From e50810924f9bf97455a69f11fcedf4f4a9d424a9 Mon Sep 17 00:00:00 2001 From: Pierre-Yves Strub Date: Mon, 25 Aug 2014 11:33:42 +0200 Subject: [PATCH 001/525] initial revision From 135c950cc40dc2e15087d689379fe735167a9bc6 Mon Sep 17 00:00:00 2001 From: Pierre-Yves Strub Date: Wed, 27 Aug 2014 14:10:24 +0200 Subject: [PATCH 002/525] .gitignore --- .gitignore | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) create mode 100644 .gitignore diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..5032cba --- /dev/null +++ b/.gitignore @@ -0,0 +1,16 @@ +main.pdf +/doc/contract/contract.pdf + +*.aux +*.bbl +*.blg +*.fdb_latexmk +*.fls +*.gnuplot +*.kilepr +*.log +*.out +*.table +*.dvi +*.synctex.gz +*.backup From a6749925d850a7dc5e4b6c7ff2178eb8a4b38365 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Fri, 27 Feb 2015 14:09:11 +0100 Subject: [PATCH 003/525] Core definitions. Starting to line up the definitions so we can prioritize the missing bits of the standard library. A note: indifferentiability should be generalized to any pair of primitives, rather than be specialized to random oracles. For example, we may want to tackle the random permutation case... --- proof/Indifferentiability.eca | 49 +++++++++++++++++++++++++ proof/RO.eca | 30 ++++++++++++++++ proof/Sponge.ec | 68 +++++++++++++++++++++++++++++++++++ 3 files changed, 147 insertions(+) create mode 100644 proof/Indifferentiability.eca create mode 100644 proof/RO.eca create mode 100644 proof/Sponge.ec diff --git a/proof/Indifferentiability.eca b/proof/Indifferentiability.eca new file mode 100644 index 0000000..1dcb8d9 --- /dev/null +++ b/proof/Indifferentiability.eca @@ -0,0 +1,49 @@ +require (*...*) RO. + +type from0, to0. +op d0: from0 -> to0 distr. + +type from1, to1. +op d1: from1 -> to1 distr. + +clone import RO as H with + type from <- from0, + type to <- to0, + op d <- d0. + +clone import RO as G with + type from <- from1, + type to <- to1, + op d <- d1. + +module type Construction (H : H.RO) = { + proc init() : unit + proc hash(x : from1): to1 +}. + +module type Simulator (H : G.RO) = { + proc init() : unit + proc hash(x : from0): to0 +}. + +module type Distinguisher (G : G.RO_, H : H.RO_) = { + proc distinguish(): bool +}. + +module Indif (G : G.RO, H : H.RO, D : Distinguisher) = { + module D = D(G,H) + + proc main(): bool = { + var b; + + G.init(); + H.init(); + b = D.distinguish(); + return b; + } +}. + +(* A C <: Construction is indifferentiable from a random oracle if + there exists a P <: Simulator such that, for all D, + | Pr[Indif(C(G),G,D): res] - Pr[Indif(H,P(H),D): res] | is small + (where G and H are the concrete random oracles defined by d0 and d1) *) diff --git a/proof/RO.eca b/proof/RO.eca new file mode 100644 index 0000000..72ab948 --- /dev/null +++ b/proof/RO.eca @@ -0,0 +1,30 @@ +require import NewFSet NewFMap. + +type from, to. + +op d: from -> to distr. + +module type RO = { + proc init() : unit + proc hash(x : from): to +}. + +module type RO_ = { + proc hash(x : from): to +}. + +module type Distinguisher(G : RO_) = { + proc distinguish(): bool +}. + +module IND(G:RO, D:Distinguisher) = { + module D = D(G) + + proc main(): bool = { + var b; + + G.init(); + b = D.distinguish(); + return b; + } +}. diff --git a/proof/Sponge.ec b/proof/Sponge.ec new file mode 100644 index 0000000..bded7e6 --- /dev/null +++ b/proof/Sponge.ec @@ -0,0 +1,68 @@ +require import Option Pair Int ABitstring NewList. +require (*..*) AWord Indifferentiability. +(* TODO: Clean up the Bitstring and Word theories + -- Make use of those new versions. *) + +(*...*) import Dprod. +(* TODO: Datatype definitions and distributions should + be properly separated and reorganized. *) + +op r : int. +axiom le0_r: 0 < r. + +op c : int. +axiom le0_c: 0 < c. + +(** Clarify assumptions on the distributions as we go. As this is currently + written, we are hiding some pretty heavy axioms behind cloning. **) +type block. +op dblock: block distr. + +clone import AWord as Block with + op length <- r, + type word <- block, + op Dword.dword <- dblock +proof leq0_length by smt. + +type capacity. +op dcapacity: capacity distr. + +clone AWord as Capacity with + op length <- c, + type word <- capacity, + op Dword.dword <- dcapacity +proof leq0_length by smt. + +type state = block * capacity. + +clone import Indifferentiability as Main with + type from0 <- state, + type to0 <- state, + op d0 <- fun (x:state) => dblock * dcapacity, + type from1 <- block list * int, + type to1 <- bitstring, + op d1 <- fun (x:block list * int) => DBitstring.dbitstring x.`2. + +module Sponge (H : H.RO): Construction(H) = { + proc init = H.init + + proc hash(p : block list, n : int): bitstring = { + var z = ABitstring.zeros n; + var s = (Block.zeros,Capacity.zeros); + var i = 0; + + if (size p >= 1 /\ nth witness p (size p - 1) <> Block.zeros) { + z = ABitstring.zeros 0; + while (p <> []) { + s = H.hash(s.`1 ^ head witness p,s.`2); + p = behead p; + } + while (i < n/%r) { + z = z || (to_bits s.`1); + s = H.hash(s); + } + } + + return sub z 0 n; + } +}. From 714a0829b7857a52417fcf591735d3675b83d8df Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Fri, 27 Feb 2015 13:57:10 -0500 Subject: [PATCH 004/525] Added strawman implemetation of an infinite random oracle. --- proof/IRO.eca | 53 +++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 53 insertions(+) create mode 100644 proof/IRO.eca diff --git a/proof/IRO.eca b/proof/IRO.eca new file mode 100644 index 0000000..b5dd307 --- /dev/null +++ b/proof/IRO.eca @@ -0,0 +1,53 @@ +(* infinite random oracle: conceptually, its range consists of + infinite length bitstrings, all of whose bits are independently + chosen *) + +require import Int Bool List FMap FSet. + +type from. + +module type IRO = { + proc init() : unit + + (* hash x, returning the first n bits of the result *) + proc hash(x : from, n : int) : bool list +}. + +op take : 'a list -> int -> 'a list. (* in NewFMap ... *) + +module IRO : IRO = { + var mp : (from, bool list) map + + proc init() : unit = { + mp = FMap.empty; + } + + proc choose(n : int) : bool list = { + var b : bool; + var bs : bool list; + bs = []; + while (n > 0) { + b = $Dbool.dbool; + bs = b :: bs; + n = n - 1; + } + return bs; + } + + proc hash(x : from, n : int) : bool list = { + var ys : bool list; + var zs : bool list; + if (! mem x (dom mp)) { + ys = choose(n); + mp.[x] = ys; + } + else { + ys = oget(mp.[x]); + if (n > length ys) { + zs = choose(n - length ys); + mp.[x] = ys ++ zs; + } + } + return take (oget mp.[x]) n; + } +}. From ff250b1637e9c70fe30419bb08d0e79325c0b352 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Mon, 2 Mar 2015 12:19:57 +0100 Subject: [PATCH 005/525] Folding in Alley's contribution. Generalizing Indifferentiability. --- proof/IRO.eca | 14 +++--- proof/Indifferentiability.eca | 66 ++++++++++++++------------ proof/LazyRO.eca | 20 ++++++++ proof/RO.eca | 2 - proof/Sponge.ec | 89 +++++++++++++++++++++++++++-------- 5 files changed, 132 insertions(+), 59 deletions(-) create mode 100644 proof/LazyRO.eca diff --git a/proof/IRO.eca b/proof/IRO.eca index b5dd307..85ae9d1 100644 --- a/proof/IRO.eca +++ b/proof/IRO.eca @@ -2,7 +2,7 @@ infinite length bitstrings, all of whose bits are independently chosen *) -require import Int Bool List FMap FSet. +require import Option Int Bool NewList NewFMap NewFSet. type from. @@ -16,10 +16,10 @@ module type IRO = { op take : 'a list -> int -> 'a list. (* in NewFMap ... *) module IRO : IRO = { - var mp : (from, bool list) map + var mp : (from, bool list) fmap proc init() : unit = { - mp = FMap.empty; + mp = map0; } proc choose(n : int) : bool list = { @@ -37,14 +37,14 @@ module IRO : IRO = { proc hash(x : from, n : int) : bool list = { var ys : bool list; var zs : bool list; - if (! mem x (dom mp)) { + if (! mem (dom mp) x) { ys = choose(n); mp.[x] = ys; } else { - ys = oget(mp.[x]); - if (n > length ys) { - zs = choose(n - length ys); + ys = oget (mp.[x]); + if (n > size ys) { + zs = choose(n - size ys); mp.[x] = ys ++ zs; } } diff --git a/proof/Indifferentiability.eca b/proof/Indifferentiability.eca index 1dcb8d9..68101c0 100644 --- a/proof/Indifferentiability.eca +++ b/proof/Indifferentiability.eca @@ -1,49 +1,55 @@ -require (*...*) RO. +(** A primitive: the building block we assume ideal **) +type p_in, p_out. -type from0, to0. -op d0: from0 -> to0 distr. - -type from1, to1. -op d1: from1 -> to1 distr. +module type Primitive = { + proc init(): unit + proc oracle(x : p_in): p_out +}. -clone import RO as H with - type from <- from0, - type to <- to0, - op d <- d0. +(** A functionality: the target construction **) +type f_in, f_out. -clone import RO as G with - type from <- from1, - type to <- to1, - op d <- d1. +module type Functionality = { + proc init(): unit + proc oracle(x : f_in): f_out +}. -module type Construction (H : H.RO) = { - proc init() : unit - proc hash(x : from1): to1 +(** A construction takes a primitive and builds a functionality. + A simulator takes a functionality and simulates the primitive. + A distinguisher gets oracle access to a primitive and a + functionality and returns a boolean (its guess as to whether it + is playing with constructed functionality and ideal primitive or + with ideal functionality and simulated primitive). **) +module type Construction (P : Primitive) = { + proc init() : unit { P.init } + proc oracle(x : f_in): f_out { P.oracle } }. -module type Simulator (H : G.RO) = { - proc init() : unit - proc hash(x : from0): to0 +module type Simulator (F : Functionality) = { + proc init() : unit { F.init } + proc oracle(x : p_in): p_out { F.oracle } }. -module type Distinguisher (G : G.RO_, H : H.RO_) = { - proc distinguish(): bool +module type Distinguisher (F : Functionality, P : Primitive) = { + proc distinguish(): bool { P.oracle F.oracle } }. -module Indif (G : G.RO, H : H.RO, D : Distinguisher) = { - module D = D(G,H) +module Indif (F : Functionality, P : Primitive, D : Distinguisher) = { + module D = D(F,P) proc main(): bool = { var b; - G.init(); - H.init(); + P.init(); + F.init(); b = D.distinguish(); return b; } }. -(* A C <: Construction is indifferentiable from a random oracle if - there exists a P <: Simulator such that, for all D, - | Pr[Indif(C(G),G,D): res] - Pr[Indif(H,P(H),D): res] | is small - (where G and H are the concrete random oracles defined by d0 and d1) *) +(* (C <: Construction) applied to (P <: Primitive) is indifferentiable + from (F <: Functionality) if there exists (S <: Simulator) such + that, for all (D <: Distinguisher), + | Pr[Indif(C(P),P,D): res] - Pr[Indif(F,S(F),D): res] | is small. + We avoid the existential by providing a concrete construction for S + and the `small` by providing a concrete bound. *) diff --git a/proof/LazyRO.eca b/proof/LazyRO.eca new file mode 100644 index 0000000..10f9a64 --- /dev/null +++ b/proof/LazyRO.eca @@ -0,0 +1,20 @@ +require import Option NewFSet NewFMap. +require (*..*) RO. + +type from, to. +op d: to distr. + +clone import RO as Types with + type from <- from, + type to <- to. + +module H : RO, RO_ = { + var m : (from, to) fmap + + proc init(): unit = { m = map0; } + + proc hash(x : from): to = { + if (!mem (dom m) x) m.[x] = $d; + return oget m.[x]; + } +}. diff --git a/proof/RO.eca b/proof/RO.eca index 72ab948..b224703 100644 --- a/proof/RO.eca +++ b/proof/RO.eca @@ -2,8 +2,6 @@ require import NewFSet NewFMap. type from, to. -op d: from -> to distr. - module type RO = { proc init() : unit proc hash(x : from): to diff --git a/proof/Sponge.ec b/proof/Sponge.ec index bded7e6..1dbea52 100644 --- a/proof/Sponge.ec +++ b/proof/Sponge.ec @@ -1,8 +1,7 @@ -require import Option Pair Int ABitstring NewList. -require (*..*) AWord Indifferentiability. +require import Option Pair Int Real NewList NewFSet NewFMap. +require (*..*) AWord LazyRO IRO Indifferentiability. (* TODO: Clean up the Bitstring and Word theories -- Make use of those new versions. *) - (*...*) import Dprod. (* TODO: Datatype definitions and distributions should be properly separated and reorganized. *) @@ -35,34 +34,84 @@ proof leq0_length by smt. type state = block * capacity. +(** Ideal Functionality **) +clone import IRO as Functionality with + type from <- block list. + +(** The following is just lining up type definitions and defines the + Indifferentiability experiment. Importantly, it defines neither + ideal primitive nor ideal functionality: only their type. **) clone import Indifferentiability as Main with - type from0 <- state, - type to0 <- state, - op d0 <- fun (x:state) => dblock * dcapacity, - type from1 <- block list * int, - type to1 <- bitstring, - op d1 <- fun (x:block list * int) => DBitstring.dbitstring x.`2. - -module Sponge (H : H.RO): Construction(H) = { - proc init = H.init - - proc hash(p : block list, n : int): bitstring = { - var z = ABitstring.zeros n; + type p_in <- state, + type p_out <- state, + type f_in <- block list * int, + type f_out <- bool list. + +(** Ideal Primitive for the Random Transformation case **) +clone import LazyRO as Primitive with + type from <- state, + type to <- state, + op d <- dblock * dcapacity. + +(*** TODO: deal with these. + - bitstrings should have conversions to and from bool list + - the generic RO should be defined somewhere else + - lining up names and types should be easier than it is... ***) +op to_bits: block -> bool list. + +module RO_to_P (O : Types.RO) = { + proc init = O.init + proc oracle = O.hash +}. + +module IRO_to_F (O : IRO): Functionality = { + proc init = O.init + + (* proc oracle = O.hash + does not work because of input types not lining up... + I though this had been taken care of. *) + proc oracle(x : block list * int): bool list = { + var bs; + bs = O.hash(x.`1,x.`2); + return bs; + } +}. + +(** We can now define the sponge construction **) +module Sponge (P : Primitive): Construction(P) = { + proc init = P.init + + proc oracle(p : block list, n : int): bool list = { + var z; var s = (Block.zeros,Capacity.zeros); var i = 0; if (size p >= 1 /\ nth witness p (size p - 1) <> Block.zeros) { - z = ABitstring.zeros 0; + z = []; while (p <> []) { - s = H.hash(s.`1 ^ head witness p,s.`2); + s = P.oracle(s.`1 ^ head witness p,s.`2); p = behead p; } while (i < n/%r) { - z = z || (to_bits s.`1); - s = H.hash(s); + z = z ++ (Self.to_bits s.`1); (* Typing by constraint would be nice *) + s = P.oracle(s); } } - return sub z 0 n; + return take n z; } }. + +(** TODO: ftn is in fact a function of N + (number of queries to the primitive interface) **) +op ftn: real. + +module P = RO_to_P(Primitive.H). +module F = IRO_to_F(IRO). + +lemma TransformationLemma (D <: Distinguisher) &m: + exists (S <: Simulator), + `|Pr[Indif(Sponge(P),P,D).main() @ &m: res] + - Pr[Indif(F,S(F),D).main() @ &m: res]| + < ftn. +proof. admit. qed. From e7cd7d706d516d3f9c2b0060b042efaa10b28d4d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Thu, 5 Mar 2015 18:06:10 +0100 Subject: [PATCH 006/525] Trying out `clone include` in anger. Identifying some possible improvements. --- proof/LazyRO.eca | 2 +- proof/RO.eca | 2 -- proof/Sponge.ec | 15 ++++++++------- 3 files changed, 9 insertions(+), 10 deletions(-) diff --git a/proof/LazyRO.eca b/proof/LazyRO.eca index 10f9a64..c8575f4 100644 --- a/proof/LazyRO.eca +++ b/proof/LazyRO.eca @@ -4,7 +4,7 @@ require (*..*) RO. type from, to. op d: to distr. -clone import RO as Types with +clone include RO with type from <- from, type to <- to. diff --git a/proof/RO.eca b/proof/RO.eca index b224703..5617647 100644 --- a/proof/RO.eca +++ b/proof/RO.eca @@ -1,5 +1,3 @@ -require import NewFSet NewFMap. - type from, to. module type RO = { diff --git a/proof/Sponge.ec b/proof/Sponge.ec index 1dbea52..5ca5413 100644 --- a/proof/Sponge.ec +++ b/proof/Sponge.ec @@ -34,19 +34,19 @@ proof leq0_length by smt. type state = block * capacity. -(** Ideal Functionality **) -clone import IRO as Functionality with - type from <- block list. - (** The following is just lining up type definitions and defines the Indifferentiability experiment. Importantly, it defines neither ideal primitive nor ideal functionality: only their type. **) -clone import Indifferentiability as Main with +clone include Indifferentiability with type p_in <- state, type p_out <- state, type f_in <- block list * int, type f_out <- bool list. +(** Ideal Functionality **) +clone import IRO as Functionality with + type from <- block list. + (** Ideal Primitive for the Random Transformation case **) clone import LazyRO as Primitive with type from <- state, @@ -59,7 +59,7 @@ clone import LazyRO as Primitive with - lining up names and types should be easier than it is... ***) op to_bits: block -> bool list. -module RO_to_P (O : Types.RO) = { +module RO_to_P (O : RO) = { proc init = O.init proc oracle = O.hash }. @@ -109,7 +109,8 @@ op ftn: real. module P = RO_to_P(Primitive.H). module F = IRO_to_F(IRO). -lemma TransformationLemma (D <: Distinguisher) &m: +(* That Self is unfortunate *) +lemma TransformationLemma (D <: Self.Distinguisher) &m: exists (S <: Simulator), `|Pr[Indif(Sponge(P),P,D).main() @ &m: res] - Pr[Indif(F,S(F),D).main() @ &m: res]| From 39c67aa138c226dbb1dc0876e057a6f005233a84 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Thu, 20 Aug 2015 10:28:26 +0200 Subject: [PATCH 007/525] Old minor stuff. --- proof/Sponge.ec | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/proof/Sponge.ec b/proof/Sponge.ec index 5ca5413..cbb602e 100644 --- a/proof/Sponge.ec +++ b/proof/Sponge.ec @@ -1,3 +1,5 @@ +pragma +Smt:lazy. + require import Option Pair Int Real NewList NewFSet NewFMap. require (*..*) AWord LazyRO IRO Indifferentiability. (* TODO: Clean up the Bitstring and Word theories @@ -88,10 +90,12 @@ module Sponge (P : Primitive): Construction(P) = { if (size p >= 1 /\ nth witness p (size p - 1) <> Block.zeros) { z = []; + (* Absorption *) while (p <> []) { s = P.oracle(s.`1 ^ head witness p,s.`2); p = behead p; } + (* Squeezing *) while (i < n/%r) { z = z ++ (Self.to_bits s.`1); (* Typing by constraint would be nice *) s = P.oracle(s); From 36e72f6975b93e66fbd38796a0913d0cf635a499 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Thu, 20 Aug 2015 11:01:51 +0200 Subject: [PATCH 008/525] Updating syntax - moving to permutation simulator. --- proof/IRO.eca | 52 +++++++++++---------------- proof/Indifferentiability.eca | 8 ++--- proof/LazyRO.eca | 4 +-- proof/LazyRP.eca | 32 +++++++++++++++++ proof/RO.eca | 12 +++---- proof/RP.eca | 26 ++++++++++++++ proof/Sponge.ec | 67 ++++++++++++++++++++++------------- 7 files changed, 131 insertions(+), 70 deletions(-) create mode 100644 proof/LazyRP.eca create mode 100644 proof/RP.eca diff --git a/proof/IRO.eca b/proof/IRO.eca index 85ae9d1..07c2c25 100644 --- a/proof/IRO.eca +++ b/proof/IRO.eca @@ -1,6 +1,6 @@ -(* infinite random oracle: conceptually, its range consists of - infinite length bitstrings, all of whose bits are independently - chosen *) +(* infinite random oracle: it ranges over infinite length bitstrings, + all of whose bits are sampled uniformly and independently. We + obviously make it lazy. *) require import Option Int Bool NewList NewFMap NewFSet. @@ -9,45 +9,33 @@ type from. module type IRO = { proc init() : unit - (* hash x, returning the first n bits of the result *) - proc hash(x : from, n : int) : bool list + (* f x, returning the first n bits of the result *) + proc f(x : from, n : int) : bool list }. -op take : 'a list -> int -> 'a list. (* in NewFMap ... *) - module IRO : IRO = { var mp : (from, bool list) fmap - proc init() : unit = { - mp = map0; - } + proc init() = { mp = map0; } + + proc choose(n) = { + var b, bs; - proc choose(n : int) : bool list = { - var b : bool; - var bs : bool list; - bs = []; + bs <- []; while (n > 0) { - b = $Dbool.dbool; - bs = b :: bs; - n = n - 1; + b <$ Dbool.dbool; + bs <- b :: bs; + n <- n - 1; } return bs; } - proc hash(x : from, n : int) : bool list = { - var ys : bool list; - var zs : bool list; - if (! mem (dom mp) x) { - ys = choose(n); - mp.[x] = ys; - } - else { - ys = oget (mp.[x]); - if (n > size ys) { - zs = choose(n - size ys); - mp.[x] = ys ++ zs; - } - } - return take (oget mp.[x]) n; + proc f(x, n) = { + var ys, zs; + + ys <- odflt [] mp.[x]; + zs <@ choose (max 0 (n - size ys)); + mp.[x] <- ys ++ zs; + return take n (oget mp.[x]); } }. diff --git a/proof/Indifferentiability.eca b/proof/Indifferentiability.eca index 68101c0..ca782a8 100644 --- a/proof/Indifferentiability.eca +++ b/proof/Indifferentiability.eca @@ -35,14 +35,12 @@ module type Distinguisher (F : Functionality, P : Primitive) = { }. module Indif (F : Functionality, P : Primitive, D : Distinguisher) = { - module D = D(F,P) - proc main(): bool = { var b; - P.init(); - F.init(); - b = D.distinguish(); + P.init(); + F.init(); + b <@ D(F,P).distinguish(); return b; } }. diff --git a/proof/LazyRO.eca b/proof/LazyRO.eca index c8575f4..80d090c 100644 --- a/proof/LazyRO.eca +++ b/proof/LazyRO.eca @@ -11,9 +11,9 @@ clone include RO with module H : RO, RO_ = { var m : (from, to) fmap - proc init(): unit = { m = map0; } + proc init() = { m = map0; } - proc hash(x : from): to = { + proc f(x) = { if (!mem (dom m) x) m.[x] = $d; return oget m.[x]; } diff --git a/proof/LazyRP.eca b/proof/LazyRP.eca new file mode 100644 index 0000000..2752038 --- /dev/null +++ b/proof/LazyRP.eca @@ -0,0 +1,32 @@ +require import Option NewFSet NewFMap. +require (*..*) RP. + +type D. +op d: D distr. + +clone include RP with + type from <- D, + type to <- D. + +module P : RP, RP_ = { + var m : (D, D) fmap + var mi: (D, D) fmap + + proc init() = { m = map0; } + + proc f(x) = { + if (!mem (dom m) x) { + m.[x] <$ d; + mi.[oget m.[x]] <- x; + } + return oget m.[x]; + } + + proc fi(x) = { + if (!mem (dom mi) x) { + mi.[x] <$ d; + m.[oget m.[x]] <- x; + } + return oget mi.[x]; + } +}. diff --git a/proof/RO.eca b/proof/RO.eca index 5617647..3bf0d3b 100644 --- a/proof/RO.eca +++ b/proof/RO.eca @@ -1,12 +1,12 @@ type from, to. module type RO = { - proc init() : unit - proc hash(x : from): to + proc init() : unit + proc f(x : from): to }. module type RO_ = { - proc hash(x : from): to + proc f(x : from): to }. module type Distinguisher(G : RO_) = { @@ -14,13 +14,11 @@ module type Distinguisher(G : RO_) = { }. module IND(G:RO, D:Distinguisher) = { - module D = D(G) - proc main(): bool = { var b; - G.init(); - b = D.distinguish(); + G.init(); + b <@ D(G).distinguish(); return b; } }. diff --git a/proof/RP.eca b/proof/RP.eca new file mode 100644 index 0000000..eafe094 --- /dev/null +++ b/proof/RP.eca @@ -0,0 +1,26 @@ +type from, to. + +module type RP = { + proc init() : unit + proc f (x : from): to + proc fi(x : to ): from +}. + +module type RP_ = { + proc f (x : from): to + proc fi(x : to ): from +}. + +module type Distinguisher(G : RP_) = { + proc distinguish(): bool +}. + +module IND(G:RP, D:Distinguisher) = { + proc main(): bool = { + var b; + + G.init(); + b <@ D(G).distinguish(); + return b; + } +}. diff --git a/proof/Sponge.ec b/proof/Sponge.ec index cbb602e..60f06c8 100644 --- a/proof/Sponge.ec +++ b/proof/Sponge.ec @@ -1,18 +1,13 @@ -pragma +Smt:lazy. - require import Option Pair Int Real NewList NewFSet NewFMap. -require (*..*) AWord LazyRO IRO Indifferentiability. +require (*..*) AWord LazyRP IRO Indifferentiability. (* TODO: Clean up the Bitstring and Word theories -- Make use of those new versions. *) (*...*) import Dprod. (* TODO: Datatype definitions and distributions should be properly separated and reorganized. *) -op r : int. -axiom le0_r: 0 < r. - -op c : int. -axiom le0_c: 0 < c. +op r : { int | 0 < r } as lt0_r. +op c : { int | 0 < c } as lt0_c. (** Clarify assumptions on the distributions as we go. As this is currently written, we are hiding some pretty heavy axioms behind cloning. **) @@ -39,8 +34,25 @@ type state = block * capacity. (** The following is just lining up type definitions and defines the Indifferentiability experiment. Importantly, it defines neither ideal primitive nor ideal functionality: only their type. **) +type p_query = [ + | F of state + | Fi of state +]. + +op is_F (q : p_query) = + with q = F s => true + with q = Fi s => false. + +op is_Fi (q : p_query) = + with q = F s => false + with q = Fi s => true. + +op get_query (q : p_query) = + with q = F s => s + with q = Fi s => s. + clone include Indifferentiability with - type p_in <- state, + type p_in <- p_query, type p_out <- state, type f_in <- block list * int, type f_out <- bool list. @@ -50,9 +62,8 @@ clone import IRO as Functionality with type from <- block list. (** Ideal Primitive for the Random Transformation case **) -clone import LazyRO as Primitive with - type from <- state, - type to <- state, +clone import LazyRP as Primitive with + type D <- state, op d <- dblock * dcapacity. (*** TODO: deal with these. @@ -61,9 +72,18 @@ clone import LazyRO as Primitive with - lining up names and types should be easier than it is... ***) op to_bits: block -> bool list. -module RO_to_P (O : RO) = { +module RO_to_P (O : RP) = { proc init = O.init - proc oracle = O.hash + proc oracle(q : p_query) = { + var r; + + if (is_F q) { + r <@ O.f(get_query q); + } else { + r <@ O.fi(get_query q); + } + return r; + } }. module IRO_to_F (O : IRO): Functionality = { @@ -74,7 +94,7 @@ module IRO_to_F (O : IRO): Functionality = { I though this had been taken care of. *) proc oracle(x : block list * int): bool list = { var bs; - bs = O.hash(x.`1,x.`2); + bs = O.f(x.`1,x.`2); return bs; } }. @@ -84,21 +104,20 @@ module Sponge (P : Primitive): Construction(P) = { proc init = P.init proc oracle(p : block list, n : int): bool list = { - var z; - var s = (Block.zeros,Capacity.zeros); - var i = 0; + var z <- []; + var s <- (Block.zeros,Capacity.zeros); + var i <- 0; if (size p >= 1 /\ nth witness p (size p - 1) <> Block.zeros) { - z = []; (* Absorption *) while (p <> []) { - s = P.oracle(s.`1 ^ head witness p,s.`2); - p = behead p; + s <@ P.oracle(F (s.`1 ^ head witness p,s.`2)); + p <- behead p; } (* Squeezing *) while (i < n/%r) { - z = z ++ (Self.to_bits s.`1); (* Typing by constraint would be nice *) - s = P.oracle(s); + z <- z ++ (Self.to_bits s.`1); (* Typing by constraint would be nice *) + s <@ P.oracle(F s); } } @@ -110,7 +129,7 @@ module Sponge (P : Primitive): Construction(P) = { (number of queries to the primitive interface) **) op ftn: real. -module P = RO_to_P(Primitive.H). +module P = RO_to_P(Primitive.P). module F = IRO_to_F(IRO). (* That Self is unfortunate *) From 6a88e850b95aef0ca40efac8d68a88e287799978 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Mon, 24 Aug 2015 11:46:55 +0200 Subject: [PATCH 009/525] Bugfix in LazyRP (was not a permutation). Minor in other defs. --- proof/LazyRP.eca | 5 +++-- proof/Sponge.ec | 2 +- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/proof/LazyRP.eca b/proof/LazyRP.eca index 2752038..299a80c 100644 --- a/proof/LazyRP.eca +++ b/proof/LazyRP.eca @@ -1,4 +1,5 @@ require import Option NewFSet NewFMap. +require import Dexcepted. require (*..*) RP. type D. @@ -16,7 +17,7 @@ module P : RP, RP_ = { proc f(x) = { if (!mem (dom m) x) { - m.[x] <$ d; + m.[x] <$ d \ rng m; mi.[oget m.[x]] <- x; } return oget m.[x]; @@ -24,7 +25,7 @@ module P : RP, RP_ = { proc fi(x) = { if (!mem (dom mi) x) { - mi.[x] <$ d; + mi.[x] <$ d \ rng mi; m.[oget m.[x]] <- x; } return oget mi.[x]; diff --git a/proof/Sponge.ec b/proof/Sponge.ec index 60f06c8..7340f61 100644 --- a/proof/Sponge.ec +++ b/proof/Sponge.ec @@ -100,7 +100,7 @@ module IRO_to_F (O : IRO): Functionality = { }. (** We can now define the sponge construction **) -module Sponge (P : Primitive): Construction(P) = { +module Sponge (P : Primitive): Construction(P), Functionality = { proc init = P.init proc oracle(p : block list, n : int): bool list = { From 234de7241da7d9a18d460f868f1becfcc669c972 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Wed, 26 Aug 2015 12:18:02 +0200 Subject: [PATCH 010/525] Submodule: cryptobib. --- .gitmodules | 3 +++ 1 file changed, 3 insertions(+) create mode 100644 .gitmodules diff --git a/.gitmodules b/.gitmodules new file mode 100644 index 0000000..2eced4c --- /dev/null +++ b/.gitmodules @@ -0,0 +1,3 @@ +[submodule "doc/bib"] + path = doc/bib + url = https://github.com/cryptobib/export From 3b920f93276c08f38800ac7bdde3bcef35bee748 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Wed, 9 Sep 2015 19:24:01 +0200 Subject: [PATCH 011/525] Iterating on ec defs. --- proof/Sponge.ec | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/proof/Sponge.ec b/proof/Sponge.ec index 7340f61..365266a 100644 --- a/proof/Sponge.ec +++ b/proof/Sponge.ec @@ -72,7 +72,7 @@ clone import LazyRP as Primitive with - lining up names and types should be easier than it is... ***) op to_bits: block -> bool list. -module RO_to_P (O : RP) = { +module RP_to_P (O : RP) = { proc init = O.init proc oracle(q : p_query) = { var r; @@ -129,11 +129,11 @@ module Sponge (P : Primitive): Construction(P), Functionality = { (number of queries to the primitive interface) **) op ftn: real. -module P = RO_to_P(Primitive.P). +module P = RP_to_P(Primitive.P). module F = IRO_to_F(IRO). (* That Self is unfortunate *) -lemma TransformationLemma (D <: Self.Distinguisher) &m: +lemma PermutationLemma (D <: Self.Distinguisher) &m: exists (S <: Simulator), `|Pr[Indif(Sponge(P),P,D).main() @ &m: res] - Pr[Indif(F,S(F),D).main() @ &m: res]| From b3220e80f95b8c5149193aa4d802fbfcf232a746 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Thu, 10 Sep 2015 12:34:53 +0200 Subject: [PATCH 012/525] Misplaced file. --- proof/Squeezeless.ec | 177 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 177 insertions(+) create mode 100644 proof/Squeezeless.ec diff --git a/proof/Squeezeless.ec b/proof/Squeezeless.ec new file mode 100644 index 0000000..645ae30 --- /dev/null +++ b/proof/Squeezeless.ec @@ -0,0 +1,177 @@ +(** This is a theory for the Squeezeless sponge: where the ideal + functionality is a fixed-output-length random oracle whose output + length is the input block size. We prove its security even when + padding is not prefix-free. **) +require import Option Pair Int Real NewList NewFSet NewFMap. +require (*..*) AWord LazyRP LazyRO Indifferentiability. +(* TODO: Clean up the Bitstring and Word theories + -- Make use of those new versions. *) +(*...*) import Dprod. +(* TODO: Datatype definitions and distributions should + be properly separated and reorganized. *) + +op r : { int | 0 < r } as lt0_r. +op c : { int | 0 < c } as lt0_c. + +(** Clarify assumptions on the distributions as we go. As this is currently + written, we are hiding some pretty heavy axioms behind cloning. **) +type block. +op dblock: block distr. + +clone import AWord as Block with + op length <- r, + type word <- block, + op Dword.dword <- dblock +proof leq0_length by smt. + +type capacity. +op dcapacity: capacity distr. + +clone AWord as Capacity with + op length <- c, + type word <- capacity, + op Dword.dword <- dcapacity +proof leq0_length by smt. + +type state = block * capacity. +op dstate = dblock * dcapacity. + +(** The following is just lining up type definitions and defines the + Indifferentiability experiment. Importantly, it defines neither + ideal primitive nor ideal functionality: only their type. **) +type p_query = [ + | F of state + | Fi of state +]. + +op is_F (q : p_query) = + with q = F s => true + with q = Fi s => false. + +op is_Fi (q : p_query) = + with q = F s => false + with q = Fi s => true. + +op get_query (q : p_query) = + with q = F s => s + with q = Fi s => s. + +clone include Indifferentiability with + type p_in <- p_query, + type p_out <- state, + type f_in <- block list, + type f_out <- block. + +(** Ideal Functionality **) +clone import LazyRO as Functionality with + type from <- block list, + type to <- block, + op d <- dblock. + +(** Ideal Primitive for the Random Transformation case **) +clone import LazyRP as Primitive with + type D <- state, + op d <- dstate. + +(*** TODO: deal with these. + - bitstrings should have conversions to and from bool list + - the generic RO should be defined somewhere else + - lining up names and types should be easier than it is... ***) +op to_bits: block -> bool list. + +module RP_to_P (O : RP) = { + proc init = O.init + proc oracle(q : p_query) = { + var r; + + if (is_F q) { + r <@ O.f(get_query q); + } else { + r <@ O.fi(get_query q); + } + return r; + } +}. + +module RO_to_F (O : RO): Functionality = { + proc init = O.init + proc oracle = O.f +}. + +(** We can now define the squeezeless sponge construction **) +module SqueezelessSponge (P : Primitive): Construction(P), Functionality = { + proc init = P.init + + proc oracle(p : block list): block = { + var (sa,sc) <- (Block.zeros,Capacity.zeros); + + if (size p >= 1 /\ p <> [Block.zeros]) { + (* Absorption *) + while (p <> []) { + (sa,sc) <@ P.oracle(F (sa ^ head witness p,sc)); + p <- behead p; + } + } + return sa; + } +}. + +(** And the corresponding simulator **) +op find_chain: (state,state) fmap -> state -> (block list * block) option. + +module PreSimulator (F : Functionality) = { + var m, mi: (state,state) fmap + + proc init() = { + F.init(); + m <- map0; + mi <- map0; + } + + proc f(x:state) = { + var pvo, p, v, h, y; + + if (!mem (dom m) x) { + pvo <- find_chain m x; + if (pvo <> None) { + (p,v) <- oget pvo; + h <@ F.oracle(rcons p v); + y <$ dcapacity; + } else { + (h,y) <$ dstate; + } + m.[x] <- (h,y); + mi.[(h,y)] <- x; + } + return oget m.[x]; + } + + proc fi(x:state) = { + var y; + + if (!mem (dom mi) x) { + y <$ dstate; + mi.[x] <- y; + m.[y] <- x; + } + return oget mi.[x]; + } +}. + +module Simulator(F : Functionality) = RP_to_P(PreSimulator(F)). + +(** TODO: ftn is in fact a function of N + (number of queries to the primitive interface) **) +op ftn: real. + +module P = RP_to_P(Primitive.P). +module F = RO_to_F(H). + +(* That Self is unfortunate *) +lemma PermutationLemma: + exists (S <: Simulator), + forall (D <: Self.Distinguisher) &m, + `|Pr[Indif(SqueezelessSponge(P),P,D).main() @ &m: res] + - Pr[Indif(F,S(F),D).main() @ &m: res]| + < ftn. +proof. admit. qed. From 958b1b5ea953f1d7bf66e4c4c3259b19b111037e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Thu, 10 Sep 2015 12:55:36 +0200 Subject: [PATCH 013/525] Minor in proof. --- proof/Squeezeless.ec | 11 +++-------- 1 file changed, 3 insertions(+), 8 deletions(-) diff --git a/proof/Squeezeless.ec b/proof/Squeezeless.ec index 645ae30..7fe9755 100644 --- a/proof/Squeezeless.ec +++ b/proof/Squeezeless.ec @@ -158,20 +158,15 @@ module PreSimulator (F : Functionality) = { } }. -module Simulator(F : Functionality) = RP_to_P(PreSimulator(F)). - -(** TODO: ftn is in fact a function of N - (number of queries to the primitive interface) **) -op ftn: real. - module P = RP_to_P(Primitive.P). module F = RO_to_F(H). +module S(F : Functionality) = RP_to_P(PreSimulator(F)). (* That Self is unfortunate *) lemma PermutationLemma: - exists (S <: Simulator), + exists epsilon, forall (D <: Self.Distinguisher) &m, `|Pr[Indif(SqueezelessSponge(P),P,D).main() @ &m: res] - Pr[Indif(F,S(F),D).main() @ &m: res]| - < ftn. + < epsilon. proof. admit. qed. From 2f6fe16ce5ab9280fc24e2cab83570a96136b693 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Tue, 15 Sep 2015 12:19:06 +0200 Subject: [PATCH 014/525] Cleanup and notes on the top-level arguments. --- proof/Sponge.ec | 125 +++++++++++++++++++++++++++++++++++++++++-- proof/Squeezeless.ec | 9 +--- 2 files changed, 123 insertions(+), 11 deletions(-) diff --git a/proof/Sponge.ec b/proof/Sponge.ec index 365266a..fc66d8f 100644 --- a/proof/Sponge.ec +++ b/proof/Sponge.ec @@ -1,5 +1,5 @@ require import Option Pair Int Real NewList NewFSet NewFMap. -require (*..*) AWord LazyRP IRO Indifferentiability. +require (*..*) AWord LazyRP IRO Indifferentiability Squeezeless. (* TODO: Clean up the Bitstring and Word theories -- Make use of those new versions. *) (*...*) import Dprod. @@ -132,10 +132,127 @@ op ftn: real. module P = RP_to_P(Primitive.P). module F = IRO_to_F(IRO). +clone import Squeezeless as Core with + op r <- r, + type block <- block, + op dblock <- dblock, + op c <- c, + type capacity <- capacity, + op dcapacity <- dcapacity, + (** The following should be dealt with by sub-theory instantiation, + but the sub-theories we instantiate are partially concrete **) + op Block.zeros <- Self.Block.zeros, + op Block.ones <- Self.Block.ones, + op Block.(^) <- Self.Block.(^), + op Block.land <- Self.Block.land, + op Block.to_bits <- Self.Block.to_bits, + op Block.from_bits <- Self.Block.from_bits, + op Block.to_int <- Self.Block.to_int, + op Block.from_int <- Self.Block.from_int, + op Capacity.zeros <- Self.Capacity.zeros, + op Capacity.ones <- Self.Capacity.ones, + op Capacity.(^) <- Self.Capacity.(^), + op Capacity.land <- Self.Capacity.land, + op Capacity.to_bits <- Self.Capacity.to_bits, + op Capacity.from_bits <- Self.Capacity.from_bits, + op Capacity.to_int <- Self.Capacity.to_int, + op Capacity.from_int <- Self.Capacity.from_int +proof *. + realize lt0_r by exact/lt0_r. + realize lt0_c by exact/lt0_c. + realize Block.ones_neq0 by exact/Self.Block.ones_neq0. + realize Block.xorwA by exact/Self.Block.xorwA. + realize Block.xorwC by exact/Self.Block.xorwC. + realize Block.xor0w by exact/Self.Block.xor0w. + realize Block.xorwK by exact/Self.Block.xorwK. + realize Block.landwA by exact/Self.Block.landwA. + realize Block.landwC by exact/Self.Block.landwC. + realize Block.land1w by exact/Self.Block.land1w. + realize Block.landwDl by exact/Self.Block.landwDl. + realize Block.landI by exact/Self.Block.landI. + realize Block.length_to_bits by exact/Self.Block.length_to_bits. + realize Block.can_from_to by exact/Self.Block.can_from_to. + realize Block.pcan_to_from by exact/Self.Block.pcan_to_from. + realize Block.to_from by exact/Self.Block.to_from. + realize Block.from_to by exact/Self.Block.from_to. + realize Block.Dword.mu_x_def by exact/Self.Block.Dword.mu_x_def. + realize Block.Dword.lossless by exact/Self.Block.Dword.lossless. + realize Capacity.ones_neq0 by exact/Self.Capacity.ones_neq0. + realize Capacity.xorwA by exact/Self.Capacity.xorwA. + realize Capacity.xorwC by exact/Self.Capacity.xorwC. + realize Capacity.xor0w by exact/Self.Capacity.xor0w. + realize Capacity.xorwK by exact/Self.Capacity.xorwK. + realize Capacity.landwA by exact/Self.Capacity.landwA. + realize Capacity.landwC by exact/Self.Capacity.landwC. + realize Capacity.land1w by exact/Self.Capacity.land1w. + realize Capacity.landwDl by exact/Self.Capacity.landwDl. + realize Capacity.landI by exact/Self.Capacity.landI. + realize Capacity.length_to_bits by exact/Self.Capacity.length_to_bits. + realize Capacity.can_from_to by exact/Self.Capacity.can_from_to. + realize Capacity.pcan_to_from by exact/Self.Capacity.pcan_to_from. + realize Capacity.to_from by exact/Self.Capacity.to_from. + realize Capacity.from_to by exact/Self.Capacity.from_to. + realize Capacity.Dword.mu_x_def by exact/Self.Capacity.Dword.mu_x_def. + realize Capacity.Dword.lossless by exact/Self.Capacity.Dword.lossless. +(* end of clone *) + +module type BlockSponge = { + proc init(): unit + proc oracle(p : block list, n : int): block list +}. + +module Squeezer(F : Core.Functionality): BlockSponge = { + proc init = F.init + + proc oracle(p : block list, n : int): block list = { + var z <- []; + var b; + var i <- 0; + + if (size p >= 1 /\ nth witness p (size p - 1) <> Self.Block.zeros) { + while (i < n) { + b <@ F.oracle(p ++ mkseq (fun i => Self.Block.zeros) i); + z <- rcons z b; + i <- i + 1; + } + } + + return z; + } +}. + +(* Result: if there exists a good simulator for the Core functionality + F, then we can construct a simulator for Squeezer(F) that has the + same differentiability advantage. + Note: We need to be careful and may need to make this whitebox so + we can avoid having to make too many queries. *) + +module Truncator(F : BlockSponge): Self.Functionality = { + proc init = F.init + + proc oracle(p : block list, n : int): bool list = { + var z <- []; + var bs; + + if (size p >= 1 /\ nth witness p ( size p - 1) <> Self.Block.zeros) { + bs <@ F.oracle(p,n /% r); + z <- z ++ flatten (map to_bits bs); + } + + return take n z; + } +}. + +(* Result: if there exists a good simulator for the BlockSponge F, + then we can construct a simulator for Truncator(F) that has the + same differentiability advantage. + Note: We need to be careful and may need to make this whitebox so + we can avoid having to make too many queries. *) + (* That Self is unfortunate *) -lemma PermutationLemma (D <: Self.Distinguisher) &m: - exists (S <: Simulator), +lemma PermutationLemma: exists (S <: Simulator), + forall (D <: Self.Distinguisher) &m, `|Pr[Indif(Sponge(P),P,D).main() @ &m: res] - Pr[Indif(F,S(F),D).main() @ &m: res]| < ftn. -proof. admit. qed. +proof. admit. qed. \ No newline at end of file diff --git a/proof/Squeezeless.ec b/proof/Squeezeless.ec index 7fe9755..a6a3151 100644 --- a/proof/Squeezeless.ec +++ b/proof/Squeezeless.ec @@ -74,11 +74,7 @@ clone import LazyRP as Primitive with op d <- dstate. (*** TODO: deal with these. - - bitstrings should have conversions to and from bool list - - the generic RO should be defined somewhere else - lining up names and types should be easier than it is... ***) -op to_bits: block -> bool list. - module RP_to_P (O : RP) = { proc init = O.init proc oracle(q : p_query) = { @@ -106,13 +102,12 @@ module SqueezelessSponge (P : Primitive): Construction(P), Functionality = { var (sa,sc) <- (Block.zeros,Capacity.zeros); if (size p >= 1 /\ p <> [Block.zeros]) { - (* Absorption *) - while (p <> []) { + while (p <> []) { (* Absorption *) (sa,sc) <@ P.oracle(F (sa ^ head witness p,sc)); p <- behead p; } } - return sa; + return sa; (* Squeezing phase (non-iterated) *) } }. From e027d2d26c9916cf779e16a4229bbb96c5ad192c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Tue, 15 Sep 2015 16:17:34 +0200 Subject: [PATCH 015/525] Fixing LazyRP. More defs for discussion support. --- proof/LazyRP.eca | 16 +++-- proof/Squeezeless.ec | 157 ++++++++++++++++++++++++++++++++++++++++++- 2 files changed, 167 insertions(+), 6 deletions(-) diff --git a/proof/LazyRP.eca b/proof/LazyRP.eca index 299a80c..578ed7b 100644 --- a/proof/LazyRP.eca +++ b/proof/LazyRP.eca @@ -13,20 +13,26 @@ module P : RP, RP_ = { var m : (D, D) fmap var mi: (D, D) fmap - proc init() = { m = map0; } + proc init() = { m = map0; mi = map0; } proc f(x) = { + var y; + if (!mem (dom m) x) { - m.[x] <$ d \ rng m; - mi.[oget m.[x]] <- x; + y <$ d \ rng m; + m.[x] <- y; + mi.[y] <- x; } return oget m.[x]; } proc fi(x) = { + var y; + if (!mem (dom mi) x) { - mi.[x] <$ d \ rng mi; - m.[oget m.[x]] <- x; + y <$ d \ rng mi; + mi.[x] <- y; + m.[y] <- x; } return oget mi.[x]; } diff --git a/proof/Squeezeless.ec b/proof/Squeezeless.ec index a6a3151..e73acfa 100644 --- a/proof/Squeezeless.ec +++ b/proof/Squeezeless.ec @@ -6,7 +6,7 @@ require import Option Pair Int Real NewList NewFSet NewFMap. require (*..*) AWord LazyRP LazyRO Indifferentiability. (* TODO: Clean up the Bitstring and Word theories -- Make use of those new versions. *) -(*...*) import Dprod. +(*...*) import Dprod Dexcepted. (* TODO: Datatype definitions and distributions should be properly separated and reorganized. *) @@ -157,6 +157,161 @@ module P = RP_to_P(Primitive.P). module F = RO_to_F(H). module S(F : Functionality) = RP_to_P(PreSimulator(F)). +section. + declare module D : Self.Distinguisher {P, F, S, Indif}. + + (** Inlining oracles into the experiment for clarity **) + (* TODO: Drop init from the Distinguisher parameters' signatures *) + local module Ideal = { + var ro : (block list,block) fmap + var m, mi : (state,state) fmap + + module F = { + proc init(): unit = { } + + proc oracle(x : block list): block = { + if (!mem (dom ro) x) { + ro.[x] <$ dblock; + } + return oget ro.[x]; + } + } + + module S = { + proc init(): unit = { } + + proc f(x : state): state = { + var pvo, p, v, h, y; + + if (!mem (dom m) x) { + pvo <- find_chain m x; + if (pvo <> None) { + (p,v) <- oget pvo; + h <@ F.oracle(rcons p v); + y <$ dcapacity; + } else { + (h,y) <$ dstate; + } + m.[x] <- (h,y); + mi.[(h,y)] <- x; + } + return oget m.[x]; + } + + proc fi(x:state) = { + var y; + + if (!mem (dom mi) x) { + y <$ dstate; + mi.[x] <- y; + m.[y] <- x; + } + return oget mi.[x]; + } + + proc oracle(q : p_query): state = { + var r; + + if (is_F q) { + r <@ f(get_query q); + } else { + r <@ fi(get_query q); + } + return r; + } + } + + proc main(): bool = { + var b; + + ro <- map0; + m <- map0; + mi <- map0; + b <@ D(F,S).distinguish(); + return b; + } + }. + + local module Concrete = { + var m, mi: (state,state) fmap + + module P = { + proc init(): unit = { } + + proc f(x : state): state = { + var y; + + if (!mem (dom m) x) { + y <$ dstate \ (rng m); + m.[x] <- y; + mi.[y] <- x; + } + return oget m.[x]; + } + + proc fi(x : state): state = { + var y; + + if (!mem (dom mi) x) { + y <$ dstate \ (rng mi); + mi.[x] <- y; + m.[y] <- x; + } + return oget mi.[x]; + } + + proc oracle(q : p_query): state = { + var r; + + if (is_F q) { + r <@ f(get_query q); + } else { + r <@ fi(get_query q); + } + return r; + } + + } + + module C = { + proc init(): unit = { } + + proc oracle(p : block list): block = { + var (sa,sc) <- (Block.zeros,Capacity.zeros); + + if (size p >= 1 /\ p <> [Block.zeros]) { + while (p <> []) { (* Absorption *) + (sa,sc) <@ P.oracle(F (sa ^ head witness p,sc)); + p <- behead p; + } + } + return sa; (* Squeezing phase (non-iterated) *) + } + } + + proc main(): bool = { + var b; + + m <- map0; + mi <- map0; + b <@ D(C,P).distinguish(); + return b; + } + }. + + (** Result: The adversary's advantage in distinguishing the modular + defs if equal to that of distinguishing these **) + local lemma Inlined_pr &m: + `|Pr[Indif(SqueezelessSponge(P),P,D).main() @ &m: res] + - Pr[Indif(F,S(F),D).main() @ &m: res]| + = `|Pr[Concrete.main() @ &m: res] + - Pr[Ideal.main() @ &m: res]|. + proof. by do !congr; expect 2 (byequiv=> //=; proc; inline *; sim; auto). qed. + + (** And now for the interesting bits **) + (* ... *) +end section. + (* That Self is unfortunate *) lemma PermutationLemma: exists epsilon, From 9eaef4233547d31fc53aedf7a612bf034586f751 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Wed, 16 Sep 2015 13:11:06 +0200 Subject: [PATCH 016/525] Guiding discussion further. Sticking to Canteaut et al for now. Need to reorganize bad events. --- proof/Squeezeless.ec | 212 ++++++++++++++++++++++++++++++++++++++++++- proof/Utils.ec | 15 +++ 2 files changed, 224 insertions(+), 3 deletions(-) create mode 100644 proof/Utils.ec diff --git a/proof/Squeezeless.ec b/proof/Squeezeless.ec index e73acfa..82c74fc 100644 --- a/proof/Squeezeless.ec +++ b/proof/Squeezeless.ec @@ -2,7 +2,7 @@ functionality is a fixed-output-length random oracle whose output length is the input block size. We prove its security even when padding is not prefix-free. **) -require import Option Pair Int Real NewList NewFSet NewFMap. +require import Fun Option Pair Int Real NewList NewFSet NewFMap Utils. require (*..*) AWord LazyRP LazyRO Indifferentiability. (* TODO: Clean up the Bitstring and Word theories -- Make use of those new versions. *) @@ -158,7 +158,7 @@ module F = RO_to_F(H). module S(F : Functionality) = RP_to_P(PreSimulator(F)). section. - declare module D : Self.Distinguisher {P, F, S, Indif}. + declare module D : Self.Distinguisher {P, F, S}. (** Inlining oracles into the experiment for clarity **) (* TODO: Drop init from the Distinguisher parameters' signatures *) @@ -309,7 +309,213 @@ section. proof. by do !congr; expect 2 (byequiv=> //=; proc; inline *; sim; auto). qed. (** And now for the interesting bits **) - (* ... *) + (** Inform the primitive interface of queries made by the + distinguisher on its functionality interface, keep track of + primitive call paths. **) + type caller = [ | I | D ]. + + op (<=) (o1 o2 : caller) = o1 = I \/ o2 = D. + + op max (o1 o2 : caller) = + with o1 = I => o2 + with o1 = D => D. + + local module InstrumentedConcrete = { + var m, mi : (state,caller * state) fmap + var paths : (capacity,caller * (block list * block)) fmap + var bext, bred : bool + var bcoll, bsuff, bmitm : bool + + module P = { + var m, mi : (state,state) fmap + + proc f(x : state): state = { + var y; + + if (!mem (dom m) x) { + y <$ dstate \ (rng m); + m.[x] <- y; + mi.[y] <- x; + } + return oget m.[x]; + } + + proc fi(x : state): state = { + var y; + + if (!mem (dom mi) x) { + y <$ dstate \ (rng mi); + mi.[x] <- y; + m.[y] <- x; + } + return oget mi.[x]; + } + } + + module S = { + (** Inner interface **) + proc f(o : caller, x : state): state = { + var o', y, pv, p, v; + + o' <- oapp fst D paths.[x.`2]; + bext <- bext \/ (o' <= o); + + if (!mem (dom m) x) { + y <@ P.f(x); + if (mem (dom paths) x.`2) { + (o',pv) <- oget paths.[x.`2]; + (p,v) <- pv; + bcoll <- bcoll \/ (mem (dom paths) y.`2); + bsuff <- bsuff \/ (mem (image (snd \o snd) (rng m)) y.`2); + paths.[y.`2] <- (max o o',(rcons p (v ^ x.`1),y.`1)); + } + m.[x] <- (o,y); + mi.[y] <- (o,x); + } else { + (o',y) <- oget m.[x]; + o' <- max o o'; + m.[x] <- (o',y); + mi.[y] <- (o',x); + } + return snd (oget m.[x]); + } + + proc fi(x : state): state = { + var o', y; + + if (!mem (dom mi) x) { + y <@ P.fi(x); + mi.[x] <- (D,y); + m.[y] <- (D,x); + bmitm <- bmitm \/ (mem (dom paths) y.`2); + } else { + (o',y) <- oget mi.[x]; + bred <- bred \/ o' = I; + mi.[x] <- (D,y); + m.[y] <- (D,x); + } + return snd (oget mi.[x]); + } + + (** Distinguisher interface **) + proc init() = { } + + proc oracle(q : p_query): state = { + var r; + + if (is_F q) { + r <@ f(D,get_query q); + } else { + r <@ fi(get_query q); + } + return r; + } + + } + + module C = { + proc init(): unit = { } + + proc oracle(p : block list): block = { + var (sa,sc) <- (Block.zeros,Capacity.zeros); + + if (size p >= 1 /\ p <> [Block.zeros]) { + while (p <> []) { + (sa,sc) <@ S.f(I,(sa ^ head witness p,sc)); + p <- behead p; + } + } + return sa; + } + } + + proc main(): bool = { + var b; + + P.m <- map0; + P.mi <- map0; + m <- map0; + mi <- map0; + paths <- map0; + bext <- false; + bred <- false; + bcoll <- false; + bsuff <- false; + bmitm <- false; + b <@ D(C,S).distinguish(); + return b; + } + }. + + (** Result: the instrumented system and the concrete system are + perfectly equivalent **) + (** This proof is done brutally because it is *just* program verification. *) + local equiv Instrumented_P_S_eq: + Concrete.P.f ~ InstrumentedConcrete.S.f: + arg{1} = arg{2}.`2 + /\ ={m,mi}(Concrete,InstrumentedConcrete.P) + /\ (forall x, InstrumentedConcrete.P.m.[x]{2} = omap snd (InstrumentedConcrete.m.[x]){2}) + /\ (forall x, InstrumentedConcrete.P.mi.[x]{2} = omap snd (InstrumentedConcrete.mi.[x]){2}) + /\ (forall x y, Concrete.m.[x]{1} = Some y <=> Concrete.mi.[y]{1} = Some x) + ==> ={res} + /\ ={m,mi}(Concrete,InstrumentedConcrete.P) + /\ (forall x, InstrumentedConcrete.P.m.[x]{2} = omap snd (InstrumentedConcrete.m.[x]){2}) + /\ (forall x, InstrumentedConcrete.P.mi.[x]{2} = omap snd (InstrumentedConcrete.mi.[x]){2}) + /\ (forall x y, Concrete.m.[x]{1} = Some y <=> Concrete.mi.[y]{1} = Some x). + proof. + proc. inline *. sp; if; 1:smt. + rcondt{2} 2; 1:by auto. + by auto; progress; expect 5 smt. + by auto; progress; expect 3 smt. + qed. + + local equiv Instrumented_Pi_Si_eq: + Concrete.P.fi ~ InstrumentedConcrete.S.fi: + ={arg} + /\ ={m,mi}(Concrete,InstrumentedConcrete.P) + /\ (forall x, InstrumentedConcrete.P.m.[x]{2} = omap snd (InstrumentedConcrete.m.[x]){2}) + /\ (forall x, InstrumentedConcrete.P.mi.[x]{2} = omap snd (InstrumentedConcrete.mi.[x]){2}) + /\ (forall x y, Concrete.m.[x]{1} = Some y <=> Concrete.mi.[y]{1} = Some x) + ==> ={res} + /\ ={m,mi}(Concrete,InstrumentedConcrete.P) + /\ (forall x, InstrumentedConcrete.P.m.[x]{2} = omap snd (InstrumentedConcrete.m.[x]){2}) + /\ (forall x, InstrumentedConcrete.P.mi.[x]{2} = omap snd (InstrumentedConcrete.mi.[x]){2}) + /\ (forall x y, Concrete.m.[x]{1} = Some y <=> Concrete.mi.[y]{1} = Some x). + proof. + proc. inline *. sp; if; 1:smt. + rcondt{2} 2; 1:by auto. + by auto; progress; expect 5 smt. + by auto; progress; expect 3 smt. + qed. + + local lemma Instrumented_pr &m: + `|Pr[Concrete.main() @ &m: res] + - Pr[Ideal.main() @ &m: res]| + = `|Pr[InstrumentedConcrete.main() @ &m: res] + - Pr[Ideal.main() @ &m: res]|. + proof. + do !congr. + byequiv=> //=. + proc. + call (_: ={m,mi}(Concrete,InstrumentedConcrete.P) + /\ (forall x, InstrumentedConcrete.P.m.[x]{2} = omap snd (InstrumentedConcrete.m.[x]){2}) + /\ (forall x, InstrumentedConcrete.P.mi.[x]{2} = omap snd (InstrumentedConcrete.mi.[x]){2}) + /\ (forall x y, Concrete.m.[x]{1} = Some y <=> Concrete.mi.[y]{1} = Some x)). + proc; if=> //=. + by call Instrumented_P_S_eq. + by call Instrumented_Pi_Si_eq. + proc. sp; if=> //=. + while ( ={sa,sc,p} + /\ ={m,mi}(Concrete,InstrumentedConcrete.P) + /\ (forall x, InstrumentedConcrete.P.m.[x]{2} = omap snd (InstrumentedConcrete.m.[x]){2}) + /\ (forall x, InstrumentedConcrete.P.mi.[x]{2} = omap snd (InstrumentedConcrete.mi.[x]){2}) + /\ (forall x y, Concrete.m.[x]{1} = Some y <=> Concrete.mi.[y]{1} = Some x)). + inline Concrete.P.oracle. rcondt{1} 2; 1:by auto. + wp; call Instrumented_P_S_eq. + by auto. + by auto. + by auto; smt. + qed. end section. (* That Self is unfortunate *) diff --git a/proof/Utils.ec b/proof/Utils.ec new file mode 100644 index 0000000..d9d7706 --- /dev/null +++ b/proof/Utils.ec @@ -0,0 +1,15 @@ +(** These should make it into the standard libs **) +require import NewList NewFSet. + +op image (f : 'a -> 'b) (X : 'a fset) = oflist (map f (elems X)) + axiomatized by imageE. + +lemma imageP (f : 'a -> 'b) (X : 'a fset) (b : 'b): + mem (image f X) b <=> exists a, mem X a /\ f a = b. +proof. + rewrite imageE mem_oflist mapP. + (* FIXME *) + by split=> [[a] [a_in_X b_def]| [a] [a_in_X b_def]]; + [rewrite -memE in a_in_X | rewrite memE in a_in_X]; + exists a; rewrite b_def. +qed. \ No newline at end of file From 03a406c58ad351b5bd97e29bdce8b8bd3952ae0e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Wed, 16 Sep 2015 14:31:31 +0200 Subject: [PATCH 017/525] One less redundant data structure. --- proof/Squeezeless.ec | 139 +++++++++++++++++++++++-------------------- 1 file changed, 73 insertions(+), 66 deletions(-) diff --git a/proof/Squeezeless.ec b/proof/Squeezeless.ec index 82c74fc..8026ee7 100644 --- a/proof/Squeezeless.ec +++ b/proof/Squeezeless.ec @@ -311,7 +311,29 @@ section. (** And now for the interesting bits **) (** Inform the primitive interface of queries made by the distinguisher on its functionality interface, keep track of - primitive call paths. **) + primitive call paths in a coloured graph. **) + (** The following invariants should always hold at adversary + boundaries (they may be violated locally, but should always be + fixed (say, by setting bad) before returning control, and the + adversary should not be able to violate them himself): + - if paths[x] = (_,(p,v)), then following path p through m + from (0^r,0^c) leads to state (v,x); (in particular, this + implies (v,x) \in rng m; + - unless bad occurs (identify which ones), for every sc, there + is at most one sa such that (sa,sc) \in rng m; + - unless bad occurs (identify which ones), if paths[x] = + (o,(p,_)) and paths[x'] = (o',(p++p',_)), then o' <= o; + (todo: maybe change the direction of that order relation so + it corresponds to "order of appearance along paths"?) + + The next step in the proof will probably be to eagerly sample + all values of the rate and introduce some indirection on + capacities so that they are only sampled (and propagated) just + before being given to the adversary. This is much easier to do + if we always sample from the full type, but I can't seem to line + up the defs so that introducing the colouring doesn't mess the + "m{1} = omap snd m{2}" invariant. This is TODO. + **) type caller = [ | I | D ]. op (<=) (o1 o2 : caller) = o1 = I \/ o2 = D. @@ -320,38 +342,12 @@ section. with o1 = I => o2 with o1 = D => D. - local module InstrumentedConcrete = { + local module Game0 = { var m, mi : (state,caller * state) fmap var paths : (capacity,caller * (block list * block)) fmap var bext, bred : bool var bcoll, bsuff, bmitm : bool - module P = { - var m, mi : (state,state) fmap - - proc f(x : state): state = { - var y; - - if (!mem (dom m) x) { - y <$ dstate \ (rng m); - m.[x] <- y; - mi.[y] <- x; - } - return oget m.[x]; - } - - proc fi(x : state): state = { - var y; - - if (!mem (dom mi) x) { - y <$ dstate \ (rng mi); - mi.[x] <- y; - m.[y] <- x; - } - return oget mi.[x]; - } - } - module S = { (** Inner interface **) proc f(o : caller, x : state): state = { @@ -361,7 +357,7 @@ section. bext <- bext \/ (o' <= o); if (!mem (dom m) x) { - y <@ P.f(x); + y <$ dstate \ (image snd (rng m)); if (mem (dom paths) x.`2) { (o',pv) <- oget paths.[x.`2]; (p,v) <- pv; @@ -384,7 +380,7 @@ section. var o', y; if (!mem (dom mi) x) { - y <@ P.fi(x); + y <$ dstate \ (image snd (rng mi)); mi.[x] <- (D,y); m.[y] <- (D,x); bmitm <- bmitm \/ (mem (dom paths) y.`2); @@ -432,16 +428,15 @@ section. proc main(): bool = { var b; - P.m <- map0; - P.mi <- map0; m <- map0; mi <- map0; - paths <- map0; bext <- false; bred <- false; bcoll <- false; bsuff <- false; bmitm <- false; + (* the empty path is initially known by the adversary to lead to capacity 0^c *) + paths <- map0.[Capacity.zeros <- (D,([<:block>],Block.zeros))]; b <@ D(C,S).distinguish(); return b; } @@ -450,68 +445,80 @@ section. (** Result: the instrumented system and the concrete system are perfectly equivalent **) (** This proof is done brutally because it is *just* program verification. *) - local equiv Instrumented_P_S_eq: - Concrete.P.f ~ InstrumentedConcrete.S.f: + local equiv Game0_P_S_eq: + Concrete.P.f ~ Game0.S.f: arg{1} = arg{2}.`2 - /\ ={m,mi}(Concrete,InstrumentedConcrete.P) - /\ (forall x, InstrumentedConcrete.P.m.[x]{2} = omap snd (InstrumentedConcrete.m.[x]){2}) - /\ (forall x, InstrumentedConcrete.P.mi.[x]{2} = omap snd (InstrumentedConcrete.mi.[x]){2}) + /\ (forall x, Concrete.m.[x]{1} = omap snd (Game0.m.[x]){2}) + /\ (forall x, Concrete.mi.[x]{1} = omap snd (Game0.mi.[x]){2}) /\ (forall x y, Concrete.m.[x]{1} = Some y <=> Concrete.mi.[y]{1} = Some x) ==> ={res} - /\ ={m,mi}(Concrete,InstrumentedConcrete.P) - /\ (forall x, InstrumentedConcrete.P.m.[x]{2} = omap snd (InstrumentedConcrete.m.[x]){2}) - /\ (forall x, InstrumentedConcrete.P.mi.[x]{2} = omap snd (InstrumentedConcrete.mi.[x]){2}) + /\ (forall x, Concrete.m.[x]{1} = omap snd (Game0.m.[x]){2}) + /\ (forall x, Concrete.mi.[x]{1} = omap snd (Game0.mi.[x]){2}) /\ (forall x y, Concrete.m.[x]{1} = Some y <=> Concrete.mi.[y]{1} = Some x). proof. - proc. inline *. sp; if; 1:smt. - rcondt{2} 2; 1:by auto. - by auto; progress; expect 5 smt. + proc. inline *. + conseq (_: x{1} = x{2} (* FIXME: conseq extend *) + /\ (forall x, Concrete.m.[x]{1} = omap snd (Game0.m.[x]){2}) + /\ (forall x, Concrete.mi.[x]{1} = omap snd (Game0.mi.[x]){2}) + /\ (forall x y, Concrete.m.[x]{1} = Some y <=> Concrete.mi.[y]{1} = Some x) + /\ image snd (rng Game0.m{2}) = rng Concrete.m{1} (* Helper *) + ==> _). + progress. apply fsetP=> x; rewrite imageP in_rng; split=> [[[o s]]|[t]]. + by rewrite in_rng /snd /= => [[t h] ->>] {s}; exists t; rewrite H h. + by rewrite H=> h; exists (oget Game0.m{2}.[t]); smt. + sp; if; 1:smt. + by auto; progress; expect 7 smt. by auto; progress; expect 3 smt. qed. - local equiv Instrumented_Pi_Si_eq: - Concrete.P.fi ~ InstrumentedConcrete.S.fi: + local equiv Game0_Pi_Si_eq: + Concrete.P.fi ~ Game0.S.fi: ={arg} - /\ ={m,mi}(Concrete,InstrumentedConcrete.P) - /\ (forall x, InstrumentedConcrete.P.m.[x]{2} = omap snd (InstrumentedConcrete.m.[x]){2}) - /\ (forall x, InstrumentedConcrete.P.mi.[x]{2} = omap snd (InstrumentedConcrete.mi.[x]){2}) + /\ (forall x, Concrete.m.[x]{1} = omap snd (Game0.m.[x]){2}) + /\ (forall x, Concrete.mi.[x]{1} = omap snd (Game0.mi.[x]){2}) /\ (forall x y, Concrete.m.[x]{1} = Some y <=> Concrete.mi.[y]{1} = Some x) ==> ={res} - /\ ={m,mi}(Concrete,InstrumentedConcrete.P) - /\ (forall x, InstrumentedConcrete.P.m.[x]{2} = omap snd (InstrumentedConcrete.m.[x]){2}) - /\ (forall x, InstrumentedConcrete.P.mi.[x]{2} = omap snd (InstrumentedConcrete.mi.[x]){2}) + /\ (forall x, Concrete.m.[x]{1} = omap snd (Game0.m.[x]){2}) + /\ (forall x, Concrete.mi.[x]{1} = omap snd (Game0.mi.[x]){2}) /\ (forall x y, Concrete.m.[x]{1} = Some y <=> Concrete.mi.[y]{1} = Some x). proof. - proc. inline *. sp; if; 1:smt. - rcondt{2} 2; 1:by auto. - by auto; progress; expect 5 smt. + proc. inline *. + conseq (_: x{1} = x{2} (* FIXME: conseq extend *) + /\ (forall x, Concrete.m.[x]{1} = omap snd (Game0.m.[x]){2}) + /\ (forall x, Concrete.mi.[x]{1} = omap snd (Game0.mi.[x]){2}) + /\ (forall x y, Concrete.m.[x]{1} = Some y <=> Concrete.mi.[y]{1} = Some x) + /\ image snd (rng Game0.mi{2}) = rng Concrete.mi{1} (* Helper *) + ==> _). + progress. apply fsetP=> x; rewrite imageP in_rng; split=> [[[o s]]|[t]]. + by rewrite in_rng /snd /= => [[t h] ->>] {s}; exists t; rewrite H0 h. + by rewrite H0=> h; exists (oget Game0.mi{2}.[t]); smt. + sp; if; 1:smt. + by auto; progress; expect 7 smt. by auto; progress; expect 3 smt. qed. - local lemma Instrumented_pr &m: + local lemma Game0_pr &m: `|Pr[Concrete.main() @ &m: res] - Pr[Ideal.main() @ &m: res]| - = `|Pr[InstrumentedConcrete.main() @ &m: res] + = `|Pr[Game0.main() @ &m: res] - Pr[Ideal.main() @ &m: res]|. proof. do !congr. byequiv=> //=. proc. - call (_: ={m,mi}(Concrete,InstrumentedConcrete.P) - /\ (forall x, InstrumentedConcrete.P.m.[x]{2} = omap snd (InstrumentedConcrete.m.[x]){2}) - /\ (forall x, InstrumentedConcrete.P.mi.[x]{2} = omap snd (InstrumentedConcrete.mi.[x]){2}) + call (_: (forall x, Concrete.m.[x]{1} = omap snd (Game0.m.[x]){2}) + /\ (forall x, Concrete.mi.[x]{1} = omap snd (Game0.mi.[x]){2}) /\ (forall x y, Concrete.m.[x]{1} = Some y <=> Concrete.mi.[y]{1} = Some x)). proc; if=> //=. - by call Instrumented_P_S_eq. - by call Instrumented_Pi_Si_eq. + by call Game0_P_S_eq. + by call Game0_Pi_Si_eq. proc. sp; if=> //=. while ( ={sa,sc,p} - /\ ={m,mi}(Concrete,InstrumentedConcrete.P) - /\ (forall x, InstrumentedConcrete.P.m.[x]{2} = omap snd (InstrumentedConcrete.m.[x]){2}) - /\ (forall x, InstrumentedConcrete.P.mi.[x]{2} = omap snd (InstrumentedConcrete.mi.[x]){2}) + /\ (forall x, Concrete.m.[x]{1} = omap snd (Game0.m.[x]){2}) + /\ (forall x, Concrete.mi.[x]{1} = omap snd (Game0.mi.[x]){2}) /\ (forall x y, Concrete.m.[x]{1} = Some y <=> Concrete.mi.[y]{1} = Some x)). inline Concrete.P.oracle. rcondt{1} 2; 1:by auto. - wp; call Instrumented_P_S_eq. + wp; call Game0_P_S_eq. by auto. by auto. by auto; smt. From b9fd5d2535b9e7c95e96321d0e7ff4acd8af5bc2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Wed, 16 Sep 2015 17:24:48 +0200 Subject: [PATCH 018/525] Moving away from permutation. Assumed RP_RF transition, plus modifications to Game0 to recover the invariant. --- proof/Squeezeless.ec | 171 ++++++++++++++++++++++++++++++------------- 1 file changed, 121 insertions(+), 50 deletions(-) diff --git a/proof/Squeezeless.ec b/proof/Squeezeless.ec index 8026ee7..dc26cae 100644 --- a/proof/Squeezeless.ec +++ b/proof/Squeezeless.ec @@ -308,6 +308,81 @@ section. - Pr[Ideal.main() @ &m: res]|. proof. by do !congr; expect 2 (byequiv=> //=; proc; inline *; sim; auto). qed. + (** An intermediate game where we don't care about the permutation + being a bijection anymore... **) + local module Concrete_F = { + var m, mi: (state,state) fmap + + module P = { + proc init(): unit = { } + + proc f(x : state): state = { + var y; + + if (!mem (dom m) x) { + y <$ dstate; + m.[x] <- y; + mi.[y] <- x; + } + return oget m.[x]; + } + + proc fi(x : state): state = { + var y; + + if (!mem (dom mi) x) { + y <$ dstate; + mi.[x] <- y; + m.[y] <- x; + } + return oget mi.[x]; + } + + proc oracle(q : p_query): state = { + var r; + + if (is_F q) { + r <@ f(get_query q); + } else { + r <@ fi(get_query q); + } + return r; + } + + } + + module C = { + proc init(): unit = { } + + proc oracle(p : block list): block = { + var (sa,sc) <- (Block.zeros,Capacity.zeros); + + if (size p >= 1 /\ p <> [Block.zeros]) { + while (p <> []) { (* Absorption *) + (sa,sc) <@ P.oracle(F (sa ^ head witness p,sc)); + p <- behead p; + } + } + return sa; (* Squeezing phase (non-iterated) *) + } + } + + proc main(): bool = { + var b; + + m <- map0; + mi <- map0; + b <@ D(C,P).distinguish(); + return b; + } + }. + + (** Result (expected): The distance between Concrete and Concrete_F + is bounded by N^2/|state|, where N is the total cost (in terms + of queries to P and P^-1) of the adversary's queries **) + + (** TODO: express and prove **) + (** And now for the interesting bits **) (** Inform the primitive interface of queries made by the distinguisher on its functionality interface, keep track of @@ -329,10 +404,9 @@ section. The next step in the proof will probably be to eagerly sample all values of the rate and introduce some indirection on capacities so that they are only sampled (and propagated) just - before being given to the adversary. This is much easier to do - if we always sample from the full type, but I can't seem to line - up the defs so that introducing the colouring doesn't mess the - "m{1} = omap snd m{2}" invariant. This is TODO. + before being given to the adversary. This is easier to do if all + samplings are independent, hence the move away from a random + permutation. Some side-effects remain worrying. **) type caller = [ | I | D ]. @@ -351,13 +425,13 @@ section. module S = { (** Inner interface **) proc f(o : caller, x : state): state = { - var o', y, pv, p, v; + var o', y, pv, p, v, x'; o' <- oapp fst D paths.[x.`2]; bext <- bext \/ (o' <= o); if (!mem (dom m) x) { - y <$ dstate \ (image snd (rng m)); + y <$ dstate; if (mem (dom paths) x.`2) { (o',pv) <- oget paths.[x.`2]; (p,v) <- pv; @@ -368,27 +442,32 @@ section. m.[x] <- (o,y); mi.[y] <- (o,x); } else { - (o',y) <- oget m.[x]; - o' <- max o o'; - m.[x] <- (o',y); - mi.[y] <- (o',x); + (o',y) <- oget m.[x]; + m.[x] <- (max o o',y); + if (mem (dom mi) y) { + (o',x') <- oget mi.[y]; + mi.[y] <- (max o o',x'); + } } return snd (oget m.[x]); } proc fi(x : state): state = { - var o', y; + var o', y, x'; if (!mem (dom mi) x) { - y <$ dstate \ (image snd (rng mi)); + y <$ dstate; mi.[x] <- (D,y); m.[y] <- (D,x); bmitm <- bmitm \/ (mem (dom paths) y.`2); } else { - (o',y) <- oget mi.[x]; - bred <- bred \/ o' = I; - mi.[x] <- (D,y); - m.[y] <- (D,x); + (o',y) <- oget mi.[x]; + bred <- bred \/ o' = I; + mi.[x] <- (D,y); + if (mem (dom m) y) { + (o',x') <- oget m.[y]; + m.[y] <- (D,x'); + } } return snd (oget mi.[x]); } @@ -446,59 +525,53 @@ section. perfectly equivalent **) (** This proof is done brutally because it is *just* program verification. *) local equiv Game0_P_S_eq: - Concrete.P.f ~ Game0.S.f: + Concrete_F.P.f ~ Game0.S.f: arg{1} = arg{2}.`2 - /\ (forall x, Concrete.m.[x]{1} = omap snd (Game0.m.[x]){2}) - /\ (forall x, Concrete.mi.[x]{1} = omap snd (Game0.mi.[x]){2}) - /\ (forall x y, Concrete.m.[x]{1} = Some y <=> Concrete.mi.[y]{1} = Some x) + /\ (forall x, Concrete_F.m.[x]{1} = omap snd (Game0.m.[x]){2}) + /\ (forall x, Concrete_F.mi.[x]{1} = omap snd (Game0.mi.[x]){2}) ==> ={res} - /\ (forall x, Concrete.m.[x]{1} = omap snd (Game0.m.[x]){2}) - /\ (forall x, Concrete.mi.[x]{1} = omap snd (Game0.mi.[x]){2}) - /\ (forall x y, Concrete.m.[x]{1} = Some y <=> Concrete.mi.[y]{1} = Some x). + /\ (forall x, Concrete_F.m.[x]{1} = omap snd (Game0.m.[x]){2}) + /\ (forall x, Concrete_F.mi.[x]{1} = omap snd (Game0.mi.[x]){2}). proof. proc. inline *. conseq (_: x{1} = x{2} (* FIXME: conseq extend *) - /\ (forall x, Concrete.m.[x]{1} = omap snd (Game0.m.[x]){2}) - /\ (forall x, Concrete.mi.[x]{1} = omap snd (Game0.mi.[x]){2}) - /\ (forall x y, Concrete.m.[x]{1} = Some y <=> Concrete.mi.[y]{1} = Some x) - /\ image snd (rng Game0.m{2}) = rng Concrete.m{1} (* Helper *) + /\ (forall x, Concrete_F.m.[x]{1} = omap snd (Game0.m.[x]){2}) + /\ (forall x, Concrete_F.mi.[x]{1} = omap snd (Game0.mi.[x]){2}) + /\ image snd (rng Game0.m{2}) = rng Concrete_F.m{1} (* Helper *) ==> _). progress. apply fsetP=> x; rewrite imageP in_rng; split=> [[[o s]]|[t]]. by rewrite in_rng /snd /= => [[t h] ->>] {s}; exists t; rewrite H h. by rewrite H=> h; exists (oget Game0.m{2}.[t]); smt. sp; if; 1:smt. - by auto; progress; expect 7 smt. - by auto; progress; expect 3 smt. + by auto; progress; expect 3 smt. + by auto; progress; expect 5 smt. qed. local equiv Game0_Pi_Si_eq: - Concrete.P.fi ~ Game0.S.fi: + Concrete_F.P.fi ~ Game0.S.fi: ={arg} - /\ (forall x, Concrete.m.[x]{1} = omap snd (Game0.m.[x]){2}) - /\ (forall x, Concrete.mi.[x]{1} = omap snd (Game0.mi.[x]){2}) - /\ (forall x y, Concrete.m.[x]{1} = Some y <=> Concrete.mi.[y]{1} = Some x) + /\ (forall x, Concrete_F.m.[x]{1} = omap snd (Game0.m.[x]){2}) + /\ (forall x, Concrete_F.mi.[x]{1} = omap snd (Game0.mi.[x]){2}) ==> ={res} - /\ (forall x, Concrete.m.[x]{1} = omap snd (Game0.m.[x]){2}) - /\ (forall x, Concrete.mi.[x]{1} = omap snd (Game0.mi.[x]){2}) - /\ (forall x y, Concrete.m.[x]{1} = Some y <=> Concrete.mi.[y]{1} = Some x). + /\ (forall x, Concrete_F.m.[x]{1} = omap snd (Game0.m.[x]){2}) + /\ (forall x, Concrete_F.mi.[x]{1} = omap snd (Game0.mi.[x]){2}). proof. proc. inline *. conseq (_: x{1} = x{2} (* FIXME: conseq extend *) - /\ (forall x, Concrete.m.[x]{1} = omap snd (Game0.m.[x]){2}) - /\ (forall x, Concrete.mi.[x]{1} = omap snd (Game0.mi.[x]){2}) - /\ (forall x y, Concrete.m.[x]{1} = Some y <=> Concrete.mi.[y]{1} = Some x) - /\ image snd (rng Game0.mi{2}) = rng Concrete.mi{1} (* Helper *) + /\ (forall x, Concrete_F.m.[x]{1} = omap snd (Game0.m.[x]){2}) + /\ (forall x, Concrete_F.mi.[x]{1} = omap snd (Game0.mi.[x]){2}) + /\ image snd (rng Game0.mi{2}) = rng Concrete_F.mi{1} (* Helper *) ==> _). progress. apply fsetP=> x; rewrite imageP in_rng; split=> [[[o s]]|[t]]. by rewrite in_rng /snd /= => [[t h] ->>] {s}; exists t; rewrite H0 h. by rewrite H0=> h; exists (oget Game0.mi{2}.[t]); smt. sp; if; 1:smt. - by auto; progress; expect 7 smt. - by auto; progress; expect 3 smt. + by auto; progress; expect 3 smt. + by auto; progress; expect 5 smt. qed. local lemma Game0_pr &m: - `|Pr[Concrete.main() @ &m: res] + `|Pr[Concrete_F.main() @ &m: res] - Pr[Ideal.main() @ &m: res]| = `|Pr[Game0.main() @ &m: res] - Pr[Ideal.main() @ &m: res]|. @@ -506,18 +579,16 @@ section. do !congr. byequiv=> //=. proc. - call (_: (forall x, Concrete.m.[x]{1} = omap snd (Game0.m.[x]){2}) - /\ (forall x, Concrete.mi.[x]{1} = omap snd (Game0.mi.[x]){2}) - /\ (forall x y, Concrete.m.[x]{1} = Some y <=> Concrete.mi.[y]{1} = Some x)). + call (_: (forall x, Concrete_F.m.[x]{1} = omap snd (Game0.m.[x]){2}) + /\ (forall x, Concrete_F.mi.[x]{1} = omap snd (Game0.mi.[x]){2})). proc; if=> //=. by call Game0_P_S_eq. by call Game0_Pi_Si_eq. proc. sp; if=> //=. while ( ={sa,sc,p} - /\ (forall x, Concrete.m.[x]{1} = omap snd (Game0.m.[x]){2}) - /\ (forall x, Concrete.mi.[x]{1} = omap snd (Game0.mi.[x]){2}) - /\ (forall x y, Concrete.m.[x]{1} = Some y <=> Concrete.mi.[y]{1} = Some x)). - inline Concrete.P.oracle. rcondt{1} 2; 1:by auto. + /\ (forall x, Concrete_F.m.[x]{1} = omap snd (Game0.m.[x]){2}) + /\ (forall x, Concrete_F.mi.[x]{1} = omap snd (Game0.mi.[x]){2})). + inline Concrete_F.P.oracle. rcondt{1} 2; 1:by auto. wp; call Game0_P_S_eq. by auto. by auto. From fbe1c4d3ab3860d0de803792c087b1c312b551df Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Thu, 17 Sep 2015 14:12:05 +0200 Subject: [PATCH 019/525] Game0: refining the invariant slightly to simplify book keeping code. --- proof/Squeezeless.ec | 68 +++++++++++++++++++++++++++++++++----------- proof/Utils.ec | 20 +++++++++++-- 2 files changed, 70 insertions(+), 18 deletions(-) diff --git a/proof/Squeezeless.ec b/proof/Squeezeless.ec index dc26cae..86b4fbd 100644 --- a/proof/Squeezeless.ec +++ b/proof/Squeezeless.ec @@ -444,10 +444,8 @@ section. } else { (o',y) <- oget m.[x]; m.[x] <- (max o o',y); - if (mem (dom mi) y) { - (o',x') <- oget mi.[y]; - mi.[y] <- (max o o',x'); - } + (o',x') <- oget mi.[y]; + mi.[y] <- (max o o',x'); } return snd (oget m.[x]); } @@ -464,10 +462,8 @@ section. (o',y) <- oget mi.[x]; bred <- bred \/ o' = I; mi.[x] <- (D,y); - if (mem (dom m) y) { - (o',x') <- oget m.[y]; - m.[y] <- (D,x'); - } + (o',x') <- oget m.[y]; + m.[y] <- (D,x'); } return snd (oget mi.[x]); } @@ -529,22 +525,40 @@ section. arg{1} = arg{2}.`2 /\ (forall x, Concrete_F.m.[x]{1} = omap snd (Game0.m.[x]){2}) /\ (forall x, Concrete_F.mi.[x]{1} = omap snd (Game0.mi.[x]){2}) + /\ (forall x, mem (rng Concrete_F.m){1} x => mem (dom Concrete_F.mi){1} x) + /\ (forall x, mem (rng Concrete_F.mi){1} x => mem (dom Concrete_F.m){1} x) ==> ={res} /\ (forall x, Concrete_F.m.[x]{1} = omap snd (Game0.m.[x]){2}) - /\ (forall x, Concrete_F.mi.[x]{1} = omap snd (Game0.mi.[x]){2}). + /\ (forall x, Concrete_F.mi.[x]{1} = omap snd (Game0.mi.[x]){2}) + /\ (forall x, mem (rng Concrete_F.m){1} x => mem (dom Concrete_F.mi){1} x) + /\ (forall x, mem (rng Concrete_F.mi){1} x => mem (dom Concrete_F.m){1} x). proof. proc. inline *. conseq (_: x{1} = x{2} (* FIXME: conseq extend *) /\ (forall x, Concrete_F.m.[x]{1} = omap snd (Game0.m.[x]){2}) /\ (forall x, Concrete_F.mi.[x]{1} = omap snd (Game0.mi.[x]){2}) + /\ (forall x, mem (rng Concrete_F.m){1} x => mem (dom Concrete_F.mi){1} x) + /\ (forall x, mem (rng Concrete_F.mi){1} x => mem (dom Concrete_F.m){1} x) /\ image snd (rng Game0.m{2}) = rng Concrete_F.m{1} (* Helper *) ==> _). progress. apply fsetP=> x; rewrite imageP in_rng; split=> [[[o s]]|[t]]. by rewrite in_rng /snd /= => [[t h] ->>] {s}; exists t; rewrite H h. by rewrite H=> h; exists (oget Game0.m{2}.[t]); smt. sp; if; 1:smt. - by auto; progress; expect 3 smt. - by auto; progress; expect 5 smt. + auto; progress; first 3 smt. + + by move: H7; rewrite domP rng_set !in_fsetU !in_fset1 rem_id // => [/H1 ->|->]. + move: H7; rewrite rng_set domP !in_fsetU !in_fset1; case (x0 = x{2})=> [->> //|x0_neq_x /=]. + + by move=> h; apply/H2/(rng_rem_le yL). + auto; progress; first 2 smt. + (** FIXME: Refine the invariant enough that the following becomes easier to prove? **) + have ->: (oget Game0.m.[x]){2}.`2 = oget Concrete_F.m{1}.[x{2}] by smt. + move: H4; rewrite in_dom. + case {-1}(Concrete_F.m{1}.[x{2}]) (eq_refl Concrete_F.m{1}.[x{2}])=> //= x' h. + rewrite/(oget (Some _))/=. + have ->: (oget Game0.mi.[x']){2}.`2 = oget Concrete_F.mi{1}.[x'] by smt. + rewrite getP; case (x0 = x')=> [<<-/=|/= _]. + by rewrite /snd /=; smt. (* x0 \in dom mi{1} (by H1 and h) *) + exact/H0. qed. local equiv Game0_Pi_Si_eq: @@ -552,22 +566,40 @@ section. ={arg} /\ (forall x, Concrete_F.m.[x]{1} = omap snd (Game0.m.[x]){2}) /\ (forall x, Concrete_F.mi.[x]{1} = omap snd (Game0.mi.[x]){2}) + /\ (forall x, mem (rng Concrete_F.m){1} x => mem (dom Concrete_F.mi){1} x) + /\ (forall x, mem (rng Concrete_F.mi){1} x => mem (dom Concrete_F.m){1} x) ==> ={res} /\ (forall x, Concrete_F.m.[x]{1} = omap snd (Game0.m.[x]){2}) - /\ (forall x, Concrete_F.mi.[x]{1} = omap snd (Game0.mi.[x]){2}). + /\ (forall x, Concrete_F.mi.[x]{1} = omap snd (Game0.mi.[x]){2}) + /\ (forall x, mem (rng Concrete_F.m){1} x => mem (dom Concrete_F.mi){1} x) + /\ (forall x, mem (rng Concrete_F.mi){1} x => mem (dom Concrete_F.m){1} x). proof. proc. inline *. conseq (_: x{1} = x{2} (* FIXME: conseq extend *) /\ (forall x, Concrete_F.m.[x]{1} = omap snd (Game0.m.[x]){2}) /\ (forall x, Concrete_F.mi.[x]{1} = omap snd (Game0.mi.[x]){2}) + /\ (forall x, mem (rng Concrete_F.m){1} x => mem (dom Concrete_F.mi){1} x) + /\ (forall x, mem (rng Concrete_F.mi){1} x => mem (dom Concrete_F.m){1} x) /\ image snd (rng Game0.mi{2}) = rng Concrete_F.mi{1} (* Helper *) ==> _). progress. apply fsetP=> x; rewrite imageP in_rng; split=> [[[o s]]|[t]]. by rewrite in_rng /snd /= => [[t h] ->>] {s}; exists t; rewrite H0 h. by rewrite H0=> h; exists (oget Game0.mi{2}.[t]); smt. sp; if; 1:smt. - by auto; progress; expect 3 smt. - by auto; progress; expect 5 smt. + auto; progress; first 3 by smt. + + move: H7; rewrite domP rng_set !in_fsetU !in_fset1; case (x0 = x{2})=> [->> //|x0_neq_x /=]. + by move=> h; apply/H1/(rng_rem_le yL). + + by move: H7; rewrite domP rng_set !in_fsetU !in_fset1 rem_id // => [/H2 ->|->]. + auto; progress; 1,3:smt. + (** FIXME: Refine the invariant enough that the following becomes easier to prove? **) + have ->: (oget Game0.mi.[x]){2}.`2 = oget Concrete_F.mi{1}.[x{2}] by smt. + move: H4; rewrite in_dom. + case {-1}(Concrete_F.mi{1}.[x{2}]) (eq_refl Concrete_F.mi{1}.[x{2}])=> //= x' h. + rewrite/(oget (Some _))/=. + have ->: (oget Game0.m.[x']){2}.`2 = oget Concrete_F.m{1}.[x'] by smt. + rewrite getP; case (x0 = x')=> [<<-/=|/= _]. + by rewrite /snd /=; smt. (* x0 \in dom mi{1} (by H1 and h) *) + exact/H. qed. local lemma Game0_pr &m: @@ -580,14 +612,18 @@ section. byequiv=> //=. proc. call (_: (forall x, Concrete_F.m.[x]{1} = omap snd (Game0.m.[x]){2}) - /\ (forall x, Concrete_F.mi.[x]{1} = omap snd (Game0.mi.[x]){2})). + /\ (forall x, Concrete_F.mi.[x]{1} = omap snd (Game0.mi.[x]){2}) + /\ (forall x, mem (rng Concrete_F.m){1} x => mem (dom Concrete_F.mi){1} x) + /\ (forall x, mem (rng Concrete_F.mi){1} x => mem (dom Concrete_F.m){1} x)). proc; if=> //=. by call Game0_P_S_eq. by call Game0_Pi_Si_eq. proc. sp; if=> //=. while ( ={sa,sc,p} /\ (forall x, Concrete_F.m.[x]{1} = omap snd (Game0.m.[x]){2}) - /\ (forall x, Concrete_F.mi.[x]{1} = omap snd (Game0.mi.[x]){2})). + /\ (forall x, Concrete_F.mi.[x]{1} = omap snd (Game0.mi.[x]){2}) + /\ (forall x, mem (rng Concrete_F.m){1} x => mem (dom Concrete_F.mi){1} x) + /\ (forall x, mem (rng Concrete_F.mi){1} x => mem (dom Concrete_F.m){1} x)). inline Concrete_F.P.oracle. rcondt{1} 2; 1:by auto. wp; call Game0_P_S_eq. by auto. diff --git a/proof/Utils.ec b/proof/Utils.ec index d9d7706..573c8c6 100644 --- a/proof/Utils.ec +++ b/proof/Utils.ec @@ -1,5 +1,5 @@ (** These should make it into the standard libs **) -require import NewList NewFSet. +require import NewList NewFSet NewFMap. op image (f : 'a -> 'b) (X : 'a fset) = oflist (map f (elems X)) axiomatized by imageE. @@ -12,4 +12,20 @@ proof. by split=> [[a] [a_in_X b_def]| [a] [a_in_X b_def]]; [rewrite -memE in a_in_X | rewrite memE in a_in_X]; exists a; rewrite b_def. -qed. \ No newline at end of file +qed. + +lemma rem_id (x : 'a) (m : ('a,'b) fmap): + !mem (dom m) x => rem x m = m. +proof. + rewrite in_dom /= => x_notin_m; apply/fmapP=> x'; rewrite remP. + case (x' = x)=> //= ->>. + by rewrite x_notin_m. +qed. + +lemma dom_rem_le (x : 'a) (m : ('a,'b) fmap) (x' : 'a): + mem (dom (rem x m)) x' => mem (dom m) x'. +proof. by rewrite dom_rem in_fsetD. qed. + +lemma rng_rem_le (x : 'a) (m : ('a,'b) fmap) (x' : 'b): + mem (rng (rem x m)) x' => mem (rng m) x'. +proof. by rewrite rng_rm in_rng=> [x0] [_ h]; exists x0. qed. From 79cf949bb32891e6286e29cf9431bb291a0c1e8b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Mon, 21 Sep 2015 15:01:29 +0200 Subject: [PATCH 020/525] SHA3: splitting maps for fun and profit. - Completely separated the map associating query origin to query; - Proved equivalence of simulator with split rate and capacity maps. The second point above should allow us to easily pre-sample all rates (visible by both adversary and ideal functionality), and use indirections for capacities. Such indirections should then allow us to perform eager sampling on capacities. --- proof/Squeezeless.ec | 407 +++++++++++++++++++++++++++++++------------ 1 file changed, 293 insertions(+), 114 deletions(-) diff --git a/proof/Squeezeless.ec b/proof/Squeezeless.ec index 86b4fbd..aa9cb5e 100644 --- a/proof/Squeezeless.ec +++ b/proof/Squeezeless.ec @@ -300,7 +300,7 @@ section. }. (** Result: The adversary's advantage in distinguishing the modular - defs if equal to that of distinguishing these **) + defs is equal to that of distinguishing these **) local lemma Inlined_pr &m: `|Pr[Indif(SqueezelessSponge(P),P,D).main() @ &m: res] - Pr[Indif(F,S(F),D).main() @ &m: res]| @@ -416,56 +416,86 @@ section. with o1 = I => o2 with o1 = D => D. + pred is_pre_permutation (m mi : ('a,'a) fmap) = + (forall x, mem (rng m) x => mem (dom mi) x) + /\ (forall x, mem (rng mi) x => mem (dom m) x). + + lemma half_permutation_set (m' mi' : ('a,'a) fmap) x' y': + (forall x, mem (rng m') x => mem (dom mi') x) + => (forall x, mem (rng m'.[x' <- y']) x => mem (dom mi'.[y' <- x']) x). + proof. + move=> h x0. + rewrite rng_set domP !in_fsetU in_fset1 => [/rng_rem_le in_rng|//=]. + by rewrite h. + qed. + + lemma pre_permutation_set (m mi : ('a,'a) fmap) x y: + is_pre_permutation m mi => + is_pre_permutation m.[x <- y] mi.[y <- x]. + proof. + move=> [dom_mi dom_m]. + by split; apply/half_permutation_set. + qed. + local module Game0 = { - var m, mi : (state,caller * state) fmap - var paths : (capacity,caller * (block list * block)) fmap + var m, mi : (state,state) fmap + var mcol, micol : (state,caller) fmap (* colouring maps for m, mi *) + var paths : (capacity,block list * block) fmap + var pathscol : (capacity,caller) fmap (* colouring maps for paths *) var bext, bred : bool var bcoll, bsuff, bmitm : bool module S = { (** Inner interface **) proc f(o : caller, x : state): state = { - var o', y, pv, p, v, x'; + var o', y, pv, p, v; - o' <- oapp fst D paths.[x.`2]; + o' <- odflt D pathscol.[x.`2]; bext <- bext \/ (o' <= o); if (!mem (dom m) x) { y <$ dstate; if (mem (dom paths) x.`2) { - (o',pv) <- oget paths.[x.`2]; - (p,v) <- pv; - bcoll <- bcoll \/ (mem (dom paths) y.`2); - bsuff <- bsuff \/ (mem (image (snd \o snd) (rng m)) y.`2); - paths.[y.`2] <- (max o o',(rcons p (v ^ x.`1),y.`1)); + o' <- oget pathscol.[x.`2]; + pv <- oget paths.[x.`2]; + (p,v) <- pv; + bcoll <- bcoll \/ (mem (dom paths) y.`2); + bsuff <- bsuff \/ (mem (image snd (rng m)) y.`2); + pathscol.[y.`2] <- max o o'; + paths.[y.`2] <- (rcons p (v ^ x.`1),y.`1); } - m.[x] <- (o,y); - mi.[y] <- (o,x); + mcol.[x] <- o; + m.[x] <- y; + micol.[y] <- o; + mi.[y] <- x; } else { - (o',y) <- oget m.[x]; - m.[x] <- (max o o',y); - (o',x') <- oget mi.[y]; - mi.[y] <- (max o o',x'); + o' <- oget mcol.[x]; + mcol.[x] <- max o o'; + y <- oget m.[x]; + o' <- oget micol.[y]; + micol.[y] <- max o o'; } - return snd (oget m.[x]); + return oget m.[x]; } proc fi(x : state): state = { - var o', y, x'; + var o', y; if (!mem (dom mi) x) { y <$ dstate; - mi.[x] <- (D,y); - m.[y] <- (D,x); - bmitm <- bmitm \/ (mem (dom paths) y.`2); + micol.[x] <- D; + mi.[x] <- y; + mcol.[y] <- D; + m.[y] <- x; + bmitm <- bmitm \/ (mem (dom paths) y.`2); } else { - (o',y) <- oget mi.[x]; - bred <- bred \/ o' = I; - mi.[x] <- (D,y); - (o',x') <- oget m.[y]; - m.[y] <- (D,x'); + o' <- oget micol.[x]; + bred <- bred \/ o' = I; + y <- oget mi.[x]; + micol.[x] <- D; + mcol.[y] <- D; } - return snd (oget mi.[x]); + return oget mi.[x]; } (** Distinguisher interface **) @@ -503,103 +533,53 @@ section. proc main(): bool = { var b; - m <- map0; - mi <- map0; - bext <- false; - bred <- false; - bcoll <- false; - bsuff <- false; - bmitm <- false; + mcol <- map0; + m <- map0; + micol <- map0; + mi <- map0; + bext <- false; + bred <- false; + bcoll <- false; + bsuff <- false; + bmitm <- false; (* the empty path is initially known by the adversary to lead to capacity 0^c *) - paths <- map0.[Capacity.zeros <- (D,([<:block>],Block.zeros))]; - b <@ D(C,S).distinguish(); + pathscol <- map0.[Capacity.zeros <- D]; + paths <- map0.[Capacity.zeros <- ([<:block>],Block.zeros)]; + b <@ D(C,S).distinguish(); return b; } }. (** Result: the instrumented system and the concrete system are perfectly equivalent **) - (** This proof is done brutally because it is *just* program verification. *) local equiv Game0_P_S_eq: Concrete_F.P.f ~ Game0.S.f: arg{1} = arg{2}.`2 - /\ (forall x, Concrete_F.m.[x]{1} = omap snd (Game0.m.[x]){2}) - /\ (forall x, Concrete_F.mi.[x]{1} = omap snd (Game0.mi.[x]){2}) - /\ (forall x, mem (rng Concrete_F.m){1} x => mem (dom Concrete_F.mi){1} x) - /\ (forall x, mem (rng Concrete_F.mi){1} x => mem (dom Concrete_F.m){1} x) + /\ ={m,mi}(Concrete_F,Game0) + /\ is_pre_permutation (Concrete_F.m){1} (Concrete_F.mi){1} ==> ={res} - /\ (forall x, Concrete_F.m.[x]{1} = omap snd (Game0.m.[x]){2}) - /\ (forall x, Concrete_F.mi.[x]{1} = omap snd (Game0.mi.[x]){2}) - /\ (forall x, mem (rng Concrete_F.m){1} x => mem (dom Concrete_F.mi){1} x) - /\ (forall x, mem (rng Concrete_F.mi){1} x => mem (dom Concrete_F.m){1} x). + /\ ={m,mi}(Concrete_F,Game0) + /\ is_pre_permutation (Concrete_F.m){1} (Concrete_F.mi){1}. proof. proc. inline *. - conseq (_: x{1} = x{2} (* FIXME: conseq extend *) - /\ (forall x, Concrete_F.m.[x]{1} = omap snd (Game0.m.[x]){2}) - /\ (forall x, Concrete_F.mi.[x]{1} = omap snd (Game0.mi.[x]){2}) - /\ (forall x, mem (rng Concrete_F.m){1} x => mem (dom Concrete_F.mi){1} x) - /\ (forall x, mem (rng Concrete_F.mi){1} x => mem (dom Concrete_F.m){1} x) - /\ image snd (rng Game0.m{2}) = rng Concrete_F.m{1} (* Helper *) - ==> _). - progress. apply fsetP=> x; rewrite imageP in_rng; split=> [[[o s]]|[t]]. - by rewrite in_rng /snd /= => [[t h] ->>] {s}; exists t; rewrite H h. - by rewrite H=> h; exists (oget Game0.m{2}.[t]); smt. - sp; if; 1:smt. - auto; progress; first 3 smt. - + by move: H7; rewrite domP rng_set !in_fsetU !in_fset1 rem_id // => [/H1 ->|->]. - move: H7; rewrite rng_set domP !in_fsetU !in_fset1; case (x0 = x{2})=> [->> //|x0_neq_x /=]. - + by move=> h; apply/H2/(rng_rem_le yL). - auto; progress; first 2 smt. - (** FIXME: Refine the invariant enough that the following becomes easier to prove? **) - have ->: (oget Game0.m.[x]){2}.`2 = oget Concrete_F.m{1}.[x{2}] by smt. - move: H4; rewrite in_dom. - case {-1}(Concrete_F.m{1}.[x{2}]) (eq_refl Concrete_F.m{1}.[x{2}])=> //= x' h. - rewrite/(oget (Some _))/=. - have ->: (oget Game0.mi.[x']){2}.`2 = oget Concrete_F.mi{1}.[x'] by smt. - rewrite getP; case (x0 = x')=> [<<-/=|/= _]. - by rewrite /snd /=; smt. (* x0 \in dom mi{1} (by H1 and h) *) - exact/H0. + sp; if=> //=; 2:by auto. + auto; progress [-split]. + by rewrite pre_permutation_set. qed. local equiv Game0_Pi_Si_eq: Concrete_F.P.fi ~ Game0.S.fi: ={arg} - /\ (forall x, Concrete_F.m.[x]{1} = omap snd (Game0.m.[x]){2}) - /\ (forall x, Concrete_F.mi.[x]{1} = omap snd (Game0.mi.[x]){2}) - /\ (forall x, mem (rng Concrete_F.m){1} x => mem (dom Concrete_F.mi){1} x) - /\ (forall x, mem (rng Concrete_F.mi){1} x => mem (dom Concrete_F.m){1} x) + /\ ={m,mi}(Concrete_F,Game0) + /\ is_pre_permutation (Concrete_F.m){1} (Concrete_F.mi){1} ==> ={res} - /\ (forall x, Concrete_F.m.[x]{1} = omap snd (Game0.m.[x]){2}) - /\ (forall x, Concrete_F.mi.[x]{1} = omap snd (Game0.mi.[x]){2}) - /\ (forall x, mem (rng Concrete_F.m){1} x => mem (dom Concrete_F.mi){1} x) - /\ (forall x, mem (rng Concrete_F.mi){1} x => mem (dom Concrete_F.m){1} x). + /\ ={m,mi}(Concrete_F,Game0) + /\ is_pre_permutation (Concrete_F.m){1} (Concrete_F.mi){1}. proof. proc. inline *. - conseq (_: x{1} = x{2} (* FIXME: conseq extend *) - /\ (forall x, Concrete_F.m.[x]{1} = omap snd (Game0.m.[x]){2}) - /\ (forall x, Concrete_F.mi.[x]{1} = omap snd (Game0.mi.[x]){2}) - /\ (forall x, mem (rng Concrete_F.m){1} x => mem (dom Concrete_F.mi){1} x) - /\ (forall x, mem (rng Concrete_F.mi){1} x => mem (dom Concrete_F.m){1} x) - /\ image snd (rng Game0.mi{2}) = rng Concrete_F.mi{1} (* Helper *) - ==> _). - progress. apply fsetP=> x; rewrite imageP in_rng; split=> [[[o s]]|[t]]. - by rewrite in_rng /snd /= => [[t h] ->>] {s}; exists t; rewrite H0 h. - by rewrite H0=> h; exists (oget Game0.mi{2}.[t]); smt. - sp; if; 1:smt. - auto; progress; first 3 by smt. - + move: H7; rewrite domP rng_set !in_fsetU !in_fset1; case (x0 = x{2})=> [->> //|x0_neq_x /=]. - by move=> h; apply/H1/(rng_rem_le yL). - + by move: H7; rewrite domP rng_set !in_fsetU !in_fset1 rem_id // => [/H2 ->|->]. - auto; progress; 1,3:smt. - (** FIXME: Refine the invariant enough that the following becomes easier to prove? **) - have ->: (oget Game0.mi.[x]){2}.`2 = oget Concrete_F.mi{1}.[x{2}] by smt. - move: H4; rewrite in_dom. - case {-1}(Concrete_F.mi{1}.[x{2}]) (eq_refl Concrete_F.mi{1}.[x{2}])=> //= x' h. - rewrite/(oget (Some _))/=. - have ->: (oget Game0.m.[x']){2}.`2 = oget Concrete_F.m{1}.[x'] by smt. - rewrite getP; case (x0 = x')=> [<<-/=|/= _]. - by rewrite /snd /=; smt. (* x0 \in dom mi{1} (by H1 and h) *) - exact/H. + sp; if=> //=; 2:by auto. + auto; progress [-split]. + by rewrite pre_permutation_set. qed. local lemma Game0_pr &m: @@ -611,25 +591,224 @@ section. do !congr. byequiv=> //=. proc. - call (_: (forall x, Concrete_F.m.[x]{1} = omap snd (Game0.m.[x]){2}) - /\ (forall x, Concrete_F.mi.[x]{1} = omap snd (Game0.mi.[x]){2}) - /\ (forall x, mem (rng Concrete_F.m){1} x => mem (dom Concrete_F.mi){1} x) - /\ (forall x, mem (rng Concrete_F.mi){1} x => mem (dom Concrete_F.m){1} x)). + call (_: ={m,mi}(Concrete_F,Game0) + /\ is_pre_permutation Concrete_F.m{1} Concrete_F.mi{1}). proc; if=> //=. - by call Game0_P_S_eq. - by call Game0_Pi_Si_eq. - proc. sp; if=> //=. + + by call Game0_P_S_eq. + + by call Game0_Pi_Si_eq. + + proc. sp; if=> //=. while ( ={sa,sc,p} - /\ (forall x, Concrete_F.m.[x]{1} = omap snd (Game0.m.[x]){2}) - /\ (forall x, Concrete_F.mi.[x]{1} = omap snd (Game0.mi.[x]){2}) - /\ (forall x, mem (rng Concrete_F.m){1} x => mem (dom Concrete_F.mi){1} x) - /\ (forall x, mem (rng Concrete_F.mi){1} x => mem (dom Concrete_F.m){1} x)). + /\ ={m,mi}(Concrete_F,Game0) + /\ is_pre_permutation Concrete_F.m{1} Concrete_F.mi{1}). inline Concrete_F.P.oracle. rcondt{1} 2; 1:by auto. wp; call Game0_P_S_eq. by auto. by auto. by auto; smt. qed. + + (** Split the simulator map into distinct rate and capacity maps **) + pred map_split (m0 : (state,state) fmap) (a1 : (state,block) fmap) (c1 : (state,capacity) fmap) = + (forall x, mem (dom m0) x = mem (dom a1) x) + /\ (forall x, mem (dom m0) x = mem (dom c1) x) + /\ (forall x, mem (dom m0) x => m0.[x] = Some (oget a1.[x],oget c1.[x])). + + lemma map_split_set m0 a1 c1 s a c: + map_split m0 a1 c1 => + map_split m0.[s <- (a,c)] a1.[s <- a] c1.[s <- c] + by []. + + local module Game1 = { + var mcol,micol : (state,caller) fmap + var rate, ratei : (state,block) fmap + var cap, capi : (state,capacity) fmap + var pathscol : (capacity,caller) fmap + var paths : (capacity,block list * block) fmap + var bext, bred : bool + var bcoll, bsuff, bmitm : bool + + module S = { + (** Inner interface **) + proc f(o : caller, x : state): state = { + var o', ya, yc, pv, p, v; + + o' <- odflt D pathscol.[x.`2]; + bext <- bext \/ (o' <= o); + + if (!mem (dom rate) x) { + (ya,yc) <$ dstate; + if (mem (dom paths) x.`2) { + o' <- oget pathscol.[x.`2]; + pv <- oget paths.[x.`2]; + (p,v) <- pv; + bcoll <- bcoll \/ (mem (dom paths) yc); + bsuff <- bsuff \/ (mem (rng cap) yc); + pathscol.[yc] <- max o o'; + paths.[yc] <- (rcons p (v ^ x.`1),ya); + } + rate.[x] <- ya; + ratei.[(ya,yc)] <- x.`1; + cap.[x] <- yc; + capi.[(ya,yc)] <- x.`2; + mcol.[x] <- o; + micol.[(ya,yc)] <- o; + } else { + o' <- oget mcol.[x]; + mcol.[x] <- max o o'; + ya <- oget rate.[x]; + yc <- oget cap.[x]; + o' <- oget micol.[(ya,yc)]; + micol.[(ya,yc)] <- max o o'; + } + return (oget rate.[x],oget cap.[x]); + } + + proc fi(x : state): state = { + var ya, yc; + + if (!mem (dom ratei) x) { + (ya,yc) <$ dstate; + micol.[x] <- D; + ratei.[x] <- ya; + capi.[x] <- yc; + mcol.[(ya,yc)] <- D; + rate.[(ya,yc)] <- x.`1; + cap.[(ya,yc)] <- x.`2; + bmitm <- bmitm \/ (mem (dom paths) yc); + } else { + bred <- bred \/ oget micol.[x] = I; + micol.[x] <- D; + ya <- oget ratei.[x]; + yc <- oget capi.[x]; + mcol.[(ya,yc)] <- D; + } + return (oget ratei.[x],oget capi.[x]); + } + + (** Distinguisher interface **) + proc init() = { } + + proc oracle(q : p_query): state = { + var r; + + if (is_F q) { + r <@ f(D,get_query q); + } else { + r <@ fi(get_query q); + } + return r; + } + + } + + module C = { + proc init(): unit = { } + + proc oracle(p : block list): block = { + var (sa,sc) <- (Block.zeros,Capacity.zeros); + + if (size p >= 1 /\ p <> [Block.zeros]) { + while (p <> []) { + (sa,sc) <@ S.f(I,(sa ^ head witness p,sc)); + p <- behead p; + } + } + return sa; + } + } + + proc main(): bool = { + var b; + + mcol <- map0; + micol <- map0; + rate <- map0; + ratei <- map0; + cap <- map0; + capi <- map0; + bext <- false; + bred <- false; + bcoll <- false; + bsuff <- false; + bmitm <- false; + (* the empty path is initially known by the adversary to lead to capacity 0^c *) + pathscol <- map0.[Capacity.zeros <- D]; + paths <- map0.[Capacity.zeros <- ([<:block>],Block.zeros)]; + b <@ D(C,S).distinguish(); + return b; + } + }. + + local equiv Game1_S_S_eq: + Game0.S.f ~ Game1.S.f: + ={arg} + /\ ={pathscol,paths}(Game0,Game1) + /\ map_split Game0.m{1} Game1.rate{2} Game1.cap{2} + /\ map_split Game0.mi{1} Game1.ratei{2} Game1.capi{2} + /\ is_pre_permutation (Game0.m){1} (Game0.mi){1} + ==> ={res} + /\ ={pathscol,paths}(Game0,Game1) + /\ map_split Game0.m{1} Game1.rate{2} Game1.cap{2} + /\ map_split Game0.mi{1} Game1.ratei{2} Game1.capi{2} + /\ is_pre_permutation (Game0.m){1} (Game0.mi){1}. + proof. + proc. inline *. + sp; if; 1:by progress [-split]; move: H=> [->]. + + auto; progress [-split]. + move: H3; case yL=> ya yc H3; case (x{2})=> xa xc. + by rewrite !getP_eq !map_split_set ?pre_permutation_set. + + auto; progress [-split]. + rewrite H H0 H1 /=. + by move: H=> [_ [_ ->]]. + qed. + + local equiv Game1_Si_Si_eq: + Game0.S.fi ~ Game1.S.fi: + ={arg} + /\ ={pathscol,paths}(Game0,Game1) + /\ map_split Game0.m{1} Game1.rate{2} Game1.cap{2} + /\ map_split Game0.mi{1} Game1.ratei{2} Game1.capi{2} + /\ is_pre_permutation (Game0.m){1} (Game0.mi){1} + ==> ={res} + /\ ={pathscol,paths}(Game0,Game1) + /\ map_split Game0.m{1} Game1.rate{2} Game1.cap{2} + /\ map_split Game0.mi{1} Game1.ratei{2} Game1.capi{2} + /\ is_pre_permutation (Game0.m){1} (Game0.mi){1}. + proof. + proc. inline *. + sp; if; 1:by progress [-split]; move: H0=> [->]. + + auto; progress [-split]. + move: H3; case yL=> ya yc H3; case (x{2})=> xa xc. + by rewrite !getP_eq !map_split_set ?pre_permutation_set. + + auto; progress [-split]. + rewrite H H0 H1 /=. + by move: H0=> [_ [_ ->]]. + qed. + + local lemma Game1_pr &m: + `|Pr[Game0.main() @ &m: res] + - Pr[Ideal.main() @ &m: res]| + = `|Pr[Game1.main() @ &m: res] + - Pr[Ideal.main() @ &m: res]|. + proof. + do !congr. byequiv=> //=; proc. + call (_: ={pathscol,paths}(Game0,Game1) + /\ map_split Game0.m{1} Game1.rate{2} Game1.cap{2} + /\ map_split Game0.mi{1} Game1.ratei{2} Game1.capi{2} + /\ is_pre_permutation Game0.m{1} Game0.mi{1}). + proc; if=> //=. + + by call Game1_S_S_eq. + + by call Game1_Si_Si_eq. + + proc; sp; if=> //=. + while ( ={sa,sc,p} + /\ ={pathscol,paths}(Game0,Game1) + /\ map_split Game0.m{1} Game1.rate{2} Game1.cap{2} + /\ map_split Game0.mi{1} Game1.ratei{2} Game1.capi{2} + /\ is_pre_permutation Game0.m{1} Game0.mi{1}). + by wp; call Game1_S_S_eq. + done. + by auto; smt. + qed. end section. (* That Self is unfortunate *) From 0eff3d0351a953458ef88713336cc6e4b13e0a17 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Wed, 23 Sep 2015 16:27:21 +0200 Subject: [PATCH 021/525] add generic reduction for padding --- proof/IndifPadding.ec | 134 ++++++++++++++++++++++++++++++++++++++++++ proof/Sponge.ec | 2 +- 2 files changed, 135 insertions(+), 1 deletion(-) create mode 100644 proof/IndifPadding.ec diff --git a/proof/IndifPadding.ec b/proof/IndifPadding.ec new file mode 100644 index 0000000..b1fec65 --- /dev/null +++ b/proof/IndifPadding.ec @@ -0,0 +1,134 @@ +require import Real NewFMap Fun. +require (*..*) Indifferentiability LazyRO. + +clone import Indifferentiability as Ind1. + +clone import Indifferentiability as Ind2 + with type p_in <- Ind1.p_in, + type p_out <- Ind1.p_out, + type f_out <- Ind1.f_out. + +op pad : Ind2.f_in -> Ind1.f_in. +op padinv : Ind1.f_in -> Ind2.f_in. +axiom cancel_pad : cancel pad padinv. +axiom cancel_padinv : cancel padinv pad. + +clone import LazyRO as RO1 + with type from <- Ind1.f_in, + type to <- Ind1.f_out. + +clone import LazyRO as RO2 + with type from <- Ind2.f_in, + type to <- Ind1.f_out, + op d <- RO1.d. + +module HF1 = { + proc init = RO1.H.init + proc oracle = RO1.H.f +}. + +module HF2 = { + proc init = RO2.H.init + proc oracle = RO2.H.f +}. + +module ConstrPad (FC:Ind1.Construction, P:Ind1.Primitive) = { + module C = FC(P) + + proc init = C.init + + proc oracle (x:Ind2.f_in) : f_out = { + var r; + r = C.oracle(pad x); + return r; + } +}. + +module DistPad(FD: Ind2.Distinguisher, F:Ind1.Functionality, P:Ind1.Primitive) = { + module Fpad = { + proc init = F.init + + proc oracle(x:Ind2.f_in) : f_out = { + var r; + r = F.oracle(pad x); + return r; + } + } + + module Dpad = FD(Fpad, P) + + proc distinguish = Dpad.distinguish +}. + +module SimPadinv(S:Ind1.Simulator, F2:Ind2.Functionality) = { + module F1 = { + proc init = F2.init + proc oracle(x:Ind1.f_in):Ind1.f_out = { + var r; + r = F2.oracle(padinv x); + return r; + } + } + + module S2 = S(F1) + + proc init = S2.init + + proc oracle = S2.oracle + }. + +section Reduction. + + declare module P : Ind1.Primitive. (* It is compatible with Ind2.Primitive *) + declare module C : Ind1.Construction {P}. + declare module S : Ind1.Simulator{ RO1.H, RO2.H}. + + declare module D' : Ind2.Distinguisher{P,C, RO1.H, RO2.H, S}. + + equiv ConstrDistPad: + Ind2.Indif(ConstrPad(C,P), P, D').main ~ + Ind1.Indif(C(P), P, DistPad(D')).main : ={glob P, glob C, glob D'} ==> + ={glob P, glob C, glob D', res}. + proof. by proc;sim. qed. + + lemma PrConstrDistPad &m: + Pr[ Ind2.Indif(ConstrPad(C,P), P, D').main() @ &m : res] = + Pr[ Ind1.Indif(C(P), P, DistPad(D')).main() @ &m : res]. + proof. by byequiv ConstrDistPad. qed. + + equiv DistH2H1: + Ind2.Indif(HF2,SimPadinv(S,HF2),D').main ~ + Ind1.Indif(HF1,S(HF1), DistPad(D')).main : + ={glob D', glob S} ==> + ={glob D',glob S, res} /\ forall x, RO2.H.m{1}.[padinv x] = RO1.H.m{2}.[x]. + proof. + proc. + call (_: ={glob S} /\ forall x, RO2.H.m{1}.[padinv x] = RO1.H.m{2}.[x]). + + proc *;inline *. + call (_: forall x, RO2.H.m{1}.[padinv x] = RO1.H.m{2}.[x]);auto. + proc;inline *;wp;sp;if;first by progress [-split];rewrite !in_dom H. + + auto;progress;first by rewrite !getP_eq. + by rewrite !getP (can_eq _ _ cancel_padinv) H. + by auto;progress;rewrite H. + + proc;inline *;wp;sp;if;first by progress[-split];rewrite -{1}(cancel_pad x{2}) !in_dom H. + + auto;progress;first by rewrite !getP_eq. + by rewrite !getP (eq_sym x1) (can2_eq _ _ cancel_pad cancel_padinv) (eq_sym x{2}) H. + by auto;progress;rewrite -H cancel_pad. + inline *;wp. call (_: ={glob D'});first by sim. + auto;progress;by rewrite !map0P. + qed. + + lemma PrDistH2H1 &m: + Pr[Ind2.Indif(HF2,SimPadinv(S,HF2),D').main() @ &m : res] = + Pr[Ind1.Indif(HF1,S(HF1), DistPad(D')).main() @ &m : res]. + proof. by byequiv DistH2H1. qed. + + lemma Conclusion &m: + `| Pr[ Ind2.Indif(ConstrPad(C,P), P, D').main() @ &m : res] - + Pr[Ind2.Indif(HF2,SimPadinv(S,HF2),D').main() @ &m : res] | = + `| Pr[ Ind1.Indif(C(P), P, DistPad(D')).main() @ &m : res] - + Pr[Ind1.Indif(HF1,S(HF1), DistPad(D')).main() @ &m : res] |. + proof. by rewrite (PrConstrDistPad &m) (PrDistH2H1 &m). qed. + +end section Reduction. + diff --git a/proof/Sponge.ec b/proof/Sponge.ec index fc66d8f..7d91e06 100644 --- a/proof/Sponge.ec +++ b/proof/Sponge.ec @@ -236,7 +236,7 @@ module Truncator(F : BlockSponge): Self.Functionality = { if (size p >= 1 /\ nth witness p ( size p - 1) <> Self.Block.zeros) { bs <@ F.oracle(p,n /% r); - z <- z ++ flatten (map to_bits bs); + z <- flatten (map to_bits bs); } return take n z; From 0b9905dfe67cbae5494bdef8df1f852e371f21b7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Wed, 23 Sep 2015 18:34:52 +0200 Subject: [PATCH 022/525] Minor things. --- proof/IndifPadding.ec | 33 ++++++++++++++------------------- 1 file changed, 14 insertions(+), 19 deletions(-) diff --git a/proof/IndifPadding.ec b/proof/IndifPadding.ec index b1fec65..db95efd 100644 --- a/proof/IndifPadding.ec +++ b/proof/IndifPadding.ec @@ -1,4 +1,4 @@ -require import Real NewFMap Fun. +require import Fun Pair Real NewFMap. require (*..*) Indifferentiability LazyRO. clone import Indifferentiability as Ind1. @@ -13,11 +13,11 @@ op padinv : Ind1.f_in -> Ind2.f_in. axiom cancel_pad : cancel pad padinv. axiom cancel_padinv : cancel padinv pad. -clone import LazyRO as RO1 +clone import LazyRO as RO1 with type from <- Ind1.f_in, type to <- Ind1.f_out. -clone import LazyRO as RO2 +clone import LazyRO as RO2 with type from <- Ind2.f_in, type to <- Ind1.f_out, op d <- RO1.d. @@ -54,10 +54,8 @@ module DistPad(FD: Ind2.Distinguisher, F:Ind1.Functionality, P:Ind1.Primitive) = return r; } } - - module Dpad = FD(Fpad, P) - proc distinguish = Dpad.distinguish + proc distinguish = FD(Fpad,P).distinguish }. module SimPadinv(S:Ind1.Simulator, F2:Ind2.Functionality) = { @@ -75,34 +73,33 @@ module SimPadinv(S:Ind1.Simulator, F2:Ind2.Functionality) = { proc init = S2.init proc oracle = S2.oracle - }. +}. section Reduction. - declare module P : Ind1.Primitive. (* It is compatible with Ind2.Primitive *) declare module C : Ind1.Construction {P}. declare module S : Ind1.Simulator{ RO1.H, RO2.H}. declare module D' : Ind2.Distinguisher{P,C, RO1.H, RO2.H, S}. - equiv ConstrDistPad: + local equiv ConstrDistPad: Ind2.Indif(ConstrPad(C,P), P, D').main ~ Ind1.Indif(C(P), P, DistPad(D')).main : ={glob P, glob C, glob D'} ==> ={glob P, glob C, glob D', res}. - proof. by proc;sim. qed. + proof. by sim. qed. - lemma PrConstrDistPad &m: + local lemma PrConstrDistPad &m: Pr[ Ind2.Indif(ConstrPad(C,P), P, D').main() @ &m : res] = Pr[ Ind1.Indif(C(P), P, DistPad(D')).main() @ &m : res]. proof. by byequiv ConstrDistPad. qed. - - equiv DistH2H1: + + local equiv DistH2H1: Ind2.Indif(HF2,SimPadinv(S,HF2),D').main ~ - Ind1.Indif(HF1,S(HF1), DistPad(D')).main : - ={glob D', glob S} ==> + Ind1.Indif(HF1,S(HF1), DistPad(D')).main : + ={glob D', glob S} ==> ={glob D',glob S, res} /\ forall x, RO2.H.m{1}.[padinv x] = RO1.H.m{2}.[x]. proof. - proc. + proc. call (_: ={glob S} /\ forall x, RO2.H.m{1}.[padinv x] = RO1.H.m{2}.[x]). + proc *;inline *. call (_: forall x, RO2.H.m{1}.[padinv x] = RO1.H.m{2}.[x]);auto. @@ -118,7 +115,7 @@ section Reduction. auto;progress;by rewrite !map0P. qed. - lemma PrDistH2H1 &m: + local lemma PrDistH2H1 &m: Pr[Ind2.Indif(HF2,SimPadinv(S,HF2),D').main() @ &m : res] = Pr[Ind1.Indif(HF1,S(HF1), DistPad(D')).main() @ &m : res]. proof. by byequiv DistH2H1. qed. @@ -129,6 +126,4 @@ section Reduction. `| Pr[ Ind1.Indif(C(P), P, DistPad(D')).main() @ &m : res] - Pr[Ind1.Indif(HF1,S(HF1), DistPad(D')).main() @ &m : res] |. proof. by rewrite (PrConstrDistPad &m) (PrDistH2H1 &m). qed. - end section Reduction. - From ec4d406b4247030168e40eb00401be0c7750e3fe Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Sat, 26 Sep 2015 12:42:14 +0200 Subject: [PATCH 023/525] Some more lemmas that may be useful. --- proof/Utils.ec | 64 +++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 63 insertions(+), 1 deletion(-) diff --git a/proof/Utils.ec b/proof/Utils.ec index 573c8c6..5517692 100644 --- a/proof/Utils.ec +++ b/proof/Utils.ec @@ -1,6 +1,8 @@ (** These should make it into the standard libs **) -require import NewList NewFSet NewFMap. +require import Pair NewList NewFSet NewFMap. +(* -------------------------------------------------------------------- *) +(* In NewFSet *) op image (f : 'a -> 'b) (X : 'a fset) = oflist (map f (elems X)) axiomatized by imageE. @@ -29,3 +31,63 @@ proof. by rewrite dom_rem in_fsetD. qed. lemma rng_rem_le (x : 'a) (m : ('a,'b) fmap) (x' : 'b): mem (rng (rem x m)) x' => mem (rng m) x'. proof. by rewrite rng_rm in_rng=> [x0] [_ h]; exists x0. qed. + + +(* -------------------------------------------------------------------- *) +(* In NewFMap *) +op reindex (f : 'a -> 'c) (m : ('a, 'b) fmap) = + NewFMap.oflist (map (fun (x : 'a * 'b) => (f x.`1,x.`2)) (elems m)) + axiomatized by reindexE. + +lemma dom_reindex (f : 'a -> 'c) (m : ('a, 'b) fmap) x: + mem (dom (reindex f m)) x <=> mem (image f (dom m)) x. +proof. + rewrite reindexE dom_oflist imageP mapP /fst; split. + move=> [[x' y] [+ ->>]]. + rewrite mapP=> [[x0 y0]] /= [h [->> ->>]] {x' y}. + by exists x0; rewrite domE mem_oflist mapP /fst; exists (x0,y0). + move=> [a] [a_in_m <<-]. + exists (f a,oget m.[a])=> /=; rewrite mapP /=. + exists (a,oget m.[a])=> //=. + have:= a_in_m; rewrite in_dom; case {-1}(m.[a]) (eq_refl m.[a])=> //=. + by move=> y; rewrite getE mem_assoc_uniq 1:uniq_keys. +qed. + +require import Fun. + +lemma reindex_injective_on (f : 'a -> 'c) (m : ('a, 'b) fmap): + (forall x y, mem (dom m) x => f x = f y => x = y) => + (forall x, m.[x] = (reindex f m).[f x]). +proof. + move=> f_pinj x. + pose s:= elems (reindex f m). + case (assocP s (f x)). + rewrite -dom_oflist {1}/s elemsK dom_reindex imageP. + move=> [[a]] [] /f_pinj h /(h x) ->> {a}. + rewrite !getE. + move=> [y] [+ ->]. + rewrite /s reindexE. + pose s':= map (fun (x : 'a * 'b) => (f x.`1,x.`2)) (elems m). + have <- := (perm_eq_mem _ _ (oflistK s')). + (** FIXME: make this a lemma **) + have h' /h': forall (s : ('c * 'b) list) x, mem (reduce s) x => mem s x. + rewrite /reduce=> s0 x0; rewrite -{2}(cat0s s0); pose acc:= []. + elim s0 acc x0=> {s'} [acc x0 /=|x' s' ih acc x0 /=]. + by rewrite cats0. + move=> /ih; rewrite -cat1s catA cats1 !mem_cat=> [|-> //=]. + rewrite /augment; case (mem (map fst acc) x'.`1)=> _ h'; left=> //. + by rewrite mem_rcons /=; right. + rewrite /s' mapP=> [[a' b']] /= [xy_in_m []]. + rewrite eq_sym. have h0 /h0 ->> <<- {a' b'}:= f_pinj a' x _; 1:by smt. + by apply/mem_assoc_uniq; 1:exact uniq_keys. + rewrite -mem_oflist {1}/s -domE=> [] h; have := h; rewrite dom_reindex. + rewrite imageP=> h'. have {h'} h': forall (a : 'a), !mem (dom m) a \/ f a <> f x by smt. + have /= := h' x. + rewrite in_dom !getE /=. + by move=> -> ->. +qed. + +lemma reindex_injective (f : 'a -> 'c) (m : ('a, 'b) fmap): + injective f => + (forall x, m.[x] = (reindex f m).[f x]). +proof. by move=> f_inj; apply/reindex_injective_on=> + + _. qed. From 5dd9d228e0a555738ca5a5a6a5a10c53430557c6 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Thu, 1 Oct 2015 09:57:15 +0200 Subject: [PATCH 024/525] small change + Generic theories for Random Oracle. --- proof/IndifPadding.ec | 35 ++-- proof/Indifferentiability.eca | 4 +- proof/LazyRO.eca | 2 +- proof/RO.eca | 369 +++++++++++++++++++++++++++++++++- 4 files changed, 384 insertions(+), 26 deletions(-) diff --git a/proof/IndifPadding.ec b/proof/IndifPadding.ec index db95efd..3a47891 100644 --- a/proof/IndifPadding.ec +++ b/proof/IndifPadding.ec @@ -22,16 +22,6 @@ clone import LazyRO as RO2 type to <- Ind1.f_out, op d <- RO1.d. -module HF1 = { - proc init = RO1.H.init - proc oracle = RO1.H.f -}. - -module HF2 = { - proc init = RO2.H.init - proc oracle = RO2.H.f -}. - module ConstrPad (FC:Ind1.Construction, P:Ind1.Primitive) = { module C = FC(P) @@ -83,19 +73,19 @@ section Reduction. declare module D' : Ind2.Distinguisher{P,C, RO1.H, RO2.H, S}. local equiv ConstrDistPad: - Ind2.Indif(ConstrPad(C,P), P, D').main ~ - Ind1.Indif(C(P), P, DistPad(D')).main : ={glob P, glob C, glob D'} ==> + Ind2.Real(P, ConstrPad(C), D').main ~ + Ind1.Real(P, C, DistPad(D')).main : ={glob P, glob C, glob D'} ==> ={glob P, glob C, glob D', res}. proof. by sim. qed. local lemma PrConstrDistPad &m: - Pr[ Ind2.Indif(ConstrPad(C,P), P, D').main() @ &m : res] = - Pr[ Ind1.Indif(C(P), P, DistPad(D')).main() @ &m : res]. + Pr[ Ind2.Real(P,ConstrPad(C), D').main() @ &m : res] = + Pr[ Ind1.Real(P,C,DistPad(D')).main() @ &m : res]. proof. by byequiv ConstrDistPad. qed. local equiv DistH2H1: - Ind2.Indif(HF2,SimPadinv(S,HF2),D').main ~ - Ind1.Indif(HF1,S(HF1), DistPad(D')).main : + Ind2.Ideal(RO2.H, SimPadinv(S), D').main ~ + Ind1.Ideal(RO1.H, S, DistPad(D')).main : ={glob D', glob S} ==> ={glob D',glob S, res} /\ forall x, RO2.H.m{1}.[padinv x] = RO1.H.m{2}.[x]. proof. @@ -116,14 +106,15 @@ section Reduction. qed. local lemma PrDistH2H1 &m: - Pr[Ind2.Indif(HF2,SimPadinv(S,HF2),D').main() @ &m : res] = - Pr[Ind1.Indif(HF1,S(HF1), DistPad(D')).main() @ &m : res]. + Pr[Ind2.Ideal(RO2.H,SimPadinv(S),D').main() @ &m : res] = + Pr[Ind1.Ideal(RO1.H,S, DistPad(D')).main() @ &m : res]. proof. by byequiv DistH2H1. qed. lemma Conclusion &m: - `| Pr[ Ind2.Indif(ConstrPad(C,P), P, D').main() @ &m : res] - - Pr[Ind2.Indif(HF2,SimPadinv(S,HF2),D').main() @ &m : res] | = - `| Pr[ Ind1.Indif(C(P), P, DistPad(D')).main() @ &m : res] - - Pr[Ind1.Indif(HF1,S(HF1), DistPad(D')).main() @ &m : res] |. + `| Pr[Ind2.Real (P , ConstrPad(C), D').main() @ &m : res] - + Pr[Ind2.Ideal(RO2.H, SimPadinv(S), D').main() @ &m : res] | = + `| Pr[Ind1.Real(P , C, DistPad(D')).main() @ &m : res] - + Pr[Ind1.Ideal(RO1.H, S, DistPad(D')).main() @ &m : res] |. proof. by rewrite (PrConstrDistPad &m) (PrDistH2H1 &m). qed. + end section Reduction. diff --git a/proof/Indifferentiability.eca b/proof/Indifferentiability.eca index ca782a8..a4a3659 100644 --- a/proof/Indifferentiability.eca +++ b/proof/Indifferentiability.eca @@ -45,9 +45,11 @@ module Indif (F : Functionality, P : Primitive, D : Distinguisher) = { } }. +module Real(P:Primitive, C:Construction) = Indif(C(P),P). +module Ideal(F:Functionality, S:Simulator) = Indif(F,S(F)). (* (C <: Construction) applied to (P <: Primitive) is indifferentiable from (F <: Functionality) if there exists (S <: Simulator) such that, for all (D <: Distinguisher), - | Pr[Indif(C(P),P,D): res] - Pr[Indif(F,S(F),D): res] | is small. + | Pr[Real(P,C,D): res] - Pr[Ideal(F,S,D): res] | is small. We avoid the existential by providing a concrete construction for S and the `small` by providing a concrete bound. *) diff --git a/proof/LazyRO.eca b/proof/LazyRO.eca index 80d090c..d9784b4 100644 --- a/proof/LazyRO.eca +++ b/proof/LazyRO.eca @@ -13,7 +13,7 @@ module H : RO, RO_ = { proc init() = { m = map0; } - proc f(x) = { + proc oracle(x) = { if (!mem (dom m) x) m.[x] = $d; return oget m.[x]; } diff --git a/proof/RO.eca b/proof/RO.eca index 3bf0d3b..8d90a89 100644 --- a/proof/RO.eca +++ b/proof/RO.eca @@ -1,12 +1,17 @@ +require import NewFMap. +(* TODO move this in NewFMap *) +lemma dom_set (m:('a,'b) fmap) a b : dom m.[a<-b] = dom m `|` fset1 a. +proof. by apply fsetP=> x;smt. qed. + type from, to. module type RO = { proc init() : unit - proc f(x : from): to + proc oracle(x : from): to }. module type RO_ = { - proc f(x : from): to + proc oracle(x : from): to }. module type Distinguisher(G : RO_) = { @@ -22,3 +27,363 @@ module IND(G:RO, D:Distinguisher) = { return b; } }. + +abstract theory Ideal. + + op sample : from -> to distr. + + module RO = { + var m : (from, to) fmap + + proc init() : unit = { + m <- map0; + } + + proc oracle(x : from) : to = { + var rd; + rd <$ sample x; + if (! mem (dom m) x) m.[x] <- rd; + return oget m.[x]; + } + }. + + section LL. + + axiom sample_ll : forall x, Distr.weight (sample x) = 1%r. + + lemma oracle_ll : phoare[RO.oracle : true ==> true] = 1%r. + proof. proc;auto;progress;apply sample_ll. qed. + + end section LL. + +end Ideal. + + +abstract theory GenIdeal. + + clone include Ideal. + axiom sample_ll : forall x, Distr.weight (sample x) = 1%r. + + op RO_dom : from fset. + + module ERO = { + proc sample() = { + var work; + work <- RO_dom; + while (work <> fset0) { + RO.oracle(pick work); + work = work `\` fset1 (pick work); + } + } + + proc init() = { + RO.m <- map0; + sample(); + } + + proc oracle = RO.oracle + }. + + module IND_S(D:Distinguisher) = { + proc main(): bool = { + var b; + RO.init(); + b <@ D(RO).distinguish(); + ERO.sample(); + return b; + } + }. + + section EAGER. + + local lemma eager_query: + eager [ERO.sample(); , RO.oracle ~ ERO.oracle, ERO.sample(); : + ={x,RO.m} ==> ={res,RO.m} ]. + proof. + eager proc. + inline ERO.sample;swap{2} 4 -3. + seq 1 1: (={x,work,RO.m});first by sim. + wp;case ((mem (dom RO.m) x){1}). + + rnd{1}. + alias{1} 1 mx = oget RO.m.[x]. + while (={work,RO.m} /\ (RO.m.[x] = Some mx){1}). + + by inline *;auto;progress;smt. + auto;progress [- split]; rewrite sample_ll H /=;smt. + case ((!mem work x){1}). + + swap{1} 2 -1;while (={work,x} /\ eq_except RO.m{1} RO.m{2} (fset1 x{1}) /\ + (!mem work x){1} /\ (RO.m.[x] = Some rd){2} /\ (!mem (dom RO.m) x){1}). + + inline *;auto;progress [-split]. + cut -> : mem (dom RO.m{2}) (pick work{2}) = mem (dom RO.m{1}) (pick work{2}) by rewrite !in_dom;smt. + smt. + auto;progress [-split];rewrite !getP_eq;smt. + inline RO.oracle. + transitivity{1} { rd <$ sample x; + while (work <> fset0) { + x0 <- pick work; + rd0 <$ sample x0; + if (!mem (dom RO.m) x0) + RO.m.[x0] <- if x0 = x then rd else rd0; + work <- work `\` fset1 (pick work); + } } + (={x,work,RO.m} ==> ={x,RO.m}) + ((={x,work,RO.m} /\ mem work{1} x{1}) /\ ! mem (dom RO.m{2}) x{2} ==> + ={x,RO.m} /\ (result = oget RO.m.[x]){2} /\ mem (dom RO.m{1}) x{1}) => //. + + by move=> &1 &2 H; exists RO.m{2}, x{2}, work{2}; generalize H. + + transitivity{1} { while (work <> fset0) { + x0 <- pick work; + rd0 <$ sample x0; + if (!mem (dom RO.m) x0) RO.m.[x0] <- rd0; + work <- work `\` fset1 (pick work); + } + rd <$ sample x; } + (={x,work,RO.m} ==> ={x,RO.m}) + (={x,work,RO.m} ==> ={x,RO.m})=> //. + + by move=> &1 &2 H; exists RO.m{2}, x{2}, work{2}; generalize H. + + by sim; rnd{2}; sim : (={x,IND_Eager.H.m}); smt. + symmetry; eager while (H: rd <$ sample x; ~ rd <$ sample x; : ={x} ==> ={rd})=> //; sim. + swap{2} 5 -4; swap [2..3] -1; case ((x = pick work){1}). + + by wp; rnd{2}; rnd; rnd{1}; wp; skip; smt. + by auto; smt. + + while (={x, work} /\ + (!mem work x => mem (dom RO.m) x){1} /\ + RO.m.[x]{2} = Some rd{1} /\ + if (mem (dom RO.m) x){1} then ={RO.m} + else eq_except RO.m{1} RO.m{2} (fset1 x{1})). + + auto;progress; 1..9,12:smt. + + case ((pick work = x){2})=> pick_x; last smt. + subst x{2}; generalize H7 H1; rewrite -neqF /eq_except=> -> /= eq_exc. + by apply fmapP=> x0; case (pick work{2} = x0); smt. + by auto; smt. + by auto;progress [-split];rewrite H0 /= getP_eq;smt. + qed. + + equiv Eager_S (D <: Distinguisher{RO}): IND_S(D).main ~ IND(ERO,D).main: ={glob D} ==> ={res,RO.m,glob D}. + proof. + proc; inline ERO.init RO.init. + seq 1 1: (={glob D, RO.m});first by wp. + symmetry; eager (H: ERO.sample(); ~ ERO.sample();: ={RO.m} ==> ={RO.m}): + (={glob D, RO.m}) => //; first by sim. + eager proc H (={RO.m}) => //; [by apply eager_query | by sim]. + qed. + + equiv Eager (D <: Distinguisher{RO}): IND(RO,D).main ~ IND(ERO,D).main: ={glob D} ==> ={res,glob D}. + proof. + transitivity IND_S(D).main + (={glob D} ==> ={res,glob D}) + (={glob D} ==> ={res,RO.m,glob D}) => //. + + by progress;exists (glob D){2}. + + proc;inline{2} ERO.sample. + while{2} true (card work{2}). + + move=> &m1 z;wp;call (oracle_ll sample_ll);auto;smt. + conseq (_: _ ==> ={b,glob D}) => //;[smt | by sim]. + apply (Eager_S D). + qed. + + end section EAGER. + +end GenIdeal. + +abstract theory FiniteIdeal. + + clone include Ideal. + axiom sample_ll (x : from): Distr.weight (sample x) = 1%r. + + op univ : from fset. + axiom univP (x:from) : mem univ x. + + module ERO = { + proc sample() = { + var work; + work <- univ; + while (work <> fset0) { + RO.oracle(pick work); + work = work `\` fset1 (pick work); + } + } + + proc init() = { + RO.m <- map0; + sample(); + } + + proc oracle(x:from):to = { return oget RO.m.[x]; } + }. + + module IND_S(D:Distinguisher) = { + proc main(): bool = { + var b; + RO.init(); + b <@ D(RO).distinguish(); + ERO.sample(); + return b; + } + }. + + section EAGER. + + declare module D: Distinguisher { RO }. + + local clone GenIdeal as GI with + op sample <- sample, + op RO_dom <- univ + proof sample_ll by apply sample_ll. + + local equiv ERO_main: + IND(GI.ERO, D).main ~ IND(ERO, D).main : ={glob D} ==> ={res, glob D} /\ GI.RO.m{1} = RO.m{2}. + proof. + proc. + call (_:GI.RO.m{1} = RO.m{2} /\ dom RO.m{2} = univ). + + proc; rcondf{1} 2;auto;progress;[ by rewrite H univP | by apply sample_ll]. + inline *. + while (={work} /\ GI.RO.m{1} = RO.m{2} /\ dom RO.m{2} = univ `\` work{2});auto;smt. + qed. + + equiv Eager_S : IND_S(D).main ~ IND(ERO,D).main: ={glob D} ==> ={res,RO.m,glob D}. + proof. + transitivity GI.IND_S(D).main + (={glob D} ==> ={res,glob D} /\ RO.m{1} = GI.RO.m{2}) + (={glob D} ==> ={res,glob D} /\ GI.RO.m{1} = RO.m{2}) => //. + + by progress;exists (glob D){2}. + + by sim. + transitivity IND(GI.ERO,D).main + (={glob D} ==> ={res,glob D, GI.RO.m}) + (={glob D} ==> ={res,glob D} /\ GI.RO.m{1} = RO.m{2}) => //. + + by progress;exists (glob D){2}. + + by conseq (GI.Eager_S D). + by apply ERO_main. + qed. + + equiv Eager : IND(RO, D).main ~ IND(ERO,D).main: ={glob D} ==> ={res,glob D}. + proof. + transitivity IND(GI.RO,D).main + (={glob D} ==> ={res,glob D} /\ RO.m{1} = GI.RO.m{2}) + (={glob D} ==> ={res,glob D}) => //. + + by progress;exists (glob D){2}. + + by sim. + transitivity IND(GI.ERO,D).main + (={glob D} ==> ={res,glob D}) + (={glob D} ==> ={res,glob D}) => //. + + by progress;exists (glob D){2}. + + by conseq (GI.Eager D). + by conseq ERO_main. + qed. + + end section EAGER. + +end FiniteIdeal. + + +abstract theory RestrIdeal. + + clone include Ideal. + axiom sample_ll (x : from): Distr.weight (sample x) = 1%r. + + op test : from -> bool. + op univ : from fset. + op dfl : to. + + axiom testP x : test x <=> mem univ x. + + module Restr (O:RO) = { + proc init = RO.init + proc oracle (x:from) : to = { + var r <- dfl; + if (test x) r <@ RO.oracle(x); + return r; + } + }. + + module ERO = { + proc sample() = { + var work; + work <- univ; + while (work <> fset0) { + RO.oracle(pick work); + work = work `\` fset1 (pick work); + } + } + + proc init() = { + RO.m <- map0; + sample(); + } + + proc oracle(x:from):to = { + return (if test x then oget RO.m.[x] else dfl); + } + }. + + module IND_S(D:Distinguisher) = { + proc main(): bool = { + var b; + RO.init(); + b <@ D(Restr(RO)).distinguish(); + ERO.sample(); + return b; + } + }. + + section EAGER. + + declare module D: Distinguisher { RO }. + + local clone GenIdeal as GI with + op sample <- sample, + op RO_dom <- univ. + + local module Restr' (O:RO_) = { + proc init() = { } + proc oracle(x:from) = { + var r <- dfl; + if (test x) r <@ O.oracle(x); + return r; + } + }. + + local module RD (O:RO_) = D(Restr'(O)). + + local equiv ERO_main: + IND(GI.ERO, RD).main ~ IND(ERO, D).main : ={glob D} ==> ={res, glob D} /\ GI.RO.m{1} = RO.m{2}. + proof. + proc. + call (_:GI.RO.m{1} = RO.m{2} /\ dom RO.m{2} = univ). + + proc. + case (test x{1});[ rcondt{1} 2 | rcondf{1} 2];auto;last smt ml=0. + by inline *;rcondf{1} 4;auto;progress;2:(by apply sample_ll);rewrite ?H0 ?H -?testP. + inline *. + while (={work} /\ GI.RO.m{1} = RO.m{2} /\ dom RO.m{2} `|` work{2} = univ);auto;1:progress; smt. + qed. + + equiv Eager_S : IND_S(D).main ~ IND(ERO,D).main: ={glob D} ==> ={res,RO.m,glob D}. + proof. + transitivity GI.IND_S(RD).main + (={glob D} ==> ={res,glob D} /\ RO.m{1} = GI.RO.m{2}) + (={glob D} ==> ={res,glob D} /\ GI.RO.m{1} = RO.m{2}) => //. + + by progress;exists (glob D){2}. + + by sim. + transitivity IND(GI.ERO,RD).main + (={glob D} ==> ={res,glob D, GI.RO.m}) + (={glob D} ==> ={res,glob D} /\ GI.RO.m{1} = RO.m{2}) => //. + + by progress;exists (glob D){2}. + + by conseq (GI.Eager_S RD). + by apply ERO_main. + qed. + + equiv Eager : IND(Restr(RO), D).main ~ IND(ERO,D).main: ={glob D} ==> ={res,glob D}. + proof. + transitivity IND(GI.RO,RD).main + (={glob D} ==> ={res,glob D} /\ RO.m{1} = GI.RO.m{2}) + (={glob D} ==> ={res,glob D}) => //. + + by progress;exists (glob D){2}. + + by sim. + transitivity IND(GI.ERO,RD).main + (={glob D} ==> ={res,glob D}) + (={glob D} ==> ={res,glob D}) => //. + + by progress;exists (glob D){2}. + + by conseq (GI.Eager RD). + by conseq ERO_main. + qed. + + end section EAGER. + +end RestrIdeal. \ No newline at end of file From bb1b501d5ff5eb72297c938608f914db191e4467 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Thu, 1 Oct 2015 09:59:23 +0200 Subject: [PATCH 025/525] renaming --- proof/{RO.eca => RndOrcl.eca} | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename proof/{RO.eca => RndOrcl.eca} (100%) diff --git a/proof/RO.eca b/proof/RndOrcl.eca similarity index 100% rename from proof/RO.eca rename to proof/RndOrcl.eca From b010afc013e5cf0b18a4413d2fcd02c9ce07d33d Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Thu, 1 Oct 2015 15:56:25 +0200 Subject: [PATCH 026/525] Some progress --- proof/Indifferentiability.eca | 4 +- proof/NBRO.eca | 153 ++++++++++++++++++++++++++++++++++ proof/RndOrcl.eca | 12 +-- 3 files changed, 159 insertions(+), 10 deletions(-) create mode 100644 proof/NBRO.eca diff --git a/proof/Indifferentiability.eca b/proof/Indifferentiability.eca index a4a3659..6c4514b 100644 --- a/proof/Indifferentiability.eca +++ b/proof/Indifferentiability.eca @@ -21,12 +21,12 @@ module type Functionality = { is playing with constructed functionality and ideal primitive or with ideal functionality and simulated primitive). **) module type Construction (P : Primitive) = { - proc init() : unit { P.init } + proc init() : unit { } proc oracle(x : f_in): f_out { P.oracle } }. module type Simulator (F : Functionality) = { - proc init() : unit { F.init } + proc init() : unit { } proc oracle(x : p_in): p_out { F.oracle } }. diff --git a/proof/NBRO.eca b/proof/NBRO.eca new file mode 100644 index 0000000..195905f --- /dev/null +++ b/proof/NBRO.eca @@ -0,0 +1,153 @@ +require import Int Real NewList NewFMap. +require RndOrcl Indifferentiability. + +type p_in. +type p_out. + +type from. + +type block. +op dblock : block distr. +axiom dblock_ll: Distr.weight dblock = 1%r. + +op univ : (from * int) fset. +op test : from * int -> bool. +op dfl : block. + +clone RndOrcl as ROB with + type from <- from * int, + type to <- block. + +clone include ROB.RestrIdeal with + op sample <- fun (x:from*int) => dblock, + op dfl <- dfl, + op univ <- univ, + op test <- test + proof sample_ll by apply dblock_ll. + +(* axiom testP (x:from * int): test x <=> mem univ x. *) +axiom test_neg (x:from) (n:int): n < 0 => !test (x,n). +axiom test_le (x:from) (n p:int) : 0 <= p <= n => test (x,n) => test (x,p). + +clone import Indifferentiability as IndB with + type p_in <- p_in, + type p_out <- p_out, + type f_in <- from * int, + type f_out <- block. + +clone import Indifferentiability as IndNB with + type p_in <- p_in, + type p_out <- p_out, + type f_in <- from * int, + type f_out <- block list. + +module RONB (Ob:IndB.Functionality) = { + proc init = Ob.init + + proc oracle(x:from, n:int) : block list = { + var b, bs; + bs <- []; + while (size bs < n) { + b <@ Ob.oracle(x,size bs); + bs <- rcons bs b; + } + return bs; + } +}. + +module DNB(D:IndNB.Distinguisher, F:IndB.Functionality, P:IndB.Primitive) = { + proc distinguish = D(RONB(F), P).distinguish +}. + +module CNB (C: IndB.Construction, P:IndB.Primitive) = RONB(C(P)). + +module FNB_B(F:IndNB.Functionality) = { + proc init () = {} + + proc oracle(x:from,n:int) : block = { + var bs; + bs <@ F.oracle(x,n+1); + return nth dfl bs n; + } +}. + +module SNB(S:IndB.Simulator, F:IndNB.Functionality) = { + + proc init = S(FNB_B(F)).init + + proc oracle = S(FNB_B(F)).oracle +}. + +section PROOF. + + declare module P:IndB.Primitive. + declare module C:IndB.Construction {P}. + declare module S:IndB.Simulator {RO}. + + declare module D: IndNB.Distinguisher {P, RO, S, C}. + + local equiv equivReal: IndNB.Real(P, CNB(C), D).main ~ IndB.Real(P, C, DNB(D)).main: + ={glob P, glob C, glob D} ==> + ={glob P, glob C, glob D,res}. + proof. proc;inline *; sim. qed. + + local module DRO (O:ROB.RO) = { + proc distinguish () : bool = { + var b; + SNB(S, RONB(O)).init(); + b <@ D(RONB(O), SNB(S, RONB(O))).distinguish(); + return b; + } + }. + + local module DNB'(O:ROB.RO) = { + proc distinguish () : bool = { + var b; + S(O).init(); + b <@ DNB(D, O, S(O)).distinguish(); + return b; + } + }. + + lemma conclusion &m: + `|Pr[IndNB.Real(P, CNB(C), D).main()@ &m:res] - Pr[IndNB.Ideal(RONB(Restr(RO)), SNB(S), D).main()@ &m:res] | = + `|Pr[IndB.Real(P, C, DNB(D)).main()@ &m:res] - Pr[IndB.Ideal(Restr(RO),S,DNB(D)).main()@ &m:res] |. + proof. + cut -> : Pr[IndNB.Real(P, CNB(C), D).main()@ &m:res] = Pr[IndB.Real(P, C, DNB(D)).main()@ &m:res]. + + byequiv equivReal=> //. + cut -> : Pr[Ideal(RONB(Restr(RO)), SNB(S), D).main() @ &m : res] = + Pr[ROB.IND(Restr(RO), DRO).main() @ &m : res]. + + byequiv=> //; proc;inline *;swap{1} 1 1;sim. + cut -> : Pr[ROB.IND(Restr(RO), DRO).main() @ &m : res] = + Pr[ROB.IND(ERO,DRO).main () @ &m : res]. + + byequiv (Eager DRO)=> //. + do 2! congr. + cut -> : Pr[IndB.Ideal(Restr(RO), S, DNB(D)).main() @ &m : res] = + Pr[ROB.IND(Restr(RO), DNB').main() @ &m : res]. + + byequiv=> //; proc;inline *;swap{1} 1 1;sim. + cut -> : Pr[ROB.IND(Restr(RO), DNB').main() @ &m : res] = + Pr[ROB.IND(ERO, DNB').main() @ &m : res]. + + byequiv (Eager DNB')=> //. + byequiv=> //;proc;inline DRO(ERO).distinguish DNB'(ERO).distinguish;wp. + call (_: ={RO.m, glob S}). + + proc (={RO.m}) => //. + proc;inline *;wp. + while{1} ((0 <= n0 => size bs0 <= n0){1} /\ forall i, 0 <= i < size bs0{1} => + nth dfl bs0{1} i = + if test (x0{1},i) + then oget RO.m{1}.[(x0{1},i)] + else dfl) ((n0 - size bs0){1}). + + move=> &m2 z;auto;progress [-split]. + rewrite size_rcons;split;2:smt ml=0;split;1:smt ml=0. + move=> i [Hi0 Hi1];rewrite nth_rcons. + case (i < size bs0{hr})=> Hi';first by apply H0. + by cut -> : i = size bs0{hr} by smt ml=0. + auto;progress;1,2: smt ml=0. + case (n{1} < 0)=> Hn. + + by rewrite nth_neg // test_neg. + apply H1=> {H1} //;smt ml=0. + + sim. + by conseq (_: _ ==> ={glob S, glob D, RO.m})=> //;sim. + qed. + +end section PROOF. diff --git a/proof/RndOrcl.eca b/proof/RndOrcl.eca index 8d90a89..09d0322 100644 --- a/proof/RndOrcl.eca +++ b/proof/RndOrcl.eca @@ -10,12 +10,8 @@ module type RO = { proc oracle(x : from): to }. -module type RO_ = { - proc oracle(x : from): to -}. - -module type Distinguisher(G : RO_) = { - proc distinguish(): bool +module type Distinguisher(G : RO) = { + proc distinguish(): bool {G.oracle} }. module IND(G:RO, D:Distinguisher) = { @@ -331,7 +327,7 @@ abstract theory RestrIdeal. op sample <- sample, op RO_dom <- univ. - local module Restr' (O:RO_) = { + local module Restr' (O:RO) = { proc init() = { } proc oracle(x:from) = { var r <- dfl; @@ -340,7 +336,7 @@ abstract theory RestrIdeal. } }. - local module RD (O:RO_) = D(Restr'(O)). + local module RD (O:RO) = D(Restr'(O)). local equiv ERO_main: IND(GI.ERO, RD).main ~ IND(ERO, D).main : ={glob D} ==> ={res, glob D} /\ GI.RO.m{1} = RO.m{2}. From a76d73f1d7b39c6e7315043ec93ac8044cc9a767 Mon Sep 17 00:00:00 2001 From: Pierre-Yves Strub Date: Thu, 22 Oct 2015 17:53:02 +0200 Subject: [PATCH 027/525] Top level definitions. --- proof/Definitions.ec | 104 +++++++++++++++++++++++++++++++++++++++++++ proof/IRO.eca | 28 +++++++----- proof/LazyRP.eca | 2 +- 3 files changed, 123 insertions(+), 11 deletions(-) create mode 100644 proof/Definitions.ec diff --git a/proof/Definitions.ec b/proof/Definitions.ec new file mode 100644 index 0000000..f355064 --- /dev/null +++ b/proof/Definitions.ec @@ -0,0 +1,104 @@ +(* -------------------------------------------------------------------- *) +require import Pair Int Real List. +require (*--*) IRO LazyRP. +(*---*) import Dprod. + +(* -------------------------------------------------------------------- *) +op r : { int | 0 < r } as gt0_r. +op c : { int | 0 < c } as gt0_c. + +type block. (* = {0,1}^r *) +type capacity. (* = {0,1}^c *) + +op cdist : capacity distr. +op bdist : block distr. + +(* isomorphic to the {0,1}^? uniform distributions *) + +op b0 : block. +op c0 : capacity. + +op b2bits : block -> bool list. + +op (^) : block -> block -> block. +op pad : bool list -> block list. + +(* -------------------------------------------------------------------- *) +clone import IRO as BIRO with + type from <- bool list, + type to <- bool, + op valid (x : bool list) <- true. + +clone import LazyRP as Perm with + type D <- block * capacity, + op d <- bdist * cdist + + rename [module] "P" as "Perm". + +(* -------------------------------------------------------------------- *) +module type CONSTRUCTION(P : RP) = { + proc init() : unit + + proc f(bp : bool list, n : int) : bool list +}. + +module type SIMULATOR(F : BIRO.IRO) = { + proc init() : unit + + proc f(_ : block * capacity) : block * capacity + + proc fi(_ : block * capacity) : block * capacity +}. + +module type DISTINGUISHER(F : BIRO.IRO, P : RP) = { + proc distinguish() : bool +}. + +(* -------------------------------------------------------------------- *) +module Experiment(F : BIRO.IRO, P : RP, D : DISTINGUISHER) = { + proc main() : bool = { + var b; + + F.init(); + P.init(); + b <@ D(F, P).distinguish(); + + return b; + } +}. + +(* -------------------------------------------------------------------- *) +module Sponge (P : RP) : BIRO.IRO, CONSTRUCTION(P) = { + proc init = P.init + + proc f(bp : bool list, n : int): bool list = { + var z <- []; + var s <- (b0, c0); + var i <- 0; + var p <- pad bp; + + (* Absorption *) + while (p <> []) { + s <@ P.f(s.`1 ^ head b0 p, s.`2); + p <- behead p; + } + (* Squeezing *) + while (i < n/%r) { + z <- z ++ (b2bits s.`1); + s <@ P.f(s); + } + + return take n z; + } +}. + +(* -------------------------------------------------------------------- *) +op eps : real. + +lemma top: + exists (S <: SIMULATOR), + forall (D <: DISTINGUISHER) &m, + `| Pr[Experiment(Sponge(Perm), Perm, D).main() @ &m : res] + - Pr[Experiment(IRO, S(IRO), D).main() @ &m : res]| + < eps. +proof. admit. qed. diff --git a/proof/IRO.eca b/proof/IRO.eca index 07c2c25..a8ff48c 100644 --- a/proof/IRO.eca +++ b/proof/IRO.eca @@ -2,19 +2,22 @@ all of whose bits are sampled uniformly and independently. We obviously make it lazy. *) -require import Option Int Bool NewList NewFMap NewFSet. +require import Option Int Bool List FSet NewFMap. -type from. +type to, from. + +op valid : from -> bool. +op dto : to distr. module type IRO = { proc init() : unit (* f x, returning the first n bits of the result *) - proc f(x : from, n : int) : bool list + proc f(x : from, n : int) : to list }. module IRO : IRO = { - var mp : (from, bool list) fmap + var mp : (from, to list) fmap proc init() = { mp = map0; } @@ -23,7 +26,7 @@ module IRO : IRO = { bs <- []; while (n > 0) { - b <$ Dbool.dbool; + b <$ dto; bs <- b :: bs; n <- n - 1; } @@ -31,11 +34,16 @@ module IRO : IRO = { } proc f(x, n) = { - var ys, zs; + var ys, zs, aout; + + aout <- []; + if (valid x) { + ys <- odflt [] mp.[x]; + zs <@ choose (max 0 (n - size ys)); + mp.[x] <- ys ++ zs; + aout <- take n (oget mp.[x]); + } - ys <- odflt [] mp.[x]; - zs <@ choose (max 0 (n - size ys)); - mp.[x] <- ys ++ zs; - return take n (oget mp.[x]); + return aout; } }. diff --git a/proof/LazyRP.eca b/proof/LazyRP.eca index 578ed7b..b483b42 100644 --- a/proof/LazyRP.eca +++ b/proof/LazyRP.eca @@ -1,4 +1,4 @@ -require import Option NewFSet NewFMap. +require import Option FSet NewFMap. require import Dexcepted. require (*..*) RP. From 0a2defb4c3c384aa776be5ac24b7731a89e1e59b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Fri, 23 Oct 2015 12:06:14 +0200 Subject: [PATCH 028/525] File for Benjamin to play with. --- proof/LeakyAbsorb.ec | 172 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 172 insertions(+) create mode 100644 proof/LeakyAbsorb.ec diff --git a/proof/LeakyAbsorb.ec b/proof/LeakyAbsorb.ec new file mode 100644 index 0000000..7fb9ffe --- /dev/null +++ b/proof/LeakyAbsorb.ec @@ -0,0 +1,172 @@ +(* -------------------------------------------------------------------- *) +require import Option Pair Int Real List FSet NewFMap. +require (*--*) IRO LazyRP. +(*---*) import Dprod. + +(* -------------------------------------------------------------------- *) +op r : { int | 0 < r } as gt0_r. +op c : { int | 0 < c } as gt0_c. + +type block. (* = {0,1}^r *) +type capacity. (* = {0,1}^c *) + +op cdist : capacity distr. +op bdist : block distr. + +(* isomorphic to the {0,1}^? uniform distributions *) + +op b0 : block. +op c0 : capacity. + +op b2bits : block -> bool list. + +op (^) : block -> block -> block. +op pad : bool list -> block list. + +(* -------------------------------------------------------------------- *) +clone import LazyRP as Perm with + type D <- block * capacity, + op d <- bdist * cdist + + rename [module] "P" as "Perm". + +clone import IRO as BIRO with + type from <- block list, + type to <- block, + op valid (x : block list) <- true, + op dto <- bdist. + +(* -------------------------------------------------------------------- *) +module type WeirdIRO = { + proc init(): unit + + proc f(_: block list * int): block list +}. + +module IdealFunctionality = { + var h : (block list,block) fmap + + proc init() = { h = map0; } + + proc core(m : block list) = { + if (!mem (dom h) m) { + h.[m] <$ bdist; + } + return oget h.[m]; + } + + proc f(m : block list, n : int) = { + var i <- 1; + var z <- [b0]; + var b; + + m <- m ++ mkseq (fun k => b0) n; + while (i < size m) { + b <@ core(take i m); + z <- rcons z b; + } + return z; + } +}. + +(* -------------------------------------------------------------------- *) +module type CONSTRUCTION(P : RP) = { + proc init() : unit + + proc f(bp : block list, n : int) : block list +}. + +module type SIMULATOR(F : WeirdIRO) = { + proc init() : unit + + proc f(_ : block * capacity) : block * capacity + + proc fi(_ : block * capacity) : block * capacity +}. + +module type DISTINGUISHER(F : WeirdIRO, P : RP) = { + proc distinguish() : bool +}. + +(* -------------------------------------------------------------------- *) +module Experiment(F : WeirdIRO, P : RP, D : DISTINGUISHER) = { + proc main() : bool = { + var b; + + F.init(); + P.init(); + b <@ D(F, P).distinguish(); + + return b; + } +}. + +(* -------------------------------------------------------------------- *) +module SpongeThatDoesNotAbsorb (P : RP) : WeirdIRO, CONSTRUCTION(P) = { + proc init = P.init + + proc f(p : block list, n : int): block list = { + var z <- []; + var (sa,sc) <- (b0, c0); + var i <- 0; + var l <- size p; + + (* Absorption *) + while (p <> []) { + z <- rcons z sa; + (sa,sc) <@ P.f(sa ^ head b0 p, sc); + p <- behead p; + } + (* Squeezing *) + while (i < n/%r) { + z <- rcons z sa; + (sa,sc) <@ P.f(sa,sc); + } + + return drop l z; + } +}. + +(* -------------------------------------------------------------------- *) +module SpongeThatAbsorbs (P : RP) : WeirdIRO, CONSTRUCTION(P) = { + proc init = P.init + + proc f(p : block list, n : int): block list = { + var z <- []; + var (sa,sc) <- (b0, c0); + var i <- 0; + + (* Absorption *) + while (p <> []) { + (sa,sc) <@ P.f(sa ^ head b0 p, sc); + p <- behead p; + } + (* Squeezing *) + while (i < n/%r) { + z <- rcons z sa; + (sa,sc) <@ P.f(sa,sc); + } + + return z; + } +}. + +(* -------------------------------------------------------------------- *) +op eps : real. + +axiom core: + exists (S <: SIMULATOR), + forall (D <: DISTINGUISHER) &m, + `| Pr[Experiment(SpongeThatDoesNotAbsorb(Perm), Perm, D).main() @ &m : res] + - Pr[Experiment(IdealFunctionality, S(IdealFunctionality), D).main() @ &m : res]| + < eps. + + +lemma top: + exists eps', + exists (S <: SIMULATOR), + forall (D <: DISTINGUISHER) &m, + `| Pr[Experiment(SpongeThatAbsorbs(Perm), Perm, D).main() @ &m : res] + - Pr[Experiment(IRO, S(IRO), D).main() @ &m : res]| + < eps'. +proof. admit. (** FILL ME IN **) qed. \ No newline at end of file From 7c77a87d629b003196a499a7a79f340714b4e1c3 Mon Sep 17 00:00:00 2001 From: Pierre-Yves Strub Date: Fri, 23 Oct 2015 12:50:39 +0200 Subject: [PATCH 029/525] .gitignore --- .gitignore | 138 +++++++++++++++++++++++++++++++++++++++++++++++++---- 1 file changed, 128 insertions(+), 10 deletions(-) diff --git a/.gitignore b/.gitignore index 5032cba..1abb86d 100644 --- a/.gitignore +++ b/.gitignore @@ -1,16 +1,134 @@ -main.pdf -/doc/contract/contract.pdf +_build/ +## Core latex/pdflatex auxiliary files: *.aux -*.bbl -*.blg -*.fdb_latexmk -*.fls -*.gnuplot -*.kilepr +*.lof *.log +*.lot +*.fls *.out -*.table +*.toc + +## Intermediate documents: *.dvi +*-converted-to.* +# these rules might exclude image files for figures etc. +*.ps +# *.eps +*.pdf + +## Bibliography auxiliary files (bibtex/biblatex/biber): +*.bbl +*.bcf +*.blg +*-blx.aux +*-blx.bib +*.brf +*.run.xml + +## Build tool auxiliary files: +*.fdb_latexmk +*.synctex *.synctex.gz -*.backup +*.synctex.gz(busy) +*.pdfsync + +## Emacs files +*~ + +## Emacs AUCTeX files +auto/ + +## Auxiliary and intermediate files from other packages: + +# algorithms +*.alg +*.loa + +# achemso +acs-*.bib + +# amsthm +*.thm + +# beamer +*.nav +*.snm +*.vrb + +#(e)ledmac/(e)ledpar +*.end +*.[1-9] +*.[1-9][0-9] +*.[1-9][0-9][0-9] +*.[1-9]R +*.[1-9][0-9]R +*.[1-9][0-9][0-9]R +*.eledsec[1-9] +*.eledsec[1-9]R +*.eledsec[1-9][0-9] +*.eledsec[1-9][0-9]R +*.eledsec[1-9][0-9][0-9] +*.eledsec[1-9][0-9][0-9]R + +# glossaries +*.acn +*.acr +*.glg +*.glo +*.gls + +# gnuplottex +*-gnuplottex-* + +# hyperref +*.brf + +# knitr +*-concordance.tex +*.tikz +*-tikzDictionary + +# listings +*.lol + +# makeidx +*.idx +*.ilg +*.ind +*.ist + +# minitoc +*.maf +*.mtc +*.mtc0 + +# minted +_minted* +*.pyg + +# morewrites +*.mw + +# nomencl +*.nlo + +# sagetex +*.sagetex.sage +*.sagetex.py +*.sagetex.scmd + +# sympy +*.sout +*.sympy +sympy-plots-for-*.tex/ + +# todonotes +*.tdo + +# xindy +*.xdy + +# WinEdt +*.bak +*.sav From 78e58c489d030c7185952375cb1cbfc9ce675926 Mon Sep 17 00:00:00 2001 From: Pierre-Yves Strub Date: Fri, 23 Oct 2015 12:50:57 +0200 Subject: [PATCH 030/525] Refactoring + core def. --- proof/Common.ec | 61 +++++++++++++++++++++++++++ proof/{Definitions.ec => TopLevel.ec} | 9 ++-- 2 files changed, 66 insertions(+), 4 deletions(-) create mode 100644 proof/Common.ec rename proof/{Definitions.ec => TopLevel.ec} (94%) diff --git a/proof/Common.ec b/proof/Common.ec new file mode 100644 index 0000000..cace21f --- /dev/null +++ b/proof/Common.ec @@ -0,0 +1,61 @@ +(* -------------------------------------------------------------------- *) +require import Fun Pair Int Real List NewDistr. +require (*--*) FinType NewMonoid. + +(* -------------------------------------------------------------------- *) +theory BitWord. +type bword. + +op zero : bword. +op (^) : bword -> bword -> bword. + +clone include NewMonoid + with + type t <- bword, + op idm <- zero, + op (+) <- (^) + proof Axioms.* by admit. + +clone FinType with type t <- bword + proof * by admit. + +op w2bits : bword -> bool list. +op bits2w : bool list -> bword. +op size : { int | 0 < size } as gt0_size. + +lemma w2bitsK : cancel w2bits bits2w. +proof. admit. qed. + +lemma bits2wK (s : bool list) : + size s = size => w2bits (bits2w s) = s. +proof. admit. qed. + +op uniform : bword distr = + MUniform.duniform FinType.elts. +end BitWord. + +(* -------------------------------------------------------------------- *) +op r : { int | 0 < r } as gt0_r. +op c : { int | 0 < c } as gt0_c. + +type block. (* ~ bitstrings of size r *) +type capacity. (* ~ bitstrings of size c *) + +(* -------------------------------------------------------------------- *) +clone BitWord as Capacity with + type bword <- capacity, + op size <- c + proof * by apply/gt0_c + + rename + [op] "zero" as "c0" + [op] "uniform" as "cdistr". + +clone export BitWord as Block with + type bword <- block, + op size <- r + proof * by apply/gt0_r + + rename + [op] "zero" as "b0" + [op] "uniform" as "bdistr". diff --git a/proof/Definitions.ec b/proof/TopLevel.ec similarity index 94% rename from proof/Definitions.ec rename to proof/TopLevel.ec index f355064..25235f4 100644 --- a/proof/Definitions.ec +++ b/proof/TopLevel.ec @@ -4,23 +4,24 @@ require (*--*) IRO LazyRP. (*---*) import Dprod. (* -------------------------------------------------------------------- *) +(* Replay Common.ec *) op r : { int | 0 < r } as gt0_r. op c : { int | 0 < c } as gt0_c. -type block. (* = {0,1}^r *) -type capacity. (* = {0,1}^c *) +type block. +type capacity. op cdist : capacity distr. op bdist : block distr. -(* isomorphic to the {0,1}^? uniform distributions *) - op b0 : block. op c0 : capacity. op b2bits : block -> bool list. op (^) : block -> block -> block. + +(* -------------------------------------------------------------------- *) op pad : bool list -> block list. (* -------------------------------------------------------------------- *) From e6591563def29e623bc85a04439465e5a62bd18c Mon Sep 17 00:00:00 2001 From: Pierre-Yves Strub Date: Fri, 23 Oct 2015 12:57:48 +0200 Subject: [PATCH 031/525] Refactoring. --- ...entiability.eca => Indifferentiability.ec} | 26 +++++++++++++------ 1 file changed, 18 insertions(+), 8 deletions(-) rename proof/{Indifferentiability.eca => Indifferentiability.ec} (74%) diff --git a/proof/Indifferentiability.eca b/proof/Indifferentiability.ec similarity index 74% rename from proof/Indifferentiability.eca rename to proof/Indifferentiability.ec index 6c4514b..178798e 100644 --- a/proof/Indifferentiability.eca +++ b/proof/Indifferentiability.ec @@ -1,9 +1,12 @@ +(* -------------------------------------------------------------------- *) +abstract theory Types. (** A primitive: the building block we assume ideal **) -type p_in, p_out. +type p. module type Primitive = { proc init(): unit - proc oracle(x : p_in): p_out + proc f(x : p): p + proc fi(x : p): p }. (** A functionality: the target construction **) @@ -11,7 +14,7 @@ type f_in, f_out. module type Functionality = { proc init(): unit - proc oracle(x : f_in): f_out + proc f(x : f_in): f_out }. (** A construction takes a primitive and builds a functionality. @@ -21,18 +24,24 @@ module type Functionality = { is playing with constructed functionality and ideal primitive or with ideal functionality and simulated primitive). **) module type Construction (P : Primitive) = { - proc init() : unit { } - proc oracle(x : f_in): f_out { P.oracle } + proc init() : unit { } + proc f(x : f_in): f_out { P.f } }. module type Simulator (F : Functionality) = { - proc init() : unit { } - proc oracle(x : p_in): p_out { F.oracle } + proc init() : unit { } + proc f(x : p) : p { F.f } + proc fi(x : p) : p { F.f } }. module type Distinguisher (F : Functionality, P : Primitive) = { - proc distinguish(): bool { P.oracle F.oracle } + proc distinguish(): bool { P.f P.fi F.f } }. +end Types. + +(* -------------------------------------------------------------------- *) +abstract theory Core. +clone import Types. module Indif (F : Functionality, P : Primitive, D : Distinguisher) = { proc main(): bool = { @@ -53,3 +62,4 @@ module Ideal(F:Functionality, S:Simulator) = Indif(F,S(F)). | Pr[Real(P,C,D): res] - Pr[Ideal(F,S,D): res] | is small. We avoid the existential by providing a concrete construction for S and the `small` by providing a concrete bound. *) +end Core. From bed42ccbd618f7f9353693867178fa41b01bf54b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Fri, 23 Oct 2015 15:12:36 +0200 Subject: [PATCH 032/525] Up one level of proof stack. --- proof/Blocks.ec | 70 ++++++++++++++++++++++++++++++++++++ proof/Indifferentiability.ec | 45 +++++++++++------------ proof/TopLevel.ec | 58 ++++++++++-------------------- 3 files changed, 112 insertions(+), 61 deletions(-) create mode 100644 proof/Blocks.ec diff --git a/proof/Blocks.ec b/proof/Blocks.ec new file mode 100644 index 0000000..a7ae183 --- /dev/null +++ b/proof/Blocks.ec @@ -0,0 +1,70 @@ +(* -------------------------------------------------------------------- *) +require import Pair Int Real List. +require (*--*) Common IRO LazyRP Indifferentiability. + +op ( * ): 'a NewDistr.distr -> 'b NewDistr.distr -> ('a * 'b) distr. + +(* -------------------------------------------------------------------- *) +clone include Common. + +(* -------------------------------------------------------------------- *) +op valid: block list -> bool. (* is in the image of the padding function *) + +clone import IRO as BIRO with + type from <- block list, + type to <- block, + op valid <- valid. + +clone import LazyRP as Perm with + type D <- block * capacity, + op d <- bdistr * Capacity.cdistr + + rename [module] "P" as "Perm". + +(* -------------------------------------------------------------------- *) +clone include Indifferentiability.Core with + type Types.p <- block * capacity, + type Types.f_in <- block list * int, + type Types.f_out <- block list + + rename + [module] "Indif" as "Experiment" + [module] "al" as "alIndif". +import Types. + +(* -------------------------------------------------------------------- *) +(** Spurious uninitialized variable warning on p *) +module BlockSponge (P : RP) : BIRO.IRO, CONSTRUCTION(P) = { + proc init = P.init + + proc f(p : block list, n : int): block list = { + var z <- []; + var (sa,sc) <- (b0, Capacity.c0); + var i <- 0; + + if (valid p) { + (* Absorption *) + while (p <> []) { + (sa,sc) <@ P.f(sa ^ head b0 p, sc); + p <- behead p; + } + (* Squeezing *) + while (i < n) { + z <- rcons z sa; + (sa,sc) <@ P.f(sa,sc); + } + } + return z; + } +}. + +(* -------------------------------------------------------------------- *) +op eps : real. + +lemma top: + exists (S <: SIMULATOR), + forall (D <: DISTINGUISHER) &m, + `| Pr[Experiment(BlockSponge(Perm), Perm, D).main() @ &m : res] + - Pr[Experiment(IRO, S(IRO), D).main() @ &m : res]| + < eps. +proof. admit. qed. diff --git a/proof/Indifferentiability.ec b/proof/Indifferentiability.ec index 178798e..f710925 100644 --- a/proof/Indifferentiability.ec +++ b/proof/Indifferentiability.ec @@ -3,16 +3,21 @@ abstract theory Types. (** A primitive: the building block we assume ideal **) type p. -module type Primitive = { +(** A functionality: the target construction **) +type f_in, f_out. +end Types. + +(* -------------------------------------------------------------------- *) +abstract theory Core. +clone import Types. + +module type PRIMITIVE = { proc init(): unit proc f(x : p): p proc fi(x : p): p }. -(** A functionality: the target construction **) -type f_in, f_out. - -module type Functionality = { +module type FUNCTIONALITY = { proc init(): unit proc f(x : f_in): f_out }. @@ -23,27 +28,22 @@ module type Functionality = { functionality and returns a boolean (its guess as to whether it is playing with constructed functionality and ideal primitive or with ideal functionality and simulated primitive). **) -module type Construction (P : Primitive) = { - proc init() : unit { } +module type CONSTRUCTION (P : PRIMITIVE) = { + proc init() : unit proc f(x : f_in): f_out { P.f } }. -module type Simulator (F : Functionality) = { - proc init() : unit { } +module type SIMULATOR (F : FUNCTIONALITY) = { + proc init() : unit proc f(x : p) : p { F.f } proc fi(x : p) : p { F.f } }. -module type Distinguisher (F : Functionality, P : Primitive) = { +module type DISTINGUISHER (F : FUNCTIONALITY, P : PRIMITIVE) = { proc distinguish(): bool { P.f P.fi F.f } }. -end Types. - -(* -------------------------------------------------------------------- *) -abstract theory Core. -clone import Types. -module Indif (F : Functionality, P : Primitive, D : Distinguisher) = { +module Indif (F : FUNCTIONALITY, P : PRIMITIVE, D : DISTINGUISHER) = { proc main(): bool = { var b; @@ -54,12 +54,13 @@ module Indif (F : Functionality, P : Primitive, D : Distinguisher) = { } }. -module Real(P:Primitive, C:Construction) = Indif(C(P),P). -module Ideal(F:Functionality, S:Simulator) = Indif(F,S(F)). -(* (C <: Construction) applied to (P <: Primitive) is indifferentiable - from (F <: Functionality) if there exists (S <: Simulator) such - that, for all (D <: Distinguisher), +module Real(P : PRIMITIVE, C : CONSTRUCTION) = Indif(C(P),P). +module Ideal(F : FUNCTIONALITY, S : SIMULATOR) = Indif(F,S(F)). + +(* (C <: CONSTRUCTION) applied to (P <: PRIMITIVE) is indifferentiable + from (F <: FUNCTIONALITY) if there exists (S <: SIMULATOR) such + that, for all (D <: DISTINGUISHER), | Pr[Real(P,C,D): res] - Pr[Ideal(F,S,D): res] | is small. We avoid the existential by providing a concrete construction for S and the `small` by providing a concrete bound. *) -end Core. +end Core. \ No newline at end of file diff --git a/proof/TopLevel.ec b/proof/TopLevel.ec index 25235f4..a329f2c 100644 --- a/proof/TopLevel.ec +++ b/proof/TopLevel.ec @@ -1,6 +1,6 @@ (* -------------------------------------------------------------------- *) require import Pair Int Real List. -require (*--*) IRO LazyRP. +require (*--*) IRO LazyRP Indifferentiability. (*---*) import Dprod. (* -------------------------------------------------------------------- *) @@ -37,56 +37,36 @@ clone import LazyRP as Perm with rename [module] "P" as "Perm". (* -------------------------------------------------------------------- *) -module type CONSTRUCTION(P : RP) = { - proc init() : unit +clone include Indifferentiability.Core with + type Types.p <- block * capacity, + type Types.f_in <- bool list * int, + type Types.f_out <- bool list - proc f(bp : bool list, n : int) : bool list -}. - -module type SIMULATOR(F : BIRO.IRO) = { - proc init() : unit - - proc f(_ : block * capacity) : block * capacity - - proc fi(_ : block * capacity) : block * capacity -}. - -module type DISTINGUISHER(F : BIRO.IRO, P : RP) = { - proc distinguish() : bool -}. - -(* -------------------------------------------------------------------- *) -module Experiment(F : BIRO.IRO, P : RP, D : DISTINGUISHER) = { - proc main() : bool = { - var b; - - F.init(); - P.init(); - b <@ D(F, P).distinguish(); - - return b; - } -}. + rename + [module] "Indif" as "Experiment" + [module] "al" as "alIndif". +import Types. (* -------------------------------------------------------------------- *) +(** Spurious uninitialized variable warning on p *) module Sponge (P : RP) : BIRO.IRO, CONSTRUCTION(P) = { proc init = P.init proc f(bp : bool list, n : int): bool list = { - var z <- []; - var s <- (b0, c0); - var i <- 0; - var p <- pad bp; + var z <- []; + var (sa,sc) <- (b0, c0); + var i <- 0; + var p <- pad bp; (* Absorption *) while (p <> []) { - s <@ P.f(s.`1 ^ head b0 p, s.`2); - p <- behead p; + (sa,sc) <@ P.f(sa ^ head b0 p, sc); + p <- behead p; } (* Squeezing *) - while (i < n/%r) { - z <- z ++ (b2bits s.`1); - s <@ P.f(s); + while (i < (n + r - 1) /% r) { + z <- z ++ (b2bits sa); + (sa,sc) <@ P.f(sa,sc); } return take n z; From 607847394653b6f722653482b9d973b083de8f7e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Fri, 23 Oct 2015 15:59:08 +0200 Subject: [PATCH 033/525] Cleaning up Benjamin's playpen. --- proof/IRO.eca | 2 +- proof/LeakyAbsorb.ec | 111 ++++++++++++++++++++++++++++--------------- 2 files changed, 73 insertions(+), 40 deletions(-) diff --git a/proof/IRO.eca b/proof/IRO.eca index a8ff48c..a644a88 100644 --- a/proof/IRO.eca +++ b/proof/IRO.eca @@ -27,7 +27,7 @@ module IRO : IRO = { bs <- []; while (n > 0) { b <$ dto; - bs <- b :: bs; + bs <- rcons bs b; n <- n - 1; } return bs; diff --git a/proof/LeakyAbsorb.ec b/proof/LeakyAbsorb.ec index 7fb9ffe..1e5e6dd 100644 --- a/proof/LeakyAbsorb.ec +++ b/proof/LeakyAbsorb.ec @@ -30,12 +30,6 @@ clone import LazyRP as Perm with rename [module] "P" as "Perm". -clone import IRO as BIRO with - type from <- block list, - type to <- block, - op valid (x : block list) <- true, - op dto <- bdist. - (* -------------------------------------------------------------------- *) module type WeirdIRO = { proc init(): unit @@ -43,12 +37,12 @@ module type WeirdIRO = { proc f(_: block list * int): block list }. -module IdealFunctionality = { - var h : (block list,block) fmap +module IdealFunctionalityThatDoesNotAbsorb = { + var h : (block list * int,block) fmap proc init() = { h = map0; } - proc core(m : block list) = { + proc core(m : block list * int) = { if (!mem (dom h) m) { h.[m] <$ bdist; } @@ -56,14 +50,51 @@ module IdealFunctionality = { } proc f(m : block list, n : int) = { - var i <- 1; - var z <- [b0]; + var i <- 0; + var j <- 1; + var z <- []; + var b <- b0; + + if (m <> []) { + while (i < size m) { + z <- rcons z b; + b <@ core(take i m,0); + i <- i + 1; + } + while (j < n) { + z <- rcons z b; + b <@ core(m,j); + j <- j + 1; + } + } + return z; + } +}. + +module IdealFunctionalityThatAbsorbs = { + var h : (block list * int,block) fmap + + proc init() = { h = map0; } + + proc core (m : block list * int) = { + if (!mem (dom h) m) { + h.[m] <$ bdist; + } + return oget h.[m]; + } + + proc f(m : block list, n : int) = { + var j <- 1; + var z <- []; var b; - m <- m ++ mkseq (fun k => b0) n; - while (i < size m) { - b <@ core(take i m); - z <- rcons z b; + if (m <> []) { + b <@ core(m,0); + while (j < n) { + z <- rcons z b; + b <@ core(m,j); + j <- j + 1; + } } return z; } @@ -111,23 +142,24 @@ module SpongeThatDoesNotAbsorb (P : RP) : WeirdIRO, CONSTRUCTION(P) = { var i <- 0; var l <- size p; - (* Absorption *) - while (p <> []) { - z <- rcons z sa; - (sa,sc) <@ P.f(sa ^ head b0 p, sc); - p <- behead p; - } - (* Squeezing *) - while (i < n/%r) { - z <- rcons z sa; - (sa,sc) <@ P.f(sa,sc); + if (p <> [] /\ nth witness p (size p - 1) <> b0) { + (* Absorption *) + while (p <> []) { + z <- rcons z sa; + (sa,sc) <@ P.f(sa ^ head b0 p, sc); + p <- behead p; + } + (* Squeezing *) + while (i < n) { + z <- rcons z sa; + (sa,sc) <@ P.f(sa,sc); + } } - return drop l z; + return z; } }. -(* -------------------------------------------------------------------- *) module SpongeThatAbsorbs (P : RP) : WeirdIRO, CONSTRUCTION(P) = { proc init = P.init @@ -136,15 +168,17 @@ module SpongeThatAbsorbs (P : RP) : WeirdIRO, CONSTRUCTION(P) = { var (sa,sc) <- (b0, c0); var i <- 0; - (* Absorption *) - while (p <> []) { - (sa,sc) <@ P.f(sa ^ head b0 p, sc); - p <- behead p; - } - (* Squeezing *) - while (i < n/%r) { - z <- rcons z sa; - (sa,sc) <@ P.f(sa,sc); + if (p <> [] /\ nth witness p (size p - 1) <> b0) { + (* Absorption *) + while (p <> []) { + (sa,sc) <@ P.f(sa ^ head b0 p, sc); + p <- behead p; + } + (* Squeezing *) + while (i < n) { + z <- rcons z sa; + (sa,sc) <@ P.f(sa,sc); + } } return z; @@ -158,15 +192,14 @@ axiom core: exists (S <: SIMULATOR), forall (D <: DISTINGUISHER) &m, `| Pr[Experiment(SpongeThatDoesNotAbsorb(Perm), Perm, D).main() @ &m : res] - - Pr[Experiment(IdealFunctionality, S(IdealFunctionality), D).main() @ &m : res]| + - Pr[Experiment(IdealFunctionalityThatDoesNotAbsorb, S(IdealFunctionalityThatDoesNotAbsorb), D).main() @ &m : res]| < eps. - lemma top: exists eps', exists (S <: SIMULATOR), forall (D <: DISTINGUISHER) &m, `| Pr[Experiment(SpongeThatAbsorbs(Perm), Perm, D).main() @ &m : res] - - Pr[Experiment(IRO, S(IRO), D).main() @ &m : res]| + - Pr[Experiment(IdealFunctionalityThatAbsorbs, S(IdealFunctionalityThatAbsorbs), D).main() @ &m : res]| < eps'. proof. admit. (** FILL ME IN **) qed. \ No newline at end of file From 5656a1b1d7db4f810c686380f63e3646c88fdfe0 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Fri, 23 Oct 2015 16:00:40 +0200 Subject: [PATCH 034/525] remove unused stuff --- proof/LeakyAbsorb.ec | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/proof/LeakyAbsorb.ec b/proof/LeakyAbsorb.ec index 1e5e6dd..44072f2 100644 --- a/proof/LeakyAbsorb.ec +++ b/proof/LeakyAbsorb.ec @@ -18,10 +18,9 @@ op bdist : block distr. op b0 : block. op c0 : capacity. -op b2bits : block -> bool list. op (^) : block -> block -> block. -op pad : bool list -> block list. + (* -------------------------------------------------------------------- *) clone import LazyRP as Perm with From 06f2d6aae544cd8b75a7016931d847c377ee27fe Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Fri, 23 Oct 2015 17:20:04 +0200 Subject: [PATCH 035/525] One more intermediate level. --- proof/Absorb.ec | 67 ++++++++++++++++++++++++++++++++++++++++++++ proof/Blocks.ec | 7 +++-- proof/LeakyAbsorb.ec | 2 +- proof/RndOrcl.eca | 36 ++++++++++++------------ 4 files changed, 91 insertions(+), 21 deletions(-) create mode 100644 proof/Absorb.ec diff --git a/proof/Absorb.ec b/proof/Absorb.ec new file mode 100644 index 0000000..4fb40a6 --- /dev/null +++ b/proof/Absorb.ec @@ -0,0 +1,67 @@ +(* -------------------------------------------------------------------- *) +require import Option Pair Int Real List. +require (*--*) Common LazyRP RndOrcl Indifferentiability. + +op ( * ): 'a NewDistr.distr -> 'b NewDistr.distr -> ('a * 'b) distr. +op cast: 'a NewDistr.distr -> 'a distr. + +(* -------------------------------------------------------------------- *) +clone include Common. + +(* -------------------------------------------------------------------- *) +op valid: block list -> bool. (* is in the image of the padding function *) +axiom valid_lb m: + valid m => + forall n, m <> mkseq (fun k => b0) n. + +clone import RndOrcl as RO with + type from <- block list, + type to <- block, + op Ideal.sample (x : block list) <- cast bdistr. +clone import Ideal. (* ?? Nested abstract theories... we don't like them *) + +clone import LazyRP as Perm with + type D <- block * capacity, + op d <- bdistr * Capacity.cdistr + + rename [module] "P" as "Perm". + +(* -------------------------------------------------------------------- *) +clone include Indifferentiability.Core with + type Types.p <- block * capacity, + type Types.f_in <- block list, + type Types.f_out <- block + + rename + [module] "Indif" as "Experiment" + [module] "al" as "alIndif". +import Types. + +(* -------------------------------------------------------------------- *) +module BlockSponge (P : RP) : RO, CONSTRUCTION(P) = { + proc init = P.init + + proc f(p : block list): block = { + var (sa,sc) <- (b0, Capacity.c0); + + if (valid p) { + (* Absorption *) + while (p <> []) { + (sa,sc) <@ P.f(sa ^ head b0 p, sc); + p <- behead p; + } + } + return sa; + } +}. + +(* -------------------------------------------------------------------- *) +op eps : real. + +lemma top: + exists (S <: SIMULATOR), + forall (D <: DISTINGUISHER) &m, + `| Pr[Experiment(BlockSponge(Perm), Perm, D).main() @ &m : res] + - Pr[Experiment(RO, S(RO), D).main() @ &m : res]| + < eps. +proof. admit. qed. diff --git a/proof/Blocks.ec b/proof/Blocks.ec index a7ae183..a9c448e 100644 --- a/proof/Blocks.ec +++ b/proof/Blocks.ec @@ -1,5 +1,5 @@ (* -------------------------------------------------------------------- *) -require import Pair Int Real List. +require import Option Pair Int Real List. require (*--*) Common IRO LazyRP Indifferentiability. op ( * ): 'a NewDistr.distr -> 'b NewDistr.distr -> ('a * 'b) distr. @@ -9,6 +9,9 @@ clone include Common. (* -------------------------------------------------------------------- *) op valid: block list -> bool. (* is in the image of the padding function *) +axiom valid_lb m: + valid m => + m <> [] /\ nth witness m (size m - 1) <> b0. clone import IRO as BIRO with type from <- block list, @@ -42,7 +45,7 @@ module BlockSponge (P : RP) : BIRO.IRO, CONSTRUCTION(P) = { var (sa,sc) <- (b0, Capacity.c0); var i <- 0; - if (valid p) { + if (valid p) { (* Absorption *) while (p <> []) { (sa,sc) <@ P.f(sa ^ head b0 p, sc); diff --git a/proof/LeakyAbsorb.ec b/proof/LeakyAbsorb.ec index 44072f2..8695c01 100644 --- a/proof/LeakyAbsorb.ec +++ b/proof/LeakyAbsorb.ec @@ -1,6 +1,6 @@ (* -------------------------------------------------------------------- *) require import Option Pair Int Real List FSet NewFMap. -require (*--*) IRO LazyRP. +require (*--*) LazyRP. (*---*) import Dprod. (* -------------------------------------------------------------------- *) diff --git a/proof/RndOrcl.eca b/proof/RndOrcl.eca index 09d0322..96d3045 100644 --- a/proof/RndOrcl.eca +++ b/proof/RndOrcl.eca @@ -1,4 +1,4 @@ -require import NewFMap. +require import Option FSet NewFMap. (* TODO move this in NewFMap *) lemma dom_set (m:('a,'b) fmap) a b : dom m.[a<-b] = dom m `|` fset1 a. proof. by apply fsetP=> x;smt. qed. @@ -7,11 +7,11 @@ type from, to. module type RO = { proc init() : unit - proc oracle(x : from): to + proc f(x : from): to }. module type Distinguisher(G : RO) = { - proc distinguish(): bool {G.oracle} + proc distinguish(): bool {G.f} }. module IND(G:RO, D:Distinguisher) = { @@ -35,7 +35,7 @@ abstract theory Ideal. m <- map0; } - proc oracle(x : from) : to = { + proc f(x : from) : to = { var rd; rd <$ sample x; if (! mem (dom m) x) m.[x] <- rd; @@ -47,7 +47,7 @@ abstract theory Ideal. axiom sample_ll : forall x, Distr.weight (sample x) = 1%r. - lemma oracle_ll : phoare[RO.oracle : true ==> true] = 1%r. + lemma f_ll : phoare[RO.f : true ==> true] = 1%r. proof. proc;auto;progress;apply sample_ll. qed. end section LL. @@ -67,7 +67,7 @@ abstract theory GenIdeal. var work; work <- RO_dom; while (work <> fset0) { - RO.oracle(pick work); + RO.f(pick work); work = work `\` fset1 (pick work); } } @@ -77,7 +77,7 @@ abstract theory GenIdeal. sample(); } - proc oracle = RO.oracle + proc f = RO.f }. module IND_S(D:Distinguisher) = { @@ -93,7 +93,7 @@ abstract theory GenIdeal. section EAGER. local lemma eager_query: - eager [ERO.sample(); , RO.oracle ~ ERO.oracle, ERO.sample(); : + eager [ERO.sample(); , RO.f ~ ERO.f, ERO.sample(); : ={x,RO.m} ==> ={res,RO.m} ]. proof. eager proc. @@ -112,7 +112,7 @@ abstract theory GenIdeal. cut -> : mem (dom RO.m{2}) (pick work{2}) = mem (dom RO.m{1}) (pick work{2}) by rewrite !in_dom;smt. smt. auto;progress [-split];rewrite !getP_eq;smt. - inline RO.oracle. + inline RO.f. transitivity{1} { rd <$ sample x; while (work <> fset0) { x0 <- pick work; @@ -170,7 +170,7 @@ abstract theory GenIdeal. + by progress;exists (glob D){2}. + proc;inline{2} ERO.sample. while{2} true (card work{2}). - + move=> &m1 z;wp;call (oracle_ll sample_ll);auto;smt. + + move=> &m1 z;wp;call (f_ll sample_ll);auto;smt. conseq (_: _ ==> ={b,glob D}) => //;[smt | by sim]. apply (Eager_S D). qed. @@ -192,7 +192,7 @@ abstract theory FiniteIdeal. var work; work <- univ; while (work <> fset0) { - RO.oracle(pick work); + RO.f(pick work); work = work `\` fset1 (pick work); } } @@ -202,7 +202,7 @@ abstract theory FiniteIdeal. sample(); } - proc oracle(x:from):to = { return oget RO.m.[x]; } + proc f(x:from):to = { return oget RO.m.[x]; } }. module IND_S(D:Distinguisher) = { @@ -282,9 +282,9 @@ abstract theory RestrIdeal. module Restr (O:RO) = { proc init = RO.init - proc oracle (x:from) : to = { + proc f (x:from) : to = { var r <- dfl; - if (test x) r <@ RO.oracle(x); + if (test x) r <@ RO.f(x); return r; } }. @@ -294,7 +294,7 @@ abstract theory RestrIdeal. var work; work <- univ; while (work <> fset0) { - RO.oracle(pick work); + RO.f(pick work); work = work `\` fset1 (pick work); } } @@ -304,7 +304,7 @@ abstract theory RestrIdeal. sample(); } - proc oracle(x:from):to = { + proc f(x:from):to = { return (if test x then oget RO.m.[x] else dfl); } }. @@ -329,9 +329,9 @@ abstract theory RestrIdeal. local module Restr' (O:RO) = { proc init() = { } - proc oracle(x:from) = { + proc f(x:from) = { var r <- dfl; - if (test x) r <@ O.oracle(x); + if (test x) r <@ O.f(x); return r; } }. From de7a32fb7dcc024c049636371e4b268875b59c27 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Mon, 26 Oct 2015 18:27:11 +0100 Subject: [PATCH 036/525] Iterating with Alley. Broken state for now. --- proof/Absorb.ec | 5 +- proof/AbsorbToBlocks.ec | 125 ++++++++++++++++++++++++++++++++++++++++ proof/Blocks.ec | 13 ++--- proof/Common.ec | 2 +- proof/LeakyAbsorb.ec | 2 +- 5 files changed, 133 insertions(+), 14 deletions(-) create mode 100644 proof/AbsorbToBlocks.ec diff --git a/proof/Absorb.ec b/proof/Absorb.ec index 4fb40a6..89f1b12 100644 --- a/proof/Absorb.ec +++ b/proof/Absorb.ec @@ -6,13 +6,10 @@ op ( * ): 'a NewDistr.distr -> 'b NewDistr.distr -> ('a * 'b) distr. op cast: 'a NewDistr.distr -> 'a distr. (* -------------------------------------------------------------------- *) -clone include Common. +require import Common. (* -------------------------------------------------------------------- *) op valid: block list -> bool. (* is in the image of the padding function *) -axiom valid_lb m: - valid m => - forall n, m <> mkseq (fun k => b0) n. clone import RndOrcl as RO with type from <- block list, diff --git a/proof/AbsorbToBlocks.ec b/proof/AbsorbToBlocks.ec new file mode 100644 index 0000000..77f1272 --- /dev/null +++ b/proof/AbsorbToBlocks.ec @@ -0,0 +1,125 @@ +(* -------------------------------------------------------------------- *) +require import Option Pair Int Real List FSet NewFMap. +require (*--*) Absorb Blocks. + +(* -------------------------------------------------------------------- *) +require import Common. + +op ( * ): 'a NewDistr.distr -> 'b NewDistr.distr -> ('a * 'b) distr. +op cast: 'a NewDistr.distr -> 'a distr. + +op extend (bs : block list) (n : int): block list = + bs ++ (mkseq (fun k => b0) n). + +op strip_aux (bs : block list) (n : int) : block list * int = + with bs = [] => ([],n) + with bs = b :: bs => + if b = b0 + then strip_aux bs (n + 1) + else (rev (b :: bs),n). + +op strip (bs : block list) = strip_aux (rev bs) 0. + +op valid_upper (bs : block list) = + bs <> [] /\ + forallb (fun n=> strip (extend bs n) = (bs,n)). + +op valid_lower (bs : block list) = + valid_upper (strip bs).`1. + +(* PY: FIXME *) +clone Absorb as Lower with + op ( * ) <- ( * )<:'a,'b>, + op cast <- cast<:'a>, + op valid <- valid_lower. + +clone Blocks as Upper with + op ( * ) <- ( * )<:'a,'b>, + op valid <- valid_upper. + +(* -------------------------------------------------------------------- *) +module LowerFun( F : Upper.FUNCTIONALITY ) : Lower.FUNCTIONALITY = { + proc init = F.init + + proc f(p : block list): block = { + var b <- []; + var n; + + if (valid_lower p) { + (p,n) <- strip p; + b <@ F.f(p,n + 1); + } + return last b0 b; + } +}. + +module Sim ( S : Lower.SIMULATOR, F : Upper.FUNCTIONALITY ) = S(LowerFun(F)). + +module UpperFun ( F : Lower.FUNCTIONALITY ) = { + proc init = F.init + + proc f(p : block list, n : int) : block list = { + var b <- b0; + var bs <- []; + var i <- 0; + + if (valid_upper p) { + while (i < n) { + b <@ F.f(extend p i); + bs <- rcons bs b; + i <- i + 1; + } + } + + return bs; + } +}. + +module Dist ( D : Upper.DISTINGUISHER, F : Lower.FUNCTIONALITY, P : Lower.PRIMITIVE ) = D(UpperFun(F),P). + +section. + declare module LowerSim : Lower.SIMULATOR. + declare module UpperDist : Upper.DISTINGUISHER { LowerSim }. + + local equiv ModularUpper: + UpperFun(Lower.BlockSponge(Lower.Perm.Perm)).f ~ Upper.BlockSponge(Upper.Perm.Perm).f: + ={arg} + /\ ={m,mi}(Lower.Perm.Perm,Upper.Perm.Perm) + /\ (forall x, mem (dom Lower.Perm.Perm.m){1} x) + ==> ={res} + /\ ={m,mi}(Lower.Perm.Perm,Upper.Perm.Perm) + /\ (forall x, mem (dom Lower.Perm.Perm.m){1} x). + proof. + proc. sp; if=> //=. + inline Lower.BlockSponge(Lower.Perm.Perm).f. + admit. (* Fun with loops *) + qed. + + pred relation (ro : (block list,block) fmap) (iro : (block list,block list) fmap) = + (forall x y, iro.[x] = Some y => + forall i, 0 <= i < size y => ro.[extend x i] = onth y i) + /\ (forall x y, ro.[x] = Some y => + let (x',n) = strip x in + mem (dom iro) x + /\ size (oget iro.[x]) >= n + /\ nth witness (oget iro.[x]) n = y). + + local equiv ModularLower: + UpperFun(Lower.Ideal.RO).f ~ Upper.BIRO.IRO.f: + ={arg} + /\ relation Lower.Ideal.RO.m{1} Upper.BIRO.IRO.mp{2} + ==> ={res} + /\ relation Lower.Ideal.RO.m{1} Upper.BIRO.IRO.mp{2}. + proof. + proc. sp; if=> //=. + inline Lower.BlockSponge(Lower.Perm.Perm).f. + admit. (* Fun with loops *) + qed. + + lemma Conclusion &m: + `|Pr[Upper.RealIndif(Upper.Perm.Perm,Upper.BlockSponge,UpperDist).main() @ &m: res] + - Pr[Upper.IdealIndif(Upper.BIRO.IRO,Sim(LowerSim),UpperDist).main() @ &m: res]| + = `|Pr[Lower.RealIndif(Lower.Perm.Perm,Lower.BlockSponge,Dist(UpperDist)).main() @ &m: res] + - Pr[Lower.IdealIndif(Lower.Ideal.RO,LowerSim,Dist(UpperDist)).main() @ &m: res]|. + proof. admit. qed. +end section. diff --git a/proof/Blocks.ec b/proof/Blocks.ec index a9c448e..0d0ca6d 100644 --- a/proof/Blocks.ec +++ b/proof/Blocks.ec @@ -5,18 +5,15 @@ require (*--*) Common IRO LazyRP Indifferentiability. op ( * ): 'a NewDistr.distr -> 'b NewDistr.distr -> ('a * 'b) distr. (* -------------------------------------------------------------------- *) -clone include Common. +require import Common. (* -------------------------------------------------------------------- *) -op valid: block list -> bool. (* is in the image of the padding function *) -axiom valid_lb m: - valid m => - m <> [] /\ nth witness m (size m - 1) <> b0. +op valid: block list -> bool. clone import IRO as BIRO with - type from <- block list, - type to <- block, - op valid <- valid. + type from <- block list, + type to <- block, + op valid <- valid. clone import LazyRP as Perm with type D <- block * capacity, diff --git a/proof/Common.ec b/proof/Common.ec index cace21f..8df87b9 100644 --- a/proof/Common.ec +++ b/proof/Common.ec @@ -31,7 +31,7 @@ lemma bits2wK (s : bool list) : proof. admit. qed. op uniform : bword distr = - MUniform.duniform FinType.elts. + MUniform.duniform FinType.enum. end BitWord. (* -------------------------------------------------------------------- *) diff --git a/proof/LeakyAbsorb.ec b/proof/LeakyAbsorb.ec index 8695c01..077ecb1 100644 --- a/proof/LeakyAbsorb.ec +++ b/proof/LeakyAbsorb.ec @@ -55,7 +55,7 @@ module IdealFunctionalityThatDoesNotAbsorb = { var b <- b0; if (m <> []) { - while (i < size m) { + while (i <= size m) { z <- rcons z b; b <@ core(take i m,0); i <- i + 1; From 2cb924fb0f4808c8fe697aa8f8afe53a3f6a3f39 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Fri, 23 Oct 2015 17:36:15 +0200 Subject: [PATCH 037/525] Some try --- proof/LeakyAbsorb.ec | 87 +++++++++++++++++++++++++++++--------------- 1 file changed, 57 insertions(+), 30 deletions(-) diff --git a/proof/LeakyAbsorb.ec b/proof/LeakyAbsorb.ec index 077ecb1..1c3710f 100644 --- a/proof/LeakyAbsorb.ec +++ b/proof/LeakyAbsorb.ec @@ -1,6 +1,6 @@ (* -------------------------------------------------------------------- *) require import Option Pair Int Real List FSet NewFMap. -require (*--*) LazyRP. +require (*--*) LazyRP RndOrcl. (*---*) import Dprod. (* -------------------------------------------------------------------- *) @@ -18,10 +18,8 @@ op bdist : block distr. op b0 : block. op c0 : capacity. - op (^) : block -> block -> block. - (* -------------------------------------------------------------------- *) clone import LazyRP as Perm with type D <- block * capacity, @@ -29,6 +27,7 @@ clone import LazyRP as Perm with rename [module] "P" as "Perm". + (* -------------------------------------------------------------------- *) module type WeirdIRO = { proc init(): unit @@ -36,12 +35,20 @@ module type WeirdIRO = { proc f(_: block list * int): block list }. +module type WeirdIRO_ = { + proc f(_: block list * int): block list +}. + +op valid_query : block list -> int -> bool. +op valid_queries : (block list) fset. +axiom valid_queryP : forall m n, valid_query m n => mem valid_queries (m ++ n). + module IdealFunctionalityThatDoesNotAbsorb = { - var h : (block list * int,block) fmap + var h : (block list,block) fmap proc init() = { h = map0; } - proc core(m : block list * int) = { + proc core(m : block list) = { if (!mem (dom h) m) { h.[m] <$ bdist; } @@ -49,20 +56,21 @@ module IdealFunctionalityThatDoesNotAbsorb = { } proc f(m : block list, n : int) = { - var i <- 0; + var i <- 1; var j <- 1; var z <- []; var b <- b0; - if (m <> []) { - while (i <= size m) { + if (valid_query m n) { + while (j <= size m) { z <- rcons z b; - b <@ core(take i m,0); - i <- i + 1; + b <@ core(take j m); + j <- j + 1; } - while (j < n) { + while (i < n) { z <- rcons z b; - b <@ core(m,j); + m <- rcons m b0; + b <@ core(m); j <- j + 1; } } @@ -71,27 +79,17 @@ module IdealFunctionalityThatDoesNotAbsorb = { }. module IdealFunctionalityThatAbsorbs = { - var h : (block list * int,block) fmap - - proc init() = { h = map0; } - - proc core (m : block list * int) = { - if (!mem (dom h) m) { - h.[m] <$ bdist; - } - return oget h.[m]; - } - proc f(m : block list, n : int) = { var j <- 1; var z <- []; var b; - if (m <> []) { - b <@ core(m,0); + if (valid_query m n) { + b <@ IdealFunctionalityThatDoesNotAbsorb.core(m); while (j < n) { z <- rcons z b; - b <@ core(m,j); + m <- rcons m b0; + b <@ IdealFunctionalityThatDoesNotAbsorb.core(m); j <- j + 1; } } @@ -114,8 +112,8 @@ module type SIMULATOR(F : WeirdIRO) = { proc fi(_ : block * capacity) : block * capacity }. -module type DISTINGUISHER(F : WeirdIRO, P : RP) = { - proc distinguish() : bool +module type DISTINGUISHER(F : WeirdIRO_, P : RP_) = { + proc distinguish() : bool }. (* -------------------------------------------------------------------- *) @@ -141,7 +139,7 @@ module SpongeThatDoesNotAbsorb (P : RP) : WeirdIRO, CONSTRUCTION(P) = { var i <- 0; var l <- size p; - if (p <> [] /\ nth witness p (size p - 1) <> b0) { + if (valid_query p n) { (* Absorption *) while (p <> []) { z <- rcons z sa; @@ -167,7 +165,7 @@ module SpongeThatAbsorbs (P : RP) : WeirdIRO, CONSTRUCTION(P) = { var (sa,sc) <- (b0, c0); var i <- 0; - if (p <> [] /\ nth witness p (size p - 1) <> b0) { + if (valid_query p n) { (* Absorption *) while (p <> []) { (sa,sc) <@ P.f(sa ^ head b0 p, sc); @@ -185,6 +183,35 @@ module SpongeThatAbsorbs (P : RP) : WeirdIRO, CONSTRUCTION(P) = { }. (* -------------------------------------------------------------------- *) +section PROOF. + declare module S:SIMULATOR { IdealFunctionalityThatDoesNotAbsorb }. + declare module D:DISTINGUISHER { Perm, IdealFunctionalityThatDoesNotAbsorb, S }. + + (* From DoNot to Absorb *) + + module MkF(F:WeirdIRO_) = { + proc f(m:block list, n:int) = { + var r = []; + if (valid_query m n) { + r <@ F.f(m,n); + r <- drop (size m) r; + } + return r; + } + }. + + module MkD (D:DISTINGUISHER, F:WeirdIRO, P:RP) = D(MkF(F),P). + + lemma conclusion &m: + `| Pr[Experiment(SpongeThatDoesNotAbsorb(Perm), Perm, MkD(D)).main() @ &m : res] + - Pr[Experiment(IdealFunctionalityThatDoesNotAbsorb, + S(IdealFunctionalityThatDoesNotAbsorb), MkD(D)).main() @ &m : res] | = + `|Pr[Experiment(SpongeThatAbsorb(Perm),Perm,D).main() @ &m : res] - + -Pr[Experiment(IdealFunctionalityThatAbsorb, + S(IdealFunctionalityThatAbsorb), D) + + + op eps : real. axiom core: From 1aa7b48b259e9a51af4a7e4575eb70f54df20dfe Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Mon, 26 Oct 2015 09:26:01 +0100 Subject: [PATCH 038/525] some progress --- proof/LeakyAbsorb.ec | 60 ++++++++++++++++++++++++++++++++++++++------ 1 file changed, 52 insertions(+), 8 deletions(-) diff --git a/proof/LeakyAbsorb.ec b/proof/LeakyAbsorb.ec index 1c3710f..0943045 100644 --- a/proof/LeakyAbsorb.ec +++ b/proof/LeakyAbsorb.ec @@ -41,7 +41,7 @@ module type WeirdIRO_ = { op valid_query : block list -> int -> bool. op valid_queries : (block list) fset. -axiom valid_queryP : forall m n, valid_query m n => mem valid_queries (m ++ n). +axiom valid_queryP : forall m n, valid_query m n => mem valid_queries (m ++ map (fun x => b0) (iota_ 0 n)). module IdealFunctionalityThatDoesNotAbsorb = { var h : (block list,block) fmap @@ -79,6 +79,8 @@ module IdealFunctionalityThatDoesNotAbsorb = { }. module IdealFunctionalityThatAbsorbs = { + proc init = IdealFunctionalityThatDoesNotAbsorb.init + proc f(m : block list, n : int) = { var j <- 1; var z <- []; @@ -131,7 +133,7 @@ module Experiment(F : WeirdIRO, P : RP, D : DISTINGUISHER) = { (* -------------------------------------------------------------------- *) module SpongeThatDoesNotAbsorb (P : RP) : WeirdIRO, CONSTRUCTION(P) = { - proc init = P.init + proc init () = { } proc f(p : block list, n : int): block list = { var z <- []; @@ -158,7 +160,7 @@ module SpongeThatDoesNotAbsorb (P : RP) : WeirdIRO, CONSTRUCTION(P) = { }. module SpongeThatAbsorbs (P : RP) : WeirdIRO, CONSTRUCTION(P) = { - proc init = P.init + proc init () = {} proc f(p : block list, n : int): block list = { var z <- []; @@ -199,16 +201,58 @@ section PROOF. return r; } }. - - module MkD (D:DISTINGUISHER, F:WeirdIRO, P:RP) = D(MkF(F),P). + + (* From Absord to do Not *) + module MkD (D:DISTINGUISHER, F:WeirdIRO_, P:RP_) = D(MkF(F),P). + + module MkFdoNot (F:WeirdIRO) = { + proc init = F.init + proc f(m:block list, n:int) : block list = { + var i, r, tl, b; + r <- []; + if (valid_query m n) { + i <- 0; + while (i < size m - 1) { + b <- F.f(take i m, 1); + i <- i + 1; + r <- r ++ b; + } + tl <- F.f(m,n); + r <- r ++ tl; + } + return r; + } + }. + + module MkS(S:SIMULATOR, F:WeirdIRO) = S(MkFdoNot(F)). + + local clone lemma conclusion &m: `| Pr[Experiment(SpongeThatDoesNotAbsorb(Perm), Perm, MkD(D)).main() @ &m : res] - Pr[Experiment(IdealFunctionalityThatDoesNotAbsorb, S(IdealFunctionalityThatDoesNotAbsorb), MkD(D)).main() @ &m : res] | = - `|Pr[Experiment(SpongeThatAbsorb(Perm),Perm,D).main() @ &m : res] - - -Pr[Experiment(IdealFunctionalityThatAbsorb, - S(IdealFunctionalityThatAbsorb), D) + `|Pr[Experiment(SpongeThatAbsorbs(Perm),Perm,D).main() @ &m : res] - + -Pr[Experiment(IdealFunctionalityThatAbsorbs, MkS(S,IdealFunctionalityThatAbsorbs), D).main() @ &m : res]|. + proof. + congr;congr. + + byequiv (_: ={glob D} ==> _) => //;proc;inline *. + call (_: ={glob Perm});1,2:(by sim); last by auto. + proc;inline{1}SpongeThatDoesNotAbsorb(Perm).f;sp 1 3;if=> //. + sp;rcondt{1} 1=> //;wp. + while (={glob Perm, i, sa, sc} /\ n0{1} = n{2} /\ z{1} = take (size m{1}) z{1} ++ z{2} /\ size m{1} <= size z{1}). + + call (_ : ={glob Perm});[by sim|auto;progress [-split];smt]. + while (={glob Perm, p, sa,sc} /\ (size z = size m - size p){1}). + + wp;call (_ : ={glob Perm});[by sim|auto;progress [-split];smt]. + by auto;progress [-split];smt. + + + auto. + +smt. smt. +search drop. + +sim. + From 47825a6af73a0fd3169b0be14627aba794333df1 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Mon, 26 Oct 2015 19:36:40 +0100 Subject: [PATCH 039/525] absorbs <-> does not absurd --- proof/LeakyAbsorb.ec | 255 +++++++++++++++++++++++++++++++++---------- 1 file changed, 198 insertions(+), 57 deletions(-) diff --git a/proof/LeakyAbsorb.ec b/proof/LeakyAbsorb.ec index 0943045..5b487ee 100644 --- a/proof/LeakyAbsorb.ec +++ b/proof/LeakyAbsorb.ec @@ -1,17 +1,16 @@ (* -------------------------------------------------------------------- *) -require import Option Pair Int Real List FSet NewFMap. -require (*--*) LazyRP RndOrcl. +require import Option Pair Int Real Distr List FSet NewFMap. +require (*--*) LazyRP RndOrcl. (*---*) import Dprod. (* -------------------------------------------------------------------- *) -op r : { int | 0 < r } as gt0_r. -op c : { int | 0 < c } as gt0_c. type block. (* = {0,1}^r *) type capacity. (* = {0,1}^c *) op cdist : capacity distr. op bdist : block distr. +axiom bdist_ll : weight bdist = 1%r. (* isomorphic to the {0,1}^? uniform distributions *) @@ -41,19 +40,32 @@ module type WeirdIRO_ = { op valid_query : block list -> int -> bool. op valid_queries : (block list) fset. -axiom valid_queryP : forall m n, valid_query m n => mem valid_queries (m ++ map (fun x => b0) (iota_ 0 n)). +axiom valid_queryP : forall m n, valid_query m n => forall k, 0 <= k <= n => mem valid_queries (m ++ map (fun x => b0) (iota_ 0 k)). +axiom valid_query_take : forall m n, valid_query m n => forall i, 0 <= i <= size m => mem valid_queries (take i m). +axiom valid_query_take1 : + forall m n, valid_query m n => forall i, 0 <= i <= size m => valid_query (take i m) 1. +axiom valid_query_size : forall m n, valid_query m n => 1 <= size m. + +module type RO = { + proc init () : unit + proc f(_:block list) : block +}. -module IdealFunctionalityThatDoesNotAbsorb = { +module Ro = { var h : (block list,block) fmap proc init() = { h = map0; } - proc core(m : block list) = { - if (!mem (dom h) m) { - h.[m] <$ bdist; - } + proc f(m : block list) = { + var r; + r <$ bdist; + if (!mem (dom h) m) h.[m] <- r ; return oget h.[m]; } +}. + +module GenIdealFunctionalityThatDoesNotAbsorb(Ro:RO) = { + proc init = Ro.init proc f(m : block list, n : int) = { var i <- 1; @@ -64,41 +76,45 @@ module IdealFunctionalityThatDoesNotAbsorb = { if (valid_query m n) { while (j <= size m) { z <- rcons z b; - b <@ core(take j m); + b <@ Ro.f(take j m); j <- j + 1; } while (i < n) { z <- rcons z b; m <- rcons m b0; - b <@ core(m); - j <- j + 1; + b <@ Ro.f(m); + i <- i + 1; } } return z; } }. -module IdealFunctionalityThatAbsorbs = { - proc init = IdealFunctionalityThatDoesNotAbsorb.init +module IdealFunctionalityThatDoesNotAbsorb = GenIdealFunctionalityThatDoesNotAbsorb(Ro). + +module GenIdealFunctionalityThatAbsorbs(Ro:RO) = { + proc init = Ro.init proc f(m : block list, n : int) = { - var j <- 1; + var i <- 1; var z <- []; var b; if (valid_query m n) { - b <@ IdealFunctionalityThatDoesNotAbsorb.core(m); - while (j < n) { + b <@ Ro.f(m); + while (i < n) { z <- rcons z b; m <- rcons m b0; - b <@ IdealFunctionalityThatDoesNotAbsorb.core(m); - j <- j + 1; + b <@ Ro.f(m); + i<- i + 1; } } return z; } }. +module IdealFunctionalityThatAbsorbs = GenIdealFunctionalityThatAbsorbs(Ro). + (* -------------------------------------------------------------------- *) module type CONSTRUCTION(P : RP) = { proc init() : unit @@ -106,7 +122,7 @@ module type CONSTRUCTION(P : RP) = { proc f(bp : block list, n : int) : block list }. -module type SIMULATOR(F : WeirdIRO) = { +module type SIMULATOR(F : WeirdIRO_) = { proc init() : unit proc f(_ : block * capacity) : block * capacity @@ -205,17 +221,18 @@ section PROOF. (* From Absord to do Not *) module MkD (D:DISTINGUISHER, F:WeirdIRO_, P:RP_) = D(MkF(F),P). - module MkFdoNot (F:WeirdIRO) = { - proc init = F.init + module MkFdoNot1 (F:WeirdIRO_) = { proc f(m:block list, n:int) : block list = { var i, r, tl, b; r <- []; if (valid_query m n) { - i <- 0; - while (i < size m - 1) { + i <- 1; + b <- [b0]; + while (i <= size m) { + r <- r ++ b; b <- F.f(take i m, 1); i <- i + 1; - r <- r ++ b; + } tl <- F.f(m,n); r <- r ++ tl; @@ -224,16 +241,127 @@ section PROOF. } }. + module MkFdoNot (F:WeirdIRO) = { + proc init = F.init + proc f = MkFdoNot1(F).f + }. + module MkS(S:SIMULATOR, F:WeirdIRO) = S(MkFdoNot(F)). - local clone + local clone RndOrcl as RndOrcl0 with + type from <- block list, + type to <- block. + + local clone RndOrcl0.RestrIdeal as RI with + op sample <- fun (bl:block list) => bdist, + op test <- (mem valid_queries), + op univ <- valid_queries, + op dfl <- b0 + proof *. + realize sample_ll. by move=> _;apply bdist_ll. qed. + realize testP. by []. qed. + import RI. + + local module E1 (Ro:RO) = { + module F = { + proc f = GenIdealFunctionalityThatDoesNotAbsorb(Ro).f + } + module P = S(F) + proc distinguish () : bool = { + var b; + P.init(); + b <@ MkD(D, F, P).distinguish(); + return b; + } + }. + + local module E2 (Ro:RO) = { + module F = { + proc f = GenIdealFunctionalityThatAbsorbs(Ro).f + } + module P = S(MkFdoNot1(F)) + proc distinguish () : bool = { + var b; + P.init(); + b <@ D(F, P).distinguish(); + return b; + } + }. + + local equiv f_f : + GenIdealFunctionalityThatDoesNotAbsorb(Ro).f ~ E1(Restr(RO)).F.f : + ={m, n} /\ Ro.h{1} = RO.m{2} ==> ={res} /\ Ro.h{1} = RO.m{2}. + proof. + proc;sp;if => //. + inline{2} Restr(RO).f. + while (={z,i,n,b,m} /\ Ro.h{1} = RO.m{2} /\ + (forall k, 0 <= k <= n - i => mem valid_queries (m ++ map (fun x => b0) (iota_ 0 k))){2}). + + rcondt{2} 5=> //. + + auto;progress; rewrite - cats1;cut := H 1 _; [by smt| by rewrite iota1]. + auto; call (_:Ro.h{1} = RO.m{2});[by sim | auto;progress]. + cut := H (k+1) _;1:by smt. + rewrite iotaS //= -cats1 -catA /= (_: map (fun (x : int) => b0) (iota_ 1 k) = map (fun (x : int) => b0) (iota_ 0 k)) //. + by rewrite (iota_addl 1 0 k) -map_comp;apply eq_map. + while (={z,j,n,b,m} /\ Ro.h{1} = RO.m{2} /\ valid_query m{1} n{1} /\ 0 <= j{1}). + + rcondt{2} 4=> //. + + auto;progress;apply (valid_query_take _ _ H)=> //. + auto; call (_:Ro.h{1} = RO.m{2});[by sim | auto;progress;smt]. + skip;progress;apply (valid_queryP _ _ H2);smt. + qed. + + local equiv f_f_a : GenIdealFunctionalityThatAbsorbs(Ro).f ~ E2(Restr(RO)).F.f : ={m,n} /\ Ro.h{1} = RO.m{2} ==> ={res} /\ Ro.h{1} = RO.m{2}. + proof. + proc; sp;if=> //;inline{2} Restr(RO).f;sp. + rcondt{2} 1=> //. + + auto;progress;cut := valid_query_take _ _ H (size m{hr}). + rewrite take_size=> HH;apply HH;smt. + while (={z,i,n,b,m} /\ Ro.h{1} = RO.m{2} /\ + (forall k, 0 <= k <= n - i => mem valid_queries (m ++ map (fun x => b0) (iota_ 0 k))){2}). + + rcondt{2} 5=> //. + + auto;progress; rewrite -cats1;cut := H 1 _; [by smt| by rewrite iota1]. + auto; call (_:Ro.h{1} = RO.m{2});[by sim | auto;progress]. + cut := H (k+1) _;1:by smt. + rewrite iotaS //= -cats1 -catA /= (_: map (fun (x : int) => b0) (iota_ 1 k) = map (fun (x : int) => b0) (iota_ 0 k)) //. + by rewrite (iota_addl 1 0 k) -map_comp;apply eq_map. + wp;call (_:Ro.h{1} = RO.m{2});[by sim | auto;progress]. + apply (valid_queryP _ _ H);smt. + qed. + + local equiv f_f' : + MkFdoNot(GenIdealFunctionalityThatAbsorbs(Ro)).f ~ MkFdoNot1(E2(Restr(RO)).F).f : + ={m, n} /\ Ro.h{1} = RO.m{2} ==> + ={res} /\ Ro.h{1} = RO.m{2}. + proof. + proc;sp;if => //;wp. + call f_f_a. + while (={i,m,r,b} /\ Ro.h{1} = RO.m{2} /\ valid_query m{1} n{1} /\ 0 <= i{1});last by auto. + wp; call f_f_a;auto;progress;smt. + qed. + + local equiv f_dN : E1(ERO).F.f ~ MkFdoNot1(E2(ERO).F).f : ={m, n} /\ ={RO.m} ==> ={res, RO.m}. + proof. + proc;sp;if=> //;sp. + inline {2} E2(ERO).F.f. + rcondt{2} 6;auto; 1: by conseq (_: _ ==> true). + while (={RO.m} /\ z{1} = r{2} ++ z0{2} /\ i{1} = i1{2} /\ n{1} = n1{2} /\ b{1} = b1{2} /\ + m{1} = m1{2}). + + inline *;auto;progress;smt. + inline ERO.f;auto. + while (={RO.m,m,n} /\ z{1} = r{2} /\ b{2} = [b{1}] /\ valid_query m{1} n{1} /\ + j{1} = i{2} /\ 0 <= i{2} /\ + (1 < j => b = mem valid_queries (take j m) ? oget RO.m.[x] : Self.b0){1}). + + rcondt{2} 6;1:by auto;progress;smt. + rcondf{2} 8;1:by auto. + auto;progress;smt. + auto;progress;smt. + qed. lemma conclusion &m: `| Pr[Experiment(SpongeThatDoesNotAbsorb(Perm), Perm, MkD(D)).main() @ &m : res] - Pr[Experiment(IdealFunctionalityThatDoesNotAbsorb, S(IdealFunctionalityThatDoesNotAbsorb), MkD(D)).main() @ &m : res] | = - `|Pr[Experiment(SpongeThatAbsorbs(Perm),Perm,D).main() @ &m : res] - - -Pr[Experiment(IdealFunctionalityThatAbsorbs, MkS(S,IdealFunctionalityThatAbsorbs), D).main() @ &m : res]|. + `|Pr[Experiment(SpongeThatAbsorbs(Perm),Perm,D).main() @ &m : res] + - Pr[Experiment(IdealFunctionalityThatAbsorbs, MkS(S,IdealFunctionalityThatAbsorbs), D).main() @ &m : res]|. proof. congr;congr. + byequiv (_: ={glob D} ==> _) => //;proc;inline *. @@ -245,31 +373,44 @@ section PROOF. while (={glob Perm, p, sa,sc} /\ (size z = size m - size p){1}). + wp;call (_ : ={glob Perm});[by sim|auto;progress [-split];smt]. by auto;progress [-split];smt. - + - auto. - -smt. smt. -search drop. - -sim. - - - - -op eps : real. - -axiom core: - exists (S <: SIMULATOR), - forall (D <: DISTINGUISHER) &m, - `| Pr[Experiment(SpongeThatDoesNotAbsorb(Perm), Perm, D).main() @ &m : res] - - Pr[Experiment(IdealFunctionalityThatDoesNotAbsorb, S(IdealFunctionalityThatDoesNotAbsorb), D).main() @ &m : res]| - < eps. - -lemma top: - exists eps', - exists (S <: SIMULATOR), - forall (D <: DISTINGUISHER) &m, - `| Pr[Experiment(SpongeThatAbsorbs(Perm), Perm, D).main() @ &m : res] - - Pr[Experiment(IdealFunctionalityThatAbsorbs, S(IdealFunctionalityThatAbsorbs), D).main() @ &m : res]| - < eps'. -proof. admit. (** FILL ME IN **) qed. \ No newline at end of file + cut -> : Pr[Experiment(IdealFunctionalityThatDoesNotAbsorb, S(IdealFunctionalityThatDoesNotAbsorb), MkD(D)).main () @ &m : res] = + Pr[RndOrcl0.IND(Restr(RO), E1).main() @ &m : res]. + + byequiv=> //. (* PY: BUG printer res *) + proc;inline{2} E1(Restr(RO)).distinguish;auto. + call (_: ={glob S} /\ Ro.h{1} = RO.m{2}). + + by proc (Ro.h{1} = RO.m{2}) => //;apply f_f. + + by proc (Ro.h{1} = RO.m{2}) => //;apply f_f. + + by proc;sp;if=> //;wp;call f_f. + by inline *; call (_: Ro.h{1} = RO.m{2});auto;apply f_f. + cut -> : Pr[Experiment(IdealFunctionalityThatAbsorbs, MkS(S, IdealFunctionalityThatAbsorbs), D).main() @ &m : res] = + Pr[RndOrcl0.IND(Restr(RO), E2).main() @ &m : res]. + + byequiv=> //. + proc;inline{2} E2(Restr(RO)).distinguish;auto. + call (_: ={glob S} /\ Ro.h{1} = RO.m{2}). + + proc (Ro.h{1} = RO.m{2}) => //; apply f_f'. + + by proc (Ro.h{1} = RO.m{2}) => //;apply f_f'. + + conseq f_f_a => //. + by inline *;call (_:Ro.h{1} = RO.m{2});[apply f_f'|auto]. + cut -> : Pr[RndOrcl0.IND(Restr(RO), E1).main() @ &m : res] = + Pr[RndOrcl0.IND(ERO, E1).main() @ &m : res]. + + byequiv (Eager E1)=> //. + cut -> : Pr[RndOrcl0.IND(Restr(RO), E2).main() @ &m : res] = + Pr[RndOrcl0.IND(ERO, E2).main() @ &m : res]. + + byequiv (Eager E2)=> //. + byequiv=> //. + proc; inline *;wp. + call (_: ={RO.m, glob S}). + + by proc (={RO.m})=> //;apply f_dN. + + by proc (={RO.m})=> //;apply f_dN. + + proc;sp;if => //. + inline{1} E1(ERO).F.f;sp;rcondt{1} 1; 1:by auto. + wp;while (={RO.m,i,b} /\ n0{1} = n{2} /\ m0{1} = m{2} /\ z{1} = take (size m{1}) z{1} ++ z{2} /\ (size m <= size z){1}). + + inline *;auto;progress [-split]; smt. + inline *;splitwhile{1} 1 : (j < size m0). + wp;seq 1 0 : (={i,RO.m, m, glob S} /\ n0{1} = n{2} /\ m0{1} = m{2} /\ size m0{1} - 1 = size z{1} /\ size m0{1} = j{1} /\ z{2} = []). + while{1} (size z{1} = j{1} - 1 /\ j{1} <= size m0{1}) ((size m0 - j){1});auto;progress [-split]; smt. + rcondt{1} 1;1:by auto. + rcondf{1} 5;auto;progress[-split];smt. + call (_: ={RO.m})=> //;1:by apply f_dN. + sim : (={glob S, glob D, RO.m})=> //. + qed. From de4b23f74a0a4c55ca34ed6f9a04debf99c03021 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Tue, 27 Oct 2015 10:42:38 +0100 Subject: [PATCH 040/525] Intermediate lemma. --- proof/AbsorbToBlocks.ec | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/proof/AbsorbToBlocks.ec b/proof/AbsorbToBlocks.ec index 77f1272..b9dd5e9 100644 --- a/proof/AbsorbToBlocks.ec +++ b/proof/AbsorbToBlocks.ec @@ -75,6 +75,8 @@ module UpperFun ( F : Lower.FUNCTIONALITY ) = { } }. +module UpperOfLowerBlockSponge (P : Upper.PRIMITIVE) = UpperFun(Lower.BlockSponge(P)). + module Dist ( D : Upper.DISTINGUISHER, F : Lower.FUNCTIONALITY, P : Lower.PRIMITIVE ) = D(UpperFun(F),P). section. @@ -116,6 +118,15 @@ section. admit. (* Fun with loops *) qed. +print Upper.RealIndif. + + lemma Intermediate &m: + `|Pr[Upper.RealIndif(Upper.Perm.Perm,UpperOfLowerBlockSponge,UpperDist).main() @ &m: res] + - Pr[Upper.IdealIndif(UpperFun(Lower.Ideal.RO),Sim(LowerSim),UpperDist).main() @ &m: res]| + = `|Pr[Lower.RealIndif(Lower.Perm.Perm,Lower.BlockSponge,Dist(UpperDist)).main() @ &m: res] + - Pr[Lower.IdealIndif(Lower.Ideal.RO,LowerSim,Dist(UpperDist)).main() @ &m: res]|. + proof. admit. qed. + lemma Conclusion &m: `|Pr[Upper.RealIndif(Upper.Perm.Perm,Upper.BlockSponge,UpperDist).main() @ &m: res] - Pr[Upper.IdealIndif(Upper.BIRO.IRO,Sim(LowerSim),UpperDist).main() @ &m: res]| From ee010c8062cc627eb7bd09546f19b01a766723b9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Tue, 27 Oct 2015 19:40:49 +0100 Subject: [PATCH 041/525] Some progress. May be broken. --- proof/Absorb.ec | 9 +- proof/AbsorbToBlocks.ec | 215 ++++++++++++++++++++++++++++++----- proof/Blocks.ec | 14 +-- proof/Common.ec | 12 +- proof/IRO.eca | 72 ++++++++++++ proof/Indifferentiability.ec | 2 +- 6 files changed, 272 insertions(+), 52 deletions(-) diff --git a/proof/Absorb.ec b/proof/Absorb.ec index 89f1b12..dbc570d 100644 --- a/proof/Absorb.ec +++ b/proof/Absorb.ec @@ -2,7 +2,6 @@ require import Option Pair Int Real List. require (*--*) Common LazyRP RndOrcl Indifferentiability. -op ( * ): 'a NewDistr.distr -> 'b NewDistr.distr -> ('a * 'b) distr. op cast: 'a NewDistr.distr -> 'a distr. (* -------------------------------------------------------------------- *) @@ -16,12 +15,6 @@ clone import RndOrcl as RO with type to <- block, op Ideal.sample (x : block list) <- cast bdistr. clone import Ideal. (* ?? Nested abstract theories... we don't like them *) - -clone import LazyRP as Perm with - type D <- block * capacity, - op d <- bdistr * Capacity.cdistr - - rename [module] "P" as "Perm". (* -------------------------------------------------------------------- *) clone include Indifferentiability.Core with @@ -35,7 +28,7 @@ clone include Indifferentiability.Core with import Types. (* -------------------------------------------------------------------- *) -module BlockSponge (P : RP) : RO, CONSTRUCTION(P) = { +module BlockSponge (P : PRIMITIVE) : RO, CONSTRUCTION(P) = { proc init = P.init proc f(p : block list): block = { diff --git a/proof/AbsorbToBlocks.ec b/proof/AbsorbToBlocks.ec index b9dd5e9..03696ba 100644 --- a/proof/AbsorbToBlocks.ec +++ b/proof/AbsorbToBlocks.ec @@ -5,7 +5,6 @@ require (*--*) Absorb Blocks. (* -------------------------------------------------------------------- *) require import Common. -op ( * ): 'a NewDistr.distr -> 'b NewDistr.distr -> ('a * 'b) distr. op cast: 'a NewDistr.distr -> 'a distr. op extend (bs : block list) (n : int): block list = @@ -20,6 +19,19 @@ op strip_aux (bs : block list) (n : int) : block list * int = op strip (bs : block list) = strip_aux (rev bs) 0. +lemma ge0_strip_aux n bs: + 0 <= n => + 0 <= (strip_aux bs n).`2. +proof. + elim bs n=> //= b bs ih n le0_n. + case (b = b0)=> //=. + by rewrite (ih (n + 1) _) 1:smt. +qed. + +lemma ge0_strip2 bs: + 0 <= (strip bs).`2. +proof. by rewrite /strip; exact/(ge0_strip_aux 0 (rev bs)). qed. + op valid_upper (bs : block list) = bs <> [] /\ forallb (fun n=> strip (extend bs n) = (bs,n)). @@ -29,12 +41,10 @@ op valid_lower (bs : block list) = (* PY: FIXME *) clone Absorb as Lower with - op ( * ) <- ( * )<:'a,'b>, op cast <- cast<:'a>, op valid <- valid_lower. clone Blocks as Upper with - op ( * ) <- ( * )<:'a,'b>, op valid <- valid_upper. (* -------------------------------------------------------------------- *) @@ -80,57 +90,200 @@ module UpperOfLowerBlockSponge (P : Upper.PRIMITIVE) = UpperFun(Lower.BlockSpong module Dist ( D : Upper.DISTINGUISHER, F : Lower.FUNCTIONALITY, P : Lower.PRIMITIVE ) = D(UpperFun(F),P). section. - declare module LowerSim : Lower.SIMULATOR. - declare module UpperDist : Upper.DISTINGUISHER { LowerSim }. + declare module LowerSim : Lower.SIMULATOR { Perm, Upper.BIRO.IRO', Lower.Ideal.RO }. + declare module UpperDist : Upper.DISTINGUISHER { Perm, Upper.BIRO.IRO', Lower.Ideal.RO, LowerSim }. - local equiv ModularUpper: - UpperFun(Lower.BlockSponge(Lower.Perm.Perm)).f ~ Upper.BlockSponge(Upper.Perm.Perm).f: + local equiv ModularUpper_Real: + UpperFun(Lower.BlockSponge(Perm)).f ~ Upper.BlockSponge(Perm).f: ={arg} - /\ ={m,mi}(Lower.Perm.Perm,Upper.Perm.Perm) - /\ (forall x, mem (dom Lower.Perm.Perm.m){1} x) + /\ ={m,mi}(Perm,Perm) + /\ (forall x, mem (dom Perm.m){1} x) ==> ={res} - /\ ={m,mi}(Lower.Perm.Perm,Upper.Perm.Perm) - /\ (forall x, mem (dom Lower.Perm.Perm.m){1} x). + /\ ={m,mi}(Perm,Perm) + /\ (forall x, mem (dom Perm.m){1} x). proof. proc. sp; if=> //=. - inline Lower.BlockSponge(Lower.Perm.Perm).f. + inline Lower.BlockSponge(Perm).f. admit. (* Fun with loops *) qed. - pred relation (ro : (block list,block) fmap) (iro : (block list,block list) fmap) = - (forall x y, iro.[x] = Some y => - forall i, 0 <= i < size y => ro.[extend x i] = onth y i) - /\ (forall x y, ro.[x] = Some y => - let (x',n) = strip x in - mem (dom iro) x - /\ size (oget iro.[x]) >= n - /\ nth witness (oget iro.[x]) n = y). + pred lower (ro : (block list,block) fmap) (iro : (block list * int,block) fmap) = + Upper.BIRO.prefix_closed iro /\ + forall x n, valid_upper x => iro.[(x,n)] = ro.[extend x n]. local equiv ModularLower: - UpperFun(Lower.Ideal.RO).f ~ Upper.BIRO.IRO.f: + UpperFun(Lower.Ideal.RO).f ~ Upper.BIRO.IRO'.f: ={arg} - /\ relation Lower.Ideal.RO.m{1} Upper.BIRO.IRO.mp{2} + /\ lower Lower.Ideal.RO.m{1} Upper.BIRO.IRO'.mp{2} ==> ={res} - /\ relation Lower.Ideal.RO.m{1} Upper.BIRO.IRO.mp{2}. + /\ lower Lower.Ideal.RO.m{1} Upper.BIRO.IRO'.mp{2}. proof. proc. sp; if=> //=. - inline Lower.BlockSponge(Lower.Perm.Perm).f. + inline Lower.BlockSponge(Perm).f. admit. (* Fun with loops *) qed. -print Upper.RealIndif. + pred upper (ro : (block list,block) fmap) (iro : (block list * int,block) fmap) = + (forall x y, valid_lower x => ro.[x] = Some y => iro.[strip x] = Some y) + /\ (forall x n y, + valid_upper x => + iro.[(x,n)] = Some y => + exists n', + n <= n' + /\ mem (dom ro) (extend x n')). + + module LowIRO' : Lower.FUNCTIONALITY = { + proc init = Upper.BIRO.IRO'.init + proc f(x : block list) = { + var b <- b0; + + if (valid_lower x) { + b <@ Upper.BIRO.IRO'.f_lazy(strip x); + } + + return b; + } + }. + + pred holey_map (iro iro_lazy : (block list * int,block) fmap) = + Upper.BIRO.prefix_closed iro + /\ (forall xn, + mem (dom iro_lazy) xn => + iro_lazy.[xn] = iro.[xn]) + /\ (forall x n, + mem (dom iro) (x,n) => + exists n', + n <= n' + /\ mem (dom iro_lazy) (x,n')). + + (** Essentially, we can delay sampling every entry in the left map + whose index is not in the index of the right map, as they have + not ben given to the adversary. **) + local lemma LazifyIRO: + eager [Upper.BIRO.IRO'.resample_invisible(); , LowerFun(Upper.BIRO.IRO').f ~ LowIRO'.f, Upper.BIRO.IRO'.resample_invisible();: + ={arg, Upper.BIRO.IRO'.visible} + /\ holey_map Upper.BIRO.IRO'.mp{1} Upper.BIRO.IRO'.mp{2} + /\ Upper.BIRO.IRO'.visible{2} = dom (Upper.BIRO.IRO'.mp){2} + ==> ={res, Upper.BIRO.IRO'.visible} + /\ holey_map Upper.BIRO.IRO'.mp{1} Upper.BIRO.IRO'.mp{2} + /\ Upper.BIRO.IRO'.visible{2} = dom (Upper.BIRO.IRO'.mp){2}]. + proof. + eager proc. + case (!valid_lower p{1})=> /=. + rcondf{1} 3; 1: by auto; inline *; auto; while (true); auto. + rcondf{2} 2; 1: by auto. + inline *; auto. + rcondf{2} 4; 1: by auto; smt. + while{1} ( work{1} <= dom (Upper.BIRO.IRO'.mp){1} + /\ holey_map Upper.BIRO.IRO'.mp{1} Upper.BIRO.IRO'.mp{2} + /\ forall x, mem work{1} x => mem (dom Upper.BIRO.IRO'.mp){1} x /\ !mem (dom Upper.BIRO.IRO'.mp){2} x) + (card work{1}). + auto; progress. + + admit. (* TODO: dto lossless *) + + move=> x; rewrite domP in_fsetD in_fsetU !in_fset1. + by case (x = pick work{hr})=> //= _ /H1 [->]. + + smt. + + smt. + + have [_] [_] /(_ x1 n0 _) //= := H0. + move: H5; rewrite domP in_fsetU in_fset1=> [//=|h]. + by have [->]:= H1 (x1,n0) _; first by rewrite h mem_pick // H2. + + move: H5; rewrite domP in_fsetD in_fsetU !in_fset1. + by case (x1 = pick work{hr})=> //= _ /H1 [->]. + + move: H5; rewrite in_fsetD in_fset1. + by case (x1 = pick work{hr})=> //= _ /H1 [_ ->]. + + smt. + by auto; smt. + rcondt{1} 3; 1: by auto; inline *; auto; while (true); auto. + rcondt{2} 2; 1: by auto. + inline Upper.BIRO.IRO'.f Upper.BIRO.IRO'.f_lazy. + rcondt{1} 8; 1: by auto; inline *; auto; while (true); auto; smt. + rcondt{2} 4; 1: by auto; smt. + case ((mem (dom Upper.BIRO.IRO'.mp) (strip p)){1} /\ !(mem (dom Upper.BIRO.IRO'.mp) (strip x)){2}). + admit. (* this is the bad case where we need to bring down the sampling from resample_invisible *) + inline{2} Upper.BIRO.IRO'.resample_invisible. + rcondf{2} 9; 1: by auto; inline *; sp; if; auto; smt. + seq 1 0: ((((p{1} = x{2} /\ ={Upper.BIRO.IRO'.visible}) /\ + holey_map Upper.BIRO.IRO'.mp{1} Upper.BIRO.IRO'.mp{2} /\ + Upper.BIRO.IRO'.visible{2} = dom Upper.BIRO.IRO'.mp{2}) /\ + valid_lower p{1}) /\ + ! (mem (dom Upper.BIRO.IRO'.mp{1}) (strip p{1}) /\ + ! mem (dom Upper.BIRO.IRO'.mp{2}) (strip x{2}))). (* disgusting copy-paste. we need seq* *) + admit. + splitwhile{1} 8: (i < n0 - 1). + rcondt{1} 9. + move=> &m; while (0 <= i < n0). + by inline*; sp; if; auto; smt. + by auto; smt. + rcondf{1} 12. + move=> &m; seq 8: (i = n0 - 1). + * wp; while (0 <= i < n0). + by inline*; sp; if; auto; smt. + by auto; smt. + * inline*; sp; if; auto; smt. + admit. (* just pushing the proof through *) + qed. + + + (** This is an eager statement: + - on actual queries, the two maps agree; + - blocks in the IRO that are just generated on the way + to answering actual queries can be resampled. **) + (* Lower.Ideal.RO.f ~ LowerFun(Upper.BIRO.IRO).f: + ={arg} + /\ true + ==> ={res}. + *) lemma Intermediate &m: - `|Pr[Upper.RealIndif(Upper.Perm.Perm,UpperOfLowerBlockSponge,UpperDist).main() @ &m: res] + `|Pr[Upper.RealIndif(Perm,Upper.BlockSponge,UpperDist).main() @ &m :res] + - Pr[Upper.IdealIndif(Upper.BIRO.IRO,Sim(LowerSim),UpperDist).main() @ &m: res]| + = `|Pr[Upper.RealIndif(Perm,UpperOfLowerBlockSponge,UpperDist).main() @ &m: res] + - Pr[Upper.IdealIndif(UpperFun(Lower.Ideal.RO),Sim(LowerSim),UpperDist).main() @ &m: res]|. + proof. + have ->: Pr[Upper.RealIndif(Perm,UpperOfLowerBlockSponge,UpperDist).main() @ &m: res] + = Pr[Upper.RealIndif(Perm,Upper.BlockSponge,UpperDist).main() @ &m :res]. + byequiv=> //=; proc. + call (_: ={m,mi}(Perm,Perm) + /\ (forall x, mem (dom Perm.m){1} x)). + by proc; if; auto; smt. + by proc; if; auto; smt. + (* BUG: arg should be handled much earlier and automatically *) + by conseq ModularUpper=> //= &1 &2; case (arg{1}); case (arg{2})=> //=. + call (_: true + ==> ={glob Perm} + /\ (forall x, mem (dom Perm.m){1} x)). + admit. (* Do this with an eagerly sampled RP *) + (* Now the other initialization is dead code. *) + call (_: true ==> true)=> //. + by proc; auto. + have ->: Pr[Upper.IdealIndif(UpperFun(Lower.Ideal.RO),Sim(LowerSim),UpperDist).main() @ &m: res] + = Pr[Upper.IdealIndif(Upper.BIRO.IRO,Sim(LowerSim),UpperDist).main() @ &m: res]. + byequiv=> //=; proc. + call (_: ={glob LowerSim} /\ relation Lower.Ideal.RO.m{1} Upper.BIRO.IRO.mp{2}). + proc (relation Lower.Ideal.RO.m{1} Upper.BIRO.IRO.mp{2})=> //=. + by proc; sp; if=> //=; call ModularLower; auto. + proc (relation Lower.Ideal.RO.m{1} Upper.BIRO.IRO.mp{2})=> //=. + by proc; sp; if=> //=; call ModularLower; auto. + (* Re-Bug *) + by conseq ModularLower=> &1 &2; case (arg{1}); case (arg{2}). + inline *; wp; call (_: true)=> //=. + by sim. + auto; progress [-split]; split=> //=. + by split=> x y; rewrite map0P. + done. + qed. + + lemma Remainder &m: + `|Pr[Upper.RealIndif(Perm,UpperOfLowerBlockSponge,UpperDist).main() @ &m: res] - Pr[Upper.IdealIndif(UpperFun(Lower.Ideal.RO),Sim(LowerSim),UpperDist).main() @ &m: res]| - = `|Pr[Lower.RealIndif(Lower.Perm.Perm,Lower.BlockSponge,Dist(UpperDist)).main() @ &m: res] - - Pr[Lower.IdealIndif(Lower.Ideal.RO,LowerSim,Dist(UpperDist)).main() @ &m: res]|. + = `|Pr[Lower.RealIndif(Perm,Lower.BlockSponge,Dist(UpperDist)).main() @ &m: res] + - Pr[Lower.IdealIndif(Lower.Ideal.RO,LowerSim,Dist(UpperDist)).main() @ &m: res]|. proof. admit. qed. lemma Conclusion &m: - `|Pr[Upper.RealIndif(Upper.Perm.Perm,Upper.BlockSponge,UpperDist).main() @ &m: res] + `|Pr[Upper.RealIndif(Perm,Upper.BlockSponge,UpperDist).main() @ &m: res] - Pr[Upper.IdealIndif(Upper.BIRO.IRO,Sim(LowerSim),UpperDist).main() @ &m: res]| - = `|Pr[Lower.RealIndif(Lower.Perm.Perm,Lower.BlockSponge,Dist(UpperDist)).main() @ &m: res] + = `|Pr[Lower.RealIndif(Perm,Lower.BlockSponge,Dist(UpperDist)).main() @ &m: res] - Pr[Lower.IdealIndif(Lower.Ideal.RO,LowerSim,Dist(UpperDist)).main() @ &m: res]|. - proof. admit. qed. + proof. by rewrite (Intermediate &m) (Remainder &m). qed. end section. diff --git a/proof/Blocks.ec b/proof/Blocks.ec index 0d0ca6d..83159e6 100644 --- a/proof/Blocks.ec +++ b/proof/Blocks.ec @@ -2,8 +2,6 @@ require import Option Pair Int Real List. require (*--*) Common IRO LazyRP Indifferentiability. -op ( * ): 'a NewDistr.distr -> 'b NewDistr.distr -> ('a * 'b) distr. - (* -------------------------------------------------------------------- *) require import Common. @@ -14,12 +12,6 @@ clone import IRO as BIRO with type from <- block list, type to <- block, op valid <- valid. - -clone import LazyRP as Perm with - type D <- block * capacity, - op d <- bdistr * Capacity.cdistr - - rename [module] "P" as "Perm". (* -------------------------------------------------------------------- *) clone include Indifferentiability.Core with @@ -34,7 +26,7 @@ import Types. (* -------------------------------------------------------------------- *) (** Spurious uninitialized variable warning on p *) -module BlockSponge (P : RP) : BIRO.IRO, CONSTRUCTION(P) = { +module BlockSponge (P : PRIMITIVE) : BIRO.IRO, CONSTRUCTION(P) = { proc init = P.init proc f(p : block list, n : int): block list = { @@ -65,6 +57,6 @@ lemma top: exists (S <: SIMULATOR), forall (D <: DISTINGUISHER) &m, `| Pr[Experiment(BlockSponge(Perm), Perm, D).main() @ &m : res] - - Pr[Experiment(IRO, S(IRO), D).main() @ &m : res]| + - Pr[Experiment(IRO', S(IRO'), D).main() @ &m : res]| < eps. -proof. admit. qed. +proof. admit. qed. \ No newline at end of file diff --git a/proof/Common.ec b/proof/Common.ec index 8df87b9..d462d5a 100644 --- a/proof/Common.ec +++ b/proof/Common.ec @@ -1,6 +1,6 @@ (* -------------------------------------------------------------------- *) require import Fun Pair Int Real List NewDistr. -require (*--*) FinType NewMonoid. +require (*--*) FinType LazyRP NewMonoid. (* -------------------------------------------------------------------- *) theory BitWord. @@ -59,3 +59,13 @@ clone export BitWord as Block with rename [op] "zero" as "b0" [op] "uniform" as "bdistr". + + print LazyRP. + +op ( * ): 'a NewDistr.distr -> 'b NewDistr.distr -> ('a * 'b) Pervasive.distr. +clone export LazyRP as Perm with + type D <- block * capacity, + op d <- bdistr * Capacity.cdistr +rename + [module type] "RP" as "PRIMITIVE" + [module] "P" as "Perm". diff --git a/proof/IRO.eca b/proof/IRO.eca index a644a88..436f7e7 100644 --- a/proof/IRO.eca +++ b/proof/IRO.eca @@ -47,3 +47,75 @@ module IRO : IRO = { return aout; } }. + +pred prefix_closed (m : (from * int,to) fmap) = + forall x n, + mem (dom m) (x,n) => + (forall i, 0 <= i < n => + mem (dom m) (x,i)). + +pred prefix_closed' (m : (from * int,to) fmap) = + forall x n i, + mem (dom m) (x,n) => + 0 <= i < n => + mem (dom m) (x,i). + +lemma cool m: prefix_closed m <=> prefix_closed' m +by []. + +module IRO' : IRO = { + var mp : (from * int, to) fmap + var visible : (from * int) fset + + proc resample_invisible() = { + var work, x; + + work <- dom mp `\` visible; + while (work <> fset0) { + x <- pick work; + mp.[x] <$ dto; + work <- work `\` fset1 x; + } + } + + proc init() = { + mp <- map0; + visible <- fset0; + } + + proc fill_in(x,n) = { + if (!mem (dom mp) (x,n)) { + mp.[(x,n)] <$ dto; + } + return oget mp.[(x,n)]; + } + + proc f(x, n) = { + var b, bs; + var i <- 0; + + bs <- []; + if (valid x) { + visible <- visible `|` fset1 (x,n); + while (i < n) { + b <@ fill_in(x,i); + bs <- rcons bs b; + i <- i + 1; + } + } + + return bs; + } + + proc f_lazy(x, i) = { + var b <- witness; + + if (valid x /\ 0 <= i) { + visible <- visible `|` fset1 (x,i); + b <@ fill_in(x,i); + } + return b; + } +}. + +(** The two are equivalent **) \ No newline at end of file diff --git a/proof/Indifferentiability.ec b/proof/Indifferentiability.ec index f710925..85d037c 100644 --- a/proof/Indifferentiability.ec +++ b/proof/Indifferentiability.ec @@ -34,7 +34,7 @@ module type CONSTRUCTION (P : PRIMITIVE) = { }. module type SIMULATOR (F : FUNCTIONALITY) = { - proc init() : unit + proc init() : unit { F.init } proc f(x : p) : p { F.f } proc fi(x : p) : p { F.f } }. From fbdfba2c883efca13511bceb471e80279c2e174b Mon Sep 17 00:00:00 2001 From: Pierre-Yves Strub Date: Wed, 28 Oct 2015 08:30:59 +0100 Subject: [PATCH 042/525] Jenkins integration --- Makefile | 30 ++++++++++++++++++++++++++++++ config/tests.config | 5 +++++ 2 files changed, 35 insertions(+) create mode 100644 Makefile create mode 100644 config/tests.config diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..3c2e3bd --- /dev/null +++ b/Makefile @@ -0,0 +1,30 @@ +# -*- Makefile -*- + +# -------------------------------------------------------------------- +ECROOT ?= +ECCHECK ?= +ECARGS ?= +ECCONF := config/tests.config +XUNITOUT ?= xunit.xml +CHECKS ?= sha3 + +ifeq ($(ECCHECK),) +ifeq ($(ECROOT),) +ECCHECK := ec-runtest +else +PATH := ${ECROOT}:${PATH} +ECCHECK := $(ECROOT)/scripts/testing/runtest +endif +endif + +# -------------------------------------------------------------------- +.PHONY: default check check-xunit + +default: + @echo "Usage: make where in [check|check-xunit]" >&2 + +check: + $(ECCHECK) --bin-args="$(ECARGS)" $(ECCONF) $(CHECKS) + +check-xunit: + $(ECCHECK) --bin-args="$(ECARGS)" --xunit=$(XUNITOUT) $(ECCONF) $(CHECKS) diff --git a/config/tests.config b/config/tests.config new file mode 100644 index 0000000..3c0fbec --- /dev/null +++ b/config/tests.config @@ -0,0 +1,5 @@ +[default] +bin = ec.native + +[test-sha3] +okdirs = proof From b9ed0a72eb6b8599bf1b0a8177da1d348efa97bb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Wed, 28 Oct 2015 15:44:53 +0100 Subject: [PATCH 043/525] Lining up more defs. --- proof/AbsorbToBlocks.ec | 32 +++++++------- proof/Blocks.ec | 4 +- proof/BlocksToTopLevel.ec | 82 ++++++++++++++++++++++++++++++++++++ proof/Indifferentiability.ec | 2 +- proof/LeakyAbsorb.ec | 2 +- proof/TopLevel.ec | 30 ++----------- 6 files changed, 106 insertions(+), 46 deletions(-) create mode 100644 proof/BlocksToTopLevel.ec diff --git a/proof/AbsorbToBlocks.ec b/proof/AbsorbToBlocks.ec index 03696ba..41657ca 100644 --- a/proof/AbsorbToBlocks.ec +++ b/proof/AbsorbToBlocks.ec @@ -235,20 +235,20 @@ section. *) lemma Intermediate &m: - `|Pr[Upper.RealIndif(Perm,Upper.BlockSponge,UpperDist).main() @ &m :res] - - Pr[Upper.IdealIndif(Upper.BIRO.IRO,Sim(LowerSim),UpperDist).main() @ &m: res]| - = `|Pr[Upper.RealIndif(Perm,UpperOfLowerBlockSponge,UpperDist).main() @ &m: res] + `|Pr[Upper.RealIndif(Upper.BlockSponge,Perm,UpperDist).main() @ &m :res] + - Pr[Upper.IdealIndif(Upper.BIRO.IRO',Sim(LowerSim),UpperDist).main() @ &m: res]| + = `|Pr[Upper.RealIndif(UpperOfLowerBlockSponge,Perm,UpperDist).main() @ &m: res] - Pr[Upper.IdealIndif(UpperFun(Lower.Ideal.RO),Sim(LowerSim),UpperDist).main() @ &m: res]|. proof. - have ->: Pr[Upper.RealIndif(Perm,UpperOfLowerBlockSponge,UpperDist).main() @ &m: res] - = Pr[Upper.RealIndif(Perm,Upper.BlockSponge,UpperDist).main() @ &m :res]. + have ->: Pr[Upper.RealIndif(UpperOfLowerBlockSponge,Perm,UpperDist).main() @ &m: res] + = Pr[Upper.RealIndif(Upper.BlockSponge,Perm,UpperDist).main() @ &m :res]. byequiv=> //=; proc. call (_: ={m,mi}(Perm,Perm) /\ (forall x, mem (dom Perm.m){1} x)). by proc; if; auto; smt. by proc; if; auto; smt. (* BUG: arg should be handled much earlier and automatically *) - by conseq ModularUpper=> //= &1 &2; case (arg{1}); case (arg{2})=> //=. + by conseq ModularUpper_Real=> //= &1 &2; case (arg{1}); case (arg{2})=> //=. call (_: true ==> ={glob Perm} /\ (forall x, mem (dom Perm.m){1} x)). @@ -257,33 +257,33 @@ section. call (_: true ==> true)=> //. by proc; auto. have ->: Pr[Upper.IdealIndif(UpperFun(Lower.Ideal.RO),Sim(LowerSim),UpperDist).main() @ &m: res] - = Pr[Upper.IdealIndif(Upper.BIRO.IRO,Sim(LowerSim),UpperDist).main() @ &m: res]. + = Pr[Upper.IdealIndif(Upper.BIRO.IRO',Sim(LowerSim),UpperDist).main() @ &m: res]. byequiv=> //=; proc. - call (_: ={glob LowerSim} /\ relation Lower.Ideal.RO.m{1} Upper.BIRO.IRO.mp{2}). - proc (relation Lower.Ideal.RO.m{1} Upper.BIRO.IRO.mp{2})=> //=. + call (_: ={glob LowerSim} /\ lower Lower.Ideal.RO.m{1} Upper.BIRO.IRO'.mp{2}). + proc (lower Lower.Ideal.RO.m{1} Upper.BIRO.IRO'.mp{2})=> //=. by proc; sp; if=> //=; call ModularLower; auto. - proc (relation Lower.Ideal.RO.m{1} Upper.BIRO.IRO.mp{2})=> //=. + proc (lower Lower.Ideal.RO.m{1} Upper.BIRO.IRO'.mp{2})=> //=. by proc; sp; if=> //=; call ModularLower; auto. (* Re-Bug *) by conseq ModularLower=> &1 &2; case (arg{1}); case (arg{2}). inline *; wp; call (_: true)=> //=. by sim. auto; progress [-split]; split=> //=. - by split=> x y; rewrite map0P. + smt. done. qed. lemma Remainder &m: - `|Pr[Upper.RealIndif(Perm,UpperOfLowerBlockSponge,UpperDist).main() @ &m: res] + `|Pr[Upper.RealIndif(UpperOfLowerBlockSponge,Perm,UpperDist).main() @ &m: res] - Pr[Upper.IdealIndif(UpperFun(Lower.Ideal.RO),Sim(LowerSim),UpperDist).main() @ &m: res]| - = `|Pr[Lower.RealIndif(Perm,Lower.BlockSponge,Dist(UpperDist)).main() @ &m: res] + = `|Pr[Lower.RealIndif(Lower.BlockSponge,Perm,Dist(UpperDist)).main() @ &m: res] - Pr[Lower.IdealIndif(Lower.Ideal.RO,LowerSim,Dist(UpperDist)).main() @ &m: res]|. proof. admit. qed. lemma Conclusion &m: - `|Pr[Upper.RealIndif(Perm,Upper.BlockSponge,UpperDist).main() @ &m: res] - - Pr[Upper.IdealIndif(Upper.BIRO.IRO,Sim(LowerSim),UpperDist).main() @ &m: res]| - = `|Pr[Lower.RealIndif(Perm,Lower.BlockSponge,Dist(UpperDist)).main() @ &m: res] + `|Pr[Upper.RealIndif(Upper.BlockSponge,Perm,UpperDist).main() @ &m: res] + - Pr[Upper.IdealIndif(Upper.BIRO.IRO',Sim(LowerSim),UpperDist).main() @ &m: res]| + = `|Pr[Lower.RealIndif(Lower.BlockSponge,Perm,Dist(UpperDist)).main() @ &m: res] - Pr[Lower.IdealIndif(Lower.Ideal.RO,LowerSim,Dist(UpperDist)).main() @ &m: res]|. proof. by rewrite (Intermediate &m) (Remainder &m). qed. end section. diff --git a/proof/Blocks.ec b/proof/Blocks.ec index 83159e6..9457575 100644 --- a/proof/Blocks.ec +++ b/proof/Blocks.ec @@ -56,7 +56,7 @@ op eps : real. lemma top: exists (S <: SIMULATOR), forall (D <: DISTINGUISHER) &m, - `| Pr[Experiment(BlockSponge(Perm), Perm, D).main() @ &m : res] - - Pr[Experiment(IRO', S(IRO'), D).main() @ &m : res]| + `| Pr[RealIndif(BlockSponge, Perm, D).main() @ &m : res] + - Pr[IdealIndif(IRO', S, D).main() @ &m : res]| < eps. proof. admit. qed. \ No newline at end of file diff --git a/proof/BlocksToTopLevel.ec b/proof/BlocksToTopLevel.ec new file mode 100644 index 0000000..50cfda7 --- /dev/null +++ b/proof/BlocksToTopLevel.ec @@ -0,0 +1,82 @@ +(* -------------------------------------------------------------------- *) +require import Fun Pred Option Pair Int Real List FSet NewFMap. +require (*--*) Blocks TopLevel. + +(* -------------------------------------------------------------------- *) +require import Common. +print Common. + +op chunk: bool list -> bool list list. + +op padlength (n : int) = + let n' = (n + 2) %% r in + if n' = 0 then 0 else r - n'. + +op pad (bs : bool list): block list = + let p = rcons (true :: mkseq (fun k => false) (padlength (size bs))) true in + map bits2w (chunk (bs ++ p)). + +op unpad (bs : block list): bool list option. (* Alley to fill in the definition *) + +axiom unpadK (bs : bool list): pcancel pad unpad. +axiom padK (*?*) (bs : block list): ocancel unpad pad. + +op valid_lower (bs : block list) = unpad bs <> None. + +clone Blocks as Lower with + op valid <- valid_lower. + +clone TopLevel as Upper. + +(* -------------------------------------------------------------------- *) +module UpperFun ( F : Lower.FUNCTIONALITY ) = { + proc init = F.init + + proc f(p : bool list, n : int) = { + var bs; + + bs <@ F.f(pad p,(n + r - 1) /% r); + return take n (flatten (map w2bits bs)); + } +}. + +module LowerFun ( F: Upper.FUNCTIONALITY) = { + proc init = F.init + + proc f(p : block list, n : int) = { + var bs, m; + var bs' <- []; + + m <- unpad p; + if (m <> None) { + bs <@ F.f(oget m,n * r); + bs' <- map bits2w (chunk bs); + } + return bs'; + } +}. + +(* -------------------------------------------------------------------- *) +equiv ModularConstruction: + UpperFun(Lower.BlockSponge(Perm)).f ~ Upper.Sponge(Perm).f: + ={glob Perm, arg} ==> ={glob Perm, res}. +proof. + proc. inline Lower.BlockSponge(Perm).f. + admit. (* done *) +qed. + +module ModularSimulator (S : Lower.SIMULATOR, F : Upper.FUNCTIONALITY) = S(LowerFun(F)). + +module LowerDist ( D : Upper.DISTINGUISHER, F : Lower.FUNCTIONALITY, P : PRIMITIVE) = + D(UpperFun(F),P). + +section. + declare module LowerSim : Lower.SIMULATOR. + declare module UpperDist : Upper.DISTINGUISHER. + + lemma Conclusion &m: + `|Pr[Upper.RealIndif(Upper.Sponge,Perm,UpperDist).main() @ &m: res] + - Pr[Upper.IdealIndif(Upper.BIRO.IRO',ModularSimulator(LowerSim),UpperDist).main() @ &m: res]| + = `|Pr[Lower.RealIndif(Lower.BlockSponge,Perm,LowerDist(UpperDist)).main() @ &m: res] + - Pr[Lower.IdealIndif(Lower.BIRO.IRO',LowerSim,LowerDist(UpperDist)).main() @ &m: res]|. + proof. admit. qed. diff --git a/proof/Indifferentiability.ec b/proof/Indifferentiability.ec index 85d037c..9a11bd5 100644 --- a/proof/Indifferentiability.ec +++ b/proof/Indifferentiability.ec @@ -54,7 +54,7 @@ module Indif (F : FUNCTIONALITY, P : PRIMITIVE, D : DISTINGUISHER) = { } }. -module Real(P : PRIMITIVE, C : CONSTRUCTION) = Indif(C(P),P). +module Real(C : CONSTRUCTION, P : PRIMITIVE) = Indif(C(P),P). module Ideal(F : FUNCTIONALITY, S : SIMULATOR) = Indif(F,S(F)). (* (C <: CONSTRUCTION) applied to (P <: PRIMITIVE) is indifferentiable diff --git a/proof/LeakyAbsorb.ec b/proof/LeakyAbsorb.ec index 5b487ee..c59fe8b 100644 --- a/proof/LeakyAbsorb.ec +++ b/proof/LeakyAbsorb.ec @@ -40,7 +40,7 @@ module type WeirdIRO_ = { op valid_query : block list -> int -> bool. op valid_queries : (block list) fset. -axiom valid_queryP : forall m n, valid_query m n => forall k, 0 <= k <= n => mem valid_queries (m ++ map (fun x => b0) (iota_ 0 k)). +axiom valid_queryP : forall m n, valid_query m n => forall k, 0 <= k <= n => mem valid_queries (m ++ mkseq (fun x => b0) k). axiom valid_query_take : forall m n, valid_query m n => forall i, 0 <= i <= size m => mem valid_queries (take i m). axiom valid_query_take1 : forall m n, valid_query m n => forall i, 0 <= i <= size m => valid_query (take i m) 1. diff --git a/proof/TopLevel.ec b/proof/TopLevel.ec index a329f2c..23b7558 100644 --- a/proof/TopLevel.ec +++ b/proof/TopLevel.ec @@ -1,25 +1,9 @@ (* -------------------------------------------------------------------- *) require import Pair Int Real List. require (*--*) IRO LazyRP Indifferentiability. -(*---*) import Dprod. (* -------------------------------------------------------------------- *) -(* Replay Common.ec *) -op r : { int | 0 < r } as gt0_r. -op c : { int | 0 < c } as gt0_c. - -type block. -type capacity. - -op cdist : capacity distr. -op bdist : block distr. - -op b0 : block. -op c0 : capacity. - -op b2bits : block -> bool list. - -op (^) : block -> block -> block. +require import Common. (* -------------------------------------------------------------------- *) op pad : bool list -> block list. @@ -29,12 +13,6 @@ clone import IRO as BIRO with type from <- bool list, type to <- bool, op valid (x : bool list) <- true. - -clone import LazyRP as Perm with - type D <- block * capacity, - op d <- bdist * cdist - - rename [module] "P" as "Perm". (* -------------------------------------------------------------------- *) clone include Indifferentiability.Core with @@ -49,12 +27,12 @@ import Types. (* -------------------------------------------------------------------- *) (** Spurious uninitialized variable warning on p *) -module Sponge (P : RP) : BIRO.IRO, CONSTRUCTION(P) = { +module Sponge (P : PRIMITIVE) : BIRO.IRO, CONSTRUCTION(P) = { proc init = P.init proc f(bp : bool list, n : int): bool list = { var z <- []; - var (sa,sc) <- (b0, c0); + var (sa,sc) <- (b0, Capacity.c0); var i <- 0; var p <- pad bp; @@ -65,7 +43,7 @@ module Sponge (P : RP) : BIRO.IRO, CONSTRUCTION(P) = { } (* Squeezing *) while (i < (n + r - 1) /% r) { - z <- z ++ (b2bits sa); + z <- z ++ (Block.w2bits sa); (sa,sc) <@ P.f(sa,sc); } From f3130a12d1eeb9a896a3939245452d73371ef810 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Sat, 14 Nov 2015 16:22:10 -0500 Subject: [PATCH 044/525] Adapted scripts to changes in EC library. Created two subdirectories: old has the development predating our October work (we can adapt these files as needed and move back to top-level) variant has Benjamin's LeakyAbsorb.ec and supporing theories (if we decide to go with this approach, we can move it back) --- proof/AbsorbToBlocks.ec | 2 +- proof/Common.ec | 4 +- proof/{ => old}/IndifPadding.ec | 0 proof/{ => old}/LazyRO.eca | 0 proof/{ => old}/NBRO.eca | 0 proof/{ => old}/Sponge.ec | 2 +- proof/{ => old}/Squeezeless.ec | 0 proof/{ => old}/Utils.ec | 2 +- proof/variant/LazyRP.eca | 39 +++ proof/{ => variant}/LeakyAbsorb.ec | 0 proof/variant/RP.eca | 26 ++ proof/variant/RndOrcl.eca | 385 +++++++++++++++++++++++++++++ 12 files changed, 455 insertions(+), 5 deletions(-) rename proof/{ => old}/IndifPadding.ec (100%) rename proof/{ => old}/LazyRO.eca (100%) rename proof/{ => old}/NBRO.eca (100%) rename proof/{ => old}/Sponge.ec (99%) rename proof/{ => old}/Squeezeless.ec (100%) rename proof/{ => old}/Utils.ec (98%) create mode 100644 proof/variant/LazyRP.eca rename proof/{ => variant}/LeakyAbsorb.ec (100%) create mode 100644 proof/variant/RP.eca create mode 100644 proof/variant/RndOrcl.eca diff --git a/proof/AbsorbToBlocks.ec b/proof/AbsorbToBlocks.ec index 41657ca..f6befac 100644 --- a/proof/AbsorbToBlocks.ec +++ b/proof/AbsorbToBlocks.ec @@ -34,7 +34,7 @@ proof. by rewrite /strip; exact/(ge0_strip_aux 0 (rev bs)). qed. op valid_upper (bs : block list) = bs <> [] /\ - forallb (fun n=> strip (extend bs n) = (bs,n)). + forall n, strip (extend bs n) = (bs,n). op valid_lower (bs : block list) = valid_upper (strip bs).`1. diff --git a/proof/Common.ec b/proof/Common.ec index d462d5a..ef408c3 100644 --- a/proof/Common.ec +++ b/proof/Common.ec @@ -1,6 +1,6 @@ (* -------------------------------------------------------------------- *) require import Fun Pair Int Real List NewDistr. -require (*--*) FinType LazyRP NewMonoid. +require (*--*) FinType LazyRP Monoid. (* -------------------------------------------------------------------- *) theory BitWord. @@ -9,7 +9,7 @@ type bword. op zero : bword. op (^) : bword -> bword -> bword. -clone include NewMonoid +clone include Monoid with type t <- bword, op idm <- zero, diff --git a/proof/IndifPadding.ec b/proof/old/IndifPadding.ec similarity index 100% rename from proof/IndifPadding.ec rename to proof/old/IndifPadding.ec diff --git a/proof/LazyRO.eca b/proof/old/LazyRO.eca similarity index 100% rename from proof/LazyRO.eca rename to proof/old/LazyRO.eca diff --git a/proof/NBRO.eca b/proof/old/NBRO.eca similarity index 100% rename from proof/NBRO.eca rename to proof/old/NBRO.eca diff --git a/proof/Sponge.ec b/proof/old/Sponge.ec similarity index 99% rename from proof/Sponge.ec rename to proof/old/Sponge.ec index 7d91e06..9648347 100644 --- a/proof/Sponge.ec +++ b/proof/old/Sponge.ec @@ -1,4 +1,4 @@ -require import Option Pair Int Real NewList NewFSet NewFMap. +require import Option Pair Int Real List FSet NewFMap. require (*..*) AWord LazyRP IRO Indifferentiability Squeezeless. (* TODO: Clean up the Bitstring and Word theories -- Make use of those new versions. *) diff --git a/proof/Squeezeless.ec b/proof/old/Squeezeless.ec similarity index 100% rename from proof/Squeezeless.ec rename to proof/old/Squeezeless.ec diff --git a/proof/Utils.ec b/proof/old/Utils.ec similarity index 98% rename from proof/Utils.ec rename to proof/old/Utils.ec index 5517692..4a460ae 100644 --- a/proof/Utils.ec +++ b/proof/old/Utils.ec @@ -1,5 +1,5 @@ (** These should make it into the standard libs **) -require import Pair NewList NewFSet NewFMap. +require import Option Pair List FSet NewFMap. (* -------------------------------------------------------------------- *) (* In NewFSet *) diff --git a/proof/variant/LazyRP.eca b/proof/variant/LazyRP.eca new file mode 100644 index 0000000..b483b42 --- /dev/null +++ b/proof/variant/LazyRP.eca @@ -0,0 +1,39 @@ +require import Option FSet NewFMap. +require import Dexcepted. +require (*..*) RP. + +type D. +op d: D distr. + +clone include RP with + type from <- D, + type to <- D. + +module P : RP, RP_ = { + var m : (D, D) fmap + var mi: (D, D) fmap + + proc init() = { m = map0; mi = map0; } + + proc f(x) = { + var y; + + if (!mem (dom m) x) { + y <$ d \ rng m; + m.[x] <- y; + mi.[y] <- x; + } + return oget m.[x]; + } + + proc fi(x) = { + var y; + + if (!mem (dom mi) x) { + y <$ d \ rng mi; + mi.[x] <- y; + m.[y] <- x; + } + return oget mi.[x]; + } +}. diff --git a/proof/LeakyAbsorb.ec b/proof/variant/LeakyAbsorb.ec similarity index 100% rename from proof/LeakyAbsorb.ec rename to proof/variant/LeakyAbsorb.ec diff --git a/proof/variant/RP.eca b/proof/variant/RP.eca new file mode 100644 index 0000000..eafe094 --- /dev/null +++ b/proof/variant/RP.eca @@ -0,0 +1,26 @@ +type from, to. + +module type RP = { + proc init() : unit + proc f (x : from): to + proc fi(x : to ): from +}. + +module type RP_ = { + proc f (x : from): to + proc fi(x : to ): from +}. + +module type Distinguisher(G : RP_) = { + proc distinguish(): bool +}. + +module IND(G:RP, D:Distinguisher) = { + proc main(): bool = { + var b; + + G.init(); + b <@ D(G).distinguish(); + return b; + } +}. diff --git a/proof/variant/RndOrcl.eca b/proof/variant/RndOrcl.eca new file mode 100644 index 0000000..96d3045 --- /dev/null +++ b/proof/variant/RndOrcl.eca @@ -0,0 +1,385 @@ +require import Option FSet NewFMap. +(* TODO move this in NewFMap *) +lemma dom_set (m:('a,'b) fmap) a b : dom m.[a<-b] = dom m `|` fset1 a. +proof. by apply fsetP=> x;smt. qed. + +type from, to. + +module type RO = { + proc init() : unit + proc f(x : from): to +}. + +module type Distinguisher(G : RO) = { + proc distinguish(): bool {G.f} +}. + +module IND(G:RO, D:Distinguisher) = { + proc main(): bool = { + var b; + + G.init(); + b <@ D(G).distinguish(); + return b; + } +}. + +abstract theory Ideal. + + op sample : from -> to distr. + + module RO = { + var m : (from, to) fmap + + proc init() : unit = { + m <- map0; + } + + proc f(x : from) : to = { + var rd; + rd <$ sample x; + if (! mem (dom m) x) m.[x] <- rd; + return oget m.[x]; + } + }. + + section LL. + + axiom sample_ll : forall x, Distr.weight (sample x) = 1%r. + + lemma f_ll : phoare[RO.f : true ==> true] = 1%r. + proof. proc;auto;progress;apply sample_ll. qed. + + end section LL. + +end Ideal. + + +abstract theory GenIdeal. + + clone include Ideal. + axiom sample_ll : forall x, Distr.weight (sample x) = 1%r. + + op RO_dom : from fset. + + module ERO = { + proc sample() = { + var work; + work <- RO_dom; + while (work <> fset0) { + RO.f(pick work); + work = work `\` fset1 (pick work); + } + } + + proc init() = { + RO.m <- map0; + sample(); + } + + proc f = RO.f + }. + + module IND_S(D:Distinguisher) = { + proc main(): bool = { + var b; + RO.init(); + b <@ D(RO).distinguish(); + ERO.sample(); + return b; + } + }. + + section EAGER. + + local lemma eager_query: + eager [ERO.sample(); , RO.f ~ ERO.f, ERO.sample(); : + ={x,RO.m} ==> ={res,RO.m} ]. + proof. + eager proc. + inline ERO.sample;swap{2} 4 -3. + seq 1 1: (={x,work,RO.m});first by sim. + wp;case ((mem (dom RO.m) x){1}). + + rnd{1}. + alias{1} 1 mx = oget RO.m.[x]. + while (={work,RO.m} /\ (RO.m.[x] = Some mx){1}). + + by inline *;auto;progress;smt. + auto;progress [- split]; rewrite sample_ll H /=;smt. + case ((!mem work x){1}). + + swap{1} 2 -1;while (={work,x} /\ eq_except RO.m{1} RO.m{2} (fset1 x{1}) /\ + (!mem work x){1} /\ (RO.m.[x] = Some rd){2} /\ (!mem (dom RO.m) x){1}). + + inline *;auto;progress [-split]. + cut -> : mem (dom RO.m{2}) (pick work{2}) = mem (dom RO.m{1}) (pick work{2}) by rewrite !in_dom;smt. + smt. + auto;progress [-split];rewrite !getP_eq;smt. + inline RO.f. + transitivity{1} { rd <$ sample x; + while (work <> fset0) { + x0 <- pick work; + rd0 <$ sample x0; + if (!mem (dom RO.m) x0) + RO.m.[x0] <- if x0 = x then rd else rd0; + work <- work `\` fset1 (pick work); + } } + (={x,work,RO.m} ==> ={x,RO.m}) + ((={x,work,RO.m} /\ mem work{1} x{1}) /\ ! mem (dom RO.m{2}) x{2} ==> + ={x,RO.m} /\ (result = oget RO.m.[x]){2} /\ mem (dom RO.m{1}) x{1}) => //. + + by move=> &1 &2 H; exists RO.m{2}, x{2}, work{2}; generalize H. + + transitivity{1} { while (work <> fset0) { + x0 <- pick work; + rd0 <$ sample x0; + if (!mem (dom RO.m) x0) RO.m.[x0] <- rd0; + work <- work `\` fset1 (pick work); + } + rd <$ sample x; } + (={x,work,RO.m} ==> ={x,RO.m}) + (={x,work,RO.m} ==> ={x,RO.m})=> //. + + by move=> &1 &2 H; exists RO.m{2}, x{2}, work{2}; generalize H. + + by sim; rnd{2}; sim : (={x,IND_Eager.H.m}); smt. + symmetry; eager while (H: rd <$ sample x; ~ rd <$ sample x; : ={x} ==> ={rd})=> //; sim. + swap{2} 5 -4; swap [2..3] -1; case ((x = pick work){1}). + + by wp; rnd{2}; rnd; rnd{1}; wp; skip; smt. + by auto; smt. + + while (={x, work} /\ + (!mem work x => mem (dom RO.m) x){1} /\ + RO.m.[x]{2} = Some rd{1} /\ + if (mem (dom RO.m) x){1} then ={RO.m} + else eq_except RO.m{1} RO.m{2} (fset1 x{1})). + + auto;progress; 1..9,12:smt. + + case ((pick work = x){2})=> pick_x; last smt. + subst x{2}; generalize H7 H1; rewrite -neqF /eq_except=> -> /= eq_exc. + by apply fmapP=> x0; case (pick work{2} = x0); smt. + by auto; smt. + by auto;progress [-split];rewrite H0 /= getP_eq;smt. + qed. + + equiv Eager_S (D <: Distinguisher{RO}): IND_S(D).main ~ IND(ERO,D).main: ={glob D} ==> ={res,RO.m,glob D}. + proof. + proc; inline ERO.init RO.init. + seq 1 1: (={glob D, RO.m});first by wp. + symmetry; eager (H: ERO.sample(); ~ ERO.sample();: ={RO.m} ==> ={RO.m}): + (={glob D, RO.m}) => //; first by sim. + eager proc H (={RO.m}) => //; [by apply eager_query | by sim]. + qed. + + equiv Eager (D <: Distinguisher{RO}): IND(RO,D).main ~ IND(ERO,D).main: ={glob D} ==> ={res,glob D}. + proof. + transitivity IND_S(D).main + (={glob D} ==> ={res,glob D}) + (={glob D} ==> ={res,RO.m,glob D}) => //. + + by progress;exists (glob D){2}. + + proc;inline{2} ERO.sample. + while{2} true (card work{2}). + + move=> &m1 z;wp;call (f_ll sample_ll);auto;smt. + conseq (_: _ ==> ={b,glob D}) => //;[smt | by sim]. + apply (Eager_S D). + qed. + + end section EAGER. + +end GenIdeal. + +abstract theory FiniteIdeal. + + clone include Ideal. + axiom sample_ll (x : from): Distr.weight (sample x) = 1%r. + + op univ : from fset. + axiom univP (x:from) : mem univ x. + + module ERO = { + proc sample() = { + var work; + work <- univ; + while (work <> fset0) { + RO.f(pick work); + work = work `\` fset1 (pick work); + } + } + + proc init() = { + RO.m <- map0; + sample(); + } + + proc f(x:from):to = { return oget RO.m.[x]; } + }. + + module IND_S(D:Distinguisher) = { + proc main(): bool = { + var b; + RO.init(); + b <@ D(RO).distinguish(); + ERO.sample(); + return b; + } + }. + + section EAGER. + + declare module D: Distinguisher { RO }. + + local clone GenIdeal as GI with + op sample <- sample, + op RO_dom <- univ + proof sample_ll by apply sample_ll. + + local equiv ERO_main: + IND(GI.ERO, D).main ~ IND(ERO, D).main : ={glob D} ==> ={res, glob D} /\ GI.RO.m{1} = RO.m{2}. + proof. + proc. + call (_:GI.RO.m{1} = RO.m{2} /\ dom RO.m{2} = univ). + + proc; rcondf{1} 2;auto;progress;[ by rewrite H univP | by apply sample_ll]. + inline *. + while (={work} /\ GI.RO.m{1} = RO.m{2} /\ dom RO.m{2} = univ `\` work{2});auto;smt. + qed. + + equiv Eager_S : IND_S(D).main ~ IND(ERO,D).main: ={glob D} ==> ={res,RO.m,glob D}. + proof. + transitivity GI.IND_S(D).main + (={glob D} ==> ={res,glob D} /\ RO.m{1} = GI.RO.m{2}) + (={glob D} ==> ={res,glob D} /\ GI.RO.m{1} = RO.m{2}) => //. + + by progress;exists (glob D){2}. + + by sim. + transitivity IND(GI.ERO,D).main + (={glob D} ==> ={res,glob D, GI.RO.m}) + (={glob D} ==> ={res,glob D} /\ GI.RO.m{1} = RO.m{2}) => //. + + by progress;exists (glob D){2}. + + by conseq (GI.Eager_S D). + by apply ERO_main. + qed. + + equiv Eager : IND(RO, D).main ~ IND(ERO,D).main: ={glob D} ==> ={res,glob D}. + proof. + transitivity IND(GI.RO,D).main + (={glob D} ==> ={res,glob D} /\ RO.m{1} = GI.RO.m{2}) + (={glob D} ==> ={res,glob D}) => //. + + by progress;exists (glob D){2}. + + by sim. + transitivity IND(GI.ERO,D).main + (={glob D} ==> ={res,glob D}) + (={glob D} ==> ={res,glob D}) => //. + + by progress;exists (glob D){2}. + + by conseq (GI.Eager D). + by conseq ERO_main. + qed. + + end section EAGER. + +end FiniteIdeal. + + +abstract theory RestrIdeal. + + clone include Ideal. + axiom sample_ll (x : from): Distr.weight (sample x) = 1%r. + + op test : from -> bool. + op univ : from fset. + op dfl : to. + + axiom testP x : test x <=> mem univ x. + + module Restr (O:RO) = { + proc init = RO.init + proc f (x:from) : to = { + var r <- dfl; + if (test x) r <@ RO.f(x); + return r; + } + }. + + module ERO = { + proc sample() = { + var work; + work <- univ; + while (work <> fset0) { + RO.f(pick work); + work = work `\` fset1 (pick work); + } + } + + proc init() = { + RO.m <- map0; + sample(); + } + + proc f(x:from):to = { + return (if test x then oget RO.m.[x] else dfl); + } + }. + + module IND_S(D:Distinguisher) = { + proc main(): bool = { + var b; + RO.init(); + b <@ D(Restr(RO)).distinguish(); + ERO.sample(); + return b; + } + }. + + section EAGER. + + declare module D: Distinguisher { RO }. + + local clone GenIdeal as GI with + op sample <- sample, + op RO_dom <- univ. + + local module Restr' (O:RO) = { + proc init() = { } + proc f(x:from) = { + var r <- dfl; + if (test x) r <@ O.f(x); + return r; + } + }. + + local module RD (O:RO) = D(Restr'(O)). + + local equiv ERO_main: + IND(GI.ERO, RD).main ~ IND(ERO, D).main : ={glob D} ==> ={res, glob D} /\ GI.RO.m{1} = RO.m{2}. + proof. + proc. + call (_:GI.RO.m{1} = RO.m{2} /\ dom RO.m{2} = univ). + + proc. + case (test x{1});[ rcondt{1} 2 | rcondf{1} 2];auto;last smt ml=0. + by inline *;rcondf{1} 4;auto;progress;2:(by apply sample_ll);rewrite ?H0 ?H -?testP. + inline *. + while (={work} /\ GI.RO.m{1} = RO.m{2} /\ dom RO.m{2} `|` work{2} = univ);auto;1:progress; smt. + qed. + + equiv Eager_S : IND_S(D).main ~ IND(ERO,D).main: ={glob D} ==> ={res,RO.m,glob D}. + proof. + transitivity GI.IND_S(RD).main + (={glob D} ==> ={res,glob D} /\ RO.m{1} = GI.RO.m{2}) + (={glob D} ==> ={res,glob D} /\ GI.RO.m{1} = RO.m{2}) => //. + + by progress;exists (glob D){2}. + + by sim. + transitivity IND(GI.ERO,RD).main + (={glob D} ==> ={res,glob D, GI.RO.m}) + (={glob D} ==> ={res,glob D} /\ GI.RO.m{1} = RO.m{2}) => //. + + by progress;exists (glob D){2}. + + by conseq (GI.Eager_S RD). + by apply ERO_main. + qed. + + equiv Eager : IND(Restr(RO), D).main ~ IND(ERO,D).main: ={glob D} ==> ={res,glob D}. + proof. + transitivity IND(GI.RO,RD).main + (={glob D} ==> ={res,glob D} /\ RO.m{1} = GI.RO.m{2}) + (={glob D} ==> ={res,glob D}) => //. + + by progress;exists (glob D){2}. + + by sim. + transitivity IND(GI.ERO,RD).main + (={glob D} ==> ={res,glob D}) + (={glob D} ==> ={res,glob D}) => //. + + by progress;exists (glob D){2}. + + by conseq (GI.Eager RD). + by conseq ERO_main. + qed. + + end section EAGER. + +end RestrIdeal. \ No newline at end of file From fdebade087e7c510869f9b763c3951e210a67db8 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Sat, 14 Nov 2015 16:34:17 -0500 Subject: [PATCH 045/525] Removed some [print]s. --- proof/BlocksToTopLevel.ec | 1 - proof/Common.ec | 3 +-- 2 files changed, 1 insertion(+), 3 deletions(-) diff --git a/proof/BlocksToTopLevel.ec b/proof/BlocksToTopLevel.ec index 50cfda7..e0fbbb3 100644 --- a/proof/BlocksToTopLevel.ec +++ b/proof/BlocksToTopLevel.ec @@ -4,7 +4,6 @@ require (*--*) Blocks TopLevel. (* -------------------------------------------------------------------- *) require import Common. -print Common. op chunk: bool list -> bool list list. diff --git a/proof/Common.ec b/proof/Common.ec index ef408c3..d64371a 100644 --- a/proof/Common.ec +++ b/proof/Common.ec @@ -60,9 +60,8 @@ clone export BitWord as Block with [op] "zero" as "b0" [op] "uniform" as "bdistr". - print LazyRP. - op ( * ): 'a NewDistr.distr -> 'b NewDistr.distr -> ('a * 'b) Pervasive.distr. + clone export LazyRP as Perm with type D <- block * capacity, op d <- bdistr * Capacity.cdistr From 66d48d65516e26f3949ade528cc521ee221d5fe1 Mon Sep 17 00:00:00 2001 From: Pierre-Yves Strub Date: Sun, 15 Nov 2015 08:26:09 +0100 Subject: [PATCH 046/525] tests.config --- config/tests.config | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/config/tests.config b/config/tests.config index 3c0fbec..3879c44 100644 --- a/config/tests.config +++ b/config/tests.config @@ -2,4 +2,4 @@ bin = ec.native [test-sha3] -okdirs = proof +okdirs = !proof From 830cc37fbdcd137d61dbc34214a6c0c73bd10a5a Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Mon, 16 Nov 2015 19:08:51 -0500 Subject: [PATCH 047/525] Change > to <. All scripts weakly check again. --- proof/IRO.eca | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/proof/IRO.eca b/proof/IRO.eca index 436f7e7..a138d16 100644 --- a/proof/IRO.eca +++ b/proof/IRO.eca @@ -25,7 +25,7 @@ module IRO : IRO = { var b, bs; bs <- []; - while (n > 0) { + while (0 < n) { b <$ dto; bs <- rcons bs b; n <- n - 1; From 148447c5bc23a03d78d8d64d8f9371182fecc720 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Wed, 18 Nov 2015 14:58:59 -0500 Subject: [PATCH 048/525] We'd forgotten to increment i in the squeezing loops. Because we are using <- in cloning Indifferentiability.Core, the subtheory Types is empty, so no need to import it. --- proof/Absorb.ec | 1 - proof/Blocks.ec | 2 +- proof/TopLevel.ec | 6 +++--- 3 files changed, 4 insertions(+), 5 deletions(-) diff --git a/proof/Absorb.ec b/proof/Absorb.ec index dbc570d..f44437b 100644 --- a/proof/Absorb.ec +++ b/proof/Absorb.ec @@ -25,7 +25,6 @@ clone include Indifferentiability.Core with rename [module] "Indif" as "Experiment" [module] "al" as "alIndif". -import Types. (* -------------------------------------------------------------------- *) module BlockSponge (P : PRIMITIVE) : RO, CONSTRUCTION(P) = { diff --git a/proof/Blocks.ec b/proof/Blocks.ec index 9457575..aac1631 100644 --- a/proof/Blocks.ec +++ b/proof/Blocks.ec @@ -22,7 +22,6 @@ clone include Indifferentiability.Core with rename [module] "Indif" as "Experiment" [module] "al" as "alIndif". -import Types. (* -------------------------------------------------------------------- *) (** Spurious uninitialized variable warning on p *) @@ -44,6 +43,7 @@ module BlockSponge (P : PRIMITIVE) : BIRO.IRO, CONSTRUCTION(P) = { while (i < n) { z <- rcons z sa; (sa,sc) <@ P.f(sa,sc); + i <- i + 1; } } return z; diff --git a/proof/TopLevel.ec b/proof/TopLevel.ec index 23b7558..9886558 100644 --- a/proof/TopLevel.ec +++ b/proof/TopLevel.ec @@ -23,14 +23,13 @@ clone include Indifferentiability.Core with rename [module] "Indif" as "Experiment" [module] "al" as "alIndif". -import Types. (* -------------------------------------------------------------------- *) -(** Spurious uninitialized variable warning on p *) + module Sponge (P : PRIMITIVE) : BIRO.IRO, CONSTRUCTION(P) = { proc init = P.init - proc f(bp : bool list, n : int): bool list = { + proc f(bp : bool list, n : int) : bool list = { var z <- []; var (sa,sc) <- (b0, Capacity.c0); var i <- 0; @@ -45,6 +44,7 @@ module Sponge (P : PRIMITIVE) : BIRO.IRO, CONSTRUCTION(P) = { while (i < (n + r - 1) /% r) { z <- z ++ (Block.w2bits sa); (sa,sc) <@ P.f(sa,sc); + i <- i + 1; } return take n z; From 29545abe2797e895e116764f98cfd1508d9280d3 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Thu, 19 Nov 2015 18:44:27 -0500 Subject: [PATCH 049/525] Defining unpadding. --- proof/Absorb.ec | 20 +++++++++++++++++++- proof/Blocks.ec | 7 ++++--- proof/Common.ec | 37 ++++++++++++++++++++++++++++++++++++- 3 files changed, 59 insertions(+), 5 deletions(-) diff --git a/proof/Absorb.ec b/proof/Absorb.ec index f44437b..9d1f753 100644 --- a/proof/Absorb.ec +++ b/proof/Absorb.ec @@ -8,7 +8,25 @@ op cast: 'a NewDistr.distr -> 'a distr. require import Common. (* -------------------------------------------------------------------- *) -op valid: block list -> bool. (* is in the image of the padding function *) + +(* valid_strip returns None if removing the longest suffix of b0's + from its argument yields a block list that cannot be unpadded; + otherwise, it removes the longest suffix of b0's from its argument + and returns the pair of the resulting block list with the number of + b0's removed *) +op valid_strip : block list -> (block list * int)option = + fun xs => + let ys = rev xs in + let i = find (fun x => x <> b0) ys in + if i = size xs + then None + else let zs = rev(drop i ys) in + if unpad zs = None + then None + else Some(zs, i). + +op valid : block list -> bool = + fun xs => valid_strip xs <> None. clone import RndOrcl as RO with type from <- block list, diff --git a/proof/Blocks.ec b/proof/Blocks.ec index aac1631..3e5d038 100644 --- a/proof/Blocks.ec +++ b/proof/Blocks.ec @@ -6,7 +6,9 @@ require (*--*) Common IRO LazyRP Indifferentiability. require import Common. (* -------------------------------------------------------------------- *) -op valid: block list -> bool. + +op valid : block list -> bool = + fun xs => unpad xs <> None. clone import IRO as BIRO with type from <- block list, @@ -24,11 +26,10 @@ clone include Indifferentiability.Core with [module] "al" as "alIndif". (* -------------------------------------------------------------------- *) -(** Spurious uninitialized variable warning on p *) module BlockSponge (P : PRIMITIVE) : BIRO.IRO, CONSTRUCTION(P) = { proc init = P.init - proc f(p : block list, n : int): block list = { + proc f(p : block list, n : int) : block list = { var z <- []; var (sa,sc) <- (b0, Capacity.c0); var i <- 0; diff --git a/proof/Common.ec b/proof/Common.ec index d64371a..862f64a 100644 --- a/proof/Common.ec +++ b/proof/Common.ec @@ -1,5 +1,5 @@ (* -------------------------------------------------------------------- *) -require import Fun Pair Int Real List NewDistr. +require import Option Fun Pair Int Real List NewDistr. require (*--*) FinType LazyRP Monoid. (* -------------------------------------------------------------------- *) @@ -68,3 +68,38 @@ clone export LazyRP as Perm with rename [module type] "RP" as "PRIMITIVE" [module] "P" as "Perm". + +(* ------------------------------ Padding ----------------------------- *) + +(* unpad_aux returns None if its argument xs doesn't end with true and + have at least one other occurrence of true; otherwise, it returns + Some of the result of removing the shortest suffix of xs containing + two occurrences of true *) +op unpad_aux : bool list -> bool list option = + fun xs => + let ys = rev xs in + if !(head false ys) + then None + else let zs = behead ys in + let i = find ((=) true) zs in + if i = size zs + then None + else Some(rev(drop (i + 1) zs)). + +op unpad : block list -> bool list option = + fun xs => + if xs = [] + then None + else let bs = w2bits(last b0 xs) in + let ys = take (size xs - 1) xs in + let ocs = unpad_aux bs in + if ocs = None + then if bs = nseq (r - 1) false ++ [true] && ys <> [] + then let ds = w2bits(last b0 ys) in + let ws = take (size ys - 1) ys in + if !(last false ds) + then None + else Some(flatten(map w2bits ws) ++ + take (size ds - 1) ds) + else None + else Some(flatten(map w2bits ys) ++ oget ocs). From 0303bda5f6348334c008a9ba9e58a2be22e7b083 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Fri, 20 Nov 2015 18:02:04 -0500 Subject: [PATCH 050/525] Padding/unpadding and extending/stripping fully specified, and lemmas connecting them stated. --- proof/Absorb.ec | 18 +--- proof/AbsorbToBlocks.ec | 208 ++++++++++++++++---------------------- proof/Blocks.ec | 2 +- proof/BlocksToTopLevel.ec | 69 +++++-------- proof/Common.ec | 85 +++++++++++++++- proof/TopLevel.ec | 3 - 6 files changed, 196 insertions(+), 189 deletions(-) diff --git a/proof/Absorb.ec b/proof/Absorb.ec index 9d1f753..633c864 100644 --- a/proof/Absorb.ec +++ b/proof/Absorb.ec @@ -9,24 +9,8 @@ require import Common. (* -------------------------------------------------------------------- *) -(* valid_strip returns None if removing the longest suffix of b0's - from its argument yields a block list that cannot be unpadded; - otherwise, it removes the longest suffix of b0's from its argument - and returns the pair of the resulting block list with the number of - b0's removed *) -op valid_strip : block list -> (block list * int)option = - fun xs => - let ys = rev xs in - let i = find (fun x => x <> b0) ys in - if i = size xs - then None - else let zs = rev(drop i ys) in - if unpad zs = None - then None - else Some(zs, i). - op valid : block list -> bool = - fun xs => valid_strip xs <> None. + fun xs => strip xs <> None. clone import RndOrcl as RO with type from <- block list, diff --git a/proof/AbsorbToBlocks.ec b/proof/AbsorbToBlocks.ec index f6befac..c349cf3 100644 --- a/proof/AbsorbToBlocks.ec +++ b/proof/AbsorbToBlocks.ec @@ -7,94 +7,55 @@ require import Common. op cast: 'a NewDistr.distr -> 'a distr. -op extend (bs : block list) (n : int): block list = - bs ++ (mkseq (fun k => b0) n). - -op strip_aux (bs : block list) (n : int) : block list * int = - with bs = [] => ([],n) - with bs = b :: bs => - if b = b0 - then strip_aux bs (n + 1) - else (rev (b :: bs),n). - -op strip (bs : block list) = strip_aux (rev bs) 0. - -lemma ge0_strip_aux n bs: - 0 <= n => - 0 <= (strip_aux bs n).`2. -proof. - elim bs n=> //= b bs ih n le0_n. - case (b = b0)=> //=. - by rewrite (ih (n + 1) _) 1:smt. -qed. - -lemma ge0_strip2 bs: - 0 <= (strip bs).`2. -proof. by rewrite /strip; exact/(ge0_strip_aux 0 (rev bs)). qed. - -op valid_upper (bs : block list) = - bs <> [] /\ - forall n, strip (extend bs n) = (bs,n). - -op valid_lower (bs : block list) = - valid_upper (strip bs).`1. - -(* PY: FIXME *) -clone Absorb as Lower with - op cast <- cast<:'a>, - op valid <- valid_lower. - -clone Blocks as Upper with - op valid <- valid_upper. - (* -------------------------------------------------------------------- *) -module LowerFun( F : Upper.FUNCTIONALITY ) : Lower.FUNCTIONALITY = { +module LowerFun(F : Blocks.FUNCTIONALITY) : Absorb.FUNCTIONALITY = { proc init = F.init - proc f(p : block list): block = { - var b <- []; + proc f(xs : block list) : block = { + var o : (block list * int)option; + var ys <- []; var n; - if (valid_lower p) { - (p,n) <- strip p; - b <@ F.f(p,n + 1); + o <- strip xs; + if (o <> None) { + (ys, n) <- oget o; + ys <@ F.f(ys, n + 1); } - return last b0 b; + return last b0 ys; } }. -module Sim ( S : Lower.SIMULATOR, F : Upper.FUNCTIONALITY ) = S(LowerFun(F)). +module Sim (S : Absorb.SIMULATOR, F : Blocks.FUNCTIONALITY) = S(LowerFun(F)). -module UpperFun ( F : Lower.FUNCTIONALITY ) = { +module UpperFun (F : Absorb.FUNCTIONALITY) = { proc init = F.init - proc f(p : block list, n : int) : block list = { - var b <- b0; - var bs <- []; + proc f(xs : block list, n : int) : block list = { + var y <- b0; + var ys <- []; var i <- 0; - if (valid_upper p) { + if (unpad xs <> None) { while (i < n) { - b <@ F.f(extend p i); - bs <- rcons bs b; + y <@ F.f(oget(extend xs i)); + ys <- rcons ys y; i <- i + 1; } } - - return bs; + return ys; } }. -module UpperOfLowerBlockSponge (P : Upper.PRIMITIVE) = UpperFun(Lower.BlockSponge(P)). +module BlocksOfAbsorbBlockSponge (P : Blocks.PRIMITIVE) = UpperFun(Absorb.BlockSponge(P)). -module Dist ( D : Upper.DISTINGUISHER, F : Lower.FUNCTIONALITY, P : Lower.PRIMITIVE ) = D(UpperFun(F),P). +module Dist ( D : Blocks.DISTINGUISHER, F : Absorb.FUNCTIONALITY, P : Absorb.PRIMITIVE ) = D(UpperFun(F),P). section. - declare module LowerSim : Lower.SIMULATOR { Perm, Upper.BIRO.IRO', Lower.Ideal.RO }. - declare module UpperDist : Upper.DISTINGUISHER { Perm, Upper.BIRO.IRO', Lower.Ideal.RO, LowerSim }. + declare module AbsorbSim : Absorb.SIMULATOR { Perm, Blocks.BIRO.IRO', Absorb.Ideal.RO }. + declare module BlocksDist : Blocks.DISTINGUISHER { Perm, Blocks.BIRO.IRO', Absorb.Ideal.RO, AbsorbSim }. - local equiv ModularUpper_Real: - UpperFun(Lower.BlockSponge(Perm)).f ~ Upper.BlockSponge(Perm).f: + local equiv ModularBlocks_Real: + UpperFun(Absorb.BlockSponge(Perm)).f ~ Blocks.BlockSponge(Perm).f: ={arg} /\ ={m,mi}(Perm,Perm) /\ (forall x, mem (dom Perm.m){1} x) @@ -103,42 +64,44 @@ section. /\ (forall x, mem (dom Perm.m){1} x). proof. proc. sp; if=> //=. - inline Lower.BlockSponge(Perm).f. + inline Absorb.BlockSponge(Perm).f. admit. (* Fun with loops *) qed. pred lower (ro : (block list,block) fmap) (iro : (block list * int,block) fmap) = - Upper.BIRO.prefix_closed iro /\ - forall x n, valid_upper x => iro.[(x,n)] = ro.[extend x n]. + Blocks.BIRO.prefix_closed iro /\ + forall x n, unpad x <> None => iro.[(x,n)] = ro.[oget(extend x n)]. - local equiv ModularLower: - UpperFun(Lower.Ideal.RO).f ~ Upper.BIRO.IRO'.f: + local equiv ModularAbsorb: + UpperFun(Absorb.Ideal.RO).f ~ Blocks.BIRO.IRO'.f: ={arg} - /\ lower Lower.Ideal.RO.m{1} Upper.BIRO.IRO'.mp{2} + /\ lower Absorb.Ideal.RO.m{1} Blocks.BIRO.IRO'.mp{2} ==> ={res} - /\ lower Lower.Ideal.RO.m{1} Upper.BIRO.IRO'.mp{2}. + /\ lower Absorb.Ideal.RO.m{1} Blocks.BIRO.IRO'.mp{2}. proof. proc. sp; if=> //=. - inline Lower.BlockSponge(Perm).f. + inline Absorb.BlockSponge(Perm).f. admit. (* Fun with loops *) qed. pred upper (ro : (block list,block) fmap) (iro : (block list * int,block) fmap) = - (forall x y, valid_lower x => ro.[x] = Some y => iro.[strip x] = Some y) + (forall x y, strip x <> None => ro.[x] = Some y => iro.[oget(strip x)] = Some y) /\ (forall x n y, - valid_upper x => + unpad x <> None => iro.[(x,n)] = Some y => exists n', n <= n' - /\ mem (dom ro) (extend x n')). + /\ mem (dom ro) (oget(extend x n'))). - module LowIRO' : Lower.FUNCTIONALITY = { - proc init = Upper.BIRO.IRO'.init + module LowIRO' : Absorb.FUNCTIONALITY = { + proc init = Blocks.BIRO.IRO'.init proc f(x : block list) = { var b <- b0; + var o : (block list * int)option; - if (valid_lower x) { - b <@ Upper.BIRO.IRO'.f_lazy(strip x); + o <- strip x; + if (o <> None) { + b <@ Blocks.BIRO.IRO'.f_lazy(oget o); } return b; @@ -146,7 +109,7 @@ section. }. pred holey_map (iro iro_lazy : (block list * int,block) fmap) = - Upper.BIRO.prefix_closed iro + Blocks.BIRO.prefix_closed iro /\ (forall xn, mem (dom iro_lazy) xn => iro_lazy.[xn] = iro.[xn]) @@ -160,23 +123,24 @@ section. whose index is not in the index of the right map, as they have not ben given to the adversary. **) local lemma LazifyIRO: - eager [Upper.BIRO.IRO'.resample_invisible(); , LowerFun(Upper.BIRO.IRO').f ~ LowIRO'.f, Upper.BIRO.IRO'.resample_invisible();: - ={arg, Upper.BIRO.IRO'.visible} - /\ holey_map Upper.BIRO.IRO'.mp{1} Upper.BIRO.IRO'.mp{2} - /\ Upper.BIRO.IRO'.visible{2} = dom (Upper.BIRO.IRO'.mp){2} - ==> ={res, Upper.BIRO.IRO'.visible} - /\ holey_map Upper.BIRO.IRO'.mp{1} Upper.BIRO.IRO'.mp{2} - /\ Upper.BIRO.IRO'.visible{2} = dom (Upper.BIRO.IRO'.mp){2}]. + eager [Blocks.BIRO.IRO'.resample_invisible(); , LowerFun(Blocks.BIRO.IRO').f ~ LowIRO'.f, Blocks.BIRO.IRO'.resample_invisible();: + ={arg, Blocks.BIRO.IRO'.visible} + /\ holey_map Blocks.BIRO.IRO'.mp{1} Blocks.BIRO.IRO'.mp{2} + /\ Blocks.BIRO.IRO'.visible{2} = dom (Blocks.BIRO.IRO'.mp){2} + ==> ={res, Blocks.BIRO.IRO'.visible} + /\ holey_map Blocks.BIRO.IRO'.mp{1} Blocks.BIRO.IRO'.mp{2} + /\ Blocks.BIRO.IRO'.visible{2} = dom (Blocks.BIRO.IRO'.mp){2}]. proof. +(* eager proc. case (!valid_lower p{1})=> /=. rcondf{1} 3; 1: by auto; inline *; auto; while (true); auto. rcondf{2} 2; 1: by auto. inline *; auto. rcondf{2} 4; 1: by auto; smt. - while{1} ( work{1} <= dom (Upper.BIRO.IRO'.mp){1} - /\ holey_map Upper.BIRO.IRO'.mp{1} Upper.BIRO.IRO'.mp{2} - /\ forall x, mem work{1} x => mem (dom Upper.BIRO.IRO'.mp){1} x /\ !mem (dom Upper.BIRO.IRO'.mp){2} x) + while{1} ( work{1} <= dom (Blocks.BIRO.IRO'.mp){1} + /\ holey_map Blocks.BIRO.IRO'.mp{1} Blocks.BIRO.IRO'.mp{2} + /\ forall x, mem work{1} x => mem (dom Blocks.BIRO.IRO'.mp){1} x /\ !mem (dom Blocks.BIRO.IRO'.mp){2} x) (card work{1}). auto; progress. + admit. (* TODO: dto lossless *) @@ -195,19 +159,19 @@ section. by auto; smt. rcondt{1} 3; 1: by auto; inline *; auto; while (true); auto. rcondt{2} 2; 1: by auto. - inline Upper.BIRO.IRO'.f Upper.BIRO.IRO'.f_lazy. + inline Blocks.BIRO.IRO'.f Blocks.BIRO.IRO'.f_lazy. rcondt{1} 8; 1: by auto; inline *; auto; while (true); auto; smt. rcondt{2} 4; 1: by auto; smt. - case ((mem (dom Upper.BIRO.IRO'.mp) (strip p)){1} /\ !(mem (dom Upper.BIRO.IRO'.mp) (strip x)){2}). + case ((mem (dom Blocks.BIRO.IRO'.mp) (strip p)){1} /\ !(mem (dom Blocks.BIRO.IRO'.mp) (strip x)){2}). admit. (* this is the bad case where we need to bring down the sampling from resample_invisible *) - inline{2} Upper.BIRO.IRO'.resample_invisible. + inline{2} Blocks.BIRO.IRO'.resample_invisible. rcondf{2} 9; 1: by auto; inline *; sp; if; auto; smt. - seq 1 0: ((((p{1} = x{2} /\ ={Upper.BIRO.IRO'.visible}) /\ - holey_map Upper.BIRO.IRO'.mp{1} Upper.BIRO.IRO'.mp{2} /\ - Upper.BIRO.IRO'.visible{2} = dom Upper.BIRO.IRO'.mp{2}) /\ + seq 1 0: ((((p{1} = x{2} /\ ={Blocks.BIRO.IRO'.visible}) /\ + holey_map Blocks.BIRO.IRO'.mp{1} Blocks.BIRO.IRO'.mp{2} /\ + Blocks.BIRO.IRO'.visible{2} = dom Blocks.BIRO.IRO'.mp{2}) /\ valid_lower p{1}) /\ - ! (mem (dom Upper.BIRO.IRO'.mp{1}) (strip p{1}) /\ - ! mem (dom Upper.BIRO.IRO'.mp{2}) (strip x{2}))). (* disgusting copy-paste. we need seq* *) + ! (mem (dom Blocks.BIRO.IRO'.mp{1}) (strip p{1}) /\ + ! mem (dom Blocks.BIRO.IRO'.mp{2}) (strip x{2}))). (* disgusting copy-paste. we need seq* *) admit. splitwhile{1} 8: (i < n0 - 1). rcondt{1} 9. @@ -221,6 +185,8 @@ section. by auto; smt. * inline*; sp; if; auto; smt. admit. (* just pushing the proof through *) +*) + admit. qed. @@ -228,27 +194,27 @@ section. - on actual queries, the two maps agree; - blocks in the IRO that are just generated on the way to answering actual queries can be resampled. **) - (* Lower.Ideal.RO.f ~ LowerFun(Upper.BIRO.IRO).f: + (* Absorb.Ideal.RO.f ~ LowerFun(Blocks.BIRO.IRO).f: ={arg} /\ true ==> ={res}. *) lemma Intermediate &m: - `|Pr[Upper.RealIndif(Upper.BlockSponge,Perm,UpperDist).main() @ &m :res] - - Pr[Upper.IdealIndif(Upper.BIRO.IRO',Sim(LowerSim),UpperDist).main() @ &m: res]| - = `|Pr[Upper.RealIndif(UpperOfLowerBlockSponge,Perm,UpperDist).main() @ &m: res] - - Pr[Upper.IdealIndif(UpperFun(Lower.Ideal.RO),Sim(LowerSim),UpperDist).main() @ &m: res]|. + `|Pr[Blocks.RealIndif(Blocks.BlockSponge,Perm,BlocksDist).main() @ &m :res] + - Pr[Blocks.IdealIndif(Blocks.BIRO.IRO',Sim(AbsorbSim),BlocksDist).main() @ &m: res]| + = `|Pr[Blocks.RealIndif(BlocksOfAbsorbBlockSponge,Perm,BlocksDist).main() @ &m: res] + - Pr[Blocks.IdealIndif(UpperFun(Absorb.Ideal.RO),Sim(AbsorbSim),BlocksDist).main() @ &m: res]|. proof. - have ->: Pr[Upper.RealIndif(UpperOfLowerBlockSponge,Perm,UpperDist).main() @ &m: res] - = Pr[Upper.RealIndif(Upper.BlockSponge,Perm,UpperDist).main() @ &m :res]. + have ->: Pr[Blocks.RealIndif(BlocksOfAbsorbBlockSponge,Perm,BlocksDist).main() @ &m: res] + = Pr[Blocks.RealIndif(Blocks.BlockSponge,Perm,BlocksDist).main() @ &m :res]. byequiv=> //=; proc. call (_: ={m,mi}(Perm,Perm) /\ (forall x, mem (dom Perm.m){1} x)). by proc; if; auto; smt. by proc; if; auto; smt. (* BUG: arg should be handled much earlier and automatically *) - by conseq ModularUpper_Real=> //= &1 &2; case (arg{1}); case (arg{2})=> //=. + by conseq ModularBlocks_Real=> //= &1 &2; case (arg{1}); case (arg{2})=> //=. call (_: true ==> ={glob Perm} /\ (forall x, mem (dom Perm.m){1} x)). @@ -256,16 +222,16 @@ section. (* Now the other initialization is dead code. *) call (_: true ==> true)=> //. by proc; auto. - have ->: Pr[Upper.IdealIndif(UpperFun(Lower.Ideal.RO),Sim(LowerSim),UpperDist).main() @ &m: res] - = Pr[Upper.IdealIndif(Upper.BIRO.IRO',Sim(LowerSim),UpperDist).main() @ &m: res]. + have ->: Pr[Blocks.IdealIndif(UpperFun(Absorb.Ideal.RO),Sim(AbsorbSim),BlocksDist).main() @ &m: res] + = Pr[Blocks.IdealIndif(Blocks.BIRO.IRO',Sim(AbsorbSim),BlocksDist).main() @ &m: res]. byequiv=> //=; proc. - call (_: ={glob LowerSim} /\ lower Lower.Ideal.RO.m{1} Upper.BIRO.IRO'.mp{2}). - proc (lower Lower.Ideal.RO.m{1} Upper.BIRO.IRO'.mp{2})=> //=. - by proc; sp; if=> //=; call ModularLower; auto. - proc (lower Lower.Ideal.RO.m{1} Upper.BIRO.IRO'.mp{2})=> //=. - by proc; sp; if=> //=; call ModularLower; auto. + call (_: ={glob AbsorbSim} /\ lower Absorb.Ideal.RO.m{1} Blocks.BIRO.IRO'.mp{2}). + proc (lower Absorb.Ideal.RO.m{1} Blocks.BIRO.IRO'.mp{2})=> //=. + by proc; sp; if=> //=; call ModularAbsorb; auto. + proc (lower Absorb.Ideal.RO.m{1} Blocks.BIRO.IRO'.mp{2})=> //=. + by proc; sp; if=> //=; call ModularAbsorb; auto. (* Re-Bug *) - by conseq ModularLower=> &1 &2; case (arg{1}); case (arg{2}). + by conseq ModularAbsorb=> &1 &2; case (arg{1}); case (arg{2}). inline *; wp; call (_: true)=> //=. by sim. auto; progress [-split]; split=> //=. @@ -274,16 +240,16 @@ section. qed. lemma Remainder &m: - `|Pr[Upper.RealIndif(UpperOfLowerBlockSponge,Perm,UpperDist).main() @ &m: res] - - Pr[Upper.IdealIndif(UpperFun(Lower.Ideal.RO),Sim(LowerSim),UpperDist).main() @ &m: res]| - = `|Pr[Lower.RealIndif(Lower.BlockSponge,Perm,Dist(UpperDist)).main() @ &m: res] - - Pr[Lower.IdealIndif(Lower.Ideal.RO,LowerSim,Dist(UpperDist)).main() @ &m: res]|. + `|Pr[Blocks.RealIndif(BlocksOfAbsorbBlockSponge,Perm,BlocksDist).main() @ &m: res] + - Pr[Blocks.IdealIndif(UpperFun(Absorb.Ideal.RO),Sim(AbsorbSim),BlocksDist).main() @ &m: res]| + = `|Pr[Absorb.RealIndif(Absorb.BlockSponge,Perm,Dist(BlocksDist)).main() @ &m: res] + - Pr[Absorb.IdealIndif(Absorb.Ideal.RO,AbsorbSim,Dist(BlocksDist)).main() @ &m: res]|. proof. admit. qed. lemma Conclusion &m: - `|Pr[Upper.RealIndif(Upper.BlockSponge,Perm,UpperDist).main() @ &m: res] - - Pr[Upper.IdealIndif(Upper.BIRO.IRO',Sim(LowerSim),UpperDist).main() @ &m: res]| - = `|Pr[Lower.RealIndif(Lower.BlockSponge,Perm,Dist(UpperDist)).main() @ &m: res] - - Pr[Lower.IdealIndif(Lower.Ideal.RO,LowerSim,Dist(UpperDist)).main() @ &m: res]|. + `|Pr[Blocks.RealIndif(Blocks.BlockSponge,Perm,BlocksDist).main() @ &m: res] + - Pr[Blocks.IdealIndif(Blocks.BIRO.IRO',Sim(AbsorbSim),BlocksDist).main() @ &m: res]| + = `|Pr[Absorb.RealIndif(Absorb.BlockSponge,Perm,Dist(BlocksDist)).main() @ &m: res] + - Pr[Absorb.IdealIndif(Absorb.Ideal.RO,AbsorbSim,Dist(BlocksDist)).main() @ &m: res]|. proof. by rewrite (Intermediate &m) (Remainder &m). qed. end section. diff --git a/proof/Blocks.ec b/proof/Blocks.ec index 3e5d038..ff3c8cd 100644 --- a/proof/Blocks.ec +++ b/proof/Blocks.ec @@ -60,4 +60,4 @@ lemma top: `| Pr[RealIndif(BlockSponge, Perm, D).main() @ &m : res] - Pr[IdealIndif(IRO', S, D).main() @ &m : res]| < eps. -proof. admit. qed. \ No newline at end of file +proof. admit. qed. diff --git a/proof/BlocksToTopLevel.ec b/proof/BlocksToTopLevel.ec index e0fbbb3..977ffac 100644 --- a/proof/BlocksToTopLevel.ec +++ b/proof/BlocksToTopLevel.ec @@ -5,77 +5,56 @@ require (*--*) Blocks TopLevel. (* -------------------------------------------------------------------- *) require import Common. -op chunk: bool list -> bool list list. - -op padlength (n : int) = - let n' = (n + 2) %% r in - if n' = 0 then 0 else r - n'. - -op pad (bs : bool list): block list = - let p = rcons (true :: mkseq (fun k => false) (padlength (size bs))) true in - map bits2w (chunk (bs ++ p)). - -op unpad (bs : block list): bool list option. (* Alley to fill in the definition *) - -axiom unpadK (bs : bool list): pcancel pad unpad. -axiom padK (*?*) (bs : block list): ocancel unpad pad. - -op valid_lower (bs : block list) = unpad bs <> None. - -clone Blocks as Lower with - op valid <- valid_lower. - -clone TopLevel as Upper. - (* -------------------------------------------------------------------- *) -module UpperFun ( F : Lower.FUNCTIONALITY ) = { +module UpperFun (F : Blocks.FUNCTIONALITY) = { proc init = F.init proc f(p : bool list, n : int) = { - var bs; + var xs; - bs <@ F.f(pad p,(n + r - 1) /% r); - return take n (flatten (map w2bits bs)); + xs <@ F.f(pad p, (n + r - 1) /% r); + return take n (flatten(map w2bits xs)); } }. -module LowerFun ( F: Upper.FUNCTIONALITY) = { +module LowerFun (F : TopLevel.FUNCTIONALITY) = { proc init = F.init - proc f(p : block list, n : int) = { - var bs, m; - var bs' <- []; + proc f(xs : block list, n : int) = { + var cs, ds : bool list; + var obs : bool list option; + var ys : block list <- []; - m <- unpad p; - if (m <> None) { - bs <@ F.f(oget m,n * r); - bs' <- map bits2w (chunk bs); + obs <- unpad xs; + if (obs <> None) { + cs <@ F.f(oget obs, n * r); (* size cs = n * r *) + ys <- (chunk cs).`1; } - return bs'; + return ys; } }. (* -------------------------------------------------------------------- *) equiv ModularConstruction: - UpperFun(Lower.BlockSponge(Perm)).f ~ Upper.Sponge(Perm).f: + UpperFun(Blocks.BlockSponge(Perm)).f ~ TopLevel.Sponge(Perm).f: ={glob Perm, arg} ==> ={glob Perm, res}. proof. - proc. inline Lower.BlockSponge(Perm).f. + proc. inline Blocks.BlockSponge(Perm).f. admit. (* done *) qed. -module ModularSimulator (S : Lower.SIMULATOR, F : Upper.FUNCTIONALITY) = S(LowerFun(F)). +module ModularSimulator (S : Blocks.SIMULATOR, F : TopLevel.FUNCTIONALITY) = S(LowerFun(F)). -module LowerDist ( D : Upper.DISTINGUISHER, F : Lower.FUNCTIONALITY, P : PRIMITIVE) = +module BlocksDist ( D : TopLevel.DISTINGUISHER, F : Blocks.FUNCTIONALITY, P : PRIMITIVE) = D(UpperFun(F),P). section. - declare module LowerSim : Lower.SIMULATOR. - declare module UpperDist : Upper.DISTINGUISHER. + declare module BlocksSim : Blocks.SIMULATOR. + declare module TopLevelDist : TopLevel.DISTINGUISHER. lemma Conclusion &m: - `|Pr[Upper.RealIndif(Upper.Sponge,Perm,UpperDist).main() @ &m: res] - - Pr[Upper.IdealIndif(Upper.BIRO.IRO',ModularSimulator(LowerSim),UpperDist).main() @ &m: res]| - = `|Pr[Lower.RealIndif(Lower.BlockSponge,Perm,LowerDist(UpperDist)).main() @ &m: res] - - Pr[Lower.IdealIndif(Lower.BIRO.IRO',LowerSim,LowerDist(UpperDist)).main() @ &m: res]|. + `|Pr[TopLevel.RealIndif(TopLevel.Sponge,Perm,TopLevelDist).main() @ &m: res] + - Pr[TopLevel.IdealIndif(TopLevel.BIRO.IRO',ModularSimulator(BlocksSim),TopLevelDist).main() @ &m: res]| + = `|Pr[Blocks.RealIndif(Blocks.BlockSponge,Perm,BlocksDist(TopLevelDist)).main() @ &m: res] + - Pr[Blocks.IdealIndif(Blocks.BIRO.IRO',BlocksSim,BlocksDist(TopLevelDist)).main() @ &m: res]|. proof. admit. qed. diff --git a/proof/Common.ec b/proof/Common.ec index 862f64a..dec6307 100644 --- a/proof/Common.ec +++ b/proof/Common.ec @@ -1,5 +1,5 @@ (* -------------------------------------------------------------------- *) -require import Option Fun Pair Int Real List NewDistr. +require import Option Fun Pair Int IntExtra Real List NewDistr. require (*--*) FinType LazyRP Monoid. (* -------------------------------------------------------------------- *) @@ -69,7 +69,34 @@ rename [module type] "RP" as "PRIMITIVE" [module] "P" as "Perm". -(* ------------------------------ Padding ----------------------------- *) +(* ------------------------- Padding/Unpadding ------------------------ *) + +(* if size cs < r, then size (chunk_aux (xs, cs) b).`2 < r *) +op chunk_aux : block list * bool list -> bool -> block list * bool list = + fun p b => + let (xs, cs) = p in + let ds = rcons cs b in + if size ds = r + then (rcons xs (bits2w ds), []) + else (xs, ds). + +(* size (chunk bs).`2 < r *) +op chunk : bool list -> block list * bool list = + fun bs => foldl chunk_aux ([], []) bs. + +op pad : bool list -> block list = + fun bs => + let (xs, cs) = chunk bs in + let siz_cs = size cs in (* siz_cs < r *) + if 2 <= r - siz_cs + then rcons xs + (bits2w(cs ++ + [true] ++ + nseq (r - siz_cs - 2) false ++ + [true])) + else (* r - siz_cs = 1 *) + xs ++ [bits2w(rcons cs true)] ++ + [bits2w(rcons (nseq (r - 1) false) true)]. (* unpad_aux returns None if its argument xs doesn't end with true and have at least one other occurrence of true; otherwise, it returns @@ -103,3 +130,57 @@ op unpad : block list -> bool list option = take (size ds - 1) ds) else None else Some(flatten(map w2bits ys) ++ oget ocs). + +lemma pad_unpad : pcancel pad unpad. +proof. +rewrite /pcancel. +admit. +qed. + +lemma unpad_pad : ocancel unpad pad. +proof. +rewrite /ocancel. +admit. +qed. + +(* ------------------------ Extending/Stripping ----------------------- *) + +(* extend xs n returns None if xs doesn't unpad successfully; + otherwise, it returns the result of adding n copies of b0 to the + end of xs (n < 0 is treated as n = 0) *) +op extend : block list -> int -> block list option = + fun xs n => + if unpad xs = None + then None + else Some(xs ++ nseq n b0). + +op extend_uncur : block list * int -> block list option = + fun (p : block list * int) => extend p.`1 p.`2. + +(* strip returns None if removing the longest suffix of b0's from its + argument yields a block list that cannot be unpadded; otherwise, it + removes the longest suffix of b0's from its argument and returns + the pair of the resulting block list with the number of b0's + removed *) +op strip : block list -> (block list * int)option = + fun xs => + let ys = rev xs in + let i = find (fun x => x <> b0) ys in + if i = size xs + then None + else let zs = rev(drop i ys) in + if unpad zs = None + then None + else Some(zs, i). + +lemma extend_strip (xs : block list, n : int) : + oapp strip (Some(xs, max n 0)) (extend xs n) = Some(xs, max n 0). +proof. +admit. +qed. + +lemma strip_extend (xs : block list) : + oapp extend_uncur (Some xs) (strip xs) = Some xs. +proof. +admit. +qed. diff --git a/proof/TopLevel.ec b/proof/TopLevel.ec index 9886558..f42864e 100644 --- a/proof/TopLevel.ec +++ b/proof/TopLevel.ec @@ -5,9 +5,6 @@ require (*--*) IRO LazyRP Indifferentiability. (* -------------------------------------------------------------------- *) require import Common. -(* -------------------------------------------------------------------- *) -op pad : bool list -> block list. - (* -------------------------------------------------------------------- *) clone import IRO as BIRO with type from <- bool list, From 2cc35e0b1389556934090efee4690dab29a0d49b Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Mon, 23 Nov 2015 12:22:39 -0500 Subject: [PATCH 051/525] Characterization lemmas for unpad and strip success. --- proof/Common.ec | 21 +++++++++++++++++++++ 1 file changed, 21 insertions(+) diff --git a/proof/Common.ec b/proof/Common.ec index dec6307..3d3361a 100644 --- a/proof/Common.ec +++ b/proof/Common.ec @@ -131,6 +131,17 @@ op unpad : block list -> bool list option = else None else Some(flatten(map w2bits ys) ++ oget ocs). +pred valid_block (xs : block list) = + exists (ys : bool list, n : int), + 0 <= n < r /\ + flatten(map w2bits xs) = ys ++ [true] ++ nseq n false ++ [true]. + +lemma valid_block (xs : block list) : + unpad xs <> None <=> valid_block xs. +proof. +admit. +qed. + lemma pad_unpad : pcancel pad unpad. proof. rewrite /pcancel. @@ -173,6 +184,16 @@ op strip : block list -> (block list * int)option = then None else Some(zs, i). +pred valid_absorb (xs : block list) = + exists (ys : block list, n : int), + 0 <= n /\ valid_block ys /\ xs = ys ++ nseq n b0. + +lemma valid_absorb (xs : block list) : + strip xs <> None <=> valid_absorb xs. +proof. +admit. +qed. + lemma extend_strip (xs : block list, n : int) : oapp strip (Some(xs, max n 0)) (extend xs n) = Some(xs, max n 0). proof. From 46349a99550fd94053dcc4ab81596a864405d55c Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Tue, 24 Nov 2015 11:48:56 -0500 Subject: [PATCH 052/525] Changed to use IntDiv. --- proof/BlocksToTopLevel.ec | 4 ++-- proof/TopLevel.ec | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/proof/BlocksToTopLevel.ec b/proof/BlocksToTopLevel.ec index 977ffac..ee672ec 100644 --- a/proof/BlocksToTopLevel.ec +++ b/proof/BlocksToTopLevel.ec @@ -1,5 +1,5 @@ (* -------------------------------------------------------------------- *) -require import Fun Pred Option Pair Int Real List FSet NewFMap. +require import Fun Pred Option Pair Int IntDiv Real List FSet NewFMap. require (*--*) Blocks TopLevel. (* -------------------------------------------------------------------- *) @@ -12,7 +12,7 @@ module UpperFun (F : Blocks.FUNCTIONALITY) = { proc f(p : bool list, n : int) = { var xs; - xs <@ F.f(pad p, (n + r - 1) /% r); + xs <@ F.f(pad p, (n + r - 1) %/ r); return take n (flatten(map w2bits xs)); } }. diff --git a/proof/TopLevel.ec b/proof/TopLevel.ec index f42864e..fdf783d 100644 --- a/proof/TopLevel.ec +++ b/proof/TopLevel.ec @@ -1,5 +1,5 @@ (* -------------------------------------------------------------------- *) -require import Pair Int Real List. +require import Pair Int IntDiv Real List. require (*--*) IRO LazyRP Indifferentiability. (* -------------------------------------------------------------------- *) @@ -38,7 +38,7 @@ module Sponge (P : PRIMITIVE) : BIRO.IRO, CONSTRUCTION(P) = { p <- behead p; } (* Squeezing *) - while (i < (n + r - 1) /% r) { + while (i < (n + r - 1) %/ r) { z <- z ++ (Block.w2bits sa); (sa,sc) <@ P.f(sa,sc); i <- i + 1; From ee8b560ff20687df204dab9ba40e3c4827863906 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Wed, 25 Nov 2015 21:55:06 -0500 Subject: [PATCH 053/525] Ugly proofs regarding chunking; will clean up next. --- proof/Common.ec | 171 ++++++++++++++++++++++++++++++++++++++++++------ 1 file changed, 150 insertions(+), 21 deletions(-) diff --git a/proof/Common.ec b/proof/Common.ec index 3d3361a..d371986 100644 --- a/proof/Common.ec +++ b/proof/Common.ec @@ -30,6 +30,9 @@ lemma bits2wK (s : bool list) : size s = size => w2bits (bits2w s) = s. proof. admit. qed. +lemma w2bits_size (x : bword) : size(w2bits x) = size. +proof. admit. qed. + op uniform : bword distr = MUniform.duniform FinType.enum. end BitWord. @@ -82,7 +85,150 @@ op chunk_aux : block list * bool list -> bool -> block list * bool list = (* size (chunk bs).`2 < r *) op chunk : bool list -> block list * bool list = - fun bs => foldl chunk_aux ([], []) bs. + foldl chunk_aux ([], []). + +op flatten (p : block list * bool list) : bool list = + flatten(map w2bits p.`1) ++ p.`2. + +lemma chunk_aux_flatten (xs : block list, cs : bool list, bs : bool list) : + size cs < r => + flatten (foldl chunk_aux (xs, cs) bs) = + flatten(map w2bits xs) ++ cs ++ bs. +proof. +move: bs xs cs. +elim. +(* basis step *) +move=> xs cs siz_cs_lt_r. +have -> : foldl chunk_aux (xs, cs) [] = (xs, cs) by trivial. +rewrite /flatten /=. +rewrite - catA. +rewrite cats0 //. +(* inductive step *) +move=> x l IH xs cs siz_cs_lt_r /=. +rewrite {2} /chunk_aux /=. +case (size cs = r - 1) => siz_cs_eq_r_min1. +have -> : size(rcons cs x) = r by smt. +simplify. +have -> : + flatten (map w2bits xs) ++ cs ++ x :: l = + flatten (map w2bits xs) ++ (rcons cs x) ++ l by smt. +rewrite (IH (rcons xs (bits2w (rcons cs x))) []). + smt. +have -> : + map w2bits (rcons xs (bits2w (rcons cs x))) = + rcons (map w2bits xs) (rcons cs x) by smt. +rewrite - cats1. +smt. +have : size cs < r - 1 by smt. +move=> siz_cs_lt_r_min1. +clear siz_cs_lt_r siz_cs_eq_r_min1. +have : !(size(rcons cs x) = r) by smt. +move=> H. +rewrite H /=. +rewrite (IH xs (rcons cs x)). + smt. +smt. +qed. + +lemma chunk_flatten : cancel chunk flatten. +proof. +rewrite /cancel => p. +rewrite /chunk. +rewrite chunk_aux_flatten. +smt. +smt. +qed. + +lemma foldl_chunk_aux_add_bits (ys : block list, cs, ds : bool list) : + size ds + size cs < r => + foldl chunk_aux (ys, ds) cs = (ys, ds ++ cs). +proof. +move: ys ds. +elim cs. +smt. +move=> c cs IH ys ds siz_ys_plus_c_cs_lt_r. +have -> : + foldl chunk_aux (ys, ds) (c :: cs) = + foldl chunk_aux (ys, rcons ds c) cs. + simplify. + have -> : chunk_aux (ys, ds) c = (ys, rcons ds c). + rewrite /chunk_aux. + simplify. + smt. + reflexivity. +rewrite (IH ys (rcons ds c)). +smt. +smt. +qed. + +lemma foldl_chunk_aux_new_block (ys : block list, cs, ds : bool list) : + cs <> [] => size ds + size cs = r => + foldl chunk_aux (ys, ds) cs = (rcons ys (bits2w(ds ++ cs)), []). +proof. +move=> cs_nonnil siz. +cut cs_form : exists (es, fs : bool list), + size es = size cs - 1 /\ + size fs = 1 /\ + cs = es ++ fs. + exists (take (size cs - 1) cs), (drop (size cs - 1) cs). + smt. +elim cs_form => es fs [H1 [H2 H3]]. +cut fs_form : exists (f : bool), fs = [f]. + exists (nth false fs 0). + smt. +elim fs_form => f H4. +rewrite H3 H4. +rewrite foldl_cat. +rewrite foldl_chunk_aux_add_bits. +smt. +cut -> : + foldl chunk_aux (ys, ds ++ es) [f] = + chunk_aux (ys, ds ++ es) f. + trivial. +rewrite /chunk_aux. +smt. +qed. + +lemma flatten_chunk_aux (xs, ys : block list, cs : bool list) : + size cs < r => + foldl chunk_aux (ys, []) (flatten(xs, cs)) = (ys ++ xs, cs). +proof. +move: cs ys. +elim xs. +(* basis step *) +move=> cs ys siz_cs_lt_r. +have -> : flatten([], cs) = cs by smt. +rewrite foldl_chunk_aux_add_bits. +smt. +smt. +(* inductive step *) +move=> x xs IH cs ys siz_cs_lt_r. +have -> : flatten(x :: xs, cs) = w2bits x ++ flatten (xs, cs) by smt. +rewrite foldl_cat. +rewrite foldl_chunk_aux_new_block. +smt. +smt. +have -> : bits2w([] ++ w2bits x) = x by smt. +rewrite (IH cs (rcons ys x)). +assumption. +smt. +qed. + +lemma flatten_chunk (xs, ys : block list, cs : bool list) : + size cs < r => + chunk(flatten(xs, cs)) = (xs, cs). +proof. +move=> siz_cs_lt_r. +rewrite /chunk. +rewrite (flatten_chunk_aux xs [] cs). +assumption. +smt. +qed. + +pred valid_block (xs : block list) = + exists (ys : bool list, n : int), + 0 <= n < r /\ + flatten(map w2bits xs) = ys ++ [true] ++ nseq n false ++ [true]. op pad : bool list -> block list = fun bs => @@ -114,27 +260,10 @@ op unpad_aux : bool list -> bool list option = else Some(rev(drop (i + 1) zs)). op unpad : block list -> bool list option = - fun xs => - if xs = [] - then None - else let bs = w2bits(last b0 xs) in - let ys = take (size xs - 1) xs in - let ocs = unpad_aux bs in - if ocs = None - then if bs = nseq (r - 1) false ++ [true] && ys <> [] - then let ds = w2bits(last b0 ys) in - let ws = take (size ys - 1) ys in - if !(last false ds) - then None - else Some(flatten(map w2bits ws) ++ - take (size ds - 1) ds) - else None - else Some(flatten(map w2bits ys) ++ oget ocs). + fun xs => unpad_aux(flatten(map w2bits xs)). -pred valid_block (xs : block list) = - exists (ys : bool list, n : int), - 0 <= n < r /\ - flatten(map w2bits xs) = ys ++ [true] ++ nseq n false ++ [true]. +lemma pad_valid (bs : bool list) : valid_block(pad bs). +proof. lemma valid_block (xs : block list) : unpad xs <> None <=> valid_block xs. From 5f6253bdf564b3b7e2c3560d9b072c786a8390db Mon Sep 17 00:00:00 2001 From: Pierre-Yves Strub Date: Wed, 25 Nov 2015 21:46:40 +0100 Subject: [PATCH 054/525] Alternative padding def. Quoting a french dictator: Un bon croquis vaut mieux qu'un long discours. --- proof/Common.ec | 147 ++++++++++++++++++++++++++++++++++++++++++++- proof/ListExtra.ec | 34 +++++++++++ 2 files changed, 178 insertions(+), 3 deletions(-) create mode 100644 proof/ListExtra.ec diff --git a/proof/Common.ec b/proof/Common.ec index d371986..7547744 100644 --- a/proof/Common.ec +++ b/proof/Common.ec @@ -1,6 +1,8 @@ (* -------------------------------------------------------------------- *) -require import Option Fun Pair Int IntExtra Real List NewDistr. +require import Option Fun Pair Int IntExtra IntDiv Real List NewDistr. +require import Ring StdRing StdOrder StdBigop ListExtra. require (*--*) FinType LazyRP Monoid. +(*---*) import IntID IntOrder Bigint Bigint.BIA. (* -------------------------------------------------------------------- *) theory BitWord. @@ -38,12 +40,19 @@ op uniform : bword distr = end BitWord. (* -------------------------------------------------------------------- *) -op r : { int | 0 < r } as gt0_r. -op c : { int | 0 < c } as gt0_c. +op r : { int | 2 <= r } as ge2_r. +op c : { int | 0 < c } as gt0_c. type block. (* ~ bitstrings of size r *) type capacity. (* ~ bitstrings of size c *) +(* -------------------------------------------------------------------- *) +lemma gt0_r: 0 < r. +proof. by apply/(ltr_le_trans 2)/ge2_r. qed. + +lemma ge0_r: 0 <= r. +proof. by apply/ltrW/gt0_r. qed. + (* -------------------------------------------------------------------- *) clone BitWord as Capacity with type bword <- capacity, @@ -74,6 +83,136 @@ rename (* ------------------------- Padding/Unpadding ------------------------ *) +(* What about this (and the comment applies to other functions): *) + +theory Alternative. +op chunk (bs : bool list) = + mkseq (fun i => take r (drop (r * i) bs)) (size bs %/ r). + +op mkpad (n : int) = + true :: rcons (nseq ((-(n+2)) %% r) false) true. + +op pad (s : bool list) = + s ++ mkpad (size s). + +op unpad (s : bool list) = + if !last false s then None else + let i = index true (behead (rev s)) in + if i+1 = size s then None else Some (take (size s - (i+2)) s). + +lemma rev_mkpad n : rev (mkpad n) = mkpad n. +proof. by rewrite /mkpad rev_cons rev_rcons rev_nseq. qed. + +lemma last_mkpad b n : last b (mkpad n) = true. +proof. by rewrite !(lastcons, lastrcons). qed. + +lemma head_mkpad b n : head b (mkpad n) = true. +proof. by []. qed. + +lemma last_pad b s : last b (pad s) = true. +proof. by rewrite lastcat last_mkpad. qed. + +lemma size_mkpad n : size (mkpad n) = (-(n+2)) %% r + 2. +proof. +rewrite /mkpad /= size_rcons size_nseq max_ler. +by rewrite modz_ge0 gtr_eqF ?gt0_r. by ring. +qed. + +lemma size_pad s: size (pad s) = (size s + 1) %/ r * r + r. +proof. +rewrite /pad /mkpad size_cat /= size_rcons size_nseq. +rewrite max_ler 1:modz_ge0 1:gtr_eqF ?gt0_r // (addrCA 1). +rewrite modNz ?gt0_r ?ltr_spaddr ?size_ge0 //. +by rewrite (@subrE (size s + 2)) -(addrA _ 2) /= modzE; ring. +qed. + +lemma size_pad_dvd_r s: r %| size (pad s). +proof. by rewrite size_pad dvdzD 1:dvdz_mull dvdzz. qed. + +lemma index_true_behead_mkpad n : + index true (behead (mkpad n)) = (-(n + 2)) %% r. +proof. +rewrite /mkpad -cats1 index_cat mem_nseq size_nseq. +by rewrite max_ler // modz_ge0 gtr_eqF ?gt0_r. +qed. + +lemma size_chunk bs : size (chunk bs) = size bs %/ r. +proof. by rewrite size_mkseq max_ler // divz_ge0 ?gt0_r ?size_ge0. qed. + +lemma in_chunk_size bs b: mem (chunk bs) b => size b = r. +proof. +move/mapP=> [i] [] /mem_iota /= [ge0_i ^lt_is +] ->. +rewrite ltzE -(@ler_pmul2r r) 1:gt0_r divzE mulrDl mul1r. +rewrite -ler_subr_addr 2!subrE addrAC -2!subrE. +move/ler_trans/(_ (size bs - r) _); 1: rewrite subrE. + by rewrite ler_naddr // oppr_le0 modz_ge0 gtr_eqF ?gt0_r. +rewrite (mulrC i) ler_subr_addl -ler_subr_addr => ler. +rewrite size_take ?ge0_r size_drop // 1:mulr_ge0 ?ge0_r //. +rewrite max_ler 1:subr_ge0 1:-subr_ge0 1:(ler_trans r) ?ge0_r //. +by move/ler_eqVlt: ler=> [<-|->]. +qed. + +lemma size_flatten_chunk bs : + size (flatten (chunk bs)) = (size bs) %/ r * r. +proof. +rewrite size_flatten sumzE big_map predT_comp /(\o) /= big_seq. +rewrite (@eq_bigr _ _ (fun x => r)) /=; 1: exact/in_chunk_size. +by rewrite -big_seq big_constz count_predT size_chunk mulrC. +qed. + +lemma chunkK bs : r %| size bs => flatten (chunk bs) = bs. +proof. +move=> dvd_d_bs; apply/(eq_from_nth false)=> [|i]. + by rewrite size_flatten_chunk divzK. +rewrite size_flatten_chunk divzK // => [ge0_i lt_ibs]. +rewrite (@nth_flatten false r); 1: by apply/allP=> s /in_chunk_size. +rewrite nth_mkseq /= 1:divz_ge0 ?ge0_i ?ltz_divRL ?gt0_r //. + by apply/(@ler_lt_trans i)=> //; rewrite lez_floor gtr_eqF ?gt0_r. +rewrite nth_take ?ltz_pmod 1:ltrW ?gt0_r nth_drop; last 2 first. + by rewrite modz_ge0 ?gtr_eqF ?gt0_r. by rewrite (@mulrC r) -divz_eq. +by rewrite mulr_ge0 ?ge0_r divz_ge0 // gt0_r. +qed. + +lemma padK : pcancel pad unpad. +proof. +move=> s @/unpad; rewrite last_pad /= rev_cat rev_mkpad. +pose i := index _ _; have ^iE {1}->: i = (-(size s + 2)) %% r. + rewrite /i behead_cat //= index_cat {1}/mkpad /= mem_rcons /=. + by rewrite index_true_behead_mkpad. +pose b := _ = size _; case: b => @/b - {b}. + rewrite modNz ?gt0_r ?ltr_spaddr ?size_ge0 //. + rewrite (subrE (size s + 2)) -(addrA _ 2) size_pad. + rewrite (addrC _ r) 2!subrE -!addrA => /addrI; rewrite addrCA /=. + rewrite -subr_eq0 -opprB subrE opprK -divz_eq oppr_eq0. + by rewrite addz_neq0 ?size_ge0. +move=> _ /=; rewrite iE -size_mkpad /pad size_cat addrK_sub. +by rewrite take_cat /= take0 cats0. +qed. + +lemma unpadK : ocancel unpad pad. +proof. +move=> s @/unpad; case: (last false s) => //=. +elim/last_ind: s=> //= s b ih {ih}; rewrite lastrcons => hb. +rewrite rev_rcons /= size_rcons -(inj_eq _ (addIr (-1))) /= ?addrK. +pose i := index _ _; case: (i = size s) => //=. +move=> ne_is @/pad; pose j := _ - (i+2); apply/eq_sym. +rewrite -{1}(cat_take_drop j (rcons s b)) eqseq_cat //=. +rewrite size_take; first rewrite /j subr_ge0. + (have ->: 2=1+1 by done); rewrite addrA -ltzE ltr_add2r. + by rewrite ltr_neqAle ne_is /= /i -size_rev index_size. +rewrite {2}/j size_rcons ltr_subl_addr ?ltr_spaddr //=. + by rewrite /i index_ge0. +rewrite -cats1 drop_cat {1}/j ltr_subl_addr ler_lt_add //=. + by rewrite ltzE /= ler_addr // /i index_ge0. +rewrite /mkpad -cats1 -cat_cons hb; congr. +admit. (* missing results on drop/take *) +qed. + +lemma chunk_padK : pcancel (chunk \o pad) (unpad \o flatten). +proof. by move=> s @/(\o); rewrite chunkK 1:size_pad_dvd_r padK. qed. +end Alternative. + +(* -------------------------------------------------------------------- *) (* if size cs < r, then size (chunk_aux (xs, cs) b).`2 < r *) op chunk_aux : block list * bool list -> bool -> block list * bool list = fun p b => @@ -230,6 +369,8 @@ pred valid_block (xs : block list) = 0 <= n < r /\ flatten(map w2bits xs) = ys ++ [true] ++ nseq n false ++ [true]. + + op pad : bool list -> block list = fun bs => let (xs, cs) = chunk bs in diff --git a/proof/ListExtra.ec b/proof/ListExtra.ec new file mode 100644 index 0000000..e8608cc --- /dev/null +++ b/proof/ListExtra.ec @@ -0,0 +1,34 @@ +(* -------------------------------------------------------------------- *) +require import Option Fun Pair Int IntExtra IntDiv Real List NewDistr. +require import Ring StdRing StdOrder. +(*---*) import IntID IntOrder. + +(* -------------------------------------------------------------------- *) +lemma nth_flatten x0 n (bs : 'a list list) i : + all (fun s => size s = n) bs + => nth x0 (flatten bs) i = nth x0 (nth [] bs (i %/ n)) (i %% n). +proof. +case: (n <= 0) => [ge0_n|/ltrNge gt0_n] /allP /= eqz. + have bsE: bs = nseq (size bs) []. + elim: bs eqz => /= [|b bs ih eqz]; 1: by rewrite nseq0. + rewrite addrC nseqS ?size_ge0 -ih /=. + by move=> x bsx; apply/eqz; rewrite bsx. + by rewrite -size_eq0 -leqn0 ?size_ge0 eqz. + rewrite {2}bsE nth_nseq_if if_same /=. + rewrite bsE; elim/natind: (size bs)=> [m le0_m|m ge0_m ih]; + by rewrite ?nseqS // nseq0_le // flatten_nil. +case: (i < 0)=> [lt0_i|/lerNgt ge0_i]. + rewrite nth_neg // (@nth_neg []) // ltrNge. + by rewrite divz_ge0 // -ltrNge. +elim: bs i ge0_i eqz => [|b bs ih] i ge0_i eqz /=. + by rewrite flatten_nil. +have /(_ b) /= := eqz; rewrite flatten_cons nth_cat => ->. +have <-: (i < n) <=> (i %/ n = 0) by rewrite -divz_eq0 // ge0_i. +case: (i < n) => [lt_in|/lerNgt le_ni]; 2: rewrite ih ?subr_ge0 //. ++ by rewrite modz_small // ge0_i ltr_normr ?lt_in. ++ by move=> x bx; have := eqz x; apply; rewrite /= bx. +rewrite subrE -mulN1r modzMDr subrE; congr. +case: (n = 0)=> [^zn ->/=|nz_n]; 2: by rewrite divzMDr 1?addrC. +rewrite divz0 /= eq_sym nth_neg ?oppr_lt0 // => {ih}; move: eqz. +by case: bs => // c bs /(_ c) /=; rewrite zn size_eq0 => ->. +qed. From c102a54471d9afdb9708cfc65db398a01e63c920 Mon Sep 17 00:00:00 2001 From: Pierre-Yves Strub Date: Mon, 30 Nov 2015 09:24:49 +0100 Subject: [PATCH 055/525] Use stdlib. bit chunking ops. --- proof/Common.ec | 39 +++++---------------------------------- proof/ListExtra.ec | 34 ---------------------------------- 2 files changed, 5 insertions(+), 68 deletions(-) delete mode 100644 proof/ListExtra.ec diff --git a/proof/Common.ec b/proof/Common.ec index 7547744..acc5412 100644 --- a/proof/Common.ec +++ b/proof/Common.ec @@ -1,6 +1,6 @@ (* -------------------------------------------------------------------- *) require import Option Fun Pair Int IntExtra IntDiv Real List NewDistr. -require import Ring StdRing StdOrder StdBigop ListExtra. +require import Ring StdRing StdOrder StdBigop BitEncoding. require (*--*) FinType LazyRP Monoid. (*---*) import IntID IntOrder Bigint Bigint.BIA. @@ -86,8 +86,7 @@ rename (* What about this (and the comment applies to other functions): *) theory Alternative. -op chunk (bs : bool list) = - mkseq (fun i => take r (drop (r * i) bs)) (size bs %/ r). +op chunk (bs : bool list) = BitChunking.chunk r bs. op mkpad (n : int) = true :: rcons (nseq ((-(n+2)) %% r) false) true. @@ -137,41 +136,13 @@ by rewrite max_ler // modz_ge0 gtr_eqF ?gt0_r. qed. lemma size_chunk bs : size (chunk bs) = size bs %/ r. -proof. by rewrite size_mkseq max_ler // divz_ge0 ?gt0_r ?size_ge0. qed. +proof. by apply/BitChunking.size_chunk/gt0_r. qed. lemma in_chunk_size bs b: mem (chunk bs) b => size b = r. -proof. -move/mapP=> [i] [] /mem_iota /= [ge0_i ^lt_is +] ->. -rewrite ltzE -(@ler_pmul2r r) 1:gt0_r divzE mulrDl mul1r. -rewrite -ler_subr_addr 2!subrE addrAC -2!subrE. -move/ler_trans/(_ (size bs - r) _); 1: rewrite subrE. - by rewrite ler_naddr // oppr_le0 modz_ge0 gtr_eqF ?gt0_r. -rewrite (mulrC i) ler_subr_addl -ler_subr_addr => ler. -rewrite size_take ?ge0_r size_drop // 1:mulr_ge0 ?ge0_r //. -rewrite max_ler 1:subr_ge0 1:-subr_ge0 1:(ler_trans r) ?ge0_r //. -by move/ler_eqVlt: ler=> [<-|->]. -qed. - -lemma size_flatten_chunk bs : - size (flatten (chunk bs)) = (size bs) %/ r * r. -proof. -rewrite size_flatten sumzE big_map predT_comp /(\o) /= big_seq. -rewrite (@eq_bigr _ _ (fun x => r)) /=; 1: exact/in_chunk_size. -by rewrite -big_seq big_constz count_predT size_chunk mulrC. -qed. +proof. by apply/BitChunking.in_chunk_size/gt0_r. qed. lemma chunkK bs : r %| size bs => flatten (chunk bs) = bs. -proof. -move=> dvd_d_bs; apply/(eq_from_nth false)=> [|i]. - by rewrite size_flatten_chunk divzK. -rewrite size_flatten_chunk divzK // => [ge0_i lt_ibs]. -rewrite (@nth_flatten false r); 1: by apply/allP=> s /in_chunk_size. -rewrite nth_mkseq /= 1:divz_ge0 ?ge0_i ?ltz_divRL ?gt0_r //. - by apply/(@ler_lt_trans i)=> //; rewrite lez_floor gtr_eqF ?gt0_r. -rewrite nth_take ?ltz_pmod 1:ltrW ?gt0_r nth_drop; last 2 first. - by rewrite modz_ge0 ?gtr_eqF ?gt0_r. by rewrite (@mulrC r) -divz_eq. -by rewrite mulr_ge0 ?ge0_r divz_ge0 // gt0_r. -qed. +proof. by apply/BitChunking.chunkK/gt0_r. qed. lemma padK : pcancel pad unpad. proof. diff --git a/proof/ListExtra.ec b/proof/ListExtra.ec deleted file mode 100644 index e8608cc..0000000 --- a/proof/ListExtra.ec +++ /dev/null @@ -1,34 +0,0 @@ -(* -------------------------------------------------------------------- *) -require import Option Fun Pair Int IntExtra IntDiv Real List NewDistr. -require import Ring StdRing StdOrder. -(*---*) import IntID IntOrder. - -(* -------------------------------------------------------------------- *) -lemma nth_flatten x0 n (bs : 'a list list) i : - all (fun s => size s = n) bs - => nth x0 (flatten bs) i = nth x0 (nth [] bs (i %/ n)) (i %% n). -proof. -case: (n <= 0) => [ge0_n|/ltrNge gt0_n] /allP /= eqz. - have bsE: bs = nseq (size bs) []. - elim: bs eqz => /= [|b bs ih eqz]; 1: by rewrite nseq0. - rewrite addrC nseqS ?size_ge0 -ih /=. - by move=> x bsx; apply/eqz; rewrite bsx. - by rewrite -size_eq0 -leqn0 ?size_ge0 eqz. - rewrite {2}bsE nth_nseq_if if_same /=. - rewrite bsE; elim/natind: (size bs)=> [m le0_m|m ge0_m ih]; - by rewrite ?nseqS // nseq0_le // flatten_nil. -case: (i < 0)=> [lt0_i|/lerNgt ge0_i]. - rewrite nth_neg // (@nth_neg []) // ltrNge. - by rewrite divz_ge0 // -ltrNge. -elim: bs i ge0_i eqz => [|b bs ih] i ge0_i eqz /=. - by rewrite flatten_nil. -have /(_ b) /= := eqz; rewrite flatten_cons nth_cat => ->. -have <-: (i < n) <=> (i %/ n = 0) by rewrite -divz_eq0 // ge0_i. -case: (i < n) => [lt_in|/lerNgt le_ni]; 2: rewrite ih ?subr_ge0 //. -+ by rewrite modz_small // ge0_i ltr_normr ?lt_in. -+ by move=> x bx; have := eqz x; apply; rewrite /= bx. -rewrite subrE -mulN1r modzMDr subrE; congr. -case: (n = 0)=> [^zn ->/=|nz_n]; 2: by rewrite divzMDr 1?addrC. -rewrite divz0 /= eq_sym nth_neg ?oppr_lt0 // => {ih}; move: eqz. -by case: bs => // c bs /(_ c) /=; rewrite zn size_eq0 => ->. -qed. From a3ca58303c3f21f9b7d6b4c1b574e25841d4b9ae Mon Sep 17 00:00:00 2001 From: Pierre-Yves Strub Date: Mon, 30 Nov 2015 09:43:54 +0100 Subject: [PATCH 056/525] Use stdlib bitwords theory. --- proof/Common.ec | 62 ++++++++++--------------------------------------- 1 file changed, 12 insertions(+), 50 deletions(-) diff --git a/proof/Common.ec b/proof/Common.ec index acc5412..02e88e0 100644 --- a/proof/Common.ec +++ b/proof/Common.ec @@ -1,44 +1,9 @@ (* -------------------------------------------------------------------- *) require import Option Fun Pair Int IntExtra IntDiv Real List NewDistr. require import Ring StdRing StdOrder StdBigop BitEncoding. -require (*--*) FinType LazyRP Monoid. +require (*--*) FinType BitWord LazyRP Monoid. (*---*) import IntID IntOrder Bigint Bigint.BIA. -(* -------------------------------------------------------------------- *) -theory BitWord. -type bword. - -op zero : bword. -op (^) : bword -> bword -> bword. - -clone include Monoid - with - type t <- bword, - op idm <- zero, - op (+) <- (^) - proof Axioms.* by admit. - -clone FinType with type t <- bword - proof * by admit. - -op w2bits : bword -> bool list. -op bits2w : bool list -> bword. -op size : { int | 0 < size } as gt0_size. - -lemma w2bitsK : cancel w2bits bits2w. -proof. admit. qed. - -lemma bits2wK (s : bool list) : - size s = size => w2bits (bits2w s) = s. -proof. admit. qed. - -lemma w2bits_size (x : bword) : size(w2bits x) = size. -proof. admit. qed. - -op uniform : bword distr = - MUniform.duniform FinType.enum. -end BitWord. - (* -------------------------------------------------------------------- *) op r : { int | 2 <= r } as ge2_r. op c : { int | 0 < c } as gt0_c. @@ -55,28 +20,25 @@ proof. by apply/ltrW/gt0_r. qed. (* -------------------------------------------------------------------- *) clone BitWord as Capacity with - type bword <- capacity, - op size <- c - proof * by apply/gt0_c + type word <- capacity, + op n <- c + proof gt0_n by apply/gt0_c - rename - [op] "zero" as "c0" - [op] "uniform" as "cdistr". + rename "dword" as "cdistr". clone export BitWord as Block with - type bword <- block, - op size <- r - proof * by apply/gt0_r + type word <- block, + op n <- r + proof gt0_n by apply/gt0_r - rename - [op] "zero" as "b0" - [op] "uniform" as "bdistr". + rename "dword" as "bdistr". -op ( * ): 'a NewDistr.distr -> 'b NewDistr.distr -> ('a * 'b) Pervasive.distr. +(* -------------------------------------------------------------------- *) +op ( * ): 'a distr -> 'b distr -> ('a * 'b) distr. clone export LazyRP as Perm with type D <- block * capacity, - op d <- bdistr * Capacity.cdistr + op d <- bdistr * Capacity.cdistr rename [module type] "RP" as "PRIMITIVE" [module] "P" as "Perm". From 8f8efe23825872ced6672fe030756e32dd113e47 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Mon, 30 Nov 2015 14:50:17 +0100 Subject: [PATCH 057/525] Use new libraries on all files. Perform some renaming... --- proof/Absorb.ec | 12 +- proof/AbsorbToBlocks.ec | 3 +- proof/Blocks.ec | 11 +- proof/Common.ec | 2 + ...entiability.ec => Indifferentiability.eca} | 15 +- proof/TopLevel.ec | 11 +- proof/old/IndifPadding.ec | 64 +++-- proof/old/LazyRO.eca | 16 +- proof/old/NBRO.eca | 102 +++---- proof/old/Sponge.ec | 258 ------------------ proof/old/Squeezeless.ec | 236 +++++----------- proof/old/Utils.ec | 18 +- 12 files changed, 200 insertions(+), 548 deletions(-) rename proof/{Indifferentiability.ec => Indifferentiability.eca} (80%) delete mode 100644 proof/old/Sponge.ec diff --git a/proof/Absorb.ec b/proof/Absorb.ec index 633c864..e8984d7 100644 --- a/proof/Absorb.ec +++ b/proof/Absorb.ec @@ -19,14 +19,16 @@ clone import RndOrcl as RO with clone import Ideal. (* ?? Nested abstract theories... we don't like them *) (* -------------------------------------------------------------------- *) -clone include Indifferentiability.Core with - type Types.p <- block * capacity, - type Types.f_in <- block list, - type Types.f_out <- block +clone include Indifferentiability with + type p <- block * capacity, + type f_in <- block list, + type f_out <- block rename [module] "Indif" as "Experiment" - [module] "al" as "alIndif". + [module] "GReal" as "RealIndif" + [module] "GIdeal" as "IdealIndif". + (* -------------------------------------------------------------------- *) module BlockSponge (P : PRIMITIVE) : RO, CONSTRUCTION(P) = { diff --git a/proof/AbsorbToBlocks.ec b/proof/AbsorbToBlocks.ec index c349cf3..a5c48bf 100644 --- a/proof/AbsorbToBlocks.ec +++ b/proof/AbsorbToBlocks.ec @@ -232,8 +232,7 @@ section. by proc; sp; if=> //=; call ModularAbsorb; auto. (* Re-Bug *) by conseq ModularAbsorb=> &1 &2; case (arg{1}); case (arg{2}). - inline *; wp; call (_: true)=> //=. - by sim. + inline *; wp;call (_: true)=> //=. auto; progress [-split]; split=> //=. smt. done. diff --git a/proof/Blocks.ec b/proof/Blocks.ec index ff3c8cd..eb1513f 100644 --- a/proof/Blocks.ec +++ b/proof/Blocks.ec @@ -16,14 +16,15 @@ clone import IRO as BIRO with op valid <- valid. (* -------------------------------------------------------------------- *) -clone include Indifferentiability.Core with - type Types.p <- block * capacity, - type Types.f_in <- block list * int, - type Types.f_out <- block list +clone include Indifferentiability with + type p <- block * capacity, + type f_in <- block list * int, + type f_out <- block list rename [module] "Indif" as "Experiment" - [module] "al" as "alIndif". + [module] "GReal" as "RealIndif" + [module] "GIdeal" as "IdealIndif". (* -------------------------------------------------------------------- *) module BlockSponge (P : PRIMITIVE) : BIRO.IRO, CONSTRUCTION(P) = { diff --git a/proof/Common.ec b/proof/Common.ec index 02e88e0..2c0493d 100644 --- a/proof/Common.ec +++ b/proof/Common.ec @@ -338,6 +338,8 @@ op unpad : block list -> bool list option = lemma pad_valid (bs : bool list) : valid_block(pad bs). proof. +admit. +qed. lemma valid_block (xs : block list) : unpad xs <> None <=> valid_block xs. diff --git a/proof/Indifferentiability.ec b/proof/Indifferentiability.eca similarity index 80% rename from proof/Indifferentiability.ec rename to proof/Indifferentiability.eca index 9a11bd5..623ca31 100644 --- a/proof/Indifferentiability.ec +++ b/proof/Indifferentiability.eca @@ -1,15 +1,8 @@ -(* -------------------------------------------------------------------- *) -abstract theory Types. (** A primitive: the building block we assume ideal **) type p. (** A functionality: the target construction **) type f_in, f_out. -end Types. - -(* -------------------------------------------------------------------- *) -abstract theory Core. -clone import Types. module type PRIMITIVE = { proc init(): unit @@ -34,7 +27,7 @@ module type CONSTRUCTION (P : PRIMITIVE) = { }. module type SIMULATOR (F : FUNCTIONALITY) = { - proc init() : unit { F.init } + proc init() : unit { (* F.init *) } proc f(x : p) : p { F.f } proc fi(x : p) : p { F.f } }. @@ -54,8 +47,9 @@ module Indif (F : FUNCTIONALITY, P : PRIMITIVE, D : DISTINGUISHER) = { } }. -module Real(C : CONSTRUCTION, P : PRIMITIVE) = Indif(C(P),P). -module Ideal(F : FUNCTIONALITY, S : SIMULATOR) = Indif(F,S(F)). +(* Using the name Real can be a bad idea, since it can clash with the theory Real *) +module GReal(C : CONSTRUCTION, P : PRIMITIVE) = Indif(C(P),P). +module GIdeal(F : FUNCTIONALITY, S : SIMULATOR) = Indif(F,S(F)). (* (C <: CONSTRUCTION) applied to (P <: PRIMITIVE) is indifferentiable from (F <: FUNCTIONALITY) if there exists (S <: SIMULATOR) such @@ -63,4 +57,3 @@ module Ideal(F : FUNCTIONALITY, S : SIMULATOR) = Indif(F,S(F)). | Pr[Real(P,C,D): res] - Pr[Ideal(F,S,D): res] | is small. We avoid the existential by providing a concrete construction for S and the `small` by providing a concrete bound. *) -end Core. \ No newline at end of file diff --git a/proof/TopLevel.ec b/proof/TopLevel.ec index fdf783d..ed1f87e 100644 --- a/proof/TopLevel.ec +++ b/proof/TopLevel.ec @@ -12,14 +12,15 @@ clone import IRO as BIRO with op valid (x : bool list) <- true. (* -------------------------------------------------------------------- *) -clone include Indifferentiability.Core with - type Types.p <- block * capacity, - type Types.f_in <- bool list * int, - type Types.f_out <- bool list +clone include Indifferentiability with + type p <- block * capacity, + type f_in <- bool list * int, + type f_out <- bool list rename [module] "Indif" as "Experiment" - [module] "al" as "alIndif". + [module] "GReal" as "RealIndif" + [module] "GIdeal" as "IdealIndif". (* -------------------------------------------------------------------- *) diff --git a/proof/old/IndifPadding.ec b/proof/old/IndifPadding.ec index 3a47891..cf80091 100644 --- a/proof/old/IndifPadding.ec +++ b/proof/old/IndifPadding.ec @@ -4,8 +4,7 @@ require (*..*) Indifferentiability LazyRO. clone import Indifferentiability as Ind1. clone import Indifferentiability as Ind2 - with type p_in <- Ind1.p_in, - type p_out <- Ind1.p_out, + with type p <- Ind1.p, type f_out <- Ind1.f_out. op pad : Ind2.f_in -> Ind1.f_in. @@ -22,25 +21,25 @@ clone import LazyRO as RO2 type to <- Ind1.f_out, op d <- RO1.d. -module ConstrPad (FC:Ind1.Construction, P:Ind1.Primitive) = { +module ConstrPad (FC:Ind1.CONSTRUCTION, P:Ind1.PRIMITIVE) = { module C = FC(P) proc init = C.init - proc oracle (x:Ind2.f_in) : f_out = { + proc f (x:Ind2.f_in) : f_out = { var r; - r = C.oracle(pad x); + r = C.f(pad x); return r; } }. -module DistPad(FD: Ind2.Distinguisher, F:Ind1.Functionality, P:Ind1.Primitive) = { +module DistPad(FD: Ind2.DISTINGUISHER, F:Ind1.FUNCTIONALITY, P:Ind1.PRIMITIVE) = { module Fpad = { proc init = F.init - proc oracle(x:Ind2.f_in) : f_out = { + proc f(x:Ind2.f_in) : f_out = { var r; - r = F.oracle(pad x); + r = F.f(pad x); return r; } } @@ -48,12 +47,12 @@ module DistPad(FD: Ind2.Distinguisher, F:Ind1.Functionality, P:Ind1.Primitive) = proc distinguish = FD(Fpad,P).distinguish }. -module SimPadinv(S:Ind1.Simulator, F2:Ind2.Functionality) = { +module SimPadinv(S:Ind1.SIMULATOR, F2:Ind2.FUNCTIONALITY) = { module F1 = { proc init = F2.init - proc oracle(x:Ind1.f_in):Ind1.f_out = { + proc f(x:Ind1.f_in):Ind1.f_out = { var r; - r = F2.oracle(padinv x); + r = F2.f(padinv x); return r; } } @@ -62,35 +61,42 @@ module SimPadinv(S:Ind1.Simulator, F2:Ind2.Functionality) = { proc init = S2.init - proc oracle = S2.oracle + proc f = S2.f + proc fi = S2.fi }. section Reduction. - declare module P : Ind1.Primitive. (* It is compatible with Ind2.Primitive *) - declare module C : Ind1.Construction {P}. - declare module S : Ind1.Simulator{ RO1.H, RO2.H}. + declare module P : Ind1.PRIMITIVE. (* It is compatible with Ind2.Primitive *) + declare module C : Ind1.CONSTRUCTION {P}. + declare module S : Ind1.SIMULATOR{ RO1.H, RO2.H}. - declare module D' : Ind2.Distinguisher{P,C, RO1.H, RO2.H, S}. + declare module D' : Ind2.DISTINGUISHER{P,C, RO1.H, RO2.H, S}. local equiv ConstrDistPad: - Ind2.Real(P, ConstrPad(C), D').main ~ - Ind1.Real(P, C, DistPad(D')).main : ={glob P, glob C, glob D'} ==> + Ind2.GReal(ConstrPad(C), P, D').main ~ + Ind1.GReal(C, P, DistPad(D')).main : ={glob P, glob C, glob D'} ==> ={glob P, glob C, glob D', res}. proof. by sim. qed. local lemma PrConstrDistPad &m: - Pr[ Ind2.Real(P,ConstrPad(C), D').main() @ &m : res] = - Pr[ Ind1.Real(P,C,DistPad(D')).main() @ &m : res]. + Pr[ Ind2.GReal(ConstrPad(C), P, D').main() @ &m : res] = + Pr[ Ind1.GReal(C, P, DistPad(D')).main() @ &m : res]. proof. by byequiv ConstrDistPad. qed. local equiv DistH2H1: - Ind2.Ideal(RO2.H, SimPadinv(S), D').main ~ - Ind1.Ideal(RO1.H, S, DistPad(D')).main : + Ind2.GIdeal(RO2.H, SimPadinv(S), D').main ~ + Ind1.GIdeal(RO1.H, S, DistPad(D')).main : ={glob D', glob S} ==> ={glob D',glob S, res} /\ forall x, RO2.H.m{1}.[padinv x] = RO1.H.m{2}.[x]. proof. proc. call (_: ={glob S} /\ forall x, RO2.H.m{1}.[padinv x] = RO1.H.m{2}.[x]). + + proc *;inline *. + call (_: forall x, RO2.H.m{1}.[padinv x] = RO1.H.m{2}.[x]);auto. + proc;inline *;wp;sp;if;first by progress [-split];rewrite !in_dom H. + + auto;progress;first by rewrite !getP_eq. + by rewrite !getP (can_eq _ _ cancel_padinv) H. + by auto;progress;rewrite H. + proc *;inline *. call (_: forall x, RO2.H.m{1}.[padinv x] = RO1.H.m{2}.[x]);auto. proc;inline *;wp;sp;if;first by progress [-split];rewrite !in_dom H. @@ -101,20 +107,20 @@ section Reduction. + auto;progress;first by rewrite !getP_eq. by rewrite !getP (eq_sym x1) (can2_eq _ _ cancel_pad cancel_padinv) (eq_sym x{2}) H. by auto;progress;rewrite -H cancel_pad. - inline *;wp. call (_: ={glob D'});first by sim. + inline *;wp. call (_: ={glob D'}). auto;progress;by rewrite !map0P. qed. local lemma PrDistH2H1 &m: - Pr[Ind2.Ideal(RO2.H,SimPadinv(S),D').main() @ &m : res] = - Pr[Ind1.Ideal(RO1.H,S, DistPad(D')).main() @ &m : res]. + Pr[Ind2.GIdeal(RO2.H,SimPadinv(S),D').main() @ &m : res] = + Pr[Ind1.GIdeal(RO1.H,S, DistPad(D')).main() @ &m : res]. proof. by byequiv DistH2H1. qed. lemma Conclusion &m: - `| Pr[Ind2.Real (P , ConstrPad(C), D').main() @ &m : res] - - Pr[Ind2.Ideal(RO2.H, SimPadinv(S), D').main() @ &m : res] | = - `| Pr[Ind1.Real(P , C, DistPad(D')).main() @ &m : res] - - Pr[Ind1.Ideal(RO1.H, S, DistPad(D')).main() @ &m : res] |. + `| Pr[Ind2.GReal (ConstrPad(C), P , D' ).main() @ &m : res] - + Pr[Ind2.GIdeal(RO2.H , SimPadinv(S), D' ).main() @ &m : res] | = + `| Pr[Ind1.GReal (C , P , DistPad(D')).main() @ &m : res] - + Pr[Ind1.GIdeal(RO1.H , S , DistPad(D')).main() @ &m : res] |. proof. by rewrite (PrConstrDistPad &m) (PrDistH2H1 &m). qed. end section Reduction. diff --git a/proof/old/LazyRO.eca b/proof/old/LazyRO.eca index d9784b4..96136e7 100644 --- a/proof/old/LazyRO.eca +++ b/proof/old/LazyRO.eca @@ -1,19 +1,21 @@ -require import Option NewFSet NewFMap. -require (*..*) RO. +require import Option FSet NewFMap. +require (*..*) NewROM. type from, to. op d: to distr. -clone include RO with - type from <- from, - type to <- to. +clone include NewROM with + type from <- from, + type to <- to, + op dsample <- fun (x:from) => d. -module H : RO, RO_ = { + +module H = { var m : (from, to) fmap proc init() = { m = map0; } - proc oracle(x) = { + proc f(x) = { if (!mem (dom m) x) m.[x] = $d; return oget m.[x]; } diff --git a/proof/old/NBRO.eca b/proof/old/NBRO.eca index 195905f..e744ecb 100644 --- a/proof/old/NBRO.eca +++ b/proof/old/NBRO.eca @@ -1,8 +1,7 @@ -require import Int Real NewList NewFMap. +require import Option Int Real List FSet NewFMap. require RndOrcl Indifferentiability. -type p_in. -type p_out. +type p. type from. @@ -30,63 +29,62 @@ axiom test_neg (x:from) (n:int): n < 0 => !test (x,n). axiom test_le (x:from) (n p:int) : 0 <= p <= n => test (x,n) => test (x,p). clone import Indifferentiability as IndB with - type p_in <- p_in, - type p_out <- p_out, + type p <- p, type f_in <- from * int, type f_out <- block. clone import Indifferentiability as IndNB with - type p_in <- p_in, - type p_out <- p_out, + type p <- p, type f_in <- from * int, type f_out <- block list. -module RONB (Ob:IndB.Functionality) = { +module RONB (Ob:IndB.FUNCTIONALITY) = { proc init = Ob.init - proc oracle(x:from, n:int) : block list = { + proc f(x:from, n:int) : block list = { var b, bs; bs <- []; while (size bs < n) { - b <@ Ob.oracle(x,size bs); + b <@ Ob.f(x,size bs); bs <- rcons bs b; } return bs; } }. -module DNB(D:IndNB.Distinguisher, F:IndB.Functionality, P:IndB.Primitive) = { +module DNB(D:IndNB.DISTINGUISHER, F:IndB.FUNCTIONALITY, P:IndB.PRIMITIVE) = { proc distinguish = D(RONB(F), P).distinguish }. -module CNB (C: IndB.Construction, P:IndB.Primitive) = RONB(C(P)). +module CNB (C: IndB.CONSTRUCTION, P:IndB.PRIMITIVE) = RONB(C(P)). -module FNB_B(F:IndNB.Functionality) = { +module FNB_B(F:IndNB.FUNCTIONALITY) = { proc init () = {} - proc oracle(x:from,n:int) : block = { + proc f(x:from,n:int) : block = { var bs; - bs <@ F.oracle(x,n+1); + bs <@ F.f(x,n+1); return nth dfl bs n; } }. -module SNB(S:IndB.Simulator, F:IndNB.Functionality) = { +module SNB(S:IndB.SIMULATOR, F:IndNB.FUNCTIONALITY) = { proc init = S(FNB_B(F)).init - proc oracle = S(FNB_B(F)).oracle + proc f = S(FNB_B(F)).f + proc fi = S(FNB_B(F)).fi }. section PROOF. - declare module P:IndB.Primitive. - declare module C:IndB.Construction {P}. - declare module S:IndB.Simulator {RO}. + declare module P:IndB.PRIMITIVE. + declare module C:IndB.CONSTRUCTION {P}. + declare module S:IndB.SIMULATOR {RO}. - declare module D: IndNB.Distinguisher {P, RO, S, C}. + declare module D: IndNB.DISTINGUISHER {P, RO, S, C}. - local equiv equivReal: IndNB.Real(P, CNB(C), D).main ~ IndB.Real(P, C, DNB(D)).main: + local equiv equivReal: IndNB.GReal(CNB(C), P, D).main ~ IndB.GReal(C, P, DNB(D)).main: ={glob P, glob C, glob D} ==> ={glob P, glob C, glob D,res}. proof. proc;inline *; sim. qed. @@ -100,52 +98,56 @@ section PROOF. } }. - local module DNB'(O:ROB.RO) = { + local module DNB'(O:ROB.RO) : ROB.Distinguisher(O)= { proc distinguish () : bool = { var b; - S(O).init(); + S(O).init(); b <@ DNB(D, O, S(O)).distinguish(); return b; } }. + local equiv feq : + FNB_B(RONB(ERO)).f ~ ERO.f : (x, n){1} = x{2} /\ ={RO.m} ==> ={res, RO.m}. + proof. + proc;inline *;wp. + while{1} ((0 <= n0 => size bs0 <= n0){1} /\ forall i, 0 <= i < size bs0{1} => + nth dfl bs0{1} i = + if test (x0{1},i) + then oget RO.m{1}.[(x0{1},i)] + else dfl) ((n0 - size bs0){1}). + + move=> &m2 z;auto;progress [-split]. + rewrite size_rcons;split;2:smt ml=0;split;1:smt ml=0. + move=> i [Hi0 Hi1];rewrite nth_rcons. + case (i < size bs0{hr})=> Hi';first by apply H0. + by cut -> : i = size bs0{hr} by smt ml=0. + auto;progress;1,2: smt ml=0. + case (n{1} < 0)=> Hn. + + by rewrite nth_neg // test_neg. + apply H1=> {H1} //;smt ml=0. + qed. + lemma conclusion &m: - `|Pr[IndNB.Real(P, CNB(C), D).main()@ &m:res] - Pr[IndNB.Ideal(RONB(Restr(RO)), SNB(S), D).main()@ &m:res] | = - `|Pr[IndB.Real(P, C, DNB(D)).main()@ &m:res] - Pr[IndB.Ideal(Restr(RO),S,DNB(D)).main()@ &m:res] |. + `|Pr[IndNB.GReal(CNB(C), P, D).main()@ &m:res] - Pr[IndNB.GIdeal(RONB(Restr(RO)), SNB(S), D).main()@ &m:res] | = + `|Pr[IndB.GReal(C, P, DNB(D)).main()@ &m:res] - Pr[IndB.GIdeal(Restr(RO),S,DNB(D)).main()@ &m:res] |. proof. - cut -> : Pr[IndNB.Real(P, CNB(C), D).main()@ &m:res] = Pr[IndB.Real(P, C, DNB(D)).main()@ &m:res]. + cut -> : Pr[IndNB.GReal(CNB(C), P, D).main()@ &m:res] = Pr[IndB.GReal(C, P, DNB(D)).main()@ &m:res]. + byequiv equivReal=> //. - cut -> : Pr[Ideal(RONB(Restr(RO)), SNB(S), D).main() @ &m : res] = + cut -> : Pr[GIdeal(RONB(Restr(RO)), SNB(S), D).main() @ &m : res] = Pr[ROB.IND(Restr(RO), DRO).main() @ &m : res]. - + byequiv=> //; proc;inline *;swap{1} 1 1;sim. + + by byequiv=> //; proc;inline *;swap{1} 1 1;sim. cut -> : Pr[ROB.IND(Restr(RO), DRO).main() @ &m : res] = Pr[ROB.IND(ERO,DRO).main () @ &m : res]. - + byequiv (Eager DRO)=> //. + + by byequiv (Eager DRO)=> //. do 2! congr. - cut -> : Pr[IndB.Ideal(Restr(RO), S, DNB(D)).main() @ &m : res] = + cut -> : Pr[IndB.GIdeal(Restr(RO), S, DNB(D)).main() @ &m : res] = Pr[ROB.IND(Restr(RO), DNB').main() @ &m : res]. - + byequiv=> //; proc;inline *;swap{1} 1 1;sim. + + by byequiv=> //; proc;inline *;swap{1} 1 1;sim. cut -> : Pr[ROB.IND(Restr(RO), DNB').main() @ &m : res] = Pr[ROB.IND(ERO, DNB').main() @ &m : res]. - + byequiv (Eager DNB')=> //. + + by byequiv (Eager DNB')=> //. byequiv=> //;proc;inline DRO(ERO).distinguish DNB'(ERO).distinguish;wp. - call (_: ={RO.m, glob S}). - + proc (={RO.m}) => //. - proc;inline *;wp. - while{1} ((0 <= n0 => size bs0 <= n0){1} /\ forall i, 0 <= i < size bs0{1} => - nth dfl bs0{1} i = - if test (x0{1},i) - then oget RO.m{1}.[(x0{1},i)] - else dfl) ((n0 - size bs0){1}). - + move=> &m2 z;auto;progress [-split]. - rewrite size_rcons;split;2:smt ml=0;split;1:smt ml=0. - move=> i [Hi0 Hi1];rewrite nth_rcons. - case (i < size bs0{hr})=> Hi';first by apply H0. - by cut -> : i = size bs0{hr} by smt ml=0. - auto;progress;1,2: smt ml=0. - case (n{1} < 0)=> Hn. - + by rewrite nth_neg // test_neg. - apply H1=> {H1} //;smt ml=0. + call (_: ={RO.m, glob S});1,2:by proc (={RO.m}) => //;apply feq. + sim. by conseq (_: _ ==> ={glob S, glob D, RO.m})=> //;sim. qed. diff --git a/proof/old/Sponge.ec b/proof/old/Sponge.ec deleted file mode 100644 index 9648347..0000000 --- a/proof/old/Sponge.ec +++ /dev/null @@ -1,258 +0,0 @@ -require import Option Pair Int Real List FSet NewFMap. -require (*..*) AWord LazyRP IRO Indifferentiability Squeezeless. -(* TODO: Clean up the Bitstring and Word theories - -- Make use of those new versions. *) -(*...*) import Dprod. -(* TODO: Datatype definitions and distributions should - be properly separated and reorganized. *) - -op r : { int | 0 < r } as lt0_r. -op c : { int | 0 < c } as lt0_c. - -(** Clarify assumptions on the distributions as we go. As this is currently - written, we are hiding some pretty heavy axioms behind cloning. **) -type block. -op dblock: block distr. - -clone import AWord as Block with - op length <- r, - type word <- block, - op Dword.dword <- dblock -proof leq0_length by smt. - -type capacity. -op dcapacity: capacity distr. - -clone AWord as Capacity with - op length <- c, - type word <- capacity, - op Dword.dword <- dcapacity -proof leq0_length by smt. - -type state = block * capacity. - -(** The following is just lining up type definitions and defines the - Indifferentiability experiment. Importantly, it defines neither - ideal primitive nor ideal functionality: only their type. **) -type p_query = [ - | F of state - | Fi of state -]. - -op is_F (q : p_query) = - with q = F s => true - with q = Fi s => false. - -op is_Fi (q : p_query) = - with q = F s => false - with q = Fi s => true. - -op get_query (q : p_query) = - with q = F s => s - with q = Fi s => s. - -clone include Indifferentiability with - type p_in <- p_query, - type p_out <- state, - type f_in <- block list * int, - type f_out <- bool list. - -(** Ideal Functionality **) -clone import IRO as Functionality with - type from <- block list. - -(** Ideal Primitive for the Random Transformation case **) -clone import LazyRP as Primitive with - type D <- state, - op d <- dblock * dcapacity. - -(*** TODO: deal with these. - - bitstrings should have conversions to and from bool list - - the generic RO should be defined somewhere else - - lining up names and types should be easier than it is... ***) -op to_bits: block -> bool list. - -module RP_to_P (O : RP) = { - proc init = O.init - proc oracle(q : p_query) = { - var r; - - if (is_F q) { - r <@ O.f(get_query q); - } else { - r <@ O.fi(get_query q); - } - return r; - } -}. - -module IRO_to_F (O : IRO): Functionality = { - proc init = O.init - - (* proc oracle = O.hash - does not work because of input types not lining up... - I though this had been taken care of. *) - proc oracle(x : block list * int): bool list = { - var bs; - bs = O.f(x.`1,x.`2); - return bs; - } -}. - -(** We can now define the sponge construction **) -module Sponge (P : Primitive): Construction(P), Functionality = { - proc init = P.init - - proc oracle(p : block list, n : int): bool list = { - var z <- []; - var s <- (Block.zeros,Capacity.zeros); - var i <- 0; - - if (size p >= 1 /\ nth witness p (size p - 1) <> Block.zeros) { - (* Absorption *) - while (p <> []) { - s <@ P.oracle(F (s.`1 ^ head witness p,s.`2)); - p <- behead p; - } - (* Squeezing *) - while (i < n/%r) { - z <- z ++ (Self.to_bits s.`1); (* Typing by constraint would be nice *) - s <@ P.oracle(F s); - } - } - - return take n z; - } -}. - -(** TODO: ftn is in fact a function of N - (number of queries to the primitive interface) **) -op ftn: real. - -module P = RP_to_P(Primitive.P). -module F = IRO_to_F(IRO). - -clone import Squeezeless as Core with - op r <- r, - type block <- block, - op dblock <- dblock, - op c <- c, - type capacity <- capacity, - op dcapacity <- dcapacity, - (** The following should be dealt with by sub-theory instantiation, - but the sub-theories we instantiate are partially concrete **) - op Block.zeros <- Self.Block.zeros, - op Block.ones <- Self.Block.ones, - op Block.(^) <- Self.Block.(^), - op Block.land <- Self.Block.land, - op Block.to_bits <- Self.Block.to_bits, - op Block.from_bits <- Self.Block.from_bits, - op Block.to_int <- Self.Block.to_int, - op Block.from_int <- Self.Block.from_int, - op Capacity.zeros <- Self.Capacity.zeros, - op Capacity.ones <- Self.Capacity.ones, - op Capacity.(^) <- Self.Capacity.(^), - op Capacity.land <- Self.Capacity.land, - op Capacity.to_bits <- Self.Capacity.to_bits, - op Capacity.from_bits <- Self.Capacity.from_bits, - op Capacity.to_int <- Self.Capacity.to_int, - op Capacity.from_int <- Self.Capacity.from_int -proof *. - realize lt0_r by exact/lt0_r. - realize lt0_c by exact/lt0_c. - realize Block.ones_neq0 by exact/Self.Block.ones_neq0. - realize Block.xorwA by exact/Self.Block.xorwA. - realize Block.xorwC by exact/Self.Block.xorwC. - realize Block.xor0w by exact/Self.Block.xor0w. - realize Block.xorwK by exact/Self.Block.xorwK. - realize Block.landwA by exact/Self.Block.landwA. - realize Block.landwC by exact/Self.Block.landwC. - realize Block.land1w by exact/Self.Block.land1w. - realize Block.landwDl by exact/Self.Block.landwDl. - realize Block.landI by exact/Self.Block.landI. - realize Block.length_to_bits by exact/Self.Block.length_to_bits. - realize Block.can_from_to by exact/Self.Block.can_from_to. - realize Block.pcan_to_from by exact/Self.Block.pcan_to_from. - realize Block.to_from by exact/Self.Block.to_from. - realize Block.from_to by exact/Self.Block.from_to. - realize Block.Dword.mu_x_def by exact/Self.Block.Dword.mu_x_def. - realize Block.Dword.lossless by exact/Self.Block.Dword.lossless. - realize Capacity.ones_neq0 by exact/Self.Capacity.ones_neq0. - realize Capacity.xorwA by exact/Self.Capacity.xorwA. - realize Capacity.xorwC by exact/Self.Capacity.xorwC. - realize Capacity.xor0w by exact/Self.Capacity.xor0w. - realize Capacity.xorwK by exact/Self.Capacity.xorwK. - realize Capacity.landwA by exact/Self.Capacity.landwA. - realize Capacity.landwC by exact/Self.Capacity.landwC. - realize Capacity.land1w by exact/Self.Capacity.land1w. - realize Capacity.landwDl by exact/Self.Capacity.landwDl. - realize Capacity.landI by exact/Self.Capacity.landI. - realize Capacity.length_to_bits by exact/Self.Capacity.length_to_bits. - realize Capacity.can_from_to by exact/Self.Capacity.can_from_to. - realize Capacity.pcan_to_from by exact/Self.Capacity.pcan_to_from. - realize Capacity.to_from by exact/Self.Capacity.to_from. - realize Capacity.from_to by exact/Self.Capacity.from_to. - realize Capacity.Dword.mu_x_def by exact/Self.Capacity.Dword.mu_x_def. - realize Capacity.Dword.lossless by exact/Self.Capacity.Dword.lossless. -(* end of clone *) - -module type BlockSponge = { - proc init(): unit - proc oracle(p : block list, n : int): block list -}. - -module Squeezer(F : Core.Functionality): BlockSponge = { - proc init = F.init - - proc oracle(p : block list, n : int): block list = { - var z <- []; - var b; - var i <- 0; - - if (size p >= 1 /\ nth witness p (size p - 1) <> Self.Block.zeros) { - while (i < n) { - b <@ F.oracle(p ++ mkseq (fun i => Self.Block.zeros) i); - z <- rcons z b; - i <- i + 1; - } - } - - return z; - } -}. - -(* Result: if there exists a good simulator for the Core functionality - F, then we can construct a simulator for Squeezer(F) that has the - same differentiability advantage. - Note: We need to be careful and may need to make this whitebox so - we can avoid having to make too many queries. *) - -module Truncator(F : BlockSponge): Self.Functionality = { - proc init = F.init - - proc oracle(p : block list, n : int): bool list = { - var z <- []; - var bs; - - if (size p >= 1 /\ nth witness p ( size p - 1) <> Self.Block.zeros) { - bs <@ F.oracle(p,n /% r); - z <- flatten (map to_bits bs); - } - - return take n z; - } -}. - -(* Result: if there exists a good simulator for the BlockSponge F, - then we can construct a simulator for Truncator(F) that has the - same differentiability advantage. - Note: We need to be careful and may need to make this whitebox so - we can avoid having to make too many queries. *) - -(* That Self is unfortunate *) -lemma PermutationLemma: exists (S <: Simulator), - forall (D <: Self.Distinguisher) &m, - `|Pr[Indif(Sponge(P),P,D).main() @ &m: res] - - Pr[Indif(F,S(F),D).main() @ &m: res]| - < ftn. -proof. admit. qed. \ No newline at end of file diff --git a/proof/old/Squeezeless.ec b/proof/old/Squeezeless.ec index aa9cb5e..ec7e0d1 100644 --- a/proof/old/Squeezeless.ec +++ b/proof/old/Squeezeless.ec @@ -2,7 +2,7 @@ functionality is a fixed-output-length random oracle whose output length is the input block size. We prove its security even when padding is not prefix-free. **) -require import Fun Option Pair Int Real NewList NewFSet NewFMap Utils. +require import Fun Option Pair Int Real List FSet NewFMap Utils. require (*..*) AWord LazyRP LazyRO Indifferentiability. (* TODO: Clean up the Bitstring and Word theories -- Make use of those new versions. *) @@ -36,31 +36,14 @@ proof leq0_length by smt. type state = block * capacity. op dstate = dblock * dcapacity. -(** The following is just lining up type definitions and defines the - Indifferentiability experiment. Importantly, it defines neither - ideal primitive nor ideal functionality: only their type. **) -type p_query = [ - | F of state - | Fi of state -]. - -op is_F (q : p_query) = - with q = F s => true - with q = Fi s => false. - -op is_Fi (q : p_query) = - with q = F s => false - with q = Fi s => true. - -op get_query (q : p_query) = - with q = F s => s - with q = Fi s => s. +print Indifferentiability. clone include Indifferentiability with - type p_in <- p_query, - type p_out <- state, + type p <- state, type f_in <- block list, - type f_out <- block. + type f_out <- block + rename [module] "GReal" as "RealIndif" + [module] "GIdeal" as "IdealIndif". (** Ideal Functionality **) clone import LazyRO as Functionality with @@ -73,37 +56,16 @@ clone import LazyRP as Primitive with type D <- state, op d <- dstate. -(*** TODO: deal with these. - - lining up names and types should be easier than it is... ***) -module RP_to_P (O : RP) = { - proc init = O.init - proc oracle(q : p_query) = { - var r; - - if (is_F q) { - r <@ O.f(get_query q); - } else { - r <@ O.fi(get_query q); - } - return r; - } -}. - -module RO_to_F (O : RO): Functionality = { - proc init = O.init - proc oracle = O.f -}. - (** We can now define the squeezeless sponge construction **) -module SqueezelessSponge (P : Primitive): Construction(P), Functionality = { - proc init = P.init +module SqueezelessSponge (P:PRIMITIVE): CONSTRUCTION(P), FUNCTIONALITY = { + proc init () = {} - proc oracle(p : block list): block = { + proc f(p : block list): block = { var (sa,sc) <- (Block.zeros,Capacity.zeros); - if (size p >= 1 /\ p <> [Block.zeros]) { + if (1 <= size p /\ p <> [Block.zeros]) { while (p <> []) { (* Absorption *) - (sa,sc) <@ P.oracle(F (sa ^ head witness p,sc)); + (sa,sc) <@ P.f((sa ^ head witness p,sc)); p <- behead p; } } @@ -114,11 +76,10 @@ module SqueezelessSponge (P : Primitive): Construction(P), Functionality = { (** And the corresponding simulator **) op find_chain: (state,state) fmap -> state -> (block list * block) option. -module PreSimulator (F : Functionality) = { +module S (F : FUNCTIONALITY) = { var m, mi: (state,state) fmap proc init() = { - F.init(); m <- map0; mi <- map0; } @@ -130,7 +91,7 @@ module PreSimulator (F : Functionality) = { pvo <- find_chain m x; if (pvo <> None) { (p,v) <- oget pvo; - h <@ F.oracle(rcons p v); + h <@ F.f(rcons p v); y <$ dcapacity; } else { (h,y) <$ dstate; @@ -153,12 +114,8 @@ module PreSimulator (F : Functionality) = { } }. -module P = RP_to_P(Primitive.P). -module F = RO_to_F(H). -module S(F : Functionality) = RP_to_P(PreSimulator(F)). - section. - declare module D : Self.Distinguisher {P, F, S}. + declare module D : Self.DISTINGUISHER {P, H, S}. (** Inlining oracles into the experiment for clarity **) (* TODO: Drop init from the Distinguisher parameters' signatures *) @@ -169,7 +126,7 @@ section. module F = { proc init(): unit = { } - proc oracle(x : block list): block = { + proc f(x : block list): block = { if (!mem (dom ro) x) { ro.[x] <$ dblock; } @@ -187,7 +144,7 @@ section. pvo <- find_chain m x; if (pvo <> None) { (p,v) <- oget pvo; - h <@ F.oracle(rcons p v); + h <@ F.f(rcons p v); y <$ dcapacity; } else { (h,y) <$ dstate; @@ -209,16 +166,6 @@ section. return oget mi.[x]; } - proc oracle(q : p_query): state = { - var r; - - if (is_F q) { - r <@ f(get_query q); - } else { - r <@ fi(get_query q); - } - return r; - } } proc main(): bool = { @@ -260,28 +207,17 @@ section. return oget mi.[x]; } - proc oracle(q : p_query): state = { - var r; - - if (is_F q) { - r <@ f(get_query q); - } else { - r <@ fi(get_query q); - } - return r; - } - } module C = { proc init(): unit = { } - proc oracle(p : block list): block = { + proc f(p : block list): block = { var (sa,sc) <- (Block.zeros,Capacity.zeros); - if (size p >= 1 /\ p <> [Block.zeros]) { + if (1 <= size p /\ p <> [Block.zeros]) { while (p <> []) { (* Absorption *) - (sa,sc) <@ P.oracle(F (sa ^ head witness p,sc)); + (sa,sc) <@ P.f((sa ^ head witness p,sc)); p <- behead p; } } @@ -302,8 +238,8 @@ section. (** Result: The adversary's advantage in distinguishing the modular defs is equal to that of distinguishing these **) local lemma Inlined_pr &m: - `|Pr[Indif(SqueezelessSponge(P),P,D).main() @ &m: res] - - Pr[Indif(F,S(F),D).main() @ &m: res]| + `|Pr[RealIndif(SqueezelessSponge,P,D).main() @ &m: res] + - Pr[IdealIndif(H,S,D).main() @ &m: res]| = `|Pr[Concrete.main() @ &m: res] - Pr[Ideal.main() @ &m: res]|. proof. by do !congr; expect 2 (byequiv=> //=; proc; inline *; sim; auto). qed. @@ -338,28 +274,17 @@ section. return oget mi.[x]; } - proc oracle(q : p_query): state = { - var r; - - if (is_F q) { - r <@ f(get_query q); - } else { - r <@ fi(get_query q); - } - return r; - } - } module C = { proc init(): unit = { } - proc oracle(p : block list): block = { + proc f(p : block list): block = { var (sa,sc) <- (Block.zeros,Capacity.zeros); - if (size p >= 1 /\ p <> [Block.zeros]) { + if (1 <= size p /\ p <> [Block.zeros]) { while (p <> []) { (* Absorption *) - (sa,sc) <@ P.oracle(F (sa ^ head witness p,sc)); + (sa,sc) <@ P.f((sa ^ head witness p,sc)); p <- behead p; } } @@ -437,6 +362,7 @@ section. by split; apply/half_permutation_set. qed. +print FUNCTIONALITY. local module Game0 = { var m, mi : (state,state) fmap var mcol, micol : (state,caller) fmap (* colouring maps for m, mi *) @@ -447,7 +373,7 @@ section. module S = { (** Inner interface **) - proc f(o : caller, x : state): state = { + proc fg(o : caller, x : state): state = { var o', y, pv, p, v; o' <- odflt D pathscol.[x.`2]; @@ -478,6 +404,12 @@ section. return oget m.[x]; } + proc f(x:state):state = { + var r; + r <@ fg(D,x); + return r; + } + proc fi(x : state): state = { var o', y; @@ -501,28 +433,17 @@ section. (** Distinguisher interface **) proc init() = { } - proc oracle(q : p_query): state = { - var r; - - if (is_F q) { - r <@ f(D,get_query q); - } else { - r <@ fi(get_query q); - } - return r; - } - } module C = { proc init(): unit = { } - proc oracle(p : block list): block = { + proc f(p : block list): block = { var (sa,sc) <- (Block.zeros,Capacity.zeros); - if (size p >= 1 /\ p <> [Block.zeros]) { + if (1 <= size p /\ p <> [Block.zeros]) { while (p <> []) { - (sa,sc) <@ S.f(I,(sa ^ head witness p,sc)); + (sa,sc) <@ S.fg(I,(sa ^ head witness p,sc)); p <- behead p; } } @@ -553,7 +474,7 @@ section. (** Result: the instrumented system and the concrete system are perfectly equivalent **) local equiv Game0_P_S_eq: - Concrete_F.P.f ~ Game0.S.f: + Concrete_F.P.f ~ Game0.S.fg: arg{1} = arg{2}.`2 /\ ={m,mi}(Concrete_F,Game0) /\ is_pre_permutation (Concrete_F.m){1} (Concrete_F.mi){1} @@ -593,14 +514,12 @@ section. proc. call (_: ={m,mi}(Concrete_F,Game0) /\ is_pre_permutation Concrete_F.m{1} Concrete_F.mi{1}). - proc; if=> //=. - + by call Game0_P_S_eq. - + by call Game0_Pi_Si_eq. + + by proc *;inline Game0.S.f;wp;call Game0_P_S_eq;auto. + + by proc *;call Game0_Pi_Si_eq. + proc. sp; if=> //=. while ( ={sa,sc,p} /\ ={m,mi}(Concrete_F,Game0) /\ is_pre_permutation Concrete_F.m{1} Concrete_F.mi{1}). - inline Concrete_F.P.oracle. rcondt{1} 2; 1:by auto. wp; call Game0_P_S_eq. by auto. by auto. @@ -629,7 +548,7 @@ section. module S = { (** Inner interface **) - proc f(o : caller, x : state): state = { + proc fg(o : caller, x : state): state = { var o', ya, yc, pv, p, v; o' <- odflt D pathscol.[x.`2]; @@ -663,6 +582,12 @@ section. return (oget rate.[x],oget cap.[x]); } + proc f(x:state):state = { + var r; + r <@ fg(D,x); + return r; + } + proc fi(x : state): state = { var ya, yc; @@ -688,28 +613,17 @@ section. (** Distinguisher interface **) proc init() = { } - proc oracle(q : p_query): state = { - var r; - - if (is_F q) { - r <@ f(D,get_query q); - } else { - r <@ fi(get_query q); - } - return r; - } - } module C = { proc init(): unit = { } - proc oracle(p : block list): block = { + proc f(p : block list): block = { var (sa,sc) <- (Block.zeros,Capacity.zeros); - if (size p >= 1 /\ p <> [Block.zeros]) { + if (1<= size p /\ p <> [Block.zeros]) { while (p <> []) { - (sa,sc) <@ S.f(I,(sa ^ head witness p,sc)); + (sa,sc) <@ S.fg(I,(sa ^ head witness p,sc)); p <- behead p; } } @@ -740,7 +654,7 @@ section. }. local equiv Game1_S_S_eq: - Game0.S.f ~ Game1.S.f: + Game0.S.fg ~ Game1.S.fg: ={arg} /\ ={pathscol,paths}(Game0,Game1) /\ map_split Game0.m{1} Game1.rate{2} Game1.cap{2} @@ -751,15 +665,15 @@ section. /\ map_split Game0.m{1} Game1.rate{2} Game1.cap{2} /\ map_split Game0.mi{1} Game1.ratei{2} Game1.capi{2} /\ is_pre_permutation (Game0.m){1} (Game0.mi){1}. - proof. + proof. proc. inline *. sp; if; 1:by progress [-split]; move: H=> [->]. - + auto; progress [-split]. - move: H3; case yL=> ya yc H3; case (x{2})=> xa xc. - by rewrite !getP_eq !map_split_set ?pre_permutation_set. - + auto; progress [-split]. - rewrite H H0 H1 /=. - by move: H=> [_ [_ ->]]. + + auto; progress [-split]. + move: H3; case yL=> ya yc H3; case (x{2})=> xa xc. + by rewrite !getP_eq !map_split_set ?pre_permutation_set. + + auto; progress [-split]. + rewrite H H0 H1 /=. + by move: H=> [_ [_ ->]]. qed. local equiv Game1_Si_Si_eq: @@ -777,12 +691,12 @@ section. proof. proc. inline *. sp; if; 1:by progress [-split]; move: H0=> [->]. - + auto; progress [-split]. - move: H3; case yL=> ya yc H3; case (x{2})=> xa xc. - by rewrite !getP_eq !map_split_set ?pre_permutation_set. - + auto; progress [-split]. - rewrite H H0 H1 /=. - by move: H0=> [_ [_ ->]]. + + auto; progress [-split]. + move: H3; case yL=> ya yc H3; case (x{2})=> xa xc. + by rewrite !getP_eq !map_split_set ?pre_permutation_set. + + auto; progress [-split]. + rewrite H H0 H1 /=. + by move: H0=> [_ [_ ->]]. qed. local lemma Game1_pr &m: @@ -796,17 +710,15 @@ section. /\ map_split Game0.m{1} Game1.rate{2} Game1.cap{2} /\ map_split Game0.mi{1} Game1.ratei{2} Game1.capi{2} /\ is_pre_permutation Game0.m{1} Game0.mi{1}). - proc; if=> //=. - + by call Game1_S_S_eq. - + by call Game1_Si_Si_eq. - + proc; sp; if=> //=. - while ( ={sa,sc,p} - /\ ={pathscol,paths}(Game0,Game1) - /\ map_split Game0.m{1} Game1.rate{2} Game1.cap{2} - /\ map_split Game0.mi{1} Game1.ratei{2} Game1.capi{2} - /\ is_pre_permutation Game0.m{1} Game0.mi{1}). - by wp; call Game1_S_S_eq. - done. + + by proc;call Game1_S_S_eq. + + by apply Game1_Si_Si_eq. + + proc; sp; if=> //=. + while ( ={sa,sc,p} + /\ ={pathscol,paths}(Game0,Game1) + /\ map_split Game0.m{1} Game1.rate{2} Game1.cap{2} + /\ map_split Game0.mi{1} Game1.ratei{2} Game1.capi{2} + /\ is_pre_permutation Game0.m{1} Game0.mi{1})=> //. + by wp; call Game1_S_S_eq. by auto; smt. qed. end section. @@ -814,8 +726,8 @@ end section. (* That Self is unfortunate *) lemma PermutationLemma: exists epsilon, - forall (D <: Self.Distinguisher) &m, - `|Pr[Indif(SqueezelessSponge(P),P,D).main() @ &m: res] - - Pr[Indif(F,S(F),D).main() @ &m: res]| + forall (D <: Self.DISTINGUISHER) &m, + `|Pr[RealIndif(SqueezelessSponge,P,D).main() @ &m: res] + - Pr[IdealIndif(H,S,D).main() @ &m: res]| < epsilon. proof. admit. qed. diff --git a/proof/old/Utils.ec b/proof/old/Utils.ec index 4a460ae..5b6f0bd 100644 --- a/proof/old/Utils.ec +++ b/proof/old/Utils.ec @@ -2,19 +2,6 @@ require import Option Pair List FSet NewFMap. (* -------------------------------------------------------------------- *) -(* In NewFSet *) -op image (f : 'a -> 'b) (X : 'a fset) = oflist (map f (elems X)) - axiomatized by imageE. - -lemma imageP (f : 'a -> 'b) (X : 'a fset) (b : 'b): - mem (image f X) b <=> exists a, mem X a /\ f a = b. -proof. - rewrite imageE mem_oflist mapP. - (* FIXME *) - by split=> [[a] [a_in_X b_def]| [a] [a_in_X b_def]]; - [rewrite -memE in a_in_X | rewrite memE in a_in_X]; - exists a; rewrite b_def. -qed. lemma rem_id (x : 'a) (m : ('a,'b) fmap): !mem (dom m) x => rem x m = m. @@ -34,11 +21,14 @@ proof. by rewrite rng_rm in_rng=> [x0] [_ h]; exists x0. qed. (* -------------------------------------------------------------------- *) -(* In NewFMap *) + (* In NewFMap *) + op reindex (f : 'a -> 'c) (m : ('a, 'b) fmap) = NewFMap.oflist (map (fun (x : 'a * 'b) => (f x.`1,x.`2)) (elems m)) axiomatized by reindexE. + + lemma dom_reindex (f : 'a -> 'c) (m : ('a, 'b) fmap) x: mem (dom (reindex f m)) x <=> mem (image f (dom m)) x. proof. From 8723cc404f4b88dd81b7e1ed32094d77f63eea64 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Mon, 30 Nov 2015 22:15:27 +0100 Subject: [PATCH 058/525] fixing previous commits --- Makefile | 2 +- proof/Absorb.ec | 2 +- proof/AbsorbToBlocks.ec | 6 +-- proof/Blocks.ec | 9 ++--- proof/BlocksToTopLevel.ec | 8 ++-- proof/Common.ec | 85 +++++++++++++++++++++++++++------------ proof/TopLevel.ec | 4 +- 7 files changed, 74 insertions(+), 42 deletions(-) diff --git a/Makefile b/Makefile index 3c2e3bd..c4106b0 100644 --- a/Makefile +++ b/Makefile @@ -3,7 +3,7 @@ # -------------------------------------------------------------------- ECROOT ?= ECCHECK ?= -ECARGS ?= +ECARGS ?= -I proof ECCONF := config/tests.config XUNITOUT ?= xunit.xml CHECKS ?= sha3 diff --git a/proof/Absorb.ec b/proof/Absorb.ec index e8984d7..062ddb0 100644 --- a/proof/Absorb.ec +++ b/proof/Absorb.ec @@ -40,7 +40,7 @@ module BlockSponge (P : PRIMITIVE) : RO, CONSTRUCTION(P) = { if (valid p) { (* Absorption *) while (p <> []) { - (sa,sc) <@ P.f(sa ^ head b0 p, sc); + (sa,sc) <@ P.f(sa +^ head b0 p, sc); p <- behead p; } } diff --git a/proof/AbsorbToBlocks.ec b/proof/AbsorbToBlocks.ec index a5c48bf..d49c36a 100644 --- a/proof/AbsorbToBlocks.ec +++ b/proof/AbsorbToBlocks.ec @@ -35,7 +35,7 @@ module UpperFun (F : Absorb.FUNCTIONALITY) = { var ys <- []; var i <- 0; - if (unpad xs <> None) { + if (valid_block xs) { while (i < n) { y <@ F.f(oget(extend xs i)); ys <- rcons ys y; @@ -70,7 +70,7 @@ section. pred lower (ro : (block list,block) fmap) (iro : (block list * int,block) fmap) = Blocks.BIRO.prefix_closed iro /\ - forall x n, unpad x <> None => iro.[(x,n)] = ro.[oget(extend x n)]. + forall x n, valid_block x => iro.[(x,n)] = ro.[oget(extend x n)]. local equiv ModularAbsorb: UpperFun(Absorb.Ideal.RO).f ~ Blocks.BIRO.IRO'.f: @@ -87,7 +87,7 @@ section. pred upper (ro : (block list,block) fmap) (iro : (block list * int,block) fmap) = (forall x y, strip x <> None => ro.[x] = Some y => iro.[oget(strip x)] = Some y) /\ (forall x n y, - unpad x <> None => + valid_block x => iro.[(x,n)] = Some y => exists n', n <= n' diff --git a/proof/Blocks.ec b/proof/Blocks.ec index eb1513f..a91162a 100644 --- a/proof/Blocks.ec +++ b/proof/Blocks.ec @@ -7,13 +7,10 @@ require import Common. (* -------------------------------------------------------------------- *) -op valid : block list -> bool = - fun xs => unpad xs <> None. - clone import IRO as BIRO with type from <- block list, type to <- block, - op valid <- valid. + op valid <- valid_block. (* -------------------------------------------------------------------- *) clone include Indifferentiability with @@ -35,10 +32,10 @@ module BlockSponge (P : PRIMITIVE) : BIRO.IRO, CONSTRUCTION(P) = { var (sa,sc) <- (b0, Capacity.c0); var i <- 0; - if (valid p) { + if (valid_block p) { (* Absorption *) while (p <> []) { - (sa,sc) <@ P.f(sa ^ head b0 p, sc); + (sa,sc) <@ P.f(sa +^ head b0 p, sc); p <- behead p; } (* Squeezing *) diff --git a/proof/BlocksToTopLevel.ec b/proof/BlocksToTopLevel.ec index ee672ec..088f7e3 100644 --- a/proof/BlocksToTopLevel.ec +++ b/proof/BlocksToTopLevel.ec @@ -12,8 +12,8 @@ module UpperFun (F : Blocks.FUNCTIONALITY) = { proc f(p : bool list, n : int) = { var xs; - xs <@ F.f(pad p, (n + r - 1) %/ r); - return take n (flatten(map w2bits xs)); + xs <@ F.f(bits2blocks (pad p), (n + r - 1) %/ r); + return take n (blocks2bits xs); } }. @@ -25,10 +25,10 @@ module LowerFun (F : TopLevel.FUNCTIONALITY) = { var obs : bool list option; var ys : block list <- []; - obs <- unpad xs; + obs <- unpad (blocks2bits xs); if (obs <> None) { cs <@ F.f(oget obs, n * r); (* size cs = n * r *) - ys <- (chunk cs).`1; + ys <- bits2blocks cs; } return ys; } diff --git a/proof/Common.ec b/proof/Common.ec index 2c0493d..c078abe 100644 --- a/proof/Common.ec +++ b/proof/Common.ec @@ -2,7 +2,7 @@ require import Option Fun Pair Int IntExtra IntDiv Real List NewDistr. require import Ring StdRing StdOrder StdBigop BitEncoding. require (*--*) FinType BitWord LazyRP Monoid. -(*---*) import IntID IntOrder Bigint Bigint.BIA. +(*---*) import IntID IntOrder Bigint Bigint.BIA IntDiv. (* -------------------------------------------------------------------- *) op r : { int | 2 <= r } as ge2_r. @@ -24,14 +24,16 @@ clone BitWord as Capacity with op n <- c proof gt0_n by apply/gt0_c - rename "dword" as "cdistr". + rename "dword" as "cdistr" + "zerow" as "c0". clone export BitWord as Block with type word <- block, op n <- r proof gt0_n by apply/gt0_r - rename "dword" as "bdistr". + rename "dword" as "bdistr" + "zerow" as "b0". (* -------------------------------------------------------------------- *) op ( * ): 'a distr -> 'b distr -> ('a * 'b) distr. @@ -47,7 +49,6 @@ rename (* What about this (and the comment applies to other functions): *) -theory Alternative. op chunk (bs : bool list) = BitChunking.chunk r bs. op mkpad (n : int) = @@ -143,8 +144,41 @@ qed. lemma chunk_padK : pcancel (chunk \o pad) (unpad \o flatten). proof. by move=> s @/(\o); rewrite chunkK 1:size_pad_dvd_r padK. qed. -end Alternative. + +lemma mkseq_add (f:int -> 'a) (n m:int): + 0 <= n => 0 <= m => + mkseq f (n+m) = mkseq f n ++ mkseq (fun i => f (n+i)) m. +admit. +qed. + + +lemma flattenK bs : (forall b, mem bs b => size b = r) => chunk (flatten bs) = bs. +proof. + elim:bs=> [_|x xs Hrec Hs]. by rewrite flatten_nil /chunk /= div0z mkseq0. + rewrite flatten_cons /chunk size_cat Hs 1://. + cut /= -> :=(divzMDl 1 (size (flatten xs)) r);1:by apply /gtr_eqF/gt0_r. + rewrite mkseq_add // 1:divz_ge0 1:gt0_r 1:size_ge0 (mkseqS _ 0) 1:// mkseq0 /=. + rewrite drop0 take_cat Hs //= take0 cats0 /= -{3}Hrec;1:by move=> b Hb;apply Hs;right. + apply eq_in_mkseq => /= i Hi; rewrite IntID.mulrDr /= drop_cat (Hs x) //=. + cut ->/=:!(r + r * i < r);smt ml=0 w=gt0_r. +qed. + +op blocks2bits (xs:block list) : bool list = + flatten (map w2bits xs). + +op bits2blocks (xs:bool list) : block list = + map bits2w (chunk xs). + +lemma block2bitsK : cancel blocks2bits bits2blocks. +proof. + move=> xs;rewrite /blocks2bits /bits2blocks flattenK. + + by move=> b /mapP [x [_ ->]];rewrite /w2bits -Array.sizeE size_word. + rewrite -map_comp -{2}(map_id xs) /(\o) /=;apply eq_map=> @/idfun x /=;apply oflistK. +qed. + + +(* (* -------------------------------------------------------------------- *) (* if size cs < r, then size (chunk_aux (xs, cs) b).`2 < r *) op chunk_aux : block list * bool list -> bool -> block list * bool list = @@ -275,10 +309,10 @@ smt. smt. (* inductive step *) move=> x xs IH cs ys siz_cs_lt_r. -have -> : flatten(x :: xs, cs) = w2bits x ++ flatten (xs, cs) by smt. +have -> : flatten(x :: xs, cs) = w2bits x ++ flatten (xs, cs) by (* smt *) admit. rewrite foldl_cat. rewrite foldl_chunk_aux_new_block. -smt. +smt ml=0. smt. have -> : bits2w([] ++ w2bits x) = x by smt. rewrite (IH cs (rcons ys x)). @@ -358,36 +392,37 @@ proof. rewrite /ocancel. admit. qed. - +*) (* ------------------------ Extending/Stripping ----------------------- *) + +op valid_block (xs : block list) = + unpad (flatten (map w2bits xs)) <> None. (* extend xs n returns None if xs doesn't unpad successfully; otherwise, it returns the result of adding n copies of b0 to the end of xs (n < 0 is treated as n = 0) *) -op extend : block list -> int -> block list option = - fun xs n => - if unpad xs = None - then None + +op extend (xs:block list) (n:int): block list option = + if unpad (flatten (map w2bits xs)) = None then None else Some(xs ++ nseq n b0). -op extend_uncur : block list * int -> block list option = - fun (p : block list * int) => extend p.`1 p.`2. +op extend_uncur (p:block list * int): block list option = + extend p.`1 p.`2. -(* strip returns None if removing the longest suffix of b0's from its +(* strip returns None if removing the longest suffix of zerow's from its argument yields a block list that cannot be unpadded; otherwise, it - removes the longest suffix of b0's from its argument and returns - the pair of the resulting block list with the number of b0's + removes the longest suffix of zerow's from its argument and returns + the pair of the resulting block list with the number of zerow's removed *) -op strip : block list -> (block list * int)option = - fun xs => +op strip (xs:block list): (block list * int)option = let ys = rev xs in let i = find (fun x => x <> b0) ys in - if i = size xs - then None - else let zs = rev(drop i ys) in - if unpad zs = None - then None - else Some(zs, i). + if i = size xs then None + else + let zs = rev(drop i ys) in + if valid_block zs then Some(zs, i) + else None. + pred valid_absorb (xs : block list) = exists (ys : block list, n : int), diff --git a/proof/TopLevel.ec b/proof/TopLevel.ec index ed1f87e..37e77a1 100644 --- a/proof/TopLevel.ec +++ b/proof/TopLevel.ec @@ -31,11 +31,11 @@ module Sponge (P : PRIMITIVE) : BIRO.IRO, CONSTRUCTION(P) = { var z <- []; var (sa,sc) <- (b0, Capacity.c0); var i <- 0; - var p <- pad bp; + var p <- map bits2w (chunk (pad bp)); (* Absorption *) while (p <> []) { - (sa,sc) <@ P.f(sa ^ head b0 p, sc); + (sa,sc) <@ P.f(sa +^ head b0 p, sc); p <- behead p; } (* Squeezing *) From c5c3c7587e4d4f4b6cc98944042f92f90567b754 Mon Sep 17 00:00:00 2001 From: Pierre-Yves Strub Date: Tue, 1 Dec 2015 09:26:44 +0100 Subject: [PATCH 059/525] Move some results to the EasyCrypt stdlib. --- proof/Common.ec | 22 +++------------------- 1 file changed, 3 insertions(+), 19 deletions(-) diff --git a/proof/Common.ec b/proof/Common.ec index c078abe..f60a782 100644 --- a/proof/Common.ec +++ b/proof/Common.ec @@ -145,24 +145,9 @@ qed. lemma chunk_padK : pcancel (chunk \o pad) (unpad \o flatten). proof. by move=> s @/(\o); rewrite chunkK 1:size_pad_dvd_r padK. qed. - -lemma mkseq_add (f:int -> 'a) (n m:int): - 0 <= n => 0 <= m => - mkseq f (n+m) = mkseq f n ++ mkseq (fun i => f (n+i)) m. -admit. -qed. - - -lemma flattenK bs : (forall b, mem bs b => size b = r) => chunk (flatten bs) = bs. -proof. - elim:bs=> [_|x xs Hrec Hs]. by rewrite flatten_nil /chunk /= div0z mkseq0. - rewrite flatten_cons /chunk size_cat Hs 1://. - cut /= -> :=(divzMDl 1 (size (flatten xs)) r);1:by apply /gtr_eqF/gt0_r. - rewrite mkseq_add // 1:divz_ge0 1:gt0_r 1:size_ge0 (mkseqS _ 0) 1:// mkseq0 /=. - rewrite drop0 take_cat Hs //= take0 cats0 /= -{3}Hrec;1:by move=> b Hb;apply Hs;right. - apply eq_in_mkseq => /= i Hi; rewrite IntID.mulrDr /= drop_cat (Hs x) //=. - cut ->/=:!(r + r * i < r);smt ml=0 w=gt0_r. -qed. +lemma flattenK bs : + (forall b, mem bs b => size b = r) => chunk (flatten bs) = bs. +proof. by apply/BitChunking.flattenK/gt0_r. qed. op blocks2bits (xs:block list) : bool list = flatten (map w2bits xs). @@ -177,7 +162,6 @@ proof. rewrite -map_comp -{2}(map_id xs) /(\o) /=;apply eq_map=> @/idfun x /=;apply oflistK. qed. - (* (* -------------------------------------------------------------------- *) (* if size cs < r, then size (chunk_aux (xs, cs) b).`2 < r *) From b020775513a1cc2e72cf16bceaf0b1934b43eadb Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Tue, 1 Dec 2015 18:58:58 -0500 Subject: [PATCH 060/525] Defined these functions op pad2blocks : bool list -> block list = bits2blocks \o pad. op unpad_blocks : block list -> bool list option = unpad \o blocks2bits. Proved the expected cancelation lemmas, as well as bits2blocksK, which was missing. extend and strip no longer can fail (as P-Y said, this makes them easier to reason about): op extend (xs : block list) (n : int) = xs ++ nseq n b0. op strip (xs : block list) = let i = find (fun x => x <> b0) (rev xs) in (take (size xs - i) xs, i). Defined validity tests for each level: (* in TopLevel *) op valid_toplevel (_ : bool list) = true. (* in Block *) op valid_block (xs : block list) = unpad_blocks xs <> None. (* in Absorb *) op valid_absorb (xs : block list) = let (ys, n) = strip xs in valid_block ys. Updated other files to track these changes. (Cancelation lemmas for extend/strip almost done, but not in this commit.) --- proof/Absorb.ec | 5 +- proof/AbsorbToBlocks.ec | 36 +++-- proof/Blocks.ec | 6 +- proof/BlocksToTopLevel.ec | 4 +- proof/Common.ec | 297 +++++++------------------------------- proof/TopLevel.ec | 4 +- 6 files changed, 76 insertions(+), 276 deletions(-) diff --git a/proof/Absorb.ec b/proof/Absorb.ec index 062ddb0..31978ef 100644 --- a/proof/Absorb.ec +++ b/proof/Absorb.ec @@ -9,9 +9,6 @@ require import Common. (* -------------------------------------------------------------------- *) -op valid : block list -> bool = - fun xs => strip xs <> None. - clone import RndOrcl as RO with type from <- block list, type to <- block, @@ -37,7 +34,7 @@ module BlockSponge (P : PRIMITIVE) : RO, CONSTRUCTION(P) = { proc f(p : block list): block = { var (sa,sc) <- (b0, Capacity.c0); - if (valid p) { + if (valid_absorb p) { (* Absorption *) while (p <> []) { (sa,sc) <@ P.f(sa +^ head b0 p, sc); diff --git a/proof/AbsorbToBlocks.ec b/proof/AbsorbToBlocks.ec index d49c36a..eb00f91 100644 --- a/proof/AbsorbToBlocks.ec +++ b/proof/AbsorbToBlocks.ec @@ -12,16 +12,13 @@ module LowerFun(F : Blocks.FUNCTIONALITY) : Absorb.FUNCTIONALITY = { proc init = F.init proc f(xs : block list) : block = { - var o : (block list * int)option; - var ys <- []; - var n; + var (ys, n) <- strip xs; + var zs <- []; - o <- strip xs; - if (o <> None) { - (ys, n) <- oget o; - ys <@ F.f(ys, n + 1); + if (valid_block ys) { + zs <@ F.f(ys, n + 1); } - return last b0 ys; + return last b0 zs; } }. @@ -37,7 +34,7 @@ module UpperFun (F : Absorb.FUNCTIONALITY) = { if (valid_block xs) { while (i < n) { - y <@ F.f(oget(extend xs i)); + y <@ F.f(extend xs i); ys <- rcons ys y; i <- i + 1; } @@ -70,7 +67,7 @@ section. pred lower (ro : (block list,block) fmap) (iro : (block list * int,block) fmap) = Blocks.BIRO.prefix_closed iro /\ - forall x n, valid_block x => iro.[(x,n)] = ro.[oget(extend x n)]. + forall x n, valid_block x => iro.[(x,n)] = ro.[extend x n]. local equiv ModularAbsorb: UpperFun(Absorb.Ideal.RO).f ~ Blocks.BIRO.IRO'.f: @@ -85,23 +82,22 @@ section. qed. pred upper (ro : (block list,block) fmap) (iro : (block list * int,block) fmap) = - (forall x y, strip x <> None => ro.[x] = Some y => iro.[oget(strip x)] = Some y) + (forall x y, valid_absorb x => ro.[x] = y => iro.[strip x] = y) /\ (forall x n y, valid_block x => iro.[(x,n)] = Some y => exists n', n <= n' - /\ mem (dom ro) (oget(extend x n'))). + /\ mem (dom ro) (extend x n')). module LowIRO' : Absorb.FUNCTIONALITY = { proc init = Blocks.BIRO.IRO'.init - proc f(x : block list) = { + proc f(xs : block list) = { var b <- b0; - var o : (block list * int)option; + var (ys, n) = strip xs; - o <- strip x; - if (o <> None) { - b <@ Blocks.BIRO.IRO'.f_lazy(oget o); + if (valid_block ys) { + b <@ Blocks.BIRO.IRO'.f_lazy(ys, n); } return b; @@ -227,9 +223,11 @@ section. byequiv=> //=; proc. call (_: ={glob AbsorbSim} /\ lower Absorb.Ideal.RO.m{1} Blocks.BIRO.IRO'.mp{2}). proc (lower Absorb.Ideal.RO.m{1} Blocks.BIRO.IRO'.mp{2})=> //=. - by proc; sp; if=> //=; call ModularAbsorb; auto. + proc; sp; if=> //=. smt. + call ModularAbsorb; auto; smt. proc (lower Absorb.Ideal.RO.m{1} Blocks.BIRO.IRO'.mp{2})=> //=. - by proc; sp; if=> //=; call ModularAbsorb; auto. + proc; sp; if=> //=. smt. + call ModularAbsorb; auto; smt. (* Re-Bug *) by conseq ModularAbsorb=> &1 &2; case (arg{1}); case (arg{2}). inline *; wp;call (_: true)=> //=. diff --git a/proof/Blocks.ec b/proof/Blocks.ec index a91162a..bdc4d2b 100644 --- a/proof/Blocks.ec +++ b/proof/Blocks.ec @@ -8,9 +8,9 @@ require import Common. (* -------------------------------------------------------------------- *) clone import IRO as BIRO with - type from <- block list, - type to <- block, - op valid <- valid_block. + type from <- block list, + type to <- block, + op valid <- valid_block. (* -------------------------------------------------------------------- *) clone include Indifferentiability with diff --git a/proof/BlocksToTopLevel.ec b/proof/BlocksToTopLevel.ec index 088f7e3..94aff60 100644 --- a/proof/BlocksToTopLevel.ec +++ b/proof/BlocksToTopLevel.ec @@ -12,7 +12,7 @@ module UpperFun (F : Blocks.FUNCTIONALITY) = { proc f(p : bool list, n : int) = { var xs; - xs <@ F.f(bits2blocks (pad p), (n + r - 1) %/ r); + xs <@ F.f(pad2blocks p, (n + r - 1) %/ r); return take n (blocks2bits xs); } }. @@ -25,7 +25,7 @@ module LowerFun (F : TopLevel.FUNCTIONALITY) = { var obs : bool list option; var ys : block list <- []; - obs <- unpad (blocks2bits xs); + obs <- unpad_blocks xs; if (obs <> None) { cs <@ F.f(oget obs, n * r); (* size cs = n * r *) ys <- bits2blocks cs; diff --git a/proof/Common.ec b/proof/Common.ec index f60a782..14fe129 100644 --- a/proof/Common.ec +++ b/proof/Common.ec @@ -155,277 +155,82 @@ op blocks2bits (xs:block list) : bool list = op bits2blocks (xs:bool list) : block list = map bits2w (chunk xs). -lemma block2bitsK : cancel blocks2bits bits2blocks. +lemma blocks2bitsK : cancel blocks2bits bits2blocks. proof. move=> xs;rewrite /blocks2bits /bits2blocks flattenK. + by move=> b /mapP [x [_ ->]];rewrite /w2bits -Array.sizeE size_word. rewrite -map_comp -{2}(map_id xs) /(\o) /=;apply eq_map=> @/idfun x /=;apply oflistK. qed. -(* -(* -------------------------------------------------------------------- *) -(* if size cs < r, then size (chunk_aux (xs, cs) b).`2 < r *) -op chunk_aux : block list * bool list -> bool -> block list * bool list = - fun p b => - let (xs, cs) = p in - let ds = rcons cs b in - if size ds = r - then (rcons xs (bits2w ds), []) - else (xs, ds). - -(* size (chunk bs).`2 < r *) -op chunk : bool list -> block list * bool list = - foldl chunk_aux ([], []). - -op flatten (p : block list * bool list) : bool list = - flatten(map w2bits p.`1) ++ p.`2. - -lemma chunk_aux_flatten (xs : block list, cs : bool list, bs : bool list) : - size cs < r => - flatten (foldl chunk_aux (xs, cs) bs) = - flatten(map w2bits xs) ++ cs ++ bs. +lemma bits2blocksK (bs : bool list) : + r %| size bs => blocks2bits(bits2blocks bs) = bs. proof. -move: bs xs cs. -elim. -(* basis step *) -move=> xs cs siz_cs_lt_r. -have -> : foldl chunk_aux (xs, cs) [] = (xs, cs) by trivial. -rewrite /flatten /=. -rewrite - catA. -rewrite cats0 //. -(* inductive step *) -move=> x l IH xs cs siz_cs_lt_r /=. -rewrite {2} /chunk_aux /=. -case (size cs = r - 1) => siz_cs_eq_r_min1. -have -> : size(rcons cs x) = r by smt. -simplify. -have -> : - flatten (map w2bits xs) ++ cs ++ x :: l = - flatten (map w2bits xs) ++ (rcons cs x) ++ l by smt. -rewrite (IH (rcons xs (bits2w (rcons cs x))) []). - smt. -have -> : - map w2bits (rcons xs (bits2w (rcons cs x))) = - rcons (map w2bits xs) (rcons cs x) by smt. -rewrite - cats1. -smt. -have : size cs < r - 1 by smt. -move=> siz_cs_lt_r_min1. -clear siz_cs_lt_r siz_cs_eq_r_min1. -have : !(size(rcons cs x) = r) by smt. -move=> H. -rewrite H /=. -rewrite (IH xs (rcons cs x)). - smt. -smt. +move=> siz_bs_div_r. +rewrite /blocks2bits /bits2blocks -map_comp. +cut map_tolistK : + forall (xss : bool list list), + (forall (xs : bool list), mem xss xs => size xs = r) => + map (w2bits \o bits2w) xss = xss. + + elim => [// | xs yss ih mem_xs_cons_yss_siz_r /=]. + + split. + + apply tolistK; rewrite mem_xs_cons_yss_siz_r //. + + apply ih => zs mem_zss_zs. + + by rewrite mem_xs_cons_yss_siz_r /=; first right; assumption. +rewrite map_tolistK; [apply in_chunk_size | exact chunkK]. qed. -lemma chunk_flatten : cancel chunk flatten. -proof. -rewrite /cancel => p. -rewrite /chunk. -rewrite chunk_aux_flatten. -smt. -smt. -qed. +op pad2blocks : bool list -> block list = bits2blocks \o pad. +op unpad_blocks : block list -> bool list option = unpad \o blocks2bits. -lemma foldl_chunk_aux_add_bits (ys : block list, cs, ds : bool list) : - size ds + size cs < r => - foldl chunk_aux (ys, ds) cs = (ys, ds ++ cs). +lemma pad2blocksK : pcancel pad2blocks unpad_blocks. proof. -move: ys ds. -elim cs. -smt. -move=> c cs IH ys ds siz_ys_plus_c_cs_lt_r. -have -> : - foldl chunk_aux (ys, ds) (c :: cs) = - foldl chunk_aux (ys, rcons ds c) cs. - simplify. - have -> : chunk_aux (ys, ds) c = (ys, rcons ds c). - rewrite /chunk_aux. - simplify. - smt. - reflexivity. -rewrite (IH ys (rcons ds c)). -smt. -smt. +move=> xs. +rewrite /pad2blocks /unpad_blocks /(\o) bits2blocksK + 1:size_pad_dvd_r padK //. qed. -lemma foldl_chunk_aux_new_block (ys : block list, cs, ds : bool list) : - cs <> [] => size ds + size cs = r => - foldl chunk_aux (ys, ds) cs = (rcons ys (bits2w(ds ++ cs)), []). +lemma unpadBlocksK : ocancel unpad_blocks pad2blocks. proof. -move=> cs_nonnil siz. -cut cs_form : exists (es, fs : bool list), - size es = size cs - 1 /\ - size fs = 1 /\ - cs = es ++ fs. - exists (take (size cs - 1) cs), (drop (size cs - 1) cs). - smt. -elim cs_form => es fs [H1 [H2 H3]]. -cut fs_form : exists (f : bool), fs = [f]. - exists (nth false fs 0). - smt. -elim fs_form => f H4. -rewrite H3 H4. -rewrite foldl_cat. -rewrite foldl_chunk_aux_add_bits. -smt. -cut -> : - foldl chunk_aux (ys, ds ++ es) [f] = - chunk_aux (ys, ds ++ es) f. - trivial. -rewrite /chunk_aux. -smt. +move=> xs; rewrite /pad2blocks /unpad_blocks /(\o). +pose bs := blocks2bits xs. +case (unpad bs = None) => [-> // | unpad_bs_neq_None]. +cut unpad_bs : unpad bs = Some(oget(unpad bs)) by rewrite /#. +rewrite unpad_bs /=. +cut -> : pad(oget(unpad bs)) = bs by rewrite - {2} (unpadK bs) unpad_bs //. +rewrite /bs blocks2bitsK //. qed. -lemma flatten_chunk_aux (xs, ys : block list, cs : bool list) : - size cs < r => - foldl chunk_aux (ys, []) (flatten(xs, cs)) = (ys ++ xs, cs). -proof. -move: cs ys. -elim xs. -(* basis step *) -move=> cs ys siz_cs_lt_r. -have -> : flatten([], cs) = cs by smt. -rewrite foldl_chunk_aux_add_bits. -smt. -smt. -(* inductive step *) -move=> x xs IH cs ys siz_cs_lt_r. -have -> : flatten(x :: xs, cs) = w2bits x ++ flatten (xs, cs) by (* smt *) admit. -rewrite foldl_cat. -rewrite foldl_chunk_aux_new_block. -smt ml=0. -smt. -have -> : bits2w([] ++ w2bits x) = x by smt. -rewrite (IH cs (rcons ys x)). -assumption. -smt. -qed. +(* ------------------------ Extending/Stripping ----------------------- *) -lemma flatten_chunk (xs, ys : block list, cs : bool list) : - size cs < r => - chunk(flatten(xs, cs)) = (xs, cs). -proof. -move=> siz_cs_lt_r. -rewrite /chunk. -rewrite (flatten_chunk_aux xs [] cs). -assumption. -smt. -qed. +op extend (xs : block list) (n : int) = + xs ++ nseq n b0. -pred valid_block (xs : block list) = - exists (ys : bool list, n : int), - 0 <= n < r /\ - flatten(map w2bits xs) = ys ++ [true] ++ nseq n false ++ [true]. - - - -op pad : bool list -> block list = - fun bs => - let (xs, cs) = chunk bs in - let siz_cs = size cs in (* siz_cs < r *) - if 2 <= r - siz_cs - then rcons xs - (bits2w(cs ++ - [true] ++ - nseq (r - siz_cs - 2) false ++ - [true])) - else (* r - siz_cs = 1 *) - xs ++ [bits2w(rcons cs true)] ++ - [bits2w(rcons (nseq (r - 1) false) true)]. - -(* unpad_aux returns None if its argument xs doesn't end with true and - have at least one other occurrence of true; otherwise, it returns - Some of the result of removing the shortest suffix of xs containing - two occurrences of true *) -op unpad_aux : bool list -> bool list option = - fun xs => - let ys = rev xs in - if !(head false ys) - then None - else let zs = behead ys in - let i = find ((=) true) zs in - if i = size zs - then None - else Some(rev(drop (i + 1) zs)). - -op unpad : block list -> bool list option = - fun xs => unpad_aux(flatten(map w2bits xs)). - -lemma pad_valid (bs : bool list) : valid_block(pad bs). -proof. -admit. -qed. +op strip (xs : block list) = + let i = find (fun x => x <> b0) (rev xs) in + (take (size xs - i) xs, i). -lemma valid_block (xs : block list) : - unpad xs <> None <=> valid_block xs. +lemma extendK (xs : block list) (n : int) : + last b0 xs <> b0 => 0 <= n => + strip(extend xs n) = (xs, n). proof. -admit. +admit. (* proof in progress *) qed. -lemma pad_unpad : pcancel pad unpad. +lemma stripK (xs : block list) : + let (ys, n) = strip xs in + extend ys n = xs. proof. -rewrite /pcancel. -admit. +admit. (* proof in progress *) qed. -lemma unpad_pad : ocancel unpad pad. -proof. -rewrite /ocancel. -admit. -qed. -*) -(* ------------------------ Extending/Stripping ----------------------- *) +(*------------------------------ Validity ----------------------------- *) +(* in TopLevel *) +op valid_toplevel (_ : bool list) = true. -op valid_block (xs : block list) = - unpad (flatten (map w2bits xs)) <> None. -(* extend xs n returns None if xs doesn't unpad successfully; - otherwise, it returns the result of adding n copies of b0 to the - end of xs (n < 0 is treated as n = 0) *) - -op extend (xs:block list) (n:int): block list option = - if unpad (flatten (map w2bits xs)) = None then None - else Some(xs ++ nseq n b0). - -op extend_uncur (p:block list * int): block list option = - extend p.`1 p.`2. - -(* strip returns None if removing the longest suffix of zerow's from its - argument yields a block list that cannot be unpadded; otherwise, it - removes the longest suffix of zerow's from its argument and returns - the pair of the resulting block list with the number of zerow's - removed *) -op strip (xs:block list): (block list * int)option = - let ys = rev xs in - let i = find (fun x => x <> b0) ys in - if i = size xs then None - else - let zs = rev(drop i ys) in - if valid_block zs then Some(zs, i) - else None. - - -pred valid_absorb (xs : block list) = - exists (ys : block list, n : int), - 0 <= n /\ valid_block ys /\ xs = ys ++ nseq n b0. - -lemma valid_absorb (xs : block list) : - strip xs <> None <=> valid_absorb xs. -proof. -admit. -qed. +(* in Block *) +op valid_block (xs : block list) = unpad_blocks xs <> None. -lemma extend_strip (xs : block list, n : int) : - oapp strip (Some(xs, max n 0)) (extend xs n) = Some(xs, max n 0). -proof. -admit. -qed. - -lemma strip_extend (xs : block list) : - oapp extend_uncur (Some xs) (strip xs) = Some xs. -proof. -admit. -qed. +(* in Absorb *) +op valid_absorb (xs : block list) = + let (ys, n) = strip xs in valid_block ys. diff --git a/proof/TopLevel.ec b/proof/TopLevel.ec index 37e77a1..2d724c5 100644 --- a/proof/TopLevel.ec +++ b/proof/TopLevel.ec @@ -8,8 +8,8 @@ require import Common. (* -------------------------------------------------------------------- *) clone import IRO as BIRO with type from <- bool list, - type to <- bool, - op valid (x : bool list) <- true. + type to <- bool, + op valid <- valid_toplevel. (* -------------------------------------------------------------------- *) clone include Indifferentiability with From fd31e6918e82365f72401820f7c9f60dc57a5e30 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Wed, 2 Dec 2015 08:37:35 -0500 Subject: [PATCH 061/525] Simplify proof using newly introduced size_tolist. Other nits. --- proof/Common.ec | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/proof/Common.ec b/proof/Common.ec index 14fe129..fd10f1c 100644 --- a/proof/Common.ec +++ b/proof/Common.ec @@ -158,8 +158,9 @@ op bits2blocks (xs:bool list) : block list = lemma blocks2bitsK : cancel blocks2bits bits2blocks. proof. move=> xs;rewrite /blocks2bits /bits2blocks flattenK. - + by move=> b /mapP [x [_ ->]];rewrite /w2bits -Array.sizeE size_word. - rewrite -map_comp -{2}(map_id xs) /(\o) /=;apply eq_map=> @/idfun x /=;apply oflistK. + + by move=> b /mapP [x [_ ->]];rewrite size_tolist. + rewrite -map_comp -{2}(map_id xs) /(\o) /=;apply eq_map=> @/idfun x /=; + apply oflistK. qed. lemma bits2blocksK (bs : bool list) : @@ -194,7 +195,8 @@ proof. move=> xs; rewrite /pad2blocks /unpad_blocks /(\o). pose bs := blocks2bits xs. case (unpad bs = None) => [-> // | unpad_bs_neq_None]. -cut unpad_bs : unpad bs = Some(oget(unpad bs)) by rewrite /#. +cut unpad_bs : unpad bs = Some(oget(unpad bs)) + by move: unpad_bs_neq_None; case (unpad bs)=> //. rewrite unpad_bs /=. cut -> : pad(oget(unpad bs)) = bs by rewrite - {2} (unpadK bs) unpad_bs //. rewrite /bs blocks2bitsK //. @@ -233,4 +235,4 @@ op valid_block (xs : block list) = unpad_blocks xs <> None. (* in Absorb *) op valid_absorb (xs : block list) = - let (ys, n) = strip xs in valid_block ys. + let (ys, _) = strip xs in valid_block ys. From 95741e509f9082fb8e43b9aa17f4c9a5776a34d1 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Thu, 3 Dec 2015 19:31:16 -0500 Subject: [PATCH 062/525] (1) Proved the cancellation lemmas for extend/strip: extendK and stripK. --- (2) Put some useful lemmas in Auxiliary.ec: (* go in Int.ec? *) lemma leltz (y x z : int) : x <= y < z => x < z. proof. move=> [/lez_eqVlt [-> // | lt_xy lt_yz]]; exact (ltz_trans y). qed. (* go in Int.ec? *) lemma ltlez (y x z : int) : x < y <= z => x < z. proof. move=> [lt_xy /lez_eqVlt [<- // | lt_yz]]; exact (ltz_trans y). qed. (* go in List.ec? *) lemma last_rev ['a] (x0 : 'a) (xs : 'a list) : last x0 (rev xs) = head x0 xs. proof. elim xs=> [| x xs ih]; [rewrite rev_nil // | rewrite rev_cons lastrcons //]. qed. (* go in List.ec? *) lemma head_nonnil ['a] (x0 : 'a) (xs : 'a list) : head x0 xs <> x0 => xs <> []. proof. case (xs)=> //. qed. --- proof/Auxiliary.ec | 27 +++++++++++++++++++++ proof/Common.ec | 60 ++++++++++++++++++++++++++++++++++++++++------ 2 files changed, 80 insertions(+), 7 deletions(-) create mode 100644 proof/Auxiliary.ec diff --git a/proof/Auxiliary.ec b/proof/Auxiliary.ec new file mode 100644 index 0000000..337452e --- /dev/null +++ b/proof/Auxiliary.ec @@ -0,0 +1,27 @@ +(* ------------------------- Auxiliary Lemmas ------------------------- *) + +require import Bool Int List. + +(* go in Int.ec? *) +lemma leltz (y x z : int) : x <= y < z => x < z. +proof. +move=> [/lez_eqVlt [-> // | lt_xy lt_yz]]; exact (ltz_trans y). +qed. + +(* go in Int.ec? *) +lemma ltlez (y x z : int) : x < y <= z => x < z. +proof. +move=> [lt_xy /lez_eqVlt [<- // | lt_yz]]; exact (ltz_trans y). +qed. + +(* go in List.ec? *) +lemma last_rev ['a] (x0 : 'a) (xs : 'a list) : + last x0 (rev xs) = head x0 xs. +proof. +elim xs=> [| x xs ih]; [rewrite rev_nil // | rewrite rev_cons lastrcons //]. +qed. + +(* go in List.ec? *) +lemma head_nonnil ['a] (x0 : 'a) (xs : 'a list) : + head x0 xs <> x0 => xs <> []. +proof. case (xs)=> //. qed. diff --git a/proof/Common.ec b/proof/Common.ec index fd10f1c..2e740fe 100644 --- a/proof/Common.ec +++ b/proof/Common.ec @@ -3,6 +3,7 @@ require import Option Fun Pair Int IntExtra IntDiv Real List NewDistr. require import Ring StdRing StdOrder StdBigop BitEncoding. require (*--*) FinType BitWord LazyRP Monoid. (*---*) import IntID IntOrder Bigint Bigint.BIA IntDiv. +require import Auxiliary. (* -------------------------------------------------------------------- *) op r : { int | 2 <= r } as ge2_r. @@ -168,7 +169,7 @@ lemma bits2blocksK (bs : bool list) : proof. move=> siz_bs_div_r. rewrite /blocks2bits /bits2blocks -map_comp. -cut map_tolistK : +have map_tolistK : forall (xss : bool list list), (forall (xs : bool list), mem xss xs => size xs = r) => map (w2bits \o bits2w) xss = xss. @@ -195,10 +196,10 @@ proof. move=> xs; rewrite /pad2blocks /unpad_blocks /(\o). pose bs := blocks2bits xs. case (unpad bs = None) => [-> // | unpad_bs_neq_None]. -cut unpad_bs : unpad bs = Some(oget(unpad bs)) +have unpad_bs : unpad bs = Some(oget(unpad bs)) by move: unpad_bs_neq_None; case (unpad bs)=> //. rewrite unpad_bs /=. -cut -> : pad(oget(unpad bs)) = bs by rewrite - {2} (unpadK bs) unpad_bs //. +have -> : pad(oget(unpad bs)) = bs by rewrite - {2} (unpadK bs) unpad_bs //. rewrite /bs blocks2bitsK //. qed. @@ -212,17 +213,62 @@ op strip (xs : block list) = (take (size xs - i) xs, i). lemma extendK (xs : block list) (n : int) : - last b0 xs <> b0 => 0 <= n => - strip(extend xs n) = (xs, n). + last b0 xs <> b0 => 0 <= n => strip(extend xs n) = (xs, n). proof. -admit. (* proof in progress *) +move=> xs_ends_not_b0 ge0_n. +rewrite /strip /extend /= rev_cat rev_nseq size_cat size_nseq max_ler // + subzE - addzA. +have head_rev_xs_neq_b0 : head b0 (rev xs) <> b0 by rewrite - last_rev revK //. +have -> : rev xs = head b0 (rev xs) :: behead (rev xs) + by rewrite head_behead //; exact (head_nonnil b0 (rev xs)). +pose p := fun (x : block) => x <> b0. +have has_p_full : has p (nseq n b0 ++ head b0 (rev xs) :: behead (rev xs)) + by apply has_cat; right; simplify; left. +have not_has_p_nseq : ! has p (nseq n b0) by rewrite has_nseq. +have -> : find p (nseq n b0 ++ head b0 (rev xs) :: behead (rev xs)) = n. + rewrite find_cat not_has_p_nseq /= size_nseq max_ler //. + have -> // : p (head b0 (rev xs)) by trivial. +by rewrite (addzC n) addNz /= take_size_cat. qed. lemma stripK (xs : block list) : let (ys, n) = strip xs in extend ys n = xs. proof. -admit. (* proof in progress *) +rewrite /strip /extend /=. +pose p := fun x => x <> b0. +pose i := find p (rev xs). +have [i_low i_upp] : 0 <= i <= size xs + by split; [apply find_ge0 | move=> _; rewrite - size_rev find_size]. +have i_upp' : 0 <= size xs - i by rewrite subz_ge0 //. +have {3} <- : + take (size xs - i) xs ++ drop (size xs - i) xs = xs by apply cat_take_drop. +have siz_drop : size(drop (size xs - i) xs) = i. + rewrite size_drop 1 : i_upp'. + have -> : size xs - (size xs - i) = i by algebra. + apply max_ler; first apply i_low. +have drop_eq_b0 : + forall (j : int), + 0 <= j < i => nth b0 (drop (size xs - i) xs) j = b0. + move=> j [j_low j_upp]. + have [i_min_j_min_1_low i_min_j_min_1_upp] : 0 <= i - j - 1 < i. + split => [|_]. + rewrite - subz_gt0 - lez_add1r in j_upp; rewrite subz_ge0 //. + rewrite - subz_gt0. + have -> : i - (i - j - 1) = j + 1 by algebra. + by rewrite - lez_add1r addzC addzA lez_add2r. + rewrite nth_drop //. + have -> : size xs - i + j = size xs - ((i - j - 1) + 1) by algebra. + rewrite - (nth_rev b0 (i - j - 1) xs). + split=> [//| _]; exact (ltlez i). + have -> : + (nth b0 (rev xs) (i - j - 1) = b0) = !p(nth b0 (rev xs) (i - j - 1)) + by trivial. + exact before_find. +have <- // : drop (size xs - i) xs = nseq i b0. + apply (eq_from_nth b0)=> [| j rng_j]. + rewrite siz_drop size_nseq max_ler //. + rewrite siz_drop in rng_j; rewrite nth_nseq //; exact drop_eq_b0. qed. (*------------------------------ Validity ----------------------------- *) From 848e223ce830509abae6bfc16a6b6208fd7b4976 Mon Sep 17 00:00:00 2001 From: Pierre-Yves Strub Date: Fri, 4 Dec 2015 09:07:10 +0100 Subject: [PATCH 063/525] Prune Auxiliary.ec + fix proofs w.r.t. name changes in the stdlib. Only last_rev has been kept. Other ones are either present in the standard library (see Number.eca && the search command), or does not qualify for having a name as their application is harder than directly calling the relevant tactic. --- proof/Auxiliary.ec | 27 --------------------------- proof/Common.ec | 13 ++++++------- 2 files changed, 6 insertions(+), 34 deletions(-) delete mode 100644 proof/Auxiliary.ec diff --git a/proof/Auxiliary.ec b/proof/Auxiliary.ec deleted file mode 100644 index 337452e..0000000 --- a/proof/Auxiliary.ec +++ /dev/null @@ -1,27 +0,0 @@ -(* ------------------------- Auxiliary Lemmas ------------------------- *) - -require import Bool Int List. - -(* go in Int.ec? *) -lemma leltz (y x z : int) : x <= y < z => x < z. -proof. -move=> [/lez_eqVlt [-> // | lt_xy lt_yz]]; exact (ltz_trans y). -qed. - -(* go in Int.ec? *) -lemma ltlez (y x z : int) : x < y <= z => x < z. -proof. -move=> [lt_xy /lez_eqVlt [<- // | lt_yz]]; exact (ltz_trans y). -qed. - -(* go in List.ec? *) -lemma last_rev ['a] (x0 : 'a) (xs : 'a list) : - last x0 (rev xs) = head x0 xs. -proof. -elim xs=> [| x xs ih]; [rewrite rev_nil // | rewrite rev_cons lastrcons //]. -qed. - -(* go in List.ec? *) -lemma head_nonnil ['a] (x0 : 'a) (xs : 'a list) : - head x0 xs <> x0 => xs <> []. -proof. case (xs)=> //. qed. diff --git a/proof/Common.ec b/proof/Common.ec index 2e740fe..a2448b1 100644 --- a/proof/Common.ec +++ b/proof/Common.ec @@ -3,7 +3,6 @@ require import Option Fun Pair Int IntExtra IntDiv Real List NewDistr. require import Ring StdRing StdOrder StdBigop BitEncoding. require (*--*) FinType BitWord LazyRP Monoid. (*---*) import IntID IntOrder Bigint Bigint.BIA IntDiv. -require import Auxiliary. (* -------------------------------------------------------------------- *) op r : { int | 2 <= r } as ge2_r. @@ -67,13 +66,13 @@ lemma rev_mkpad n : rev (mkpad n) = mkpad n. proof. by rewrite /mkpad rev_cons rev_rcons rev_nseq. qed. lemma last_mkpad b n : last b (mkpad n) = true. -proof. by rewrite !(lastcons, lastrcons). qed. +proof. by rewrite !(last_cons, last_rcons). qed. lemma head_mkpad b n : head b (mkpad n) = true. proof. by []. qed. lemma last_pad b s : last b (pad s) = true. -proof. by rewrite lastcat last_mkpad. qed. +proof. by rewrite last_cat last_mkpad. qed. lemma size_mkpad n : size (mkpad n) = (-(n+2)) %% r + 2. proof. @@ -127,7 +126,7 @@ qed. lemma unpadK : ocancel unpad pad. proof. move=> s @/unpad; case: (last false s) => //=. -elim/last_ind: s=> //= s b ih {ih}; rewrite lastrcons => hb. +elim/last_ind: s=> //= s b ih {ih}; rewrite last_rcons => hb. rewrite rev_rcons /= size_rcons -(inj_eq _ (addIr (-1))) /= ?addrK. pose i := index _ _; case: (i = size s) => //=. move=> ne_is @/pad; pose j := _ - (i+2); apply/eq_sym. @@ -219,8 +218,8 @@ move=> xs_ends_not_b0 ge0_n. rewrite /strip /extend /= rev_cat rev_nseq size_cat size_nseq max_ler // subzE - addzA. have head_rev_xs_neq_b0 : head b0 (rev xs) <> b0 by rewrite - last_rev revK //. -have -> : rev xs = head b0 (rev xs) :: behead (rev xs) - by rewrite head_behead //; exact (head_nonnil b0 (rev xs)). +have -> : rev xs = head b0 (rev xs) :: behead (rev xs). + by rewrite head_behead //; case: (rev xs) head_rev_xs_neq_b0. pose p := fun (x : block) => x <> b0. have has_p_full : has p (nseq n b0 ++ head b0 (rev xs) :: behead (rev xs)) by apply has_cat; right; simplify; left. @@ -260,7 +259,7 @@ have drop_eq_b0 : rewrite nth_drop //. have -> : size xs - i + j = size xs - ((i - j - 1) + 1) by algebra. rewrite - (nth_rev b0 (i - j - 1) xs). - split=> [//| _]; exact (ltlez i). + split=> [//| _]; exact/(ltr_le_trans i). have -> : (nth b0 (rev xs) (i - j - 1) = b0) = !p(nth b0 (rev xs) (i - j - 1)) by trivial. From 733acad6226a78036174d1c401396e8a9549f5fb Mon Sep 17 00:00:00 2001 From: Pierre-Yves Strub Date: Fri, 4 Dec 2015 10:48:27 +0100 Subject: [PATCH 064/525] Backward chaining... --- proof/Common.ec | 53 +++++++++++++++---------------------------------- 1 file changed, 16 insertions(+), 37 deletions(-) diff --git a/proof/Common.ec b/proof/Common.ec index a2448b1..522d5d8 100644 --- a/proof/Common.ec +++ b/proof/Common.ec @@ -203,7 +203,6 @@ rewrite /bs blocks2bitsK //. qed. (* ------------------------ Extending/Stripping ----------------------- *) - op extend (xs : block list) (n : int) = xs ++ nseq n b0. @@ -231,43 +230,23 @@ by rewrite (addzC n) addNz /= take_size_cat. qed. lemma stripK (xs : block list) : - let (ys, n) = strip xs in - extend ys n = xs. + extend (strip xs).`1 (strip xs).`2 = xs. proof. -rewrite /strip /extend /=. -pose p := fun x => x <> b0. -pose i := find p (rev xs). -have [i_low i_upp] : 0 <= i <= size xs - by split; [apply find_ge0 | move=> _; rewrite - size_rev find_size]. -have i_upp' : 0 <= size xs - i by rewrite subz_ge0 //. -have {3} <- : - take (size xs - i) xs ++ drop (size xs - i) xs = xs by apply cat_take_drop. -have siz_drop : size(drop (size xs - i) xs) = i. - rewrite size_drop 1 : i_upp'. - have -> : size xs - (size xs - i) = i by algebra. - apply max_ler; first apply i_low. -have drop_eq_b0 : - forall (j : int), - 0 <= j < i => nth b0 (drop (size xs - i) xs) j = b0. - move=> j [j_low j_upp]. - have [i_min_j_min_1_low i_min_j_min_1_upp] : 0 <= i - j - 1 < i. - split => [|_]. - rewrite - subz_gt0 - lez_add1r in j_upp; rewrite subz_ge0 //. - rewrite - subz_gt0. - have -> : i - (i - j - 1) = j + 1 by algebra. - by rewrite - lez_add1r addzC addzA lez_add2r. - rewrite nth_drop //. - have -> : size xs - i + j = size xs - ((i - j - 1) + 1) by algebra. - rewrite - (nth_rev b0 (i - j - 1) xs). - split=> [//| _]; exact/(ltr_le_trans i). - have -> : - (nth b0 (rev xs) (i - j - 1) = b0) = !p(nth b0 (rev xs) (i - j - 1)) - by trivial. - exact before_find. -have <- // : drop (size xs - i) xs = nseq i b0. - apply (eq_from_nth b0)=> [| j rng_j]. - rewrite siz_drop size_nseq max_ler //. - rewrite siz_drop in rng_j; rewrite nth_nseq //; exact drop_eq_b0. +rewrite /extend /strip eq_sym /=; pose i := find _ _. +rewrite -{1}(cat_take_drop (size xs - i) xs); congr. +have [ge0_i le_ixs]: 0 <= i <= size xs. + by rewrite find_ge0 -size_rev find_size. +have sz_drop: size (drop (size xs - i) xs) = i. + rewrite size_drop ?subr_ge0 // 2!subrE opprD opprK. + by rewrite addrA addrN /= max_ler. +apply/(eq_from_nth b0) => [|j]; rewrite ?size_nseq ?max_ler //. +rewrite sz_drop=> -[ge0_j lt_ji]; rewrite nth_nseq //. +rewrite nth_drop ?subr_ge0 // -{1}revK nth_rev ?size_rev. + rewrite addr_ge0 ?subr_ge0 //= -ltr_subr_addr 2!subrE. + by rewrite ltr_add2l ltr_opp2. +have @/predC1 /= ->// := (before_find b0 (predC1 b0)). +pose s := (_ - _)%Int; rewrite -/i (_ : s = i - (j+1)) /s 1:#ring. +by rewrite subr_ge0 -ltzE lt_ji /= subrE ltr_snaddr // oppr_lt0 ltzS. qed. (*------------------------------ Validity ----------------------------- *) From 5c59f9f260ef8e4301377f0a675ad1ffc241a97b Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Sat, 5 Dec 2015 08:20:58 +0100 Subject: [PATCH 065/525] Start proof of sha3. Definition of game for bad event + game after eager. Some try in the proof --- Makefile | 2 +- proof/Common.ec | 3 +- proof/old/Squeezeless.ec | 1069 ++++++++++++++++++++++++++++---------- 3 files changed, 804 insertions(+), 270 deletions(-) diff --git a/Makefile b/Makefile index c4106b0..6111395 100644 --- a/Makefile +++ b/Makefile @@ -3,7 +3,7 @@ # -------------------------------------------------------------------- ECROOT ?= ECCHECK ?= -ECARGS ?= -I proof +ECARGS ?= -I proof -I proof/variant -I proof/old ECCONF := config/tests.config XUNITOUT ?= xunit.xml CHECKS ?= sha3 diff --git a/proof/Common.ec b/proof/Common.ec index 522d5d8..90eea5c 100644 --- a/proof/Common.ec +++ b/proof/Common.ec @@ -2,7 +2,7 @@ require import Option Fun Pair Int IntExtra IntDiv Real List NewDistr. require import Ring StdRing StdOrder StdBigop BitEncoding. require (*--*) FinType BitWord LazyRP Monoid. -(*---*) import IntID IntOrder Bigint Bigint.BIA IntDiv. +(*---*) import IntID IntOrder Bigint Bigint.BIA IntDiv Dprod. (* -------------------------------------------------------------------- *) op r : { int | 2 <= r } as ge2_r. @@ -36,7 +36,6 @@ clone export BitWord as Block with "zerow" as "b0". (* -------------------------------------------------------------------- *) -op ( * ): 'a distr -> 'b distr -> ('a * 'b) distr. clone export LazyRP as Perm with type D <- block * capacity, diff --git a/proof/old/Squeezeless.ec b/proof/old/Squeezeless.ec index ec7e0d1..d9bea41 100644 --- a/proof/old/Squeezeless.ec +++ b/proof/old/Squeezeless.ec @@ -1,42 +1,16 @@ + (** This is a theory for the Squeezeless sponge: where the ideal functionality is a fixed-output-length random oracle whose output length is the input block size. We prove its security even when padding is not prefix-free. **) -require import Fun Option Pair Int Real List FSet NewFMap Utils. -require (*..*) AWord LazyRP LazyRO Indifferentiability. -(* TODO: Clean up the Bitstring and Word theories - -- Make use of those new versions. *) -(*...*) import Dprod Dexcepted. -(* TODO: Datatype definitions and distributions should - be properly separated and reorganized. *) - -op r : { int | 0 < r } as lt0_r. -op c : { int | 0 < c } as lt0_c. - -(** Clarify assumptions on the distributions as we go. As this is currently - written, we are hiding some pretty heavy axioms behind cloning. **) -type block. -op dblock: block distr. - -clone import AWord as Block with - op length <- r, - type word <- block, - op Dword.dword <- dblock -proof leq0_length by smt. - -type capacity. -op dcapacity: capacity distr. - -clone AWord as Capacity with - op length <- c, - type word <- capacity, - op Dword.dword <- dcapacity -proof leq0_length by smt. - -type state = block * capacity. -op dstate = dblock * dcapacity. - -print Indifferentiability. +require import Pred Fun Option Pair Int Real List FSet NewFMap Utils Common. + +require (*..*) RndOrcl Indifferentiability. +(*...*) import Dprod Dexcepted Capacity. + +type state = block * capacity. +op dstate = bdistr * cdistr. + clone include Indifferentiability with type p <- state, @@ -45,27 +19,47 @@ clone include Indifferentiability with rename [module] "GReal" as "RealIndif" [module] "GIdeal" as "IdealIndif". + +(* max number of call to the permutation and its inverse *) +op max_size : int. + (** Ideal Functionality **) -clone import LazyRO as Functionality with - type from <- block list, - type to <- block, - op d <- dblock. +clone import Tuple as TupleBl with + type t <- block, + op Support.enum <- Block.words + proof Support.enum_spec by exact Block.enum_spec. -(** Ideal Primitive for the Random Transformation case **) -clone import LazyRP as Primitive with - type D <- state, - op d <- dstate. +op bl_enum = flatten (mkseq (fun i => wordn i) (max_size + 1)). +op bl_univ = FSet.oflist bl_enum. + +clone RndOrcl as RndOrclB with + type from <- block list, + type to <- block. + +clone import RndOrclB.RestrIdeal as Functionality with + op sample _ <- bdistr, + op test l <- List.size l <= max_size, + op univ <- bl_univ, + op dfl <- b0 + proof *. +realize sample_ll by exact Block.DWord.bdistr_ll. +realize testP. +proof. + move=> x; rewrite mem_oflist-flattenP; split=>[_|[s[/mkseqP[i[/=_->>]]/wordnP->/#]]]. + exists (wordn (size x));cut Hsx := size_ge0 x. + rewrite wordnP max_ler //= mkseqP /=;exists (size x);smt ml=0. +qed. (** We can now define the squeezeless sponge construction **) module SqueezelessSponge (P:PRIMITIVE): CONSTRUCTION(P), FUNCTIONALITY = { proc init () = {} proc f(p : block list): block = { - var (sa,sc) <- (Block.zeros,Capacity.zeros); + var (sa,sc) <- (b0,c0); - if (1 <= size p /\ p <> [Block.zeros]) { + if (1 <= size p /\ p <> [b0]) { while (p <> []) { (* Absorption *) - (sa,sc) <@ P.f((sa ^ head witness p,sc)); + (sa,sc) <@ P.f((sa +^ head witness p,sc)); p <- behead p; } } @@ -73,176 +67,18 @@ module SqueezelessSponge (P:PRIMITIVE): CONSTRUCTION(P), FUNCTIONALITY = { } }. -(** And the corresponding simulator **) -op find_chain: (state,state) fmap -> state -> (block list * block) option. - -module S (F : FUNCTIONALITY) = { - var m, mi: (state,state) fmap - - proc init() = { - m <- map0; - mi <- map0; - } - - proc f(x:state) = { - var pvo, p, v, h, y; - - if (!mem (dom m) x) { - pvo <- find_chain m x; - if (pvo <> None) { - (p,v) <- oget pvo; - h <@ F.f(rcons p v); - y <$ dcapacity; - } else { - (h,y) <$ dstate; - } - m.[x] <- (h,y); - mi.[(h,y)] <- x; - } - return oget m.[x]; - } - - proc fi(x:state) = { - var y; - - if (!mem (dom mi) x) { - y <$ dstate; - mi.[x] <- y; - m.[y] <- x; - } - return oget mi.[x]; - } -}. - section. - declare module D : Self.DISTINGUISHER {P, H, S}. - - (** Inlining oracles into the experiment for clarity **) - (* TODO: Drop init from the Distinguisher parameters' signatures *) - local module Ideal = { - var ro : (block list,block) fmap - var m, mi : (state,state) fmap - - module F = { - proc init(): unit = { } - - proc f(x : block list): block = { - if (!mem (dom ro) x) { - ro.[x] <$ dblock; - } - return oget ro.[x]; - } - } - - module S = { - proc init(): unit = { } - - proc f(x : state): state = { - var pvo, p, v, h, y; - - if (!mem (dom m) x) { - pvo <- find_chain m x; - if (pvo <> None) { - (p,v) <- oget pvo; - h <@ F.f(rcons p v); - y <$ dcapacity; - } else { - (h,y) <$ dstate; - } - m.[x] <- (h,y); - mi.[(h,y)] <- x; - } - return oget m.[x]; - } - - proc fi(x:state) = { - var y; - - if (!mem (dom mi) x) { - y <$ dstate; - mi.[x] <- y; - m.[y] <- x; - } - return oget mi.[x]; - } - - } - - proc main(): bool = { - var b; - - ro <- map0; - m <- map0; - mi <- map0; - b <@ D(F,S).distinguish(); - return b; - } - }. - local module Concrete = { - var m, mi: (state,state) fmap + declare module D : Self.DISTINGUISHER {Perm, RO}. - module P = { - proc init(): unit = { } - - proc f(x : state): state = { - var y; - - if (!mem (dom m) x) { - y <$ dstate \ (rng m); - m.[x] <- y; - mi.[y] <- x; - } - return oget m.[x]; - } - - proc fi(x : state): state = { - var y; - - if (!mem (dom mi) x) { - y <$ dstate \ (rng mi); - mi.[x] <- y; - m.[y] <- x; - } - return oget mi.[x]; - } - - } - - module C = { - proc init(): unit = { } - - proc f(p : block list): block = { - var (sa,sc) <- (Block.zeros,Capacity.zeros); - - if (1 <= size p /\ p <> [Block.zeros]) { - while (p <> []) { (* Absorption *) - (sa,sc) <@ P.f((sa ^ head witness p,sc)); - p <- behead p; - } - } - return sa; (* Squeezing phase (non-iterated) *) - } - } - - proc main(): bool = { - var b; - - m <- map0; - mi <- map0; - b <@ D(C,P).distinguish(); - return b; - } - }. + local module Concrete = RealIndif(SqueezelessSponge,Perm,D). (** Result: The adversary's advantage in distinguishing the modular defs is equal to that of distinguishing these **) local lemma Inlined_pr &m: - `|Pr[RealIndif(SqueezelessSponge,P,D).main() @ &m: res] - - Pr[IdealIndif(H,S,D).main() @ &m: res]| - = `|Pr[Concrete.main() @ &m: res] - - Pr[Ideal.main() @ &m: res]|. - proof. by do !congr; expect 2 (byequiv=> //=; proc; inline *; sim; auto). qed. + Pr[RealIndif(SqueezelessSponge,Perm,D).main() @ &m: res] + = Pr[Concrete.main() @ &m: res]. + proof. trivial. qed. (** An intermediate game where we don't care about the permutation being a bijection anymore... **) @@ -280,11 +116,11 @@ section. proc init(): unit = { } proc f(p : block list): block = { - var (sa,sc) <- (Block.zeros,Capacity.zeros); + var (sa,sc) <- (b0,c0); - if (1 <= size p /\ p <> [Block.zeros]) { + if (1 <= size p /\ p <> [b0]) { while (p <> []) { (* Absorption *) - (sa,sc) <@ P.f((sa ^ head witness p,sc)); + (sa,sc) <@ P.f((sa +^ head witness p,sc)); p <- behead p; } } @@ -301,6 +137,13 @@ section. return b; } }. + + op bound_concrete : real. + + local lemma Concrete_Concrete_F &m: + Pr[Concrete.main() @ &m: res] <= + Pr[Concrete_F.main() @ &m: res] + bound_concrete. + admitted. (** Result (expected): The distance between Concrete and Concrete_F is bounded by N^2/|state|, where N is the total cost (in terms @@ -333,7 +176,7 @@ section. samplings are independent, hence the move away from a random permutation. Some side-effects remain worrying. **) - type caller = [ | I | D ]. + type caller = [ I | D ]. op (<=) (o1 o2 : caller) = o1 = I \/ o2 = D. @@ -362,46 +205,521 @@ section. by split; apply/half_permutation_set. qed. -print FUNCTIONALITY. - local module Game0 = { - var m, mi : (state,state) fmap - var mcol, micol : (state,caller) fmap (* colouring maps for m, mi *) - var paths : (capacity,block list * block) fmap - var pathscol : (capacity,caller) fmap (* colouring maps for paths *) - var bext, bred : bool - var bcoll, bsuff, bmitm : bool + type handle = int. + + type hstate = block * handle. + + type ccapacity = capacity * caller. + + op hinv (handles:(handle,ccapacity) fmap) (c:capacity) = + find (fun _ => pred1 c \o fst) handles. + + op hinvD (handles:(handle,ccapacity) fmap) (c:capacity) = + find (fun _ => pred1 (c,D)) handles. + + local module G2 = { + var m, mi : (state , state ) fmap + var mh, mhi : (hstate, hstate) fmap + var handles : (handle, ccapacity) fmap + var chandle : int + var paths : (capacity, block list * block) fmap + var bext, bcol : bool + + + module C = { + proc init(): unit = { } + + proc f(p : block list): block = { + var h, i <- 0; + var (sa,sc) <- (b0,c0); + var sa'; + + if (1 <= size p /\ p <> [b0]) { + while (i < size p - 1 /\ mem (dom m) (sa +^ nth witness p i, sc)) { + (sa, sc) <- oget m.[(sa +^ nth witness p i, sc)]; + (sa', h) <- oget mh.[(sa +^ nth witness p i, h)]; + i <- i + 1; + } + while (i < size p) { + sc <$ cdistr; + bcol <- bcol \/ hinv handles sc <> None; + sa' <- RO.f(take i p); + mh.[(sa,h)] <- (sa', chandle); + mhi.[(sa',chandle)] <- (sa,h); + (sa,h) <- (sa',chandle); + handles.[chandle] <- (sc,I); + chandle <- chandle + 1; + i <- i + 1; + } + sa <- RO.f(p); + } + return sa; + } + } module S = { (** Inner interface **) - proc fg(o : caller, x : state): state = { - var o', y, pv, p, v; + proc f(x : state): state = { + var p, v, y, y1, y2, hy2, hx2; + + if (!mem (dom m) x) { + if (mem (dom paths) x.`2) { + (p,v) <- oget paths.[x.`2]; + y1 <- RO.f (rcons p (v +^ x.`1)); + y2 <$ cdistr; + y <- (y1, y2); + paths.[y2] <- (rcons p (v +^ x.`1), y.`1); + } else { + y <$ dstate; + } + bext <- bext \/ mem (rng handles) (x.`2, I); + (* exists x2 h, handles.[h] = Some (X2,I) *) + if (!(mem (rng handles) (x.`2, D))) { + handles.[chandle] <- (x.`2, D); + chandle <- chandle + 1; + } + hx2 <- oget (hinvD handles x.`2); + if (mem (dom mh) (x.`1, hx2) /\ (oget handles.[(oget mh.[(x.`1,hx2)]).`2]).`2 = I) { + hy2 <- (oget mh.[(x.`1, hx2)]).`2; + y <- (y.`1, (oget handles.[hy2]).`1); + handles.[hy2] <- (y.`2, D); + (* bad <- bad \/ mem X2 y.`2; *) + m.[x] <- y; + mi.[y] <- x; + } else { + bcol <- bcol \/ hinv handles y.`2 <> None; + hy2 <- chandle; + chandle <- chandle + 1; + handles.[hy2] <- (y.`2, D); + m.[x] <- y; + mh.[(x.`1, hx2)] <- (y.`1, hy2); + mi.[y] <- x; + mhi.[(y.`1, hy2)] <- (x.`1, hx2); + } + } else { + y <- oget m.[x]; + } + return y; + } - o' <- odflt D pathscol.[x.`2]; - bext <- bext \/ (o' <= o); + proc fi(x : state): state = { + var y, y1, hx2, hy2; + + if (!mem (dom mi) x) { + bext <- bext \/ mem (rng handles) (x.`2, I); + (* exists x2 h, handles.[h] = Some (X2,I) *) + if (!(mem (rng handles) (x.`2, D))) { + handles.[chandle] <- (x.`2, D); + chandle <- chandle + 1; + } + hx2 <- oget (hinvD handles x.`2); + y <$ dstate; + if (mem (dom mhi) (x.`1, hx2) /\ (oget handles.[(oget mh.[(x.`1,hx2)]).`2]).`2 = I) { + (y1,hy2) <- oget mhi.[(x.`1, hx2)]; + y <- (y.`1, (oget handles.[hy2]).`1); + handles.[hy2] <- (y.`2, D); + (* bad <- bad \/ mem X2 y.`2; *) + mi.[x] <- y; + mhi.[(x.`1, hx2)] <- (y.`1, hy2); + m.[y] <- x; + mh.[(y.`1, hy2)] <- (x.`1, hx2); + } else { + bcol <- bcol \/ hinv handles y.`2 <> None; + hy2 <- chandle; + chandle <- chandle + 1; + handles.[hy2] <- (y.`2, D); + mi.[x] <- y; + mhi.[(x.`1, hx2)] <- (y.`1, hy2); + m.[y] <- x; + mh.[(y.`1, hy2)] <- (x.`1, hx2); + } + } else { + y <- oget mi.[x]; + } + return y; + } + + (** Distinguisher interface **) + proc init() = { } + + } + + + proc main(): bool = { + var b; + + m <- map0; + mi <- map0; + bext <- false; + bcol <- false; + + (* the empty path is initially known by the adversary to lead to capacity 0^c *) + handles <- map0.[0 <- (c0, D)]; + paths <- map0.[c0 <- ([<:block>],b0)]; + chandle <- 1; + b <@ D(C,S).distinguish(); + return b; + } + }. + +op INV2 (m mi:(state , state ) fmap) (mh mhi:(hstate, hstate) fmap) (handles:(handle, ccapacity) fmap) chandle = + dom mh = rng mhi /\ dom mhi = rng mh /\ + (forall xh, mem (dom mh `|` rng mh) xh => mem (dom handles) xh.`2) /\ + (forall h, mem (dom handles) h => h < chandle) /\ + (forall xh, mem (dom mh) xh => mem (dom m) (xh.`1, (oget handles.[xh.`2]).`1) \/ (oget handles.[xh.`2]).`2 = I) /\ + (forall xh, mem (dom mhi) xh => mem (dom mi) (xh.`1, (oget handles.[xh.`2]).`1) \/ (oget handles.[xh.`2]).`2 = I). + +lemma get_oget (m:('a,'b)fmap) (x:'a) : mem (dom m) x => m.[x] = Some (oget m.[x]). +proof. by rewrite in_dom;case (m.[x]). qed. + +lemma find_set (m:('a,'b) fmap) y x (p:'a -> 'b -> bool): + (forall x, mem (dom m) x => !p x (oget m.[x])) => + find p m.[x <- y] = if p x y then Some x else None. +proof. + cut [[a []->[]] | []-> Hp Hnp]:= findP p (m.[x<-y]);1: rewrite getP dom_set !inE /#. + by case (p x y)=> //; cut := Hp x;rewrite getP dom_set !inE /= oget_some. +qed. + +require import StdOrder. +require import Ring. + +lemma hinvD_rng x (handles:(handle, ccapacity) fmap): + mem (rng handles) (x, D) => + handles.[oget (hinvD handles x)]= Some(x, D). +proof. + cut[ [a []->[]] | []->/=Hp ]/=:= findP (fun _ z => z = (x, D)) handles. + + by rewrite oget_some=> ? <- _;apply get_oget. + by rewrite in_rng=> [a Ha];cut := Hp a; rewrite in_dom Ha oget_some. +qed. + +(* TODO: change the name *) +lemma map_perm (m mi: ('a, 'a) fmap) x y: !mem (dom mi) y => dom m = rng mi => dom m.[x<-y] = rng mi.[y<- x]. +proof. + move=> Hdom Heq;rewrite fsetP=> w;rewrite dom_set in_rng !inE;split. + + rewrite Heq in_rng. case (w=x)=>[->|Hneq/=[a Ha]];1:by exists y;rewrite getP. + exists a;rewrite getP;case (a=y)=>[->>|//]. + by move:Hdom;rewrite in_dom Ha. + rewrite Heq in_rng;by move=>[a];rewrite getP;case(a=y)=>[->>/# |_ <-];left;exists a. +qed. + +local hoare test_f : G2.S.f : INV2 G2.m G2.mi G2.mh G2.mhi G2.handles G2.chandle (*/\ INV2 G2.mi G2.mhi G2.handles*) ==> + INV2 G2.m G2.mi G2.mh G2.mhi G2.handles G2.chandle. +proof. + proc;if;last by auto. + auto;conseq (_ :_ ==> true)=> //. + move=> &hr [][]Hmhmhi[]Hmhimh[]Hdomh[]Hhbound[]Hmhor Hmhior Hnmem y _;split;beta iota. + + move=> Hnrng handles chandle hx2 @/handles. + cut ->>{hx2} : hx2 = G2.chandle{hr}. + + rewrite /hx2 /handles /hinvD find_set /pred1 //=. + move=> x2 Hx2;cut := Hnrng;rewrite in_rng NewLogic.negb_exists /= => /(_ x2). + by rewrite get_oget. + split=> /= [[Hmem _] | Hmem]. + + by cut /Hhbound // := Hdomh (x{hr}.`1, G2.chandle{hr}) _; rewrite inE;left. + do !apply andI. + + apply map_perm=> //;rewrite -not_def=> H. + by cut /#:= Hhbound chandle _;apply (Hdomh (y.`1,chandle));rewrite !inE -Hmhimh H. + + apply map_perm=> //;rewrite -not_def=> H. + by cut /#:= Hhbound G2.chandle{hr} _;apply (Hdomh (x{hr}.`1,G2.chandle{hr}));rewrite !inE H. + + move=>[x1 h];cut := Hdomh (x1,h). + rewrite !(dom_set, rng_set, inE) /==>H1 [[H2|[_->]]|[/rng_rem_le H2|[_->]]]//; + by rewrite H1 ?H2. + + by move=> h;cut := Hhbound h;rewrite !dom_set !inE /= => H [[/H|]|->>]/#. + + move=>[x1 h];rewrite !getP !dom_set !inE /==>[|[]->> ->>];rewrite /chandles /=. + + move=>Hh. cut /Hhbound/=:= Hdomh (x1,h) _;1:by rewrite !inE Hh. + move=> ^Hlt /IntOrder.gtr_eqF; rewrite eq_sym=>->. + by cut ->/#: h <> G2.chandle{hr} + 1 by smt ml=0. + cut ->/=: G2.chandle{hr} <> G2.chandle{hr} + 1 by smt ml=0. + by rewrite oget_some /#. + move=>[x1 h];rewrite !getP !dom_set !inE /==>[|[]->> ->>];rewrite /chandles /=. + + move=>Hh; cut /Hhbound/=:= Hdomh (x1,h) _;1:by rewrite !inE -Hmhimh Hh. + move=> ^Hlt /IntOrder.gtr_eqF; rewrite eq_sym=>->. + by cut ->/#: h <> G2.chandle{hr} + 1 by smt ml=0. + by rewrite oget_some /#. + move=> /= Hrng;cut Hget:= hinvD_rng _ _ Hrng;split=> /=. + + move=> []/Hmhor /= [] ; rewrite Hget oget_some /#. + move=> Hnot;do !apply andI. + + apply map_perm=> //;rewrite -not_def=> H. + by cut /#:= Hhbound G2.chandle{hr} _;apply (Hdomh (y.`1,G2.chandle{hr})); + rewrite !inE -Hmhimh H. + + apply map_perm=> //;rewrite -not_def=> H. + by cut := Hmhor _ H;move: Hnmem;rewrite Hget oget_some /=;case (x{hr}). + + move=> [x1 h];rewrite !(dom_set,rng_set, inE) => [[H|[_ ->]]| [/rng_rem_le H|[_->]]]//=. + + by left;apply (Hdomh (x1,h));rewrite inE H. + + by left;rewrite in_dom Hget. + by left;apply (Hdomh (x1,h));rewrite inE H. + + by move=>h;rewrite dom_set !inE=> [/Hhbound|->]/#. + + move=> [x1 h];rewrite !(dom_set, getP, inE) /==>[H|[->> ->>]]. + + by cut /IntOrder.ltr_eqF->/#:= Hhbound h _;1:by apply (Hdomh (x1,h));rewrite inE H. + cut ->/=:oget (hinvD G2.handles{hr} x{hr}.`2) <> G2.chandle{hr}. + + by cut /#:= Hhbound (oget (hinvD G2.handles{hr} x{hr}.`2)) _;1:by rewrite in_dom Hget. + by rewrite Hget oget_some /=;right;case (x{hr}). + move=> [x1 h];rewrite !(dom_set, getP, inE) /==>[H|[->> ->> /=]]. + + by cut /IntOrder.ltr_eqF->/#:= Hhbound h _;1: apply (Hdomh (x1,h));rewrite inE -Hmhimh H. + by rewrite oget_some /=;right;case y. +qed. + +local hoare test_fi : G2.S.fi : INV2 G2.m G2.mi G2.mh G2.mhi G2.handles G2.chandle ==> + INV2 G2.m G2.mi G2.mh G2.mhi G2.handles G2.chandle. +proof. + proc;if;last by auto. + auto. move=> &hr [][]Hmhmhi[]Hmhimh[]Hdomh[]Hhbound[]Hmhor Hmhior Hnmem;split;beta iota. + + move=> Hnrng handles chandle hx2 @/handles y Hy. + cut ->>{hx2} : hx2 = G2.chandle{hr}. + + rewrite /hx2 /handles /hinvD find_set /pred1 //=. + move=> x2 Hx2;cut := Hnrng;rewrite in_rng NewLogic.negb_exists /= => /(_ x2). + by rewrite get_oget. + split=> /= [[Hmem _] | Hmem]. + + by cut /Hhbound // := Hdomh (x{hr}.`1, G2.chandle{hr}) _;rewrite inE -Hmhimh;right. + do !apply andI. + + apply map_perm=> //;rewrite -not_def=> H. + by cut /#:= Hhbound G2.chandle{hr} _;apply (Hdomh (x{hr}.`1,G2.chandle{hr})); + rewrite !inE -Hmhimh H. + + apply map_perm=> //;rewrite -not_def=> H. + by cut /#:= Hhbound chandle _;apply (Hdomh (y.`1,chandle));rewrite !inE -Hmhimh H. + + move=>[x1 h];cut := Hdomh (x1,h). + rewrite !(dom_set, rng_set, inE) /==>H1 [[H2|[_->]]|[/rng_rem_le H2|[_->]]]//; + by rewrite H1 ?H2. + + by move=> h;cut := Hhbound h;rewrite !dom_set !inE /= => H [[/H|]|->>]/#. + + move=>[x1 h];rewrite !getP !dom_set !inE /==>[|[]->> ->>];rewrite /chandles /=. + + move=>Hh; cut /Hhbound/=:= Hdomh (x1,h) _;1:by rewrite !inE -Hmhimh Hh. + move=> ^Hlt /IntOrder.gtr_eqF; rewrite eq_sym=>->. + by cut ->/#: h <> G2.chandle{hr} + 1 by smt ml=0. + by rewrite oget_some /#. + move=>[x1 h];rewrite !getP !dom_set !inE /==>[|[]->> ->>];rewrite /chandles /=. + + move=>Hh;cut /Hhbound/=:= Hdomh (x1,h) _;1:by rewrite !inE -Hmhimh Hh. + move=> ^Hlt /IntOrder.gtr_eqF; rewrite eq_sym=>->. + by cut ->/#: h <> G2.chandle{hr} + 1 by smt ml=0. + cut ->/=: G2.chandle{hr} <> G2.chandle{hr} + 1 by smt ml=0. + by rewrite oget_some /#. + move=> /= Hrng y Hy;cut Hget:= hinvD_rng _ _ Hrng;split=> /=. + + move=> []/Hmhior /= [] ; rewrite Hget oget_some /#. + move=> Hnot;do !apply andI. + + apply map_perm=> //;rewrite -not_def=> H. + by cut := Hmhior _ H;move: Hnmem;rewrite Hget oget_some /=;case (x{hr}). + + apply map_perm=> //;rewrite -not_def=> H. + by cut /#:= Hhbound G2.chandle{hr} _;apply (Hdomh (y.`1,G2.chandle{hr})); + rewrite !inE -Hmhimh H. + + move=> [x1 h];rewrite !(dom_set,rng_set, inE) => [[H|[_ ->]]| [/rng_rem_le H|[_->]]]//=. + + by left;apply (Hdomh (x1,h));rewrite inE H. + + by left;apply (Hdomh (x1,h));rewrite inE H. + by left;rewrite in_dom Hget. + + by move=>h;rewrite dom_set !inE=> [/Hhbound|->]/#. + + move=> [x1 h];rewrite !(dom_set, getP, inE) /==>[H|[->> ->> /=]]. + + by cut /IntOrder.ltr_eqF->/#:= Hhbound h _;1: apply (Hdomh (x1,h));rewrite inE -Hmhimh H. + by rewrite oget_some /==>{Hy};right;case y. + move=> [x1 h];rewrite !(dom_set, getP, inE) /==>[H|[->> ->>]]. + + by cut /IntOrder.ltr_eqF->/#:= Hhbound h _;1:apply (Hdomh (x1,h));rewrite inE -Hmhimh H. + cut ->/=:oget (hinvD G2.handles{hr} x{hr}.`2) <> G2.chandle{hr}. + + by cut /#:= Hhbound (oget (hinvD G2.handles{hr} x{hr}.`2)) _;1:by rewrite in_dom Hget. + by rewrite Hget oget_some /=;right;case (x{hr}). +qed. + +local hoare test_C : G2.C.f : INV2 G2.m G2.mi G2.mh G2.mhi G2.handles G2.chandle ==> + INV2 G2.m G2.mi G2.mh G2.mhi G2.handles G2.chandle. + + +local module Game3 = { + var m, mi : (state , state ) fmap + var mh, mhi : (hstate, hstate) fmap + var handles : (handle, ccapacity) fmap + var chandle : int + var paths : (capacity, block list * block) fmap + var bext : bool + + + module C = { + proc init(): unit = { } + + proc f(p : block list): block = { + var h, i <- 0; + var (sa,sc) <- (b0,c0); + var sa'; + + if (1 <= size p /\ p <> [b0]) { + while (i < size p - 1 /\ mem (dom m) (sa +^ nth witness p i, sc)) { + (sa, sc) <- oget m.[(sa +^ nth witness p i, sc)]; + (sa', h) <- oget mh.[(sa +^ nth witness p i, h)]; + i <- i + 1; + } + while (i < size p) { + sc <$ cdistr; + sa' <- RO.f(take i p); + mh.[(sa,h)] <- (sa', chandle); + mhi.[(sa',chandle)] <- (sa,h); + (sa,h) <- (sa',chandle); + handles.[chandle] <- (sc,I); + chandle <- chandle + 1; + i <- i + 1; + } + sa <- RO.f(p); + } + return sa; + } + } + + module S = { + (** Inner interface **) + proc f(x : state): state = { + var p, v, y, y1, y2, hy2, hx2; + if (!mem (dom m) x) { - y <$ dstate; if (mem (dom paths) x.`2) { - o' <- oget pathscol.[x.`2]; - pv <- oget paths.[x.`2]; - (p,v) <- pv; - bcoll <- bcoll \/ (mem (dom paths) y.`2); - bsuff <- bsuff \/ (mem (image snd (rng m)) y.`2); - pathscol.[y.`2] <- max o o'; - paths.[y.`2] <- (rcons p (v ^ x.`1),y.`1); + (p,v) <- oget paths.[x.`2]; + y1 <- RO.f (rcons p (v +^ x.`1)); + y2 <$ cdistr; + y <- (y1, y2); + paths.[y2] <- (rcons p (v +^ x.`1), y.`1); + } else { + y <$ dstate; + } + bext <- bext \/ mem (rng handles) (x.`2, I); + (* exists x2 h, handles.[h] = Some (X2,I) *) + if (!(mem (rng handles) (x.`2, D))) { + handles.[chandle] <- (x.`2, D); + chandle <- chandle + 1; + } + hx2 <- oget (hinvD handles x.`2); + if (mem (dom mh) (x.`1, hx2)) { + hy2 <- (oget mh.[(x.`1, hx2)]).`2; + handles.[hy2] <- (y.`2, D); + (* bad <- bad \/ mem X2 y.`2; *) + m.[x] <- y; + mh.[(x.`1, hx2)] <- (y.`1, hy2); + mi.[y] <- x; + mhi.[(y.`1, hy2)] <- (x.`1, hx2); + } else { + hy2 <- chandle; + chandle <- chandle + 1; + handles.[hy2] <- (y.`2, D); + m.[x] <- y; + mh.[(x.`1, hx2)] <- (y.`1, hy2); + mi.[y] <- x; + mhi.[(y.`1, hy2)] <- (x.`1, hx2); + } + } else { + y <- oget m.[x]; + } + return y; + } + + proc fi(x : state): state = { + var y, y1, y2, hx2, hy2; + + if (!mem (dom mi) x) { + bext <- bext \/ mem (rng handles) (x.`2, I); + (* exists x2 h, handles.[h] = Some (X2,I) *) + if (!(mem (rng handles) (x.`2, D))) { + handles.[chandle] <- (x.`2, D); + chandle <- chandle + 1; + } + hx2 <- oget (hinvD handles x.`2); + if (mem (dom mhi) (x.`1, hx2)) { + (y1,hy2) <- oget mhi.[(x.`1, hx2)]; + y2 <$ cdistr; + y <- (y1,y2); + handles.[hy2] <- (y.`2, D); + (* bad <- bad \/ mem X2 y.`2; *) + mi.[x] <- y; + mhi.[(x.`1, hx2)] <- (y.`1, hy2); + m.[y] <- x; + mh.[(y.`1, hy2)] <- (x.`1, hx2); + } else { + y <$ dstate; + hy2 <- chandle; + chandle <- chandle + 1; + handles.[hy2] <- (y.`2, D); + mi.[x] <- y; + mhi.[(x.`1, hx2)] <- (y.`1, hy2); + m.[y] <- x; + mh.[(y.`1, hy2)] <- (x.`1, hx2); } - mcol.[x] <- o; - m.[x] <- y; - micol.[y] <- o; - mi.[y] <- x; } else { - o' <- oget mcol.[x]; - mcol.[x] <- max o o'; - y <- oget m.[x]; - o' <- oget micol.[y]; - micol.[y] <- max o o'; + y <- oget mi.[x]; } - return oget m.[x]; + return y; + } + + (** Distinguisher interface **) + proc init() = { } + + } + + + + proc main(): bool = { + var b; + + m <- map0; + mi <- map0; + bext <- false; + + (* the empty path is initially known by the adversary to lead to capacity 0^c *) + handles <- map0.[0 <- (c0, D)]; + paths <- map0.[c0 <- ([<:block>],b0)]; + chandle <- 1; + b <@ D(C,S).distinguish(); + return b; + } + }. + + + + + local module Game1 = { + var m, mi : (hstate,hstate) fmap + var paths : (handle,(block list * block) list) fmap + var handles : (handle, ccapacity) fmap + var bext, bred, bcoll : bool + var chandle : int + + module S = { + (** Inner interface **) + proc fg(o : caller, x : state): state = { + var o', p, v, y, y1, y2, ox2, hx2, y1h; + + ox2 <- hinv handles x.`2; + hx2 <- oget ox2; + bext <- bext \/ + (o = D /\ ox2 <> None /\ paths.[hx2] <> None /\ + find_path m D paths hx2 = None); + + + if (ox2 = None) { + handles.[chandle] <- (x.`2,o); + hx2 <- chandle; + chandle <- chandle + 1; + } + + if (!mem (dom m) (x.`1, hx2) || (oget handles.[hx2]).`2 = I /\ o = D) { + if (mem (dom paths) hx2 /\ find_path m o paths hx2 <> None) { + (p,v) <- oget (find_path m o paths hx2); + y1 <- RO.f (rcons p (v +^ x.`1)); + y2 <$ cdistr; + y <- (y1, y2); + if (hinv handles y.`2 = None) + paths.[chandle (*y2*)] <- extend_paths x.`1 y.`1 (oget paths.[hx2]); + } else { + y <$ dstate; + } + if (hinv handles y.`2 = None) { + y1h <- (y.`1, chandle); + handles.[chandle] <- (y.`2, o); + m.[(x.`1, hx2)] <- y1h; + mi.[y1h] <- (x.`1, hx2); + handles.[hx2] <- (x.`2, max o (oget handles.[hx2]).`2); (* Warning: not sure we want it *) + chandle <- chandle + 1; + } else { + bcoll <- true; + } + } else { (* mem (dom m) (x.`1, hx2) /\ (!dom m with I \/ o <> D) *) + y1h <- oget m.[(x.`1,hx2)]; + (y2,o') <- oget handles.[y1h.`2]; + handles.[y1h.`2] <- (y2, max o o'); + handles.[hx2] <- (x.`2, max o (oget handles.[hx2]).`2); + y <- (y1h.`1, y2); + } + return y; } proc f(x:state):state = { @@ -411,23 +729,40 @@ print FUNCTIONALITY. } proc fi(x : state): state = { - var o', y; + var o', y, y2, ox2, hx2, y1h; + + ox2 <- hinv handles x.`2; + hx2 <- oget ox2; + + if (ox2 = None) { + handles.[chandle] <- (x.`2,D); + hx2 <- chandle; + chandle <- chandle + 1; + } + + if (!mem (dom mi) (x.`1,hx2) || (oget handles.[hx2]).`2 = I) { + y <$ dstate; + if ( hinv handles y.`2 = None) { + y1h <- (y.`1, chandle); + handles.[chandle] <- (y.`2, D); + mi.[(x.`1, hx2)] <- y1h; + m.[y1h] <- (x.`1, hx2); + handles.[hx2] <- ((oget handles.[hx2]).`1, D); + chandle <- chandle + 1; + } else { + bcoll <- true; + } - if (!mem (dom mi) x) { - y <$ dstate; - micol.[x] <- D; - mi.[x] <- y; - mcol.[y] <- D; - m.[y] <- x; - bmitm <- bmitm \/ (mem (dom paths) y.`2); } else { - o' <- oget micol.[x]; - bred <- bred \/ o' = I; - y <- oget mi.[x]; - micol.[x] <- D; - mcol.[y] <- D; + y1h <- oget mi.[(x.`1,hx2)]; + (y2,o') <- oget handles.[y1h.`2]; + bred <- bred \/ o' = I; + handles.[y1h.`2] <- (y2, D); + handles.[hx2] <- (x.`2, D); + y <- (y1h.`1, y2); + } - return oget mi.[x]; + return y; } (** Distinguisher interface **) @@ -439,9 +774,9 @@ print FUNCTIONALITY. proc init(): unit = { } proc f(p : block list): block = { - var (sa,sc) <- (Block.zeros,Capacity.zeros); + var (sa,sc) <- (b0,c0); - if (1 <= size p /\ p <> [Block.zeros]) { + if (1 <= size p /\ p <> [b0]) { while (p <> []) { (sa,sc) <@ S.fg(I,(sa ^ head witness p,sc)); p <- behead p; @@ -454,9 +789,7 @@ print FUNCTIONALITY. proc main(): bool = { var b; - mcol <- map0; m <- map0; - micol <- map0; mi <- map0; bext <- false; bred <- false; @@ -464,12 +797,87 @@ print FUNCTIONALITY. bsuff <- false; bmitm <- false; (* the empty path is initially known by the adversary to lead to capacity 0^c *) - pathscol <- map0.[Capacity.zeros <- D]; - paths <- map0.[Capacity.zeros <- ([<:block>],Block.zeros)]; + handles <- map0.[0 <- (c0, D)]; + paths <- map0.[0 <- ([<:block>],b0,D)]; + chandle <- 1; b <@ D(C,S).distinguish(); return b; } }. + + + + + +module M = { + proc f () : unit = { + var x; + var l:int list; + l = []; + } +}. + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + (** Result: the instrumented system and the concrete system are perfectly equivalent **) @@ -619,9 +1027,9 @@ print FUNCTIONALITY. proc init(): unit = { } proc f(p : block list): block = { - var (sa,sc) <- (Block.zeros,Capacity.zeros); + var (sa,sc) <- (b0,c0); - if (1<= size p /\ p <> [Block.zeros]) { + if (1<= size p /\ p <> [b0]) { while (p <> []) { (sa,sc) <@ S.fg(I,(sa ^ head witness p,sc)); p <- behead p; @@ -646,8 +1054,8 @@ print FUNCTIONALITY. bsuff <- false; bmitm <- false; (* the empty path is initially known by the adversary to lead to capacity 0^c *) - pathscol <- map0.[Capacity.zeros <- D]; - paths <- map0.[Capacity.zeros <- ([<:block>],Block.zeros)]; + pathscol <- map0.[c0 <- D]; + paths <- map0.[c0 <- ([<:block>],b0)]; b <@ D(C,S).distinguish(); return b; } @@ -721,6 +1129,133 @@ print FUNCTIONALITY. by wp; call Game1_S_S_eq. by auto; smt. qed. + +(*un jeu avec indirection. +jeu avec indirection -> simulateur. *) + type handle = int. + type hstate = block * handle. + + + local module Game2 = { + + var mcol,micol : (hstate,caller) fmap + var rate, ratei : (hstate,block) fmap + var cap, capi : (hstate,handle) fmap + var handles : (handle,capacity) fmap + var pathscol : (handle,caller) fmap + var paths : (handle,block list * block) fmap + var bext, bred : bool + var bcoll, bsuff, bmitm : bool + + module S = { + (** Inner interface **) + proc fg(o : caller, x : state): state = { + var o', ya, yc, pv, p, v, x2; + + (* Fait chier ici *) +(* o' <- odflt D pathscol.[x.`2]; + bext <- bext \/ (o' <= o); *) + + if (!mem (dom rate) x) { + x2 <- hinv handles x.`2; + (ya,yc) <$ dstate; + if (mem (dom paths) x.`2) { + o' <- oget pathscol.[x.`2]; + pv <- oget paths.[x.`2]; + (p,v) <- pv; + bcoll <- bcoll \/ (mem (dom paths) yc); + bsuff <- bsuff \/ (mem (rng cap) yc); + pathscol.[yc] <- max o o'; + paths.[yc] <- (rcons p (v ^ x.`1),ya); + } + rate.[x] <- ya; + ratei.[(ya,yc)] <- x.`1; + cap.[x] <- yc; + capi.[(ya,yc)] <- x.`2; + mcol.[x] <- o; + micol.[(ya,yc)] <- o; + } else { + o' <- oget mcol.[x]; + mcol.[x] <- max o o'; + ya <- oget rate.[x]; + yc <- oget cap.[x]; + o' <- oget micol.[(ya,yc)]; + micol.[(ya,yc)] <- max o o'; + } + return (oget rate.[x],oget cap.[x]); + } + + proc f(x:state):state = { + var r; + r <@ fg(D,x); + return r; + } + + proc fi(x : state): state = { + var ya, yc; + + if (!mem (dom ratei) x) { + (ya,yc) <$ dstate; + micol.[x] <- D; + ratei.[x] <- ya; + capi.[x] <- yc; + mcol.[(ya,yc)] <- D; + rate.[(ya,yc)] <- x.`1; + cap.[(ya,yc)] <- x.`2; + bmitm <- bmitm \/ (mem (dom paths) yc); + } else { + bred <- bred \/ oget micol.[x] = I; + micol.[x] <- D; + ya <- oget ratei.[x]; + yc <- oget capi.[x]; + mcol.[(ya,yc)] <- D; + } + return (oget ratei.[x],oget capi.[x]); + } + + (** Distinguisher interface **) + proc init() = { } + + } + + module C = { + proc init(): unit = { } + + proc f(p : block list): block = { + var (sa,sc) <- (b0,c0); + + if (1<= size p /\ p <> [b0]) { + while (p <> []) { + (sa,sc) <@ S.fg(I,(sa ^ head witness p,sc)); + p <- behead p; + } + } + return sa; + } + } + + proc main(): bool = { + var b; + + mcol <- map0; + micol <- map0; + rate <- map0; + ratei <- map0; + cap <- map0; + capi <- map0; + bext <- false; + bred <- false; + bcoll <- false; + bsuff <- false; + bmitm <- false; + (* the empty path is initially known by the adversary to lead to capacity 0^c *) + pathscol <- map0.[c0 <- D]; + paths <- map0.[c0 <- ([<:block>],b0)]; + b <@ D(C,S).distinguish(); + return b; + } + }. + end section. (* That Self is unfortunate *) From a16bda999deff7f5ddbed5ad2471d2c5cd912d4b Mon Sep 17 00:00:00 2001 From: Pierre-Yves Strub Date: Wed, 9 Dec 2015 12:00:13 +0100 Subject: [PATCH 066/525] Update proofs w.r.t. the new stdlib. --- proof/Common.ec | 22 ++++++++++------------ 1 file changed, 10 insertions(+), 12 deletions(-) diff --git a/proof/Common.ec b/proof/Common.ec index 90eea5c..295d385 100644 --- a/proof/Common.ec +++ b/proof/Common.ec @@ -84,7 +84,7 @@ proof. rewrite /pad /mkpad size_cat /= size_rcons size_nseq. rewrite max_ler 1:modz_ge0 1:gtr_eqF ?gt0_r // (addrCA 1). rewrite modNz ?gt0_r ?ltr_spaddr ?size_ge0 //. -by rewrite (@subrE (size s + 2)) -(addrA _ 2) /= modzE; ring. +by rewrite -(addrA _ 2) /= modzE; ring. qed. lemma size_pad_dvd_r s: r %| size (pad s). @@ -114,11 +114,10 @@ pose i := index _ _; have ^iE {1}->: i = (-(size s + 2)) %% r. by rewrite index_true_behead_mkpad. pose b := _ = size _; case: b => @/b - {b}. rewrite modNz ?gt0_r ?ltr_spaddr ?size_ge0 //. - rewrite (subrE (size s + 2)) -(addrA _ 2) size_pad. - rewrite (addrC _ r) 2!subrE -!addrA => /addrI; rewrite addrCA /=. - rewrite -subr_eq0 -opprB subrE opprK -divz_eq oppr_eq0. + rewrite -(addrA _ 2) size_pad (addrC _ r) -!addrA => /addrI. + rewrite addrCA /= -subr_eq0 -opprD oppr_eq0 addrC -divz_eq. by rewrite addz_neq0 ?size_ge0. -move=> _ /=; rewrite iE -size_mkpad /pad size_cat addrK_sub. +move=> _ /=; rewrite iE -size_mkpad /pad size_cat addrK. by rewrite take_cat /= take0 cats0. qed. @@ -212,9 +211,8 @@ op strip (xs : block list) = lemma extendK (xs : block list) (n : int) : last b0 xs <> b0 => 0 <= n => strip(extend xs n) = (xs, n). proof. -move=> xs_ends_not_b0 ge0_n. -rewrite /strip /extend /= rev_cat rev_nseq size_cat size_nseq max_ler // - subzE - addzA. +move=> xs_ends_not_b0 ge0_n; rewrite /strip /extend /=. +rewrite rev_cat rev_nseq size_cat size_nseq max_ler // -addzA. have head_rev_xs_neq_b0 : head b0 (rev xs) <> b0 by rewrite - last_rev revK //. have -> : rev xs = head b0 (rev xs) :: behead (rev xs). by rewrite head_behead //; case: (rev xs) head_rev_xs_neq_b0. @@ -236,16 +234,16 @@ rewrite -{1}(cat_take_drop (size xs - i) xs); congr. have [ge0_i le_ixs]: 0 <= i <= size xs. by rewrite find_ge0 -size_rev find_size. have sz_drop: size (drop (size xs - i) xs) = i. - rewrite size_drop ?subr_ge0 // 2!subrE opprD opprK. - by rewrite addrA addrN /= max_ler. + rewrite size_drop ?subr_ge0 // opprD opprK. + by rewrite addrA /= max_ler. apply/(eq_from_nth b0) => [|j]; rewrite ?size_nseq ?max_ler //. rewrite sz_drop=> -[ge0_j lt_ji]; rewrite nth_nseq //. rewrite nth_drop ?subr_ge0 // -{1}revK nth_rev ?size_rev. - rewrite addr_ge0 ?subr_ge0 //= -ltr_subr_addr 2!subrE. + rewrite addr_ge0 ?subr_ge0 //= -ltr_subr_addr. by rewrite ltr_add2l ltr_opp2. have @/predC1 /= ->// := (before_find b0 (predC1 b0)). pose s := (_ - _)%Int; rewrite -/i (_ : s = i - (j+1)) /s 1:#ring. -by rewrite subr_ge0 -ltzE lt_ji /= subrE ltr_snaddr // oppr_lt0 ltzS. +by rewrite subr_ge0 -ltzE lt_ji /= ltr_snaddr // oppr_lt0 ltzS. qed. (*------------------------------ Validity ----------------------------- *) From db97513c7554b1375eccbf01566d6b408944ea6d Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Wed, 9 Dec 2015 12:07:33 +0100 Subject: [PATCH 067/525] progress --- proof/old/Squeezeless.ec | 389 +++++++++++++++++++++++++++++++++++---- 1 file changed, 349 insertions(+), 40 deletions(-) diff --git a/proof/old/Squeezeless.ec b/proof/old/Squeezeless.ec index d9bea41..969918c 100644 --- a/proof/old/Squeezeless.ec +++ b/proof/old/Squeezeless.ec @@ -82,7 +82,7 @@ section. (** An intermediate game where we don't care about the permutation being a bijection anymore... **) - local module Concrete_F = { + local module CF = { var m, mi: (state,state) fmap module P = { @@ -140,9 +140,9 @@ section. op bound_concrete : real. - local lemma Concrete_Concrete_F &m: + local lemma Concrete_CF &m: Pr[Concrete.main() @ &m: res] <= - Pr[Concrete_F.main() @ &m: res] + bound_concrete. + Pr[CF.main() @ &m: res] + bound_concrete. admitted. (** Result (expected): The distance between Concrete and Concrete_F @@ -211,16 +211,70 @@ section. type ccapacity = capacity * caller. - op hinv (handles:(handle,ccapacity) fmap) (c:capacity) = + type smap = (state , state ) fmap. + type hsmap = (hstate, hstate ) fmap. + type handles = (handle, ccapacity) fmap. + +lemma get_oget (m:('a,'b)fmap) (x:'a) : mem (dom m) x => m.[x] = Some (oget m.[x]). +proof. by rewrite in_dom;case (m.[x]). qed. + +lemma find_set (m:('a,'b) fmap) y x (p:'a -> 'b -> bool): + (forall x, mem (dom m) x => !p x (oget m.[x])) => + find p m.[x <- y] = if p x y then Some x else None. +proof. + cut [[a []->[]] | []-> Hp Hnp]:= findP p (m.[x<-y]);1: rewrite getP dom_set !inE /#. + by case (p x y)=> //; cut := Hp x;rewrite getP dom_set !inE /= oget_some. +qed. + +require import StdOrder. +require import Ring. + + (* Operators and properties of handles *) + op hinv (handles:handles) (c:capacity) = find (fun _ => pred1 c \o fst) handles. - op hinvD (handles:(handle,ccapacity) fmap) (c:capacity) = + op hinvD (handles:handles) (c:capacity) = find (fun _ => pred1 (c,D)) handles. + op huniq (handles:handles) = + forall h1 h2 cf1 cf2, + handles.[h1] = Some cf1 => + handles.[h2] = Some cf2 => + cf1.`1 = cf2.`1 => h1 = h2. + + lemma hinvP handles c: + if hinv handles c = None then forall h f, handles.[h] <> Some(c,f) + else exists f, handles.[oget (hinv handles c)] = Some(c,f). + proof. + cut @/pred1@/(\o)/=[[h []->[]Hmem <<-]|[]->H h f]/= := + findP (fun (_ : handle) => pred1 c \o fst) handles. + + by exists (oget handles.[h]).`2;rewrite oget_some get_oget;2:case (oget handles.[h]). + by rewrite -not_def=> Heq; cut := H h;rewrite in_dom Heq. + qed. + + lemma huniq_hinv (handles:handles) (h:handle): + huniq handles => mem (dom handles) h => hinv handles (oget handles.[h]).`1 = Some h. + proof. + move=> Huniq;pose c := (oget handles.[h]).`1. + cut:=Huniq h;cut:=hinvP handles c. + case (hinv _ _)=> /=[Hdiff _| h' +/(_ h')];1:by rewrite in_dom /#. + by move=> [f ->] /(_ (oget handles.[h]) (c,f)) H1 H2;rewrite H1 // get_oget. + qed. + + lemma hinvDP handles c: + if hinvD handles c = None then forall h, handles.[h] <> Some(c,D) + else handles.[oget (hinvD handles c)] = Some(c,D). + proof. + cut @/pred1/=[[h []->[]Hmem ]|[]->H h ]/= := + findP (fun (_ : handle) => pred1 (c,D)) handles. + + by rewrite oget_some get_oget. + by rewrite -not_def=> Heq; cut := H h;rewrite in_dom Heq. + qed. + local module G2 = { - var m, mi : (state , state ) fmap - var mh, mhi : (hstate, hstate) fmap - var handles : (handle, ccapacity) fmap + var m, mi : smap + var mh, mhi : hsmap + var handles : handles var chandle : int var paths : (capacity, block list * block) fmap var bext, bcol : bool @@ -230,27 +284,26 @@ section. proc init(): unit = { } proc f(p : block list): block = { + var sa, sa', sc; var h, i <- 0; - var (sa,sc) <- (b0,c0); - var sa'; - + sa <- b0; if (1 <= size p /\ p <> [b0]) { - while (i < size p - 1 /\ mem (dom m) (sa +^ nth witness p i, sc)) { - (sa, sc) <- oget m.[(sa +^ nth witness p i, sc)]; - (sa', h) <- oget mh.[(sa +^ nth witness p i, h)]; + while (i < size p ) { + if (mem (dom mh) (sa +^ nth witness p i, h)) { + (sa, h) <- oget mh.[(sa +^ nth witness p i, h)]; + } else { + sc <$ cdistr; + bcol <- bcol \/ hinv handles sc <> None; + sa' <- RO.f(take (i+1) p); + sa <- sa +^ nth witness p i; + mh.[(sa,h)] <- (sa', chandle); + mhi.[(sa',chandle)] <- (sa, h); + (sa,h) <- (sa',chandle); + handles.[chandle] <- (sc,I); + chandle <- chandle + 1; + } i <- i + 1; } - while (i < size p) { - sc <$ cdistr; - bcol <- bcol \/ hinv handles sc <> None; - sa' <- RO.f(take i p); - mh.[(sa,h)] <- (sa', chandle); - mhi.[(sa',chandle)] <- (sa,h); - (sa,h) <- (sa',chandle); - handles.[chandle] <- (sc,I); - chandle <- chandle + 1; - i <- i + 1; - } sa <- RO.f(p); } return sa; @@ -344,8 +397,6 @@ section. } - - proc main(): bool = { var b; @@ -363,6 +414,277 @@ section. } }. + op build_hpath (mh:hsmap) (bs:block list) = + let step = fun (sah:hstate option ) (b:block) => + if sah = None then None + else + let sah = oget sah in + mh.[(sah.`1 +^ b, sah.`2)] in + foldl step (Some (b0,0)) bs. + + op eqm_handles (handles:handles) (m:smap) (mh:hsmap) = + (forall bc bc', m.[bc] = Some bc' => + exists h h' f f', + handles.[h ] = Some(bc .`2,f ) /\ + handles.[h'] = Some(bc'.`2,f') /\ + mh.[(bc.`1, h)] = Some (bc'.`1,h')) /\ + (forall bh bh', mh.[bh] = Some bh' => + exists c c' f f', + handles.[bh .`2] = Some(c ,f) /\ + handles.[bh'.`2] = Some(c',f') /\ + m.[(bh.`1, c)] = Some (bh'.`1,c')). + + op mh_spec (handles:handles) (m2:smap) (mh:hsmap) (ro:(block list, block)fmap) = + (forall bh bh', mh.[bh] = Some bh' => + exists c f c' f', + handles.[bh .`2]=Some(c,f) /\ + handles.[bh'.`2]=Some(c',f') /\ + if f' = D then m2.[(bh.`1,c)] = Some(bh'.`1,c') /\ f = D + else + exists p v b, + ro.[rcons p b] = Some bh'.`1 /\ + build_hpath mh p = Some(v,bh.`2) /\ + bh.`1 = v +^ b) /\ + (forall p b, mem (dom ro) (rcons p b) <=> + exists v h h', + build_hpath mh p = Some (v,h) /\ + mh.[(v +^ b,h)] = Some (oget ro.[rcons p b], h')). + + op paths_spec (handles:handles) (mh:hsmap) (paths:(capacity,block list * block)fmap) = + forall c p v, paths.[c] = Some(p,v) <=> + exists h, + build_hpath mh p = Some(v,h) /\ + handles.[h] = Some(c,D). + + op incl (m m':('a,'b)fmap) = + forall x, m .[x] <> None => m'.[x] = m.[x]. + + op INV_CF_G2 (handles:handles) (m1 mi1 m2 mi2:smap) (mh2 mhi2:hsmap) (ro:(block list, block) fmap) paths = + (eqm_handles handles m1 mh2 /\ eqm_handles handles mi1 mhi2) /\ + (incl m2 m1 /\ incl mi2 mi1) /\ + (mh_spec handles m2 mh2 ro /\ paths_spec handles mh2 paths /\ huniq handles). + + lemma eqm_dom_mh_m handles m mh hx2 f (x:state): + eqm_handles handles m mh => + handles.[hx2] = Some (x.`2, f) => + mem (dom mh) (x.`1, hx2) => mem (dom m) x. + proof. + move=>[]H1 H2 Hhx2;rewrite !in_dom. + case: (mh.[_]) (H2 (x.`1,hx2))=> //= bh' /(_ bh') [c c' f1 f1']. + by rewrite Hhx2=> /=[][]<<- _;case:(x)=> ??[]_->. + qed. + + axiom D_ll (F <: FUNCTIONALITY{D}) (P <: PRIMITIVE{D}): + islossless P.f => islossless P.fi => islossless F.f => + islossless D(F, P).distinguish. + + clone import Pair.Dprod.Sample as Sample2 with + type t1 <- block, + type t2 <- capacity, + op d1 <- bdistr, + op d2 <- cdistr. + + local equiv CF_G2 : CF.main ~ G2.main : ={glob D} ==> !(G2.bcol \/ G2.bext){2} => ={res}. + proof. + proc. + call (_:(G2.bcol \/ G2.bext), INV_CF_G2 G2.handles{2} CF.m{1} CF.mi{1} G2.m{2} G2.mi{2} G2.mh{2} G2.mhi{2} RO.m{2} G2.paths{2}). + (* lossless D *) + + apply D_ll. + (** proofs for G2.S.f *) + (* equiv CF.P.f G2.S.f *) + + proc;if{1}=>/=. + (* x is not in m{1} so forall h, (x.1,h) is not in mh{2} *) + + rcondt{2} 1. + + move=> &hr;skip=> &hr'[][]_[]<-[]_[][]Hincl Hincli _. + rewrite !in_dom/==>H; by case:(G2.m{hr'}.[x{hr}]) (Hincl x{hr})=> //=;rewrite H. + exists* RO.m{2}, G2.paths{2};elim*=>ro0 paths0. + seq 1 2 : (!G2.bcol{2} /\ (G2.bext = mem (rng G2.handles) (x.`2, I)){2} /\ + ={x,y} /\ + INV_CF_G2 G2.handles{2} CF.m{1} CF.mi{1} G2.m{2} G2.mi{2} G2.mh{2} G2.mhi{2} ro0 paths0 /\ + ! mem (dom CF.m{1}) x{1} /\ + (if mem (dom paths0) x.`2 then + let (p,v) = oget paths0.[x.`2] in + RO.m{2} = ro0.[rcons p (v+^x.`1) <- y.`1] /\ + G2.paths = paths0.[y.`2 <- (rcons p (v +^ x.`1), y.`1)] + else RO.m = ro0 /\ G2.paths = paths0){2}). + + wp 1 1;conseq (_: ={y} /\ + if mem (dom paths0) x{2}.`2 then + let (p0, v0) = oget paths0.[x{2}.`2] in + RO.m{2} = ro0.[rcons p0 (v0 +^ x{2}.`1) <- y{2}.`1] /\ + G2.paths{2} = paths0.[y{2}.`2 <- (rcons p0 (v0 +^ x{2}.`1), y{2}.`1)] + else RO.m{2} = ro0 /\ G2.paths{2} = paths0);1:smt ml=0. + if{2};2:by auto=>/#. + inline{2} RO.f;rcondt{2} 4. + + move=> &ml;auto=>/= &mr[][]_[][]_[]->[][][]_ Heqm _[]_[][]_ Hro[] Hpath _ HnCFm. + rewrite in_dom;case:(G2.paths{mr}.[_]) (Hpath x{mr}.`2)=>//[[p v]]/(_ p v)/=[h][]Hbu Hh b _. + rewrite -not_def=> /Hro [??h'];rewrite oget_some Hbu => [][]<- <- /=. + rewrite Block.xorwA Block.xorwK Block.xorwC Block.xorw0 -not_def=>/Heqm [c c' f f']. + by rewrite Hh=>[][]<- _[]_ Hm;move:HnCFm;rewrite in_dom;case:(x{mr}) Hm=> ??->. + swap{2} 3-2;swap{2}6-4;wp;conseq (_:y{1} =(rd,y2){2}). + + progress [-split]. rewrite getP_eq oget_some H2/=. + by move:H2;rewrite in_dom;case:(G2.paths{2}.[x{2}.`2]). + transitivity{1} {y <- S.sample();} (true ==> ={y}) (true==>y{1}=(rd,y2){2})=>//;1:by inline*;auto. + transitivity{2} {(rd,y2) <- S.sample2();} (true==>y{1}=(rd,y2){2}) (true==> ={rd,y2})=>//;2:by inline*;auto. + by call sample_sample2;auto=> /=?[??]->. + +print Sample2. + appl + + inline*;auto. + + + +search Pair.Dprod.( * ). +print Pair. + +search mem dom None. +print in_dom. + search "_.[_]" "_.[_<-_]" . + + move: Heqm=> []. +search (+^). + + Hp b _;rewrite -not_def. + move=> /Hro. + +[][][]_[]->Hinv Hmx Hp b _. + cut [H1 H2] : path_RO G2.mh{mr} RO.m{mr}. admit. + rewrite -not_def in_dom=>/H2[h1 h2][]Hh1 Hh2. cut:= H1 _ _ _ _ Hh1 Hh2. + case ((oget G2.paths{mr}.[x{mr}.`2]).`1 = [])=> /=. + + admit. + admit. (* should be more or less ok *) + by auto=> &ml&mr;rewrite NewLogic.negb_or=> [][][][]-> ->;progress. + case (mem (rng G2.handles{2}) (x{2}.`2, I)). + + conseq (_:_ ==> true);[by move=> &ml&mr[][]_[]->_-> | auto]. + seq 0 2: ((!G2.bcol{2} /\ + G2.bext{2} = mem (rng G2.handles{2}) (x{2}.`2, I) /\ + ={x, y} /\ + INV_CF_G2 G2.handles{2} CF.m{1} CF.mi{1} G2.m{2} G2.mi{2} G2.mh{2} + G2.mhi{2} RO.m{2} /\ + !mem (dom CF.m{1}) x{1}) /\ + !mem (rng G2.handles{2}) (x{2}.`2, I) /\ + (G2.handles.[hx2] = Some (x.`2,D)){2}). + + admit. (* should be ok *) + rcondf{2} 1. + + move=> &ml;skip=> &mr[][]_[]_[][->_][]Hinv Hdom[]_ Hx2. + rewrite NewLogic.negb_and;left;move:Hdom;apply NewLogic.contraLR=> /=. + admit. (* foo *) + admit. (* should be ok *) *) + if{2}=> /=. + + admit. (* can be hard *) + auto=> &ml&mr[][][]->[]-> ^Hinv->/=. + admit. + + +search dom hinv. + = hinv G2.handles x.`2){2}). +=>//. + +;progress;smt ml=0. + seq 0 1 : + case ((mem (rng G2.handles) (x.`2, I)){2}). + + + + !mem (dom m) x => + !mem (dom mh) x.1 (hinv x.2) + +hinv x.2 = + + rcondf{2} 5. + + move=> &ml;wp 2;conseq (_:_==>true)=> //= &mr. + rewrite in_rng. +search rng. += to_hstate.[x] + + + +print incl. + +[]+[]_[]+ _. + +<-. +;1:(move=> &hr;skip). + + |]. + +admit. + (* lossless CF.P.f *) + + admit. + (* lossless and do not reset bad G2.S.f *) + + admit. + (** proofs for G2.S.fi *) + (* equiv CF.P.fi G2.S.fi *) + + admit. + (* lossless CF.P.fi *) + + admit. + (* lossless and do not reset bad G2.S.fi *) + + admit. + (** proofs for G2.C.f *) + (* equiv CF.C.f G2.C.f *) + + admit. + (* lossless CF.C.f *) + + admit. + (* lossless and do not reset bad G2.C.f *) + + admit. + (* Init ok *) + + admit. + qed. + + + +ma equiv_ +Concrete_F + + + + + + mh.[RO. + + + (p,v) <- oget paths.[x.`2]; + y1 <- RO.f (rcons p (v +^ x.`1)); + y2 <$ cdistr; + y <- (y1, y2); + paths.[y2] <- (rcons p (v +^ x.`1), y.`1); + + + +inv : + (forall (x:state), m.[x]{1} <> None => m.[x]{1} = mh.[x.`1, oget (hinv handles{2} x.`2)]) + (forall (xh:hstate), m.[xh]{2} <> None => mh.[xh]{2} = mh.[x.`1, (oget (handles.[xh.`2])).`1]) + + (si path alors mh= ...) + (si + + + + +op check_hpath (mh:(hstate, hstate) fmap) (handles:(handle, ccapacity) fmap) (xs:block list) (c:capacity) = + obind (fun (sah:hstate) => if c = sah.`2 then Some sah.`1 else None) + (build_hpath mh xs). + + if sah <> None then + + else None + +hpath + let step = fun (sah:hstate option ) (x:block) => + if sah = None then None + else + let sah = oget sah in + mh.[(sah.`1 +^ x, sah.`2)] in + foldl step (Some (b0,0)) xs. + + + + + + + +fun sah => mh.fun (sah:hstate) (cont=> + if mem + + op INV2 (m mi:(state , state ) fmap) (mh mhi:(hstate, hstate) fmap) (handles:(handle, ccapacity) fmap) chandle = dom mh = rng mhi /\ dom mhi = rng mh /\ (forall xh, mem (dom mh `|` rng mh) xh => mem (dom handles) xh.`2) /\ @@ -370,19 +692,6 @@ op INV2 (m mi:(state , state ) fmap) (mh mhi:(hstate, hstate) fmap) (handles:(ha (forall xh, mem (dom mh) xh => mem (dom m) (xh.`1, (oget handles.[xh.`2]).`1) \/ (oget handles.[xh.`2]).`2 = I) /\ (forall xh, mem (dom mhi) xh => mem (dom mi) (xh.`1, (oget handles.[xh.`2]).`1) \/ (oget handles.[xh.`2]).`2 = I). -lemma get_oget (m:('a,'b)fmap) (x:'a) : mem (dom m) x => m.[x] = Some (oget m.[x]). -proof. by rewrite in_dom;case (m.[x]). qed. - -lemma find_set (m:('a,'b) fmap) y x (p:'a -> 'b -> bool): - (forall x, mem (dom m) x => !p x (oget m.[x])) => - find p m.[x <- y] = if p x y then Some x else None. -proof. - cut [[a []->[]] | []-> Hp Hnp]:= findP p (m.[x<-y]);1: rewrite getP dom_set !inE /#. - by case (p x y)=> //; cut := Hp x;rewrite getP dom_set !inE /= oget_some. -qed. - -require import StdOrder. -require import Ring. lemma hinvD_rng x (handles:(handle, ccapacity) fmap): mem (rng handles) (x, D) => From 28a65f998cee0c950d3e98df32d215c8e1548626 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Wed, 9 Dec 2015 11:00:46 -0500 Subject: [PATCH 068/525] Fixed definition of unpad. Revised padK is done. unpadK will be done later today -- please leave alone for the moment. --- proof/Common.ec | 23 +++++++++++++++++------ 1 file changed, 17 insertions(+), 6 deletions(-) diff --git a/proof/Common.ec b/proof/Common.ec index 295d385..93f8891 100644 --- a/proof/Common.ec +++ b/proof/Common.ec @@ -46,8 +46,6 @@ rename (* ------------------------- Padding/Unpadding ------------------------ *) -(* What about this (and the comment applies to other functions): *) - op chunk (bs : bool list) = BitChunking.chunk r bs. op mkpad (n : int) = @@ -59,7 +57,9 @@ op pad (s : bool list) = op unpad (s : bool list) = if !last false s then None else let i = index true (behead (rev s)) in - if i+1 = size s then None else Some (take (size s - (i+2)) s). + if i + 1 = size s then None + else let n = size s - (i + 2) in + if i = (-(n+2)) %% r then Some (take n s) else None. lemma rev_mkpad n : rev (mkpad n) = mkpad n. proof. by rewrite /mkpad rev_cons rev_rcons rev_nseq. qed. @@ -109,20 +109,29 @@ proof. by apply/BitChunking.chunkK/gt0_r. qed. lemma padK : pcancel pad unpad. proof. move=> s @/unpad; rewrite last_pad /= rev_cat rev_mkpad. -pose i := index _ _; have ^iE {1}->: i = (-(size s + 2)) %% r. +pose i := index _ _. +have ^iE {1 2}->: i = (-(size s + 2)) %% r. rewrite /i behead_cat //= index_cat {1}/mkpad /= mem_rcons /=. by rewrite index_true_behead_mkpad. -pose b := _ = size _; case: b => @/b - {b}. +pose b := _ = size _; case b => @/b - {b}. rewrite modNz ?gt0_r ?ltr_spaddr ?size_ge0 //. rewrite -(addrA _ 2) size_pad (addrC _ r) -!addrA => /addrI. rewrite addrCA /= -subr_eq0 -opprD oppr_eq0 addrC -divz_eq. by rewrite addz_neq0 ?size_ge0. -move=> _ /=; rewrite iE -size_mkpad /pad size_cat addrK. +move=> x {x}. +cut -> : size (pad s) - (i + 2) + 2 = size (pad s) - i by algebra. +pose b := _ = _ %% r; case b=> @/b - {b}; last first. +have -> // : size s + 2 = size (pad s) - i + by rewrite /pad size_cat size_mkpad iE #ring. +move=> x {x} /=; rewrite iE -size_mkpad /pad size_cat addrK. by rewrite take_cat /= take0 cats0. qed. lemma unpadK : ocancel unpad pad. proof. +(* +proof in progress -- Alley to fill in shortly + move=> s @/unpad; case: (last false s) => //=. elim/last_ind: s=> //= s b ih {ih}; rewrite last_rcons => hb. rewrite rev_rcons /= size_rcons -(inj_eq _ (addIr (-1))) /= ?addrK. @@ -138,6 +147,8 @@ rewrite -cats1 drop_cat {1}/j ltr_subl_addr ler_lt_add //=. by rewrite ltzE /= ler_addr // /i index_ge0. rewrite /mkpad -cats1 -cat_cons hb; congr. admit. (* missing results on drop/take *) +*) +admit. qed. lemma chunk_padK : pcancel (chunk \o pad) (unpad \o flatten). From 91d67d20f2dc025833252ae2389004aedf7a04f5 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Wed, 9 Dec 2015 22:06:59 +0100 Subject: [PATCH 069/525] really start the proof --- proof/old/Squeezeless.ec | 166 ++++++++++++++++++++++++++++++++++++--- 1 file changed, 155 insertions(+), 11 deletions(-) diff --git a/proof/old/Squeezeless.ec b/proof/old/Squeezeless.ec index 969918c..2376327 100644 --- a/proof/old/Squeezeless.ec +++ b/proof/old/Squeezeless.ec @@ -271,6 +271,20 @@ require import Ring. by rewrite -not_def=> Heq; cut := H h;rewrite in_dom Heq. qed. + lemma huniq_hinvD (handles:handles) c: + huniq handles => mem (rng handles) (c,D) => handles.[oget (hinvD handles c)] = Some(c,D). + proof. + move=> Huniq;rewrite in_rng=> [h]H;case: (hinvD _ _) (Huniq h) (hinvDP handles c)=>//=. + by move=>_/(_ h);rewrite H. + qed. + + lemma huniq_hinvD_h h (handles:handles) c: + huniq handles => handles.[h] = Some (c,D) => hinvD handles c = Some h. + proof. + move=> Huniq;case: (hinvD _ _) (hinvDP handles c)=>/= [H|h'];1: by apply H. + by rewrite oget_some=> /Huniq H/H. + qed. + local module G2 = { var m, mi : smap var mh, mhi : hsmap @@ -414,13 +428,14 @@ require import Ring. } }. - op build_hpath (mh:hsmap) (bs:block list) = - let step = fun (sah:hstate option ) (b:block) => + op step_hpath (mh:hsmap) (sah:hstate option) (b:block) = if sah = None then None else let sah = oget sah in - mh.[(sah.`1 +^ b, sah.`2)] in - foldl step (Some (b0,0)) bs. + mh.[(sah.`1 +^ b, sah.`2)]. + + op build_hpath (mh:hsmap) (bs:block list) = + foldl (step_hpath mh) (Some (b0,0)) bs. op eqm_handles (handles:handles) (m:smap) (mh:hsmap) = (forall bc bc', m.[bc] = Some bc' => @@ -459,10 +474,13 @@ require import Ring. op incl (m m':('a,'b)fmap) = forall x, m .[x] <> None => m'.[x] = m.[x]. - op INV_CF_G2 (handles:handles) (m1 mi1 m2 mi2:smap) (mh2 mhi2:hsmap) (ro:(block list, block) fmap) paths = + op handle_spec handles chandle = + huniq handles /\ handles.[0] = Some (c0,D) /\ forall h, mem (dom handles) h => h < chandle. + + op INV_CF_G2 (handles:handles) chandle (m1 mi1 m2 mi2:smap) (mh2 mhi2:hsmap) (ro:(block list, block) fmap) paths = (eqm_handles handles m1 mh2 /\ eqm_handles handles mi1 mhi2) /\ (incl m2 m1 /\ incl mi2 mi1) /\ - (mh_spec handles m2 mh2 ro /\ paths_spec handles mh2 paths /\ huniq handles). + (mh_spec handles m2 mh2 ro /\ paths_spec handles mh2 paths /\ handle_spec handles chandle). lemma eqm_dom_mh_m handles m mh hx2 f (x:state): eqm_handles handles m mh => @@ -484,10 +502,76 @@ require import Ring. op d1 <- bdistr, op d2 <- cdistr. + lemma eqm_up_handles handles chandle m mh x2 : + handle_spec handles chandle => + eqm_handles handles m mh => + eqm_handles handles.[chandle <- (x2, D)] m mh. + proof. + move=> []Hu[Hh0 Hlt][]H1 H2;split=>[bc bc'/H1 [h h' f f'][]Hh[]Hh' Hmh| bh bh'/H2 [c c' f f'][]Hh []Hh' Hm]. + + exists h,h',f,f';rewrite !getP Hmh/=-Hh-Hh'(_:h<>chandle)2:(_:h'<>chandle) //. + + by apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom Hh. + by apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom Hh'. + + exists c,c',f,f';rewrite !getP Hm/=-Hh-Hh'(_:bh.`2<>chandle)2:(_:bh'.`2<>chandle) //. + + by apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom Hh. + by apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom Hh'. + qed. + + lemma build_hpathP mh p v h: + build_hpath mh p = Some (v, h) => + (p = [] /\ v=b0 /\ h=0) \/ + exists p' b v' h', + p = rcons p' b /\ build_hpath mh p' = Some(v',h') /\ mh.[(v'+^b, h')] = Some(v,h). + proof. + elim/last_ind:p=>@/build_hpath //= p' b _. + rewrite -cats1 foldl_cat /= => H;right;exists p',b. + move:H;rewrite {1}/step_hpath;case (foldl _ _ _)=> //= -[v' h']. + by rewrite oget_some /==>Heq; exists v',h';rewrite -cats1. + qed. + + lemma chandle_ge0 handles chandle : handle_spec handles chandle => 0 < chandle. + proof. by move=>[]_[]Heq Hlt;apply Hlt;rewrite in_dom Heq. qed. + + lemma chandle_0 handles chandle : handle_spec handles chandle => 0 <> chandle. + proof. move=> Hh;apply /IntOrder.ltr_eqF/(chandle_ge0 _ _ Hh). qed. + + (* TODO make sub lemmas for this proof *) + lemma INV_CF_G2_up_handle handles chandle m1 mi1 m2 mi2 mh mhi ro paths x2: + INV_CF_G2 handles chandle m1 mi1 m2 mi2 mh mhi ro paths => + (forall f, ! mem (rng handles) (x2, f)) => + INV_CF_G2 handles.[chandle <- (x2, D)](chandle+1) m1 mi1 m2 mi2 mh mhi ro paths. + proof. + move=>[][]Heqm Heqmi[]Hincl[]Hmh[]Hp Hh Hx2;split. + + by split;apply eqm_up_handles. + split=>//;split;[|split]. + + move:Hmh Hh=>[H1 ?][_[]_ Hlt];split=>// bh bh' /H1 [c f c' f'][]Hh[]Hh' Hif. + exists c,f,c',f';rewrite Hif-Hh-Hh'!getP(_:bh.`2<>chandle)2:(_:bh'.`2<>chandle) //. + + by apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom Hh. + by apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom Hh'. + + move=> c p v;rewrite Hp;apply NewLogic.exists_iff=> h/=;split=> -[^Hbu->] /=; + rewrite getP. + + move:Hh=>[]_[]_/(_ h)Hlt Hh;rewrite (_:h<>chandle)//. + by apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom Hh. + rewrite (_:h<>chandle)//. + cut [[]_[]_->|[p' b v' h'[]_[]_ Hh']]:= build_hpathP _ _ _ _ Hbu. + + by rewrite (chandle_0 _ _ Hh). + move:Hh=>[]_[]_/(_ h)Hlt;apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom. + by cut [/(_ _ _ Hh')[????][]_[]->]:= Hmh. + cut []Hu[]Hh0 Hlt:= Hh;split;[ | split]. + + move=> h1 h2 [c1 f1] [c2 f2];rewrite !getP. + case (h1=chandle)=>[->/=[]->> ->|_]; (case (h2=chandle)=>[->//=|_]). + + by move=>Heq ->>;move:(Hx2 f2);rewrite in_rng NewLogic.negb_exists=>/=/(_ h2); + rewrite Heq. + + by move=>Heq[]->> <<- ->>;move:(Hx2 f1);rewrite in_rng NewLogic.negb_exists=>/=/(_ h1); + rewrite Heq. + by apply Hu. + + by rewrite getP (chandle_0 _ _ Hh). + move=>h;rewrite dom_set !inE /#. + qed. + local equiv CF_G2 : CF.main ~ G2.main : ={glob D} ==> !(G2.bcol \/ G2.bext){2} => ={res}. proof. proc. - call (_:(G2.bcol \/ G2.bext), INV_CF_G2 G2.handles{2} CF.m{1} CF.mi{1} G2.m{2} G2.mi{2} G2.mh{2} G2.mhi{2} RO.m{2} G2.paths{2}). + call (_:(G2.bcol \/ G2.bext), INV_CF_G2 G2.handles{2} G2.chandle{2} CF.m{1} CF.mi{1} G2.m{2} G2.mi{2} G2.mh{2} G2.mhi{2} RO.m{2} G2.paths{2}). (* lossless D *) + apply D_ll. (** proofs for G2.S.f *) @@ -500,7 +584,7 @@ require import Ring. exists* RO.m{2}, G2.paths{2};elim*=>ro0 paths0. seq 1 2 : (!G2.bcol{2} /\ (G2.bext = mem (rng G2.handles) (x.`2, I)){2} /\ ={x,y} /\ - INV_CF_G2 G2.handles{2} CF.m{1} CF.mi{1} G2.m{2} G2.mi{2} G2.mh{2} G2.mhi{2} ro0 paths0 /\ + INV_CF_G2 G2.handles{2} G2.chandle{2} CF.m{1} CF.mi{1} G2.m{2} G2.mi{2} G2.mh{2} G2.mhi{2} ro0 paths0 /\ ! mem (dom CF.m{1}) x{1} /\ (if mem (dom paths0) x.`2 then let (p,v) = oget paths0.[x.`2] in @@ -515,18 +599,78 @@ require import Ring. else RO.m{2} = ro0 /\ G2.paths{2} = paths0);1:smt ml=0. if{2};2:by auto=>/#. inline{2} RO.f;rcondt{2} 4. - + move=> &ml;auto=>/= &mr[][]_[][]_[]->[][][]_ Heqm _[]_[][]_ Hro[] Hpath _ HnCFm. + + move=> &ml;auto=>/= &mr[][]_[][]_[]->[][][]_ Heqm _[]_[][]_ Hro[] Hpath _ HnCFm. rewrite in_dom;case:(G2.paths{mr}.[_]) (Hpath x{mr}.`2)=>//[[p v]]/(_ p v)/=[h][]Hbu Hh b _. rewrite -not_def=> /Hro [??h'];rewrite oget_some Hbu => [][]<- <- /=. rewrite Block.xorwA Block.xorwK Block.xorwC Block.xorw0 -not_def=>/Heqm [c c' f f']. by rewrite Hh=>[][]<- _[]_ Hm;move:HnCFm;rewrite in_dom;case:(x{mr}) Hm=> ??->. swap{2} 3-2;swap{2}6-4;wp;conseq (_:y{1} =(rd,y2){2}). - + progress [-split]. rewrite getP_eq oget_some H2/=. - by move:H2;rewrite in_dom;case:(G2.paths{2}.[x{2}.`2]). + + progress [-split];rewrite getP_eq oget_some H2/=. + by move:H2;rewrite in_dom;case:(G2.paths{2}.[_]). transitivity{1} {y <- S.sample();} (true ==> ={y}) (true==>y{1}=(rd,y2){2})=>//;1:by inline*;auto. transitivity{2} {(rd,y2) <- S.sample2();} (true==>y{1}=(rd,y2){2}) (true==> ={rd,y2})=>//;2:by inline*;auto. by call sample_sample2;auto=> /=?[??]->. + case (mem (rng G2.handles{2}) (x{2}.`2, I)). + + conseq (_:true);[by move=> ??[][]_[]->_->|auto]. + conseq (_: !G2.bcol{2} => + oget CF.m{1}.[x{1}] = y{2} /\ + INV_CF_G2 G2.handles{2} G2.chandle{2} CF.m{1} CF.mi{1} G2.m{2} G2.mi{2} G2.mh{2} G2.mhi{2} RO.m{2} G2.paths{2}). + + by move=> ??[][]_[]->[][]-> _ _ ->. + seq 0 2: ((!G2.bcol{2} /\ ={x, y} /\ + INV_CF_G2 G2.handles{2} G2.chandle{2} CF.m{1} CF.mi{1} G2.m{2} G2.mi{2} + G2.mh{2} G2.mhi{2} ro0 paths0 /\ + ! mem (dom CF.m{1}) x{1} /\ + if mem (dom paths0) x{2}.`2 then + let (p0, v0) = oget paths0.[x{2}.`2] in + RO.m{2} = ro0.[rcons p0 (v0 +^ x{2}.`1) <- y{2}.`1] /\ + G2.paths{2} = paths0.[y{2}.`2 <- (rcons p0 (v0 +^ x{2}.`1), y{2}.`1)] + else RO.m{2} = ro0 /\ G2.paths{2} = paths0) /\ + !mem (rng G2.handles{2}) (x{2}.`2, I) /\ + (G2.handles.[hx2]=Some(x.`2,D)){2}). + + auto=> &ml&mr[][]->[]_[][]-> ->[]Hinv []-> -> ^Hrng-> /=. + case (mem (rng G2.handles{mr}) (x{mr}.`2, Top.D))=> Hmem /=. + + by split=>//;apply /huniq_hinvD=>//;move:Hinv;rewrite /INV_CF_G2/handle_spec. + rewrite -anda_and;split=> [ | {Hinv}Hinv]. + + by apply INV_CF_G2_up_handle=>//[[]]. + rewrite rng_set (huniq_hinvD_h G2.chandle{mr}) ?getP//. + + by move:Hinv;rewrite /INV_CF_G2/handle_spec. + by rewrite oget_some /=!inE/=;move:Hrng;apply NewLogic.contraLR=>/=;apply rng_rem_le. + rcondf{2} 1. + + move=> &ml;skip=> &mr[][]_[][]-> _ []Hinv[]Hndom _[]_ Hh;rewrite -not_def in_dom=>[]. + move:Hinv=>[][][]_ /(_ (x{mr}.`1, hx2{mr}));case (G2.mh{mr}.[_])=>// bh' /(_ bh') [c c' f f'] /=. + by rewrite Hh/= =>[][]<- _ []_ H;case: (x{mr}) H Hndom => [x1 x2];rewrite in_dom=>->. + auto. +(* Stopped here *) + admit. + + +/=. +case ( + + + + _. + rewrite in_dom;case (paths0.[x{mr}.`2])=> //= [[p v]]. + rewrite oget_some /=. + case + +search rng rem. + + rewrite getP. +search hinvD. + move=> + + + + search hinvD. +search hinv. + G2.mh{2} G2.mhi{2} RO.m{2} G2.paths{2} + seq + wp=> //. +progress [-split]. by move:H4;rewrite H3. + progress. + seq print Sample2. appl + inline*;auto. From ba78027863b32b80d9355513656b140aeabd0901 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Wed, 9 Dec 2015 22:35:36 +0100 Subject: [PATCH 070/525] cleaning + split lemma. --- proof/old/Squeezeless.ec | 234 ++++++++++++--------------------------- 1 file changed, 72 insertions(+), 162 deletions(-) diff --git a/proof/old/Squeezeless.ec b/proof/old/Squeezeless.ec index 2376327..33743e4 100644 --- a/proof/old/Squeezeless.ec +++ b/proof/old/Squeezeless.ec @@ -474,13 +474,13 @@ require import Ring. op incl (m m':('a,'b)fmap) = forall x, m .[x] <> None => m'.[x] = m.[x]. - op handle_spec handles chandle = + op handles_spec handles chandle = huniq handles /\ handles.[0] = Some (c0,D) /\ forall h, mem (dom handles) h => h < chandle. op INV_CF_G2 (handles:handles) chandle (m1 mi1 m2 mi2:smap) (mh2 mhi2:hsmap) (ro:(block list, block) fmap) paths = (eqm_handles handles m1 mh2 /\ eqm_handles handles mi1 mhi2) /\ (incl m2 m1 /\ incl mi2 mi1) /\ - (mh_spec handles m2 mh2 ro /\ paths_spec handles mh2 paths /\ handle_spec handles chandle). + (mh_spec handles m2 mh2 ro /\ paths_spec handles mh2 paths /\ handles_spec handles chandle). lemma eqm_dom_mh_m handles m mh hx2 f (x:state): eqm_handles handles m mh => @@ -502,20 +502,6 @@ require import Ring. op d1 <- bdistr, op d2 <- cdistr. - lemma eqm_up_handles handles chandle m mh x2 : - handle_spec handles chandle => - eqm_handles handles m mh => - eqm_handles handles.[chandle <- (x2, D)] m mh. - proof. - move=> []Hu[Hh0 Hlt][]H1 H2;split=>[bc bc'/H1 [h h' f f'][]Hh[]Hh' Hmh| bh bh'/H2 [c c' f f'][]Hh []Hh' Hm]. - + exists h,h',f,f';rewrite !getP Hmh/=-Hh-Hh'(_:h<>chandle)2:(_:h'<>chandle) //. - + by apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom Hh. - by apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom Hh'. - + exists c,c',f,f';rewrite !getP Hm/=-Hh-Hh'(_:bh.`2<>chandle)2:(_:bh'.`2<>chandle) //. - + by apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom Hh. - by apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom Hh'. - qed. - lemma build_hpathP mh p v h: build_hpath mh p = Some (v, h) => (p = [] /\ v=b0 /\ h=0) \/ @@ -528,35 +514,62 @@ require import Ring. by rewrite oget_some /==>Heq; exists v',h';rewrite -cats1. qed. - lemma chandle_ge0 handles chandle : handle_spec handles chandle => 0 < chandle. + lemma chandle_ge0 handles chandle : handles_spec handles chandle => 0 < chandle. proof. by move=>[]_[]Heq Hlt;apply Hlt;rewrite in_dom Heq. qed. - lemma chandle_0 handles chandle : handle_spec handles chandle => 0 <> chandle. + lemma chandle_0 handles chandle : handles_spec handles chandle => 0 <> chandle. proof. move=> Hh;apply /IntOrder.ltr_eqF/(chandle_ge0 _ _ Hh). qed. - (* TODO make sub lemmas for this proof *) - lemma INV_CF_G2_up_handle handles chandle m1 mi1 m2 mi2 mh mhi ro paths x2: - INV_CF_G2 handles chandle m1 mi1 m2 mi2 mh mhi ro paths => - (forall f, ! mem (rng handles) (x2, f)) => - INV_CF_G2 handles.[chandle <- (x2, D)](chandle+1) m1 mi1 m2 mi2 mh mhi ro paths. + lemma eqm_up_handles handles chandle m mh x2 : + handles_spec handles chandle => + eqm_handles handles m mh => + eqm_handles handles.[chandle <- (x2, D)] m mh. proof. - move=>[][]Heqm Heqmi[]Hincl[]Hmh[]Hp Hh Hx2;split. - + by split;apply eqm_up_handles. - split=>//;split;[|split]. - + move:Hmh Hh=>[H1 ?][_[]_ Hlt];split=>// bh bh' /H1 [c f c' f'][]Hh[]Hh' Hif. - exists c,f,c',f';rewrite Hif-Hh-Hh'!getP(_:bh.`2<>chandle)2:(_:bh'.`2<>chandle) //. + move=> []Hu[Hh0 Hlt][]H1 H2;split=> + [bc bc'/H1 [h h' f f'][]Hh[]Hh' Hmh| bh bh'/H2 [c c' f f'][]Hh []Hh' Hm]. + + exists h,h',f,f';rewrite !getP Hmh/=-Hh-Hh'(_:h<>chandle)2:(_:h'<>chandle) //. + by apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom Hh. by apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom Hh'. - + move=> c p v;rewrite Hp;apply NewLogic.exists_iff=> h/=;split=> -[^Hbu->] /=; + exists c,c',f,f';rewrite !getP Hm/=-Hh-Hh'(_:bh.`2<>chandle)2:(_:bh'.`2<>chandle) //. + + by apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom Hh. + by apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom Hh'. + qed. + + lemma mh_up_handles handles chandle m2 mh ro cf: + handles_spec handles chandle => + mh_spec handles m2 mh ro => + mh_spec handles.[chandle <- cf] m2 mh ro. + proof. + move=> Hh Hmh. + move:Hmh Hh=>[H1 ?][_[]_ Hlt];split=>// bh bh' /H1 [c f c' f'][]Hh[]Hh' Hif. + exists c,f,c',f';rewrite Hif-Hh-Hh'!getP(_:bh.`2<>chandle)2:(_:bh'.`2<>chandle) //. + + by apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom Hh. + by apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom Hh'. + qed. + + lemma paths_up_handles m2 ro handles mh paths cf chandle: + mh_spec handles m2 mh ro => + handles_spec handles chandle => + paths_spec handles mh paths => + paths_spec handles.[chandle <- cf] mh paths. + proof. + move=> Hmh Hh Hp c p v;rewrite Hp;apply NewLogic.exists_iff=> h/=;split=> -[^Hbu->] /=; rewrite getP. - + move:Hh=>[]_[]_/(_ h)Hlt Hh;rewrite (_:h<>chandle)//. - by apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom Hh. - rewrite (_:h<>chandle)//. - cut [[]_[]_->|[p' b v' h'[]_[]_ Hh']]:= build_hpathP _ _ _ _ Hbu. - + by rewrite (chandle_0 _ _ Hh). - move:Hh=>[]_[]_/(_ h)Hlt;apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom. - by cut [/(_ _ _ Hh')[????][]_[]->]:= Hmh. - cut []Hu[]Hh0 Hlt:= Hh;split;[ | split]. + + move:Hh=>[]_[]_/(_ h)Hlt Hh;rewrite (_:h<>chandle)//. + by apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom Hh. + rewrite (_:h<>chandle)//. + cut [[]_[]_->|[p' b v' h'[]_[]_ Hh']]:= build_hpathP _ _ _ _ Hbu. + + by rewrite (chandle_0 _ _ Hh). + move:Hh=>[]_[]_/(_ h)Hlt;apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom. + by cut [/(_ _ _ Hh')[????][]_[]->]:= Hmh. + qed. + + lemma handles_up_handles handles chandle x2 f': + (forall (f : caller), ! mem (rng handles) (x2, f)) => + handles_spec handles chandle => + handles_spec handles.[chandle <- (x2, f')] (chandle + 1). + proof. + move=> Hx2^Hh[]Hu[]Hh0 Hlt;split;[ | split]. + move=> h1 h2 [c1 f1] [c2 f2];rewrite !getP. case (h1=chandle)=>[->/=[]->> ->|_]; (case (h2=chandle)=>[->//=|_]). + by move=>Heq ->>;move:(Hx2 f2);rewrite in_rng NewLogic.negb_exists=>/=/(_ h2); @@ -568,6 +581,19 @@ require import Ring. move=>h;rewrite dom_set !inE /#. qed. + lemma INV_CF_G2_up_handles handles chandle m1 mi1 m2 mi2 mh mhi ro paths x2: + INV_CF_G2 handles chandle m1 mi1 m2 mi2 mh mhi ro paths => + (forall f, ! mem (rng handles) (x2, f)) => + INV_CF_G2 handles.[chandle <- (x2, D)](chandle+1) m1 mi1 m2 mi2 mh mhi ro paths. + proof. + move=>[][]Heqm Heqmi[]Hincl[]Hmh[]Hp Hh Hx2;split. + + by split;apply eqm_up_handles. + split=>//;split;[|split]. + + by apply mh_up_handles. + + by apply (paths_up_handles m2 ro). + by apply handles_up_handles. + qed. + local equiv CF_G2 : CF.main ~ G2.main : ={glob D} ==> !(G2.bcol \/ G2.bext){2} => ={res}. proof. proc. @@ -629,11 +655,11 @@ require import Ring. (G2.handles.[hx2]=Some(x.`2,D)){2}). + auto=> &ml&mr[][]->[]_[][]-> ->[]Hinv []-> -> ^Hrng-> /=. case (mem (rng G2.handles{mr}) (x{mr}.`2, Top.D))=> Hmem /=. - + by split=>//;apply /huniq_hinvD=>//;move:Hinv;rewrite /INV_CF_G2/handle_spec. + + by split=>//;apply /huniq_hinvD=>//;move:Hinv;rewrite /INV_CF_G2/handles_spec. rewrite -anda_and;split=> [ | {Hinv}Hinv]. - + by apply INV_CF_G2_up_handle=>//[[]]. + + by apply INV_CF_G2_up_handles=>//[[]]. rewrite rng_set (huniq_hinvD_h G2.chandle{mr}) ?getP//. - + by move:Hinv;rewrite /INV_CF_G2/handle_spec. + + by move:Hinv;rewrite /INV_CF_G2/handles_spec. by rewrite oget_some /=!inE/=;move:Hrng;apply NewLogic.contraLR=>/=;apply rng_rem_le. rcondf{2} 1. + move=> &ml;skip=> &mr[][]_[][]-> _ []Hinv[]Hndom _[]_ Hh;rewrite -not_def in_dom=>[]. @@ -642,115 +668,7 @@ require import Ring. auto. (* Stopped here *) admit. - - -/=. -case ( - - - - _. - rewrite in_dom;case (paths0.[x{mr}.`2])=> //= [[p v]]. - rewrite oget_some /=. - case - -search rng rem. - - rewrite getP. -search hinvD. - move=> - - - - search hinvD. -search hinv. - - G2.mh{2} G2.mhi{2} RO.m{2} G2.paths{2} - seq - wp=> //. -progress [-split]. by move:H4;rewrite H3. - progress. - seq -print Sample2. - appl - + inline*;auto. - - - -search Pair.Dprod.( * ). -print Pair. - -search mem dom None. -print in_dom. - search "_.[_]" "_.[_<-_]" . - - move: Heqm=> []. -search (+^). - - Hp b _;rewrite -not_def. - move=> /Hro. - -[][][]_[]->Hinv Hmx Hp b _. - cut [H1 H2] : path_RO G2.mh{mr} RO.m{mr}. admit. - rewrite -not_def in_dom=>/H2[h1 h2][]Hh1 Hh2. cut:= H1 _ _ _ _ Hh1 Hh2. - case ((oget G2.paths{mr}.[x{mr}.`2]).`1 = [])=> /=. - + admit. - admit. (* should be more or less ok *) - by auto=> &ml&mr;rewrite NewLogic.negb_or=> [][][][]-> ->;progress. - case (mem (rng G2.handles{2}) (x{2}.`2, I)). - + conseq (_:_ ==> true);[by move=> &ml&mr[][]_[]->_-> | auto]. - seq 0 2: ((!G2.bcol{2} /\ - G2.bext{2} = mem (rng G2.handles{2}) (x{2}.`2, I) /\ - ={x, y} /\ - INV_CF_G2 G2.handles{2} CF.m{1} CF.mi{1} G2.m{2} G2.mi{2} G2.mh{2} - G2.mhi{2} RO.m{2} /\ - !mem (dom CF.m{1}) x{1}) /\ - !mem (rng G2.handles{2}) (x{2}.`2, I) /\ - (G2.handles.[hx2] = Some (x.`2,D)){2}). - + admit. (* should be ok *) - rcondf{2} 1. - + move=> &ml;skip=> &mr[][]_[]_[][->_][]Hinv Hdom[]_ Hx2. - rewrite NewLogic.negb_and;left;move:Hdom;apply NewLogic.contraLR=> /=. - admit. (* foo *) - admit. (* should be ok *) *) - if{2}=> /=. - + admit. (* can be hard *) - auto=> &ml&mr[][][]->[]-> ^Hinv->/=. admit. - - -search dom hinv. - = hinv G2.handles x.`2){2}). -=>//. - -;progress;smt ml=0. - seq 0 1 : - case ((mem (rng G2.handles) (x.`2, I)){2}). - + - - !mem (dom m) x => - !mem (dom mh) x.1 (hinv x.2) - -hinv x.2 = - - rcondf{2} 5. - + move=> &ml;wp 2;conseq (_:_==>true)=> //= &mr. - rewrite in_rng. -search rng. -= to_hstate.[x] - - - -print incl. - -[]+[]_[]+ _. - -<-. -;1:(move=> &hr;skip). - - |]. - -admit. (* lossless CF.P.f *) + admit. (* lossless and do not reset bad G2.S.f *) @@ -775,30 +693,22 @@ admit. -ma equiv_ -Concrete_F - - mh.[RO. - (p,v) <- oget paths.[x.`2]; - y1 <- RO.f (rcons p (v +^ x.`1)); - y2 <$ cdistr; - y <- (y1, y2); - paths.[y2] <- (rcons p (v +^ x.`1), y.`1); -inv : - (forall (x:state), m.[x]{1} <> None => m.[x]{1} = mh.[x.`1, oget (hinv handles{2} x.`2)]) - (forall (xh:hstate), m.[xh]{2} <> None => mh.[xh]{2} = mh.[x.`1, (oget (handles.[xh.`2])).`1]) - (si path alors mh= ...) - (si + + + + + + From 8e71b1fb1329ee2c06a81ab4beff88de6d37f17b Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Wed, 9 Dec 2015 18:39:46 -0500 Subject: [PATCH 071/525] Full proof of unpadK. --- proof/Common.ec | 75 ++++++++++++++++++++++++++++++++++++++----------- 1 file changed, 59 insertions(+), 16 deletions(-) diff --git a/proof/Common.ec b/proof/Common.ec index 93f8891..6b3d84c 100644 --- a/proof/Common.ec +++ b/proof/Common.ec @@ -118,37 +118,80 @@ pose b := _ = size _; case b => @/b - {b}. rewrite -(addrA _ 2) size_pad (addrC _ r) -!addrA => /addrI. rewrite addrCA /= -subr_eq0 -opprD oppr_eq0 addrC -divz_eq. by rewrite addz_neq0 ?size_ge0. -move=> x {x}. -cut -> : size (pad s) - (i + 2) + 2 = size (pad s) - i by algebra. +move=> sz {sz}. +have -> : size (pad s) - (i + 2) + 2 = size (pad s) - i by ring. pose b := _ = _ %% r; case b=> @/b - {b}; last first. have -> // : size s + 2 = size (pad s) - i by rewrite /pad size_cat size_mkpad iE #ring. -move=> x {x} /=; rewrite iE -size_mkpad /pad size_cat addrK. +move=> sz {sz} /=; rewrite iE -size_mkpad /pad size_cat addrK. by rewrite take_cat /= take0 cats0. qed. lemma unpadK : ocancel unpad pad. proof. -(* -proof in progress -- Alley to fill in shortly - -move=> s @/unpad; case: (last false s) => //=. +move=> s @/unpad; case: (last false s)=> //=. elim/last_ind: s=> //= s b ih {ih}; rewrite last_rcons => hb. rewrite rev_rcons /= size_rcons -(inj_eq _ (addIr (-1))) /= ?addrK. -pose i := index _ _; case: (i = size s) => //=. -move=> ne_is @/pad; pose j := _ - (i+2); apply/eq_sym. +pose i := index _ _; case: (i = size s)=> // ne_is @/pad. +have [ge0_i lt_siz_s_i] : 0 <= i < size s. + have le_siz_s_i : i <= size s by rewrite /i - size_rev index_size. + split=> [| _]; [rewrite index_ge0 | rewrite ltr_neqAle //]. +have -> : size s + 1 - (i + 2) + 2 = size s - i + 1 by ring. +have -> : size s + 1 - (i + 2) = size s - i - 1 by ring. +case: (i = (-(size s - i + 1)) %% r) => [iE | //]. +pose j := size s - i - 1; apply/eq_sym. rewrite -{1}(cat_take_drop j (rcons s b)) eqseq_cat //=. rewrite size_take; first rewrite /j subr_ge0. - (have ->: 2=1+1 by done); rewrite addrA -ltzE ltr_add2r. - by rewrite ltr_neqAle ne_is /= /i -size_rev index_size. + rewrite - (ler_add2r i) - addrA addNr /= lez_add1r //. rewrite {2}/j size_rcons ltr_subl_addr ?ltr_spaddr //=. - by rewrite /i index_ge0. + rewrite ler_add2l - ler_oppl (ler_trans 0) // lerN10. rewrite -cats1 drop_cat {1}/j ltr_subl_addr ler_lt_add //=. - by rewrite ltzE /= ler_addr // /i index_ge0. + rewrite ltr_oppl (ltr_le_trans 0) 1:ltrN10 //. rewrite /mkpad -cats1 -cat_cons hb; congr. -admit. (* missing results on drop/take *) -*) -admit. +have [ge0_j le_siz_j] : 0 <= j < size s. + rewrite /j; split=> [| _]. + rewrite - (ler_add2r 1) /= - addrA addNr /= - (ler_add2r i) + - addrA addNr /= lez_add1r //. + rewrite - addrA - opprD - (ltr_add2r (i + 1)) - addrA addrN /= + ltz_addl (ler_lt_trans i) // ltz_addl ltr01. +rewrite (drop_nth false) //. +have -> : nth false s j = true + by rewrite /j - addrA - opprD - nth_rev // nth_index // + - index_mem size_rev //. +congr. +have size_drop : size (drop (j + 1) s) = (-(j + 2)) %% r. + rewrite size_drop; 1:rewrite (ler_trans j) //ler_addl ler01. + rewrite max_ler /j. + have -> // : size s - (size s - i - 1 + 1) = i by ring. + have -> : size s - (size s - i - 1 + 1) = i by ring. + have -> : -(size s - i - 1 + 2) = -(size s - i + 1). + ring. rewrite - iE //. +apply (eq_from_nth false). +rewrite size_drop size_nseq. +rewrite max_ler // 1:modz_ge0 gtr_eqF ?gt0_r //. +move=> k [ge0k lt_size_drop_k]; rewrite size_drop in lt_size_drop_k. +rewrite nth_nseq; first split=> // _; rewrite - size_drop //. +rewrite nth_drop // 1:(ler_trans j) // 1:lez_addl 1:ler01. +rewrite /j. +have -> : size s - i - 1 + 1 + k = size s - ((i - k - 1) + 1) by ring. +have i_min_k_min1_rng {size_drop} : 0 <= i - k - 1 < i. + rewrite iE; pose sz := (-(size s - i + 1)) %% r. + split=> [| _]. + rewrite - (ler_add2r (k + 1)) /=. + have -> @/sz : sz - k - 1 + (k + 1) = sz by ring. + have -> : -(size s - i + 1) = -(size s - i - 1 + 2) by ring. + rewrite - /j addrC lez_add1r //. + rewrite -(ltr_add2r (k + 1)). + have -> : sz - k - 1 + (k + 1) = sz by algebra. + rewrite ltr_addl ltzS //. +rewrite - nth_rev //. + split=> [| _ //]. + elim i_min_k_min1_rng=> //. + rewrite (ltr_trans i) //; elim i_min_k_min1_rng=> //. +have -> : + (nth false (rev s) (i - k - 1) = false) = + (nth false (rev s) (i - k - 1) <> true) by smt ml=0. +rewrite (before_index false) //. qed. lemma chunk_padK : pcancel (chunk \o pad) (unpad \o flatten). From 402be12aae8e2e46de0e4213653b49c8c93b8075 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Thu, 10 Dec 2015 09:45:23 +0100 Subject: [PATCH 072/525] Split proof into different file such that we can limit conflict --- proof/Indifferentiability.eca | 13 +- proof/old/ConcreteF.eca | 77 +++++ proof/old/G1.eca | 405 +++++++++++++++++++++++++ proof/old/SLCommon.ec | 208 +++++++++++++ proof/old/Squeezeless.ec | 539 +++++----------------------------- 5 files changed, 770 insertions(+), 472 deletions(-) create mode 100644 proof/old/ConcreteF.eca create mode 100644 proof/old/G1.eca create mode 100644 proof/old/SLCommon.ec diff --git a/proof/Indifferentiability.eca b/proof/Indifferentiability.eca index 623ca31..9a3a37a 100644 --- a/proof/Indifferentiability.eca +++ b/proof/Indifferentiability.eca @@ -10,11 +10,20 @@ module type PRIMITIVE = { proc fi(x : p): p }. +module type DPRIMITIVE = { + proc f(x : p): p + proc fi(x : p): p +}. + module type FUNCTIONALITY = { proc init(): unit proc f(x : f_in): f_out }. +module type DFUNCTIONALITY = { + proc f(x : f_in): f_out +}. + (** A construction takes a primitive and builds a functionality. A simulator takes a functionality and simulates the primitive. A distinguisher gets oracle access to a primitive and a @@ -32,8 +41,8 @@ module type SIMULATOR (F : FUNCTIONALITY) = { proc fi(x : p) : p { F.f } }. -module type DISTINGUISHER (F : FUNCTIONALITY, P : PRIMITIVE) = { - proc distinguish(): bool { P.f P.fi F.f } +module type DISTINGUISHER (F : DFUNCTIONALITY, P : DPRIMITIVE) = { + proc distinguish(): bool }. module Indif (F : FUNCTIONALITY, P : PRIMITIVE, D : DISTINGUISHER) = { diff --git a/proof/old/ConcreteF.eca b/proof/old/ConcreteF.eca new file mode 100644 index 0000000..548b2a3 --- /dev/null +++ b/proof/old/ConcreteF.eca @@ -0,0 +1,77 @@ +require import Pred Fun Option Pair Int Real StdOrder Ring. +require import List FSet NewFMap Utils Common SLCommon. +(*...*) import Dprod Dexcepted Capacity IntOrder. + +module Concrete(D:DISTINGUISHER) = RealIndif(SqueezelessSponge,Perm,D). +(** An intermediate game where we don't care about the permutation + being a bijection anymore... **) +module CF(D:DISTINGUISHER) = { + var m, mi: (state,state) fmap + + module P = { + proc init(): unit = { } + + proc f(x : state): state = { + var y; + + if (!mem (dom m) x) { + y <$ dstate; + m.[x] <- y; + mi.[y] <- x; + } + return oget m.[x]; + } + + proc fi(x : state): state = { + var y; + + if (!mem (dom mi) x) { + y <$ dstate; + mi.[x] <- y; + m.[y] <- x; + } + return oget mi.[x]; + } + + } + + module C = { + proc init(): unit = { } + + proc f(p : block list): block = { + var (sa,sc) <- (b0,c0); + + if (1 <= size p /\ p <> [b0]) { + while (p <> []) { (* Absorption *) + (sa,sc) <@ P.f((sa +^ head witness p,sc)); + p <- behead p; + } + } + return sa; (* Squeezing phase (non-iterated) *) + } + } + + proc main(): bool = { + var b; + + m <- map0; + mi <- map0; + b <@ D(C,P).distinguish(); + return b; + } + }. + +section PROOF. + + declare module D : DISTINGUISHER {Perm, RO, CF}. + + op bound_concrete : real. + + lemma Concrete_CF &m: + Pr[Concrete(D).main() @ &m: res] <= + Pr[CF(D).main() @ &m: res] + bound_concrete. + admitted. + +end section PROOF. + + diff --git a/proof/old/G1.eca b/proof/old/G1.eca new file mode 100644 index 0000000..d3dcd1f --- /dev/null +++ b/proof/old/G1.eca @@ -0,0 +1,405 @@ +require import Pred Fun Option Pair Int Real StdOrder Ring. +require import List FSet NewFMap Utils Common SLCommon. +(*...*) import Dprod Dexcepted Capacity IntOrder. + +require ConcreteF. + +module G1(D:DISTINGUISHER) = { + var m, mi : smap + var mh, mhi : hsmap + var handles : handles + var chandle : int + var paths : (capacity, block list * block) fmap + var bext, bcol : bool + + + module C = { + proc init(): unit = { } + + proc f(p : block list): block = { + var sa, sa', sc; + var h, i <- 0; + sa <- b0; + if (1 <= size p /\ p <> [b0]) { + while (i < size p ) { + if (mem (dom mh) (sa +^ nth witness p i, h)) { + (sa, h) <- oget mh.[(sa +^ nth witness p i, h)]; + } else { + sc <$ cdistr; + bcol <- bcol \/ hinv handles sc <> None; + sa' <- RO.f(take (i+1) p); + sa <- sa +^ nth witness p i; + mh.[(sa,h)] <- (sa', chandle); + mhi.[(sa',chandle)] <- (sa, h); + (sa,h) <- (sa',chandle); + handles.[chandle] <- (sc,I); + chandle <- chandle + 1; + } + i <- i + 1; + } + sa <- RO.f(p); + } + return sa; + } + } + + module S = { + (** Inner interface **) + proc f(x : state): state = { + var p, v, y, y1, y2, hy2, hx2; + + if (!mem (dom m) x) { + if (mem (dom paths) x.`2) { + (p,v) <- oget paths.[x.`2]; + y1 <- RO.f (rcons p (v +^ x.`1)); + y2 <$ cdistr; + y <- (y1, y2); + paths.[y2] <- (rcons p (v +^ x.`1), y.`1); + } else { + y <$ dstate; + } + bext <- bext \/ mem (rng handles) (x.`2, I); + (* exists x2 h, handles.[h] = Some (X2,I) *) + if (!(mem (rng handles) (x.`2, D))) { + handles.[chandle] <- (x.`2, D); + chandle <- chandle + 1; + } + hx2 <- oget (hinvD handles x.`2); + if (mem (dom mh) (x.`1, hx2) /\ (oget handles.[(oget mh.[(x.`1,hx2)]).`2]).`2 = I) { + hy2 <- (oget mh.[(x.`1, hx2)]).`2; + y <- (y.`1, (oget handles.[hy2]).`1); + handles.[hy2] <- (y.`2, D); + (* bad <- bad \/ mem X2 y.`2; *) + m.[x] <- y; + mi.[y] <- x; + } else { + bcol <- bcol \/ hinv handles y.`2 <> None; + hy2 <- chandle; + chandle <- chandle + 1; + handles.[hy2] <- (y.`2, D); + m.[x] <- y; + mh.[(x.`1, hx2)] <- (y.`1, hy2); + mi.[y] <- x; + mhi.[(y.`1, hy2)] <- (x.`1, hx2); + } + } else { + y <- oget m.[x]; + } + return y; + } + + proc fi(x : state): state = { + var y, y1, hx2, hy2; + + if (!mem (dom mi) x) { + bext <- bext \/ mem (rng handles) (x.`2, I); + (* exists x2 h, handles.[h] = Some (X2,I) *) + if (!(mem (rng handles) (x.`2, D))) { + handles.[chandle] <- (x.`2, D); + chandle <- chandle + 1; + } + hx2 <- oget (hinvD handles x.`2); + y <$ dstate; + if (mem (dom mhi) (x.`1, hx2) /\ (oget handles.[(oget mh.[(x.`1,hx2)]).`2]).`2 = I) { + (y1,hy2) <- oget mhi.[(x.`1, hx2)]; + y <- (y.`1, (oget handles.[hy2]).`1); + handles.[hy2] <- (y.`2, D); + (* bad <- bad \/ mem X2 y.`2; *) + mi.[x] <- y; + mhi.[(x.`1, hx2)] <- (y.`1, hy2); + m.[y] <- x; + mh.[(y.`1, hy2)] <- (x.`1, hx2); + } else { + bcol <- bcol \/ hinv handles y.`2 <> None; + hy2 <- chandle; + chandle <- chandle + 1; + handles.[hy2] <- (y.`2, D); + mi.[x] <- y; + mhi.[(x.`1, hx2)] <- (y.`1, hy2); + m.[y] <- x; + mh.[(y.`1, hy2)] <- (x.`1, hx2); + } + } else { + y <- oget mi.[x]; + } + return y; + } + + (** Distinguisher interface **) + proc init() = { } + + } + + proc main(): bool = { + var b; + + m <- map0; + mi <- map0; + bext <- false; + bcol <- false; + + (* the empty path is initially known by the adversary to lead to capacity 0^c *) + handles <- map0.[0 <- (c0, D)]; + paths <- map0.[c0 <- ([<:block>],b0)]; + chandle <- 1; + b <@ D(C,S).distinguish(); + return b; + } +}. + +(* -------------------------------------------------------------------------- *) + +op eqm_handles (handles:handles) (m:smap) (mh:hsmap) = + (forall bc bc', m.[bc] = Some bc' => + exists h h' f f', + handles.[h ] = Some(bc .`2,f ) /\ + handles.[h'] = Some(bc'.`2,f') /\ + mh.[(bc.`1, h)] = Some (bc'.`1,h')) /\ + (forall bh bh', mh.[bh] = Some bh' => + exists c c' f f', + handles.[bh .`2] = Some(c ,f) /\ + handles.[bh'.`2] = Some(c',f') /\ + m.[(bh.`1, c)] = Some (bh'.`1,c')). + +op mh_spec (handles:handles) (m2:smap) (mh:hsmap) (ro:(block list, block)fmap) = + (forall bh bh', mh.[bh] = Some bh' => + exists c f c' f', + handles.[bh .`2]=Some(c,f) /\ + handles.[bh'.`2]=Some(c',f') /\ + if f' = D then m2.[(bh.`1,c)] = Some(bh'.`1,c') /\ f = D + else + exists p v b, + ro.[rcons p b] = Some bh'.`1 /\ + build_hpath mh p = Some(v,bh.`2) /\ + bh.`1 = v +^ b) /\ + (forall p b, mem (dom ro) (rcons p b) <=> + exists v h h', + build_hpath mh p = Some (v,h) /\ + mh.[(v +^ b,h)] = Some (oget ro.[rcons p b], h')). + +op paths_spec (handles:handles) (mh:hsmap) (paths:(capacity,block list * block)fmap) = + forall c p v, paths.[c] = Some(p,v) <=> + exists h, + build_hpath mh p = Some(v,h) /\ + handles.[h] = Some(c,D). + +op handles_spec handles chandle = + huniq handles /\ handles.[0] = Some (c0,D) /\ forall h, mem (dom handles) h => h < chandle. + +op INV_CF_G1 (handles:handles) chandle (m1 mi1 m2 mi2:smap) (mh2 mhi2:hsmap) (ro:(block list, block) fmap) paths = + (eqm_handles handles m1 mh2 /\ eqm_handles handles mi1 mhi2) /\ + (incl m2 m1 /\ incl mi2 mi1) /\ + (mh_spec handles m2 mh2 ro /\ paths_spec handles mh2 paths /\ handles_spec handles chandle). + +lemma eqm_dom_mh_m handles m mh hx2 f (x:state): + eqm_handles handles m mh => + handles.[hx2] = Some (x.`2, f) => + mem (dom mh) (x.`1, hx2) => mem (dom m) x. +proof. + move=>[]H1 H2 Hhx2;rewrite !in_dom. + case: (mh.[_]) (H2 (x.`1,hx2))=> //= bh' /(_ bh') [c c' f1 f1']. + by rewrite Hhx2=> /=[][]<<- _;case:(x)=> ??[]_->. +qed. + +lemma chandle_ge0 handles chandle : handles_spec handles chandle => 0 < chandle. +proof. by move=>[]_[]Heq Hlt;apply Hlt;rewrite in_dom Heq. qed. + +lemma chandle_0 handles chandle : handles_spec handles chandle => 0 <> chandle. +proof. move=> Hh;apply /IntOrder.ltr_eqF/(chandle_ge0 _ _ Hh). qed. + +lemma eqm_up_handles handles chandle m mh x2 : + handles_spec handles chandle => + eqm_handles handles m mh => + eqm_handles handles.[chandle <- (x2, D)] m mh. +proof. + move=> []Hu[Hh0 Hlt][]H1 H2;split=> + [bc bc'/H1 [h h' f f'][]Hh[]Hh' Hmh| bh bh'/H2 [c c' f f'][]Hh []Hh' Hm]. + + exists h,h',f,f';rewrite !getP Hmh/=-Hh-Hh'(_:h<>chandle)2:(_:h'<>chandle) //. + + by apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom Hh. + by apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom Hh'. + exists c,c',f,f';rewrite !getP Hm/=-Hh-Hh'(_:bh.`2<>chandle)2:(_:bh'.`2<>chandle) //. + + by apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom Hh. + by apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom Hh'. +qed. + +lemma mh_up_handles handles chandle m2 mh ro cf: + handles_spec handles chandle => + mh_spec handles m2 mh ro => + mh_spec handles.[chandle <- cf] m2 mh ro. +proof. + move=> Hh Hmh. + move:Hmh Hh=>[H1 ?][_[]_ Hlt];split=>// bh bh' /H1 [c f c' f'][]Hh[]Hh' Hif. + exists c,f,c',f';rewrite Hif-Hh-Hh'!getP(_:bh.`2<>chandle)2:(_:bh'.`2<>chandle) //. + + by apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom Hh. + by apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom Hh'. +qed. + +lemma paths_up_handles m2 ro handles mh paths cf chandle: + mh_spec handles m2 mh ro => + handles_spec handles chandle => + paths_spec handles mh paths => + paths_spec handles.[chandle <- cf] mh paths. +proof. + move=> Hmh Hh Hp c p v;rewrite Hp;apply NewLogic.exists_iff=> h/=;split=> -[^Hbu->] /=; + rewrite getP. + + move:Hh=>[]_[]_/(_ h)Hlt Hh;rewrite (_:h<>chandle)//. + by apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom Hh. + rewrite (_:h<>chandle)//. + cut [[]_[]_->|[p' b v' h'[]_[]_ Hh']]:= build_hpathP _ _ _ _ Hbu. + + by rewrite (chandle_0 _ _ Hh). + move:Hh=>[]_[]_/(_ h)Hlt;apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom. + by cut [/(_ _ _ Hh')[????][]_[]->]:= Hmh. +qed. + +lemma handles_up_handles handles chandle x2 f': + (forall (f : caller), ! mem (rng handles) (x2, f)) => + handles_spec handles chandle => + handles_spec handles.[chandle <- (x2, f')] (chandle + 1). +proof. + move=> Hx2^Hh[]Hu[]Hh0 Hlt;split;[ | split]. + + move=> h1 h2 [c1 f1] [c2 f2];rewrite !getP. + case (h1=chandle)=>[->/=[]->> ->|_]; (case (h2=chandle)=>[->//=|_]). + + by move=>Heq ->>;move:(Hx2 f2);rewrite in_rng NewLogic.negb_exists=>/=/(_ h2); + rewrite Heq. + + by move=>Heq[]->> <<- ->>;move:(Hx2 f1);rewrite in_rng NewLogic.negb_exists=>/=/(_ h1); + rewrite Heq. + by apply Hu. + + by rewrite getP (chandle_0 _ _ Hh). + move=>h;rewrite dom_set !inE /#. +qed. + +lemma INV_CF_G1_up_handles handles chandle m1 mi1 m2 mi2 mh mhi ro paths x2: + INV_CF_G1 handles chandle m1 mi1 m2 mi2 mh mhi ro paths => + (forall f, ! mem (rng handles) (x2, f)) => + INV_CF_G1 handles.[chandle <- (x2, D)](chandle+1) m1 mi1 m2 mi2 mh mhi ro paths. +proof. + move=>[][]Heqm Heqmi[]Hincl[]Hmh[]Hp Hh Hx2;split. + + by split;apply eqm_up_handles. + split=>//;split;[|split]. + + by apply mh_up_handles. + + by apply (paths_up_handles m2 ro). + by apply handles_up_handles. +qed. + +section PROOF. + + declare module D : DISTINGUISHER {Perm, RO, G1}. + + axiom D_ll (F <: DFUNCTIONALITY{D}) (P <: DPRIMITIVE{D}): + islossless P.f => islossless P.fi => islossless F.f => + islossless D(F, P).distinguish. + + local clone import ConcreteF as ConcreteF'. + + local equiv CF_G1 : CF(D).main ~ G1(D).main : ={glob D} ==> !(G1.bcol \/ G1.bext){2} => ={res}. + proof. + proc. + call (_:(G1.bcol \/ G1.bext), INV_CF_G1 G1.handles{2} G1.chandle{2} CF.m{1} CF.mi{1} G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} RO.m{2} G1.paths{2}). + (* lossless D *) + + apply D_ll. + (** proofs for G1.S.f *) + (* equiv CF.P.f G1.S.f *) + + proc;if{1}=>/=. + (* x is not in m{1} so forall h, (x.1,h) is not in mh{2} *) + + rcondt{2} 1. + + move=> &hr;skip=> &hr'[][]_[]<-[]_[][]Hincl Hincli _. + rewrite !in_dom/==>H; by case:(G1.m{hr'}.[x{hr}]) (Hincl x{hr})=> //=;rewrite H. + exists* RO.m{2}, G1.paths{2};elim*=>ro0 paths0. + seq 1 2 : (!G1.bcol{2} /\ (G1.bext = mem (rng G1.handles) (x.`2, I)){2} /\ + ={x,y} /\ + INV_CF_G1 G1.handles{2} G1.chandle{2} CF.m{1} CF.mi{1} G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} ro0 paths0 /\ + ! mem (dom CF.m{1}) x{1} /\ + (if mem (dom paths0) x.`2 then + let (p,v) = oget paths0.[x.`2] in + RO.m{2} = ro0.[rcons p (v+^x.`1) <- y.`1] /\ + G1.paths = paths0.[y.`2 <- (rcons p (v +^ x.`1), y.`1)] + else RO.m = ro0 /\ G1.paths = paths0){2}). + + wp 1 1;conseq (_: ={y} /\ + if mem (dom paths0) x{2}.`2 then + let (p0, v0) = oget paths0.[x{2}.`2] in + RO.m{2} = ro0.[rcons p0 (v0 +^ x{2}.`1) <- y{2}.`1] /\ + G1.paths{2} = paths0.[y{2}.`2 <- (rcons p0 (v0 +^ x{2}.`1), y{2}.`1)] + else RO.m{2} = ro0 /\ G1.paths{2} = paths0);1:smt ml=0. + if{2};2:by auto=>/#. + inline{2} RO.f;rcondt{2} 4. + + move=> &ml;auto=>/= &mr[][]_[][]_[]->[][][]_ Heqm _[]_[][]_ Hro[] Hpath _ HnCFm. + rewrite in_dom;case:(G1.paths{mr}.[_]) (Hpath x{mr}.`2)=>//[[p v]]/(_ p v)/=[h][]Hbu Hh b _. + rewrite -not_def=> /Hro [??h'];rewrite oget_some Hbu => [][]<- <- /=. + rewrite Block.xorwA Block.xorwK Block.xorwC Block.xorw0 -not_def=>/Heqm [c c' f f']. + by rewrite Hh=>[][]<- _[]_ Hm;move:HnCFm;rewrite in_dom;case:(x{mr}) Hm=> ??->. + swap{2} 3-2;swap{2}6-4;wp;conseq (_:y{1} =(rd,y2){2}). + + progress [-split];rewrite getP_eq oget_some H2/=. + by move:H2;rewrite in_dom;case:(G1.paths{2}.[_]). + transitivity{1} {y <- S.sample();} (true ==> ={y}) (true==>y{1}=(rd,y2){2})=>//;1:by inline*;auto. + transitivity{2} {(rd,y2) <- S.sample2();} (true==>y{1}=(rd,y2){2}) (true==> ={rd,y2})=>//;2:by inline*;auto. + by call sample_sample2;auto=> /=?[??]->. + case (mem (rng G1.handles{2}) (x{2}.`2, I)). + + conseq (_:true);[by move=> ??[][]_[]->_->|auto]. + conseq (_: !G1.bcol{2} => + oget CF.m{1}.[x{1}] = y{2} /\ + INV_CF_G1 G1.handles{2} G1.chandle{2} CF.m{1} CF.mi{1} G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} RO.m{2} G1.paths{2}). + + by move=> ??[][]_[]->[][]-> _ _ ->. + seq 0 2: ((!G1.bcol{2} /\ ={x, y} /\ + INV_CF_G1 G1.handles{2} G1.chandle{2} CF.m{1} CF.mi{1} G1.m{2} G1.mi{2} + G1.mh{2} G1.mhi{2} ro0 paths0 /\ + ! mem (dom CF.m{1}) x{1} /\ + if mem (dom paths0) x{2}.`2 then + let (p0, v0) = oget paths0.[x{2}.`2] in + RO.m{2} = ro0.[rcons p0 (v0 +^ x{2}.`1) <- y{2}.`1] /\ + G1.paths{2} = paths0.[y{2}.`2 <- (rcons p0 (v0 +^ x{2}.`1), y{2}.`1)] + else RO.m{2} = ro0 /\ G1.paths{2} = paths0) /\ + !mem (rng G1.handles{2}) (x{2}.`2, I) /\ + (G1.handles.[hx2]=Some(x.`2,D)){2}). + + auto=> &ml&mr[][]->[]_[][]-> ->[]Hinv []-> -> ^Hrng-> /=. + case (mem (rng G1.handles{mr}) (x{mr}.`2, D))=> Hmem /=. + + by split=>//;apply /huniq_hinvD=>//;move:Hinv;rewrite /INV_CF_G1/handles_spec. + rewrite -anda_and;split=> [ | {Hinv}Hinv]. + + by apply INV_CF_G1_up_handles=>//[[]]. + rewrite rng_set (huniq_hinvD_h G1.chandle{mr}) ?getP//. + + by move:Hinv;rewrite /INV_CF_G1/handles_spec. + by rewrite oget_some /=!inE/=;move:Hrng;apply NewLogic.contraLR=>/=;apply rng_rem_le. + rcondf{2} 1. + + move=> &ml;skip=> &mr[][]_[][]-> _ []Hinv[]Hndom _[]_ Hh;rewrite -not_def in_dom=>[]. + move:Hinv=>[][][]_ /(_ (x{mr}.`1, hx2{mr}));case (G1.mh{mr}.[_])=>// bh' /(_ bh') [c c' f f'] /=. + by rewrite Hh/= =>[][]<- _ []_ H;case: (x{mr}) H Hndom => [x1 x2];rewrite in_dom=>->. + auto. + (* Stopped here *) + admit. + admit. + (* lossless CF.P.f *) + + admit. + (* lossless and do not reset bad G1.S.f *) + + admit. + (** proofs for G1.S.fi *) + (* equiv CF.P.fi G1.S.fi *) + + admit. + (* lossless CF.P.fi *) + + admit. + (* lossless and do not reset bad G1.S.fi *) + + admit. + (** proofs for G1.C.f *) + (* equiv CF.C.f G1.C.f *) + + admit. + (* lossless CF.C.f *) + + admit. + (* lossless and do not reset bad G1.C.f *) + + admit. + (* Init ok *) + + admit. + qed. + + lemma Concrete_G1 &m: + Pr[RealIndif(SqueezelessSponge,Perm,D).main() @ &m: res] <= + Pr[G1(D).main() @ &m: res] + bound_concrete + Pr[G1(D).main() @&m: G1.bcol] + Pr[G1(D).main() @&m: G1.bext]. + proof. + apply (RealOrder.ler_trans _ _ _ (Concrete_CF D &m)). + cut : Pr[CF(D).main() @ &m : res] <= + Pr[G1(D).main() @ &m : res] + Pr[G1(D).main() @ &m : G1.bcol \/ G1.bext]. + + by byequiv CF_G1 =>/#. + cut /# : Pr[G1(D).main() @ &m : G1.bcol \/ G1.bext] <= Pr[G1(D).main() @ &m : G1.bcol] + Pr[G1(D).main() @ &m : G1.bext]. + rewrite Pr [mu_or]; smt. + qed. + +end section PROOF. + + diff --git a/proof/old/SLCommon.ec b/proof/old/SLCommon.ec new file mode 100644 index 0000000..cfbe2ca --- /dev/null +++ b/proof/old/SLCommon.ec @@ -0,0 +1,208 @@ + +(** This is a theory for the Squeezeless sponge: where the ideal + functionality is a fixed-output-length random oracle whose output + length is the input block size. We prove its security even when + padding is not prefix-free. **) +require import Pred Fun Option Pair Int Real StdOrder Ring. +require import List FSet NewFMap Utils Common. + +require (*..*) RndOrcl Indifferentiability. +(*...*) import Dprod Dexcepted Capacity IntOrder. + +type state = block * capacity. +op dstate = bdistr * cdistr. + + +clone include Indifferentiability with + type p <- state, + type f_in <- block list, + type f_out <- block + rename [module] "GReal" as "RealIndif" + [module] "GIdeal" as "IdealIndif". + + +(** max number of call to the permutation and its inverse, + including those performed by the construction. *) +op max_size : int. + +(** Ideal Functionality **) +clone export Tuple as TupleBl with + type t <- block, + op Support.enum <- Block.words + proof Support.enum_spec by exact Block.enum_spec. + +op bl_enum = flatten (mkseq (fun i => wordn i) (max_size + 1)). +op bl_univ = FSet.oflist bl_enum. + +clone RndOrcl as RndOrclB with + type from <- block list, + type to <- block. + +clone export RndOrclB.RestrIdeal as Functionality with + op sample _ <- bdistr, + op test l <- List.size l <= max_size, + op univ <- bl_univ, + op dfl <- b0 + proof *. +realize sample_ll by exact Block.DWord.bdistr_ll. +realize testP. +proof. + move=> x; rewrite mem_oflist-flattenP; split=>[_|[s[/mkseqP[i[/=_->>]]/wordnP->/#]]]. + exists (wordn (size x));cut Hsx := size_ge0 x. + rewrite wordnP max_ler //= mkseqP /=;exists (size x);smt ml=0. +qed. + +(** We can now define the squeezeless sponge construction **) +module SqueezelessSponge (P:PRIMITIVE): CONSTRUCTION(P), FUNCTIONALITY = { + proc init () = {} + + proc f(p : block list): block = { + var (sa,sc) <- (b0,c0); + + if (1 <= size p /\ p <> [b0]) { + while (p <> []) { (* Absorption *) + (sa,sc) <@ P.f((sa +^ head witness p,sc)); + p <- behead p; + } + } + return sa; (* Squeezing phase (non-iterated) *) + } +}. + +clone export Pair.Dprod.Sample as Sample2 with + type t1 <- block, + type t2 <- capacity, + op d1 <- bdistr, + op d2 <- cdistr. + +(* -------------------------------------------------------------------------- *) +(** TODO move this **) + +op incl (m m':('a,'b)fmap) = + forall x, m .[x] <> None => m'.[x] = m.[x]. + +(* -------------------------------------------------------------------------- *) +(** usefull type and operators for the proof **) + +type caller = [ I | D ]. + +type handle = int. + +type hstate = block * handle. + +type ccapacity = capacity * caller. + +type smap = (state , state ) fmap. +type hsmap = (hstate, hstate ) fmap. +type handles = (handle, ccapacity) fmap. + +(* Did we use it? *) +op (<=) (o1 o2 : caller) = o1 = I \/ o2 = D. + +(* Did we use it? *) +op max (o1 o2 : caller) = + with o1 = I => o2 + with o1 = D => D. + +pred is_pre_permutation (m mi : ('a,'a) fmap) = + (forall x, mem (rng m) x => mem (dom mi) x) + /\ (forall x, mem (rng mi) x => mem (dom m) x). + +lemma half_permutation_set (m' mi' : ('a,'a) fmap) x' y': + (forall x, mem (rng m') x => mem (dom mi') x) + => (forall x, mem (rng m'.[x' <- y']) x => mem (dom mi'.[y' <- x']) x). +proof. + move=> h x0. + rewrite rng_set domP !in_fsetU in_fset1 => [/rng_rem_le in_rng|//=]. + by rewrite h. +qed. + +lemma pre_permutation_set (m mi : ('a,'a) fmap) x y: + is_pre_permutation m mi => + is_pre_permutation m.[x <- y] mi.[y <- x]. +proof. + move=> [dom_mi dom_m]. + by split; apply/half_permutation_set. +qed. + +(** Operators and properties of handles *) + +op hinv (handles:handles) (c:capacity) = + find (fun _ => pred1 c \o fst) handles. + +op hinvD (handles:handles) (c:capacity) = + find (fun _ => pred1 (c,D)) handles. + +op huniq (handles:handles) = + forall h1 h2 cf1 cf2, + handles.[h1] = Some cf1 => + handles.[h2] = Some cf2 => + cf1.`1 = cf2.`1 => h1 = h2. + +lemma hinvP handles c: + if hinv handles c = None then forall h f, handles.[h] <> Some(c,f) + else exists f, handles.[oget (hinv handles c)] = Some(c,f). +proof. + cut @/pred1@/(\o)/=[[h []->[]Hmem <<-]|[]->H h f]/= := + findP (fun (_ : handle) => pred1 c \o fst) handles. + + by exists (oget handles.[h]).`2;rewrite oget_some get_oget;2:case (oget handles.[h]). + by rewrite -not_def=> Heq; cut := H h;rewrite in_dom Heq. +qed. + +lemma huniq_hinv (handles:handles) (h:handle): + huniq handles => mem (dom handles) h => hinv handles (oget handles.[h]).`1 = Some h. +proof. + move=> Huniq;pose c := (oget handles.[h]).`1. + cut:=Huniq h;cut:=hinvP handles c. + case (hinv _ _)=> /=[Hdiff _| h' +/(_ h')];1:by rewrite in_dom /#. + by move=> [f ->] /(_ (oget handles.[h]) (c,f)) H1 H2;rewrite H1 // get_oget. +qed. + +lemma hinvDP handles c: + if hinvD handles c = None then forall h, handles.[h] <> Some(c,D) + else handles.[oget (hinvD handles c)] = Some(c,D). +proof. + cut @/pred1/=[[h []->[]Hmem ]|[]->H h ]/= := + findP (fun (_ : handle) => pred1 (c,D)) handles. + + by rewrite oget_some get_oget. + by rewrite -not_def=> Heq; cut := H h;rewrite in_dom Heq. +qed. + +lemma huniq_hinvD (handles:handles) c: + huniq handles => mem (rng handles) (c,D) => handles.[oget (hinvD handles c)] = Some(c,D). +proof. + move=> Huniq;rewrite in_rng=> [h]H;case: (hinvD _ _) (Huniq h) (hinvDP handles c)=>//=. + by move=>_/(_ h);rewrite H. +qed. + +lemma huniq_hinvD_h h (handles:handles) c: + huniq handles => handles.[h] = Some (c,D) => hinvD handles c = Some h. +proof. + move=> Huniq;case: (hinvD _ _) (hinvDP handles c)=>/= [H|h'];1: by apply H. + by rewrite oget_some=> /Huniq H/H. +qed. + +(* Functionnal version of the construction using handle *) + +op step_hpath (mh:hsmap) (sah:hstate option) (b:block) = + if sah = None then None + else + let sah = oget sah in + mh.[(sah.`1 +^ b, sah.`2)]. + +op build_hpath (mh:hsmap) (bs:block list) = + foldl (step_hpath mh) (Some (b0,0)) bs. + +lemma build_hpathP mh p v h: + build_hpath mh p = Some (v, h) => + (p = [] /\ v=b0 /\ h=0) \/ + exists p' b v' h', + p = rcons p' b /\ build_hpath mh p' = Some(v',h') /\ mh.[(v'+^b, h')] = Some(v,h). +proof. + elim/last_ind:p=>@/build_hpath //= p' b _. + rewrite -cats1 foldl_cat /= => H;right;exists p',b. + move:H;rewrite {1}/step_hpath;case (foldl _ _ _)=> //= -[v' h']. + by rewrite oget_some /==>Heq; exists v',h';rewrite -cats1. +qed. + + diff --git a/proof/old/Squeezeless.ec b/proof/old/Squeezeless.ec index 33743e4..a684ada 100644 --- a/proof/old/Squeezeless.ec +++ b/proof/old/Squeezeless.ec @@ -67,83 +67,91 @@ module SqueezelessSponge (P:PRIMITIVE): CONSTRUCTION(P), FUNCTIONALITY = { } }. -section. +module Count = { var c:int }. - declare module D : Self.DISTINGUISHER {Perm, RO}. +module DCount (D:DISTINGUISHER, F:DFUNCTIONALITY, P:DPRIMITIVE) = { - local module Concrete = RealIndif(SqueezelessSponge,Perm,D). - - (** Result: The adversary's advantage in distinguishing the modular - defs is equal to that of distinguishing these **) - local lemma Inlined_pr &m: - Pr[RealIndif(SqueezelessSponge,Perm,D).main() @ &m: res] - = Pr[Concrete.main() @ &m: res]. - proof. trivial. qed. + module Fc = { + proc f (bs:block list) = { + var b; + Count.c <- Count.c + size bs; + b <@ F.f(bs); + return b; + } + } - (** An intermediate game where we don't care about the permutation - being a bijection anymore... **) - local module CF = { - var m, mi: (state,state) fmap + module Pc = { + proc f (x:state) = { + var y; + Count.c <- Count.c + 1; + y <@ P.f(x); + return y; + } - module P = { - proc init(): unit = { } + proc fi(x:state) = { + var y; + Count.c <- Count.c + 1; + y <@ P.fi(x); + return y; + } + } - proc f(x : state): state = { - var y; + proc distinguish = D(Fc,Pc).distinguish - if (!mem (dom m) x) { - y <$ dstate; - m.[x] <- y; - mi.[y] <- x; - } - return oget m.[x]; - } +}. - proc fi(x : state): state = { - var y; +module DRestr (D:DISTINGUISHER, F:DFUNCTIONALITY, P:DPRIMITIVE) = { + var count:int - if (!mem (dom mi) x) { - y <$ dstate; - mi.[x] <- y; - m.[y] <- x; - } - return oget mi.[x]; + module Fc = { + proc f (bs:block list) = { + var b = b0; + if (Count.c + size bs <= max_size) { + Count.c <- Count.c + size bs; + b <@ F.f(bs); } + return b; + } + } + module Pc = { + proc f (x:state) = { + var y; + if ( + count <- count + 1; + y <@ P.f(x); + return y; } - module C = { - proc init(): unit = { } + proc fi(x:state) = { + var y; + count <- count + 1; + y <@ P.fi(x); + return y; + } + } - proc f(p : block list): block = { - var (sa,sc) <- (b0,c0); + proc distinguish = D(Fc,Pc).distinguish - if (1 <= size p /\ p <> [b0]) { - while (p <> []) { (* Absorption *) - (sa,sc) <@ P.f((sa +^ head witness p,sc)); - p <- behead p; - } - } - return sa; (* Squeezing phase (non-iterated) *) - } - } +}. - proc main(): bool = { - var b; - m <- map0; - mi <- map0; - b <@ D(C,P).distinguish(); - return b; - } - }. - - op bound_concrete : real. - local lemma Concrete_CF &m: - Pr[Concrete.main() @ &m: res] <= - Pr[CF.main() @ &m: res] + bound_concrete. - admitted. + +module type DPRIMITIVE = { + proc f(x : p): p + proc fi(x : p): p +}. + +module type FUNCTIONALITY = { + proc init(): unit + proc f(x : f_in): f_out +}. + +module type DFUNCTIONALITY = { + proc f(x : f_in): f_out +}. + (** Result (expected): The distance between Concrete and Concrete_F is bounded by N^2/|state|, where N is the total cost (in terms @@ -226,7 +234,7 @@ proof. by case (p x y)=> //; cut := Hp x;rewrite getP dom_set !inE /= oget_some. qed. -require import StdOrder. +require import StdOrder IntOrder. require import Ring. (* Operators and properties of handles *) @@ -285,416 +293,7 @@ require import Ring. by rewrite oget_some=> /Huniq H/H. qed. - local module G2 = { - var m, mi : smap - var mh, mhi : hsmap - var handles : handles - var chandle : int - var paths : (capacity, block list * block) fmap - var bext, bcol : bool - - - module C = { - proc init(): unit = { } - - proc f(p : block list): block = { - var sa, sa', sc; - var h, i <- 0; - sa <- b0; - if (1 <= size p /\ p <> [b0]) { - while (i < size p ) { - if (mem (dom mh) (sa +^ nth witness p i, h)) { - (sa, h) <- oget mh.[(sa +^ nth witness p i, h)]; - } else { - sc <$ cdistr; - bcol <- bcol \/ hinv handles sc <> None; - sa' <- RO.f(take (i+1) p); - sa <- sa +^ nth witness p i; - mh.[(sa,h)] <- (sa', chandle); - mhi.[(sa',chandle)] <- (sa, h); - (sa,h) <- (sa',chandle); - handles.[chandle] <- (sc,I); - chandle <- chandle + 1; - } - i <- i + 1; - } - sa <- RO.f(p); - } - return sa; - } - } - - module S = { - (** Inner interface **) - proc f(x : state): state = { - var p, v, y, y1, y2, hy2, hx2; - - if (!mem (dom m) x) { - if (mem (dom paths) x.`2) { - (p,v) <- oget paths.[x.`2]; - y1 <- RO.f (rcons p (v +^ x.`1)); - y2 <$ cdistr; - y <- (y1, y2); - paths.[y2] <- (rcons p (v +^ x.`1), y.`1); - } else { - y <$ dstate; - } - bext <- bext \/ mem (rng handles) (x.`2, I); - (* exists x2 h, handles.[h] = Some (X2,I) *) - if (!(mem (rng handles) (x.`2, D))) { - handles.[chandle] <- (x.`2, D); - chandle <- chandle + 1; - } - hx2 <- oget (hinvD handles x.`2); - if (mem (dom mh) (x.`1, hx2) /\ (oget handles.[(oget mh.[(x.`1,hx2)]).`2]).`2 = I) { - hy2 <- (oget mh.[(x.`1, hx2)]).`2; - y <- (y.`1, (oget handles.[hy2]).`1); - handles.[hy2] <- (y.`2, D); - (* bad <- bad \/ mem X2 y.`2; *) - m.[x] <- y; - mi.[y] <- x; - } else { - bcol <- bcol \/ hinv handles y.`2 <> None; - hy2 <- chandle; - chandle <- chandle + 1; - handles.[hy2] <- (y.`2, D); - m.[x] <- y; - mh.[(x.`1, hx2)] <- (y.`1, hy2); - mi.[y] <- x; - mhi.[(y.`1, hy2)] <- (x.`1, hx2); - } - } else { - y <- oget m.[x]; - } - return y; - } - - proc fi(x : state): state = { - var y, y1, hx2, hy2; - - if (!mem (dom mi) x) { - bext <- bext \/ mem (rng handles) (x.`2, I); - (* exists x2 h, handles.[h] = Some (X2,I) *) - if (!(mem (rng handles) (x.`2, D))) { - handles.[chandle] <- (x.`2, D); - chandle <- chandle + 1; - } - hx2 <- oget (hinvD handles x.`2); - y <$ dstate; - if (mem (dom mhi) (x.`1, hx2) /\ (oget handles.[(oget mh.[(x.`1,hx2)]).`2]).`2 = I) { - (y1,hy2) <- oget mhi.[(x.`1, hx2)]; - y <- (y.`1, (oget handles.[hy2]).`1); - handles.[hy2] <- (y.`2, D); - (* bad <- bad \/ mem X2 y.`2; *) - mi.[x] <- y; - mhi.[(x.`1, hx2)] <- (y.`1, hy2); - m.[y] <- x; - mh.[(y.`1, hy2)] <- (x.`1, hx2); - } else { - bcol <- bcol \/ hinv handles y.`2 <> None; - hy2 <- chandle; - chandle <- chandle + 1; - handles.[hy2] <- (y.`2, D); - mi.[x] <- y; - mhi.[(x.`1, hx2)] <- (y.`1, hy2); - m.[y] <- x; - mh.[(y.`1, hy2)] <- (x.`1, hx2); - } - } else { - y <- oget mi.[x]; - } - return y; - } - - (** Distinguisher interface **) - proc init() = { } - - } - - proc main(): bool = { - var b; - - m <- map0; - mi <- map0; - bext <- false; - bcol <- false; - - (* the empty path is initially known by the adversary to lead to capacity 0^c *) - handles <- map0.[0 <- (c0, D)]; - paths <- map0.[c0 <- ([<:block>],b0)]; - chandle <- 1; - b <@ D(C,S).distinguish(); - return b; - } - }. - - op step_hpath (mh:hsmap) (sah:hstate option) (b:block) = - if sah = None then None - else - let sah = oget sah in - mh.[(sah.`1 +^ b, sah.`2)]. - op build_hpath (mh:hsmap) (bs:block list) = - foldl (step_hpath mh) (Some (b0,0)) bs. - - op eqm_handles (handles:handles) (m:smap) (mh:hsmap) = - (forall bc bc', m.[bc] = Some bc' => - exists h h' f f', - handles.[h ] = Some(bc .`2,f ) /\ - handles.[h'] = Some(bc'.`2,f') /\ - mh.[(bc.`1, h)] = Some (bc'.`1,h')) /\ - (forall bh bh', mh.[bh] = Some bh' => - exists c c' f f', - handles.[bh .`2] = Some(c ,f) /\ - handles.[bh'.`2] = Some(c',f') /\ - m.[(bh.`1, c)] = Some (bh'.`1,c')). - - op mh_spec (handles:handles) (m2:smap) (mh:hsmap) (ro:(block list, block)fmap) = - (forall bh bh', mh.[bh] = Some bh' => - exists c f c' f', - handles.[bh .`2]=Some(c,f) /\ - handles.[bh'.`2]=Some(c',f') /\ - if f' = D then m2.[(bh.`1,c)] = Some(bh'.`1,c') /\ f = D - else - exists p v b, - ro.[rcons p b] = Some bh'.`1 /\ - build_hpath mh p = Some(v,bh.`2) /\ - bh.`1 = v +^ b) /\ - (forall p b, mem (dom ro) (rcons p b) <=> - exists v h h', - build_hpath mh p = Some (v,h) /\ - mh.[(v +^ b,h)] = Some (oget ro.[rcons p b], h')). - - op paths_spec (handles:handles) (mh:hsmap) (paths:(capacity,block list * block)fmap) = - forall c p v, paths.[c] = Some(p,v) <=> - exists h, - build_hpath mh p = Some(v,h) /\ - handles.[h] = Some(c,D). - - op incl (m m':('a,'b)fmap) = - forall x, m .[x] <> None => m'.[x] = m.[x]. - - op handles_spec handles chandle = - huniq handles /\ handles.[0] = Some (c0,D) /\ forall h, mem (dom handles) h => h < chandle. - - op INV_CF_G2 (handles:handles) chandle (m1 mi1 m2 mi2:smap) (mh2 mhi2:hsmap) (ro:(block list, block) fmap) paths = - (eqm_handles handles m1 mh2 /\ eqm_handles handles mi1 mhi2) /\ - (incl m2 m1 /\ incl mi2 mi1) /\ - (mh_spec handles m2 mh2 ro /\ paths_spec handles mh2 paths /\ handles_spec handles chandle). - - lemma eqm_dom_mh_m handles m mh hx2 f (x:state): - eqm_handles handles m mh => - handles.[hx2] = Some (x.`2, f) => - mem (dom mh) (x.`1, hx2) => mem (dom m) x. - proof. - move=>[]H1 H2 Hhx2;rewrite !in_dom. - case: (mh.[_]) (H2 (x.`1,hx2))=> //= bh' /(_ bh') [c c' f1 f1']. - by rewrite Hhx2=> /=[][]<<- _;case:(x)=> ??[]_->. - qed. - - axiom D_ll (F <: FUNCTIONALITY{D}) (P <: PRIMITIVE{D}): - islossless P.f => islossless P.fi => islossless F.f => - islossless D(F, P).distinguish. - - clone import Pair.Dprod.Sample as Sample2 with - type t1 <- block, - type t2 <- capacity, - op d1 <- bdistr, - op d2 <- cdistr. - - lemma build_hpathP mh p v h: - build_hpath mh p = Some (v, h) => - (p = [] /\ v=b0 /\ h=0) \/ - exists p' b v' h', - p = rcons p' b /\ build_hpath mh p' = Some(v',h') /\ mh.[(v'+^b, h')] = Some(v,h). - proof. - elim/last_ind:p=>@/build_hpath //= p' b _. - rewrite -cats1 foldl_cat /= => H;right;exists p',b. - move:H;rewrite {1}/step_hpath;case (foldl _ _ _)=> //= -[v' h']. - by rewrite oget_some /==>Heq; exists v',h';rewrite -cats1. - qed. - - lemma chandle_ge0 handles chandle : handles_spec handles chandle => 0 < chandle. - proof. by move=>[]_[]Heq Hlt;apply Hlt;rewrite in_dom Heq. qed. - - lemma chandle_0 handles chandle : handles_spec handles chandle => 0 <> chandle. - proof. move=> Hh;apply /IntOrder.ltr_eqF/(chandle_ge0 _ _ Hh). qed. - - lemma eqm_up_handles handles chandle m mh x2 : - handles_spec handles chandle => - eqm_handles handles m mh => - eqm_handles handles.[chandle <- (x2, D)] m mh. - proof. - move=> []Hu[Hh0 Hlt][]H1 H2;split=> - [bc bc'/H1 [h h' f f'][]Hh[]Hh' Hmh| bh bh'/H2 [c c' f f'][]Hh []Hh' Hm]. - + exists h,h',f,f';rewrite !getP Hmh/=-Hh-Hh'(_:h<>chandle)2:(_:h'<>chandle) //. - + by apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom Hh. - by apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom Hh'. - exists c,c',f,f';rewrite !getP Hm/=-Hh-Hh'(_:bh.`2<>chandle)2:(_:bh'.`2<>chandle) //. - + by apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom Hh. - by apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom Hh'. - qed. - - lemma mh_up_handles handles chandle m2 mh ro cf: - handles_spec handles chandle => - mh_spec handles m2 mh ro => - mh_spec handles.[chandle <- cf] m2 mh ro. - proof. - move=> Hh Hmh. - move:Hmh Hh=>[H1 ?][_[]_ Hlt];split=>// bh bh' /H1 [c f c' f'][]Hh[]Hh' Hif. - exists c,f,c',f';rewrite Hif-Hh-Hh'!getP(_:bh.`2<>chandle)2:(_:bh'.`2<>chandle) //. - + by apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom Hh. - by apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom Hh'. - qed. - - lemma paths_up_handles m2 ro handles mh paths cf chandle: - mh_spec handles m2 mh ro => - handles_spec handles chandle => - paths_spec handles mh paths => - paths_spec handles.[chandle <- cf] mh paths. - proof. - move=> Hmh Hh Hp c p v;rewrite Hp;apply NewLogic.exists_iff=> h/=;split=> -[^Hbu->] /=; - rewrite getP. - + move:Hh=>[]_[]_/(_ h)Hlt Hh;rewrite (_:h<>chandle)//. - by apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom Hh. - rewrite (_:h<>chandle)//. - cut [[]_[]_->|[p' b v' h'[]_[]_ Hh']]:= build_hpathP _ _ _ _ Hbu. - + by rewrite (chandle_0 _ _ Hh). - move:Hh=>[]_[]_/(_ h)Hlt;apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom. - by cut [/(_ _ _ Hh')[????][]_[]->]:= Hmh. - qed. - - lemma handles_up_handles handles chandle x2 f': - (forall (f : caller), ! mem (rng handles) (x2, f)) => - handles_spec handles chandle => - handles_spec handles.[chandle <- (x2, f')] (chandle + 1). - proof. - move=> Hx2^Hh[]Hu[]Hh0 Hlt;split;[ | split]. - + move=> h1 h2 [c1 f1] [c2 f2];rewrite !getP. - case (h1=chandle)=>[->/=[]->> ->|_]; (case (h2=chandle)=>[->//=|_]). - + by move=>Heq ->>;move:(Hx2 f2);rewrite in_rng NewLogic.negb_exists=>/=/(_ h2); - rewrite Heq. - + by move=>Heq[]->> <<- ->>;move:(Hx2 f1);rewrite in_rng NewLogic.negb_exists=>/=/(_ h1); - rewrite Heq. - by apply Hu. - + by rewrite getP (chandle_0 _ _ Hh). - move=>h;rewrite dom_set !inE /#. - qed. - - lemma INV_CF_G2_up_handles handles chandle m1 mi1 m2 mi2 mh mhi ro paths x2: - INV_CF_G2 handles chandle m1 mi1 m2 mi2 mh mhi ro paths => - (forall f, ! mem (rng handles) (x2, f)) => - INV_CF_G2 handles.[chandle <- (x2, D)](chandle+1) m1 mi1 m2 mi2 mh mhi ro paths. - proof. - move=>[][]Heqm Heqmi[]Hincl[]Hmh[]Hp Hh Hx2;split. - + by split;apply eqm_up_handles. - split=>//;split;[|split]. - + by apply mh_up_handles. - + by apply (paths_up_handles m2 ro). - by apply handles_up_handles. - qed. - - local equiv CF_G2 : CF.main ~ G2.main : ={glob D} ==> !(G2.bcol \/ G2.bext){2} => ={res}. - proof. - proc. - call (_:(G2.bcol \/ G2.bext), INV_CF_G2 G2.handles{2} G2.chandle{2} CF.m{1} CF.mi{1} G2.m{2} G2.mi{2} G2.mh{2} G2.mhi{2} RO.m{2} G2.paths{2}). - (* lossless D *) - + apply D_ll. - (** proofs for G2.S.f *) - (* equiv CF.P.f G2.S.f *) - + proc;if{1}=>/=. - (* x is not in m{1} so forall h, (x.1,h) is not in mh{2} *) - + rcondt{2} 1. - + move=> &hr;skip=> &hr'[][]_[]<-[]_[][]Hincl Hincli _. - rewrite !in_dom/==>H; by case:(G2.m{hr'}.[x{hr}]) (Hincl x{hr})=> //=;rewrite H. - exists* RO.m{2}, G2.paths{2};elim*=>ro0 paths0. - seq 1 2 : (!G2.bcol{2} /\ (G2.bext = mem (rng G2.handles) (x.`2, I)){2} /\ - ={x,y} /\ - INV_CF_G2 G2.handles{2} G2.chandle{2} CF.m{1} CF.mi{1} G2.m{2} G2.mi{2} G2.mh{2} G2.mhi{2} ro0 paths0 /\ - ! mem (dom CF.m{1}) x{1} /\ - (if mem (dom paths0) x.`2 then - let (p,v) = oget paths0.[x.`2] in - RO.m{2} = ro0.[rcons p (v+^x.`1) <- y.`1] /\ - G2.paths = paths0.[y.`2 <- (rcons p (v +^ x.`1), y.`1)] - else RO.m = ro0 /\ G2.paths = paths0){2}). - + wp 1 1;conseq (_: ={y} /\ - if mem (dom paths0) x{2}.`2 then - let (p0, v0) = oget paths0.[x{2}.`2] in - RO.m{2} = ro0.[rcons p0 (v0 +^ x{2}.`1) <- y{2}.`1] /\ - G2.paths{2} = paths0.[y{2}.`2 <- (rcons p0 (v0 +^ x{2}.`1), y{2}.`1)] - else RO.m{2} = ro0 /\ G2.paths{2} = paths0);1:smt ml=0. - if{2};2:by auto=>/#. - inline{2} RO.f;rcondt{2} 4. - + move=> &ml;auto=>/= &mr[][]_[][]_[]->[][][]_ Heqm _[]_[][]_ Hro[] Hpath _ HnCFm. - rewrite in_dom;case:(G2.paths{mr}.[_]) (Hpath x{mr}.`2)=>//[[p v]]/(_ p v)/=[h][]Hbu Hh b _. - rewrite -not_def=> /Hro [??h'];rewrite oget_some Hbu => [][]<- <- /=. - rewrite Block.xorwA Block.xorwK Block.xorwC Block.xorw0 -not_def=>/Heqm [c c' f f']. - by rewrite Hh=>[][]<- _[]_ Hm;move:HnCFm;rewrite in_dom;case:(x{mr}) Hm=> ??->. - swap{2} 3-2;swap{2}6-4;wp;conseq (_:y{1} =(rd,y2){2}). - + progress [-split];rewrite getP_eq oget_some H2/=. - by move:H2;rewrite in_dom;case:(G2.paths{2}.[_]). - transitivity{1} {y <- S.sample();} (true ==> ={y}) (true==>y{1}=(rd,y2){2})=>//;1:by inline*;auto. - transitivity{2} {(rd,y2) <- S.sample2();} (true==>y{1}=(rd,y2){2}) (true==> ={rd,y2})=>//;2:by inline*;auto. - by call sample_sample2;auto=> /=?[??]->. - case (mem (rng G2.handles{2}) (x{2}.`2, I)). - + conseq (_:true);[by move=> ??[][]_[]->_->|auto]. - conseq (_: !G2.bcol{2} => - oget CF.m{1}.[x{1}] = y{2} /\ - INV_CF_G2 G2.handles{2} G2.chandle{2} CF.m{1} CF.mi{1} G2.m{2} G2.mi{2} G2.mh{2} G2.mhi{2} RO.m{2} G2.paths{2}). - + by move=> ??[][]_[]->[][]-> _ _ ->. - seq 0 2: ((!G2.bcol{2} /\ ={x, y} /\ - INV_CF_G2 G2.handles{2} G2.chandle{2} CF.m{1} CF.mi{1} G2.m{2} G2.mi{2} - G2.mh{2} G2.mhi{2} ro0 paths0 /\ - ! mem (dom CF.m{1}) x{1} /\ - if mem (dom paths0) x{2}.`2 then - let (p0, v0) = oget paths0.[x{2}.`2] in - RO.m{2} = ro0.[rcons p0 (v0 +^ x{2}.`1) <- y{2}.`1] /\ - G2.paths{2} = paths0.[y{2}.`2 <- (rcons p0 (v0 +^ x{2}.`1), y{2}.`1)] - else RO.m{2} = ro0 /\ G2.paths{2} = paths0) /\ - !mem (rng G2.handles{2}) (x{2}.`2, I) /\ - (G2.handles.[hx2]=Some(x.`2,D)){2}). - + auto=> &ml&mr[][]->[]_[][]-> ->[]Hinv []-> -> ^Hrng-> /=. - case (mem (rng G2.handles{mr}) (x{mr}.`2, Top.D))=> Hmem /=. - + by split=>//;apply /huniq_hinvD=>//;move:Hinv;rewrite /INV_CF_G2/handles_spec. - rewrite -anda_and;split=> [ | {Hinv}Hinv]. - + by apply INV_CF_G2_up_handles=>//[[]]. - rewrite rng_set (huniq_hinvD_h G2.chandle{mr}) ?getP//. - + by move:Hinv;rewrite /INV_CF_G2/handles_spec. - by rewrite oget_some /=!inE/=;move:Hrng;apply NewLogic.contraLR=>/=;apply rng_rem_le. - rcondf{2} 1. - + move=> &ml;skip=> &mr[][]_[][]-> _ []Hinv[]Hndom _[]_ Hh;rewrite -not_def in_dom=>[]. - move:Hinv=>[][][]_ /(_ (x{mr}.`1, hx2{mr}));case (G2.mh{mr}.[_])=>// bh' /(_ bh') [c c' f f'] /=. - by rewrite Hh/= =>[][]<- _ []_ H;case: (x{mr}) H Hndom => [x1 x2];rewrite in_dom=>->. - auto. -(* Stopped here *) - admit. - admit. - (* lossless CF.P.f *) - + admit. - (* lossless and do not reset bad G2.S.f *) - + admit. - (** proofs for G2.S.fi *) - (* equiv CF.P.fi G2.S.fi *) - + admit. - (* lossless CF.P.fi *) - + admit. - (* lossless and do not reset bad G2.S.fi *) - + admit. - (** proofs for G2.C.f *) - (* equiv CF.C.f G2.C.f *) - + admit. - (* lossless CF.C.f *) - + admit. - (* lossless and do not reset bad G2.C.f *) - + admit. - (* Init ok *) - + admit. - qed. - - - - - From bc85514f72e7d458368703f7afee0c9db0b6ea06 Mon Sep 17 00:00:00 2001 From: Pierre-Yves Strub Date: Thu, 10 Dec 2015 10:25:38 +0100 Subject: [PATCH 073/525] apply auto-magic sed commands to sha3 (w.r.t EC update) --- proof/AbsorbToBlocks.ec | 2 +- proof/old/G1.eca | 10 +++++----- proof/old/SLCommon.ec | 4 ++-- proof/old/Squeezeless.ec | 32 ++++++++++++++++---------------- proof/old/Utils.ec | 10 +++++----- 5 files changed, 29 insertions(+), 29 deletions(-) diff --git a/proof/AbsorbToBlocks.ec b/proof/AbsorbToBlocks.ec index eb00f91..8122a2a 100644 --- a/proof/AbsorbToBlocks.ec +++ b/proof/AbsorbToBlocks.ec @@ -145,7 +145,7 @@ section. + smt. + smt. + have [_] [_] /(_ x1 n0 _) //= := H0. - move: H5; rewrite domP in_fsetU in_fset1=> [//=|h]. + move: H5; rewrite domP in_fsetU in_fset1=> -[//=|h]. by have [->]:= H1 (x1,n0) _; first by rewrite h mem_pick // H2. + move: H5; rewrite domP in_fsetD in_fsetU !in_fset1. by case (x1 = pick work{hr})=> //= _ /H1 [->]. diff --git a/proof/old/G1.eca b/proof/old/G1.eca index d3dcd1f..32df648 100644 --- a/proof/old/G1.eca +++ b/proof/old/G1.eca @@ -198,7 +198,7 @@ lemma eqm_dom_mh_m handles m mh hx2 f (x:state): proof. move=>[]H1 H2 Hhx2;rewrite !in_dom. case: (mh.[_]) (H2 (x.`1,hx2))=> //= bh' /(_ bh') [c c' f1 f1']. - by rewrite Hhx2=> /=[][]<<- _;case:(x)=> ??[]_->. + by rewrite Hhx2=> /= -[][]<<- _;case:(x)=> ??[]_->. qed. lemma chandle_ge0 handles chandle : handles_spec handles chandle => 0 < chandle. @@ -324,9 +324,9 @@ section PROOF. inline{2} RO.f;rcondt{2} 4. + move=> &ml;auto=>/= &mr[][]_[][]_[]->[][][]_ Heqm _[]_[][]_ Hro[] Hpath _ HnCFm. rewrite in_dom;case:(G1.paths{mr}.[_]) (Hpath x{mr}.`2)=>//[[p v]]/(_ p v)/=[h][]Hbu Hh b _. - rewrite -not_def=> /Hro [??h'];rewrite oget_some Hbu => [][]<- <- /=. + rewrite -not_def=> /Hro [??h'];rewrite oget_some Hbu => -[][]<- <- /=. rewrite Block.xorwA Block.xorwK Block.xorwC Block.xorw0 -not_def=>/Heqm [c c' f f']. - by rewrite Hh=>[][]<- _[]_ Hm;move:HnCFm;rewrite in_dom;case:(x{mr}) Hm=> ??->. + by rewrite Hh=> -[][]<- _[]_ Hm;move:HnCFm;rewrite in_dom;case:(x{mr}) Hm=> ??->. swap{2} 3-2;swap{2}6-4;wp;conseq (_:y{1} =(rd,y2){2}). + progress [-split];rewrite getP_eq oget_some H2/=. by move:H2;rewrite in_dom;case:(G1.paths{2}.[_]). @@ -359,9 +359,9 @@ section PROOF. + by move:Hinv;rewrite /INV_CF_G1/handles_spec. by rewrite oget_some /=!inE/=;move:Hrng;apply NewLogic.contraLR=>/=;apply rng_rem_le. rcondf{2} 1. - + move=> &ml;skip=> &mr[][]_[][]-> _ []Hinv[]Hndom _[]_ Hh;rewrite -not_def in_dom=>[]. + + move=> &ml;skip=> &mr[][]_[][]-> _ []Hinv[]Hndom _[]_ Hh;rewrite -not_def in_dom=> -[]. move:Hinv=>[][][]_ /(_ (x{mr}.`1, hx2{mr}));case (G1.mh{mr}.[_])=>// bh' /(_ bh') [c c' f f'] /=. - by rewrite Hh/= =>[][]<- _ []_ H;case: (x{mr}) H Hndom => [x1 x2];rewrite in_dom=>->. + by rewrite Hh/= => -[][]<- _ []_ H;case: (x{mr}) H Hndom => [x1 x2];rewrite in_dom=>->. auto. (* Stopped here *) admit. diff --git a/proof/old/SLCommon.ec b/proof/old/SLCommon.ec index cfbe2ca..4add140 100644 --- a/proof/old/SLCommon.ec +++ b/proof/old/SLCommon.ec @@ -113,7 +113,7 @@ lemma half_permutation_set (m' mi' : ('a,'a) fmap) x' y': => (forall x, mem (rng m'.[x' <- y']) x => mem (dom mi'.[y' <- x']) x). proof. move=> h x0. - rewrite rng_set domP !in_fsetU in_fset1 => [/rng_rem_le in_rng|//=]. + rewrite rng_set domP !in_fsetU in_fset1 => -[/rng_rem_le in_rng|//=]. by rewrite h. qed. @@ -171,7 +171,7 @@ qed. lemma huniq_hinvD (handles:handles) c: huniq handles => mem (rng handles) (c,D) => handles.[oget (hinvD handles c)] = Some(c,D). proof. - move=> Huniq;rewrite in_rng=> [h]H;case: (hinvD _ _) (Huniq h) (hinvDP handles c)=>//=. + move=> Huniq;rewrite in_rng=> -[h]H;case: (hinvD _ _) (Huniq h) (hinvDP handles c)=>//=. by move=>_/(_ h);rewrite H. qed. diff --git a/proof/old/Squeezeless.ec b/proof/old/Squeezeless.ec index a684ada..a0345bc 100644 --- a/proof/old/Squeezeless.ec +++ b/proof/old/Squeezeless.ec @@ -201,7 +201,7 @@ module type DFUNCTIONALITY = { => (forall x, mem (rng m'.[x' <- y']) x => mem (dom mi'.[y' <- x']) x). proof. move=> h x0. - rewrite rng_set domP !in_fsetU in_fset1 => [/rng_rem_le in_rng|//=]. + rewrite rng_set domP !in_fsetU in_fset1 => -[/rng_rem_le in_rng|//=]. by rewrite h. qed. @@ -282,7 +282,7 @@ require import Ring. lemma huniq_hinvD (handles:handles) c: huniq handles => mem (rng handles) (c,D) => handles.[oget (hinvD handles c)] = Some(c,D). proof. - move=> Huniq;rewrite in_rng=> [h]H;case: (hinvD _ _) (Huniq h) (hinvDP handles c)=>//=. + move=> Huniq;rewrite in_rng=> -[h]H;case: (hinvD _ _) (Huniq h) (hinvDP handles c)=>//=. by move=>_/(_ h);rewrite H. qed. @@ -352,14 +352,14 @@ lemma hinvD_rng x (handles:(handle, ccapacity) fmap): proof. cut[ [a []->[]] | []->/=Hp ]/=:= findP (fun _ z => z = (x, D)) handles. + by rewrite oget_some=> ? <- _;apply get_oget. - by rewrite in_rng=> [a Ha];cut := Hp a; rewrite in_dom Ha oget_some. + by rewrite in_rng=> -[a Ha];cut := Hp a; rewrite in_dom Ha oget_some. qed. (* TODO: change the name *) lemma map_perm (m mi: ('a, 'a) fmap) x y: !mem (dom mi) y => dom m = rng mi => dom m.[x<-y] = rng mi.[y<- x]. proof. move=> Hdom Heq;rewrite fsetP=> w;rewrite dom_set in_rng !inE;split. - + rewrite Heq in_rng. case (w=x)=>[->|Hneq/=[a Ha]];1:by exists y;rewrite getP. + + rewrite Heq in_rng. case (w=x)=> -[->|Hneq/=[a Ha]];1:by exists y;rewrite getP. exists a;rewrite getP;case (a=y)=>[->>|//]. by move:Hdom;rewrite in_dom Ha. rewrite Heq in_rng;by move=>[a];rewrite getP;case(a=y)=>[->>/# |_ <-];left;exists a. @@ -387,13 +387,13 @@ proof. rewrite !(dom_set, rng_set, inE) /==>H1 [[H2|[_->]]|[/rng_rem_le H2|[_->]]]//; by rewrite H1 ?H2. + by move=> h;cut := Hhbound h;rewrite !dom_set !inE /= => H [[/H|]|->>]/#. - + move=>[x1 h];rewrite !getP !dom_set !inE /==>[|[]->> ->>];rewrite /chandles /=. + + move=>[x1 h];rewrite !getP !dom_set !inE /==> -[|[]->> ->>];rewrite /chandles /=. + move=>Hh. cut /Hhbound/=:= Hdomh (x1,h) _;1:by rewrite !inE Hh. move=> ^Hlt /IntOrder.gtr_eqF; rewrite eq_sym=>->. by cut ->/#: h <> G2.chandle{hr} + 1 by smt ml=0. cut ->/=: G2.chandle{hr} <> G2.chandle{hr} + 1 by smt ml=0. by rewrite oget_some /#. - move=>[x1 h];rewrite !getP !dom_set !inE /==>[|[]->> ->>];rewrite /chandles /=. + move=>[x1 h];rewrite !getP !dom_set !inE /==> -[|[]->> ->>];rewrite /chandles /=. + move=>Hh; cut /Hhbound/=:= Hdomh (x1,h) _;1:by rewrite !inE -Hmhimh Hh. move=> ^Hlt /IntOrder.gtr_eqF; rewrite eq_sym=>->. by cut ->/#: h <> G2.chandle{hr} + 1 by smt ml=0. @@ -406,17 +406,17 @@ proof. rewrite !inE -Hmhimh H. + apply map_perm=> //;rewrite -not_def=> H. by cut := Hmhor _ H;move: Hnmem;rewrite Hget oget_some /=;case (x{hr}). - + move=> [x1 h];rewrite !(dom_set,rng_set, inE) => [[H|[_ ->]]| [/rng_rem_le H|[_->]]]//=. + + move=> [x1 h];rewrite !(dom_set,rng_set, inE) => -[[H|[_ ->]]| [/rng_rem_le H|[_->]]]//=. + by left;apply (Hdomh (x1,h));rewrite inE H. + by left;rewrite in_dom Hget. by left;apply (Hdomh (x1,h));rewrite inE H. - + by move=>h;rewrite dom_set !inE=> [/Hhbound|->]/#. - + move=> [x1 h];rewrite !(dom_set, getP, inE) /==>[H|[->> ->>]]. + + by move=>h;rewrite dom_set !inE=> -[/Hhbound|->]/#. + + move=> [x1 h];rewrite !(dom_set, getP, inE) /==> -[H|[->> ->>]]. + by cut /IntOrder.ltr_eqF->/#:= Hhbound h _;1:by apply (Hdomh (x1,h));rewrite inE H. cut ->/=:oget (hinvD G2.handles{hr} x{hr}.`2) <> G2.chandle{hr}. + by cut /#:= Hhbound (oget (hinvD G2.handles{hr} x{hr}.`2)) _;1:by rewrite in_dom Hget. by rewrite Hget oget_some /=;right;case (x{hr}). - move=> [x1 h];rewrite !(dom_set, getP, inE) /==>[H|[->> ->> /=]]. + move=> [x1 h];rewrite !(dom_set, getP, inE) /==> -[H|[->> ->> /=]]. + by cut /IntOrder.ltr_eqF->/#:= Hhbound h _;1: apply (Hdomh (x1,h));rewrite inE -Hmhimh H. by rewrite oget_some /=;right;case y. qed. @@ -443,12 +443,12 @@ proof. rewrite !(dom_set, rng_set, inE) /==>H1 [[H2|[_->]]|[/rng_rem_le H2|[_->]]]//; by rewrite H1 ?H2. + by move=> h;cut := Hhbound h;rewrite !dom_set !inE /= => H [[/H|]|->>]/#. - + move=>[x1 h];rewrite !getP !dom_set !inE /==>[|[]->> ->>];rewrite /chandles /=. + + move=>[x1 h];rewrite !getP !dom_set !inE /==> -[|[]->> ->>];rewrite /chandles /=. + move=>Hh; cut /Hhbound/=:= Hdomh (x1,h) _;1:by rewrite !inE -Hmhimh Hh. move=> ^Hlt /IntOrder.gtr_eqF; rewrite eq_sym=>->. by cut ->/#: h <> G2.chandle{hr} + 1 by smt ml=0. by rewrite oget_some /#. - move=>[x1 h];rewrite !getP !dom_set !inE /==>[|[]->> ->>];rewrite /chandles /=. + move=>[x1 h];rewrite !getP !dom_set !inE /==> -[|[]->> ->>];rewrite /chandles /=. + move=>Hh;cut /Hhbound/=:= Hdomh (x1,h) _;1:by rewrite !inE -Hmhimh Hh. move=> ^Hlt /IntOrder.gtr_eqF; rewrite eq_sym=>->. by cut ->/#: h <> G2.chandle{hr} + 1 by smt ml=0. @@ -462,15 +462,15 @@ proof. + apply map_perm=> //;rewrite -not_def=> H. by cut /#:= Hhbound G2.chandle{hr} _;apply (Hdomh (y.`1,G2.chandle{hr})); rewrite !inE -Hmhimh H. - + move=> [x1 h];rewrite !(dom_set,rng_set, inE) => [[H|[_ ->]]| [/rng_rem_le H|[_->]]]//=. + + move=> [x1 h];rewrite !(dom_set,rng_set, inE) => -[[H|[_ ->]]| [/rng_rem_le H|[_->]]]//=. + by left;apply (Hdomh (x1,h));rewrite inE H. + by left;apply (Hdomh (x1,h));rewrite inE H. by left;rewrite in_dom Hget. - + by move=>h;rewrite dom_set !inE=> [/Hhbound|->]/#. - + move=> [x1 h];rewrite !(dom_set, getP, inE) /==>[H|[->> ->> /=]]. + + by move=>h;rewrite dom_set !inE=> -[/Hhbound|->]/#. + + move=> [x1 h];rewrite !(dom_set, getP, inE) /==> -[H|[->> ->> /=]]. + by cut /IntOrder.ltr_eqF->/#:= Hhbound h _;1: apply (Hdomh (x1,h));rewrite inE -Hmhimh H. by rewrite oget_some /==>{Hy};right;case y. - move=> [x1 h];rewrite !(dom_set, getP, inE) /==>[H|[->> ->>]]. + move=> [x1 h];rewrite !(dom_set, getP, inE) /==> -[H|[->> ->>]]. + by cut /IntOrder.ltr_eqF->/#:= Hhbound h _;1:apply (Hdomh (x1,h));rewrite inE -Hmhimh H. cut ->/=:oget (hinvD G2.handles{hr} x{hr}.`2) <> G2.chandle{hr}. + by cut /#:= Hhbound (oget (hinvD G2.handles{hr} x{hr}.`2)) _;1:by rewrite in_dom Hget. diff --git a/proof/old/Utils.ec b/proof/old/Utils.ec index 5b6f0bd..8ec5b44 100644 --- a/proof/old/Utils.ec +++ b/proof/old/Utils.ec @@ -17,7 +17,7 @@ proof. by rewrite dom_rem in_fsetD. qed. lemma rng_rem_le (x : 'a) (m : ('a,'b) fmap) (x' : 'b): mem (rng (rem x m)) x' => mem (rng m) x'. -proof. by rewrite rng_rm in_rng=> [x0] [_ h]; exists x0. qed. +proof. by rewrite rng_rm in_rng=> -[x0] [_ h]; exists x0. qed. (* -------------------------------------------------------------------- *) @@ -34,7 +34,7 @@ lemma dom_reindex (f : 'a -> 'c) (m : ('a, 'b) fmap) x: proof. rewrite reindexE dom_oflist imageP mapP /fst; split. move=> [[x' y] [+ ->>]]. - rewrite mapP=> [[x0 y0]] /= [h [->> ->>]] {x' y}. + rewrite mapP=> -[[x0 y0]] /= [h [->> ->>]] {x' y}. by exists x0; rewrite domE mem_oflist mapP /fst; exists (x0,y0). move=> [a] [a_in_m <<-]. exists (f a,oget m.[a])=> /=; rewrite mapP /=. @@ -64,13 +64,13 @@ proof. rewrite /reduce=> s0 x0; rewrite -{2}(cat0s s0); pose acc:= []. elim s0 acc x0=> {s'} [acc x0 /=|x' s' ih acc x0 /=]. by rewrite cats0. - move=> /ih; rewrite -cat1s catA cats1 !mem_cat=> [|-> //=]. + move=> /ih; rewrite -cat1s catA cats1 !mem_cat=> -[|-> //=]. rewrite /augment; case (mem (map fst acc) x'.`1)=> _ h'; left=> //. by rewrite mem_rcons /=; right. - rewrite /s' mapP=> [[a' b']] /= [xy_in_m []]. + rewrite /s' mapP=> -[[a' b']] /= [xy_in_m []]. rewrite eq_sym. have h0 /h0 ->> <<- {a' b'}:= f_pinj a' x _; 1:by smt. by apply/mem_assoc_uniq; 1:exact uniq_keys. - rewrite -mem_oflist {1}/s -domE=> [] h; have := h; rewrite dom_reindex. + rewrite -mem_oflist {1}/s -domE=> -[] h; have := h; rewrite dom_reindex. rewrite imageP=> h'. have {h'} h': forall (a : 'a), !mem (dom m) a \/ f a <> f x by smt. have /= := h' x. rewrite in_dom !getE /=. From 27a8c456790ef657821f7d377ebb97b3b862b49d Mon Sep 17 00:00:00 2001 From: Pierre-Yves Strub Date: Thu, 10 Dec 2015 13:08:29 +0100 Subject: [PATCH 074/525] generalize -> move: --- proof/RndOrcl.eca | 6 +++--- proof/variant/RndOrcl.eca | 6 +++--- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/proof/RndOrcl.eca b/proof/RndOrcl.eca index 96d3045..4b15b5c 100644 --- a/proof/RndOrcl.eca +++ b/proof/RndOrcl.eca @@ -124,7 +124,7 @@ abstract theory GenIdeal. (={x,work,RO.m} ==> ={x,RO.m}) ((={x,work,RO.m} /\ mem work{1} x{1}) /\ ! mem (dom RO.m{2}) x{2} ==> ={x,RO.m} /\ (result = oget RO.m.[x]){2} /\ mem (dom RO.m{1}) x{1}) => //. - + by move=> &1 &2 H; exists RO.m{2}, x{2}, work{2}; generalize H. + + by move=> &1 &2 H; exists RO.m{2}, x{2}, work{2}; move: H. + transitivity{1} { while (work <> fset0) { x0 <- pick work; rd0 <$ sample x0; @@ -134,7 +134,7 @@ abstract theory GenIdeal. rd <$ sample x; } (={x,work,RO.m} ==> ={x,RO.m}) (={x,work,RO.m} ==> ={x,RO.m})=> //. - + by move=> &1 &2 H; exists RO.m{2}, x{2}, work{2}; generalize H. + + by move=> &1 &2 H; exists RO.m{2}, x{2}, work{2}; move: H. + by sim; rnd{2}; sim : (={x,IND_Eager.H.m}); smt. symmetry; eager while (H: rd <$ sample x; ~ rd <$ sample x; : ={x} ==> ={rd})=> //; sim. swap{2} 5 -4; swap [2..3] -1; case ((x = pick work){1}). @@ -147,7 +147,7 @@ abstract theory GenIdeal. else eq_except RO.m{1} RO.m{2} (fset1 x{1})). + auto;progress; 1..9,12:smt. + case ((pick work = x){2})=> pick_x; last smt. - subst x{2}; generalize H7 H1; rewrite -neqF /eq_except=> -> /= eq_exc. + subst x{2}; move: H7 H1; rewrite -neqF /eq_except=> -> /= eq_exc. by apply fmapP=> x0; case (pick work{2} = x0); smt. by auto; smt. by auto;progress [-split];rewrite H0 /= getP_eq;smt. diff --git a/proof/variant/RndOrcl.eca b/proof/variant/RndOrcl.eca index 96d3045..4b15b5c 100644 --- a/proof/variant/RndOrcl.eca +++ b/proof/variant/RndOrcl.eca @@ -124,7 +124,7 @@ abstract theory GenIdeal. (={x,work,RO.m} ==> ={x,RO.m}) ((={x,work,RO.m} /\ mem work{1} x{1}) /\ ! mem (dom RO.m{2}) x{2} ==> ={x,RO.m} /\ (result = oget RO.m.[x]){2} /\ mem (dom RO.m{1}) x{1}) => //. - + by move=> &1 &2 H; exists RO.m{2}, x{2}, work{2}; generalize H. + + by move=> &1 &2 H; exists RO.m{2}, x{2}, work{2}; move: H. + transitivity{1} { while (work <> fset0) { x0 <- pick work; rd0 <$ sample x0; @@ -134,7 +134,7 @@ abstract theory GenIdeal. rd <$ sample x; } (={x,work,RO.m} ==> ={x,RO.m}) (={x,work,RO.m} ==> ={x,RO.m})=> //. - + by move=> &1 &2 H; exists RO.m{2}, x{2}, work{2}; generalize H. + + by move=> &1 &2 H; exists RO.m{2}, x{2}, work{2}; move: H. + by sim; rnd{2}; sim : (={x,IND_Eager.H.m}); smt. symmetry; eager while (H: rd <$ sample x; ~ rd <$ sample x; : ={x} ==> ={rd})=> //; sim. swap{2} 5 -4; swap [2..3] -1; case ((x = pick work){1}). @@ -147,7 +147,7 @@ abstract theory GenIdeal. else eq_except RO.m{1} RO.m{2} (fset1 x{1})). + auto;progress; 1..9,12:smt. + case ((pick work = x){2})=> pick_x; last smt. - subst x{2}; generalize H7 H1; rewrite -neqF /eq_except=> -> /= eq_exc. + subst x{2}; move: H7 H1; rewrite -neqF /eq_except=> -> /= eq_exc. by apply fmapP=> x0; case (pick work{2} = x0); smt. by auto; smt. by auto;progress [-split];rewrite H0 /= getP_eq;smt. From 56f916cb6d595b6d8da2d3ec8734d50ed6303ad8 Mon Sep 17 00:00:00 2001 From: Pierre-Yves Strub Date: Thu, 10 Dec 2015 13:19:30 +0100 Subject: [PATCH 075/525] .dir-locals --- proof/.dir-locals.el | 4 ++++ 1 file changed, 4 insertions(+) create mode 100644 proof/.dir-locals.el diff --git a/proof/.dir-locals.el b/proof/.dir-locals.el new file mode 100644 index 0000000..fbf2dcd --- /dev/null +++ b/proof/.dir-locals.el @@ -0,0 +1,4 @@ +((easycrypt-mode . + ((eval . + (flet ((pre (s) (concat (locate-dominating-file buffer-file-name ".dir-locals.el") s))) + (setq easycrypt-load-path `(,(pre ".") ,(pre "variant") ,(pre "old")))))))) From 5ed04fa4c6c65bb4f04722a011e51f09d26f4482 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Thu, 10 Dec 2015 14:03:38 +0100 Subject: [PATCH 076/525] Add a generic proof allowing to switch from an oracle to a restricted oracle --- proof/old/Count.eca | 140 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 140 insertions(+) create mode 100644 proof/old/Count.eca diff --git a/proof/old/Count.eca b/proof/old/Count.eca new file mode 100644 index 0000000..1ce6ea7 --- /dev/null +++ b/proof/old/Count.eca @@ -0,0 +1,140 @@ +require import Pred Fun Option Pair Int Real StdOrder Ring. +require import List FSet NewFMap Utils Common SLCommon. +(*...*) import Dprod Dexcepted Capacity IntOrder. + +module type ODISTINGUISHER = { + proc p (_:state) : state + proc pi (_:state) : state + proc f (_:block list) : block +}. + +module type DISTINGUISHER1 (O:ODISTINGUISHER) = { + proc distinguish () : bool +}. + +module ToC (D:DISTINGUISHER, O:ODISTINGUISHER) = { + module F = { + proc f = O.f + } + module P = { + proc f = O.p + proc fi = O.pi + } + proc distinguisher = D(F,P).distinguish +}. + +module OfC(F:DFUNCTIONALITY, P:DPRIMITIVE) = { + proc f = F.f + proc p = P.f + proc pi = P.fi +}. + +module OC (O:ODISTINGUISHER) = { + + var c : int + + proc init () = { + c <- 0; + } + + proc f (bs:block list) = { + var b; + c <- c + size bs; + b <@ O.f(bs); + return b; + } + + proc p (x:state) = { + var y; + c <- c + 1; + y <@ O.p(x); + return y; + } + + proc pi(x:state) = { + var y; + c <- c + 1; + y <@ O.pi(x); + return y; + } + +}. + + +module OCRestr (O:ODISTINGUISHER) = { + + proc f (bs:block list) = { + var b = b0; + if (OC.c + size bs <= max_size) { + OC.c <- OC.c + size bs; + b <@ O.f(bs); + } + return b; + } + + proc p (x:state) = { + var y = (b0,c0); + if (OC.c + 1 <= max_size) { + OC.c <- OC.c + 1; + y <@ O.p(x); + } + return y; + } + + proc pi(x:state) = { + var y = (b0,c0); + if (OC.c + 1 <= max_size) { + OC.c <- OC.c + 1; + y <@ O.pi(x); + } + return y; + } + +}. + +section PROOF. + + declare module O:ODISTINGUISHER{OC}. + + declare module D : DISTINGUISHER1 {O,OC}. + + axiom D_ll (O <: ODISTINGUISHER{D}): + islossless O.p => islossless O.pi => islossless O.f => + islossless D(O).distinguish. + + axiom D_max : hoare [D(OC(O)).distinguish : OC.c = 0 ==> OC.c <= max_size]. + + axiom f_ll : phoare [O.f:true ==> true] = 1%r. + axiom p_ll : phoare [O.p:true ==> true] = 1%r. + axiom pi_ll : phoare [O.pi:true ==> true] = 1%r. + + equiv D_DRestr : D(O).distinguish ~ D(OCRestr(O)).distinguish : + ={glob D, glob O} /\ OC.c{2} = 0 ==> ={res,glob D, glob O}. + proof. + transitivity D(OC(O)).distinguish + (={glob D, glob O} ==> ={res,glob D, glob O}) + (={glob D, glob O, OC.c} /\ OC.c{1} = 0 ==> ={res,glob D, glob O})=>//. + + by move=> ?&mr[][]-> -> ->;exists (glob O){mr}, (glob D){mr}, 0. + + by proc (={glob O})=>//;proc *;inline *;sim. + symmetry. + conseq (_: ={glob D, glob O,OC.c} /\ OC.c{2} = 0 ==> OC.c{2} <= max_size => ={res,glob D, glob O}) _ + (_: OC.c = 0 ==> OC.c <= max_size)=>//;1:by smt ml=0. + + apply D_max. + proc (max_size < OC.c) (={glob O, OC.c})=>//. + + smt ml=0. + + by move=> O' ???;apply (D_ll O'). + + proc;sp 1 0;if{1};1:by call(_:true);auto. + by call{2} p_ll;auto=> /#. + + by move=> ?_;proc;sp;if;auto;call p_ll;auto. + + by move=> _;proc;call p_ll;auto=> /#. + + proc;sp 1 0;if{1};1:by call(_:true);auto. + by call{2} pi_ll;auto=> /#. + + by move=> ?_;proc;sp;if;auto;call pi_ll;auto. + + by move=> _;proc;call pi_ll;auto=> /#. + + proc;sp 1 0;if{1};1:by call(_:true);auto. + by call{2} f_ll;auto=> /#. + + by move=> ?_;proc;sp;if;auto;call f_ll;auto. + by move=> _;proc;call f_ll;auto; smt ml=0 w=size_ge0. + qed. + +end section PROOF. \ No newline at end of file From 0faf7cf5d3fec119e5ebc2095def63330a268cb5 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Thu, 10 Dec 2015 15:09:52 +0100 Subject: [PATCH 077/525] end generic proof on counting --- proof/old/Count.eca | 69 ++++++++++++++++++++++++++++++++++++++++----- 1 file changed, 62 insertions(+), 7 deletions(-) diff --git a/proof/old/Count.eca b/proof/old/Count.eca index 1ce6ea7..640261e 100644 --- a/proof/old/Count.eca +++ b/proof/old/Count.eca @@ -2,6 +2,13 @@ require import Pred Fun Option Pair Int Real StdOrder Ring. require import List FSet NewFMap Utils Common SLCommon. (*...*) import Dprod Dexcepted Capacity IntOrder. +module type ORACLES = { + proc *init() : unit + proc p (_:state) : state + proc pi (_:state) : state + proc f (_:block list) : block +}. + module type ODISTINGUISHER = { proc p (_:state) : state proc pi (_:state) : state @@ -33,10 +40,6 @@ module OC (O:ODISTINGUISHER) = { var c : int - proc init () = { - c <- 0; - } - proc f (bs:block list) = { var b; c <- c + size bs; @@ -92,7 +95,30 @@ module OCRestr (O:ODISTINGUISHER) = { }. -section PROOF. +module Main1 (O:ORACLES,D:DISTINGUISHER1) = { + + proc main() : bool = { + var b; + O.init(); + b <@ D(O).distinguish(); + return b; + } + +}. + +module Main2 (O:ORACLES,D:DISTINGUISHER1) = { + + proc main() : bool = { + var b; + O.init(); + OC.c <- 0; + b <@ D(OCRestr(O)).distinguish(); + return b; + } + +}. + +section. declare module O:ODISTINGUISHER{OC}. @@ -117,7 +143,8 @@ section PROOF. + by move=> ?&mr[][]-> -> ->;exists (glob O){mr}, (glob D){mr}, 0. + by proc (={glob O})=>//;proc *;inline *;sim. symmetry. - conseq (_: ={glob D, glob O,OC.c} /\ OC.c{2} = 0 ==> OC.c{2} <= max_size => ={res,glob D, glob O}) _ + conseq (_: ={glob D, glob O,OC.c} /\ OC.c{2} = 0 ==> + OC.c{2} <= max_size => ={res,glob D, glob O}) _ (_: OC.c = 0 ==> OC.c <= max_size)=>//;1:by smt ml=0. + apply D_max. proc (max_size < OC.c) (={glob O, OC.c})=>//. @@ -137,4 +164,32 @@ section PROOF. by move=> _;proc;call f_ll;auto; smt ml=0 w=size_ge0. qed. -end section PROOF. \ No newline at end of file +end section. + +section. + + declare module O:ORACLES{OC}. + + declare module D : DISTINGUISHER1 {O,OC}. + + axiom D_ll (O <: ODISTINGUISHER{D}): + islossless O.p => islossless O.pi => islossless O.f => + islossless D(O).distinguish. + + axiom D_max : hoare [D(OC(O)).distinguish : OC.c = 0 ==> OC.c <= max_size]. + + axiom f_ll : phoare [O.f:true ==> true] = 1%r. + axiom p_ll : phoare [O.p:true ==> true] = 1%r. + axiom pi_ll : phoare [O.pi:true ==> true] = 1%r. + + equiv Main1_Main2 : Main1(O,D).main ~ Main2(O,D).main: + ={glob D} ==> ={res, glob D, glob O}. + proof. + proc;call (D_DRestr O D D_ll D_max f_ll p_ll pi_ll);wp;call(_:true);auto. + qed. + + lemma Pr_Main1_Main2 &m : + Pr[Main1(O,D).main()@&m:res] = Pr[Main2(O,D).main()@&m:res]. + proof. by byequiv Main1_Main2. qed. + +end section. From bd23464fa21b9caf4613fb1dda0aac9353518240 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Thu, 10 Dec 2015 15:14:03 +0100 Subject: [PATCH 078/525] renaming --- proof/old/{Count.eca => Count.ec} | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename proof/old/{Count.eca => Count.ec} (100%) diff --git a/proof/old/Count.eca b/proof/old/Count.ec similarity index 100% rename from proof/old/Count.eca rename to proof/old/Count.ec From e29617048e981f548c2ee9f351c556918987a523 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Thu, 10 Dec 2015 21:55:30 +0100 Subject: [PATCH 079/525] some progress ? --- proof/Indifferentiability.eca | 6 +- proof/old/ConcreteF.eca | 239 +++++++++++++++++++++++++--------- proof/old/SLCommon.ec | 2 +- 3 files changed, 181 insertions(+), 66 deletions(-) diff --git a/proof/Indifferentiability.eca b/proof/Indifferentiability.eca index 9a3a37a..14c871f 100644 --- a/proof/Indifferentiability.eca +++ b/proof/Indifferentiability.eca @@ -30,12 +30,12 @@ module type DFUNCTIONALITY = { functionality and returns a boolean (its guess as to whether it is playing with constructed functionality and ideal primitive or with ideal functionality and simulated primitive). **) -module type CONSTRUCTION (P : PRIMITIVE) = { - proc init() : unit +module type CONSTRUCTION (P : DPRIMITIVE) = { + proc init() : unit {} proc f(x : f_in): f_out { P.f } }. -module type SIMULATOR (F : FUNCTIONALITY) = { +module type SIMULATOR (F : DFUNCTIONALITY) = { proc init() : unit { (* F.init *) } proc f(x : p) : p { F.f } proc fi(x : p) : p { F.f } diff --git a/proof/old/ConcreteF.eca b/proof/old/ConcreteF.eca index 548b2a3..ffdf199 100644 --- a/proof/old/ConcreteF.eca +++ b/proof/old/ConcreteF.eca @@ -1,77 +1,192 @@ require import Pred Fun Option Pair Int Real StdOrder Ring. require import List FSet NewFMap Utils Common SLCommon. -(*...*) import Dprod Dexcepted Capacity IntOrder. - -module Concrete(D:DISTINGUISHER) = RealIndif(SqueezelessSponge,Perm,D). -(** An intermediate game where we don't care about the permutation - being a bijection anymore... **) -module CF(D:DISTINGUISHER) = { - var m, mi: (state,state) fmap - - module P = { - proc init(): unit = { } - - proc f(x : state): state = { - var y; - - if (!mem (dom m) x) { - y <$ dstate; - m.[x] <- y; - mi.[y] <- x; - } - return oget m.[x]; - } - - proc fi(x : state): state = { - var y; - - if (!mem (dom mi) x) { - y <$ dstate; - mi.[x] <- y; - m.[y] <- x; - } - return oget mi.[x]; - } +(*...*) import Dprod Dexcepted Capacity IntOrder RealOrder. - } - module C = { - proc init(): unit = { } - proc f(p : block list): block = { - var (sa,sc) <- (b0,c0); +module C = { + var c:int + proc init () = { c <- 0; } +}. - if (1 <= size p /\ p <> [b0]) { - while (p <> []) { (* Absorption *) - (sa,sc) <@ P.f((sa +^ head witness p,sc)); - p <- behead p; - } - } - return sa; (* Squeezing phase (non-iterated) *) - } - } +module PC (P:PRIMITIVE) = { + + proc init () = { + C.init(); + P.init(); + } + + proc f (x:state) = { + var y; + C.c <- C.c + 1; + y <@ P.f(x); + return y; + } + + proc fi(x:state) = { + var y; + C.c <- C.c + 1; + y <@ P.fi(x); + return y; + } + +}. + +module PRestr (P:PRIMITIVE) = { - proc main(): bool = { - var b; + proc init () = { + C.init(); + P.init(); + } - m <- map0; - mi <- map0; - b <@ D(C,P).distinguish(); - return b; + proc f (x:state) = { + var y=(b0,c0); + if (C.c + 1 <= max_size) { + C.c <- C.c + 1; + y <@ P.f(x); } - }. + return y; + } + + proc fi(x:state) = { + var y=(b0,c0); + if (C.c + 1 <= max_size) { + C.c <- C.c + 1; + y <@ P.fi(x); + } + return y; + } + +}. -section PROOF. +module FC(F:FUNCTIONALITY) = { - declare module D : DISTINGUISHER {Perm, RO, CF}. - - op bound_concrete : real. + proc init = F.init - lemma Concrete_CF &m: - Pr[Concrete(D).main() @ &m: res] <= - Pr[CF(D).main() @ &m: res] + bound_concrete. - admitted. + proc f (bs:block list) = { + var b= b0; + C.c <- C.c + size bs; + b <@ F.f(bs); + return b; + } +}. -end section PROOF. +module FRestr(F:FUNCTIONALITY) = { + proc init = F.init + proc f (bs:block list) = { + var b= b0; + if (C.c + size bs <= max_size) { + C.c <- C.c + size bs; + b <@ F.f(bs); + } + return b; + } +}. + +section COUNT. + + declare module P:PRIMITIVE{C}. + declare module CO:CONSTRUCTION{C,P}. + declare module D:DISTINGUISHER{C,P,CO}. + + axiom f_ll : islossless P.f. + axiom fi_ll : islossless P.fi. + + axiom CO_ll : islossless CO(P).f. + + axiom D_ll (F <: DFUNCTIONALITY{D}) (P <: DPRIMITIVE{D}): + islossless P.f => islossless P.fi => islossless F.f => + islossless D(F, P).distinguish. + + lemma Pr_restr &m : + Pr[Indif(FC(CO(P)), PC(P), D).main()@ &m:res /\ C.c <= max_size] <= + Pr[Indif(FRestr(CO(P)), PRestr(P), D).main()@ &m:res]. + proof. + byequiv (_: ={glob D, glob P, glob CO} ==> C.c{1} <= max_size => ={res})=>//; + 2:by move=> ??H[]?/H<-. + symmetry;proc. + call (_: max_size < C.c, ={glob P, glob CO, glob C}). + + apply D_ll. + + proc; sp 1 0;if{1};1:by call(_:true);auto. + by call{2} f_ll;auto=>/#. + + by move=> ?_;proc;sp;if;auto;call f_ll;auto. + + by move=> _;proc;call f_ll;auto=>/#. + + proc;sp 1 0;if{1};1:by call(_:true);auto. + by call{2} fi_ll;auto=>/#. + + by move=> ?_;proc;sp;if;auto;call fi_ll;auto. + + by move=> _;proc;call fi_ll;auto=>/#. + + proc;sp 1 0;if{1};1:by call(_: ={glob P});auto;sim. + by call{2} CO_ll;auto=>/#. + + by move=> ?_;proc;sp;if;auto;call CO_ll;auto. + + move=> _;proc;call CO_ll;auto;smt ml=0 w=size_ge0. + inline *;call (_:true);call(_:true);auto=>/#. + qed. + +end section COUNT. + +module PF = { + var m, mi: (state,state) fmap + + proc init(): unit = { + m <- map0; + mi <- map0; + } + + proc f(x : state): state = { + var y; + + if (!mem (dom m) x) { + y <$ dstate; + m.[x] <- y; + mi.[y] <- x; + } + return oget m.[x]; + } + + proc fi(x : state): state = { + var y; + + if (!mem (dom mi) x) { + y <$ dstate; + mi.[x] <- y; + m.[y] <- x; + } + return oget mi.[x]; + } + +}. + +op bound_concrete : real. + +module GReal(D:DISTINGUISHER) = + Indif(FC(SqueezelessSponge(Perm)), PC(Perm), D). + +module CF(D:DISTINGUISHER) = + Indif(FRestr(SqueezelessSponge(PF)), PRestr(PF), D). + +section. + + declare module D : DISTINGUISHER {Perm, C, PF}. + + axiom D_ll (F <: DFUNCTIONALITY{D}) (P <: DPRIMITIVE{D}): + islossless P.f => islossless P.fi => islossless F.f => + islossless D(F, P).distinguish. + + lemma Real_Concrete &m : + Pr[GReal(D).main()@ &m:res /\ C.c <= max_size] <= + Pr[CF(D).main()@ &m: res] + bound_concrete. + proof. + cut p_ll : islossless Perm.f. + + admit. (* We should have the lemma *) + cut pi_ll : islossless Perm.fi. + + admit. (* We should have the lemma *) + cut f_ll : islossless SqueezelessSponge(Perm).f. + + admit. (* We should have the lemma *) + apply (ler_trans _ _ _ + (Pr_restr Perm SqueezelessSponge D p_ll pi_ll f_ll D_ll &m)). + admit. (* Francois *) + qed. + +end section. diff --git a/proof/old/SLCommon.ec b/proof/old/SLCommon.ec index 4add140..6cffd25 100644 --- a/proof/old/SLCommon.ec +++ b/proof/old/SLCommon.ec @@ -53,7 +53,7 @@ proof. qed. (** We can now define the squeezeless sponge construction **) -module SqueezelessSponge (P:PRIMITIVE): CONSTRUCTION(P), FUNCTIONALITY = { +module SqueezelessSponge (P:DPRIMITIVE): FUNCTIONALITY = { proc init () = {} proc f(p : block list): block = { From 0692a68d51588c3b08adb2e750749242f6abdd43 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Thu, 10 Dec 2015 21:58:44 +0100 Subject: [PATCH 080/525] remove unused try. --- proof/old/Count.ec | 195 --------------------------------------------- 1 file changed, 195 deletions(-) delete mode 100644 proof/old/Count.ec diff --git a/proof/old/Count.ec b/proof/old/Count.ec deleted file mode 100644 index 640261e..0000000 --- a/proof/old/Count.ec +++ /dev/null @@ -1,195 +0,0 @@ -require import Pred Fun Option Pair Int Real StdOrder Ring. -require import List FSet NewFMap Utils Common SLCommon. -(*...*) import Dprod Dexcepted Capacity IntOrder. - -module type ORACLES = { - proc *init() : unit - proc p (_:state) : state - proc pi (_:state) : state - proc f (_:block list) : block -}. - -module type ODISTINGUISHER = { - proc p (_:state) : state - proc pi (_:state) : state - proc f (_:block list) : block -}. - -module type DISTINGUISHER1 (O:ODISTINGUISHER) = { - proc distinguish () : bool -}. - -module ToC (D:DISTINGUISHER, O:ODISTINGUISHER) = { - module F = { - proc f = O.f - } - module P = { - proc f = O.p - proc fi = O.pi - } - proc distinguisher = D(F,P).distinguish -}. - -module OfC(F:DFUNCTIONALITY, P:DPRIMITIVE) = { - proc f = F.f - proc p = P.f - proc pi = P.fi -}. - -module OC (O:ODISTINGUISHER) = { - - var c : int - - proc f (bs:block list) = { - var b; - c <- c + size bs; - b <@ O.f(bs); - return b; - } - - proc p (x:state) = { - var y; - c <- c + 1; - y <@ O.p(x); - return y; - } - - proc pi(x:state) = { - var y; - c <- c + 1; - y <@ O.pi(x); - return y; - } - -}. - - -module OCRestr (O:ODISTINGUISHER) = { - - proc f (bs:block list) = { - var b = b0; - if (OC.c + size bs <= max_size) { - OC.c <- OC.c + size bs; - b <@ O.f(bs); - } - return b; - } - - proc p (x:state) = { - var y = (b0,c0); - if (OC.c + 1 <= max_size) { - OC.c <- OC.c + 1; - y <@ O.p(x); - } - return y; - } - - proc pi(x:state) = { - var y = (b0,c0); - if (OC.c + 1 <= max_size) { - OC.c <- OC.c + 1; - y <@ O.pi(x); - } - return y; - } - -}. - -module Main1 (O:ORACLES,D:DISTINGUISHER1) = { - - proc main() : bool = { - var b; - O.init(); - b <@ D(O).distinguish(); - return b; - } - -}. - -module Main2 (O:ORACLES,D:DISTINGUISHER1) = { - - proc main() : bool = { - var b; - O.init(); - OC.c <- 0; - b <@ D(OCRestr(O)).distinguish(); - return b; - } - -}. - -section. - - declare module O:ODISTINGUISHER{OC}. - - declare module D : DISTINGUISHER1 {O,OC}. - - axiom D_ll (O <: ODISTINGUISHER{D}): - islossless O.p => islossless O.pi => islossless O.f => - islossless D(O).distinguish. - - axiom D_max : hoare [D(OC(O)).distinguish : OC.c = 0 ==> OC.c <= max_size]. - - axiom f_ll : phoare [O.f:true ==> true] = 1%r. - axiom p_ll : phoare [O.p:true ==> true] = 1%r. - axiom pi_ll : phoare [O.pi:true ==> true] = 1%r. - - equiv D_DRestr : D(O).distinguish ~ D(OCRestr(O)).distinguish : - ={glob D, glob O} /\ OC.c{2} = 0 ==> ={res,glob D, glob O}. - proof. - transitivity D(OC(O)).distinguish - (={glob D, glob O} ==> ={res,glob D, glob O}) - (={glob D, glob O, OC.c} /\ OC.c{1} = 0 ==> ={res,glob D, glob O})=>//. - + by move=> ?&mr[][]-> -> ->;exists (glob O){mr}, (glob D){mr}, 0. - + by proc (={glob O})=>//;proc *;inline *;sim. - symmetry. - conseq (_: ={glob D, glob O,OC.c} /\ OC.c{2} = 0 ==> - OC.c{2} <= max_size => ={res,glob D, glob O}) _ - (_: OC.c = 0 ==> OC.c <= max_size)=>//;1:by smt ml=0. - + apply D_max. - proc (max_size < OC.c) (={glob O, OC.c})=>//. - + smt ml=0. - + by move=> O' ???;apply (D_ll O'). - + proc;sp 1 0;if{1};1:by call(_:true);auto. - by call{2} p_ll;auto=> /#. - + by move=> ?_;proc;sp;if;auto;call p_ll;auto. - + by move=> _;proc;call p_ll;auto=> /#. - + proc;sp 1 0;if{1};1:by call(_:true);auto. - by call{2} pi_ll;auto=> /#. - + by move=> ?_;proc;sp;if;auto;call pi_ll;auto. - + by move=> _;proc;call pi_ll;auto=> /#. - + proc;sp 1 0;if{1};1:by call(_:true);auto. - by call{2} f_ll;auto=> /#. - + by move=> ?_;proc;sp;if;auto;call f_ll;auto. - by move=> _;proc;call f_ll;auto; smt ml=0 w=size_ge0. - qed. - -end section. - -section. - - declare module O:ORACLES{OC}. - - declare module D : DISTINGUISHER1 {O,OC}. - - axiom D_ll (O <: ODISTINGUISHER{D}): - islossless O.p => islossless O.pi => islossless O.f => - islossless D(O).distinguish. - - axiom D_max : hoare [D(OC(O)).distinguish : OC.c = 0 ==> OC.c <= max_size]. - - axiom f_ll : phoare [O.f:true ==> true] = 1%r. - axiom p_ll : phoare [O.p:true ==> true] = 1%r. - axiom pi_ll : phoare [O.pi:true ==> true] = 1%r. - - equiv Main1_Main2 : Main1(O,D).main ~ Main2(O,D).main: - ={glob D} ==> ={res, glob D, glob O}. - proof. - proc;call (D_DRestr O D D_ll D_max f_ll p_ll pi_ll);wp;call(_:true);auto. - qed. - - lemma Pr_Main1_Main2 &m : - Pr[Main1(O,D).main()@&m:res] = Pr[Main2(O,D).main()@&m:res]. - proof. by byequiv Main1_Main2. qed. - -end section. From 77e0100cc7298a7dc6db5c06c4f8fe5ade9f2fa5 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Fri, 11 Dec 2015 09:15:42 +0100 Subject: [PATCH 081/525] General infrastructure. --- proof/old/ConcreteF.eca | 151 ++++--------------------------- proof/old/G1.eca | 77 +++++++++------- proof/old/SLCommon.ec | 196 +++++++++++++++++++++++++++++++++++++++- 3 files changed, 261 insertions(+), 163 deletions(-) diff --git a/proof/old/ConcreteF.eca b/proof/old/ConcreteF.eca index ffdf199..22b4e05 100644 --- a/proof/old/ConcreteF.eca +++ b/proof/old/ConcreteF.eca @@ -2,130 +2,6 @@ require import Pred Fun Option Pair Int Real StdOrder Ring. require import List FSet NewFMap Utils Common SLCommon. (*...*) import Dprod Dexcepted Capacity IntOrder RealOrder. - - -module C = { - var c:int - proc init () = { c <- 0; } -}. - -module PC (P:PRIMITIVE) = { - - proc init () = { - C.init(); - P.init(); - } - - proc f (x:state) = { - var y; - C.c <- C.c + 1; - y <@ P.f(x); - return y; - } - - proc fi(x:state) = { - var y; - C.c <- C.c + 1; - y <@ P.fi(x); - return y; - } - -}. - -module PRestr (P:PRIMITIVE) = { - - proc init () = { - C.init(); - P.init(); - } - - proc f (x:state) = { - var y=(b0,c0); - if (C.c + 1 <= max_size) { - C.c <- C.c + 1; - y <@ P.f(x); - } - return y; - } - - proc fi(x:state) = { - var y=(b0,c0); - if (C.c + 1 <= max_size) { - C.c <- C.c + 1; - y <@ P.fi(x); - } - return y; - } - -}. - -module FC(F:FUNCTIONALITY) = { - - proc init = F.init - - proc f (bs:block list) = { - var b= b0; - C.c <- C.c + size bs; - b <@ F.f(bs); - return b; - } -}. - -module FRestr(F:FUNCTIONALITY) = { - - proc init = F.init - - proc f (bs:block list) = { - var b= b0; - if (C.c + size bs <= max_size) { - C.c <- C.c + size bs; - b <@ F.f(bs); - } - return b; - } -}. - -section COUNT. - - declare module P:PRIMITIVE{C}. - declare module CO:CONSTRUCTION{C,P}. - declare module D:DISTINGUISHER{C,P,CO}. - - axiom f_ll : islossless P.f. - axiom fi_ll : islossless P.fi. - - axiom CO_ll : islossless CO(P).f. - - axiom D_ll (F <: DFUNCTIONALITY{D}) (P <: DPRIMITIVE{D}): - islossless P.f => islossless P.fi => islossless F.f => - islossless D(F, P).distinguish. - - lemma Pr_restr &m : - Pr[Indif(FC(CO(P)), PC(P), D).main()@ &m:res /\ C.c <= max_size] <= - Pr[Indif(FRestr(CO(P)), PRestr(P), D).main()@ &m:res]. - proof. - byequiv (_: ={glob D, glob P, glob CO} ==> C.c{1} <= max_size => ={res})=>//; - 2:by move=> ??H[]?/H<-. - symmetry;proc. - call (_: max_size < C.c, ={glob P, glob CO, glob C}). - + apply D_ll. - + proc; sp 1 0;if{1};1:by call(_:true);auto. - by call{2} f_ll;auto=>/#. - + by move=> ?_;proc;sp;if;auto;call f_ll;auto. - + by move=> _;proc;call f_ll;auto=>/#. - + proc;sp 1 0;if{1};1:by call(_:true);auto. - by call{2} fi_ll;auto=>/#. - + by move=> ?_;proc;sp;if;auto;call fi_ll;auto. - + by move=> _;proc;call fi_ll;auto=>/#. - + proc;sp 1 0;if{1};1:by call(_: ={glob P});auto;sim. - by call{2} CO_ll;auto=>/#. - + by move=> ?_;proc;sp;if;auto;call CO_ll;auto. - + move=> _;proc;call CO_ll;auto;smt ml=0 w=size_ge0. - inline *;call (_:true);call(_:true);auto=>/#. - qed. - -end section COUNT. - module PF = { var m, mi: (state,state) fmap @@ -158,13 +34,10 @@ module PF = { }. +(* Fixme *) op bound_concrete : real. -module GReal(D:DISTINGUISHER) = - Indif(FC(SqueezelessSponge(Perm)), PC(Perm), D). - -module CF(D:DISTINGUISHER) = - Indif(FRestr(SqueezelessSponge(PF)), PRestr(PF), D). +module CF(D:DISTINGUISHER) = Indif(SqueezelessSponge(PF), PF, D). section. @@ -174,10 +47,26 @@ section. islossless P.f => islossless P.fi => islossless F.f => islossless D(F, P).distinguish. + local module GReal' = Indif(FC(SqueezelessSponge(Perm)), PC(Perm), D). + + (* TODO move this *) + lemma size_behead(l:'a list): l <> [] => size (behead l) = size l - 1. + proof. case l=>// ??/=;ring. qed. + lemma Real_Concrete &m : - Pr[GReal(D).main()@ &m:res /\ C.c <= max_size] <= - Pr[CF(D).main()@ &m: res] + bound_concrete. + Pr[GReal(D).main()@ &m: res /\ C.c <= max_size] <= + Pr[CF(DRestr(D)).main()@ &m: res] + bound_concrete. proof. + cut->: + Pr[RealIndif(SqueezelessSponge,PC(Perm),D).main()@ &m: + res /\ C.c <= max_size] = Pr[GReal'.main()@ &m: res/\ C.c <= max_size]. + + byequiv=>//;proc;inline *;call (_: ={C.c,glob Perm});last by auto. + + by sim. + by sim. + proc;inline *;sp 1 0;if{1};wp;[rcondt{2}5|rcondf{2}5];1,3:by auto. + + while (={glob Perm,sc,sa,p} /\ (C.c + size p){1} = C.c{2});2:by auto. + by wp;sp 1 1;if{2};[rcondt{1} 3|rcondf{1} 3];auto; + progress;rewrite size_behead//;ring. + by auto; smt ml=0 w=size_ge0. cut p_ll : islossless Perm.f. + admit. (* We should have the lemma *) cut pi_ll : islossless Perm.fi. diff --git a/proof/old/G1.eca b/proof/old/G1.eca index 32df648..42c8fc6 100644 --- a/proof/old/G1.eca +++ b/proof/old/G1.eca @@ -14,7 +14,6 @@ module G1(D:DISTINGUISHER) = { module C = { - proc init(): unit = { } proc f(p : block list): block = { var sa, sa', sc; @@ -44,7 +43,7 @@ module G1(D:DISTINGUISHER) = { } module S = { - (** Inner interface **) + proc f(x : state): state = { var p, v, y, y1, y2, hy2, hx2; @@ -281,24 +280,25 @@ proof. by apply handles_up_handles. qed. -section PROOF. +clone import ConcreteF as ConcreteF1. + +section AUX. - declare module D : DISTINGUISHER {Perm, RO, G1}. + declare module D : DISTINGUISHER {PF, RO, G1}. axiom D_ll (F <: DFUNCTIONALITY{D}) (P <: DPRIMITIVE{D}): islossless P.f => islossless P.fi => islossless F.f => islossless D(F, P).distinguish. - local clone import ConcreteF as ConcreteF'. - - local equiv CF_G1 : CF(D).main ~ G1(D).main : ={glob D} ==> !(G1.bcol \/ G1.bext){2} => ={res}. + equiv CF_G1 : CF(D).main ~ G1(D).main: + ={glob D} ==> !(G1.bcol \/ G1.bext){2} => ={res}. proof. proc. - call (_:(G1.bcol \/ G1.bext), INV_CF_G1 G1.handles{2} G1.chandle{2} CF.m{1} CF.mi{1} G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} RO.m{2} G1.paths{2}). + call (_:(G1.bcol \/ G1.bext), INV_CF_G1 G1.handles{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} RO.m{2} G1.paths{2}). (* lossless D *) + apply D_ll. (** proofs for G1.S.f *) - (* equiv CF.P.f G1.S.f *) + (* equiv PF.P.f G1.S.f *) + proc;if{1}=>/=. (* x is not in m{1} so forall h, (x.1,h) is not in mh{2} *) + rcondt{2} 1. @@ -307,8 +307,8 @@ section PROOF. exists* RO.m{2}, G1.paths{2};elim*=>ro0 paths0. seq 1 2 : (!G1.bcol{2} /\ (G1.bext = mem (rng G1.handles) (x.`2, I)){2} /\ ={x,y} /\ - INV_CF_G1 G1.handles{2} G1.chandle{2} CF.m{1} CF.mi{1} G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} ro0 paths0 /\ - ! mem (dom CF.m{1}) x{1} /\ + INV_CF_G1 G1.handles{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} ro0 paths0 /\ + ! mem (dom PF.m{1}) x{1} /\ (if mem (dom paths0) x.`2 then let (p,v) = oget paths0.[x.`2] in RO.m{2} = ro0.[rcons p (v+^x.`1) <- y.`1] /\ @@ -322,11 +322,11 @@ section PROOF. else RO.m{2} = ro0 /\ G1.paths{2} = paths0);1:smt ml=0. if{2};2:by auto=>/#. inline{2} RO.f;rcondt{2} 4. - + move=> &ml;auto=>/= &mr[][]_[][]_[]->[][][]_ Heqm _[]_[][]_ Hro[] Hpath _ HnCFm. + + move=> &ml;auto=>/= &mr[][]_[][]_[]->[][][]_ Heqm _[]_[][]_ Hro[] Hpath _ HnPFm. rewrite in_dom;case:(G1.paths{mr}.[_]) (Hpath x{mr}.`2)=>//[[p v]]/(_ p v)/=[h][]Hbu Hh b _. rewrite -not_def=> /Hro [??h'];rewrite oget_some Hbu => -[][]<- <- /=. rewrite Block.xorwA Block.xorwK Block.xorwC Block.xorw0 -not_def=>/Heqm [c c' f f']. - by rewrite Hh=> -[][]<- _[]_ Hm;move:HnCFm;rewrite in_dom;case:(x{mr}) Hm=> ??->. + by rewrite Hh=> -[][]<- _[]_ Hm;move:HnPFm;rewrite in_dom;case:(x{mr}) Hm=> ??->. swap{2} 3-2;swap{2}6-4;wp;conseq (_:y{1} =(rd,y2){2}). + progress [-split];rewrite getP_eq oget_some H2/=. by move:H2;rewrite in_dom;case:(G1.paths{2}.[_]). @@ -336,13 +336,13 @@ section PROOF. case (mem (rng G1.handles{2}) (x{2}.`2, I)). + conseq (_:true);[by move=> ??[][]_[]->_->|auto]. conseq (_: !G1.bcol{2} => - oget CF.m{1}.[x{1}] = y{2} /\ - INV_CF_G1 G1.handles{2} G1.chandle{2} CF.m{1} CF.mi{1} G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} RO.m{2} G1.paths{2}). + oget PF.m{1}.[x{1}] = y{2} /\ + INV_CF_G1 G1.handles{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} RO.m{2} G1.paths{2}). + by move=> ??[][]_[]->[][]-> _ _ ->. seq 0 2: ((!G1.bcol{2} /\ ={x, y} /\ - INV_CF_G1 G1.handles{2} G1.chandle{2} CF.m{1} CF.mi{1} G1.m{2} G1.mi{2} + INV_CF_G1 G1.handles{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} ro0 paths0 /\ - ! mem (dom CF.m{1}) x{1} /\ + ! mem (dom PF.m{1}) x{1} /\ if mem (dom paths0) x{2}.`2 then let (p0, v0) = oget paths0.[x{2}.`2] in RO.m{2} = ro0.[rcons p0 (v0 +^ x{2}.`1) <- y{2}.`1] /\ @@ -366,21 +366,21 @@ section PROOF. (* Stopped here *) admit. admit. - (* lossless CF.P.f *) + (* lossless PF.P.f *) + admit. (* lossless and do not reset bad G1.S.f *) + admit. (** proofs for G1.S.fi *) - (* equiv CF.P.fi G1.S.fi *) + (* equiv PF.P.fi G1.S.fi *) + admit. - (* lossless CF.P.fi *) + (* lossless PF.P.fi *) + admit. (* lossless and do not reset bad G1.S.fi *) + admit. (** proofs for G1.C.f *) - (* equiv CF.C.f G1.C.f *) + (* equiv PF.C.f G1.C.f *) + admit. - (* lossless CF.C.f *) + (* lossless PF.C.f *) + admit. (* lossless and do not reset bad G1.C.f *) + admit. @@ -388,18 +388,33 @@ section PROOF. + admit. qed. - lemma Concrete_G1 &m: - Pr[RealIndif(SqueezelessSponge,Perm,D).main() @ &m: res] <= - Pr[G1(D).main() @ &m: res] + bound_concrete + Pr[G1(D).main() @&m: G1.bcol] + Pr[G1(D).main() @&m: G1.bext]. +end section AUX. + +section. + + declare module D: DISTINGUISHER{Perm, C, PF, G1}. + + axiom D_ll (F <: DFUNCTIONALITY{D}) (P <: DPRIMITIVE{D}): + islossless P.f => islossless P.fi => + islossless F.f => islossless D(F, P).distinguish. + + lemma Real_G1 &m: + Pr[GReal(D).main() @ &m: res /\ C.c <= max_size] <= + Pr[G1(DRestr(D)).main() @ &m: res] + bound_concrete + + Pr[G1(DRestr(D)).main() @&m: G1.bcol] + Pr[G1(DRestr(D)).main() @&m: G1.bext]. proof. - apply (RealOrder.ler_trans _ _ _ (Concrete_CF D &m)). - cut : Pr[CF(D).main() @ &m : res] <= - Pr[G1(D).main() @ &m : res] + Pr[G1(D).main() @ &m : G1.bcol \/ G1.bext]. - + by byequiv CF_G1 =>/#. - cut /# : Pr[G1(D).main() @ &m : G1.bcol \/ G1.bext] <= Pr[G1(D).main() @ &m : G1.bcol] + Pr[G1(D).main() @ &m : G1.bext]. + apply (RealOrder.ler_trans _ _ _ (Real_Concrete D D_ll &m)). + cut : Pr[CF(DRestr(D)).main() @ &m : res] <= + Pr[G1(DRestr(D)).main() @ &m : res] + + Pr[G1(DRestr(D)).main() @ &m : G1.bcol \/ G1.bext]. + + byequiv (CF_G1 (DRestr(D)) _)=>//;1:by apply (DRestr_ll D D_ll). + smt ml=0. + cut /# : Pr[G1(DRestr(D)).main() @ &m : G1.bcol \/ G1.bext] <= + Pr[G1(DRestr(D)).main() @ &m : G1.bcol] + + Pr[G1(DRestr(D)).main() @ &m : G1.bext]. rewrite Pr [mu_or]; smt. qed. -end section PROOF. +end section. diff --git a/proof/old/SLCommon.ec b/proof/old/SLCommon.ec index 6cffd25..43df1f4 100644 --- a/proof/old/SLCommon.ec +++ b/proof/old/SLCommon.ec @@ -59,7 +59,7 @@ module SqueezelessSponge (P:DPRIMITIVE): FUNCTIONALITY = { proc f(p : block list): block = { var (sa,sc) <- (b0,c0); - if (1 <= size p /\ p <> [b0]) { + if (1 <= size p (*/\ p <> [b0]*)) { while (p <> []) { (* Absorption *) (sa,sc) <@ P.f((sa +^ head witness p,sc)); p <- behead p; @@ -206,3 +206,197 @@ proof. qed. +(* -------------------------------------------------------------------------- *) + +module C = { + var c:int + proc init () = { c <- 0; } +}. + +module PC (P:PRIMITIVE) = { + + proc init () = { + C.init(); + P.init(); + } + + proc f (x:state) = { + var y; + C.c <- C.c + 1; + y <@ P.f(x); + return y; + } + + proc fi(x:state) = { + var y; + C.c <- C.c + 1; + y <@ P.fi(x); + return y; + } + +}. + +module DPRestr (P:DPRIMITIVE) = { + + proc f (x:state) = { + var y=(b0,c0); + if (C.c + 1 <= max_size) { + C.c <- C.c + 1; + y <@ P.f(x); + } + return y; + } + + proc fi(x:state) = { + var y=(b0,c0); + if (C.c + 1 <= max_size) { + C.c <- C.c + 1; + y <@ P.fi(x); + } + return y; + } + +}. + +module PRestr (P:PRIMITIVE) = { + + proc init () = { + C.init(); + P.init(); + } + + proc f = DPRestr(P).f + + proc fi = DPRestr(P).fi + +}. + +module FC(F:FUNCTIONALITY) = { + + proc init = F.init + + proc f (bs:block list) = { + var b= b0; + C.c <- C.c + size bs; + b <@ F.f(bs); + return b; + } +}. + +module DFRestr(F:DFUNCTIONALITY) = { + + proc f (bs:block list) = { + var b= b0; + if (C.c + size bs <= max_size) { + C.c <- C.c + size bs; + b <@ F.f(bs); + } + return b; + } +}. + +module FRestr(F:FUNCTIONALITY) = { + + proc init = F.init + + proc f = DFRestr(F).f + +}. + +(* -------------------------------------------------------------------------- *) +(* This allow swap the counting from oracle to adversary *) +module DRestr(D:DISTINGUISHER, F:DFUNCTIONALITY, P:DPRIMITIVE) = { + proc distinguish() = { + var b; + C.init(); + b <@ D(DFRestr(F), DPRestr(P)).distinguish(); + return b; + } +}. + +lemma rp_ll (P<:DPRIMITIVE): islossless P.f => islossless DPRestr(P).f. +proof. move=>Hll;proc;sp;if=>//;call Hll;auto. qed. + +lemma rpi_ll (P<:DPRIMITIVE): islossless P.fi => islossless DPRestr(P).fi. +proof. move=>Hll;proc;sp;if=>//;call Hll;auto. qed. + +lemma rf_ll (F<:DFUNCTIONALITY): islossless F.f => islossless DFRestr(F).f. +proof. move=>Hll;proc;sp;if=>//;call Hll;auto. qed. + +lemma DRestr_ll (D<:DISTINGUISHER{C}): + (forall (F<:DFUNCTIONALITY{D})(P<:DPRIMITIVE{D}), + islossless P.f => islossless P.fi => islossless F.f => + islossless D(F,P).distinguish) => + forall (F <: DFUNCTIONALITY{DRestr(D)}) (P <: DPRIMITIVE{DRestr(D)}), + islossless P.f => + islossless P.fi => islossless F.f => islossless DRestr(D, F, P).distinguish. +proof. + move=> D_ll F P p_ll pi_ll f_ll;proc. + call (D_ll (DFRestr(F)) (DPRestr(P)) _ _ _). + + by apply (rp_ll P). + by apply (rpi_ll P). + by apply (rf_ll F). + by inline *;auto. +qed. + +(* Exemple *) +(* +section RESTR. + declare module F:FUNCTIONALITY{C}. + declare module P:PRIMITIVE{C,F}. + declare module D:DISTINGUISHER{F,P,C}. + + lemma swap_restr &m: + Pr[Indif(FRestr(F), PRestr(P), D).main()@ &m: res] = + Pr[Indif(F,P,DRestr(D)).main()@ &m: res]. + proof. + byequiv=>//. + proc;inline *;wp;swap{1}1 2;sim. + qed. + +end RESTR. +*) + +section COUNT. + + declare module P:PRIMITIVE{C}. + declare module CO:CONSTRUCTION{C,P}. + declare module D:DISTINGUISHER{C,P,CO}. + + axiom f_ll : islossless P.f. + axiom fi_ll : islossless P.fi. + + axiom CO_ll : islossless CO(P).f. + + axiom D_ll (F <: DFUNCTIONALITY{D}) (P <: DPRIMITIVE{D}): + islossless P.f => islossless P.fi => islossless F.f => + islossless D(F, P).distinguish. + + lemma Pr_restr &m : + Pr[Indif(FC(CO(P)), PC(P), D).main()@ &m:res /\ C.c <= max_size] <= + Pr[Indif(CO(P), P, DRestr(D)).main()@ &m:res]. + proof. + byequiv (_: ={glob D, glob P, glob CO} ==> C.c{1} <= max_size => ={res})=>//; + 2:by move=> ??H[]?/H<-. + symmetry;proc;inline *;wp;swap{2}1 2. + call (_: max_size < C.c, ={glob P, glob CO, glob C}). + + apply D_ll. + + proc; sp 1 0;if{1};1:by call(_:true);auto. + by call{2} f_ll;auto=>/#. + + by move=> ?_;proc;sp;if;auto;call f_ll;auto. + + by move=> _;proc;call f_ll;auto=>/#. + + proc;sp 1 0;if{1};1:by call(_:true);auto. + by call{2} fi_ll;auto=>/#. + + by move=> ?_;proc;sp;if;auto;call fi_ll;auto. + + by move=> _;proc;call fi_ll;auto=>/#. + + proc;sp 1 0;if{1};1:by call(_: ={glob P});auto;sim. + by call{2} CO_ll;auto=>/#. + + by move=> ?_;proc;sp;if;auto;call CO_ll;auto. + + move=> _;proc;call CO_ll;auto;smt ml=0 w=size_ge0. + wp;call (_:true);call(_:true);auto=>/#. + qed. + +end section COUNT. + +(* -------------------------------------------------------------------------- *) +(** The initial Game *) +module GReal(D:DISTINGUISHER) = RealIndif(SqueezelessSponge, PC(Perm), D). + From d2eef3dfec7bb0b81a4980950a19955612159804 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Fri, 11 Dec 2015 10:08:25 +0100 Subject: [PATCH 082/525] rename file --- proof/old/{G1.eca => Handle.eca} | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename proof/old/{G1.eca => Handle.eca} (100%) diff --git a/proof/old/G1.eca b/proof/old/Handle.eca similarity index 100% rename from proof/old/G1.eca rename to proof/old/Handle.eca From f31d15d822f14466b9d325b374b945e2092d3248 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Fri, 11 Dec 2015 14:52:29 +0100 Subject: [PATCH 083/525] minors fix (dead code, missing initialization), duplicate with stdlib --- proof/old/Handle.eca | 10 +++++----- proof/old/SLCommon.ec | 2 +- proof/old/Utils.ec | 19 ------------------- 3 files changed, 6 insertions(+), 25 deletions(-) diff --git a/proof/old/Handle.eca b/proof/old/Handle.eca index 42c8fc6..354c31e 100644 --- a/proof/old/Handle.eca +++ b/proof/old/Handle.eca @@ -124,18 +124,18 @@ module G1(D:DISTINGUISHER) = { return y; } - (** Distinguisher interface **) - proc init() = { } - } proc main(): bool = { var b; + RO.m <- map0; m <- map0; mi <- map0; + mh <- map0; + mhi <- map0; bext <- false; - bcol <- false; + bcol <- false; (* the empty path is initially known by the adversary to lead to capacity 0^c *) handles <- map0.[0 <- (c0, D)]; @@ -280,7 +280,7 @@ proof. by apply handles_up_handles. qed. -clone import ConcreteF as ConcreteF1. +clone export ConcreteF as ConcreteF1. section AUX. diff --git a/proof/old/SLCommon.ec b/proof/old/SLCommon.ec index 43df1f4..c1f6648 100644 --- a/proof/old/SLCommon.ec +++ b/proof/old/SLCommon.ec @@ -23,7 +23,7 @@ clone include Indifferentiability with (** max number of call to the permutation and its inverse, including those performed by the construction. *) -op max_size : int. +op max_size : { int | 0 <= max_size } as max_ge0. (** Ideal Functionality **) clone export Tuple as TupleBl with diff --git a/proof/old/Utils.ec b/proof/old/Utils.ec index 8ec5b44..549d1ac 100644 --- a/proof/old/Utils.ec +++ b/proof/old/Utils.ec @@ -1,25 +1,6 @@ (** These should make it into the standard libs **) require import Option Pair List FSet NewFMap. -(* -------------------------------------------------------------------- *) - -lemma rem_id (x : 'a) (m : ('a,'b) fmap): - !mem (dom m) x => rem x m = m. -proof. - rewrite in_dom /= => x_notin_m; apply/fmapP=> x'; rewrite remP. - case (x' = x)=> //= ->>. - by rewrite x_notin_m. -qed. - -lemma dom_rem_le (x : 'a) (m : ('a,'b) fmap) (x' : 'a): - mem (dom (rem x m)) x' => mem (dom m) x'. -proof. by rewrite dom_rem in_fsetD. qed. - -lemma rng_rem_le (x : 'a) (m : ('a,'b) fmap) (x' : 'b): - mem (rng (rem x m)) x' => mem (rng m) x'. -proof. by rewrite rng_rm in_rng=> -[x0] [_ h]; exists x0. qed. - - (* -------------------------------------------------------------------- *) (* In NewFMap *) From f73f8b6604023d41ce801b6a6efdfbcdd3bb6a1a Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Fri, 11 Dec 2015 14:52:56 +0100 Subject: [PATCH 084/525] start bounding the 2 bad events --- proof/old/G2.eca | 286 +++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 286 insertions(+) create mode 100644 proof/old/G2.eca diff --git a/proof/old/G2.eca b/proof/old/G2.eca new file mode 100644 index 0000000..2eb8483 --- /dev/null +++ b/proof/old/G2.eca @@ -0,0 +1,286 @@ +require import Pred Fun Option Pair Int Real StdOrder Ring. +require import List FSet NewFMap Utils Common SLCommon. +(*...*) import Dprod Dexcepted Capacity IntOrder. + +require Handle. + +clone import Handle as Handle0. + +(* -------------------------------------------------------------------------- *) +section PROOF. + declare module D: DISTINGUISHER{C, PF, G1}. + + axiom D_ll (F <: DFUNCTIONALITY{D}) (P <: DPRIMITIVE{D}): + islossless P.f => islossless P.fi => + islossless F.f => islossless D(F, P).distinguish. + + local module Gcol = { + + var count : int + + proc sample_c () = { + var c=c0; + if (card (image fst (rng G1.handles)) <= 2*max_size) { + c <$ cdistr; + G1.bcol <- G1.bcol \/ mem (image fst (rng G1.handles)) c; + count <- count + 1; + } + return c; + } + + module C = { + + proc f(p : block list): block = { + var sa, sa', sc; + var h, i <- 0; + sa <- b0; + if (1 <= size p /\ p <> [b0]) { + while (i < size p ) { + if (mem (dom G1.mh) (sa +^ nth witness p i, h)) { + (sa, h) <- oget G1.mh.[(sa +^ nth witness p i, h)]; + } else { + sc <@ sample_c(); + sa' <- RO.f(take (i+1) p); + sa <- sa +^ nth witness p i; + G1.mh.[(sa,h)] <- (sa', G1.chandle); + G1.mhi.[(sa',G1.chandle)] <- (sa, h); + (sa,h) <- (sa',G1.chandle); + G1.handles.[G1.chandle] <- (sc,I); + G1.chandle <- G1.chandle + 1; + } + i <- i + 1; + } + sa <- RO.f(p); + } + return sa; + } + } + + module S = { + + proc f(x : state): state = { + var p, v, y, y1, y2, hy2, hx2; + + if (!mem (dom G1.m) x) { + if (!(mem (rng G1.handles) (x.`2, D))) { + G1.handles.[G1.chandle] <- (x.`2, D); + G1.chandle <- G1.chandle + 1; + } + hx2 <- oget (hinvD G1.handles x.`2); + + if (mem (dom G1.paths) x.`2) { + (p,v) <- oget G1.paths.[x.`2]; + y1 <- RO.f (rcons p (v +^ x.`1)); + y2 <@ sample_c(); + y <- (y1, y2); + G1.paths.[y2] <- (rcons p (v +^ x.`1), y.`1); + } else { + y1 <$ bdistr; + y2 <@ sample_c(); + y <- (y1,y2); + } + (* exists x2 h, G1.handles.[h] = Some (X2,I) *) + + if (mem (dom G1.mh) (x.`1, hx2) /\ + (oget G1.handles.[(oget G1.mh.[(x.`1,hx2)]).`2]).`2 = I) { + hy2 <- (oget G1.mh.[(x.`1, hx2)]).`2; + y <- (y.`1, (oget G1.handles.[hy2]).`1); + G1.handles.[hy2] <- (y.`2, D); + (* bad <- bad \/ mem X2 y.`2; *) + G1.m.[x] <- y; + G1.mi.[y] <- x; + } else { + hy2 <- G1.chandle; + G1.chandle <- G1.chandle + 1; + G1.handles.[hy2] <- (y.`2, D); + G1.m.[x] <- y; + G1.mh.[(x.`1, hx2)] <- (y.`1, hy2); + G1.mi.[y] <- x; + G1.mhi.[(y.`1, hy2)] <- (x.`1, hx2); + } + } else { + y <- oget G1.m.[x]; + } + return y; + } + + proc fi(x : state): state = { + var y, y1, y2, hx2, hy2; + + if (!mem (dom G1.mi) x) { + if (!(mem (rng G1.handles) (x.`2, D))) { + G1.handles.[G1.chandle] <- (x.`2, D); + G1.chandle <- G1.chandle + 1; + } + hx2 <- oget (hinvD G1.handles x.`2); + y1 <$ bdistr; + y2 <@ sample_c(); + y <- (y1,y2); + if (mem (dom G1.mhi) (x.`1, hx2) /\ + (oget G1.handles.[(oget G1.mh.[(x.`1,hx2)]).`2]).`2 = I) { + (y1,hy2) <- oget G1.mhi.[(x.`1, hx2)]; + y <- (y.`1, (oget G1.handles.[hy2]).`1); + G1.handles.[hy2] <- (y.`2, D); + (* bad <- bad \/ mem X2 y.`2; *) + G1.mi.[x] <- y; + G1.mhi.[(x.`1, hx2)] <- (y.`1, hy2); + G1.m.[y] <- x; + G1.mh.[(y.`1, hy2)] <- (x.`1, hx2); + } else { + hy2 <- G1.chandle; + G1.chandle <- G1.chandle + 1; + G1.handles.[hy2] <- (y.`2, D); + G1.mi.[x] <- y; + G1.mhi.[(x.`1, hx2)] <- (y.`1, hy2); + G1.m.[y] <- x; + G1.mh.[(y.`1, hy2)] <- (x.`1, hx2); + } + } else { + y <- oget G1.mi.[x]; + } + return y; + } + + } + + proc main(): bool = { + var b; + + RO.m <- map0; + G1.m <- map0; + G1.mi <- map0; + G1.mh <- map0; + G1.mhi <- map0; + G1.bcol <- false; + + G1.handles <- map0.[0 <- (c0, D)]; + G1.paths <- map0.[c0 <- ([<:block>],b0)]; + G1.chandle <- 1; + count <- 0; + b <@ DRestr(D,C,S).distinguish(); + return b; + } + }. + + lemma card_rng_set (m:('a,'b)fmap) x y: card(rng m.[x<-y]) <= card(rng m) + 1. + proof. + rewrite rng_set fcardU fcard1. + cut := subset_leq_fcard (rng (rem x m)) (rng m) _;2:smt ml=0 w=fcard_ge0. + rewrite subsetP=> z;apply rng_rem_le. + qed. + + lemma hinv_image handles c: + hinv handles c <> None => + mem (image fst (rng handles)) c. + proof. + case: (hinv handles c) (hinvP handles c)=>//= h[f] Heq. + rewrite imageP;exists (c,f)=>@/fst/=. + by rewrite in_rng;exists (oget (Some h)). + qed. + + local equiv G1col : G1(DRestr(D)).main ~ Gcol.main : + ={glob D} ==> (G1.bcol{1} => G1.bcol{2}) /\ Gcol.count{2} <= max_size. + proof. + proc;inline*;wp. + call (_: ={RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,G1.handles,C.c}/\ + (G1.bcol{1} => G1.bcol{2}) /\ + (card (rng G1.handles) <= 2*C.c + 1 /\ + Gcol.count <= C.c <= max_size){2}). + + proc;sp 1 1;if=>//. + inline G1(DRestr(D)).S.f Gcol.S.f. + seq 2 2 : (={RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,G1.handles, + C.c,x0} /\ + (G1.bcol{1} => G1.bcol{2}) /\ + (card(rng G1.handles) + 2 <= 2*C.c + 1/\ + Gcol.count + 1 <= C.c <= max_size){2});1:by auto=>/#. + if=>//;last by auto=>/#. + swap{1}[2..4]-1. + seq 3 2:(={RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,G1.handles, + C.c,x0,hx2} /\ + (G1.bcol{1} => G1.bcol{2}) /\ + (card (rng G1.handles) + 1 <= 2 * C.c + 1/\ + Gcol.count + 1 <= C.c <= max_size){2}). + + auto;smt ml=0 w=card_rng_set. + seq 1 1: + (={RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,G1.handles, + C.c,x0,hx2,y0} /\ + ((G1.bcol\/hinv G1.handles y0.`2 <> None){1} => G1.bcol{2}) /\ + (card (rng G1.handles) + 1 <= 2 * C.c + 1 /\ + Gcol.count <= C.c <= max_size){2});last by auto;smt ml=0 w=card_rng_set. + if=>//;inline Gcol.sample_c. + + rcondt{2}4. + + auto;conseq (_:true)=>//;progress. + cut /#:= fcard_image_leq fst (rng G1.handles{hr}). + wp;conseq (_: ={p,v,RO.m,y1} /\ y2{1}=c{2})=>//;1:smt ml=0 w=hinv_image. + by sim. + rcondt{2}3. + + by auto;progress;cut /#:= fcard_image_leq fst (rng G1.handles{hr}). + swap{2}2-1;sp 0 1;wp;conseq(_:y0{1}=(y1,c){2})=>//;1:smt ml=0 w=hinv_image. + transitivity{1} {y0 <- S.sample();} + (true ==> ={y0}) + (true ==> y0{1}=(y1,c){2})=>//;1:by inline*;auto. + transitivity{2} {(y1,c) <- S.sample2();} + (true==>y0{1}=(y1,c){2}) + (true==> ={y1,c})=>//;2:by inline*;auto. + by call sample_sample2;auto=> /=?[??]->. + + + proc;sp 1 1;if=>//. + inline G1(DRestr(D)).S.fi Gcol.S.fi. + seq 2 2 : (={RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,G1.handles, + C.c,x0} /\ + (G1.bcol{1} => G1.bcol{2}) /\ + (card(rng G1.handles) + 2 <= 2*C.c + 1 /\ + Gcol.count + 1 <= C.c <= max_size){2});1:by auto=>/#. + if=>//;last by auto=>/#. + seq 3 2:(={RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,G1.handles, + C.c,x0,hx2} /\ + (G1.bcol{1} => G1.bcol{2}) /\ + (card (rng G1.handles) + 1 <= 2 * C.c + 1 /\ + Gcol.count + 1 <= C.c <= max_size){2}). + + auto;smt ml=0 w=card_rng_set. + seq 1 2: + (={RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,G1.handles, + C.c,x0,hx2} /\ y0{1} = (y1,y2){2} /\ + ((G1.bcol\/hinv G1.handles y0.`2 <> None){1} => G1.bcol{2}) /\ + (card (rng G1.handles) + 1 <= 2 * C.c + 1 /\ + Gcol.count <= C.c <= max_size){2});last by auto;smt ml=0 w=card_rng_set. + inline Gcol.sample_c. + rcondt{2}3. + + by auto;progress;cut /#:= fcard_image_leq fst (rng G1.handles{hr}). + swap{2}2-1;sp 0 1;wp;conseq(_:y0{1}=(y1,c){2})=>//;1:smt ml=0 w=hinv_image. + transitivity{1} {y0 <- S.sample();} + (true ==> ={y0}) + (true ==> y0{1}=(y1,c){2})=>//;1:by inline*;auto. + transitivity{2} {(y1,c) <- S.sample2();} + (true==>y0{1}=(y1,c){2}) + (true==> ={y1,c})=>//;2:by inline*;auto. + by call sample_sample2;auto=> /=?[??]->. + + + proc;sp 1 1;if=>//. + inline G1(DRestr(D)).C.f Gcol.C.f. + seq 5 5: + (={RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,G1.handles,C.c,b, + p,h,i,sa} /\ i{1}=0 /\ + (G1.bcol{1} => G1.bcol{2}) /\ + card (rng G1.handles{2}) + 2*(size p{2}) <= 2 * C.c{2} + 1 /\ + Gcol.count{2} + size p{2} <= C.c{2} <= max_size);1:by auto=>/#. + wp;if=>//;2:by auto;smt ml=0 w=size_ge0. + call (_: ={RO.m});1:by sim. + while + (={RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,G1.handles,C.c,b, + p,h,i,sa} /\ (i <= size p){1} /\ + (G1.bcol{1} => G1.bcol{2}) /\ + (card (rng G1.handles) + 2*(size p - i) <= 2 * C.c + 1 /\ + Gcol.count + size p - i <= C.c <= max_size){2}); + last by auto; smt ml=0 w=size_ge0. + if=>//;auto;1:smt ml=0 w=size_ge0. + call (_: ={RO.m});1:by sim. + inline *;rcondt{2} 2. + + auto;progress;cut /#:= fcard_image_leq fst (rng G1.handles{hr}). + auto;smt ml=0 w=(hinv_image card_rng_set). + + auto;progress;3:by smt ml=0. + + by rewrite rng_set rem0 rng0 fset0U fcard1. + by apply max_ge0. + qed. + From ac08aaafdff9e4d70095927f53f1b3c218a852de Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Fri, 11 Dec 2015 16:49:22 +0100 Subject: [PATCH 085/525] use fel to bound the probability. --- proof/old/G2.eca | 45 ++++++++++++++++++++++++++++++++++++++++----- 1 file changed, 40 insertions(+), 5 deletions(-) diff --git a/proof/old/G2.eca b/proof/old/G2.eca index 2eb8483..b7d61bd 100644 --- a/proof/old/G2.eca +++ b/proof/old/G2.eca @@ -1,6 +1,6 @@ -require import Pred Fun Option Pair Int Real StdOrder Ring. -require import List FSet NewFMap Utils Common SLCommon. -(*...*) import Dprod Dexcepted Capacity IntOrder. +require import Pred Fun Option Pair Int Real StdOrder Ring StdBigop. +require import List FSet NewFMap Utils Common SLCommon FelTactic Mu_mem. +(*...*) import Dprod Dexcepted Capacity IntOrder Bigreal RealOrder BRA. require Handle. @@ -20,11 +20,13 @@ section PROOF. proc sample_c () = { var c=c0; - if (card (image fst (rng G1.handles)) <= 2*max_size) { + if (card (image fst (rng G1.handles)) <= 2*max_size /\ + count < max_size) { c <$ cdistr; G1.bcol <- G1.bcol \/ mem (image fst (rng G1.handles)) c; count <- count + 1; } + return c; } @@ -209,7 +211,7 @@ section PROOF. Gcol.count <= C.c <= max_size){2});last by auto;smt ml=0 w=card_rng_set. if=>//;inline Gcol.sample_c. + rcondt{2}4. - + auto;conseq (_:true)=>//;progress. + + auto;conseq (_:true)=>//;progress;2: smt ml=0. cut /#:= fcard_image_leq fst (rng G1.handles{hr}). wp;conseq (_: ={p,v,RO.m,y1} /\ y2{1}=c{2})=>//;1:smt ml=0 w=hinv_image. by sim. @@ -284,3 +286,36 @@ section PROOF. by apply max_ge0. qed. + (* TODO: move this *) + lemma c_gt0r : 0%r < (2^c)%r. + proof. by rewrite from_intM;apply /powPos. qed. + + local lemma eps_ge0 : 0%r <= (2 * max_size)%r / (2 ^ c)%r. + proof. + apply divr_ge0;1:by rewrite from_intMle;smt ml=0 w=max_ge0. + by apply /ltrW/c_gt0r. + qed. + + local lemma Pr_col &m : + Pr[Gcol.main()@&m : G1.bcol /\ Gcol.count <= max_size] <= + max_size%r * ((2*max_size)%r / (2^c)%r). + proof. + fel 10 Gcol.count (fun x=> (2*max_size)%r / (2^c)%r) + max_size G1.bcol + [Gcol.sample_c : (card (image fst (rng G1.handles)) <= 2*max_size /\ Gcol.count < max_size)]=>//;2:by auto. + + rewrite /felsum Bigreal.sumr_const count_predT size_range. + apply ler_wpmul2r;1:by apply eps_ge0. + by rewrite from_intMle;smt ml=0 w=max_ge0. + + proc;sp;if;2:by hoare=>//??;apply eps_ge0. + wp. + rnd (mem (image fst (rng G1.handles)));skip;progress;2:smt ml=0. + rewrite (Mu_mem.mu_mem (image fst (rng G1.handles{hr})) cdistr (1%r/(2^c)%r))//. + + move=>x _;apply DWord.muxP. + rewrite (div_def (2 * _)%r) 1:from_intMeq;1:by apply /IntOrder.lt0r_neq0/powPos. + apply ler_wpmul2r;2:by rewrite from_intMle. + by apply divr_ge0=>//;apply /ltrW/c_gt0r. + + move=>ci;proc;rcondt 2;auto=>/#. + move=> b c;proc;sp;if;auto;smt ml=0. + qed. + +end section PROOF. From ceab53c113d439876bd741a501da94906605123b Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Fri, 11 Dec 2015 17:02:41 -0500 Subject: [PATCH 086/525] Tracking Benjamin's changes to Indifferentiability.eca. Because of the introduction/use of DPRIMITIVE and DFUNCTIONALITY, almost everything wasn't checking. Now constructions and simulators *don't* have access to the init procedure of their arguments, but they are still required to provide init procedures themselves. (It's in Indif.main that they are called.) Also made the version of IRO that uses a RO from [from * int] to [to] be the official implementation. --- proof/Absorb.ec | 5 +- proof/AbsorbToBlocks.ec | 17 +++--- proof/Blocks.ec | 6 +- proof/BlocksToTopLevel.ec | 27 +++++---- proof/IRO.eca | 103 +++++++++++++++++++++++----------- proof/Indifferentiability.eca | 2 +- proof/TopLevel.ec | 10 ++-- 7 files changed, 107 insertions(+), 63 deletions(-) diff --git a/proof/Absorb.ec b/proof/Absorb.ec index 31978ef..bdbbc80 100644 --- a/proof/Absorb.ec +++ b/proof/Absorb.ec @@ -25,11 +25,10 @@ clone include Indifferentiability with [module] "Indif" as "Experiment" [module] "GReal" as "RealIndif" [module] "GIdeal" as "IdealIndif". - (* -------------------------------------------------------------------- *) -module BlockSponge (P : PRIMITIVE) : RO, CONSTRUCTION(P) = { - proc init = P.init +module BlockSponge (P : DPRIMITIVE) : FUNCTIONALITY, CONSTRUCTION(P) = { + proc init() = {} proc f(p : block list): block = { var (sa,sc) <- (b0, Capacity.c0); diff --git a/proof/AbsorbToBlocks.ec b/proof/AbsorbToBlocks.ec index 8122a2a..b21bcb3 100644 --- a/proof/AbsorbToBlocks.ec +++ b/proof/AbsorbToBlocks.ec @@ -8,8 +8,8 @@ require import Common. op cast: 'a NewDistr.distr -> 'a distr. (* -------------------------------------------------------------------- *) -module LowerFun(F : Blocks.FUNCTIONALITY) : Absorb.FUNCTIONALITY = { - proc init = F.init +module LowerFun(F : Blocks.DFUNCTIONALITY) : Absorb.DFUNCTIONALITY = { + proc init() = {} proc f(xs : block list) : block = { var (ys, n) <- strip xs; @@ -22,10 +22,10 @@ module LowerFun(F : Blocks.FUNCTIONALITY) : Absorb.FUNCTIONALITY = { } }. -module Sim (S : Absorb.SIMULATOR, F : Blocks.FUNCTIONALITY) = S(LowerFun(F)). +module Sim (S : Absorb.SIMULATOR, F : Blocks.DFUNCTIONALITY) = S(LowerFun(F)). -module UpperFun (F : Absorb.FUNCTIONALITY) = { - proc init = F.init +module UpperFun (F : Absorb.DFUNCTIONALITY) = { + proc init() = {} proc f(xs : block list, n : int) : block list = { var y <- b0; @@ -43,9 +43,10 @@ module UpperFun (F : Absorb.FUNCTIONALITY) = { } }. -module BlocksOfAbsorbBlockSponge (P : Blocks.PRIMITIVE) = UpperFun(Absorb.BlockSponge(P)). +module BlocksOfAbsorbBlockSponge (P : Blocks.DPRIMITIVE) = + UpperFun(Absorb.BlockSponge(P)). -module Dist ( D : Blocks.DISTINGUISHER, F : Absorb.FUNCTIONALITY, P : Absorb.PRIMITIVE ) = D(UpperFun(F),P). +module Dist (D : Blocks.DISTINGUISHER, F : Absorb.DFUNCTIONALITY) = D(UpperFun(F)). section. declare module AbsorbSim : Absorb.SIMULATOR { Perm, Blocks.BIRO.IRO', Absorb.Ideal.RO }. @@ -232,7 +233,7 @@ section. by conseq ModularAbsorb=> &1 &2; case (arg{1}); case (arg{2}). inline *; wp;call (_: true)=> //=. auto; progress [-split]; split=> //=. - smt. + admit. done. qed. diff --git a/proof/Blocks.ec b/proof/Blocks.ec index bdc4d2b..fb20873 100644 --- a/proof/Blocks.ec +++ b/proof/Blocks.ec @@ -24,8 +24,8 @@ clone include Indifferentiability with [module] "GIdeal" as "IdealIndif". (* -------------------------------------------------------------------- *) -module BlockSponge (P : PRIMITIVE) : BIRO.IRO, CONSTRUCTION(P) = { - proc init = P.init +module BlockSponge (P : DPRIMITIVE) : FUNCTIONALITY, CONSTRUCTION(P) = { + proc init() = {} proc f(p : block list, n : int) : block list = { var z <- []; @@ -56,6 +56,6 @@ lemma top: exists (S <: SIMULATOR), forall (D <: DISTINGUISHER) &m, `| Pr[RealIndif(BlockSponge, Perm, D).main() @ &m : res] - - Pr[IdealIndif(IRO', S, D).main() @ &m : res]| + - Pr[IdealIndif(IRO, S, D).main() @ &m : res]| < eps. proof. admit. qed. diff --git a/proof/BlocksToTopLevel.ec b/proof/BlocksToTopLevel.ec index 94aff60..e9b159a 100644 --- a/proof/BlocksToTopLevel.ec +++ b/proof/BlocksToTopLevel.ec @@ -6,8 +6,8 @@ require (*--*) Blocks TopLevel. require import Common. (* -------------------------------------------------------------------- *) -module UpperFun (F : Blocks.FUNCTIONALITY) = { - proc init = F.init +module UpperFun (F : Blocks.DFUNCTIONALITY) = { + proc init() = {} proc f(p : bool list, n : int) = { var xs; @@ -17,8 +17,8 @@ module UpperFun (F : Blocks.FUNCTIONALITY) = { } }. -module LowerFun (F : TopLevel.FUNCTIONALITY) = { - proc init = F.init +module LowerFun (F : TopLevel.DFUNCTIONALITY) = { + proc init() = {} proc f(xs : block list, n : int) = { var cs, ds : bool list; @@ -43,18 +43,23 @@ proof. admit. (* done *) qed. -module ModularSimulator (S : Blocks.SIMULATOR, F : TopLevel.FUNCTIONALITY) = S(LowerFun(F)). +module ModularSimulator (S : Blocks.SIMULATOR, F : TopLevel.DFUNCTIONALITY) = + S(LowerFun(F)). -module BlocksDist ( D : TopLevel.DISTINGUISHER, F : Blocks.FUNCTIONALITY, P : PRIMITIVE) = - D(UpperFun(F),P). +module BlocksDist (D : TopLevel.DISTINGUISHER, F : Blocks.DFUNCTIONALITY) = + D(UpperFun(F)). section. declare module BlocksSim : Blocks.SIMULATOR. declare module TopLevelDist : TopLevel.DISTINGUISHER. lemma Conclusion &m: - `|Pr[TopLevel.RealIndif(TopLevel.Sponge,Perm,TopLevelDist).main() @ &m: res] - - Pr[TopLevel.IdealIndif(TopLevel.BIRO.IRO',ModularSimulator(BlocksSim),TopLevelDist).main() @ &m: res]| - = `|Pr[Blocks.RealIndif(Blocks.BlockSponge,Perm,BlocksDist(TopLevelDist)).main() @ &m: res] - - Pr[Blocks.IdealIndif(Blocks.BIRO.IRO',BlocksSim,BlocksDist(TopLevelDist)).main() @ &m: res]|. + `|Pr[TopLevel.RealIndif(TopLevel.Sponge, Perm, TopLevelDist).main() @ &m: res] - + Pr[TopLevel.IdealIndif(TopLevel.BIRO.IRO, ModularSimulator(BlocksSim), + TopLevelDist).main() @ &m: res]| = + `|Pr[Blocks.RealIndif(Blocks.BlockSponge, Perm, + BlocksDist(TopLevelDist)).main() @ &m: res] - + Pr[Blocks.IdealIndif(Blocks.BIRO.IRO, BlocksSim, + BlocksDist(TopLevelDist)).main() @ &m: res]|. proof. admit. qed. +end section. diff --git a/proof/IRO.eca b/proof/IRO.eca index a138d16..d2a1cf0 100644 --- a/proof/IRO.eca +++ b/proof/IRO.eca @@ -16,38 +16,6 @@ module type IRO = { proc f(x : from, n : int) : to list }. -module IRO : IRO = { - var mp : (from, to list) fmap - - proc init() = { mp = map0; } - - proc choose(n) = { - var b, bs; - - bs <- []; - while (0 < n) { - b <$ dto; - bs <- rcons bs b; - n <- n - 1; - } - return bs; - } - - proc f(x, n) = { - var ys, zs, aout; - - aout <- []; - if (valid x) { - ys <- odflt [] mp.[x]; - zs <@ choose (max 0 (n - size ys)); - mp.[x] <- ys ++ zs; - aout <- take n (oget mp.[x]); - } - - return aout; - } -}. - pred prefix_closed (m : (from * int,to) fmap) = forall x n, mem (dom m) (x,n) => @@ -63,6 +31,41 @@ pred prefix_closed' (m : (from * int,to) fmap) = lemma cool m: prefix_closed m <=> prefix_closed' m by []. +(* official version: *) + +module IRO : IRO = { + var mp : (from * int, to) fmap + + proc init() = { + mp <- map0; + } + + proc fill_in(x, n) = { + if (!mem (dom mp) (x, n)) { + mp.[(x,n)] <$ dto; + } + return oget mp.[(x,n)]; + } + + proc f(x, n) = { + var b, bs; + var i <- 0; + + bs <- []; + if (valid x) { + while (i < n) { + b <@ fill_in(x, i); + bs <- rcons bs b; + i <- i + 1; + } + } + + return bs; + } +}. + +(* version for AbsorbToBlocks.ec attempt *) + module IRO' : IRO = { var mp : (from * int, to) fmap var visible : (from * int) fset @@ -118,4 +121,38 @@ module IRO' : IRO = { } }. -(** The two are equivalent **) \ No newline at end of file +(* +another implementation, but probably not useful + +module IRO : IRO = { + var mp : (from, to list) fmap + + proc init() = { mp = map0; } + + proc choose(n) = { + var b, bs; + + bs <- []; + while (0 < n) { + b <$ dto; + bs <- rcons bs b; + n <- n - 1; + } + return bs; + } + + proc f(x, n) = { + var ys, zs, aout; + + aout <- []; + if (valid x) { + ys <- odflt [] mp.[x]; + zs <@ choose (max 0 (n - size ys)); + mp.[x] <- ys ++ zs; + aout <- take n (oget mp.[x]); + } + + return aout; + } +}. +*) diff --git a/proof/Indifferentiability.eca b/proof/Indifferentiability.eca index 14c871f..d0cf65e 100644 --- a/proof/Indifferentiability.eca +++ b/proof/Indifferentiability.eca @@ -36,7 +36,7 @@ module type CONSTRUCTION (P : DPRIMITIVE) = { }. module type SIMULATOR (F : DFUNCTIONALITY) = { - proc init() : unit { (* F.init *) } + proc init() : unit { } proc f(x : p) : p { F.f } proc fi(x : p) : p { F.f } }. diff --git a/proof/TopLevel.ec b/proof/TopLevel.ec index 2d724c5..39ee761 100644 --- a/proof/TopLevel.ec +++ b/proof/TopLevel.ec @@ -24,8 +24,8 @@ clone include Indifferentiability with (* -------------------------------------------------------------------- *) -module Sponge (P : PRIMITIVE) : BIRO.IRO, CONSTRUCTION(P) = { - proc init = P.init +module Sponge (P : DPRIMITIVE) : FUNCTIONALITY, CONSTRUCTION(P) = { + proc init() : unit = {} proc f(bp : bool list, n : int) : bool list = { var z <- []; @@ -52,10 +52,12 @@ module Sponge (P : PRIMITIVE) : BIRO.IRO, CONSTRUCTION(P) = { (* -------------------------------------------------------------------- *) op eps : real. +print RealIndif. + lemma top: exists (S <: SIMULATOR), forall (D <: DISTINGUISHER) &m, - `| Pr[Experiment(Sponge(Perm), Perm, D).main() @ &m : res] - - Pr[Experiment(IRO, S(IRO), D).main() @ &m : res]| + `| Pr[RealIndif(Sponge, Perm, D).main() @ &m : res] + - Pr[IdealIndif(IRO, S, D).main() @ &m : res]| < eps. proof. admit. qed. From b7a4f164516cb2ebc5b38aff394ad4a746828708 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Mon, 14 Dec 2015 12:43:40 +0100 Subject: [PATCH 087/525] some intermediary stuff. --- proof/old/G2.eca | 238 +++++++++- proof/old/Handle.eca | 7 +- proof/old/MyRO.ec | 1003 ++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 1236 insertions(+), 12 deletions(-) create mode 100644 proof/old/MyRO.ec diff --git a/proof/old/G2.eca b/proof/old/G2.eca index b7d61bd..3c91e0e 100644 --- a/proof/old/G2.eca +++ b/proof/old/G2.eca @@ -6,6 +6,10 @@ require Handle. clone import Handle as Handle0. + + +(* + (* -------------------------------------------------------------------------- *) section PROOF. declare module D: DISTINGUISHER{C, PF, G1}. @@ -81,14 +85,11 @@ section PROOF. y2 <@ sample_c(); y <- (y1,y2); } - (* exists x2 h, G1.handles.[h] = Some (X2,I) *) - if (mem (dom G1.mh) (x.`1, hx2) /\ - (oget G1.handles.[(oget G1.mh.[(x.`1,hx2)]).`2]).`2 = I) { + in_dom_with G1.handles (oget G1.mh.[(x.`1,hx2)]).`2 I) { hy2 <- (oget G1.mh.[(x.`1, hx2)]).`2; y <- (y.`1, (oget G1.handles.[hy2]).`1); G1.handles.[hy2] <- (y.`2, D); - (* bad <- bad \/ mem X2 y.`2; *) G1.m.[x] <- y; G1.mi.[y] <- x; } else { @@ -119,11 +120,10 @@ section PROOF. y2 <@ sample_c(); y <- (y1,y2); if (mem (dom G1.mhi) (x.`1, hx2) /\ - (oget G1.handles.[(oget G1.mh.[(x.`1,hx2)]).`2]).`2 = I) { + in_dom_with G1.handles (oget G1.mhi.[(x.`1,hx2)]).`2 I) { (y1,hy2) <- oget G1.mhi.[(x.`1, hx2)]; y <- (y.`1, (oget G1.handles.[hy2]).`1); G1.handles.[hy2] <- (y.`2, D); - (* bad <- bad \/ mem X2 y.`2; *) G1.mi.[x] <- y; G1.mhi.[(x.`1, hx2)] <- (y.`1, hy2); G1.m.[y] <- x; @@ -290,10 +290,13 @@ section PROOF. lemma c_gt0r : 0%r < (2^c)%r. proof. by rewrite from_intM;apply /powPos. qed. + lemma c_ge0r : 0%r <= (2^c)%r. + proof. by apply /ltrW/c_gt0r. qed. + local lemma eps_ge0 : 0%r <= (2 * max_size)%r / (2 ^ c)%r. proof. apply divr_ge0;1:by rewrite from_intMle;smt ml=0 w=max_ge0. - by apply /ltrW/c_gt0r. + by apply c_ge0r. qed. local lemma Pr_col &m : @@ -313,9 +316,228 @@ section PROOF. + move=>x _;apply DWord.muxP. rewrite (div_def (2 * _)%r) 1:from_intMeq;1:by apply /IntOrder.lt0r_neq0/powPos. apply ler_wpmul2r;2:by rewrite from_intMle. - by apply divr_ge0=>//;apply /ltrW/c_gt0r. + by apply divr_ge0=>//;apply /c_ge0r. + move=>ci;proc;rcondt 2;auto=>/#. move=> b c;proc;sp;if;auto;smt ml=0. qed. end section PROOF. +*) + +module type SAMPLE = { + proc sampleI(h:handle) : unit + proc setD(h:handle, c:capacity) : unit + proc get(h:handle) : capacity + proc in_dom(h:handle,c:caller) : bool + proc restrD() : (handle,capacity)fmap +}. + +module type ADV_SAMPLEH(O:SAMPLE) = { + proc main() : bool +}. + + +module Lsample = { + var handles : (handle, ccapacity)fmap + + proc sampleI(h:handle) = { + var c; + c <$ cdistr; + handles.[h] <- (c,I); + } + + proc setD (h:handle, c:capacity) = { + handles.[h] <- (c,D); + } + + proc in_dom(h:handle, c:caller) = { + return in_dom_with handles h c; + } + + proc restrD() = { + return ( + let m = NewFMap.filter (fun _ (p:ccapacity) => p.`2=D) handles in + NewFMap.map (fun _ (p:ccapacity) => p.`1) m); + } + + proc get(h:handle) = { + var c; + c <$ cdistr; + if (!mem (dom handles) h) { + handles.[h] <- (c,D); + } + return (oget (handles.[h])).`1; + } + +}. + +module Esample = { + var handles : (handle, ccapacity)fmap + + proc sampleI(h:handle) = { + var c; + c <$ cdistr; + handles.[h] <- (c,I); + } + + proc setD (h:handle, c:capacity) = { + handles.[h] <- (c,D); + } + + proc in_dom(h:handle, c:caller) = { + return in_dom_with handles h c; + } + + proc restrD() = { + return ( + let m = NewFMap.filter (fun _ (p:ccapacity) => p.`2=D) handles in + NewFMap.map (fun _ (p:ccapacity) => p.`1) m); + } + + proc get(h:handle) = { + var c; + c <$ cdistr; + if (!mem (dom handles) h || (oget handles.[h]).`2 = I) { + handles.[h] <- (c,D); + } + return (oget (handles.[h])).`1; + } + +}. + +op hinvc (handles : (handle,capacity)fmap) (c : capacity) : handle option = + find (fun _ => pred1 c) handles. + +module G2(D:DISTINGUISHER,HS:SAMPLE) = { + + module C = { + + proc f(p : block list): block = { + var sa, sa'; + var h, i <- 0; + sa <- b0; + if (1 <= size p /\ p <> [b0]) { + while (i < size p ) { + if (mem (dom G1.mh) (sa +^ nth witness p i, h)) { + (sa, h) <- oget G1.mh.[(sa +^ nth witness p i, h)]; + } else { + HS.sampleI(G1.chandle); + sa' <- RO.f(take (i+1) p); + sa <- sa +^ nth witness p i; + G1.mh.[(sa,h)] <- (sa', G1.chandle); + G1.mhi.[(sa',G1.chandle)] <- (sa, h); + (sa,h) <- (sa',G1.chandle); + G1.chandle <- G1.chandle + 1; + } + i <- i + 1; + } + sa <- RO.f(p); + } + return sa; + } + } + + module S = { + + proc f(x : state): state = { + var p, v, y, y1, y2, hy2, hx2, handles_,t; + + if (!mem (dom G1.m) x) { + if (mem (dom G1.paths) x.`2) { + (p,v) <- oget G1.paths.[x.`2]; + y1 <- RO.f (rcons p (v +^ x.`1)); + y2 <$ cdistr; + y <- (y1, y2); + G1.paths.[y2] <- (rcons p (v +^ x.`1), y.`1); + } else { + y <$ dstate; + } +(* G1.bext <- G1.bext \/ mem (rng handles) (x.`2, I); *) + (* exists x2 h, handles.[h] = Some (X2,I) *) + handles_ <@ HS.restrD(); + if (!mem (rng handles_) x.`2) { + HS.setD(G1.chandle, x.`2); + G1.chandle <- G1.chandle + 1; + } + handles_ <- HS.restrD(); + hx2 <- oget (hinvc handles_ x.`2); + t <@ HS.in_dom((oget G1.mh.[(x.`1,hx2)]).`2, I); + if (mem (dom G1.mh) (x.`1, hx2) /\ t) { + hy2 <- (oget G1.mh.[(x.`1, hx2)]).`2; + y2 <@ HS.get(hy2); + y <- (y.`1, y2); + (* bad <- bad \/ mem X2 y.`2; *) + G1.m.[x] <- y; + G1.mi.[y] <- x; + } else { + hy2 <- G1.chandle; + G1.chandle <- G1.chandle + 1; + HS.setD(hy2, y.`2); + G1.m.[x] <- y; + G1.mh.[(x.`1, hx2)] <- (y.`1, hy2); + G1.mi.[y] <- x; + G1.mhi.[(y.`1, hy2)] <- (x.`1, hx2); + } + } else { + y <- oget G1.m.[x]; + } + return y; + } + + proc fi(x : state): state = { + var y, y1, y2, hx2, hy2, handles_, t; + + if (!mem (dom G1.mi) x) { + (* bext <- bext \/ mem (rng handles) (x.`2, I); *) + (* exists x2 h, handles.[h] = Some (X2,I) *) + handles_ <@ HS.restrD(); + if (!mem (rng handles_) x.`2) { + HS.setD(G1.chandle, x.`2); + G1.chandle <- G1.chandle + 1; + } + handles_ <@ HS.restrD(); + hx2 <- oget (hinvc handles_ x.`2); + y <$ dstate; + t <@ HS.in_dom((oget G1.mh.[(x.`1,hx2)]).`2, I); + if (mem (dom G1.mhi) (x.`1, hx2) /\ t) { + (y1,hy2) <- oget G1.mhi.[(x.`1, hx2)]; + y2 <@ HS.get(hy2); + y <- (y.`1, y2); + (* bad <- bad \/ mem X2 y.`2; *) + G1.mi.[x] <- y; + G1.m.[y] <- x; + } else { + hy2 <- G1.chandle; + G1.chandle <- G1.chandle + 1; + HS.setD(hy2, y.`2); + G1.mi.[x] <- y; + G1.mhi.[(x.`1, hx2)] <- (y.`1, hy2); + G1.m.[y] <- x; + G1.mh.[(y.`1, hy2)] <- (x.`1, hx2); + } + } else { + y <- oget G1.mi.[x]; + } + return y; + } + + } + + proc main(): bool = { + var b; + + RO.m <- map0; + G1.m <- map0; + G1.mi <- map0; + G1.mh <- map0; + G1.mhi <- map0; + G1.bext <- false; + + (* the empty path is initially known by the adversary to lead to capacity 0^c *) + HS.setD(0,c0); + G1.paths <- map0.[c0 <- ([<:block>],b0)]; + G1.chandle <- 1; + b <@ D(C,S).distinguish(); + return b; + } +}. \ No newline at end of file diff --git a/proof/old/Handle.eca b/proof/old/Handle.eca index 354c31e..a5f2b18 100644 --- a/proof/old/Handle.eca +++ b/proof/old/Handle.eca @@ -64,7 +64,7 @@ module G1(D:DISTINGUISHER) = { chandle <- chandle + 1; } hx2 <- oget (hinvD handles x.`2); - if (mem (dom mh) (x.`1, hx2) /\ (oget handles.[(oget mh.[(x.`1,hx2)]).`2]).`2 = I) { + if (mem (dom mh) (x.`1, hx2) /\ in_dom_with handles (oget mh.[(x.`1,hx2)]).`2 I) { hy2 <- (oget mh.[(x.`1, hx2)]).`2; y <- (y.`1, (oget handles.[hy2]).`1); handles.[hy2] <- (y.`2, D); @@ -99,15 +99,14 @@ module G1(D:DISTINGUISHER) = { } hx2 <- oget (hinvD handles x.`2); y <$ dstate; - if (mem (dom mhi) (x.`1, hx2) /\ (oget handles.[(oget mh.[(x.`1,hx2)]).`2]).`2 = I) { + if (mem (dom mhi) (x.`1,hx2) /\ + in_dom_with handles (oget mhi.[(x.`1,hx2)]).`2 I) { (y1,hy2) <- oget mhi.[(x.`1, hx2)]; y <- (y.`1, (oget handles.[hy2]).`1); handles.[hy2] <- (y.`2, D); (* bad <- bad \/ mem X2 y.`2; *) mi.[x] <- y; - mhi.[(x.`1, hx2)] <- (y.`1, hy2); m.[y] <- x; - mh.[(y.`1, hy2)] <- (x.`1, hx2); } else { bcol <- bcol \/ hinv handles y.`2 <> None; hy2 <- chandle; diff --git a/proof/old/MyRO.ec b/proof/old/MyRO.ec new file mode 100644 index 0000000..59aaaab --- /dev/null +++ b/proof/old/MyRO.ec @@ -0,0 +1,1003 @@ +require import Option List FSet NewFMap. + import NewLogic. + +abstract theory Titer. + +type t. + +module type Orcl = { + proc f (x:t) : unit +}. + +module Iter (O:Orcl) = { + proc iter(l:t list) = { + while (l <> []) { + O.f(head witness l); + l <- drop 1 l; + } + } +}. + +section. + +declare module O:Orcl. + +axiom iter_swap1 i1 i2: + equiv [Iter(O).iter ~ Iter(O).iter : + l{1} = [i1;i2] /\ l{2} = [i2;i1] /\ ={glob O} ==> ={glob O}]. + +lemma iter_swap s1 i s2: + equiv [Iter(O).iter ~ Iter(O).iter : + l{1} = i::s1++s2 /\ l{2} = s1++i::s2 /\ ={glob O} ==> ={glob O}]. +proof. + elim:s1=> /=[|i' s1 Hrec];1:by sim. + transitivity Iter(O).iter + (l{1}= i :: i' :: (s1 ++ s2) /\ l{2} = i' :: i :: (s1 ++ s2) /\ ={glob O} ==> + ={glob O}) + (l{1}= i' :: i :: (s1 ++ s2) /\ l{2} = i' :: (s1 ++ i::s2) /\ ={glob O} ==> + ={glob O})=>//. + + by move=> ?&ml[*]<*>;exists (glob O){ml}, (i' :: i :: (s1 ++ s2)). + + proc;rcondt{1}1=>//;rcondt{2}1=>//. + rcondt{1}3;1:by auto;conseq(_: true). + rcondt{2}3;1:by auto;conseq(_: true). + seq 4 4 : (={l,glob O});last by sim. + transitivity{1} {Iter(O).iter([i;i']); l <- drop 2 l;} + (l{1} = i :: i' :: (s1 ++ s2) /\ ={l, glob O} ==> ={l,glob O}) + (l{1} = i :: i' :: (s1 ++ s2) /\ + l{2} = i' :: i :: (s1 ++ s2) /\ ={glob O} ==> ={l,glob O})=>//. + + by move=>?&ml[*]<*>;exists (glob O){ml}, (i :: i' :: (s1 ++ s2)). + + inline *;rcondt{2} 2;1:by auto. + rcondt{2} 4;1:by auto;sp;conseq(_:true). + rcondf{2} 6; auto;call(_:true);wp;call(_:true);auto. + transitivity{1} {Iter(O).iter([i';i]); l <- drop 2 l;} + (l{1} = i :: i' :: (s1 ++ s2) /\ + l{2} = i' :: i :: (s1 ++ s2) /\ ={glob O} ==> ={l,glob O}) + (l{2} = i' :: i :: (s1 ++ s2) /\ ={l, glob O} ==> ={l,glob O})=>//. + + by move=>?&ml[*]<*>;exists (glob O){ml}, (i' :: i :: (s1 ++ s2)). + + wp; by call (iter_swap1 i i'). + (* call iter_swap1: FIXME catch exception *) + inline *;rcondt{1} 2;1:by auto. + rcondt{1} 4;1:by auto;sp;conseq(_:true). + rcondf{1} 6; auto;call(_:true);wp;call(_:true);auto. + proc;rcondt{1}1=>//;rcondt{2}1=>//. + seq 2 2 : (l{1} = i :: (s1 ++ s2) /\ l{2} = s1 ++ i :: s2 /\ ={glob O}). + + by wp;call(_:true);auto;progress;rewrite drop0. + transitivity{1} {Iter(O).iter(l); } + (={l,glob O} /\ l{1}= i::(s1++s2) ==> ={glob O}) + (={glob O} /\ l{1}=i::(s1++s2) /\ l{2}= (s1++i::s2) ==> ={glob O})=>//. + + by move=>?&ml[*]<*>;exists (glob O){ml}, (i :: (s1 ++ s2)). + + by inline *;sim. + transitivity{1} {Iter(O).iter(l); } + (={glob O} /\ l{1}=i::(s1++s2) /\ l{2}= (s1++i::s2) ==> ={glob O}) + (={l,glob O} /\ l{2}= (s1++i::s2) ==> ={glob O})=>//. + + by move=>?&ml[*]<*>;exists (glob O){ml}, (s1 ++ i::s2). + + by call Hrec;auto. + by inline*;sim. +qed. + +lemma iter_perm : + equiv [Iter(O).iter ~ Iter(O).iter : perm_eq l{1} l{2} /\ ={glob O} ==> ={glob O}]. +proof. + exists*l{1},l{2};elim*=>l1 l2;case (perm_eq l1 l2)=> Hp;last first. + + conseq (_:false==>_)=>// ??[*]//. + elim: l1 l2 Hp=> [|i s1 ih] s2 eq_s12 /=. + + have ->: s2 = [] by apply/perm_eq_small/perm_eq_sym. + proc;rcondf{1} 1=>//;rcondf{2} 1=>//. + have/perm_eq_mem/(_ i) := eq_s12; rewrite mem_head /=. + move/splitPr => [s3 s4] ->>. + transitivity Iter(O).iter + (l{1}=i::s1 /\ l{2}=i::(s3++s4) /\ ={glob O} ==> ={glob O}) + (l{1}=i::(s3++s4) /\ l{2}=s3++i::s4 /\ ={glob O} ==> ={glob O})=>//. + + by move=>?&ml[*]-> -> _ ->; exists (glob O){ml}, (i :: (s3 ++ s4)). + + proc;rcondt{1}1=>//;rcondt{2}1=>//. + seq 2 2: (s1 = l{1} /\ l{2}=s3++s4 /\ ={glob O}). + + by wp;call(_:true);auto;progress;rewrite drop0. + transitivity{1} {Iter(O).iter(l); } + (={l,glob O} ==> ={glob O}) + (s1 = l{1} /\ l{2} = s3 ++ s4 /\ ={glob O} ==> ={glob O})=>//. + + by move=>?&ml[*]-> -> ->;exists (glob O){ml}, l{1}. + + by inline Iter(O).iter;sim. + transitivity{1} {Iter(O).iter(l); } + (s1 = l{1} /\ l{2} = s3 ++ s4 /\ ={glob O} ==> ={glob O}) + (={l,glob O} ==> ={glob O}) =>//. + + by move=>?&ml[*]-> -> ->;exists (glob O){ml}, (s3++s4). + + move: eq_s12; rewrite -(cat1s i s4) catA perm_eq_sym. + rewrite perm_catCA /= perm_cons perm_eq_sym=> Hp. + + call (ih (s3++s4) Hp)=>//. + by inline Iter(O).iter;sim. + by apply (iter_swap s3 i s4). (* FIXME: apply iter_swap fail! *) +qed. + +end section. + +end Titer. + +type flag = [ Unknown | Known ]. + +abstract theory Ideal. + +type from, to. + +op sampleto : from -> to distr. + +module type RO = { + proc init () : unit + proc get (x : from) : to + proc set (x : from, y : to) : unit + proc sample(x : from) : unit + proc in_dom(x : from,f : flag) : bool + proc restrK() : (from,to)fmap +}. + +module type Distinguisher(G : RO) = { + proc distinguish(): bool +}. + +op in_dom_with (m:(from, to * flag)fmap) (x:from) (f:flag) = + mem (dom m) x /\ (oget (m.[x])).`2 = f. + +op restr f (m:(from, to * flag)fmap) = + let m = filter (fun _ (p:to*flag) => p.`2=f) m in + map (fun _ (p:to*flag) => p.`1) m. + +lemma restrP m f x: + (restr f m).[x] = + obind (fun (p:to*flag)=>if p.`2=f then Some p.`1 else None) m.[x]. +proof. + rewrite /restr /= mapP filterP in_dom /=. + by case (m.[x])=>//= -[x0 f'];rewrite oget_some /=;case (f' = f). +qed. + +lemma restr_dom m f x: + mem (dom(restr f m)) x <=> (mem (dom m) x /\ (oget m.[x]).`2 = f). +proof. + rewrite !in_dom;case: (m.[x]) (restrP m f x)=>//= -[t f'] /=. + by rewrite oget_some /=;case (f' = f)=> [_ ->|]. +qed. + +lemma restr_set_diff f2 f1 m x y: + !mem (dom m) x => + f2 <> f1 => restr f1 m.[x<-(y,f2)] = restr f1 m. +proof. + rewrite fmapP in_dom=>/= Hdom Hf x';rewrite !restrP getP. + by case (x' = x)=>//=->;rewrite Hf Hdom. +qed. + +module RO : RO = { + var m : (from, to * flag)fmap + + proc init () = { m <- map0; } + + proc get(x:from) = { + var r; + r <$ sampleto x; + if (mem (dom m) x) r <- (oget m.[x]).`1; + m.[x] <- (r,Known); + return r; + } + + proc set (x:from, y:to) = { + m.[x] <- (y,Known); + } + + proc sample(x:from) = { + var c; + c <$ sampleto x; + m.[x] <- (c,Unknown); + } + + proc in_dom(x:from, f:flag) = { + return in_dom_with m x f; + } + + proc restrK() = { + return restr Known m; + } +}. + +section LL. + +lemma init_ll : islossless RO.init. +proof. by proc;auto. qed. + +lemma in_dom_ll : islossless RO.in_dom. +proof. by proc. qed. + +lemma restrK_ll : islossless RO.restrK. +proof. by proc. qed. + +lemma set_ll : islossless RO.set. +proof. by proc;auto. qed. + +axiom sampleto_ll : forall x, Distr.weight (sampleto x) = 1%r. + +lemma get_ll : islossless RO.get. +proof. by proc;auto;progress;apply sampleto_ll. qed. + +lemma sample_ll : islossless RO.sample. +proof. by proc;auto;progress;apply sampleto_ll. qed. + +end section LL. + +end Ideal. + +abstract theory GenEager. + +clone include Ideal. + +axiom sampleto_ll : forall x, Distr.weight (sampleto x) = 1%r. + +clone include Titer with type t <- from. + +module ERO : RO = { + + proc init = RO.init + + proc get(x:from) = { + var r; + r <$ sampleto x; + if (!mem (dom RO.m) x || (oget RO.m.[x]).`2 = Unknown) { + RO.m.[x] <- (r,Known); + } + return (oget RO.m.[x]).`1; + } + + proc set = RO.set + + proc sample = RO.sample + + proc in_dom = RO.in_dom + + proc restrK = RO.restrK + + module I = { + proc f = sample + } + + proc resample () = { + Iter(I).iter (elems (dom (restr Unknown RO.m))); + } + +}. + +lemma set_eq (m:('a,'b)fmap) x y: m.[x] = Some y => m.[x<-y] = m. +proof. + by rewrite fmapP=> Hx x';rewrite getP;case (x'=x)=>//->;rewrite Hx. +qed. + +lemma eager_get : + eager [ERO.resample(); , RO.get ~ ERO.get, ERO.resample(); : + ={x,RO.m} ==> ={res,RO.m} ]. +proof. + eager proc. + wp;case ((mem (dom RO.m) x /\ (oget RO.m.[x]).`2=Known){1}). + + rnd{1};rcondf{2} 2;1:by auto=> /#. + alias{1} 1 mx = oget RO.m.[x];inline *. + while (={l,RO.m} /\ (!mem l x /\ RO.m.[x] = Some (mx.`1,Known)){1}). + + auto=>?&ml[*]-> ->;case (l{ml})=>//=x2 l2 Hmx Hgx?->. + by rewrite getP drop0 /#. + auto=>??[*]-> ->/= Hmem HK;rewrite sampleto_ll/==> r _. + rewrite -memE restr_dom Hmem/= HK. + rewrite {1}get_oget //= -HK;case:(oget _)HK=> x1?/=->. + by move=>????-> _[*]_-> _ Heq?;rewrite in_dom set_eq Heq. + rcondt{2} 2. + auto=> ?[*]-> ->;rewrite negb_and /#. + case ((mem (dom RO.m) x){1}). + + inline{1} ERO.resample=>/=. + transitivity{1} { Iter(ERO.I).iter(x::elems ((dom (restr Unknown RO.m)) `\` fset1 x)); + r <$ sampleto x; } + (={x,RO.m} /\ mem (dom RO.m{1}) x{1} /\ (oget RO.m{1}.[x{1}]).`2 = Unknown ==> + ={x,RO.m}) + (={x,RO.m} /\ mem (dom RO.m{1}) x{1} /\ (oget RO.m{1}.[x{1}]).`2 = Unknown==> + ={x} /\ eq_except RO.m{1} RO.m{2} (fset1 x{1}) /\ + RO.m{1}.[x{2}] = Some (result{2},Unknown) /\ + RO.m{2}.[x{2}] = Some (result{2},Known)). + + by move=>?&ml[*]-> -> ??;exists RO.m{ml}, x{ml}=>/#. + + move=>???;rewrite in_dom=>[*]<*>[*]->/eq_except_sym H Hxm Hx2. + rewrite Hxm oget_some /=;apply /eq_sym. + have /(congr1 oget):= Hx2 => <-;apply eq_except_set_eq=>//. + by rewrite in_dom Hx2. + + rnd;call (iter_perm ERO.I _). + + + + + + cut ->: (result{2}, Known) = oget RO.m{2}.[x{2}]. + + + search eq_except. + set_eq. + 1:Hx. +;rewrite H=>{H}. + + <- ((oget RO.m{1}.[x{1}]).`1, Known)] = RO.m{2} + mem (dom RO.m{1} x{1} + + transitivity{1} { work <- dom RO.m; + r <$ sampleto x; + while (work <> fset0) { + x0 <- pick work; + if (in_dom_with RO.m x0 Unknown) { + c <$ sampleto x0; + RO.m.[x0] <- (if x0 = x then r else c, Unknown); + } + work <- work `\` fset1 (pick work); + } } + (={x,RO.m} ==> ={x,RO.m}) + (={x,RO.m} /\ (mem (dom RO.m) x /\ (oget RO.m.[x]).`2 = Unknown){1} ==> + ={x} /\ RO.m{1} = RO.m{2}.[x{2}<-(result{2}, Unknown)] /\ + RO.m{2}.[x{2}] = Some(result{2}, Known)). + + move=>?&mr[*]-> ->??;exists RO.m{mr},x{mr}=>/#. + + move=>?&m?[2*]-> -> <- ->_. + by rewrite in_dom getP_eq oget_some set_set set_eq. + + seq 1 1:(={work,x,RO.m});[by sim|symmetry]. + eager while (H:r<$sampleto x; ~ r<$sampleto x; : ={x} ==> ={r})=>//;1,3:by sim. + swap{1}2-1;sp 1 1. + if{2};[rcondt{1}2|rcondf{1}2];1,3,4:by auto. + by rnd{2};wp;case ((x0 = x){1});[rnd{1}|];auto=>??[*]-> -> -> -> ->_ _ _->; + rewrite sampleto_ll. + alias{1} 1 cx = (oget RO.m.[x]).`1. + while (={work,x,r} /\ mem (dom RO.m{1}) x{1} /\ (RO.m.[x]=Some(r,Known)){2}/\ + RO.m{1} = (RO.m.[x<-(if mem work x then cx{1} else r, Unknown)]){2}). + + sp 1 1;case ((x0 = x){1}). + + rcondt{1} 1. by auto;progress;rewrite getP_eq oget_some;case (mem _ _). + rcondf{2} 1. by auto=> @/in_dom_with;progress;rewrite H0. + auto=> ??[*]_-> -> -> ->?-> ->?_<-/=;rewrite sampleto_ll=>c _. + by rewrite dom_set !inE /= set_set. + if=>//. auto;progress[-split]. by rewrite /in_dom_with dom_set getP !inE H3. + + auto;progress [-split];split=>// _. + by rewrite dom_set !inE H/= getP set_set (eq_sym x{2}) H3 H0. + by auto;progress;rewrite !inE (eq_sym x{2}) H3. + auto;progress [-split];rewrite H1 /=. + rewrite dom_set fsetUC subset_fsetU_id /=. + + by move=> x;rewrite inE. + rewrite H getP_eq /= set_set /= set_eq. + + by rewrite {1}get_oget // -H0;case (oget _). + by move=> ????-> ->/=[*];rewrite !inE oget_some. + inline *;swap{1} 3 -2. + admit. +(* + (* Admit *) + while (={work,x,r} /\ (RO.m.[x]=None){1} /\ + RO.m{2} = RO.m{1}.[x{2}<-(r{2},Known)] /\ + !mem work{2} x{2}). + + wp;sp 1 1;if. auto=> ??[*]-> -> -> Hex Hmem Heq Hx _ /= ?->/=. + rewrite !inE Hmem !getP Heq /=. + cut ^Hd->/=: x{2} <> pick work{2} by smt ml=0 w=mem_pick. + by rewrite Hex set_set Hd. + auto=>??/=[*]-> -> _ ^Hdom;rewrite in_dom=>/=Hnone?->;rewrite restr_set_diff//=. + by rewrite Hnone /= restr_dom Hdom=>????-> ->[*];rewrite in_dom getP_eq. *) +qed. + +search "_.[_<-_]". + search + auto=> ??/=[*]-> -> _ Hmem/=?->/=;rewrite restr_set_diff //=. + rewrite eq_except_sym set_eq_except restr_dom Hmem getP_eq=>????->_ [*]. + + rewrite Hmem. + + get_eq. + + transitivity{2} { + +=>-[->//|/#]. + + + {1}(get_oget m_R x{2}). +print get_oget. +search "_.[_]" "_.[_<-_]". +print restrK. + + +smt. + H /=;smt. + case ((!mem work x){1}). + + swap{1} 2 -1;while (={work,x} /\ eq_except RO.m{1} RO.m{2} (fset1 x{1}) /\ + (!mem work x){1} /\ (RO.m.[x] = Some rd){2} /\ (!mem (dom RO.m) x){1}). + + inline *;auto;progress [-split]. + cut -> : mem (dom RO.m{2}) (pick work{2}) = mem (dom RO.m{1}) (pick work{2}) by rewrite !in_dom;smt. + smt. + auto;progress [-split];rewrite !getP_eq;smt. + inline RO.f. + transitivity{1} { rd <$ sample x; + while (work <> fset0) { + x0 <- pick work; + rd0 <$ sample x0; + if (!mem (dom RO.m) x0) + RO.m.[x0] <- if x0 = x then rd else rd0; + work <- work `\` fset1 (pick work); + } } + (={x,work,RO.m} ==> ={x,RO.m}) + ((={x,work,RO.m} /\ mem work{1} x{1}) /\ ! mem (dom RO.m{2}) x{2} ==> + ={x,RO.m} /\ (result = oget RO.m.[x]){2} /\ mem (dom RO.m{1}) x{1}) => //. + + by move=> &1 &2 H; exists RO.m{2}, x{2}, work{2}; move: H. + + transitivity{1} { while (work <> fset0) { + x0 <- pick work; + rd0 <$ sample x0; + if (!mem (dom RO.m) x0) RO.m.[x0] <- rd0; + work <- work `\` fset1 (pick work); + } + rd <$ sample x; } + (={x,work,RO.m} ==> ={x,RO.m}) + (={x,work,RO.m} ==> ={x,RO.m})=> //. + + by move=> &1 &2 H; exists RO.m{2}, x{2}, work{2}; move: H. + + by sim; rnd{2}; sim : (={x,IND_Eager.H.m}); smt. + symmetry; eager while (H: rd <$ sample x; ~ rd <$ sample x; : ={x} ==> ={rd})=> //; sim. + swap{2} 5 -4; swap [2..3] -1; case ((x = pick work){1}). + + by wp; rnd{2}; rnd; rnd{1}; wp; skip; smt. + by auto; smt. + + while (={x, work} /\ + (!mem work x => mem (dom RO.m) x){1} /\ + RO.m.[x]{2} = Some rd{1} /\ + if (mem (dom RO.m) x){1} then ={RO.m} + else eq_except RO.m{1} RO.m{2} (fset1 x{1})). + + auto;progress; 1..9,12:smt. + + case ((pick work = x){2})=> pick_x; last smt. + subst x{2}; move: H7 H1; rewrite -neqF /eq_except=> -> /= eq_exc. + by apply fmapP=> x0; case (pick work{2} = x0); smt. + by auto; smt. + by auto;progress [-split];rewrite H0 /= getP_eq;smt. + + + + + + + + + + + + + + module IND_S(D:Distinguisher) = { + proc main(): bool = { + var b; + RO.init(); + b <@ D(RO).distinguish(); + ERO.sample(); + return b; + } + }. + + section EAGER. + + local lemma eager_query: + eager [ERO.sample(); , RO.f ~ ERO.f, ERO.sample(); : + ={x,RO.m} ==> ={res,RO.m} ]. + proof. + eager proc. + inline ERO.sample;swap{2} 4 -3. + seq 1 1: (={x,work,RO.m});first by sim. + wp;case ((mem (dom RO.m) x){1}). + + rnd{1}. + alias{1} 1 mx = oget RO.m.[x]. + while (={work,RO.m} /\ (RO.m.[x] = Some mx){1}). + + by inline *;auto;progress;smt. + auto;progress [- split]; rewrite sample_ll H /=;smt. + case ((!mem work x){1}). + + swap{1} 2 -1;while (={work,x} /\ eq_except RO.m{1} RO.m{2} (fset1 x{1}) /\ + (!mem work x){1} /\ (RO.m.[x] = Some rd){2} /\ (!mem (dom RO.m) x){1}). + + inline *;auto;progress [-split]. + cut -> : mem (dom RO.m{2}) (pick work{2}) = mem (dom RO.m{1}) (pick work{2}) by rewrite !in_dom;smt. + smt. + auto;progress [-split];rewrite !getP_eq;smt. + inline RO.f. + transitivity{1} { rd <$ sample x; + while (work <> fset0) { + x0 <- pick work; + rd0 <$ sample x0; + if (!mem (dom RO.m) x0) + RO.m.[x0] <- if x0 = x then rd else rd0; + work <- work `\` fset1 (pick work); + } } + (={x,work,RO.m} ==> ={x,RO.m}) + ((={x,work,RO.m} /\ mem work{1} x{1}) /\ ! mem (dom RO.m{2}) x{2} ==> + ={x,RO.m} /\ (result = oget RO.m.[x]){2} /\ mem (dom RO.m{1}) x{1}) => //. + + by move=> &1 &2 H; exists RO.m{2}, x{2}, work{2}; move: H. + + transitivity{1} { while (work <> fset0) { + x0 <- pick work; + rd0 <$ sample x0; + if (!mem (dom RO.m) x0) RO.m.[x0] <- rd0; + work <- work `\` fset1 (pick work); + } + rd <$ sample x; } + (={x,work,RO.m} ==> ={x,RO.m}) + (={x,work,RO.m} ==> ={x,RO.m})=> //. + + by move=> &1 &2 H; exists RO.m{2}, x{2}, work{2}; move: H. + + by sim; rnd{2}; sim : (={x,IND_Eager.H.m}); smt. + symmetry; eager while (H: rd <$ sample x; ~ rd <$ sample x; : ={x} ==> ={rd})=> //; sim. + swap{2} 5 -4; swap [2..3] -1; case ((x = pick work){1}). + + by wp; rnd{2}; rnd; rnd{1}; wp; skip; smt. + by auto; smt. + + while (={x, work} /\ + (!mem work x => mem (dom RO.m) x){1} /\ + RO.m.[x]{2} = Some rd{1} /\ + if (mem (dom RO.m) x){1} then ={RO.m} + else eq_except RO.m{1} RO.m{2} (fset1 x{1})). + + auto;progress; 1..9,12:smt. + + case ((pick work = x){2})=> pick_x; last smt. + subst x{2}; move: H7 H1; rewrite -neqF /eq_except=> -> /= eq_exc. + by apply fmapP=> x0; case (pick work{2} = x0); smt. + by auto; smt. + by auto;progress [-split];rewrite H0 /= getP_eq;smt. + qed. + + equiv Eager_S (D <: Distinguisher{RO}): IND_S(D).main ~ IND(ERO,D).main: ={glob D} ==> ={res,RO.m,glob D}. + proof. + proc; inline ERO.init RO.init. + seq 1 1: (={glob D, RO.m});first by wp. + symmetry; eager (H: ERO.sample(); ~ ERO.sample();: ={RO.m} ==> ={RO.m}): + (={glob D, RO.m}) => //; first by sim. + eager proc H (={RO.m}) => //; [by apply eager_query | by sim]. + qed. + + equiv Eager (D <: Distinguisher{RO}): IND(RO,D).main ~ IND(ERO,D).main: ={glob D} ==> ={res,glob D}. + proof. + transitivity IND_S(D).main + (={glob D} ==> ={res,glob D}) + (={glob D} ==> ={res,RO.m,glob D}) => //. + + by progress;exists (glob D){2}. + + proc;inline{2} ERO.sample. + while{2} true (card work{2}). + + move=> &m1 z;wp;call (f_ll sample_ll);auto;smt. + conseq (_: _ ==> ={b,glob D}) => //;[smt | by sim]. + apply (Eager_S D). + qed. + + end section EAGER. + +end GenIdeal. + + + + + + + + + + + + + + + +abstract theory + + +module type SAMPLE = { + proc sampleI(h:handle) : unit + proc setD(h:handle, c:capacity) : unit + proc get(h:handle) : capacity + proc in_dom(h:handle,c:caller) : bool + proc restrD() : (handle,capacity)fmap +}. + +module type ADV_SAMPLEH(O:SAMPLE) = { + proc main() : bool +}. + + + +module Esample = { + var handles : (handle, ccapacity)fmap + + proc sampleI(h:handle) = { + var c; + c <$ cdistr; + handles.[h] <- (c,I); + } + + proc setD (h:handle, c:capacity) = { + handles.[h] <- (c,D); + } + + proc in_dom(h:handle, c:caller) = { + return in_dom_with handles h c; + } + + proc restrD() = { + return ( + let m = NewFMap.filter (fun _ (p:ccapacity) => p.`2=D) handles in + NewFMap.map (fun _ (p:ccapacity) => p.`1) m); + } + + proc get(h:handle) = { + var c; + c <$ cdistr; + if (!mem (dom handles) h || (oget handles.[h]).`2 = I) { + handles.[h] <- (c,D); + } + return (oget (handles.[h])).`1; + } + +}. + + + + + + + + +type from, to. + +module type RO = { + proc init() : unit + proc f(x : from): to +}. + +module type Distinguisher(G : RO) = { + proc distinguish(): bool {G.f} +}. + +module IND(G:RO, D:Distinguisher) = { + proc main(): bool = { + var b; + + G.init(); + b <@ D(G).distinguish(); + return b; + } +}. + +abstract theory Ideal. + + op sample : from -> to distr. + + module RO = { + var m : (from, to) fmap + + proc init() : unit = { + m <- map0; + } + + proc f(x : from) : to = { + var rd; + rd <$ sample x; + if (! mem (dom m) x) m.[x] <- rd; + return oget m.[x]; + } + }. + + section LL. + + axiom sample_ll : forall x, Distr.weight (sample x) = 1%r. + + lemma f_ll : phoare[RO.f : true ==> true] = 1%r. + proof. proc;auto;progress;apply sample_ll. qed. + + end section LL. + +end Ideal. + + +abstract theory GenIdeal. + + clone include Ideal. + axiom sample_ll : forall x, Distr.weight (sample x) = 1%r. + + op RO_dom : from fset. + + module ERO = { + proc sample() = { + var work; + work <- RO_dom; + while (work <> fset0) { + RO.f(pick work); + work = work `\` fset1 (pick work); + } + } + + proc init() = { + RO.m <- map0; + sample(); + } + + proc f = RO.f + }. + + module IND_S(D:Distinguisher) = { + proc main(): bool = { + var b; + RO.init(); + b <@ D(RO).distinguish(); + ERO.sample(); + return b; + } + }. + + section EAGER. + + local lemma eager_query: + eager [ERO.sample(); , RO.f ~ ERO.f, ERO.sample(); : + ={x,RO.m} ==> ={res,RO.m} ]. + proof. + eager proc. + inline ERO.sample;swap{2} 4 -3. + seq 1 1: (={x,work,RO.m});first by sim. + wp;case ((mem (dom RO.m) x){1}). + + rnd{1}. + alias{1} 1 mx = oget RO.m.[x]. + while (={work,RO.m} /\ (RO.m.[x] = Some mx){1}). + + by inline *;auto;progress;smt. + auto;progress [- split]; rewrite sample_ll H /=;smt. + case ((!mem work x){1}). + + swap{1} 2 -1;while (={work,x} /\ eq_except RO.m{1} RO.m{2} (fset1 x{1}) /\ + (!mem work x){1} /\ (RO.m.[x] = Some rd){2} /\ (!mem (dom RO.m) x){1}). + + inline *;auto;progress [-split]. + cut -> : mem (dom RO.m{2}) (pick work{2}) = mem (dom RO.m{1}) (pick work{2}) by rewrite !in_dom;smt. + smt. + auto;progress [-split];rewrite !getP_eq;smt. + inline RO.f. + transitivity{1} { rd <$ sample x; + while (work <> fset0) { + x0 <- pick work; + rd0 <$ sample x0; + if (!mem (dom RO.m) x0) + RO.m.[x0] <- if x0 = x then rd else rd0; + work <- work `\` fset1 (pick work); + } } + (={x,work,RO.m} ==> ={x,RO.m}) + ((={x,work,RO.m} /\ mem work{1} x{1}) /\ ! mem (dom RO.m{2}) x{2} ==> + ={x,RO.m} /\ (result = oget RO.m.[x]){2} /\ mem (dom RO.m{1}) x{1}) => //. + + by move=> &1 &2 H; exists RO.m{2}, x{2}, work{2}; move: H. + + transitivity{1} { while (work <> fset0) { + x0 <- pick work; + rd0 <$ sample x0; + if (!mem (dom RO.m) x0) RO.m.[x0] <- rd0; + work <- work `\` fset1 (pick work); + } + rd <$ sample x; } + (={x,work,RO.m} ==> ={x,RO.m}) + (={x,work,RO.m} ==> ={x,RO.m})=> //. + + by move=> &1 &2 H; exists RO.m{2}, x{2}, work{2}; move: H. + + by sim; rnd{2}; sim : (={x,IND_Eager.H.m}); smt. + symmetry; eager while (H: rd <$ sample x; ~ rd <$ sample x; : ={x} ==> ={rd})=> //; sim. + swap{2} 5 -4; swap [2..3] -1; case ((x = pick work){1}). + + by wp; rnd{2}; rnd; rnd{1}; wp; skip; smt. + by auto; smt. + + while (={x, work} /\ + (!mem work x => mem (dom RO.m) x){1} /\ + RO.m.[x]{2} = Some rd{1} /\ + if (mem (dom RO.m) x){1} then ={RO.m} + else eq_except RO.m{1} RO.m{2} (fset1 x{1})). + + auto;progress; 1..9,12:smt. + + case ((pick work = x){2})=> pick_x; last smt. + subst x{2}; move: H7 H1; rewrite -neqF /eq_except=> -> /= eq_exc. + by apply fmapP=> x0; case (pick work{2} = x0); smt. + by auto; smt. + by auto;progress [-split];rewrite H0 /= getP_eq;smt. + qed. + + equiv Eager_S (D <: Distinguisher{RO}): IND_S(D).main ~ IND(ERO,D).main: ={glob D} ==> ={res,RO.m,glob D}. + proof. + proc; inline ERO.init RO.init. + seq 1 1: (={glob D, RO.m});first by wp. + symmetry; eager (H: ERO.sample(); ~ ERO.sample();: ={RO.m} ==> ={RO.m}): + (={glob D, RO.m}) => //; first by sim. + eager proc H (={RO.m}) => //; [by apply eager_query | by sim]. + qed. + + equiv Eager (D <: Distinguisher{RO}): IND(RO,D).main ~ IND(ERO,D).main: ={glob D} ==> ={res,glob D}. + proof. + transitivity IND_S(D).main + (={glob D} ==> ={res,glob D}) + (={glob D} ==> ={res,RO.m,glob D}) => //. + + by progress;exists (glob D){2}. + + proc;inline{2} ERO.sample. + while{2} true (card work{2}). + + move=> &m1 z;wp;call (f_ll sample_ll);auto;smt. + conseq (_: _ ==> ={b,glob D}) => //;[smt | by sim]. + apply (Eager_S D). + qed. + + end section EAGER. + +end GenIdeal. + +abstract theory FiniteIdeal. + + clone include Ideal. + axiom sample_ll (x : from): Distr.weight (sample x) = 1%r. + + op univ : from fset. + axiom univP (x:from) : mem univ x. + + module ERO = { + proc sample() = { + var work; + work <- univ; + while (work <> fset0) { + RO.f(pick work); + work = work `\` fset1 (pick work); + } + } + + proc init() = { + RO.m <- map0; + sample(); + } + + proc f(x:from):to = { return oget RO.m.[x]; } + }. + + module IND_S(D:Distinguisher) = { + proc main(): bool = { + var b; + RO.init(); + b <@ D(RO).distinguish(); + ERO.sample(); + return b; + } + }. + + section EAGER. + + declare module D: Distinguisher { RO }. + + local clone GenIdeal as GI with + op sample <- sample, + op RO_dom <- univ + proof sample_ll by apply sample_ll. + + local equiv ERO_main: + IND(GI.ERO, D).main ~ IND(ERO, D).main : ={glob D} ==> ={res, glob D} /\ GI.RO.m{1} = RO.m{2}. + proof. + proc. + call (_:GI.RO.m{1} = RO.m{2} /\ dom RO.m{2} = univ). + + proc; rcondf{1} 2;auto;progress;[ by rewrite H univP | by apply sample_ll]. + inline *. + while (={work} /\ GI.RO.m{1} = RO.m{2} /\ dom RO.m{2} = univ `\` work{2});auto;smt. + qed. + + equiv Eager_S : IND_S(D).main ~ IND(ERO,D).main: ={glob D} ==> ={res,RO.m,glob D}. + proof. + transitivity GI.IND_S(D).main + (={glob D} ==> ={res,glob D} /\ RO.m{1} = GI.RO.m{2}) + (={glob D} ==> ={res,glob D} /\ GI.RO.m{1} = RO.m{2}) => //. + + by progress;exists (glob D){2}. + + by sim. + transitivity IND(GI.ERO,D).main + (={glob D} ==> ={res,glob D, GI.RO.m}) + (={glob D} ==> ={res,glob D} /\ GI.RO.m{1} = RO.m{2}) => //. + + by progress;exists (glob D){2}. + + by conseq (GI.Eager_S D). + by apply ERO_main. + qed. + + equiv Eager : IND(RO, D).main ~ IND(ERO,D).main: ={glob D} ==> ={res,glob D}. + proof. + transitivity IND(GI.RO,D).main + (={glob D} ==> ={res,glob D} /\ RO.m{1} = GI.RO.m{2}) + (={glob D} ==> ={res,glob D}) => //. + + by progress;exists (glob D){2}. + + by sim. + transitivity IND(GI.ERO,D).main + (={glob D} ==> ={res,glob D}) + (={glob D} ==> ={res,glob D}) => //. + + by progress;exists (glob D){2}. + + by conseq (GI.Eager D). + by conseq ERO_main. + qed. + + end section EAGER. + +end FiniteIdeal. + + +abstract theory RestrIdeal. + + clone include Ideal. + axiom sample_ll (x : from): Distr.weight (sample x) = 1%r. + + op test : from -> bool. + op univ : from fset. + op dfl : to. + + axiom testP x : test x <=> mem univ x. + + module Restr (O:RO) = { + proc init = RO.init + proc f (x:from) : to = { + var r <- dfl; + if (test x) r <@ RO.f(x); + return r; + } + }. + + module ERO = { + proc sample() = { + var work; + work <- univ; + while (work <> fset0) { + RO.f(pick work); + work = work `\` fset1 (pick work); + } + } + + proc init() = { + RO.m <- map0; + sample(); + } + + proc f(x:from):to = { + return (if test x then oget RO.m.[x] else dfl); + } + }. + + module IND_S(D:Distinguisher) = { + proc main(): bool = { + var b; + RO.init(); + b <@ D(Restr(RO)).distinguish(); + ERO.sample(); + return b; + } + }. + + section EAGER. + + declare module D: Distinguisher { RO }. + + local clone GenIdeal as GI with + op sample <- sample, + op RO_dom <- univ. + + local module Restr' (O:RO) = { + proc init() = { } + proc f(x:from) = { + var r <- dfl; + if (test x) r <@ O.f(x); + return r; + } + }. + + local module RD (O:RO) = D(Restr'(O)). + + local equiv ERO_main: + IND(GI.ERO, RD).main ~ IND(ERO, D).main : ={glob D} ==> ={res, glob D} /\ GI.RO.m{1} = RO.m{2}. + proof. + proc. + call (_:GI.RO.m{1} = RO.m{2} /\ dom RO.m{2} = univ). + + proc. + case (test x{1});[ rcondt{1} 2 | rcondf{1} 2];auto;last smt ml=0. + by inline *;rcondf{1} 4;auto;progress;2:(by apply sample_ll);rewrite ?H0 ?H -?testP. + inline *. + while (={work} /\ GI.RO.m{1} = RO.m{2} /\ dom RO.m{2} `|` work{2} = univ);auto;1:progress; smt. + qed. + + equiv Eager_S : IND_S(D).main ~ IND(ERO,D).main: ={glob D} ==> ={res,RO.m,glob D}. + proof. + transitivity GI.IND_S(RD).main + (={glob D} ==> ={res,glob D} /\ RO.m{1} = GI.RO.m{2}) + (={glob D} ==> ={res,glob D} /\ GI.RO.m{1} = RO.m{2}) => //. + + by progress;exists (glob D){2}. + + by sim. + transitivity IND(GI.ERO,RD).main + (={glob D} ==> ={res,glob D, GI.RO.m}) + (={glob D} ==> ={res,glob D} /\ GI.RO.m{1} = RO.m{2}) => //. + + by progress;exists (glob D){2}. + + by conseq (GI.Eager_S RD). + by apply ERO_main. + qed. + + equiv Eager : IND(Restr(RO), D).main ~ IND(ERO,D).main: ={glob D} ==> ={res,glob D}. + proof. + transitivity IND(GI.RO,RD).main + (={glob D} ==> ={res,glob D} /\ RO.m{1} = GI.RO.m{2}) + (={glob D} ==> ={res,glob D}) => //. + + by progress;exists (glob D){2}. + + by sim. + transitivity IND(GI.ERO,RD).main + (={glob D} ==> ={res,glob D}) + (={glob D} ==> ={res,glob D}) => //. + + by progress;exists (glob D){2}. + + by conseq (GI.Eager RD). + by conseq ERO_main. + qed. + + end section EAGER. + +end RestrIdeal. \ No newline at end of file From 697e1e5819ee31ff0add754f657b9789cff764b3 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Mon, 14 Dec 2015 17:08:39 -0500 Subject: [PATCH 088/525] Two auxiliary lemmas, for consideration for inclusion in EC library: lemma dvdz_lt (x y z : int) : 0 < z => z %| x => z %| y => x < y => x + z <= y. lemma chunk_cat r (xs ys : 'a list) : 0 < r => r %| size xs => chunk r (xs ++ ys) = chunk r xs ++ chunk r ys. --- proof/Temp.ec | 63 +++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 63 insertions(+) create mode 100644 proof/Temp.ec diff --git a/proof/Temp.ec b/proof/Temp.ec new file mode 100644 index 0000000..0ab3d3b --- /dev/null +++ b/proof/Temp.ec @@ -0,0 +1,63 @@ +(* Temporary File for Auxiliary Lemmas *) + +require import Option Fun Pair Int IntExtra IntDiv Real List NewDistr. +require import Ring StdRing StdOrder StdBigop BitEncoding. +(*---*) import IntID IntOrder BitChunking. + +(* Add to IntDiv? *) + +lemma dvdz_lt (x y z : int) : + 0 < z => z %| x => z %| y => x < y => x + z <= y. +proof. +move=> gt0_z z_dvd_x z_dvd_y. +have -> : x = (x %/ z) * z by rewrite divzK. +have -> : y = (y %/ z) * z by rewrite divzK. +pose u := x %/ z; pose v := y %/ z; move=> u_tim_z_lt_v_tim_z. +have u_lt_v : u < v by rewrite -(@ltr_pmul2r z). +have -> : v = u + (v - u) by ring. +rewrite mulrDl ler_add2l ler_pemull 1:ltrW //. +by rewrite - (@ler_add2r u) - addrA addNr /= lez_add1r. +qed. + +(* Add to BitEncoding? *) + +lemma chunk_cat r (xs ys : 'a list) : + 0 < r => r %| size xs => chunk r (xs ++ ys) = chunk r xs ++ chunk r ys. +proof. +move=> ge0_r r_dvd_siz_xs; rewrite /chunk size_cat divzDl //. +(rewrite mkseq_add; first 2 rewrite divz_ge0 // size_ge0); congr. +apply eq_in_mkseq=> i [ge0_i i_lt_siz_xs_div_r] /=. +have i_tim_r_lt_siz_xs : i * r < size xs + by rewrite ltz_divRL // in i_lt_siz_xs_div_r. +have i_tim_r_add_r_le_siz_xs : i * r + r <= size xs + by rewrite dvdz_lt // dvdz_mull dvdzz. +rewrite mulrC drop_cat i_tim_r_lt_siz_xs /= take_cat. +cut r_le_siz_drop : r <= size (drop (i * r) xs) + by rewrite size_drop 1:divr_ge0 // 1:ltrW // max_ler + ler_subr_addr /= 1:ltrW // addrC. +rewrite ler_eqVlt in r_le_siz_drop. +elim r_le_siz_drop=> [r_eq_siz_drop | -> //]. +rewrite {1 6 8} r_eq_siz_drop /= take0 cats0 take_size //. +apply eq_in_mkseq=> i [ge0_i lt_siz_ys_i] /=. +have -> : r * (size xs %/ r + i) = size xs + r * i + by rewrite mulrDr mulrC divzK. +rewrite drop_cat. +case (size xs + r * i < size xs)=> [/gtr_addl lt0_r_tim_i | _]. +have contrad : 0 <= r * i < 0 by split; [rewrite divr_ge0 1:ltrW |]. +rewrite ler_lt_asym in contrad; elim contrad. +have -> // : size xs + r * i - size xs = r * i by ring. +qed. + +(* Add to Common? *) + +theory ForCommon. + +require import Common. + +lemma chunk_cat (xs ys : 'a list) : + r %| size xs => chunk r (xs ++ ys) = chunk r xs ++ chunk r ys. +proof. +exact /chunk_cat /gt0_r. +qed. + +end ForCommon. From 24355e295284443d304da262fa072ecba36b70fe Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Tue, 15 Dec 2015 01:39:27 +0100 Subject: [PATCH 089/525] Move a new version of generic RO with the corresponding eager proof. Should help a lot in the proof of squeezeless sponge and also in the Alley part. --- proof/old/MyRO.ec | 978 +++++++++++++--------------------------------- 1 file changed, 269 insertions(+), 709 deletions(-) diff --git a/proof/old/MyRO.ec b/proof/old/MyRO.ec index 59aaaab..56f8be7 100644 --- a/proof/old/MyRO.ec +++ b/proof/old/MyRO.ec @@ -1,5 +1,39 @@ require import Option List FSet NewFMap. - import NewLogic. + import NewLogic Fun. + +(* TODO: move this *) +lemma set_eq (m:('a,'b)fmap) x y: m.[x] = Some y => m.[x<-y] = m. +proof. + by rewrite fmapP=> Hx x';rewrite getP;case (x'=x)=>//->;rewrite Hx. +qed. + +lemma oflistK_uniq (s : 'a list) : uniq s => + perm_eq s (elems (oflist s)). +proof. by move/undup_id => {1}<-; apply/FSet.oflistK. qed. + +lemma setD1E (s : 'a fset) x : + perm_eq (elems (s `\` fset1 x)) (rem x (elems s)). +proof. +rewrite setDE; pose s' := List.filter _ _; apply/(perm_eq_trans s'). + rewrite perm_eq_sym oflistK_uniq ?filter_uniq ?uniq_elems. +rewrite /s' rem_filter ?uniq_elems; apply/uniq_perm_eq; + rewrite ?filter_uniq ?uniq_elems // => y. +by rewrite !mem_filter /predC in_fset1. +qed. + +lemma perm_to_rem (s:'a fset) x : + mem s x => perm_eq (elems s) (x :: elems (s `\` fset1 x)). +proof. +rewrite memE => /perm_to_rem /perm_eqlP->; apply/perm_cons. +have /perm_eqlP <- := (setD1E s x); rewrite perm_eq_refl. +qed. + +lemma mem_drop (s:'a list) n x: mem (drop n s) x => mem s x. +proof. by rewrite -{2}(cat_take_drop n) mem_cat=>->. qed. + +lemma mem_take (s:'a list) n x: mem (take n s) x => mem s x. +proof. by rewrite -{2}(cat_take_drop n) mem_cat=>->. qed. +(* end TODO *) abstract theory Titer. @@ -18,6 +52,14 @@ module Iter (O:Orcl) = { } }. +lemma iter_ll(O<:Orcl): islossless O.f => islossless Iter(O).iter. +proof. + move=> O_ll;proc;inline Iter(O).iter. + while true (size l);auto=>/=. + + call O_ll;skip=> /=?[*]Hl<-;smt ml=0 w=(size_eq0 size_ge0 size_drop). + smt ml=0 w=(size_eq0 size_ge0). +qed. + section. declare module O:Orcl. @@ -36,7 +78,7 @@ proof. ={glob O}) (l{1}= i' :: i :: (s1 ++ s2) /\ l{2} = i' :: (s1 ++ i::s2) /\ ={glob O} ==> ={glob O})=>//. - + by move=> ?&ml[*]<*>;exists (glob O){ml}, (i' :: i :: (s1 ++ s2)). + + by move=> ?&mr[*]<*>;exists (glob O){mr}, (i' :: i :: (s1 ++ s2)). + proc;rcondt{1}1=>//;rcondt{2}1=>//. rcondt{1}3;1:by auto;conseq(_: true). rcondt{2}3;1:by auto;conseq(_: true). @@ -45,7 +87,7 @@ proof. (l{1} = i :: i' :: (s1 ++ s2) /\ ={l, glob O} ==> ={l,glob O}) (l{1} = i :: i' :: (s1 ++ s2) /\ l{2} = i' :: i :: (s1 ++ s2) /\ ={glob O} ==> ={l,glob O})=>//. - + by move=>?&ml[*]<*>;exists (glob O){ml}, (i :: i' :: (s1 ++ s2)). + + by move=>?&mr[*]<*>;exists (glob O){mr}, (i :: i' :: (s1 ++ s2)). + inline *;rcondt{2} 2;1:by auto. rcondt{2} 4;1:by auto;sp;conseq(_:true). rcondf{2} 6; auto;call(_:true);wp;call(_:true);auto. @@ -53,7 +95,7 @@ proof. (l{1} = i :: i' :: (s1 ++ s2) /\ l{2} = i' :: i :: (s1 ++ s2) /\ ={glob O} ==> ={l,glob O}) (l{2} = i' :: i :: (s1 ++ s2) /\ ={l, glob O} ==> ={l,glob O})=>//. - + by move=>?&ml[*]<*>;exists (glob O){ml}, (i' :: i :: (s1 ++ s2)). + + by move=>?&mr[*]<*>;exists (glob O){mr}, (i' :: i :: (s1 ++ s2)). + wp; by call (iter_swap1 i i'). (* call iter_swap1: FIXME catch exception *) inline *;rcondt{1} 2;1:by auto. @@ -65,12 +107,12 @@ proof. transitivity{1} {Iter(O).iter(l); } (={l,glob O} /\ l{1}= i::(s1++s2) ==> ={glob O}) (={glob O} /\ l{1}=i::(s1++s2) /\ l{2}= (s1++i::s2) ==> ={glob O})=>//. - + by move=>?&ml[*]<*>;exists (glob O){ml}, (i :: (s1 ++ s2)). + + by move=>?&mr[*]<*>;exists (glob O){mr}, (i :: (s1 ++ s2)). + by inline *;sim. transitivity{1} {Iter(O).iter(l); } (={glob O} /\ l{1}=i::(s1++s2) /\ l{2}= (s1++i::s2) ==> ={glob O}) (={l,glob O} /\ l{2}= (s1++i::s2) ==> ={glob O})=>//. - + by move=>?&ml[*]<*>;exists (glob O){ml}, (s1 ++ i::s2). + + by move=>?&mr[*]<*>;exists (glob O){mr}, (s1 ++ i::s2). + by call Hrec;auto. by inline*;sim. qed. @@ -88,19 +130,19 @@ proof. transitivity Iter(O).iter (l{1}=i::s1 /\ l{2}=i::(s3++s4) /\ ={glob O} ==> ={glob O}) (l{1}=i::(s3++s4) /\ l{2}=s3++i::s4 /\ ={glob O} ==> ={glob O})=>//. - + by move=>?&ml[*]-> -> _ ->; exists (glob O){ml}, (i :: (s3 ++ s4)). + + by move=>?&mr[*]-> -> _ ->; exists (glob O){mr}, (i :: (s3 ++ s4)). + proc;rcondt{1}1=>//;rcondt{2}1=>//. seq 2 2: (s1 = l{1} /\ l{2}=s3++s4 /\ ={glob O}). + by wp;call(_:true);auto;progress;rewrite drop0. transitivity{1} {Iter(O).iter(l); } (={l,glob O} ==> ={glob O}) (s1 = l{1} /\ l{2} = s3 ++ s4 /\ ={glob O} ==> ={glob O})=>//. - + by move=>?&ml[*]-> -> ->;exists (glob O){ml}, l{1}. + + by move=>?&mr[*]-> -> ->;exists (glob O){mr}, l{1}. + by inline Iter(O).iter;sim. transitivity{1} {Iter(O).iter(l); } (s1 = l{1} /\ l{2} = s3 ++ s4 /\ ={glob O} ==> ={glob O}) (={l,glob O} ==> ={glob O}) =>//. - + by move=>?&ml[*]-> -> ->;exists (glob O){ml}, (s3++s4). + + by move=>?&mr[*]-> -> ->;exists (glob O){mr}, (s3++s4). + move: eq_s12; rewrite -(cat1s i s4) catA perm_eq_sym. rewrite perm_catCA /= perm_cons perm_eq_sym=> Hp. + call (ih (s3++s4) Hp)=>//. @@ -155,14 +197,29 @@ proof. by rewrite oget_some /=;case (f' = f)=> [_ ->|]. qed. -lemma restr_set_diff f2 f1 m x y: +lemma restr_set m f1 f2 x y: + restr f1 m.[x<-(y,f2)] = if f1 = f2 then (restr f1 m).[x<-y] else rem x (restr f1 m). +proof. + rewrite fmapP;case (f1=f2)=>[->|Hneq]x0;rewrite !(restrP,getP);1: by case (x0=x). + case (x0=x)=>[->|Hnx];1:by rewrite (eq_sym f2) Hneq remP_eq. + by rewrite remP Hnx restrP. +qed. + +lemma restr_set_eq m f x y: + restr f m.[x<-(y,f)] = (restr f m).[x<-y]. +proof. by rewrite restr_set. qed. + +lemma restr0 f : restr f map0 = map0. +proof. by apply fmapP=>x;rewrite restrP !map0P. qed. + +lemma restr_set_neq f2 f1 m x y: !mem (dom m) x => f2 <> f1 => restr f1 m.[x<-(y,f2)] = restr f1 m. proof. - rewrite fmapP in_dom=>/= Hdom Hf x';rewrite !restrP getP. - by case (x' = x)=>//=->;rewrite Hf Hdom. + by move=>Hm Hneq;rewrite restr_set (eq_sym f1) Hneq rem_id//restr_dom Hm. qed. +(* -------------------------------------------------------------------------- *) module RO : RO = { var m : (from, to * flag)fmap @@ -221,6 +278,8 @@ end section LL. end Ideal. + +(* -------------------------------------------------------------------------- *) abstract theory GenEager. clone include Ideal. @@ -260,9 +319,32 @@ module ERO : RO = { }. -lemma set_eq (m:('a,'b)fmap) x y: m.[x] = Some y => m.[x<-y] = m. +lemma resample_ll : islossless ERO.resample. +proof. + proc;call (iter_ll ERO.I _)=>//;apply (sample_ll sampleto_ll). +qed. + +lemma eager_init : + eager [ERO.resample(); , RO.init ~ ERO.init, ERO.resample(); : + ={RO.m} ==> ={RO.m} ]. proof. - by rewrite fmapP=> Hx x';rewrite getP;case (x'=x)=>//->;rewrite Hx. + eager proc. inline{2} *;rcondf{2}3;auto=>/=. + + by move=>?_;rewrite restr0 dom0 elems_fset0. + by conseq (_:) (_:true==>true: =1%r) _=>//;call resample_ll. +qed. + +lemma iter_perm2 (i1 i2 : from): + equiv[ Iter(ERO.I).iter ~ Iter(ERO.I).iter : + l{1} = [i1; i2] /\ l{2} = [i2; i1] /\ ={glob ERO.I} ==> + ={glob ERO.I}]. +proof. + proc;rcondt{1}1=>//;rcondt{2}1=>//. + rcondt{1}3;1:by auto;conseq(_:true). + rcondt{2}3;1:by auto;conseq(_:true). + seq 4 4 : (={l,RO.m});2:by sim. + case (i1=i2);1:by sim. + inline *;swap[4..5]-2;swap{2} 6-2;auto=>?&mr[*]3!<*>Hneq/=?->?->/=. + by rewrite set_set Hneq. qed. lemma eager_get : @@ -274,7 +356,7 @@ proof. + rnd{1};rcondf{2} 2;1:by auto=> /#. alias{1} 1 mx = oget RO.m.[x];inline *. while (={l,RO.m} /\ (!mem l x /\ RO.m.[x] = Some (mx.`1,Known)){1}). - + auto=>?&ml[*]-> ->;case (l{ml})=>//=x2 l2 Hmx Hgx?->. + + auto=>?&mr[*]-> ->;case (l{mr})=>//=x2 l2 Hmx Hgx?->. by rewrite getP drop0 /#. auto=>??[*]-> ->/= Hmem HK;rewrite sampleto_ll/==> r _. rewrite -memE restr_dom Hmem/= HK. @@ -282,722 +364,200 @@ proof. by move=>????-> _[*]_-> _ Heq?;rewrite in_dom set_eq Heq. rcondt{2} 2. + auto=> ?[*]-> ->;rewrite negb_and /#. case ((mem (dom RO.m) x){1}). - + inline{1} ERO.resample=>/=. + + inline{1} ERO.resample=>/=;rnd{1}. transitivity{1} { Iter(ERO.I).iter(x::elems ((dom (restr Unknown RO.m)) `\` fset1 x)); - r <$ sampleto x; } + } (={x,RO.m} /\ mem (dom RO.m{1}) x{1} /\ (oget RO.m{1}.[x{1}]).`2 = Unknown ==> ={x,RO.m}) (={x,RO.m} /\ mem (dom RO.m{1}) x{1} /\ (oget RO.m{1}.[x{1}]).`2 = Unknown==> ={x} /\ eq_except RO.m{1} RO.m{2} (fset1 x{1}) /\ RO.m{1}.[x{2}] = Some (result{2},Unknown) /\ RO.m{2}.[x{2}] = Some (result{2},Known)). - + by move=>?&ml[*]-> -> ??;exists RO.m{ml}, x{ml}=>/#. + + by move=>?&mr[*]-> -> ??;exists RO.m{mr}, x{mr}=>/#. + move=>???;rewrite in_dom=>[*]<*>[*]->/eq_except_sym H Hxm Hx2. - rewrite Hxm oget_some /=;apply /eq_sym. + rewrite sampleto_ll=> r _;rewrite /= Hxm oget_some /=;apply /eq_sym. have /(congr1 oget):= Hx2 => <-;apply eq_except_set_eq=>//. by rewrite in_dom Hx2. - + rnd;call (iter_perm ERO.I _). - - - - - - cut ->: (result{2}, Known) = oget RO.m{2}.[x{2}]. - - - search eq_except. - set_eq. - 1:Hx. -;rewrite H=>{H}. - - <- ((oget RO.m{1}.[x{1}]).`1, Known)] = RO.m{2} - mem (dom RO.m{1} x{1} - - transitivity{1} { work <- dom RO.m; - r <$ sampleto x; - while (work <> fset0) { - x0 <- pick work; - if (in_dom_with RO.m x0 Unknown) { - c <$ sampleto x0; - RO.m.[x0] <- (if x0 = x then r else c, Unknown); - } - work <- work `\` fset1 (pick work); - } } - (={x,RO.m} ==> ={x,RO.m}) - (={x,RO.m} /\ (mem (dom RO.m) x /\ (oget RO.m.[x]).`2 = Unknown){1} ==> - ={x} /\ RO.m{1} = RO.m{2}.[x{2}<-(result{2}, Unknown)] /\ - RO.m{2}.[x{2}] = Some(result{2}, Known)). - + move=>?&mr[*]-> ->??;exists RO.m{mr},x{mr}=>/#. - + move=>?&m?[2*]-> -> <- ->_. - by rewrite in_dom getP_eq oget_some set_set set_eq. - + seq 1 1:(={work,x,RO.m});[by sim|symmetry]. - eager while (H:r<$sampleto x; ~ r<$sampleto x; : ={x} ==> ={r})=>//;1,3:by sim. - swap{1}2-1;sp 1 1. - if{2};[rcondt{1}2|rcondf{1}2];1,3,4:by auto. - by rnd{2};wp;case ((x0 = x){1});[rnd{1}|];auto=>??[*]-> -> -> -> ->_ _ _->; - rewrite sampleto_ll. - alias{1} 1 cx = (oget RO.m.[x]).`1. - while (={work,x,r} /\ mem (dom RO.m{1}) x{1} /\ (RO.m.[x]=Some(r,Known)){2}/\ - RO.m{1} = (RO.m.[x<-(if mem work x then cx{1} else r, Unknown)]){2}). - + sp 1 1;case ((x0 = x){1}). - + rcondt{1} 1. by auto;progress;rewrite getP_eq oget_some;case (mem _ _). - rcondf{2} 1. by auto=> @/in_dom_with;progress;rewrite H0. - auto=> ??[*]_-> -> -> ->?-> ->?_<-/=;rewrite sampleto_ll=>c _. - by rewrite dom_set !inE /= set_set. - if=>//. auto;progress[-split]. by rewrite /in_dom_with dom_set getP !inE H3. - + auto;progress [-split];split=>// _. - by rewrite dom_set !inE H/= getP set_set (eq_sym x{2}) H3 H0. - by auto;progress;rewrite !inE (eq_sym x{2}) H3. - auto;progress [-split];rewrite H1 /=. - rewrite dom_set fsetUC subset_fsetU_id /=. - + by move=> x;rewrite inE. - rewrite H getP_eq /= set_set /= set_eq. - + by rewrite {1}get_oget // -H0;case (oget _). - by move=> ????-> ->/=[*];rewrite !inE oget_some. - inline *;swap{1} 3 -2. - admit. -(* - (* Admit *) - while (={work,x,r} /\ (RO.m.[x]=None){1} /\ - RO.m{2} = RO.m{1}.[x{2}<-(r{2},Known)] /\ - !mem work{2} x{2}). - + wp;sp 1 1;if. auto=> ??[*]-> -> -> Hex Hmem Heq Hx _ /= ?->/=. - rewrite !inE Hmem !getP Heq /=. - cut ^Hd->/=: x{2} <> pick work{2} by smt ml=0 w=mem_pick. - by rewrite Hex set_set Hd. - auto=>??/=[*]-> -> _ ^Hdom;rewrite in_dom=>/=Hnone?->;rewrite restr_set_diff//=. - by rewrite Hnone /= restr_dom Hdom=>????-> ->[*];rewrite in_dom getP_eq. *) + + call (iter_perm ERO.I iter_perm2). + skip=> &1 &2 [[->> ->>]] [Hdom Hm];progress. + by apply /perm_to_rem/restr_dom;rewrite Hdom Hm. + inline *;rcondt{1} 2;1:by auto. + while (={x,l} /\ !mem l{1} x{1}/\ + eq_except RO.m{1} RO.m{2} (fset1 x{1}) /\ + RO.m{1}.[x{2}] = Some (result{2}, Unknown) /\ + RO.m{2}.[x{2}] = Some (result{2}, Known)). + + auto=> ?&mr[*]2!->Hm Hex Hm1 Hmr Hneq _/=?->. + rewrite (contra _ _ (mem_drop _ 1 _) Hm) /=. + rewrite!getP;move:Hm;rewrite-(mem_head_behead witness l{mr})//negb_or=>-[]->_. + by rewrite Hm1 Hmr/=;apply eq_except_set. + auto=>?&mr[[->>->>]][]Hdom Hm /=/=?->/=. + rewrite !drop0 restr_set /= dom_rem /= -memE !inE /=. + by rewrite !getP_eq /= oget_some/= set2_eq_except. + inline *. swap{1}3-2. + while (={l,x} /\ !mem l{1} x{1} /\ RO.m{1}.[x{1}] = None /\ + RO.m{2} = RO.m{1}.[x{2}<-(r{2},Known)]). + + auto=> ?&mr[*]2!->Hm Hn Heq Hl _/=?->. + rewrite (contra _ _ (mem_drop _ 1 _) Hm) /=. + rewrite set_set -Heq !getP -(eq_sym (x{mr})). + by move:Hm;rewrite -(mem_head_behead witness l{mr} Hl) -Hn negb_or=>-[]->. + auto=> ?&mr[*]2!->_ Hnm/=?->. + rewrite -memE restr_set_neq //= restr_dom Hnm /=. + by have:=Hnm;rewrite in_dom/==>->/=????->->;rewrite in_dom getP_eq oget_some. qed. - -search "_.[_<-_]". - search - auto=> ??/=[*]-> -> _ Hmem/=?->/=;rewrite restr_set_diff //=. - rewrite eq_except_sym set_eq_except restr_dom Hmem getP_eq=>????->_ [*]. - rewrite Hmem. - - get_eq. - - transitivity{2} { - -=>-[->//|/#]. - - - {1}(get_oget m_R x{2}). -print get_oget. -search "_.[_]" "_.[_<-_]". -print restrK. - - -smt. - H /=;smt. - case ((!mem work x){1}). - + swap{1} 2 -1;while (={work,x} /\ eq_except RO.m{1} RO.m{2} (fset1 x{1}) /\ - (!mem work x){1} /\ (RO.m.[x] = Some rd){2} /\ (!mem (dom RO.m) x){1}). - + inline *;auto;progress [-split]. - cut -> : mem (dom RO.m{2}) (pick work{2}) = mem (dom RO.m{1}) (pick work{2}) by rewrite !in_dom;smt. - smt. - auto;progress [-split];rewrite !getP_eq;smt. - inline RO.f. - transitivity{1} { rd <$ sample x; - while (work <> fset0) { - x0 <- pick work; - rd0 <$ sample x0; - if (!mem (dom RO.m) x0) - RO.m.[x0] <- if x0 = x then rd else rd0; - work <- work `\` fset1 (pick work); - } } - (={x,work,RO.m} ==> ={x,RO.m}) - ((={x,work,RO.m} /\ mem work{1} x{1}) /\ ! mem (dom RO.m{2}) x{2} ==> - ={x,RO.m} /\ (result = oget RO.m.[x]){2} /\ mem (dom RO.m{1}) x{1}) => //. - + by move=> &1 &2 H; exists RO.m{2}, x{2}, work{2}; move: H. - + transitivity{1} { while (work <> fset0) { - x0 <- pick work; - rd0 <$ sample x0; - if (!mem (dom RO.m) x0) RO.m.[x0] <- rd0; - work <- work `\` fset1 (pick work); +lemma eager_set : + eager [ERO.resample(); , RO.set ~ ERO.set, ERO.resample(); : + ={x,y} /\ ={RO.m} ==> ={res,RO.m} ]. +proof. + eager proc. + case ((mem (dom RO.m) x /\ (oget RO.m.[x]).`2 = Unknown){1}). + inline{1} ERO.resample=>/=;wp 1 2. + transitivity{1} { Iter(ERO.I).iter(x::elems ((dom (restr Unknown RO.m)) `\` fset1 x)); } - rd <$ sample x; } - (={x,work,RO.m} ==> ={x,RO.m}) - (={x,work,RO.m} ==> ={x,RO.m})=> //. - + by move=> &1 &2 H; exists RO.m{2}, x{2}, work{2}; move: H. - + by sim; rnd{2}; sim : (={x,IND_Eager.H.m}); smt. - symmetry; eager while (H: rd <$ sample x; ~ rd <$ sample x; : ={x} ==> ={rd})=> //; sim. - swap{2} 5 -4; swap [2..3] -1; case ((x = pick work){1}). - + by wp; rnd{2}; rnd; rnd{1}; wp; skip; smt. - by auto; smt. - + while (={x, work} /\ - (!mem work x => mem (dom RO.m) x){1} /\ - RO.m.[x]{2} = Some rd{1} /\ - if (mem (dom RO.m) x){1} then ={RO.m} - else eq_except RO.m{1} RO.m{2} (fset1 x{1})). - + auto;progress; 1..9,12:smt. - + case ((pick work = x){2})=> pick_x; last smt. - subst x{2}; move: H7 H1; rewrite -neqF /eq_except=> -> /= eq_exc. - by apply fmapP=> x0; case (pick work{2} = x0); smt. - by auto; smt. - by auto;progress [-split];rewrite H0 /= getP_eq;smt. - - - - - - - - - - - - - - module IND_S(D:Distinguisher) = { - proc main(): bool = { - var b; - RO.init(); - b <@ D(RO).distinguish(); - ERO.sample(); - return b; - } - }. - - section EAGER. - - local lemma eager_query: - eager [ERO.sample(); , RO.f ~ ERO.f, ERO.sample(); : - ={x,RO.m} ==> ={res,RO.m} ]. - proof. - eager proc. - inline ERO.sample;swap{2} 4 -3. - seq 1 1: (={x,work,RO.m});first by sim. - wp;case ((mem (dom RO.m) x){1}). - + rnd{1}. - alias{1} 1 mx = oget RO.m.[x]. - while (={work,RO.m} /\ (RO.m.[x] = Some mx){1}). - + by inline *;auto;progress;smt. - auto;progress [- split]; rewrite sample_ll H /=;smt. - case ((!mem work x){1}). - + swap{1} 2 -1;while (={work,x} /\ eq_except RO.m{1} RO.m{2} (fset1 x{1}) /\ - (!mem work x){1} /\ (RO.m.[x] = Some rd){2} /\ (!mem (dom RO.m) x){1}). - + inline *;auto;progress [-split]. - cut -> : mem (dom RO.m{2}) (pick work{2}) = mem (dom RO.m{1}) (pick work{2}) by rewrite !in_dom;smt. - smt. - auto;progress [-split];rewrite !getP_eq;smt. - inline RO.f. - transitivity{1} { rd <$ sample x; - while (work <> fset0) { - x0 <- pick work; - rd0 <$ sample x0; - if (!mem (dom RO.m) x0) - RO.m.[x0] <- if x0 = x then rd else rd0; - work <- work `\` fset1 (pick work); - } } - (={x,work,RO.m} ==> ={x,RO.m}) - ((={x,work,RO.m} /\ mem work{1} x{1}) /\ ! mem (dom RO.m{2}) x{2} ==> - ={x,RO.m} /\ (result = oget RO.m.[x]){2} /\ mem (dom RO.m{1}) x{1}) => //. - + by move=> &1 &2 H; exists RO.m{2}, x{2}, work{2}; move: H. - + transitivity{1} { while (work <> fset0) { - x0 <- pick work; - rd0 <$ sample x0; - if (!mem (dom RO.m) x0) RO.m.[x0] <- rd0; - work <- work `\` fset1 (pick work); - } - rd <$ sample x; } - (={x,work,RO.m} ==> ={x,RO.m}) - (={x,work,RO.m} ==> ={x,RO.m})=> //. - + by move=> &1 &2 H; exists RO.m{2}, x{2}, work{2}; move: H. - + by sim; rnd{2}; sim : (={x,IND_Eager.H.m}); smt. - symmetry; eager while (H: rd <$ sample x; ~ rd <$ sample x; : ={x} ==> ={rd})=> //; sim. - swap{2} 5 -4; swap [2..3] -1; case ((x = pick work){1}). - + by wp; rnd{2}; rnd; rnd{1}; wp; skip; smt. - by auto; smt. - + while (={x, work} /\ - (!mem work x => mem (dom RO.m) x){1} /\ - RO.m.[x]{2} = Some rd{1} /\ - if (mem (dom RO.m) x){1} then ={RO.m} - else eq_except RO.m{1} RO.m{2} (fset1 x{1})). - + auto;progress; 1..9,12:smt. - + case ((pick work = x){2})=> pick_x; last smt. - subst x{2}; move: H7 H1; rewrite -neqF /eq_except=> -> /= eq_exc. - by apply fmapP=> x0; case (pick work{2} = x0); smt. - by auto; smt. - by auto;progress [-split];rewrite H0 /= getP_eq;smt. - qed. - - equiv Eager_S (D <: Distinguisher{RO}): IND_S(D).main ~ IND(ERO,D).main: ={glob D} ==> ={res,RO.m,glob D}. - proof. - proc; inline ERO.init RO.init. - seq 1 1: (={glob D, RO.m});first by wp. - symmetry; eager (H: ERO.sample(); ~ ERO.sample();: ={RO.m} ==> ={RO.m}): - (={glob D, RO.m}) => //; first by sim. - eager proc H (={RO.m}) => //; [by apply eager_query | by sim]. - qed. - - equiv Eager (D <: Distinguisher{RO}): IND(RO,D).main ~ IND(ERO,D).main: ={glob D} ==> ={res,glob D}. - proof. - transitivity IND_S(D).main - (={glob D} ==> ={res,glob D}) - (={glob D} ==> ={res,RO.m,glob D}) => //. - + by progress;exists (glob D){2}. - + proc;inline{2} ERO.sample. - while{2} true (card work{2}). - + move=> &m1 z;wp;call (f_ll sample_ll);auto;smt. - conseq (_: _ ==> ={b,glob D}) => //;[smt | by sim]. - apply (Eager_S D). - qed. - - end section EAGER. - -end GenIdeal. - - - - - - - - - - - - - - - -abstract theory - - -module type SAMPLE = { - proc sampleI(h:handle) : unit - proc setD(h:handle, c:capacity) : unit - proc get(h:handle) : capacity - proc in_dom(h:handle,c:caller) : bool - proc restrD() : (handle,capacity)fmap -}. - -module type ADV_SAMPLEH(O:SAMPLE) = { - proc main() : bool -}. - - - -module Esample = { - var handles : (handle, ccapacity)fmap + (={x,y,RO.m} /\ mem (dom RO.m{1}) x{1} /\ (oget RO.m{1}.[x{1}]).`2 = Unknown ==> + ={x,y,RO.m}) + (={x,y,RO.m} /\ mem (dom RO.m{1}) x{1} /\ (oget RO.m{1}.[x{1}]).`2 = Unknown==> + ={x,y} /\ eq_except RO.m{1} RO.m{2} (fset1 x{1}) /\ + RO.m{2}.[x{2}] = Some (y{2},Known)). + + by move=>?&mr[*]-> -> ???;exists RO.m{mr}, y{mr}, x{mr}=>/#. + + move=>??? [*]<*>[*]-> -> Hex Hm2. + by rewrite (eq_except_set_eq RO.m{2} RO.m{m} x{2}) ?in_dom ?Hm2// eq_except_sym. + + call (iter_perm ERO.I iter_perm2). + skip=>?&mr[][]->>[]->>->>[]Hdom Hm/=. + by apply /perm_to_rem/restr_dom;rewrite Hdom Hm. + inline *;rcondt{1} 2;1:by auto. + while (={x,l} /\ !mem l{1} x{1}/\ + eq_except RO.m{1} RO.m{2} (fset1 x{1}) /\ + RO.m{2}.[x{2}] = Some (y{2}, Known)). + + auto=> ?&mr[*]2!->Hm Hex Hm1 Hmr _/=?->. + rewrite (contra _ _ (mem_drop _ 1 _) Hm) /=. + rewrite!getP;move:Hm;rewrite-(mem_head_behead witness l{mr})//negb_or=>-[]->_. + by rewrite Hm1 /=;apply eq_except_set. + auto=>?&mr[*]3!<*>Hdom Hm /=/=;rewrite !drop0 sampleto_ll=>/=?_. + by rewrite -memE restr_set /= dom_rem !inE !getP_eq set2_eq_except. + inline *;wp. + while (={x,l} /\ !mem l{1} x{1}/\ + eq_except RO.m{1} RO.m{2} (fset1 x{1}) /\ + RO.m{2}.[x{2}] = Some (y{2}, Known)). + + auto=> ?&mr[*]2!->Hm Hex Hm1 Hmr _/=?->. + rewrite (contra _ _ (mem_drop _ 1 _) Hm) /=. + rewrite!getP;move:Hm;rewrite-(mem_head_behead witness l{mr})//negb_or=>-[]->_. + by rewrite Hm1 /=;apply eq_except_set. + auto=> ?&mr[*]3!-> Hnm /=. + rewrite-memE restr_set/=rem_id?restr_dom//=Hnm. + rewrite getP_eq eq_except_sym set_eq_except/=. + move=>/=????2!->/=[]/eq_except_sym? Hx2;apply/eq_sym. + have/(congr1 oget):=Hx2=><-;apply eq_except_set_eq=>//;by rewrite in_dom Hx2. +qed. - proc sampleI(h:handle) = { - var c; - c <$ cdistr; - handles.[h] <- (c,I); - } +lemma eager_in_dom: + eager [ERO.resample(); , RO.in_dom ~ ERO.in_dom, ERO.resample(); : + ={x,f} /\ ={RO.m} ==> ={res,RO.m} ]. +proof. + eager proc;inline *;wp. + while (={l,RO.m} /\ (forall z, mem l z => in_dom_with RO.m z Unknown){1} /\ + in_dom_with RO.m{1} x{1} f{1} = result{2}). + + auto=>?&mr[*]2!->Hz <-?_/=?->/=. + by split=>[z Hm|];rewrite /in_dom_with dom_set getP !inE/#. + by auto=>?&mr/=[*]3!->/=;split=>// z;rewrite -memE restr_dom. +qed. - proc setD (h:handle, c:capacity) = { - handles.[h] <- (c,D); - } +lemma eager_restrK: + eager [ERO.resample(); , RO.restrK ~ ERO.restrK, ERO.resample(); : + ={RO.m} ==> ={res,RO.m} ]. +proof. + eager proc;inline *;wp. + while (={l,RO.m} /\ (forall z, mem l z => in_dom_with RO.m z Unknown){1} /\ + restr Known RO.m{1} = result{2}). + + auto=>?&mr[*]2!->Hz<-?_/=?->/=. + split=>[z Hm|];1:by rewrite /in_dom_with dom_set getP !inE/#. + rewrite restr_set rem_id?restr_dom//. + by move:H=>/(mem_head_behead witness) /(_ (head witness l{mr})) /= /Hz /#. + by auto=>?&mr/=->/=;split=>// z;rewrite -memE restr_dom. +qed. - proc in_dom(h:handle, c:caller) = { - return in_dom_with handles h c; - } +lemma eager_sample: + eager [ERO.resample(); , RO.sample ~ ERO.sample, ERO.resample(); : + ={x,RO.m} ==> ={res,RO.m} ]. +proof. + eager proc. + transitivity{2} { + c <$ sampleto x; RO.m.[x] <- (c, Unknown); + Iter(ERO.I).iter(x::elems ((dom (restr Unknown RO.m)) `\` fset1 x));} + (={x,RO.m} ==> ={x,RO.m}) + (={x,RO.m} ==> ={x,RO.m})=>//;last first. + + inline{2} ERO.resample;call (iter_perm ERO.I iter_perm2);auto=>?&mr[]->->/=?->. + by rewrite !restr_set/= !dom_set perm_eq_sym perm_to_rem !inE. + + by move=>?&mr[*]2!->;exists RO.m{mr}, x{mr}. + inline ERO.resample;inline{2}*;rcondt{2}4;1:by auto. + wp;case ((!mem (dom RO.m) x \/ (oget RO.m.[x]).`2=Known){1}). + + inline *;swap{1}3-1. + while (={x,l} /\ RO.m{1}.[x{1} <- (c{1}, Unknown)] = RO.m{2} /\ !(mem l x){1}). + + auto=>?&mr[*]2!-><- Hnm Hl _/=?->. + rewrite (contra _ _ (mem_drop _ 1 _) Hnm) /= set_set. + by move:Hnm;rewrite-(mem_head_behead witness l{mr})//negb_or eq_sym=>-[]->. + auto=>?&mr[*]2!->?/=;rewrite sampleto_ll=>?_?->;rewrite drop0. + rewrite restr_set/= dom_set fsetDK. + cut<-/=:dom (restr Unknown RO.m{mr}) = + dom (restr Unknown RO.m{mr}) `\` fset1 x{mr}. + + apply fsetP=>z;rewrite !(restr_dom,inE)/#. + by rewrite set_set/= -memE restr_dom;split=>/#. + transitivity{1} { + Iter(ERO.I).iter(x::elems ((dom (restr Unknown RO.m)) `\` fset1 x)); + c<$ sampleto x;} + (={x,RO.m} /\ (mem (dom RO.m) x /\ (oget RO.m.[x]).`2=Unknown){1} ==> ={x,c,RO.m}) + (={x,RO.m} /\ (mem (dom RO.m) x /\ (oget RO.m.[x]).`2=Unknown){1} ==> + ={x} /\ RO.m{1}.[x{1} <- (c{1}, Unknown)] = RO.m{2})=>//. + + by move=>?&mr[*]2!->?;exists RO.m{mr}, x{mr}=>/#. + + rnd;call (iter_perm ERO.I iter_perm2);auto=>?&mr[*]->->/=??;split=>//. + by rewrite perm_to_rem restr_dom. + inline *;rcondt{1}2;1:by auto. + swap{1} 7-2. + while (={x,l} /\ RO.m{1}.[x{1} <- (c{1}, Unknown)] = RO.m{2} /\ !(mem l x){1}). + + auto=>?&mr[*]2!-><- Hnm Hl _/=?->. + rewrite (contra _ _ (mem_drop _ 1 _) Hnm) /= set_set. + by move:Hnm;rewrite-(mem_head_behead witness l{mr})//negb_or eq_sym=>-[]->. + by auto=>?&mr[*]2!->??/=?->?->;rewrite!drop0 restr_set/=dom_set fsetDK-memE!inE. +qed. - proc restrD() = { - return ( - let m = NewFMap.filter (fun _ (p:ccapacity) => p.`2=D) handles in - NewFMap.map (fun _ (p:ccapacity) => p.`1) m); - } +module Eager (D:Distinguisher) = { - proc get(h:handle) = { - var c; - c <$ cdistr; - if (!mem (dom handles) h || (oget handles.[h]).`2 = I) { - handles.[h] <- (c,D); - } - return (oget (handles.[h])).`1; + proc main1() = { + var b; + RO.init(); + b <@ D(RO).distinguish(); + return b; } -}. - - - - - - - - -type from, to. - -module type RO = { - proc init() : unit - proc f(x : from): to -}. - -module type Distinguisher(G : RO) = { - proc distinguish(): bool {G.f} -}. - -module IND(G:RO, D:Distinguisher) = { - proc main(): bool = { + proc main2() = { var b; - - G.init(); - b <@ D(G).distinguish(); + ERO.init(); + b <@ D(ERO).distinguish(); + ERO.resample(); return b; - } -}. - -abstract theory Ideal. - - op sample : from -> to distr. - - module RO = { - var m : (from, to) fmap - - proc init() : unit = { - m <- map0; - } - - proc f(x : from) : to = { - var rd; - rd <$ sample x; - if (! mem (dom m) x) m.[x] <- rd; - return oget m.[x]; - } - }. - - section LL. - - axiom sample_ll : forall x, Distr.weight (sample x) = 1%r. - - lemma f_ll : phoare[RO.f : true ==> true] = 1%r. - proof. proc;auto;progress;apply sample_ll. qed. - - end section LL. - -end Ideal. - - -abstract theory GenIdeal. - - clone include Ideal. - axiom sample_ll : forall x, Distr.weight (sample x) = 1%r. - - op RO_dom : from fset. + } - module ERO = { - proc sample() = { - var work; - work <- RO_dom; - while (work <> fset0) { - RO.f(pick work); - work = work `\` fset1 (pick work); - } - } +}. - proc init() = { - RO.m <- map0; - sample(); - } +equiv Eager_1_2 (D<:Distinguisher{RO}) : Eager(D).main1 ~ Eager(D).main2 : + ={glob D} ==> ={res,glob RO, glob D}. +proof. + proc. + transitivity{1} + { RO.init(); + ERO.resample(); + b <@ D(RO).distinguish(); } + (={glob D} ==> ={b,RO.m,glob D}) + (={glob D} ==> ={b,RO.m,glob D})=> //. + + by move=> ?&mr->;exists (glob D){mr}. + + inline *;rcondf{2}3;2:by sim. + by auto=>?;rewrite restr0 dom0 elems_fset0. + seq 1 1: (={glob D, RO.m});1:by inline *;auto. + eager (H: ERO.resample(); ~ ERO.resample();: ={RO.m} ==> ={RO.m}): + (={glob D, RO.m}) => //;1:by sim. + eager proc H (={RO.m}) => //;try sim. + + by apply eager_init. + by apply eager_get. + by apply eager_set. + + by apply eager_sample. + by apply eager_in_dom. + by apply eager_restrK. +qed. - proc f = RO.f - }. - - module IND_S(D:Distinguisher) = { - proc main(): bool = { - var b; - RO.init(); - b <@ D(RO).distinguish(); - ERO.sample(); - return b; - } - }. - - section EAGER. - - local lemma eager_query: - eager [ERO.sample(); , RO.f ~ ERO.f, ERO.sample(); : - ={x,RO.m} ==> ={res,RO.m} ]. - proof. - eager proc. - inline ERO.sample;swap{2} 4 -3. - seq 1 1: (={x,work,RO.m});first by sim. - wp;case ((mem (dom RO.m) x){1}). - + rnd{1}. - alias{1} 1 mx = oget RO.m.[x]. - while (={work,RO.m} /\ (RO.m.[x] = Some mx){1}). - + by inline *;auto;progress;smt. - auto;progress [- split]; rewrite sample_ll H /=;smt. - case ((!mem work x){1}). - + swap{1} 2 -1;while (={work,x} /\ eq_except RO.m{1} RO.m{2} (fset1 x{1}) /\ - (!mem work x){1} /\ (RO.m.[x] = Some rd){2} /\ (!mem (dom RO.m) x){1}). - + inline *;auto;progress [-split]. - cut -> : mem (dom RO.m{2}) (pick work{2}) = mem (dom RO.m{1}) (pick work{2}) by rewrite !in_dom;smt. - smt. - auto;progress [-split];rewrite !getP_eq;smt. - inline RO.f. - transitivity{1} { rd <$ sample x; - while (work <> fset0) { - x0 <- pick work; - rd0 <$ sample x0; - if (!mem (dom RO.m) x0) - RO.m.[x0] <- if x0 = x then rd else rd0; - work <- work `\` fset1 (pick work); - } } - (={x,work,RO.m} ==> ={x,RO.m}) - ((={x,work,RO.m} /\ mem work{1} x{1}) /\ ! mem (dom RO.m{2}) x{2} ==> - ={x,RO.m} /\ (result = oget RO.m.[x]){2} /\ mem (dom RO.m{1}) x{1}) => //. - + by move=> &1 &2 H; exists RO.m{2}, x{2}, work{2}; move: H. - + transitivity{1} { while (work <> fset0) { - x0 <- pick work; - rd0 <$ sample x0; - if (!mem (dom RO.m) x0) RO.m.[x0] <- rd0; - work <- work `\` fset1 (pick work); - } - rd <$ sample x; } - (={x,work,RO.m} ==> ={x,RO.m}) - (={x,work,RO.m} ==> ={x,RO.m})=> //. - + by move=> &1 &2 H; exists RO.m{2}, x{2}, work{2}; move: H. - + by sim; rnd{2}; sim : (={x,IND_Eager.H.m}); smt. - symmetry; eager while (H: rd <$ sample x; ~ rd <$ sample x; : ={x} ==> ={rd})=> //; sim. - swap{2} 5 -4; swap [2..3] -1; case ((x = pick work){1}). - + by wp; rnd{2}; rnd; rnd{1}; wp; skip; smt. - by auto; smt. - + while (={x, work} /\ - (!mem work x => mem (dom RO.m) x){1} /\ - RO.m.[x]{2} = Some rd{1} /\ - if (mem (dom RO.m) x){1} then ={RO.m} - else eq_except RO.m{1} RO.m{2} (fset1 x{1})). - + auto;progress; 1..9,12:smt. - + case ((pick work = x){2})=> pick_x; last smt. - subst x{2}; move: H7 H1; rewrite -neqF /eq_except=> -> /= eq_exc. - by apply fmapP=> x0; case (pick work{2} = x0); smt. - by auto; smt. - by auto;progress [-split];rewrite H0 /= getP_eq;smt. - qed. - - equiv Eager_S (D <: Distinguisher{RO}): IND_S(D).main ~ IND(ERO,D).main: ={glob D} ==> ={res,RO.m,glob D}. - proof. - proc; inline ERO.init RO.init. - seq 1 1: (={glob D, RO.m});first by wp. - symmetry; eager (H: ERO.sample(); ~ ERO.sample();: ={RO.m} ==> ={RO.m}): - (={glob D, RO.m}) => //; first by sim. - eager proc H (={RO.m}) => //; [by apply eager_query | by sim]. - qed. - - equiv Eager (D <: Distinguisher{RO}): IND(RO,D).main ~ IND(ERO,D).main: ={glob D} ==> ={res,glob D}. - proof. - transitivity IND_S(D).main - (={glob D} ==> ={res,glob D}) - (={glob D} ==> ={res,RO.m,glob D}) => //. - + by progress;exists (glob D){2}. - + proc;inline{2} ERO.sample. - while{2} true (card work{2}). - + move=> &m1 z;wp;call (f_ll sample_ll);auto;smt. - conseq (_: _ ==> ={b,glob D}) => //;[smt | by sim]. - apply (Eager_S D). - qed. - - end section EAGER. - -end GenIdeal. - -abstract theory FiniteIdeal. - - clone include Ideal. - axiom sample_ll (x : from): Distr.weight (sample x) = 1%r. - - op univ : from fset. - axiom univP (x:from) : mem univ x. - - module ERO = { - proc sample() = { - var work; - work <- univ; - while (work <> fset0) { - RO.f(pick work); - work = work `\` fset1 (pick work); - } - } - - proc init() = { - RO.m <- map0; - sample(); - } - - proc f(x:from):to = { return oget RO.m.[x]; } - }. - - module IND_S(D:Distinguisher) = { - proc main(): bool = { - var b; - RO.init(); - b <@ D(RO).distinguish(); - ERO.sample(); - return b; - } - }. - - section EAGER. - - declare module D: Distinguisher { RO }. - - local clone GenIdeal as GI with - op sample <- sample, - op RO_dom <- univ - proof sample_ll by apply sample_ll. - - local equiv ERO_main: - IND(GI.ERO, D).main ~ IND(ERO, D).main : ={glob D} ==> ={res, glob D} /\ GI.RO.m{1} = RO.m{2}. - proof. - proc. - call (_:GI.RO.m{1} = RO.m{2} /\ dom RO.m{2} = univ). - + proc; rcondf{1} 2;auto;progress;[ by rewrite H univP | by apply sample_ll]. - inline *. - while (={work} /\ GI.RO.m{1} = RO.m{2} /\ dom RO.m{2} = univ `\` work{2});auto;smt. - qed. - - equiv Eager_S : IND_S(D).main ~ IND(ERO,D).main: ={glob D} ==> ={res,RO.m,glob D}. - proof. - transitivity GI.IND_S(D).main - (={glob D} ==> ={res,glob D} /\ RO.m{1} = GI.RO.m{2}) - (={glob D} ==> ={res,glob D} /\ GI.RO.m{1} = RO.m{2}) => //. - + by progress;exists (glob D){2}. - + by sim. - transitivity IND(GI.ERO,D).main - (={glob D} ==> ={res,glob D, GI.RO.m}) - (={glob D} ==> ={res,glob D} /\ GI.RO.m{1} = RO.m{2}) => //. - + by progress;exists (glob D){2}. - + by conseq (GI.Eager_S D). - by apply ERO_main. - qed. - - equiv Eager : IND(RO, D).main ~ IND(ERO,D).main: ={glob D} ==> ={res,glob D}. - proof. - transitivity IND(GI.RO,D).main - (={glob D} ==> ={res,glob D} /\ RO.m{1} = GI.RO.m{2}) - (={glob D} ==> ={res,glob D}) => //. - + by progress;exists (glob D){2}. - + by sim. - transitivity IND(GI.ERO,D).main - (={glob D} ==> ={res,glob D}) - (={glob D} ==> ={res,glob D}) => //. - + by progress;exists (glob D){2}. - + by conseq (GI.Eager D). - by conseq ERO_main. - qed. - - end section EAGER. - -end FiniteIdeal. - - -abstract theory RestrIdeal. - - clone include Ideal. - axiom sample_ll (x : from): Distr.weight (sample x) = 1%r. - - op test : from -> bool. - op univ : from fset. - op dfl : to. - - axiom testP x : test x <=> mem univ x. - - module Restr (O:RO) = { - proc init = RO.init - proc f (x:from) : to = { - var r <- dfl; - if (test x) r <@ RO.f(x); - return r; - } - }. - - module ERO = { - proc sample() = { - var work; - work <- univ; - while (work <> fset0) { - RO.f(pick work); - work = work `\` fset1 (pick work); - } - } - - proc init() = { - RO.m <- map0; - sample(); - } - - proc f(x:from):to = { - return (if test x then oget RO.m.[x] else dfl); - } - }. - - module IND_S(D:Distinguisher) = { - proc main(): bool = { - var b; - RO.init(); - b <@ D(Restr(RO)).distinguish(); - ERO.sample(); - return b; - } - }. - - section EAGER. - - declare module D: Distinguisher { RO }. - - local clone GenIdeal as GI with - op sample <- sample, - op RO_dom <- univ. - - local module Restr' (O:RO) = { - proc init() = { } - proc f(x:from) = { - var r <- dfl; - if (test x) r <@ O.f(x); - return r; - } - }. - - local module RD (O:RO) = D(Restr'(O)). - - local equiv ERO_main: - IND(GI.ERO, RD).main ~ IND(ERO, D).main : ={glob D} ==> ={res, glob D} /\ GI.RO.m{1} = RO.m{2}. - proof. - proc. - call (_:GI.RO.m{1} = RO.m{2} /\ dom RO.m{2} = univ). - + proc. - case (test x{1});[ rcondt{1} 2 | rcondf{1} 2];auto;last smt ml=0. - by inline *;rcondf{1} 4;auto;progress;2:(by apply sample_ll);rewrite ?H0 ?H -?testP. - inline *. - while (={work} /\ GI.RO.m{1} = RO.m{2} /\ dom RO.m{2} `|` work{2} = univ);auto;1:progress; smt. - qed. - - equiv Eager_S : IND_S(D).main ~ IND(ERO,D).main: ={glob D} ==> ={res,RO.m,glob D}. - proof. - transitivity GI.IND_S(RD).main - (={glob D} ==> ={res,glob D} /\ RO.m{1} = GI.RO.m{2}) - (={glob D} ==> ={res,glob D} /\ GI.RO.m{1} = RO.m{2}) => //. - + by progress;exists (glob D){2}. - + by sim. - transitivity IND(GI.ERO,RD).main - (={glob D} ==> ={res,glob D, GI.RO.m}) - (={glob D} ==> ={res,glob D} /\ GI.RO.m{1} = RO.m{2}) => //. - + by progress;exists (glob D){2}. - + by conseq (GI.Eager_S RD). - by apply ERO_main. - qed. - - equiv Eager : IND(Restr(RO), D).main ~ IND(ERO,D).main: ={glob D} ==> ={res,glob D}. - proof. - transitivity IND(GI.RO,RD).main - (={glob D} ==> ={res,glob D} /\ RO.m{1} = GI.RO.m{2}) - (={glob D} ==> ={res,glob D}) => //. - + by progress;exists (glob D){2}. - + by sim. - transitivity IND(GI.ERO,RD).main - (={glob D} ==> ={res,glob D}) - (={glob D} ==> ={res,glob D}) => //. - + by progress;exists (glob D){2}. - + by conseq (GI.Eager RD). - by conseq ERO_main. - qed. - - end section EAGER. - -end RestrIdeal. \ No newline at end of file +end GenEager. From b9fc6e54ac71aa8f17813868d6754d67d65e3596 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Tue, 15 Dec 2015 08:43:59 +0100 Subject: [PATCH 090/525] small improvement --- proof/old/MyRO.ec | 29 +++++++++++++++++++---------- 1 file changed, 19 insertions(+), 10 deletions(-) diff --git a/proof/old/MyRO.ec b/proof/old/MyRO.ec index 56f8be7..8da2d87 100644 --- a/proof/old/MyRO.ec +++ b/proof/old/MyRO.ec @@ -520,6 +520,21 @@ proof. by auto=>?&mr[*]2!->??/=?->?->;rewrite!drop0 restr_set/=dom_set fsetDK-memE!inE. qed. +section. + +declare module D:Distinguisher {RO}. + +lemma eager_D : eager [ERO.resample(); , D(RO).distinguish ~ + D(ERO).distinguish, ERO.resample(); : + ={glob D,RO.m} ==> ={RO.m, glob D} /\ ={res} ]. +proof. + eager proc (H_: ERO.resample(); ~ ERO.resample();: ={RO.m} ==> ={RO.m}) + (={RO.m})=>//; try by sim. + + by apply eager_init. + by apply eager_get. + by apply eager_set. + + by apply eager_sample. + by apply eager_in_dom. + by apply eager_restrK. +qed. + + module Eager (D:Distinguisher) = { proc main1() = { @@ -531,7 +546,7 @@ module Eager (D:Distinguisher) = { proc main2() = { var b; - ERO.init(); + RO.init(); b <@ D(ERO).distinguish(); ERO.resample(); return b; @@ -539,25 +554,19 @@ module Eager (D:Distinguisher) = { }. -equiv Eager_1_2 (D<:Distinguisher{RO}) : Eager(D).main1 ~ Eager(D).main2 : +equiv Eager_1_2: Eager(D).main1 ~ Eager(D).main2 : ={glob D} ==> ={res,glob RO, glob D}. proof. proc. transitivity{1} - { RO.init(); - ERO.resample(); - b <@ D(RO).distinguish(); } + { RO.init(); ERO.resample(); b <@ D(RO).distinguish(); } (={glob D} ==> ={b,RO.m,glob D}) (={glob D} ==> ={b,RO.m,glob D})=> //. + by move=> ?&mr->;exists (glob D){mr}. + inline *;rcondf{2}3;2:by sim. by auto=>?;rewrite restr0 dom0 elems_fset0. seq 1 1: (={glob D, RO.m});1:by inline *;auto. - eager (H: ERO.resample(); ~ ERO.resample();: ={RO.m} ==> ={RO.m}): - (={glob D, RO.m}) => //;1:by sim. - eager proc H (={RO.m}) => //;try sim. - + by apply eager_init. + by apply eager_get. + by apply eager_set. - + by apply eager_sample. + by apply eager_in_dom. + by apply eager_restrK. + by eager call eager_D. qed. end GenEager. From e512d393bc47965940585a78273a29aa6e37eb60 Mon Sep 17 00:00:00 2001 From: Pierre-Yves Strub Date: Tue, 15 Dec 2015 12:44:07 +0100 Subject: [PATCH 091/525] Clearing proofs that have been pushed in the stdlib. --- proof/Common.ec | 4 ++++ proof/Temp.ec | 56 ------------------------------------------------- 2 files changed, 4 insertions(+), 56 deletions(-) diff --git a/proof/Common.ec b/proof/Common.ec index 6b3d84c..3b0e1f0 100644 --- a/proof/Common.ec +++ b/proof/Common.ec @@ -106,6 +106,10 @@ proof. by apply/BitChunking.in_chunk_size/gt0_r. qed. lemma chunkK bs : r %| size bs => flatten (chunk bs) = bs. proof. by apply/BitChunking.chunkK/gt0_r. qed. +lemma chunk_cat (xs ys : bool list) : + r %| size xs => chunk (xs ++ ys) = chunk xs ++ chunk ys. +proof. by apply/BitChunking.chunk_cat/gt0_r. qed. + lemma padK : pcancel pad unpad. proof. move=> s @/unpad; rewrite last_pad /= rev_cat rev_mkpad. diff --git a/proof/Temp.ec b/proof/Temp.ec index 0ab3d3b..06449dd 100644 --- a/proof/Temp.ec +++ b/proof/Temp.ec @@ -4,60 +4,4 @@ require import Option Fun Pair Int IntExtra IntDiv Real List NewDistr. require import Ring StdRing StdOrder StdBigop BitEncoding. (*---*) import IntID IntOrder BitChunking. -(* Add to IntDiv? *) - -lemma dvdz_lt (x y z : int) : - 0 < z => z %| x => z %| y => x < y => x + z <= y. -proof. -move=> gt0_z z_dvd_x z_dvd_y. -have -> : x = (x %/ z) * z by rewrite divzK. -have -> : y = (y %/ z) * z by rewrite divzK. -pose u := x %/ z; pose v := y %/ z; move=> u_tim_z_lt_v_tim_z. -have u_lt_v : u < v by rewrite -(@ltr_pmul2r z). -have -> : v = u + (v - u) by ring. -rewrite mulrDl ler_add2l ler_pemull 1:ltrW //. -by rewrite - (@ler_add2r u) - addrA addNr /= lez_add1r. -qed. - -(* Add to BitEncoding? *) - -lemma chunk_cat r (xs ys : 'a list) : - 0 < r => r %| size xs => chunk r (xs ++ ys) = chunk r xs ++ chunk r ys. -proof. -move=> ge0_r r_dvd_siz_xs; rewrite /chunk size_cat divzDl //. -(rewrite mkseq_add; first 2 rewrite divz_ge0 // size_ge0); congr. -apply eq_in_mkseq=> i [ge0_i i_lt_siz_xs_div_r] /=. -have i_tim_r_lt_siz_xs : i * r < size xs - by rewrite ltz_divRL // in i_lt_siz_xs_div_r. -have i_tim_r_add_r_le_siz_xs : i * r + r <= size xs - by rewrite dvdz_lt // dvdz_mull dvdzz. -rewrite mulrC drop_cat i_tim_r_lt_siz_xs /= take_cat. -cut r_le_siz_drop : r <= size (drop (i * r) xs) - by rewrite size_drop 1:divr_ge0 // 1:ltrW // max_ler - ler_subr_addr /= 1:ltrW // addrC. -rewrite ler_eqVlt in r_le_siz_drop. -elim r_le_siz_drop=> [r_eq_siz_drop | -> //]. -rewrite {1 6 8} r_eq_siz_drop /= take0 cats0 take_size //. -apply eq_in_mkseq=> i [ge0_i lt_siz_ys_i] /=. -have -> : r * (size xs %/ r + i) = size xs + r * i - by rewrite mulrDr mulrC divzK. -rewrite drop_cat. -case (size xs + r * i < size xs)=> [/gtr_addl lt0_r_tim_i | _]. -have contrad : 0 <= r * i < 0 by split; [rewrite divr_ge0 1:ltrW |]. -rewrite ler_lt_asym in contrad; elim contrad. -have -> // : size xs + r * i - size xs = r * i by ring. -qed. - -(* Add to Common? *) - -theory ForCommon. - -require import Common. - -lemma chunk_cat (xs ys : 'a list) : - r %| size xs => chunk r (xs ++ ys) = chunk r xs ++ chunk r ys. -proof. -exact /chunk_cat /gt0_r. -qed. - end ForCommon. From 038ace0dafc3e085c7fa1d373373aa005239c9a8 Mon Sep 17 00:00:00 2001 From: Pierre-Yves Strub Date: Tue, 15 Dec 2015 13:41:44 +0100 Subject: [PATCH 092/525] Shrinking unpadK. --- proof/Common.ec | 75 ++++++++++++------------------------------------- 1 file changed, 18 insertions(+), 57 deletions(-) diff --git a/proof/Common.ec b/proof/Common.ec index 3b0e1f0..f34b353 100644 --- a/proof/Common.ec +++ b/proof/Common.ec @@ -3,6 +3,7 @@ require import Option Fun Pair Int IntExtra IntDiv Real List NewDistr. require import Ring StdRing StdOrder StdBigop BitEncoding. require (*--*) FinType BitWord LazyRP Monoid. (*---*) import IntID IntOrder Bigint Bigint.BIA IntDiv Dprod. +require import NewLogic. (* -------------------------------------------------------------------- *) op r : { int | 2 <= r } as ge2_r. @@ -134,68 +135,28 @@ qed. lemma unpadK : ocancel unpad pad. proof. move=> s @/unpad; case: (last false s)=> //=. -elim/last_ind: s=> //= s b ih {ih}; rewrite last_rcons => hb. +elim/last_ind: s=> //= s b ih {ih}; rewrite last_rcons => ->. rewrite rev_rcons /= size_rcons -(inj_eq _ (addIr (-1))) /= ?addrK. pose i := index _ _; case: (i = size s)=> // ne_is @/pad. +have lt_is: i < size s by rewrite ltr_neqAle ne_is -size_rev index_size. have [ge0_i lt_siz_s_i] : 0 <= i < size s. have le_siz_s_i : i <= size s by rewrite /i - size_rev index_size. split=> [| _]; [rewrite index_ge0 | rewrite ltr_neqAle //]. -have -> : size s + 1 - (i + 2) + 2 = size s - i + 1 by ring. -have -> : size s + 1 - (i + 2) = size s - i - 1 by ring. -case: (i = (-(size s - i + 1)) %% r) => [iE | //]. -pose j := size s - i - 1; apply/eq_sym. -rewrite -{1}(cat_take_drop j (rcons s b)) eqseq_cat //=. -rewrite size_take; first rewrite /j subr_ge0. - rewrite - (ler_add2r i) - addrA addNr /= lez_add1r //. -rewrite {2}/j size_rcons ltr_subl_addr ?ltr_spaddr //=. - rewrite ler_add2l - ler_oppl (ler_trans 0) // lerN10. -rewrite -cats1 drop_cat {1}/j ltr_subl_addr ler_lt_add //=. - rewrite ltr_oppl (ltr_le_trans 0) 1:ltrN10 //. -rewrite /mkpad -cats1 -cat_cons hb; congr. -have [ge0_j le_siz_j] : 0 <= j < size s. - rewrite /j; split=> [| _]. - rewrite - (ler_add2r 1) /= - addrA addNr /= - (ler_add2r i) - - addrA addNr /= lez_add1r //. - rewrite - addrA - opprD - (ltr_add2r (i + 1)) - addrA addrN /= - ltz_addl (ler_lt_trans i) // ltz_addl ltr01. -rewrite (drop_nth false) //. -have -> : nth false s j = true - by rewrite /j - addrA - opprD - nth_rev // nth_index // - - index_mem size_rev //. -congr. -have size_drop : size (drop (j + 1) s) = (-(j + 2)) %% r. - rewrite size_drop; 1:rewrite (ler_trans j) //ler_addl ler01. - rewrite max_ler /j. - have -> // : size s - (size s - i - 1 + 1) = i by ring. - have -> : size s - (size s - i - 1 + 1) = i by ring. - have -> : -(size s - i - 1 + 2) = -(size s - i + 1). - ring. rewrite - iE //. -apply (eq_from_nth false). -rewrite size_drop size_nseq. -rewrite max_ler // 1:modz_ge0 gtr_eqF ?gt0_r //. -move=> k [ge0k lt_size_drop_k]; rewrite size_drop in lt_size_drop_k. -rewrite nth_nseq; first split=> // _; rewrite - size_drop //. -rewrite nth_drop // 1:(ler_trans j) // 1:lez_addl 1:ler01. -rewrite /j. -have -> : size s - i - 1 + 1 + k = size s - ((i - k - 1) + 1) by ring. -have i_min_k_min1_rng {size_drop} : 0 <= i - k - 1 < i. - rewrite iE; pose sz := (-(size s - i + 1)) %% r. - split=> [| _]. - rewrite - (ler_add2r (k + 1)) /=. - have -> @/sz : sz - k - 1 + (k + 1) = sz by ring. - have -> : -(size s - i + 1) = -(size s - i - 1 + 2) by ring. - rewrite - /j addrC lez_add1r //. - rewrite -(ltr_add2r (k + 1)). - have -> : sz - k - 1 + (k + 1) = sz by algebra. - rewrite ltr_addl ltzS //. -rewrite - nth_rev //. - split=> [| _ //]. - elim i_min_k_min1_rng=> //. - rewrite (ltr_trans i) //; elim i_min_k_min1_rng=> //. -have -> : - (nth false (rev s) (i - k - 1) = false) = - (nth false (rev s) (i - k - 1) <> true) by smt ml=0. -rewrite (before_index false) //. +pose j := (size s + _ - _); case: (i = (-(j + 2)) %% r) => // iE. +apply/eq_sym; rewrite -{1}(cat_take_drop j (rcons _ _)); congr. +have jE: j = size s - (i + 1) by rewrite /j #ring. +have [ge0_j lt_js]: 0 <= j < size s by move=> /#. +rewrite -cats1 drop_cat lt_js /= /mkpad -cats1 -cat_cons; congr=> //=. +rewrite size_take // size_cat /= ltr_spsaddr //= -iE. +have sz_js: size (drop j s) = i+1; last apply/(eq_from_nth false). ++ by rewrite size_drop //= max_ler ?subr_ge0 ?ltrW // /j #ring. ++ by rewrite sz_js /= addrC size_nseq max_ler. +rewrite sz_js => k [ge0_k lt_kSi]; rewrite nth_drop //. +move/ler_eqVlt: ge0_k => [<-|] /=. + by rewrite jE -nth_rev ?nth_index // -index_mem size_rev. +move=> lt0_k; rewrite gtr_eqF //= nth_nseq 1:/#. +have ->: j + k = (size s) - ((i-k) + 1) by rewrite /j #ring. +by rewrite -nth_rev 1:/# &(negbRL _ true) &(before_index) /#. qed. lemma chunk_padK : pcancel (chunk \o pad) (unpad \o flatten). From b96f6f99acb7ffaa68139c35228ff95152a0b5d5 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Thu, 17 Dec 2015 15:17:16 -0500 Subject: [PATCH 093/525] Proved lemmas giving iff characterizations of the validity functions for Block and Absorb. lemma nosmt valid_block_prop (xs : block list) : valid_block xs <=> exists (s : bool list, n : int), (0 <= n < r /\ r %| (size s + n + 2)) && blocks2bits xs = s ++ [true] ++ nseq n false ++ [true]. lemma valid_block_ends_not_b0 (xs : block list) : valid_block xs => last b0 xs <> b0. lemma nosmt valid_absorb_prop (xs : block list) : valid_absorb xs <=> exists (ys : block list, n : int), 0 <= n /\ xs = ys ++ nseq n b0 /\ valid_block ys. There are several functions at the beginning of Common.ec for the standard library. --- proof/Common.ec | 218 +++++++++++++++++++++++++++++++++++++++--------- 1 file changed, 178 insertions(+), 40 deletions(-) diff --git a/proof/Common.ec b/proof/Common.ec index f34b353..ad58974 100644 --- a/proof/Common.ec +++ b/proof/Common.ec @@ -1,4 +1,5 @@ (* -------------------------------------------------------------------- *) + require import Option Fun Pair Int IntExtra IntDiv Real List NewDistr. require import Ring StdRing StdOrder StdBigop BitEncoding. require (*--*) FinType BitWord LazyRP Monoid. @@ -36,6 +37,29 @@ clone export BitWord as Block with rename "dword" as "bdistr" "zerow" as "b0". +lemma b0 : b0 = bits2w(nseq r false). +proof. +admit. (* FIXME *) +qed. + +lemma bits2w_inj_eq (cs ds : bool list) : + size cs = r => size ds = r => bits2w cs = bits2w ds <=> cs = ds. +proof. +admit. (* FIXME *) +qed. + +lemma last_neq_cat (x : 'a) (xs : 'a list) : + last x xs = x => xs = [] \/ exists ys, xs = rcons ys x. +proof. +elim xs; smt ml=0. +qed. + +lemma last_nseq (x0 x : 'a, n : int) : + 0 < n => last x0 (nseq n x) = x. +proof. +admit. +qed. + (* -------------------------------------------------------------------- *) clone export LazyRP as Perm with @@ -49,18 +73,18 @@ rename op chunk (bs : bool list) = BitChunking.chunk r bs. -op mkpad (n : int) = - true :: rcons (nseq ((-(n+2)) %% r) false) true. +op num0 (n : int) = (-(n + 2)) %% r. -op pad (s : bool list) = - s ++ mkpad (size s). +op mkpad (n : int) = true :: rcons (nseq (num0 n) false) true. + +op pad (s : bool list) = s ++ mkpad (size s). op unpad (s : bool list) = if !last false s then None else let i = index true (behead (rev s)) in if i + 1 = size s then None else let n = size s - (i + 2) in - if i = (-(n+2)) %% r then Some (take n s) else None. + if i = num0 n then Some (take n s) else None. lemma rev_mkpad n : rev (mkpad n) = mkpad n. proof. by rewrite /mkpad rev_cons rev_rcons rev_nseq. qed. @@ -74,42 +98,68 @@ proof. by []. qed. lemma last_pad b s : last b (pad s) = true. proof. by rewrite last_cat last_mkpad. qed. -lemma size_mkpad n : size (mkpad n) = (-(n+2)) %% r + 2. +lemma size_mkpad n : size (mkpad n) = num0 n + 2. proof. rewrite /mkpad /= size_rcons size_nseq max_ler. by rewrite modz_ge0 gtr_eqF ?gt0_r. by ring. qed. -lemma size_pad s: size (pad s) = (size s + 1) %/ r * r + r. +lemma size_pad_equiv (m : int) : + 0 <= m => m + num0 m + 2 = (m + 1) %/ r * r + r. proof. -rewrite /pad /mkpad size_cat /= size_rcons size_nseq. -rewrite max_ler 1:modz_ge0 1:gtr_eqF ?gt0_r // (addrCA 1). -rewrite modNz ?gt0_r ?ltr_spaddr ?size_ge0 //. -by rewrite -(addrA _ 2) /= modzE; ring. +move=> ge0_m. +by rewrite modNz 1:/# 1:gt0_r -(addrA _ 2) /= modzE #ring. qed. -lemma size_pad_dvd_r s: r %| size (pad s). -proof. by rewrite size_pad dvdzD 1:dvdz_mull dvdzz. qed. +lemma num0_prop (m : int) : + 0 <= m => 0 <= num0 m < r /\ r %| (m + num0 m + 2). +proof. +move=> ge0_m. split. split=> [| _]. +by rewrite modz_ge0 1:gtr_eqF 1:gt0_r. rewrite ltz_pmod gt0_r. +rewrite (size_pad_equiv m) // dvdzD 1:dvdz_mull dvdzz. +qed. -lemma index_true_behead_mkpad n : - index true (behead (mkpad n)) = (-(n + 2)) %% r. +lemma num0_alt (n m : int) : + 0 <= m => 0 <= n < r => r %| (m + n + 2) => n = num0 m. proof. -rewrite /mkpad -cats1 index_cat mem_nseq size_nseq. -by rewrite max_ler // modz_ge0 gtr_eqF ?gt0_r. +move=> ge0_m [ge0_n lt_rn] r_dvd_m_add_n_add2. +rewrite modNz 1:ltr_spaddr // 1:gt0_r. +have -> : m + 2 - 1 = ((m + n + 2) - (n + 1)) by algebra. +rewrite -modzDm; have -> /= : (m + n + 2) %% r = 0 by apply dvdzE. +rewrite modz_mod modNz 1:/# 1:gt0_r. +have -> : r - 1 - (r - 1 - (n + 1 - 1) %% r) = n %% r by algebra. +rewrite modz_small 1:gtr0_norm 1:gt0_r /#. qed. -lemma size_chunk bs : size (chunk bs) = size bs %/ r. -proof. by apply/BitChunking.size_chunk/gt0_r. qed. +lemma size_pad_raw (s : bool list) : + size (pad s) = size s + num0 (size s) + 2. +proof. +rewrite /pad /mkpad /= -cats1 -cat1s 2!catA 3!size_cat /= + size_nseq 1:max_ler 1:modz_ge0 1:gtr_eqF 1:gt0_r // #ring. +qed. -lemma in_chunk_size bs b: mem (chunk bs) b => size b = r. -proof. by apply/BitChunking.in_chunk_size/gt0_r. qed. +lemma size_pad (s : bool list) : + size (pad s) = (size s + 1) %/ r * r + r. +proof. by rewrite size_pad_raw size_pad_equiv 1:size_ge0. qed. -lemma chunkK bs : r %| size bs => flatten (chunk bs) = bs. -proof. by apply/BitChunking.chunkK/gt0_r. qed. +lemma size_pad_dvd_r s : r %| size (pad s). +proof. by rewrite size_pad dvdzD 1:dvdz_mull dvdzz. qed. -lemma chunk_cat (xs ys : bool list) : - r %| size xs => chunk (xs ++ ys) = chunk xs ++ chunk ys. -proof. by apply/BitChunking.chunk_cat/gt0_r. qed. +lemma pad_alt (s : bool list, n : int) : + 0 <= n < r => r %| (size s + n + 2) => + pad s = s ++ [true] ++ nseq n false ++ [true]. +proof. +move=> [ge0_n lt_nr] mod. +rewrite /pad /mkpad /= -cats1 -cat1s 2!catA + (num0_alt n (size s)) // size_ge0. +qed. + +lemma index_true_behead_mkpad n : + index true (behead (mkpad n)) = num0 n. +proof. +rewrite /mkpad -cats1 index_cat mem_nseq size_nseq. +by rewrite max_ler // modz_ge0 gtr_eqF ?gt0_r. +qed. lemma padK : pcancel pad unpad. proof. @@ -123,7 +173,7 @@ pose b := _ = size _; case b => @/b - {b}. rewrite -(addrA _ 2) size_pad (addrC _ r) -!addrA => /addrI. rewrite addrCA /= -subr_eq0 -opprD oppr_eq0 addrC -divz_eq. by rewrite addz_neq0 ?size_ge0. -move=> sz {sz}. +move=> sz {sz}; rewrite /num0. have -> : size (pad s) - (i + 2) + 2 = size (pad s) - i by ring. pose b := _ = _ %% r; case b=> @/b - {b}; last first. have -> // : size s + 2 = size (pad s) - i @@ -137,7 +187,7 @@ proof. move=> s @/unpad; case: (last false s)=> //=. elim/last_ind: s=> //= s b ih {ih}; rewrite last_rcons => ->. rewrite rev_rcons /= size_rcons -(inj_eq _ (addIr (-1))) /= ?addrK. -pose i := index _ _; case: (i = size s)=> // ne_is @/pad. +pose i := index _ _; case: (i = size s)=> // ne_is @/pad @/num0. have lt_is: i < size s by rewrite ltr_neqAle ne_is -size_rev index_size. have [ge0_i lt_siz_s_i] : 0 <= i < size s. have le_siz_s_i : i <= size s by rewrite /i - size_rev index_size. @@ -159,6 +209,34 @@ have ->: j + k = (size s) - ((i-k) + 1) by rewrite /j #ring. by rewrite -nth_rev 1:/# &(negbRL _ true) &(before_index) /#. qed. +lemma nosmt unpad_prop (t : bool list) : + unpad t <> None <=> + exists (s : bool list, n : int), + (0 <= n < r /\ r %| (size s + n + 2)) && + t = s ++ [true] ++ nseq n false ++ [true]. +proof. +split=> [unpd_neq_None | [s n [[range_n dvd] ->]]]. +have [u unpd_Some] : exists s, unpad t = Some s + by move: unpd_neq_None; case (unpad t)=> // x _; exists x. +have <- : pad u = t by rewrite -(unpadK t) unpd_Some. +exists u, (num0 (size u)); split=> [| [num0_rng dvd_num0]]. +by rewrite num0_prop size_ge0. by apply pad_alt. +by rewrite -pad_alt // padK. +qed. + +lemma size_chunk bs : size (chunk bs) = size bs %/ r. +proof. by apply/BitChunking.size_chunk/gt0_r. qed. + +lemma in_chunk_size bs b: mem (chunk bs) b => size b = r. +proof. by apply/BitChunking.in_chunk_size/gt0_r. qed. + +lemma chunkK bs : r %| size bs => flatten (chunk bs) = bs. +proof. by apply/BitChunking.chunkK/gt0_r. qed. + +lemma chunk_cat (xs ys : bool list) : + r %| size xs => chunk (xs ++ ys) = chunk xs ++ chunk ys. +proof. by apply/BitChunking.chunk_cat/gt0_r. qed. + lemma chunk_padK : pcancel (chunk \o pad) (unpad \o flatten). proof. by move=> s @/(\o); rewrite chunkK 1:size_pad_dvd_r padK. qed. @@ -166,11 +244,19 @@ lemma flattenK bs : (forall b, mem bs b => size b = r) => chunk (flatten bs) = bs. proof. by apply/BitChunking.flattenK/gt0_r. qed. -op blocks2bits (xs:block list) : bool list = - flatten (map w2bits xs). +op blocks2bits (xs:block list) : bool list = flatten (map w2bits xs). + +lemma blocks2bits_nil : blocks2bits [] = []. +proof. by rewrite /blocks2bits /= flatten_nil. qed. + +lemma blocks2bits_sing (x : block) : blocks2bits [x] = w2bits x. +proof. by rewrite /blocks2bits /flatten /= cats0. qed. + +lemma blocks2bits_cat (xs ys : block list) : + blocks2bits (xs ++ ys) = blocks2bits xs ++ blocks2bits ys. +proof. by rewrite /blocks2bits map_cat flatten_cat. qed. -op bits2blocks (xs:bool list) : block list = - map bits2w (chunk xs). +op bits2blocks (xs:bool list) : block list = map bits2w (chunk xs). lemma blocks2bitsK : cancel blocks2bits bits2blocks. proof. @@ -193,7 +279,7 @@ have map_tolistK : + split. + apply tolistK; rewrite mem_xs_cons_yss_siz_r //. + apply ih => zs mem_zss_zs. - + by rewrite mem_xs_cons_yss_siz_r /=; first right; assumption. + + by rewrite mem_xs_cons_yss_siz_r /=; first right. rewrite map_tolistK; [apply in_chunk_size | exact chunkK]. qed. @@ -203,8 +289,8 @@ op unpad_blocks : block list -> bool list option = unpad \o blocks2bits. lemma pad2blocksK : pcancel pad2blocks unpad_blocks. proof. move=> xs. -rewrite /pad2blocks /unpad_blocks /(\o) bits2blocksK - 1:size_pad_dvd_r padK //. +by rewrite /pad2blocks /unpad_blocks /(\o) bits2blocksK + 1:size_pad_dvd_r padK. qed. lemma unpadBlocksK : ocancel unpad_blocks pad2blocks. @@ -213,10 +299,11 @@ move=> xs; rewrite /pad2blocks /unpad_blocks /(\o). pose bs := blocks2bits xs. case (unpad bs = None) => [-> // | unpad_bs_neq_None]. have unpad_bs : unpad bs = Some(oget(unpad bs)) - by move: unpad_bs_neq_None; case (unpad bs)=> //. + by move: unpad_bs_neq_None; case (unpad bs). rewrite unpad_bs /=. -have -> : pad(oget(unpad bs)) = bs by rewrite - {2} (unpadK bs) unpad_bs //. -rewrite /bs blocks2bitsK //. +have -> : pad(oget(unpad bs)) = bs + by rewrite - {2} (unpadK bs) unpad_bs. +by rewrite /bs blocks2bitsK. qed. (* ------------------------ Extending/Stripping ----------------------- *) @@ -227,6 +314,10 @@ op strip (xs : block list) = let i = find (fun x => x <> b0) (rev xs) in (take (size xs - i) xs, i). +lemma strip_ge0 (xs : block list) : + 0 <= (strip xs).`2. +proof. rewrite /strip /= find_ge0. qed. + lemma extendK (xs : block list) (n : int) : last b0 xs <> b0 => 0 <= n => strip(extend xs n) = (xs, n). proof. @@ -273,6 +364,53 @@ op valid_toplevel (_ : bool list) = true. (* in Block *) op valid_block (xs : block list) = unpad_blocks xs <> None. +lemma nosmt valid_block_prop (xs : block list) : + valid_block xs <=> + exists (s : bool list, n : int), + (0 <= n < r /\ r %| (size s + n + 2)) && + blocks2bits xs = s ++ [true] ++ nseq n false ++ [true]. +proof. rewrite /unpad_blocks /(\o); apply unpad_prop. qed. + +lemma valid_block_ends_not_b0 (xs : block list) : + valid_block xs => last b0 xs <> b0. +proof. +move=> vb_xs. +have [s n [_ btb_eq]] : + exists (s : bool list) (n : int), + (0 <= n < r /\ r %| (size s + n + 2)) && + blocks2bits xs = s ++ [true] ++ nseq n false ++ [true] + by rewrite -valid_block_prop. +case (last b0 xs <> b0)=> [// | last_xs_eq_b0]. +rewrite nnot in last_xs_eq_b0. +move: last_xs_eq_b0=> /last_neq_cat [->> | [ys ->>]]. +rewrite /blocks2bits /# in btb_eq. +rewrite -cats1 blocks2bits_cat blocks2bits_sing in btb_eq. +have left : last true (blocks2bits ys ++ w2bits b0) = false + by rewrite last_cat b0 tolistK 1:size_nseq 1:max_ler // 1:ge0_r // + last_nseq 1:gt0_r. +have right : last true (s ++ [true] ++ nseq n false ++ [true]) = true + by rewrite cats1 last_rcons. +have last_eq : + last true (blocks2bits ys ++ w2bits b0) = + last true (s ++ [true] ++ nseq n false ++ [true]) + by rewrite btb_eq. +by rewrite left right in last_eq. +qed. + (* in Absorb *) -op valid_absorb (xs : block list) = - let (ys, _) = strip xs in valid_block ys. +op valid_absorb (xs : block list) = valid_block((strip xs).`1). + +lemma nosmt valid_absorb_prop (xs : block list) : + valid_absorb xs <=> + exists (ys : block list, n : int), + 0 <= n /\ xs = ys ++ nseq n b0 /\ valid_block ys. +proof. +rewrite /valid_absorb. +split=> [| [ys n] [ge0_n [-> vb_ys]]]. +move=> strp_xs_valid. +exists (strip xs).`1, (strip xs).`2. +split; first apply (strip_ge0 xs). +split=> //. +by rewrite -/(extend (strip xs).`1 (strip xs).`2) eq_sym (stripK xs). +by rewrite -/(extend ys n) extendK 1:valid_block_ends_not_b0. +qed. From 706338d48bbd552de41d80035b539308c2f8fe7d Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Thu, 17 Dec 2015 17:42:59 -0500 Subject: [PATCH 094/525] valid_block_prop had redundant conjunct. --- proof/Common.ec | 35 +++++++++++++++++++++++++---------- 1 file changed, 25 insertions(+), 10 deletions(-) diff --git a/proof/Common.ec b/proof/Common.ec index ad58974..de91f3b 100644 --- a/proof/Common.ec +++ b/proof/Common.ec @@ -54,12 +54,6 @@ proof. elim xs; smt ml=0. qed. -lemma last_nseq (x0 x : 'a, n : int) : - 0 < n => last x0 (nseq n x) = x. -proof. -admit. -qed. - (* -------------------------------------------------------------------- *) clone export LazyRP as Perm with @@ -256,6 +250,15 @@ lemma blocks2bits_cat (xs ys : block list) : blocks2bits (xs ++ ys) = blocks2bits xs ++ blocks2bits ys. proof. by rewrite /blocks2bits map_cat flatten_cat. qed. +lemma size_blocks2bits (xs : block list) : + size (blocks2bits xs) = r * size xs. +proof. +elim xs=> [| x xs ih]. +by rewrite blocks2bits_nil. +rewrite -cat1s blocks2bits_cat blocks2bits_sing size_cat // + size_cat size_tolist ih /= #ring. +qed. + op bits2blocks (xs:bool list) : block list = map bits2w (chunk xs). lemma blocks2bitsK : cancel blocks2bits bits2blocks. @@ -367,9 +370,21 @@ op valid_block (xs : block list) = unpad_blocks xs <> None. lemma nosmt valid_block_prop (xs : block list) : valid_block xs <=> exists (s : bool list, n : int), + 0 <= n < r /\ blocks2bits xs = s ++ [true] ++ nseq n false ++ [true]. +proof. +rewrite /unpad_blocks /(\o). +split=> [vb | [s n] [rng_n btb]]. +have /# : + exists (s : bool list) (n : int), (0 <= n < r /\ r %| (size s + n + 2)) && - blocks2bits xs = s ++ [true] ++ nseq n false ++ [true]. -proof. rewrite /unpad_blocks /(\o); apply unpad_prop. qed. + blocks2bits xs = s ++ [true] ++ nseq n false ++ [true] + by apply unpad_prop. +have dvd : r %| (size s + n + 2). + have <- : size (blocks2bits xs) = size s + n + 2 + by rewrite btb 3!size_cat /= size_nseq max_ler /#. + rewrite size_blocks2bits dvdz_mulr dvdzz. +rewrite unpad_prop /#. +qed. lemma valid_block_ends_not_b0 (xs : block list) : valid_block xs => last b0 xs <> b0. @@ -377,8 +392,8 @@ proof. move=> vb_xs. have [s n [_ btb_eq]] : exists (s : bool list) (n : int), - (0 <= n < r /\ r %| (size s + n + 2)) && - blocks2bits xs = s ++ [true] ++ nseq n false ++ [true] + 0 <= n < r /\ + blocks2bits xs = s ++ [true] ++ nseq n false ++ [true]. by rewrite -valid_block_prop. case (last b0 xs <> b0)=> [// | last_xs_eq_b0]. rewrite nnot in last_xs_eq_b0. From d23fd60007c627d815cb2938d17b23c618f2fe26 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Thu, 17 Dec 2015 21:28:52 -0500 Subject: [PATCH 095/525] Nit. --- proof/Common.ec | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/proof/Common.ec b/proof/Common.ec index de91f3b..a28e312 100644 --- a/proof/Common.ec +++ b/proof/Common.ec @@ -48,12 +48,18 @@ proof. admit. (* FIXME *) qed. -lemma last_neq_cat (x : 'a) (xs : 'a list) : +lemma last_eq_rcons (x : 'a) (xs : 'a list) : last x xs = x => xs = [] \/ exists ys, xs = rcons ys x. proof. elim xs; smt ml=0. qed. +lemma last_neq_rcons (y x : 'a) (xs : 'a list) : + x <> y => last y xs = x => exists ys, xs = rcons ys x. +proof. +elim xs; smt ml=0. +qed. + (* -------------------------------------------------------------------- *) clone export LazyRP as Perm with @@ -397,7 +403,7 @@ have [s n [_ btb_eq]] : by rewrite -valid_block_prop. case (last b0 xs <> b0)=> [// | last_xs_eq_b0]. rewrite nnot in last_xs_eq_b0. -move: last_xs_eq_b0=> /last_neq_cat [->> | [ys ->>]]. +move: last_xs_eq_b0=> /last_eq_rcons [->> | [ys ->>]]. rewrite /blocks2bits /# in btb_eq. rewrite -cats1 blocks2bits_cat blocks2bits_sing in btb_eq. have left : last true (blocks2bits ys ++ w2bits b0) = false From 52508c6f038d83e9445ac8e587bd4b3464db2475 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Fri, 18 Dec 2015 10:20:41 +0100 Subject: [PATCH 096/525] Pushing on the GReal->ConcreteF transition. --- proof/LazyRP.eca | 21 ++++++++++++++++++- proof/old/ConcreteF.eca | 29 ++++++++++++++++++++------- proof/variant/LazyRP.eca | 39 ------------------------------------ proof/variant/LeakyAbsorb.ec | 5 +++-- proof/variant/RP.eca | 26 ------------------------ 5 files changed, 45 insertions(+), 75 deletions(-) delete mode 100644 proof/variant/LazyRP.eca delete mode 100644 proof/variant/RP.eca diff --git a/proof/LazyRP.eca b/proof/LazyRP.eca index b483b42..012268d 100644 --- a/proof/LazyRP.eca +++ b/proof/LazyRP.eca @@ -1,4 +1,4 @@ -require import Option FSet NewFMap. +require import Option Real FSet NewFMap Distr. require import Dexcepted. require (*..*) RP. @@ -37,3 +37,22 @@ module P : RP, RP_ = { return oget mi.[x]; } }. + +lemma P_init_ll: islossless P.init. +proof. by proc; auto. qed. + +lemma P_f_ll: is_lossless d => support d = predT => islossless P.f. +proof. +move=> d_ll d_fu; proc; if=> //=; auto=> &m /= x_notin_m. +have h:= endo_dom_rng P.m{m} _; first by exists x{m}. +apply/lossless_restr; first by rewrite d_ll. +smt. (* needs help *) +qed. + +lemma P_fi_ll: is_lossless d => support d = predT => islossless P.fi. +proof. +move=> d_ll d_fu; proc; if=> //=; auto=> &m /= x_notin_m. +have h:= endo_dom_rng P.mi{m} _; first by exists x{m}. +apply/lossless_restr; first by rewrite d_ll. +smt. (* needs help *) +qed. diff --git a/proof/old/ConcreteF.eca b/proof/old/ConcreteF.eca index 22b4e05..dbf7ed3 100644 --- a/proof/old/ConcreteF.eca +++ b/proof/old/ConcreteF.eca @@ -66,13 +66,28 @@ section. + while (={glob Perm,sc,sa,p} /\ (C.c + size p){1} = C.c{2});2:by auto. by wp;sp 1 1;if{2};[rcondt{1} 3|rcondf{1} 3];auto; progress;rewrite size_behead//;ring. - by auto; smt ml=0 w=size_ge0. - cut p_ll : islossless Perm.f. - + admit. (* We should have the lemma *) - cut pi_ll : islossless Perm.fi. - + admit. (* We should have the lemma *) - cut f_ll : islossless SqueezelessSponge(Perm).f. - + admit. (* We should have the lemma *) + by auto; smt ml=0 w=size_ge0. + have p_ll := P_f_ll _ _. + + apply/Dprod.lossless. + + exact/Block.DWord.bdistr_ll. + exact/Capacity.DWord.cdistr_ll. + + apply/fun_ext=> x; rewrite Dprod.supp_def /bdistr /cdistr. + rewrite -/(Distr.support _ _) NewDistr.MUniform.support_duniform Block.enumP. + by rewrite -/(Distr.support _ _) NewDistr.MUniform.support_duniform Capacity.enumP. + have pi_ll := P_fi_ll _ _. + + apply/Dprod.lossless. + + exact/Block.DWord.bdistr_ll. + exact/Capacity.DWord.cdistr_ll. + + apply/fun_ext=> x; rewrite Dprod.supp_def /bdistr /cdistr. + rewrite -/(Distr.support _ _) NewDistr.MUniform.support_duniform Block.enumP. + by rewrite -/(Distr.support _ _) NewDistr.MUniform.support_duniform Capacity.enumP. + have f_ll : islossless SqueezelessSponge(Perm).f. + + proc; sp; if=> //=. + while true (size p) (size p) 1%r=> //=. + * smt w=(size_ge0 size_eq0). + * by move=> hind; seq 2: true 1%r 1%r 0%r _=> //=; wp; call p_ll. + * by wp; call p_ll. + by move=> z; conseq (_: _ : =1%r); wp; call p_ll; skip; smt w=size_behead. apply (ler_trans _ _ _ (Pr_restr Perm SqueezelessSponge D p_ll pi_ll f_ll D_ll &m)). admit. (* Francois *) diff --git a/proof/variant/LazyRP.eca b/proof/variant/LazyRP.eca deleted file mode 100644 index b483b42..0000000 --- a/proof/variant/LazyRP.eca +++ /dev/null @@ -1,39 +0,0 @@ -require import Option FSet NewFMap. -require import Dexcepted. -require (*..*) RP. - -type D. -op d: D distr. - -clone include RP with - type from <- D, - type to <- D. - -module P : RP, RP_ = { - var m : (D, D) fmap - var mi: (D, D) fmap - - proc init() = { m = map0; mi = map0; } - - proc f(x) = { - var y; - - if (!mem (dom m) x) { - y <$ d \ rng m; - m.[x] <- y; - mi.[y] <- x; - } - return oget m.[x]; - } - - proc fi(x) = { - var y; - - if (!mem (dom mi) x) { - y <$ d \ rng mi; - mi.[x] <- y; - m.[y] <- x; - } - return oget mi.[x]; - } -}. diff --git a/proof/variant/LeakyAbsorb.ec b/proof/variant/LeakyAbsorb.ec index c59fe8b..3ebe579 100644 --- a/proof/variant/LeakyAbsorb.ec +++ b/proof/variant/LeakyAbsorb.ec @@ -363,7 +363,7 @@ section PROOF. `|Pr[Experiment(SpongeThatAbsorbs(Perm),Perm,D).main() @ &m : res] - Pr[Experiment(IdealFunctionalityThatAbsorbs, MkS(S,IdealFunctionalityThatAbsorbs), D).main() @ &m : res]|. proof. - congr;congr. + do 3?congr. + byequiv (_: ={glob D} ==> _) => //;proc;inline *. call (_: ={glob Perm});1,2:(by sim); last by auto. proc;inline{1}SpongeThatDoesNotAbsorb(Perm).f;sp 1 3;if=> //. @@ -371,7 +371,8 @@ section PROOF. while (={glob Perm, i, sa, sc} /\ n0{1} = n{2} /\ z{1} = take (size m{1}) z{1} ++ z{2} /\ size m{1} <= size z{1}). + call (_ : ={glob Perm});[by sim|auto;progress [-split];smt]. while (={glob Perm, p, sa,sc} /\ (size z = size m - size p){1}). - + wp;call (_ : ={glob Perm});[by sim|auto;progress [-split];smt]. + + wp;call (_ : ={glob Perm});[by sim|auto;progress [-split]]. + by rewrite size_rcons H; move: H0; case: (p{2})=> //= x xs; ring. by auto;progress [-split];smt. cut -> : Pr[Experiment(IdealFunctionalityThatDoesNotAbsorb, S(IdealFunctionalityThatDoesNotAbsorb), MkD(D)).main () @ &m : res] = Pr[RndOrcl0.IND(Restr(RO), E1).main() @ &m : res]. diff --git a/proof/variant/RP.eca b/proof/variant/RP.eca deleted file mode 100644 index eafe094..0000000 --- a/proof/variant/RP.eca +++ /dev/null @@ -1,26 +0,0 @@ -type from, to. - -module type RP = { - proc init() : unit - proc f (x : from): to - proc fi(x : to ): from -}. - -module type RP_ = { - proc f (x : from): to - proc fi(x : to ): from -}. - -module type Distinguisher(G : RP_) = { - proc distinguish(): bool -}. - -module IND(G:RP, D:Distinguisher) = { - proc main(): bool = { - var b; - - G.init(); - b <@ D(G).distinguish(); - return b; - } -}. From 114d90f45ab79b8a4ecd7c16f7617630ead8ea15 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Sat, 19 Dec 2015 14:00:29 -0500 Subject: [PATCH 097/525] Simplifications. --- proof/Common.ec | 38 ++++++++++++++++---------------------- 1 file changed, 16 insertions(+), 22 deletions(-) diff --git a/proof/Common.ec b/proof/Common.ec index a28e312..b0d322d 100644 --- a/proof/Common.ec +++ b/proof/Common.ec @@ -265,6 +265,9 @@ rewrite -cat1s blocks2bits_cat blocks2bits_sing size_cat // size_cat size_tolist ih /= #ring. qed. +lemma size_blocks2bits_dvd_r (xs : block list) : r %| size(blocks2bits xs). +proof. rewrite size_blocks2bits dvdz_mulr dvdzz. qed. + op bits2blocks (xs:bool list) : block list = map bits2w (chunk xs). lemma blocks2bitsK : cancel blocks2bits bits2blocks. @@ -378,30 +381,24 @@ lemma nosmt valid_block_prop (xs : block list) : exists (s : bool list, n : int), 0 <= n < r /\ blocks2bits xs = s ++ [true] ++ nseq n false ++ [true]. proof. -rewrite /unpad_blocks /(\o). +rewrite /valid_block /unpad_blocks /(\o). split=> [vb | [s n] [rng_n btb]]. -have /# : - exists (s : bool list) (n : int), - (0 <= n < r /\ r %| (size s + n + 2)) && - blocks2bits xs = s ++ [true] ++ nseq n false ++ [true] - by apply unpad_prop. -have dvd : r %| (size s + n + 2). - have <- : size (blocks2bits xs) = size s + n + 2 - by rewrite btb 3!size_cat /= size_nseq max_ler /#. - rewrite size_blocks2bits dvdz_mulr dvdzz. -rewrite unpad_prop /#. +cut [up _] := (unpad_prop (blocks2bits xs)). +rewrite vb /= in up; elim up=> [s n] [[rng_n _] b2b]. +by exists s, n. +apply unpad_prop; exists s, n; split=> //; split=> //. +have <- : size (blocks2bits xs) = size s + n + 2 + by rewrite btb 3!size_cat /= size_nseq max_ler /#ring. +rewrite size_blocks2bits_dvd_r. qed. lemma valid_block_ends_not_b0 (xs : block list) : valid_block xs => last b0 xs <> b0. proof. move=> vb_xs. -have [s n [_ btb_eq]] : - exists (s : bool list) (n : int), - 0 <= n < r /\ - blocks2bits xs = s ++ [true] ++ nseq n false ++ [true]. - by rewrite -valid_block_prop. -case (last b0 xs <> b0)=> [// | last_xs_eq_b0]. +cut bp := valid_block_prop xs. +rewrite vb_xs /= in bp; elim bp=> [s n] [_ btb_eq]. +case: (last b0 xs <> b0)=> [// | last_xs_eq_b0]. rewrite nnot in last_xs_eq_b0. move: last_xs_eq_b0=> /last_eq_rcons [->> | [ys ->>]]. rewrite /blocks2bits /# in btb_eq. @@ -426,12 +423,9 @@ lemma nosmt valid_absorb_prop (xs : block list) : exists (ys : block list, n : int), 0 <= n /\ xs = ys ++ nseq n b0 /\ valid_block ys. proof. -rewrite /valid_absorb. -split=> [| [ys n] [ge0_n [-> vb_ys]]]. -move=> strp_xs_valid. +rewrite /valid_absorb; split=> [strp_xs_valid | [ys n] [ge0_n [-> vb_ys]]]. exists (strip xs).`1, (strip xs).`2. -split; first apply (strip_ge0 xs). -split=> //. +split; [apply (strip_ge0 xs) | split=> //]. by rewrite -/(extend (strip xs).`1 (strip xs).`2) eq_sym (stripK xs). by rewrite -/(extend ys n) extendK 1:valid_block_ends_not_b0. qed. From a2b305a261990823f6e91ec0b5152ad7e979587f Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Sun, 20 Dec 2015 23:12:39 -0500 Subject: [PATCH 098/525] Almost done with alternative version of valid_block_prop, which should be more useful for some purposes. --- proof/Common.ec | 196 +++++++++++++++++++++++++++++++++++++++++------- 1 file changed, 168 insertions(+), 28 deletions(-) diff --git a/proof/Common.ec b/proof/Common.ec index b0d322d..6736cd8 100644 --- a/proof/Common.ec +++ b/proof/Common.ec @@ -37,6 +37,19 @@ clone export BitWord as Block with rename "dword" as "bdistr" "zerow" as "b0". +(* ------------------------- Auxiliary Lemmas ------------------------- *) + +lemma chunk_nil' ['a] (r : int) : BitChunking.chunk r [<:'a>] = []. +proof. by rewrite /chunk /= div0z mkseq0. qed. + +lemma chunk_sing' r (xs : bool list) : + 0 < r => size xs = r => BitChunking.chunk r xs = [xs]. +proof. +move=> gt0_r sz_xs_eq_r. +by rewrite /bits2blocks /chunk sz_xs_eq_r divzz ltr0_neq0 1:gt0_r b2i1 + mkseq1 /= drop0 -sz_xs_eq_r take_size. +qed. + lemma b0 : b0 = bits2w(nseq r false). proof. admit. (* FIXME *) @@ -48,16 +61,16 @@ proof. admit. (* FIXME *) qed. -lemma last_eq_rcons (x : 'a) (xs : 'a list) : - last x xs = x => xs = [] \/ exists ys, xs = rcons ys x. +lemma last_drop_all_but_last (y : 'a, xs : 'a list) : + xs = [] \/ drop (size xs - 1) xs = [last y xs]. proof. -elim xs; smt ml=0. -qed. - -lemma last_neq_rcons (y x : 'a) (xs : 'a list) : - x <> y => last y xs = x => exists ys, xs = rcons ys x. -proof. -elim xs; smt ml=0. +elim xs=> // z zs ih /=; have -> : 1 + size zs - 1 = size zs by ring. +case (size zs <= 0)=> [le0_sz_zs | gt0_sz_zs]. +have sz_zs_eq0 : size zs = 0 + by rewrite (ler_asym (size zs) 0); split=> // _; rewrite size_ge0. +by have -> : zs = [] by rewrite -size_eq0. +case (zs = [])=> // zs_non_nil. elim ih=> // ->. +by rewrite (last_nonempty y z). qed. (* -------------------------------------------------------------------- *) @@ -233,6 +246,12 @@ proof. by apply/BitChunking.in_chunk_size/gt0_r. qed. lemma chunkK bs : r %| size bs => flatten (chunk bs) = bs. proof. by apply/BitChunking.chunkK/gt0_r. qed. +lemma chunk_nil : chunk [] = []. +proof. by apply/chunk_nil'. qed. + +lemma chunk_sing (xs : bool list) : size xs = r => chunk xs = [xs]. +proof. by apply/chunk_sing'/gt0_r. qed. + lemma chunk_cat (xs ys : bool list) : r %| size xs => chunk (xs ++ ys) = chunk xs ++ chunk ys. proof. by apply/BitChunking.chunk_cat/gt0_r. qed. @@ -268,7 +287,22 @@ qed. lemma size_blocks2bits_dvd_r (xs : block list) : r %| size(blocks2bits xs). proof. rewrite size_blocks2bits dvdz_mulr dvdzz. qed. -op bits2blocks (xs:bool list) : block list = map bits2w (chunk xs). +op bits2blocks (xs : bool list) : block list = map bits2w (chunk xs). + +lemma bits2blocks_nil : bits2blocks [] = []. +proof. by rewrite /bits2blocks chunk_nil. qed. + +lemma bits2blocks_sing (xs : bool list) : + size xs = r => bits2blocks xs = [bits2w xs]. +proof. move=> sz_xs_eq_r; by rewrite /bits2blocks chunk_sing. qed. + +lemma bits2blocks_cat (xs ys : bool list) : + r %| size xs => r %| size ys => + bits2blocks (xs ++ ys) = bits2blocks xs ++ bits2blocks ys. +proof. +move=> r_dvd_sz_xs r_dvd_sz_ys. +by rewrite /bits2blocks chunk_cat // map_cat. +qed. lemma blocks2bitsK : cancel blocks2bits bits2blocks. proof. @@ -382,37 +416,143 @@ lemma nosmt valid_block_prop (xs : block list) : 0 <= n < r /\ blocks2bits xs = s ++ [true] ++ nseq n false ++ [true]. proof. rewrite /valid_block /unpad_blocks /(\o). -split=> [vb | [s n] [rng_n btb]]. +split=> [vb | [s n] [rng_n b2b]]. cut [up _] := (unpad_prop (blocks2bits xs)). rewrite vb /= in up; elim up=> [s n] [[rng_n _] b2b]. by exists s, n. apply unpad_prop; exists s, n; split=> //; split=> //. have <- : size (blocks2bits xs) = size s + n + 2 - by rewrite btb 3!size_cat /= size_nseq max_ler /#ring. + by rewrite b2b 3!size_cat /= size_nseq max_ler /#ring. rewrite size_blocks2bits_dvd_r. qed. lemma valid_block_ends_not_b0 (xs : block list) : valid_block xs => last b0 xs <> b0. proof. -move=> vb_xs. -cut bp := valid_block_prop xs. -rewrite vb_xs /= in bp; elim bp=> [s n] [_ btb_eq]. +move=> vb_xs; cut bp := valid_block_prop xs. +rewrite vb_xs /= in bp; elim bp=> [s n] [_ b2b_xs_eq]. case: (last b0 xs <> b0)=> [// | last_xs_eq_b0]. rewrite nnot in last_xs_eq_b0. -move: last_xs_eq_b0=> /last_eq_rcons [->> | [ys ->>]]. -rewrite /blocks2bits /# in btb_eq. -rewrite -cats1 blocks2bits_cat blocks2bits_sing in btb_eq. -have left : last true (blocks2bits ys ++ w2bits b0) = false - by rewrite last_cat b0 tolistK 1:size_nseq 1:max_ler // 1:ge0_r // - last_nseq 1:gt0_r. -have right : last true (s ++ [true] ++ nseq n false ++ [true]) = true - by rewrite cats1 last_rcons. -have last_eq : - last true (blocks2bits ys ++ w2bits b0) = - last true (s ++ [true] ++ nseq n false ++ [true]) - by rewrite btb_eq. -by rewrite left right in last_eq. +have xs_non_nil : xs <> [] by smt ml=0. +elim (last_drop_all_but_last b0 xs)=> // drop_xs. +have xs_take_drop : xs = take (size xs - 1) xs ++ drop (size xs - 1) xs + by rewrite cat_take_drop. +rewrite drop_xs last_xs_eq_b0 b0 in xs_take_drop. +have last_b2b_xs_true : last true (blocks2bits xs) = true + by rewrite b2b_xs_eq cats1 last_rcons. +have last_b2b_xs_false : last true (blocks2bits xs) = false + by rewrite xs_take_drop blocks2bits_cat blocks2bits_sing tolistK + 1:size_nseq 1:max_ler 1:ge0_r // last_cat + last_nseq 1:gt0_r. +by rewrite last_b2b_xs_true in last_b2b_xs_false. +qed. + +lemma dvd_bounded_imp_eq (n : int) : + r %| n => 0 < n < r + r => n = r. +proof. +move=> dvd_rn [gt0_n lt_n_2r]. +have [m] n_eq /# : exists m, m * r = n + by exists (n %/ r); apply dvdz_eq. +qed. + +lemma nosmt valid_block_prop_alt (xs : block list) : + valid_block xs <=> + (exists (ys : block list, x : block, s : bool list, n : int), + xs = ys ++ [x] /\ 0 <= n /\ + w2bits x = s ++ [true] ++ nseq n false ++ [true]) \/ + (exists (ys : block list, y z : block), + xs = ys ++ [y; z] /\ last false (w2bits y) /\ + w2bits z = nseq (r - 1) false ++ [true]). +proof. +rewrite valid_block_prop. +split=>[[s n] [[ge0_n lt_nr] b2b_xs_eq] | + [[ys x s n] [xs_eq [ge0_n w2b_ys_eq]] | + [ys y z] [xs_eq [lst_w2b_y w2b_z_eq]]]]. +have sz_s_divz_eq : size s = size s %/ r * r + size s %% r + by apply divz_eq. +pose tke := take (size s %/ r * r) s. +pose drp := drop (size s %/ r * r) s. +have sz_tke : size tke = size s %/ r * r. + rewrite size_take 1:mulr_ge0 1:divz_ge0 1:gt0_r 1:size_ge0 + 1:ge0_r. + case (size s %/ r * r < size s)=> // not_lt_sz_s. + rewrite -lezNgt in not_lt_sz_s. + apply ler_asym; split=> // _. + by rewrite lez_floor gtr_eqF 1:gt0_r //. +have sz_drp : size drp = size s %% r. + rewrite size_drop 1:mulr_ge0 1:divz_ge0 1:gt0_r 1:size_ge0 + 1:ge0_r. + case (size s %/ r * r < size s)=> // not_lt_sz_s. + rewrite max_ler /#. + have eq : size s %/ r * r = size s. + rewrite -lezNgt in not_lt_sz_s. + apply ler_asym; split=> //. + by rewrite lez_floor gtr_eqF 1:gt0_r //. + rewrite max_lel /#. +have sz_s_pad_dvd_r : r %| (size s + n + 2). + have <- : size (s ++ [true] ++ nseq n false ++ [true]) = size s + n + 2 + by rewrite !size_cat /= size_nseq max_ler 1:ge0_n #ring. + rewrite -b2b_xs_eq size_blocks2bits_dvd_r. +have sz_tke_dvd_r : r %| size tke + by rewrite sz_tke dvdz_mull dvdzz. +have sz_drp_plus_n_plus_2_dvd_r : r %| (size drp + n + 2). + rewrite sz_drp dvdzE + -(dvdz_modzDl (size s %/ r * r) (size s %% r + n + 2) r) + 1:dvdz_mull 1:dvdzz. + cut -> : size s %/ r * r + (size s %% r + n + 2) = size s + n + 2. + rewrite {3}sz_s_divz_eq #ring. by rewrite -dvdzE. +have xs_eq : xs = bits2blocks(s ++ [true] ++ nseq n false ++ [true]) + by rewrite -blocks2bitsK b2b_xs_eq. +rewrite -(cat_take_drop (size s %/ r * r) s) -!catA -/tke -/drp in xs_eq. +rewrite bits2blocks_cat in xs_eq. +rewrite sz_tke_dvd_r. rewrite !size_cat /= size_nseq max_ler 1:ge0_n. +have -> : size drp + (1 + (n + 1)) = size drp + n + 2 by ring. +rewrite sz_drp_plus_n_plus_2_dvd_r. +case: (n = r - 1)=> [n_eq_r_min1 | n_neq_r_min1]. +right. +admit. (* Alley in process of filling *) +have lt_n_r_min1 : n < r - 1 by smt ml=0. +left. +move: xs_eq. +have sz_drp_plus_n_plus_2_eq_r : size drp + n + 2 = r. + rewrite (dvd_bounded_imp_eq (size drp + n + 2)) // sz_drp. + have n_plus2_rng : 2 <= n + 2 <= r by smt ml=0. + rewrite -addrA; split=> [| _]. + rewrite ltr_paddl 1:modz_ge0 1:gtr_eqF 1:gt0_r // /#. + have -> : r + r = (r - 1) + (r + 1) by ring. + rewrite ler_lt_add 1:-ltzS 1:-addrA /= 1:ltz_pmod 1:gt0_r. + by rewrite -(ltr_add2r (-2)) -2!addrA. +move=> xs_eq. +rewrite (bits2blocks_sing + (drp ++ ([true] ++ (nseq n false ++ [true])))) + in xs_eq. +rewrite !size_cat /= size_nseq max_ler 1:ge0_n 1:sz_drp. + have -> : size s %% r + (1 + (n + 1)) = size s %%r + n + 2 by ring. + by rewrite -sz_drp. +exists (bits2blocks tke), + (bits2w(drp ++ ([true] ++ (nseq n false ++ [true])))), + drp, n. +split=> //; split=> //. +by rewrite tolistK 1:!size_cat /= 1:size_nseq 1:max_ler 1:ge0_n + 1:-sz_drp_plus_n_plus_2_eq_r 1:#ring -!catA cat1s. +exists (blocks2bits ys ++ s), n; split. +have sz_w2b_x_eq_r : size(w2bits x) = r by apply size_tolist. +rewrite w2b_ys_eq !size_cat /= size_nseq max_ler // in sz_w2b_x_eq_r. +split=> // _; smt ml=0 w=(size_ge0). +by rewrite xs_eq blocks2bits_cat blocks2bits_sing w2b_ys_eq !catA. +exists (blocks2bits ys ++ (take (r - 1) (w2bits y))), (r - 1). +split; first smt ml=0 w=(gt0_r). +rewrite xs_eq blocks2bits_cat; have -> : [y; z] = [y] ++ [z] by trivial. +rewrite blocks2bits_cat 2!blocks2bits_sing -!catA; congr. +have {1}-> : w2bits y = take (r - 1) (w2bits y) ++ [true]. + rewrite -{1}(cat_take_drop (r - 1) (w2bits y)); congr. + elim (last_drop_all_but_last false (w2bits y))=> + [w2b_y_nil | drop_w2b_y_last]. + have not_lst_w2b_y : ! last false (w2bits y) by rewrite w2b_y_nil. + done. + rewrite lst_w2b_y in drop_w2b_y_last. + by rewrite -drop_w2b_y_last size_tolist. +by rewrite w2b_z_eq !catA. qed. (* in Absorb *) From ecc628909ac84064d5e0c8bff2e1d27ca1b1c192 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Mon, 21 Dec 2015 10:25:27 -0500 Subject: [PATCH 099/525] Done with alternative block-level validity function. --- proof/Common.ec | 85 +++++++++++++++++++++++++++++++------------------ proof/Temp.ec | 7 ---- 2 files changed, 54 insertions(+), 38 deletions(-) delete mode 100644 proof/Temp.ec diff --git a/proof/Common.ec b/proof/Common.ec index 6736cd8..c50e1c7 100644 --- a/proof/Common.ec +++ b/proof/Common.ec @@ -39,7 +39,15 @@ clone export BitWord as Block with (* ------------------------- Auxiliary Lemmas ------------------------- *) -lemma chunk_nil' ['a] (r : int) : BitChunking.chunk r [<:'a>] = []. +lemma dvdz_close (n : int) : + r %| n => 0 < n < 2 * r => n = r. +proof. +move=> dvd_rn [gt0_n lt_n_2r]. +have [m] n_eq /# : exists m, m * r = n + by exists (n %/ r); apply dvdz_eq. +qed. + +lemma chunk_nil' ['a] r : BitChunking.chunk r [<:'a>] = []. proof. by rewrite /chunk /= div0z mkseq0. qed. lemma chunk_sing' r (xs : bool list) : @@ -301,7 +309,7 @@ lemma bits2blocks_cat (xs ys : bool list) : bits2blocks (xs ++ ys) = bits2blocks xs ++ bits2blocks ys. proof. move=> r_dvd_sz_xs r_dvd_sz_ys. -by rewrite /bits2blocks chunk_cat // map_cat. +by rewrite /bits2blocks chunk_cat 2:map_cat. qed. lemma blocks2bitsK : cancel blocks2bits bits2blocks. @@ -353,6 +361,7 @@ by rewrite /bs blocks2bitsK. qed. (* ------------------------ Extending/Stripping ----------------------- *) + op extend (xs : block list) (n : int) = xs ++ nseq n b0. @@ -417,7 +426,7 @@ lemma nosmt valid_block_prop (xs : block list) : proof. rewrite /valid_block /unpad_blocks /(\o). split=> [vb | [s n] [rng_n b2b]]. -cut [up _] := (unpad_prop (blocks2bits xs)). +have [up _] := (unpad_prop (blocks2bits xs)). rewrite vb /= in up; elim up=> [s n] [[rng_n _] b2b]. by exists s, n. apply unpad_prop; exists s, n; split=> //; split=> //. @@ -429,7 +438,7 @@ qed. lemma valid_block_ends_not_b0 (xs : block list) : valid_block xs => last b0 xs <> b0. proof. -move=> vb_xs; cut bp := valid_block_prop xs. +move=> vb_xs; have bp := valid_block_prop xs. rewrite vb_xs /= in bp; elim bp=> [s n] [_ b2b_xs_eq]. case: (last b0 xs <> b0)=> [// | last_xs_eq_b0]. rewrite nnot in last_xs_eq_b0. @@ -447,14 +456,6 @@ have last_b2b_xs_false : last true (blocks2bits xs) = false by rewrite last_b2b_xs_true in last_b2b_xs_false. qed. -lemma dvd_bounded_imp_eq (n : int) : - r %| n => 0 < n < r + r => n = r. -proof. -move=> dvd_rn [gt0_n lt_n_2r]. -have [m] n_eq /# : exists m, m * r = n - by exists (n %/ r); apply dvdz_eq. -qed. - lemma nosmt valid_block_prop_alt (xs : block list) : valid_block xs <=> (exists (ys : block list, x : block, s : bool list, n : int), @@ -470,14 +471,12 @@ split=>[[s n] [[ge0_n lt_nr] b2b_xs_eq] | [ys y z] [xs_eq [lst_w2b_y w2b_z_eq]]]]. have sz_s_divz_eq : size s = size s %/ r * r + size s %% r by apply divz_eq. -pose tke := take (size s %/ r * r) s. -pose drp := drop (size s %/ r * r) s. +pose tke := take (size s %/ r * r) s; pose drp := drop (size s %/ r * r) s. have sz_tke : size tke = size s %/ r * r. rewrite size_take 1:mulr_ge0 1:divz_ge0 1:gt0_r 1:size_ge0 1:ge0_r. case (size s %/ r * r < size s)=> // not_lt_sz_s. - rewrite -lezNgt in not_lt_sz_s. - apply ler_asym; split=> // _. + rewrite -lezNgt in not_lt_sz_s; apply ler_asym; split=> // _. by rewrite lez_floor gtr_eqF 1:gt0_r //. have sz_drp : size drp = size s %% r. rewrite size_drop 1:mulr_ge0 1:divz_ge0 1:gt0_r 1:size_ge0 @@ -485,40 +484,64 @@ have sz_drp : size drp = size s %% r. case (size s %/ r * r < size s)=> // not_lt_sz_s. rewrite max_ler /#. have eq : size s %/ r * r = size s. - rewrite -lezNgt in not_lt_sz_s. - apply ler_asym; split=> //. + rewrite -lezNgt in not_lt_sz_s; apply ler_asym; split=> //. by rewrite lez_floor gtr_eqF 1:gt0_r //. rewrite max_lel /#. have sz_s_pad_dvd_r : r %| (size s + n + 2). have <- : size (s ++ [true] ++ nseq n false ++ [true]) = size s + n + 2 by rewrite !size_cat /= size_nseq max_ler 1:ge0_n #ring. rewrite -b2b_xs_eq size_blocks2bits_dvd_r. -have sz_tke_dvd_r : r %| size tke - by rewrite sz_tke dvdz_mull dvdzz. +have sz_tke_dvd_r : r %| size tke by rewrite sz_tke dvdz_mull dvdzz. have sz_drp_plus_n_plus_2_dvd_r : r %| (size drp + n + 2). rewrite sz_drp dvdzE -(dvdz_modzDl (size s %/ r * r) (size s %% r + n + 2) r) 1:dvdz_mull 1:dvdzz. - cut -> : size s %/ r * r + (size s %% r + n + 2) = size s + n + 2. + have -> : size s %/ r * r + (size s %% r + n + 2) = size s + n + 2. rewrite {3}sz_s_divz_eq #ring. by rewrite -dvdzE. have xs_eq : xs = bits2blocks(s ++ [true] ++ nseq n false ++ [true]) by rewrite -blocks2bitsK b2b_xs_eq. -rewrite -(cat_take_drop (size s %/ r * r) s) -!catA -/tke -/drp in xs_eq. -rewrite bits2blocks_cat in xs_eq. -rewrite sz_tke_dvd_r. rewrite !size_cat /= size_nseq max_ler 1:ge0_n. -have -> : size drp + (1 + (n + 1)) = size drp + n + 2 by ring. -rewrite sz_drp_plus_n_plus_2_dvd_r. +rewrite -(cat_take_drop (size s %/ r * r) s) -!catA -/tke -/drp + bits2blocks_cat in xs_eq. ++ rewrite sz_tke_dvd_r. rewrite !size_cat /= size_nseq max_ler 1:ge0_n. ++ have -> : size drp + (1 + (n + 1)) = size drp + n + 2 by ring. ++ rewrite sz_drp_plus_n_plus_2_dvd_r. case: (n = r - 1)=> [n_eq_r_min1 | n_neq_r_min1]. right. -admit. (* Alley in process of filling *) +have sz_drp_plus1_dvd_r : r %| (size drp + 1). + rewrite dvdzE -(addz0 (size drp + 1)) -{1}(modzz r). + have {1}-> : r = n + 1 by smt ml=0. + rewrite modzDmr. + have -> : size drp + 1 + (n + 1) = size drp + n + 2 by ring. + by rewrite -dvdzE. +have sz_drp_plus1_eq_r : size drp + 1 = r. + rewrite (dvdz_close (size drp + 1)) //. + split=> [| _]; first rewrite ltr_paddl 1:size_ge0 ltr01. + have -> : 2 * r = r + r by ring. + rewrite ltr_add // 1:sz_drp 1:ltz_pmod 1:gt0_r ltzE ge2_r. +exists (bits2blocks tke), + (bits2w (drp ++ [true])), + (bits2w (nseq n false ++ [true])). +split. +rewrite xs_eq. +rewrite (catA drp [true]) bits2blocks_cat 1:size_cat // + 1:size_cat 1:size_nseq 1:max_ler 1:ge0_n /= 1:/#. +rewrite (bits2blocks_sing (drp ++ [true])) 1:size_cat //. +rewrite (bits2blocks_sing (nseq n false ++ [true])). +rewrite size_cat size_nseq max_ler /= 1:ge0_n /#. +by rewrite catA. +do 2! rewrite tolistK 1:size_cat //=. ++ rewrite size_nseq max_ler 1:ge0_n /#. +split; first rewrite cats1 last_rcons. +have -> // : n = r - 1 by smt ml=0. have lt_n_r_min1 : n < r - 1 by smt ml=0. left. move: xs_eq. have sz_drp_plus_n_plus_2_eq_r : size drp + n + 2 = r. - rewrite (dvd_bounded_imp_eq (size drp + n + 2)) // sz_drp. + rewrite (dvdz_close (size drp + n + 2)) // sz_drp. have n_plus2_rng : 2 <= n + 2 <= r by smt ml=0. rewrite -addrA; split=> [| _]. rewrite ltr_paddl 1:modz_ge0 1:gtr_eqF 1:gt0_r // /#. + have ->: 2 * r = r + r by ring. have -> : r + r = (r - 1) + (r + 1) by ring. rewrite ler_lt_add 1:-ltzS 1:-addrA /= 1:ltz_pmod 1:gt0_r. by rewrite -(ltr_add2r (-2)) -2!addrA. @@ -526,9 +549,9 @@ move=> xs_eq. rewrite (bits2blocks_sing (drp ++ ([true] ++ (nseq n false ++ [true])))) in xs_eq. -rewrite !size_cat /= size_nseq max_ler 1:ge0_n 1:sz_drp. - have -> : size s %% r + (1 + (n + 1)) = size s %%r + n + 2 by ring. - by rewrite -sz_drp. ++ rewrite !size_cat /= size_nseq max_ler 1:ge0_n 1:sz_drp. ++ have -> : size s %% r + (1 + (n + 1)) = size s %%r + n + 2 by ring. ++ by rewrite -sz_drp. exists (bits2blocks tke), (bits2w(drp ++ ([true] ++ (nseq n false ++ [true])))), drp, n. diff --git a/proof/Temp.ec b/proof/Temp.ec deleted file mode 100644 index 06449dd..0000000 --- a/proof/Temp.ec +++ /dev/null @@ -1,7 +0,0 @@ -(* Temporary File for Auxiliary Lemmas *) - -require import Option Fun Pair Int IntExtra IntDiv Real List NewDistr. -require import Ring StdRing StdOrder StdBigop BitEncoding. -(*---*) import IntID IntOrder BitChunking. - -end ForCommon. From 949f55fed62ce2ab95c50fa1de492ee38b4a1fab Mon Sep 17 00:00:00 2001 From: Pierre-Yves Strub Date: Mon, 21 Dec 2015 19:04:31 +0100 Subject: [PATCH 100/525] Some refactoring in Common. - use implicits (even if the system if far from perfect). Note that some proofs tend to overspecify lemmas' arguments. - remove useless intermediate that can be proved by a single rewrite or apply, or simplify their proofs. - remove useless pre-conditions && split lemmas of the form `XXX => A1 && ... && An`. - some renamings (xxxE for alt. def., xxxP for specifications) - start using inductive predicates (note: `exists` should handle inductive predicates equiv. to existentials). --- proof/Common.ec | 185 ++++++++++++++++++++++-------------------------- 1 file changed, 83 insertions(+), 102 deletions(-) diff --git a/proof/Common.ec b/proof/Common.ec index c50e1c7..65ba799 100644 --- a/proof/Common.ec +++ b/proof/Common.ec @@ -1,11 +1,12 @@ (* -------------------------------------------------------------------- *) - require import Option Fun Pair Int IntExtra IntDiv Real List NewDistr. require import Ring StdRing StdOrder StdBigop BitEncoding. require (*--*) FinType BitWord LazyRP Monoid. (*---*) import IntID IntOrder Bigint Bigint.BIA IntDiv Dprod. require import NewLogic. +pragma +implicits. + (* -------------------------------------------------------------------- *) op r : { int | 2 <= r } as ge2_r. op c : { int | 0 < c } as gt0_c. @@ -75,23 +76,21 @@ proof. elim xs=> // z zs ih /=; have -> : 1 + size zs - 1 = size zs by ring. case (size zs <= 0)=> [le0_sz_zs | gt0_sz_zs]. have sz_zs_eq0 : size zs = 0 - by rewrite (ler_asym (size zs) 0); split=> // _; rewrite size_ge0. + by rewrite (@ler_asym (size zs) 0); split=> // _; rewrite size_ge0. by have -> : zs = [] by rewrite -size_eq0. case (zs = [])=> // zs_non_nil. elim ih=> // ->. -by rewrite (last_nonempty y z). +by rewrite (@last_nonempty y z). qed. (* -------------------------------------------------------------------- *) - clone export LazyRP as Perm with type D <- block * capacity, op d <- bdistr * Capacity.cdistr -rename - [module type] "RP" as "PRIMITIVE" - [module] "P" as "Perm". + rename + [module type] "RP" as "PRIMITIVE" + [module] "P" as "Perm". (* ------------------------- Padding/Unpadding ------------------------ *) - op chunk (bs : bool list) = BitChunking.chunk r bs. op num0 (n : int) = (-(n + 2)) %% r. @@ -129,51 +128,28 @@ lemma size_pad_equiv (m : int) : 0 <= m => m + num0 m + 2 = (m + 1) %/ r * r + r. proof. move=> ge0_m. -by rewrite modNz 1:/# 1:gt0_r -(addrA _ 2) /= modzE #ring. -qed. - -lemma num0_prop (m : int) : - 0 <= m => 0 <= num0 m < r /\ r %| (m + num0 m + 2). -proof. -move=> ge0_m. split. split=> [| _]. -by rewrite modz_ge0 1:gtr_eqF 1:gt0_r. rewrite ltz_pmod gt0_r. -rewrite (size_pad_equiv m) // dvdzD 1:dvdz_mull dvdzz. +by rewrite modNz 1:/# 1:gt0_r -(@addrA _ 2) /= modzE #ring. qed. -lemma num0_alt (n m : int) : - 0 <= m => 0 <= n < r => r %| (m + n + 2) => n = num0 m. -proof. -move=> ge0_m [ge0_n lt_rn] r_dvd_m_add_n_add2. -rewrite modNz 1:ltr_spaddr // 1:gt0_r. -have -> : m + 2 - 1 = ((m + n + 2) - (n + 1)) by algebra. -rewrite -modzDm; have -> /= : (m + n + 2) %% r = 0 by apply dvdzE. -rewrite modz_mod modNz 1:/# 1:gt0_r. -have -> : r - 1 - (r - 1 - (n + 1 - 1) %% r) = n %% r by algebra. -rewrite modz_small 1:gtr0_norm 1:gt0_r /#. -qed. - -lemma size_pad_raw (s : bool list) : +lemma size_padE (s : bool list) : size (pad s) = size s + num0 (size s) + 2. -proof. -rewrite /pad /mkpad /= -cats1 -cat1s 2!catA 3!size_cat /= - size_nseq 1:max_ler 1:modz_ge0 1:gtr_eqF 1:gt0_r // #ring. -qed. +proof. by rewrite /pad size_cat size_mkpad addrA. qed. lemma size_pad (s : bool list) : size (pad s) = (size s + 1) %/ r * r + r. -proof. by rewrite size_pad_raw size_pad_equiv 1:size_ge0. qed. +proof. by rewrite size_padE size_pad_equiv 1:size_ge0. qed. lemma size_pad_dvd_r s : r %| size (pad s). proof. by rewrite size_pad dvdzD 1:dvdz_mull dvdzz. qed. -lemma pad_alt (s : bool list, n : int) : - 0 <= n < r => r %| (size s + n + 2) => - pad s = s ++ [true] ++ nseq n false ++ [true]. -proof. -move=> [ge0_n lt_nr] mod. -rewrite /pad /mkpad /= -cats1 -cat1s 2!catA - (num0_alt n (size s)) // size_ge0. -qed. +lemma dvd_r_num0 (m : int) : r %| (m + num0 m + 2). +proof. by rewrite /num0 /(%|) addrAC modzDmr subrr mod0z. qed. + +lemma num0_ge0 (m : int) : 0 <= num0 m. +proof. by rewrite modz_ge0 ?gtr_eqF ?gt0_r. qed. + +lemma num0_ltr (m : int) : num0 m < r. +proof. by rewrite ltz_pmod gt0_r. qed. lemma index_true_behead_mkpad n : index true (behead (mkpad n)) = num0 n. @@ -182,6 +158,14 @@ rewrite /mkpad -cats1 index_cat mem_nseq size_nseq. by rewrite max_ler // modz_ge0 gtr_eqF ?gt0_r. qed. +lemma padE (s : bool list, n : int) : + 0 <= n < r => r %| (size s + n + 2) => + pad s = s ++ [true] ++ nseq n false ++ [true]. +proof. +move=> lt_0r dvdr; rewrite -!catA /pad /mkpad /= cats1 /num0. +by do! congr; rewrite -(dvdz_modzDr dvdr) modz_small 2:#ring /#. +qed. + lemma padK : pcancel pad unpad. proof. move=> s @/unpad; rewrite last_pad /= rev_cat rev_mkpad. @@ -191,7 +175,7 @@ have ^iE {1 2}->: i = (-(size s + 2)) %% r. by rewrite index_true_behead_mkpad. pose b := _ = size _; case b => @/b - {b}. rewrite modNz ?gt0_r ?ltr_spaddr ?size_ge0 //. - rewrite -(addrA _ 2) size_pad (addrC _ r) -!addrA => /addrI. + rewrite -(@addrA _ 2) size_pad (@addrC _ r) -!addrA => /addrI. rewrite addrCA /= -subr_eq0 -opprD oppr_eq0 addrC -divz_eq. by rewrite addz_neq0 ?size_ge0. move=> sz {sz}; rewrite /num0. @@ -207,14 +191,14 @@ lemma unpadK : ocancel unpad pad. proof. move=> s @/unpad; case: (last false s)=> //=. elim/last_ind: s=> //= s b ih {ih}; rewrite last_rcons => ->. -rewrite rev_rcons /= size_rcons -(inj_eq _ (addIr (-1))) /= ?addrK. +rewrite rev_rcons /= size_rcons -(inj_eq (addIr (-1))) /= ?addrK. pose i := index _ _; case: (i = size s)=> // ne_is @/pad @/num0. have lt_is: i < size s by rewrite ltr_neqAle ne_is -size_rev index_size. have [ge0_i lt_siz_s_i] : 0 <= i < size s. have le_siz_s_i : i <= size s by rewrite /i - size_rev index_size. split=> [| _]; [rewrite index_ge0 | rewrite ltr_neqAle //]. pose j := (size s + _ - _); case: (i = (-(j + 2)) %% r) => // iE. -apply/eq_sym; rewrite -{1}(cat_take_drop j (rcons _ _)); congr. +apply/eq_sym; rewrite -{1}(@cat_take_drop j (rcons _ _)); congr. have jE: j = size s - (i + 1) by rewrite /j #ring. have [ge0_j lt_js]: 0 <= j < size s by move=> /#. rewrite -cats1 drop_cat lt_js /= /mkpad -cats1 -cat_cons; congr=> //=. @@ -227,22 +211,24 @@ move/ler_eqVlt: ge0_k => [<-|] /=. by rewrite jE -nth_rev ?nth_index // -index_mem size_rev. move=> lt0_k; rewrite gtr_eqF //= nth_nseq 1:/#. have ->: j + k = (size s) - ((i-k) + 1) by rewrite /j #ring. -by rewrite -nth_rev 1:/# &(negbRL _ true) &(before_index) /#. +by rewrite -nth_rev 1:/# &(@negbRL _ true) &(before_index) /#. qed. -lemma nosmt unpad_prop (t : bool list) : - unpad t <> None <=> - exists (s : bool list, n : int), - (0 <= n < r /\ r %| (size s + n + 2)) && - t = s ++ [true] ++ nseq n false ++ [true]. +pred unpad_spec (t : bool list) = +| Unpad (s : bool list, n : int) of + (0 <= n < r) + & (r %| (size s + n + 2)) + & (t = s ++ [true] ++ nseq n false ++ [true]). + +lemma nosmt unpadP (t : bool list) : + unpad t <> None <=> unpad_spec t. proof. -split=> [unpd_neq_None | [s n [[range_n dvd] ->]]]. -have [u unpd_Some] : exists s, unpad t = Some s - by move: unpd_neq_None; case (unpad t)=> // x _; exists x. -have <- : pad u = t by rewrite -(unpadK t) unpd_Some. -exists u, (num0 (size u)); split=> [| [num0_rng dvd_num0]]. -by rewrite num0_prop size_ge0. by apply pad_alt. -by rewrite -pad_alt // padK. +split=> [|[s n lt_nr dvd ->]]; last by rewrite -padE ?padK. +case: {-2}(unpad _) (eq_refl (unpad t)) => // s /eq_sym sE _. +have ->: t = pad s by rewrite -(unpadK t) sE. +apply/(Unpad s (num0 (size s))). + by rewrite num0_ge0 num0_ltr. by rewrite dvd_r_num0. +by rewrite -padE ?dvd_r_num0 // num0_ge0 num0_ltr. qed. lemma size_chunk bs : size (chunk bs) = size bs %/ r. @@ -286,15 +272,15 @@ proof. by rewrite /blocks2bits map_cat flatten_cat. qed. lemma size_blocks2bits (xs : block list) : size (blocks2bits xs) = r * size xs. proof. -elim xs=> [| x xs ih]. -by rewrite blocks2bits_nil. -rewrite -cat1s blocks2bits_cat blocks2bits_sing size_cat // - size_cat size_tolist ih /= #ring. +elim: xs=> [| x xs ih]; first by rewrite blocks2bits_nil. +rewrite -cat1s blocks2bits_cat blocks2bits_sing size_cat //. +rewrite size_cat size_tolist ih /= #ring. qed. lemma size_blocks2bits_dvd_r (xs : block list) : r %| size(blocks2bits xs). -proof. rewrite size_blocks2bits dvdz_mulr dvdzz. qed. +proof. by rewrite size_blocks2bits dvdz_mulr dvdzz. qed. +(* -------------------------------------------------------------------- *) op bits2blocks (xs : bool list) : block list = map bits2w (chunk xs). lemma bits2blocks_nil : bits2blocks [] = []. @@ -302,10 +288,9 @@ proof. by rewrite /bits2blocks chunk_nil. qed. lemma bits2blocks_sing (xs : bool list) : size xs = r => bits2blocks xs = [bits2w xs]. -proof. move=> sz_xs_eq_r; by rewrite /bits2blocks chunk_sing. qed. +proof. by move=> sz_xs_eq_r; rewrite /bits2blocks chunk_sing. qed. -lemma bits2blocks_cat (xs ys : bool list) : - r %| size xs => r %| size ys => +lemma bits2blocks_cat (xs ys : bool list) : r %| size xs => r %| size ys => bits2blocks (xs ++ ys) = bits2blocks xs ++ bits2blocks ys. proof. move=> r_dvd_sz_xs r_dvd_sz_ys. @@ -314,37 +299,34 @@ qed. lemma blocks2bitsK : cancel blocks2bits bits2blocks. proof. - move=> xs;rewrite /blocks2bits /bits2blocks flattenK. - + by move=> b /mapP [x [_ ->]];rewrite size_tolist. - rewrite -map_comp -{2}(map_id xs) /(\o) /=;apply eq_map=> @/idfun x /=; - apply oflistK. +move=> xs; rewrite /blocks2bits /bits2blocks flattenK. + by move=> b /mapP [x [_ ->]];rewrite size_tolist. +rewrite -map_comp -{2}(@map_id xs) /(\o) /=. +by apply eq_map=> @/idfun x /=; apply oflistK. qed. lemma bits2blocksK (bs : bool list) : r %| size bs => blocks2bits(bits2blocks bs) = bs. proof. -move=> siz_bs_div_r. -rewrite /blocks2bits /bits2blocks -map_comp. +move=> dvd_r_bs; rewrite /blocks2bits /bits2blocks -map_comp. have map_tolistK : forall (xss : bool list list), (forall (xs : bool list), mem xss xs => size xs = r) => map (w2bits \o bits2w) xss = xss. - + elim => [// | xs yss ih mem_xs_cons_yss_siz_r /=]. - + split. - + apply tolistK; rewrite mem_xs_cons_yss_siz_r //. - + apply ih => zs mem_zss_zs. - + by rewrite mem_xs_cons_yss_siz_r /=; first right. -rewrite map_tolistK; [apply in_chunk_size | exact chunkK]. ++ elim=> [// | xs yss ih eqr_sz /=]; split. + by apply tolistK; rewrite eqr_sz. + by apply/ih => zs mem_zss_zs; rewrite eqr_sz //=; right. +by rewrite map_tolistK; [apply in_chunk_size | exact chunkK]. qed. +(* -------------------------------------------------------------------- *) op pad2blocks : bool list -> block list = bits2blocks \o pad. op unpad_blocks : block list -> bool list option = unpad \o blocks2bits. lemma pad2blocksK : pcancel pad2blocks unpad_blocks. proof. -move=> xs. -by rewrite /pad2blocks /unpad_blocks /(\o) bits2blocksK - 1:size_pad_dvd_r padK. +move=> xs @/pad2blocks @/unpad_blocks @/(\o). +by rewrite bits2blocksK 1:size_pad_dvd_r padK. qed. lemma unpadBlocksK : ocancel unpad_blocks pad2blocks. @@ -361,7 +343,6 @@ by rewrite /bs blocks2bitsK. qed. (* ------------------------ Extending/Stripping ----------------------- *) - op extend (xs : block list) (n : int) = xs ++ nseq n b0. @@ -371,7 +352,7 @@ op strip (xs : block list) = lemma strip_ge0 (xs : block list) : 0 <= (strip xs).`2. -proof. rewrite /strip /= find_ge0. qed. +proof. by rewrite /strip /= find_ge0. qed. lemma extendK (xs : block list) (n : int) : last b0 xs <> b0 => 0 <= n => strip(extend xs n) = (xs, n). @@ -388,14 +369,14 @@ have not_has_p_nseq : ! has p (nseq n b0) by rewrite has_nseq. have -> : find p (nseq n b0 ++ head b0 (rev xs) :: behead (rev xs)) = n. rewrite find_cat not_has_p_nseq /= size_nseq max_ler //. have -> // : p (head b0 (rev xs)) by trivial. -by rewrite (addzC n) addNz /= take_size_cat. +by rewrite (@addzC n) addNz /= take_size_cat. qed. lemma stripK (xs : block list) : extend (strip xs).`1 (strip xs).`2 = xs. proof. rewrite /extend /strip eq_sym /=; pose i := find _ _. -rewrite -{1}(cat_take_drop (size xs - i) xs); congr. +rewrite -{1}(@cat_take_drop (size xs - i) xs); congr. have [ge0_i le_ixs]: 0 <= i <= size xs. by rewrite find_ge0 -size_rev find_size. have sz_drop: size (drop (size xs - i) xs) = i. @@ -426,10 +407,10 @@ lemma nosmt valid_block_prop (xs : block list) : proof. rewrite /valid_block /unpad_blocks /(\o). split=> [vb | [s n] [rng_n b2b]]. -have [up _] := (unpad_prop (blocks2bits xs)). -rewrite vb /= in up; elim up=> [s n] [[rng_n _] b2b]. +have [up _] := (unpadP (blocks2bits xs)). +rewrite vb /= in up; case: up=> [s n rng_n _ b2b]. by exists s, n. -apply unpad_prop; exists s, n; split=> //; split=> //. +apply unpadP; apply (Unpad s n)=> //. have <- : size (blocks2bits xs) = size s + n + 2 by rewrite b2b 3!size_cat /= size_nseq max_ler /#ring. rewrite size_blocks2bits_dvd_r. @@ -494,13 +475,13 @@ have sz_s_pad_dvd_r : r %| (size s + n + 2). have sz_tke_dvd_r : r %| size tke by rewrite sz_tke dvdz_mull dvdzz. have sz_drp_plus_n_plus_2_dvd_r : r %| (size drp + n + 2). rewrite sz_drp dvdzE - -(dvdz_modzDl (size s %/ r * r) (size s %% r + n + 2) r) + -(@dvdz_modzDl (size s %/ r * r) (size s %% r + n + 2) r) 1:dvdz_mull 1:dvdzz. have -> : size s %/ r * r + (size s %% r + n + 2) = size s + n + 2. rewrite {3}sz_s_divz_eq #ring. by rewrite -dvdzE. have xs_eq : xs = bits2blocks(s ++ [true] ++ nseq n false ++ [true]) by rewrite -blocks2bitsK b2b_xs_eq. -rewrite -(cat_take_drop (size s %/ r * r) s) -!catA -/tke -/drp +rewrite -(@cat_take_drop (size s %/ r * r) s) -!catA -/tke -/drp bits2blocks_cat in xs_eq. + rewrite sz_tke_dvd_r. rewrite !size_cat /= size_nseq max_ler 1:ge0_n. + have -> : size drp + (1 + (n + 1)) = size drp + n + 2 by ring. @@ -508,13 +489,13 @@ rewrite -(cat_take_drop (size s %/ r * r) s) -!catA -/tke -/drp case: (n = r - 1)=> [n_eq_r_min1 | n_neq_r_min1]. right. have sz_drp_plus1_dvd_r : r %| (size drp + 1). - rewrite dvdzE -(addz0 (size drp + 1)) -{1}(modzz r). + rewrite dvdzE -(@addz0 (size drp + 1)) -{1}(@modzz r). have {1}-> : r = n + 1 by smt ml=0. rewrite modzDmr. have -> : size drp + 1 + (n + 1) = size drp + n + 2 by ring. by rewrite -dvdzE. have sz_drp_plus1_eq_r : size drp + 1 = r. - rewrite (dvdz_close (size drp + 1)) //. + rewrite (@dvdz_close (size drp + 1)) //. split=> [| _]; first rewrite ltr_paddl 1:size_ge0 ltr01. have -> : 2 * r = r + r by ring. rewrite ltr_add // 1:sz_drp 1:ltz_pmod 1:gt0_r ltzE ge2_r. @@ -523,10 +504,10 @@ exists (bits2blocks tke), (bits2w (nseq n false ++ [true])). split. rewrite xs_eq. -rewrite (catA drp [true]) bits2blocks_cat 1:size_cat // +rewrite (@catA drp [true]) bits2blocks_cat 1:size_cat // 1:size_cat 1:size_nseq 1:max_ler 1:ge0_n /= 1:/#. -rewrite (bits2blocks_sing (drp ++ [true])) 1:size_cat //. -rewrite (bits2blocks_sing (nseq n false ++ [true])). +rewrite (@bits2blocks_sing (drp ++ [true])) 1:size_cat //. +rewrite (@bits2blocks_sing (nseq n false ++ [true])). rewrite size_cat size_nseq max_ler /= 1:ge0_n /#. by rewrite catA. do 2! rewrite tolistK 1:size_cat //=. @@ -537,16 +518,16 @@ have lt_n_r_min1 : n < r - 1 by smt ml=0. left. move: xs_eq. have sz_drp_plus_n_plus_2_eq_r : size drp + n + 2 = r. - rewrite (dvdz_close (size drp + n + 2)) // sz_drp. + rewrite (@dvdz_close (size drp + n + 2)) // sz_drp. have n_plus2_rng : 2 <= n + 2 <= r by smt ml=0. rewrite -addrA; split=> [| _]. rewrite ltr_paddl 1:modz_ge0 1:gtr_eqF 1:gt0_r // /#. have ->: 2 * r = r + r by ring. have -> : r + r = (r - 1) + (r + 1) by ring. rewrite ler_lt_add 1:-ltzS 1:-addrA /= 1:ltz_pmod 1:gt0_r. - by rewrite -(ltr_add2r (-2)) -2!addrA. + by rewrite -(@ltr_add2r (-2)) -2!addrA. move=> xs_eq. -rewrite (bits2blocks_sing +rewrite (@bits2blocks_sing (drp ++ ([true] ++ (nseq n false ++ [true])))) in xs_eq. + rewrite !size_cat /= size_nseq max_ler 1:ge0_n 1:sz_drp. @@ -568,7 +549,7 @@ split; first smt ml=0 w=(gt0_r). rewrite xs_eq blocks2bits_cat; have -> : [y; z] = [y] ++ [z] by trivial. rewrite blocks2bits_cat 2!blocks2bits_sing -!catA; congr. have {1}-> : w2bits y = take (r - 1) (w2bits y) ++ [true]. - rewrite -{1}(cat_take_drop (r - 1) (w2bits y)); congr. + rewrite -{1}(@cat_take_drop (r - 1) (w2bits y)); congr. elim (last_drop_all_but_last false (w2bits y))=> [w2b_y_nil | drop_w2b_y_last]. have not_lst_w2b_y : ! last false (w2bits y) by rewrite w2b_y_nil. @@ -588,7 +569,7 @@ lemma nosmt valid_absorb_prop (xs : block list) : proof. rewrite /valid_absorb; split=> [strp_xs_valid | [ys n] [ge0_n [-> vb_ys]]]. exists (strip xs).`1, (strip xs).`2. -split; [apply (strip_ge0 xs) | split=> //]. -by rewrite -/(extend (strip xs).`1 (strip xs).`2) eq_sym (stripK xs). +split; [apply (@strip_ge0 xs) | split=> //]. +by rewrite -/(extend (strip xs).`1 (strip xs).`2) eq_sym (@stripK xs). by rewrite -/(extend ys n) extendK 1:valid_block_ends_not_b0. qed. From 5a1e62c8bc3dae5014de8ad5403d86121303b143 Mon Sep 17 00:00:00 2001 From: Pierre-Yves Strub Date: Tue, 22 Dec 2015 21:21:05 +0100 Subject: [PATCH 101/525] Examplify `case _: ...`. --- proof/Common.ec | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/proof/Common.ec b/proof/Common.ec index 65ba799..48326ff 100644 --- a/proof/Common.ec +++ b/proof/Common.ec @@ -224,7 +224,7 @@ lemma nosmt unpadP (t : bool list) : unpad t <> None <=> unpad_spec t. proof. split=> [|[s n lt_nr dvd ->]]; last by rewrite -padE ?padK. -case: {-2}(unpad _) (eq_refl (unpad t)) => // s /eq_sym sE _. +case _: (unpad t) => // s sE _. have ->: t = pad s by rewrite -(unpadK t) sE. apply/(Unpad s (num0 (size s))). by rewrite num0_ge0 num0_ltr. by rewrite dvd_r_num0. From 990d7ba5c7ff60a33198435ae08bca640b99ff19 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Mon, 28 Dec 2015 09:08:12 +0100 Subject: [PATCH 102/525] progress --- proof/old/MyRO.ec | 752 +++++++++++++++++++++++++--------------------- 1 file changed, 417 insertions(+), 335 deletions(-) diff --git a/proof/old/MyRO.ec b/proof/old/MyRO.ec index 8da2d87..b373634 100644 --- a/proof/old/MyRO.ec +++ b/proof/old/MyRO.ec @@ -1,161 +1,67 @@ -require import Option List FSet NewFMap. +require import Pair Option List FSet NewFMap. import NewLogic Fun. +require IterProc. -(* TODO: move this *) -lemma set_eq (m:('a,'b)fmap) x y: m.[x] = Some y => m.[x<-y] = m. -proof. - by rewrite fmapP=> Hx x';rewrite getP;case (x'=x)=>//->;rewrite Hx. -qed. - -lemma oflistK_uniq (s : 'a list) : uniq s => - perm_eq s (elems (oflist s)). -proof. by move/undup_id => {1}<-; apply/FSet.oflistK. qed. - -lemma setD1E (s : 'a fset) x : - perm_eq (elems (s `\` fset1 x)) (rem x (elems s)). -proof. -rewrite setDE; pose s' := List.filter _ _; apply/(perm_eq_trans s'). - rewrite perm_eq_sym oflistK_uniq ?filter_uniq ?uniq_elems. -rewrite /s' rem_filter ?uniq_elems; apply/uniq_perm_eq; - rewrite ?filter_uniq ?uniq_elems // => y. -by rewrite !mem_filter /predC in_fset1. -qed. +(* FIXME notation *) +abbrev ([+]) ['a 'b](x : 'b) = fun (_ : 'a) => x. -lemma perm_to_rem (s:'a fset) x : - mem s x => perm_eq (elems s) (x :: elems (s `\` fset1 x)). -proof. -rewrite memE => /perm_to_rem /perm_eqlP->; apply/perm_cons. -have /perm_eqlP <- := (setD1E s x); rewrite perm_eq_refl. -qed. - -lemma mem_drop (s:'a list) n x: mem (drop n s) x => mem s x. -proof. by rewrite -{2}(cat_take_drop n) mem_cat=>->. qed. +type flag = [ Unknown | Known ]. -lemma mem_take (s:'a list) n x: mem (take n s) x => mem s x. -proof. by rewrite -{2}(cat_take_drop n) mem_cat=>->. qed. -(* end TODO *) +lemma neqK_eqU f : f <> Known <=> f = Unknown. +proof. by case: f. qed. -abstract theory Titer. +op in_dom_with (m:('from, 'to * 'flag)fmap) (x:'from) (f:'flag) = + mem (dom m) x /\ (oget (m.[x])).`2 = f. -type t. +op restr f (m:('from, 'to * 'flag)fmap) = + let m = filter (fun _ (p:'to*'flag) => p.`2=f) m in + map (fun _ (p:'to*'flag) => p.`1) m. -module type Orcl = { - proc f (x:t) : unit -}. +lemma restrP (m:('from, 'to * 'flag)fmap) f x: + (restr f m).[x] = + obind (fun (p:'to*'flag)=>if p.`2=f then Some p.`1 else None) m.[x]. +proof. + rewrite /restr /= mapP filterP in_dom /=. + by case (m.[x])=>//= -[x0 f'];rewrite oget_some /=;case (f' = f). +qed. -module Iter (O:Orcl) = { - proc iter(l:t list) = { - while (l <> []) { - O.f(head witness l); - l <- drop 1 l; - } - } -}. +lemma dom_restr (m:('from, 'to * 'flag)fmap) f x: + mem (dom(restr f m)) x <=> in_dom_with m x f. +proof. + rewrite /in_dom_with !in_dom;case: (m.[x]) (restrP m f x)=>//= -[t f'] /=. + by rewrite oget_some /=;case (f' = f)=> [_ ->|]. +qed. -lemma iter_ll(O<:Orcl): islossless O.f => islossless Iter(O).iter. +lemma restr_set (m:('from, 'to * 'flag)fmap) f1 f2 x y: + restr f1 m.[x<-(y,f2)] = if f1 = f2 then (restr f1 m).[x<-y] else rem x (restr f1 m). proof. - move=> O_ll;proc;inline Iter(O).iter. - while true (size l);auto=>/=. - + call O_ll;skip=> /=?[*]Hl<-;smt ml=0 w=(size_eq0 size_ge0 size_drop). - smt ml=0 w=(size_eq0 size_ge0). + rewrite fmapP;case (f1=f2)=>[->|Hneq]x0;rewrite !(restrP,getP);1: by case (x0=x). + case (x0=x)=>[->|Hnx];1:by rewrite (eq_sym f2) Hneq remP_eq. + by rewrite remP Hnx restrP. qed. -section. - -declare module O:Orcl. +lemma restr_set_eq (m:('from, 'to * 'flag)fmap) f x y: + restr f m.[x<-(y,f)] = (restr f m).[x<-y]. +proof. by rewrite restr_set. qed. -axiom iter_swap1 i1 i2: - equiv [Iter(O).iter ~ Iter(O).iter : - l{1} = [i1;i2] /\ l{2} = [i2;i1] /\ ={glob O} ==> ={glob O}]. +lemma restr0 f : restr f map0<:'from, 'to * 'flag> = map0. +proof. by apply fmapP=>x;rewrite restrP !map0P. qed. -lemma iter_swap s1 i s2: - equiv [Iter(O).iter ~ Iter(O).iter : - l{1} = i::s1++s2 /\ l{2} = s1++i::s2 /\ ={glob O} ==> ={glob O}]. +lemma restr_set_neq f2 f1 (m:('from, 'to * 'flag)fmap) x y: + !mem (dom m) x => + f2 <> f1 => restr f1 m.[x<-(y,f2)] = restr f1 m. proof. - elim:s1=> /=[|i' s1 Hrec];1:by sim. - transitivity Iter(O).iter - (l{1}= i :: i' :: (s1 ++ s2) /\ l{2} = i' :: i :: (s1 ++ s2) /\ ={glob O} ==> - ={glob O}) - (l{1}= i' :: i :: (s1 ++ s2) /\ l{2} = i' :: (s1 ++ i::s2) /\ ={glob O} ==> - ={glob O})=>//. - + by move=> ?&mr[*]<*>;exists (glob O){mr}, (i' :: i :: (s1 ++ s2)). - + proc;rcondt{1}1=>//;rcondt{2}1=>//. - rcondt{1}3;1:by auto;conseq(_: true). - rcondt{2}3;1:by auto;conseq(_: true). - seq 4 4 : (={l,glob O});last by sim. - transitivity{1} {Iter(O).iter([i;i']); l <- drop 2 l;} - (l{1} = i :: i' :: (s1 ++ s2) /\ ={l, glob O} ==> ={l,glob O}) - (l{1} = i :: i' :: (s1 ++ s2) /\ - l{2} = i' :: i :: (s1 ++ s2) /\ ={glob O} ==> ={l,glob O})=>//. - + by move=>?&mr[*]<*>;exists (glob O){mr}, (i :: i' :: (s1 ++ s2)). - + inline *;rcondt{2} 2;1:by auto. - rcondt{2} 4;1:by auto;sp;conseq(_:true). - rcondf{2} 6; auto;call(_:true);wp;call(_:true);auto. - transitivity{1} {Iter(O).iter([i';i]); l <- drop 2 l;} - (l{1} = i :: i' :: (s1 ++ s2) /\ - l{2} = i' :: i :: (s1 ++ s2) /\ ={glob O} ==> ={l,glob O}) - (l{2} = i' :: i :: (s1 ++ s2) /\ ={l, glob O} ==> ={l,glob O})=>//. - + by move=>?&mr[*]<*>;exists (glob O){mr}, (i' :: i :: (s1 ++ s2)). - + wp; by call (iter_swap1 i i'). - (* call iter_swap1: FIXME catch exception *) - inline *;rcondt{1} 2;1:by auto. - rcondt{1} 4;1:by auto;sp;conseq(_:true). - rcondf{1} 6; auto;call(_:true);wp;call(_:true);auto. - proc;rcondt{1}1=>//;rcondt{2}1=>//. - seq 2 2 : (l{1} = i :: (s1 ++ s2) /\ l{2} = s1 ++ i :: s2 /\ ={glob O}). - + by wp;call(_:true);auto;progress;rewrite drop0. - transitivity{1} {Iter(O).iter(l); } - (={l,glob O} /\ l{1}= i::(s1++s2) ==> ={glob O}) - (={glob O} /\ l{1}=i::(s1++s2) /\ l{2}= (s1++i::s2) ==> ={glob O})=>//. - + by move=>?&mr[*]<*>;exists (glob O){mr}, (i :: (s1 ++ s2)). - + by inline *;sim. - transitivity{1} {Iter(O).iter(l); } - (={glob O} /\ l{1}=i::(s1++s2) /\ l{2}= (s1++i::s2) ==> ={glob O}) - (={l,glob O} /\ l{2}= (s1++i::s2) ==> ={glob O})=>//. - + by move=>?&mr[*]<*>;exists (glob O){mr}, (s1 ++ i::s2). - + by call Hrec;auto. - by inline*;sim. + by move=>Hm Hneq;rewrite restr_set(eq_sym f1)Hneq rem_id//dom_restr/in_dom_with Hm. qed. -lemma iter_perm : - equiv [Iter(O).iter ~ Iter(O).iter : perm_eq l{1} l{2} /\ ={glob O} ==> ={glob O}]. +lemma restr_rem (m:('from,'to*'flag)fmap) x f: + restr f (rem x m) = + if in_dom_with m x f then rem x (restr f m) else restr f m. proof. - exists*l{1},l{2};elim*=>l1 l2;case (perm_eq l1 l2)=> Hp;last first. - + conseq (_:false==>_)=>// ??[*]//. - elim: l1 l2 Hp=> [|i s1 ih] s2 eq_s12 /=. - + have ->: s2 = [] by apply/perm_eq_small/perm_eq_sym. - proc;rcondf{1} 1=>//;rcondf{2} 1=>//. - have/perm_eq_mem/(_ i) := eq_s12; rewrite mem_head /=. - move/splitPr => [s3 s4] ->>. - transitivity Iter(O).iter - (l{1}=i::s1 /\ l{2}=i::(s3++s4) /\ ={glob O} ==> ={glob O}) - (l{1}=i::(s3++s4) /\ l{2}=s3++i::s4 /\ ={glob O} ==> ={glob O})=>//. - + by move=>?&mr[*]-> -> _ ->; exists (glob O){mr}, (i :: (s3 ++ s4)). - + proc;rcondt{1}1=>//;rcondt{2}1=>//. - seq 2 2: (s1 = l{1} /\ l{2}=s3++s4 /\ ={glob O}). - + by wp;call(_:true);auto;progress;rewrite drop0. - transitivity{1} {Iter(O).iter(l); } - (={l,glob O} ==> ={glob O}) - (s1 = l{1} /\ l{2} = s3 ++ s4 /\ ={glob O} ==> ={glob O})=>//. - + by move=>?&mr[*]-> -> ->;exists (glob O){mr}, l{1}. - + by inline Iter(O).iter;sim. - transitivity{1} {Iter(O).iter(l); } - (s1 = l{1} /\ l{2} = s3 ++ s4 /\ ={glob O} ==> ={glob O}) - (={l,glob O} ==> ={glob O}) =>//. - + by move=>?&mr[*]-> -> ->;exists (glob O){mr}, (s3++s4). - + move: eq_s12; rewrite -(cat1s i s4) catA perm_eq_sym. - rewrite perm_catCA /= perm_cons perm_eq_sym=> Hp. - + call (ih (s3++s4) Hp)=>//. - by inline Iter(O).iter;sim. - by apply (iter_swap s3 i s4). (* FIXME: apply iter_swap fail! *) + rewrite fmapP=>z;rewrite restrP;case (in_dom_with m x f); + rewrite !(restrP,remP) /in_dom_with in_dom /#. qed. -end section. - -end Titer. - -type flag = [ Unknown | Known ]. - abstract theory Ideal. type from, to. @@ -166,61 +72,60 @@ module type RO = { proc init () : unit proc get (x : from) : to proc set (x : from, y : to) : unit + proc rem (x : from) : unit + proc sample(x : from) : unit +}. + +module type RO_Distinguisher(G : RO) = { + proc distinguish(): bool +}. + +module type FRO = { + proc init () : unit + proc get (x : from) : to + proc set (x : from, y : to) : unit + proc rem (x : from) : unit proc sample(x : from) : unit proc in_dom(x : from,f : flag) : bool proc restrK() : (from,to)fmap }. -module type Distinguisher(G : RO) = { +module type FRO_Distinguisher(G : FRO) = { proc distinguish(): bool }. -op in_dom_with (m:(from, to * flag)fmap) (x:from) (f:flag) = - mem (dom m) x /\ (oget (m.[x])).`2 = f. +(* -------------------------------------------------------------------------- *) +module RO : RO = { + var m : (from, to)fmap -op restr f (m:(from, to * flag)fmap) = - let m = filter (fun _ (p:to*flag) => p.`2=f) m in - map (fun _ (p:to*flag) => p.`1) m. + proc init () = { m <- map0; } -lemma restrP m f x: - (restr f m).[x] = - obind (fun (p:to*flag)=>if p.`2=f then Some p.`1 else None) m.[x]. -proof. - rewrite /restr /= mapP filterP in_dom /=. - by case (m.[x])=>//= -[x0 f'];rewrite oget_some /=;case (f' = f). -qed. + proc get(x:from) = { + var r; + r <$ sampleto x; + if (!mem (dom m) x) m.[x] <- r; + return (oget m.[x]); + } -lemma restr_dom m f x: - mem (dom(restr f m)) x <=> (mem (dom m) x /\ (oget m.[x]).`2 = f). -proof. - rewrite !in_dom;case: (m.[x]) (restrP m f x)=>//= -[t f'] /=. - by rewrite oget_some /=;case (f' = f)=> [_ ->|]. -qed. + proc set (x:from, y:to) = { + m.[x] <- y; + } -lemma restr_set m f1 f2 x y: - restr f1 m.[x<-(y,f2)] = if f1 = f2 then (restr f1 m).[x<-y] else rem x (restr f1 m). -proof. - rewrite fmapP;case (f1=f2)=>[->|Hneq]x0;rewrite !(restrP,getP);1: by case (x0=x). - case (x0=x)=>[->|Hnx];1:by rewrite (eq_sym f2) Hneq remP_eq. - by rewrite remP Hnx restrP. -qed. + proc rem (x:from) = { + m <- rem x m; + } -lemma restr_set_eq m f x y: - restr f m.[x<-(y,f)] = (restr f m).[x<-y]. -proof. by rewrite restr_set. qed. + proc sample(x:from) = { + get(x); + } -lemma restr0 f : restr f map0 = map0. -proof. by apply fmapP=>x;rewrite restrP !map0P. qed. + proc restrK() = { + return m; + } -lemma restr_set_neq f2 f1 m x y: - !mem (dom m) x => - f2 <> f1 => restr f1 m.[x<-(y,f2)] = restr f1 m. -proof. - by move=>Hm Hneq;rewrite restr_set (eq_sym f1) Hneq rem_id//restr_dom Hm. -qed. +}. -(* -------------------------------------------------------------------------- *) -module RO : RO = { +module FRO : FRO = { var m : (from, to * flag)fmap proc init () = { m <- map0; } @@ -237,10 +142,14 @@ module RO : RO = { m.[x] <- (y,Known); } + proc rem (x:from) = { + m <- rem x m; + } + proc sample(x:from) = { var c; - c <$ sampleto x; - m.[x] <- (c,Unknown); + c <$ sampleto x; + if (!mem (dom m) x) m.[x] <- (c,Unknown); } proc in_dom(x:from, f:flag) = { @@ -250,323 +159,496 @@ module RO : RO = { proc restrK() = { return restr Known m; } + }. +equiv RO_FRO_init : RO.init ~ FRO.init : true ==> RO.m{1} = map (+fst) FRO.m{2}. +proof. by proc;auto=>/=;rewrite map_map0. qed. + +equiv RO_FRO_get : RO.get ~ FRO.get : + ={x} /\ RO.m{1} = map (+fst) FRO.m{2} ==> ={res} /\ RO.m{1} = map (+fst) FRO.m{2}. +proof. + proc;auto=>?&ml[]->->/=?->/=. + rewrite !dom_map !map_set/fst/= getP_eq oget_some;progress. + + by rewrite mapP oget_omap_some // -in_dom. + by apply /eq_sym/set_eq;rewrite get_oget?dom_map// mapP oget_omap_some// -in_dom. +qed. + +equiv RO_FRO_set : RO.set ~ FRO.set : + ={x,y} /\ RO.m{1} = map (+fst) FRO.m{2} ==> RO.m{1} = map (+fst) FRO.m{2}. +proof. by proc;auto=>?&ml[*]3!->;rewrite map_set. qed. + +equiv RO_FRO_rem : RO.rem ~ FRO.rem : + ={x} /\ RO.m{1} = map (+fst) FRO.m{2} ==> RO.m{1} = map (+fst) FRO.m{2}. +proof. by proc;auto=>??;rewrite map_rem. qed. + +equiv RO_FRO_sample : RO.sample ~ FRO.sample : + ={x} /\ RO.m{1} = map (+fst) FRO.m{2} ==> RO.m{1} = map (+fst) FRO.m{2}. +proof. + by proc;inline *;auto=>?&ml[]2!->/=?->;rewrite dom_map/= map_set. +qed. + +lemma RO_FRO_D (D<:RO_Distinguisher{RO,FRO}) : + equiv [D(RO).distinguish ~ D(FRO).distinguish : + ={glob D} /\ RO.m{1} = map (+fst) FRO.m{2} ==> + ={glob D} /\ RO.m{1} = map (+fst) FRO.m{2} ]. +proof. + proc (RO.m{1} = map (+fst) FRO.m{2})=>//. + + by conseq RO_FRO_init. + by conseq RO_FRO_get. + by conseq RO_FRO_set. + + by conseq RO_FRO_rem. + by conseq RO_FRO_sample. +qed. + section LL. -lemma init_ll : islossless RO.init. +lemma RO_init_ll : islossless RO.init. proof. by proc;auto. qed. -lemma in_dom_ll : islossless RO.in_dom. +lemma FRO_init_ll : islossless FRO.init. +proof. by proc;auto. qed. + +lemma FRO_in_dom_ll : islossless FRO.in_dom. proof. by proc. qed. -lemma restrK_ll : islossless RO.restrK. +lemma FRO_restrK_ll : islossless FRO.restrK. proof. by proc. qed. -lemma set_ll : islossless RO.set. +lemma RO_set_ll : islossless RO.set. +proof. by proc;auto. qed. + +lemma FRO_set_ll : islossless FRO.set. proof. by proc;auto. qed. axiom sampleto_ll : forall x, Distr.weight (sampleto x) = 1%r. -lemma get_ll : islossless RO.get. +lemma RO_get_ll : islossless RO.get. +proof. by proc;auto;progress;apply sampleto_ll. qed. + +lemma FRO_get_ll : islossless FRO.get. proof. by proc;auto;progress;apply sampleto_ll. qed. -lemma sample_ll : islossless RO.sample. +lemma RO_sample_ll : islossless RO.sample. +proof. by proc;call RO_get_ll. qed. + +lemma FRO_sample_ll : islossless FRO.sample. proof. by proc;auto;progress;apply sampleto_ll. qed. end section LL. end Ideal. - (* -------------------------------------------------------------------------- *) + abstract theory GenEager. clone include Ideal. axiom sampleto_ll : forall x, Distr.weight (sampleto x) = 1%r. -clone include Titer with type t <- from. +clone include IterProc with type t <- from. -module ERO : RO = { +(** A module that resample query if the associate value is unknown *) +module RRO : FRO = { - proc init = RO.init + proc init = FRO.init proc get(x:from) = { var r; r <$ sampleto x; - if (!mem (dom RO.m) x || (oget RO.m.[x]).`2 = Unknown) { - RO.m.[x] <- (r,Known); + if (!mem (dom FRO.m) x || (oget FRO.m.[x]).`2 = Unknown) { + FRO.m.[x] <- (r,Known); } - return (oget RO.m.[x]).`1; + return (oget FRO.m.[x]).`1; } - proc set = RO.set + proc set = FRO.set + + proc rem = FRO.rem - proc sample = RO.sample + proc sample = FRO.sample - proc in_dom = RO.in_dom + proc in_dom = FRO.in_dom - proc restrK = RO.restrK + proc restrK = FRO.restrK module I = { - proc f = sample + proc f (x:from) = { + var c; + c <$ sampleto x; + FRO.m.[x] <- (c,Unknown); + } } proc resample () = { - Iter(I).iter (elems (dom (restr Unknown RO.m))); + Iter(I).iter (elems (dom (restr Unknown FRO.m))); } }. -lemma resample_ll : islossless ERO.resample. +(* A module which is lazy on sample *) +module LRO : RO = { + + proc init = RO.init + + proc get = RO.get + + proc set = RO.set + + proc rem = RO.rem + + proc sample(x:from) = {} + +}. + +lemma RRO_resample_ll : islossless RRO.resample. proof. - proc;call (iter_ll ERO.I _)=>//;apply (sample_ll sampleto_ll). + proc;call (iter_ll RRO.I _)=>//;proc;auto=>/=?;apply sampleto_ll. qed. lemma eager_init : - eager [ERO.resample(); , RO.init ~ ERO.init, ERO.resample(); : - ={RO.m} ==> ={RO.m} ]. + eager [RRO.resample(); , FRO.init ~ RRO.init, RRO.resample(); : + ={FRO.m} ==> ={FRO.m} ]. proof. eager proc. inline{2} *;rcondf{2}3;auto=>/=. + by move=>?_;rewrite restr0 dom0 elems_fset0. - by conseq (_:) (_:true==>true: =1%r) _=>//;call resample_ll. + by conseq (_:) (_:true==>true: =1%r) _=>//;call RRO_resample_ll. qed. lemma iter_perm2 (i1 i2 : from): - equiv[ Iter(ERO.I).iter ~ Iter(ERO.I).iter : - l{1} = [i1; i2] /\ l{2} = [i2; i1] /\ ={glob ERO.I} ==> - ={glob ERO.I}]. + equiv[ Iter(RRO.I).iter_12 ~ Iter(RRO.I).iter_21 : + ={glob RRO.I, t1, t2} ==> ={glob RRO.I}]. proof. - proc;rcondt{1}1=>//;rcondt{2}1=>//. - rcondt{1}3;1:by auto;conseq(_:true). - rcondt{2}3;1:by auto;conseq(_:true). - seq 4 4 : (={l,RO.m});2:by sim. - case (i1=i2);1:by sim. - inline *;swap[4..5]-2;swap{2} 6-2;auto=>?&mr[*]3!<*>Hneq/=?->?->/=. - by rewrite set_set Hneq. + proc;inline *;case ((t1=t2){1});1:by auto. + by swap{2}[4..5]-3;auto=> &ml&mr[*]3!->neq/=?->?->;rewrite set_set neq. qed. lemma eager_get : - eager [ERO.resample(); , RO.get ~ ERO.get, ERO.resample(); : - ={x,RO.m} ==> ={res,RO.m} ]. + eager [RRO.resample(); , FRO.get ~ RRO.get, RRO.resample(); : + ={x,FRO.m} ==> ={res,FRO.m} ]. proof. eager proc. - wp;case ((mem (dom RO.m) x /\ (oget RO.m.[x]).`2=Known){1}). + wp;case ((mem (dom FRO.m) x /\ (oget FRO.m.[x]).`2=Known){1}). + rnd{1};rcondf{2} 2;1:by auto=> /#. - alias{1} 1 mx = oget RO.m.[x];inline *. - while (={l,RO.m} /\ (!mem l x /\ RO.m.[x] = Some (mx.`1,Known)){1}). + exists * ((oget FRO.m.[x{2}]){1}). +;inline RRO.resample. + cut := iter_inv RRO.I (fun z=>x{1}<>z) (fun m1 m2 => m1 = m2 /\ . + print iter_inv. + while (={l,FRO.m} /\ (!mem l x /\ FRO.m.[x] = Some (mx.`1,Known)){1}). + auto=>?&mr[*]-> ->;case (l{mr})=>//=x2 l2 Hmx Hgx?->. by rewrite getP drop0 /#. auto=>??[*]-> ->/= Hmem HK;rewrite sampleto_ll/==> r _. - rewrite -memE restr_dom Hmem/= HK. + rewrite -memE dom_restr Hmem/= HK. rewrite {1}get_oget //= -HK;case:(oget _)HK=> x1?/=->. by move=>????-> _[*]_-> _ Heq?;rewrite in_dom set_eq Heq. rcondt{2} 2. + auto=> ?[*]-> ->;rewrite negb_and /#. - case ((mem (dom RO.m) x){1}). - + inline{1} ERO.resample=>/=;rnd{1}. - transitivity{1} { Iter(ERO.I).iter(x::elems ((dom (restr Unknown RO.m)) `\` fset1 x)); - } - (={x,RO.m} /\ mem (dom RO.m{1}) x{1} /\ (oget RO.m{1}.[x{1}]).`2 = Unknown ==> - ={x,RO.m}) - (={x,RO.m} /\ mem (dom RO.m{1}) x{1} /\ (oget RO.m{1}.[x{1}]).`2 = Unknown==> - ={x} /\ eq_except RO.m{1} RO.m{2} (fset1 x{1}) /\ - RO.m{1}.[x{2}] = Some (result{2},Unknown) /\ - RO.m{2}.[x{2}] = Some (result{2},Known)). - + by move=>?&mr[*]-> -> ??;exists RO.m{mr}, x{mr}=>/#. + case ((mem (dom FRO.m) x){1}). + + inline{1} RRO.resample=>/=;rnd{1}. + transitivity{1} + { Iter(RRO.I).iter(x::elems ((dom (restr Unknown FRO.m)) `\` fset1 x)); } + (={x,FRO.m} /\ mem (dom FRO.m{1}) x{1} /\ (oget FRO.m{1}.[x{1}]).`2 = Unknown ==> + ={x,FRO.m}) + (={x,FRO.m} /\ mem (dom FRO.m{1}) x{1} /\ (oget FRO.m{1}.[x{1}]).`2 = Unknown==> + ={x} /\ eq_except FRO.m{1} FRO.m{2} (fset1 x{1}) /\ + FRO.m{1}.[x{2}] = Some (result{2},Unknown) /\ + FRO.m{2}.[x{2}] = Some (result{2},Known)). + + by move=>?&mr[*]-> -> ??;exists FRO.m{mr}, x{mr}=>/#. + move=>???;rewrite in_dom=>[*]<*>[*]->/eq_except_sym H Hxm Hx2. rewrite sampleto_ll=> r _;rewrite /= Hxm oget_some /=;apply /eq_sym. have /(congr1 oget):= Hx2 => <-;apply eq_except_set_eq=>//. by rewrite in_dom Hx2. - + call (iter_perm ERO.I iter_perm2). + + call (iter_perm RRO.I iter_perm2). skip=> &1 &2 [[->> ->>]] [Hdom Hm];progress. - by apply /perm_to_rem/restr_dom;rewrite Hdom Hm. + by apply /perm_to_rem/dom_restr;rewrite Hdom Hm. inline *;rcondt{1} 2;1:by auto. while (={x,l} /\ !mem l{1} x{1}/\ - eq_except RO.m{1} RO.m{2} (fset1 x{1}) /\ - RO.m{1}.[x{2}] = Some (result{2}, Unknown) /\ - RO.m{2}.[x{2}] = Some (result{2}, Known)). + eq_except FRO.m{1} FRO.m{2} (fset1 x{1}) /\ + FRO.m{1}.[x{2}] = Some (result{2}, Unknown) /\ + FRO.m{2}.[x{2}] = Some (result{2}, Known)). + auto=> ?&mr[*]2!->Hm Hex Hm1 Hmr Hneq _/=?->. - rewrite (contra _ _ (mem_drop _ 1 _) Hm) /=. - rewrite!getP;move:Hm;rewrite-(mem_head_behead witness l{mr})//negb_or=>-[]->_. - by rewrite Hm1 Hmr/=;apply eq_except_set. + rewrite (contra _ _ (mem_drop 1 _ _) Hm) /= !getP. + move:Hm;rewrite-(mem_head_behead witness l{mr})//negb_or=>-[]-> _/=. + rewrite Hm1 Hmr/=;apply eq_except_set=>//. auto=>?&mr[[->>->>]][]Hdom Hm /=/=?->/=. rewrite !drop0 restr_set /= dom_rem /= -memE !inE /=. by rewrite !getP_eq /= oget_some/= set2_eq_except. inline *. swap{1}3-2. - while (={l,x} /\ !mem l{1} x{1} /\ RO.m{1}.[x{1}] = None /\ - RO.m{2} = RO.m{1}.[x{2}<-(r{2},Known)]). + while (={l,x} /\ !mem l{1} x{1} /\ FRO.m{1}.[x{1}] = None /\ + FRO.m{2} = FRO.m{1}.[x{2}<-(r{2},Known)]). + auto=> ?&mr[*]2!->Hm Hn Heq Hl _/=?->. - rewrite (contra _ _ (mem_drop _ 1 _) Hm) /=. + rewrite (contra _ _ (mem_drop 1 _ _) Hm) /=. rewrite set_set -Heq !getP -(eq_sym (x{mr})). by move:Hm;rewrite -(mem_head_behead witness l{mr} Hl) -Hn negb_or=>-[]->. auto=> ?&mr[*]2!->_ Hnm/=?->. - rewrite -memE restr_set_neq //= restr_dom Hnm /=. + rewrite -memE restr_set_neq //= dom_restr Hnm /=. by have:=Hnm;rewrite in_dom/==>->/=????->->;rewrite in_dom getP_eq oget_some. qed. lemma eager_set : - eager [ERO.resample(); , RO.set ~ ERO.set, ERO.resample(); : - ={x,y} /\ ={RO.m} ==> ={res,RO.m} ]. + eager [RRO.resample(); , FRO.set ~ RRO.set, RRO.resample(); : + ={x,y} /\ ={FRO.m} ==> ={res,FRO.m} ]. proof. eager proc. - case ((mem (dom RO.m) x /\ (oget RO.m.[x]).`2 = Unknown){1}). - inline{1} ERO.resample=>/=;wp 1 2. - transitivity{1} { Iter(ERO.I).iter(x::elems ((dom (restr Unknown RO.m)) `\` fset1 x)); + case ((mem (dom FRO.m) x /\ (oget FRO.m.[x]).`2 = Unknown){1}). + inline{1} RRO.resample=>/=;wp 1 2. + transitivity{1} { Iter(RRO.I).iter(x::elems ((dom (restr Unknown FRO.m)) `\` fset1 x)); } - (={x,y,RO.m} /\ mem (dom RO.m{1}) x{1} /\ (oget RO.m{1}.[x{1}]).`2 = Unknown ==> - ={x,y,RO.m}) - (={x,y,RO.m} /\ mem (dom RO.m{1}) x{1} /\ (oget RO.m{1}.[x{1}]).`2 = Unknown==> - ={x,y} /\ eq_except RO.m{1} RO.m{2} (fset1 x{1}) /\ - RO.m{2}.[x{2}] = Some (y{2},Known)). - + by move=>?&mr[*]-> -> ???;exists RO.m{mr}, y{mr}, x{mr}=>/#. + (={x,y,FRO.m} /\ mem (dom FRO.m{1}) x{1} /\ (oget FRO.m{1}.[x{1}]).`2 = Unknown ==> + ={x,y,FRO.m}) + (={x,y,FRO.m} /\ mem (dom FRO.m{1}) x{1} /\ (oget FRO.m{1}.[x{1}]).`2 = Unknown==> + ={x,y} /\ eq_except FRO.m{1} FRO.m{2} (fset1 x{1}) /\ + FRO.m{2}.[x{2}] = Some (y{2},Known)). + + by move=>?&mr[*]-> -> ???;exists FRO.m{mr}, y{mr}, x{mr}=>/#. + move=>??? [*]<*>[*]-> -> Hex Hm2. - by rewrite (eq_except_set_eq RO.m{2} RO.m{m} x{2}) ?in_dom ?Hm2// eq_except_sym. - + call (iter_perm ERO.I iter_perm2). + by rewrite (eq_except_set_eq FRO.m{2} FRO.m{m} x{2}) ?in_dom ?Hm2// eq_except_sym. + + call (iter_perm RRO.I iter_perm2). skip=>?&mr[][]->>[]->>->>[]Hdom Hm/=. - by apply /perm_to_rem/restr_dom;rewrite Hdom Hm. + by apply /perm_to_rem/dom_restr;rewrite Hdom Hm. inline *;rcondt{1} 2;1:by auto. while (={x,l} /\ !mem l{1} x{1}/\ - eq_except RO.m{1} RO.m{2} (fset1 x{1}) /\ - RO.m{2}.[x{2}] = Some (y{2}, Known)). + eq_except FRO.m{1} FRO.m{2} (fset1 x{1}) /\ + FRO.m{2}.[x{2}] = Some (y{2}, Known)). + auto=> ?&mr[*]2!->Hm Hex Hm1 Hmr _/=?->. - rewrite (contra _ _ (mem_drop _ 1 _) Hm) /=. + rewrite (contra _ _ (mem_drop 1 _ _) Hm) /=. rewrite!getP;move:Hm;rewrite-(mem_head_behead witness l{mr})//negb_or=>-[]->_. by rewrite Hm1 /=;apply eq_except_set. auto=>?&mr[*]3!<*>Hdom Hm /=/=;rewrite !drop0 sampleto_ll=>/=?_. by rewrite -memE restr_set /= dom_rem !inE !getP_eq set2_eq_except. inline *;wp. while (={x,l} /\ !mem l{1} x{1}/\ - eq_except RO.m{1} RO.m{2} (fset1 x{1}) /\ - RO.m{2}.[x{2}] = Some (y{2}, Known)). + eq_except FRO.m{1} FRO.m{2} (fset1 x{1}) /\ + FRO.m{2}.[x{2}] = Some (y{2}, Known)). + auto=> ?&mr[*]2!->Hm Hex Hm1 Hmr _/=?->. - rewrite (contra _ _ (mem_drop _ 1 _) Hm) /=. + rewrite (contra _ _ (mem_drop 1 _ _) Hm) /=. rewrite!getP;move:Hm;rewrite-(mem_head_behead witness l{mr})//negb_or=>-[]->_. by rewrite Hm1 /=;apply eq_except_set. auto=> ?&mr[*]3!-> Hnm /=. - rewrite-memE restr_set/=rem_id?restr_dom//=Hnm. + rewrite-memE restr_set/=rem_id?dom_restr//=Hnm. rewrite getP_eq eq_except_sym set_eq_except/=. move=>/=????2!->/=[]/eq_except_sym? Hx2;apply/eq_sym. have/(congr1 oget):=Hx2=><-;apply eq_except_set_eq=>//;by rewrite in_dom Hx2. qed. +lemma eager_rem: + eager [RRO.resample(); , FRO.rem ~ RRO.rem, RRO.resample(); : + ={x} /\ ={FRO.m} ==> ={res,FRO.m} ]. +proof. + eager proc;case ((in_dom_with FRO.m x Unknown){1}). + + inline RRO.resample;wp. + transitivity{1} + { Iter(RRO.I).iter(x::elems (dom (restr Unknown FRO.m) `\` fset1 x)); } + (={x,FRO.m}/\(in_dom_with FRO.m x Unknown){1}==> ={x,FRO.m}) + (={x,FRO.m}/\ (in_dom_with FRO.m x Unknown){1} ==> (rem x FRO.m){1} = FRO.m{2})=>//. + + by move=>?&mr[*]2!->_;exists FRO.m{mr}, x{mr}. + + call (iter_perm RRO.I iter_perm2);skip=>?&mr[*]2!->?/=. + by apply /perm_to_rem/dom_restr. + inline *;rcondt{1}2;1:by auto. + while (={l} /\ FRO.m{2} = rem x{1} FRO.m{1} /\ !(mem l x){1}). + + auto=>?&mr[*]->-> ^ + Hm Hl _/=?->. + rewrite rem_set-(mem_head_behead witness l{mr})//negb_or=>-[]->_/=. + by rewrite (contra _ _ (mem_drop 1 _ _) Hm). + auto=>?&mr[*]2!->Hidm/=;rewrite sampleto_ll/==>?. + by rewrite drop0 restr_rem Hidm/= dom_rem rem_set -memE !inE. + inline *;wp. + while (={l} /\ FRO.m{2} = rem x{1} FRO.m{1} /\ !(mem l x){1}). + + auto=>?&mr[*]->-> ^ + Hm Hl _/=?->. + rewrite rem_set-(mem_head_behead witness l{mr})//negb_or=>-[]->_/=. + by rewrite (contra _ _ (mem_drop 1 _ _) Hm). + by auto=>?&mr[*]2!->Hndw/=;rewrite restr_rem Hndw//= -memE dom_restr. +qed. + lemma eager_in_dom: - eager [ERO.resample(); , RO.in_dom ~ ERO.in_dom, ERO.resample(); : - ={x,f} /\ ={RO.m} ==> ={res,RO.m} ]. + eager [RRO.resample(); , FRO.in_dom ~ RRO.in_dom, RRO.resample(); : + ={x,f} /\ ={FRO.m} ==> ={res,FRO.m} ]. proof. eager proc;inline *;wp. - while (={l,RO.m} /\ (forall z, mem l z => in_dom_with RO.m z Unknown){1} /\ - in_dom_with RO.m{1} x{1} f{1} = result{2}). + while (={l,FRO.m} /\ (forall z, mem l z => in_dom_with FRO.m z Unknown){1} /\ + in_dom_with FRO.m{1} x{1} f{1} = result{2}). + auto=>?&mr[*]2!->Hz <-?_/=?->/=. - by split=>[z Hm|];rewrite /in_dom_with dom_set getP !inE/#. - by auto=>?&mr/=[*]3!->/=;split=>// z;rewrite -memE restr_dom. + split=>[z /mem_drop Hm|];rewrite /in_dom_with dom_set getP !inE /#. + by auto=>?&mr/=[*]3!->/=;split=>// z;rewrite -memE dom_restr. qed. lemma eager_restrK: - eager [ERO.resample(); , RO.restrK ~ ERO.restrK, ERO.resample(); : - ={RO.m} ==> ={res,RO.m} ]. + eager [RRO.resample(); , FRO.restrK ~ RRO.restrK, RRO.resample(); : + ={FRO.m} ==> ={res,FRO.m} ]. proof. eager proc;inline *;wp. - while (={l,RO.m} /\ (forall z, mem l z => in_dom_with RO.m z Unknown){1} /\ - restr Known RO.m{1} = result{2}). + while (={l,FRO.m} /\ (forall z, mem l z => in_dom_with FRO.m z Unknown){1} /\ + restr Known FRO.m{1} = result{2}). + auto=>?&mr[*]2!->Hz<-?_/=?->/=. - split=>[z Hm|];1:by rewrite /in_dom_with dom_set getP !inE/#. - rewrite restr_set rem_id?restr_dom//. + split=>[z /mem_drop Hm|];1:by rewrite /in_dom_with dom_set getP !inE /#. + rewrite restr_set rem_id?dom_restr//. by move:H=>/(mem_head_behead witness) /(_ (head witness l{mr})) /= /Hz /#. - by auto=>?&mr/=->/=;split=>// z;rewrite -memE restr_dom. + by auto=>?&mr/=->/=;split=>// z;rewrite -memE dom_restr. qed. lemma eager_sample: - eager [ERO.resample(); , RO.sample ~ ERO.sample, ERO.resample(); : - ={x,RO.m} ==> ={res,RO.m} ]. + eager [RRO.resample(); , FRO.sample ~ RRO.sample, RRO.resample(); : + ={x,FRO.m} ==> ={res,FRO.m} ]. proof. eager proc. - transitivity{2} { - c <$ sampleto x; RO.m.[x] <- (c, Unknown); - Iter(ERO.I).iter(x::elems ((dom (restr Unknown RO.m)) `\` fset1 x));} - (={x,RO.m} ==> ={x,RO.m}) - (={x,RO.m} ==> ={x,RO.m})=>//;last first. - + inline{2} ERO.resample;call (iter_perm ERO.I iter_perm2);auto=>?&mr[]->->/=?->. - by rewrite !restr_set/= !dom_set perm_eq_sym perm_to_rem !inE. - + by move=>?&mr[*]2!->;exists RO.m{mr}, x{mr}. - inline ERO.resample;inline{2}*;rcondt{2}4;1:by auto. - wp;case ((!mem (dom RO.m) x \/ (oget RO.m.[x]).`2=Known){1}). - + inline *;swap{1}3-1. - while (={x,l} /\ RO.m{1}.[x{1} <- (c{1}, Unknown)] = RO.m{2} /\ !(mem l x){1}). - + auto=>?&mr[*]2!-><- Hnm Hl _/=?->. - rewrite (contra _ _ (mem_drop _ 1 _) Hnm) /= set_set. - by move:Hnm;rewrite-(mem_head_behead witness l{mr})//negb_or eq_sym=>-[]->. - auto=>?&mr[*]2!->?/=;rewrite sampleto_ll=>?_?->;rewrite drop0. - rewrite restr_set/= dom_set fsetDK. - cut<-/=:dom (restr Unknown RO.m{mr}) = - dom (restr Unknown RO.m{mr}) `\` fset1 x{mr}. - + apply fsetP=>z;rewrite !(restr_dom,inE)/#. - by rewrite set_set/= -memE restr_dom;split=>/#. - transitivity{1} { - Iter(ERO.I).iter(x::elems ((dom (restr Unknown RO.m)) `\` fset1 x)); - c<$ sampleto x;} - (={x,RO.m} /\ (mem (dom RO.m) x /\ (oget RO.m.[x]).`2=Unknown){1} ==> ={x,c,RO.m}) - (={x,RO.m} /\ (mem (dom RO.m) x /\ (oget RO.m.[x]).`2=Unknown){1} ==> - ={x} /\ RO.m{1}.[x{1} <- (c{1}, Unknown)] = RO.m{2})=>//. - + by move=>?&mr[*]2!->?;exists RO.m{mr}, x{mr}=>/#. - + rnd;call (iter_perm ERO.I iter_perm2);auto=>?&mr[*]->->/=??;split=>//. - by rewrite perm_to_rem restr_dom. - inline *;rcondt{1}2;1:by auto. - swap{1} 7-2. - while (={x,l} /\ RO.m{1}.[x{1} <- (c{1}, Unknown)] = RO.m{2} /\ !(mem l x){1}). - + auto=>?&mr[*]2!-><- Hnm Hl _/=?->. - rewrite (contra _ _ (mem_drop _ 1 _) Hnm) /= set_set. - by move:Hnm;rewrite-(mem_head_behead witness l{mr})//negb_or eq_sym=>-[]->. - by auto=>?&mr[*]2!->??/=?->?->;rewrite!drop0 restr_set/=dom_set fsetDK-memE!inE. + case (!mem (dom (FRO.m{2})) x{2}). + + rcondt{2}2;1:by auto. + transitivity{2} { + c <$ sampleto x; FRO.m.[x] <- (c, Unknown); + Iter(RRO.I).iter(x::elems ((dom (restr Unknown FRO.m)) `\` fset1 x));} + (={x,FRO.m} /\ ! mem (dom FRO.m{2}) x{2} ==> ={x,FRO.m}) + (={x,FRO.m} /\ ! mem (dom FRO.m{2}) x{2} ==> ={x,FRO.m})=>//;last first. + + inline{2} RRO.resample;call (iter_perm RRO.I iter_perm2);auto=>?&mr[*]2!->?/=?->. + by rewrite !restr_set/= !dom_set perm_eq_sym perm_to_rem !inE. + + by move=>?&mr[*]2!->?;exists FRO.m{mr}, x{mr}. + inline RRO.resample;inline{2}*;rcondt{2}4;1:by auto. + inline *;wp;swap{1}-2. + while (={l} /\ FRO.m{2} = (FRO.m.[x <- (c,Unknown)]){1} /\ + (!mem (dom FRO.m) x /\ !mem l x){1}). + + auto=>?&mr[*]2!->Hd Hl Hnl _/=?->. + rewrite dom_set !inE set_set (contra _ _ (mem_drop 1 _ _) Hl). + by move:Hl;rewrite-(mem_head_behead witness l{mr})//negb_or eq_sym=>-[]->. + auto=>?&mr[*]2!->Hd;rewrite sampleto_ll=>?_/=?->. + rewrite drop0 set_set_eq restr_set/= -memE dom_set fsetDK;split=>//. + have^Hx->: !mem (dom (restr Unknown FRO.m{mr})) x{mr} by rewrite dom_restr Hd. + cut->//: dom (restr Unknown FRO.m{mr}) `\` fset1 x{mr} = + dom (restr Unknown FRO.m{mr}). + by rewrite fsetP=>x;rewrite in_fsetD1 /#. + rcondf{2}2;1:by auto. + swap{1}2-1;inline*;auto. + while (={l,FRO.m} /\ (mem (dom FRO.m) x){1});auto. + by move=>?&mr[*]2!->Hm Hl _/=?->;rewrite dom_set !inE Hm. qed. section. -declare module D:Distinguisher {RO}. +declare module D:FRO_Distinguisher {FRO}. -lemma eager_D : eager [ERO.resample(); , D(RO).distinguish ~ - D(ERO).distinguish, ERO.resample(); : - ={glob D,RO.m} ==> ={RO.m, glob D} /\ ={res} ]. +lemma eager_D : eager [RRO.resample(); , D(FRO).distinguish ~ + D(RRO).distinguish, RRO.resample(); : + ={glob D,FRO.m} ==> ={FRO.m, glob D} /\ ={res} ]. proof. - eager proc (H_: ERO.resample(); ~ ERO.resample();: ={RO.m} ==> ={RO.m}) - (={RO.m})=>//; try by sim. + eager proc (H_: RRO.resample(); ~ RRO.resample();: ={FRO.m} ==> ={FRO.m}) + (={FRO.m})=>//; try by sim. + by apply eager_init. + by apply eager_get. + by apply eager_set. - + by apply eager_sample. + by apply eager_in_dom. + by apply eager_restrK. + + by apply eager_rem. + by apply eager_sample. + + by apply eager_in_dom. + by apply eager_restrK. qed. - -module Eager (D:Distinguisher) = { +module Eager (D:FRO_Distinguisher) = { proc main1() = { var b; - RO.init(); - b <@ D(RO).distinguish(); + FRO.init(); + b <@ D(FRO).distinguish(); return b; } proc main2() = { var b; - RO.init(); - b <@ D(ERO).distinguish(); - ERO.resample(); + FRO.init(); + b <@ D(RRO).distinguish(); + RRO.resample(); return b; } }. equiv Eager_1_2: Eager(D).main1 ~ Eager(D).main2 : - ={glob D} ==> ={res,glob RO, glob D}. + ={glob D} ==> ={res,glob FRO, glob D}. proof. proc. transitivity{1} - { RO.init(); ERO.resample(); b <@ D(RO).distinguish(); } - (={glob D} ==> ={b,RO.m,glob D}) - (={glob D} ==> ={b,RO.m,glob D})=> //. + { FRO.init(); RRO.resample(); b <@ D(FRO).distinguish(); } + (={glob D} ==> ={b,FRO.m,glob D}) + (={glob D} ==> ={b,FRO.m,glob D})=> //. + by move=> ?&mr->;exists (glob D){mr}. + inline *;rcondf{2}3;2:by sim. by auto=>?;rewrite restr0 dom0 elems_fset0. - seq 1 1: (={glob D, RO.m});1:by inline *;auto. + seq 1 1: (={glob D, FRO.m});1:by inline *;auto. by eager call eager_D. qed. -end GenEager. +end section. + +equiv LRO_RRO_init : LRO.init ~ RRO.init : true ==> RO.m{1} = restr Known FRO.m{2}. +proof. by proc;auto=>/=;rewrite restr0. qed. + +equiv LRO_RRO_get : LRO.get ~ RRO.get : + ={x} /\ RO.m{1} = restr Known FRO.m{2} ==> ={res} /\ RO.m{1} = restr Known FRO.m{2}. +proof. + proc;auto=>?&ml[]->->/=?->/=. + rewrite dom_restr negb_and ora_or neqK_eqU. + rewrite !restr_set/= !getP_eq oget_some;progress. + by move:H;rewrite negb_or/= restrP in_dom /#. +qed. + +equiv LRO_RRO_set : LRO.set ~ RRO.set : + ={x,y} /\ RO.m{1} = restr Known FRO.m{2} ==> RO.m{1} = restr Known FRO.m{2}. +proof. by proc;auto=>?&ml[*]3!->;rewrite restr_set. qed. + +equiv LRO_RRO_rem : LRO.rem ~ RRO.rem : + ={x} /\ RO.m{1} = restr Known FRO.m{2} ==> RO.m{1} = restr Known FRO.m{2}. +proof. + proc;inline *;auto=>?&mr[*]->->. rewrite restr_rem. + case (in_dom_with FRO.m{mr} x{mr} Known)=>// Hidw. + by rewrite rem_id // dom_restr. +qed. + +equiv LRO_RRO_sample : LRO.sample ~ RRO.sample: + ={x} /\ RO.m{1} = restr Known FRO.m{2} ==> RO.m{1} = restr Known FRO.m{2}. +proof. + proc;auto=>?&ml[]_->;rewrite sampleto_ll=> ??;rewrite restr_set /==>Hnd. + by rewrite rem_id // dom_restr Hnd. +qed. + +lemma LRO_RRO_D (D<:RO_Distinguisher{RO,FRO}) : + equiv [D(LRO).distinguish ~ D(RRO).distinguish : + ={glob D} /\ RO.m{1} = restr Known FRO.m{2} ==> + ={glob D} /\ RO.m{1} = restr Known FRO.m{2} ]. +proof. + proc (RO.m{1} = restr Known FRO.m{2})=>//. + + by conseq LRO_RRO_init. + by conseq LRO_RRO_get. + by conseq LRO_RRO_set. + + by conseq LRO_RRO_rem. + by conseq LRO_RRO_sample. +qed. + +section. + +declare module D : RO_Distinguisher{RO,FRO}. + +local module M = { + proc main1() = { + var b; + RRO.resample(); + b <@ D(FRO).distinguish(); + return b; + } + + proc main2() = { + var b; + b <@ D(RRO).distinguish(); + RRO.resample(); + return b; + } +}. + +lemma RO_LRO_D : + equiv [D(RO).distinguish ~ D(LRO).distinguish : + ={glob D,RO.m} ==> ={glob D}]. +proof. + transitivity M.main1 + (={glob D} /\ FRO.m{2} = map (fun _ c => (c,Known)) RO.m{1} ==> + ={glob D}) + (={glob D} /\ FRO.m{1} = map (fun _ c => (c,Known)) RO.m{2} ==> + ={glob D})=>//. + + by move=>?&mr[]2!->;exists (glob D){mr},(map(fun _ c =>(c,Known))RO.m{mr}). + + proc*;inline M.main1;wp;call (RO_FRO_D D);inline *. + rcondf{2}2;auto. + + move=> &mr[]_->;apply mem_eq0=>z;rewrite -memE dom_restr mapP dom_map in_dom. + by case(RO.m{m}.[_]). + by move=>?&mr[]2!->/=;rewrite map_comp map_id. + transitivity M.main2 + (={glob D, FRO.m} ==> ={glob D}) + (={glob D} /\ FRO.m{1} = map (fun _ c => (c,Known)) RO.m{2} ==> + ={glob D})=>//. + + by move=>?&mr[]2!->;exists (glob D){mr},(map(fun _ c =>(c,Known))RO.m{mr}). + + by proc; eager call (eager_D D);auto. + proc*;inline M.main2;wp;call{1} RRO_resample_ll. + symmetry;call (LRO_RRO_D D);auto=> &ml&mr[*]2!->;split=>//=. + by rewrite fmapP=>x;rewrite restrP mapP;case (RO.m{ml}.[x]). +qed. From 19a466925b5af5283cbbd777a00cc96a994a30c0 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Mon, 4 Jan 2016 13:57:37 +0100 Subject: [PATCH 103/525] use std lib --- proof/old/MyRO.ec | 237 ++++++++++++++++++++++++++-------------------- 1 file changed, 132 insertions(+), 105 deletions(-) diff --git a/proof/old/MyRO.ec b/proof/old/MyRO.ec index b373634..0a0ed47 100644 --- a/proof/old/MyRO.ec +++ b/proof/old/MyRO.ec @@ -321,6 +321,29 @@ proof. by swap{2}[4..5]-3;auto=> &ml&mr[*]3!->neq/=?->?->;rewrite set_set neq. qed. +equiv I_f_neq x1 mx1: RRO.I.f ~ RRO.I.f : + ={x,FRO.m} /\ x1 <> x{1} /\ FRO.m{1}.[x1] = mx1 ==> + ={FRO.m} /\ FRO.m{1}.[x1] = mx1. +proof. + by proc;auto=>?&mr[*]2!->Hneq Heq/=?->;rewrite getP Hneq. +qed. + +equiv I_f_eqex x1 mx1 mx2: RRO.I.f ~ RRO.I.f : + ={x} /\ x1 <> x{1} /\ eq_except FRO.m{1} FRO.m{2} (fset1 x1) /\ + FRO.m{1}.[x1] = mx1 /\ FRO.m{2}.[x1] = mx2 ==> + eq_except FRO.m{1} FRO.m{2} (fset1 x1) /\ + FRO.m{1}.[x1] = mx1 /\ FRO.m{2}.[x1] = mx2. +proof. + by proc;auto=>?&mr[*]->Hneq Heq/= Heq1 Heq2?->/=;rewrite !getP Hneq eq_except_set. +qed. + +equiv I_f_set x1 r1 : RRO.I.f ~ RRO.I.f : + ={x} /\ x1 <> x{1} /\ FRO.m{1}.[x1] = None /\ FRO.m{2} = FRO.m{1}.[x1 <- (r1, Known)] ==> + FRO.m{1}.[x1] = None /\ FRO.m{2} = FRO.m{1}.[x1 <- (r1, Known)]. +proof. + by proc;auto=>?&mr[*]->Hneq H1->/=?->;rewrite getP Hneq/= H1 set_set Hneq. +qed. + lemma eager_get : eager [RRO.resample(); , FRO.get ~ RRO.get, RRO.resample(); : ={x,FRO.m} ==> ={res,FRO.m} ]. @@ -328,22 +351,16 @@ proof. eager proc. wp;case ((mem (dom FRO.m) x /\ (oget FRO.m.[x]).`2=Known){1}). + rnd{1};rcondf{2} 2;1:by auto=> /#. - exists * ((oget FRO.m.[x{2}]){1}). -;inline RRO.resample. - cut := iter_inv RRO.I (fun z=>x{1}<>z) (fun m1 m2 => m1 = m2 /\ . - print iter_inv. - while (={l,FRO.m} /\ (!mem l x /\ FRO.m.[x] = Some (mx.`1,Known)){1}). - + auto=>?&mr[*]-> ->;case (l{mr})=>//=x2 l2 Hmx Hgx?->. - by rewrite getP drop0 /#. - auto=>??[*]-> ->/= Hmem HK;rewrite sampleto_ll/==> r _. - rewrite -memE dom_restr Hmem/= HK. - rewrite {1}get_oget //= -HK;case:(oget _)HK=> x1?/=->. - by move=>????-> _[*]_-> _ Heq?;rewrite in_dom set_eq Heq. - rcondt{2} 2. + auto=> ?[*]-> ->;rewrite negb_and /#. + exists*x{1}, ((oget FRO.m.[x{2}]){1});elim*=>x1 mx;inline RRO.resample. + call (iter_inv RRO.I (fun z=>x1<>z) (fun o1 o2 => o1 = o2 /\ o1.[x1]= Some mx) _)=>/=. + + by conseq (I_f_neq x1 (Some mx))=>//. + auto=>?&mr[*]4!->Hd Hget;rewrite sampleto_ll /==>?_;split. + + by rewrite get_oget//oget_some/==> x;rewrite -memE dom_restr/#. + by move=>[*]_ Heq?mr[*]->Heq'?_;rewrite in_dom Heq' oget_some /= set_eq /#. case ((mem (dom FRO.m) x){1}). + inline{1} RRO.resample=>/=;rnd{1}. transitivity{1} - { Iter(RRO.I).iter(x::elems ((dom (restr Unknown FRO.m)) `\` fset1 x)); } + { Iter(RRO.I).iter_1s(x, elems ((dom (restr Unknown FRO.m)) `\` fset1 x)); } (={x,FRO.m} /\ mem (dom FRO.m{1}) x{1} /\ (oget FRO.m{1}.[x{1}]).`2 = Unknown ==> ={x,FRO.m}) (={x,FRO.m} /\ mem (dom FRO.m{1}) x{1} /\ (oget FRO.m{1}.[x{1}]).`2 = Unknown==> @@ -355,31 +372,29 @@ proof. rewrite sampleto_ll=> r _;rewrite /= Hxm oget_some /=;apply /eq_sym. have /(congr1 oget):= Hx2 => <-;apply eq_except_set_eq=>//. by rewrite in_dom Hx2. - + call (iter_perm RRO.I iter_perm2). - skip=> &1 &2 [[->> ->>]] [Hdom Hm];progress. - by apply /perm_to_rem/dom_restr;rewrite Hdom Hm. - inline *;rcondt{1} 2;1:by auto. - while (={x,l} /\ !mem l{1} x{1}/\ - eq_except FRO.m{1} FRO.m{2} (fset1 x{1}) /\ - FRO.m{1}.[x{2}] = Some (result{2}, Unknown) /\ - FRO.m{2}.[x{2}] = Some (result{2}, Known)). - + auto=> ?&mr[*]2!->Hm Hex Hm1 Hmr Hneq _/=?->. - rewrite (contra _ _ (mem_drop 1 _ _) Hm) /= !getP. - move:Hm;rewrite-(mem_head_behead witness l{mr})//negb_or=>-[]-> _/=. - rewrite Hm1 Hmr/=;apply eq_except_set=>//. - auto=>?&mr[[->>->>]][]Hdom Hm /=/=?->/=. - rewrite !drop0 restr_set /= dom_rem /= -memE !inE /=. - by rewrite !getP_eq /= oget_some/= set2_eq_except. - inline *. swap{1}3-2. - while (={l,x} /\ !mem l{1} x{1} /\ FRO.m{1}.[x{1}] = None /\ - FRO.m{2} = FRO.m{1}.[x{2}<-(r{2},Known)]). - + auto=> ?&mr[*]2!->Hm Hn Heq Hl _/=?->. - rewrite (contra _ _ (mem_drop 1 _ _) Hm) /=. - rewrite set_set -Heq !getP -(eq_sym (x{mr})). - by move:Hm;rewrite -(mem_head_behead witness l{mr} Hl) -Hn negb_or=>-[]->. - auto=> ?&mr[*]2!->_ Hnm/=?->. - rewrite -memE restr_set_neq //= dom_restr Hnm /=. - by have:=Hnm;rewrite in_dom/==>->/=????->->;rewrite in_dom getP_eq oget_some. + + symmetry;call (iter1_perm RRO.I iter_perm2). + skip=> &1 &2 [[->> ->>]] [Hdom Hm];split=>//=. + by apply /perm_eq_sym/perm_to_rem/dom_restr;rewrite /in_dom_with Hdom Hm. + inline Iter(RRO.I).iter_1s RRO.I.f RRO.resample. + seq 5 3 : (={x} /\ eq_except FRO.m{1} FRO.m{2} (fset1 x{1}) /\ + (l =elems(dom (restr Unknown FRO.m) `\` fset1 x)){1} /\ + FRO.m{1}.[x{2}] = Some (result{2}, Unknown) /\ + FRO.m{2}.[x{2}] = Some (result{2}, Known)). + + auto=>?&mr[*]2!->/=^Hdom->^Hget->?->/=. + by rewrite !getP /=oget_some !restr_set/= dom_set set2_eq_except fsetDK. + exists*x{1}, FRO.m{1}.[x{2}], FRO.m{2}.[x{2}];elim*=>x1 mx1 mx2. + call (iter_inv RRO.I (fun z=>x1<>z) + (fun o1 o2 => eq_except o1 o2 (fset1 x1) /\ o1.[x1]= mx1 /\ o2.[x1]=mx2) + (I_f_eqex x1 mx1 mx2))=>/=;auto=>?&mr[*]4!->^H->->^H1->^H2->/=;split. + + congr;rewrite fsetP=>z;rewrite !inE !dom_restr /in_dom_with !in_dom; smt. + by move=>x;rewrite -memE in_fsetD1 eq_sym. + swap{1}-1;seq 1 1 : (={r,x,FRO.m} /\ ! mem (dom FRO.m{1}) x{1});1:by auto. + inline RRO.resample;exists*x{1},r{1};elim*=>x1 r1. + call (iter_inv RRO.I (fun z=>x1<>z) + (fun o1 o2 => o1.[x1] = None /\ o2= o1.[x1<-(r1,Known)]) (I_f_set x1 r1));auto. + move=>?&mr[*]5!-> ^Hnin^ + ->/=;rewrite in_dom=>/=->/=;rewrite restr_set_neq //=;split. + + by move=>z; rewrite -memE dom_restr /#. + by move=>_?mr[*]^Hmem 2!->;rewrite in_dom Hmem /= getP /=oget_some. qed. lemma eager_set : @@ -387,44 +402,39 @@ lemma eager_set : ={x,y} /\ ={FRO.m} ==> ={res,FRO.m} ]. proof. eager proc. + inline RRO.resample=>/=;wp. case ((mem (dom FRO.m) x /\ (oget FRO.m.[x]).`2 = Unknown){1}). - inline{1} RRO.resample=>/=;wp 1 2. - transitivity{1} { Iter(RRO.I).iter(x::elems ((dom (restr Unknown FRO.m)) `\` fset1 x)); - } + + transitivity{1} { Iter(RRO.I).iter_1s(x,elems ((dom (restr Unknown FRO.m)) `\` fset1 x));} (={x,y,FRO.m} /\ mem (dom FRO.m{1}) x{1} /\ (oget FRO.m{1}.[x{1}]).`2 = Unknown ==> ={x,y,FRO.m}) (={x,y,FRO.m} /\ mem (dom FRO.m{1}) x{1} /\ (oget FRO.m{1}.[x{1}]).`2 = Unknown==> ={x,y} /\ eq_except FRO.m{1} FRO.m{2} (fset1 x{1}) /\ FRO.m{2}.[x{2}] = Some (y{2},Known)). - + by move=>?&mr[*]-> -> ???;exists FRO.m{mr}, y{mr}, x{mr}=>/#. - + move=>??? [*]<*>[*]-> -> Hex Hm2. - by rewrite (eq_except_set_eq FRO.m{2} FRO.m{m} x{2}) ?in_dom ?Hm2// eq_except_sym. - + call (iter_perm RRO.I iter_perm2). - skip=>?&mr[][]->>[]->>->>[]Hdom Hm/=. - by apply /perm_to_rem/dom_restr;rewrite Hdom Hm. - inline *;rcondt{1} 2;1:by auto. - while (={x,l} /\ !mem l{1} x{1}/\ - eq_except FRO.m{1} FRO.m{2} (fset1 x{1}) /\ - FRO.m{2}.[x{2}] = Some (y{2}, Known)). - + auto=> ?&mr[*]2!->Hm Hex Hm1 Hmr _/=?->. - rewrite (contra _ _ (mem_drop 1 _ _) Hm) /=. - rewrite!getP;move:Hm;rewrite-(mem_head_behead witness l{mr})//negb_or=>-[]->_. - by rewrite Hm1 /=;apply eq_except_set. - auto=>?&mr[*]3!<*>Hdom Hm /=/=;rewrite !drop0 sampleto_ll=>/=?_. - by rewrite -memE restr_set /= dom_rem !inE !getP_eq set2_eq_except. - inline *;wp. - while (={x,l} /\ !mem l{1} x{1}/\ - eq_except FRO.m{1} FRO.m{2} (fset1 x{1}) /\ - FRO.m{2}.[x{2}] = Some (y{2}, Known)). - + auto=> ?&mr[*]2!->Hm Hex Hm1 Hmr _/=?->. - rewrite (contra _ _ (mem_drop 1 _ _) Hm) /=. - rewrite!getP;move:Hm;rewrite-(mem_head_behead witness l{mr})//negb_or=>-[]->_. - by rewrite Hm1 /=;apply eq_except_set. - auto=> ?&mr[*]3!-> Hnm /=. - rewrite-memE restr_set/=rem_id?dom_restr//=Hnm. - rewrite getP_eq eq_except_sym set_eq_except/=. - move=>/=????2!->/=[]/eq_except_sym? Hx2;apply/eq_sym. - have/(congr1 oget):=Hx2=><-;apply eq_except_set_eq=>//;by rewrite in_dom Hx2. + + by move=>?&mr[*]2!->???;exists FRO.m{mr}, y{mr}, x{mr}=>/#. + + move=>?&m&mr[*]<*>[*]2!->Hex Hm2. + by rewrite (eq_except_set_eq FRO.m{mr} FRO.m{m} x{mr}) ?in_dom ?Hm2// eq_except_sym. + + symmetry;call (iter1_perm RRO.I iter_perm2);auto=>?&mr[*]3!-> Hdom Hm;split=>//=. + by apply /perm_eq_sym/perm_to_rem/dom_restr;rewrite /in_dom_with Hdom. + inline{1}Iter(RRO.I).iter_1s. + seq 3 1: (={x,y} /\ eq_except FRO.m{1} FRO.m{2} (fset1 x{1}) /\ + l{1} = (elems (dom (restr Unknown FRO.m))){2} /\ !mem l{1} x{1} /\ + (FRO.m.[x]=Some(y, Known)){2}). + + inline *;auto=>?&mr[*]3!->/=Hmem Hget;rewrite sampleto_ll=>?_. + by rewrite set2_eq_except getP_eq restr_set /= dom_rem -memE !inE negb_and. + exists* x{1},y{1},(FRO.m.[x]{1});elim*=>x1 y1 mx1;pose mx2:=Some(y1,Known). + call (iter_inv RRO.I (fun z=>x1<>z) + (fun o1 o2 => eq_except o1 o2 (fset1 x1) /\ o1.[x1]= mx1 /\ o2.[x1]=mx2) + (I_f_eqex x1 mx1 mx2))=>/=;auto=>?&mr[*]-><-2!->->>2!->Hmem->/#. + exists* x{1},y{1},(FRO.m.[x]{1});elim*=>x1 y1 mx1;pose mx2:=Some(y1,Known). + call (iter_inv RRO.I (fun z=>x1<>z) + (fun o1 o2 => eq_except o1 o2 (fset1 x1) /\ o1.[x1]= mx1 /\ o2.[x1]=mx2) + (I_f_eqex x1 mx1 mx2))=>/=;auto=>?&mr[*]-><-2!->->>->/= Hidm. + rewrite restr_set getP_eq/mx2 eq_except_sym set_eq_except/=;split;[split|]. + + by congr;apply fsetP=>z;rewrite !(dom_rem,inE,dom_restr) /#. + + by move=>z;rewrite -memE dom_restr /#. + move=>_??[*]Hex HLx HRx;apply /eq_sym. + have/(congr1 oget):=HRx=><-;apply eq_except_set_eq=>//;1:by rewrite in_dom HRx. + by apply /eq_except_sym. qed. lemma eager_rem: @@ -434,25 +444,37 @@ proof. eager proc;case ((in_dom_with FRO.m x Unknown){1}). + inline RRO.resample;wp. transitivity{1} - { Iter(RRO.I).iter(x::elems (dom (restr Unknown FRO.m) `\` fset1 x)); } + { Iter(RRO.I).iter_1s(x,elems (dom (restr Unknown FRO.m) `\` fset1 x)); } (={x,FRO.m}/\(in_dom_with FRO.m x Unknown){1}==> ={x,FRO.m}) (={x,FRO.m}/\ (in_dom_with FRO.m x Unknown){1} ==> (rem x FRO.m){1} = FRO.m{2})=>//. + by move=>?&mr[*]2!->_;exists FRO.m{mr}, x{mr}. - + call (iter_perm RRO.I iter_perm2);skip=>?&mr[*]2!->?/=. - by apply /perm_to_rem/dom_restr. - inline *;rcondt{1}2;1:by auto. - while (={l} /\ FRO.m{2} = rem x{1} FRO.m{1} /\ !(mem l x){1}). - + auto=>?&mr[*]->-> ^ + Hm Hl _/=?->. - rewrite rem_set-(mem_head_behead witness l{mr})//negb_or=>-[]->_/=. - by rewrite (contra _ _ (mem_drop 1 _ _) Hm). - auto=>?&mr[*]2!->Hidm/=;rewrite sampleto_ll/==>?. - by rewrite drop0 restr_rem Hidm/= dom_rem rem_set -memE !inE. - inline *;wp. - while (={l} /\ FRO.m{2} = rem x{1} FRO.m{1} /\ !(mem l x){1}). - + auto=>?&mr[*]->-> ^ + Hm Hl _/=?->. - rewrite rem_set-(mem_head_behead witness l{mr})//negb_or=>-[]->_/=. - by rewrite (contra _ _ (mem_drop 1 _ _) Hm). - by auto=>?&mr[*]2!->Hndw/=;rewrite restr_rem Hndw//= -memE dom_restr. + + symmetry;call (iter1_perm RRO.I iter_perm2);skip=>?&mr[*]2!->?/=;split=>//. + by apply /perm_eq_sym/perm_to_rem/dom_restr. + inline{1}Iter(RRO.I).iter_1s. + seq 3 1: (={x} /\ eq_except FRO.m{1} FRO.m{2} (fset1 x{1}) /\ + l{1} = (elems (dom (restr Unknown FRO.m))){2} /\ !mem l{1} x{1} /\ + (FRO.m.[x]=None){2}). + + inline *;auto=>??[*]2!->Hidm/=;rewrite sampleto_ll=>?_. + rewrite eq_except_rem 1:!inE 2:set_eq_except // remP -memE in_fsetD1 negb_and /=. + by rewrite restr_rem Hidm /= dom_rem. + exists* x{1},(FRO.m.[x]{1});elim*=>x1 mx1. + call (iter_inv RRO.I (fun z=>x1<>z) + (fun o1 o2 => eq_except o1 o2 (fset1 x1) /\ o1.[x1]= mx1 /\ o2.[x1]=None) _). + + by conseq (I_f_eqex x1 mx1 None). + auto=>?&mr[*]3!->^Hex 2!->Hmem ^Hx->/=;split=>[/#|_ mL mR[*]/eq_exceptP Hex'?Heq]. + apply fmapP=>z;rewrite remP;case (z=x{mr})=>[->/=|Hneq];1:by rewrite Heq. + by apply Hex';rewrite inE. + inline RRO.resample;wp. + exists *x{1},(FRO.m.[x]{1});elim*=>x1 mx1. + call (iter_inv RRO.I (fun z=>x1<>z) + (fun o1 o2 => eq_except o1 o2 (fset1 x1) /\ o1.[x1]= mx1 /\ o2.[x1]=None) _). + + by conseq (I_f_eqex x1 mx1 None). + auto=>?&mr[*]4!->Hin/=. + rewrite restr_rem Hin/= remP eq_except_rem 1:inE // 1:eq_except_refl /=;split. + + by move=>z;rewrite -memE dom_restr /#. + move=>_ mL mR[*] /eq_exceptP Hex'?Heq. + apply fmapP=>z;rewrite remP;case (z=x{mr})=>[->/=|Hneq];1:by rewrite Heq. + by apply Hex';rewrite inE. qed. lemma eager_in_dom: @@ -490,25 +512,28 @@ proof. + rcondt{2}2;1:by auto. transitivity{2} { c <$ sampleto x; FRO.m.[x] <- (c, Unknown); - Iter(RRO.I).iter(x::elems ((dom (restr Unknown FRO.m)) `\` fset1 x));} + Iter(RRO.I).iter_1s(x,elems ((dom (restr Unknown FRO.m)) `\` fset1 x));} (={x,FRO.m} /\ ! mem (dom FRO.m{2}) x{2} ==> ={x,FRO.m}) (={x,FRO.m} /\ ! mem (dom FRO.m{2}) x{2} ==> ={x,FRO.m})=>//;last first. - + inline{2} RRO.resample;call (iter_perm RRO.I iter_perm2);auto=>?&mr[*]2!->?/=?->. - by rewrite !restr_set/= !dom_set perm_eq_sym perm_to_rem !inE. + + inline{2} RRO.resample;call (iter1_perm RRO.I iter_perm2);auto=>?&mr[*]2!->Hmem/=?->/=. + by apply /perm_eq_sym/perm_to_rem;rewrite restr_set/=dom_set !inE. + by move=>?&mr[*]2!->?;exists FRO.m{mr}, x{mr}. - inline RRO.resample;inline{2}*;rcondt{2}4;1:by auto. - inline *;wp;swap{1}-2. - while (={l} /\ FRO.m{2} = (FRO.m.[x <- (c,Unknown)]){1} /\ - (!mem (dom FRO.m) x /\ !mem l x){1}). - + auto=>?&mr[*]2!->Hd Hl Hnl _/=?->. - rewrite dom_set !inE set_set (contra _ _ (mem_drop 1 _ _) Hl). - by move:Hl;rewrite-(mem_head_behead witness l{mr})//negb_or eq_sym=>-[]->. - auto=>?&mr[*]2!->Hd;rewrite sampleto_ll=>?_/=?->. - rewrite drop0 set_set_eq restr_set/= -memE dom_set fsetDK;split=>//. - have^Hx->: !mem (dom (restr Unknown FRO.m{mr})) x{mr} by rewrite dom_restr Hd. - cut->//: dom (restr Unknown FRO.m{mr}) `\` fset1 x{mr} = - dom (restr Unknown FRO.m{mr}). - by rewrite fsetP=>x;rewrite in_fsetD1 /#. + inline Iter(RRO.I).iter_1s RRO.I.f RRO.resample;wp;swap{1}-1. + seq 1 7 : (={x} /\ eq_except FRO.m{1} FRO.m{2} (fset1 x{1}) /\ + l{2} = (elems (dom (restr Unknown FRO.m))){1} /\ + (FRO.m.[x]){2} = Some(c{1},Unknown) /\ (FRO.m.[x]){1} = None). + + wp;rnd;auto=>?&mr[*]2!->;rewrite in_dom sampleto_ll/==>Heq?_?->. + rewrite getP_eq restr_set/=dom_set fsetDK eq_except_sym set_set Heq/=set_eq_except/=. + congr;apply fsetP=>z;rewrite in_fsetD1 dom_restr /in_dom_with !in_dom /#. + exists*x{1},c{1};elim*=>x1 c1;pose mx2:=Some(c1,Unknown). + call (iter_inv RRO.I (fun z=>x1<>z) + (fun o1 o2 => eq_except o1 o2 (fset1 x1) /\ o1.[x1]= None /\ o2.[x1]=mx2) _). + + by conseq (I_f_eqex x1 None mx2). + auto=>?&mr[*]2!<-->^Hex 3!->^Hx1-> @/mx2/=;split=>[z|_ mL mR[*]]. + + rewrite -memE dom_restr /in_dom_with in_dom /#. + rewrite in_dom=>Hex'->HRx/=;apply /eq_sym. + have/(congr1 oget):=HRx=><-;apply eq_except_set_eq;1:by rewrite in_dom HRx. + by apply eq_except_sym. rcondf{2}2;1:by auto. swap{1}2-1;inline*;auto. while (={l,FRO.m} /\ (mem (dom FRO.m) x){1});auto. @@ -594,7 +619,7 @@ equiv LRO_RRO_sample : LRO.sample ~ RRO.sample: ={x} /\ RO.m{1} = restr Known FRO.m{2} ==> RO.m{1} = restr Known FRO.m{2}. proof. proc;auto=>?&ml[]_->;rewrite sampleto_ll=> ??;rewrite restr_set /==>Hnd. - by rewrite rem_id // dom_restr Hnd. + by rewrite rem_id // dom_restr /in_dom_with Hnd. qed. lemma LRO_RRO_D (D<:RO_Distinguisher{RO,FRO}) : @@ -639,9 +664,9 @@ proof. + by move=>?&mr[]2!->;exists (glob D){mr},(map(fun _ c =>(c,Known))RO.m{mr}). + proc*;inline M.main1;wp;call (RO_FRO_D D);inline *. rcondf{2}2;auto. - + move=> &mr[]_->;apply mem_eq0=>z;rewrite -memE dom_restr mapP dom_map in_dom. + + move=> &mr[]_->;apply mem_eq0=>z;rewrite -memE dom_restr /in_dom_with mapP dom_map in_dom. by case(RO.m{m}.[_]). - by move=>?&mr[]2!->/=;rewrite map_comp map_id. + by move=>?&mr[]2!->/=;rewrite map_comp /fst/= map_id. transitivity M.main2 (={glob D, FRO.m} ==> ={glob D}) (={glob D} /\ FRO.m{1} = map (fun _ c => (c,Known)) RO.m{2} ==> @@ -652,3 +677,5 @@ proof. symmetry;call (LRO_RRO_D D);auto=> &ml&mr[*]2!->;split=>//=. by rewrite fmapP=>x;rewrite restrP mapP;case (RO.m{ml}.[x]). qed. + +end section. From b475e0e815ded7bb3108107652165d0aae39b00d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Thu, 7 Jan 2016 21:33:20 -0800 Subject: [PATCH 104/525] Moving forward slightly. --- proof/old/ConcreteF.eca | 27 +++++++++++++++++++++++++-- 1 file changed, 25 insertions(+), 2 deletions(-) diff --git a/proof/old/ConcreteF.eca b/proof/old/ConcreteF.eca index dbf7ed3..26f5f27 100644 --- a/proof/old/ConcreteF.eca +++ b/proof/old/ConcreteF.eca @@ -1,6 +1,7 @@ require import Pred Fun Option Pair Int Real StdOrder Ring. require import List FSet NewFMap Utils Common SLCommon. (*...*) import Dprod Dexcepted Capacity IntOrder RealOrder. +require (*..*) Strong_RP_RF. module PF = { var m, mi: (state,state) fmap @@ -40,7 +41,6 @@ op bound_concrete : real. module CF(D:DISTINGUISHER) = Indif(SqueezelessSponge(PF), PF, D). section. - declare module D : DISTINGUISHER {Perm, C, PF}. axiom D_ll (F <: DFUNCTIONALITY{D}) (P <: DPRIMITIVE{D}): @@ -49,9 +49,32 @@ section. local module GReal' = Indif(FC(SqueezelessSponge(Perm)), PC(Perm), D). + (** TODO: this is expressed with restricted oracles rather than + restricted events. Extend the library and unify with the + statement as expressed in this file. **) + local clone Strong_RP_RF as Toto with + type D <- state, + op uD <- dstate, + type K <- unit, + op dK <- (Distr.Dunit.dunit<:unit> tt), + op q <- max_size + 1 + proof *. + realize gt0_q by smt w=max_ge0. + realize uD_uf_fu. + split. + case=> [x y]; rewrite Dprod.supp_def /fst /snd /=. + by rewrite Block.DWord.supportP Capacity.DWord.supportP. + apply/dprodU. + by rewrite Block.DWord.bdistr_uf. + by rewrite Capacity.DWord.cdistr_uf. + qed. + realize dK_ll. + by rewrite /is_lossless -/(Distr.weight _) Distr.Dunit.lossless. + qed. + (* TODO move this *) lemma size_behead(l:'a list): l <> [] => size (behead l) = size l - 1. - proof. case l=>// ??/=;ring. qed. + proof. by case l=> // ?? /=; ring. qed. lemma Real_Concrete &m : Pr[GReal(D).main()@ &m: res /\ C.c <= max_size] <= From eec7d8d8ed35dec0f12ccb3bef2d15dd643750af Mon Sep 17 00:00:00 2001 From: Pierre-Yves Strub Date: Mon, 18 Jan 2016 10:47:06 +0100 Subject: [PATCH 105/525] syntax change fix --- proof/Common.ec | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/proof/Common.ec b/proof/Common.ec index 48326ff..e018936 100644 --- a/proof/Common.ec +++ b/proof/Common.ec @@ -214,7 +214,7 @@ have ->: j + k = (size s) - ((i-k) + 1) by rewrite /j #ring. by rewrite -nth_rev 1:/# &(@negbRL _ true) &(before_index) /#. qed. -pred unpad_spec (t : bool list) = +inductive unpad_spec (t : bool list) = | Unpad (s : bool list, n : int) of (0 <= n < r) & (r %| (size s + n + 2)) From 0f3e857f095902087b3a30cff446eea01a8828f1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Mon, 18 Jan 2016 11:27:05 +0100 Subject: [PATCH 106/525] MyRO: Closing internal theory. --- proof/old/MyRO.ec | 2 ++ 1 file changed, 2 insertions(+) diff --git a/proof/old/MyRO.ec b/proof/old/MyRO.ec index 0a0ed47..4bf405c 100644 --- a/proof/old/MyRO.ec +++ b/proof/old/MyRO.ec @@ -679,3 +679,5 @@ proof. qed. end section. + +end GenEager. From 5b923f5f7332a5cb2764870d260978017b3b0802 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Mon, 18 Jan 2016 11:11:31 +0100 Subject: [PATCH 107/525] remember the proof --- proof/old/G2.eca | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/proof/old/G2.eca b/proof/old/G2.eca index 3c91e0e..3a5baac 100644 --- a/proof/old/G2.eca +++ b/proof/old/G2.eca @@ -8,7 +8,7 @@ clone import Handle as Handle0. -(* + (* -------------------------------------------------------------------------- *) section PROOF. @@ -454,6 +454,8 @@ module G2(D:DISTINGUISHER,HS:SAMPLE) = { } (* G1.bext <- G1.bext \/ mem (rng handles) (x.`2, I); *) (* exists x2 h, handles.[h] = Some (X2,I) *) + (* exists x h, mem (dom G1.m) x /\ handles.[h] = Some (x.2, I) *) + handles_ <@ HS.restrD(); if (!mem (rng handles_) x.`2) { HS.setD(G1.chandle, x.`2); @@ -465,8 +467,10 @@ module G2(D:DISTINGUISHER,HS:SAMPLE) = { if (mem (dom G1.mh) (x.`1, hx2) /\ t) { hy2 <- (oget G1.mh.[(x.`1, hx2)]).`2; y2 <@ HS.get(hy2); + (* bad <- bad \/ mem (map snd (dom G1.m)) y2 *) + +(* bext{1} => bad{2} \/ exists x h, mem (dom G1.m) x /\ handles.[h] = Some (x.2, I) *) y <- (y.`1, y2); - (* bad <- bad \/ mem X2 y.`2; *) G1.m.[x] <- y; G1.mi.[y] <- x; } else { From f371fc0e663e24d79124bad4e61516679c28aa9e Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Mon, 18 Jan 2016 12:15:54 +0100 Subject: [PATCH 108/525] Renaming --- proof/{old/MyRO.ec => RndO.ec} | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename proof/{old/MyRO.ec => RndO.ec} (100%) diff --git a/proof/old/MyRO.ec b/proof/RndO.ec similarity index 100% rename from proof/old/MyRO.ec rename to proof/RndO.ec From f534d39345f3a356934422d0431d85116727b1bc Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Mon, 18 Jan 2016 14:42:51 +0100 Subject: [PATCH 109/525] bla bla --- proof/old/G2.eca | 177 ++++++++++++++++++++++++++++++++++++++++--- proof/old/Handle.eca | 3 +- 2 files changed, 170 insertions(+), 10 deletions(-) diff --git a/proof/old/G2.eca b/proof/old/G2.eca index 3a5baac..55a7188 100644 --- a/proof/old/G2.eca +++ b/proof/old/G2.eca @@ -2,15 +2,15 @@ require import Pred Fun Option Pair Int Real StdOrder Ring StdBigop. require import List FSet NewFMap Utils Common SLCommon FelTactic Mu_mem. (*...*) import Dprod Dexcepted Capacity IntOrder Bigreal RealOrder BRA. -require Handle. +require import RndO. +require (*..*) Handle. clone import Handle as Handle0. - - (* -------------------------------------------------------------------------- *) + section PROOF. declare module D: DISTINGUISHER{C, PF, G1}. @@ -125,9 +125,7 @@ section PROOF. y <- (y.`1, (oget G1.handles.[hy2]).`1); G1.handles.[hy2] <- (y.`2, D); G1.mi.[x] <- y; - G1.mhi.[(x.`1, hx2)] <- (y.`1, hy2); G1.m.[y] <- x; - G1.mh.[(y.`1, hy2)] <- (x.`1, hx2); } else { hy2 <- G1.chandle; G1.chandle <- G1.chandle + 1; @@ -239,13 +237,13 @@ section PROOF. (G1.bcol{1} => G1.bcol{2}) /\ (card (rng G1.handles) + 1 <= 2 * C.c + 1 /\ Gcol.count + 1 <= C.c <= max_size){2}). - + auto;smt ml=0 w=card_rng_set. + + by auto;smt ml=0 w=card_rng_set. seq 1 2: (={RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,G1.handles, C.c,x0,hx2} /\ y0{1} = (y1,y2){2} /\ ((G1.bcol\/hinv G1.handles y0.`2 <> None){1} => G1.bcol{2}) /\ (card (rng G1.handles) + 1 <= 2 * C.c + 1 /\ - Gcol.count <= C.c <= max_size){2});last by auto;smt ml=0 w=card_rng_set. + Gcol.count <= C.c <= max_size){2});2:by auto;smt w=card_rng_set. inline Gcol.sample_c. rcondt{2}3. + by auto;progress;cut /#:= fcard_image_leq fst (rng G1.handles{hr}). @@ -322,7 +320,167 @@ section PROOF. qed. end section PROOF. -*) + + + +(*section PROOF_ext. + + declare module D: DISTINGUISHER{C, PF, G1}. + + local clone import GenEager as Gen with + type from <- int, + type to = + +type from, to. + +op sampleto : from -> to distr. +axiom sampleto_ll : forall x, Distr.weight (sampleto x) = 1%r. + + +print Gen. + + clone import + + module G2(D:DISTINGUISHER,HS:SAMPLE) = { + + module C = { + + proc f(p : block list): block = { + var sa, sa'; + var h, i <- 0; + sa <- b0; + if (1 <= size p /\ p <> [b0]) { + while (i < size p ) { + if (mem (dom G1.mh) (sa +^ nth witness p i, h)) { + (sa, h) <- oget G1.mh.[(sa +^ nth witness p i, h)]; + } else { + HS.sampleI(G1.chandle); + sa' <- RO.f(take (i+1) p); + sa <- sa +^ nth witness p i; + G1.mh.[(sa,h)] <- (sa', G1.chandle); + G1.mhi.[(sa',G1.chandle)] <- (sa, h); + (sa,h) <- (sa',G1.chandle); + G1.chandle <- G1.chandle + 1; + } + i <- i + 1; + } + sa <- RO.f(p); + } + return sa; + } + } + + module S = { + + proc f(x : state): state = { + var p, v, y, y1, y2, hy2, hx2, handles_,t; + + if (!mem (dom G1.m) x) { + if (mem (dom G1.paths) x.`2) { + (p,v) <- oget G1.paths.[x.`2]; + y1 <- RO.f (rcons p (v +^ x.`1)); + y2 <$ cdistr; + y <- (y1, y2); + G1.paths.[y2] <- (rcons p (v +^ x.`1), y.`1); + } else { + y <$ dstate; + } +(* G1.bext <- G1.bext \/ mem (rng handles) (x.`2, I); *) + (* exists x2 h, handles.[h] = Some (X2,I) *) + (* exists x h, mem (dom G1.m) x /\ handles.[h] = Some (x.2, I) *) + + handles_ <@ HS.restrD(); + if (!mem (rng handles_) x.`2) { + HS.setD(G1.chandle, x.`2); + G1.chandle <- G1.chandle + 1; + } + handles_ <- HS.restrD(); + hx2 <- oget (hinvc handles_ x.`2); + t <@ HS.in_dom((oget G1.mh.[(x.`1,hx2)]).`2, I); + if (mem (dom G1.mh) (x.`1, hx2) /\ t) { + hy2 <- (oget G1.mh.[(x.`1, hx2)]).`2; + y2 <@ HS.get(hy2); + (* bad <- bad \/ mem (map snd (dom G1.m)) y2 *) + +(* bext{1} => bad{2} \/ exists x h, mem (dom G1.m) x /\ handles.[h] = Some (x.2, I) *) + y <- (y.`1, y2); + G1.m.[x] <- y; + G1.mi.[y] <- x; + } else { + hy2 <- G1.chandle; + G1.chandle <- G1.chandle + 1; + HS.setD(hy2, y.`2); + G1.m.[x] <- y; + G1.mh.[(x.`1, hx2)] <- (y.`1, hy2); + G1.mi.[y] <- x; + G1.mhi.[(y.`1, hy2)] <- (x.`1, hx2); + } + } else { + y <- oget G1.m.[x]; + } + return y; + } + + proc fi(x : state): state = { + var y, y1, y2, hx2, hy2, handles_, t; + + if (!mem (dom G1.mi) x) { + (* bext <- bext \/ mem (rng handles) (x.`2, I); *) + (* exists x2 h, handles.[h] = Some (X2,I) *) + handles_ <@ HS.restrD(); + if (!mem (rng handles_) x.`2) { + HS.setD(G1.chandle, x.`2); + G1.chandle <- G1.chandle + 1; + } + handles_ <@ HS.restrD(); + hx2 <- oget (hinvc handles_ x.`2); + y <$ dstate; + t <@ HS.in_dom((oget G1.mh.[(x.`1,hx2)]).`2, I); + if (mem (dom G1.mhi) (x.`1, hx2) /\ t) { + (y1,hy2) <- oget G1.mhi.[(x.`1, hx2)]; + y2 <@ HS.get(hy2); + y <- (y.`1, y2); + (* bad <- bad \/ mem X2 y.`2; *) + G1.mi.[x] <- y; + G1.m.[y] <- x; + } else { + hy2 <- G1.chandle; + G1.chandle <- G1.chandle + 1; + HS.setD(hy2, y.`2); + G1.mi.[x] <- y; + G1.mhi.[(x.`1, hx2)] <- (y.`1, hy2); + G1.m.[y] <- x; + G1.mh.[(y.`1, hy2)] <- (x.`1, hx2); + } + } else { + y <- oget G1.mi.[x]; + } + return y; + } + + } + + proc main(): bool = { + var b; + + RO.m <- map0; + G1.m <- map0; + G1.mi <- map0; + G1.mh <- map0; + G1.mhi <- map0; + G1.bext <- false; + + (* the empty path is initially known by the adversary to lead to capacity 0^c *) + HS.setD(0,c0); + G1.paths <- map0.[c0 <- ([<:block>],b0)]; + G1.chandle <- 1; + b <@ D(C,S).distinguish(); + return b; + } +}. + + + module type SAMPLE = { proc sampleI(h:handle) : unit @@ -544,4 +702,5 @@ module G2(D:DISTINGUISHER,HS:SAMPLE) = { b <@ D(C,S).distinguish(); return b; } -}. \ No newline at end of file +}. +*) \ No newline at end of file diff --git a/proof/old/Handle.eca b/proof/old/Handle.eca index a5f2b18..50efca9 100644 --- a/proof/old/Handle.eca +++ b/proof/old/Handle.eca @@ -1,9 +1,10 @@ require import Pred Fun Option Pair Int Real StdOrder Ring. -require import List FSet NewFMap Utils Common SLCommon. +require import List FSet NewFMap Utils Common SLCommon RndO. (*...*) import Dprod Dexcepted Capacity IntOrder. require ConcreteF. + module G1(D:DISTINGUISHER) = { var m, mi : smap var mh, mhi : hsmap From 114da61191862ce0719635d9d3850823d84e4b3e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Mon, 18 Jan 2016 17:43:37 +0100 Subject: [PATCH 110/525] A proof for ConcreteF -- ugly but effective. --- proof/old/ConcreteF.eca | 67 ++++++++++++++++++++++++++++++++++++----- 1 file changed, 60 insertions(+), 7 deletions(-) diff --git a/proof/old/ConcreteF.eca b/proof/old/ConcreteF.eca index 26f5f27..4f408fc 100644 --- a/proof/old/ConcreteF.eca +++ b/proof/old/ConcreteF.eca @@ -52,11 +52,11 @@ section. (** TODO: this is expressed with restricted oracles rather than restricted events. Extend the library and unify with the statement as expressed in this file. **) - local clone Strong_RP_RF as Toto with + local clone import Strong_RP_RF as Switching with type D <- state, op uD <- dstate, type K <- unit, - op dK <- (Distr.Dunit.dunit<:unit> tt), + op dK <- (NewDistr.MUnit.dunit<:unit> tt), op q <- max_size + 1 proof *. realize gt0_q by smt w=max_ge0. @@ -69,16 +69,44 @@ section. by rewrite Capacity.DWord.cdistr_uf. qed. realize dK_ll. - by rewrite /is_lossless -/(Distr.weight _) Distr.Dunit.lossless. + by rewrite /is_lossless NewDistr.MUnit.dunit_ll. qed. (* TODO move this *) - lemma size_behead(l:'a list): l <> [] => size (behead l) = size l - 1. + lemma size_behead (l : 'a list) : l <> [] => size (behead l) = size l - 1. proof. by case l=> // ?? /=; ring. qed. + local module D'(P' : PRPt.Oracles): PRPt.Distinguisher(P') = { + proc distinguish = DRestr(D,SqueezelessSponge(P'),P').distinguish + }. + + local lemma DoubleBounding (P <: PRPt.StrongPRP {D, C, DBounder}) &m: + Pr[PRPt.IND(P,D').main() @ &m: res] + = Pr[PRPt.IND(P,DBounder(D')).main() @ &m: res]. + proof. + byequiv=> //=; proc; inline *. + wp. + call (_: ={glob C, glob P} /\ DBounder.FBounder.c{2} = C.c{2}). + + proc; sp; if=> //=; inline *. + rcondt{2} 4; 1: by auto=> /#. + by wp; call (_: true); auto. + + proc; sp; if=> //=; inline *. + rcondt{2} 4; 1: by auto=> /#. + by wp; call (_: true); auto. + + proc; sp; if=> //=; inline *. + sp; if=> //=; last by wp; auto; smt w=size_ge0. + wp; while ( ={glob C, glob P, p, sa, sc} + /\ C.c{2} <= max_size + /\ DBounder.FBounder.c{2} = C.c{2} - size p{2}). + rcondt{2} 3; 1: by auto; smt w=size_ge0. + by wp; call (_: true); auto=> /#. + by auto; progress; ring. + by wp; call (_: true). + qed. + lemma Real_Concrete &m : Pr[GReal(D).main()@ &m: res /\ C.c <= max_size] <= - Pr[CF(DRestr(D)).main()@ &m: res] + bound_concrete. + Pr[CF(DRestr(D)).main()@ &m: res] + ((max_size + 1) ^ 2)%r * mu dstate (pred1 witness). proof. cut->: Pr[RealIndif(SqueezelessSponge,PC(Perm),D).main()@ &m: @@ -89,7 +117,7 @@ section. + while (={glob Perm,sc,sa,p} /\ (C.c + size p){1} = C.c{2});2:by auto. by wp;sp 1 1;if{2};[rcondt{1} 3|rcondf{1} 3];auto; progress;rewrite size_behead//;ring. - by auto; smt ml=0 w=size_ge0. + by auto; smt w=size_ge0. have p_ll := P_f_ll _ _. + apply/Dprod.lossless. + exact/Block.DWord.bdistr_ll. @@ -113,7 +141,32 @@ section. by move=> z; conseq (_: _ : =1%r); wp; call p_ll; skip; smt w=size_behead. apply (ler_trans _ _ _ (Pr_restr Perm SqueezelessSponge D p_ll pi_ll f_ll D_ll &m)). - admit. (* Francois *) + have ->: Pr[Indif(SqueezelessSponge(Perm), Perm, DRestr(D)).main() @ &m: res] + = Pr[PRPt.IND(PRPi.PRPi,DBounder(D')).main() @ &m: res]. + + rewrite -(DoubleBounding PRPi.PRPi &m). + byequiv=> //=; proc; inline *; sim (_: ={m,mi}(Perm,PRPi.PRPi) /\ ={glob C}). + * by proc; if=> //=; auto. + by proc; if=> //=; auto. + have ->: Pr[CF(DRestr(D)).main() @ &m: res] + = Pr[PRPt.IND(ARP,DBounder(D')).main() @ &m: res]. + + rewrite -(DoubleBounding ARP &m). + byequiv=> //=; proc; inline *; sim (_: ={m,mi}(PF,ARP)). + * by proc; if=> //=; auto. + have:= Conclusion D' &m _. + + move=> O O_f_ll O_fi_ll. + proc; call (_: true)=> //=. + * apply D_ll. + * by proc; sp; if=> //=; call O_f_ll; auto. + * by proc; sp; if=> //=; call O_fi_ll; auto. + * proc; inline *; sp; if=> //=; sp; if=> //=; auto. + while true (size p). + - by auto; call O_f_ll; auto=> /#. + by auto; smt w=size_ge0. + by inline *; auto. + move=> h. + (* to avoid asking smt to do the proof with probability expressions... *) + have -> //: forall (x y z : real), `|x - y| <= z => x <= y + z. + smt w=(@RealOrder). qed. end section. From e3dfe35a706ac33d8ef23be93336432a0ea7049f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Mon, 18 Jan 2016 17:44:14 +0100 Subject: [PATCH 111/525] Removing an obsolete comment. --- proof/old/ConcreteF.eca | 3 --- 1 file changed, 3 deletions(-) diff --git a/proof/old/ConcreteF.eca b/proof/old/ConcreteF.eca index 4f408fc..d4763fe 100644 --- a/proof/old/ConcreteF.eca +++ b/proof/old/ConcreteF.eca @@ -49,9 +49,6 @@ section. local module GReal' = Indif(FC(SqueezelessSponge(Perm)), PC(Perm), D). - (** TODO: this is expressed with restricted oracles rather than - restricted events. Extend the library and unify with the - statement as expressed in this file. **) local clone import Strong_RP_RF as Switching with type D <- state, op uD <- dstate, From fbba4a525653c6e76c98c5073e7c4fa93d526f93 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Mon, 18 Jan 2016 17:45:09 +0100 Subject: [PATCH 112/525] Further cleanup of unneeded operator. Sorry for the spam. --- proof/old/ConcreteF.eca | 3 --- 1 file changed, 3 deletions(-) diff --git a/proof/old/ConcreteF.eca b/proof/old/ConcreteF.eca index d4763fe..737381b 100644 --- a/proof/old/ConcreteF.eca +++ b/proof/old/ConcreteF.eca @@ -35,9 +35,6 @@ module PF = { }. -(* Fixme *) -op bound_concrete : real. - module CF(D:DISTINGUISHER) = Indif(SqueezelessSponge(PF), PF, D). section. From 99344fe08e7a13b961e8da36fe854eedbeadc97f Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Tue, 19 Jan 2016 09:37:35 +0100 Subject: [PATCH 113/525] progress --- proof/old/G2.eca | 99 +++++++++++++++++++++++++------------------- proof/old/Handle.eca | 3 +- 2 files changed, 58 insertions(+), 44 deletions(-) diff --git a/proof/old/G2.eca b/proof/old/G2.eca index 55a7188..e2372ee 100644 --- a/proof/old/G2.eca +++ b/proof/old/G2.eca @@ -7,10 +7,8 @@ require (*..*) Handle. clone import Handle as Handle0. - - (* -------------------------------------------------------------------------- *) - +(* section PROOF. declare module D: DISTINGUISHER{C, PF, G1}. @@ -320,28 +318,26 @@ section PROOF. qed. end section PROOF. +*) +print RO. +clone import GenEager as Gen with + type from <- int, + type to <- capacity, + op sampleto <- fun (_:int) => cdistr + proof sampleto_ll by apply DWord.cdistr_ll. -(*section PROOF_ext. - - declare module D: DISTINGUISHER{C, PF, G1}. - - local clone import GenEager as Gen with - type from <- int, - type to = - -type from, to. - -op sampleto : from -> to distr. -axiom sampleto_ll : forall x, Distr.weight (sampleto x) = 1%r. - +print RO. +print Functionality.RO. -print Gen. +op bad_ext (m:('a*'b,'c)fmap) (y:'b) = + mem (map snd (elems (dom m))) y. - clone import +op hinvc (handles : (int,capacity) fmap) (c : capacity) : handle option = + find (+ pred1 c) handles. - module G2(D:DISTINGUISHER,HS:SAMPLE) = { + module G2(D:DISTINGUISHER,HS:FRO) = { module C = { @@ -354,8 +350,8 @@ print Gen. if (mem (dom G1.mh) (sa +^ nth witness p i, h)) { (sa, h) <- oget G1.mh.[(sa +^ nth witness p i, h)]; } else { - HS.sampleI(G1.chandle); - sa' <- RO.f(take (i+1) p); + HS.sample(G1.chandle); + sa' <@ Functionality.RO.f(take (i+1) p); sa <- sa +^ nth witness p i; G1.mh.[(sa,h)] <- (sa', G1.chandle); G1.mhi.[(sa',G1.chandle)] <- (sa, h); @@ -364,7 +360,7 @@ print Gen. } i <- i + 1; } - sa <- RO.f(p); + sa <- Functionality.RO.f(p); } return sa; } @@ -378,38 +374,34 @@ print Gen. if (!mem (dom G1.m) x) { if (mem (dom G1.paths) x.`2) { (p,v) <- oget G1.paths.[x.`2]; - y1 <- RO.f (rcons p (v +^ x.`1)); + y1 <- Functionality.RO.f (rcons p (v +^ x.`1)); y2 <$ cdistr; y <- (y1, y2); G1.paths.[y2] <- (rcons p (v +^ x.`1), y.`1); } else { y <$ dstate; } -(* G1.bext <- G1.bext \/ mem (rng handles) (x.`2, I); *) - (* exists x2 h, handles.[h] = Some (X2,I) *) (* exists x h, mem (dom G1.m) x /\ handles.[h] = Some (x.2, I) *) - handles_ <@ HS.restrD(); + handles_ <@ HS.restrK(); if (!mem (rng handles_) x.`2) { - HS.setD(G1.chandle, x.`2); + HS.set(G1.chandle, x.`2); G1.chandle <- G1.chandle + 1; } - handles_ <- HS.restrD(); + handles_ <- HS.restrK(); hx2 <- oget (hinvc handles_ x.`2); - t <@ HS.in_dom((oget G1.mh.[(x.`1,hx2)]).`2, I); + t <@ HS.in_dom((oget G1.mh.[(x.`1,hx2)]).`2, Unknown); if (mem (dom G1.mh) (x.`1, hx2) /\ t) { hy2 <- (oget G1.mh.[(x.`1, hx2)]).`2; y2 <@ HS.get(hy2); - (* bad <- bad \/ mem (map snd (dom G1.m)) y2 *) - -(* bext{1} => bad{2} \/ exists x h, mem (dom G1.m) x /\ handles.[h] = Some (x.2, I) *) + G1.bext <- G1.bext \/ bad_ext G1.m y2; y <- (y.`1, y2); G1.m.[x] <- y; G1.mi.[y] <- x; } else { hy2 <- G1.chandle; G1.chandle <- G1.chandle + 1; - HS.setD(hy2, y.`2); + HS.set(hy2, y.`2); G1.m.[x] <- y; G1.mh.[(x.`1, hx2)] <- (y.`1, hy2); G1.mi.[y] <- x; @@ -425,28 +417,26 @@ print Gen. var y, y1, y2, hx2, hy2, handles_, t; if (!mem (dom G1.mi) x) { - (* bext <- bext \/ mem (rng handles) (x.`2, I); *) - (* exists x2 h, handles.[h] = Some (X2,I) *) - handles_ <@ HS.restrD(); + handles_ <@ HS.restrK(); if (!mem (rng handles_) x.`2) { - HS.setD(G1.chandle, x.`2); + HS.set(G1.chandle, x.`2); G1.chandle <- G1.chandle + 1; } - handles_ <@ HS.restrD(); + handles_ <@ HS.restrK(); hx2 <- oget (hinvc handles_ x.`2); y <$ dstate; - t <@ HS.in_dom((oget G1.mh.[(x.`1,hx2)]).`2, I); + t <@ HS.in_dom((oget G1.mh.[(x.`1,hx2)]).`2, Unknown); if (mem (dom G1.mhi) (x.`1, hx2) /\ t) { (y1,hy2) <- oget G1.mhi.[(x.`1, hx2)]; y2 <@ HS.get(hy2); y <- (y.`1, y2); - (* bad <- bad \/ mem X2 y.`2; *) + G1.bext <- G1.bext \/ bad_ext G1.m y2; G1.mi.[x] <- y; G1.m.[y] <- x; } else { hy2 <- G1.chandle; G1.chandle <- G1.chandle + 1; - HS.setD(hy2, y.`2); + HS.set(hy2, y.`2); G1.mi.[x] <- y; G1.mhi.[(x.`1, hx2)] <- (y.`1, hy2); G1.m.[y] <- x; @@ -471,7 +461,8 @@ print Gen. G1.bext <- false; (* the empty path is initially known by the adversary to lead to capacity 0^c *) - HS.setD(0,c0); + HS.init(); + HS.set(0,c0); G1.paths <- map0.[c0 <- ([<:block>],b0)]; G1.chandle <- 1; b <@ D(C,S).distinguish(); @@ -480,6 +471,30 @@ print Gen. }. +section EXT. + + declare module D: DISTINGUISHER{C, PF, G1, G2}. + + equiv G1_G2 : G1(D).main ~ G2(D,FRO).main : + ={glob D} ==> ={res} /\ G1.bext{1} => (G1.bext{2} \/ + exists x h, mem (dom G1.m{2}) x /\ FRO.m{2}.[h] = Some (x.`2, Unknown)). + + + + +col.main +type from, to. + +op sampleto : from -> to distr. +axiom sampleto_ll : forall x, Distr.weight (sampleto x) = 1%r. + + +print Gen. + + clone import + + + module type SAMPLE = { diff --git a/proof/old/Handle.eca b/proof/old/Handle.eca index 50efca9..78f490e 100644 --- a/proof/old/Handle.eca +++ b/proof/old/Handle.eca @@ -4,7 +4,6 @@ require import List FSet NewFMap Utils Common SLCommon RndO. require ConcreteF. - module G1(D:DISTINGUISHER) = { var m, mi : smap var mh, mhi : hsmap @@ -27,7 +26,7 @@ module G1(D:DISTINGUISHER) = { } else { sc <$ cdistr; bcol <- bcol \/ hinv handles sc <> None; - sa' <- RO.f(take (i+1) p); + sa' <@ RO.f(take (i+1) p); sa <- sa +^ nth witness p i; mh.[(sa,h)] <- (sa', chandle); mhi.[(sa',chandle)] <- (sa, h); From 40b3b162d9c787b1d5fe0ad8c4ecb1706f265bbf Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Tue, 19 Jan 2016 10:07:28 +0100 Subject: [PATCH 114/525] start propagation of RndO instead of RndOrcl --- proof/old/Handle.eca | 7 ++ proof/old/SLCommon.ec | 153 ++++++++++++++++++++---------------------- 2 files changed, 79 insertions(+), 81 deletions(-) diff --git a/proof/old/Handle.eca b/proof/old/Handle.eca index 78f490e..d5deb5c 100644 --- a/proof/old/Handle.eca +++ b/proof/old/Handle.eca @@ -4,6 +4,13 @@ require import List FSet NewFMap Utils Common SLCommon RndO. require ConcreteF. +clone import GenEager as Gen with + type from <- handle, + type to <- capacity, + op sampleto <- fun (_:int) => cdistr + proof sampleto_ll by apply DWord.cdistr_ll. + +print hinv. module G1(D:DISTINGUISHER) = { var m, mi : smap var mh, mhi : hsmap diff --git a/proof/old/SLCommon.ec b/proof/old/SLCommon.ec index c1f6648..280bcc9 100644 --- a/proof/old/SLCommon.ec +++ b/proof/old/SLCommon.ec @@ -4,15 +4,14 @@ length is the input block size. We prove its security even when padding is not prefix-free. **) require import Pred Fun Option Pair Int Real StdOrder Ring. -require import List FSet NewFMap Utils Common. +require import List FSet NewFMap Utils Common RndO. -require (*..*) RndOrcl Indifferentiability. +require (*..*) Indifferentiability. (*...*) import Dprod Dexcepted Capacity IntOrder. type state = block * capacity. op dstate = bdistr * cdistr. - clone include Indifferentiability with type p <- state, type f_in <- block list, @@ -34,23 +33,14 @@ clone export Tuple as TupleBl with op bl_enum = flatten (mkseq (fun i => wordn i) (max_size + 1)). op bl_univ = FSet.oflist bl_enum. -clone RndOrcl as RndOrclB with +(* -------------------------------------------------------------------------- *) +(* Random oracle from block list to block *) + +clone import RndO.GenEager as F with type from <- block list, - type to <- block. - -clone export RndOrclB.RestrIdeal as Functionality with - op sample _ <- bdistr, - op test l <- List.size l <= max_size, - op univ <- bl_univ, - op dfl <- b0 - proof *. -realize sample_ll by exact Block.DWord.bdistr_ll. -realize testP. -proof. - move=> x; rewrite mem_oflist-flattenP; split=>[_|[s[/mkseqP[i[/=_->>]]/wordnP->/#]]]. - exists (wordn (size x));cut Hsx := size_ge0 x. - rewrite wordnP max_ler //= mkseqP /=;exists (size x);smt ml=0. -qed. + type to <- block, + op sampleto <- fun (_:block list)=> bdistr + proof * by exact Block.DWord.bdistr_ll. (** We can now define the squeezeless sponge construction **) module SqueezelessSponge (P:DPRIMITIVE): FUNCTIONALITY = { @@ -90,7 +80,7 @@ type handle = int. type hstate = block * handle. -type ccapacity = capacity * caller. +type ccapacity = capacity * flag. type smap = (state , state ) fmap. type hsmap = (hstate, hstate ) fmap. @@ -125,63 +115,6 @@ proof. by split; apply/half_permutation_set. qed. -(** Operators and properties of handles *) - -op hinv (handles:handles) (c:capacity) = - find (fun _ => pred1 c \o fst) handles. - -op hinvD (handles:handles) (c:capacity) = - find (fun _ => pred1 (c,D)) handles. - -op huniq (handles:handles) = - forall h1 h2 cf1 cf2, - handles.[h1] = Some cf1 => - handles.[h2] = Some cf2 => - cf1.`1 = cf2.`1 => h1 = h2. - -lemma hinvP handles c: - if hinv handles c = None then forall h f, handles.[h] <> Some(c,f) - else exists f, handles.[oget (hinv handles c)] = Some(c,f). -proof. - cut @/pred1@/(\o)/=[[h []->[]Hmem <<-]|[]->H h f]/= := - findP (fun (_ : handle) => pred1 c \o fst) handles. - + by exists (oget handles.[h]).`2;rewrite oget_some get_oget;2:case (oget handles.[h]). - by rewrite -not_def=> Heq; cut := H h;rewrite in_dom Heq. -qed. - -lemma huniq_hinv (handles:handles) (h:handle): - huniq handles => mem (dom handles) h => hinv handles (oget handles.[h]).`1 = Some h. -proof. - move=> Huniq;pose c := (oget handles.[h]).`1. - cut:=Huniq h;cut:=hinvP handles c. - case (hinv _ _)=> /=[Hdiff _| h' +/(_ h')];1:by rewrite in_dom /#. - by move=> [f ->] /(_ (oget handles.[h]) (c,f)) H1 H2;rewrite H1 // get_oget. -qed. - -lemma hinvDP handles c: - if hinvD handles c = None then forall h, handles.[h] <> Some(c,D) - else handles.[oget (hinvD handles c)] = Some(c,D). -proof. - cut @/pred1/=[[h []->[]Hmem ]|[]->H h ]/= := - findP (fun (_ : handle) => pred1 (c,D)) handles. - + by rewrite oget_some get_oget. - by rewrite -not_def=> Heq; cut := H h;rewrite in_dom Heq. -qed. - -lemma huniq_hinvD (handles:handles) c: - huniq handles => mem (rng handles) (c,D) => handles.[oget (hinvD handles c)] = Some(c,D). -proof. - move=> Huniq;rewrite in_rng=> -[h]H;case: (hinvD _ _) (Huniq h) (hinvDP handles c)=>//=. - by move=>_/(_ h);rewrite H. -qed. - -lemma huniq_hinvD_h h (handles:handles) c: - huniq handles => handles.[h] = Some (c,D) => hinvD handles c = Some h. -proof. - move=> Huniq;case: (hinvD _ _) (hinvDP handles c)=>/= [H|h'];1: by apply H. - by rewrite oget_some=> /Huniq H/H. -qed. - (* Functionnal version of the construction using handle *) op step_hpath (mh:hsmap) (sah:hstate option) (b:block) = @@ -337,9 +270,8 @@ proof. by inline *;auto. qed. -(* Exemple *) -(* section RESTR. + declare module F:FUNCTIONALITY{C}. declare module P:PRIMITIVE{C,F}. declare module D:DISTINGUISHER{F,P,C}. @@ -352,8 +284,7 @@ section RESTR. proc;inline *;wp;swap{1}1 2;sim. qed. -end RESTR. -*) +end section RESTR. section COUNT. @@ -396,7 +327,67 @@ section COUNT. end section COUNT. + + +(* -------------------------------------------------------------------------- *) +(** Operators and properties of handles *) +op hinv (handles:handles) (c:capacity) = + find (fun _ => pred1 c \o fst) handles. + +op hinvK (handles:handles) (c:capacity) = + find (fun _ => pred1 (c,Known)) handles. + +op huniq (handles:handles) = + forall h1 h2 cf1 cf2, + handles.[h1] = Some cf1 => + handles.[h2] = Some cf2 => + cf1.`1 = cf2.`1 => h1 = h2. + +lemma hinvP handles c: + if hinv handles c = None then forall h f, handles.[h] <> Some(c,f) + else exists f, handles.[oget (hinv handles c)] = Some(c,f). +proof. + cut @/pred1@/(\o)/=[[h []->[]Hmem <<-]|[]->H h f]/= := + findP (fun (_ : handle) => pred1 c \o fst) handles. + + by exists (oget handles.[h]).`2;rewrite oget_some get_oget;2:case (oget handles.[h]). + by rewrite -not_def=> Heq; cut := H h;rewrite in_dom Heq. +qed. + +lemma huniq_hinv (handles:handles) (h:handle): + huniq handles => mem (dom handles) h => hinv handles (oget handles.[h]).`1 = Some h. +proof. + move=> Huniq;pose c := (oget handles.[h]).`1. + cut:=Huniq h;cut:=hinvP handles c. + case (hinv _ _)=> /=[Hdiff _| h' +/(_ h')];1:by rewrite in_dom /#. + by move=> [f ->] /(_ (oget handles.[h]) (c,f)) H1 H2;rewrite H1 // get_oget. +qed. + +lemma hinvKP handles c: + if hinvK handles c = None then forall h, handles.[h] <> Some(c,Known) + else handles.[oget (hinvK handles c)] = Some(c,Known). +proof. + cut @/pred1/=[[h []->[]Hmem ]|[]->H h ]/= := + findP (fun (_ : handle) => pred1 (c,Known)) handles. + + by rewrite oget_some get_oget. + by rewrite -not_def=> Heq; cut := H h;rewrite in_dom Heq. +qed. + +lemma huniq_hinvK (handles:handles) c: + huniq handles => mem (rng handles) (c,Known) => handles.[oget (hinvK handles c)] = Some(c,Known). +proof. + move=> Huniq;rewrite in_rng=> -[h]H;case: (hinvK _ _) (Huniq h) (hinvKP handles c)=>//=. + by move=>_/(_ h);rewrite H. +qed. + +lemma huniq_hinvK_h h (handles:handles) c: + huniq handles => handles.[h] = Some (c,Known) => hinvK handles c = Some h. +proof. + move=> Huniq;case: (hinvK _ _) (hinvKP handles c)=>/= [H|h'];1: by apply H. + by rewrite oget_some=> /Huniq H/H. +qed. + (* -------------------------------------------------------------------------- *) (** The initial Game *) module GReal(D:DISTINGUISHER) = RealIndif(SqueezelessSponge, PC(Perm), D). + From 8caa21fd190b0e032849187e5c1e976c4a47ea7d Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Tue, 19 Jan 2016 15:37:03 +0100 Subject: [PATCH 115/525] use RndO and not RndOrcl. --- proof/old/ConcreteF.eca | 29 +- proof/old/G2.eca | 616 ++-------------------------------------- proof/old/Gcol.eca | 321 +++++++++++++++++++++ proof/old/Handle.eca | 118 ++++---- proof/old/SLCommon.ec | 11 - 5 files changed, 423 insertions(+), 672 deletions(-) create mode 100644 proof/old/Gcol.eca diff --git a/proof/old/ConcreteF.eca b/proof/old/ConcreteF.eca index 737381b..23e2ba1 100644 --- a/proof/old/ConcreteF.eca +++ b/proof/old/ConcreteF.eca @@ -1,6 +1,8 @@ require import Pred Fun Option Pair Int Real StdOrder Ring. require import List FSet NewFMap Utils Common SLCommon. + (*...*) import Dprod Dexcepted Capacity IntOrder RealOrder. + require (*..*) Strong_RP_RF. module PF = { @@ -53,6 +55,7 @@ section. op dK <- (NewDistr.MUnit.dunit<:unit> tt), op q <- max_size + 1 proof *. + realize gt0_q by smt w=max_ge0. realize uD_uf_fu. split. @@ -146,21 +149,17 @@ section. + rewrite -(DoubleBounding ARP &m). byequiv=> //=; proc; inline *; sim (_: ={m,mi}(PF,ARP)). * by proc; if=> //=; auto. - have:= Conclusion D' &m _. - + move=> O O_f_ll O_fi_ll. - proc; call (_: true)=> //=. - * apply D_ll. - * by proc; sp; if=> //=; call O_f_ll; auto. - * by proc; sp; if=> //=; call O_fi_ll; auto. - * proc; inline *; sp; if=> //=; sp; if=> //=; auto. - while true (size p). - - by auto; call O_f_ll; auto=> /#. - by auto; smt w=size_ge0. - by inline *; auto. - move=> h. - (* to avoid asking smt to do the proof with probability expressions... *) - have -> //: forall (x y z : real), `|x - y| <= z => x <= y + z. - smt w=(@RealOrder). + have /#:= Conclusion D' &m _. + move=> O O_f_ll O_fi_ll. + proc; call (_: true)=> //=. + + apply D_ll. + + by proc; sp; if=> //=; call O_f_ll; auto. + + by proc; sp; if=> //=; call O_fi_ll; auto. + + proc; inline *; sp; if=> //=; sp; if=> //=; auto. + while true (size p). + * by auto; call O_f_ll; auto=> /#. + by auto; smt w=size_ge0. + by inline *; auto. qed. end section. diff --git a/proof/old/G2.eca b/proof/old/G2.eca index e2372ee..8dda61d 100644 --- a/proof/old/G2.eca +++ b/proof/old/G2.eca @@ -1,346 +1,21 @@ -require import Pred Fun Option Pair Int Real StdOrder Ring StdBigop. -require import List FSet NewFMap Utils Common SLCommon FelTactic Mu_mem. +require import Pred Fun Option Pair Int Real RealExtra StdOrder Ring StdBigop. +require import List FSet NewFMap Utils Common SLCommon RndO FelTactic Mu_mem. (*...*) import Dprod Dexcepted Capacity IntOrder Bigreal RealOrder BRA. -require import RndO. -require (*..*) Handle. +require (*..*) Gcol. -clone import Handle as Handle0. +clone export Gcol as Gcol0. -(* -------------------------------------------------------------------------- *) -(* -section PROOF. - declare module D: DISTINGUISHER{C, PF, G1}. - - axiom D_ll (F <: DFUNCTIONALITY{D}) (P <: DPRIMITIVE{D}): - islossless P.f => islossless P.fi => - islossless F.f => islossless D(F, P).distinguish. - - local module Gcol = { - - var count : int - - proc sample_c () = { - var c=c0; - if (card (image fst (rng G1.handles)) <= 2*max_size /\ - count < max_size) { - c <$ cdistr; - G1.bcol <- G1.bcol \/ mem (image fst (rng G1.handles)) c; - count <- count + 1; - } - - return c; - } - - module C = { - - proc f(p : block list): block = { - var sa, sa', sc; - var h, i <- 0; - sa <- b0; - if (1 <= size p /\ p <> [b0]) { - while (i < size p ) { - if (mem (dom G1.mh) (sa +^ nth witness p i, h)) { - (sa, h) <- oget G1.mh.[(sa +^ nth witness p i, h)]; - } else { - sc <@ sample_c(); - sa' <- RO.f(take (i+1) p); - sa <- sa +^ nth witness p i; - G1.mh.[(sa,h)] <- (sa', G1.chandle); - G1.mhi.[(sa',G1.chandle)] <- (sa, h); - (sa,h) <- (sa',G1.chandle); - G1.handles.[G1.chandle] <- (sc,I); - G1.chandle <- G1.chandle + 1; - } - i <- i + 1; - } - sa <- RO.f(p); - } - return sa; - } - } - - module S = { - - proc f(x : state): state = { - var p, v, y, y1, y2, hy2, hx2; - - if (!mem (dom G1.m) x) { - if (!(mem (rng G1.handles) (x.`2, D))) { - G1.handles.[G1.chandle] <- (x.`2, D); - G1.chandle <- G1.chandle + 1; - } - hx2 <- oget (hinvD G1.handles x.`2); - - if (mem (dom G1.paths) x.`2) { - (p,v) <- oget G1.paths.[x.`2]; - y1 <- RO.f (rcons p (v +^ x.`1)); - y2 <@ sample_c(); - y <- (y1, y2); - G1.paths.[y2] <- (rcons p (v +^ x.`1), y.`1); - } else { - y1 <$ bdistr; - y2 <@ sample_c(); - y <- (y1,y2); - } - if (mem (dom G1.mh) (x.`1, hx2) /\ - in_dom_with G1.handles (oget G1.mh.[(x.`1,hx2)]).`2 I) { - hy2 <- (oget G1.mh.[(x.`1, hx2)]).`2; - y <- (y.`1, (oget G1.handles.[hy2]).`1); - G1.handles.[hy2] <- (y.`2, D); - G1.m.[x] <- y; - G1.mi.[y] <- x; - } else { - hy2 <- G1.chandle; - G1.chandle <- G1.chandle + 1; - G1.handles.[hy2] <- (y.`2, D); - G1.m.[x] <- y; - G1.mh.[(x.`1, hx2)] <- (y.`1, hy2); - G1.mi.[y] <- x; - G1.mhi.[(y.`1, hy2)] <- (x.`1, hx2); - } - } else { - y <- oget G1.m.[x]; - } - return y; - } - - proc fi(x : state): state = { - var y, y1, y2, hx2, hy2; - - if (!mem (dom G1.mi) x) { - if (!(mem (rng G1.handles) (x.`2, D))) { - G1.handles.[G1.chandle] <- (x.`2, D); - G1.chandle <- G1.chandle + 1; - } - hx2 <- oget (hinvD G1.handles x.`2); - y1 <$ bdistr; - y2 <@ sample_c(); - y <- (y1,y2); - if (mem (dom G1.mhi) (x.`1, hx2) /\ - in_dom_with G1.handles (oget G1.mhi.[(x.`1,hx2)]).`2 I) { - (y1,hy2) <- oget G1.mhi.[(x.`1, hx2)]; - y <- (y.`1, (oget G1.handles.[hy2]).`1); - G1.handles.[hy2] <- (y.`2, D); - G1.mi.[x] <- y; - G1.m.[y] <- x; - } else { - hy2 <- G1.chandle; - G1.chandle <- G1.chandle + 1; - G1.handles.[hy2] <- (y.`2, D); - G1.mi.[x] <- y; - G1.mhi.[(x.`1, hx2)] <- (y.`1, hy2); - G1.m.[y] <- x; - G1.mh.[(y.`1, hy2)] <- (x.`1, hx2); - } - } else { - y <- oget G1.mi.[x]; - } - return y; - } - - } - - proc main(): bool = { - var b; - - RO.m <- map0; - G1.m <- map0; - G1.mi <- map0; - G1.mh <- map0; - G1.mhi <- map0; - G1.bcol <- false; - - G1.handles <- map0.[0 <- (c0, D)]; - G1.paths <- map0.[c0 <- ([<:block>],b0)]; - G1.chandle <- 1; - count <- 0; - b <@ DRestr(D,C,S).distinguish(); - return b; - } - }. - - lemma card_rng_set (m:('a,'b)fmap) x y: card(rng m.[x<-y]) <= card(rng m) + 1. - proof. - rewrite rng_set fcardU fcard1. - cut := subset_leq_fcard (rng (rem x m)) (rng m) _;2:smt ml=0 w=fcard_ge0. - rewrite subsetP=> z;apply rng_rem_le. - qed. - - lemma hinv_image handles c: - hinv handles c <> None => - mem (image fst (rng handles)) c. - proof. - case: (hinv handles c) (hinvP handles c)=>//= h[f] Heq. - rewrite imageP;exists (c,f)=>@/fst/=. - by rewrite in_rng;exists (oget (Some h)). - qed. - - local equiv G1col : G1(DRestr(D)).main ~ Gcol.main : - ={glob D} ==> (G1.bcol{1} => G1.bcol{2}) /\ Gcol.count{2} <= max_size. - proof. - proc;inline*;wp. - call (_: ={RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,G1.handles,C.c}/\ - (G1.bcol{1} => G1.bcol{2}) /\ - (card (rng G1.handles) <= 2*C.c + 1 /\ - Gcol.count <= C.c <= max_size){2}). - + proc;sp 1 1;if=>//. - inline G1(DRestr(D)).S.f Gcol.S.f. - seq 2 2 : (={RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,G1.handles, - C.c,x0} /\ - (G1.bcol{1} => G1.bcol{2}) /\ - (card(rng G1.handles) + 2 <= 2*C.c + 1/\ - Gcol.count + 1 <= C.c <= max_size){2});1:by auto=>/#. - if=>//;last by auto=>/#. - swap{1}[2..4]-1. - seq 3 2:(={RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,G1.handles, - C.c,x0,hx2} /\ - (G1.bcol{1} => G1.bcol{2}) /\ - (card (rng G1.handles) + 1 <= 2 * C.c + 1/\ - Gcol.count + 1 <= C.c <= max_size){2}). - + auto;smt ml=0 w=card_rng_set. - seq 1 1: - (={RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,G1.handles, - C.c,x0,hx2,y0} /\ - ((G1.bcol\/hinv G1.handles y0.`2 <> None){1} => G1.bcol{2}) /\ - (card (rng G1.handles) + 1 <= 2 * C.c + 1 /\ - Gcol.count <= C.c <= max_size){2});last by auto;smt ml=0 w=card_rng_set. - if=>//;inline Gcol.sample_c. - + rcondt{2}4. - + auto;conseq (_:true)=>//;progress;2: smt ml=0. - cut /#:= fcard_image_leq fst (rng G1.handles{hr}). - wp;conseq (_: ={p,v,RO.m,y1} /\ y2{1}=c{2})=>//;1:smt ml=0 w=hinv_image. - by sim. - rcondt{2}3. - + by auto;progress;cut /#:= fcard_image_leq fst (rng G1.handles{hr}). - swap{2}2-1;sp 0 1;wp;conseq(_:y0{1}=(y1,c){2})=>//;1:smt ml=0 w=hinv_image. - transitivity{1} {y0 <- S.sample();} - (true ==> ={y0}) - (true ==> y0{1}=(y1,c){2})=>//;1:by inline*;auto. - transitivity{2} {(y1,c) <- S.sample2();} - (true==>y0{1}=(y1,c){2}) - (true==> ={y1,c})=>//;2:by inline*;auto. - by call sample_sample2;auto=> /=?[??]->. - - + proc;sp 1 1;if=>//. - inline G1(DRestr(D)).S.fi Gcol.S.fi. - seq 2 2 : (={RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,G1.handles, - C.c,x0} /\ - (G1.bcol{1} => G1.bcol{2}) /\ - (card(rng G1.handles) + 2 <= 2*C.c + 1 /\ - Gcol.count + 1 <= C.c <= max_size){2});1:by auto=>/#. - if=>//;last by auto=>/#. - seq 3 2:(={RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,G1.handles, - C.c,x0,hx2} /\ - (G1.bcol{1} => G1.bcol{2}) /\ - (card (rng G1.handles) + 1 <= 2 * C.c + 1 /\ - Gcol.count + 1 <= C.c <= max_size){2}). - + by auto;smt ml=0 w=card_rng_set. - seq 1 2: - (={RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,G1.handles, - C.c,x0,hx2} /\ y0{1} = (y1,y2){2} /\ - ((G1.bcol\/hinv G1.handles y0.`2 <> None){1} => G1.bcol{2}) /\ - (card (rng G1.handles) + 1 <= 2 * C.c + 1 /\ - Gcol.count <= C.c <= max_size){2});2:by auto;smt w=card_rng_set. - inline Gcol.sample_c. - rcondt{2}3. - + by auto;progress;cut /#:= fcard_image_leq fst (rng G1.handles{hr}). - swap{2}2-1;sp 0 1;wp;conseq(_:y0{1}=(y1,c){2})=>//;1:smt ml=0 w=hinv_image. - transitivity{1} {y0 <- S.sample();} - (true ==> ={y0}) - (true ==> y0{1}=(y1,c){2})=>//;1:by inline*;auto. - transitivity{2} {(y1,c) <- S.sample2();} - (true==>y0{1}=(y1,c){2}) - (true==> ={y1,c})=>//;2:by inline*;auto. - by call sample_sample2;auto=> /=?[??]->. - - + proc;sp 1 1;if=>//. - inline G1(DRestr(D)).C.f Gcol.C.f. - seq 5 5: - (={RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,G1.handles,C.c,b, - p,h,i,sa} /\ i{1}=0 /\ - (G1.bcol{1} => G1.bcol{2}) /\ - card (rng G1.handles{2}) + 2*(size p{2}) <= 2 * C.c{2} + 1 /\ - Gcol.count{2} + size p{2} <= C.c{2} <= max_size);1:by auto=>/#. - wp;if=>//;2:by auto;smt ml=0 w=size_ge0. - call (_: ={RO.m});1:by sim. - while - (={RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,G1.handles,C.c,b, - p,h,i,sa} /\ (i <= size p){1} /\ - (G1.bcol{1} => G1.bcol{2}) /\ - (card (rng G1.handles) + 2*(size p - i) <= 2 * C.c + 1 /\ - Gcol.count + size p - i <= C.c <= max_size){2}); - last by auto; smt ml=0 w=size_ge0. - if=>//;auto;1:smt ml=0 w=size_ge0. - call (_: ={RO.m});1:by sim. - inline *;rcondt{2} 2. - + auto;progress;cut /#:= fcard_image_leq fst (rng G1.handles{hr}). - auto;smt ml=0 w=(hinv_image card_rng_set). - - auto;progress;3:by smt ml=0. - + by rewrite rng_set rem0 rng0 fset0U fcard1. - by apply max_ge0. - qed. - - (* TODO: move this *) - lemma c_gt0r : 0%r < (2^c)%r. - proof. by rewrite from_intM;apply /powPos. qed. - - lemma c_ge0r : 0%r <= (2^c)%r. - proof. by apply /ltrW/c_gt0r. qed. - - local lemma eps_ge0 : 0%r <= (2 * max_size)%r / (2 ^ c)%r. - proof. - apply divr_ge0;1:by rewrite from_intMle;smt ml=0 w=max_ge0. - by apply c_ge0r. - qed. - - local lemma Pr_col &m : - Pr[Gcol.main()@&m : G1.bcol /\ Gcol.count <= max_size] <= - max_size%r * ((2*max_size)%r / (2^c)%r). - proof. - fel 10 Gcol.count (fun x=> (2*max_size)%r / (2^c)%r) - max_size G1.bcol - [Gcol.sample_c : (card (image fst (rng G1.handles)) <= 2*max_size /\ Gcol.count < max_size)]=>//;2:by auto. - + rewrite /felsum Bigreal.sumr_const count_predT size_range. - apply ler_wpmul2r;1:by apply eps_ge0. - by rewrite from_intMle;smt ml=0 w=max_ge0. - + proc;sp;if;2:by hoare=>//??;apply eps_ge0. - wp. - rnd (mem (image fst (rng G1.handles)));skip;progress;2:smt ml=0. - rewrite (Mu_mem.mu_mem (image fst (rng G1.handles{hr})) cdistr (1%r/(2^c)%r))//. - + move=>x _;apply DWord.muxP. - rewrite (div_def (2 * _)%r) 1:from_intMeq;1:by apply /IntOrder.lt0r_neq0/powPos. - apply ler_wpmul2r;2:by rewrite from_intMle. - by apply divr_ge0=>//;apply /c_ge0r. - + move=>ci;proc;rcondt 2;auto=>/#. - move=> b c;proc;sp;if;auto;smt ml=0. - qed. - -end section PROOF. -*) - -print RO. - -clone import GenEager as Gen with - type from <- int, - type to <- capacity, - op sampleto <- fun (_:int) => cdistr - proof sampleto_ll by apply DWord.cdistr_ll. - -print RO. -print Functionality.RO. - -op bad_ext (m:('a*'b,'c)fmap) (y:'b) = +op bad_ext (m:smap) y = mem (map snd (elems (dom m))) y. -op hinvc (handles : (int,capacity) fmap) (c : capacity) : handle option = - find (+ pred1 c) handles. +op hinvc (m:(handle,capacity)fmap) (c:capacity) = + find (+ pred1 c) m. - module G2(D:DISTINGUISHER,HS:FRO) = { +module G2(D:DISTINGUISHER,HS:FRO) = { module C = { - + proc f(p : block list): block = { var sa, sa'; var h, i <- 0; @@ -351,7 +26,7 @@ op hinvc (handles : (int,capacity) fmap) (c : capacity) : handle option = (sa, h) <- oget G1.mh.[(sa +^ nth witness p i, h)]; } else { HS.sample(G1.chandle); - sa' <@ Functionality.RO.f(take (i+1) p); + sa' <@ F.RO.get(take (i+1) p); sa <- sa +^ nth witness p i; G1.mh.[(sa,h)] <- (sa', G1.chandle); G1.mhi.[(sa',G1.chandle)] <- (sa, h); @@ -360,21 +35,21 @@ op hinvc (handles : (int,capacity) fmap) (c : capacity) : handle option = } i <- i + 1; } - sa <- Functionality.RO.f(p); + sa <- F.RO.get(p); } return sa; } } - + module S = { - + proc f(x : state): state = { var p, v, y, y1, y2, hy2, hx2, handles_,t; - + if (!mem (dom G1.m) x) { if (mem (dom G1.paths) x.`2) { (p,v) <- oget G1.paths.[x.`2]; - y1 <- Functionality.RO.f (rcons p (v +^ x.`1)); + y1 <- F.RO.get (rcons p (v +^ x.`1)); y2 <$ cdistr; y <- (y1, y2); G1.paths.[y2] <- (rcons p (v +^ x.`1), y.`1); @@ -382,7 +57,7 @@ op hinvc (handles : (int,capacity) fmap) (c : capacity) : handle option = y <$ dstate; } (* exists x h, mem (dom G1.m) x /\ handles.[h] = Some (x.2, I) *) - + handles_ <@ HS.restrK(); if (!mem (rng handles_) x.`2) { HS.set(G1.chandle, x.`2); @@ -412,10 +87,10 @@ op hinvc (handles : (int,capacity) fmap) (c : capacity) : handle option = } return y; } - + proc fi(x : state): state = { var y, y1, y2, hx2, hy2, handles_, t; - + if (!mem (dom G1.mi) x) { handles_ <@ HS.restrK(); if (!mem (rng handles_) x.`2) { @@ -447,19 +122,19 @@ op hinvc (handles : (int,capacity) fmap) (c : capacity) : handle option = } return y; } - + } - + proc main(): bool = { var b; - - RO.m <- map0; + + F.RO.m <- map0; G1.m <- map0; G1.mi <- map0; G1.mh <- map0; G1.mhi <- map0; G1.bext <- false; - + (* the empty path is initially known by the adversary to lead to capacity 0^c *) HS.init(); HS.set(0,c0); @@ -470,7 +145,6 @@ op hinvc (handles : (int,capacity) fmap) (c : capacity) : handle option = } }. - section EXT. declare module D: DISTINGUISHER{C, PF, G1, G2}. @@ -478,244 +152,12 @@ section EXT. equiv G1_G2 : G1(D).main ~ G2(D,FRO).main : ={glob D} ==> ={res} /\ G1.bext{1} => (G1.bext{2} \/ exists x h, mem (dom G1.m{2}) x /\ FRO.m{2}.[h] = Some (x.`2, Unknown)). + proof. + proc. + admit. + qed. +end section EXT. - - -col.main -type from, to. - -op sampleto : from -> to distr. -axiom sampleto_ll : forall x, Distr.weight (sampleto x) = 1%r. - - -print Gen. - - clone import - - - - - -module type SAMPLE = { - proc sampleI(h:handle) : unit - proc setD(h:handle, c:capacity) : unit - proc get(h:handle) : capacity - proc in_dom(h:handle,c:caller) : bool - proc restrD() : (handle,capacity)fmap -}. - -module type ADV_SAMPLEH(O:SAMPLE) = { - proc main() : bool -}. - - -module Lsample = { - var handles : (handle, ccapacity)fmap - - proc sampleI(h:handle) = { - var c; - c <$ cdistr; - handles.[h] <- (c,I); - } - - proc setD (h:handle, c:capacity) = { - handles.[h] <- (c,D); - } - - proc in_dom(h:handle, c:caller) = { - return in_dom_with handles h c; - } - - proc restrD() = { - return ( - let m = NewFMap.filter (fun _ (p:ccapacity) => p.`2=D) handles in - NewFMap.map (fun _ (p:ccapacity) => p.`1) m); - } - - proc get(h:handle) = { - var c; - c <$ cdistr; - if (!mem (dom handles) h) { - handles.[h] <- (c,D); - } - return (oget (handles.[h])).`1; - } - -}. - -module Esample = { - var handles : (handle, ccapacity)fmap - - proc sampleI(h:handle) = { - var c; - c <$ cdistr; - handles.[h] <- (c,I); - } - - proc setD (h:handle, c:capacity) = { - handles.[h] <- (c,D); - } - - proc in_dom(h:handle, c:caller) = { - return in_dom_with handles h c; - } - - proc restrD() = { - return ( - let m = NewFMap.filter (fun _ (p:ccapacity) => p.`2=D) handles in - NewFMap.map (fun _ (p:ccapacity) => p.`1) m); - } - - proc get(h:handle) = { - var c; - c <$ cdistr; - if (!mem (dom handles) h || (oget handles.[h]).`2 = I) { - handles.[h] <- (c,D); - } - return (oget (handles.[h])).`1; - } - -}. - -op hinvc (handles : (handle,capacity)fmap) (c : capacity) : handle option = - find (fun _ => pred1 c) handles. - -module G2(D:DISTINGUISHER,HS:SAMPLE) = { - - module C = { - - proc f(p : block list): block = { - var sa, sa'; - var h, i <- 0; - sa <- b0; - if (1 <= size p /\ p <> [b0]) { - while (i < size p ) { - if (mem (dom G1.mh) (sa +^ nth witness p i, h)) { - (sa, h) <- oget G1.mh.[(sa +^ nth witness p i, h)]; - } else { - HS.sampleI(G1.chandle); - sa' <- RO.f(take (i+1) p); - sa <- sa +^ nth witness p i; - G1.mh.[(sa,h)] <- (sa', G1.chandle); - G1.mhi.[(sa',G1.chandle)] <- (sa, h); - (sa,h) <- (sa',G1.chandle); - G1.chandle <- G1.chandle + 1; - } - i <- i + 1; - } - sa <- RO.f(p); - } - return sa; - } - } - - module S = { - - proc f(x : state): state = { - var p, v, y, y1, y2, hy2, hx2, handles_,t; - - if (!mem (dom G1.m) x) { - if (mem (dom G1.paths) x.`2) { - (p,v) <- oget G1.paths.[x.`2]; - y1 <- RO.f (rcons p (v +^ x.`1)); - y2 <$ cdistr; - y <- (y1, y2); - G1.paths.[y2] <- (rcons p (v +^ x.`1), y.`1); - } else { - y <$ dstate; - } -(* G1.bext <- G1.bext \/ mem (rng handles) (x.`2, I); *) - (* exists x2 h, handles.[h] = Some (X2,I) *) - (* exists x h, mem (dom G1.m) x /\ handles.[h] = Some (x.2, I) *) - - handles_ <@ HS.restrD(); - if (!mem (rng handles_) x.`2) { - HS.setD(G1.chandle, x.`2); - G1.chandle <- G1.chandle + 1; - } - handles_ <- HS.restrD(); - hx2 <- oget (hinvc handles_ x.`2); - t <@ HS.in_dom((oget G1.mh.[(x.`1,hx2)]).`2, I); - if (mem (dom G1.mh) (x.`1, hx2) /\ t) { - hy2 <- (oget G1.mh.[(x.`1, hx2)]).`2; - y2 <@ HS.get(hy2); - (* bad <- bad \/ mem (map snd (dom G1.m)) y2 *) - -(* bext{1} => bad{2} \/ exists x h, mem (dom G1.m) x /\ handles.[h] = Some (x.2, I) *) - y <- (y.`1, y2); - G1.m.[x] <- y; - G1.mi.[y] <- x; - } else { - hy2 <- G1.chandle; - G1.chandle <- G1.chandle + 1; - HS.setD(hy2, y.`2); - G1.m.[x] <- y; - G1.mh.[(x.`1, hx2)] <- (y.`1, hy2); - G1.mi.[y] <- x; - G1.mhi.[(y.`1, hy2)] <- (x.`1, hx2); - } - } else { - y <- oget G1.m.[x]; - } - return y; - } - - proc fi(x : state): state = { - var y, y1, y2, hx2, hy2, handles_, t; - - if (!mem (dom G1.mi) x) { - (* bext <- bext \/ mem (rng handles) (x.`2, I); *) - (* exists x2 h, handles.[h] = Some (X2,I) *) - handles_ <@ HS.restrD(); - if (!mem (rng handles_) x.`2) { - HS.setD(G1.chandle, x.`2); - G1.chandle <- G1.chandle + 1; - } - handles_ <@ HS.restrD(); - hx2 <- oget (hinvc handles_ x.`2); - y <$ dstate; - t <@ HS.in_dom((oget G1.mh.[(x.`1,hx2)]).`2, I); - if (mem (dom G1.mhi) (x.`1, hx2) /\ t) { - (y1,hy2) <- oget G1.mhi.[(x.`1, hx2)]; - y2 <@ HS.get(hy2); - y <- (y.`1, y2); - (* bad <- bad \/ mem X2 y.`2; *) - G1.mi.[x] <- y; - G1.m.[y] <- x; - } else { - hy2 <- G1.chandle; - G1.chandle <- G1.chandle + 1; - HS.setD(hy2, y.`2); - G1.mi.[x] <- y; - G1.mhi.[(x.`1, hx2)] <- (y.`1, hy2); - G1.m.[y] <- x; - G1.mh.[(y.`1, hy2)] <- (x.`1, hx2); - } - } else { - y <- oget G1.mi.[x]; - } - return y; - } - - } - - proc main(): bool = { - var b; - - RO.m <- map0; - G1.m <- map0; - G1.mi <- map0; - G1.mh <- map0; - G1.mhi <- map0; - G1.bext <- false; - (* the empty path is initially known by the adversary to lead to capacity 0^c *) - HS.setD(0,c0); - G1.paths <- map0.[c0 <- ([<:block>],b0)]; - G1.chandle <- 1; - b <@ D(C,S).distinguish(); - return b; - } -}. -*) \ No newline at end of file + diff --git a/proof/old/Gcol.eca b/proof/old/Gcol.eca new file mode 100644 index 0000000..24778fd --- /dev/null +++ b/proof/old/Gcol.eca @@ -0,0 +1,321 @@ +require import Pred Fun Option Pair Int Real RealExtra StdOrder Ring StdBigop. +require import List FSet NewFMap Utils Common SLCommon RndO FelTactic Mu_mem. +(*...*) import Dprod Dexcepted Capacity IntOrder Bigreal RealOrder BRA. + +require (*..*) Handle. + +clone export Handle as Handle0. + export ROhandle. + +(* -------------------------------------------------------------------------- *) + +section PROOF. + declare module D: DISTINGUISHER{C, PF, G1}. + + axiom D_ll (F <: DFUNCTIONALITY{D}) (P <: DPRIMITIVE{D}): + islossless P.f => islossless P.fi => + islossless F.f => islossless D(F, P).distinguish. + + local module Gcol = { + + var count : int + + proc sample_c () = { + var c=c0; + if (card (image fst (rng FRO.m)) <= 2*max_size /\ + count < max_size) { + c <$ cdistr; + G1.bcol <- G1.bcol \/ mem (image fst (rng FRO.m)) c; + count <- count + 1; + } + + return c; + } + + module C = { + + proc f(p : block list): block = { + var sa, sa', sc; + var h, i <- 0; + sa <- b0; + if (1 <= size p /\ p <> [b0]) { + while (i < size p ) { + if (mem (dom G1.mh) (sa +^ nth witness p i, h)) { + (sa, h) <- oget G1.mh.[(sa +^ nth witness p i, h)]; + } else { + sc <@ sample_c(); + sa' <- F.RO.get(take (i+1) p); + sa <- sa +^ nth witness p i; + G1.mh.[(sa,h)] <- (sa', G1.chandle); + G1.mhi.[(sa',G1.chandle)] <- (sa, h); + (sa,h) <- (sa',G1.chandle); + FRO.m.[G1.chandle] <- (sc,Unknown); + G1.chandle <- G1.chandle + 1; + } + i <- i + 1; + } + sa <- F.RO.get(p); + } + return sa; + } + } + + module S = { + + proc f(x : state): state = { + var p, v, y, y1, y2, hy2, hx2; + + if (!mem (dom G1.m) x) { + if (!(mem (rng FRO.m) (x.`2, Known))) { + FRO.m.[G1.chandle] <- (x.`2, Known); + G1.chandle <- G1.chandle + 1; + } + hx2 <- oget (hinvK FRO.m x.`2); + + if (mem (dom G1.paths) x.`2) { + (p,v) <- oget G1.paths.[x.`2]; + y1 <- F.RO.get (rcons p (v +^ x.`1)); + y2 <@ sample_c(); + y <- (y1, y2); + G1.paths.[y2] <- (rcons p (v +^ x.`1), y.`1); + } else { + y1 <$ bdistr; + y2 <@ sample_c(); + y <- (y1,y2); + } + if (mem (dom G1.mh) (x.`1, hx2) /\ + in_dom_with FRO.m (oget G1.mh.[(x.`1,hx2)]).`2 Unknown) { + hy2 <- (oget G1.mh.[(x.`1, hx2)]).`2; + y <- (y.`1, (oget FRO.m.[hy2]).`1); + FRO.m.[hy2] <- (y.`2, Known); + G1.m.[x] <- y; + G1.mi.[y] <- x; + } else { + hy2 <- G1.chandle; + G1.chandle <- G1.chandle + 1; + FRO.m.[hy2] <- (y.`2, Known); + G1.m.[x] <- y; + G1.mh.[(x.`1, hx2)] <- (y.`1, hy2); + G1.mi.[y] <- x; + G1.mhi.[(y.`1, hy2)] <- (x.`1, hx2); + } + } else { + y <- oget G1.m.[x]; + } + return y; + } + + proc fi(x : state): state = { + var y, y1, y2, hx2, hy2; + + if (!mem (dom G1.mi) x) { + if (!(mem (rng FRO.m) (x.`2, Known))) { + FRO.m.[G1.chandle] <- (x.`2, Known); + G1.chandle <- G1.chandle + 1; + } + hx2 <- oget (hinvK FRO.m x.`2); + y1 <$ bdistr; + y2 <@ sample_c(); + y <- (y1,y2); + if (mem (dom G1.mhi) (x.`1, hx2) /\ + in_dom_with FRO.m (oget G1.mhi.[(x.`1,hx2)]).`2 Unknown) { + (y1,hy2) <- oget G1.mhi.[(x.`1, hx2)]; + y <- (y.`1, (oget FRO.m.[hy2]).`1); + FRO.m.[hy2] <- (y.`2, Known); + G1.mi.[x] <- y; + G1.m.[y] <- x; + } else { + hy2 <- G1.chandle; + G1.chandle <- G1.chandle + 1; + FRO.m.[hy2] <- (y.`2, Known); + G1.mi.[x] <- y; + G1.mhi.[(x.`1, hx2)] <- (y.`1, hy2); + G1.m.[y] <- x; + G1.mh.[(y.`1, hy2)] <- (x.`1, hx2); + } + } else { + y <- oget G1.mi.[x]; + } + return y; + } + + } + + proc main(): bool = { + var b; + + F.RO.m <- map0; + G1.m <- map0; + G1.mi <- map0; + G1.mh <- map0; + G1.mhi <- map0; + G1.bcol <- false; + + FRO.m <- map0.[0 <- (c0, Known)]; + G1.paths <- map0.[c0 <- ([<:block>],b0)]; + G1.chandle <- 1; + count <- 0; + b <@ DRestr(D,C,S).distinguish(); + return b; + } + }. + + lemma card_rng_set (m:('a,'b)fmap) x y: card(rng m.[x<-y]) <= card(rng m) + 1. + proof. + rewrite rng_set fcardU fcard1. + cut := subset_leq_fcard (rng (rem x m)) (rng m) _;2:smt ml=0 w=fcard_ge0. + rewrite subsetP=> z;apply rng_rem_le. + qed. + + lemma hinv_image handles c: + hinv handles c <> None => + mem (image fst (rng handles)) c. + proof. + case: (hinv handles c) (hinvP handles c)=>//= h[f] Heq. + rewrite imageP;exists (c,f)=>@/fst/=. + by rewrite in_rng;exists (oget (Some h)). + qed. + + local equiv G1col : G1(DRestr(D)).main ~ Gcol.main : + ={glob D} ==> (G1.bcol{1} => G1.bcol{2}) /\ Gcol.count{2} <= max_size. + proof. + proc;inline*;wp. + call (_: ={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m,C.c}/\ + (G1.bcol{1} => G1.bcol{2}) /\ + (card (rng FRO.m) <= 2*C.c + 1 /\ + Gcol.count <= C.c <= max_size){2}). + + proc;sp 1 1;if=>//. + inline G1(DRestr(D)).S.f Gcol.S.f. + seq 2 2 : (={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m, + C.c,x0} /\ + (G1.bcol{1} => G1.bcol{2}) /\ + (card(rng FRO.m) + 2 <= 2*C.c + 1/\ + Gcol.count + 1 <= C.c <= max_size){2});1:by auto=>/#. + if=>//;last by auto=>/#. + swap{1}[2..4]-1. + seq 3 2:(={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m, + C.c,x0,hx2} /\ + (G1.bcol{1} => G1.bcol{2}) /\ + (card (rng FRO.m) + 1 <= 2 * C.c + 1/\ + Gcol.count + 1 <= C.c <= max_size){2}). + + auto;smt ml=0 w=card_rng_set. + seq 1 1: + (={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m, + C.c,x0,hx2,y0} /\ + ((G1.bcol\/hinv FRO.m y0.`2 <> None){1} => G1.bcol{2}) /\ + (card (rng FRO.m) + 1 <= 2 * C.c + 1 /\ + Gcol.count <= C.c <= max_size){2});last by auto;smt ml=0 w=card_rng_set. + if=>//;inline Gcol.sample_c. + + rcondt{2}4. + + auto;conseq (_:true)=>//;progress;2: smt ml=0. + cut /#:= fcard_image_leq fst (rng FRO.m{hr}). + wp;conseq (_: ={p,v,F.RO.m,y1} /\ y2{1}=c{2})=>//;1:smt ml=0 w=hinv_image. + sim. + rcondt{2}3. + + by auto;progress;cut /#:= fcard_image_leq fst (rng FRO.m{hr}). + swap{2}2-1;sp 0 1;wp;conseq(_:y0{1}=(y1,c){2})=>//;1:smt ml=0 w=hinv_image. + transitivity{1} {y0 <- S.sample();} + (true ==> ={y0}) + (true ==> y0{1}=(y1,c){2})=>//;1:by inline*;auto. + transitivity{2} {(y1,c) <- S.sample2();} + (true==>y0{1}=(y1,c){2}) + (true==> ={y1,c})=>//;2:by inline*;auto. + by call sample_sample2;auto=> /=?[??]->. + + + proc;sp 1 1;if=>//. + inline G1(DRestr(D)).S.fi Gcol.S.fi. + seq 2 2 : (={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m, + C.c,x0} /\ + (G1.bcol{1} => G1.bcol{2}) /\ + (card(rng FRO.m) + 2 <= 2*C.c + 1 /\ + Gcol.count + 1 <= C.c <= max_size){2});1:by auto=>/#. + if=>//;last by auto=>/#. + seq 3 2:(={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m, + C.c,x0,hx2} /\ + (G1.bcol{1} => G1.bcol{2}) /\ + (card (rng FRO.m) + 1 <= 2 * C.c + 1 /\ + Gcol.count + 1 <= C.c <= max_size){2}). + + by auto;smt ml=0 w=card_rng_set. + seq 1 2: + (={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m, + C.c,x0,hx2} /\ y0{1} = (y1,y2){2} /\ + ((G1.bcol\/hinv FRO.m y0.`2 <> None){1} => G1.bcol{2}) /\ + (card (rng FRO.m) + 1 <= 2 * C.c + 1 /\ + Gcol.count <= C.c <= max_size){2});2:by auto;smt w=card_rng_set. + inline Gcol.sample_c. + rcondt{2}3. + + by auto;progress;cut /#:= fcard_image_leq fst (rng FRO.m{hr}). + swap{2}2-1;sp 0 1;wp;conseq(_:y0{1}=(y1,c){2})=>//;1:smt ml=0 w=hinv_image. + transitivity{1} {y0 <- S.sample();} + (true ==> ={y0}) + (true ==> y0{1}=(y1,c){2})=>//;1:by inline*;auto. + transitivity{2} {(y1,c) <- S.sample2();} + (true==>y0{1}=(y1,c){2}) + (true==> ={y1,c})=>//;2:by inline*;auto. + by call sample_sample2;auto=> /=?[??]->. + + + proc;sp 1 1;if=>//. + inline G1(DRestr(D)).C.f Gcol.C.f. + seq 5 5: + (={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m,C.c,b, + p,h,i,sa} /\ i{1}=0 /\ + (G1.bcol{1} => G1.bcol{2}) /\ + card (rng FRO.m{2}) + 2*(size p{2}) <= 2 * C.c{2} + 1 /\ + Gcol.count{2} + size p{2} <= C.c{2} <= max_size);1:by auto=>/#. + wp;if=>//;2:by auto;smt ml=0 w=size_ge0. + call (_: ={F.RO.m});1:by sim. + while + (={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m,C.c,b, + p,h,i,sa} /\ (i <= size p){1} /\ + (G1.bcol{1} => G1.bcol{2}) /\ + (card (rng FRO.m) + 2*(size p - i) <= 2 * C.c + 1 /\ + Gcol.count + size p - i <= C.c <= max_size){2}); + last by auto; smt ml=0 w=size_ge0. + if=>//;auto;1:smt ml=0 w=size_ge0. + call (_: ={F.RO.m});1:by sim. + inline *;rcondt{2} 2. + + auto;progress;cut /#:= fcard_image_leq fst (rng FRO.m{hr}). + auto;smt ml=0 w=(hinv_image card_rng_set). + + auto;progress;3:by smt ml=0. + + by rewrite rng_set rem0 rng0 fset0U fcard1. + by apply max_ge0. + qed. + + (* TODO: move this *) + lemma c_gt0r : 0%r < (2^c)%r. + proof. by rewrite lt_fromint;apply /powPos. qed. + + lemma c_ge0r : 0%r <= (2^c)%r. + proof. by apply /ltrW/c_gt0r. qed. + + local lemma eps_ge0 : 0%r <= (2 * max_size)%r / (2 ^ c)%r. + proof. + apply divr_ge0;1:by rewrite le_fromint;smt ml=0 w=max_ge0. + by apply c_ge0r. + qed. + + local lemma Pr_col &m : + Pr[Gcol.main()@&m : G1.bcol /\ Gcol.count <= max_size] <= + max_size%r * ((2*max_size)%r / (2^c)%r). + proof. + fel 10 Gcol.count (fun x=> (2*max_size)%r / (2^c)%r) + max_size G1.bcol + [Gcol.sample_c : (card (image fst (rng FRO.m)) <= 2*max_size /\ Gcol.count < max_size)]=>//;2:by auto. + + rewrite /felsum Bigreal.sumr_const count_predT size_range. + apply ler_wpmul2r;1:by apply eps_ge0. + by rewrite le_fromint;smt ml=0 w=max_ge0. + + proc;sp;if;2:by hoare=>//??;apply eps_ge0. + wp. + rnd (mem (image fst (rng FRO.m)));skip;progress;2:smt ml=0. + rewrite (Mu_mem.mu_mem (image fst (rng FRO.m{hr})) cdistr (1%r/(2^c)%r))//. + + move=>x _;apply DWord.muxP. + apply ler_wpmul2r;2:by rewrite le_fromint. + by apply divr_ge0=>//;apply /c_ge0r. + + move=>ci;proc;rcondt 2;auto=>/#. + move=> b c;proc;sp;if;auto;smt ml=0. + qed. + +end section PROOF. + + diff --git a/proof/old/Handle.eca b/proof/old/Handle.eca index d5deb5c..b93dea6 100644 --- a/proof/old/Handle.eca +++ b/proof/old/Handle.eca @@ -4,22 +4,19 @@ require import List FSet NewFMap Utils Common SLCommon RndO. require ConcreteF. -clone import GenEager as Gen with +clone import GenEager as ROhandle with type from <- handle, type to <- capacity, op sampleto <- fun (_:int) => cdistr proof sampleto_ll by apply DWord.cdistr_ll. -print hinv. module G1(D:DISTINGUISHER) = { var m, mi : smap var mh, mhi : hsmap - var handles : handles var chandle : int var paths : (capacity, block list * block) fmap var bext, bcol : bool - module C = { proc f(p : block list): block = { @@ -32,18 +29,18 @@ module G1(D:DISTINGUISHER) = { (sa, h) <- oget mh.[(sa +^ nth witness p i, h)]; } else { sc <$ cdistr; - bcol <- bcol \/ hinv handles sc <> None; - sa' <@ RO.f(take (i+1) p); + bcol <- bcol \/ hinv FRO.m sc <> None; + sa' <@ F.RO.get(take (i+1) p); sa <- sa +^ nth witness p i; mh.[(sa,h)] <- (sa', chandle); mhi.[(sa',chandle)] <- (sa, h); (sa,h) <- (sa',chandle); - handles.[chandle] <- (sc,I); + FRO.m.[chandle] <- (sc,Unknown); chandle <- chandle + 1; } i <- i + 1; } - sa <- RO.f(p); + sa <- F.RO.get(p); } return sa; } @@ -57,32 +54,32 @@ module G1(D:DISTINGUISHER) = { if (!mem (dom m) x) { if (mem (dom paths) x.`2) { (p,v) <- oget paths.[x.`2]; - y1 <- RO.f (rcons p (v +^ x.`1)); + y1 <- F.RO.get (rcons p (v +^ x.`1)); y2 <$ cdistr; y <- (y1, y2); paths.[y2] <- (rcons p (v +^ x.`1), y.`1); } else { y <$ dstate; } - bext <- bext \/ mem (rng handles) (x.`2, I); + bext <- bext \/ mem (rng FRO.m) (x.`2, Unknown); (* exists x2 h, handles.[h] = Some (X2,I) *) - if (!(mem (rng handles) (x.`2, D))) { - handles.[chandle] <- (x.`2, D); + if (!(mem (rng FRO.m) (x.`2, Known))) { + FRO.m.[chandle] <- (x.`2, Known); chandle <- chandle + 1; } - hx2 <- oget (hinvD handles x.`2); - if (mem (dom mh) (x.`1, hx2) /\ in_dom_with handles (oget mh.[(x.`1,hx2)]).`2 I) { + hx2 <- oget (hinvK FRO.m x.`2); + if (mem (dom mh) (x.`1, hx2) /\ in_dom_with FRO.m (oget mh.[(x.`1,hx2)]).`2 Unknown) { hy2 <- (oget mh.[(x.`1, hx2)]).`2; - y <- (y.`1, (oget handles.[hy2]).`1); - handles.[hy2] <- (y.`2, D); + y <- (y.`1, (oget FRO.m.[hy2]).`1); + FRO.m.[hy2] <- (y.`2, Known); (* bad <- bad \/ mem X2 y.`2; *) m.[x] <- y; mi.[y] <- x; } else { - bcol <- bcol \/ hinv handles y.`2 <> None; + bcol <- bcol \/ hinv FRO.m y.`2 <> None; hy2 <- chandle; chandle <- chandle + 1; - handles.[hy2] <- (y.`2, D); + FRO.m.[hy2] <- (y.`2, Known); m.[x] <- y; mh.[(x.`1, hx2)] <- (y.`1, hy2); mi.[y] <- x; @@ -98,27 +95,27 @@ module G1(D:DISTINGUISHER) = { var y, y1, hx2, hy2; if (!mem (dom mi) x) { - bext <- bext \/ mem (rng handles) (x.`2, I); + bext <- bext \/ mem (rng FRO.m) (x.`2, Unknown); (* exists x2 h, handles.[h] = Some (X2,I) *) - if (!(mem (rng handles) (x.`2, D))) { - handles.[chandle] <- (x.`2, D); + if (!(mem (rng FRO.m) (x.`2, Known))) { + FRO.m.[chandle] <- (x.`2, Known); chandle <- chandle + 1; } - hx2 <- oget (hinvD handles x.`2); + hx2 <- oget (hinvK FRO.m x.`2); y <$ dstate; if (mem (dom mhi) (x.`1,hx2) /\ - in_dom_with handles (oget mhi.[(x.`1,hx2)]).`2 I) { + in_dom_with FRO.m (oget mhi.[(x.`1,hx2)]).`2 Unknown) { (y1,hy2) <- oget mhi.[(x.`1, hx2)]; - y <- (y.`1, (oget handles.[hy2]).`1); - handles.[hy2] <- (y.`2, D); + y <- (y.`1, (oget FRO.m.[hy2]).`1); + FRO.m.[hy2] <- (y.`2, Known); (* bad <- bad \/ mem X2 y.`2; *) mi.[x] <- y; m.[y] <- x; } else { - bcol <- bcol \/ hinv handles y.`2 <> None; + bcol <- bcol \/ hinv FRO.m y.`2 <> None; hy2 <- chandle; chandle <- chandle + 1; - handles.[hy2] <- (y.`2, D); + FRO.m.[hy2] <- (y.`2, Known); mi.[x] <- y; mhi.[(x.`1, hx2)] <- (y.`1, hy2); m.[y] <- x; @@ -135,7 +132,7 @@ module G1(D:DISTINGUISHER) = { proc main(): bool = { var b; - RO.m <- map0; + F.RO.m <- map0; m <- map0; mi <- map0; mh <- map0; @@ -144,7 +141,7 @@ module G1(D:DISTINGUISHER) = { bcol <- false; (* the empty path is initially known by the adversary to lead to capacity 0^c *) - handles <- map0.[0 <- (c0, D)]; + FRO.m <- map0.[0 <- (c0, Known)]; paths <- map0.[c0 <- ([<:block>],b0)]; chandle <- 1; b <@ D(C,S).distinguish(); @@ -171,7 +168,7 @@ op mh_spec (handles:handles) (m2:smap) (mh:hsmap) (ro:(block list, block)fmap) = exists c f c' f', handles.[bh .`2]=Some(c,f) /\ handles.[bh'.`2]=Some(c',f') /\ - if f' = D then m2.[(bh.`1,c)] = Some(bh'.`1,c') /\ f = D + if f' = Known then m2.[(bh.`1,c)] = Some(bh'.`1,c') /\ f = Known else exists p v b, ro.[rcons p b] = Some bh'.`1 /\ @@ -186,10 +183,10 @@ op paths_spec (handles:handles) (mh:hsmap) (paths:(capacity,block list * block)f forall c p v, paths.[c] = Some(p,v) <=> exists h, build_hpath mh p = Some(v,h) /\ - handles.[h] = Some(c,D). + handles.[h] = Some(c,Known). op handles_spec handles chandle = - huniq handles /\ handles.[0] = Some (c0,D) /\ forall h, mem (dom handles) h => h < chandle. + huniq handles /\ handles.[0] = Some (c0,Known) /\ forall h, mem (dom handles) h => h < chandle. op INV_CF_G1 (handles:handles) chandle (m1 mi1 m2 mi2:smap) (mh2 mhi2:hsmap) (ro:(block list, block) fmap) paths = (eqm_handles handles m1 mh2 /\ eqm_handles handles mi1 mhi2) /\ @@ -215,7 +212,7 @@ proof. move=> Hh;apply /IntOrder.ltr_eqF/(chandle_ge0 _ _ Hh). qed. lemma eqm_up_handles handles chandle m mh x2 : handles_spec handles chandle => eqm_handles handles m mh => - eqm_handles handles.[chandle <- (x2, D)] m mh. + eqm_handles handles.[chandle <- (x2, Known)] m mh. proof. move=> []Hu[Hh0 Hlt][]H1 H2;split=> [bc bc'/H1 [h h' f f'][]Hh[]Hh' Hmh| bh bh'/H2 [c c' f f'][]Hh []Hh' Hm]. @@ -257,7 +254,7 @@ proof. qed. lemma handles_up_handles handles chandle x2 f': - (forall (f : caller), ! mem (rng handles) (x2, f)) => + (forall (f : flag), ! mem (rng handles) (x2, f)) => handles_spec handles chandle => handles_spec handles.[chandle <- (x2, f')] (chandle + 1). proof. @@ -276,7 +273,7 @@ qed. lemma INV_CF_G1_up_handles handles chandle m1 mi1 m2 mi2 mh mhi ro paths x2: INV_CF_G1 handles chandle m1 mi1 m2 mi2 mh mhi ro paths => (forall f, ! mem (rng handles) (x2, f)) => - INV_CF_G1 handles.[chandle <- (x2, D)](chandle+1) m1 mi1 m2 mi2 mh mhi ro paths. + INV_CF_G1 handles.[chandle <- (x2, Known)](chandle+1) m1 mi1 m2 mi2 mh mhi ro paths. proof. move=>[][]Heqm Heqmi[]Hincl[]Hmh[]Hp Hh Hx2;split. + by split;apply eqm_up_handles. @@ -300,7 +297,9 @@ section AUX. ={glob D} ==> !(G1.bcol \/ G1.bext){2} => ={res}. proof. proc. - call (_:(G1.bcol \/ G1.bext), INV_CF_G1 G1.handles{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} RO.m{2} G1.paths{2}). + call (_:(G1.bcol \/ G1.bext), + INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} + G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2}). (* lossless D *) + apply D_ll. (** proofs for G1.S.f *) @@ -310,58 +309,59 @@ section AUX. + rcondt{2} 1. + move=> &hr;skip=> &hr'[][]_[]<-[]_[][]Hincl Hincli _. rewrite !in_dom/==>H; by case:(G1.m{hr'}.[x{hr}]) (Hincl x{hr})=> //=;rewrite H. - exists* RO.m{2}, G1.paths{2};elim*=>ro0 paths0. - seq 1 2 : (!G1.bcol{2} /\ (G1.bext = mem (rng G1.handles) (x.`2, I)){2} /\ + exists* F.RO.m{2}, G1.paths{2};elim*=>ro0 paths0. + seq 1 2 : (!G1.bcol{2} /\ (G1.bext = mem (rng FRO.m) (x.`2, Unknown)){2} /\ ={x,y} /\ - INV_CF_G1 G1.handles{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} ro0 paths0 /\ + INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} + G1.mh{2} G1.mhi{2} ro0 paths0 /\ ! mem (dom PF.m{1}) x{1} /\ (if mem (dom paths0) x.`2 then let (p,v) = oget paths0.[x.`2] in - RO.m{2} = ro0.[rcons p (v+^x.`1) <- y.`1] /\ + F.RO.m{2} = ro0.[rcons p (v+^x.`1) <- y.`1] /\ G1.paths = paths0.[y.`2 <- (rcons p (v +^ x.`1), y.`1)] - else RO.m = ro0 /\ G1.paths = paths0){2}). + else F.RO.m = ro0 /\ G1.paths = paths0){2}). + wp 1 1;conseq (_: ={y} /\ if mem (dom paths0) x{2}.`2 then let (p0, v0) = oget paths0.[x{2}.`2] in - RO.m{2} = ro0.[rcons p0 (v0 +^ x{2}.`1) <- y{2}.`1] /\ + F.RO.m{2} = ro0.[rcons p0 (v0 +^ x{2}.`1) <- y{2}.`1] /\ G1.paths{2} = paths0.[y{2}.`2 <- (rcons p0 (v0 +^ x{2}.`1), y{2}.`1)] - else RO.m{2} = ro0 /\ G1.paths{2} = paths0);1:smt ml=0. + else F.RO.m{2} = ro0 /\ G1.paths{2} = paths0);1:smt ml=0. if{2};2:by auto=>/#. - inline{2} RO.f;rcondt{2} 4. + inline{2} F.RO.get;rcondt{2} 4. + move=> &ml;auto=>/= &mr[][]_[][]_[]->[][][]_ Heqm _[]_[][]_ Hro[] Hpath _ HnPFm. rewrite in_dom;case:(G1.paths{mr}.[_]) (Hpath x{mr}.`2)=>//[[p v]]/(_ p v)/=[h][]Hbu Hh b _. rewrite -not_def=> /Hro [??h'];rewrite oget_some Hbu => -[][]<- <- /=. rewrite Block.xorwA Block.xorwK Block.xorwC Block.xorw0 -not_def=>/Heqm [c c' f f']. by rewrite Hh=> -[][]<- _[]_ Hm;move:HnPFm;rewrite in_dom;case:(x{mr}) Hm=> ??->. - swap{2} 3-2;swap{2}6-4;wp;conseq (_:y{1} =(rd,y2){2}). + swap{2} 3-2;swap{2}6-4;wp;conseq (_:y{1} =(r,y2){2}). + progress [-split];rewrite getP_eq oget_some H2/=. by move:H2;rewrite in_dom;case:(G1.paths{2}.[_]). - transitivity{1} {y <- S.sample();} (true ==> ={y}) (true==>y{1}=(rd,y2){2})=>//;1:by inline*;auto. - transitivity{2} {(rd,y2) <- S.sample2();} (true==>y{1}=(rd,y2){2}) (true==> ={rd,y2})=>//;2:by inline*;auto. + transitivity{1} {y <- S.sample();} (true ==> ={y}) (true==>y{1}=(r,y2){2})=>//;1:by inline*;auto. + transitivity{2} {(r,y2) <- S.sample2();} (true==>y{1}=(r,y2){2}) (true==> ={r,y2})=>//;2:by inline*;auto. by call sample_sample2;auto=> /=?[??]->. - case (mem (rng G1.handles{2}) (x{2}.`2, I)). + case (mem (rng FRO.m{2}) (x{2}.`2, Unknown)). + conseq (_:true);[by move=> ??[][]_[]->_->|auto]. conseq (_: !G1.bcol{2} => oget PF.m{1}.[x{1}] = y{2} /\ - INV_CF_G1 G1.handles{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} RO.m{2} G1.paths{2}). + INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2}). + by move=> ??[][]_[]->[][]-> _ _ ->. seq 0 2: ((!G1.bcol{2} /\ ={x, y} /\ - INV_CF_G1 G1.handles{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} + INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} ro0 paths0 /\ ! mem (dom PF.m{1}) x{1} /\ if mem (dom paths0) x{2}.`2 then let (p0, v0) = oget paths0.[x{2}.`2] in - RO.m{2} = ro0.[rcons p0 (v0 +^ x{2}.`1) <- y{2}.`1] /\ + F.RO.m{2} = ro0.[rcons p0 (v0 +^ x{2}.`1) <- y{2}.`1] /\ G1.paths{2} = paths0.[y{2}.`2 <- (rcons p0 (v0 +^ x{2}.`1), y{2}.`1)] - else RO.m{2} = ro0 /\ G1.paths{2} = paths0) /\ - !mem (rng G1.handles{2}) (x{2}.`2, I) /\ - (G1.handles.[hx2]=Some(x.`2,D)){2}). + else F.RO.m{2} = ro0 /\ G1.paths{2} = paths0) /\ + !mem (rng FRO.m{2}) (x{2}.`2, Unknown) /\ + (FRO.m.[hx2]=Some(x.`2,Known)){2}). + auto=> &ml&mr[][]->[]_[][]-> ->[]Hinv []-> -> ^Hrng-> /=. - case (mem (rng G1.handles{mr}) (x{mr}.`2, D))=> Hmem /=. - + by split=>//;apply /huniq_hinvD=>//;move:Hinv;rewrite /INV_CF_G1/handles_spec. + case (mem (rng FRO.m{mr}) (x{mr}.`2, Known))=> Hmem /=. + + by split=>//;apply /huniq_hinvK=>//;move:Hinv;rewrite /INV_CF_G1/handles_spec. rewrite -anda_and;split=> [ | {Hinv}Hinv]. + by apply INV_CF_G1_up_handles=>//[[]]. - rewrite rng_set (huniq_hinvD_h G1.chandle{mr}) ?getP//. + rewrite rng_set (huniq_hinvK_h G1.chandle{mr}) ?getP//. + by move:Hinv;rewrite /INV_CF_G1/handles_spec. by rewrite oget_some /=!inE/=;move:Hrng;apply NewLogic.contraLR=>/=;apply rng_rem_le. rcondf{2} 1. @@ -398,7 +398,7 @@ end section AUX. section. - declare module D: DISTINGUISHER{Perm, C, PF, G1}. + declare module D: DISTINGUISHER{Perm, C, PF, G1, RO}. axiom D_ll (F <: DFUNCTIONALITY{D}) (P <: DPRIMITIVE{D}): islossless P.f => islossless P.fi => @@ -406,7 +406,7 @@ section. lemma Real_G1 &m: Pr[GReal(D).main() @ &m: res /\ C.c <= max_size] <= - Pr[G1(DRestr(D)).main() @ &m: res] + bound_concrete + + Pr[G1(DRestr(D)).main() @ &m: res] + ((max_size + 1) ^ 2)%r * mu dstate (pred1 witness) + Pr[G1(DRestr(D)).main() @&m: G1.bcol] + Pr[G1(DRestr(D)).main() @&m: G1.bext]. proof. apply (RealOrder.ler_trans _ _ _ (Real_Concrete D D_ll &m)). diff --git a/proof/old/SLCommon.ec b/proof/old/SLCommon.ec index 280bcc9..468adc5 100644 --- a/proof/old/SLCommon.ec +++ b/proof/old/SLCommon.ec @@ -19,7 +19,6 @@ clone include Indifferentiability with rename [module] "GReal" as "RealIndif" [module] "GIdeal" as "IdealIndif". - (** max number of call to the permutation and its inverse, including those performed by the construction. *) op max_size : { int | 0 <= max_size } as max_ge0. @@ -74,8 +73,6 @@ op incl (m m':('a,'b)fmap) = (* -------------------------------------------------------------------------- *) (** usefull type and operators for the proof **) -type caller = [ I | D ]. - type handle = int. type hstate = block * handle. @@ -86,14 +83,6 @@ type smap = (state , state ) fmap. type hsmap = (hstate, hstate ) fmap. type handles = (handle, ccapacity) fmap. -(* Did we use it? *) -op (<=) (o1 o2 : caller) = o1 = I \/ o2 = D. - -(* Did we use it? *) -op max (o1 o2 : caller) = - with o1 = I => o2 - with o1 = D => D. - pred is_pre_permutation (m mi : ('a,'a) fmap) = (forall x, mem (rng m) x => mem (dom mi) x) /\ (forall x, mem (rng mi) x => mem (dom m) x). From 54e8b23f77e1b172a412dc069cebd1127b13f3f6 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Wed, 20 Jan 2016 15:32:36 +0100 Subject: [PATCH 116/525] push for the others --- proof/RndO.ec | 5 +- proof/old/G2.eca | 319 ++++++++++++++++++++++++++++++++++++++++-- proof/old/SLCommon.ec | 12 +- 3 files changed, 313 insertions(+), 23 deletions(-) diff --git a/proof/RndO.ec b/proof/RndO.ec index 4bf405c..a8c21dc 100644 --- a/proof/RndO.ec +++ b/proof/RndO.ec @@ -1,3 +1,4 @@ +pragma -oldip. require import Pair Option List FSet NewFMap. import NewLogic Fun. require IterProc. @@ -447,7 +448,7 @@ proof. { Iter(RRO.I).iter_1s(x,elems (dom (restr Unknown FRO.m) `\` fset1 x)); } (={x,FRO.m}/\(in_dom_with FRO.m x Unknown){1}==> ={x,FRO.m}) (={x,FRO.m}/\ (in_dom_with FRO.m x Unknown){1} ==> (rem x FRO.m){1} = FRO.m{2})=>//. - + by move=>?&mr[*]2!->_;exists FRO.m{mr}, x{mr}. + + by move=>?&mr[*]2!->?;exists FRO.m{mr}, x{mr}. + symmetry;call (iter1_perm RRO.I iter_perm2);skip=>?&mr[*]2!->?/=;split=>//. by apply /perm_eq_sym/perm_to_rem/dom_restr. inline{1}Iter(RRO.I).iter_1s. @@ -496,7 +497,7 @@ proof. eager proc;inline *;wp. while (={l,FRO.m} /\ (forall z, mem l z => in_dom_with FRO.m z Unknown){1} /\ restr Known FRO.m{1} = result{2}). - + auto=>?&mr[*]2!->Hz<-?_/=?->/=. + + auto=>?&mr[*]2!->Hz<-?H/=?->/=. split=>[z /mem_drop Hm|];1:by rewrite /in_dom_with dom_set getP !inE /#. rewrite restr_set rem_id?dom_restr//. by move:H=>/(mem_head_behead witness) /(_ (head witness l{mr})) /= /Hz /#. diff --git a/proof/old/G2.eca b/proof/old/G2.eca index 8dda61d..c1464d0 100644 --- a/proof/old/G2.eca +++ b/proof/old/G2.eca @@ -1,3 +1,4 @@ +pragma -oldip. require import Pred Fun Option Pair Int Real RealExtra StdOrder Ring StdBigop. require import List FSet NewFMap Utils Common SLCommon RndO FelTactic Mu_mem. (*...*) import Dprod Dexcepted Capacity IntOrder Bigreal RealOrder BRA. @@ -7,7 +8,8 @@ require (*..*) Gcol. clone export Gcol as Gcol0. op bad_ext (m:smap) y = - mem (map snd (elems (dom m))) y. + mem (map snd (elems (dom m))) y \/ + mem (map snd (elems (rng m))) y. op hinvc (m:(handle,capacity)fmap) (c:capacity) = find (+ pred1 c) m. @@ -31,7 +33,7 @@ module G2(D:DISTINGUISHER,HS:FRO) = { G1.mh.[(sa,h)] <- (sa', G1.chandle); G1.mhi.[(sa',G1.chandle)] <- (sa, h); (sa,h) <- (sa',G1.chandle); - G1.chandle <- G1.chandle + 1; + G1.chandle <- G1.chandle + 1; } i <- i + 1; } @@ -69,7 +71,7 @@ module G2(D:DISTINGUISHER,HS:FRO) = { if (mem (dom G1.mh) (x.`1, hx2) /\ t) { hy2 <- (oget G1.mh.[(x.`1, hx2)]).`2; y2 <@ HS.get(hy2); - G1.bext <- G1.bext \/ bad_ext G1.m y2; + G1.bext <- G1.bext \/ bad_ext G1.m y2 \/ y2 = x.`2; y <- (y.`1, y2); G1.m.[x] <- y; G1.mi.[y] <- x; @@ -100,12 +102,12 @@ module G2(D:DISTINGUISHER,HS:FRO) = { handles_ <@ HS.restrK(); hx2 <- oget (hinvc handles_ x.`2); y <$ dstate; - t <@ HS.in_dom((oget G1.mh.[(x.`1,hx2)]).`2, Unknown); + t <@ HS.in_dom((oget G1.mhi.[(x.`1,hx2)]).`2, Unknown); if (mem (dom G1.mhi) (x.`1, hx2) /\ t) { (y1,hy2) <- oget G1.mhi.[(x.`1, hx2)]; y2 <@ HS.get(hy2); y <- (y.`1, y2); - G1.bext <- G1.bext \/ bad_ext G1.m y2; + G1.bext <- G1.bext \/ bad_ext G1.m y2 \/ y2 = x.`2; G1.mi.[x] <- y; G1.m.[y] <- x; } else { @@ -125,7 +127,7 @@ module G2(D:DISTINGUISHER,HS:FRO) = { } - proc main(): bool = { + proc distinguish(): bool = { var b; F.RO.m <- map0; @@ -136,7 +138,6 @@ module G2(D:DISTINGUISHER,HS:FRO) = { G1.bext <- false; (* the empty path is initially known by the adversary to lead to capacity 0^c *) - HS.init(); HS.set(0,c0); G1.paths <- map0.[c0 <- ([<:block>],b0)]; G1.chandle <- 1; @@ -145,18 +146,308 @@ module G2(D:DISTINGUISHER,HS:FRO) = { } }. -section EXT. +section. - declare module D: DISTINGUISHER{C, PF, G1, G2}. - - equiv G1_G2 : G1(D).main ~ G2(D,FRO).main : - ={glob D} ==> ={res} /\ G1.bext{1} => (G1.bext{2} \/ - exists x h, mem (dom G1.m{2}) x /\ FRO.m{2}.[h] = Some (x.`2, Unknown)). + declare module D: DISTINGUISHER{G1, G2, FRO}. + + op inv_ext1 bext1 bext2 (G1m:smap) (FROm:handles) = + bext1 => (bext2 \/ exists x h, mem (dom G1m `|` rng G1m) x /\ FROm.[h] = Some (x.`2, Unknown)). + + lemma rng_restr (m : ('from, 'to * 'flag) fmap) f x: + mem (rng (restr f m)) x <=> mem (rng m) (x,f). proof. - proc. + rewrite !in_rng;split=>-[z]H;exists z;move:H;rewrite restrP; case m.[z]=>//=. + by move=> [t f'] /=;case (f'=f). + qed. + + equiv G1_G2 : G1(D).main ~ Eager(G2(D)).main1 : + ={glob D} ==> ={res} /\ inv_ext1 G1.bext{1} G1.bext{2} G1.m{2} FRO.m{2}. + proof. + proc;inline{2} FRO.init G2(D, FRO).distinguish;wp. + call (_: ={F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.paths,G1.chandle,FRO.m} /\ + inv_ext1 G1.bext{1} G1.bext{2} G1.m{2} FRO.m{2} /\ + (forall h, mem (dom FRO.m) h => h < G1.chandle){1}). + + proc;if=>//;last by auto. + seq 1 1: (={F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.paths,G1.chandle,FRO.m,x,y} /\ + inv_ext1 G1.bext{1} G1.bext{2} G1.m{2} FRO.m{2} /\ + (forall h, mem (dom FRO.m) h => h < G1.chandle){1} /\ + ! mem (dom G1.m{1}) x{1}). + + by if=>//;auto;call (_: ={F.RO.m});[sim |auto]. + seq 3 5: + (={F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.paths,G1.chandle,FRO.m,hx2,x,y,hx2} /\ + t{2} = (in_dom_with FRO.m (oget G1.mh.[(x.`1, hx2)]).`2 Unknown){1} /\ + (G1.bext{1} => (G1.bext{2} \/ (mem (rng FRO.m) (x.`2, Unknown)){2} \/ + exists x h, mem (dom G1.m{2} `|` rng G1.m{2}) x /\ + FRO.m{2}.[h] = Some (x.`2, Unknown))) /\ + (forall h, mem (dom FRO.m) h => h < G1.chandle){1} /\ + ! mem (dom G1.m{1}) x{1}). + + inline *;auto=> &ml&mr[*]10!-> Hi Hhand -> /=. + rewrite -dom_restr rng_restr /=;progress; 3:by smt ml=0. + + rewrite rng_set !inE rem_id 1:/#;move:H0=>[/Hi[->|[x' h][]H1 H2]|->]//. + right;right;exists x', h;rewrite getP. + by cut ->//:(h<> G1.chandle{mr});move:(Hhand h);rewrite in_dom H2 /#. + by move:H0;rewrite dom_set !inE /#. + if=>//. + + inline *;rcondt{2} 4. + + by move=> &m;auto;rewrite /in_dom_with. + auto;progress. + + by apply DWord.cdistr_ll. + + rewrite /inv_ext1=>/H{H}[->//|[/in_rng[h]Hh|[[x1 x2] h [Hx Hh]]]]. + + case (h = (oget G1.mh{2}.[(x{2}.`1, hx2{2})]).`2)=> [->>|Hneq]. + + by left;rewrite Hh oget_some. + by right;exists x{2}, h;rewrite dom_set getP Hneq !inE. + case (h = (oget G1.mh{2}.[(x{2}.`1, hx2{2})]).`2)=> [->>|Hneq]. + rewrite Hh /bad_ext oget_some /= !mem_map_snd. + by left;right;left <@ Hx;rewrite !inE=>-[|]Hx;[left|right];exists x1; + rewrite -memE. + right;exists (x1,x2), h;rewrite dom_set rng_set getP Hneq rem_id //=. + by move:Hx;rewrite !inE Hh=>-[]->. + by move:H6 H2;rewrite /in_dom_with dom_set !inE /#. + inline *;auto;progress;last by move:H3;rewrite dom_set !inE /#. + rewrite /inv_ext1=> /H [->//|[/in_rng[h]Hh|[x' h [Hx Hh]]]]. + + right;exists x{2}, h;rewrite getP dom_set !inE /=. + by move:(H0 h);rewrite in_dom Hh /#. + right;exists x', h;rewrite getP dom_set !inE. + move:(H0 h) Hx;rewrite in_dom rng_set Hh !inE rem_id //= /#. + + + proc;if=>//;last by auto. + seq 4 6: + (={F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.paths,G1.chandle,FRO.m,hx2,x,y,hx2} /\ + t{2} = (in_dom_with FRO.m (oget G1.mhi.[(x.`1, hx2)]).`2 Unknown){1} /\ + (G1.bext{1} => (G1.bext{2} \/ (mem (rng FRO.m) (x.`2, Unknown)){2} \/ + exists x h, mem (dom G1.m{2} `|` rng G1.m{2}) x /\ + FRO.m{2}.[h] = Some (x.`2, Unknown))) /\ + (forall h, mem (dom FRO.m) h => h < G1.chandle){1} /\ + ! mem (dom G1.mi{1}) x{1}). + + inline *;auto=> &ml&mr[*]9!-> Hi Hhand -> /=. + rewrite -dom_restr rng_restr /=;progress; 3:by smt ml=0. + + rewrite rng_set !inE rem_id 1:/#;move:H2=>[/Hi[->|[x' h][]HH1 HH2]|->]//. + right;right;exists x', h;rewrite getP. + by cut ->//:(h<> G1.chandle{mr});move:(Hhand h);rewrite in_dom HH2 /#. + by move:H2;rewrite dom_set !inE /#. + if=>//. + + inline *;rcondt{2} 4. + + by move=> &m;auto;rewrite /in_dom_with. + auto;progress. + + by apply DWord.cdistr_ll. + + rewrite /inv_ext1=>/H{H}[->//|[/in_rng[h]Hh|[[x1 x2] h [Hx Hh]]]]. + + case (h = (oget G1.mhi{2}.[(x{2}.`1, hx2{2})]).`2)=> [->>|Hneq /=]. + + by left;rewrite Hh oget_some. + by right;exists x{2}, h;rewrite rng_set getP Hneq !inE. + case (h = (oget G1.mhi{2}.[(x{2}.`1, hx2{2})]).`2)=> [->>|Hneq]. + rewrite Hh /bad_ext oget_some /= !mem_map_snd. + by left;right;left <@ Hx;rewrite !inE=>-[|]?;[left|right]; + exists x1;rewrite -memE. + right;exists (x1,x2), h;rewrite dom_set rng_set getP Hneq !inE Hh /= rng_rem. + move:Hx;rewrite !inE in_rng. + + +search mem rng. +print rngP. + + case ((x1,x2) = + (y{2}.`1, (oget FRO.m{2}.[(oget G1.mhi{2}.[(x{2}.`1, hx2{2})]).`2]).`1))=> + [/=->//|Hneq']. + right;left;exists (x1,x2);rewrite Hneq'. + move:Hx;rewrite inE in_rng=>-[->//|[[a1 a2]]] /#. +search mem rng. +search rng rem. + Hh. + Hx. + by move:H6 H2;rewrite /in_dom_with dom_set !inE /#. + inline *;auto;progress;last by move:H3;rewrite dom_set !inE /#. + rewrite /inv_ext1=> /H [->//|[/in_rng[h]Hh|[x' h [Hx Hh]]]]. + + right;exists x{2}, h;rewrite getP dom_set !inE /=. + by move:(H0 h);rewrite in_dom Hh /#. + right;exists x', h;rewrite getP dom_set !inE. + by move:(H0 h);rewrite in_dom Hh Hx /#. + + + + (************) + inline*;auto. + + auto=> //. +sim. admit. qed. + equiv Eager_1_2: Eager(G2(D)).main1 ~ Eager(G2(D)).main2 : + ={glob G2(D)} ==> ={G1.m,FRO.m,G1.bext}. + proof. by conseq (Eager_1_2 (G2(D))). qed. + +end section. + +section EXT. + + declare module D: DISTINGUISHER{C, PF, G1, G2 }. + + local module ReSample = { + var count:int + proc f (x:handle) = { + var c; + c <$ cdistr; + if (card (dom G1.m) < max_size /\ count < max_size) { + G1.bext <- G1.bext \/ bad_ext G1.m c; + FRO.m.[x] <- (c,Unknown); + } + } + }. + + local module Gext = { + + proc resample () = { + Iter(ReSample).iter (elems (dom (restr Unknown FRO.m))); + } + + module C = { + + proc f(p : block list): block = { + var sa, sa'; + var h, i <- 0; + sa <- b0; + if (1 <= size p /\ p <> [b0]) { + while (i < size p ) { + if (mem (dom G1.mh) (sa +^ nth witness p i, h)) { + (sa, h) <- oget G1.mh.[(sa +^ nth witness p i, h)]; + } else { + RRO.sample(G1.chandle); + sa' <@ F.RO.get(take (i+1) p); + sa <- sa +^ nth witness p i; + G1.mh.[(sa,h)] <- (sa', G1.chandle); + G1.mhi.[(sa',G1.chandle)] <- (sa, h); + (sa,h) <- (sa',G1.chandle); + G1.chandle <- G1.chandle + 1; + } + i <- i + 1; + } + sa <- F.RO.get(p); + } + return sa; + } + } + + module S = { + + proc f(x : state): state = { + var p, v, y, y1, y2, hy2, hx2, handles_,t; + + if (!mem (dom G1.m) x) { + if (mem (dom G1.paths) x.`2) { + (p,v) <- oget G1.paths.[x.`2]; + y1 <- F.RO.get (rcons p (v +^ x.`1)); + y2 <$ cdistr; + y <- (y1, y2); + G1.paths.[y2] <- (rcons p (v +^ x.`1), y.`1); + } else { + y <$ dstate; + } + (* exists x h, mem (dom G1.m) x /\ handles.[h] = Some (x.2, I) *) + + handles_ <@ RRO.restrK(); + if (!mem (rng handles_) x.`2) { + RRO.set(G1.chandle, x.`2); + G1.chandle <- G1.chandle + 1; + } + handles_ <- RRO.restrK(); + hx2 <- oget (hinvc handles_ x.`2); + t <@ RRO.in_dom((oget G1.mh.[(x.`1,hx2)]).`2, Unknown); + if (mem (dom G1.mh) (x.`1, hx2) /\ t) { + hy2 <- (oget G1.mh.[(x.`1, hx2)]).`2; + ReSample.f(hy2); + y2 <@ RRO.get(hy2); + y <- (y.`1, y2); + G1.m.[x] <- y; + G1.mi.[y] <- x; + } else { + hy2 <- G1.chandle; + G1.chandle <- G1.chandle + 1; + RRO.set(hy2, y.`2); + G1.m.[x] <- y; + G1.mh.[(x.`1, hx2)] <- (y.`1, hy2); + G1.mi.[y] <- x; + G1.mhi.[(y.`1, hy2)] <- (x.`1, hx2); + } + } else { + y <- oget G1.m.[x]; + } + return y; + } + + proc fi(x : state): state = { + var y, y1, y2, hx2, hy2, handles_, t; + + if (!mem (dom G1.mi) x) { + handles_ <@ RRO.restrK(); + if (!mem (rng handles_) x.`2) { + RRO.set(G1.chandle, x.`2); + G1.chandle <- G1.chandle + 1; + } + handles_ <@ RRO.restrK(); + hx2 <- oget (hinvc handles_ x.`2); + y <$ dstate; + t <@ RRO.in_dom((oget G1.mh.[(x.`1,hx2)]).`2, Unknown); + if (mem (dom G1.mhi) (x.`1, hx2) /\ t) { + (y1,hy2) <- oget G1.mhi.[(x.`1, hx2)]; + ReSample.f(hy2); + y2 <@ RRO.get(hy2); + y <- (y.`1, y2); + + G1.mi.[x] <- y; + G1.m.[y] <- x; + } else { + hy2 <- G1.chandle; + G1.chandle <- G1.chandle + 1; + RRO.set(hy2, y.`2); + G1.mi.[x] <- y; + G1.mhi.[(x.`1, hx2)] <- (y.`1, hy2); + G1.m.[y] <- x; + G1.mh.[(y.`1, hy2)] <- (x.`1, hx2); + } + } else { + y <- oget G1.mi.[x]; + } + return y; + } + + } + + proc distinguish(): bool = { + var b; + + F.RO.m <- map0; + G1.m <- map0; + G1.mi <- map0; + G1.mh <- map0; + G1.mhi <- map0; + G1.bext <- false; + ReSample.count <- 0; + FRO.m <- map0; + + (* the empty path is initially known by the adversary to lead to capacity 0^c *) + RRO.set(0,c0); + G1.paths <- map0.[c0 <- ([<:block>],b0)]; + G1.chandle <- 1; + b <@ D(C,S).distinguish(); + resample(); + return b; + } + }. + + local equiv EG2_Gext : Eager(G2(DRestr(D))).main2 ~ Gext.distinguish: + ={glob D} ==> + (G1.bext{1} \/ + exists x h, mem (dom G1.m{1}) x /\ FRO.m{1}.[h] = Some (x.`2, Unknown)) => + G1.bext{2}. + proof. + admit. + qed. + + local lemma Pr_ext &m: + Pr[Gext.distinguish()@ &m : G1.bext] <= (max_size^2)%r / (2^c)%r. + proof. + admit. + qed. + + end section EXT. diff --git a/proof/old/SLCommon.ec b/proof/old/SLCommon.ec index 468adc5..2073e0f 100644 --- a/proof/old/SLCommon.ec +++ b/proof/old/SLCommon.ec @@ -316,15 +316,13 @@ section COUNT. end section COUNT. - - (* -------------------------------------------------------------------------- *) (** Operators and properties of handles *) op hinv (handles:handles) (c:capacity) = find (fun _ => pred1 c \o fst) handles. op hinvK (handles:handles) (c:capacity) = - find (fun _ => pred1 (c,Known)) handles. + find (fun _ => pred1 c) (restr Known handles). op huniq (handles:handles) = forall h1 h2 cf1 cf2, @@ -355,10 +353,10 @@ lemma hinvKP handles c: if hinvK handles c = None then forall h, handles.[h] <> Some(c,Known) else handles.[oget (hinvK handles c)] = Some(c,Known). proof. - cut @/pred1/=[[h []->[]Hmem ]|[]->H h ]/= := - findP (fun (_ : handle) => pred1 (c,Known)) handles. - + by rewrite oget_some get_oget. - by rewrite -not_def=> Heq; cut := H h;rewrite in_dom Heq. + rewrite /hinvK. + cut @/pred1/= [[h]|][->/=]:= findP (+ pred1 c) (restr Known handles). + + by rewrite oget_some in_dom restrP;case (handles.[h])=>//= /#. + by move=>+h-/(_ h);rewrite in_dom restrP -!not_def=> H1 H2;apply H1;rewrite H2. qed. lemma huniq_hinvK (handles:handles) c: From 3dab20eee3ff675f8a356b3b6bf893c128cbf9e5 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Wed, 20 Jan 2016 19:48:10 +0100 Subject: [PATCH 117/525] Changed Common.ec to use inductive predicates, thoughout. Housekeeping in Block.ec (renamed from Blocks.ec) and TopLevel.ec (which now encorporates BlocksToTopLevel.ec). --- proof/Block.ec | 65 ++++++++++++++++ proof/Blocks.ec | 61 --------------- proof/BlocksToTopLevel.ec | 65 ---------------- proof/Common.ec | 159 +++++++++++++++++++++----------------- proof/TopLevel.ec | 121 +++++++++++++++++++++-------- 5 files changed, 238 insertions(+), 233 deletions(-) create mode 100644 proof/Block.ec delete mode 100644 proof/Blocks.ec delete mode 100644 proof/BlocksToTopLevel.ec diff --git a/proof/Block.ec b/proof/Block.ec new file mode 100644 index 0000000..d3710ef --- /dev/null +++ b/proof/Block.ec @@ -0,0 +1,65 @@ +(*-------------------- Padded Block Sponge Construction ----------------*) + +require import Option Pair Int Real List. +require (*--*) IRO Indifferentiability. +require import Common. + +(*------------------------- Indifferentiability ------------------------*) + +clone include Indifferentiability with + type p <- block * capacity, + type f_in <- block list * int, + type f_out <- block list + + rename + [module] "Indif" as "Experiment" + [module] "GReal" as "RealIndif" + [module] "GIdeal" as "IdealIndif". + +(*------------------------- Ideal Functionality ------------------------*) + +clone import IRO as BIRO with + type from <- block list, + type to <- block, + op valid <- valid_block. + +(*------------------------- Sponge Construction ------------------------*) + +module Sponge (P : DPRIMITIVE) : FUNCTIONALITY, CONSTRUCTION(P) = { + proc init() = {} + + proc f(xs : block list, n : int) : block list = { + var z <- []; + var (sa, sc) <- (b0, Capacity.c0); + var i <- 0; + + if (valid_block xs) { + (* absorption *) + while (xs <> []) { + (sa, sc) <@ P.f(sa +^ head b0 xs, sc); + xs <- behead xs; + } + (* Squeezing *) + while (i < n) { + z <- rcons z sa; + (sa, sc) <@ P.f(sa, sc); + i <- i + 1; + } + } + return z; + } +}. + +(*----------------------------- Conclusion -----------------------------*) + +(* this is just for typechecking, right now: *) + +op eps : real. + +lemma top: + exists (S <: SIMULATOR), + forall (D <: DISTINGUISHER) &m, + `| Pr[RealIndif(Sponge, Perm, D).main() @ &m : res] + - Pr[IdealIndif(IRO, S, D).main() @ &m : res]| + < eps. +proof. admit. qed. diff --git a/proof/Blocks.ec b/proof/Blocks.ec deleted file mode 100644 index fb20873..0000000 --- a/proof/Blocks.ec +++ /dev/null @@ -1,61 +0,0 @@ -(* -------------------------------------------------------------------- *) -require import Option Pair Int Real List. -require (*--*) Common IRO LazyRP Indifferentiability. - -(* -------------------------------------------------------------------- *) -require import Common. - -(* -------------------------------------------------------------------- *) - -clone import IRO as BIRO with - type from <- block list, - type to <- block, - op valid <- valid_block. - -(* -------------------------------------------------------------------- *) -clone include Indifferentiability with - type p <- block * capacity, - type f_in <- block list * int, - type f_out <- block list - - rename - [module] "Indif" as "Experiment" - [module] "GReal" as "RealIndif" - [module] "GIdeal" as "IdealIndif". - -(* -------------------------------------------------------------------- *) -module BlockSponge (P : DPRIMITIVE) : FUNCTIONALITY, CONSTRUCTION(P) = { - proc init() = {} - - proc f(p : block list, n : int) : block list = { - var z <- []; - var (sa,sc) <- (b0, Capacity.c0); - var i <- 0; - - if (valid_block p) { - (* Absorption *) - while (p <> []) { - (sa,sc) <@ P.f(sa +^ head b0 p, sc); - p <- behead p; - } - (* Squeezing *) - while (i < n) { - z <- rcons z sa; - (sa,sc) <@ P.f(sa,sc); - i <- i + 1; - } - } - return z; - } -}. - -(* -------------------------------------------------------------------- *) -op eps : real. - -lemma top: - exists (S <: SIMULATOR), - forall (D <: DISTINGUISHER) &m, - `| Pr[RealIndif(BlockSponge, Perm, D).main() @ &m : res] - - Pr[IdealIndif(IRO, S, D).main() @ &m : res]| - < eps. -proof. admit. qed. diff --git a/proof/BlocksToTopLevel.ec b/proof/BlocksToTopLevel.ec deleted file mode 100644 index e9b159a..0000000 --- a/proof/BlocksToTopLevel.ec +++ /dev/null @@ -1,65 +0,0 @@ -(* -------------------------------------------------------------------- *) -require import Fun Pred Option Pair Int IntDiv Real List FSet NewFMap. -require (*--*) Blocks TopLevel. - -(* -------------------------------------------------------------------- *) -require import Common. - -(* -------------------------------------------------------------------- *) -module UpperFun (F : Blocks.DFUNCTIONALITY) = { - proc init() = {} - - proc f(p : bool list, n : int) = { - var xs; - - xs <@ F.f(pad2blocks p, (n + r - 1) %/ r); - return take n (blocks2bits xs); - } -}. - -module LowerFun (F : TopLevel.DFUNCTIONALITY) = { - proc init() = {} - - proc f(xs : block list, n : int) = { - var cs, ds : bool list; - var obs : bool list option; - var ys : block list <- []; - - obs <- unpad_blocks xs; - if (obs <> None) { - cs <@ F.f(oget obs, n * r); (* size cs = n * r *) - ys <- bits2blocks cs; - } - return ys; - } -}. - -(* -------------------------------------------------------------------- *) -equiv ModularConstruction: - UpperFun(Blocks.BlockSponge(Perm)).f ~ TopLevel.Sponge(Perm).f: - ={glob Perm, arg} ==> ={glob Perm, res}. -proof. - proc. inline Blocks.BlockSponge(Perm).f. - admit. (* done *) -qed. - -module ModularSimulator (S : Blocks.SIMULATOR, F : TopLevel.DFUNCTIONALITY) = - S(LowerFun(F)). - -module BlocksDist (D : TopLevel.DISTINGUISHER, F : Blocks.DFUNCTIONALITY) = - D(UpperFun(F)). - -section. - declare module BlocksSim : Blocks.SIMULATOR. - declare module TopLevelDist : TopLevel.DISTINGUISHER. - - lemma Conclusion &m: - `|Pr[TopLevel.RealIndif(TopLevel.Sponge, Perm, TopLevelDist).main() @ &m: res] - - Pr[TopLevel.IdealIndif(TopLevel.BIRO.IRO, ModularSimulator(BlocksSim), - TopLevelDist).main() @ &m: res]| = - `|Pr[Blocks.RealIndif(Blocks.BlockSponge, Perm, - BlocksDist(TopLevelDist)).main() @ &m: res] - - Pr[Blocks.IdealIndif(Blocks.BIRO.IRO, BlocksSim, - BlocksDist(TopLevelDist)).main() @ &m: res]|. - proof. admit. qed. -end section. diff --git a/proof/Common.ec b/proof/Common.ec index e018936..180ac9d 100644 --- a/proof/Common.ec +++ b/proof/Common.ec @@ -1,4 +1,5 @@ -(* -------------------------------------------------------------------- *) +(*------------------- Common Definitions and Lemmas --------------------*) + require import Option Fun Pair Int IntExtra IntDiv Real List NewDistr. require import Ring StdRing StdOrder StdBigop BitEncoding. require (*--*) FinType BitWord LazyRP Monoid. @@ -82,7 +83,8 @@ case (zs = [])=> // zs_non_nil. elim ih=> // ->. by rewrite (@last_nonempty y z). qed. -(* -------------------------------------------------------------------- *) +(*------------------------------ Primitive -----------------------------*) + clone export LazyRP as Perm with type D <- block * capacity, op d <- bdistr * Capacity.cdistr @@ -91,7 +93,6 @@ clone export LazyRP as Perm with [module] "P" as "Perm". (* ------------------------- Padding/Unpadding ------------------------ *) -op chunk (bs : bool list) = BitChunking.chunk r bs. op num0 (n : int) = (-(n + 2)) %% r. @@ -215,7 +216,7 @@ by rewrite -nth_rev 1:/# &(@negbRL _ true) &(before_index) /#. qed. inductive unpad_spec (t : bool list) = -| Unpad (s : bool list, n : int) of + Unpad (s : bool list, n : int) of (0 <= n < r) & (r %| (size s + n + 2)) & (t = s ++ [true] ++ nseq n false ++ [true]). @@ -231,6 +232,10 @@ apply/(Unpad s (num0 (size s))). by rewrite -padE ?dvd_r_num0 // num0_ge0 num0_ltr. qed. +(*------------------------------ Chunking ------------------------------*) + +op chunk (bs : bool list) = BitChunking.chunk r bs. + lemma size_chunk bs : size (chunk bs) = size bs %/ r. proof. by apply/BitChunking.size_chunk/gt0_r. qed. @@ -257,6 +262,8 @@ lemma flattenK bs : (forall b, mem bs b => size b = r) => chunk (flatten bs) = bs. proof. by apply/BitChunking.flattenK/gt0_r. qed. +(*--------------- Converting Between Block Lists and Bits --------------*) + op blocks2bits (xs:block list) : bool list = flatten (map w2bits xs). lemma blocks2bits_nil : blocks2bits [] = []. @@ -280,7 +287,6 @@ qed. lemma size_blocks2bits_dvd_r (xs : block list) : r %| size(blocks2bits xs). proof. by rewrite size_blocks2bits dvdz_mulr dvdzz. qed. -(* -------------------------------------------------------------------- *) op bits2blocks (xs : bool list) : block list = map bits2w (chunk xs). lemma bits2blocks_nil : bits2blocks [] = []. @@ -319,7 +325,8 @@ have map_tolistK : by rewrite map_tolistK; [apply in_chunk_size | exact chunkK]. qed. -(* -------------------------------------------------------------------- *) +(*-------------- Padding to Blocks / Unpadding from Blocks -------------*) + op pad2blocks : bool list -> block list = bits2blocks \o pad. op unpad_blocks : block list -> bool list option = unpad \o blocks2bits. @@ -342,7 +349,8 @@ have -> : pad(oget(unpad bs)) = bs by rewrite /bs blocks2bitsK. qed. -(* ------------------------ Extending/Stripping ----------------------- *) +(*-------------------------- Extending/Stripping -----------------------*) + op extend (xs : block list) (n : int) = xs ++ nseq n b0. @@ -392,35 +400,40 @@ pose s := (_ - _)%Int; rewrite -/i (_ : s = i - (j+1)) /s 1:#ring. by rewrite subr_ge0 -ltzE lt_ji /= ltr_snaddr // oppr_lt0 ltzS. qed. -(*------------------------------ Validity ----------------------------- *) +(*------------------------------ Validity ------------------------------*) (* in TopLevel *) + op valid_toplevel (_ : bool list) = true. (* in Block *) + op valid_block (xs : block list) = unpad_blocks xs <> None. -lemma nosmt valid_block_prop (xs : block list) : - valid_block xs <=> - exists (s : bool list, n : int), - 0 <= n < r /\ blocks2bits xs = s ++ [true] ++ nseq n false ++ [true]. +inductive valid_block_spec (xs : block list) = + ValidBlock (s : bool list, n : int) of + (0 <= n < r) + & (blocks2bits xs = s ++ [true] ++ nseq n false ++ [true]). + +lemma nosmt valid_blockP (xs : block list) : + valid_block xs <=> valid_block_spec xs. proof. -rewrite /valid_block /unpad_blocks /(\o). -split=> [vb | [s n] [rng_n b2b]]. +split=> [vb | [s n] [rng_n b2b] b2b_xs_eq]. have [up _] := (unpadP (blocks2bits xs)). rewrite vb /= in up; case: up=> [s n rng_n _ b2b]. -by exists s, n. -apply unpadP; apply (Unpad s n)=> //. +by apply (@ValidBlock xs s n). +rewrite unpadP (@Unpad (blocks2bits xs) s n) //. have <- : size (blocks2bits xs) = size s + n + 2 - by rewrite b2b 3!size_cat /= size_nseq max_ler /#ring. -rewrite size_blocks2bits_dvd_r. + by rewrite b2b_xs_eq 3!size_cat /= size_nseq max_ler /#ring. +by apply size_blocks2bits_dvd_r. qed. lemma valid_block_ends_not_b0 (xs : block list) : valid_block xs => last b0 xs <> b0. proof. -move=> vb_xs; have bp := valid_block_prop xs. -rewrite vb_xs /= in bp; elim bp=> [s n] [_ b2b_xs_eq]. +move=> vb_xs; have bp := valid_blockP xs. +rewrite vb_xs /= in bp. +move: bp=> [s n] _ b2b_xs_eq. case: (last b0 xs <> b0)=> [// | last_xs_eq_b0]. rewrite nnot in last_xs_eq_b0. have xs_non_nil : xs <> [] by smt ml=0. @@ -437,19 +450,23 @@ have last_b2b_xs_false : last true (blocks2bits xs) = false by rewrite last_b2b_xs_true in last_b2b_xs_false. qed. -lemma nosmt valid_block_prop_alt (xs : block list) : - valid_block xs <=> - (exists (ys : block list, x : block, s : bool list, n : int), - xs = ys ++ [x] /\ 0 <= n /\ - w2bits x = s ++ [true] ++ nseq n false ++ [true]) \/ - (exists (ys : block list, y z : block), - xs = ys ++ [y; z] /\ last false (w2bits y) /\ - w2bits z = nseq (r - 1) false ++ [true]). +inductive valid_block_struct_spec (xs : block list) = + ValidBlockStruct1 (ys : block list, x : block, s : bool list, n : int) of + (xs = ys ++ [x]) + & (0 <= n) + & (w2bits x = s ++ [true] ++ nseq n false ++ [true]) +| ValidBlockStruct2 (ys : block list, y z : block) of + (xs = ys ++ [y; z]) + & (last false (w2bits y)) + & (w2bits z = nseq (r - 1) false ++ [true]). + +lemma nosmt valid_block_structP (xs : block list) : + valid_block xs <=> valid_block_struct_spec xs. proof. -rewrite valid_block_prop. -split=>[[s n] [[ge0_n lt_nr] b2b_xs_eq] | - [[ys x s n] [xs_eq [ge0_n w2b_ys_eq]] | - [ys y z] [xs_eq [lst_w2b_y w2b_z_eq]]]]. +rewrite valid_blockP. +split=> [[s n] [ge0_n lt_nr] b2b_xs_eq | + [ys x s n xs_eq ge0_n w2b_x_eq | + ys y z xs_eq lst w2b_z_eq]]. have sz_s_divz_eq : size s = size s %/ r * r + size s %% r by apply divz_eq. pose tke := take (size s %/ r * r) s; pose drp := drop (size s %/ r * r) s. @@ -487,7 +504,6 @@ rewrite -(@cat_take_drop (size s %/ r * r) s) -!catA -/tke -/drp + have -> : size drp + (1 + (n + 1)) = size drp + n + 2 by ring. + rewrite sz_drp_plus_n_plus_2_dvd_r. case: (n = r - 1)=> [n_eq_r_min1 | n_neq_r_min1]. -right. have sz_drp_plus1_dvd_r : r %| (size drp + 1). rewrite dvdzE -(@addz0 (size drp + 1)) -{1}(@modzz r). have {1}-> : r = n + 1 by smt ml=0. @@ -499,23 +515,16 @@ have sz_drp_plus1_eq_r : size drp + 1 = r. split=> [| _]; first rewrite ltr_paddl 1:size_ge0 ltr01. have -> : 2 * r = r + r by ring. rewrite ltr_add // 1:sz_drp 1:ltz_pmod 1:gt0_r ltzE ge2_r. -exists (bits2blocks tke), - (bits2w (drp ++ [true])), - (bits2w (nseq n false ++ [true])). -split. -rewrite xs_eq. -rewrite (@catA drp [true]) bits2blocks_cat 1:size_cat // - 1:size_cat 1:size_nseq 1:max_ler 1:ge0_n /= 1:/#. -rewrite (@bits2blocks_sing (drp ++ [true])) 1:size_cat //. -rewrite (@bits2blocks_sing (nseq n false ++ [true])). -rewrite size_cat size_nseq max_ler /= 1:ge0_n /#. -by rewrite catA. -do 2! rewrite tolistK 1:size_cat //=. -+ rewrite size_nseq max_ler 1:ge0_n /#. -split; first rewrite cats1 last_rcons. -have -> // : n = r - 1 by smt ml=0. +apply (@ValidBlockStruct2 xs (bits2blocks tke) + (bits2w (drp ++ [true])) (bits2w (nseq n false ++ [true]))). +rewrite xs_eq (@catA drp [true]) bits2blocks_cat 1:size_cat // + 1:size_cat 1:size_nseq 1:max_ler 1:ge0_n /= 1:/# + (@bits2blocks_sing (drp ++ [true])) 1:size_cat // + (@bits2blocks_sing (nseq n false ++ [true])) + 1:size_cat 1:size_nseq /= 1:max_ler 1:ge0_n /#. +rewrite tolistK 1:size_cat //= cats1 last_rcons. +rewrite n_eq_r_min1 tolistK 1:size_cat //= size_nseq max_ler /#. have lt_n_r_min1 : n < r - 1 by smt ml=0. -left. move: xs_eq. have sz_drp_plus_n_plus_2_eq_r : size drp + n + 2 = r. rewrite (@dvdz_close (size drp + n + 2)) // sz_drp. @@ -533,43 +542,47 @@ rewrite (@bits2blocks_sing + rewrite !size_cat /= size_nseq max_ler 1:ge0_n 1:sz_drp. + have -> : size s %% r + (1 + (n + 1)) = size s %%r + n + 2 by ring. + by rewrite -sz_drp. -exists (bits2blocks tke), - (bits2w(drp ++ ([true] ++ (nseq n false ++ [true])))), - drp, n. -split=> //; split=> //. +apply (@ValidBlockStruct1 xs (bits2blocks tke) + (bits2w(drp ++ ([true] ++ (nseq n false ++ [true])))) + drp n)=> //. by rewrite tolistK 1:!size_cat /= 1:size_nseq 1:max_ler 1:ge0_n 1:-sz_drp_plus_n_plus_2_eq_r 1:#ring -!catA cat1s. -exists (blocks2bits ys ++ s), n; split. have sz_w2b_x_eq_r : size(w2bits x) = r by apply size_tolist. -rewrite w2b_ys_eq !size_cat /= size_nseq max_ler // in sz_w2b_x_eq_r. -split=> // _; smt ml=0 w=(size_ge0). -by rewrite xs_eq blocks2bits_cat blocks2bits_sing w2b_ys_eq !catA. -exists (blocks2bits ys ++ (take (r - 1) (w2bits y))), (r - 1). -split; first smt ml=0 w=(gt0_r). -rewrite xs_eq blocks2bits_cat; have -> : [y; z] = [y] ++ [z] by trivial. -rewrite blocks2bits_cat 2!blocks2bits_sing -!catA; congr. -have {1}-> : w2bits y = take (r - 1) (w2bits y) ++ [true]. +rewrite w2b_x_eq !size_cat /= size_nseq max_ler // in sz_w2b_x_eq_r. +have lt_nr : n < r by smt ml=0 w=(size_ge0). +apply (@ValidBlock xs (blocks2bits ys ++ s) n)=> //. +by rewrite xs_eq blocks2bits_cat blocks2bits_sing w2b_x_eq -!catA. +move: xs_eq. have -> : [y; z] = [y] ++ [z] by trivial. move=> xs_eq. +have w2bits_y_eq : w2bits y = take (r - 1) (w2bits y) ++ [true]. rewrite -{1}(@cat_take_drop (r - 1) (w2bits y)); congr. elim (last_drop_all_but_last false (w2bits y))=> [w2b_y_nil | drop_w2b_y_last]. have not_lst_w2b_y : ! last false (w2bits y) by rewrite w2b_y_nil. - done. - rewrite lst_w2b_y in drop_w2b_y_last. + by rewrite w2b_y_nil. + rewrite lst in drop_w2b_y_last. by rewrite -drop_w2b_y_last size_tolist. -by rewrite w2b_z_eq !catA. +apply (@ValidBlock xs (blocks2bits ys ++ (take (r - 1) (w2bits y))) + (r - 1)). +smt ml=0 w=(ge2_r). +rewrite xs_eq 2!blocks2bits_cat 2!blocks2bits_sing -!catA; congr. +by rewrite {1}w2bits_y_eq -catA w2b_z_eq. qed. (* in Absorb *) + op valid_absorb (xs : block list) = valid_block((strip xs).`1). -lemma nosmt valid_absorb_prop (xs : block list) : - valid_absorb xs <=> - exists (ys : block list, n : int), - 0 <= n /\ xs = ys ++ nseq n b0 /\ valid_block ys. +inductive valid_absorb_spec (xs : block list) = + ValidAbsorb (ys : block list, n : int) of + (valid_block ys) + & (0 <= n) + & (xs = ys ++ nseq n b0). + +lemma nosmt valid_absorbP (xs : block list) : + valid_absorb xs <=> valid_absorb_spec xs. proof. -rewrite /valid_absorb; split=> [strp_xs_valid | [ys n] [ge0_n [-> vb_ys]]]. -exists (strip xs).`1, (strip xs).`2. -split; [apply (@strip_ge0 xs) | split=> //]. -by rewrite -/(extend (strip xs).`1 (strip xs).`2) eq_sym (@stripK xs). +rewrite /valid_absorb; split=> [strp_xs_valid | [ys n] ge0_n vb_ys ->]. +by rewrite (@ValidAbsorb xs (strip xs).`1 (strip xs).`2) + 2:(@strip_ge0 xs) 2:(@stripK xs). by rewrite -/(extend ys n) extendK 1:valid_block_ends_not_b0. qed. diff --git a/proof/TopLevel.ec b/proof/TopLevel.ec index 39ee761..406bf77 100644 --- a/proof/TopLevel.ec +++ b/proof/TopLevel.ec @@ -1,17 +1,11 @@ -(* -------------------------------------------------------------------- *) -require import Pair Int IntDiv Real List. -require (*--*) IRO LazyRP Indifferentiability. +(*------------------------- Sponge Construction ------------------------*) -(* -------------------------------------------------------------------- *) +require import Pair Int IntDiv Real List Option. require import Common. +require (*--*) IRO Block. + +(*------------------------- Indifferentiability ------------------------*) -(* -------------------------------------------------------------------- *) -clone import IRO as BIRO with - type from <- bool list, - type to <- bool, - op valid <- valid_toplevel. - -(* -------------------------------------------------------------------- *) clone include Indifferentiability with type p <- block * capacity, type f_in <- bool list * int, @@ -22,42 +16,101 @@ clone include Indifferentiability with [module] "GReal" as "RealIndif" [module] "GIdeal" as "IdealIndif". -(* -------------------------------------------------------------------- *) +(*------------------------- Ideal Functionality ------------------------*) + +clone import IRO as BIRO with + type from <- bool list, + type to <- bool, + op valid <- valid_toplevel. + +(*------------------------- Sponge Construction ------------------------*) module Sponge (P : DPRIMITIVE) : FUNCTIONALITY, CONSTRUCTION(P) = { proc init() : unit = {} - proc f(bp : bool list, n : int) : bool list = { - var z <- []; - var (sa,sc) <- (b0, Capacity.c0); - var i <- 0; - var p <- map bits2w (chunk (pad bp)); + proc f(bs : bool list, n : int) : bool list = { + var z <- []; + var (sa, sc) <- (b0, Capacity.c0); + var i <- 0; + var xs <- pad2blocks bs; - (* Absorption *) - while (p <> []) { - (sa,sc) <@ P.f(sa +^ head b0 p, sc); - p <- behead p; + (* absorption *) + while (xs <> []) { + (sa, sc) <@ P.f(sa +^ head b0 xs, sc); + xs <- behead xs; } - (* Squeezing *) + (* squeezing *) while (i < (n + r - 1) %/ r) { - z <- z ++ (Block.w2bits sa); - (sa,sc) <@ P.f(sa,sc); - i <- i + 1; + z <- z ++ w2bits sa; + (sa, sc) <@ P.f(sa, sc); + i <- i + 1; } return take n z; } }. -(* -------------------------------------------------------------------- *) -op eps : real. +(*------------- Simulator and Distinguisher Constructions --------------*) + +module LowerFun (F : DFUNCTIONALITY) : Block.DFUNCTIONALITY = { + proc init() = {} -print RealIndif. + proc f(xs : block list, n : int) = { + var cs, ds : bool list; + var obs : bool list option; + var ys : block list <- []; -lemma top: - exists (S <: SIMULATOR), - forall (D <: DISTINGUISHER) &m, - `| Pr[RealIndif(Sponge, Perm, D).main() @ &m : res] - - Pr[IdealIndif(IRO, S, D).main() @ &m : res]| - < eps. + obs <- unpad_blocks xs; + if (obs <> None) { + cs <@ F.f(oget obs, n * r); (* size cs = n * r *) + ys <- bits2blocks cs; + } + return ys; + } +}. + +module RaiseFun (F : Block.DFUNCTIONALITY) : DFUNCTIONALITY = { + proc init() = {} + + proc f(bs : bool list, n : int) = { + var xs; + + xs <@ F.f(pad2blocks bs, (n + r - 1) %/ r); + return take n (blocks2bits xs); + } +}. + +module LowerDist (D : DISTINGUISHER, F : Block.DFUNCTIONALITY) = D(RaiseFun(F)). + +module RaiseSim (S : Block.SIMULATOR, F : DFUNCTIONALITY) = S(LowerFun(F)). + +(*------------------------------- Proof --------------------------------*) + +section. + +declare module BlockSim : Block.SIMULATOR. +declare module Dist : DISTINGUISHER. + +lemma Conclusion' &m : + `|Pr[RealIndif(Sponge, Perm, Dist).main() @ &m: res] - + Pr[IdealIndif(IRO, RaiseSim(BlockSim), Dist).main() @ &m : res]| = + `|Pr[Block.RealIndif + (Block.Sponge, Perm, LowerDist(Dist)).main() @ &m : res] - + Pr[Block.IdealIndif + (Block.BIRO.IRO, BlockSim, LowerDist(Dist)).main() @ &m : res]|. proof. admit. qed. + +end section. + +(*----------------------------- Conclusion -----------------------------*) + +lemma Conclusion (BlockSim <: Block.SIMULATOR) + (Dist <: DISTINGUISHER) + &m : + `|Pr[RealIndif(Sponge, Perm, Dist).main() @ &m: res] - + Pr[IdealIndif(IRO, RaiseSim(BlockSim), Dist).main() @ &m : res]| = + `|Pr[Block.RealIndif + (Block.Sponge, Perm, LowerDist(Dist)).main() @ &m : res] - + Pr[Block.IdealIndif + (Block.BIRO.IRO, BlockSim, LowerDist(Dist)).main() @ &m : res]|. +proof. by apply (Conclusion' BlockSim Dist &m). qed. From 3fee7f3b5f7b14e7bc57b5a95be3774800373f6d Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Thu, 21 Jan 2016 10:34:03 +0100 Subject: [PATCH 118/525] Updated documentation. --- proof/IRO.eca | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/proof/IRO.eca b/proof/IRO.eca index d2a1cf0..697902f 100644 --- a/proof/IRO.eca +++ b/proof/IRO.eca @@ -1,6 +1,7 @@ -(* infinite random oracle: it ranges over infinite length bitstrings, - all of whose bits are sampled uniformly and independently. We - obviously make it lazy. *) +(* Infinite random oracle, mapping values of type [from] to infinite + sequences of values of type [to], each sampled uniformly and + independently. We obviously make it lazy. Inputs not satisfying + a validity predicate are mapped to the empty list *) require import Option Int Bool List FSet NewFMap. @@ -12,7 +13,7 @@ op dto : to distr. module type IRO = { proc init() : unit - (* f x, returning the first n bits of the result *) + (* f x, returning the first n elements of the result *) proc f(x : from, n : int) : to list }. @@ -28,7 +29,7 @@ pred prefix_closed' (m : (from * int,to) fmap) = 0 <= i < n => mem (dom m) (x,i). -lemma cool m: prefix_closed m <=> prefix_closed' m +lemma prefix_closed_equiv m: prefix_closed m <=> prefix_closed' m by []. (* official version: *) From 06445887d9c01ac13679d81b12a9444e91bb865a Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Thu, 21 Jan 2016 12:00:07 +0100 Subject: [PATCH 119/525] Added lemma connecting valid_block and pad2blocks. --- proof/Common.ec | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/proof/Common.ec b/proof/Common.ec index 180ac9d..115c5ce 100644 --- a/proof/Common.ec +++ b/proof/Common.ec @@ -410,6 +410,12 @@ op valid_toplevel (_ : bool list) = true. op valid_block (xs : block list) = unpad_blocks xs <> None. +lemma valid_pad2blocks (bs : bool list) : + valid_block(pad2blocks bs). +proof. +by rewrite /valid_block pad2blocksK. +qed. + inductive valid_block_spec (xs : block list) = ValidBlock (s : bool list, n : int) of (0 <= n < r) From 517080588f04ae21214a5ac16e4a3e8c049c2328 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Thu, 21 Jan 2016 15:43:31 +0100 Subject: [PATCH 120/525] Reduced TopLevel proof to lemma to be proved using eager. --- proof/TopLevel.ec | 85 +++++++++++++++++++++++++++++++++++++++++++---- 1 file changed, 78 insertions(+), 7 deletions(-) diff --git a/proof/TopLevel.ec b/proof/TopLevel.ec index 406bf77..8c0be41 100644 --- a/proof/TopLevel.ec +++ b/proof/TopLevel.ec @@ -1,6 +1,6 @@ (*------------------------- Sponge Construction ------------------------*) -require import Pair Int IntDiv Real List Option. +require import Pair Int IntDiv Real List Option NewFMap. require import Common. require (*--*) IRO Block. @@ -88,8 +88,77 @@ module RaiseSim (S : Block.SIMULATOR, F : DFUNCTIONALITY) = S(LowerFun(F)). section. -declare module BlockSim : Block.SIMULATOR. -declare module Dist : DISTINGUISHER. +declare module BlockSim : Block.SIMULATOR{IRO, Block.BIRO.IRO}. +declare module Dist : DISTINGUISHER{Perm, BlockSim, IRO, Block.BIRO.IRO}. + +lemma Sponge_Raise_Block_Sponge_f : + equiv[Sponge(Perm).f ~ RaiseFun(Block.Sponge(Perm)).f : + ={bs, n, glob Perm} ==> ={res, glob Perm}]. +proof. +proc; inline Block.Sponge(Perm).f. +conseq (_ : ={bs, n, glob Perm} ==> _)=> //. +swap{2} [3..5] -2. +seq 4 4 : + (={n, glob Perm, sa, sc, i} /\ xs{1} = xs0{2} /\ z{1} = [] /\ z{2} = [] /\ + valid_block xs0{2}). +auto; progress; apply valid_pad2blocks. +rcondt{2} 2; auto. +swap{2} 1 1. +seq 1 1 : + (={n, glob Perm, sa, sc, i} /\ xs{1} = xs0{2} /\ z{1} = [] /\ z{2} = []). +while (={glob Perm, sa, sc, i} /\ xs{1} = xs0{2} /\ z{1} = [] /\ z{2} = []). +wp. call (_ : ={glob Perm}). sim. auto. auto. +seq 0 1 : + (={n, glob Perm, sa, sc, i} /\ blocks2bits z{2} = z{1} /\ + n0{2} = (n{1} + r - 1) %/ r); first auto. +while (={n, glob Perm, i, sa, sc} /\ blocks2bits z{2} = z{1} /\ + n0{2} = (n{1} + r - 1) %/ r). +wp. call (_ : ={glob Perm}); first sim. auto. +auto; progress; by rewrite -cats1 blocks2bits_cat blocks2bits_sing. +auto. +qed. + +lemma RealIndif &m : + Pr[RealIndif(Sponge, Perm, Dist).main() @ &m: res] = + Pr[Block.RealIndif + (Block.Sponge, Perm, LowerDist(Dist)).main() @ &m : res]. +proof. +byequiv=> //; proc. +seq 2 2 : (={glob Dist, glob Perm}); first sim. +call (_ : ={glob Perm}); first 2 sim. +conseq Sponge_Raise_Block_Sponge_f=> //. +auto. +qed. + +lemma IdealDist &1 &2 (a : bool) : + (glob Dist){1} = (glob Dist){2} => (glob BlockSim){1} = (glob BlockSim){2} => + IRO.mp{1} = NewFMap.map0 => Block.BIRO.IRO.mp{2} = NewFMap.map0 => + Pr[Dist(IRO, BlockSim(LowerFun(IRO))).distinguish() @ &1 : a = res] = + Pr[Dist(RaiseFun(Block.BIRO.IRO), + BlockSim(Block.BIRO.IRO)).distinguish() @ &2 : a = res]. +proof. +admit. +qed. + +lemma IdealIndif &m : + Pr[IdealIndif(IRO, RaiseSim(BlockSim), Dist).main() @ &m : res] = + Pr[Block.IdealIndif + (Block.BIRO.IRO, BlockSim, LowerDist(Dist)).main () @ &m : res]. +proof. +byequiv=> //; proc. +seq 2 2 : + (={glob Dist, glob BlockSim} /\ IRO.mp{1} = NewFMap.map0 /\ + Block.BIRO.IRO.mp{2} = NewFMap.map0). +inline *; wp; call (_ : true); auto. +call + (_ : + ={glob Dist, glob BlockSim} /\ + IRO.mp{1} = map0 /\ Block.BIRO.IRO.mp{2} = map0 ==> + ={res}). +bypr res{1} res{2}=> //; progress. +apply (IdealDist &1 &2 a)=> //. +auto. +qed. lemma Conclusion' &m : `|Pr[RealIndif(Sponge, Perm, Dist).main() @ &m: res] - @@ -98,14 +167,16 @@ lemma Conclusion' &m : (Block.Sponge, Perm, LowerDist(Dist)).main() @ &m : res] - Pr[Block.IdealIndif (Block.BIRO.IRO, BlockSim, LowerDist(Dist)).main() @ &m : res]|. -proof. admit. qed. +proof. +by rewrite (RealIndif &m) (IdealIndif &m). +qed. end section. (*----------------------------- Conclusion -----------------------------*) -lemma Conclusion (BlockSim <: Block.SIMULATOR) - (Dist <: DISTINGUISHER) +lemma Conclusion (BlockSim <: Block.SIMULATOR{IRO, Block.BIRO.IRO}) + (Dist <: DISTINGUISHER{Perm, BlockSim, IRO, Block.BIRO.IRO}) &m : `|Pr[RealIndif(Sponge, Perm, Dist).main() @ &m: res] - Pr[IdealIndif(IRO, RaiseSim(BlockSim), Dist).main() @ &m : res]| = @@ -113,4 +184,4 @@ lemma Conclusion (BlockSim <: Block.SIMULATOR) (Block.Sponge, Perm, LowerDist(Dist)).main() @ &m : res] - Pr[Block.IdealIndif (Block.BIRO.IRO, BlockSim, LowerDist(Dist)).main() @ &m : res]|. -proof. by apply (Conclusion' BlockSim Dist &m). qed. +proof. by apply/(Conclusion' BlockSim Dist &m). qed. From 96775f6d48db5ad29d5887a94e6f9f26fb139cdd Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Fri, 22 Jan 2016 15:03:45 +0100 Subject: [PATCH 121/525] Progress in top level proof. --- proof/Block.ec | 3 +- proof/TopLevel.ec | 254 ++++++++++++++++++++++++++++++++++++++++++---- 2 files changed, 234 insertions(+), 23 deletions(-) diff --git a/proof/Block.ec b/proof/Block.ec index d3710ef..8887e5e 100644 --- a/proof/Block.ec +++ b/proof/Block.ec @@ -21,7 +21,8 @@ clone include Indifferentiability with clone import IRO as BIRO with type from <- block list, type to <- block, - op valid <- valid_block. + op valid <- valid_block, + op dto <- bdistr. (*------------------------- Sponge Construction ------------------------*) diff --git a/proof/TopLevel.ec b/proof/TopLevel.ec index 8c0be41..9276ec5 100644 --- a/proof/TopLevel.ec +++ b/proof/TopLevel.ec @@ -1,7 +1,7 @@ (*------------------------- Sponge Construction ------------------------*) -require import Pair Int IntDiv Real List Option NewFMap. -require import Common. +require import Pair Int IntDiv Real List Option FSet NewFMap DBool. +require import Fun Common. require (*--*) IRO Block. (*------------------------- Indifferentiability ------------------------*) @@ -21,7 +21,8 @@ clone include Indifferentiability with clone import IRO as BIRO with type from <- bool list, type to <- bool, - op valid <- valid_toplevel. + op valid <- valid_toplevel, + op dto <- dbool. (*------------------------- Sponge Construction ------------------------*) @@ -53,8 +54,6 @@ module Sponge (P : DPRIMITIVE) : FUNCTIONALITY, CONSTRUCTION(P) = { (*------------- Simulator and Distinguisher Constructions --------------*) module LowerFun (F : DFUNCTIONALITY) : Block.DFUNCTIONALITY = { - proc init() = {} - proc f(xs : block list, n : int) = { var cs, ds : bool list; var obs : bool list option; @@ -63,15 +62,13 @@ module LowerFun (F : DFUNCTIONALITY) : Block.DFUNCTIONALITY = { obs <- unpad_blocks xs; if (obs <> None) { cs <@ F.f(oget obs, n * r); (* size cs = n * r *) - ys <- bits2blocks cs; + ys <- bits2blocks cs; (* size ys = n *) } return ys; } }. module RaiseFun (F : Block.DFUNCTIONALITY) : DFUNCTIONALITY = { - proc init() = {} - proc f(bs : bool list, n : int) = { var xs; @@ -91,7 +88,175 @@ section. declare module BlockSim : Block.SIMULATOR{IRO, Block.BIRO.IRO}. declare module Dist : DISTINGUISHER{Perm, BlockSim, IRO, Block.BIRO.IRO}. -lemma Sponge_Raise_Block_Sponge_f : +module type BLOCK_IRO_BITS = { + proc init() : unit + proc g(x : block list, n : int) : bool list + proc f(x : block list, n : int) : block list +}. + +module type BLOCK_IRO_BITS_DIST(BIROB : BLOCK_IRO_BITS) = { + proc distinguish(): bool +}. + +local module BlockIROBitsEager : BLOCK_IRO_BITS, Block.BIRO.IRO = { + var mp : (block list * int, bool) fmap + + proc init() : unit = { + mp <- map0; + } + + proc fill_in(xs, i) = { + if (! mem (dom mp) (xs, i)) { + mp.[(xs, i)] <$ dbool; + } + return oget mp.[(xs, i)]; + } + + proc g(xs, n) = { + var b, bs; + var m <- ((n + r - 1) %/ r) * r; + var i <- 0; + + bs <- []; + if (valid_block xs) { + while (i < n) { + b <@ fill_in(xs, i); + bs <- rcons bs b; + i <- i + 1; + } + while (i < m) { (* eager part *) + fill_in(xs, i); + i <- i + 1; + } + } + return bs; + } + + proc f(xs, n) = { + var bs, ys; + bs <@ g(xs, n * r); + ys <- bits2blocks bs; + return ys; + } +}. + +local module BlockIROBitsLazy : BLOCK_IRO_BITS, Block.BIRO.IRO = { + var mp : (block list * int, bool) fmap + + proc init() : unit = { + mp <- map0; + } + + proc fill_in(xs, i) = { + if (! mem (dom mp) (xs, i)) { + mp.[(xs, i)] <$ dbool; + } + return oget mp.[(xs, i)]; + } + + proc g(xs, n) = { + var b, bs; + var i <- 0; + + bs <- []; + if (valid_block xs) { + while (i < n) { + b <@ fill_in(xs, i); + bs <- rcons bs b; + i <- i + 1; + } + } + return bs; + } + + proc f(xs, n) = { + var bs, ys; + bs <@ g(xs, n * r); + ys <- bits2blocks bs; + return ys; + } +}. + +local module RaiseBIROBLazy (F : BLOCK_IRO_BITS) : FUNCTIONALITY = { + proc init() = { + F.init(); + } + + proc f(bs : bool list, n : int) = { + var cs; + + cs <@ F.g(pad2blocks bs, n); + return take n cs; + } +}. + +pred LazyInvar + (mp1 : (bool list * int, bool) fmap, + mp2 : (block list * int, bool) fmap) = + (forall (bs : bool list, n : int), + mem (dom mp1) (bs, n) <=> mem (dom mp2) (pad2blocks bs, n)) /\ + (forall (xs : block list, n), + mem (dom mp2) (xs, n) => valid_block xs) /\ + (forall (bs : bool list, n : int), + mem (dom mp1) (bs, n) => + oget mp1.[(bs, n)] = oget mp2.[(pad2blocks bs, n)]). + +local lemma LowerFun_IRO_BlockIROBitsLazy_f : + equiv[LowerFun(IRO).f ~ BlockIROBitsLazy.f : + ={xs, n} /\ LazyInvar IRO.mp{1} BlockIROBitsLazy.mp{2} ==> + ={res} /\ LazyInvar IRO.mp{1} BlockIROBitsLazy.mp{2}]. +proof. +proc=> /=; inline BlockIROBitsLazy.g. +seq 0 1 : + (={n} /\ xs{1} = xs0{2} /\ + LazyInvar IRO.mp{1} BlockIROBitsLazy.mp{2}); first auto. +case (valid_block xs{1}). +rcondt{1} 3; first auto. rcondt{2} 4; first auto. +inline *. rcondt{1} 7; first auto. +seq 6 3 : + (={n, n0} /\ xs{1} = xs0{2} /\ n0{1} = n{1} * r /\ + LazyInvar IRO.mp{1} BlockIROBitsLazy.mp{2} /\ + valid_block xs{1} /\ pad2blocks x{1} = xs0{2}). +auto; progress; have {2}<- /# := unpadBlocksK xs0{2}. +admit. +rcondf{1} 3; first auto. rcondf{2} 4; first auto. +auto; progress; by rewrite bits2blocks_nil. +qed. + +(* TODO: + + IRO.f ~ RaiseBIROBLazy(BlockIROBitsLazy).f *) + +(* TODO: +BlockIROBitsEager.f ~ Block.BIRO.IRO.f + +BlockIROBitsEager.fi ~ Block.BIRO.IRO.fi + +RaiseFun(BlockIROBitsEager).f ~ RaiseFun(Block.BIRO.IRO).f +*) + +local lemma BlockIROBitsEager (D <: BLOCK_IRO_BITS_DIST) : + equiv[D(BlockIROBitsEager).distinguish ~ D(BlockIROBitsLazy).distinguish : + ={glob D} /\ BlockIROBitsEager.mp{1} = BlockIROBitsLazy.mp{2} ==> + ={glob D}]. +proof. +admit. +qed. + +pred BlockIROBits_Eager_Invar + (mp1 : (block list * int, block) fmap, + mp2 : (block list * int, bool) fmap) = + (forall (xs : block list, i : int), + mem (dom mp1) (xs, i) => + 0 <= i /\ + (forall (j : int), 0 <= j < i => mem (dom mp1) (xs, j)) /\ + (forall (j : int), i * r <= j < (i + 1) * r => + mp2.[(xs, j)] = Some(nth false (w2bits(oget mp1.[(xs, i)])) j))) /\ + (forall (xs : block list, j : int), + mem (dom mp2) (xs, j) => + 0 <= j /\ mem (dom mp1) (xs, j %/ r)). + +local lemma Sponge_Raise_Block_Sponge_f : equiv[Sponge(Perm).f ~ RaiseFun(Block.Sponge(Perm)).f : ={bs, n, glob Perm} ==> ={res, glob Perm}]. proof. @@ -118,7 +283,7 @@ auto; progress; by rewrite -cats1 blocks2bits_cat blocks2bits_sing. auto. qed. -lemma RealIndif &m : +local lemma RealIndif &m : Pr[RealIndif(Sponge, Perm, Dist).main() @ &m: res] = Pr[Block.RealIndif (Block.Sponge, Perm, LowerDist(Dist)).main() @ &m : res]. @@ -130,36 +295,81 @@ conseq Sponge_Raise_Block_Sponge_f=> //. auto. qed. -lemma IdealDist &1 &2 (a : bool) : - (glob Dist){1} = (glob Dist){2} => (glob BlockSim){1} = (glob BlockSim){2} => - IRO.mp{1} = NewFMap.map0 => Block.BIRO.IRO.mp{2} = NewFMap.map0 => - Pr[Dist(IRO, BlockSim(LowerFun(IRO))).distinguish() @ &1 : a = res] = - Pr[Dist(RaiseFun(Block.BIRO.IRO), - BlockSim(Block.BIRO.IRO)).distinguish() @ &2 : a = res]. +local lemma IdealIndifIROLazy &m : + Pr[IdealIndif(IRO, RaiseSim(BlockSim), Dist).main() @ &m : res] = + Pr[Experiment + (RaiseBIROBLazy(BlockIROBitsLazy), BlockSim(BlockIROBitsLazy), + Dist).main() @ &m : res]. proof. +byequiv=> //; proc. +seq 2 2 : + (={glob Dist, glob BlockSim} /\ IRO.mp{1} = NewFMap.map0 /\ + BlockIROBitsLazy.mp{2} = NewFMap.map0). +inline *; wp; call (_ : true); auto. +call + (_ : + ={glob Dist, glob BlockSim} /\ + IRO.mp{1} = map0 /\ BlockIROBitsLazy.mp{2} = map0 ==> + ={res}). +proc (={glob BlockSim}). +smt. +smt. +admit. +admit. admit. +auto. qed. -lemma IdealIndif &m : - Pr[IdealIndif(IRO, RaiseSim(BlockSim), Dist).main() @ &m : res] = +local lemma IdealIndifLazy &m : + Pr[Experiment + (RaiseBIROBLazy(BlockIROBitsLazy), BlockSim(BlockIROBitsLazy), + Dist).main() @ &m : res] = + Pr[Block.IdealIndif + (BlockIROBitsEager, BlockSim, LowerDist(Dist)).main() @ &m : res]. +proof. +byequiv=> //; proc. +seq 2 2 : + (={glob Dist, glob BlockSim} /\ BlockIROBitsLazy.mp{1} = NewFMap.map0 /\ + BlockIROBitsEager.mp{2} = NewFMap.map0). +inline *; wp; call (_ : true); auto. +(* reduction to BlockIROBitsEager *) +admit. +qed. + +local lemma IdealIndifEager &m : + Pr[Block.IdealIndif + (BlockIROBitsEager, BlockSim, LowerDist(Dist)).main() @ &m : res] = Pr[Block.IdealIndif (Block.BIRO.IRO, BlockSim, LowerDist(Dist)).main () @ &m : res]. proof. byequiv=> //; proc. seq 2 2 : - (={glob Dist, glob BlockSim} /\ IRO.mp{1} = NewFMap.map0 /\ + (={glob Dist, glob BlockSim} /\ BlockIROBitsEager.mp{1} = NewFMap.map0 /\ Block.BIRO.IRO.mp{2} = NewFMap.map0). inline *; wp; call (_ : true); auto. call (_ : ={glob Dist, glob BlockSim} /\ - IRO.mp{1} = map0 /\ Block.BIRO.IRO.mp{2} = map0 ==> + BlockIROBitsEager.mp{1} = map0 /\ Block.BIRO.IRO.mp{2} = map0 ==> ={res}). -bypr res{1} res{2}=> //; progress. -apply (IdealDist &1 &2 a)=> //. +proc (={glob BlockSim}). +smt. +smt. +proc (true); first 2 smt. +admit. +admit. +admit. auto. qed. +local lemma IdealIndif &m : + Pr[IdealIndif(IRO, RaiseSim(BlockSim), Dist).main() @ &m : res] = + Pr[Block.IdealIndif + (Block.BIRO.IRO, BlockSim, LowerDist(Dist)).main () @ &m : res]. +proof. +by rewrite (IdealIndifIROLazy &m) (IdealIndifLazy &m) (IdealIndifEager &m). +qed. + lemma Conclusion' &m : `|Pr[RealIndif(Sponge, Perm, Dist).main() @ &m: res] - Pr[IdealIndif(IRO, RaiseSim(BlockSim), Dist).main() @ &m : res]| = From 58a7b2313874a6413f1a7a8ea8dfa45232a5cece Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Fri, 22 Jan 2016 12:53:52 +0100 Subject: [PATCH 122/525] RndO: new intro pattern syntax. --- proof/RndO.ec | 74 +++++++++++++++++++++++++-------------------------- 1 file changed, 37 insertions(+), 37 deletions(-) diff --git a/proof/RndO.ec b/proof/RndO.ec index a8c21dc..2e8757f 100644 --- a/proof/RndO.ec +++ b/proof/RndO.ec @@ -177,7 +177,7 @@ qed. equiv RO_FRO_set : RO.set ~ FRO.set : ={x,y} /\ RO.m{1} = map (+fst) FRO.m{2} ==> RO.m{1} = map (+fst) FRO.m{2}. -proof. by proc;auto=>?&ml[*]3!->;rewrite map_set. qed. +proof. by proc;auto=>?&ml[#]3->;rewrite map_set. qed. equiv RO_FRO_rem : RO.rem ~ FRO.rem : ={x} /\ RO.m{1} = map (+fst) FRO.m{2} ==> RO.m{1} = map (+fst) FRO.m{2}. @@ -319,14 +319,14 @@ lemma iter_perm2 (i1 i2 : from): ={glob RRO.I, t1, t2} ==> ={glob RRO.I}]. proof. proc;inline *;case ((t1=t2){1});1:by auto. - by swap{2}[4..5]-3;auto=> &ml&mr[*]3!->neq/=?->?->;rewrite set_set neq. + by swap{2}[4..5]-3;auto=> &ml&mr[#]3->neq/=?->?->;rewrite set_set neq. qed. equiv I_f_neq x1 mx1: RRO.I.f ~ RRO.I.f : ={x,FRO.m} /\ x1 <> x{1} /\ FRO.m{1}.[x1] = mx1 ==> ={FRO.m} /\ FRO.m{1}.[x1] = mx1. proof. - by proc;auto=>?&mr[*]2!->Hneq Heq/=?->;rewrite getP Hneq. + by proc;auto=>?&mr[#]2->Hneq Heq/=?->;rewrite getP Hneq. qed. equiv I_f_eqex x1 mx1 mx2: RRO.I.f ~ RRO.I.f : @@ -335,14 +335,14 @@ equiv I_f_eqex x1 mx1 mx2: RRO.I.f ~ RRO.I.f : eq_except FRO.m{1} FRO.m{2} (fset1 x1) /\ FRO.m{1}.[x1] = mx1 /\ FRO.m{2}.[x1] = mx2. proof. - by proc;auto=>?&mr[*]->Hneq Heq/= Heq1 Heq2?->/=;rewrite !getP Hneq eq_except_set. + by proc;auto=>?&mr[#]->Hneq Heq/= Heq1 Heq2?->/=;rewrite !getP Hneq eq_except_set. qed. equiv I_f_set x1 r1 : RRO.I.f ~ RRO.I.f : ={x} /\ x1 <> x{1} /\ FRO.m{1}.[x1] = None /\ FRO.m{2} = FRO.m{1}.[x1 <- (r1, Known)] ==> FRO.m{1}.[x1] = None /\ FRO.m{2} = FRO.m{1}.[x1 <- (r1, Known)]. proof. - by proc;auto=>?&mr[*]->Hneq H1->/=?->;rewrite getP Hneq/= H1 set_set Hneq. + by proc;auto=>?&mr[#]->Hneq H1->/=?->;rewrite getP Hneq/= H1 set_set Hneq. qed. lemma eager_get : @@ -355,9 +355,9 @@ proof. exists*x{1}, ((oget FRO.m.[x{2}]){1});elim*=>x1 mx;inline RRO.resample. call (iter_inv RRO.I (fun z=>x1<>z) (fun o1 o2 => o1 = o2 /\ o1.[x1]= Some mx) _)=>/=. + by conseq (I_f_neq x1 (Some mx))=>//. - auto=>?&mr[*]4!->Hd Hget;rewrite sampleto_ll /==>?_;split. + auto=>?&mr[#]4->Hd Hget;rewrite sampleto_ll /==>?_;split. + by rewrite get_oget//oget_some/==> x;rewrite -memE dom_restr/#. - by move=>[*]_ Heq?mr[*]->Heq'?_;rewrite in_dom Heq' oget_some /= set_eq /#. + by move=>[#]_ Heq?mr[#]->Heq'?_;rewrite in_dom Heq' oget_some /= set_eq /#. case ((mem (dom FRO.m) x){1}). + inline{1} RRO.resample=>/=;rnd{1}. transitivity{1} @@ -368,8 +368,8 @@ proof. ={x} /\ eq_except FRO.m{1} FRO.m{2} (fset1 x{1}) /\ FRO.m{1}.[x{2}] = Some (result{2},Unknown) /\ FRO.m{2}.[x{2}] = Some (result{2},Known)). - + by move=>?&mr[*]-> -> ??;exists FRO.m{mr}, x{mr}=>/#. - + move=>???;rewrite in_dom=>[*]<*>[*]->/eq_except_sym H Hxm Hx2. + + by move=>?&mr[#]-> -> ??;exists FRO.m{mr}, x{mr}=>/#. + + move=>???;rewrite in_dom=>[#]<*>[#]->/eq_except_sym H Hxm Hx2. rewrite sampleto_ll=> r _;rewrite /= Hxm oget_some /=;apply /eq_sym. have /(congr1 oget):= Hx2 => <-;apply eq_except_set_eq=>//. by rewrite in_dom Hx2. @@ -381,21 +381,21 @@ proof. (l =elems(dom (restr Unknown FRO.m) `\` fset1 x)){1} /\ FRO.m{1}.[x{2}] = Some (result{2}, Unknown) /\ FRO.m{2}.[x{2}] = Some (result{2}, Known)). - + auto=>?&mr[*]2!->/=^Hdom->^Hget->?->/=. + + auto=>?&mr[#]2->/=^Hdom->^Hget->?->/=. by rewrite !getP /=oget_some !restr_set/= dom_set set2_eq_except fsetDK. exists*x{1}, FRO.m{1}.[x{2}], FRO.m{2}.[x{2}];elim*=>x1 mx1 mx2. call (iter_inv RRO.I (fun z=>x1<>z) (fun o1 o2 => eq_except o1 o2 (fset1 x1) /\ o1.[x1]= mx1 /\ o2.[x1]=mx2) - (I_f_eqex x1 mx1 mx2))=>/=;auto=>?&mr[*]4!->^H->->^H1->^H2->/=;split. + (I_f_eqex x1 mx1 mx2))=>/=;auto=>?&mr[#]4->^H->->^H1->^H2->/=;split. + congr;rewrite fsetP=>z;rewrite !inE !dom_restr /in_dom_with !in_dom; smt. by move=>x;rewrite -memE in_fsetD1 eq_sym. swap{1}-1;seq 1 1 : (={r,x,FRO.m} /\ ! mem (dom FRO.m{1}) x{1});1:by auto. inline RRO.resample;exists*x{1},r{1};elim*=>x1 r1. call (iter_inv RRO.I (fun z=>x1<>z) (fun o1 o2 => o1.[x1] = None /\ o2= o1.[x1<-(r1,Known)]) (I_f_set x1 r1));auto. - move=>?&mr[*]5!-> ^Hnin^ + ->/=;rewrite in_dom=>/=->/=;rewrite restr_set_neq //=;split. + move=>?&mr[#]5-> ^Hnin^ + ->/=;rewrite in_dom=>/=->/=;rewrite restr_set_neq //=;split. + by move=>z; rewrite -memE dom_restr /#. - by move=>_?mr[*]^Hmem 2!->;rewrite in_dom Hmem /= getP /=oget_some. + by move=>_?mr[#]^Hmem 2!->;rewrite in_dom Hmem /= getP /=oget_some. qed. lemma eager_set : @@ -411,29 +411,29 @@ proof. (={x,y,FRO.m} /\ mem (dom FRO.m{1}) x{1} /\ (oget FRO.m{1}.[x{1}]).`2 = Unknown==> ={x,y} /\ eq_except FRO.m{1} FRO.m{2} (fset1 x{1}) /\ FRO.m{2}.[x{2}] = Some (y{2},Known)). - + by move=>?&mr[*]2!->???;exists FRO.m{mr}, y{mr}, x{mr}=>/#. - + move=>?&m&mr[*]<*>[*]2!->Hex Hm2. + + by move=>?&mr[#]2->???;exists FRO.m{mr}, y{mr}, x{mr}=>/#. + + move=>?&m&mr[#]<*>[#]2->Hex Hm2. by rewrite (eq_except_set_eq FRO.m{mr} FRO.m{m} x{mr}) ?in_dom ?Hm2// eq_except_sym. - + symmetry;call (iter1_perm RRO.I iter_perm2);auto=>?&mr[*]3!-> Hdom Hm;split=>//=. + + symmetry;call (iter1_perm RRO.I iter_perm2);auto=>?&mr[#]3-> Hdom Hm;split=>//=. by apply /perm_eq_sym/perm_to_rem/dom_restr;rewrite /in_dom_with Hdom. inline{1}Iter(RRO.I).iter_1s. seq 3 1: (={x,y} /\ eq_except FRO.m{1} FRO.m{2} (fset1 x{1}) /\ l{1} = (elems (dom (restr Unknown FRO.m))){2} /\ !mem l{1} x{1} /\ (FRO.m.[x]=Some(y, Known)){2}). - + inline *;auto=>?&mr[*]3!->/=Hmem Hget;rewrite sampleto_ll=>?_. + + inline *;auto=>?&mr[#]3->/=Hmem Hget;rewrite sampleto_ll=>?_. by rewrite set2_eq_except getP_eq restr_set /= dom_rem -memE !inE negb_and. exists* x{1},y{1},(FRO.m.[x]{1});elim*=>x1 y1 mx1;pose mx2:=Some(y1,Known). call (iter_inv RRO.I (fun z=>x1<>z) (fun o1 o2 => eq_except o1 o2 (fset1 x1) /\ o1.[x1]= mx1 /\ o2.[x1]=mx2) - (I_f_eqex x1 mx1 mx2))=>/=;auto=>?&mr[*]-><-2!->->>2!->Hmem->/#. + (I_f_eqex x1 mx1 mx2))=>/=;auto=>?&mr[#]-><-2!->->>2!->Hmem->/#. exists* x{1},y{1},(FRO.m.[x]{1});elim*=>x1 y1 mx1;pose mx2:=Some(y1,Known). call (iter_inv RRO.I (fun z=>x1<>z) (fun o1 o2 => eq_except o1 o2 (fset1 x1) /\ o1.[x1]= mx1 /\ o2.[x1]=mx2) - (I_f_eqex x1 mx1 mx2))=>/=;auto=>?&mr[*]-><-2!->->>->/= Hidm. + (I_f_eqex x1 mx1 mx2))=>/=;auto=>?&mr[#]-><-2!->->>->/= Hidm. rewrite restr_set getP_eq/mx2 eq_except_sym set_eq_except/=;split;[split|]. + by congr;apply fsetP=>z;rewrite !(dom_rem,inE,dom_restr) /#. + by move=>z;rewrite -memE dom_restr /#. - move=>_??[*]Hex HLx HRx;apply /eq_sym. + move=>_??[#]Hex HLx HRx;apply /eq_sym. have/(congr1 oget):=HRx=><-;apply eq_except_set_eq=>//;1:by rewrite in_dom HRx. by apply /eq_except_sym. qed. @@ -448,21 +448,21 @@ proof. { Iter(RRO.I).iter_1s(x,elems (dom (restr Unknown FRO.m) `\` fset1 x)); } (={x,FRO.m}/\(in_dom_with FRO.m x Unknown){1}==> ={x,FRO.m}) (={x,FRO.m}/\ (in_dom_with FRO.m x Unknown){1} ==> (rem x FRO.m){1} = FRO.m{2})=>//. - + by move=>?&mr[*]2!->?;exists FRO.m{mr}, x{mr}. - + symmetry;call (iter1_perm RRO.I iter_perm2);skip=>?&mr[*]2!->?/=;split=>//. + + by move=>?&mr[#]2->?;exists FRO.m{mr}, x{mr}. + + symmetry;call (iter1_perm RRO.I iter_perm2);skip=>?&mr[#]2!->?/=;split=>//. by apply /perm_eq_sym/perm_to_rem/dom_restr. inline{1}Iter(RRO.I).iter_1s. seq 3 1: (={x} /\ eq_except FRO.m{1} FRO.m{2} (fset1 x{1}) /\ l{1} = (elems (dom (restr Unknown FRO.m))){2} /\ !mem l{1} x{1} /\ (FRO.m.[x]=None){2}). - + inline *;auto=>??[*]2!->Hidm/=;rewrite sampleto_ll=>?_. + + inline *;auto=>??[#]2->Hidm/=;rewrite sampleto_ll=>?_. rewrite eq_except_rem 1:!inE 2:set_eq_except // remP -memE in_fsetD1 negb_and /=. by rewrite restr_rem Hidm /= dom_rem. exists* x{1},(FRO.m.[x]{1});elim*=>x1 mx1. call (iter_inv RRO.I (fun z=>x1<>z) (fun o1 o2 => eq_except o1 o2 (fset1 x1) /\ o1.[x1]= mx1 /\ o2.[x1]=None) _). + by conseq (I_f_eqex x1 mx1 None). - auto=>?&mr[*]3!->^Hex 2!->Hmem ^Hx->/=;split=>[/#|_ mL mR[*]/eq_exceptP Hex'?Heq]. + auto=>?&mr[#]3->^Hex 2!->Hmem ^Hx->/=;split=>[/#|_ mL mR[#]/eq_exceptP Hex'?Heq]. apply fmapP=>z;rewrite remP;case (z=x{mr})=>[->/=|Hneq];1:by rewrite Heq. by apply Hex';rewrite inE. inline RRO.resample;wp. @@ -470,10 +470,10 @@ proof. call (iter_inv RRO.I (fun z=>x1<>z) (fun o1 o2 => eq_except o1 o2 (fset1 x1) /\ o1.[x1]= mx1 /\ o2.[x1]=None) _). + by conseq (I_f_eqex x1 mx1 None). - auto=>?&mr[*]4!->Hin/=. + auto=>?&mr[#]4->Hin/=. rewrite restr_rem Hin/= remP eq_except_rem 1:inE // 1:eq_except_refl /=;split. + by move=>z;rewrite -memE dom_restr /#. - move=>_ mL mR[*] /eq_exceptP Hex'?Heq. + move=>_ mL mR[#] /eq_exceptP Hex'?Heq. apply fmapP=>z;rewrite remP;case (z=x{mr})=>[->/=|Hneq];1:by rewrite Heq. by apply Hex';rewrite inE. qed. @@ -485,9 +485,9 @@ proof. eager proc;inline *;wp. while (={l,FRO.m} /\ (forall z, mem l z => in_dom_with FRO.m z Unknown){1} /\ in_dom_with FRO.m{1} x{1} f{1} = result{2}). - + auto=>?&mr[*]2!->Hz <-?_/=?->/=. + + auto=>?&mr[#]2->Hz <-?_/=?->/=. split=>[z /mem_drop Hm|];rewrite /in_dom_with dom_set getP !inE /#. - by auto=>?&mr/=[*]3!->/=;split=>// z;rewrite -memE dom_restr. + by auto=>?&mr/=[#]3->/=;split=>// z;rewrite -memE dom_restr. qed. lemma eager_restrK: @@ -497,7 +497,7 @@ proof. eager proc;inline *;wp. while (={l,FRO.m} /\ (forall z, mem l z => in_dom_with FRO.m z Unknown){1} /\ restr Known FRO.m{1} = result{2}). - + auto=>?&mr[*]2!->Hz<-?H/=?->/=. + + auto=>?&mr[#]2->Hz<-?H/=?->/=. split=>[z /mem_drop Hm|];1:by rewrite /in_dom_with dom_set getP !inE /#. rewrite restr_set rem_id?dom_restr//. by move:H=>/(mem_head_behead witness) /(_ (head witness l{mr})) /= /Hz /#. @@ -516,21 +516,21 @@ proof. Iter(RRO.I).iter_1s(x,elems ((dom (restr Unknown FRO.m)) `\` fset1 x));} (={x,FRO.m} /\ ! mem (dom FRO.m{2}) x{2} ==> ={x,FRO.m}) (={x,FRO.m} /\ ! mem (dom FRO.m{2}) x{2} ==> ={x,FRO.m})=>//;last first. - + inline{2} RRO.resample;call (iter1_perm RRO.I iter_perm2);auto=>?&mr[*]2!->Hmem/=?->/=. + + inline{2} RRO.resample;call (iter1_perm RRO.I iter_perm2);auto=>?&mr[#]2->Hmem/=?->/=. by apply /perm_eq_sym/perm_to_rem;rewrite restr_set/=dom_set !inE. - + by move=>?&mr[*]2!->?;exists FRO.m{mr}, x{mr}. + + by move=>?&mr[#]2->?;exists FRO.m{mr}, x{mr}. inline Iter(RRO.I).iter_1s RRO.I.f RRO.resample;wp;swap{1}-1. seq 1 7 : (={x} /\ eq_except FRO.m{1} FRO.m{2} (fset1 x{1}) /\ l{2} = (elems (dom (restr Unknown FRO.m))){1} /\ (FRO.m.[x]){2} = Some(c{1},Unknown) /\ (FRO.m.[x]){1} = None). - + wp;rnd;auto=>?&mr[*]2!->;rewrite in_dom sampleto_ll/==>Heq?_?->. + + wp;rnd;auto=>?&mr[#]2->;rewrite in_dom sampleto_ll/==>Heq?_?->. rewrite getP_eq restr_set/=dom_set fsetDK eq_except_sym set_set Heq/=set_eq_except/=. congr;apply fsetP=>z;rewrite in_fsetD1 dom_restr /in_dom_with !in_dom /#. exists*x{1},c{1};elim*=>x1 c1;pose mx2:=Some(c1,Unknown). call (iter_inv RRO.I (fun z=>x1<>z) (fun o1 o2 => eq_except o1 o2 (fset1 x1) /\ o1.[x1]= None /\ o2.[x1]=mx2) _). + by conseq (I_f_eqex x1 None mx2). - auto=>?&mr[*]2!<-->^Hex 3!->^Hx1-> @/mx2/=;split=>[z|_ mL mR[*]]. + auto=>?&mr[#]2<-->^Hex 3!->^Hx1-> @/mx2/=;split=>[z|_ mL mR[#]]. + rewrite -memE dom_restr /in_dom_with in_dom /#. rewrite in_dom=>Hex'->HRx/=;apply /eq_sym. have/(congr1 oget):=HRx=><-;apply eq_except_set_eq;1:by rewrite in_dom HRx. @@ -538,7 +538,7 @@ proof. rcondf{2}2;1:by auto. swap{1}2-1;inline*;auto. while (={l,FRO.m} /\ (mem (dom FRO.m) x){1});auto. - by move=>?&mr[*]2!->Hm Hl _/=?->;rewrite dom_set !inE Hm. + by move=>?&mr[#]2->Hm Hl _/=?->;rewrite dom_set !inE Hm. qed. section. @@ -606,12 +606,12 @@ qed. equiv LRO_RRO_set : LRO.set ~ RRO.set : ={x,y} /\ RO.m{1} = restr Known FRO.m{2} ==> RO.m{1} = restr Known FRO.m{2}. -proof. by proc;auto=>?&ml[*]3!->;rewrite restr_set. qed. +proof. by proc;auto=>?&ml[#]3->;rewrite restr_set. qed. equiv LRO_RRO_rem : LRO.rem ~ RRO.rem : ={x} /\ RO.m{1} = restr Known FRO.m{2} ==> RO.m{1} = restr Known FRO.m{2}. proof. - proc;inline *;auto=>?&mr[*]->->. rewrite restr_rem. + proc;inline *;auto=>?&mr[#]->->. rewrite restr_rem. case (in_dom_with FRO.m{mr} x{mr} Known)=>// Hidw. by rewrite rem_id // dom_restr. qed. @@ -675,7 +675,7 @@ proof. + by move=>?&mr[]2!->;exists (glob D){mr},(map(fun _ c =>(c,Known))RO.m{mr}). + by proc; eager call (eager_D D);auto. proc*;inline M.main2;wp;call{1} RRO_resample_ll. - symmetry;call (LRO_RRO_D D);auto=> &ml&mr[*]2!->;split=>//=. + symmetry;call (LRO_RRO_D D);auto=> &ml&mr[#]2->;split=>//=. by rewrite fmapP=>x;rewrite restrP mapP;case (RO.m{ml}.[x]). qed. From 614f806bc2141ed5cf141fd5dcfc527012b67834 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Fri, 22 Jan 2016 15:07:49 +0100 Subject: [PATCH 123/525] Some progress on the invariant proofs. --- proof/old/Handle.eca | 200 +++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 195 insertions(+), 5 deletions(-) diff --git a/proof/old/Handle.eca b/proof/old/Handle.eca index b93dea6..c35ae48 100644 --- a/proof/old/Handle.eca +++ b/proof/old/Handle.eca @@ -165,7 +165,7 @@ op eqm_handles (handles:handles) (m:smap) (mh:hsmap) = op mh_spec (handles:handles) (m2:smap) (mh:hsmap) (ro:(block list, block)fmap) = (forall bh bh', mh.[bh] = Some bh' => - exists c f c' f', + exists c c' f f', handles.[bh .`2]=Some(c,f) /\ handles.[bh'.`2]=Some(c',f') /\ if f' = Known then m2.[(bh.`1,c)] = Some(bh'.`1,c') /\ f = Known @@ -185,7 +185,7 @@ op paths_spec (handles:handles) (mh:hsmap) (paths:(capacity,block list * block)f build_hpath mh p = Some(v,h) /\ handles.[h] = Some(c,Known). -op handles_spec handles chandle = +op handles_spec handles chandle = huniq handles /\ handles.[0] = Some (c0,Known) /\ forall h, mem (dom handles) h => h < chandle. op INV_CF_G1 (handles:handles) chandle (m1 mi1 m2 mi2:smap) (mh2 mhi2:hsmap) (ro:(block list, block) fmap) paths = @@ -193,6 +193,66 @@ op INV_CF_G1 (handles:handles) chandle (m1 mi1 m2 mi2:smap) (mh2 mhi2:hsmap) (ro (incl m2 m1 /\ incl mi2 mi1) /\ (mh_spec handles m2 mh2 ro /\ paths_spec handles mh2 paths /\ handles_spec handles chandle). +lemma eqm_of_INV (chandle : handle) + (mi1 m2 mi2 : smap) (mhi2 : hsmap) + (ro : (block list, block) fmap) + (paths : (capacity, block list * block) fmap) + handles m1 mh2: + INV_CF_G1 handles chandle m1 mi1 m2 mi2 mh2 mhi2 ro paths => + eqm_handles handles m1 mh2. +proof. by move=> @/INV_CF_G1 [#]. qed. + +lemma eqmi_of_INV (chandle : handle) + (m1 m2 mi2 : smap) (mh2 : hsmap) + (ro : (block list, block) fmap) + (paths : (capacity, block list * block) fmap) + handles mi1 mhi2: + INV_CF_G1 handles chandle m1 mi1 m2 mi2 mh2 mhi2 ro paths => + eqm_handles handles mi1 mhi2. +proof. by move=> @/INV_CF_G1 [#]. qed. + +lemma incl_of_INV (handles : handles) (chandle : handle) + (mi1 mi2 : smap) (mh2 mhi2: hsmap) + (ro : (block list, block) fmap) + (paths : (capacity, block list * block) fmap) + m1 m2: + INV_CF_G1 handles chandle m1 mi1 m2 mi2 mh2 mhi2 ro paths => + incl m2 m1. +proof. by move=> @/INV_CF_G1 [#]. qed. + +lemma incli_of_INV (handles : handles) (chandle : handle) + (m1 m2 : smap) (mh2 mhi2: hsmap) + (ro : (block list, block) fmap) + (paths : (capacity, block list * block) fmap) + mi1 mi2: + INV_CF_G1 handles chandle m1 mi1 m2 mi2 mh2 mhi2 ro paths => + incl mi2 mi1. +proof. by move=> @/INV_CF_G1 [#]. qed. + +lemma mh_of_INV (chandle : handle) + (m1 mi1 mi2 : smap) (mhi2 : hsmap) + (paths : (capacity, block list * block) fmap) + handles m2 mh2 ro: + INV_CF_G1 handles chandle m1 mi1 m2 mi2 mh2 mhi2 ro paths => + mh_spec handles m2 mh2 ro. +proof. by move=> @/INV_CF_G1 [#]. qed. + +lemma paths_of_INV (chandle : handle) + (m1 m2 mi1 mi2: smap) (mhi2: hsmap) + (ro : (block list, block) fmap) + handles mh2 paths: + INV_CF_G1 handles chandle m1 mi1 m2 mi2 mh2 mhi2 ro paths => + paths_spec handles mh2 paths. +proof. by move=> @/INV_CF_G1 [#]. qed. + +lemma handles_of_INV (m1 m2 mi1 mi2 : smap) (mh2 mhi2 : hsmap) + (ro : (block list, block) fmap) + (paths : (capacity, block list * block) fmap) + handles chandle: + INV_CF_G1 handles chandle m1 mi1 m2 mi2 mh2 mhi2 ro paths => + handles_spec handles chandle. +proof. by move=> @/INV_CF_G1 [#]. qed. + lemma eqm_dom_mh_m handles m mh hx2 f (x:state): eqm_handles handles m mh => handles.[hx2] = Some (x.`2, f) => @@ -283,6 +343,76 @@ proof. by apply handles_up_handles. qed. +lemma eqm_handles_up (handles : handles) m mh (h hx:handle) (x y : state) f: + huniq handles => + handles.[h] = None => + handles.[hx] = Some (x.`2, f) => + eqm_handles handles m mh => + eqm_handles handles.[h <- (y.`2,Known)] m.[x <- y] mh.[(x.`1,hx) <- (y.`1,h)]. +proof. +move=> uniq_h h_h h_hx @/eqm_handles [] hmmh hmhm; split. ++ move=> bc bc'; rewrite getP; case (bc = x)=> /= [->> <<- {bc bc'}|]. + * by exists hx, h, f, Known; rewrite !getP /= [smt w=in_dom]. + move=> bc_neq_x /hmmh [] h0 h0' f0 f0' [#] h_h0 h_h0' mhi_bc. + by exists h0, h0', f0, f0'; rewrite !getP [smt w=in_dom]. +move=> bh bh'; rewrite getP; case (bh = (x.`1,hx))=> /= [->> <<- {bh bh'}|]. + * by exists x.`2, y.`2, f, Known; rewrite !getP [smt w=in_dom]. +case bh=> b h0 /=. +rewrite anda_and NewLogic.negb_and=> bh_neq_x1hx /hmhm /= [] c0 c0' f0 f0' [#] h_h0 h_bh' m_bc. +exists c0, c0', f0, f0'; rewrite !getP. +split; 1:smt w=in_dom. +split; 1:smt w=in_dom. +case x bh_neq_x1hx h_hx=> x1 x2 /= => - [/#|h0_neq_hx h_hx]. +have -> //=: c0 <> x2; move: h0_neq_hx; apply/contra. +exact/(uniq_h _ _ _ _ h_h0 h_hx). +qed. + +lemma eqmi_handles_up (handles : handles) mi mhi (h hx : handle) (x y : state) f: + (!exists f', mem (rng handles) (y.`2,f')) => + handles.[h] = None => + handles.[hx] = Some (x.`2, f) => + eqm_handles handles mi mhi => + eqm_handles handles.[h <- (y.`2,Known)] mi.[y <- x] mhi.[(y.`1,h) <- (x.`1,hx)]. +proof. +move=> y_notinr1_handles h_h h_hx @/eqm_handles [] hmmh hmhm; split. ++ move=> bc bc'; rewrite getP; case (bc = y)=> /= [->> <<- {bc bc'}|]. + * by exists h, hx, Known, f; rewrite !getP /= [smt w=in_dom]. + move=> bc_neq_y /hmmh [] h0 h0' f0 f0' [#] h_h0 h_h0' mhi_bc. + by exists h0, h0', f0, f0'; rewrite !getP [smt w=in_dom]. +move=> bh bh'; rewrite getP; case (bh = (y.`1,h))=> /= [->> <<- {bh bh'}|]. + * by exists y.`2, x.`2, Known, f; rewrite !getP [smt w=in_dom]. +case bh=> b h0 /=. +rewrite anda_and NewLogic.negb_and=> bh_neq_y1h /hmhm /= [] c0 c0' f0 f0' [#] h_bh h_bh' mi_bh. +exists c0, c0', f0, f0'; rewrite !getP. +split; 1:smt w=in_dom. +split; 1:smt w=in_dom. +case y bh_neq_y1h y_notinr1_handles=> y1 y2 /= [/#|h0_neq_h y_notinr1_handles]. +have /#: c0 = y2 => false; move=> /(congr1 (fun x=> exists f', mem (rng handles) (x,f'))) /=. +rewrite y_notinr1_handles /= neqF /=; exists f0. +by rewrite in_rng; exists h0. +qed. + +lemma incl_set (m m' : ('a,'b) fmap) x y: + incl m m' => + incl m.[x <- y] m'.[x <- y]. +proof. smt w=(in_dom getP). qed. + +lemma hinv_notin_rng m y2: + SLCommon.hinv m y2 = None => + (forall h f, m.[h] <> Some (y2,f)). +proof. by move=> hinv_none; have:= hinvP m y2; rewrite hinv_none. qed. + +lemma handles_spec_notin_dom m h: + handles_spec m h => + !mem (dom m) h. +proof. smt w=in_dom. qed. + +lemma neq_Known f: f <> Known <=> f = Unknown. +proof. by case f. qed. + +lemma neq_Unkwown f: f <> Unknown <=> f = Known. +proof. by case f. qed. + clone export ConcreteF as ConcreteF1. section AUX. @@ -368,9 +498,48 @@ section AUX. + move=> &ml;skip=> &mr[][]_[][]-> _ []Hinv[]Hndom _[]_ Hh;rewrite -not_def in_dom=> -[]. move:Hinv=>[][][]_ /(_ (x{mr}.`1, hx2{mr}));case (G1.mh{mr}.[_])=>// bh' /(_ bh') [c c' f f'] /=. by rewrite Hh/= => -[][]<- _ []_ H;case: (x{mr}) H Hndom => [x1 x2];rewrite in_dom=>->. - auto. + auto=> &1 &2 [#] -> ->> ->> hinv x_notin_PF disj x2U_notinr_FRO FRO_hx2 /= hinv_y2. + have:= hinvP FRO.m{2} y{2}.`2; rewrite hinv_y2 //= => y2_notinr1_FRO. + rewrite getP /= oget_some /= /INV_CF_G1. + rewrite (eqm_handles_up FRO.m{2} PF.m{1} G1.mh{2} G1.chandle{2} hx2{2} x{2} y{2} Known _ _ _ _) //= 1..3:[smt w=in_dom]. + rewrite (eqmi_handles_up FRO.m{2} PF.mi{1} G1.mhi{2} G1.chandle{2} hx2{2} x{2} y{2} Known _ _ _ _) //= 2..3:[smt w=in_dom]. + + rewrite NewLogic.negb_exists=> f /=; rewrite in_rng NewLogic.negb_exists=> h. + exact/(y2_notinr1_FRO h f). + have /eqT -> /= := incl_set G1.m{2} PF.m{1} x{2} y{2} _; 1: by smt ml=0. + have /eqT -> /= := incl_set G1.mi{2} PF.mi{1} y{2} x{2} _; 1: by smt ml=0. + rewrite handles_up_handles 1:[smt w=in_rng] 1:/# /=. + split. + rewrite /mh_spec; split. + move=> bh [] b ch; rewrite getP; case (bh = (x.`1,hx2){2})=> [<*> /=|]. + rewrite anda_and=> [#] <*>. + exists x{2}.`2, y{2}.`2, Known, Known=> //=. + rewrite !getP /=; elim: (x{2}) FRO_hx2=> x1 x2 FRO_hx2; elim (y{2})=> y1 y2 /=. + have /#: hx2{2} = G1.chandle{2} => false. + move=> /(congr1 (fun x=> FRO.m{2}.[x])) /=; rewrite FRO_hx2. + have:= handles_spec_notin_dom FRO.m{2} G1.chandle{2} _; 1: smt ml=0. + by rewrite in_dom /= => ->. + elim bh=> b' h' /=; rewrite anda_and NewLogic.negb_and=> bh_neq_xhx ^mh_bh. + have @/eqm_handles [] hmmh hmhm := eqm_of_INV _ _ _ _ _ _ _ _ _ _ hinv. + move=> /hmhm=>- [c c' f f'] /= [#] FRO_h' FRO_ch PF_b'c. + exists c, c', f, f'=> //=. + rewrite !getP /=; elim: (x{2}) FRO_hx2 mh_bh x2U_notinr_FRO x_notin_PF bh_neq_xhx=> x1 x2 /= FRO_hx2 mh_bh x2U_notinr_FRO x_notin_PF bh_neq_xhx. + elim: (y{2}) y2_notinr1_FRO hinv_y2=> y1 y2 /= y2_notinr1_FRO hinv_y2. + have -> /=: h' <> G1.chandle{2} by smt w=in_dom. + rewrite FRO_h' /=. + have -> /=: ch <> G1.chandle{2} by smt w=in_dom. + rewrite FRO_ch /=; split=> /= [|/neq_Known ->> {f'}]. + case bh_neq_xhx=> [-> /#|h'_neq_hx2]. + have /#: c <> x2. + have @/handles_spec [] huniq _ := handles_of_INV _ _ _ _ _ _ _ _ _ _ hinv. + by move: h'_neq_hx2; apply/contra/(huniq _ _ (c,f) (x2,Known)). + case disj. + rewrite in_dom; case (paths0.[x{2}.`2])=> @/oget //= [[p0 v]] /= [#] <*>. + admit. (** KEY observation: if two hstates lead to hstates that + share the same handle through mh, then they are equal **) + admit. (* this one should be a lot easier *) + admit. (* some pain here *) + admit. (* will be painful as well *) (* Stopped here *) - admit. admit. (* lossless PF.P.f *) + admit. @@ -391,7 +560,28 @@ section AUX. (* lossless and do not reset bad G1.C.f *) + admit. (* Init ok *) - + admit. + inline *. auto; progress=> //=. + + smt w=map0P. + + smt w=map0P. + + smt w=map0P. + + smt w=map0P. + + smt w=map0P. + + smt w=(map0P in_dom). + + smt w=map0P. + + rewrite /paths_spec=> c p v. rewrite !getP; case (c = c0)=> //=. + rewrite anda_and=> c_c0; split=> [[] <<- <<-|]. + + by exists 0; rewrite /build_hpath /= getP /= c_c0. + move=> [h] @/build_hpath [] h0; rewrite getP; case (h = 0). + + by move=> /= ->> ->>; move: h0; smt. + smt w=map0P. + move=> c_c0; rewrite map0P /= NewLogic.negb_exists /= => h. + rewrite NewLogic.negb_and getP; case (h = 0)=> //=; [|by rewrite map0P]. + by move=> _; right; rewrite eq_sym. + + smt w=(map0P getP). + + by rewrite getP. + + move: H; rewrite in_dom getP; case (h = 0)=> //=. + by rewrite map0P. + + by move: H1=> /H0 [#]. qed. end section AUX. From d14d39d837376bb02e82875c31b2dbf2573be9dc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Fri, 22 Jan 2016 15:27:12 +0100 Subject: [PATCH 124/525] Fixing Absorb to Blocks as much as possible. --- proof/AbsorbToBlocks.ec | 74 ++++++++++++++++++++--------------------- 1 file changed, 37 insertions(+), 37 deletions(-) diff --git a/proof/AbsorbToBlocks.ec b/proof/AbsorbToBlocks.ec index b21bcb3..f22d47c 100644 --- a/proof/AbsorbToBlocks.ec +++ b/proof/AbsorbToBlocks.ec @@ -1,6 +1,6 @@ (* -------------------------------------------------------------------- *) require import Option Pair Int Real List FSet NewFMap. -require (*--*) Absorb Blocks. +require (*--*) Absorb Block. (* -------------------------------------------------------------------- *) require import Common. @@ -8,7 +8,7 @@ require import Common. op cast: 'a NewDistr.distr -> 'a distr. (* -------------------------------------------------------------------- *) -module LowerFun(F : Blocks.DFUNCTIONALITY) : Absorb.DFUNCTIONALITY = { +module LowerFun(F : Self.Block.DFUNCTIONALITY) : Absorb.DFUNCTIONALITY = { proc init() = {} proc f(xs : block list) : block = { @@ -22,7 +22,7 @@ module LowerFun(F : Blocks.DFUNCTIONALITY) : Absorb.DFUNCTIONALITY = { } }. -module Sim (S : Absorb.SIMULATOR, F : Blocks.DFUNCTIONALITY) = S(LowerFun(F)). +module Sim (S : Absorb.SIMULATOR, F : Self.Block.DFUNCTIONALITY) = S(LowerFun(F)). module UpperFun (F : Absorb.DFUNCTIONALITY) = { proc init() = {} @@ -43,17 +43,17 @@ module UpperFun (F : Absorb.DFUNCTIONALITY) = { } }. -module BlocksOfAbsorbBlockSponge (P : Blocks.DPRIMITIVE) = +module BlocksOfAbsorbBlockSponge (P : Self.Block.DPRIMITIVE) = UpperFun(Absorb.BlockSponge(P)). -module Dist (D : Blocks.DISTINGUISHER, F : Absorb.DFUNCTIONALITY) = D(UpperFun(F)). +module Dist (D : Self.Block.DISTINGUISHER, F : Absorb.DFUNCTIONALITY) = D(UpperFun(F)). section. - declare module AbsorbSim : Absorb.SIMULATOR { Perm, Blocks.BIRO.IRO', Absorb.Ideal.RO }. - declare module BlocksDist : Blocks.DISTINGUISHER { Perm, Blocks.BIRO.IRO', Absorb.Ideal.RO, AbsorbSim }. + declare module AbsorbSim : Absorb.SIMULATOR { Perm, Self.Block.BIRO.IRO', Absorb.Ideal.RO }. + declare module BlocksDist : Self.Block.DISTINGUISHER { Perm, Self.Block.BIRO.IRO', Absorb.Ideal.RO, AbsorbSim }. local equiv ModularBlocks_Real: - UpperFun(Absorb.BlockSponge(Perm)).f ~ Blocks.BlockSponge(Perm).f: + UpperFun(Absorb.BlockSponge(Perm)).f ~ Self.Block.Sponge(Perm).f: ={arg} /\ ={m,mi}(Perm,Perm) /\ (forall x, mem (dom Perm.m){1} x) @@ -67,15 +67,15 @@ section. qed. pred lower (ro : (block list,block) fmap) (iro : (block list * int,block) fmap) = - Blocks.BIRO.prefix_closed iro /\ + Self.Block.BIRO.prefix_closed iro /\ forall x n, valid_block x => iro.[(x,n)] = ro.[extend x n]. local equiv ModularAbsorb: - UpperFun(Absorb.Ideal.RO).f ~ Blocks.BIRO.IRO'.f: + UpperFun(Absorb.Ideal.RO).f ~ Self.Block.BIRO.IRO'.f: ={arg} - /\ lower Absorb.Ideal.RO.m{1} Blocks.BIRO.IRO'.mp{2} + /\ lower Absorb.Ideal.RO.m{1} Self.Block.BIRO.IRO'.mp{2} ==> ={res} - /\ lower Absorb.Ideal.RO.m{1} Blocks.BIRO.IRO'.mp{2}. + /\ lower Absorb.Ideal.RO.m{1} Self.Block.BIRO.IRO'.mp{2}. proof. proc. sp; if=> //=. inline Absorb.BlockSponge(Perm).f. @@ -92,13 +92,13 @@ section. /\ mem (dom ro) (extend x n')). module LowIRO' : Absorb.FUNCTIONALITY = { - proc init = Blocks.BIRO.IRO'.init + proc init = Self.Block.BIRO.IRO'.init proc f(xs : block list) = { var b <- b0; var (ys, n) = strip xs; if (valid_block ys) { - b <@ Blocks.BIRO.IRO'.f_lazy(ys, n); + b <@ Self.Block.BIRO.IRO'.f_lazy(ys, n); } return b; @@ -106,7 +106,7 @@ section. }. pred holey_map (iro iro_lazy : (block list * int,block) fmap) = - Blocks.BIRO.prefix_closed iro + Self.Block.BIRO.prefix_closed iro /\ (forall xn, mem (dom iro_lazy) xn => iro_lazy.[xn] = iro.[xn]) @@ -120,13 +120,13 @@ section. whose index is not in the index of the right map, as they have not ben given to the adversary. **) local lemma LazifyIRO: - eager [Blocks.BIRO.IRO'.resample_invisible(); , LowerFun(Blocks.BIRO.IRO').f ~ LowIRO'.f, Blocks.BIRO.IRO'.resample_invisible();: - ={arg, Blocks.BIRO.IRO'.visible} - /\ holey_map Blocks.BIRO.IRO'.mp{1} Blocks.BIRO.IRO'.mp{2} - /\ Blocks.BIRO.IRO'.visible{2} = dom (Blocks.BIRO.IRO'.mp){2} - ==> ={res, Blocks.BIRO.IRO'.visible} - /\ holey_map Blocks.BIRO.IRO'.mp{1} Blocks.BIRO.IRO'.mp{2} - /\ Blocks.BIRO.IRO'.visible{2} = dom (Blocks.BIRO.IRO'.mp){2}]. + eager [Self.Block.BIRO.IRO'.resample_invisible(); , LowerFun(Self.Block.BIRO.IRO').f ~ LowIRO'.f, Self.Block.BIRO.IRO'.resample_invisible();: + ={arg, Self.Block.BIRO.IRO'.visible} + /\ holey_map Self.Block.BIRO.IRO'.mp{1} Self.Block.BIRO.IRO'.mp{2} + /\ Self.Block.BIRO.IRO'.visible{2} = dom (Self.Block.BIRO.IRO'.mp){2} + ==> ={res, Self.Block.BIRO.IRO'.visible} + /\ holey_map Self.Block.BIRO.IRO'.mp{1} Self.Block.BIRO.IRO'.mp{2} + /\ Self.Block.BIRO.IRO'.visible{2} = dom (Self.Block.BIRO.IRO'.mp){2}]. proof. (* eager proc. @@ -198,13 +198,13 @@ section. *) lemma Intermediate &m: - `|Pr[Blocks.RealIndif(Blocks.BlockSponge,Perm,BlocksDist).main() @ &m :res] - - Pr[Blocks.IdealIndif(Blocks.BIRO.IRO',Sim(AbsorbSim),BlocksDist).main() @ &m: res]| - = `|Pr[Blocks.RealIndif(BlocksOfAbsorbBlockSponge,Perm,BlocksDist).main() @ &m: res] - - Pr[Blocks.IdealIndif(UpperFun(Absorb.Ideal.RO),Sim(AbsorbSim),BlocksDist).main() @ &m: res]|. + `|Pr[Self.Block.RealIndif(Self.Block.Sponge,Perm,BlocksDist).main() @ &m :res] + - Pr[Self.Block.IdealIndif(Self.Block.BIRO.IRO',Sim(AbsorbSim),BlocksDist).main() @ &m: res]| + = `|Pr[Self.Block.RealIndif(BlocksOfAbsorbBlockSponge,Perm,BlocksDist).main() @ &m: res] + - Pr[Self.Block.IdealIndif(UpperFun(Absorb.Ideal.RO),Sim(AbsorbSim),BlocksDist).main() @ &m: res]|. proof. - have ->: Pr[Blocks.RealIndif(BlocksOfAbsorbBlockSponge,Perm,BlocksDist).main() @ &m: res] - = Pr[Blocks.RealIndif(Blocks.BlockSponge,Perm,BlocksDist).main() @ &m :res]. + have ->: Pr[Self.Block.RealIndif(BlocksOfAbsorbBlockSponge,Perm,BlocksDist).main() @ &m: res] + = Pr[Self.Block.RealIndif(Self.Block.Sponge,Perm,BlocksDist).main() @ &m :res]. byequiv=> //=; proc. call (_: ={m,mi}(Perm,Perm) /\ (forall x, mem (dom Perm.m){1} x)). @@ -219,14 +219,14 @@ section. (* Now the other initialization is dead code. *) call (_: true ==> true)=> //. by proc; auto. - have ->: Pr[Blocks.IdealIndif(UpperFun(Absorb.Ideal.RO),Sim(AbsorbSim),BlocksDist).main() @ &m: res] - = Pr[Blocks.IdealIndif(Blocks.BIRO.IRO',Sim(AbsorbSim),BlocksDist).main() @ &m: res]. + have ->: Pr[Self.Block.IdealIndif(UpperFun(Absorb.Ideal.RO),Sim(AbsorbSim),BlocksDist).main() @ &m: res] + = Pr[Self.Block.IdealIndif(Self.Block.BIRO.IRO',Sim(AbsorbSim),BlocksDist).main() @ &m: res]. byequiv=> //=; proc. - call (_: ={glob AbsorbSim} /\ lower Absorb.Ideal.RO.m{1} Blocks.BIRO.IRO'.mp{2}). - proc (lower Absorb.Ideal.RO.m{1} Blocks.BIRO.IRO'.mp{2})=> //=. + call (_: ={glob AbsorbSim} /\ lower Absorb.Ideal.RO.m{1} Self.Block.BIRO.IRO'.mp{2}). + proc (lower Absorb.Ideal.RO.m{1} Self.Block.BIRO.IRO'.mp{2})=> //=. proc; sp; if=> //=. smt. call ModularAbsorb; auto; smt. - proc (lower Absorb.Ideal.RO.m{1} Blocks.BIRO.IRO'.mp{2})=> //=. + proc (lower Absorb.Ideal.RO.m{1} Self.Block.BIRO.IRO'.mp{2})=> //=. proc; sp; if=> //=. smt. call ModularAbsorb; auto; smt. (* Re-Bug *) @@ -238,15 +238,15 @@ section. qed. lemma Remainder &m: - `|Pr[Blocks.RealIndif(BlocksOfAbsorbBlockSponge,Perm,BlocksDist).main() @ &m: res] - - Pr[Blocks.IdealIndif(UpperFun(Absorb.Ideal.RO),Sim(AbsorbSim),BlocksDist).main() @ &m: res]| + `|Pr[Self.Block.RealIndif(BlocksOfAbsorbBlockSponge,Perm,BlocksDist).main() @ &m: res] + - Pr[Self.Block.IdealIndif(UpperFun(Absorb.Ideal.RO),Sim(AbsorbSim),BlocksDist).main() @ &m: res]| = `|Pr[Absorb.RealIndif(Absorb.BlockSponge,Perm,Dist(BlocksDist)).main() @ &m: res] - Pr[Absorb.IdealIndif(Absorb.Ideal.RO,AbsorbSim,Dist(BlocksDist)).main() @ &m: res]|. proof. admit. qed. lemma Conclusion &m: - `|Pr[Blocks.RealIndif(Blocks.BlockSponge,Perm,BlocksDist).main() @ &m: res] - - Pr[Blocks.IdealIndif(Blocks.BIRO.IRO',Sim(AbsorbSim),BlocksDist).main() @ &m: res]| + `|Pr[Self.Block.RealIndif(Self.Block.Sponge,Perm,BlocksDist).main() @ &m: res] + - Pr[Self.Block.IdealIndif(Self.Block.BIRO.IRO',Sim(AbsorbSim),BlocksDist).main() @ &m: res]| = `|Pr[Absorb.RealIndif(Absorb.BlockSponge,Perm,Dist(BlocksDist)).main() @ &m: res] - Pr[Absorb.IdealIndif(Absorb.Ideal.RO,AbsorbSim,Dist(BlocksDist)).main() @ &m: res]|. proof. by rewrite (Intermediate &m) (Remainder &m). qed. From 922fe0b45aebc920f41922877c6d7c5004edbaa2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Fri, 22 Jan 2016 15:37:40 +0100 Subject: [PATCH 125/525] Removing obsolete definition file. SLCommon contains the defs for the Core transformation. --- proof/old/Squeezeless.ec | 1230 -------------------------------------- 1 file changed, 1230 deletions(-) delete mode 100644 proof/old/Squeezeless.ec diff --git a/proof/old/Squeezeless.ec b/proof/old/Squeezeless.ec deleted file mode 100644 index a0345bc..0000000 --- a/proof/old/Squeezeless.ec +++ /dev/null @@ -1,1230 +0,0 @@ - -(** This is a theory for the Squeezeless sponge: where the ideal - functionality is a fixed-output-length random oracle whose output - length is the input block size. We prove its security even when - padding is not prefix-free. **) -require import Pred Fun Option Pair Int Real List FSet NewFMap Utils Common. - -require (*..*) RndOrcl Indifferentiability. -(*...*) import Dprod Dexcepted Capacity. - -type state = block * capacity. -op dstate = bdistr * cdistr. - - -clone include Indifferentiability with - type p <- state, - type f_in <- block list, - type f_out <- block - rename [module] "GReal" as "RealIndif" - [module] "GIdeal" as "IdealIndif". - - -(* max number of call to the permutation and its inverse *) -op max_size : int. - -(** Ideal Functionality **) -clone import Tuple as TupleBl with - type t <- block, - op Support.enum <- Block.words - proof Support.enum_spec by exact Block.enum_spec. - -op bl_enum = flatten (mkseq (fun i => wordn i) (max_size + 1)). -op bl_univ = FSet.oflist bl_enum. - -clone RndOrcl as RndOrclB with - type from <- block list, - type to <- block. - -clone import RndOrclB.RestrIdeal as Functionality with - op sample _ <- bdistr, - op test l <- List.size l <= max_size, - op univ <- bl_univ, - op dfl <- b0 - proof *. -realize sample_ll by exact Block.DWord.bdistr_ll. -realize testP. -proof. - move=> x; rewrite mem_oflist-flattenP; split=>[_|[s[/mkseqP[i[/=_->>]]/wordnP->/#]]]. - exists (wordn (size x));cut Hsx := size_ge0 x. - rewrite wordnP max_ler //= mkseqP /=;exists (size x);smt ml=0. -qed. - -(** We can now define the squeezeless sponge construction **) -module SqueezelessSponge (P:PRIMITIVE): CONSTRUCTION(P), FUNCTIONALITY = { - proc init () = {} - - proc f(p : block list): block = { - var (sa,sc) <- (b0,c0); - - if (1 <= size p /\ p <> [b0]) { - while (p <> []) { (* Absorption *) - (sa,sc) <@ P.f((sa +^ head witness p,sc)); - p <- behead p; - } - } - return sa; (* Squeezing phase (non-iterated) *) - } -}. - -module Count = { var c:int }. - -module DCount (D:DISTINGUISHER, F:DFUNCTIONALITY, P:DPRIMITIVE) = { - - module Fc = { - proc f (bs:block list) = { - var b; - Count.c <- Count.c + size bs; - b <@ F.f(bs); - return b; - } - } - - module Pc = { - proc f (x:state) = { - var y; - Count.c <- Count.c + 1; - y <@ P.f(x); - return y; - } - - proc fi(x:state) = { - var y; - Count.c <- Count.c + 1; - y <@ P.fi(x); - return y; - } - } - - proc distinguish = D(Fc,Pc).distinguish - -}. - -module DRestr (D:DISTINGUISHER, F:DFUNCTIONALITY, P:DPRIMITIVE) = { - var count:int - - module Fc = { - proc f (bs:block list) = { - var b = b0; - if (Count.c + size bs <= max_size) { - Count.c <- Count.c + size bs; - b <@ F.f(bs); - } - return b; - } - } - - module Pc = { - proc f (x:state) = { - var y; - if ( - count <- count + 1; - y <@ P.f(x); - return y; - } - - proc fi(x:state) = { - var y; - count <- count + 1; - y <@ P.fi(x); - return y; - } - } - - proc distinguish = D(Fc,Pc).distinguish - -}. - - - - -module type DPRIMITIVE = { - proc f(x : p): p - proc fi(x : p): p -}. - -module type FUNCTIONALITY = { - proc init(): unit - proc f(x : f_in): f_out -}. - -module type DFUNCTIONALITY = { - proc f(x : f_in): f_out -}. - - - (** Result (expected): The distance between Concrete and Concrete_F - is bounded by N^2/|state|, where N is the total cost (in terms - of queries to P and P^-1) of the adversary's queries **) - - (** TODO: express and prove **) - - (** And now for the interesting bits **) - (** Inform the primitive interface of queries made by the - distinguisher on its functionality interface, keep track of - primitive call paths in a coloured graph. **) - (** The following invariants should always hold at adversary - boundaries (they may be violated locally, but should always be - fixed (say, by setting bad) before returning control, and the - adversary should not be able to violate them himself): - - if paths[x] = (_,(p,v)), then following path p through m - from (0^r,0^c) leads to state (v,x); (in particular, this - implies (v,x) \in rng m; - - unless bad occurs (identify which ones), for every sc, there - is at most one sa such that (sa,sc) \in rng m; - - unless bad occurs (identify which ones), if paths[x] = - (o,(p,_)) and paths[x'] = (o',(p++p',_)), then o' <= o; - (todo: maybe change the direction of that order relation so - it corresponds to "order of appearance along paths"?) - - The next step in the proof will probably be to eagerly sample - all values of the rate and introduce some indirection on - capacities so that they are only sampled (and propagated) just - before being given to the adversary. This is easier to do if all - samplings are independent, hence the move away from a random - permutation. Some side-effects remain worrying. - **) - type caller = [ I | D ]. - - op (<=) (o1 o2 : caller) = o1 = I \/ o2 = D. - - op max (o1 o2 : caller) = - with o1 = I => o2 - with o1 = D => D. - - pred is_pre_permutation (m mi : ('a,'a) fmap) = - (forall x, mem (rng m) x => mem (dom mi) x) - /\ (forall x, mem (rng mi) x => mem (dom m) x). - - lemma half_permutation_set (m' mi' : ('a,'a) fmap) x' y': - (forall x, mem (rng m') x => mem (dom mi') x) - => (forall x, mem (rng m'.[x' <- y']) x => mem (dom mi'.[y' <- x']) x). - proof. - move=> h x0. - rewrite rng_set domP !in_fsetU in_fset1 => -[/rng_rem_le in_rng|//=]. - by rewrite h. - qed. - - lemma pre_permutation_set (m mi : ('a,'a) fmap) x y: - is_pre_permutation m mi => - is_pre_permutation m.[x <- y] mi.[y <- x]. - proof. - move=> [dom_mi dom_m]. - by split; apply/half_permutation_set. - qed. - - type handle = int. - - type hstate = block * handle. - - type ccapacity = capacity * caller. - - type smap = (state , state ) fmap. - type hsmap = (hstate, hstate ) fmap. - type handles = (handle, ccapacity) fmap. - -lemma get_oget (m:('a,'b)fmap) (x:'a) : mem (dom m) x => m.[x] = Some (oget m.[x]). -proof. by rewrite in_dom;case (m.[x]). qed. - -lemma find_set (m:('a,'b) fmap) y x (p:'a -> 'b -> bool): - (forall x, mem (dom m) x => !p x (oget m.[x])) => - find p m.[x <- y] = if p x y then Some x else None. -proof. - cut [[a []->[]] | []-> Hp Hnp]:= findP p (m.[x<-y]);1: rewrite getP dom_set !inE /#. - by case (p x y)=> //; cut := Hp x;rewrite getP dom_set !inE /= oget_some. -qed. - -require import StdOrder IntOrder. -require import Ring. - - (* Operators and properties of handles *) - op hinv (handles:handles) (c:capacity) = - find (fun _ => pred1 c \o fst) handles. - - op hinvD (handles:handles) (c:capacity) = - find (fun _ => pred1 (c,D)) handles. - - op huniq (handles:handles) = - forall h1 h2 cf1 cf2, - handles.[h1] = Some cf1 => - handles.[h2] = Some cf2 => - cf1.`1 = cf2.`1 => h1 = h2. - - lemma hinvP handles c: - if hinv handles c = None then forall h f, handles.[h] <> Some(c,f) - else exists f, handles.[oget (hinv handles c)] = Some(c,f). - proof. - cut @/pred1@/(\o)/=[[h []->[]Hmem <<-]|[]->H h f]/= := - findP (fun (_ : handle) => pred1 c \o fst) handles. - + by exists (oget handles.[h]).`2;rewrite oget_some get_oget;2:case (oget handles.[h]). - by rewrite -not_def=> Heq; cut := H h;rewrite in_dom Heq. - qed. - - lemma huniq_hinv (handles:handles) (h:handle): - huniq handles => mem (dom handles) h => hinv handles (oget handles.[h]).`1 = Some h. - proof. - move=> Huniq;pose c := (oget handles.[h]).`1. - cut:=Huniq h;cut:=hinvP handles c. - case (hinv _ _)=> /=[Hdiff _| h' +/(_ h')];1:by rewrite in_dom /#. - by move=> [f ->] /(_ (oget handles.[h]) (c,f)) H1 H2;rewrite H1 // get_oget. - qed. - - lemma hinvDP handles c: - if hinvD handles c = None then forall h, handles.[h] <> Some(c,D) - else handles.[oget (hinvD handles c)] = Some(c,D). - proof. - cut @/pred1/=[[h []->[]Hmem ]|[]->H h ]/= := - findP (fun (_ : handle) => pred1 (c,D)) handles. - + by rewrite oget_some get_oget. - by rewrite -not_def=> Heq; cut := H h;rewrite in_dom Heq. - qed. - - lemma huniq_hinvD (handles:handles) c: - huniq handles => mem (rng handles) (c,D) => handles.[oget (hinvD handles c)] = Some(c,D). - proof. - move=> Huniq;rewrite in_rng=> -[h]H;case: (hinvD _ _) (Huniq h) (hinvDP handles c)=>//=. - by move=>_/(_ h);rewrite H. - qed. - - lemma huniq_hinvD_h h (handles:handles) c: - huniq handles => handles.[h] = Some (c,D) => hinvD handles c = Some h. - proof. - move=> Huniq;case: (hinvD _ _) (hinvDP handles c)=>/= [H|h'];1: by apply H. - by rewrite oget_some=> /Huniq H/H. - qed. - - - - - - - - - - - - - - - - - - - - -op check_hpath (mh:(hstate, hstate) fmap) (handles:(handle, ccapacity) fmap) (xs:block list) (c:capacity) = - obind (fun (sah:hstate) => if c = sah.`2 then Some sah.`1 else None) - (build_hpath mh xs). - - if sah <> None then - - else None - -hpath - let step = fun (sah:hstate option ) (x:block) => - if sah = None then None - else - let sah = oget sah in - mh.[(sah.`1 +^ x, sah.`2)] in - foldl step (Some (b0,0)) xs. - - - - - - - -fun sah => mh.fun (sah:hstate) (cont=> - if mem - - -op INV2 (m mi:(state , state ) fmap) (mh mhi:(hstate, hstate) fmap) (handles:(handle, ccapacity) fmap) chandle = - dom mh = rng mhi /\ dom mhi = rng mh /\ - (forall xh, mem (dom mh `|` rng mh) xh => mem (dom handles) xh.`2) /\ - (forall h, mem (dom handles) h => h < chandle) /\ - (forall xh, mem (dom mh) xh => mem (dom m) (xh.`1, (oget handles.[xh.`2]).`1) \/ (oget handles.[xh.`2]).`2 = I) /\ - (forall xh, mem (dom mhi) xh => mem (dom mi) (xh.`1, (oget handles.[xh.`2]).`1) \/ (oget handles.[xh.`2]).`2 = I). - - -lemma hinvD_rng x (handles:(handle, ccapacity) fmap): - mem (rng handles) (x, D) => - handles.[oget (hinvD handles x)]= Some(x, D). -proof. - cut[ [a []->[]] | []->/=Hp ]/=:= findP (fun _ z => z = (x, D)) handles. - + by rewrite oget_some=> ? <- _;apply get_oget. - by rewrite in_rng=> -[a Ha];cut := Hp a; rewrite in_dom Ha oget_some. -qed. - -(* TODO: change the name *) -lemma map_perm (m mi: ('a, 'a) fmap) x y: !mem (dom mi) y => dom m = rng mi => dom m.[x<-y] = rng mi.[y<- x]. -proof. - move=> Hdom Heq;rewrite fsetP=> w;rewrite dom_set in_rng !inE;split. - + rewrite Heq in_rng. case (w=x)=> -[->|Hneq/=[a Ha]];1:by exists y;rewrite getP. - exists a;rewrite getP;case (a=y)=>[->>|//]. - by move:Hdom;rewrite in_dom Ha. - rewrite Heq in_rng;by move=>[a];rewrite getP;case(a=y)=>[->>/# |_ <-];left;exists a. -qed. - -local hoare test_f : G2.S.f : INV2 G2.m G2.mi G2.mh G2.mhi G2.handles G2.chandle (*/\ INV2 G2.mi G2.mhi G2.handles*) ==> - INV2 G2.m G2.mi G2.mh G2.mhi G2.handles G2.chandle. -proof. - proc;if;last by auto. - auto;conseq (_ :_ ==> true)=> //. - move=> &hr [][]Hmhmhi[]Hmhimh[]Hdomh[]Hhbound[]Hmhor Hmhior Hnmem y _;split;beta iota. - + move=> Hnrng handles chandle hx2 @/handles. - cut ->>{hx2} : hx2 = G2.chandle{hr}. - + rewrite /hx2 /handles /hinvD find_set /pred1 //=. - move=> x2 Hx2;cut := Hnrng;rewrite in_rng NewLogic.negb_exists /= => /(_ x2). - by rewrite get_oget. - split=> /= [[Hmem _] | Hmem]. - + by cut /Hhbound // := Hdomh (x{hr}.`1, G2.chandle{hr}) _; rewrite inE;left. - do !apply andI. - + apply map_perm=> //;rewrite -not_def=> H. - by cut /#:= Hhbound chandle _;apply (Hdomh (y.`1,chandle));rewrite !inE -Hmhimh H. - + apply map_perm=> //;rewrite -not_def=> H. - by cut /#:= Hhbound G2.chandle{hr} _;apply (Hdomh (x{hr}.`1,G2.chandle{hr}));rewrite !inE H. - + move=>[x1 h];cut := Hdomh (x1,h). - rewrite !(dom_set, rng_set, inE) /==>H1 [[H2|[_->]]|[/rng_rem_le H2|[_->]]]//; - by rewrite H1 ?H2. - + by move=> h;cut := Hhbound h;rewrite !dom_set !inE /= => H [[/H|]|->>]/#. - + move=>[x1 h];rewrite !getP !dom_set !inE /==> -[|[]->> ->>];rewrite /chandles /=. - + move=>Hh. cut /Hhbound/=:= Hdomh (x1,h) _;1:by rewrite !inE Hh. - move=> ^Hlt /IntOrder.gtr_eqF; rewrite eq_sym=>->. - by cut ->/#: h <> G2.chandle{hr} + 1 by smt ml=0. - cut ->/=: G2.chandle{hr} <> G2.chandle{hr} + 1 by smt ml=0. - by rewrite oget_some /#. - move=>[x1 h];rewrite !getP !dom_set !inE /==> -[|[]->> ->>];rewrite /chandles /=. - + move=>Hh; cut /Hhbound/=:= Hdomh (x1,h) _;1:by rewrite !inE -Hmhimh Hh. - move=> ^Hlt /IntOrder.gtr_eqF; rewrite eq_sym=>->. - by cut ->/#: h <> G2.chandle{hr} + 1 by smt ml=0. - by rewrite oget_some /#. - move=> /= Hrng;cut Hget:= hinvD_rng _ _ Hrng;split=> /=. - + move=> []/Hmhor /= [] ; rewrite Hget oget_some /#. - move=> Hnot;do !apply andI. - + apply map_perm=> //;rewrite -not_def=> H. - by cut /#:= Hhbound G2.chandle{hr} _;apply (Hdomh (y.`1,G2.chandle{hr})); - rewrite !inE -Hmhimh H. - + apply map_perm=> //;rewrite -not_def=> H. - by cut := Hmhor _ H;move: Hnmem;rewrite Hget oget_some /=;case (x{hr}). - + move=> [x1 h];rewrite !(dom_set,rng_set, inE) => -[[H|[_ ->]]| [/rng_rem_le H|[_->]]]//=. - + by left;apply (Hdomh (x1,h));rewrite inE H. - + by left;rewrite in_dom Hget. - by left;apply (Hdomh (x1,h));rewrite inE H. - + by move=>h;rewrite dom_set !inE=> -[/Hhbound|->]/#. - + move=> [x1 h];rewrite !(dom_set, getP, inE) /==> -[H|[->> ->>]]. - + by cut /IntOrder.ltr_eqF->/#:= Hhbound h _;1:by apply (Hdomh (x1,h));rewrite inE H. - cut ->/=:oget (hinvD G2.handles{hr} x{hr}.`2) <> G2.chandle{hr}. - + by cut /#:= Hhbound (oget (hinvD G2.handles{hr} x{hr}.`2)) _;1:by rewrite in_dom Hget. - by rewrite Hget oget_some /=;right;case (x{hr}). - move=> [x1 h];rewrite !(dom_set, getP, inE) /==> -[H|[->> ->> /=]]. - + by cut /IntOrder.ltr_eqF->/#:= Hhbound h _;1: apply (Hdomh (x1,h));rewrite inE -Hmhimh H. - by rewrite oget_some /=;right;case y. -qed. - -local hoare test_fi : G2.S.fi : INV2 G2.m G2.mi G2.mh G2.mhi G2.handles G2.chandle ==> - INV2 G2.m G2.mi G2.mh G2.mhi G2.handles G2.chandle. -proof. - proc;if;last by auto. - auto. move=> &hr [][]Hmhmhi[]Hmhimh[]Hdomh[]Hhbound[]Hmhor Hmhior Hnmem;split;beta iota. - + move=> Hnrng handles chandle hx2 @/handles y Hy. - cut ->>{hx2} : hx2 = G2.chandle{hr}. - + rewrite /hx2 /handles /hinvD find_set /pred1 //=. - move=> x2 Hx2;cut := Hnrng;rewrite in_rng NewLogic.negb_exists /= => /(_ x2). - by rewrite get_oget. - split=> /= [[Hmem _] | Hmem]. - + by cut /Hhbound // := Hdomh (x{hr}.`1, G2.chandle{hr}) _;rewrite inE -Hmhimh;right. - do !apply andI. - + apply map_perm=> //;rewrite -not_def=> H. - by cut /#:= Hhbound G2.chandle{hr} _;apply (Hdomh (x{hr}.`1,G2.chandle{hr})); - rewrite !inE -Hmhimh H. - + apply map_perm=> //;rewrite -not_def=> H. - by cut /#:= Hhbound chandle _;apply (Hdomh (y.`1,chandle));rewrite !inE -Hmhimh H. - + move=>[x1 h];cut := Hdomh (x1,h). - rewrite !(dom_set, rng_set, inE) /==>H1 [[H2|[_->]]|[/rng_rem_le H2|[_->]]]//; - by rewrite H1 ?H2. - + by move=> h;cut := Hhbound h;rewrite !dom_set !inE /= => H [[/H|]|->>]/#. - + move=>[x1 h];rewrite !getP !dom_set !inE /==> -[|[]->> ->>];rewrite /chandles /=. - + move=>Hh; cut /Hhbound/=:= Hdomh (x1,h) _;1:by rewrite !inE -Hmhimh Hh. - move=> ^Hlt /IntOrder.gtr_eqF; rewrite eq_sym=>->. - by cut ->/#: h <> G2.chandle{hr} + 1 by smt ml=0. - by rewrite oget_some /#. - move=>[x1 h];rewrite !getP !dom_set !inE /==> -[|[]->> ->>];rewrite /chandles /=. - + move=>Hh;cut /Hhbound/=:= Hdomh (x1,h) _;1:by rewrite !inE -Hmhimh Hh. - move=> ^Hlt /IntOrder.gtr_eqF; rewrite eq_sym=>->. - by cut ->/#: h <> G2.chandle{hr} + 1 by smt ml=0. - cut ->/=: G2.chandle{hr} <> G2.chandle{hr} + 1 by smt ml=0. - by rewrite oget_some /#. - move=> /= Hrng y Hy;cut Hget:= hinvD_rng _ _ Hrng;split=> /=. - + move=> []/Hmhior /= [] ; rewrite Hget oget_some /#. - move=> Hnot;do !apply andI. - + apply map_perm=> //;rewrite -not_def=> H. - by cut := Hmhior _ H;move: Hnmem;rewrite Hget oget_some /=;case (x{hr}). - + apply map_perm=> //;rewrite -not_def=> H. - by cut /#:= Hhbound G2.chandle{hr} _;apply (Hdomh (y.`1,G2.chandle{hr})); - rewrite !inE -Hmhimh H. - + move=> [x1 h];rewrite !(dom_set,rng_set, inE) => -[[H|[_ ->]]| [/rng_rem_le H|[_->]]]//=. - + by left;apply (Hdomh (x1,h));rewrite inE H. - + by left;apply (Hdomh (x1,h));rewrite inE H. - by left;rewrite in_dom Hget. - + by move=>h;rewrite dom_set !inE=> -[/Hhbound|->]/#. - + move=> [x1 h];rewrite !(dom_set, getP, inE) /==> -[H|[->> ->> /=]]. - + by cut /IntOrder.ltr_eqF->/#:= Hhbound h _;1: apply (Hdomh (x1,h));rewrite inE -Hmhimh H. - by rewrite oget_some /==>{Hy};right;case y. - move=> [x1 h];rewrite !(dom_set, getP, inE) /==> -[H|[->> ->>]]. - + by cut /IntOrder.ltr_eqF->/#:= Hhbound h _;1:apply (Hdomh (x1,h));rewrite inE -Hmhimh H. - cut ->/=:oget (hinvD G2.handles{hr} x{hr}.`2) <> G2.chandle{hr}. - + by cut /#:= Hhbound (oget (hinvD G2.handles{hr} x{hr}.`2)) _;1:by rewrite in_dom Hget. - by rewrite Hget oget_some /=;right;case (x{hr}). -qed. - -local hoare test_C : G2.C.f : INV2 G2.m G2.mi G2.mh G2.mhi G2.handles G2.chandle ==> - INV2 G2.m G2.mi G2.mh G2.mhi G2.handles G2.chandle. - - -local module Game3 = { - var m, mi : (state , state ) fmap - var mh, mhi : (hstate, hstate) fmap - var handles : (handle, ccapacity) fmap - var chandle : int - var paths : (capacity, block list * block) fmap - var bext : bool - - - module C = { - proc init(): unit = { } - - proc f(p : block list): block = { - var h, i <- 0; - var (sa,sc) <- (b0,c0); - var sa'; - - if (1 <= size p /\ p <> [b0]) { - while (i < size p - 1 /\ mem (dom m) (sa +^ nth witness p i, sc)) { - (sa, sc) <- oget m.[(sa +^ nth witness p i, sc)]; - (sa', h) <- oget mh.[(sa +^ nth witness p i, h)]; - i <- i + 1; - } - while (i < size p) { - sc <$ cdistr; - sa' <- RO.f(take i p); - mh.[(sa,h)] <- (sa', chandle); - mhi.[(sa',chandle)] <- (sa,h); - (sa,h) <- (sa',chandle); - handles.[chandle] <- (sc,I); - chandle <- chandle + 1; - i <- i + 1; - } - sa <- RO.f(p); - } - return sa; - } - } - - module S = { - (** Inner interface **) - proc f(x : state): state = { - var p, v, y, y1, y2, hy2, hx2; - - if (!mem (dom m) x) { - if (mem (dom paths) x.`2) { - (p,v) <- oget paths.[x.`2]; - y1 <- RO.f (rcons p (v +^ x.`1)); - y2 <$ cdistr; - y <- (y1, y2); - paths.[y2] <- (rcons p (v +^ x.`1), y.`1); - } else { - y <$ dstate; - } - bext <- bext \/ mem (rng handles) (x.`2, I); - (* exists x2 h, handles.[h] = Some (X2,I) *) - if (!(mem (rng handles) (x.`2, D))) { - handles.[chandle] <- (x.`2, D); - chandle <- chandle + 1; - } - hx2 <- oget (hinvD handles x.`2); - if (mem (dom mh) (x.`1, hx2)) { - hy2 <- (oget mh.[(x.`1, hx2)]).`2; - handles.[hy2] <- (y.`2, D); - (* bad <- bad \/ mem X2 y.`2; *) - m.[x] <- y; - mh.[(x.`1, hx2)] <- (y.`1, hy2); - mi.[y] <- x; - mhi.[(y.`1, hy2)] <- (x.`1, hx2); - } else { - hy2 <- chandle; - chandle <- chandle + 1; - handles.[hy2] <- (y.`2, D); - m.[x] <- y; - mh.[(x.`1, hx2)] <- (y.`1, hy2); - mi.[y] <- x; - mhi.[(y.`1, hy2)] <- (x.`1, hx2); - } - } else { - y <- oget m.[x]; - } - return y; - } - - proc fi(x : state): state = { - var y, y1, y2, hx2, hy2; - - if (!mem (dom mi) x) { - bext <- bext \/ mem (rng handles) (x.`2, I); - (* exists x2 h, handles.[h] = Some (X2,I) *) - if (!(mem (rng handles) (x.`2, D))) { - handles.[chandle] <- (x.`2, D); - chandle <- chandle + 1; - } - hx2 <- oget (hinvD handles x.`2); - if (mem (dom mhi) (x.`1, hx2)) { - (y1,hy2) <- oget mhi.[(x.`1, hx2)]; - y2 <$ cdistr; - y <- (y1,y2); - handles.[hy2] <- (y.`2, D); - (* bad <- bad \/ mem X2 y.`2; *) - mi.[x] <- y; - mhi.[(x.`1, hx2)] <- (y.`1, hy2); - m.[y] <- x; - mh.[(y.`1, hy2)] <- (x.`1, hx2); - } else { - y <$ dstate; - hy2 <- chandle; - chandle <- chandle + 1; - handles.[hy2] <- (y.`2, D); - mi.[x] <- y; - mhi.[(x.`1, hx2)] <- (y.`1, hy2); - m.[y] <- x; - mh.[(y.`1, hy2)] <- (x.`1, hx2); - } - } else { - y <- oget mi.[x]; - } - return y; - } - - (** Distinguisher interface **) - proc init() = { } - - } - - - - proc main(): bool = { - var b; - - m <- map0; - mi <- map0; - bext <- false; - - (* the empty path is initially known by the adversary to lead to capacity 0^c *) - handles <- map0.[0 <- (c0, D)]; - paths <- map0.[c0 <- ([<:block>],b0)]; - chandle <- 1; - b <@ D(C,S).distinguish(); - return b; - } - }. - - - - - local module Game1 = { - var m, mi : (hstate,hstate) fmap - var paths : (handle,(block list * block) list) fmap - var handles : (handle, ccapacity) fmap - var bext, bred, bcoll : bool - var chandle : int - - module S = { - (** Inner interface **) - proc fg(o : caller, x : state): state = { - var o', p, v, y, y1, y2, ox2, hx2, y1h; - - ox2 <- hinv handles x.`2; - hx2 <- oget ox2; - bext <- bext \/ - (o = D /\ ox2 <> None /\ paths.[hx2] <> None /\ - find_path m D paths hx2 = None); - - - if (ox2 = None) { - handles.[chandle] <- (x.`2,o); - hx2 <- chandle; - chandle <- chandle + 1; - } - - if (!mem (dom m) (x.`1, hx2) || (oget handles.[hx2]).`2 = I /\ o = D) { - if (mem (dom paths) hx2 /\ find_path m o paths hx2 <> None) { - (p,v) <- oget (find_path m o paths hx2); - y1 <- RO.f (rcons p (v +^ x.`1)); - y2 <$ cdistr; - y <- (y1, y2); - if (hinv handles y.`2 = None) - paths.[chandle (*y2*)] <- extend_paths x.`1 y.`1 (oget paths.[hx2]); - } else { - y <$ dstate; - } - if (hinv handles y.`2 = None) { - y1h <- (y.`1, chandle); - handles.[chandle] <- (y.`2, o); - m.[(x.`1, hx2)] <- y1h; - mi.[y1h] <- (x.`1, hx2); - handles.[hx2] <- (x.`2, max o (oget handles.[hx2]).`2); (* Warning: not sure we want it *) - chandle <- chandle + 1; - } else { - bcoll <- true; - } - } else { (* mem (dom m) (x.`1, hx2) /\ (!dom m with I \/ o <> D) *) - y1h <- oget m.[(x.`1,hx2)]; - (y2,o') <- oget handles.[y1h.`2]; - handles.[y1h.`2] <- (y2, max o o'); - handles.[hx2] <- (x.`2, max o (oget handles.[hx2]).`2); - y <- (y1h.`1, y2); - } - return y; - } - - proc f(x:state):state = { - var r; - r <@ fg(D,x); - return r; - } - - proc fi(x : state): state = { - var o', y, y2, ox2, hx2, y1h; - - ox2 <- hinv handles x.`2; - hx2 <- oget ox2; - - if (ox2 = None) { - handles.[chandle] <- (x.`2,D); - hx2 <- chandle; - chandle <- chandle + 1; - } - - if (!mem (dom mi) (x.`1,hx2) || (oget handles.[hx2]).`2 = I) { - y <$ dstate; - if ( hinv handles y.`2 = None) { - y1h <- (y.`1, chandle); - handles.[chandle] <- (y.`2, D); - mi.[(x.`1, hx2)] <- y1h; - m.[y1h] <- (x.`1, hx2); - handles.[hx2] <- ((oget handles.[hx2]).`1, D); - chandle <- chandle + 1; - } else { - bcoll <- true; - } - - } else { - y1h <- oget mi.[(x.`1,hx2)]; - (y2,o') <- oget handles.[y1h.`2]; - bred <- bred \/ o' = I; - handles.[y1h.`2] <- (y2, D); - handles.[hx2] <- (x.`2, D); - y <- (y1h.`1, y2); - - } - return y; - } - - (** Distinguisher interface **) - proc init() = { } - - } - - module C = { - proc init(): unit = { } - - proc f(p : block list): block = { - var (sa,sc) <- (b0,c0); - - if (1 <= size p /\ p <> [b0]) { - while (p <> []) { - (sa,sc) <@ S.fg(I,(sa ^ head witness p,sc)); - p <- behead p; - } - } - return sa; - } - } - - proc main(): bool = { - var b; - - m <- map0; - mi <- map0; - bext <- false; - bred <- false; - bcoll <- false; - bsuff <- false; - bmitm <- false; - (* the empty path is initially known by the adversary to lead to capacity 0^c *) - handles <- map0.[0 <- (c0, D)]; - paths <- map0.[0 <- ([<:block>],b0,D)]; - chandle <- 1; - b <@ D(C,S).distinguish(); - return b; - } - }. - - - - - -module M = { - proc f () : unit = { - var x; - var l:int list; - l = []; - } -}. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - (** Result: the instrumented system and the concrete system are - perfectly equivalent **) - local equiv Game0_P_S_eq: - Concrete_F.P.f ~ Game0.S.fg: - arg{1} = arg{2}.`2 - /\ ={m,mi}(Concrete_F,Game0) - /\ is_pre_permutation (Concrete_F.m){1} (Concrete_F.mi){1} - ==> ={res} - /\ ={m,mi}(Concrete_F,Game0) - /\ is_pre_permutation (Concrete_F.m){1} (Concrete_F.mi){1}. - proof. - proc. inline *. - sp; if=> //=; 2:by auto. - auto; progress [-split]. - by rewrite pre_permutation_set. - qed. - - local equiv Game0_Pi_Si_eq: - Concrete_F.P.fi ~ Game0.S.fi: - ={arg} - /\ ={m,mi}(Concrete_F,Game0) - /\ is_pre_permutation (Concrete_F.m){1} (Concrete_F.mi){1} - ==> ={res} - /\ ={m,mi}(Concrete_F,Game0) - /\ is_pre_permutation (Concrete_F.m){1} (Concrete_F.mi){1}. - proof. - proc. inline *. - sp; if=> //=; 2:by auto. - auto; progress [-split]. - by rewrite pre_permutation_set. - qed. - - local lemma Game0_pr &m: - `|Pr[Concrete_F.main() @ &m: res] - - Pr[Ideal.main() @ &m: res]| - = `|Pr[Game0.main() @ &m: res] - - Pr[Ideal.main() @ &m: res]|. - proof. - do !congr. - byequiv=> //=. - proc. - call (_: ={m,mi}(Concrete_F,Game0) - /\ is_pre_permutation Concrete_F.m{1} Concrete_F.mi{1}). - + by proc *;inline Game0.S.f;wp;call Game0_P_S_eq;auto. - + by proc *;call Game0_Pi_Si_eq. - + proc. sp; if=> //=. - while ( ={sa,sc,p} - /\ ={m,mi}(Concrete_F,Game0) - /\ is_pre_permutation Concrete_F.m{1} Concrete_F.mi{1}). - wp; call Game0_P_S_eq. - by auto. - by auto. - by auto; smt. - qed. - - (** Split the simulator map into distinct rate and capacity maps **) - pred map_split (m0 : (state,state) fmap) (a1 : (state,block) fmap) (c1 : (state,capacity) fmap) = - (forall x, mem (dom m0) x = mem (dom a1) x) - /\ (forall x, mem (dom m0) x = mem (dom c1) x) - /\ (forall x, mem (dom m0) x => m0.[x] = Some (oget a1.[x],oget c1.[x])). - - lemma map_split_set m0 a1 c1 s a c: - map_split m0 a1 c1 => - map_split m0.[s <- (a,c)] a1.[s <- a] c1.[s <- c] - by []. - - local module Game1 = { - var mcol,micol : (state,caller) fmap - var rate, ratei : (state,block) fmap - var cap, capi : (state,capacity) fmap - var pathscol : (capacity,caller) fmap - var paths : (capacity,block list * block) fmap - var bext, bred : bool - var bcoll, bsuff, bmitm : bool - - module S = { - (** Inner interface **) - proc fg(o : caller, x : state): state = { - var o', ya, yc, pv, p, v; - - o' <- odflt D pathscol.[x.`2]; - bext <- bext \/ (o' <= o); - - if (!mem (dom rate) x) { - (ya,yc) <$ dstate; - if (mem (dom paths) x.`2) { - o' <- oget pathscol.[x.`2]; - pv <- oget paths.[x.`2]; - (p,v) <- pv; - bcoll <- bcoll \/ (mem (dom paths) yc); - bsuff <- bsuff \/ (mem (rng cap) yc); - pathscol.[yc] <- max o o'; - paths.[yc] <- (rcons p (v ^ x.`1),ya); - } - rate.[x] <- ya; - ratei.[(ya,yc)] <- x.`1; - cap.[x] <- yc; - capi.[(ya,yc)] <- x.`2; - mcol.[x] <- o; - micol.[(ya,yc)] <- o; - } else { - o' <- oget mcol.[x]; - mcol.[x] <- max o o'; - ya <- oget rate.[x]; - yc <- oget cap.[x]; - o' <- oget micol.[(ya,yc)]; - micol.[(ya,yc)] <- max o o'; - } - return (oget rate.[x],oget cap.[x]); - } - - proc f(x:state):state = { - var r; - r <@ fg(D,x); - return r; - } - - proc fi(x : state): state = { - var ya, yc; - - if (!mem (dom ratei) x) { - (ya,yc) <$ dstate; - micol.[x] <- D; - ratei.[x] <- ya; - capi.[x] <- yc; - mcol.[(ya,yc)] <- D; - rate.[(ya,yc)] <- x.`1; - cap.[(ya,yc)] <- x.`2; - bmitm <- bmitm \/ (mem (dom paths) yc); - } else { - bred <- bred \/ oget micol.[x] = I; - micol.[x] <- D; - ya <- oget ratei.[x]; - yc <- oget capi.[x]; - mcol.[(ya,yc)] <- D; - } - return (oget ratei.[x],oget capi.[x]); - } - - (** Distinguisher interface **) - proc init() = { } - - } - - module C = { - proc init(): unit = { } - - proc f(p : block list): block = { - var (sa,sc) <- (b0,c0); - - if (1<= size p /\ p <> [b0]) { - while (p <> []) { - (sa,sc) <@ S.fg(I,(sa ^ head witness p,sc)); - p <- behead p; - } - } - return sa; - } - } - - proc main(): bool = { - var b; - - mcol <- map0; - micol <- map0; - rate <- map0; - ratei <- map0; - cap <- map0; - capi <- map0; - bext <- false; - bred <- false; - bcoll <- false; - bsuff <- false; - bmitm <- false; - (* the empty path is initially known by the adversary to lead to capacity 0^c *) - pathscol <- map0.[c0 <- D]; - paths <- map0.[c0 <- ([<:block>],b0)]; - b <@ D(C,S).distinguish(); - return b; - } - }. - - local equiv Game1_S_S_eq: - Game0.S.fg ~ Game1.S.fg: - ={arg} - /\ ={pathscol,paths}(Game0,Game1) - /\ map_split Game0.m{1} Game1.rate{2} Game1.cap{2} - /\ map_split Game0.mi{1} Game1.ratei{2} Game1.capi{2} - /\ is_pre_permutation (Game0.m){1} (Game0.mi){1} - ==> ={res} - /\ ={pathscol,paths}(Game0,Game1) - /\ map_split Game0.m{1} Game1.rate{2} Game1.cap{2} - /\ map_split Game0.mi{1} Game1.ratei{2} Game1.capi{2} - /\ is_pre_permutation (Game0.m){1} (Game0.mi){1}. - proof. - proc. inline *. - sp; if; 1:by progress [-split]; move: H=> [->]. - + auto; progress [-split]. - move: H3; case yL=> ya yc H3; case (x{2})=> xa xc. - by rewrite !getP_eq !map_split_set ?pre_permutation_set. - + auto; progress [-split]. - rewrite H H0 H1 /=. - by move: H=> [_ [_ ->]]. - qed. - - local equiv Game1_Si_Si_eq: - Game0.S.fi ~ Game1.S.fi: - ={arg} - /\ ={pathscol,paths}(Game0,Game1) - /\ map_split Game0.m{1} Game1.rate{2} Game1.cap{2} - /\ map_split Game0.mi{1} Game1.ratei{2} Game1.capi{2} - /\ is_pre_permutation (Game0.m){1} (Game0.mi){1} - ==> ={res} - /\ ={pathscol,paths}(Game0,Game1) - /\ map_split Game0.m{1} Game1.rate{2} Game1.cap{2} - /\ map_split Game0.mi{1} Game1.ratei{2} Game1.capi{2} - /\ is_pre_permutation (Game0.m){1} (Game0.mi){1}. - proof. - proc. inline *. - sp; if; 1:by progress [-split]; move: H0=> [->]. - + auto; progress [-split]. - move: H3; case yL=> ya yc H3; case (x{2})=> xa xc. - by rewrite !getP_eq !map_split_set ?pre_permutation_set. - + auto; progress [-split]. - rewrite H H0 H1 /=. - by move: H0=> [_ [_ ->]]. - qed. - - local lemma Game1_pr &m: - `|Pr[Game0.main() @ &m: res] - - Pr[Ideal.main() @ &m: res]| - = `|Pr[Game1.main() @ &m: res] - - Pr[Ideal.main() @ &m: res]|. - proof. - do !congr. byequiv=> //=; proc. - call (_: ={pathscol,paths}(Game0,Game1) - /\ map_split Game0.m{1} Game1.rate{2} Game1.cap{2} - /\ map_split Game0.mi{1} Game1.ratei{2} Game1.capi{2} - /\ is_pre_permutation Game0.m{1} Game0.mi{1}). - + by proc;call Game1_S_S_eq. - + by apply Game1_Si_Si_eq. - + proc; sp; if=> //=. - while ( ={sa,sc,p} - /\ ={pathscol,paths}(Game0,Game1) - /\ map_split Game0.m{1} Game1.rate{2} Game1.cap{2} - /\ map_split Game0.mi{1} Game1.ratei{2} Game1.capi{2} - /\ is_pre_permutation Game0.m{1} Game0.mi{1})=> //. - by wp; call Game1_S_S_eq. - by auto; smt. - qed. - -(*un jeu avec indirection. -jeu avec indirection -> simulateur. *) - type handle = int. - type hstate = block * handle. - - - local module Game2 = { - - var mcol,micol : (hstate,caller) fmap - var rate, ratei : (hstate,block) fmap - var cap, capi : (hstate,handle) fmap - var handles : (handle,capacity) fmap - var pathscol : (handle,caller) fmap - var paths : (handle,block list * block) fmap - var bext, bred : bool - var bcoll, bsuff, bmitm : bool - - module S = { - (** Inner interface **) - proc fg(o : caller, x : state): state = { - var o', ya, yc, pv, p, v, x2; - - (* Fait chier ici *) -(* o' <- odflt D pathscol.[x.`2]; - bext <- bext \/ (o' <= o); *) - - if (!mem (dom rate) x) { - x2 <- hinv handles x.`2; - (ya,yc) <$ dstate; - if (mem (dom paths) x.`2) { - o' <- oget pathscol.[x.`2]; - pv <- oget paths.[x.`2]; - (p,v) <- pv; - bcoll <- bcoll \/ (mem (dom paths) yc); - bsuff <- bsuff \/ (mem (rng cap) yc); - pathscol.[yc] <- max o o'; - paths.[yc] <- (rcons p (v ^ x.`1),ya); - } - rate.[x] <- ya; - ratei.[(ya,yc)] <- x.`1; - cap.[x] <- yc; - capi.[(ya,yc)] <- x.`2; - mcol.[x] <- o; - micol.[(ya,yc)] <- o; - } else { - o' <- oget mcol.[x]; - mcol.[x] <- max o o'; - ya <- oget rate.[x]; - yc <- oget cap.[x]; - o' <- oget micol.[(ya,yc)]; - micol.[(ya,yc)] <- max o o'; - } - return (oget rate.[x],oget cap.[x]); - } - - proc f(x:state):state = { - var r; - r <@ fg(D,x); - return r; - } - - proc fi(x : state): state = { - var ya, yc; - - if (!mem (dom ratei) x) { - (ya,yc) <$ dstate; - micol.[x] <- D; - ratei.[x] <- ya; - capi.[x] <- yc; - mcol.[(ya,yc)] <- D; - rate.[(ya,yc)] <- x.`1; - cap.[(ya,yc)] <- x.`2; - bmitm <- bmitm \/ (mem (dom paths) yc); - } else { - bred <- bred \/ oget micol.[x] = I; - micol.[x] <- D; - ya <- oget ratei.[x]; - yc <- oget capi.[x]; - mcol.[(ya,yc)] <- D; - } - return (oget ratei.[x],oget capi.[x]); - } - - (** Distinguisher interface **) - proc init() = { } - - } - - module C = { - proc init(): unit = { } - - proc f(p : block list): block = { - var (sa,sc) <- (b0,c0); - - if (1<= size p /\ p <> [b0]) { - while (p <> []) { - (sa,sc) <@ S.fg(I,(sa ^ head witness p,sc)); - p <- behead p; - } - } - return sa; - } - } - - proc main(): bool = { - var b; - - mcol <- map0; - micol <- map0; - rate <- map0; - ratei <- map0; - cap <- map0; - capi <- map0; - bext <- false; - bred <- false; - bcoll <- false; - bsuff <- false; - bmitm <- false; - (* the empty path is initially known by the adversary to lead to capacity 0^c *) - pathscol <- map0.[c0 <- D]; - paths <- map0.[c0 <- ([<:block>],b0)]; - b <@ D(C,S).distinguish(); - return b; - } - }. - -end section. - -(* That Self is unfortunate *) -lemma PermutationLemma: - exists epsilon, - forall (D <: Self.DISTINGUISHER) &m, - `|Pr[RealIndif(SqueezelessSponge,P,D).main() @ &m: res] - - Pr[IdealIndif(H,S,D).main() @ &m: res]| - < epsilon. -proof. admit. qed. From 5338a1de92bd1fa3bf05fae0e3ce546207d59f02 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Fri, 22 Jan 2016 17:51:10 +0100 Subject: [PATCH 126/525] Progress on Top Level. --- proof/TopLevel.ec | 123 ++++++++++++++++++++++++++++++++++------------ 1 file changed, 91 insertions(+), 32 deletions(-) diff --git a/proof/TopLevel.ec b/proof/TopLevel.ec index 9276ec5..7d66bf3 100644 --- a/proof/TopLevel.ec +++ b/proof/TopLevel.ec @@ -1,7 +1,7 @@ (*------------------------- Sponge Construction ------------------------*) -require import Pair Int IntDiv Real List Option FSet NewFMap DBool. -require import Fun Common. +require import Fun Pair Int IntDiv Real List Option FSet NewFMap DBool. +require import Common StdOrder. import IntOrder. require (*--*) IRO Block. (*------------------------- Indifferentiability ------------------------*) @@ -186,7 +186,7 @@ local module RaiseBIROBLazy (F : BLOCK_IRO_BITS) : FUNCTIONALITY = { var cs; cs <@ F.g(pad2blocks bs, n); - return take n cs; + return cs; } }. @@ -214,36 +214,58 @@ case (valid_block xs{1}). rcondt{1} 3; first auto. rcondt{2} 4; first auto. inline *. rcondt{1} 7; first auto. seq 6 3 : - (={n, n0} /\ xs{1} = xs0{2} /\ n0{1} = n{1} * r /\ + (={i, n0} /\ bs{1} = bs0{2} /\ LazyInvar IRO.mp{1} BlockIROBitsLazy.mp{2} /\ - valid_block xs{1} /\ pad2blocks x{1} = xs0{2}). + pad2blocks x{1} = xs0{2}). auto; progress; have {2}<- /# := unpadBlocksK xs0{2}. -admit. +wp. +while + (={i, n0} /\ bs{1} = bs0{2} /\ + LazyInvar IRO.mp{1} BlockIROBitsLazy.mp{2} /\ + pad2blocks x{1} = xs0{2}). +sp; auto. +if. +progress; smt ml=0. +rnd; auto; progress; smt. (* will get rid of smt's *) +auto; progress; smt. +auto. rcondf{1} 3; first auto. rcondf{2} 4; first auto. auto; progress; by rewrite bits2blocks_nil. qed. -(* TODO: - - IRO.f ~ RaiseBIROBLazy(BlockIROBitsLazy).f *) - -(* TODO: -BlockIROBitsEager.f ~ Block.BIRO.IRO.f - -BlockIROBitsEager.fi ~ Block.BIRO.IRO.fi - -RaiseFun(BlockIROBitsEager).f ~ RaiseFun(Block.BIRO.IRO).f -*) +local lemma IRO_RaiseBIROBLazy_BlockIROBitsLazy_f : + equiv[IRO.f ~ RaiseBIROBLazy(BlockIROBitsLazy).f : + ={n} /\ x{1} = bs{2} /\ + LazyInvar IRO.mp{1} BlockIROBitsLazy.mp{2} ==> + ={res} /\ LazyInvar IRO.mp{1} BlockIROBitsLazy.mp{2}]. +proof. +proc=> /=; inline *. +rcondt{1} 3; first auto. +rcondt{2} 5; first auto; progress; apply valid_pad2blocks. +seq 2 4 : + (={i, n} /\ n{1} = n0{2} /\ xs{2} = pad2blocks x{1} /\ bs{1} = bs0{2} /\ + LazyInvar IRO.mp{1} BlockIROBitsLazy.mp{2}); first auto. +wp. +while + (={i, n} /\ n{1} = n0{2} /\ xs{2} = pad2blocks x{1} /\ bs{1} = bs0{2} /\ + LazyInvar IRO.mp{1} BlockIROBitsLazy.mp{2}). +wp; sp. +if. +progress; smt. (* will get rid of smt's *) +rnd; skip; progress; smt. +auto; progress; smt. +auto. +qed. local lemma BlockIROBitsEager (D <: BLOCK_IRO_BITS_DIST) : equiv[D(BlockIROBitsEager).distinguish ~ D(BlockIROBitsLazy).distinguish : ={glob D} /\ BlockIROBitsEager.mp{1} = BlockIROBitsLazy.mp{2} ==> ={glob D}]. proof. -admit. +admit. (* use RndO.ec result *) qed. -pred BlockIROBits_Eager_Invar +pred EagerInvar (mp1 : (block list * int, block) fmap, mp2 : (block list * int, bool) fmap) = (forall (xs : block list, i : int), @@ -256,6 +278,39 @@ pred BlockIROBits_Eager_Invar mem (dom mp2) (xs, j) => 0 <= j /\ mem (dom mp1) (xs, j %/ r)). +local lemma BlockIROBitsEager_BlockIRO_f : + equiv[BlockIROBitsEager.f ~ Block.BIRO.IRO.f : + xs{1} = x{2} /\ ={n} /\ + EagerInvar Block.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1} ==> + ={res} /\ EagerInvar Block.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1}]. +proof. +proc=> /=. +inline BlockIROBitsEager.g. +seq 5 2 : + (xs0{1} = x{2} /\ bs0{1} = [] /\ bs{2} = [] /\ n0{1} = n{2} * r /\ + n0{1} = m{1} /\ + EagerInvar Block.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1}). +auto; progress. +rewrite -addzA divzMDl 1:gtr_eqF 1:gt0_r //. +have -> // : (r - 1) %/ r = 0 by smt. (* TODO *) +if=> //. +(* +second while loop in {1} is redundant +what's left is to deal with sampling... *) +admit. +auto; progress; by rewrite bits2blocks_nil. +qed. + +local lemma RaiseFun_BlockIROBitsEager_BlockIRO_f : + equiv[RaiseFun(BlockIROBitsEager).f ~ RaiseFun(Block.BIRO.IRO).f : + ={bs, n} /\ + EagerInvar Block.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1} ==> + ={res} /\ + EagerInvar Block.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1}]. +proof. +proc=> /=; by call BlockIROBitsEager_BlockIRO_f. +qed. + local lemma Sponge_Raise_Block_Sponge_f : equiv[Sponge(Perm).f ~ RaiseFun(Block.Sponge(Perm)).f : ={bs, n, glob Perm} ==> ={res, glob Perm}]. @@ -311,12 +366,14 @@ call ={glob Dist, glob BlockSim} /\ IRO.mp{1} = map0 /\ BlockIROBitsLazy.mp{2} = map0 ==> ={res}). -proc (={glob BlockSim}). -smt. -smt. -admit. -admit. -admit. +proc (={glob BlockSim} /\ LazyInvar IRO.mp{1} BlockIROBitsLazy.mp{2}). +smt. (* will remove this *) +trivial. +proc (LazyInvar IRO.mp{1} BlockIROBitsLazy.mp{2})=> //. +apply LowerFun_IRO_BlockIROBitsLazy_f. +proc (LazyInvar IRO.mp{1} BlockIROBitsLazy.mp{2})=> //. +apply LowerFun_IRO_BlockIROBitsLazy_f. +by conseq IRO_RaiseBIROBLazy_BlockIROBitsLazy_f. auto. qed. @@ -352,13 +409,15 @@ call ={glob Dist, glob BlockSim} /\ BlockIROBitsEager.mp{1} = map0 /\ Block.BIRO.IRO.mp{2} = map0 ==> ={res}). -proc (={glob BlockSim}). -smt. -smt. -proc (true); first 2 smt. -admit. -admit. -admit. +proc + (={glob BlockSim} /\ + EagerInvar Block.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1}) => //. +smt. (* TODO *) +proc (EagerInvar Block.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1})=> //. +conseq BlockIROBitsEager_BlockIRO_f=> //. +proc (EagerInvar Block.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1})=> //. +conseq BlockIROBitsEager_BlockIRO_f=> //. +conseq RaiseFun_BlockIROBitsEager_BlockIRO_f=> //. auto. qed. From f6541755883a25dd3e180b361fd59a17744a252b Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Fri, 22 Jan 2016 19:58:12 +0100 Subject: [PATCH 127/525] A bit more progress on top level. Has some smt calls, which will shortly be removed. --- proof/TopLevel.ec | 20 ++++++++++++-------- 1 file changed, 12 insertions(+), 8 deletions(-) diff --git a/proof/TopLevel.ec b/proof/TopLevel.ec index 7d66bf3..796d9cb 100644 --- a/proof/TopLevel.ec +++ b/proof/TopLevel.ec @@ -287,16 +287,20 @@ proof. proc=> /=. inline BlockIROBitsEager.g. seq 5 2 : - (xs0{1} = x{2} /\ bs0{1} = [] /\ bs{2} = [] /\ n0{1} = n{2} * r /\ + (={i} /\ xs0{1} = x{2} /\ bs0{1} = [] /\ bs{2} = [] /\ n0{1} = n{2} * r /\ n0{1} = m{1} /\ EagerInvar Block.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1}). auto; progress. rewrite -addzA divzMDl 1:gtr_eqF 1:gt0_r //. have -> // : (r - 1) %/ r = 0 by smt. (* TODO *) if=> //. -(* -second while loop in {1} is redundant -what's left is to deal with sampling... *) +rcondf{1} 2; auto; first while (true); auto. +conseq + (_ : + ={i} /\ n0{1} = n{2} * r /\ xs0{1} = x{2} /\ bs0{1} = [] /\ bs{2} = [] /\ + EagerInvar Block.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1} ==> + bits2blocks bs0{1} = bs{2} /\ + EagerInvar Block.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1})=> //. admit. auto; progress; by rewrite bits2blocks_nil. qed. @@ -413,10 +417,10 @@ proc (={glob BlockSim} /\ EagerInvar Block.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1}) => //. smt. (* TODO *) -proc (EagerInvar Block.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1})=> //. -conseq BlockIROBitsEager_BlockIRO_f=> //. -proc (EagerInvar Block.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1})=> //. -conseq BlockIROBitsEager_BlockIRO_f=> //. +proc (EagerInvar Block.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1})=> //; + conseq BlockIROBitsEager_BlockIRO_f=> //. +proc (EagerInvar Block.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1})=> //; + conseq BlockIROBitsEager_BlockIRO_f=> //. conseq RaiseFun_BlockIROBitsEager_BlockIRO_f=> //. auto. qed. From a2817bd1d70230618e893adecea8dbdff92b8bf3 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Fri, 22 Jan 2016 20:40:06 +0100 Subject: [PATCH 128/525] almost the end for bounding the probability of bext. --- proof/old/G2.eca | 307 +++++++++++++++++++++++++++++++++++------------ 1 file changed, 231 insertions(+), 76 deletions(-) diff --git a/proof/old/G2.eca b/proof/old/G2.eca index c1464d0..1e77061 100644 --- a/proof/old/G2.eca +++ b/proof/old/G2.eca @@ -7,9 +7,9 @@ require (*..*) Gcol. clone export Gcol as Gcol0. -op bad_ext (m:smap) y = - mem (map snd (elems (dom m))) y \/ - mem (map snd (elems (rng m))) y. +op bad_ext (m mi:smap) y = + mem (image snd (dom m)) y \/ + mem (image snd (dom mi)) y. op hinvc (m:(handle,capacity)fmap) (c:capacity) = find (+ pred1 c) m. @@ -71,7 +71,7 @@ module G2(D:DISTINGUISHER,HS:FRO) = { if (mem (dom G1.mh) (x.`1, hx2) /\ t) { hy2 <- (oget G1.mh.[(x.`1, hx2)]).`2; y2 <@ HS.get(hy2); - G1.bext <- G1.bext \/ bad_ext G1.m y2 \/ y2 = x.`2; + G1.bext <- G1.bext \/ bad_ext G1.m G1.mi y2 \/ y2 = x.`2; y <- (y.`1, y2); G1.m.[x] <- y; G1.mi.[y] <- x; @@ -107,7 +107,7 @@ module G2(D:DISTINGUISHER,HS:FRO) = { (y1,hy2) <- oget G1.mhi.[(x.`1, hx2)]; y2 <@ HS.get(hy2); y <- (y.`1, y2); - G1.bext <- G1.bext \/ bad_ext G1.m y2 \/ y2 = x.`2; + G1.bext <- G1.bext \/ bad_ext G1.m G1.mi y2 \/ y2 = x.`2; G1.mi.[x] <- y; G1.m.[y] <- x; } else { @@ -150,8 +150,11 @@ section. declare module D: DISTINGUISHER{G1, G2, FRO}. - op inv_ext1 bext1 bext2 (G1m:smap) (FROm:handles) = - bext1 => (bext2 \/ exists x h, mem (dom G1m `|` rng G1m) x /\ FROm.[h] = Some (x.`2, Unknown)). + op inv_ext (m mi:smap) (FROm:handles) = + exists x h, mem (dom m `|` dom mi) x /\ FROm.[h] = Some (x.`2, Unknown). + + op inv_ext1 bext1 bext2 (m mi:smap) (FROm:handles) = + bext1 => (bext2 \/ inv_ext m mi FROm). lemma rng_restr (m : ('from, 'to * 'flag) fmap) f x: mem (rng (restr f m)) x <=> mem (rng m) (x,f). @@ -161,15 +164,15 @@ section. qed. equiv G1_G2 : G1(D).main ~ Eager(G2(D)).main1 : - ={glob D} ==> ={res} /\ inv_ext1 G1.bext{1} G1.bext{2} G1.m{2} FRO.m{2}. + ={glob D} ==> ={res} /\ inv_ext1 G1.bext{1} G1.bext{2} G1.m{2} G1.mi{2} FRO.m{2}. proof. proc;inline{2} FRO.init G2(D, FRO).distinguish;wp. call (_: ={F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.paths,G1.chandle,FRO.m} /\ - inv_ext1 G1.bext{1} G1.bext{2} G1.m{2} FRO.m{2} /\ + inv_ext1 G1.bext{1} G1.bext{2} G1.m{2} G1.mi{2} FRO.m{2} /\ (forall h, mem (dom FRO.m) h => h < G1.chandle){1}). + proc;if=>//;last by auto. seq 1 1: (={F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.paths,G1.chandle,FRO.m,x,y} /\ - inv_ext1 G1.bext{1} G1.bext{2} G1.m{2} FRO.m{2} /\ + inv_ext1 G1.bext{1} G1.bext{2} G1.m{2} G1.mi{2} FRO.m{2} /\ (forall h, mem (dom FRO.m) h => h < G1.chandle){1} /\ ! mem (dom G1.m{1}) x{1}). + by if=>//;auto;call (_: ={F.RO.m});[sim |auto]. @@ -177,11 +180,10 @@ section. (={F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.paths,G1.chandle,FRO.m,hx2,x,y,hx2} /\ t{2} = (in_dom_with FRO.m (oget G1.mh.[(x.`1, hx2)]).`2 Unknown){1} /\ (G1.bext{1} => (G1.bext{2} \/ (mem (rng FRO.m) (x.`2, Unknown)){2} \/ - exists x h, mem (dom G1.m{2} `|` rng G1.m{2}) x /\ - FRO.m{2}.[h] = Some (x.`2, Unknown))) /\ + inv_ext G1.m{2} G1.mi{2} FRO.m{2})) /\ (forall h, mem (dom FRO.m) h => h < G1.chandle){1} /\ ! mem (dom G1.m{1}) x{1}). - + inline *;auto=> &ml&mr[*]10!-> Hi Hhand -> /=. + + inline *;auto=> &ml&mr[#]10!-> Hi Hhand -> /=. rewrite -dom_restr rng_restr /=;progress; 3:by smt ml=0. + rewrite rng_set !inE rem_id 1:/#;move:H0=>[/Hi[->|[x' h][]H1 H2]|->]//. right;right;exists x', h;rewrite getP. @@ -196,29 +198,29 @@ section. + case (h = (oget G1.mh{2}.[(x{2}.`1, hx2{2})]).`2)=> [->>|Hneq]. + by left;rewrite Hh oget_some. by right;exists x{2}, h;rewrite dom_set getP Hneq !inE. - case (h = (oget G1.mh{2}.[(x{2}.`1, hx2{2})]).`2)=> [->>|Hneq]. + rewrite Hh /bad_ext oget_some /= !mem_map_snd. - by left;right;left <@ Hx;rewrite !inE=>-[|]Hx;[left|right];exists x1; - rewrite -memE. - right;exists (x1,x2), h;rewrite dom_set rng_set getP Hneq rem_id //=. + case (h = (oget G1.mh{2}.[(x{2}.`1, hx2{2})]).`2)=> [->>|Hneq]. + + rewrite Hh /bad_ext oget_some /= <@ Hx;rewrite !inE. + by move=>[|]/(mem_image snd)->. + right;exists (x1,x2), h;rewrite !dom_set getP Hneq //=. by move:Hx;rewrite !inE Hh=>-[]->. by move:H6 H2;rewrite /in_dom_with dom_set !inE /#. inline *;auto;progress;last by move:H3;rewrite dom_set !inE /#. rewrite /inv_ext1=> /H [->//|[/in_rng[h]Hh|[x' h [Hx Hh]]]]. + right;exists x{2}, h;rewrite getP dom_set !inE /=. by move:(H0 h);rewrite in_dom Hh /#. - right;exists x', h;rewrite getP dom_set !inE. - move:(H0 h) Hx;rewrite in_dom rng_set Hh !inE rem_id //= /#. + right;exists x', h;rewrite getP !dom_set !inE;split. + + by move:Hx;rewrite !inE=>-[]->. + by move:(H0 h);rewrite !in_dom Hh /#. + proc;if=>//;last by auto. seq 4 6: (={F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.paths,G1.chandle,FRO.m,hx2,x,y,hx2} /\ t{2} = (in_dom_with FRO.m (oget G1.mhi.[(x.`1, hx2)]).`2 Unknown){1} /\ (G1.bext{1} => (G1.bext{2} \/ (mem (rng FRO.m) (x.`2, Unknown)){2} \/ - exists x h, mem (dom G1.m{2} `|` rng G1.m{2}) x /\ - FRO.m{2}.[h] = Some (x.`2, Unknown))) /\ + inv_ext G1.m{2} G1.mi{2} FRO.m{2})) /\ (forall h, mem (dom FRO.m) h => h < G1.chandle){1} /\ ! mem (dom G1.mi{1}) x{1}). - + inline *;auto=> &ml&mr[*]9!-> Hi Hhand -> /=. + + inline *;auto=> &ml&mr[#]9!-> Hi Hhand -> /=. rewrite -dom_restr rng_restr /=;progress; 3:by smt ml=0. + rewrite rng_set !inE rem_id 1:/#;move:H2=>[/Hi[->|[x' h][]HH1 HH2]|->]//. right;right;exists x', h;rewrite getP. @@ -230,48 +232,48 @@ section. auto;progress. + by apply DWord.cdistr_ll. + rewrite /inv_ext1=>/H{H}[->//|[/in_rng[h]Hh|[[x1 x2] h [Hx Hh]]]]. - + case (h = (oget G1.mhi{2}.[(x{2}.`1, hx2{2})]).`2)=> [->>|Hneq /=]. + + case (h = (oget G1.mhi{2}.[(x{2}.`1, hx2{2})]).`2)=> [->>|Hneq]. + by left;rewrite Hh oget_some. - by right;exists x{2}, h;rewrite rng_set getP Hneq !inE. - case (h = (oget G1.mhi{2}.[(x{2}.`1, hx2{2})]).`2)=> [->>|Hneq]. + rewrite Hh /bad_ext oget_some /= !mem_map_snd. - by left;right;left <@ Hx;rewrite !inE=>-[|]?;[left|right]; - exists x1;rewrite -memE. - right;exists (x1,x2), h;rewrite dom_set rng_set getP Hneq !inE Hh /= rng_rem. - move:Hx;rewrite !inE in_rng. - - -search mem rng. -print rngP. - - case ((x1,x2) = - (y{2}.`1, (oget FRO.m{2}.[(oget G1.mhi{2}.[(x{2}.`1, hx2{2})]).`2]).`1))=> - [/=->//|Hneq']. - right;left;exists (x1,x2);rewrite Hneq'. - move:Hx;rewrite inE in_rng=>-[->//|[[a1 a2]]] /#. -search mem rng. -search rng rem. - Hh. - Hx. + by right;exists x{2}, h;rewrite !dom_set getP Hneq !inE. + case (h = (oget G1.mhi{2}.[(x{2}.`1, hx2{2})]).`2)=> [->>|Hneq]. + + rewrite Hh /bad_ext oget_some /= <@ Hx;rewrite !inE. + by move=>[|]/(mem_image snd)->. + right;exists (x1,x2), h;rewrite !dom_set getP Hneq //=. + by move:Hx;rewrite !inE Hh=>-[]->. by move:H6 H2;rewrite /in_dom_with dom_set !inE /#. inline *;auto;progress;last by move:H3;rewrite dom_set !inE /#. rewrite /inv_ext1=> /H [->//|[/in_rng[h]Hh|[x' h [Hx Hh]]]]. - + right;exists x{2}, h;rewrite getP dom_set !inE /=. + + right;exists x{2}, h;rewrite getP !dom_set !inE /=. by move:(H0 h);rewrite in_dom Hh /#. - right;exists x', h;rewrite getP dom_set !inE. - by move:(H0 h);rewrite in_dom Hh Hx /#. - - + right;exists x', h;rewrite getP !dom_set !inE;split. + + by move:Hx;rewrite !inE=>-[]->. + by move:(H0 h);rewrite !in_dom Hh /#. - (************) - inline*;auto. - - auto=> //. -sim. - admit. - qed. + + proc; + conseq (_: ={sa,G1.mh,G1.mhi,F.RO.m, G1.chandle, FRO.m} /\ + inv_ext1 G1.bext{1} G1.bext{2} G1.m{2} G1.mi{2} FRO.m{2} /\ + forall (h0 : handle), mem (dom FRO.m{1}) h0 => h0 < G1.chandle{1})=>//. + sp 3 3;if=>//;call (_: ={F.RO.m});1:by sim. + while (={sa,G1.mh,G1.mhi,F.RO.m,G1.chandle,FRO.m,i,h,sa,p} /\ + inv_ext1 G1.bext{1} G1.bext{2} G1.m{2} G1.mi{2} FRO.m{2} /\ + forall (h0 : handle), mem (dom FRO.m{1}) h0 => h0 < G1.chandle{1})=>//. + if=>//;inline *;1:by auto. + rcondt{2} 3;1:by auto=>/#. + auto=> &m1&m2 [#] 10!-> Hinv Hhand Hi _ _ /= ?->?->/=;split=>/= _;split. + + move:Hinv;rewrite /inv_ext1=> H/H{H}[->//|[x h]];rewrite inE=>-[Hmem Hh]. + by right;exists x,h;rewrite !inE Hmem getP;smt w=in_dom. + + by move=>h;rewrite dom_set !inE /#. + + move:Hinv;rewrite /inv_ext1=> H/H{H}[->//|[x h]];rewrite inE=>-[Hmem Hh]. + by right;exists x,h;rewrite !inE Hmem getP;smt w=in_dom. + by move=>h;rewrite dom_set !inE /#. + + (* **************** *) + inline *;auto;progress. + by move:H;rewrite dom_set dom0 !inE=>->. + qed. equiv Eager_1_2: Eager(G2(D)).main1 ~ Eager(G2(D)).main2 : - ={glob G2(D)} ==> ={G1.m,FRO.m,G1.bext}. + ={glob G2(D)} ==> ={G1.m,G1.mi,FRO.m,G1.bext}. proof. by conseq (Eager_1_2 (G2(D))). qed. end section. @@ -282,14 +284,28 @@ section EXT. local module ReSample = { var count:int - proc f (x:handle) = { + proc f (h:handle) = { var c; c <$ cdistr; - if (card (dom G1.m) < max_size /\ count < max_size) { - G1.bext <- G1.bext \/ bad_ext G1.m c; - FRO.m.[x] <- (c,Unknown); + if (card (dom G1.m) <= max_size /\ + card (dom G1.mi) <= max_size /\ count < max_size) { + G1.bext <- G1.bext \/ mem (image snd (dom G1.m `|` dom G1.mi)) c; + FRO.m.[h] <- (c,Unknown); + count = count + 1 ; } } + + proc f1 (x:capacity,h:handle) = { + var c; + c <$ cdistr; + if (card (dom G1.m) < max_size /\ + card (dom G1.mi) < max_size /\ count < max_size) { + G1.bext <- G1.bext \/ mem (image snd (dom G1.m `|` dom G1.mi) `|` fset1 x) c; + FRO.m.[h] <- (c,Unknown); + count = count + 1; + } + } + }. local module Gext = { @@ -352,8 +368,8 @@ section EXT. t <@ RRO.in_dom((oget G1.mh.[(x.`1,hx2)]).`2, Unknown); if (mem (dom G1.mh) (x.`1, hx2) /\ t) { hy2 <- (oget G1.mh.[(x.`1, hx2)]).`2; - ReSample.f(hy2); - y2 <@ RRO.get(hy2); + ReSample.f1(x.`2, hy2); + y2 <@ FRO.get(hy2); y <- (y.`1, y2); G1.m.[x] <- y; G1.mi.[y] <- x; @@ -384,11 +400,11 @@ section EXT. handles_ <@ RRO.restrK(); hx2 <- oget (hinvc handles_ x.`2); y <$ dstate; - t <@ RRO.in_dom((oget G1.mh.[(x.`1,hx2)]).`2, Unknown); + t <@ RRO.in_dom((oget G1.mhi.[(x.`1,hx2)]).`2, Unknown); if (mem (dom G1.mhi) (x.`1, hx2) /\ t) { (y1,hy2) <- oget G1.mhi.[(x.`1, hx2)]; - ReSample.f(hy2); - y2 <@ RRO.get(hy2); + ReSample.f1(x.`2,hy2); + y2 <@ FRO.get(hy2); y <- (y.`1, y2); G1.mi.[x] <- y; @@ -413,6 +429,7 @@ section EXT. proc distinguish(): bool = { var b; + SLCommon.C.c <- 0; F.RO.m <- map0; G1.m <- map0; G1.mi <- map0; @@ -426,27 +443,165 @@ section EXT. RRO.set(0,c0); G1.paths <- map0.[c0 <- ([<:block>],b0)]; G1.chandle <- 1; - b <@ D(C,S).distinguish(); + b <@ DRestr(D,C,S).distinguish(); resample(); return b; } }. + op inv_lt (m2 mi2:smap) c1 (Fm2:handles) count2 = + size m2 < c1 /\ size mi2 < c1 /\ + count2 + size (restr Unknown Fm2) < c1 /\ + c1 <= max_size. + + op inv_le (m2 mi2:smap) c1 (Fm2:handles) count2 = + size m2 <= c1 /\ size mi2 <= c1 /\ + count2 + size (restr Unknown Fm2) <= c1 /\ + c1 <= max_size. + + lemma fset0_eqP (s:'a fset): s = fset0 <=> forall x, !mem s x. + proof. + split=>[-> x|Hmem];1:by rewrite inE. + by apply fsetP=>x;rewrite inE Hmem. + qed. + + lemma size_set (m:('a,'b)fmap) (x:'a) (y:'b): + size (m.[x<-y]) = if mem (dom m) x then size m else size m + 1. + proof. + rewrite sizeE dom_set;case (mem (dom m) x)=> Hx. + + by rewrite fsetUC subset_fsetU_id 2:sizeE 2:// => z; rewrite ?inE. + rewrite fcardUI_indep 1:fset0_eqP=>[z|]. + + by rewrite !inE;case (z=x)=>//. + by rewrite fcard1 sizeE. + qed. + + lemma size_set_le (m:('a,'b)fmap) (x:'a) (y:'b): size (m.[x<-y]) <= size m + 1. + proof. rewrite size_set /#. qed. + + lemma size_rem (m:('a,'b)fmap) (x:'a): + size (rem x m) = if mem (dom m) x then size m - 1 else size m. + proof. + rewrite !sizeE dom_rem fcardD;case (mem (dom m) x)=> Hx. + + by rewrite subset_fsetI_id 2:fcard1// => z;rewrite !inE. + by rewrite (eq_fcards0 (_ `&` _)) 2:// fset0_eqP=>z;rewrite !inE /#. + qed. + + lemma size_rem_le (m:('a,'b)fmap) x : size (rem x m) <= size m. + proof. by rewrite size_rem /#. qed. + + lemma size_ge0 (m:('a,'b)fmap) : 0 <= size m. + proof. rewrite sizeE fcard_ge0. qed. + + lemma size0 : size map0<:'a,'b> = 0. + proof. by rewrite sizeE dom0 fcards0. qed. + + local equiv RROset_inv_lt : RRO.set ~ RRO.set : + ={x,y,FRO.m} /\ inv_lt G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2} ==> + ={res,FRO.m} /\ inv_lt G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2}. + proof. + proc;auto=> &ml&mr[#]3!-> /= @/inv_lt [*]. + rewrite restr_set /=;smt w=(size_set_le size_rem_le). + qed. + local equiv EG2_Gext : Eager(G2(DRestr(D))).main2 ~ Gext.distinguish: ={glob D} ==> - (G1.bext{1} \/ - exists x h, mem (dom G1.m{1}) x /\ FRO.m{1}.[h] = Some (x.`2, Unknown)) => + (G1.bext{1} \/ inv_ext G1.m{1} G1.mi{1} FRO.m{1}) => G1.bext{2}. - proof. - admit. - qed. + proof. + proc;inline *;wp. + while (={l,FRO.m,G1.m,G1.mi} /\ card (dom G1.m){2} <= max_size /\ + card (dom G1.mi){2} <= max_size /\ + ReSample.count{2} + size l{2} <= max_size /\ + ((G1.bext{1} \/ + exists (x : state) (h : handle), + mem (dom G1.m{1} `|` dom G1.mi{1}) x /\ + FRO.m{1}.[h] = Some (x.`2, Unknown) /\ !mem l{1} h) => + G1.bext{2})). + + rcondt{2} 3. + + by move=> &m;auto=> &m'[#] 6!-> /= + _ _;case (l{m'})=>//=; smt w=List.size_ge0. + auto=> &ml&mr[#]6!->;case(l{mr})=>[//|h1 l1/=Hle Hext c->/=];split. + + smt w=(drop0 size_ge0). + rewrite drop0=>-[H|[x h][#]];1:by rewrite Hext // H. + rewrite getP;case (h=h1)=> [/=->Hin->_ | Hneq ???]. + + by right;apply (mem_image snd _ x). + by rewrite Hext 2://;right;exists x, h;rewrite Hneq. + wp; call (_: ={F.RO.m,FRO.m,G1.paths,G1.mh,G1.mhi,G1.m,G1.mi,G1.chandle,G1.bext, C.c} /\ + inv_le G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2}). + + proc;sp;if=> //. + call (_: ={x,F.RO.m,FRO.m,G1.paths,G1.mh,G1.mhi,G1.m,G1.mi,G1.chandle,G1.bext,C.c} /\ + inv_lt G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2} ==> + ={res,F.RO.m,FRO.m,G1.paths,G1.mh,G1.mhi,G1.m,G1.mi,G1.chandle,G1.bext,C.c} /\ + inv_le G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2});last by auto=> /#. + proc;if=>//;last by auto=>/#. + seq 1 1 : + (={y,x,F.RO.m,FRO.m,G1.paths,G1.mh,G1.mhi,G1.m,G1.mi,G1.chandle,G1.bext, C.c} /\ + inv_lt G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2}). + + by if=>//;auto;call (_: ={F.RO.m});auto. + seq 5 5 : + (={t,y,x,hx2,F.RO.m,FRO.m,G1.paths,G1.mh,G1.mhi,G1.m,G1.mi,G1.chandle,G1.bext, C.c} /\ + inv_lt G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2} /\ + (t => in_dom_with FRO.m (oget G1.mh.[(x.`1, hx2)]).`2 Unknown){1}). + + inline RRO.in_dom; wp;call (_: ={FRO.m});1:by sim. + inline RRO.restrK;sp 1 1;if=>//. + by wp;call RROset_inv_lt;auto. + if=>//;wp. + + inline *;rcondt{1} 4;1:by auto=>/#. + rcondt{2} 5;1:by auto;smt w=(sizeE size_ge0). + rcondt{2} 10. by auto;progress;rewrite dom_set !inE. + wp;rnd{2};auto=> /= ??[#]!-> @/inv_lt @/inv_le [#] mlt milt clt cle Hin 3?->/=. + rewrite DWord.cdistr_ll /= => ? _;rewrite /bad_ext !getP /= !oget_some /= set_set_eq /=. + rewrite !(imageU,inE) restr_set /= size_rem dom_restr Hin //=; smt w=size_set_le. + by call RROset_inv_lt;auto;smt w=size_set_le. - local lemma Pr_ext &m: - Pr[Gext.distinguish()@ &m : G1.bext] <= (max_size^2)%r / (2^c)%r. - proof. - admit. - qed. + + proc;sp;if=> //. + call (_: ={x,F.RO.m,FRO.m,G1.paths,G1.mh,G1.mhi,G1.m,G1.mi,G1.chandle,G1.bext,C.c} /\ + inv_lt G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2} ==> + ={res,F.RO.m,FRO.m,G1.paths,G1.mh,G1.mhi,G1.m,G1.mi,G1.chandle,G1.bext,C.c} /\ + inv_le G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2});last by auto=> /#. + proc;if=>//;last by auto=>/#. + seq 6 6 : + (={t,y,x,hx2,F.RO.m,FRO.m,G1.paths,G1.mh,G1.mhi,G1.m,G1.mi,G1.chandle,G1.bext, C.c} /\ + inv_lt G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2} /\ + (t => in_dom_with FRO.m (oget G1.mhi.[(x.`1, hx2)]).`2 Unknown){1}). + + inline RRO.in_dom; auto;call (_: ={FRO.m});1:by sim. + inline RRO.restrK;sp 1 1;if=>//. + by wp;call RROset_inv_lt;auto. + if=>//;wp. + + inline *;rcondt{1} 4;1:by auto=>/#. + rcondt{2} 5;1:by auto;smt w=(sizeE size_ge0). + rcondt{2} 10. by auto;progress;rewrite dom_set !inE. + wp;rnd{2};auto=> /= ??[#]!-> @/inv_lt @/inv_le [#] mlt milt clt cle Hin 3?->/=. + rewrite DWord.cdistr_ll /= => ? _;rewrite /bad_ext !getP /= !oget_some /= set_set_eq /=. + rewrite !(imageU,inE) restr_set /= size_rem dom_restr Hin //=; smt w=size_set_le. + by call RROset_inv_lt;auto;smt w=size_set_le. + + proc;sp 1 1;if=>//. + inline G2(DRestr(D), RRO).C.f Gext.C.f. + sp 5 5;elim *=> c0L c0R;if => //;last by auto;smt w=List.size_ge0. + wp;call (_: ={F.RO.m});1:by sim. + while (={i,p,G1.mh,sa,h,FRO.m,F.RO.m,G1.mh,G1.mhi,G1.chandle} /\ 0 <= i{1} <= size p{1}/\ + c0R + size p{1} <= max_size /\ + inv_le G1.m{2} G1.mi{2} (c0R + i){2} FRO.m{2} ReSample.count{2});last by auto=>/#. + if=> //;1:by auto=>/#. + auto;call (_: ={F.RO.m});1:by sim. + (*inline *;auto=>/> ?&mr. BUG anomaly: EcLowGoal.InvalidProofTerm *) + inline *;auto=> ?&mr [#]!->@/inv_le Hi [#]. + case (p{mr})=> [/#|/=p1 p2] 4?_ /= 2?-> /=;split=>/= Hmem 4? [#]2->/= => [|/#]. + by rewrite restr_set /= size_set dom_restr /in_dom_with Hmem/= /#. + + (* auto=> />. BUG *) + auto;progress[delta];rewrite ?(size0,restr0,restr_set,rem0,max_ge0,-sizeE,-cardE) //=. + + smt ml=0. + smt ml=0. + smt ml=0. + + elim H7=>// [[x h] [#]];rewrite -memE dom_restr /in_dom_with in_dom=> _ ->/=. + by rewrite oget_some. + apply H10=>//. + qed. + + local lemma Pr_ext &m: + Pr[Gext.distinguish()@ &m : G1.bext] <= (max_size^2)%r / (2^c)%r. + proof. + admit. + qed. end section EXT. From 25529268efdf7c5db4735eb968416b2aa66d0385 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Fri, 22 Jan 2016 22:02:08 +0100 Subject: [PATCH 129/525] lemmas for bounding Pr bext done. Need to add some glue. --- proof/old/G2.eca | 57 ++++++++++++++++++++++++++++++++++++++-------- proof/old/Gcol.eca | 26 ++++++++++----------- 2 files changed, 60 insertions(+), 23 deletions(-) diff --git a/proof/old/G2.eca b/proof/old/G2.eca index 1e77061..2834520 100644 --- a/proof/old/G2.eca +++ b/proof/old/G2.eca @@ -287,8 +287,7 @@ section EXT. proc f (h:handle) = { var c; c <$ cdistr; - if (card (dom G1.m) <= max_size /\ - card (dom G1.mi) <= max_size /\ count < max_size) { + if (size G1.m <= max_size /\ size G1.mi <= max_size /\ ReSample.count < max_size) { G1.bext <- G1.bext \/ mem (image snd (dom G1.m `|` dom G1.mi)) c; FRO.m.[h] <- (c,Unknown); count = count + 1 ; @@ -298,8 +297,7 @@ section EXT. proc f1 (x:capacity,h:handle) = { var c; c <$ cdistr; - if (card (dom G1.m) < max_size /\ - card (dom G1.mi) < max_size /\ count < max_size) { + if (size G1.m < max_size /\ size G1.mi < max_size /\ ReSample.count < max_size) { G1.bext <- G1.bext \/ mem (image snd (dom G1.m `|` dom G1.mi) `|` fset1 x) c; FRO.m.[h] <- (c,Unknown); count = count + 1; @@ -505,20 +503,21 @@ section EXT. local equiv EG2_Gext : Eager(G2(DRestr(D))).main2 ~ Gext.distinguish: ={glob D} ==> + ReSample.count{2} <= max_size /\ (G1.bext{1} \/ inv_ext G1.m{1} G1.mi{1} FRO.m{1}) => G1.bext{2}. proof. proc;inline *;wp. - while (={l,FRO.m,G1.m,G1.mi} /\ card (dom G1.m){2} <= max_size /\ - card (dom G1.mi){2} <= max_size /\ + while (={l,FRO.m,G1.m,G1.mi} /\ size G1.m{2} <= max_size /\ + size G1.mi{2} <= max_size /\ ReSample.count{2} + size l{2} <= max_size /\ ((G1.bext{1} \/ exists (x : state) (h : handle), mem (dom G1.m{1} `|` dom G1.mi{1}) x /\ FRO.m{1}.[h] = Some (x.`2, Unknown) /\ !mem l{1} h) => G1.bext{2})). - + rcondt{2} 3. - + by move=> &m;auto=> &m'[#] 6!-> /= + _ _;case (l{m'})=>//=; smt w=List.size_ge0. + + rcondt{2} 3. + + move=> &m;auto=> &m'[#] 6!-> /= + _ _;case (l{m'})=>//=; smt w=List.size_ge0. auto=> &ml&mr[#]6!->;case(l{mr})=>[//|h1 l1/=Hle Hext c->/=];split. + smt w=(drop0 size_ge0). rewrite drop0=>-[H|[x h][#]];1:by rewrite Hext // H. @@ -598,9 +597,47 @@ section EXT. qed. local lemma Pr_ext &m: - Pr[Gext.distinguish()@ &m : G1.bext] <= (max_size^2)%r / (2^c)%r. + Pr[Gext.distinguish()@&m : G1.bext /\ ReSample.count <= max_size] <= + max_size%r * ((2*max_size)%r / (2^c)%r). proof. - admit. + fel 8 ReSample.count (fun x=> (2*max_size)%r / (2^c)%r) + max_size G1.bext + [ReSample.f : + (size G1.m <= max_size /\ size G1.mi <= max_size /\ ReSample.count < max_size); + ReSample.f1 : + (size G1.m < max_size /\ size G1.mi < max_size /\ ReSample.count < max_size) + ]=> //; 2:by auto. + + rewrite /felsum Bigreal.sumr_const count_predT size_range. + apply ler_wpmul2r;1:by apply eps_ge0. + by rewrite le_fromint;smt ml=0 w=max_ge0. + + proc. + case ((size G1.m <= max_size /\ size G1.mi <= max_size /\ ReSample.count < max_size)); + [rcondt 2 | rcondf 2]; 1,3:by auto. + + wp;rnd (mem (image snd (dom G1.m `|` dom G1.mi)));skip=> &hr[#]?->/=???. + rewrite (Mu_mem.mu_mem (image snd (dom G1.m{hr}`|`dom G1.mi{hr})) cdistr (1%r/(2^c)%r))//. + + move=>x _;apply DWord.muxP. + apply ler_wpmul2r;1:by apply divr_ge0=>//;apply /c_ge0r. + rewrite imageU fcardU le_fromint. + move:(fcard_image_leq snd (dom G1.m{hr}))(fcard_image_leq snd (dom G1.mi{hr})). + rewrite -!sizeE;smt w=fcard_ge0. + by hoare=>[??|];[apply eps_ge0|auto]. + + by move=>c1;proc;auto=> &hr [^H 2->]/#. + + by move=> b1 c1;proc;auto=> &hr [^H 2->]. + + proc. + case ((size G1.m < max_size /\ size G1.mi < max_size /\ ReSample.count < max_size)); + [rcondt 2 | rcondf 2]; 1,3:by auto. + + wp;rnd (mem (image snd (dom G1.m `|` dom G1.mi ) `|` fset1 x));skip=> &hr[#]?->/=???. + rewrite (Mu_mem.mu_mem + (image snd (dom G1.m{hr} `|` dom G1.mi{hr}) `|` fset1 x{hr}) + cdistr (1%r/(2^c)%r))//. + + move=>x _;apply DWord.muxP. + apply ler_wpmul2r;1:by apply divr_ge0=>//;apply /c_ge0r. + rewrite imageU !fcardU le_fromint fcard1. + move:(fcard_image_leq snd (dom G1.m{hr}))(fcard_image_leq snd (dom G1.mi{hr})). + rewrite -!sizeE;smt w=fcard_ge0. + by hoare=>[??|];[apply eps_ge0|auto]. + + by move=>c1;proc;auto=> &hr [^H 2->]/#. + by move=> b1 c1;proc;auto=> &hr [^H 2->]. qed. end section EXT. diff --git a/proof/old/Gcol.eca b/proof/old/Gcol.eca index 24778fd..399492d 100644 --- a/proof/old/Gcol.eca +++ b/proof/old/Gcol.eca @@ -9,6 +9,19 @@ clone export Handle as Handle0. (* -------------------------------------------------------------------------- *) + (* TODO: move this *) + lemma c_gt0r : 0%r < (2^c)%r. + proof. by rewrite lt_fromint;apply /powPos. qed. + + lemma c_ge0r : 0%r <= (2^c)%r. + proof. by apply /ltrW/c_gt0r. qed. + + lemma eps_ge0 : 0%r <= (2 * max_size)%r / (2 ^ c)%r. + proof. + apply divr_ge0;1:by rewrite le_fromint;smt ml=0 w=max_ge0. + by apply c_ge0r. + qed. + section PROOF. declare module D: DISTINGUISHER{C, PF, G1}. @@ -282,19 +295,6 @@ section PROOF. by apply max_ge0. qed. - (* TODO: move this *) - lemma c_gt0r : 0%r < (2^c)%r. - proof. by rewrite lt_fromint;apply /powPos. qed. - - lemma c_ge0r : 0%r <= (2^c)%r. - proof. by apply /ltrW/c_gt0r. qed. - - local lemma eps_ge0 : 0%r <= (2 * max_size)%r / (2 ^ c)%r. - proof. - apply divr_ge0;1:by rewrite le_fromint;smt ml=0 w=max_ge0. - by apply c_ge0r. - qed. - local lemma Pr_col &m : Pr[Gcol.main()@&m : G1.bcol /\ Gcol.count <= max_size] <= max_size%r * ((2*max_size)%r / (2^c)%r). From f60a4591c90261b2506a17d109ef1dee4523dc91 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Fri, 22 Jan 2016 23:13:06 +0100 Subject: [PATCH 130/525] add glue between the different lemmas. --- proof/old/G2.eca | 35 ++++++++++++++++++++++++++++------- proof/old/Gcol.eca | 8 ++++++++ 2 files changed, 36 insertions(+), 7 deletions(-) diff --git a/proof/old/G2.eca b/proof/old/G2.eca index 2834520..547bedd 100644 --- a/proof/old/G2.eca +++ b/proof/old/G2.eca @@ -272,15 +272,11 @@ section. by move:H;rewrite dom_set dom0 !inE=>->. qed. - equiv Eager_1_2: Eager(G2(D)).main1 ~ Eager(G2(D)).main2 : - ={glob G2(D)} ==> ={G1.m,G1.mi,FRO.m,G1.bext}. - proof. by conseq (Eager_1_2 (G2(D))). qed. - end section. section EXT. - declare module D: DISTINGUISHER{C, PF, G1, G2 }. + declare module D: DISTINGUISHER{C, PF, G1, G2, Perm, RO }. local module ReSample = { var count:int @@ -504,8 +500,7 @@ section EXT. local equiv EG2_Gext : Eager(G2(DRestr(D))).main2 ~ Gext.distinguish: ={glob D} ==> ReSample.count{2} <= max_size /\ - (G1.bext{1} \/ inv_ext G1.m{1} G1.mi{1} FRO.m{1}) => - G1.bext{2}. + ((G1.bext{1} \/ inv_ext G1.m{1} G1.mi{1} FRO.m{1}) => G1.bext{2}). proof. proc;inline *;wp. while (={l,FRO.m,G1.m,G1.mi} /\ size G1.m{2} <= max_size /\ @@ -640,6 +635,32 @@ section EXT. by move=> b1 c1;proc;auto=> &hr [^H 2->]. qed. + axiom D_ll: + forall (F <: DFUNCTIONALITY{D}) (P <: DPRIMITIVE{D}), + islossless P.f => islossless P.fi => islossless F.f => islossless D(F, P).distinguish. + + (* TODO Francois : on peut pas avoir max_size au lieu de (max_size + 1)? *) + lemma Real_G2 &m: + Pr[GReal(D).main() @ &m: res /\ C.c <= max_size] <= + Pr[Eager(G2(DRestr(D))).main2() @ &m: res] + + ((max_size + 1) ^ 2)%r * mu dstate (pred1 witness) + + max_size%r * ((2*max_size)%r / (2^c)%r) + + max_size%r * ((2*max_size)%r / (2^c)%r). + proof. + apply (ler_trans _ _ _ (Real_G1 D D_ll &m)). + do !apply ler_add => //. + + cut ->: Pr[G1(DRestr(D)).main() @ &m : res] = Pr[Eager(G2(DRestr(D))).main1() @ &m : res]. + + by byequiv (G1_G2 (DRestr(D))). + by apply lerr_eq;byequiv (Eager_1_2 (G2(DRestr(D)))). + + by apply (Pr_G1col D D_ll &m). + apply (ler_trans Pr[Eager(G2(DRestr(D))).main1()@&m: G1.bext \/ inv_ext G1.m G1.mi FRO.m]). + + by byequiv (G1_G2 (DRestr(D)))=>//#. + apply (ler_trans Pr[Eager(G2(DRestr(D))).main2()@&m : G1.bext \/ inv_ext G1.m G1.mi FRO.m]). + + by apply lerr_eq;byequiv (Eager_1_2 (G2(DRestr(D)))). + apply (ler_trans _ _ _ _ (Pr_ext &m)). + byequiv EG2_Gext=>//#. + qed. + end section EXT. diff --git a/proof/old/Gcol.eca b/proof/old/Gcol.eca index 399492d..504d172 100644 --- a/proof/old/Gcol.eca +++ b/proof/old/Gcol.eca @@ -316,6 +316,14 @@ section PROOF. move=> b c;proc;sp;if;auto;smt ml=0. qed. + lemma Pr_G1col &m: + Pr[G1(DRestr(D)).main() @ &m : G1.bcol] <= max_size%r * ((2*max_size)%r / (2^c)%r). + proof. + apply (ler_trans Pr[Gcol.main()@&m : G1.bcol /\ Gcol.count <= max_size]). + + byequiv G1col=> //#. + apply (Pr_col &m). + qed. + end section PROOF. From 97b5cb1d17ce3428ae74edc1c61f0e345a69c5ef Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Fri, 22 Jan 2016 23:16:33 +0100 Subject: [PATCH 131/525] rename file --- proof/old/{G2.eca => Gext.eca} | 1 + 1 file changed, 1 insertion(+) rename proof/old/{G2.eca => Gext.eca} (99%) diff --git a/proof/old/G2.eca b/proof/old/Gext.eca similarity index 99% rename from proof/old/G2.eca rename to proof/old/Gext.eca index 547bedd..6201a58 100644 --- a/proof/old/G2.eca +++ b/proof/old/Gext.eca @@ -56,6 +56,7 @@ module G2(D:DISTINGUISHER,HS:FRO) = { y <- (y1, y2); G1.paths.[y2] <- (rcons p (v +^ x.`1), y.`1); } else { + y <$ dstate; } (* exists x h, mem (dom G1.m) x /\ handles.[h] = Some (x.2, I) *) From 3a83b7f63cf78c97999b5a9f9f4569a8c29cf793 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Mon, 25 Jan 2016 09:35:17 +0100 Subject: [PATCH 132/525] align --- proof/old/Handle.eca | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/proof/old/Handle.eca b/proof/old/Handle.eca index c35ae48..7027bf0 100644 --- a/proof/old/Handle.eca +++ b/proof/old/Handle.eca @@ -71,7 +71,7 @@ module G1(D:DISTINGUISHER) = { if (mem (dom mh) (x.`1, hx2) /\ in_dom_with FRO.m (oget mh.[(x.`1,hx2)]).`2 Unknown) { hy2 <- (oget mh.[(x.`1, hx2)]).`2; y <- (y.`1, (oget FRO.m.[hy2]).`1); - FRO.m.[hy2] <- (y.`2, Known); + FRO.m.[hy2] <- (y.`2, Known); (* bad <- bad \/ mem X2 y.`2; *) m.[x] <- y; mi.[y] <- x; From fdcf2245db4875854a5cf1fdf56628d26a5f25f3 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Mon, 25 Jan 2016 13:33:28 +0100 Subject: [PATCH 133/525] propagate modifications allowing to do the final transition. --- proof/old/Gcol.eca | 31 ++++++++++------------- proof/old/Gext.eca | 58 ++++++++++++++++++++++++++------------------ proof/old/Handle.eca | 19 +++++++++------ 3 files changed, 60 insertions(+), 48 deletions(-) diff --git a/proof/old/Gcol.eca b/proof/old/Gcol.eca index 504d172..ef8c42c 100644 --- a/proof/old/Gcol.eca +++ b/proof/old/Gcol.eca @@ -84,18 +84,16 @@ section PROOF. G1.chandle <- G1.chandle + 1; } hx2 <- oget (hinvK FRO.m x.`2); - if (mem (dom G1.paths) x.`2) { (p,v) <- oget G1.paths.[x.`2]; y1 <- F.RO.get (rcons p (v +^ x.`1)); y2 <@ sample_c(); - y <- (y1, y2); - G1.paths.[y2] <- (rcons p (v +^ x.`1), y.`1); } else { y1 <$ bdistr; y2 <@ sample_c(); - y <- (y1,y2); + } + y <- (y1,y2); if (mem (dom G1.mh) (x.`1, hx2) /\ in_dom_with FRO.m (oget G1.mh.[(x.`1,hx2)]).`2 Unknown) { hy2 <- (oget G1.mh.[(x.`1, hx2)]).`2; @@ -112,6 +110,10 @@ section PROOF. G1.mi.[y] <- x; G1.mhi.[(y.`1, hy2)] <- (x.`1, hx2); } + if (mem (dom G1.paths) x.`2) { + (p,v) <- oget G1.paths.[x.`2]; + G1.paths.[y.`2] <- (rcons p (v +^ x.`1), y.`1); + } } else { y <- oget G1.m.[x]; } @@ -205,36 +207,29 @@ section PROOF. (card(rng FRO.m) + 2 <= 2*C.c + 1/\ Gcol.count + 1 <= C.c <= max_size){2});1:by auto=>/#. if=>//;last by auto=>/#. - swap{1}[2..4]-1. + swap{1}[3..5]-2. seq 3 2:(={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m, C.c,x0,hx2} /\ (G1.bcol{1} => G1.bcol{2}) /\ (card (rng FRO.m) + 1 <= 2 * C.c + 1/\ Gcol.count + 1 <= C.c <= max_size){2}). + auto;smt ml=0 w=card_rng_set. - seq 1 1: + seq 2 2: (={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m, C.c,x0,hx2,y0} /\ ((G1.bcol\/hinv FRO.m y0.`2 <> None){1} => G1.bcol{2}) /\ (card (rng FRO.m) + 1 <= 2 * C.c + 1 /\ Gcol.count <= C.c <= max_size){2});last by auto;smt ml=0 w=card_rng_set. - if=>//;inline Gcol.sample_c. + wp;if=>//;inline Gcol.sample_c. + rcondt{2}4. + auto;conseq (_:true)=>//;progress;2: smt ml=0. - cut /#:= fcard_image_leq fst (rng FRO.m{hr}). + by cut /#:= fcard_image_leq fst (rng FRO.m{hr}). wp;conseq (_: ={p,v,F.RO.m,y1} /\ y2{1}=c{2})=>//;1:smt ml=0 w=hinv_image. - sim. + by sim. rcondt{2}3. + by auto;progress;cut /#:= fcard_image_leq fst (rng FRO.m{hr}). - swap{2}2-1;sp 0 1;wp;conseq(_:y0{1}=(y1,c){2})=>//;1:smt ml=0 w=hinv_image. - transitivity{1} {y0 <- S.sample();} - (true ==> ={y0}) - (true ==> y0{1}=(y1,c){2})=>//;1:by inline*;auto. - transitivity{2} {(y1,c) <- S.sample2();} - (true==>y0{1}=(y1,c){2}) - (true==> ={y1,c})=>//;2:by inline*;auto. - by call sample_sample2;auto=> /=?[??]->. - + auto;progress;smt w=hinv_image. + + proc;sp 1 1;if=>//. inline G1(DRestr(D)).S.fi Gcol.S.fi. seq 2 2 : (={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m, diff --git a/proof/old/Gext.eca b/proof/old/Gext.eca index 6201a58..8ebfed0 100644 --- a/proof/old/Gext.eca +++ b/proof/old/Gext.eca @@ -53,13 +53,11 @@ module G2(D:DISTINGUISHER,HS:FRO) = { (p,v) <- oget G1.paths.[x.`2]; y1 <- F.RO.get (rcons p (v +^ x.`1)); y2 <$ cdistr; - y <- (y1, y2); - G1.paths.[y2] <- (rcons p (v +^ x.`1), y.`1); } else { - - y <$ dstate; + y1 <$ bdistr; + y2 <$ cdistr; } - (* exists x h, mem (dom G1.m) x /\ handles.[h] = Some (x.2, I) *) + y <- (y1, y2); handles_ <@ HS.restrK(); if (!mem (rng handles_) x.`2) { @@ -85,6 +83,10 @@ module G2(D:DISTINGUISHER,HS:FRO) = { G1.mi.[y] <- x; G1.mhi.[(y.`1, hy2)] <- (x.`1, hx2); } + if (mem (dom G1.paths) x.`2) { + (p,v) <- oget G1.paths.[x.`2]; + G1.paths.[y.`2] <- (rcons p (v +^ x.`1), y.`1); + } } else { y <- oget G1.m.[x]; } @@ -172,7 +174,7 @@ section. inv_ext1 G1.bext{1} G1.bext{2} G1.m{2} G1.mi{2} FRO.m{2} /\ (forall h, mem (dom FRO.m) h => h < G1.chandle){1}). + proc;if=>//;last by auto. - seq 1 1: (={F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.paths,G1.chandle,FRO.m,x,y} /\ + seq 2 2: (={F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.paths,G1.chandle,FRO.m,x,y} /\ inv_ext1 G1.bext{1} G1.bext{2} G1.m{2} G1.mi{2} FRO.m{2} /\ (forall h, mem (dom FRO.m) h => h < G1.chandle){1} /\ ! mem (dom G1.m{1}) x{1}). @@ -190,9 +192,13 @@ section. right;right;exists x', h;rewrite getP. by cut ->//:(h<> G1.chandle{mr});move:(Hhand h);rewrite in_dom H2 /#. by move:H0;rewrite dom_set !inE /#. + seq 1 1: (={x,y,F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.paths,G1.chandle,FRO.m} /\ + inv_ext1 G1.bext{1} G1.bext{2} G1.m{2} G1.mi{2} FRO.m{2} /\ + forall (h : handle), mem (dom FRO.m{1}) h => h < G1.chandle{1});2:by auto. if=>//. + inline *;rcondt{2} 4. + by move=> &m;auto;rewrite /in_dom_with. +(* auto=> |>. (* Bug ???? *) *) auto;progress. + by apply DWord.cdistr_ll. + rewrite /inv_ext1=>/H{H}[->//|[/in_rng[h]Hh|[[x1 x2] h [Hx Hh]]]]. @@ -345,12 +351,11 @@ section EXT. if (mem (dom G1.paths) x.`2) { (p,v) <- oget G1.paths.[x.`2]; y1 <- F.RO.get (rcons p (v +^ x.`1)); - y2 <$ cdistr; - y <- (y1, y2); - G1.paths.[y2] <- (rcons p (v +^ x.`1), y.`1); } else { - y <$ dstate; + y1 <$ bdistr; } + y2 <$ cdistr; + y <- (y1, y2); (* exists x h, mem (dom G1.m) x /\ handles.[h] = Some (x.2, I) *) handles_ <@ RRO.restrK(); @@ -377,6 +382,10 @@ section EXT. G1.mi.[y] <- x; G1.mhi.[(y.`1, hy2)] <- (x.`1, hx2); } + if (mem (dom G1.paths) x.`2) { + (p,v) <- oget G1.paths.[x.`2]; + G1.paths.[y.`2] <- (rcons p (v +^ x.`1), y.`1); + } } else { y <- oget G1.m.[x]; } @@ -528,7 +537,10 @@ section EXT. ={res,F.RO.m,FRO.m,G1.paths,G1.mh,G1.mhi,G1.m,G1.mi,G1.chandle,G1.bext,C.c} /\ inv_le G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2});last by auto=> /#. proc;if=>//;last by auto=>/#. - seq 1 1 : + seq 8 9 : (={x, y, F.RO.m, FRO.m, G1.paths, G1.mh, G1.mhi, G1.m, G1.mi, G1.chandle, + G1.bext, C.c} /\ + inv_le G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2});2:by auto. + seq 2 3 : (={y,x,F.RO.m,FRO.m,G1.paths,G1.mh,G1.mhi,G1.m,G1.mi,G1.chandle,G1.bext, C.c} /\ inv_lt G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2}). + by if=>//;auto;call (_: ={F.RO.m});auto. @@ -607,33 +619,33 @@ section EXT. apply ler_wpmul2r;1:by apply eps_ge0. by rewrite le_fromint;smt ml=0 w=max_ge0. + proc. - case ((size G1.m <= max_size /\ size G1.mi <= max_size /\ ReSample.count < max_size)); + case ((size G1.m < max_size /\ size G1.mi < max_size /\ ReSample.count < max_size)); [rcondt 2 | rcondf 2]; 1,3:by auto. - + wp;rnd (mem (image snd (dom G1.m `|` dom G1.mi)));skip=> &hr[#]?->/=???. - rewrite (Mu_mem.mu_mem (image snd (dom G1.m{hr}`|`dom G1.mi{hr})) cdistr (1%r/(2^c)%r))//. + + wp;rnd (mem (image snd (dom G1.m `|` dom G1.mi ) `|` fset1 x));skip=> &hr[#]?->/=???. + rewrite (Mu_mem.mu_mem + (image snd (dom G1.m{hr} `|` dom G1.mi{hr}) `|` fset1 x{hr}) + cdistr (1%r/(2^c)%r))//. + move=>x _;apply DWord.muxP. apply ler_wpmul2r;1:by apply divr_ge0=>//;apply /c_ge0r. - rewrite imageU fcardU le_fromint. + rewrite imageU !fcardU le_fromint fcard1. move:(fcard_image_leq snd (dom G1.m{hr}))(fcard_image_leq snd (dom G1.mi{hr})). rewrite -!sizeE;smt w=fcard_ge0. by hoare=>[??|];[apply eps_ge0|auto]. + by move=>c1;proc;auto=> &hr [^H 2->]/#. + by move=> b1 c1;proc;auto=> &hr [^H 2->]. + proc. - case ((size G1.m < max_size /\ size G1.mi < max_size /\ ReSample.count < max_size)); - [rcondt 2 | rcondf 2]; 1,3:by auto. - + wp;rnd (mem (image snd (dom G1.m `|` dom G1.mi ) `|` fset1 x));skip=> &hr[#]?->/=???. - rewrite (Mu_mem.mu_mem - (image snd (dom G1.m{hr} `|` dom G1.mi{hr}) `|` fset1 x{hr}) - cdistr (1%r/(2^c)%r))//. + case ((size G1.m <= max_size /\ size G1.mi <= max_size /\ ReSample.count < max_size)); + [rcondt 2 | rcondf 2];1,3:by auto. + + wp;rnd (mem (image snd (dom G1.m `|` dom G1.mi)));skip=> &hr[#]?->/=???. + rewrite (Mu_mem.mu_mem (image snd (dom G1.m{hr}`|`dom G1.mi{hr})) cdistr (1%r/(2^c)%r))//. + move=>x _;apply DWord.muxP. apply ler_wpmul2r;1:by apply divr_ge0=>//;apply /c_ge0r. - rewrite imageU !fcardU le_fromint fcard1. + rewrite imageU fcardU le_fromint. move:(fcard_image_leq snd (dom G1.m{hr}))(fcard_image_leq snd (dom G1.mi{hr})). rewrite -!sizeE;smt w=fcard_ge0. by hoare=>[??|];[apply eps_ge0|auto]. + by move=>c1;proc;auto=> &hr [^H 2->]/#. - by move=> b1 c1;proc;auto=> &hr [^H 2->]. + by move=> b1 c1;proc;auto=> &hr [^H 2->]. qed. axiom D_ll: diff --git a/proof/old/Handle.eca b/proof/old/Handle.eca index 7027bf0..22fa30a 100644 --- a/proof/old/Handle.eca +++ b/proof/old/Handle.eca @@ -56,13 +56,13 @@ module G1(D:DISTINGUISHER) = { (p,v) <- oget paths.[x.`2]; y1 <- F.RO.get (rcons p (v +^ x.`1)); y2 <$ cdistr; - y <- (y1, y2); - paths.[y2] <- (rcons p (v +^ x.`1), y.`1); } else { - y <$ dstate; + y1 <$ bdistr; + y2 <$ cdistr; + } + y <- (y1, y2); bext <- bext \/ mem (rng FRO.m) (x.`2, Unknown); - (* exists x2 h, handles.[h] = Some (X2,I) *) if (!(mem (rng FRO.m) (x.`2, Known))) { FRO.m.[chandle] <- (x.`2, Known); chandle <- chandle + 1; @@ -72,7 +72,6 @@ module G1(D:DISTINGUISHER) = { hy2 <- (oget mh.[(x.`1, hx2)]).`2; y <- (y.`1, (oget FRO.m.[hy2]).`1); FRO.m.[hy2] <- (y.`2, Known); - (* bad <- bad \/ mem X2 y.`2; *) m.[x] <- y; mi.[y] <- x; } else { @@ -85,6 +84,11 @@ module G1(D:DISTINGUISHER) = { mi.[y] <- x; mhi.[(y.`1, hy2)] <- (x.`1, hx2); } + if (mem (dom paths) x.`2) { + (p,v) <- oget paths.[x.`2]; + paths.[y.`2] <- (rcons p (v +^ x.`1), y.`1); + } + } else { y <- oget m.[x]; } @@ -96,7 +100,6 @@ module G1(D:DISTINGUISHER) = { if (!mem (dom mi) x) { bext <- bext \/ mem (rng FRO.m) (x.`2, Unknown); - (* exists x2 h, handles.[h] = Some (X2,I) *) if (!(mem (rng FRO.m) (x.`2, Known))) { FRO.m.[chandle] <- (x.`2, Known); chandle <- chandle + 1; @@ -108,7 +111,6 @@ module G1(D:DISTINGUISHER) = { (y1,hy2) <- oget mhi.[(x.`1, hx2)]; y <- (y.`1, (oget FRO.m.[hy2]).`1); FRO.m.[hy2] <- (y.`2, Known); - (* bad <- bad \/ mem X2 y.`2; *) mi.[x] <- y; m.[y] <- x; } else { @@ -426,6 +428,8 @@ section AUX. equiv CF_G1 : CF(D).main ~ G1(D).main: ={glob D} ==> !(G1.bcol \/ G1.bext){2} => ={res}. proof. + admit. +(* proc. call (_:(G1.bcol \/ G1.bext), INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} @@ -582,6 +586,7 @@ section AUX. + move: H; rewrite in_dom getP; case (h = 0)=> //=. by rewrite map0P. + by move: H1=> /H0 [#]. +*) qed. end section AUX. From 01be078242ac232882419735ec582465e4f25272 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Mon, 25 Jan 2016 14:31:25 +0100 Subject: [PATCH 134/525] split all sampling of y in two. --- proof/old/Gcol.eca | 17 ++++++----------- proof/old/Gext.eca | 44 ++++++++++++++++++++++++-------------------- proof/old/Handle.eca | 10 ++++++---- 3 files changed, 36 insertions(+), 35 deletions(-) diff --git a/proof/old/Gcol.eca b/proof/old/Gcol.eca index ef8c42c..78d8136 100644 --- a/proof/old/Gcol.eca +++ b/proof/old/Gcol.eca @@ -1,3 +1,4 @@ +pragma -oldip. require import Pred Fun Option Pair Int Real RealExtra StdOrder Ring StdBigop. require import List FSet NewFMap Utils Common SLCommon RndO FelTactic Mu_mem. (*...*) import Dprod Dexcepted Capacity IntOrder Bigreal RealOrder BRA. @@ -244,24 +245,18 @@ section PROOF. (card (rng FRO.m) + 1 <= 2 * C.c + 1 /\ Gcol.count + 1 <= C.c <= max_size){2}). + by auto;smt ml=0 w=card_rng_set. - seq 1 2: + seq 3 3: (={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m, - C.c,x0,hx2} /\ y0{1} = (y1,y2){2} /\ + C.c,x0,hx2,y0,y1,y2} /\ y0{1} = (y1,y2){1} /\ ((G1.bcol\/hinv FRO.m y0.`2 <> None){1} => G1.bcol{2}) /\ (card (rng FRO.m) + 1 <= 2 * C.c + 1 /\ Gcol.count <= C.c <= max_size){2});2:by auto;smt w=card_rng_set. inline Gcol.sample_c. rcondt{2}3. + by auto;progress;cut /#:= fcard_image_leq fst (rng FRO.m{hr}). - swap{2}2-1;sp 0 1;wp;conseq(_:y0{1}=(y1,c){2})=>//;1:smt ml=0 w=hinv_image. - transitivity{1} {y0 <- S.sample();} - (true ==> ={y0}) - (true ==> y0{1}=(y1,c){2})=>//;1:by inline*;auto. - transitivity{2} {(y1,c) <- S.sample2();} - (true==>y0{1}=(y1,c){2}) - (true==> ={y1,c})=>//;2:by inline*;auto. - by call sample_sample2;auto=> /=?[??]->. - +(* BUG: auto=> /> ?? Himp _ _ _ ?_?_ [/Himp->// | H]. marche pas ???? *) + auto=> /> ?? Himp _ _ _ ?_?_ [/Himp->// | X];right;apply hinv_image=> //. + + proc;sp 1 1;if=>//. inline G1(DRestr(D)).C.f Gcol.C.f. seq 5 5: diff --git a/proof/old/Gext.eca b/proof/old/Gext.eca index 8ebfed0..a38aff6 100644 --- a/proof/old/Gext.eca +++ b/proof/old/Gext.eca @@ -104,7 +104,9 @@ module G2(D:DISTINGUISHER,HS:FRO) = { } handles_ <@ HS.restrK(); hx2 <- oget (hinvc handles_ x.`2); - y <$ dstate; + y1 <$ bdistr; + y2 <$ cdistr; + y <- (y1,y2); t <@ HS.in_dom((oget G1.mhi.[(x.`1,hx2)]).`2, Unknown); if (mem (dom G1.mhi) (x.`1, hx2) /\ t) { (y1,hy2) <- oget G1.mhi.[(x.`1, hx2)]; @@ -220,7 +222,7 @@ section. by move:(H0 h);rewrite !in_dom Hh /#. + proc;if=>//;last by auto. - seq 4 6: + seq 6 8: (={F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.paths,G1.chandle,FRO.m,hx2,x,y,hx2} /\ t{2} = (in_dom_with FRO.m (oget G1.mhi.[(x.`1, hx2)]).`2 Unknown){1} /\ (G1.bext{1} => (G1.bext{2} \/ (mem (rng FRO.m) (x.`2, Unknown)){2} \/ @@ -229,10 +231,10 @@ section. ! mem (dom G1.mi{1}) x{1}). + inline *;auto=> &ml&mr[#]9!-> Hi Hhand -> /=. rewrite -dom_restr rng_restr /=;progress; 3:by smt ml=0. - + rewrite rng_set !inE rem_id 1:/#;move:H2=>[/Hi[->|[x' h][]HH1 HH2]|->]//. + + rewrite rng_set !inE rem_id 1:/#;move:H4=>[/Hi[->|[x' h][]HH1 HH2]|->]//. right;right;exists x', h;rewrite getP. by cut ->//:(h<> G1.chandle{mr});move:(Hhand h);rewrite in_dom HH2 /#. - by move:H2;rewrite dom_set !inE /#. + by move:H4;rewrite dom_set !inE /#. if=>//. + inline *;rcondt{2} 4. + by move=> &m;auto;rewrite /in_dom_with. @@ -403,7 +405,9 @@ section EXT. } handles_ <@ RRO.restrK(); hx2 <- oget (hinvc handles_ x.`2); - y <$ dstate; + y1 <$ bdistr; + y2 <$ cdistr; + y <- (y1,y2); t <@ RRO.in_dom((oget G1.mhi.[(x.`1,hx2)]).`2, Unknown); if (mem (dom G1.mhi) (x.`1, hx2) /\ t) { (y1,hy2) <- oget G1.mhi.[(x.`1, hx2)]; @@ -566,7 +570,7 @@ section EXT. ={res,F.RO.m,FRO.m,G1.paths,G1.mh,G1.mhi,G1.m,G1.mi,G1.chandle,G1.bext,C.c} /\ inv_le G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2});last by auto=> /#. proc;if=>//;last by auto=>/#. - seq 6 6 : + seq 8 8 : (={t,y,x,hx2,F.RO.m,FRO.m,G1.paths,G1.mh,G1.mhi,G1.m,G1.mi,G1.chandle,G1.bext, C.c} /\ inv_lt G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2} /\ (t => in_dom_with FRO.m (oget G1.mhi.[(x.`1, hx2)]).`2 Unknown){1}). @@ -619,33 +623,33 @@ section EXT. apply ler_wpmul2r;1:by apply eps_ge0. by rewrite le_fromint;smt ml=0 w=max_ge0. + proc. - case ((size G1.m < max_size /\ size G1.mi < max_size /\ ReSample.count < max_size)); - [rcondt 2 | rcondf 2]; 1,3:by auto. - + wp;rnd (mem (image snd (dom G1.m `|` dom G1.mi ) `|` fset1 x));skip=> &hr[#]?->/=???. - rewrite (Mu_mem.mu_mem - (image snd (dom G1.m{hr} `|` dom G1.mi{hr}) `|` fset1 x{hr}) - cdistr (1%r/(2^c)%r))//. + case ((size G1.m <= max_size /\ size G1.mi <= max_size /\ ReSample.count < max_size)); + [rcondt 2 | rcondf 2];1,3:by auto. + + wp;rnd (mem (image snd (dom G1.m `|` dom G1.mi)));skip=> &hr[#]?->/=???. + rewrite (Mu_mem.mu_mem (image snd (dom G1.m{hr}`|`dom G1.mi{hr})) cdistr (1%r/(2^c)%r))//. + move=>x _;apply DWord.muxP. apply ler_wpmul2r;1:by apply divr_ge0=>//;apply /c_ge0r. - rewrite imageU !fcardU le_fromint fcard1. + rewrite imageU fcardU le_fromint. move:(fcard_image_leq snd (dom G1.m{hr}))(fcard_image_leq snd (dom G1.mi{hr})). rewrite -!sizeE;smt w=fcard_ge0. by hoare=>[??|];[apply eps_ge0|auto]. + by move=>c1;proc;auto=> &hr [^H 2->]/#. - + by move=> b1 c1;proc;auto=> &hr [^H 2->]. + by move=> b1 c1;proc;auto=> &hr [^H 2->]. + proc. - case ((size G1.m <= max_size /\ size G1.mi <= max_size /\ ReSample.count < max_size)); - [rcondt 2 | rcondf 2];1,3:by auto. - + wp;rnd (mem (image snd (dom G1.m `|` dom G1.mi)));skip=> &hr[#]?->/=???. - rewrite (Mu_mem.mu_mem (image snd (dom G1.m{hr}`|`dom G1.mi{hr})) cdistr (1%r/(2^c)%r))//. + case ((size G1.m < max_size /\ size G1.mi < max_size /\ ReSample.count < max_size)); + [rcondt 2 | rcondf 2]; 1,3:by auto. + + wp;rnd (mem (image snd (dom G1.m `|` dom G1.mi ) `|` fset1 x));skip=> &hr[#]?->/=???. + rewrite (Mu_mem.mu_mem + (image snd (dom G1.m{hr} `|` dom G1.mi{hr}) `|` fset1 x{hr}) + cdistr (1%r/(2^c)%r))//. + move=>x _;apply DWord.muxP. apply ler_wpmul2r;1:by apply divr_ge0=>//;apply /c_ge0r. - rewrite imageU fcardU le_fromint. + rewrite imageU !fcardU le_fromint fcard1. move:(fcard_image_leq snd (dom G1.m{hr}))(fcard_image_leq snd (dom G1.mi{hr})). rewrite -!sizeE;smt w=fcard_ge0. by hoare=>[??|];[apply eps_ge0|auto]. + by move=>c1;proc;auto=> &hr [^H 2->]/#. - by move=> b1 c1;proc;auto=> &hr [^H 2->]. + by move=> b1 c1;proc;auto=> &hr [^H 2->]. qed. axiom D_ll: diff --git a/proof/old/Handle.eca b/proof/old/Handle.eca index 22fa30a..1794696 100644 --- a/proof/old/Handle.eca +++ b/proof/old/Handle.eca @@ -96,7 +96,7 @@ module G1(D:DISTINGUISHER) = { } proc fi(x : state): state = { - var y, y1, hx2, hy2; + var y, y1, y2, hx2, hy2; if (!mem (dom mi) x) { bext <- bext \/ mem (rng FRO.m) (x.`2, Unknown); @@ -105,19 +105,21 @@ module G1(D:DISTINGUISHER) = { chandle <- chandle + 1; } hx2 <- oget (hinvK FRO.m x.`2); - y <$ dstate; + y1 <$ bdistr; + y2 <$ cdistr; + y <- (y1,y2); if (mem (dom mhi) (x.`1,hx2) /\ in_dom_with FRO.m (oget mhi.[(x.`1,hx2)]).`2 Unknown) { (y1,hy2) <- oget mhi.[(x.`1, hx2)]; y <- (y.`1, (oget FRO.m.[hy2]).`1); - FRO.m.[hy2] <- (y.`2, Known); + FRO.m.[hy2] <- (y.`2, Known); mi.[x] <- y; m.[y] <- x; } else { bcol <- bcol \/ hinv FRO.m y.`2 <> None; hy2 <- chandle; chandle <- chandle + 1; - FRO.m.[hy2] <- (y.`2, Known); + FRO.m.[hy2] <- (y.`2, Known); mi.[x] <- y; mhi.[(x.`1, hx2)] <- (y.`1, hy2); m.[y] <- x; From 558673d47bb452bb0c6d9c718dfac3f7b24fb805 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Mon, 25 Jan 2016 14:44:55 +0100 Subject: [PATCH 135/525] improve RndO lemmas. --- proof/RndO.ec | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/proof/RndO.ec b/proof/RndO.ec index 2e8757f..5e0a450 100644 --- a/proof/RndO.ec +++ b/proof/RndO.ec @@ -192,7 +192,7 @@ qed. lemma RO_FRO_D (D<:RO_Distinguisher{RO,FRO}) : equiv [D(RO).distinguish ~ D(FRO).distinguish : ={glob D} /\ RO.m{1} = map (+fst) FRO.m{2} ==> - ={glob D} /\ RO.m{1} = map (+fst) FRO.m{2} ]. + ={res,glob D} /\ RO.m{1} = map (+fst) FRO.m{2} ]. proof. proc (RO.m{1} = map (+fst) FRO.m{2})=>//. + by conseq RO_FRO_init. + by conseq RO_FRO_get. + by conseq RO_FRO_set. @@ -626,7 +626,7 @@ qed. lemma LRO_RRO_D (D<:RO_Distinguisher{RO,FRO}) : equiv [D(LRO).distinguish ~ D(RRO).distinguish : ={glob D} /\ RO.m{1} = restr Known FRO.m{2} ==> - ={glob D} /\ RO.m{1} = restr Known FRO.m{2} ]. + ={res,glob D} /\ RO.m{1} = restr Known FRO.m{2} ]. proof. proc (RO.m{1} = restr Known FRO.m{2})=>//. + by conseq LRO_RRO_init. + by conseq LRO_RRO_get. + by conseq LRO_RRO_set. @@ -655,23 +655,23 @@ local module M = { lemma RO_LRO_D : equiv [D(RO).distinguish ~ D(LRO).distinguish : - ={glob D,RO.m} ==> ={glob D}]. + ={glob D,RO.m} ==> ={res,glob D}]. proof. transitivity M.main1 (={glob D} /\ FRO.m{2} = map (fun _ c => (c,Known)) RO.m{1} ==> - ={glob D}) + ={res,glob D}) (={glob D} /\ FRO.m{1} = map (fun _ c => (c,Known)) RO.m{2} ==> - ={glob D})=>//. + ={res,glob D})=>//. + by move=>?&mr[]2!->;exists (glob D){mr},(map(fun _ c =>(c,Known))RO.m{mr}). + proc*;inline M.main1;wp;call (RO_FRO_D D);inline *. rcondf{2}2;auto. + move=> &mr[]_->;apply mem_eq0=>z;rewrite -memE dom_restr /in_dom_with mapP dom_map in_dom. by case(RO.m{m}.[_]). - by move=>?&mr[]2!->/=;rewrite map_comp /fst/= map_id. + by move=>?&mr[]2!->/=;rewrite map_comp /fst/= map_id. transitivity M.main2 - (={glob D, FRO.m} ==> ={glob D}) + (={glob D, FRO.m} ==> ={res, glob D}) (={glob D} /\ FRO.m{1} = map (fun _ c => (c,Known)) RO.m{2} ==> - ={glob D})=>//. + ={res,glob D})=>//. + by move=>?&mr[]2!->;exists (glob D){mr},(map(fun _ c =>(c,Known))RO.m{mr}). + by proc; eager call (eager_D D);auto. proc*;inline M.main2;wp;call{1} RRO_resample_ll. From 403e826387f12127ffb4e0337d68c845c6b6bef1 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Mon, 25 Jan 2016 16:57:44 +0100 Subject: [PATCH 136/525] almost done. need to remove on test in C.f. --- proof/old/Gconcl.ec | 405 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 405 insertions(+) create mode 100644 proof/old/Gconcl.ec diff --git a/proof/old/Gconcl.ec b/proof/old/Gconcl.ec new file mode 100644 index 0000000..dccbcbc --- /dev/null +++ b/proof/old/Gconcl.ec @@ -0,0 +1,405 @@ +pragma -oldip. +require import Pred Fun Option Pair Int Real RealExtra StdOrder Ring StdBigop. +require import List FSet NewFMap Utils Common SLCommon RndO FelTactic Mu_mem. +(*...*) import Dprod Dexcepted Capacity IntOrder Bigreal RealOrder BRA. + +require (*..*) Gext. + +module IF = { + proc init = F.RO.init + proc f(p:block list) = { + var sa <- b0; + if (1 <= size p /\ p <> [b0]) { + sa <@ F.RO.get(p); + } + return sa; + } +}. + +module S(F : DFUNCTIONALITY) = { + var m, mi : smap + var paths : (capacity, block list * block) fmap + + proc init() = { + m <- map0; + mi <- map0; + (* the empty path is initially known by the adversary to lead to capacity 0^c *) + paths <- map0.[c0 <- ([<:block>],b0)]; + } + + proc f(x : state): state = { + var p, v, y, y1, y2; + + if (!mem (dom m) x) { + if (mem (dom paths) x.`2) { + (p,v) <- oget paths.[x.`2]; + y1 <- F.f (rcons p (v +^ x.`1)); + } else { + y1 <$ bdistr; + } + y2 <$ cdistr; + y <- (y1,y2); + m.[x] <- y; + mi.[y] <- x; + if (mem (dom paths) x.`2) { + (p,v) <- oget paths.[x.`2]; + paths.[y.`2] <- (rcons p (v +^ x.`1), y.`1); + } + } else { + y <- oget m.[x]; + } + return y; + } + + proc fi(x : state): state = { + var y, y1, y2; + + if (!mem (dom mi) x) { + y1 <$ bdistr; + y2 <$ cdistr; + y <- (y1,y2); + mi.[x] <- y; + m.[y] <- x; + } else { + y <- oget mi.[x]; + } + return y; + } + +}. + +section. + +declare module D: DISTINGUISHER{C, Perm, F.RO, F.FRO,S }. +local clone import Gext as Gext0. + +local module G3(RO:F.RO) = { + + module C = { + + proc f(p : block list): block = { + var sa, sa'; + var h, i <- 0; + sa <- b0; + if (1 <= size p /\ p <> [b0]) { + while (i < size p ) { + if (mem (dom G1.mh) (sa +^ nth witness p i, h)) { + RO.sample(take (i+1) p); + (sa, h) <- oget G1.mh.[(sa +^ nth witness p i, h)]; + } else { + RRO.sample(G1.chandle); + sa' <@ RO.get(take (i+1) p); + sa <- sa +^ nth witness p i; + G1.mh.[(sa,h)] <- (sa', G1.chandle); + G1.mhi.[(sa',G1.chandle)] <- (sa, h); + (sa,h) <- (sa',G1.chandle); + G1.chandle <- G1.chandle + 1; + } + i <- i + 1; + } + sa <- RO.get(p); + } + return sa; + } + } + + module S = { + + proc f(x : state): state = { + var p, v, y, y1, y2, hy2, hx2, handles_,t; + + if (!mem (dom G1.m) x) { + if (mem (dom G1.paths) x.`2) { + (p,v) <- oget G1.paths.[x.`2]; + y1 <- RO.get (rcons p (v +^ x.`1)); + } else { + y1 <$ bdistr; + } + y2 <$ cdistr; + y <- (y1, y2); + handles_ <@ RRO.restrK(); + if (!mem (rng handles_) x.`2) { + RRO.set(G1.chandle, x.`2); + G1.chandle <- G1.chandle + 1; + } + handles_ <- RRO.restrK(); + hx2 <- oget (hinvc handles_ x.`2); + t <@ RRO.in_dom((oget G1.mh.[(x.`1,hx2)]).`2, Unknown); + if (mem (dom G1.mh) (x.`1, hx2) /\ t) { + hy2 <- (oget G1.mh.[(x.`1, hx2)]).`2; + FRO.m.[hy2] <- (y2,Known); + G1.m.[x] <- y; + G1.mi.[y] <- x; + } else { + hy2 <- G1.chandle; + G1.chandle <- G1.chandle + 1; + RRO.set(hy2, y.`2); + G1.m.[x] <- y; + G1.mh.[(x.`1, hx2)] <- (y.`1, hy2); + G1.mi.[y] <- x; + G1.mhi.[(y.`1, hy2)] <- (x.`1, hx2); + } + if (mem (dom G1.paths) x.`2) { + (p,v) <- oget G1.paths.[x.`2]; + G1.paths.[y.`2] <- (rcons p (v +^ x.`1), y.`1); + } + } else { + y <- oget G1.m.[x]; + } + return y; + } + + proc fi(x : state): state = { + var y, y1, y2, hx2, hy2, handles_, t; + + if (!mem (dom G1.mi) x) { + handles_ <@ RRO.restrK(); + if (!mem (rng handles_) x.`2) { + RRO.set(G1.chandle, x.`2); + G1.chandle <- G1.chandle + 1; + } + handles_ <@ RRO.restrK(); + hx2 <- oget (hinvc handles_ x.`2); + t <@ RRO.in_dom((oget G1.mhi.[(x.`1,hx2)]).`2, Unknown); + y1 <$ bdistr; + y2 <$ cdistr; + y <- (y1,y2); + if (mem (dom G1.mhi) (x.`1, hx2) /\ t) { + (y1,hy2) <- oget G1.mhi.[(x.`1, hx2)]; + FRO.m.[hy2] <- (y2,Known); + G1.mi.[x] <- y; + G1.m.[y] <- x; + } else { + hy2 <- G1.chandle; + G1.chandle <- G1.chandle + 1; + RRO.set(hy2, y.`2); + G1.mi.[x] <- y; + G1.mhi.[(x.`1, hx2)] <- (y.`1, hy2); + G1.m.[y] <- x; + G1.mh.[(y.`1, hy2)] <- (x.`1, hx2); + } + } else { + y <- oget G1.mi.[x]; + } + return y; + } + + } + + proc distinguish(): bool = { + var b; + + RO.init(); + G1.m <- map0; + G1.mi <- map0; + G1.mh <- map0; + G1.mhi <- map0; + + (* the empty path is initially known by the adversary to lead to capacity 0^c *) + RRO.init(); + RRO.set(0,c0); + G1.paths <- map0.[c0 <- ([<:block>],b0)]; + G1.chandle <- 1; + b <@ DRestr(D,C,S).distinguish(); + return b; + } +}. + +local equiv G2_G3: Eager(G2(DRestr(D))).main2 ~ G3(F.LRO).distinguish : ={glob D} ==> ={res}. +proof. + proc;wp;call{1} RRO_resample_ll;inline *;wp. + call (_: ={FRO.m,F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.chandle,G1.paths,C.c}); last by auto. + + + proc;sp;if=> //. + call (_: ={FRO.m,F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.chandle,G1.paths,C.c});2:by auto. + if=> //;2:by sim. + swap{1} [3..7] -2;swap{2} [4..8] -3. + seq 5 5:(={hx2,t,x,FRO.m,F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.chandle,G1.paths,C.c} /\ + (t = in_dom_with FRO.m (oget G1.mh.[(x.`1, hx2)]).`2 Unknown){1}); + 1:by inline *;auto. + seq 3 4:(={y,x,FRO.m,F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.chandle,G1.paths,C.c}); + 2:by sim. + if=>//. + + seq 2 2:(={y1,hx2,t,x,FRO.m,F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.chandle,G1.paths,C.c} + /\ (t = in_dom_with FRO.m (oget G1.mh.[(x.`1, hx2)]).`2 Unknown){1}). + + by inline *;auto=> /> ? _;rewrite Block.DWord.bdistr_ll. + case ((mem (dom G1.mh) (x.`1, hx2) /\ t){1}); + [rcondt{1} 3;2:rcondt{2} 3| rcondf{1} 3;2:rcondf{2} 3]; + 1,2,4,5:(by move=>?;conseq (_:true);auto);2:by sim. + inline *;rcondt{1} 6;1:by auto=>/>. + wp;rnd;auto;progress[-split];rewrite DWord.cdistr_ll /= => ?_?->. + by rewrite !getP /= oget_some. + case ((mem (dom G1.mh) (x.`1, hx2) /\ t){1}); + [rcondt{1} 4;2:rcondt{2} 4| rcondf{1} 4;2:rcondf{2} 4]; + 1,2,4,5:(by move=>?;conseq (_:true);auto);2:by sim. + inline *;rcondt{1} 7;1:by auto=>/>. + wp;rnd;auto;rnd{1};auto;progress[-split]. + rewrite Block.DWord.supportP DWord.cdistr_ll /==> ?_?->. + by rewrite !getP /= oget_some. + + + proc;sp;if=>//. + call (_: ={FRO.m,F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.chandle,G1.paths,C.c});2:by auto. + if=> //;2:sim. + swap{1} 8 -3. + seq 6 6 : (={y1,hx2,t,x,FRO.m,F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.chandle,G1.paths,C.c} + /\ (t = in_dom_with FRO.m (oget G1.mhi.[(x.`1, hx2)]).`2 Unknown){1}). + + by inline *;auto. + case ((mem (dom G1.mhi) (x.`1, hx2) /\ t){1}); + [rcondt{1} 3;2:rcondt{2} 3| rcondf{1} 3;2:rcondf{2} 3]; + 1,2,4,5:(by move=>?;conseq (_:true);auto);2:by sim. + inline *;rcondt{1} 6;1:by auto=>/>. + wp;rnd;auto;progress[-split];rewrite DWord.cdistr_ll /= => ?_?->. + by rewrite !getP /= oget_some. + + proc;sp;if=>//. + call (_: ={FRO.m,F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.chandle,G1.paths,C.c});2:by auto. + by inline F.LRO.sample;sim. +qed. + +local equiv G3_G3: G3(F.LRO).distinguish ~ G3(F.RO).distinguish : ={glob G3,F.RO.m} ==> ={res}. +proof. symmetry;conseq (F.RO_LRO_D G3)=> //. qed. + +local module G4(RO:F.RO) = { + + module C = { + + proc f(p : block list): block = { + var sa; + var h, i <- 0; + sa <- b0; + if (1 <= size p /\ p <> [b0]) { + while (i < size p ) { + RO.sample(take (i+1) p); + i <- i + 1; + } + sa <- RO.get(p); + } + return sa; + } + } + + module S = { + + proc f(x : state): state = { + var p, v, y, y1, y2; + + if (!mem (dom G1.m) x) { + if (mem (dom G1.paths) x.`2) { + (p,v) <- oget G1.paths.[x.`2]; + y1 <- RO.get (rcons p (v +^ x.`1)); + } else { + y1 <$ bdistr; + } + y2 <$ cdistr; + y <- (y1,y2); + G1.m.[x] <- y; + G1.mi.[y] <- x; + if (mem (dom G1.paths) x.`2) { + (p,v) <- oget G1.paths.[x.`2]; + G1.paths.[y.`2] <- (rcons p (v +^ x.`1), y.`1); + } + } else { + y <- oget G1.m.[x]; + } + return y; + } + + proc fi(x : state): state = { + var y, y1, y2; + + if (!mem (dom G1.mi) x) { + y1 <$ bdistr; + y2 <$ cdistr; + y <- (y1,y2); + G1.mi.[x] <- y; + G1.m.[y] <- x; + } else { + y <- oget G1.mi.[x]; + } + return y; + } + + } + + proc distinguish(): bool = { + var b; + + RO.init(); + G1.m <- map0; + G1.mi <- map0; + (* the empty path is initially known by the adversary to lead to capacity 0^c *) + G1.paths <- map0.[c0 <- ([<:block>],b0)]; + b <@ DRestr(D,C,S).distinguish(); + return b; + } +}. + +local equiv G3_G4 : G3(F.RO).distinguish ~ G4(F.RO).distinguish : ={glob D} ==> ={res}. +proof. + proc;inline *;wp. + call (_: ={G1.m,G1.mi,G1.paths,F.RO.m,C.c});last by auto. + + proc;sp;if=>//. + call (_: ={G1.m,G1.mi,G1.paths,F.RO.m,C.c});last by auto. + if => //;2:sim. + seq 3 3: (={x,y1,y2,y,G1.m,G1.mi,G1.paths,F.RO.m,C.c});1:by sim. + sim;seq 5 0: (={x,y1,y2,y,G1.m,G1.mi,G1.paths,F.RO.m,C.c});1:by inline *;auto. + by if{1};sim;inline *;auto. + + proc;sp;if=>//. + call (_: ={G1.m,G1.mi,G1.paths,F.RO.m,C.c});last by auto. + if => //;2:sim. + seq 5 0: (={x,G1.m,G1.mi,G1.paths,F.RO.m,C.c});1:by inline *;auto. + seq 3 3: (={x,y1,y2,y,G1.m,G1.mi,G1.paths,F.RO.m,C.c});1:by sim. + by if{1};sim;inline *;auto. + proc;sp;if=>//. + call (_: ={G1.m,G1.mi,G1.paths,F.RO.m,C.c});last by auto. + sp;if=>//;sim; while(={i,p,F.RO.m})=>//. + inline F.RO.sample F.RO.get;if{1};1:by auto. + by sim;inline *;auto;progress;apply DWord.cdistr_ll. +qed. + +local equiv G4_G4 : G4(F.RO).distinguish ~ G4(F.LRO).distinguish : ={glob G4,F.RO.m} ==> ={res}. +proof. conseq (F.RO_LRO_D G4)=> //. qed. + +local equiv G4_Ideal : G4(F.LRO).distinguish ~ IdealIndif(IF,S,DRestr(D)).main : + ={glob D} ==> ={res}. +proof. + proc;inline *;wp. + call (_: ={C.c,F.RO.m} /\ G1.m{1}=S.m{2} /\ G1.mi{1}=S.mi{2} /\ G1.paths{1}=S.paths{2}). + + proc;sp;if=>//. + call (_: ={C.c,F.RO.m} /\ G1.m{1}=S.m{2} /\ G1.mi{1}=S.mi{2} /\ G1.paths{1}=S.paths{2}); + 2: by auto. + if=>//;sim;if=> //;2:by auto. + inline{2} IF.f;rcondt{2} 4. + + auto;progress. smt w=(size_rcons List.size_ge0). + admit. + by inline *;sim. + + by sim. + + proc;sp;if=>//. + call (_: ={F.RO.m});2:by auto. + sp;if=>//;sim. + by while{1} (true) (size p - i){1};auto;1:inline*;auto=>/#. + by auto. +qed. + +axiom D_ll : + forall (F <: DFUNCTIONALITY{D}) (P <: DPRIMITIVE{D}), + islossless P.f => + islossless P.fi => islossless F.f => islossless D(F, P).distinguish. + +lemma Real_Ideal &m: + Pr[GReal(D).main() @ &m: res /\ C.c <= max_size] <= + Pr[IdealIndif(IF,S,DRestr(D)).main() @ &m :res] + + ((max_size + 1) ^ 2)%r * mu dstate (pred1 witness) + + max_size%r * ((2*max_size)%r / (2^c)%r) + + max_size%r * ((2*max_size)%r / (2^c)%r). +proof. + apply (ler_trans _ _ _ (Real_G2 D D_ll &m)). + rewrite !(ler_add2l, ler_add2r);apply lerr_eq. + apply (eq_trans _ Pr[G3(F.LRO).distinguish() @ &m : res]);1:by byequiv G2_G3. + apply (eq_trans _ Pr[G3(F.RO ).distinguish() @ &m : res]);1:by byequiv G3_G3. + apply (eq_trans _ Pr[G4(F.RO ).distinguish() @ &m : res]);1:by byequiv G3_G4. + apply (eq_trans _ Pr[G4(F.LRO).distinguish() @ &m : res]);1:by byequiv G4_G4. + by byequiv G4_Ideal. +qed. + +end section. From b200a4814889ab8fb05c87c800be99cd0a5f5aae Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Mon, 25 Jan 2016 18:30:36 +0100 Subject: [PATCH 137/525] End of the last part of the proof. --- proof/old/Gcol.eca | 33 +++++++++---------- proof/old/Gconcl.ec | 73 +++++++++++++++---------------------------- proof/old/Gext.eca | 65 ++++++++++++++++++-------------------- proof/old/Handle.eca | 32 +++++++++---------- proof/old/SLCommon.ec | 9 +++--- 5 files changed, 89 insertions(+), 123 deletions(-) diff --git a/proof/old/Gcol.eca b/proof/old/Gcol.eca index 78d8136..8603f9f 100644 --- a/proof/old/Gcol.eca +++ b/proof/old/Gcol.eca @@ -52,24 +52,22 @@ section PROOF. var sa, sa', sc; var h, i <- 0; sa <- b0; - if (1 <= size p /\ p <> [b0]) { - while (i < size p ) { - if (mem (dom G1.mh) (sa +^ nth witness p i, h)) { - (sa, h) <- oget G1.mh.[(sa +^ nth witness p i, h)]; - } else { - sc <@ sample_c(); - sa' <- F.RO.get(take (i+1) p); - sa <- sa +^ nth witness p i; - G1.mh.[(sa,h)] <- (sa', G1.chandle); - G1.mhi.[(sa',G1.chandle)] <- (sa, h); - (sa,h) <- (sa',G1.chandle); - FRO.m.[G1.chandle] <- (sc,Unknown); - G1.chandle <- G1.chandle + 1; - } - i <- i + 1; + while (i < size p ) { + if (mem (dom G1.mh) (sa +^ nth witness p i, h)) { + (sa, h) <- oget G1.mh.[(sa +^ nth witness p i, h)]; + } else { + sc <@ sample_c(); + sa' <- F.RO.get(take (i+1) p); + sa <- sa +^ nth witness p i; + G1.mh.[(sa,h)] <- (sa', G1.chandle); + G1.mhi.[(sa',G1.chandle)] <- (sa, h); + (sa,h) <- (sa',G1.chandle); + FRO.m.[G1.chandle] <- (sc,Unknown); + G1.chandle <- G1.chandle + 1; } - sa <- F.RO.get(p); + i <- i + 1; } + sa <- F.RO.get(p); return sa; } } @@ -265,8 +263,7 @@ section PROOF. (G1.bcol{1} => G1.bcol{2}) /\ card (rng FRO.m{2}) + 2*(size p{2}) <= 2 * C.c{2} + 1 /\ Gcol.count{2} + size p{2} <= C.c{2} <= max_size);1:by auto=>/#. - wp;if=>//;2:by auto;smt ml=0 w=size_ge0. - call (_: ={F.RO.m});1:by sim. + wp;call (_: ={F.RO.m});1:by sim. while (={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m,C.c,b, p,h,i,sa} /\ (i <= size p){1} /\ diff --git a/proof/old/Gconcl.ec b/proof/old/Gconcl.ec index dccbcbc..a3d7948 100644 --- a/proof/old/Gconcl.ec +++ b/proof/old/Gconcl.ec @@ -7,13 +7,7 @@ require (*..*) Gext. module IF = { proc init = F.RO.init - proc f(p:block list) = { - var sa <- b0; - if (1 <= size p /\ p <> [b0]) { - sa <@ F.RO.get(p); - } - return sa; - } + proc f = F.RO.get }. module S(F : DFUNCTIONALITY) = { @@ -81,24 +75,22 @@ local module G3(RO:F.RO) = { var sa, sa'; var h, i <- 0; sa <- b0; - if (1 <= size p /\ p <> [b0]) { - while (i < size p ) { - if (mem (dom G1.mh) (sa +^ nth witness p i, h)) { - RO.sample(take (i+1) p); - (sa, h) <- oget G1.mh.[(sa +^ nth witness p i, h)]; - } else { - RRO.sample(G1.chandle); - sa' <@ RO.get(take (i+1) p); - sa <- sa +^ nth witness p i; - G1.mh.[(sa,h)] <- (sa', G1.chandle); - G1.mhi.[(sa',G1.chandle)] <- (sa, h); - (sa,h) <- (sa',G1.chandle); - G1.chandle <- G1.chandle + 1; - } - i <- i + 1; + while (i < size p ) { + if (mem (dom G1.mh) (sa +^ nth witness p i, h)) { + RO.sample(take (i+1) p); + (sa, h) <- oget G1.mh.[(sa +^ nth witness p i, h)]; + } else { + RRO.sample(G1.chandle); + sa' <@ RO.get(take (i+1) p); + sa <- sa +^ nth witness p i; + G1.mh.[(sa,h)] <- (sa', G1.chandle); + G1.mhi.[(sa',G1.chandle)] <- (sa, h); + (sa,h) <- (sa',G1.chandle); + G1.chandle <- G1.chandle + 1; } - sa <- RO.get(p); + i <- i + 1; } + sa <- RO.get(p); return sa; } } @@ -256,9 +248,6 @@ proof. by inline F.LRO.sample;sim. qed. -local equiv G3_G3: G3(F.LRO).distinguish ~ G3(F.RO).distinguish : ={glob G3,F.RO.m} ==> ={res}. -proof. symmetry;conseq (F.RO_LRO_D G3)=> //. qed. - local module G4(RO:F.RO) = { module C = { @@ -267,13 +256,11 @@ local module G4(RO:F.RO) = { var sa; var h, i <- 0; sa <- b0; - if (1 <= size p /\ p <> [b0]) { - while (i < size p ) { - RO.sample(take (i+1) p); - i <- i + 1; - } - sa <- RO.get(p); + while (i < size p ) { + RO.sample(take (i+1) p); + i <- i + 1; } + sa <- RO.get(p); return sa; } } @@ -352,31 +339,20 @@ proof. by if{1};sim;inline *;auto. proc;sp;if=>//. call (_: ={G1.m,G1.mi,G1.paths,F.RO.m,C.c});last by auto. - sp;if=>//;sim; while(={i,p,F.RO.m})=>//. + sp;sim; while(={i,p,F.RO.m})=>//. inline F.RO.sample F.RO.get;if{1};1:by auto. by sim;inline *;auto;progress;apply DWord.cdistr_ll. qed. -local equiv G4_G4 : G4(F.RO).distinguish ~ G4(F.LRO).distinguish : ={glob G4,F.RO.m} ==> ={res}. -proof. conseq (F.RO_LRO_D G4)=> //. qed. - local equiv G4_Ideal : G4(F.LRO).distinguish ~ IdealIndif(IF,S,DRestr(D)).main : ={glob D} ==> ={res}. proof. proc;inline *;wp. call (_: ={C.c,F.RO.m} /\ G1.m{1}=S.m{2} /\ G1.mi{1}=S.mi{2} /\ G1.paths{1}=S.paths{2}). - + proc;sp;if=>//. - call (_: ={C.c,F.RO.m} /\ G1.m{1}=S.m{2} /\ G1.mi{1}=S.mi{2} /\ G1.paths{1}=S.paths{2}); - 2: by auto. - if=>//;sim;if=> //;2:by auto. - inline{2} IF.f;rcondt{2} 4. - + auto;progress. smt w=(size_rcons List.size_ge0). - admit. - by inline *;sim. - + by sim. + + by sim. + by sim. + proc;sp;if=>//. call (_: ={F.RO.m});2:by auto. - sp;if=>//;sim. + inline F.LRO.get F.FRO.sample;wp 7 2;sim. by while{1} (true) (size p - i){1};auto;1:inline*;auto=>/#. by auto. qed. @@ -396,9 +372,10 @@ proof. apply (ler_trans _ _ _ (Real_G2 D D_ll &m)). rewrite !(ler_add2l, ler_add2r);apply lerr_eq. apply (eq_trans _ Pr[G3(F.LRO).distinguish() @ &m : res]);1:by byequiv G2_G3. - apply (eq_trans _ Pr[G3(F.RO ).distinguish() @ &m : res]);1:by byequiv G3_G3. + apply (eq_trans _ Pr[G3(F.RO ).distinguish() @ &m : res]). + + by byequiv (_: ={glob G3, F.RO.m} ==> _)=>//;symmetry;conseq (F.RO_LRO_D G3). apply (eq_trans _ Pr[G4(F.RO ).distinguish() @ &m : res]);1:by byequiv G3_G4. - apply (eq_trans _ Pr[G4(F.LRO).distinguish() @ &m : res]);1:by byequiv G4_G4. + apply (eq_trans _ Pr[G4(F.LRO).distinguish() @ &m : res]);1:by byequiv (F.RO_LRO_D G4). by byequiv G4_Ideal. qed. diff --git a/proof/old/Gext.eca b/proof/old/Gext.eca index a38aff6..102c49b 100644 --- a/proof/old/Gext.eca +++ b/proof/old/Gext.eca @@ -22,23 +22,21 @@ module G2(D:DISTINGUISHER,HS:FRO) = { var sa, sa'; var h, i <- 0; sa <- b0; - if (1 <= size p /\ p <> [b0]) { - while (i < size p ) { - if (mem (dom G1.mh) (sa +^ nth witness p i, h)) { - (sa, h) <- oget G1.mh.[(sa +^ nth witness p i, h)]; - } else { - HS.sample(G1.chandle); - sa' <@ F.RO.get(take (i+1) p); - sa <- sa +^ nth witness p i; - G1.mh.[(sa,h)] <- (sa', G1.chandle); - G1.mhi.[(sa',G1.chandle)] <- (sa, h); - (sa,h) <- (sa',G1.chandle); - G1.chandle <- G1.chandle + 1; - } - i <- i + 1; + while (i < size p ) { + if (mem (dom G1.mh) (sa +^ nth witness p i, h)) { + (sa, h) <- oget G1.mh.[(sa +^ nth witness p i, h)]; + } else { + HS.sample(G1.chandle); + sa' <@ F.RO.get(take (i+1) p); + sa <- sa +^ nth witness p i; + G1.mh.[(sa,h)] <- (sa', G1.chandle); + G1.mhi.[(sa',G1.chandle)] <- (sa, h); + (sa,h) <- (sa',G1.chandle); + G1.chandle <- G1.chandle + 1; } - sa <- F.RO.get(p); + i <- i + 1; } + sa <- F.RO.get(p); return sa; } } @@ -262,7 +260,7 @@ section. conseq (_: ={sa,G1.mh,G1.mhi,F.RO.m, G1.chandle, FRO.m} /\ inv_ext1 G1.bext{1} G1.bext{2} G1.m{2} G1.mi{2} FRO.m{2} /\ forall (h0 : handle), mem (dom FRO.m{1}) h0 => h0 < G1.chandle{1})=>//. - sp 3 3;if=>//;call (_: ={F.RO.m});1:by sim. + sp 3 3;call (_: ={F.RO.m});1:by sim. while (={sa,G1.mh,G1.mhi,F.RO.m,G1.chandle,FRO.m,i,h,sa,p} /\ inv_ext1 G1.bext{1} G1.bext{2} G1.m{2} G1.mi{2} FRO.m{2} /\ forall (h0 : handle), mem (dom FRO.m{1}) h0 => h0 < G1.chandle{1})=>//. @@ -323,23 +321,21 @@ section EXT. var sa, sa'; var h, i <- 0; sa <- b0; - if (1 <= size p /\ p <> [b0]) { - while (i < size p ) { - if (mem (dom G1.mh) (sa +^ nth witness p i, h)) { - (sa, h) <- oget G1.mh.[(sa +^ nth witness p i, h)]; - } else { - RRO.sample(G1.chandle); - sa' <@ F.RO.get(take (i+1) p); - sa <- sa +^ nth witness p i; - G1.mh.[(sa,h)] <- (sa', G1.chandle); - G1.mhi.[(sa',G1.chandle)] <- (sa, h); - (sa,h) <- (sa',G1.chandle); - G1.chandle <- G1.chandle + 1; - } - i <- i + 1; + while (i < size p ) { + if (mem (dom G1.mh) (sa +^ nth witness p i, h)) { + (sa, h) <- oget G1.mh.[(sa +^ nth witness p i, h)]; + } else { + RRO.sample(G1.chandle); + sa' <@ F.RO.get(take (i+1) p); + sa <- sa +^ nth witness p i; + G1.mh.[(sa,h)] <- (sa', G1.chandle); + G1.mhi.[(sa',G1.chandle)] <- (sa, h); + (sa,h) <- (sa',G1.chandle); + G1.chandle <- G1.chandle + 1; } - sa <- F.RO.get(p); + i <- i + 1; } + sa <- F.RO.get(p); return sa; } } @@ -588,19 +584,18 @@ section EXT. + proc;sp 1 1;if=>//. inline G2(DRestr(D), RRO).C.f Gext.C.f. - sp 5 5;elim *=> c0L c0R;if => //;last by auto;smt w=List.size_ge0. + sp 5 5;elim *=> c0L c0R. wp;call (_: ={F.RO.m});1:by sim. while (={i,p,G1.mh,sa,h,FRO.m,F.RO.m,G1.mh,G1.mhi,G1.chandle} /\ 0 <= i{1} <= size p{1}/\ c0R + size p{1} <= max_size /\ - inv_le G1.m{2} G1.mi{2} (c0R + i){2} FRO.m{2} ReSample.count{2});last by auto=>/#. + inv_le G1.m{2} G1.mi{2} (c0R + i){2} FRO.m{2} ReSample.count{2}); + last by auto;smt w=List.size_ge0. if=> //;1:by auto=>/#. auto;call (_: ={F.RO.m});1:by sim. - (*inline *;auto=>/> ?&mr. BUG anomaly: EcLowGoal.InvalidProofTerm *) inline *;auto=> ?&mr [#]!->@/inv_le Hi [#]. case (p{mr})=> [/#|/=p1 p2] 4?_ /= 2?-> /=;split=>/= Hmem 4? [#]2->/= => [|/#]. by rewrite restr_set /= size_set dom_restr /in_dom_with Hmem/= /#. - (* auto=> />. BUG *) auto;progress[delta];rewrite ?(size0,restr0,restr_set,rem0,max_ge0,-sizeE,-cardE) //=. + smt ml=0. + smt ml=0. + smt ml=0. + elim H7=>// [[x h] [#]];rewrite -memE dom_restr /in_dom_with in_dom=> _ ->/=. diff --git a/proof/old/Handle.eca b/proof/old/Handle.eca index 1794696..944b652 100644 --- a/proof/old/Handle.eca +++ b/proof/old/Handle.eca @@ -23,25 +23,23 @@ module G1(D:DISTINGUISHER) = { var sa, sa', sc; var h, i <- 0; sa <- b0; - if (1 <= size p /\ p <> [b0]) { - while (i < size p ) { - if (mem (dom mh) (sa +^ nth witness p i, h)) { - (sa, h) <- oget mh.[(sa +^ nth witness p i, h)]; - } else { - sc <$ cdistr; - bcol <- bcol \/ hinv FRO.m sc <> None; - sa' <@ F.RO.get(take (i+1) p); - sa <- sa +^ nth witness p i; - mh.[(sa,h)] <- (sa', chandle); - mhi.[(sa',chandle)] <- (sa, h); - (sa,h) <- (sa',chandle); - FRO.m.[chandle] <- (sc,Unknown); - chandle <- chandle + 1; - } - i <- i + 1; + while (i < size p ) { + if (mem (dom mh) (sa +^ nth witness p i, h)) { + (sa, h) <- oget mh.[(sa +^ nth witness p i, h)]; + } else { + sc <$ cdistr; + bcol <- bcol \/ hinv FRO.m sc <> None; + sa' <@ F.RO.get(take (i+1) p); + sa <- sa +^ nth witness p i; + mh.[(sa,h)] <- (sa', chandle); + mhi.[(sa',chandle)] <- (sa, h); + (sa,h) <- (sa',chandle); + FRO.m.[chandle] <- (sc,Unknown); + chandle <- chandle + 1; } - sa <- F.RO.get(p); + i <- i + 1; } + sa <- F.RO.get(p); return sa; } } diff --git a/proof/old/SLCommon.ec b/proof/old/SLCommon.ec index 2073e0f..ec26f5c 100644 --- a/proof/old/SLCommon.ec +++ b/proof/old/SLCommon.ec @@ -48,12 +48,11 @@ module SqueezelessSponge (P:DPRIMITIVE): FUNCTIONALITY = { proc f(p : block list): block = { var (sa,sc) <- (b0,c0); - if (1 <= size p (*/\ p <> [b0]*)) { - while (p <> []) { (* Absorption *) - (sa,sc) <@ P.f((sa +^ head witness p,sc)); - p <- behead p; - } + while (p <> []) { (* Absorption *) + (sa,sc) <@ P.f((sa +^ head witness p,sc)); + p <- behead p; } + return sa; (* Squeezing phase (non-iterated) *) } }. From 04c9bd688625c66a3d83223b6ad9fb315e112845 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Tue, 26 Jan 2016 14:36:27 +0100 Subject: [PATCH 138/525] Fixing defs and proofs w.r.t new distributions. --- proof/LazyRP.eca | 10 ++++------ proof/old/ConcreteF.eca | 8 ++++---- 2 files changed, 8 insertions(+), 10 deletions(-) diff --git a/proof/LazyRP.eca b/proof/LazyRP.eca index 012268d..b262f0d 100644 --- a/proof/LazyRP.eca +++ b/proof/LazyRP.eca @@ -19,7 +19,7 @@ module P : RP, RP_ = { var y; if (!mem (dom m) x) { - y <$ d \ rng m; + y <$ d \ (mem (rng m)); m.[x] <- y; mi.[y] <- x; } @@ -30,7 +30,7 @@ module P : RP, RP_ = { var y; if (!mem (dom mi) x) { - y <$ d \ rng mi; + y <$ d \ (mem (rng mi)); mi.[x] <- y; m.[y] <- x; } @@ -45,14 +45,12 @@ lemma P_f_ll: is_lossless d => support d = predT => islossless P.f. proof. move=> d_ll d_fu; proc; if=> //=; auto=> &m /= x_notin_m. have h:= endo_dom_rng P.m{m} _; first by exists x{m}. -apply/lossless_restr; first by rewrite d_ll. -smt. (* needs help *) +apply/dexcepted_ll=> //; smt. (* needs help *) qed. lemma P_fi_ll: is_lossless d => support d = predT => islossless P.fi. proof. move=> d_ll d_fu; proc; if=> //=; auto=> &m /= x_notin_m. have h:= endo_dom_rng P.mi{m} _; first by exists x{m}. -apply/lossless_restr; first by rewrite d_ll. -smt. (* needs help *) +apply/dexcepted_ll=> //; smt. (* needs help *) qed. diff --git a/proof/old/ConcreteF.eca b/proof/old/ConcreteF.eca index 23e2ba1..20ad629 100644 --- a/proof/old/ConcreteF.eca +++ b/proof/old/ConcreteF.eca @@ -120,15 +120,15 @@ section. + exact/Block.DWord.bdistr_ll. exact/Capacity.DWord.cdistr_ll. + apply/fun_ext=> x; rewrite Dprod.supp_def /bdistr /cdistr. - rewrite -/(Distr.support _ _) NewDistr.MUniform.support_duniform Block.enumP. - by rewrite -/(Distr.support _ _) NewDistr.MUniform.support_duniform Capacity.enumP. + rewrite -/(Distr.support _ _) NewDistr.MUniform.duniform_fu Block.enumP. + by rewrite -/(Distr.support _ _) NewDistr.MUniform.duniform_fu Capacity.enumP. have pi_ll := P_fi_ll _ _. + apply/Dprod.lossless. + exact/Block.DWord.bdistr_ll. exact/Capacity.DWord.cdistr_ll. + apply/fun_ext=> x; rewrite Dprod.supp_def /bdistr /cdistr. - rewrite -/(Distr.support _ _) NewDistr.MUniform.support_duniform Block.enumP. - by rewrite -/(Distr.support _ _) NewDistr.MUniform.support_duniform Capacity.enumP. + rewrite -/(Distr.support _ _) NewDistr.MUniform.duniform_fu Block.enumP. + by rewrite -/(Distr.support _ _) NewDistr.MUniform.duniform_fu Capacity.enumP. have f_ll : islossless SqueezelessSponge(Perm).f. + proc; sp; if=> //=. while true (size p) (size p) 1%r=> //=. From df2f9d16188d0425842e5fd5cc6547e4344d0484 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Tue, 26 Jan 2016 15:28:46 +0100 Subject: [PATCH 139/525] Pushing ConcreteF back through. --- proof/old/ConcreteF.eca | 20 +++++++------------- 1 file changed, 7 insertions(+), 13 deletions(-) diff --git a/proof/old/ConcreteF.eca b/proof/old/ConcreteF.eca index 20ad629..b100f1a 100644 --- a/proof/old/ConcreteF.eca +++ b/proof/old/ConcreteF.eca @@ -91,7 +91,6 @@ section. rcondt{2} 4; 1: by auto=> /#. by wp; call (_: true); auto. + proc; sp; if=> //=; inline *. - sp; if=> //=; last by wp; auto; smt w=size_ge0. wp; while ( ={glob C, glob P, p, sa, sc} /\ C.c{2} <= max_size /\ DBounder.FBounder.c{2} = C.c{2} - size p{2}). @@ -110,11 +109,9 @@ section. res /\ C.c <= max_size] = Pr[GReal'.main()@ &m: res/\ C.c <= max_size]. + byequiv=>//;proc;inline *;call (_: ={C.c,glob Perm});last by auto. + by sim. + by sim. - proc;inline *;sp 1 0;if{1};wp;[rcondt{2}5|rcondf{2}5];1,3:by auto. - + while (={glob Perm,sc,sa,p} /\ (C.c + size p){1} = C.c{2});2:by auto. - by wp;sp 1 1;if{2};[rcondt{1} 3|rcondf{1} 3];auto; - progress;rewrite size_behead//;ring. - by auto; smt w=size_ge0. + proc; inline *; wp. + while (={glob Perm,sc,sa,p} /\ (C.c + size p){1} = C.c{2});2:by auto. + by sp; if=> //=; auto=> /> &2 cL /size_behead=> ->; progress; ring. have p_ll := P_f_ll _ _. + apply/Dprod.lossless. + exact/Block.DWord.bdistr_ll. @@ -130,12 +127,9 @@ section. rewrite -/(Distr.support _ _) NewDistr.MUniform.duniform_fu Block.enumP. by rewrite -/(Distr.support _ _) NewDistr.MUniform.duniform_fu Capacity.enumP. have f_ll : islossless SqueezelessSponge(Perm).f. - + proc; sp; if=> //=. - while true (size p) (size p) 1%r=> //=. - * smt w=(size_ge0 size_eq0). - * by move=> hind; seq 2: true 1%r 1%r 0%r _=> //=; wp; call p_ll. - * by wp; call p_ll. - by move=> z; conseq (_: _ : =1%r); wp; call p_ll; skip; smt w=size_behead. + + proc; while true (size p)=> //=. + * by move=> z; wp; call p_ll; skip=> /> &hr /size_behead /#. + by auto; smt w=size_ge0. apply (ler_trans _ _ _ (Pr_restr Perm SqueezelessSponge D p_ll pi_ll f_ll D_ll &m)). have ->: Pr[Indif(SqueezelessSponge(Perm), Perm, DRestr(D)).main() @ &m: res] @@ -155,7 +149,7 @@ section. + apply D_ll. + by proc; sp; if=> //=; call O_f_ll; auto. + by proc; sp; if=> //=; call O_fi_ll; auto. - + proc; inline *; sp; if=> //=; sp; if=> //=; auto. + + proc; inline *; sp; if=> //=; auto. while true (size p). * by auto; call O_f_ll; auto=> /#. by auto; smt w=size_ge0. From 73038f075ecae4197f99fb2cedac55125a0fc3f1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Tue, 26 Jan 2016 15:40:38 +0100 Subject: [PATCH 140/525] ConcreteF: split sampling. --- proof/old/ConcreteF.eca | 45 ++++++++++++++++++++++++++++++++--------- 1 file changed, 36 insertions(+), 9 deletions(-) diff --git a/proof/old/ConcreteF.eca b/proof/old/ConcreteF.eca index b100f1a..304840e 100644 --- a/proof/old/ConcreteF.eca +++ b/proof/old/ConcreteF.eca @@ -14,23 +14,25 @@ module PF = { } proc f(x : state): state = { - var y; + var y1, y2; if (!mem (dom m) x) { - y <$ dstate; - m.[x] <- y; - mi.[y] <- x; + y1 <$ bdistr; + y2 <$ cdistr; + m.[x] <- (y1,y2); + mi.[(y1,y2)] <- x; } return oget m.[x]; } proc fi(x : state): state = { - var y; + var y1, y2; if (!mem (dom mi) x) { - y <$ dstate; - mi.[x] <- y; - m.[y] <- x; + y1 <$ bdistr; + y2 <$ cdistr; + mi.[x] <- (y1,y2); + m.[(y1,y2)] <- x; } return oget mi.[x]; } @@ -100,6 +102,12 @@ section. by wp; call (_: true). qed. + local clone import Sample with + type t1 <- block, + op d1 <- bdistr, + type t2 <- capacity, + op d2 <- cdistr. + lemma Real_Concrete &m : Pr[GReal(D).main()@ &m: res /\ C.c <= max_size] <= Pr[CF(DRestr(D)).main()@ &m: res] + ((max_size + 1) ^ 2)%r * mu dstate (pred1 witness). @@ -142,7 +150,26 @@ section. = Pr[PRPt.IND(ARP,DBounder(D')).main() @ &m: res]. + rewrite -(DoubleBounding ARP &m). byequiv=> //=; proc; inline *; sim (_: ={m,mi}(PF,ARP)). - * by proc; if=> //=; auto. + * proc; if=> //=; auto; conseq (_: true ==> (y1,y2){1} = x{2})=> //=. + transitivity{1} { (y1,y2) <@ S.sample2(); } + (true ==> ={y1,y2}) + (true ==> (y1,y2){1} = x{2})=> //=. + - by inline *; auto. + transitivity{2} { x <@ S.sample(); } + (true ==> (y1,y2){1} = x{2}) + (true ==> ={x})=> //=. + - by symmetry; call sample_sample2; skip=> /> []. + by inline *; auto. + proc; if=> //=; auto; conseq (_: true ==> (y1,y2){1} = y{2})=> //=. + transitivity{1} { (y1,y2) <@ S.sample2(); } + (true ==> ={y1,y2}) + (true ==> (y1,y2){1} = y{2})=> //=. + - by inline *; auto. + transitivity{2} { y <@ S.sample(); } + (true ==> (y1,y2){1} = y{2}) + (true ==> ={y})=> //=. + - by symmetry; call sample_sample2; skip=> /> []. + by inline *; auto. have /#:= Conclusion D' &m _. move=> O O_f_ll O_fi_ll. proc; call (_: true)=> //=. From d954a2ece8691e9ac8a2a1292de3cfc075701863 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Tue, 26 Jan 2016 19:38:06 +0100 Subject: [PATCH 141/525] Update files that are still relevant. This is to stick to latest revision of stdlib. --- proof/Common.ec | 6 +++--- proof/RndO.ec | 4 ++-- proof/RndOrcl.eca | 6 +++--- proof/old/ConcreteF.eca | 18 +++++++++--------- proof/old/Gcol.eca | 3 ++- proof/old/Gconcl.ec | 3 ++- proof/old/Gext.eca | 3 ++- proof/old/Handle.eca | 3 ++- proof/old/SLCommon.ec | 8 ++++---- proof/variant/RndOrcl.eca | 4 ++-- 10 files changed, 31 insertions(+), 27 deletions(-) diff --git a/proof/Common.ec b/proof/Common.ec index 115c5ce..51bf821 100644 --- a/proof/Common.ec +++ b/proof/Common.ec @@ -1,9 +1,9 @@ (*------------------- Common Definitions and Lemmas --------------------*) require import Option Fun Pair Int IntExtra IntDiv Real List NewDistr. -require import Ring StdRing StdOrder StdBigop BitEncoding. +require import Ring StdRing StdOrder StdBigop BitEncoding DProd. require (*--*) FinType BitWord LazyRP Monoid. -(*---*) import IntID IntOrder Bigint Bigint.BIA IntDiv Dprod. +(*---*) import IntID IntOrder Bigint Bigint.BIA IntDiv. require import NewLogic. pragma +implicits. @@ -87,7 +87,7 @@ qed. clone export LazyRP as Perm with type D <- block * capacity, - op d <- bdistr * Capacity.cdistr + op d <- bdistr `*` Capacity.cdistr rename [module type] "RP" as "PRIMITIVE" [module] "P" as "Perm". diff --git a/proof/RndO.ec b/proof/RndO.ec index 5e0a450..367870b 100644 --- a/proof/RndO.ec +++ b/proof/RndO.ec @@ -1,5 +1,5 @@ pragma -oldip. -require import Pair Option List FSet NewFMap. +require import Pair Option List FSet NewFMap NewDistr. import NewLogic Fun. require IterProc. @@ -168,7 +168,7 @@ proof. by proc;auto=>/=;rewrite map_map0. qed. equiv RO_FRO_get : RO.get ~ FRO.get : ={x} /\ RO.m{1} = map (+fst) FRO.m{2} ==> ={res} /\ RO.m{1} = map (+fst) FRO.m{2}. -proof. +proof. proc;auto=>?&ml[]->->/=?->/=. rewrite !dom_map !map_set/fst/= getP_eq oget_some;progress. + by rewrite mapP oget_omap_some // -in_dom. diff --git a/proof/RndOrcl.eca b/proof/RndOrcl.eca index 4b15b5c..07fd6ba 100644 --- a/proof/RndOrcl.eca +++ b/proof/RndOrcl.eca @@ -1,4 +1,4 @@ -require import Option FSet NewFMap. +require import Option FSet NewFMap NewDistr. (* TODO move this in NewFMap *) lemma dom_set (m:('a,'b) fmap) a b : dom m.[a<-b] = dom m `|` fset1 a. proof. by apply fsetP=> x;smt. qed. @@ -45,7 +45,7 @@ abstract theory Ideal. section LL. - axiom sample_ll : forall x, Distr.weight (sample x) = 1%r. + axiom sample_ll : forall x, weight (sample x) = 1%r. lemma f_ll : phoare[RO.f : true ==> true] = 1%r. proof. proc;auto;progress;apply sample_ll. qed. @@ -149,7 +149,7 @@ abstract theory GenIdeal. + case ((pick work = x){2})=> pick_x; last smt. subst x{2}; move: H7 H1; rewrite -neqF /eq_except=> -> /= eq_exc. by apply fmapP=> x0; case (pick work{2} = x0); smt. - by auto; smt. + by auto; smt w=@NewFMap. by auto;progress [-split];rewrite H0 /= getP_eq;smt. qed. diff --git a/proof/old/ConcreteF.eca b/proof/old/ConcreteF.eca index 304840e..73cf914 100644 --- a/proof/old/ConcreteF.eca +++ b/proof/old/ConcreteF.eca @@ -1,7 +1,7 @@ require import Pred Fun Option Pair Int Real StdOrder Ring. -require import List FSet NewFMap Utils Common SLCommon. +require import List FSet NewFMap Utils Common SLCommon DProd Dexcepted. -(*...*) import Dprod Dexcepted Capacity IntOrder RealOrder. +(*...*) import Capacity IntOrder RealOrder. require (*..*) Strong_RP_RF. @@ -61,9 +61,9 @@ section. realize gt0_q by smt w=max_ge0. realize uD_uf_fu. split. - case=> [x y]; rewrite Dprod.supp_def /fst /snd /=. + case=> [x y]; rewrite support_dprod /=. by rewrite Block.DWord.supportP Capacity.DWord.supportP. - apply/dprodU. + apply/dprod_uf. by rewrite Block.DWord.bdistr_uf. by rewrite Capacity.DWord.cdistr_uf. qed. @@ -102,7 +102,7 @@ section. by wp; call (_: true). qed. - local clone import Sample with + local clone import ProdSampling with type t1 <- block, op d1 <- bdistr, type t2 <- capacity, @@ -121,17 +121,17 @@ section. while (={glob Perm,sc,sa,p} /\ (C.c + size p){1} = C.c{2});2:by auto. by sp; if=> //=; auto=> /> &2 cL /size_behead=> ->; progress; ring. have p_ll := P_f_ll _ _. - + apply/Dprod.lossless. + + apply/dprod_ll; split. + exact/Block.DWord.bdistr_ll. exact/Capacity.DWord.cdistr_ll. - + apply/fun_ext=> x; rewrite Dprod.supp_def /bdistr /cdistr. + + apply/fun_ext=>- [] a b; rewrite support_dprod. rewrite -/(Distr.support _ _) NewDistr.MUniform.duniform_fu Block.enumP. by rewrite -/(Distr.support _ _) NewDistr.MUniform.duniform_fu Capacity.enumP. have pi_ll := P_fi_ll _ _. - + apply/Dprod.lossless. + + apply/dprod_ll; split. + exact/Block.DWord.bdistr_ll. exact/Capacity.DWord.cdistr_ll. - + apply/fun_ext=> x; rewrite Dprod.supp_def /bdistr /cdistr. + + apply/fun_ext=>- [] a b; rewrite support_dprod. rewrite -/(Distr.support _ _) NewDistr.MUniform.duniform_fu Block.enumP. by rewrite -/(Distr.support _ _) NewDistr.MUniform.duniform_fu Capacity.enumP. have f_ll : islossless SqueezelessSponge(Perm).f. diff --git a/proof/old/Gcol.eca b/proof/old/Gcol.eca index 8603f9f..8405281 100644 --- a/proof/old/Gcol.eca +++ b/proof/old/Gcol.eca @@ -1,7 +1,8 @@ pragma -oldip. require import Pred Fun Option Pair Int Real RealExtra StdOrder Ring StdBigop. require import List FSet NewFMap Utils Common SLCommon RndO FelTactic Mu_mem. -(*...*) import Dprod Dexcepted Capacity IntOrder Bigreal RealOrder BRA. +require import DProd Dexcepted. +(*...*) import Capacity IntOrder Bigreal RealOrder BRA. require (*..*) Handle. diff --git a/proof/old/Gconcl.ec b/proof/old/Gconcl.ec index a3d7948..d984261 100644 --- a/proof/old/Gconcl.ec +++ b/proof/old/Gconcl.ec @@ -1,7 +1,8 @@ pragma -oldip. require import Pred Fun Option Pair Int Real RealExtra StdOrder Ring StdBigop. require import List FSet NewFMap Utils Common SLCommon RndO FelTactic Mu_mem. -(*...*) import Dprod Dexcepted Capacity IntOrder Bigreal RealOrder BRA. +require import DProd Dexcepted. +(*...*) import Capacity IntOrder Bigreal RealOrder BRA. require (*..*) Gext. diff --git a/proof/old/Gext.eca b/proof/old/Gext.eca index 102c49b..e42d96e 100644 --- a/proof/old/Gext.eca +++ b/proof/old/Gext.eca @@ -1,7 +1,8 @@ pragma -oldip. require import Pred Fun Option Pair Int Real RealExtra StdOrder Ring StdBigop. require import List FSet NewFMap Utils Common SLCommon RndO FelTactic Mu_mem. -(*...*) import Dprod Dexcepted Capacity IntOrder Bigreal RealOrder BRA. +require import DProd Dexcepted. +(*...*) import Capacity IntOrder Bigreal RealOrder BRA. require (*..*) Gcol. diff --git a/proof/old/Handle.eca b/proof/old/Handle.eca index 944b652..136ff79 100644 --- a/proof/old/Handle.eca +++ b/proof/old/Handle.eca @@ -1,6 +1,7 @@ require import Pred Fun Option Pair Int Real StdOrder Ring. require import List FSet NewFMap Utils Common SLCommon RndO. -(*...*) import Dprod Dexcepted Capacity IntOrder. +require import DProd Dexcepted. +(*...*) import Capacity IntOrder. require ConcreteF. diff --git a/proof/old/SLCommon.ec b/proof/old/SLCommon.ec index ec26f5c..6f9fd1a 100644 --- a/proof/old/SLCommon.ec +++ b/proof/old/SLCommon.ec @@ -4,13 +4,13 @@ length is the input block size. We prove its security even when padding is not prefix-free. **) require import Pred Fun Option Pair Int Real StdOrder Ring. -require import List FSet NewFMap Utils Common RndO. +require import List FSet NewFMap Utils Common RndO DProd Dexcepted. require (*..*) Indifferentiability. -(*...*) import Dprod Dexcepted Capacity IntOrder. +(*...*) import Capacity IntOrder. type state = block * capacity. -op dstate = bdistr * cdistr. +op dstate = bdistr `*` cdistr. clone include Indifferentiability with type p <- state, @@ -57,7 +57,7 @@ module SqueezelessSponge (P:DPRIMITIVE): FUNCTIONALITY = { } }. -clone export Pair.Dprod.Sample as Sample2 with +clone export DProd.ProdSampling as Sample2 with type t1 <- block, type t2 <- capacity, op d1 <- bdistr, diff --git a/proof/variant/RndOrcl.eca b/proof/variant/RndOrcl.eca index 4b15b5c..4f8b612 100644 --- a/proof/variant/RndOrcl.eca +++ b/proof/variant/RndOrcl.eca @@ -1,4 +1,4 @@ -require import Option FSet NewFMap. +require import Option FSet NewFMap NewDistr. (* TODO move this in NewFMap *) lemma dom_set (m:('a,'b) fmap) a b : dom m.[a<-b] = dom m `|` fset1 a. proof. by apply fsetP=> x;smt. qed. @@ -45,7 +45,7 @@ abstract theory Ideal. section LL. - axiom sample_ll : forall x, Distr.weight (sample x) = 1%r. + axiom sample_ll : forall x, weight (sample x) = 1%r. lemma f_ll : phoare[RO.f : true ==> true] = 1%r. proof. proc;auto;progress;apply sample_ll. qed. From d2ac5b9b1a85e53e184e2ec921a78df3601d9ad0 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Tue, 26 Jan 2016 14:58:53 -0500 Subject: [PATCH 142/525] Added lemmas relating to (n + r - 1) %/ r. --- proof/Common.ec | 34 ++++++++++++++++++++++++++++++++++ 1 file changed, 34 insertions(+) diff --git a/proof/Common.ec b/proof/Common.ec index 51bf821..df16091 100644 --- a/proof/Common.ec +++ b/proof/Common.ec @@ -92,6 +92,40 @@ clone export LazyRP as Perm with [module type] "RP" as "PRIMITIVE" [module] "P" as "Perm". +(*---------------------- Needed Blocks Computation ---------------------*) + +lemma needed_blocks_non_pos (n : int) : + n <= 0 => (n + r - 1) %/ r <= 0. +proof. +move=> le0_n. +rewrite (lez_trans ((r - 1) %/ r)) 1:leq_div2r 1:/# 1:ge0_r. +have -> // : (r - 1) %/ r = 0 + by rewrite -divz_eq0 1:gt0_r; smt ml=0 w=(gt0_r). +qed. + +lemma needed_blocks_suff (n : int) : + n <= (n + r - 1) %/ r * r. +proof. +have -> : (n + r - 1) %/r * r = (n + r - 1) - (n + r - 1)%% r + by rewrite {2}(@divz_eq (n + r - 1) r) #ring. +by rewrite -(@addzA n) -(@addzA n) lez_addl subz_ge0 -ltzS -(@addzA r) /= + ltz_pmod gt0_r. +qed. + +lemma needed_blocks_nec (n : int) : + 0 <= (n + r - 1) %/ r * r - n < r. +proof. +split=> [| _]. +by rewrite subz_ge0 needed_blocks_suff. +have -> : (n + r - 1) %/r * r = (n + r - 1) - (n + r - 1)%% r + by rewrite {2}(@divz_eq (n + r - 1) r) #ring. +have -> : n + r - 1 - (n + r - 1) %% r - n = r - 1 - (n + r - 1) %% r + by ring. +rewrite ltzE -(@ler_add2r (-r)) /=. +cut -> : r - 1 - (n + r - 1) %% r + 1 - r = -(n + r - 1) %% r by ring. +by rewrite oppz_le0 modz_ge0 gtr_eqF 1:gt0_r. +qed. + (* ------------------------- Padding/Unpadding ------------------------ *) op num0 (n : int) = (-(n + 2)) %% r. From 7e0bdf18462155f7a6b9221e1bda5a1bd07c206b Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Tue, 26 Jan 2016 15:03:14 -0500 Subject: [PATCH 143/525] Renaming. --- proof/Common.ec | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/proof/Common.ec b/proof/Common.ec index df16091..3d452fc 100644 --- a/proof/Common.ec +++ b/proof/Common.ec @@ -112,7 +112,7 @@ by rewrite -(@addzA n) -(@addzA n) lez_addl subz_ge0 -ltzS -(@addzA r) /= ltz_pmod gt0_r. qed. -lemma needed_blocks_nec (n : int) : +lemma needed_blocks_correct (n : int) : 0 <= (n + r - 1) %/ r * r - n < r. proof. split=> [| _]. From 02e9a0048d74904b2a9b04883ece55f2e926da58 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Tue, 26 Jan 2016 18:36:31 -0500 Subject: [PATCH 144/525] Renamed the three Sponge theories: TopLevel => Sponge Block => BlockSponge Absorb => AbsorbSponge Added injectivity lemma for pad2blocks to Common. Fixed a glitch in the game structure of Sponge (was TopLevel). Also got rid of smt (without ml=0) calls. --- proof/{Absorb.ec => AbsorbSponge.ec} | 0 proof/{Block.ec => BlockSponge.ec} | 2 +- proof/Common.ec | 19 +- proof/{TopLevel.ec => Sponge.ec} | 306 +++++++++++++++++++-------- 4 files changed, 238 insertions(+), 89 deletions(-) rename proof/{Absorb.ec => AbsorbSponge.ec} (100%) rename proof/{Block.ec => BlockSponge.ec} (98%) rename proof/{TopLevel.ec => Sponge.ec} (53%) diff --git a/proof/Absorb.ec b/proof/AbsorbSponge.ec similarity index 100% rename from proof/Absorb.ec rename to proof/AbsorbSponge.ec diff --git a/proof/Block.ec b/proof/BlockSponge.ec similarity index 98% rename from proof/Block.ec rename to proof/BlockSponge.ec index 8887e5e..2a0b693 100644 --- a/proof/Block.ec +++ b/proof/BlockSponge.ec @@ -57,7 +57,7 @@ module Sponge (P : DPRIMITIVE) : FUNCTIONALITY, CONSTRUCTION(P) = { op eps : real. -lemma top: +lemma conclusion : exists (S <: SIMULATOR), forall (D <: DISTINGUISHER) &m, `| Pr[RealIndif(Sponge, Perm, D).main() @ &m : res] diff --git a/proof/Common.ec b/proof/Common.ec index 3d452fc..2cf8061 100644 --- a/proof/Common.ec +++ b/proof/Common.ec @@ -126,6 +126,13 @@ cut -> : r - 1 - (n + r - 1) %% r + 1 - r = -(n + r - 1) %% r by ring. by rewrite oppz_le0 modz_ge0 gtr_eqF 1:gt0_r. qed. +lemma needed_blocks_prod_r (n : int) : + (n * r + r - 1) %/ r = n. +proof. +rewrite -addzA divzMDl 1:gtr_eqF 1:gt0_r // divz_small //. +smt ml=0 w=(gt0_n). +qed. + (* ------------------------- Padding/Unpadding ------------------------ *) op num0 (n : int) = (-(n + 2)) %% r. @@ -383,6 +390,12 @@ have -> : pad(oget(unpad bs)) = bs by rewrite /bs blocks2bitsK. qed. +lemma pad2blocks_inj : injective pad2blocks. +proof. +search pcancel injective. +apply /(pcan_inj pad2blocks unpad_blocks) /pad2blocksK. +qed. + (*-------------------------- Extending/Stripping -----------------------*) op extend (xs : block list) (n : int) = @@ -436,11 +449,11 @@ qed. (*------------------------------ Validity ------------------------------*) -(* in TopLevel *) +(* in Sponge *) op valid_toplevel (_ : bool list) = true. -(* in Block *) +(* in BlockSponge *) op valid_block (xs : block list) = unpad_blocks xs <> None. @@ -608,7 +621,7 @@ rewrite xs_eq 2!blocks2bits_cat 2!blocks2bits_sing -!catA; congr. by rewrite {1}w2bits_y_eq -catA w2b_z_eq. qed. -(* in Absorb *) +(* in AbsorbSponge *) op valid_absorb (xs : block list) = valid_block((strip xs).`1). diff --git a/proof/TopLevel.ec b/proof/Sponge.ec similarity index 53% rename from proof/TopLevel.ec rename to proof/Sponge.ec index 796d9cb..e75b026 100644 --- a/proof/TopLevel.ec +++ b/proof/Sponge.ec @@ -2,7 +2,7 @@ require import Fun Pair Int IntDiv Real List Option FSet NewFMap DBool. require import Common StdOrder. import IntOrder. -require (*--*) IRO Block. +require (*--*) IRO BlockSponge. (*------------------------- Indifferentiability ------------------------*) @@ -53,7 +53,7 @@ module Sponge (P : DPRIMITIVE) : FUNCTIONALITY, CONSTRUCTION(P) = { (*------------- Simulator and Distinguisher Constructions --------------*) -module LowerFun (F : DFUNCTIONALITY) : Block.DFUNCTIONALITY = { +module LowerFun (F : DFUNCTIONALITY) : BlockSponge.DFUNCTIONALITY = { proc f(xs : block list, n : int) = { var cs, ds : bool list; var obs : bool list option; @@ -68,7 +68,7 @@ module LowerFun (F : DFUNCTIONALITY) : Block.DFUNCTIONALITY = { } }. -module RaiseFun (F : Block.DFUNCTIONALITY) : DFUNCTIONALITY = { +module RaiseFun (F : BlockSponge.DFUNCTIONALITY) : DFUNCTIONALITY = { proc f(bs : bool list, n : int) = { var xs; @@ -77,16 +77,18 @@ module RaiseFun (F : Block.DFUNCTIONALITY) : DFUNCTIONALITY = { } }. -module LowerDist (D : DISTINGUISHER, F : Block.DFUNCTIONALITY) = D(RaiseFun(F)). +module LowerDist (D : DISTINGUISHER, F : BlockSponge.DFUNCTIONALITY) = + D(RaiseFun(F)). -module RaiseSim (S : Block.SIMULATOR, F : DFUNCTIONALITY) = S(LowerFun(F)). +module RaiseSim (S : BlockSponge.SIMULATOR, F : DFUNCTIONALITY) = + S(LowerFun(F)). (*------------------------------- Proof --------------------------------*) section. -declare module BlockSim : Block.SIMULATOR{IRO, Block.BIRO.IRO}. -declare module Dist : DISTINGUISHER{Perm, BlockSim, IRO, Block.BIRO.IRO}. +declare module BlockSim : BlockSponge.SIMULATOR{IRO, BlockSponge.BIRO.IRO}. +declare module Dist : DISTINGUISHER{Perm, BlockSim, IRO, BlockSponge.BIRO.IRO}. module type BLOCK_IRO_BITS = { proc init() : unit @@ -95,10 +97,10 @@ module type BLOCK_IRO_BITS = { }. module type BLOCK_IRO_BITS_DIST(BIROB : BLOCK_IRO_BITS) = { - proc distinguish(): bool + proc distinguish(): bool {BIROB.g BIROB.f} }. -local module BlockIROBitsEager : BLOCK_IRO_BITS, Block.BIRO.IRO = { +local module BlockIROBitsEager : BLOCK_IRO_BITS, BlockSponge.BIRO.IRO = { var mp : (block list * int, bool) fmap proc init() : unit = { @@ -140,7 +142,7 @@ local module BlockIROBitsEager : BLOCK_IRO_BITS, Block.BIRO.IRO = { } }. -local module BlockIROBitsLazy : BLOCK_IRO_BITS, Block.BIRO.IRO = { +local module BlockIROBitsLazy : BLOCK_IRO_BITS, BlockSponge.BIRO.IRO = { var mp : (block list * int, bool) fmap proc init() : unit = { @@ -177,6 +179,14 @@ local module BlockIROBitsLazy : BLOCK_IRO_BITS, Block.BIRO.IRO = { } }. +local lemma BlockIROBitsEager (D <: BLOCK_IRO_BITS_DIST) : + equiv[D(BlockIROBitsEager).distinguish ~ D(BlockIROBitsLazy).distinguish : + ={glob D} /\ BlockIROBitsEager.mp{1} = BlockIROBitsLazy.mp{2} ==> + ={glob D}]. +proof. +admit. (* use RndO.ec result *) +qed. + local module RaiseBIROBLazy (F : BLOCK_IRO_BITS) : FUNCTIONALITY = { proc init() = { F.init(); @@ -201,6 +211,60 @@ pred LazyInvar mem (dom mp1) (bs, n) => oget mp1.[(bs, n)] = oget mp2.[(pad2blocks bs, n)]). +local lemma lazy_invar_upd_mem_dom_iff + (mp1 : (bool list * int, bool) fmap, + mp2 : (block list * int, bool) fmap, + bs cs : bool list, n m : int, b : bool) : + LazyInvar mp1 mp2 => + mem (dom mp1.[(bs, n) <- b]) (cs, m) <=> + mem (dom mp2.[(pad2blocks bs, n) <- b]) (pad2blocks cs, m). +proof. +move=> LI; split=> [mem_upd_mp1 | mem_upd_mp2]. +rewrite domP in_fsetU1; rewrite domP in_fsetU1 in mem_upd_mp1. +case: ((cs, m) = (bs, n))=> [cs_m_eq_bs_n | cs_m_neq_bs_n]. +right; by elim cs_m_eq_bs_n=> ->->. +left; smt ml=0. +rewrite domP in_fsetU1; rewrite domP in_fsetU1 in mem_upd_mp2. +case: ((cs, m) = (bs, n))=> [// | cs_m_neq_bs_n]. +elim mem_upd_mp2=> [/# | [p2b_cs_p2b_bs eq_mn]]. +have /# : cs = bs by apply pad2blocks_inj. +qed. + +local lemma lazy_invar_upd2_vb + (mp1 : (bool list * int, bool) fmap, + mp2 : (block list * int, bool) fmap, + bs : bool list, xs : block list, n m : int, b : bool) : + LazyInvar mp1 mp2 => + mem (dom mp2.[(pad2blocks bs, n) <- b]) (xs, m) => + valid_block xs. +proof. +move=> LI mem_upd_mp2. +rewrite domP in_fsetU1 in mem_upd_mp2. +elim mem_upd_mp2=> [/# | [-> _]]. +apply/valid_pad2blocks. +qed. + +local lemma lazy_invar_upd_lu_eq + (mp1 : (bool list * int, bool) fmap, + mp2 : (block list * int, bool) fmap, + bs cs : bool list, n m : int, b : bool) : + LazyInvar mp1 mp2 => + mem (dom mp1.[(bs, n) <- b]) (cs, m) => + oget mp1.[(bs, n) <- b].[(cs, m)] = + oget mp2.[(pad2blocks bs, n) <- b].[(pad2blocks cs, m)]. +proof. +move=> LI mem_upd_mp1. +case: ((cs, m) = (bs, n))=> [[->->] | cs_m_neq_bs_n]. +smt ml=0 w=(getP_eq). +rewrite domP in_fsetU1 in mem_upd_mp1. +elim mem_upd_mp1=> [mem_mp1 | [->->]]. +case: ((pad2blocks bs, n) = (pad2blocks cs, m))=> + [[p2b_bs_p2b_cs eq_mn] | p2b_bs_n_neq_p2b_cs_m]. +smt ml=0 w=(pad2blocks_inj). +smt ml=0 w=(getP). +smt ml=0 w=(getP). +qed. + local lemma LowerFun_IRO_BlockIROBitsLazy_f : equiv[LowerFun(IRO).f ~ BlockIROBitsLazy.f : ={xs, n} /\ LazyInvar IRO.mp{1} BlockIROBitsLazy.mp{2} ==> @@ -226,8 +290,13 @@ while sp; auto. if. progress; smt ml=0. -rnd; auto; progress; smt. (* will get rid of smt's *) -auto; progress; smt. +rnd; auto; progress; + [smt ml=0 w=(getP_eq) | + smt ml=0 w=(lazy_invar_upd_mem_dom_iff) | + smt ml=0 w=(lazy_invar_upd_mem_dom_iff) | + smt ml=0 w=(lazy_invar_upd2_vb) | + smt ml=0 w=(lazy_invar_upd_lu_eq)]. +auto; progress; smt ml=0. auto. rcondf{1} 3; first auto. rcondf{2} 4; first auto. auto; progress; by rewrite bits2blocks_nil. @@ -251,20 +320,17 @@ while LazyInvar IRO.mp{1} BlockIROBitsLazy.mp{2}). wp; sp. if. -progress; smt. (* will get rid of smt's *) -rnd; skip; progress; smt. -auto; progress; smt. +progress; smt ml=0. +rnd; skip; progress; + [smt ml=0 w=(getP_eq) | + smt ml=0 w=(lazy_invar_upd_mem_dom_iff) | + smt ml=0 w=(lazy_invar_upd_mem_dom_iff) | + smt ml=0 w=(lazy_invar_upd2_vb) | + smt ml=0 w=(lazy_invar_upd_lu_eq)]. +auto; progress; smt ml=0. auto. qed. -local lemma BlockIROBitsEager (D <: BLOCK_IRO_BITS_DIST) : - equiv[D(BlockIROBitsEager).distinguish ~ D(BlockIROBitsLazy).distinguish : - ={glob D} /\ BlockIROBitsEager.mp{1} = BlockIROBitsLazy.mp{2} ==> - ={glob D}]. -proof. -admit. (* use RndO.ec result *) -qed. - pred EagerInvar (mp1 : (block list * int, block) fmap, mp2 : (block list * int, bool) fmap) = @@ -278,48 +344,119 @@ pred EagerInvar mem (dom mp2) (xs, j) => 0 <= j /\ mem (dom mp1) (xs, j %/ r)). -local lemma BlockIROBitsEager_BlockIRO_f : - equiv[BlockIROBitsEager.f ~ Block.BIRO.IRO.f : - xs{1} = x{2} /\ ={n} /\ - EagerInvar Block.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1} ==> - ={res} /\ EagerInvar Block.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1}]. +local lemma BlockIROBitsEager_f_BlockIRO_g : + equiv[BlockIROBitsEager.f ~ BlockIROBitsEager.g : + ={xs, BlockIROBitsEager.mp} /\ n{1} * r = n{2} ==> + res{1} = bits2blocks res{2} /\ ={BlockIROBitsEager.mp}]. +proof. +proc=> /=; inline *. +seq 5 3 : + (={i, BlockIROBitsEager.mp} /\ xs0{1} = xs{2} /\ + bs0{1} = bs{2} /\ n0{1} = n{2} /\ m{1} = n0{1} /\ m{2} = n{2}). +auto; progress; + first 2 rewrite -addzA divzMDl 1:gtr_eqF 1:gt0_r // divz_small //; + smt ml=0 w=(gt0_n). +if=> //; wp. +while + (={i, BlockIROBitsEager.mp} /\ xs0{1} = xs{2} /\ + bs0{1} = bs{2} /\ n0{1} = n{2} /\ m{1} = n0{1} /\ + m{2} = n{2}). +sp; wp; if=> //; rnd; auto. +while + (={i, BlockIROBitsEager.mp} /\ xs0{1} = xs{2} /\ + bs0{1} = bs{2} /\ n0{1} = n{2} /\ m{1} = n0{1} /\ + m{2} = n{2})=> //. +sp; wp; if=> //; rnd; auto. +auto. +qed. + +local lemma BlockIROBitsEager_g_Block_IRO_f + (n' : int) (x' : block list) : + equiv[BlockIROBitsEager.g ~ BlockSponge.BIRO.IRO.f : + n' = n{1} /\ xs{1} = x{2} /\ x' = x{2} /\ + n{2} = (n{1} + r - 1) %/ r /\ + EagerInvar BlockSponge.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1} ==> + EagerInvar BlockSponge.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1} /\ + (valid_block x' => + res{1} = take n' (blocks2bits res{2}) /\ + size res{2} = (n' + r - 1) %/ r) /\ + (! valid_block x' => res{1} = [] /\ res{2} = [])]. proof. proc=> /=. -inline BlockIROBitsEager.g. -seq 5 2 : - (={i} /\ xs0{1} = x{2} /\ bs0{1} = [] /\ bs{2} = [] /\ n0{1} = n{2} * r /\ - n0{1} = m{1} /\ - EagerInvar Block.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1}). +seq 3 2 : + (n' = n{1} /\ xs{1} = x{2} /\ x' = x{2} /\ + n{2} = (n{1} + r - 1) %/ r /\ n{2} * r = m{1} /\ + i{1} = 0 /\ i{2} = 0 /\ bs{1} = [] /\ bs{2} = [] /\ + EagerInvar BlockSponge.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1}). auto; progress. -rewrite -addzA divzMDl 1:gtr_eqF 1:gt0_r //. -have -> // : (r - 1) %/ r = 0 by smt. (* TODO *) if=> //. -rcondf{1} 2; auto; first while (true); auto. conseq (_ : - ={i} /\ n0{1} = n{2} * r /\ xs0{1} = x{2} /\ bs0{1} = [] /\ bs{2} = [] /\ - EagerInvar Block.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1} ==> - bits2blocks bs0{1} = bs{2} /\ - EagerInvar Block.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1})=> //. -admit. -auto; progress; by rewrite bits2blocks_nil. + xs{1} = x{2} /\ n' = n{1} /\ n{2} = (n{1} + r - 1) %/ r /\ + n{2} * r = m{1} /\ n{1} <= m{1} /\ + i{1} = 0 /\ i{2} = 0 /\ bs{1} = [] /\ bs{2} = [] /\ + EagerInvar BlockSponge.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1} ==> + bs{1} = take n' (blocks2bits bs{2}) /\ + size bs{2} = (n' + r - 1) %/ r /\ + EagerInvar BlockSponge.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1})=> //. +progress; apply/needed_blocks_suff. +admit. +qed. + +local lemma BlockIROBitsEager_BlockIRO_f : + equiv[BlockIROBitsEager.f ~ BlockSponge.BIRO.IRO.f : + xs{1} = x{2} /\ ={n} /\ + EagerInvar BlockSponge.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1} ==> + ={res} /\ EagerInvar BlockSponge.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1}]. +proof. +transitivity + BlockIROBitsEager.g + (={xs, BlockIROBitsEager.mp} /\ n{2} = n{1} * r /\ + EagerInvar BlockSponge.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1} ==> + res{1} = bits2blocks res{2} /\ ={BlockIROBitsEager.mp}) + (xs{1} = x{2} /\ n{1} = n{2} * r /\ + EagerInvar BlockSponge.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1} ==> + res{1} = (blocks2bits res{2}) /\ + EagerInvar BlockSponge.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1}). +progress. +exists BlockSponge.BIRO.IRO.mp{2}, BlockIROBitsEager.mp{1}, (xs{1}, n{1} * r). + progress; by rewrite H0. +progress; apply blocks2bitsK. +conseq BlockIROBitsEager_f_BlockIRO_g. +progress; by rewrite H0. +exists* n{1}; elim*=> n1. exists* xs{1}; elim*=> xs'. +conseq (BlockIROBitsEager_g_Block_IRO_f n1 xs')=> //. +progress; rewrite H0; by rewrite needed_blocks_prod_r. +progress. +case (valid_block xs{1})=> [vb_xs1 | not_vb_xs1]. +have [-> size_result_R] := H3 vb_xs1. +have -> : n{1} = size(blocks2bits result_R) + by rewrite size_blocks2bits size_result_R H0 + needed_blocks_prod_r mulzC. +by rewrite take_size. +by have [->->] := H4 not_vb_xs1. qed. -local lemma RaiseFun_BlockIROBitsEager_BlockIRO_f : - equiv[RaiseFun(BlockIROBitsEager).f ~ RaiseFun(Block.BIRO.IRO).f : - ={bs, n} /\ - EagerInvar Block.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1} ==> - ={res} /\ - EagerInvar Block.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1}]. +local lemma RaiseBIROBLazy_BlockIROBitsEager_RaiseFun_Block_IRO_f : + equiv[RaiseBIROBLazy(BlockIROBitsEager).f ~ RaiseFun(BlockSponge.BIRO.IRO).f : + ={bs, n} /\ ={glob BlockSim} /\ + EagerInvar BlockSponge.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1} ==> + ={res} /\ ={glob BlockSim} /\ + EagerInvar BlockSponge.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1}]. proof. -proc=> /=; by call BlockIROBitsEager_BlockIRO_f. +proc=> /=. +exists* n{1}; elim*=> n'. +exists* (pad2blocks bs{2}); elim*=> xs2. +call (BlockIROBitsEager_g_Block_IRO_f n' xs2). +auto; progress. +by have [-> _] := H2 _; first apply/valid_pad2blocks. qed. local lemma Sponge_Raise_Block_Sponge_f : - equiv[Sponge(Perm).f ~ RaiseFun(Block.Sponge(Perm)).f : + equiv[Sponge(Perm).f ~ RaiseFun(BlockSponge.Sponge(Perm)).f : ={bs, n, glob Perm} ==> ={res, glob Perm}]. proof. -proc; inline Block.Sponge(Perm).f. +proc; inline BlockSponge.Sponge(Perm).f. conseq (_ : ={bs, n, glob Perm} ==> _)=> //. swap{2} [3..5] -2. seq 4 4 : @@ -344,8 +481,8 @@ qed. local lemma RealIndif &m : Pr[RealIndif(Sponge, Perm, Dist).main() @ &m: res] = - Pr[Block.RealIndif - (Block.Sponge, Perm, LowerDist(Dist)).main() @ &m : res]. + Pr[BlockSponge.RealIndif + (BlockSponge.Sponge, Perm, LowerDist(Dist)).main() @ &m : res]. proof. byequiv=> //; proc. seq 2 2 : (={glob Dist, glob Perm}); first sim. @@ -371,7 +508,7 @@ call IRO.mp{1} = map0 /\ BlockIROBitsLazy.mp{2} = map0 ==> ={res}). proc (={glob BlockSim} /\ LazyInvar IRO.mp{1} BlockIROBitsLazy.mp{2}). -smt. (* will remove this *) +progress; rewrite dom0 in_fset0 in H; elim H. trivial. proc (LazyInvar IRO.mp{1} BlockIROBitsLazy.mp{2})=> //. apply LowerFun_IRO_BlockIROBitsLazy_f. @@ -385,50 +522,49 @@ local lemma IdealIndifLazy &m : Pr[Experiment (RaiseBIROBLazy(BlockIROBitsLazy), BlockSim(BlockIROBitsLazy), Dist).main() @ &m : res] = - Pr[Block.IdealIndif - (BlockIROBitsEager, BlockSim, LowerDist(Dist)).main() @ &m : res]. + Pr[Experiment + (RaiseBIROBLazy(BlockIROBitsEager), BlockSim(BlockIROBitsEager), + Dist).main() @ &m : res]. proof. -byequiv=> //; proc. -seq 2 2 : - (={glob Dist, glob BlockSim} /\ BlockIROBitsLazy.mp{1} = NewFMap.map0 /\ - BlockIROBitsEager.mp{2} = NewFMap.map0). -inline *; wp; call (_ : true); auto. -(* reduction to BlockIROBitsEager *) +(* reduction to eager *) admit. qed. local lemma IdealIndifEager &m : - Pr[Block.IdealIndif - (BlockIROBitsEager, BlockSim, LowerDist(Dist)).main() @ &m : res] = - Pr[Block.IdealIndif - (Block.BIRO.IRO, BlockSim, LowerDist(Dist)).main () @ &m : res]. + Pr[Experiment + (RaiseBIROBLazy(BlockIROBitsEager), BlockSim(BlockIROBitsEager), + Dist).main() @ &m : res] = + Pr[BlockSponge.IdealIndif + (BlockSponge.BIRO.IRO, BlockSim, LowerDist(Dist)).main () @ &m : res]. proof. byequiv=> //; proc. seq 2 2 : (={glob Dist, glob BlockSim} /\ BlockIROBitsEager.mp{1} = NewFMap.map0 /\ - Block.BIRO.IRO.mp{2} = NewFMap.map0). + BlockSponge.BIRO.IRO.mp{2} = NewFMap.map0). inline *; wp; call (_ : true); auto. call (_ : ={glob Dist, glob BlockSim} /\ - BlockIROBitsEager.mp{1} = map0 /\ Block.BIRO.IRO.mp{2} = map0 ==> + BlockIROBitsEager.mp{1} = map0 /\ BlockSponge.BIRO.IRO.mp{2} = map0 ==> ={res}). proc (={glob BlockSim} /\ - EagerInvar Block.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1}) => //. -smt. (* TODO *) -proc (EagerInvar Block.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1})=> //; + EagerInvar BlockSponge.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1}) => //. +progress; rewrite dom0 in_fset0 in H; elim H. + +proc (EagerInvar BlockSponge.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1})=> //; conseq BlockIROBitsEager_BlockIRO_f=> //. -proc (EagerInvar Block.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1})=> //; +proc (EagerInvar BlockSponge.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1})=> //; conseq BlockIROBitsEager_BlockIRO_f=> //. -conseq RaiseFun_BlockIROBitsEager_BlockIRO_f=> //. +exists* n{1}; elim *=> n'. +conseq RaiseBIROBLazy_BlockIROBitsEager_RaiseFun_Block_IRO_f=> //. auto. qed. local lemma IdealIndif &m : Pr[IdealIndif(IRO, RaiseSim(BlockSim), Dist).main() @ &m : res] = - Pr[Block.IdealIndif - (Block.BIRO.IRO, BlockSim, LowerDist(Dist)).main () @ &m : res]. + Pr[BlockSponge.IdealIndif + (BlockSponge.BIRO.IRO, BlockSim, LowerDist(Dist)).main () @ &m : res]. proof. by rewrite (IdealIndifIROLazy &m) (IdealIndifLazy &m) (IdealIndifEager &m). qed. @@ -436,10 +572,10 @@ qed. lemma Conclusion' &m : `|Pr[RealIndif(Sponge, Perm, Dist).main() @ &m: res] - Pr[IdealIndif(IRO, RaiseSim(BlockSim), Dist).main() @ &m : res]| = - `|Pr[Block.RealIndif - (Block.Sponge, Perm, LowerDist(Dist)).main() @ &m : res] - - Pr[Block.IdealIndif - (Block.BIRO.IRO, BlockSim, LowerDist(Dist)).main() @ &m : res]|. + `|Pr[BlockSponge.RealIndif + (BlockSponge.Sponge, Perm, LowerDist(Dist)).main() @ &m : res] - + Pr[BlockSponge.IdealIndif + (BlockSponge.BIRO.IRO, BlockSim, LowerDist(Dist)).main() @ &m : res]|. proof. by rewrite (RealIndif &m) (IdealIndif &m). qed. @@ -448,13 +584,13 @@ end section. (*----------------------------- Conclusion -----------------------------*) -lemma Conclusion (BlockSim <: Block.SIMULATOR{IRO, Block.BIRO.IRO}) - (Dist <: DISTINGUISHER{Perm, BlockSim, IRO, Block.BIRO.IRO}) +lemma Conclusion (BlockSim <: BlockSponge.SIMULATOR{IRO, BlockSponge.BIRO.IRO}) + (Dist <: DISTINGUISHER{Perm, BlockSim, IRO, BlockSponge.BIRO.IRO}) &m : `|Pr[RealIndif(Sponge, Perm, Dist).main() @ &m: res] - Pr[IdealIndif(IRO, RaiseSim(BlockSim), Dist).main() @ &m : res]| = - `|Pr[Block.RealIndif - (Block.Sponge, Perm, LowerDist(Dist)).main() @ &m : res] - - Pr[Block.IdealIndif - (Block.BIRO.IRO, BlockSim, LowerDist(Dist)).main() @ &m : res]|. + `|Pr[BlockSponge.RealIndif + (BlockSponge.Sponge, Perm, LowerDist(Dist)).main() @ &m : res] - + Pr[BlockSponge.IdealIndif + (BlockSponge.BIRO.IRO, BlockSim, LowerDist(Dist)).main() @ &m : res]|. proof. by apply/(Conclusion' BlockSim Dist &m). qed. From 7c595d752929cfd66692b420d555869c63685669 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Tue, 26 Jan 2016 18:47:09 -0500 Subject: [PATCH 145/525] Removed [search] command. --- proof/Common.ec | 1 - 1 file changed, 1 deletion(-) diff --git a/proof/Common.ec b/proof/Common.ec index 2cf8061..16e8ac0 100644 --- a/proof/Common.ec +++ b/proof/Common.ec @@ -392,7 +392,6 @@ qed. lemma pad2blocks_inj : injective pad2blocks. proof. -search pcancel injective. apply /(pcan_inj pad2blocks unpad_blocks) /pad2blocksK. qed. From 5aa7931d66dfde54309cfe109fc349a279ee6607 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Tue, 26 Jan 2016 18:57:24 -0500 Subject: [PATCH 146/525] Nit. --- proof/Sponge.ec | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/proof/Sponge.ec b/proof/Sponge.ec index e75b026..0e1879b 100644 --- a/proof/Sponge.ec +++ b/proof/Sponge.ec @@ -182,7 +182,7 @@ local module BlockIROBitsLazy : BLOCK_IRO_BITS, BlockSponge.BIRO.IRO = { local lemma BlockIROBitsEager (D <: BLOCK_IRO_BITS_DIST) : equiv[D(BlockIROBitsEager).distinguish ~ D(BlockIROBitsLazy).distinguish : ={glob D} /\ BlockIROBitsEager.mp{1} = BlockIROBitsLazy.mp{2} ==> - ={glob D}]. + ={res, glob D}]. proof. admit. (* use RndO.ec result *) qed. From 97e17bafe33a9897c75877e8dbf1e021bfe4136a Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Wed, 27 Jan 2016 17:20:05 -0500 Subject: [PATCH 147/525] About to apply RndO. --- proof/Sponge.ec | 233 ++++++++++++++++++++++++++++-------------------- 1 file changed, 134 insertions(+), 99 deletions(-) diff --git a/proof/Sponge.ec b/proof/Sponge.ec index 0e1879b..58d540d 100644 --- a/proof/Sponge.ec +++ b/proof/Sponge.ec @@ -2,7 +2,7 @@ require import Fun Pair Int IntDiv Real List Option FSet NewFMap DBool. require import Common StdOrder. import IntOrder. -require (*--*) IRO BlockSponge. +require (*--*) IRO BlockSponge RndO. (*------------------------- Indifferentiability ------------------------*) @@ -85,22 +85,19 @@ module RaiseSim (S : BlockSponge.SIMULATOR, F : DFUNCTIONALITY) = (*------------------------------- Proof --------------------------------*) -section. - -declare module BlockSim : BlockSponge.SIMULATOR{IRO, BlockSponge.BIRO.IRO}. -declare module Dist : DISTINGUISHER{Perm, BlockSim, IRO, BlockSponge.BIRO.IRO}. +abstract theory HybridIRO. -module type BLOCK_IRO_BITS = { +module type HYBRID_IRO = { proc init() : unit proc g(x : block list, n : int) : bool list proc f(x : block list, n : int) : block list }. -module type BLOCK_IRO_BITS_DIST(BIROB : BLOCK_IRO_BITS) = { - proc distinguish(): bool {BIROB.g BIROB.f} +module type HYBRID_IRO_DIST(HI : HYBRID_IRO) = { + proc distinguish(): bool }. -local module BlockIROBitsEager : BLOCK_IRO_BITS, BlockSponge.BIRO.IRO = { +module HybridIROEager : HYBRID_IRO, BlockSponge.BIRO.IRO = { var mp : (block list * int, bool) fmap proc init() : unit = { @@ -142,7 +139,7 @@ local module BlockIROBitsEager : BLOCK_IRO_BITS, BlockSponge.BIRO.IRO = { } }. -local module BlockIROBitsLazy : BLOCK_IRO_BITS, BlockSponge.BIRO.IRO = { +module HybridIROLazy : HYBRID_IRO, BlockSponge.BIRO.IRO = { var mp : (block list * int, bool) fmap proc init() : unit = { @@ -179,23 +176,31 @@ local module BlockIROBitsLazy : BLOCK_IRO_BITS, BlockSponge.BIRO.IRO = { } }. -local lemma BlockIROBitsEager (D <: BLOCK_IRO_BITS_DIST) : - equiv[D(BlockIROBitsEager).distinguish ~ D(BlockIROBitsLazy).distinguish : - ={glob D} /\ BlockIROBitsEager.mp{1} = BlockIROBitsLazy.mp{2} ==> - ={res, glob D}]. +section. + +declare module D : HYBRID_IRO_DIST. + +local clone RndO.GenEager as RO. + +lemma HybridIROLazyEager (D <: HYBRID_IRO_DIST) &m : + Pr[D(HybridIROLazy).distinguish() @ &m : res] = + Pr[D(HybridIROEager).distinguish() @ &m : res]. proof. +byequiv=> //. admit. (* use RndO.ec result *) qed. -local module RaiseBIROBLazy (F : BLOCK_IRO_BITS) : FUNCTIONALITY = { +end section. + +module RaiseHybridIRO (HI : HYBRID_IRO) : FUNCTIONALITY = { proc init() = { - F.init(); + HI.init(); } proc f(bs : bool list, n : int) = { var cs; - cs <@ F.g(pad2blocks bs, n); + cs <@ HI.g(pad2blocks bs, n); return cs; } }. @@ -211,7 +216,7 @@ pred LazyInvar mem (dom mp1) (bs, n) => oget mp1.[(bs, n)] = oget mp2.[(pad2blocks bs, n)]). -local lemma lazy_invar_upd_mem_dom_iff +lemma lazy_invar_upd_mem_dom_iff (mp1 : (bool list * int, bool) fmap, mp2 : (block list * int, bool) fmap, bs cs : bool list, n m : int, b : bool) : @@ -230,7 +235,7 @@ elim mem_upd_mp2=> [/# | [p2b_cs_p2b_bs eq_mn]]. have /# : cs = bs by apply pad2blocks_inj. qed. -local lemma lazy_invar_upd2_vb +lemma lazy_invar_upd2_vb (mp1 : (bool list * int, bool) fmap, mp2 : (block list * int, bool) fmap, bs : bool list, xs : block list, n m : int, b : bool) : @@ -244,7 +249,7 @@ elim mem_upd_mp2=> [/# | [-> _]]. apply/valid_pad2blocks. qed. -local lemma lazy_invar_upd_lu_eq +lemma lazy_invar_upd_lu_eq (mp1 : (bool list * int, bool) fmap, mp2 : (block list * int, bool) fmap, bs cs : bool list, n m : int, b : bool) : @@ -265,27 +270,27 @@ smt ml=0 w=(getP). smt ml=0 w=(getP). qed. -local lemma LowerFun_IRO_BlockIROBitsLazy_f : - equiv[LowerFun(IRO).f ~ BlockIROBitsLazy.f : - ={xs, n} /\ LazyInvar IRO.mp{1} BlockIROBitsLazy.mp{2} ==> - ={res} /\ LazyInvar IRO.mp{1} BlockIROBitsLazy.mp{2}]. +lemma LowerFun_IRO_HybridIROLazy_f : + equiv[LowerFun(IRO).f ~ HybridIROLazy.f : + ={xs, n} /\ LazyInvar IRO.mp{1} HybridIROLazy.mp{2} ==> + ={res} /\ LazyInvar IRO.mp{1} HybridIROLazy.mp{2}]. proof. -proc=> /=; inline BlockIROBitsLazy.g. +proc=> /=; inline HybridIROLazy.g. seq 0 1 : (={n} /\ xs{1} = xs0{2} /\ - LazyInvar IRO.mp{1} BlockIROBitsLazy.mp{2}); first auto. + LazyInvar IRO.mp{1} HybridIROLazy.mp{2}); first auto. case (valid_block xs{1}). rcondt{1} 3; first auto. rcondt{2} 4; first auto. inline *. rcondt{1} 7; first auto. seq 6 3 : (={i, n0} /\ bs{1} = bs0{2} /\ - LazyInvar IRO.mp{1} BlockIROBitsLazy.mp{2} /\ + LazyInvar IRO.mp{1} HybridIROLazy.mp{2} /\ pad2blocks x{1} = xs0{2}). auto; progress; have {2}<- /# := unpadBlocksK xs0{2}. wp. while (={i, n0} /\ bs{1} = bs0{2} /\ - LazyInvar IRO.mp{1} BlockIROBitsLazy.mp{2} /\ + LazyInvar IRO.mp{1} HybridIROLazy.mp{2} /\ pad2blocks x{1} = xs0{2}). sp; auto. if. @@ -302,22 +307,22 @@ rcondf{1} 3; first auto. rcondf{2} 4; first auto. auto; progress; by rewrite bits2blocks_nil. qed. -local lemma IRO_RaiseBIROBLazy_BlockIROBitsLazy_f : - equiv[IRO.f ~ RaiseBIROBLazy(BlockIROBitsLazy).f : +lemma IRO_RaiseHybridIRO_HybridIROLazy_f : + equiv[IRO.f ~ RaiseHybridIRO(HybridIROLazy).f : ={n} /\ x{1} = bs{2} /\ - LazyInvar IRO.mp{1} BlockIROBitsLazy.mp{2} ==> - ={res} /\ LazyInvar IRO.mp{1} BlockIROBitsLazy.mp{2}]. + LazyInvar IRO.mp{1} HybridIROLazy.mp{2} ==> + ={res} /\ LazyInvar IRO.mp{1} HybridIROLazy.mp{2}]. proof. proc=> /=; inline *. rcondt{1} 3; first auto. rcondt{2} 5; first auto; progress; apply valid_pad2blocks. seq 2 4 : (={i, n} /\ n{1} = n0{2} /\ xs{2} = pad2blocks x{1} /\ bs{1} = bs0{2} /\ - LazyInvar IRO.mp{1} BlockIROBitsLazy.mp{2}); first auto. + LazyInvar IRO.mp{1} HybridIROLazy.mp{2}); first auto. wp. while (={i, n} /\ n{1} = n0{2} /\ xs{2} = pad2blocks x{1} /\ bs{1} = bs0{2} /\ - LazyInvar IRO.mp{1} BlockIROBitsLazy.mp{2}). + LazyInvar IRO.mp{1} HybridIROLazy.mp{2}). wp; sp. if. progress; smt ml=0. @@ -344,39 +349,38 @@ pred EagerInvar mem (dom mp2) (xs, j) => 0 <= j /\ mem (dom mp1) (xs, j %/ r)). -local lemma BlockIROBitsEager_f_BlockIRO_g : - equiv[BlockIROBitsEager.f ~ BlockIROBitsEager.g : - ={xs, BlockIROBitsEager.mp} /\ n{1} * r = n{2} ==> - res{1} = bits2blocks res{2} /\ ={BlockIROBitsEager.mp}]. +lemma HybridIROEager_f_g : + equiv[HybridIROEager.f ~ HybridIROEager.g : + ={xs, HybridIROEager.mp} /\ n{1} * r = n{2} ==> + res{1} = bits2blocks res{2} /\ ={HybridIROEager.mp}]. proof. proc=> /=; inline *. seq 5 3 : - (={i, BlockIROBitsEager.mp} /\ xs0{1} = xs{2} /\ + (={i, HybridIROEager.mp} /\ xs0{1} = xs{2} /\ bs0{1} = bs{2} /\ n0{1} = n{2} /\ m{1} = n0{1} /\ m{2} = n{2}). auto; progress; first 2 rewrite -addzA divzMDl 1:gtr_eqF 1:gt0_r // divz_small //; smt ml=0 w=(gt0_n). if=> //; wp. while - (={i, BlockIROBitsEager.mp} /\ xs0{1} = xs{2} /\ + (={i, HybridIROEager.mp} /\ xs0{1} = xs{2} /\ bs0{1} = bs{2} /\ n0{1} = n{2} /\ m{1} = n0{1} /\ m{2} = n{2}). sp; wp; if=> //; rnd; auto. while - (={i, BlockIROBitsEager.mp} /\ xs0{1} = xs{2} /\ + (={i, HybridIROEager.mp} /\ xs0{1} = xs{2} /\ bs0{1} = bs{2} /\ n0{1} = n{2} /\ m{1} = n0{1} /\ m{2} = n{2})=> //. sp; wp; if=> //; rnd; auto. auto. qed. -local lemma BlockIROBitsEager_g_Block_IRO_f - (n' : int) (x' : block list) : - equiv[BlockIROBitsEager.g ~ BlockSponge.BIRO.IRO.f : +lemma HybridIROEager_g_BlockIRO_f (n' : int) (x' : block list) : + equiv[HybridIROEager.g ~ BlockSponge.BIRO.IRO.f : n' = n{1} /\ xs{1} = x{2} /\ x' = x{2} /\ n{2} = (n{1} + r - 1) %/ r /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1} ==> - EagerInvar BlockSponge.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1} /\ + EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} /\ (valid_block x' => res{1} = take n' (blocks2bits res{2}) /\ size res{2} = (n' + r - 1) %/ r) /\ @@ -387,7 +391,7 @@ seq 3 2 : (n' = n{1} /\ xs{1} = x{2} /\ x' = x{2} /\ n{2} = (n{1} + r - 1) %/ r /\ n{2} * r = m{1} /\ i{1} = 0 /\ i{2} = 0 /\ bs{1} = [] /\ bs{2} = [] /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1}). + EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). auto; progress. if=> //. conseq @@ -395,37 +399,37 @@ conseq xs{1} = x{2} /\ n' = n{1} /\ n{2} = (n{1} + r - 1) %/ r /\ n{2} * r = m{1} /\ n{1} <= m{1} /\ i{1} = 0 /\ i{2} = 0 /\ bs{1} = [] /\ bs{2} = [] /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1} ==> + EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> bs{1} = take n' (blocks2bits bs{2}) /\ size bs{2} = (n' + r - 1) %/ r /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1})=> //. + EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1})=> //. progress; apply/needed_blocks_suff. admit. qed. -local lemma BlockIROBitsEager_BlockIRO_f : - equiv[BlockIROBitsEager.f ~ BlockSponge.BIRO.IRO.f : +lemma HybridIROEager_BlockIRO_f : + equiv[HybridIROEager.f ~ BlockSponge.BIRO.IRO.f : xs{1} = x{2} /\ ={n} /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1} ==> - ={res} /\ EagerInvar BlockSponge.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1}]. + EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + ={res} /\ EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}]. proof. transitivity - BlockIROBitsEager.g - (={xs, BlockIROBitsEager.mp} /\ n{2} = n{1} * r /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1} ==> - res{1} = bits2blocks res{2} /\ ={BlockIROBitsEager.mp}) + HybridIROEager.g + (={xs, HybridIROEager.mp} /\ n{2} = n{1} * r /\ + EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + res{1} = bits2blocks res{2} /\ ={HybridIROEager.mp}) (xs{1} = x{2} /\ n{1} = n{2} * r /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1} ==> + EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> res{1} = (blocks2bits res{2}) /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1}). + EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). progress. -exists BlockSponge.BIRO.IRO.mp{2}, BlockIROBitsEager.mp{1}, (xs{1}, n{1} * r). +exists BlockSponge.BIRO.IRO.mp{2}, HybridIROEager.mp{1}, (xs{1}, n{1} * r). progress; by rewrite H0. progress; apply blocks2bitsK. -conseq BlockIROBitsEager_f_BlockIRO_g. +conseq HybridIROEager_f_g. progress; by rewrite H0. exists* n{1}; elim*=> n1. exists* xs{1}; elim*=> xs'. -conseq (BlockIROBitsEager_g_Block_IRO_f n1 xs')=> //. +conseq (HybridIROEager_g_BlockIRO_f n1 xs')=> //. progress; rewrite H0; by rewrite needed_blocks_prod_r. progress. case (valid_block xs{1})=> [vb_xs1 | not_vb_xs1]. @@ -437,22 +441,31 @@ by rewrite take_size. by have [->->] := H4 not_vb_xs1. qed. -local lemma RaiseBIROBLazy_BlockIROBitsEager_RaiseFun_Block_IRO_f : - equiv[RaiseBIROBLazy(BlockIROBitsEager).f ~ RaiseFun(BlockSponge.BIRO.IRO).f : +end HybridIRO. + +section. + +declare module BlockSim : BlockSponge.SIMULATOR{IRO, BlockSponge.BIRO.IRO}. +declare module Dist : DISTINGUISHER{Perm, BlockSim, IRO, BlockSponge.BIRO.IRO}. + +local clone import HybridIRO as HIRO. + +local lemma RaiseHybridIRO_HybridIROEager_RaiseFun_BlockIRO_f : + equiv[RaiseHybridIRO(HybridIROEager).f ~ RaiseFun(BlockSponge.BIRO.IRO).f : ={bs, n} /\ ={glob BlockSim} /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1} ==> + EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> ={res} /\ ={glob BlockSim} /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1}]. + EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}]. proof. proc=> /=. exists* n{1}; elim*=> n'. exists* (pad2blocks bs{2}); elim*=> xs2. -call (BlockIROBitsEager_g_Block_IRO_f n' xs2). +call (HybridIROEager_g_BlockIRO_f n' xs2). auto; progress. by have [-> _] := H2 _; first apply/valid_pad2blocks. qed. -local lemma Sponge_Raise_Block_Sponge_f : +local lemma Sponge_Raise_BlockSponge_f : equiv[Sponge(Perm).f ~ RaiseFun(BlockSponge.Sponge(Perm)).f : ={bs, n, glob Perm} ==> ={res, glob Perm}]. proof. @@ -479,7 +492,7 @@ auto; progress; by rewrite -cats1 blocks2bits_cat blocks2bits_sing. auto. qed. -local lemma RealIndif &m : +local lemma RealIndif_Sponge_BlockSponge &m : Pr[RealIndif(Sponge, Perm, Dist).main() @ &m: res] = Pr[BlockSponge.RealIndif (BlockSponge.Sponge, Perm, LowerDist(Dist)).main() @ &m : res]. @@ -487,86 +500,108 @@ proof. byequiv=> //; proc. seq 2 2 : (={glob Dist, glob Perm}); first sim. call (_ : ={glob Perm}); first 2 sim. -conseq Sponge_Raise_Block_Sponge_f=> //. +conseq Sponge_Raise_BlockSponge_f=> //. auto. qed. -local lemma IdealIndifIROLazy &m : +local lemma Ideal_IRO_Experiment_HybridLazy &m : Pr[IdealIndif(IRO, RaiseSim(BlockSim), Dist).main() @ &m : res] = Pr[Experiment - (RaiseBIROBLazy(BlockIROBitsLazy), BlockSim(BlockIROBitsLazy), + (RaiseHybridIRO(HybridIROLazy), BlockSim(HybridIROLazy), Dist).main() @ &m : res]. proof. byequiv=> //; proc. seq 2 2 : (={glob Dist, glob BlockSim} /\ IRO.mp{1} = NewFMap.map0 /\ - BlockIROBitsLazy.mp{2} = NewFMap.map0). + HybridIROLazy.mp{2} = NewFMap.map0). inline *; wp; call (_ : true); auto. call (_ : ={glob Dist, glob BlockSim} /\ - IRO.mp{1} = map0 /\ BlockIROBitsLazy.mp{2} = map0 ==> + IRO.mp{1} = map0 /\ HybridIROLazy.mp{2} = map0 ==> ={res}). -proc (={glob BlockSim} /\ LazyInvar IRO.mp{1} BlockIROBitsLazy.mp{2}). +proc (={glob BlockSim} /\ LazyInvar IRO.mp{1} HybridIROLazy.mp{2}). progress; rewrite dom0 in_fset0 in H; elim H. trivial. -proc (LazyInvar IRO.mp{1} BlockIROBitsLazy.mp{2})=> //. -apply LowerFun_IRO_BlockIROBitsLazy_f. -proc (LazyInvar IRO.mp{1} BlockIROBitsLazy.mp{2})=> //. -apply LowerFun_IRO_BlockIROBitsLazy_f. -by conseq IRO_RaiseBIROBLazy_BlockIROBitsLazy_f. +proc (LazyInvar IRO.mp{1} HybridIROLazy.mp{2})=> //. +apply LowerFun_IRO_HybridIROLazy_f. +proc (LazyInvar IRO.mp{1} HybridIROLazy.mp{2})=> //. +apply LowerFun_IRO_HybridIROLazy_f. +by conseq IRO_RaiseHybridIRO_HybridIROLazy_f. auto. qed. -local lemma IdealIndifLazy &m : +local module HybridIRODist(HI : HYBRID_IRO) : HYBRID_IRO_DIST (HI) = { + + proc distinguish() : bool = { + var b : bool; + b <@ Experiment(RaiseHybridIRO(HI), BlockSim(HI), Dist).main(); + return b; + } +}. + +local lemma Experiment_Hybrid_Lazy_Eager &m : Pr[Experiment - (RaiseBIROBLazy(BlockIROBitsLazy), BlockSim(BlockIROBitsLazy), + (RaiseHybridIRO(HybridIROLazy), BlockSim(HybridIROLazy), Dist).main() @ &m : res] = Pr[Experiment - (RaiseBIROBLazy(BlockIROBitsEager), BlockSim(BlockIROBitsEager), + (RaiseHybridIRO(HybridIROEager), BlockSim(HybridIROEager), Dist).main() @ &m : res]. proof. -(* reduction to eager *) -admit. +have -> : + Pr[Experiment + (RaiseHybridIRO(HybridIROLazy), BlockSim(HybridIROLazy), + Dist).main() @ &m : res] = + Pr[HybridIRODist(HybridIROLazy).distinguish() @ &m : res]. + byequiv=> //; proc; inline *; sim. +rewrite (HybridIROLazyEager(HybridIRODist) &m). +have -> : + Pr[HybridIRODist(HybridIROEager).distinguish() @ &m : res] = + Pr[Experiment + (RaiseHybridIRO(HybridIROEager), BlockSim(HybridIROEager), + Dist).main() @ &m : res]. + byequiv=> //; proc; inline *; sim. +done. qed. -local lemma IdealIndifEager &m : +local lemma Experiment_HybridEager_Ideal_BlockIRO &m : Pr[Experiment - (RaiseBIROBLazy(BlockIROBitsEager), BlockSim(BlockIROBitsEager), + (RaiseHybridIRO(HybridIROEager), BlockSim(HybridIROEager), Dist).main() @ &m : res] = Pr[BlockSponge.IdealIndif (BlockSponge.BIRO.IRO, BlockSim, LowerDist(Dist)).main () @ &m : res]. proof. byequiv=> //; proc. seq 2 2 : - (={glob Dist, glob BlockSim} /\ BlockIROBitsEager.mp{1} = NewFMap.map0 /\ + (={glob Dist, glob BlockSim} /\ HybridIROEager.mp{1} = NewFMap.map0 /\ BlockSponge.BIRO.IRO.mp{2} = NewFMap.map0). inline *; wp; call (_ : true); auto. call (_ : ={glob Dist, glob BlockSim} /\ - BlockIROBitsEager.mp{1} = map0 /\ BlockSponge.BIRO.IRO.mp{2} = map0 ==> + HybridIROEager.mp{1} = map0 /\ BlockSponge.BIRO.IRO.mp{2} = map0 ==> ={res}). proc (={glob BlockSim} /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1}) => //. + EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}) => //. progress; rewrite dom0 in_fset0 in H; elim H. - -proc (EagerInvar BlockSponge.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1})=> //; - conseq BlockIROBitsEager_BlockIRO_f=> //. -proc (EagerInvar BlockSponge.BIRO.IRO.mp{2} BlockIROBitsEager.mp{1})=> //; - conseq BlockIROBitsEager_BlockIRO_f=> //. +proc (EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1})=> //; + conseq HybridIROEager_BlockIRO_f=> //. +proc (EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1})=> //; + conseq HybridIROEager_BlockIRO_f=> //. exists* n{1}; elim *=> n'. -conseq RaiseBIROBLazy_BlockIROBitsEager_RaiseFun_Block_IRO_f=> //. +conseq RaiseHybridIRO_HybridIROEager_RaiseFun_BlockIRO_f=> //. auto. qed. -local lemma IdealIndif &m : +local lemma IdealIndif_IRO_BlockIRO &m : Pr[IdealIndif(IRO, RaiseSim(BlockSim), Dist).main() @ &m : res] = Pr[BlockSponge.IdealIndif (BlockSponge.BIRO.IRO, BlockSim, LowerDist(Dist)).main () @ &m : res]. proof. -by rewrite (IdealIndifIROLazy &m) (IdealIndifLazy &m) (IdealIndifEager &m). +by rewrite (Ideal_IRO_Experiment_HybridLazy &m) + (Experiment_Hybrid_Lazy_Eager &m) + (Experiment_HybridEager_Ideal_BlockIRO &m). qed. lemma Conclusion' &m : @@ -577,7 +612,7 @@ lemma Conclusion' &m : Pr[BlockSponge.IdealIndif (BlockSponge.BIRO.IRO, BlockSim, LowerDist(Dist)).main() @ &m : res]|. proof. -by rewrite (RealIndif &m) (IdealIndif &m). +by rewrite (RealIndif_Sponge_BlockSponge &m) (IdealIndif_IRO_BlockIRO &m). qed. end section. From 97cf219abf12ecef1fc8fe7db50b29a12a8fe94a Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Thu, 28 Jan 2016 09:44:31 -0500 Subject: [PATCH 148/525] Completed application of RndO. --- proof/Sponge.ec | 256 +++++++++++++++++++++++++++++++++++++++++++----- 1 file changed, 232 insertions(+), 24 deletions(-) diff --git a/proof/Sponge.ec b/proof/Sponge.ec index 58d540d..51d29af 100644 --- a/proof/Sponge.ec +++ b/proof/Sponge.ec @@ -85,6 +85,8 @@ module RaiseSim (S : BlockSponge.SIMULATOR, F : DFUNCTIONALITY) = (*------------------------------- Proof --------------------------------*) +(*------------------- abstract theory of hybrid IROs -------------------*) + abstract theory HybridIRO. module type HYBRID_IRO = { @@ -94,7 +96,7 @@ module type HYBRID_IRO = { }. module type HYBRID_IRO_DIST(HI : HYBRID_IRO) = { - proc distinguish(): bool + proc distinguish() : bool }. module HybridIROEager : HYBRID_IRO, BlockSponge.BIRO.IRO = { @@ -176,18 +178,209 @@ module HybridIROLazy : HYBRID_IRO, BlockSponge.BIRO.IRO = { } }. +module HybridIROExper(HI : HYBRID_IRO, D : HYBRID_IRO_DIST) = { + proc main() : bool = { + var b : bool; + HI.init(); + b <@ D(HI).distinguish(); + return b; + } +}. + section. -declare module D : HYBRID_IRO_DIST. +declare module D : HYBRID_IRO_DIST{HybridIROEager, HybridIROLazy}. + +local clone RndO.GenEager as ERO with + type from <- block list * int, + type to <- bool, + op sampleto <- fun _ => dbool. + +local module EROExper(O : ERO.RO, D : ERO.RO_Distinguisher) = { + proc main() : bool = { + var b : bool; + O.init(); + b <@ D(O).distinguish(); + return b; + } +}. + +local lemma LRO_RO (D <: ERO.RO_Distinguisher{ERO.RO, ERO.FRO}) &m : + Pr[EROExper(ERO.LRO, D).main() @ &m : res] = + Pr[EROExper(ERO.RO, D).main() @ &m : res]. +proof. +byequiv=> //; proc. +seq 1 1 : (={glob D, ERO.RO.m}); first sim. +symmetry; call (ERO.RO_LRO_D D); auto. +qed. + +local module HIRO(RO : ERO.RO) = { + proc init() : unit = { + RO.init(); + } + + proc g(xs, n) = { + var b, bs; + var m <- ((n + r - 1) %/ r) * r; + var i <- 0; + + bs <- []; + if (valid_block xs) { + while (i < n) { + b <@ RO.get(xs, i); + bs <- rcons bs b; + i <- i + 1; + } + while (i < m) { + RO.sample(xs, i); + i <- i + 1; + } + } + return bs; + } + + proc f(xs, n) = { + var bs, ys; + bs <@ g(xs, n * r); + ys <- bits2blocks bs; + return ys; + } +}. + +local lemma HybridIROLazy_fill_in_LRO_get : + equiv[HybridIROLazy.fill_in ~ ERO.LRO.get : + (xs, i){1} = x{2} /\ HybridIROLazy.mp{1} = ERO.RO.m{2} ==> + ={res} /\ HybridIROLazy.mp{1} = ERO.RO.m{2}]. +proof. +proc=> /=. +case: (mem (dom HybridIROLazy.mp{1}) (xs{1}, i{1})). +rcondf{1} 1; first auto. rcondf{2} 2; first auto. +rnd{2}; auto; progress; apply/dbool_ll. +rcondt{1} 1; first auto. rcondt{2} 2; first auto. +wp; rnd; auto. +qed. + +local lemma HybridIROLazy_HIRO_LRO_init : + equiv[HybridIROLazy.init ~ HIRO(ERO.LRO).init : + true ==> HybridIROLazy.mp{1} = ERO.RO.m{2}]. +proof. proc; inline*; auto. qed. + +local lemma HybridIROLazy_HIRO_LRO_g : + equiv[HybridIROLazy.g ~ HIRO(ERO.LRO).g : + ={xs, n} /\ HybridIROLazy.mp{1} = ERO.RO.m{2} ==> + ={res} /\ HybridIROLazy.mp{1} = ERO.RO.m{2}]. +proof. +proc; inline ERO.LRO.sample; sp=> /=. +if=> //. +while{2} (true) (m{2} - i{2}). +progress; auto; progress; smt ml=0. +while (={xs, n, i, bs} /\ HybridIROLazy.mp{1} = ERO.RO.m{2}). +wp; call HybridIROLazy_fill_in_LRO_get; auto. +auto; progress; smt ml=0. +qed. + +local lemma HybridIROLazy_HIRO_LRO_f : + equiv[HybridIROLazy.f ~ HIRO(ERO.LRO).f : + ={xs, n} /\ HybridIROLazy.mp{1} = ERO.RO.m{2} ==> + ={res} /\ HybridIROLazy.mp{1} = ERO.RO.m{2}]. +proof. +proc; wp; call HybridIROLazy_HIRO_LRO_g; auto. +qed. + +local lemma RO_get_HybridIROEager_fill_in : + equiv[ERO.RO.get ~ HybridIROEager.fill_in : + x{1} = (xs, i){2} /\ ERO.RO.m{1} = HybridIROEager.mp{2} ==> + ={res} /\ ERO.RO.m{1} = HybridIROEager.mp{2}]. +proof. +proc=> /=. +case: (mem (dom HybridIROEager.mp{2}) (xs{2}, i{2})). +rcondf{1} 2; first auto. rcondf{2} 1; first auto. +rnd{1}; auto; progress; apply/dbool_ll. +rcondt{1} 2; first auto. rcondt{2} 1; first auto. +wp; rnd; auto. +qed. + +local lemma RO_sample_HybridIROEager_fill_in : + equiv[ERO.RO.sample ~ HybridIROEager.fill_in : + x{1} = (xs, i){2} /\ ERO.RO.m{1} = HybridIROEager.mp{2} ==> + ERO.RO.m{1} = HybridIROEager.mp{2}]. +proof. +proc=> /=; inline ERO.RO.get; sp. +case: (mem (dom HybridIROEager.mp{2}) (xs{2}, i{2})). +rcondf{1} 2; first auto. rcondf{2} 1; first auto. +rnd{1}; auto; progress; apply/dbool_ll. +rcondt{1} 2; first auto. rcondt{2} 1; first auto. +wp; rnd; auto. +qed. + +local lemma HIRO_RO_HybridIROEager_init : + equiv[HIRO(ERO.RO).init ~ HybridIROEager.init : + true ==> ={res} /\ ERO.RO.m{1} = HybridIROEager.mp{2}]. +proof. proc; inline*; auto. qed. + +local lemma HIRO_RO_HybridIROEager_g : + equiv[HIRO(ERO.RO).g ~ HybridIROEager.g : + ={xs, n} /\ ERO.RO.m{1} = HybridIROEager.mp{2} ==> + ={res} /\ ERO.RO.m{1} = HybridIROEager.mp{2}]. +proof. +proc; first sp=> /=. +if=> //. +while (={i, m, xs} /\ ERO.RO.m{1} = HybridIROEager.mp{2}). +wp; call RO_sample_HybridIROEager_fill_in; auto. +while (={i, n, xs, bs} /\ ERO.RO.m{1} = HybridIROEager.mp{2}). +wp; call RO_get_HybridIROEager_fill_in; auto. +auto. +qed. + +local lemma HIRO_RO_HybridIROEager_f : + equiv[HIRO(ERO.RO).f ~ HybridIROEager.f : + ={xs, n} /\ ERO.RO.m{1} = HybridIROEager.mp{2} ==> + ={res} /\ ERO.RO.m{1} = HybridIROEager.mp{2}]. +proof. +proc; wp; call HIRO_RO_HybridIROEager_g; auto. +qed. + +local module RODist(RO : ERO.RO) = { + proc distinguish() : bool = { + var b : bool; + b <@ D(HIRO(RO)).distinguish(); + return b; + } +}. + +local lemma Exper_HybridLazy_ERO_LRO &m : + Pr[HybridIROExper(HybridIROLazy, D).main() @ &m : res] = + Pr[EROExper(ERO.LRO, RODist).main() @ &m : res]. +proof. +byequiv=> //; proc; inline*; wp. +seq 1 1 : (={glob D} /\ HybridIROLazy.mp{1} = ERO.RO.m{2}); first auto. +call (_ : HybridIROLazy.mp{1} = ERO.RO.m{2}). +conseq HybridIROLazy_HIRO_LRO_init. +conseq HybridIROLazy_HIRO_LRO_g. +conseq HybridIROLazy_HIRO_LRO_f. +auto. +qed. -local clone RndO.GenEager as RO. +local lemma ERO_RO_Exper_HybridEager &m : + Pr[EROExper(ERO.RO, RODist).main() @ &m : res] = + Pr[HybridIROExper(HybridIROEager, D).main() @ &m : res]. +proof. +byequiv=> //; proc; inline*; wp. +seq 1 1 : (={glob D} /\ ERO.RO.m{1} = HybridIROEager.mp{2}); first auto. +call (_ : ERO.RO.m{1} = HybridIROEager.mp{2}). +conseq HIRO_RO_HybridIROEager_init. +conseq HIRO_RO_HybridIROEager_g. +conseq HIRO_RO_HybridIROEager_f. +auto. +qed. -lemma HybridIROLazyEager (D <: HYBRID_IRO_DIST) &m : - Pr[D(HybridIROLazy).distinguish() @ &m : res] = - Pr[D(HybridIROEager).distinguish() @ &m : res]. +lemma HybridIROExper_Lazy_Eager &m : + Pr[HybridIROExper(HybridIROLazy, D).main() @ &m : res] = + Pr[HybridIROExper(HybridIROEager, D).main() @ &m : res]. proof. -byequiv=> //. -admit. (* use RndO.ec result *) +by rewrite (Exper_HybridLazy_ERO_LRO &m) + (LRO_RO RODist &m) + (ERO_RO_Exper_HybridEager &m). qed. end section. @@ -281,7 +474,7 @@ seq 0 1 : LazyInvar IRO.mp{1} HybridIROLazy.mp{2}); first auto. case (valid_block xs{1}). rcondt{1} 3; first auto. rcondt{2} 4; first auto. -inline *. rcondt{1} 7; first auto. +inline*. rcondt{1} 7; first auto. seq 6 3 : (={i, n0} /\ bs{1} = bs0{2} /\ LazyInvar IRO.mp{1} HybridIROLazy.mp{2} /\ @@ -313,7 +506,7 @@ lemma IRO_RaiseHybridIRO_HybridIROLazy_f : LazyInvar IRO.mp{1} HybridIROLazy.mp{2} ==> ={res} /\ LazyInvar IRO.mp{1} HybridIROLazy.mp{2}]. proof. -proc=> /=; inline *. +proc=> /=; inline*. rcondt{1} 3; first auto. rcondt{2} 5; first auto; progress; apply valid_pad2blocks. seq 2 4 : @@ -354,7 +547,7 @@ lemma HybridIROEager_f_g : ={xs, HybridIROEager.mp} /\ n{1} * r = n{2} ==> res{1} = bits2blocks res{2} /\ ={HybridIROEager.mp}]. proof. -proc=> /=; inline *. +proc=> /=; inline*. seq 5 3 : (={i, HybridIROEager.mp} /\ xs0{1} = xs{2} /\ bs0{1} = bs{2} /\ n0{1} = n{2} /\ m{1} = n0{1} /\ m{2} = n{2}). @@ -404,6 +597,8 @@ conseq size bs{2} = (n' + r - 1) %/ r /\ EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1})=> //. progress; apply/needed_blocks_suff. +splitwhile{1} 1 : i < (n' %/ r) * r. +splitwhile{2} 1 : i < n' %/ r. admit. qed. @@ -514,7 +709,7 @@ byequiv=> //; proc. seq 2 2 : (={glob Dist, glob BlockSim} /\ IRO.mp{1} = NewFMap.map0 /\ HybridIROLazy.mp{2} = NewFMap.map0). -inline *; wp; call (_ : true); auto. +inline*; wp; call (_ : true); auto. call (_ : ={glob Dist, glob BlockSim} /\ @@ -532,36 +727,49 @@ auto. qed. local module HybridIRODist(HI : HYBRID_IRO) : HYBRID_IRO_DIST (HI) = { - proc distinguish() : bool = { var b : bool; - b <@ Experiment(RaiseHybridIRO(HI), BlockSim(HI), Dist).main(); + BlockSim(HI).init(); + b <@ Dist(RaiseHybridIRO(HI), BlockSim(HI)).distinguish(); return b; } }. -local lemma Experiment_Hybrid_Lazy_Eager &m : +local lemma Experiment_HybridIROExper_Lazy &m : Pr[Experiment (RaiseHybridIRO(HybridIROLazy), BlockSim(HybridIROLazy), Dist).main() @ &m : res] = + Pr[HybridIROExper(HybridIROLazy, HybridIRODist).main() @ &m : res]. +proof. +byequiv=> //; proc; inline*. +seq 2 2 : (={glob Dist, glob BlockSim, HybridIROLazy.mp}). +swap{2} 1 1; wp; call (_ : true); auto. +sim. +qed. + +local lemma HybridIROExper_Experiment_Eager &m : + Pr[HybridIROExper(HybridIROEager, HybridIRODist).main() @ &m : res] = Pr[Experiment (RaiseHybridIRO(HybridIROEager), BlockSim(HybridIROEager), Dist).main() @ &m : res]. proof. -have -> : +byequiv=> //; proc; inline*. +seq 2 2 : (={glob Dist, glob BlockSim, HybridIROEager.mp}). +swap{2} 1 1; wp; call (_ : true); auto. +sim. +qed. + +local lemma Experiment_Hybrid_Lazy_Eager &m : Pr[Experiment (RaiseHybridIRO(HybridIROLazy), BlockSim(HybridIROLazy), Dist).main() @ &m : res] = - Pr[HybridIRODist(HybridIROLazy).distinguish() @ &m : res]. - byequiv=> //; proc; inline *; sim. -rewrite (HybridIROLazyEager(HybridIRODist) &m). -have -> : - Pr[HybridIRODist(HybridIROEager).distinguish() @ &m : res] = Pr[Experiment (RaiseHybridIRO(HybridIROEager), BlockSim(HybridIROEager), Dist).main() @ &m : res]. - byequiv=> //; proc; inline *; sim. -done. +proof. +by rewrite (Experiment_HybridIROExper_Lazy &m) + (HybridIROExper_Lazy_Eager HybridIRODist &m) + (HybridIROExper_Experiment_Eager &m). qed. local lemma Experiment_HybridEager_Ideal_BlockIRO &m : @@ -575,7 +783,7 @@ byequiv=> //; proc. seq 2 2 : (={glob Dist, glob BlockSim} /\ HybridIROEager.mp{1} = NewFMap.map0 /\ BlockSponge.BIRO.IRO.mp{2} = NewFMap.map0). -inline *; wp; call (_ : true); auto. +inline*; wp; call (_ : true); auto. call (_ : ={glob Dist, glob BlockSim} /\ From 5fb2b23f81e79323da44c287d39effef1a597341 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Sat, 30 Jan 2016 17:05:12 -0500 Subject: [PATCH 149/525] Isolated the two places (admits now) where must move from bits to blocks. --- proof/Common.ec | 63 ++++++++++++++++- proof/Sponge.ec | 182 +++++++++++++++++++++++++++++++++--------------- 2 files changed, 186 insertions(+), 59 deletions(-) diff --git a/proof/Common.ec b/proof/Common.ec index 16e8ac0..5e28a29 100644 --- a/proof/Common.ec +++ b/proof/Common.ec @@ -94,6 +94,11 @@ clone export LazyRP as Perm with (*---------------------- Needed Blocks Computation ---------------------*) +lemma needed_blocks0 : (0 + r - 1) %/ r = 0. +proof. +rewrite -divz_eq0 1:gt0_r; smt ml=0 w=(gt0_r). +qed. + lemma needed_blocks_non_pos (n : int) : n <= 0 => (n + r - 1) %/ r <= 0. proof. @@ -130,7 +135,63 @@ lemma needed_blocks_prod_r (n : int) : (n * r + r - 1) %/ r = n. proof. rewrite -addzA divzMDl 1:gtr_eqF 1:gt0_r // divz_small //. -smt ml=0 w=(gt0_n). +smt ml=0 w=(gt0_r). +qed. + +lemma needed_blocks_eq_div_r (n : int) : + r %| n <=> n %/ r = (n + r - 1) %/ r. +proof. +split=> [r_dvd_n | eq_div]. +have {2}<- := divzK r n _; first trivial. +by rewrite needed_blocks_prod_r. +rewrite dvdzE. +rewrite {2}(@divz_eq n r) -!addrA @divzMDl 1:gtr_eqF 1:gt0_r // + -{1}(@addz0 (n %/ r)) in eq_div. +have eq_div_simp : (n %% r + (r - 1)) %/ r = 0 + by rewrite (@addzI (n %/ r) 0 ((n %% r + (r - 1)) %/ r)). +have [_ n_mod_r_plus_r_min1_lt_r] : 0 <= n %% r + (r - 1) < r + by rewrite divz_eq0 1:gt0_r. +have n_mod_r_plus_r_min1_lt_r_simp : n %% r <= 0 + by rewrite -(@lez_add2r (r - 1)) /= -ltzS -addzA /=. +by apply lez_anti; split=> // _; rewrite modz_ge0 1:gtr_eqF 1:gt0_r. +qed. + +lemma needed_blocks_succ_eq_div_r (n : int) : + ! r %| n <=> n %/ r + 1 = (n + r - 1) %/ r. +proof. +split=> [not_r_dvd_n | succ_eq_div]. +have {2}-> := divz_eq n r. +rewrite -!addrA divzMDl 1:gtr_eqF 1:gt0_r //; ring. +rewrite dvdzE in not_r_dvd_n. +have gt0_mod : 0 < n %% r + by rewrite ltz_def=> |>; rewrite modz_ge0 1:gtr_eqF 1:gt0_r. +have [r_le_n_mod_r_plus_r_min1 n_mod_r_plus_r_min1_lt_r] : + r <= n %% r + (r - 1) < r + r. + split=> [| _]. + by rewrite (@addrC r (-1)) addrA -{1}add0z lez_add2r -ltzS + -addrA addNz. + by rewrite (@addrC r (-1)) addrA ltz_add2r -(@ltz_add2r 1) -addrA /= + (@ltr_trans r) 1:ltz_pmod 1:gt0_r -{1}addz0 ler_lt_add 1:lezz ltr01. +have [m [-> [ge0_m lt_mr]]] : + exists (m : int), n %% r + (r - 1) = r + m /\ 0 <= m < r. + exists (n %% r + (r - 1) - r). + split; first ring. + split=> [| _]. + by rewrite -(@lez_add2r r) -addrA addNz. + by rewrite -(@ltz_add2r r) -addrA addNz. +rewrite -{1}(@mul1z r) divzMDl 1:gtr_eqF 1:gt0_r // + opprD addrA /=. +rewrite divz_small; [by rewrite ger0_norm 1:ge0_r | done]. +have not_eq_dvd : n %/ r <> (n + r - 1) %/ r by smt ml=0. +by rewrite needed_blocks_eq_div_r. +qed. + +lemma needed_blocks_rel_div_r (n : int) : + n %/ r = (n + r - 1) %/ r \/ n %/ r + 1 = (n + r - 1) %/ r. +proof. +case: (r %| n)=> [r_dvd_n | not_r_dvd_n]. +left; by apply/needed_blocks_eq_div_r. +right; by apply/needed_blocks_succ_eq_div_r. qed. (* ------------------------- Padding/Unpadding ------------------------ *) diff --git a/proof/Sponge.ec b/proof/Sponge.ec index 51d29af..11f338b 100644 --- a/proof/Sponge.ec +++ b/proof/Sponge.ec @@ -99,7 +99,7 @@ module type HYBRID_IRO_DIST(HI : HYBRID_IRO) = { proc distinguish() : bool }. -module HybridIROEager : HYBRID_IRO, BlockSponge.BIRO.IRO = { +module HybridIROLazy : HYBRID_IRO, BlockSponge.BIRO.IRO = { var mp : (block list * int, bool) fmap proc init() : unit = { @@ -115,7 +115,6 @@ module HybridIROEager : HYBRID_IRO, BlockSponge.BIRO.IRO = { proc g(xs, n) = { var b, bs; - var m <- ((n + r - 1) %/ r) * r; var i <- 0; bs <- []; @@ -125,10 +124,6 @@ module HybridIROEager : HYBRID_IRO, BlockSponge.BIRO.IRO = { bs <- rcons bs b; i <- i + 1; } - while (i < m) { (* eager part *) - fill_in(xs, i); - i <- i + 1; - } } return bs; } @@ -141,7 +136,16 @@ module HybridIROEager : HYBRID_IRO, BlockSponge.BIRO.IRO = { } }. -module HybridIROLazy : HYBRID_IRO, BlockSponge.BIRO.IRO = { +module HybridIROExper(HI : HYBRID_IRO, D : HYBRID_IRO_DIST) = { + proc main() : bool = { + var b : bool; + HI.init(); + b <@ D(HI).distinguish(); + return b; + } +}. + +module HybridIROEager : HYBRID_IRO, BlockSponge.BIRO.IRO = { var mp : (block list * int, bool) fmap proc init() : unit = { @@ -157,6 +161,7 @@ module HybridIROLazy : HYBRID_IRO, BlockSponge.BIRO.IRO = { proc g(xs, n) = { var b, bs; + var m <- ((n + r - 1) %/ r) * r; var i <- 0; bs <- []; @@ -166,6 +171,10 @@ module HybridIROLazy : HYBRID_IRO, BlockSponge.BIRO.IRO = { bs <- rcons bs b; i <- i + 1; } + while (i < m) { (* eager part *) + fill_in(xs, i); + i <- i + 1; + } } return bs; } @@ -178,15 +187,6 @@ module HybridIROLazy : HYBRID_IRO, BlockSponge.BIRO.IRO = { } }. -module HybridIROExper(HI : HYBRID_IRO, D : HYBRID_IRO_DIST) = { - proc main() : bool = { - var b : bool; - HI.init(); - b <@ D(HI).distinguish(); - return b; - } -}. - section. declare module D : HYBRID_IRO_DIST{HybridIROEager, HybridIROLazy}. @@ -551,9 +551,7 @@ proc=> /=; inline*. seq 5 3 : (={i, HybridIROEager.mp} /\ xs0{1} = xs{2} /\ bs0{1} = bs{2} /\ n0{1} = n{2} /\ m{1} = n0{1} /\ m{2} = n{2}). -auto; progress; - first 2 rewrite -addzA divzMDl 1:gtr_eqF 1:gt0_r // divz_small //; - smt ml=0 w=(gt0_n). +auto; progress; first 2 by rewrite needed_blocks_prod_r. if=> //; wp. while (={i, HybridIROEager.mp} /\ xs0{1} = xs{2} /\ @@ -568,37 +566,95 @@ sp; wp; if=> //; rnd; auto. auto. qed. -lemma HybridIROEager_g_BlockIRO_f (n' : int) (x' : block list) : +lemma HybridIROEager_g_BlockIRO_f (n1 : int) (x2 : block list) : equiv[HybridIROEager.g ~ BlockSponge.BIRO.IRO.f : - n' = n{1} /\ xs{1} = x{2} /\ x' = x{2} /\ + n1 = n{1} /\ x2 = x{2} /\ xs{1} = x{2} /\ n{2} = (n{1} + r - 1) %/ r /\ EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} /\ - (valid_block x' => - res{1} = take n' (blocks2bits res{2}) /\ - size res{2} = (n' + r - 1) %/ r) /\ - (! valid_block x' => res{1} = [] /\ res{2} = [])]. + (valid_block x2 => + (n1 <= 0 => res{1} = [] /\ res{2} = []) /\ + (0 < n1 => + res{1} = take n1 (blocks2bits res{2}) /\ + size res{2} = (n1 + r - 1) %/ r)) /\ + (! valid_block x2 => res{1} = [] /\ res{2} = [])]. proof. proc=> /=. seq 3 2 : - (n' = n{1} /\ xs{1} = x{2} /\ x' = x{2} /\ + (n1 = n{1} /\ xs{1} = x{2} /\ x2 = x{2} /\ n{2} = (n{1} + r - 1) %/ r /\ n{2} * r = m{1} /\ i{1} = 0 /\ i{2} = 0 /\ bs{1} = [] /\ bs{2} = [] /\ EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). auto; progress. if=> //. +case: (n1 < 0). +rcondf{1} 1; first auto; progress; smt ml=0. +rcondf{2} 1; first auto; progress; smt ml=0 w=(needed_blocks_non_pos). +rcondf{1} 1; first auto; progress; smt ml=0 w=(needed_blocks_non_pos gt0_r). +auto; progress; + [by rewrite blocks2bits_nil | by smt ml=0 w=(needed_blocks0)]. +(* 0 <= n1 *) conseq (_ : - xs{1} = x{2} /\ n' = n{1} /\ n{2} = (n{1} + r - 1) %/ r /\ + xs{1} = x{2} /\ n1 = n{1} /\ 0 <= n1 /\ n{2} = (n{1} + r - 1) %/ r /\ n{2} * r = m{1} /\ n{1} <= m{1} /\ i{1} = 0 /\ i{2} = 0 /\ bs{1} = [] /\ bs{2} = [] /\ EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> - bs{1} = take n' (blocks2bits bs{2}) /\ - size bs{2} = (n' + r - 1) %/ r /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1})=> //. -progress; apply/needed_blocks_suff. -splitwhile{1} 1 : i < (n' %/ r) * r. -splitwhile{2} 1 : i < n' %/ r. + bs{1} = take n1 (blocks2bits bs{2}) /\ + size bs{2} = (n1 + r - 1) %/ r /\ + EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). +progress; [smt ml=0 | apply/needed_blocks_suff]. +move=> |> &1 &2 ? ? ? mp1 mp2 bs ? ? ?; + smt ml=0 w=(size_eq0 needed_blocks0 take0). +splitwhile{1} 1 : i < (n1 %/ r) * r. +splitwhile{2} 1 : i < n1 %/ r. +seq 1 1 : + (xs{1} = x{2} /\ n1 = n{1} /\ 0 <= n1 /\ n{2} = (n1 + r - 1) %/ r /\ + n{2} * r = m{1} /\ n{1} <= m{1} /\ i{1} = n1 %/ r * r /\ + i{2} = n1 %/ r /\ size bs{2} = i{2} /\ bs{1} = blocks2bits bs{2} /\ + EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). +admit. +conseq + (_ : + n1 = n{1} /\ 0 <= n1 /\ xs{1} = x{2} /\ n{2} = (n1 + r - 1) %/ r /\ + n{2} * r = m{1} /\ n{1} <= m{1} /\ i{1} = n1 %/ r * r /\ + i{2} = n1 %/ r /\ size bs{2} = i{2} /\ bs{1} = blocks2bits bs{2} /\ + EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} /\ + (i{2} = n{2} \/ i{2} + 1 = n{2}) ==> + _). +progress; by apply/needed_blocks_rel_div_r. +case: (i{2} = n{2}). +rcondf{2} 1; first auto; progress; smt ml=0. +rcondf{1} 1; first auto; progress; smt ml=0. +rcondf{1} 1; first auto; progress; smt ml=0. +auto=> |> &1 &2 ? ? sz_eq ? ? need_blks_eq. +split. +have -> : n{1} = size (blocks2bits bs{2}) + by rewrite size_blocks2bits sz_eq -mulzC divzK 1:needed_blocks_eq_div_r. +by rewrite take_size. +by rewrite sz_eq need_blks_eq. +(* i{2} <> n{2}, so i{2} + 1 = n{2} *) +rcondt{2} 1; first auto; progress; smt ml=0. +rcondf{2} 4; first auto; call (_ : true). +if=> //. auto; progress; smt ml=0. +wp; exists* i{1}; elim*=> i1; exists* bs{2}; elim*=> bs2. +conseq + (_ : + n1 = n{1} /\ 0 <= n1 /\ i1 = i{1} /\ bs2 = bs{2} /\ xs{1} = x{2} /\ + i{1} = i{2} * r /\ n{1} <= m{1} /\ m{1} - i{1} = r /\ + bs{1} = blocks2bits bs2 /\ + EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + bs{1} = blocks2bits bs2 ++ take (n1 - i1) (w2bits b{2}) /\ + EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). +progress; smt ml=0. +move=> |> &1 &2 ? ? sz_eq ? ? ? mp1 mp2 b ?. +split. +rewrite -cats1 blocks2bits_cat blocks2bits_sing take_cat. +have -> /= : !(n{1} < size(blocks2bits bs{2})). + rewrite size_blocks2bits sz_eq. + by smt ml=0 w=(needed_blocks_correct). +by rewrite size_blocks2bits sz_eq; congr; congr; smt ml=0. +by rewrite size_rcons; smt ml=0. admit. qed. @@ -617,23 +673,27 @@ transitivity EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> res{1} = (blocks2bits res{2}) /\ EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). -progress. +move=> |> &1 &2 ? n_eq inv. exists BlockSponge.BIRO.IRO.mp{2}, HybridIROEager.mp{1}, (xs{1}, n{1} * r). - progress; by rewrite H0. +move=> |>; by rewrite n_eq. progress; apply blocks2bitsK. conseq HybridIROEager_f_g. -progress; by rewrite H0. +move=> |> &1 &2 ? -> ? //. exists* n{1}; elim*=> n1. exists* xs{1}; elim*=> xs'. conseq (HybridIROEager_g_BlockIRO_f n1 xs')=> //. -progress; rewrite H0; by rewrite needed_blocks_prod_r. -progress. +move=> |> &1 &2 ? -> inv; by rewrite needed_blocks_prod_r. +move=> |> &1 &2 ? n1_eq ? res1 res2 ? ? ? vb_imp not_vb_imp. case (valid_block xs{1})=> [vb_xs1 | not_vb_xs1]. -have [-> size_result_R] := H3 vb_xs1. -have -> : n{1} = size(blocks2bits result_R) - by rewrite size_blocks2bits size_result_R H0 - needed_blocks_prod_r mulzC. +have [le0_n1_imp gt0_n1_imp] := vb_imp vb_xs1. +case: (n{1} <= 0)=> [le0_n1 | not_le0_n1]. +smt ml=0. +have gt0_n1 : 0 < n{1} by smt ml=0. +have [-> sz_res2] := gt0_n1_imp gt0_n1. +have -> : n{1} = size(blocks2bits res2) + by rewrite size_blocks2bits sz_res2 n1_eq + needed_blocks_prod_r mulzC. by rewrite take_size. -by have [->->] := H4 not_vb_xs1. +by have [->->] := not_vb_imp not_vb_xs1. qed. end HybridIRO. @@ -645,21 +705,6 @@ declare module Dist : DISTINGUISHER{Perm, BlockSim, IRO, BlockSponge.BIRO.IRO}. local clone import HybridIRO as HIRO. -local lemma RaiseHybridIRO_HybridIROEager_RaiseFun_BlockIRO_f : - equiv[RaiseHybridIRO(HybridIROEager).f ~ RaiseFun(BlockSponge.BIRO.IRO).f : - ={bs, n} /\ ={glob BlockSim} /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> - ={res} /\ ={glob BlockSim} /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}]. -proof. -proc=> /=. -exists* n{1}; elim*=> n'. -exists* (pad2blocks bs{2}); elim*=> xs2. -call (HybridIROEager_g_BlockIRO_f n' xs2). -auto; progress. -by have [-> _] := H2 _; first apply/valid_pad2blocks. -qed. - local lemma Sponge_Raise_BlockSponge_f : equiv[Sponge(Perm).f ~ RaiseFun(BlockSponge.Sponge(Perm)).f : ={bs, n, glob Perm} ==> ={res, glob Perm}]. @@ -699,6 +744,27 @@ conseq Sponge_Raise_BlockSponge_f=> //. auto. qed. +local lemma RaiseHybridIRO_HybridIROEager_RaiseFun_BlockIRO_f : + equiv[RaiseHybridIRO(HybridIROEager).f ~ RaiseFun(BlockSponge.BIRO.IRO).f : + ={bs, n} /\ ={glob BlockSim} /\ + EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + ={res} /\ ={glob BlockSim} /\ + EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}]. +proof. +proc=> /=. +exists* n{1}; elim*=> n'. +exists* (pad2blocks bs{2}); elim*=> xs2. +call (HybridIROEager_g_BlockIRO_f n' xs2). +auto=> |> &1 &2 ? res1 res2 mp1 mp2 ? vb_imp not_vb_imp. +case: (valid_block (pad2blocks bs{2}))=> [vb | not_vb]. +have [le0_n2_imp gt0_n2_imp] := vb_imp vb. +case: (n{2} <= 0)=> [le0_n2 | not_le0_n2]. +smt ml=0. +have gt0_n2 : 0 < n{2} by smt ml=0. +by have [-> _] := gt0_n2_imp gt0_n2. +have [-> ->] := not_vb_imp not_vb; by rewrite blocks2bits_nil. +qed. + local lemma Ideal_IRO_Experiment_HybridLazy &m : Pr[IdealIndif(IRO, RaiseSim(BlockSim), Dist).main() @ &m : res] = Pr[Experiment From 5665b91877be43f68a80a9d68b0cef045b2df1c0 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Tue, 2 Feb 2016 10:37:45 -0500 Subject: [PATCH 150/525] Killed an [smt ml=0] that was now failing. --- proof/Common.ec | 13 ++++++++++--- 1 file changed, 10 insertions(+), 3 deletions(-) diff --git a/proof/Common.ec b/proof/Common.ec index 5e28a29..8222121 100644 --- a/proof/Common.ec +++ b/proof/Common.ec @@ -44,9 +44,16 @@ clone export BitWord as Block with lemma dvdz_close (n : int) : r %| n => 0 < n < 2 * r => n = r. proof. -move=> dvd_rn [gt0_n lt_n_2r]. -have [m] n_eq /# : exists m, m * r = n - by exists (n %/ r); apply dvdz_eq. +move=> dvd_rn. +have [m] <- : exists m, m * r = n + by exists (n %/ r); by rewrite divzK. +move=> [gt0_m_tim_r m_tim_r_lt_2r]. +case: (m = 1)=> // /ltr_total [/ltz1 le0_m | gt1_m]. +rewrite pmulr_lgt0 1:gt0_r in gt0_m_tim_r. +have // : 0 < 0 by rewrite (@ltr_le_trans m). +rewrite ltr_pmul2r 1:gt0_r in m_tim_r_lt_2r. +rewrite -lez_add1r /= in gt1_m. +have // : 2 < 2 by rewrite (@ler_lt_trans m). qed. lemma chunk_nil' ['a] r : BitChunking.chunk r [<:'a>] = []. From d6ce7f2a590c5c1fd0da9cd23a70ae32d8d24ddc Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Wed, 3 Feb 2016 11:14:03 -0500 Subject: [PATCH 151/525] Made Common.ec and Sponge.ec check with *both* Alt-Ergo and Z3 (so not relying on a single SMT-solver being sound). --- proof/Common.ec | 14 +++++++++++++- proof/Sponge.ec | 34 ++++++++++++++++++++-------------- 2 files changed, 33 insertions(+), 15 deletions(-) diff --git a/proof/Common.ec b/proof/Common.ec index 8222121..5359872 100644 --- a/proof/Common.ec +++ b/proof/Common.ec @@ -90,6 +90,10 @@ case (zs = [])=> // zs_non_nil. elim ih=> // ->. by rewrite (@last_nonempty y z). qed. +lemma not_none ['a] (x : 'a option) : + x <> None => x = Some(oget x). +proof. case: (x)=> //. qed. + (*------------------------------ Primitive -----------------------------*) clone export LazyRP as Perm with @@ -556,7 +560,15 @@ rewrite vb_xs /= in bp. move: bp=> [s n] _ b2b_xs_eq. case: (last b0 xs <> b0)=> [// | last_xs_eq_b0]. rewrite nnot in last_xs_eq_b0. -have xs_non_nil : xs <> [] by smt ml=0. +have xs_non_nil : xs <> []. + case: xs b2b_xs_eq last_xs_eq_b0 vb_xs=> // contrad. + rewrite blocks2bits_nil in contrad. + have contrad_last : + false = last false (s ++ [true] ++ nseq n false ++ [true]). + have {1}-> : false = last false [] by trivial. + by rewrite {1}contrad. + rewrite last_cat /= in contrad_last. + elim contrad_last. elim (last_drop_all_but_last b0 xs)=> // drop_xs. have xs_take_drop : xs = take (size xs - 1) xs ++ drop (size xs - 1) xs by rewrite cat_take_drop. diff --git a/proof/Sponge.ec b/proof/Sponge.ec index 11f338b..36928de 100644 --- a/proof/Sponge.ec +++ b/proof/Sponge.ec @@ -479,7 +479,9 @@ seq 6 3 : (={i, n0} /\ bs{1} = bs0{2} /\ LazyInvar IRO.mp{1} HybridIROLazy.mp{2} /\ pad2blocks x{1} = xs0{2}). -auto; progress; have {2}<- /# := unpadBlocksK xs0{2}. +auto; progress; + have {2}<- := unpadBlocksK xs0{2}; first + by rewrite (@not_none (unpad_blocks xs0{2})). wp. while (={i, n0} /\ bs{1} = bs0{2} /\ @@ -489,11 +491,12 @@ sp; auto. if. progress; smt ml=0. rnd; auto; progress; - [smt ml=0 w=(getP_eq) | - smt ml=0 w=(lazy_invar_upd_mem_dom_iff) | - smt ml=0 w=(lazy_invar_upd_mem_dom_iff) | - smt ml=0 w=(lazy_invar_upd2_vb) | - smt ml=0 w=(lazy_invar_upd_lu_eq)]. + [by rewrite !getP_eq | + by rewrite -(@lazy_invar_upd_mem_dom_iff IRO.mp{1}) | + by rewrite (@lazy_invar_upd_mem_dom_iff IRO.mp{1} HybridIROLazy.mp{2}) | + by rewrite (@lazy_invar_upd2_vb IRO.mp{1} HybridIROLazy.mp{2} + x{1} xs2 i{2} n2 mpL) | + by rewrite (@lazy_invar_upd_lu_eq IRO.mp{1} HybridIROLazy.mp{2})]. auto; progress; smt ml=0. auto. rcondf{1} 3; first auto. rcondf{2} 4; first auto. @@ -519,12 +522,13 @@ while wp; sp. if. progress; smt ml=0. -rnd; skip; progress; - [smt ml=0 w=(getP_eq) | - smt ml=0 w=(lazy_invar_upd_mem_dom_iff) | - smt ml=0 w=(lazy_invar_upd_mem_dom_iff) | - smt ml=0 w=(lazy_invar_upd2_vb) | - smt ml=0 w=(lazy_invar_upd_lu_eq)]. +rnd; auto; progress; + [by rewrite !getP_eq | + by rewrite -(@lazy_invar_upd_mem_dom_iff IRO.mp{1}) | + by rewrite (@lazy_invar_upd_mem_dom_iff IRO.mp{1} HybridIROLazy.mp{2}) | + by rewrite (@lazy_invar_upd2_vb IRO.mp{1} HybridIROLazy.mp{2} + x{1} xs1 i{2} n1 mpL) | + by rewrite (@lazy_invar_upd_lu_eq IRO.mp{1} HybridIROLazy.mp{2})]. auto; progress; smt ml=0. auto. qed. @@ -589,8 +593,10 @@ auto; progress. if=> //. case: (n1 < 0). rcondf{1} 1; first auto; progress; smt ml=0. -rcondf{2} 1; first auto; progress; smt ml=0 w=(needed_blocks_non_pos). -rcondf{1} 1; first auto; progress; smt ml=0 w=(needed_blocks_non_pos gt0_r). +rcondf{2} 1; first auto; progress; + by rewrite -lezNgt needed_blocks_non_pos ltzW. +rcondf{1} 1; first auto; progress; + by rewrite -lezNgt pmulr_lle0 1:gt0_r needed_blocks_non_pos ltzW. auto; progress; [by rewrite blocks2bits_nil | by smt ml=0 w=(needed_blocks0)]. (* 0 <= n1 *) From a804f3ba07e9ff6d732459d2b7374b0b39a500f9 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Wed, 3 Feb 2016 11:24:35 -0500 Subject: [PATCH 152/525] Make IRO work for Z3 as well as Alt-Ergo. --- proof/IRO.eca | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/proof/IRO.eca b/proof/IRO.eca index 697902f..1519b1d 100644 --- a/proof/IRO.eca +++ b/proof/IRO.eca @@ -29,8 +29,8 @@ pred prefix_closed' (m : (from * int,to) fmap) = 0 <= i < n => mem (dom m) (x,i). -lemma prefix_closed_equiv m: prefix_closed m <=> prefix_closed' m -by []. +lemma prefix_closed_equiv m: prefix_closed m <=> prefix_closed' m. +proof. smt ml=0. qed. (* official version: *) From 2a8c9cd8ab4ae03bda909dfa3357954fe29d3b8a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Wed, 3 Feb 2016 18:36:23 +0100 Subject: [PATCH 153/525] Filling in admits. Moving a lemma to stdlib. --- proof/Common.ec | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/proof/Common.ec b/proof/Common.ec index 5359872..dea1847 100644 --- a/proof/Common.ec +++ b/proof/Common.ec @@ -69,13 +69,16 @@ qed. lemma b0 : b0 = bits2w(nseq r false). proof. -admit. (* FIXME *) +rewrite wordP=> i ge0_i_ltr; rewrite offunifE ge0_i_ltr /= getE ge0_i_ltr /=. +rewrite ofwordK 1:Array.size_mkarray 1:size_nseq 1:/#. +by rewrite Array.getE Array.ofarrayK nth_nseq. qed. lemma bits2w_inj_eq (cs ds : bool list) : size cs = r => size ds = r => bits2w cs = bits2w ds <=> cs = ds. proof. -admit. (* FIXME *) +rewrite -!Array.size_mkarray=> s_cs_r s_ds_r; split=> //=. +by move=> @/bits2w /(mkword_pinj _ _ s_cs_r s_ds_r) /Array.mkarray_inj. qed. lemma last_drop_all_but_last (y : 'a, xs : 'a list) : @@ -90,10 +93,6 @@ case (zs = [])=> // zs_non_nil. elim ih=> // ->. by rewrite (@last_nonempty y z). qed. -lemma not_none ['a] (x : 'a option) : - x <> None => x = Some(oget x). -proof. case: (x)=> //. qed. - (*------------------------------ Primitive -----------------------------*) clone export LazyRP as Perm with From 03169f017ad89d565343079dcb823780565066eb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Wed, 3 Feb 2016 18:43:36 +0100 Subject: [PATCH 154/525] Move old to core. --- proof/.dir-locals.el | 2 +- proof/{old => core}/ConcreteF.eca | 0 proof/{old => core}/Gcol.eca | 0 proof/{old => core}/Gconcl.ec | 0 proof/{old => core}/Gext.eca | 0 proof/{old => core}/Handle.eca | 0 proof/{old => core}/IndifPadding.ec | 0 proof/{old => core}/LazyRO.eca | 0 proof/{old => core}/NBRO.eca | 0 proof/{old => core}/SLCommon.ec | 0 proof/{old => core}/Utils.ec | 0 11 files changed, 1 insertion(+), 1 deletion(-) rename proof/{old => core}/ConcreteF.eca (100%) rename proof/{old => core}/Gcol.eca (100%) rename proof/{old => core}/Gconcl.ec (100%) rename proof/{old => core}/Gext.eca (100%) rename proof/{old => core}/Handle.eca (100%) rename proof/{old => core}/IndifPadding.ec (100%) rename proof/{old => core}/LazyRO.eca (100%) rename proof/{old => core}/NBRO.eca (100%) rename proof/{old => core}/SLCommon.ec (100%) rename proof/{old => core}/Utils.ec (100%) diff --git a/proof/.dir-locals.el b/proof/.dir-locals.el index fbf2dcd..e868573 100644 --- a/proof/.dir-locals.el +++ b/proof/.dir-locals.el @@ -1,4 +1,4 @@ ((easycrypt-mode . ((eval . (flet ((pre (s) (concat (locate-dominating-file buffer-file-name ".dir-locals.el") s))) - (setq easycrypt-load-path `(,(pre ".") ,(pre "variant") ,(pre "old")))))))) + (setq easycrypt-load-path `(,(pre ".") ,(pre "variant") ,(pre "core")))))))) diff --git a/proof/old/ConcreteF.eca b/proof/core/ConcreteF.eca similarity index 100% rename from proof/old/ConcreteF.eca rename to proof/core/ConcreteF.eca diff --git a/proof/old/Gcol.eca b/proof/core/Gcol.eca similarity index 100% rename from proof/old/Gcol.eca rename to proof/core/Gcol.eca diff --git a/proof/old/Gconcl.ec b/proof/core/Gconcl.ec similarity index 100% rename from proof/old/Gconcl.ec rename to proof/core/Gconcl.ec diff --git a/proof/old/Gext.eca b/proof/core/Gext.eca similarity index 100% rename from proof/old/Gext.eca rename to proof/core/Gext.eca diff --git a/proof/old/Handle.eca b/proof/core/Handle.eca similarity index 100% rename from proof/old/Handle.eca rename to proof/core/Handle.eca diff --git a/proof/old/IndifPadding.ec b/proof/core/IndifPadding.ec similarity index 100% rename from proof/old/IndifPadding.ec rename to proof/core/IndifPadding.ec diff --git a/proof/old/LazyRO.eca b/proof/core/LazyRO.eca similarity index 100% rename from proof/old/LazyRO.eca rename to proof/core/LazyRO.eca diff --git a/proof/old/NBRO.eca b/proof/core/NBRO.eca similarity index 100% rename from proof/old/NBRO.eca rename to proof/core/NBRO.eca diff --git a/proof/old/SLCommon.ec b/proof/core/SLCommon.ec similarity index 100% rename from proof/old/SLCommon.ec rename to proof/core/SLCommon.ec diff --git a/proof/old/Utils.ec b/proof/core/Utils.ec similarity index 100% rename from proof/old/Utils.ec rename to proof/core/Utils.ec From add003d69ce52ee0df651b98fd388a71363b8b66 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Wed, 3 Feb 2016 18:51:17 +0100 Subject: [PATCH 155/525] Alpha: not_none -> some_oget. --- proof/Sponge.ec | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/proof/Sponge.ec b/proof/Sponge.ec index 36928de..de71e97 100644 --- a/proof/Sponge.ec +++ b/proof/Sponge.ec @@ -481,7 +481,7 @@ seq 6 3 : pad2blocks x{1} = xs0{2}). auto; progress; have {2}<- := unpadBlocksK xs0{2}; first - by rewrite (@not_none (unpad_blocks xs0{2})). + by rewrite (@some_oget (unpad_blocks xs0{2})). wp. while (={i, n0} /\ bs{1} = bs0{2} /\ From 108a9eb286600e0c9bacc49d80a9491a726c143b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Wed, 3 Feb 2016 18:51:41 +0100 Subject: [PATCH 156/525] Dealing with old theory renames. --- proof/AbsorbToBlocks.ec | 94 ++++++++++++++++++------------------ proof/variant/LeakyAbsorb.ec | 7 ++- proof/variant/RndOrcl.eca | 2 +- 3 files changed, 51 insertions(+), 52 deletions(-) diff --git a/proof/AbsorbToBlocks.ec b/proof/AbsorbToBlocks.ec index f22d47c..d2c27a7 100644 --- a/proof/AbsorbToBlocks.ec +++ b/proof/AbsorbToBlocks.ec @@ -1,6 +1,6 @@ (* -------------------------------------------------------------------- *) require import Option Pair Int Real List FSet NewFMap. -require (*--*) Absorb Block. +require (*--*) AbsorbSponge BlockSponge. (* -------------------------------------------------------------------- *) require import Common. @@ -8,7 +8,7 @@ require import Common. op cast: 'a NewDistr.distr -> 'a distr. (* -------------------------------------------------------------------- *) -module LowerFun(F : Self.Block.DFUNCTIONALITY) : Absorb.DFUNCTIONALITY = { +module LowerFun(F : Self.BlockSponge.DFUNCTIONALITY) : AbsorbSponge.DFUNCTIONALITY = { proc init() = {} proc f(xs : block list) : block = { @@ -22,9 +22,9 @@ module LowerFun(F : Self.Block.DFUNCTIONALITY) : Absorb.DFUNCTIONALITY = { } }. -module Sim (S : Absorb.SIMULATOR, F : Self.Block.DFUNCTIONALITY) = S(LowerFun(F)). +module Sim (S : AbsorbSponge.SIMULATOR, F : Self.BlockSponge.DFUNCTIONALITY) = S(LowerFun(F)). -module UpperFun (F : Absorb.DFUNCTIONALITY) = { +module UpperFun (F : AbsorbSponge.DFUNCTIONALITY) = { proc init() = {} proc f(xs : block list, n : int) : block list = { @@ -43,17 +43,17 @@ module UpperFun (F : Absorb.DFUNCTIONALITY) = { } }. -module BlocksOfAbsorbBlockSponge (P : Self.Block.DPRIMITIVE) = - UpperFun(Absorb.BlockSponge(P)). +module BlocksOfAbsorbBlockSponge (P : Self.BlockSponge.DPRIMITIVE) = + UpperFun(AbsorbSponge.BlockSponge(P)). -module Dist (D : Self.Block.DISTINGUISHER, F : Absorb.DFUNCTIONALITY) = D(UpperFun(F)). +module Dist (D : Self.BlockSponge.DISTINGUISHER, F : AbsorbSponge.DFUNCTIONALITY) = D(UpperFun(F)). section. - declare module AbsorbSim : Absorb.SIMULATOR { Perm, Self.Block.BIRO.IRO', Absorb.Ideal.RO }. - declare module BlocksDist : Self.Block.DISTINGUISHER { Perm, Self.Block.BIRO.IRO', Absorb.Ideal.RO, AbsorbSim }. + declare module AbsorbSim : AbsorbSponge.SIMULATOR { Perm, Self.BlockSponge.BIRO.IRO', AbsorbSponge.Ideal.RO }. + declare module BlocksDist : Self.BlockSponge.DISTINGUISHER { Perm, Self.BlockSponge.BIRO.IRO', AbsorbSponge.Ideal.RO, AbsorbSim }. local equiv ModularBlocks_Real: - UpperFun(Absorb.BlockSponge(Perm)).f ~ Self.Block.Sponge(Perm).f: + UpperFun(AbsorbSponge.BlockSponge(Perm)).f ~ Self.BlockSponge.Sponge(Perm).f: ={arg} /\ ={m,mi}(Perm,Perm) /\ (forall x, mem (dom Perm.m){1} x) @@ -62,23 +62,23 @@ section. /\ (forall x, mem (dom Perm.m){1} x). proof. proc. sp; if=> //=. - inline Absorb.BlockSponge(Perm).f. + inline AbsorbSponge.BlockSponge(Perm).f. admit. (* Fun with loops *) qed. pred lower (ro : (block list,block) fmap) (iro : (block list * int,block) fmap) = - Self.Block.BIRO.prefix_closed iro /\ + Self.BlockSponge.BIRO.prefix_closed iro /\ forall x n, valid_block x => iro.[(x,n)] = ro.[extend x n]. local equiv ModularAbsorb: - UpperFun(Absorb.Ideal.RO).f ~ Self.Block.BIRO.IRO'.f: + UpperFun(AbsorbSponge.Ideal.RO).f ~ Self.BlockSponge.BIRO.IRO'.f: ={arg} - /\ lower Absorb.Ideal.RO.m{1} Self.Block.BIRO.IRO'.mp{2} + /\ lower AbsorbSponge.Ideal.RO.m{1} Self.BlockSponge.BIRO.IRO'.mp{2} ==> ={res} - /\ lower Absorb.Ideal.RO.m{1} Self.Block.BIRO.IRO'.mp{2}. + /\ lower AbsorbSponge.Ideal.RO.m{1} Self.BlockSponge.BIRO.IRO'.mp{2}. proof. proc. sp; if=> //=. - inline Absorb.BlockSponge(Perm).f. + inline AbsorbSponge.BlockSponge(Perm).f. admit. (* Fun with loops *) qed. @@ -91,14 +91,14 @@ section. n <= n' /\ mem (dom ro) (extend x n')). - module LowIRO' : Absorb.FUNCTIONALITY = { - proc init = Self.Block.BIRO.IRO'.init + module LowIRO' : AbsorbSponge.FUNCTIONALITY = { + proc init = Self.BlockSponge.BIRO.IRO'.init proc f(xs : block list) = { var b <- b0; var (ys, n) = strip xs; if (valid_block ys) { - b <@ Self.Block.BIRO.IRO'.f_lazy(ys, n); + b <@ Self.BlockSponge.BIRO.IRO'.f_lazy(ys, n); } return b; @@ -106,7 +106,7 @@ section. }. pred holey_map (iro iro_lazy : (block list * int,block) fmap) = - Self.Block.BIRO.prefix_closed iro + Self.BlockSponge.BIRO.prefix_closed iro /\ (forall xn, mem (dom iro_lazy) xn => iro_lazy.[xn] = iro.[xn]) @@ -120,13 +120,13 @@ section. whose index is not in the index of the right map, as they have not ben given to the adversary. **) local lemma LazifyIRO: - eager [Self.Block.BIRO.IRO'.resample_invisible(); , LowerFun(Self.Block.BIRO.IRO').f ~ LowIRO'.f, Self.Block.BIRO.IRO'.resample_invisible();: - ={arg, Self.Block.BIRO.IRO'.visible} - /\ holey_map Self.Block.BIRO.IRO'.mp{1} Self.Block.BIRO.IRO'.mp{2} - /\ Self.Block.BIRO.IRO'.visible{2} = dom (Self.Block.BIRO.IRO'.mp){2} - ==> ={res, Self.Block.BIRO.IRO'.visible} - /\ holey_map Self.Block.BIRO.IRO'.mp{1} Self.Block.BIRO.IRO'.mp{2} - /\ Self.Block.BIRO.IRO'.visible{2} = dom (Self.Block.BIRO.IRO'.mp){2}]. + eager [Self.BlockSponge.BIRO.IRO'.resample_invisible(); , LowerFun(Self.BlockSponge.BIRO.IRO').f ~ LowIRO'.f, Self.BlockSponge.BIRO.IRO'.resample_invisible();: + ={arg, Self.BlockSponge.BIRO.IRO'.visible} + /\ holey_map Self.BlockSponge.BIRO.IRO'.mp{1} Self.BlockSponge.BIRO.IRO'.mp{2} + /\ Self.BlockSponge.BIRO.IRO'.visible{2} = dom (Self.BlockSponge.BIRO.IRO'.mp){2} + ==> ={res, Self.BlockSponge.BIRO.IRO'.visible} + /\ holey_map Self.BlockSponge.BIRO.IRO'.mp{1} Self.BlockSponge.BIRO.IRO'.mp{2} + /\ Self.BlockSponge.BIRO.IRO'.visible{2} = dom (Self.BlockSponge.BIRO.IRO'.mp){2}]. proof. (* eager proc. @@ -191,20 +191,20 @@ section. - on actual queries, the two maps agree; - blocks in the IRO that are just generated on the way to answering actual queries can be resampled. **) - (* Absorb.Ideal.RO.f ~ LowerFun(Blocks.BIRO.IRO).f: + (* AbsorbSponge.Ideal.RO.f ~ LowerFun(Blocks.BIRO.IRO).f: ={arg} /\ true ==> ={res}. *) lemma Intermediate &m: - `|Pr[Self.Block.RealIndif(Self.Block.Sponge,Perm,BlocksDist).main() @ &m :res] - - Pr[Self.Block.IdealIndif(Self.Block.BIRO.IRO',Sim(AbsorbSim),BlocksDist).main() @ &m: res]| - = `|Pr[Self.Block.RealIndif(BlocksOfAbsorbBlockSponge,Perm,BlocksDist).main() @ &m: res] - - Pr[Self.Block.IdealIndif(UpperFun(Absorb.Ideal.RO),Sim(AbsorbSim),BlocksDist).main() @ &m: res]|. + `|Pr[Self.BlockSponge.RealIndif(Self.BlockSponge.Sponge,Perm,BlocksDist).main() @ &m :res] + - Pr[Self.BlockSponge.IdealIndif(Self.BlockSponge.BIRO.IRO',Sim(AbsorbSim),BlocksDist).main() @ &m: res]| + = `|Pr[Self.BlockSponge.RealIndif(BlocksOfAbsorbBlockSponge,Perm,BlocksDist).main() @ &m: res] + - Pr[Self.BlockSponge.IdealIndif(UpperFun(AbsorbSponge.Ideal.RO),Sim(AbsorbSim),BlocksDist).main() @ &m: res]|. proof. - have ->: Pr[Self.Block.RealIndif(BlocksOfAbsorbBlockSponge,Perm,BlocksDist).main() @ &m: res] - = Pr[Self.Block.RealIndif(Self.Block.Sponge,Perm,BlocksDist).main() @ &m :res]. + have ->: Pr[Self.BlockSponge.RealIndif(BlocksOfAbsorbBlockSponge,Perm,BlocksDist).main() @ &m: res] + = Pr[Self.BlockSponge.RealIndif(Self.BlockSponge.Sponge,Perm,BlocksDist).main() @ &m :res]. byequiv=> //=; proc. call (_: ={m,mi}(Perm,Perm) /\ (forall x, mem (dom Perm.m){1} x)). @@ -219,14 +219,14 @@ section. (* Now the other initialization is dead code. *) call (_: true ==> true)=> //. by proc; auto. - have ->: Pr[Self.Block.IdealIndif(UpperFun(Absorb.Ideal.RO),Sim(AbsorbSim),BlocksDist).main() @ &m: res] - = Pr[Self.Block.IdealIndif(Self.Block.BIRO.IRO',Sim(AbsorbSim),BlocksDist).main() @ &m: res]. + have ->: Pr[Self.BlockSponge.IdealIndif(UpperFun(AbsorbSponge.Ideal.RO),Sim(AbsorbSim),BlocksDist).main() @ &m: res] + = Pr[Self.BlockSponge.IdealIndif(Self.BlockSponge.BIRO.IRO',Sim(AbsorbSim),BlocksDist).main() @ &m: res]. byequiv=> //=; proc. - call (_: ={glob AbsorbSim} /\ lower Absorb.Ideal.RO.m{1} Self.Block.BIRO.IRO'.mp{2}). - proc (lower Absorb.Ideal.RO.m{1} Self.Block.BIRO.IRO'.mp{2})=> //=. + call (_: ={glob AbsorbSim} /\ lower AbsorbSponge.Ideal.RO.m{1} Self.BlockSponge.BIRO.IRO'.mp{2}). + proc (lower AbsorbSponge.Ideal.RO.m{1} Self.BlockSponge.BIRO.IRO'.mp{2})=> //=. proc; sp; if=> //=. smt. call ModularAbsorb; auto; smt. - proc (lower Absorb.Ideal.RO.m{1} Self.Block.BIRO.IRO'.mp{2})=> //=. + proc (lower AbsorbSponge.Ideal.RO.m{1} Self.BlockSponge.BIRO.IRO'.mp{2})=> //=. proc; sp; if=> //=. smt. call ModularAbsorb; auto; smt. (* Re-Bug *) @@ -238,16 +238,16 @@ section. qed. lemma Remainder &m: - `|Pr[Self.Block.RealIndif(BlocksOfAbsorbBlockSponge,Perm,BlocksDist).main() @ &m: res] - - Pr[Self.Block.IdealIndif(UpperFun(Absorb.Ideal.RO),Sim(AbsorbSim),BlocksDist).main() @ &m: res]| - = `|Pr[Absorb.RealIndif(Absorb.BlockSponge,Perm,Dist(BlocksDist)).main() @ &m: res] - - Pr[Absorb.IdealIndif(Absorb.Ideal.RO,AbsorbSim,Dist(BlocksDist)).main() @ &m: res]|. + `|Pr[Self.BlockSponge.RealIndif(BlocksOfAbsorbBlockSponge,Perm,BlocksDist).main() @ &m: res] + - Pr[Self.BlockSponge.IdealIndif(UpperFun(AbsorbSponge.Ideal.RO),Sim(AbsorbSim),BlocksDist).main() @ &m: res]| + = `|Pr[AbsorbSponge.RealIndif(AbsorbSponge.BlockSponge,Perm,Dist(BlocksDist)).main() @ &m: res] + - Pr[AbsorbSponge.IdealIndif(AbsorbSponge.Ideal.RO,AbsorbSim,Dist(BlocksDist)).main() @ &m: res]|. proof. admit. qed. lemma Conclusion &m: - `|Pr[Self.Block.RealIndif(Self.Block.Sponge,Perm,BlocksDist).main() @ &m: res] - - Pr[Self.Block.IdealIndif(Self.Block.BIRO.IRO',Sim(AbsorbSim),BlocksDist).main() @ &m: res]| - = `|Pr[Absorb.RealIndif(Absorb.BlockSponge,Perm,Dist(BlocksDist)).main() @ &m: res] - - Pr[Absorb.IdealIndif(Absorb.Ideal.RO,AbsorbSim,Dist(BlocksDist)).main() @ &m: res]|. + `|Pr[Self.BlockSponge.RealIndif(Self.BlockSponge.Sponge,Perm,BlocksDist).main() @ &m: res] + - Pr[Self.BlockSponge.IdealIndif(Self.BlockSponge.BIRO.IRO',Sim(AbsorbSim),BlocksDist).main() @ &m: res]| + = `|Pr[AbsorbSponge.RealIndif(AbsorbSponge.BlockSponge,Perm,Dist(BlocksDist)).main() @ &m: res] + - Pr[AbsorbSponge.IdealIndif(AbsorbSponge.Ideal.RO,AbsorbSim,Dist(BlocksDist)).main() @ &m: res]|. proof. by rewrite (Intermediate &m) (Remainder &m). qed. end section. diff --git a/proof/variant/LeakyAbsorb.ec b/proof/variant/LeakyAbsorb.ec index 3ebe579..8f03201 100644 --- a/proof/variant/LeakyAbsorb.ec +++ b/proof/variant/LeakyAbsorb.ec @@ -1,7 +1,6 @@ (* -------------------------------------------------------------------- *) -require import Option Pair Int Real Distr List FSet NewFMap. -require (*--*) LazyRP RndOrcl. -(*---*) import Dprod. +require import Option Pair Int Real Distr List FSet NewFMap DProd. +require (*--*) LazyRP RndOrcl. (* -------------------------------------------------------------------- *) @@ -22,7 +21,7 @@ op (^) : block -> block -> block. (* -------------------------------------------------------------------- *) clone import LazyRP as Perm with type D <- block * capacity, - op d <- bdist * cdist + op d <- bdist `*` cdist rename [module] "P" as "Perm". diff --git a/proof/variant/RndOrcl.eca b/proof/variant/RndOrcl.eca index 4f8b612..07fd6ba 100644 --- a/proof/variant/RndOrcl.eca +++ b/proof/variant/RndOrcl.eca @@ -149,7 +149,7 @@ abstract theory GenIdeal. + case ((pick work = x){2})=> pick_x; last smt. subst x{2}; move: H7 H1; rewrite -neqF /eq_except=> -> /= eq_exc. by apply fmapP=> x0; case (pick work{2} = x0); smt. - by auto; smt. + by auto; smt w=@NewFMap. by auto;progress [-split];rewrite H0 /= getP_eq;smt. qed. From db77864b7bf19230ea10c783c483b5680d9b6e97 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Wed, 3 Feb 2016 19:06:14 +0100 Subject: [PATCH 157/525] Pushing a proof back through after oracles got swapped for some reason. This may need to be investigated further. --- proof/core/Gext.eca | 23 ++++++++++------------- 1 file changed, 10 insertions(+), 13 deletions(-) diff --git a/proof/core/Gext.eca b/proof/core/Gext.eca index e42d96e..e2cb45d 100644 --- a/proof/core/Gext.eca +++ b/proof/core/Gext.eca @@ -619,28 +619,28 @@ section EXT. apply ler_wpmul2r;1:by apply eps_ge0. by rewrite le_fromint;smt ml=0 w=max_ge0. + proc. - case ((size G1.m <= max_size /\ size G1.mi <= max_size /\ ReSample.count < max_size)); + case ((size G1.m < max_size /\ size G1.mi < max_size /\ ReSample.count < max_size)); [rcondt 2 | rcondf 2];1,3:by auto. - + wp;rnd (mem (image snd (dom G1.m `|` dom G1.mi)));skip=> &hr[#]?->/=???. - rewrite (Mu_mem.mu_mem (image snd (dom G1.m{hr}`|`dom G1.mi{hr})) cdistr (1%r/(2^c)%r))//. - + move=>x _;apply DWord.muxP. + + wp;rnd (mem (image snd (dom G1.m `|` dom G1.mi) `|` fset1 x));skip=> &hr[#]?->/=???. + rewrite (Mu_mem.mu_mem (image snd (dom G1.m{hr}`|`dom G1.mi{hr}) `|` fset1 x{hr}) cdistr (1%r/(2^c)%r))//. + + by move=>x _;apply DWord.muxP. apply ler_wpmul2r;1:by apply divr_ge0=>//;apply /c_ge0r. rewrite imageU fcardU le_fromint. move:(fcard_image_leq snd (dom G1.m{hr}))(fcard_image_leq snd (dom G1.mi{hr})). - rewrite -!sizeE;smt w=fcard_ge0. + by rewrite -!sizeE fcardU fcard1; smt w=fcard_ge0. by hoare=>[??|];[apply eps_ge0|auto]. + by move=>c1;proc;auto=> &hr [^H 2->]/#. by move=> b1 c1;proc;auto=> &hr [^H 2->]. - + proc. - case ((size G1.m < max_size /\ size G1.mi < max_size /\ ReSample.count < max_size)); + + proc. + case ((size G1.m <= max_size /\ size G1.mi <= max_size /\ ReSample.count < max_size)); [rcondt 2 | rcondf 2]; 1,3:by auto. - + wp;rnd (mem (image snd (dom G1.m `|` dom G1.mi ) `|` fset1 x));skip=> &hr[#]?->/=???. + + wp;rnd (mem (image snd (dom G1.m `|` dom G1.mi )));skip=> &hr[#]?->/=???. rewrite (Mu_mem.mu_mem - (image snd (dom G1.m{hr} `|` dom G1.mi{hr}) `|` fset1 x{hr}) + (image snd (dom G1.m{hr} `|` dom G1.mi{hr})) cdistr (1%r/(2^c)%r))//. + move=>x _;apply DWord.muxP. apply ler_wpmul2r;1:by apply divr_ge0=>//;apply /c_ge0r. - rewrite imageU !fcardU le_fromint fcard1. + rewrite imageU !fcardU le_fromint. move:(fcard_image_leq snd (dom G1.m{hr}))(fcard_image_leq snd (dom G1.mi{hr})). rewrite -!sizeE;smt w=fcard_ge0. by hoare=>[??|];[apply eps_ge0|auto]. @@ -675,6 +675,3 @@ section EXT. qed. end section EXT. - - - From 64a257b80a9b8caea2ca50587acf05e294173496 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Wed, 3 Feb 2016 19:36:50 +0100 Subject: [PATCH 158/525] Revert "Pushing a proof back through after oracles got swapped for some reason." This reverts commit 7e32f742fa318b19e41ab7d99d39496645304427. --- proof/core/Gext.eca | 23 +++++++++++++---------- 1 file changed, 13 insertions(+), 10 deletions(-) diff --git a/proof/core/Gext.eca b/proof/core/Gext.eca index e2cb45d..e42d96e 100644 --- a/proof/core/Gext.eca +++ b/proof/core/Gext.eca @@ -619,28 +619,28 @@ section EXT. apply ler_wpmul2r;1:by apply eps_ge0. by rewrite le_fromint;smt ml=0 w=max_ge0. + proc. - case ((size G1.m < max_size /\ size G1.mi < max_size /\ ReSample.count < max_size)); + case ((size G1.m <= max_size /\ size G1.mi <= max_size /\ ReSample.count < max_size)); [rcondt 2 | rcondf 2];1,3:by auto. - + wp;rnd (mem (image snd (dom G1.m `|` dom G1.mi) `|` fset1 x));skip=> &hr[#]?->/=???. - rewrite (Mu_mem.mu_mem (image snd (dom G1.m{hr}`|`dom G1.mi{hr}) `|` fset1 x{hr}) cdistr (1%r/(2^c)%r))//. - + by move=>x _;apply DWord.muxP. + + wp;rnd (mem (image snd (dom G1.m `|` dom G1.mi)));skip=> &hr[#]?->/=???. + rewrite (Mu_mem.mu_mem (image snd (dom G1.m{hr}`|`dom G1.mi{hr})) cdistr (1%r/(2^c)%r))//. + + move=>x _;apply DWord.muxP. apply ler_wpmul2r;1:by apply divr_ge0=>//;apply /c_ge0r. rewrite imageU fcardU le_fromint. move:(fcard_image_leq snd (dom G1.m{hr}))(fcard_image_leq snd (dom G1.mi{hr})). - by rewrite -!sizeE fcardU fcard1; smt w=fcard_ge0. + rewrite -!sizeE;smt w=fcard_ge0. by hoare=>[??|];[apply eps_ge0|auto]. + by move=>c1;proc;auto=> &hr [^H 2->]/#. by move=> b1 c1;proc;auto=> &hr [^H 2->]. - + proc. - case ((size G1.m <= max_size /\ size G1.mi <= max_size /\ ReSample.count < max_size)); + + proc. + case ((size G1.m < max_size /\ size G1.mi < max_size /\ ReSample.count < max_size)); [rcondt 2 | rcondf 2]; 1,3:by auto. - + wp;rnd (mem (image snd (dom G1.m `|` dom G1.mi )));skip=> &hr[#]?->/=???. + + wp;rnd (mem (image snd (dom G1.m `|` dom G1.mi ) `|` fset1 x));skip=> &hr[#]?->/=???. rewrite (Mu_mem.mu_mem - (image snd (dom G1.m{hr} `|` dom G1.mi{hr})) + (image snd (dom G1.m{hr} `|` dom G1.mi{hr}) `|` fset1 x{hr}) cdistr (1%r/(2^c)%r))//. + move=>x _;apply DWord.muxP. apply ler_wpmul2r;1:by apply divr_ge0=>//;apply /c_ge0r. - rewrite imageU !fcardU le_fromint. + rewrite imageU !fcardU le_fromint fcard1. move:(fcard_image_leq snd (dom G1.m{hr}))(fcard_image_leq snd (dom G1.mi{hr})). rewrite -!sizeE;smt w=fcard_ge0. by hoare=>[??|];[apply eps_ge0|auto]. @@ -675,3 +675,6 @@ section EXT. qed. end section EXT. + + + From 2f14b0576d47a05c8516247e878824d37bcceb8e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Wed, 3 Feb 2016 19:40:35 +0100 Subject: [PATCH 159/525] Cleaning up the core bound. --- proof/core/ConcreteF.eca | 7 +++---- proof/core/Gconcl.ec | 2 +- proof/core/Gext.eca | 3 +-- proof/core/Handle.eca | 2 +- 4 files changed, 6 insertions(+), 8 deletions(-) diff --git a/proof/core/ConcreteF.eca b/proof/core/ConcreteF.eca index 73cf914..b357211 100644 --- a/proof/core/ConcreteF.eca +++ b/proof/core/ConcreteF.eca @@ -55,10 +55,9 @@ section. op uD <- dstate, type K <- unit, op dK <- (NewDistr.MUnit.dunit<:unit> tt), - op q <- max_size + 1 + op q <- max_size proof *. - - realize gt0_q by smt w=max_ge0. + realize ge0_q by smt w=max_ge0. realize uD_uf_fu. split. case=> [x y]; rewrite support_dprod /=. @@ -110,7 +109,7 @@ section. lemma Real_Concrete &m : Pr[GReal(D).main()@ &m: res /\ C.c <= max_size] <= - Pr[CF(DRestr(D)).main()@ &m: res] + ((max_size + 1) ^ 2)%r * mu dstate (pred1 witness). + Pr[CF(DRestr(D)).main()@ &m: res] + (max_size ^ 2)%r * mu dstate (pred1 witness). proof. cut->: Pr[RealIndif(SqueezelessSponge,PC(Perm),D).main()@ &m: diff --git a/proof/core/Gconcl.ec b/proof/core/Gconcl.ec index d984261..0476021 100644 --- a/proof/core/Gconcl.ec +++ b/proof/core/Gconcl.ec @@ -366,7 +366,7 @@ axiom D_ll : lemma Real_Ideal &m: Pr[GReal(D).main() @ &m: res /\ C.c <= max_size] <= Pr[IdealIndif(IF,S,DRestr(D)).main() @ &m :res] + - ((max_size + 1) ^ 2)%r * mu dstate (pred1 witness) + + (max_size ^ 2)%r * mu dstate (pred1 witness) + max_size%r * ((2*max_size)%r / (2^c)%r) + max_size%r * ((2*max_size)%r / (2^c)%r). proof. diff --git a/proof/core/Gext.eca b/proof/core/Gext.eca index e42d96e..ec98425 100644 --- a/proof/core/Gext.eca +++ b/proof/core/Gext.eca @@ -652,11 +652,10 @@ section EXT. forall (F <: DFUNCTIONALITY{D}) (P <: DPRIMITIVE{D}), islossless P.f => islossless P.fi => islossless F.f => islossless D(F, P).distinguish. - (* TODO Francois : on peut pas avoir max_size au lieu de (max_size + 1)? *) lemma Real_G2 &m: Pr[GReal(D).main() @ &m: res /\ C.c <= max_size] <= Pr[Eager(G2(DRestr(D))).main2() @ &m: res] + - ((max_size + 1) ^ 2)%r * mu dstate (pred1 witness) + + (max_size ^ 2)%r * mu dstate (pred1 witness) + max_size%r * ((2*max_size)%r / (2^c)%r) + max_size%r * ((2*max_size)%r / (2^c)%r). proof. diff --git a/proof/core/Handle.eca b/proof/core/Handle.eca index 136ff79..5e528f0 100644 --- a/proof/core/Handle.eca +++ b/proof/core/Handle.eca @@ -602,7 +602,7 @@ section. lemma Real_G1 &m: Pr[GReal(D).main() @ &m: res /\ C.c <= max_size] <= - Pr[G1(DRestr(D)).main() @ &m: res] + ((max_size + 1) ^ 2)%r * mu dstate (pred1 witness) + + Pr[G1(DRestr(D)).main() @ &m: res] + (max_size ^ 2)%r * mu dstate (pred1 witness) + Pr[G1(DRestr(D)).main() @&m: G1.bcol] + Pr[G1(DRestr(D)).main() @&m: G1.bext]. proof. apply (RealOrder.ler_trans _ _ _ (Real_Concrete D D_ll &m)). From 85970da0fb0eee0b9aff9bc273c211053c7faa29 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Wed, 3 Feb 2016 17:27:58 -0500 Subject: [PATCH 160/525] Changing the [-I proof/old] in Makefile to [-I proof/core], reflecting Francois's renaming. --- Makefile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Makefile b/Makefile index 6111395..f822a72 100644 --- a/Makefile +++ b/Makefile @@ -3,7 +3,7 @@ # -------------------------------------------------------------------- ECROOT ?= ECCHECK ?= -ECARGS ?= -I proof -I proof/variant -I proof/old +ECARGS ?= -I proof -I proof/variant -I proof/core ECCONF := config/tests.config XUNITOUT ?= xunit.xml CHECKS ?= sha3 From beada21798e73b706c4b1bb447f2c18cb55d4337 Mon Sep 17 00:00:00 2001 From: Pierre-Yves Strub Date: Wed, 3 Feb 2016 23:44:54 +0100 Subject: [PATCH 161/525] push include paths in tests.config --- Makefile | 2 +- config/tests.config | 3 ++- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/Makefile b/Makefile index f822a72..3c2e3bd 100644 --- a/Makefile +++ b/Makefile @@ -3,7 +3,7 @@ # -------------------------------------------------------------------- ECROOT ?= ECCHECK ?= -ECARGS ?= -I proof -I proof/variant -I proof/core +ECARGS ?= ECCONF := config/tests.config XUNITOUT ?= xunit.xml CHECKS ?= sha3 diff --git a/config/tests.config b/config/tests.config index 3879c44..b386ecb 100644 --- a/config/tests.config +++ b/config/tests.config @@ -1,5 +1,6 @@ [default] -bin = ec.native +bin = ec.native +args = -I proof -I proof/variant -I proof/core [test-sha3] okdirs = !proof From 21f1e9a4c2f4198aca2ebe62a804618b5cc91846 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Thu, 4 Feb 2016 17:19:51 +0100 Subject: [PATCH 162/525] Remove old and unused files. the folder may have contained useful stuff. Check history if needed. --- proof/.dir-locals.el | 2 +- proof/AbsorbSponge.ec | 56 ----- proof/AbsorbToBlocks.ec | 253 --------------------- proof/RndOrcl.eca | 385 -------------------------------- proof/variant/LeakyAbsorb.ec | 416 ----------------------------------- proof/variant/RndOrcl.eca | 385 -------------------------------- 6 files changed, 1 insertion(+), 1496 deletions(-) delete mode 100644 proof/AbsorbSponge.ec delete mode 100644 proof/AbsorbToBlocks.ec delete mode 100644 proof/RndOrcl.eca delete mode 100644 proof/variant/LeakyAbsorb.ec delete mode 100644 proof/variant/RndOrcl.eca diff --git a/proof/.dir-locals.el b/proof/.dir-locals.el index e868573..a0bbb33 100644 --- a/proof/.dir-locals.el +++ b/proof/.dir-locals.el @@ -1,4 +1,4 @@ ((easycrypt-mode . ((eval . (flet ((pre (s) (concat (locate-dominating-file buffer-file-name ".dir-locals.el") s))) - (setq easycrypt-load-path `(,(pre ".") ,(pre "variant") ,(pre "core")))))))) + (setq easycrypt-load-path `(,(pre ".") ,(pre "core")))))))) diff --git a/proof/AbsorbSponge.ec b/proof/AbsorbSponge.ec deleted file mode 100644 index bdbbc80..0000000 --- a/proof/AbsorbSponge.ec +++ /dev/null @@ -1,56 +0,0 @@ -(* -------------------------------------------------------------------- *) -require import Option Pair Int Real List. -require (*--*) Common LazyRP RndOrcl Indifferentiability. - -op cast: 'a NewDistr.distr -> 'a distr. - -(* -------------------------------------------------------------------- *) -require import Common. - -(* -------------------------------------------------------------------- *) - -clone import RndOrcl as RO with - type from <- block list, - type to <- block, - op Ideal.sample (x : block list) <- cast bdistr. -clone import Ideal. (* ?? Nested abstract theories... we don't like them *) - -(* -------------------------------------------------------------------- *) -clone include Indifferentiability with - type p <- block * capacity, - type f_in <- block list, - type f_out <- block - - rename - [module] "Indif" as "Experiment" - [module] "GReal" as "RealIndif" - [module] "GIdeal" as "IdealIndif". - -(* -------------------------------------------------------------------- *) -module BlockSponge (P : DPRIMITIVE) : FUNCTIONALITY, CONSTRUCTION(P) = { - proc init() = {} - - proc f(p : block list): block = { - var (sa,sc) <- (b0, Capacity.c0); - - if (valid_absorb p) { - (* Absorption *) - while (p <> []) { - (sa,sc) <@ P.f(sa +^ head b0 p, sc); - p <- behead p; - } - } - return sa; - } -}. - -(* -------------------------------------------------------------------- *) -op eps : real. - -lemma top: - exists (S <: SIMULATOR), - forall (D <: DISTINGUISHER) &m, - `| Pr[Experiment(BlockSponge(Perm), Perm, D).main() @ &m : res] - - Pr[Experiment(RO, S(RO), D).main() @ &m : res]| - < eps. -proof. admit. qed. diff --git a/proof/AbsorbToBlocks.ec b/proof/AbsorbToBlocks.ec deleted file mode 100644 index d2c27a7..0000000 --- a/proof/AbsorbToBlocks.ec +++ /dev/null @@ -1,253 +0,0 @@ -(* -------------------------------------------------------------------- *) -require import Option Pair Int Real List FSet NewFMap. -require (*--*) AbsorbSponge BlockSponge. - -(* -------------------------------------------------------------------- *) -require import Common. - -op cast: 'a NewDistr.distr -> 'a distr. - -(* -------------------------------------------------------------------- *) -module LowerFun(F : Self.BlockSponge.DFUNCTIONALITY) : AbsorbSponge.DFUNCTIONALITY = { - proc init() = {} - - proc f(xs : block list) : block = { - var (ys, n) <- strip xs; - var zs <- []; - - if (valid_block ys) { - zs <@ F.f(ys, n + 1); - } - return last b0 zs; - } -}. - -module Sim (S : AbsorbSponge.SIMULATOR, F : Self.BlockSponge.DFUNCTIONALITY) = S(LowerFun(F)). - -module UpperFun (F : AbsorbSponge.DFUNCTIONALITY) = { - proc init() = {} - - proc f(xs : block list, n : int) : block list = { - var y <- b0; - var ys <- []; - var i <- 0; - - if (valid_block xs) { - while (i < n) { - y <@ F.f(extend xs i); - ys <- rcons ys y; - i <- i + 1; - } - } - return ys; - } -}. - -module BlocksOfAbsorbBlockSponge (P : Self.BlockSponge.DPRIMITIVE) = - UpperFun(AbsorbSponge.BlockSponge(P)). - -module Dist (D : Self.BlockSponge.DISTINGUISHER, F : AbsorbSponge.DFUNCTIONALITY) = D(UpperFun(F)). - -section. - declare module AbsorbSim : AbsorbSponge.SIMULATOR { Perm, Self.BlockSponge.BIRO.IRO', AbsorbSponge.Ideal.RO }. - declare module BlocksDist : Self.BlockSponge.DISTINGUISHER { Perm, Self.BlockSponge.BIRO.IRO', AbsorbSponge.Ideal.RO, AbsorbSim }. - - local equiv ModularBlocks_Real: - UpperFun(AbsorbSponge.BlockSponge(Perm)).f ~ Self.BlockSponge.Sponge(Perm).f: - ={arg} - /\ ={m,mi}(Perm,Perm) - /\ (forall x, mem (dom Perm.m){1} x) - ==> ={res} - /\ ={m,mi}(Perm,Perm) - /\ (forall x, mem (dom Perm.m){1} x). - proof. - proc. sp; if=> //=. - inline AbsorbSponge.BlockSponge(Perm).f. - admit. (* Fun with loops *) - qed. - - pred lower (ro : (block list,block) fmap) (iro : (block list * int,block) fmap) = - Self.BlockSponge.BIRO.prefix_closed iro /\ - forall x n, valid_block x => iro.[(x,n)] = ro.[extend x n]. - - local equiv ModularAbsorb: - UpperFun(AbsorbSponge.Ideal.RO).f ~ Self.BlockSponge.BIRO.IRO'.f: - ={arg} - /\ lower AbsorbSponge.Ideal.RO.m{1} Self.BlockSponge.BIRO.IRO'.mp{2} - ==> ={res} - /\ lower AbsorbSponge.Ideal.RO.m{1} Self.BlockSponge.BIRO.IRO'.mp{2}. - proof. - proc. sp; if=> //=. - inline AbsorbSponge.BlockSponge(Perm).f. - admit. (* Fun with loops *) - qed. - - pred upper (ro : (block list,block) fmap) (iro : (block list * int,block) fmap) = - (forall x y, valid_absorb x => ro.[x] = y => iro.[strip x] = y) - /\ (forall x n y, - valid_block x => - iro.[(x,n)] = Some y => - exists n', - n <= n' - /\ mem (dom ro) (extend x n')). - - module LowIRO' : AbsorbSponge.FUNCTIONALITY = { - proc init = Self.BlockSponge.BIRO.IRO'.init - proc f(xs : block list) = { - var b <- b0; - var (ys, n) = strip xs; - - if (valid_block ys) { - b <@ Self.BlockSponge.BIRO.IRO'.f_lazy(ys, n); - } - - return b; - } - }. - - pred holey_map (iro iro_lazy : (block list * int,block) fmap) = - Self.BlockSponge.BIRO.prefix_closed iro - /\ (forall xn, - mem (dom iro_lazy) xn => - iro_lazy.[xn] = iro.[xn]) - /\ (forall x n, - mem (dom iro) (x,n) => - exists n', - n <= n' - /\ mem (dom iro_lazy) (x,n')). - - (** Essentially, we can delay sampling every entry in the left map - whose index is not in the index of the right map, as they have - not ben given to the adversary. **) - local lemma LazifyIRO: - eager [Self.BlockSponge.BIRO.IRO'.resample_invisible(); , LowerFun(Self.BlockSponge.BIRO.IRO').f ~ LowIRO'.f, Self.BlockSponge.BIRO.IRO'.resample_invisible();: - ={arg, Self.BlockSponge.BIRO.IRO'.visible} - /\ holey_map Self.BlockSponge.BIRO.IRO'.mp{1} Self.BlockSponge.BIRO.IRO'.mp{2} - /\ Self.BlockSponge.BIRO.IRO'.visible{2} = dom (Self.BlockSponge.BIRO.IRO'.mp){2} - ==> ={res, Self.BlockSponge.BIRO.IRO'.visible} - /\ holey_map Self.BlockSponge.BIRO.IRO'.mp{1} Self.BlockSponge.BIRO.IRO'.mp{2} - /\ Self.BlockSponge.BIRO.IRO'.visible{2} = dom (Self.BlockSponge.BIRO.IRO'.mp){2}]. - proof. -(* - eager proc. - case (!valid_lower p{1})=> /=. - rcondf{1} 3; 1: by auto; inline *; auto; while (true); auto. - rcondf{2} 2; 1: by auto. - inline *; auto. - rcondf{2} 4; 1: by auto; smt. - while{1} ( work{1} <= dom (Blocks.BIRO.IRO'.mp){1} - /\ holey_map Blocks.BIRO.IRO'.mp{1} Blocks.BIRO.IRO'.mp{2} - /\ forall x, mem work{1} x => mem (dom Blocks.BIRO.IRO'.mp){1} x /\ !mem (dom Blocks.BIRO.IRO'.mp){2} x) - (card work{1}). - auto; progress. - + admit. (* TODO: dto lossless *) - + move=> x; rewrite domP in_fsetD in_fsetU !in_fset1. - by case (x = pick work{hr})=> //= _ /H1 [->]. - + smt. - + smt. - + have [_] [_] /(_ x1 n0 _) //= := H0. - move: H5; rewrite domP in_fsetU in_fset1=> -[//=|h]. - by have [->]:= H1 (x1,n0) _; first by rewrite h mem_pick // H2. - + move: H5; rewrite domP in_fsetD in_fsetU !in_fset1. - by case (x1 = pick work{hr})=> //= _ /H1 [->]. - + move: H5; rewrite in_fsetD in_fset1. - by case (x1 = pick work{hr})=> //= _ /H1 [_ ->]. - + smt. - by auto; smt. - rcondt{1} 3; 1: by auto; inline *; auto; while (true); auto. - rcondt{2} 2; 1: by auto. - inline Blocks.BIRO.IRO'.f Blocks.BIRO.IRO'.f_lazy. - rcondt{1} 8; 1: by auto; inline *; auto; while (true); auto; smt. - rcondt{2} 4; 1: by auto; smt. - case ((mem (dom Blocks.BIRO.IRO'.mp) (strip p)){1} /\ !(mem (dom Blocks.BIRO.IRO'.mp) (strip x)){2}). - admit. (* this is the bad case where we need to bring down the sampling from resample_invisible *) - inline{2} Blocks.BIRO.IRO'.resample_invisible. - rcondf{2} 9; 1: by auto; inline *; sp; if; auto; smt. - seq 1 0: ((((p{1} = x{2} /\ ={Blocks.BIRO.IRO'.visible}) /\ - holey_map Blocks.BIRO.IRO'.mp{1} Blocks.BIRO.IRO'.mp{2} /\ - Blocks.BIRO.IRO'.visible{2} = dom Blocks.BIRO.IRO'.mp{2}) /\ - valid_lower p{1}) /\ - ! (mem (dom Blocks.BIRO.IRO'.mp{1}) (strip p{1}) /\ - ! mem (dom Blocks.BIRO.IRO'.mp{2}) (strip x{2}))). (* disgusting copy-paste. we need seq* *) - admit. - splitwhile{1} 8: (i < n0 - 1). - rcondt{1} 9. - move=> &m; while (0 <= i < n0). - by inline*; sp; if; auto; smt. - by auto; smt. - rcondf{1} 12. - move=> &m; seq 8: (i = n0 - 1). - * wp; while (0 <= i < n0). - by inline*; sp; if; auto; smt. - by auto; smt. - * inline*; sp; if; auto; smt. - admit. (* just pushing the proof through *) -*) - admit. - qed. - - - (** This is an eager statement: - - on actual queries, the two maps agree; - - blocks in the IRO that are just generated on the way - to answering actual queries can be resampled. **) - (* AbsorbSponge.Ideal.RO.f ~ LowerFun(Blocks.BIRO.IRO).f: - ={arg} - /\ true - ==> ={res}. - *) - - lemma Intermediate &m: - `|Pr[Self.BlockSponge.RealIndif(Self.BlockSponge.Sponge,Perm,BlocksDist).main() @ &m :res] - - Pr[Self.BlockSponge.IdealIndif(Self.BlockSponge.BIRO.IRO',Sim(AbsorbSim),BlocksDist).main() @ &m: res]| - = `|Pr[Self.BlockSponge.RealIndif(BlocksOfAbsorbBlockSponge,Perm,BlocksDist).main() @ &m: res] - - Pr[Self.BlockSponge.IdealIndif(UpperFun(AbsorbSponge.Ideal.RO),Sim(AbsorbSim),BlocksDist).main() @ &m: res]|. - proof. - have ->: Pr[Self.BlockSponge.RealIndif(BlocksOfAbsorbBlockSponge,Perm,BlocksDist).main() @ &m: res] - = Pr[Self.BlockSponge.RealIndif(Self.BlockSponge.Sponge,Perm,BlocksDist).main() @ &m :res]. - byequiv=> //=; proc. - call (_: ={m,mi}(Perm,Perm) - /\ (forall x, mem (dom Perm.m){1} x)). - by proc; if; auto; smt. - by proc; if; auto; smt. - (* BUG: arg should be handled much earlier and automatically *) - by conseq ModularBlocks_Real=> //= &1 &2; case (arg{1}); case (arg{2})=> //=. - call (_: true - ==> ={glob Perm} - /\ (forall x, mem (dom Perm.m){1} x)). - admit. (* Do this with an eagerly sampled RP *) - (* Now the other initialization is dead code. *) - call (_: true ==> true)=> //. - by proc; auto. - have ->: Pr[Self.BlockSponge.IdealIndif(UpperFun(AbsorbSponge.Ideal.RO),Sim(AbsorbSim),BlocksDist).main() @ &m: res] - = Pr[Self.BlockSponge.IdealIndif(Self.BlockSponge.BIRO.IRO',Sim(AbsorbSim),BlocksDist).main() @ &m: res]. - byequiv=> //=; proc. - call (_: ={glob AbsorbSim} /\ lower AbsorbSponge.Ideal.RO.m{1} Self.BlockSponge.BIRO.IRO'.mp{2}). - proc (lower AbsorbSponge.Ideal.RO.m{1} Self.BlockSponge.BIRO.IRO'.mp{2})=> //=. - proc; sp; if=> //=. smt. - call ModularAbsorb; auto; smt. - proc (lower AbsorbSponge.Ideal.RO.m{1} Self.BlockSponge.BIRO.IRO'.mp{2})=> //=. - proc; sp; if=> //=. smt. - call ModularAbsorb; auto; smt. - (* Re-Bug *) - by conseq ModularAbsorb=> &1 &2; case (arg{1}); case (arg{2}). - inline *; wp;call (_: true)=> //=. - auto; progress [-split]; split=> //=. - admit. - done. - qed. - - lemma Remainder &m: - `|Pr[Self.BlockSponge.RealIndif(BlocksOfAbsorbBlockSponge,Perm,BlocksDist).main() @ &m: res] - - Pr[Self.BlockSponge.IdealIndif(UpperFun(AbsorbSponge.Ideal.RO),Sim(AbsorbSim),BlocksDist).main() @ &m: res]| - = `|Pr[AbsorbSponge.RealIndif(AbsorbSponge.BlockSponge,Perm,Dist(BlocksDist)).main() @ &m: res] - - Pr[AbsorbSponge.IdealIndif(AbsorbSponge.Ideal.RO,AbsorbSim,Dist(BlocksDist)).main() @ &m: res]|. - proof. admit. qed. - - lemma Conclusion &m: - `|Pr[Self.BlockSponge.RealIndif(Self.BlockSponge.Sponge,Perm,BlocksDist).main() @ &m: res] - - Pr[Self.BlockSponge.IdealIndif(Self.BlockSponge.BIRO.IRO',Sim(AbsorbSim),BlocksDist).main() @ &m: res]| - = `|Pr[AbsorbSponge.RealIndif(AbsorbSponge.BlockSponge,Perm,Dist(BlocksDist)).main() @ &m: res] - - Pr[AbsorbSponge.IdealIndif(AbsorbSponge.Ideal.RO,AbsorbSim,Dist(BlocksDist)).main() @ &m: res]|. - proof. by rewrite (Intermediate &m) (Remainder &m). qed. -end section. diff --git a/proof/RndOrcl.eca b/proof/RndOrcl.eca deleted file mode 100644 index 07fd6ba..0000000 --- a/proof/RndOrcl.eca +++ /dev/null @@ -1,385 +0,0 @@ -require import Option FSet NewFMap NewDistr. -(* TODO move this in NewFMap *) -lemma dom_set (m:('a,'b) fmap) a b : dom m.[a<-b] = dom m `|` fset1 a. -proof. by apply fsetP=> x;smt. qed. - -type from, to. - -module type RO = { - proc init() : unit - proc f(x : from): to -}. - -module type Distinguisher(G : RO) = { - proc distinguish(): bool {G.f} -}. - -module IND(G:RO, D:Distinguisher) = { - proc main(): bool = { - var b; - - G.init(); - b <@ D(G).distinguish(); - return b; - } -}. - -abstract theory Ideal. - - op sample : from -> to distr. - - module RO = { - var m : (from, to) fmap - - proc init() : unit = { - m <- map0; - } - - proc f(x : from) : to = { - var rd; - rd <$ sample x; - if (! mem (dom m) x) m.[x] <- rd; - return oget m.[x]; - } - }. - - section LL. - - axiom sample_ll : forall x, weight (sample x) = 1%r. - - lemma f_ll : phoare[RO.f : true ==> true] = 1%r. - proof. proc;auto;progress;apply sample_ll. qed. - - end section LL. - -end Ideal. - - -abstract theory GenIdeal. - - clone include Ideal. - axiom sample_ll : forall x, Distr.weight (sample x) = 1%r. - - op RO_dom : from fset. - - module ERO = { - proc sample() = { - var work; - work <- RO_dom; - while (work <> fset0) { - RO.f(pick work); - work = work `\` fset1 (pick work); - } - } - - proc init() = { - RO.m <- map0; - sample(); - } - - proc f = RO.f - }. - - module IND_S(D:Distinguisher) = { - proc main(): bool = { - var b; - RO.init(); - b <@ D(RO).distinguish(); - ERO.sample(); - return b; - } - }. - - section EAGER. - - local lemma eager_query: - eager [ERO.sample(); , RO.f ~ ERO.f, ERO.sample(); : - ={x,RO.m} ==> ={res,RO.m} ]. - proof. - eager proc. - inline ERO.sample;swap{2} 4 -3. - seq 1 1: (={x,work,RO.m});first by sim. - wp;case ((mem (dom RO.m) x){1}). - + rnd{1}. - alias{1} 1 mx = oget RO.m.[x]. - while (={work,RO.m} /\ (RO.m.[x] = Some mx){1}). - + by inline *;auto;progress;smt. - auto;progress [- split]; rewrite sample_ll H /=;smt. - case ((!mem work x){1}). - + swap{1} 2 -1;while (={work,x} /\ eq_except RO.m{1} RO.m{2} (fset1 x{1}) /\ - (!mem work x){1} /\ (RO.m.[x] = Some rd){2} /\ (!mem (dom RO.m) x){1}). - + inline *;auto;progress [-split]. - cut -> : mem (dom RO.m{2}) (pick work{2}) = mem (dom RO.m{1}) (pick work{2}) by rewrite !in_dom;smt. - smt. - auto;progress [-split];rewrite !getP_eq;smt. - inline RO.f. - transitivity{1} { rd <$ sample x; - while (work <> fset0) { - x0 <- pick work; - rd0 <$ sample x0; - if (!mem (dom RO.m) x0) - RO.m.[x0] <- if x0 = x then rd else rd0; - work <- work `\` fset1 (pick work); - } } - (={x,work,RO.m} ==> ={x,RO.m}) - ((={x,work,RO.m} /\ mem work{1} x{1}) /\ ! mem (dom RO.m{2}) x{2} ==> - ={x,RO.m} /\ (result = oget RO.m.[x]){2} /\ mem (dom RO.m{1}) x{1}) => //. - + by move=> &1 &2 H; exists RO.m{2}, x{2}, work{2}; move: H. - + transitivity{1} { while (work <> fset0) { - x0 <- pick work; - rd0 <$ sample x0; - if (!mem (dom RO.m) x0) RO.m.[x0] <- rd0; - work <- work `\` fset1 (pick work); - } - rd <$ sample x; } - (={x,work,RO.m} ==> ={x,RO.m}) - (={x,work,RO.m} ==> ={x,RO.m})=> //. - + by move=> &1 &2 H; exists RO.m{2}, x{2}, work{2}; move: H. - + by sim; rnd{2}; sim : (={x,IND_Eager.H.m}); smt. - symmetry; eager while (H: rd <$ sample x; ~ rd <$ sample x; : ={x} ==> ={rd})=> //; sim. - swap{2} 5 -4; swap [2..3] -1; case ((x = pick work){1}). - + by wp; rnd{2}; rnd; rnd{1}; wp; skip; smt. - by auto; smt. - + while (={x, work} /\ - (!mem work x => mem (dom RO.m) x){1} /\ - RO.m.[x]{2} = Some rd{1} /\ - if (mem (dom RO.m) x){1} then ={RO.m} - else eq_except RO.m{1} RO.m{2} (fset1 x{1})). - + auto;progress; 1..9,12:smt. - + case ((pick work = x){2})=> pick_x; last smt. - subst x{2}; move: H7 H1; rewrite -neqF /eq_except=> -> /= eq_exc. - by apply fmapP=> x0; case (pick work{2} = x0); smt. - by auto; smt w=@NewFMap. - by auto;progress [-split];rewrite H0 /= getP_eq;smt. - qed. - - equiv Eager_S (D <: Distinguisher{RO}): IND_S(D).main ~ IND(ERO,D).main: ={glob D} ==> ={res,RO.m,glob D}. - proof. - proc; inline ERO.init RO.init. - seq 1 1: (={glob D, RO.m});first by wp. - symmetry; eager (H: ERO.sample(); ~ ERO.sample();: ={RO.m} ==> ={RO.m}): - (={glob D, RO.m}) => //; first by sim. - eager proc H (={RO.m}) => //; [by apply eager_query | by sim]. - qed. - - equiv Eager (D <: Distinguisher{RO}): IND(RO,D).main ~ IND(ERO,D).main: ={glob D} ==> ={res,glob D}. - proof. - transitivity IND_S(D).main - (={glob D} ==> ={res,glob D}) - (={glob D} ==> ={res,RO.m,glob D}) => //. - + by progress;exists (glob D){2}. - + proc;inline{2} ERO.sample. - while{2} true (card work{2}). - + move=> &m1 z;wp;call (f_ll sample_ll);auto;smt. - conseq (_: _ ==> ={b,glob D}) => //;[smt | by sim]. - apply (Eager_S D). - qed. - - end section EAGER. - -end GenIdeal. - -abstract theory FiniteIdeal. - - clone include Ideal. - axiom sample_ll (x : from): Distr.weight (sample x) = 1%r. - - op univ : from fset. - axiom univP (x:from) : mem univ x. - - module ERO = { - proc sample() = { - var work; - work <- univ; - while (work <> fset0) { - RO.f(pick work); - work = work `\` fset1 (pick work); - } - } - - proc init() = { - RO.m <- map0; - sample(); - } - - proc f(x:from):to = { return oget RO.m.[x]; } - }. - - module IND_S(D:Distinguisher) = { - proc main(): bool = { - var b; - RO.init(); - b <@ D(RO).distinguish(); - ERO.sample(); - return b; - } - }. - - section EAGER. - - declare module D: Distinguisher { RO }. - - local clone GenIdeal as GI with - op sample <- sample, - op RO_dom <- univ - proof sample_ll by apply sample_ll. - - local equiv ERO_main: - IND(GI.ERO, D).main ~ IND(ERO, D).main : ={glob D} ==> ={res, glob D} /\ GI.RO.m{1} = RO.m{2}. - proof. - proc. - call (_:GI.RO.m{1} = RO.m{2} /\ dom RO.m{2} = univ). - + proc; rcondf{1} 2;auto;progress;[ by rewrite H univP | by apply sample_ll]. - inline *. - while (={work} /\ GI.RO.m{1} = RO.m{2} /\ dom RO.m{2} = univ `\` work{2});auto;smt. - qed. - - equiv Eager_S : IND_S(D).main ~ IND(ERO,D).main: ={glob D} ==> ={res,RO.m,glob D}. - proof. - transitivity GI.IND_S(D).main - (={glob D} ==> ={res,glob D} /\ RO.m{1} = GI.RO.m{2}) - (={glob D} ==> ={res,glob D} /\ GI.RO.m{1} = RO.m{2}) => //. - + by progress;exists (glob D){2}. - + by sim. - transitivity IND(GI.ERO,D).main - (={glob D} ==> ={res,glob D, GI.RO.m}) - (={glob D} ==> ={res,glob D} /\ GI.RO.m{1} = RO.m{2}) => //. - + by progress;exists (glob D){2}. - + by conseq (GI.Eager_S D). - by apply ERO_main. - qed. - - equiv Eager : IND(RO, D).main ~ IND(ERO,D).main: ={glob D} ==> ={res,glob D}. - proof. - transitivity IND(GI.RO,D).main - (={glob D} ==> ={res,glob D} /\ RO.m{1} = GI.RO.m{2}) - (={glob D} ==> ={res,glob D}) => //. - + by progress;exists (glob D){2}. - + by sim. - transitivity IND(GI.ERO,D).main - (={glob D} ==> ={res,glob D}) - (={glob D} ==> ={res,glob D}) => //. - + by progress;exists (glob D){2}. - + by conseq (GI.Eager D). - by conseq ERO_main. - qed. - - end section EAGER. - -end FiniteIdeal. - - -abstract theory RestrIdeal. - - clone include Ideal. - axiom sample_ll (x : from): Distr.weight (sample x) = 1%r. - - op test : from -> bool. - op univ : from fset. - op dfl : to. - - axiom testP x : test x <=> mem univ x. - - module Restr (O:RO) = { - proc init = RO.init - proc f (x:from) : to = { - var r <- dfl; - if (test x) r <@ RO.f(x); - return r; - } - }. - - module ERO = { - proc sample() = { - var work; - work <- univ; - while (work <> fset0) { - RO.f(pick work); - work = work `\` fset1 (pick work); - } - } - - proc init() = { - RO.m <- map0; - sample(); - } - - proc f(x:from):to = { - return (if test x then oget RO.m.[x] else dfl); - } - }. - - module IND_S(D:Distinguisher) = { - proc main(): bool = { - var b; - RO.init(); - b <@ D(Restr(RO)).distinguish(); - ERO.sample(); - return b; - } - }. - - section EAGER. - - declare module D: Distinguisher { RO }. - - local clone GenIdeal as GI with - op sample <- sample, - op RO_dom <- univ. - - local module Restr' (O:RO) = { - proc init() = { } - proc f(x:from) = { - var r <- dfl; - if (test x) r <@ O.f(x); - return r; - } - }. - - local module RD (O:RO) = D(Restr'(O)). - - local equiv ERO_main: - IND(GI.ERO, RD).main ~ IND(ERO, D).main : ={glob D} ==> ={res, glob D} /\ GI.RO.m{1} = RO.m{2}. - proof. - proc. - call (_:GI.RO.m{1} = RO.m{2} /\ dom RO.m{2} = univ). - + proc. - case (test x{1});[ rcondt{1} 2 | rcondf{1} 2];auto;last smt ml=0. - by inline *;rcondf{1} 4;auto;progress;2:(by apply sample_ll);rewrite ?H0 ?H -?testP. - inline *. - while (={work} /\ GI.RO.m{1} = RO.m{2} /\ dom RO.m{2} `|` work{2} = univ);auto;1:progress; smt. - qed. - - equiv Eager_S : IND_S(D).main ~ IND(ERO,D).main: ={glob D} ==> ={res,RO.m,glob D}. - proof. - transitivity GI.IND_S(RD).main - (={glob D} ==> ={res,glob D} /\ RO.m{1} = GI.RO.m{2}) - (={glob D} ==> ={res,glob D} /\ GI.RO.m{1} = RO.m{2}) => //. - + by progress;exists (glob D){2}. - + by sim. - transitivity IND(GI.ERO,RD).main - (={glob D} ==> ={res,glob D, GI.RO.m}) - (={glob D} ==> ={res,glob D} /\ GI.RO.m{1} = RO.m{2}) => //. - + by progress;exists (glob D){2}. - + by conseq (GI.Eager_S RD). - by apply ERO_main. - qed. - - equiv Eager : IND(Restr(RO), D).main ~ IND(ERO,D).main: ={glob D} ==> ={res,glob D}. - proof. - transitivity IND(GI.RO,RD).main - (={glob D} ==> ={res,glob D} /\ RO.m{1} = GI.RO.m{2}) - (={glob D} ==> ={res,glob D}) => //. - + by progress;exists (glob D){2}. - + by sim. - transitivity IND(GI.ERO,RD).main - (={glob D} ==> ={res,glob D}) - (={glob D} ==> ={res,glob D}) => //. - + by progress;exists (glob D){2}. - + by conseq (GI.Eager RD). - by conseq ERO_main. - qed. - - end section EAGER. - -end RestrIdeal. \ No newline at end of file diff --git a/proof/variant/LeakyAbsorb.ec b/proof/variant/LeakyAbsorb.ec deleted file mode 100644 index 8f03201..0000000 --- a/proof/variant/LeakyAbsorb.ec +++ /dev/null @@ -1,416 +0,0 @@ -(* -------------------------------------------------------------------- *) -require import Option Pair Int Real Distr List FSet NewFMap DProd. -require (*--*) LazyRP RndOrcl. - -(* -------------------------------------------------------------------- *) - -type block. (* = {0,1}^r *) -type capacity. (* = {0,1}^c *) - -op cdist : capacity distr. -op bdist : block distr. -axiom bdist_ll : weight bdist = 1%r. - -(* isomorphic to the {0,1}^? uniform distributions *) - -op b0 : block. -op c0 : capacity. - -op (^) : block -> block -> block. - -(* -------------------------------------------------------------------- *) -clone import LazyRP as Perm with - type D <- block * capacity, - op d <- bdist `*` cdist - - rename [module] "P" as "Perm". - - -(* -------------------------------------------------------------------- *) -module type WeirdIRO = { - proc init(): unit - - proc f(_: block list * int): block list -}. - -module type WeirdIRO_ = { - proc f(_: block list * int): block list -}. - -op valid_query : block list -> int -> bool. -op valid_queries : (block list) fset. -axiom valid_queryP : forall m n, valid_query m n => forall k, 0 <= k <= n => mem valid_queries (m ++ mkseq (fun x => b0) k). -axiom valid_query_take : forall m n, valid_query m n => forall i, 0 <= i <= size m => mem valid_queries (take i m). -axiom valid_query_take1 : - forall m n, valid_query m n => forall i, 0 <= i <= size m => valid_query (take i m) 1. -axiom valid_query_size : forall m n, valid_query m n => 1 <= size m. - -module type RO = { - proc init () : unit - proc f(_:block list) : block -}. - -module Ro = { - var h : (block list,block) fmap - - proc init() = { h = map0; } - - proc f(m : block list) = { - var r; - r <$ bdist; - if (!mem (dom h) m) h.[m] <- r ; - return oget h.[m]; - } -}. - -module GenIdealFunctionalityThatDoesNotAbsorb(Ro:RO) = { - proc init = Ro.init - - proc f(m : block list, n : int) = { - var i <- 1; - var j <- 1; - var z <- []; - var b <- b0; - - if (valid_query m n) { - while (j <= size m) { - z <- rcons z b; - b <@ Ro.f(take j m); - j <- j + 1; - } - while (i < n) { - z <- rcons z b; - m <- rcons m b0; - b <@ Ro.f(m); - i <- i + 1; - } - } - return z; - } -}. - -module IdealFunctionalityThatDoesNotAbsorb = GenIdealFunctionalityThatDoesNotAbsorb(Ro). - -module GenIdealFunctionalityThatAbsorbs(Ro:RO) = { - proc init = Ro.init - - proc f(m : block list, n : int) = { - var i <- 1; - var z <- []; - var b; - - if (valid_query m n) { - b <@ Ro.f(m); - while (i < n) { - z <- rcons z b; - m <- rcons m b0; - b <@ Ro.f(m); - i<- i + 1; - } - } - return z; - } -}. - -module IdealFunctionalityThatAbsorbs = GenIdealFunctionalityThatAbsorbs(Ro). - -(* -------------------------------------------------------------------- *) -module type CONSTRUCTION(P : RP) = { - proc init() : unit - - proc f(bp : block list, n : int) : block list -}. - -module type SIMULATOR(F : WeirdIRO_) = { - proc init() : unit - - proc f(_ : block * capacity) : block * capacity - - proc fi(_ : block * capacity) : block * capacity -}. - -module type DISTINGUISHER(F : WeirdIRO_, P : RP_) = { - proc distinguish() : bool -}. - -(* -------------------------------------------------------------------- *) -module Experiment(F : WeirdIRO, P : RP, D : DISTINGUISHER) = { - proc main() : bool = { - var b; - - F.init(); - P.init(); - b <@ D(F, P).distinguish(); - - return b; - } -}. - -(* -------------------------------------------------------------------- *) -module SpongeThatDoesNotAbsorb (P : RP) : WeirdIRO, CONSTRUCTION(P) = { - proc init () = { } - - proc f(p : block list, n : int): block list = { - var z <- []; - var (sa,sc) <- (b0, c0); - var i <- 0; - var l <- size p; - - if (valid_query p n) { - (* Absorption *) - while (p <> []) { - z <- rcons z sa; - (sa,sc) <@ P.f(sa ^ head b0 p, sc); - p <- behead p; - } - (* Squeezing *) - while (i < n) { - z <- rcons z sa; - (sa,sc) <@ P.f(sa,sc); - } - } - - return z; - } -}. - -module SpongeThatAbsorbs (P : RP) : WeirdIRO, CONSTRUCTION(P) = { - proc init () = {} - - proc f(p : block list, n : int): block list = { - var z <- []; - var (sa,sc) <- (b0, c0); - var i <- 0; - - if (valid_query p n) { - (* Absorption *) - while (p <> []) { - (sa,sc) <@ P.f(sa ^ head b0 p, sc); - p <- behead p; - } - (* Squeezing *) - while (i < n) { - z <- rcons z sa; - (sa,sc) <@ P.f(sa,sc); - } - } - - return z; - } -}. - -(* -------------------------------------------------------------------- *) -section PROOF. - declare module S:SIMULATOR { IdealFunctionalityThatDoesNotAbsorb }. - declare module D:DISTINGUISHER { Perm, IdealFunctionalityThatDoesNotAbsorb, S }. - - (* From DoNot to Absorb *) - - module MkF(F:WeirdIRO_) = { - proc f(m:block list, n:int) = { - var r = []; - if (valid_query m n) { - r <@ F.f(m,n); - r <- drop (size m) r; - } - return r; - } - }. - - (* From Absord to do Not *) - module MkD (D:DISTINGUISHER, F:WeirdIRO_, P:RP_) = D(MkF(F),P). - - module MkFdoNot1 (F:WeirdIRO_) = { - proc f(m:block list, n:int) : block list = { - var i, r, tl, b; - r <- []; - if (valid_query m n) { - i <- 1; - b <- [b0]; - while (i <= size m) { - r <- r ++ b; - b <- F.f(take i m, 1); - i <- i + 1; - - } - tl <- F.f(m,n); - r <- r ++ tl; - } - return r; - } - }. - - module MkFdoNot (F:WeirdIRO) = { - proc init = F.init - proc f = MkFdoNot1(F).f - }. - - module MkS(S:SIMULATOR, F:WeirdIRO) = S(MkFdoNot(F)). - - local clone RndOrcl as RndOrcl0 with - type from <- block list, - type to <- block. - - local clone RndOrcl0.RestrIdeal as RI with - op sample <- fun (bl:block list) => bdist, - op test <- (mem valid_queries), - op univ <- valid_queries, - op dfl <- b0 - proof *. - realize sample_ll. by move=> _;apply bdist_ll. qed. - realize testP. by []. qed. - import RI. - - local module E1 (Ro:RO) = { - module F = { - proc f = GenIdealFunctionalityThatDoesNotAbsorb(Ro).f - } - module P = S(F) - proc distinguish () : bool = { - var b; - P.init(); - b <@ MkD(D, F, P).distinguish(); - return b; - } - }. - - local module E2 (Ro:RO) = { - module F = { - proc f = GenIdealFunctionalityThatAbsorbs(Ro).f - } - module P = S(MkFdoNot1(F)) - proc distinguish () : bool = { - var b; - P.init(); - b <@ D(F, P).distinguish(); - return b; - } - }. - - local equiv f_f : - GenIdealFunctionalityThatDoesNotAbsorb(Ro).f ~ E1(Restr(RO)).F.f : - ={m, n} /\ Ro.h{1} = RO.m{2} ==> ={res} /\ Ro.h{1} = RO.m{2}. - proof. - proc;sp;if => //. - inline{2} Restr(RO).f. - while (={z,i,n,b,m} /\ Ro.h{1} = RO.m{2} /\ - (forall k, 0 <= k <= n - i => mem valid_queries (m ++ map (fun x => b0) (iota_ 0 k))){2}). - + rcondt{2} 5=> //. - + auto;progress; rewrite - cats1;cut := H 1 _; [by smt| by rewrite iota1]. - auto; call (_:Ro.h{1} = RO.m{2});[by sim | auto;progress]. - cut := H (k+1) _;1:by smt. - rewrite iotaS //= -cats1 -catA /= (_: map (fun (x : int) => b0) (iota_ 1 k) = map (fun (x : int) => b0) (iota_ 0 k)) //. - by rewrite (iota_addl 1 0 k) -map_comp;apply eq_map. - while (={z,j,n,b,m} /\ Ro.h{1} = RO.m{2} /\ valid_query m{1} n{1} /\ 0 <= j{1}). - + rcondt{2} 4=> //. - + auto;progress;apply (valid_query_take _ _ H)=> //. - auto; call (_:Ro.h{1} = RO.m{2});[by sim | auto;progress;smt]. - skip;progress;apply (valid_queryP _ _ H2);smt. - qed. - - local equiv f_f_a : GenIdealFunctionalityThatAbsorbs(Ro).f ~ E2(Restr(RO)).F.f : ={m,n} /\ Ro.h{1} = RO.m{2} ==> ={res} /\ Ro.h{1} = RO.m{2}. - proof. - proc; sp;if=> //;inline{2} Restr(RO).f;sp. - rcondt{2} 1=> //. - + auto;progress;cut := valid_query_take _ _ H (size m{hr}). - rewrite take_size=> HH;apply HH;smt. - while (={z,i,n,b,m} /\ Ro.h{1} = RO.m{2} /\ - (forall k, 0 <= k <= n - i => mem valid_queries (m ++ map (fun x => b0) (iota_ 0 k))){2}). - + rcondt{2} 5=> //. - + auto;progress; rewrite -cats1;cut := H 1 _; [by smt| by rewrite iota1]. - auto; call (_:Ro.h{1} = RO.m{2});[by sim | auto;progress]. - cut := H (k+1) _;1:by smt. - rewrite iotaS //= -cats1 -catA /= (_: map (fun (x : int) => b0) (iota_ 1 k) = map (fun (x : int) => b0) (iota_ 0 k)) //. - by rewrite (iota_addl 1 0 k) -map_comp;apply eq_map. - wp;call (_:Ro.h{1} = RO.m{2});[by sim | auto;progress]. - apply (valid_queryP _ _ H);smt. - qed. - - local equiv f_f' : - MkFdoNot(GenIdealFunctionalityThatAbsorbs(Ro)).f ~ MkFdoNot1(E2(Restr(RO)).F).f : - ={m, n} /\ Ro.h{1} = RO.m{2} ==> - ={res} /\ Ro.h{1} = RO.m{2}. - proof. - proc;sp;if => //;wp. - call f_f_a. - while (={i,m,r,b} /\ Ro.h{1} = RO.m{2} /\ valid_query m{1} n{1} /\ 0 <= i{1});last by auto. - wp; call f_f_a;auto;progress;smt. - qed. - - local equiv f_dN : E1(ERO).F.f ~ MkFdoNot1(E2(ERO).F).f : ={m, n} /\ ={RO.m} ==> ={res, RO.m}. - proof. - proc;sp;if=> //;sp. - inline {2} E2(ERO).F.f. - rcondt{2} 6;auto; 1: by conseq (_: _ ==> true). - while (={RO.m} /\ z{1} = r{2} ++ z0{2} /\ i{1} = i1{2} /\ n{1} = n1{2} /\ b{1} = b1{2} /\ - m{1} = m1{2}). - + inline *;auto;progress;smt. - inline ERO.f;auto. - while (={RO.m,m,n} /\ z{1} = r{2} /\ b{2} = [b{1}] /\ valid_query m{1} n{1} /\ - j{1} = i{2} /\ 0 <= i{2} /\ - (1 < j => b = mem valid_queries (take j m) ? oget RO.m.[x] : Self.b0){1}). - + rcondt{2} 6;1:by auto;progress;smt. - rcondf{2} 8;1:by auto. - auto;progress;smt. - auto;progress;smt. - qed. - - lemma conclusion &m: - `| Pr[Experiment(SpongeThatDoesNotAbsorb(Perm), Perm, MkD(D)).main() @ &m : res] - - Pr[Experiment(IdealFunctionalityThatDoesNotAbsorb, - S(IdealFunctionalityThatDoesNotAbsorb), MkD(D)).main() @ &m : res] | = - `|Pr[Experiment(SpongeThatAbsorbs(Perm),Perm,D).main() @ &m : res] - - Pr[Experiment(IdealFunctionalityThatAbsorbs, MkS(S,IdealFunctionalityThatAbsorbs), D).main() @ &m : res]|. - proof. - do 3?congr. - + byequiv (_: ={glob D} ==> _) => //;proc;inline *. - call (_: ={glob Perm});1,2:(by sim); last by auto. - proc;inline{1}SpongeThatDoesNotAbsorb(Perm).f;sp 1 3;if=> //. - sp;rcondt{1} 1=> //;wp. - while (={glob Perm, i, sa, sc} /\ n0{1} = n{2} /\ z{1} = take (size m{1}) z{1} ++ z{2} /\ size m{1} <= size z{1}). - + call (_ : ={glob Perm});[by sim|auto;progress [-split];smt]. - while (={glob Perm, p, sa,sc} /\ (size z = size m - size p){1}). - + wp;call (_ : ={glob Perm});[by sim|auto;progress [-split]]. - by rewrite size_rcons H; move: H0; case: (p{2})=> //= x xs; ring. - by auto;progress [-split];smt. - cut -> : Pr[Experiment(IdealFunctionalityThatDoesNotAbsorb, S(IdealFunctionalityThatDoesNotAbsorb), MkD(D)).main () @ &m : res] = - Pr[RndOrcl0.IND(Restr(RO), E1).main() @ &m : res]. - + byequiv=> //. (* PY: BUG printer res *) - proc;inline{2} E1(Restr(RO)).distinguish;auto. - call (_: ={glob S} /\ Ro.h{1} = RO.m{2}). - + by proc (Ro.h{1} = RO.m{2}) => //;apply f_f. - + by proc (Ro.h{1} = RO.m{2}) => //;apply f_f. - + by proc;sp;if=> //;wp;call f_f. - by inline *; call (_: Ro.h{1} = RO.m{2});auto;apply f_f. - cut -> : Pr[Experiment(IdealFunctionalityThatAbsorbs, MkS(S, IdealFunctionalityThatAbsorbs), D).main() @ &m : res] = - Pr[RndOrcl0.IND(Restr(RO), E2).main() @ &m : res]. - + byequiv=> //. - proc;inline{2} E2(Restr(RO)).distinguish;auto. - call (_: ={glob S} /\ Ro.h{1} = RO.m{2}). - + proc (Ro.h{1} = RO.m{2}) => //; apply f_f'. - + by proc (Ro.h{1} = RO.m{2}) => //;apply f_f'. - + conseq f_f_a => //. - by inline *;call (_:Ro.h{1} = RO.m{2});[apply f_f'|auto]. - cut -> : Pr[RndOrcl0.IND(Restr(RO), E1).main() @ &m : res] = - Pr[RndOrcl0.IND(ERO, E1).main() @ &m : res]. - + byequiv (Eager E1)=> //. - cut -> : Pr[RndOrcl0.IND(Restr(RO), E2).main() @ &m : res] = - Pr[RndOrcl0.IND(ERO, E2).main() @ &m : res]. - + byequiv (Eager E2)=> //. - byequiv=> //. - proc; inline *;wp. - call (_: ={RO.m, glob S}). - + by proc (={RO.m})=> //;apply f_dN. - + by proc (={RO.m})=> //;apply f_dN. - + proc;sp;if => //. - inline{1} E1(ERO).F.f;sp;rcondt{1} 1; 1:by auto. - wp;while (={RO.m,i,b} /\ n0{1} = n{2} /\ m0{1} = m{2} /\ z{1} = take (size m{1}) z{1} ++ z{2} /\ (size m <= size z){1}). - + inline *;auto;progress [-split]; smt. - inline *;splitwhile{1} 1 : (j < size m0). - wp;seq 1 0 : (={i,RO.m, m, glob S} /\ n0{1} = n{2} /\ m0{1} = m{2} /\ size m0{1} - 1 = size z{1} /\ size m0{1} = j{1} /\ z{2} = []). - while{1} (size z{1} = j{1} - 1 /\ j{1} <= size m0{1}) ((size m0 - j){1});auto;progress [-split]; smt. - rcondt{1} 1;1:by auto. - rcondf{1} 5;auto;progress[-split];smt. - call (_: ={RO.m})=> //;1:by apply f_dN. - sim : (={glob S, glob D, RO.m})=> //. - qed. diff --git a/proof/variant/RndOrcl.eca b/proof/variant/RndOrcl.eca deleted file mode 100644 index 07fd6ba..0000000 --- a/proof/variant/RndOrcl.eca +++ /dev/null @@ -1,385 +0,0 @@ -require import Option FSet NewFMap NewDistr. -(* TODO move this in NewFMap *) -lemma dom_set (m:('a,'b) fmap) a b : dom m.[a<-b] = dom m `|` fset1 a. -proof. by apply fsetP=> x;smt. qed. - -type from, to. - -module type RO = { - proc init() : unit - proc f(x : from): to -}. - -module type Distinguisher(G : RO) = { - proc distinguish(): bool {G.f} -}. - -module IND(G:RO, D:Distinguisher) = { - proc main(): bool = { - var b; - - G.init(); - b <@ D(G).distinguish(); - return b; - } -}. - -abstract theory Ideal. - - op sample : from -> to distr. - - module RO = { - var m : (from, to) fmap - - proc init() : unit = { - m <- map0; - } - - proc f(x : from) : to = { - var rd; - rd <$ sample x; - if (! mem (dom m) x) m.[x] <- rd; - return oget m.[x]; - } - }. - - section LL. - - axiom sample_ll : forall x, weight (sample x) = 1%r. - - lemma f_ll : phoare[RO.f : true ==> true] = 1%r. - proof. proc;auto;progress;apply sample_ll. qed. - - end section LL. - -end Ideal. - - -abstract theory GenIdeal. - - clone include Ideal. - axiom sample_ll : forall x, Distr.weight (sample x) = 1%r. - - op RO_dom : from fset. - - module ERO = { - proc sample() = { - var work; - work <- RO_dom; - while (work <> fset0) { - RO.f(pick work); - work = work `\` fset1 (pick work); - } - } - - proc init() = { - RO.m <- map0; - sample(); - } - - proc f = RO.f - }. - - module IND_S(D:Distinguisher) = { - proc main(): bool = { - var b; - RO.init(); - b <@ D(RO).distinguish(); - ERO.sample(); - return b; - } - }. - - section EAGER. - - local lemma eager_query: - eager [ERO.sample(); , RO.f ~ ERO.f, ERO.sample(); : - ={x,RO.m} ==> ={res,RO.m} ]. - proof. - eager proc. - inline ERO.sample;swap{2} 4 -3. - seq 1 1: (={x,work,RO.m});first by sim. - wp;case ((mem (dom RO.m) x){1}). - + rnd{1}. - alias{1} 1 mx = oget RO.m.[x]. - while (={work,RO.m} /\ (RO.m.[x] = Some mx){1}). - + by inline *;auto;progress;smt. - auto;progress [- split]; rewrite sample_ll H /=;smt. - case ((!mem work x){1}). - + swap{1} 2 -1;while (={work,x} /\ eq_except RO.m{1} RO.m{2} (fset1 x{1}) /\ - (!mem work x){1} /\ (RO.m.[x] = Some rd){2} /\ (!mem (dom RO.m) x){1}). - + inline *;auto;progress [-split]. - cut -> : mem (dom RO.m{2}) (pick work{2}) = mem (dom RO.m{1}) (pick work{2}) by rewrite !in_dom;smt. - smt. - auto;progress [-split];rewrite !getP_eq;smt. - inline RO.f. - transitivity{1} { rd <$ sample x; - while (work <> fset0) { - x0 <- pick work; - rd0 <$ sample x0; - if (!mem (dom RO.m) x0) - RO.m.[x0] <- if x0 = x then rd else rd0; - work <- work `\` fset1 (pick work); - } } - (={x,work,RO.m} ==> ={x,RO.m}) - ((={x,work,RO.m} /\ mem work{1} x{1}) /\ ! mem (dom RO.m{2}) x{2} ==> - ={x,RO.m} /\ (result = oget RO.m.[x]){2} /\ mem (dom RO.m{1}) x{1}) => //. - + by move=> &1 &2 H; exists RO.m{2}, x{2}, work{2}; move: H. - + transitivity{1} { while (work <> fset0) { - x0 <- pick work; - rd0 <$ sample x0; - if (!mem (dom RO.m) x0) RO.m.[x0] <- rd0; - work <- work `\` fset1 (pick work); - } - rd <$ sample x; } - (={x,work,RO.m} ==> ={x,RO.m}) - (={x,work,RO.m} ==> ={x,RO.m})=> //. - + by move=> &1 &2 H; exists RO.m{2}, x{2}, work{2}; move: H. - + by sim; rnd{2}; sim : (={x,IND_Eager.H.m}); smt. - symmetry; eager while (H: rd <$ sample x; ~ rd <$ sample x; : ={x} ==> ={rd})=> //; sim. - swap{2} 5 -4; swap [2..3] -1; case ((x = pick work){1}). - + by wp; rnd{2}; rnd; rnd{1}; wp; skip; smt. - by auto; smt. - + while (={x, work} /\ - (!mem work x => mem (dom RO.m) x){1} /\ - RO.m.[x]{2} = Some rd{1} /\ - if (mem (dom RO.m) x){1} then ={RO.m} - else eq_except RO.m{1} RO.m{2} (fset1 x{1})). - + auto;progress; 1..9,12:smt. - + case ((pick work = x){2})=> pick_x; last smt. - subst x{2}; move: H7 H1; rewrite -neqF /eq_except=> -> /= eq_exc. - by apply fmapP=> x0; case (pick work{2} = x0); smt. - by auto; smt w=@NewFMap. - by auto;progress [-split];rewrite H0 /= getP_eq;smt. - qed. - - equiv Eager_S (D <: Distinguisher{RO}): IND_S(D).main ~ IND(ERO,D).main: ={glob D} ==> ={res,RO.m,glob D}. - proof. - proc; inline ERO.init RO.init. - seq 1 1: (={glob D, RO.m});first by wp. - symmetry; eager (H: ERO.sample(); ~ ERO.sample();: ={RO.m} ==> ={RO.m}): - (={glob D, RO.m}) => //; first by sim. - eager proc H (={RO.m}) => //; [by apply eager_query | by sim]. - qed. - - equiv Eager (D <: Distinguisher{RO}): IND(RO,D).main ~ IND(ERO,D).main: ={glob D} ==> ={res,glob D}. - proof. - transitivity IND_S(D).main - (={glob D} ==> ={res,glob D}) - (={glob D} ==> ={res,RO.m,glob D}) => //. - + by progress;exists (glob D){2}. - + proc;inline{2} ERO.sample. - while{2} true (card work{2}). - + move=> &m1 z;wp;call (f_ll sample_ll);auto;smt. - conseq (_: _ ==> ={b,glob D}) => //;[smt | by sim]. - apply (Eager_S D). - qed. - - end section EAGER. - -end GenIdeal. - -abstract theory FiniteIdeal. - - clone include Ideal. - axiom sample_ll (x : from): Distr.weight (sample x) = 1%r. - - op univ : from fset. - axiom univP (x:from) : mem univ x. - - module ERO = { - proc sample() = { - var work; - work <- univ; - while (work <> fset0) { - RO.f(pick work); - work = work `\` fset1 (pick work); - } - } - - proc init() = { - RO.m <- map0; - sample(); - } - - proc f(x:from):to = { return oget RO.m.[x]; } - }. - - module IND_S(D:Distinguisher) = { - proc main(): bool = { - var b; - RO.init(); - b <@ D(RO).distinguish(); - ERO.sample(); - return b; - } - }. - - section EAGER. - - declare module D: Distinguisher { RO }. - - local clone GenIdeal as GI with - op sample <- sample, - op RO_dom <- univ - proof sample_ll by apply sample_ll. - - local equiv ERO_main: - IND(GI.ERO, D).main ~ IND(ERO, D).main : ={glob D} ==> ={res, glob D} /\ GI.RO.m{1} = RO.m{2}. - proof. - proc. - call (_:GI.RO.m{1} = RO.m{2} /\ dom RO.m{2} = univ). - + proc; rcondf{1} 2;auto;progress;[ by rewrite H univP | by apply sample_ll]. - inline *. - while (={work} /\ GI.RO.m{1} = RO.m{2} /\ dom RO.m{2} = univ `\` work{2});auto;smt. - qed. - - equiv Eager_S : IND_S(D).main ~ IND(ERO,D).main: ={glob D} ==> ={res,RO.m,glob D}. - proof. - transitivity GI.IND_S(D).main - (={glob D} ==> ={res,glob D} /\ RO.m{1} = GI.RO.m{2}) - (={glob D} ==> ={res,glob D} /\ GI.RO.m{1} = RO.m{2}) => //. - + by progress;exists (glob D){2}. - + by sim. - transitivity IND(GI.ERO,D).main - (={glob D} ==> ={res,glob D, GI.RO.m}) - (={glob D} ==> ={res,glob D} /\ GI.RO.m{1} = RO.m{2}) => //. - + by progress;exists (glob D){2}. - + by conseq (GI.Eager_S D). - by apply ERO_main. - qed. - - equiv Eager : IND(RO, D).main ~ IND(ERO,D).main: ={glob D} ==> ={res,glob D}. - proof. - transitivity IND(GI.RO,D).main - (={glob D} ==> ={res,glob D} /\ RO.m{1} = GI.RO.m{2}) - (={glob D} ==> ={res,glob D}) => //. - + by progress;exists (glob D){2}. - + by sim. - transitivity IND(GI.ERO,D).main - (={glob D} ==> ={res,glob D}) - (={glob D} ==> ={res,glob D}) => //. - + by progress;exists (glob D){2}. - + by conseq (GI.Eager D). - by conseq ERO_main. - qed. - - end section EAGER. - -end FiniteIdeal. - - -abstract theory RestrIdeal. - - clone include Ideal. - axiom sample_ll (x : from): Distr.weight (sample x) = 1%r. - - op test : from -> bool. - op univ : from fset. - op dfl : to. - - axiom testP x : test x <=> mem univ x. - - module Restr (O:RO) = { - proc init = RO.init - proc f (x:from) : to = { - var r <- dfl; - if (test x) r <@ RO.f(x); - return r; - } - }. - - module ERO = { - proc sample() = { - var work; - work <- univ; - while (work <> fset0) { - RO.f(pick work); - work = work `\` fset1 (pick work); - } - } - - proc init() = { - RO.m <- map0; - sample(); - } - - proc f(x:from):to = { - return (if test x then oget RO.m.[x] else dfl); - } - }. - - module IND_S(D:Distinguisher) = { - proc main(): bool = { - var b; - RO.init(); - b <@ D(Restr(RO)).distinguish(); - ERO.sample(); - return b; - } - }. - - section EAGER. - - declare module D: Distinguisher { RO }. - - local clone GenIdeal as GI with - op sample <- sample, - op RO_dom <- univ. - - local module Restr' (O:RO) = { - proc init() = { } - proc f(x:from) = { - var r <- dfl; - if (test x) r <@ O.f(x); - return r; - } - }. - - local module RD (O:RO) = D(Restr'(O)). - - local equiv ERO_main: - IND(GI.ERO, RD).main ~ IND(ERO, D).main : ={glob D} ==> ={res, glob D} /\ GI.RO.m{1} = RO.m{2}. - proof. - proc. - call (_:GI.RO.m{1} = RO.m{2} /\ dom RO.m{2} = univ). - + proc. - case (test x{1});[ rcondt{1} 2 | rcondf{1} 2];auto;last smt ml=0. - by inline *;rcondf{1} 4;auto;progress;2:(by apply sample_ll);rewrite ?H0 ?H -?testP. - inline *. - while (={work} /\ GI.RO.m{1} = RO.m{2} /\ dom RO.m{2} `|` work{2} = univ);auto;1:progress; smt. - qed. - - equiv Eager_S : IND_S(D).main ~ IND(ERO,D).main: ={glob D} ==> ={res,RO.m,glob D}. - proof. - transitivity GI.IND_S(RD).main - (={glob D} ==> ={res,glob D} /\ RO.m{1} = GI.RO.m{2}) - (={glob D} ==> ={res,glob D} /\ GI.RO.m{1} = RO.m{2}) => //. - + by progress;exists (glob D){2}. - + by sim. - transitivity IND(GI.ERO,RD).main - (={glob D} ==> ={res,glob D, GI.RO.m}) - (={glob D} ==> ={res,glob D} /\ GI.RO.m{1} = RO.m{2}) => //. - + by progress;exists (glob D){2}. - + by conseq (GI.Eager_S RD). - by apply ERO_main. - qed. - - equiv Eager : IND(Restr(RO), D).main ~ IND(ERO,D).main: ={glob D} ==> ={res,glob D}. - proof. - transitivity IND(GI.RO,RD).main - (={glob D} ==> ={res,glob D} /\ RO.m{1} = GI.RO.m{2}) - (={glob D} ==> ={res,glob D}) => //. - + by progress;exists (glob D){2}. - + by sim. - transitivity IND(GI.ERO,RD).main - (={glob D} ==> ={res,glob D}) - (={glob D} ==> ={res,glob D}) => //. - + by progress;exists (glob D){2}. - + by conseq (GI.Eager RD). - by conseq ERO_main. - qed. - - end section EAGER. - -end RestrIdeal. \ No newline at end of file From 7913632bbcfc0eac416c49c50778638b443623ab Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Thu, 4 Feb 2016 17:21:47 +0100 Subject: [PATCH 163/525] One more obsolete file. --- proof/core/NBRO.eca | 155 -------------------------------------------- 1 file changed, 155 deletions(-) delete mode 100644 proof/core/NBRO.eca diff --git a/proof/core/NBRO.eca b/proof/core/NBRO.eca deleted file mode 100644 index e744ecb..0000000 --- a/proof/core/NBRO.eca +++ /dev/null @@ -1,155 +0,0 @@ -require import Option Int Real List FSet NewFMap. -require RndOrcl Indifferentiability. - -type p. - -type from. - -type block. -op dblock : block distr. -axiom dblock_ll: Distr.weight dblock = 1%r. - -op univ : (from * int) fset. -op test : from * int -> bool. -op dfl : block. - -clone RndOrcl as ROB with - type from <- from * int, - type to <- block. - -clone include ROB.RestrIdeal with - op sample <- fun (x:from*int) => dblock, - op dfl <- dfl, - op univ <- univ, - op test <- test - proof sample_ll by apply dblock_ll. - -(* axiom testP (x:from * int): test x <=> mem univ x. *) -axiom test_neg (x:from) (n:int): n < 0 => !test (x,n). -axiom test_le (x:from) (n p:int) : 0 <= p <= n => test (x,n) => test (x,p). - -clone import Indifferentiability as IndB with - type p <- p, - type f_in <- from * int, - type f_out <- block. - -clone import Indifferentiability as IndNB with - type p <- p, - type f_in <- from * int, - type f_out <- block list. - -module RONB (Ob:IndB.FUNCTIONALITY) = { - proc init = Ob.init - - proc f(x:from, n:int) : block list = { - var b, bs; - bs <- []; - while (size bs < n) { - b <@ Ob.f(x,size bs); - bs <- rcons bs b; - } - return bs; - } -}. - -module DNB(D:IndNB.DISTINGUISHER, F:IndB.FUNCTIONALITY, P:IndB.PRIMITIVE) = { - proc distinguish = D(RONB(F), P).distinguish -}. - -module CNB (C: IndB.CONSTRUCTION, P:IndB.PRIMITIVE) = RONB(C(P)). - -module FNB_B(F:IndNB.FUNCTIONALITY) = { - proc init () = {} - - proc f(x:from,n:int) : block = { - var bs; - bs <@ F.f(x,n+1); - return nth dfl bs n; - } -}. - -module SNB(S:IndB.SIMULATOR, F:IndNB.FUNCTIONALITY) = { - - proc init = S(FNB_B(F)).init - - proc f = S(FNB_B(F)).f - proc fi = S(FNB_B(F)).fi -}. - -section PROOF. - - declare module P:IndB.PRIMITIVE. - declare module C:IndB.CONSTRUCTION {P}. - declare module S:IndB.SIMULATOR {RO}. - - declare module D: IndNB.DISTINGUISHER {P, RO, S, C}. - - local equiv equivReal: IndNB.GReal(CNB(C), P, D).main ~ IndB.GReal(C, P, DNB(D)).main: - ={glob P, glob C, glob D} ==> - ={glob P, glob C, glob D,res}. - proof. proc;inline *; sim. qed. - - local module DRO (O:ROB.RO) = { - proc distinguish () : bool = { - var b; - SNB(S, RONB(O)).init(); - b <@ D(RONB(O), SNB(S, RONB(O))).distinguish(); - return b; - } - }. - - local module DNB'(O:ROB.RO) : ROB.Distinguisher(O)= { - proc distinguish () : bool = { - var b; - S(O).init(); - b <@ DNB(D, O, S(O)).distinguish(); - return b; - } - }. - - local equiv feq : - FNB_B(RONB(ERO)).f ~ ERO.f : (x, n){1} = x{2} /\ ={RO.m} ==> ={res, RO.m}. - proof. - proc;inline *;wp. - while{1} ((0 <= n0 => size bs0 <= n0){1} /\ forall i, 0 <= i < size bs0{1} => - nth dfl bs0{1} i = - if test (x0{1},i) - then oget RO.m{1}.[(x0{1},i)] - else dfl) ((n0 - size bs0){1}). - + move=> &m2 z;auto;progress [-split]. - rewrite size_rcons;split;2:smt ml=0;split;1:smt ml=0. - move=> i [Hi0 Hi1];rewrite nth_rcons. - case (i < size bs0{hr})=> Hi';first by apply H0. - by cut -> : i = size bs0{hr} by smt ml=0. - auto;progress;1,2: smt ml=0. - case (n{1} < 0)=> Hn. - + by rewrite nth_neg // test_neg. - apply H1=> {H1} //;smt ml=0. - qed. - - lemma conclusion &m: - `|Pr[IndNB.GReal(CNB(C), P, D).main()@ &m:res] - Pr[IndNB.GIdeal(RONB(Restr(RO)), SNB(S), D).main()@ &m:res] | = - `|Pr[IndB.GReal(C, P, DNB(D)).main()@ &m:res] - Pr[IndB.GIdeal(Restr(RO),S,DNB(D)).main()@ &m:res] |. - proof. - cut -> : Pr[IndNB.GReal(CNB(C), P, D).main()@ &m:res] = Pr[IndB.GReal(C, P, DNB(D)).main()@ &m:res]. - + byequiv equivReal=> //. - cut -> : Pr[GIdeal(RONB(Restr(RO)), SNB(S), D).main() @ &m : res] = - Pr[ROB.IND(Restr(RO), DRO).main() @ &m : res]. - + by byequiv=> //; proc;inline *;swap{1} 1 1;sim. - cut -> : Pr[ROB.IND(Restr(RO), DRO).main() @ &m : res] = - Pr[ROB.IND(ERO,DRO).main () @ &m : res]. - + by byequiv (Eager DRO)=> //. - do 2! congr. - cut -> : Pr[IndB.GIdeal(Restr(RO), S, DNB(D)).main() @ &m : res] = - Pr[ROB.IND(Restr(RO), DNB').main() @ &m : res]. - + by byequiv=> //; proc;inline *;swap{1} 1 1;sim. - cut -> : Pr[ROB.IND(Restr(RO), DNB').main() @ &m : res] = - Pr[ROB.IND(ERO, DNB').main() @ &m : res]. - + by byequiv (Eager DNB')=> //. - byequiv=> //;proc;inline DRO(ERO).distinguish DNB'(ERO).distinguish;wp. - call (_: ={RO.m, glob S});1,2:by proc (={RO.m}) => //;apply feq. - + sim. - by conseq (_: _ ==> ={glob S, glob D, RO.m})=> //;sim. - qed. - -end section PROOF. From 089b3ca6f04d5a527ec66b234113cb2cd9d6d059 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Thu, 4 Feb 2016 12:16:36 -0500 Subject: [PATCH 164/525] Merged RP and LazyRP => RP. There's an unrestricted smt left in RP.ec, because of the goal: d_ll: is_lossless dt d_fu: support dt = predT &m: memory h : exists (x : t), ! mem (rng P.m{m}) x ------------------------------------------------------------------------ mu dt (mem (rng P.m{m})) < 1%r After a quick look, I'm not seeing what combination of distribution lemmas says that if the support of a distribution d is all of a type t and some element of t doesn't satisfy a predicate P, that mu d P < 1. --- proof/Common.ec | 8 +++--- proof/LazyRP.eca | 56 ------------------------------------- proof/RP.eca | 72 ++++++++++++++++++++++++++++++++++++------------ 3 files changed, 59 insertions(+), 77 deletions(-) delete mode 100644 proof/LazyRP.eca diff --git a/proof/Common.ec b/proof/Common.ec index dea1847..c4ff7ee 100644 --- a/proof/Common.ec +++ b/proof/Common.ec @@ -2,7 +2,7 @@ require import Option Fun Pair Int IntExtra IntDiv Real List NewDistr. require import Ring StdRing StdOrder StdBigop BitEncoding DProd. -require (*--*) FinType BitWord LazyRP Monoid. +require (*--*) FinType BitWord RP Monoid. (*---*) import IntID IntOrder Bigint Bigint.BIA IntDiv. require import NewLogic. @@ -95,9 +95,9 @@ qed. (*------------------------------ Primitive -----------------------------*) -clone export LazyRP as Perm with - type D <- block * capacity, - op d <- bdistr `*` Capacity.cdistr +clone export RP as Perm with + type t <- block * capacity, + op dt <- bdistr `*` Capacity.cdistr rename [module type] "RP" as "PRIMITIVE" [module] "P" as "Perm". diff --git a/proof/LazyRP.eca b/proof/LazyRP.eca deleted file mode 100644 index b262f0d..0000000 --- a/proof/LazyRP.eca +++ /dev/null @@ -1,56 +0,0 @@ -require import Option Real FSet NewFMap Distr. -require import Dexcepted. -require (*..*) RP. - -type D. -op d: D distr. - -clone include RP with - type from <- D, - type to <- D. - -module P : RP, RP_ = { - var m : (D, D) fmap - var mi: (D, D) fmap - - proc init() = { m = map0; mi = map0; } - - proc f(x) = { - var y; - - if (!mem (dom m) x) { - y <$ d \ (mem (rng m)); - m.[x] <- y; - mi.[y] <- x; - } - return oget m.[x]; - } - - proc fi(x) = { - var y; - - if (!mem (dom mi) x) { - y <$ d \ (mem (rng mi)); - mi.[x] <- y; - m.[y] <- x; - } - return oget mi.[x]; - } -}. - -lemma P_init_ll: islossless P.init. -proof. by proc; auto. qed. - -lemma P_f_ll: is_lossless d => support d = predT => islossless P.f. -proof. -move=> d_ll d_fu; proc; if=> //=; auto=> &m /= x_notin_m. -have h:= endo_dom_rng P.m{m} _; first by exists x{m}. -apply/dexcepted_ll=> //; smt. (* needs help *) -qed. - -lemma P_fi_ll: is_lossless d => support d = predT => islossless P.fi. -proof. -move=> d_ll d_fu; proc; if=> //=; auto=> &m /= x_notin_m. -have h:= endo_dom_rng P.mi{m} _; first by exists x{m}. -apply/dexcepted_ll=> //; smt. (* needs help *) -qed. diff --git a/proof/RP.eca b/proof/RP.eca index eafe094..8f28a87 100644 --- a/proof/RP.eca +++ b/proof/RP.eca @@ -1,26 +1,64 @@ -type from, to. +(*************************- Random Permutation -*************************) + +require import Option Real FSet NewFMap Distr. +require import Dexcepted. + +type t. +op dt : t distr. module type RP = { - proc init() : unit - proc f (x : from): to - proc fi(x : to ): from + proc init() : unit + proc f(x : t) : t + proc fi(x : t) : t }. -module type RP_ = { - proc f (x : from): to - proc fi(x : to ): from +module type DRP = { + proc f(x : t) : t + proc fi(x : t) : t }. -module type Distinguisher(G : RP_) = { - proc distinguish(): bool -}. +module P : RP, DRP = { + var m : (t, t) fmap + var mi : (t, t) fmap + + proc init() = { m = map0; mi = map0; } + + proc f(x) = { + var y; -module IND(G:RP, D:Distinguisher) = { - proc main(): bool = { - var b; + if (! mem (dom m) x) { + y <$ dt \ (mem (rng m)); + m.[x] <- y; + mi.[y] <- x; + } + return oget m.[x]; + } - G.init(); - b <@ D(G).distinguish(); - return b; - } + proc fi(x) = { + var y; + + if (! mem (dom mi) x) { + y <$ dt \ (mem (rng mi)); + mi.[x] <- y; + m.[y] <- x; + } + return oget mi.[x]; + } }. + +lemma P_init_ll: islossless P.init. +proof. by proc; auto. qed. + +lemma P_f_ll: is_lossless dt => support dt = predT => islossless P.f. +proof. +move=> d_ll d_fu; proc; if=> //=; auto=> &m /= x_notin_m. +have h:= endo_dom_rng P.m{m} _; first by exists x{m}. +apply/dexcepted_ll=> //; smt. (* needs help *) +qed. + +lemma P_fi_ll: is_lossless dt => support dt = predT => islossless P.fi. +proof. +move=> d_ll d_fu; proc; if=> //=; auto=> &m /= x_notin_m. +have h:= endo_dom_rng P.mi{m} _; first by exists x{m}. +apply/dexcepted_ll=> //; smt. (* needs help *) +qed. From f45ed80e26f986248368d41106cb4874b337513a Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Thu, 4 Feb 2016 20:15:50 -0500 Subject: [PATCH 165/525] Removing unrestricted smt. Maybe the following lemma would be useful addition to EC Library, as it works well with dexcepted_ll? lemma mu_except ['a] (d : 'a distr, y : 'a, P : 'a -> bool) : is_lossless d => support d = predT => ! P y => mu d P < 1%r. (Francois just used this logic in IdealPRP.ec; as he says, maybe we should be using that instead of RP.ec.) --- proof/RP.eca | 27 ++++++++++++++++++++++----- 1 file changed, 22 insertions(+), 5 deletions(-) diff --git a/proof/RP.eca b/proof/RP.eca index 8f28a87..6c0bf1d 100644 --- a/proof/RP.eca +++ b/proof/RP.eca @@ -1,7 +1,8 @@ (*************************- Random Permutation -*************************) require import Option Real FSet NewFMap Distr. -require import Dexcepted. +require import Dexcepted StdOrder. import RealOrder. +require import Ring StdRing. import RField. type t. op dt : t distr. @@ -49,16 +50,32 @@ module P : RP, DRP = { lemma P_init_ll: islossless P.init. proof. by proc; auto. qed. +(* maybe a useful standard lemma? *) + +lemma mu_except ['a] (d : 'a distr, y : 'a, P : 'a -> bool) : + is_lossless d => support d = predT => ! P y => mu d P < 1%r. +proof. +move=> d_ll supp_d_all notP_y. +have splitP : mu d P + mu d (predC P) = 1%r + by rewrite -d_ll (mu_split d predT P) mu_not mu_and. +have -> : mu d P = 1%r - mu d (predC P) by rewrite -splitP #ring. +rewrite ltr_subl_addl addrC -(ltr_add2l (-1%r)) addrA /=. +rewrite (ltr_le_trans (mu d (pred1 y))) 1:witness_support. +exists y; split=> //. +by rewrite -/(support d y) supp_d_all. +by rewrite mu_sub=> z @/pred1. +qed. + lemma P_f_ll: is_lossless dt => support dt = predT => islossless P.f. proof. move=> d_ll d_fu; proc; if=> //=; auto=> &m /= x_notin_m. -have h:= endo_dom_rng P.m{m} _; first by exists x{m}. -apply/dexcepted_ll=> //; smt. (* needs help *) +have [y not_mem_y_rng_m] := endo_dom_rng P.m{m} _; first by exists x{m}. +by apply /dexcepted_ll /(mu_except dt y (mem (rng P.m{m}))). qed. lemma P_fi_ll: is_lossless dt => support dt = predT => islossless P.fi. proof. move=> d_ll d_fu; proc; if=> //=; auto=> &m /= x_notin_m. -have h:= endo_dom_rng P.mi{m} _; first by exists x{m}. -apply/dexcepted_ll=> //; smt. (* needs help *) +have [y not_mem_y_rng_mi] := endo_dom_rng P.mi{m} _; first by exists x{m}. +by apply /dexcepted_ll /(mu_except dt y (mem (rng P.mi{m}))). qed. From 236b4504544ad4b2e81608af07776547fb7b3eaa Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Thu, 4 Feb 2016 22:26:58 -0500 Subject: [PATCH 166/525] Shortening of proof. --- proof/RP.eca | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/proof/RP.eca b/proof/RP.eca index 6c0bf1d..0edf05e 100644 --- a/proof/RP.eca +++ b/proof/RP.eca @@ -56,13 +56,11 @@ lemma mu_except ['a] (d : 'a distr, y : 'a, P : 'a -> bool) : is_lossless d => support d = predT => ! P y => mu d P < 1%r. proof. move=> d_ll supp_d_all notP_y. -have splitP : mu d P + mu d (predC P) = 1%r - by rewrite -d_ll (mu_split d predT P) mu_not mu_and. -have -> : mu d P = 1%r - mu d (predC P) by rewrite -splitP #ring. +have -> : mu d P = 1%r - mu d (predC P) + by rewrite -d_ll (mu_split d predT P) mu_not mu_and #ring. rewrite ltr_subl_addl addrC -(ltr_add2l (-1%r)) addrA /=. rewrite (ltr_le_trans (mu d (pred1 y))) 1:witness_support. -exists y; split=> //. -by rewrite -/(support d y) supp_d_all. +exists y; split=> //; by rewrite -/(support d y) supp_d_all. by rewrite mu_sub=> z @/pred1. qed. From eeaedf66ae2c8b4207df327dba74bfbca9002295 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Fri, 5 Feb 2016 00:31:27 -0500 Subject: [PATCH 167/525] Simplified statement of lemma mu_except ['a] (d : 'a distr, y : 'a, P : 'a -> bool) : in_supp y d => ! P y => mu d P < mu d predT. And simplified use of it. --- proof/RP.eca | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/proof/RP.eca b/proof/RP.eca index 0edf05e..a943a7e 100644 --- a/proof/RP.eca +++ b/proof/RP.eca @@ -3,6 +3,7 @@ require import Option Real FSet NewFMap Distr. require import Dexcepted StdOrder. import RealOrder. require import Ring StdRing. import RField. +require Monoid. import AddMonoid. type t. op dt : t distr. @@ -53,27 +54,26 @@ proof. by proc; auto. qed. (* maybe a useful standard lemma? *) lemma mu_except ['a] (d : 'a distr, y : 'a, P : 'a -> bool) : - is_lossless d => support d = predT => ! P y => mu d P < 1%r. + in_supp y d => ! P y => mu d P < mu d predT. proof. -move=> d_ll supp_d_all notP_y. -have -> : mu d P = 1%r - mu d (predC P) - by rewrite -d_ll (mu_split d predT P) mu_not mu_and #ring. -rewrite ltr_subl_addl addrC -(ltr_add2l (-1%r)) addrA /=. -rewrite (ltr_le_trans (mu d (pred1 y))) 1:witness_support. -exists y; split=> //; by rewrite -/(support d y) supp_d_all. -by rewrite mu_sub=> z @/pred1. +move=> in_supp_yd notP_y. +have -> : mu d P = mu d predT - mu d (predC P) + by rewrite (mu_split d predT P) mu_not mu_and #ring. +rewrite ltr_subl_addl (ltr_le_trans (mu d (pred1 y) + mu d predT)). +by rewrite -(add0r (mu _ _)) 1:ltr_le_add. +by rewrite ler_add mu_sub /pred1; first move=> ?. qed. lemma P_f_ll: is_lossless dt => support dt = predT => islossless P.f. proof. move=> d_ll d_fu; proc; if=> //=; auto=> &m /= x_notin_m. have [y not_mem_y_rng_m] := endo_dom_rng P.m{m} _; first by exists x{m}. -by apply /dexcepted_ll /(mu_except dt y (mem (rng P.m{m}))). +by rewrite dexcepted_ll // -d_ll (mu_except dt y) -/(support _ _) 1:d_fu. qed. lemma P_fi_ll: is_lossless dt => support dt = predT => islossless P.fi. proof. move=> d_ll d_fu; proc; if=> //=; auto=> &m /= x_notin_m. have [y not_mem_y_rng_mi] := endo_dom_rng P.mi{m} _; first by exists x{m}. -by apply /dexcepted_ll /(mu_except dt y (mem (rng P.mi{m}))). +by rewrite dexcepted_ll // -d_ll (mu_except dt y) -/(support _ _) 1:d_fu. qed. From 6213660c409ad7b681a655c0b72e687b8058308d Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Fri, 19 Feb 2016 16:12:45 -0500 Subject: [PATCH 168/525] Updating top-level scripts to Benjamin's new parameterized module syntax. I haven't updated the files in the "core" subdirectory, several of which are now failing to parse. --- proof/BlockSponge.ec | 2 +- proof/Sponge.ec | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/proof/BlockSponge.ec b/proof/BlockSponge.ec index 2a0b693..08219e5 100644 --- a/proof/BlockSponge.ec +++ b/proof/BlockSponge.ec @@ -26,7 +26,7 @@ clone import IRO as BIRO with (*------------------------- Sponge Construction ------------------------*) -module Sponge (P : DPRIMITIVE) : FUNCTIONALITY, CONSTRUCTION(P) = { +module (Sponge : CONSTRUCTION) (P : DPRIMITIVE) : FUNCTIONALITY = { proc init() = {} proc f(xs : block list, n : int) : block list = { diff --git a/proof/Sponge.ec b/proof/Sponge.ec index de71e97..4610d80 100644 --- a/proof/Sponge.ec +++ b/proof/Sponge.ec @@ -26,7 +26,7 @@ clone import IRO as BIRO with (*------------------------- Sponge Construction ------------------------*) -module Sponge (P : DPRIMITIVE) : FUNCTIONALITY, CONSTRUCTION(P) = { +module (Sponge : CONSTRUCTION) (P : DPRIMITIVE) : FUNCTIONALITY = { proc init() : unit = {} proc f(bs : bool list, n : int) : bool list = { @@ -798,7 +798,7 @@ by conseq IRO_RaiseHybridIRO_HybridIROLazy_f. auto. qed. -local module HybridIRODist(HI : HYBRID_IRO) : HYBRID_IRO_DIST (HI) = { +local module (HybridIRODist : HYBRID_IRO_DIST) (HI : HYBRID_IRO) = { proc distinguish() : bool = { var b : bool; BlockSim(HI).init(); From 1b358bcd07a278eb52dcbc5dcf43e83f2474787d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Wed, 24 Feb 2016 17:44:52 +0100 Subject: [PATCH 169/525] Module definitions to type-check. New and improved functor system really helped with debugging. --- proof/core/ConcreteF.eca | 2 +- proof/core/IndifPadding.ec | 9 +++------ 2 files changed, 4 insertions(+), 7 deletions(-) diff --git a/proof/core/ConcreteF.eca b/proof/core/ConcreteF.eca index b357211..7f8bc18 100644 --- a/proof/core/ConcreteF.eca +++ b/proof/core/ConcreteF.eca @@ -74,7 +74,7 @@ section. lemma size_behead (l : 'a list) : l <> [] => size (behead l) = size l - 1. proof. by case l=> // ?? /=; ring. qed. - local module D'(P' : PRPt.Oracles): PRPt.Distinguisher(P') = { + local module (D': PRPt.Distinguisher) (P' : PRPt.Oracles) = { proc distinguish = DRestr(D,SqueezelessSponge(P'),P').distinguish }. diff --git a/proof/core/IndifPadding.ec b/proof/core/IndifPadding.ec index cf80091..192ca69 100644 --- a/proof/core/IndifPadding.ec +++ b/proof/core/IndifPadding.ec @@ -21,7 +21,7 @@ clone import LazyRO as RO2 type to <- Ind1.f_out, op d <- RO1.d. -module ConstrPad (FC:Ind1.CONSTRUCTION, P:Ind1.PRIMITIVE) = { +module ConstrPad (FC:Ind1.CONSTRUCTION, P:Ind1.DPRIMITIVE) = { module C = FC(P) proc init = C.init @@ -33,10 +33,8 @@ module ConstrPad (FC:Ind1.CONSTRUCTION, P:Ind1.PRIMITIVE) = { } }. -module DistPad(FD: Ind2.DISTINGUISHER, F:Ind1.FUNCTIONALITY, P:Ind1.PRIMITIVE) = { +module DistPad(FD: Ind2.DISTINGUISHER, F:Ind1.DFUNCTIONALITY, P:Ind1.DPRIMITIVE) = { module Fpad = { - proc init = F.init - proc f(x:Ind2.f_in) : f_out = { var r; r = F.f(pad x); @@ -47,9 +45,8 @@ module DistPad(FD: Ind2.DISTINGUISHER, F:Ind1.FUNCTIONALITY, P:Ind1.PRIMITIVE) = proc distinguish = FD(Fpad,P).distinguish }. -module SimPadinv(S:Ind1.SIMULATOR, F2:Ind2.FUNCTIONALITY) = { +module SimPadinv(S:Ind1.SIMULATOR, F2:Ind2.DFUNCTIONALITY) = { module F1 = { - proc init = F2.init proc f(x:Ind1.f_in):Ind1.f_out = { var r; r = F2.f(padinv x); From ea1413d27038ea74b944b3f038371b03ca36e4bd Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Thu, 25 Feb 2016 16:52:53 +0100 Subject: [PATCH 170/525] fix proof due to change in few --- proof/core/Gext.eca | 44 +++++++++++++++++++------------------------- 1 file changed, 19 insertions(+), 25 deletions(-) diff --git a/proof/core/Gext.eca b/proof/core/Gext.eca index ec98425..24c5bab 100644 --- a/proof/core/Gext.eca +++ b/proof/core/Gext.eca @@ -618,34 +618,28 @@ section EXT. + rewrite /felsum Bigreal.sumr_const count_predT size_range. apply ler_wpmul2r;1:by apply eps_ge0. by rewrite le_fromint;smt ml=0 w=max_ge0. - + proc. - case ((size G1.m <= max_size /\ size G1.mi <= max_size /\ ReSample.count < max_size)); - [rcondt 2 | rcondf 2];1,3:by auto. - + wp;rnd (mem (image snd (dom G1.m `|` dom G1.mi)));skip=> &hr[#]?->/=???. - rewrite (Mu_mem.mu_mem (image snd (dom G1.m{hr}`|`dom G1.mi{hr})) cdistr (1%r/(2^c)%r))//. - + move=>x _;apply DWord.muxP. - apply ler_wpmul2r;1:by apply divr_ge0=>//;apply /c_ge0r. - rewrite imageU fcardU le_fromint. - move:(fcard_image_leq snd (dom G1.m{hr}))(fcard_image_leq snd (dom G1.mi{hr})). - rewrite -!sizeE;smt w=fcard_ge0. - by hoare=>[??|];[apply eps_ge0|auto]. - + by move=>c1;proc;auto=> &hr [^H 2->]/#. - by move=> b1 c1;proc;auto=> &hr [^H 2->]. - + proc. - case ((size G1.m < max_size /\ size G1.mi < max_size /\ ReSample.count < max_size)); - [rcondt 2 | rcondf 2]; 1,3:by auto. - + wp;rnd (mem (image snd (dom G1.m `|` dom G1.mi ) `|` fset1 x));skip=> &hr[#]?->/=???. - rewrite (Mu_mem.mu_mem + + proc;rcondt 2;1:by auto. + wp;rnd (mem (image snd (dom G1.m `|` dom G1.mi ) `|` fset1 x));skip=> /> &hr ?? -> /= ??. + rewrite (Mu_mem.mu_mem (image snd (dom G1.m{hr} `|` dom G1.mi{hr}) `|` fset1 x{hr}) cdistr (1%r/(2^c)%r))//. - + move=>x _;apply DWord.muxP. - apply ler_wpmul2r;1:by apply divr_ge0=>//;apply /c_ge0r. - rewrite imageU !fcardU le_fromint fcard1. - move:(fcard_image_leq snd (dom G1.m{hr}))(fcard_image_leq snd (dom G1.mi{hr})). - rewrite -!sizeE;smt w=fcard_ge0. - by hoare=>[??|];[apply eps_ge0|auto]. + + by move=>x _;apply DWord.muxP. + apply ler_wpmul2r;1:by apply divr_ge0=>//;apply /c_ge0r. + rewrite imageU !fcardU le_fromint fcard1. + move:(fcard_image_leq snd (dom G1.m{hr}))(fcard_image_leq snd (dom G1.mi{hr})). + by rewrite -!sizeE;smt w=fcard_ge0. + + by move=>c1;proc;auto=> &hr [^H 2->]/#. + + by move=> b1 c1;proc;auto=> /#. + + proc;rcondt 2;1:by auto. + wp;rnd (mem (image snd (dom G1.m `|` dom G1.mi)));skip=> /> &hr ??-> /= ??. + rewrite (Mu_mem.mu_mem (image snd (dom G1.m{hr}`|`dom G1.mi{hr})) cdistr (1%r/(2^c)%r))//. + + by move=>x _;apply DWord.muxP. + apply ler_wpmul2r;1:by apply divr_ge0=>//;apply /c_ge0r. + rewrite imageU fcardU le_fromint. + move:(fcard_image_leq snd (dom G1.m{hr}))(fcard_image_leq snd (dom G1.mi{hr})). + by rewrite -!sizeE;smt w=fcard_ge0. + by move=>c1;proc;auto=> &hr [^H 2->]/#. - by move=> b1 c1;proc;auto=> &hr [^H 2->]. + move=> b1 c1;proc;auto=> /#. qed. axiom D_ll: From 480e966afdaf40ea342519d6da996def08f68fdb Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Fri, 11 Mar 2016 10:13:07 -0500 Subject: [PATCH 171/525] Using new [smt(...)] shorthand :-) --- proof/Common.ec | 18 ++++++++-------- proof/IRO.eca | 2 +- proof/Sponge.ec | 56 ++++++++++++++++++++++++------------------------- 3 files changed, 38 insertions(+), 38 deletions(-) diff --git a/proof/Common.ec b/proof/Common.ec index c4ff7ee..a5e452a 100644 --- a/proof/Common.ec +++ b/proof/Common.ec @@ -106,7 +106,7 @@ clone export RP as Perm with lemma needed_blocks0 : (0 + r - 1) %/ r = 0. proof. -rewrite -divz_eq0 1:gt0_r; smt ml=0 w=(gt0_r). +rewrite -divz_eq0 1:gt0_r; smt(gt0_r). qed. lemma needed_blocks_non_pos (n : int) : @@ -115,7 +115,7 @@ proof. move=> le0_n. rewrite (lez_trans ((r - 1) %/ r)) 1:leq_div2r 1:/# 1:ge0_r. have -> // : (r - 1) %/ r = 0 - by rewrite -divz_eq0 1:gt0_r; smt ml=0 w=(gt0_r). + by rewrite -divz_eq0 1:gt0_r; smt(gt0_r). qed. lemma needed_blocks_suff (n : int) : @@ -145,7 +145,7 @@ lemma needed_blocks_prod_r (n : int) : (n * r + r - 1) %/ r = n. proof. rewrite -addzA divzMDl 1:gtr_eqF 1:gt0_r // divz_small //. -smt ml=0 w=(gt0_r). +smt(gt0_r). qed. lemma needed_blocks_eq_div_r (n : int) : @@ -192,7 +192,7 @@ have [m [-> [ge0_m lt_mr]]] : rewrite -{1}(@mul1z r) divzMDl 1:gtr_eqF 1:gt0_r // opprD addrA /=. rewrite divz_small; [by rewrite ger0_norm 1:ge0_r | done]. -have not_eq_dvd : n %/ r <> (n + r - 1) %/ r by smt ml=0. +have not_eq_dvd : n %/ r <> (n + r - 1) %/ r by smt(). by rewrite needed_blocks_eq_div_r. qed. @@ -637,7 +637,7 @@ rewrite -(@cat_take_drop (size s %/ r * r) s) -!catA -/tke -/drp case: (n = r - 1)=> [n_eq_r_min1 | n_neq_r_min1]. have sz_drp_plus1_dvd_r : r %| (size drp + 1). rewrite dvdzE -(@addz0 (size drp + 1)) -{1}(@modzz r). - have {1}-> : r = n + 1 by smt ml=0. + have {1}-> : r = n + 1 by smt(). rewrite modzDmr. have -> : size drp + 1 + (n + 1) = size drp + n + 2 by ring. by rewrite -dvdzE. @@ -655,11 +655,11 @@ rewrite xs_eq (@catA drp [true]) bits2blocks_cat 1:size_cat // 1:size_cat 1:size_nseq /= 1:max_ler 1:ge0_n /#. rewrite tolistK 1:size_cat //= cats1 last_rcons. rewrite n_eq_r_min1 tolistK 1:size_cat //= size_nseq max_ler /#. -have lt_n_r_min1 : n < r - 1 by smt ml=0. +have lt_n_r_min1 : n < r - 1 by smt(). move: xs_eq. have sz_drp_plus_n_plus_2_eq_r : size drp + n + 2 = r. rewrite (@dvdz_close (size drp + n + 2)) // sz_drp. - have n_plus2_rng : 2 <= n + 2 <= r by smt ml=0. + have n_plus2_rng : 2 <= n + 2 <= r by smt(). rewrite -addrA; split=> [| _]. rewrite ltr_paddl 1:modz_ge0 1:gtr_eqF 1:gt0_r // /#. have ->: 2 * r = r + r by ring. @@ -680,7 +680,7 @@ by rewrite tolistK 1:!size_cat /= 1:size_nseq 1:max_ler 1:ge0_n 1:-sz_drp_plus_n_plus_2_eq_r 1:#ring -!catA cat1s. have sz_w2b_x_eq_r : size(w2bits x) = r by apply size_tolist. rewrite w2b_x_eq !size_cat /= size_nseq max_ler // in sz_w2b_x_eq_r. -have lt_nr : n < r by smt ml=0 w=(size_ge0). +have lt_nr : n < r by smt(size_ge0). apply (@ValidBlock xs (blocks2bits ys ++ s) n)=> //. by rewrite xs_eq blocks2bits_cat blocks2bits_sing w2b_x_eq -!catA. move: xs_eq. have -> : [y; z] = [y] ++ [z] by trivial. move=> xs_eq. @@ -694,7 +694,7 @@ have w2bits_y_eq : w2bits y = take (r - 1) (w2bits y) ++ [true]. by rewrite -drop_w2b_y_last size_tolist. apply (@ValidBlock xs (blocks2bits ys ++ (take (r - 1) (w2bits y))) (r - 1)). -smt ml=0 w=(ge2_r). +smt(ge2_r). rewrite xs_eq 2!blocks2bits_cat 2!blocks2bits_sing -!catA; congr. by rewrite {1}w2bits_y_eq -catA w2b_z_eq. qed. diff --git a/proof/IRO.eca b/proof/IRO.eca index 1519b1d..e957130 100644 --- a/proof/IRO.eca +++ b/proof/IRO.eca @@ -30,7 +30,7 @@ pred prefix_closed' (m : (from * int,to) fmap) = mem (dom m) (x,i). lemma prefix_closed_equiv m: prefix_closed m <=> prefix_closed' m. -proof. smt ml=0. qed. +proof. smt(). qed. (* official version: *) diff --git a/proof/Sponge.ec b/proof/Sponge.ec index 4610d80..d5a929a 100644 --- a/proof/Sponge.ec +++ b/proof/Sponge.ec @@ -273,10 +273,10 @@ proof. proc; inline ERO.LRO.sample; sp=> /=. if=> //. while{2} (true) (m{2} - i{2}). -progress; auto; progress; smt ml=0. +progress; auto; progress; smt(). while (={xs, n, i, bs} /\ HybridIROLazy.mp{1} = ERO.RO.m{2}). wp; call HybridIROLazy_fill_in_LRO_get; auto. -auto; progress; smt ml=0. +auto; progress; smt(). qed. local lemma HybridIROLazy_HIRO_LRO_f : @@ -421,7 +421,7 @@ move=> LI; split=> [mem_upd_mp1 | mem_upd_mp2]. rewrite domP in_fsetU1; rewrite domP in_fsetU1 in mem_upd_mp1. case: ((cs, m) = (bs, n))=> [cs_m_eq_bs_n | cs_m_neq_bs_n]. right; by elim cs_m_eq_bs_n=> ->->. -left; smt ml=0. +left; smt(). rewrite domP in_fsetU1; rewrite domP in_fsetU1 in mem_upd_mp2. case: ((cs, m) = (bs, n))=> [// | cs_m_neq_bs_n]. elim mem_upd_mp2=> [/# | [p2b_cs_p2b_bs eq_mn]]. @@ -453,14 +453,14 @@ lemma lazy_invar_upd_lu_eq proof. move=> LI mem_upd_mp1. case: ((cs, m) = (bs, n))=> [[->->] | cs_m_neq_bs_n]. -smt ml=0 w=(getP_eq). +smt(getP_eq). rewrite domP in_fsetU1 in mem_upd_mp1. elim mem_upd_mp1=> [mem_mp1 | [->->]]. case: ((pad2blocks bs, n) = (pad2blocks cs, m))=> [[p2b_bs_p2b_cs eq_mn] | p2b_bs_n_neq_p2b_cs_m]. -smt ml=0 w=(pad2blocks_inj). -smt ml=0 w=(getP). -smt ml=0 w=(getP). +smt(pad2blocks_inj). +smt(getP). +smt(getP). qed. lemma LowerFun_IRO_HybridIROLazy_f : @@ -489,7 +489,7 @@ while pad2blocks x{1} = xs0{2}). sp; auto. if. -progress; smt ml=0. +progress; smt(). rnd; auto; progress; [by rewrite !getP_eq | by rewrite -(@lazy_invar_upd_mem_dom_iff IRO.mp{1}) | @@ -497,7 +497,7 @@ rnd; auto; progress; by rewrite (@lazy_invar_upd2_vb IRO.mp{1} HybridIROLazy.mp{2} x{1} xs2 i{2} n2 mpL) | by rewrite (@lazy_invar_upd_lu_eq IRO.mp{1} HybridIROLazy.mp{2})]. -auto; progress; smt ml=0. +auto; progress; smt(). auto. rcondf{1} 3; first auto. rcondf{2} 4; first auto. auto; progress; by rewrite bits2blocks_nil. @@ -521,7 +521,7 @@ while LazyInvar IRO.mp{1} HybridIROLazy.mp{2}). wp; sp. if. -progress; smt ml=0. +progress; smt(). rnd; auto; progress; [by rewrite !getP_eq | by rewrite -(@lazy_invar_upd_mem_dom_iff IRO.mp{1}) | @@ -529,7 +529,7 @@ rnd; auto; progress; by rewrite (@lazy_invar_upd2_vb IRO.mp{1} HybridIROLazy.mp{2} x{1} xs1 i{2} n1 mpL) | by rewrite (@lazy_invar_upd_lu_eq IRO.mp{1} HybridIROLazy.mp{2})]. -auto; progress; smt ml=0. +auto; progress; smt(). auto. qed. @@ -592,13 +592,13 @@ seq 3 2 : auto; progress. if=> //. case: (n1 < 0). -rcondf{1} 1; first auto; progress; smt ml=0. +rcondf{1} 1; first auto; progress; smt(). rcondf{2} 1; first auto; progress; by rewrite -lezNgt needed_blocks_non_pos ltzW. rcondf{1} 1; first auto; progress; by rewrite -lezNgt pmulr_lle0 1:gt0_r needed_blocks_non_pos ltzW. auto; progress; - [by rewrite blocks2bits_nil | by smt ml=0 w=(needed_blocks0)]. + [by rewrite blocks2bits_nil | by smt(needed_blocks0)]. (* 0 <= n1 *) conseq (_ : @@ -609,9 +609,9 @@ conseq bs{1} = take n1 (blocks2bits bs{2}) /\ size bs{2} = (n1 + r - 1) %/ r /\ EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). -progress; [smt ml=0 | apply/needed_blocks_suff]. +progress; [smt() | apply/needed_blocks_suff]. move=> |> &1 &2 ? ? ? mp1 mp2 bs ? ? ?; - smt ml=0 w=(size_eq0 needed_blocks0 take0). + smt(size_eq0 needed_blocks0 take0). splitwhile{1} 1 : i < (n1 %/ r) * r. splitwhile{2} 1 : i < n1 %/ r. seq 1 1 : @@ -630,9 +630,9 @@ conseq _). progress; by apply/needed_blocks_rel_div_r. case: (i{2} = n{2}). -rcondf{2} 1; first auto; progress; smt ml=0. -rcondf{1} 1; first auto; progress; smt ml=0. -rcondf{1} 1; first auto; progress; smt ml=0. +rcondf{2} 1; first auto; progress; smt(). +rcondf{1} 1; first auto; progress; smt(). +rcondf{1} 1; first auto; progress; smt(). auto=> |> &1 &2 ? ? sz_eq ? ? need_blks_eq. split. have -> : n{1} = size (blocks2bits bs{2}) @@ -640,9 +640,9 @@ have -> : n{1} = size (blocks2bits bs{2}) by rewrite take_size. by rewrite sz_eq need_blks_eq. (* i{2} <> n{2}, so i{2} + 1 = n{2} *) -rcondt{2} 1; first auto; progress; smt ml=0. +rcondt{2} 1; first auto; progress; smt(). rcondf{2} 4; first auto; call (_ : true). -if=> //. auto; progress; smt ml=0. +if=> //. auto; progress; smt(). wp; exists* i{1}; elim*=> i1; exists* bs{2}; elim*=> bs2. conseq (_ : @@ -652,15 +652,15 @@ conseq EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> bs{1} = blocks2bits bs2 ++ take (n1 - i1) (w2bits b{2}) /\ EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). -progress; smt ml=0. +progress; smt(). move=> |> &1 &2 ? ? sz_eq ? ? ? mp1 mp2 b ?. split. rewrite -cats1 blocks2bits_cat blocks2bits_sing take_cat. have -> /= : !(n{1} < size(blocks2bits bs{2})). rewrite size_blocks2bits sz_eq. - by smt ml=0 w=(needed_blocks_correct). -by rewrite size_blocks2bits sz_eq; congr; congr; smt ml=0. -by rewrite size_rcons; smt ml=0. + by smt(needed_blocks_correct). +by rewrite size_blocks2bits sz_eq; congr; congr; smt(). +by rewrite size_rcons; smt(). admit. qed. @@ -692,8 +692,8 @@ move=> |> &1 &2 ? n1_eq ? res1 res2 ? ? ? vb_imp not_vb_imp. case (valid_block xs{1})=> [vb_xs1 | not_vb_xs1]. have [le0_n1_imp gt0_n1_imp] := vb_imp vb_xs1. case: (n{1} <= 0)=> [le0_n1 | not_le0_n1]. -smt ml=0. -have gt0_n1 : 0 < n{1} by smt ml=0. +smt(). +have gt0_n1 : 0 < n{1} by smt(). have [-> sz_res2] := gt0_n1_imp gt0_n1. have -> : n{1} = size(blocks2bits res2) by rewrite size_blocks2bits sz_res2 n1_eq @@ -765,8 +765,8 @@ auto=> |> &1 &2 ? res1 res2 mp1 mp2 ? vb_imp not_vb_imp. case: (valid_block (pad2blocks bs{2}))=> [vb | not_vb]. have [le0_n2_imp gt0_n2_imp] := vb_imp vb. case: (n{2} <= 0)=> [le0_n2 | not_le0_n2]. -smt ml=0. -have gt0_n2 : 0 < n{2} by smt ml=0. +smt(). +have gt0_n2 : 0 < n{2} by smt(). by have [-> _] := gt0_n2_imp gt0_n2. have [-> ->] := not_vb_imp not_vb; by rewrite blocks2bits_nil. qed. From 3922fc1456cc5f8387a173114712282586f2d82a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Mon, 27 Jun 2016 17:53:59 +0100 Subject: [PATCH 172/525] Updating proof scripts to reflect library changes. --- proof/Common.ec | 81 ++++++++++++++++++++-------------------- proof/RndO.ec | 36 +++++++++--------- proof/Sponge.ec | 6 +-- proof/core/ConcreteF.eca | 2 +- proof/core/Gcol.eca | 2 +- proof/core/Gconcl.ec | 4 +- proof/core/Gext.eca | 16 ++++---- proof/core/SLCommon.ec | 2 +- 8 files changed, 74 insertions(+), 75 deletions(-) diff --git a/proof/Common.ec b/proof/Common.ec index a5e452a..f19f6fb 100644 --- a/proof/Common.ec +++ b/proof/Common.ec @@ -28,7 +28,8 @@ clone BitWord as Capacity with op n <- c proof gt0_n by apply/gt0_c - rename "dword" as "cdistr" + rename "word" as "cap" + "dword" as "cdistr" "zerow" as "c0". clone export BitWord as Block with @@ -36,7 +37,8 @@ clone export BitWord as Block with op n <- r proof gt0_n by apply/gt0_r - rename "dword" as "bdistr" + rename "word" as "block" + "dword" as "bdistr" "zerow" as "b0". (* ------------------------- Auxiliary Lemmas ------------------------- *) @@ -67,19 +69,16 @@ by rewrite /bits2blocks /chunk sz_xs_eq_r divzz ltr0_neq0 1:gt0_r b2i1 mkseq1 /= drop0 -sz_xs_eq_r take_size. qed. -lemma b0 : b0 = bits2w(nseq r false). +lemma b0 : b0 = mkblock (nseq r false). proof. -rewrite wordP=> i ge0_i_ltr; rewrite offunifE ge0_i_ltr /= getE ge0_i_ltr /=. -rewrite ofwordK 1:Array.size_mkarray 1:size_nseq 1:/#. -by rewrite Array.getE Array.ofarrayK nth_nseq. +rewrite blockP=> i ge0_i_ltr; rewrite offunifE ge0_i_ltr /= getE ge0_i_ltr /=. +rewrite ofblockK 1:size_nseq 1:/#. +by rewrite nth_nseq. qed. lemma bits2w_inj_eq (cs ds : bool list) : - size cs = r => size ds = r => bits2w cs = bits2w ds <=> cs = ds. -proof. -rewrite -!Array.size_mkarray=> s_cs_r s_ds_r; split=> //=. -by move=> @/bits2w /(mkword_pinj _ _ s_cs_r s_ds_r) /Array.mkarray_inj. -qed. + size cs = r => size ds = r => mkblock cs = mkblock ds <=> cs = ds. +proof. by move=> s_cs_r s_ds_r; split=> //=; exact/mkblock_pinj. qed. lemma last_drop_all_but_last (y : 'a, xs : 'a list) : xs = [] \/ drop (size xs - 1) xs = [last y xs]. @@ -234,14 +233,14 @@ proof. by rewrite last_cat last_mkpad. qed. lemma size_mkpad n : size (mkpad n) = num0 n + 2. proof. rewrite /mkpad /= size_rcons size_nseq max_ler. -by rewrite modz_ge0 gtr_eqF ?gt0_r. by ring. +by rewrite /num0 modz_ge0 gtr_eqF ?gt0_r. by ring. qed. lemma size_pad_equiv (m : int) : 0 <= m => m + num0 m + 2 = (m + 1) %/ r * r + r. proof. move=> ge0_m. -by rewrite modNz 1:/# 1:gt0_r -(@addrA _ 2) /= modzE #ring. +by rewrite /num0 modNz 1:/# 1:gt0_r -(@addrA _ 2) /= modzE #ring. qed. lemma size_padE (s : bool list) : @@ -259,16 +258,16 @@ lemma dvd_r_num0 (m : int) : r %| (m + num0 m + 2). proof. by rewrite /num0 /(%|) addrAC modzDmr subrr mod0z. qed. lemma num0_ge0 (m : int) : 0 <= num0 m. -proof. by rewrite modz_ge0 ?gtr_eqF ?gt0_r. qed. +proof. by rewrite /num0 modz_ge0 ?gtr_eqF ?gt0_r. qed. lemma num0_ltr (m : int) : num0 m < r. -proof. by rewrite ltz_pmod gt0_r. qed. +proof. by rewrite /num0 ltz_pmod gt0_r. qed. lemma index_true_behead_mkpad n : index true (behead (mkpad n)) = num0 n. proof. rewrite /mkpad -cats1 index_cat mem_nseq size_nseq. -by rewrite max_ler // modz_ge0 gtr_eqF ?gt0_r. +by rewrite max_ler // /num0 modz_ge0 gtr_eqF ?gt0_r. qed. lemma padE (s : bool list, n : int) : @@ -376,12 +375,12 @@ proof. by apply/BitChunking.flattenK/gt0_r. qed. (*--------------- Converting Between Block Lists and Bits --------------*) -op blocks2bits (xs:block list) : bool list = flatten (map w2bits xs). +op blocks2bits (xs:block list) : bool list = flatten (map ofblock xs). lemma blocks2bits_nil : blocks2bits [] = []. proof. by rewrite /blocks2bits /= flatten_nil. qed. -lemma blocks2bits_sing (x : block) : blocks2bits [x] = w2bits x. +lemma blocks2bits_sing (x : block) : blocks2bits [x] = ofblock x. proof. by rewrite /blocks2bits /flatten /= cats0. qed. lemma blocks2bits_cat (xs ys : block list) : @@ -393,19 +392,19 @@ lemma size_blocks2bits (xs : block list) : proof. elim: xs=> [| x xs ih]; first by rewrite blocks2bits_nil. rewrite -cat1s blocks2bits_cat blocks2bits_sing size_cat //. -rewrite size_cat size_tolist ih /= #ring. +rewrite size_cat size_block ih /= #ring. qed. lemma size_blocks2bits_dvd_r (xs : block list) : r %| size(blocks2bits xs). proof. by rewrite size_blocks2bits dvdz_mulr dvdzz. qed. -op bits2blocks (xs : bool list) : block list = map bits2w (chunk xs). +op bits2blocks (xs : bool list) : block list = map mkblock (chunk xs). lemma bits2blocks_nil : bits2blocks [] = []. proof. by rewrite /bits2blocks chunk_nil. qed. lemma bits2blocks_sing (xs : bool list) : - size xs = r => bits2blocks xs = [bits2w xs]. + size xs = r => bits2blocks xs = [mkblock xs]. proof. by move=> sz_xs_eq_r; rewrite /bits2blocks chunk_sing. qed. lemma bits2blocks_cat (xs ys : bool list) : r %| size xs => r %| size ys => @@ -418,9 +417,9 @@ qed. lemma blocks2bitsK : cancel blocks2bits bits2blocks. proof. move=> xs; rewrite /blocks2bits /bits2blocks flattenK. - by move=> b /mapP [x [_ ->]];rewrite size_tolist. + by move=> b /mapP [x [_ ->]];rewrite size_block. rewrite -map_comp -{2}(@map_id xs) /(\o) /=. -by apply eq_map=> @/idfun x /=; apply oflistK. +by apply eq_map=> @/idfun x /=; exact/mkblockK. qed. lemma bits2blocksK (bs : bool list) : @@ -430,9 +429,9 @@ move=> dvd_r_bs; rewrite /blocks2bits /bits2blocks -map_comp. have map_tolistK : forall (xss : bool list list), (forall (xs : bool list), mem xss xs => size xs = r) => - map (w2bits \o bits2w) xss = xss. + map (ofblock \o mkblock) xss = xss. + elim=> [// | xs yss ih eqr_sz /=]; split. - by apply tolistK; rewrite eqr_sz. + by apply ofblockK; rewrite eqr_sz. by apply/ih => zs mem_zss_zs; rewrite eqr_sz //=; right. by rewrite map_tolistK; [apply in_chunk_size | exact chunkK]. qed. @@ -575,7 +574,7 @@ rewrite drop_xs last_xs_eq_b0 b0 in xs_take_drop. have last_b2b_xs_true : last true (blocks2bits xs) = true by rewrite b2b_xs_eq cats1 last_rcons. have last_b2b_xs_false : last true (blocks2bits xs) = false - by rewrite xs_take_drop blocks2bits_cat blocks2bits_sing tolistK + by rewrite xs_take_drop blocks2bits_cat blocks2bits_sing ofblockK 1:size_nseq 1:max_ler 1:ge0_r // last_cat last_nseq 1:gt0_r. by rewrite last_b2b_xs_true in last_b2b_xs_false. @@ -585,11 +584,11 @@ inductive valid_block_struct_spec (xs : block list) = ValidBlockStruct1 (ys : block list, x : block, s : bool list, n : int) of (xs = ys ++ [x]) & (0 <= n) - & (w2bits x = s ++ [true] ++ nseq n false ++ [true]) + & (ofblock x = s ++ [true] ++ nseq n false ++ [true]) | ValidBlockStruct2 (ys : block list, y z : block) of (xs = ys ++ [y; z]) - & (last false (w2bits y)) - & (w2bits z = nseq (r - 1) false ++ [true]). + & (last false (ofblock y)) + & (ofblock z = nseq (r - 1) false ++ [true]). lemma nosmt valid_block_structP (xs : block list) : valid_block xs <=> valid_block_struct_spec xs. @@ -647,14 +646,14 @@ have sz_drp_plus1_eq_r : size drp + 1 = r. have -> : 2 * r = r + r by ring. rewrite ltr_add // 1:sz_drp 1:ltz_pmod 1:gt0_r ltzE ge2_r. apply (@ValidBlockStruct2 xs (bits2blocks tke) - (bits2w (drp ++ [true])) (bits2w (nseq n false ++ [true]))). + (mkblock (drp ++ [true])) (mkblock (nseq n false ++ [true]))). rewrite xs_eq (@catA drp [true]) bits2blocks_cat 1:size_cat // 1:size_cat 1:size_nseq 1:max_ler 1:ge0_n /= 1:/# (@bits2blocks_sing (drp ++ [true])) 1:size_cat // (@bits2blocks_sing (nseq n false ++ [true])) 1:size_cat 1:size_nseq /= 1:max_ler 1:ge0_n /#. -rewrite tolistK 1:size_cat //= cats1 last_rcons. -rewrite n_eq_r_min1 tolistK 1:size_cat //= size_nseq max_ler /#. +rewrite ofblockK 1:size_cat //= cats1 last_rcons. +rewrite n_eq_r_min1 ofblockK 1:size_cat //= size_nseq max_ler /#. have lt_n_r_min1 : n < r - 1 by smt(). move: xs_eq. have sz_drp_plus_n_plus_2_eq_r : size drp + n + 2 = r. @@ -674,25 +673,25 @@ rewrite (@bits2blocks_sing + have -> : size s %% r + (1 + (n + 1)) = size s %%r + n + 2 by ring. + by rewrite -sz_drp. apply (@ValidBlockStruct1 xs (bits2blocks tke) - (bits2w(drp ++ ([true] ++ (nseq n false ++ [true])))) + (mkblock (drp ++ ([true] ++ (nseq n false ++ [true])))) drp n)=> //. -by rewrite tolistK 1:!size_cat /= 1:size_nseq 1:max_ler 1:ge0_n +by rewrite ofblockK 1:!size_cat /= 1:size_nseq 1:max_ler 1:ge0_n 1:-sz_drp_plus_n_plus_2_eq_r 1:#ring -!catA cat1s. -have sz_w2b_x_eq_r : size(w2bits x) = r by apply size_tolist. +have sz_w2b_x_eq_r : size (ofblock x) = r by apply size_block. rewrite w2b_x_eq !size_cat /= size_nseq max_ler // in sz_w2b_x_eq_r. have lt_nr : n < r by smt(size_ge0). apply (@ValidBlock xs (blocks2bits ys ++ s) n)=> //. by rewrite xs_eq blocks2bits_cat blocks2bits_sing w2b_x_eq -!catA. move: xs_eq. have -> : [y; z] = [y] ++ [z] by trivial. move=> xs_eq. -have w2bits_y_eq : w2bits y = take (r - 1) (w2bits y) ++ [true]. - rewrite -{1}(@cat_take_drop (r - 1) (w2bits y)); congr. - elim (last_drop_all_but_last false (w2bits y))=> +have w2bits_y_eq : ofblock y = take (r - 1) (ofblock y) ++ [true]. + rewrite -{1}(@cat_take_drop (r - 1) (ofblock y)); congr. + elim (last_drop_all_but_last false (ofblock y))=> [w2b_y_nil | drop_w2b_y_last]. - have not_lst_w2b_y : ! last false (w2bits y) by rewrite w2b_y_nil. + have not_lst_w2b_y : ! last false (ofblock y) by rewrite w2b_y_nil. by rewrite w2b_y_nil. rewrite lst in drop_w2b_y_last. - by rewrite -drop_w2b_y_last size_tolist. -apply (@ValidBlock xs (blocks2bits ys ++ (take (r - 1) (w2bits y))) + by rewrite -drop_w2b_y_last size_block. +apply (@ValidBlock xs (blocks2bits ys ++ (take (r - 1) (ofblock y))) (r - 1)). smt(ge2_r). rewrite xs_eq 2!blocks2bits_cat 2!blocks2bits_sing -!catA; congr. diff --git a/proof/RndO.ec b/proof/RndO.ec index 367870b..7036303 100644 --- a/proof/RndO.ec +++ b/proof/RndO.ec @@ -330,9 +330,9 @@ proof. qed. equiv I_f_eqex x1 mx1 mx2: RRO.I.f ~ RRO.I.f : - ={x} /\ x1 <> x{1} /\ eq_except FRO.m{1} FRO.m{2} (fset1 x1) /\ + ={x} /\ x1 <> x{1} /\ eq_except FRO.m{1} FRO.m{2} (pred1 x1) /\ FRO.m{1}.[x1] = mx1 /\ FRO.m{2}.[x1] = mx2 ==> - eq_except FRO.m{1} FRO.m{2} (fset1 x1) /\ + eq_except FRO.m{1} FRO.m{2} (pred1 x1) /\ FRO.m{1}.[x1] = mx1 /\ FRO.m{2}.[x1] = mx2. proof. by proc;auto=>?&mr[#]->Hneq Heq/= Heq1 Heq2?->/=;rewrite !getP Hneq eq_except_set. @@ -365,7 +365,7 @@ proof. (={x,FRO.m} /\ mem (dom FRO.m{1}) x{1} /\ (oget FRO.m{1}.[x{1}]).`2 = Unknown ==> ={x,FRO.m}) (={x,FRO.m} /\ mem (dom FRO.m{1}) x{1} /\ (oget FRO.m{1}.[x{1}]).`2 = Unknown==> - ={x} /\ eq_except FRO.m{1} FRO.m{2} (fset1 x{1}) /\ + ={x} /\ eq_except FRO.m{1} FRO.m{2} (pred1 x{1}) /\ FRO.m{1}.[x{2}] = Some (result{2},Unknown) /\ FRO.m{2}.[x{2}] = Some (result{2},Known)). + by move=>?&mr[#]-> -> ??;exists FRO.m{mr}, x{mr}=>/#. @@ -377,7 +377,7 @@ proof. skip=> &1 &2 [[->> ->>]] [Hdom Hm];split=>//=. by apply /perm_eq_sym/perm_to_rem/dom_restr;rewrite /in_dom_with Hdom Hm. inline Iter(RRO.I).iter_1s RRO.I.f RRO.resample. - seq 5 3 : (={x} /\ eq_except FRO.m{1} FRO.m{2} (fset1 x{1}) /\ + seq 5 3 : (={x} /\ eq_except FRO.m{1} FRO.m{2} (pred1 x{1}) /\ (l =elems(dom (restr Unknown FRO.m) `\` fset1 x)){1} /\ FRO.m{1}.[x{2}] = Some (result{2}, Unknown) /\ FRO.m{2}.[x{2}] = Some (result{2}, Known)). @@ -385,7 +385,7 @@ proof. by rewrite !getP /=oget_some !restr_set/= dom_set set2_eq_except fsetDK. exists*x{1}, FRO.m{1}.[x{2}], FRO.m{2}.[x{2}];elim*=>x1 mx1 mx2. call (iter_inv RRO.I (fun z=>x1<>z) - (fun o1 o2 => eq_except o1 o2 (fset1 x1) /\ o1.[x1]= mx1 /\ o2.[x1]=mx2) + (fun o1 o2 => eq_except o1 o2 (pred1 x1) /\ o1.[x1]= mx1 /\ o2.[x1]=mx2) (I_f_eqex x1 mx1 mx2))=>/=;auto=>?&mr[#]4->^H->->^H1->^H2->/=;split. + congr;rewrite fsetP=>z;rewrite !inE !dom_restr /in_dom_with !in_dom; smt. by move=>x;rewrite -memE in_fsetD1 eq_sym. @@ -409,7 +409,7 @@ proof. (={x,y,FRO.m} /\ mem (dom FRO.m{1}) x{1} /\ (oget FRO.m{1}.[x{1}]).`2 = Unknown ==> ={x,y,FRO.m}) (={x,y,FRO.m} /\ mem (dom FRO.m{1}) x{1} /\ (oget FRO.m{1}.[x{1}]).`2 = Unknown==> - ={x,y} /\ eq_except FRO.m{1} FRO.m{2} (fset1 x{1}) /\ + ={x,y} /\ eq_except FRO.m{1} FRO.m{2} (pred1 x{1}) /\ FRO.m{2}.[x{2}] = Some (y{2},Known)). + by move=>?&mr[#]2->???;exists FRO.m{mr}, y{mr}, x{mr}=>/#. + move=>?&m&mr[#]<*>[#]2->Hex Hm2. @@ -417,18 +417,18 @@ proof. + symmetry;call (iter1_perm RRO.I iter_perm2);auto=>?&mr[#]3-> Hdom Hm;split=>//=. by apply /perm_eq_sym/perm_to_rem/dom_restr;rewrite /in_dom_with Hdom. inline{1}Iter(RRO.I).iter_1s. - seq 3 1: (={x,y} /\ eq_except FRO.m{1} FRO.m{2} (fset1 x{1}) /\ + seq 3 1: (={x,y} /\ eq_except FRO.m{1} FRO.m{2} (pred1 x{1}) /\ l{1} = (elems (dom (restr Unknown FRO.m))){2} /\ !mem l{1} x{1} /\ (FRO.m.[x]=Some(y, Known)){2}). + inline *;auto=>?&mr[#]3->/=Hmem Hget;rewrite sampleto_ll=>?_. by rewrite set2_eq_except getP_eq restr_set /= dom_rem -memE !inE negb_and. exists* x{1},y{1},(FRO.m.[x]{1});elim*=>x1 y1 mx1;pose mx2:=Some(y1,Known). call (iter_inv RRO.I (fun z=>x1<>z) - (fun o1 o2 => eq_except o1 o2 (fset1 x1) /\ o1.[x1]= mx1 /\ o2.[x1]=mx2) + (fun o1 o2 => eq_except o1 o2 (pred1 x1) /\ o1.[x1]= mx1 /\ o2.[x1]=mx2) (I_f_eqex x1 mx1 mx2))=>/=;auto=>?&mr[#]-><-2!->->>2!->Hmem->/#. exists* x{1},y{1},(FRO.m.[x]{1});elim*=>x1 y1 mx1;pose mx2:=Some(y1,Known). call (iter_inv RRO.I (fun z=>x1<>z) - (fun o1 o2 => eq_except o1 o2 (fset1 x1) /\ o1.[x1]= mx1 /\ o2.[x1]=mx2) + (fun o1 o2 => eq_except o1 o2 (pred1 x1) /\ o1.[x1]= mx1 /\ o2.[x1]=mx2) (I_f_eqex x1 mx1 mx2))=>/=;auto=>?&mr[#]-><-2!->->>->/= Hidm. rewrite restr_set getP_eq/mx2 eq_except_sym set_eq_except/=;split;[split|]. + by congr;apply fsetP=>z;rewrite !(dom_rem,inE,dom_restr) /#. @@ -452,30 +452,30 @@ proof. + symmetry;call (iter1_perm RRO.I iter_perm2);skip=>?&mr[#]2!->?/=;split=>//. by apply /perm_eq_sym/perm_to_rem/dom_restr. inline{1}Iter(RRO.I).iter_1s. - seq 3 1: (={x} /\ eq_except FRO.m{1} FRO.m{2} (fset1 x{1}) /\ + seq 3 1: (={x} /\ eq_except FRO.m{1} FRO.m{2} (pred1 x{1}) /\ l{1} = (elems (dom (restr Unknown FRO.m))){2} /\ !mem l{1} x{1} /\ (FRO.m.[x]=None){2}). + inline *;auto=>??[#]2->Hidm/=;rewrite sampleto_ll=>?_. - rewrite eq_except_rem 1:!inE 2:set_eq_except // remP -memE in_fsetD1 negb_and /=. + rewrite eq_except_rem 2:set_eq_except // remP -memE in_fsetD1 negb_and /=. by rewrite restr_rem Hidm /= dom_rem. exists* x{1},(FRO.m.[x]{1});elim*=>x1 mx1. call (iter_inv RRO.I (fun z=>x1<>z) - (fun o1 o2 => eq_except o1 o2 (fset1 x1) /\ o1.[x1]= mx1 /\ o2.[x1]=None) _). + (fun o1 o2 => eq_except o1 o2 (pred1 x1) /\ o1.[x1]= mx1 /\ o2.[x1]=None) _). + by conseq (I_f_eqex x1 mx1 None). auto=>?&mr[#]3->^Hex 2!->Hmem ^Hx->/=;split=>[/#|_ mL mR[#]/eq_exceptP Hex'?Heq]. apply fmapP=>z;rewrite remP;case (z=x{mr})=>[->/=|Hneq];1:by rewrite Heq. - by apply Hex';rewrite inE. + by apply Hex'. inline RRO.resample;wp. exists *x{1},(FRO.m.[x]{1});elim*=>x1 mx1. call (iter_inv RRO.I (fun z=>x1<>z) - (fun o1 o2 => eq_except o1 o2 (fset1 x1) /\ o1.[x1]= mx1 /\ o2.[x1]=None) _). + (fun o1 o2 => eq_except o1 o2 (pred1 x1) /\ o1.[x1]= mx1 /\ o2.[x1]=None) _). + by conseq (I_f_eqex x1 mx1 None). auto=>?&mr[#]4->Hin/=. - rewrite restr_rem Hin/= remP eq_except_rem 1:inE // 1:eq_except_refl /=;split. + rewrite restr_rem Hin/= remP eq_except_rem // 1:eq_except_refl /=;split. + by move=>z;rewrite -memE dom_restr /#. move=>_ mL mR[#] /eq_exceptP Hex'?Heq. apply fmapP=>z;rewrite remP;case (z=x{mr})=>[->/=|Hneq];1:by rewrite Heq. - by apply Hex';rewrite inE. + by apply Hex'. qed. lemma eager_in_dom: @@ -520,7 +520,7 @@ proof. by apply /perm_eq_sym/perm_to_rem;rewrite restr_set/=dom_set !inE. + by move=>?&mr[#]2->?;exists FRO.m{mr}, x{mr}. inline Iter(RRO.I).iter_1s RRO.I.f RRO.resample;wp;swap{1}-1. - seq 1 7 : (={x} /\ eq_except FRO.m{1} FRO.m{2} (fset1 x{1}) /\ + seq 1 7 : (={x} /\ eq_except FRO.m{1} FRO.m{2} (pred1 x{1}) /\ l{2} = (elems (dom (restr Unknown FRO.m))){1} /\ (FRO.m.[x]){2} = Some(c{1},Unknown) /\ (FRO.m.[x]){1} = None). + wp;rnd;auto=>?&mr[#]2->;rewrite in_dom sampleto_ll/==>Heq?_?->. @@ -528,7 +528,7 @@ proof. congr;apply fsetP=>z;rewrite in_fsetD1 dom_restr /in_dom_with !in_dom /#. exists*x{1},c{1};elim*=>x1 c1;pose mx2:=Some(c1,Unknown). call (iter_inv RRO.I (fun z=>x1<>z) - (fun o1 o2 => eq_except o1 o2 (fset1 x1) /\ o1.[x1]= None /\ o2.[x1]=mx2) _). + (fun o1 o2 => eq_except o1 o2 (pred1 x1) /\ o1.[x1]= None /\ o2.[x1]=mx2) _). + by conseq (I_f_eqex x1 None mx2). auto=>?&mr[#]2<-->^Hex 3!->^Hx1-> @/mx2/=;split=>[z|_ mL mR[#]]. + rewrite -memE dom_restr /in_dom_with in_dom /#. diff --git a/proof/Sponge.ec b/proof/Sponge.ec index d5a929a..acf6b34 100644 --- a/proof/Sponge.ec +++ b/proof/Sponge.ec @@ -42,7 +42,7 @@ module (Sponge : CONSTRUCTION) (P : DPRIMITIVE) : FUNCTIONALITY = { } (* squeezing *) while (i < (n + r - 1) %/ r) { - z <- z ++ w2bits sa; + z <- z ++ ofblock sa; (sa, sc) <@ P.f(sa, sc); i <- i + 1; } @@ -541,7 +541,7 @@ pred EagerInvar 0 <= i /\ (forall (j : int), 0 <= j < i => mem (dom mp1) (xs, j)) /\ (forall (j : int), i * r <= j < (i + 1) * r => - mp2.[(xs, j)] = Some(nth false (w2bits(oget mp1.[(xs, i)])) j))) /\ + mp2.[(xs, j)] = Some(nth false (ofblock (oget mp1.[(xs, i)])) j))) /\ (forall (xs : block list, j : int), mem (dom mp2) (xs, j) => 0 <= j /\ mem (dom mp1) (xs, j %/ r)). @@ -650,7 +650,7 @@ conseq i{1} = i{2} * r /\ n{1} <= m{1} /\ m{1} - i{1} = r /\ bs{1} = blocks2bits bs2 /\ EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> - bs{1} = blocks2bits bs2 ++ take (n1 - i1) (w2bits b{2}) /\ + bs{1} = blocks2bits bs2 ++ take (n1 - i1) (ofblock b{2}) /\ EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). progress; smt(). move=> |> &1 &2 ? ? sz_eq ? ? ? mp1 mp2 b ?. diff --git a/proof/core/ConcreteF.eca b/proof/core/ConcreteF.eca index 7f8bc18..8c5367b 100644 --- a/proof/core/ConcreteF.eca +++ b/proof/core/ConcreteF.eca @@ -61,7 +61,7 @@ section. realize uD_uf_fu. split. case=> [x y]; rewrite support_dprod /=. - by rewrite Block.DWord.supportP Capacity.DWord.supportP. + by rewrite Block.DWord.support_bdistr Capacity.DWord.support_cdistr. apply/dprod_uf. by rewrite Block.DWord.bdistr_uf. by rewrite Capacity.DWord.cdistr_uf. diff --git a/proof/core/Gcol.eca b/proof/core/Gcol.eca index 8405281..3f680bf 100644 --- a/proof/core/Gcol.eca +++ b/proof/core/Gcol.eca @@ -297,7 +297,7 @@ section PROOF. wp. rnd (mem (image fst (rng FRO.m)));skip;progress;2:smt ml=0. rewrite (Mu_mem.mu_mem (image fst (rng FRO.m{hr})) cdistr (1%r/(2^c)%r))//. - + move=>x _;apply DWord.muxP. + + move=>x _; apply DWord.cdistr1E. apply ler_wpmul2r;2:by rewrite le_fromint. by apply divr_ge0=>//;apply /c_ge0r. + move=>ci;proc;rcondt 2;auto=>/#. diff --git a/proof/core/Gconcl.ec b/proof/core/Gconcl.ec index 0476021..6027e1a 100644 --- a/proof/core/Gconcl.ec +++ b/proof/core/Gconcl.ec @@ -226,8 +226,8 @@ proof. [rcondt{1} 4;2:rcondt{2} 4| rcondf{1} 4;2:rcondf{2} 4]; 1,2,4,5:(by move=>?;conseq (_:true);auto);2:by sim. inline *;rcondt{1} 7;1:by auto=>/>. - wp;rnd;auto;rnd{1};auto;progress[-split]. - rewrite Block.DWord.supportP DWord.cdistr_ll /==> ?_?->. + wp;rnd;auto;rnd{1};auto;progress[-split]. + rewrite Block.DWord.support_bdistr DWord.cdistr_ll /==> ?_?->. by rewrite !getP /= oget_some. + proc;sp;if=>//. diff --git a/proof/core/Gext.eca b/proof/core/Gext.eca index 24c5bab..0fe42ad 100644 --- a/proof/core/Gext.eca +++ b/proof/core/Gext.eca @@ -619,23 +619,23 @@ section EXT. apply ler_wpmul2r;1:by apply eps_ge0. by rewrite le_fromint;smt ml=0 w=max_ge0. + proc;rcondt 2;1:by auto. - wp;rnd (mem (image snd (dom G1.m `|` dom G1.mi ) `|` fset1 x));skip=> /> &hr ?? -> /= ??. + wp; rnd (mem (image snd (dom G1.m `|` dom G1.mi ))); skip=> /> &hr ? ? -> /= ? ?. rewrite (Mu_mem.mu_mem - (image snd (dom G1.m{hr} `|` dom G1.mi{hr}) `|` fset1 x{hr}) + (image snd (dom G1.m{hr} `|` dom G1.mi{hr})) cdistr (1%r/(2^c)%r))//. - + by move=>x _;apply DWord.muxP. + + by move=>x _;apply DWord.cdistr1E. apply ler_wpmul2r;1:by apply divr_ge0=>//;apply /c_ge0r. - rewrite imageU !fcardU le_fromint fcard1. + rewrite imageU fcardU le_fromint. move:(fcard_image_leq snd (dom G1.m{hr}))(fcard_image_leq snd (dom G1.mi{hr})). by rewrite -!sizeE;smt w=fcard_ge0. + by move=>c1;proc;auto=> &hr [^H 2->]/#. + by move=> b1 c1;proc;auto=> /#. + proc;rcondt 2;1:by auto. - wp;rnd (mem (image snd (dom G1.m `|` dom G1.mi)));skip=> /> &hr ??-> /= ??. - rewrite (Mu_mem.mu_mem (image snd (dom G1.m{hr}`|`dom G1.mi{hr})) cdistr (1%r/(2^c)%r))//. - + by move=>x _;apply DWord.muxP. + wp;rnd (mem (image snd (dom G1.m `|` dom G1.mi) `|` fset1 x));skip=> /> &hr ??-> /= ??. + rewrite (Mu_mem.mu_mem (image snd (dom G1.m{hr}`|`dom G1.mi{hr}) `|` fset1 x{hr}) cdistr (1%r/(2^c)%r))//. + + by move=>x _;apply DWord.cdistr1E. apply ler_wpmul2r;1:by apply divr_ge0=>//;apply /c_ge0r. - rewrite imageU fcardU le_fromint. + rewrite imageU !fcardU le_fromint fcard1. move:(fcard_image_leq snd (dom G1.m{hr}))(fcard_image_leq snd (dom G1.mi{hr})). by rewrite -!sizeE;smt w=fcard_ge0. + by move=>c1;proc;auto=> &hr [^H 2->]/#. diff --git a/proof/core/SLCommon.ec b/proof/core/SLCommon.ec index 6f9fd1a..92f7e0c 100644 --- a/proof/core/SLCommon.ec +++ b/proof/core/SLCommon.ec @@ -26,7 +26,7 @@ op max_size : { int | 0 <= max_size } as max_ge0. (** Ideal Functionality **) clone export Tuple as TupleBl with type t <- block, - op Support.enum <- Block.words + op Support.enum <- Block.blocks proof Support.enum_spec by exact Block.enum_spec. op bl_enum = flatten (mkseq (fun i => wordn i) (max_size + 1)). From db9942f0149827ef0ec6e1c9a312e71500a3b684 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Wed, 29 Jun 2016 16:55:58 +0100 Subject: [PATCH 173/525] Trying to get back into the invariant -- First attempt --- proof/core/Handle.eca | 848 +++++++++++++++++++++++------------------- 1 file changed, 471 insertions(+), 377 deletions(-) diff --git a/proof/core/Handle.eca b/proof/core/Handle.eca index 5e528f0..f05c336 100644 --- a/proof/core/Handle.eca +++ b/proof/core/Handle.eca @@ -1,4 +1,5 @@ -require import Pred Fun Option Pair Int Real StdOrder Ring. +pragma -oldip. pragma +implicits. +require import Pred Fun Option Pair Int Real StdOrder Ring NewLogic. require import List FSet NewFMap Utils Common SLCommon RndO. require import DProd Dexcepted. (*...*) import Capacity IntOrder. @@ -58,7 +59,6 @@ module G1(D:DISTINGUISHER) = { } else { y1 <$ bdistr; y2 <$ cdistr; - } y <- (y1, y2); bext <- bext \/ mem (rng FRO.m) (x.`2, Unknown); @@ -77,7 +77,7 @@ module G1(D:DISTINGUISHER) = { bcol <- bcol \/ hinv FRO.m y.`2 <> None; hy2 <- chandle; chandle <- chandle + 1; - FRO.m.[hy2] <- (y.`2, Known); + FRO.m.[hy2] <- (y.`2, Known); m.[x] <- y; mh.[(x.`1, hx2)] <- (y.`1, hy2); mi.[y] <- x; @@ -104,9 +104,9 @@ module G1(D:DISTINGUISHER) = { chandle <- chandle + 1; } hx2 <- oget (hinvK FRO.m x.`2); - y1 <$ bdistr; - y2 <$ cdistr; - y <- (y1,y2); + y1 <$ bdistr; + y2 <$ cdistr; + y <- (y1,y2); if (mem (dom mhi) (x.`1,hx2) /\ in_dom_with FRO.m (oget mhi.[(x.`1,hx2)]).`2 Unknown) { (y1,hy2) <- oget mhi.[(x.`1, hx2)]; @@ -135,7 +135,7 @@ module G1(D:DISTINGUISHER) = { proc main(): bool = { var b; - F.RO.m <- map0; + F.RO.m <- map0; m <- map0; mi <- map0; mh <- map0; @@ -144,7 +144,7 @@ module G1(D:DISTINGUISHER) = { bcol <- false; (* the empty path is initially known by the adversary to lead to capacity 0^c *) - FRO.m <- map0.[0 <- (c0, Known)]; + FRO.m <- map0.[0 <- (c0, Known)]; paths <- map0.[c0 <- ([<:block>],b0)]; chandle <- 1; b <@ D(C,S).distinguish(); @@ -153,269 +153,355 @@ module G1(D:DISTINGUISHER) = { }. (* -------------------------------------------------------------------------- *) - -op eqm_handles (handles:handles) (m:smap) (mh:hsmap) = - (forall bc bc', m.[bc] = Some bc' => - exists h h' f f', - handles.[h ] = Some(bc .`2,f ) /\ - handles.[h'] = Some(bc'.`2,f') /\ - mh.[(bc.`1, h)] = Some (bc'.`1,h')) /\ - (forall bh bh', mh.[bh] = Some bh' => - exists c c' f f', - handles.[bh .`2] = Some(c ,f) /\ - handles.[bh'.`2] = Some(c',f') /\ - m.[(bh.`1, c)] = Some (bh'.`1,c')). - -op mh_spec (handles:handles) (m2:smap) (mh:hsmap) (ro:(block list, block)fmap) = - (forall bh bh', mh.[bh] = Some bh' => - exists c c' f f', - handles.[bh .`2]=Some(c,f) /\ - handles.[bh'.`2]=Some(c',f') /\ - if f' = Known then m2.[(bh.`1,c)] = Some(bh'.`1,c') /\ f = Known - else - exists p v b, - ro.[rcons p b] = Some bh'.`1 /\ - build_hpath mh p = Some(v,bh.`2) /\ - bh.`1 = v +^ b) /\ - (forall p b, mem (dom ro) (rcons p b) <=> - exists v h h', - build_hpath mh p = Some (v,h) /\ - mh.[(v +^ b,h)] = Some (oget ro.[rcons p b], h')). - -op paths_spec (handles:handles) (mh:hsmap) (paths:(capacity,block list * block)fmap) = - forall c p v, paths.[c] = Some(p,v) <=> - exists h, - build_hpath mh p = Some(v,h) /\ - handles.[h] = Some(c,Known). - -op handles_spec handles chandle = - huniq handles /\ handles.[0] = Some (c0,Known) /\ forall h, mem (dom handles) h => h < chandle. - -op INV_CF_G1 (handles:handles) chandle (m1 mi1 m2 mi2:smap) (mh2 mhi2:hsmap) (ro:(block list, block) fmap) paths = - (eqm_handles handles m1 mh2 /\ eqm_handles handles mi1 mhi2) /\ - (incl m2 m1 /\ incl mi2 mi1) /\ - (mh_spec handles m2 mh2 ro /\ paths_spec handles mh2 paths /\ handles_spec handles chandle). - -lemma eqm_of_INV (chandle : handle) - (mi1 m2 mi2 : smap) (mhi2 : hsmap) - (ro : (block list, block) fmap) - (paths : (capacity, block list * block) fmap) - handles m1 mh2: - INV_CF_G1 handles chandle m1 mi1 m2 mi2 mh2 mhi2 ro paths => - eqm_handles handles m1 mh2. -proof. by move=> @/INV_CF_G1 [#]. qed. - -lemma eqmi_of_INV (chandle : handle) - (m1 m2 mi2 : smap) (mh2 : hsmap) - (ro : (block list, block) fmap) - (paths : (capacity, block list * block) fmap) - handles mi1 mhi2: - INV_CF_G1 handles chandle m1 mi1 m2 mi2 mh2 mhi2 ro paths => - eqm_handles handles mi1 mhi2. -proof. by move=> @/INV_CF_G1 [#]. qed. - -lemma incl_of_INV (handles : handles) (chandle : handle) - (mi1 mi2 : smap) (mh2 mhi2: hsmap) - (ro : (block list, block) fmap) - (paths : (capacity, block list * block) fmap) - m1 m2: - INV_CF_G1 handles chandle m1 mi1 m2 mi2 mh2 mhi2 ro paths => - incl m2 m1. -proof. by move=> @/INV_CF_G1 [#]. qed. - -lemma incli_of_INV (handles : handles) (chandle : handle) - (m1 m2 : smap) (mh2 mhi2: hsmap) - (ro : (block list, block) fmap) - (paths : (capacity, block list * block) fmap) - mi1 mi2: - INV_CF_G1 handles chandle m1 mi1 m2 mi2 mh2 mhi2 ro paths => - incl mi2 mi1. -proof. by move=> @/INV_CF_G1 [#]. qed. - -lemma mh_of_INV (chandle : handle) - (m1 mi1 mi2 : smap) (mhi2 : hsmap) - (paths : (capacity, block list * block) fmap) - handles m2 mh2 ro: - INV_CF_G1 handles chandle m1 mi1 m2 mi2 mh2 mhi2 ro paths => - mh_spec handles m2 mh2 ro. -proof. by move=> @/INV_CF_G1 [#]. qed. - -lemma paths_of_INV (chandle : handle) - (m1 m2 mi1 mi2: smap) (mhi2: hsmap) - (ro : (block list, block) fmap) - handles mh2 paths: - INV_CF_G1 handles chandle m1 mi1 m2 mi2 mh2 mhi2 ro paths => - paths_spec handles mh2 paths. -proof. by move=> @/INV_CF_G1 [#]. qed. - -lemma handles_of_INV (m1 m2 mi1 mi2 : smap) (mh2 mhi2 : hsmap) - (ro : (block list, block) fmap) - (paths : (capacity, block list * block) fmap) - handles chandle: - INV_CF_G1 handles chandle m1 mi1 m2 mi2 mh2 mhi2 ro paths => - handles_spec handles chandle. -proof. by move=> @/INV_CF_G1 [#]. qed. - -lemma eqm_dom_mh_m handles m mh hx2 f (x:state): - eqm_handles handles m mh => - handles.[hx2] = Some (x.`2, f) => - mem (dom mh) (x.`1, hx2) => mem (dom m) x. -proof. - move=>[]H1 H2 Hhx2;rewrite !in_dom. - case: (mh.[_]) (H2 (x.`1,hx2))=> //= bh' /(_ bh') [c c' f1 f1']. - by rewrite Hhx2=> /= -[][]<<- _;case:(x)=> ??[]_->. -qed. - -lemma chandle_ge0 handles chandle : handles_spec handles chandle => 0 < chandle. -proof. by move=>[]_[]Heq Hlt;apply Hlt;rewrite in_dom Heq. qed. - -lemma chandle_0 handles chandle : handles_spec handles chandle => 0 <> chandle. -proof. move=> Hh;apply /IntOrder.ltr_eqF/(chandle_ge0 _ _ Hh). qed. - -lemma eqm_up_handles handles chandle m mh x2 : - handles_spec handles chandle => - eqm_handles handles m mh => - eqm_handles handles.[chandle <- (x2, Known)] m mh. +(** NOTE: this invariant is NOT the one we want: it is missing the constraints on the inverse maps. **) +inductive invariant (hs : handles) (ch : handle) (m1 m2 : smap) (mh : hsmap) (ro : (block list, block) fmap) (pi : (capacity, (block list * block)) fmap) = + | Inv of (forall xa xc ya yc, + m1.[(xa,xc)] = Some (ya,yc) => + exists xh yh xf yf, + hs.[xh] = Some (xc,xf) + /\ hs.[yh] = Some (yc,yf) + /\ mh.[(xa,xh)] = Some (ya,yh)) + & (forall xa xh ya yh, + mh.[(xa,xh)] = Some (ya,yh) => + exists xc yc xf yf, + hs.[xh] = Some (xc,xf) + /\ hs.[yh] = Some (yc,yf) + /\ m1.[(xa,xc)] = Some (ya,yc)) + & (incl m2 m1) + & (forall xa xh ya yh, + mh.[(xa,xh)] = Some (ya,yh) => + exists xc yc xf yf, + hs.[xh] = Some (xc,xf) + /\ hs.[yh] = Some (yc,yf) + /\ if yf = Known + then m2.[(xa,xc)] = Some (ya,yc) + /\ xf = Known + else exists p v b, + ro.[rcons p b] = Some ya + /\ build_hpath mh p = Some (v,xh) + /\ xa = v +^ b) + & (forall p xa b, + ro.[rcons p xa] = Some b <=> + exists v xh yh, + build_hpath mh p = Some (v,xh) + /\ mh.[(v +^ xa,xh)] = Some (b,yh)) + & (forall c p v, + pi.[c] = Some (p,v) <=> + exists h, + build_hpath mh p = Some(v,h) + /\ hs.[h] = Some (c,Known)) + & (huniq hs) + & (hs.[0] = Some (c0,Known)) + & (forall h, mem (dom hs) h => h < ch). + +(* inductive eqm_handles (handles:handles) (m:smap) (mh:hsmap) = *) +(* | MH of (forall bc bc', m.[bc] = Some bc' => *) +(* exists h h' f f', *) +(* handles.[h ] = Some(bc .`2,f ) /\ *) +(* handles.[h'] = Some(bc'.`2,f') /\ *) +(* mh.[(bc.`1, h)] = Some (bc'.`1,h')) *) +(* & (forall bh bh', mh.[bh] = Some bh' => *) +(* exists c c' f f', *) +(* handles.[bh .`2] = Some(c ,f) /\ *) +(* handles.[bh'.`2] = Some(c',f') /\ *) +(* m.[(bh.`1, c)] = Some (bh'.`1,c')). *) + +(* inductive mh_spec (handles:handles) (m2:smap) (mh:hsmap) (ro:(block list, block)fmap) = *) +(* | H of (forall bh bh', mh.[bh] = Some bh' => *) +(* exists c c' f f', *) +(* handles.[bh .`2]=Some(c,f) /\ *) +(* handles.[bh'.`2]=Some(c',f') /\ *) +(* if f' = Known *) +(* then m2.[(bh.`1,c)] = Some(bh'.`1,c') /\ f = Known *) +(* else exists p v b, *) +(* ro.[rcons p b] = Some bh'.`1 /\ *) +(* build_hpath mh p = Some(v,bh.`2) /\ *) +(* bh.`1 = v +^ b) *) +(* & (forall p b, mem (dom ro) (rcons p b) <=> *) +(* exists v h h', *) +(* build_hpath mh p = Some (v,h) /\ *) +(* mh.[(v +^ b,h)] = Some (oget ro.[rcons p b], h')). *) + +(* inductive paths_spec (handles:handles) (mh:hsmap) (paths:(capacity,block list * block)fmap) = *) +(* | P of (forall c p v, paths.[c] = Some(p,v) <=> *) +(* exists h, *) +(* build_hpath mh p = Some(v,h) /\ *) +(* handles.[h] = Some(c,Known)). *) + +(* inductive handles_spec handles chandle = *) +(* | Hs of (huniq handles) *) +(* & (handles.[0] = Some (c0,Known)) *) +(* & (forall h, mem (dom handles) h => h < chandle). *) + +(* inductive INV_CF_G1 (handles:handles) chandle (m1 mi1 m2 mi2:smap) (mh2 mhi2:hsmap) (ro:(block list, block) fmap) paths = *) +(* | CF_G1 of (eqm_handles handles m1 mh2) *) +(* & (eqm_handles handles mi1 mhi2) *) +(* & (incl m2 m1) *) +(* & (incl mi2 mi1) *) +(* & (mh_spec handles m2 mh2 ro) *) +(* & (paths_spec handles mh2 paths) *) +(* & (handles_spec handles chandle). *) + +(* lemma eqm_of_INV (chandle : handle) *) +(* (mi1 m2 mi2 : smap) (mhi2 : hsmap) *) +(* (ro : (block list, block) fmap) *) +(* (paths : (capacity, block list * block) fmap) *) +(* handles m1 mh2: *) +(* INV_CF_G1 handles chandle m1 mi1 m2 mi2 mh2 mhi2 ro paths => *) +(* eqm_handles handles m1 mh2. *) +(* proof. by case. qed. *) + +(* lemma eqmi_of_INV (chandle : handle) *) +(* (m1 m2 mi2 : smap) (mh2 : hsmap) *) +(* (ro : (block list, block) fmap) *) +(* (paths : (capacity, block list * block) fmap) *) +(* handles mi1 mhi2: *) +(* INV_CF_G1 handles chandle m1 mi1 m2 mi2 mh2 mhi2 ro paths => *) +(* eqm_handles handles mi1 mhi2. *) +(* proof. by case. qed. *) + +(* lemma incl_of_INV (handles : handles) (chandle : handle) *) +(* (mi1 mi2 : smap) (mh2 mhi2: hsmap) *) +(* (ro : (block list, block) fmap) *) +(* (paths : (capacity, block list * block) fmap) *) +(* m1 m2: *) +(* INV_CF_G1 handles chandle m1 mi1 m2 mi2 mh2 mhi2 ro paths => *) +(* incl m2 m1. *) +(* proof. by case. qed. *) + +(* lemma incli_of_INV (handles : handles) (chandle : handle) *) +(* (m1 m2 : smap) (mh2 mhi2: hsmap) *) +(* (ro : (block list, block) fmap) *) +(* (paths : (capacity, block list * block) fmap) *) +(* mi1 mi2: *) +(* INV_CF_G1 handles chandle m1 mi1 m2 mi2 mh2 mhi2 ro paths => *) +(* incl mi2 mi1. *) +(* proof. by case. qed. *) + +(* lemma mh_of_INV (chandle : handle) *) +(* (m1 mi1 mi2 : smap) (mhi2 : hsmap) *) +(* (paths : (capacity, block list * block) fmap) *) +(* handles m2 mh2 ro: *) +(* INV_CF_G1 handles chandle m1 mi1 m2 mi2 mh2 mhi2 ro paths => *) +(* mh_spec handles m2 mh2 ro. *) +(* proof. by case. qed. *) + +(* lemma paths_of_INV (chandle : handle) *) +(* (m1 m2 mi1 mi2: smap) (mhi2: hsmap) *) +(* (ro : (block list, block) fmap) *) +(* handles mh2 paths: *) +(* INV_CF_G1 handles chandle m1 mi1 m2 mi2 mh2 mhi2 ro paths => *) +(* paths_spec handles mh2 paths. *) +(* proof. by case. qed. *) + +(* lemma handles_of_INV (m1 m2 mi1 mi2 : smap) (mh2 mhi2 : hsmap) *) +(* (ro : (block list, block) fmap) *) +(* (paths : (capacity, block list * block) fmap) *) +(* handles chandle: *) +(* INV_CF_G1 handles chandle m1 mi1 m2 mi2 mh2 mhi2 ro paths => *) +(* handles_spec handles chandle. *) +(* proof. by case. qed. *) + +(* lemma eqm_dom_mh_m handles m mh hx2 f (x:state): *) +(* eqm_handles handles m mh => *) +(* handles.[hx2] = Some (x.`2, f) => *) +(* mem (dom mh) (x.`1, hx2) => mem (dom m) x. *) +(* proof. *) +(* move=>[]H1 H2 Hhx2;rewrite !in_dom. *) +(* case: (mh.[_]) (H2 (x.`1,hx2))=> //= bh' /(_ bh') [c c' f1 f1']. *) +(* by rewrite Hhx2=> /= -[][]<<- _;case:(x)=> ??[]_->. *) +(* qed. *) + +(* lemma chandle_ge0 handles chandle : handles_spec handles chandle => 0 < chandle. *) +(* proof. by case=> _ Heq Hlt; apply Hlt; rewrite in_dom Heq. qed. *) + +(* lemma chandle_0 handles chandle : handles_spec handles chandle => 0 <> chandle. *) +(* proof. by move=> Hh;apply/ltr_eqF/(@chandle_ge0 _ _ Hh). qed. *) + +(* lemma eqm_up_handles handles chandle m mh x2 : *) +(* handles_spec handles chandle => *) +(* eqm_handles handles m mh => *) +(* eqm_handles handles.[chandle <- (x2, Known)] m mh. *) +(* proof. *) +(* case=> Hu Hh0 Hlt [] m_some mh_some; split. *) +(* + move=> bc bc' /m_some [h h' f f'] [#] Hh Hh' Hmh. *) +(* exists h, h', f, f'; rewrite !getP Hmh -Hh -Hh' /=. *) +(* rewrite ltr_eqF /=; 1:by apply/Hlt; rewrite in_dom Hh. *) +(* by rewrite ltr_eqF; 1:by apply/Hlt; rewrite in_dom Hh'. *) +(* move=> bh bh' /mh_some [c c' f f'] [#] Hh Hh' Hm. *) +(* exists c, c', f, f'; rewrite !getP Hm -Hh -Hh'. *) +(* rewrite ltr_eqF /=; 1:by apply/Hlt; rewrite in_dom Hh. *) +(* by rewrite ltr_eqF; 1:by apply/Hlt; rewrite in_dom Hh'. *) +(* qed. *) + +(* lemma mh_up_handles handles chandle m2 mh ro cf: *) +(* handles_spec handles chandle => *) +(* mh_spec handles m2 mh ro => *) +(* mh_spec handles.[chandle <- cf] m2 mh ro. *) +(* proof. *) +(* move=> + [] mh_some ?=> -[] _ _ Hlt; split=> // bh bh' /mh_some [c c' f f'] [#] Hh Hh' Hif. *) +(* exists c,c',f,f'; rewrite Hif -Hh -Hh' !getP. *) +(* rewrite ltr_eqF /=; 1:by apply/Hlt; rewrite in_dom Hh. *) +(* by rewrite ltr_eqF; 1:by apply/Hlt; rewrite in_dom Hh'. *) +(* qed. *) + +(* lemma paths_up_handles m2 ro handles mh paths cf chandle: *) +(* mh_spec handles m2 mh ro => *) +(* handles_spec handles chandle => *) +(* paths_spec handles mh paths => *) +(* paths_spec handles.[chandle <- cf] mh paths. *) +(* proof. *) +(* move=> Hmh Hh [] Hp; split=> c p v; rewrite Hp; apply exists_iff=> x /=. *) +(* split=>- [] ^Hbu -> /=; rewrite getP. *) +(* + case: Hh=> _ _ Hlt x_in_handles. *) +(* by rewrite ltr_eqF; 1:by apply/Hlt; rewrite in_dom x_in_handles. *) +(* case: (x = chandle)=> //=. *) +(* move: Hbu=> /build_hpathP [[#] _ _ ->|[p' b v' h' [#] _ _ Hh']]. *) +(* + by rewrite (@chandle_0 _ _ Hh). *) +(* case: Hh=> _ _ /(_ x) Hlt; rewrite ltr_eqF //. *) +(* by apply/Hlt; rewrite in_dom; case: Hmh=> /(_ _ _ Hh') [????] [#] _ ->. *) +(* qed. *) + +(* lemma handles_up_handles handles chandle x2 f': *) +(* (forall (f : flag), ! mem (rng handles) (x2, f)) => *) +(* handles_spec handles chandle => *) +(* handles_spec handles.[chandle <- (x2, f')] (chandle + 1). *) +(* proof. *) +(* move=> Hx2 ^Hh [] Hu Hh0 Hlt; split. *) +(* + move=> h1 h2 [c1 f1] [c2 f2]; rewrite !getP /=. *) +(* case: (h1 = chandle)=> /= [-> [] ->> ->|_]; (case: (h2 = chandle)=> [-> //= |_]). *) +(* + by move=> Heq ->>; move: (Hx2 f2); rewrite in_rng negb_exists=> /= /(_ h2). *) +(* + by move=> Heq [] ->> <<- ->>; move: (Hx2 f1); rewrite in_rng negb_exists=> /= /(_ h1). *) +(* by apply Hu. *) +(* + by rewrite getP (@chandle_0 _ _ Hh). *) +(* + by move=> h; rewrite dom_set !inE /#. *) +(* qed. *) + +(* lemma INV_CF_G1_up_handles handles chandle m1 mi1 m2 mi2 mh mhi ro paths x2: *) +(* INV_CF_G1 handles chandle m1 mi1 m2 mi2 mh mhi ro paths => *) +(* (forall f, ! mem (rng handles) (x2, f)) => *) +(* INV_CF_G1 handles.[chandle <- (x2, Known)](chandle+1) m1 mi1 m2 mi2 mh mhi ro paths. *) +(* proof. *) +(* case=> Heqm Heqmi Hincl Hincli Hmh Hp Hh Hx2; split. *) +(* + exact/eqm_up_handles. *) +(* + exact/eqm_up_handles. *) +(* + done. *) +(* + done. *) +(* + exact/mh_up_handles. *) +(* + exact/(paths_up_handles m2 ro). *) +(* exact/handles_up_handles. *) +(* qed. *) + +(* lemma eqm_handles_up (handles : handles) m mh (h hx:handle) (x y : state) f: *) +(* huniq handles => *) +(* handles.[h] = None => *) +(* handles.[hx] = Some (x.`2, f) => *) +(* eqm_handles handles m mh => *) +(* eqm_handles handles.[h <- (y.`2,Known)] m.[x <- y] mh.[(x.`1,hx) <- (y.`1,h)]. *) +(* proof. *) +(* move=> uniq_h h_h h_hx @/eqm_handles [] hmmh hmhm; split. *) +(* + move=> bc bc'; rewrite getP; case (bc = x)=> /= [->> <<- {bc bc'}|]. *) +(* * by exists hx, h, f, Known; rewrite !getP /= [smt (in_dom)]. *) +(* move=> bc_neq_x /hmmh [] h0 h0' f0 f0' [#] h_h0 h_h0' mhi_bc. *) +(* by exists h0, h0', f0, f0'; rewrite !getP [smt (in_dom)]. *) +(* move=> bh bh'; rewrite getP; case (bh = (x.`1,hx))=> /= [->> <<- {bh bh'}|]. *) +(* * by exists x.`2, y.`2, f, Known; rewrite !getP [smt (in_dom)]. *) +(* case bh=> b h0 /=. *) +(* rewrite anda_and negb_and=> bh_neq_x1hx /hmhm /= [] c0 c0' f0 f0' [#] h_h0 h_bh' m_bc. *) +(* exists c0, c0', f0, f0'; rewrite !getP. *) +(* split; 1:smt (in_dom). *) +(* split; 1:smt (in_dom). *) +(* case x bh_neq_x1hx h_hx=> x1 x2 /= => - [/#|h0_neq_hx h_hx]. *) +(* have -> //=: c0 <> x2; move: h0_neq_hx; apply/contra. *) +(* exact/(@uniq_h _ _ _ _ h_h0 h_hx). *) +(* qed. *) + +(* lemma eqmi_handles_up (handles : handles) mi mhi (h hx : handle) (x y : state) f: *) +(* (!exists f', mem (rng handles) (y.`2,f')) => *) +(* handles.[h] = None => *) +(* handles.[hx] = Some (x.`2, f) => *) +(* eqm_handles handles mi mhi => *) +(* eqm_handles handles.[h <- (y.`2,Known)] mi.[y <- x] mhi.[(y.`1,h) <- (x.`1,hx)]. *) +(* proof. *) +(* move=> y_notinr1_handles h_h h_hx @/eqm_handles [] hmmh hmhm; split. *) +(* + move=> bc bc'; rewrite getP; case (bc = y)=> /= [->> <<- {bc bc'}|]. *) +(* * by exists h, hx, Known, f; rewrite !getP /= [smt (in_dom)]. *) +(* move=> bc_neq_y /hmmh [] h0 h0' f0 f0' [#] h_h0 h_h0' mhi_bc. *) +(* by exists h0, h0', f0, f0'; rewrite !getP [smt (in_dom)]. *) +(* move=> bh bh'; rewrite getP; case (bh = (y.`1,h))=> /= [->> <<- {bh bh'}|]. *) +(* * by exists y.`2, x.`2, Known, f; rewrite !getP [smt (in_dom)]. *) +(* case bh=> b h0 /=. *) +(* rewrite anda_and negb_and=> bh_neq_y1h /hmhm /= [] c0 c0' f0 f0' [#] h_bh h_bh' mi_bh. *) +(* exists c0, c0', f0, f0'; rewrite !getP. *) +(* split; 1:smt (in_dom). *) +(* split; 1:smt (in_dom). *) +(* case y bh_neq_y1h y_notinr1_handles=> y1 y2 /= [/#|h0_neq_h y_notinr1_handles]. *) +(* have /#: c0 = y2 => false; move=> /(congr1 (fun x=> exists f', mem (rng handles) (x,f'))) /=. *) +(* rewrite y_notinr1_handles /= neqF /=; exists f0. *) +(* by rewrite in_rng; exists h0. *) +(* qed. *) + +(* lemma incl_set (m m' : ('a,'b) fmap) x y: *) +(* incl m m' => *) +(* incl m.[x <- y] m'.[x <- y]. *) +(* proof. smt (in_dom getP). qed. *) + +(* lemma hinv_notin_rng m y2: *) +(* SLCommon.hinv m y2 = None => *) +(* (forall h f, m.[h] <> Some (y2,f)). *) +(* proof. by move=> hinv_none; have:= hinvP m y2; rewrite hinv_none. qed. *) + +(* lemma handles_spec_notin_dom m h: *) +(* handles_spec m h => *) +(* !mem (dom m) h. *) +(* proof. case; smt (in_dom). qed. *) + +(* lemma neq_Known f: f <> Known <=> f = Unknown. *) +(* proof. by case f. qed. *) + +(* lemma neq_Unkwown f: f <> Unknown <=> f = Known. *) +(* proof. by case f. qed. *) + +op getflag (hs : handles) xc = + omap snd (obind ("_.[_]" hs) (hinv hs xc)). + +(* lemma getflagP hs xc f: *) +(* huniq hs => *) +(* (mem (rng hs) (xc,f) <=> getflag hs xc = Some f). *) +(* proof. *) +(* move=> huniq_hs; split. *) +(* + rewrite in_rng=> -[h] hs_h. *) +(* move: (hinvP hs xc)=> [_ /(_ h f) //|]. *) +(* rewrite /getflag; case: (hinv hs xc)=> // h' _ [f']; rewrite oget_some. *) +(* move=> /(huniq_hs _ h _ (xc,f)) /(_ hs_h) /= ->>. *) +(* by rewrite hs_h. *) +(* rewrite /getflag; case: (hinvP hs xc)=> [-> //|]. *) +(* rewrite in_rng; case: (hinv hs xc)=> //= h [f']. *) +(* rewrite oget_some=> ^ hs_h -> @/snd /= ->>. *) +(* by exists h. *) +(* qed. *) + +(* lemma paths_prefix handles m2 mh ro paths c b p v: *) +(* mh_spec handles m2 mh ro => *) +(* paths_spec handles mh paths => *) +(* paths.[c] = Some (rcons p b,v) => *) +(* (exists c' v', paths.[c'] = Some (p,v')). *) +(* proof. *) +(* move=> [] mh_some _ [] hpaths ^paths_c. *) +(* move=> /hpaths [h] [#] /build_hpathP [/#|] [p' b' v' h'] [#] ^/rconsIs + /rconssI- <*>. *) +(* move=> hpath + handles_h - /mh_some /= [c' c0 f' f]; rewrite handles_h /= => /> handles_h' _. *) +(* by exists c', v'; rewrite hpaths; exists h'. *) +(* qed. *) + +lemma build_hpath_prefix mh p b v h: + build_hpath mh (rcons p b) = Some (v,h) => + (exists v' h', build_hpath mh p = Some (v',h')). proof. - move=> []Hu[Hh0 Hlt][]H1 H2;split=> - [bc bc'/H1 [h h' f f'][]Hh[]Hh' Hmh| bh bh'/H2 [c c' f f'][]Hh []Hh' Hm]. - + exists h,h',f,f';rewrite !getP Hmh/=-Hh-Hh'(_:h<>chandle)2:(_:h'<>chandle) //. - + by apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom Hh. - by apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom Hh'. - exists c,c',f,f';rewrite !getP Hm/=-Hh-Hh'(_:bh.`2<>chandle)2:(_:bh'.`2<>chandle) //. - + by apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom Hh. - by apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom Hh'. +move=> /build_hpathP [/#|] [p' b' v' h'] [#] + + _. +move=> ^/rconsIs <<- {b'} /rconssI <<- {p'} H. +by exists v', h'. qed. -lemma mh_up_handles handles chandle m2 mh ro cf: - handles_spec handles chandle => - mh_spec handles m2 mh ro => - mh_spec handles.[chandle <- cf] m2 mh ro. -proof. - move=> Hh Hmh. - move:Hmh Hh=>[H1 ?][_[]_ Hlt];split=>// bh bh' /H1 [c f c' f'][]Hh[]Hh' Hif. - exists c,f,c',f';rewrite Hif-Hh-Hh'!getP(_:bh.`2<>chandle)2:(_:bh'.`2<>chandle) //. - + by apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom Hh. - by apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom Hh'. -qed. - -lemma paths_up_handles m2 ro handles mh paths cf chandle: - mh_spec handles m2 mh ro => - handles_spec handles chandle => - paths_spec handles mh paths => - paths_spec handles.[chandle <- cf] mh paths. -proof. - move=> Hmh Hh Hp c p v;rewrite Hp;apply NewLogic.exists_iff=> h/=;split=> -[^Hbu->] /=; - rewrite getP. - + move:Hh=>[]_[]_/(_ h)Hlt Hh;rewrite (_:h<>chandle)//. - by apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom Hh. - rewrite (_:h<>chandle)//. - cut [[]_[]_->|[p' b v' h'[]_[]_ Hh']]:= build_hpathP _ _ _ _ Hbu. - + by rewrite (chandle_0 _ _ Hh). - move:Hh=>[]_[]_/(_ h)Hlt;apply /IntOrder.ltr_eqF/Hlt;rewrite in_dom. - by cut [/(_ _ _ Hh')[????][]_[]->]:= Hmh. -qed. - -lemma handles_up_handles handles chandle x2 f': - (forall (f : flag), ! mem (rng handles) (x2, f)) => - handles_spec handles chandle => - handles_spec handles.[chandle <- (x2, f')] (chandle + 1). -proof. - move=> Hx2^Hh[]Hu[]Hh0 Hlt;split;[ | split]. - + move=> h1 h2 [c1 f1] [c2 f2];rewrite !getP. - case (h1=chandle)=>[->/=[]->> ->|_]; (case (h2=chandle)=>[->//=|_]). - + by move=>Heq ->>;move:(Hx2 f2);rewrite in_rng NewLogic.negb_exists=>/=/(_ h2); - rewrite Heq. - + by move=>Heq[]->> <<- ->>;move:(Hx2 f1);rewrite in_rng NewLogic.negb_exists=>/=/(_ h1); - rewrite Heq. - by apply Hu. - + by rewrite getP (chandle_0 _ _ Hh). - move=>h;rewrite dom_set !inE /#. -qed. - -lemma INV_CF_G1_up_handles handles chandle m1 mi1 m2 mi2 mh mhi ro paths x2: - INV_CF_G1 handles chandle m1 mi1 m2 mi2 mh mhi ro paths => - (forall f, ! mem (rng handles) (x2, f)) => - INV_CF_G1 handles.[chandle <- (x2, Known)](chandle+1) m1 mi1 m2 mi2 mh mhi ro paths. -proof. - move=>[][]Heqm Heqmi[]Hincl[]Hmh[]Hp Hh Hx2;split. - + by split;apply eqm_up_handles. - split=>//;split;[|split]. - + by apply mh_up_handles. - + by apply (paths_up_handles m2 ro). - by apply handles_up_handles. -qed. - -lemma eqm_handles_up (handles : handles) m mh (h hx:handle) (x y : state) f: - huniq handles => - handles.[h] = None => - handles.[hx] = Some (x.`2, f) => - eqm_handles handles m mh => - eqm_handles handles.[h <- (y.`2,Known)] m.[x <- y] mh.[(x.`1,hx) <- (y.`1,h)]. -proof. -move=> uniq_h h_h h_hx @/eqm_handles [] hmmh hmhm; split. -+ move=> bc bc'; rewrite getP; case (bc = x)=> /= [->> <<- {bc bc'}|]. - * by exists hx, h, f, Known; rewrite !getP /= [smt w=in_dom]. - move=> bc_neq_x /hmmh [] h0 h0' f0 f0' [#] h_h0 h_h0' mhi_bc. - by exists h0, h0', f0, f0'; rewrite !getP [smt w=in_dom]. -move=> bh bh'; rewrite getP; case (bh = (x.`1,hx))=> /= [->> <<- {bh bh'}|]. - * by exists x.`2, y.`2, f, Known; rewrite !getP [smt w=in_dom]. -case bh=> b h0 /=. -rewrite anda_and NewLogic.negb_and=> bh_neq_x1hx /hmhm /= [] c0 c0' f0 f0' [#] h_h0 h_bh' m_bc. -exists c0, c0', f0, f0'; rewrite !getP. -split; 1:smt w=in_dom. -split; 1:smt w=in_dom. -case x bh_neq_x1hx h_hx=> x1 x2 /= => - [/#|h0_neq_hx h_hx]. -have -> //=: c0 <> x2; move: h0_neq_hx; apply/contra. -exact/(uniq_h _ _ _ _ h_h0 h_hx). -qed. - -lemma eqmi_handles_up (handles : handles) mi mhi (h hx : handle) (x y : state) f: - (!exists f', mem (rng handles) (y.`2,f')) => - handles.[h] = None => - handles.[hx] = Some (x.`2, f) => - eqm_handles handles mi mhi => - eqm_handles handles.[h <- (y.`2,Known)] mi.[y <- x] mhi.[(y.`1,h) <- (x.`1,hx)]. -proof. -move=> y_notinr1_handles h_h h_hx @/eqm_handles [] hmmh hmhm; split. -+ move=> bc bc'; rewrite getP; case (bc = y)=> /= [->> <<- {bc bc'}|]. - * by exists h, hx, Known, f; rewrite !getP /= [smt w=in_dom]. - move=> bc_neq_y /hmmh [] h0 h0' f0 f0' [#] h_h0 h_h0' mhi_bc. - by exists h0, h0', f0, f0'; rewrite !getP [smt w=in_dom]. -move=> bh bh'; rewrite getP; case (bh = (y.`1,h))=> /= [->> <<- {bh bh'}|]. - * by exists y.`2, x.`2, Known, f; rewrite !getP [smt w=in_dom]. -case bh=> b h0 /=. -rewrite anda_and NewLogic.negb_and=> bh_neq_y1h /hmhm /= [] c0 c0' f0 f0' [#] h_bh h_bh' mi_bh. -exists c0, c0', f0, f0'; rewrite !getP. -split; 1:smt w=in_dom. -split; 1:smt w=in_dom. -case y bh_neq_y1h y_notinr1_handles=> y1 y2 /= [/#|h0_neq_h y_notinr1_handles]. -have /#: c0 = y2 => false; move=> /(congr1 (fun x=> exists f', mem (rng handles) (x,f'))) /=. -rewrite y_notinr1_handles /= neqF /=; exists f0. -by rewrite in_rng; exists h0. -qed. - -lemma incl_set (m m' : ('a,'b) fmap) x y: - incl m m' => - incl m.[x <- y] m'.[x <- y]. -proof. smt w=(in_dom getP). qed. - -lemma hinv_notin_rng m y2: - SLCommon.hinv m y2 = None => - (forall h f, m.[h] <> Some (y2,f)). -proof. by move=> hinv_none; have:= hinvP m y2; rewrite hinv_none. qed. - -lemma handles_spec_notin_dom m h: - handles_spec m h => - !mem (dom m) h. -proof. smt w=in_dom. qed. - -lemma neq_Known f: f <> Known <=> f = Unknown. -proof. by case f. qed. - -lemma neq_Unkwown f: f <> Unknown <=> f = Known. -proof. by case f. qed. - clone export ConcreteF as ConcreteF1. section AUX. @@ -429,68 +515,72 @@ section AUX. equiv CF_G1 : CF(D).main ~ G1(D).main: ={glob D} ==> !(G1.bcol \/ G1.bext){2} => ={res}. proof. - admit. -(* - proc. - call (_:(G1.bcol \/ G1.bext), - INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} - G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2}). - (* lossless D *) - + apply D_ll. - (** proofs for G1.S.f *) - (* equiv PF.P.f G1.S.f *) - + proc;if{1}=>/=. - (* x is not in m{1} so forall h, (x.1,h) is not in mh{2} *) - + rcondt{2} 1. - + move=> &hr;skip=> &hr'[][]_[]<-[]_[][]Hincl Hincli _. - rewrite !in_dom/==>H; by case:(G1.m{hr'}.[x{hr}]) (Hincl x{hr})=> //=;rewrite H. - exists* F.RO.m{2}, G1.paths{2};elim*=>ro0 paths0. - seq 1 2 : (!G1.bcol{2} /\ (G1.bext = mem (rng FRO.m) (x.`2, Unknown)){2} /\ - ={x,y} /\ - INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} - G1.mh{2} G1.mhi{2} ro0 paths0 /\ - ! mem (dom PF.m{1}) x{1} /\ - (if mem (dom paths0) x.`2 then - let (p,v) = oget paths0.[x.`2] in - F.RO.m{2} = ro0.[rcons p (v+^x.`1) <- y.`1] /\ - G1.paths = paths0.[y.`2 <- (rcons p (v +^ x.`1), y.`1)] - else F.RO.m = ro0 /\ G1.paths = paths0){2}). - + wp 1 1;conseq (_: ={y} /\ - if mem (dom paths0) x{2}.`2 then - let (p0, v0) = oget paths0.[x{2}.`2] in - F.RO.m{2} = ro0.[rcons p0 (v0 +^ x{2}.`1) <- y{2}.`1] /\ - G1.paths{2} = paths0.[y{2}.`2 <- (rcons p0 (v0 +^ x{2}.`1), y{2}.`1)] - else F.RO.m{2} = ro0 /\ G1.paths{2} = paths0);1:smt ml=0. - if{2};2:by auto=>/#. - inline{2} F.RO.get;rcondt{2} 4. - + move=> &ml;auto=>/= &mr[][]_[][]_[]->[][][]_ Heqm _[]_[][]_ Hro[] Hpath _ HnPFm. - rewrite in_dom;case:(G1.paths{mr}.[_]) (Hpath x{mr}.`2)=>//[[p v]]/(_ p v)/=[h][]Hbu Hh b _. - rewrite -not_def=> /Hro [??h'];rewrite oget_some Hbu => -[][]<- <- /=. - rewrite Block.xorwA Block.xorwK Block.xorwC Block.xorw0 -not_def=>/Heqm [c c' f f']. - by rewrite Hh=> -[][]<- _[]_ Hm;move:HnPFm;rewrite in_dom;case:(x{mr}) Hm=> ??->. - swap{2} 3-2;swap{2}6-4;wp;conseq (_:y{1} =(r,y2){2}). - + progress [-split];rewrite getP_eq oget_some H2/=. - by move:H2;rewrite in_dom;case:(G1.paths{2}.[_]). - transitivity{1} {y <- S.sample();} (true ==> ={y}) (true==>y{1}=(r,y2){2})=>//;1:by inline*;auto. - transitivity{2} {(r,y2) <- S.sample2();} (true==>y{1}=(r,y2){2}) (true==> ={r,y2})=>//;2:by inline*;auto. - by call sample_sample2;auto=> /=?[??]->. - case (mem (rng FRO.m{2}) (x{2}.`2, Unknown)). - + conseq (_:true);[by move=> ??[][]_[]->_->|auto]. - conseq (_: !G1.bcol{2} => - oget PF.m{1}.[x{1}] = y{2} /\ - INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2}). - + by move=> ??[][]_[]->[][]-> _ _ ->. - seq 0 2: ((!G1.bcol{2} /\ ={x, y} /\ - INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} - G1.mh{2} G1.mhi{2} ro0 paths0 /\ - ! mem (dom PF.m{1}) x{1} /\ - if mem (dom paths0) x{2}.`2 then - let (p0, v0) = oget paths0.[x{2}.`2] in - F.RO.m{2} = ro0.[rcons p0 (v0 +^ x{2}.`1) <- y{2}.`1] /\ - G1.paths{2} = paths0.[y{2}.`2 <- (rcons p0 (v0 +^ x{2}.`1), y{2}.`1)] - else F.RO.m{2} = ro0 /\ G1.paths{2} = paths0) /\ - !mem (rng FRO.m{2}) (x{2}.`2, Unknown) /\ - (FRO.m.[hx2]=Some(x.`2,Known)){2}). + proc. + call (_: G1.bcol \/ G1.bext, + invariant FRO.m{2} G1.chandle{2} PF.m{1} G1.m{2} G1.mh{2} F.RO.m{2} G1.paths{2}). + (* lossless D *) + + exact/D_ll. + (** proofs for G1.S.f *) + (* equivalence up to bad of PF.f and G1.S.f *) + + proc; if{1}=> //=. + (* x is not in m{1} so forall h, (x.1,h) is not in mh{2} *) + + rcondt{2} 1. + + move=> &m; auto=> &m' [#] _ <- Hinv. + by rewrite !in_dom; apply/contra=> ^ h; case: Hinv=> _ _ ->. + exists* F.RO.m{2}; elim*=> ro0. + seq 2 3: ( !G1.bcol{2} + /\ (G1.bext <=> mem (rng FRO.m) (x.`2, Unknown)){2} + /\ ={x,y1,y2} + /\ invariant FRO.m{2} G1.chandle{2} PF.m{1} G1.m{2} G1.mh{2} ro0 G1.paths{2} + /\ ! mem (dom PF.m{1}) x{1} + /\ (if mem (dom G1.paths) x.`2 + then let (p,v) = oget G1.paths.[x.`2] in + F.RO.m{2} = ro0.[rcons p (v+^x.`1) <- y.`1] + else F.RO.m = ro0){2}). + + if{2}; last first. + + by auto=> |> &1 &2; rewrite negb_or; case=> -> ->. + inline{2} F.RO.get; rcondt{2} 4. + + auto=> |> &m'; case: (x{m'})=> /= _x1 _x2 _ [] + m_some mh_some leq in_mh in_ro in_pi hs_inj hs0 hs_dom + + r0 _ - {r0} + x2_in_pi. + have:= x2_in_pi; rewrite in_dom. + case: {-1}(G1.paths.[_x2]{m'}) (eq_refl (G1.paths.[_x2]{m'}))=> //= -[] p v paths_x2. + rewrite oget_some /=; have /in_pi [h_x2] [#] pv_hx2 hs_h_x2:= paths_x2. + apply/contra; rewrite !in_dom. + case: {-1}(F.RO.m.[rcons p (v +^ _x1)]{m'}) (eq_refl (F.RO.m.[rcons p (v +^ _x1)]{m'}))=> //= b. + move=> ^ro_pv_x1 /in_ro [v' xh yh] [#]. + rewrite pv_hx2 /= => [#] <<- <<-. + rewrite Block.xorwA Block.xorwK Block.xorwC Block.xorw0. + by move=> /mh_some [xc yc xf yf] [#]; rewrite hs_h_x2 /= => [#] <<- <<- _ ->. + auto=> |> &1 &2; rewrite negb_or; case=> -> -> /= Hinv x_notin_PF ^x2_in_paths. + rewrite in_dom; case: {-1}(G1.paths.[x.`2]{2}) (eq_refl G1.paths.[x.`2]{2})=> //=. + move=> [p v] paths_x2 y1' _ y2' _; rewrite oget_some /=. + rewrite getP /= oget_some /= => x1 x2 [] <- <-. + by rewrite getP /= oget_some. + admit. +(* swap{2} 3-2;swap{2}6-4;wp;conseq (_:y{1} =(r,y2){2}). + + progress [-split];rewrite getP_eq oget_some H2/=. + by move:H2;rewrite in_dom;case:(G1.paths{2}.[_]). + transitivity{1} {y <- S.sample();} (true ==> ={y}) (true==>y{1}=(r,y2){2})=>//;1:by inline*;auto. + transitivity{2} {(r,y2) <- S.sample2();} (true==>y{1}=(r,y2){2}) (true==> ={r,y2})=>//;2:by inline*;auto. + by call sample_sample2;auto=> /=?[??]->. + case (mem (rng FRO.m{2}) (x{2}.`2, Unknown)). + + conseq (_:true);[by move=> ??[][]_[]->_->|auto]. + conseq (_: !G1.bcol{2} => + oget PF.m{1}.[x{1}] = y{2} /\ + INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2}). + by move=> ??[][]_[]->[][]-> _ _ ->. *) + admit. +(* seq 0 2: ((!G1.bcol{2} /\ ={x, y} /\ + INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} + G1.mh{2} G1.mhi{2} ro0 paths0 /\ + ! mem (dom PF.m{1}) x{1} /\ + if mem (dom paths0) x{2}.`2 then + let (p0, v0) = oget paths0.[x{2}.`2] in + F.RO.m{2} = ro0.[rcons p0 (v0 +^ x{2}.`1) <- y{2}.`1] /\ + G1.paths{2} = paths0.[y{2}.`2 <- (rcons p0 (v0 +^ x{2}.`1), y{2}.`1)] + else F.RO.m{2} = ro0 /\ G1.paths{2} = paths0) /\ + !mem (rng FRO.m{2}) (x{2}.`2, Unknown) /\ + (FRO.m.[hx2]=Some(x.`2,Known)){2}). + auto=> &ml&mr[][]->[]_[][]-> ->[]Hinv []-> -> ^Hrng-> /=. case (mem (rng FRO.m{mr}) (x{mr}.`2, Known))=> Hmem /=. + by split=>//;apply /huniq_hinvK=>//;move:Hinv;rewrite /INV_CF_G1/handles_spec. @@ -508,7 +598,7 @@ section AUX. rewrite getP /= oget_some /= /INV_CF_G1. rewrite (eqm_handles_up FRO.m{2} PF.m{1} G1.mh{2} G1.chandle{2} hx2{2} x{2} y{2} Known _ _ _ _) //= 1..3:[smt w=in_dom]. rewrite (eqmi_handles_up FRO.m{2} PF.mi{1} G1.mhi{2} G1.chandle{2} hx2{2} x{2} y{2} Known _ _ _ _) //= 2..3:[smt w=in_dom]. - + rewrite NewLogic.negb_exists=> f /=; rewrite in_rng NewLogic.negb_exists=> h. + + rewrite negb_exists=> f /=; rewrite in_rng negb_exists=> h. exact/(y2_notinr1_FRO h f). have /eqT -> /= := incl_set G1.m{2} PF.m{1} x{2} y{2} _; 1: by smt ml=0. have /eqT -> /= := incl_set G1.mi{2} PF.mi{1} y{2} x{2} _; 1: by smt ml=0. @@ -523,7 +613,7 @@ section AUX. move=> /(congr1 (fun x=> FRO.m{2}.[x])) /=; rewrite FRO_hx2. have:= handles_spec_notin_dom FRO.m{2} G1.chandle{2} _; 1: smt ml=0. by rewrite in_dom /= => ->. - elim bh=> b' h' /=; rewrite anda_and NewLogic.negb_and=> bh_neq_xhx ^mh_bh. + elim bh=> b' h' /=; rewrite anda_and negb_and=> bh_neq_xhx ^mh_bh. have @/eqm_handles [] hmmh hmhm := eqm_of_INV _ _ _ _ _ _ _ _ _ _ hinv. move=> /hmhm=>- [c c' f f'] /= [#] FRO_h' FRO_ch PF_b'c. exists c, c', f, f'=> //=. @@ -544,51 +634,55 @@ section AUX. admit. (* this one should be a lot easier *) admit. (* some pain here *) admit. (* will be painful as well *) - (* Stopped here *) - admit. - (* lossless PF.P.f *) - + admit. - (* lossless and do not reset bad G1.S.f *) - + admit. - (** proofs for G1.S.fi *) - (* equiv PF.P.fi G1.S.fi *) - + admit. - (* lossless PF.P.fi *) - + admit. - (* lossless and do not reset bad G1.S.fi *) - + admit. - (** proofs for G1.C.f *) - (* equiv PF.C.f G1.C.f *) - + admit. - (* lossless PF.C.f *) - + admit. - (* lossless and do not reset bad G1.C.f *) - + admit. - (* Init ok *) - inline *. auto; progress=> //=. - + smt w=map0P. - + smt w=map0P. - + smt w=map0P. - + smt w=map0P. - + smt w=map0P. - + smt w=(map0P in_dom). - + smt w=map0P. - + rewrite /paths_spec=> c p v. rewrite !getP; case (c = c0)=> //=. - rewrite anda_and=> c_c0; split=> [[] <<- <<-|]. - + by exists 0; rewrite /build_hpath /= getP /= c_c0. - move=> [h] @/build_hpath [] h0; rewrite getP; case (h = 0). - + by move=> /= ->> ->>; move: h0; smt. - smt w=map0P. - move=> c_c0; rewrite map0P /= NewLogic.negb_exists /= => h. - rewrite NewLogic.negb_and getP; case (h = 0)=> //=; [|by rewrite map0P]. - by move=> _; right; rewrite eq_sym. - + smt w=(map0P getP). - + by rewrite getP. - + move: H; rewrite in_dom getP; case (h = 0)=> //=. - by rewrite map0P. - + by move: H1=> /H0 [#]. *) - qed. + (* Stopped here *) + + move=> &2 _; proc; if=> //=; wp; rnd predT; rnd predT; auto. + smt (Block.DWord.bdistr_uf Capacity.DWord.cdistr_uf). + (* lossless and do not reset bad G1.S.f *) + + move=> _; proc; if; auto. + conseq (_: _ ==> G1.bcol \/ G1.bext); 1:smt (). + inline *; if=> //=; wp; rnd predT; wp; rnd predT; auto. + + smt (Block.DWord.bdistr_uf Capacity.DWord.cdistr_uf). + smt (Block.DWord.bdistr_uf Capacity.DWord.cdistr_uf). + (** proofs for G1.S.fi *) + (* equiv PF.P.fi G1.S.fi *) + + admit. + (* lossless PF.P.fi *) + + admit. + (* lossless and do not reset bad G1.S.fi *) + + admit. + (** proofs for G1.C.f *) + (* equiv PF.C.f G1.C.f *) + + admit. + (* lossless PF.C.f *) + + admit. + (* lossless and do not reset bad G1.C.f *) + + admit. + (* Init ok *) + admit. +(*inline *. auto; progress=> //=. + + smt w=map0P. + + smt w=map0P. + + smt w=map0P. + + smt w=map0P. + + smt w=map0P. + + smt w=(map0P in_dom). + + smt w=map0P. + + rewrite /paths_spec=> c p v. rewrite !getP; case (c = c0)=> //=. + rewrite anda_and=> c_c0; split=> [[] <<- <<-|]. + + by exists 0; rewrite /build_hpath /= getP /= c_c0. + move=> [h] @/build_hpath [] h0; rewrite getP; case (h = 0). + + by move=> /= ->> ->>; move: h0; smt. + smt w=map0P. + move=> c_c0; rewrite map0P /= negb_exists /= => h. + rewrite negb_and getP; case (h = 0)=> //=; [|by rewrite map0P]. + by move=> _; right; rewrite eq_sym. + + smt w=(map0P getP). + + by rewrite getP. + + move: H; rewrite in_dom getP; case (h = 0)=> //=. + by rewrite map0P. + + by move: H1=> /H0 [#].*) +qed. end section AUX. @@ -605,7 +699,7 @@ section. Pr[G1(DRestr(D)).main() @ &m: res] + (max_size ^ 2)%r * mu dstate (pred1 witness) + Pr[G1(DRestr(D)).main() @&m: G1.bcol] + Pr[G1(DRestr(D)).main() @&m: G1.bext]. proof. - apply (RealOrder.ler_trans _ _ _ (Real_Concrete D D_ll &m)). + apply (@RealOrder.ler_trans _ _ _ (Real_Concrete D D_ll &m)). cut : Pr[CF(DRestr(D)).main() @ &m : res] <= Pr[G1(DRestr(D)).main() @ &m : res] + Pr[G1(DRestr(D)).main() @ &m : G1.bcol \/ G1.bext]. From 78daded0eca810e6f3de440f7482ce4dd3fe020b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Fri, 8 Jul 2016 12:38:54 +0100 Subject: [PATCH 174/525] Retrieving the full invariant with better behaviour w.r.t. case. --- proof/core/Handle.eca | 656 ++++++++++++++++++++---------------------- 1 file changed, 318 insertions(+), 338 deletions(-) diff --git a/proof/core/Handle.eca b/proof/core/Handle.eca index f05c336..755444b 100644 --- a/proof/core/Handle.eca +++ b/proof/core/Handle.eca @@ -153,345 +153,307 @@ module G1(D:DISTINGUISHER) = { }. (* -------------------------------------------------------------------------- *) -(** NOTE: this invariant is NOT the one we want: it is missing the constraints on the inverse maps. **) -inductive invariant (hs : handles) (ch : handle) (m1 m2 : smap) (mh : hsmap) (ro : (block list, block) fmap) (pi : (capacity, (block list * block)) fmap) = - | Inv of (forall xa xc ya yc, - m1.[(xa,xc)] = Some (ya,yc) => - exists xh yh xf yf, - hs.[xh] = Some (xc,xf) - /\ hs.[yh] = Some (yc,yf) - /\ mh.[(xa,xh)] = Some (ya,yh)) - & (forall xa xh ya yh, - mh.[(xa,xh)] = Some (ya,yh) => - exists xc yc xf yf, - hs.[xh] = Some (xc,xf) - /\ hs.[yh] = Some (yc,yf) - /\ m1.[(xa,xc)] = Some (ya,yc)) - & (incl m2 m1) - & (forall xa xh ya yh, - mh.[(xa,xh)] = Some (ya,yh) => - exists xc yc xf yf, - hs.[xh] = Some (xc,xf) - /\ hs.[yh] = Some (yc,yf) - /\ if yf = Known - then m2.[(xa,xc)] = Some (ya,yc) - /\ xf = Known - else exists p v b, - ro.[rcons p b] = Some ya - /\ build_hpath mh p = Some (v,xh) - /\ xa = v +^ b) - & (forall p xa b, - ro.[rcons p xa] = Some b <=> - exists v xh yh, - build_hpath mh p = Some (v,xh) - /\ mh.[(v +^ xa,xh)] = Some (b,yh)) - & (forall c p v, - pi.[c] = Some (p,v) <=> - exists h, - build_hpath mh p = Some(v,h) - /\ hs.[h] = Some (c,Known)) - & (huniq hs) - & (hs.[0] = Some (c0,Known)) - & (forall h, mem (dom hs) h => h < ch). - -(* inductive eqm_handles (handles:handles) (m:smap) (mh:hsmap) = *) -(* | MH of (forall bc bc', m.[bc] = Some bc' => *) -(* exists h h' f f', *) -(* handles.[h ] = Some(bc .`2,f ) /\ *) -(* handles.[h'] = Some(bc'.`2,f') /\ *) -(* mh.[(bc.`1, h)] = Some (bc'.`1,h')) *) -(* & (forall bh bh', mh.[bh] = Some bh' => *) -(* exists c c' f f', *) -(* handles.[bh .`2] = Some(c ,f) /\ *) -(* handles.[bh'.`2] = Some(c',f') /\ *) -(* m.[(bh.`1, c)] = Some (bh'.`1,c')). *) - -(* inductive mh_spec (handles:handles) (m2:smap) (mh:hsmap) (ro:(block list, block)fmap) = *) -(* | H of (forall bh bh', mh.[bh] = Some bh' => *) -(* exists c c' f f', *) -(* handles.[bh .`2]=Some(c,f) /\ *) -(* handles.[bh'.`2]=Some(c',f') /\ *) -(* if f' = Known *) -(* then m2.[(bh.`1,c)] = Some(bh'.`1,c') /\ f = Known *) -(* else exists p v b, *) -(* ro.[rcons p b] = Some bh'.`1 /\ *) -(* build_hpath mh p = Some(v,bh.`2) /\ *) -(* bh.`1 = v +^ b) *) -(* & (forall p b, mem (dom ro) (rcons p b) <=> *) -(* exists v h h', *) -(* build_hpath mh p = Some (v,h) /\ *) -(* mh.[(v +^ b,h)] = Some (oget ro.[rcons p b], h')). *) - -(* inductive paths_spec (handles:handles) (mh:hsmap) (paths:(capacity,block list * block)fmap) = *) -(* | P of (forall c p v, paths.[c] = Some(p,v) <=> *) -(* exists h, *) -(* build_hpath mh p = Some(v,h) /\ *) -(* handles.[h] = Some(c,Known)). *) - -(* inductive handles_spec handles chandle = *) -(* | Hs of (huniq handles) *) -(* & (handles.[0] = Some (c0,Known)) *) -(* & (forall h, mem (dom handles) h => h < chandle). *) - -(* inductive INV_CF_G1 (handles:handles) chandle (m1 mi1 m2 mi2:smap) (mh2 mhi2:hsmap) (ro:(block list, block) fmap) paths = *) -(* | CF_G1 of (eqm_handles handles m1 mh2) *) -(* & (eqm_handles handles mi1 mhi2) *) -(* & (incl m2 m1) *) -(* & (incl mi2 mi1) *) -(* & (mh_spec handles m2 mh2 ro) *) -(* & (paths_spec handles mh2 paths) *) -(* & (handles_spec handles chandle). *) - -(* lemma eqm_of_INV (chandle : handle) *) -(* (mi1 m2 mi2 : smap) (mhi2 : hsmap) *) -(* (ro : (block list, block) fmap) *) -(* (paths : (capacity, block list * block) fmap) *) -(* handles m1 mh2: *) -(* INV_CF_G1 handles chandle m1 mi1 m2 mi2 mh2 mhi2 ro paths => *) -(* eqm_handles handles m1 mh2. *) -(* proof. by case. qed. *) - -(* lemma eqmi_of_INV (chandle : handle) *) -(* (m1 m2 mi2 : smap) (mh2 : hsmap) *) -(* (ro : (block list, block) fmap) *) -(* (paths : (capacity, block list * block) fmap) *) -(* handles mi1 mhi2: *) -(* INV_CF_G1 handles chandle m1 mi1 m2 mi2 mh2 mhi2 ro paths => *) -(* eqm_handles handles mi1 mhi2. *) -(* proof. by case. qed. *) - -(* lemma incl_of_INV (handles : handles) (chandle : handle) *) -(* (mi1 mi2 : smap) (mh2 mhi2: hsmap) *) -(* (ro : (block list, block) fmap) *) -(* (paths : (capacity, block list * block) fmap) *) -(* m1 m2: *) -(* INV_CF_G1 handles chandle m1 mi1 m2 mi2 mh2 mhi2 ro paths => *) -(* incl m2 m1. *) -(* proof. by case. qed. *) - -(* lemma incli_of_INV (handles : handles) (chandle : handle) *) -(* (m1 m2 : smap) (mh2 mhi2: hsmap) *) -(* (ro : (block list, block) fmap) *) -(* (paths : (capacity, block list * block) fmap) *) -(* mi1 mi2: *) -(* INV_CF_G1 handles chandle m1 mi1 m2 mi2 mh2 mhi2 ro paths => *) -(* incl mi2 mi1. *) -(* proof. by case. qed. *) - -(* lemma mh_of_INV (chandle : handle) *) -(* (m1 mi1 mi2 : smap) (mhi2 : hsmap) *) -(* (paths : (capacity, block list * block) fmap) *) -(* handles m2 mh2 ro: *) -(* INV_CF_G1 handles chandle m1 mi1 m2 mi2 mh2 mhi2 ro paths => *) -(* mh_spec handles m2 mh2 ro. *) -(* proof. by case. qed. *) - -(* lemma paths_of_INV (chandle : handle) *) -(* (m1 m2 mi1 mi2: smap) (mhi2: hsmap) *) -(* (ro : (block list, block) fmap) *) -(* handles mh2 paths: *) -(* INV_CF_G1 handles chandle m1 mi1 m2 mi2 mh2 mhi2 ro paths => *) -(* paths_spec handles mh2 paths. *) -(* proof. by case. qed. *) - -(* lemma handles_of_INV (m1 m2 mi1 mi2 : smap) (mh2 mhi2 : hsmap) *) -(* (ro : (block list, block) fmap) *) -(* (paths : (capacity, block list * block) fmap) *) -(* handles chandle: *) -(* INV_CF_G1 handles chandle m1 mi1 m2 mi2 mh2 mhi2 ro paths => *) -(* handles_spec handles chandle. *) -(* proof. by case. qed. *) - -(* lemma eqm_dom_mh_m handles m mh hx2 f (x:state): *) -(* eqm_handles handles m mh => *) -(* handles.[hx2] = Some (x.`2, f) => *) -(* mem (dom mh) (x.`1, hx2) => mem (dom m) x. *) -(* proof. *) -(* move=>[]H1 H2 Hhx2;rewrite !in_dom. *) -(* case: (mh.[_]) (H2 (x.`1,hx2))=> //= bh' /(_ bh') [c c' f1 f1']. *) -(* by rewrite Hhx2=> /= -[][]<<- _;case:(x)=> ??[]_->. *) -(* qed. *) - -(* lemma chandle_ge0 handles chandle : handles_spec handles chandle => 0 < chandle. *) -(* proof. by case=> _ Heq Hlt; apply Hlt; rewrite in_dom Heq. qed. *) - -(* lemma chandle_0 handles chandle : handles_spec handles chandle => 0 <> chandle. *) -(* proof. by move=> Hh;apply/ltr_eqF/(@chandle_ge0 _ _ Hh). qed. *) - -(* lemma eqm_up_handles handles chandle m mh x2 : *) -(* handles_spec handles chandle => *) -(* eqm_handles handles m mh => *) -(* eqm_handles handles.[chandle <- (x2, Known)] m mh. *) -(* proof. *) -(* case=> Hu Hh0 Hlt [] m_some mh_some; split. *) -(* + move=> bc bc' /m_some [h h' f f'] [#] Hh Hh' Hmh. *) -(* exists h, h', f, f'; rewrite !getP Hmh -Hh -Hh' /=. *) -(* rewrite ltr_eqF /=; 1:by apply/Hlt; rewrite in_dom Hh. *) -(* by rewrite ltr_eqF; 1:by apply/Hlt; rewrite in_dom Hh'. *) -(* move=> bh bh' /mh_some [c c' f f'] [#] Hh Hh' Hm. *) -(* exists c, c', f, f'; rewrite !getP Hm -Hh -Hh'. *) -(* rewrite ltr_eqF /=; 1:by apply/Hlt; rewrite in_dom Hh. *) -(* by rewrite ltr_eqF; 1:by apply/Hlt; rewrite in_dom Hh'. *) -(* qed. *) - -(* lemma mh_up_handles handles chandle m2 mh ro cf: *) -(* handles_spec handles chandle => *) -(* mh_spec handles m2 mh ro => *) -(* mh_spec handles.[chandle <- cf] m2 mh ro. *) -(* proof. *) -(* move=> + [] mh_some ?=> -[] _ _ Hlt; split=> // bh bh' /mh_some [c c' f f'] [#] Hh Hh' Hif. *) -(* exists c,c',f,f'; rewrite Hif -Hh -Hh' !getP. *) -(* rewrite ltr_eqF /=; 1:by apply/Hlt; rewrite in_dom Hh. *) -(* by rewrite ltr_eqF; 1:by apply/Hlt; rewrite in_dom Hh'. *) -(* qed. *) - -(* lemma paths_up_handles m2 ro handles mh paths cf chandle: *) -(* mh_spec handles m2 mh ro => *) -(* handles_spec handles chandle => *) -(* paths_spec handles mh paths => *) -(* paths_spec handles.[chandle <- cf] mh paths. *) -(* proof. *) -(* move=> Hmh Hh [] Hp; split=> c p v; rewrite Hp; apply exists_iff=> x /=. *) -(* split=>- [] ^Hbu -> /=; rewrite getP. *) -(* + case: Hh=> _ _ Hlt x_in_handles. *) -(* by rewrite ltr_eqF; 1:by apply/Hlt; rewrite in_dom x_in_handles. *) -(* case: (x = chandle)=> //=. *) -(* move: Hbu=> /build_hpathP [[#] _ _ ->|[p' b v' h' [#] _ _ Hh']]. *) -(* + by rewrite (@chandle_0 _ _ Hh). *) -(* case: Hh=> _ _ /(_ x) Hlt; rewrite ltr_eqF //. *) -(* by apply/Hlt; rewrite in_dom; case: Hmh=> /(_ _ _ Hh') [????] [#] _ ->. *) -(* qed. *) - -(* lemma handles_up_handles handles chandle x2 f': *) -(* (forall (f : flag), ! mem (rng handles) (x2, f)) => *) -(* handles_spec handles chandle => *) -(* handles_spec handles.[chandle <- (x2, f')] (chandle + 1). *) -(* proof. *) -(* move=> Hx2 ^Hh [] Hu Hh0 Hlt; split. *) -(* + move=> h1 h2 [c1 f1] [c2 f2]; rewrite !getP /=. *) -(* case: (h1 = chandle)=> /= [-> [] ->> ->|_]; (case: (h2 = chandle)=> [-> //= |_]). *) -(* + by move=> Heq ->>; move: (Hx2 f2); rewrite in_rng negb_exists=> /= /(_ h2). *) -(* + by move=> Heq [] ->> <<- ->>; move: (Hx2 f1); rewrite in_rng negb_exists=> /= /(_ h1). *) -(* by apply Hu. *) -(* + by rewrite getP (@chandle_0 _ _ Hh). *) -(* + by move=> h; rewrite dom_set !inE /#. *) -(* qed. *) - -(* lemma INV_CF_G1_up_handles handles chandle m1 mi1 m2 mi2 mh mhi ro paths x2: *) -(* INV_CF_G1 handles chandle m1 mi1 m2 mi2 mh mhi ro paths => *) -(* (forall f, ! mem (rng handles) (x2, f)) => *) -(* INV_CF_G1 handles.[chandle <- (x2, Known)](chandle+1) m1 mi1 m2 mi2 mh mhi ro paths. *) -(* proof. *) -(* case=> Heqm Heqmi Hincl Hincli Hmh Hp Hh Hx2; split. *) -(* + exact/eqm_up_handles. *) -(* + exact/eqm_up_handles. *) -(* + done. *) -(* + done. *) -(* + exact/mh_up_handles. *) -(* + exact/(paths_up_handles m2 ro). *) -(* exact/handles_up_handles. *) -(* qed. *) - -(* lemma eqm_handles_up (handles : handles) m mh (h hx:handle) (x y : state) f: *) -(* huniq handles => *) -(* handles.[h] = None => *) -(* handles.[hx] = Some (x.`2, f) => *) -(* eqm_handles handles m mh => *) -(* eqm_handles handles.[h <- (y.`2,Known)] m.[x <- y] mh.[(x.`1,hx) <- (y.`1,h)]. *) -(* proof. *) -(* move=> uniq_h h_h h_hx @/eqm_handles [] hmmh hmhm; split. *) -(* + move=> bc bc'; rewrite getP; case (bc = x)=> /= [->> <<- {bc bc'}|]. *) -(* * by exists hx, h, f, Known; rewrite !getP /= [smt (in_dom)]. *) -(* move=> bc_neq_x /hmmh [] h0 h0' f0 f0' [#] h_h0 h_h0' mhi_bc. *) -(* by exists h0, h0', f0, f0'; rewrite !getP [smt (in_dom)]. *) -(* move=> bh bh'; rewrite getP; case (bh = (x.`1,hx))=> /= [->> <<- {bh bh'}|]. *) -(* * by exists x.`2, y.`2, f, Known; rewrite !getP [smt (in_dom)]. *) -(* case bh=> b h0 /=. *) -(* rewrite anda_and negb_and=> bh_neq_x1hx /hmhm /= [] c0 c0' f0 f0' [#] h_h0 h_bh' m_bc. *) -(* exists c0, c0', f0, f0'; rewrite !getP. *) -(* split; 1:smt (in_dom). *) -(* split; 1:smt (in_dom). *) -(* case x bh_neq_x1hx h_hx=> x1 x2 /= => - [/#|h0_neq_hx h_hx]. *) -(* have -> //=: c0 <> x2; move: h0_neq_hx; apply/contra. *) -(* exact/(@uniq_h _ _ _ _ h_h0 h_hx). *) -(* qed. *) - -(* lemma eqmi_handles_up (handles : handles) mi mhi (h hx : handle) (x y : state) f: *) -(* (!exists f', mem (rng handles) (y.`2,f')) => *) -(* handles.[h] = None => *) -(* handles.[hx] = Some (x.`2, f) => *) -(* eqm_handles handles mi mhi => *) -(* eqm_handles handles.[h <- (y.`2,Known)] mi.[y <- x] mhi.[(y.`1,h) <- (x.`1,hx)]. *) -(* proof. *) -(* move=> y_notinr1_handles h_h h_hx @/eqm_handles [] hmmh hmhm; split. *) -(* + move=> bc bc'; rewrite getP; case (bc = y)=> /= [->> <<- {bc bc'}|]. *) -(* * by exists h, hx, Known, f; rewrite !getP /= [smt (in_dom)]. *) -(* move=> bc_neq_y /hmmh [] h0 h0' f0 f0' [#] h_h0 h_h0' mhi_bc. *) -(* by exists h0, h0', f0, f0'; rewrite !getP [smt (in_dom)]. *) -(* move=> bh bh'; rewrite getP; case (bh = (y.`1,h))=> /= [->> <<- {bh bh'}|]. *) -(* * by exists y.`2, x.`2, Known, f; rewrite !getP [smt (in_dom)]. *) -(* case bh=> b h0 /=. *) -(* rewrite anda_and negb_and=> bh_neq_y1h /hmhm /= [] c0 c0' f0 f0' [#] h_bh h_bh' mi_bh. *) -(* exists c0, c0', f0, f0'; rewrite !getP. *) -(* split; 1:smt (in_dom). *) -(* split; 1:smt (in_dom). *) -(* case y bh_neq_y1h y_notinr1_handles=> y1 y2 /= [/#|h0_neq_h y_notinr1_handles]. *) -(* have /#: c0 = y2 => false; move=> /(congr1 (fun x=> exists f', mem (rng handles) (x,f'))) /=. *) -(* rewrite y_notinr1_handles /= neqF /=; exists f0. *) -(* by rewrite in_rng; exists h0. *) -(* qed. *) - -(* lemma incl_set (m m' : ('a,'b) fmap) x y: *) -(* incl m m' => *) -(* incl m.[x <- y] m'.[x <- y]. *) -(* proof. smt (in_dom getP). qed. *) - -(* lemma hinv_notin_rng m y2: *) -(* SLCommon.hinv m y2 = None => *) -(* (forall h f, m.[h] <> Some (y2,f)). *) -(* proof. by move=> hinv_none; have:= hinvP m y2; rewrite hinv_none. qed. *) - -(* lemma handles_spec_notin_dom m h: *) -(* handles_spec m h => *) -(* !mem (dom m) h. *) -(* proof. case; smt (in_dom). qed. *) - -(* lemma neq_Known f: f <> Known <=> f = Unknown. *) -(* proof. by case f. qed. *) - -(* lemma neq_Unkwown f: f <> Unknown <=> f = Known. *) -(* proof. by case f. qed. *) +inductive eqm_handles (hs : handles) (m : smap) (mh : hsmap) = + | MH of (forall xa xc ya yc, + m.[(xa,xc)] = Some (ya,yc) => + exists xh yh xf yf, + hs.[xh] = Some (xc,xf) + /\ hs.[yh] = Some (yc,yf) + /\ mh.[(xa,xh)] = Some (ya,yh)) + & (forall xa xh ya yh, + mh.[(xa,xh)] = Some (ya,yh) => + exists xc yc xf yf, + hs.[xh] = Some (xc,xf) + /\ hs.[yh] = Some (yc,yf) + /\ m.[(xa,xc)] = Some (ya,yc)). + +inductive mh_spec (hs : handles) (m2 : smap) (mh : hsmap) (ro : (block list,block) fmap) = + | H of (forall xa xh ya yh, + mh.[(xa,xh)] = Some (ya,yh) => + exists xc yc xf yf, + hs.[xh] = Some (xc,xf) + /\ hs.[yh] = Some (yc,yf) + /\ if yf = Known + then m2.[(xa,xc)] = Some (ya,yc) + /\ xf = Known + else exists p v b, + ro.[rcons p b] = Some ya + /\ build_hpath mh p = Some (v,xh) + /\ xa = v +^ b) + & (forall p xa b, + ro.[rcons p xa] = Some b <=> + exists v xh yh, + build_hpath mh p = Some (v,xh) + /\ mh.[(v +^ xa,xh)] = Some (b,yh)). + +inductive paths_spec (hs : handles) (mh : hsmap) (pi : (capacity,block list*block) fmap) = + | P of (forall c p v, + pi.[c] = Some (p,v) <=> + exists h, + build_hpath mh p = Some(v,h) + /\ hs.[h] = Some (c,Known)). + +inductive handles_spec hs ch = + | Hs of (huniq hs) + & (hs.[0] = Some (c0,Known)) + & (forall h, mem (dom hs) h => h < ch). + +inductive INV_CF_G1 (hs : handles) ch (m1 mi1 m2 mi2 : smap) + (mh2 mhi2 : hsmap) (ro : (block list,block) fmap) pi = + | HCF_G1 of (eqm_handles hs m1 mh2) + & (eqm_handles hs mi1 mhi2) + & (incl m2 m1) + & (incl mi2 mi1) + & (mh_spec hs m2 mh2 ro) + & (paths_spec hs mh2 pi) + & (handles_spec hs ch). + +lemma eqm_of_INV (ch : handle) + (mi1 m2 mi2 : smap) (mhi2 : hsmap) + (ro : (block list, block) fmap) + (pi : (capacity, block list * block) fmap) + hs m1 mh2: + INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi => + eqm_handles hs m1 mh2. +proof. by case. qed. + +lemma eqmi_of_INV (ch : handle) + (m1 m2 mi2 : smap) (mh2 : hsmap) + (ro : (block list, block) fmap) + (pi : (capacity, block list * block) fmap) + hs mi1 mhi2: + INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi => + eqm_handles hs mi1 mhi2. +proof. by case. qed. + +lemma incl_of_INV (hs : handles) (ch : handle) + (mi1 mi2 : smap) (mh2 mhi2: hsmap) + (ro : (block list, block) fmap) + (pi : (capacity, block list * block) fmap) + m1 m2: + INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi => + incl m2 m1. +proof. by case. qed. + +lemma incli_of_INV (hs : handles) (ch : handle) + (m1 m2 : smap) (mh2 mhi2: hsmap) + (ro : (block list, block) fmap) + (pi : (capacity, block list * block) fmap) + mi1 mi2: + INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi => + incl mi2 mi1. +proof. by case. qed. + +lemma mh_of_INV (ch : handle) + (m1 mi1 mi2 : smap) (mhi2 : hsmap) + (pi : (capacity, block list * block) fmap) + hs m2 mh2 ro: + INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi => + mh_spec hs m2 mh2 ro. +proof. by case. qed. + +lemma paths_of_INV (ch : handle) + (m1 m2 mi1 mi2: smap) (mhi2: hsmap) + (ro : (block list, block) fmap) + hs mh2 pi: + INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi => + paths_spec hs mh2 pi. +proof. by case. qed. + +lemma handles_of_INV (m1 m2 mi1 mi2 : smap) (mh2 mhi2 : hsmap) + (ro : (block list, block) fmap) + (pi : (capacity, block list * block) fmap) + hs ch: + INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi => + handles_spec hs ch. +proof. by case. qed. + +lemma eqm_dom_mh_m hs m mh hx2 f (x:state): + eqm_handles hs m mh => + hs.[hx2] = Some (x.`2, f) => + mem (dom mh) (x.`1, hx2) => mem (dom m) x. +proof. +move=>[]H1 H2 Hhx2;rewrite !in_dom. +case: (mh.[_]) (H2 x.`1 hx2) => //= -[] b' h' /(_ b' h') [c c' f1 f1']. +by rewrite Hhx2=> /= -[][]<<- _;case:(x)=> ??[]_->. +qed. + +lemma chandle_ge0 hs ch : handles_spec hs ch => 0 < ch. +proof. by case=> _ Heq Hlt; apply Hlt; rewrite in_dom Heq. qed. + +lemma chandle_0 hs ch : handles_spec hs ch => 0 <> ch. +proof. by move=> Hh;apply/ltr_eqF/(@chandle_ge0 _ _ Hh). qed. + +lemma eqm_up_handles hs ch m mh x2 : + handles_spec hs ch => + eqm_handles hs m mh => + eqm_handles hs.[ch <- (x2, Known)] m mh. +proof. +case=> Hu Hh0 Hlt [] m_some mh_some; split. ++ move=> xb xc xb' xc' /m_some [h h' f f'] [#] Hh Hh' Hmh. + exists h, h', f, f'; rewrite !getP Hmh -Hh -Hh' /=. + rewrite ltr_eqF /=; 1:by apply/Hlt; rewrite in_dom Hh. + by rewrite ltr_eqF; 1:by apply/Hlt; rewrite in_dom Hh'. +move=> xb xh xb' xh' /mh_some [c c' f f'] [#] Hh Hh' Hm. +exists c, c', f, f'; rewrite !getP Hm -Hh -Hh'. +rewrite ltr_eqF /=; 1:by apply/Hlt; rewrite in_dom Hh. +by rewrite ltr_eqF; 1:by apply/Hlt; rewrite in_dom Hh'. +qed. + +lemma mh_up_handles hs ch m2 mh ro cf: + handles_spec hs ch => + mh_spec hs m2 mh ro => + mh_spec hs.[ch <- cf] m2 mh ro. +proof. +move=> + [] mh_some ?=> -[] _ _ Hlt; split=> // b h b' h' /mh_some [c c' f f'] [#] Hh Hh' Hif. +exists c,c',f,f'; rewrite Hif -Hh -Hh' !getP. +rewrite ltr_eqF /=; 1:by apply/Hlt; rewrite in_dom Hh. +by rewrite ltr_eqF; 1:by apply/Hlt; rewrite in_dom Hh'. +qed. + +lemma paths_up_handles m2 ro hs mh pi cf ch: + mh_spec hs m2 mh ro => + handles_spec hs ch => + paths_spec hs mh pi => + paths_spec hs.[ch <- cf] mh pi. +proof. +move=> Hmh Hh [] Hp; split=> c p v; rewrite Hp; apply exists_iff=> x /=. +split=>- [] ^Hbu -> /=; rewrite getP. ++ case: Hh=> _ _ Hlt x_in_handles. + by rewrite ltr_eqF; 1:by apply/Hlt; rewrite in_dom x_in_handles. +case: (x = ch)=> //=. +move: Hbu=> /build_hpathP [[#] _ _ ->|[p' b v' h' [#] _ _ Hh']]. ++ by rewrite (@chandle_0 _ _ Hh). +case: Hh=> _ _ /(_ x) Hlt; rewrite ltr_eqF //. +by apply/Hlt; rewrite in_dom; case: Hmh=> /(_ _ _ _ _ Hh') [????] [#] _ ->. +qed. + +lemma handles_up_handles hs ch x2 f': + (forall (f : flag), ! mem (rng hs) (x2, f)) => + handles_spec hs ch => + handles_spec hs.[ch <- (x2, f')] (ch + 1). +proof. +move=> Hx2 ^Hh [] Hu Hh0 Hlt; split. ++ move=> h1 h2 [c1 f1] [c2 f2]; rewrite !getP /=. + case: (h1 = ch)=> /= [-> [] ->> ->|_]; (case: (h2 = ch)=> [-> //= |_]). + + by move=> Heq ->>; move: (Hx2 f2); rewrite in_rng negb_exists=> /= /(_ h2). + + by move=> Heq [] ->> <<- ->>; move: (Hx2 f1); rewrite in_rng negb_exists=> /= /(_ h1). + by apply Hu. ++ by rewrite getP (@chandle_0 _ _ Hh). ++ by move=> h; rewrite dom_set !inE /#. +qed. + +lemma INV_CF_G1_up_handles hs ch m1 mi1 m2 mi2 mh mhi ro pi x2: + INV_CF_G1 hs ch m1 mi1 m2 mi2 mh mhi ro pi => + (forall f, !mem (rng hs) (x2, f)) => + INV_CF_G1 hs.[ch <- (x2, Known)] (ch + 1) m1 mi1 m2 mi2 mh mhi ro pi. +proof. +case=> Heqm Heqmi Hincl Hincli Hmh Hp Hh Hx2. +exact/(HCF_G1 (eqm_up_handles Hh Heqm) (eqm_up_handles Hh Heqmi) + _ _ + (:@mh_up_handles _ _ _ _ _ (x2,Known) Hh Hmh) + (:@paths_up_handles m2 ro _ _ _ (x2,Known) _ Hmh Hh Hp) + (:@handles_up_handles _ _ x2 Known _ Hh)). +qed. + +lemma eqm_handles_up (hs : handles) m mh (h hx:handle) (x y : state) f: + huniq hs => + hs.[h] = None => + hs.[hx] = Some (x.`2, f) => + eqm_handles hs m mh => + eqm_handles hs.[h <- (y.`2,Known)] m.[x <- y] mh.[(x.`1,hx) <- (y.`1,h)]. +proof. +move=> uniq_h h_h h_hx @/eqm_handles [] hmmh hmhm; split. ++ move=> b c b' c'; rewrite getP; case ((b,c) = x)=> /= [<<- ->> {x y} /=|]. + * by exists hx, h, f, Known; rewrite !getP /= [smt (in_dom)]. + move=> bc_neq_x /hmmh [] h0 h0' f0 f0' [#] h_h0 h_h0' mhi_bc. + by exists h0, h0', f0, f0'; rewrite !getP [smt (in_dom)]. +move=> xb xh b' h'; rewrite getP; case ((xb,xh) = (x.`1,hx))=> /= [[#] <*> [#] <*>|]. + * by exists x.`2, y.`2, f, Known; rewrite !getP [smt (in_dom)]. +rewrite anda_and negb_and=> bh_neq_x1hx /hmhm /= [] c0 c0' f0 f0' [#] h_h0 h_bh' m_bc. +exists c0, c0', f0, f0'; rewrite !getP. +split; 1:smt (in_dom). +split; 1:smt (in_dom). +case x bh_neq_x1hx h_hx=> x1 x2 /= => - [/#|h0_neq_hx h_hx]. +have -> //=: c0 <> x2; move: h0_neq_hx; apply/contra. +exact/(@uniq_h _ _ _ _ h_h0 h_hx). +qed. + +lemma eqmi_handles_up (hs : handles) mi mhi (h hx : handle) (x y : state) f: + (!exists f', mem (rng hs) (y.`2,f')) => + hs.[h] = None => + hs.[hx] = Some (x.`2, f) => + eqm_handles hs mi mhi => + eqm_handles hs.[h <- (y.`2,Known)] mi.[y <- x] mhi.[(y.`1,h) <- (x.`1,hx)]. +proof. +move=> y_notinr1_handles h_h h_hx @/eqm_handles [] hmmh hmhm; split. ++ move=> xb xc xb' xc'; rewrite getP; case ((xb,xc) = y)=> /= [<<- ->> {x y}|]. + * by exists h, hx, Known, f; rewrite !getP /= [smt (in_dom)]. + move=> bc_neq_y /hmmh [] h0 h0' f0 f0' [#] h_h0 h_h0' mhi_bc. + by exists h0, h0', f0, f0'; rewrite !getP [smt (in_dom)]. +move=> xb xh xb' xh'; rewrite getP; case ((xb,xh) = (y.`1,h))=> /= [[#] <*> [#] <*>|]. + * by exists y.`2, x.`2, Known, f; rewrite !getP [smt (in_dom)]. +rewrite anda_and negb_and=> bh_neq_y1h /hmhm /= [] c0 c0' f0 f0' [#] h_bh h_bh' mi_bh. +exists c0, c0', f0, f0'; rewrite !getP. +split; 1:smt (in_dom). +split; 1:smt (in_dom). +case y bh_neq_y1h y_notinr1_handles=> y1 y2 /= [/#|h0_neq_h y_notinr1_handles]. +have /#: c0 = y2 => false; move=> /(congr1 (fun x=> exists f', mem (rng hs) (x,f'))) /=. +rewrite y_notinr1_handles /= neqF /=; exists f0. +by rewrite in_rng; exists xh. +qed. + +lemma incl_set (m m' : ('a,'b) fmap) x y: + incl m m' => + incl m.[x <- y] m'.[x <- y]. +proof. smt (in_dom getP). qed. + +lemma hinv_notin_rng m y2: + SLCommon.hinv m y2 = None => + (forall h f, m.[h] <> Some (y2,f)). +proof. by move=> hinv_none; have:= hinvP m y2; rewrite hinv_none. qed. + +lemma handles_spec_notin_dom m h: + handles_spec m h => + !mem (dom m) h. +proof. case; smt (in_dom). qed. + +lemma neq_Known f: f <> Known <=> f = Unknown. +proof. by case f. qed. + +lemma neq_Unkwown f: f <> Unknown <=> f = Known. +proof. by case f. qed. op getflag (hs : handles) xc = omap snd (obind ("_.[_]" hs) (hinv hs xc)). -(* lemma getflagP hs xc f: *) -(* huniq hs => *) -(* (mem (rng hs) (xc,f) <=> getflag hs xc = Some f). *) -(* proof. *) -(* move=> huniq_hs; split. *) -(* + rewrite in_rng=> -[h] hs_h. *) -(* move: (hinvP hs xc)=> [_ /(_ h f) //|]. *) -(* rewrite /getflag; case: (hinv hs xc)=> // h' _ [f']; rewrite oget_some. *) -(* move=> /(huniq_hs _ h _ (xc,f)) /(_ hs_h) /= ->>. *) -(* by rewrite hs_h. *) -(* rewrite /getflag; case: (hinvP hs xc)=> [-> //|]. *) -(* rewrite in_rng; case: (hinv hs xc)=> //= h [f']. *) -(* rewrite oget_some=> ^ hs_h -> @/snd /= ->>. *) -(* by exists h. *) -(* qed. *) - -(* lemma paths_prefix handles m2 mh ro paths c b p v: *) -(* mh_spec handles m2 mh ro => *) -(* paths_spec handles mh paths => *) -(* paths.[c] = Some (rcons p b,v) => *) -(* (exists c' v', paths.[c'] = Some (p,v')). *) -(* proof. *) -(* move=> [] mh_some _ [] hpaths ^paths_c. *) -(* move=> /hpaths [h] [#] /build_hpathP [/#|] [p' b' v' h'] [#] ^/rconsIs + /rconssI- <*>. *) -(* move=> hpath + handles_h - /mh_some /= [c' c0 f' f]; rewrite handles_h /= => /> handles_h' _. *) -(* by exists c', v'; rewrite hpaths; exists h'. *) -(* qed. *) +lemma getflagP hs xc f: + huniq hs => + (mem (rng hs) (xc,f) <=> getflag hs xc = Some f). +proof. +move=> huniq_hs; split. ++ rewrite in_rng=> -[h] hs_h. + move: (hinvP hs xc)=> [_ /(_ h f) //|]. + rewrite /getflag; case: (hinv hs xc)=> // h' _ [f']; rewrite oget_some. + move=> /(huniq_hs _ h _ (xc,f)) /(_ hs_h) /= ->>. + by rewrite hs_h. +rewrite /getflag; case: (hinvP hs xc)=> [-> //|]. +rewrite in_rng; case: (hinv hs xc)=> //= h [f']. +rewrite oget_some=> ^ hs_h -> @/snd /= ->>. +by exists h. +qed. + +lemma paths_prefix handles m2 mh ro paths c b p v: + mh_spec handles m2 mh ro => + paths_spec handles mh paths => + paths.[c] = Some (rcons p b,v) => + (exists c' v', paths.[c'] = Some (p,v')). +proof. +move=> [] mh_some _ [] hpaths ^paths_c. +move=> /hpaths [h] [#] /build_hpathP [/#|] [p' b' v' h'] [#] ^/rconsIs + /rconssI- <*>. +move=> hpath + handles_h - /mh_some /= [c' c0 f' f]; rewrite handles_h /= => /> handles_h' _. +by exists c', v'; rewrite hpaths; exists h'. +qed. lemma build_hpath_prefix mh p b v h: build_hpath mh (rcons p b) = Some (v,h) => @@ -504,6 +466,17 @@ qed. clone export ConcreteF as ConcreteF1. +inductive if_ind (b t e: bool) = + | Then of b & (b => t) + | Else of (!b) & (!b => e). + +lemma ifP (b t e : bool): (if b then t else e) <=> if_ind b t e. +proof. +split; case: b=> _ => [t_|e_|[]//|[]//]. ++ exact/Then. +exact/Else. +qed. + section AUX. declare module D : DISTINGUISHER {PF, RO, G1}. @@ -517,7 +490,8 @@ section AUX. proof. proc. call (_: G1.bcol \/ G1.bext, - invariant FRO.m{2} G1.chandle{2} PF.m{1} G1.m{2} G1.mh{2} F.RO.m{2} G1.paths{2}). + INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} + G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2}). (* lossless D *) + exact/D_ll. (** proofs for G1.S.f *) @@ -531,7 +505,7 @@ section AUX. seq 2 3: ( !G1.bcol{2} /\ (G1.bext <=> mem (rng FRO.m) (x.`2, Unknown)){2} /\ ={x,y1,y2} - /\ invariant FRO.m{2} G1.chandle{2} PF.m{1} G1.m{2} G1.mh{2} ro0 G1.paths{2} + /\ INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} ro0 G1.paths{2} /\ ! mem (dom PF.m{1}) x{1} /\ (if mem (dom G1.paths) x.`2 then let (p,v) = oget G1.paths.[x.`2] in @@ -541,7 +515,7 @@ section AUX. + by auto=> |> &1 &2; rewrite negb_or; case=> -> ->. inline{2} F.RO.get; rcondt{2} 4. + auto=> |> &m'; case: (x{m'})=> /= _x1 _x2 _ [] - m_some mh_some leq in_mh in_ro in_pi hs_inj hs0 hs_dom + + r0 _ - {r0} + x2_in_pi. + [] m_some mh_some _ leq _ [] in_mh in_ro [] in_pi [] hs_inj hs0 hs_dom + + r0 _ - {r0} + x2_in_pi. have:= x2_in_pi; rewrite in_dom. case: {-1}(G1.paths.[_x2]{m'}) (eq_refl (G1.paths.[_x2]{m'}))=> //= -[] p v paths_x2. rewrite oget_some /=; have /in_pi [h_x2] [#] pv_hx2 hs_h_x2:= paths_x2. @@ -556,6 +530,12 @@ section AUX. move=> [p v] paths_x2 y1' _ y2' _; rewrite oget_some /=. rewrite getP /= oget_some /= => x1 x2 [] <- <-. by rewrite getP /= oget_some. + auto=> &1 &2; case: (x{2})=> [] x1 x2 /= [#] not_bcol bext_upd <*>. + rewrite ifP=> Hinv x_notin_PF ROupd. + split=> /= [x2K_notin_rFRO|x2K_in_rFRO]. + + split=> /= [#]. + + admit. + admit. admit. (* swap{2} 3-2;swap{2}6-4;wp;conseq (_:y{1} =(r,y2){2}). + progress [-split];rewrite getP_eq oget_some H2/=. From 81fef50b8a48bfe730ff35fc3e243e62070f49fb Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Mon, 11 Jul 2016 22:50:06 -0400 Subject: [PATCH 175/525] Work in progress on top-level proof; more tomorrow. --- proof/Sponge.ec | 30 ++++++++++++++++++++++++++---- 1 file changed, 26 insertions(+), 4 deletions(-) diff --git a/proof/Sponge.ec b/proof/Sponge.ec index acf6b34..67439ae 100644 --- a/proof/Sponge.ec +++ b/proof/Sponge.ec @@ -647,12 +647,12 @@ wp; exists* i{1}; elim*=> i1; exists* bs{2}; elim*=> bs2. conseq (_ : n1 = n{1} /\ 0 <= n1 /\ i1 = i{1} /\ bs2 = bs{2} /\ xs{1} = x{2} /\ - i{1} = i{2} * r /\ n{1} <= m{1} /\ m{1} - i{1} = r /\ - bs{1} = blocks2bits bs2 /\ + i{1} = i{2} * r /\ n{1} <= m{1} /\ m{1} - i{1} = r /\ i{1} <= n{1} /\ + bs{1} = blocks2bits bs2 /\ size bs{1} = i1 /\ size bs{2} = i{2} /\ EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> bs{1} = blocks2bits bs2 ++ take (n1 - i1) (ofblock b{2}) /\ EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). -progress; smt(). +progress; smt(lez_floor size_blocks2bits). move=> |> &1 &2 ? ? sz_eq ? ? ? mp1 mp2 b ?. split. rewrite -cats1 blocks2bits_cat blocks2bits_sing take_cat. @@ -661,7 +661,29 @@ have -> /= : !(n{1} < size(blocks2bits bs{2})). by smt(needed_blocks_correct). by rewrite size_blocks2bits sz_eq; congr; congr; smt(). by rewrite size_rcons; smt(). -admit. +transitivity{1} + { while (i < m) { + b <@ HybridIROEager.fill_in(xs, i); + bs <- rcons bs b; + i <- i + 1; + } + } + (={bs, m, i, HybridIROEager.mp} /\ n1 = n{1} /\ i1 = i{1} /\ + i1 <= n1 /\ n1 <= m{1} /\ size bs{1} = i1 ==> + ={HybridIROEager.mp} /\ i1 <= n1 /\ bs{1} = take n1 bs{2}) + (n1 = n{1} /\ 0 <= n1 /\ i1 = i{1} /\ i1 <= n1 /\ bs2 = bs{2} /\ + xs{1} = x{2} /\ i{1} = i{2} * r /\ n1 <= m{1} /\ m{1} - i{1} = r /\ + bs{1} = blocks2bits bs2 /\ size(blocks2bits bs2) = i1 /\ + EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + bs{1} = blocks2bits bs2 ++ ofblock b{2} /\ size(blocks2bits bs2) = i1 /\ + n1 - i1 <= size(ofblock b{2}) /\ + EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). +progress; exists HybridIROEager.mp{1}, (blocks2bits bs{2}); + smt(size_blocks2bits). +progress; smt(take_cat). +splitwhile{2} 1 : i < n. +admit. +admit. qed. lemma HybridIROEager_BlockIRO_f : From df648fb4b931b13dd20a8589675809d550cf2e04 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Tue, 12 Jul 2016 14:10:17 -0400 Subject: [PATCH 176/525] More progress on top-level proof. --- proof/Sponge.ec | 48 ++++++++++++++++++++++++++++++++++++++---------- 1 file changed, 38 insertions(+), 10 deletions(-) diff --git a/proof/Sponge.ec b/proof/Sponge.ec index 67439ae..6bdee16 100644 --- a/proof/Sponge.ec +++ b/proof/Sponge.ec @@ -668,21 +668,49 @@ transitivity{1} i <- i + 1; } } - (={bs, m, i, HybridIROEager.mp} /\ n1 = n{1} /\ i1 = i{1} /\ - i1 <= n1 /\ n1 <= m{1} /\ size bs{1} = i1 ==> + (={bs, m, i, xs, HybridIROEager.mp} /\ n1 = n{1} /\ i1 <= n1 /\ + i{1} <= n1 /\ size bs{1} = i{1} /\ n1 <= m{1} ==> ={HybridIROEager.mp} /\ i1 <= n1 /\ bs{1} = take n1 bs{2}) - (n1 = n{1} /\ 0 <= n1 /\ i1 = i{1} /\ i1 <= n1 /\ bs2 = bs{2} /\ - xs{1} = x{2} /\ i{1} = i{2} * r /\ n1 <= m{1} /\ m{1} - i{1} = r /\ - bs{1} = blocks2bits bs2 /\ size(blocks2bits bs2) = i1 /\ + (i1 = i{1} /\ xs{1} = x{2} /\ i{1} = i{2} * r /\ n1 = n{1} /\ + n1 <= m{1} /\ bs{1} = blocks2bits bs2 /\ size(blocks2bits bs2) = i1 /\ EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> bs{1} = blocks2bits bs2 ++ ofblock b{2} /\ size(blocks2bits bs2) = i1 /\ - n1 - i1 <= size(ofblock b{2}) /\ EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). -progress; exists HybridIROEager.mp{1}, (blocks2bits bs{2}); - smt(size_blocks2bits). +progress; + exists HybridIROEager.mp{1}, (blocks2bits bs{2}), n{1}, m{1}, + (size bs{2} * r), x{2}; + smt(). progress; smt(take_cat). -splitwhile{2} 1 : i < n. -admit. +splitwhile{2} 1 : i < n1. +seq 1 1 : + (={HybridIROEager.mp, xs, bs, i, m} /\ i{1} = n1 /\ n1 <= m{1} /\ + i1 <= n1 /\ size bs{1} = n1). +while + (={HybridIROEager.mp, xs, bs, i, m} /\ n{1} = n1 /\ n1 <= m{1} /\ + i{1} <= n1 /\ size bs{1} = i{1}). +wp. +call (_ : ={HybridIROEager.mp}). +if => //; rnd; auto. +skip; smt(size_rcons). +skip; smt(). +while + (={HybridIROEager.mp, xs, i, m} /\ n1 <= m{1} /\ + n1 <= i{1} <= m{1} /\ n1 <= size bs{2} /\ + bs{1} = take n1 bs{2}). +wp. +call (_ : ={HybridIROEager.mp}). +if => //; rnd; auto. +skip; progress; + [smt() | smt() | smt(size_rcons) | + rewrite -cats1 take_cat; + smt(size_rcons take_oversize cats1 cats0)]. +skip; smt(take_size). +conseq + (_ : + xs{1} = x{2} /\ i{1} = i{2} * r /\ bs{1} = blocks2bits bs2 /\ + EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + bs{1} = blocks2bits bs2 ++ ofblock b{2} /\ + EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}) => //. admit. qed. From 404dee2fb6cc5c03fd29a3b255c2d4122838722d Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Tue, 12 Jul 2016 15:32:04 -0400 Subject: [PATCH 177/525] Forgot part of precondition. --- proof/Sponge.ec | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/proof/Sponge.ec b/proof/Sponge.ec index 6bdee16..21b72d7 100644 --- a/proof/Sponge.ec +++ b/proof/Sponge.ec @@ -669,10 +669,11 @@ transitivity{1} } } (={bs, m, i, xs, HybridIROEager.mp} /\ n1 = n{1} /\ i1 <= n1 /\ - i{1} <= n1 /\ size bs{1} = i{1} /\ n1 <= m{1} ==> + i{1} <= n1 /\ n1 <= m{1} /\ size bs{1} = i{1} ==> ={HybridIROEager.mp} /\ i1 <= n1 /\ bs{1} = take n1 bs{2}) (i1 = i{1} /\ xs{1} = x{2} /\ i{1} = i{2} * r /\ n1 = n{1} /\ - n1 <= m{1} /\ bs{1} = blocks2bits bs2 /\ size(blocks2bits bs2) = i1 /\ + n1 <= m{1} /\ m{1} - i{1} = r /\ + bs{1} = blocks2bits bs2 /\ size(blocks2bits bs2) = i1 /\ EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> bs{1} = blocks2bits bs2 ++ ofblock b{2} /\ size(blocks2bits bs2) = i1 /\ EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). @@ -707,7 +708,8 @@ skip; progress; skip; smt(take_size). conseq (_ : - xs{1} = x{2} /\ i{1} = i{2} * r /\ bs{1} = blocks2bits bs2 /\ + xs{1} = x{2} /\ i{1} = i{2} * r /\ m{1} - i{1} = r /\ + bs{1} = blocks2bits bs2 /\ EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> bs{1} = blocks2bits bs2 ++ ofblock b{2} /\ EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}) => //. From 465efbacb88b7f8c867dd790e9ae25db79061768 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Tue, 12 Jul 2016 17:41:48 -0400 Subject: [PATCH 178/525] Refactoring. --- proof/Sponge.ec | 50 +++++++++++++++++++------------------------------ 1 file changed, 19 insertions(+), 31 deletions(-) diff --git a/proof/Sponge.ec b/proof/Sponge.ec index 21b72d7..098e4f6 100644 --- a/proof/Sponge.ec +++ b/proof/Sponge.ec @@ -627,7 +627,8 @@ conseq i{2} = n1 %/ r /\ size bs{2} = i{2} /\ bs{1} = blocks2bits bs{2} /\ EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} /\ (i{2} = n{2} \/ i{2} + 1 = n{2}) ==> - _). + bs{1} = take n1 (blocks2bits bs{2}) /\ size bs{2} = n{2} /\ + EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}) => //. progress; by apply/needed_blocks_rel_div_r. case: (i{2} = n{2}). rcondf{2} 1; first auto; progress; smt(). @@ -643,24 +644,19 @@ by rewrite sz_eq need_blks_eq. rcondt{2} 1; first auto; progress; smt(). rcondf{2} 4; first auto; call (_ : true). if=> //. auto; progress; smt(). -wp; exists* i{1}; elim*=> i1; exists* bs{2}; elim*=> bs2. conseq (_ : - n1 = n{1} /\ 0 <= n1 /\ i1 = i{1} /\ bs2 = bs{2} /\ xs{1} = x{2} /\ - i{1} = i{2} * r /\ n{1} <= m{1} /\ m{1} - i{1} = r /\ i{1} <= n{1} /\ - bs{1} = blocks2bits bs2 /\ size bs{1} = i1 /\ size bs{2} = i{2} /\ + n1 = n{1} /\ 0 <= n1 /\ xs{1} = x{2} /\ i{1} = i{2} * r /\ + n{1} <= m{1} /\ m{1} - i{1} = r /\ i{1} <= n{1} /\ + bs{1} = blocks2bits bs{2} /\ size bs{1} = i{1} /\ size bs{2} = i{2} /\ EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> - bs{1} = blocks2bits bs2 ++ take (n1 - i1) (ofblock b{2}) /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). + bs{1} = take n1 (blocks2bits bs{2}) /\ + EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}) + _ + (_ : size bs = n - 1 ==> size bs = n). progress; smt(lez_floor size_blocks2bits). -move=> |> &1 &2 ? ? sz_eq ? ? ? mp1 mp2 b ?. -split. -rewrite -cats1 blocks2bits_cat blocks2bits_sing take_cat. -have -> /= : !(n{1} < size(blocks2bits bs{2})). - rewrite size_blocks2bits sz_eq. - by smt(needed_blocks_correct). -by rewrite size_blocks2bits sz_eq; congr; congr; smt(). -by rewrite size_rcons; smt(). +smt(). +wp. call (_ : true). auto. skip; smt(size_rcons). transitivity{1} { while (i < m) { b <@ HybridIROEager.fill_in(xs, i); @@ -668,24 +664,23 @@ transitivity{1} i <- i + 1; } } - (={bs, m, i, xs, HybridIROEager.mp} /\ n1 = n{1} /\ i1 <= n1 /\ - i{1} <= n1 /\ n1 <= m{1} /\ size bs{1} = i{1} ==> - ={HybridIROEager.mp} /\ i1 <= n1 /\ bs{1} = take n1 bs{2}) - (i1 = i{1} /\ xs{1} = x{2} /\ i{1} = i{2} * r /\ n1 = n{1} /\ - n1 <= m{1} /\ m{1} - i{1} = r /\ - bs{1} = blocks2bits bs2 /\ size(blocks2bits bs2) = i1 /\ + (={bs, m, i, xs, HybridIROEager.mp} /\ n1 = n{1} /\ i{1} <= n1 /\ + n1 <= m{1} /\ size bs{1} = i{1} ==> + ={HybridIROEager.mp} /\ bs{1} = take n1 bs{2}) + (xs{1} = x{2} /\ i{1} = i{2} * r /\ m{1} - i{1} = r /\ + bs{1} = blocks2bits bs{2} /\ EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> - bs{1} = blocks2bits bs2 ++ ofblock b{2} /\ size(blocks2bits bs2) = i1 /\ + bs{1} = blocks2bits bs{2} /\ EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). progress; - exists HybridIROEager.mp{1}, (blocks2bits bs{2}), n{1}, m{1}, + exists HybridIROEager.mp{1}, (blocks2bits bs{2}), m{1}, (size bs{2} * r), x{2}; smt(). progress; smt(take_cat). splitwhile{2} 1 : i < n1. seq 1 1 : (={HybridIROEager.mp, xs, bs, i, m} /\ i{1} = n1 /\ n1 <= m{1} /\ - i1 <= n1 /\ size bs{1} = n1). + size bs{1} = n1). while (={HybridIROEager.mp, xs, bs, i, m} /\ n{1} = n1 /\ n1 <= m{1} /\ i{1} <= n1 /\ size bs{1} = i{1}). @@ -706,13 +701,6 @@ skip; progress; rewrite -cats1 take_cat; smt(size_rcons take_oversize cats1 cats0)]. skip; smt(take_size). -conseq - (_ : - xs{1} = x{2} /\ i{1} = i{2} * r /\ m{1} - i{1} = r /\ - bs{1} = blocks2bits bs2 /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> - bs{1} = blocks2bits bs2 ++ ofblock b{2} /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}) => //. admit. qed. From 959d672c156e50e4d1464ca69c52e11c41a968fa Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Wed, 13 Jul 2016 09:33:23 -0400 Subject: [PATCH 179/525] More progress on top-level proof. --- proof/Sponge.ec | 143 +++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 142 insertions(+), 1 deletion(-) diff --git a/proof/Sponge.ec b/proof/Sponge.ec index 098e4f6..a349a60 100644 --- a/proof/Sponge.ec +++ b/proof/Sponge.ec @@ -570,6 +570,88 @@ sp; wp; if=> //; rnd; auto. auto. qed. +(* modules needed for applying transitivity tactic *) + +module HybridIROEagerTrans = { + (* from HybridIROEager; need copy for transitivity + to work *) + + proc g(xs, n) = { + var b, bs; + var m <- ((n + r - 1) %/ r) * r; + var i <- 0; + + bs <- []; + if (valid_block xs) { + while (i < n) { + b <@ HybridIROEager.fill_in(xs, i); + bs <- rcons bs b; + i <- i + 1; + } + while (i < m) { + HybridIROEager.fill_in(xs, i); + i <- i + 1; + } + } + return bs; + } + + proc next_block(i, m : int, xs, bs) = { + var b; + + while (i < m) { + b <@ HybridIROEager.fill_in(xs, i); + bs <- rcons bs b; + i <- i + 1; + } + return (bs, i); + } +}. + +module BlockSpongeTrans = { + (* from BlockSponge.BIRO.IRO; need copy for transitivity + to work *) + + proc f(x, n) = { + var b, bs; + var i <- 0; + + bs <- []; + if (valid_block x) { + while (i < n) { + b <@ BlockSponge.BIRO.IRO.fill_in(x, i); + bs <- rcons bs b; + i <- i + 1; + } + } + + return bs; + } + + proc next_block(x, i, bs) = { + var b; + + b <@ BlockSponge.BIRO.IRO.fill_in(x, i); + bs <- rcons bs b; + i <- i + 1; + return (bs, i); + } +}. + +lemma HybridIROEager_next (i2 : int) : + equiv + [HybridIROEagerTrans.next_block ~ BlockSpongeTrans.next_block : + i2 = i{2} /\ xs{1} = x{2} /\ i{1} = i{2} * r /\ m{1} - i{1} = r /\ + bs{1} = blocks2bits bs{2} /\ + EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + res{1}.`1 = blocks2bits res{2}.`1 /\ + res{1}.`2 = res{2}.`2 * r /\ res{2}.`2 = i2 + 1 /\ + EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}]. +proof. +proc=> /=. +admit. +qed. + lemma HybridIROEager_g_BlockIRO_f (n1 : int) (x2 : block list) : equiv[HybridIROEager.g ~ BlockSponge.BIRO.IRO.f : n1 = n{1} /\ x2 = x{2} /\ xs{1} = x{2} /\ @@ -583,6 +665,34 @@ lemma HybridIROEager_g_BlockIRO_f (n1 : int) (x2 : block list) : size res{2} = (n1 + r - 1) %/ r)) /\ (! valid_block x2 => res{1} = [] /\ res{2} = [])]. proof. +transitivity + HybridIROEagerTrans.g + (={n, xs, HybridIROEager.mp} ==> ={res, HybridIROEager.mp}) + (n1 = n{1} /\ x2 = x{2} /\ xs{1} = x{2} /\ + n{2} = (n{1} + r - 1) %/ r /\ + EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} /\ + (valid_block x2 => + (n1 <= 0 => res{1} = [] /\ res{2} = []) /\ + (0 < n1 => + res{1} = take n1 (blocks2bits res{2}) /\ + size res{2} = (n1 + r - 1) %/ r)) /\ + (! valid_block x2 => res{1} = [] /\ res{2} = [])); + [smt() | smt() | sim | idtac]. +transitivity + BlockSpongeTrans.f + (n1 = n{1} /\ x2 = x{2} /\ xs{1} = x{2} /\ + n{2} = (n{1} + r - 1) %/ r /\ + EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} /\ + (valid_block x2 => + (n1 <= 0 => res{1} = [] /\ res{2} = []) /\ + (0 < n1 => + res{1} = take n1 (blocks2bits res{2}) /\ + size res{2} = (n1 + r - 1) %/ r)) /\ + (! valid_block x2 => res{1} = [] /\ res{2} = [])) + (={x, n, BlockSponge.BIRO.IRO.mp} ==> ={res, BlockSponge.BIRO.IRO.mp}); + last first; [sim | smt() | smt() | idtac]. proc=> /=. seq 3 2 : (n1 = n{1} /\ xs{1} = x{2} /\ x2 = x{2} /\ @@ -701,7 +811,38 @@ skip; progress; rewrite -cats1 take_cat; smt(size_rcons take_oversize cats1 cats0)]. skip; smt(take_size). -admit. +transitivity{1} + { (bs, i) <@ HybridIROEagerTrans.next_block(i, m, xs, bs); + } + (={i, m, xs, bs, HybridIROEager.mp} ==> + ={i, m, xs, bs, HybridIROEager.mp}) + (xs{1} = x{2} /\ i{1} = i{2} * r /\ m{1} - i{1} = r /\ + bs{1} = blocks2bits bs{2} /\ + EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + bs{1} = blocks2bits bs{2} /\ + EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). +progress; +exists HybridIROEager.mp{1}, (blocks2bits bs{2}), m{1}, (i{2} * r), x{2}; + trivial. +trivial. +inline HybridIROEagerTrans.next_block; sim. +transitivity{2} + { (bs, i) <@ BlockSpongeTrans.next_block(x, i, bs); + } + (xs{1} = x{2} /\ i{1} = i{2} * r /\ m{1} - i{1} = r /\ + bs{1} = blocks2bits bs{2} /\ + EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + bs{1} = blocks2bits bs{2} /\ + EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}) + (={bs, i, x, BlockSponge.BIRO.IRO.mp} ==> + ={bs, i, x, BlockSponge.BIRO.IRO.mp}). +progress. +exists BlockSponge.BIRO.IRO.mp{2}, bs{2}, i{2}, x{2}; trivial. +trivial. +exists* i{2}; elim*=> i2. +call (HybridIROEager_next i2). +auto. +inline BlockSpongeTrans.next_block; sim. qed. lemma HybridIROEager_BlockIRO_f : From 3258b1bb3907b6610c2090616ec6c9973eae5636 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Wed, 13 Jul 2016 18:50:26 +0100 Subject: [PATCH 180/525] Strengthening a core result --- proof/core/SLCommon.ec | 45 +++++++++++++++++++++++++++++++++++------- 1 file changed, 38 insertions(+), 7 deletions(-) diff --git a/proof/core/SLCommon.ec b/proof/core/SLCommon.ec index 92f7e0c..f325091 100644 --- a/proof/core/SLCommon.ec +++ b/proof/core/SLCommon.ec @@ -114,19 +114,50 @@ op step_hpath (mh:hsmap) (sah:hstate option) (b:block) = op build_hpath (mh:hsmap) (bs:block list) = foldl (step_hpath mh) (Some (b0,0)) bs. +(* +inductive build_hpath_spec mh p v h = + | Empty of (p = []) + & (v = b0) + & (h = 0) + | Extend p' b v' h' of (p = rcons p' b) + & (build_hpath mh p' = Some (v',h')) + & (mh.[(v' +^ b,h')] = Some (v,h)). + +lemma build_hpathP mh p v h: + build_hpath mh p = Some (v,h) <=> build_hpath_spec mh p v h. +proof. +elim/last_ind: p v h=> @/build_hpath //= [v h|p b ih v h]. ++ by rewrite anda_and; split=> [!~#] <*>; [exact/Empty|move=> [] /#]. +rewrite -{1}cats1 foldl_cat {1}/step_hpath /=. +case: {-1}(foldl _ _ _) (eq_refl (foldl (step_hpath mh) (Some (b0,0)) p))=> //=. ++ apply/NewLogic.implybN; case=> [/#|p' b0 v' h']. + move=> ^/rconssI <<- {p'} /rconsIs ->> {b}. + by rewrite /build_hpath=> ->. +move=> [v' h']; rewrite oget_some /= -/(build_hpath _ _)=> build. +split. ++ by move=> mh__; apply/(Extend mh (rcons p b) v h p b v' h' _ build mh__). +case=> [/#|] p' b' v'' h'' ^/rconssI <<- {p'} /rconsIs <<- {b'}. +by rewrite build /= => [#] <*>. +qed. +*) + lemma build_hpathP mh p v h: - build_hpath mh p = Some (v, h) => + build_hpath mh p = Some (v, h) <=> (p = [] /\ v=b0 /\ h=0) \/ exists p' b v' h', p = rcons p' b /\ build_hpath mh p' = Some(v',h') /\ mh.[(v'+^b, h')] = Some(v,h). -proof. - elim/last_ind:p=>@/build_hpath //= p' b _. - rewrite -cats1 foldl_cat /= => H;right;exists p',b. - move:H;rewrite {1}/step_hpath;case (foldl _ _ _)=> //= -[v' h']. - by rewrite oget_some /==>Heq; exists v',h';rewrite -cats1. +proof. (* this is not an induction, but only a case analysis *) +elim/last_ind: p v h => //= [v h|p b _ v h]. ++ by rewrite /build_hpath /= anda_and; split=> [!~#] <*>; [left|move=> [] /#]. +rewrite -{1}cats1 foldl_cat /= -/(build_hpath _ _) /=. +have -> /=: rcons p b <> [] by smt (). (* inelegant -- need lemma in List.ec *) +case: {-1}(build_hpath _ _) (eq_refl (build_hpath mh p))=> //=. ++ by rewrite /step_hpath //= NewLogic.implybN=> -[] p' b0 b' h' [#] /rconssI <*> ->. +move=> [v' h'] build_path; split=> [step_path|[] p' b' v'' h'']. ++ by exists p, b, v', h'. +by move=> [#] ^/rconssI <<- /rconsIs <<-; rewrite build_path=> ->. qed. - (* -------------------------------------------------------------------------- *) module C = { From 4cabb5fc729c14c009cf6a3f5cafeb5f6f0b43bb Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Fri, 22 Jul 2016 17:38:18 -0400 Subject: [PATCH 181/525] Working toward next step of top-level proof. --- proof/Sponge.ec | 44 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 44 insertions(+) diff --git a/proof/Sponge.ec b/proof/Sponge.ec index a349a60..a25bbf2 100644 --- a/proof/Sponge.ec +++ b/proof/Sponge.ec @@ -572,6 +572,11 @@ qed. (* modules needed for applying transitivity tactic *) +pred EagerBitsOfBlockDom + (xs : block list, i : int, mp : (block list * int, bool) fmap) = + (forall (j : int), i <= j < i + r => mem (dom mp) (xs, j)) \/ + (forall (j : int), i <= j < i + r => ! mem (dom mp) (xs, j)). + module HybridIROEagerTrans = { (* from HybridIROEager; need copy for transitivity to work *) @@ -606,8 +611,47 @@ module HybridIROEagerTrans = { } return (bs, i); } + + proc next_block_split(i, m : int, xs, bs) = { + var b, j, cs; + + (* assuming EagerBitsOfBlockDom xs i HybridIROEager.mp *) + + if (mem (dom HybridIROEager.mp) (xs, i)) { + while (i < m) { + b <- oget HybridIROEager.mp.[(xs, i)]; + bs <- rcons bs b; + i <- i + 1; + } + } else { + j <- i; + while (i < m) { + b <$ dbool; + bs <- rcons bs b; + i <- i + 1; + } + cs <- bs; + while (j < m) { + HybridIROEager.mp.[(xs, j)] <- head true cs; + cs <- behead cs; + j <- j + 1; + } + } + return (bs, i); + } }. +lemma HybridIROEagerTrans_next_block_split : + equiv + [HybridIROEagerTrans.next_block ~ HybridIROEagerTrans.next_block_split : + ={i, m, xs, HybridIROEager.mp} /\ + EagerBitsOfBlockDom xs{1} i{1} HybridIROEager.mp{1} ==> + ={res, HybridIROEager.mp}]. +proof. +proc=> /=. +admit. +qed. + module BlockSpongeTrans = { (* from BlockSponge.BIRO.IRO; need copy for transitivity to work *) From a7c0d16e133ea7583d62a28c363a45b4548cd7ef Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Tue, 26 Jul 2016 23:26:14 -0400 Subject: [PATCH 182/525] More progress on top-level proof. --- proof/Sponge.ec | 83 ++++++++++++++++++++++++++++++++++++++++--------- 1 file changed, 68 insertions(+), 15 deletions(-) diff --git a/proof/Sponge.ec b/proof/Sponge.ec index a25bbf2..41066eb 100644 --- a/proof/Sponge.ec +++ b/proof/Sponge.ec @@ -546,6 +546,42 @@ pred EagerInvar mem (dom mp2) (xs, j) => 0 <= j /\ mem (dom mp1) (xs, j %/ r)). +pred BlockBitsAllInDom + (xs : block list, i : int, mp : (block list * int, bool) fmap) = + forall (j : int), i <= j < i + r => mem (dom mp) (xs, j). + +pred BlockBitsAllNotInDom + (xs : block list, i : int, mp : (block list * int, bool) fmap) = + forall (j : int), i <= j < i + r => ! mem (dom mp) (xs, j). + +pred BlockBitsDomAllInOrOut + (xs : block list, i : int, mp : (block list * int, bool) fmap) = + BlockBitsAllInDom xs i mp \/ BlockBitsAllNotInDom xs i mp. + +lemma eager_inv_imp_block_bits_dom + (mp1 : (block list * int, bool) fmap, + mp2 : (block list * int, block) fmap, + xs : block list, i : int) : + 0 <= i => r %| i => EagerInvar mp2 mp1 => + BlockBitsDomAllInOrOut xs i mp1. +proof. +move=> ge0_i r_dvd_i [ei1 ei2]. +case (mem (dom mp2) (xs, i %/ r))=> [mem_mp2 | not_mem_mp2]. +have ei1_xs_i_div_r := ei1 xs (i %/ r). +have [_ [_ mp1_eq_block_bits]] := ei1_xs_i_div_r mem_mp2. +left=> j j_rng. +have mp1_eq_block_bits_j := mp1_eq_block_bits j _. + by rewrite divzK // mulzDl /= divzK. +rewrite in_dom /#. +right=> j j_rng. +case (mem (dom mp1) (xs, j))=> // mem_mp1 /=. +have [_ mem_mp2] := ei2 xs j mem_mp1. +have [k] [k_ran j_eq_i_plus_k] : exists k, 0 <= k < r /\ j = i + k + by exists (j - i); smt(). +have /# : (i + k) %/r = i %/ r + by rewrite divzDl // (divz_small k r) 1:ger0_norm 1:ge0_r. +qed. + lemma HybridIROEager_f_g : equiv[HybridIROEager.f ~ HybridIROEager.g : ={xs, HybridIROEager.mp} /\ n{1} * r = n{2} ==> @@ -572,11 +608,6 @@ qed. (* modules needed for applying transitivity tactic *) -pred EagerBitsOfBlockDom - (xs : block list, i : int, mp : (block list * int, bool) fmap) = - (forall (j : int), i <= j < i + r => mem (dom mp) (xs, j)) \/ - (forall (j : int), i <= j < i + r => ! mem (dom mp) (xs, j)). - module HybridIROEagerTrans = { (* from HybridIROEager; need copy for transitivity to work *) @@ -615,7 +646,8 @@ module HybridIROEagerTrans = { proc next_block_split(i, m : int, xs, bs) = { var b, j, cs; - (* assuming EagerBitsOfBlockDom xs i HybridIROEager.mp *) + (* assuming BlockBitsDomAllInOrOut xs i HybridIROEager.mp + and m = i + r *) if (mem (dom HybridIROEager.mp) (xs, i)) { while (i < m) { @@ -644,8 +676,8 @@ module HybridIROEagerTrans = { lemma HybridIROEagerTrans_next_block_split : equiv [HybridIROEagerTrans.next_block ~ HybridIROEagerTrans.next_block_split : - ={i, m, xs, HybridIROEager.mp} /\ - EagerBitsOfBlockDom xs{1} i{1} HybridIROEager.mp{1} ==> + ={i, m, xs, bs, HybridIROEager.mp} /\ m{1} = i{1} + r /\ + BlockBitsDomAllInOrOut xs{1} i{1} HybridIROEager.mp{1} ==> ={res, HybridIROEager.mp}]. proof. proc=> /=. @@ -685,13 +717,34 @@ module BlockSpongeTrans = { lemma HybridIROEager_next (i2 : int) : equiv [HybridIROEagerTrans.next_block ~ BlockSpongeTrans.next_block : - i2 = i{2} /\ xs{1} = x{2} /\ i{1} = i{2} * r /\ m{1} - i{1} = r /\ - bs{1} = blocks2bits bs{2} /\ + i2 = i{2} /\ 0 <= i{2} /\ xs{1} = x{2} /\ i{1} = i{2} * r /\ + m{1} - i{1} = r /\ bs{1} = blocks2bits bs{2} /\ EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> res{1}.`1 = blocks2bits res{2}.`1 /\ res{1}.`2 = res{2}.`2 * r /\ res{2}.`2 = i2 + 1 /\ EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}]. proof. +transitivity + HybridIROEagerTrans.next_block_split + (={i, m, xs, bs, HybridIROEager.mp} /\ m{1} = i{1} + r /\ + BlockBitsDomAllInOrOut xs{1} i{1} HybridIROEager.mp{1}==> + ={res, HybridIROEager.mp}) + (i2 = i{2} /\ 0 <= i{2} /\ xs{1} = x{2} /\ i{1} = i{2} * r /\ + m{1} - i{1} = r /\ bs{1} = blocks2bits bs{2} /\ + EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + res{1}.`1 = blocks2bits res{2}.`1 /\ + res{1}.`2 = res{2}.`2 * r /\ res{2}.`2 = i2 + 1 /\ + EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). +progress; exists HybridIROEager.mp{1}, (i{1}, m{1}, xs{1}, bs{1}). +progress. smt(). +apply + (eager_inv_imp_block_bits_dom HybridIROEager.mp{1} + BlockSponge.BIRO.IRO.mp{2} xs{1} i{1}). +smt(ge0_r). +rewrite H1; smt(dvdz_mulr dvdzz). +trivial. +trivial. +apply HybridIROEagerTrans_next_block_split. proc=> /=. admit. qed. @@ -800,7 +853,7 @@ rcondf{2} 4; first auto; call (_ : true). if=> //. auto; progress; smt(). conseq (_ : - n1 = n{1} /\ 0 <= n1 /\ xs{1} = x{2} /\ i{1} = i{2} * r /\ + n1 = n{1} /\ 0 <= n1 /\ xs{1} = x{2} /\ 0 <= i{2} /\ i{1} = i{2} * r /\ n{1} <= m{1} /\ m{1} - i{1} = r /\ i{1} <= n{1} /\ bs{1} = blocks2bits bs{2} /\ size bs{1} = i{1} /\ size bs{2} = i{2} /\ EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> @@ -808,7 +861,7 @@ conseq EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}) _ (_ : size bs = n - 1 ==> size bs = n). -progress; smt(lez_floor size_blocks2bits). +progress; smt(divz_ge0 gt0_r lez_floor size_blocks2bits). smt(). wp. call (_ : true). auto. skip; smt(size_rcons). transitivity{1} @@ -821,7 +874,7 @@ transitivity{1} (={bs, m, i, xs, HybridIROEager.mp} /\ n1 = n{1} /\ i{1} <= n1 /\ n1 <= m{1} /\ size bs{1} = i{1} ==> ={HybridIROEager.mp} /\ bs{1} = take n1 bs{2}) - (xs{1} = x{2} /\ i{1} = i{2} * r /\ m{1} - i{1} = r /\ + (xs{1} = x{2} /\ 0 <= i{2} /\ i{1} = i{2} * r /\ m{1} - i{1} = r /\ bs{1} = blocks2bits bs{2} /\ EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> bs{1} = blocks2bits bs{2} /\ @@ -860,7 +913,7 @@ transitivity{1} } (={i, m, xs, bs, HybridIROEager.mp} ==> ={i, m, xs, bs, HybridIROEager.mp}) - (xs{1} = x{2} /\ i{1} = i{2} * r /\ m{1} - i{1} = r /\ + (xs{1} = x{2} /\ 0 <= i{2} /\ i{1} = i{2} * r /\ m{1} - i{1} = r /\ bs{1} = blocks2bits bs{2} /\ EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> bs{1} = blocks2bits bs{2} /\ @@ -873,7 +926,7 @@ inline HybridIROEagerTrans.next_block; sim. transitivity{2} { (bs, i) <@ BlockSpongeTrans.next_block(x, i, bs); } - (xs{1} = x{2} /\ i{1} = i{2} * r /\ m{1} - i{1} = r /\ + (xs{1} = x{2} /\ 0 <= i{2} /\ i{1} = i{2} * r /\ m{1} - i{1} = r /\ bs{1} = blocks2bits bs{2} /\ EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> bs{1} = blocks2bits bs{2} /\ From 7c69cbecf29e7f26ccd44516b938c1ac91bc2fcf Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Wed, 27 Jul 2016 11:32:56 -0400 Subject: [PATCH 183/525] Housekeeping. --- proof/Common.ec | 1 + proof/Sponge.ec | 133 +++++++++++++++++++++++++++++++++--------------- 2 files changed, 94 insertions(+), 40 deletions(-) diff --git a/proof/Common.ec b/proof/Common.ec index f19f6fb..3d1cf7e 100644 --- a/proof/Common.ec +++ b/proof/Common.ec @@ -1,4 +1,5 @@ (*------------------- Common Definitions and Lemmas --------------------*) +(* checks with both Alt-Ergo and Z3 *) require import Option Fun Pair Int IntExtra IntDiv Real List NewDistr. require import Ring StdRing StdOrder StdBigop BitEncoding DProd. diff --git a/proof/Sponge.ec b/proof/Sponge.ec index 41066eb..cd8f3a2 100644 --- a/proof/Sponge.ec +++ b/proof/Sponge.ec @@ -1,4 +1,5 @@ (*------------------------- Sponge Construction ------------------------*) +(* checks with both Alt-Ergo and Z3 *) require import Fun Pair Int IntDiv Real List Option FSet NewFMap DBool. require import Common StdOrder. import IntOrder. @@ -409,6 +410,44 @@ pred LazyInvar mem (dom mp1) (bs, n) => oget mp1.[(bs, n)] = oget mp2.[(pad2blocks bs, n)]). +lemma lazy_invar0 : LazyInvar map0 map0. +proof. +split; first smt(in_fset0 dom0). +split; smt(in_fset0 dom0). +qed. + +lemma lazy_invar_mem_pad2blocks_l2r + (mp1 : (bool list * int, bool) fmap, + mp2 : (block list * int, bool) fmap, + bs : bool list, i : int) : + LazyInvar mp1 mp2 => mem (dom mp1) (bs, i) => + mem (dom mp2) (pad2blocks bs, i). +proof. smt(). qed. + +lemma lazy_invar_mem_pad2blocks_r2l + (mp1 : (bool list * int, bool) fmap, + mp2 : (block list * int, bool) fmap, + bs : bool list, i : int) : + LazyInvar mp1 mp2 => mem (dom mp2) (pad2blocks bs, i) => + mem (dom mp1) (bs, i). +proof. smt(). qed. + +lemma lazy_invar_vb + (mp1 : (bool list * int, bool) fmap, + mp2 : (block list * int, bool) fmap, + xs : block list, n : int) : + LazyInvar mp1 mp2 => mem (dom mp2) (xs, n) => + valid_block xs. +proof. smt(). qed. + +lemma lazy_invar_lookup_eq + (mp1 : (bool list * int, bool) fmap, + mp2 : (block list * int, bool) fmap, + bs : bool list, n : int) : + LazyInvar mp1 mp2 => mem (dom mp1) (bs, n) => + oget mp1.[(bs, n)] = oget mp2.[(pad2blocks bs, n)]. +proof. smt(). qed. + lemma lazy_invar_upd_mem_dom_iff (mp1 : (bool list * int, bool) fmap, mp2 : (block list * int, bool) fmap, @@ -489,7 +528,11 @@ while pad2blocks x{1} = xs0{2}). sp; auto. if. -progress; smt(). +progress; + [by apply (lazy_invar_mem_pad2blocks_l2r IRO.mp{1} + HybridIROLazy.mp{2} x{1} i{2}) | + by apply (lazy_invar_mem_pad2blocks_r2l IRO.mp{1} + HybridIROLazy.mp{2} x{1} i{2})]. rnd; auto; progress; [by rewrite !getP_eq | by rewrite -(@lazy_invar_upd_mem_dom_iff IRO.mp{1}) | @@ -497,7 +540,8 @@ rnd; auto; progress; by rewrite (@lazy_invar_upd2_vb IRO.mp{1} HybridIROLazy.mp{2} x{1} xs2 i{2} n2 mpL) | by rewrite (@lazy_invar_upd_lu_eq IRO.mp{1} HybridIROLazy.mp{2})]. -auto; progress; smt(). +auto; progress [-delta]. +by rewrite (lazy_invar_lookup_eq IRO.mp{1} HybridIROLazy.mp{2} x{1} i{2}). auto. rcondf{1} 3; first auto. rcondf{2} 4; first auto. auto; progress; by rewrite bits2blocks_nil. @@ -521,7 +565,11 @@ while LazyInvar IRO.mp{1} HybridIROLazy.mp{2}). wp; sp. if. -progress; smt(). +progress; + [by apply (lazy_invar_mem_pad2blocks_l2r IRO.mp{1} + HybridIROLazy.mp{2} x{1} i{2}) | + by apply (lazy_invar_mem_pad2blocks_r2l IRO.mp{1} + HybridIROLazy.mp{2} x{1} i{2})]. rnd; auto; progress; [by rewrite !getP_eq | by rewrite -(@lazy_invar_upd_mem_dom_iff IRO.mp{1}) | @@ -529,7 +577,8 @@ rnd; auto; progress; by rewrite (@lazy_invar_upd2_vb IRO.mp{1} HybridIROLazy.mp{2} x{1} xs1 i{2} n1 mpL) | by rewrite (@lazy_invar_upd_lu_eq IRO.mp{1} HybridIROLazy.mp{2})]. -auto; progress; smt(). +auto; progress [-delta]; + by rewrite (lazy_invar_lookup_eq IRO.mp{1} HybridIROLazy.mp{2} x{1} i{2}). auto. qed. @@ -558,6 +607,9 @@ pred BlockBitsDomAllInOrOut (xs : block list, i : int, mp : (block list * int, bool) fmap) = BlockBitsAllInDom xs i mp \/ BlockBitsAllNotInDom xs i mp. +lemma eager_invar0 : EagerInvar map0 map0. +proof. split; smt(dom0 in_fset0). qed. + lemma eager_inv_imp_block_bits_dom (mp1 : (block list * int, bool) fmap, mp2 : (block list * int, block) fmap, @@ -775,7 +827,7 @@ transitivity res{1} = take n1 (blocks2bits res{2}) /\ size res{2} = (n1 + r - 1) %/ r)) /\ (! valid_block x2 => res{1} = [] /\ res{2} = [])); - [smt() | smt() | sim | idtac]. + [smt() | trivial | sim | idtac]. transitivity BlockSpongeTrans.f (n1 = n{1} /\ x2 = x{2} /\ xs{1} = x{2} /\ @@ -987,7 +1039,7 @@ section. declare module BlockSim : BlockSponge.SIMULATOR{IRO, BlockSponge.BIRO.IRO}. declare module Dist : DISTINGUISHER{Perm, BlockSim, IRO, BlockSponge.BIRO.IRO}. -local clone import HybridIRO as HIRO. +local clone HybridIRO as HIRO. local lemma Sponge_Raise_BlockSponge_f : equiv[Sponge(Perm).f ~ RaiseFun(BlockSponge.Sponge(Perm)).f : @@ -1029,16 +1081,17 @@ auto. qed. local lemma RaiseHybridIRO_HybridIROEager_RaiseFun_BlockIRO_f : - equiv[RaiseHybridIRO(HybridIROEager).f ~ RaiseFun(BlockSponge.BIRO.IRO).f : + equiv[HIRO.RaiseHybridIRO(HIRO.HybridIROEager).f ~ + RaiseFun(BlockSponge.BIRO.IRO).f : ={bs, n} /\ ={glob BlockSim} /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + HIRO.EagerInvar BlockSponge.BIRO.IRO.mp{2} HIRO.HybridIROEager.mp{1} ==> ={res} /\ ={glob BlockSim} /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}]. + HIRO.EagerInvar BlockSponge.BIRO.IRO.mp{2} HIRO.HybridIROEager.mp{1}]. proof. proc=> /=. exists* n{1}; elim*=> n'. exists* (pad2blocks bs{2}); elim*=> xs2. -call (HybridIROEager_g_BlockIRO_f n' xs2). +call (HIRO.HybridIROEager_g_BlockIRO_f n' xs2). auto=> |> &1 &2 ? res1 res2 mp1 mp2 ? vb_imp not_vb_imp. case: (valid_block (pad2blocks bs{2}))=> [vb | not_vb]. have [le0_n2_imp gt0_n2_imp] := vb_imp vb. @@ -1052,101 +1105,101 @@ qed. local lemma Ideal_IRO_Experiment_HybridLazy &m : Pr[IdealIndif(IRO, RaiseSim(BlockSim), Dist).main() @ &m : res] = Pr[Experiment - (RaiseHybridIRO(HybridIROLazy), BlockSim(HybridIROLazy), + (HIRO.RaiseHybridIRO(HIRO.HybridIROLazy), BlockSim(HIRO.HybridIROLazy), Dist).main() @ &m : res]. proof. byequiv=> //; proc. seq 2 2 : (={glob Dist, glob BlockSim} /\ IRO.mp{1} = NewFMap.map0 /\ - HybridIROLazy.mp{2} = NewFMap.map0). + HIRO.HybridIROLazy.mp{2} = NewFMap.map0). inline*; wp; call (_ : true); auto. call (_ : ={glob Dist, glob BlockSim} /\ - IRO.mp{1} = map0 /\ HybridIROLazy.mp{2} = map0 ==> + IRO.mp{1} = map0 /\ HIRO.HybridIROLazy.mp{2} = map0 ==> ={res}). -proc (={glob BlockSim} /\ LazyInvar IRO.mp{1} HybridIROLazy.mp{2}). -progress; rewrite dom0 in_fset0 in H; elim H. +proc (={glob BlockSim} /\ HIRO.LazyInvar IRO.mp{1} HIRO.HybridIROLazy.mp{2}). +progress [-delta]; apply HIRO.lazy_invar0. trivial. -proc (LazyInvar IRO.mp{1} HybridIROLazy.mp{2})=> //. -apply LowerFun_IRO_HybridIROLazy_f. -proc (LazyInvar IRO.mp{1} HybridIROLazy.mp{2})=> //. -apply LowerFun_IRO_HybridIROLazy_f. -by conseq IRO_RaiseHybridIRO_HybridIROLazy_f. +proc (HIRO.LazyInvar IRO.mp{1} HIRO.HybridIROLazy.mp{2})=> //. +apply HIRO.LowerFun_IRO_HybridIROLazy_f. +proc (HIRO.LazyInvar IRO.mp{1} HIRO.HybridIROLazy.mp{2})=> //. +apply HIRO.LowerFun_IRO_HybridIROLazy_f. +by conseq HIRO.IRO_RaiseHybridIRO_HybridIROLazy_f. auto. qed. -local module (HybridIRODist : HYBRID_IRO_DIST) (HI : HYBRID_IRO) = { +local module (HybridIRODist : HIRO.HYBRID_IRO_DIST) (HI : HIRO.HYBRID_IRO) = { proc distinguish() : bool = { var b : bool; BlockSim(HI).init(); - b <@ Dist(RaiseHybridIRO(HI), BlockSim(HI)).distinguish(); + b <@ Dist(HIRO.RaiseHybridIRO(HI), BlockSim(HI)).distinguish(); return b; } }. local lemma Experiment_HybridIROExper_Lazy &m : Pr[Experiment - (RaiseHybridIRO(HybridIROLazy), BlockSim(HybridIROLazy), + (HIRO.RaiseHybridIRO(HIRO.HybridIROLazy), BlockSim(HIRO.HybridIROLazy), Dist).main() @ &m : res] = - Pr[HybridIROExper(HybridIROLazy, HybridIRODist).main() @ &m : res]. + Pr[HIRO.HybridIROExper(HIRO.HybridIROLazy, HybridIRODist).main() @ &m : res]. proof. byequiv=> //; proc; inline*. -seq 2 2 : (={glob Dist, glob BlockSim, HybridIROLazy.mp}). +seq 2 2 : (={glob Dist, glob BlockSim, HIRO.HybridIROLazy.mp}). swap{2} 1 1; wp; call (_ : true); auto. sim. qed. local lemma HybridIROExper_Experiment_Eager &m : - Pr[HybridIROExper(HybridIROEager, HybridIRODist).main() @ &m : res] = + Pr[HIRO.HybridIROExper(HIRO.HybridIROEager, HybridIRODist).main() @ &m : res] = Pr[Experiment - (RaiseHybridIRO(HybridIROEager), BlockSim(HybridIROEager), + (HIRO.RaiseHybridIRO(HIRO.HybridIROEager), BlockSim(HIRO.HybridIROEager), Dist).main() @ &m : res]. proof. byequiv=> //; proc; inline*. -seq 2 2 : (={glob Dist, glob BlockSim, HybridIROEager.mp}). +seq 2 2 : (={glob Dist, glob BlockSim, HIRO.HybridIROEager.mp}). swap{2} 1 1; wp; call (_ : true); auto. sim. qed. local lemma Experiment_Hybrid_Lazy_Eager &m : Pr[Experiment - (RaiseHybridIRO(HybridIROLazy), BlockSim(HybridIROLazy), + (HIRO.RaiseHybridIRO(HIRO.HybridIROLazy), BlockSim(HIRO.HybridIROLazy), Dist).main() @ &m : res] = Pr[Experiment - (RaiseHybridIRO(HybridIROEager), BlockSim(HybridIROEager), + (HIRO.RaiseHybridIRO(HIRO.HybridIROEager), BlockSim(HIRO.HybridIROEager), Dist).main() @ &m : res]. proof. by rewrite (Experiment_HybridIROExper_Lazy &m) - (HybridIROExper_Lazy_Eager HybridIRODist &m) + (HIRO.HybridIROExper_Lazy_Eager HybridIRODist &m) (HybridIROExper_Experiment_Eager &m). qed. local lemma Experiment_HybridEager_Ideal_BlockIRO &m : Pr[Experiment - (RaiseHybridIRO(HybridIROEager), BlockSim(HybridIROEager), + (HIRO.RaiseHybridIRO(HIRO.HybridIROEager), BlockSim(HIRO.HybridIROEager), Dist).main() @ &m : res] = Pr[BlockSponge.IdealIndif (BlockSponge.BIRO.IRO, BlockSim, LowerDist(Dist)).main () @ &m : res]. proof. byequiv=> //; proc. seq 2 2 : - (={glob Dist, glob BlockSim} /\ HybridIROEager.mp{1} = NewFMap.map0 /\ + (={glob Dist, glob BlockSim} /\ HIRO.HybridIROEager.mp{1} = NewFMap.map0 /\ BlockSponge.BIRO.IRO.mp{2} = NewFMap.map0). inline*; wp; call (_ : true); auto. call (_ : ={glob Dist, glob BlockSim} /\ - HybridIROEager.mp{1} = map0 /\ BlockSponge.BIRO.IRO.mp{2} = map0 ==> + HIRO.HybridIROEager.mp{1} = map0 /\ BlockSponge.BIRO.IRO.mp{2} = map0 ==> ={res}). proc (={glob BlockSim} /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}) => //. -progress; rewrite dom0 in_fset0 in H; elim H. -proc (EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1})=> //; - conseq HybridIROEager_BlockIRO_f=> //. -proc (EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1})=> //; - conseq HybridIROEager_BlockIRO_f=> //. + HIRO.EagerInvar BlockSponge.BIRO.IRO.mp{2} HIRO.HybridIROEager.mp{1}) => //. +progress [-delta]; apply HIRO.eager_invar0. +proc (HIRO.EagerInvar BlockSponge.BIRO.IRO.mp{2} HIRO.HybridIROEager.mp{1})=> //; + conseq HIRO.HybridIROEager_BlockIRO_f=> //. +proc (HIRO.EagerInvar BlockSponge.BIRO.IRO.mp{2} HIRO.HybridIROEager.mp{1})=> //; + conseq HIRO.HybridIROEager_BlockIRO_f=> //. exists* n{1}; elim *=> n'. conseq RaiseHybridIRO_HybridIROEager_RaiseFun_BlockIRO_f=> //. auto. From da359252b07f8e13d182c4ddf0661074b59a79e7 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Wed, 27 Jul 2016 18:26:48 -0400 Subject: [PATCH 184/525] Progress on top-level proof (but some commented-out script that I'll rework tomorrow). --- proof/Sponge.ec | 161 ++++++++++++++++++++++++++++++++++++++---------- 1 file changed, 129 insertions(+), 32 deletions(-) diff --git a/proof/Sponge.ec b/proof/Sponge.ec index cd8f3a2..75115be 100644 --- a/proof/Sponge.ec +++ b/proof/Sponge.ec @@ -599,41 +599,83 @@ pred BlockBitsAllInDom (xs : block list, i : int, mp : (block list * int, bool) fmap) = forall (j : int), i <= j < i + r => mem (dom mp) (xs, j). -pred BlockBitsAllNotInDom +pred BlockBitsAllOutDom (xs : block list, i : int, mp : (block list * int, bool) fmap) = forall (j : int), i <= j < i + r => ! mem (dom mp) (xs, j). pred BlockBitsDomAllInOrOut (xs : block list, i : int, mp : (block list * int, bool) fmap) = - BlockBitsAllInDom xs i mp \/ BlockBitsAllNotInDom xs i mp. + BlockBitsAllInDom xs i mp \/ BlockBitsAllOutDom xs i mp. lemma eager_invar0 : EagerInvar map0 map0. proof. split; smt(dom0 in_fset0). qed. lemma eager_inv_imp_block_bits_dom - (mp1 : (block list * int, bool) fmap, - mp2 : (block list * int, block) fmap, + (mp1 : (block list * int, block) fmap, + mp2 : (block list * int, bool) fmap, xs : block list, i : int) : - 0 <= i => r %| i => EagerInvar mp2 mp1 => - BlockBitsDomAllInOrOut xs i mp1. + 0 <= i => r %| i => EagerInvar mp1 mp2 => + BlockBitsDomAllInOrOut xs i mp2. proof. move=> ge0_i r_dvd_i [ei1 ei2]. -case (mem (dom mp2) (xs, i %/ r))=> [mem_mp2 | not_mem_mp2]. +case (mem (dom mp1) (xs, i %/ r))=> [mem_mp1 | not_mem_mp1]. have ei1_xs_i_div_r := ei1 xs (i %/ r). -have [_ [_ mp1_eq_block_bits]] := ei1_xs_i_div_r mem_mp2. +have [_ [_ mp2_eq_block_bits]] := ei1_xs_i_div_r mem_mp1. left=> j j_rng. -have mp1_eq_block_bits_j := mp1_eq_block_bits j _. +have mp2_eq_block_bits_j := mp2_eq_block_bits j _. by rewrite divzK // mulzDl /= divzK. rewrite in_dom /#. right=> j j_rng. -case (mem (dom mp1) (xs, j))=> // mem_mp1 /=. -have [_ mem_mp2] := ei2 xs j mem_mp1. +case (mem (dom mp2) (xs, j))=> // mem_mp2 /=. +have [_ mem_mp1] := ei2 xs j mem_mp2. have [k] [k_ran j_eq_i_plus_k] : exists k, 0 <= k < r /\ j = i + k by exists (j - i); smt(). have /# : (i + k) %/r = i %/ r by rewrite divzDl // (divz_small k r) 1:ger0_norm 1:ge0_r. qed. +lemma eager_inv_mem_dom2 + (mp1 : (block list * int, block) fmap, + mp2 : (block list * int, bool) fmap, + xs : block list, i : int) : + EagerInvar mp1 mp2 => mem (dom mp1) (xs, i) => + BlockBitsAllInDom xs (i * r) mp2. +proof. +move=> [ei1 _] mem j j_ran. +have [ge0_i [_ eq_mp2_block_i]] := ei1 xs i mem. +rewrite in_dom. +have /# := eq_mp2_block_i j _; smt(). +qed. + +lemma eager_inv_not_mem_dom2 + (mp1 : (block list * int, bool) fmap, + mp2 : (block list * int, block) fmap, + xs : block list, i : int) : + EagerInvar mp2 mp1 => 0 <= i => ! mem (dom mp2) (xs, i) => + BlockBitsAllOutDom xs (i * r) mp1. +proof. +move=> [_ ei2] ge0_i not_mem_mp2_i j j_ran. +case (mem (dom mp1) (xs, j))=> // mem_mp1_j. +have [ge0_j mem_mp2_j_div_r] := ei2 xs j mem_mp1_j. +have /# : j %/ r = i. +have [k] [k_ran ->] : exists k, 0 <= k < r /\ j = i * r + k + by exists (j - i * r); smt(). +by rewrite divzDl 1:dvdz_mull 1:dvdzz (divz_small k r) + 1:ger0_norm 1:ge0_r //= mulzK 1:gtr_eqF 1:gt0_r. +qed. + +lemma block_bits_dom_first_in_imp_all_in + (xs : block list, i : int, mp : (block list * int, bool) fmap) : + BlockBitsDomAllInOrOut xs i mp => mem (dom mp) (xs, i) => + BlockBitsAllInDom xs i mp. +proof. smt(). qed. + +lemma block_bits_dom_first_out_imp_all_out + (xs : block list, i : int, mp : (block list * int, bool) fmap) : + BlockBitsDomAllInOrOut xs i mp => ! mem (dom mp) (xs, i) => + BlockBitsAllOutDom xs i mp. +proof. smt(). qed. + lemma HybridIROEager_f_g : equiv[HybridIROEager.f ~ HybridIROEager.g : ={xs, HybridIROEager.mp} /\ n{1} * r = n{2} ==> @@ -696,10 +738,10 @@ module HybridIROEagerTrans = { } proc next_block_split(i, m : int, xs, bs) = { - var b, j, cs; + var b, i'; (* assuming BlockBitsDomAllInOrOut xs i HybridIROEager.mp - and m = i + r *) + and m = i + r and size bs = i *) if (mem (dom HybridIROEager.mp) (xs, i)) { while (i < m) { @@ -708,17 +750,16 @@ module HybridIROEagerTrans = { i <- i + 1; } } else { - j <- i; + i' <- i; while (i < m) { b <$ dbool; bs <- rcons bs b; i <- i + 1; } - cs <- bs; - while (j < m) { - HybridIROEager.mp.[(xs, j)] <- head true cs; - cs <- behead cs; - j <- j + 1; + i <- i'; + while (i < m) { + HybridIROEager.mp.[(xs, i)] <- nth true bs i; + i <- i + 1; } } return (bs, i); @@ -729,10 +770,62 @@ lemma HybridIROEagerTrans_next_block_split : equiv [HybridIROEagerTrans.next_block ~ HybridIROEagerTrans.next_block_split : ={i, m, xs, bs, HybridIROEager.mp} /\ m{1} = i{1} + r /\ + size bs{1} = i{1} /\ BlockBitsDomAllInOrOut xs{1} i{1} HybridIROEager.mp{1} ==> ={res, HybridIROEager.mp}]. proof. proc=> /=. +(* +ROUGH WORK -- will rework tomorrow (invariants were faulty) + +case (mem (dom HybridIROEager.mp{2}) (xs{2}, i{2})). +rcondt{2} 1; first auto. +conseq + (_ : + ={i, m, xs, bs, HybridIROEager.mp} /\ i{1} <= m{1} /\ + (forall (j : int), + i{1} <= j < m{1} => + mem (dom HybridIROEager.mp{1}) (xs{1}, j)) ==> + _). +progress; smt(gt0_r). +while + (={i, m, xs, bs, HybridIROEager.mp} /\ i{1} <= m{1} /\ + (forall (j : int), + i{1} <= j < m{1} => + mem (dom HybridIROEager.mp{1}) (xs{1}, j))). +wp; inline*. +rcondf{1} 3; first auto; smt(). +auto; smt(). +auto. +rcondf{2} 1; first auto. +sp; exists* i{1}; elim*=> i''. +conseq + (_ : + ={i, m, xs, bs, HybridIROEager.mp} /\ i'' = i{1} /\ + i'' = i'{2} /\ i'' + r = m{1} /\ + (forall (j : int), + i{1} <= j < m{1} => + ! mem (dom HybridIROEager.mp{1}) (xs{1}, j)) ==> + _). +progress; smt(gt0_r). +seq 1 1 : + (={i, m, xs, bs, HybridIROEager.mp} /\ i'{2} = i'' /\ i{1} = i'' + r /\ + size bs{1} = r /\ + (forall (j : int), + i'' <= j < i{1} => + HybridIROEager.mp{1}.[(xs{1}, j)] = Some(nth true bs{1} (j - i'')))). +while + (={i, m, xs, bs} /\ i'' = i'{2} /\ i'' + r = m{1} /\ i'' <= i{1} /\ + i{1} <= m{1} /\ size bs{1} = i{1} - i'' /\ + (forall (j : int), + i'' <= j < i{1} => + HybridIROEager.mp{1}.[(xs{1}, j)] = Some(nth true bs{1} (j - i''))) /\ + (forall (j : int), + i{1} <= j < m{1} => + ! mem (dom HybridIROEager.mp{1}) (xs{1}, j))). +inline*; rcondt{1} 3; first auto; smt(). +sp; wp; rnd; skip. +*) admit. qed. @@ -770,7 +863,7 @@ lemma HybridIROEager_next (i2 : int) : equiv [HybridIROEagerTrans.next_block ~ BlockSpongeTrans.next_block : i2 = i{2} /\ 0 <= i{2} /\ xs{1} = x{2} /\ i{1} = i{2} * r /\ - m{1} - i{1} = r /\ bs{1} = blocks2bits bs{2} /\ + m{1} - i{1} = r /\ bs{1} = blocks2bits bs{2} /\ size bs{2} = i{2} /\ EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> res{1}.`1 = blocks2bits res{2}.`1 /\ res{1}.`2 = res{2}.`2 * r /\ res{2}.`2 = i2 + 1 /\ @@ -779,25 +872,29 @@ proof. transitivity HybridIROEagerTrans.next_block_split (={i, m, xs, bs, HybridIROEager.mp} /\ m{1} = i{1} + r /\ - BlockBitsDomAllInOrOut xs{1} i{1} HybridIROEager.mp{1}==> + size bs{1} = i{1} /\ + BlockBitsDomAllInOrOut xs{1} i{1} HybridIROEager.mp{1} ==> ={res, HybridIROEager.mp}) (i2 = i{2} /\ 0 <= i{2} /\ xs{1} = x{2} /\ i{1} = i{2} * r /\ - m{1} - i{1} = r /\ bs{1} = blocks2bits bs{2} /\ + m{1} - i{1} = r /\ size bs{1} = i{1} /\ bs{1} = blocks2bits bs{2} /\ EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> res{1}.`1 = blocks2bits res{2}.`1 /\ res{1}.`2 = res{2}.`2 * r /\ res{2}.`2 = i2 + 1 /\ EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). progress; exists HybridIROEager.mp{1}, (i{1}, m{1}, xs{1}, bs{1}). progress. smt(). +smt(size_blocks2bits). apply - (eager_inv_imp_block_bits_dom HybridIROEager.mp{1} - BlockSponge.BIRO.IRO.mp{2} xs{1} i{1}). + (eager_inv_imp_block_bits_dom BlockSponge.BIRO.IRO.mp{2} + HybridIROEager.mp{1} xs{1} i{1}). smt(ge0_r). rewrite H1; smt(dvdz_mulr dvdzz). trivial. +smt(size_blocks2bits). trivial. apply HybridIROEagerTrans_next_block_split. proc=> /=. +inline*. admit. qed. @@ -927,7 +1024,7 @@ transitivity{1} n1 <= m{1} /\ size bs{1} = i{1} ==> ={HybridIROEager.mp} /\ bs{1} = take n1 bs{2}) (xs{1} = x{2} /\ 0 <= i{2} /\ i{1} = i{2} * r /\ m{1} - i{1} = r /\ - bs{1} = blocks2bits bs{2} /\ + size bs{2} = i{2} /\ bs{1} = blocks2bits bs{2} /\ EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> bs{1} = blocks2bits bs{2} /\ EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). @@ -966,27 +1063,27 @@ transitivity{1} (={i, m, xs, bs, HybridIROEager.mp} ==> ={i, m, xs, bs, HybridIROEager.mp}) (xs{1} = x{2} /\ 0 <= i{2} /\ i{1} = i{2} * r /\ m{1} - i{1} = r /\ - bs{1} = blocks2bits bs{2} /\ + size bs{2} = i{2} /\ bs{1} = blocks2bits bs{2} /\ EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> bs{1} = blocks2bits bs{2} /\ EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). -progress; -exists HybridIROEager.mp{1}, (blocks2bits bs{2}), m{1}, (i{2} * r), x{2}; - trivial. +progress [-delta]; +exists HybridIROEager.mp{1}, (blocks2bits bs{2}), m{1}, + (size bs{2} * r), x{2}=> //. trivial. inline HybridIROEagerTrans.next_block; sim. transitivity{2} { (bs, i) <@ BlockSpongeTrans.next_block(x, i, bs); } (xs{1} = x{2} /\ 0 <= i{2} /\ i{1} = i{2} * r /\ m{1} - i{1} = r /\ - bs{1} = blocks2bits bs{2} /\ + size bs{2} = i{2} /\ bs{1} = blocks2bits bs{2} /\ EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> bs{1} = blocks2bits bs{2} /\ EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}) (={bs, i, x, BlockSponge.BIRO.IRO.mp} ==> ={bs, i, x, BlockSponge.BIRO.IRO.mp}). -progress. -exists BlockSponge.BIRO.IRO.mp{2}, bs{2}, i{2}, x{2}; trivial. +progress [-delta]; +exists BlockSponge.BIRO.IRO.mp{2}, bs{2}, (size bs{2}), x{2}=> //. trivial. exists* i{2}; elim*=> i2. call (HybridIROEager_next i2). From 55403d648dea43e15c8156a1c014131a478b37b1 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Tue, 2 Aug 2016 16:11:20 -0400 Subject: [PATCH 185/525] Progress on top-level proof. --- proof/Sponge.ec | 149 ++++++++++++++++++++++++++++++++++++++++-------- 1 file changed, 124 insertions(+), 25 deletions(-) diff --git a/proof/Sponge.ec b/proof/Sponge.ec index 75115be..a28b46b 100644 --- a/proof/Sponge.ec +++ b/proof/Sponge.ec @@ -588,12 +588,10 @@ pred EagerInvar (forall (xs : block list, i : int), mem (dom mp1) (xs, i) => 0 <= i /\ - (forall (j : int), 0 <= j < i => mem (dom mp1) (xs, j)) /\ (forall (j : int), i * r <= j < (i + 1) * r => mp2.[(xs, j)] = Some(nth false (ofblock (oget mp1.[(xs, i)])) j))) /\ (forall (xs : block list, j : int), - mem (dom mp2) (xs, j) => - 0 <= j /\ mem (dom mp1) (xs, j %/ r)). + mem (dom mp2) (xs, j) => mem (dom mp1) (xs, j %/ r)). pred BlockBitsAllInDom (xs : block list, i : int, mp : (block list * int, bool) fmap) = @@ -607,6 +605,25 @@ pred BlockBitsDomAllInOrOut (xs : block list, i : int, mp : (block list * int, bool) fmap) = BlockBitsAllInDom xs i mp \/ BlockBitsAllOutDom xs i mp. +lemma eager_inv_mem_mp1_ge0 + (mp1 : (block list * int, block) fmap, + mp2 : (block list * int, bool) fmap, + xs : block list, i : int) : + EagerInvar mp1 mp2 => mem (dom mp1) (xs, i) => 0 <= i. +proof. move=> [ei1 ei2] mem_mp1_i; smt(). qed. + +lemma eager_inv_mem_mp2_ge0 + (mp1 : (block list * int, block) fmap, + mp2 : (block list * int, bool) fmap, + xs : block list, j : int) : + EagerInvar mp1 mp2 => mem (dom mp2) (xs, j) => 0 <= j. +proof. +move=> [ei1 ei2] mem_mp2_j. +have mem_mp1_j_div_r : mem (dom mp1) (xs, j %/ r) by smt(). +have ge0_j_div_r : 0 <= j %/ r by smt(). +smt(divz_ge0 gt0_r). +qed. + lemma eager_invar0 : EagerInvar map0 map0. proof. split; smt(dom0 in_fset0). qed. @@ -620,14 +637,14 @@ proof. move=> ge0_i r_dvd_i [ei1 ei2]. case (mem (dom mp1) (xs, i %/ r))=> [mem_mp1 | not_mem_mp1]. have ei1_xs_i_div_r := ei1 xs (i %/ r). -have [_ [_ mp2_eq_block_bits]] := ei1_xs_i_div_r mem_mp1. +have [_ mp2_eq_block_bits] := ei1_xs_i_div_r mem_mp1. left=> j j_rng. have mp2_eq_block_bits_j := mp2_eq_block_bits j _. by rewrite divzK // mulzDl /= divzK. rewrite in_dom /#. right=> j j_rng. case (mem (dom mp2) (xs, j))=> // mem_mp2 /=. -have [_ mem_mp1] := ei2 xs j mem_mp2. +have mem_mp1 := ei2 xs j mem_mp2. have [k] [k_ran j_eq_i_plus_k] : exists k, 0 <= k < r /\ j = i + k by exists (j - i); smt(). have /# : (i + k) %/r = i %/ r @@ -642,7 +659,7 @@ lemma eager_inv_mem_dom2 BlockBitsAllInDom xs (i * r) mp2. proof. move=> [ei1 _] mem j j_ran. -have [ge0_i [_ eq_mp2_block_i]] := ei1 xs i mem. +have [ge0_i eq_mp2_block_i] := ei1 xs i mem. rewrite in_dom. have /# := eq_mp2_block_i j _; smt(). qed. @@ -656,7 +673,7 @@ lemma eager_inv_not_mem_dom2 proof. move=> [_ ei2] ge0_i not_mem_mp2_i j j_ran. case (mem (dom mp1) (xs, j))=> // mem_mp1_j. -have [ge0_j mem_mp2_j_div_r] := ei2 xs j mem_mp1_j. +have mem_mp2_j_div_r := ei2 xs j mem_mp1_j. have /# : j %/ r = i. have [k] [k_ran ->] : exists k, 0 <= k < r /\ j = i * r + k by exists (j - i * r); smt(). @@ -766,6 +783,48 @@ module HybridIROEagerTrans = { } }. +pred eager_eq_except + (xs : block list, i j : int, + mp1 mp2 : (block list * int, bool) fmap) = + forall (ys : block list, k : int), + ys <> xs \/ k < i \/ j <= k => mp1.[(ys, k)] = mp2.[(ys, k)]. + +lemma eager_eq_except_upd1_eq_in + (xs : block list, i j k : int, y : bool, + mp1 mp2 : (block list * int, bool) fmap) : + eager_eq_except xs i j mp1 mp2 => i <= k => k < j => + eager_eq_except xs i j mp1.[(xs, k) <- y] mp2. +proof. +move=> eee le_ik lt_kj ys l disj. +have ne : (xs, k) <> (ys, l) by smt(). +smt(getP). +qed. + +lemma eager_eq_except_upd2_eq_in + (xs : block list, i j k : int, y : bool, + mp1 mp2 : (block list * int, bool) fmap) : + eager_eq_except xs i j mp1 mp2 => i <= k => k < j => + eager_eq_except xs i j mp1 mp2.[(xs, k) <- y]. +proof. +move=> eee le_ik lt_kj ys l disj. +have ne : (xs, k) <> (ys, l) by smt(). +smt(getP). +qed. + +lemma eager_eq_except_maps_eq + (xs : block list, i j : int, y : bool, + mp1 mp2 : (block list * int, bool) fmap) : + i <= j => eager_eq_except xs i j mp1 mp2 => + (forall (k : int), + i <= k < j => mp1.[(xs, k)] = mp2.[(xs, k)]) => + mp1 = mp2. +proof. +move=> lt_ij eee ran_k. +apply fmapP=> p. +have [ys k] -> /# : exists ys k, p = (ys, k) + by exists p.`1, p.`2; smt(). +qed. + lemma HybridIROEagerTrans_next_block_split : equiv [HybridIROEagerTrans.next_block ~ HybridIROEagerTrans.next_block_split : @@ -775,9 +834,6 @@ lemma HybridIROEagerTrans_next_block_split : ={res, HybridIROEager.mp}]. proof. proc=> /=. -(* -ROUGH WORK -- will rework tomorrow (invariants were faulty) - case (mem (dom HybridIROEager.mp{2}) (xs{2}, i{2})). rcondt{2} 1; first auto. conseq @@ -802,31 +858,75 @@ sp; exists* i{1}; elim*=> i''. conseq (_ : ={i, m, xs, bs, HybridIROEager.mp} /\ i'' = i{1} /\ - i'' = i'{2} /\ i'' + r = m{1} /\ + i'' = i'{2} /\ i'' + r = m{1} /\ size bs{1} = i'' /\ (forall (j : int), i{1} <= j < m{1} => ! mem (dom HybridIROEager.mp{1}) (xs{1}, j)) ==> _). progress; smt(gt0_r). seq 1 1 : - (={i, m, xs, bs, HybridIROEager.mp} /\ i'{2} = i'' /\ i{1} = i'' + r /\ - size bs{1} = r /\ + (={i, m, xs, bs} /\ i'{2} = i'' /\ i{1} = i'' + r /\ + size bs{1} = i'' + r /\ m{1} = i'' + r /\ (forall (j : int), - i'' <= j < i{1} => - HybridIROEager.mp{1}.[(xs{1}, j)] = Some(nth true bs{1} (j - i'')))). + i'' <= j < i'' + r => + HybridIROEager.mp{1}.[(xs{1}, j)] = Some(nth true bs{1} j)) /\ + (forall (j : int), + i'' <= j < i'' + 1 => + ! mem (dom HybridIROEager.mp{2}) (xs{1}, j)) /\ + eager_eq_except xs{1} i'' i{1} HybridIROEager.mp{1} HybridIROEager.mp{2}). while - (={i, m, xs, bs} /\ i'' = i'{2} /\ i'' + r = m{1} /\ i'' <= i{1} /\ - i{1} <= m{1} /\ size bs{1} = i{1} - i'' /\ + (={i, m, xs, bs} /\ i'{2} = i'' /\ m{1} = i'' + r /\ + i'' <= i{1} <= i'' + r /\ size bs{1} = i{1} /\ (forall (j : int), i'' <= j < i{1} => - HybridIROEager.mp{1}.[(xs{1}, j)] = Some(nth true bs{1} (j - i''))) /\ + HybridIROEager.mp{1}.[(xs{1}, j)] = Some(nth true bs{1} j)) /\ (forall (j : int), - i{1} <= j < m{1} => - ! mem (dom HybridIROEager.mp{1}) (xs{1}, j))). + i{1} <= j < i'' + r => + ! mem (dom HybridIROEager.mp{1}) (xs{1}, j)) /\ + (forall (j : int), + i'' <= j < i'' + r => + ! mem (dom HybridIROEager.mp{2}) (xs{1}, j)) /\ + eager_eq_except xs{1} i'' (i'' + r) HybridIROEager.mp{1} HybridIROEager.mp{2}). inline*; rcondt{1} 3; first auto; smt(). -sp; wp; rnd; skip. -*) -admit. +sp; wp; rnd; skip; progress. +by rewrite getP_eq oget_some. +smt(). smt(). smt(getP_eq size_rcons). +rewrite nth_rcons /=. +case (j = size bs{2})=> [-> /= | ne_j_size_bs]. +by rewrite getP_eq oget_some. +have -> /= : j < size bs{2} by smt(). +rewrite getP ne_j_size_bs /= /#. +rewrite domP in_fsetU1 /#. +by apply eager_eq_except_upd1_eq_in. +skip; progress; smt(gt0_r). +sp; elim*=> i_R. +conseq + (_ : + ={xs, bs, m} /\ i{2} = i'' /\ i{1} = i'' + r /\ m{1} = i'' + r /\ + size bs{1} = i'' + r /\ + (forall (j : int), + i'' <= j < i'' + r => + HybridIROEager.mp{1}.[(xs{1}, j)] = Some (nth true bs{1} j)) /\ + eager_eq_except xs{1} i'' (i'' + r) + HybridIROEager.mp{1} HybridIROEager.mp{2} ==> + _)=> //. +while{2} + (={xs, bs, m} /\ i'' <= i{2} <= i'' + r /\ i{1} = i'' + r /\ + m{1} = i'' + r /\ size bs{1} = i'' + r /\ + (forall (j : int), + i'' <= j < i{2} => + HybridIROEager.mp{1}.[(xs{1}, j)] = HybridIROEager.mp{2}.[(xs{1}, j)]) /\ + (forall (j : int), + i{2} <= j < i'' + r => + HybridIROEager.mp{1}.[(xs{1}, j)] = Some (nth true bs{1} j)) /\ + eager_eq_except xs{1} i'' (i'' + r) + HybridIROEager.mp{1} HybridIROEager.mp{2}) + (m{2} - i{2}). +progress; auto; progress; + [smt() | smt(gt0_r) | smt(getP) | smt() | + by apply eager_eq_except_upd2_eq_in | smt()]. +skip; progress; + [smt(gt0_r) | smt() | smt() | smt() | smt(eager_eq_except_maps_eq)]. qed. module BlockSpongeTrans = { @@ -893,8 +993,7 @@ trivial. smt(size_blocks2bits). trivial. apply HybridIROEagerTrans_next_block_split. -proc=> /=. -inline*. +proc=> /=; inline*. admit. qed. From 5d138397c3ebf23f77179bd90406dbbcc57a9225 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Wed, 3 Aug 2016 15:14:31 -0400 Subject: [PATCH 186/525] More progress on top-level proof. --- proof/Sponge.ec | 152 +++++++++++++++++++++++++++++++++++++++++------- 1 file changed, 132 insertions(+), 20 deletions(-) diff --git a/proof/Sponge.ec b/proof/Sponge.ec index a28b46b..d45a533 100644 --- a/proof/Sponge.ec +++ b/proof/Sponge.ec @@ -589,7 +589,8 @@ pred EagerInvar mem (dom mp1) (xs, i) => 0 <= i /\ (forall (j : int), i * r <= j < (i + 1) * r => - mp2.[(xs, j)] = Some(nth false (ofblock (oget mp1.[(xs, i)])) j))) /\ + mp2.[(xs, j)] = + Some(nth false (ofblock (oget mp1.[(xs, i)])) (j - i * r)))) /\ (forall (xs : block list, j : int), mem (dom mp2) (xs, j) => mem (dom mp1) (xs, j %/ r)). @@ -651,7 +652,7 @@ have /# : (i + k) %/r = i %/ r by rewrite divzDl // (divz_small k r) 1:ger0_norm 1:ge0_r. qed. -lemma eager_inv_mem_dom2 +lemma eager_inv_mem_dom1 (mp1 : (block list * int, block) fmap, mp2 : (block list * int, bool) fmap, xs : block list, i : int) : @@ -664,16 +665,16 @@ rewrite in_dom. have /# := eq_mp2_block_i j _; smt(). qed. -lemma eager_inv_not_mem_dom2 - (mp1 : (block list * int, bool) fmap, - mp2 : (block list * int, block) fmap, +lemma eager_inv_not_mem_dom1 + (mp1 : (block list * int, block) fmap, + mp2 : (block list * int, bool) fmap, xs : block list, i : int) : - EagerInvar mp2 mp1 => 0 <= i => ! mem (dom mp2) (xs, i) => - BlockBitsAllOutDom xs (i * r) mp1. + EagerInvar mp1 mp2 => 0 <= i => ! mem (dom mp1) (xs, i) => + BlockBitsAllOutDom xs (i * r) mp2. proof. -move=> [_ ei2] ge0_i not_mem_mp2_i j j_ran. -case (mem (dom mp1) (xs, j))=> // mem_mp1_j. -have mem_mp2_j_div_r := ei2 xs j mem_mp1_j. +move=> [_ ei2] ge0_i not_mem_mp1_i j j_ran. +case (mem (dom mp2) (xs, j))=> // mem_mp2_j. +have mem_mp1_j_div_r := ei2 xs j mem_mp2_j. have /# : j %/ r = i. have [k] [k_ran ->] : exists k, 0 <= k < r /\ j = i * r + k by exists (j - i * r); smt(). @@ -980,20 +981,131 @@ transitivity EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> res{1}.`1 = blocks2bits res{2}.`1 /\ res{1}.`2 = res{2}.`2 * r /\ res{2}.`2 = i2 + 1 /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). -progress; exists HybridIROEager.mp{1}, (i{1}, m{1}, xs{1}, bs{1}). -progress. smt(). -smt(size_blocks2bits). + EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1})=> //. +move=> |> &1 &2 ge0_i2 -> i1_eq_i2_tim_r m_min_i1_eq_r -> sz_bs_eq_i2 ei. +exists HybridIROEager.mp{1}, (i{1}, m{1}, x{2}, blocks2bits bs{2})=> |>. +split. split. smt(gt0_r). split. smt(size_blocks2bits). apply (eager_inv_imp_block_bits_dom BlockSponge.BIRO.IRO.mp{2} - HybridIROEager.mp{1} xs{1} i{1}). -smt(ge0_r). -rewrite H1; smt(dvdz_mulr dvdzz). -trivial. + HybridIROEager.mp{1} x{2} i{1})=> //. +rewrite i1_eq_i2_tim_r mulr_ge0 // ge0_r. +rewrite i1_eq_i2_tim_r dvdz_mull dvdzz. smt(size_blocks2bits). -trivial. apply HybridIROEagerTrans_next_block_split. -proc=> /=; inline*. +proc=> /=; inline*; sp; wp. +case (mem (dom BlockSponge.BIRO.IRO.mp{2}) (x0{2}, n{2})). +(* mem (dom BlockSponge.BIRO.IRO.mp{2}) (x0{2}, n{2}) *) +rcondf{2} 1; first auto. +rcondt{1} 1; first auto; progress [-delta]. +have bb_all_in : BlockBitsAllInDom x{m} (i{m} * r) HybridIROEager.mp{hr} + by apply (eager_inv_mem_dom1 BlockSponge.BIRO.IRO.mp{m}). +smt(gt0_r). simplify. +conseq + (_ : + x0{2} = x{2} /\ n{2} = i{2} /\ i2 = i{2} /\ 0 <= i{2} /\ xs{1} = x{2} /\ + i{1} = i{2} * r /\ m{1} - i{1} = r /\ size bs{1} = i{1} /\ + bs{1} = blocks2bits bs{2} /\ + EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} /\ + mem (dom BlockSponge.BIRO.IRO.mp{2}) (x0{2}, n{2}) /\ + BlockBitsAllInDom xs{1} i{1} HybridIROEager.mp{1} ==> + _). +move=> |> &1 &2 ge0_i m_min_i_tim_r_eq_r sz_b2b_bs_eq_i_tim_r ei mem_mp2_x_i. +by apply (eager_inv_mem_dom1 BlockSponge.BIRO.IRO.mp{2}). +exists* i{1}; elim*=> i1. exists* bs{1}; elim*=> bs1. +conseq + (_ : + i1 = i{1} /\ 0 <= i2 /\ i1 = i2 * r /\ m{1} - i1 = r /\ + bs1 = bs{1} /\ size bs1 = i1 /\ bs1 = blocks2bits bs{2} /\ + EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} /\ + mem (dom BlockSponge.BIRO.IRO.mp{2}) (xs{1}, i2) /\ + BlockBitsAllInDom xs{1} i1 HybridIROEager.mp{1} ==> + bs{1} = + blocks2bits (rcons bs{2} (oget BlockSponge.BIRO.IRO.mp{2}.[(xs{1}, i2)])) /\ + i{1} = (i2 + 1) * r /\ + EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1})=> //. +while{1} + (i1 <= i{1} <= m{1} /\ i1 = i2 * r /\ size bs{1} = i{1} /\ + m{1} - i1 = r /\ + bs{1} = + bs1 ++ + take (i{1} - i1) + (ofblock (oget(BlockSponge.BIRO.IRO.mp{2}.[(xs{1}, i2)]))) /\ + EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} /\ + BlockBitsAllInDom xs{1} i1 HybridIROEager.mp{1} /\ + mem (dom BlockSponge.BIRO.IRO.mp{2}) (xs{1}, i2)) + (m{1} - i{1}). +move=> &m z. +auto=> + |> &hr i2_tim_r_le_sz_bs sz_bs_le_m m_min_i2_tim_r_eq_r bs_eq ei + bb_all_in mem_blk_mp_xs_i2 sz_bs_lt_m. +split. split. split=> [| _]; smt(). split. +by rewrite -cats1 size_cat. +rewrite -cats1 {1}bs_eq -catA; congr. +have -> : size bs{hr} + 1 - i2 * r = size bs{hr} - i2 * r + 1 by algebra. +rewrite (take_nth false) 1:size_block; first smt(size_ge0). +rewrite -cats1; congr; congr. +have some_form_mp_hr_lookup_eq : + HybridIROEager.mp{hr}.[(xs{hr}, size bs{hr})] = + Some (nth false (ofblock (oget BlockSponge.BIRO.IRO.mp{m}.[(xs{hr}, i2)])) + (size bs{hr} - i2 * r)). + have [ei1 _] := ei. + have [_ ei1_xs_i2] := ei1 xs{hr} i2 mem_blk_mp_xs_i2. + by rewrite ei1_xs_i2 1:/#. +by rewrite some_form_mp_hr_lookup_eq oget_some. +smt(). +skip. (* getting anomaly from => |> *) +move=> &1 &2 [-> [ge0_i2 [i1_eq_i2_tim_r H]]]. +elim H=> [m_min_i1_eq_r [->> [sz_bs1_eq_i1 H]]]. +elim H=> ->> [ei [mem_dom_mp2_xs_i2 bb_all_in]]. +split. split. +split=> [// | _]; rewrite i1_eq_i2_tim_r; smt(ge0_r). +split=> //. split; first smt(). split=> //. +split; first by rewrite /= take0 cats0. split=> //. +move=> i_L bs_L. +split=> [| lt_i_L_m]; first smt(). +move=> [i1_le_i_L_le_m [_ [sz_bs_L_eq_i_L [m1_min_i1_eq_r H]]]]. +elim H=> [bs_L_eq [_ [_ mem_mp2_xs_i2]]]. +split. +have i_L_eq_m : i_L = m{1} by smt(). +rewrite bs_L_eq -cats1 blocks2bits_cat; congr. +rewrite i_L_eq_m m1_min_i1_eq_r blocks2bits_sing. +pose blk := (oget BlockSponge.BIRO.IRO.mp{2}.[(xs{1}, i2)]). +have -> : r = size (ofblock blk) by rewrite size_block. +by rewrite take_size. +split=> //; smt(). +(* ! mem (dom BlockSponge.BIRO.IRO.mp{2}) (x0{2}, n{2}) *) +rcondt{2} 1; first auto. +rcondf{1} 1; first auto; progress [-delta]. +have bb_all_not_in : BlockBitsAllOutDom x{m} (i{m} * r) HybridIROEager.mp{hr} + by apply (eager_inv_not_mem_dom1 BlockSponge.BIRO.IRO.mp{m}). +smt(gt0_r). simplify. +conseq + (_ : + x0{2} = x{2} /\ n{2} = i{2} /\ i2 = i{2} /\ 0 <= i{2} /\ xs{1} = x{2} /\ + i{1} = i{2} * r /\ m{1} - i{1} = r /\ size bs{1} = i{1} /\ + bs{1} = blocks2bits bs{2} /\ + EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} /\ + ! mem (dom BlockSponge.BIRO.IRO.mp{2}) (x0{2}, n{2}) /\ + BlockBitsAllOutDom xs{1} i{1} HybridIROEager.mp{1} ==> + _). +progress [-delta]. +have bb_all_in : BlockBitsAllOutDom x{2} (i{2} * r) HybridIROEager.mp{1} + by apply (eager_inv_not_mem_dom1 BlockSponge.BIRO.IRO.mp{2}). +smt(gt0_r). +sp. +exists* i{1}; elim*=> i1. exists* bs{2}; elim*=> bs2. +conseq + (_ : + 0 <= i2 /\ x0{2} = xs{1} /\ n{2} = i2 /\ + i{1} = i1 /\ i'{1} = i1 /\ i1 = i2 * r /\ m{1} - i1 = r /\ + bs{1} = blocks2bits bs2 /\ size bs{1} = i1 /\ + EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} /\ + ! mem (dom BlockSponge.BIRO.IRO.mp{2}) (x0{2}, i2) /\ + BlockBitsAllOutDom xs{1} i1 HybridIROEager.mp{1} ==> + bs{1} = + blocks2bits (rcons bs2 (oget BlockSponge.BIRO.IRO.mp{2}.[(x0{2}, i2)])) /\ + i{1} = (i2 + 1) * r /\ + EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1})=> //. admit. qed. From ca6e11ef47a8089f33926e57bfe7a725e534f023 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Wed, 3 Aug 2016 22:24:28 -0400 Subject: [PATCH 187/525] Saving work for today. --- proof/Sponge.ec | 266 ++++++++++++++++++++++++++++-------------------- 1 file changed, 155 insertions(+), 111 deletions(-) diff --git a/proof/Sponge.ec b/proof/Sponge.ec index d45a533..fd5889b 100644 --- a/proof/Sponge.ec +++ b/proof/Sponge.ec @@ -399,7 +399,7 @@ module RaiseHybridIRO (HI : HYBRID_IRO) : FUNCTIONALITY = { } }. -pred LazyInvar +pred lazy_invar (mp1 : (bool list * int, bool) fmap, mp2 : (block list * int, bool) fmap) = (forall (bs : bool list, n : int), @@ -410,7 +410,7 @@ pred LazyInvar mem (dom mp1) (bs, n) => oget mp1.[(bs, n)] = oget mp2.[(pad2blocks bs, n)]). -lemma lazy_invar0 : LazyInvar map0 map0. +lemma lazy_invar0 : lazy_invar map0 map0. proof. split; first smt(in_fset0 dom0). split; smt(in_fset0 dom0). @@ -420,7 +420,7 @@ lemma lazy_invar_mem_pad2blocks_l2r (mp1 : (bool list * int, bool) fmap, mp2 : (block list * int, bool) fmap, bs : bool list, i : int) : - LazyInvar mp1 mp2 => mem (dom mp1) (bs, i) => + lazy_invar mp1 mp2 => mem (dom mp1) (bs, i) => mem (dom mp2) (pad2blocks bs, i). proof. smt(). qed. @@ -428,7 +428,7 @@ lemma lazy_invar_mem_pad2blocks_r2l (mp1 : (bool list * int, bool) fmap, mp2 : (block list * int, bool) fmap, bs : bool list, i : int) : - LazyInvar mp1 mp2 => mem (dom mp2) (pad2blocks bs, i) => + lazy_invar mp1 mp2 => mem (dom mp2) (pad2blocks bs, i) => mem (dom mp1) (bs, i). proof. smt(). qed. @@ -436,7 +436,7 @@ lemma lazy_invar_vb (mp1 : (bool list * int, bool) fmap, mp2 : (block list * int, bool) fmap, xs : block list, n : int) : - LazyInvar mp1 mp2 => mem (dom mp2) (xs, n) => + lazy_invar mp1 mp2 => mem (dom mp2) (xs, n) => valid_block xs. proof. smt(). qed. @@ -444,7 +444,7 @@ lemma lazy_invar_lookup_eq (mp1 : (bool list * int, bool) fmap, mp2 : (block list * int, bool) fmap, bs : bool list, n : int) : - LazyInvar mp1 mp2 => mem (dom mp1) (bs, n) => + lazy_invar mp1 mp2 => mem (dom mp1) (bs, n) => oget mp1.[(bs, n)] = oget mp2.[(pad2blocks bs, n)]. proof. smt(). qed. @@ -452,7 +452,7 @@ lemma lazy_invar_upd_mem_dom_iff (mp1 : (bool list * int, bool) fmap, mp2 : (block list * int, bool) fmap, bs cs : bool list, n m : int, b : bool) : - LazyInvar mp1 mp2 => + lazy_invar mp1 mp2 => mem (dom mp1.[(bs, n) <- b]) (cs, m) <=> mem (dom mp2.[(pad2blocks bs, n) <- b]) (pad2blocks cs, m). proof. @@ -471,7 +471,7 @@ lemma lazy_invar_upd2_vb (mp1 : (bool list * int, bool) fmap, mp2 : (block list * int, bool) fmap, bs : bool list, xs : block list, n m : int, b : bool) : - LazyInvar mp1 mp2 => + lazy_invar mp1 mp2 => mem (dom mp2.[(pad2blocks bs, n) <- b]) (xs, m) => valid_block xs. proof. @@ -485,7 +485,7 @@ lemma lazy_invar_upd_lu_eq (mp1 : (bool list * int, bool) fmap, mp2 : (block list * int, bool) fmap, bs cs : bool list, n m : int, b : bool) : - LazyInvar mp1 mp2 => + lazy_invar mp1 mp2 => mem (dom mp1.[(bs, n) <- b]) (cs, m) => oget mp1.[(bs, n) <- b].[(cs, m)] = oget mp2.[(pad2blocks bs, n) <- b].[(pad2blocks cs, m)]. @@ -504,19 +504,19 @@ qed. lemma LowerFun_IRO_HybridIROLazy_f : equiv[LowerFun(IRO).f ~ HybridIROLazy.f : - ={xs, n} /\ LazyInvar IRO.mp{1} HybridIROLazy.mp{2} ==> - ={res} /\ LazyInvar IRO.mp{1} HybridIROLazy.mp{2}]. + ={xs, n} /\ lazy_invar IRO.mp{1} HybridIROLazy.mp{2} ==> + ={res} /\ lazy_invar IRO.mp{1} HybridIROLazy.mp{2}]. proof. proc=> /=; inline HybridIROLazy.g. seq 0 1 : (={n} /\ xs{1} = xs0{2} /\ - LazyInvar IRO.mp{1} HybridIROLazy.mp{2}); first auto. + lazy_invar IRO.mp{1} HybridIROLazy.mp{2}); first auto. case (valid_block xs{1}). rcondt{1} 3; first auto. rcondt{2} 4; first auto. inline*. rcondt{1} 7; first auto. seq 6 3 : (={i, n0} /\ bs{1} = bs0{2} /\ - LazyInvar IRO.mp{1} HybridIROLazy.mp{2} /\ + lazy_invar IRO.mp{1} HybridIROLazy.mp{2} /\ pad2blocks x{1} = xs0{2}). auto; progress; have {2}<- := unpadBlocksK xs0{2}; first @@ -524,7 +524,7 @@ auto; progress; wp. while (={i, n0} /\ bs{1} = bs0{2} /\ - LazyInvar IRO.mp{1} HybridIROLazy.mp{2} /\ + lazy_invar IRO.mp{1} HybridIROLazy.mp{2} /\ pad2blocks x{1} = xs0{2}). sp; auto. if. @@ -550,19 +550,19 @@ qed. lemma IRO_RaiseHybridIRO_HybridIROLazy_f : equiv[IRO.f ~ RaiseHybridIRO(HybridIROLazy).f : ={n} /\ x{1} = bs{2} /\ - LazyInvar IRO.mp{1} HybridIROLazy.mp{2} ==> - ={res} /\ LazyInvar IRO.mp{1} HybridIROLazy.mp{2}]. + lazy_invar IRO.mp{1} HybridIROLazy.mp{2} ==> + ={res} /\ lazy_invar IRO.mp{1} HybridIROLazy.mp{2}]. proof. proc=> /=; inline*. rcondt{1} 3; first auto. rcondt{2} 5; first auto; progress; apply valid_pad2blocks. seq 2 4 : (={i, n} /\ n{1} = n0{2} /\ xs{2} = pad2blocks x{1} /\ bs{1} = bs0{2} /\ - LazyInvar IRO.mp{1} HybridIROLazy.mp{2}); first auto. + lazy_invar IRO.mp{1} HybridIROLazy.mp{2}); first auto. wp. while (={i, n} /\ n{1} = n0{2} /\ xs{2} = pad2blocks x{1} /\ bs{1} = bs0{2} /\ - LazyInvar IRO.mp{1} HybridIROLazy.mp{2}). + lazy_invar IRO.mp{1} HybridIROLazy.mp{2}). wp; sp. if. progress; @@ -572,7 +572,7 @@ progress; HybridIROLazy.mp{2} x{1} i{2})]. rnd; auto; progress; [by rewrite !getP_eq | - by rewrite -(@lazy_invar_upd_mem_dom_iff IRO.mp{1}) | + by rewrite -(lazy_invar_upd_mem_dom_iff IRO.mp{1}) | by rewrite (@lazy_invar_upd_mem_dom_iff IRO.mp{1} HybridIROLazy.mp{2}) | by rewrite (@lazy_invar_upd2_vb IRO.mp{1} HybridIROLazy.mp{2} x{1} xs1 i{2} n1 mpL) | @@ -582,7 +582,7 @@ auto; progress [-delta]; auto. qed. -pred EagerInvar +pred eager_invar (mp1 : (block list * int, block) fmap, mp2 : (block list * int, bool) fmap) = (forall (xs : block list, i : int), @@ -594,30 +594,30 @@ pred EagerInvar (forall (xs : block list, j : int), mem (dom mp2) (xs, j) => mem (dom mp1) (xs, j %/ r)). -pred BlockBitsAllInDom +pred block_bits_all_in_dom (xs : block list, i : int, mp : (block list * int, bool) fmap) = forall (j : int), i <= j < i + r => mem (dom mp) (xs, j). -pred BlockBitsAllOutDom +pred block_bits_all_out_dom (xs : block list, i : int, mp : (block list * int, bool) fmap) = forall (j : int), i <= j < i + r => ! mem (dom mp) (xs, j). -pred BlockBitsDomAllInOrOut +pred block_bits_dom_all_in_or_out (xs : block list, i : int, mp : (block list * int, bool) fmap) = - BlockBitsAllInDom xs i mp \/ BlockBitsAllOutDom xs i mp. + block_bits_all_in_dom xs i mp \/ block_bits_all_out_dom xs i mp. lemma eager_inv_mem_mp1_ge0 (mp1 : (block list * int, block) fmap, mp2 : (block list * int, bool) fmap, xs : block list, i : int) : - EagerInvar mp1 mp2 => mem (dom mp1) (xs, i) => 0 <= i. + eager_invar mp1 mp2 => mem (dom mp1) (xs, i) => 0 <= i. proof. move=> [ei1 ei2] mem_mp1_i; smt(). qed. lemma eager_inv_mem_mp2_ge0 (mp1 : (block list * int, block) fmap, mp2 : (block list * int, bool) fmap, xs : block list, j : int) : - EagerInvar mp1 mp2 => mem (dom mp2) (xs, j) => 0 <= j. + eager_invar mp1 mp2 => mem (dom mp2) (xs, j) => 0 <= j. proof. move=> [ei1 ei2] mem_mp2_j. have mem_mp1_j_div_r : mem (dom mp1) (xs, j %/ r) by smt(). @@ -625,15 +625,15 @@ have ge0_j_div_r : 0 <= j %/ r by smt(). smt(divz_ge0 gt0_r). qed. -lemma eager_invar0 : EagerInvar map0 map0. +lemma eager_invar0 : eager_invar map0 map0. proof. split; smt(dom0 in_fset0). qed. lemma eager_inv_imp_block_bits_dom (mp1 : (block list * int, block) fmap, mp2 : (block list * int, bool) fmap, xs : block list, i : int) : - 0 <= i => r %| i => EagerInvar mp1 mp2 => - BlockBitsDomAllInOrOut xs i mp2. + 0 <= i => r %| i => eager_invar mp1 mp2 => + block_bits_dom_all_in_or_out xs i mp2. proof. move=> ge0_i r_dvd_i [ei1 ei2]. case (mem (dom mp1) (xs, i %/ r))=> [mem_mp1 | not_mem_mp1]. @@ -656,8 +656,8 @@ lemma eager_inv_mem_dom1 (mp1 : (block list * int, block) fmap, mp2 : (block list * int, bool) fmap, xs : block list, i : int) : - EagerInvar mp1 mp2 => mem (dom mp1) (xs, i) => - BlockBitsAllInDom xs (i * r) mp2. + eager_invar mp1 mp2 => mem (dom mp1) (xs, i) => + block_bits_all_in_dom xs (i * r) mp2. proof. move=> [ei1 _] mem j j_ran. have [ge0_i eq_mp2_block_i] := ei1 xs i mem. @@ -669,8 +669,8 @@ lemma eager_inv_not_mem_dom1 (mp1 : (block list * int, block) fmap, mp2 : (block list * int, bool) fmap, xs : block list, i : int) : - EagerInvar mp1 mp2 => 0 <= i => ! mem (dom mp1) (xs, i) => - BlockBitsAllOutDom xs (i * r) mp2. + eager_invar mp1 mp2 => 0 <= i => ! mem (dom mp1) (xs, i) => + block_bits_all_out_dom xs (i * r) mp2. proof. move=> [_ ei2] ge0_i not_mem_mp1_i j j_ran. case (mem (dom mp2) (xs, j))=> // mem_mp2_j. @@ -684,14 +684,14 @@ qed. lemma block_bits_dom_first_in_imp_all_in (xs : block list, i : int, mp : (block list * int, bool) fmap) : - BlockBitsDomAllInOrOut xs i mp => mem (dom mp) (xs, i) => - BlockBitsAllInDom xs i mp. + block_bits_dom_all_in_or_out xs i mp => mem (dom mp) (xs, i) => + block_bits_all_in_dom xs i mp. proof. smt(). qed. lemma block_bits_dom_first_out_imp_all_out (xs : block list, i : int, mp : (block list * int, bool) fmap) : - BlockBitsDomAllInOrOut xs i mp => ! mem (dom mp) (xs, i) => - BlockBitsAllOutDom xs i mp. + block_bits_dom_all_in_or_out xs i mp => ! mem (dom mp) (xs, i) => + block_bits_all_out_dom xs i mp. proof. smt(). qed. lemma HybridIROEager_f_g : @@ -756,9 +756,9 @@ module HybridIROEagerTrans = { } proc next_block_split(i, m : int, xs, bs) = { - var b, i'; + var b, i', cs; - (* assuming BlockBitsDomAllInOrOut xs i HybridIROEager.mp + (* assuming block_bits_dom_all_in_or_out xs i HybridIROEager.mp and m = i + r and size bs = i *) if (mem (dom HybridIROEager.mp) (xs, i)) { @@ -768,13 +768,13 @@ module HybridIROEagerTrans = { i <- i + 1; } } else { - i' <- i; + i' <- i; cs <- []; while (i < m) { b <$ dbool; - bs <- rcons bs b; + cs <- rcons cs b; i <- i + 1; } - i <- i'; + i <- i'; bs <- bs ++ cs; while (i < m) { HybridIROEager.mp.[(xs, i)] <- nth true bs i; i <- i + 1; @@ -831,7 +831,7 @@ lemma HybridIROEagerTrans_next_block_split : [HybridIROEagerTrans.next_block ~ HybridIROEagerTrans.next_block_split : ={i, m, xs, bs, HybridIROEager.mp} /\ m{1} = i{1} + r /\ size bs{1} = i{1} /\ - BlockBitsDomAllInOrOut xs{1} i{1} HybridIROEager.mp{1} ==> + block_bits_dom_all_in_or_out xs{1} i{1} HybridIROEager.mp{1} ==> ={res, HybridIROEager.mp}]. proof. proc=> /=. @@ -858,26 +858,26 @@ rcondf{2} 1; first auto. sp; exists* i{1}; elim*=> i''. conseq (_ : - ={i, m, xs, bs, HybridIROEager.mp} /\ i'' = i{1} /\ - i'' = i'{2} /\ i'' + r = m{1} /\ size bs{1} = i'' /\ + ={i, m, xs, bs, HybridIROEager.mp} /\ i'' = i{1} /\ i'' = i'{2} /\ + i'' + r = m{1} /\ size bs{1} = i'' /\ cs{2} = [] /\ (forall (j : int), i{1} <= j < m{1} => ! mem (dom HybridIROEager.mp{1}) (xs{1}, j)) ==> _). progress; smt(gt0_r). seq 1 1 : - (={i, m, xs, bs} /\ i'{2} = i'' /\ i{1} = i'' + r /\ + (={i, m, xs} /\ i'{2} = i'' /\ i{1} = i'' + r /\ bs{1} = bs{2} ++ cs{2} /\ size bs{1} = i'' + r /\ m{1} = i'' + r /\ (forall (j : int), i'' <= j < i'' + r => HybridIROEager.mp{1}.[(xs{1}, j)] = Some(nth true bs{1} j)) /\ (forall (j : int), - i'' <= j < i'' + 1 => + i'' <= j < i'' + r => ! mem (dom HybridIROEager.mp{2}) (xs{1}, j)) /\ eager_eq_except xs{1} i'' i{1} HybridIROEager.mp{1} HybridIROEager.mp{2}). while - (={i, m, xs, bs} /\ i'{2} = i'' /\ m{1} = i'' + r /\ - i'' <= i{1} <= i'' + r /\ size bs{1} = i{1} /\ + (={i, m, xs} /\ i'{2} = i'' /\ m{1} = i'' + r /\ + i'' <= i{1} <= i'' + r /\ size bs{1} = i{1} /\ bs{1} = bs{2} ++ cs{2} /\ (forall (j : int), i'' <= j < i{1} => HybridIROEager.mp{1}.[(xs{1}, j)] = Some(nth true bs{1} j)) /\ @@ -890,17 +890,20 @@ while eager_eq_except xs{1} i'' (i'' + r) HybridIROEager.mp{1} HybridIROEager.mp{2}). inline*; rcondt{1} 3; first auto; smt(). sp; wp; rnd; skip; progress. +smt(size_cat). +smt(size_cat). +smt(size_rcons size_cat). +rewrite -2!cats1 catA; congr; congr. by rewrite getP_eq oget_some. -smt(). smt(). smt(getP_eq size_rcons). rewrite nth_rcons /=. -case (j = size bs{2})=> [-> /= | ne_j_size_bs]. +case (j = size (bs{2} ++ cs{2}))=> [-> /= | ne_j_size_bs_cat_cs]. by rewrite getP_eq oget_some. -have -> /= : j < size bs{2} by smt(). -rewrite getP ne_j_size_bs /= /#. +have -> /= : j < size(bs{2} ++ cs{2}) by smt(). +rewrite getP ne_j_size_bs_cat_cs /= /#. rewrite domP in_fsetU1 /#. by apply eager_eq_except_upd1_eq_in. -skip; progress; smt(gt0_r). -sp; elim*=> i_R. +skip; progress; smt(gt0_r cats0 size_cat). +sp 0 1; elim*=> i_R. sp; elim*=> cs_R. conseq (_ : ={xs, bs, m} /\ i{2} = i'' /\ i{1} = i'' + r /\ m{1} = i'' + r /\ @@ -965,23 +968,23 @@ lemma HybridIROEager_next (i2 : int) : [HybridIROEagerTrans.next_block ~ BlockSpongeTrans.next_block : i2 = i{2} /\ 0 <= i{2} /\ xs{1} = x{2} /\ i{1} = i{2} * r /\ m{1} - i{1} = r /\ bs{1} = blocks2bits bs{2} /\ size bs{2} = i{2} /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> res{1}.`1 = blocks2bits res{2}.`1 /\ res{1}.`2 = res{2}.`2 * r /\ res{2}.`2 = i2 + 1 /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}]. + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}]. proof. transitivity HybridIROEagerTrans.next_block_split (={i, m, xs, bs, HybridIROEager.mp} /\ m{1} = i{1} + r /\ size bs{1} = i{1} /\ - BlockBitsDomAllInOrOut xs{1} i{1} HybridIROEager.mp{1} ==> + block_bits_dom_all_in_or_out xs{1} i{1} HybridIROEager.mp{1} ==> ={res, HybridIROEager.mp}) (i2 = i{2} /\ 0 <= i{2} /\ xs{1} = x{2} /\ i{1} = i{2} * r /\ m{1} - i{1} = r /\ size bs{1} = i{1} /\ bs{1} = blocks2bits bs{2} /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> res{1}.`1 = blocks2bits res{2}.`1 /\ res{1}.`2 = res{2}.`2 * r /\ res{2}.`2 = i2 + 1 /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1})=> //. + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1})=> //. move=> |> &1 &2 ge0_i2 -> i1_eq_i2_tim_r m_min_i1_eq_r -> sz_bs_eq_i2 ei. exists HybridIROEager.mp{1}, (i{1}, m{1}, x{2}, blocks2bits bs{2})=> |>. split. split. smt(gt0_r). split. smt(size_blocks2bits). @@ -997,7 +1000,7 @@ case (mem (dom BlockSponge.BIRO.IRO.mp{2}) (x0{2}, n{2})). (* mem (dom BlockSponge.BIRO.IRO.mp{2}) (x0{2}, n{2}) *) rcondf{2} 1; first auto. rcondt{1} 1; first auto; progress [-delta]. -have bb_all_in : BlockBitsAllInDom x{m} (i{m} * r) HybridIROEager.mp{hr} +have bb_all_in : block_bits_all_in_dom x{m} (i{m} * r) HybridIROEager.mp{hr} by apply (eager_inv_mem_dom1 BlockSponge.BIRO.IRO.mp{m}). smt(gt0_r). simplify. conseq @@ -1005,9 +1008,9 @@ conseq x0{2} = x{2} /\ n{2} = i{2} /\ i2 = i{2} /\ 0 <= i{2} /\ xs{1} = x{2} /\ i{1} = i{2} * r /\ m{1} - i{1} = r /\ size bs{1} = i{1} /\ bs{1} = blocks2bits bs{2} /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} /\ mem (dom BlockSponge.BIRO.IRO.mp{2}) (x0{2}, n{2}) /\ - BlockBitsAllInDom xs{1} i{1} HybridIROEager.mp{1} ==> + block_bits_all_in_dom xs{1} i{1} HybridIROEager.mp{1} ==> _). move=> |> &1 &2 ge0_i m_min_i_tim_r_eq_r sz_b2b_bs_eq_i_tim_r ei mem_mp2_x_i. by apply (eager_inv_mem_dom1 BlockSponge.BIRO.IRO.mp{2}). @@ -1016,13 +1019,13 @@ conseq (_ : i1 = i{1} /\ 0 <= i2 /\ i1 = i2 * r /\ m{1} - i1 = r /\ bs1 = bs{1} /\ size bs1 = i1 /\ bs1 = blocks2bits bs{2} /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} /\ mem (dom BlockSponge.BIRO.IRO.mp{2}) (xs{1}, i2) /\ - BlockBitsAllInDom xs{1} i1 HybridIROEager.mp{1} ==> + block_bits_all_in_dom xs{1} i1 HybridIROEager.mp{1} ==> bs{1} = blocks2bits (rcons bs{2} (oget BlockSponge.BIRO.IRO.mp{2}.[(xs{1}, i2)])) /\ i{1} = (i2 + 1) * r /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1})=> //. + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1})=> //. while{1} (i1 <= i{1} <= m{1} /\ i1 = i2 * r /\ size bs{1} = i{1} /\ m{1} - i1 = r /\ @@ -1030,8 +1033,8 @@ while{1} bs1 ++ take (i{1} - i1) (ofblock (oget(BlockSponge.BIRO.IRO.mp{2}.[(xs{1}, i2)]))) /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} /\ - BlockBitsAllInDom xs{1} i1 HybridIROEager.mp{1} /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} /\ + block_bits_all_in_dom xs{1} i1 HybridIROEager.mp{1} /\ mem (dom BlockSponge.BIRO.IRO.mp{2}) (xs{1}, i2)) (m{1} - i{1}). move=> &m z. @@ -1076,7 +1079,7 @@ split=> //; smt(). (* ! mem (dom BlockSponge.BIRO.IRO.mp{2}) (x0{2}, n{2}) *) rcondt{2} 1; first auto. rcondf{1} 1; first auto; progress [-delta]. -have bb_all_not_in : BlockBitsAllOutDom x{m} (i{m} * r) HybridIROEager.mp{hr} +have bb_all_not_in : block_bits_all_out_dom x{m} (i{m} * r) HybridIROEager.mp{hr} by apply (eager_inv_not_mem_dom1 BlockSponge.BIRO.IRO.mp{m}). smt(gt0_r). simplify. conseq @@ -1084,28 +1087,69 @@ conseq x0{2} = x{2} /\ n{2} = i{2} /\ i2 = i{2} /\ 0 <= i{2} /\ xs{1} = x{2} /\ i{1} = i{2} * r /\ m{1} - i{1} = r /\ size bs{1} = i{1} /\ bs{1} = blocks2bits bs{2} /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} /\ ! mem (dom BlockSponge.BIRO.IRO.mp{2}) (x0{2}, n{2}) /\ - BlockBitsAllOutDom xs{1} i{1} HybridIROEager.mp{1} ==> + block_bits_all_out_dom xs{1} i{1} HybridIROEager.mp{1} ==> _). progress [-delta]. -have bb_all_in : BlockBitsAllOutDom x{2} (i{2} * r) HybridIROEager.mp{1} +have bb_all_in : block_bits_all_out_dom x{2} (i{2} * r) HybridIROEager.mp{1} by apply (eager_inv_not_mem_dom1 BlockSponge.BIRO.IRO.mp{2}). smt(gt0_r). -sp. -exists* i{1}; elim*=> i1. exists* bs{2}; elim*=> bs2. +sp. exists* i{1}; elim*=> i1. exists* bs{2}; elim*=> bs2. conseq (_ : 0 <= i2 /\ x0{2} = xs{1} /\ n{2} = i2 /\ i{1} = i1 /\ i'{1} = i1 /\ i1 = i2 * r /\ m{1} - i1 = r /\ - bs{1} = blocks2bits bs2 /\ size bs{1} = i1 /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} /\ + bs{1} = blocks2bits bs2 /\ size bs{1} = i1 /\ cs{1} = [] /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} /\ ! mem (dom BlockSponge.BIRO.IRO.mp{2}) (x0{2}, i2) /\ - BlockBitsAllOutDom xs{1} i1 HybridIROEager.mp{1} ==> + block_bits_all_out_dom xs{1} i1 HybridIROEager.mp{1} ==> bs{1} = blocks2bits (rcons bs2 (oget BlockSponge.BIRO.IRO.mp{2}.[(x0{2}, i2)])) /\ i{1} = (i2 + 1) * r /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1})=> //. + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1})=> //. +alias{2} 1 with w. +seq 1 1 : + (0 <= i2 /\ x0{2} = xs{1} /\ n{2} = i2 /\ + i{1} = m{1} /\ i'{1} = i1 /\ i1 = i2 * r /\ m{1} - i1 = r /\ + bs{1} = blocks2bits bs2 /\ size bs{1} = i1 /\ cs{1} = ofblock w{2} /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} /\ + ! mem (dom BlockSponge.BIRO.IRO.mp{2}) (x0{2}, i2) /\ + block_bits_all_out_dom xs{1} i1 HybridIROEager.mp{1}). +conseq + (_ : + cs{1} = [] /\ m{1} - i{1} = r /\ 0 <= i{1} ==> + cs{1} = ofblock w{2} /\ i{1} = m{1})=> //. +progress; rewrite mulr_ge0 // ge0_r. +admit. +wp; simplify. sp; elim*=> bs_L _. +exists* HybridIROEager.mp{1}; elim*=> mp1'. +conseq + (_ : + i{1} = i1 /\ bs{1} = blocks2bits bs2 ++ (ofblock w{2}) /\ + 0 <= i2 /\ x0{2} = xs{1} /\ n{2} = i2 /\ i1 = i2 * r /\ + m{1} - i1 = r /\ size(blocks2bits bs2) = i1 /\ + mp1' = HybridIROEager.mp{1} /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} mp1' /\ + ! mem (dom BlockSponge.BIRO.IRO.mp{2}) (x0{2}, i2) /\ + block_bits_all_out_dom xs{1} i1 mp1' ==> + _)=> //. +(* this probably needs work -- tomorrow! *) +while{1} + (bs{1} = blocks2bits bs2 ++ (ofblock w{2}) /\ + 0 <= i2 /\ x0{2} = xs{1} /\ n{2} = i2 /\ i1 = i2 * r /\ + m{1} - i1 = r /\ size(blocks2bits bs2) = i1 /\ + i1 <= i{1} <= m{1} /\ + eager_eq_except xs{1} i1 (i1 + r) + mp1' HybridIROEager.mp{1} /\ + (forall (j : int), + i1 <= j < i{1} => + HybridIROEager.mp{1}.[(xs{1}, j)] = + Some(nth false bs{1} j)) /\ + (forall (j : int), + i{1} <= j < m{1} => ! mem (dom HybridIROEager.mp{1}) (xs{1}, j))) + (m{1} - i{1}). +admit. admit. qed. @@ -1113,8 +1157,8 @@ lemma HybridIROEager_g_BlockIRO_f (n1 : int) (x2 : block list) : equiv[HybridIROEager.g ~ BlockSponge.BIRO.IRO.f : n1 = n{1} /\ x2 = x{2} /\ xs{1} = x{2} /\ n{2} = (n{1} + r - 1) %/ r /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} /\ (valid_block x2 => (n1 <= 0 => res{1} = [] /\ res{2} = []) /\ (0 < n1 => @@ -1127,8 +1171,8 @@ transitivity (={n, xs, HybridIROEager.mp} ==> ={res, HybridIROEager.mp}) (n1 = n{1} /\ x2 = x{2} /\ xs{1} = x{2} /\ n{2} = (n{1} + r - 1) %/ r /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} /\ (valid_block x2 => (n1 <= 0 => res{1} = [] /\ res{2} = []) /\ (0 < n1 => @@ -1140,8 +1184,8 @@ transitivity BlockSpongeTrans.f (n1 = n{1} /\ x2 = x{2} /\ xs{1} = x{2} /\ n{2} = (n{1} + r - 1) %/ r /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} /\ (valid_block x2 => (n1 <= 0 => res{1} = [] /\ res{2} = []) /\ (0 < n1 => @@ -1155,7 +1199,7 @@ seq 3 2 : (n1 = n{1} /\ xs{1} = x{2} /\ x2 = x{2} /\ n{2} = (n{1} + r - 1) %/ r /\ n{2} * r = m{1} /\ i{1} = 0 /\ i{2} = 0 /\ bs{1} = [] /\ bs{2} = [] /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). auto; progress. if=> //. case: (n1 < 0). @@ -1172,10 +1216,10 @@ conseq xs{1} = x{2} /\ n1 = n{1} /\ 0 <= n1 /\ n{2} = (n{1} + r - 1) %/ r /\ n{2} * r = m{1} /\ n{1} <= m{1} /\ i{1} = 0 /\ i{2} = 0 /\ bs{1} = [] /\ bs{2} = [] /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> bs{1} = take n1 (blocks2bits bs{2}) /\ size bs{2} = (n1 + r - 1) %/ r /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). progress; [smt() | apply/needed_blocks_suff]. move=> |> &1 &2 ? ? ? mp1 mp2 bs ? ? ?; smt(size_eq0 needed_blocks0 take0). @@ -1185,17 +1229,17 @@ seq 1 1 : (xs{1} = x{2} /\ n1 = n{1} /\ 0 <= n1 /\ n{2} = (n1 + r - 1) %/ r /\ n{2} * r = m{1} /\ n{1} <= m{1} /\ i{1} = n1 %/ r * r /\ i{2} = n1 %/ r /\ size bs{2} = i{2} /\ bs{1} = blocks2bits bs{2} /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). admit. conseq (_ : n1 = n{1} /\ 0 <= n1 /\ xs{1} = x{2} /\ n{2} = (n1 + r - 1) %/ r /\ n{2} * r = m{1} /\ n{1} <= m{1} /\ i{1} = n1 %/ r * r /\ i{2} = n1 %/ r /\ size bs{2} = i{2} /\ bs{1} = blocks2bits bs{2} /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} /\ (i{2} = n{2} \/ i{2} + 1 = n{2}) ==> bs{1} = take n1 (blocks2bits bs{2}) /\ size bs{2} = n{2} /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}) => //. + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}) => //. progress; by apply/needed_blocks_rel_div_r. case: (i{2} = n{2}). rcondf{2} 1; first auto; progress; smt(). @@ -1216,9 +1260,9 @@ conseq n1 = n{1} /\ 0 <= n1 /\ xs{1} = x{2} /\ 0 <= i{2} /\ i{1} = i{2} * r /\ n{1} <= m{1} /\ m{1} - i{1} = r /\ i{1} <= n{1} /\ bs{1} = blocks2bits bs{2} /\ size bs{1} = i{1} /\ size bs{2} = i{2} /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> bs{1} = take n1 (blocks2bits bs{2}) /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}) + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}) _ (_ : size bs = n - 1 ==> size bs = n). progress; smt(divz_ge0 gt0_r lez_floor size_blocks2bits). @@ -1236,9 +1280,9 @@ transitivity{1} ={HybridIROEager.mp} /\ bs{1} = take n1 bs{2}) (xs{1} = x{2} /\ 0 <= i{2} /\ i{1} = i{2} * r /\ m{1} - i{1} = r /\ size bs{2} = i{2} /\ bs{1} = blocks2bits bs{2} /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> bs{1} = blocks2bits bs{2} /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). progress; exists HybridIROEager.mp{1}, (blocks2bits bs{2}), m{1}, (size bs{2} * r), x{2}; @@ -1275,9 +1319,9 @@ transitivity{1} ={i, m, xs, bs, HybridIROEager.mp}) (xs{1} = x{2} /\ 0 <= i{2} /\ i{1} = i{2} * r /\ m{1} - i{1} = r /\ size bs{2} = i{2} /\ bs{1} = blocks2bits bs{2} /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> bs{1} = blocks2bits bs{2} /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). progress [-delta]; exists HybridIROEager.mp{1}, (blocks2bits bs{2}), m{1}, (size bs{2} * r), x{2}=> //. @@ -1288,9 +1332,9 @@ transitivity{2} } (xs{1} = x{2} /\ 0 <= i{2} /\ i{1} = i{2} * r /\ m{1} - i{1} = r /\ size bs{2} = i{2} /\ bs{1} = blocks2bits bs{2} /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> bs{1} = blocks2bits bs{2} /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}) + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}) (={bs, i, x, BlockSponge.BIRO.IRO.mp} ==> ={bs, i, x, BlockSponge.BIRO.IRO.mp}). progress [-delta]; @@ -1305,18 +1349,18 @@ qed. lemma HybridIROEager_BlockIRO_f : equiv[HybridIROEager.f ~ BlockSponge.BIRO.IRO.f : xs{1} = x{2} /\ ={n} /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> - ={res} /\ EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}]. + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + ={res} /\ eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}]. proof. transitivity HybridIROEager.g (={xs, HybridIROEager.mp} /\ n{2} = n{1} * r /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> res{1} = bits2blocks res{2} /\ ={HybridIROEager.mp}) (xs{1} = x{2} /\ n{1} = n{2} * r /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> res{1} = (blocks2bits res{2}) /\ - EagerInvar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). move=> |> &1 &2 ? n_eq inv. exists BlockSponge.BIRO.IRO.mp{2}, HybridIROEager.mp{1}, (xs{1}, n{1} * r). move=> |>; by rewrite n_eq. @@ -1392,9 +1436,9 @@ local lemma RaiseHybridIRO_HybridIROEager_RaiseFun_BlockIRO_f : equiv[HIRO.RaiseHybridIRO(HIRO.HybridIROEager).f ~ RaiseFun(BlockSponge.BIRO.IRO).f : ={bs, n} /\ ={glob BlockSim} /\ - HIRO.EagerInvar BlockSponge.BIRO.IRO.mp{2} HIRO.HybridIROEager.mp{1} ==> + HIRO.eager_invar BlockSponge.BIRO.IRO.mp{2} HIRO.HybridIROEager.mp{1} ==> ={res} /\ ={glob BlockSim} /\ - HIRO.EagerInvar BlockSponge.BIRO.IRO.mp{2} HIRO.HybridIROEager.mp{1}]. + HIRO.eager_invar BlockSponge.BIRO.IRO.mp{2} HIRO.HybridIROEager.mp{1}]. proof. proc=> /=. exists* n{1}; elim*=> n'. @@ -1426,12 +1470,12 @@ call ={glob Dist, glob BlockSim} /\ IRO.mp{1} = map0 /\ HIRO.HybridIROLazy.mp{2} = map0 ==> ={res}). -proc (={glob BlockSim} /\ HIRO.LazyInvar IRO.mp{1} HIRO.HybridIROLazy.mp{2}). +proc (={glob BlockSim} /\ HIRO.lazy_invar IRO.mp{1} HIRO.HybridIROLazy.mp{2}). progress [-delta]; apply HIRO.lazy_invar0. trivial. -proc (HIRO.LazyInvar IRO.mp{1} HIRO.HybridIROLazy.mp{2})=> //. +proc (HIRO.lazy_invar IRO.mp{1} HIRO.HybridIROLazy.mp{2})=> //. apply HIRO.LowerFun_IRO_HybridIROLazy_f. -proc (HIRO.LazyInvar IRO.mp{1} HIRO.HybridIROLazy.mp{2})=> //. +proc (HIRO.lazy_invar IRO.mp{1} HIRO.HybridIROLazy.mp{2})=> //. apply HIRO.LowerFun_IRO_HybridIROLazy_f. by conseq HIRO.IRO_RaiseHybridIRO_HybridIROLazy_f. auto. @@ -1502,11 +1546,11 @@ call ={res}). proc (={glob BlockSim} /\ - HIRO.EagerInvar BlockSponge.BIRO.IRO.mp{2} HIRO.HybridIROEager.mp{1}) => //. + HIRO.eager_invar BlockSponge.BIRO.IRO.mp{2} HIRO.HybridIROEager.mp{1}) => //. progress [-delta]; apply HIRO.eager_invar0. -proc (HIRO.EagerInvar BlockSponge.BIRO.IRO.mp{2} HIRO.HybridIROEager.mp{1})=> //; +proc (HIRO.eager_invar BlockSponge.BIRO.IRO.mp{2} HIRO.HybridIROEager.mp{1})=> //; conseq HIRO.HybridIROEager_BlockIRO_f=> //. -proc (HIRO.EagerInvar BlockSponge.BIRO.IRO.mp{2} HIRO.HybridIROEager.mp{1})=> //; +proc (HIRO.eager_invar BlockSponge.BIRO.IRO.mp{2} HIRO.HybridIROEager.mp{1})=> //; conseq HIRO.HybridIROEager_BlockIRO_f=> //. exists* n{1}; elim *=> n'. conseq RaiseHybridIRO_HybridIROEager_RaiseFun_BlockIRO_f=> //. From d9db405deb573b4f1d05cee58ab51b8c9e4bf4cc Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Fri, 5 Aug 2016 12:08:53 -0400 Subject: [PATCH 188/525] More progress with top-level proof. --- proof/Sponge.ec | 378 +++++++++++++++++++++++++++++------------------- 1 file changed, 231 insertions(+), 147 deletions(-) diff --git a/proof/Sponge.ec b/proof/Sponge.ec index fd5889b..c5dc472 100644 --- a/proof/Sponge.ec +++ b/proof/Sponge.ec @@ -2,6 +2,7 @@ (* checks with both Alt-Ergo and Z3 *) require import Fun Pair Int IntDiv Real List Option FSet NewFMap DBool. +import IntExtra. require import Common StdOrder. import IntOrder. require (*--*) IRO BlockSponge RndO. @@ -520,7 +521,7 @@ seq 6 3 : pad2blocks x{1} = xs0{2}). auto; progress; have {2}<- := unpadBlocksK xs0{2}; first - by rewrite (@some_oget (unpad_blocks xs0{2})). + by rewrite (some_oget (unpad_blocks xs0{2})). wp. while (={i, n0} /\ bs{1} = bs0{2} /\ @@ -535,11 +536,11 @@ progress; HybridIROLazy.mp{2} x{1} i{2})]. rnd; auto; progress; [by rewrite !getP_eq | - by rewrite -(@lazy_invar_upd_mem_dom_iff IRO.mp{1}) | - by rewrite (@lazy_invar_upd_mem_dom_iff IRO.mp{1} HybridIROLazy.mp{2}) | - by rewrite (@lazy_invar_upd2_vb IRO.mp{1} HybridIROLazy.mp{2} + by rewrite -(lazy_invar_upd_mem_dom_iff IRO.mp{1}) | + by rewrite (lazy_invar_upd_mem_dom_iff IRO.mp{1} HybridIROLazy.mp{2}) | + by rewrite (lazy_invar_upd2_vb IRO.mp{1} HybridIROLazy.mp{2} x{1} xs2 i{2} n2 mpL) | - by rewrite (@lazy_invar_upd_lu_eq IRO.mp{1} HybridIROLazy.mp{2})]. + by rewrite (lazy_invar_upd_lu_eq IRO.mp{1} HybridIROLazy.mp{2})]. auto; progress [-delta]. by rewrite (lazy_invar_lookup_eq IRO.mp{1} HybridIROLazy.mp{2} x{1} i{2}). auto. @@ -573,10 +574,10 @@ progress; rnd; auto; progress; [by rewrite !getP_eq | by rewrite -(lazy_invar_upd_mem_dom_iff IRO.mp{1}) | - by rewrite (@lazy_invar_upd_mem_dom_iff IRO.mp{1} HybridIROLazy.mp{2}) | - by rewrite (@lazy_invar_upd2_vb IRO.mp{1} HybridIROLazy.mp{2} + by rewrite (lazy_invar_upd_mem_dom_iff IRO.mp{1} HybridIROLazy.mp{2}) | + by rewrite (lazy_invar_upd2_vb IRO.mp{1} HybridIROLazy.mp{2} x{1} xs1 i{2} n1 mpL) | - by rewrite (@lazy_invar_upd_lu_eq IRO.mp{1} HybridIROLazy.mp{2})]. + by rewrite (lazy_invar_upd_lu_eq IRO.mp{1} HybridIROLazy.mp{2})]. auto; progress [-delta]; by rewrite (lazy_invar_lookup_eq IRO.mp{1} HybridIROLazy.mp{2} x{1} i{2}). auto. @@ -756,7 +757,7 @@ module HybridIROEagerTrans = { } proc next_block_split(i, m : int, xs, bs) = { - var b, i', cs; + var b, j, cs; (* assuming block_bits_dom_all_in_or_out xs i HybridIROEager.mp and m = i + r and size bs = i *) @@ -768,13 +769,13 @@ module HybridIROEagerTrans = { i <- i + 1; } } else { - i' <- i; cs <- []; - while (i < m) { + j <- 0; cs <- []; + while (j < r) { b <$ dbool; cs <- rcons cs b; - i <- i + 1; + j <- j + 1; } - i <- i'; bs <- bs ++ cs; + bs <- bs ++ cs; while (i < m) { HybridIROEager.mp.[(xs, i)] <- nth true bs i; i <- i + 1; @@ -790,6 +791,14 @@ pred eager_eq_except forall (ys : block list, k : int), ys <> xs \/ k < i \/ j <= k => mp1.[(ys, k)] = mp2.[(ys, k)]. +lemma eager_eq_except_mem_iff + (xs ys : block list, i j k: int, + mp1 mp2 : (block list * int, bool) fmap) : + eager_eq_except xs i j mp1 mp2 => + ys <> xs \/ k < i \/ j <= k => + mem (dom mp1) (ys, k) <=> mem (dom mp2) (ys, k). +proof. smt(in_dom get_oget). qed. + lemma eager_eq_except_upd1_eq_in (xs : block list, i j k : int, y : bool, mp1 mp2 : (block list * int, bool) fmap) : @@ -826,6 +835,73 @@ have [ys k] -> /# : exists ys k, p = (ys, k) by exists p.`1, p.`2; smt(). qed. +lemma eager_invar_eq_except_upd1 + (mp1 : (block list * int, block) fmap, + mp2 : (block list * int, bool) fmap, + mp2' : (block list * int, bool) fmap, + xs : block list, i : int, y : block) : + 0 <= i => eager_invar mp1 mp2 => + eager_eq_except xs (i * r) ((i + 1) * r) mp2 mp2' => + (forall (j : int), + i * r <= j < (i + 1) * r => + mp2'.[(xs, j)] = Some (nth false (ofblock y) (j - i * r))) => + eager_invar mp1.[(xs, i) <- y] mp2'. +proof. +move=> ge0_i [ei1 ei2] ee mp2'_ran_eq. +split=> [ys k mem_mp1_upd_xs_i_y_ys_k | ys k mem_dom_mp2'_ys_k]. +case (xs = ys)=> [eq_xs_ys | ne_xs_ys]. +case (k = i)=> [eq_k_i | ne_k_i]. +split; first smt(). +move=> j j_ran. +by rewrite -eq_xs_ys eq_k_i getP_eq mp2'_ran_eq -eq_k_i. +rewrite domP in_fsetU1 in mem_mp1_upd_xs_i_y_ys_k. +have xs_i_ne_ys_k : (xs, i) <> (ys, k) by smt(). +have mem_mp1_ys_k : mem (dom mp1) (ys, k) by smt(). +split; first smt(eager_inv_mem_mp2_ge0). +move=> j j_ran; rewrite getP. +have -> /= : (ys, k) <> (xs, i) by smt(). +have [_ ei1_ys_k_snd] := ei1 ys k mem_mp1_ys_k. +have <- : + mp2.[(ys, j)] = + Some (nth false (ofblock (oget mp1.[(ys, k)])) (j - k * r)) + by rewrite ei1_ys_k_snd. +have /# : j < i * r \/ (i + 1) * r <= j. + have [lt_ki | lt_ik] : k < i \/ i < k by smt(). + left. + have le_k_add1_i : k + 1 <= i + by rewrite addzC lez_add1r. + by rewrite (ltr_le_trans ((k + 1) * r)) 1:/# ler_pmul2r 1:gt0_r. + right. + have le_i_add1_k : i + 1 <= k + by rewrite addzC lez_add1r. + rewrite (lez_trans (k * r)) 1:ler_pmul2r 1:gt0_r // /#. +rewrite domP in_fsetU1 in mem_mp1_upd_xs_i_y_ys_k. +have xs_i_ne_ys_k : (xs, i) <> (ys, k) by smt(). +have mem_mp1_ys_k : mem (dom mp1) (ys, k) by smt(). +split; first smt(eager_inv_mem_mp2_ge0). +move=> j j_ran; rewrite getP. +have -> /= : (ys, k) <> (xs, i) by smt(). +have [_ ei1_ys_k_snd] := ei1 ys k mem_mp1_ys_k. +have <- /# : + mp2.[(ys, j)] = + Some (nth false (ofblock (oget mp1.[(ys, k)])) (j - k * r)) + by rewrite ei1_ys_k_snd. +rewrite domP in_fsetU1. +case (xs = ys)=> [-> | ne_xs_ys]. +case (k < i * r)=> [lt_k_i_tim_r | not_lt_k_i_tim_r]. +smt(eager_eq_except_mem_iff). +case ((i + 1) * r <= k)=> [i_add1_tim_r_le_k | not_i_add1_tim_r_le_k]. +smt(eager_eq_except_mem_iff). +right. +have le_i_tim_r_k : i * r <= k by smt(). +have lt_k_i_add1_tim_r : k < (i + 1) * r by smt(). +have -> // : i = k %/ r. + apply eqz_leq; split. + by rewrite lez_divRL 1:gt0_r. + by rewrite -ltzS ltz_divLR 1:gt0_r. +smt(eager_eq_except_mem_iff). +qed. + lemma HybridIROEagerTrans_next_block_split : equiv [HybridIROEagerTrans.next_block ~ HybridIROEagerTrans.next_block_split : @@ -836,6 +912,7 @@ lemma HybridIROEagerTrans_next_block_split : proof. proc=> /=. case (mem (dom HybridIROEager.mp{2}) (xs{2}, i{2})). +(* mem (dom HybridIROEager.mp{2}) (xs{2}, i{2}) *) rcondt{2} 1; first auto. conseq (_ : @@ -854,76 +931,73 @@ wp; inline*. rcondf{1} 3; first auto; smt(). auto; smt(). auto. +(* ! mem (dom HybridIROEager.mp{2}) (xs{2}, i{2}) *) rcondf{2} 1; first auto. -sp; exists* i{1}; elim*=> i''. +sp; exists* i{1}; elim*=> i'. conseq (_ : - ={i, m, xs, bs, HybridIROEager.mp} /\ i'' = i{1} /\ i'' = i'{2} /\ - i'' + r = m{1} /\ size bs{1} = i'' /\ cs{2} = [] /\ + ={i, m, xs, bs, HybridIROEager.mp} /\ i{1} = i' /\ + i' + r = m{1} /\ size bs{1} = i' /\ cs{2} = [] /\ j{2} = 0 /\ (forall (j : int), - i{1} <= j < m{1} => + i' <= j < i' + r => ! mem (dom HybridIROEager.mp{1}) (xs{1}, j)) ==> _). progress; smt(gt0_r). -seq 1 1 : - (={i, m, xs} /\ i'{2} = i'' /\ i{1} = i'' + r /\ bs{1} = bs{2} ++ cs{2} /\ - size bs{1} = i'' + r /\ m{1} = i'' + r /\ - (forall (j : int), - i'' <= j < i'' + r => - HybridIROEager.mp{1}.[(xs{1}, j)] = Some(nth true bs{1} j)) /\ - (forall (j : int), - i'' <= j < i'' + r => - ! mem (dom HybridIROEager.mp{2}) (xs{1}, j)) /\ - eager_eq_except xs{1} i'' i{1} HybridIROEager.mp{1} HybridIROEager.mp{2}). +seq 1 2 : + (={m, xs} /\ i{2} = i' /\ i{1} = i' + r /\ bs{1} = bs{2} /\ + size bs{1} = i' + r /\ m{1} = i' + r /\ + (forall (k : int), + i' <= k < i' + r => + HybridIROEager.mp{1}.[(xs{1}, k)] = Some(nth true bs{1} k)) /\ + eager_eq_except xs{1} i' (i' + r) HybridIROEager.mp{1} HybridIROEager.mp{2}). +wp. while - (={i, m, xs} /\ i'{2} = i'' /\ m{1} = i'' + r /\ - i'' <= i{1} <= i'' + r /\ size bs{1} = i{1} /\ bs{1} = bs{2} ++ cs{2} /\ - (forall (j : int), - i'' <= j < i{1} => - HybridIROEager.mp{1}.[(xs{1}, j)] = Some(nth true bs{1} j)) /\ - (forall (j : int), - i{1} <= j < i'' + r => - ! mem (dom HybridIROEager.mp{1}) (xs{1}, j)) /\ - (forall (j : int), - i'' <= j < i'' + r => - ! mem (dom HybridIROEager.mp{2}) (xs{1}, j)) /\ - eager_eq_except xs{1} i'' (i'' + r) HybridIROEager.mp{1} HybridIROEager.mp{2}). + (={m, xs} /\ i{2} = i' /\ m{1} = i' + r /\ i' <= i{1} <= i' + r /\ + 0 <= j{2} <= r /\ i{1} - i' = j{2} /\ + size bs{1} = i{1} /\ bs{1} = bs{2} ++ cs{2} /\ + (forall (k : int), + i' <= k < i{1} => + HybridIROEager.mp{1}.[(xs{1}, k)] = Some(nth true bs{1} k)) /\ + (forall (k : int), + i{1} <= k < i' + r => + ! mem (dom HybridIROEager.mp{1}) (xs{1}, k)) /\ + eager_eq_except xs{1} i' (i' + r) HybridIROEager.mp{1} HybridIROEager.mp{2}). inline*; rcondt{1} 3; first auto; smt(). sp; wp; rnd; skip; progress. -smt(size_cat). -smt(size_cat). -smt(size_rcons size_cat). +smt(size_cat). smt(size_cat). smt(size_cat). +smt(size_rcons size_cat). smt(size_cat). +rewrite -cats1; smt(size_cat). rewrite -2!cats1 catA; congr; congr. by rewrite getP_eq oget_some. rewrite nth_rcons /=. -case (j = size (bs{2} ++ cs{2}))=> [-> /= | ne_j_size_bs_cat_cs]. +case (k = size (bs{2} ++ cs{2}))=> [-> /= | ne_k_size_bs_cat_cs]. by rewrite getP_eq oget_some. -have -> /= : j < size(bs{2} ++ cs{2}) by smt(). -rewrite getP ne_j_size_bs_cat_cs /= /#. +have -> /= : k < size(bs{2} ++ cs{2}) by smt(). +rewrite getP ne_k_size_bs_cat_cs /= /#. rewrite domP in_fsetU1 /#. by apply eager_eq_except_upd1_eq_in. +smt(size_cat). smt(size_cat). skip; progress; smt(gt0_r cats0 size_cat). -sp 0 1; elim*=> i_R. sp; elim*=> cs_R. conseq (_ : - ={xs, bs, m} /\ i{2} = i'' /\ i{1} = i'' + r /\ m{1} = i'' + r /\ - size bs{1} = i'' + r /\ - (forall (j : int), - i'' <= j < i'' + r => - HybridIROEager.mp{1}.[(xs{1}, j)] = Some (nth true bs{1} j)) /\ - eager_eq_except xs{1} i'' (i'' + r) + ={xs, bs, m} /\ i{2} = i' /\ i{1} = i' + r /\ m{1} = i' + r /\ + size bs{1} = i' + r /\ + (forall (k : int), + i' <= k < i' + r => + HybridIROEager.mp{1}.[(xs{1}, k)] = Some (nth true bs{1} k)) /\ + eager_eq_except xs{1} i' (i' + r) HybridIROEager.mp{1} HybridIROEager.mp{2} ==> _)=> //. while{2} - (={xs, bs, m} /\ i'' <= i{2} <= i'' + r /\ i{1} = i'' + r /\ - m{1} = i'' + r /\ size bs{1} = i'' + r /\ - (forall (j : int), - i'' <= j < i{2} => - HybridIROEager.mp{1}.[(xs{1}, j)] = HybridIROEager.mp{2}.[(xs{1}, j)]) /\ - (forall (j : int), - i{2} <= j < i'' + r => - HybridIROEager.mp{1}.[(xs{1}, j)] = Some (nth true bs{1} j)) /\ - eager_eq_except xs{1} i'' (i'' + r) + (={xs, bs, m} /\ i' <= i{2} <= i' + r /\ i{1} = i' + r /\ + m{1} = i' + r /\ size bs{1} = i' + r /\ + (forall (k : int), + i' <= k < i{2} => + HybridIROEager.mp{1}.[(xs{1}, k)] = HybridIROEager.mp{2}.[(xs{1}, k)]) /\ + (forall (k : int), + i{2} <= k < i' + r => + HybridIROEager.mp{1}.[(xs{1}, k)] = Some (nth true bs{1} k)) /\ + eager_eq_except xs{1} i' (i' + r) HybridIROEager.mp{1} HybridIROEager.mp{2}) (m{2} - i{2}). progress; auto; progress; @@ -971,6 +1045,7 @@ lemma HybridIROEager_next (i2 : int) : eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> res{1}.`1 = blocks2bits res{2}.`1 /\ res{1}.`2 = res{2}.`2 * r /\ res{2}.`2 = i2 + 1 /\ + size res{2}.`1 = i2 + 1 /\ eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}]. proof. transitivity @@ -980,52 +1055,44 @@ transitivity block_bits_dom_all_in_or_out xs{1} i{1} HybridIROEager.mp{1} ==> ={res, HybridIROEager.mp}) (i2 = i{2} /\ 0 <= i{2} /\ xs{1} = x{2} /\ i{1} = i{2} * r /\ - m{1} - i{1} = r /\ size bs{1} = i{1} /\ bs{1} = blocks2bits bs{2} /\ + m{1} - i{1} = r /\ size bs{2} = i2 /\ bs{1} = blocks2bits bs{2} /\ eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> res{1}.`1 = blocks2bits res{2}.`1 /\ res{1}.`2 = res{2}.`2 * r /\ res{2}.`2 = i2 + 1 /\ + size res{2}.`1 = i2 + 1 /\ eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1})=> //. move=> |> &1 &2 ge0_i2 -> i1_eq_i2_tim_r m_min_i1_eq_r -> sz_bs_eq_i2 ei. exists HybridIROEager.mp{1}, (i{1}, m{1}, x{2}, blocks2bits bs{2})=> |>. -split. split. smt(gt0_r). split. smt(size_blocks2bits). +split; first smt(). +split; first smt(size_blocks2bits). apply (eager_inv_imp_block_bits_dom BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} x{2} i{1})=> //. rewrite i1_eq_i2_tim_r mulr_ge0 // ge0_r. rewrite i1_eq_i2_tim_r dvdz_mull dvdzz. -smt(size_blocks2bits). apply HybridIROEagerTrans_next_block_split. proc=> /=; inline*; sp; wp. case (mem (dom BlockSponge.BIRO.IRO.mp{2}) (x0{2}, n{2})). (* mem (dom BlockSponge.BIRO.IRO.mp{2}) (x0{2}, n{2}) *) rcondf{2} 1; first auto. rcondt{1} 1; first auto; progress [-delta]. -have bb_all_in : block_bits_all_in_dom x{m} (i{m} * r) HybridIROEager.mp{hr} +have bb_all_in : block_bits_all_in_dom x{m} (size bs{m} * r) HybridIROEager.mp{hr} by apply (eager_inv_mem_dom1 BlockSponge.BIRO.IRO.mp{m}). smt(gt0_r). simplify. -conseq - (_ : - x0{2} = x{2} /\ n{2} = i{2} /\ i2 = i{2} /\ 0 <= i{2} /\ xs{1} = x{2} /\ - i{1} = i{2} * r /\ m{1} - i{1} = r /\ size bs{1} = i{1} /\ - bs{1} = blocks2bits bs{2} /\ - eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} /\ - mem (dom BlockSponge.BIRO.IRO.mp{2}) (x0{2}, n{2}) /\ - block_bits_all_in_dom xs{1} i{1} HybridIROEager.mp{1} ==> - _). -move=> |> &1 &2 ge0_i m_min_i_tim_r_eq_r sz_b2b_bs_eq_i_tim_r ei mem_mp2_x_i. -by apply (eager_inv_mem_dom1 BlockSponge.BIRO.IRO.mp{2}). exists* i{1}; elim*=> i1. exists* bs{1}; elim*=> bs1. conseq (_ : i1 = i{1} /\ 0 <= i2 /\ i1 = i2 * r /\ m{1} - i1 = r /\ - bs1 = bs{1} /\ size bs1 = i1 /\ bs1 = blocks2bits bs{2} /\ - eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} /\ + bs1 = bs{1} /\ size bs{2} = i2 /\ size bs1 = i1 /\ + bs1 = blocks2bits bs{2} /\ mem (dom BlockSponge.BIRO.IRO.mp{2}) (xs{1}, i2) /\ - block_bits_all_in_dom xs{1} i1 HybridIROEager.mp{1} ==> + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> bs{1} = blocks2bits (rcons bs{2} (oget BlockSponge.BIRO.IRO.mp{2}.[(xs{1}, i2)])) /\ - i{1} = (i2 + 1) * r /\ - eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1})=> //. + i{1} = (i2 + 1) * r /\ size bs{2} = i2 /\ size bs{1} = (i2 + 1) * r /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). +progress; smt(size_blocks2bits). +progress; by rewrite size_rcons. while{1} (i1 <= i{1} <= m{1} /\ i1 = i2 * r /\ size bs{1} = i{1} /\ m{1} - i1 = r /\ @@ -1033,14 +1100,13 @@ while{1} bs1 ++ take (i{1} - i1) (ofblock (oget(BlockSponge.BIRO.IRO.mp{2}.[(xs{1}, i2)]))) /\ - eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} /\ - block_bits_all_in_dom xs{1} i1 HybridIROEager.mp{1} /\ - mem (dom BlockSponge.BIRO.IRO.mp{2}) (xs{1}, i2)) + mem (dom BlockSponge.BIRO.IRO.mp{2}) (xs{1}, i2) /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}) (m{1} - i{1}). move=> &m z. auto=> - |> &hr i2_tim_r_le_sz_bs sz_bs_le_m m_min_i2_tim_r_eq_r bs_eq ei - bb_all_in mem_blk_mp_xs_i2 sz_bs_lt_m. + |> &hr i2_tim_r_le_sz_bs sz_bs_le_m m_min_i2_tim_r_eq_r bs_eq + mem_blk_mp_xs_i2 ei sz_bs_lt_m. split. split. split=> [| _]; smt(). split. by rewrite -cats1 size_cat. rewrite -cats1 {1}bs_eq -catA; congr. @@ -1058,14 +1124,14 @@ by rewrite some_form_mp_hr_lookup_eq oget_some. smt(). skip. (* getting anomaly from => |> *) move=> &1 &2 [-> [ge0_i2 [i1_eq_i2_tim_r H]]]. -elim H=> [m_min_i1_eq_r [->> [sz_bs1_eq_i1 H]]]. -elim H=> ->> [ei [mem_dom_mp2_xs_i2 bb_all_in]]. +elim H=> [m_min_i1_eq_r [->> [sz_bs2_eq_i2 H]]]. +elim H=> [sz_b2b_bs2_eq_i1 [->> [mem_dom_mp2_xs_i2 ei]]]. split. split. split=> [// | _]; rewrite i1_eq_i2_tim_r; smt(ge0_r). split=> //. split; first smt(). split=> //. split; first by rewrite /= take0 cats0. split=> //. -move=> i_L bs_L. -split=> [| lt_i_L_m]; first smt(). +move=> bs_L i_L. +split=> [| not_lt_i_L_m]; first smt(). move=> [i1_le_i_L_le_m [_ [sz_bs_L_eq_i_L [m1_min_i1_eq_r H]]]]. elim H=> [bs_L_eq [_ [_ mem_mp2_xs_i2]]]. split. @@ -1075,82 +1141,100 @@ rewrite i_L_eq_m m1_min_i1_eq_r blocks2bits_sing. pose blk := (oget BlockSponge.BIRO.IRO.mp{2}.[(xs{1}, i2)]). have -> : r = size (ofblock blk) by rewrite size_block. by rewrite take_size. +split; first smt(). +split=> //. split=> //; smt(). (* ! mem (dom BlockSponge.BIRO.IRO.mp{2}) (x0{2}, n{2}) *) rcondt{2} 1; first auto. rcondf{1} 1; first auto; progress [-delta]. -have bb_all_not_in : block_bits_all_out_dom x{m} (i{m} * r) HybridIROEager.mp{hr} +have bb_all_not_in : + block_bits_all_out_dom x{m} (size bs{m} * r) HybridIROEager.mp{hr} by apply (eager_inv_not_mem_dom1 BlockSponge.BIRO.IRO.mp{m}). smt(gt0_r). simplify. conseq (_ : x0{2} = x{2} /\ n{2} = i{2} /\ i2 = i{2} /\ 0 <= i{2} /\ xs{1} = x{2} /\ - i{1} = i{2} * r /\ m{1} - i{1} = r /\ size bs{1} = i{1} /\ + i{1} = i{2} * r /\ m{1} - i{1} = r /\ size bs{2} = i2 /\ bs{1} = blocks2bits bs{2} /\ - eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} /\ - ! mem (dom BlockSponge.BIRO.IRO.mp{2}) (x0{2}, n{2}) /\ - block_bits_all_out_dom xs{1} i{1} HybridIROEager.mp{1} ==> - _). -progress [-delta]. -have bb_all_in : block_bits_all_out_dom x{2} (i{2} * r) HybridIROEager.mp{1} - by apply (eager_inv_not_mem_dom1 BlockSponge.BIRO.IRO.mp{2}). -smt(gt0_r). -sp. exists* i{1}; elim*=> i1. exists* bs{2}; elim*=> bs2. -conseq - (_ : - 0 <= i2 /\ x0{2} = xs{1} /\ n{2} = i2 /\ - i{1} = i1 /\ i'{1} = i1 /\ i1 = i2 * r /\ m{1} - i1 = r /\ - bs{1} = blocks2bits bs2 /\ size bs{1} = i1 /\ cs{1} = [] /\ - eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} /\ - ! mem (dom BlockSponge.BIRO.IRO.mp{2}) (x0{2}, i2) /\ - block_bits_all_out_dom xs{1} i1 HybridIROEager.mp{1} ==> - bs{1} = - blocks2bits (rcons bs2 (oget BlockSponge.BIRO.IRO.mp{2}.[(x0{2}, i2)])) /\ - i{1} = (i2 + 1) * r /\ - eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1})=> //. + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + _)=> //. alias{2} 1 with w. -seq 1 1 : - (0 <= i2 /\ x0{2} = xs{1} /\ n{2} = i2 /\ - i{1} = m{1} /\ i'{1} = i1 /\ i1 = i2 * r /\ m{1} - i1 = r /\ - bs{1} = blocks2bits bs2 /\ size bs{1} = i1 /\ cs{1} = ofblock w{2} /\ - eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} /\ - ! mem (dom BlockSponge.BIRO.IRO.mp{2}) (x0{2}, i2) /\ - block_bits_all_out_dom xs{1} i1 HybridIROEager.mp{1}). -conseq - (_ : - cs{1} = [] /\ m{1} - i{1} = r /\ 0 <= i{1} ==> - cs{1} = ofblock w{2} /\ i{1} = m{1})=> //. -progress; rewrite mulr_ge0 // ge0_r. +seq 3 1 : + (xs{1} = x0{2} /\ n{2} = i2 /\ i{2} = i2 /\ 0 <= i2 /\ + i{1} = i2 * r /\ m{1} - i{1} = r /\ size bs{2} = i2 /\ + size cs{1} = r /\ mkblock cs{1} = w{2} /\ bs{1} = blocks2bits bs{2} /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). +conseq (_ : true ==> cs{1} = ofblock w{2}). +progress; [by rewrite size_block | by rewrite mkblockK]. admit. -wp; simplify. sp; elim*=> bs_L _. -exists* HybridIROEager.mp{1}; elim*=> mp1'. +wp; simplify; sp; elim*=> bs_l. +exists* HybridIROEager.mp{1}; elim*=> mp1. +exists* i{1}; elim*=> i1. conseq (_ : - i{1} = i1 /\ bs{1} = blocks2bits bs2 ++ (ofblock w{2}) /\ - 0 <= i2 /\ x0{2} = xs{1} /\ n{2} = i2 /\ i1 = i2 * r /\ - m{1} - i1 = r /\ size(blocks2bits bs2) = i1 /\ - mp1' = HybridIROEager.mp{1} /\ - eager_invar BlockSponge.BIRO.IRO.mp{2} mp1' /\ - ! mem (dom BlockSponge.BIRO.IRO.mp{2}) (x0{2}, i2) /\ - block_bits_all_out_dom xs{1} i1 mp1' ==> - _)=> //. -(* this probably needs work -- tomorrow! *) + xs{1} = x0{2} /\ 0 <= i2 /\ i{1} = i1 /\ i1 = i2 * r /\ + m{1} - i1 = r /\ + bs{1} = blocks2bits bs{2} ++ ofblock w{2} /\ size bs{2} = i2 /\ + size bs{1} = i1 + r /\ mp1 = HybridIROEager.mp{1} /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + bs{1} = blocks2bits bs{2} ++ ofblock w{2} /\ + i{1} = (i2 + 1) * r /\ + eager_invar BlockSponge.BIRO.IRO.mp{2}.[(x0{2}, i2) <- w{2}] + HybridIROEager.mp{1})=> //. +progress; + [by rewrite ofblockK | rewrite size_cat size_blocks2bits /#]. +progress. +by rewrite -cats1 blocks2bits_cat blocks2bits_sing getP_eq + oget_some ofblockK. +by rewrite size_rcons. while{1} - (bs{1} = blocks2bits bs2 ++ (ofblock w{2}) /\ - 0 <= i2 /\ x0{2} = xs{1} /\ n{2} = i2 /\ i1 = i2 * r /\ - m{1} - i1 = r /\ size(blocks2bits bs2) = i1 /\ + (0 <= i1 /\ m{1} - i1 = r /\ size bs{1} = i1 + r /\ i1 <= i{1} <= m{1} /\ - eager_eq_except xs{1} i1 (i1 + r) - mp1' HybridIROEager.mp{1} /\ + eager_eq_except xs{1} i1 (i1 + r) mp1 HybridIROEager.mp{1} /\ (forall (j : int), i1 <= j < i{1} => - HybridIROEager.mp{1}.[(xs{1}, j)] = - Some(nth false bs{1} j)) /\ - (forall (j : int), - i{1} <= j < m{1} => ! mem (dom HybridIROEager.mp{1}) (xs{1}, j))) + HybridIROEager.mp{1}.[(xs{1}, j)] = Some(nth false bs{1} j))) (m{1} - i{1}). -admit. -admit. +progress; auto. +move=> |> &hr ge0_i1 m_min_i1_eq_r sz_bs_eq_i1_plus_r il_le_i _ ee. +move=> mp_ran_eq lt_im. +split. +split; first smt(). +split; first smt(eager_eq_except_upd2_eq_in). +move=> j i1_le_j j_lt_i_add1. +case (i{hr} = j)=> [-> | ne_ij]. +rewrite getP /=; smt(nth_onth onth_nth). +rewrite getP. +have -> /= : (xs{hr}, j) <> (xs{hr}, i{hr}) by smt(). +rewrite mp_ran_eq /#. +smt(). +skip=> &1 &2 [-> [ge0_i2 [eq_i_i1 [i1_eq_i2_tim_r [m_min_i1_eq_r H]]]]]. +elim H=> [bs1_eq [sz_bs2_eq_i2 [sz_bs1_eq_i1_add_r [-> ei]]]]. +have ge0_i1 : 0 <= i1 + by rewrite i1_eq_i2_tim_r divr_ge0 // ge0_r. +split. +split=> //. +split; first smt(ge0_r). +split; first smt(). +split. +split; smt(ge0_r). +split; first smt(). +smt(). +move=> mp_L i_L. +split; first smt(). +move=> not_i_L_lt_m H. +elim H=> [_ [_ [_ [[i1_le_i_L i_L_le_m] [ee mp_L_ran_eq]]]]]. +split; first smt(). +split; first smt(). +apply (eager_invar_eq_except_upd1 BlockSponge.BIRO.IRO.mp{2} + HybridIROEager.mp{1} mp_L x0{2} i2 w{2})=> //. +by rewrite mulzDl /= -i1_eq_i2_tim_r. +move=> j j_ran. +rewrite mp_L_ran_eq 1:/#; congr. +rewrite bs1_eq nth_cat. +have -> : size(blocks2bits bs{2}) = i2 * r + by rewrite size_blocks2bits /#. +have -> // : j < i2 * r = false by smt(). qed. lemma HybridIROEager_g_BlockIRO_f (n1 : int) (x2 : block list) : From 46dc77e30384524021d8310a01eb964faba57cfd Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Fri, 5 Aug 2016 15:51:32 -0400 Subject: [PATCH 189/525] More work on top-level proof. --- proof/Sponge.ec | 50 ++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 49 insertions(+), 1 deletion(-) diff --git a/proof/Sponge.ec b/proof/Sponge.ec index c5dc472..036df39 100644 --- a/proof/Sponge.ec +++ b/proof/Sponge.ec @@ -1037,6 +1037,38 @@ module BlockSpongeTrans = { } }. +module BlockGen = { + proc loop() : block = { + var b : bool; var j : int; var cs : bool list; + j <- 0; cs <- []; + while (j < r) { + b <$ {0,1}; + cs <- rcons cs b; + j <- j + 1; + } + return mkblock cs; + } + + proc direct() : block = { + var w : block; + w <$ bdistr; + return w; + } +}. + +lemma BlockGen_loop_direct : + equiv[BlockGen.loop ~ BlockGen.direct : true ==> ={res}]. +proof. +bypr res{1} res{2}=> // &1 &2 w. +have -> : Pr[BlockGen.direct() @ &2 : w = res] = 1%r / (2 ^ r)%r. + byphoare=> //. + proc; rnd; skip; progress; rewrite DWord.bdistrE. + have -> : (fun x => w = x) = (Pred.pred1 w) + by apply ExtEq.fun_ext=> x; by rewrite (eq_sym w x). + by rewrite count_uniq_mem 1:enum_uniq enumP b2i1. +admit. +qed. + lemma HybridIROEager_next (i2 : int) : equiv [HybridIROEagerTrans.next_block ~ BlockSpongeTrans.next_block : @@ -1166,7 +1198,23 @@ seq 3 1 : eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). conseq (_ : true ==> cs{1} = ofblock w{2}). progress; [by rewrite size_block | by rewrite mkblockK]. -admit. +transitivity{2} + { w <@ BlockGen.loop(); } + (true ==> cs{1} = ofblock w{2}) + (true ==> ={w})=> //. +inline BlockGen.loop; sp; wp. +while (={j, cs} /\ 0 <= j{1} <= r /\ size cs{1} = j{1}). +wp; rnd; skip; progress; smt(size_ge0 size_rcons). +skip; progress. +smt(gt0_r). +have sz_cs_R_eq_r : size cs_R = r by smt(). +by rewrite ofblockK. +transitivity{2} + { w <@ BlockGen.direct(); } + (true ==> ={w}) + (true ==> ={w})=> //. +call BlockGen_loop_direct; auto. +inline BlockGen.direct; sim. wp; simplify; sp; elim*=> bs_l. exists* HybridIROEager.mp{1}; elim*=> mp1. exists* i{1}; elim*=> i1. From 5a6cfa0fac5d57568fd1865c93e7b57192a38873 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Sat, 6 Aug 2016 09:25:04 -0400 Subject: [PATCH 190/525] Application of DList.Program. --- proof/Sponge.ec | 73 ++++++++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 69 insertions(+), 4 deletions(-) diff --git a/proof/Sponge.ec b/proof/Sponge.ec index 036df39..c3abb12 100644 --- a/proof/Sponge.ec +++ b/proof/Sponge.ec @@ -2,8 +2,10 @@ (* checks with both Alt-Ergo and Z3 *) require import Fun Pair Int IntDiv Real List Option FSet NewFMap DBool. -import IntExtra. -require import Common StdOrder. import IntOrder. +import Pred IntExtra. +require import DList StdBigop. +require import StdOrder. import IntOrder. +require import Common. require (*--*) IRO BlockSponge RndO. (*------------------------- Indifferentiability ------------------------*) @@ -1056,6 +1058,42 @@ module BlockGen = { } }. +(* use Program abstract theory of DList *) + +clone Program as Prog with + type t = bool, + op d = {0,1} +proof *. +(* nothing to be proved *) + +lemma PrLoopSnoc_sample &m (bs : bool list) : + Pr[Prog.LoopSnoc.sample(r) @ &m : bs = res] = + mu (dlist {0,1} r) (pred1 bs). +proof. +have -> : + Pr[Prog.LoopSnoc.sample(r) @ &m: bs = res] = + Pr[Prog.Sample.sample(r) @ &m: bs = res]. + byequiv=> //. + symmetry. + conseq (_ : ={n} ==> ={res})=> //. + apply Prog.Sample_LoopSnoc_eq. +apply (Prog.pr_Sample r &m bs). +qed. + +lemma iter_mul_one_half_pos (n : int) : + 0 < n => iter n (( * ) (1%r / 2%r)) 1%r = inv(2 ^ n)%r. +proof. +move=> gt0_n. +have -> /# // : + forall (n : int), + 0 <= n => 0 < n => iter n (( * ) (1%r / 2%r)) 1%r = inv (2 ^ n)%r. +elim=> [// | i ge0_i IH _]. +case (i = 0)=> [-> /= | ne_i0]. +rewrite iter1 pow1 /#. +by rewrite iterS // IH 1:/# powS // RealExtra.fromintM + StdRing.RField.invfM. +qed. + lemma BlockGen_loop_direct : equiv[BlockGen.loop ~ BlockGen.direct : true ==> ={res}]. proof. @@ -1063,10 +1101,37 @@ bypr res{1} res{2}=> // &1 &2 w. have -> : Pr[BlockGen.direct() @ &2 : w = res] = 1%r / (2 ^ r)%r. byphoare=> //. proc; rnd; skip; progress; rewrite DWord.bdistrE. - have -> : (fun x => w = x) = (Pred.pred1 w) + have -> : (fun x => w = x) = (pred1 w) by apply ExtEq.fun_ext=> x; by rewrite (eq_sym w x). by rewrite count_uniq_mem 1:enum_uniq enumP b2i1. -admit. +have -> : + Pr[BlockGen.loop() @ &1 : w = res] = + Pr[Prog.LoopSnoc.sample(r) @ &1 : ofblock w = res]. + byequiv=> //. + proc. + seq 2 2 : + (r = n{2} /\ j{1} = i{2} /\ j{1} = 0 /\ + cs{1} = l{2} /\ cs{1} = []); + first auto. + while + (r = n{2} /\ j{1} = i{2} /\ cs{1} = l{2} /\ j{1} <= r /\ + size cs{1} = j{1}). + wp; rnd; skip. + progress; smt(cats1 gt0_r size_rcons). + skip=> &m1 &m2 [r_eq [j_eq [j_init [cs_eq cs_init]]]]. + split; first smt(gt0_r). + move=> j_L cs_L l_R i_r not_j_L_lt_r not_i_r_lt_n. + move=> [_ [j_L_eq [cs_L_eq [j_L_le_r sz_cs_L_eq_j_L]]]]. + have sz_cs_L_eq_r : size cs_L = r by smt(). + progress; [by rewrite ofblockK | by rewrite cs_L_eq mkblockK]. +rewrite (PrLoopSnoc_sample &1 (ofblock w)). +rewrite mux_dlist 1:ge0_r size_block /=. +have -> : + (fun (x : bool) => mu {0,1} (pred1 x)) = + (fun (x : bool) => 1%r / 2%r). + apply ExtEq.fun_ext=> x; by rewrite dboolb. +by rewrite Bigreal.BRM.big_const count_predT size_block + iter_mul_one_half_pos 1:gt0_r. qed. lemma HybridIROEager_next (i2 : int) : From 5c69a86ae658e777dde73695f5c0ea7ab293918b Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Sat, 6 Aug 2016 16:38:06 -0400 Subject: [PATCH 191/525] Fixed Common.ec to track PY's change in ordering of cloning renamings. --- proof/Common.ec | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/proof/Common.ec b/proof/Common.ec index 3d1cf7e..2580617 100644 --- a/proof/Common.ec +++ b/proof/Common.ec @@ -29,8 +29,8 @@ clone BitWord as Capacity with op n <- c proof gt0_n by apply/gt0_c - rename "word" as "cap" - "dword" as "cdistr" + rename "dword" as "cdistr" + "word" as "cap" "zerow" as "c0". clone export BitWord as Block with @@ -38,8 +38,8 @@ clone export BitWord as Block with op n <- r proof gt0_n by apply/gt0_r - rename "word" as "block" - "dword" as "bdistr" + rename "dword" as "bdistr" + "word" as "block" "zerow" as "b0". (* ------------------------- Auxiliary Lemmas ------------------------- *) From d007da7d9a1b0400acc2745a777dd7d2adea8c1a Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Sat, 6 Aug 2016 16:39:05 -0400 Subject: [PATCH 192/525] Isolation of last lemma of top-level proof. --- proof/Sponge.ec | 138 ++++++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 135 insertions(+), 3 deletions(-) diff --git a/proof/Sponge.ec b/proof/Sponge.ec index c3abb12..3439750 100644 --- a/proof/Sponge.ec +++ b/proof/Sponge.ec @@ -785,6 +785,16 @@ module HybridIROEagerTrans = { } return (bs, i); } + + proc loop(n : int, xs : block list) : int * bool list = { + var b : bool; var i <- 0; var bs <- []; + while (i < n * r) { + b <@ HybridIROEager.fill_in(xs, i); + bs <- rcons bs b; + i <- i + 1; + } + return (i, bs); + } }. pred eager_eq_except @@ -1037,6 +1047,16 @@ module BlockSpongeTrans = { i <- i + 1; return (bs, i); } + + proc loop(n : int, xs : block list) : int * block list = { + var b : block; var i <- 0; var bs <- []; + while (i < n) { + b <@ BlockSponge.BIRO.IRO.fill_in(xs, i); + bs <- rcons bs b; + i <- i + 1; + } + return (i, bs); + } }. module BlockGen = { @@ -1134,7 +1154,7 @@ by rewrite Bigreal.BRM.big_const count_predT size_block iter_mul_one_half_pos 1:gt0_r. qed. -lemma HybridIROEager_next (i2 : int) : +lemma HybridIROEagerTrans_BlockSpongeTrans_next_block (i2 : int) : equiv [HybridIROEagerTrans.next_block ~ BlockSpongeTrans.next_block : i2 = i{2} /\ 0 <= i{2} /\ xs{1} = x{2} /\ i{1} = i{2} * r /\ @@ -1350,6 +1370,19 @@ have -> : size(blocks2bits bs{2}) = i2 * r have -> // : j < i2 * r = false by smt(). qed. +lemma HybridIROEagerTrans_BlockSpongeTrans_loop (n' : int) : + equiv + [HybridIROEagerTrans.loop ~ BlockSpongeTrans.loop : + ={xs, n} /\ n' = n{1} /\ 0 <= n' /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + res{1}.`1 = n' * r /\ res{2}.`1 = n' /\ + size res{2}.`2 = n' /\ res{1}.`2 = blocks2bits res{2}.`2 /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}]. +proof. +proc=> /=. +admit. +qed. + lemma HybridIROEager_g_BlockIRO_f (n1 : int) (x2 : block list) : equiv[HybridIROEager.g ~ BlockSponge.BIRO.IRO.f : n1 = n{1} /\ x2 = x{2} /\ xs{1} = x{2} /\ @@ -1427,7 +1460,106 @@ seq 1 1 : n{2} * r = m{1} /\ n{1} <= m{1} /\ i{1} = n1 %/ r * r /\ i{2} = n1 %/ r /\ size bs{2} = i{2} /\ bs{1} = blocks2bits bs{2} /\ eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). -admit. +conseq + (_ : + xs{1} = x{2} /\ n1 = n{1} /\ 0 <= n1 /\ n{2} = (n1 + r - 1) %/ r /\ + i{1} = 0 /\ i{2} = 0 /\ bs{1} = [] /\ bs{2} = [] /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + i{1} = n1 %/ r * r /\ i{2} = n1 %/ r /\ + size bs{2} = i{2} /\ bs{1} = blocks2bits bs{2} /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1})=> //. +transitivity{1} + { while (i < n1 %/ r * r) { + b <@ HybridIROEager.fill_in(xs, i); + bs <- rcons bs b; + i <- i + 1; + } + } + (={i, bs, xs, HybridIROEager.mp} /\ n1 = n{1} /\ 0 <= n1 ==> + ={i, bs, xs, HybridIROEager.mp}) + (xs{1} = x{2} /\ n1 = n{1} /\ 0 <= n1 /\ n{2} = (n1 + r - 1) %/ r /\ + i{1} = 0 /\ i{2} = 0 /\ bs{1} = [] /\ bs{2} = [] /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + i{1} = n1 %/ r * r /\ i{2} = n1 %/ r /\ + size bs{2} = i{2} /\ bs{1} = blocks2bits bs{2} /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1})=> //. +progress; exists HybridIROEager.mp{1}, [], n{1}, 0, x{2}; smt(). +while (={i, bs, xs, HybridIROEager.mp} /\ n1 = n{1} /\ 0 <= n1). +wp. call (_ : ={HybridIROEager.mp}). if=> //; auto. +auto; progress; smt(leq_trunc_div ge0_r). +auto; progress; smt(leq_trunc_div ge0_r). +transitivity{2} + { while (i < n1 %/ r) { + b <@ BlockSponge.BIRO.IRO.fill_in(x, i); + bs <- rcons bs b; + i <- i + 1; + } + } + (xs{1} = x{2} /\ n1 = n{1} /\ 0 <= n1 /\ n{2} = (n1 + r - 1) %/ r /\ + i{1} = 0 /\ i{2} = 0 /\ bs{1} = [] /\ bs{2} = [] /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + i{1} = n1 %/ r * r /\ i{2} = n1 %/ r /\ size bs{2} = i{2} /\ + bs{1} = blocks2bits bs{2} /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}) + (={i, x, bs, BlockSponge.BIRO.IRO.mp} /\ n{2} = (n1 + r - 1) %/ r ==> + ={i, x, bs, BlockSponge.BIRO.IRO.mp})=> //. +progress; + exists BlockSponge.BIRO.IRO.mp{2}, [], 0, x{2}, ((n{1} + r - 1) %/ r); + smt(). +conseq + (_ : + xs{1} = x{2} /\ 0 <= n1 /\ + i{1} = 0 /\ i{2} = 0 /\ bs{1} = [] /\ bs{2} = [] /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + i{1} = n1 %/ r * r /\ i{2} = n1 %/ r /\ + size bs{2} = n1 %/ r /\ bs{1} = blocks2bits bs{2} /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1})=> //. +transitivity{1} + { (i, bs) = HybridIROEagerTrans.loop(n1 %/ r, xs); } + (={xs, HybridIROEager.mp} /\ n{2} = n1 %/ r /\ i{1} = 0 /\ bs{1} = [] ==> + ={i, xs, bs, HybridIROEager.mp}) + (xs{1} = x{2} /\ 0 <= n1 /\ i{2} = 0 /\ bs{2} = [] /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + i{1} = n1 %/ r * r /\ i{2} = n1 %/ r /\ + size bs{2} = n1 %/ r /\ bs{1} = blocks2bits bs{2} /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). +progress; exists HybridIROEager.mp{1}, (n1 %/ r), x{2}; smt(). +smt(). +inline HybridIROEagerTrans.loop; sp; wp. +while + (={HybridIROEager.mp} /\ i{1} = i0{2} /\ bs{1} = bs0{2} /\ + xs{1} = xs0{2} /\ n0{2} = n1 %/ r). +wp. call (_ : ={HybridIROEager.mp}). if=> //; rnd; auto. +auto. auto. +transitivity{2} + { (i, bs) = BlockSpongeTrans.loop(n1 %/ r, x); } + (xs{1} = x{2} /\ 0 <= n1 /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + i{1} = n1 %/ r * r /\ i{2} = n1 %/ r /\ + size bs{2} = n1 %/ r /\ bs{1} = blocks2bits bs{2} /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}) + (={x, BlockSponge.BIRO.IRO.mp} /\ i{2} = 0 /\ bs{2} = [] ==> + ={i, x, bs, BlockSponge.BIRO.IRO.mp}). +progress; exists BlockSponge.BIRO.IRO.mp{2}, x{2}; smt(). +smt(). +call (HybridIROEagerTrans_BlockSpongeTrans_loop (n1 %/ r)). +skip; progress; smt(divz_ge0 gt0_r). +inline BlockSpongeTrans.loop; sp; wp. +while + (={BlockSponge.BIRO.IRO.mp} /\ i0{1} = i{2} /\ n0{1} = n1 %/ r /\ + xs{1} = x{2} /\ bs0{1} = bs{2}). +wp. call (_ : ={BlockSponge.BIRO.IRO.mp}). if=> //; rnd; auto. +auto. auto. +while + (={i, x, bs, BlockSponge.BIRO.IRO.mp} /\ n{2} = (n1 + r - 1) %/ r). +wp. call (_ : ={BlockSponge.BIRO.IRO.mp}). if=> //. +auto. +auto; progress; + have /# : n1 %/ r <= (n1 + r - 1) %/ r + by rewrite leq_div2r; smt(gt0_r). +auto; progress; + have /# : n1 %/ r <= (n1 + r - 1) %/ r + by rewrite leq_div2r; smt(gt0_r). conseq (_ : n1 = n{1} /\ 0 <= n1 /\ xs{1} = x{2} /\ n{2} = (n1 + r - 1) %/ r /\ @@ -1538,7 +1670,7 @@ progress [-delta]; exists BlockSponge.BIRO.IRO.mp{2}, bs{2}, (size bs{2}), x{2}=> //. trivial. exists* i{2}; elim*=> i2. -call (HybridIROEager_next i2). +call (HybridIROEagerTrans_BlockSpongeTrans_next_block i2). auto. inline BlockSpongeTrans.next_block; sim. qed. From 2a04b31526a856e3f500c32ff2b6a6cdb3e7e01f Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Sun, 7 Aug 2016 09:49:59 -0400 Subject: [PATCH 193/525] Finished top-level proof. :-) Updated comments to make clear that Common.ec and Sponge.ec check with both Alt-Ergo and Z3 and only make use of restricted smt calls (restricted to specified lemmas). --- proof/Common.ec | 9 ++- proof/Sponge.ec | 150 +++++++++++++++++++++++++++++++++++++++++------- 2 files changed, 136 insertions(+), 23 deletions(-) diff --git a/proof/Common.ec b/proof/Common.ec index 2580617..9425328 100644 --- a/proof/Common.ec +++ b/proof/Common.ec @@ -1,5 +1,12 @@ (*------------------- Common Definitions and Lemmas --------------------*) -(* checks with both Alt-Ergo and Z3 *) + +(* checks with both Alt-Ergo and Z3; all smt applications are + restricted to specific lemmas *) + +(* +prover ["Z3"]. +prover ["Alt-Ergo"]. +*) require import Option Fun Pair Int IntExtra IntDiv Real List NewDistr. require import Ring StdRing StdOrder StdBigop BitEncoding DProd. diff --git a/proof/Sponge.ec b/proof/Sponge.ec index 3439750..eb3106a 100644 --- a/proof/Sponge.ec +++ b/proof/Sponge.ec @@ -1,8 +1,15 @@ (*------------------------- Sponge Construction ------------------------*) -(* checks with both Alt-Ergo and Z3 *) + +(* checks with both Alt-Ergo and Z3; all smt applications are + restricted to specific lemmas *) + +(* +prover ["Z3"]. +prover ["Alt-Ergo"]. +*) require import Fun Pair Int IntDiv Real List Option FSet NewFMap DBool. -import Pred IntExtra. +(*---*) import Pred IntExtra. require import DList StdBigop. require import StdOrder. import IntOrder. require import Common. @@ -747,7 +754,7 @@ module HybridIROEagerTrans = { return bs; } - proc next_block(i, m : int, xs, bs) = { + proc next_block(xs, i, m : int, bs) = { var b; while (i < m) { @@ -758,7 +765,7 @@ module HybridIROEagerTrans = { return (bs, i); } - proc next_block_split(i, m : int, xs, bs) = { + proc next_block_split(xs, i, m : int, bs) = { var b, j, cs; (* assuming block_bits_dom_all_in_or_out xs i HybridIROEager.mp @@ -1179,7 +1186,7 @@ transitivity size res{2}.`1 = i2 + 1 /\ eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1})=> //. move=> |> &1 &2 ge0_i2 -> i1_eq_i2_tim_r m_min_i1_eq_r -> sz_bs_eq_i2 ei. -exists HybridIROEager.mp{1}, (i{1}, m{1}, x{2}, blocks2bits bs{2})=> |>. +exists HybridIROEager.mp{1}, (x{2}, i{1}, m{1}, blocks2bits bs{2})=> |>. split; first smt(). split; first smt(size_blocks2bits). apply @@ -1379,8 +1386,108 @@ lemma HybridIROEagerTrans_BlockSpongeTrans_loop (n' : int) : size res{2}.`2 = n' /\ res{1}.`2 = blocks2bits res{2}.`2 /\ eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}]. proof. +case (0 <= n'); last first=> [not_ge0_n' | ge0_n']. +proc=> /=; exfalso. proc=> /=. -admit. +move: ge0_n'; elim n'=> [| n' ge0_n' IH]. +sp. rcondf{1} 1; auto. rcondf{2} 1; auto. +splitwhile{1} 3 : (i < (n - 1) * r). +splitwhile{2} 3 : (i < n - 1). +seq 3 3 : + (={xs, n} /\ n{1} = n' + 1 /\ i{1} = n' * r /\ i{2} = n' /\ + size bs{2} = n' /\ bs{1} = blocks2bits bs{2} /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). +conseq + (_ : + ={xs, n} /\ n' + 1 = n{1} /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + i{1} = n' * r /\ i{2} = n' /\ size bs{2} = n' /\ + bs{1} = blocks2bits bs{2} /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1})=> //. +transitivity{1} + { i <- 0; bs <- []; + while (i < n * r) { + b <@ HybridIROEager.fill_in(xs, i); + bs <- rcons bs b; + i <- i + 1; + } + } + (={xs, HybridIROEager.mp} /\ n{1} = n' + 1 /\ n{2} = n' ==> + ={bs, i, HybridIROEager.mp}) + (={xs} /\ n{1} = n' /\ n{2} = n' + 1 /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + i{1} = n' * r /\ i{2} = n' /\ size bs{2} = n' /\ + bs{1} = blocks2bits bs{2} /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1})=> //. +progress; exists HybridIROEager.mp{1}, n', xs{2}=> //. +while (={xs, i, bs, HybridIROEager.mp} /\ n{1} = n' + 1 /\ n{2} = n'). +wp. call (_ : ={HybridIROEager.mp}). if=> //; rnd; auto. +skip; progress; smt(ge0_r). +auto; smt(). +transitivity{2} + { i <- 0; bs <- []; + while (i < n) { + b <@ BlockSponge.BIRO.IRO.fill_in(xs, i); + bs <- rcons bs b; + i <- i + 1; + } + } + (={xs, n} /\ n{1} = n' /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + i{1} = n' * r /\ i{2} = n' /\ size bs{2} = n' /\ + bs{1} = blocks2bits bs{2} /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}) + (={xs,BlockSponge.BIRO.IRO.mp} /\ n{1} = n' /\ n{2} = n' + 1 ==> + ={i, bs, BlockSponge.BIRO.IRO.mp})=> //. +progress; exists BlockSponge.BIRO.IRO.mp{2}, n{1}, xs{2}=> //. +conseq IH=> //. +while + (={xs, bs, i, BlockSponge.BIRO.IRO.mp} /\ n{1} = n' /\ n{2} = n' + 1). +wp. call (_ : ={BlockSponge.BIRO.IRO.mp}). if=> //; rnd; auto. +auto; smt(). +auto; smt(). +unroll{2} 1. +rcondt{2} 1; first auto; progress; smt(). +rcondf{2} 4. auto. +call (_ : true). if=> //. +skip; smt(). +transitivity{1} + { (bs, i) <@ HybridIROEagerTrans.next_block(xs, i, (n' + 1) * r, bs); } + (={xs, i, bs, HybridIROEager.mp} /\ n{1} = n' + 1 ==> + ={i, bs, HybridIROEager.mp}) + (={xs} /\ i{1} = n' * r /\ i{2} = n' /\ + size bs{2} = n' /\ bs{1} = blocks2bits bs{2} /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + i{1} = (n' + 1) * r /\ i{2} = n' + 1 /\ size bs{2} = n' + 1 /\ + bs{1} = blocks2bits bs{2} /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1})=> //. +progress; + exists HybridIROEager.mp{1}, (size bs{2} * r), (blocks2bits bs{2}), xs{2}=> //. +inline HybridIROEagerTrans.next_block; sp; wp. +while + (xs{1} = xs0{2} /\ i{1} = i0{2} /\ n{1} = n' + 1 /\ + m{2} = (n' + 1) * r /\ bs{1} = bs0{2} /\ + ={HybridIROEager.mp}). +wp. call (_ : ={HybridIROEager.mp}). +if=> //; rnd; auto. +auto. auto. +transitivity{2} + { (bs, i) <@ BlockSpongeTrans.next_block(xs, i, bs); } + (={xs} /\ i{1} = n' * r /\ i{2} = n' /\ + size bs{2} = n' /\ bs{1} = blocks2bits bs{2} /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + i{1} = (n' + 1) * r /\ i{2} = n' + 1 /\ size bs{2} = n' + 1 /\ + bs{1} = blocks2bits bs{2} /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}) + (={xs, bs, i, BlockSponge.BIRO.IRO.mp} ==> + ={xs, bs, i, BlockSponge.BIRO.IRO.mp})=> //. +progress; exists BlockSponge.BIRO.IRO.mp{2}, (size bs{2}), bs{2}, xs{2}=> //. +call (HybridIROEagerTrans_BlockSpongeTrans_next_block n'). +skip; progress; smt(). +inline BlockSpongeTrans.next_block. +wp; sp. +call (_ : ={BlockSponge.BIRO.IRO.mp}). if=> //; rnd; skip; smt(). +auto. qed. lemma HybridIROEager_g_BlockIRO_f (n1 : int) (x2 : block list) : @@ -1483,7 +1590,7 @@ transitivity{1} i{1} = n1 %/ r * r /\ i{2} = n1 %/ r /\ size bs{2} = i{2} /\ bs{1} = blocks2bits bs{2} /\ eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1})=> //. -progress; exists HybridIROEager.mp{1}, [], n{1}, 0, x{2}; smt(). +progress; exists HybridIROEager.mp{1}, [], n{1}, 0, x{2}=> //. while (={i, bs, xs, HybridIROEager.mp} /\ n1 = n{1} /\ 0 <= n1). wp. call (_ : ={HybridIROEager.mp}). if=> //; auto. auto; progress; smt(leq_trunc_div ge0_r). @@ -1504,8 +1611,7 @@ transitivity{2} (={i, x, bs, BlockSponge.BIRO.IRO.mp} /\ n{2} = (n1 + r - 1) %/ r ==> ={i, x, bs, BlockSponge.BIRO.IRO.mp})=> //. progress; - exists BlockSponge.BIRO.IRO.mp{2}, [], 0, x{2}, ((n{1} + r - 1) %/ r); - smt(). + exists BlockSponge.BIRO.IRO.mp{2}, [], 0, x{2}, ((n{1} + r - 1) %/ r)=> //. conseq (_ : xs{1} = x{2} /\ 0 <= n1 /\ @@ -1515,7 +1621,7 @@ conseq size bs{2} = n1 %/ r /\ bs{1} = blocks2bits bs{2} /\ eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1})=> //. transitivity{1} - { (i, bs) = HybridIROEagerTrans.loop(n1 %/ r, xs); } + { (i, bs) <@ HybridIROEagerTrans.loop(n1 %/ r, xs); } (={xs, HybridIROEager.mp} /\ n{2} = n1 %/ r /\ i{1} = 0 /\ bs{1} = [] ==> ={i, xs, bs, HybridIROEager.mp}) (xs{1} = x{2} /\ 0 <= n1 /\ i{2} = 0 /\ bs{2} = [] /\ @@ -1523,8 +1629,8 @@ transitivity{1} i{1} = n1 %/ r * r /\ i{2} = n1 %/ r /\ size bs{2} = n1 %/ r /\ bs{1} = blocks2bits bs{2} /\ eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). -progress; exists HybridIROEager.mp{1}, (n1 %/ r), x{2}; smt(). -smt(). +progress; exists HybridIROEager.mp{1}, (n1 %/ r), x{2}=> //. +trivial. inline HybridIROEagerTrans.loop; sp; wp. while (={HybridIROEager.mp} /\ i{1} = i0{2} /\ bs{1} = bs0{2} /\ @@ -1532,16 +1638,15 @@ while wp. call (_ : ={HybridIROEager.mp}). if=> //; rnd; auto. auto. auto. transitivity{2} - { (i, bs) = BlockSpongeTrans.loop(n1 %/ r, x); } + { (i, bs) <@ BlockSpongeTrans.loop(n1 %/ r, x); } (xs{1} = x{2} /\ 0 <= n1 /\ eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> i{1} = n1 %/ r * r /\ i{2} = n1 %/ r /\ size bs{2} = n1 %/ r /\ bs{1} = blocks2bits bs{2} /\ eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}) (={x, BlockSponge.BIRO.IRO.mp} /\ i{2} = 0 /\ bs{2} = [] ==> - ={i, x, bs, BlockSponge.BIRO.IRO.mp}). -progress; exists BlockSponge.BIRO.IRO.mp{2}, x{2}; smt(). -smt(). + ={i, x, bs, BlockSponge.BIRO.IRO.mp})=> //. +progress; exists BlockSponge.BIRO.IRO.mp{2}, x{2}=> //. call (HybridIROEagerTrans_BlockSpongeTrans_loop (n1 %/ r)). skip; progress; smt(divz_ge0 gt0_r). inline BlockSpongeTrans.loop; sp; wp. @@ -1642,7 +1747,7 @@ skip; progress; smt(size_rcons take_oversize cats1 cats0)]. skip; smt(take_size). transitivity{1} - { (bs, i) <@ HybridIROEagerTrans.next_block(i, m, xs, bs); + { (bs, i) <@ HybridIROEagerTrans.next_block(xs, i, m, bs); } (={i, m, xs, bs, HybridIROEager.mp} ==> ={i, m, xs, bs, HybridIROEager.mp}) @@ -1896,7 +2001,7 @@ by rewrite (Ideal_IRO_Experiment_HybridLazy &m) (Experiment_HybridEager_Ideal_BlockIRO &m). qed. -lemma Conclusion' &m : +lemma conclu &m : `|Pr[RealIndif(Sponge, Perm, Dist).main() @ &m: res] - Pr[IdealIndif(IRO, RaiseSim(BlockSim), Dist).main() @ &m : res]| = `|Pr[BlockSponge.RealIndif @@ -1911,13 +2016,14 @@ end section. (*----------------------------- Conclusion -----------------------------*) -lemma Conclusion (BlockSim <: BlockSponge.SIMULATOR{IRO, BlockSponge.BIRO.IRO}) - (Dist <: DISTINGUISHER{Perm, BlockSim, IRO, BlockSponge.BIRO.IRO}) - &m : +lemma conclusion + (BlockSim <: BlockSponge.SIMULATOR{IRO, BlockSponge.BIRO.IRO}) + (Dist <: DISTINGUISHER{Perm, BlockSim, IRO, BlockSponge.BIRO.IRO}) + &m : `|Pr[RealIndif(Sponge, Perm, Dist).main() @ &m: res] - Pr[IdealIndif(IRO, RaiseSim(BlockSim), Dist).main() @ &m : res]| = `|Pr[BlockSponge.RealIndif (BlockSponge.Sponge, Perm, LowerDist(Dist)).main() @ &m : res] - Pr[BlockSponge.IdealIndif (BlockSponge.BIRO.IRO, BlockSim, LowerDist(Dist)).main() @ &m : res]|. -proof. by apply/(Conclusion' BlockSim Dist &m). qed. +proof. by apply/(conclu BlockSim Dist &m). qed. From 7044468b490504752fcd8b3b0982868b57269191 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Mon, 8 Aug 2016 13:12:46 +0100 Subject: [PATCH 194/525] Use inductives for path specifications --- proof/core/SLCommon.ec | 20 -------------------- 1 file changed, 20 deletions(-) diff --git a/proof/core/SLCommon.ec b/proof/core/SLCommon.ec index f325091..fbb4548 100644 --- a/proof/core/SLCommon.ec +++ b/proof/core/SLCommon.ec @@ -1,4 +1,3 @@ - (** This is a theory for the Squeezeless sponge: where the ideal functionality is a fixed-output-length random oracle whose output length is the input block size. We prove its security even when @@ -114,7 +113,6 @@ op step_hpath (mh:hsmap) (sah:hstate option) (b:block) = op build_hpath (mh:hsmap) (bs:block list) = foldl (step_hpath mh) (Some (b0,0)) bs. -(* inductive build_hpath_spec mh p v h = | Empty of (p = []) & (v = b0) @@ -139,24 +137,6 @@ split. case=> [/#|] p' b' v'' h'' ^/rconssI <<- {p'} /rconsIs <<- {b'}. by rewrite build /= => [#] <*>. qed. -*) - -lemma build_hpathP mh p v h: - build_hpath mh p = Some (v, h) <=> - (p = [] /\ v=b0 /\ h=0) \/ - exists p' b v' h', - p = rcons p' b /\ build_hpath mh p' = Some(v',h') /\ mh.[(v'+^b, h')] = Some(v,h). -proof. (* this is not an induction, but only a case analysis *) -elim/last_ind: p v h => //= [v h|p b _ v h]. -+ by rewrite /build_hpath /= anda_and; split=> [!~#] <*>; [left|move=> [] /#]. -rewrite -{1}cats1 foldl_cat /= -/(build_hpath _ _) /=. -have -> /=: rcons p b <> [] by smt (). (* inelegant -- need lemma in List.ec *) -case: {-1}(build_hpath _ _) (eq_refl (build_hpath mh p))=> //=. -+ by rewrite /step_hpath //= NewLogic.implybN=> -[] p' b0 b' h' [#] /rconssI <*> ->. -move=> [v' h'] build_path; split=> [step_path|[] p' b' v'' h'']. -+ by exists p, b, v', h'. -by move=> [#] ^/rconssI <<- /rconsIs <<-; rewrite build_path=> ->. -qed. (* -------------------------------------------------------------------------- *) From 44c8184386bc9d7de29faa75e2a1f02d6f49f851 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Mon, 8 Aug 2016 13:18:13 +0100 Subject: [PATCH 195/525] Goals got reordered. This may need reverted (again). --- proof/core/Gext.eca | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/proof/core/Gext.eca b/proof/core/Gext.eca index 0fe42ad..1605283 100644 --- a/proof/core/Gext.eca +++ b/proof/core/Gext.eca @@ -619,23 +619,23 @@ section EXT. apply ler_wpmul2r;1:by apply eps_ge0. by rewrite le_fromint;smt ml=0 w=max_ge0. + proc;rcondt 2;1:by auto. - wp; rnd (mem (image snd (dom G1.m `|` dom G1.mi ))); skip=> /> &hr ? ? -> /= ? ?. - rewrite (Mu_mem.mu_mem - (image snd (dom G1.m{hr} `|` dom G1.mi{hr})) - cdistr (1%r/(2^c)%r))//. + wp;rnd (mem (image snd (dom G1.m `|` dom G1.mi) `|` fset1 x));skip=> /> &hr ??-> /= ??. + rewrite (Mu_mem.mu_mem (image snd (dom G1.m{hr}`|`dom G1.mi{hr}) `|` fset1 x{hr}) cdistr (1%r/(2^c)%r))//. + by move=>x _;apply DWord.cdistr1E. apply ler_wpmul2r;1:by apply divr_ge0=>//;apply /c_ge0r. - rewrite imageU fcardU le_fromint. + rewrite imageU !fcardU le_fromint fcard1. move:(fcard_image_leq snd (dom G1.m{hr}))(fcard_image_leq snd (dom G1.mi{hr})). by rewrite -!sizeE;smt w=fcard_ge0. + by move=>c1;proc;auto=> &hr [^H 2->]/#. + by move=> b1 c1;proc;auto=> /#. + proc;rcondt 2;1:by auto. - wp;rnd (mem (image snd (dom G1.m `|` dom G1.mi) `|` fset1 x));skip=> /> &hr ??-> /= ??. - rewrite (Mu_mem.mu_mem (image snd (dom G1.m{hr}`|`dom G1.mi{hr}) `|` fset1 x{hr}) cdistr (1%r/(2^c)%r))//. - + by move=>x _;apply DWord.cdistr1E. + wp; rnd (mem (image snd (dom G1.m `|` dom G1.mi ))); skip=> /> &hr ? ? -> /= ? ?. + rewrite (Mu_mem.mu_mem + (image snd (dom G1.m{hr} `|` dom G1.mi{hr})) + cdistr (1%r/(2^c)%r))//. + + by move=>x _;apply DWord.cdistr1E. apply ler_wpmul2r;1:by apply divr_ge0=>//;apply /c_ge0r. - rewrite imageU !fcardU le_fromint fcard1. + rewrite imageU fcardU le_fromint. move:(fcard_image_leq snd (dom G1.m{hr}))(fcard_image_leq snd (dom G1.mi{hr})). by rewrite -!sizeE;smt w=fcard_ge0. + by move=>c1;proc;auto=> &hr [^H 2->]/#. From c3be71eb926e59c36407cac8b67b84a0b3faa771 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Mon, 8 Aug 2016 10:10:52 -0400 Subject: [PATCH 196/525] Nits. --- proof/Sponge.ec | 33 ++++++++++++++++++--------------- 1 file changed, 18 insertions(+), 15 deletions(-) diff --git a/proof/Sponge.ec b/proof/Sponge.ec index eb3106a..a7a2c08 100644 --- a/proof/Sponge.ec +++ b/proof/Sponge.ec @@ -1145,10 +1145,11 @@ have -> : size cs{1} = j{1}). wp; rnd; skip. progress; smt(cats1 gt0_r size_rcons). - skip=> &m1 &m2 [r_eq [j_eq [j_init [cs_eq cs_init]]]]. + skip=> &m1 &m2 [# r_eq j_eq j_init cs_eq cs_init]. split; first smt(gt0_r). - move=> j_L cs_L l_R i_r not_j_L_lt_r not_i_r_lt_n. - move=> [_ [j_L_eq [cs_L_eq [j_L_le_r sz_cs_L_eq_j_L]]]]. + move=> + j_L cs_L l_R i_r not_j_L_lt_r not_i_r_lt_n + [# _ j_L_eq cs_L_eq j_L_le_r sz_cs_L_eq_j_L]. have sz_cs_L_eq_r : size cs_L = r by smt(). progress; [by rewrite ofblockK | by rewrite cs_L_eq mkblockK]. rewrite (PrLoopSnoc_sample &1 (ofblock w)). @@ -1246,18 +1247,20 @@ have some_form_mp_hr_lookup_eq : by rewrite ei1_xs_i2 1:/#. by rewrite some_form_mp_hr_lookup_eq oget_some. smt(). -skip. (* getting anomaly from => |> *) -move=> &1 &2 [-> [ge0_i2 [i1_eq_i2_tim_r H]]]. -elim H=> [m_min_i1_eq_r [->> [sz_bs2_eq_i2 H]]]. -elim H=> [sz_b2b_bs2_eq_i1 [->> [mem_dom_mp2_xs_i2 ei]]]. +skip. +move=> + &1 &2 + [# -> ge0_i2 i1_eq_i2_tim_r m_min_i1_eq_r ->> sz_bs2_eq_i2 + sz_b2b_bs2_eq_i1 ->> mem_dom_mp2_xs_i2 ei]. split. split. split=> [// | _]; rewrite i1_eq_i2_tim_r; smt(ge0_r). split=> //. split; first smt(). split=> //. split; first by rewrite /= take0 cats0. split=> //. move=> bs_L i_L. split=> [| not_lt_i_L_m]; first smt(). -move=> [i1_le_i_L_le_m [_ [sz_bs_L_eq_i_L [m1_min_i1_eq_r H]]]]. -elim H=> [bs_L_eq [_ [_ mem_mp2_xs_i2]]]. +move=> + [# i1_le_i_L_le_m _ _ sz_bs_L_eq_i_L m1_min_i1_eq_r + bs_L_eq mem_mp2_xs_i2 _]. split. have i_L_eq_m : i_L = m{1} by smt(). rewrite bs_L_eq -cats1 blocks2bits_cat; congr. @@ -1348,8 +1351,10 @@ rewrite getP. have -> /= : (xs{hr}, j) <> (xs{hr}, i{hr}) by smt(). rewrite mp_ran_eq /#. smt(). -skip=> &1 &2 [-> [ge0_i2 [eq_i_i1 [i1_eq_i2_tim_r [m_min_i1_eq_r H]]]]]. -elim H=> [bs1_eq [sz_bs2_eq_i2 [sz_bs1_eq_i1_add_r [-> ei]]]]. +skip=> + &1 &2 + [# -> ge0_i2 eq_i_i1 i1_eq_i2_tim_r m_min_i1_eq_r + bs1_eq sz_bs2_eq_i2 sz_bs1_eq_i1_add_r -> ei]. have ge0_i1 : 0 <= i1 by rewrite i1_eq_i2_tim_r divr_ge0 // ge0_r. split. @@ -1358,12 +1363,10 @@ split; first smt(ge0_r). split; first smt(). split. split; smt(ge0_r). -split; first smt(). -smt(). +split; smt(). move=> mp_L i_L. split; first smt(). -move=> not_i_L_lt_m H. -elim H=> [_ [_ [_ [[i1_le_i_L i_L_le_m] [ee mp_L_ran_eq]]]]]. +move=> not_i_L_lt_m [# _ _ _ i1_le_i_L i_L_le_m ee mp_L_ran_eq]. split; first smt(). split; first smt(). apply (eager_invar_eq_except_upd1 BlockSponge.BIRO.IRO.mp{2} From 783c6d1770229d40e2cbb49eba928c36aa715726 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Tue, 9 Aug 2016 21:14:50 +0100 Subject: [PATCH 197/525] Almost back to before code change. But much more disgusting. The invariant seems to be the right one, but is not expressed in the right way for the new code, which can't be split horizontally as well anymore because the invariant is only true at function boundaries. --- proof/core/Handle.eca | 610 ++++++++++++++++++++++++++++++------------ 1 file changed, 440 insertions(+), 170 deletions(-) diff --git a/proof/core/Handle.eca b/proof/core/Handle.eca index 755444b..7f3e0e1 100644 --- a/proof/core/Handle.eca +++ b/proof/core/Handle.eca @@ -7,10 +7,10 @@ require import DProd Dexcepted. require ConcreteF. clone import GenEager as ROhandle with - type from <- handle, - type to <- capacity, - op sampleto <- fun (_:int) => cdistr - proof sampleto_ll by apply DWord.cdistr_ll. + type from <- handle, + type to <- capacity, + op sampleto <- fun (_:int) => cdistr + proof sampleto_ll by apply DWord.cdistr_ll. module G1(D:DISTINGUISHER) = { var m, mi : smap @@ -156,13 +156,13 @@ module G1(D:DISTINGUISHER) = { inductive eqm_handles (hs : handles) (m : smap) (mh : hsmap) = | MH of (forall xa xc ya yc, m.[(xa,xc)] = Some (ya,yc) => - exists xh yh xf yf, + exists xh xf yh yf, hs.[xh] = Some (xc,xf) /\ hs.[yh] = Some (yc,yf) /\ mh.[(xa,xh)] = Some (ya,yh)) & (forall xa xh ya yh, mh.[(xa,xh)] = Some (ya,yh) => - exists xc yc xf yf, + exists xc xf yc yf, hs.[xh] = Some (xc,xf) /\ hs.[yh] = Some (yc,yf) /\ m.[(xa,xc)] = Some (ya,yc)). @@ -170,16 +170,15 @@ inductive eqm_handles (hs : handles) (m : smap) (mh : hsmap) = inductive mh_spec (hs : handles) (m2 : smap) (mh : hsmap) (ro : (block list,block) fmap) = | H of (forall xa xh ya yh, mh.[(xa,xh)] = Some (ya,yh) => - exists xc yc xf yf, + exists xc xf yc yf, hs.[xh] = Some (xc,xf) /\ hs.[yh] = Some (yc,yf) /\ if yf = Known then m2.[(xa,xc)] = Some (ya,yc) /\ xf = Known - else exists p v b, - ro.[rcons p b] = Some ya - /\ build_hpath mh p = Some (v,xh) - /\ xa = v +^ b) + else exists p v, + ro.[rcons p (v +^ xa)] = Some ya + /\ build_hpath mh p = Some (v,xh)) & (forall p xa b, ro.[rcons p xa] = Some b <=> exists v xh yh, @@ -268,6 +267,7 @@ lemma handles_of_INV (m1 m2 mi1 mi2 : smap) (mh2 mhi2 : hsmap) handles_spec hs ch. proof. by case. qed. +(** ?? **) lemma eqm_dom_mh_m hs m mh hx2 f (x:state): eqm_handles hs m mh => hs.[hx2] = Some (x.`2, f) => @@ -284,6 +284,7 @@ proof. by case=> _ Heq Hlt; apply Hlt; rewrite in_dom Heq. qed. lemma chandle_0 hs ch : handles_spec hs ch => 0 <> ch. proof. by move=> Hh;apply/ltr_eqF/(@chandle_ge0 _ _ Hh). qed. +(** Adding handles **) lemma eqm_up_handles hs ch m mh x2 : handles_spec hs ch => eqm_handles hs m mh => @@ -322,7 +323,7 @@ split=>- [] ^Hbu -> /=; rewrite getP. + case: Hh=> _ _ Hlt x_in_handles. by rewrite ltr_eqF; 1:by apply/Hlt; rewrite in_dom x_in_handles. case: (x = ch)=> //=. -move: Hbu=> /build_hpathP [[#] _ _ ->|[p' b v' h' [#] _ _ Hh']]. +move: Hbu=> /build_hpathP [[#] _ _ ->|p' b v' h' [#] _ _ Hh']. + by rewrite (@chandle_0 _ _ Hh). case: Hh=> _ _ /(_ x) Hlt; rewrite ltr_eqF //. by apply/Hlt; rewrite in_dom; case: Hmh=> /(_ _ _ _ _ Hh') [????] [#] _ ->. @@ -337,10 +338,10 @@ move=> Hx2 ^Hh [] Hu Hh0 Hlt; split. + move=> h1 h2 [c1 f1] [c2 f2]; rewrite !getP /=. case: (h1 = ch)=> /= [-> [] ->> ->|_]; (case: (h2 = ch)=> [-> //= |_]). + by move=> Heq ->>; move: (Hx2 f2); rewrite in_rng negb_exists=> /= /(_ h2). - + by move=> Heq [] ->> <<- ->>; move: (Hx2 f1); rewrite in_rng negb_exists=> /= /(_ h1). + + by move=> Heq [] ->> <<- ->>; move: (Hx2 f1); rewrite in_rng negb_exists=> /= /(_ h1). by apply Hu. + by rewrite getP (@chandle_0 _ _ Hh). -+ by move=> h; rewrite dom_set !inE /#. +by move=> h; rewrite dom_set !inE /#. qed. lemma INV_CF_G1_up_handles hs ch m1 mi1 m2 mi2 mh mhi ro pi x2: @@ -356,6 +357,7 @@ exact/(HCF_G1 (eqm_up_handles Hh Heqm) (eqm_up_handles Hh Heqmi) (:@handles_up_handles _ _ x2 Known _ Hh)). qed. +(** Updating forward map **) lemma eqm_handles_up (hs : handles) m mh (h hx:handle) (x y : state) f: huniq hs => hs.[h] = None => @@ -365,13 +367,13 @@ lemma eqm_handles_up (hs : handles) m mh (h hx:handle) (x y : state) f: proof. move=> uniq_h h_h h_hx @/eqm_handles [] hmmh hmhm; split. + move=> b c b' c'; rewrite getP; case ((b,c) = x)=> /= [<<- ->> {x y} /=|]. - * by exists hx, h, f, Known; rewrite !getP /= [smt (in_dom)]. - move=> bc_neq_x /hmmh [] h0 h0' f0 f0' [#] h_h0 h_h0' mhi_bc. - by exists h0, h0', f0, f0'; rewrite !getP [smt (in_dom)]. + * by exists hx, f, h, Known; rewrite !getP /= [smt (in_dom)]. + move=> bc_neq_x /hmmh [] h0 f0 h0' f0' [#] h_h0 h_h0' mhi_bc. + by exists h0, f0, h0', f0'; rewrite !getP [smt (in_dom)]. move=> xb xh b' h'; rewrite getP; case ((xb,xh) = (x.`1,hx))=> /= [[#] <*> [#] <*>|]. - * by exists x.`2, y.`2, f, Known; rewrite !getP [smt (in_dom)]. -rewrite anda_and negb_and=> bh_neq_x1hx /hmhm /= [] c0 c0' f0 f0' [#] h_h0 h_bh' m_bc. -exists c0, c0', f0, f0'; rewrite !getP. + * by exists x.`2, f, y.`2, Known; rewrite !getP [smt (in_dom)]. +rewrite anda_and negb_and=> bh_neq_x1hx /hmhm /= [] c0 f0 c0' f0' [#] h_h0 h_bh' m_bc. +exists c0, f0, c0', f0'; rewrite !getP. split; 1:smt (in_dom). split; 1:smt (in_dom). case x bh_neq_x1hx h_hx=> x1 x2 /= => - [/#|h0_neq_hx h_hx]. @@ -379,6 +381,7 @@ have -> //=: c0 <> x2; move: h0_neq_hx; apply/contra. exact/(@uniq_h _ _ _ _ h_h0 h_hx). qed. +(** Updating backward map **) lemma eqmi_handles_up (hs : handles) mi mhi (h hx : handle) (x y : state) f: (!exists f', mem (rng hs) (y.`2,f')) => hs.[h] = None => @@ -388,13 +391,13 @@ lemma eqmi_handles_up (hs : handles) mi mhi (h hx : handle) (x y : state) f: proof. move=> y_notinr1_handles h_h h_hx @/eqm_handles [] hmmh hmhm; split. + move=> xb xc xb' xc'; rewrite getP; case ((xb,xc) = y)=> /= [<<- ->> {x y}|]. - * by exists h, hx, Known, f; rewrite !getP /= [smt (in_dom)]. - move=> bc_neq_y /hmmh [] h0 h0' f0 f0' [#] h_h0 h_h0' mhi_bc. - by exists h0, h0', f0, f0'; rewrite !getP [smt (in_dom)]. + * by exists h, Known, hx, f; rewrite !getP /= [smt (in_dom)]. + move=> bc_neq_y /hmmh [] h0 f0 h0' f0' [#] h_h0 h_h0' mhi_bc. + by exists h0, f0, h0', f0'; rewrite !getP [smt (in_dom)]. move=> xb xh xb' xh'; rewrite getP; case ((xb,xh) = (y.`1,h))=> /= [[#] <*> [#] <*>|]. - * by exists y.`2, x.`2, Known, f; rewrite !getP [smt (in_dom)]. -rewrite anda_and negb_and=> bh_neq_y1h /hmhm /= [] c0 c0' f0 f0' [#] h_bh h_bh' mi_bh. -exists c0, c0', f0, f0'; rewrite !getP. + * by exists y.`2, Known, x.`2, f; rewrite !getP [smt (in_dom)]. +rewrite anda_and negb_and=> bh_neq_y1h /hmhm /= [] c0 f0 c0' f0' [#] h_bh h_bh' mi_bh. +exists c0, f0, c0', f0'; rewrite !getP. split; 1:smt (in_dom). split; 1:smt (in_dom). case y bh_neq_y1h y_notinr1_handles=> y1 y2 /= [/#|h0_neq_h y_notinr1_handles]. @@ -427,20 +430,28 @@ proof. by case f. qed. op getflag (hs : handles) xc = omap snd (obind ("_.[_]" hs) (hinv hs xc)). -lemma getflagP hs xc f: +lemma getflagP_none hs xc: + (getflag hs xc = None <=> forall f, !mem (rng hs) (xc,f)). +proof. +rewrite /getflag; case: (hinvP hs xc)=> [->|] //=. ++ smt (in_rng). +smt (in_rng). +qed. + +lemma getflagP_some hs xc f: huniq hs => - (mem (rng hs) (xc,f) <=> getflag hs xc = Some f). + (getflag hs xc = Some f <=> mem (rng hs) (xc,f)). proof. move=> huniq_hs; split. -+ rewrite in_rng=> -[h] hs_h. - move: (hinvP hs xc)=> [_ /(_ h f) //|]. - rewrite /getflag; case: (hinv hs xc)=> // h' _ [f']; rewrite oget_some. - move=> /(huniq_hs _ h _ (xc,f)) /(_ hs_h) /= ->>. - by rewrite hs_h. -rewrite /getflag; case: (hinvP hs xc)=> [-> //|]. -rewrite in_rng; case: (hinv hs xc)=> //= h [f']. -rewrite oget_some=> ^ hs_h -> @/snd /= ->>. -by exists h. ++ rewrite /getflag; case: (hinvP hs xc)=> [-> //|]. + rewrite in_rng; case: (hinv hs xc)=> //= h [f']. + rewrite oget_some=> ^ hs_h -> @/snd /= ->>. + by exists h. +rewrite in_rng=> -[h] hs_h. +move: (hinvP hs xc)=> [_ /(_ h f) //|]. +rewrite /getflag; case: (hinv hs xc)=> // h' _ [f']; rewrite oget_some. +move=> /(huniq_hs _ h _ (xc,f)) /(_ hs_h) /= ->>. +by rewrite hs_h. qed. lemma paths_prefix handles m2 mh ro paths c b p v: @@ -450,33 +461,200 @@ lemma paths_prefix handles m2 mh ro paths c b p v: (exists c' v', paths.[c'] = Some (p,v')). proof. move=> [] mh_some _ [] hpaths ^paths_c. -move=> /hpaths [h] [#] /build_hpathP [/#|] [p' b' v' h'] [#] ^/rconsIs + /rconssI- <*>. +move=> /hpaths [h] [#] /build_hpathP [/#|] p' b' v' h' [#] ^/rconsIs + /rconssI- <*>. move=> hpath + handles_h - /mh_some /= [c' c0 f' f]; rewrite handles_h /= => /> handles_h' _. by exists c', v'; rewrite hpaths; exists h'. qed. lemma build_hpath_prefix mh p b v h: - build_hpath mh (rcons p b) = Some (v,h) => - (exists v' h', build_hpath mh p = Some (v',h')). + build_hpath mh (rcons p b) = Some (v,h) <=> + (exists v' h', build_hpath mh p = Some (v',h') /\ mh.[(v' +^ b,h')] = Some (v,h)). proof. -move=> /build_hpathP [/#|] [p' b' v' h'] [#] + + _. -move=> ^/rconsIs <<- {b'} /rconssI <<- {p'} H. -by exists v', h'. +rewrite build_hpathP; split=> [[/#|p' b' v' h' [#] + Hhpath Hmh]|[v' h'] [] Hhpath Hmh]. ++ by move=> ^/rconsIs <<- {b'} /rconssI <<- {p'}; exists v', h'. +exact/(Extend _ _ _ _ _ Hhpath Hmh). qed. -clone export ConcreteF as ConcreteF1. +lemma iter_step_path_from_None mh p: foldl (step_hpath mh) None p = None. +proof. by elim: p. qed. + +lemma build_hpath_up mh xc xh yc yh p b h: + !mem (dom mh) (xc,xh) => + build_hpath mh p = Some (b,h) => + build_hpath mh.[(xc,xh) <- (yc,yh)] p = Some (b,h). +proof. +move=> xch_notin_mh @/build_hpath. +have: (exists p' v h, build_hpath mh p' = Some (v +^ b0,h)). ++ by exists [], b0, 0; rewrite build_hpathP Block.xorw0; exact/Empty. +pose root:= b0; elim: p root 0=> //= b1 p ih bn hn. +rewrite /(step_hpath _ (Some _)) /= oget_some /= /(step_hpath _ (Some _)) /= oget_some /= getP. +case: (mem (dom mh) (bn +^ b1,hn))=> [bnb1hn_in_mh extend_path|]. ++ have -> /= : (bn +^ b1,hn) <> (xc,xh). + + apply/contraT=> /(congr1 (mem (dom mh)) (bn +^ b1,hn) (xc,xh)). + by rewrite xch_notin_mh bnb1hn_in_mh. + case: {-1}(mh.[(bn +^ b1,hn)]) (eq_refl (mh.[(bn +^ b1,hn)]))=> //=. + + smt. (* figure out *) + move=> [] b2 h2 mh_bnb1hn. + apply/(@ih b2 h2). + case: extend_path=> p' v hp' build_path. + by exists p', (v +^ bn +^ b2), hp'; rewrite build_path //= #ring. +by rewrite in_dom /= => mh_bnb1hn _; rewrite mh_bnb1hn iter_step_path_from_None. +qed. + +lemma build_hpath_down mh xc xh yc yh p v h: + 0 <> xh + => (forall c' h' xc', mh.[(c',h')] <> Some (xc',xh)) + => build_hpath mh.[(xc,xh) <- (yc,yh)] p = Some (v,h) + => build_hpath mh p = Some (v,h). +proof. +move=> xh_neq_0 xh_notin_rng2_mh. +elim/last_ind: p v h=> [v h /build_hpathP [<*>|/#] //=|p b ih]. +move=> v h /build_hpathP [/#|p' b' + + ^/rconsIs <<- /rconssI <<-]. +move=> v' h' /ih; rewrite getP. +case: ((v' +^ b,h') = (xc,xh))=> [[#] <*> + [#] <*>|_ Hpath Hmh]. ++ by move=> /build_hpathP [|] /#. +exact/build_hpathP/(Extend _ _ _ _ _ Hpath Hmh). +qed. -inductive if_ind (b t e: bool) = - | Then of b & (b => t) - | Else of (!b) & (!b => e). +lemma INV_CF_G1_notin_PFm_notin_G1m hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi x: + INV_CF_G1 hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi => + PFm.[x] = None => + G1m.[x] = None. +proof. by move=> /incl_of_INV G1m_le_PFm; apply/contraLR=> ^h; rewrite G1m_le_PFm. qed. -lemma ifP (b t e : bool): (if b then t else e) <=> if_ind b t e. +lemma INV_CF_G1_0 hs PFm PFmi G1m G1mi G1mh G1mhi ro pi: + !INV_CF_G1 hs 0 PFm PFmi G1m G1mi G1mh G1mhi ro pi. proof. -split; case: b=> _ => [t_|e_|[]//|[]//]. -+ exact/Then. -exact/Else. +rewrite -negP=> -[] _ _ _ _ _ _ [] _ + /(_ 0) /=. +by rewrite in_dom=> ->. qed. +(** Clean this up and tidy intermediate results, more particularly + anything that is derived from individual components of INV_CF_G1 **) +lemma lemma1 hs ch PFm PFmi G1m G1mi G1mh G1mhi ro (pi : (capacity,block list * block) fmap) x1 x2 y1 y2: + x2 <> y2 => + PFm.[(x1,x2)] = None => + G1m.[(x1,x2)] = None => + pi.[x2] = None => + (forall f, !mem (rng hs) (x2,f)) => + (forall f, !mem (rng hs) (y2,f)) => + INV_CF_G1 hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi => + INV_CF_G1 hs.[ch <- (x2,Known)].[ch + 1 <- (y2,Known)] (ch + 2) + PFm.[(x1,x2) <- (y1,y2)] PFmi.[(y1,y2) <- (x1,x2)] + G1m.[(x1,x2) <- (y1,y2)] G1mi.[(y1,y2) <- (x1,x2)] + G1mh.[(x1,ch) <- (y1,ch + 1)] G1mhi.[(y1,ch + 1) <- (x1,ch)] + ro pi. +proof. +move=> x2_neq_y2 PFm_x G1m_x pi_x2 x2_notin_hs y2_notin_hs Hinv; split. ++ apply/(@eqm_handles_up hs.[ch <- (x2,Known)] PFm G1mh (ch + 1) ch (x1,x2) (y1,y2) Known). + + move=> @/huniq h1 h2 [c1 f1] [c2 f2]; rewrite !getP /=. + case: (h1 = ch); case: (h2 = ch)=> //=. + + move=> + + [#] - + <*>. + by move: (x2_notin_hs f2); rewrite in_rng negb_exists /= => ->. + + move=> <*> + + [#] <*>. + by move: (x2_notin_hs f1); rewrite in_rng negb_exists /= => ->. + case: Hinv=> _ _ _ _ _ _ [] + _ _ _ _ - h. + exact/(@h h1 h2 (c1,f1) (c2,f2)). + + by rewrite getP; case: Hinv=> _ _ _ _ _ _ [] _ _; smt (in_dom). + + by rewrite getP. + by apply/eqm_up_handles; case: Hinv. ++ apply/(@eqmi_handles_up hs.[ch <- (x2,Known)] PFmi G1mhi (ch + 1) ch (x1,x2) (y1,y2) Known). + + rewrite negb_exists /= => f; rewrite in_rng negb_exists /= => h. + rewrite getP; case: (h = ch)=> _; first by rewrite /= x2_neq_y2. + by move: (y2_notin_hs f); rewrite in_rng negb_exists /= => ->. + + by rewrite getP; case: Hinv=> _ _ _ _ _ _ [] _ _; smt (in_dom). + + by rewrite getP. + by apply/eqm_up_handles; case: Hinv. ++ move=> z; rewrite !getP; case: (z = (x1,x2))=> //= _. + by case: Hinv=> _ _ + _ _ _ _ - @/incl /(_ z). ++ move=> z; rewrite !getP; case: (z = (y1,y2))=> //= _. + by case: Hinv=> _ _ _ + _ _ _ - @/incl /(_ z). ++ split. + + move=> xa xh ya yh; rewrite getP; case: ((xa,xh) = (x1,ch)). + + move=> /= [#] <*> [#] <*>; exists x2, Known, y2, Known=> //=. + by rewrite !getP /#. + rewrite /= anda_and negb_and=> h hG1mh. (* This one needs cleaned up in priority. These are things that should be deduced instantly. *) + have := Hinv=>- [] _ _ _ _ [] + _ _ _ - h0. + have [xc xf yc yf] [#] hs_xh hs_yh ite:= h0 _ _ _ _ hG1mh. + have yh_lt_ch: xh < ch by case: Hinv=> _ _ _ _ _ _ [] _ _ -> //; rewrite in_dom hs_xh. + have xh_lt_ch: yh < ch by case: Hinv=> _ _ _ _ _ _ [] _ _ -> //; rewrite in_dom hs_yh. + exists xc, xf, yc, yf. + split; first by smt (getP). + split; first by smt (getP). + split=> /=. + + by move: ite=> <*> /= [#] hG1m -> //=; rewrite getP; case: ((xa,xc) = (x1,x2))=> [<*> /#|]. + move: ite=> + hrw; move: hrw=> -> /= [p v] [#] ro_pv hpath. + exists p, v; rewrite ro_pv /=. + apply/build_hpath_up=> //=; case: Hinv=> _ _ _ _ _ _ [] _ _ hh. + rewrite -negP in_dom; case: {-1}(G1mh.[(x1,ch)]) (eq_refl (G1mh.[(x1,ch)]))=> [//=|[xa' xh']]. + move=> /h0 [xc0 xf0 ? ?] [] + _. + by move: (hh ch)=> /=; rewrite in_dom /= => ->. + (* These two are going to be painful: -> are easy. <- rely on the fact that neither x not y had an associated handle, and therefore cannot be involved in a path. This is crucial. Maybe some other permutation of the goals/invariant's conjuncts would help clarify. *) + + move=> p xa b; have:= Hinv=>- [] _ _ _ _ [] _ -> _ _. + apply/exists_iff=> v /=; apply/exists_iff=> xh /=; apply/exists_iff=> yh /=. + have G1mh_x1ch: G1mh.[(x1,ch)] = None. + + have /# : forall x1' xh', G1mh.[(x1,ch)] <> Some (x1',xh'). + move=> x1' xh'; rewrite -negP=> G1mh_xh'. + have [] [] _ ht _ _ _ _ _ _ := Hinv. + move: (ht _ _ _ _ G1mh_xh')=> [xc xf yc yf] [#] + _ _ {ht}. + have [] _ _ _ _ _ _ [] _ _ /(_ ch):= Hinv. + by rewrite in_dom=> /= ->. + have ch_notin_G1mh: forall cx, !mem (rng G1mh) (cx,ch). + + move=> cx; rewrite in_rng negb_exists=> - [b0 h0] /=; rewrite -negP=> G1mh_cxch. + by case: Hinv=> - [] _ + _ _ _ _ _ [] _ _ + - /(_ ch) + /(_ _ _ _ _ G1mh_cxch) [xc xf yc yf] [#] _ hs_ch _ - /=; rewrite in_dom hs_ch. + split=> -[#]. + + move=> hpath hG1mh. + rewrite getP; case: ((v +^ xa,xh) = (x1,ch))=> [/#|_]. + rewrite hG1mh //=. + by apply/build_hpath_up=> //=; rewrite in_dom G1mh_x1ch. + (* The following case should be built into the lemma (build_hpath_down) *) + rewrite getP; case: ((v +^ xa,xh) = (x1,ch))=> [[#] <*> + [#] <*>|]. + + have ht /ht {ht} /= := (build_hpath_down G1mh (v +^ xa) ch b (ch + 1) p v ch _ _). + + by case: Hinv=> _ _ _ _ _ _ [] _ + +; smt (in_dom). + + move=> c' h' xc'; move: (ch_notin_G1mh xc'). + by rewrite in_rng negb_exists /= => ->. + move=> /build_hpathP [<*>|p' b' v' h' <*>]; first by rewrite INV_CF_G1_0 in Hinv; smt (). + by move: (ch_notin_G1mh v); rewrite in_rng negb_exists /= => ->. + move=> _. + have ht /ht {ht} /= -> //= := build_hpath_down G1mh x1 ch y1 (ch + 1) p v xh _ _. + + by case: Hinv=> _ _ _ _ _ _ [] _ + +; smt (in_dom). + by move=> c' h' xc'; move: (ch_notin_G1mh xc'); rewrite in_rng negb_exists /= => ->. ++ split=> c p v; have [] _ _ _ _ _ [] -> _:= Hinv. + apply/exists_iff=> h /=; split=> [#]. + have ht /ht {ht} -> /= := build_hpath_up G1mh x1 ch y1 (ch +1) p v h _. + + rewrite in_dom /=; case: {-1}(G1mh.[(x1,ch)]) (eq_refl (G1mh.[(x1,ch)]))=> [|[x1' xh'] G1mh_x1'xh'] //=. + case: Hinv=> - [] _ /(_ _ _ _ _ G1mh_x1'xh') [xc xf ct ft] [#] hs_ch _ _ _ _ _ _ _ [] _ _ /(_ ch) /=. + by rewrite in_dom hs_ch. + move=> hs_h; rewrite !getP hs_h. + have /#: h < ch. + by case: Hinv=> _ _ _ _ _ _ [] _ _ /(_ h); rewrite in_dom hs_h. + have ch_notin_G1mh: forall cx, !mem (rng G1mh) (cx,ch). + + move=> cx; rewrite in_rng negb_exists=> - [b0 h0] /=; rewrite -negP=> G1mh_cxch. + by case: Hinv=> - [] _ + _ _ _ _ _ [] _ _ + - /(_ ch) + /(_ _ _ _ _ G1mh_cxch) [xc xf yc yf] [#] _ hs_ch _ - /=; rewrite in_dom hs_ch. + have Sch_notin_G1mh: forall cx, !mem (rng G1mh) (cx,ch + 1). + + move=> cx; rewrite in_rng negb_exists=> - [b0 h0] /=; rewrite -negP=> G1mh_cxch. + by case: Hinv=> - [] _ + _ _ _ _ _ [] _ _ + - /(_ (ch + 1)) + /(_ _ _ _ _ G1mh_cxch) [xc xf yc yf] [#] _ hs_ch _ - /=; rewrite in_dom hs_ch /#. + have ht /ht {ht} /= := build_hpath_down G1mh x1 ch y1 (ch + 1) p v h _ _. + + by case: Hinv=> _ _ _ _ _ _ [] _ + +; smt (in_dom). + + by move=> c' h' xc'; move: (ch_notin_G1mh xc'); rewrite in_rng negb_exists /= => ->. + move=> Hpath; rewrite Hpath /=. + have: h <> ch /\ h <> ch + 1; last by smt (getP). + case: (h = 0)=> [<*>|]. + + by case: Hinv=> _ _ _ _ _ _ [] _ + /(_ 0) //=; rewrite in_dom=> /#. + move=> h_neq_0; move: Hpath=> /build_hpathP [<*> /#|p' b' v' h' <*> _]. + move: (ch_notin_G1mh v); rewrite in_rng negb_exists /= => /(_ (v' +^ b',h')). + move: (Sch_notin_G1mh v); rewrite in_rng negb_exists /= => /(_ (v' +^ b',h')). + smt (). +have ->: ch + 2 = ch + 1 + 1 by rewrite -addzA. +apply/(@handles_up_handles hs.[ch <- (x2,Known)] (ch + 1) y2 Known). ++ move=> f; rewrite in_rng negb_exists /= => h; rewrite !getP. + case: (h = ch)=> [<*> /=|_]; first by rewrite x2_neq_y2. + by move: (y2_notin_hs f); rewrite in_rng negb_exists /= => ->. +by apply/handles_up_handles=> //=; case: Hinv. +qed. + +clone export ConcreteF as ConcreteF1. + section AUX. declare module D : DISTINGUISHER {PF, RO, G1}. @@ -487,7 +665,7 @@ section AUX. equiv CF_G1 : CF(D).main ~ G1(D).main: ={glob D} ==> !(G1.bcol \/ G1.bext){2} => ={res}. - proof. + proof. proc. call (_: G1.bcol \/ G1.bext, INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} @@ -496,125 +674,217 @@ section AUX. + exact/D_ll. (** proofs for G1.S.f *) (* equivalence up to bad of PF.f and G1.S.f *) - + proc; if{1}=> //=. - (* x is not in m{1} so forall h, (x.1,h) is not in mh{2} *) - + rcondt{2} 1. - + move=> &m; auto=> &m' [#] _ <- Hinv. - by rewrite !in_dom; apply/contra=> ^ h; case: Hinv=> _ _ ->. - exists* F.RO.m{2}; elim*=> ro0. - seq 2 3: ( !G1.bcol{2} - /\ (G1.bext <=> mem (rng FRO.m) (x.`2, Unknown)){2} - /\ ={x,y1,y2} - /\ INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} ro0 G1.paths{2} - /\ ! mem (dom PF.m{1}) x{1} - /\ (if mem (dom G1.paths) x.`2 - then let (p,v) = oget G1.paths.[x.`2] in - F.RO.m{2} = ro0.[rcons p (v+^x.`1) <- y.`1] - else F.RO.m = ro0){2}). - + if{2}; last first. - + by auto=> |> &1 &2; rewrite negb_or; case=> -> ->. - inline{2} F.RO.get; rcondt{2} 4. - + auto=> |> &m'; case: (x{m'})=> /= _x1 _x2 _ [] - [] m_some mh_some _ leq _ [] in_mh in_ro [] in_pi [] hs_inj hs0 hs_dom + + r0 _ - {r0} + x2_in_pi. - have:= x2_in_pi; rewrite in_dom. - case: {-1}(G1.paths.[_x2]{m'}) (eq_refl (G1.paths.[_x2]{m'}))=> //= -[] p v paths_x2. - rewrite oget_some /=; have /in_pi [h_x2] [#] pv_hx2 hs_h_x2:= paths_x2. - apply/contra; rewrite !in_dom. - case: {-1}(F.RO.m.[rcons p (v +^ _x1)]{m'}) (eq_refl (F.RO.m.[rcons p (v +^ _x1)]{m'}))=> //= b. - move=> ^ro_pv_x1 /in_ro [v' xh yh] [#]. - rewrite pv_hx2 /= => [#] <<- <<-. - rewrite Block.xorwA Block.xorwK Block.xorwC Block.xorw0. - by move=> /mh_some [xc yc xf yf] [#]; rewrite hs_h_x2 /= => [#] <<- <<- _ ->. - auto=> |> &1 &2; rewrite negb_or; case=> -> -> /= Hinv x_notin_PF ^x2_in_paths. - rewrite in_dom; case: {-1}(G1.paths.[x.`2]{2}) (eq_refl G1.paths.[x.`2]{2})=> //=. - move=> [p v] paths_x2 y1' _ y2' _; rewrite oget_some /=. - rewrite getP /= oget_some /= => x1 x2 [] <- <-. - by rewrite getP /= oget_some. - auto=> &1 &2; case: (x{2})=> [] x1 x2 /= [#] not_bcol bext_upd <*>. - rewrite ifP=> Hinv x_notin_PF ROupd. - split=> /= [x2K_notin_rFRO|x2K_in_rFRO]. - + split=> /= [#]. - + admit. - admit. - admit. -(* swap{2} 3-2;swap{2}6-4;wp;conseq (_:y{1} =(r,y2){2}). - + progress [-split];rewrite getP_eq oget_some H2/=. - by move:H2;rewrite in_dom;case:(G1.paths{2}.[_]). - transitivity{1} {y <- S.sample();} (true ==> ={y}) (true==>y{1}=(r,y2){2})=>//;1:by inline*;auto. - transitivity{2} {(r,y2) <- S.sample2();} (true==>y{1}=(r,y2){2}) (true==> ={r,y2})=>//;2:by inline*;auto. - by call sample_sample2;auto=> /=?[??]->. - case (mem (rng FRO.m{2}) (x{2}.`2, Unknown)). - + conseq (_:true);[by move=> ??[][]_[]->_->|auto]. - conseq (_: !G1.bcol{2} => - oget PF.m{1}.[x{1}] = y{2} /\ - INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2}). - by move=> ??[][]_[]->[][]-> _ _ ->. *) - admit. -(* seq 0 2: ((!G1.bcol{2} /\ ={x, y} /\ - INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} - G1.mh{2} G1.mhi{2} ro0 paths0 /\ - ! mem (dom PF.m{1}) x{1} /\ - if mem (dom paths0) x{2}.`2 then - let (p0, v0) = oget paths0.[x{2}.`2] in - F.RO.m{2} = ro0.[rcons p0 (v0 +^ x{2}.`1) <- y{2}.`1] /\ - G1.paths{2} = paths0.[y{2}.`2 <- (rcons p0 (v0 +^ x{2}.`1), y{2}.`1)] - else F.RO.m{2} = ro0 /\ G1.paths{2} = paths0) /\ - !mem (rng FRO.m{2}) (x{2}.`2, Unknown) /\ - (FRO.m.[hx2]=Some(x.`2,Known)){2}). - + auto=> &ml&mr[][]->[]_[][]-> ->[]Hinv []-> -> ^Hrng-> /=. - case (mem (rng FRO.m{mr}) (x{mr}.`2, Known))=> Hmem /=. - + by split=>//;apply /huniq_hinvK=>//;move:Hinv;rewrite /INV_CF_G1/handles_spec. - rewrite -anda_and;split=> [ | {Hinv}Hinv]. - + by apply INV_CF_G1_up_handles=>//[[]]. - rewrite rng_set (huniq_hinvK_h G1.chandle{mr}) ?getP//. - + by move:Hinv;rewrite /INV_CF_G1/handles_spec. - by rewrite oget_some /=!inE/=;move:Hrng;apply NewLogic.contraLR=>/=;apply rng_rem_le. + + conseq (_: !G1.bcol{2} + /\ !G1.bext{2} + /\ ={x} + /\ INV_CF_G1 FRO.m{2} G1.chandle{2} + PF.m{1} PF.mi{1} + G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} + F.RO.m{2} G1.paths{2} + ==> !G1.bcol{2} + => !G1.bext{2} + => ={res} + /\ INV_CF_G1 FRO.m{2} G1.chandle{2} + PF.m{1} PF.mi{1} + G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} + F.RO.m{2} G1.paths{2}). + + by move=> &1 &2; rewrite negb_or. + + by move=> &1 &2 _ ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? [#]; rewrite negb_or. + (* For now, everything is completely directed by the syntax of + programs, so we can *try* to identify general principles of that + weird data structure and of its invariant. I'm not sure we'll ever + be able to do that, though. *) + (* We want to name everything for now, to make it easier to manage complexity *) + exists * FRO.m{2}, G1.chandle{2}, + PF.m{1}, PF.mi{1}, + G1.m{2}, G1.mi{2}, G1.mh{2}, G1.mhi{2}, + F.RO.m{2}, G1.paths{2}, + x{2}. + elim * => hs0 ch0 PFm PFmi G1m G1mi G1mh G1mhi ro0 pi0 [] x1 x2. + (* poor man's extraction of a fact from a precondition *) + case @[ambient]: {-1}(INV_CF_G1 hs0 ch0 PFm PFmi G1m G1mi G1mh G1mhi ro0 pi0) + (eq_refl (INV_CF_G1 hs0 ch0 PFm PFmi G1m G1mi G1mh G1mhi ro0 pi0)); last first. + + by move=> h; exfalso=> &1 &2 [#] <*>; rewrite h. + move=> /eqT inv0; proc; case @[ambient] {-1}(PFm.[(x1,x2)]) (eq_refl (PFm.[(x1,x2)])). + + move=> x1x2_notin_PFm. + move: (INV_CF_G1_notin_PFm_notin_G1m _ _ _ _ _ _ _ _ _ _ _ inv0 x1x2_notin_PFm). + move=> x1x2_notin_G1m. + rcondt{1} 1; 1:by move=> //= &1; skip=> &2 [#] <*>; rewrite in_dom x1x2_notin_PFm. + rcondt{2} 1; 1:by move=> //= &1; skip=> &2 [#] <*>; rewrite in_dom x1x2_notin_G1m. + case @[ambient]: {-1}(pi0.[x2]) (eq_refl (pi0.[x2])). + + move=> x2_in_pi; rcondf{2} 1. + + by move=> //= &1; skip=> &2 [#] <*>; rewrite in_dom x2_in_pi. + rcondf{2} 8. + + by move=> //= &1; auto=> &2 [#] !<<-; rewrite !in_dom x2_in_pi. + seq 2 2: ( hs0 = FRO.m{2} + /\ ch0 = G1.chandle{2} + /\ PFm = PF.m{1} + /\ PFmi = PF.mi{1} + /\ G1m = G1.m{2} + /\ G1mi = G1.mi{2} + /\ G1mh = G1.mh{2} + /\ G1mhi = G1.mhi{2} + /\ ro0 = F.RO.m{2} + /\ pi0 = G1.paths{2} + /\ (x1,x2) = x{2} + /\ !G1.bcol{2} + /\ !G1.bext{2} + /\ ={x, y1, y2} + /\ INV_CF_G1 hs0 ch0 PFm PFmi G1m G1mi G1mh G1mhi ro0 pi0). + + by auto. + case @[ambient]: {-1}(getflag hs0 x2) (eq_refl (getflag hs0 x2)). + + rewrite getflagP_none => x2f_notin_rng_hs0; rcondt{2} 3. + + by move=> &1; auto=> &2 />; rewrite x2f_notin_rng_hs0. + rcondf{2} 6. + + move=> &1; auto=> &2 />. + have ->: hinvK FRO.m{2}.[G1.chandle{2} <- (x2,Known)] x2 = Some G1.chandle{2}. + + rewrite (@huniq_hinvK_h G1.chandle{2} FRO.m{2}.[G1.chandle{2} <- (x2,Known)] x2) //. + + move=> hx hy [] xc xf [] yc yf /=. + rewrite !getP; case: (hx = G1.chandle{2}); case: (hy = G1.chandle{2})=> //=. + + move=> _ + [#] - <*>. + by have:= (x2f_notin_rng_hs0 yf); rewrite in_rng negb_exists /= => ->. + + move=> + _ + [#] - <*>. + by have:= (x2f_notin_rng_hs0 xf); rewrite in_rng negb_exists /= => ->. + by move=> _ _; case: inv0=> _ _ _ _ _ _ [] + _ _ - /(_ hx hy (xc,xf) (yc,yf)). + by rewrite !getP. + rewrite oget_some=> _ _ _. + have -> //: !mem (dom G1.mh{2}) (x1,G1.chandle{2}). + rewrite in_dom /=; case: {-1}(G1.mh.[(x1,G1.chandle)]{2}) (eq_refl (G1.mh.[(x1,G1.chandle)]{2}))=> //= -[xa xh]; rewrite -negP. + case: inv0=> - [] _ + _ _ _ _ _ [] _ _ h_handles. + move=> /(_ x1 G1.chandle{2} xa xh) h /h [] xc xf yc yf. + by have ->: FRO.m.[G1.chandle]{2} = None by smt (in_dom). + case: (x2 <> y2{2} /\ (forall f, !mem (rng hs0) (y2{2},f))). + + auto=> &1 &2 [#] !<<- -> -> !->> {&1} /= _ x2_neq_y2 y2_notin_hs _ _. + rewrite getP /= oget_some /= -addzA /=. + rewrite (@huniq_hinvK_h ch0 hs0.[ch0 <- (x2,Known)] x2); 2:by rewrite getP. + + move=> @/huniq h1 h2 [c1 f1] [c2 f2]; rewrite !getP /=. + case: (h1 = ch0); case: (h2 = ch0)=> //=. + + by move=> _ + [#] - <*>; move: (x2f_notin_rng_hs0 f2); rewrite in_rng negb_exists=> /= ->. + + by move=> + _ + [#] <*> - <*>; move: (x2f_notin_rng_hs0 f1); rewrite in_rng negb_exists=> /= ->. + move=> _ _; case: inv0=> _ _ _ _ _ _ [] + _ _ - h. + by apply/h; rewrite getP. + by rewrite oget_some; exact/lemma1. + conseq (_: _ ==> G1.bcol{2})=> //=. + auto=> &1 &2 [#] !<<- -> _ ->> !<<- _ /=. + case: (hinvP hs0.[ch0 <- (x2,Known)] y2{1})=> //= -> /=. + move=> hs0_spec; split=> [|f]. + + by have:= hs0_spec ch0 Known; rewrite getP. + rewrite in_rng negb_exists /= => h. + have:= hs0_spec h f; rewrite getP; case: (h = ch0)=> [<*>|//=]. + by have -> //=: hs0.[ch0] = None; case: inv0=> _ _ _ _ _ _ [] _ _; smt (in_dom). + case; rewrite getflagP_some; 1,3:by case: inv0=> _ _ _ _ _ _ []. + + by move=> x2_is_U; conseq (_: G1.bext{2})=> //=; auto=> &1 &2 />; rewrite x2_is_U. + move=> x2_is_K; rcondf{2} 3; 1:by move=> &1; auto. + have:= x2_is_K; rewrite in_rng=> - [hx] hs0_hx. + seq 0 3: ( hs0 = FRO.m{2} + /\ ch0 = G1.chandle{2} + /\ PFm = PF.m{1} + /\ PFmi = PF.mi{1} + /\ G1m = G1.m{2} + /\ G1mi = G1.mi{2} + /\ G1mh = G1.mh{2} + /\ G1mhi = G1.mhi{2} + /\ ro0 = F.RO.m{2} + /\ pi0 = G1.paths{2} + /\ (x1,x2) = x{2} + /\ !G1.bcol{2} + /\ !G1.bext{2} + /\ ={x,y1,y2} + /\ y{2} = (y1,y2){2} + /\ hx2{2} = hx + /\ INV_CF_G1 hs0 ch0 PFm PFmi G1m G1mi G1mh G1mhi ro0 pi0). + + auto=> &1 &2 /> _ -> /= _; split. + + move: x2_is_K; rewrite in_rng /= => -[hx2] hs_hx2. + rewrite in_rng negb_exists /==> h; rewrite -negP=> hs_h. + case: inv0=> _ _ _ _ _ _ [] Hhuniq _ _. + by move: (Hhuniq _ _ _ _ hs_hx2 hs_h)=> ht; move: ht hs_h=> /= <*>; rewrite hs_hx2. + rewrite (@huniq_hinvK_h hx FRO.m{2} x2) //. + by case: inv0=> _ _ _ _ _ _ []. + have x1hx_notin_G1m: !mem (dom G1mh) (x1,hx). + + rewrite in_dom; case: {-1}(G1mh.[(x1,hx)]) (eq_refl G1mh.[(x1,hx)])=> //=. + move=> [mhx1 mhx2]; rewrite -negP=> h. + have:= inv0=> -[] [] _ hg _ _ _ _ _ _. + have [xa xh ya yh] := hg _ _ _ _ h. + by rewrite hs0_hx=> [#] <*>; rewrite x1x2_notin_PFm. rcondf{2} 1. - + move=> &ml;skip=> &mr[][]_[][]-> _ []Hinv[]Hndom _[]_ Hh;rewrite -not_def in_dom=> -[]. - move:Hinv=>[][][]_ /(_ (x{mr}.`1, hx2{mr}));case (G1.mh{mr}.[_])=>// bh' /(_ bh') [c c' f f'] /=. - by rewrite Hh/= => -[][]<- _ []_ H;case: (x{mr}) H Hndom => [x1 x2];rewrite in_dom=>->. - auto=> &1 &2 [#] -> ->> ->> hinv x_notin_PF disj x2U_notinr_FRO FRO_hx2 /= hinv_y2. - have:= hinvP FRO.m{2} y{2}.`2; rewrite hinv_y2 //= => y2_notinr1_FRO. - rewrite getP /= oget_some /= /INV_CF_G1. - rewrite (eqm_handles_up FRO.m{2} PF.m{1} G1.mh{2} G1.chandle{2} hx2{2} x{2} y{2} Known _ _ _ _) //= 1..3:[smt w=in_dom]. - rewrite (eqmi_handles_up FRO.m{2} PF.mi{1} G1.mhi{2} G1.chandle{2} hx2{2} x{2} y{2} Known _ _ _ _) //= 2..3:[smt w=in_dom]. - + rewrite negb_exists=> f /=; rewrite in_rng negb_exists=> h. - exact/(y2_notinr1_FRO h f). - have /eqT -> /= := incl_set G1.m{2} PF.m{1} x{2} y{2} _; 1: by smt ml=0. - have /eqT -> /= := incl_set G1.mi{2} PF.mi{1} y{2} x{2} _; 1: by smt ml=0. - rewrite handles_up_handles 1:[smt w=in_rng] 1:/# /=. - split. - rewrite /mh_spec; split. - move=> bh [] b ch; rewrite getP; case (bh = (x.`1,hx2){2})=> [<*> /=|]. - rewrite anda_and=> [#] <*>. - exists x{2}.`2, y{2}.`2, Known, Known=> //=. - rewrite !getP /=; elim: (x{2}) FRO_hx2=> x1 x2 FRO_hx2; elim (y{2})=> y1 y2 /=. - have /#: hx2{2} = G1.chandle{2} => false. - move=> /(congr1 (fun x=> FRO.m{2}.[x])) /=; rewrite FRO_hx2. - have:= handles_spec_notin_dom FRO.m{2} G1.chandle{2} _; 1: smt ml=0. - by rewrite in_dom /= => ->. - elim bh=> b' h' /=; rewrite anda_and negb_and=> bh_neq_xhx ^mh_bh. - have @/eqm_handles [] hmmh hmhm := eqm_of_INV _ _ _ _ _ _ _ _ _ _ hinv. - move=> /hmhm=>- [c c' f f'] /= [#] FRO_h' FRO_ch PF_b'c. - exists c, c', f, f'=> //=. - rewrite !getP /=; elim: (x{2}) FRO_hx2 mh_bh x2U_notinr_FRO x_notin_PF bh_neq_xhx=> x1 x2 /= FRO_hx2 mh_bh x2U_notinr_FRO x_notin_PF bh_neq_xhx. - elim: (y{2}) y2_notinr1_FRO hinv_y2=> y1 y2 /= y2_notinr1_FRO hinv_y2. - have -> /=: h' <> G1.chandle{2} by smt w=in_dom. - rewrite FRO_h' /=. - have -> /=: ch <> G1.chandle{2} by smt w=in_dom. - rewrite FRO_ch /=; split=> /= [|/neq_Known ->> {f'}]. - case bh_neq_xhx=> [-> /#|h'_neq_hx2]. - have /#: c <> x2. - have @/handles_spec [] huniq _ := handles_of_INV _ _ _ _ _ _ _ _ _ _ hinv. - by move: h'_neq_hx2; apply/contra/(huniq _ _ (c,f) (x2,Known)). - case disj. - rewrite in_dom; case (paths0.[x{2}.`2])=> @/oget //= [[p0 v]] /= [#] <*>. - admit. (** KEY observation: if two hstates lead to hstates that - share the same handle through mh, then they are equal **) - admit. (* this one should be a lot easier *) - admit. (* some pain here *) - admit. (* will be painful as well *) -*) + + by move=> &m; auto=> //= &hr [#] <*>; rewrite x1hx_notin_G1m. + auto=> &1 &2 [#] !<<- -> -> !->> _ /= hinv_y2_none. + rewrite getP /= oget_some /=. + admit. + (* lemma 2: + PFm.[(x1,x2)] = None => + G1m.[(x1,x2)] = None => + pi0.[x2] = None => + mem (rng hs (x2,Known) => + hinv hs y2 = None => + INV_CF_G1 hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi => + INV_CF_G1 hs.[ch <- (y2,Known)] (ch + 1) + PFm.[(x,1x2) <- (y1,y2)] PFmi.[(y1,y2) <- (x1,x2)] + G1m.[(x1,x2) <- (y1,y2)] G1mi.[(y1,y2) <- (x1,x2)] + G1mh.[(x1,hx) <- (y1,ch)] G1mhi.[(y1,ch) <- (x1,hx)] + ro pi. *) + move=> [p0 v0] ^ pi_x2. have [] _ _ _ _ _ [] -> _ [hx2] [#] Hpath hs_hx2:= inv0. + rcondt{2} 1. by move=> &m; auto=> &hr [#] !<<- _ _ ->> /= _; rewrite in_dom pi_x2. + rcondf{2} 6. + + auto; inline *; auto=> &hr [#] !<<- _ _ !->> _ /= + _ - _ + _ - _ /=. + by rewrite in_rng; exists hx2. + rcondf{2} 7. + + auto; inline *; auto=> &hr [#] !<<- _ _ !->> _ /= + _ - _ + _ - _ /=. + rewrite negb_and; left; rewrite (@huniq_hinvK_h hx2 hs0 x2) // 2:oget_some. + + by case: inv0=> _ _ _ _ _ _ []. + rewrite in_dom; case: {-1}(G1mh.[(x1,hx2)]) (eq_refl (G1mh.[(x1,hx2)]))=> [//=|[xa xc] G1mh_x1hx2]. + have [] [] _ /(_ _ _ _ _ G1mh_x1hx2) [xc0 xf0 yc0 yf0] + _ _ _ _ _ _:= inv0. + by move=> [#]; rewrite hs_hx2=> [#] !<<- {xc0 xf0}; rewrite x1x2_notin_PFm. + rcondt{2} 15. + + auto; inline *; auto=> &hr [#] !<<- _ _ !->> _ /= + _ - _ + _ - _ /=. + by rewrite in_dom pi_x2. + inline F.RO.get. rcondt{2} 4. + + auto=> &hr [#] !<<- _ _ !->> _ /= + _ - _; rewrite pi_x2 oget_some /=. + rewrite in_dom; case: {-1}(ro0.[rcons p0 (v0 +^ x1)]) (eq_refl (ro0.[rcons p0 (v0 +^ x1)])). + + done. + move=> bo ^ro_pvx1 /=. have [] _ _ _ _ [] _ -> _ _:= inv0. + rewrite negb_exists=> ? /=; rewrite negb_exists=> ? /=; rewrite negb_exists=> yh /=. + rewrite Hpath /=; rewrite negb_and -implyNb /= => [#] !<<-. + rewrite xorwA xorwK xorwC xorw0 -negP=> G1mh_x1hx2. + have [] [] _ /(_ _ _ _ _ G1mh_x1hx2) + _ _ _ _ _ _ := inv0. + move=> [xc xf yc yf] [#]; rewrite hs_hx2=> [#] <*>. + by rewrite x1x2_notin_PFm. + auto. admit. (* this is the easy case *) + move=> [xa xc] PFm_x1x2. rcondf{1} 1; 1:by auto=> &hr [#] !<<- _ _ ->>; rewrite in_dom PFm_x1x2. + have [] [] /(_ _ _ _ _ PFm_x1x2) + _ _ _ _ _ _ _ := inv0. + move=> [hx2 fx2 hy2 fy2] [#] hs_hx2 hs_hy2 G1mh_x1hx2. + case @[ambient]: {-1}(G1m.[(x1,x2)]) (eq_refl (G1m.[(x1,x2)])); last first. + + move=> [ya yc] G1m_x1x2; rcondf{2} 1; 1:by auto=> &hr [#] !<<- _ _ ->>; rewrite in_dom G1m_x1x2. + auto=> &1 &2 [#] <*> -> -> -> /=; have [] _ _ /(_ (x1,x2)) + _ _ _ _ := inv0. + by rewrite PFm_x1x2 G1m_x1x2 /= => [#] !<<- {ya yc}. + move=> x1x2_notin_G1m; rcondt{2} 1; 1:by auto=> &hr [#] !<<- _ _ ->>; rewrite in_dom x1x2_notin_G1m. + have <*>: fy2 = Unknown. + + case: inv0=> _ _ _ _ [] /(_ _ _ _ _ G1mh_x1hx2) + _ _ _. + move=> [xc0 xf0 yc0 yf0] [#]; rewrite hs_hx2 hs_hy2=> [#] !<<- [#] !<<- {xc0 xf0 yc0 yf0}. + by case: fy2 hs_hy2 G1mh_x1hx2=> //=; rewrite x1x2_notin_G1m. + case @[ambient]: fx2 hs_hx2=> hs_hx2. + + swap{2} 3 -2; seq 0 1: (G1.bext{2}); last by inline*; if{2}; auto; smt (@Block @Capacity). + by auto=> ? ? [#] !<<- _ -> ->> _ /=; rewrite in_rng; exists hx2. + have [] _ _ _ _ [] /(_ _ _ _ _ G1mh_x1hx2) + _ _ _:= inv0. + move=> [xc0 xf0 yc0 yf0] [#]; rewrite hs_hx2 hs_hy2=> [#] !<<- [#] !<<- {xc0 xf0 yc0 yf0} /= [p0 v0] [#] Hro Hpath. + have [] _ _ _ _ _ [] /(_ x2 p0 v0) /iffRL Hpi _:= inv0. + move: (Hpi _); first by exists hx2. + move=> pi_x2; rcondt{2} 1; 1:by auto=> &hr [#] <*>; rewrite in_dom pi_x2. + inline F.RO.get. + rcondf{2} 4; first by auto=> &hr [#] !<<- _ _ ->> _ /=; rewrite pi_x2 oget_some /= in_dom Hro. + rcondf{2} 8; first by auto=> &hr [#] !<<- _ _ ->> _ /= + _ - _ + _ - _; rewrite in_rng; exists hx2. + rcondt{2} 9. + + auto=> &hr [#] !<<- _ _ ->> _ /= + _ - _ + _ - _. + rewrite (@huniq_hinvK_h hx2 hs0 x2) // 2:in_dom 2:G1mh_x1hx2 2:!oget_some /=. + + by case: inv0=> _ _ _ _ _ _ []. + by rewrite /in_dom_with in_dom hs_hy2. + rcondt{2} 14; first by auto=> &hr [#] !<<- _ _ ->> _ /=; rewrite in_dom pi_x2. + auto=> &1 &2 [#] !<<- -> -> ->> _ /=; rewrite Block.DWord.bdistr_ll Capacity.DWord.cdistr_ll /=. + move=> + _ - _ + _ - _; rewrite PFm_x1x2 pi_x2 !oget_some //=. + rewrite (@huniq_hinvK_h hx2 hs0 x2) // ?oget_some. + + by case: inv0=> _ _ _ _ _ _ []. + rewrite Hro G1mh_x1hx2 hs_hy2 ?oget_some //=. + (* lemma 3 *) admit. (* Stopped here *) + move=> &2 _; proc; if=> //=; wp; rnd predT; rnd predT; auto. smt (Block.DWord.bdistr_uf Capacity.DWord.cdistr_uf). From 53fe71d6ff7431e72a9401a1366aa0bbc3037407 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Tue, 9 Aug 2016 18:25:57 -0400 Subject: [PATCH 198/525] Cleaning up top-level proof. --- proof/Sponge.ec | 357 +++++++++++++++++++++++++++--------------------- 1 file changed, 200 insertions(+), 157 deletions(-) diff --git a/proof/Sponge.ec b/proof/Sponge.ec index a7a2c08..3fa6796 100644 --- a/proof/Sponge.ec +++ b/proof/Sponge.ec @@ -8,10 +8,10 @@ prover ["Z3"]. prover ["Alt-Ergo"]. *) -require import Fun Pair Int IntDiv Real List Option FSet NewFMap DBool. +require import Bool Fun Pair Option Int IntDiv Real List FSet NewFMap. (*---*) import Pred IntExtra. -require import DList StdBigop. -require import StdOrder. import IntOrder. +require import NewDistr DBool DList. +require import StdBigop StdOrder. import IntOrder. require import Common. require (*--*) IRO BlockSponge RndO. @@ -23,9 +23,9 @@ clone include Indifferentiability with type f_out <- bool list rename - [module] "Indif" as "Experiment" + [module] "Indif" as "Experiment" [module] "GReal" as "RealIndif" - [module] "GIdeal" as "IdealIndif". + [module] "GIdeal" as "IdealIndif". (*------------------------- Ideal Functionality ------------------------*) @@ -49,7 +49,7 @@ module (Sponge : CONSTRUCTION) (P : DPRIMITIVE) : FUNCTIONALITY = { (* absorption *) while (xs <> []) { (sa, sc) <@ P.f(sa +^ head b0 xs, sc); - xs <- behead xs; + xs <- behead xs; } (* squeezing *) while (i < (n + r - 1) %/ r) { @@ -72,8 +72,8 @@ module LowerFun (F : DFUNCTIONALITY) : BlockSponge.DFUNCTIONALITY = { obs <- unpad_blocks xs; if (obs <> None) { - cs <@ F.f(oget obs, n * r); (* size cs = n * r *) - ys <- bits2blocks cs; (* size ys = n *) + cs <@ F.f(oget obs, n * r); (* size cs = n * r *) + ys <- bits2blocks cs; (* size ys = n *) } return ys; } @@ -96,20 +96,40 @@ module RaiseSim (S : BlockSponge.SIMULATOR, F : DFUNCTIONALITY) = (*------------------------------- Proof --------------------------------*) -(*------------------- abstract theory of hybrid IROs -------------------*) +(*------------------- abstract theory of Hybrid IROs -------------------*) abstract theory HybridIRO. module type HYBRID_IRO = { + (* initialization *) proc init() : unit + + (* hashing blocks, giving n bits *) proc g(x : block list, n : int) : bool list + + (* hashing blocks, giving n blocks *) proc f(x : block list, n : int) : block list }. +(* distinguisher for Hybrid IROs *) + module type HYBRID_IRO_DIST(HI : HYBRID_IRO) = { proc distinguish() : bool }. +(* experiments for Hybrid IROs *) + +module HybridIROExper(HI : HYBRID_IRO, D : HYBRID_IRO_DIST) = { + proc main() : bool = { + var b : bool; + HI.init(); + b <@ D(HI).distinguish(); + return b; + } +}. + +(* lazy implementation of Hybrid IROs *) + module HybridIROLazy : HYBRID_IRO, BlockSponge.BIRO.IRO = { var mp : (block list * int, bool) fmap @@ -139,7 +159,7 @@ module HybridIROLazy : HYBRID_IRO, BlockSponge.BIRO.IRO = { return bs; } - proc f(xs, n) = { + proc f(xs, n) = { (* implemented using g *) var bs, ys; bs <@ g(xs, n * r); ys <- bits2blocks bs; @@ -147,16 +167,10 @@ module HybridIROLazy : HYBRID_IRO, BlockSponge.BIRO.IRO = { } }. -module HybridIROExper(HI : HYBRID_IRO, D : HYBRID_IRO_DIST) = { - proc main() : bool = { - var b : bool; - HI.init(); - b <@ D(HI).distinguish(); - return b; - } -}. +(* eager implementation of Hybrid IROs *) module HybridIROEager : HYBRID_IRO, BlockSponge.BIRO.IRO = { + (* same as lazy implementation, except for indicated part *) var mp : (block list * int, bool) fmap proc init() : unit = { @@ -198,6 +212,14 @@ module HybridIROEager : HYBRID_IRO, BlockSponge.BIRO.IRO = { } }. +(* we are going to use RndO.GenEager to prove: + +lemma HybridIROExper_Lazy_Eager + (D <: HYBRID_IRO_DIST{HybridIROEager, HybridIROLazy}) &m : + Pr[HybridIROExper(HybridIROLazy, D).main() @ &m : res] = + Pr[HybridIROExper(HybridIROEager, D).main() @ &m : res]. +*) + section. declare module D : HYBRID_IRO_DIST{HybridIROEager, HybridIROLazy}. @@ -225,9 +247,11 @@ seq 1 1 : (={glob D, ERO.RO.m}); first sim. symmetry; call (ERO.RO_LRO_D D); auto. qed. -local module HIRO(RO : ERO.RO) = { +(* make a Hybrid IRO out of a random oracle *) + +local module HIRO(RO : ERO.RO) : HYBRID_IRO = { proc init() : unit = { - RO.init(); + RO.init(); } proc g(xs, n) = { @@ -258,24 +282,24 @@ local module HIRO(RO : ERO.RO) = { } }. +local lemma HybridIROLazy_HIRO_LRO_init : + equiv[HybridIROLazy.init ~ HIRO(ERO.LRO).init : + true ==> HybridIROLazy.mp{1} = ERO.RO.m{2}]. +proof. proc; inline*; auto. qed. + local lemma HybridIROLazy_fill_in_LRO_get : equiv[HybridIROLazy.fill_in ~ ERO.LRO.get : (xs, i){1} = x{2} /\ HybridIROLazy.mp{1} = ERO.RO.m{2} ==> ={res} /\ HybridIROLazy.mp{1} = ERO.RO.m{2}]. proof. proc=> /=. -case: (mem (dom HybridIROLazy.mp{1}) (xs{1}, i{1})). +case (mem (dom HybridIROLazy.mp{1}) (xs{1}, i{1})). rcondf{1} 1; first auto. rcondf{2} 2; first auto. -rnd{2}; auto; progress; apply/dbool_ll. +rnd{2}; auto; progress; apply dbool_ll. rcondt{1} 1; first auto. rcondt{2} 2; first auto. wp; rnd; auto. qed. -local lemma HybridIROLazy_HIRO_LRO_init : - equiv[HybridIROLazy.init ~ HIRO(ERO.LRO).init : - true ==> HybridIROLazy.mp{1} = ERO.RO.m{2}]. -proof. proc; inline*; auto. qed. - local lemma HybridIROLazy_HIRO_LRO_g : equiv[HybridIROLazy.g ~ HIRO(ERO.LRO).g : ={xs, n} /\ HybridIROLazy.mp{1} = ERO.RO.m{2} ==> @@ -294,9 +318,12 @@ local lemma HybridIROLazy_HIRO_LRO_f : equiv[HybridIROLazy.f ~ HIRO(ERO.LRO).f : ={xs, n} /\ HybridIROLazy.mp{1} = ERO.RO.m{2} ==> ={res} /\ HybridIROLazy.mp{1} = ERO.RO.m{2}]. -proof. -proc; wp; call HybridIROLazy_HIRO_LRO_g; auto. -qed. +proof. proc; wp; call HybridIROLazy_HIRO_LRO_g; auto. qed. + +local lemma HIRO_RO_HybridIROEager_init : + equiv[HIRO(ERO.RO).init ~ HybridIROEager.init : + true ==> ={res} /\ ERO.RO.m{1} = HybridIROEager.mp{2}]. +proof. proc; inline*; auto. qed. local lemma RO_get_HybridIROEager_fill_in : equiv[ERO.RO.get ~ HybridIROEager.fill_in : @@ -304,9 +331,9 @@ local lemma RO_get_HybridIROEager_fill_in : ={res} /\ ERO.RO.m{1} = HybridIROEager.mp{2}]. proof. proc=> /=. -case: (mem (dom HybridIROEager.mp{2}) (xs{2}, i{2})). +case (mem (dom HybridIROEager.mp{2}) (xs{2}, i{2})). rcondf{1} 2; first auto. rcondf{2} 1; first auto. -rnd{1}; auto; progress; apply/dbool_ll. +rnd{1}; auto; progress; apply dbool_ll. rcondt{1} 2; first auto. rcondt{2} 1; first auto. wp; rnd; auto. qed. @@ -317,18 +344,13 @@ local lemma RO_sample_HybridIROEager_fill_in : ERO.RO.m{1} = HybridIROEager.mp{2}]. proof. proc=> /=; inline ERO.RO.get; sp. -case: (mem (dom HybridIROEager.mp{2}) (xs{2}, i{2})). +case (mem (dom HybridIROEager.mp{2}) (xs{2}, i{2})). rcondf{1} 2; first auto. rcondf{2} 1; first auto. -rnd{1}; auto; progress; apply/dbool_ll. +rnd{1}; auto; progress; apply dbool_ll. rcondt{1} 2; first auto. rcondt{2} 1; first auto. wp; rnd; auto. qed. -local lemma HIRO_RO_HybridIROEager_init : - equiv[HIRO(ERO.RO).init ~ HybridIROEager.init : - true ==> ={res} /\ ERO.RO.m{1} = HybridIROEager.mp{2}]. -proof. proc; inline*; auto. qed. - local lemma HIRO_RO_HybridIROEager_g : equiv[HIRO(ERO.RO).g ~ HybridIROEager.g : ={xs, n} /\ ERO.RO.m{1} = HybridIROEager.mp{2} ==> @@ -347,9 +369,9 @@ local lemma HIRO_RO_HybridIROEager_f : equiv[HIRO(ERO.RO).f ~ HybridIROEager.f : ={xs, n} /\ ERO.RO.m{1} = HybridIROEager.mp{2} ==> ={res} /\ ERO.RO.m{1} = HybridIROEager.mp{2}]. -proof. -proc; wp; call HIRO_RO_HybridIROEager_g; auto. -qed. +proof. proc; wp; call HIRO_RO_HybridIROEager_g; auto. qed. + +(* make distinguisher for random oracles out of HIRO and D *) local module RODist(RO : ERO.RO) = { proc distinguish() : bool = { @@ -359,7 +381,7 @@ local module RODist(RO : ERO.RO) = { } }. -local lemma Exper_HybridLazy_ERO_LRO &m : +local lemma Exper_HybridIROLazy_LRO &m : Pr[HybridIROExper(HybridIROLazy, D).main() @ &m : res] = Pr[EROExper(ERO.LRO, RODist).main() @ &m : res]. proof. @@ -372,7 +394,7 @@ conseq HybridIROLazy_HIRO_LRO_f. auto. qed. -local lemma ERO_RO_Exper_HybridEager &m : +local lemma Exper_RO_HybridIROEager &m : Pr[EROExper(ERO.RO, RODist).main() @ &m : res] = Pr[HybridIROExper(HybridIROEager, D).main() @ &m : res]. proof. @@ -385,17 +407,26 @@ conseq HIRO_RO_HybridIROEager_f. auto. qed. -lemma HybridIROExper_Lazy_Eager &m : +lemma HybridIROExper_Lazy_Eager' &m : Pr[HybridIROExper(HybridIROLazy, D).main() @ &m : res] = Pr[HybridIROExper(HybridIROEager, D).main() @ &m : res]. proof. -by rewrite (Exper_HybridLazy_ERO_LRO &m) +by rewrite (Exper_HybridIROLazy_LRO &m) (LRO_RO RODist &m) - (ERO_RO_Exper_HybridEager &m). + (Exper_RO_HybridIROEager &m). qed. end section. +lemma HybridIROExper_Lazy_Eager + (D <: HYBRID_IRO_DIST{HybridIROEager, HybridIROLazy}) &m : + Pr[HybridIROExper(HybridIROLazy, D).main() @ &m : res] = + Pr[HybridIROExper(HybridIROEager, D).main() @ &m : res]. +proof. by apply (HybridIROExper_Lazy_Eager' D &m). qed. + +(* turn a Hybrid IRO implementation (lazy or eager) into + top-level ideal functionality *) + module RaiseHybridIRO (HI : HYBRID_IRO) : FUNCTIONALITY = { proc init() = { HI.init(); @@ -403,12 +434,13 @@ module RaiseHybridIRO (HI : HYBRID_IRO) : FUNCTIONALITY = { proc f(bs : bool list, n : int) = { var cs; - cs <@ HI.g(pad2blocks bs, n); return cs; } }. +(* invariant relating maps of BIRO.IRO and HybridIROLazy *) + pred lazy_invar (mp1 : (bool list * int, bool) fmap, mp2 : (block list * int, bool) fmap) = @@ -466,10 +498,10 @@ lemma lazy_invar_upd_mem_dom_iff mem (dom mp1.[(bs, n) <- b]) (cs, m) <=> mem (dom mp2.[(pad2blocks bs, n) <- b]) (pad2blocks cs, m). proof. -move=> LI; split=> [mem_upd_mp1 | mem_upd_mp2]. +move=> li; split=> [mem_upd_mp1 | mem_upd_mp2]. rewrite domP in_fsetU1; rewrite domP in_fsetU1 in mem_upd_mp1. case: ((cs, m) = (bs, n))=> [cs_m_eq_bs_n | cs_m_neq_bs_n]. -right; by elim cs_m_eq_bs_n=> ->->. +right; by elim cs_m_eq_bs_n=> -> ->. left; smt(). rewrite domP in_fsetU1; rewrite domP in_fsetU1 in mem_upd_mp2. case: ((cs, m) = (bs, n))=> [// | cs_m_neq_bs_n]. @@ -485,10 +517,10 @@ lemma lazy_invar_upd2_vb mem (dom mp2.[(pad2blocks bs, n) <- b]) (xs, m) => valid_block xs. proof. -move=> LI mem_upd_mp2. +move=> li mem_upd_mp2. rewrite domP in_fsetU1 in mem_upd_mp2. elim mem_upd_mp2=> [/# | [-> _]]. -apply/valid_pad2blocks. +apply valid_pad2blocks. qed. lemma lazy_invar_upd_lu_eq @@ -500,16 +532,14 @@ lemma lazy_invar_upd_lu_eq oget mp1.[(bs, n) <- b].[(cs, m)] = oget mp2.[(pad2blocks bs, n) <- b].[(pad2blocks cs, m)]. proof. -move=> LI mem_upd_mp1. -case: ((cs, m) = (bs, n))=> [[->->] | cs_m_neq_bs_n]. +move=> li mem_upd_mp1. +case: ((cs, m) = (bs, n))=> [[-> ->] | cs_m_neq_bs_n]. smt(getP_eq). rewrite domP in_fsetU1 in mem_upd_mp1. -elim mem_upd_mp1=> [mem_mp1 | [->->]]. +elim mem_upd_mp1=> [mem_mp1 | [-> ->]]. case: ((pad2blocks bs, n) = (pad2blocks cs, m))=> [[p2b_bs_p2b_cs eq_mn] | p2b_bs_n_neq_p2b_cs_m]. -smt(pad2blocks_inj). -smt(getP). -smt(getP). +smt(pad2blocks_inj). smt(getP). smt(getP). qed. lemma LowerFun_IRO_HybridIROLazy_f : @@ -528,9 +558,9 @@ seq 6 3 : (={i, n0} /\ bs{1} = bs0{2} /\ lazy_invar IRO.mp{1} HybridIROLazy.mp{2} /\ pad2blocks x{1} = xs0{2}). -auto; progress; +auto; progress. have {2}<- := unpadBlocksK xs0{2}; first - by rewrite (some_oget (unpad_blocks xs0{2})). + by rewrite (some_oget (unpad_blocks xs0{2})). wp. while (={i, n0} /\ bs{1} = bs0{2} /\ @@ -592,6 +622,8 @@ auto; progress [-delta]; auto. qed. +(* invariant relating maps of HybridIROEager and BlockSponge.BIRO.IRO *) + pred eager_invar (mp1 : (block list * int, block) fmap, mp2 : (block list * int, bool) fmap) = @@ -646,7 +678,7 @@ lemma eager_inv_imp_block_bits_dom block_bits_dom_all_in_or_out xs i mp2. proof. move=> ge0_i r_dvd_i [ei1 ei2]. -case (mem (dom mp1) (xs, i %/ r))=> [mem_mp1 | not_mem_mp1]. +case: (mem (dom mp1) (xs, i %/ r))=> [mem_mp1 | not_mem_mp1]. have ei1_xs_i_div_r := ei1 xs (i %/ r). have [_ mp2_eq_block_bits] := ei1_xs_i_div_r mem_mp1. left=> j j_rng. @@ -654,7 +686,7 @@ have mp2_eq_block_bits_j := mp2_eq_block_bits j _. by rewrite divzK // mulzDl /= divzK. rewrite in_dom /#. right=> j j_rng. -case (mem (dom mp2) (xs, j))=> // mem_mp2 /=. +case: (mem (dom mp2) (xs, j))=> // mem_mp2 /=. have mem_mp1 := ei2 xs j mem_mp2. have [k] [k_ran j_eq_i_plus_k] : exists k, 0 <= k < r /\ j = i + k by exists (j - i); smt(). @@ -728,7 +760,8 @@ sp; wp; if=> //; rnd; auto. auto. qed. -(* modules needed for applying transitivity tactic *) +(* module needed for applying transitivity tactic in connection + with HybridIROEager *) module HybridIROEagerTrans = { (* from HybridIROEager; need copy for transitivity @@ -754,6 +787,8 @@ module HybridIROEagerTrans = { return bs; } + (* getting next block of bits; assuming m = i + r and size bs = i *) + proc next_block(xs, i, m : int, bs) = { var b; @@ -765,12 +800,12 @@ module HybridIROEagerTrans = { return (bs, i); } + (* version of next_block split into cases; assuming m = i + r, + size bs = i and block_bits_dom_all_in_or_out xs i HybridIROEager.mp *) + proc next_block_split(xs, i, m : int, bs) = { var b, j, cs; - (* assuming block_bits_dom_all_in_or_out xs i HybridIROEager.mp - and m = i + r and size bs = i *) - if (mem (dom HybridIROEager.mp) (xs, i)) { while (i < m) { b <- oget HybridIROEager.mp.[(xs, i)]; @@ -793,6 +828,8 @@ module HybridIROEagerTrans = { return (bs, i); } + (* loop getting n * r bits of hash *) + proc loop(n : int, xs : block list) : int * bool list = { var b : bool; var i <- 0; var bs <- []; while (i < n * r) { @@ -804,6 +841,9 @@ module HybridIROEagerTrans = { } }. +(* predicate saying two (block list * int, bool) maps are the same + except (perhaps) on a range of bits for a single block list *) + pred eager_eq_except (xs : block list, i j : int, mp1 mp2 : (block list * int, bool) fmap) = @@ -868,8 +908,8 @@ lemma eager_invar_eq_except_upd1 proof. move=> ge0_i [ei1 ei2] ee mp2'_ran_eq. split=> [ys k mem_mp1_upd_xs_i_y_ys_k | ys k mem_dom_mp2'_ys_k]. -case (xs = ys)=> [eq_xs_ys | ne_xs_ys]. -case (k = i)=> [eq_k_i | ne_k_i]. +case: (xs = ys)=> [eq_xs_ys | ne_xs_ys]. +case: (k = i)=> [eq_k_i | ne_k_i]. split; first smt(). move=> j j_ran. by rewrite -eq_xs_ys eq_k_i getP_eq mp2'_ran_eq -eq_k_i. @@ -906,10 +946,10 @@ have <- /# : Some (nth false (ofblock (oget mp1.[(ys, k)])) (j - k * r)) by rewrite ei1_ys_k_snd. rewrite domP in_fsetU1. -case (xs = ys)=> [-> | ne_xs_ys]. -case (k < i * r)=> [lt_k_i_tim_r | not_lt_k_i_tim_r]. +case: (xs = ys)=> [-> | ne_xs_ys]. +case: (k < i * r)=> [lt_k_i_tim_r | not_lt_k_i_tim_r]. smt(eager_eq_except_mem_iff). -case ((i + 1) * r <= k)=> [i_add1_tim_r_le_k | not_i_add1_tim_r_le_k]. +case: ((i + 1) * r <= k)=> [i_add1_tim_r_le_k | not_i_add1_tim_r_le_k]. smt(eager_eq_except_mem_iff). right. have le_i_tim_r_k : i * r <= k by smt(). @@ -989,7 +1029,7 @@ rewrite -cats1; smt(size_cat). rewrite -2!cats1 catA; congr; congr. by rewrite getP_eq oget_some. rewrite nth_rcons /=. -case (k = size (bs{2} ++ cs{2}))=> [-> /= | ne_k_size_bs_cat_cs]. +case: (k = size (bs{2} ++ cs{2}))=> [-> /= | ne_k_size_bs_cat_cs]. by rewrite getP_eq oget_some. have -> /= : k < size(bs{2} ++ cs{2}) by smt(). rewrite getP ne_k_size_bs_cat_cs /= /#. @@ -1026,6 +1066,9 @@ skip; progress; [smt(gt0_r) | smt() | smt() | smt() | smt(eager_eq_except_maps_eq)]. qed. +(* module needed for applying transitivity tactic in connection + with BlockSponge.BIRO.IRO *) + module BlockSpongeTrans = { (* from BlockSponge.BIRO.IRO; need copy for transitivity to work *) @@ -1046,6 +1089,8 @@ module BlockSpongeTrans = { return bs; } + (* getting next block; assumes size bs = i *) + proc next_block(x, i, bs) = { var b; @@ -1055,6 +1100,8 @@ module BlockSpongeTrans = { return (bs, i); } + (* loop getting n blocks *) + proc loop(n : int, xs : block list) : int * block list = { var b : block; var i <- 0; var bs <- []; while (i < n) { @@ -1066,25 +1113,6 @@ module BlockSpongeTrans = { } }. -module BlockGen = { - proc loop() : block = { - var b : bool; var j : int; var cs : bool list; - j <- 0; cs <- []; - while (j < r) { - b <$ {0,1}; - cs <- rcons cs b; - j <- j + 1; - } - return mkblock cs; - } - - proc direct() : block = { - var w : block; - w <$ bdistr; - return w; - } -}. - (* use Program abstract theory of DList *) clone Program as Prog with @@ -1115,12 +1143,33 @@ have -> /# // : forall (n : int), 0 <= n => 0 < n => iter n (( * ) (1%r / 2%r)) 1%r = inv (2 ^ n)%r. elim=> [// | i ge0_i IH _]. -case (i = 0)=> [-> /= | ne_i0]. +case: (i = 0)=> [-> /= | ne_i0]. rewrite iter1 pow1 /#. by rewrite iterS // IH 1:/# powS // RealExtra.fromintM StdRing.RField.invfM. qed. +(* module for adapting PrLoopSnoc_sample to block generation *) + +module BlockGen = { + proc loop() : block = { + var b : bool; var j : int; var cs : bool list; + j <- 0; cs <- []; + while (j < r) { + b <$ {0,1}; + cs <- rcons cs b; + j <- j + 1; + } + return mkblock cs; + } + + proc direct() : block = { + var w : block; + w <$ bdistr; + return w; + } +}. + lemma BlockGen_loop_direct : equiv[BlockGen.loop ~ BlockGen.direct : true ==> ={res}]. proof. @@ -1134,8 +1183,7 @@ have -> : Pr[BlockGen.direct() @ &2 : w = res] = 1%r / (2 ^ r)%r. have -> : Pr[BlockGen.loop() @ &1 : w = res] = Pr[Prog.LoopSnoc.sample(r) @ &1 : ofblock w = res]. - byequiv=> //. - proc. + byequiv=> //; proc. seq 2 2 : (r = n{2} /\ j{1} = i{2} /\ j{1} = 0 /\ cs{1} = l{2} /\ cs{1} = []); @@ -1201,10 +1249,11 @@ case (mem (dom BlockSponge.BIRO.IRO.mp{2}) (x0{2}, n{2})). (* mem (dom BlockSponge.BIRO.IRO.mp{2}) (x0{2}, n{2}) *) rcondf{2} 1; first auto. rcondt{1} 1; first auto; progress [-delta]. -have bb_all_in : block_bits_all_in_dom x{m} (size bs{m} * r) HybridIROEager.mp{hr} +have bb_all_in : + block_bits_all_in_dom x{m} (size bs{m} * r) HybridIROEager.mp{hr} by apply (eager_inv_mem_dom1 BlockSponge.BIRO.IRO.mp{m}). -smt(gt0_r). simplify. -exists* i{1}; elim*=> i1. exists* bs{1}; elim*=> bs1. +smt(gt0_r). +simplify; exists* i{1}; elim*=> i1; exists* bs{1}; elim*=> bs1. conseq (_ : i1 = i{1} /\ 0 <= i2 /\ i1 = i2 * r /\ m{1} - i1 = r /\ @@ -1247,8 +1296,7 @@ have some_form_mp_hr_lookup_eq : by rewrite ei1_xs_i2 1:/#. by rewrite some_form_mp_hr_lookup_eq oget_some. smt(). -skip. -move=> +skip=> &1 &2 [# -> ge0_i2 i1_eq_i2_tim_r m_min_i1_eq_r ->> sz_bs2_eq_i2 sz_b2b_bs2_eq_i1 ->> mem_dom_mp2_xs_i2 ei]. @@ -1277,7 +1325,8 @@ rcondf{1} 1; first auto; progress [-delta]. have bb_all_not_in : block_bits_all_out_dom x{m} (size bs{m} * r) HybridIROEager.mp{hr} by apply (eager_inv_not_mem_dom1 BlockSponge.BIRO.IRO.mp{m}). -smt(gt0_r). simplify. +smt(gt0_r). +simplify. conseq (_ : x0{2} = x{2} /\ n{2} = i{2} /\ i2 = i{2} /\ 0 <= i{2} /\ xs{1} = x{2} /\ @@ -1291,8 +1340,8 @@ seq 3 1 : i{1} = i2 * r /\ m{1} - i{1} = r /\ size bs{2} = i2 /\ size cs{1} = r /\ mkblock cs{1} = w{2} /\ bs{1} = blocks2bits bs{2} /\ eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). -conseq (_ : true ==> cs{1} = ofblock w{2}). -progress; [by rewrite size_block | by rewrite mkblockK]. +conseq (_ : true ==> cs{1} = ofblock w{2}); first + progress; [by rewrite size_block | by rewrite mkblockK]. transitivity{2} { w <@ BlockGen.loop(); } (true ==> cs{1} = ofblock w{2}) @@ -1311,8 +1360,7 @@ transitivity{2} call BlockGen_loop_direct; auto. inline BlockGen.direct; sim. wp; simplify; sp; elim*=> bs_l. -exists* HybridIROEager.mp{1}; elim*=> mp1. -exists* i{1}; elim*=> i1. +exists* HybridIROEager.mp{1}; elim*=> mp1; exists* i{1}; elim*=> i1. conseq (_ : xs{1} = x0{2} /\ 0 <= i2 /\ i{1} = i1 /\ i1 = i2 * r /\ @@ -1323,13 +1371,13 @@ conseq bs{1} = blocks2bits bs{2} ++ ofblock w{2} /\ i{1} = (i2 + 1) * r /\ eager_invar BlockSponge.BIRO.IRO.mp{2}.[(x0{2}, i2) <- w{2}] - HybridIROEager.mp{1})=> //. + HybridIROEager.mp{1}). progress; [by rewrite ofblockK | rewrite size_cat size_blocks2bits /#]. -progress. -by rewrite -cats1 blocks2bits_cat blocks2bits_sing getP_eq - oget_some ofblockK. -by rewrite size_rcons. +progress; + [by rewrite -cats1 blocks2bits_cat blocks2bits_sing getP_eq + oget_some ofblockK | + by rewrite size_rcons]. while{1} (0 <= i1 /\ m{1} - i1 = r /\ size bs{1} = i1 + r /\ i1 <= i{1} <= m{1} /\ @@ -1339,13 +1387,14 @@ while{1} HybridIROEager.mp{1}.[(xs{1}, j)] = Some(nth false bs{1} j))) (m{1} - i{1}). progress; auto. -move=> |> &hr ge0_i1 m_min_i1_eq_r sz_bs_eq_i1_plus_r il_le_i _ ee. -move=> mp_ran_eq lt_im. +move=> + |> &hr ge0_i1 m_min_i1_eq_r sz_bs_eq_i1_plus_r il_le_i _ ee + mp_ran_eq lt_im. split. split; first smt(). split; first smt(eager_eq_except_upd2_eq_in). move=> j i1_le_j j_lt_i_add1. -case (i{hr} = j)=> [-> | ne_ij]. +case: (i{hr} = j)=> [-> | ne_ij]. rewrite getP /=; smt(nth_onth onth_nth). rewrite getP. have -> /= : (xs{hr}, j) <> (xs{hr}, i{hr}) by smt(). @@ -1361,9 +1410,7 @@ split. split=> //. split; first smt(ge0_r). split; first smt(). -split. split; smt(ge0_r). -split; smt(). move=> mp_L i_L. split; first smt(). move=> not_i_L_lt_m [# _ _ _ i1_le_i_L i_L_le_m ee mp_L_ran_eq]. @@ -1394,8 +1441,7 @@ proc=> /=; exfalso. proc=> /=. move: ge0_n'; elim n'=> [| n' ge0_n' IH]. sp. rcondf{1} 1; auto. rcondf{2} 1; auto. -splitwhile{1} 3 : (i < (n - 1) * r). -splitwhile{2} 3 : (i < n - 1). +splitwhile{1} 3 : (i < (n - 1) * r); splitwhile{2} 3 : (i < n - 1). seq 3 3 : (={xs, n} /\ n{1} = n' + 1 /\ i{1} = n' * r /\ i{2} = n' /\ size bs{2} = n' /\ bs{1} = blocks2bits bs{2} /\ @@ -1449,11 +1495,8 @@ while wp. call (_ : ={BlockSponge.BIRO.IRO.mp}). if=> //; rnd; auto. auto; smt(). auto; smt(). -unroll{2} 1. -rcondt{2} 1; first auto; progress; smt(). -rcondf{2} 4. auto. -call (_ : true). if=> //. -skip; smt(). +unroll{2} 1. rcondt{2} 1; first auto; progress; smt(). +rcondf{2} 4. auto. call (_ : true). if=> //. auto. transitivity{1} { (bs, i) <@ HybridIROEagerTrans.next_block(xs, i, (n' + 1) * r, bs); } (={xs, i, bs, HybridIROEager.mp} /\ n{1} = n' + 1 ==> @@ -1465,14 +1508,14 @@ transitivity{1} bs{1} = blocks2bits bs{2} /\ eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1})=> //. progress; - exists HybridIROEager.mp{1}, (size bs{2} * r), (blocks2bits bs{2}), xs{2}=> //. + exists HybridIROEager.mp{1}, (size bs{2} * r), + (blocks2bits bs{2}), xs{2}=> //. inline HybridIROEagerTrans.next_block; sp; wp. while (xs{1} = xs0{2} /\ i{1} = i0{2} /\ n{1} = n' + 1 /\ m{2} = (n' + 1) * r /\ bs{1} = bs0{2} /\ ={HybridIROEager.mp}). -wp. call (_ : ={HybridIROEager.mp}). -if=> //; rnd; auto. +wp. call (_ : ={HybridIROEager.mp}). if=> //; rnd; auto. auto. auto. transitivity{2} { (bs, i) <@ BlockSpongeTrans.next_block(xs, i, bs); } @@ -1488,8 +1531,7 @@ progress; exists BlockSponge.BIRO.IRO.mp{2}, (size bs{2}), bs{2}, xs{2}=> //. call (HybridIROEagerTrans_BlockSpongeTrans_next_block n'). skip; progress; smt(). inline BlockSpongeTrans.next_block. -wp; sp. -call (_ : ={BlockSponge.BIRO.IRO.mp}). if=> //; rnd; skip; smt(). +wp; sp. call (_ : ={BlockSponge.BIRO.IRO.mp}). if=> //; rnd; skip; smt(). auto. qed. @@ -1542,7 +1584,7 @@ seq 3 2 : eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). auto; progress. if=> //. -case: (n1 < 0). +case (n1 < 0). rcondf{1} 1; first auto; progress; smt(). rcondf{2} 1; first auto; progress; by rewrite -lezNgt needed_blocks_non_pos ltzW. @@ -1563,8 +1605,7 @@ conseq progress; [smt() | apply/needed_blocks_suff]. move=> |> &1 &2 ? ? ? mp1 mp2 bs ? ? ?; smt(size_eq0 needed_blocks0 take0). -splitwhile{1} 1 : i < (n1 %/ r) * r. -splitwhile{2} 1 : i < n1 %/ r. +splitwhile{1} 1 : i < (n1 %/ r) * r; splitwhile{2} 1 : i < n1 %/ r. seq 1 1 : (xs{1} = x{2} /\ n1 = n{1} /\ 0 <= n1 /\ n{2} = (n1 + r - 1) %/ r /\ n{2} * r = m{1} /\ n{1} <= m{1} /\ i{1} = n1 %/ r * r /\ @@ -1678,7 +1719,7 @@ conseq bs{1} = take n1 (blocks2bits bs{2}) /\ size bs{2} = n{2} /\ eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}) => //. progress; by apply/needed_blocks_rel_div_r. -case: (i{2} = n{2}). +case (i{2} = n{2}). rcondf{2} 1; first auto; progress; smt(). rcondf{1} 1; first auto; progress; smt(). rcondf{1} 1; first auto; progress; smt(). @@ -1722,8 +1763,7 @@ transitivity{1} eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). progress; exists HybridIROEager.mp{1}, (blocks2bits bs{2}), m{1}, - (size bs{2} * r), x{2}; - smt(). + (size bs{2} * r), x{2}=> //. progress; smt(take_cat). splitwhile{2} 1 : i < n1. seq 1 1 : @@ -1758,11 +1798,10 @@ transitivity{1} size bs{2} = i{2} /\ bs{1} = blocks2bits bs{2} /\ eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> bs{1} = blocks2bits bs{2} /\ - eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1})=> //. progress [-delta]; -exists HybridIROEager.mp{1}, (blocks2bits bs{2}), m{1}, - (size bs{2} * r), x{2}=> //. -trivial. + exists HybridIROEager.mp{1}, (blocks2bits bs{2}), m{1}, + (size bs{2} * r), x{2}=> //. inline HybridIROEagerTrans.next_block; sim. transitivity{2} { (bs, i) <@ BlockSpongeTrans.next_block(x, i, bs); @@ -1773,10 +1812,9 @@ transitivity{2} bs{1} = blocks2bits bs{2} /\ eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}) (={bs, i, x, BlockSponge.BIRO.IRO.mp} ==> - ={bs, i, x, BlockSponge.BIRO.IRO.mp}). + ={bs, i, x, BlockSponge.BIRO.IRO.mp})=> //. progress [-delta]; -exists BlockSponge.BIRO.IRO.mp{2}, bs{2}, (size bs{2}), x{2}=> //. -trivial. + exists BlockSponge.BIRO.IRO.mp{2}, bs{2}, (size bs{2}), x{2}=> //. exists* i{2}; elim*=> i2. call (HybridIROEagerTrans_BlockSpongeTrans_next_block i2). auto. @@ -1804,21 +1842,20 @@ move=> |>; by rewrite n_eq. progress; apply blocks2bitsK. conseq HybridIROEager_f_g. move=> |> &1 &2 ? -> ? //. -exists* n{1}; elim*=> n1. exists* xs{1}; elim*=> xs'. +exists* n{1}; elim*=> n1; exists* xs{1}; elim*=> xs'. conseq (HybridIROEager_g_BlockIRO_f n1 xs')=> //. move=> |> &1 &2 ? -> inv; by rewrite needed_blocks_prod_r. move=> |> &1 &2 ? n1_eq ? res1 res2 ? ? ? vb_imp not_vb_imp. -case (valid_block xs{1})=> [vb_xs1 | not_vb_xs1]. +case: (valid_block xs{1})=> [vb_xs1 | not_vb_xs1]. have [le0_n1_imp gt0_n1_imp] := vb_imp vb_xs1. -case: (n{1} <= 0)=> [le0_n1 | not_le0_n1]. -smt(). +case: (n{1} <= 0)=> [le0_n1 /# | not_le0_n1]. have gt0_n1 : 0 < n{1} by smt(). have [-> sz_res2] := gt0_n1_imp gt0_n1. have -> : n{1} = size(blocks2bits res2) by rewrite size_blocks2bits sz_res2 n1_eq needed_blocks_prod_r mulzC. by rewrite take_size. -by have [->->] := not_vb_imp not_vb_xs1. +by have [-> ->] := not_vb_imp not_vb_xs1. qed. end HybridIRO. @@ -1841,8 +1878,7 @@ seq 4 4 : (={n, glob Perm, sa, sc, i} /\ xs{1} = xs0{2} /\ z{1} = [] /\ z{2} = [] /\ valid_block xs0{2}). auto; progress; apply valid_pad2blocks. -rcondt{2} 2; auto. -swap{2} 1 1. +rcondt{2} 2; auto. swap{2} 1 1. seq 1 1 : (={n, glob Perm, sa, sc, i} /\ xs{1} = xs0{2} /\ z{1} = [] /\ z{2} = []). while (={glob Perm, sa, sc, i} /\ xs{1} = xs0{2} /\ z{1} = [] /\ z{2} = []). @@ -1881,11 +1917,10 @@ proc=> /=. exists* n{1}; elim*=> n'. exists* (pad2blocks bs{2}); elim*=> xs2. call (HIRO.HybridIROEager_g_BlockIRO_f n' xs2). -auto=> |> &1 &2 ? res1 res2 mp1 mp2 ? vb_imp not_vb_imp. +skip=> |> &1 &2 ? res1 res2 mp1 mp2 ? vb_imp not_vb_imp. case: (valid_block (pad2blocks bs{2}))=> [vb | not_vb]. have [le0_n2_imp gt0_n2_imp] := vb_imp vb. -case: (n{2} <= 0)=> [le0_n2 | not_le0_n2]. -smt(). +case: (n{2} <= 0)=> [le0_n2 /# | not_le0_n2]. have gt0_n2 : 0 < n{2} by smt(). by have [-> _] := gt0_n2_imp gt0_n2. have [-> ->] := not_vb_imp not_vb; by rewrite blocks2bits_nil. @@ -1907,9 +1942,10 @@ call ={glob Dist, glob BlockSim} /\ IRO.mp{1} = map0 /\ HIRO.HybridIROLazy.mp{2} = map0 ==> ={res}). -proc (={glob BlockSim} /\ HIRO.lazy_invar IRO.mp{1} HIRO.HybridIROLazy.mp{2}). +proc + (={glob BlockSim} /\ + HIRO.lazy_invar IRO.mp{1} HIRO.HybridIROLazy.mp{2})=> //. progress [-delta]; apply HIRO.lazy_invar0. -trivial. proc (HIRO.lazy_invar IRO.mp{1} HIRO.HybridIROLazy.mp{2})=> //. apply HIRO.LowerFun_IRO_HybridIROLazy_f. proc (HIRO.lazy_invar IRO.mp{1} HIRO.HybridIROLazy.mp{2})=> //. @@ -1918,6 +1954,10 @@ by conseq HIRO.IRO_RaiseHybridIRO_HybridIROLazy_f. auto. qed. +(* make a Hybrid IRO distinguisher from BlockSim and Dist (HI.f is + used by BlockSim, and HI.g is used by HIRO.RaiseHybridIRO; + HI.init is unused -- see the SIMULATOR module type) *) + local module (HybridIRODist : HIRO.HYBRID_IRO_DIST) (HI : HIRO.HYBRID_IRO) = { proc distinguish() : bool = { var b : bool; @@ -1940,7 +1980,8 @@ sim. qed. local lemma HybridIROExper_Experiment_Eager &m : - Pr[HIRO.HybridIROExper(HIRO.HybridIROEager, HybridIRODist).main() @ &m : res] = + Pr[HIRO.HybridIROExper(HIRO.HybridIROEager, HybridIRODist).main() @ + &m : res] = Pr[Experiment (HIRO.RaiseHybridIRO(HIRO.HybridIROEager), BlockSim(HIRO.HybridIROEager), Dist).main() @ &m : res]. @@ -1982,12 +2023,14 @@ call HIRO.HybridIROEager.mp{1} = map0 /\ BlockSponge.BIRO.IRO.mp{2} = map0 ==> ={res}). proc - (={glob BlockSim} /\ - HIRO.eager_invar BlockSponge.BIRO.IRO.mp{2} HIRO.HybridIROEager.mp{1}) => //. + (={glob BlockSim} /\ + HIRO.eager_invar BlockSponge.BIRO.IRO.mp{2} HIRO.HybridIROEager.mp{1})=> //. progress [-delta]; apply HIRO.eager_invar0. -proc (HIRO.eager_invar BlockSponge.BIRO.IRO.mp{2} HIRO.HybridIROEager.mp{1})=> //; +proc (HIRO.eager_invar BlockSponge.BIRO.IRO.mp{2} + HIRO.HybridIROEager.mp{1})=> //; conseq HIRO.HybridIROEager_BlockIRO_f=> //. -proc (HIRO.eager_invar BlockSponge.BIRO.IRO.mp{2} HIRO.HybridIROEager.mp{1})=> //; +proc (HIRO.eager_invar BlockSponge.BIRO.IRO.mp{2} + HIRO.HybridIROEager.mp{1})=> //; conseq HIRO.HybridIROEager_BlockIRO_f=> //. exists* n{1}; elim *=> n'. conseq RaiseHybridIRO_HybridIROEager_RaiseFun_BlockIRO_f=> //. @@ -2029,4 +2072,4 @@ lemma conclusion (BlockSponge.Sponge, Perm, LowerDist(Dist)).main() @ &m : res] - Pr[BlockSponge.IdealIndif (BlockSponge.BIRO.IRO, BlockSim, LowerDist(Dist)).main() @ &m : res]|. -proof. by apply/(conclu BlockSim Dist &m). qed. +proof. by apply (conclu BlockSim Dist &m). qed. From e601676e0f7300aa7934e3d787d5d1130abb19bb Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Wed, 10 Aug 2016 15:57:14 -0400 Subject: [PATCH 199/525] Simplifications. --- proof/Sponge.ec | 305 ++++++++++++++++++------------------------------ 1 file changed, 112 insertions(+), 193 deletions(-) diff --git a/proof/Sponge.ec b/proof/Sponge.ec index 3fa6796..295aab4 100644 --- a/proof/Sponge.ec +++ b/proof/Sponge.ec @@ -424,8 +424,8 @@ lemma HybridIROExper_Lazy_Eager Pr[HybridIROExper(HybridIROEager, D).main() @ &m : res]. proof. by apply (HybridIROExper_Lazy_Eager' D &m). qed. -(* turn a Hybrid IRO implementation (lazy or eager) into - top-level ideal functionality *) +(* turn a Hybrid IRO implementation (lazy or eager) into top-level + ideal functionality; its f procedure only uses IH.g *) module RaiseHybridIRO (HI : HYBRID_IRO) : FUNCTIONALITY = { proc init() = { @@ -764,29 +764,6 @@ qed. with HybridIROEager *) module HybridIROEagerTrans = { - (* from HybridIROEager; need copy for transitivity - to work *) - - proc g(xs, n) = { - var b, bs; - var m <- ((n + r - 1) %/ r) * r; - var i <- 0; - - bs <- []; - if (valid_block xs) { - while (i < n) { - b <@ HybridIROEager.fill_in(xs, i); - bs <- rcons bs b; - i <- i + 1; - } - while (i < m) { - HybridIROEager.fill_in(xs, i); - i <- i + 1; - } - } - return bs; - } - (* getting next block of bits; assuming m = i + r and size bs = i *) proc next_block(xs, i, m : int, bs) = { @@ -1070,25 +1047,6 @@ qed. with BlockSponge.BIRO.IRO *) module BlockSpongeTrans = { - (* from BlockSponge.BIRO.IRO; need copy for transitivity - to work *) - - proc f(x, n) = { - var b, bs; - var i <- 0; - - bs <- []; - if (valid_block x) { - while (i < n) { - b <@ BlockSponge.BIRO.IRO.fill_in(x, i); - bs <- rcons bs b; - i <- i + 1; - } - } - - return bs; - } - (* getting next block; assumes size bs = i *) proc next_block(x, i, bs) = { @@ -1264,12 +1222,10 @@ conseq bs{1} = blocks2bits (rcons bs{2} (oget BlockSponge.BIRO.IRO.mp{2}.[(xs{1}, i2)])) /\ i{1} = (i2 + 1) * r /\ size bs{2} = i2 /\ size bs{1} = (i2 + 1) * r /\ - eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). -progress; smt(size_blocks2bits). -progress; by rewrite size_rcons. + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}); + [progress; smt(size_blocks2bits) | progress; by rewrite size_rcons | idtac]. while{1} - (i1 <= i{1} <= m{1} /\ i1 = i2 * r /\ size bs{1} = i{1} /\ - m{1} - i1 = r /\ + (i1 <= i{1} <= m{1} /\ i1 = i2 * r /\ size bs{1} = i{1} /\ m{1} - i1 = r /\ bs{1} = bs1 ++ take (i{1} - i1) @@ -1281,8 +1237,7 @@ move=> &m z. auto=> |> &hr i2_tim_r_le_sz_bs sz_bs_le_m m_min_i2_tim_r_eq_r bs_eq mem_blk_mp_xs_i2 ei sz_bs_lt_m. -split. split. split=> [| _]; smt(). split. -by rewrite -cats1 size_cat. +split. split. split=> [| _]; smt(). split; first by rewrite -cats1 size_cat. rewrite -cats1 {1}bs_eq -catA; congr. have -> : size bs{hr} + 1 - i2 * r = size bs{hr} - i2 * r + 1 by algebra. rewrite (take_nth false) 1:size_block; first smt(size_ge0). @@ -1300,8 +1255,7 @@ skip=> &1 &2 [# -> ge0_i2 i1_eq_i2_tim_r m_min_i1_eq_r ->> sz_bs2_eq_i2 sz_b2b_bs2_eq_i1 ->> mem_dom_mp2_xs_i2 ei]. -split. split. -split=> [// | _]; rewrite i1_eq_i2_tim_r; smt(ge0_r). +split. split. split=> [// | _]; rewrite i1_eq_i2_tim_r; smt(ge0_r). split=> //. split; first smt(). split=> //. split; first by rewrite /= take0 cats0. split=> //. move=> bs_L i_L. @@ -1311,17 +1265,14 @@ move=> bs_L_eq mem_mp2_xs_i2 _]. split. have i_L_eq_m : i_L = m{1} by smt(). -rewrite bs_L_eq -cats1 blocks2bits_cat; congr. -rewrite i_L_eq_m m1_min_i1_eq_r blocks2bits_sing. +rewrite bs_L_eq -cats1 blocks2bits_cat + i_L_eq_m m1_min_i1_eq_r blocks2bits_sing. pose blk := (oget BlockSponge.BIRO.IRO.mp{2}.[(xs{1}, i2)]). have -> : r = size (ofblock blk) by rewrite size_block. by rewrite take_size. -split; first smt(). -split=> //. -split=> //; smt(). +split; smt(). (* ! mem (dom BlockSponge.BIRO.IRO.mp{2}) (x0{2}, n{2}) *) -rcondt{2} 1; first auto. -rcondf{1} 1; first auto; progress [-delta]. +rcondt{2} 1; first auto. rcondf{1} 1; first auto; progress [-delta]. have bb_all_not_in : block_bits_all_out_dom x{m} (size bs{m} * r) HybridIROEager.mp{hr} by apply (eager_inv_not_mem_dom1 BlockSponge.BIRO.IRO.mp{m}). @@ -1390,8 +1341,7 @@ progress; auto. move=> |> &hr ge0_i1 m_min_i1_eq_r sz_bs_eq_i1_plus_r il_le_i _ ee mp_ran_eq lt_im. -split. -split; first smt(). +split. split; first smt(). split; first smt(eager_eq_except_upd2_eq_in). move=> j i1_le_j j_lt_i_add1. case: (i{hr} = j)=> [-> | ne_ij]. @@ -1404,13 +1354,9 @@ skip=> &1 &2 [# -> ge0_i2 eq_i_i1 i1_eq_i2_tim_r m_min_i1_eq_r bs1_eq sz_bs2_eq_i2 sz_bs1_eq_i1_add_r -> ei]. -have ge0_i1 : 0 <= i1 - by rewrite i1_eq_i2_tim_r divr_ge0 // ge0_r. -split. -split=> //. -split; first smt(ge0_r). -split; first smt(). -split; smt(ge0_r). +have ge0_i1 : 0 <= i1 by rewrite i1_eq_i2_tim_r divr_ge0 // ge0_r. +split. split=> //. split; first smt(ge0_r). +split; first smt(). split; smt(ge0_r). move=> mp_L i_L. split; first smt(). move=> not_i_L_lt_m [# _ _ _ i1_le_i_L i_L_le_m ee mp_L_ran_eq]. @@ -1420,8 +1366,7 @@ apply (eager_invar_eq_except_upd1 BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} mp_L x0{2} i2 w{2})=> //. by rewrite mulzDl /= -i1_eq_i2_tim_r. move=> j j_ran. -rewrite mp_L_ran_eq 1:/#; congr. -rewrite bs1_eq nth_cat. +rewrite mp_L_ran_eq 1:/#; congr; rewrite bs1_eq nth_cat. have -> : size(blocks2bits bs{2}) = i2 * r by rewrite size_blocks2bits /#. have -> // : j < i2 * r = false by smt(). @@ -1548,34 +1493,6 @@ lemma HybridIROEager_g_BlockIRO_f (n1 : int) (x2 : block list) : size res{2} = (n1 + r - 1) %/ r)) /\ (! valid_block x2 => res{1} = [] /\ res{2} = [])]. proof. -transitivity - HybridIROEagerTrans.g - (={n, xs, HybridIROEager.mp} ==> ={res, HybridIROEager.mp}) - (n1 = n{1} /\ x2 = x{2} /\ xs{1} = x{2} /\ - n{2} = (n{1} + r - 1) %/ r /\ - eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> - eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} /\ - (valid_block x2 => - (n1 <= 0 => res{1} = [] /\ res{2} = []) /\ - (0 < n1 => - res{1} = take n1 (blocks2bits res{2}) /\ - size res{2} = (n1 + r - 1) %/ r)) /\ - (! valid_block x2 => res{1} = [] /\ res{2} = [])); - [smt() | trivial | sim | idtac]. -transitivity - BlockSpongeTrans.f - (n1 = n{1} /\ x2 = x{2} /\ xs{1} = x{2} /\ - n{2} = (n{1} + r - 1) %/ r /\ - eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> - eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} /\ - (valid_block x2 => - (n1 <= 0 => res{1} = [] /\ res{2} = []) /\ - (0 < n1 => - res{1} = take n1 (blocks2bits res{2}) /\ - size res{2} = (n1 + r - 1) %/ r)) /\ - (! valid_block x2 => res{1} = [] /\ res{2} = [])) - (={x, n, BlockSponge.BIRO.IRO.mp} ==> ={res, BlockSponge.BIRO.IRO.mp}); - last first; [sim | smt() | smt() | idtac]. proc=> /=. seq 3 2 : (n1 = n{1} /\ xs{1} = x{2} /\ x2 = x{2} /\ @@ -1605,12 +1522,15 @@ conseq progress; [smt() | apply/needed_blocks_suff]. move=> |> &1 &2 ? ? ? mp1 mp2 bs ? ? ?; smt(size_eq0 needed_blocks0 take0). -splitwhile{1} 1 : i < (n1 %/ r) * r; splitwhile{2} 1 : i < n1 %/ r. +splitwhile{1} 1 : i < (n1 %/ r) * r. splitwhile{2} 1 : i < n1 %/ r. seq 1 1 : (xs{1} = x{2} /\ n1 = n{1} /\ 0 <= n1 /\ n{2} = (n1 + r - 1) %/ r /\ n{2} * r = m{1} /\ n{1} <= m{1} /\ i{1} = n1 %/ r * r /\ i{2} = n1 %/ r /\ size bs{2} = i{2} /\ bs{1} = blocks2bits bs{2} /\ eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). +(* we have zero or more blocks to add on the right, and + r times that number of bits to add on the left; + we will work up to applying HybridIROEagerTrans_BlockSpongeTrans_loop *) conseq (_ : xs{1} = x{2} /\ n1 = n{1} /\ 0 <= n1 /\ n{2} = (n1 + r - 1) %/ r /\ @@ -1639,23 +1559,34 @@ while (={i, bs, xs, HybridIROEager.mp} /\ n1 = n{1} /\ 0 <= n1). wp. call (_ : ={HybridIROEager.mp}). if=> //; auto. auto; progress; smt(leq_trunc_div ge0_r). auto; progress; smt(leq_trunc_div ge0_r). -transitivity{2} - { while (i < n1 %/ r) { - b <@ BlockSponge.BIRO.IRO.fill_in(x, i); - bs <- rcons bs b; - i <- i + 1; - } - } - (xs{1} = x{2} /\ n1 = n{1} /\ 0 <= n1 /\ n{2} = (n1 + r - 1) %/ r /\ - i{1} = 0 /\ i{2} = 0 /\ bs{1} = [] /\ bs{2} = [] /\ - eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> - i{1} = n1 %/ r * r /\ i{2} = n1 %/ r /\ size bs{2} = i{2} /\ - bs{1} = blocks2bits bs{2} /\ - eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}) - (={i, x, bs, BlockSponge.BIRO.IRO.mp} /\ n{2} = (n1 + r - 1) %/ r ==> - ={i, x, bs, BlockSponge.BIRO.IRO.mp})=> //. -progress; - exists BlockSponge.BIRO.IRO.mp{2}, [], 0, x{2}, ((n{1} + r - 1) %/ r)=> //. +(transitivity{2} + { while (i < n1 %/ r) { + b <@ BlockSponge.BIRO.IRO.fill_in(x, i); + bs <- rcons bs b; + i <- i + 1; + } + } + (xs{1} = x{2} /\ n1 = n{1} /\ 0 <= n1 /\ n{2} = (n1 + r - 1) %/ r /\ + i{1} = 0 /\ i{2} = 0 /\ bs{1} = [] /\ bs{2} = [] /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + i{1} = n1 %/ r * r /\ i{2} = n1 %/ r /\ size bs{2} = i{2} /\ + bs{1} = blocks2bits bs{2} /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}) + (={i, x, bs, BlockSponge.BIRO.IRO.mp} /\ n{2} = (n1 + r - 1) %/ r ==> + ={i, x, bs, BlockSponge.BIRO.IRO.mp})=> //; + first progress; + exists BlockSponge.BIRO.IRO.mp{2}, [], 0, x{2}, + ((n{1} + r - 1) %/ r)=> //); + first last. +while + (={i, x, bs, BlockSponge.BIRO.IRO.mp} /\ n{2} = (n1 + r - 1) %/ r). +wp. call (_ : ={BlockSponge.BIRO.IRO.mp}). if=> //; auto. +auto; progress; + have /# : n1 %/ r <= (n1 + r - 1) %/ r + by rewrite leq_div2r; smt(gt0_r). +auto; progress; + have /# : n1 %/ r <= (n1 + r - 1) %/ r + by rewrite leq_div2r; smt(gt0_r). conseq (_ : xs{1} = x{2} /\ 0 <= n1 /\ @@ -1672,43 +1603,35 @@ transitivity{1} eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> i{1} = n1 %/ r * r /\ i{2} = n1 %/ r /\ size bs{2} = n1 %/ r /\ bs{1} = blocks2bits bs{2} /\ - eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1})=> //. progress; exists HybridIROEager.mp{1}, (n1 %/ r), x{2}=> //. -trivial. inline HybridIROEagerTrans.loop; sp; wp. while (={HybridIROEager.mp} /\ i{1} = i0{2} /\ bs{1} = bs0{2} /\ xs{1} = xs0{2} /\ n0{2} = n1 %/ r). wp. call (_ : ={HybridIROEager.mp}). if=> //; rnd; auto. auto. auto. -transitivity{2} - { (i, bs) <@ BlockSpongeTrans.loop(n1 %/ r, x); } - (xs{1} = x{2} /\ 0 <= n1 /\ - eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> - i{1} = n1 %/ r * r /\ i{2} = n1 %/ r /\ - size bs{2} = n1 %/ r /\ bs{1} = blocks2bits bs{2} /\ - eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}) - (={x, BlockSponge.BIRO.IRO.mp} /\ i{2} = 0 /\ bs{2} = [] ==> - ={i, x, bs, BlockSponge.BIRO.IRO.mp})=> //. -progress; exists BlockSponge.BIRO.IRO.mp{2}, x{2}=> //. -call (HybridIROEagerTrans_BlockSpongeTrans_loop (n1 %/ r)). -skip; progress; smt(divz_ge0 gt0_r). +(transitivity{2} + { (i, bs) <@ BlockSpongeTrans.loop(n1 %/ r, x); } + (xs{1} = x{2} /\ 0 <= n1 /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + i{1} = n1 %/ r * r /\ i{2} = n1 %/ r /\ + size bs{2} = n1 %/ r /\ bs{1} = blocks2bits bs{2} /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}) + (={x, BlockSponge.BIRO.IRO.mp} /\ i{2} = 0 /\ bs{2} = [] ==> + ={i, x, bs, BlockSponge.BIRO.IRO.mp})=> //; + first progress; exists BlockSponge.BIRO.IRO.mp{2}, x{2}=> //); + last first. inline BlockSpongeTrans.loop; sp; wp. while (={BlockSponge.BIRO.IRO.mp} /\ i0{1} = i{2} /\ n0{1} = n1 %/ r /\ xs{1} = x{2} /\ bs0{1} = bs{2}). wp. call (_ : ={BlockSponge.BIRO.IRO.mp}). if=> //; rnd; auto. auto. auto. -while - (={i, x, bs, BlockSponge.BIRO.IRO.mp} /\ n{2} = (n1 + r - 1) %/ r). -wp. call (_ : ={BlockSponge.BIRO.IRO.mp}). if=> //. -auto. -auto; progress; - have /# : n1 %/ r <= (n1 + r - 1) %/ r - by rewrite leq_div2r; smt(gt0_r). -auto; progress; - have /# : n1 %/ r <= (n1 + r - 1) %/ r - by rewrite leq_div2r; smt(gt0_r). +call (HybridIROEagerTrans_BlockSpongeTrans_loop (n1 %/ r)). +skip; progress; smt(divz_ge0 gt0_r). +(* either nothing more to do on either side, or a single block to add + on the right side, and less than r bits to add on the left side *) conseq (_ : n1 = n{1} /\ 0 <= n1 /\ xs{1} = x{2} /\ n{2} = (n1 + r - 1) %/ r /\ @@ -1719,7 +1642,7 @@ conseq bs{1} = take n1 (blocks2bits bs{2}) /\ size bs{2} = n{2} /\ eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}) => //. progress; by apply/needed_blocks_rel_div_r. -case (i{2} = n{2}). +case (i{2} = n{2}). (* so i{1} = n{1} and i{1} = m{1} *) rcondf{2} 1; first auto; progress; smt(). rcondf{1} 1; first auto; progress; smt(). rcondf{1} 1; first auto; progress; smt(). @@ -1729,10 +1652,10 @@ have -> : n{1} = size (blocks2bits bs{2}) by rewrite size_blocks2bits sz_eq -mulzC divzK 1:needed_blocks_eq_div_r. by rewrite take_size. by rewrite sz_eq need_blks_eq. -(* i{2} <> n{2}, so i{2} + 1 = n{2} *) +(* i{2} <> n{2}, so i{2} + 1 = n{2}, m{1} - i{1} = r and i{1} <= m{1} *) rcondt{2} 1; first auto; progress; smt(). -rcondf{2} 4; first auto; call (_ : true). -if=> //. auto; progress; smt(). +rcondf{2} 4. +auto; call (_ : true); [if=> //; auto; progress; smt() | auto; smt()]. conseq (_ : n1 = n{1} /\ 0 <= n1 /\ xs{1} = x{2} /\ 0 <= i{2} /\ i{1} = i{2} * r /\ @@ -1742,9 +1665,8 @@ conseq bs{1} = take n1 (blocks2bits bs{2}) /\ eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}) _ - (_ : size bs = n - 1 ==> size bs = n). + (_ : size bs = n - 1 ==> size bs = n)=> //. progress; smt(divz_ge0 gt0_r lez_floor size_blocks2bits). -smt(). wp. call (_ : true). auto. skip; smt(size_rcons). transitivity{1} { while (i < m) { @@ -1772,23 +1694,20 @@ seq 1 1 : while (={HybridIROEager.mp, xs, bs, i, m} /\ n{1} = n1 /\ n1 <= m{1} /\ i{1} <= n1 /\ size bs{1} = i{1}). -wp. -call (_ : ={HybridIROEager.mp}). -if => //; rnd; auto. +wp; call (_ : ={HybridIROEager.mp}); first if => //; rnd; auto. skip; smt(size_rcons). skip; smt(). while (={HybridIROEager.mp, xs, i, m} /\ n1 <= m{1} /\ n1 <= i{1} <= m{1} /\ n1 <= size bs{2} /\ bs{1} = take n1 bs{2}). -wp. -call (_ : ={HybridIROEager.mp}). -if => //; rnd; auto. +wp; call (_ : ={HybridIROEager.mp}); first if => //; rnd; auto. skip; progress; [smt() | smt() | smt(size_rcons) | rewrite -cats1 take_cat; smt(size_rcons take_oversize cats1 cats0)]. skip; smt(take_size). +(* now we can use HybridIROEagerTrans_BlockSpongeTrans_next_block *) transitivity{1} { (bs, i) <@ HybridIROEagerTrans.next_block(xs, i, m, bs); } @@ -1803,22 +1722,23 @@ progress [-delta]; exists HybridIROEager.mp{1}, (blocks2bits bs{2}), m{1}, (size bs{2} * r), x{2}=> //. inline HybridIROEagerTrans.next_block; sim. -transitivity{2} - { (bs, i) <@ BlockSpongeTrans.next_block(x, i, bs); - } - (xs{1} = x{2} /\ 0 <= i{2} /\ i{1} = i{2} * r /\ m{1} - i{1} = r /\ - size bs{2} = i{2} /\ bs{1} = blocks2bits bs{2} /\ - eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> - bs{1} = blocks2bits bs{2} /\ - eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}) - (={bs, i, x, BlockSponge.BIRO.IRO.mp} ==> - ={bs, i, x, BlockSponge.BIRO.IRO.mp})=> //. -progress [-delta]; - exists BlockSponge.BIRO.IRO.mp{2}, bs{2}, (size bs{2}), x{2}=> //. +(transitivity{2} + { (bs, i) <@ BlockSpongeTrans.next_block(x, i, bs); + } + (xs{1} = x{2} /\ 0 <= i{2} /\ i{1} = i{2} * r /\ m{1} - i{1} = r /\ + size bs{2} = i{2} /\ bs{1} = blocks2bits bs{2} /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> + bs{1} = blocks2bits bs{2} /\ + eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}) + (={bs, i, x, BlockSponge.BIRO.IRO.mp} ==> + ={bs, i, x, BlockSponge.BIRO.IRO.mp})=> //; + first progress [-delta]; + exists BlockSponge.BIRO.IRO.mp{2}, bs{2}, (size bs{2}), x{2}=> //); + last first. +inline BlockSpongeTrans.next_block; sim. exists* i{2}; elim*=> i2. call (HybridIROEagerTrans_BlockSpongeTrans_next_block i2). auto. -inline BlockSpongeTrans.next_block; sim. qed. lemma HybridIROEager_BlockIRO_f : @@ -1840,8 +1760,7 @@ move=> |> &1 &2 ? n_eq inv. exists BlockSponge.BIRO.IRO.mp{2}, HybridIROEager.mp{1}, (xs{1}, n{1} * r). move=> |>; by rewrite n_eq. progress; apply blocks2bitsK. -conseq HybridIROEager_f_g. -move=> |> &1 &2 ? -> ? //. +by conseq HybridIROEager_f_g=> |> &1 &2 ? -> ?. exists* n{1}; elim*=> n1; exists* xs{1}; elim*=> xs'. conseq (HybridIROEager_g_BlockIRO_f n1 xs')=> //. move=> |> &1 &2 ? -> inv; by rewrite needed_blocks_prod_r. @@ -1905,27 +1824,6 @@ conseq Sponge_Raise_BlockSponge_f=> //. auto. qed. -local lemma RaiseHybridIRO_HybridIROEager_RaiseFun_BlockIRO_f : - equiv[HIRO.RaiseHybridIRO(HIRO.HybridIROEager).f ~ - RaiseFun(BlockSponge.BIRO.IRO).f : - ={bs, n} /\ ={glob BlockSim} /\ - HIRO.eager_invar BlockSponge.BIRO.IRO.mp{2} HIRO.HybridIROEager.mp{1} ==> - ={res} /\ ={glob BlockSim} /\ - HIRO.eager_invar BlockSponge.BIRO.IRO.mp{2} HIRO.HybridIROEager.mp{1}]. -proof. -proc=> /=. -exists* n{1}; elim*=> n'. -exists* (pad2blocks bs{2}); elim*=> xs2. -call (HIRO.HybridIROEager_g_BlockIRO_f n' xs2). -skip=> |> &1 &2 ? res1 res2 mp1 mp2 ? vb_imp not_vb_imp. -case: (valid_block (pad2blocks bs{2}))=> [vb | not_vb]. -have [le0_n2_imp gt0_n2_imp] := vb_imp vb. -case: (n{2} <= 0)=> [le0_n2 /# | not_le0_n2]. -have gt0_n2 : 0 < n{2} by smt(). -by have [-> _] := gt0_n2_imp gt0_n2. -have [-> ->] := not_vb_imp not_vb; by rewrite blocks2bits_nil. -qed. - local lemma Ideal_IRO_Experiment_HybridLazy &m : Pr[IdealIndif(IRO, RaiseSim(BlockSim), Dist).main() @ &m : res] = Pr[Experiment @@ -1946,10 +1844,10 @@ proc (={glob BlockSim} /\ HIRO.lazy_invar IRO.mp{1} HIRO.HybridIROLazy.mp{2})=> //. progress [-delta]; apply HIRO.lazy_invar0. -proc (HIRO.lazy_invar IRO.mp{1} HIRO.HybridIROLazy.mp{2})=> //. -apply HIRO.LowerFun_IRO_HybridIROLazy_f. -proc (HIRO.lazy_invar IRO.mp{1} HIRO.HybridIROLazy.mp{2})=> //. -apply HIRO.LowerFun_IRO_HybridIROLazy_f. +proc (HIRO.lazy_invar IRO.mp{1} HIRO.HybridIROLazy.mp{2})=> //; + apply HIRO.LowerFun_IRO_HybridIROLazy_f. +proc (HIRO.lazy_invar IRO.mp{1} HIRO.HybridIROLazy.mp{2})=> //; + apply HIRO.LowerFun_IRO_HybridIROLazy_f. by conseq HIRO.IRO_RaiseHybridIRO_HybridIROLazy_f. auto. qed. @@ -2005,6 +1903,27 @@ by rewrite (Experiment_HybridIROExper_Lazy &m) (HybridIROExper_Experiment_Eager &m). qed. +local lemma RaiseHybridIRO_HybridIROEager_RaiseFun_BlockIRO_f : + equiv[HIRO.RaiseHybridIRO(HIRO.HybridIROEager).f ~ + RaiseFun(BlockSponge.BIRO.IRO).f : + ={bs, n} /\ ={glob BlockSim} /\ + HIRO.eager_invar BlockSponge.BIRO.IRO.mp{2} HIRO.HybridIROEager.mp{1} ==> + ={res} /\ ={glob BlockSim} /\ + HIRO.eager_invar BlockSponge.BIRO.IRO.mp{2} HIRO.HybridIROEager.mp{1}]. +proof. +proc=> /=. +exists* n{1}; elim*=> n'. +exists* (pad2blocks bs{2}); elim*=> xs2. +call (HIRO.HybridIROEager_g_BlockIRO_f n' xs2). +skip=> |> &1 &2 ? res1 res2 mp1 mp2 ? vb_imp not_vb_imp. +case: (valid_block (pad2blocks bs{2}))=> [vb | not_vb]. +have [le0_n2_imp gt0_n2_imp] := vb_imp vb. +case: (n{2} <= 0)=> [le0_n2 /# | not_le0_n2]. +have gt0_n2 : 0 < n{2} by smt(). +by have [-> _] := gt0_n2_imp gt0_n2. +have [-> ->] := not_vb_imp not_vb; by rewrite blocks2bits_nil. +qed. + local lemma Experiment_HybridEager_Ideal_BlockIRO &m : Pr[Experiment (HIRO.RaiseHybridIRO(HIRO.HybridIROEager), BlockSim(HIRO.HybridIROEager), From d41ee2ff3fcae7c9606469d9fc1cf9ba6c0067be Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Wed, 10 Aug 2016 22:38:19 -0400 Subject: [PATCH 200/525] Fixing scripts in top-level directory wrt PY's new stable ordering. --- proof/RndO.ec | 2 +- proof/Sponge.ec | 26 +++++++++++++------------- 2 files changed, 14 insertions(+), 14 deletions(-) diff --git a/proof/RndO.ec b/proof/RndO.ec index 7036303..97b5c14 100644 --- a/proof/RndO.ec +++ b/proof/RndO.ec @@ -411,7 +411,7 @@ proof. (={x,y,FRO.m} /\ mem (dom FRO.m{1}) x{1} /\ (oget FRO.m{1}.[x{1}]).`2 = Unknown==> ={x,y} /\ eq_except FRO.m{1} FRO.m{2} (pred1 x{1}) /\ FRO.m{2}.[x{2}] = Some (y{2},Known)). - + by move=>?&mr[#]2->???;exists FRO.m{mr}, y{mr}, x{mr}=>/#. + + by move=>?&mr[#]2->???;exists FRO.m{mr}, x{mr}, y{mr}=>/#. + move=>?&m&mr[#]<*>[#]2->Hex Hm2. by rewrite (eq_except_set_eq FRO.m{mr} FRO.m{m} x{mr}) ?in_dom ?Hm2// eq_except_sym. + symmetry;call (iter1_perm RRO.I iter_perm2);auto=>?&mr[#]3-> Hdom Hm;split=>//=. diff --git a/proof/Sponge.ec b/proof/Sponge.ec index 295aab4..2c357a3 100644 --- a/proof/Sponge.ec +++ b/proof/Sponge.ec @@ -1154,7 +1154,7 @@ have -> : skip=> &m1 &m2 [# r_eq j_eq j_init cs_eq cs_init]. split; first smt(gt0_r). move=> - j_L cs_L l_R i_r not_j_L_lt_r not_i_r_lt_n + cs_L j_L i_r l_R not_j_L_lt_r not_i_r_lt_n [# _ j_L_eq cs_L_eq j_L_le_r sz_cs_L_eq_j_L]. have sz_cs_L_eq_r : size cs_L = r by smt(). progress; [by rewrite ofblockK | by rewrite cs_L_eq mkblockK]. @@ -1452,9 +1452,9 @@ transitivity{1} i{1} = (n' + 1) * r /\ i{2} = n' + 1 /\ size bs{2} = n' + 1 /\ bs{1} = blocks2bits bs{2} /\ eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1})=> //. -progress; - exists HybridIROEager.mp{1}, (size bs{2} * r), - (blocks2bits bs{2}), xs{2}=> //. +progress. + exists HybridIROEager.mp{1}, (blocks2bits bs{2}), (size bs{2} * r), + xs{2}=> //. inline HybridIROEagerTrans.next_block; sp; wp. while (xs{1} = xs0{2} /\ i{1} = i0{2} /\ n{1} = n' + 1 /\ @@ -1472,7 +1472,7 @@ transitivity{2} eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}) (={xs, bs, i, BlockSponge.BIRO.IRO.mp} ==> ={xs, bs, i, BlockSponge.BIRO.IRO.mp})=> //. -progress; exists BlockSponge.BIRO.IRO.mp{2}, (size bs{2}), bs{2}, xs{2}=> //. +progress. exists BlockSponge.BIRO.IRO.mp{2}, bs{2}, (size bs{2}), xs{2}=> //. call (HybridIROEagerTrans_BlockSpongeTrans_next_block n'). skip; progress; smt(). inline BlockSpongeTrans.next_block. @@ -1554,7 +1554,7 @@ transitivity{1} i{1} = n1 %/ r * r /\ i{2} = n1 %/ r /\ size bs{2} = i{2} /\ bs{1} = blocks2bits bs{2} /\ eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1})=> //. -progress; exists HybridIROEager.mp{1}, [], n{1}, 0, x{2}=> //. +progress; exists HybridIROEager.mp{1}, [], 0, n{1}, x{2}=> //. while (={i, bs, xs, HybridIROEager.mp} /\ n1 = n{1} /\ 0 <= n1). wp. call (_ : ={HybridIROEager.mp}). if=> //; auto. auto; progress; smt(leq_trunc_div ge0_r). @@ -1575,8 +1575,8 @@ auto; progress; smt(leq_trunc_div ge0_r). (={i, x, bs, BlockSponge.BIRO.IRO.mp} /\ n{2} = (n1 + r - 1) %/ r ==> ={i, x, bs, BlockSponge.BIRO.IRO.mp})=> //; first progress; - exists BlockSponge.BIRO.IRO.mp{2}, [], 0, x{2}, - ((n{1} + r - 1) %/ r)=> //); + exists BlockSponge.BIRO.IRO.mp{2}, [], 0, + ((n{1} + r - 1) %/ r), x{2}=> //); first last. while (={i, x, bs, BlockSponge.BIRO.IRO.mp} /\ n{2} = (n1 + r - 1) %/ r). @@ -1684,8 +1684,8 @@ transitivity{1} bs{1} = blocks2bits bs{2} /\ eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). progress; - exists HybridIROEager.mp{1}, (blocks2bits bs{2}), m{1}, - (size bs{2} * r), x{2}=> //. + exists HybridIROEager.mp{1}, (blocks2bits bs{2}), (size bs{2} * r), m{1}, + x{2}=> //. progress; smt(take_cat). splitwhile{2} 1 : i < n1. seq 1 1 : @@ -1719,8 +1719,8 @@ transitivity{1} bs{1} = blocks2bits bs{2} /\ eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1})=> //. progress [-delta]; - exists HybridIROEager.mp{1}, (blocks2bits bs{2}), m{1}, - (size bs{2} * r), x{2}=> //. + exists HybridIROEager.mp{1}, (blocks2bits bs{2}), (size bs{2} * r), m{1}, + x{2}=> //. inline HybridIROEagerTrans.next_block; sim. (transitivity{2} { (bs, i) <@ BlockSpongeTrans.next_block(x, i, bs); @@ -1757,7 +1757,7 @@ transitivity res{1} = (blocks2bits res{2}) /\ eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). move=> |> &1 &2 ? n_eq inv. -exists BlockSponge.BIRO.IRO.mp{2}, HybridIROEager.mp{1}, (xs{1}, n{1} * r). +exists HybridIROEager.mp{1}, BlockSponge.BIRO.IRO.mp{2}, (xs{1}, n{1} * r). move=> |>; by rewrite n_eq. progress; apply blocks2bitsK. by conseq HybridIROEager_f_g=> |> &1 &2 ? -> ?. From f5202e9a9e6b0f2f33daca94d960b428495ade22 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Thu, 11 Aug 2016 12:41:42 -0400 Subject: [PATCH 201/525] Nits. --- proof/Sponge.ec | 34 ++++++++++++++-------------------- 1 file changed, 14 insertions(+), 20 deletions(-) diff --git a/proof/Sponge.ec b/proof/Sponge.ec index 2c357a3..53d4499 100644 --- a/proof/Sponge.ec +++ b/proof/Sponge.ec @@ -1151,13 +1151,11 @@ have -> : size cs{1} = j{1}). wp; rnd; skip. progress; smt(cats1 gt0_r size_rcons). - skip=> &m1 &m2 [# r_eq j_eq j_init cs_eq cs_init]. + skip=> &m1 &m2 [# <- <- -> <- ->]. split; first smt(gt0_r). - move=> - cs_L j_L i_r l_R not_j_L_lt_r not_i_r_lt_n - [# _ j_L_eq cs_L_eq j_L_le_r sz_cs_L_eq_j_L]. - have sz_cs_L_eq_r : size cs_L = r by smt(). - progress; [by rewrite ofblockK | by rewrite cs_L_eq mkblockK]. + move=> cs j i ds not_lt_jr not_lt_ir [# _ eq_ji -> le_jr sz_cs_eq_j]. + have sz_ds_eq_r : size ds = r by smt(). + progress; [by rewrite ofblockK | by rewrite mkblockK]. rewrite (PrLoopSnoc_sample &1 (ofblock w)). rewrite mux_dlist 1:ge0_r size_block /=. have -> : @@ -1253,20 +1251,17 @@ by rewrite some_form_mp_hr_lookup_eq oget_some. smt(). skip=> &1 &2 - [# -> ge0_i2 i1_eq_i2_tim_r m_min_i1_eq_r ->> sz_bs2_eq_i2 + [# <- ge0_i2 i1_eq_i2_tim_r m_min_i1_eq_r <- sz_bs2_eq_i2 sz_b2b_bs2_eq_i1 ->> mem_dom_mp2_xs_i2 ei]. split. split. split=> [// | _]; rewrite i1_eq_i2_tim_r; smt(ge0_r). split=> //. split; first smt(). split=> //. split; first by rewrite /= take0 cats0. split=> //. -move=> bs_L i_L. -split=> [| not_lt_i_L_m]; first smt(). -move=> - [# i1_le_i_L_le_m _ _ sz_bs_L_eq_i_L m1_min_i1_eq_r - bs_L_eq mem_mp2_xs_i2 _]. +clear bs1; move=> bs1 i1'. +split=> [| not_i1'_lt_m]; first smt(). +move=> [# i1_le_i1' i1'_le_m _ sz_bs1_eq_i1' _ bs1_eq mem_mp2_xs_i2 _]. split. -have i_L_eq_m : i_L = m{1} by smt(). -rewrite bs_L_eq -cats1 blocks2bits_cat - i_L_eq_m m1_min_i1_eq_r blocks2bits_sing. +have i1'_eq_m : i1' = m{1} by smt(). +rewrite bs1_eq -cats1 blocks2bits_cat i1'_eq_m m_min_i1_eq_r blocks2bits_sing. pose blk := (oget BlockSponge.BIRO.IRO.mp{2}.[(xs{1}, i2)]). have -> : r = size (ofblock blk) by rewrite size_block. by rewrite take_size. @@ -1351,9 +1346,8 @@ have -> /= : (xs{hr}, j) <> (xs{hr}, i{hr}) by smt(). rewrite mp_ran_eq /#. smt(). skip=> - &1 &2 - [# -> ge0_i2 eq_i_i1 i1_eq_i2_tim_r m_min_i1_eq_r - bs1_eq sz_bs2_eq_i2 sz_bs1_eq_i1_add_r -> ei]. + &1 &2 [# -> ge0_i2 -> i1_eq_i2_tim_r m_min_i1_eq_r + bs1_eq sz_bs2_eq_i2 sz_bs1_eq_i1_add_r -> ei]. have ge0_i1 : 0 <= i1 by rewrite i1_eq_i2_tim_r divr_ge0 // ge0_r. split. split=> //. split; first smt(ge0_r). split; first smt(). split; smt(ge0_r). @@ -1452,7 +1446,7 @@ transitivity{1} i{1} = (n' + 1) * r /\ i{2} = n' + 1 /\ size bs{2} = n' + 1 /\ bs{1} = blocks2bits bs{2} /\ eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1})=> //. -progress. +progress; exists HybridIROEager.mp{1}, (blocks2bits bs{2}), (size bs{2} * r), xs{2}=> //. inline HybridIROEagerTrans.next_block; sp; wp. @@ -1472,7 +1466,7 @@ transitivity{2} eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}) (={xs, bs, i, BlockSponge.BIRO.IRO.mp} ==> ={xs, bs, i, BlockSponge.BIRO.IRO.mp})=> //. -progress. exists BlockSponge.BIRO.IRO.mp{2}, bs{2}, (size bs{2}), xs{2}=> //. +progress; exists BlockSponge.BIRO.IRO.mp{2}, bs{2}, (size bs{2}), xs{2}=> //. call (HybridIROEagerTrans_BlockSpongeTrans_next_block n'). skip; progress; smt(). inline BlockSpongeTrans.next_block. From c4f3c3a3c9c1ab6f228ffaa327e3feacfdd3ab34 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Thu, 11 Aug 2016 17:44:34 +0100 Subject: [PATCH 202/525] Simplifying intro patterns with laziness. --- proof/core/Handle.eca | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/proof/core/Handle.eca b/proof/core/Handle.eca index 7f3e0e1..55fef06 100644 --- a/proof/core/Handle.eca +++ b/proof/core/Handle.eca @@ -826,20 +826,20 @@ section AUX. move=> [p0 v0] ^ pi_x2. have [] _ _ _ _ _ [] -> _ [hx2] [#] Hpath hs_hx2:= inv0. rcondt{2} 1. by move=> &m; auto=> &hr [#] !<<- _ _ ->> /= _; rewrite in_dom pi_x2. rcondf{2} 6. - + auto; inline *; auto=> &hr [#] !<<- _ _ !->> _ /= + _ - _ + _ - _ /=. + + auto; inline *; auto=> &hr [#] !<<- _ _ !->> _ /= _ _ _ _ /=. by rewrite in_rng; exists hx2. rcondf{2} 7. - + auto; inline *; auto=> &hr [#] !<<- _ _ !->> _ /= + _ - _ + _ - _ /=. + + auto; inline *; auto=> &hr [#] !<<- _ _ !->> _ /= _ _ _ _ /=. rewrite negb_and; left; rewrite (@huniq_hinvK_h hx2 hs0 x2) // 2:oget_some. + by case: inv0=> _ _ _ _ _ _ []. rewrite in_dom; case: {-1}(G1mh.[(x1,hx2)]) (eq_refl (G1mh.[(x1,hx2)]))=> [//=|[xa xc] G1mh_x1hx2]. have [] [] _ /(_ _ _ _ _ G1mh_x1hx2) [xc0 xf0 yc0 yf0] + _ _ _ _ _ _:= inv0. by move=> [#]; rewrite hs_hx2=> [#] !<<- {xc0 xf0}; rewrite x1x2_notin_PFm. rcondt{2} 15. - + auto; inline *; auto=> &hr [#] !<<- _ _ !->> _ /= + _ - _ + _ - _ /=. + + auto; inline *; auto=> &hr [#] !<<- _ _ !->> _ /= _ _ _ _ /=. by rewrite in_dom pi_x2. inline F.RO.get. rcondt{2} 4. - + auto=> &hr [#] !<<- _ _ !->> _ /= + _ - _; rewrite pi_x2 oget_some /=. + + auto=> &hr [#] !<<- _ _ !->> _ /= _ _; rewrite pi_x2 oget_some /=. rewrite in_dom; case: {-1}(ro0.[rcons p0 (v0 +^ x1)]) (eq_refl (ro0.[rcons p0 (v0 +^ x1)])). + done. move=> bo ^ro_pvx1 /=. have [] _ _ _ _ [] _ -> _ _:= inv0. @@ -872,15 +872,15 @@ section AUX. move=> pi_x2; rcondt{2} 1; 1:by auto=> &hr [#] <*>; rewrite in_dom pi_x2. inline F.RO.get. rcondf{2} 4; first by auto=> &hr [#] !<<- _ _ ->> _ /=; rewrite pi_x2 oget_some /= in_dom Hro. - rcondf{2} 8; first by auto=> &hr [#] !<<- _ _ ->> _ /= + _ - _ + _ - _; rewrite in_rng; exists hx2. + rcondf{2} 8; first by auto=> &hr [#] !<<- _ _ ->> _ /= _ _ _ _; rewrite in_rng; exists hx2. rcondt{2} 9. - + auto=> &hr [#] !<<- _ _ ->> _ /= + _ - _ + _ - _. + + auto=> &hr [#] !<<- _ _ ->> _ /= _ _ _ _. rewrite (@huniq_hinvK_h hx2 hs0 x2) // 2:in_dom 2:G1mh_x1hx2 2:!oget_some /=. + by case: inv0=> _ _ _ _ _ _ []. by rewrite /in_dom_with in_dom hs_hy2. rcondt{2} 14; first by auto=> &hr [#] !<<- _ _ ->> _ /=; rewrite in_dom pi_x2. auto=> &1 &2 [#] !<<- -> -> ->> _ /=; rewrite Block.DWord.bdistr_ll Capacity.DWord.cdistr_ll /=. - move=> + _ - _ + _ - _; rewrite PFm_x1x2 pi_x2 !oget_some //=. + move=> _ _ _ _; rewrite PFm_x1x2 pi_x2 !oget_some //=. rewrite (@huniq_hinvK_h hx2 hs0 x2) // ?oget_some. + by case: inv0=> _ _ _ _ _ _ []. rewrite Hro G1mh_x1hx2 hs_hy2 ?oget_some //=. From 0ededfe054e4ce0d1b6ec800e1aa0266bc9bc5da Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Mon, 8 Aug 2016 13:18:13 +0100 Subject: [PATCH 203/525] Revert "Goals got reordered. This may need reverted (again)." This reverts commit 26cce50e87620f435d4610ef400f7cb7a8017342. --- proof/core/Gext.eca | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/proof/core/Gext.eca b/proof/core/Gext.eca index 1605283..0fe42ad 100644 --- a/proof/core/Gext.eca +++ b/proof/core/Gext.eca @@ -619,23 +619,23 @@ section EXT. apply ler_wpmul2r;1:by apply eps_ge0. by rewrite le_fromint;smt ml=0 w=max_ge0. + proc;rcondt 2;1:by auto. - wp;rnd (mem (image snd (dom G1.m `|` dom G1.mi) `|` fset1 x));skip=> /> &hr ??-> /= ??. - rewrite (Mu_mem.mu_mem (image snd (dom G1.m{hr}`|`dom G1.mi{hr}) `|` fset1 x{hr}) cdistr (1%r/(2^c)%r))//. + wp; rnd (mem (image snd (dom G1.m `|` dom G1.mi ))); skip=> /> &hr ? ? -> /= ? ?. + rewrite (Mu_mem.mu_mem + (image snd (dom G1.m{hr} `|` dom G1.mi{hr})) + cdistr (1%r/(2^c)%r))//. + by move=>x _;apply DWord.cdistr1E. apply ler_wpmul2r;1:by apply divr_ge0=>//;apply /c_ge0r. - rewrite imageU !fcardU le_fromint fcard1. + rewrite imageU fcardU le_fromint. move:(fcard_image_leq snd (dom G1.m{hr}))(fcard_image_leq snd (dom G1.mi{hr})). by rewrite -!sizeE;smt w=fcard_ge0. + by move=>c1;proc;auto=> &hr [^H 2->]/#. + by move=> b1 c1;proc;auto=> /#. + proc;rcondt 2;1:by auto. - wp; rnd (mem (image snd (dom G1.m `|` dom G1.mi ))); skip=> /> &hr ? ? -> /= ? ?. - rewrite (Mu_mem.mu_mem - (image snd (dom G1.m{hr} `|` dom G1.mi{hr})) - cdistr (1%r/(2^c)%r))//. - + by move=>x _;apply DWord.cdistr1E. + wp;rnd (mem (image snd (dom G1.m `|` dom G1.mi) `|` fset1 x));skip=> /> &hr ??-> /= ??. + rewrite (Mu_mem.mu_mem (image snd (dom G1.m{hr}`|`dom G1.mi{hr}) `|` fset1 x{hr}) cdistr (1%r/(2^c)%r))//. + + by move=>x _;apply DWord.cdistr1E. apply ler_wpmul2r;1:by apply divr_ge0=>//;apply /c_ge0r. - rewrite imageU fcardU le_fromint. + rewrite imageU !fcardU le_fromint fcard1. move:(fcard_image_leq snd (dom G1.m{hr}))(fcard_image_leq snd (dom G1.mi{hr})). by rewrite -!sizeE;smt w=fcard_ge0. + by move=>c1;proc;auto=> &hr [^H 2->]/#. From b1cdd803ddc9de3c6ab2ae9b671955102cddfc94 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Fri, 19 Aug 2016 13:33:49 +0100 Subject: [PATCH 204/525] Updating EC. Proofs not moving forward very fast. --- proof/RndO.ec | 12 +- proof/Sponge.ec | 32 ++-- proof/core/Gext.eca | 26 +-- proof/core/Handle.eca | 414 ++++++++++++++++++++++++++++++++++++------ 4 files changed, 395 insertions(+), 89 deletions(-) diff --git a/proof/RndO.ec b/proof/RndO.ec index 97b5c14..b533c6e 100644 --- a/proof/RndO.ec +++ b/proof/RndO.ec @@ -368,7 +368,7 @@ proof. ={x} /\ eq_except FRO.m{1} FRO.m{2} (pred1 x{1}) /\ FRO.m{1}.[x{2}] = Some (result{2},Unknown) /\ FRO.m{2}.[x{2}] = Some (result{2},Known)). - + by move=>?&mr[#]-> -> ??;exists FRO.m{mr}, x{mr}=>/#. + + by move=>?&mr[#]-> -> ??;exists FRO.m{mr} x{mr}=>/#. + move=>???;rewrite in_dom=>[#]<*>[#]->/eq_except_sym H Hxm Hx2. rewrite sampleto_ll=> r _;rewrite /= Hxm oget_some /=;apply /eq_sym. have /(congr1 oget):= Hx2 => <-;apply eq_except_set_eq=>//. @@ -411,7 +411,7 @@ proof. (={x,y,FRO.m} /\ mem (dom FRO.m{1}) x{1} /\ (oget FRO.m{1}.[x{1}]).`2 = Unknown==> ={x,y} /\ eq_except FRO.m{1} FRO.m{2} (pred1 x{1}) /\ FRO.m{2}.[x{2}] = Some (y{2},Known)). - + by move=>?&mr[#]2->???;exists FRO.m{mr}, x{mr}, y{mr}=>/#. + + by move=>?&mr[#]2->???;exists FRO.m{mr} x{mr} y{mr}=>/#. + move=>?&m&mr[#]<*>[#]2->Hex Hm2. by rewrite (eq_except_set_eq FRO.m{mr} FRO.m{m} x{mr}) ?in_dom ?Hm2// eq_except_sym. + symmetry;call (iter1_perm RRO.I iter_perm2);auto=>?&mr[#]3-> Hdom Hm;split=>//=. @@ -448,7 +448,7 @@ proof. { Iter(RRO.I).iter_1s(x,elems (dom (restr Unknown FRO.m) `\` fset1 x)); } (={x,FRO.m}/\(in_dom_with FRO.m x Unknown){1}==> ={x,FRO.m}) (={x,FRO.m}/\ (in_dom_with FRO.m x Unknown){1} ==> (rem x FRO.m){1} = FRO.m{2})=>//. - + by move=>?&mr[#]2->?;exists FRO.m{mr}, x{mr}. + + by move=>?&mr[#]2->?;exists FRO.m{mr} x{mr}. + symmetry;call (iter1_perm RRO.I iter_perm2);skip=>?&mr[#]2!->?/=;split=>//. by apply /perm_eq_sym/perm_to_rem/dom_restr. inline{1}Iter(RRO.I).iter_1s. @@ -518,7 +518,7 @@ proof. (={x,FRO.m} /\ ! mem (dom FRO.m{2}) x{2} ==> ={x,FRO.m})=>//;last first. + inline{2} RRO.resample;call (iter1_perm RRO.I iter_perm2);auto=>?&mr[#]2->Hmem/=?->/=. by apply /perm_eq_sym/perm_to_rem;rewrite restr_set/=dom_set !inE. - + by move=>?&mr[#]2->?;exists FRO.m{mr}, x{mr}. + + by move=>?&mr[#]2->?;exists FRO.m{mr} x{mr}. inline Iter(RRO.I).iter_1s RRO.I.f RRO.resample;wp;swap{1}-1. seq 1 7 : (={x} /\ eq_except FRO.m{1} FRO.m{2} (pred1 x{1}) /\ l{2} = (elems (dom (restr Unknown FRO.m))){1} /\ @@ -662,7 +662,7 @@ proof. ={res,glob D}) (={glob D} /\ FRO.m{1} = map (fun _ c => (c,Known)) RO.m{2} ==> ={res,glob D})=>//. - + by move=>?&mr[]2!->;exists (glob D){mr},(map(fun _ c =>(c,Known))RO.m{mr}). + + by move=>?&mr[]2!->;exists (glob D){mr}(map(fun _ c =>(c,Known))RO.m{mr}). + proc*;inline M.main1;wp;call (RO_FRO_D D);inline *. rcondf{2}2;auto. + move=> &mr[]_->;apply mem_eq0=>z;rewrite -memE dom_restr /in_dom_with mapP dom_map in_dom. @@ -672,7 +672,7 @@ proof. (={glob D, FRO.m} ==> ={res, glob D}) (={glob D} /\ FRO.m{1} = map (fun _ c => (c,Known)) RO.m{2} ==> ={res,glob D})=>//. - + by move=>?&mr[]2!->;exists (glob D){mr},(map(fun _ c =>(c,Known))RO.m{mr}). + + by move=>?&mr[]2!->;exists (glob D){mr} (map(fun _ c =>(c,Known))RO.m{mr}). + by proc; eager call (eager_D D);auto. proc*;inline M.main2;wp;call{1} RRO_resample_ll. symmetry;call (LRO_RRO_D D);auto=> &ml&mr[#]2->;split=>//=. diff --git a/proof/Sponge.ec b/proof/Sponge.ec index 53d4499..e7b6054 100644 --- a/proof/Sponge.ec +++ b/proof/Sponge.ec @@ -868,7 +868,7 @@ proof. move=> lt_ij eee ran_k. apply fmapP=> p. have [ys k] -> /# : exists ys k, p = (ys, k) - by exists p.`1, p.`2; smt(). + by exists p.`1 p.`2; smt(). qed. lemma eager_invar_eq_except_upd1 @@ -1191,7 +1191,7 @@ transitivity size res{2}.`1 = i2 + 1 /\ eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1})=> //. move=> |> &1 &2 ge0_i2 -> i1_eq_i2_tim_r m_min_i1_eq_r -> sz_bs_eq_i2 ei. -exists HybridIROEager.mp{1}, (x{2}, i{1}, m{1}, blocks2bits bs{2})=> |>. +exists HybridIROEager.mp{1} (x{2}, i{1}, m{1}, blocks2bits bs{2})=> |>. split; first smt(). split; first smt(size_blocks2bits). apply @@ -1407,7 +1407,7 @@ transitivity{1} i{1} = n' * r /\ i{2} = n' /\ size bs{2} = n' /\ bs{1} = blocks2bits bs{2} /\ eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1})=> //. -progress; exists HybridIROEager.mp{1}, n', xs{2}=> //. +progress; exists HybridIROEager.mp{1} n' xs{2}=> //. while (={xs, i, bs, HybridIROEager.mp} /\ n{1} = n' + 1 /\ n{2} = n'). wp. call (_ : ={HybridIROEager.mp}). if=> //; rnd; auto. skip; progress; smt(ge0_r). @@ -1427,7 +1427,7 @@ transitivity{2} eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}) (={xs,BlockSponge.BIRO.IRO.mp} /\ n{1} = n' /\ n{2} = n' + 1 ==> ={i, bs, BlockSponge.BIRO.IRO.mp})=> //. -progress; exists BlockSponge.BIRO.IRO.mp{2}, n{1}, xs{2}=> //. +progress; exists BlockSponge.BIRO.IRO.mp{2} n{1} xs{2}=> //. conseq IH=> //. while (={xs, bs, i, BlockSponge.BIRO.IRO.mp} /\ n{1} = n' /\ n{2} = n' + 1). @@ -1447,8 +1447,7 @@ transitivity{1} bs{1} = blocks2bits bs{2} /\ eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1})=> //. progress; - exists HybridIROEager.mp{1}, (blocks2bits bs{2}), (size bs{2} * r), - xs{2}=> //. + exists HybridIROEager.mp{1} (blocks2bits bs{2}) (size bs{2} * r) xs{2}=> //. inline HybridIROEagerTrans.next_block; sp; wp. while (xs{1} = xs0{2} /\ i{1} = i0{2} /\ n{1} = n' + 1 /\ @@ -1466,7 +1465,7 @@ transitivity{2} eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}) (={xs, bs, i, BlockSponge.BIRO.IRO.mp} ==> ={xs, bs, i, BlockSponge.BIRO.IRO.mp})=> //. -progress; exists BlockSponge.BIRO.IRO.mp{2}, bs{2}, (size bs{2}), xs{2}=> //. +progress; exists BlockSponge.BIRO.IRO.mp{2} bs{2} (size bs{2}) xs{2}=> //. call (HybridIROEagerTrans_BlockSpongeTrans_next_block n'). skip; progress; smt(). inline BlockSpongeTrans.next_block. @@ -1548,7 +1547,7 @@ transitivity{1} i{1} = n1 %/ r * r /\ i{2} = n1 %/ r /\ size bs{2} = i{2} /\ bs{1} = blocks2bits bs{2} /\ eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1})=> //. -progress; exists HybridIROEager.mp{1}, [], 0, n{1}, x{2}=> //. +progress; exists HybridIROEager.mp{1} [] 0 n{1} x{2}=> //. while (={i, bs, xs, HybridIROEager.mp} /\ n1 = n{1} /\ 0 <= n1). wp. call (_ : ={HybridIROEager.mp}). if=> //; auto. auto; progress; smt(leq_trunc_div ge0_r). @@ -1569,8 +1568,7 @@ auto; progress; smt(leq_trunc_div ge0_r). (={i, x, bs, BlockSponge.BIRO.IRO.mp} /\ n{2} = (n1 + r - 1) %/ r ==> ={i, x, bs, BlockSponge.BIRO.IRO.mp})=> //; first progress; - exists BlockSponge.BIRO.IRO.mp{2}, [], 0, - ((n{1} + r - 1) %/ r), x{2}=> //); + exists BlockSponge.BIRO.IRO.mp{2} [] 0 ((n{1} + r - 1) %/ r) x{2}=> //); first last. while (={i, x, bs, BlockSponge.BIRO.IRO.mp} /\ n{2} = (n1 + r - 1) %/ r). @@ -1598,7 +1596,7 @@ transitivity{1} i{1} = n1 %/ r * r /\ i{2} = n1 %/ r /\ size bs{2} = n1 %/ r /\ bs{1} = blocks2bits bs{2} /\ eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1})=> //. -progress; exists HybridIROEager.mp{1}, (n1 %/ r), x{2}=> //. +progress; exists HybridIROEager.mp{1} (n1 %/ r) x{2}=> //. inline HybridIROEagerTrans.loop; sp; wp. while (={HybridIROEager.mp} /\ i{1} = i0{2} /\ bs{1} = bs0{2} /\ @@ -1614,7 +1612,7 @@ auto. auto. eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}) (={x, BlockSponge.BIRO.IRO.mp} /\ i{2} = 0 /\ bs{2} = [] ==> ={i, x, bs, BlockSponge.BIRO.IRO.mp})=> //; - first progress; exists BlockSponge.BIRO.IRO.mp{2}, x{2}=> //); + first progress; exists BlockSponge.BIRO.IRO.mp{2} x{2}=> //); last first. inline BlockSpongeTrans.loop; sp; wp. while @@ -1678,8 +1676,7 @@ transitivity{1} bs{1} = blocks2bits bs{2} /\ eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). progress; - exists HybridIROEager.mp{1}, (blocks2bits bs{2}), (size bs{2} * r), m{1}, - x{2}=> //. + exists HybridIROEager.mp{1} (blocks2bits bs{2}) (size bs{2} * r) m{1} x{2}=> //. progress; smt(take_cat). splitwhile{2} 1 : i < n1. seq 1 1 : @@ -1713,8 +1710,7 @@ transitivity{1} bs{1} = blocks2bits bs{2} /\ eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1})=> //. progress [-delta]; - exists HybridIROEager.mp{1}, (blocks2bits bs{2}), (size bs{2} * r), m{1}, - x{2}=> //. + exists HybridIROEager.mp{1} (blocks2bits bs{2}) (size bs{2} * r) m{1} x{2}=> //. inline HybridIROEagerTrans.next_block; sim. (transitivity{2} { (bs, i) <@ BlockSpongeTrans.next_block(x, i, bs); @@ -1727,7 +1723,7 @@ inline HybridIROEagerTrans.next_block; sim. (={bs, i, x, BlockSponge.BIRO.IRO.mp} ==> ={bs, i, x, BlockSponge.BIRO.IRO.mp})=> //; first progress [-delta]; - exists BlockSponge.BIRO.IRO.mp{2}, bs{2}, (size bs{2}), x{2}=> //); + exists BlockSponge.BIRO.IRO.mp{2} bs{2} (size bs{2}) x{2}=> //); last first. inline BlockSpongeTrans.next_block; sim. exists* i{2}; elim*=> i2. @@ -1751,7 +1747,7 @@ transitivity res{1} = (blocks2bits res{2}) /\ eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). move=> |> &1 &2 ? n_eq inv. -exists HybridIROEager.mp{1}, BlockSponge.BIRO.IRO.mp{2}, (xs{1}, n{1} * r). +exists HybridIROEager.mp{1} BlockSponge.BIRO.IRO.mp{2} (xs{1}, n{1} * r). move=> |>; by rewrite n_eq. progress; apply blocks2bitsK. by conseq HybridIROEager_f_g=> |> &1 &2 ? -> ?. diff --git a/proof/core/Gext.eca b/proof/core/Gext.eca index 0fe42ad..f467cc0 100644 --- a/proof/core/Gext.eca +++ b/proof/core/Gext.eca @@ -190,7 +190,7 @@ section. + inline *;auto=> &ml&mr[#]10!-> Hi Hhand -> /=. rewrite -dom_restr rng_restr /=;progress; 3:by smt ml=0. + rewrite rng_set !inE rem_id 1:/#;move:H0=>[/Hi[->|[x' h][]H1 H2]|->]//. - right;right;exists x', h;rewrite getP. + right;right;exists x' h;rewrite getP. by cut ->//:(h<> G1.chandle{mr});move:(Hhand h);rewrite in_dom H2 /#. by move:H0;rewrite dom_set !inE /#. seq 1 1: (={x,y,F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.paths,G1.chandle,FRO.m} /\ @@ -205,18 +205,18 @@ section. + rewrite /inv_ext1=>/H{H}[->//|[/in_rng[h]Hh|[[x1 x2] h [Hx Hh]]]]. + case (h = (oget G1.mh{2}.[(x{2}.`1, hx2{2})]).`2)=> [->>|Hneq]. + by left;rewrite Hh oget_some. - by right;exists x{2}, h;rewrite dom_set getP Hneq !inE. + by right;exists x{2} h;rewrite dom_set getP Hneq !inE. case (h = (oget G1.mh{2}.[(x{2}.`1, hx2{2})]).`2)=> [->>|Hneq]. + rewrite Hh /bad_ext oget_some /= <@ Hx;rewrite !inE. by move=>[|]/(mem_image snd)->. - right;exists (x1,x2), h;rewrite !dom_set getP Hneq //=. + right;exists (x1,x2) h;rewrite !dom_set getP Hneq //=. by move:Hx;rewrite !inE Hh=>-[]->. by move:H6 H2;rewrite /in_dom_with dom_set !inE /#. inline *;auto;progress;last by move:H3;rewrite dom_set !inE /#. rewrite /inv_ext1=> /H [->//|[/in_rng[h]Hh|[x' h [Hx Hh]]]]. - + right;exists x{2}, h;rewrite getP dom_set !inE /=. + + right;exists x{2} h;rewrite getP dom_set !inE /=. by move:(H0 h);rewrite in_dom Hh /#. - right;exists x', h;rewrite getP !dom_set !inE;split. + right;exists x' h;rewrite getP !dom_set !inE;split. + by move:Hx;rewrite !inE=>-[]->. by move:(H0 h);rewrite !in_dom Hh /#. @@ -231,7 +231,7 @@ section. + inline *;auto=> &ml&mr[#]9!-> Hi Hhand -> /=. rewrite -dom_restr rng_restr /=;progress; 3:by smt ml=0. + rewrite rng_set !inE rem_id 1:/#;move:H4=>[/Hi[->|[x' h][]HH1 HH2]|->]//. - right;right;exists x', h;rewrite getP. + right;right;exists x' h;rewrite getP. by cut ->//:(h<> G1.chandle{mr});move:(Hhand h);rewrite in_dom HH2 /#. by move:H4;rewrite dom_set !inE /#. if=>//. @@ -242,18 +242,18 @@ section. + rewrite /inv_ext1=>/H{H}[->//|[/in_rng[h]Hh|[[x1 x2] h [Hx Hh]]]]. + case (h = (oget G1.mhi{2}.[(x{2}.`1, hx2{2})]).`2)=> [->>|Hneq]. + by left;rewrite Hh oget_some. - by right;exists x{2}, h;rewrite !dom_set getP Hneq !inE. + by right;exists x{2} h;rewrite !dom_set getP Hneq !inE. case (h = (oget G1.mhi{2}.[(x{2}.`1, hx2{2})]).`2)=> [->>|Hneq]. + rewrite Hh /bad_ext oget_some /= <@ Hx;rewrite !inE. by move=>[|]/(mem_image snd)->. - right;exists (x1,x2), h;rewrite !dom_set getP Hneq //=. + right;exists (x1,x2) h;rewrite !dom_set getP Hneq //=. by move:Hx;rewrite !inE Hh=>-[]->. by move:H6 H2;rewrite /in_dom_with dom_set !inE /#. inline *;auto;progress;last by move:H3;rewrite dom_set !inE /#. rewrite /inv_ext1=> /H [->//|[/in_rng[h]Hh|[x' h [Hx Hh]]]]. - + right;exists x{2}, h;rewrite getP !dom_set !inE /=. + + right;exists x{2} h;rewrite getP !dom_set !inE /=. by move:(H0 h);rewrite in_dom Hh /#. - right;exists x', h;rewrite getP !dom_set !inE;split. + right;exists x' h;rewrite getP !dom_set !inE;split. + by move:Hx;rewrite !inE=>-[]->. by move:(H0 h);rewrite !in_dom Hh /#. @@ -269,10 +269,10 @@ section. rcondt{2} 3;1:by auto=>/#. auto=> &m1&m2 [#] 10!-> Hinv Hhand Hi _ _ /= ?->?->/=;split=>/= _;split. + move:Hinv;rewrite /inv_ext1=> H/H{H}[->//|[x h]];rewrite inE=>-[Hmem Hh]. - by right;exists x,h;rewrite !inE Hmem getP;smt w=in_dom. + by right;exists x h;rewrite !inE Hmem getP;smt w=in_dom. + by move=>h;rewrite dom_set !inE /#. + move:Hinv;rewrite /inv_ext1=> H/H{H}[->//|[x h]];rewrite inE=>-[Hmem Hh]. - by right;exists x,h;rewrite !inE Hmem getP;smt w=in_dom. + by right;exists x h;rewrite !inE Hmem getP;smt w=in_dom. by move=>h;rewrite dom_set !inE /#. (* **************** *) @@ -529,7 +529,7 @@ section EXT. rewrite drop0=>-[H|[x h][#]];1:by rewrite Hext // H. rewrite getP;case (h=h1)=> [/=->Hin->_ | Hneq ???]. + by right;apply (mem_image snd _ x). - by rewrite Hext 2://;right;exists x, h;rewrite Hneq. + by rewrite Hext 2://;right;exists x h;rewrite Hneq. wp; call (_: ={F.RO.m,FRO.m,G1.paths,G1.mh,G1.mhi,G1.m,G1.mi,G1.chandle,G1.bext, C.c} /\ inv_le G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2}). + proc;sp;if=> //. diff --git a/proof/core/Handle.eca b/proof/core/Handle.eca index 55fef06..b768aa4 100644 --- a/proof/core/Handle.eca +++ b/proof/core/Handle.eca @@ -153,6 +153,7 @@ module G1(D:DISTINGUISHER) = { }. (* -------------------------------------------------------------------------- *) +(** RELATIONAL: Map, Handle-Map and Handles are compatible **) inductive eqm_handles (hs : handles) (m : smap) (mh : hsmap) = | MH of (forall xa xc ya yc, m.[(xa,xc)] = Some (ya,yc) => @@ -167,6 +168,157 @@ inductive eqm_handles (hs : handles) (m : smap) (mh : hsmap) = /\ hs.[yh] = Some (yc,yf) /\ m.[(xa,xc)] = Some (ya,yc)). +(* Consequences of (xa,xc) \in (dom m) *) +lemma eqm_handles_m_some (hs : handles) (m : smap) (mh : hsmap) + xa xc ya yc: + huniq hs + => eqm_handles hs m mh + => m.[(xa,xc)] = Some (ya,yc) + => exists hx fx hy fy, + hs.[hx] = Some (xc,fx) + /\ hs.[hy] = Some (yc,fy) + /\ mh.[(xa,hx)] = Some (ya,hy). +proof. by move=> hs_huniq [] + _ m_xaxc - /(_ _ _ _ _ m_xaxc). qed. + +lemma eqm_handles_m_some_xy (hs : handles) (m : smap) (mh : hsmap) + xa xc ya yc hx fx hy fy: + huniq hs + => eqm_handles hs m mh + => m.[(xa,xc)] = Some (ya,yc) + => hs.[hx] = Some (xc,fx) + => hs.[hy] = Some (yc,fy) + => mh.[(xa,hx)] = Some (ya,hy). +proof. +move=> hs_huniq [] + _ m_xaxc hs_hx hs_hy - /(_ _ _ _ _ m_xaxc) [xh xf yh yf] [#]. +by move=> /(hs_huniq _ _ _ _ hs_hx) /= <<*> /(hs_huniq _ _ _ _ hs_hy) /= <<*>. +qed. + +lemma eqm_handles_m_some_x (hs : handles) (m : smap) (mh : hsmap) + xa xc ya yc hx fx: + huniq hs + => eqm_handles hs m mh + => m.[(xa,xc)] = Some (ya,yc) + => hs.[hx] = Some (xc,fx) + => exists hy fy, + hs.[hy] = Some (yc,fy) + /\ mh.[(xa,hx)] = Some (ya,hy). +proof. +move=> hs_huniq [] + _ m_xaxc hs_hx - /(_ _ _ _ _ m_xaxc) [xh xf yh yf] [#]. +by move=> /(hs_huniq _ _ _ _ hs_hx) /= <<*> hs_hy mh_xaxc; exists yh yf. +qed. + +lemma eqm_handles_m_some_y (hs : handles) (m : smap) (mh : hsmap) + xa xc ya yc hy fy: + huniq hs + => eqm_handles hs m mh + => m.[(xa,xc)] = Some (ya,yc) + => hs.[hy] = Some (yc,fy) + => exists hx fx, + hs.[hx] = Some (xc,fx) + /\ mh.[(xa,hx)] = Some (ya,hy). +proof. +move=> hs_huniq [] + _ m_xaxc hs_hy - /(_ _ _ _ _ m_xaxc) [xh xf yh yf] [#]. +by move=> hs_hx /(hs_huniq _ _ _ _ hs_hy) /= <<*> mh_xaxc; exists xh xf. +qed. + +(* Consequence of (xa,xc) \notin (dom m) *) +lemma eqm_handles_m_none_in_mh (hs : handles) (m : smap) (mh : hsmap) + xa xc ya yc hx: + eqm_handles hs m mh + => m.[(xa,xc)] = None + => mh.[(xa,hx)] = Some (ya,yc) + => (forall fx, hs.[hx] <> Some (xc,fx)). +proof. by move=> [] _ Hmh m_xaxc /Hmh [xc0 fx yc0 fy] [#] -> /#. qed. + +lemma eqm_handles_m_none_in_hs (hs : handles) (m : smap) (mh : hsmap) + xa xc hx fx: + eqm_handles hs m mh + => m.[(xa,xc)] = None + => hs.[hx] = Some (xc,fx) + => mh.[(xa,hx)] = None. +proof. +move=> [] _ Hmh m_xaxc. +case: {-1}(mh.[(xa,hx)]) (eq_refl (mh.[(xa,hx)]))=> [//|]. (* TODO: contra *) +by move=> [ya hy] /Hmh [xc0 fx0 yc fy] [#] /#. +qed. + +(* Consequence of (xa,hx) \in (dom mh) *) +lemma eqm_handles_mh_some (hs : handles) (m : smap) (mh : hsmap) + xa hx ya hy: + huniq hs + => eqm_handles hs m mh + => mh.[(xa,hx)] = Some (ya,hy) + => exists xc fx yc fy, + hs.[hx] = Some (xc,fx) + /\ hs.[hy] = Some (yc,fy) + /\ m.[(xa,xc)] = Some (ya,yc). +proof. by move=> hs_huniq [] _ + mh_xaxc - /(_ _ _ _ _ mh_xaxc). qed. + +lemma eqm_handles_mh_some_xy (hs : handles) (m : smap) (mh : hsmap) + xa hx ya hy xc fx yc fy: + huniq hs + => eqm_handles hs m mh + => mh.[(xa,hx)] = Some (ya,hy) + => hs.[hx] = Some (xc,fx) + => hs.[hy] = Some (yc,fy) + => m.[(xa,xc)] = Some (ya,yc). +proof. +move=> hs_huniq [] _ + mh_xaxc hs_hx hs_hy - /(_ _ _ _ _ mh_xaxc) [xc' xf' yc' yf'] [#]. +by rewrite hs_hx hs_hy /= => [#] <<*> [#] <<*>. +qed. + +lemma eqm_handles_mh_some_x (hs : handles) (m : smap) (mh : hsmap) + xa hx ya hy xc fx: + huniq hs + => eqm_handles hs m mh + => mh.[(xa,hx)] = Some (ya,hy) + => hs.[hx] = Some (xc,fx) + => exists yc fy, + hs.[hy] = Some (yc,fy) + /\ m.[(xa,xc)] = Some (ya,yc). +proof. +move=> hs_huniq [] _ + mh_xaxc hs_hx - /(_ _ _ _ _ mh_xaxc) [xc' fx' yc fy] [#]. +by rewrite hs_hx /= => [#] <<*> hs_hy m_xaxc; exists yc fy. +qed. + +lemma eqm_handles_mh_some_y (hs : handles) (m : smap) (mh : hsmap) + xa hx ya hy yc fy: + huniq hs + => eqm_handles hs m mh + => mh.[(xa,hx)] = Some (ya,hy) + => hs.[hy] = Some (yc,fy) + => exists xc fx, + hs.[hx] = Some (xc,fx) + /\ m.[(xa,xc)] = Some (ya,yc). +proof. +move=> hs_huniq [] _ + mh_xaxc hs_hy - /(_ _ _ _ _ mh_xaxc) [xc fx yc' fy'] [#] hs_hx. +by rewrite hs_hy /= => [#] <<*> m_xaxc; exists xc fx. +qed. + +(* Consequences of (xa,hx) \notin (dom mh) *) +lemma eqm_handles_mh_none_in_m (hs : handles) (m : smap) (mh : hsmap) + xa xc ya yc hx: + huniq hs + => eqm_handles hs m mh + => mh.[(xa,hx)] = None + => m.[(xa,xc)] = Some (ya,yc) + => (forall fx, hs.[hx] <> Some (xc,fx)). +proof. by move=> hs_huniq [] Hm _ mh_xaxc /Hm [hx0 fx hy0 fy] [#] /#. qed. + +lemma eqm_handles_mh_none_in_hs (hs : handles) (m : smap) (mh : hsmap) + xa hx xc fx: + huniq hs + => eqm_handles hs m mh + => mh.[(xa,hx)] = None + => hs.[hx] = Some (xc,fx) + => m.[(xa,xc)] = None. +proof. +move=> hs_huniq [] Hm _ m_xaxc. +case: {-1}(m.[(xa,xc)]) (eq_refl (m.[(xa,xc)]))=> [//|]. (* TODO: contra *) +by move=> [ya hy] /Hm [xc0 fx0 yc fy] [#] /#. +qed. + +(* WELL-FORMEDNESS<2>: Handles, Map, Handle-Map and RO are compatible *) inductive mh_spec (hs : handles) (m2 : smap) (mh : hsmap) (ro : (block list,block) fmap) = | H of (forall xa xh ya yh, mh.[(xa,xh)] = Some (ya,yh) => @@ -185,6 +337,99 @@ inductive mh_spec (hs : handles) (m2 : smap) (mh : hsmap) (ro : (block list,bloc build_hpath mh p = Some (v,xh) /\ mh.[(v +^ xa,xh)] = Some (b,yh)). +(* Consequences of (xa,hx) \in (dom mh) *) +lemma mh_spec_mh_some (hs : handles) (Gm : smap) (mh : hsmap) ro + xa hx ya hy: + mh_spec hs Gm mh ro + => mh.[(xa,hx)] = Some (ya,hy) + => exists xc fx yc fy, + hs.[hx] = Some (xc,fx) + /\ hs.[hy] = Some (yc,fy) + /\ if fy = Known + then Gm.[(xa,xc)] = Some (ya,yc) + /\ fx = Known + else exists p v, + ro.[rcons p (v +^ xa)] = Some ya + /\ build_hpath mh p = Some (v,hx). +proof. by move=> [] + _ mh_xaxc - /(_ _ _ _ _ mh_xaxc). qed. + +lemma mh_spec_mh_some_y (hs : handles) (Gm : smap) (mh : hsmap) ro + xa hx ya hy yc fy: + mh_spec hs Gm mh ro + => mh.[(xa,hx)] = Some (ya,hy) + => hs.[hy] = Some (yc,fy) + => exists xc fx, + hs.[hx] = Some (xc,fx) + /\ if fy = Known + then Gm.[(xa,xc)] = Some (ya,yc) + /\ fx = Known + else exists p v, + ro.[rcons p (v +^ xa)] = Some ya + /\ build_hpath mh p = Some (v,hx). +proof. +move=> Hmh /(mh_spec_mh_some _ _ _ _ _ _ _ _ Hmh) [xc fx yc0 fy0] [#] -> ->. +by move=> + [#] <<*> - H; exists xc fx. +qed. + +lemma mh_spec_mh_some_yK (hs : handles) (Gm : smap) (mh : hsmap) ro + xa hx ya hy yc: + mh_spec hs Gm mh ro + => mh.[(xa,hx)] = Some (ya,hy) + => hs.[hy] = Some (yc,Known) + => exists xc, + hs.[hx] = Some (xc,Known) + /\ Gm.[(xa,xc)] = Some (ya,yc). +proof. +move=> Hmh mh_xaxc /(mh_spec_mh_some_y _ _ _ _ _ _ _ _ _ _ Hmh mh_xaxc) [xc fx] [#] /=. +by move=> hs_hx Gm_xaxc <*>; exists xc. +qed. + +lemma mh_spec_mh_some_yU (hs : handles) (Gm : smap) (mh : hsmap) ro + xa hx ya hy yc: + mh_spec hs Gm mh ro + => mh.[(xa,hx)] = Some (ya,hy) + => hs.[hy] = Some (yc,Unknown) + => exists xc fx p v, + hs.[hx] = Some (xc,fx) + /\ ro.[rcons p (v +^ xa)] = Some ya + /\ build_hpath mh p = Some (v,hx). +proof. +move=> Hmh mh_xaxc /(mh_spec_mh_some_y _ _ _ _ _ _ _ _ _ _ Hmh mh_xaxc) [xc fx] [#] /=. +by move=> hs_hx [p v] H; exists xc fx p v. +qed. + +lemma mh_spec_mh_some_x (hs : handles) (Gm : smap) (mh : hsmap) ro + xa hx ya hy xc fx: + mh_spec hs Gm mh ro + => mh.[(xa,hx)] = Some (ya,hy) + => hs.[hx] = Some (xc,fx) + => exists yc fy, + hs.[hy] = Some (yc,fy) + /\ if fy = Known + then Gm.[(xa,xc)] = Some (ya,yc) + /\ fx = Known + else exists p v, + ro.[rcons p (v +^ xa)] = Some ya + /\ build_hpath mh p = Some (v,hx). +proof. +move=> Hmh /(mh_spec_mh_some _ _ _ _ _ _ _ _ Hmh) [xc0 fx0 yc fy] [#] -> ->. +by move=> + [#] <<*> - H; exists yc fy. +qed. + +lemma mh_spec_mh_some_xU (hs : handles) (Gm : smap) (mh : hsmap) ro + xa hx ya hy xc: + mh_spec hs Gm mh ro + => mh.[(xa,hx)] = Some (ya,hy) + => hs.[hx] = Some (xc,Unknown) + => exists yc p v, + hs.[hy] = Some (yc,Unknown) + /\ ro.[rcons p (v +^ xa)] = Some ya + /\ build_hpath mh p = Some (v,hx). +proof. +move=> Hmh mh_xaxc /(mh_spec_mh_some_x _ _ _ _ _ _ _ _ _ _ Hmh mh_xaxc) [yc fy] [#] ->. +by case: fy=> //= - [p v] H; exists yc p v. +qed. + inductive paths_spec (hs : handles) (mh : hsmap) (pi : (capacity,block list*block) fmap) = | P of (forall c p v, pi.[c] = Some (p,v) <=> @@ -197,6 +442,9 @@ inductive handles_spec hs ch = & (hs.[0] = Some (c0,Known)) & (forall h, mem (dom hs) h => h < ch). +inductive inverse_spec (m:('a,'b) fmap) mi = + | Is of (forall x y, m.[x] = Some y <=> mi.[y] = Some x). + inductive INV_CF_G1 (hs : handles) ch (m1 mi1 m2 mi2 : smap) (mh2 mhi2 : hsmap) (ro : (block list,block) fmap) pi = | HCF_G1 of (eqm_handles hs m1 mh2) @@ -292,11 +540,11 @@ lemma eqm_up_handles hs ch m mh x2 : proof. case=> Hu Hh0 Hlt [] m_some mh_some; split. + move=> xb xc xb' xc' /m_some [h h' f f'] [#] Hh Hh' Hmh. - exists h, h', f, f'; rewrite !getP Hmh -Hh -Hh' /=. + exists h h' f f'; rewrite !getP Hmh -Hh -Hh' /=. rewrite ltr_eqF /=; 1:by apply/Hlt; rewrite in_dom Hh. by rewrite ltr_eqF; 1:by apply/Hlt; rewrite in_dom Hh'. move=> xb xh xb' xh' /mh_some [c c' f f'] [#] Hh Hh' Hm. -exists c, c', f, f'; rewrite !getP Hm -Hh -Hh'. +exists c c' f f'; rewrite !getP Hm -Hh -Hh'. rewrite ltr_eqF /=; 1:by apply/Hlt; rewrite in_dom Hh. by rewrite ltr_eqF; 1:by apply/Hlt; rewrite in_dom Hh'. qed. @@ -307,7 +555,7 @@ lemma mh_up_handles hs ch m2 mh ro cf: mh_spec hs.[ch <- cf] m2 mh ro. proof. move=> + [] mh_some ?=> -[] _ _ Hlt; split=> // b h b' h' /mh_some [c c' f f'] [#] Hh Hh' Hif. -exists c,c',f,f'; rewrite Hif -Hh -Hh' !getP. +exists c c' f f'; rewrite Hif -Hh -Hh' !getP. rewrite ltr_eqF /=; 1:by apply/Hlt; rewrite in_dom Hh. by rewrite ltr_eqF; 1:by apply/Hlt; rewrite in_dom Hh'. qed. @@ -344,18 +592,18 @@ move=> Hx2 ^Hh [] Hu Hh0 Hlt; split. by move=> h; rewrite dom_set !inE /#. qed. -lemma INV_CF_G1_up_handles hs ch m1 mi1 m2 mi2 mh mhi ro pi x2: - INV_CF_G1 hs ch m1 mi1 m2 mi2 mh mhi ro pi => - (forall f, !mem (rng hs) (x2, f)) => - INV_CF_G1 hs.[ch <- (x2, Known)] (ch + 1) m1 mi1 m2 mi2 mh mhi ro pi. -proof. -case=> Heqm Heqmi Hincl Hincli Hmh Hp Hh Hx2. -exact/(HCF_G1 (eqm_up_handles Hh Heqm) (eqm_up_handles Hh Heqmi) - _ _ - (:@mh_up_handles _ _ _ _ _ (x2,Known) Hh Hmh) - (:@paths_up_handles m2 ro _ _ _ (x2,Known) _ Hmh Hh Hp) - (:@handles_up_handles _ _ x2 Known _ Hh)). -qed. +(* lemma INV_CF_G1_up_handles hs ch m1 mi1 m2 mi2 mh mhi ro pi x2: *) +(* INV_CF_G1 hs ch m1 mi1 m2 mi2 mh mhi ro pi => *) +(* (forall f, !mem (rng hs) (x2, f)) => *) +(* INV_CF_G1 hs.[ch <- (x2, Known)] (ch + 1) m1 mi1 m2 mi2 mh mhi ro pi. *) +(* proof. *) +(* case=> Heqm Heqmi Hincl Hincli Hmh Hp Hh Hx2. *) +(* exact/(HCF_G1 (eqm_up_handles Hh Heqm) (eqm_up_handles Hh Heqmi) *) +(* _ _ *) +(* (:@mh_up_handles _ _ _ _ _ (x2,Known) Hh Hmh) *) +(* (:@paths_up_handles m2 ro _ _ _ (x2,Known) _ Hmh Hh Hp) *) +(* (:@handles_up_handles _ _ x2 Known _ Hh)). *) +(* qed. *) (** Updating forward map **) lemma eqm_handles_up (hs : handles) m mh (h hx:handle) (x y : state) f: @@ -367,13 +615,13 @@ lemma eqm_handles_up (hs : handles) m mh (h hx:handle) (x y : state) f: proof. move=> uniq_h h_h h_hx @/eqm_handles [] hmmh hmhm; split. + move=> b c b' c'; rewrite getP; case ((b,c) = x)=> /= [<<- ->> {x y} /=|]. - * by exists hx, f, h, Known; rewrite !getP /= [smt (in_dom)]. + * by exists hx f h Known; rewrite !getP /= [smt (in_dom)]. move=> bc_neq_x /hmmh [] h0 f0 h0' f0' [#] h_h0 h_h0' mhi_bc. - by exists h0, f0, h0', f0'; rewrite !getP [smt (in_dom)]. + by exists h0 f0 h0' f0'; rewrite !getP [smt (in_dom)]. move=> xb xh b' h'; rewrite getP; case ((xb,xh) = (x.`1,hx))=> /= [[#] <*> [#] <*>|]. - * by exists x.`2, f, y.`2, Known; rewrite !getP [smt (in_dom)]. + * by exists x.`2 f y.`2 Known; rewrite !getP [smt (in_dom)]. rewrite anda_and negb_and=> bh_neq_x1hx /hmhm /= [] c0 f0 c0' f0' [#] h_h0 h_bh' m_bc. -exists c0, f0, c0', f0'; rewrite !getP. +exists c0 f0 c0' f0'; rewrite !getP. split; 1:smt (in_dom). split; 1:smt (in_dom). case x bh_neq_x1hx h_hx=> x1 x2 /= => - [/#|h0_neq_hx h_hx]. @@ -391,13 +639,13 @@ lemma eqmi_handles_up (hs : handles) mi mhi (h hx : handle) (x y : state) f: proof. move=> y_notinr1_handles h_h h_hx @/eqm_handles [] hmmh hmhm; split. + move=> xb xc xb' xc'; rewrite getP; case ((xb,xc) = y)=> /= [<<- ->> {x y}|]. - * by exists h, Known, hx, f; rewrite !getP /= [smt (in_dom)]. + * by exists h Known hx f; rewrite !getP /= [smt (in_dom)]. move=> bc_neq_y /hmmh [] h0 f0 h0' f0' [#] h_h0 h_h0' mhi_bc. - by exists h0, f0, h0', f0'; rewrite !getP [smt (in_dom)]. + by exists h0 f0 h0' f0'; rewrite !getP [smt (in_dom)]. move=> xb xh xb' xh'; rewrite getP; case ((xb,xh) = (y.`1,h))=> /= [[#] <*> [#] <*>|]. - * by exists y.`2, Known, x.`2, f; rewrite !getP [smt (in_dom)]. + * by exists y.`2 Known x.`2 f; rewrite !getP [smt (in_dom)]. rewrite anda_and negb_and=> bh_neq_y1h /hmhm /= [] c0 f0 c0' f0' [#] h_bh h_bh' mi_bh. -exists c0, f0, c0', f0'; rewrite !getP. +exists c0 f0 c0' f0'; rewrite !getP. split; 1:smt (in_dom). split; 1:smt (in_dom). case y bh_neq_y1h y_notinr1_handles=> y1 y2 /= [/#|h0_neq_h y_notinr1_handles]. @@ -463,7 +711,7 @@ proof. move=> [] mh_some _ [] hpaths ^paths_c. move=> /hpaths [h] [#] /build_hpathP [/#|] p' b' v' h' [#] ^/rconsIs + /rconssI- <*>. move=> hpath + handles_h - /mh_some /= [c' c0 f' f]; rewrite handles_h /= => /> handles_h' _. -by exists c', v'; rewrite hpaths; exists h'. +by exists c' v'; rewrite hpaths; exists h'. qed. lemma build_hpath_prefix mh p b v h: @@ -471,7 +719,7 @@ lemma build_hpath_prefix mh p b v h: (exists v' h', build_hpath mh p = Some (v',h') /\ mh.[(v' +^ b,h')] = Some (v,h)). proof. rewrite build_hpathP; split=> [[/#|p' b' v' h' [#] + Hhpath Hmh]|[v' h'] [] Hhpath Hmh]. -+ by move=> ^/rconsIs <<- {b'} /rconssI <<- {p'}; exists v', h'. ++ by move=> ^/rconsIs <<- {b'} /rconssI <<- {p'}; exists v' h'. exact/(Extend _ _ _ _ _ Hhpath Hmh). qed. @@ -485,7 +733,7 @@ lemma build_hpath_up mh xc xh yc yh p b h: proof. move=> xch_notin_mh @/build_hpath. have: (exists p' v h, build_hpath mh p' = Some (v +^ b0,h)). -+ by exists [], b0, 0; rewrite build_hpathP Block.xorw0; exact/Empty. ++ by exists [] b0 0; rewrite build_hpathP Block.xorw0; exact/Empty. pose root:= b0; elim: p root 0=> //= b1 p ih bn hn. rewrite /(step_hpath _ (Some _)) /= oget_some /= /(step_hpath _ (Some _)) /= oget_some /= getP. case: (mem (dom mh) (bn +^ b1,hn))=> [bnb1hn_in_mh extend_path|]. @@ -497,12 +745,12 @@ case: (mem (dom mh) (bn +^ b1,hn))=> [bnb1hn_in_mh extend_path|]. move=> [] b2 h2 mh_bnb1hn. apply/(@ih b2 h2). case: extend_path=> p' v hp' build_path. - by exists p', (v +^ bn +^ b2), hp'; rewrite build_path //= #ring. + by exists p' (v +^ bn +^ b2) hp'; rewrite build_path //= #ring. by rewrite in_dom /= => mh_bnb1hn _; rewrite mh_bnb1hn iter_step_path_from_None. qed. lemma build_hpath_down mh xc xh yc yh p v h: - 0 <> xh + xh <> 0 => (forall c' h' xc', mh.[(c',h')] <> Some (xc',xh)) => build_hpath mh.[(xc,xh) <- (yc,yh)] p = Some (v,h) => build_hpath mh p = Some (v,h). @@ -512,7 +760,7 @@ elim/last_ind: p v h=> [v h /build_hpathP [<*>|/#] //=|p b ih]. move=> v h /build_hpathP [/#|p' b' + + ^/rconsIs <<- /rconssI <<-]. move=> v' h' /ih; rewrite getP. case: ((v' +^ b,h') = (xc,xh))=> [[#] <*> + [#] <*>|_ Hpath Hmh]. -+ by move=> /build_hpathP [|] /#. ++ by move=> /build_hpathP [/#|] /#. exact/build_hpathP/(Extend _ _ _ _ _ Hpath Hmh). qed. @@ -555,36 +803,36 @@ move=> x2_neq_y2 PFm_x G1m_x pi_x2 x2_notin_hs y2_notin_hs Hinv; split. by move: (x2_notin_hs f1); rewrite in_rng negb_exists /= => ->. case: Hinv=> _ _ _ _ _ _ [] + _ _ _ _ - h. exact/(@h h1 h2 (c1,f1) (c2,f2)). - + by rewrite getP; case: Hinv=> _ _ _ _ _ _ [] _ _; smt (in_dom). + + by rewrite getP; case: Hinv=> _ _ _ _ _ _ []; smt (in_dom). + by rewrite getP. by apply/eqm_up_handles; case: Hinv. + apply/(@eqmi_handles_up hs.[ch <- (x2,Known)] PFmi G1mhi (ch + 1) ch (x1,x2) (y1,y2) Known). + rewrite negb_exists /= => f; rewrite in_rng negb_exists /= => h. rewrite getP; case: (h = ch)=> _; first by rewrite /= x2_neq_y2. by move: (y2_notin_hs f); rewrite in_rng negb_exists /= => ->. - + by rewrite getP; case: Hinv=> _ _ _ _ _ _ [] _ _; smt (in_dom). + + by rewrite getP; case: Hinv=> _ _ _ _ _ _ []; smt (in_dom). + by rewrite getP. by apply/eqm_up_handles; case: Hinv. + move=> z; rewrite !getP; case: (z = (x1,x2))=> //= _. by case: Hinv=> _ _ + _ _ _ _ - @/incl /(_ z). + move=> z; rewrite !getP; case: (z = (y1,y2))=> //= _. - by case: Hinv=> _ _ _ + _ _ _ - @/incl /(_ z). + by case: Hinv=> _ _ _ + - @/incl /(_ z). + split. + move=> xa xh ya yh; rewrite getP; case: ((xa,xh) = (x1,ch)). - + move=> /= [#] <*> [#] <*>; exists x2, Known, y2, Known=> //=. + + move=> /= [#] <*> [#] <*>; exists x2 Known y2 Known=> //=. by rewrite !getP /#. rewrite /= anda_and negb_and=> h hG1mh. (* This one needs cleaned up in priority. These are things that should be deduced instantly. *) have := Hinv=>- [] _ _ _ _ [] + _ _ _ - h0. have [xc xf yc yf] [#] hs_xh hs_yh ite:= h0 _ _ _ _ hG1mh. have yh_lt_ch: xh < ch by case: Hinv=> _ _ _ _ _ _ [] _ _ -> //; rewrite in_dom hs_xh. have xh_lt_ch: yh < ch by case: Hinv=> _ _ _ _ _ _ [] _ _ -> //; rewrite in_dom hs_yh. - exists xc, xf, yc, yf. + exists xc xf yc yf. split; first by smt (getP). split; first by smt (getP). split=> /=. + by move: ite=> <*> /= [#] hG1m -> //=; rewrite getP; case: ((xa,xc) = (x1,x2))=> [<*> /#|]. move: ite=> + hrw; move: hrw=> -> /= [p v] [#] ro_pv hpath. - exists p, v; rewrite ro_pv /=. + exists p v; rewrite ro_pv /=. apply/build_hpath_up=> //=; case: Hinv=> _ _ _ _ _ _ [] _ _ hh. rewrite -negP in_dom; case: {-1}(G1mh.[(x1,ch)]) (eq_refl (G1mh.[(x1,ch)]))=> [//=|[xa' xh']]. move=> /h0 [xc0 xf0 ? ?] [] + _. @@ -601,7 +849,7 @@ move=> x2_neq_y2 PFm_x G1m_x pi_x2 x2_notin_hs y2_notin_hs Hinv; split. by rewrite in_dom=> /= ->. have ch_notin_G1mh: forall cx, !mem (rng G1mh) (cx,ch). + move=> cx; rewrite in_rng negb_exists=> - [b0 h0] /=; rewrite -negP=> G1mh_cxch. - by case: Hinv=> - [] _ + _ _ _ _ _ [] _ _ + - /(_ ch) + /(_ _ _ _ _ G1mh_cxch) [xc xf yc yf] [#] _ hs_ch _ - /=; rewrite in_dom hs_ch. + by case: Hinv=> - [] _ + _ _ _ _ _ [] _ _ + - /(_ _ _ _ _ G1mh_cxch) [xc xf yc yf] [#] _ hs_ch _ /(_ ch) /=; rewrite in_dom hs_ch. split=> -[#]. + move=> hpath hG1mh. rewrite getP; case: ((v +^ xa,xh) = (x1,ch))=> [/#|_]. @@ -619,7 +867,7 @@ move=> x2_neq_y2 PFm_x G1m_x pi_x2 x2_notin_hs y2_notin_hs Hinv; split. have ht /ht {ht} /= -> //= := build_hpath_down G1mh x1 ch y1 (ch + 1) p v xh _ _. + by case: Hinv=> _ _ _ _ _ _ [] _ + +; smt (in_dom). by move=> c' h' xc'; move: (ch_notin_G1mh xc'); rewrite in_rng negb_exists /= => ->. -+ split=> c p v; have [] _ _ _ _ _ [] -> _:= Hinv. ++ split=> c p v; have [] _ _ _ _ _ [] -> _ := Hinv. apply/exists_iff=> h /=; split=> [#]. have ht /ht {ht} -> /= := build_hpath_up G1mh x1 ch y1 (ch +1) p v h _. + rewrite in_dom /=; case: {-1}(G1mh.[(x1,ch)]) (eq_refl (G1mh.[(x1,ch)]))=> [|[x1' xh'] G1mh_x1'xh'] //=. @@ -630,10 +878,10 @@ move=> x2_neq_y2 PFm_x G1m_x pi_x2 x2_notin_hs y2_notin_hs Hinv; split. by case: Hinv=> _ _ _ _ _ _ [] _ _ /(_ h); rewrite in_dom hs_h. have ch_notin_G1mh: forall cx, !mem (rng G1mh) (cx,ch). + move=> cx; rewrite in_rng negb_exists=> - [b0 h0] /=; rewrite -negP=> G1mh_cxch. - by case: Hinv=> - [] _ + _ _ _ _ _ [] _ _ + - /(_ ch) + /(_ _ _ _ _ G1mh_cxch) [xc xf yc yf] [#] _ hs_ch _ - /=; rewrite in_dom hs_ch. + by case: Hinv=> - [] _ + _ _ _ _ _ [] _ _ + - /(_ _ _ _ _ G1mh_cxch) [xc xf yc yf] [#] _ hs_ch _ /(_ ch) /=; rewrite in_dom hs_ch. have Sch_notin_G1mh: forall cx, !mem (rng G1mh) (cx,ch + 1). + move=> cx; rewrite in_rng negb_exists=> - [b0 h0] /=; rewrite -negP=> G1mh_cxch. - by case: Hinv=> - [] _ + _ _ _ _ _ [] _ _ + - /(_ (ch + 1)) + /(_ _ _ _ _ G1mh_cxch) [xc xf yc yf] [#] _ hs_ch _ - /=; rewrite in_dom hs_ch /#. + by case: Hinv=> - [] _ + _ _ _ _ _ [] _ _ + - /(_ _ _ _ _ G1mh_cxch) [xc xf yc yf] [#] _ hs_ch _ /(_ (ch + 1)) /=; rewrite in_dom hs_ch /#. have ht /ht {ht} /= := build_hpath_down G1mh x1 ch y1 (ch + 1) p v h _ _. + by case: Hinv=> _ _ _ _ _ _ [] _ + +; smt (in_dom). + by move=> c' h' xc'; move: (ch_notin_G1mh xc'); rewrite in_rng negb_exists /= => ->. @@ -653,6 +901,80 @@ apply/(@handles_up_handles hs.[ch <- (x2,Known)] (ch + 1) y2 Known). by apply/handles_up_handles=> //=; case: Hinv. qed. +lemma lemma2 hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi x1 x2 y1 y2 hx: + INV_CF_G1 hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi => + PFm.[(x1,x2)] = None => + G1m.[(x1,x2)] = None => + pi.[x2] = None => + hs.[hx] = Some (x2,Known) => + hinv hs y2 = None => + INV_CF_G1 hs.[ch <- (y2,Known)] (ch + 1) + PFm.[(x1,x2) <- (y1,y2)] PFmi.[(y1,y2) <- (x1,x2)] + G1m.[(x1,x2) <- (y1,y2)] G1mi.[(y1,y2) <- (x1,x2)] + G1mh.[(x1,hx) <- (y1,ch)] G1mhi.[(y1,ch) <- (x1,hx)] + ro pi. +proof. +move=> Hinv x1x2_notin_PFm x1x2_notin_G1m x2_notin_pi hs_hx y2_notinrng_hs. +split. ++ apply/(@eqm_handles_up _ _ _ _ _ (x1,x2) (y1,y2) Known). + + by case: Hinv=> _ _ _ _ _ _ []. + + by case: Hinv=> _ _ _ _ _ _ []; smt (in_dom). + + by rewrite hs_hx. + + by case: Hinv. ++ apply/(@eqmi_handles_up _ _ _ _ _ (x1,x2) (y1,y2) Known). + + move: y2_notinrng_hs=> /hinv_notin_rng y2_notinrng_hs. + rewrite negb_exists /= => f; rewrite in_rng negb_exists /= => h. + by rewrite y2_notinrng_hs. + + by case: Hinv=> _ _ _ _ _ _ []; smt (in_dom). + + by rewrite hs_hx. + + by case: Hinv. ++ move=> [xa xc]; rewrite !getP; case: ((xa,xc) = (x1,x2))=> //= _ h. + by case: Hinv=> _ _ ->. ++ move=> [xa xc]; rewrite !getP; case: ((xa,xc) = (y1,y2))=> //= _ h. + by case: Hinv=> _ _ _ ->. ++ split. + + move=> xa xh ya yh; rewrite getP; case: ((xa,xh) = (x1,hx))=> [[#] <*>> [#] <<*> /=|]. + + exists x2 Known y2 Known=> //=; rewrite !getP hs_hx /=. + by case: Hinv=> _ _ _ _ _ _ []; smt (in_dom). + move=> xaxh_neq_x1hx mh_xaxh. + have [] _ _ _ _ [] + _ _ _ - /(_ _ _ _ _ mh_xaxh):= Hinv. + move=> [xc xf yc] [] /= - [#] hs_xh hs_yh h. + + exists xc xf yc Unknown=> /=; rewrite !getP hs_xh hs_yh. + split; first by case: Hinv=> _ _ _ _ _ _ []; smt (in_dom). + split; first by case: Hinv=> _ _ _ _ _ _ []; smt (in_dom). + elim: h=> p v [#] Hro Hpath; exists p v; rewrite Hro /=. + apply/build_hpath_up=> //=. + rewrite in_dom -negP; case: {-1}(G1mh.[(x1,hx)]) (eq_refl G1mh.[(x1,hx)])=> [//=|[x' hx'] mh_x1hx]. + have [] [] _ /(_ _ _ _ _ mh_x1hx) + _ _ _ _ _ _:= Hinv. + by move=> [xc0 xf0 yc0 yf0] [#] <<*>; rewrite hs_hx => [#] <<*>; rewrite x1x2_notin_PFm. + move=> ->> {xf} /=; exists xc Known yc Known=> //=. + rewrite !getP. + have -> //=: (xa,xc) <> (x1,x2). + + move: xaxh_neq_x1hx; apply/contra=> [#] <*>> /=. + by case: Hinv=> _ _ _ _ _ _ [] /(_ xh hx _ _ hs_xh hs_hx). + by rewrite h; case: Hinv=> _ _ _ _ _ _ []; smt (in_dom). + move=> p xa b; have [] _ _ _ _ [] _ -> _ _ := Hinv. + apply/exists_iff=> v /=; apply/exists_iff=> xh /=; apply/exists_iff=> yh /=. + split=> -[#]. + + move=> hpath hG1mh; rewrite getP; case: ((v +^ xa,xh) = (x1,hx))=> [[#] <<*>|_]. + + have [] [] _ + _ _ _ _ _ _ -/(_ _ _ _ _ hG1mh):= Hinv. + by move=> [xc xf yc yf] [#]; rewrite hs_hx /= => [#] <<*>; rewrite x1x2_notin_PFm. + rewrite hG1mh //=. + apply/build_hpath_up=> //=; rewrite in_dom. + case: {-1}(G1mh.[(x1,hx)]) (eq_refl G1mh.[(x1,hx)])=> [//|[xa' xc'] G1mh_xaxc']. + have [] [] _ /(_ _ _ _ _ G1mh_xaxc') + _ _ _ _ _ _:= Hinv. + by move=> [xc xf yc yf] [#]; rewrite hs_hx=> [#] <<*>; rewrite x1x2_notin_PFm. + rewrite getP; case: ((v +^ xa,xh) = (x1,hx))=> [[#] <*> + [#] <*>|]. + + move=> /build_hpathP [<*> /=|]. + + have [] _ _ _ _ _ _ [] _ + _:= Hinv. + rewrite hs_hx => /= [#] <*>. + have [] _ _ _ _ _ [] /(_ c0 [] b0) /iffRL + _ := Hinv. + move=> /(_ _); 1:by exists 0=> /#. + by rewrite x2_notin_pi. + move=> p' b' v' h' ->> Hpath Hextend; split. + + apply/build_hpathP/(@Extend G1mh (rcons p' b') v hx p' b' v' h')=> //. +admitted. + clone export ConcreteF as ConcreteF1. section AUX. @@ -810,19 +1132,7 @@ section AUX. + by move=> &m; auto=> //= &hr [#] <*>; rewrite x1hx_notin_G1m. auto=> &1 &2 [#] !<<- -> -> !->> _ /= hinv_y2_none. rewrite getP /= oget_some /=. - admit. - (* lemma 2: - PFm.[(x1,x2)] = None => - G1m.[(x1,x2)] = None => - pi0.[x2] = None => - mem (rng hs (x2,Known) => - hinv hs y2 = None => - INV_CF_G1 hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi => - INV_CF_G1 hs.[ch <- (y2,Known)] (ch + 1) - PFm.[(x,1x2) <- (y1,y2)] PFmi.[(y1,y2) <- (x1,x2)] - G1m.[(x1,x2) <- (y1,y2)] G1mi.[(y1,y2) <- (x1,x2)] - G1mh.[(x1,hx) <- (y1,ch)] G1mhi.[(y1,ch) <- (x1,hx)] - ro pi. *) + exact/lemma2. move=> [p0 v0] ^ pi_x2. have [] _ _ _ _ _ [] -> _ [hx2] [#] Hpath hs_hx2:= inv0. rcondt{2} 1. by move=> &m; auto=> &hr [#] !<<- _ _ ->> /= _; rewrite in_dom pi_x2. rcondf{2} 6. From 32210ccebe05ad1225d70e9463464d53a2288e10 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Mon, 22 Aug 2016 21:48:40 +0100 Subject: [PATCH 205/525] Progress in Core proof. --- proof/core/Handle.eca | 1468 +++++++++++++++++++++-------------------- 1 file changed, 746 insertions(+), 722 deletions(-) diff --git a/proof/core/Handle.eca b/proof/core/Handle.eca index b768aa4..01d62d5 100644 --- a/proof/core/Handle.eca +++ b/proof/core/Handle.eca @@ -154,323 +154,325 @@ module G1(D:DISTINGUISHER) = { (* -------------------------------------------------------------------------- *) (** RELATIONAL: Map, Handle-Map and Handles are compatible **) -inductive eqm_handles (hs : handles) (m : smap) (mh : hsmap) = - | MH of (forall xa xc ya yc, - m.[(xa,xc)] = Some (ya,yc) => - exists xh xf yh yf, - hs.[xh] = Some (xc,xf) - /\ hs.[yh] = Some (yc,yf) - /\ mh.[(xa,xh)] = Some (ya,yh)) - & (forall xa xh ya yh, - mh.[(xa,xh)] = Some (ya,yh) => - exists xc xf yc yf, - hs.[xh] = Some (xc,xf) - /\ hs.[yh] = Some (yc,yf) - /\ m.[(xa,xc)] = Some (ya,yc)). - -(* Consequences of (xa,xc) \in (dom m) *) -lemma eqm_handles_m_some (hs : handles) (m : smap) (mh : hsmap) - xa xc ya yc: - huniq hs - => eqm_handles hs m mh - => m.[(xa,xc)] = Some (ya,yc) - => exists hx fx hy fy, - hs.[hx] = Some (xc,fx) - /\ hs.[hy] = Some (yc,fy) - /\ mh.[(xa,hx)] = Some (ya,hy). -proof. by move=> hs_huniq [] + _ m_xaxc - /(_ _ _ _ _ m_xaxc). qed. - -lemma eqm_handles_m_some_xy (hs : handles) (m : smap) (mh : hsmap) - xa xc ya yc hx fx hy fy: - huniq hs - => eqm_handles hs m mh - => m.[(xa,xc)] = Some (ya,yc) - => hs.[hx] = Some (xc,fx) - => hs.[hy] = Some (yc,fy) - => mh.[(xa,hx)] = Some (ya,hy). -proof. -move=> hs_huniq [] + _ m_xaxc hs_hx hs_hy - /(_ _ _ _ _ m_xaxc) [xh xf yh yf] [#]. -by move=> /(hs_huniq _ _ _ _ hs_hx) /= <<*> /(hs_huniq _ _ _ _ hs_hy) /= <<*>. -qed. - -lemma eqm_handles_m_some_x (hs : handles) (m : smap) (mh : hsmap) - xa xc ya yc hx fx: - huniq hs - => eqm_handles hs m mh - => m.[(xa,xc)] = Some (ya,yc) - => hs.[hx] = Some (xc,fx) - => exists hy fy, - hs.[hy] = Some (yc,fy) - /\ mh.[(xa,hx)] = Some (ya,hy). -proof. -move=> hs_huniq [] + _ m_xaxc hs_hx - /(_ _ _ _ _ m_xaxc) [xh xf yh yf] [#]. -by move=> /(hs_huniq _ _ _ _ hs_hx) /= <<*> hs_hy mh_xaxc; exists yh yf. -qed. - -lemma eqm_handles_m_some_y (hs : handles) (m : smap) (mh : hsmap) - xa xc ya yc hy fy: - huniq hs - => eqm_handles hs m mh - => m.[(xa,xc)] = Some (ya,yc) - => hs.[hy] = Some (yc,fy) - => exists hx fx, - hs.[hx] = Some (xc,fx) - /\ mh.[(xa,hx)] = Some (ya,hy). -proof. -move=> hs_huniq [] + _ m_xaxc hs_hy - /(_ _ _ _ _ m_xaxc) [xh xf yh yf] [#]. -by move=> hs_hx /(hs_huniq _ _ _ _ hs_hy) /= <<*> mh_xaxc; exists xh xf. -qed. +inductive m_mh (hs : handles) (m : smap) (mh : hsmap) = + | INV_m_mh of (forall xa xc ya yc, + m.[(xa,xc)] = Some (ya,yc) => + exists hx fx hy fy, + hs.[hx] = Some (xc,fx) + /\ hs.[hy] = Some (yc,fy) + /\ mh.[(xa,hx)] = Some (ya,hy)) + & (forall xa hx ya hy, + mh.[(xa,hx)] = Some (ya,hy) => + exists xc fx yc fy, + hs.[hx] = Some (xc,fx) + /\ hs.[hy] = Some (yc,fy) + /\ m.[(xa,xc)] = Some (ya,yc)). + +(* (* Consequences of (xa,xc) \in (dom m) *) *) +(* lemma eqm_handles_m_some (hs : handles) (m : smap) (mh : hsmap) *) +(* xa xc ya yc: *) +(* huniq hs *) +(* => eqm_handles hs m mh *) +(* => m.[(xa,xc)] = Some (ya,yc) *) +(* => exists hx fx hy fy, *) +(* hs.[hx] = Some (xc,fx) *) +(* /\ hs.[hy] = Some (yc,fy) *) +(* /\ mh.[(xa,hx)] = Some (ya,hy). *) +(* proof. by move=> hs_huniq [] + _ m_xaxc - /(_ _ _ _ _ m_xaxc). qed. *) + +(* lemma eqm_handles_m_some_xy (hs : handles) (m : smap) (mh : hsmap) *) +(* xa xc ya yc hx fx hy fy: *) +(* huniq hs *) +(* => eqm_handles hs m mh *) +(* => m.[(xa,xc)] = Some (ya,yc) *) +(* => hs.[hx] = Some (xc,fx) *) +(* => hs.[hy] = Some (yc,fy) *) +(* => mh.[(xa,hx)] = Some (ya,hy). *) +(* proof. *) +(* move=> hs_huniq [] + _ m_xaxc hs_hx hs_hy - /(_ _ _ _ _ m_xaxc) [xh xf yh yf] [#]. *) +(* by move=> /(hs_huniq _ _ _ _ hs_hx) /= <<*> /(hs_huniq _ _ _ _ hs_hy) /= <<*>. *) +(* qed. *) -(* Consequence of (xa,xc) \notin (dom m) *) -lemma eqm_handles_m_none_in_mh (hs : handles) (m : smap) (mh : hsmap) - xa xc ya yc hx: - eqm_handles hs m mh - => m.[(xa,xc)] = None - => mh.[(xa,hx)] = Some (ya,yc) - => (forall fx, hs.[hx] <> Some (xc,fx)). -proof. by move=> [] _ Hmh m_xaxc /Hmh [xc0 fx yc0 fy] [#] -> /#. qed. +(* lemma eqm_handles_m_some_x (hs : handles) (m : smap) (mh : hsmap) *) +(* xa xc ya yc hx fx: *) +(* huniq hs *) +(* => eqm_handles hs m mh *) +(* => m.[(xa,xc)] = Some (ya,yc) *) +(* => hs.[hx] = Some (xc,fx) *) +(* => exists hy fy, *) +(* hs.[hy] = Some (yc,fy) *) +(* /\ mh.[(xa,hx)] = Some (ya,hy). *) +(* proof. *) +(* move=> hs_huniq [] + _ m_xaxc hs_hx - /(_ _ _ _ _ m_xaxc) [xh xf yh yf] [#]. *) +(* by move=> /(hs_huniq _ _ _ _ hs_hx) /= <<*> hs_hy mh_xaxc; exists yh yf. *) +(* qed. *) -lemma eqm_handles_m_none_in_hs (hs : handles) (m : smap) (mh : hsmap) - xa xc hx fx: - eqm_handles hs m mh - => m.[(xa,xc)] = None - => hs.[hx] = Some (xc,fx) - => mh.[(xa,hx)] = None. -proof. -move=> [] _ Hmh m_xaxc. -case: {-1}(mh.[(xa,hx)]) (eq_refl (mh.[(xa,hx)]))=> [//|]. (* TODO: contra *) -by move=> [ya hy] /Hmh [xc0 fx0 yc fy] [#] /#. -qed. +(* lemma eqm_handles_m_some_y (hs : handles) (m : smap) (mh : hsmap) *) +(* xa xc ya yc hy fy: *) +(* huniq hs *) +(* => eqm_handles hs m mh *) +(* => m.[(xa,xc)] = Some (ya,yc) *) +(* => hs.[hy] = Some (yc,fy) *) +(* => exists hx fx, *) +(* hs.[hx] = Some (xc,fx) *) +(* /\ mh.[(xa,hx)] = Some (ya,hy). *) +(* proof. *) +(* move=> hs_huniq [] + _ m_xaxc hs_hy - /(_ _ _ _ _ m_xaxc) [xh xf yh yf] [#]. *) +(* by move=> hs_hx /(hs_huniq _ _ _ _ hs_hy) /= <<*> mh_xaxc; exists xh xf. *) +(* qed. *) -(* Consequence of (xa,hx) \in (dom mh) *) -lemma eqm_handles_mh_some (hs : handles) (m : smap) (mh : hsmap) - xa hx ya hy: - huniq hs - => eqm_handles hs m mh - => mh.[(xa,hx)] = Some (ya,hy) - => exists xc fx yc fy, - hs.[hx] = Some (xc,fx) - /\ hs.[hy] = Some (yc,fy) - /\ m.[(xa,xc)] = Some (ya,yc). -proof. by move=> hs_huniq [] _ + mh_xaxc - /(_ _ _ _ _ mh_xaxc). qed. - -lemma eqm_handles_mh_some_xy (hs : handles) (m : smap) (mh : hsmap) - xa hx ya hy xc fx yc fy: - huniq hs - => eqm_handles hs m mh - => mh.[(xa,hx)] = Some (ya,hy) - => hs.[hx] = Some (xc,fx) - => hs.[hy] = Some (yc,fy) - => m.[(xa,xc)] = Some (ya,yc). -proof. -move=> hs_huniq [] _ + mh_xaxc hs_hx hs_hy - /(_ _ _ _ _ mh_xaxc) [xc' xf' yc' yf'] [#]. -by rewrite hs_hx hs_hy /= => [#] <<*> [#] <<*>. -qed. +(* (* Consequence of (xa,xc) \notin (dom m) *) *) +(* lemma eqm_handles_m_none_in_mh (hs : handles) (m : smap) (mh : hsmap) *) +(* xa xc ya yc hx: *) +(* eqm_handles hs m mh *) +(* => m.[(xa,xc)] = None *) +(* => mh.[(xa,hx)] = Some (ya,yc) *) +(* => (forall fx, hs.[hx] <> Some (xc,fx)). *) +(* proof. by move=> [] _ Hmh m_xaxc /Hmh [xc0 fx yc0 fy] [#] -> /#. qed. *) + +(* lemma eqm_handles_m_none_in_hs (hs : handles) (m : smap) (mh : hsmap) *) +(* xa xc hx fx: *) +(* eqm_handles hs m mh *) +(* => m.[(xa,xc)] = None *) +(* => hs.[hx] = Some (xc,fx) *) +(* => mh.[(xa,hx)] = None. *) +(* proof. *) +(* move=> [] _ Hmh m_xaxc. *) +(* case: {-1}(mh.[(xa,hx)]) (eq_refl (mh.[(xa,hx)]))=> [//|]. (* TODO: contra *) *) +(* by move=> [ya hy] /Hmh [xc0 fx0 yc fy] [#] /#. *) +(* qed. *) -lemma eqm_handles_mh_some_x (hs : handles) (m : smap) (mh : hsmap) - xa hx ya hy xc fx: - huniq hs - => eqm_handles hs m mh - => mh.[(xa,hx)] = Some (ya,hy) - => hs.[hx] = Some (xc,fx) - => exists yc fy, - hs.[hy] = Some (yc,fy) - /\ m.[(xa,xc)] = Some (ya,yc). -proof. -move=> hs_huniq [] _ + mh_xaxc hs_hx - /(_ _ _ _ _ mh_xaxc) [xc' fx' yc fy] [#]. -by rewrite hs_hx /= => [#] <<*> hs_hy m_xaxc; exists yc fy. -qed. +(* (* Consequence of (xa,hx) \in (dom mh) *) *) +(* lemma eqm_handles_mh_some (hs : handles) (m : smap) (mh : hsmap) *) +(* xa hx ya hy: *) +(* huniq hs *) +(* => eqm_handles hs m mh *) +(* => mh.[(xa,hx)] = Some (ya,hy) *) +(* => exists xc fx yc fy, *) +(* hs.[hx] = Some (xc,fx) *) +(* /\ hs.[hy] = Some (yc,fy) *) +(* /\ m.[(xa,xc)] = Some (ya,yc). *) +(* proof. by move=> hs_huniq [] _ + mh_xaxc - /(_ _ _ _ _ mh_xaxc). qed. *) + +(* lemma eqm_handles_mh_some_xy (hs : handles) (m : smap) (mh : hsmap) *) +(* xa hx ya hy xc fx yc fy: *) +(* huniq hs *) +(* => eqm_handles hs m mh *) +(* => mh.[(xa,hx)] = Some (ya,hy) *) +(* => hs.[hx] = Some (xc,fx) *) +(* => hs.[hy] = Some (yc,fy) *) +(* => m.[(xa,xc)] = Some (ya,yc). *) +(* proof. *) +(* move=> hs_huniq [] _ + mh_xaxc hs_hx hs_hy - /(_ _ _ _ _ mh_xaxc) [xc' xf' yc' yf'] [#]. *) +(* by rewrite hs_hx hs_hy /= => [#] <<*> [#] <<*>. *) +(* qed. *) -lemma eqm_handles_mh_some_y (hs : handles) (m : smap) (mh : hsmap) - xa hx ya hy yc fy: - huniq hs - => eqm_handles hs m mh - => mh.[(xa,hx)] = Some (ya,hy) - => hs.[hy] = Some (yc,fy) - => exists xc fx, - hs.[hx] = Some (xc,fx) - /\ m.[(xa,xc)] = Some (ya,yc). -proof. -move=> hs_huniq [] _ + mh_xaxc hs_hy - /(_ _ _ _ _ mh_xaxc) [xc fx yc' fy'] [#] hs_hx. -by rewrite hs_hy /= => [#] <<*> m_xaxc; exists xc fx. -qed. +(* lemma eqm_handles_mh_some_x (hs : handles) (m : smap) (mh : hsmap) *) +(* xa hx ya hy xc fx: *) +(* huniq hs *) +(* => eqm_handles hs m mh *) +(* => mh.[(xa,hx)] = Some (ya,hy) *) +(* => hs.[hx] = Some (xc,fx) *) +(* => exists yc fy, *) +(* hs.[hy] = Some (yc,fy) *) +(* /\ m.[(xa,xc)] = Some (ya,yc). *) +(* proof. *) +(* move=> hs_huniq [] _ + mh_xaxc hs_hx - /(_ _ _ _ _ mh_xaxc) [xc' fx' yc fy] [#]. *) +(* by rewrite hs_hx /= => [#] <<*> hs_hy m_xaxc; exists yc fy. *) +(* qed. *) -(* Consequences of (xa,hx) \notin (dom mh) *) -lemma eqm_handles_mh_none_in_m (hs : handles) (m : smap) (mh : hsmap) - xa xc ya yc hx: - huniq hs - => eqm_handles hs m mh - => mh.[(xa,hx)] = None - => m.[(xa,xc)] = Some (ya,yc) - => (forall fx, hs.[hx] <> Some (xc,fx)). -proof. by move=> hs_huniq [] Hm _ mh_xaxc /Hm [hx0 fx hy0 fy] [#] /#. qed. +(* lemma eqm_handles_mh_some_y (hs : handles) (m : smap) (mh : hsmap) *) +(* xa hx ya hy yc fy: *) +(* huniq hs *) +(* => eqm_handles hs m mh *) +(* => mh.[(xa,hx)] = Some (ya,hy) *) +(* => hs.[hy] = Some (yc,fy) *) +(* => exists xc fx, *) +(* hs.[hx] = Some (xc,fx) *) +(* /\ m.[(xa,xc)] = Some (ya,yc). *) +(* proof. *) +(* move=> hs_huniq [] _ + mh_xaxc hs_hy - /(_ _ _ _ _ mh_xaxc) [xc fx yc' fy'] [#] hs_hx. *) +(* by rewrite hs_hy /= => [#] <<*> m_xaxc; exists xc fx. *) +(* qed. *) -lemma eqm_handles_mh_none_in_hs (hs : handles) (m : smap) (mh : hsmap) - xa hx xc fx: - huniq hs - => eqm_handles hs m mh - => mh.[(xa,hx)] = None - => hs.[hx] = Some (xc,fx) - => m.[(xa,xc)] = None. -proof. -move=> hs_huniq [] Hm _ m_xaxc. -case: {-1}(m.[(xa,xc)]) (eq_refl (m.[(xa,xc)]))=> [//|]. (* TODO: contra *) -by move=> [ya hy] /Hm [xc0 fx0 yc fy] [#] /#. -qed. +(* (* Consequences of (xa,hx) \notin (dom mh) *) *) +(* lemma eqm_handles_mh_none_in_m (hs : handles) (m : smap) (mh : hsmap) *) +(* xa xc ya yc hx: *) +(* huniq hs *) +(* => eqm_handles hs m mh *) +(* => mh.[(xa,hx)] = None *) +(* => m.[(xa,xc)] = Some (ya,yc) *) +(* => (forall fx, hs.[hx] <> Some (xc,fx)). *) +(* proof. by move=> hs_huniq [] Hm _ mh_xaxc /Hm [hx0 fx hy0 fy] [#] /#. qed. *) + +(* lemma eqm_handles_mh_none_in_hs (hs : handles) (m : smap) (mh : hsmap) *) +(* xa hx xc fx: *) +(* huniq hs *) +(* => eqm_handles hs m mh *) +(* => mh.[(xa,hx)] = None *) +(* => hs.[hx] = Some (xc,fx) *) +(* => m.[(xa,xc)] = None. *) +(* proof. *) +(* move=> hs_huniq [] Hm _ m_xaxc. *) +(* case: {-1}(m.[(xa,xc)]) (eq_refl (m.[(xa,xc)]))=> [//|]. (* TODO: contra *) *) +(* by move=> [ya hy] /Hm [xc0 fx0 yc fy] [#] /#. *) +(* qed. *) (* WELL-FORMEDNESS<2>: Handles, Map, Handle-Map and RO are compatible *) -inductive mh_spec (hs : handles) (m2 : smap) (mh : hsmap) (ro : (block list,block) fmap) = - | H of (forall xa xh ya yh, - mh.[(xa,xh)] = Some (ya,yh) => - exists xc xf yc yf, - hs.[xh] = Some (xc,xf) - /\ hs.[yh] = Some (yc,yf) - /\ if yf = Known - then m2.[(xa,xc)] = Some (ya,yc) - /\ xf = Known - else exists p v, - ro.[rcons p (v +^ xa)] = Some ya - /\ build_hpath mh p = Some (v,xh)) - & (forall p xa b, - ro.[rcons p xa] = Some b <=> - exists v xh yh, - build_hpath mh p = Some (v,xh) - /\ mh.[(v +^ xa,xh)] = Some (b,yh)). - -(* Consequences of (xa,hx) \in (dom mh) *) -lemma mh_spec_mh_some (hs : handles) (Gm : smap) (mh : hsmap) ro - xa hx ya hy: - mh_spec hs Gm mh ro - => mh.[(xa,hx)] = Some (ya,hy) - => exists xc fx yc fy, - hs.[hx] = Some (xc,fx) - /\ hs.[hy] = Some (yc,fy) - /\ if fy = Known - then Gm.[(xa,xc)] = Some (ya,yc) - /\ fx = Known - else exists p v, - ro.[rcons p (v +^ xa)] = Some ya - /\ build_hpath mh p = Some (v,hx). -proof. by move=> [] + _ mh_xaxc - /(_ _ _ _ _ mh_xaxc). qed. - -lemma mh_spec_mh_some_y (hs : handles) (Gm : smap) (mh : hsmap) ro - xa hx ya hy yc fy: - mh_spec hs Gm mh ro - => mh.[(xa,hx)] = Some (ya,hy) - => hs.[hy] = Some (yc,fy) - => exists xc fx, - hs.[hx] = Some (xc,fx) - /\ if fy = Known - then Gm.[(xa,xc)] = Some (ya,yc) - /\ fx = Known - else exists p v, - ro.[rcons p (v +^ xa)] = Some ya - /\ build_hpath mh p = Some (v,hx). -proof. -move=> Hmh /(mh_spec_mh_some _ _ _ _ _ _ _ _ Hmh) [xc fx yc0 fy0] [#] -> ->. -by move=> + [#] <<*> - H; exists xc fx. -qed. +inductive mh_spec (hs : handles) (Gm : smap) (mh : hsmap) (ro : (block list,block) fmap) = + | INV_mh of (forall xa hx ya hy, + mh.[(xa,hx)] = Some (ya,hy) => + exists xc fx yc fy, + hs.[hx] = Some (xc,fx) + /\ hs.[hy] = Some (yc,fy) + /\ if fy = Known + then Gm.[(xa,xc)] = Some (ya,yc) + /\ fx = Known + else exists p v, + ro.[rcons p (v +^ xa)] = Some ya + /\ build_hpath mh p = Some (v,hx)) + & (forall p bn b, + ro.[rcons p bn] = Some b <=> + exists v hx hy, + build_hpath mh p = Some (v,hx) + /\ mh.[(v +^ bn,hx)] = Some (b,hy)). + +(* (* Consequences of (xa,hx) \in (dom mh) *) *) +(* lemma mh_spec_mh_some (hs : handles) (Gm : smap) (mh : hsmap) ro *) +(* xa hx ya hy: *) +(* mh_spec hs Gm mh ro *) +(* => mh.[(xa,hx)] = Some (ya,hy) *) +(* => exists xc fx yc fy, *) +(* hs.[hx] = Some (xc,fx) *) +(* /\ hs.[hy] = Some (yc,fy) *) +(* /\ if fy = Known *) +(* then Gm.[(xa,xc)] = Some (ya,yc) *) +(* /\ fx = Known *) +(* else exists p v, *) +(* ro.[rcons p (v +^ xa)] = Some ya *) +(* /\ build_hpath mh p = Some (v,hx). *) +(* proof. by move=> [] + _ mh_xaxc - /(_ _ _ _ _ mh_xaxc). qed. *) + +(* lemma mh_spec_mh_some_y (hs : handles) (Gm : smap) (mh : hsmap) ro *) +(* xa hx ya hy yc fy: *) +(* mh_spec hs Gm mh ro *) +(* => mh.[(xa,hx)] = Some (ya,hy) *) +(* => hs.[hy] = Some (yc,fy) *) +(* => exists xc fx, *) +(* hs.[hx] = Some (xc,fx) *) +(* /\ if fy = Known *) +(* then Gm.[(xa,xc)] = Some (ya,yc) *) +(* /\ fx = Known *) +(* else exists p v, *) +(* ro.[rcons p (v +^ xa)] = Some ya *) +(* /\ build_hpath mh p = Some (v,hx). *) +(* proof. *) +(* move=> Hmh /(mh_spec_mh_some _ _ _ _ _ _ _ _ Hmh) [xc fx yc0 fy0] [#] -> ->. *) +(* by move=> + [#] <<*> - H; exists xc fx. *) +(* qed. *) -lemma mh_spec_mh_some_yK (hs : handles) (Gm : smap) (mh : hsmap) ro - xa hx ya hy yc: - mh_spec hs Gm mh ro - => mh.[(xa,hx)] = Some (ya,hy) - => hs.[hy] = Some (yc,Known) - => exists xc, - hs.[hx] = Some (xc,Known) - /\ Gm.[(xa,xc)] = Some (ya,yc). -proof. -move=> Hmh mh_xaxc /(mh_spec_mh_some_y _ _ _ _ _ _ _ _ _ _ Hmh mh_xaxc) [xc fx] [#] /=. -by move=> hs_hx Gm_xaxc <*>; exists xc. -qed. +(* lemma mh_spec_mh_some_yK (hs : handles) (Gm : smap) (mh : hsmap) ro *) +(* xa hx ya hy yc: *) +(* mh_spec hs Gm mh ro *) +(* => mh.[(xa,hx)] = Some (ya,hy) *) +(* => hs.[hy] = Some (yc,Known) *) +(* => exists xc, *) +(* hs.[hx] = Some (xc,Known) *) +(* /\ Gm.[(xa,xc)] = Some (ya,yc). *) +(* proof. *) +(* move=> Hmh mh_xaxc /(mh_spec_mh_some_y _ _ _ _ _ _ _ _ _ _ Hmh mh_xaxc) [xc fx] [#] /=. *) +(* by move=> hs_hx Gm_xaxc <*>; exists xc. *) +(* qed. *) -lemma mh_spec_mh_some_yU (hs : handles) (Gm : smap) (mh : hsmap) ro - xa hx ya hy yc: - mh_spec hs Gm mh ro - => mh.[(xa,hx)] = Some (ya,hy) - => hs.[hy] = Some (yc,Unknown) - => exists xc fx p v, - hs.[hx] = Some (xc,fx) - /\ ro.[rcons p (v +^ xa)] = Some ya - /\ build_hpath mh p = Some (v,hx). -proof. -move=> Hmh mh_xaxc /(mh_spec_mh_some_y _ _ _ _ _ _ _ _ _ _ Hmh mh_xaxc) [xc fx] [#] /=. -by move=> hs_hx [p v] H; exists xc fx p v. -qed. +(* lemma mh_spec_mh_some_yU (hs : handles) (Gm : smap) (mh : hsmap) ro *) +(* xa hx ya hy yc: *) +(* mh_spec hs Gm mh ro *) +(* => mh.[(xa,hx)] = Some (ya,hy) *) +(* => hs.[hy] = Some (yc,Unknown) *) +(* => exists xc fx p v, *) +(* hs.[hx] = Some (xc,fx) *) +(* /\ ro.[rcons p (v +^ xa)] = Some ya *) +(* /\ build_hpath mh p = Some (v,hx). *) +(* proof. *) +(* move=> Hmh mh_xaxc /(mh_spec_mh_some_y _ _ _ _ _ _ _ _ _ _ Hmh mh_xaxc) [xc fx] [#] /=. *) +(* by move=> hs_hx [p v] H; exists xc fx p v. *) +(* qed. *) -lemma mh_spec_mh_some_x (hs : handles) (Gm : smap) (mh : hsmap) ro - xa hx ya hy xc fx: - mh_spec hs Gm mh ro - => mh.[(xa,hx)] = Some (ya,hy) - => hs.[hx] = Some (xc,fx) - => exists yc fy, - hs.[hy] = Some (yc,fy) - /\ if fy = Known - then Gm.[(xa,xc)] = Some (ya,yc) - /\ fx = Known - else exists p v, - ro.[rcons p (v +^ xa)] = Some ya - /\ build_hpath mh p = Some (v,hx). -proof. -move=> Hmh /(mh_spec_mh_some _ _ _ _ _ _ _ _ Hmh) [xc0 fx0 yc fy] [#] -> ->. -by move=> + [#] <<*> - H; exists yc fy. -qed. +(* lemma mh_spec_mh_some_x (hs : handles) (Gm : smap) (mh : hsmap) ro *) +(* xa hx ya hy xc fx: *) +(* mh_spec hs Gm mh ro *) +(* => mh.[(xa,hx)] = Some (ya,hy) *) +(* => hs.[hx] = Some (xc,fx) *) +(* => exists yc fy, *) +(* hs.[hy] = Some (yc,fy) *) +(* /\ if fy = Known *) +(* then Gm.[(xa,xc)] = Some (ya,yc) *) +(* /\ fx = Known *) +(* else exists p v, *) +(* ro.[rcons p (v +^ xa)] = Some ya *) +(* /\ build_hpath mh p = Some (v,hx). *) +(* proof. *) +(* move=> Hmh /(mh_spec_mh_some _ _ _ _ _ _ _ _ Hmh) [xc0 fx0 yc fy] [#] -> ->. *) +(* by move=> + [#] <<*> - H; exists yc fy. *) +(* qed. *) -lemma mh_spec_mh_some_xU (hs : handles) (Gm : smap) (mh : hsmap) ro - xa hx ya hy xc: - mh_spec hs Gm mh ro - => mh.[(xa,hx)] = Some (ya,hy) - => hs.[hx] = Some (xc,Unknown) - => exists yc p v, - hs.[hy] = Some (yc,Unknown) - /\ ro.[rcons p (v +^ xa)] = Some ya - /\ build_hpath mh p = Some (v,hx). -proof. -move=> Hmh mh_xaxc /(mh_spec_mh_some_x _ _ _ _ _ _ _ _ _ _ Hmh mh_xaxc) [yc fy] [#] ->. -by case: fy=> //= - [p v] H; exists yc p v. -qed. +(* lemma mh_spec_mh_some_xU (hs : handles) (Gm : smap) (mh : hsmap) ro *) +(* xa hx ya hy xc: *) +(* mh_spec hs Gm mh ro *) +(* => mh.[(xa,hx)] = Some (ya,hy) *) +(* => hs.[hx] = Some (xc,Unknown) *) +(* => exists yc p v, *) +(* hs.[hy] = Some (yc,Unknown) *) +(* /\ ro.[rcons p (v +^ xa)] = Some ya *) +(* /\ build_hpath mh p = Some (v,hx). *) +(* proof. *) +(* move=> Hmh mh_xaxc /(mh_spec_mh_some_x _ _ _ _ _ _ _ _ _ _ Hmh mh_xaxc) [yc fy] [#] ->. *) +(* by case: fy=> //= - [p v] H; exists yc p v. *) +(* qed. *) -inductive paths_spec (hs : handles) (mh : hsmap) (pi : (capacity,block list*block) fmap) = - | P of (forall c p v, - pi.[c] = Some (p,v) <=> - exists h, - build_hpath mh p = Some(v,h) - /\ hs.[h] = Some (c,Known)). - -inductive handles_spec hs ch = - | Hs of (huniq hs) - & (hs.[0] = Some (c0,Known)) - & (forall h, mem (dom hs) h => h < ch). - -inductive inverse_spec (m:('a,'b) fmap) mi = - | Is of (forall x y, m.[x] = Some y <=> mi.[y] = Some x). - -inductive INV_CF_G1 (hs : handles) ch (m1 mi1 m2 mi2 : smap) - (mh2 mhi2 : hsmap) (ro : (block list,block) fmap) pi = - | HCF_G1 of (eqm_handles hs m1 mh2) - & (eqm_handles hs mi1 mhi2) - & (incl m2 m1) - & (incl mi2 mi1) - & (mh_spec hs m2 mh2 ro) - & (paths_spec hs mh2 pi) - & (handles_spec hs ch). - -lemma eqm_of_INV (ch : handle) - (mi1 m2 mi2 : smap) (mhi2 : hsmap) - (ro : (block list, block) fmap) - (pi : (capacity, block list * block) fmap) - hs m1 mh2: +inductive pi_spec (hs : handles) (mh : hsmap) (pi : (capacity,block list * block) fmap) = + | INV_pi of (forall c p v, + pi.[c] = Some (p,v) <=> + exists h, + build_hpath mh p = Some(v,h) + /\ hs.[h] = Some (c,Known)). + +inductive hs_spec hs ch = + | INV_hs of (huniq hs) + & (hs.[0] = Some (c0,Known)) + & (forall cf h, hs.[h] = Some cf => h < ch). + +inductive inv_spec (m:('a,'b) fmap) mi = + | INV_inv of (forall x y, m.[x] = Some y <=> mi.[y] = Some x). + +inductive INV_CF_G1 (hs : handles) ch (Pm Pmi Gm Gmi : smap) + (mh mhi : hsmap) (ro : (block list,block) fmap) pi = + | HCF_G1 of (hs_spec hs ch) +(* & (inv_spec mh mhi) *) + & (m_mh hs Pm mh) + & (m_mh hs Pmi mhi) + & (incl Gm Pm) + & (incl Gmi Pmi) + & (mh_spec hs Gm mh ro) + & (pi_spec hs mh pi). + +(** Structural Projections **) +lemma m_mh_of_INV (ch : handle) + (mi1 m2 mi2 : smap) (mhi2 : hsmap) + (ro : (block list, block) fmap) + (pi : (capacity, block list * block) fmap) + hs m1 mh2: INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi => - eqm_handles hs m1 mh2. + m_mh hs m1 mh2. proof. by case. qed. -lemma eqmi_of_INV (ch : handle) - (m1 m2 mi2 : smap) (mh2 : hsmap) - (ro : (block list, block) fmap) - (pi : (capacity, block list * block) fmap) - hs mi1 mhi2: +lemma mi_mhi_of_INV (ch : handle) + (m1 m2 mi2 : smap) (mh2 : hsmap) + (ro : (block list, block) fmap) + (pi : (capacity, block list * block) fmap) + hs mi1 mhi2: INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi => - eqm_handles hs mi1 mhi2. + m_mh hs mi1 mhi2. proof. by case. qed. lemma incl_of_INV (hs : handles) (ch : handle) @@ -499,196 +501,280 @@ lemma mh_of_INV (ch : handle) mh_spec hs m2 mh2 ro. proof. by case. qed. -lemma paths_of_INV (ch : handle) - (m1 m2 mi1 mi2: smap) (mhi2: hsmap) - (ro : (block list, block) fmap) - hs mh2 pi: +lemma pi_of_INV (ch : handle) + (m1 m2 mi1 mi2: smap) (mhi2: hsmap) + (ro : (block list, block) fmap) + hs mh2 pi: INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi => - paths_spec hs mh2 pi. + pi_spec hs mh2 pi. proof. by case. qed. -lemma handles_of_INV (m1 m2 mi1 mi2 : smap) (mh2 mhi2 : hsmap) - (ro : (block list, block) fmap) - (pi : (capacity, block list * block) fmap) - hs ch: +lemma hs_of_INV (m1 m2 mi1 mi2 : smap) (mh2 mhi2 : hsmap) + (ro : (block list, block) fmap) + (pi : (capacity, block list * block) fmap) + hs ch: INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi => - handles_spec hs ch. + hs_spec hs ch. proof. by case. qed. -(** ?? **) -lemma eqm_dom_mh_m hs m mh hx2 f (x:state): - eqm_handles hs m mh => - hs.[hx2] = Some (x.`2, f) => - mem (dom mh) (x.`1, hx2) => mem (dom m) x. +(* lemma inv_of_INV hs ch m1 mi1 m2 mi2 ro pi *) +(* mh2 mhi2: *) +(* INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi => *) +(* inv_spec mh2 mhi2. *) +(* proof. by case. qed. *) + +(** Useful Lemmas **) +lemma ch_gt0 hs ch : hs_spec hs ch => 0 < ch. +proof. by case=> _ + Hlt -/Hlt. qed. + +lemma ch_neq0 hs ch : hs_spec hs ch => 0 <> ch. +proof. by move=> /ch_gt0/ltr_eqF. qed. + +lemma ch_notin_dom_hs hs ch: hs_spec hs ch => hs.[ch] = None. +proof. +by move=> [] _ _ dom_hs; case: {-1}(hs.[ch]) (eq_refl hs.[ch])=> [//|cf/dom_hs]. +qed. + +lemma Sch_notin_dom_hs hs ch: hs_spec hs ch => hs.[ch + 1] = None. +proof. +by move=> [] _ _ dom_hs; case: {-1}(hs.[ch + 1]) (eq_refl hs.[ch + 1])=> [//|cg/dom_hs/#]. +qed. + +lemma ch_notin_dom2_mh hs m mh xa ch: + m_mh hs m mh + => hs_spec hs ch + => mh.[(xa,ch)] = None. +proof. +move=> [] Hm_mh Hmh_m [] _ _ dom_hs. +case: {-1}(mh.[(xa,ch)]) (eq_refl mh.[(xa,ch)])=> [//=|[ya hy] /Hmh_m]. +by move=> [xc0 fx0 yc fy] [#] /dom_hs. +qed. + +lemma Sch_notin_dom2_mh hs m mh xa ch: + m_mh hs m mh + => hs_spec hs ch + => mh.[(xa,ch + 1)] = None. proof. -move=>[]H1 H2 Hhx2;rewrite !in_dom. -case: (mh.[_]) (H2 x.`1 hx2) => //= -[] b' h' /(_ b' h') [c c' f1 f1']. -by rewrite Hhx2=> /= -[][]<<- _;case:(x)=> ??[]_->. +move=> [] Hm_mh Hmh_m [] _ _ dom_hs. +case: {-1}(mh.[(xa,ch + 1)]) (eq_refl mh.[(xa,ch + 1)])=> [//=|[ya hy] /Hmh_m]. +by move=> [xc0 fx0 yc fy] [#] /dom_hs /#. qed. -lemma chandle_ge0 hs ch : handles_spec hs ch => 0 < ch. -proof. by case=> _ Heq Hlt; apply Hlt; rewrite in_dom Heq. qed. +lemma dom_hs_neq_ch hs ch hx xc fx: + hs_spec hs ch + => hs.[hx] = Some (xc,fx) + => hx <> ch. +proof. by move=> [] _ _ dom_hs /dom_hs /#. qed. -lemma chandle_0 hs ch : handles_spec hs ch => 0 <> ch. -proof. by move=> Hh;apply/ltr_eqF/(@chandle_ge0 _ _ Hh). qed. +lemma dom_hs_neq_Sch hs ch hx xc fx: + hs_spec hs ch + => hs.[hx] = Some(xc,fx) + => hx <> ch + 1. +proof. by move=> [] _ _ dom_hs /dom_hs /#. qed. -(** Adding handles **) -lemma eqm_up_handles hs ch m mh x2 : - handles_spec hs ch => - eqm_handles hs m mh => - eqm_handles hs.[ch <- (x2, Known)] m mh. +lemma notin_m_notin_mh hs m mh xa xc hx fx: + m_mh hs m mh + => m.[(xa,xc)] = None + => hs.[hx] = Some (xc,fx) + => mh.[(xa,hx)] = None. +proof. +move=> [] _ Hmh_m m_xaxc hs_hx; case: {-1}(mh.[(xa,hx)]) (eq_refl mh.[(xa,hx)])=> [//|]. +by move=> [ya hy] /Hmh_m [xc0 fx0 yc0 fy0] [#]; rewrite hs_hx=> [#] <*>; rewrite m_xaxc. +qed. + +lemma notin_m_notin_Gm (m Gm : ('a,'b) fmap) x: + incl Gm m + => m.[x] = None + => Gm.[x] = None. +proof. by move=> Gm_leq_m; apply/contraLR=> ^ /Gm_leq_m ->. qed. + +lemma notin_hs_notin_dom2_mh hs m mh xa hx: + m_mh hs m mh + => hs.[hx] = None + => mh.[(xa,hx)] = None. proof. -case=> Hu Hh0 Hlt [] m_some mh_some; split. -+ move=> xb xc xb' xc' /m_some [h h' f f'] [#] Hh Hh' Hmh. - exists h h' f f'; rewrite !getP Hmh -Hh -Hh' /=. - rewrite ltr_eqF /=; 1:by apply/Hlt; rewrite in_dom Hh. - by rewrite ltr_eqF; 1:by apply/Hlt; rewrite in_dom Hh'. -move=> xb xh xb' xh' /mh_some [c c' f f'] [#] Hh Hh' Hm. -exists c c' f f'; rewrite !getP Hm -Hh -Hh'. -rewrite ltr_eqF /=; 1:by apply/Hlt; rewrite in_dom Hh. -by rewrite ltr_eqF; 1:by apply/Hlt; rewrite in_dom Hh'. +move=> [] _ Hmh_m hs_hx; case: {-1}(mh.[(xa,hx)]) (eq_refl mh.[(xa,hx)])=> [//|]. +by move=> [ya hy] /Hmh_m [xc fx yc fy] [#]; rewrite hs_hx. qed. -lemma mh_up_handles hs ch m2 mh ro cf: - handles_spec hs ch => - mh_spec hs m2 mh ro => - mh_spec hs.[ch <- cf] m2 mh ro. +(** Adding handles **) +lemma m_mh_addh hs ch m mh xc fx: + hs_spec hs ch + => m_mh hs m mh + => m_mh hs.[ch <- (xc, fx)] m mh. proof. -move=> + [] mh_some ?=> -[] _ _ Hlt; split=> // b h b' h' /mh_some [c c' f f'] [#] Hh Hh' Hif. -exists c c' f f'; rewrite Hif -Hh -Hh' !getP. -rewrite ltr_eqF /=; 1:by apply/Hlt; rewrite in_dom Hh. -by rewrite ltr_eqF; 1:by apply/Hlt; rewrite in_dom Hh'. +move=> ^Hhs [] Hhuniq hs_0 dom_hs [] Hm_mh Hmh_m; split. ++ move=> xa0 xc0 ya yc /Hm_mh [hx0 fx0 hy fy] [#] hs_hx0 hs_hy mh_xaxc0. + exists hx0 fx0 hy fy; rewrite !getP mh_xaxc0 hs_hx0 hs_hy /=. + move: hs_hx0=> /dom_hs/ltr_eqF -> /=. + by move: hs_hy=> /dom_hs/ltr_eqF -> /=. +move=> xa hx ya hy /Hmh_m [xc0 fx0 yc fy] [#] hs_hx hs_hy m_xaxc0. +exists xc0 fx0 yc fy; rewrite !getP m_xaxc0 hs_hx hs_hy. +move: hs_hx=> /dom_hs/ltr_eqF -> /=. +by move: hs_hy=> /dom_hs/ltr_eqF -> /=. qed. -lemma paths_up_handles m2 ro hs mh pi cf ch: - mh_spec hs m2 mh ro => - handles_spec hs ch => - paths_spec hs mh pi => - paths_spec hs.[ch <- cf] mh pi. +lemma hs_addh hs ch xc fx: + hs_spec hs ch + => (forall f h, hs.[h] <> Some (xc,f)) + => hs_spec hs.[ch <- (xc,fx)] (ch + 1). proof. -move=> Hmh Hh [] Hp; split=> c p v; rewrite Hp; apply exists_iff=> x /=. -split=>- [] ^Hbu -> /=; rewrite getP. -+ case: Hh=> _ _ Hlt x_in_handles. - by rewrite ltr_eqF; 1:by apply/Hlt; rewrite in_dom x_in_handles. -case: (x = ch)=> //=. -move: Hbu=> /build_hpathP [[#] _ _ ->|p' b v' h' [#] _ _ Hh']. -+ by rewrite (@chandle_0 _ _ Hh). -case: Hh=> _ _ /(_ x) Hlt; rewrite ltr_eqF //. -by apply/Hlt; rewrite in_dom; case: Hmh=> /(_ _ _ _ _ Hh') [????] [#] _ ->. +move=> ^Hhs [] Hhuniq hs_0 dom_hs xc_notin_rng1_hs; split. ++ move=> h1 h2 [c1 f1] [c2 f2]; rewrite !getP /=. + case: (h1 = ch); case: (h2 = ch)=> //= [+ + [#]|+ + + [#]|]=> <*>; + first 2 by rewrite xc_notin_rng1_hs. + by move=> _ _ hs_h1 /(Hhuniq _ _ _ _ hs_h1). ++ by rewrite getP (ch_neq0 _ Hhs). ++ move=> [c f] h; rewrite !getP; case: (h = ch)=> [<*> /#|_]. +by move=> /dom_hs /#. qed. -lemma handles_up_handles hs ch x2 f': - (forall (f : flag), ! mem (rng hs) (x2, f)) => - handles_spec hs ch => - handles_spec hs.[ch <- (x2, f')] (ch + 1). +lemma mh_addh hs ch Gm mh ro xc fx: + hs_spec hs ch + => mh_spec hs Gm mh ro + => mh_spec hs.[ch <- (xc,fx)] Gm mh ro. proof. -move=> Hx2 ^Hh [] Hu Hh0 Hlt; split. -+ move=> h1 h2 [c1 f1] [c2 f2]; rewrite !getP /=. - case: (h1 = ch)=> /= [-> [] ->> ->|_]; (case: (h2 = ch)=> [-> //= |_]). - + by move=> Heq ->>; move: (Hx2 f2); rewrite in_rng negb_exists=> /= /(_ h2). - + by move=> Heq [] ->> <<- ->>; move: (Hx2 f1); rewrite in_rng negb_exists=> /= /(_ h1). - by apply Hu. -+ by rewrite getP (@chandle_0 _ _ Hh). -by move=> h; rewrite dom_set !inE /#. +move=> [] _ _ dom_hs [] Hmh ?; split=> //. +move=> xa hx ya hy /Hmh [xc0 fx0 yc0 fy0] [#] hs_hx hs_hy Hite. +exists xc0 fx0 yc0 fy0; rewrite !getP Hite hs_hx hs_hy /=. +rewrite ltr_eqF /=; 1:by apply/(dom_hs _ hs_hx). +by rewrite ltr_eqF /=; 1:by apply/(dom_hs _ hs_hy). qed. -(* lemma INV_CF_G1_up_handles hs ch m1 mi1 m2 mi2 mh mhi ro pi x2: *) -(* INV_CF_G1 hs ch m1 mi1 m2 mi2 mh mhi ro pi => *) -(* (forall f, !mem (rng hs) (x2, f)) => *) -(* INV_CF_G1 hs.[ch <- (x2, Known)] (ch + 1) m1 mi1 m2 mi2 mh mhi ro pi. *) +(* lemma paths_up_handles m2 ro hs mh pi cf ch: *) +(* mh_spec hs m2 mh ro => *) +(* handles_spec hs ch => *) +(* paths_spec hs mh pi => *) +(* paths_spec hs.[ch <- cf] mh pi. *) (* proof. *) -(* case=> Heqm Heqmi Hincl Hincli Hmh Hp Hh Hx2. *) -(* exact/(HCF_G1 (eqm_up_handles Hh Heqm) (eqm_up_handles Hh Heqmi) *) -(* _ _ *) -(* (:@mh_up_handles _ _ _ _ _ (x2,Known) Hh Hmh) *) -(* (:@paths_up_handles m2 ro _ _ _ (x2,Known) _ Hmh Hh Hp) *) -(* (:@handles_up_handles _ _ x2 Known _ Hh)). *) +(* move=> Hmh Hh [] Hp; split=> c p v; rewrite Hp; apply exists_iff=> x /=. *) +(* split=>- [] ^Hbu -> /=; rewrite getP. *) +(* + case: Hh=> _ _ Hlt x_in_handles. *) +(* by rewrite ltr_eqF; 1:by apply/Hlt; rewrite in_dom x_in_handles. *) +(* case: (x = ch)=> //=. *) +(* move: Hbu=> /build_hpathP [[#] _ _ ->|p' b v' h' [#] _ _ Hh']. *) +(* + by rewrite (@chandle_0 _ _ Hh). *) +(* case: Hh=> _ _ /(_ x) Hlt; rewrite ltr_eqF //. *) +(* by apply/Hlt; rewrite in_dom; case: Hmh=> /(_ _ _ _ _ Hh') [????] [#] _ ->. *) (* qed. *) +(* lemma handles_up_handles hs ch x2 f': *) +(* (forall (f : flag), ! mem (rng hs) (x2, f)) => *) +(* handles_spec hs ch => *) +(* handles_spec hs.[ch <- (x2, f')] (ch + 1). *) +(* proof. *) +(* move=> Hx2 ^Hh [] Hu Hh0 Hlt; split. *) +(* + move=> h1 h2 [c1 f1] [c2 f2]; rewrite !getP /=. *) +(* case: (h1 = ch)=> /= [-> [] ->> ->|_]; (case: (h2 = ch)=> [-> //= |_]). *) +(* + by move=> Heq ->>; move: (Hx2 f2); rewrite in_rng negb_exists=> /= /(_ h2). *) +(* + by move=> Heq [] ->> <<- ->>; move: (Hx2 f1); rewrite in_rng negb_exists=> /= /(_ h1). *) +(* by apply Hu. *) +(* + by rewrite getP (@chandle_0 _ _ Hh). *) +(* by move=> h; rewrite dom_set !inE /#. *) +(* qed. *) + +(* (* lemma INV_CF_G1_up_handles hs ch m1 mi1 m2 mi2 mh mhi ro pi x2: *) *) +(* (* INV_CF_G1 hs ch m1 mi1 m2 mi2 mh mhi ro pi => *) *) +(* (* (forall f, !mem (rng hs) (x2, f)) => *) *) +(* (* INV_CF_G1 hs.[ch <- (x2, Known)] (ch + 1) m1 mi1 m2 mi2 mh mhi ro pi. *) *) +(* (* proof. *) *) +(* (* case=> Heqm Heqmi Hincl Hincli Hmh Hp Hh Hx2. *) *) +(* (* exact/(HCF_G1 (eqm_up_handles Hh Heqm) (eqm_up_handles Hh Heqmi) *) *) +(* (* _ _ *) *) +(* (* (:@mh_up_handles _ _ _ _ _ (x2,Known) Hh Hmh) *) *) +(* (* (:@paths_up_handles m2 ro _ _ _ (x2,Known) _ Hmh Hh Hp) *) *) +(* (* (:@handles_up_handles _ _ x2 Known _ Hh)). *) *) +(* (* qed. *) *) + (** Updating forward map **) -lemma eqm_handles_up (hs : handles) m mh (h hx:handle) (x y : state) f: +lemma m_mh_addh_addm hs Pm mh hx xa xc hy ya yc f: + m_mh hs Pm mh => huniq hs => - hs.[h] = None => - hs.[hx] = Some (x.`2, f) => - eqm_handles hs m mh => - eqm_handles hs.[h <- (y.`2,Known)] m.[x <- y] mh.[(x.`1,hx) <- (y.`1,h)]. + hs.[hx] = Some (xc, f) => + hs.[hy] = None => + m_mh hs.[hy <- (yc,Known)] Pm.[(xa,xc) <- (ya,yc)] mh.[(xa,hx) <- (ya,hy)]. proof. -move=> uniq_h h_h h_hx @/eqm_handles [] hmmh hmhm; split. -+ move=> b c b' c'; rewrite getP; case ((b,c) = x)=> /= [<<- ->> {x y} /=|]. - * by exists hx f h Known; rewrite !getP /= [smt (in_dom)]. - move=> bc_neq_x /hmmh [] h0 f0 h0' f0' [#] h_h0 h_h0' mhi_bc. - by exists h0 f0 h0' f0'; rewrite !getP [smt (in_dom)]. -move=> xb xh b' h'; rewrite getP; case ((xb,xh) = (x.`1,hx))=> /= [[#] <*> [#] <*>|]. - * by exists x.`2 f y.`2 Known; rewrite !getP [smt (in_dom)]. -rewrite anda_and negb_and=> bh_neq_x1hx /hmhm /= [] c0 f0 c0' f0' [#] h_h0 h_bh' m_bc. -exists c0 f0 c0' f0'; rewrite !getP. -split; 1:smt (in_dom). -split; 1:smt (in_dom). -case x bh_neq_x1hx h_hx=> x1 x2 /= => - [/#|h0_neq_hx h_hx]. -have -> //=: c0 <> x2; move: h0_neq_hx; apply/contra. -exact/(@uniq_h _ _ _ _ h_h0 h_hx). +move=> [] Hm_mh Hmh_m Hhuniq hs_hx hs_hy. +split=> [xa0 xc0 ya0 yc0|xa0 hx0 ya0 hy0]; rewrite getP. ++ case: ((xa0,xc0) = (xa,xc))=> [[#] <<*> [#] <<*>|] /=. + + by exists hx f hy Known; rewrite !getP /= /#. + move=> xaxc0_neq_xaxc /Hm_mh [hx0 fx0 hy0 fy0] [#] hs_hx0 hs_hy0 mh_xahx0. + by exists hx0 fx0 hy0 fy0; rewrite !getP /#. +case: ((xa0,hx0) = (xa,hx))=> [[#] <*>> [#] <<*>|] /=. ++ by exists xc f yc Known; rewrite !getP /= /#. +rewrite anda_and=> /negb_and xahx0_neq_xahx /Hmh_m [xc0 fx0 yc0 fy0] [#] hs_hx0 hs_hy0 Pm_xaxc0. +exists xc0 fx0 yc0 fy0; rewrite !getP; do !split=> [/#|/#|/=]. +move: xahx0_neq_xahx; case: (xa0 = xa)=> [/= <*>>|//=]; case: (xc0 = xc)=> [<*>>|//=]. +by move: hs_hx=> /(Hhuniq _ _ _ _ hs_hx0). qed. (** Updating backward map **) -lemma eqmi_handles_up (hs : handles) mi mhi (h hx : handle) (x y : state) f: - (!exists f', mem (rng hs) (y.`2,f')) => - hs.[h] = None => - hs.[hx] = Some (x.`2, f) => - eqm_handles hs mi mhi => - eqm_handles hs.[h <- (y.`2,Known)] mi.[y <- x] mhi.[(y.`1,h) <- (x.`1,hx)]. +lemma mi_mhi_addh_addmi (hs : handles) mi mhi hx xa xc hy ya yc fx: + m_mh hs mi mhi => + (forall f h, hs.[h] <> Some (yc,f)) => + hs.[hx] = Some (xc,fx) => + hs.[hy] = None => + m_mh hs.[hy <- (yc,Known)] mi.[(ya,yc) <- (xa,xc)] mhi.[(ya,hy) <- (xa,hx)]. proof. -move=> y_notinr1_handles h_h h_hx @/eqm_handles [] hmmh hmhm; split. -+ move=> xb xc xb' xc'; rewrite getP; case ((xb,xc) = y)=> /= [<<- ->> {x y}|]. - * by exists h Known hx f; rewrite !getP /= [smt (in_dom)]. - move=> bc_neq_y /hmmh [] h0 f0 h0' f0' [#] h_h0 h_h0' mhi_bc. - by exists h0 f0 h0' f0'; rewrite !getP [smt (in_dom)]. -move=> xb xh xb' xh'; rewrite getP; case ((xb,xh) = (y.`1,h))=> /= [[#] <*> [#] <*>|]. - * by exists y.`2 Known x.`2 f; rewrite !getP [smt (in_dom)]. -rewrite anda_and negb_and=> bh_neq_y1h /hmhm /= [] c0 f0 c0' f0' [#] h_bh h_bh' mi_bh. -exists c0 f0 c0' f0'; rewrite !getP. -split; 1:smt (in_dom). -split; 1:smt (in_dom). -case y bh_neq_y1h y_notinr1_handles=> y1 y2 /= [/#|h0_neq_h y_notinr1_handles]. -have /#: c0 = y2 => false; move=> /(congr1 (fun x=> exists f', mem (rng hs) (x,f'))) /=. -rewrite y_notinr1_handles /= neqF /=; exists f0. -by rewrite in_rng; exists xh. +move=> [] Hm_mh Hmh_m yc_notin_rng1_hs hs_hx hs_hy; split. ++ move=> ya0 yc0 xa0 xc0; rewrite getP; case: ((ya0,yc0) = (ya,yc))=> [[#] <*>> [#] <*>>|]. + + by exists hy Known hx fx; rewrite !getP /= /#. + move=> yayc0_neq_yayc /Hm_mh [hy0 fy0 hx0 fx0] [#] hs_hy0 hs_hx0 mhi_yayc0. + by exists hy0 fy0 hx0 fx0; rewrite !getP /#. +move=> ya0 hy0 xa0 hx0; rewrite getP; case: ((ya0,hy0) = (ya,hy))=> [[#] <*>> [#] <<*>|]. ++ by exists yc Known xc fx; rewrite !getP //= /#. +rewrite /= anda_and=> /negb_and yahy0_neq_yahy /Hmh_m [yc0 fy0 xc0 fx0] [#] hs_hy0 hs_hx0 mi_yayc0. +exists yc0 fy0 xc0 fx0; rewrite !getP; do !split=> [/#|/#|]. +move: yahy0_neq_yahy; case: (ya0 = ya)=> [<<*> //=|/#]; case: (yc0 = yc)=> [<*>> /=|//=]. +by move: hs_hy0; rewrite yc_notin_rng1_hs. qed. -lemma incl_set (m m' : ('a,'b) fmap) x y: - incl m m' => - incl m.[x <- y] m'.[x <- y]. -proof. smt (in_dom getP). qed. +(** Inversion **) +lemma inv_addm (m : ('a,'b) fmap) mi x y: + inv_spec m mi + => m.[x] = None + => mi.[y] = None + => inv_spec m.[x <- y] mi.[y <- x]. +proof. +move=> [] Hinv m_x mi_y; split=> x' y'; rewrite !getP; split. ++ case: (x' = x)=> /= [[#] <*> //=|_ /Hinv ^ + ->]. + by move: mi_y; case: (y' = y)=> [[#] <*> ->|]. +case: (y' = y)=> /= [[#] <*> //=|_ /Hinv ^ + ->]. +by move: m_x; case: (x' = x)=> [[#] <*> ->|]. +qed. -lemma hinv_notin_rng m y2: - SLCommon.hinv m y2 = None => - (forall h f, m.[h] <> Some (y2,f)). -proof. by move=> hinv_none; have:= hinvP m y2; rewrite hinv_none. qed. +(** Map Inclusion **) +lemma incl_addm (m m' : ('a,'b) fmap) x y: + incl m m' + => incl m.[x <- y] m'.[x <- y]. +proof. by move=> m_leq_m' x'; rewrite !getP; case: (x' = x)=> [|_ /m_leq_m']. qed. -lemma handles_spec_notin_dom m h: - handles_spec m h => - !mem (dom m) h. -proof. case; smt (in_dom). qed. +(* lemma hinv_notin_rng m y2: *) +(* SLCommon.hinv m y2 = None => *) +(* (forall h f, m.[h] <> Some (y2,f)). *) +(* proof. by move=> hinv_none; have:= hinvP m y2; rewrite hinv_none. qed. *) -lemma neq_Known f: f <> Known <=> f = Unknown. -proof. by case f. qed. +(* lemma handles_spec_notin_dom m h: *) +(* handles_spec m h => *) +(* !mem (dom m) h. *) +(* proof. case; smt (in_dom). qed. *) -lemma neq_Unkwown f: f <> Unknown <=> f = Known. -proof. by case f. qed. +(* lemma neq_Known f: f <> Known <=> f = Unknown. *) +(* proof. by case f. qed. *) + +(* lemma neq_Unkwown f: f <> Unknown <=> f = Known. *) +(* proof. by case f. qed. *) op getflag (hs : handles) xc = omap snd (obind ("_.[_]" hs) (hinv hs xc)). lemma getflagP_none hs xc: - (getflag hs xc = None <=> forall f, !mem (rng hs) (xc,f)). -proof. -rewrite /getflag; case: (hinvP hs xc)=> [->|] //=. -+ smt (in_rng). -smt (in_rng). -qed. + (getflag hs xc = None <=> forall f h, hs.[h] <> Some (xc,f)). +proof. by rewrite /getflag; case: (hinvP hs xc)=> [->|] //= /#. qed. lemma getflagP_some hs xc f: - huniq hs => - (getflag hs xc = Some f <=> mem (rng hs) (xc,f)). + huniq hs + => (getflag hs xc = Some f <=> mem (rng hs) (xc,f)). proof. move=> huniq_hs; split. + rewrite /getflag; case: (hinvP hs xc)=> [-> //|]. @@ -702,278 +788,220 @@ move=> /(huniq_hs _ h _ (xc,f)) /(_ hs_h) /= ->>. by rewrite hs_h. qed. -lemma paths_prefix handles m2 mh ro paths c b p v: - mh_spec handles m2 mh ro => - paths_spec handles mh paths => - paths.[c] = Some (rcons p b,v) => - (exists c' v', paths.[c'] = Some (p,v')). -proof. -move=> [] mh_some _ [] hpaths ^paths_c. -move=> /hpaths [h] [#] /build_hpathP [/#|] p' b' v' h' [#] ^/rconsIs + /rconssI- <*>. -move=> hpath + handles_h - /mh_some /= [c' c0 f' f]; rewrite handles_h /= => /> handles_h' _. -by exists c' v'; rewrite hpaths; exists h'. -qed. +(* lemma paths_prefix handles m2 mh ro paths c b p v: *) +(* mh_spec handles m2 mh ro => *) +(* paths_spec handles mh paths => *) +(* paths.[c] = Some (rcons p b,v) => *) +(* (exists c' v', paths.[c'] = Some (p,v')). *) +(* proof. *) +(* move=> [] mh_some _ [] hpaths ^paths_c. *) +(* move=> /hpaths [h] [#] /build_hpathP [/#|] p' b' v' h' [#] ^/rconsIs + /rconssI- <*>. *) +(* move=> hpath + handles_h - /mh_some /= [c' c0 f' f]; rewrite handles_h /= => /> handles_h' _. *) +(* by exists c' v'; rewrite hpaths; exists h'. *) +(* qed. *) lemma build_hpath_prefix mh p b v h: - build_hpath mh (rcons p b) = Some (v,h) <=> - (exists v' h', build_hpath mh p = Some (v',h') /\ mh.[(v' +^ b,h')] = Some (v,h)). + build_hpath mh (rcons p b) = Some (v,h) + <=> (exists v' h', build_hpath mh p = Some (v',h') /\ mh.[(v' +^ b,h')] = Some (v,h)). proof. rewrite build_hpathP; split=> [[/#|p' b' v' h' [#] + Hhpath Hmh]|[v' h'] [] Hhpath Hmh]. + by move=> ^/rconsIs <<- {b'} /rconssI <<- {p'}; exists v' h'. exact/(Extend _ _ _ _ _ Hhpath Hmh). qed. -lemma iter_step_path_from_None mh p: foldl (step_hpath mh) None p = None. +lemma foldl_step_hpath_None mh p: foldl (step_hpath mh) None p = None. proof. by elim: p. qed. -lemma build_hpath_up mh xc xh yc yh p b h: - !mem (dom mh) (xc,xh) => - build_hpath mh p = Some (b,h) => - build_hpath mh.[(xc,xh) <- (yc,yh)] p = Some (b,h). +(** This proof is not understood **) +lemma build_hpath_up mh xa hx ya hy p b h: + build_hpath mh p = Some (b,h) + => mh.[(xa,hx)] = None + => build_hpath mh.[(xa,hx) <- (ya,hy)] p = Some (b,h). proof. -move=> xch_notin_mh @/build_hpath. +move=> + mh_xahx - @/build_hpath. have: (exists p' v h, build_hpath mh p' = Some (v +^ b0,h)). + by exists [] b0 0; rewrite build_hpathP Block.xorw0; exact/Empty. pose root:= b0; elim: p root 0=> //= b1 p ih bn hn. rewrite /(step_hpath _ (Some _)) /= oget_some /= /(step_hpath _ (Some _)) /= oget_some /= getP. -case: (mem (dom mh) (bn +^ b1,hn))=> [bnb1hn_in_mh extend_path|]. -+ have -> /= : (bn +^ b1,hn) <> (xc,xh). - + apply/contraT=> /(congr1 (mem (dom mh)) (bn +^ b1,hn) (xc,xh)). - by rewrite xch_notin_mh bnb1hn_in_mh. - case: {-1}(mh.[(bn +^ b1,hn)]) (eq_refl (mh.[(bn +^ b1,hn)]))=> //=. - + smt. (* figure out *) - move=> [] b2 h2 mh_bnb1hn. - apply/(@ih b2 h2). - case: extend_path=> p' v hp' build_path. - by exists p' (v +^ bn +^ b2) hp'; rewrite build_path //= #ring. -by rewrite in_dom /= => mh_bnb1hn _; rewrite mh_bnb1hn iter_step_path_from_None. +case: {-1}(mh.[(bn +^ b1,hn)]) (eq_refl mh.[(bn +^ b1,hn)])=> [|[xc' hx'] mh_bnb1hn]; last first. ++ have -> /= : (bn +^ b1,hn) <> (xa,hx). + + apply/contraT=> /(congr1 (fun ch=> mh.[ch]) (bn +^ b1,hn) (xa,hx)). + by rewrite mh_xahx mh_bnb1hn. + smt. (* figure out *) +by rewrite foldl_step_hpath_None. qed. -lemma build_hpath_down mh xc xh yc yh p v h: - xh <> 0 - => (forall c' h' xc', mh.[(c',h')] <> Some (xc',xh)) - => build_hpath mh.[(xc,xh) <- (yc,yh)] p = Some (v,h) +lemma build_hpath_down mh xa hx ya hy p v h: + (forall p v, build_hpath mh p <> Some (v,hx)) + => build_hpath mh.[(xa,hx) <- (ya,hy)] p = Some (v,h) => build_hpath mh p = Some (v,h). proof. -move=> xh_neq_0 xh_notin_rng2_mh. +move=> no_path_to_hx. elim/last_ind: p v h=> [v h /build_hpathP [<*>|/#] //=|p b ih]. move=> v h /build_hpathP [/#|p' b' + + ^/rconsIs <<- /rconssI <<-]. move=> v' h' /ih; rewrite getP. -case: ((v' +^ b,h') = (xc,xh))=> [[#] <*> + [#] <*>|_ Hpath Hmh]. -+ by move=> /build_hpathP [/#|] /#. -exact/build_hpathP/(Extend _ _ _ _ _ Hpath Hmh). +case: ((v' +^ b,h') = (xa,hx))=> [/#|_ Hpath Hextend]. +exact/build_hpathP/(Extend _ _ _ _ _ Hpath Hextend). qed. -lemma INV_CF_G1_notin_PFm_notin_G1m hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi x: - INV_CF_G1 hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi => - PFm.[x] = None => - G1m.[x] = None. -proof. by move=> /incl_of_INV G1m_le_PFm; apply/contraLR=> ^h; rewrite G1m_le_PFm. qed. - -lemma INV_CF_G1_0 hs PFm PFmi G1m G1mi G1mh G1mhi ro pi: - !INV_CF_G1 hs 0 PFm PFmi G1m G1mi G1mh G1mhi ro pi. -proof. -rewrite -negP=> -[] _ _ _ _ _ _ [] _ + /(_ 0) /=. -by rewrite in_dom=> ->. -qed. - -(** Clean this up and tidy intermediate results, more particularly - anything that is derived from individual components of INV_CF_G1 **) -lemma lemma1 hs ch PFm PFmi G1m G1mi G1mh G1mhi ro (pi : (capacity,block list * block) fmap) x1 x2 y1 y2: - x2 <> y2 => - PFm.[(x1,x2)] = None => - G1m.[(x1,x2)] = None => - pi.[x2] = None => - (forall f, !mem (rng hs) (x2,f)) => - (forall f, !mem (rng hs) (y2,f)) => - INV_CF_G1 hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi => - INV_CF_G1 hs.[ch <- (x2,Known)].[ch + 1 <- (y2,Known)] (ch + 2) - PFm.[(x1,x2) <- (y1,y2)] PFmi.[(y1,y2) <- (x1,x2)] - G1m.[(x1,x2) <- (y1,y2)] G1mi.[(y1,y2) <- (x1,x2)] - G1mh.[(x1,ch) <- (y1,ch + 1)] G1mhi.[(y1,ch + 1) <- (x1,ch)] - ro pi. +lemma lemma1 hs ch Pm Pmi Gm Gmi mh mhi ro pi x1 x2 y1 y2: + INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi + => x2 <> y2 + => Pm.[(x1,x2)] = None + => Gm.[(x1,x2)] = None + => pi.[x2] = None + => (forall f h, hs.[h] <> Some (x2,f)) + => (forall f h, hs.[h] <> Some (y2,f)) + => INV_CF_G1 + hs.[ch <- (x2,Known)].[ch + 1 <- (y2,Known)] (ch + 2) + Pm.[(x1,x2) <- (y1,y2)] Pmi.[(y1,y2) <- (x1,x2)] + Gm.[(x1,x2) <- (y1,y2)] Gmi.[(y1,y2) <- (x1,x2)] + mh.[(x1,ch) <- (y1,ch + 1)] mhi.[(y1,ch + 1) <- (x1,ch)] + ro pi. proof. -move=> x2_neq_y2 PFm_x G1m_x pi_x2 x2_notin_hs y2_notin_hs Hinv; split. -+ apply/(@eqm_handles_up hs.[ch <- (x2,Known)] PFm G1mh (ch + 1) ch (x1,x2) (y1,y2) Known). - + move=> @/huniq h1 h2 [c1 f1] [c2 f2]; rewrite !getP /=. - case: (h1 = ch); case: (h2 = ch)=> //=. - + move=> + + [#] - + <*>. - by move: (x2_notin_hs f2); rewrite in_rng negb_exists /= => ->. - + move=> <*> + + [#] <*>. - by move: (x2_notin_hs f1); rewrite in_rng negb_exists /= => ->. - case: Hinv=> _ _ _ _ _ _ [] + _ _ _ _ - h. - exact/(@h h1 h2 (c1,f1) (c2,f2)). - + by rewrite getP; case: Hinv=> _ _ _ _ _ _ []; smt (in_dom). +move=> HINV x2_neq_y2 Pm_x Gm_x pi_x2 x2_notin_rng1_hs y2_notin_rng1_hs; split. ++ rewrite (@addzA ch 1 1); apply/hs_addh. + + by move: HINV=> /hs_of_INV/hs_addh=> ->. + by move=> f h; rewrite getP; case: (h = ch)=> [/#|_]; exact/y2_notin_rng1_hs. +(* + apply/inv_addm; 1:by case: HINV. *) +(* + have ^ /m_mh_of_INV Hm_mh /hs_of_INV Hhs := HINV. *) +(* by apply/(ch_notin_dom2_mh _ _ Hm_mh Hhs). *) +(* have ^ /mi_mhi_of_INV Hmi_mhi /hs_of_INV Hhs := HINV. *) +(* by apply/(Sch_notin_dom2_mh _ _ Hmi_mhi Hhs). *) ++ apply/(@m_mh_addh_addm hs.[ch <- (x2,Known)] Pm mh ch x1 x2 (ch + 1) y1 y2 Known). + + by move: HINV=> ^/hs_of_INV Hhs /m_mh_of_INV; exact/(m_mh_addh Hhs). + + by move: HINV => /hs_of_INV /hs_addh /(_ x2 Known _) // []. + by rewrite getP. - by apply/eqm_up_handles; case: Hinv. -+ apply/(@eqmi_handles_up hs.[ch <- (x2,Known)] PFmi G1mhi (ch + 1) ch (x1,x2) (y1,y2) Known). - + rewrite negb_exists /= => f; rewrite in_rng negb_exists /= => h. - rewrite getP; case: (h = ch)=> _; first by rewrite /= x2_neq_y2. - by move: (y2_notin_hs f); rewrite in_rng negb_exists /= => ->. - + by rewrite getP; case: Hinv=> _ _ _ _ _ _ []; smt (in_dom). + by rewrite getP gtr_eqF 1:/# /=; apply/Sch_notin_dom_hs; case: HINV. ++ apply/(@mi_mhi_addh_addmi hs.[ch <- (x2,Known)] Pmi mhi ch x1 x2 (ch + 1) y1 y2 Known). + + by move: HINV=> ^/hs_of_INV Hhs /mi_mhi_of_INV; exact/(m_mh_addh Hhs). + + move=> f h; rewrite getP; case: (h = ch)=> [_ //=|_ //=]; first by rewrite x2_neq_y2. + by rewrite y2_notin_rng1_hs. + by rewrite getP. - by apply/eqm_up_handles; case: Hinv. -+ move=> z; rewrite !getP; case: (z = (x1,x2))=> //= _. - by case: Hinv=> _ _ + _ _ _ _ - @/incl /(_ z). -+ move=> z; rewrite !getP; case: (z = (y1,y2))=> //= _. - by case: Hinv=> _ _ _ + - @/incl /(_ z). + by rewrite getP gtr_eqF 1:/# /=; apply/Sch_notin_dom_hs; case: HINV. ++ by apply/incl_addm; case: HINV. ++ by apply/incl_addm; case: HINV. + split. - + move=> xa xh ya yh; rewrite getP; case: ((xa,xh) = (x1,ch)). - + move=> /= [#] <*> [#] <*>; exists x2 Known y2 Known=> //=. - by rewrite !getP /#. - rewrite /= anda_and negb_and=> h hG1mh. (* This one needs cleaned up in priority. These are things that should be deduced instantly. *) - have := Hinv=>- [] _ _ _ _ [] + _ _ _ - h0. - have [xc xf yc yf] [#] hs_xh hs_yh ite:= h0 _ _ _ _ hG1mh. - have yh_lt_ch: xh < ch by case: Hinv=> _ _ _ _ _ _ [] _ _ -> //; rewrite in_dom hs_xh. - have xh_lt_ch: yh < ch by case: Hinv=> _ _ _ _ _ _ [] _ _ -> //; rewrite in_dom hs_yh. - exists xc xf yc yf. - split; first by smt (getP). - split; first by smt (getP). - split=> /=. - + by move: ite=> <*> /= [#] hG1m -> //=; rewrite getP; case: ((xa,xc) = (x1,x2))=> [<*> /#|]. - move: ite=> + hrw; move: hrw=> -> /= [p v] [#] ro_pv hpath. - exists p v; rewrite ro_pv /=. - apply/build_hpath_up=> //=; case: Hinv=> _ _ _ _ _ _ [] _ _ hh. - rewrite -negP in_dom; case: {-1}(G1mh.[(x1,ch)]) (eq_refl (G1mh.[(x1,ch)]))=> [//=|[xa' xh']]. - move=> /h0 [xc0 xf0 ? ?] [] + _. - by move: (hh ch)=> /=; rewrite in_dom /= => ->. - (* These two are going to be painful: -> are easy. <- rely on the fact that neither x not y had an associated handle, and therefore cannot be involved in a path. This is crucial. Maybe some other permutation of the goals/invariant's conjuncts would help clarify. *) - + move=> p xa b; have:= Hinv=>- [] _ _ _ _ [] _ -> _ _. - apply/exists_iff=> v /=; apply/exists_iff=> xh /=; apply/exists_iff=> yh /=. - have G1mh_x1ch: G1mh.[(x1,ch)] = None. - + have /# : forall x1' xh', G1mh.[(x1,ch)] <> Some (x1',xh'). - move=> x1' xh'; rewrite -negP=> G1mh_xh'. - have [] [] _ ht _ _ _ _ _ _ := Hinv. - move: (ht _ _ _ _ G1mh_xh')=> [xc xf yc yf] [#] + _ _ {ht}. - have [] _ _ _ _ _ _ [] _ _ /(_ ch):= Hinv. - by rewrite in_dom=> /= ->. - have ch_notin_G1mh: forall cx, !mem (rng G1mh) (cx,ch). - + move=> cx; rewrite in_rng negb_exists=> - [b0 h0] /=; rewrite -negP=> G1mh_cxch. - by case: Hinv=> - [] _ + _ _ _ _ _ [] _ _ + - /(_ _ _ _ _ G1mh_cxch) [xc xf yc yf] [#] _ hs_ch _ /(_ ch) /=; rewrite in_dom hs_ch. - split=> -[#]. - + move=> hpath hG1mh. - rewrite getP; case: ((v +^ xa,xh) = (x1,ch))=> [/#|_]. - rewrite hG1mh //=. - by apply/build_hpath_up=> //=; rewrite in_dom G1mh_x1ch. - (* The following case should be built into the lemma (build_hpath_down) *) - rewrite getP; case: ((v +^ xa,xh) = (x1,ch))=> [[#] <*> + [#] <*>|]. - + have ht /ht {ht} /= := (build_hpath_down G1mh (v +^ xa) ch b (ch + 1) p v ch _ _). - + by case: Hinv=> _ _ _ _ _ _ [] _ + +; smt (in_dom). - + move=> c' h' xc'; move: (ch_notin_G1mh xc'). - by rewrite in_rng negb_exists /= => ->. - move=> /build_hpathP [<*>|p' b' v' h' <*>]; first by rewrite INV_CF_G1_0 in Hinv; smt (). - by move: (ch_notin_G1mh v); rewrite in_rng negb_exists /= => ->. - move=> _. - have ht /ht {ht} /= -> //= := build_hpath_down G1mh x1 ch y1 (ch + 1) p v xh _ _. - + by case: Hinv=> _ _ _ _ _ _ [] _ + +; smt (in_dom). - by move=> c' h' xc'; move: (ch_notin_G1mh xc'); rewrite in_rng negb_exists /= => ->. -+ split=> c p v; have [] _ _ _ _ _ [] -> _ := Hinv. + + move=> xa hx ya hy; rewrite getP; case: ((xa,hx) = (x1,ch))=> [|]. + + by move=> [#] <*> [#] <*>; exists x2 Known y2 Known; rewrite !getP /#. + move=> xahx_neq_x1ch; have ^ /hs_of_INV Hhs /mh_of_INV [] Hmh _ /Hmh {Hmh} := HINV. + move=> [xc fx yc fy] [#] hs_hx hs_hy Hite. + exists xc fx yc fy; do 2?split; first 2 by smt (dom_hs_neq_ch dom_hs_neq_Sch getP). + case: fy Hite hs_hy=> /= [[p v] [Hro Hpath] hs_hy|[#] Gm_xaxc <*> hs_hy] /=; last first. + + by rewrite getP; case: ((xa,xc) = (x1,x2))=> [/#|]. + exists p v; rewrite Hro /=; apply/build_hpath_up=> //. + have /m_mh_of_INV /notin_hs_notin_dom2_mh H:= HINV. + exact/H/ch_notin_dom_hs/Hhs. + move=> p xa b; have /mh_of_INV [] _ -> := HINV. + apply/exists_iff=> v /=; apply/exists_iff=> hx /=; apply/exists_iff=> hy /=. + have mh_x1ch: mh.[(x1,ch)] = None. + + by apply/(notin_hs_notin_dom2_mh hs Pm)/ch_notin_dom_hs; case: HINV. + have ch_notin_rng2_mh: forall a h a', mh.[(a,h)] <> Some (a',ch). + + move=> a h a'; rewrite -negP; have /m_mh_of_INV [] _ Hmh_m /Hmh_m {Hmh_m} := HINV. + by move=> [xc fx yc fy] [#] _; rewrite ch_notin_dom_hs; case: HINV. + split=> -[#]. + + move=> Hpath mh_vxahx; rewrite getP; case: ((v +^ xa,hx) = (x1,ch))=> [/#|_]. + by rewrite mh_vxahx //=; apply/build_hpath_up=> //=; rewrite mh_x1ch. + have H /H {H}:= build_hpath_down mh x1 ch y1 (ch + 1) p v hx _. + + move=> p0 v0; rewrite -negP=> /build_hpathP [<*>|]. + + by have /hs_of_INV [] _ + H - /H {H} := HINV. + by move=> p' b' v' h' <*>; rewrite ch_notin_rng2_mh. + move=> ^ /build_hpathP + -> /=; rewrite getP. + by case=> [<*>|/#]; move: HINV=> /hs_of_INV [] _ + H - /H {H} /#. ++ split=> c p v; have ^/hs_of_INV [] _ _ dom_hs /pi_of_INV [] -> := HINV. apply/exists_iff=> h /=; split=> [#]. - have ht /ht {ht} -> /= := build_hpath_up G1mh x1 ch y1 (ch +1) p v h _. - + rewrite in_dom /=; case: {-1}(G1mh.[(x1,ch)]) (eq_refl (G1mh.[(x1,ch)]))=> [|[x1' xh'] G1mh_x1'xh'] //=. - case: Hinv=> - [] _ /(_ _ _ _ _ G1mh_x1'xh') [xc xf ct ft] [#] hs_ch _ _ _ _ _ _ _ [] _ _ /(_ ch) /=. - by rewrite in_dom hs_ch. - move=> hs_h; rewrite !getP hs_h. - have /#: h < ch. - by case: Hinv=> _ _ _ _ _ _ [] _ _ /(_ h); rewrite in_dom hs_h. - have ch_notin_G1mh: forall cx, !mem (rng G1mh) (cx,ch). - + move=> cx; rewrite in_rng negb_exists=> - [b0 h0] /=; rewrite -negP=> G1mh_cxch. - by case: Hinv=> - [] _ + _ _ _ _ _ [] _ _ + - /(_ _ _ _ _ G1mh_cxch) [xc xf yc yf] [#] _ hs_ch _ /(_ ch) /=; rewrite in_dom hs_ch. - have Sch_notin_G1mh: forall cx, !mem (rng G1mh) (cx,ch + 1). - + move=> cx; rewrite in_rng negb_exists=> - [b0 h0] /=; rewrite -negP=> G1mh_cxch. - by case: Hinv=> - [] _ + _ _ _ _ _ [] _ _ + - /(_ _ _ _ _ G1mh_cxch) [xc xf yc yf] [#] _ hs_ch _ /(_ (ch + 1)) /=; rewrite in_dom hs_ch /#. - have ht /ht {ht} /= := build_hpath_down G1mh x1 ch y1 (ch + 1) p v h _ _. - + by case: Hinv=> _ _ _ _ _ _ [] _ + +; smt (in_dom). - + by move=> c' h' xc'; move: (ch_notin_G1mh xc'); rewrite in_rng negb_exists /= => ->. - move=> Hpath; rewrite Hpath /=. - have: h <> ch /\ h <> ch + 1; last by smt (getP). - case: (h = 0)=> [<*>|]. - + by case: Hinv=> _ _ _ _ _ _ [] _ + /(_ 0) //=; rewrite in_dom=> /#. - move=> h_neq_0; move: Hpath=> /build_hpathP [<*> /#|p' b' v' h' <*> _]. - move: (ch_notin_G1mh v); rewrite in_rng negb_exists /= => /(_ (v' +^ b',h')). - move: (Sch_notin_G1mh v); rewrite in_rng negb_exists /= => /(_ (v' +^ b',h')). - smt (). -have ->: ch + 2 = ch + 1 + 1 by rewrite -addzA. -apply/(@handles_up_handles hs.[ch <- (x2,Known)] (ch + 1) y2 Known). -+ move=> f; rewrite in_rng negb_exists /= => h; rewrite !getP. - case: (h = ch)=> [<*> /=|_]; first by rewrite x2_neq_y2. - by move: (y2_notin_hs f); rewrite in_rng negb_exists /= => ->. -by apply/handles_up_handles=> //=; case: Hinv. + + move=> /(build_hpath_up mh x1 ch y1 (ch + 1) p v h) /(_ _). + + by apply/(notin_hs_notin_dom2_mh hs Pm)/ch_notin_dom_hs; case: HINV. + by move=> -> /= ^ /dom_hs; rewrite !getP /#. + have ch_notin_rng2_mh: forall a h a', mh.[(a,h)] <> Some (a',ch). + + move=> a h' a'; rewrite -negP; have /m_mh_of_INV [] _ Hmh_m /Hmh_m {Hmh_m} := HINV. + by move=> [xc fx yc fy] [#] _; rewrite ch_notin_dom_hs; case: HINV. + have Sch_notin_rng2_mh: forall a h a', mh.[(a,h)] <> Some (a',ch + 1). + + move=> a h' a'; rewrite -negP; have /m_mh_of_INV [] _ Hmh_m /Hmh_m {Hmh_m} := HINV. + by move=> [xc fx yc fy] [#] _; rewrite Sch_notin_dom_hs; case: HINV. + have H /H {H}:= build_hpath_down mh x1 ch y1 (ch + 1) p v h _. + + move=> p0 v0; rewrite -negP=> /build_hpathP [<*>|]. + + by have /hs_of_INV [] _ + H - /H {H} := HINV. + by move=> p' b' v' h' <*>; rewrite ch_notin_rng2_mh. + move=> ^ /build_hpathP + -> /=; rewrite !getP. + by case=> [<*>|/#]; move: HINV=> /hs_of_INV [] _ + H - /H {H} /#. qed. lemma lemma2 hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi x1 x2 y1 y2 hx: - INV_CF_G1 hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi => - PFm.[(x1,x2)] = None => - G1m.[(x1,x2)] = None => - pi.[x2] = None => - hs.[hx] = Some (x2,Known) => - hinv hs y2 = None => - INV_CF_G1 hs.[ch <- (y2,Known)] (ch + 1) - PFm.[(x1,x2) <- (y1,y2)] PFmi.[(y1,y2) <- (x1,x2)] - G1m.[(x1,x2) <- (y1,y2)] G1mi.[(y1,y2) <- (x1,x2)] - G1mh.[(x1,hx) <- (y1,ch)] G1mhi.[(y1,ch) <- (x1,hx)] - ro pi. + INV_CF_G1 hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi + => PFm.[(x1,x2)] = None + => G1m.[(x1,x2)] = None + => pi.[x2] = None + => hs.[hx] = Some (x2,Known) + => (forall f h, hs.[h] <> Some (y2,f)) + => INV_CF_G1 hs.[ch <- (y2,Known)] (ch + 1) + PFm.[(x1,x2) <- (y1,y2)] PFmi.[(y1,y2) <- (x1,x2)] + G1m.[(x1,x2) <- (y1,y2)] G1mi.[(y1,y2) <- (x1,x2)] + G1mh.[(x1,hx) <- (y1,ch)] G1mhi.[(y1,ch) <- (x1,hx)] + ro pi. proof. -move=> Hinv x1x2_notin_PFm x1x2_notin_G1m x2_notin_pi hs_hx y2_notinrng_hs. +move=> HINV PFm_x1x2 G1m_x1x2 pi_x2 hs_hx y2_notin_rng1_hs. split. -+ apply/(@eqm_handles_up _ _ _ _ _ (x1,x2) (y1,y2) Known). - + by case: Hinv=> _ _ _ _ _ _ []. - + by case: Hinv=> _ _ _ _ _ _ []; smt (in_dom). - + by rewrite hs_hx. - + by case: Hinv. -+ apply/(@eqmi_handles_up _ _ _ _ _ (x1,x2) (y1,y2) Known). - + move: y2_notinrng_hs=> /hinv_notin_rng y2_notinrng_hs. - rewrite negb_exists /= => f; rewrite in_rng negb_exists /= => h. - by rewrite y2_notinrng_hs. - + by case: Hinv=> _ _ _ _ _ _ []; smt (in_dom). - + by rewrite hs_hx. - + by case: Hinv. -+ move=> [xa xc]; rewrite !getP; case: ((xa,xc) = (x1,x2))=> //= _ h. - by case: Hinv=> _ _ ->. -+ move=> [xa xc]; rewrite !getP; case: ((xa,xc) = (y1,y2))=> //= _ h. - by case: Hinv=> _ _ _ ->. ++ by apply/hs_addh=> //=; case: HINV. +(* + apply/inv_addm; 1:by case: HINV. *) +(* + have ^ /m_mh_of_INV Hm_mh /hs_of_INV Hhs := HINV. *) +(* by apply/(notin_m_notin_mh _ _ _ _ Hm_mh PFm_x1x2 hs_hx). *) +(* have ^ /mi_mhi_of_INV Hmi_mhi /hs_of_INV Hhs := HINV. *) +(* by apply/(ch_notin_dom2_mh _ _ Hmi_mhi Hhs). *) ++ have ^ /hs_of_INV ^ Hhs [] Hhuniq _ _ /m_mh_of_INV := HINV. + move=> /m_mh_addh_addm /(_ hx x1 x2 ch y1 y2 Known Hhuniq hs_hx _) //. + exact/ch_notin_dom_hs. ++ have ^ /hs_of_INV ^ Hhs [] Hhuniq _ _ /mi_mhi_of_INV := HINV. + move=> /mi_mhi_addh_addmi /(_ hx x1 x2 ch y1 y2 Known _ hs_hx _) //. + exact/ch_notin_dom_hs. ++ by have /incl_of_INV/incl_addm ->:= HINV. ++ by have /incli_of_INV/incl_addm ->:= HINV. + split. - + move=> xa xh ya yh; rewrite getP; case: ((xa,xh) = (x1,hx))=> [[#] <*>> [#] <<*> /=|]. - + exists x2 Known y2 Known=> //=; rewrite !getP hs_hx /=. - by case: Hinv=> _ _ _ _ _ _ []; smt (in_dom). - move=> xaxh_neq_x1hx mh_xaxh. - have [] _ _ _ _ [] + _ _ _ - /(_ _ _ _ _ mh_xaxh):= Hinv. - move=> [xc xf yc] [] /= - [#] hs_xh hs_yh h. - + exists xc xf yc Unknown=> /=; rewrite !getP hs_xh hs_yh. - split; first by case: Hinv=> _ _ _ _ _ _ []; smt (in_dom). - split; first by case: Hinv=> _ _ _ _ _ _ []; smt (in_dom). - elim: h=> p v [#] Hro Hpath; exists p v; rewrite Hro /=. - apply/build_hpath_up=> //=. - rewrite in_dom -negP; case: {-1}(G1mh.[(x1,hx)]) (eq_refl G1mh.[(x1,hx)])=> [//=|[x' hx'] mh_x1hx]. - have [] [] _ /(_ _ _ _ _ mh_x1hx) + _ _ _ _ _ _:= Hinv. - by move=> [xc0 xf0 yc0 yf0] [#] <<*>; rewrite hs_hx => [#] <<*>; rewrite x1x2_notin_PFm. - move=> ->> {xf} /=; exists xc Known yc Known=> //=. - rewrite !getP. - have -> //=: (xa,xc) <> (x1,x2). - + move: xaxh_neq_x1hx; apply/contra=> [#] <*>> /=. - by case: Hinv=> _ _ _ _ _ _ [] /(_ xh hx _ _ hs_xh hs_hx). - by rewrite h; case: Hinv=> _ _ _ _ _ _ []; smt (in_dom). - move=> p xa b; have [] _ _ _ _ [] _ -> _ _ := Hinv. - apply/exists_iff=> v /=; apply/exists_iff=> xh /=; apply/exists_iff=> yh /=. - split=> -[#]. - + move=> hpath hG1mh; rewrite getP; case: ((v +^ xa,xh) = (x1,hx))=> [[#] <<*>|_]. - + have [] [] _ + _ _ _ _ _ _ -/(_ _ _ _ _ hG1mh):= Hinv. - by move=> [xc xf yc yf] [#]; rewrite hs_hx /= => [#] <<*>; rewrite x1x2_notin_PFm. - rewrite hG1mh //=. - apply/build_hpath_up=> //=; rewrite in_dom. - case: {-1}(G1mh.[(x1,hx)]) (eq_refl G1mh.[(x1,hx)])=> [//|[xa' xc'] G1mh_xaxc']. - have [] [] _ /(_ _ _ _ _ G1mh_xaxc') + _ _ _ _ _ _:= Hinv. - by move=> [xc xf yc yf] [#]; rewrite hs_hx=> [#] <<*>; rewrite x1x2_notin_PFm. - rewrite getP; case: ((v +^ xa,xh) = (x1,hx))=> [[#] <*> + [#] <*>|]. - + move=> /build_hpathP [<*> /=|]. - + have [] _ _ _ _ _ _ [] _ + _:= Hinv. - rewrite hs_hx => /= [#] <*>. - have [] _ _ _ _ _ [] /(_ c0 [] b0) /iffRL + _ := Hinv. - move=> /(_ _); 1:by exists 0=> /#. - by rewrite x2_notin_pi. - move=> p' b' v' h' ->> Hpath Hextend; split. - + apply/build_hpathP/(@Extend G1mh (rcons p' b') v hx p' b' v' h')=> //. -admitted. + + move=> xa' hx' ya' hy'; rewrite getP; case: ((xa',hx') = (x1,hx))=> [[#] <*>> [#] <<*> /=|]. + + exists x2 Known y2 Known=> //=; rewrite !getP /=. + by have /hs_of_INV [] _ _ dom_hs /#:= HINV. + move=> xahx'_neq_x1hx; have /mh_of_INV [] Hmh _ /Hmh {Hmh} := HINV. + move=> [xc fx yc] [] /= [#] hs_hx' hs_hy'=> [[p v] [Hro Hpath]|<*> Gm_xa'xc]. + + exists xc fx yc Unknown=> /=; rewrite !getP hs_hx' hs_hy'. + rewrite (dom_hs_neq_ch hs xc fx _ hs_hx') /=; 1:by case: HINV. + rewrite (dom_hs_neq_ch hs yc Unknown _ hs_hy')/= ; 1:by case: HINV. + exists p v; rewrite Hro /=; apply/build_hpath_up/(notin_m_notin_mh _ _ _ _ _ PFm_x1x2 hs_hx). + + done. + by case: HINV. + exists xc Known yc Known=> //=; rewrite !getP; case: ((xa',xc) = (x1,x2))=> [/#|]. + rewrite Gm_xa'xc /= (dom_hs_neq_ch hs xc Known _ hs_hx') /=; 1:by case: HINV. + by rewrite (dom_hs_neq_ch hs yc Known _ hs_hy')/= ; 1:by case: HINV. + move=> p xa b; have /mh_of_INV [] _ -> := HINV; split. + + move=> [v hi hf] [#] Hpath mh_vxahi; exists v hi hf. + rewrite getP; case: ((v +^ xa,hi) = (x1,hx))=> [[#] <*>|_]. + + move: mh_vxahi; have /m_mh_of_INV [] _ H /H {H}:= HINV. + by move=> [xc fx yc fy] [#]; rewrite hs_hx=> [#] <*>; rewrite PFm_x1x2. + rewrite mh_vxahi /=; apply/build_hpath_up=> //. + by apply/(notin_m_notin_mh _ _ _ _ _ PFm_x1x2 hs_hx); case: HINV. + move=> [v hi hf] [#]. + have no_path_to_hx: forall p0 v0, build_hpath G1mh p0 <> Some (v0,hx). + + have /pi_of_INV [] /(_ x2):= HINV; rewrite pi_x2 /=. + by move=> + p0 v0 - /(_ p0 v0) /negb_exists /(_ hx) /=; rewrite hs_hx. + have H /H {H} := build_hpath_down G1mh x1 hx y1 ch p v hi no_path_to_hx. + rewrite getP. case: ((v +^ xa,hi) = (x1,hx))=> [[#] <*>|_ Hpath Hextend]. + + by rewrite no_path_to_hx. + by exists v hi hf. ++ split=> c p v; have /pi_of_INV [] -> := HINV. + apply/exists_iff=> h /=; split=> [#]. + + move=> /build_hpath_up /(_ x1 hx y1 ch _). + + by apply/(notin_m_notin_mh hs PFm x2 Known); case:HINV. + move=> -> /=; rewrite getP. + by have /hs_of_INV [] _ _ dom_hs ^ + /dom_hs /#:= HINV. + have no_path_to_hx: forall p0 v0, build_hpath G1mh p0 <> Some (v0,hx). + + have /pi_of_INV [] /(_ x2):= HINV; rewrite pi_x2 /=. + by move=> + p0 v0 - /(_ p0 v0) /negb_exists /(_ hx) /=; rewrite hs_hx. + have H /H {H} := build_hpath_down G1mh x1 hx y1 ch p v h no_path_to_hx. + move=> ^ Hpath -> /=; rewrite getP; case: (h = ch)=> [<*> /= [#] <*>|//=]. + move: Hpath=> /build_hpathP [<*>|]. + + by have /hs_of_INV [] _ + H - /H {H}:= HINV. + move=> p' b' v' h' <*> _; have /m_mh_of_INV [] _ H /H {H}:= HINV. + by move=> [xc fx yc fy] [#] _; have /hs_of_INV [] _ _ H /H {H}:= HINV. +qed. clone export ConcreteF as ConcreteF1. @@ -1028,11 +1056,10 @@ section AUX. (eq_refl (INV_CF_G1 hs0 ch0 PFm PFmi G1m G1mi G1mh G1mhi ro0 pi0)); last first. + by move=> h; exfalso=> &1 &2 [#] <*>; rewrite h. move=> /eqT inv0; proc; case @[ambient] {-1}(PFm.[(x1,x2)]) (eq_refl (PFm.[(x1,x2)])). - + move=> x1x2_notin_PFm. - move: (INV_CF_G1_notin_PFm_notin_G1m _ _ _ _ _ _ _ _ _ _ _ inv0 x1x2_notin_PFm). - move=> x1x2_notin_G1m. - rcondt{1} 1; 1:by move=> //= &1; skip=> &2 [#] <*>; rewrite in_dom x1x2_notin_PFm. - rcondt{2} 1; 1:by move=> //= &1; skip=> &2 [#] <*>; rewrite in_dom x1x2_notin_G1m. + + move=> PFm_x1x2. + have /incl_of_INV /(notin_m_notin_Gm _ _ (x1,x2)) /(_ _) // Gm_x1x2 := inv0. + rcondt{1} 1; 1:by move=> //= &1; skip=> &2 [#] <*>; rewrite in_dom PFm_x1x2. + rcondt{2} 1; 1:by move=> //= &1; skip=> &2 [#] <*>; rewrite in_dom Gm_x1x2. case @[ambient]: {-1}(pi0.[x2]) (eq_refl (pi0.[x2])). + move=> x2_in_pi; rcondf{2} 1. + by move=> //= &1; skip=> &2 [#] <*>; rewrite in_dom x2_in_pi. @@ -1056,34 +1083,32 @@ section AUX. + by auto. case @[ambient]: {-1}(getflag hs0 x2) (eq_refl (getflag hs0 x2)). + rewrite getflagP_none => x2f_notin_rng_hs0; rcondt{2} 3. - + by move=> &1; auto=> &2 />; rewrite x2f_notin_rng_hs0. + + move=> &1; auto=> &2 /> _ _ _; rewrite in_rng negb_exists /=. + exact/(@x2f_notin_rng_hs0 Known). rcondf{2} 6. + move=> &1; auto=> &2 />. have ->: hinvK FRO.m{2}.[G1.chandle{2} <- (x2,Known)] x2 = Some G1.chandle{2}. + rewrite (@huniq_hinvK_h G1.chandle{2} FRO.m{2}.[G1.chandle{2} <- (x2,Known)] x2) //. + move=> hx hy [] xc xf [] yc yf /=. rewrite !getP; case: (hx = G1.chandle{2}); case: (hy = G1.chandle{2})=> //=. - + move=> _ + [#] - <*>. - by have:= (x2f_notin_rng_hs0 yf); rewrite in_rng negb_exists /= => ->. - + move=> + _ + [#] - <*>. - by have:= (x2f_notin_rng_hs0 xf); rewrite in_rng negb_exists /= => ->. - by move=> _ _; case: inv0=> _ _ _ _ _ _ [] + _ _ - /(_ hx hy (xc,xf) (yc,yf)). + + by move=> _ + [#] - <*>; have:= (x2f_notin_rng_hs0 yf hy). + + by move=> + _ + [#] - <*>; have:= (x2f_notin_rng_hs0 xf hx). + by move=> _ _; have /hs_of_INV [] + _ _ - /(_ hx hy (xc,xf) (yc,yf)) := inv0. by rewrite !getP. rewrite oget_some=> _ _ _. have -> //: !mem (dom G1.mh{2}) (x1,G1.chandle{2}). rewrite in_dom /=; case: {-1}(G1.mh.[(x1,G1.chandle)]{2}) (eq_refl (G1.mh.[(x1,G1.chandle)]{2}))=> //= -[xa xh]; rewrite -negP. - case: inv0=> - [] _ + _ _ _ _ _ [] _ _ h_handles. - move=> /(_ x1 G1.chandle{2} xa xh) h /h [] xc xf yc yf. - by have ->: FRO.m.[G1.chandle]{2} = None by smt (in_dom). - case: (x2 <> y2{2} /\ (forall f, !mem (rng hs0) (y2{2},f))). + have ^/m_mh_of_INV [] _ + /hs_of_INV [] _ _ h_handles := inv0. + by move=> /(_ x1 G1.chandle{2} xa xh) h /h [] xc xf yc yf [#] /h_handles. + case: (x2 <> y2{2} /\ (forall f h, hs0.[h] <> Some (y2{2},f))). + auto=> &1 &2 [#] !<<- -> -> !->> {&1} /= _ x2_neq_y2 y2_notin_hs _ _. rewrite getP /= oget_some /= -addzA /=. rewrite (@huniq_hinvK_h ch0 hs0.[ch0 <- (x2,Known)] x2); 2:by rewrite getP. + move=> @/huniq h1 h2 [c1 f1] [c2 f2]; rewrite !getP /=. case: (h1 = ch0); case: (h2 = ch0)=> //=. - + by move=> _ + [#] - <*>; move: (x2f_notin_rng_hs0 f2); rewrite in_rng negb_exists=> /= ->. - + by move=> + _ + [#] <*> - <*>; move: (x2f_notin_rng_hs0 f1); rewrite in_rng negb_exists=> /= ->. - move=> _ _; case: inv0=> _ _ _ _ _ _ [] + _ _ - h. + + by move=> _ + [#] - <*>; move: (x2f_notin_rng_hs0 f2 h2). + + by move=> + _ + [#] <*> - <*>; move: (x2f_notin_rng_hs0 f1 h1). + have /hs_of_INV [] + _ _ _ _ - h := inv0. by apply/h; rewrite getP. by rewrite oget_some; exact/lemma1. conseq (_: _ ==> G1.bcol{2})=> //=. @@ -1091,10 +1116,9 @@ section AUX. case: (hinvP hs0.[ch0 <- (x2,Known)] y2{1})=> //= -> /=. move=> hs0_spec; split=> [|f]. + by have:= hs0_spec ch0 Known; rewrite getP. - rewrite in_rng negb_exists /= => h. - have:= hs0_spec h f; rewrite getP; case: (h = ch0)=> [<*>|//=]. - by have -> //=: hs0.[ch0] = None; case: inv0=> _ _ _ _ _ _ [] _ _; smt (in_dom). - case; rewrite getflagP_some; 1,3:by case: inv0=> _ _ _ _ _ _ []. + move=> h; have:= hs0_spec h f; rewrite getP; case: (h = ch0)=> [<*>|//=]. + by move=> _; rewrite -negP; have /hs_of_INV [] _ _ H /H {H}:= inv0. + case; rewrite getflagP_some; 1,3:by have /hs_of_INV []:= inv0. + by move=> x2_is_U; conseq (_: G1.bext{2})=> //=; auto=> &1 &2 />; rewrite x2_is_U. move=> x2_is_K; rcondf{2} 3; 1:by move=> &1; auto. have:= x2_is_K; rewrite in_rng=> - [hx] hs0_hx. @@ -1118,22 +1142,22 @@ section AUX. + auto=> &1 &2 /> _ -> /= _; split. + move: x2_is_K; rewrite in_rng /= => -[hx2] hs_hx2. rewrite in_rng negb_exists /==> h; rewrite -negP=> hs_h. - case: inv0=> _ _ _ _ _ _ [] Hhuniq _ _. + have /hs_of_INV [] Hhuniq _ _ := inv0. by move: (Hhuniq _ _ _ _ hs_hx2 hs_h)=> ht; move: ht hs_h=> /= <*>; rewrite hs_hx2. rewrite (@huniq_hinvK_h hx FRO.m{2} x2) //. - by case: inv0=> _ _ _ _ _ _ []. + by have /hs_of_INV [] := inv0. have x1hx_notin_G1m: !mem (dom G1mh) (x1,hx). + rewrite in_dom; case: {-1}(G1mh.[(x1,hx)]) (eq_refl G1mh.[(x1,hx)])=> //=. move=> [mhx1 mhx2]; rewrite -negP=> h. - have:= inv0=> -[] [] _ hg _ _ _ _ _ _. + have /m_mh_of_INV [] _ hg := inv0. have [xa xh ya yh] := hg _ _ _ _ h. - by rewrite hs0_hx=> [#] <*>; rewrite x1x2_notin_PFm. + by rewrite hs0_hx=> [#] <*>; rewrite PFm_x1x2. rcondf{2} 1. + by move=> &m; auto=> //= &hr [#] <*>; rewrite x1hx_notin_G1m. auto=> &1 &2 [#] !<<- -> -> !->> _ /= hinv_y2_none. - rewrite getP /= oget_some /=. - exact/lemma2. - move=> [p0 v0] ^ pi_x2. have [] _ _ _ _ _ [] -> _ [hx2] [#] Hpath hs_hx2:= inv0. + rewrite getP /= oget_some /=; apply/lemma2=> //. + + by case: (hinvP hs0 y2{2})=> [_ + f h|//=] - ->. + move=> [p0 v0] ^ pi_x2. have /pi_of_INV [] -> [hx2] [#] Hpath hs_hx2:= inv0. rcondt{2} 1. by move=> &m; auto=> &hr [#] !<<- _ _ ->> /= _; rewrite in_dom pi_x2. rcondf{2} 6. + auto; inline *; auto=> &hr [#] !<<- _ _ !->> _ /= _ _ _ _ /=. @@ -1141,10 +1165,10 @@ section AUX. rcondf{2} 7. + auto; inline *; auto=> &hr [#] !<<- _ _ !->> _ /= _ _ _ _ /=. rewrite negb_and; left; rewrite (@huniq_hinvK_h hx2 hs0 x2) // 2:oget_some. - + by case: inv0=> _ _ _ _ _ _ []. + + by have /hs_of_INV []:= inv0. rewrite in_dom; case: {-1}(G1mh.[(x1,hx2)]) (eq_refl (G1mh.[(x1,hx2)]))=> [//=|[xa xc] G1mh_x1hx2]. - have [] [] _ /(_ _ _ _ _ G1mh_x1hx2) [xc0 xf0 yc0 yf0] + _ _ _ _ _ _:= inv0. - by move=> [#]; rewrite hs_hx2=> [#] !<<- {xc0 xf0}; rewrite x1x2_notin_PFm. + have /m_mh_of_INV [] _ /(_ _ _ _ _ G1mh_x1hx2) [xc0 xf0 yc0 yf0] := inv0. + by move=> [#]; rewrite hs_hx2=> [#] !<<- {xc0 xf0}; rewrite PFm_x1x2. rcondt{2} 15. + auto; inline *; auto=> &hr [#] !<<- _ _ !->> _ /= _ _ _ _ /=. by rewrite in_dom pi_x2. @@ -1152,32 +1176,32 @@ section AUX. + auto=> &hr [#] !<<- _ _ !->> _ /= _ _; rewrite pi_x2 oget_some /=. rewrite in_dom; case: {-1}(ro0.[rcons p0 (v0 +^ x1)]) (eq_refl (ro0.[rcons p0 (v0 +^ x1)])). + done. - move=> bo ^ro_pvx1 /=. have [] _ _ _ _ [] _ -> _ _:= inv0. + move=> bo ^ro_pvx1 /=. have /mh_of_INV [] _ ->:= inv0. rewrite negb_exists=> ? /=; rewrite negb_exists=> ? /=; rewrite negb_exists=> yh /=. rewrite Hpath /=; rewrite negb_and -implyNb /= => [#] !<<-. rewrite xorwA xorwK xorwC xorw0 -negP=> G1mh_x1hx2. - have [] [] _ /(_ _ _ _ _ G1mh_x1hx2) + _ _ _ _ _ _ := inv0. + have /m_mh_of_INV [] _ /(_ _ _ _ _ G1mh_x1hx2) := inv0. move=> [xc xf yc yf] [#]; rewrite hs_hx2=> [#] <*>. - by rewrite x1x2_notin_PFm. + by rewrite PFm_x1x2. auto. admit. (* this is the easy case *) move=> [xa xc] PFm_x1x2. rcondf{1} 1; 1:by auto=> &hr [#] !<<- _ _ ->>; rewrite in_dom PFm_x1x2. - have [] [] /(_ _ _ _ _ PFm_x1x2) + _ _ _ _ _ _ _ := inv0. + have /m_mh_of_INV [] + _ - /(_ _ _ _ _ PFm_x1x2) := inv0. move=> [hx2 fx2 hy2 fy2] [#] hs_hx2 hs_hy2 G1mh_x1hx2. case @[ambient]: {-1}(G1m.[(x1,x2)]) (eq_refl (G1m.[(x1,x2)])); last first. + move=> [ya yc] G1m_x1x2; rcondf{2} 1; 1:by auto=> &hr [#] !<<- _ _ ->>; rewrite in_dom G1m_x1x2. - auto=> &1 &2 [#] <*> -> -> -> /=; have [] _ _ /(_ (x1,x2)) + _ _ _ _ := inv0. + auto=> &1 &2 [#] <*> -> -> -> /=; have /incl_of_INV /(_ (x1,x2)) := inv0. by rewrite PFm_x1x2 G1m_x1x2 /= => [#] !<<- {ya yc}. move=> x1x2_notin_G1m; rcondt{2} 1; 1:by auto=> &hr [#] !<<- _ _ ->>; rewrite in_dom x1x2_notin_G1m. have <*>: fy2 = Unknown. - + case: inv0=> _ _ _ _ [] /(_ _ _ _ _ G1mh_x1hx2) + _ _ _. + + have /mh_of_INV [] /(_ _ _ _ _ G1mh_x1hx2) + _ := inv0. move=> [xc0 xf0 yc0 yf0] [#]; rewrite hs_hx2 hs_hy2=> [#] !<<- [#] !<<- {xc0 xf0 yc0 yf0}. by case: fy2 hs_hy2 G1mh_x1hx2=> //=; rewrite x1x2_notin_G1m. case @[ambient]: fx2 hs_hx2=> hs_hx2. + swap{2} 3 -2; seq 0 1: (G1.bext{2}); last by inline*; if{2}; auto; smt (@Block @Capacity). by auto=> ? ? [#] !<<- _ -> ->> _ /=; rewrite in_rng; exists hx2. - have [] _ _ _ _ [] /(_ _ _ _ _ G1mh_x1hx2) + _ _ _:= inv0. + have /mh_of_INV []/(_ _ _ _ _ G1mh_x1hx2) + _:= inv0. move=> [xc0 xf0 yc0 yf0] [#]; rewrite hs_hx2 hs_hy2=> [#] !<<- [#] !<<- {xc0 xf0 yc0 yf0} /= [p0 v0] [#] Hro Hpath. - have [] _ _ _ _ _ [] /(_ x2 p0 v0) /iffRL Hpi _:= inv0. + have /pi_of_INV [] /(_ x2 p0 v0) /iffRL Hpi:= inv0. move: (Hpi _); first by exists hx2. move=> pi_x2; rcondt{2} 1; 1:by auto=> &hr [#] <*>; rewrite in_dom pi_x2. inline F.RO.get. @@ -1186,13 +1210,13 @@ section AUX. rcondt{2} 9. + auto=> &hr [#] !<<- _ _ ->> _ /= _ _ _ _. rewrite (@huniq_hinvK_h hx2 hs0 x2) // 2:in_dom 2:G1mh_x1hx2 2:!oget_some /=. - + by case: inv0=> _ _ _ _ _ _ []. + + by have /hs_of_INV []:= inv0. by rewrite /in_dom_with in_dom hs_hy2. rcondt{2} 14; first by auto=> &hr [#] !<<- _ _ ->> _ /=; rewrite in_dom pi_x2. auto=> &1 &2 [#] !<<- -> -> ->> _ /=; rewrite Block.DWord.bdistr_ll Capacity.DWord.cdistr_ll /=. move=> _ _ _ _; rewrite PFm_x1x2 pi_x2 !oget_some //=. rewrite (@huniq_hinvK_h hx2 hs0 x2) // ?oget_some. - + by case: inv0=> _ _ _ _ _ _ []. + + by have /hs_of_INV []:= inv0. rewrite Hro G1mh_x1hx2 hs_hy2 ?oget_some //=. (* lemma 3 *) admit. (* Stopped here *) From 949fcfd14c143d31d6a51a95a688157e567fac96 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Wed, 24 Aug 2016 09:55:21 +0100 Subject: [PATCH 206/525] Pushing for discussion with Benjamin. --- proof/core/Handle.eca | 381 +++++++++++++++--------------------------- 1 file changed, 134 insertions(+), 247 deletions(-) diff --git a/proof/core/Handle.eca b/proof/core/Handle.eca index 01d62d5..afa7766 100644 --- a/proof/core/Handle.eca +++ b/proof/core/Handle.eca @@ -74,7 +74,7 @@ module G1(D:DISTINGUISHER) = { m.[x] <- y; mi.[y] <- x; } else { - bcol <- bcol \/ hinv FRO.m y.`2 <> None; + bcol <- bcol \/ hinv FRO.m y.`2 <> None; hy2 <- chandle; chandle <- chandle + 1; FRO.m.[hy2] <- (y.`2, Known); @@ -87,7 +87,6 @@ module G1(D:DISTINGUISHER) = { (p,v) <- oget paths.[x.`2]; paths.[y.`2] <- (rcons p (v +^ x.`1), y.`1); } - } else { y <- oget m.[x]; } @@ -153,6 +152,16 @@ module G1(D:DISTINGUISHER) = { }. (* -------------------------------------------------------------------------- *) +(** The state of CF contains only the map PF.m. + The state of G1 contains: + - the map hs that associates handles to flagged capacities; + - the map G1.m that represents the *public* view of map PF.m; + - the map G1.mh that represents PF.m with handle-based indirection; + - the map ro that represents the functionality; + - the map pi that returns *the* known path to a capacity if it exists. + The following invariants encode these facts, and some auxiliary + knowledge that can most likely be deduced but is useful in the proof. **) + (** RELATIONAL: Map, Handle-Map and Handles are compatible **) inductive m_mh (hs : handles) (m : smap) (mh : hsmap) = | INV_m_mh of (forall xa xc ya yc, @@ -168,156 +177,6 @@ inductive m_mh (hs : handles) (m : smap) (mh : hsmap) = /\ hs.[hy] = Some (yc,fy) /\ m.[(xa,xc)] = Some (ya,yc)). -(* (* Consequences of (xa,xc) \in (dom m) *) *) -(* lemma eqm_handles_m_some (hs : handles) (m : smap) (mh : hsmap) *) -(* xa xc ya yc: *) -(* huniq hs *) -(* => eqm_handles hs m mh *) -(* => m.[(xa,xc)] = Some (ya,yc) *) -(* => exists hx fx hy fy, *) -(* hs.[hx] = Some (xc,fx) *) -(* /\ hs.[hy] = Some (yc,fy) *) -(* /\ mh.[(xa,hx)] = Some (ya,hy). *) -(* proof. by move=> hs_huniq [] + _ m_xaxc - /(_ _ _ _ _ m_xaxc). qed. *) - -(* lemma eqm_handles_m_some_xy (hs : handles) (m : smap) (mh : hsmap) *) -(* xa xc ya yc hx fx hy fy: *) -(* huniq hs *) -(* => eqm_handles hs m mh *) -(* => m.[(xa,xc)] = Some (ya,yc) *) -(* => hs.[hx] = Some (xc,fx) *) -(* => hs.[hy] = Some (yc,fy) *) -(* => mh.[(xa,hx)] = Some (ya,hy). *) -(* proof. *) -(* move=> hs_huniq [] + _ m_xaxc hs_hx hs_hy - /(_ _ _ _ _ m_xaxc) [xh xf yh yf] [#]. *) -(* by move=> /(hs_huniq _ _ _ _ hs_hx) /= <<*> /(hs_huniq _ _ _ _ hs_hy) /= <<*>. *) -(* qed. *) - -(* lemma eqm_handles_m_some_x (hs : handles) (m : smap) (mh : hsmap) *) -(* xa xc ya yc hx fx: *) -(* huniq hs *) -(* => eqm_handles hs m mh *) -(* => m.[(xa,xc)] = Some (ya,yc) *) -(* => hs.[hx] = Some (xc,fx) *) -(* => exists hy fy, *) -(* hs.[hy] = Some (yc,fy) *) -(* /\ mh.[(xa,hx)] = Some (ya,hy). *) -(* proof. *) -(* move=> hs_huniq [] + _ m_xaxc hs_hx - /(_ _ _ _ _ m_xaxc) [xh xf yh yf] [#]. *) -(* by move=> /(hs_huniq _ _ _ _ hs_hx) /= <<*> hs_hy mh_xaxc; exists yh yf. *) -(* qed. *) - -(* lemma eqm_handles_m_some_y (hs : handles) (m : smap) (mh : hsmap) *) -(* xa xc ya yc hy fy: *) -(* huniq hs *) -(* => eqm_handles hs m mh *) -(* => m.[(xa,xc)] = Some (ya,yc) *) -(* => hs.[hy] = Some (yc,fy) *) -(* => exists hx fx, *) -(* hs.[hx] = Some (xc,fx) *) -(* /\ mh.[(xa,hx)] = Some (ya,hy). *) -(* proof. *) -(* move=> hs_huniq [] + _ m_xaxc hs_hy - /(_ _ _ _ _ m_xaxc) [xh xf yh yf] [#]. *) -(* by move=> hs_hx /(hs_huniq _ _ _ _ hs_hy) /= <<*> mh_xaxc; exists xh xf. *) -(* qed. *) - -(* (* Consequence of (xa,xc) \notin (dom m) *) *) -(* lemma eqm_handles_m_none_in_mh (hs : handles) (m : smap) (mh : hsmap) *) -(* xa xc ya yc hx: *) -(* eqm_handles hs m mh *) -(* => m.[(xa,xc)] = None *) -(* => mh.[(xa,hx)] = Some (ya,yc) *) -(* => (forall fx, hs.[hx] <> Some (xc,fx)). *) -(* proof. by move=> [] _ Hmh m_xaxc /Hmh [xc0 fx yc0 fy] [#] -> /#. qed. *) - -(* lemma eqm_handles_m_none_in_hs (hs : handles) (m : smap) (mh : hsmap) *) -(* xa xc hx fx: *) -(* eqm_handles hs m mh *) -(* => m.[(xa,xc)] = None *) -(* => hs.[hx] = Some (xc,fx) *) -(* => mh.[(xa,hx)] = None. *) -(* proof. *) -(* move=> [] _ Hmh m_xaxc. *) -(* case: {-1}(mh.[(xa,hx)]) (eq_refl (mh.[(xa,hx)]))=> [//|]. (* TODO: contra *) *) -(* by move=> [ya hy] /Hmh [xc0 fx0 yc fy] [#] /#. *) -(* qed. *) - -(* (* Consequence of (xa,hx) \in (dom mh) *) *) -(* lemma eqm_handles_mh_some (hs : handles) (m : smap) (mh : hsmap) *) -(* xa hx ya hy: *) -(* huniq hs *) -(* => eqm_handles hs m mh *) -(* => mh.[(xa,hx)] = Some (ya,hy) *) -(* => exists xc fx yc fy, *) -(* hs.[hx] = Some (xc,fx) *) -(* /\ hs.[hy] = Some (yc,fy) *) -(* /\ m.[(xa,xc)] = Some (ya,yc). *) -(* proof. by move=> hs_huniq [] _ + mh_xaxc - /(_ _ _ _ _ mh_xaxc). qed. *) - -(* lemma eqm_handles_mh_some_xy (hs : handles) (m : smap) (mh : hsmap) *) -(* xa hx ya hy xc fx yc fy: *) -(* huniq hs *) -(* => eqm_handles hs m mh *) -(* => mh.[(xa,hx)] = Some (ya,hy) *) -(* => hs.[hx] = Some (xc,fx) *) -(* => hs.[hy] = Some (yc,fy) *) -(* => m.[(xa,xc)] = Some (ya,yc). *) -(* proof. *) -(* move=> hs_huniq [] _ + mh_xaxc hs_hx hs_hy - /(_ _ _ _ _ mh_xaxc) [xc' xf' yc' yf'] [#]. *) -(* by rewrite hs_hx hs_hy /= => [#] <<*> [#] <<*>. *) -(* qed. *) - -(* lemma eqm_handles_mh_some_x (hs : handles) (m : smap) (mh : hsmap) *) -(* xa hx ya hy xc fx: *) -(* huniq hs *) -(* => eqm_handles hs m mh *) -(* => mh.[(xa,hx)] = Some (ya,hy) *) -(* => hs.[hx] = Some (xc,fx) *) -(* => exists yc fy, *) -(* hs.[hy] = Some (yc,fy) *) -(* /\ m.[(xa,xc)] = Some (ya,yc). *) -(* proof. *) -(* move=> hs_huniq [] _ + mh_xaxc hs_hx - /(_ _ _ _ _ mh_xaxc) [xc' fx' yc fy] [#]. *) -(* by rewrite hs_hx /= => [#] <<*> hs_hy m_xaxc; exists yc fy. *) -(* qed. *) - -(* lemma eqm_handles_mh_some_y (hs : handles) (m : smap) (mh : hsmap) *) -(* xa hx ya hy yc fy: *) -(* huniq hs *) -(* => eqm_handles hs m mh *) -(* => mh.[(xa,hx)] = Some (ya,hy) *) -(* => hs.[hy] = Some (yc,fy) *) -(* => exists xc fx, *) -(* hs.[hx] = Some (xc,fx) *) -(* /\ m.[(xa,xc)] = Some (ya,yc). *) -(* proof. *) -(* move=> hs_huniq [] _ + mh_xaxc hs_hy - /(_ _ _ _ _ mh_xaxc) [xc fx yc' fy'] [#] hs_hx. *) -(* by rewrite hs_hy /= => [#] <<*> m_xaxc; exists xc fx. *) -(* qed. *) - -(* (* Consequences of (xa,hx) \notin (dom mh) *) *) -(* lemma eqm_handles_mh_none_in_m (hs : handles) (m : smap) (mh : hsmap) *) -(* xa xc ya yc hx: *) -(* huniq hs *) -(* => eqm_handles hs m mh *) -(* => mh.[(xa,hx)] = None *) -(* => m.[(xa,xc)] = Some (ya,yc) *) -(* => (forall fx, hs.[hx] <> Some (xc,fx)). *) -(* proof. by move=> hs_huniq [] Hm _ mh_xaxc /Hm [hx0 fx hy0 fy] [#] /#. qed. *) - -(* lemma eqm_handles_mh_none_in_hs (hs : handles) (m : smap) (mh : hsmap) *) -(* xa hx xc fx: *) -(* huniq hs *) -(* => eqm_handles hs m mh *) -(* => mh.[(xa,hx)] = None *) -(* => hs.[hx] = Some (xc,fx) *) -(* => m.[(xa,xc)] = None. *) -(* proof. *) -(* move=> hs_huniq [] Hm _ m_xaxc. *) -(* case: {-1}(m.[(xa,xc)]) (eq_refl (m.[(xa,xc)]))=> [//|]. (* TODO: contra *) *) -(* by move=> [ya hy] /Hm [xc0 fx0 yc fy] [#] /#. *) -(* qed. *) - (* WELL-FORMEDNESS<2>: Handles, Map, Handle-Map and RO are compatible *) inductive mh_spec (hs : handles) (Gm : smap) (mh : hsmap) (ro : (block list,block) fmap) = | INV_mh of (forall xa hx ya hy, @@ -337,99 +196,7 @@ inductive mh_spec (hs : handles) (Gm : smap) (mh : hsmap) (ro : (block list,bloc build_hpath mh p = Some (v,hx) /\ mh.[(v +^ bn,hx)] = Some (b,hy)). -(* (* Consequences of (xa,hx) \in (dom mh) *) *) -(* lemma mh_spec_mh_some (hs : handles) (Gm : smap) (mh : hsmap) ro *) -(* xa hx ya hy: *) -(* mh_spec hs Gm mh ro *) -(* => mh.[(xa,hx)] = Some (ya,hy) *) -(* => exists xc fx yc fy, *) -(* hs.[hx] = Some (xc,fx) *) -(* /\ hs.[hy] = Some (yc,fy) *) -(* /\ if fy = Known *) -(* then Gm.[(xa,xc)] = Some (ya,yc) *) -(* /\ fx = Known *) -(* else exists p v, *) -(* ro.[rcons p (v +^ xa)] = Some ya *) -(* /\ build_hpath mh p = Some (v,hx). *) -(* proof. by move=> [] + _ mh_xaxc - /(_ _ _ _ _ mh_xaxc). qed. *) - -(* lemma mh_spec_mh_some_y (hs : handles) (Gm : smap) (mh : hsmap) ro *) -(* xa hx ya hy yc fy: *) -(* mh_spec hs Gm mh ro *) -(* => mh.[(xa,hx)] = Some (ya,hy) *) -(* => hs.[hy] = Some (yc,fy) *) -(* => exists xc fx, *) -(* hs.[hx] = Some (xc,fx) *) -(* /\ if fy = Known *) -(* then Gm.[(xa,xc)] = Some (ya,yc) *) -(* /\ fx = Known *) -(* else exists p v, *) -(* ro.[rcons p (v +^ xa)] = Some ya *) -(* /\ build_hpath mh p = Some (v,hx). *) -(* proof. *) -(* move=> Hmh /(mh_spec_mh_some _ _ _ _ _ _ _ _ Hmh) [xc fx yc0 fy0] [#] -> ->. *) -(* by move=> + [#] <<*> - H; exists xc fx. *) -(* qed. *) - -(* lemma mh_spec_mh_some_yK (hs : handles) (Gm : smap) (mh : hsmap) ro *) -(* xa hx ya hy yc: *) -(* mh_spec hs Gm mh ro *) -(* => mh.[(xa,hx)] = Some (ya,hy) *) -(* => hs.[hy] = Some (yc,Known) *) -(* => exists xc, *) -(* hs.[hx] = Some (xc,Known) *) -(* /\ Gm.[(xa,xc)] = Some (ya,yc). *) -(* proof. *) -(* move=> Hmh mh_xaxc /(mh_spec_mh_some_y _ _ _ _ _ _ _ _ _ _ Hmh mh_xaxc) [xc fx] [#] /=. *) -(* by move=> hs_hx Gm_xaxc <*>; exists xc. *) -(* qed. *) - -(* lemma mh_spec_mh_some_yU (hs : handles) (Gm : smap) (mh : hsmap) ro *) -(* xa hx ya hy yc: *) -(* mh_spec hs Gm mh ro *) -(* => mh.[(xa,hx)] = Some (ya,hy) *) -(* => hs.[hy] = Some (yc,Unknown) *) -(* => exists xc fx p v, *) -(* hs.[hx] = Some (xc,fx) *) -(* /\ ro.[rcons p (v +^ xa)] = Some ya *) -(* /\ build_hpath mh p = Some (v,hx). *) -(* proof. *) -(* move=> Hmh mh_xaxc /(mh_spec_mh_some_y _ _ _ _ _ _ _ _ _ _ Hmh mh_xaxc) [xc fx] [#] /=. *) -(* by move=> hs_hx [p v] H; exists xc fx p v. *) -(* qed. *) - -(* lemma mh_spec_mh_some_x (hs : handles) (Gm : smap) (mh : hsmap) ro *) -(* xa hx ya hy xc fx: *) -(* mh_spec hs Gm mh ro *) -(* => mh.[(xa,hx)] = Some (ya,hy) *) -(* => hs.[hx] = Some (xc,fx) *) -(* => exists yc fy, *) -(* hs.[hy] = Some (yc,fy) *) -(* /\ if fy = Known *) -(* then Gm.[(xa,xc)] = Some (ya,yc) *) -(* /\ fx = Known *) -(* else exists p v, *) -(* ro.[rcons p (v +^ xa)] = Some ya *) -(* /\ build_hpath mh p = Some (v,hx). *) -(* proof. *) -(* move=> Hmh /(mh_spec_mh_some _ _ _ _ _ _ _ _ Hmh) [xc0 fx0 yc fy] [#] -> ->. *) -(* by move=> + [#] <<*> - H; exists yc fy. *) -(* qed. *) - -(* lemma mh_spec_mh_some_xU (hs : handles) (Gm : smap) (mh : hsmap) ro *) -(* xa hx ya hy xc: *) -(* mh_spec hs Gm mh ro *) -(* => mh.[(xa,hx)] = Some (ya,hy) *) -(* => hs.[hx] = Some (xc,Unknown) *) -(* => exists yc p v, *) -(* hs.[hy] = Some (yc,Unknown) *) -(* /\ ro.[rcons p (v +^ xa)] = Some ya *) -(* /\ build_hpath mh p = Some (v,hx). *) -(* proof. *) -(* move=> Hmh mh_xaxc /(mh_spec_mh_some_x _ _ _ _ _ _ _ _ _ _ Hmh mh_xaxc) [yc fy] [#] ->. *) -(* by case: fy=> //= - [p v] H; exists yc p v. *) -(* qed. *) - +(* WELL-FORMEDNESS<2>: Handles, Handle-Map and Paths are compatible *) inductive pi_spec (hs : handles) (mh : hsmap) (pi : (capacity,block list * block) fmap) = | INV_pi of (forall c p v, pi.[c] = Some (p,v) <=> @@ -437,14 +204,17 @@ inductive pi_spec (hs : handles) (mh : hsmap) (pi : (capacity,block list * block build_hpath mh p = Some(v,h) /\ hs.[h] = Some (c,Known)). +(* WELL-FORMEDNESS<2>: Handles are well-formed *) inductive hs_spec hs ch = | INV_hs of (huniq hs) & (hs.[0] = Some (c0,Known)) & (forall cf h, hs.[h] = Some cf => h < ch). +(* Useless stuff *) inductive inv_spec (m:('a,'b) fmap) mi = | INV_inv of (forall x y, m.[x] = Some y <=> mi.[y] = Some x). +(* Invariant: maybe we should split relational and non-relational parts? *) inductive INV_CF_G1 (hs : handles) ch (Pm Pmi Gm Gmi : smap) (mh mhi : hsmap) (ro : (block list,block) fmap) pi = | HCF_G1 of (hs_spec hs ch) @@ -629,6 +399,19 @@ move=> ^Hhs [] Hhuniq hs_0 dom_hs xc_notin_rng1_hs; split. by move=> /dom_hs /#. qed. +lemma hs_updh hs ch fx hx xc fx': + hs_spec hs ch + => 0 <> hx + => hs.[hx] = Some (xc,fx) + => hs_spec hs.[hx <- (xc,fx')] ch. +proof. +move=> ^Hhs [] Hhuniq hs_0 dom_hs hx_neq0 hs_hx; split. ++ by move=> h1 h2 [c1 f1] [c2 f2]; rewrite !getP /= /#. ++ by rewrite getP hx_neq0. +move=> cf h; rewrite getP; case: (h = hx)=> [<*> _|_ /dom_hs //]. +by move: hs_hx=> /dom_hs. +qed. + lemma mh_addh hs ch Gm mh ro xc fx: hs_spec hs ch => mh_spec hs Gm mh ro @@ -1003,6 +786,109 @@ split. by move=> [xc fx yc fy] [#] _; have /hs_of_INV [] _ _ H /H {H}:= HINV. qed. +lemma lemma3 hs ch Pm Pmi Gm Gmi mh mhi ro pi xa xc hx ya yc hy p b: + INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi + => Pm.[(xa,xc)] = Some (ya,yc) + => Gm.[(xa,xc)] = None + => mh.[(xa,hx)] = Some (ya,hy) + => hs.[hx] = Some (xc,Known) + => hs.[hy] = Some (yc,Unknown) + => pi.[xc] = Some (p,b) + => INV_CF_G1 hs.[hy <- (yc,Known)] ch + Pm Pmi + Gm.[(xa,xc) <- (ya,yc)] Gmi.[(ya,yc) <- (xa,xc)] + mh mhi + ro pi.[yc <- (rcons p (b +^ xa),ya)]. +proof. +move=> HINV Pm_xaxc Gm_xaxc mh_xahx hs_hx hs_hy pi_xc. +split. ++ have /hs_of_INV /hs_updh /(_ Unknown) H := HINV; apply/H=> {H} //. + by rewrite -negP=> <*>; move: hs_hy; have /hs_of_INV [] _ -> := HINV. ++ split. (* Pull out *) + + move=> xa' xc' ya' yc'; have /m_mh_of_INV [] H _ /H {H}:= HINV. + move=> [hx' fx' hy' fy'] [#] hs_hx' hs_hy' mh_xahx'. + case: (hx' = hy); case: (hy' = hy)=> //= <*> => [|hy'_neq_hy|hx'_neq_hy|Hhx' Hhy']. + + by exists hy Known hy Known; rewrite !getP /= /#. + + by exists hy Known hy' fy'; rewrite !getP hy'_neq_hy /#. + + by exists hx' fx' hy Known; rewrite !getP hx'_neq_hy /#. + by exists hx' fx' hy' fy'; rewrite !getP Hhx' Hhy'. + move=> xa' hx' ya' hy'; have /m_mh_of_INV [] _ H /H {H}:= HINV. + move=> [xc' fx' yc' fy'] [#] hs_hx' hs_hy' m_xaxc'. + case: (hx' = hy); case: (hy' = hy)=> //= <*> => [|hy'_neq_hy|hx'_neq_hy|Hhx' Hhy']. + + by exists yc Known yc Known; rewrite !getP /= /#. + + by exists yc Known yc' fy'; rewrite !getP hy'_neq_hy /#. + + by exists xc' fx' yc Known; rewrite !getP hx'_neq_hy /#. + by exists xc' fx' yc' fy'; rewrite !getP Hhx' Hhy'. ++ split. (* Pull out *) + + move=> xa' xc' ya' yc'; have /mi_mhi_of_INV [] H _ /H {H}:= HINV. + move=> [hx' fx' hy' fy'] [#] hs_hx' hs_hy' mh_xahx'. + case: (hx' = hy); case: (hy' = hy)=> //= <*> => [|hy'_neq_hy|hx'_neq_hy|Hhx' Hhy']. + + by exists hy Known hy Known; rewrite !getP /= /#. + + by exists hy Known hy' fy'; rewrite !getP hy'_neq_hy /#. + + by exists hx' fx' hy Known; rewrite !getP hx'_neq_hy /#. + by exists hx' fx' hy' fy'; rewrite !getP Hhx' Hhy'. + move=> xa' hx' ya' hy'; have /mi_mhi_of_INV [] _ H /H {H}:= HINV. + move=> [xc' fx' yc' fy'] [#] hs_hx' hs_hy' m_xaxc'. + case: (hx' = hy); case: (hy' = hy)=> //= <*> => [|hy'_neq_hy|hx'_neq_hy|Hhx' Hhy']. + + by exists yc Known yc Known; rewrite !getP /= /#. + + by exists yc Known yc' fy'; rewrite !getP hy'_neq_hy /#. + + by exists xc' fx' yc Known; rewrite !getP hx'_neq_hy /#. + by exists xc' fx' yc' fy'; rewrite !getP Hhx' Hhy'. ++ move=> [za zc]; rewrite getP; case: ((za,zc) = (xa,xc))=> // _. + by have /incl_of_INV H /H {H}:= HINV. ++ (* inverse or pre-inverse - probably on mh/mhi *) admit. ++ split; last by have /mh_of_INV [] _:= HINV. + have pi_yc: pi.[yc] = None. + + have /#: forall p b, pi.[yc] <> Some (p,b). + move=> p0 b0; rewrite -negP. + have /pi_of_INV [] -> [h] [#] _ := HINV. + have /hs_of_INV [] Hhuniq _ _^hs_h - /Hhuniq /(_ _ _ hs_hy) := HINV. + by move: hs_h; case: (h = hy)=> [<*>|//=]; rewrite hs_hy. +(* have path_hx: build_hpath mh p = Some (b,hx). + + move: pi_xc; have /pi_of_INV [] -> [h] [#] Hpath := HINV. + by have /hs_of_INV [] Hhuniq _ _ ^hs_h - /Hhuniq /(_ _ _ hs_hx) /= <*>:= HINV. + have ro_pbxa: ro.[rcons p (b +^ xa)] = Some ya. + + have /mh_of_INV [] _ -> := HINV. + by exists b hx hy; rewrite xorwA xorwK xorwC xorw0. + have path_hy: build_hpath mh (rcons p (b +^ xa)) = Some (ya,hy). + + apply/build_hpathP/(@Extend _ _ _ _ p (b +^ xa) b hx)=> //. + by rewrite xorwA xorwK xorwC xorw0. *) + move=> xa' hx' ya' hy'; have /mh_of_INV [] H _ /H {H} [xc' fx' yc' fy'] [#] hs_hx' := HINV. + case: (hy' = hy)=> /= [<*>|]. + + rewrite hs_hy=> /= [#] <*> /= [p' b'] [#] ro_pbxa'. + case: fx' hs_hx'=> hs_hx'. + + case: (hx' = hy)=> /= [<*>|]. + + rewrite hs_hy=> /= [#] <<*>; case: fy'=> //= hs_hy' ?. + exists yc Known yc' Unknown. + + + + + case: ((ya',hy') = (ya,hy))=> [[#] <*>|yahy'_neq_yahy]. + + have /mh_of_INV [] H _ /H {H} [xc' fx' yc0 fy0] [#] hs_hx':= HINV. + rewrite hs_hy=> /= [#] <<*> /= h. + exists xc' fx' yc Known=> /=. + split. admit. + + rewrite getP /=. + have /mh_of_INV [] H _ /H {H} [xc' fx' yc' fy'] [#] hs_hx' hs_hy' Hite:= HINV. + have xaxc'_neq_xaxc: ((xa',xc') <> (xa,xc)). + + move: xahx'_neq_xahx=> /=; case: (xa' = xa)=> [<*> /= hx'_neq_hx|/#]. + rewrite -negP=> [#] <<*>; have /hs_of_INV [] Hhuniq _ _:= HINV. + by move: (Hhuniq _ _ _ _ hs_hx' hs_hx). + case: (hx' = hy); case: (hy' = hy)=> <*>. + + move: hs_hx' hs_hy'; rewrite hs_hy=> /= [#] <<*> [#] <<*>. + exists yc Known yc Known=> /=; rewrite !getP xaxc'_neq_xaxc /=. +print mh_spec. + exists xc' fx' yc' fy'; rewrite !getP xaxc'_neq_xaxc /= Hite /=. + +print mh_spec. + +have /mh_of_INV [] H _ /H {H}:= HINV. + move=> [xc' fx' yc' fy'] [#] hs_hx' hs_hy' Hite. + exists xc' fx' yc' fy'; case: fy' hs_hy' Hite=> //= hs_hy'. + + move=> [p' v'] [#] Hro Hpi. +admitted. + clone export ConcreteF as ConcreteF1. section AUX. @@ -1201,8 +1087,8 @@ section AUX. by auto=> ? ? [#] !<<- _ -> ->> _ /=; rewrite in_rng; exists hx2. have /mh_of_INV []/(_ _ _ _ _ G1mh_x1hx2) + _:= inv0. move=> [xc0 xf0 yc0 yf0] [#]; rewrite hs_hx2 hs_hy2=> [#] !<<- [#] !<<- {xc0 xf0 yc0 yf0} /= [p0 v0] [#] Hro Hpath. - have /pi_of_INV [] /(_ x2 p0 v0) /iffRL Hpi:= inv0. - move: (Hpi _); first by exists hx2. + have /pi_of_INV [] /(_ x2 p0 v0) /iffRL /(_ _) := inv0. + + by exists hx2. move=> pi_x2; rcondt{2} 1; 1:by auto=> &hr [#] <*>; rewrite in_dom pi_x2. inline F.RO.get. rcondf{2} 4; first by auto=> &hr [#] !<<- _ _ ->> _ /=; rewrite pi_x2 oget_some /= in_dom Hro. @@ -1218,6 +1104,7 @@ section AUX. rewrite (@huniq_hinvK_h hx2 hs0 x2) // ?oget_some. + by have /hs_of_INV []:= inv0. rewrite Hro G1mh_x1hx2 hs_hy2 ?oget_some //=. + (* lemma 3 *) admit. (* Stopped here *) + move=> &2 _; proc; if=> //=; wp; rnd predT; rnd predT; auto. From 91f33725cf8732a658bd81fe16c485a2bffdcebd Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Wed, 24 Aug 2016 12:01:25 +0100 Subject: [PATCH 207/525] Some progress -- Facts about paths. --- proof/core/Handle.eca | 75 +++++++++++++------------------------------ 1 file changed, 22 insertions(+), 53 deletions(-) diff --git a/proof/core/Handle.eca b/proof/core/Handle.eca index afa7766..8b5ed43 100644 --- a/proof/core/Handle.eca +++ b/proof/core/Handle.eca @@ -583,6 +583,7 @@ qed. (* by exists c' v'; rewrite hpaths; exists h'. *) (* qed. *) +(** Stuff about paths **) lemma build_hpath_prefix mh p b v h: build_hpath mh (rcons p b) = Some (v,h) <=> (exists v' h', build_hpath mh p = Some (v',h') /\ mh.[(v' +^ b,h')] = Some (v,h)). @@ -592,26 +593,16 @@ rewrite build_hpathP; split=> [[/#|p' b' v' h' [#] + Hhpath Hmh]|[v' h'] [] Hhpa exact/(Extend _ _ _ _ _ Hhpath Hmh). qed. -lemma foldl_step_hpath_None mh p: foldl (step_hpath mh) None p = None. -proof. by elim: p. qed. - -(** This proof is not understood **) -lemma build_hpath_up mh xa hx ya hy p b h: - build_hpath mh p = Some (b,h) +lemma build_hpath_up mh xa hx ya hy p za hz: + build_hpath mh p = Some (za,hz) => mh.[(xa,hx)] = None - => build_hpath mh.[(xa,hx) <- (ya,hy)] p = Some (b,h). + => build_hpath mh.[(xa,hx) <- (ya,hy)] p = Some (za,hz). proof. -move=> + mh_xahx - @/build_hpath. -have: (exists p' v h, build_hpath mh p' = Some (v +^ b0,h)). -+ by exists [] b0 0; rewrite build_hpathP Block.xorw0; exact/Empty. -pose root:= b0; elim: p root 0=> //= b1 p ih bn hn. -rewrite /(step_hpath _ (Some _)) /= oget_some /= /(step_hpath _ (Some _)) /= oget_some /= getP. -case: {-1}(mh.[(bn +^ b1,hn)]) (eq_refl mh.[(bn +^ b1,hn)])=> [|[xc' hx'] mh_bnb1hn]; last first. -+ have -> /= : (bn +^ b1,hn) <> (xa,hx). - + apply/contraT=> /(congr1 (fun ch=> mh.[ch]) (bn +^ b1,hn) (xa,hx)). - by rewrite mh_xahx mh_bnb1hn. - smt. (* figure out *) -by rewrite foldl_step_hpath_None. +move=> + mh_xahx; elim/last_ind: p za hz=> [za hz|p b ih za hz]. ++ by rewrite /build_hpath. +move=> /build_hpath_prefix [b' h'] [#] /ih Hpath Hmh. +apply/build_hpathP/(@Extend _ _ _ _ p b b' h' _ Hpath _)=> //. +by rewrite getP /#. qed. lemma build_hpath_down mh xa hx ya hy p v h: @@ -627,6 +618,19 @@ case: ((v' +^ b,h') = (xa,hx))=> [/#|_ Hpath Hextend]. exact/build_hpathP/(Extend _ _ _ _ _ Hpath Hextend). qed. +lemma known_path_uniq hs mh pi xc hx p xa p' xa': + pi_spec hs mh pi + => hs.[hx] = Some (xc,Known) + => build_hpath mh p = Some (xa, hx) + => build_hpath mh p' = Some (xa',hx) + => p = p' /\ xa = xa'. +proof. +move=> [] Ipi hs_hy path_p path_p'. +have /iffRL /(_ _):= Ipi xc p xa; first by exists hx. +have /iffRL /(_ _):= Ipi xc p' xa'; first by exists hx. +by move=> ->. +qed. + lemma lemma1 hs ch Pm Pmi Gm Gmi mh mhi ro pi x1 x2 y1 y2: INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi => x2 <> y2 @@ -853,40 +857,6 @@ split. have path_hy: build_hpath mh (rcons p (b +^ xa)) = Some (ya,hy). + apply/build_hpathP/(@Extend _ _ _ _ p (b +^ xa) b hx)=> //. by rewrite xorwA xorwK xorwC xorw0. *) - move=> xa' hx' ya' hy'; have /mh_of_INV [] H _ /H {H} [xc' fx' yc' fy'] [#] hs_hx' := HINV. - case: (hy' = hy)=> /= [<*>|]. - + rewrite hs_hy=> /= [#] <*> /= [p' b'] [#] ro_pbxa'. - case: fx' hs_hx'=> hs_hx'. - - case: (hx' = hy)=> /= [<*>|]. - + rewrite hs_hy=> /= [#] <<*>; case: fy'=> //= hs_hy' ?. - exists yc Known yc' Unknown. - - - + - case: ((ya',hy') = (ya,hy))=> [[#] <*>|yahy'_neq_yahy]. - + have /mh_of_INV [] H _ /H {H} [xc' fx' yc0 fy0] [#] hs_hx':= HINV. - rewrite hs_hy=> /= [#] <<*> /= h. - exists xc' fx' yc Known=> /=. - split. admit. - + rewrite getP /=. - have /mh_of_INV [] H _ /H {H} [xc' fx' yc' fy'] [#] hs_hx' hs_hy' Hite:= HINV. - have xaxc'_neq_xaxc: ((xa',xc') <> (xa,xc)). - + move: xahx'_neq_xahx=> /=; case: (xa' = xa)=> [<*> /= hx'_neq_hx|/#]. - rewrite -negP=> [#] <<*>; have /hs_of_INV [] Hhuniq _ _:= HINV. - by move: (Hhuniq _ _ _ _ hs_hx' hs_hx). - case: (hx' = hy); case: (hy' = hy)=> <*>. - + move: hs_hx' hs_hy'; rewrite hs_hy=> /= [#] <<*> [#] <<*>. - exists yc Known yc Known=> /=; rewrite !getP xaxc'_neq_xaxc /=. -print mh_spec. - exists xc' fx' yc' fy'; rewrite !getP xaxc'_neq_xaxc /= Hite /=. - -print mh_spec. - -have /mh_of_INV [] H _ /H {H}:= HINV. - move=> [xc' fx' yc' fy'] [#] hs_hx' hs_hy' Hite. - exists xc' fx' yc' fy'; case: fy' hs_hy' Hite=> //= hs_hy'. - + move=> [p' v'] [#] Hro Hpi. admitted. clone export ConcreteF as ConcreteF1. @@ -1104,7 +1074,6 @@ section AUX. rewrite (@huniq_hinvK_h hx2 hs0 x2) // ?oget_some. + by have /hs_of_INV []:= inv0. rewrite Hro G1mh_x1hx2 hs_hy2 ?oget_some //=. - (* lemma 3 *) admit. (* Stopped here *) + move=> &2 _; proc; if=> //=; wp; rnd predT; rnd predT; auto. From d6cf16376c93a60c0b1855df33b7f8b19fcc4176 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Wed, 24 Aug 2016 12:35:49 +0100 Subject: [PATCH 208/525] Adding the inversion invariant back in. --- proof/core/Handle.eca | 39 +++++++++++++++++++++------------------ 1 file changed, 21 insertions(+), 18 deletions(-) diff --git a/proof/core/Handle.eca b/proof/core/Handle.eca index 8b5ed43..bae2f0d 100644 --- a/proof/core/Handle.eca +++ b/proof/core/Handle.eca @@ -148,7 +148,7 @@ module G1(D:DISTINGUISHER) = { chandle <- 1; b <@ D(C,S).distinguish(); return b; - } + } }. (* -------------------------------------------------------------------------- *) @@ -218,7 +218,7 @@ inductive inv_spec (m:('a,'b) fmap) mi = inductive INV_CF_G1 (hs : handles) ch (Pm Pmi Gm Gmi : smap) (mh mhi : hsmap) (ro : (block list,block) fmap) pi = | HCF_G1 of (hs_spec hs ch) -(* & (inv_spec mh mhi) *) + & (inv_spec mh mhi) & (m_mh hs Pm mh) & (m_mh hs Pmi mhi) & (incl Gm Pm) @@ -287,11 +287,11 @@ lemma hs_of_INV (m1 m2 mi1 mi2 : smap) (mh2 mhi2 : hsmap) hs_spec hs ch. proof. by case. qed. -(* lemma inv_of_INV hs ch m1 mi1 m2 mi2 ro pi *) -(* mh2 mhi2: *) -(* INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi => *) -(* inv_spec mh2 mhi2. *) -(* proof. by case. qed. *) +lemma inv_of_INV hs ch m1 mi1 m2 mi2 ro pi + mh2 mhi2: + INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi => + inv_spec mh2 mhi2. +proof. by case. qed. (** Useful Lemmas **) lemma ch_gt0 hs ch : hs_spec hs ch => 0 < ch. @@ -631,6 +631,7 @@ have /iffRL /(_ _):= Ipi xc p' xa'; first by exists hx. by move=> ->. qed. +(** Path-specific lemmas **) lemma lemma1 hs ch Pm Pmi Gm Gmi mh mhi ro pi x1 x2 y1 y2: INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi => x2 <> y2 @@ -650,11 +651,11 @@ move=> HINV x2_neq_y2 Pm_x Gm_x pi_x2 x2_notin_rng1_hs y2_notin_rng1_hs; split. + rewrite (@addzA ch 1 1); apply/hs_addh. + by move: HINV=> /hs_of_INV/hs_addh=> ->. by move=> f h; rewrite getP; case: (h = ch)=> [/#|_]; exact/y2_notin_rng1_hs. -(* + apply/inv_addm; 1:by case: HINV. *) -(* + have ^ /m_mh_of_INV Hm_mh /hs_of_INV Hhs := HINV. *) -(* by apply/(ch_notin_dom2_mh _ _ Hm_mh Hhs). *) -(* have ^ /mi_mhi_of_INV Hmi_mhi /hs_of_INV Hhs := HINV. *) -(* by apply/(Sch_notin_dom2_mh _ _ Hmi_mhi Hhs). *) ++ apply/inv_addm; 1:by case: HINV. + + have ^ /m_mh_of_INV Hm_mh /hs_of_INV Hhs := HINV. + by apply/(ch_notin_dom2_mh _ _ Hm_mh Hhs). + have ^ /mi_mhi_of_INV Hmi_mhi /hs_of_INV Hhs := HINV. + by apply/(Sch_notin_dom2_mh _ _ Hmi_mhi Hhs). + apply/(@m_mh_addh_addm hs.[ch <- (x2,Known)] Pm mh ch x1 x2 (ch + 1) y1 y2 Known). + by move: HINV=> ^/hs_of_INV Hhs /m_mh_of_INV; exact/(m_mh_addh Hhs). + by move: HINV => /hs_of_INV /hs_addh /(_ x2 Known _) // []. @@ -730,11 +731,11 @@ proof. move=> HINV PFm_x1x2 G1m_x1x2 pi_x2 hs_hx y2_notin_rng1_hs. split. + by apply/hs_addh=> //=; case: HINV. -(* + apply/inv_addm; 1:by case: HINV. *) -(* + have ^ /m_mh_of_INV Hm_mh /hs_of_INV Hhs := HINV. *) -(* by apply/(notin_m_notin_mh _ _ _ _ Hm_mh PFm_x1x2 hs_hx). *) -(* have ^ /mi_mhi_of_INV Hmi_mhi /hs_of_INV Hhs := HINV. *) -(* by apply/(ch_notin_dom2_mh _ _ Hmi_mhi Hhs). *) ++ apply/inv_addm; 1:by case: HINV. + + have ^ /m_mh_of_INV Hm_mh /hs_of_INV Hhs := HINV. + by apply/(notin_m_notin_mh _ _ _ _ Hm_mh PFm_x1x2 hs_hx). + have ^ /mi_mhi_of_INV Hmi_mhi /hs_of_INV Hhs := HINV. + by apply/(ch_notin_dom2_mh _ _ Hmi_mhi Hhs). + have ^ /hs_of_INV ^ Hhs [] Hhuniq _ _ /m_mh_of_INV := HINV. move=> /m_mh_addh_addm /(_ hx x1 x2 ch y1 y2 Known Hhuniq hs_hx _) //. exact/ch_notin_dom_hs. @@ -808,6 +809,7 @@ move=> HINV Pm_xaxc Gm_xaxc mh_xahx hs_hx hs_hy pi_xc. split. + have /hs_of_INV /hs_updh /(_ Unknown) H := HINV; apply/H=> {H} //. by rewrite -negP=> <*>; move: hs_hy; have /hs_of_INV [] _ -> := HINV. ++ admit. + split. (* Pull out *) + move=> xa' xc' ya' yc'; have /m_mh_of_INV [] H _ /H {H}:= HINV. move=> [hx' fx' hy' fy'] [#] hs_hx' hs_hy' mh_xahx'. @@ -840,7 +842,8 @@ split. by exists xc' fx' yc' fy'; rewrite !getP Hhx' Hhy'. + move=> [za zc]; rewrite getP; case: ((za,zc) = (xa,xc))=> // _. by have /incl_of_INV H /H {H}:= HINV. -+ (* inverse or pre-inverse - probably on mh/mhi *) admit. ++ case HINV. ++ (** inverse or pre-inverse - probably on mh/mhi *) admit. + split; last by have /mh_of_INV [] _:= HINV. have pi_yc: pi.[yc] = None. + have /#: forall p b, pi.[yc] <> Some (p,b). From 7efb0658e3294c2d5857192486d243e2f7b9c8a7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Wed, 24 Aug 2016 14:54:45 +0100 Subject: [PATCH 209/525] Cleanup. --- proof/core/Handle.eca | 286 +++++++++++++++++++----------------------- 1 file changed, 132 insertions(+), 154 deletions(-) diff --git a/proof/core/Handle.eca b/proof/core/Handle.eca index bae2f0d..91253a8 100644 --- a/proof/core/Handle.eca +++ b/proof/core/Handle.eca @@ -367,7 +367,7 @@ move=> [] _ Hmh_m hs_hx; case: {-1}(mh.[(xa,hx)]) (eq_refl mh.[(xa,hx)])=> [//|] by move=> [ya hy] /Hmh_m [xc fx yc fy] [#]; rewrite hs_hx. qed. -(** Adding handles **) +(** Preservation of m_mh **) lemma m_mh_addh hs ch m mh xc fx: hs_spec hs ch => m_mh hs m mh @@ -384,92 +384,28 @@ move: hs_hx=> /dom_hs/ltr_eqF -> /=. by move: hs_hy=> /dom_hs/ltr_eqF -> /=. qed. -lemma hs_addh hs ch xc fx: - hs_spec hs ch - => (forall f h, hs.[h] <> Some (xc,f)) - => hs_spec hs.[ch <- (xc,fx)] (ch + 1). -proof. -move=> ^Hhs [] Hhuniq hs_0 dom_hs xc_notin_rng1_hs; split. -+ move=> h1 h2 [c1 f1] [c2 f2]; rewrite !getP /=. - case: (h1 = ch); case: (h2 = ch)=> //= [+ + [#]|+ + + [#]|]=> <*>; - first 2 by rewrite xc_notin_rng1_hs. - by move=> _ _ hs_h1 /(Hhuniq _ _ _ _ hs_h1). -+ by rewrite getP (ch_neq0 _ Hhs). -+ move=> [c f] h; rewrite !getP; case: (h = ch)=> [<*> /#|_]. -by move=> /dom_hs /#. -qed. - -lemma hs_updh hs ch fx hx xc fx': - hs_spec hs ch - => 0 <> hx - => hs.[hx] = Some (xc,fx) - => hs_spec hs.[hx <- (xc,fx')] ch. -proof. -move=> ^Hhs [] Hhuniq hs_0 dom_hs hx_neq0 hs_hx; split. -+ by move=> h1 h2 [c1 f1] [c2 f2]; rewrite !getP /= /#. -+ by rewrite getP hx_neq0. -move=> cf h; rewrite getP; case: (h = hx)=> [<*> _|_ /dom_hs //]. -by move: hs_hx=> /dom_hs. -qed. - -lemma mh_addh hs ch Gm mh ro xc fx: - hs_spec hs ch - => mh_spec hs Gm mh ro - => mh_spec hs.[ch <- (xc,fx)] Gm mh ro. +lemma m_mh_updh fy0 hs m mh yc hy fy: + m_mh hs m mh + => hs.[hy] = Some (yc,fy0) + => m_mh hs.[hy <- (yc,fy)] m mh. proof. -move=> [] _ _ dom_hs [] Hmh ?; split=> //. -move=> xa hx ya hy /Hmh [xc0 fx0 yc0 fy0] [#] hs_hx hs_hy Hite. -exists xc0 fx0 yc0 fy0; rewrite !getP Hite hs_hx hs_hy /=. -rewrite ltr_eqF /=; 1:by apply/(dom_hs _ hs_hx). -by rewrite ltr_eqF /=; 1:by apply/(dom_hs _ hs_hy). +move=> Im_mh hs_hy; split. ++ move=> xa' xc' ya' yc'; have [] H _ /H {H}:= Im_mh. + move=> [hx' fx' hy' fy'] [#] hs_hx' hs_hy' mh_xahx'. + case: (hx' = hy); case: (hy' = hy)=> //= <*> => [|Hhy'|Hhx'|Hhx' Hhy']. + + by exists hy fy hy fy; rewrite !getP /= /#. + + by exists hy fy hy' fy'; rewrite !getP Hhy' /#. + + by exists hx' fx' hy fy; rewrite !getP Hhx' /#. + by exists hx' fx' hy' fy'; rewrite !getP Hhx' Hhy'. +move=> xa' hx' ya' hy'; have [] _ H /H {H}:= Im_mh. +move=> [xc' fx' yc' fy'] [#] hs_hx' hs_hy' m_xaxc'. +case: (hx' = hy); case: (hy' = hy)=> //= <*> => [|Hhy'|Hhx'|Hhx' Hhy']. ++ by exists yc fy yc fy; rewrite !getP /= /#. ++ by exists yc fy yc' fy'; rewrite !getP Hhy' /#. ++ by exists xc' fx' yc fy; rewrite !getP Hhx' /#. +by exists xc' fx' yc' fy'; rewrite !getP Hhx' Hhy'. qed. -(* lemma paths_up_handles m2 ro hs mh pi cf ch: *) -(* mh_spec hs m2 mh ro => *) -(* handles_spec hs ch => *) -(* paths_spec hs mh pi => *) -(* paths_spec hs.[ch <- cf] mh pi. *) -(* proof. *) -(* move=> Hmh Hh [] Hp; split=> c p v; rewrite Hp; apply exists_iff=> x /=. *) -(* split=>- [] ^Hbu -> /=; rewrite getP. *) -(* + case: Hh=> _ _ Hlt x_in_handles. *) -(* by rewrite ltr_eqF; 1:by apply/Hlt; rewrite in_dom x_in_handles. *) -(* case: (x = ch)=> //=. *) -(* move: Hbu=> /build_hpathP [[#] _ _ ->|p' b v' h' [#] _ _ Hh']. *) -(* + by rewrite (@chandle_0 _ _ Hh). *) -(* case: Hh=> _ _ /(_ x) Hlt; rewrite ltr_eqF //. *) -(* by apply/Hlt; rewrite in_dom; case: Hmh=> /(_ _ _ _ _ Hh') [????] [#] _ ->. *) -(* qed. *) - -(* lemma handles_up_handles hs ch x2 f': *) -(* (forall (f : flag), ! mem (rng hs) (x2, f)) => *) -(* handles_spec hs ch => *) -(* handles_spec hs.[ch <- (x2, f')] (ch + 1). *) -(* proof. *) -(* move=> Hx2 ^Hh [] Hu Hh0 Hlt; split. *) -(* + move=> h1 h2 [c1 f1] [c2 f2]; rewrite !getP /=. *) -(* case: (h1 = ch)=> /= [-> [] ->> ->|_]; (case: (h2 = ch)=> [-> //= |_]). *) -(* + by move=> Heq ->>; move: (Hx2 f2); rewrite in_rng negb_exists=> /= /(_ h2). *) -(* + by move=> Heq [] ->> <<- ->>; move: (Hx2 f1); rewrite in_rng negb_exists=> /= /(_ h1). *) -(* by apply Hu. *) -(* + by rewrite getP (@chandle_0 _ _ Hh). *) -(* by move=> h; rewrite dom_set !inE /#. *) -(* qed. *) - -(* (* lemma INV_CF_G1_up_handles hs ch m1 mi1 m2 mi2 mh mhi ro pi x2: *) *) -(* (* INV_CF_G1 hs ch m1 mi1 m2 mi2 mh mhi ro pi => *) *) -(* (* (forall f, !mem (rng hs) (x2, f)) => *) *) -(* (* INV_CF_G1 hs.[ch <- (x2, Known)] (ch + 1) m1 mi1 m2 mi2 mh mhi ro pi. *) *) -(* (* proof. *) *) -(* (* case=> Heqm Heqmi Hincl Hincli Hmh Hp Hh Hx2. *) *) -(* (* exact/(HCF_G1 (eqm_up_handles Hh Heqm) (eqm_up_handles Hh Heqmi) *) *) -(* (* _ _ *) *) -(* (* (:@mh_up_handles _ _ _ _ _ (x2,Known) Hh Hmh) *) *) -(* (* (:@paths_up_handles m2 ro _ _ _ (x2,Known) _ Hmh Hh Hp) *) *) -(* (* (:@handles_up_handles _ _ x2 Known _ Hh)). *) *) -(* (* qed. *) *) - -(** Updating forward map **) lemma m_mh_addh_addm hs Pm mh hx xa xc hy ya yc f: m_mh hs Pm mh => huniq hs => @@ -491,7 +427,6 @@ move: xahx0_neq_xahx; case: (xa0 = xa)=> [/= <*>>|//=]; case: (xc0 = xc)=> [<*>> by move: hs_hx=> /(Hhuniq _ _ _ _ hs_hx0). qed. -(** Updating backward map **) lemma mi_mhi_addh_addmi (hs : handles) mi mhi hx xa xc hy ya yc fx: m_mh hs mi mhi => (forall f h, hs.[h] <> Some (yc,f)) => @@ -512,7 +447,49 @@ move: yahy0_neq_yahy; case: (ya0 = ya)=> [<<*> //=|/#]; case: (yc0 = yc)=> [<*>> by move: hs_hy0; rewrite yc_notin_rng1_hs. qed. -(** Inversion **) +(** Preservation of hs_spec **) +lemma hs_addh hs ch xc fx: + hs_spec hs ch + => (forall f h, hs.[h] <> Some (xc,f)) + => hs_spec hs.[ch <- (xc,fx)] (ch + 1). +proof. +move=> ^Hhs [] Hhuniq hs_0 dom_hs xc_notin_rng1_hs; split. ++ move=> h1 h2 [c1 f1] [c2 f2]; rewrite !getP /=. + case: (h1 = ch); case: (h2 = ch)=> //= [+ + [#]|+ + + [#]|]=> <*>; + first 2 by rewrite xc_notin_rng1_hs. + by move=> _ _ hs_h1 /(Hhuniq _ _ _ _ hs_h1). ++ by rewrite getP (ch_neq0 _ Hhs). ++ move=> [c f] h; rewrite !getP; case: (h = ch)=> [<*> /#|_]. +by move=> /dom_hs /#. +qed. + +lemma hs_updh hs ch fx hx xc fx': + hs_spec hs ch + => 0 <> hx + => hs.[hx] = Some (xc,fx) + => hs_spec hs.[hx <- (xc,fx')] ch. +proof. +move=> ^Hhs [] Hhuniq hs_0 dom_hs hx_neq0 hs_hx; split. ++ by move=> h1 h2 [c1 f1] [c2 f2]; rewrite !getP /= /#. ++ by rewrite getP hx_neq0. +move=> cf h; rewrite getP; case: (h = hx)=> [<*> _|_ /dom_hs //]. +by move: hs_hx=> /dom_hs. +qed. + +(** Preservation of mh_spec **) +lemma mh_addh hs ch Gm mh ro xc fx: + hs_spec hs ch + => mh_spec hs Gm mh ro + => mh_spec hs.[ch <- (xc,fx)] Gm mh ro. +proof. +move=> [] _ _ dom_hs [] Hmh ?; split=> //. +move=> xa hx ya hy /Hmh [xc0 fx0 yc0 fy0] [#] hs_hx hs_hy Hite. +exists xc0 fx0 yc0 fy0; rewrite !getP Hite hs_hx hs_hy /=. +rewrite ltr_eqF /=; 1:by apply/(dom_hs _ hs_hx). +by rewrite ltr_eqF /=; 1:by apply/(dom_hs _ hs_hy). +qed. + +(** Preservation of inv_spec **) lemma inv_addm (m : ('a,'b) fmap) mi x y: inv_spec m mi => m.[x] = None @@ -526,7 +503,7 @@ case: (y' = y)=> /= [[#] <*> //=|_ /Hinv ^ + ->]. by move: m_x; case: (x' = x)=> [[#] <*> ->|]. qed. -(** Map Inclusion **) +(** Preservation of incl **) lemma incl_addm (m m' : ('a,'b) fmap) x y: incl m m' => incl m.[x <- y] m'.[x <- y]. @@ -631,6 +608,31 @@ have /iffRL /(_ _):= Ipi xc p' xa'; first by exists hx. by move=> ->. qed. +(* Useful? Not sure... *) +lemma path_split hs ch m mh xc hx p xa: + hs_spec hs ch + => m_mh hs m mh + => hs.[hx] = Some (xc,Unknown) + => build_hpath mh p = Some (xa,hx) + => exists pk ya yc hy b za zc hz pu, + p = (rcons pk b) ++ pu + /\ build_hpath mh pk = Some (ya,hy) + /\ hs.[hy] = Some (yc,Known) + /\ mh.[(ya +^ b,hy)] = Some (za,hz) + /\ hs.[hz] = Some (zc,Unknown). +proof. +move=> Ihs [] _ Imh_m. +elim/last_ind: p hx xa xc=> [hx xa xc + /build_hpathP [_ <*>|/#]|]. ++ by have [] _ -> _ [#]:= Ihs. +move=> p b ih hx xa xc hs_hx /build_hpath_prefix. +move=> [ya hy] [#] path_p_hy ^mh_yabh' /Imh_m [yc fy ? ?] [#] hs_hy. +rewrite hs_hx=> /= [#] <<*> _; case: fy hs_hy. ++ move=> /ih /(_ ya _) // [pk ya' yc' hy' b' za zc hz pu] [#] <*>. + move=> Hpath hs_hy' mh_tahy' hs_hz. + by exists pk ya' yc' hy' b' za zc hz (rcons pu b); rewrite rcons_cat. +by move=> hs_hy; exists p ya yc hy b xa xc hx []; rewrite cats0. +qed. + (** Path-specific lemmas **) lemma lemma1 hs ch Pm Pmi Gm Gmi mh mhi ro pi x1 x2 y1 y2: INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi @@ -696,23 +698,23 @@ move=> HINV x2_neq_y2 Pm_x Gm_x pi_x2 x2_notin_rng1_hs y2_notin_rng1_hs; split. by move=> p' b' v' h' <*>; rewrite ch_notin_rng2_mh. move=> ^ /build_hpathP + -> /=; rewrite getP. by case=> [<*>|/#]; move: HINV=> /hs_of_INV [] _ + H - /H {H} /#. -+ split=> c p v; have ^/hs_of_INV [] _ _ dom_hs /pi_of_INV [] -> := HINV. - apply/exists_iff=> h /=; split=> [#]. - + move=> /(build_hpath_up mh x1 ch y1 (ch + 1) p v h) /(_ _). - + by apply/(notin_hs_notin_dom2_mh hs Pm)/ch_notin_dom_hs; case: HINV. - by move=> -> /= ^ /dom_hs; rewrite !getP /#. - have ch_notin_rng2_mh: forall a h a', mh.[(a,h)] <> Some (a',ch). - + move=> a h' a'; rewrite -negP; have /m_mh_of_INV [] _ Hmh_m /Hmh_m {Hmh_m} := HINV. - by move=> [xc fx yc fy] [#] _; rewrite ch_notin_dom_hs; case: HINV. - have Sch_notin_rng2_mh: forall a h a', mh.[(a,h)] <> Some (a',ch + 1). - + move=> a h' a'; rewrite -negP; have /m_mh_of_INV [] _ Hmh_m /Hmh_m {Hmh_m} := HINV. - by move=> [xc fx yc fy] [#] _; rewrite Sch_notin_dom_hs; case: HINV. - have H /H {H}:= build_hpath_down mh x1 ch y1 (ch + 1) p v h _. - + move=> p0 v0; rewrite -negP=> /build_hpathP [<*>|]. - + by have /hs_of_INV [] _ + H - /H {H} := HINV. - by move=> p' b' v' h' <*>; rewrite ch_notin_rng2_mh. - move=> ^ /build_hpathP + -> /=; rewrite !getP. - by case=> [<*>|/#]; move: HINV=> /hs_of_INV [] _ + H - /H {H} /#. +split=> c p v; have ^/hs_of_INV [] _ _ dom_hs /pi_of_INV [] -> := HINV. +apply/exists_iff=> h /=; split=> [#]. ++ move=> /(build_hpath_up mh x1 ch y1 (ch + 1) p v h) /(_ _). + + by apply/(notin_hs_notin_dom2_mh hs Pm)/ch_notin_dom_hs; case: HINV. + by move=> -> /= ^ /dom_hs; rewrite !getP /#. +have ch_notin_rng2_mh: forall a h a', mh.[(a,h)] <> Some (a',ch). ++ move=> a h' a'; rewrite -negP; have /m_mh_of_INV [] _ Hmh_m /Hmh_m {Hmh_m} := HINV. + by move=> [xc fx yc fy] [#] _; rewrite ch_notin_dom_hs; case: HINV. +have Sch_notin_rng2_mh: forall a h a', mh.[(a,h)] <> Some (a',ch + 1). ++ move=> a h' a'; rewrite -negP; have /m_mh_of_INV [] _ Hmh_m /Hmh_m {Hmh_m} := HINV. + by move=> [xc fx yc fy] [#] _; rewrite Sch_notin_dom_hs; case: HINV. +have H /H {H}:= build_hpath_down mh x1 ch y1 (ch + 1) p v h _. ++ move=> p0 v0; rewrite -negP=> /build_hpathP [<*>|]. + + by have /hs_of_INV [] _ + H - /H {H} := HINV. + by move=> p' b' v' h' <*>; rewrite ch_notin_rng2_mh. +move=> ^ /build_hpathP + -> /=; rewrite !getP. +by case=> [<*>|/#]; move: HINV=> /hs_of_INV [] _ + H - /H {H} /#. qed. lemma lemma2 hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi x1 x2 y1 y2 hx: @@ -774,21 +776,21 @@ split. rewrite getP. case: ((v +^ xa,hi) = (x1,hx))=> [[#] <*>|_ Hpath Hextend]. + by rewrite no_path_to_hx. by exists v hi hf. -+ split=> c p v; have /pi_of_INV [] -> := HINV. - apply/exists_iff=> h /=; split=> [#]. - + move=> /build_hpath_up /(_ x1 hx y1 ch _). - + by apply/(notin_m_notin_mh hs PFm x2 Known); case:HINV. - move=> -> /=; rewrite getP. - by have /hs_of_INV [] _ _ dom_hs ^ + /dom_hs /#:= HINV. - have no_path_to_hx: forall p0 v0, build_hpath G1mh p0 <> Some (v0,hx). - + have /pi_of_INV [] /(_ x2):= HINV; rewrite pi_x2 /=. - by move=> + p0 v0 - /(_ p0 v0) /negb_exists /(_ hx) /=; rewrite hs_hx. - have H /H {H} := build_hpath_down G1mh x1 hx y1 ch p v h no_path_to_hx. - move=> ^ Hpath -> /=; rewrite getP; case: (h = ch)=> [<*> /= [#] <*>|//=]. - move: Hpath=> /build_hpathP [<*>|]. - + by have /hs_of_INV [] _ + H - /H {H}:= HINV. - move=> p' b' v' h' <*> _; have /m_mh_of_INV [] _ H /H {H}:= HINV. - by move=> [xc fx yc fy] [#] _; have /hs_of_INV [] _ _ H /H {H}:= HINV. +split=> c p v; have /pi_of_INV [] -> := HINV. +apply/exists_iff=> h /=; split=> [#]. ++ move=> /build_hpath_up /(_ x1 hx y1 ch _). + + by apply/(notin_m_notin_mh hs PFm x2 Known); case:HINV. + move=> -> /=; rewrite getP. + by have /hs_of_INV [] _ _ dom_hs ^ + /dom_hs /#:= HINV. +have no_path_to_hx: forall p0 v0, build_hpath G1mh p0 <> Some (v0,hx). ++ have /pi_of_INV [] /(_ x2):= HINV; rewrite pi_x2 /=. + by move=> + p0 v0 - /(_ p0 v0) /negb_exists /(_ hx) /=; rewrite hs_hx. +have H /H {H} := build_hpath_down G1mh x1 hx y1 ch p v h no_path_to_hx. +move=> ^ Hpath -> /=; rewrite getP; case: (h = ch)=> [<*> /= [#] <*>|//=]. +move: Hpath=> /build_hpathP [<*>|]. ++ by have /hs_of_INV [] _ + H - /H {H}:= HINV. +move=> p' b' v' h' <*> _; have /m_mh_of_INV [] _ H /H {H}:= HINV. +by move=> [xc fx yc fy] [#] _; have /hs_of_INV [] _ _ H /H {H}:= HINV. qed. lemma lemma3 hs ch Pm Pmi Gm Gmi mh mhi ro pi xa xc hx ya yc hy p b: @@ -809,49 +811,24 @@ move=> HINV Pm_xaxc Gm_xaxc mh_xahx hs_hx hs_hy pi_xc. split. + have /hs_of_INV /hs_updh /(_ Unknown) H := HINV; apply/H=> {H} //. by rewrite -negP=> <*>; move: hs_hy; have /hs_of_INV [] _ -> := HINV. -+ admit. -+ split. (* Pull out *) - + move=> xa' xc' ya' yc'; have /m_mh_of_INV [] H _ /H {H}:= HINV. - move=> [hx' fx' hy' fy'] [#] hs_hx' hs_hy' mh_xahx'. - case: (hx' = hy); case: (hy' = hy)=> //= <*> => [|hy'_neq_hy|hx'_neq_hy|Hhx' Hhy']. - + by exists hy Known hy Known; rewrite !getP /= /#. - + by exists hy Known hy' fy'; rewrite !getP hy'_neq_hy /#. - + by exists hx' fx' hy Known; rewrite !getP hx'_neq_hy /#. - by exists hx' fx' hy' fy'; rewrite !getP Hhx' Hhy'. - move=> xa' hx' ya' hy'; have /m_mh_of_INV [] _ H /H {H}:= HINV. - move=> [xc' fx' yc' fy'] [#] hs_hx' hs_hy' m_xaxc'. - case: (hx' = hy); case: (hy' = hy)=> //= <*> => [|hy'_neq_hy|hx'_neq_hy|Hhx' Hhy']. - + by exists yc Known yc Known; rewrite !getP /= /#. - + by exists yc Known yc' fy'; rewrite !getP hy'_neq_hy /#. - + by exists xc' fx' yc Known; rewrite !getP hx'_neq_hy /#. - by exists xc' fx' yc' fy'; rewrite !getP Hhx' Hhy'. -+ split. (* Pull out *) - + move=> xa' xc' ya' yc'; have /mi_mhi_of_INV [] H _ /H {H}:= HINV. - move=> [hx' fx' hy' fy'] [#] hs_hx' hs_hy' mh_xahx'. - case: (hx' = hy); case: (hy' = hy)=> //= <*> => [|hy'_neq_hy|hx'_neq_hy|Hhx' Hhy']. - + by exists hy Known hy Known; rewrite !getP /= /#. - + by exists hy Known hy' fy'; rewrite !getP hy'_neq_hy /#. - + by exists hx' fx' hy Known; rewrite !getP hx'_neq_hy /#. - by exists hx' fx' hy' fy'; rewrite !getP Hhx' Hhy'. - move=> xa' hx' ya' hy'; have /mi_mhi_of_INV [] _ H /H {H}:= HINV. - move=> [xc' fx' yc' fy'] [#] hs_hx' hs_hy' m_xaxc'. - case: (hx' = hy); case: (hy' = hy)=> //= <*> => [|hy'_neq_hy|hx'_neq_hy|Hhx' Hhy']. - + by exists yc Known yc Known; rewrite !getP /= /#. - + by exists yc Known yc' fy'; rewrite !getP hy'_neq_hy /#. - + by exists xc' fx' yc Known; rewrite !getP hx'_neq_hy /#. - by exists xc' fx' yc' fy'; rewrite !getP Hhx' Hhy'. ++ by case: HINV. ++ by apply/(m_mh_updh Unknown)=> //; case: HINV. ++ by apply/(m_mh_updh Unknown)=> //; case: HINV. + move=> [za zc]; rewrite getP; case: ((za,zc) = (xa,xc))=> // _. by have /incl_of_INV H /H {H}:= HINV. -+ case HINV. -+ (** inverse or pre-inverse - probably on mh/mhi *) admit. ++ move: mh_xahx; have /inv_of_INV [] H /H {H}:= HINV. + have /mi_mhi_of_INV [] _ H /H {H} [xct fxt yct fyt] [#] := HINV. + rewrite hs_hx hs_hy=> /= [#] 2!<<- {xct fxt} [#] 2!<<- {yct fyt} Pmi_yayc. + move=> [za zc]; rewrite getP; case: ((za,zc) = (ya,yc))=> // _. + by have /incli_of_INV H /H {H}:= HINV. + split; last by have /mh_of_INV [] _:= HINV. - have pi_yc: pi.[yc] = None. +(* have pi_yc: pi.[yc] = None. + have /#: forall p b, pi.[yc] <> Some (p,b). move=> p0 b0; rewrite -negP. have /pi_of_INV [] -> [h] [#] _ := HINV. have /hs_of_INV [] Hhuniq _ _^hs_h - /Hhuniq /(_ _ _ hs_hy) := HINV. by move: hs_h; case: (h = hy)=> [<*>|//=]; rewrite hs_hy. -(* have path_hx: build_hpath mh p = Some (b,hx). + have path_hx: build_hpath mh p = Some (b,hx). + move: pi_xc; have /pi_of_INV [] -> [h] [#] Hpath := HINV. by have /hs_of_INV [] Hhuniq _ _ ^hs_h - /Hhuniq /(_ _ _ hs_hx) /= <*>:= HINV. have ro_pbxa: ro.[rcons p (b +^ xa)] = Some ya. @@ -860,6 +837,7 @@ split. have path_hy: build_hpath mh (rcons p (b +^ xa)) = Some (ya,hy). + apply/build_hpathP/(@Extend _ _ _ _ p (b +^ xa) b hx)=> //. by rewrite xorwA xorwK xorwC xorw0. *) + admitted. clone export ConcreteF as ConcreteF1. From e1c6063088138f3d82950a68b6bc70c119ef694a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Wed, 24 Aug 2016 19:06:36 +0100 Subject: [PATCH 210/525] Saving state. --- proof/core/Handle.eca | 55 +++++++++++++++++++++++++++++++------------ 1 file changed, 40 insertions(+), 15 deletions(-) diff --git a/proof/core/Handle.eca b/proof/core/Handle.eca index 91253a8..fc52215 100644 --- a/proof/core/Handle.eca +++ b/proof/core/Handle.eca @@ -822,22 +822,47 @@ split. move=> [za zc]; rewrite getP; case: ((za,zc) = (ya,yc))=> // _. by have /incli_of_INV H /H {H}:= HINV. + split; last by have /mh_of_INV [] _:= HINV. -(* have pi_yc: pi.[yc] = None. - + have /#: forall p b, pi.[yc] <> Some (p,b). - move=> p0 b0; rewrite -negP. - have /pi_of_INV [] -> [h] [#] _ := HINV. - have /hs_of_INV [] Hhuniq _ _^hs_h - /Hhuniq /(_ _ _ hs_hy) := HINV. - by move: hs_h; case: (h = hy)=> [<*>|//=]; rewrite hs_hy. - have path_hx: build_hpath mh p = Some (b,hx). - + move: pi_xc; have /pi_of_INV [] -> [h] [#] Hpath := HINV. - by have /hs_of_INV [] Hhuniq _ _ ^hs_h - /Hhuniq /(_ _ _ hs_hx) /= <*>:= HINV. - have ro_pbxa: ro.[rcons p (b +^ xa)] = Some ya. - + have /mh_of_INV [] _ -> := HINV. - by exists b hx hy; rewrite xorwA xorwK xorwC xorw0. - have path_hy: build_hpath mh (rcons p (b +^ xa)) = Some (ya,hy). + move=> xa' hx' ya' hy'; case: ((xa',hx') = (xa,hx))=> [[#] <*>|]. + + rewrite mh_xahx=> /= [#] <<*>; rewrite !getP /=. + case: (hx = hy)=> [<*>|_]; first by move: hs_hx; rewrite hs_hy. + by exists xc Known yc Known; rewrite getP. + move=> Hxahx' ^mh_xahx'; have /mh_of_INV [] H _ /H {H} := HINV. + move=> [xc' fx' yc' fy'] [#] hs_hx' hs_hy' Hite. + have Hxaxc': ((xa',xc') <> (xa,xc)). + + move: Hxahx'=> /=; case: (xa' = xa)=> [<*> /=|//=]; apply/contra=> <*>. + by move: hs_hx; have /hs_of_INV [] H _ _ /H {H} /(_ _ _ hs_hx' _):= HINV. + exists xc' (if hx' = hy then Known else fx') yc' (if hy' = hy then Known else fy'). + rewrite !getP Hxaxc' /=; case: (hy' = hy)=> [<*> /=|]. + + move: hs_hy' Hite; rewrite hs_hy=> /= [#] <<*> /=. + move=> [p' b'] [#] ro_pbxa' path_hx'. + case: (hx' = hy)=> [<*> /=|]. + + move: hs_hx' ; rewrite hs_hy=> /= [#] <<*> /=. + admit. (** Really not sure, but looks surprising that we could have mh.[(.,hy)] = Some (.,hy) in a well-formed map. **) + admit. + case: (hx' = hy)=> [<*> /=|//=]. + move: hs_hx'; rewrite hs_hy' hs_hy=> /= [#] <<*> /=. + by move: Hite=> /= [#]; case: fy' hs_hy'=> //= _ ->. +split=> c p' b'; rewrite !getP; case: (yc = c)=> [<<*> /=|yc_neq_c]. ++ admit. (* weird things going on here *) +(* + split=> [[#] <<*>|]. + + exists hy; rewrite getP /=. + apply/build_hpathP/(@Extend _ _ _ _ p (b +^ xa) b hx)=> //. + + move: pi_xc; have /pi_of_INV [] -> [h] [#] Hpath := HINV. + by have /hs_of_INV [] H _ _ /H {H} /(_ _ _ hs_hx _) // := HINV. + by rewrite xorwA xorwK xorwC xorw0. + move=> [h] [#] Hpath; rewrite getP; case: (h = hy)=> [<*> /=|]; last first. + + by move=> + hs_h; move: hs_h; have /hs_of_INV [] H _ _ /H {H} /(_ _ _ hs_hy _):= HINV. + move: pi_xc; have /pi_of_INV [] -> [ht] [#] path_p := HINV. + have /hs_of_INV [] H _ _ /H {H} /(_ _ _ hs_hx _) // <*> := HINV. + have: build_hpath mh (rcons p (b +^ xa)) = Some (ya,hy). + apply/build_hpathP/(@Extend _ _ _ _ p (b +^ xa) b hx)=> //. - by rewrite xorwA xorwK xorwC xorw0. *) - + by rewrite xorwA xorwK xorwC xorw0. + elim/last_ind: p' Hpath. + + rewrite /build_hpath /= => [#] <*>. + by move: hs_hy; have /hs_of_INV [] _ -> := HINV. *) +rewrite (@eq_sym c) yc_neq_c /=; have /pi_of_INV [] -> := HINV. +apply/exists_iff=> h /=; rewrite getP; case: (h = hy)=> [<*> /=|//=]. +by rewrite yc_neq_c hs_hy /=. admitted. clone export ConcreteF as ConcreteF1. From 40b36d05f1407ebfd967a426724b2999702bdb2e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Thu, 25 Aug 2016 11:02:02 +0100 Subject: [PATCH 211/525] Handle: augmenting invariant and finishing lemma 3. --- proof/core/Handle.eca | 189 ++++++++++++++++++++---------------------- 1 file changed, 90 insertions(+), 99 deletions(-) diff --git a/proof/core/Handle.eca b/proof/core/Handle.eca index fc52215..27cb51e 100644 --- a/proof/core/Handle.eca +++ b/proof/core/Handle.eca @@ -194,7 +194,11 @@ inductive mh_spec (hs : handles) (Gm : smap) (mh : hsmap) (ro : (block list,bloc ro.[rcons p bn] = Some b <=> exists v hx hy, build_hpath mh p = Some (v,hx) - /\ mh.[(v +^ bn,hx)] = Some (b,hy)). + /\ mh.[(v +^ bn,hx)] = Some (b,hy)) + & (forall p v p' v' hx, + build_hpath mh p = Some (v,hx) + => build_hpath mh p' = Some (v',hx) + => p = p' /\ v = v'). (* WELL-FORMEDNESS<2>: Handles, Handle-Map and Paths are compatible *) inductive pi_spec (hs : handles) (mh : hsmap) (pi : (capacity,block list * block) fmap) = @@ -482,7 +486,7 @@ lemma mh_addh hs ch Gm mh ro xc fx: => mh_spec hs Gm mh ro => mh_spec hs.[ch <- (xc,fx)] Gm mh ro. proof. -move=> [] _ _ dom_hs [] Hmh ?; split=> //. +move=> [] _ _ dom_hs [] Hmh ? ?; split=> //. move=> xa hx ya hy /Hmh [xc0 fx0 yc0 fy0] [#] hs_hx hs_hy Hite. exists xc0 fx0 yc0 fy0; rewrite !getP Hite hs_hx hs_hy /=. rewrite ltr_eqF /=; 1:by apply/(dom_hs _ hs_hx). @@ -509,22 +513,7 @@ lemma incl_addm (m m' : ('a,'b) fmap) x y: => incl m.[x <- y] m'.[x <- y]. proof. by move=> m_leq_m' x'; rewrite !getP; case: (x' = x)=> [|_ /m_leq_m']. qed. -(* lemma hinv_notin_rng m y2: *) -(* SLCommon.hinv m y2 = None => *) -(* (forall h f, m.[h] <> Some (y2,f)). *) -(* proof. by move=> hinv_none; have:= hinvP m y2; rewrite hinv_none. qed. *) - -(* lemma handles_spec_notin_dom m h: *) -(* handles_spec m h => *) -(* !mem (dom m) h. *) -(* proof. case; smt (in_dom). qed. *) - -(* lemma neq_Known f: f <> Known <=> f = Unknown. *) -(* proof. by case f. qed. *) - -(* lemma neq_Unkwown f: f <> Unknown <=> f = Known. *) -(* proof. by case f. qed. *) - +(** getflag: retrieve the flag of a capacity **) op getflag (hs : handles) xc = omap snd (obind ("_.[_]" hs) (hinv hs xc)). @@ -548,18 +537,6 @@ move=> /(huniq_hs _ h _ (xc,f)) /(_ hs_h) /= ->>. by rewrite hs_h. qed. -(* lemma paths_prefix handles m2 mh ro paths c b p v: *) -(* mh_spec handles m2 mh ro => *) -(* paths_spec handles mh paths => *) -(* paths.[c] = Some (rcons p b,v) => *) -(* (exists c' v', paths.[c'] = Some (p,v')). *) -(* proof. *) -(* move=> [] mh_some _ [] hpaths ^paths_c. *) -(* move=> /hpaths [h] [#] /build_hpathP [/#|] p' b' v' h' [#] ^/rconsIs + /rconssI- <*>. *) -(* move=> hpath + handles_h - /mh_some /= [c' c0 f' f]; rewrite handles_h /= => /> handles_h' _. *) -(* by exists c' v'; rewrite hpaths; exists h'. *) -(* qed. *) - (** Stuff about paths **) lemma build_hpath_prefix mh p b v h: build_hpath mh (rcons p b) = Some (v,h) @@ -674,7 +651,7 @@ move=> HINV x2_neq_y2 Pm_x Gm_x pi_x2 x2_notin_rng1_hs y2_notin_rng1_hs; split. + split. + move=> xa hx ya hy; rewrite getP; case: ((xa,hx) = (x1,ch))=> [|]. + by move=> [#] <*> [#] <*>; exists x2 Known y2 Known; rewrite !getP /#. - move=> xahx_neq_x1ch; have ^ /hs_of_INV Hhs /mh_of_INV [] Hmh _ /Hmh {Hmh} := HINV. + move=> xahx_neq_x1ch; have ^ /hs_of_INV Hhs /mh_of_INV [] Hmh _ _ /Hmh {Hmh} := HINV. move=> [xc fx yc fy] [#] hs_hx hs_hy Hite. exists xc fx yc fy; do 2?split; first 2 by smt (dom_hs_neq_ch dom_hs_neq_Sch getP). case: fy Hite hs_hy=> /= [[p v] [Hro Hpath] hs_hy|[#] Gm_xaxc <*> hs_hy] /=; last first. @@ -682,22 +659,30 @@ move=> HINV x2_neq_y2 Pm_x Gm_x pi_x2 x2_notin_rng1_hs y2_notin_rng1_hs; split. exists p v; rewrite Hro /=; apply/build_hpath_up=> //. have /m_mh_of_INV /notin_hs_notin_dom2_mh H:= HINV. exact/H/ch_notin_dom_hs/Hhs. - move=> p xa b; have /mh_of_INV [] _ -> := HINV. - apply/exists_iff=> v /=; apply/exists_iff=> hx /=; apply/exists_iff=> hy /=. - have mh_x1ch: mh.[(x1,ch)] = None. - + by apply/(notin_hs_notin_dom2_mh hs Pm)/ch_notin_dom_hs; case: HINV. - have ch_notin_rng2_mh: forall a h a', mh.[(a,h)] <> Some (a',ch). - + move=> a h a'; rewrite -negP; have /m_mh_of_INV [] _ Hmh_m /Hmh_m {Hmh_m} := HINV. - by move=> [xc fx yc fy] [#] _; rewrite ch_notin_dom_hs; case: HINV. - split=> -[#]. - + move=> Hpath mh_vxahx; rewrite getP; case: ((v +^ xa,hx) = (x1,ch))=> [/#|_]. - by rewrite mh_vxahx //=; apply/build_hpath_up=> //=; rewrite mh_x1ch. - have H /H {H}:= build_hpath_down mh x1 ch y1 (ch + 1) p v hx _. + + move=> p xa b; have /mh_of_INV [] _ -> _ := HINV. + apply/exists_iff=> v /=; apply/exists_iff=> hx /=; apply/exists_iff=> hy /=. + have mh_x1ch: mh.[(x1,ch)] = None. + + by apply/(notin_hs_notin_dom2_mh hs Pm)/ch_notin_dom_hs; case: HINV. + have ch_notin_rng2_mh: forall a h a', mh.[(a,h)] <> Some (a',ch). + + move=> a h a'; rewrite -negP; have /m_mh_of_INV [] _ Hmh_m /Hmh_m {Hmh_m} := HINV. + by move=> [xc fx yc fy] [#] _; rewrite ch_notin_dom_hs; case: HINV. + split=> -[#]. + + move=> Hpath mh_vxahx; rewrite getP; case: ((v +^ xa,hx) = (x1,ch))=> [/#|_]. + by rewrite mh_vxahx //=; apply/build_hpath_up=> //=; rewrite mh_x1ch. + have H /H {H}:= build_hpath_down mh x1 ch y1 (ch + 1) p v hx _. + + move=> p0 v0; rewrite -negP=> /build_hpathP [<*>|]. + + by have /hs_of_INV [] _ + H - /H {H} := HINV. + by move=> p' b' v' h' <*>; rewrite ch_notin_rng2_mh. + move=> ^ /build_hpathP + -> /=; rewrite getP. + by case=> [<*>|/#]; move: HINV=> /hs_of_INV [] _ + H - /H {H} /#. + move=> p v p' v' hx. + have: (forall p v, build_hpath mh p <> Some (v,ch)). + move=> p0 v0; rewrite -negP=> /build_hpathP [<*>|]. + by have /hs_of_INV [] _ + H - /H {H} := HINV. - by move=> p' b' v' h' <*>; rewrite ch_notin_rng2_mh. - move=> ^ /build_hpathP + -> /=; rewrite getP. - by case=> [<*>|/#]; move: HINV=> /hs_of_INV [] _ + H - /H {H} /#. + move=> p'0 b'0 v'0 h'0 <*> _; have /m_mh_of_INV [] _ H /H {H} := HINV. + by move=> [xc fx yc fy] [#] _; have /hs_of_INV [] _ _ H /H {H}:= HINV. + move=> ^ + /build_hpath_down H /H {H} - /build_hpath_down H + /H {H}. + by have /mh_of_INV [] _ _ /(_ p v p' v' hx) := HINV. split=> c p v; have ^/hs_of_INV [] _ _ dom_hs /pi_of_INV [] -> := HINV. apply/exists_iff=> h /=; split=> [#]. + move=> /(build_hpath_up mh x1 ch y1 (ch + 1) p v h) /(_ _). @@ -750,7 +735,7 @@ split. + move=> xa' hx' ya' hy'; rewrite getP; case: ((xa',hx') = (x1,hx))=> [[#] <*>> [#] <<*> /=|]. + exists x2 Known y2 Known=> //=; rewrite !getP /=. by have /hs_of_INV [] _ _ dom_hs /#:= HINV. - move=> xahx'_neq_x1hx; have /mh_of_INV [] Hmh _ /Hmh {Hmh} := HINV. + move=> xahx'_neq_x1hx; have /mh_of_INV [] Hmh _ _ /Hmh {Hmh} := HINV. move=> [xc fx yc] [] /= [#] hs_hx' hs_hy'=> [[p v] [Hro Hpath]|<*> Gm_xa'xc]. + exists xc fx yc Unknown=> /=; rewrite !getP hs_hx' hs_hy'. rewrite (dom_hs_neq_ch hs xc fx _ hs_hx') /=; 1:by case: HINV. @@ -761,21 +746,27 @@ split. exists xc Known yc Known=> //=; rewrite !getP; case: ((xa',xc) = (x1,x2))=> [/#|]. rewrite Gm_xa'xc /= (dom_hs_neq_ch hs xc Known _ hs_hx') /=; 1:by case: HINV. by rewrite (dom_hs_neq_ch hs yc Known _ hs_hy')/= ; 1:by case: HINV. - move=> p xa b; have /mh_of_INV [] _ -> := HINV; split. - + move=> [v hi hf] [#] Hpath mh_vxahi; exists v hi hf. - rewrite getP; case: ((v +^ xa,hi) = (x1,hx))=> [[#] <*>|_]. - + move: mh_vxahi; have /m_mh_of_INV [] _ H /H {H}:= HINV. - by move=> [xc fx yc fy] [#]; rewrite hs_hx=> [#] <*>; rewrite PFm_x1x2. - rewrite mh_vxahi /=; apply/build_hpath_up=> //. - by apply/(notin_m_notin_mh _ _ _ _ _ PFm_x1x2 hs_hx); case: HINV. - move=> [v hi hf] [#]. - have no_path_to_hx: forall p0 v0, build_hpath G1mh p0 <> Some (v0,hx). + + move=> p xa b; have /mh_of_INV [] _ -> _ := HINV; split. + + move=> [v hi hf] [#] Hpath mh_vxahi; exists v hi hf. + rewrite getP; case: ((v +^ xa,hi) = (x1,hx))=> [[#] <*>|_]. + + move: mh_vxahi; have /m_mh_of_INV [] _ H /H {H}:= HINV. + by move=> [xc fx yc fy] [#]; rewrite hs_hx=> [#] <*>; rewrite PFm_x1x2. + rewrite mh_vxahi /=; apply/build_hpath_up=> //. + by apply/(notin_m_notin_mh _ _ _ _ _ PFm_x1x2 hs_hx); case: HINV. + move=> [v hi hf] [#]. + have no_path_to_hx: forall p0 v0, build_hpath G1mh p0 <> Some (v0,hx). + + have /pi_of_INV [] /(_ x2):= HINV; rewrite pi_x2 /=. + by move=> + p0 v0 - /(_ p0 v0) /negb_exists /(_ hx) /=; rewrite hs_hx. + have H /H {H} := build_hpath_down G1mh x1 hx y1 ch p v hi no_path_to_hx. + rewrite getP. case: ((v +^ xa,hi) = (x1,hx))=> [[#] <*>|_ Hpath Hextend]. + + by rewrite no_path_to_hx. + by exists v hi hf. + move=> p v p' v' h0. + have: forall p0 v0, build_hpath G1mh p0 <> Some (v0,hx). + have /pi_of_INV [] /(_ x2):= HINV; rewrite pi_x2 /=. by move=> + p0 v0 - /(_ p0 v0) /negb_exists /(_ hx) /=; rewrite hs_hx. - have H /H {H} := build_hpath_down G1mh x1 hx y1 ch p v hi no_path_to_hx. - rewrite getP. case: ((v +^ xa,hi) = (x1,hx))=> [[#] <*>|_ Hpath Hextend]. - + by rewrite no_path_to_hx. - by exists v hi hf. + move=> ^ + /build_hpath_down H /H {H} - /build_hpath_down H + /H {H}. + by have /mh_of_INV [] _ _ /(_ p v p' v' h0):= HINV. split=> c p v; have /pi_of_INV [] -> := HINV. apply/exists_iff=> h /=; split=> [#]. + move=> /build_hpath_up /(_ x1 hx y1 ch _). @@ -821,49 +812,49 @@ split. rewrite hs_hx hs_hy=> /= [#] 2!<<- {xct fxt} [#] 2!<<- {yct fyt} Pmi_yayc. move=> [za zc]; rewrite getP; case: ((za,zc) = (ya,yc))=> // _. by have /incli_of_INV H /H {H}:= HINV. -+ split; last by have /mh_of_INV [] _:= HINV. ++ split; last 2 by have /mh_of_INV [] _:= HINV. move=> xa' hx' ya' hy'; case: ((xa',hx') = (xa,hx))=> [[#] <*>|]. + rewrite mh_xahx=> /= [#] <<*>; rewrite !getP /=. case: (hx = hy)=> [<*>|_]; first by move: hs_hx; rewrite hs_hy. by exists xc Known yc Known; rewrite getP. - move=> Hxahx' ^mh_xahx'; have /mh_of_INV [] H _ /H {H} := HINV. - move=> [xc' fx' yc' fy'] [#] hs_hx' hs_hy' Hite. - have Hxaxc': ((xa',xc') <> (xa,xc)). - + move: Hxahx'=> /=; case: (xa' = xa)=> [<*> /=|//=]; apply/contra=> <*>. - by move: hs_hx; have /hs_of_INV [] H _ _ /H {H} /(_ _ _ hs_hx' _):= HINV. - exists xc' (if hx' = hy then Known else fx') yc' (if hy' = hy then Known else fy'). - rewrite !getP Hxaxc' /=; case: (hy' = hy)=> [<*> /=|]. - + move: hs_hy' Hite; rewrite hs_hy=> /= [#] <<*> /=. - move=> [p' b'] [#] ro_pbxa' path_hx'. - case: (hx' = hy)=> [<*> /=|]. - + move: hs_hx' ; rewrite hs_hy=> /= [#] <<*> /=. - admit. (** Really not sure, but looks surprising that we could have mh.[(.,hy)] = Some (.,hy) in a well-formed map. **) - admit. - case: (hx' = hy)=> [<*> /=|//=]. - move: hs_hx'; rewrite hs_hy' hs_hy=> /= [#] <<*> /=. + move=> Hxahx' mh_xahx'. + have ^path_to_hy: build_hpath mh (rcons p (b +^ xa)) = Some (ya,hy). + + apply/build_hpath_prefix; exists b hx. + rewrite xorwA xorwK xorwC xorw0 mh_xahx /=. + move: pi_xc; have /pi_of_INV [] -> [h] [#] := HINV. + by have /hs_of_INV [] H _ _ + /H {H} /(_ _ _ hs_hx _) := HINV. + have /mh_of_INV [] /(_ _ _ _ _ mh_xahx') + ro_def H /H {H} unique_path_to_hy := HINV. + move=> [xc' fx' yc' fy'] /= [#]. + case: (hy' = hy)=> [<*> hs_hx'|Hhy']. + + rewrite hs_hy=> /= [#] <<*> /= [p' b'] [#] ro_pbxa' path_hx'. + have:= unique_path_to_hy (rcons p' (b' +^ xa')) ya' _. + + by apply/build_hpath_prefix; exists b' hx'; rewrite xorwA xorwK xorwC xorw0. + move=> [#] ^/rconsIs + /rconssI - <<*>. + by move: mh_xahx' Hxahx' mh_xahx; have /inv_of_INV [] ^ + -> - -> -> /= -> := HINV. + rewrite (@getP _ _ _ hy') Hhy'=> /= hs_hx' ^ hs_hy' -> Hite. + exists xc' (if hx' = hy then Known else fx') yc' fy'. + rewrite (@getP Gm) (_: (xa',xc') <> (xa,xc)) /=. + + move: Hxahx'=> /=; case: (xa' = xa)=> [<*> /=|//]. + by apply/contra=> <*>; have /hs_of_INV [] + _ _ - /(_ _ _ _ _ hs_hx' hs_hx _) := HINV. + rewrite getP; case: (hx' = hy)=> /= [<*>|//]. + move: hs_hx'; rewrite hs_hy=> /= [#] <<*> /=. by move: Hite=> /= [#]; case: fy' hs_hy'=> //= _ ->. -split=> c p' b'; rewrite !getP; case: (yc = c)=> [<<*> /=|yc_neq_c]. -+ admit. (* weird things going on here *) -(* + split=> [[#] <<*>|]. - + exists hy; rewrite getP /=. - apply/build_hpathP/(@Extend _ _ _ _ p (b +^ xa) b hx)=> //. - + move: pi_xc; have /pi_of_INV [] -> [h] [#] Hpath := HINV. - by have /hs_of_INV [] H _ _ /H {H} /(_ _ _ hs_hx _) // := HINV. - by rewrite xorwA xorwK xorwC xorw0. - move=> [h] [#] Hpath; rewrite getP; case: (h = hy)=> [<*> /=|]; last first. - + by move=> + hs_h; move: hs_h; have /hs_of_INV [] H _ _ /H {H} /(_ _ _ hs_hy _):= HINV. - move: pi_xc; have /pi_of_INV [] -> [ht] [#] path_p := HINV. - have /hs_of_INV [] H _ _ /H {H} /(_ _ _ hs_hx _) // <*> := HINV. - have: build_hpath mh (rcons p (b +^ xa)) = Some (ya,hy). - + apply/build_hpathP/(@Extend _ _ _ _ p (b +^ xa) b hx)=> //. - by rewrite xorwA xorwK xorwC xorw0. - elim/last_ind: p' Hpath. - + rewrite /build_hpath /= => [#] <*>. - by move: hs_hy; have /hs_of_INV [] _ -> := HINV. *) -rewrite (@eq_sym c) yc_neq_c /=; have /pi_of_INV [] -> := HINV. -apply/exists_iff=> h /=; rewrite getP; case: (h = hy)=> [<*> /=|//=]. -by rewrite yc_neq_c hs_hy /=. -admitted. +split=> c p' b'; rewrite !getP; case: (yc = c)=> [<<*> /=|yc_neq_c]; last first. ++ rewrite (@eq_sym c) yc_neq_c /=; have /pi_of_INV [] -> := HINV. + apply/exists_iff=> h /=; rewrite getP; case: (h = hy)=> [<*> /=|//=]. + by rewrite yc_neq_c hs_hy /=. +split=> [[#] <<*>|]. ++ exists hy; rewrite getP /=; apply/build_hpath_prefix. + exists b hx; rewrite xorwA xorwK xorwC xorw0 mh_xahx /=. + move: pi_xc; have /pi_of_INV [] -> [h] [#] + hs_h:= HINV. + by have /hs_of_INV [] + _ _ - /(_ _ _ _ _ hs_hx hs_h _) := HINV. +move=> [h]; rewrite getP; case: (h = hy)=> [<*> /=|]; last first. ++ by have /hs_of_INV [] H _ _ + [#] _ /H {H} /(_ _ _ hs_hy _) // <*> := HINV. +have /mh_of_INV [] _ _ /(_ p' b') H /H {H} /(_ (rcons p (b +^ xa)) ya _) //:= HINV. +apply/build_hpath_prefix; exists b hx; rewrite xorwA xorwK xorwC xorw0 mh_xahx /=. +move: pi_xc; have /pi_of_INV [] -> [h] [#] + hs_h:= HINV. +by have /hs_of_INV [] + _ _ - /(_ _ _ _ _ hs_hx hs_h _) := HINV. +qed. clone export ConcreteF as ConcreteF1. @@ -1038,7 +1029,7 @@ section AUX. + auto=> &hr [#] !<<- _ _ !->> _ /= _ _; rewrite pi_x2 oget_some /=. rewrite in_dom; case: {-1}(ro0.[rcons p0 (v0 +^ x1)]) (eq_refl (ro0.[rcons p0 (v0 +^ x1)])). + done. - move=> bo ^ro_pvx1 /=. have /mh_of_INV [] _ ->:= inv0. + move=> bo ^ro_pvx1 /=. have /mh_of_INV [] _ -> _:= inv0. rewrite negb_exists=> ? /=; rewrite negb_exists=> ? /=; rewrite negb_exists=> yh /=. rewrite Hpath /=; rewrite negb_and -implyNb /= => [#] !<<-. rewrite xorwA xorwK xorwC xorw0 -negP=> G1mh_x1hx2. @@ -1061,7 +1052,7 @@ section AUX. case @[ambient]: fx2 hs_hx2=> hs_hx2. + swap{2} 3 -2; seq 0 1: (G1.bext{2}); last by inline*; if{2}; auto; smt (@Block @Capacity). by auto=> ? ? [#] !<<- _ -> ->> _ /=; rewrite in_rng; exists hx2. - have /mh_of_INV []/(_ _ _ _ _ G1mh_x1hx2) + _:= inv0. + have /mh_of_INV []/(_ _ _ _ _ G1mh_x1hx2) + _ _:= inv0. move=> [xc0 xf0 yc0 yf0] [#]; rewrite hs_hx2 hs_hy2=> [#] !<<- [#] !<<- {xc0 xf0 yc0 yf0} /= [p0 v0] [#] Hro Hpath. have /pi_of_INV [] /(_ x2 p0 v0) /iffRL /(_ _) := inv0. + by exists hx2. From 7bda1df74e8f2ed342d56ae23e9a29fd125a704c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Thu, 25 Aug 2016 11:38:26 +0100 Subject: [PATCH 212/525] Initialization. --- proof/core/Handle.eca | 32 ++++++++------------------------ proof/core/SLCommon.ec | 8 ++++++++ 2 files changed, 16 insertions(+), 24 deletions(-) diff --git a/proof/core/Handle.eca b/proof/core/Handle.eca index 27cb51e..d929a12 100644 --- a/proof/core/Handle.eca +++ b/proof/core/Handle.eca @@ -1070,8 +1070,8 @@ section AUX. move=> _ _ _ _; rewrite PFm_x1x2 pi_x2 !oget_some //=. rewrite (@huniq_hinvK_h hx2 hs0 x2) // ?oget_some. + by have /hs_of_INV []:= inv0. - rewrite Hro G1mh_x1hx2 hs_hy2 ?oget_some //=. - (* lemma 3 *) admit. + rewrite Hro G1mh_x1hx2 hs_hy2 ?oget_some //= => _. + exact/(@lemma3 _ _ _ _ _ _ _ _ _ _ _ _ hx2 _ _ hy2). (* Stopped here *) + move=> &2 _; proc; if=> //=; wp; rnd predT; rnd predT; auto. smt (Block.DWord.bdistr_uf Capacity.DWord.cdistr_uf). @@ -1096,29 +1096,13 @@ section AUX. (* lossless and do not reset bad G1.C.f *) + admit. (* Init ok *) - admit. -(*inline *. auto; progress=> //=. - + smt w=map0P. - + smt w=map0P. - + smt w=map0P. - + smt w=map0P. - + smt w=map0P. - + smt w=(map0P in_dom). - + smt w=map0P. - + rewrite /paths_spec=> c p v. rewrite !getP; case (c = c0)=> //=. - rewrite anda_and=> c_c0; split=> [[] <<- <<-|]. - + by exists 0; rewrite /build_hpath /= getP /= c_c0. - move=> [h] @/build_hpath [] h0; rewrite getP; case (h = 0). - + by move=> /= ->> ->>; move: h0; smt. - smt w=map0P. - move=> c_c0; rewrite map0P /= negb_exists /= => h. - rewrite negb_and getP; case (h = 0)=> //=; [|by rewrite map0P]. - by move=> _; right; rewrite eq_sym. - + smt w=(map0P getP). + inline *; auto=> />; split=> [|/#]. + (do !split; last 3 smt (getP map0P build_hpath_map0)); last 5 by move=> ? ? ? ?; rewrite map0P. + + move=> h1 h2 ? ?; rewrite !getP !map0P. + by case: (h1 = 0); case: (h2 = 0)=> //=. + by rewrite getP. - + move: H; rewrite in_dom getP; case (h = 0)=> //=. - by rewrite map0P. - + by move: H1=> /H0 [#].*) + + by move=> ? h; rewrite getP map0P; case: (h = 0). + by move=> ? ?; rewrite !map0P. qed. end section AUX. diff --git a/proof/core/SLCommon.ec b/proof/core/SLCommon.ec index fbb4548..01ac9dc 100644 --- a/proof/core/SLCommon.ec +++ b/proof/core/SLCommon.ec @@ -138,6 +138,14 @@ case=> [/#|] p' b' v'' h'' ^/rconssI <<- {p'} /rconsIs <<- {b'}. by rewrite build /= => [#] <*>. qed. +lemma build_hpath_map0 p: + build_hpath map0 p + = if p = [] then Some (b0,0) else None. +proof. +elim/last_ind: p=> //= p b _. +by rewrite -{1}cats1 foldl_cat {1}/step_hpath /= map0P /= /#. +qed. + (* -------------------------------------------------------------------------- *) module C = { From be2bc79c1afe95b5dc6a04653533e8a6f29d9fed Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Thu, 25 Aug 2016 12:43:31 +0100 Subject: [PATCH 213/525] Sorting out the easy things. --- proof/core/Handle.eca | 20 +++++++++++++++----- 1 file changed, 15 insertions(+), 5 deletions(-) diff --git a/proof/core/Handle.eca b/proof/core/Handle.eca index d929a12..b962b2e 100644 --- a/proof/core/Handle.eca +++ b/proof/core/Handle.eca @@ -1072,7 +1072,7 @@ section AUX. + by have /hs_of_INV []:= inv0. rewrite Hro G1mh_x1hx2 hs_hy2 ?oget_some //= => _. exact/(@lemma3 _ _ _ _ _ _ _ _ _ _ _ _ hx2 _ _ hy2). - (* Stopped here *) + (* lossless PF.f *) + move=> &2 _; proc; if=> //=; wp; rnd predT; rnd predT; auto. smt (Block.DWord.bdistr_uf Capacity.DWord.cdistr_uf). (* lossless and do not reset bad G1.S.f *) @@ -1085,16 +1085,26 @@ section AUX. (* equiv PF.P.fi G1.S.fi *) + admit. (* lossless PF.P.fi *) - + admit. + + move=> &2 _; proc; if=> //=; wp; rnd predT; rnd predT; auto. + smt (Block.DWord.bdistr_uf Capacity.DWord.cdistr_uf). (* lossless and do not reset bad G1.S.fi *) - + admit. + + move=> _; proc; if; 2:by auto. + by wp; do 2!rnd predT; auto => &hr [#]; smt (Block.DWord.bdistr_uf Capacity.DWord.cdistr_uf). (** proofs for G1.C.f *) (* equiv PF.C.f G1.C.f *) + admit. (* lossless PF.C.f *) - + admit. + + move=> &2 _; proc; inline *; while (true) (size p); auto. + + sp; if; 2:by auto; smt (size_behead). + by wp; do 2!rnd predT; auto; smt (size_behead Block.DWord.bdistr_uf Capacity.DWord.cdistr_uf). + smt (size_ge0). (* lossless and do not reset bad G1.C.f *) - + admit. + + move=> _; proc; inline *; wp; rnd predT; auto. + while (G1.bcol \/ G1.bext) (size p - i)=> [z|]. + + if; 1:by auto=> /#. + wp; rnd predT; wp; rnd predT; auto. + smt (Block.DWord.bdistr_uf Capacity.DWord.cdistr_uf). + by auto; smt (Block.DWord.bdistr_uf Capacity.DWord.cdistr_uf). (* Init ok *) inline *; auto=> />; split=> [|/#]. (do !split; last 3 smt (getP map0P build_hpath_map0)); last 5 by move=> ? ? ? ?; rewrite map0P. From e536650de262f0e0ed851a2478fb7e756acc5056 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Thu, 25 Aug 2016 16:54:54 +0200 Subject: [PATCH 214/525] some progress, need a lot of simplification --- proof/core/Handle.eca | 131 +++++++++++++++++++++++++++++++++++++++++- 1 file changed, 130 insertions(+), 1 deletion(-) diff --git a/proof/core/Handle.eca b/proof/core/Handle.eca index b962b2e..64d1f09 100644 --- a/proof/core/Handle.eca +++ b/proof/core/Handle.eca @@ -858,6 +858,48 @@ qed. clone export ConcreteF as ConcreteF1. +lemma m_mh_None hs0 PFm G1mh hx2 x2 k x1: + m_mh hs0 PFm G1mh => + hs0.[hx2] = Some (x2, k) => + PFm.[(x1, x2)] = None => + G1mh.[(x1,hx2)] = None. +proof. + move=> [] HP /(_ x1 hx2) + Hhx2;case (G1mh.[(x1, hx2)]) => //. + by move=> -[ya hy] /(_ ya hy) /= [] ????; rewrite Hhx2 => /= [#] <- _ _ ->. +qed. + +lemma build_hpath_None (G1mh:hsmap) p: + foldl (step_hpath G1mh) None p = None. +proof. by elim:p. qed. + +lemma build_hpath_up_None (G1mh:hsmap) bi1 bi2 bi p: + G1mh.[bi1] = None => + build_hpath G1mh p = Some bi => + build_hpath G1mh.[bi1 <- bi2] p = Some bi. +proof. + rewrite /build_hpath;move=> Hbi1. + elim: p (Some (b0,0)) => //= b p Hrec obi. + rewrite {2 4}/step_hpath /=;case: obi => //= [ | bi'];1:by apply Hrec. + rewrite oget_some. + rewrite getP. case ((bi'.`1 +^ b, bi'.`2) = bi1) => [-> | _];2:by apply Hrec. + by rewrite Hbi1 build_hpath_None. +qed. + +lemma build_hpath_down_None h ch mh xa ha ya a p: + h <> ch => ha <> ch => + (forall ya, mh.[(ya,ch)] = None) => + build_hpath mh.[(xa,ha) <- (ya,ch)] p = Some (a,h) => + build_hpath mh p = Some (a,h). +proof. + move=> Hh Hha Hmh;rewrite /build_hpath;move: (Some (b0, 0)). + elim: p => //= b p Hrec [ | bi] /=;rewrite {2 4}/step_hpath /= ?build_hpath_None //. + rewrite oget_some getP;case ((bi.`1 +^ b, bi.`2) = (xa, ha)) => _;2:by apply Hrec. + move=> {Hrec};case: p=> /= [[_ ->>]| b' p];1: by move:Hh. + by rewrite {2}/step_hpath /= oget_some /= getP_neq /= ?Hha // Hmh build_hpath_None. +qed. + +(* we should do a lemma to have the equivalence *) + section AUX. declare module D : DISTINGUISHER {PF, RO, G1}. @@ -1036,7 +1078,94 @@ section AUX. have /m_mh_of_INV [] _ /(_ _ _ _ _ G1mh_x1hx2) := inv0. move=> [xc xf yc yf] [#]; rewrite hs_hx2=> [#] <*>. by rewrite PFm_x1x2. - auto. admit. (* this is the easy case *) + auto => &m1 &m2 [#] !<- _ _ -> /= _ y1L -> y2L -> /=. + rewrite !getP_eq pi_x2 !oget_some /=. + have /hs_of_INV [] Hu _ _:= inv0; have -> := huniq_hinvK_h _ _ _ Hu hs_hx2. + rewrite oget_some -!nor => /= -[] ? Hy2L [*]. + case:inv0=> Hhs Hinv Hmmh Hmmhi Hincl Hincli Hmh Hpi; apply HCF_G1. + + by apply hs_addh => //;have /# := hinvP hs0 y2L. + + apply inv_addm=>//;first by move: hs_hx2 PFm_x1x2;apply: m_mh_None. + by apply (ch_notin_dom2_mh _ _ Hmmhi Hhs). + + by apply (m_mh_addh_addm _ Hmmh _ hs_hx2)=>//;apply ch_notin_dom_hs. + + apply (mi_mhi_addh_addmi _ Hmmhi _ hs_hx2);last by apply ch_notin_dom_hs. + by have := hinvP hs0 y2L;rewrite Hy2L /#. + + by apply incl_addm. + by apply incl_addm. + + split. + + move=> xa hx ya hy;rewrite getP;case ((xa, hx) = (x1, hx2))=> /=. + + move=> [] !-> [] !<-; exists x2 Known y2L Known. + by rewrite !getP_eq /= getP_neq // eq_sym; apply (dom_hs_neq_ch _ _ _ Hhs hs_hx2). + move=> Hdiff Hxa; case Hmh=> /(_ _ _ _ _ Hxa) [] xc fx yc fy [#] Hhx Hhy HG1 _. + exists xc fx yc fy;rewrite !getP_neq //. + + by rewrite eq_sym;apply (dom_hs_neq_ch _ _ _ Hhs Hhx). + + by rewrite eq_sym;apply (dom_hs_neq_ch _ _ _ Hhs Hhy). + + rewrite /= -negP=> -[] <<- <<-;apply Hdiff=> /=. + by apply (Hu hx (x2, fx) (x2, Known)). + rewrite Hhx Hhy=> /=;move: HG1. + case: fy Hhy=> Hhy //= [p v [Hro Hbu]]. + exists p v;split. + + rewrite getP_neq // -negP => ^ /rconssI <<- /rconsIs. + move: Hbu;rewrite Hpath /= => -[!<<-] /=. + by rewrite -negP=> /Block.WRing.addrI /#. + by apply build_hpath_up=> //; move: hs_hx2 PFm_x1x2;apply: m_mh_None. + move=> p bn b; rewrite getP. + case (rcons p bn = rcons p0 (v0 +^ x1)). + + move=> ^ /rconssI <<- /rconsIs ->> /=; split => [<<- | ]. + + exists v0 hx2 ch0. + rewrite (build_hpath_up Hpath) /=;1:by move: hs_hx2 PFm_x1x2;apply: m_mh_None. + by rewrite xorwA xorwK Block.WRing.add0r getP_eq. + move=> [v hx hy] [];rewrite getP ;case ((v +^ (v0 +^ x1), hx) = (x1, hx2)) => //. + move=> Hdiff;have HG1 := m_mh_None _ _ _ _ _ _ _ Hmmh hs_hx2 PFm_x1x2. + have -> /= [->> <<-]:= build_hpath_up_None _ _ (y1L, ch0) _ _ HG1 Hpath. + by move:Hdiff;rewrite xorwA xorwK Block.WRing.add0r. + move=> Hdiff; case Hmh => _ ->. + apply exists_iff=> v /= ;apply exists_iff => hx /=;apply exists_iff => hy /=;split. + + move=> [Hp Hhx]. + have HG1 := m_mh_None _ _ _ _ _ _ _ Hmmh hs_hx2 PFm_x1x2. + have -> /= := build_hpath_up_None _ _ (y1L, ch0) _ _ HG1 Hp. + by rewrite getP_neq //= -negP => -[->> <<-]; move: Hhx;rewrite HG1. + rewrite getP; case ((v +^ bn, hx) = (x1, hx2))=> /=. + + move=> [<<- ->>] [+ [!<<-]]. + have Hhx2:= dom_hs_neq_ch _ _ _ _ _ Hhs hs_hx2. + move=> Hbui;have := build_hpath_down_None _ _ _ _ _ _ _ _ _ _ _ Hbui=> //. + + move=> ya;case Hmmh=> _ /(_ ya ch0);case (G1mh.[(ya, ch0)]) => //. + move=> [ya1 hy1] /(_ ya1 hy1) /=;rewrite -negP => -[xc fx yc fy [#] Hch]. + by have := dom_hs_neq_ch _ _ _ _ _ Hhs Hch. + move=>{Hbui} Hbui; have : pi0.[x2] = Some (p, v). + + by case: Hpi => ->;exists hx2. + by rewrite pi_x2 /= => -[!->>];move:Hdiff; rewrite xorwA xorwK Block.WRing.add0r. + move=> _ [+ ^ H ->] /=. apply build_hpath_down_None. + + case: Hmmh => _ /(_ _ _ _ _ H) [xc fx yc fy [#] Hch] _ _. + by apply (dom_hs_neq_ch _ _ _ Hhs Hch). + + by apply (dom_hs_neq_ch _ _ _ Hhs hs_hx2). + move=> ya; case Hmmh=> _ /(_ ya ch0); case (G1mh.[(ya, ch0)])=> //. + move=>[ya1 ha1] /(_ ya1 ha1) [xc fx yc fy [#] Hch]. + by have := dom_hs_neq_ch _ _ _ _ _ Hhs Hch. + split=> c p v;rewrite getP. case (c = y2L) => [->> /= | ?]. + + split. + + move=> [!<<-];exists ch0;rewrite getP_eq /= build_hpath_prefix. + exists v0 hx2;rewrite xorwA xorwK Block.WRing.add0r getP_eq /=. + have HG1 := m_mh_None _ _ _ _ _ _ _ Hmmh hs_hx2 PFm_x1x2. + by apply build_hpath_up_None. + have Hhx2:= dom_hs_neq_ch _ _ _ _ _ Hhs hs_hx2. + move=> [h []];rewrite getP;case (h=ch0)=> [->> /= | Hh]. + + admit. + move=> Hbui;have := build_hpath_down_None _ _ _ _ _ _ _ _ _ _ _ Hbui=> //. + + move=> ya;case Hmmh=> _ /(_ ya ch0);case (G1mh.[(ya, ch0)]) => //. + move=> [ya1 hy1] /(_ ya1 hy1) /=;rewrite -negP => -[xc fx yc fy [#] Hch]. + by have := dom_hs_neq_ch _ _ _ _ _ Hhs Hch. + by move=> _ Hhsh;have := hinvP hs0 y2L;rewrite Hy2L /= => /(_ h Known);rewrite Hhsh. + case Hpi=> ->;apply exists_iff=> /= h;rewrite getP;case (h = ch0) => [->> /= | Hdiff]. + + split => [|/#]. + by rewrite build_hpathP=> -[_ Hch]; have := dom_hs_neq_ch _ _ _ _ _ Hhs Hch. + split=> -[+ ->] /=. + + have HG1 := m_mh_None _ _ _ _ _ _ _ Hmmh hs_hx2 PFm_x1x2. + by apply build_hpath_up_None. + have Hhx2:= dom_hs_neq_ch _ _ _ _ _ Hhs hs_hx2. + apply build_hpath_down_None=> //. + move=> ya;case Hmmh=> _ /(_ ya ch0);case (G1mh.[(ya, ch0)]) => //. + move=> [ya1 hy1] /(_ ya1 hy1) /=;rewrite -negP => -[xc fx yc fy [#] Hch]. + by have := dom_hs_neq_ch _ _ _ _ _ Hhs Hch. + (* this is the easy case *) move=> [xa xc] PFm_x1x2. rcondf{1} 1; 1:by auto=> &hr [#] !<<- _ _ ->>; rewrite in_dom PFm_x1x2. have /m_mh_of_INV [] + _ - /(_ _ _ _ _ PFm_x1x2) := inv0. move=> [hx2 fx2 hy2 fy2] [#] hs_hx2 hs_hy2 G1mh_x1hx2. From f5a47c133a95c82236427a8e67ed88615e647f2f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Thu, 25 Aug 2016 18:32:20 +0100 Subject: [PATCH 215/525] Moving forward with proof for inversion. We really need to make the lemmas slightly more abstract. --- proof/core/Handle.eca | 275 +++++++++++++++++++++++++++++++++++++++++- 1 file changed, 272 insertions(+), 3 deletions(-) diff --git a/proof/core/Handle.eca b/proof/core/Handle.eca index 64d1f09..2e399aa 100644 --- a/proof/core/Handle.eca +++ b/proof/core/Handle.eca @@ -452,6 +452,18 @@ by move: hs_hy0; rewrite yc_notin_rng1_hs. qed. (** Preservation of hs_spec **) +lemma huniq_addh hs h c f: + huniq hs + => (forall f' h', hs.[h'] <> Some (c,f')) + => huniq hs.[h <- (c,f)]. +proof. +move=> Hhuniq c_notin_rng1_hs h1 h2 [c1 f1] [c2 f2]; rewrite !getP. +case: (h1 = h); case: (h2 = h)=> //= [Hh2 + [#]|+ Hh1 + [#]|_ _] - <*>. ++ by rewrite c_notin_rng1_hs. ++ by rewrite c_notin_rng1_hs. +exact/Hhuniq. +qed. + lemma hs_addh hs ch xc fx: hs_spec hs ch => (forall f h, hs.[h] <> Some (xc,f)) @@ -616,7 +628,6 @@ lemma lemma1 hs ch Pm Pmi Gm Gmi mh mhi ro pi x1 x2 y1 y2: => x2 <> y2 => Pm.[(x1,x2)] = None => Gm.[(x1,x2)] = None - => pi.[x2] = None => (forall f h, hs.[h] <> Some (x2,f)) => (forall f h, hs.[h] <> Some (y2,f)) => INV_CF_G1 @@ -626,7 +637,7 @@ lemma lemma1 hs ch Pm Pmi Gm Gmi mh mhi ro pi x1 x2 y1 y2: mh.[(x1,ch) <- (y1,ch + 1)] mhi.[(y1,ch + 1) <- (x1,ch)] ro pi. proof. -move=> HINV x2_neq_y2 Pm_x Gm_x pi_x2 x2_notin_rng1_hs y2_notin_rng1_hs; split. +move=> HINV x2_neq_y2 Pm_x Gm_x x2_notin_rng1_hs y2_notin_rng1_hs; split. + rewrite (@addzA ch 1 1); apply/hs_addh. + by move: HINV=> /hs_of_INV/hs_addh=> ->. by move=> f h; rewrite getP; case: (h = ch)=> [/#|_]; exact/y2_notin_rng1_hs. @@ -702,6 +713,95 @@ move=> ^ /build_hpathP + -> /=; rewrite !getP. by case=> [<*>|/#]; move: HINV=> /hs_of_INV [] _ + H - /H {H} /#. qed. +lemma lemma1' hs ch Pm Pmi Gm Gmi mh mhi ro pi x1 x2 y1 y2: + INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi + => x2 <> y2 + => Pmi.[(x1,x2)] = None + => Gmi.[(x1,x2)] = None + => (forall f h, hs.[h] <> Some (x2,f)) + => (forall f h, hs.[h] <> Some (y2,f)) + => INV_CF_G1 + hs.[ch <- (x2,Known)].[ch + 1 <- (y2,Known)] (ch + 2) + Pm.[(y1,y2) <- (x1,x2)] Pmi.[(x1,x2) <- (y1,y2)] + Gm.[(y1,y2) <- (x1,x2)] Gmi.[(x1,x2) <- (y1,y2)] + mh.[(y1,ch + 1) <- (x1,ch)] mhi.[(x1,ch) <- (y1,ch + 1)] + ro pi. +proof. +move=> HINV x2_neq_y2 Pm_x Gm_x xc_notin_rng1_hs yc_notin_rng1_hs; split. ++ rewrite (@addzA ch 1 1); apply/hs_addh. + + by move: HINV=> /hs_of_INV/hs_addh=> ->. + by move=> f h; rewrite getP; case: (h = ch)=> [/#|_]; exact/yc_notin_rng1_hs. ++ apply/inv_addm; 1:by case: HINV. + + have ^ /m_mh_of_INV Hm_mh /hs_of_INV Hhs := HINV. + by apply/(Sch_notin_dom2_mh _ _ Hm_mh Hhs). + have ^ /mi_mhi_of_INV Hmi_mhi /hs_of_INV Hhs := HINV. + by apply/(ch_notin_dom2_mh _ _ Hmi_mhi Hhs). ++ apply/(@mi_mhi_addh_addmi hs.[ch <- (x2,Known)] Pm mh ch x1 x2 (ch + 1) y1 y2 Known). + + by move: HINV=> ^/hs_of_INV Hhs /m_mh_of_INV; exact/(m_mh_addh Hhs). + + by move=> f h; rewrite getP; case: (h = ch)=> [<*> /#|]; rewrite yc_notin_rng1_hs. + + by rewrite getP. + by rewrite getP gtr_eqF 1:/# /=; apply/Sch_notin_dom_hs; case: HINV. ++ apply/(@m_mh_addh_addm hs.[ch <- (x2,Known)] Pmi mhi ch x1 x2 (ch + 1) y1 y2 Known). + + by move: HINV=> ^/hs_of_INV Hhs /mi_mhi_of_INV; exact/(m_mh_addh Hhs). + + by have /hs_of_INV /hs_addh /(_ x2 Known _) // []:= HINV. + + by rewrite getP. + by rewrite getP gtr_eqF 1:/# /=; apply/Sch_notin_dom_hs; case: HINV. ++ by apply/incl_addm; case: HINV. ++ by apply/incl_addm; case: HINV. ++ split. + + move=> ya hy xa hx; rewrite getP; case: ((ya,hy) = (y1,ch + 1))=> [|]. + + by move=> [#] <*> [#] <*>; exists y2 Known x2 Known; rewrite !getP /#. + move=> yahy_neq_y1Sch; have ^ /hs_of_INV Hhs /mh_of_INV [] Hmh _ _ /Hmh {Hmh} := HINV. + move=> [yc fy xc fx] [#] hs_hy hs_hx Hite. + exists yc fy xc fx; do 2?split; first 2 by smt (dom_hs_neq_ch dom_hs_neq_Sch getP). + case: fx Hite hs_hx=> /= [[p v] [Hro Hpath] hs_hx|[#] Gm_yayc <*> hs_hx] /=; last first. + + by rewrite getP; case: ((ya,yc) = (y1,y2))=> [/#|]. + exists p v; rewrite Hro /=; apply/build_hpath_up=> //. + have /m_mh_of_INV /notin_hs_notin_dom2_mh H:= HINV. + exact/H/Sch_notin_dom_hs/Hhs. + + move=> p ya b; have /mh_of_INV [] _ -> _ := HINV. + apply/exists_iff=> v /=; apply/exists_iff=> hx /=; apply/exists_iff=> hy /=. + have mh_y1Sch: mh.[(y1,ch + 1)] = None. + + by apply/(notin_hs_notin_dom2_mh hs Pm)/Sch_notin_dom_hs; case: HINV. + have Sch_notin_rng2_mh: forall a h a', mh.[(a,h)] <> Some (a',ch + 1). + + move=> a h a'; rewrite -negP; have /m_mh_of_INV [] _ Hmh_m /Hmh_m {Hmh_m} := HINV. + by move=> [yc fy xc fx] [#] _; rewrite Sch_notin_dom_hs; case: HINV. + split=> -[#]. + + move=> Hpath mh_vxahx; rewrite getP; case: ((v +^ ya,hx) = (y1,ch + 1))=> [/#|_]. + by rewrite mh_vxahx //=; apply/build_hpath_up=> //=; rewrite mh_y1ch. + have H /H {H}:= build_hpath_down mh y1 (ch + 1) x1 ch p v hx _. + + move=> p0 v0; rewrite -negP=> /build_hpathP [<*>|]. + + by have /hs_of_INV [] _ + H - /H {H} /# := HINV. + by move=> p' b' v' h' <*>; rewrite Sch_notin_rng2_mh. + move=> ^ /build_hpathP + -> /=; rewrite getP. + by case=> [<*>|/#]; move: HINV=> /hs_of_INV [] _ + H - /H {H} /#. + move=> p v p' v' hx. + have: (forall p v, build_hpath mh p <> Some (v,ch + 1)). + + move=> p0 v0; rewrite -negP=> /build_hpathP [<*>|]. + + by have /hs_of_INV [] _ + H - /H {H} /# := HINV. + move=> p'0 b'0 v'0 h'0 <*> _; have /m_mh_of_INV [] _ H /H {H} := HINV. + by move=> [xc fx yc fy] [#] _; have /hs_of_INV [] _ _ H /H {H} /#:= HINV. + move=> ^ + /build_hpath_down H /H {H} - /build_hpath_down H + /H {H}. + by have /mh_of_INV [] _ _ /(_ p v p' v' hx) := HINV. +split=> c p v; have ^/hs_of_INV [] _ _ dom_hs /pi_of_INV [] -> := HINV. +apply/exists_iff=> h /=; split=> [#]. ++ move=> /(build_hpath_up mh y1 (ch + 1) x1 ch p v h) /(_ _). + + by apply/(notin_hs_notin_dom2_mh hs Pm)/Sch_notin_dom_hs; case: HINV. + by move=> -> /= ^ /dom_hs; rewrite !getP /#. +have ch_notin_rng2_mh: forall a h a', mh.[(a,h)] <> Some (a',ch). ++ move=> a h' a'; rewrite -negP; have /m_mh_of_INV [] _ Hmh_m /Hmh_m {Hmh_m} := HINV. + by move=> [xc fx yc fy] [#] _; rewrite ch_notin_dom_hs; case: HINV. +have Sch_notin_rng2_mh: forall a h a', mh.[(a,h)] <> Some (a',ch + 1). ++ move=> a h' a'; rewrite -negP; have /m_mh_of_INV [] _ Hmh_m /Hmh_m {Hmh_m} := HINV. + by move=> [xc fx yc fy] [#] _; rewrite Sch_notin_dom_hs; case: HINV. +have H /H {H}:= build_hpath_down mh y1 (ch + 1) x1 ch p v h _. ++ move=> p0 v0; rewrite -negP=> /build_hpathP [<*>|]. + + by have /hs_of_INV [] _ + H - /H {H} /# := HINV. + by move=> p' b' v' h' <*>; rewrite Sch_notin_rng2_mh. +move=> ^ /build_hpathP + -> /=; rewrite !getP. +by case=> [<*>|/#]; move: HINV=> /hs_of_INV [] _ + H - /H {H} /#. +qed. + lemma lemma2 hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi x1 x2 y1 y2 hx: INV_CF_G1 hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi => PFm.[(x1,x2)] = None @@ -784,6 +884,97 @@ move=> p' b' v' h' <*> _; have /m_mh_of_INV [] _ H /H {H}:= HINV. by move=> [xc fx yc fy] [#] _; have /hs_of_INV [] _ _ H /H {H}:= HINV. qed. +lemma lemma2' hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi x1 x2 y1 y2 hx: + INV_CF_G1 hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi + => PFmi.[(x1,x2)] = None + => G1mi.[(x1,x2)] = None + => hs.[hx] = Some (x2,Known) + => (forall f h, hs.[h] <> Some (y2,f)) + => INV_CF_G1 hs.[ch <- (y2,Known)] (ch + 1) + PFm.[(y1,y2) <- (x1,x2)] PFmi.[(x1,x2) <- (y1,y2)] + G1m.[(y1,y2) <- (x1,x2)] G1mi.[(x1,x2) <- (y1,y2)] + G1mh.[(y1,ch) <- (x1,hx)] G1mhi.[(x1,hx) <- (y1,ch)] + ro pi. +proof. +move=> HINV PFmi_x1x2 G1mi_x1x2 hs_hx y2_notin_rng1_hs. +split. ++ by apply/hs_addh=> //=; case: HINV. ++ apply/inv_addm; 1:by case: HINV. + + have ^ /m_mh_of_INV Hm_mh /hs_of_INV Hhs := HINV. + by apply/(ch_notin_dom2_mh _ _ Hm_mh Hhs). + have ^ /mi_mhi_of_INV Hm_mh /hs_of_INV Hhs := HINV. + by apply/(notin_m_notin_mh _ _ _ _ Hm_mh PFmi_x1x2 hs_hx). ++ have ^ /hs_of_INV ^ Hhs [] Hhuniq _ _ /m_mh_of_INV := HINV. + move=> /mi_mhi_addh_addmi /(_ hx x1 x2 ch y1 y2 Known _ hs_hx _) //. + exact/ch_notin_dom_hs. ++ have ^ /hs_of_INV ^ Hhs [] Hhuniq _ _ /mi_mhi_of_INV := HINV. + move=> /m_mh_addh_addm /(_ hx x1 x2 ch y1 y2 Known _ hs_hx _) //. + exact/ch_notin_dom_hs. ++ by have /incl_of_INV/incl_addm ->:= HINV. ++ by have /incli_of_INV/incl_addm ->:= HINV. ++ split. + + move=> ya' hy' xa' hx'; rewrite getP; case: ((ya',hy') = (y1,ch))=> [[#] <*>> [#] <<*> /=|]. + + exists y2 Known x2 Known=> //=; rewrite !getP /=. + by have /hs_of_INV [] _ _ dom_hs /#:= HINV. + move=> yahy'_neq_y1ch; have /mh_of_INV [] Hmh _ _ /Hmh {Hmh} := HINV. + move=> [yc fy xc] [] /= [#] hs_hy' hs_hx'=> [[p v] [#] Hro Hpath|Gm_ya'yc <*>]. + + exists yc fy xc Unknown => /=; rewrite !getP hs_hx' hs_hy'. + rewrite (dom_hs_neq_ch hs yc fy _ hs_hy') /=; 1:by case: HINV. + rewrite (dom_hs_neq_ch hs xc Unknown _ hs_hx')/= ; 1:by case: HINV. + exists p v; rewrite Hro /=; apply/build_hpath_up=> //. + case: {-1}(G1mh.[(y1,ch)]) (eq_refl G1mh.[(y1,ch)])=> [//|[za zc]]. + have /m_mh_of_INV [] _ H /H {H} [? ? ? ?] [#]:= HINV. + by have /hs_of_INV [] _ _ H /H {H} := HINV. + exists yc Known xc Known=> //=; rewrite !getP; case: ((ya',yc) = (y1,y2))=> [/#|]. + rewrite Gm_ya'yc /= (dom_hs_neq_ch hs yc Known _ hs_hy') /=; 1:by case: HINV. + by rewrite (dom_hs_neq_ch hs xc Known _ hs_hx')/= ; 1:by case: HINV. + + move=> p ya b; have /mh_of_INV [] _ -> _ := HINV. + apply/exists_iff=> v /=; apply/exists_iff=> hx' /=; apply/exists_iff=> hy' /=. + split=> [#]. + + admit. + have no_path_to_ch: forall p0 v0, build_hpath G1mh p0 <> Some (v0,ch). + + move=> p0 v0; elim/last_ind: p0. + + by have /hs_of_INV [] /# := HINV. + move=> p0 b0 _; rewrite build_hpath_prefix. + apply/negb_exists=> b' /=; apply/negb_exists=> h' /=; apply/negb_and=> /=; right. + rewrite -negP; have /mh_of_INV [] H _ _ /H {H} [? ? ? ?] [#] _ := HINV. + by have /hs_of_INV [] _ _ H /H {H} := HINV. + have H /H {H} := build_hpath_down G1mh y1 ch x1 hx p v hx' no_path_to_ch. + rewrite getP. case: ((v +^ ya,hx') = (y1,ch))=> [[#] <*>|_ Hpath Hextend //=]. + by rewrite no_path_to_ch. + move=> p v p' v' h0. + have: forall p0 v0, build_hpath G1mh p0 <> Some (v0,ch). + + move=> p0 v0; elim/last_ind: p0. + + by have /hs_of_INV [] /# := HINV. + move=> p0 b0 _; rewrite build_hpath_prefix. + apply/negb_exists=> b' /=; apply/negb_exists=> h' /=; apply/negb_and=> /=; right. + rewrite -negP; have /mh_of_INV [] H _ _ /H {H} [? ? ? ?] [#] _ := HINV. + by have /hs_of_INV [] _ _ H /H {H} := HINV. + move=> ^ + /build_hpath_down H /H {H} - /build_hpath_down H + /H {H}. + by have /mh_of_INV [] _ _ /(_ p v p' v' h0):= HINV. +split=> c p v; have /pi_of_INV [] -> := HINV. +apply/exists_iff=> h /=; split=> [#]. ++ move=> /build_hpath_up /(_ y1 ch x1 hx _). + + have ^ /m_mh_of_INV [] _ H /hs_of_INV [] _ _ H' := HINV. + case: {-1}(G1mh.[(y1,ch)]) (eq_refl (G1mh.[(y1,ch)]))=> [//|]. + by move=> [za zc] /H [? ? ? ?] [#] /H'. + move=> -> /=; rewrite getP. + by have /hs_of_INV [] _ _ dom_hs ^ + /dom_hs /#:= HINV. +have no_path_to_ch: forall p0 v0, build_hpath G1mh p0 <> Some (v0,ch). ++ move=> p0 v0; elim/last_ind: p0. + + by have /hs_of_INV [] /# := HINV. + move=> p0 b0 _; rewrite build_hpath_prefix. + apply/negb_exists=> b' /=; apply/negb_exists=> h' /=; apply/negb_and=> /=; right. + rewrite -negP; have /mh_of_INV [] H _ _ /H {H} [? ? ? ?] [#] _ := HINV. + by have /hs_of_INV [] _ _ H /H {H} := HINV. +have H /H {H} := build_hpath_down G1mh y1 ch x1 hx p v h no_path_to_ch. +move=> ^ Hpath -> /=; rewrite getP; case: (h = ch)=> [<*> /= [#] <*>|//=]. +move: Hpath=> /build_hpathP [<*>|]. ++ by have /hs_of_INV [] _ + H - /H {H}:= HINV. +move=> p' b' v' h' <*> _; have /m_mh_of_INV [] _ H /H {H}:= HINV. +by move=> [xc fx yc fy] [#] _; have /hs_of_INV [] _ _ H /H {H}:= HINV. +qed. + lemma lemma3 hs ch Pm Pmi Gm Gmi mh mhi ro pi xa xc hx ya yc hy p b: INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi => Pm.[(xa,xc)] = Some (ya,yc) @@ -900,6 +1091,84 @@ qed. (* we should do a lemma to have the equivalence *) +equiv eq_fi (D <: DISTINGUISHER {PF, RO, G1}): PF.fi ~ G1(D).S.fi: + !G1.bcol{2} + /\ !G1.bext{2} + /\ ={x} + /\ INV_CF_G1 FRO.m{2} G1.chandle{2} + PF.m{1} PF.mi{1} + G1.m{2} G1.mi{2} + G1.mh{2} G1.mhi{2} + F.RO.m{2} G1.paths{2} + ==> !G1.bcol{2} + => !G1.bext{2} + => ={res} + /\ INV_CF_G1 FRO.m{2} G1.chandle{2} + PF.m{1} PF.mi{1} + G1.m{2} G1.mi{2} + G1.mh{2} G1.mhi{2} + F.RO.m{2} G1.paths{2}. +proof. +exists* FRO.m{2}, G1.chandle{2}, PF.m{1}, PF.mi{1}, + G1.m{2}, G1.mi{2}, G1.mh{2}, G1.mhi{2}, + F.RO.m{2}, G1.paths{2}, x{2}. +elim* => hs ch Pm Pmi Gm Gmi mh mhi ro pi [xa xc]. +case @[ambient]: + {-1}(INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi) + (eq_refl (INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi)); last first. ++ by move=> inv0; exfalso=> ? ? [#] <<*>; rewrite inv0. +move=> /eqT inv0; proc. +case @[ambient]: {-1}(Pmi.[(xa,xc)]) (eq_refl Pmi.[(xa,xc)])=> [Pmi_xaxc|[ya yc] Pmi_xaxc]. ++ have /incli_of_INV /(_ (xa,xc)) := inv0; rewrite Pmi_xaxc /=. + case: {-1}(Gmi.[(xa,xc)]) (eq_refl Gmi.[(xa,xc)])=> //= Gmi_xaxc. + rcondt{1} 1; 1:by auto=> &hr [#] <<*>; rewrite in_dom Pmi_xaxc. + rcondt{2} 1; 1:by auto=> &hr [#] <<*>; rewrite in_dom Gmi_xaxc. + case @[ambient]: {-1}(getflag hs xc) (eq_refl (getflag hs xc)). + + move=> /getflagP_none xc_notin_rng1_hs. + rcondt{2} 2. + + auto=> &hr [#] <<*> _ _ _; rewrite in_rng negb_exists=> h /=. + by rewrite xc_notin_rng1_hs. + rcondf{2} 8. + + auto=> &hr [#] !<<- _ _ ->> _ /= _ _ _ _. + rewrite negb_and in_dom; left. + rewrite (@huniq_hinvK_h ch) 3:oget_some /=. + + by apply/huniq_addh=> //; have /hs_of_INV [] := inv0. + + by rewrite getP. + apply/(@notin_m_notin_mh hs.[ch <- (xc,Known)] Pmi _ _ xc ch Known)=> //. + + by apply/m_mh_addh=> //; case: inv0. + by rewrite getP. + auto=> ? ? [#] !<<- -> -> ->> _ /= ya -> /= yc -> /=. + case: (hinvP (hs.[ch <- (xc,Known)]) yc)=> [_|-> //] yc_notin_rng1_hs_addh _ _. + rewrite getP /= oget_some /= -addzA /=. + rewrite(@huniq_hinvK_h ch) 3:oget_some /=. + + by apply/huniq_addh=> //; have /hs_of_INV [] := inv0. + + by rewrite getP. + apply/(@lemma1' hs ch Pm Pmi Gm Gmi mh mhi ro pi xa xc ya yc inv0 _ Pmi_xaxc Gmi_xaxc)=> //. + + rewrite -negP=> <*>; move: yc_notin_rng1_hs_addh => /=. + apply/negb_forall=> /=; exists ch; apply/negb_forall=> /=; exists Known. + by rewrite getP. + + move=> f h; move: (yc_notin_rng1_hs_addh h f); rewrite getP. + case: (h = ch)=> <*> //= _; rewrite -negP. + by have /hs_of_INV [] _ _ H /H {H} := inv0. + have /hs_of_INV [] Hhuniq _ _ [] /(getflagP_some _ _ _ Hhuniq):= inv0. + + move=> x2_is_U; conseq (_: _ ==> G1.bext{2})=> //. + by auto=> ? ? [#] !<<- _ -> ->> _ /=; rewrite x2_is_U. + move=> ^x2_is_K; rewrite in_rng=> -[hx2] hs_hx2. + rcondf{2} 2; 1:by auto=> &hr [#] <*> /=; rewrite x2_is_K. + rcondf{2} 6. + + auto=> &hr [#] !<<- _ _ ->> _. + rewrite (@huniq_hinvK_h hx2) // oget_some /= => _ _ _ _. + rewrite negb_and in_dom /=; left. + by apply/(@notin_m_notin_mh hs Pmi _ _ xc _ Known)=> //; case: inv0. + auto=> ? ? [#] !<<- -> -> ->> _. + rewrite (@huniq_hinvK_h hx2) // oget_some /= => y1 -> /= y2 -> /=. + case: (hinvP hs y2)=> [_ y2_notin_rng1_hs _ _|/#]. + rewrite getP /= oget_some /=. + by apply/lemma2'=> // f h; exact/y2_notin_rng1_hs. +rcondf{1} 1; 1:by auto=> &hr [#] <<*>; rewrite in_dom Pmi_xaxc. +admit. (* more things *) +qed. + section AUX. declare module D : DISTINGUISHER {PF, RO, G1}. @@ -1212,7 +1481,7 @@ section AUX. smt (Block.DWord.bdistr_uf Capacity.DWord.cdistr_uf). (** proofs for G1.S.fi *) (* equiv PF.P.fi G1.S.fi *) - + admit. + + by conseq (eq_fi D)=> /#. (* lossless PF.P.fi *) + move=> &2 _; proc; if=> //=; wp; rnd predT; rnd predT; auto. smt (Block.DWord.bdistr_uf Capacity.DWord.cdistr_uf). From 7559df866f17b83dab6e8d17b9681369aefef7a7 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Fri, 26 Aug 2016 13:03:52 +0200 Subject: [PATCH 216/525] some progress --- proof/Common.ec | 2 +- proof/core/Handle.eca | 147 +++++++++++++++++++++++++----------------- 2 files changed, 90 insertions(+), 59 deletions(-) diff --git a/proof/Common.ec b/proof/Common.ec index 9425328..35a95ef 100644 --- a/proof/Common.ec +++ b/proof/Common.ec @@ -77,7 +77,7 @@ by rewrite /bits2blocks /chunk sz_xs_eq_r divzz ltr0_neq0 1:gt0_r b2i1 mkseq1 /= drop0 -sz_xs_eq_r take_size. qed. -lemma b0 : b0 = mkblock (nseq r false). +lemma b0P : b0 = mkblock (nseq r false). proof. rewrite blockP=> i ge0_i_ltr; rewrite offunifE ge0_i_ltr /= getE ge0_i_ltr /=. rewrite ofblockK 1:size_nseq 1:/#. diff --git a/proof/core/Handle.eca b/proof/core/Handle.eca index 2e399aa..54d49c6 100644 --- a/proof/core/Handle.eca +++ b/proof/core/Handle.eca @@ -1063,6 +1063,26 @@ lemma build_hpath_None (G1mh:hsmap) p: foldl (step_hpath G1mh) None p = None. proof. by elim:p. qed. +lemma build_hpath_upd_ch ha ch mh xa ya p v hx: + 0 <> ch => ha <> ch => (forall xa xb ha hb, mh.[(xa,ha)] = Some(xb, hb) => ha <> ch /\ hb <> ch) => + build_hpath mh.[(xa, ha) <- (ya, ch)] p = Some (v, hx) => + if hx = ch then + (exists p0 x, build_hpath mh p0 = Some (x, ha) /\ p = rcons p0 (x +^ xa) /\ v = ya) + else + build_hpath mh p = Some (v, hx). +proof. + move=> Hch0 Hha Hch. + elim/last_ind: p v hx=> /=. + + by move=> v hx;rewrite /build_hpath /= => -[!<<-];rewrite Hch0. + move=> p x Hrec v hx /build_hpath_prefix [v' h' [/Hrec{Hrec}]]. + rewrite getP /=;case (h' = ch) => [->> | ]. + + by rewrite (@eq_sym ch) Hha /= => _ /Hch. + case (v' +^ x = xa && h' = ha) => [[!<<-] /= ?? [!->>] /=| ]. + + by exists p v';rewrite xorwA xorwK xorwC xorw0. + case (hx = ch)=> [->> _ _ _ /Hch //|??? Hbu Hg]. + by rewrite build_hpath_prefix;exists v' h'. +qed. + lemma build_hpath_up_None (G1mh:hsmap) bi1 bi2 bi p: G1mh.[bi1] = None => build_hpath G1mh p = Some bi => @@ -1076,6 +1096,7 @@ proof. by rewrite Hbi1 build_hpath_None. qed. +(* lemma build_hpath_down_None h ch mh xa ha ya a p: h <> ch => ha <> ch => (forall ya, mh.[(ya,ch)] = None) => @@ -1088,7 +1109,27 @@ proof. move=> {Hrec};case: p=> /= [[_ ->>]| b' p];1: by move:Hh. by rewrite {2}/step_hpath /= oget_some /= getP_neq /= ?Hha // Hmh build_hpath_None. qed. +*) + +lemma build_hpath_upd_ch_iff ha ch mh xa ya p v hx: + mh.[(xa,ha)] = None => + 0 <> ch => ha <> ch => (forall xa xb ha hb, mh.[(xa,ha)] = Some(xb, hb) => ha <> ch /\ hb <> ch) => + build_hpath mh.[(xa, ha) <- (ya, ch)] p = Some (v, hx) <=> + if hx = ch then + (exists p0 x, build_hpath mh p0 = Some (x, ha) /\ p = rcons p0 (x +^ xa) /\ v = ya) + else + build_hpath mh p = Some (v, hx). +proof. + move=> Ha Hch0 Hha Hch;split;1: by apply build_hpath_upd_ch. + case (hx = ch);2: by move=> ?;apply build_hpath_up_None. + move=> ->> [p0 x [? [!->>]]]. + rewrite build_hpath_prefix;exists x ha. + by rewrite xorwA xorwK xorwC xorw0 getP_eq /=;apply build_hpath_up_None. +qed. + + + (* we should do a lemma to have the equivalence *) equiv eq_fi (D <: DISTINGUISHER {PF, RO, G1}): PF.fi ~ G1(D).S.fi: @@ -1351,10 +1392,18 @@ section AUX. rewrite !getP_eq pi_x2 !oget_some /=. have /hs_of_INV [] Hu _ _:= inv0; have -> := huniq_hinvK_h _ _ _ Hu hs_hx2. rewrite oget_some -!nor => /= -[] ? Hy2L [*]. - case:inv0=> Hhs Hinv Hmmh Hmmhi Hincl Hincli Hmh Hpi; apply HCF_G1. + case:inv0=> Hhs Hinv Hmmh Hmmhi Hincl Hincli Hmh Hpi. + have Hhx2:= dom_hs_neq_ch _ _ _ _ _ Hhs hs_hx2. + have mh_hx2: G1mh.[(x1,hx2)] = None. + + case Hmmh => _ /(_ x1 hx2);case (G1mh.[(x1, hx2)]) => // -[ya hy] /(_ ya hy) /=. + by rewrite -negP=> -[xc fx yc fy];rewrite hs_hx2 => -[[!<<-]];rewrite PFm_x1x2. + have ch_0 := ch_neq0 _ _ Hhs. + have ch_None : forall xa xb ha hb, G1mh.[(xa,ha)] = Some(xb, hb) => ha <> ch0 /\ hb <> ch0. + + move=> xa xb ha hb;case Hmmh=> _ H /H [xc fx yc fy [#]]. + by move=> /(dom_hs_neq_ch _ _ _ _ _ Hhs) -> /(dom_hs_neq_ch _ _ _ _ _ Hhs). + split. + by apply hs_addh => //;have /# := hinvP hs0 y2L. - + apply inv_addm=>//;first by move: hs_hx2 PFm_x1x2;apply: m_mh_None. - by apply (ch_notin_dom2_mh _ _ Hmmhi Hhs). + + by apply inv_addm=>//; apply (ch_notin_dom2_mh _ _ Hmmhi Hhs). + by apply (m_mh_addh_addm _ Hmmh _ hs_hx2)=>//;apply ch_notin_dom_hs. + apply (mi_mhi_addh_addmi _ Hmmhi _ hs_hx2);last by apply ch_notin_dom_hs. by have := hinvP hs0 y2L;rewrite Hy2L /#. @@ -1363,7 +1412,7 @@ section AUX. + move=> xa hx ya hy;rewrite getP;case ((xa, hx) = (x1, hx2))=> /=. + move=> [] !-> [] !<-; exists x2 Known y2L Known. by rewrite !getP_eq /= getP_neq // eq_sym; apply (dom_hs_neq_ch _ _ _ Hhs hs_hx2). - move=> Hdiff Hxa; case Hmh=> /(_ _ _ _ _ Hxa) [] xc fx yc fy [#] Hhx Hhy HG1 _. + move=> Hdiff Hxa; case Hmh=> /(_ _ _ _ _ Hxa) [] xc fx yc fy [#] Hhx Hhy HG1 _ _. exists xc fx yc fy;rewrite !getP_neq //. + by rewrite eq_sym;apply (dom_hs_neq_ch _ _ _ Hhs Hhx). + by rewrite eq_sym;apply (dom_hs_neq_ch _ _ _ Hhs Hhy). @@ -1376,65 +1425,47 @@ section AUX. move: Hbu;rewrite Hpath /= => -[!<<-] /=. by rewrite -negP=> /Block.WRing.addrI /#. by apply build_hpath_up=> //; move: hs_hx2 PFm_x1x2;apply: m_mh_None. - move=> p bn b; rewrite getP. - case (rcons p bn = rcons p0 (v0 +^ x1)). - + move=> ^ /rconssI <<- /rconsIs ->> /=; split => [<<- | ]. - + exists v0 hx2 ch0. - rewrite (build_hpath_up Hpath) /=;1:by move: hs_hx2 PFm_x1x2;apply: m_mh_None. - by rewrite xorwA xorwK Block.WRing.add0r getP_eq. - move=> [v hx hy] [];rewrite getP ;case ((v +^ (v0 +^ x1), hx) = (x1, hx2)) => //. - move=> Hdiff;have HG1 := m_mh_None _ _ _ _ _ _ _ Hmmh hs_hx2 PFm_x1x2. - have -> /= [->> <<-]:= build_hpath_up_None _ _ (y1L, ch0) _ _ HG1 Hpath. - by move:Hdiff;rewrite xorwA xorwK Block.WRing.add0r. - move=> Hdiff; case Hmh => _ ->. - apply exists_iff=> v /= ;apply exists_iff => hx /=;apply exists_iff => hy /=;split. - + move=> [Hp Hhx]. - have HG1 := m_mh_None _ _ _ _ _ _ _ Hmmh hs_hx2 PFm_x1x2. - have -> /= := build_hpath_up_None _ _ (y1L, ch0) _ _ HG1 Hp. - by rewrite getP_neq //= -negP => -[->> <<-]; move: Hhx;rewrite HG1. - rewrite getP; case ((v +^ bn, hx) = (x1, hx2))=> /=. - + move=> [<<- ->>] [+ [!<<-]]. - have Hhx2:= dom_hs_neq_ch _ _ _ _ _ Hhs hs_hx2. - move=> Hbui;have := build_hpath_down_None _ _ _ _ _ _ _ _ _ _ _ Hbui=> //. - + move=> ya;case Hmmh=> _ /(_ ya ch0);case (G1mh.[(ya, ch0)]) => //. - move=> [ya1 hy1] /(_ ya1 hy1) /=;rewrite -negP => -[xc fx yc fy [#] Hch]. - by have := dom_hs_neq_ch _ _ _ _ _ Hhs Hch. - move=>{Hbui} Hbui; have : pi0.[x2] = Some (p, v). - + by case: Hpi => ->;exists hx2. - by rewrite pi_x2 /= => -[!->>];move:Hdiff; rewrite xorwA xorwK Block.WRing.add0r. - move=> _ [+ ^ H ->] /=. apply build_hpath_down_None. - + case: Hmmh => _ /(_ _ _ _ _ H) [xc fx yc fy [#] Hch] _ _. - by apply (dom_hs_neq_ch _ _ _ Hhs Hch). - + by apply (dom_hs_neq_ch _ _ _ Hhs hs_hx2). - move=> ya; case Hmmh=> _ /(_ ya ch0); case (G1mh.[(ya, ch0)])=> //. - move=>[ya1 ha1] /(_ ya1 ha1) [xc fx yc fy [#] Hch]. - by have := dom_hs_neq_ch _ _ _ _ _ Hhs Hch. - split=> c p v;rewrite getP. case (c = y2L) => [->> /= | ?]. + + move=> p bn b; rewrite getP. + case (rcons p bn = rcons p0 (v0 +^ x1)). + + move=> ^ /rconssI <<- /rconsIs ->> /=; split => [<<- | ]. + + exists v0 hx2 ch0. + rewrite (build_hpath_up Hpath) /=;1:by move: hs_hx2 PFm_x1x2;apply: m_mh_None. + by rewrite xorwA xorwK Block.WRing.add0r getP_eq. + move=> [v hx hy] [];rewrite getP ;case ((v +^ (v0 +^ x1), hx) = (x1, hx2)) => //. + move=> Hdiff;have HG1 := m_mh_None _ _ _ _ _ _ _ Hmmh hs_hx2 PFm_x1x2. + have -> /= [->> <<-]:= build_hpath_up_None _ _ (y1L, ch0) _ _ HG1 Hpath. + by move:Hdiff;rewrite xorwA xorwK Block.WRing.add0r. + move=> Hdiff; case Hmh => ? -> Huni. + apply exists_iff=> v /= ;apply exists_iff => hx /=;apply exists_iff => hy /=. + rewrite build_hpath_upd_ch_iff //. + case (hx = ch0) => [->>|?]. + + split;1: by move=> [] _ /ch_None. + move=> [[p0' x [Hhx2']]]. + have [!->>] [!->>]:= Huni _ _ _ _ _ Hpath Hhx2'. + by rewrite getP_neq /= ?Hhx2 // => /ch_None. + rewrite getP;case ((v +^ bn, hx) = (x1, hx2)) => //= -[<<- ->>]. + split=> -[H];have [!->>]:= Huni _ _ _ _ _ Hpath H;move:Hdiff; + by rewrite xorwA xorwK Block.WRing.add0r. + move=> p v p' v' hx;case Hmh => _ _ Huni. + rewrite !build_hpath_upd_ch_iff //. + case (hx = ch0) => [->> [?? [# H1 -> ->]] [?? [# H2 -> ->]]|_ ] /=. + + by have [!->>] := Huni _ _ _ _ _ H1 H2. + by apply Huni. + split=> c p v;rewrite getP. case (c = y2L) => [->> /= | Hc]. + split. + move=> [!<<-];exists ch0;rewrite getP_eq /= build_hpath_prefix. exists v0 hx2;rewrite xorwA xorwK Block.WRing.add0r getP_eq /=. have HG1 := m_mh_None _ _ _ _ _ _ _ Hmmh hs_hx2 PFm_x1x2. by apply build_hpath_up_None. - have Hhx2:= dom_hs_neq_ch _ _ _ _ _ Hhs hs_hx2. - move=> [h []];rewrite getP;case (h=ch0)=> [->> /= | Hh]. - + admit. - move=> Hbui;have := build_hpath_down_None _ _ _ _ _ _ _ _ _ _ _ Hbui=> //. - + move=> ya;case Hmmh=> _ /(_ ya ch0);case (G1mh.[(ya, ch0)]) => //. - move=> [ya1 hy1] /(_ ya1 hy1) /=;rewrite -negP => -[xc fx yc fy [#] Hch]. - by have := dom_hs_neq_ch _ _ _ _ _ Hhs Hch. - by move=> _ Hhsh;have := hinvP hs0 y2L;rewrite Hy2L /= => /(_ h Known);rewrite Hhsh. - case Hpi=> ->;apply exists_iff=> /= h;rewrite getP;case (h = ch0) => [->> /= | Hdiff]. - + split => [|/#]. - by rewrite build_hpathP=> -[_ Hch]; have := dom_hs_neq_ch _ _ _ _ _ Hhs Hch. - split=> -[+ ->] /=. - + have HG1 := m_mh_None _ _ _ _ _ _ _ Hmmh hs_hx2 PFm_x1x2. - by apply build_hpath_up_None. - have Hhx2:= dom_hs_neq_ch _ _ _ _ _ Hhs hs_hx2. - apply build_hpath_down_None=> //. - move=> ya;case Hmmh=> _ /(_ ya ch0);case (G1mh.[(ya, ch0)]) => //. - move=> [ya1 hy1] /(_ ya1 hy1) /=;rewrite -negP => -[xc fx yc fy [#] Hch]. - by have := dom_hs_neq_ch _ _ _ _ _ Hhs Hch. - (* this is the easy case *) + move=> [h []];rewrite getP build_hpath_upd_ch_iff //. + case (h=ch0)=> [->> /= [??[# H1 -> ->]]| Hh] /=. + + by case Hmh => _ _ /(_ _ _ _ _ _ Hpath H1). + by have := hinvP hs0 y2L;rewrite Hy2L /= => ->. + case Hpi => ->;apply exists_iff => h /=. + rewrite build_hpath_upd_ch_iff // getP;case (h = ch0) => [->> | //]. + split;1: by move=> [_ /(dom_hs_neq_ch _ _ _ _ _ Hhs)]. + by move=> /= [_ <<-];move:Hc. + move=> [xa xc] PFm_x1x2. rcondf{1} 1; 1:by auto=> &hr [#] !<<- _ _ ->>; rewrite in_dom PFm_x1x2. have /m_mh_of_INV [] + _ - /(_ _ _ _ _ PFm_x1x2) := inv0. move=> [hx2 fx2 hy2 fy2] [#] hs_hx2 hs_hy2 G1mh_x1hx2. From 1960c2a4274ea3569a83a40ee7ccdb60cba51e6b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Fri, 26 Aug 2016 12:32:12 +0100 Subject: [PATCH 217/525] Finishing proof for inverse queries. Had to add a component to the invariant, but I'm not updating the rest of the proof to avoid conflicts with Benjamin at this stage. --- proof/core/Handle.eca | 84 ++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 83 insertions(+), 1 deletion(-) diff --git a/proof/core/Handle.eca b/proof/core/Handle.eca index 54d49c6..3a683d8 100644 --- a/proof/core/Handle.eca +++ b/proof/core/Handle.eca @@ -222,6 +222,7 @@ inductive inv_spec (m:('a,'b) fmap) mi = inductive INV_CF_G1 (hs : handles) ch (Pm Pmi Gm Gmi : smap) (mh mhi : hsmap) (ro : (block list,block) fmap) pi = | HCF_G1 of (hs_spec hs ch) + & (inv_spec Gm Gmi) & (inv_spec mh mhi) & (m_mh hs Pm mh) & (m_mh hs Pmi mhi) @@ -297,6 +298,11 @@ lemma inv_of_INV hs ch m1 mi1 m2 mi2 ro pi inv_spec mh2 mhi2. proof. by case. qed. +lemma invG_of_INV hs ch m1 mi1 mh2 mhi2 ro pi m2 mi2: + INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi => + inv_spec m2 mi2. +proof. by case. qed. + (** Useful Lemmas **) lemma ch_gt0 hs ch : hs_spec hs ch => 0 < ch. proof. by case=> _ + Hlt -/Hlt. qed. @@ -451,6 +457,40 @@ move: yahy0_neq_yahy; case: (ya0 = ya)=> [<<*> //=|/#]; case: (yc0 = yc)=> [<*>> by move: hs_hy0; rewrite yc_notin_rng1_hs. qed. +(** Inversion **) +lemma inv_mh_inv_Pm hs Pm Pmi mh mhi: + m_mh hs Pm mh + => m_mh hs Pmi mhi + => inv_spec mh mhi + => inv_spec Pm Pmi. +proof. +move=> Hm_mh Hmi_mhi [] Hinv; split=>- [xa xc] [ya yc]; split. ++ have [] H _ /H {H} [hx fx hy fy] [#] hs_hx hs_hy /Hinv := Hm_mh. + have [] _ H /H {H} [? ? ? ?] [#] := Hmi_mhi. + by rewrite hs_hx hs_hy=> /= [#] <<*> [#] <<*>. +have [] H _ /H {H} [hy fy hx fx] [#] hs_hy hs_hx /Hinv := Hmi_mhi. +have [] _ H /H {H} [? ? ? ?] [#] := Hm_mh. +by rewrite hs_hx hs_hy=> /= [#] <<*> [#] <<*>. +qed. + +lemma inv_incl_none Pm Pmi Gm (x : 'a) Gmi (y : 'b): + inv_spec Pm Pmi + => inv_spec Gm Gmi + => incl Gm Pm + => incl Gmi Pmi + => Pm.[x] = Some y + => (Gm.[x] = None <=> Gmi.[y] = None). +proof. +move=> [] invP [] invG Gm_leq_Pm Gmi_leq_Pmi ^P_x; rewrite invP=> Pi_y. +split=> [G_x | Gi_y]. ++ case: {-1}(Gmi.[y]) (eq_refl Gmi.[y])=> [//|x']. + move=> ^Gmi_y; rewrite -Gmi_leq_Pmi 1:Gmi_y// Pi_y /= -negP=> <<*>. + by move: Gmi_y; rewrite -invG G_x. +case: {-1}(Gm.[x]) (eq_refl Gm.[x])=> [//|y']. +move=> ^Gm_y; rewrite -Gm_leq_Pm 1:Gm_y// P_x /= -negP=> <<*>. +by move: Gm_y; rewrite invG Gi_y. +qed. + (** Preservation of hs_spec **) lemma huniq_addh hs h c f: huniq hs @@ -641,6 +681,11 @@ move=> HINV x2_neq_y2 Pm_x Gm_x x2_notin_rng1_hs y2_notin_rng1_hs; split. + rewrite (@addzA ch 1 1); apply/hs_addh. + by move: HINV=> /hs_of_INV/hs_addh=> ->. by move=> f h; rewrite getP; case: (h = ch)=> [/#|_]; exact/y2_notin_rng1_hs. ++ apply/inv_addm=> //; 1:by case: HINV. + case: {-1}(Gmi.[(y1,y2)]) (eq_refl Gmi.[(y1,y2)])=> [//|[xa xc]]. + + have /incli_of_INV @/incl + ^h - <- := HINV; 1: by rewrite h. + have /mi_mhi_of_INV [] H _ /H {H} [hx fx hy fy] [#] := HINV. + by rewrite y2_notin_rng1_hs. + apply/inv_addm; 1:by case: HINV. + have ^ /m_mh_of_INV Hm_mh /hs_of_INV Hhs := HINV. by apply/(ch_notin_dom2_mh _ _ Hm_mh Hhs). @@ -731,6 +776,11 @@ move=> HINV x2_neq_y2 Pm_x Gm_x xc_notin_rng1_hs yc_notin_rng1_hs; split. + rewrite (@addzA ch 1 1); apply/hs_addh. + by move: HINV=> /hs_of_INV/hs_addh=> ->. by move=> f h; rewrite getP; case: (h = ch)=> [/#|_]; exact/yc_notin_rng1_hs. ++ apply/inv_addm=> //; 1:by case: HINV. + case: {-1}(Gm.[(y1,y2)]) (eq_refl Gm.[(y1,y2)])=> [//|[xa xc]]. + + have /incl_of_INV + ^h - <- := HINV; 1: by rewrite h. + have /m_mh_of_INV [] H _ /H {H} [hx fx hy fy] [#] := HINV. + by rewrite yc_notin_rng1_hs. + apply/inv_addm; 1:by case: HINV. + have ^ /m_mh_of_INV Hm_mh /hs_of_INV Hhs := HINV. by apply/(Sch_notin_dom2_mh _ _ Hm_mh Hhs). @@ -818,6 +868,11 @@ proof. move=> HINV PFm_x1x2 G1m_x1x2 pi_x2 hs_hx y2_notin_rng1_hs. split. + by apply/hs_addh=> //=; case: HINV. ++ apply/inv_addm=> //; 1:by case: HINV. + case: {-1}(G1mi.[(y1,y2)]) (eq_refl G1mi.[(y1,y2)])=> [//|[xa xc]]. + + have /incli_of_INV @/incl + ^h - <- := HINV; 1: by rewrite h. + have /mi_mhi_of_INV [] H _ /H {H} [hx' fx' hy' fy'] [#] := HINV. + by rewrite y2_notin_rng1_hs. + apply/inv_addm; 1:by case: HINV. + have ^ /m_mh_of_INV Hm_mh /hs_of_INV Hhs := HINV. by apply/(notin_m_notin_mh _ _ _ _ Hm_mh PFm_x1x2 hs_hx). @@ -899,6 +954,11 @@ proof. move=> HINV PFmi_x1x2 G1mi_x1x2 hs_hx y2_notin_rng1_hs. split. + by apply/hs_addh=> //=; case: HINV. ++ apply/inv_addm=> //; 1:by case: HINV. + case: {-1}(G1m.[(y1,y2)]) (eq_refl G1m.[(y1,y2)])=> [//|[xa xc]]. + + have /incl_of_INV + ^h - <- := HINV; 1: by rewrite h. + have /m_mh_of_INV [] H _ /H {H} [hx' fx' hy' fy'] [#] := HINV. + by rewrite y2_notin_rng1_hs. + apply/inv_addm; 1:by case: HINV. + have ^ /m_mh_of_INV Hm_mh /hs_of_INV Hhs := HINV. by apply/(ch_notin_dom2_mh _ _ Hm_mh Hhs). @@ -993,6 +1053,13 @@ move=> HINV Pm_xaxc Gm_xaxc mh_xahx hs_hx hs_hy pi_xc. split. + have /hs_of_INV /hs_updh /(_ Unknown) H := HINV; apply/H=> {H} //. by rewrite -negP=> <*>; move: hs_hy; have /hs_of_INV [] _ -> := HINV. ++ apply/inv_addm=> //; 1:by case: HINV. + case: {-1}(Gmi.[(ya,yc)]) (eq_refl Gmi.[(ya,yc)])=> [//|[xa' xc']]. + have /incli_of_INV + ^h - <- := HINV; 1:by rewrite h. + move: Pm_xaxc; have [] -> -> /= := inv_mh_inv_Pm hs Pm Pmi mh mhi _ _ _; first 3 by case: HINV. + rewrite anda_and -negP=> [#] <<*>. + move: h; have /invG_of_INV [] <- := HINV. + by rewrite Gm_xaxc. + by case: HINV. + by apply/(m_mh_updh Unknown)=> //; case: HINV. + by apply/(m_mh_updh Unknown)=> //; case: HINV. @@ -1207,7 +1274,22 @@ case @[ambient]: {-1}(Pmi.[(xa,xc)]) (eq_refl Pmi.[(xa,xc)])=> [Pmi_xaxc|[ya yc] rewrite getP /= oget_some /=. by apply/lemma2'=> // f h; exact/y2_notin_rng1_hs. rcondf{1} 1; 1:by auto=> &hr [#] <<*>; rewrite in_dom Pmi_xaxc. -admit. (* more things *) +case @[ambient]: {-1}(Gmi.[(xa,xc)]) (eq_refl Gmi.[(xa,xc)])=> [|[ya' yc'] ^] Gmi_xaxc. ++ rcondt{2} 1; 1:by auto=> &hr [#] <<*>; rewrite in_dom Gmi_xaxc. + conseq (_: _ ==> G1.bext{2})=> //. + auto=> &1 &2 [#] !<<- _ -> ->> _ />. + rewrite !in_rng; have ->: exists hx, hs.[hx] = Some (xc,Unknown). + + move: Pmi_xaxc; have /mi_mhi_of_INV [] H _ /H {H} := inv0. + move=> [hx fx hy fy] [#] hs_hx hs_hy. + have ^/inv_of_INV [] <- /mh_of_INV [] H _ _ /H {H} := inv0. + move=> [? ? ? ?] [#]; rewrite hs_hx hs_hy=> /= [#] <<*> [#] <<*>. + case: fx hs_hx=> hs_hx /= => [_|[#]]; first by exists hx. + by have /invG_of_INV [] -> := inv0; rewrite Gmi_xaxc. + smt (Block.DWord.bdistr_uf Capacity.DWord.cdistr_uf). +have /incli_of_INV <- := inv0; 1:by rewrite Gmi_xaxc. +rewrite Pmi_xaxc=> /= [#] <<*>. +rcondf{2} 1; 1:by auto=> &hr [#] <<*>; rewrite in_dom Gmi_xaxc. +by auto=> &1 &2 /#. qed. section AUX. From cb6669db8052899a3493c287ffc30a78b2c9cfa3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Fri, 26 Aug 2016 12:51:48 +0100 Subject: [PATCH 218/525] Actually finishing the proof. --- proof/core/Handle.eca | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/proof/core/Handle.eca b/proof/core/Handle.eca index 3a683d8..73249f7 100644 --- a/proof/core/Handle.eca +++ b/proof/core/Handle.eca @@ -991,7 +991,11 @@ split. + move=> p ya b; have /mh_of_INV [] _ -> _ := HINV. apply/exists_iff=> v /=; apply/exists_iff=> hx' /=; apply/exists_iff=> hy' /=. split=> [#]. - + admit. + + move=> /(@build_hpath_up _ y1 ch x1 hx) /(_ _). + + apply/(@notin_hs_notin_dom2_mh hs PFm)/(ch_notin_dom_hs); by case: HINV. + move=> -> /=; rewrite getP /=; case: (hx' = ch)=> <*> //. + have /m_mh_of_INV [] _ H /H {H} [xc fx yc fy] [#] := HINV. + by have /hs_of_INV [] _ _ H /H {H} := HINV. have no_path_to_ch: forall p0 v0, build_hpath G1mh p0 <> Some (v0,ch). + move=> p0 v0; elim/last_ind: p0. + by have /hs_of_INV [] /# := HINV. From 3dc89b29e7702ac1e9c52eb80c48399ce7a7a4d5 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Fri, 26 Aug 2016 07:59:30 -0400 Subject: [PATCH 219/525] The lemma Benjamin renamed was used later on, so made the change there. --- proof/Common.ec | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/proof/Common.ec b/proof/Common.ec index 35a95ef..4ebce78 100644 --- a/proof/Common.ec +++ b/proof/Common.ec @@ -578,7 +578,7 @@ have xs_non_nil : xs <> []. elim (last_drop_all_but_last b0 xs)=> // drop_xs. have xs_take_drop : xs = take (size xs - 1) xs ++ drop (size xs - 1) xs by rewrite cat_take_drop. -rewrite drop_xs last_xs_eq_b0 b0 in xs_take_drop. +rewrite drop_xs last_xs_eq_b0 b0P in xs_take_drop. have last_b2b_xs_true : last true (blocks2bits xs) = true by rewrite b2b_xs_eq cats1 last_rcons. have last_b2b_xs_false : last true (blocks2bits xs) = false From 0e549fb9d5c83ba156f7734ec2b384376b734366 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Fri, 26 Aug 2016 13:31:44 +0100 Subject: [PATCH 220/525] Propagating new invariant through. --- proof/core/Handle.eca | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/proof/core/Handle.eca b/proof/core/Handle.eca index 73249f7..799ff4f 100644 --- a/proof/core/Handle.eca +++ b/proof/core/Handle.eca @@ -1478,7 +1478,7 @@ section AUX. rewrite !getP_eq pi_x2 !oget_some /=. have /hs_of_INV [] Hu _ _:= inv0; have -> := huniq_hinvK_h _ _ _ Hu hs_hx2. rewrite oget_some -!nor => /= -[] ? Hy2L [*]. - case:inv0=> Hhs Hinv Hmmh Hmmhi Hincl Hincli Hmh Hpi. + case:inv0=> Hhs Hinv HinvG Hmmh Hmmhi Hincl Hincli Hmh Hpi. have Hhx2:= dom_hs_neq_ch _ _ _ _ _ Hhs hs_hx2. have mh_hx2: G1mh.[(x1,hx2)] = None. + case Hmmh => _ /(_ x1 hx2);case (G1mh.[(x1, hx2)]) => // -[ya hy] /(_ ya hy) /=. @@ -1489,6 +1489,10 @@ section AUX. by move=> /(dom_hs_neq_ch _ _ _ _ _ Hhs) -> /(dom_hs_neq_ch _ _ _ _ _ Hhs). split. + by apply hs_addh => //;have /# := hinvP hs0 y2L. + + apply inv_addm=> //; case: {-1}(G1mi.[(y1L,y2L)]) (eq_refl G1mi.[(y1L,y2L)])=> //. + move=> [x1L x2L] ^G1mi_y; rewrite -Hincli 1:G1mi_y//. + case: Hmmhi Hy2L => H _ + /H {H} [hx fx hy fy] [#]. + by case: (hinvP hs0 y2L)=> [_ ->|//]. + by apply inv_addm=>//; apply (ch_notin_dom2_mh _ _ Hmmhi Hhs). + by apply (m_mh_addh_addm _ Hmmh _ hs_hx2)=>//;apply ch_notin_dom_hs. + apply (mi_mhi_addh_addmi _ Hmmhi _ hs_hx2);last by apply ch_notin_dom_hs. @@ -1627,6 +1631,7 @@ section AUX. by case: (h1 = 0); case: (h2 = 0)=> //=. + by rewrite getP. + by move=> ? h; rewrite getP map0P; case: (h = 0). + + by move=> ? ?; rewrite !map0P. by move=> ? ?; rewrite !map0P. qed. From 2524e68c7856b9fa263a46cd40ba1eff7db5b478 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Mon, 29 Aug 2016 11:18:40 +0100 Subject: [PATCH 221/525] Starting relation of security of core to security of BlockSponge. BlockSponge is used as assumption in top-level proof. There are some things that need thought about regarding what valid queries are and what we should do on invalid queries. --- proof/IRO.eca | 36 -------- proof/core/CoreToBlockSponge.eca | 144 +++++++++++++++++++++++++++++++ 2 files changed, 144 insertions(+), 36 deletions(-) create mode 100644 proof/core/CoreToBlockSponge.eca diff --git a/proof/IRO.eca b/proof/IRO.eca index e957130..cff25e3 100644 --- a/proof/IRO.eca +++ b/proof/IRO.eca @@ -121,39 +121,3 @@ module IRO' : IRO = { return b; } }. - -(* -another implementation, but probably not useful - -module IRO : IRO = { - var mp : (from, to list) fmap - - proc init() = { mp = map0; } - - proc choose(n) = { - var b, bs; - - bs <- []; - while (0 < n) { - b <$ dto; - bs <- rcons bs b; - n <- n - 1; - } - return bs; - } - - proc f(x, n) = { - var ys, zs, aout; - - aout <- []; - if (valid x) { - ys <- odflt [] mp.[x]; - zs <@ choose (max 0 (n - size ys)); - mp.[x] <- ys ++ zs; - aout <- take n (oget mp.[x]); - } - - return aout; - } -}. -*) diff --git a/proof/core/CoreToBlockSponge.eca b/proof/core/CoreToBlockSponge.eca new file mode 100644 index 0000000..640d086 --- /dev/null +++ b/proof/core/CoreToBlockSponge.eca @@ -0,0 +1,144 @@ +(* -------------------------------------------------------------------- *) +require import Option Pair Int Real Distr List FSet NewFMap DProd. +require import BlockSponge Gconcl. + +(*---*) import Common Perm. + +(* -------------------------------------------------------------------- *) +section PROOF. + declare module D:DISTINGUISHER { Perm, Gconcl.IF, SLCommon.C, Gconcl.S, BIRO.IRO }. + + module Wrap (D : DISTINGUISHER) (F : DFUNCTIONALITY) (P : DPRIMITIVE) = { + module WF = { + proc f(x : block list * int) = { + var r <- []; + var p, n; + + (p,n) <- x; + if (valid_block p /\ 0 < n) { + r <@ F.f(x); + } + return r; + } + } + + proc distinguish = D(WF,P).distinguish + }. + + module LowerF (F:DFUNCTIONALITY) = { + proc f(m:block list) : block = { + var r <- []; + var p, n; + + (p,n) <- strip m; + if (p <> []) { + r <- F.f(p,n); + } + return last b0 r; + } + }. + + module RaiseF (F:SLCommon.DFUNCTIONALITY) = { + proc f(m:block list, n:int) : block list = { + var i, r, b; + r <- []; + + if (m <> []) { + i <- 0; + b <- b0; + while (i < n) { + b <- F.f(extend m i); + r <- rcons r b; + i <- i + 1; + + } + } + return r; + } + }. + + module LowerDist(D : DISTINGUISHER, F : SLCommon.DFUNCTIONALITY) = + D(RaiseF(F)). + + module RaiseSim(S:SLCommon.SIMULATOR, F:DFUNCTIONALITY) = + S(LowerF(F)). + + local equiv f_f: BIRO.IRO.f ~ RaiseF(Gconcl.IF).f: + ={n} /\ x{1} = m{2} + /\ 0 <= n{2} + /\ valid_block x{1} + /\ (forall p n, BIRO.IRO.mp{1}.[(p,n)] <> None => last b0 p <> b0) + /\ (forall p, SLCommon.F.RO.m{2}.[p] = BIRO.IRO.mp{1}.[strip p]) + ==> ={res} + /\ (forall p n, BIRO.IRO.mp{1}.[(p,n)] <> None => last b0 p <> b0) + /\ (forall p, SLCommon.F.RO.m{2}.[p] = BIRO.IRO.mp{1}.[strip p]). + proof. + proc. rcondt{2} 2; 1:by auto=> /#. rcondt{1} 3; 1:by auto=> /#. + inline *. wp. + while ( ={i,n} /\ x{1} = m{2} /\ bs{1} = r{2} + /\ 0 <= i{2} <= n{2} + /\ last b0 x{1} <> b0 + /\ (forall p n, BIRO.IRO.mp{1}.[(p,n)] <> None => last b0 p <> b0) + /\ (forall p, SLCommon.F.RO.m{2}.[p] = BIRO.IRO.mp{1}.[strip p])). + + sp; if{1}. + + rcondt{2} 2. + + auto=> &hr [#] !->> i_ge0 i_lt_n wf hinv1 hinv2 _ _ + _ _. + by rewrite !in_dom /= hinv2 extendK. + auto=> &1 &2 /= [#] !->> i_ge0 _ wf inv1 inv2 i_lt_n _. + rewrite in_dom wf=> mp_xi r -> /=; split; first by rewrite !getP. + split=> [/#|]; split=> [p n|p]. + + by rewrite getP; case: ((p,n) = (m,i){2})=> [[#] <*>|_ /inv1]. + rewrite !getP; case: (strip p = (m,i){2})=> [strip_p|]. + + by have := stripK p; rewrite strip_p=> /= ->. + case: (p = extend m{2} i{2})=> [<*>|_ _]; first by rewrite extendK. + exact/inv2. + rcondf{2} 2. + + auto=> &hr [#] !->> i_ge0 i_lt_n wf hinv1 hinv2 _ _ + _ _. + by rewrite !in_dom /= hinv2 extendK. + by auto=> &1 &2; smt (DWord.bdistr_ll extendK). + by auto; smt (valid_block_ends_not_b0). + qed. + + lemma conclusion &m: + `| Pr[RealIndif(Sponge,Perm,Wrap(D)).main() @ &m : res] + - Pr[IdealIndif(BIRO.IRO,RaiseSim(Gconcl.S),Wrap(D)).main() @ &m : res] | + = `| Pr[SLCommon.RealIndif(SLCommon.SqueezelessSponge,SLCommon.PC(Perm),LowerDist(Wrap(D))).main() @ &m : res] + - Pr[SLCommon.IdealIndif(Gconcl.IF,Gconcl.S,LowerDist(Wrap(D))).main() @ &m : res] |. + proof. + do 3?congr. + + byequiv (_: ={glob D} ==> _)=> //; proc; inline *. + call (_: ={glob Perm}). + + by proc; inline *; wp; sim. + + by proc; inline *; wp; sim. + + proc; sp; if=> //. + call (_: ={glob Perm, arg} + /\ valid_block xs{1} /\ 0 < n{1} + ==> ={glob Perm, res}). + + proc. rcondt{1} 4; 1:by auto. rcondt{2} 2; 1:by auto; smt (valid_block_ends_not_b0). + rcondt{2} 4; 1:by auto. + inline{2} SLCommon.SqueezelessSponge(SLCommon.PC(Perm)).f. + seq 4 6: ( ={glob Perm, n, i, sa, sc} + /\ (* some notion of path through Perm.m *) true). + + while ( ={glob Perm, sa, sc} + /\ xs{1} = p{2} + /\ (* some notion of path through Perm.m *) true). + + wp; call (_: ={glob Perm}). + + by inline *; wp; sim. + by auto=> /> /#. + by auto=> &1 &2 [#] !<<- vblock n_gt0 /=; rewrite /extend nseq0 cats0. + (* make sure that the notion of path guarantees that only the last call of each iteration adds something to the map, and that it is exactly the right call *) + admit. + by auto=> /#. + by auto. + byequiv (_: ={glob D} ==> _)=> //; proc; inline *. + call (_: ={glob S} + /\ (forall p n, BIRO.IRO.mp{1}.[(p,n)] <> None => last b0 p <> b0) + /\ (forall p, SLCommon.F.RO.m{2}.[p] = BIRO.IRO.mp{1}.[strip p]) + /\ (* relation between S.paths and presence in the RO map *) true). + + proc. if=> //=; last by auto. if=> //=; last by auto. + inline *. admit. (* something about valid queries *) + + admit. (* prove: S(LowerF(BIRO.IRO)).fi ~ S(IF).fi *) + + by proc; sp; if=> //; call (f_f); auto=> /#. + by auto=> />; split=> [?|] ?; rewrite !map0P. + qed. +end section PROOF. From 7f9450b2094bf60d1141ecacfcef2c18c0fef521 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Mon, 29 Aug 2016 11:19:56 +0100 Subject: [PATCH 222/525] Whitespace. --- proof/core/Handle.eca | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/proof/core/Handle.eca b/proof/core/Handle.eca index 799ff4f..9fe7f89 100644 --- a/proof/core/Handle.eca +++ b/proof/core/Handle.eca @@ -648,7 +648,7 @@ lemma path_split hs ch m mh xc hx p xa: /\ build_hpath mh pk = Some (ya,hy) /\ hs.[hy] = Some (yc,Known) /\ mh.[(ya +^ b,hy)] = Some (za,hz) - /\ hs.[hz] = Some (zc,Unknown). + /\ hs.[hz] = Some (zc,Unknown). proof. move=> Ihs [] _ Imh_m. elim/last_ind: p hx xa xc=> [hx xa xc + /build_hpathP [_ <*>|/#]|]. From 931fe8ca48171148e9df88b8eab145c568fc7174 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Wed, 31 Aug 2016 12:15:47 +0100 Subject: [PATCH 223/525] Isolating known statements for the Core Construction. --- proof/core/Core.eca | 306 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 306 insertions(+) create mode 100644 proof/core/Core.eca diff --git a/proof/core/Core.eca b/proof/core/Core.eca new file mode 100644 index 0000000..cb39bc3 --- /dev/null +++ b/proof/core/Core.eca @@ -0,0 +1,306 @@ +require import Pred Fun Option Pair Int Real List FSet NewFMap NewDistr. +require import StdOrder Ring DProd. +(*---*) import IntOrder. + +require (*..*) RP Indifferentiability. + +(*** THEORY PARAMETERS ***) +(** Block/Rate **) +theory Block. + op r : int. + axiom r_ge0: 0 <= r. + + type block. + + op b0: block. + op (+^): block -> block -> block. + + axiom addbA b1 b2 b3: b1 +^ (b2 +^ b3) = b1 +^ b2 +^ b3. + axiom addbC b1 b2: b1 +^ b2 = b2 +^ b1. + axiom add0b b: b0 +^ b = b. + axiom addbK b: b +^ b = b0. + + op enum: block list. + axiom block_enum b: count (pred1 b) enum = 1. + axiom card_block: size enum = 2^r. + + clone import Ring.ZModule as BlockMonoid with + type t <- block, + op zeror <- b0, + op ( + ) <- (+^), + op [ - ] (b : block) <- b + proof *. + realize addrA by exact/addbA. + realize addrC by exact/addbC. + realize add0r by exact/add0b. + realize addNr by exact/addbK. + + clone import MFinite as DBlock with + type t <- block, + op Support.enum <- enum + rename "dunifin" as "bdistr" + "duniform" as "bdistr" + proof *. + realize Support.enum_spec by exact/block_enum. +end Block. +import Block DBlock. + +(** Capacity **) +theory Capacity. + op c : int. + axiom c_ge0: 0 <= c. + + type capacity. + + op c0: capacity. + + op enum: capacity list. + axiom capacity_enum b: count (pred1 b) enum = 1. + axiom card_capacity: size enum = 2^c. + + clone import MFinite as DCapacity with + type t <- capacity, + op Support.enum <- enum + rename "dunifin" as "cdistr" + "duniform" as "cdistr" + proof *. + realize Support.enum_spec by exact/capacity_enum. +end Capacity. +import Capacity DCapacity. + +(** Validity of Functionality Queries **) +op valid: block list -> bool. +axiom valid_not_nil m: valid m => m <> []. + +(** Adversary's Query Cost **) +op max_query: int. +axiom max_query_ge0: 0 <= max_query. + +(*** DEFINITIONS ***) +type state = block * capacity. +op dstate = bdistr `*` cdistr. + +(** Indifferentiability Experiment **) +clone include Indifferentiability with + type p <- state, + type f_in <- block list, + type f_out <- block + rename [module] "GReal" as "RealIndif" + [module] "GIdeal" as "IdealIndif". + +(** Query Counting **) +module C = { + var c:int + proc init() = { c <- 0; } +}. + +module PC (P : PRIMITIVE) : PRIMITIVE = { + proc init () = { + C.init(); + P.init(); + } + + proc f (x : state) = { + var y; + + C.c <- C.c + 1; + y <@ P.f(x); + return y; + } + + proc fi(x : state) = { + var y; + + C.c <- C.c + 1; + y <@ P.fi(x); + return y; + } +}. + +module DPRestr (P : DPRIMITIVE) : DPRIMITIVE = { + proc f (x : state) = { + var y <- (b0,c0); + + if (C.c + 1 <= max_query) { + C.c <- C.c + 1; + y <@ P.f(x); + } + return y; + } + + proc fi(x : state) = { + var y <- (b0,c0); + + if (C.c + 1 <= max_query) { + C.c <- C.c + 1; + y <@ P.fi(x); + } + return y; + } +}. + +module PRestr (P : PRIMITIVE) : PRIMITIVE = { + proc init () = { + C.init(); + P.init(); + } + + proc f = DPRestr(P).f + proc fi = DPRestr(P).fi +}. + +module FC (F : FUNCTIONALITY) : FUNCTIONALITY = { + proc init = F.init + + proc f (p : block list) = { + var b <- witness; + + if (valid p) { + C.c <- C.c + size p; + b <@ F.f(p); + } + return b; + } +}. + +module DFRestr (F : DFUNCTIONALITY) : DFUNCTIONALITY = { + proc f (bs : block list) = { + var b <- b0; + + if (C.c + size bs <= max_query) { + C.c <- C.c + size bs; + b <@ F.f(bs); + } + return b; + } +}. + +module FRestr(F : FUNCTIONALITY) : FUNCTIONALITY = { + proc init = F.init + proc f = DFRestr(F).f +}. + +module (DRestr (D : DISTINGUISHER) : DISTINGUISHER) + (F : DFUNCTIONALITY) (P : DPRIMITIVE) = { + proc distinguish() = { + var b; + + C.init(); + b <@ D(DFRestr(F), DPRestr(P)).distinguish(); + return b; + } +}. + +(** Ideal Primitive **) +clone import RP as Perm with + type t <- block * capacity, + op dt <- bdistr `*` cdistr + rename + [module type] "RP" as "PRIMITIVE" + [module] "P" as "Perm". + +(** Core Construction **) +module (Core : CONSTRUCTION) (P:DPRIMITIVE): FUNCTIONALITY = { + proc init () = {} + + proc f(p : block list): block = { + var (sa,sc) <- (b0,c0); + + while (p <> []) { + (sa,sc) <@ P.f((sa +^ head witness p,sc)); + p <- behead p; + } + return sa; + } +}. + +(** Ideal Core Functionality **) +module ICore: FUNCTIONALITY = { + var m : (block list,block) fmap + + proc init() = { + m = map0; + } + + proc f(p : block list): block = { + var r <- witness; + + if (valid p) { + if (!mem (dom m) p) { + m.[p] <$ bdistr; + } + r <- oget m.[p]; + } + return r; + } +}. + +(** Core Simulator **) +module (S : SIMULATOR) (F : DFUNCTIONALITY) : PRIMITIVE = { + var m, mi : (state,state) fmap + var pi : (capacity, block list * block) fmap + + proc init() = { + m <- map0; + mi <- map0; + pi <- map0.[c0 <- ([<:block>],b0)]; + } + + proc f(x : state): state = { + var p, v, y, y1, y2; + + if (!mem (dom m) x) { + if (mem (dom pi) x.`2) { + (p,v) <- oget pi.[x.`2]; + y1 <- F.f (rcons p (v +^ x.`1)); + } else { + y1 <$ bdistr; + } + y2 <$ cdistr; + y <- (y1,y2); + m.[x] <- y; + mi.[y] <- x; + if (mem (dom pi) x.`2) { + (p,v) <- oget pi.[x.`2]; + pi.[y.`2] <- (rcons p (v +^ x.`1), y.`1); + } + } else { + y <- oget m.[x]; + } + return y; + } + + proc fi(x : state): state = { + var y, y1, y2; + + if (!mem (dom mi) x) { + y1 <$ bdistr; + y2 <$ cdistr; + y <- (y1,y2); + mi.[x] <- y; + m.[y] <- x; + } else { + y <- oget mi.[x]; + } + return y; + } +}. + +(*** PROOF ***) +(** TODO -- This is not indifferentiability -- clean up and fix **) +(** However, this is what's proven (modulo the additional validity + check in ICore, not present in IF. The validity checks may be + problematic in combination with counting, so we need to make sure + both are present throughout before diving in. **) +lemma CoreIndiff (D <: DISTINGUISHER {C, Perm, Core, ICore, S}) &m: + (forall (F <: DFUNCTIONALITY {D}) (P <: DPRIMITIVE {D}), + islossless P.f + => islossless P.fi + => islossless F.f + => islossless D(F,P).distinguish) + => Pr[RealIndif(Core,PC(Perm),D).main() @ &m: res /\ C.c <= max_query] + <= Pr[IdealIndif(ICore,S,DRestr(D)).main() @ &m :res] + + (max_query ^ 2)%r / (2^(r + c))%r + + max_query%r * ((2*max_query)%r / (2^c)%r) + + max_query%r * ((2*max_query)%r / (2^c)%r). +abort. From 3adf9427ef756d4728d49b7fd8a558982d5d1002 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Wed, 31 Aug 2016 15:32:27 +0200 Subject: [PATCH 224/525] almost the end of core --- proof/core/Handle.eca | 227 +++++++++++++++++++++++++++++++++++++++--- 1 file changed, 212 insertions(+), 15 deletions(-) diff --git a/proof/core/Handle.eca b/proof/core/Handle.eca index 9fe7f89..0905386 100644 --- a/proof/core/Handle.eca +++ b/proof/core/Handle.eca @@ -416,41 +416,41 @@ case: (hx' = hy); case: (hy' = hy)=> //= <*> => [|Hhy'|Hhx'|Hhx' Hhy']. by exists xc' fx' yc' fy'; rewrite !getP Hhx' Hhy'. qed. -lemma m_mh_addh_addm hs Pm mh hx xa xc hy ya yc f: +lemma m_mh_addh_addm hs Pm mh hx xa xc hy ya yc f f': m_mh hs Pm mh => huniq hs => hs.[hx] = Some (xc, f) => hs.[hy] = None => - m_mh hs.[hy <- (yc,Known)] Pm.[(xa,xc) <- (ya,yc)] mh.[(xa,hx) <- (ya,hy)]. + m_mh hs.[hy <- (yc,f')] Pm.[(xa,xc) <- (ya,yc)] mh.[(xa,hx) <- (ya,hy)]. proof. move=> [] Hm_mh Hmh_m Hhuniq hs_hx hs_hy. split=> [xa0 xc0 ya0 yc0|xa0 hx0 ya0 hy0]; rewrite getP. + case: ((xa0,xc0) = (xa,xc))=> [[#] <<*> [#] <<*>|] /=. - + by exists hx f hy Known; rewrite !getP /= /#. + + by exists hx f hy f'; rewrite !getP /= /#. move=> xaxc0_neq_xaxc /Hm_mh [hx0 fx0 hy0 fy0] [#] hs_hx0 hs_hy0 mh_xahx0. by exists hx0 fx0 hy0 fy0; rewrite !getP /#. case: ((xa0,hx0) = (xa,hx))=> [[#] <*>> [#] <<*>|] /=. -+ by exists xc f yc Known; rewrite !getP /= /#. ++ by exists xc f yc f'; rewrite !getP /= /#. rewrite anda_and=> /negb_and xahx0_neq_xahx /Hmh_m [xc0 fx0 yc0 fy0] [#] hs_hx0 hs_hy0 Pm_xaxc0. exists xc0 fx0 yc0 fy0; rewrite !getP; do !split=> [/#|/#|/=]. move: xahx0_neq_xahx; case: (xa0 = xa)=> [/= <*>>|//=]; case: (xc0 = xc)=> [<*>>|//=]. by move: hs_hx=> /(Hhuniq _ _ _ _ hs_hx0). qed. -lemma mi_mhi_addh_addmi (hs : handles) mi mhi hx xa xc hy ya yc fx: +lemma mi_mhi_addh_addmi (hs : handles) mi mhi hx xa xc hy ya yc fx fy: m_mh hs mi mhi => (forall f h, hs.[h] <> Some (yc,f)) => hs.[hx] = Some (xc,fx) => hs.[hy] = None => - m_mh hs.[hy <- (yc,Known)] mi.[(ya,yc) <- (xa,xc)] mhi.[(ya,hy) <- (xa,hx)]. + m_mh hs.[hy <- (yc,fy)] mi.[(ya,yc) <- (xa,xc)] mhi.[(ya,hy) <- (xa,hx)]. proof. move=> [] Hm_mh Hmh_m yc_notin_rng1_hs hs_hx hs_hy; split. + move=> ya0 yc0 xa0 xc0; rewrite getP; case: ((ya0,yc0) = (ya,yc))=> [[#] <*>> [#] <*>>|]. - + by exists hy Known hx fx; rewrite !getP /= /#. + + by exists hy fy hx fx; rewrite !getP /= /#. move=> yayc0_neq_yayc /Hm_mh [hy0 fy0 hx0 fx0] [#] hs_hy0 hs_hx0 mhi_yayc0. by exists hy0 fy0 hx0 fx0; rewrite !getP /#. move=> ya0 hy0 xa0 hx0; rewrite getP; case: ((ya0,hy0) = (ya,hy))=> [[#] <*>> [#] <<*>|]. -+ by exists yc Known xc fx; rewrite !getP //= /#. ++ by exists yc fy xc fx; rewrite !getP //= /#. rewrite /= anda_and=> /negb_and yahy0_neq_yahy /Hmh_m [yc0 fy0 xc0 fx0] [#] hs_hy0 hs_hx0 mi_yayc0. exists yc0 fy0 xc0 fx0; rewrite !getP; do !split=> [/#|/#|]. move: yahy0_neq_yahy; case: (ya0 = ya)=> [<<*> //=|/#]; case: (yc0 = yc)=> [<*>> /=|//=]. @@ -696,7 +696,7 @@ move=> HINV x2_neq_y2 Pm_x Gm_x x2_notin_rng1_hs y2_notin_rng1_hs; split. + by move: HINV => /hs_of_INV /hs_addh /(_ x2 Known _) // []. + by rewrite getP. by rewrite getP gtr_eqF 1:/# /=; apply/Sch_notin_dom_hs; case: HINV. -+ apply/(@mi_mhi_addh_addmi hs.[ch <- (x2,Known)] Pmi mhi ch x1 x2 (ch + 1) y1 y2 Known). ++ apply/(@mi_mhi_addh_addmi hs.[ch <- (x2,Known)] Pmi mhi ch x1 x2 (ch + 1) y1 y2 Known Known). + by move: HINV=> ^/hs_of_INV Hhs /mi_mhi_of_INV; exact/(m_mh_addh Hhs). + move=> f h; rewrite getP; case: (h = ch)=> [_ //=|_ //=]; first by rewrite x2_neq_y2. by rewrite y2_notin_rng1_hs. @@ -786,7 +786,7 @@ move=> HINV x2_neq_y2 Pm_x Gm_x xc_notin_rng1_hs yc_notin_rng1_hs; split. by apply/(Sch_notin_dom2_mh _ _ Hm_mh Hhs). have ^ /mi_mhi_of_INV Hmi_mhi /hs_of_INV Hhs := HINV. by apply/(ch_notin_dom2_mh _ _ Hmi_mhi Hhs). -+ apply/(@mi_mhi_addh_addmi hs.[ch <- (x2,Known)] Pm mh ch x1 x2 (ch + 1) y1 y2 Known). ++ apply/(@mi_mhi_addh_addmi hs.[ch <- (x2,Known)] Pm mh ch x1 x2 (ch + 1) y1 y2 Known Known). + by move: HINV=> ^/hs_of_INV Hhs /m_mh_of_INV; exact/(m_mh_addh Hhs). + by move=> f h; rewrite getP; case: (h = ch)=> [<*> /#|]; rewrite yc_notin_rng1_hs. + by rewrite getP. @@ -879,10 +879,10 @@ split. have ^ /mi_mhi_of_INV Hmi_mhi /hs_of_INV Hhs := HINV. by apply/(ch_notin_dom2_mh _ _ Hmi_mhi Hhs). + have ^ /hs_of_INV ^ Hhs [] Hhuniq _ _ /m_mh_of_INV := HINV. - move=> /m_mh_addh_addm /(_ hx x1 x2 ch y1 y2 Known Hhuniq hs_hx _) //. + move=> /m_mh_addh_addm /(_ hx x1 x2 ch y1 y2 Known Known Hhuniq hs_hx _) //. exact/ch_notin_dom_hs. + have ^ /hs_of_INV ^ Hhs [] Hhuniq _ _ /mi_mhi_of_INV := HINV. - move=> /mi_mhi_addh_addmi /(_ hx x1 x2 ch y1 y2 Known _ hs_hx _) //. + move=> /mi_mhi_addh_addmi /(_ hx x1 x2 ch y1 y2 Known Known _ hs_hx _) //. exact/ch_notin_dom_hs. + by have /incl_of_INV/incl_addm ->:= HINV. + by have /incli_of_INV/incl_addm ->:= HINV. @@ -965,10 +965,10 @@ split. have ^ /mi_mhi_of_INV Hm_mh /hs_of_INV Hhs := HINV. by apply/(notin_m_notin_mh _ _ _ _ Hm_mh PFmi_x1x2 hs_hx). + have ^ /hs_of_INV ^ Hhs [] Hhuniq _ _ /m_mh_of_INV := HINV. - move=> /mi_mhi_addh_addmi /(_ hx x1 x2 ch y1 y2 Known _ hs_hx _) //. + move=> /mi_mhi_addh_addmi /(_ hx x1 x2 ch y1 y2 Known Known _ hs_hx _) //. exact/ch_notin_dom_hs. + have ^ /hs_of_INV ^ Hhs [] Hhuniq _ _ /mi_mhi_of_INV := HINV. - move=> /m_mh_addh_addm /(_ hx x1 x2 ch y1 y2 Known _ hs_hx _) //. + move=> /m_mh_addh_addm /(_ hx x1 x2 ch y1 y2 Known Known _ hs_hx _) //. exact/ch_notin_dom_hs. + by have /incl_of_INV/incl_addm ->:= HINV. + by have /incli_of_INV/incl_addm ->:= HINV. @@ -1296,6 +1296,203 @@ rcondf{2} 1; 1:by auto=> &hr [#] <<*>; rewrite in_dom Gmi_xaxc. by auto=> &1 &2 /#. qed. +lemma head_nth (w:'a) l : head w l = nth w l 0. +proof. by case l. qed. + +lemma drop_add (n1 n2:int) (l:'a list) : 0 <= n1 => 0 <= n2 => drop (n1 + n2) l = drop n2 (drop n1 l). +proof. + move=> Hn1 Hn2;elim: n1 Hn1 l => /= [ | n1 Hn1 Hrec] l;1: by rewrite drop0. + by case: l => //= a l /#. +qed. + +lemma behead_drop (l:'a list) : behead l = drop 1 l. +proof. by case l => //= l;rewrite drop0. qed. + +lemma incl_upd_nin (m1 m2:('a,'b)fmap) x y: incl m1 m2 => !mem (dom m2) x => incl m1 m2.[x <- y]. +proof. + move=> Hincl Hdom w ^/Hincl <- => Hw. + rewrite getP_neq // -negP => ->>. + by move: Hdom;rewrite in_dom. +qed. + + + +equiv PFf_Cf (D<:DISTINGUISHER): SqueezelessSponge(PF).f ~ G1(D).C.f : + ! (G1.bcol{2} \/ G1.bext{2}) /\ + ={p} /\ p{1} <> [] /\ + INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} ==> + ! (G1.bcol{2} \/ G1.bext{2}) => + ={res} /\ INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2}. +proof. + proc; seq 2 4: + ((!(G1.bcol{2} \/ G1.bext{2}) => + (INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} /\ + F.RO.m.[p]{2} = Some sa{1})));last first. + + case : (! (G1.bcol{2} \/ G1.bext{2})); + 2: by conseq (_:_ ==> true)=> //; inline *;auto;rewrite Block.DWord.bdistr_ll. + inline *; rcondf{2} 3. + + by move=> &m;auto=> &hr [#] H /H[_ H1] ??;rewrite in_dom H1. + by auto=> /> &m1 &m2;rewrite Block.DWord.bdistr_ll /= => H /H [-> ->];rewrite oget_some. + while ( + p{1} = (drop i p){2} /\ (0 <= i <= size p){2} /\ + (!(G1.bcol{2} \/ G1.bext{2}) => + (INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} /\ + ={sa} /\ + (exists f, FRO.m.[h]{2} = Some (sc{1}, f)) /\ + (build_hpath G1.mh (take i p) = Some (sa,h)){2} /\ + if i{2} = 0 then (sa,h){2} = (b0, 0) + else F.RO.m.[take i p]{2} = Some sa{1})));last first. + + auto=> &m1 &m2 [#] -> -> Hp ^ Hinv -> /=;rewrite drop0 size_ge0 /=;split. + + split;[split|];1: by exists Known;case Hinv => -[] _ ->. + + by rewrite take0. + by case (p{m2}) => //=;smt w=size_ge0. + move=> ????? ????? ?? iR ? ->> ?[#] _ ?? H /H{H} [#] -> ->> _ ?. + have -> : iR = size p{m2} by smt (). + have -> /= : size p{m2} <> 0 by smt (size_ge0). + by rewrite take_size. + inline *;sp 1 0;wp=> /=. + conseq (_: _ ==> (! (G1.bcol{2} \/ G1.bext{2}) => + INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} + G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} /\ + (oget PF.m{1}.[x{1}]).`1 = sa{2} /\ + (exists (f : flag), FRO.m{2}.[h{2}] = Some ((oget PF.m{1}.[x{1}]).`2, f)) /\ + (build_hpath G1.mh (take (i + 1) p) = Some (sa,h)){2} /\ + if i{2} + 1 = 0 then sa{2} = b0 && h{2} = 0 + else F.RO.m{2}.[take (i{2} + 1) p{2}] = Some (oget PF.m{1}.[x{1}]).`1)). + + move=> &m1 &m2 [#] 2!->> ?? H ?? ?????????? H'. + rewrite behead_drop -drop_add //=;split=>[/#|]. + by have := size_drop (i{m2} + 1) p{m2};case (drop (i{m2} + 1) p{m2}) => //= [/#| ];smt w=size_ge0. + case ((G1.bcol{2} \/ G1.bext{2})). + + wp;conseq (_: _ ==> (G1.bcol{2} \/ G1.bext{2}))=> //. + by if{1};if{2};auto;2:(swap{2} 4 -3;auto); smt w=(Block.DWord.bdistr_ll DWord.cdistr_ll). + conseq (_: (x{1} = (sa{1} +^ head witness p{1}, sc{1}) /\ + (p{1} = drop i{2} p{2} /\ + 0 <= i{2} <= size p{2} /\ + (INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} + G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} /\ + ={sa} /\ + (exists (f : flag), FRO.m{2}.[h{2}] = Some (sc{1}, f)) /\ + (build_hpath G1.mh (take i p) = Some (sa,h)){2} /\ + if i{2} = 0 then (sa{2}, h{2}) = (b0, 0) + else F.RO.m{2}.[take i{2} p{2}] = Some sa{1})) /\ + p{1} <> [] /\ i{2} < size p{2}) /\ + ! (G1.bcol{2} \/ G1.bext{2}) /\ + (mem (dom PF.m) x){1} = (mem (dom G1.mh) (sa +^ nth witness p i, h)){2} ==> _). + + move=> &m1 &m2 [#] 2!->> ?? H ?? ^ /H [#] /= Hinv ->> Hf -> -> ? /= />. + case: Hf=> f Hm; rewrite head_nth nth_drop // addz0 !in_dom. + pose X := sa{m2} +^ nth witness p{m2} i{m2}. + case (Hinv)=> -[Hu _ _] _ _ [] /(_ X sc{m1}) Hpf ^ HG1 /(_ X h{m2}) Hmh _ _ _ _ _. + case: {-1}(PF.m{m1}.[(X,sc{m1})]) (eq_refl (PF.m{m1}.[(X,sc{m1})])) Hpf Hmh. + + case (G1.mh{m2}.[(X, h{m2})]) => //= -[ya hy] Hpf. + by rewrite -negP => /(_ ya hy) [] ????[#];rewrite Hm /= => -[<-];rewrite Hpf. + move=> [ya yc] Hpf/(_ ya yc) [hx fx hy fy [#]] Hhx Hhy ^ /HG1 [xc fx0 yc0 fy0]. + rewrite Hhx => /= [#] 2!<<-;rewrite Hhy Hpf /= => -[] !->> _. + by have /= <<- -> := Hu _ _ _ _ Hm Hhx. + if{1};[rcondf{2} 1| rcondt{2} 1];1,3:(by auto;smt ());last first. + + auto => /> /= &m1 &m2 ?? [] Hhs Hinv Hinvi Hmmh Hmmhi Hincl Hincli Hmh Hpi f. + rewrite head_nth nth_drop // addz0 => Heq Hbu ????. + rewrite !in_dom. + have -> /= : i{m2} + 1 <> 0 by smt (). + pose sa' := sa{m2} +^ nth witness p{m2} i{m2}. + case (Hmmh) => /(_ sa' sc{m1});case (PF.m{m1}.[(sa', sc{m1})])=> //= -[ya yc] /(_ ya yc) /=. + move=> [hx fx hy fy]; case (Hhs) => Hu _ _ [#] Heq'. + have /= <<- /= Hhy ^? ->:= Hu _ _ _ _ Heq Heq'. + rewrite !oget_some /= => _;split;1: by exists fy. + rewrite (@take_nth witness) 1://. + case (Hmh) => _ -> _;rewrite build_hpath_prefix Hbu /#. + rcondt{2} 5. + + move=> &m;auto=> &hr /> ?? Hinv f. + rewrite head_nth nth_drop // addz0; pose sa' := sa{hr} +^ nth witness p{hr} i{hr}. + move=> ?Hbu????->Hmem ????. + case (Hinv) => ??????? [] H1 H2 H3 ?. + rewrite (@take_nth witness) 1:// -negP in_dom. + pose p' := (take i{hr} p{hr}); pose w:= (nth witness p{hr} i{hr}). + case {-1}(F.RO.m{hr}.[rcons p' w]) (eq_refl (F.RO.m{hr}.[rcons p' w]))=> //. + move=> ? /H2 [???];rewrite Hbu => -[] [!<<-] HG1. + by move: Hmem;rewrite in_dom HG1. + swap{2} 4 -3;auto => &m1 &m2 [#] 2!->?? [] Hhs Hinv Hinvi Hmmh Hmmhi Hincl Hincli Hmh Hpi -> /=. + move=> Hsc Hpa Hif Hdrop Hlt Hbad. + rewrite head_nth nth_drop // addz0; pose sa' := sa{m2} +^ nth witness p{m2} i{m2}. + move=> Heq Hdom y1L-> /= y2L-> /=. + have -> /= : i{m2} + 1 <> 0 by smt (). + rewrite !getP_eq !oget_some /=. + pose p' := (take (i{m2} + 1) p{m2});rewrite -!nor=> [#] ? /= Hy2 ?. + split;last first. + + split;1: by exists Unknown. + rewrite /p' (@take_nth witness) 1:// build_hpath_prefix. + exists sa{m2} h{m2}. + rewrite /sa' getP_eq /=;apply build_hpath_up => //. + by move: Hdom;rewrite Heq /sa' in_dom. + have Hy1L := ch_notin_dom2_mh _ _ _ y1L G1.chandle{m2} Hmmhi Hhs. + have := hinvP FRO.m{m2} y2L;rewrite Hy2 /= => Hy2L. + have g1_sa' : G1.mh{m2}.[(sa', h{m2})] = None by move: Hdom;rewrite Heq in_dom. + case :Hsc => f Hsc; have Hh := dom_hs_neq_ch _ _ _ _ _ Hhs Hsc. + have Hch : FRO.m{m2}.[G1.chandle{m2}] = None. + + case Hhs => _ _ H. + by case {-1}(FRO.m{m2}.[G1.chandle{m2}]) (eq_refl (FRO.m{m2}.[G1.chandle{m2}])) => // ? /H. + have Hy2_mi: ! mem (dom PF.mi{m1}) (y1L, y2L). + + rewrite in_dom;case {-1}( PF.mi{m1}.[(y1L, y2L)]) (eq_refl (PF.mi{m1}.[(y1L, y2L)])) => //. + by move=> [] ??;case Hmmhi=> H _ /H [] ????;rewrite Hy2L. + have ch_0 := ch_neq0 _ _ Hhs. + have ch_None : + forall xa xb ha hb, G1.mh{m2}.[(xa,ha)] = Some(xb, hb) => + ha <> G1.chandle{m2} /\ hb <> G1.chandle{m2}. + + move=> xa xb ha hb;case Hmmh=> _ H /H [xc fx yc fy [#]]. + by move=> /(dom_hs_neq_ch _ _ _ _ _ Hhs) -> /(dom_hs_neq_ch _ _ _ _ _ Hhs). + split=> //. + + by apply hs_addh => // ??;apply Hy2L. + + by apply inv_addm. + + by apply (m_mh_addh_addm f) => //;case Hhs. + + by apply (mi_mhi_addh_addmi f)=> // ??;apply Hy2L. + + by apply incl_upd_nin. + + by apply incl_upd_nin. + + case (Hmh)=> H1 H2 H3;split. + + move=> xa hx ya hy;rewrite getP;case((xa, hx) = (sa', h{m2}))=> [[2!->>] [2!<<-] | Hdiff]. + + exists sc{m1} f y2L Unknown. + rewrite getP_eq getP_neq 1:eq_sym //= Hsc /=. + exists (take i{m2} p{m2}) sa{m2}. + rewrite /p' (@take_nth witness) 1:// /sa' xorwA xorwK xorwC xorw0 getP_eq /=. + by apply build_hpath_up_None. + move=> /H1 [xc fx yc fy] [#] Hhx Hhy Hfy; exists xc fx yc fy. + rewrite !getP_neq. + + by rewrite eq_sym;apply (dom_hs_neq_ch _ _ _ Hhs Hhx). + + by rewrite eq_sym;apply (dom_hs_neq_ch _ _ _ Hhs Hhy). + rewrite Hhx Hhy /=;case: fy Hhy Hfy => //= Hhy [p v [Hro Hpath]]. + exists p v;rewrite getP_neq 1:-negP 1:/p' 1:(@take_nth witness) 1://. + + move => ^ /rconssI <<-;move: Hpath;rewrite Hpa=> -[!<<-] /rconsIs Heq'. + by move:Hdiff=> /=;rewrite /sa' Heq' xorwA xorwK xorwC xorw0. + by rewrite Hro /=;apply build_hpath_up_None. + + move=> p1 bn b; rewrite getP /p' (@take_nth witness) //. + case (rcons p1 bn = rcons (take i{m2} p{m2}) (nth witness p{m2} i{m2})). + + move=> ^ /rconssI ->> /rconsIs ->> /=; split => [<<- | ]. + + exists sa{m2} h{m2} G1.chandle{m2}. + by rewrite /sa' getP_eq /= (build_hpath_up Hpa) //. + move=> [v hx hy []] Heq1;rewrite getP /sa'. + case ((v +^ nth witness p{m2} i{m2}, hx) = (sa{m2} +^ nth witness p{m2} i{m2}, h{m2})) => //. + have := build_hpath_up_None G1.mh{m2} (sa', h{m2}) (y1L, G1.chandle{m2}) _ _ g1_sa' Hpa. + by rewrite Heq1 => -[!->>]. + move=> Hdiff;rewrite H2. + apply exists_iff=> v /= ;apply exists_iff => hx /=;apply exists_iff => hy /=. + have Hhx2 := dom_hs_neq_ch _ _ _ _ _ Hhs Hsc. + rewrite build_hpath_upd_ch_iff //. + case (hx = G1.chandle{m2}) => [->>|?]. + + split;1: by move=> [] _ /ch_None. + move=> [[p0' x [Hhx2']]]. + have [!<<-] [!->>]:= H3 _ _ _ _ _ Hpa Hhx2'. + by rewrite getP_neq /= ?Hhx2 // => /ch_None. + rewrite getP; case ((v +^ bn, hx) = (sa', h{m2})) => //= -[Hsa' ->>]. + rewrite Hsa' g1_sa' /= -negP => [#] Hbu !<<-. + have [!<<-]:= H3 _ _ _ _ _ Hpa Hbu. + move: Hsa'=> /Block.WRing.addrI /#. + move=> p1 v p2 v' hx. + rewrite !build_hpath_upd_ch_iff //. + case (hx = G1.chandle{m2})=> [->> | Hdiff ];2:by apply H3. + by move=> /> ?? Hp1 ?? Hp2;have [!->>] := H3 _ _ _ _ _ Hp1 Hp2. + case (Hpi) => H1;split=> c p1 v1;rewrite H1 => {H1}. + apply exists_iff => h1 /=. rewrite getP build_hpath_upd_ch_iff //. + by case (h1 = G1.chandle{m2}) => [->> /#|]. +qed. + section AUX. declare module D : DISTINGUISHER {PF, RO, G1}. @@ -1611,7 +1808,7 @@ section AUX. by wp; do 2!rnd predT; auto => &hr [#]; smt (Block.DWord.bdistr_uf Capacity.DWord.cdistr_uf). (** proofs for G1.C.f *) (* equiv PF.C.f G1.C.f *) - + admit. + + proc. (* lossless PF.C.f *) + move=> &2 _; proc; inline *; while (true) (size p); auto. + sp; if; 2:by auto; smt (size_behead). From eb0f7275a9069da21f90c3074707560aec84e19b Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Wed, 31 Aug 2016 09:47:34 -0400 Subject: [PATCH 225/525] Formatting. --- proof/Sponge.ec | 18 ++++++++++-------- 1 file changed, 10 insertions(+), 8 deletions(-) diff --git a/proof/Sponge.ec b/proof/Sponge.ec index e7b6054..102db36 100644 --- a/proof/Sponge.ec +++ b/proof/Sponge.ec @@ -828,7 +828,7 @@ pred eager_eq_except ys <> xs \/ k < i \/ j <= k => mp1.[(ys, k)] = mp2.[(ys, k)]. lemma eager_eq_except_mem_iff - (xs ys : block list, i j k: int, + (xs ys : block list, i j k : int, mp1 mp2 : (block list * int, bool) fmap) : eager_eq_except xs i j mp1 mp2 => ys <> xs \/ k < i \/ j <= k => @@ -1084,8 +1084,8 @@ lemma PrLoopSnoc_sample &m (bs : bool list) : mu (dlist {0,1} r) (pred1 bs). proof. have -> : - Pr[Prog.LoopSnoc.sample(r) @ &m: bs = res] = - Pr[Prog.Sample.sample(r) @ &m: bs = res]. + Pr[Prog.LoopSnoc.sample(r) @ &m : bs = res] = + Pr[Prog.Sample.sample(r) @ &m : bs = res]. byequiv=> //. symmetry. conseq (_ : ={n} ==> ={res})=> //. @@ -1676,7 +1676,8 @@ transitivity{1} bs{1} = blocks2bits bs{2} /\ eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}). progress; - exists HybridIROEager.mp{1} (blocks2bits bs{2}) (size bs{2} * r) m{1} x{2}=> //. + exists HybridIROEager.mp{1} (blocks2bits bs{2}) + (size bs{2} * r) m{1} x{2}=> //. progress; smt(take_cat). splitwhile{2} 1 : i < n1. seq 1 1 : @@ -1710,7 +1711,8 @@ transitivity{1} bs{1} = blocks2bits bs{2} /\ eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1})=> //. progress [-delta]; - exists HybridIROEager.mp{1} (blocks2bits bs{2}) (size bs{2} * r) m{1} x{2}=> //. + exists HybridIROEager.mp{1} (blocks2bits bs{2}) (size bs{2} * r) + m{1} x{2}=> //. inline HybridIROEagerTrans.next_block; sim. (transitivity{2} { (bs, i) <@ BlockSpongeTrans.next_block(x, i, bs); @@ -1803,7 +1805,7 @@ auto. qed. local lemma RealIndif_Sponge_BlockSponge &m : - Pr[RealIndif(Sponge, Perm, Dist).main() @ &m: res] = + Pr[RealIndif(Sponge, Perm, Dist).main() @ &m : res] = Pr[BlockSponge.RealIndif (BlockSponge.Sponge, Perm, LowerDist(Dist)).main() @ &m : res]. proof. @@ -1957,7 +1959,7 @@ by rewrite (Ideal_IRO_Experiment_HybridLazy &m) qed. lemma conclu &m : - `|Pr[RealIndif(Sponge, Perm, Dist).main() @ &m: res] - + `|Pr[RealIndif(Sponge, Perm, Dist).main() @ &m : res] - Pr[IdealIndif(IRO, RaiseSim(BlockSim), Dist).main() @ &m : res]| = `|Pr[BlockSponge.RealIndif (BlockSponge.Sponge, Perm, LowerDist(Dist)).main() @ &m : res] - @@ -1975,7 +1977,7 @@ lemma conclusion (BlockSim <: BlockSponge.SIMULATOR{IRO, BlockSponge.BIRO.IRO}) (Dist <: DISTINGUISHER{Perm, BlockSim, IRO, BlockSponge.BIRO.IRO}) &m : - `|Pr[RealIndif(Sponge, Perm, Dist).main() @ &m: res] - + `|Pr[RealIndif(Sponge, Perm, Dist).main() @ &m : res] - Pr[IdealIndif(IRO, RaiseSim(BlockSim), Dist).main() @ &m : res]| = `|Pr[BlockSponge.RealIndif (BlockSponge.Sponge, Perm, LowerDist(Dist)).main() @ &m : res] - From c00855117641fd2c6eea77313dd7928280645302 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Wed, 31 Aug 2016 11:13:40 -0400 Subject: [PATCH 226/525] A little more code documentation. Some more to follow. --- proof/Sponge.ec | 28 ++++++++++++++++++++++++++++ 1 file changed, 28 insertions(+) diff --git a/proof/Sponge.ec b/proof/Sponge.ec index 102db36..9583cb7 100644 --- a/proof/Sponge.ec +++ b/proof/Sponge.ec @@ -1778,6 +1778,8 @@ declare module Dist : DISTINGUISHER{Perm, BlockSim, IRO, BlockSponge.BIRO.IRO}. local clone HybridIRO as HIRO. +(* working toward the Real side of the top-level theorem *) + local lemma Sponge_Raise_BlockSponge_f : equiv[Sponge(Perm).f ~ RaiseFun(BlockSponge.Sponge(Perm)).f : ={bs, n, glob Perm} ==> ={res, glob Perm}]. @@ -1804,6 +1806,8 @@ auto; progress; by rewrite -cats1 blocks2bits_cat blocks2bits_sing. auto. qed. +(* the Real side of top-level theorem *) + local lemma RealIndif_Sponge_BlockSponge &m : Pr[RealIndif(Sponge, Perm, Dist).main() @ &m : res] = Pr[BlockSponge.RealIndif @@ -1816,6 +1820,11 @@ conseq Sponge_Raise_BlockSponge_f=> //. auto. qed. +(* working toward the Ideal side of the top-level theorem *) + +(* first step of Ideal side: express in terms of Experiment and + HIRO.HybridIROLazy *) + local lemma Ideal_IRO_Experiment_HybridLazy &m : Pr[IdealIndif(IRO, RaiseSim(BlockSim), Dist).main() @ &m : res] = Pr[Experiment @@ -1844,6 +1853,11 @@ by conseq HIRO.IRO_RaiseHybridIRO_HybridIROLazy_f. auto. qed. +(* working toward middle step of Ideal side: using Experiment, and + taking HIRO.HybridIROLazy to HIRO.HybridIROEager + + we will employ HIRO.HybridIROExper_Lazy_Eager *) + (* make a Hybrid IRO distinguisher from BlockSim and Dist (HI.f is used by BlockSim, and HI.g is used by HIRO.RaiseHybridIRO; HI.init is unused -- see the SIMULATOR module type) *) @@ -1857,6 +1871,8 @@ local module (HybridIRODist : HIRO.HYBRID_IRO_DIST) (HI : HIRO.HYBRID_IRO) = { } }. +(* initial bridging step *) + local lemma Experiment_HybridIROExper_Lazy &m : Pr[Experiment (HIRO.RaiseHybridIRO(HIRO.HybridIROLazy), BlockSim(HIRO.HybridIROLazy), @@ -1869,6 +1885,8 @@ swap{2} 1 1; wp; call (_ : true); auto. sim. qed. +(* final bridging step *) + local lemma HybridIROExper_Experiment_Eager &m : Pr[HIRO.HybridIROExper(HIRO.HybridIROEager, HybridIRODist).main() @ &m : res] = @@ -1882,6 +1900,9 @@ swap{2} 1 1; wp; call (_ : true); auto. sim. qed. +(* middle step of Ideal side: using Experiment, and taking HIRO.HybridIROLazy + to HIRO.HybridIROEager *) + local lemma Experiment_Hybrid_Lazy_Eager &m : Pr[Experiment (HIRO.RaiseHybridIRO(HIRO.HybridIROLazy), BlockSim(HIRO.HybridIROLazy), @@ -1895,6 +1916,8 @@ by rewrite (Experiment_HybridIROExper_Lazy &m) (HybridIROExper_Experiment_Eager &m). qed. +(* working toward last step of Ideal side *) + local lemma RaiseHybridIRO_HybridIROEager_RaiseFun_BlockIRO_f : equiv[HIRO.RaiseHybridIRO(HIRO.HybridIROEager).f ~ RaiseFun(BlockSponge.BIRO.IRO).f : @@ -1916,6 +1939,9 @@ by have [-> _] := gt0_n2_imp gt0_n2. have [-> ->] := not_vb_imp not_vb; by rewrite blocks2bits_nil. qed. +(* last step of Ideal side: express in terms of Experiment and + HIRO.HybridIROEager *) + local lemma Experiment_HybridEager_Ideal_BlockIRO &m : Pr[Experiment (HIRO.RaiseHybridIRO(HIRO.HybridIROEager), BlockSim(HIRO.HybridIROEager), @@ -1948,6 +1974,8 @@ conseq RaiseHybridIRO_HybridIROEager_RaiseFun_BlockIRO_f=> //. auto. qed. +(* the Ideal side of top-level theorem *) + local lemma IdealIndif_IRO_BlockIRO &m : Pr[IdealIndif(IRO, RaiseSim(BlockSim), Dist).main() @ &m : res] = Pr[BlockSponge.IdealIndif From d22a9cf40c37740250b4ce988014470455da2ddd Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Wed, 31 Aug 2016 12:42:15 +0100 Subject: [PATCH 227/525] Core.eca slightly more usable. --- proof/core/Core.eca | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) diff --git a/proof/core/Core.eca b/proof/core/Core.eca index cb39bc3..edf5fe1 100644 --- a/proof/core/Core.eca +++ b/proof/core/Core.eca @@ -29,6 +29,7 @@ theory Block. op zeror <- b0, op ( + ) <- (+^), op [ - ] (b : block) <- b + remove abbrev (-) proof *. realize addrA by exact/addbA. realize addrC by exact/addbC. @@ -155,10 +156,8 @@ module FC (F : FUNCTIONALITY) : FUNCTIONALITY = { proc f (p : block list) = { var b <- witness; - if (valid p) { - C.c <- C.c + size p; - b <@ F.f(p); - } + C.c <- C.c + size p; + b <@ F.f(p); return b; } }. @@ -192,7 +191,7 @@ module (DRestr (D : DISTINGUISHER) : DISTINGUISHER) }. (** Ideal Primitive **) -clone import RP as Perm with +clone export RP as Perm with type t <- block * capacity, op dt <- bdistr `*` cdistr rename @@ -286,6 +285,11 @@ module (S : SIMULATOR) (F : DFUNCTIONALITY) : PRIMITIVE = { } }. +(** Initial and Final Games **) +module GReal (D : DISTINGUISHER) = RealIndif(Core,PC(Perm),D). + +module GIdeal (D : DISTINGUISHER) = IdealIndif(ICore,S,D). + (*** PROOF ***) (** TODO -- This is not indifferentiability -- clean up and fix **) (** However, this is what's proven (modulo the additional validity From 5180605393a4e19e1c43976c6e676155371d49c3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Wed, 31 Aug 2016 13:56:37 +0100 Subject: [PATCH 228/525] Old stuff. --- proof/attic/LeakyAbsorb.ec | 416 +++++++++++++++++++++++++++++++++++++ 1 file changed, 416 insertions(+) create mode 100644 proof/attic/LeakyAbsorb.ec diff --git a/proof/attic/LeakyAbsorb.ec b/proof/attic/LeakyAbsorb.ec new file mode 100644 index 0000000..8f03201 --- /dev/null +++ b/proof/attic/LeakyAbsorb.ec @@ -0,0 +1,416 @@ +(* -------------------------------------------------------------------- *) +require import Option Pair Int Real Distr List FSet NewFMap DProd. +require (*--*) LazyRP RndOrcl. + +(* -------------------------------------------------------------------- *) + +type block. (* = {0,1}^r *) +type capacity. (* = {0,1}^c *) + +op cdist : capacity distr. +op bdist : block distr. +axiom bdist_ll : weight bdist = 1%r. + +(* isomorphic to the {0,1}^? uniform distributions *) + +op b0 : block. +op c0 : capacity. + +op (^) : block -> block -> block. + +(* -------------------------------------------------------------------- *) +clone import LazyRP as Perm with + type D <- block * capacity, + op d <- bdist `*` cdist + + rename [module] "P" as "Perm". + + +(* -------------------------------------------------------------------- *) +module type WeirdIRO = { + proc init(): unit + + proc f(_: block list * int): block list +}. + +module type WeirdIRO_ = { + proc f(_: block list * int): block list +}. + +op valid_query : block list -> int -> bool. +op valid_queries : (block list) fset. +axiom valid_queryP : forall m n, valid_query m n => forall k, 0 <= k <= n => mem valid_queries (m ++ mkseq (fun x => b0) k). +axiom valid_query_take : forall m n, valid_query m n => forall i, 0 <= i <= size m => mem valid_queries (take i m). +axiom valid_query_take1 : + forall m n, valid_query m n => forall i, 0 <= i <= size m => valid_query (take i m) 1. +axiom valid_query_size : forall m n, valid_query m n => 1 <= size m. + +module type RO = { + proc init () : unit + proc f(_:block list) : block +}. + +module Ro = { + var h : (block list,block) fmap + + proc init() = { h = map0; } + + proc f(m : block list) = { + var r; + r <$ bdist; + if (!mem (dom h) m) h.[m] <- r ; + return oget h.[m]; + } +}. + +module GenIdealFunctionalityThatDoesNotAbsorb(Ro:RO) = { + proc init = Ro.init + + proc f(m : block list, n : int) = { + var i <- 1; + var j <- 1; + var z <- []; + var b <- b0; + + if (valid_query m n) { + while (j <= size m) { + z <- rcons z b; + b <@ Ro.f(take j m); + j <- j + 1; + } + while (i < n) { + z <- rcons z b; + m <- rcons m b0; + b <@ Ro.f(m); + i <- i + 1; + } + } + return z; + } +}. + +module IdealFunctionalityThatDoesNotAbsorb = GenIdealFunctionalityThatDoesNotAbsorb(Ro). + +module GenIdealFunctionalityThatAbsorbs(Ro:RO) = { + proc init = Ro.init + + proc f(m : block list, n : int) = { + var i <- 1; + var z <- []; + var b; + + if (valid_query m n) { + b <@ Ro.f(m); + while (i < n) { + z <- rcons z b; + m <- rcons m b0; + b <@ Ro.f(m); + i<- i + 1; + } + } + return z; + } +}. + +module IdealFunctionalityThatAbsorbs = GenIdealFunctionalityThatAbsorbs(Ro). + +(* -------------------------------------------------------------------- *) +module type CONSTRUCTION(P : RP) = { + proc init() : unit + + proc f(bp : block list, n : int) : block list +}. + +module type SIMULATOR(F : WeirdIRO_) = { + proc init() : unit + + proc f(_ : block * capacity) : block * capacity + + proc fi(_ : block * capacity) : block * capacity +}. + +module type DISTINGUISHER(F : WeirdIRO_, P : RP_) = { + proc distinguish() : bool +}. + +(* -------------------------------------------------------------------- *) +module Experiment(F : WeirdIRO, P : RP, D : DISTINGUISHER) = { + proc main() : bool = { + var b; + + F.init(); + P.init(); + b <@ D(F, P).distinguish(); + + return b; + } +}. + +(* -------------------------------------------------------------------- *) +module SpongeThatDoesNotAbsorb (P : RP) : WeirdIRO, CONSTRUCTION(P) = { + proc init () = { } + + proc f(p : block list, n : int): block list = { + var z <- []; + var (sa,sc) <- (b0, c0); + var i <- 0; + var l <- size p; + + if (valid_query p n) { + (* Absorption *) + while (p <> []) { + z <- rcons z sa; + (sa,sc) <@ P.f(sa ^ head b0 p, sc); + p <- behead p; + } + (* Squeezing *) + while (i < n) { + z <- rcons z sa; + (sa,sc) <@ P.f(sa,sc); + } + } + + return z; + } +}. + +module SpongeThatAbsorbs (P : RP) : WeirdIRO, CONSTRUCTION(P) = { + proc init () = {} + + proc f(p : block list, n : int): block list = { + var z <- []; + var (sa,sc) <- (b0, c0); + var i <- 0; + + if (valid_query p n) { + (* Absorption *) + while (p <> []) { + (sa,sc) <@ P.f(sa ^ head b0 p, sc); + p <- behead p; + } + (* Squeezing *) + while (i < n) { + z <- rcons z sa; + (sa,sc) <@ P.f(sa,sc); + } + } + + return z; + } +}. + +(* -------------------------------------------------------------------- *) +section PROOF. + declare module S:SIMULATOR { IdealFunctionalityThatDoesNotAbsorb }. + declare module D:DISTINGUISHER { Perm, IdealFunctionalityThatDoesNotAbsorb, S }. + + (* From DoNot to Absorb *) + + module MkF(F:WeirdIRO_) = { + proc f(m:block list, n:int) = { + var r = []; + if (valid_query m n) { + r <@ F.f(m,n); + r <- drop (size m) r; + } + return r; + } + }. + + (* From Absord to do Not *) + module MkD (D:DISTINGUISHER, F:WeirdIRO_, P:RP_) = D(MkF(F),P). + + module MkFdoNot1 (F:WeirdIRO_) = { + proc f(m:block list, n:int) : block list = { + var i, r, tl, b; + r <- []; + if (valid_query m n) { + i <- 1; + b <- [b0]; + while (i <= size m) { + r <- r ++ b; + b <- F.f(take i m, 1); + i <- i + 1; + + } + tl <- F.f(m,n); + r <- r ++ tl; + } + return r; + } + }. + + module MkFdoNot (F:WeirdIRO) = { + proc init = F.init + proc f = MkFdoNot1(F).f + }. + + module MkS(S:SIMULATOR, F:WeirdIRO) = S(MkFdoNot(F)). + + local clone RndOrcl as RndOrcl0 with + type from <- block list, + type to <- block. + + local clone RndOrcl0.RestrIdeal as RI with + op sample <- fun (bl:block list) => bdist, + op test <- (mem valid_queries), + op univ <- valid_queries, + op dfl <- b0 + proof *. + realize sample_ll. by move=> _;apply bdist_ll. qed. + realize testP. by []. qed. + import RI. + + local module E1 (Ro:RO) = { + module F = { + proc f = GenIdealFunctionalityThatDoesNotAbsorb(Ro).f + } + module P = S(F) + proc distinguish () : bool = { + var b; + P.init(); + b <@ MkD(D, F, P).distinguish(); + return b; + } + }. + + local module E2 (Ro:RO) = { + module F = { + proc f = GenIdealFunctionalityThatAbsorbs(Ro).f + } + module P = S(MkFdoNot1(F)) + proc distinguish () : bool = { + var b; + P.init(); + b <@ D(F, P).distinguish(); + return b; + } + }. + + local equiv f_f : + GenIdealFunctionalityThatDoesNotAbsorb(Ro).f ~ E1(Restr(RO)).F.f : + ={m, n} /\ Ro.h{1} = RO.m{2} ==> ={res} /\ Ro.h{1} = RO.m{2}. + proof. + proc;sp;if => //. + inline{2} Restr(RO).f. + while (={z,i,n,b,m} /\ Ro.h{1} = RO.m{2} /\ + (forall k, 0 <= k <= n - i => mem valid_queries (m ++ map (fun x => b0) (iota_ 0 k))){2}). + + rcondt{2} 5=> //. + + auto;progress; rewrite - cats1;cut := H 1 _; [by smt| by rewrite iota1]. + auto; call (_:Ro.h{1} = RO.m{2});[by sim | auto;progress]. + cut := H (k+1) _;1:by smt. + rewrite iotaS //= -cats1 -catA /= (_: map (fun (x : int) => b0) (iota_ 1 k) = map (fun (x : int) => b0) (iota_ 0 k)) //. + by rewrite (iota_addl 1 0 k) -map_comp;apply eq_map. + while (={z,j,n,b,m} /\ Ro.h{1} = RO.m{2} /\ valid_query m{1} n{1} /\ 0 <= j{1}). + + rcondt{2} 4=> //. + + auto;progress;apply (valid_query_take _ _ H)=> //. + auto; call (_:Ro.h{1} = RO.m{2});[by sim | auto;progress;smt]. + skip;progress;apply (valid_queryP _ _ H2);smt. + qed. + + local equiv f_f_a : GenIdealFunctionalityThatAbsorbs(Ro).f ~ E2(Restr(RO)).F.f : ={m,n} /\ Ro.h{1} = RO.m{2} ==> ={res} /\ Ro.h{1} = RO.m{2}. + proof. + proc; sp;if=> //;inline{2} Restr(RO).f;sp. + rcondt{2} 1=> //. + + auto;progress;cut := valid_query_take _ _ H (size m{hr}). + rewrite take_size=> HH;apply HH;smt. + while (={z,i,n,b,m} /\ Ro.h{1} = RO.m{2} /\ + (forall k, 0 <= k <= n - i => mem valid_queries (m ++ map (fun x => b0) (iota_ 0 k))){2}). + + rcondt{2} 5=> //. + + auto;progress; rewrite -cats1;cut := H 1 _; [by smt| by rewrite iota1]. + auto; call (_:Ro.h{1} = RO.m{2});[by sim | auto;progress]. + cut := H (k+1) _;1:by smt. + rewrite iotaS //= -cats1 -catA /= (_: map (fun (x : int) => b0) (iota_ 1 k) = map (fun (x : int) => b0) (iota_ 0 k)) //. + by rewrite (iota_addl 1 0 k) -map_comp;apply eq_map. + wp;call (_:Ro.h{1} = RO.m{2});[by sim | auto;progress]. + apply (valid_queryP _ _ H);smt. + qed. + + local equiv f_f' : + MkFdoNot(GenIdealFunctionalityThatAbsorbs(Ro)).f ~ MkFdoNot1(E2(Restr(RO)).F).f : + ={m, n} /\ Ro.h{1} = RO.m{2} ==> + ={res} /\ Ro.h{1} = RO.m{2}. + proof. + proc;sp;if => //;wp. + call f_f_a. + while (={i,m,r,b} /\ Ro.h{1} = RO.m{2} /\ valid_query m{1} n{1} /\ 0 <= i{1});last by auto. + wp; call f_f_a;auto;progress;smt. + qed. + + local equiv f_dN : E1(ERO).F.f ~ MkFdoNot1(E2(ERO).F).f : ={m, n} /\ ={RO.m} ==> ={res, RO.m}. + proof. + proc;sp;if=> //;sp. + inline {2} E2(ERO).F.f. + rcondt{2} 6;auto; 1: by conseq (_: _ ==> true). + while (={RO.m} /\ z{1} = r{2} ++ z0{2} /\ i{1} = i1{2} /\ n{1} = n1{2} /\ b{1} = b1{2} /\ + m{1} = m1{2}). + + inline *;auto;progress;smt. + inline ERO.f;auto. + while (={RO.m,m,n} /\ z{1} = r{2} /\ b{2} = [b{1}] /\ valid_query m{1} n{1} /\ + j{1} = i{2} /\ 0 <= i{2} /\ + (1 < j => b = mem valid_queries (take j m) ? oget RO.m.[x] : Self.b0){1}). + + rcondt{2} 6;1:by auto;progress;smt. + rcondf{2} 8;1:by auto. + auto;progress;smt. + auto;progress;smt. + qed. + + lemma conclusion &m: + `| Pr[Experiment(SpongeThatDoesNotAbsorb(Perm), Perm, MkD(D)).main() @ &m : res] + - Pr[Experiment(IdealFunctionalityThatDoesNotAbsorb, + S(IdealFunctionalityThatDoesNotAbsorb), MkD(D)).main() @ &m : res] | = + `|Pr[Experiment(SpongeThatAbsorbs(Perm),Perm,D).main() @ &m : res] + - Pr[Experiment(IdealFunctionalityThatAbsorbs, MkS(S,IdealFunctionalityThatAbsorbs), D).main() @ &m : res]|. + proof. + do 3?congr. + + byequiv (_: ={glob D} ==> _) => //;proc;inline *. + call (_: ={glob Perm});1,2:(by sim); last by auto. + proc;inline{1}SpongeThatDoesNotAbsorb(Perm).f;sp 1 3;if=> //. + sp;rcondt{1} 1=> //;wp. + while (={glob Perm, i, sa, sc} /\ n0{1} = n{2} /\ z{1} = take (size m{1}) z{1} ++ z{2} /\ size m{1} <= size z{1}). + + call (_ : ={glob Perm});[by sim|auto;progress [-split];smt]. + while (={glob Perm, p, sa,sc} /\ (size z = size m - size p){1}). + + wp;call (_ : ={glob Perm});[by sim|auto;progress [-split]]. + by rewrite size_rcons H; move: H0; case: (p{2})=> //= x xs; ring. + by auto;progress [-split];smt. + cut -> : Pr[Experiment(IdealFunctionalityThatDoesNotAbsorb, S(IdealFunctionalityThatDoesNotAbsorb), MkD(D)).main () @ &m : res] = + Pr[RndOrcl0.IND(Restr(RO), E1).main() @ &m : res]. + + byequiv=> //. (* PY: BUG printer res *) + proc;inline{2} E1(Restr(RO)).distinguish;auto. + call (_: ={glob S} /\ Ro.h{1} = RO.m{2}). + + by proc (Ro.h{1} = RO.m{2}) => //;apply f_f. + + by proc (Ro.h{1} = RO.m{2}) => //;apply f_f. + + by proc;sp;if=> //;wp;call f_f. + by inline *; call (_: Ro.h{1} = RO.m{2});auto;apply f_f. + cut -> : Pr[Experiment(IdealFunctionalityThatAbsorbs, MkS(S, IdealFunctionalityThatAbsorbs), D).main() @ &m : res] = + Pr[RndOrcl0.IND(Restr(RO), E2).main() @ &m : res]. + + byequiv=> //. + proc;inline{2} E2(Restr(RO)).distinguish;auto. + call (_: ={glob S} /\ Ro.h{1} = RO.m{2}). + + proc (Ro.h{1} = RO.m{2}) => //; apply f_f'. + + by proc (Ro.h{1} = RO.m{2}) => //;apply f_f'. + + conseq f_f_a => //. + by inline *;call (_:Ro.h{1} = RO.m{2});[apply f_f'|auto]. + cut -> : Pr[RndOrcl0.IND(Restr(RO), E1).main() @ &m : res] = + Pr[RndOrcl0.IND(ERO, E1).main() @ &m : res]. + + byequiv (Eager E1)=> //. + cut -> : Pr[RndOrcl0.IND(Restr(RO), E2).main() @ &m : res] = + Pr[RndOrcl0.IND(ERO, E2).main() @ &m : res]. + + byequiv (Eager E2)=> //. + byequiv=> //. + proc; inline *;wp. + call (_: ={RO.m, glob S}). + + by proc (={RO.m})=> //;apply f_dN. + + by proc (={RO.m})=> //;apply f_dN. + + proc;sp;if => //. + inline{1} E1(ERO).F.f;sp;rcondt{1} 1; 1:by auto. + wp;while (={RO.m,i,b} /\ n0{1} = n{2} /\ m0{1} = m{2} /\ z{1} = take (size m{1}) z{1} ++ z{2} /\ (size m <= size z){1}). + + inline *;auto;progress [-split]; smt. + inline *;splitwhile{1} 1 : (j < size m0). + wp;seq 1 0 : (={i,RO.m, m, glob S} /\ n0{1} = n{2} /\ m0{1} = m{2} /\ size m0{1} - 1 = size z{1} /\ size m0{1} = j{1} /\ z{2} = []). + while{1} (size z{1} = j{1} - 1 /\ j{1} <= size m0{1}) ((size m0 - j){1});auto;progress [-split]; smt. + rcondt{1} 1;1:by auto. + rcondf{1} 5;auto;progress[-split];smt. + call (_: ={RO.m})=> //;1:by apply f_dN. + sim : (={glob S, glob D, RO.m})=> //. + qed. From dca81a129cc8131c0e4a94500ef05730212d03d4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Wed, 31 Aug 2016 17:53:43 +0100 Subject: [PATCH 229/525] Clean trasnfer of Indifferentiability from to by injective extension. In theory, axioms on valid, extend, strip are minimal --- proof/{core => clean}/Core.eca | 4 +- proof/clean/CoreExtension.eca | 417 +++++++++++++++++++++++++++++++++ 2 files changed, 419 insertions(+), 2 deletions(-) rename proof/{core => clean}/Core.eca (99%) create mode 100644 proof/clean/CoreExtension.eca diff --git a/proof/core/Core.eca b/proof/clean/Core.eca similarity index 99% rename from proof/core/Core.eca rename to proof/clean/Core.eca index edf5fe1..29d1fa3 100644 --- a/proof/core/Core.eca +++ b/proof/clean/Core.eca @@ -154,7 +154,7 @@ module FC (F : FUNCTIONALITY) : FUNCTIONALITY = { proc init = F.init proc f (p : block list) = { - var b <- witness; + var b <- b0; C.c <- C.c + size p; b <@ F.f(p); @@ -222,7 +222,7 @@ module ICore: FUNCTIONALITY = { } proc f(p : block list): block = { - var r <- witness; + var r <- b0; if (valid p) { if (!mem (dom m) p) { diff --git a/proof/clean/CoreExtension.eca b/proof/clean/CoreExtension.eca new file mode 100644 index 0000000..87cdc7b --- /dev/null +++ b/proof/clean/CoreExtension.eca @@ -0,0 +1,417 @@ +pragma -oldip. pragma +implicits. +require import Pred Fun Option Pair Int Real List FSet NewFMap NewDistr. +require import StdOrder Ring DProd. +(*---*) import IntOrder. + +require (*..*) RP Indifferentiability. + +(*** THEORY PARAMETERS ***) +(** Block/Rate **) +theory Block. + op r : int. + axiom r_ge0: 0 <= r. + + type block. + + op b0: block. + op (+^): block -> block -> block. + + axiom addbA b1 b2 b3: b1 +^ (b2 +^ b3) = b1 +^ b2 +^ b3. + axiom addbC b1 b2: b1 +^ b2 = b2 +^ b1. + axiom add0b b: b0 +^ b = b. + axiom addbK b: b +^ b = b0. + + op blocks: block list. + axiom blocks_spec b: count (pred1 b) blocks = 1. + axiom card_block: size blocks = 2^r. + + clone import Ring.ZModule as BlockMonoid with + type t <- block, + op zeror <- b0, + op ( + ) <- (+^), + op [ - ] (b : block) <- b + remove abbrev (-) + proof *. + realize addrA by exact/addbA. + realize addrC by exact/addbC. + realize add0r by exact/add0b. + realize addNr by exact/addbK. + + clone import MFinite as DBlock with + type t <- block, + op Support.enum <- blocks + rename "dunifin" as "bdistr" + "duniform" as "bdistr" + proof *. + realize Support.enum_spec by exact/blocks_spec. +end Block. +import Block DBlock. + +(** Capacity **) +theory Capacity. + op c : int. + axiom c_ge0: 0 <= c. + + type capacity. + + op c0: capacity. + + op caps: capacity list. + axiom caps_spec b: count (pred1 b) caps = 1. + axiom card_capacity: size caps = 2^c. + + clone import MFinite as DCapacity with + type t <- capacity, + op Support.enum <- caps + rename "dunifin" as "cdistr" + "duniform" as "cdistr" + proof *. + realize Support.enum_spec by exact/caps_spec. +end Capacity. +import Capacity DCapacity. + +(** Validity of Functionality Queries and Partial Bijection **) +op valid: block list -> bool. + +op extend: block list -> int -> block list. +op strip: block list -> (block list * int). + +axiom stripK bs: extend (strip bs).`1 (strip bs).`2 = bs. +axiom extendK bs n: 0 <= n => valid bs => strip (extend bs n) = (bs,n). + +lemma injective_strip: injective strip. +proof. +by move=> bs1 bs2 eq_strip; rewrite -stripK eq_strip; exact/(@stripK bs2). +qed. + +(** Adversary's Query Cost **) +op max_query: int. +axiom max_query_ge0: 0 <= max_query. + +(*** DEFINITIONS ***) +type state = block * capacity. +op dstate = bdistr `*` cdistr. + +(** Indifferentiability Experiment **) +clone include Indifferentiability with + type p <- state, + type f_in <- block list * int, + type f_out <- block + rename [module] "GReal" as "RealIndif" + [module] "GIdeal" as "IdealIndif". + +(** Query Counting **) +module C = { + var c:int + proc init() = { c <- 0; } +}. + +module PC (P : PRIMITIVE) : PRIMITIVE = { + proc init () = { + C.init(); + P.init(); + } + + proc f (x : state) = { + var y; + + C.c <- C.c + 1; + y <@ P.f(x); + return y; + } + + proc fi(x : state) = { + var y; + + C.c <- C.c + 1; + y <@ P.fi(x); + return y; + } +}. + +module DPRestr (P : DPRIMITIVE) : DPRIMITIVE = { + proc f (x : state) = { + var y <- (b0,c0); + + if (C.c + 1 <= max_query) { + C.c <- C.c + 1; + y <@ P.f(x); + } + return y; + } + + proc fi(x : state) = { + var y <- (b0,c0); + + if (C.c + 1 <= max_query) { + C.c <- C.c + 1; + y <@ P.fi(x); + } + return y; + } +}. + +module PRestr (P : PRIMITIVE) : PRIMITIVE = { + proc init () = { + C.init(); + P.init(); + } + + proc f = DPRestr(P).f + proc fi = DPRestr(P).fi +}. + +module FC (F : FUNCTIONALITY) : FUNCTIONALITY = { + proc init = F.init + + proc f (p : block list, n : int) = { + var b <- b0; + + C.c <- C.c + size p; + b <@ F.f(p,n); + return b; + } +}. + +module DFRestr (F : DFUNCTIONALITY) : DFUNCTIONALITY = { + proc f (p : block list, n : int) = { + var b <- b0; + + if (C.c + size p <= max_query) { + C.c <- C.c + size p; + b <@ F.f(p, n); + } + return b; + } +}. + +module FRestr(F : FUNCTIONALITY) : FUNCTIONALITY = { + proc init = F.init + proc f = DFRestr(F).f +}. + +module (DRestr (D : DISTINGUISHER) : DISTINGUISHER) + (F : DFUNCTIONALITY) (P : DPRIMITIVE) = { + proc distinguish() = { + var b; + + C.init(); + b <@ D(DFRestr(F), DPRestr(P)).distinguish(); + return b; + } +}. + +(** Core Extension Construction **) +module (CoreExtension : CONSTRUCTION) (P:DPRIMITIVE): FUNCTIONALITY = { + proc init () = {} + + proc f(p : block list, n : int): block = { + var (sa,sc) <- (b0,c0); + + if (valid p /\ 0 <= n) { + p <- extend p n; + while (p <> []) { + (sa,sc) <@ P.f((sa +^ head witness p,sc)); + p <- behead p; + } + } + return sa; + } +}. + +(** Ideal Core Extension Functionality **) +module ICoreExtension: FUNCTIONALITY = { + var m : (block list * int,block) fmap + + proc init() = { + m = map0; + } + + proc f(p : block list, n : int): block = { + var r <- b0; + + if (valid p /\ 0 <= n) { + if (!mem (dom m) (p,n)) { + m.[(p,n)] <$ bdistr; + } + r <- oget m.[(p,n)]; + } + return r; + } +}. + +(** Initial and Final Games **) +module GReal (D : DISTINGUISHER, P : PRIMITIVE) = RealIndif(CoreExtension,P,D). + +module GIdeal (D : DISTINGUISHER, S : SIMULATOR) = IdealIndif(ICoreExtension,S,D). + +(*** PROOF ***) +require (*--*) Core. + +section PROOF. + local clone Core as CoreSim with + op Block.r <- r, + type Block.block <- block, + op Block.b0 <- b0, + op Block.(+^) <- (+^), + op Block.enum <- blocks, + op Capacity.c <- c, + type Capacity.capacity <- capacity, + op Capacity.c0 <- c0, + op Capacity.enum <- caps, + op max_query <- max_query, + op valid (bs) <- valid (strip bs).`1 /\ 0 <= (strip bs).`2 + proof *. + realize Block.r_ge0 by exact/r_ge0. + realize Block.addbA by exact/addbA. + realize Block.addbC by exact/addbC. + realize Block.add0b by exact/add0b. + realize Block.addbK by exact/addbK. + realize Block.block_enum by exact/blocks_spec. + realize Block.card_block by exact/card_block. + realize Capacity.c_ge0 by exact/c_ge0. + realize Capacity.capacity_enum by exact/caps_spec. + realize Capacity.card_capacity by exact/card_capacity. + realize valid_not_nil by admit. + realize max_query_ge0 by exact/max_query_ge0. + + (** Simulator and Distinguisher constructions **) + module (RaiseSim (S : CoreSim.SIMULATOR) : SIMULATOR) + (F : DFUNCTIONALITY) = { + module LowerF = { + proc f(p : block list) = { + var n, b; + + (p,n) <- strip p; + b <@ F.f(p,n); + return b; + } + } + + proc init = S(LowerF).init + proc f = S(LowerF).f + proc fi = S(LowerF).fi + }. + + module (LowerDist (D : DISTINGUISHER) : CoreSim.DISTINGUISHER) + (F : CoreSim.DFUNCTIONALITY) (P : CoreSim.DPRIMITIVE) = { + module RaiseF = { + proc f(p : block list, n : int) = { + var b <- b0; + + if (valid p /\ 0 <= n) { + p <- extend p n; + b <@ F.f(p); + } + return b; + } + } + + proc distinguish = D(RaiseF,P).distinguish + }. + + declare module D : DISTINGUISHER { CoreSim.Core, CoreSim.Perm.Perm, CoreSim.ICore, CoreSim.S, CoreSim.C, ICoreExtension }. + + local lemma LiftIndif &m: + `| Pr[CoreSim.GReal(LowerDist(D)).main() @ &m: res] + - Pr[CoreSim.GIdeal(LowerDist(D)).main() @ &m: res] | + = `| Pr[GReal(D,CoreSim.Perm.Perm).main() @ &m: res] + - Pr[GIdeal(D,RaiseSim(CoreSim.S)).main() @ &m: res] |. + proof. + do !congr. + + byequiv (_: ={glob D} ==> _)=> //; proc. + seq 2 2: (={glob CoreSim.Perm.Perm, glob D}). + + by inline *; auto. + call (_: ={glob CoreSim.Perm.Perm})=> //. + + by proc; inline{1} 2; wp; sim. + + by proc; inline{1} 2; wp; sim. + proc; sp; if=> //=. inline{1} 2; wp. + while (={glob CoreSim.Perm.Perm, sa, sc} /\ p0{1} = p{2}); auto. + by inline *; sp; if=> //=; auto. + byequiv (_: ={glob CoreSim.S, glob D} ==> _)=> //; proc. + seq 2 2: ( ={glob D, glob CoreSim.S} + /\ (forall p n, + mem (dom ICoreExtension.m) (p,n) + => valid p + /\ 0 <= n){2} + /\ (forall p n, valid p => 0 <= n => + ICoreExtension.m.[(p,n)]{2} = CoreSim.ICore.m.[extend p n]{1})). + + by inline *; auto; smt (in_dom map0P). + call (_: ={glob CoreSim.S} + /\ (forall p n, + mem (dom ICoreExtension.m) (p,n) + => valid p + /\ 0 <= n){2} + /\ (forall p n, valid p => 0 <= n => + ICoreExtension.m.[(p,n)]{2} = CoreSim.ICore.m.[extend p n]{1}))=> //. + + proc; if=> //=; last by auto. + if=> //=. + + rcondt{1} 7=> [&m0|]. + + inline *; sp; if=> //=; last by auto; smt (bdistr_ll). + if=> //=; last by auto; smt (bdistr_ll). + by auto; smt (bdistr_ll cdistr_ll). + rcondt{2} 7=> [&m0|]. + + inline *; sp; if=> //=; last by auto; smt (bdistr_ll). + if=> //=; last by auto; smt (bdistr_ll). + by auto; smt (bdistr_ll cdistr_ll). + auto; sp. + conseq (_: ={x, p, v, glob CoreSim.S} + /\ CoreSim.S.pi.[x.`2]{2} = Some (p,v){2} + /\ CoreSim.S.m.[x]{1} = None + /\ (forall p n, + mem (dom ICoreExtension.m) (p,n) + => valid p + /\ 0 <= n){2} + /\ (forall p n, valid p => 0 <= n => + ICoreExtension.m.[(p,n)]{2} = CoreSim.ICore.m.[extend p n]{1}) + ==> ={glob CoreSim.S, y1, p, v, x} + /\ (forall p n, + mem (dom ICoreExtension.m) (p,n) + => valid p + /\ 0 <= n){2} + /\ (forall p n, valid p => 0 <= n => + ICoreExtension.m.[(p,n)]{2} = CoreSim.ICore.m.[extend p n]{1}))=> //. + + auto=> /> &1 &2 ^pv_def <- [#] <*> h1 h2; rewrite !in_dom=> /= -> /=. + by case: (CoreSim.S.pi.[x.`2]{2}) pv_def=> //= x @/oget /=. + inline *; sp; if=> //=. + + by move=> /> &1 &2; case: (strip (rcons p (v +^ x.`1)){2})=> p' n' [#] !->>. + if=> //=. + + move=> /> &1 &2; case _: (strip (rcons p (v +^ x.`1)){2})=> p' n' h_def [#] !->>. + move=> _ _ h1 h2 /= valid_p ge0_n; rewrite !in_dom. + rewrite h2 //. + have ->: p' = (strip (rcons p (v +^ x.`1)){2}).`1 by rewrite h_def. + have ->: n' = (strip (rcons p (v +^ x.`1)){2}).`2 by rewrite h_def. + by rewrite (@stripK (rcons p (v +^ x.`1)){2}). + + auto=> /> &1 &2; case _: (strip (rcons p (v +^ x.`1)){2})=> p' n' h_def [#] !->>. + move=> pi_x2 m_x h1 h2 /= valid_p n_ge0; rewrite in_dom=> /= m_pvx1. + move=> _ b _ _; rewrite getP /= oget_some getP /= oget_some /=; split. + + move=> p n; rewrite in_dom getP; case ((p,n) = (p',n'))=> //= _. + by rewrite -in_dom=> /h1. + move=> p0 n0 valid_p' n'_ge0; rewrite !getP h2 // -h_def. + case: (extend p0 n0 = (rcons p (v +^ x.`1)){2})=> //=. + + by rewrite -extendK=> // ->. + case: ((p0,n0) = (strip (rcons p (v +^ x.`1))){2})=> //=. + smt (stripK). + + auto=> /> &1 &2; case _: (strip (rcons p (v +^ x.`1)){2})=> p' n' h_def [#] !->>. + by move=> _ _ h1 h2 /= valid_p' n'_ge0 _; rewrite h2 //; smt (stripK). + by auto. + rcondf{1} 6; 1:by auto. + rcondf{2} 6; 1:by auto. + by auto. + + by proc; if=> //=; auto. + proc; sp; if=> //=; inline{1} 2. + rcondt{1} 4; 1:auto. + + by move=> &hr [#] !->> h1 h2 valid_p n_ge0 /=; rewrite extendK. + sp; if=> //=. + + by move=> /> &1 &2 h1 h2 valid_p n_ge0; rewrite !in_dom h2 // -extendK. + + auto=> /> &1 &2 h1 h2 valid_p n_ge0; rewrite in_dom=> /= ^extend_pn_notin_m. + rewrite -h2=> // pn_notin_m _ b _ _; rewrite 2!getP /=; split. + + move=> p' n'; rewrite in_dom getP; case ((p',n') = (p{2},n{2}))=> //= _. + by rewrite -in_dom=> /h1. + move=> p0 m0 valid_p0 n0_ge0; rewrite !getP h2 // -!extendK //. + case: (extend p0 m0 = extend p{2} n{2})=> [->|] //. + by have /contra H /H ->:= (injective_strip (extend p0 m0) (extend p{2} n{2})). + by auto=> /> &1 &2 h1 h2 valid_p n_ge0 _; rewrite -h2. + qed. + +end section PROOF. From 4bddf4472e5b76437988f49bd7d7170905b5b007 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Thu, 1 Sep 2016 10:49:00 +0100 Subject: [PATCH 230/525] Figuring out abstract gluing: adding query counters. --- proof/clean/Core.eca | 177 +++++++++--------- proof/clean/CoreExtension.eca | 302 ++++++++++++++++++++----------- proof/core/CoreToBlockSponge.eca | 23 ++- 3 files changed, 302 insertions(+), 200 deletions(-) diff --git a/proof/clean/Core.eca b/proof/clean/Core.eca index 29d1fa3..5302fc9 100644 --- a/proof/clean/Core.eca +++ b/proof/clean/Core.eca @@ -90,105 +90,109 @@ clone include Indifferentiability with [module] "GIdeal" as "IdealIndif". (** Query Counting **) -module C = { - var c:int - proc init() = { c <- 0; } -}. - -module PC (P : PRIMITIVE) : PRIMITIVE = { - proc init () = { - C.init(); - P.init(); - } - - proc f (x : state) = { - var y; - - C.c <- C.c + 1; - y <@ P.f(x); - return y; - } - - proc fi(x : state) = { - var y; - - C.c <- C.c + 1; - y <@ P.fi(x); - return y; - } -}. +theory Counting. + module C = { + var c:int + proc init() = { c <- 0; } + }. + + module PC (P : PRIMITIVE) : PRIMITIVE = { + proc init () = { + C.init(); + P.init(); + } -module DPRestr (P : DPRIMITIVE) : DPRIMITIVE = { - proc f (x : state) = { - var y <- (b0,c0); + proc f (x : state) = { + var y; - if (C.c + 1 <= max_query) { C.c <- C.c + 1; y <@ P.f(x); + return y; } - return y; - } - proc fi(x : state) = { - var y <- (b0,c0); + proc fi(x : state) = { + var y; - if (C.c + 1 <= max_query) { C.c <- C.c + 1; y <@ P.fi(x); + return y; } - return y; - } -}. + }. -module PRestr (P : PRIMITIVE) : PRIMITIVE = { - proc init () = { - C.init(); - P.init(); - } + module DPRestr (P : DPRIMITIVE) : DPRIMITIVE = { + proc f (x : state) = { + var y <- (b0,c0); - proc f = DPRestr(P).f - proc fi = DPRestr(P).fi -}. + if (C.c + 1 <= max_query) { + C.c <- C.c + 1; + y <@ P.f(x); + } + return y; + } -module FC (F : FUNCTIONALITY) : FUNCTIONALITY = { - proc init = F.init + proc fi(x : state) = { + var y <- (b0,c0); - proc f (p : block list) = { - var b <- b0; + if (C.c + 1 <= max_query) { + C.c <- C.c + 1; + y <@ P.fi(x); + } + return y; + } + }. - C.c <- C.c + size p; - b <@ F.f(p); - return b; - } -}. + module PRestr (P : PRIMITIVE) : PRIMITIVE = { + proc init () = { + C.init(); + P.init(); + } + + proc f = DPRestr(P).f + proc fi = DPRestr(P).fi + }. + + module FC (F : FUNCTIONALITY) : FUNCTIONALITY = { + proc init = F.init -module DFRestr (F : DFUNCTIONALITY) : DFUNCTIONALITY = { - proc f (bs : block list) = { - var b <- b0; + proc f (p : block list) = { + var b <- b0; - if (C.c + size bs <= max_query) { - C.c <- C.c + size bs; - b <@ F.f(bs); + if (valid p) { + C.c <- C.c + size p; + b <@ F.f(p); + } + return b; } - return b; - } -}. + }. -module FRestr(F : FUNCTIONALITY) : FUNCTIONALITY = { - proc init = F.init - proc f = DFRestr(F).f -}. + module DFRestr (F : DFUNCTIONALITY) : DFUNCTIONALITY = { + proc f (bs : block list) = { + var b <- b0; -module (DRestr (D : DISTINGUISHER) : DISTINGUISHER) - (F : DFUNCTIONALITY) (P : DPRIMITIVE) = { - proc distinguish() = { - var b; + if (valid bs /\ C.c + size bs <= max_query) { + C.c <- C.c + size bs; + b <@ F.f(bs); + } + return b; + } + }. - C.init(); - b <@ D(DFRestr(F), DPRestr(P)).distinguish(); - return b; - } -}. + module FRestr(F : FUNCTIONALITY) : FUNCTIONALITY = { + proc init = F.init + proc f = DFRestr(F).f + }. + + module (DRestr (D : DISTINGUISHER) : DISTINGUISHER) + (F : DFUNCTIONALITY) (P : DPRIMITIVE) = { + proc distinguish() = { + var b; + + C.init(); + b <@ D(DFRestr(F), DPRestr(P)).distinguish(); + return b; + } + }. +end Counting. (** Ideal Primitive **) clone export RP as Perm with @@ -284,27 +288,22 @@ module (S : SIMULATOR) (F : DFUNCTIONALITY) : PRIMITIVE = { return y; } }. +import Counting. (** Initial and Final Games **) -module GReal (D : DISTINGUISHER) = RealIndif(Core,PC(Perm),D). - +module GReal (D : DISTINGUISHER) = RealIndif(Core,Perm,D). module GIdeal (D : DISTINGUISHER) = IdealIndif(ICore,S,D). (*** PROOF ***) -(** TODO -- This is not indifferentiability -- clean up and fix **) -(** However, this is what's proven (modulo the additional validity - check in ICore, not present in IF. The validity checks may be - problematic in combination with counting, so we need to make sure - both are present throughout before diving in. **) lemma CoreIndiff (D <: DISTINGUISHER {C, Perm, Core, ICore, S}) &m: (forall (F <: DFUNCTIONALITY {D}) (P <: DPRIMITIVE {D}), islossless P.f => islossless P.fi => islossless F.f => islossless D(F,P).distinguish) - => Pr[RealIndif(Core,PC(Perm),D).main() @ &m: res /\ C.c <= max_query] - <= Pr[IdealIndif(ICore,S,DRestr(D)).main() @ &m :res] - + (max_query ^ 2)%r / (2^(r + c))%r + => `| Pr[RealIndif(Core,Perm,DRestr(D)).main() @ &m: res] + - Pr[IdealIndif(ICore,S,DRestr(D)).main() @ &m :res] | + <= (max_query ^ 2)%r / (2^(r + c))%r + max_query%r * ((2*max_query)%r / (2^c)%r) + max_query%r * ((2*max_query)%r / (2^c)%r). -abort. +admitted. diff --git a/proof/clean/CoreExtension.eca b/proof/clean/CoreExtension.eca index 87cdc7b..e2144f8 100644 --- a/proof/clean/CoreExtension.eca +++ b/proof/clean/CoreExtension.eca @@ -71,13 +71,16 @@ end Capacity. import Capacity DCapacity. (** Validity of Functionality Queries and Partial Bijection **) -op valid: block list -> bool. +op valid: block list -> int -> bool. +axiom nil_not_valid bs n: valid bs n => bs <> []. op extend: block list -> int -> block list. op strip: block list -> (block list * int). +axiom strip_nil bs: (strip bs).`1 <> [] => bs <> []. axiom stripK bs: extend (strip bs).`1 (strip bs).`2 = bs. -axiom extendK bs n: 0 <= n => valid bs => strip (extend bs n) = (bs,n). +axiom extendK bs n: valid bs n => strip (extend bs n) = (bs,n). +axiom size_extend bs n: valid bs n => size (extend bs n) = size bs + n. lemma injective_strip: injective strip. proof. @@ -100,106 +103,111 @@ clone include Indifferentiability with rename [module] "GReal" as "RealIndif" [module] "GIdeal" as "IdealIndif". -(** Query Counting **) -module C = { - var c:int - proc init() = { c <- 0; } -}. - -module PC (P : PRIMITIVE) : PRIMITIVE = { - proc init () = { - C.init(); - P.init(); - } - - proc f (x : state) = { - var y; - - C.c <- C.c + 1; - y <@ P.f(x); - return y; - } - - proc fi(x : state) = { - var y; +(** Query Counting -- Note that we only count **adversary** queries **) +theory Counting. + module C = { + var c:int + proc init() = { c <- 0; } + }. - C.c <- C.c + 1; - y <@ P.fi(x); - return y; - } -}. + module PC (P : PRIMITIVE) : PRIMITIVE = { + proc init () = { + C.init(); + P.init(); + } -module DPRestr (P : DPRIMITIVE) : DPRIMITIVE = { - proc f (x : state) = { - var y <- (b0,c0); + proc f (x : state) = { + var y; - if (C.c + 1 <= max_query) { C.c <- C.c + 1; y <@ P.f(x); + return y; } - return y; - } - proc fi(x : state) = { - var y <- (b0,c0); + proc fi(x : state) = { + var y; - if (C.c + 1 <= max_query) { C.c <- C.c + 1; y <@ P.fi(x); + return y; } - return y; - } -}. + }. -module PRestr (P : PRIMITIVE) : PRIMITIVE = { - proc init () = { - C.init(); - P.init(); - } + module DPRestr (P : DPRIMITIVE) : DPRIMITIVE = { + proc f (x : state) = { + var y <- (b0,c0); - proc f = DPRestr(P).f - proc fi = DPRestr(P).fi -}. + if (C.c + 1 <= max_query) { + C.c <- C.c + 1; + y <@ P.f(x); + } + return y; + } -module FC (F : FUNCTIONALITY) : FUNCTIONALITY = { - proc init = F.init + proc fi(x : state) = { + var y <- (b0,c0); - proc f (p : block list, n : int) = { - var b <- b0; + if (C.c + 1 <= max_query) { + C.c <- C.c + 1; + y <@ P.fi(x); + } + return y; + } + }. - C.c <- C.c + size p; - b <@ F.f(p,n); - return b; - } -}. + module PRestr (P : PRIMITIVE) : PRIMITIVE = { + proc init () = { + C.init(); + P.init(); + } -module DFRestr (F : DFUNCTIONALITY) : DFUNCTIONALITY = { - proc f (p : block list, n : int) = { - var b <- b0; + proc f = DPRestr(P).f + proc fi = DPRestr(P).fi + }. - if (C.c + size p <= max_query) { - C.c <- C.c + size p; - b <@ F.f(p, n); + module FC (F : FUNCTIONALITY) : FUNCTIONALITY = { + proc init = F.init + + proc f (p : block list, n : int) = { + var b <- b0; + + if (valid p n) { + C.c <- C.c + size p + n; + b <@ F.f(p,n); + } + return b; } - return b; - } -}. + }. -module FRestr(F : FUNCTIONALITY) : FUNCTIONALITY = { - proc init = F.init - proc f = DFRestr(F).f -}. + module DFRestr (F : DFUNCTIONALITY) : DFUNCTIONALITY = { + proc f (p : block list, n : int) = { + var b <- b0; -module (DRestr (D : DISTINGUISHER) : DISTINGUISHER) - (F : DFUNCTIONALITY) (P : DPRIMITIVE) = { - proc distinguish() = { - var b; + if (valid p n /\ C.c + size p + n <= max_query) { + C.c <- C.c + size p + n; + b <@ F.f(p, n); + } + return b; + } + }. - C.init(); - b <@ D(DFRestr(F), DPRestr(P)).distinguish(); - return b; - } -}. + module FRestr(F : FUNCTIONALITY) : FUNCTIONALITY = { + proc init = F.init + proc f = DFRestr(F).f + }. + + module (DRestr (D : DISTINGUISHER) : DISTINGUISHER) + (F : DFUNCTIONALITY) (P : DPRIMITIVE) = { + proc distinguish() = { + var b; + + C.init(); + b <@ D(DFRestr(F), DPRestr(P)).distinguish(); + return b; + } + }. +end Counting. +import Counting. (** Core Extension Construction **) module (CoreExtension : CONSTRUCTION) (P:DPRIMITIVE): FUNCTIONALITY = { @@ -208,7 +216,7 @@ module (CoreExtension : CONSTRUCTION) (P:DPRIMITIVE): FUNCTIONALITY = { proc f(p : block list, n : int): block = { var (sa,sc) <- (b0,c0); - if (valid p /\ 0 <= n) { + if (valid p n) { p <- extend p n; while (p <> []) { (sa,sc) <@ P.f((sa +^ head witness p,sc)); @@ -230,7 +238,7 @@ module ICoreExtension: FUNCTIONALITY = { proc f(p : block list, n : int): block = { var r <- b0; - if (valid p /\ 0 <= n) { + if (valid p n) { if (!mem (dom m) (p,n)) { m.[(p,n)] <$ bdistr; } @@ -260,7 +268,7 @@ section PROOF. op Capacity.c0 <- c0, op Capacity.enum <- caps, op max_query <- max_query, - op valid (bs) <- valid (strip bs).`1 /\ 0 <= (strip bs).`2 + op valid (bs) <- valid (strip bs).`1 (strip bs).`2 proof *. realize Block.r_ge0 by exact/r_ge0. realize Block.addbA by exact/addbA. @@ -272,8 +280,9 @@ section PROOF. realize Capacity.c_ge0 by exact/c_ge0. realize Capacity.capacity_enum by exact/caps_spec. realize Capacity.card_capacity by exact/card_capacity. - realize valid_not_nil by admit. realize max_query_ge0 by exact/max_query_ge0. + realize valid_not_nil. + proof. by move=> m /nil_not_valid; exact/(@strip_nil m). qed. (** Simulator and Distinguisher constructions **) module (RaiseSim (S : CoreSim.SIMULATOR) : SIMULATOR) @@ -299,7 +308,7 @@ section PROOF. proc f(p : block list, n : int) = { var b <- b0; - if (valid p /\ 0 <= n) { + if (valid p n) { p <- extend p n; b <@ F.f(p); } @@ -310,9 +319,54 @@ section PROOF. proc distinguish = D(RaiseF,P).distinguish }. - declare module D : DISTINGUISHER { CoreSim.Core, CoreSim.Perm.Perm, CoreSim.ICore, CoreSim.S, CoreSim.C, ICoreExtension }. - local lemma LiftIndif &m: + (** Transferring Query Counting -- We need to give two lemmas because of restrictions **) + local equiv DRestr_LowerDist_Real + (D <: DISTINGUISHER { CoreSim.Counting.C, Self.Counting.C }) + (C <: CoreSim.CONSTRUCTION {D, CoreSim.Counting.C, Self.Counting.C}) + (P <: DPRIMITIVE {D, C, CoreSim.Counting.C, Self.Counting.C}): + LowerDist(DRestr(D),C(P),P).distinguish ~ CoreSim.Counting.DRestr(LowerDist(D),C(P),P).distinguish: + ={glob D, glob C, glob P} + ==> ={res, glob D, glob C, glob P} /\ Counting.C.c{1} = CoreSim.Counting.C.c{2}. + proof. + proc; call (_: ={glob C, glob P} + /\ Counting.C.c{1} = CoreSim.Counting.C.c{2}); + first 2 by sim. + + proc; sp; if{2}=> //=; last by rcondf{1} 1; 1:by auto=> /> ->. + inline{2} 2; inline{1} 1.2. + sp; if; auto. + + by move=> /> &1 &2 ^ ^ ^ valid_pn /extendK -> /= /size_extend -> -> /#. + rcondt{1} 5; 1:by auto. + by sim; auto=> /> &1 &2 /size_extend -> /#. + by inline *; auto. + qed. + + local equiv DRestr_LowerDist_Ideal + (D <: DISTINGUISHER { CoreSim.Counting.C, Self.Counting.C }) + (F <: CoreSim.DFUNCTIONALITY {D, CoreSim.Counting.C, Self.Counting.C}) + (S <: CoreSim.SIMULATOR {D, F, CoreSim.Counting.C, Self.Counting.C}): + LowerDist(DRestr(D),F,S(F)).distinguish ~ CoreSim.Counting.DRestr(LowerDist(D),F,S(F)).distinguish: + ={glob D, glob F, glob S} + ==> ={res, glob D, glob F, glob S} /\ Counting.C.c{1} = CoreSim.Counting.C.c{2}. + proof. + proc; call (_: ={glob F, glob S} + /\ Counting.C.c{1} = CoreSim.Counting.C.c{2}); + first 2 by sim. + + proc; sp; if{2}=> //=; last by rcondf{1} 1; 1:by auto=> /> ->. + inline{2} 2; inline{1} 1.2. + sp; if; auto. + + by move=> /> &1 &2 ^ ^ ^ valid_pn /extendK -> /= /size_extend -> -> /#. + rcondt{1} 5; 1:by auto. + by sim; auto=> /> &1 &2 /size_extend -> /#. + by inline *; auto. + qed. + + (** The raised simulator is such that the indifferentiability + advantage of any high-level adversary is exactly that of the + lowered distinguisher against the low-level simulator. **) + local lemma LiftIndif + (D <: DISTINGUISHER { CoreSim.Perm.Perm, CoreSim.ICore, CoreSim.S, ICoreExtension }) + &m: `| Pr[CoreSim.GReal(LowerDist(D)).main() @ &m: res] - Pr[CoreSim.GIdeal(LowerDist(D)).main() @ &m: res] | = `| Pr[GReal(D,CoreSim.Perm.Perm).main() @ &m: res] @@ -322,9 +376,7 @@ section PROOF. + byequiv (_: ={glob D} ==> _)=> //; proc. seq 2 2: (={glob CoreSim.Perm.Perm, glob D}). + by inline *; auto. - call (_: ={glob CoreSim.Perm.Perm})=> //. - + by proc; inline{1} 2; wp; sim. - + by proc; inline{1} 2; wp; sim. + call (_: ={glob CoreSim.Perm.Perm})=> //; first 2 by sim. proc; sp; if=> //=. inline{1} 2; wp. while (={glob CoreSim.Perm.Perm, sa, sc} /\ p0{1} = p{2}); auto. by inline *; sp; if=> //=; auto. @@ -332,17 +384,15 @@ section PROOF. seq 2 2: ( ={glob D, glob CoreSim.S} /\ (forall p n, mem (dom ICoreExtension.m) (p,n) - => valid p - /\ 0 <= n){2} - /\ (forall p n, valid p => 0 <= n => + => valid p n){2} + /\ (forall p n, valid p n => ICoreExtension.m.[(p,n)]{2} = CoreSim.ICore.m.[extend p n]{1})). + by inline *; auto; smt (in_dom map0P). call (_: ={glob CoreSim.S} /\ (forall p n, mem (dom ICoreExtension.m) (p,n) - => valid p - /\ 0 <= n){2} - /\ (forall p n, valid p => 0 <= n => + => valid p n){2} + /\ (forall p n, valid p n => ICoreExtension.m.[(p,n)]{2} = CoreSim.ICore.m.[extend p n]{1}))=> //. + proc; if=> //=; last by auto. if=> //=. @@ -360,16 +410,14 @@ section PROOF. /\ CoreSim.S.m.[x]{1} = None /\ (forall p n, mem (dom ICoreExtension.m) (p,n) - => valid p - /\ 0 <= n){2} - /\ (forall p n, valid p => 0 <= n => + => valid p n){2} + /\ (forall p n, valid p n => ICoreExtension.m.[(p,n)]{2} = CoreSim.ICore.m.[extend p n]{1}) ==> ={glob CoreSim.S, y1, p, v, x} /\ (forall p n, mem (dom ICoreExtension.m) (p,n) - => valid p - /\ 0 <= n){2} - /\ (forall p n, valid p => 0 <= n => + => valid p n){2} + /\ (forall p n, valid p n => ICoreExtension.m.[(p,n)]{2} = CoreSim.ICore.m.[extend p n]{1}))=> //. + auto=> /> &1 &2 ^pv_def <- [#] <*> h1 h2; rewrite !in_dom=> /= -> /=. by case: (CoreSim.S.pi.[x.`2]{2}) pv_def=> //= x @/oget /=. @@ -377,23 +425,23 @@ section PROOF. + by move=> /> &1 &2; case: (strip (rcons p (v +^ x.`1)){2})=> p' n' [#] !->>. if=> //=. + move=> /> &1 &2; case _: (strip (rcons p (v +^ x.`1)){2})=> p' n' h_def [#] !->>. - move=> _ _ h1 h2 /= valid_p ge0_n; rewrite !in_dom. + move=> _ _ h1 h2 /= valid_pn; rewrite !in_dom. rewrite h2 //. have ->: p' = (strip (rcons p (v +^ x.`1)){2}).`1 by rewrite h_def. have ->: n' = (strip (rcons p (v +^ x.`1)){2}).`2 by rewrite h_def. by rewrite (@stripK (rcons p (v +^ x.`1)){2}). + auto=> /> &1 &2; case _: (strip (rcons p (v +^ x.`1)){2})=> p' n' h_def [#] !->>. - move=> pi_x2 m_x h1 h2 /= valid_p n_ge0; rewrite in_dom=> /= m_pvx1. + move=> pi_x2 m_x h1 h2 /= valid_pn; rewrite in_dom=> /= m_pvx1. move=> _ b _ _; rewrite getP /= oget_some getP /= oget_some /=; split. + move=> p n; rewrite in_dom getP; case ((p,n) = (p',n'))=> //= _. by rewrite -in_dom=> /h1. - move=> p0 n0 valid_p' n'_ge0; rewrite !getP h2 // -h_def. + move=> p0 n0 valid_pn'; rewrite !getP h2 // -h_def. case: (extend p0 n0 = (rcons p (v +^ x.`1)){2})=> //=. + by rewrite -extendK=> // ->. case: ((p0,n0) = (strip (rcons p (v +^ x.`1))){2})=> //=. smt (stripK). + auto=> /> &1 &2; case _: (strip (rcons p (v +^ x.`1)){2})=> p' n' h_def [#] !->>. - by move=> _ _ h1 h2 /= valid_p' n'_ge0 _; rewrite h2 //; smt (stripK). + by move=> _ _ h1 h2 /= valid_pn' _; rewrite h2 //; smt (stripK). by auto. rcondf{1} 6; 1:by auto. rcondf{2} 6; 1:by auto. @@ -403,15 +451,49 @@ section PROOF. rcondt{1} 4; 1:auto. + by move=> &hr [#] !->> h1 h2 valid_p n_ge0 /=; rewrite extendK. sp; if=> //=. - + by move=> /> &1 &2 h1 h2 valid_p n_ge0; rewrite !in_dom h2 // -extendK. - + auto=> /> &1 &2 h1 h2 valid_p n_ge0; rewrite in_dom=> /= ^extend_pn_notin_m. + + by move=> /> &1 &2 h1 h2 valid_pn; rewrite !in_dom h2 // -extendK. + + auto=> /> &1 &2 h1 h2 valid_pn; rewrite in_dom=> /= ^extend_pn_notin_m. rewrite -h2=> // pn_notin_m _ b _ _; rewrite 2!getP /=; split. + move=> p' n'; rewrite in_dom getP; case ((p',n') = (p{2},n{2}))=> //= _. by rewrite -in_dom=> /h1. - move=> p0 m0 valid_p0 n0_ge0; rewrite !getP h2 // -!extendK //. + move=> p0 m0 valid_pn0; rewrite !getP h2 // -!extendK //. case: (extend p0 m0 = extend p{2} n{2})=> [->|] //. by have /contra H /H ->:= (injective_strip (extend p0 m0) (extend p{2} n{2})). - by auto=> /> &1 &2 h1 h2 valid_p n_ge0 _; rewrite -h2. + by auto=> /> &1 &2 h1 h2 valid_pn _; rewrite -h2. qed. + (** And we conclude with a bound on indifferentiability of the + high-level construction **) + (** TODO: Arrange that this lemma be non-local **) + local lemma ExtensionIndif + (D <: DISTINGUISHER { CoreSim.Perm.Perm, CoreSim.ICore, CoreSim.S, + ICoreExtension, CoreSim.Counting.C, Self.Counting.C }) + &m: + (forall (F <: DFUNCTIONALITY {D}) (P <: DPRIMITIVE {D}), + islossless P.f + => islossless P.fi + => islossless F.f + => islossless D(F,P).distinguish) + => `| Pr[GReal(DRestr(D),CoreSim.Perm.Perm).main() @ &m: res] + - Pr[GIdeal(DRestr(D),RaiseSim(CoreSim.S)).main() @ &m: res] | + <= (max_query ^ 2)%r / (2^(r + c))%r + + max_query%r * ((2*max_query)%r / (2^c)%r) + + max_query%r * ((2*max_query)%r / (2^c)%r). + proof. + move=> D_ll. + rewrite -(LiftIndif (DRestr(D)) &m). + have ->: Pr[CoreSim.GReal(LowerDist(DRestr(D))).main() @ &m: res] + = Pr[CoreSim.GReal(CoreSim.Counting.DRestr(LowerDist(D))).main() @ &m: res]. + + byequiv (_: ={glob D} ==> _)=> //=; proc. + call (DRestr_LowerDist_Real D CoreSim.Core CoreSim.Perm.Perm). + by inline *; auto. + have ->: Pr[CoreSim.GIdeal(LowerDist(DRestr(D))).main() @ &m: res] + = Pr[CoreSim.GIdeal(CoreSim.Counting.DRestr(LowerDist(D))).main() @ &m: res]. + + byequiv (_: ={glob D} ==> _)=> //=; proc. + call (DRestr_LowerDist_Ideal D CoreSim.ICore CoreSim.S). + by inline *; auto. + apply/(CoreSim.CoreIndiff (LowerDist(D)) &m _). + move=> F P Pf_ll Pfi_ll Ff_ll; proc (true)=> //. + by proc; sp; if=> //=; call Ff_ll; auto. + qed. end section PROOF. diff --git a/proof/core/CoreToBlockSponge.eca b/proof/core/CoreToBlockSponge.eca index 640d086..6cf2b01 100644 --- a/proof/core/CoreToBlockSponge.eca +++ b/proof/core/CoreToBlockSponge.eca @@ -1,6 +1,27 @@ (* -------------------------------------------------------------------- *) require import Option Pair Int Real Distr List FSet NewFMap DProd. -require import BlockSponge Gconcl. +require import BlockSponge. + +require (*--*) Core. + +op max_query : int. +axiom max_query_ge0: 0 <= max_query. + +clone Core as CoreConstruction with + op Block.r <- Common.r, + type Block.block <- Common.block, + op Block.b0 <- Common.Block.b0, + op Block.(+^) <- Common.Block.(+^), + op Block.enum <- Common.Block.blocks, + op Capacity.c <- Common.c, + type Capacity.capacity <- Common.capacity, + op Capacity.c0 <- Common.Capacity.c0, + op Capacity.enum <- Common.Capacity.caps, + op max_query <- max_query +proof *. +realize Block.r_ge0 by exact/Common.ge0_r. +search Common.Block.(+^). +realize Block.addbA by exact/Common.Block.addwA. (*---*) import Common Perm. From e6e046ceee87601fe7e3c239c82eba7df1df9502 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Thu, 1 Sep 2016 13:32:24 +0100 Subject: [PATCH 231/525] NewCore --- proof/clean/NewCore.eca | 324 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 324 insertions(+) create mode 100644 proof/clean/NewCore.eca diff --git a/proof/clean/NewCore.eca b/proof/clean/NewCore.eca new file mode 100644 index 0000000..39fc5c0 --- /dev/null +++ b/proof/clean/NewCore.eca @@ -0,0 +1,324 @@ +require import Pred Fun Option Pair Int Real List FSet NewFMap NewDistr. +require import StdOrder Ring DProd. +(*---*) import IntOrder. + +require (*..*) RP Indifferentiability. + +(*** THEORY PARAMETERS ***) +(** Block/Rate **) +theory Block. + op r : int. + axiom r_ge0: 0 <= r. + + type block. + + op b0: block. + op (+^): block -> block -> block. + + axiom addbA b1 b2 b3: b1 +^ (b2 +^ b3) = b1 +^ b2 +^ b3. + axiom addbC b1 b2: b1 +^ b2 = b2 +^ b1. + axiom add0b b: b0 +^ b = b. + axiom addbK b: b +^ b = b0. + + op enum: block list. + axiom block_enum b: count (pred1 b) enum = 1. + axiom card_block: size enum = 2^r. + + clone import Ring.ZModule as BlockMonoid with + type t <- block, + op zeror <- b0, + op ( + ) <- (+^), + op [ - ] (b : block) <- b + remove abbrev (-) + proof *. + realize addrA by exact/addbA. + realize addrC by exact/addbC. + realize add0r by exact/add0b. + realize addNr by exact/addbK. + + clone import MFinite as DBlock with + type t <- block, + op Support.enum <- enum + rename "dunifin" as "bdistr" + "duniform" as "bdistr" + proof *. + realize Support.enum_spec by exact/block_enum. +end Block. +import Block DBlock. + +(** Capacity **) +theory Capacity. + op c : int. + axiom c_ge0: 0 <= c. + + type capacity. + + op c0: capacity. + + op enum: capacity list. + axiom capacity_enum b: count (pred1 b) enum = 1. + axiom card_capacity: size enum = 2^c. + + clone import MFinite as DCapacity with + type t <- capacity, + op Support.enum <- enum + rename "dunifin" as "cdistr" + "duniform" as "cdistr" + proof *. + realize Support.enum_spec by exact/capacity_enum. +end Capacity. +import Capacity DCapacity. + +(** Validity of Functionality Queries **) +op valid: block list -> bool. +axiom valid_not_nil m: valid m => m <> []. + +(** Adversary's Query Cost **) +op max_query: int. +axiom max_query_ge0: 0 <= max_query. + +(*** DEFINITIONS ***) +type state = block * capacity. +op dstate = bdistr `*` cdistr. + +(** Indifferentiability Experiment **) +clone include Indifferentiability with + type p <- state, + type f_in <- block list, + type f_out <- block list + rename [module] "GReal" as "RealIndif" + [module] "GIdeal" as "IdealIndif". + +(** Query Counting **) +theory Counting. + module C = { + var c:int + proc init() = { c <- 0; } + }. + + module PC (P : PRIMITIVE) : PRIMITIVE = { + proc init () = { + C.init(); + P.init(); + } + + proc f (x : state) = { + var y; + + C.c <- C.c + 1; + y <@ P.f(x); + return y; + } + + proc fi(x : state) = { + var y; + + C.c <- C.c + 1; + y <@ P.fi(x); + return y; + } + }. + + module DPRestr (P : DPRIMITIVE) : DPRIMITIVE = { + proc f (x : state) = { + var y <- (b0,c0); + + if (C.c + 1 <= max_query) { + C.c <- C.c + 1; + y <@ P.f(x); + } + return y; + } + + proc fi(x : state) = { + var y <- (b0,c0); + + if (C.c + 1 <= max_query) { + C.c <- C.c + 1; + y <@ P.fi(x); + } + return y; + } + }. + + module PRestr (P : PRIMITIVE) : PRIMITIVE = { + proc init () = { + C.init(); + P.init(); + } + + proc f = DPRestr(P).f + proc fi = DPRestr(P).fi + }. + + module FC (F : FUNCTIONALITY) : FUNCTIONALITY = { + proc init = F.init + + proc f (p : block list) = { + var r <- []; + + if (valid p) { + C.c <- C.c + size p; + r <@ F.f(p); + } + return r; + } + }. + + module DFRestr (F : DFUNCTIONALITY) : DFUNCTIONALITY = { + proc f (bs : block list) = { + var r <- []; + + if (valid bs /\ C.c + size bs <= max_query) { + C.c <- C.c + size bs; + r <@ F.f(bs); + } + return r; + } + }. + + module FRestr(F : FUNCTIONALITY) : FUNCTIONALITY = { + proc init = F.init + proc f = DFRestr(F).f + }. + + module (DRestr (D : DISTINGUISHER) : DISTINGUISHER) + (F : DFUNCTIONALITY) (P : DPRIMITIVE) = { + proc distinguish() = { + var b; + + C.init(); + b <@ D(DFRestr(F), DPRestr(P)).distinguish(); + return b; + } + }. +end Counting. + +(** Ideal Primitive **) +clone export RP as Perm with + type t <- block * capacity, + op dt <- bdistr `*` cdistr + rename + [module type] "RP" as "PRIMITIVE" + [module] "P" as "Perm". + +(** Core Construction **) +module (Core : CONSTRUCTION) (P:DPRIMITIVE): FUNCTIONALITY = { + proc init () = {} + + proc f(p : block list): block list = { + var (sa,sc) <- (b0,c0); + var r <- []; + + while (p <> []) { + (sa,sc) <@ P.f((sa +^ head witness p,sc)); + r <- rcons r sa; + p <- behead p; + } + return r; + } +}. + +(** Ideal Core Functionality **) +module ICore : FUNCTIONALITY = { + var m : (block list,block) fmap + + proc init() = { + m = map0; + } + + proc fill_in(p : block list) = { + if (!mem (dom m) p) { + m.[p] <$ bdistr; + } + return oget m.[p]; + } + + proc f(p : block list): block list = { + var r <- []; + var i <- 0; + var b; + + if (valid p) { + while (i < size p) { + b <@ fill_in(take i p); + r <- rcons r b; + i <- i + 1; + } + } + return r; + } +}. + +(** Core Simulator **) +module (S : SIMULATOR) (F : DFUNCTIONALITY) : PRIMITIVE = { + var m, mi : (state,state) fmap + var pi : (capacity, block list * block) fmap + + proc init() = { + m <- map0; + mi <- map0; + pi <- map0.[c0 <- ([<:block>],b0)]; + } + + proc f(x : state): state = { + var p, v, y, y1, y2; + var b; + + if (!mem (dom m) x) { + if (mem (dom pi) x.`2) { + (p,v) <- oget pi.[x.`2]; + (* Not sure *) + b <- F.f (rcons p (v +^ x.`1)); + y1 <- last b0 b; + } else { + y1 <$ bdistr; + } + y2 <$ cdistr; + y <- (y1,y2); + m.[x] <- y; + mi.[y] <- x; + if (mem (dom pi) x.`2) { + (p,v) <- oget pi.[x.`2]; + pi.[y.`2] <- (rcons p (v +^ x.`1), y.`1); + } + } else { + y <- oget m.[x]; + } + return y; + } + + proc fi(x : state): state = { + var y, y1, y2; + + if (!mem (dom mi) x) { + y1 <$ bdistr; + y2 <$ cdistr; + y <- (y1,y2); + mi.[x] <- y; + m.[y] <- x; + } else { + y <- oget mi.[x]; + } + return y; + } +}. + +(** Initial and Final Games **) +module GReal (D : DISTINGUISHER) = RealIndif(Core,Perm,D). +module GIdeal (D : DISTINGUISHER) = IdealIndif(ICore,S,D). + +(*** PROOF ***) +import Counting. +lemma CoreIndiff (D <: DISTINGUISHER {C, Perm, Core, ICore, S}) &m: + (forall (F <: DFUNCTIONALITY {D}) (P <: DPRIMITIVE {D}), + islossless P.f + => islossless P.fi + => islossless F.f + => islossless D(F,P).distinguish) + => `| Pr[RealIndif(Core,Perm,DRestr(D)).main() @ &m: res] + - Pr[IdealIndif(ICore,S,DRestr(D)).main() @ &m :res] | + <= (max_query ^ 2)%r / (2^(r + c))%r + + max_query%r * ((2*max_query)%r / (2^c)%r) + + max_query%r * ((2*max_query)%r / (2^c)%r). +admitted. From 1e7676b54c14426c79e79c84d5d833694c9bb0e1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Thu, 1 Sep 2016 13:51:12 +0100 Subject: [PATCH 232/525] Removing newly obsolete files. --- proof/clean/Core.eca | 309 --------------------- proof/clean/CoreExtension.eca | 499 ---------------------------------- 2 files changed, 808 deletions(-) delete mode 100644 proof/clean/Core.eca delete mode 100644 proof/clean/CoreExtension.eca diff --git a/proof/clean/Core.eca b/proof/clean/Core.eca deleted file mode 100644 index 5302fc9..0000000 --- a/proof/clean/Core.eca +++ /dev/null @@ -1,309 +0,0 @@ -require import Pred Fun Option Pair Int Real List FSet NewFMap NewDistr. -require import StdOrder Ring DProd. -(*---*) import IntOrder. - -require (*..*) RP Indifferentiability. - -(*** THEORY PARAMETERS ***) -(** Block/Rate **) -theory Block. - op r : int. - axiom r_ge0: 0 <= r. - - type block. - - op b0: block. - op (+^): block -> block -> block. - - axiom addbA b1 b2 b3: b1 +^ (b2 +^ b3) = b1 +^ b2 +^ b3. - axiom addbC b1 b2: b1 +^ b2 = b2 +^ b1. - axiom add0b b: b0 +^ b = b. - axiom addbK b: b +^ b = b0. - - op enum: block list. - axiom block_enum b: count (pred1 b) enum = 1. - axiom card_block: size enum = 2^r. - - clone import Ring.ZModule as BlockMonoid with - type t <- block, - op zeror <- b0, - op ( + ) <- (+^), - op [ - ] (b : block) <- b - remove abbrev (-) - proof *. - realize addrA by exact/addbA. - realize addrC by exact/addbC. - realize add0r by exact/add0b. - realize addNr by exact/addbK. - - clone import MFinite as DBlock with - type t <- block, - op Support.enum <- enum - rename "dunifin" as "bdistr" - "duniform" as "bdistr" - proof *. - realize Support.enum_spec by exact/block_enum. -end Block. -import Block DBlock. - -(** Capacity **) -theory Capacity. - op c : int. - axiom c_ge0: 0 <= c. - - type capacity. - - op c0: capacity. - - op enum: capacity list. - axiom capacity_enum b: count (pred1 b) enum = 1. - axiom card_capacity: size enum = 2^c. - - clone import MFinite as DCapacity with - type t <- capacity, - op Support.enum <- enum - rename "dunifin" as "cdistr" - "duniform" as "cdistr" - proof *. - realize Support.enum_spec by exact/capacity_enum. -end Capacity. -import Capacity DCapacity. - -(** Validity of Functionality Queries **) -op valid: block list -> bool. -axiom valid_not_nil m: valid m => m <> []. - -(** Adversary's Query Cost **) -op max_query: int. -axiom max_query_ge0: 0 <= max_query. - -(*** DEFINITIONS ***) -type state = block * capacity. -op dstate = bdistr `*` cdistr. - -(** Indifferentiability Experiment **) -clone include Indifferentiability with - type p <- state, - type f_in <- block list, - type f_out <- block - rename [module] "GReal" as "RealIndif" - [module] "GIdeal" as "IdealIndif". - -(** Query Counting **) -theory Counting. - module C = { - var c:int - proc init() = { c <- 0; } - }. - - module PC (P : PRIMITIVE) : PRIMITIVE = { - proc init () = { - C.init(); - P.init(); - } - - proc f (x : state) = { - var y; - - C.c <- C.c + 1; - y <@ P.f(x); - return y; - } - - proc fi(x : state) = { - var y; - - C.c <- C.c + 1; - y <@ P.fi(x); - return y; - } - }. - - module DPRestr (P : DPRIMITIVE) : DPRIMITIVE = { - proc f (x : state) = { - var y <- (b0,c0); - - if (C.c + 1 <= max_query) { - C.c <- C.c + 1; - y <@ P.f(x); - } - return y; - } - - proc fi(x : state) = { - var y <- (b0,c0); - - if (C.c + 1 <= max_query) { - C.c <- C.c + 1; - y <@ P.fi(x); - } - return y; - } - }. - - module PRestr (P : PRIMITIVE) : PRIMITIVE = { - proc init () = { - C.init(); - P.init(); - } - - proc f = DPRestr(P).f - proc fi = DPRestr(P).fi - }. - - module FC (F : FUNCTIONALITY) : FUNCTIONALITY = { - proc init = F.init - - proc f (p : block list) = { - var b <- b0; - - if (valid p) { - C.c <- C.c + size p; - b <@ F.f(p); - } - return b; - } - }. - - module DFRestr (F : DFUNCTIONALITY) : DFUNCTIONALITY = { - proc f (bs : block list) = { - var b <- b0; - - if (valid bs /\ C.c + size bs <= max_query) { - C.c <- C.c + size bs; - b <@ F.f(bs); - } - return b; - } - }. - - module FRestr(F : FUNCTIONALITY) : FUNCTIONALITY = { - proc init = F.init - proc f = DFRestr(F).f - }. - - module (DRestr (D : DISTINGUISHER) : DISTINGUISHER) - (F : DFUNCTIONALITY) (P : DPRIMITIVE) = { - proc distinguish() = { - var b; - - C.init(); - b <@ D(DFRestr(F), DPRestr(P)).distinguish(); - return b; - } - }. -end Counting. - -(** Ideal Primitive **) -clone export RP as Perm with - type t <- block * capacity, - op dt <- bdistr `*` cdistr - rename - [module type] "RP" as "PRIMITIVE" - [module] "P" as "Perm". - -(** Core Construction **) -module (Core : CONSTRUCTION) (P:DPRIMITIVE): FUNCTIONALITY = { - proc init () = {} - - proc f(p : block list): block = { - var (sa,sc) <- (b0,c0); - - while (p <> []) { - (sa,sc) <@ P.f((sa +^ head witness p,sc)); - p <- behead p; - } - return sa; - } -}. - -(** Ideal Core Functionality **) -module ICore: FUNCTIONALITY = { - var m : (block list,block) fmap - - proc init() = { - m = map0; - } - - proc f(p : block list): block = { - var r <- b0; - - if (valid p) { - if (!mem (dom m) p) { - m.[p] <$ bdistr; - } - r <- oget m.[p]; - } - return r; - } -}. - -(** Core Simulator **) -module (S : SIMULATOR) (F : DFUNCTIONALITY) : PRIMITIVE = { - var m, mi : (state,state) fmap - var pi : (capacity, block list * block) fmap - - proc init() = { - m <- map0; - mi <- map0; - pi <- map0.[c0 <- ([<:block>],b0)]; - } - - proc f(x : state): state = { - var p, v, y, y1, y2; - - if (!mem (dom m) x) { - if (mem (dom pi) x.`2) { - (p,v) <- oget pi.[x.`2]; - y1 <- F.f (rcons p (v +^ x.`1)); - } else { - y1 <$ bdistr; - } - y2 <$ cdistr; - y <- (y1,y2); - m.[x] <- y; - mi.[y] <- x; - if (mem (dom pi) x.`2) { - (p,v) <- oget pi.[x.`2]; - pi.[y.`2] <- (rcons p (v +^ x.`1), y.`1); - } - } else { - y <- oget m.[x]; - } - return y; - } - - proc fi(x : state): state = { - var y, y1, y2; - - if (!mem (dom mi) x) { - y1 <$ bdistr; - y2 <$ cdistr; - y <- (y1,y2); - mi.[x] <- y; - m.[y] <- x; - } else { - y <- oget mi.[x]; - } - return y; - } -}. -import Counting. - -(** Initial and Final Games **) -module GReal (D : DISTINGUISHER) = RealIndif(Core,Perm,D). -module GIdeal (D : DISTINGUISHER) = IdealIndif(ICore,S,D). - -(*** PROOF ***) -lemma CoreIndiff (D <: DISTINGUISHER {C, Perm, Core, ICore, S}) &m: - (forall (F <: DFUNCTIONALITY {D}) (P <: DPRIMITIVE {D}), - islossless P.f - => islossless P.fi - => islossless F.f - => islossless D(F,P).distinguish) - => `| Pr[RealIndif(Core,Perm,DRestr(D)).main() @ &m: res] - - Pr[IdealIndif(ICore,S,DRestr(D)).main() @ &m :res] | - <= (max_query ^ 2)%r / (2^(r + c))%r - + max_query%r * ((2*max_query)%r / (2^c)%r) - + max_query%r * ((2*max_query)%r / (2^c)%r). -admitted. diff --git a/proof/clean/CoreExtension.eca b/proof/clean/CoreExtension.eca deleted file mode 100644 index e2144f8..0000000 --- a/proof/clean/CoreExtension.eca +++ /dev/null @@ -1,499 +0,0 @@ -pragma -oldip. pragma +implicits. -require import Pred Fun Option Pair Int Real List FSet NewFMap NewDistr. -require import StdOrder Ring DProd. -(*---*) import IntOrder. - -require (*..*) RP Indifferentiability. - -(*** THEORY PARAMETERS ***) -(** Block/Rate **) -theory Block. - op r : int. - axiom r_ge0: 0 <= r. - - type block. - - op b0: block. - op (+^): block -> block -> block. - - axiom addbA b1 b2 b3: b1 +^ (b2 +^ b3) = b1 +^ b2 +^ b3. - axiom addbC b1 b2: b1 +^ b2 = b2 +^ b1. - axiom add0b b: b0 +^ b = b. - axiom addbK b: b +^ b = b0. - - op blocks: block list. - axiom blocks_spec b: count (pred1 b) blocks = 1. - axiom card_block: size blocks = 2^r. - - clone import Ring.ZModule as BlockMonoid with - type t <- block, - op zeror <- b0, - op ( + ) <- (+^), - op [ - ] (b : block) <- b - remove abbrev (-) - proof *. - realize addrA by exact/addbA. - realize addrC by exact/addbC. - realize add0r by exact/add0b. - realize addNr by exact/addbK. - - clone import MFinite as DBlock with - type t <- block, - op Support.enum <- blocks - rename "dunifin" as "bdistr" - "duniform" as "bdistr" - proof *. - realize Support.enum_spec by exact/blocks_spec. -end Block. -import Block DBlock. - -(** Capacity **) -theory Capacity. - op c : int. - axiom c_ge0: 0 <= c. - - type capacity. - - op c0: capacity. - - op caps: capacity list. - axiom caps_spec b: count (pred1 b) caps = 1. - axiom card_capacity: size caps = 2^c. - - clone import MFinite as DCapacity with - type t <- capacity, - op Support.enum <- caps - rename "dunifin" as "cdistr" - "duniform" as "cdistr" - proof *. - realize Support.enum_spec by exact/caps_spec. -end Capacity. -import Capacity DCapacity. - -(** Validity of Functionality Queries and Partial Bijection **) -op valid: block list -> int -> bool. -axiom nil_not_valid bs n: valid bs n => bs <> []. - -op extend: block list -> int -> block list. -op strip: block list -> (block list * int). - -axiom strip_nil bs: (strip bs).`1 <> [] => bs <> []. -axiom stripK bs: extend (strip bs).`1 (strip bs).`2 = bs. -axiom extendK bs n: valid bs n => strip (extend bs n) = (bs,n). -axiom size_extend bs n: valid bs n => size (extend bs n) = size bs + n. - -lemma injective_strip: injective strip. -proof. -by move=> bs1 bs2 eq_strip; rewrite -stripK eq_strip; exact/(@stripK bs2). -qed. - -(** Adversary's Query Cost **) -op max_query: int. -axiom max_query_ge0: 0 <= max_query. - -(*** DEFINITIONS ***) -type state = block * capacity. -op dstate = bdistr `*` cdistr. - -(** Indifferentiability Experiment **) -clone include Indifferentiability with - type p <- state, - type f_in <- block list * int, - type f_out <- block - rename [module] "GReal" as "RealIndif" - [module] "GIdeal" as "IdealIndif". - -(** Query Counting -- Note that we only count **adversary** queries **) -theory Counting. - module C = { - var c:int - proc init() = { c <- 0; } - }. - - module PC (P : PRIMITIVE) : PRIMITIVE = { - proc init () = { - C.init(); - P.init(); - } - - proc f (x : state) = { - var y; - - C.c <- C.c + 1; - y <@ P.f(x); - return y; - } - - proc fi(x : state) = { - var y; - - C.c <- C.c + 1; - y <@ P.fi(x); - return y; - } - }. - - module DPRestr (P : DPRIMITIVE) : DPRIMITIVE = { - proc f (x : state) = { - var y <- (b0,c0); - - if (C.c + 1 <= max_query) { - C.c <- C.c + 1; - y <@ P.f(x); - } - return y; - } - - proc fi(x : state) = { - var y <- (b0,c0); - - if (C.c + 1 <= max_query) { - C.c <- C.c + 1; - y <@ P.fi(x); - } - return y; - } - }. - - module PRestr (P : PRIMITIVE) : PRIMITIVE = { - proc init () = { - C.init(); - P.init(); - } - - proc f = DPRestr(P).f - proc fi = DPRestr(P).fi - }. - - module FC (F : FUNCTIONALITY) : FUNCTIONALITY = { - proc init = F.init - - proc f (p : block list, n : int) = { - var b <- b0; - - if (valid p n) { - C.c <- C.c + size p + n; - b <@ F.f(p,n); - } - return b; - } - }. - - module DFRestr (F : DFUNCTIONALITY) : DFUNCTIONALITY = { - proc f (p : block list, n : int) = { - var b <- b0; - - if (valid p n /\ C.c + size p + n <= max_query) { - C.c <- C.c + size p + n; - b <@ F.f(p, n); - } - return b; - } - }. - - module FRestr(F : FUNCTIONALITY) : FUNCTIONALITY = { - proc init = F.init - proc f = DFRestr(F).f - }. - - module (DRestr (D : DISTINGUISHER) : DISTINGUISHER) - (F : DFUNCTIONALITY) (P : DPRIMITIVE) = { - proc distinguish() = { - var b; - - C.init(); - b <@ D(DFRestr(F), DPRestr(P)).distinguish(); - return b; - } - }. -end Counting. -import Counting. - -(** Core Extension Construction **) -module (CoreExtension : CONSTRUCTION) (P:DPRIMITIVE): FUNCTIONALITY = { - proc init () = {} - - proc f(p : block list, n : int): block = { - var (sa,sc) <- (b0,c0); - - if (valid p n) { - p <- extend p n; - while (p <> []) { - (sa,sc) <@ P.f((sa +^ head witness p,sc)); - p <- behead p; - } - } - return sa; - } -}. - -(** Ideal Core Extension Functionality **) -module ICoreExtension: FUNCTIONALITY = { - var m : (block list * int,block) fmap - - proc init() = { - m = map0; - } - - proc f(p : block list, n : int): block = { - var r <- b0; - - if (valid p n) { - if (!mem (dom m) (p,n)) { - m.[(p,n)] <$ bdistr; - } - r <- oget m.[(p,n)]; - } - return r; - } -}. - -(** Initial and Final Games **) -module GReal (D : DISTINGUISHER, P : PRIMITIVE) = RealIndif(CoreExtension,P,D). - -module GIdeal (D : DISTINGUISHER, S : SIMULATOR) = IdealIndif(ICoreExtension,S,D). - -(*** PROOF ***) -require (*--*) Core. - -section PROOF. - local clone Core as CoreSim with - op Block.r <- r, - type Block.block <- block, - op Block.b0 <- b0, - op Block.(+^) <- (+^), - op Block.enum <- blocks, - op Capacity.c <- c, - type Capacity.capacity <- capacity, - op Capacity.c0 <- c0, - op Capacity.enum <- caps, - op max_query <- max_query, - op valid (bs) <- valid (strip bs).`1 (strip bs).`2 - proof *. - realize Block.r_ge0 by exact/r_ge0. - realize Block.addbA by exact/addbA. - realize Block.addbC by exact/addbC. - realize Block.add0b by exact/add0b. - realize Block.addbK by exact/addbK. - realize Block.block_enum by exact/blocks_spec. - realize Block.card_block by exact/card_block. - realize Capacity.c_ge0 by exact/c_ge0. - realize Capacity.capacity_enum by exact/caps_spec. - realize Capacity.card_capacity by exact/card_capacity. - realize max_query_ge0 by exact/max_query_ge0. - realize valid_not_nil. - proof. by move=> m /nil_not_valid; exact/(@strip_nil m). qed. - - (** Simulator and Distinguisher constructions **) - module (RaiseSim (S : CoreSim.SIMULATOR) : SIMULATOR) - (F : DFUNCTIONALITY) = { - module LowerF = { - proc f(p : block list) = { - var n, b; - - (p,n) <- strip p; - b <@ F.f(p,n); - return b; - } - } - - proc init = S(LowerF).init - proc f = S(LowerF).f - proc fi = S(LowerF).fi - }. - - module (LowerDist (D : DISTINGUISHER) : CoreSim.DISTINGUISHER) - (F : CoreSim.DFUNCTIONALITY) (P : CoreSim.DPRIMITIVE) = { - module RaiseF = { - proc f(p : block list, n : int) = { - var b <- b0; - - if (valid p n) { - p <- extend p n; - b <@ F.f(p); - } - return b; - } - } - - proc distinguish = D(RaiseF,P).distinguish - }. - - - (** Transferring Query Counting -- We need to give two lemmas because of restrictions **) - local equiv DRestr_LowerDist_Real - (D <: DISTINGUISHER { CoreSim.Counting.C, Self.Counting.C }) - (C <: CoreSim.CONSTRUCTION {D, CoreSim.Counting.C, Self.Counting.C}) - (P <: DPRIMITIVE {D, C, CoreSim.Counting.C, Self.Counting.C}): - LowerDist(DRestr(D),C(P),P).distinguish ~ CoreSim.Counting.DRestr(LowerDist(D),C(P),P).distinguish: - ={glob D, glob C, glob P} - ==> ={res, glob D, glob C, glob P} /\ Counting.C.c{1} = CoreSim.Counting.C.c{2}. - proof. - proc; call (_: ={glob C, glob P} - /\ Counting.C.c{1} = CoreSim.Counting.C.c{2}); - first 2 by sim. - + proc; sp; if{2}=> //=; last by rcondf{1} 1; 1:by auto=> /> ->. - inline{2} 2; inline{1} 1.2. - sp; if; auto. - + by move=> /> &1 &2 ^ ^ ^ valid_pn /extendK -> /= /size_extend -> -> /#. - rcondt{1} 5; 1:by auto. - by sim; auto=> /> &1 &2 /size_extend -> /#. - by inline *; auto. - qed. - - local equiv DRestr_LowerDist_Ideal - (D <: DISTINGUISHER { CoreSim.Counting.C, Self.Counting.C }) - (F <: CoreSim.DFUNCTIONALITY {D, CoreSim.Counting.C, Self.Counting.C}) - (S <: CoreSim.SIMULATOR {D, F, CoreSim.Counting.C, Self.Counting.C}): - LowerDist(DRestr(D),F,S(F)).distinguish ~ CoreSim.Counting.DRestr(LowerDist(D),F,S(F)).distinguish: - ={glob D, glob F, glob S} - ==> ={res, glob D, glob F, glob S} /\ Counting.C.c{1} = CoreSim.Counting.C.c{2}. - proof. - proc; call (_: ={glob F, glob S} - /\ Counting.C.c{1} = CoreSim.Counting.C.c{2}); - first 2 by sim. - + proc; sp; if{2}=> //=; last by rcondf{1} 1; 1:by auto=> /> ->. - inline{2} 2; inline{1} 1.2. - sp; if; auto. - + by move=> /> &1 &2 ^ ^ ^ valid_pn /extendK -> /= /size_extend -> -> /#. - rcondt{1} 5; 1:by auto. - by sim; auto=> /> &1 &2 /size_extend -> /#. - by inline *; auto. - qed. - - (** The raised simulator is such that the indifferentiability - advantage of any high-level adversary is exactly that of the - lowered distinguisher against the low-level simulator. **) - local lemma LiftIndif - (D <: DISTINGUISHER { CoreSim.Perm.Perm, CoreSim.ICore, CoreSim.S, ICoreExtension }) - &m: - `| Pr[CoreSim.GReal(LowerDist(D)).main() @ &m: res] - - Pr[CoreSim.GIdeal(LowerDist(D)).main() @ &m: res] | - = `| Pr[GReal(D,CoreSim.Perm.Perm).main() @ &m: res] - - Pr[GIdeal(D,RaiseSim(CoreSim.S)).main() @ &m: res] |. - proof. - do !congr. - + byequiv (_: ={glob D} ==> _)=> //; proc. - seq 2 2: (={glob CoreSim.Perm.Perm, glob D}). - + by inline *; auto. - call (_: ={glob CoreSim.Perm.Perm})=> //; first 2 by sim. - proc; sp; if=> //=. inline{1} 2; wp. - while (={glob CoreSim.Perm.Perm, sa, sc} /\ p0{1} = p{2}); auto. - by inline *; sp; if=> //=; auto. - byequiv (_: ={glob CoreSim.S, glob D} ==> _)=> //; proc. - seq 2 2: ( ={glob D, glob CoreSim.S} - /\ (forall p n, - mem (dom ICoreExtension.m) (p,n) - => valid p n){2} - /\ (forall p n, valid p n => - ICoreExtension.m.[(p,n)]{2} = CoreSim.ICore.m.[extend p n]{1})). - + by inline *; auto; smt (in_dom map0P). - call (_: ={glob CoreSim.S} - /\ (forall p n, - mem (dom ICoreExtension.m) (p,n) - => valid p n){2} - /\ (forall p n, valid p n => - ICoreExtension.m.[(p,n)]{2} = CoreSim.ICore.m.[extend p n]{1}))=> //. - + proc; if=> //=; last by auto. - if=> //=. - + rcondt{1} 7=> [&m0|]. - + inline *; sp; if=> //=; last by auto; smt (bdistr_ll). - if=> //=; last by auto; smt (bdistr_ll). - by auto; smt (bdistr_ll cdistr_ll). - rcondt{2} 7=> [&m0|]. - + inline *; sp; if=> //=; last by auto; smt (bdistr_ll). - if=> //=; last by auto; smt (bdistr_ll). - by auto; smt (bdistr_ll cdistr_ll). - auto; sp. - conseq (_: ={x, p, v, glob CoreSim.S} - /\ CoreSim.S.pi.[x.`2]{2} = Some (p,v){2} - /\ CoreSim.S.m.[x]{1} = None - /\ (forall p n, - mem (dom ICoreExtension.m) (p,n) - => valid p n){2} - /\ (forall p n, valid p n => - ICoreExtension.m.[(p,n)]{2} = CoreSim.ICore.m.[extend p n]{1}) - ==> ={glob CoreSim.S, y1, p, v, x} - /\ (forall p n, - mem (dom ICoreExtension.m) (p,n) - => valid p n){2} - /\ (forall p n, valid p n => - ICoreExtension.m.[(p,n)]{2} = CoreSim.ICore.m.[extend p n]{1}))=> //. - + auto=> /> &1 &2 ^pv_def <- [#] <*> h1 h2; rewrite !in_dom=> /= -> /=. - by case: (CoreSim.S.pi.[x.`2]{2}) pv_def=> //= x @/oget /=. - inline *; sp; if=> //=. - + by move=> /> &1 &2; case: (strip (rcons p (v +^ x.`1)){2})=> p' n' [#] !->>. - if=> //=. - + move=> /> &1 &2; case _: (strip (rcons p (v +^ x.`1)){2})=> p' n' h_def [#] !->>. - move=> _ _ h1 h2 /= valid_pn; rewrite !in_dom. - rewrite h2 //. - have ->: p' = (strip (rcons p (v +^ x.`1)){2}).`1 by rewrite h_def. - have ->: n' = (strip (rcons p (v +^ x.`1)){2}).`2 by rewrite h_def. - by rewrite (@stripK (rcons p (v +^ x.`1)){2}). - + auto=> /> &1 &2; case _: (strip (rcons p (v +^ x.`1)){2})=> p' n' h_def [#] !->>. - move=> pi_x2 m_x h1 h2 /= valid_pn; rewrite in_dom=> /= m_pvx1. - move=> _ b _ _; rewrite getP /= oget_some getP /= oget_some /=; split. - + move=> p n; rewrite in_dom getP; case ((p,n) = (p',n'))=> //= _. - by rewrite -in_dom=> /h1. - move=> p0 n0 valid_pn'; rewrite !getP h2 // -h_def. - case: (extend p0 n0 = (rcons p (v +^ x.`1)){2})=> //=. - + by rewrite -extendK=> // ->. - case: ((p0,n0) = (strip (rcons p (v +^ x.`1))){2})=> //=. - smt (stripK). - + auto=> /> &1 &2; case _: (strip (rcons p (v +^ x.`1)){2})=> p' n' h_def [#] !->>. - by move=> _ _ h1 h2 /= valid_pn' _; rewrite h2 //; smt (stripK). - by auto. - rcondf{1} 6; 1:by auto. - rcondf{2} 6; 1:by auto. - by auto. - + by proc; if=> //=; auto. - proc; sp; if=> //=; inline{1} 2. - rcondt{1} 4; 1:auto. - + by move=> &hr [#] !->> h1 h2 valid_p n_ge0 /=; rewrite extendK. - sp; if=> //=. - + by move=> /> &1 &2 h1 h2 valid_pn; rewrite !in_dom h2 // -extendK. - + auto=> /> &1 &2 h1 h2 valid_pn; rewrite in_dom=> /= ^extend_pn_notin_m. - rewrite -h2=> // pn_notin_m _ b _ _; rewrite 2!getP /=; split. - + move=> p' n'; rewrite in_dom getP; case ((p',n') = (p{2},n{2}))=> //= _. - by rewrite -in_dom=> /h1. - move=> p0 m0 valid_pn0; rewrite !getP h2 // -!extendK //. - case: (extend p0 m0 = extend p{2} n{2})=> [->|] //. - by have /contra H /H ->:= (injective_strip (extend p0 m0) (extend p{2} n{2})). - by auto=> /> &1 &2 h1 h2 valid_pn _; rewrite -h2. - qed. - - (** And we conclude with a bound on indifferentiability of the - high-level construction **) - (** TODO: Arrange that this lemma be non-local **) - local lemma ExtensionIndif - (D <: DISTINGUISHER { CoreSim.Perm.Perm, CoreSim.ICore, CoreSim.S, - ICoreExtension, CoreSim.Counting.C, Self.Counting.C }) - &m: - (forall (F <: DFUNCTIONALITY {D}) (P <: DPRIMITIVE {D}), - islossless P.f - => islossless P.fi - => islossless F.f - => islossless D(F,P).distinguish) - => `| Pr[GReal(DRestr(D),CoreSim.Perm.Perm).main() @ &m: res] - - Pr[GIdeal(DRestr(D),RaiseSim(CoreSim.S)).main() @ &m: res] | - <= (max_query ^ 2)%r / (2^(r + c))%r - + max_query%r * ((2*max_query)%r / (2^c)%r) - + max_query%r * ((2*max_query)%r / (2^c)%r). - proof. - move=> D_ll. - rewrite -(LiftIndif (DRestr(D)) &m). - have ->: Pr[CoreSim.GReal(LowerDist(DRestr(D))).main() @ &m: res] - = Pr[CoreSim.GReal(CoreSim.Counting.DRestr(LowerDist(D))).main() @ &m: res]. - + byequiv (_: ={glob D} ==> _)=> //=; proc. - call (DRestr_LowerDist_Real D CoreSim.Core CoreSim.Perm.Perm). - by inline *; auto. - have ->: Pr[CoreSim.GIdeal(LowerDist(DRestr(D))).main() @ &m: res] - = Pr[CoreSim.GIdeal(CoreSim.Counting.DRestr(LowerDist(D))).main() @ &m: res]. - + byequiv (_: ={glob D} ==> _)=> //=; proc. - call (DRestr_LowerDist_Ideal D CoreSim.ICore CoreSim.S). - by inline *; auto. - apply/(CoreSim.CoreIndiff (LowerDist(D)) &m _). - move=> F P Pf_ll Pfi_ll Ff_ll; proc (true)=> //. - by proc; sp; if=> //=; call Ff_ll; auto. - qed. -end section PROOF. From 91d15e7ccffa9ab910453e7bfa5232618490debc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Thu, 1 Sep 2016 14:16:35 +0100 Subject: [PATCH 233/525] NewCore: name fixes. --- proof/clean/NewCore.eca | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/proof/clean/NewCore.eca b/proof/clean/NewCore.eca index 39fc5c0..08dc975 100644 --- a/proof/clean/NewCore.eca +++ b/proof/clean/NewCore.eca @@ -20,9 +20,9 @@ theory Block. axiom add0b b: b0 +^ b = b. axiom addbK b: b +^ b = b0. - op enum: block list. - axiom block_enum b: count (pred1 b) enum = 1. - axiom card_block: size enum = 2^r. + op blocks: block list. + axiom blocks_spec b: count (pred1 b) blocks = 1. + axiom card_block: size blocks = 2^r. clone import Ring.ZModule as BlockMonoid with type t <- block, @@ -38,11 +38,11 @@ theory Block. clone import MFinite as DBlock with type t <- block, - op Support.enum <- enum + op Support.enum <- blocks rename "dunifin" as "bdistr" "duniform" as "bdistr" proof *. - realize Support.enum_spec by exact/block_enum. + realize Support.enum_spec by exact/blocks_spec. end Block. import Block DBlock. @@ -55,17 +55,17 @@ theory Capacity. op c0: capacity. - op enum: capacity list. - axiom capacity_enum b: count (pred1 b) enum = 1. - axiom card_capacity: size enum = 2^c. + op caps: capacity list. + axiom caps_spec b: count (pred1 b) caps = 1. + axiom card_capacity: size caps = 2^c. clone import MFinite as DCapacity with type t <- capacity, - op Support.enum <- enum + op Support.enum <- caps rename "dunifin" as "cdistr" "duniform" as "cdistr" proof *. - realize Support.enum_spec by exact/capacity_enum. + realize Support.enum_spec by exact/caps_spec. end Capacity. import Capacity DCapacity. @@ -83,7 +83,7 @@ op dstate = bdistr `*` cdistr. (** Indifferentiability Experiment **) clone include Indifferentiability with - type p <- state, + type p <- state, type f_in <- block list, type f_out <- block list rename [module] "GReal" as "RealIndif" From 0ccf957d388fe591dc67bf221c44fba62336f750 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Thu, 1 Sep 2016 15:13:47 -0400 Subject: [PATCH 234/525] A few documentation things. --- proof/Sponge.ec | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) diff --git a/proof/Sponge.ec b/proof/Sponge.ec index 9583cb7..94a2ac9 100644 --- a/proof/Sponge.ec +++ b/proof/Sponge.ec @@ -1771,6 +1771,8 @@ qed. end HybridIRO. +(* now we use HybridIRO to prove the main result *) + section. declare module BlockSim : BlockSponge.SIMULATOR{IRO, BlockSponge.BIRO.IRO}. @@ -1778,7 +1780,7 @@ declare module Dist : DISTINGUISHER{Perm, BlockSim, IRO, BlockSponge.BIRO.IRO}. local clone HybridIRO as HIRO. -(* working toward the Real side of the top-level theorem *) +(* working toward the Real side of the main result *) local lemma Sponge_Raise_BlockSponge_f : equiv[Sponge(Perm).f ~ RaiseFun(BlockSponge.Sponge(Perm)).f : @@ -1806,7 +1808,7 @@ auto; progress; by rewrite -cats1 blocks2bits_cat blocks2bits_sing. auto. qed. -(* the Real side of top-level theorem *) +(* the Real side of main result *) local lemma RealIndif_Sponge_BlockSponge &m : Pr[RealIndif(Sponge, Perm, Dist).main() @ &m : res] = @@ -1820,7 +1822,7 @@ conseq Sponge_Raise_BlockSponge_f=> //. auto. qed. -(* working toward the Ideal side of the top-level theorem *) +(* working toward the Ideal side of the main result *) (* first step of Ideal side: express in terms of Experiment and HIRO.HybridIROLazy *) @@ -1838,9 +1840,9 @@ seq 2 2 : inline*; wp; call (_ : true); auto. call (_ : - ={glob Dist, glob BlockSim} /\ - IRO.mp{1} = map0 /\ HIRO.HybridIROLazy.mp{2} = map0 ==> - ={res}). + ={glob Dist, glob BlockSim} /\ + IRO.mp{1} = map0 /\ HIRO.HybridIROLazy.mp{2} = map0 ==> + ={res}). proc (={glob BlockSim} /\ HIRO.lazy_invar IRO.mp{1} HIRO.HybridIROLazy.mp{2})=> //. @@ -1974,7 +1976,7 @@ conseq RaiseHybridIRO_HybridIROEager_RaiseFun_BlockIRO_f=> //. auto. qed. -(* the Ideal side of top-level theorem *) +(* the Ideal side of main result *) local lemma IdealIndif_IRO_BlockIRO &m : Pr[IdealIndif(IRO, RaiseSim(BlockSim), Dist).main() @ &m : res] = From 41262e7a18b83b2e28c113cf240325e22e3abe0b Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Thu, 1 Sep 2016 16:56:57 -0400 Subject: [PATCH 235/525] Implementing change to squeezing loops in BlockSponge/Sponge, avoiding superfluous application of primitive. Adapted top-level proof to track this change. --- proof/BlockSponge.ec | 8 +++++--- proof/Sponge.ec | 10 ++++++++-- 2 files changed, 13 insertions(+), 5 deletions(-) diff --git a/proof/BlockSponge.ec b/proof/BlockSponge.ec index 08219e5..d4302de 100644 --- a/proof/BlockSponge.ec +++ b/proof/BlockSponge.ec @@ -42,9 +42,11 @@ module (Sponge : CONSTRUCTION) (P : DPRIMITIVE) : FUNCTIONALITY = { } (* Squeezing *) while (i < n) { - z <- rcons z sa; - (sa, sc) <@ P.f(sa, sc); - i <- i + 1; + z <- rcons z sa; + i <- i + 1; + if (i < n) { + (sa, sc) <@ P.f(sa, sc); + } } } return z; diff --git a/proof/Sponge.ec b/proof/Sponge.ec index 94a2ac9..575c58e 100644 --- a/proof/Sponge.ec +++ b/proof/Sponge.ec @@ -54,8 +54,10 @@ module (Sponge : CONSTRUCTION) (P : DPRIMITIVE) : FUNCTIONALITY = { (* squeezing *) while (i < (n + r - 1) %/ r) { z <- z ++ ofblock sa; - (sa, sc) <@ P.f(sa, sc); i <- i + 1; + if (i < (n + r - 1) %/ r) { + (sa, sc) <@ P.f(sa, sc); + } } return take n z; @@ -1803,7 +1805,11 @@ seq 0 1 : n0{2} = (n{1} + r - 1) %/ r); first auto. while (={n, glob Perm, i, sa, sc} /\ blocks2bits z{2} = z{1} /\ n0{2} = (n{1} + r - 1) %/ r). -wp. call (_ : ={glob Perm}); first sim. auto. +case (i{1} + 1 < (n{1} + r - 1) %/ r). +rcondt{1} 3; first auto. rcondt{2} 3; first auto. +call (_ : ={glob Perm}); first sim. +auto; progress; by rewrite -cats1 blocks2bits_cat blocks2bits_sing. +rcondf{1} 3; first auto. rcondf{2} 3; first auto. auto; progress; by rewrite -cats1 blocks2bits_cat blocks2bits_sing. auto. qed. From 85a415313d19d11ca660fe5f917b691ec21fee74 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Thu, 1 Sep 2016 17:19:20 -0400 Subject: [PATCH 236/525] Nit. --- proof/BlockSponge.ec | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/proof/BlockSponge.ec b/proof/BlockSponge.ec index d4302de..b6f50ac 100644 --- a/proof/BlockSponge.ec +++ b/proof/BlockSponge.ec @@ -40,7 +40,7 @@ module (Sponge : CONSTRUCTION) (P : DPRIMITIVE) : FUNCTIONALITY = { (sa, sc) <@ P.f(sa +^ head b0 xs, sc); xs <- behead xs; } - (* Squeezing *) + (* squeezing *) while (i < n) { z <- rcons z sa; i <- i + 1; From 1f17edc708f60c3eb5d1c18a85b365a3ab4bb493 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Fri, 2 Sep 2016 09:03:55 +0100 Subject: [PATCH 237/525] Pulling out common abstractions in Clean. --- proof/clean/NewCommon.ec | 73 ++++++++++++++++++++++++++++++++++++++++ proof/clean/NewCore.eca | 71 ++------------------------------------ 2 files changed, 75 insertions(+), 69 deletions(-) create mode 100644 proof/clean/NewCommon.ec diff --git a/proof/clean/NewCommon.ec b/proof/clean/NewCommon.ec new file mode 100644 index 0000000..892511d --- /dev/null +++ b/proof/clean/NewCommon.ec @@ -0,0 +1,73 @@ +require import Pred Fun NewLogic NewDistr. +require import Int Real List NewFMap FSet. +require import StdOrder. +(*---*) import IntOrder. + +(*** THEORY PARAMETERS ***) +(** Block/Rate **) +theory Block. + op r : int. + axiom r_ge0: 0 <= r. + + type block. + + op b0: block. + op (+^): block -> block -> block. + + axiom addbA b1 b2 b3: b1 +^ (b2 +^ b3) = b1 +^ b2 +^ b3. + axiom addbC b1 b2: b1 +^ b2 = b2 +^ b1. + axiom add0b b: b0 +^ b = b. + axiom addbK b: b +^ b = b0. + + op blocks: block list. + axiom blocks_spec b: count (pred1 b) blocks = 1. + axiom card_block: size blocks = 2^r. + + clone import Ring.ZModule as BlockMonoid with + type t <- block, + op zeror <- b0, + op ( + ) <- (+^), + op [ - ] (b : block) <- b + remove abbrev (-) + proof *. + realize addrA by exact/addbA. + realize addrC by exact/addbC. + realize add0r by exact/add0b. + realize addNr by exact/addbK. + + clone import MFinite as DBlock with + type t <- block, + op Support.enum <- blocks + rename "dunifin" as "bdistr" + "duniform" as "bdistr" + proof *. + realize Support.enum_spec by exact/blocks_spec. +end Block. +import Block DBlock. + +(** Capacity **) +theory Capacity. + op c : int. + axiom c_ge0: 0 <= c. + + type capacity. + + op c0: capacity. + + op caps: capacity list. + axiom caps_spec b: count (pred1 b) caps = 1. + axiom card_capacity: size caps = 2^c. + + clone import MFinite as DCapacity with + type t <- capacity, + op Support.enum <- caps + rename "dunifin" as "cdistr" + "duniform" as "cdistr" + proof *. + realize Support.enum_spec by exact/caps_spec. +end Capacity. +import Capacity DCapacity. + +(** Query Bound **) +op max_query: int. +axiom max_query_ge0: 0 <= max_query. \ No newline at end of file diff --git a/proof/clean/NewCore.eca b/proof/clean/NewCore.eca index 08dc975..aea1710 100644 --- a/proof/clean/NewCore.eca +++ b/proof/clean/NewCore.eca @@ -4,78 +4,11 @@ require import StdOrder Ring DProd. require (*..*) RP Indifferentiability. -(*** THEORY PARAMETERS ***) -(** Block/Rate **) -theory Block. - op r : int. - axiom r_ge0: 0 <= r. - - type block. - - op b0: block. - op (+^): block -> block -> block. - - axiom addbA b1 b2 b3: b1 +^ (b2 +^ b3) = b1 +^ b2 +^ b3. - axiom addbC b1 b2: b1 +^ b2 = b2 +^ b1. - axiom add0b b: b0 +^ b = b. - axiom addbK b: b +^ b = b0. - - op blocks: block list. - axiom blocks_spec b: count (pred1 b) blocks = 1. - axiom card_block: size blocks = 2^r. - - clone import Ring.ZModule as BlockMonoid with - type t <- block, - op zeror <- b0, - op ( + ) <- (+^), - op [ - ] (b : block) <- b - remove abbrev (-) - proof *. - realize addrA by exact/addbA. - realize addrC by exact/addbC. - realize add0r by exact/add0b. - realize addNr by exact/addbK. - - clone import MFinite as DBlock with - type t <- block, - op Support.enum <- blocks - rename "dunifin" as "bdistr" - "duniform" as "bdistr" - proof *. - realize Support.enum_spec by exact/blocks_spec. -end Block. -import Block DBlock. - -(** Capacity **) -theory Capacity. - op c : int. - axiom c_ge0: 0 <= c. - - type capacity. - - op c0: capacity. - - op caps: capacity list. - axiom caps_spec b: count (pred1 b) caps = 1. - axiom card_capacity: size caps = 2^c. - - clone import MFinite as DCapacity with - type t <- capacity, - op Support.enum <- caps - rename "dunifin" as "cdistr" - "duniform" as "cdistr" - proof *. - realize Support.enum_spec by exact/caps_spec. -end Capacity. -import Capacity DCapacity. +require import NewCommon. +(*---*) import Block DBlock Capacity DCapacity. (** Validity of Functionality Queries **) op valid: block list -> bool. -axiom valid_not_nil m: valid m => m <> []. - -(** Adversary's Query Cost **) -op max_query: int. -axiom max_query_ge0: 0 <= max_query. (*** DEFINITIONS ***) type state = block * capacity. From a727633a1f7ccd0c13d3bbf190c65677d011feda Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Fri, 2 Sep 2016 11:54:25 +0100 Subject: [PATCH 238/525] Progress on NewCore -> BlockSponge. Some changes to NewCore definitions. --- proof/clean/BlockSponge.eca | 218 ++++++++++++++++++++++++++++++++++++ proof/clean/NewCore.eca | 131 +--------------------- 2 files changed, 224 insertions(+), 125 deletions(-) create mode 100644 proof/clean/BlockSponge.eca diff --git a/proof/clean/BlockSponge.eca b/proof/clean/BlockSponge.eca new file mode 100644 index 0000000..2df60aa --- /dev/null +++ b/proof/clean/BlockSponge.eca @@ -0,0 +1,218 @@ +require import Pred Fun NewLogic NewDistr. +require import Option Int Real List NewFMap FSet. +require import StdOrder. +(*---*) import IntOrder. + +require import NewCommon. +(*---*) import Block DBlock Capacity DCapacity. + +(*** THEORY PARAMETERS ***) +(** Validity of Functionality Queries **) +op valid: block list -> int -> bool. + +(** Validity and Parsing/Formatting of Functionality Queries **) +op format (p : block list) (n : int) = p ++ nseq n b0. +op parse: block list -> (block list * int). + +axiom formatK bs: format (parse bs).`1 (parse bs).`2 = bs. +axiom parseK t n: valid t n => parse (format t n) = (t,n). + +lemma parse_injective: injective parse. +proof. by move=> bs1 bs2 eq_format; rewrite -formatK eq_format (@formatK bs2). qed. + +(*** DEFINITIONS ***) +(** Low-Level Definitions **) +require (*--*) NewCore. + +clone import NewCore as Low with + op valid bs <- valid (parse bs).`1 (parse bs).`2 +proof * by done. + +(** High-Level Definitions **) +(* Indifferentiability *) +clone import Indifferentiability as BS_Ind with + type p <- block * capacity, + type f_in <- block list * int, + type f_out <- block list +proof * by done. + +(* BlockSponge Construction *) +module (BlockSponge : CONSTRUCTION) (P : DPRIMITIVE) : FUNCTIONALITY = { + proc init() = {} + + proc f(p : block list, n : int) : block list = { + var r <- []; + var (sa,sc) <- (b0,c0); + var i <- 0; + + while (i < size p) { + (sa,sc) <@ P.f((sa +^ nth witness p i,sc)); + i <- i + 1; + } + i <- 0; + while (i < n) { + r <- rcons r sa; + i <- i + 1; + if (i < n) { + (sa,sc) <@ P.f(sa,sc); + } + } + return r; + } +}. + +(* Ideal Block Sponge Functionality *) +module IBlockSponge : FUNCTIONALITY = { + var m : (block list * int,block) fmap + + proc init() = { + m <- map0; + } + + proc fill_in(x, n) = { + if (!mem (dom m) (x, n)) { + m.[(x,n)] <$ bdistr; + } + return oget m.[(x,n)]; + } + + proc f(x, n) = { + var b, bs; + var i <- 0; + + bs <- []; + if (valid x n) { + while (i < n) { + b <@ fill_in(x, i); + bs <- rcons bs b; + i <- i + 1; + } + } + return bs; + } +}. + +(* Parametric Simulator *) +module (HiSim (S : Low.SIMULATOR) : SIMULATOR) (F : DFUNCTIONALITY) = { + module LoF = { + proc f(x : block list): block list = { + var r <- []; + var (p,n) <- parse x; + var b <- []; + var i <- 1; + + while (i <= n) { + b <- F.f(take i p,1); + r <- r ++ b; + i <- i + 1; + } + return r; + } + } + + proc init = S(LoF).init + proc f = S(LoF).f + proc fi = S(LoF).fi +}. + +(* Constructed Distinguisher *) +module (LoDist (D : DISTINGUISHER) : Low.DISTINGUISHER) + (F : Low.DFUNCTIONALITY) (P : Low.DPRIMITIVE) = { + module HiF = { + proc f(p : block list, n : int) = { + var r <- []; + + r <@ F.f(format p (n - 1)); + if (n <= 0) { + r <- drop (size p) r; + } else { + r <- drop (size p - 1) r; + } + return r; + } + } + + proc distinguish = D(HiF,P).distinguish +}. + +(*** PROOF + forall P D S, + LoDist(D)^{Core(P),P} ~ LoDist(D)^{ICore,S(ICore)} + => D^{BlockSponge(P),P} ~ D^{IBlockSponge,HiSim(S)(IBlockSponge)} ***) +section PROOF. + declare module P : PRIMITIVE { Low.ICore, IBlockSponge }. + declare module S : Low.SIMULATOR { Low.ICore, IBlockSponge, P }. + declare module D : DISTINGUISHER { Low.ICore, IBlockSponge, P, S }. + + lemma LiftInd &m: + `| Pr[Low.Indif(Core(P),P,LoDist(D)).main() @ &m: res] + - Pr[Low.Indif(ICore,S(ICore),LoDist(D)).main() @ &m: res] | + = `| Pr[Indif(BlockSponge(P),P,D).main() @ &m: res] + - Pr[Indif(IBlockSponge,HiSim(S,IBlockSponge),D).main() @ &m: res] |. + proof. + do !congr. + + byequiv (_: ={glob D, glob P} ==> _ )=> //=; proc. + call (_: ={glob P}); first 2 by sim. + + proc=> /=; inline{1} 2. + seq 5 3: ( ={glob P, p, n, r, sa, sc, i} + /\ sa{1} = b0 + /\ i{1} = 0 + /\ r{1} = [] + /\ r0{1} = [] + /\ p0{1} = p{1} ++ nseq (n{1} - 1) b0); 1: by auto. + splitwhile{1} 1: (i < size p); wp. + seq 1 1: ( ={glob P, p, n, r, sa, sc, i} + /\ r{2} = [] + /\ i{1} = size p{1} + /\ size r0{1} = size p{1} + /\ last b0 r0{1} = sa{2} + /\ p0{1} = p{1} ++ nseq (n{1} - 1) b0). + + while ( ={glob P, p, n, r, sa, sc, i} + /\ i{1} <= size p{1} + /\ size r0{1} = i{1} + /\ last b0 r0{1} = sa{2} + /\ p0{1} = p{1} ++ nseq (n{1} - 1) b0). + + wp; call (_: true); auto=> /> &1 &2 _ _ r_p. + rewrite nth_cat r_p=> /= -[sa sc] /=. + by rewrite last_rcons size_rcons /= size_cat size_nseq /#. + by auto=> /> &2; rewrite size_cat size_nseq; smt (size_ge0). + case: (n{1} <= 0). + + rcondf{1} 1; 1:by auto=> /> &hr; rewrite size_cat size_nseq /#. + rcondf{2} 2; 1:by auto=> /> &hr /#. + by auto=> /> &1 &2 <-; rewrite drop_size. + splitwhile{2} 2: (i < n - 1). rcondt{2} 3. + + auto; while (i < n); 2:by auto=> /#. + rcondt 3; 1:by auto=> /#. + by call (_: true)=> //; auto=> /#. + rcondf{2} 5. + + auto; while (i < n); 2:by auto=> /#. + rcondt 3; 1:by auto=> /#. + by call (_: true)=> //; auto=> /#. + rcondf{2} 5. + + auto; while (i < n); 2:by auto=> /#. + rcondt 3; 1:by auto=> /#. + by call (_: true)=> //; auto=> /#. + wp. + while ( ={glob P, n, sa, sc} + /\ 0 < n{1} + /\ i{1} = i{2} + size p{1} + /\ size p{1} <= size r0{1} + /\ size p{1} <= i{1} + /\ drop (size p{1} - 1) r0{1} = rcons r{2} sa{2} + /\ p0{1} = p{1} ++ nseq (n{1} - 1) b0). + + rcondt{2} 3; 1:by auto=> /> &hr /#. + wp; call (_: true); auto=> /> &1 &2 In Is Ii Ir. + rewrite size_cat size_nseq=> ? _ ?. + rewrite nth_cat ltzNge Ii /= nth_nseq 1:/#. + rewrite BlockMonoid.AddMonoid.addm0=> /= -[sa sc] /=. + by rewrite size_rcons -Ir -cats1 drop_cat !cats1 /#. + auto=> &1 &2 [#] <*> ^Hsize <- /ltzNge ^n_gt0 -> /=. + rewrite size_cat size_nseq /= -Hsize; do 2?split=> [|/#|/#]. + have: r0{1} <> [] by smt (size_eq0). + move=> {p_not_nil Hsize}; elim/last_ind: (r0{1})=> //= r sa ih _. + + by rewrite last_rcons size_rcons -cats1 addzK drop_cat. + by inline *; call (_: true). + byequiv=> //=. + admit. + qed. +end section PROOF. \ No newline at end of file diff --git a/proof/clean/NewCore.eca b/proof/clean/NewCore.eca index aea1710..eee1b99 100644 --- a/proof/clean/NewCore.eca +++ b/proof/clean/NewCore.eca @@ -22,111 +22,6 @@ clone include Indifferentiability with rename [module] "GReal" as "RealIndif" [module] "GIdeal" as "IdealIndif". -(** Query Counting **) -theory Counting. - module C = { - var c:int - proc init() = { c <- 0; } - }. - - module PC (P : PRIMITIVE) : PRIMITIVE = { - proc init () = { - C.init(); - P.init(); - } - - proc f (x : state) = { - var y; - - C.c <- C.c + 1; - y <@ P.f(x); - return y; - } - - proc fi(x : state) = { - var y; - - C.c <- C.c + 1; - y <@ P.fi(x); - return y; - } - }. - - module DPRestr (P : DPRIMITIVE) : DPRIMITIVE = { - proc f (x : state) = { - var y <- (b0,c0); - - if (C.c + 1 <= max_query) { - C.c <- C.c + 1; - y <@ P.f(x); - } - return y; - } - - proc fi(x : state) = { - var y <- (b0,c0); - - if (C.c + 1 <= max_query) { - C.c <- C.c + 1; - y <@ P.fi(x); - } - return y; - } - }. - - module PRestr (P : PRIMITIVE) : PRIMITIVE = { - proc init () = { - C.init(); - P.init(); - } - - proc f = DPRestr(P).f - proc fi = DPRestr(P).fi - }. - - module FC (F : FUNCTIONALITY) : FUNCTIONALITY = { - proc init = F.init - - proc f (p : block list) = { - var r <- []; - - if (valid p) { - C.c <- C.c + size p; - r <@ F.f(p); - } - return r; - } - }. - - module DFRestr (F : DFUNCTIONALITY) : DFUNCTIONALITY = { - proc f (bs : block list) = { - var r <- []; - - if (valid bs /\ C.c + size bs <= max_query) { - C.c <- C.c + size bs; - r <@ F.f(bs); - } - return r; - } - }. - - module FRestr(F : FUNCTIONALITY) : FUNCTIONALITY = { - proc init = F.init - proc f = DFRestr(F).f - }. - - module (DRestr (D : DISTINGUISHER) : DISTINGUISHER) - (F : DFUNCTIONALITY) (P : DPRIMITIVE) = { - proc distinguish() = { - var b; - - C.init(); - b <@ D(DFRestr(F), DPRestr(P)).distinguish(); - return b; - } - }. -end Counting. - (** Ideal Primitive **) clone export RP as Perm with type t <- block * capacity, @@ -142,11 +37,12 @@ module (Core : CONSTRUCTION) (P:DPRIMITIVE): FUNCTIONALITY = { proc f(p : block list): block list = { var (sa,sc) <- (b0,c0); var r <- []; + var i <- 0; - while (p <> []) { - (sa,sc) <@ P.f((sa +^ head witness p,sc)); + while (i < size p) { + (sa,sc) <@ P.f((sa +^ nth witness p i,sc)); r <- rcons r sa; - p <- behead p; + i <- i + 1; } return r; } @@ -169,11 +65,11 @@ module ICore : FUNCTIONALITY = { proc f(p : block list): block list = { var r <- []; - var i <- 0; + var i <- 1; var b; if (valid p) { - while (i < size p) { + while (i <= size p) { b <@ fill_in(take i p); r <- rcons r b; i <- i + 1; @@ -240,18 +136,3 @@ module (S : SIMULATOR) (F : DFUNCTIONALITY) : PRIMITIVE = { (** Initial and Final Games **) module GReal (D : DISTINGUISHER) = RealIndif(Core,Perm,D). module GIdeal (D : DISTINGUISHER) = IdealIndif(ICore,S,D). - -(*** PROOF ***) -import Counting. -lemma CoreIndiff (D <: DISTINGUISHER {C, Perm, Core, ICore, S}) &m: - (forall (F <: DFUNCTIONALITY {D}) (P <: DPRIMITIVE {D}), - islossless P.f - => islossless P.fi - => islossless F.f - => islossless D(F,P).distinguish) - => `| Pr[RealIndif(Core,Perm,DRestr(D)).main() @ &m: res] - - Pr[IdealIndif(ICore,S,DRestr(D)).main() @ &m :res] | - <= (max_query ^ 2)%r / (2^(r + c))%r - + max_query%r * ((2*max_query)%r / (2^c)%r) - + max_query%r * ((2*max_query)%r / (2^c)%r). -admitted. From c00b4f72310318913cbb05b7febc053540f2311f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Tue, 6 Sep 2016 21:32:36 +0100 Subject: [PATCH 239/525] Trying to figure things out. --- proof/clean/BlockSponge.eca | 261 ++++++++++++++++++++++++------------ proof/clean/NewCore.eca | 15 +-- 2 files changed, 176 insertions(+), 100 deletions(-) diff --git a/proof/clean/BlockSponge.eca b/proof/clean/BlockSponge.eca index 2df60aa..dccae19 100644 --- a/proof/clean/BlockSponge.eca +++ b/proof/clean/BlockSponge.eca @@ -1,5 +1,5 @@ require import Pred Fun NewLogic NewDistr. -require import Option Int Real List NewFMap FSet. +require import Option Int IntExtra Real List NewFMap FSet. require import StdOrder. (*---*) import IntOrder. @@ -8,14 +8,15 @@ require import NewCommon. (*** THEORY PARAMETERS ***) (** Validity of Functionality Queries **) -op valid: block list -> int -> bool. +op valid: block list -> bool. +axiom valid_spec p: valid p => p <> []. (** Validity and Parsing/Formatting of Functionality Queries **) -op format (p : block list) (n : int) = p ++ nseq n b0. +op format (p : block list) (n : int) = p ++ nseq (n - 1) b0. op parse: block list -> (block list * int). axiom formatK bs: format (parse bs).`1 (parse bs).`2 = bs. -axiom parseK t n: valid t n => parse (format t n) = (t,n). +axiom parseK p n: 0 < n => valid p => parse (format p n) = (p,n). lemma parse_injective: injective parse. proof. by move=> bs1 bs2 eq_format; rewrite -formatK eq_format (@formatK bs2). qed. @@ -25,7 +26,7 @@ proof. by move=> bs1 bs2 eq_format; rewrite -formatK eq_format (@formatK bs2). q require (*--*) NewCore. clone import NewCore as Low with - op valid bs <- valid (parse bs).`1 (parse bs).`2 + op valid bs <- valid (parse bs).`1 /\ 0 < (parse bs).`2 proof * by done. (** High-Level Definitions **) @@ -45,16 +46,18 @@ module (BlockSponge : CONSTRUCTION) (P : DPRIMITIVE) : FUNCTIONALITY = { var (sa,sc) <- (b0,c0); var i <- 0; - while (i < size p) { - (sa,sc) <@ P.f((sa +^ nth witness p i,sc)); - i <- i + 1; - } - i <- 0; - while (i < n) { - r <- rcons r sa; - i <- i + 1; - if (i < n) { - (sa,sc) <@ P.f(sa,sc); + if (valid p /\ 0 < n) { + while (i < size p) { + (sa,sc) <@ P.f((sa +^ nth witness p i,sc)); + i <- i + 1; + } + i <- 0; + while (i < n) { + r <- rcons r sa; + i <- i + 1; + if (i < n) { + (sa,sc) <@ P.f(sa,sc); + } } } return r; @@ -78,11 +81,11 @@ module IBlockSponge : FUNCTIONALITY = { proc f(x, n) = { var b, bs; - var i <- 0; + var i <- 1; bs <- []; - if (valid x n) { - while (i < n) { + if (valid x /\ 0 < n) { + while (i <= n) { b <@ fill_in(x, i); bs <- rcons bs b; i <- i + 1; @@ -101,10 +104,15 @@ module (HiSim (S : Low.SIMULATOR) : SIMULATOR) (F : DFUNCTIONALITY) = { var b <- []; var i <- 1; - while (i <= n) { - b <- F.f(take i p,1); + if (valid p /\ 0 < n) + { + while (i <= size p) { + b <@ F.f(take i p,1); + r <- r ++ b; + i <- i + 1; + } + b <@ F.f(p,n); r <- r ++ b; - i <- i + 1; } return r; } @@ -115,6 +123,9 @@ module (HiSim (S : Low.SIMULATOR) : SIMULATOR) (F : DFUNCTIONALITY) = { proc fi = S(LoF).fi }. +pred INV (mc : (block list,block) fmap) (mb : (block list * int,block) fmap) = + forall p, mc.[p] = mb.[parse p]. + (* Constructed Distinguisher *) module (LoDist (D : DISTINGUISHER) : Low.DISTINGUISHER) (F : Low.DFUNCTIONALITY) (P : Low.DPRIMITIVE) = { @@ -122,11 +133,9 @@ module (LoDist (D : DISTINGUISHER) : Low.DISTINGUISHER) proc f(p : block list, n : int) = { var r <- []; - r <@ F.f(format p (n - 1)); - if (n <= 0) { - r <- drop (size p) r; - } else { - r <- drop (size p - 1) r; + if (valid p /\ 0 < n) { + r <@ F.f(format p n); + r <- drop (size p - b2i (n <> 0)) r; } return r; } @@ -140,9 +149,9 @@ module (LoDist (D : DISTINGUISHER) : Low.DISTINGUISHER) LoDist(D)^{Core(P),P} ~ LoDist(D)^{ICore,S(ICore)} => D^{BlockSponge(P),P} ~ D^{IBlockSponge,HiSim(S)(IBlockSponge)} ***) section PROOF. - declare module P : PRIMITIVE { Low.ICore, IBlockSponge }. - declare module S : Low.SIMULATOR { Low.ICore, IBlockSponge, P }. - declare module D : DISTINGUISHER { Low.ICore, IBlockSponge, P, S }. + declare module P : PRIMITIVE { Low.ICore, IBlockSponge, HiSim }. + declare module S : Low.SIMULATOR { Low.ICore, IBlockSponge, HiSim, P }. + declare module D : DISTINGUISHER { Low.ICore, IBlockSponge, HiSim, P, S }. lemma LiftInd &m: `| Pr[Low.Indif(Core(P),P,LoDist(D)).main() @ &m: res] @@ -153,66 +162,146 @@ section PROOF. do !congr. + byequiv (_: ={glob D, glob P} ==> _ )=> //=; proc. call (_: ={glob P}); first 2 by sim. - + proc=> /=; inline{1} 2. - seq 5 3: ( ={glob P, p, n, r, sa, sc, i} + + proc=> /=; sp; if=>//=; inline{1} 1. + seq 4 0: ( ={glob P, p, n, r, sa, sc, i} + /\ p{1} <> [] + /\ 0 < n{1} /\ sa{1} = b0 /\ i{1} = 0 /\ r{1} = [] /\ r0{1} = [] - /\ p0{1} = p{1} ++ nseq (n{1} - 1) b0); 1: by auto. - splitwhile{1} 1: (i < size p); wp. - seq 1 1: ( ={glob P, p, n, r, sa, sc, i} - /\ r{2} = [] - /\ i{1} = size p{1} - /\ size r0{1} = size p{1} - /\ last b0 r0{1} = sa{2} /\ p0{1} = p{1} ++ nseq (n{1} - 1) b0). - + while ( ={glob P, p, n, r, sa, sc, i} - /\ i{1} <= size p{1} - /\ size r0{1} = i{1} - /\ last b0 r0{1} = sa{2} - /\ p0{1} = p{1} ++ nseq (n{1} - 1) b0). - + wp; call (_: true); auto=> /> &1 &2 _ _ r_p. - rewrite nth_cat r_p=> /= -[sa sc] /=. - by rewrite last_rcons size_rcons /= size_cat size_nseq /#. - by auto=> /> &2; rewrite size_cat size_nseq; smt (size_ge0). - case: (n{1} <= 0). - + rcondf{1} 1; 1:by auto=> /> &hr; rewrite size_cat size_nseq /#. - rcondf{2} 2; 1:by auto=> /> &hr /#. - by auto=> /> &1 &2 <-; rewrite drop_size. - splitwhile{2} 2: (i < n - 1). rcondt{2} 3. - + auto; while (i < n); 2:by auto=> /#. - rcondt 3; 1:by auto=> /#. - by call (_: true)=> //; auto=> /#. - rcondf{2} 5. - + auto; while (i < n); 2:by auto=> /#. - rcondt 3; 1:by auto=> /#. - by call (_: true)=> //; auto=> /#. - rcondf{2} 5. - + auto; while (i < n); 2:by auto=> /#. - rcondt 3; 1:by auto=> /#. - by call (_: true)=> //; auto=> /#. - wp. - while ( ={glob P, n, sa, sc} - /\ 0 < n{1} - /\ i{1} = i{2} + size p{1} - /\ size p{1} <= size r0{1} - /\ size p{1} <= i{1} - /\ drop (size p{1} - 1) r0{1} = rcons r{2} sa{2} - /\ p0{1} = p{1} ++ nseq (n{1} - 1) b0). - + rcondt{2} 3; 1:by auto=> /> &hr /#. - wp; call (_: true); auto=> /> &1 &2 In Is Ii Ir. - rewrite size_cat size_nseq=> ? _ ?. - rewrite nth_cat ltzNge Ii /= nth_nseq 1:/#. - rewrite BlockMonoid.AddMonoid.addm0=> /= -[sa sc] /=. - by rewrite size_rcons -Ir -cats1 drop_cat !cats1 /#. - auto=> &1 &2 [#] <*> ^Hsize <- /ltzNge ^n_gt0 -> /=. - rewrite size_cat size_nseq /= -Hsize; do 2?split=> [|/#|/#]. - have: r0{1} <> [] by smt (size_eq0). - move=> {p_not_nil Hsize}; elim/last_ind: (r0{1})=> //= r sa ih _. - + by rewrite last_rcons size_rcons -cats1 addzK drop_cat. - by inline *; call (_: true). - byequiv=> //=. - admit. + + by auto=> /> &2 /valid_spec. + splitwhile{1} 1: (i < size p). + splitwhile{2} 3: (i < n - 1). + rcondt{2} 4. + + auto; while (i < n); 2:by wp; conseq (_: _ ==> true)=> // /#. + by sp; if; 1:call (_: true); auto=> /#. + rcondf{2} 6. + + auto; while (i < n); 2:by wp; conseq (_: _ ==> true)=> // /#. + by sp; if; 1:call (_: true); auto=> /#. + rcondf{2} 6. + + auto; while (i < n); 2:by wp; conseq (_: _ ==> true)=> // /#. + by sp; if; 1:call (_: true); auto=> /#. + wp; while ( ={glob P, p, n, sa, sc} + /\ i{1} = i{2} + size p{2} + /\ drop (size p - 1){1} r0{1} = rcons r{2} sa{2} + /\ 0 <= i{2} + /\ p{1} <> [] + /\ 0 < n{1} + /\ p0{1} = p{1} ++ nseq (n{1} - 1) b0). + + rcondt{2} 3; 1:by auto=> /#. + wp; call (_: true); auto=> /> &1 &2 eq_r i_ge0 p_neq_nil n_ge0 i1_lt_szp0 _ i2_lt_Pn. + rewrite nth_cat -subr_lt0 addzK ltzNge i_ge0 /=. + rewrite nth_nseq // BlockMonoid.AddMonoid.addm0=> /= -[sa sc] /=. + rewrite size_cat size_nseq; split=> [|/#]; split=> [/#|]; split=> [|/#]. + smt (@List). + wp; while ( ={glob P, p, n, sa, sc, i} + /\ i{1} <= size p{1} + /\ size r0{1} = i{1} + /\ last b0 r0{1} = sa{2} + /\ p0{1} = p{1} ++ nseq (n{1} - 1) b0). + + wp; call (_: true); auto=> /> &1 &2. + rewrite size_cat size_nseq=> _ _ szr0_lt_szp. + rewrite nth_cat szr0_lt_szp=> /= -[sa sc] /=. + by rewrite size_rcons last_rcons /= /#. + auto=> /> &2 p_neq_nil n_gt0. + rewrite size_cat size_nseq size_ge0; split=> [/#|r _]. + rewrite ltzNge=> /= szp_le_szr szr_le_szp; split=> [|/#]; split=> [|/#]; split=> [/#|]. + smt (@List). + by inline *; call (_: true). + byequiv (_: ={glob D, glob S} ==> _)=> //=; proc. + call (_: ={glob S} + /\ INV ICore.m{1} IBlockSponge.m{2}). + + proc (INV ICore.m{1} IBlockSponge.m{2})=> //. + proc=> /=; sp; if=> [&1 &2 [#] <*> <-| |] //. + conseq (_: ={r, i} + /\ r{2} = [] + /\ b{2} = [] + /\ i{2} = 1 + /\ parse p{1} = (p{2},n{2}) + /\ valid p{2} + /\ 0 < n{2} + /\ INV ICore.m{1} IBlockSponge.m{2} + ==> _)=> />. + + by move=> &1 &2=> <-. + splitwhile{1} 1: (i <= size (parse p).`1); inline{2} 2. + rcondt{2} 6; first by auto; while (true)=> //; auto=> /> &hr <- //. + wp; while ( i{1} = i0{2} + size x0{2} - 1 + /\ p{1} = x0{2} ++ nseq (n0 - 1){2} b0 + /\ r{1} = r{2} ++ bs{2} + /\ 0 < i0{2} + /\ valid x0{2} + /\ INV ICore.m{1} IBlockSponge.m{2}). + + wp; call (_: arg{1} = format arg{2}.`1 arg{2}.`2 + /\ 0 < arg{2}.`2 + /\ valid arg{2}.`1 + /\ INV ICore.m{1} IBlockSponge.m{2} + ==> ={res} + /\ INV ICore.m{1} IBlockSponge.m{2}). + + proc; if=> //=. + + by move=> /> &1 &2 n_gt0 valid_x; rewrite !in_dom -parseK=> // ->. + + auto=> /> &1 &2 n_gt0 valid_x HINV _ b _; rewrite !getP /=. + move=> p'; rewrite !getP; case: (parse p' = (x,n){2}). + + by rewrite -parseK=> // /parse_injective ->. + by case: (p' = format x{2} n{2})=> //= [<*>|_ _]; [rewrite parseK|exact/HINV]. + by auto=> /> &1 &2 n_gt0 valid_x ->; rewrite parseK. + auto=> /> &1 &2 i0_gt0 + + _ i0_le_n0. + have ->: take (i0 + size x0 - 1){2} (x0 ++ nseq (n0 - 1) Block.b0){2} + = x0{2} ++ nseq (i0 - 1){2} b0. + + rewrite take_cat. + have -> /=: !i0{2} + size x0{2} - 1 < size x0{2} by smt (). + congr; apply/(eq_from_nth witness). + + by rewrite size_take ?size_nseq /#. + move=> j; rewrite size_take ?size_nseq 1:/#. + by move=> [j_ge0 j_lt_i0]; rewrite nth_take ?nth_nseq /#. + rewrite /format size_cat size_nseq=> /= _ _ b mc mb _. + by rewrite rcons_cat /= /#. + wp; conseq (_: ={r, i} + /\ r{2} = [] + /\ b{2} = [] + /\ i{2} = 1 + /\ parse p{1} = (p,n){2} + /\ valid p{2} + /\ 0 < n{2} + /\ INV ICore.m{1} IBlockSponge.m{2} + ==> ={r} + /\ i{1} = size p{2} + /\ INV ICore.m{1} IBlockSponge.m{2})=> //=. + + move=> &1 &2 [#] !<<- !->> parse_p valid_p n_gt0 _ mc i r1 mb ? [#] <<*> HINV. + move: n_gt0 valid_p=> ^n_gt0 /parseK H ^valid_p /H {H}. + rewrite -parse_p cats0 valid_p HINV=> /parse_injective <<- @/format /=. + by rewrite size_cat size_nseq /= /#. + while ( ={r, i} + /\ valid p{2} + /\ 0 < n{2} + /\ p{1} = p{2} ++ nseq (n - 1){2} b0 + /\ 0 < i{1} + /\ INV ICore.m{1} IBlockSponge.m{2}). + + wp; call (_: arg{1} = arg{2}.`1 + /\ arg{2}.`2 = 1 + /\ INV ICore.m{1} IBlockSponge.m{2} + ==> res{2} = [res{1}] + /\ INV ICore.m{1} IBlockSponge.m{2}). + + admit. (* This is false because of the validity check. Figure it out. *) + auto=> /> &1 &2 valid_p n_gt0 i_gt0 _ _ _ i_le_szp. + have ->: take i{2} (p{2} ++ nseq (n{2} - 1) b0) = take i{2} p{2}. + + rewrite take_cat; case: (i{2} = size p{2})=> [-> /=|/#]. + by rewrite take0 take_size cats0. + move: n_gt0 valid_p=> ^n_gt0 /parseK H ^valid_p /H {H} @/format -> /=. + by move=> b mc mb _; rewrite cats1 /= size_cat size_nseq /#. + (* BUG: auto=> />. anomaly: ECLowGOal.InvalidProofTerm *) + auto=> &1 &2 [#] !->> parse_p valid_p n_gt0 HINV /=; rewrite valid_p n_gt0 HINV. + move: n_gt0 valid_p=> ^n_gt0 /parseK H ^valid_p /H {H}. + rewrite -parse_p=> /parse_injective <<- @/format /=. + rewrite parse_p size_cat size_nseq /=. + split=> [/#|mc i r mb ? ? + + [#] <*> /=]. + (* stupid off-by-one *) admit. + + admit. + + proc; sp; if=> //=; inline{1} 1; rcondt{1} 4. + + by auto=> /> &hr _ ^valid_x+ ^n_gt0 /parseK H - /H {H} ->. + (* same as the second loop in LoF.f *) + admit. + by inline *; auto; call (_: true); auto=> /> p; rewrite !map0P. qed. -end section PROOF. \ No newline at end of file +end section PROOF. diff --git a/proof/clean/NewCore.eca b/proof/clean/NewCore.eca index eee1b99..ca801f8 100644 --- a/proof/clean/NewCore.eca +++ b/proof/clean/NewCore.eca @@ -22,16 +22,8 @@ clone include Indifferentiability with rename [module] "GReal" as "RealIndif" [module] "GIdeal" as "IdealIndif". -(** Ideal Primitive **) -clone export RP as Perm with - type t <- block * capacity, - op dt <- bdistr `*` cdistr - rename - [module type] "RP" as "PRIMITIVE" - [module] "P" as "Perm". - (** Core Construction **) -module (Core : CONSTRUCTION) (P:DPRIMITIVE): FUNCTIONALITY = { +module (Core : CONSTRUCTION) (P : DPRIMITIVE): FUNCTIONALITY = { proc init () = {} proc f(p : block list): block list = { @@ -97,7 +89,6 @@ module (S : SIMULATOR) (F : DFUNCTIONALITY) : PRIMITIVE = { if (!mem (dom m) x) { if (mem (dom pi) x.`2) { (p,v) <- oget pi.[x.`2]; - (* Not sure *) b <- F.f (rcons p (v +^ x.`1)); y1 <- last b0 b; } else { @@ -132,7 +123,3 @@ module (S : SIMULATOR) (F : DFUNCTIONALITY) : PRIMITIVE = { return y; } }. - -(** Initial and Final Games **) -module GReal (D : DISTINGUISHER) = RealIndif(Core,Perm,D). -module GIdeal (D : DISTINGUISHER) = IdealIndif(ICore,S,D). From d3a41eadddc046e64616e4e94eefe94241cf351d Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Tue, 6 Sep 2016 19:46:07 -0400 Subject: [PATCH 240/525] Finished documentation of top-level proof. --- proof/Sponge.ec | 90 +++++++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 88 insertions(+), 2 deletions(-) diff --git a/proof/Sponge.ec b/proof/Sponge.ec index 575c58e..6b38d51 100644 --- a/proof/Sponge.ec +++ b/proof/Sponge.ec @@ -96,8 +96,94 @@ module LowerDist (D : DISTINGUISHER, F : BlockSponge.DFUNCTIONALITY) = module RaiseSim (S : BlockSponge.SIMULATOR, F : DFUNCTIONALITY) = S(LowerFun(F)). +(* Our main result will be: + + lemma conclusion + (BlockSim <: BlockSponge.SIMULATOR{IRO, BlockSponge.BIRO.IRO}) + (Dist <: DISTINGUISHER{Perm, BlockSim, IRO, BlockSponge.BIRO.IRO}) + &m : + `|Pr[RealIndif(Sponge, Perm, Dist).main() @ &m : res] - + Pr[IdealIndif(IRO, RaiseSim(BlockSim), Dist).main() @ &m : res]| = + `|Pr[BlockSponge.RealIndif + (BlockSponge.Sponge, Perm, LowerDist(Dist)).main() @ &m : res] - + Pr[BlockSponge.IdealIndif + (BlockSponge.BIRO.IRO, BlockSim, LowerDist(Dist)).main() @ &m : res]| +*) + (*------------------------------- Proof --------------------------------*) +(* Proving the Real side + + Pr[RealIndif(Sponge, Perm, Dist).main() @ &m : res] = + Pr[BlockSponge.RealIndif + (BlockSponge.Sponge, Perm, LowerDist(Dist)).main() @ &m : res] + + is easy (see lemma RealIndif_Sponge_BlockSponge) + + And we split the proof of the Ideal side (IdealIndif_IRO_BlockIRO) + + Pr[IdealIndif(IRO, RaiseSim(BlockSim), Dist).main() @ &m : res] = + Pr[BlockSponge.IdealIndif + (BlockSponge.BIRO.IRO, BlockSim, LowerDist(Dist)).main () @ &m : res]. + + into three steps, involving Hybrid IROs, which, in addition to + an init procedure, have procedures + + (* hashing block lists, giving n bits *) + proc g(x : block list, n : int) : bool list + + (* hashing block lists, giving n blocks *) + proc f(x : block list, n : int) : block list + + We have lazy (HybridIROLazy) and eager (HybridIROEager) Hybrid + IROs, both of which work with a finite map from block list * int to + bool. In both versions, f is defined in terms of g. In the lazy + version, g consults/randomly updates just those elements of the + map's domain needed to produce the needed bits. But the eager + version goes further, consulting/randomly updating enough extra + domain elements so that a multiple of r domain elements were + consulted/randomly updated (those extra bits are discarded) + + We have a parameterized module RaiseHybridIRO for turning a Hybrid + IRO into a FUNCTIONALITY in the obvious way, and we split the proof + of the Ideal side into three steps: + + Step 1: + + Pr[IdealIndif(IRO, RaiseSim(BlockSim), Dist).main() @ &m : res] = + Pr[Experiment + (RaiseHybridIRO(HybridIROLazy), BlockSim(HybridIROLazy), + Dist).main() @ &m : res] + + This step is proved using a lazy invariant relating the + maps of the bit-based IRO and HybridIROLazy + + Step 2: + + Pr[Experiment + (RaiseHybridIRO(HybridIROLazy), BlockSim(HybridIROLazy), + Dist).main() @ &m : res] = + Pr[Experiment + (RaiseHybridIRO(HybridIROEager), BlockSim(HybridIROEager), + Dist).main() @ &m : res] + + This step is proved using the eager sampling lemma provided by + RndO. + + Step 3: + + Pr[Experiment + (RaiseHybridIRO(HybridIROEager), BlockSim(HybridIROEager), + Dist).main() @ &m : res] = + Pr[BlockSponge.IdealIndif + (BlockSponge.BIRO.IRO, BlockSim, LowerDist(Dist)).main () @ &m : res] + + This step is proved using an invariant relating the maps of + HybridIROEager and the block-based IRO. Its proof is the most + involved, and uses the Program abstract theory of DList to show the + equivalence of randomly choosing a block and forming a block out + of r randomly chosen bits *) + (*------------------- abstract theory of Hybrid IROs -------------------*) abstract theory HybridIRO. @@ -106,10 +192,10 @@ module type HYBRID_IRO = { (* initialization *) proc init() : unit - (* hashing blocks, giving n bits *) + (* hashing block lists, giving n bits *) proc g(x : block list, n : int) : bool list - (* hashing blocks, giving n blocks *) + (* hashing block lists, giving n blocks *) proc f(x : block list, n : int) : block list }. From c60a954743884a5dcacc7910e7d91973ae8354fb Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Tue, 6 Sep 2016 20:08:01 -0400 Subject: [PATCH 241/525] Nit. --- proof/Sponge.ec | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/proof/Sponge.ec b/proof/Sponge.ec index 6b38d51..3873aaa 100644 --- a/proof/Sponge.ec +++ b/proof/Sponge.ec @@ -145,8 +145,8 @@ module RaiseSim (S : BlockSponge.SIMULATOR, F : DFUNCTIONALITY) = consulted/randomly updated (those extra bits are discarded) We have a parameterized module RaiseHybridIRO for turning a Hybrid - IRO into a FUNCTIONALITY in the obvious way, and we split the proof - of the Ideal side into three steps: + IRO into a FUNCTIONALITY in the obvious way (not using f), and we + split the proof of the Ideal side into three steps: Step 1: From 7a5d394a1ae1909ce6235c58828c79dbdeb073a4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Thu, 14 Dec 2017 17:29:10 +0100 Subject: [PATCH 242/525] The first admit has been killed. The second admit, I cannot say. The third admit is false. --- proof/clean/BlockSponge.eca | 148 ++++++++++++++++++------------------ proof/clean/NewCommon.ec | 4 +- proof/clean/NewCore.eca | 12 +-- 3 files changed, 80 insertions(+), 84 deletions(-) diff --git a/proof/clean/BlockSponge.eca b/proof/clean/BlockSponge.eca index dccae19..81f2751 100644 --- a/proof/clean/BlockSponge.eca +++ b/proof/clean/BlockSponge.eca @@ -1,5 +1,5 @@ -require import Pred Fun NewLogic NewDistr. -require import Option Int IntExtra Real List NewFMap FSet. +require import Core Logic Distr. +require import Int IntExtra Real List NewFMap FSet. require import StdOrder. (*---*) import IntOrder. @@ -10,6 +10,8 @@ require import NewCommon. (** Validity of Functionality Queries **) op valid: block list -> bool. axiom valid_spec p: valid p => p <> []. +(* FIXME : verify if this axiom is correct. *) +axiom valid_take p i: valid p => 0 < i => valid (take i p). (** Validity and Parsing/Formatting of Functionality Queries **) op format (p : block list) (n : int) = p ++ nseq (n - 1) b0. @@ -21,6 +23,25 @@ axiom parseK p n: 0 < n => valid p => parse (format p n) = (p,n). lemma parse_injective: injective parse. proof. by move=> bs1 bs2 eq_format; rewrite -formatK eq_format (@formatK bs2). qed. +lemma parse_valid p: valid p => parse p = (p,1). +proof. +move=>h;cut{1}->:p=format p 1;2:smt(parseK). +by rewrite/format/=nseq0 cats0. +qed. + +(******************* Useful lemmas ******************) +lemma take_nseq (b:block) i j : take i (nseq j b) = nseq (min i j) b. +proof. +move:i;elim/natind=>//=. ++ smt(take_le0 nseq0_le). +move=>i hi0 hind. +case(i + 1 <= j)=>hi1j. ++ rewrite (take_nth b);1:smt(size_nseq). + rewrite hind nth_nseq 1:/# //=-nseqSr/#. +rewrite take_oversize;smt(size_nseq). +qed. + + (*** DEFINITIONS ***) (** Low-Level Definitions **) require (*--*) NewCore. @@ -106,7 +127,7 @@ module (HiSim (S : Low.SIMULATOR) : SIMULATOR) (F : DFUNCTIONALITY) = { if (valid p /\ 0 < n) { - while (i <= size p) { + while (i < size p) { b <@ F.f(take i p,1); r <- r ++ b; i <- i + 1; @@ -149,13 +170,13 @@ module (LoDist (D : DISTINGUISHER) : Low.DISTINGUISHER) LoDist(D)^{Core(P),P} ~ LoDist(D)^{ICore,S(ICore)} => D^{BlockSponge(P),P} ~ D^{IBlockSponge,HiSim(S)(IBlockSponge)} ***) section PROOF. - declare module P : PRIMITIVE { Low.ICore, IBlockSponge, HiSim }. - declare module S : Low.SIMULATOR { Low.ICore, IBlockSponge, HiSim, P }. - declare module D : DISTINGUISHER { Low.ICore, IBlockSponge, HiSim, P, S }. + declare module P : PRIMITIVE { Low.ICORE, IBlockSponge, HiSim }. + declare module S : Low.SIMULATOR { Low.ICORE, IBlockSponge, HiSim, P }. + declare module D : DISTINGUISHER { Low.ICORE, IBlockSponge, HiSim, P, S }. lemma LiftInd &m: - `| Pr[Low.Indif(Core(P),P,LoDist(D)).main() @ &m: res] - - Pr[Low.Indif(ICore,S(ICore),LoDist(D)).main() @ &m: res] | + `| Pr[Low.Indif(CORE(P),P,LoDist(D)).main() @ &m: res] + - Pr[Low.Indif(ICORE,S(ICORE),LoDist(D)).main() @ &m: res] | = `| Pr[Indif(BlockSponge(P),P,D).main() @ &m: res] - Pr[Indif(IBlockSponge,HiSim(S,IBlockSponge),D).main() @ &m: res] |. proof. @@ -212,8 +233,8 @@ section PROOF. by inline *; call (_: true). byequiv (_: ={glob D, glob S} ==> _)=> //=; proc. call (_: ={glob S} - /\ INV ICore.m{1} IBlockSponge.m{2}). - + proc (INV ICore.m{1} IBlockSponge.m{2})=> //. + /\ INV ICORE.m{1} IBlockSponge.m{2}). + + proc (INV ICORE.m{1} IBlockSponge.m{2})=> //. proc=> /=; sp; if=> [&1 &2 [#] <*> <-| |] //. conseq (_: ={r, i} /\ r{2} = [] @@ -222,84 +243,59 @@ section PROOF. /\ parse p{1} = (p{2},n{2}) /\ valid p{2} /\ 0 < n{2} - /\ INV ICore.m{1} IBlockSponge.m{2} + /\ INV ICORE.m{1} IBlockSponge.m{2} ==> _)=> />. + by move=> &1 &2=> <-. - splitwhile{1} 1: (i <= size (parse p).`1); inline{2} 2. + splitwhile{1} 1: (i < size (parse p).`1); inline{2} 2. rcondt{2} 6; first by auto; while (true)=> //; auto=> /> &hr <- //. - wp; while ( i{1} = i0{2} + size x0{2} - 1 + wp. while ( i{1} = i0{2} + size x0{2} - 1 /\ p{1} = x0{2} ++ nseq (n0 - 1){2} b0 /\ r{1} = r{2} ++ bs{2} /\ 0 < i0{2} /\ valid x0{2} - /\ INV ICore.m{1} IBlockSponge.m{2}). - + wp; call (_: arg{1} = format arg{2}.`1 arg{2}.`2 - /\ 0 < arg{2}.`2 - /\ valid arg{2}.`1 - /\ INV ICore.m{1} IBlockSponge.m{2} - ==> ={res} - /\ INV ICore.m{1} IBlockSponge.m{2}). - + proc; if=> //=. - + by move=> /> &1 &2 n_gt0 valid_x; rewrite !in_dom -parseK=> // ->. - + auto=> /> &1 &2 n_gt0 valid_x HINV _ b _; rewrite !getP /=. - move=> p'; rewrite !getP; case: (parse p' = (x,n){2}). - + by rewrite -parseK=> // /parse_injective ->. - by case: (p' = format x{2} n{2})=> //= [<*>|_ _]; [rewrite parseK|exact/HINV]. - by auto=> /> &1 &2 n_gt0 valid_x ->; rewrite parseK. - auto=> /> &1 &2 i0_gt0 + + _ i0_le_n0. - have ->: take (i0 + size x0 - 1){2} (x0 ++ nseq (n0 - 1) Block.b0){2} - = x0{2} ++ nseq (i0 - 1){2} b0. - + rewrite take_cat. - have -> /=: !i0{2} + size x0{2} - 1 < size x0{2} by smt (). - congr; apply/(eq_from_nth witness). - + by rewrite size_take ?size_nseq /#. - move=> j; rewrite size_take ?size_nseq 1:/#. - by move=> [j_ge0 j_lt_i0]; rewrite nth_take ?nth_nseq /#. - rewrite /format size_cat size_nseq=> /= _ _ b mc mb _. - by rewrite rcons_cat /= /#. - wp; conseq (_: ={r, i} - /\ r{2} = [] - /\ b{2} = [] - /\ i{2} = 1 - /\ parse p{1} = (p,n){2} - /\ valid p{2} - /\ 0 < n{2} - /\ INV ICore.m{1} IBlockSponge.m{2} - ==> ={r} - /\ i{1} = size p{2} - /\ INV ICore.m{1} IBlockSponge.m{2})=> //=. - + move=> &1 &2 [#] !<<- !->> parse_p valid_p n_gt0 _ mc i r1 mb ? [#] <<*> HINV. - move: n_gt0 valid_p=> ^n_gt0 /parseK H ^valid_p /H {H}. - rewrite -parse_p cats0 valid_p HINV=> /parse_injective <<- @/format /=. - by rewrite size_cat size_nseq /= /#. - while ( ={r, i} + /\ n{2} = n0{2} + /\ INV ICORE.m{1} IBlockSponge.m{2} + /\ parse p{1} = (p{2}, n{2})). + + wp;inline*;sp;wp;if;auto;smt(parseK min_lel size_nseq take_nseq + rcons_cat parse_injective getP in_dom oget_some take_size take0 + take_cat parse_valid valid_take cat_rcons cats0 size_cat size_ge0). + wp=>/=. + conseq(:_==> ={r, i} /\ valid p{2} /\ 0 < n{2} - /\ p{1} = p{2} ++ nseq (n - 1){2} b0 - /\ 0 < i{1} - /\ INV ICore.m{1} IBlockSponge.m{2}). - + wp; call (_: arg{1} = arg{2}.`1 - /\ arg{2}.`2 = 1 - /\ INV ICore.m{1} IBlockSponge.m{2} - ==> res{2} = [res{1}] - /\ INV ICore.m{1} IBlockSponge.m{2}). - + admit. (* This is false because of the validity check. Figure it out. *) - auto=> /> &1 &2 valid_p n_gt0 i_gt0 _ _ _ i_le_szp. - have ->: take i{2} (p{2} ++ nseq (n{2} - 1) b0) = take i{2} p{2}. - + rewrite take_cat; case: (i{2} = size p{2})=> [-> /=|/#]. - by rewrite take0 take_size cats0. - move: n_gt0 valid_p=> ^n_gt0 /parseK H ^valid_p /H {H} @/format -> /=. - by move=> b mc mb _; rewrite cats1 /= size_cat size_nseq /#. - (* BUG: auto=> />. anomaly: ECLowGOal.InvalidProofTerm *) - auto=> &1 &2 [#] !->> parse_p valid_p n_gt0 HINV /=; rewrite valid_p n_gt0 HINV. - move: n_gt0 valid_p=> ^n_gt0 /parseK H ^valid_p /H {H}. - rewrite -parse_p=> /parse_injective <<- @/format /=. - rewrite parse_p size_cat size_nseq /=. - split=> [/#|mc i r mb ? ? + + [#] <*> /=]. - (* stupid off-by-one *) admit. + /\ p{1} = p{2} ++ nseq (n{2} - 1) Block.b0 + /\ i{1} = size p{2} + /\ parse p{1} = (p{2}, n{2}) + /\ INV ICORE.m{1} IBlockSponge.m{2});progress;..-2:smt(cats0 size_cat size_ge0). + while( ={r,i} + /\ valid p{2} + /\ 0 < n{2} + /\ p{1} = p{2} ++ nseq (n{2} - 1) Block.b0 + /\ 0 < i{1} <= size p{2} + /\ parse p{1} = (p{2}, n{2}) + /\ INV ICORE.m{1} IBlockSponge.m{2}). + + inline*;auto;sp;rcondt{2}1;1:(auto;smt(valid_take)). + rcondt{2}1;1:auto;sp;rcondf{2}5;1:auto;if;auto; + smt(parse_injective getP oget_some in_dom take_size take0 take_cat + parse_valid valid_take cat_rcons cats0 size_cat size_ge0). + auto;smt(parseK min_lel size_nseq take_nseq valid_spec + rcons_cat parse_injective getP in_dom oget_some take_size take0 + take_cat parse_valid valid_take cat_rcons cats0 size_cat size_ge0). + admit. + proc; sp; if=> //=; inline{1} 1; rcondt{1} 4. + by auto=> /> &hr _ ^valid_x+ ^n_gt0 /parseK H - /H {H} ->. + sp;wp. + conseq(:_==> drop (size p{1} - 1) r0{1} = bs{2} + /\ ={glob S} + /\ INV ICORE.m{1} IBlockSponge.m{2});progress. + by do !congr;rewrite b2i_eq1/#. + inline*;rewrite/INV. +(* This is false : because ICORE.m{1} will be bigger than IBlockSponge.m{2} *) + splitwhile{1}1:i<=size p;rcondt{2}1;1:auto=>/#. + inline*. + while( i{1} = i{2} + size p{1} - 1 + /\ + (* same as the second loop in LoF.f *) admit. by inline *; auto; call (_: true); auto=> /> p; rewrite !map0P. diff --git a/proof/clean/NewCommon.ec b/proof/clean/NewCommon.ec index 892511d..e2055d1 100644 --- a/proof/clean/NewCommon.ec +++ b/proof/clean/NewCommon.ec @@ -1,5 +1,5 @@ -require import Pred Fun NewLogic NewDistr. -require import Int Real List NewFMap FSet. +require import Core Logic Distr. +require import Int IntExtra Real List NewFMap FSet. require import StdOrder. (*---*) import IntOrder. diff --git a/proof/clean/NewCore.eca b/proof/clean/NewCore.eca index ca801f8..c37730d 100644 --- a/proof/clean/NewCore.eca +++ b/proof/clean/NewCore.eca @@ -1,4 +1,4 @@ -require import Pred Fun Option Pair Int Real List FSet NewFMap NewDistr. +require import Core Int Real List FSet NewFMap Distr. require import StdOrder Ring DProd. (*---*) import IntOrder. @@ -22,8 +22,8 @@ clone include Indifferentiability with rename [module] "GReal" as "RealIndif" [module] "GIdeal" as "IdealIndif". -(** Core Construction **) -module (Core : CONSTRUCTION) (P : DPRIMITIVE): FUNCTIONALITY = { +(** CORE Construction **) +module (CORE : CONSTRUCTION) (P : DPRIMITIVE): FUNCTIONALITY = { proc init () = {} proc f(p : block list): block list = { @@ -40,8 +40,8 @@ module (Core : CONSTRUCTION) (P : DPRIMITIVE): FUNCTIONALITY = { } }. -(** Ideal Core Functionality **) -module ICore : FUNCTIONALITY = { +(** Ideal CORE Functionality **) +module ICORE : FUNCTIONALITY = { var m : (block list,block) fmap proc init() = { @@ -71,7 +71,7 @@ module ICore : FUNCTIONALITY = { } }. -(** Core Simulator **) +(** CORE Simulator **) module (S : SIMULATOR) (F : DFUNCTIONALITY) : PRIMITIVE = { var m, mi : (state,state) fmap var pi : (capacity, block list * block) fmap From 1675799de7ee6bfc4a727ba75baf1f6ea70b5315 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Tue, 2 Jan 2018 16:15:07 +0100 Subject: [PATCH 243/525] a little step for the second admit. --- proof/clean/BlockSponge.eca | 14 +++++++++++++- 1 file changed, 13 insertions(+), 1 deletion(-) diff --git a/proof/clean/BlockSponge.eca b/proof/clean/BlockSponge.eca index 81f2751..58beb10 100644 --- a/proof/clean/BlockSponge.eca +++ b/proof/clean/BlockSponge.eca @@ -281,7 +281,19 @@ section PROOF. auto;smt(parseK min_lel size_nseq take_nseq valid_spec rcons_cat parse_injective getP in_dom oget_some take_size take0 take_cat parse_valid valid_take cat_rcons cats0 size_cat size_ge0). - + admit. + + proc (INV ICORE.m{1} IBlockSponge.m{2})=> //. + proc. + sp;if;1:progress=>/#. + splitwhile{1} 1 : i < size (parse p).`1. + rcondt{1}2;progress. + + while(i <= size (parse p).`1);auto;1:call(:true);auto;progress. + + rewrite/#. + + smt(size_ge0 valid_spec). + cut/#:size (parse x{m0}).`1 <= size x{m0}. + by rewrite-{2}(formatK x{m0}) -H/=/format size_cat size_nseq/#. + inline*;auto. +(* now we should manage the while loops *) + + proc; sp; if=> //=; inline{1} 1; rcondt{1} 4. + by auto=> /> &hr _ ^valid_x+ ^n_gt0 /parseK H - /H {H} ->. sp;wp. From 1e9fa53ce0a8ba8b176ddd74fab1a059252f3f31 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Tue, 2 Jan 2018 16:17:00 +0100 Subject: [PATCH 244/525] clean --- proof/clean/BlockSponge.eca | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/proof/clean/BlockSponge.eca b/proof/clean/BlockSponge.eca index 58beb10..d287e46 100644 --- a/proof/clean/BlockSponge.eca +++ b/proof/clean/BlockSponge.eca @@ -293,6 +293,8 @@ section PROOF. by rewrite-{2}(formatK x{m0}) -H/=/format size_cat size_nseq/#. inline*;auto. (* now we should manage the while loops *) + admit. + + auto. + proc; sp; if=> //=; inline{1} 1; rcondt{1} 4. + by auto=> /> &hr _ ^valid_x+ ^n_gt0 /parseK H - /H {H} ->. @@ -305,9 +307,6 @@ section PROOF. (* This is false : because ICORE.m{1} will be bigger than IBlockSponge.m{2} *) splitwhile{1}1:i<=size p;rcondt{2}1;1:auto=>/#. inline*. - while( i{1} = i{2} + size p{1} - 1 - /\ - (* same as the second loop in LoF.f *) admit. by inline *; auto; call (_: true); auto=> /> p; rewrite !map0P. From 7f40e35886e7affd32cae2d99c1c93c859336618 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Thu, 4 Jan 2018 09:58:42 +0100 Subject: [PATCH 245/525] . --- proof/clean/BlockSponge.eca | 124 +++++++++++++++++------------------- proof/clean/NewCore.eca | 39 +++++++----- 2 files changed, 82 insertions(+), 81 deletions(-) diff --git a/proof/clean/BlockSponge.eca b/proof/clean/BlockSponge.eca index d287e46..8db0169 100644 --- a/proof/clean/BlockSponge.eca +++ b/proof/clean/BlockSponge.eca @@ -24,20 +24,20 @@ lemma parse_injective: injective parse. proof. by move=> bs1 bs2 eq_format; rewrite -formatK eq_format (@formatK bs2). qed. lemma parse_valid p: valid p => parse p = (p,1). -proof. -move=>h;cut{1}->:p=format p 1;2:smt(parseK). +proof. +move=>h;cut{1}->:p=format p 1;2:smt(parseK). by rewrite/format/=nseq0 cats0. qed. (******************* Useful lemmas ******************) lemma take_nseq (b:block) i j : take i (nseq j b) = nseq (min i j) b. -proof. +proof. move:i;elim/natind=>//=. -+ smt(take_le0 nseq0_le). -move=>i hi0 hind. -case(i + 1 <= j)=>hi1j. ++ smt(take_le0 nseq0_le). +move=>i hi0 hind. +case(i + 1 <= j)=>hi1j. + rewrite (take_nth b);1:smt(size_nseq). - rewrite hind nth_nseq 1:/# //=-nseqSr/#. + rewrite hind nth_nseq 1:/# //=-nseqSr/#. rewrite take_oversize;smt(size_nseq). qed. @@ -47,7 +47,7 @@ qed. require (*--*) NewCore. clone import NewCore as Low with - op valid bs <- valid (parse bs).`1 /\ 0 < (parse bs).`2 + op valid bs <- let (b,s) = bs in valid b /\ 0 < s proof * by done. (** High-Level Definitions **) @@ -102,10 +102,15 @@ module IBlockSponge : FUNCTIONALITY = { proc f(x, n) = { var b, bs; - var i <- 1; + var i <- 0; bs <- []; if (valid x /\ 0 < n) { + while (i < size x) { + b <@ fill_in(take i x,1); + i <- i + 1; + } + i <- 1; while (i <= n) { b <@ fill_in(x, i); bs <- rcons bs b; @@ -116,12 +121,11 @@ module IBlockSponge : FUNCTIONALITY = { } }. -(* Parametric Simulator *) +(* Parametric Simulator *) module (HiSim (S : Low.SIMULATOR) : SIMULATOR) (F : DFUNCTIONALITY) = { module LoF = { - proc f(x : block list): block list = { + proc f(p : block list, n : int): block list = { var r <- []; - var (p,n) <- parse x; var b <- []; var i <- 1; @@ -155,8 +159,7 @@ module (LoDist (D : DISTINGUISHER) : Low.DISTINGUISHER) var r <- []; if (valid p /\ 0 < n) { - r <@ F.f(format p n); - r <- drop (size p - b2i (n <> 0)) r; + r <@ F.f(p,n); } return r; } @@ -184,58 +187,22 @@ section PROOF. + byequiv (_: ={glob D, glob P} ==> _ )=> //=; proc. call (_: ={glob P}); first 2 by sim. + proc=> /=; sp; if=>//=; inline{1} 1. - seq 4 0: ( ={glob P, p, n, r, sa, sc, i} - /\ p{1} <> [] - /\ 0 < n{1} - /\ sa{1} = b0 - /\ i{1} = 0 - /\ r{1} = [] - /\ r0{1} = [] - /\ p0{1} = p{1} ++ nseq (n{1} - 1) b0). - + by auto=> /> &2 /valid_spec. - splitwhile{1} 1: (i < size p). - splitwhile{2} 3: (i < n - 1). - rcondt{2} 4. - + auto; while (i < n); 2:by wp; conseq (_: _ ==> true)=> // /#. - by sp; if; 1:call (_: true); auto=> /#. - rcondf{2} 6. - + auto; while (i < n); 2:by wp; conseq (_: _ ==> true)=> // /#. - by sp; if; 1:call (_: true); auto=> /#. - rcondf{2} 6. - + auto; while (i < n); 2:by wp; conseq (_: _ ==> true)=> // /#. - by sp; if; 1:call (_: true); auto=> /#. - wp; while ( ={glob P, p, n, sa, sc} - /\ i{1} = i{2} + size p{2} - /\ drop (size p - 1){1} r0{1} = rcons r{2} sa{2} - /\ 0 <= i{2} - /\ p{1} <> [] - /\ 0 < n{1} - /\ p0{1} = p{1} ++ nseq (n{1} - 1) b0). - + rcondt{2} 3; 1:by auto=> /#. - wp; call (_: true); auto=> /> &1 &2 eq_r i_ge0 p_neq_nil n_ge0 i1_lt_szp0 _ i2_lt_Pn. - rewrite nth_cat -subr_lt0 addzK ltzNge i_ge0 /=. - rewrite nth_nseq // BlockMonoid.AddMonoid.addm0=> /= -[sa sc] /=. - rewrite size_cat size_nseq; split=> [|/#]; split=> [/#|]; split=> [|/#]. - smt (@List). - wp; while ( ={glob P, p, n, sa, sc, i} - /\ i{1} <= size p{1} - /\ size r0{1} = i{1} - /\ last b0 r0{1} = sa{2} - /\ p0{1} = p{1} ++ nseq (n{1} - 1) b0). - + wp; call (_: true); auto=> /> &1 &2. - rewrite size_cat size_nseq=> _ _ szr0_lt_szp. - rewrite nth_cat szr0_lt_szp=> /= -[sa sc] /=. - by rewrite size_rcons last_rcons /= /#. - auto=> /> &2 p_neq_nil n_gt0. - rewrite size_cat size_nseq size_ge0; split=> [/#|r _]. - rewrite ltzNge=> /= szp_le_szr szr_le_szp; split=> [|/#]; split=> [|/#]; split=> [/#|]. - smt (@List). - by inline *; call (_: true). + sp;wp. + rcondt{1}3;progress. + + by wp;while(valid p0 /\ 0 < n0);auto;call(:true);auto. + while( ={sa,sc,glob P} /\ i{1} = i{2} + 1 /\ r0{1} = r{2} + /\ n{2} = n0{1});auto. + + sp;if;1:progress=>/#;1:call(:true);auto=>/#. + by conseq(:_==> ={sa, sc, glob P} /\ r0{1} = r{2} /\ n{2} = n0{1}); + 2:sim;progress=>/#. + + by inline*;auto;call(:true);auto. + byequiv (_: ={glob D, glob S} ==> _)=> //=; proc. - call (_: ={glob S} - /\ INV ICORE.m{1} IBlockSponge.m{2}). - + proc (INV ICORE.m{1} IBlockSponge.m{2})=> //. - proc=> /=; sp; if=> [&1 &2 [#] <*> <-| |] //. + call (_: ={glob S} /\ ={m}(ICORE,IBlockSponge) ). + + proc (ICORE.m{1} = IBlockSponge.m{2})=> //. + proc=> /=; sp;if=> [&1 &2 [#] <*>| |] //. + inline *. conseq (_: ={r, i} /\ r{2} = [] /\ b{2} = [] @@ -291,7 +258,32 @@ section PROOF. + smt(size_ge0 valid_spec). cut/#:size (parse x{m0}).`1 <= size x{m0}. by rewrite-{2}(formatK x{m0}) -H/=/format size_cat size_nseq/#. - inline*;auto. + inline*;auto. + replace{2} { + while { + setup; + if { + (while as loop) + }; + setup_end + }; + after + } by { + while(i < size p) { + setup; + loop; + setup_end; + } + after; + } + (r{2} = [] /\ (p{2}, n{2}) = parse x{2} /\ b{2} = [] /\ + i{2} = 1 /\ r{1} = [] /\ i{1} = 1 /\ p{1} = x{2} /\ + INV ICORE.m{1} IBlockSponge.m{2} /\ valid (parse p{1}).`1 /\ + 0 < (parse p{1}).`2 + ==> r{1} = r{2} ++ bs0{2} /\ INV ICORE.m{1} IBlockSponge.m{2}) + (={i,p,n,x,r,b,IBlockSponge.m, + + (* now we should manage the while loops *) admit. + auto. diff --git a/proof/clean/NewCore.eca b/proof/clean/NewCore.eca index c37730d..27fb1af 100644 --- a/proof/clean/NewCore.eca +++ b/proof/clean/NewCore.eca @@ -8,7 +8,7 @@ require import NewCommon. (*---*) import Block DBlock Capacity DCapacity. (** Validity of Functionality Queries **) -op valid: block list -> bool. +op valid: block list * int -> bool. (*** DEFINITIONS ***) type state = block * capacity. @@ -17,7 +17,7 @@ op dstate = bdistr `*` cdistr. (** Indifferentiability Experiment **) clone include Indifferentiability with type p <- state, - type f_in <- block list, + type f_in <- block list * int, type f_out <- block list rename [module] "GReal" as "RealIndif" [module] "GIdeal" as "IdealIndif". @@ -26,43 +26,52 @@ clone include Indifferentiability with module (CORE : CONSTRUCTION) (P : DPRIMITIVE): FUNCTIONALITY = { proc init () = {} - proc f(p : block list): block list = { + proc f(p : block list, n : int): block list = { var (sa,sc) <- (b0,c0); var r <- []; var i <- 0; while (i < size p) { (sa,sc) <@ P.f((sa +^ nth witness p i,sc)); - r <- rcons r sa; i <- i + 1; } + i <- 1; + if (valid (p,n)) { + while(i <= n) { + r <- rcons r sa; + i <- i + 1; + if (i <= n) { + (sa,sc) <@ P.f(sa,sc); + } + } + } return r; } }. (** Ideal CORE Functionality **) module ICORE : FUNCTIONALITY = { - var m : (block list,block) fmap + var m : (block list * int,block) fmap proc init() = { m = map0; } - proc fill_in(p : block list) = { - if (!mem (dom m) p) { - m.[p] <$ bdistr; + proc fill_in(p : block list, n : int): block = { + if (!mem (dom m) (p,n)) { + m.[(p,n)] <$ bdistr; } - return oget m.[p]; + return oget m.[(p,n)]; } - proc f(p : block list): block list = { + proc f(p : block list, n : int): block list = { var r <- []; var i <- 1; var b; - if (valid p) { - while (i <= size p) { - b <@ fill_in(take i p); + if (valid (p,n)) { + while (i <= n) { + b <@ fill_in(p,i); r <- rcons r b; i <- i + 1; } @@ -71,7 +80,7 @@ module ICORE : FUNCTIONALITY = { } }. -(** CORE Simulator **) +(** CORE Simulator **) module (S : SIMULATOR) (F : DFUNCTIONALITY) : PRIMITIVE = { var m, mi : (state,state) fmap var pi : (capacity, block list * block) fmap @@ -89,7 +98,7 @@ module (S : SIMULATOR) (F : DFUNCTIONALITY) : PRIMITIVE = { if (!mem (dom m) x) { if (mem (dom pi) x.`2) { (p,v) <- oget pi.[x.`2]; - b <- F.f (rcons p (v +^ x.`1)); + b <- F.f (rcons p (v +^ x.`1),1); y1 <- last b0 b; } else { y1 <$ bdistr; From 74c9023e4bed239b1fd578e448d3682be007c867 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Thu, 4 Jan 2018 10:24:41 +0100 Subject: [PATCH 246/525] . --- proof/BlockSponge.ec | 6 ++++-- proof/Common.ec | 18 +++++++++++------- proof/IRO.eca | 2 +- proof/RP.eca | 4 ++-- proof/clean/BlockSponge.eca | 13 ++++++++----- 5 files changed, 26 insertions(+), 17 deletions(-) diff --git a/proof/BlockSponge.ec b/proof/BlockSponge.ec index b6f50ac..5c9956d 100644 --- a/proof/BlockSponge.ec +++ b/proof/BlockSponge.ec @@ -1,6 +1,6 @@ (*-------------------- Padded Block Sponge Construction ----------------*) -require import Option Pair Int Real List. +require import Core Int Real List. require (*--*) IRO Indifferentiability. require import Common. @@ -65,4 +65,6 @@ lemma conclusion : `| Pr[RealIndif(Sponge, Perm, D).main() @ &m : res] - Pr[IdealIndif(IRO, S, D).main() @ &m : res]| < eps. -proof. admit. qed. +proof. +admit. +qed. diff --git a/proof/Common.ec b/proof/Common.ec index 4ebce78..08fbb22 100644 --- a/proof/Common.ec +++ b/proof/Common.ec @@ -8,11 +8,11 @@ prover ["Z3"]. prover ["Alt-Ergo"]. *) -require import Option Fun Pair Int IntExtra IntDiv Real List NewDistr. +require import Core Int IntExtra IntDiv Real List Distr. require import Ring StdRing StdOrder StdBigop BitEncoding DProd. require (*--*) FinType BitWord RP Monoid. (*---*) import IntID IntOrder Bigint Bigint.BIA IntDiv. -require import NewLogic. +(* require import NewLogic. *) pragma +implicits. @@ -40,15 +40,19 @@ clone BitWord as Capacity with "word" as "cap" "zerow" as "c0". +op cdistr = Capacity.DWord.dunifin. + clone export BitWord as Block with type word <- block, op n <- r proof gt0_n by apply/gt0_r - rename "dword" as "bdistr" - "word" as "block" + rename "word" as "block" + "Word" as "Block" "zerow" as "b0". +op bdistr = DBlock.dunifin. + (* ------------------------- Auxiliary Lemmas ------------------------- *) lemma dvdz_close (n : int) : @@ -104,7 +108,7 @@ qed. clone export RP as Perm with type t <- block * capacity, - op dt <- bdistr `*` Capacity.cdistr + op dt <- bdistr `*` cdistr rename [module type] "RP" as "PRIMITIVE" [module] "P" as "Perm". @@ -564,8 +568,8 @@ proof. move=> vb_xs; have bp := valid_blockP xs. rewrite vb_xs /= in bp. move: bp=> [s n] _ b2b_xs_eq. -case: (last b0 xs <> b0)=> [// | last_xs_eq_b0]. -rewrite nnot in last_xs_eq_b0. +case: (last b0 xs <> b0)=> [// | last_xs_eq_b0]. +rewrite negbK in last_xs_eq_b0. have xs_non_nil : xs <> []. case: xs b2b_xs_eq last_xs_eq_b0 vb_xs=> // contrad. rewrite blocks2bits_nil in contrad. diff --git a/proof/IRO.eca b/proof/IRO.eca index cff25e3..05d512d 100644 --- a/proof/IRO.eca +++ b/proof/IRO.eca @@ -3,7 +3,7 @@ independently. We obviously make it lazy. Inputs not satisfying a validity predicate are mapped to the empty list *) -require import Option Int Bool List FSet NewFMap. +require import Core Int Bool List FSet NewFMap. type to, from. diff --git a/proof/RP.eca b/proof/RP.eca index a943a7e..6c54150 100644 --- a/proof/RP.eca +++ b/proof/RP.eca @@ -1,6 +1,6 @@ (*************************- Random Permutation -*************************) -require import Option Real FSet NewFMap Distr. +require import Core Real FSet NewFMap Distr. require import Dexcepted StdOrder. import RealOrder. require import Ring StdRing. import RField. require Monoid. import AddMonoid. @@ -54,7 +54,7 @@ proof. by proc; auto. qed. (* maybe a useful standard lemma? *) lemma mu_except ['a] (d : 'a distr, y : 'a, P : 'a -> bool) : - in_supp y d => ! P y => mu d P < mu d predT. + y \in d => ! P y => mu d P < mu d predT. proof. move=> in_supp_yd notP_y. have -> : mu d P = mu d predT - mu d (predC P) diff --git a/proof/clean/BlockSponge.eca b/proof/clean/BlockSponge.eca index 8db0169..ade0646 100644 --- a/proof/clean/BlockSponge.eca +++ b/proof/clean/BlockSponge.eca @@ -72,11 +72,11 @@ module (BlockSponge : CONSTRUCTION) (P : DPRIMITIVE) : FUNCTIONALITY = { (sa,sc) <@ P.f((sa +^ nth witness p i,sc)); i <- i + 1; } - i <- 0; - while (i < n) { + i <- 1; + while (i <= n) { r <- rcons r sa; - i <- i + 1; - if (i < n) { + i <- i + 1; + if (i <= n) { (sa,sc) <@ P.f(sa,sc); } } @@ -112,10 +112,13 @@ module IBlockSponge : FUNCTIONALITY = { } i <- 1; while (i <= n) { - b <@ fill_in(x, i); bs <- rcons bs b; i <- i + 1; + if (i <= n) { + b <@ fill_in(x, i); + } } + bs <- rcons bs b; } return bs; } From 8477ef0d0ad2161b2ac1b68e4dceb347df87d005 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Thu, 4 Jan 2018 11:07:14 +0100 Subject: [PATCH 247/525] . --- proof/clean/BlockSponge.eca | 268 +++++++++++++++++++----------------- proof/clean/NewCore.eca | 17 ++- 2 files changed, 151 insertions(+), 134 deletions(-) diff --git a/proof/clean/BlockSponge.eca b/proof/clean/BlockSponge.eca index ade0646..98a309d 100644 --- a/proof/clean/BlockSponge.eca +++ b/proof/clean/BlockSponge.eca @@ -73,12 +73,11 @@ module (BlockSponge : CONSTRUCTION) (P : DPRIMITIVE) : FUNCTIONALITY = { i <- i + 1; } i <- 1; - while (i <= n) { + r <- rcons r sa; + while (i < n) { + (sa,sc) <@ P.f(sa,sc); r <- rcons r sa; i <- i + 1; - if (i <= n) { - (sa,sc) <@ P.f(sa,sc); - } } } return r; @@ -102,28 +101,28 @@ module IBlockSponge : FUNCTIONALITY = { proc f(x, n) = { var b, bs; - var i <- 0; + var i <- 1; bs <- []; if (valid x /\ 0 < n) { - while (i < size x) { - b <@ fill_in(take i x,1); + (* while (i < size x) { *) + (* b <@ fill_in(take i x,1); *) + (* i <- i + 1; *) + (* } *) + (* i <- 1; *) + b <@ fill_in(x, 1); + bs <- rcons bs b; + while (i < n) { i <- i + 1; - } - i <- 1; - while (i <= n) { + b <@ fill_in(x, i); bs <- rcons bs b; - i <- i + 1; - if (i <= n) { - b <@ fill_in(x, i); - } } - bs <- rcons bs b; } return bs; } }. + (* Parametric Simulator *) module (HiSim (S : Low.SIMULATOR) : SIMULATOR) (F : DFUNCTIONALITY) = { module LoF = { @@ -134,11 +133,11 @@ module (HiSim (S : Low.SIMULATOR) : SIMULATOR) (F : DFUNCTIONALITY) = { if (valid p /\ 0 < n) { - while (i < size p) { - b <@ F.f(take i p,1); - r <- r ++ b; - i <- i + 1; - } + (* while (i < size p) { *) + (* b <@ F.f(take i p,1); *) + (* r <- r ++ b; *) + (* i <- i + 1; *) + (* } *) b <@ F.f(p,n); r <- r ++ b; } @@ -191,11 +190,8 @@ section PROOF. call (_: ={glob P}); first 2 by sim. + proc=> /=; sp; if=>//=; inline{1} 1. sp;wp. - rcondt{1}3;progress. - + by wp;while(valid p0 /\ 0 < n0);auto;call(:true);auto. - while( ={sa,sc,glob P} /\ i{1} = i{2} + 1 /\ r0{1} = r{2} - /\ n{2} = n0{1});auto. - + sp;if;1:progress=>/#;1:call(:true);auto=>/#. + rcondt{1}1;progress. + while( ={sa,sc,glob P,i} /\ r0{1} = r{2} /\ n{2} = n0{1});auto;1:call(:true);auto. by conseq(:_==> ={sa, sc, glob P} /\ r0{1} = r{2} /\ n{2} = n0{1}); 2:sim;progress=>/#. @@ -205,105 +201,127 @@ section PROOF. call (_: ={glob S} /\ ={m}(ICORE,IBlockSponge) ). + proc (ICORE.m{1} = IBlockSponge.m{2})=> //. proc=> /=; sp;if=> [&1 &2 [#] <*>| |] //. - inline *. - conseq (_: ={r, i} - /\ r{2} = [] - /\ b{2} = [] - /\ i{2} = 1 - /\ parse p{1} = (p{2},n{2}) - /\ valid p{2} - /\ 0 < n{2} - /\ INV ICORE.m{1} IBlockSponge.m{2} - ==> _)=> />. - + by move=> &1 &2=> <-. - splitwhile{1} 1: (i < size (parse p).`1); inline{2} 2. - rcondt{2} 6; first by auto; while (true)=> //; auto=> /> &hr <- //. - wp. while ( i{1} = i0{2} + size x0{2} - 1 - /\ p{1} = x0{2} ++ nseq (n0 - 1){2} b0 - /\ r{1} = r{2} ++ bs{2} - /\ 0 < i0{2} - /\ valid x0{2} - /\ n{2} = n0{2} - /\ INV ICORE.m{1} IBlockSponge.m{2} - /\ parse p{1} = (p{2}, n{2})). - + wp;inline*;sp;wp;if;auto;smt(parseK min_lel size_nseq take_nseq - rcons_cat parse_injective getP in_dom oget_some take_size take0 - take_cat parse_valid valid_take cat_rcons cats0 size_cat size_ge0). - wp=>/=. - conseq(:_==> ={r, i} - /\ valid p{2} - /\ 0 < n{2} - /\ p{1} = p{2} ++ nseq (n{2} - 1) Block.b0 - /\ i{1} = size p{2} - /\ parse p{1} = (p{2}, n{2}) - /\ INV ICORE.m{1} IBlockSponge.m{2});progress;..-2:smt(cats0 size_cat size_ge0). - while( ={r,i} - /\ valid p{2} - /\ 0 < n{2} - /\ p{1} = p{2} ++ nseq (n{2} - 1) Block.b0 - /\ 0 < i{1} <= size p{2} - /\ parse p{1} = (p{2}, n{2}) - /\ INV ICORE.m{1} IBlockSponge.m{2}). - + inline*;auto;sp;rcondt{2}1;1:(auto;smt(valid_take)). - rcondt{2}1;1:auto;sp;rcondf{2}5;1:auto;if;auto; - smt(parse_injective getP oget_some in_dom take_size take0 take_cat - parse_valid valid_take cat_rcons cats0 size_cat size_ge0). - auto;smt(parseK min_lel size_nseq take_nseq valid_spec - rcons_cat parse_injective getP in_dom oget_some take_size take0 - take_cat parse_valid valid_take cat_rcons cats0 size_cat size_ge0). - + proc (INV ICORE.m{1} IBlockSponge.m{2})=> //. - proc. - sp;if;1:progress=>/#. - splitwhile{1} 1 : i < size (parse p).`1. - rcondt{1}2;progress. - + while(i <= size (parse p).`1);auto;1:call(:true);auto;progress. - + rewrite/#. - + smt(size_ge0 valid_spec). - cut/#:size (parse x{m0}).`1 <= size x{m0}. - by rewrite-{2}(formatK x{m0}) -H/=/format size_cat size_nseq/#. - inline*;auto. - replace{2} { - while { - setup; - if { - (while as loop) - }; - setup_end - }; - after - } by { - while(i < size p) { - setup; - loop; - setup_end; - } - after; - } - (r{2} = [] /\ (p{2}, n{2}) = parse x{2} /\ b{2} = [] /\ - i{2} = 1 /\ r{1} = [] /\ i{1} = 1 /\ p{1} = x{2} /\ - INV ICORE.m{1} IBlockSponge.m{2} /\ valid (parse p{1}).`1 /\ - 0 < (parse p{1}).`2 - ==> r{1} = r{2} ++ bs0{2} /\ INV ICORE.m{1} IBlockSponge.m{2}) - (={i,p,n,x,r,b,IBlockSponge.m, - - -(* now we should manage the while loops *) - admit. - + auto. - - + proc; sp; if=> //=; inline{1} 1; rcondt{1} 4. - + by auto=> /> &hr _ ^valid_x+ ^n_gt0 /parseK H - /H {H} ->. - sp;wp. - conseq(:_==> drop (size p{1} - 1) r0{1} = bs{2} - /\ ={glob S} - /\ INV ICORE.m{1} IBlockSponge.m{2});progress. - by do !congr;rewrite b2i_eq1/#. - inline*;rewrite/INV. -(* This is false : because ICORE.m{1} will be bigger than IBlockSponge.m{2} *) - splitwhile{1}1:i<=size p;rcondt{2}1;1:auto=>/#. inline*. - (* same as the second loop in LoF.f *) - admit. - by inline *; auto; call (_: true); auto=> /> p; rewrite !map0P. - qed. + sp;rcondt{2}1;auto. + rcondt{1}1;1:auto=>/#. + conseq(:_ ==> r{1} = bs{2} /\ ICORE.m{1} = IBlockSponge.m{2});progress. + by while( i{1} = i0{2} + 1 /\ n{1} = n0{2} /\ x{2} = p{1} + /\ ICORE.m{1} = IBlockSponge.m{2} /\ r{1} = bs{2});sp;if;auto=>/#. + + + proc(={m}(ICORE,IBlockSponge))=>//=. + proc;inline*;sp;if;auto;sp;rcondt{2}1;auto;sp. + rcondt{1}1;1:auto=>/#;sp. + conseq(:_ ==> r{1} = bs{2} /\ ICORE.m{1} = IBlockSponge.m{2});progress. + by while( i{1} = i0{2} + 1 /\ n{1} = n0{2} /\ x{2} = p{1} + /\ ICORE.m{1} = IBlockSponge.m{2} /\ r{1} = bs{2});sp;if;auto=>/#. + + + proc;inline*;sp;if;auto;sp;rcondt{1}1;auto;progress. + rcondt{1}1;1:auto=>/#;sp. + conseq(:_ ==> r0{1} = bs{2} /\ ICORE.m{1} = IBlockSponge.m{2});progress. + by while( i{1} = i{2} + 1 /\ n0{1} = n{2} /\ x{2} = p0{1} + /\ ICORE.m{1} = IBlockSponge.m{2} /\ r0{1} = bs{2});sp;if;auto=>/#. + + by inline*;auto;call(:true);auto. +qed. + +(* conseq (_: ={r, i} *) +(* /\ r{2} = [] *) +(* /\ b{2} = [] *) +(* /\ i{2} = 1 *) +(* /\ parse p{1} = (p{2},n{2}) *) +(* /\ valid p{2} *) +(* /\ 0 < n{2} *) +(* /\ INV ICORE.m{1} IBlockSponge.m{2} *) +(* ==> _)=> />. *) +(* + by move=> &1 &2=> <-. *) +(* splitwhile{1} 1: (i < size (parse p).`1); inline{2} 2. *) +(* rcondt{2} 6; first by auto; while (true)=> //; auto=> /> &hr <- //. *) +(* wp. while ( i{1} = i0{2} + size x0{2} - 1 *) +(* /\ p{1} = x0{2} ++ nseq (n0 - 1){2} b0 *) +(* /\ r{1} = r{2} ++ bs{2} *) +(* /\ 0 < i0{2} *) +(* /\ valid x0{2} *) +(* /\ n{2} = n0{2} *) +(* /\ INV ICORE.m{1} IBlockSponge.m{2} *) +(* /\ parse p{1} = (p{2}, n{2})). *) +(* + wp;inline*;sp;wp;if;auto;smt(parseK min_lel size_nseq take_nseq *) +(* rcons_cat parse_injective getP in_dom oget_some take_size take0 *) +(* take_cat parse_valid valid_take cat_rcons cats0 size_cat size_ge0). *) +(* wp=>/=. *) +(* conseq(:_==> ={r, i} *) +(* /\ valid p{2} *) +(* /\ 0 < n{2} *) +(* /\ p{1} = p{2} ++ nseq (n{2} - 1) Block.b0 *) +(* /\ i{1} = size p{2} *) +(* /\ parse p{1} = (p{2}, n{2}) *) +(* /\ INV ICORE.m{1} IBlockSponge.m{2});progress;..-2:smt(cats0 size_cat size_ge0). *) +(* while( ={r,i} *) +(* /\ valid p{2} *) +(* /\ 0 < n{2} *) +(* /\ p{1} = p{2} ++ nseq (n{2} - 1) Block.b0 *) +(* /\ 0 < i{1} <= size p{2} *) +(* /\ parse p{1} = (p{2}, n{2}) *) +(* /\ INV ICORE.m{1} IBlockSponge.m{2}). *) +(* + inline*;auto;sp;rcondt{2}1;1:(auto;smt(valid_take)). *) +(* rcondt{2}1;1:auto;sp;rcondf{2}5;1:auto;if;auto; *) +(* smt(parse_injective getP oget_some in_dom take_size take0 take_cat *) +(* parse_valid valid_take cat_rcons cats0 size_cat size_ge0). *) +(* auto;smt(parseK min_lel size_nseq take_nseq valid_spec *) +(* rcons_cat parse_injective getP in_dom oget_some take_size take0 *) +(* take_cat parse_valid valid_take cat_rcons cats0 size_cat size_ge0). *) +(* + proc (INV ICORE.m{1} IBlockSponge.m{2})=> //. *) +(* proc. *) +(* sp;if;1:progress=>/#. *) +(* splitwhile{1} 1 : i < size (parse p).`1. *) +(* rcondt{1}2;progress. *) +(* + while(i <= size (parse p).`1);auto;1:call(:true);auto;progress. *) +(* + rewrite/#. *) +(* + smt(size_ge0 valid_spec). *) +(* cut/#:size (parse x{m0}).`1 <= size x{m0}. *) +(* by rewrite-{2}(formatK x{m0}) -H/=/format size_cat size_nseq/#. *) +(* inline*;auto. *) +(* replace{2} { *) +(* while { *) +(* setup; *) +(* if { *) +(* (while as loop) *) +(* }; *) +(* setup_end *) +(* }; *) +(* after *) +(* } by { *) +(* while(i < size p) { *) +(* setup; *) +(* loop; *) +(* setup_end; *) +(* } *) +(* after; *) +(* } *) +(* (r{2} = [] /\ (p{2}, n{2}) = parse x{2} /\ b{2} = [] /\ *) +(* i{2} = 1 /\ r{1} = [] /\ i{1} = 1 /\ p{1} = x{2} /\ *) +(* INV ICORE.m{1} IBlockSponge.m{2} /\ valid (parse p{1}).`1 /\ *) +(* 0 < (parse p{1}).`2 *) +(* ==> r{1} = r{2} ++ bs0{2} /\ INV ICORE.m{1} IBlockSponge.m{2}) *) +(* (={i,p,n,x,r,b,IBlockSponge.m, *) + + +(* (* now we should manage the while loops *) *) +(* admit. *) +(* + auto. *) + +(* + proc; sp; if=> //=; inline{1} 1; rcondt{1} 4. *) +(* + by auto=> /> &hr _ ^valid_x+ ^n_gt0 /parseK H - /H {H} ->. *) +(* sp;wp. *) +(* conseq(:_==> drop (size p{1} - 1) r0{1} = bs{2} *) +(* /\ ={glob S} *) +(* /\ INV ICORE.m{1} IBlockSponge.m{2});progress. *) +(* by do !congr;rewrite b2i_eq1/#. *) +(* inline*;rewrite/INV. *) +(* (* This is false : because ICORE.m{1} will be bigger than IBlockSponge.m{2} *) *) +(* splitwhile{1}1:i<=size p;rcondt{2}1;1:auto=>/#. *) +(* inline*. *) +(* (* same as the second loop in LoF.f *) *) +(* admit. *) +(* by inline *; auto; call (_: true); auto=> /> p; rewrite !map0P. *) +(* qed. *) end section PROOF. diff --git a/proof/clean/NewCore.eca b/proof/clean/NewCore.eca index 27fb1af..89d5c13 100644 --- a/proof/clean/NewCore.eca +++ b/proof/clean/NewCore.eca @@ -31,18 +31,17 @@ module (CORE : CONSTRUCTION) (P : DPRIMITIVE): FUNCTIONALITY = { var r <- []; var i <- 0; - while (i < size p) { - (sa,sc) <@ P.f((sa +^ nth witness p i,sc)); - i <- i + 1; - } - i <- 1; if (valid (p,n)) { - while(i <= n) { + while (i < size p) { + (sa,sc) <@ P.f((sa +^ nth witness p i,sc)); + i <- i + 1; + } + i <- 1; + r <- rcons r sa; + while(i < n) { + (sa,sc) <@ P.f(sa,sc); r <- rcons r sa; i <- i + 1; - if (i <= n) { - (sa,sc) <@ P.f(sa,sc); - } } } return r; From 9a631702ab5791c06024d9ab19b96183bacc7d60 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Thu, 4 Jan 2018 17:51:59 +0100 Subject: [PATCH 248/525] clean/BlockSponge.eca : - Low : BlockSponge(P).f(p,n) outputs a n-length list - Hi : BlockSponge(P).f(x) outputs only the last block We want to prove that distinguishing in the Low environnement is equivalent to distinguish in the Hi environnement. --- proof/clean/BlockSponge.eca | 814 +++++++++++++++++++++++++++++++++--- proof/clean/NewCore.eca | 6 + 2 files changed, 765 insertions(+), 55 deletions(-) diff --git a/proof/clean/BlockSponge.eca b/proof/clean/BlockSponge.eca index 98a309d..822ef5a 100644 --- a/proof/clean/BlockSponge.eca +++ b/proof/clean/BlockSponge.eca @@ -54,70 +54,73 @@ proof * by done. (* Indifferentiability *) clone import Indifferentiability as BS_Ind with type p <- block * capacity, - type f_in <- block list * int, - type f_out <- block list + type f_in <- block list, + type f_out <- block proof * by done. (* BlockSponge Construction *) module (BlockSponge : CONSTRUCTION) (P : DPRIMITIVE) : FUNCTIONALITY = { proc init() = {} - proc f(p : block list, n : int) : block list = { - var r <- []; + proc f(p : block list) : block = { var (sa,sc) <- (b0,c0); var i <- 0; + var (x,n) <- parse p; - if (valid p /\ 0 < n) { + if (valid x /\ 0 < n) { while (i < size p) { (sa,sc) <@ P.f((sa +^ nth witness p i,sc)); i <- i + 1; } - i <- 1; - r <- rcons r sa; - while (i < n) { - (sa,sc) <@ P.f(sa,sc); - r <- rcons r sa; - i <- i + 1; - } } - return r; + return sa; } }. (* Ideal Block Sponge Functionality *) module IBlockSponge : FUNCTIONALITY = { - var m : (block list * int,block) fmap + var m : (block list,block) fmap proc init() = { m <- map0; } - proc fill_in(x, n) = { - if (!mem (dom m) (x, n)) { - m.[(x,n)] <$ bdistr; + proc fill_in(x) = { + if (!mem (dom m) x) { + m.[x] <$ bdistr; } - return oget m.[(x,n)]; + return oget m.[x]; } - proc f(x, n) = { - var b, bs; + proc f(x : block list) = { + var b,bs <- b0; var i <- 1; - bs <- []; - if (valid x /\ 0 < n) { - (* while (i < size x) { *) - (* b <@ fill_in(take i x,1); *) - (* i <- i + 1; *) - (* } *) - (* i <- 1; *) - b <@ fill_in(x, 1); - bs <- rcons bs b; - while (i < n) { + var (p,n) <- parse x; + + if (valid p /\ 0 < n) { + while (i < size x) { + b <@ fill_in(take i x); i <- i + 1; - b <@ fill_in(x, i); - bs <- rcons bs b; } + bs <@ fill_in(x); } + + (* bs <- []; *) + (* if (valid x /\ 0 < n) { *) + (* (* while (i < size x) { *) *) + (* (* b <@ fill_in(take i x,1); *) *) + (* (* i <- i + 1; *) *) + (* (* } *) *) + (* (* i <- 1; *) *) + (* b <@ fill_in(x, 1); *) + (* bs <- rcons bs b; *) + (* while (i < n) { *) + (* i <- i + 1; *) + (* b <@ fill_in(x, i); *) + (* bs <- rcons bs b; *) + (* } *) + (* } *) return bs; } }. @@ -128,18 +131,17 @@ module (HiSim (S : Low.SIMULATOR) : SIMULATOR) (F : DFUNCTIONALITY) = { module LoF = { proc f(p : block list, n : int): block list = { var r <- []; - var b <- []; - var i <- 1; + var b; + var i <- 0; if (valid p /\ 0 < n) { - (* while (i < size p) { *) - (* b <@ F.f(take i p,1); *) - (* r <- r ++ b; *) - (* i <- i + 1; *) - (* } *) - b <@ F.f(p,n); - r <- r ++ b; + while (i < n) { + b <@ F.f(p ++ nseq i b0); + r <- rcons r b; + i <- i + 1; + } + } return r; } @@ -157,19 +159,26 @@ pred INV (mc : (block list,block) fmap) (mb : (block list * int,block) fmap) = module (LoDist (D : DISTINGUISHER) : Low.DISTINGUISHER) (F : Low.DFUNCTIONALITY) (P : Low.DPRIMITIVE) = { module HiF = { - proc f(p : block list, n : int) = { + proc f(p : block list) = { var r <- []; + var b <- b0; + var x,n; + - if (valid p /\ 0 < n) { - r <@ F.f(p,n); + (x,n) <- parse p; + + if (valid x /\ 0 < n) { + r <@ F.f(x,n); + b <- last b0 r; } - return r; + return b; } } proc distinguish = D(HiF,P).distinguish }. + (*** PROOF forall P D S, LoDist(D)^{Core(P),P} ~ LoDist(D)^{ICore,S(ICore)} @@ -178,6 +187,636 @@ section PROOF. declare module P : PRIMITIVE { Low.ICORE, IBlockSponge, HiSim }. declare module S : Low.SIMULATOR { Low.ICORE, IBlockSponge, HiSim, P }. declare module D : DISTINGUISHER { Low.ICORE, IBlockSponge, HiSim, P, S }. +print ICORE. + +local module ICORE_eager : Low.FUNCTIONALITY = { + var order : block list list + var dist_res : bool + + proc init() : unit = { + order <- []; + dist_res <- false; + ICORE.init(); + } + + proc fill_in (x : block list) = { + var i <- 1; + var c; + var (p,n) <- parse x; + + while (i < size p) { + ICORE.fill_in(take i p, 1); + order <- rcons order (take i p); + i <- i + 1; + } + i <- 1; + while (i <= n) { + ICORE.fill_in(p, i); + order <- rcons order (format p i); + i <- i + 1; + } + c <@ ICORE.fill_in(p,n); + return c; + } + + proc f(p : block list, n : int) : block list = { + var r : block list; + var i : int <- 1; + var b : block; + + r <- []; + if (valid p /\ 0 < n) { + while (i <= n) { + b <@ fill_in(format p i); + r <- rcons r b; + i <- i + 1; + } + } + return r; + } + proc ewhile() : unit = { + var world <- order; + + var y <- []; + while(world <> []) { + y <- head ([]) world; + fill_in(y); + world <- behead world; + } + } + }. + + local module ICORE_e = { + proc init = ICORE_eager.init + + + proc fill_in (x : block list) = { + var i <- 1; + var c; + var (p,n) <- parse x; + + while (i < size p) { + ICORE_eager.order <- rcons ICORE_eager.order (take i p); + i <- i + 1; + } + i <- 1; + while (i <= n) { + ICORE_eager.order <- rcons ICORE_eager.order (format p i); + i <- i + 1; + } + c <@ ICORE.fill_in(p,n); + return c; + } + + + proc f(p : block list, n : int) : block list = { + var r : block list; + var i : int <- 1; + var b : block; + + r <- []; + if (valid p /\ 0 < n) { + while (i <= n) { + b <@ fill_in(format p i); + r <- rcons r b; + i <- i + 1; + } + } + return r; + } + }. + + local lemma eager_ICORE_e_f : + eager[ ICORE_eager.ewhile();, ICORE_eager.f + ~ ICORE_e.f, ICORE_eager.ewhile(); : + ={p, n} /\ ={ICORE_eager.dist_res, ICORE_eager.order, ICORE.m} + ==> + ={res, ICORE_eager.dist_res, ICORE_eager.order, ICORE.m}]. + proof. + eager proc. + swap{1}2;swap{2}-1;sp;wp. + if{2};1:rcondt{1}2;last first;1:rcondf{1}2;progress;2:sim. + + inline*;sp;while(! (valid p /\ 0 < n));auto. + sp;seq 1 : (! (valid p /\ 0 < n));1:by while(! (valid p /\ 0 < n));auto;sp;if;auto. + by sp;seq 1 : (! (valid p /\ 0 < n));1:while(! (valid p /\ 0 < n));auto;sp;if;auto. + + inline*;sp;while( (valid p /\ 0 < n));auto. + sp;seq 1 : ( (valid p /\ 0 < n));1:by while( (valid p /\ 0 < n));auto;sp;if;auto. + by sp;seq 1 : ( (valid p /\ 0 < n));1:while( (valid p /\ 0 < n));auto;sp;if;auto. + conseq(: ={p, n, glob ICORE_eager, i, r} ==> + ={p, n, glob ICORE_eager, i, r});progress. + eager while(J : ICORE_eager.ewhile(); ~ ICORE_eager.ewhile(); : + ={p, n, glob ICORE_eager, i, r} ==> ={p, n, glob ICORE_eager, i, r});progress;1,3:sim. + swap{2}-1;wp 3 3. + swap{2}-1;sim. + conseq(:_==> ={p, n, b, glob ICORE_eager});progress. + inline{1}2;inline{2}1. + (* TODO : a lot of eager while to prepare. *) + + replace{2} { while;_ as loop1; (while;_ as loop2); eage } by { + loop1; + eage; + loop2; + } + (={i,r,p,n,glob ICORE_eager} /\ i{2} = 1 /\ r{2} = [] /\ valid p{2} + /\ 0 < n{2} ==> ={r, ICORE_eager.dist_res, ICORE_eager.order, ICORE.m}) + (={i,r,p,n,glob ICORE_eager} /\ i{2} = 1 /\ r{2} = [] /\ valid p{2} + /\ 0 < n{2} ==> ={r, ICORE_eager.dist_res, ICORE_eager.order, ICORE.m}); + progress;1:rewrite/#. + + sim. + conseq(: ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i} + ==> ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i}); + progress. + eager while(J: ICORE_eager.ewhile(); ~ ICORE_eager.ewhile(); : + ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i} ==> + ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i}); + progress;1,3:sim. + swap{2}-1;sim. + inline*. + splitwhile{2}4:world <> [(take i p)]. + sp. swap{1}-4;sp. + seq 1 1: ( ={glob ICORE_eager,n,p,r,i} /\ i{1} < size p{1} + /\ world{2} = [(take i{2} p{2})] + /\ world{1} = [] + /\ world{2} = rcons world{1} (take i{2} p{2}));last first. + + rcondt{2}1;1:auto=>/#. + by rcondf{2}6;auto;sp;if;auto. + while(={glob ICORE_eager,n,p,r,i} /\ i{1} < size p{1} + /\ world{2} = rcons world{1} (take i{2} p{2}));last auto=>/#. + by sp;if;auto;smt(head_behead). + swap{1}3 -1;seq 2 2 :(={glob ICORE_eager,n,p,r,i});1:sim. + eager while(J: ICORE_eager.ewhile(); ~ ICORE_eager.ewhile(); : + ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i} ==> + ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i}); + progress;1,3:sim. + inline ICORE_eager.ewhile. + swap{2}[4..6]-2;sim;swap{2}2;sp. + symmetry;conseq(: ={world,ICORE.m,p,i} ==> ={world,ICORE.m,p,i,b});progress. + replace{1} { all } by { b <- b0; all; } + (={world,ICORE.m,p,i} ==> ={world,ICORE.m,p,i,b}) + (={world,ICORE.m,p,i} ==> ={world,ICORE.m,p,i,b});progress;1:rewrite/#;1:sim. + replace{2} { all } by { b <- b0; all; } + (={world,ICORE.m,p,i} ==> ={world,ICORE.m,p,i,b}) + (={world,ICORE.m,p,i} ==> ={world,ICORE.m,p,i,b});progress;1:rewrite/#;2:sim. + sp;conseq(: ={world,ICORE.m,p,i,b} ==> ={world,ICORE.m,p,i,b});progress. + eager while(J: b <@ ICORE.fill_in(p,i); ~ b <@ ICORE.fill_in(p,i); : + ={world, p, ICORE.m, i, b} ==> ={world, p, ICORE.m, i, b}); + progress;1,3:sim. + inline*;sp;wp. + swap{1}[3..5]-2;swap{2}[3..4]-2;sp. + case(((p0,n0)=(p1,n1)){1})=>//=. + - if;auto;1:rcondf{1}3;1:auto;1:smt(dom_set in_fsetU1). + + by rcondf{2}3;auto;smt(dom_set in_fsetU1). + by sp;if;auto. + if{2};last first;2:rcondt{1}3;1:rcondf{1}3;progress. + + if;auto;smt(dom_set in_fsetU1). + + sp;if;auto;smt(dom_set in_fsetU1). + + sp;if;auto;smt(dom_set in_fsetU1). + if{1};last first;2:rcondt{2}3;1:rcondf{2}3;progress. + + auto;smt(dom_set in_fsetU1). + + auto;smt(dom_set getP in_fsetU1). + + auto;smt(dom_set in_fsetU1). + swap{2}-1;wp;conseq(:_==> ={ICORE.m} /\ b{1} = oget ICORE.m{2}.[(p1{2}, n1{2})]);progress. + alias{1} 1 c = b0. + transitivity{1} { + b <$ bdistr; + c <$ bdistr; + ICORE.m.[(p0, n0)] <- b; + ICORE.m.[(p1, n1)] <- c; + } + (={ICORE.m,p0,n0,p1,n1} /\ ! (p0{1} = p1{1} && n0{1} = n1{1}) ==> + ={ICORE.m} /\ b{1} = oget ICORE.m{2}.[(p0{2}, n0{2})]) + (={ICORE.m} /\ (p0,n0,p1,n1){1} = (p1,n1,p0,n0){2} + /\ ! (p0{1} = p1{1} && n0{1} = n1{1}) ==> + ={ICORE.m} /\ (p0,n0,p1,n1){1} = (p1,n1,p0,n0){2}); + progress;1:rewrite/#. + + swap{2}3-1;wp;rnd=>/=. + wp 2 2;conseq(:_==> ={ICORE.m});1:smt(getP). + by wp;rnd;auto. + transitivity{1} { + b <$ bdistr; + c <$ bdistr; + ICORE.m.[(p1, n1)] <- b; + ICORE.m.[(p0, n0)] <- c; + } + (={ICORE.m,p0,n0,p1,n1} /\ ! (p0{1} = p1{1} && n0{1} = n1{1}) ==> + ={ICORE.m,p0,p1,n0,n1}) + (={ICORE.m} /\ (p0,n0,p1,n1){1} = (p1,n1,p0,n0){2} + /\ ! (p0{1} = p1{1} && n0{1} = n1{1}) ==> + ={ICORE.m} /\ (p0,n0,p1,n1){1} = (p1,n1,p0,n0){2}); + progress;1:rewrite/#. + + swap{1}1;wp;conseq(:_==> (b,c){1} = (c,b){2});progress;2:(rnd;rnd;auto). + by rewrite set_set H0. + by swap{1}3-1;wp;rnd;wp;rnd;auto. + qed. + eager proc. + + local lemma eager_ICORE &m : + Pr[Low.Indif(ICORE, S(ICORE), LoDist(D)).main() @ &m : res] = + Pr[Low.Indif(ICORE_eager, S(ICORE_eager), LoDist(D)).main() @ &m : res]. + + proof. + cut->:Pr[Low.Indif(ICORE, S(ICORE), LoDist(D)).main() @ &m : res] = + Pr[Low.Indif(ICORE_e, S(ICORE_e), LoDist(D)).main() @ &m : res]. + + byequiv (_: ={glob D, glob S} ==> _ )=> //=; proc. + call(: ={glob S,glob ICORE})=>//=;auto. + + proc(={glob ICORE});auto;proc. + sp;if;auto;sp;inline*. + while(={ICORE.m,r,i,p,n} /\ valid p{1} /\ 0 < n{1} /\ 0 < i{1})=>//=;1:auto. + swap{2}[7..8]-3;sp. + conseq(:_==> ={ICORE.m,r,p,n});1:smt(parseK). + sim. + conseq(:_==> ={ICORE.m,r,p,n});1:smt(parseK). + while{2}(={n, p, r, ICORE.m})(n0{2} - i0{2} + 1);1:auto;1:progress=>/#. + conseq(:_==> ={n, p, r, ICORE.m});1:progress=>/#. + wp;while{2}(={n, p, r, ICORE.m})(size p0{2} - i0{2});auto=>/#. + + proc(={glob ICORE});auto;proc. + sp;if;auto;sp;inline*. + while(={ICORE.m,r,i,p,n} /\ valid p{1} /\ 0 < n{1} /\ 0 < i{1})=>//=;1:auto. + swap{2}[7..8]-3;sp. + conseq(:_==> ={ICORE.m,r,p,n});1:smt(parseK). + sim. + conseq(:_==> ={ICORE.m,r,p,n});1:smt(parseK). + while{2}(={n, p, r, ICORE.m})(n0{2} - i0{2} + 1);1:auto;1:progress=>/#. + conseq(:_==> ={n, p, r, ICORE.m});1:progress=>/#. + wp;while{2}(={n, p, r, ICORE.m})(size p0{2} - i0{2});auto=>/#. + + proc;inline*;sp;if;auto;1:progress=>/#;sp. + sp;if;1:auto=>/#;sp;inline*. + while(={ICORE.m,r0,i,p0,n0} /\ valid p0{1} /\ 0 < n0{1} /\ 0 < i{1})=>//=;1:auto. + swap{2}[7..8]-3;sp. + conseq(:_==> ={ICORE.m,r0,p0,n0});1:smt(parseK). + sim. + conseq(:_==> ={ICORE.m,r0,p0,n0});1:smt(parseK). + while{2}(={n0, p0, r0, ICORE.m})(n1{2} - i0{2} + 1);1:auto;1:progress=>/#. + conseq(:_==> ={n0, p0, r0, ICORE.m});1:progress=>/#. + by wp;while{2}(={n0, p0, r0, ICORE.m})(size p1{2} - i0{2});auto=>/#. + + by auto=>/#. + + by auto=>/#. + by inline*;auto;call(:true);auto. + + byequiv (_: ={glob D, glob S} ==> _ )=> //=; proc. + replace{1} { all; <@ } by { + all; + ICORE_eager.dist_res <@ LoDist(D, ICORE_e, S(ICORE_e)).distinguish(); + b <- ICORE_eager.dist_res; + ICORE_eager.ewhile(); + } + (={glob D, glob S} ==> ={b}) + (={glob D, glob S} ==> ={b});progress. + + rewrite/#. + + seq 3 4 : (={b});inline*;auto. + - call(: ={glob S,glob ICORE_e});auto. + + by proc(={glob ICORE_e});auto;proc;sim. + + by proc(={glob ICORE_e});auto;proc;sim. + + by proc;sim. + by call(:true);auto. + by sp;while{2}(={b})(size world{2});auto;1:(sp;if);auto; + smt(bdistr_ll head_behead size_eq0 size_ge0). + + + replace{2} { all; <@ } by { + all; + ICORE_eager.ewhile(); + ICORE_eager.dist_res <@ LoDist(D, ICORE_eager, S(ICORE_eager)).distinguish(); + b <- ICORE_eager.dist_res; + } + (={glob D, glob S} ==> ={b}) + (={glob D, glob S} ==> ={b});progress;last first. + + by inline*;rcondf{1}7;auto;2:sim;call(:true);auto. + + by rewrite/#. + + swap{1}-1;sim. + + symmetry;seq 2 2 : (={glob S,glob D,glob ICORE_eager});1:sim;progress. + + eager call(: ={arg, glob D, glob S,glob ICORE_eager} ==> + ={res, glob D, glob S,glob ICORE_eager} );auto. + eager proc(H : ICORE_eager.ewhile(); ~ ICORE_eager.ewhile(); : + ={glob S, glob ICORE_eager} ==> ={glob S, glob ICORE_eager}) + (={glob S, glob ICORE_eager});auto;progress;1,3,5,7:sim. + + + eager proc(H': ICORE_eager.ewhile(); ~ ICORE_eager.ewhile(); : + ={glob ICORE_eager} ==> ={glob ICORE_eager}) + (={glob ICORE_eager});auto;progress;1,3:sim. + + (* eager : ewhile; ICORE_eager.f ~ ICORE_e.f ; ewhile *) + eager proc. + swap{1}2;swap{2}-1;sp;wp. + if{2};1:rcondt{1}2;last first;1:rcondf{1}2;progress;2:sim. + + inline*;sp;while(! (valid p /\ 0 < n));auto;sp;if;auto. + + inline*;sp;while(valid p /\ 0 < n);auto;sp;if;auto. + replace{2} { while as loop1; (<-;while as loop2); eage } by { + loop1; + eage; + loop2; + } + (={i,r,p,n,glob ICORE_eager} /\ i{2} = 1 /\ r{2} = [] /\ valid p{2} + /\ 0 < n{2} ==> ={r, ICORE_eager.dist_res, ICORE_eager.order, ICORE.m}) + (={i,r,p,n,glob ICORE_eager} /\ i{2} = 1 /\ r{2} = [] /\ valid p{2} + /\ 0 < n{2} ==> ={r, ICORE_eager.dist_res, ICORE_eager.order, ICORE.m}); + progress;1:rewrite/#. + + sim. + conseq(: ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i} + ==> ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i}); + progress. + eager while(J: ICORE_eager.ewhile(); ~ ICORE_eager.ewhile(); : + ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i} ==> + ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i}); + progress;1,3:sim. + swap{2}-1;sim. + inline*. + splitwhile{2}4:world <> [(take i p)]. + sp. swap{1}-4;sp. + seq 1 1: ( ={glob ICORE_eager,n,p,r,i} /\ i{1} < size p{1} + /\ world{2} = [(take i{2} p{2})] + /\ world{1} = [] + /\ world{2} = rcons world{1} (take i{2} p{2}));last first. + + rcondt{2}1;1:auto=>/#. + by rcondf{2}6;auto;sp;if;auto. + while(={glob ICORE_eager,n,p,r,i} /\ i{1} < size p{1} + /\ world{2} = rcons world{1} (take i{2} p{2}));last auto=>/#. + by sp;if;auto;smt(head_behead). + swap{1}3 -1;seq 2 2 :(={glob ICORE_eager,n,p,r,i});1:sim. + eager while(J: ICORE_eager.ewhile(); ~ ICORE_eager.ewhile(); : + ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i} ==> + ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i}); + progress;1,3:sim. + inline ICORE_eager.ewhile. + swap{2}[4..6]-2;sim;swap{2}2;sp. + symmetry;conseq(: ={world,ICORE.m,p,i} ==> ={world,ICORE.m,p,i,b});progress. + replace{1} { all } by { b <- b0; all; } + (={world,ICORE.m,p,i} ==> ={world,ICORE.m,p,i,b}) + (={world,ICORE.m,p,i} ==> ={world,ICORE.m,p,i,b});progress;1:rewrite/#;1:sim. + replace{2} { all } by { b <- b0; all; } + (={world,ICORE.m,p,i} ==> ={world,ICORE.m,p,i,b}) + (={world,ICORE.m,p,i} ==> ={world,ICORE.m,p,i,b});progress;1:rewrite/#;2:sim. + sp;conseq(: ={world,ICORE.m,p,i,b} ==> ={world,ICORE.m,p,i,b});progress. + eager while(J: b <@ ICORE.fill_in(p,i); ~ b <@ ICORE.fill_in(p,i); : + ={world, p, ICORE.m, i, b} ==> ={world, p, ICORE.m, i, b}); + progress;1,3:sim. + inline*;sp;wp. + swap{1}[3..5]-2;swap{2}[3..4]-2;sp. + case(((p0,n0)=(p1,n1)){1})=>//=. + - if;auto;1:rcondf{1}3;1:auto;1:smt(dom_set in_fsetU1). + + by rcondf{2}3;auto;smt(dom_set in_fsetU1). + by sp;if;auto. + if{2};last first;2:rcondt{1}3;1:rcondf{1}3;progress. + + if;auto;smt(dom_set in_fsetU1). + + sp;if;auto;smt(dom_set in_fsetU1). + + sp;if;auto;smt(dom_set in_fsetU1). + if{1};last first;2:rcondt{2}3;1:rcondf{2}3;progress. + + auto;smt(dom_set in_fsetU1). + + auto;smt(dom_set getP in_fsetU1). + + auto;smt(dom_set in_fsetU1). + swap{2}-1;wp;conseq(:_==> ={ICORE.m} /\ b{1} = oget ICORE.m{2}.[(p1{2}, n1{2})]);progress. + alias{1} 1 c = b0. + transitivity{1} { + b <$ bdistr; + c <$ bdistr; + ICORE.m.[(p0, n0)] <- b; + ICORE.m.[(p1, n1)] <- c; + } + (={ICORE.m,p0,n0,p1,n1} /\ ! (p0{1} = p1{1} && n0{1} = n1{1}) ==> + ={ICORE.m} /\ b{1} = oget ICORE.m{2}.[(p0{2}, n0{2})]) + (={ICORE.m} /\ (p0,n0,p1,n1){1} = (p1,n1,p0,n0){2} + /\ ! (p0{1} = p1{1} && n0{1} = n1{1}) ==> + ={ICORE.m} /\ (p0,n0,p1,n1){1} = (p1,n1,p0,n0){2}); + progress;1:rewrite/#. + + swap{2}3-1;wp;rnd=>/=. + wp 2 2;conseq(:_==> ={ICORE.m});1:smt(getP). + by wp;rnd;auto. + transitivity{1} { + b <$ bdistr; + c <$ bdistr; + ICORE.m.[(p1, n1)] <- b; + ICORE.m.[(p0, n0)] <- c; + } + (={ICORE.m,p0,n0,p1,n1} /\ ! (p0{1} = p1{1} && n0{1} = n1{1}) ==> + ={ICORE.m,p0,p1,n0,n1}) + (={ICORE.m} /\ (p0,n0,p1,n1){1} = (p1,n1,p0,n0){2} + /\ ! (p0{1} = p1{1} && n0{1} = n1{1}) ==> + ={ICORE.m} /\ (p0,n0,p1,n1){1} = (p1,n1,p0,n0){2}); + progress;1:rewrite/#. + + swap{1}1;wp;conseq(:_==> (b,c){1} = (c,b){2});progress;2:(rnd;rnd;auto). + by rewrite set_set H0. + by swap{1}3-1;wp;rnd;wp;rnd;auto. + + + eager proc(H': ICORE_eager.ewhile(); ~ ICORE_eager.ewhile(); : + ={glob ICORE_eager} ==> ={glob ICORE_eager}) + (={glob ICORE_eager});auto;progress;1,3:sim. + eager proc. + swap{1}2;swap{2}-1;sp;wp. + if{2};1:rcondt{1}2;last first;1:rcondf{1}2;progress;2:sim. + + inline*;sp;while(! (valid p /\ 0 < n));auto;sp;if;auto. + + inline*;sp;while(valid p /\ 0 < n);auto;sp;if;auto. + replace{2} { while as loop1; (<-;while as loop2); eage } by { + loop1; + eage; + loop2; + } + (={i,r,p,n,glob ICORE_eager} /\ i{2} = 1 /\ r{2} = [] /\ valid p{2} + /\ 0 < n{2} ==> ={r, ICORE_eager.dist_res, ICORE_eager.order, ICORE.m}) + (={i,r,p,n,glob ICORE_eager} /\ i{2} = 1 /\ r{2} = [] /\ valid p{2} + /\ 0 < n{2} ==> ={r, ICORE_eager.dist_res, ICORE_eager.order, ICORE.m}); + progress;1:rewrite/#. + + sim. + conseq(: ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i} + ==> ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i}); + progress. + eager while(J: ICORE_eager.ewhile(); ~ ICORE_eager.ewhile(); : + ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i} ==> + ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i}); + progress;1,3:sim. + swap{2}-1;sim. + inline*. + splitwhile{2}4:world <> [(take i p)]. + sp. swap{1}-4;sp. + seq 1 1: ( ={glob ICORE_eager,n,p,r,i} /\ i{1} < size p{1} + /\ world{2} = [(take i{2} p{2})] + /\ world{1} = [] + /\ world{2} = rcons world{1} (take i{2} p{2}));last first. + + rcondt{2}1;1:auto=>/#. + by rcondf{2}6;auto;sp;if;auto. + while(={glob ICORE_eager,n,p,r,i} /\ i{1} < size p{1} + /\ world{2} = rcons world{1} (take i{2} p{2}));last auto=>/#. + by sp;if;auto;smt(head_behead). + swap{1}3 -1;seq 2 2 :(={glob ICORE_eager,n,p,r,i});1:sim. + eager while(J: ICORE_eager.ewhile(); ~ ICORE_eager.ewhile(); : + ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i} ==> + ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i}); + progress;1,3:sim. + inline ICORE_eager.ewhile. + swap{2}[4..6]-2;sim;swap{2}2;sp. + symmetry;conseq(: ={world,ICORE.m,p,i} ==> ={world,ICORE.m,p,i,b});progress. + replace{1} { all } by { b <- b0; all; } + (={world,ICORE.m,p,i} ==> ={world,ICORE.m,p,i,b}) + (={world,ICORE.m,p,i} ==> ={world,ICORE.m,p,i,b});progress;1:rewrite/#;1:sim. + replace{2} { all } by { b <- b0; all; } + (={world,ICORE.m,p,i} ==> ={world,ICORE.m,p,i,b}) + (={world,ICORE.m,p,i} ==> ={world,ICORE.m,p,i,b});progress;1:rewrite/#;2:sim. + sp;conseq(: ={world,ICORE.m,p,i,b} ==> ={world,ICORE.m,p,i,b});progress. + eager while(J: b <@ ICORE.fill_in(p,i); ~ b <@ ICORE.fill_in(p,i); : + ={world, p, ICORE.m, i, b} ==> ={world, p, ICORE.m, i, b}); + progress;1,3:sim. + inline*;sp;wp. + swap{1}[3..5]-2;swap{2}[3..4]-2;sp. + case(((p0,n0)=(p1,n1)){1})=>//=. + - if;auto;1:rcondf{1}3;1:auto;1:smt(dom_set in_fsetU1). + + by rcondf{2}3;auto;smt(dom_set in_fsetU1). + by sp;if;auto. + if{2};last first;2:rcondt{1}3;1:rcondf{1}3;progress. + + if;auto;smt(dom_set in_fsetU1). + + sp;if;auto;smt(dom_set in_fsetU1). + + sp;if;auto;smt(dom_set in_fsetU1). + if{1};last first;2:rcondt{2}3;1:rcondf{2}3;progress. + + auto;smt(dom_set in_fsetU1). + + auto;smt(dom_set getP in_fsetU1). + + auto;smt(dom_set in_fsetU1). + swap{2}-1;wp;conseq(:_==> ={ICORE.m} /\ b{1} = oget ICORE.m{2}.[(p1{2}, n1{2})]);progress. + alias{1} 1 c = b0. + transitivity{1} { + b <$ bdistr; + c <$ bdistr; + ICORE.m.[(p0, n0)] <- b; + ICORE.m.[(p1, n1)] <- c; + } + (={ICORE.m,p0,n0,p1,n1} /\ ! (p0{1} = p1{1} && n0{1} = n1{1}) ==> + ={ICORE.m} /\ b{1} = oget ICORE.m{2}.[(p0{2}, n0{2})]) + (={ICORE.m} /\ (p0,n0,p1,n1){1} = (p1,n1,p0,n0){2} + /\ ! (p0{1} = p1{1} && n0{1} = n1{1}) ==> + ={ICORE.m} /\ (p0,n0,p1,n1){1} = (p1,n1,p0,n0){2}); + progress;1:rewrite/#. + + swap{2}3-1;wp;rnd=>/=. + wp 2 2;conseq(:_==> ={ICORE.m});1:smt(getP). + by wp;rnd;auto. + transitivity{1} { + b <$ bdistr; + c <$ bdistr; + ICORE.m.[(p1, n1)] <- b; + ICORE.m.[(p0, n0)] <- c; + } + (={ICORE.m,p0,n0,p1,n1} /\ ! (p0{1} = p1{1} && n0{1} = n1{1}) ==> + ={ICORE.m,p0,p1,n0,n1}) + (={ICORE.m} /\ (p0,n0,p1,n1){1} = (p1,n1,p0,n0){2} + /\ ! (p0{1} = p1{1} && n0{1} = n1{1}) ==> + ={ICORE.m} /\ (p0,n0,p1,n1){1} = (p1,n1,p0,n0){2}); + progress;1:rewrite/#. + + swap{1}1;wp;conseq(:_==> (b,c){1} = (c,b){2});progress;2:(rnd;rnd;auto). + by rewrite set_set H0. + by swap{1}3-1;wp;rnd;wp;rnd;auto. + + eager proc. + swap{1}3;sp;swap{2}-1;sim. + if{2};last first;2:rcondt{1}2;1:rcondf{1}2;progress;2:sim. + + by inline*;sp;while(! (valid x /\ 0 < n));auto;1:(sp;if);auto=>/#. + + by inline*;sp;while( valid x /\ 0 < n );auto;1:(sp;if);auto=>/#. + swap{2}-1;sim. + eager call(: ={p, n, ICORE_eager.dist_res, ICORE_eager.order, ICORE.m} + ==> ={res, ICORE_eager.dist_res, ICORE_eager.order, ICORE.m}). + + (* eager : ewhile; ICORE_eager.f ~ ICORE_e.f ; ewhile *) + eager proc. + swap{1}2;swap{2}-1;sp;wp. + if{2};1:rcondt{1}2;last first;1:rcondf{1}2;progress;2:sim. + + inline*;sp;while(! (valid p /\ 0 < n));auto;sp;if;auto. + + inline*;sp;while(valid p /\ 0 < n);auto;sp;if;auto. + replace{2} { while as loop1; (<-;while as loop2); eage } by { + loop1; + eage; + loop2; + } + (={i,r,p,n,glob ICORE_eager} /\ i{2} = 1 /\ r{2} = [] /\ valid p{2} + /\ 0 < n{2} ==> ={r, ICORE_eager.dist_res, ICORE_eager.order, ICORE.m}) + (={i,r,p,n,glob ICORE_eager} /\ i{2} = 1 /\ r{2} = [] /\ valid p{2} + /\ 0 < n{2} ==> ={r, ICORE_eager.dist_res, ICORE_eager.order, ICORE.m}); + progress;1:rewrite/#. + + sim. + conseq(: ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i} + ==> ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i}); + progress. + eager while(J: ICORE_eager.ewhile(); ~ ICORE_eager.ewhile(); : + ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i} ==> + ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i}); + progress;1,3:sim. + swap{2}-1;sim. + inline*. + splitwhile{2}4:world <> [(take i p)]. + sp. swap{1}-4;sp. + seq 1 1: ( ={glob ICORE_eager,n,p,r,i} /\ i{1} < size p{1} + /\ world{2} = [(take i{2} p{2})] + /\ world{1} = [] + /\ world{2} = rcons world{1} (take i{2} p{2}));last first. + + rcondt{2}1;1:auto=>/#. + by rcondf{2}6;auto;sp;if;auto. + while(={glob ICORE_eager,n,p,r,i} /\ i{1} < size p{1} + /\ world{2} = rcons world{1} (take i{2} p{2}));last auto=>/#. + by sp;if;auto;smt(head_behead). + swap{1}3 -1;seq 2 2 :(={glob ICORE_eager,n,p,r,i});1:sim. + eager while(J: ICORE_eager.ewhile(); ~ ICORE_eager.ewhile(); : + ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i} ==> + ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i}); + progress;1,3:sim. + inline ICORE_eager.ewhile. + swap{2}[4..6]-2;sim;swap{2}2;sp. + symmetry;conseq(: ={world,ICORE.m,p,i} ==> ={world,ICORE.m,p,i,b});progress. + replace{1} { all } by { b <- b0; all; } + (={world,ICORE.m,p,i} ==> ={world,ICORE.m,p,i,b}) + (={world,ICORE.m,p,i} ==> ={world,ICORE.m,p,i,b});progress;1:rewrite/#;1:sim. + replace{2} { all } by { b <- b0; all; } + (={world,ICORE.m,p,i} ==> ={world,ICORE.m,p,i,b}) + (={world,ICORE.m,p,i} ==> ={world,ICORE.m,p,i,b});progress;1:rewrite/#;2:sim. + sp;conseq(: ={world,ICORE.m,p,i,b} ==> ={world,ICORE.m,p,i,b});progress. + eager while(J: b <@ ICORE.fill_in(p,i); ~ b <@ ICORE.fill_in(p,i); : + ={world, p, ICORE.m, i, b} ==> ={world, p, ICORE.m, i, b}); + progress;1,3:sim. + inline*;sp;wp. + swap{1}[3..5]-2;swap{2}[3..4]-2;sp. + case(((p0,n0)=(p1,n1)){1})=>//=. + - if;auto;1:rcondf{1}3;1:auto;1:smt(dom_set in_fsetU1). + + by rcondf{2}3;auto;smt(dom_set in_fsetU1). + by sp;if;auto. + if{2};last first;2:rcondt{1}3;1:rcondf{1}3;progress. + + if;auto;smt(dom_set in_fsetU1). + + sp;if;auto;smt(dom_set in_fsetU1). + + sp;if;auto;smt(dom_set in_fsetU1). + if{1};last first;2:rcondt{2}3;1:rcondf{2}3;progress. + + auto;smt(dom_set in_fsetU1). + + auto;smt(dom_set getP in_fsetU1). + + auto;smt(dom_set in_fsetU1). + swap{2}-1;wp;conseq(:_==> ={ICORE.m} /\ b{1} = oget ICORE.m{2}.[(p1{2}, n1{2})]);progress. + alias{1} 1 c = b0. + transitivity{1} { + b <$ bdistr; + c <$ bdistr; + ICORE.m.[(p0, n0)] <- b; + ICORE.m.[(p1, n1)] <- c; + } + (={ICORE.m,p0,n0,p1,n1} /\ ! (p0{1} = p1{1} && n0{1} = n1{1}) ==> + ={ICORE.m} /\ b{1} = oget ICORE.m{2}.[(p0{2}, n0{2})]) + (={ICORE.m} /\ (p0,n0,p1,n1){1} = (p1,n1,p0,n0){2} + /\ ! (p0{1} = p1{1} && n0{1} = n1{1}) ==> + ={ICORE.m} /\ (p0,n0,p1,n1){1} = (p1,n1,p0,n0){2}); + progress;1:rewrite/#. + + swap{2}3-1;wp;rnd=>/=. + wp 2 2;conseq(:_==> ={ICORE.m});1:smt(getP). + by wp;rnd;auto. + transitivity{1} { + b <$ bdistr; + c <$ bdistr; + ICORE.m.[(p1, n1)] <- b; + ICORE.m.[(p0, n0)] <- c; + } + (={ICORE.m,p0,n0,p1,n1} /\ ! (p0{1} = p1{1} && n0{1} = n1{1}) ==> + ={ICORE.m,p0,p1,n0,n1}) + (={ICORE.m} /\ (p0,n0,p1,n1){1} = (p1,n1,p0,n0){2} + /\ ! (p0{1} = p1{1} && n0{1} = n1{1}) ==> + ={ICORE.m} /\ (p0,n0,p1,n1){1} = (p1,n1,p0,n0){2}); + progress;1:rewrite/#. + + swap{1}1;wp;conseq(:_==> (b,c){1} = (c,b){2});progress;2:(rnd;rnd;auto). + by rewrite set_set H0. + by swap{1}3-1;wp;rnd;wp;rnd;auto. + + by auto;progress=>/#. + qed. lemma LiftInd &m: `| Pr[Low.Indif(CORE(P),P,LoDist(D)).main() @ &m: res] @@ -188,21 +827,86 @@ section PROOF. do !congr. + byequiv (_: ={glob D, glob P} ==> _ )=> //=; proc. call (_: ={glob P}); first 2 by sim. - + proc=> /=; sp; if=>//=; inline{1} 1. - sp;wp. + + proc=> /=; sp;if=>//=;1:progress=>/#. + inline*;sp;wp. rcondt{1}1;progress. - while( ={sa,sc,glob P,i} /\ r0{1} = r{2} /\ n{2} = n0{1});auto;1:call(:true);auto. - by conseq(:_==> ={sa, sc, glob P} /\ r0{1} = r{2} /\ n{2} = n0{1}); - 2:sim;progress=>/#. + splitwhile{2}1: i < size x. + seq 3 1:( ={glob P,sa,sc,p} + /\ (x,n,p0,n0){1} = (x,n,x,n){2} + /\ valid x{1} + /\ i{2} = size x{2} + /\ i{1} = 1 + /\ r0{1} = [sa{1}] + /\ (x{2}, n{2}) = parse p{2} + /\ 0 < n{1}). + + wp;conseq(:_==> ={glob P,sa,sc,i,p,x,n} + /\ i{2} = size x{2} + /\ (x,n,p0,n0){1} = (x,n,x,n){2});progress. + while( ={glob P,sa,sc,i,p,x,n} + /\ (x{2}, n{2}) = parse p{2} + /\ (p0,n0){1} = (x,n){2} + /\ 0 <= i{2} <= size x{2} <= size p{2});auto;1:call(:true);auto;progress;2..9,-3..-1:smt(size_ge0). + + by rewrite-(formatK p{2})-H/=/format nth_cat H3. + + by rewrite-(formatK p{2})-H/=/format size_cat;smt(size_ge0). + by rewrite-(formatK p{2})-H/=/format size_cat;smt(size_ge0). - by inline*;auto;call(:true);auto. + while( ={glob P,sa,sc,p} + /\ i{1} - 1 = i{2} - size x{2} + /\ size x{2} <= i{2} <= size p{2} + /\ sa{1} = last b0 r0{1} + /\ (x{2}, n{2}) = parse p{2} + /\ (x{1}, n{1}) = parse p{1} + /\ valid x{1} + /\ 0 < n{1} + /\ size p{2} = size x{2} + n{2} - 1 + /\ n0{1} = n{2} + );auto;last first. + + progress. + + by rewrite-(formatK p{2})-H0/=/format size_cat size_nseq/#. + + by rewrite-(formatK p{2})-H0/=/format size_cat size_nseq/#. + + by rewrite-(formatK p{2})-H0/=/format size_cat size_nseq/#. + by move:H2;rewrite-(formatK p{2})-H0/=/format size_cat size_nseq/#. + call(:true);auto;progress;2..5,-2..:smt(last_rcons). + rewrite -(formatK p{2})-H2/=/format nth_cat nth_nseq_if. + cut->//=:!i{2} < size x{2} by rewrite/#. + cut->//=: 0 <= i{2} - size x{2} by rewrite/#. + rewrite-H. + cut->/=:i{1} - 1 < n{2} - 1 by rewrite/#. + by rewrite BlockMonoid.addr0. + + by inline*;auto;call(:true);auto. print HiSim. print ICORE. + + (* TODO : Introduce an equivalent module to ICORE whose fill_in procedure + makes the same calls as IBlockSponge *) + (* rewrite (eager_ICORE &m). *) byequiv (_: ={glob D, glob S} ==> _)=> //=; proc. - call (_: ={glob S} /\ ={m}(ICORE,IBlockSponge) ). - + proc (ICORE.m{1} = IBlockSponge.m{2})=> //. - proc=> /=; sp;if=> [&1 &2 [#] <*>| |] //. + + call (_: ={glob S} /\ INV IBlockSponge.m{2} ICORE.m{1}). + + proc (INV IBlockSponge.m{2} ICORE.m{1})=> //. + proc=> /=; sp;if=> [&1 &2 [#] <*>| |] //=. + inline{2} 1.1. inline*. - sp;rcondt{2}1;auto. + while( INV IBlockSponge.m{2} ICORE.m{1} + /\ i{1} = i{2} + 1 + /\ 0 < i{1} + /\ ={n,p,r} + /\ valid p{1} /\ 0 < n{1});last auto=>/#. + rcondt{2}6;auto;progress. + + by cut:=parseK p{hr} (i{hr}+1) H0 H1;rewrite/format-addzA/==>->/=. + + by cut:=parseK p{hr} (i{hr}+1) H0 H1;rewrite/format-addzA/==>->/=. + sp. + conseq(:_==> INV IBlockSponge.m{2} ICORE.m{1} /\ x1{2} = x{2} /\ );1:progress. + rewrite/#. + congr;congr;rewrite H6 -H;congr;congr;2:rewrite/#. + rewrite/#. + rewrite/#. + rewrite/#. + rewrite/#. + rewrite/#. + rewrite/#. + /\ ={r + rcondt{1}1;1:auto=>/#. conseq(:_ ==> r{1} = bs{2} /\ ICORE.m{1} = IBlockSponge.m{2});progress. by while( i{1} = i0{2} + 1 /\ n{1} = n0{2} /\ x{2} = p{1} diff --git a/proof/clean/NewCore.eca b/proof/clean/NewCore.eca index 89d5c13..56a5c10 100644 --- a/proof/clean/NewCore.eca +++ b/proof/clean/NewCore.eca @@ -131,3 +131,9 @@ module (S : SIMULATOR) (F : DFUNCTIONALITY) : PRIMITIVE = { return y; } }. + + +(* we want to build S such that, + forall D, + D^{Core(P),P} ~ D^{ICore,S(ICore)} +*) \ No newline at end of file From a13adf2d419ec239c032ebc6a1865b5996745e86 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Thu, 4 Jan 2018 17:01:15 -0500 Subject: [PATCH 249/525] Brought RndO.ec and Sponge.ec up-to-date with current library. --- proof/RndO.ec | 40 +++++++++++++++++++++++++++------------- proof/Sponge.ec | 32 ++++++++++++++++---------------- 2 files changed, 43 insertions(+), 29 deletions(-) diff --git a/proof/RndO.ec b/proof/RndO.ec index b533c6e..fdc6799 100644 --- a/proof/RndO.ec +++ b/proof/RndO.ec @@ -1,6 +1,5 @@ pragma -oldip. -require import Pair Option List FSet NewFMap NewDistr. - import NewLogic Fun. +require import Core List FSet NewFMap Distr. require IterProc. (* FIXME notation *) @@ -302,7 +301,8 @@ module LRO : RO = { lemma RRO_resample_ll : islossless RRO.resample. proof. - proc;call (iter_ll RRO.I _)=>//;proc;auto=>/=?;apply sampleto_ll. + proc;call (iter_ll RRO.I _)=>//;proc;auto=>/=?; + by split; first apply sampleto_ll. qed. lemma eager_init : @@ -355,9 +355,13 @@ proof. exists*x{1}, ((oget FRO.m.[x{2}]){1});elim*=>x1 mx;inline RRO.resample. call (iter_inv RRO.I (fun z=>x1<>z) (fun o1 o2 => o1 = o2 /\ o1.[x1]= Some mx) _)=>/=. + by conseq (I_f_neq x1 (Some mx))=>//. - auto=>?&mr[#]4->Hd Hget;rewrite sampleto_ll /==>?_;split. + auto=>?&mr[#]4->Hd Hget. + split; first apply sampleto_ll. + move=> /=_?_; split. + by rewrite get_oget//oget_some/==> x;rewrite -memE dom_restr/#. - by move=>[#]_ Heq?mr[#]->Heq'?_;rewrite in_dom Heq' oget_some /= set_eq /#. + move=>[#]_ Heq?mr[#]->Heq'. + split=> [| _ r _]; first apply sampleto_ll. + rewrite in_dom Heq' oget_some /= set_eq /#. case ((mem (dom FRO.m) x){1}). + inline{1} RRO.resample=>/=;rnd{1}. transitivity{1} @@ -370,7 +374,8 @@ proof. FRO.m{2}.[x{2}] = Some (result{2},Known)). + by move=>?&mr[#]-> -> ??;exists FRO.m{mr} x{mr}=>/#. + move=>???;rewrite in_dom=>[#]<*>[#]->/eq_except_sym H Hxm Hx2. - rewrite sampleto_ll=> r _;rewrite /= Hxm oget_some /=;apply /eq_sym. + split=> [| _ r _]; first apply sampleto_ll. + rewrite /= Hxm oget_some /=;apply /eq_sym. have /(congr1 oget):= Hx2 => <-;apply eq_except_set_eq=>//. by rewrite in_dom Hx2. + symmetry;call (iter1_perm RRO.I iter_perm2). @@ -420,7 +425,8 @@ proof. seq 3 1: (={x,y} /\ eq_except FRO.m{1} FRO.m{2} (pred1 x{1}) /\ l{1} = (elems (dom (restr Unknown FRO.m))){2} /\ !mem l{1} x{1} /\ (FRO.m.[x]=Some(y, Known)){2}). - + inline *;auto=>?&mr[#]3->/=Hmem Hget;rewrite sampleto_ll=>?_. + + inline *;auto=>?&mr[#]3->/=Hmem Hget. + split=> [|_ c _]; first apply sampleto_ll. by rewrite set2_eq_except getP_eq restr_set /= dom_rem -memE !inE negb_and. exists* x{1},y{1},(FRO.m.[x]{1});elim*=>x1 y1 mx1;pose mx2:=Some(y1,Known). call (iter_inv RRO.I (fun z=>x1<>z) @@ -455,7 +461,8 @@ proof. seq 3 1: (={x} /\ eq_except FRO.m{1} FRO.m{2} (pred1 x{1}) /\ l{1} = (elems (dom (restr Unknown FRO.m))){2} /\ !mem l{1} x{1} /\ (FRO.m.[x]=None){2}). - + inline *;auto=>??[#]2->Hidm/=;rewrite sampleto_ll=>?_. + + inline *;auto=>??[#]2->Hidm/=. + split=> [| _ c _]; first apply sampleto_ll. rewrite eq_except_rem 2:set_eq_except // remP -memE in_fsetD1 negb_and /=. by rewrite restr_rem Hidm /= dom_rem. exists* x{1},(FRO.m.[x]{1});elim*=>x1 mx1. @@ -486,7 +493,10 @@ proof. while (={l,FRO.m} /\ (forall z, mem l z => in_dom_with FRO.m z Unknown){1} /\ in_dom_with FRO.m{1} x{1} f{1} = result{2}). + auto=>?&mr[#]2->Hz <-?_/=?->/=. - split=>[z /mem_drop Hm|];rewrite /in_dom_with dom_set getP !inE /#. + split=>[z /mem_drop Hm|]. + rewrite /in_dom_with dom_set getP !inE /#. + rewrite /in_dom_with in Hz. + rewrite /in_dom_with dom_set getP !inE; smt(mem_head_behead). by auto=>?&mr/=[#]3->/=;split=>// z;rewrite -memE dom_restr. qed. @@ -523,7 +533,9 @@ proof. seq 1 7 : (={x} /\ eq_except FRO.m{1} FRO.m{2} (pred1 x{1}) /\ l{2} = (elems (dom (restr Unknown FRO.m))){1} /\ (FRO.m.[x]){2} = Some(c{1},Unknown) /\ (FRO.m.[x]){1} = None). - + wp;rnd;auto=>?&mr[#]2->;rewrite in_dom sampleto_ll/==>Heq?_?->. + + wp;rnd;auto=>?&mr[#]2->; rewrite in_dom /=. + move=> Heq; split; first apply sampleto_ll. + move=> _ c _ ??; split=> // _. rewrite getP_eq restr_set/=dom_set fsetDK eq_except_sym set_set Heq/=set_eq_except/=. congr;apply fsetP=>z;rewrite in_fsetD1 dom_restr /in_dom_with !in_dom /#. exists*x{1},c{1};elim*=>x1 c1;pose mx2:=Some(c1,Unknown). @@ -599,7 +611,7 @@ equiv LRO_RRO_get : LRO.get ~ RRO.get : ={x} /\ RO.m{1} = restr Known FRO.m{2} ==> ={res} /\ RO.m{1} = restr Known FRO.m{2}. proof. proc;auto=>?&ml[]->->/=?->/=. - rewrite dom_restr negb_and ora_or neqK_eqU. + rewrite dom_restr orabP negb_and neqK_eqU. rewrite !restr_set/= !getP_eq oget_some;progress. by move:H;rewrite negb_or/= restrP in_dom /#. qed. @@ -619,8 +631,10 @@ qed. equiv LRO_RRO_sample : LRO.sample ~ RRO.sample: ={x} /\ RO.m{1} = restr Known FRO.m{2} ==> RO.m{1} = restr Known FRO.m{2}. proof. - proc;auto=>?&ml[]_->;rewrite sampleto_ll=> ??;rewrite restr_set /==>Hnd. - by rewrite rem_id // dom_restr /in_dom_with Hnd. + proc;auto=>?&ml[]_->. +split=> [| _ ? _]; first apply sampleto_ll. +rewrite restr_set /==>Hnd. +by rewrite rem_id // dom_restr /in_dom_with Hnd. qed. lemma LRO_RRO_D (D<:RO_Distinguisher{RO,FRO}) : diff --git a/proof/Sponge.ec b/proof/Sponge.ec index 3873aaa..f812a3a 100644 --- a/proof/Sponge.ec +++ b/proof/Sponge.ec @@ -8,9 +8,9 @@ prover ["Z3"]. prover ["Alt-Ergo"]. *) -require import Bool Fun Pair Option Int IntDiv Real List FSet NewFMap. -(*---*) import Pred IntExtra. -require import NewDistr DBool DList. +require import Core Int IntDiv Real List FSet NewFMap. +(*---*) import IntExtra. +require import Distr DBool DList. require import StdBigop StdOrder. import IntOrder. require import Common. require (*--*) IRO BlockSponge RndO. @@ -1168,12 +1168,12 @@ proof *. (* nothing to be proved *) lemma PrLoopSnoc_sample &m (bs : bool list) : - Pr[Prog.LoopSnoc.sample(r) @ &m : bs = res] = + Pr[Prog.LoopSnoc.sample(r) @ &m : res = bs] = mu (dlist {0,1} r) (pred1 bs). proof. have -> : - Pr[Prog.LoopSnoc.sample(r) @ &m : bs = res] = - Pr[Prog.Sample.sample(r) @ &m : bs = res]. + Pr[Prog.LoopSnoc.sample(r) @ &m : res = bs] = + Pr[Prog.Sample.sample(r) @ &m : res = bs]. byequiv=> //. symmetry. conseq (_ : ={n} ==> ={res})=> //. @@ -1220,15 +1220,15 @@ lemma BlockGen_loop_direct : equiv[BlockGen.loop ~ BlockGen.direct : true ==> ={res}]. proof. bypr res{1} res{2}=> // &1 &2 w. -have -> : Pr[BlockGen.direct() @ &2 : w = res] = 1%r / (2 ^ r)%r. +have -> : Pr[BlockGen.direct() @ &2 : res = w] = 1%r / (2 ^ r)%r. byphoare=> //. - proc; rnd; skip; progress; rewrite DWord.bdistrE. - have -> : (fun x => w = x) = (pred1 w) - by apply ExtEq.fun_ext=> x; by rewrite (eq_sym w x). - by rewrite count_uniq_mem 1:enum_uniq enumP b2i1. + proc; rnd; skip; progress. + rewrite DBlock.dunifinE. + have -> : (transpose (=) w) = (pred1 w) by rewrite /pred1. + by rewrite DBlock.Support.enum_spec block_card. have -> : - Pr[BlockGen.loop() @ &1 : w = res] = - Pr[Prog.LoopSnoc.sample(r) @ &1 : ofblock w = res]. + Pr[BlockGen.loop() @ &1 : res = w] = + Pr[Prog.LoopSnoc.sample(r) @ &1 : res = ofblock w]. byequiv=> //; proc. seq 2 2 : (r = n{2} /\ j{1} = i{2} /\ j{1} = 0 /\ @@ -1245,11 +1245,11 @@ have -> : have sz_ds_eq_r : size ds = r by smt(). progress; [by rewrite ofblockK | by rewrite mkblockK]. rewrite (PrLoopSnoc_sample &1 (ofblock w)). -rewrite mux_dlist 1:ge0_r size_block /=. +rewrite dlist1E 1:ge0_r size_block /=. have -> : - (fun (x : bool) => mu {0,1} (pred1 x)) = + (fun (x : bool) => mu1 {0,1} x) = (fun (x : bool) => 1%r / 2%r). - apply ExtEq.fun_ext=> x; by rewrite dboolb. +apply fun_ext=> x; by rewrite dbool1E. by rewrite Bigreal.BRM.big_const count_predT size_block iter_mul_one_half_pos 1:gt0_r. qed. From 092f4d537c1e45b7ec66e3bbeea95b6dd7761ad7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Fri, 5 Jan 2018 19:52:18 +0100 Subject: [PATCH 250/525] . --- proof/clean/BlockSponge.eca | 856 +++++++++++++++++------------------- 1 file changed, 399 insertions(+), 457 deletions(-) diff --git a/proof/clean/BlockSponge.eca b/proof/clean/BlockSponge.eca index 822ef5a..67e2782 100644 --- a/proof/clean/BlockSponge.eca +++ b/proof/clean/BlockSponge.eca @@ -132,12 +132,12 @@ module (HiSim (S : Low.SIMULATOR) : SIMULATOR) (F : DFUNCTIONALITY) = { proc f(p : block list, n : int): block list = { var r <- []; var b; - var i <- 0; + var i <- 1; if (valid p /\ 0 < n) { - while (i < n) { - b <@ F.f(p ++ nseq i b0); + while (i <= n) { + b <@ F.f(format p i); r <- rcons r b; i <- i + 1; } @@ -205,17 +205,16 @@ local module ICORE_eager : Low.FUNCTIONALITY = { var (p,n) <- parse x; while (i < size p) { - ICORE.fill_in(take i p, 1); - order <- rcons order (take i p); + ICORE.fill_in(parse(take i p)); i <- i + 1; } i <- 1; - while (i <= n) { + while (i < n) { ICORE.fill_in(p, i); - order <- rcons order (format p i); i <- i + 1; } - c <@ ICORE.fill_in(p,n); + c <@ ICORE.fill_in(parse(format p n)); + order <- rcons order x; return c; } @@ -236,35 +235,39 @@ local module ICORE_eager : Low.FUNCTIONALITY = { } proc ewhile() : unit = { var world <- order; + var i <- 1; + var (p,n); var y <- []; + while(world <> []) { y <- head ([]) world; - fill_in(y); + i <- 1; + (p,n) <- parse y; + while (i < size p) { + ICORE.fill_in(parse(take i p)); + i <- i + 1; + } + i <- 1; + while (i < n) { + ICORE.fill_in(parse(format p i)); + i <- i + 1; + } world <- behead world; } } }. - local module ICORE_e = { + local module ICORE_e : Low.FUNCTIONALITY = { proc init = ICORE_eager.init proc fill_in (x : block list) = { - var i <- 1; var c; var (p,n) <- parse x; - while (i < size p) { - ICORE_eager.order <- rcons ICORE_eager.order (take i p); - i <- i + 1; - } - i <- 1; - while (i <= n) { - ICORE_eager.order <- rcons ICORE_eager.order (format p i); - i <- i + 1; - } c <@ ICORE.fill_in(p,n); + ICORE_eager.order <- rcons ICORE_eager.order (x); return c; } @@ -286,6 +289,223 @@ local module ICORE_eager : Low.FUNCTIONALITY = { } }. + local lemma eager_ICORE_fill_in : + eager[ ICORE_eager.ewhile();, ICORE.fill_in + ~ ICORE.fill_in, ICORE_eager.ewhile(); + : ={arg, ICORE_eager.order, ICORE.m} + ==> + ={res, ICORE_eager.order, ICORE.m}]. + proof. + eager proc. + inline ICORE_eager.ewhile;symmetry. + swap{1}[1..2]2. + replace{1} { all } by { + result <- b0; + all; + } + (={p,n,ICORE_eager.order,ICORE.m} + ==> ={result,ICORE_eager.order,ICORE.m}) + (={p,n,ICORE_eager.order,ICORE.m} + ==> ={result,ICORE_eager.order,ICORE.m}); + progress;1:rewrite/#;1:sim. + replace{2} { all } by { + result <- b0; + all; + } + (={p,n,ICORE_eager.order,ICORE.m} + ==> ={result,ICORE_eager.order,ICORE.m}) + (={p,n,ICORE_eager.order,ICORE.m} + ==> ={result,ICORE_eager.order,ICORE.m}); + progress;1:rewrite/#;2:sim. + sp;swap{1}3-2;sp. + conseq(: ={world, ICORE_eager.order, ICORE.m, p, n, result} + ==> ={world, ICORE_eager.order, ICORE.m, p, n, result});progress. + eager while(J: + if (!((p,n) \in dom ICORE.m)) { + ICORE.m.[(p,n)] <$ bdistr; + } + result <- oget ICORE.m.[(p, n)]; + ~ + if (!((p,n) \in dom ICORE.m)) { + ICORE.m.[(p,n)] <$ bdistr; + } + result <- oget ICORE.m.[(p, n)]; + : + ={world, ICORE_eager.order, ICORE.m, p, n, result} + ==> + ={world, ICORE_eager.order, ICORE.m, p, n, result});progress;1,3:sim. + swap{2}7 2;sim;swap{1}3-2;sp 1 1. + conseq(: ={y,p,n,ICORE.m,ICORE_eager.order} + ==> ={result,ICORE.m,ICORE_eager.order});progress. + + replace{1} { (if;<-); body } by { + result <@ ICORE.fill_in(p,n); + body; + } + (={y,p,n,ICORE.m,ICORE_eager.order} + ==> ={result,ICORE.m,ICORE_eager.order}) + (={y,p,n,ICORE.m,ICORE_eager.order} + ==> ={result,ICORE.m,ICORE_eager.order}); + progress;1:rewrite/#;1:(inline{2}1;sim). + replace{2} { body;(if;<-) } by { + body; + result <@ ICORE.fill_in(p,n); + } + (={y,p,n,ICORE.m,ICORE_eager.order} + ==> ={result,ICORE.m,ICORE_eager.order}) + (={y,p,n,ICORE.m,ICORE_eager.order} + ==> ={result,ICORE.m,ICORE_eager.order}); + progress;1:rewrite/#;2:(inline*;sim). + + replace{2} { begin; (while as loop); (<@ as result) } by { + begin; + result; + loop; + } + (={y,p,n,ICORE.m,ICORE_eager.order} + ==> ={n0,p0,result,ICORE.m,ICORE_eager.order}) + (={y,p,n,ICORE.m,ICORE_eager.order} + ==> ={n0,p0,result,ICORE.m,ICORE_eager.order}); + progress;1:rewrite/#;last first. + + + seq 4 4:(={i,n0,p,p0,n,ICORE_eager.order,ICORE.m});1:sim. + replace{1} { all } by { result <- b0; all; } + (={i, n0, p, p0, n, ICORE_eager.order, ICORE.m} + ==> ={n0,p0,result, ICORE.m, ICORE_eager.order}) + (={i, n0, p, p0, n, ICORE_eager.order, ICORE.m} + ==> ={n0,p0,result, ICORE.m, ICORE_eager.order}); + progress;1:rewrite/#;1:sim. + replace{2} { all } by { result <- b0; all; } + (={i, n0, p, p0, n, ICORE_eager.order, ICORE.m} + ==> ={n0,p0,result, ICORE.m, ICORE_eager.order}) + (={i, n0, p, p0, n, ICORE_eager.order, ICORE.m} + ==> ={n0,p0,result, ICORE.m, ICORE_eager.order}); + progress;1:rewrite/#;2:sim. + sp;conseq(: ={i, n0, p, p0, n, ICORE_eager.order, ICORE.m, result} + ==> _);progress. + eager while(K: + result <@ ICORE.fill_in(p, n); ~ + result <@ ICORE.fill_in(p, n); : + ={i, n0, p, p0, n, ICORE_eager.order, ICORE.m, result} ==> + ={i, n0, p, p0, n, ICORE_eager.order, ICORE.m, result}); + progress;1,3:sim. + swap{2}-1;sim;conseq(:_==> ={result,ICORE.m});progress. + inline *. (* TODO : reprendre d'ici. Il y avait un pb de parse/format. *) + + + case((p, n){1} = (p0, i){1}). + + sp;rcondf{1}5;first auto;if;auto;smt(dom_set in_fsetU1). + by rcondf{2}4;auto;if;auto;smt(dom_set in_fsetU1). + sp;if{1};last first;2:rcondt{2}4;1:rcondf{2}4;progress;2:sim. + + auto;if;auto;smt(dom_set in_fsetU1). + + if{2};last first;2:rcondt{1}4;1:rcondf{1}4;auto;smt(getP). + + auto;if;auto;smt(dom_set in_fsetU1). + if{2};last first;2:rcondt{1}5;1:rcondf{1}5;progress. + + auto;smt(dom_set in_fsetU1). + + auto;smt(getP). + + auto;smt(dom_set in_fsetU1). + conseq(:_==> ={ICORE.m,result});progress. + alias{1} 1 c = b0; + transitivity{1} { + c <$ bdistr; + result <$ bdistr; + ICORE.m.[(p,n)] <- result; + ICORE.m.[(p0,i)] <- c; + } + (={p0,i,p,n,ICORE.m} /\ p1{1} = p{1} /\ n1{1} = n{1} + /\ ! (p{1} = p0{1} && n{1} = i{1}) ==> ={ICORE.m,result}) + (={p0,i,p,n,ICORE.m} /\ p1{2} = p0{2} /\ n1{2} = i{2} + /\ ! (p{1} = p0{1} && n{1} = i{1}) ==> ={ICORE.m,result}); + progress;1:rewrite/#. + + by swap{2}2;wp;rnd;wp;rnd;auto;smt(getP). + transitivity{1} { + c <$ bdistr; + result <$ bdistr; + ICORE.m.[(p,n)] <- result; + ICORE.m.[(p0,i)] <- c; + } + (={p0,i,p,n,ICORE.m} /\ ! (p{1} = p0{1} && n{1} = i{1}) + ==> ={ICORE.m,result}) + (={p0,i,p,n,ICORE.m} /\ p1{2} = p0{2} /\ n1{2} = i{2} + /\ ! (p{1} = p0{1} && n{1} = i{1}) ==> ={ICORE.m,result}); + progress;1:rewrite/#. + + by wp;rnd;rnd;auto;smt(set_set). + by wp;rnd;wp;rnd;auto;progress;smt(set_set getP). + sim;swap{2}-1;sim;swap{1}2;sp. + + conseq(: ={p,n,p0,n0,i,ICORE.m,ICORE_eager.order} + ==> ={result,ICORE_eager.order,ICORE.m});first 2 progress=>/#. + replace{1} { all } by { + result <- b0; + all; + } + (={p,n,p0,i,ICORE_eager.order,ICORE.m} + ==> ={result,ICORE_eager.order,ICORE.m}) + (={p,n,p0,i,ICORE_eager.order,ICORE.m} + ==> ={result,ICORE_eager.order,ICORE.m}); + progress;1:rewrite/#;1:sim. + replace{2} { all } by { + result <- b0; + all; + } + (={p,n,p0,i,ICORE_eager.order,ICORE.m} + ==> ={result,ICORE_eager.order,ICORE.m}) + (={p,n,p0,i,ICORE_eager.order,ICORE.m} + ==> ={result,ICORE_eager.order,ICORE.m}); + progress;1:rewrite/#;2:sim. + sp;conseq(: ={p,n,p0,i,ICORE.m,ICORE_eager.order,result} ==> _); + progress. + eager while(K: + result <@ ICORE.fill_in(p, n); ~ + result <@ ICORE.fill_in(p, n); : + ={p, n, p0, i, ICORE.m, ICORE_eager.order, result} ==> + ={p, n, p0, i, ICORE.m, ICORE_eager.order, result}); + progress;1,3:sim. + + swap{2}-1;sim;conseq(:_==> ={result,ICORE.m});progress. + inline *. + case((p, n){1} = parse (take i p0){1}). + + sp;rcondf{1}4;first auto;if;auto;smt(dom_set in_fsetU1). + by rcondf{2}4;auto;if;auto;smt(dom_set in_fsetU1). + sp;if{1};last first;2:rcondt{2}4;1:rcondf{2}4;progress;2:sim. + + auto;if;auto;smt(dom_set in_fsetU1). + + if{2};last first;2:rcondt{1}3;1:rcondf{1}3;auto;smt(getP). + + auto;if;auto;smt(dom_set in_fsetU1). + if{2};last first;2:rcondt{1}4;1:rcondf{1}4;progress. + + auto;smt(dom_set in_fsetU1). + + auto;smt(getP). + + auto;smt(dom_set in_fsetU1). + conseq(:_==> ={ICORE.m,result});progress. + alias{1} 1 c = b0. + transitivity{1} { + c <$ bdistr; + result <$ bdistr; + ICORE.m.[(p,n)] <- result; + ICORE.m.[parse(take i p0)] <- c; + } + (={p0,i,p,n,ICORE.m} /\ p1{1} = p{1} /\ n1{1} = n{1} + /\ (p1{1},n1{1}) <> parse (take i{1} p0{1}) ==> ={ICORE.m,result}) + (={p0,i,p,n,ICORE.m} /\ (p1{2},n1{2}) = parse(take i{1} p0{2}) + /\ (p1{1},n1{1}) <> parse (take i{1} p0{1}) ==> ={ICORE.m,result}); + progress;1:rewrite/#. + + by swap{2}2;wp;rnd;wp;rnd;auto;smt(getP). + transitivity{1} { + c <$ bdistr; + result <$ bdistr; + ICORE.m.[(p,n)] <- result; + ICORE.m.[parse(take i p0)] <- c; + } + (={p0,i,p,n,ICORE.m} /\ (p1{1},n1{1}) <> parse (take i{1} p0{1}) + ==> ={ICORE.m,result}) + (={p0,i,p,n,ICORE.m} /\ (p1{2},n1{2}) = parse(take i{1} p0{2}) + /\ (p1{1},n1{1}) <> parse (take i{1} p0{1}) ==> ={ICORE.m,result}); + progress;1:rewrite/#. + + by wp;rnd;rnd;auto;smt(set_set). + wp;rnd;wp;rnd;auto;progress. smt(set_set getP). + + qed. + + local lemma eager_ICORE_e_f : eager[ ICORE_eager.ewhile();, ICORE_eager.f ~ ICORE_e.f, ICORE_eager.ewhile(); : @@ -304,111 +524,83 @@ local module ICORE_eager : Low.FUNCTIONALITY = { by sp;seq 1 : ( (valid p /\ 0 < n));1:while( (valid p /\ 0 < n));auto;sp;if;auto. conseq(: ={p, n, glob ICORE_eager, i, r} ==> ={p, n, glob ICORE_eager, i, r});progress. - eager while(J : ICORE_eager.ewhile(); ~ ICORE_eager.ewhile(); : - ={p, n, glob ICORE_eager, i, r} ==> ={p, n, glob ICORE_eager, i, r});progress;1,3:sim. + + eager while(J : + ICORE_eager.ewhile(); ~ + ICORE_eager.ewhile(); : + ={p, n, glob ICORE_eager, i, r} ==> + ={p, n, glob ICORE_eager, i, r}); + progress;1,3:sim. swap{2}-1;wp 3 3. swap{2}-1;sim. conseq(:_==> ={p, n, b, glob ICORE_eager});progress. - inline{1}2;inline{2}1. - (* TODO : a lot of eager while to prepare. *) - - replace{2} { while;_ as loop1; (while;_ as loop2); eage } by { - loop1; - eage; - loop2; - } - (={i,r,p,n,glob ICORE_eager} /\ i{2} = 1 /\ r{2} = [] /\ valid p{2} - /\ 0 < n{2} ==> ={r, ICORE_eager.dist_res, ICORE_eager.order, ICORE.m}) - (={i,r,p,n,glob ICORE_eager} /\ i{2} = 1 /\ r{2} = [] /\ valid p{2} - /\ 0 < n{2} ==> ={r, ICORE_eager.dist_res, ICORE_eager.order, ICORE.m}); - progress;1:rewrite/#. - + sim. - conseq(: ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i} - ==> ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i}); - progress. - eager while(J: ICORE_eager.ewhile(); ~ ICORE_eager.ewhile(); : - ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i} ==> - ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i}); - progress;1,3:sim. - swap{2}-1;sim. - inline*. - splitwhile{2}4:world <> [(take i p)]. - sp. swap{1}-4;sp. - seq 1 1: ( ={glob ICORE_eager,n,p,r,i} /\ i{1} < size p{1} - /\ world{2} = [(take i{2} p{2})] - /\ world{1} = [] - /\ world{2} = rcons world{1} (take i{2} p{2}));last first. - + rcondt{2}1;1:auto=>/#. - by rcondf{2}6;auto;sp;if;auto. - while(={glob ICORE_eager,n,p,r,i} /\ i{1} < size p{1} - /\ world{2} = rcons world{1} (take i{2} p{2}));last auto=>/#. - by sp;if;auto;smt(head_behead). - swap{1}3 -1;seq 2 2 :(={glob ICORE_eager,n,p,r,i});1:sim. - eager while(J: ICORE_eager.ewhile(); ~ ICORE_eager.ewhile(); : - ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i} ==> - ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i}); - progress;1,3:sim. - inline ICORE_eager.ewhile. - swap{2}[4..6]-2;sim;swap{2}2;sp. - symmetry;conseq(: ={world,ICORE.m,p,i} ==> ={world,ICORE.m,p,i,b});progress. - replace{1} { all } by { b <- b0; all; } - (={world,ICORE.m,p,i} ==> ={world,ICORE.m,p,i,b}) - (={world,ICORE.m,p,i} ==> ={world,ICORE.m,p,i,b});progress;1:rewrite/#;1:sim. - replace{2} { all } by { b <- b0; all; } - (={world,ICORE.m,p,i} ==> ={world,ICORE.m,p,i,b}) - (={world,ICORE.m,p,i} ==> ={world,ICORE.m,p,i,b});progress;1:rewrite/#;2:sim. - sp;conseq(: ={world,ICORE.m,p,i,b} ==> ={world,ICORE.m,p,i,b});progress. - eager while(J: b <@ ICORE.fill_in(p,i); ~ b <@ ICORE.fill_in(p,i); : - ={world, p, ICORE.m, i, b} ==> ={world, p, ICORE.m, i, b}); - progress;1,3:sim. - inline*;sp;wp. - swap{1}[3..5]-2;swap{2}[3..4]-2;sp. - case(((p0,n0)=(p1,n1)){1})=>//=. - - if;auto;1:rcondf{1}3;1:auto;1:smt(dom_set in_fsetU1). - + by rcondf{2}3;auto;smt(dom_set in_fsetU1). - by sp;if;auto. - if{2};last first;2:rcondt{1}3;1:rcondf{1}3;progress. - + if;auto;smt(dom_set in_fsetU1). - + sp;if;auto;smt(dom_set in_fsetU1). - + sp;if;auto;smt(dom_set in_fsetU1). - if{1};last first;2:rcondt{2}3;1:rcondf{2}3;progress. - + auto;smt(dom_set in_fsetU1). - + auto;smt(dom_set getP in_fsetU1). - + auto;smt(dom_set in_fsetU1). - swap{2}-1;wp;conseq(:_==> ={ICORE.m} /\ b{1} = oget ICORE.m{2}.[(p1{2}, n1{2})]);progress. - alias{1} 1 c = b0. - transitivity{1} { - b <$ bdistr; - c <$ bdistr; - ICORE.m.[(p0, n0)] <- b; - ICORE.m.[(p1, n1)] <- c; - } - (={ICORE.m,p0,n0,p1,n1} /\ ! (p0{1} = p1{1} && n0{1} = n1{1}) ==> - ={ICORE.m} /\ b{1} = oget ICORE.m{2}.[(p0{2}, n0{2})]) - (={ICORE.m} /\ (p0,n0,p1,n1){1} = (p1,n1,p0,n0){2} - /\ ! (p0{1} = p1{1} && n0{1} = n1{1}) ==> - ={ICORE.m} /\ (p0,n0,p1,n1){1} = (p1,n1,p0,n0){2}); - progress;1:rewrite/#. - + swap{2}3-1;wp;rnd=>/=. - wp 2 2;conseq(:_==> ={ICORE.m});1:smt(getP). - by wp;rnd;auto. - transitivity{1} { - b <$ bdistr; - c <$ bdistr; - ICORE.m.[(p1, n1)] <- b; - ICORE.m.[(p0, n0)] <- c; - } - (={ICORE.m,p0,n0,p1,n1} /\ ! (p0{1} = p1{1} && n0{1} = n1{1}) ==> - ={ICORE.m,p0,p1,n0,n1}) - (={ICORE.m} /\ (p0,n0,p1,n1){1} = (p1,n1,p0,n0){2} - /\ ! (p0{1} = p1{1} && n0{1} = n1{1}) ==> - ={ICORE.m} /\ (p0,n0,p1,n1){1} = (p1,n1,p0,n0){2}); - progress;1:rewrite/#. - + swap{1}1;wp;conseq(:_==> (b,c){1} = (c,b){2});progress;2:(rnd;rnd;auto). - by rewrite set_set H0. - by swap{1}3-1;wp;rnd;wp;rnd;auto. + inline{2}1. + swap{2}3 1;swap{2}-1. + replace{2} { (<@ as fill_in);(<@ as ewhile) } by { + ewhile; + fill_in; + } + (={i, r, p, n, glob ICORE_eager} ==> ={b, p, n, glob ICORE_eager}) + (={i, r, p, n, glob ICORE_eager} ==> ={b, p, n, glob ICORE_eager}); + progress;1:rewrite/#;last first. + + sim;conseq(:_==> ={ICORE_eager.order, ICORE.m,c});progress. + seq 3 3:(={p0,n0,ICORE_eager.order, ICORE.m});1:sim. + by eager call(eager_ICORE_fill_in);auto. + inline{1}2;sim;swap{1}-1;sim. + + inline{2}4. + splitwhile{2}7: 1 < size world. + rcondt{2}8;progress. + + sp;while(last (head [] (behead world)) world = format p i /\ 1 <= size world); + auto;last smt(last_rcons size_rcons size_ge0 size_eq0). + inline*=>//=. + sp;seq 1 : (last (head [] (behead world)) (behead world) = format p i + /\ 1 <= size (behead world)). + + while(last (head [] (behead world)) (behead world) = format p i + /\ 1 <= size (behead world));auto. + + by sp;if;auto. + by progress;smt(head_behead). + sp;seq 1 : (last (head [] (behead world)) (behead world) = format p i + /\ 1 <= size (behead world)). + + while(last (head [] (behead world)) (behead world) = format p i + /\ 1 <= size (behead world));auto. + by sp;if;auto. + by auto;progress;smt(head_behead). + rcondf{2}15;progress. + + seq 8 : (world = [format p i]). + + wp;sp;while(last (head [] world) world = format p i /\ 1 <= size world); + auto;last first. + + smt(last_rcons size_rcons size_ge0 head_behead size_eq0). + inline*=>//=. + sp;seq 1 : (last (head [] world) (behead world) = format p i + /\ 1 <= size (behead world)). + + while(last (head [] world) (behead world) = format p i + /\ 1 <= size (behead world));auto. + + by sp;if;auto. + by progress;smt(head_behead). + sp;seq 1 : (last (head [] world) (behead world) = format p i + /\ 1 <= size (behead world)). + + while(last (head [] world) (behead world) = format p i + /\ 1 <= size (behead world));auto. + by sp;if;auto. + by auto;progress;smt(head_behead). + inline*=>/=. + sp;seq 1:(world = [format p i]);1:while(world = [format p i]);1:(sp;if);auto. + by sp;seq 1:(world = [format p i]);1:while(world = [format p i]);1:(sp;if);auto. + + swap{1}-3;sim. + inline*;sim;swap{1}[5..8]-1;wp;sp=>/=. + conseq(:_==> ={ICORE.m,ICORE_eager.order} + /\ world{1} = [] /\ world{2} = [format p{2} i{2}]); + 1:smt(parseK). + + while(={ICORE.m} /\ world{2} = rcons world{1} (format p{2} i{2})); + auto;last smt(size_eq0 size_rcons size_ge0). + rewrite/=. + sp;conseq(:_==> ={ICORE.m}); + 1:smt(head_behead size_eq0 size_rcons size_ge0);sim. + smt(head_behead). qed. - eager proc. local lemma eager_ICORE &m : Pr[Low.Indif(ICORE, S(ICORE), LoDist(D)).main() @ &m : res] = @@ -422,33 +614,15 @@ local module ICORE_eager : Low.FUNCTIONALITY = { + proc(={glob ICORE});auto;proc. sp;if;auto;sp;inline*. while(={ICORE.m,r,i,p,n} /\ valid p{1} /\ 0 < n{1} /\ 0 < i{1})=>//=;1:auto. - swap{2}[7..8]-3;sp. - conseq(:_==> ={ICORE.m,r,p,n});1:smt(parseK). - sim. - conseq(:_==> ={ICORE.m,r,p,n});1:smt(parseK). - while{2}(={n, p, r, ICORE.m})(n0{2} - i0{2} + 1);1:auto;1:progress=>/#. - conseq(:_==> ={n, p, r, ICORE.m});1:progress=>/#. - wp;while{2}(={n, p, r, ICORE.m})(size p0{2} - i0{2});auto=>/#. + sp;if;auto;smt(parseK). + proc(={glob ICORE});auto;proc. sp;if;auto;sp;inline*. while(={ICORE.m,r,i,p,n} /\ valid p{1} /\ 0 < n{1} /\ 0 < i{1})=>//=;1:auto. - swap{2}[7..8]-3;sp. - conseq(:_==> ={ICORE.m,r,p,n});1:smt(parseK). - sim. - conseq(:_==> ={ICORE.m,r,p,n});1:smt(parseK). - while{2}(={n, p, r, ICORE.m})(n0{2} - i0{2} + 1);1:auto;1:progress=>/#. - conseq(:_==> ={n, p, r, ICORE.m});1:progress=>/#. - wp;while{2}(={n, p, r, ICORE.m})(size p0{2} - i0{2});auto=>/#. + sp;if;auto;smt(parseK). + proc;inline*;sp;if;auto;1:progress=>/#;sp. sp;if;1:auto=>/#;sp;inline*. while(={ICORE.m,r0,i,p0,n0} /\ valid p0{1} /\ 0 < n0{1} /\ 0 < i{1})=>//=;1:auto. - swap{2}[7..8]-3;sp. - conseq(:_==> ={ICORE.m,r0,p0,n0});1:smt(parseK). - sim. - conseq(:_==> ={ICORE.m,r0,p0,n0});1:smt(parseK). - while{2}(={n0, p0, r0, ICORE.m})(n1{2} - i0{2} + 1);1:auto;1:progress=>/#. - conseq(:_==> ={n0, p0, r0, ICORE.m});1:progress=>/#. - by wp;while{2}(={n0, p0, r0, ICORE.m})(size p1{2} - i0{2});auto=>/#. + sp;if;auto;smt(parseK). + by auto=>/#. + by auto=>/#. by inline*;auto;call(:true);auto. @@ -469,9 +643,12 @@ local module ICORE_eager : Low.FUNCTIONALITY = { + by proc(={glob ICORE_e});auto;proc;sim. + by proc;sim. by call(:true);auto. - by sp;while{2}(={b})(size world{2});auto;1:(sp;if);auto; - smt(bdistr_ll head_behead size_eq0 size_ge0). - + sp;while{2}(={b})(size world{2});auto;2:smt(size_eq0 size_ge0). + while(b = b{m0} /\ size (behead world) < z)(n+1-i); + first progress;sp;if;auto;smt(bdistr_ll head_behead size_eq0 size_ge0). + wp;while(b = b{m0} /\ size (behead world) < z)(size p-i); + first progress;sp;if;auto;smt(bdistr_ll head_behead size_eq0 size_ge0). + auto;smt(head_behead). replace{2} { all; <@ } by { all; @@ -480,9 +657,8 @@ local module ICORE_eager : Low.FUNCTIONALITY = { b <- ICORE_eager.dist_res; } (={glob D, glob S} ==> ={b}) - (={glob D, glob S} ==> ={b});progress;last first. - + by inline*;rcondf{1}7;auto;2:sim;call(:true);auto. - + by rewrite/#. + (={glob D, glob S} ==> ={b});progress;1:rewrite/#;last first. + + by inline*;rcondf{1}8;auto;2:sim;call(:true);auto. swap{1}-1;sim. @@ -494,328 +670,65 @@ local module ICORE_eager : Low.FUNCTIONALITY = { ={glob S, glob ICORE_eager} ==> ={glob S, glob ICORE_eager}) (={glob S, glob ICORE_eager});auto;progress;1,3,5,7:sim. - + eager proc(H': ICORE_eager.ewhile(); ~ ICORE_eager.ewhile(); : + +eager proc(H': ICORE_eager.ewhile(); ~ ICORE_eager.ewhile(); : ={glob ICORE_eager} ==> ={glob ICORE_eager}) (={glob ICORE_eager});auto;progress;1,3:sim. - + (* eager : ewhile; ICORE_eager.f ~ ICORE_e.f ; ewhile *) eager proc. - swap{1}2;swap{2}-1;sp;wp. - if{2};1:rcondt{1}2;last first;1:rcondf{1}2;progress;2:sim. - + inline*;sp;while(! (valid p /\ 0 < n));auto;sp;if;auto. - + inline*;sp;while(valid p /\ 0 < n);auto;sp;if;auto. - replace{2} { while as loop1; (<-;while as loop2); eage } by { - loop1; - eage; - loop2; - } - (={i,r,p,n,glob ICORE_eager} /\ i{2} = 1 /\ r{2} = [] /\ valid p{2} - /\ 0 < n{2} ==> ={r, ICORE_eager.dist_res, ICORE_eager.order, ICORE.m}) - (={i,r,p,n,glob ICORE_eager} /\ i{2} = 1 /\ r{2} = [] /\ valid p{2} - /\ 0 < n{2} ==> ={r, ICORE_eager.dist_res, ICORE_eager.order, ICORE.m}); - progress;1:rewrite/#. - + sim. - conseq(: ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i} - ==> ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i}); - progress. - eager while(J: ICORE_eager.ewhile(); ~ ICORE_eager.ewhile(); : - ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i} ==> - ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i}); - progress;1,3:sim. - swap{2}-1;sim. - inline*. - splitwhile{2}4:world <> [(take i p)]. - sp. swap{1}-4;sp. - seq 1 1: ( ={glob ICORE_eager,n,p,r,i} /\ i{1} < size p{1} - /\ world{2} = [(take i{2} p{2})] - /\ world{1} = [] - /\ world{2} = rcons world{1} (take i{2} p{2}));last first. - + rcondt{2}1;1:auto=>/#. - by rcondf{2}6;auto;sp;if;auto. - while(={glob ICORE_eager,n,p,r,i} /\ i{1} < size p{1} - /\ world{2} = rcons world{1} (take i{2} p{2}));last auto=>/#. - by sp;if;auto;smt(head_behead). - swap{1}3 -1;seq 2 2 :(={glob ICORE_eager,n,p,r,i});1:sim. - eager while(J: ICORE_eager.ewhile(); ~ ICORE_eager.ewhile(); : - ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i} ==> - ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i}); - progress;1,3:sim. - inline ICORE_eager.ewhile. - swap{2}[4..6]-2;sim;swap{2}2;sp. - symmetry;conseq(: ={world,ICORE.m,p,i} ==> ={world,ICORE.m,p,i,b});progress. - replace{1} { all } by { b <- b0; all; } - (={world,ICORE.m,p,i} ==> ={world,ICORE.m,p,i,b}) - (={world,ICORE.m,p,i} ==> ={world,ICORE.m,p,i,b});progress;1:rewrite/#;1:sim. - replace{2} { all } by { b <- b0; all; } - (={world,ICORE.m,p,i} ==> ={world,ICORE.m,p,i,b}) - (={world,ICORE.m,p,i} ==> ={world,ICORE.m,p,i,b});progress;1:rewrite/#;2:sim. - sp;conseq(: ={world,ICORE.m,p,i,b} ==> ={world,ICORE.m,p,i,b});progress. - eager while(J: b <@ ICORE.fill_in(p,i); ~ b <@ ICORE.fill_in(p,i); : - ={world, p, ICORE.m, i, b} ==> ={world, p, ICORE.m, i, b}); - progress;1,3:sim. - inline*;sp;wp. - swap{1}[3..5]-2;swap{2}[3..4]-2;sp. - case(((p0,n0)=(p1,n1)){1})=>//=. - - if;auto;1:rcondf{1}3;1:auto;1:smt(dom_set in_fsetU1). - + by rcondf{2}3;auto;smt(dom_set in_fsetU1). - by sp;if;auto. - if{2};last first;2:rcondt{1}3;1:rcondf{1}3;progress. - + if;auto;smt(dom_set in_fsetU1). - + sp;if;auto;smt(dom_set in_fsetU1). - + sp;if;auto;smt(dom_set in_fsetU1). - if{1};last first;2:rcondt{2}3;1:rcondf{2}3;progress. - + auto;smt(dom_set in_fsetU1). - + auto;smt(dom_set getP in_fsetU1). - + auto;smt(dom_set in_fsetU1). - swap{2}-1;wp;conseq(:_==> ={ICORE.m} /\ b{1} = oget ICORE.m{2}.[(p1{2}, n1{2})]);progress. - alias{1} 1 c = b0. - transitivity{1} { - b <$ bdistr; - c <$ bdistr; - ICORE.m.[(p0, n0)] <- b; - ICORE.m.[(p1, n1)] <- c; + replace{1} { <@ as ewhile; rest } by { + ewhile; + result <@ ICORE_eager.f(p,n); } - (={ICORE.m,p0,n0,p1,n1} /\ ! (p0{1} = p1{1} && n0{1} = n1{1}) ==> - ={ICORE.m} /\ b{1} = oget ICORE.m{2}.[(p0{2}, n0{2})]) - (={ICORE.m} /\ (p0,n0,p1,n1){1} = (p1,n1,p0,n0){2} - /\ ! (p0{1} = p1{1} && n0{1} = n1{1}) ==> - ={ICORE.m} /\ (p0,n0,p1,n1){1} = (p1,n1,p0,n0){2}); - progress;1:rewrite/#. - + swap{2}3-1;wp;rnd=>/=. - wp 2 2;conseq(:_==> ={ICORE.m});1:smt(getP). - by wp;rnd;auto. - transitivity{1} { - b <$ bdistr; - c <$ bdistr; - ICORE.m.[(p1, n1)] <- b; - ICORE.m.[(p0, n0)] <- c; + (={p,n,glob ICORE_eager} ==> ={result,glob ICORE_eager}) + (={p,n,glob ICORE_eager} ==> ={result,glob ICORE_eager}); + progress;1:rewrite/#;1:(inline*;sim). + replace{2} { rest; (<@ as ewhile) } by { + result <@ ICORE_e.f(p,n); + ewhile; } - (={ICORE.m,p0,n0,p1,n1} /\ ! (p0{1} = p1{1} && n0{1} = n1{1}) ==> - ={ICORE.m,p0,p1,n0,n1}) - (={ICORE.m} /\ (p0,n0,p1,n1){1} = (p1,n1,p0,n0){2} - /\ ! (p0{1} = p1{1} && n0{1} = n1{1}) ==> - ={ICORE.m} /\ (p0,n0,p1,n1){1} = (p1,n1,p0,n0){2}); - progress;1:rewrite/#. - + swap{1}1;wp;conseq(:_==> (b,c){1} = (c,b){2});progress;2:(rnd;rnd;auto). - by rewrite set_set H0. - by swap{1}3-1;wp;rnd;wp;rnd;auto. - - + eager proc(H': ICORE_eager.ewhile(); ~ ICORE_eager.ewhile(); : + (={p,n,glob ICORE_eager} ==> ={result,glob ICORE_eager}) + (={p,n,glob ICORE_eager} ==> ={result,glob ICORE_eager}); + progress;1:rewrite/#;2:(inline*;sim). + + by eager call(eager_ICORE_e_f);auto. + + + +eager proc(H': ICORE_eager.ewhile(); ~ ICORE_eager.ewhile(); : ={glob ICORE_eager} ==> ={glob ICORE_eager}) (={glob ICORE_eager});auto;progress;1,3:sim. + + (* eager : ewhile; ICORE_eager.f ~ ICORE_e.f ; ewhile *) eager proc. - swap{1}2;swap{2}-1;sp;wp. - if{2};1:rcondt{1}2;last first;1:rcondf{1}2;progress;2:sim. - + inline*;sp;while(! (valid p /\ 0 < n));auto;sp;if;auto. - + inline*;sp;while(valid p /\ 0 < n);auto;sp;if;auto. - replace{2} { while as loop1; (<-;while as loop2); eage } by { - loop1; - eage; - loop2; + replace{1} { <@ as ewhile; rest } by { + ewhile; + result <@ ICORE_eager.f(p,n); } - (={i,r,p,n,glob ICORE_eager} /\ i{2} = 1 /\ r{2} = [] /\ valid p{2} - /\ 0 < n{2} ==> ={r, ICORE_eager.dist_res, ICORE_eager.order, ICORE.m}) - (={i,r,p,n,glob ICORE_eager} /\ i{2} = 1 /\ r{2} = [] /\ valid p{2} - /\ 0 < n{2} ==> ={r, ICORE_eager.dist_res, ICORE_eager.order, ICORE.m}); - progress;1:rewrite/#. - + sim. - conseq(: ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i} - ==> ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i}); - progress. - eager while(J: ICORE_eager.ewhile(); ~ ICORE_eager.ewhile(); : - ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i} ==> - ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i}); - progress;1,3:sim. - swap{2}-1;sim. - inline*. - splitwhile{2}4:world <> [(take i p)]. - sp. swap{1}-4;sp. - seq 1 1: ( ={glob ICORE_eager,n,p,r,i} /\ i{1} < size p{1} - /\ world{2} = [(take i{2} p{2})] - /\ world{1} = [] - /\ world{2} = rcons world{1} (take i{2} p{2}));last first. - + rcondt{2}1;1:auto=>/#. - by rcondf{2}6;auto;sp;if;auto. - while(={glob ICORE_eager,n,p,r,i} /\ i{1} < size p{1} - /\ world{2} = rcons world{1} (take i{2} p{2}));last auto=>/#. - by sp;if;auto;smt(head_behead). - swap{1}3 -1;seq 2 2 :(={glob ICORE_eager,n,p,r,i});1:sim. - eager while(J: ICORE_eager.ewhile(); ~ ICORE_eager.ewhile(); : - ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i} ==> - ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i}); - progress;1,3:sim. - inline ICORE_eager.ewhile. - swap{2}[4..6]-2;sim;swap{2}2;sp. - symmetry;conseq(: ={world,ICORE.m,p,i} ==> ={world,ICORE.m,p,i,b});progress. - replace{1} { all } by { b <- b0; all; } - (={world,ICORE.m,p,i} ==> ={world,ICORE.m,p,i,b}) - (={world,ICORE.m,p,i} ==> ={world,ICORE.m,p,i,b});progress;1:rewrite/#;1:sim. - replace{2} { all } by { b <- b0; all; } - (={world,ICORE.m,p,i} ==> ={world,ICORE.m,p,i,b}) - (={world,ICORE.m,p,i} ==> ={world,ICORE.m,p,i,b});progress;1:rewrite/#;2:sim. - sp;conseq(: ={world,ICORE.m,p,i,b} ==> ={world,ICORE.m,p,i,b});progress. - eager while(J: b <@ ICORE.fill_in(p,i); ~ b <@ ICORE.fill_in(p,i); : - ={world, p, ICORE.m, i, b} ==> ={world, p, ICORE.m, i, b}); - progress;1,3:sim. - inline*;sp;wp. - swap{1}[3..5]-2;swap{2}[3..4]-2;sp. - case(((p0,n0)=(p1,n1)){1})=>//=. - - if;auto;1:rcondf{1}3;1:auto;1:smt(dom_set in_fsetU1). - + by rcondf{2}3;auto;smt(dom_set in_fsetU1). - by sp;if;auto. - if{2};last first;2:rcondt{1}3;1:rcondf{1}3;progress. - + if;auto;smt(dom_set in_fsetU1). - + sp;if;auto;smt(dom_set in_fsetU1). - + sp;if;auto;smt(dom_set in_fsetU1). - if{1};last first;2:rcondt{2}3;1:rcondf{2}3;progress. - + auto;smt(dom_set in_fsetU1). - + auto;smt(dom_set getP in_fsetU1). - + auto;smt(dom_set in_fsetU1). - swap{2}-1;wp;conseq(:_==> ={ICORE.m} /\ b{1} = oget ICORE.m{2}.[(p1{2}, n1{2})]);progress. - alias{1} 1 c = b0. - transitivity{1} { - b <$ bdistr; - c <$ bdistr; - ICORE.m.[(p0, n0)] <- b; - ICORE.m.[(p1, n1)] <- c; + (={p,n,glob ICORE_eager} ==> ={result,glob ICORE_eager}) + (={p,n,glob ICORE_eager} ==> ={result,glob ICORE_eager}); + progress;1:rewrite/#;1:(inline*;sim). + replace{2} { rest; (<@ as ewhile) } by { + result <@ ICORE_e.f(p,n); + ewhile; } - (={ICORE.m,p0,n0,p1,n1} /\ ! (p0{1} = p1{1} && n0{1} = n1{1}) ==> - ={ICORE.m} /\ b{1} = oget ICORE.m{2}.[(p0{2}, n0{2})]) - (={ICORE.m} /\ (p0,n0,p1,n1){1} = (p1,n1,p0,n0){2} - /\ ! (p0{1} = p1{1} && n0{1} = n1{1}) ==> - ={ICORE.m} /\ (p0,n0,p1,n1){1} = (p1,n1,p0,n0){2}); - progress;1:rewrite/#. - + swap{2}3-1;wp;rnd=>/=. - wp 2 2;conseq(:_==> ={ICORE.m});1:smt(getP). - by wp;rnd;auto. - transitivity{1} { - b <$ bdistr; - c <$ bdistr; - ICORE.m.[(p1, n1)] <- b; - ICORE.m.[(p0, n0)] <- c; - } - (={ICORE.m,p0,n0,p1,n1} /\ ! (p0{1} = p1{1} && n0{1} = n1{1}) ==> - ={ICORE.m,p0,p1,n0,n1}) - (={ICORE.m} /\ (p0,n0,p1,n1){1} = (p1,n1,p0,n0){2} - /\ ! (p0{1} = p1{1} && n0{1} = n1{1}) ==> - ={ICORE.m} /\ (p0,n0,p1,n1){1} = (p1,n1,p0,n0){2}); - progress;1:rewrite/#. - + swap{1}1;wp;conseq(:_==> (b,c){1} = (c,b){2});progress;2:(rnd;rnd;auto). - by rewrite set_set H0. - by swap{1}3-1;wp;rnd;wp;rnd;auto. + (={p,n,glob ICORE_eager} ==> ={result,glob ICORE_eager}) + (={p,n,glob ICORE_eager} ==> ={result,glob ICORE_eager}); + progress;1:rewrite/#;2:(inline*;sim). + + by eager call(eager_ICORE_e_f);auto. eager proc. swap{1}3;sp;swap{2}-1;sim. if{2};last first;2:rcondt{1}2;1:rcondf{1}2;progress;2:sim. - + by inline*;sp;while(! (valid x /\ 0 < n));auto;1:(sp;if);auto=>/#. - + by inline*;sp;while( valid x /\ 0 < n );auto;1:(sp;if);auto=>/#. + + inline*;sp;while(! (valid x /\ 0 < n));auto;2:rewrite/#. + while(! (valid x /\ 0 < n));1:(sp;if);auto. + while(! (valid x /\ 0 < n));1:(sp;if);auto. + + inline*;sp;while( (valid x /\ 0 < n));auto;2:rewrite/#. + while( (valid x /\ 0 < n));1:(sp;if);auto. + while( (valid x /\ 0 < n));1:(sp;if);auto. swap{2}-1;sim. - eager call(: ={p, n, ICORE_eager.dist_res, ICORE_eager.order, ICORE.m} - ==> ={res, ICORE_eager.dist_res, ICORE_eager.order, ICORE.m}). - - (* eager : ewhile; ICORE_eager.f ~ ICORE_e.f ; ewhile *) - eager proc. - swap{1}2;swap{2}-1;sp;wp. - if{2};1:rcondt{1}2;last first;1:rcondf{1}2;progress;2:sim. - + inline*;sp;while(! (valid p /\ 0 < n));auto;sp;if;auto. - + inline*;sp;while(valid p /\ 0 < n);auto;sp;if;auto. - replace{2} { while as loop1; (<-;while as loop2); eage } by { - loop1; - eage; - loop2; - } - (={i,r,p,n,glob ICORE_eager} /\ i{2} = 1 /\ r{2} = [] /\ valid p{2} - /\ 0 < n{2} ==> ={r, ICORE_eager.dist_res, ICORE_eager.order, ICORE.m}) - (={i,r,p,n,glob ICORE_eager} /\ i{2} = 1 /\ r{2} = [] /\ valid p{2} - /\ 0 < n{2} ==> ={r, ICORE_eager.dist_res, ICORE_eager.order, ICORE.m}); - progress;1:rewrite/#. - + sim. - conseq(: ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i} - ==> ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i}); - progress. - eager while(J: ICORE_eager.ewhile(); ~ ICORE_eager.ewhile(); : - ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i} ==> - ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i}); - progress;1,3:sim. - swap{2}-1;sim. - inline*. - splitwhile{2}4:world <> [(take i p)]. - sp. swap{1}-4;sp. - seq 1 1: ( ={glob ICORE_eager,n,p,r,i} /\ i{1} < size p{1} - /\ world{2} = [(take i{2} p{2})] - /\ world{1} = [] - /\ world{2} = rcons world{1} (take i{2} p{2}));last first. - + rcondt{2}1;1:auto=>/#. - by rcondf{2}6;auto;sp;if;auto. - while(={glob ICORE_eager,n,p,r,i} /\ i{1} < size p{1} - /\ world{2} = rcons world{1} (take i{2} p{2}));last auto=>/#. - by sp;if;auto;smt(head_behead). - swap{1}3 -1;seq 2 2 :(={glob ICORE_eager,n,p,r,i});1:sim. - eager while(J: ICORE_eager.ewhile(); ~ ICORE_eager.ewhile(); : - ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i} ==> - ={ICORE_eager.dist_res, ICORE_eager.order, n, p, r, ICORE.m, i}); - progress;1,3:sim. - inline ICORE_eager.ewhile. - swap{2}[4..6]-2;sim;swap{2}2;sp. - symmetry;conseq(: ={world,ICORE.m,p,i} ==> ={world,ICORE.m,p,i,b});progress. - replace{1} { all } by { b <- b0; all; } - (={world,ICORE.m,p,i} ==> ={world,ICORE.m,p,i,b}) - (={world,ICORE.m,p,i} ==> ={world,ICORE.m,p,i,b});progress;1:rewrite/#;1:sim. - replace{2} { all } by { b <- b0; all; } - (={world,ICORE.m,p,i} ==> ={world,ICORE.m,p,i,b}) - (={world,ICORE.m,p,i} ==> ={world,ICORE.m,p,i,b});progress;1:rewrite/#;2:sim. - sp;conseq(: ={world,ICORE.m,p,i,b} ==> ={world,ICORE.m,p,i,b});progress. - eager while(J: b <@ ICORE.fill_in(p,i); ~ b <@ ICORE.fill_in(p,i); : - ={world, p, ICORE.m, i, b} ==> ={world, p, ICORE.m, i, b}); - progress;1,3:sim. - inline*;sp;wp. - swap{1}[3..5]-2;swap{2}[3..4]-2;sp. - case(((p0,n0)=(p1,n1)){1})=>//=. - - if;auto;1:rcondf{1}3;1:auto;1:smt(dom_set in_fsetU1). - + by rcondf{2}3;auto;smt(dom_set in_fsetU1). - by sp;if;auto. - if{2};last first;2:rcondt{1}3;1:rcondf{1}3;progress. - + if;auto;smt(dom_set in_fsetU1). - + sp;if;auto;smt(dom_set in_fsetU1). - + sp;if;auto;smt(dom_set in_fsetU1). - if{1};last first;2:rcondt{2}3;1:rcondf{2}3;progress. - + auto;smt(dom_set in_fsetU1). - + auto;smt(dom_set getP in_fsetU1). - + auto;smt(dom_set in_fsetU1). - swap{2}-1;wp;conseq(:_==> ={ICORE.m} /\ b{1} = oget ICORE.m{2}.[(p1{2}, n1{2})]);progress. - alias{1} 1 c = b0. - transitivity{1} { - b <$ bdistr; - c <$ bdistr; - ICORE.m.[(p0, n0)] <- b; - ICORE.m.[(p1, n1)] <- c; - } - (={ICORE.m,p0,n0,p1,n1} /\ ! (p0{1} = p1{1} && n0{1} = n1{1}) ==> - ={ICORE.m} /\ b{1} = oget ICORE.m{2}.[(p0{2}, n0{2})]) - (={ICORE.m} /\ (p0,n0,p1,n1){1} = (p1,n1,p0,n0){2} - /\ ! (p0{1} = p1{1} && n0{1} = n1{1}) ==> - ={ICORE.m} /\ (p0,n0,p1,n1){1} = (p1,n1,p0,n0){2}); - progress;1:rewrite/#. - + swap{2}3-1;wp;rnd=>/=. - wp 2 2;conseq(:_==> ={ICORE.m});1:smt(getP). - by wp;rnd;auto. - transitivity{1} { - b <$ bdistr; - c <$ bdistr; - ICORE.m.[(p1, n1)] <- b; - ICORE.m.[(p0, n0)] <- c; - } - (={ICORE.m,p0,n0,p1,n1} /\ ! (p0{1} = p1{1} && n0{1} = n1{1}) ==> - ={ICORE.m,p0,p1,n0,n1}) - (={ICORE.m} /\ (p0,n0,p1,n1){1} = (p1,n1,p0,n0){2} - /\ ! (p0{1} = p1{1} && n0{1} = n1{1}) ==> - ={ICORE.m} /\ (p0,n0,p1,n1){1} = (p1,n1,p0,n0){2}); - progress;1:rewrite/#. - + swap{1}1;wp;conseq(:_==> (b,c){1} = (c,b){2});progress;2:(rnd;rnd;auto). - by rewrite set_set H0. - by swap{1}3-1;wp;rnd;wp;rnd;auto. - - by auto;progress=>/#. + eager call(eager_ICORE_e_f). + auto=>/#. qed. lemma LiftInd &m: @@ -875,11 +788,11 @@ local module ICORE_eager : Low.FUNCTIONALITY = { cut->/=:i{1} - 1 < n{2} - 1 by rewrite/#. by rewrite BlockMonoid.addr0. - by inline*;auto;call(:true);auto. print HiSim. print ICORE. + by inline*;auto;call(:true);auto. (* TODO : Introduce an equivalent module to ICORE whose fill_in procedure makes the same calls as IBlockSponge *) - (* rewrite (eager_ICORE &m). *) + rewrite (eager_ICORE &m). byequiv (_: ={glob D, glob S} ==> _)=> //=; proc. call (_: ={glob S} /\ INV IBlockSponge.m{2} ICORE.m{1}). @@ -894,8 +807,37 @@ local module ICORE_eager : Low.FUNCTIONALITY = { /\ valid p{1} /\ 0 < n{1});last auto=>/#. rcondt{2}6;auto;progress. + by cut:=parseK p{hr} (i{hr}+1) H0 H1;rewrite/format-addzA/==>->/=. - + by cut:=parseK p{hr} (i{hr}+1) H0 H1;rewrite/format-addzA/==>->/=. + + by cut:=parseK p{hr} (i{hr}+1) H0 H1;rewrite/format-addzA/==>->/=. sp. + conseq(:_==> (INV IBlockSponge.m{2} ICORE.m{1} /\ + rcons r{1} (oget ICORE.m{1}.[(p3{1}, n3{1})]) = + rcons r{2} (oget IBlockSponge.m{2}.[x1{2}])));1:progress=>/#. + seq 3 1:(x{2} = format p0{1} n0{1} /\ INV IBlockSponge.m{2} ICORE.m{1} + /\ valid p0{1} /\ 0 < n0{1} /\ ={r});last first. + sp;if;auto;smt(in_dom parseK getP formatK). + + splitwhile{2}1:i0 < size p. + conseq(:_==> INV IBlockSponge.m{2} ICORE.m{1});1:smt(parseK). + while(INV IBlockSponge.m{2} ICORE.m{1} + /\ valid p0{1} + /\ 0 < i0{1} + /\ 0 < n0{1} + /\ i0{1} = i0{2} - size p0{1} + 1 + /\ format p0{1} i0{1} = take i0{2} x{2} + /\ x{2} = format p0{1} n0{1});auto. + + sp;if;auto;smt(parseK formatK in_dom getP take_cat size_cat + size_nseq take_nseq). + conseq(:_==> INV IBlockSponge.m{2} ICORE.m{1} /\ + i0{2} = size p0{1});1:smt(parseK formatK take_cat nseq0 cats0 take0 size_cat size_nseq). + while(={i0} /\ 0 < i0{1} <= size p0{1} /\ p0{1} = p{2} /\ + valid p0{1} /\ 0 < n0{1} /\ + x{2} = format p0{1} n0{1} /\ INV IBlockSponge.m{2} ICORE.m{1});auto. + + sp;if;auto;progress. move:H7;rewrite 2!in_dom take_cat H6/=H3. smt(in_dom take_cat nseq0 cats0). rewrite in_dom/=H3. +smt(in_dom take_cat parseK formatK). + + + + sp;sim. conseq(:_==> INV IBlockSponge.m{2} ICORE.m{1} /\ x1{2} = x{2} /\ );1:progress. rewrite/#. congr;congr;rewrite H6 -H;congr;congr;2:rewrite/#. From 144f90721e6063eaf22b0248b6be9fe0ec8997b3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Mon, 8 Jan 2018 17:02:39 +0100 Subject: [PATCH 251/525] updated existing proof to the last version of EasyCrypt and finish the proof in clean/BlockSponge.eca Now we need a trick for the counters. --- proof/clean/BlockSponge.eca | 877 ++++++------------------------------ proof/core/ConcreteF.eca | 37 +- proof/core/Gcol.eca | 8 +- proof/core/Gconcl.ec | 11 +- proof/core/Gext.eca | 22 +- proof/core/Handle.eca | 57 +-- proof/core/SLCommon.ec | 17 +- proof/core/Utils.ec | 3 +- 8 files changed, 218 insertions(+), 814 deletions(-) diff --git a/proof/clean/BlockSponge.eca b/proof/clean/BlockSponge.eca index 67e2782..80675ae 100644 --- a/proof/clean/BlockSponge.eca +++ b/proof/clean/BlockSponge.eca @@ -10,8 +10,6 @@ require import NewCommon. (** Validity of Functionality Queries **) op valid: block list -> bool. axiom valid_spec p: valid p => p <> []. -(* FIXME : verify if this axiom is correct. *) -axiom valid_take p i: valid p => 0 < i => valid (take i p). (** Validity and Parsing/Formatting of Functionality Queries **) op format (p : block list) (n : int) = p ++ nseq (n - 1) b0. @@ -93,34 +91,18 @@ module IBlockSponge : FUNCTIONALITY = { } proc f(x : block list) = { - var b,bs <- b0; - var i <- 1; + var bs <- b0; + var i <- 0; var (p,n) <- parse x; - if (valid p /\ 0 < n) { - while (i < size x) { - b <@ fill_in(take i x); + while (i < n) { + fill_in(take (size p + i) x); i <- i + 1; } bs <@ fill_in(x); } - (* bs <- []; *) - (* if (valid x /\ 0 < n) { *) - (* (* while (i < size x) { *) *) - (* (* b <@ fill_in(take i x,1); *) *) - (* (* i <- i + 1; *) *) - (* (* } *) *) - (* (* i <- 1; *) *) - (* b <@ fill_in(x, 1); *) - (* bs <- rcons bs b; *) - (* while (i < n) { *) - (* i <- i + 1; *) - (* b <@ fill_in(x, i); *) - (* bs <- rcons bs b; *) - (* } *) - (* } *) return bs; } }. @@ -187,549 +169,6 @@ section PROOF. declare module P : PRIMITIVE { Low.ICORE, IBlockSponge, HiSim }. declare module S : Low.SIMULATOR { Low.ICORE, IBlockSponge, HiSim, P }. declare module D : DISTINGUISHER { Low.ICORE, IBlockSponge, HiSim, P, S }. -print ICORE. - -local module ICORE_eager : Low.FUNCTIONALITY = { - var order : block list list - var dist_res : bool - - proc init() : unit = { - order <- []; - dist_res <- false; - ICORE.init(); - } - - proc fill_in (x : block list) = { - var i <- 1; - var c; - var (p,n) <- parse x; - - while (i < size p) { - ICORE.fill_in(parse(take i p)); - i <- i + 1; - } - i <- 1; - while (i < n) { - ICORE.fill_in(p, i); - i <- i + 1; - } - c <@ ICORE.fill_in(parse(format p n)); - order <- rcons order x; - return c; - } - - proc f(p : block list, n : int) : block list = { - var r : block list; - var i : int <- 1; - var b : block; - - r <- []; - if (valid p /\ 0 < n) { - while (i <= n) { - b <@ fill_in(format p i); - r <- rcons r b; - i <- i + 1; - } - } - return r; - } - proc ewhile() : unit = { - var world <- order; - var i <- 1; - var (p,n); - - var y <- []; - - while(world <> []) { - y <- head ([]) world; - i <- 1; - (p,n) <- parse y; - while (i < size p) { - ICORE.fill_in(parse(take i p)); - i <- i + 1; - } - i <- 1; - while (i < n) { - ICORE.fill_in(parse(format p i)); - i <- i + 1; - } - world <- behead world; - } - } - }. - - local module ICORE_e : Low.FUNCTIONALITY = { - proc init = ICORE_eager.init - - - proc fill_in (x : block list) = { - var c; - var (p,n) <- parse x; - - c <@ ICORE.fill_in(p,n); - ICORE_eager.order <- rcons ICORE_eager.order (x); - return c; - } - - - proc f(p : block list, n : int) : block list = { - var r : block list; - var i : int <- 1; - var b : block; - - r <- []; - if (valid p /\ 0 < n) { - while (i <= n) { - b <@ fill_in(format p i); - r <- rcons r b; - i <- i + 1; - } - } - return r; - } - }. - - local lemma eager_ICORE_fill_in : - eager[ ICORE_eager.ewhile();, ICORE.fill_in - ~ ICORE.fill_in, ICORE_eager.ewhile(); - : ={arg, ICORE_eager.order, ICORE.m} - ==> - ={res, ICORE_eager.order, ICORE.m}]. - proof. - eager proc. - inline ICORE_eager.ewhile;symmetry. - swap{1}[1..2]2. - replace{1} { all } by { - result <- b0; - all; - } - (={p,n,ICORE_eager.order,ICORE.m} - ==> ={result,ICORE_eager.order,ICORE.m}) - (={p,n,ICORE_eager.order,ICORE.m} - ==> ={result,ICORE_eager.order,ICORE.m}); - progress;1:rewrite/#;1:sim. - replace{2} { all } by { - result <- b0; - all; - } - (={p,n,ICORE_eager.order,ICORE.m} - ==> ={result,ICORE_eager.order,ICORE.m}) - (={p,n,ICORE_eager.order,ICORE.m} - ==> ={result,ICORE_eager.order,ICORE.m}); - progress;1:rewrite/#;2:sim. - sp;swap{1}3-2;sp. - conseq(: ={world, ICORE_eager.order, ICORE.m, p, n, result} - ==> ={world, ICORE_eager.order, ICORE.m, p, n, result});progress. - eager while(J: - if (!((p,n) \in dom ICORE.m)) { - ICORE.m.[(p,n)] <$ bdistr; - } - result <- oget ICORE.m.[(p, n)]; - ~ - if (!((p,n) \in dom ICORE.m)) { - ICORE.m.[(p,n)] <$ bdistr; - } - result <- oget ICORE.m.[(p, n)]; - : - ={world, ICORE_eager.order, ICORE.m, p, n, result} - ==> - ={world, ICORE_eager.order, ICORE.m, p, n, result});progress;1,3:sim. - swap{2}7 2;sim;swap{1}3-2;sp 1 1. - conseq(: ={y,p,n,ICORE.m,ICORE_eager.order} - ==> ={result,ICORE.m,ICORE_eager.order});progress. - - replace{1} { (if;<-); body } by { - result <@ ICORE.fill_in(p,n); - body; - } - (={y,p,n,ICORE.m,ICORE_eager.order} - ==> ={result,ICORE.m,ICORE_eager.order}) - (={y,p,n,ICORE.m,ICORE_eager.order} - ==> ={result,ICORE.m,ICORE_eager.order}); - progress;1:rewrite/#;1:(inline{2}1;sim). - replace{2} { body;(if;<-) } by { - body; - result <@ ICORE.fill_in(p,n); - } - (={y,p,n,ICORE.m,ICORE_eager.order} - ==> ={result,ICORE.m,ICORE_eager.order}) - (={y,p,n,ICORE.m,ICORE_eager.order} - ==> ={result,ICORE.m,ICORE_eager.order}); - progress;1:rewrite/#;2:(inline*;sim). - - replace{2} { begin; (while as loop); (<@ as result) } by { - begin; - result; - loop; - } - (={y,p,n,ICORE.m,ICORE_eager.order} - ==> ={n0,p0,result,ICORE.m,ICORE_eager.order}) - (={y,p,n,ICORE.m,ICORE_eager.order} - ==> ={n0,p0,result,ICORE.m,ICORE_eager.order}); - progress;1:rewrite/#;last first. - - + seq 4 4:(={i,n0,p,p0,n,ICORE_eager.order,ICORE.m});1:sim. - replace{1} { all } by { result <- b0; all; } - (={i, n0, p, p0, n, ICORE_eager.order, ICORE.m} - ==> ={n0,p0,result, ICORE.m, ICORE_eager.order}) - (={i, n0, p, p0, n, ICORE_eager.order, ICORE.m} - ==> ={n0,p0,result, ICORE.m, ICORE_eager.order}); - progress;1:rewrite/#;1:sim. - replace{2} { all } by { result <- b0; all; } - (={i, n0, p, p0, n, ICORE_eager.order, ICORE.m} - ==> ={n0,p0,result, ICORE.m, ICORE_eager.order}) - (={i, n0, p, p0, n, ICORE_eager.order, ICORE.m} - ==> ={n0,p0,result, ICORE.m, ICORE_eager.order}); - progress;1:rewrite/#;2:sim. - sp;conseq(: ={i, n0, p, p0, n, ICORE_eager.order, ICORE.m, result} - ==> _);progress. - eager while(K: - result <@ ICORE.fill_in(p, n); ~ - result <@ ICORE.fill_in(p, n); : - ={i, n0, p, p0, n, ICORE_eager.order, ICORE.m, result} ==> - ={i, n0, p, p0, n, ICORE_eager.order, ICORE.m, result}); - progress;1,3:sim. - swap{2}-1;sim;conseq(:_==> ={result,ICORE.m});progress. - inline *. (* TODO : reprendre d'ici. Il y avait un pb de parse/format. *) - - - case((p, n){1} = (p0, i){1}). - + sp;rcondf{1}5;first auto;if;auto;smt(dom_set in_fsetU1). - by rcondf{2}4;auto;if;auto;smt(dom_set in_fsetU1). - sp;if{1};last first;2:rcondt{2}4;1:rcondf{2}4;progress;2:sim. - + auto;if;auto;smt(dom_set in_fsetU1). - + if{2};last first;2:rcondt{1}4;1:rcondf{1}4;auto;smt(getP). - + auto;if;auto;smt(dom_set in_fsetU1). - if{2};last first;2:rcondt{1}5;1:rcondf{1}5;progress. - + auto;smt(dom_set in_fsetU1). - + auto;smt(getP). - + auto;smt(dom_set in_fsetU1). - conseq(:_==> ={ICORE.m,result});progress. - alias{1} 1 c = b0; - transitivity{1} { - c <$ bdistr; - result <$ bdistr; - ICORE.m.[(p,n)] <- result; - ICORE.m.[(p0,i)] <- c; - } - (={p0,i,p,n,ICORE.m} /\ p1{1} = p{1} /\ n1{1} = n{1} - /\ ! (p{1} = p0{1} && n{1} = i{1}) ==> ={ICORE.m,result}) - (={p0,i,p,n,ICORE.m} /\ p1{2} = p0{2} /\ n1{2} = i{2} - /\ ! (p{1} = p0{1} && n{1} = i{1}) ==> ={ICORE.m,result}); - progress;1:rewrite/#. - + by swap{2}2;wp;rnd;wp;rnd;auto;smt(getP). - transitivity{1} { - c <$ bdistr; - result <$ bdistr; - ICORE.m.[(p,n)] <- result; - ICORE.m.[(p0,i)] <- c; - } - (={p0,i,p,n,ICORE.m} /\ ! (p{1} = p0{1} && n{1} = i{1}) - ==> ={ICORE.m,result}) - (={p0,i,p,n,ICORE.m} /\ p1{2} = p0{2} /\ n1{2} = i{2} - /\ ! (p{1} = p0{1} && n{1} = i{1}) ==> ={ICORE.m,result}); - progress;1:rewrite/#. - + by wp;rnd;rnd;auto;smt(set_set). - by wp;rnd;wp;rnd;auto;progress;smt(set_set getP). - sim;swap{2}-1;sim;swap{1}2;sp. - - conseq(: ={p,n,p0,n0,i,ICORE.m,ICORE_eager.order} - ==> ={result,ICORE_eager.order,ICORE.m});first 2 progress=>/#. - replace{1} { all } by { - result <- b0; - all; - } - (={p,n,p0,i,ICORE_eager.order,ICORE.m} - ==> ={result,ICORE_eager.order,ICORE.m}) - (={p,n,p0,i,ICORE_eager.order,ICORE.m} - ==> ={result,ICORE_eager.order,ICORE.m}); - progress;1:rewrite/#;1:sim. - replace{2} { all } by { - result <- b0; - all; - } - (={p,n,p0,i,ICORE_eager.order,ICORE.m} - ==> ={result,ICORE_eager.order,ICORE.m}) - (={p,n,p0,i,ICORE_eager.order,ICORE.m} - ==> ={result,ICORE_eager.order,ICORE.m}); - progress;1:rewrite/#;2:sim. - sp;conseq(: ={p,n,p0,i,ICORE.m,ICORE_eager.order,result} ==> _); - progress. - eager while(K: - result <@ ICORE.fill_in(p, n); ~ - result <@ ICORE.fill_in(p, n); : - ={p, n, p0, i, ICORE.m, ICORE_eager.order, result} ==> - ={p, n, p0, i, ICORE.m, ICORE_eager.order, result}); - progress;1,3:sim. - - swap{2}-1;sim;conseq(:_==> ={result,ICORE.m});progress. - inline *. - case((p, n){1} = parse (take i p0){1}). - + sp;rcondf{1}4;first auto;if;auto;smt(dom_set in_fsetU1). - by rcondf{2}4;auto;if;auto;smt(dom_set in_fsetU1). - sp;if{1};last first;2:rcondt{2}4;1:rcondf{2}4;progress;2:sim. - + auto;if;auto;smt(dom_set in_fsetU1). - + if{2};last first;2:rcondt{1}3;1:rcondf{1}3;auto;smt(getP). - + auto;if;auto;smt(dom_set in_fsetU1). - if{2};last first;2:rcondt{1}4;1:rcondf{1}4;progress. - + auto;smt(dom_set in_fsetU1). - + auto;smt(getP). - + auto;smt(dom_set in_fsetU1). - conseq(:_==> ={ICORE.m,result});progress. - alias{1} 1 c = b0. - transitivity{1} { - c <$ bdistr; - result <$ bdistr; - ICORE.m.[(p,n)] <- result; - ICORE.m.[parse(take i p0)] <- c; - } - (={p0,i,p,n,ICORE.m} /\ p1{1} = p{1} /\ n1{1} = n{1} - /\ (p1{1},n1{1}) <> parse (take i{1} p0{1}) ==> ={ICORE.m,result}) - (={p0,i,p,n,ICORE.m} /\ (p1{2},n1{2}) = parse(take i{1} p0{2}) - /\ (p1{1},n1{1}) <> parse (take i{1} p0{1}) ==> ={ICORE.m,result}); - progress;1:rewrite/#. - + by swap{2}2;wp;rnd;wp;rnd;auto;smt(getP). - transitivity{1} { - c <$ bdistr; - result <$ bdistr; - ICORE.m.[(p,n)] <- result; - ICORE.m.[parse(take i p0)] <- c; - } - (={p0,i,p,n,ICORE.m} /\ (p1{1},n1{1}) <> parse (take i{1} p0{1}) - ==> ={ICORE.m,result}) - (={p0,i,p,n,ICORE.m} /\ (p1{2},n1{2}) = parse(take i{1} p0{2}) - /\ (p1{1},n1{1}) <> parse (take i{1} p0{1}) ==> ={ICORE.m,result}); - progress;1:rewrite/#. - + by wp;rnd;rnd;auto;smt(set_set). - wp;rnd;wp;rnd;auto;progress. smt(set_set getP). - - qed. - - - local lemma eager_ICORE_e_f : - eager[ ICORE_eager.ewhile();, ICORE_eager.f - ~ ICORE_e.f, ICORE_eager.ewhile(); : - ={p, n} /\ ={ICORE_eager.dist_res, ICORE_eager.order, ICORE.m} - ==> - ={res, ICORE_eager.dist_res, ICORE_eager.order, ICORE.m}]. - proof. - eager proc. - swap{1}2;swap{2}-1;sp;wp. - if{2};1:rcondt{1}2;last first;1:rcondf{1}2;progress;2:sim. - + inline*;sp;while(! (valid p /\ 0 < n));auto. - sp;seq 1 : (! (valid p /\ 0 < n));1:by while(! (valid p /\ 0 < n));auto;sp;if;auto. - by sp;seq 1 : (! (valid p /\ 0 < n));1:while(! (valid p /\ 0 < n));auto;sp;if;auto. - + inline*;sp;while( (valid p /\ 0 < n));auto. - sp;seq 1 : ( (valid p /\ 0 < n));1:by while( (valid p /\ 0 < n));auto;sp;if;auto. - by sp;seq 1 : ( (valid p /\ 0 < n));1:while( (valid p /\ 0 < n));auto;sp;if;auto. - conseq(: ={p, n, glob ICORE_eager, i, r} ==> - ={p, n, glob ICORE_eager, i, r});progress. - - eager while(J : - ICORE_eager.ewhile(); ~ - ICORE_eager.ewhile(); : - ={p, n, glob ICORE_eager, i, r} ==> - ={p, n, glob ICORE_eager, i, r}); - progress;1,3:sim. - swap{2}-1;wp 3 3. - swap{2}-1;sim. - conseq(:_==> ={p, n, b, glob ICORE_eager});progress. - inline{2}1. - swap{2}3 1;swap{2}-1. - replace{2} { (<@ as fill_in);(<@ as ewhile) } by { - ewhile; - fill_in; - } - (={i, r, p, n, glob ICORE_eager} ==> ={b, p, n, glob ICORE_eager}) - (={i, r, p, n, glob ICORE_eager} ==> ={b, p, n, glob ICORE_eager}); - progress;1:rewrite/#;last first. - + sim;conseq(:_==> ={ICORE_eager.order, ICORE.m,c});progress. - seq 3 3:(={p0,n0,ICORE_eager.order, ICORE.m});1:sim. - by eager call(eager_ICORE_fill_in);auto. - inline{1}2;sim;swap{1}-1;sim. - - inline{2}4. - splitwhile{2}7: 1 < size world. - rcondt{2}8;progress. - + sp;while(last (head [] (behead world)) world = format p i /\ 1 <= size world); - auto;last smt(last_rcons size_rcons size_ge0 size_eq0). - inline*=>//=. - sp;seq 1 : (last (head [] (behead world)) (behead world) = format p i - /\ 1 <= size (behead world)). - + while(last (head [] (behead world)) (behead world) = format p i - /\ 1 <= size (behead world));auto. - + by sp;if;auto. - by progress;smt(head_behead). - sp;seq 1 : (last (head [] (behead world)) (behead world) = format p i - /\ 1 <= size (behead world)). - + while(last (head [] (behead world)) (behead world) = format p i - /\ 1 <= size (behead world));auto. - by sp;if;auto. - by auto;progress;smt(head_behead). - rcondf{2}15;progress. - + seq 8 : (world = [format p i]). - + wp;sp;while(last (head [] world) world = format p i /\ 1 <= size world); - auto;last first. - + smt(last_rcons size_rcons size_ge0 head_behead size_eq0). - inline*=>//=. - sp;seq 1 : (last (head [] world) (behead world) = format p i - /\ 1 <= size (behead world)). - + while(last (head [] world) (behead world) = format p i - /\ 1 <= size (behead world));auto. - + by sp;if;auto. - by progress;smt(head_behead). - sp;seq 1 : (last (head [] world) (behead world) = format p i - /\ 1 <= size (behead world)). - + while(last (head [] world) (behead world) = format p i - /\ 1 <= size (behead world));auto. - by sp;if;auto. - by auto;progress;smt(head_behead). - inline*=>/=. - sp;seq 1:(world = [format p i]);1:while(world = [format p i]);1:(sp;if);auto. - by sp;seq 1:(world = [format p i]);1:while(world = [format p i]);1:(sp;if);auto. - - swap{1}-3;sim. - inline*;sim;swap{1}[5..8]-1;wp;sp=>/=. - conseq(:_==> ={ICORE.m,ICORE_eager.order} - /\ world{1} = [] /\ world{2} = [format p{2} i{2}]); - 1:smt(parseK). - - while(={ICORE.m} /\ world{2} = rcons world{1} (format p{2} i{2})); - auto;last smt(size_eq0 size_rcons size_ge0). - rewrite/=. - sp;conseq(:_==> ={ICORE.m}); - 1:smt(head_behead size_eq0 size_rcons size_ge0);sim. - smt(head_behead). - qed. - - local lemma eager_ICORE &m : - Pr[Low.Indif(ICORE, S(ICORE), LoDist(D)).main() @ &m : res] = - Pr[Low.Indif(ICORE_eager, S(ICORE_eager), LoDist(D)).main() @ &m : res]. - - proof. - cut->:Pr[Low.Indif(ICORE, S(ICORE), LoDist(D)).main() @ &m : res] = - Pr[Low.Indif(ICORE_e, S(ICORE_e), LoDist(D)).main() @ &m : res]. - + byequiv (_: ={glob D, glob S} ==> _ )=> //=; proc. - call(: ={glob S,glob ICORE})=>//=;auto. - + proc(={glob ICORE});auto;proc. - sp;if;auto;sp;inline*. - while(={ICORE.m,r,i,p,n} /\ valid p{1} /\ 0 < n{1} /\ 0 < i{1})=>//=;1:auto. - sp;if;auto;smt(parseK). - + proc(={glob ICORE});auto;proc. - sp;if;auto;sp;inline*. - while(={ICORE.m,r,i,p,n} /\ valid p{1} /\ 0 < n{1} /\ 0 < i{1})=>//=;1:auto. - sp;if;auto;smt(parseK). - + proc;inline*;sp;if;auto;1:progress=>/#;sp. - sp;if;1:auto=>/#;sp;inline*. - while(={ICORE.m,r0,i,p0,n0} /\ valid p0{1} /\ 0 < n0{1} /\ 0 < i{1})=>//=;1:auto. - sp;if;auto;smt(parseK). - + by auto=>/#. - + by auto=>/#. - by inline*;auto;call(:true);auto. - - byequiv (_: ={glob D, glob S} ==> _ )=> //=; proc. - replace{1} { all; <@ } by { - all; - ICORE_eager.dist_res <@ LoDist(D, ICORE_e, S(ICORE_e)).distinguish(); - b <- ICORE_eager.dist_res; - ICORE_eager.ewhile(); - } - (={glob D, glob S} ==> ={b}) - (={glob D, glob S} ==> ={b});progress. - + rewrite/#. - + seq 3 4 : (={b});inline*;auto. - - call(: ={glob S,glob ICORE_e});auto. - + by proc(={glob ICORE_e});auto;proc;sim. - + by proc(={glob ICORE_e});auto;proc;sim. - + by proc;sim. - by call(:true);auto. - sp;while{2}(={b})(size world{2});auto;2:smt(size_eq0 size_ge0). - while(b = b{m0} /\ size (behead world) < z)(n+1-i); - first progress;sp;if;auto;smt(bdistr_ll head_behead size_eq0 size_ge0). - wp;while(b = b{m0} /\ size (behead world) < z)(size p-i); - first progress;sp;if;auto;smt(bdistr_ll head_behead size_eq0 size_ge0). - auto;smt(head_behead). - - replace{2} { all; <@ } by { - all; - ICORE_eager.ewhile(); - ICORE_eager.dist_res <@ LoDist(D, ICORE_eager, S(ICORE_eager)).distinguish(); - b <- ICORE_eager.dist_res; - } - (={glob D, glob S} ==> ={b}) - (={glob D, glob S} ==> ={b});progress;1:rewrite/#;last first. - + by inline*;rcondf{1}8;auto;2:sim;call(:true);auto. - - swap{1}-1;sim. - - symmetry;seq 2 2 : (={glob S,glob D,glob ICORE_eager});1:sim;progress. - - eager call(: ={arg, glob D, glob S,glob ICORE_eager} ==> - ={res, glob D, glob S,glob ICORE_eager} );auto. - eager proc(H : ICORE_eager.ewhile(); ~ ICORE_eager.ewhile(); : - ={glob S, glob ICORE_eager} ==> ={glob S, glob ICORE_eager}) - (={glob S, glob ICORE_eager});auto;progress;1,3,5,7:sim. - - +eager proc(H': ICORE_eager.ewhile(); ~ ICORE_eager.ewhile(); : - ={glob ICORE_eager} ==> ={glob ICORE_eager}) - (={glob ICORE_eager});auto;progress;1,3:sim. - - (* eager : ewhile; ICORE_eager.f ~ ICORE_e.f ; ewhile *) - eager proc. - replace{1} { <@ as ewhile; rest } by { - ewhile; - result <@ ICORE_eager.f(p,n); - } - (={p,n,glob ICORE_eager} ==> ={result,glob ICORE_eager}) - (={p,n,glob ICORE_eager} ==> ={result,glob ICORE_eager}); - progress;1:rewrite/#;1:(inline*;sim). - replace{2} { rest; (<@ as ewhile) } by { - result <@ ICORE_e.f(p,n); - ewhile; - } - (={p,n,glob ICORE_eager} ==> ={result,glob ICORE_eager}) - (={p,n,glob ICORE_eager} ==> ={result,glob ICORE_eager}); - progress;1:rewrite/#;2:(inline*;sim). - - by eager call(eager_ICORE_e_f);auto. - - - +eager proc(H': ICORE_eager.ewhile(); ~ ICORE_eager.ewhile(); : - ={glob ICORE_eager} ==> ={glob ICORE_eager}) - (={glob ICORE_eager});auto;progress;1,3:sim. - - (* eager : ewhile; ICORE_eager.f ~ ICORE_e.f ; ewhile *) - eager proc. - replace{1} { <@ as ewhile; rest } by { - ewhile; - result <@ ICORE_eager.f(p,n); - } - (={p,n,glob ICORE_eager} ==> ={result,glob ICORE_eager}) - (={p,n,glob ICORE_eager} ==> ={result,glob ICORE_eager}); - progress;1:rewrite/#;1:(inline*;sim). - replace{2} { rest; (<@ as ewhile) } by { - result <@ ICORE_e.f(p,n); - ewhile; - } - (={p,n,glob ICORE_eager} ==> ={result,glob ICORE_eager}) - (={p,n,glob ICORE_eager} ==> ={result,glob ICORE_eager}); - progress;1:rewrite/#;2:(inline*;sim). - - by eager call(eager_ICORE_e_f);auto. - - eager proc. - swap{1}3;sp;swap{2}-1;sim. - if{2};last first;2:rcondt{1}2;1:rcondf{1}2;progress;2:sim. - + inline*;sp;while(! (valid x /\ 0 < n));auto;2:rewrite/#. - while(! (valid x /\ 0 < n));1:(sp;if);auto. - while(! (valid x /\ 0 < n));1:(sp;if);auto. - + inline*;sp;while( (valid x /\ 0 < n));auto;2:rewrite/#. - while( (valid x /\ 0 < n));1:(sp;if);auto. - while( (valid x /\ 0 < n));1:(sp;if);auto. - swap{2}-1;sim. - eager call(eager_ICORE_e_f). - auto=>/#. - qed. lemma LiftInd &m: `| Pr[Low.Indif(CORE(P),P,LoDist(D)).main() @ &m: res] @@ -790,184 +229,148 @@ local module ICORE_eager : Low.FUNCTIONALITY = { by inline*;auto;call(:true);auto. - (* TODO : Introduce an equivalent module to ICORE whose fill_in procedure - makes the same calls as IBlockSponge *) - rewrite (eager_ICORE &m). byequiv (_: ={glob D, glob S} ==> _)=> //=; proc. - call (_: ={glob S} /\ INV IBlockSponge.m{2} ICORE.m{1}). + proc (INV IBlockSponge.m{2} ICORE.m{1})=> //. proc=> /=; sp;if=> [&1 &2 [#] <*>| |] //=. inline{2} 1.1. inline*. while( INV IBlockSponge.m{2} ICORE.m{1} - /\ i{1} = i{2} + 1 - /\ 0 < i{1} - /\ ={n,p,r} - /\ valid p{1} /\ 0 < n{1});last auto=>/#. - rcondt{2}6;auto;progress. - + by cut:=parseK p{hr} (i{hr}+1) H0 H1;rewrite/format-addzA/==>->/=. - + by cut:=parseK p{hr} (i{hr}+1) H0 H1;rewrite/format-addzA/==>->/=. - sp. - conseq(:_==> (INV IBlockSponge.m{2} ICORE.m{1} /\ - rcons r{1} (oget ICORE.m{1}.[(p3{1}, n3{1})]) = - rcons r{2} (oget IBlockSponge.m{2}.[x1{2}])));1:progress=>/#. - seq 3 1:(x{2} = format p0{1} n0{1} /\ INV IBlockSponge.m{2} ICORE.m{1} - /\ valid p0{1} /\ 0 < n0{1} /\ ={r});last first. - sp;if;auto;smt(in_dom parseK getP formatK). - - splitwhile{2}1:i0 < size p. - conseq(:_==> INV IBlockSponge.m{2} ICORE.m{1});1:smt(parseK). - while(INV IBlockSponge.m{2} ICORE.m{1} - /\ valid p0{1} - /\ 0 < i0{1} - /\ 0 < n0{1} - /\ i0{1} = i0{2} - size p0{1} + 1 - /\ format p0{1} i0{1} = take i0{2} x{2} - /\ x{2} = format p0{1} n0{1});auto. - + sp;if;auto;smt(parseK formatK in_dom getP take_cat size_cat - size_nseq take_nseq). - conseq(:_==> INV IBlockSponge.m{2} ICORE.m{1} /\ - i0{2} = size p0{1});1:smt(parseK formatK take_cat nseq0 cats0 take0 size_cat size_nseq). - while(={i0} /\ 0 < i0{1} <= size p0{1} /\ p0{1} = p{2} /\ - valid p0{1} /\ 0 < n0{1} /\ - x{2} = format p0{1} n0{1} /\ INV IBlockSponge.m{2} ICORE.m{1});auto. - + sp;if;auto;progress. move:H7;rewrite 2!in_dom take_cat H6/=H3. smt(in_dom take_cat nseq0 cats0). rewrite in_dom/=H3. -smt(in_dom take_cat parseK formatK). - - - - sp;sim. - conseq(:_==> INV IBlockSponge.m{2} ICORE.m{1} /\ x1{2} = x{2} /\ );1:progress. - rewrite/#. - congr;congr;rewrite H6 -H;congr;congr;2:rewrite/#. - rewrite/#. - rewrite/#. - rewrite/#. - rewrite/#. - rewrite/#. - rewrite/#. - /\ ={r - - rcondt{1}1;1:auto=>/#. - conseq(:_ ==> r{1} = bs{2} /\ ICORE.m{1} = IBlockSponge.m{2});progress. - by while( i{1} = i0{2} + 1 /\ n{1} = n0{2} /\ x{2} = p{1} - /\ ICORE.m{1} = IBlockSponge.m{2} /\ r{1} = bs{2});sp;if;auto=>/#. - - + proc(={m}(ICORE,IBlockSponge))=>//=. - proc;inline*;sp;if;auto;sp;rcondt{2}1;auto;sp. - rcondt{1}1;1:auto=>/#;sp. - conseq(:_ ==> r{1} = bs{2} /\ ICORE.m{1} = IBlockSponge.m{2});progress. - by while( i{1} = i0{2} + 1 /\ n{1} = n0{2} /\ x{2} = p{1} - /\ ICORE.m{1} = IBlockSponge.m{2} /\ r{1} = bs{2});sp;if;auto=>/#. - - + proc;inline*;sp;if;auto;sp;rcondt{1}1;auto;progress. - rcondt{1}1;1:auto=>/#;sp. - conseq(:_ ==> r0{1} = bs{2} /\ ICORE.m{1} = IBlockSponge.m{2});progress. - by while( i{1} = i{2} + 1 /\ n0{1} = n{2} /\ x{2} = p0{1} - /\ ICORE.m{1} = IBlockSponge.m{2} /\ r0{1} = bs{2});sp;if;auto=>/#. - - by inline*;auto;call(:true);auto. -qed. + /\ 0 < i{1} <= n{1} + 1 + /\ ={n,p,r,i} + /\ valid p{1} + /\ 0 < n{1} + /\ (forall j, 0 < j < i{1} => + format p{2} j \in dom IBlockSponge.m{2}));last auto=>/#. + rcondt{2}5;auto;1:smt(parseK). + swap{2}6-1;sp. + conseq(:_==> INV IBlockSponge.m{2} ICORE.m{1} /\ + (forall j, 0 < j <= n0{1} => + format p0{1} j \in dom IBlockSponge.m{2}));1:smt(parseK formatK). + conseq(: INV IBlockSponge.m{2} ICORE.m{1} /\ (forall (j : int), + 0 < j < n0{1} => format p0{1} j \in dom IBlockSponge.m{2}) /\ + (p0,n0){1} = parse x1{2} /\ (x=x1){2} /\ ={p0,n0} /\ + n0{1} = i{2} /\ 0 <= i0{2} < i{2} + ==> _);1:smt(parseK formatK). + seq 1 1 : (INV IBlockSponge.m{2} ICORE.m{1} /\ 0 < n0{2} /\ + (forall (j : int), 0 < j <= n0{1} => + format p0{1} j \in dom IBlockSponge.m{2}) /\ + (p0,n0){1} = parse x1{2} /\ ={p0,n0} /\ (x=x1){2});last first. + + rcondf{2}1;auto;smt(parseK formatK). + splitwhile{2}1:(i0+1 + format p0{1} j \in dom IBlockSponge.m{2}) /\ + (p0,n0){1} = parse x1{2} /\ ={p0,n0} /\ (x=x1){2});last first. + + rcondt{2}1;1:auto=>/#;rcondf{2}4;1: by progress;sp;if;auto=>/#. + sp;if;auto;progress. + + rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. + cut->/=:!size p0{2} + i0{2} < size p0{2} by rewrite/#. + smt(in_dom formatK). + + move:H3;rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. + cut->/=:!size p0{2} + i0{2} < size p0{2} by rewrite/#. + smt(in_dom formatK). + + rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. + smt(getP parseK formatK). + + rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. + smt(in_dom getP parseK formatK). + + case(j=i0{2} + 1)=>//=;2:rewrite/#. + smt(in_dom getP parseK formatK). + while{2}((p0{2}, n0{2}) = parse x1{2} /\ (x=x1){2} /\ 0 <= i0{2} < n0{2} /\ + INV IBlockSponge.m{2} ICORE.m{1} /\ (p0,n0){1} = parse x1{2} /\ + ={p0,n0} /\ (forall (j : int), 0 < j < n0{2} => + format p0{2} j \in dom IBlockSponge.m{2}))(n0{2}-i0{2});progress. + + sp;rcondf 1;auto;progress. + + rewrite-(formatK x1{hr})-H3/=take_cat addzAC/=/=take_nseq/min/=. + cut->/=:!size p0{hr} + i0{hr} < size p0{hr} by rewrite/#. + by cut/#:=H4 (i0{hr}+1). + + by rewrite/#. + by rewrite/#. + by auto=>/#. -(* conseq (_: ={r, i} *) -(* /\ r{2} = [] *) -(* /\ b{2} = [] *) -(* /\ i{2} = 1 *) -(* /\ parse p{1} = (p{2},n{2}) *) -(* /\ valid p{2} *) -(* /\ 0 < n{2} *) -(* /\ INV ICORE.m{1} IBlockSponge.m{2} *) -(* ==> _)=> />. *) -(* + by move=> &1 &2=> <-. *) -(* splitwhile{1} 1: (i < size (parse p).`1); inline{2} 2. *) -(* rcondt{2} 6; first by auto; while (true)=> //; auto=> /> &hr <- //. *) -(* wp. while ( i{1} = i0{2} + size x0{2} - 1 *) -(* /\ p{1} = x0{2} ++ nseq (n0 - 1){2} b0 *) -(* /\ r{1} = r{2} ++ bs{2} *) -(* /\ 0 < i0{2} *) -(* /\ valid x0{2} *) -(* /\ n{2} = n0{2} *) -(* /\ INV ICORE.m{1} IBlockSponge.m{2} *) -(* /\ parse p{1} = (p{2}, n{2})). *) -(* + wp;inline*;sp;wp;if;auto;smt(parseK min_lel size_nseq take_nseq *) -(* rcons_cat parse_injective getP in_dom oget_some take_size take0 *) -(* take_cat parse_valid valid_take cat_rcons cats0 size_cat size_ge0). *) -(* wp=>/=. *) -(* conseq(:_==> ={r, i} *) -(* /\ valid p{2} *) -(* /\ 0 < n{2} *) -(* /\ p{1} = p{2} ++ nseq (n{2} - 1) Block.b0 *) -(* /\ i{1} = size p{2} *) -(* /\ parse p{1} = (p{2}, n{2}) *) -(* /\ INV ICORE.m{1} IBlockSponge.m{2});progress;..-2:smt(cats0 size_cat size_ge0). *) -(* while( ={r,i} *) -(* /\ valid p{2} *) -(* /\ 0 < n{2} *) -(* /\ p{1} = p{2} ++ nseq (n{2} - 1) Block.b0 *) -(* /\ 0 < i{1} <= size p{2} *) -(* /\ parse p{1} = (p{2}, n{2}) *) -(* /\ INV ICORE.m{1} IBlockSponge.m{2}). *) -(* + inline*;auto;sp;rcondt{2}1;1:(auto;smt(valid_take)). *) -(* rcondt{2}1;1:auto;sp;rcondf{2}5;1:auto;if;auto; *) -(* smt(parse_injective getP oget_some in_dom take_size take0 take_cat *) -(* parse_valid valid_take cat_rcons cats0 size_cat size_ge0). *) -(* auto;smt(parseK min_lel size_nseq take_nseq valid_spec *) -(* rcons_cat parse_injective getP in_dom oget_some take_size take0 *) -(* take_cat parse_valid valid_take cat_rcons cats0 size_cat size_ge0). *) -(* + proc (INV ICORE.m{1} IBlockSponge.m{2})=> //. *) -(* proc. *) -(* sp;if;1:progress=>/#. *) -(* splitwhile{1} 1 : i < size (parse p).`1. *) -(* rcondt{1}2;progress. *) -(* + while(i <= size (parse p).`1);auto;1:call(:true);auto;progress. *) -(* + rewrite/#. *) -(* + smt(size_ge0 valid_spec). *) -(* cut/#:size (parse x{m0}).`1 <= size x{m0}. *) -(* by rewrite-{2}(formatK x{m0}) -H/=/format size_cat size_nseq/#. *) -(* inline*;auto. *) -(* replace{2} { *) -(* while { *) -(* setup; *) -(* if { *) -(* (while as loop) *) -(* }; *) -(* setup_end *) -(* }; *) -(* after *) -(* } by { *) -(* while(i < size p) { *) -(* setup; *) -(* loop; *) -(* setup_end; *) -(* } *) -(* after; *) -(* } *) -(* (r{2} = [] /\ (p{2}, n{2}) = parse x{2} /\ b{2} = [] /\ *) -(* i{2} = 1 /\ r{1} = [] /\ i{1} = 1 /\ p{1} = x{2} /\ *) -(* INV ICORE.m{1} IBlockSponge.m{2} /\ valid (parse p{1}).`1 /\ *) -(* 0 < (parse p{1}).`2 *) -(* ==> r{1} = r{2} ++ bs0{2} /\ INV ICORE.m{1} IBlockSponge.m{2}) *) -(* (={i,p,n,x,r,b,IBlockSponge.m, *) - - -(* (* now we should manage the while loops *) *) -(* admit. *) -(* + auto. *) - -(* + proc; sp; if=> //=; inline{1} 1; rcondt{1} 4. *) -(* + by auto=> /> &hr _ ^valid_x+ ^n_gt0 /parseK H - /H {H} ->. *) -(* sp;wp. *) -(* conseq(:_==> drop (size p{1} - 1) r0{1} = bs{2} *) -(* /\ ={glob S} *) -(* /\ INV ICORE.m{1} IBlockSponge.m{2});progress. *) -(* by do !congr;rewrite b2i_eq1/#. *) -(* inline*;rewrite/INV. *) -(* (* This is false : because ICORE.m{1} will be bigger than IBlockSponge.m{2} *) *) -(* splitwhile{1}1:i<=size p;rcondt{2}1;1:auto=>/#. *) -(* inline*. *) -(* (* same as the second loop in LoF.f *) *) -(* admit. *) -(* by inline *; auto; call (_: true); auto=> /> p; rewrite !map0P. *) -(* qed. *) + + proc (INV IBlockSponge.m{2} ICORE.m{1})=> //. + proc=> /=; sp;if=> [&1 &2 [#] <*>| |] //=. + inline{2} 1.1. + inline*. + while( INV IBlockSponge.m{2} ICORE.m{1} + /\ 0 < i{1} <= n{1} + 1 + /\ ={n,p,r,i} + /\ valid p{1} + /\ 0 < n{1} + /\ (forall j, 0 < j < i{1} => + format p{2} j \in dom IBlockSponge.m{2}));last auto=>/#. + rcondt{2}5;auto;1:smt(parseK). + swap{2}6-1;sp. + conseq(:_==> INV IBlockSponge.m{2} ICORE.m{1} /\ + (forall j, 0 < j <= n0{1} => + format p0{1} j \in dom IBlockSponge.m{2}));1:smt(parseK formatK). + conseq(: INV IBlockSponge.m{2} ICORE.m{1} /\ (forall (j : int), + 0 < j < n0{1} => format p0{1} j \in dom IBlockSponge.m{2}) /\ + (p0,n0){1} = parse x1{2} /\ (x=x1){2} /\ ={p0,n0} /\ + n0{1} = i{2} /\ 0 <= i0{2} < i{2} + ==> _);1:smt(parseK formatK). + seq 1 1 : (INV IBlockSponge.m{2} ICORE.m{1} /\ 0 < n0{2} /\ + (forall (j : int), 0 < j <= n0{1} => + format p0{1} j \in dom IBlockSponge.m{2}) /\ + (p0,n0){1} = parse x1{2} /\ ={p0,n0} /\ (x=x1){2});last first. + + rcondf{2}1;auto;smt(parseK formatK). + splitwhile{2}1:(i0+1 + format p0{1} j \in dom IBlockSponge.m{2}) /\ + (p0,n0){1} = parse x1{2} /\ ={p0,n0} /\ (x=x1){2});last first. + + rcondt{2}1;1:auto=>/#;rcondf{2}4;1: by progress;sp;if;auto=>/#. + sp;if;auto;progress. + + rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. + cut->/=:!size p0{2} + i0{2} < size p0{2} by rewrite/#. + smt(in_dom formatK). + + move:H3;rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. + cut->/=:!size p0{2} + i0{2} < size p0{2} by rewrite/#. + smt(in_dom formatK). + + rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. + smt(getP parseK formatK). + + rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. + smt(in_dom getP parseK formatK). + + case(j=i0{2} + 1)=>//=;2:rewrite/#. + smt(in_dom getP parseK formatK). + while{2}((p0{2}, n0{2}) = parse x1{2} /\ (x=x1){2} /\ 0 <= i0{2} < n0{2} /\ + INV IBlockSponge.m{2} ICORE.m{1} /\ (p0,n0){1} = parse x1{2} /\ + ={p0,n0} /\ (forall (j : int), 0 < j < n0{2} => + format p0{2} j \in dom IBlockSponge.m{2}))(n0{2}-i0{2});progress. + + sp;rcondf 1;auto;progress. + + rewrite-(formatK x1{hr})-H3/=take_cat addzAC/=/=take_nseq/min/=. + cut->/=:!size p0{hr} + i0{hr} < size p0{hr} by rewrite/#. + by cut/#:=H4 (i0{hr}+1). + + by rewrite/#. + by rewrite/#. + by auto=>/#. + + + proc. + sp;if=> [&1 &2 [#] <*>/#| |] //=. + inline*;sp;rcondt{1}1;auto. + swap{2}1;sp. + conseq(:_==> last Block.b0 r0{1} = oget IBlockSponge.m{2}.[x{2}] /\ + INV IBlockSponge.m{2} ICORE.m{1});progress. + seq 1 1 :(last Block.b0 r0{1} = oget IBlockSponge.m{2}.[x{2}] /\ + INV IBlockSponge.m{2} ICORE.m{1} /\ + x1{2} \in dom IBlockSponge.m{2});last by rcondf{2}1;auto=>/#. + conseq(:_==> INV IBlockSponge.m{2} ICORE.m{1} /\ i{2} = n{2} /\ + Some (last Block.b0 r0{1}) = + IBlockSponge.m{2}.[take (size p + i){2} x{2}]);progress. + + move:H5;rewrite take_oversize;2:smt(oget_some). + by rewrite-formatK/=-H/=size_cat size_nseq/#. + + move:H5;rewrite take_oversize. + + by rewrite-formatK/=-H/=size_cat size_nseq/#. + by rewrite in_dom/#. + while( i{1} = i{2}+1 /\ n0{1} = n{2} /\ p{2} = p0{1} + /\ valid p0{1} /\ 0 < i{1} /\ i{2} <= n{2} + /\ (i{2} = n{2} => Some (last Block.b0 r0{1}) = + IBlockSponge.m{2}.[take (size p{2} + i{2}) x{2}]) + /\ INV IBlockSponge.m{2} ICORE.m{1} + /\ parse x{2} = (p0{1},n0{1}));auto;last first. + + progress=>/#. + sp;if;auto;smt(take_nseq parseK in_dom formatK take_cat getP last_rcons). + + by inline*;auto;call(:true);auto;smt(in_dom dom0 in_fset0). +qed. end section PROOF. diff --git a/proof/core/ConcreteF.eca b/proof/core/ConcreteF.eca index 8c5367b..dde9a3c 100644 --- a/proof/core/ConcreteF.eca +++ b/proof/core/ConcreteF.eca @@ -1,4 +1,4 @@ -require import Pred Fun Option Pair Int Real StdOrder Ring. +require import Core Int Real StdOrder Ring Distr IntExtra. require import List FSet NewFMap Utils Common SLCommon DProd Dexcepted. (*...*) import Capacity IntOrder RealOrder. @@ -54,20 +54,23 @@ section. type D <- state, op uD <- dstate, type K <- unit, - op dK <- (NewDistr.MUnit.dunit<:unit> tt), + op dK <- (MUnit.dunit<:unit> tt), op q <- max_size proof *. realize ge0_q by smt w=max_ge0. realize uD_uf_fu. split. - case=> [x y]; rewrite support_dprod /=. - by rewrite Block.DWord.support_bdistr Capacity.DWord.support_cdistr. - apply/dprod_uf. - by rewrite Block.DWord.bdistr_uf. - by rewrite Capacity.DWord.cdistr_uf. + case=> [x y]; rewrite supp_dprod /=. + rewrite Block.DBlock.supp_dunifin Capacity.DWord.supp_dunifin/=. + smt(dprod1E Block.DBlock.dunifin_funi Capacity.DWord.dunifin_funi). + split. + smt(dprod_ll Block.DBlock.dunifin_ll Capacity.DWord.dunifin_ll). + apply/dprod_fu. + rewrite Block.DBlock.dunifin_fu. + by rewrite Capacity.DWord.dunifin_fu. qed. realize dK_ll. - by rewrite /is_lossless NewDistr.MUnit.dunit_ll. + by rewrite /is_lossless MUnit.dunit_ll. qed. (* TODO move this *) @@ -121,18 +124,16 @@ section. by sp; if=> //=; auto=> /> &2 cL /size_behead=> ->; progress; ring. have p_ll := P_f_ll _ _. + apply/dprod_ll; split. - + exact/Block.DWord.bdistr_ll. - exact/Capacity.DWord.cdistr_ll. - + apply/fun_ext=>- [] a b; rewrite support_dprod. - rewrite -/(Distr.support _ _) NewDistr.MUniform.duniform_fu Block.enumP. - by rewrite -/(Distr.support _ _) NewDistr.MUniform.duniform_fu Capacity.enumP. + + exact/Block.DBlock.dunifin_ll. + exact/Capacity.DWord.dunifin_ll. + + apply/fun_ext=>- [] a b; rewrite supp_dprod. + by rewrite/=/predT/=Block.DBlock.dunifin_fu Capacity.DWord.dunifin_fu. have pi_ll := P_fi_ll _ _. + apply/dprod_ll; split. - + exact/Block.DWord.bdistr_ll. - exact/Capacity.DWord.cdistr_ll. - + apply/fun_ext=>- [] a b; rewrite support_dprod. - rewrite -/(Distr.support _ _) NewDistr.MUniform.duniform_fu Block.enumP. - by rewrite -/(Distr.support _ _) NewDistr.MUniform.duniform_fu Capacity.enumP. + + exact/Block.DBlock.dunifin_ll. + exact/Capacity.DWord.dunifin_ll. + + apply/fun_ext=>- [] a b; rewrite supp_dprod. + by rewrite/=/predT/=Block.DBlock.dunifin_fu Capacity.DWord.dunifin_fu. have f_ll : islossless SqueezelessSponge(Perm).f. + proc; while true (size p)=> //=. * by move=> z; wp; call p_ll; skip=> /> &hr /size_behead /#. diff --git a/proof/core/Gcol.eca b/proof/core/Gcol.eca index 3f680bf..fcc397c 100644 --- a/proof/core/Gcol.eca +++ b/proof/core/Gcol.eca @@ -1,5 +1,5 @@ pragma -oldip. -require import Pred Fun Option Pair Int Real RealExtra StdOrder Ring StdBigop. +require import Core Int Real RealExtra StdOrder Ring StdBigop IntExtra. require import List FSet NewFMap Utils Common SLCommon RndO FelTactic Mu_mem. require import DProd Dexcepted. (*...*) import Capacity IntOrder Bigreal RealOrder BRA. @@ -295,9 +295,9 @@ section PROOF. by rewrite le_fromint;smt ml=0 w=max_ge0. + proc;sp;if;2:by hoare=>//??;apply eps_ge0. wp. - rnd (mem (image fst (rng FRO.m)));skip;progress;2:smt ml=0. - rewrite (Mu_mem.mu_mem (image fst (rng FRO.m{hr})) cdistr (1%r/(2^c)%r))//. - + move=>x _; apply DWord.cdistr1E. + rnd (mem (image fst (rng FRO.m)));skip;progress;2:smt ml=0. + cut->:=(Mu_mem.mu_mem (image fst (rng FRO.m{hr})) cdistr (1%r/(2^c)%r) _). + + move=>x _; rewrite DWord.dunifin1E;do !congr;exact cap_card. apply ler_wpmul2r;2:by rewrite le_fromint. by apply divr_ge0=>//;apply /c_ge0r. + move=>ci;proc;rcondt 2;auto=>/#. diff --git a/proof/core/Gconcl.ec b/proof/core/Gconcl.ec index 6027e1a..1215e7e 100644 --- a/proof/core/Gconcl.ec +++ b/proof/core/Gconcl.ec @@ -1,10 +1,11 @@ pragma -oldip. -require import Pred Fun Option Pair Int Real RealExtra StdOrder Ring StdBigop. +require import Core Int Real RealExtra StdOrder Ring StdBigop IntExtra. require import List FSet NewFMap Utils Common SLCommon RndO FelTactic Mu_mem. require import DProd Dexcepted. (*...*) import Capacity IntOrder Bigreal RealOrder BRA. require (*..*) Gext. +print F.RO. module IF = { proc init = F.RO.init @@ -220,14 +221,14 @@ proof. [rcondt{1} 3;2:rcondt{2} 3| rcondf{1} 3;2:rcondf{2} 3]; 1,2,4,5:(by move=>?;conseq (_:true);auto);2:by sim. inline *;rcondt{1} 6;1:by auto=>/>. - wp;rnd;auto;progress[-split];rewrite DWord.cdistr_ll /= => ?_?->. + wp;rnd;auto;progress[-split];rewrite DWord.dunifin_ll /= => ?_?->. by rewrite !getP /= oget_some. case ((mem (dom G1.mh) (x.`1, hx2) /\ t){1}); [rcondt{1} 4;2:rcondt{2} 4| rcondf{1} 4;2:rcondf{2} 4]; 1,2,4,5:(by move=>?;conseq (_:true);auto);2:by sim. inline *;rcondt{1} 7;1:by auto=>/>. wp;rnd;auto;rnd{1};auto;progress[-split]. - rewrite Block.DWord.support_bdistr DWord.cdistr_ll /==> ?_?->. + rewrite Block.DBlock.supp_dunifin DWord.dunifin_ll /==> ?_?->. by rewrite !getP /= oget_some. + proc;sp;if=>//. @@ -241,7 +242,7 @@ proof. [rcondt{1} 3;2:rcondt{2} 3| rcondf{1} 3;2:rcondf{2} 3]; 1,2,4,5:(by move=>?;conseq (_:true);auto);2:by sim. inline *;rcondt{1} 6;1:by auto=>/>. - wp;rnd;auto;progress[-split];rewrite DWord.cdistr_ll /= => ?_?->. + wp;rnd;auto;progress[-split];rewrite DWord.dunifin_ll /= => ?_?->. by rewrite !getP /= oget_some. proc;sp;if=>//. @@ -342,7 +343,7 @@ proof. call (_: ={G1.m,G1.mi,G1.paths,F.RO.m,C.c});last by auto. sp;sim; while(={i,p,F.RO.m})=>//. inline F.RO.sample F.RO.get;if{1};1:by auto. - by sim;inline *;auto;progress;apply DWord.cdistr_ll. + by sim;inline *;auto;progress;apply DWord.dunifin_ll. qed. local equiv G4_Ideal : G4(F.LRO).distinguish ~ IdealIndif(IF,S,DRestr(D)).main : diff --git a/proof/core/Gext.eca b/proof/core/Gext.eca index f467cc0..c7439d7 100644 --- a/proof/core/Gext.eca +++ b/proof/core/Gext.eca @@ -1,5 +1,5 @@ pragma -oldip. -require import Pred Fun Option Pair Int Real RealExtra StdOrder Ring StdBigop. +require import Core Int Real RealExtra StdOrder Ring StdBigop IntExtra. require import List FSet NewFMap Utils Common SLCommon RndO FelTactic Mu_mem. require import DProd Dexcepted. (*...*) import Capacity IntOrder Bigreal RealOrder BRA. @@ -201,7 +201,7 @@ section. + by move=> &m;auto;rewrite /in_dom_with. (* auto=> |>. (* Bug ???? *) *) auto;progress. - + by apply DWord.cdistr_ll. + + by apply DWord.dunifin_ll. + rewrite /inv_ext1=>/H{H}[->//|[/in_rng[h]Hh|[[x1 x2] h [Hx Hh]]]]. + case (h = (oget G1.mh{2}.[(x{2}.`1, hx2{2})]).`2)=> [->>|Hneq]. + by left;rewrite Hh oget_some. @@ -238,7 +238,7 @@ section. + inline *;rcondt{2} 4. + by move=> &m;auto;rewrite /in_dom_with. auto;progress. - + by apply DWord.cdistr_ll. + + by apply DWord.dunifin_ll. + rewrite /inv_ext1=>/H{H}[->//|[/in_rng[h]Hh|[[x1 x2] h [Hx Hh]]]]. + case (h = (oget G1.mhi{2}.[(x{2}.`1, hx2{2})]).`2)=> [->>|Hneq]. + by left;rewrite Hh oget_some. @@ -557,7 +557,7 @@ section EXT. rcondt{2} 5;1:by auto;smt w=(sizeE size_ge0). rcondt{2} 10. by auto;progress;rewrite dom_set !inE. wp;rnd{2};auto=> /= ??[#]!-> @/inv_lt @/inv_le [#] mlt milt clt cle Hin 3?->/=. - rewrite DWord.cdistr_ll /= => ? _;rewrite /bad_ext !getP /= !oget_some /= set_set_eq /=. + rewrite DWord.dunifin_ll /= => ? _;rewrite /bad_ext !getP /= !oget_some /= set_set_eq /=. rewrite !(imageU,inE) restr_set /= size_rem dom_restr Hin //=; smt w=size_set_le. by call RROset_inv_lt;auto;smt w=size_set_le. @@ -579,7 +579,7 @@ section EXT. rcondt{2} 5;1:by auto;smt w=(sizeE size_ge0). rcondt{2} 10. by auto;progress;rewrite dom_set !inE. wp;rnd{2};auto=> /= ??[#]!-> @/inv_lt @/inv_le [#] mlt milt clt cle Hin 3?->/=. - rewrite DWord.cdistr_ll /= => ? _;rewrite /bad_ext !getP /= !oget_some /= set_set_eq /=. + rewrite DWord.dunifin_ll /= => ? _;rewrite /bad_ext !getP /= !oget_some /= set_set_eq /=. rewrite !(imageU,inE) restr_set /= size_rem dom_restr Hin //=; smt w=size_set_le. by call RROset_inv_lt;auto;smt w=size_set_le. @@ -622,22 +622,24 @@ section EXT. wp; rnd (mem (image snd (dom G1.m `|` dom G1.mi ))); skip=> /> &hr ? ? -> /= ? ?. rewrite (Mu_mem.mu_mem (image snd (dom G1.m{hr} `|` dom G1.mi{hr})) - cdistr (1%r/(2^c)%r))//. - + by move=>x _;apply DWord.cdistr1E. - apply ler_wpmul2r;1:by apply divr_ge0=>//;apply /c_ge0r. + cdistr (1%r/(2^c)%r))//. + + by move=>x _;rewrite DWord.dunifin1E cap_card. + rewrite ler_wpmul2r;1:by apply divr_ge0=>//;apply /c_ge0r. rewrite imageU fcardU le_fromint. move:(fcard_image_leq snd (dom G1.m{hr}))(fcard_image_leq snd (dom G1.mi{hr})). by rewrite -!sizeE;smt w=fcard_ge0. + + rewrite/#. + by move=>c1;proc;auto=> &hr [^H 2->]/#. + by move=> b1 c1;proc;auto=> /#. + proc;rcondt 2;1:by auto. wp;rnd (mem (image snd (dom G1.m `|` dom G1.mi) `|` fset1 x));skip=> /> &hr ??-> /= ??. rewrite (Mu_mem.mu_mem (image snd (dom G1.m{hr}`|`dom G1.mi{hr}) `|` fset1 x{hr}) cdistr (1%r/(2^c)%r))//. - + by move=>x _;apply DWord.cdistr1E. - apply ler_wpmul2r;1:by apply divr_ge0=>//;apply /c_ge0r. + + by move=>x _;rewrite DWord.dunifin1E cap_card. + rewrite ler_wpmul2r;1:by apply divr_ge0=>//;apply /c_ge0r. rewrite imageU !fcardU le_fromint fcard1. move:(fcard_image_leq snd (dom G1.m{hr}))(fcard_image_leq snd (dom G1.mi{hr})). by rewrite -!sizeE;smt w=fcard_ge0. + + rewrite/#. + by move=>c1;proc;auto=> &hr [^H 2->]/#. move=> b1 c1;proc;auto=> /#. qed. diff --git a/proof/core/Handle.eca b/proof/core/Handle.eca index 0905386..9fb10b9 100644 --- a/proof/core/Handle.eca +++ b/proof/core/Handle.eca @@ -1,5 +1,5 @@ pragma -oldip. pragma +implicits. -require import Pred Fun Option Pair Int Real StdOrder Ring NewLogic. +require import Core Int Real StdOrder Ring IntExtra. require import List FSet NewFMap Utils Common SLCommon RndO. require import DProd Dexcepted. (*...*) import Capacity IntOrder. @@ -10,7 +10,7 @@ clone import GenEager as ROhandle with type from <- handle, type to <- capacity, op sampleto <- fun (_:int) => cdistr - proof sampleto_ll by apply DWord.cdistr_ll. + proof sampleto_ll by apply DWord.dunifin_ll. module G1(D:DISTINGUISHER) = { var m, mi : smap @@ -431,7 +431,7 @@ split=> [xa0 xc0 ya0 yc0|xa0 hx0 ya0 hy0]; rewrite getP. by exists hx0 fx0 hy0 fy0; rewrite !getP /#. case: ((xa0,hx0) = (xa,hx))=> [[#] <*>> [#] <<*>|] /=. + by exists xc f yc f'; rewrite !getP /= /#. -rewrite anda_and=> /negb_and xahx0_neq_xahx /Hmh_m [xc0 fx0 yc0 fy0] [#] hs_hx0 hs_hy0 Pm_xaxc0. +rewrite andaE=> /negb_and xahx0_neq_xahx /Hmh_m [xc0 fx0 yc0 fy0] [#] hs_hx0 hs_hy0 Pm_xaxc0. exists xc0 fx0 yc0 fy0; rewrite !getP; do !split=> [/#|/#|/=]. move: xahx0_neq_xahx; case: (xa0 = xa)=> [/= <*>>|//=]; case: (xc0 = xc)=> [<*>>|//=]. by move: hs_hx=> /(Hhuniq _ _ _ _ hs_hx0). @@ -451,7 +451,7 @@ move=> [] Hm_mh Hmh_m yc_notin_rng1_hs hs_hx hs_hy; split. by exists hy0 fy0 hx0 fx0; rewrite !getP /#. move=> ya0 hy0 xa0 hx0; rewrite getP; case: ((ya0,hy0) = (ya,hy))=> [[#] <*>> [#] <<*>|]. + by exists yc fy xc fx; rewrite !getP //= /#. -rewrite /= anda_and=> /negb_and yahy0_neq_yahy /Hmh_m [yc0 fy0 xc0 fx0] [#] hs_hy0 hs_hx0 mi_yayc0. +rewrite /= andaE=> /negb_and yahy0_neq_yahy /Hmh_m [yc0 fy0 xc0 fx0] [#] hs_hy0 hs_hx0 mi_yayc0. exists yc0 fy0 xc0 fx0; rewrite !getP; do !split=> [/#|/#|]. move: yahy0_neq_yahy; case: (ya0 = ya)=> [<<*> //=|/#]; case: (yc0 = yc)=> [<*>> /=|//=]. by move: hs_hy0; rewrite yc_notin_rng1_hs. @@ -1061,7 +1061,7 @@ split. case: {-1}(Gmi.[(ya,yc)]) (eq_refl Gmi.[(ya,yc)])=> [//|[xa' xc']]. have /incli_of_INV + ^h - <- := HINV; 1:by rewrite h. move: Pm_xaxc; have [] -> -> /= := inv_mh_inv_Pm hs Pm Pmi mh mhi _ _ _; first 3 by case: HINV. - rewrite anda_and -negP=> [#] <<*>. + rewrite andaE -negP=> [#] <<*>. move: h; have /invG_of_INV [] <- := HINV. by rewrite Gm_xaxc. + by case: HINV. @@ -1288,8 +1288,8 @@ case @[ambient]: {-1}(Gmi.[(xa,xc)]) (eq_refl Gmi.[(xa,xc)])=> [|[ya' yc'] ^] Gm have ^/inv_of_INV [] <- /mh_of_INV [] H _ _ /H {H} := inv0. move=> [? ? ? ?] [#]; rewrite hs_hx hs_hy=> /= [#] <<*> [#] <<*>. case: fx hs_hx=> hs_hx /= => [_|[#]]; first by exists hx. - by have /invG_of_INV [] -> := inv0; rewrite Gmi_xaxc. - smt (Block.DWord.bdistr_uf Capacity.DWord.cdistr_uf). + by have /invG_of_INV [] -> := inv0; rewrite Gmi_xaxc. print Block.DBlock. + smt (@Block.DBlock @Capacity.DWord). have /incli_of_INV <- := inv0; 1:by rewrite Gmi_xaxc. rewrite Pmi_xaxc=> /= [#] <<*>. rcondf{2} 1; 1:by auto=> &hr [#] <<*>; rewrite in_dom Gmi_xaxc. @@ -1329,10 +1329,10 @@ proof. (INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} /\ F.RO.m.[p]{2} = Some sa{1})));last first. + case : (! (G1.bcol{2} \/ G1.bext{2})); - 2: by conseq (_:_ ==> true)=> //; inline *;auto;rewrite Block.DWord.bdistr_ll. + 2: by conseq (_:_ ==> true)=> //; inline *;auto;rewrite Block.DBlock.dunifin_ll. inline *; rcondf{2} 3. + by move=> &m;auto=> &hr [#] H /H[_ H1] ??;rewrite in_dom H1. - by auto=> /> &m1 &m2;rewrite Block.DWord.bdistr_ll /= => H /H [-> ->];rewrite oget_some. + by auto=> /> &m1 &m2;rewrite Block.DBlock.dunifin_ll /= => H /H [-> ->];rewrite oget_some. while ( p{1} = (drop i p){2} /\ (0 <= i <= size p){2} /\ (!(G1.bcol{2} \/ G1.bext{2}) => @@ -1364,7 +1364,7 @@ proof. by have := size_drop (i{m2} + 1) p{m2};case (drop (i{m2} + 1) p{m2}) => //= [/#| ];smt w=size_ge0. case ((G1.bcol{2} \/ G1.bext{2})). + wp;conseq (_: _ ==> (G1.bcol{2} \/ G1.bext{2}))=> //. - by if{1};if{2};auto;2:(swap{2} 4 -3;auto); smt w=(Block.DWord.bdistr_ll DWord.cdistr_ll). + by if{1};if{2};auto;2:(swap{2} 4 -3;auto); smt w=(Block.DBlock.dunifin_ll DWord.dunifin_ll). conseq (_: (x{1} = (sa{1} +^ head witness p{1}, sc{1}) /\ (p{1} = drop i{2} p{2} /\ 0 <= i{2} <= size p{2} /\ @@ -1416,7 +1416,7 @@ proof. move=> Heq Hdom y1L-> /= y2L-> /=. have -> /= : i{m2} + 1 <> 0 by smt (). rewrite !getP_eq !oget_some /=. - pose p' := (take (i{m2} + 1) p{m2});rewrite -!nor=> [#] ? /= Hy2 ?. + pose p' := (take (i{m2} + 1) p{m2});rewrite/==> [#] ? /=. split;last first. + split;1: by exists Unknown. rewrite /p' (@take_nth witness) 1:// build_hpath_prefix. @@ -1424,7 +1424,7 @@ proof. rewrite /sa' getP_eq /=;apply build_hpath_up => //. by move: Hdom;rewrite Heq /sa' in_dom. have Hy1L := ch_notin_dom2_mh _ _ _ y1L G1.chandle{m2} Hmmhi Hhs. - have := hinvP FRO.m{m2} y2L;rewrite Hy2 /= => Hy2L. + have := hinvP FRO.m{m2} y2L;rewrite /= => Hy2L. have g1_sa' : G1.mh{m2}.[(sa', h{m2})] = None by move: Hdom;rewrite Heq in_dom. case :Hsc => f Hsc; have Hh := dom_hs_neq_ch _ _ _ _ _ Hhs Hsc. have Hch : FRO.m{m2}.[G1.chandle{m2}] = None. @@ -1432,7 +1432,7 @@ proof. by case {-1}(FRO.m{m2}.[G1.chandle{m2}]) (eq_refl (FRO.m{m2}.[G1.chandle{m2}])) => // ? /H. have Hy2_mi: ! mem (dom PF.mi{m1}) (y1L, y2L). + rewrite in_dom;case {-1}( PF.mi{m1}.[(y1L, y2L)]) (eq_refl (PF.mi{m1}.[(y1L, y2L)])) => //. - by move=> [] ??;case Hmmhi=> H _ /H [] ????;rewrite Hy2L. + by move=> [] ??;case Hmmhi=> H _ /H [] ????/#. have ch_0 := ch_neq0 _ _ Hhs. have ch_None : forall xa xb ha hb, G1.mh{m2}.[(xa,ha)] = Some(xb, hb) => @@ -1440,10 +1440,10 @@ proof. + move=> xa xb ha hb;case Hmmh=> _ H /H [xc fx yc fy [#]]. by move=> /(dom_hs_neq_ch _ _ _ _ _ Hhs) -> /(dom_hs_neq_ch _ _ _ _ _ Hhs). split=> //. - + by apply hs_addh => // ??;apply Hy2L. + + by apply hs_addh => // ??/#. + by apply inv_addm. + by apply (m_mh_addh_addm f) => //;case Hhs. - + by apply (mi_mhi_addh_addmi f)=> // ??;apply Hy2L. + + by apply (mi_mhi_addh_addmi f)=> // ??/#. + by apply incl_upd_nin. + by apply incl_upd_nin. + case (Hmh)=> H1 H2 H3;split. @@ -1674,7 +1674,7 @@ section AUX. auto => &m1 &m2 [#] !<- _ _ -> /= _ y1L -> y2L -> /=. rewrite !getP_eq pi_x2 !oget_some /=. have /hs_of_INV [] Hu _ _:= inv0; have -> := huniq_hinvK_h _ _ _ Hu hs_hx2. - rewrite oget_some -!nor => /= -[] ? Hy2L [*]. + rewrite oget_some => /= ? Hy2L . case:inv0=> Hhs Hinv HinvG Hmmh Hmmhi Hincl Hincli Hmh Hpi. have Hhx2:= dom_hs_neq_ch _ _ _ _ _ Hhs hs_hx2. have mh_hx2: G1mh.[(x1,hx2)] = None. @@ -1689,11 +1689,11 @@ section AUX. + apply inv_addm=> //; case: {-1}(G1mi.[(y1L,y2L)]) (eq_refl G1mi.[(y1L,y2L)])=> //. move=> [x1L x2L] ^G1mi_y; rewrite -Hincli 1:G1mi_y//. case: Hmmhi Hy2L => H _ + /H {H} [hx fx hy fy] [#]. - by case: (hinvP hs0 y2L)=> [_ ->|//]. + by case: (hinvP hs0 y2L)=> [_ ->|//]/#. + by apply inv_addm=>//; apply (ch_notin_dom2_mh _ _ Hmmhi Hhs). + by apply (m_mh_addh_addm _ Hmmh _ hs_hx2)=>//;apply ch_notin_dom_hs. + apply (mi_mhi_addh_addmi _ Hmmhi _ hs_hx2);last by apply ch_notin_dom_hs. - by have := hinvP hs0 y2L;rewrite Hy2L /#. + by have := hinvP hs0 y2L;rewrite /#. + by apply incl_addm. + by apply incl_addm. + split. + move=> xa hx ya hy;rewrite getP;case ((xa, hx) = (x1, hx2))=> /=. @@ -1747,7 +1747,7 @@ section AUX. move=> [h []];rewrite getP build_hpath_upd_ch_iff //. case (h=ch0)=> [->> /= [??[# H1 -> ->]]| Hh] /=. + by case Hmh => _ _ /(_ _ _ _ _ _ Hpath H1). - by have := hinvP hs0 y2L;rewrite Hy2L /= => ->. + by have := hinvP hs0 y2L;rewrite /= => /#. case Hpi => ->;apply exists_iff => h /=. rewrite build_hpath_upd_ch_iff // getP;case (h = ch0) => [->> | //]. split;1: by move=> [_ /(dom_hs_neq_ch _ _ _ _ _ Hhs)]. @@ -1782,7 +1782,7 @@ section AUX. + by have /hs_of_INV []:= inv0. by rewrite /in_dom_with in_dom hs_hy2. rcondt{2} 14; first by auto=> &hr [#] !<<- _ _ ->> _ /=; rewrite in_dom pi_x2. - auto=> &1 &2 [#] !<<- -> -> ->> _ /=; rewrite Block.DWord.bdistr_ll Capacity.DWord.cdistr_ll /=. + auto=> &1 &2 [#] !<<- -> -> ->> _ /=; rewrite Block.DBlock.dunifin_ll Capacity.DWord.dunifin_ll /=. move=> _ _ _ _; rewrite PFm_x1x2 pi_x2 !oget_some //=. rewrite (@huniq_hinvK_h hx2 hs0 x2) // ?oget_some. + by have /hs_of_INV []:= inv0. @@ -1790,37 +1790,38 @@ section AUX. exact/(@lemma3 _ _ _ _ _ _ _ _ _ _ _ _ hx2 _ _ hy2). (* lossless PF.f *) + move=> &2 _; proc; if=> //=; wp; rnd predT; rnd predT; auto. - smt (Block.DWord.bdistr_uf Capacity.DWord.cdistr_uf). + smt (@Block.DBlock @Capacity.DWord). (* lossless and do not reset bad G1.S.f *) + move=> _; proc; if; auto. conseq (_: _ ==> G1.bcol \/ G1.bext); 1:smt (). inline *; if=> //=; wp; rnd predT; wp; rnd predT; auto. - + smt (Block.DWord.bdistr_uf Capacity.DWord.cdistr_uf). - smt (Block.DWord.bdistr_uf Capacity.DWord.cdistr_uf). + + smt (@Block.DBlock @Capacity.DWord). + smt (@Block.DBlock @Capacity.DWord). (** proofs for G1.S.fi *) (* equiv PF.P.fi G1.S.fi *) + by conseq (eq_fi D)=> /#. (* lossless PF.P.fi *) + move=> &2 _; proc; if=> //=; wp; rnd predT; rnd predT; auto. - smt (Block.DWord.bdistr_uf Capacity.DWord.cdistr_uf). + smt (@Block.DBlock @Capacity.DWord). (* lossless and do not reset bad G1.S.fi *) + move=> _; proc; if; 2:by auto. - by wp; do 2!rnd predT; auto => &hr [#]; smt (Block.DWord.bdistr_uf Capacity.DWord.cdistr_uf). + by wp; do 2!rnd predT; auto => &hr [#]; smt (@Block.DBlock @Capacity.DWord). (** proofs for G1.C.f *) (* equiv PF.C.f G1.C.f *) + proc. + inline*;sp. admit. (* this is false *) (* lossless PF.C.f *) + move=> &2 _; proc; inline *; while (true) (size p); auto. + sp; if; 2:by auto; smt (size_behead). - by wp; do 2!rnd predT; auto; smt (size_behead Block.DWord.bdistr_uf Capacity.DWord.cdistr_uf). + by wp; do 2!rnd predT; auto; smt (size_behead @Block.DBlock @Capacity.DWord). smt (size_ge0). (* lossless and do not reset bad G1.C.f *) + move=> _; proc; inline *; wp; rnd predT; auto. while (G1.bcol \/ G1.bext) (size p - i)=> [z|]. + if; 1:by auto=> /#. wp; rnd predT; wp; rnd predT; auto. - smt (Block.DWord.bdistr_uf Capacity.DWord.cdistr_uf). - by auto; smt (Block.DWord.bdistr_uf Capacity.DWord.cdistr_uf). + smt (@Block.DBlock @Capacity.DWord). + by auto; smt (@Block.DBlock @Capacity.DWord). (* Init ok *) inline *; auto=> />; split=> [|/#]. (do !split; last 3 smt (getP map0P build_hpath_map0)); last 5 by move=> ? ? ? ?; rewrite map0P. diff --git a/proof/core/SLCommon.ec b/proof/core/SLCommon.ec index 01ac9dc..d46259d 100644 --- a/proof/core/SLCommon.ec +++ b/proof/core/SLCommon.ec @@ -2,7 +2,7 @@ functionality is a fixed-output-length random oracle whose output length is the input block size. We prove its security even when padding is not prefix-free. **) -require import Pred Fun Option Pair Int Real StdOrder Ring. +require import Core Int Real StdOrder Ring. require import List FSet NewFMap Utils Common RndO DProd Dexcepted. require (*..*) Indifferentiability. @@ -33,12 +33,11 @@ op bl_univ = FSet.oflist bl_enum. (* -------------------------------------------------------------------------- *) (* Random oracle from block list to block *) - clone import RndO.GenEager as F with type from <- block list, type to <- block, op sampleto <- fun (_:block list)=> bdistr - proof * by exact Block.DWord.bdistr_ll. + proof * by exact Block.DBlock.dunifin_ll. (** We can now define the squeezeless sponge construction **) module SqueezelessSponge (P:DPRIMITIVE): FUNCTIONALITY = { @@ -124,11 +123,11 @@ inductive build_hpath_spec mh p v h = lemma build_hpathP mh p v h: build_hpath mh p = Some (v,h) <=> build_hpath_spec mh p v h. proof. -elim/last_ind: p v h=> @/build_hpath //= [v h|p b ih v h]. -+ by rewrite anda_and; split=> [!~#] <*>; [exact/Empty|move=> [] /#]. +elim/last_ind: p v h=> @/build_hpath //= [v h|p b ih v h]. ++ by rewrite andaE; split=> [!~#] <*>; [exact/Empty|move=> [] /#]. rewrite -{1}cats1 foldl_cat {1}/step_hpath /=. case: {-1}(foldl _ _ _) (eq_refl (foldl (step_hpath mh) (Some (b0,0)) p))=> //=. -+ apply/NewLogic.implybN; case=> [/#|p' b0 v' h']. ++ apply/implybN; case=> [/#|p' b0 v' h']. move=> ^/rconssI <<- {p'} /rconsIs ->> {b}. by rewrite /build_hpath=> ->. move=> [v' h']; rewrite oget_some /= -/(build_hpath _ _)=> build. @@ -355,7 +354,7 @@ proof. cut @/pred1@/(\o)/=[[h []->[]Hmem <<-]|[]->H h f]/= := findP (fun (_ : handle) => pred1 c \o fst) handles. + by exists (oget handles.[h]).`2;rewrite oget_some get_oget;2:case (oget handles.[h]). - by rewrite -not_def=> Heq; cut := H h;rewrite in_dom Heq. + cut := H h;rewrite in_dom/#. qed. lemma huniq_hinv (handles:handles) (h:handle): @@ -374,7 +373,7 @@ proof. rewrite /hinvK. cut @/pred1/= [[h]|][->/=]:= findP (+ pred1 c) (restr Known handles). + by rewrite oget_some in_dom restrP;case (handles.[h])=>//= /#. - by move=>+h-/(_ h);rewrite in_dom restrP -!not_def=> H1 H2;apply H1;rewrite H2. + by move=>+h-/(_ h);rewrite in_dom restrP => H1/#. qed. lemma huniq_hinvK (handles:handles) c: @@ -394,5 +393,3 @@ qed. (* -------------------------------------------------------------------------- *) (** The initial Game *) module GReal(D:DISTINGUISHER) = RealIndif(SqueezelessSponge, PC(Perm), D). - - diff --git a/proof/core/Utils.ec b/proof/core/Utils.ec index 549d1ac..3f2b506 100644 --- a/proof/core/Utils.ec +++ b/proof/core/Utils.ec @@ -1,5 +1,5 @@ (** These should make it into the standard libs **) -require import Option Pair List FSet NewFMap. +require import Core List FSet NewFMap. (* -------------------------------------------------------------------- *) (* In NewFMap *) @@ -24,7 +24,6 @@ proof. by move=> y; rewrite getE mem_assoc_uniq 1:uniq_keys. qed. -require import Fun. lemma reindex_injective_on (f : 'a -> 'c) (m : ('a, 'b) fmap): (forall x y, mem (dom m) x => f x = f y => x = y) => From db9b549f3a094be3311f6c44dfb6190ed1c35e3b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Tue, 9 Jan 2018 18:16:43 +0100 Subject: [PATCH 252/525] . --- proof/clean/BlockSponge.eca | 321 ++++++++++++++++++++++++++++++++++-- 1 file changed, 303 insertions(+), 18 deletions(-) diff --git a/proof/clean/BlockSponge.eca b/proof/clean/BlockSponge.eca index 80675ae..00f2d31 100644 --- a/proof/clean/BlockSponge.eca +++ b/proof/clean/BlockSponge.eca @@ -138,22 +138,22 @@ pred INV (mc : (block list,block) fmap) (mb : (block list * int,block) fmap) = forall p, mc.[p] = mb.[parse p]. (* Constructed Distinguisher *) -module (LoDist (D : DISTINGUISHER) : Low.DISTINGUISHER) - (F : Low.DFUNCTIONALITY) (P : Low.DPRIMITIVE) = { +module (HiDist (D : Low.DISTINGUISHER) : DISTINGUISHER) + (F : DFUNCTIONALITY) (P : DPRIMITIVE) = { module HiF = { - proc f(p : block list) = { + proc f(p : block list, n : int) = { var r <- []; var b <- b0; - var x,n; + var i <- 1; - - (x,n) <- parse p; - - if (valid x /\ 0 < n) { - r <@ F.f(x,n); - b <- last b0 r; + if (valid p /\ 0 < n) { + while(i <= n) { + b <@ F.f(format p i); + r <- rcons r b; + i <- i + 1; + } } - return b; + return r; } } @@ -163,18 +163,288 @@ module (LoDist (D : DISTINGUISHER) : Low.DISTINGUISHER) (*** PROOF forall P D S, - LoDist(D)^{Core(P),P} ~ LoDist(D)^{ICore,S(ICore)} - => D^{BlockSponge(P),P} ~ D^{IBlockSponge,HiSim(S)(IBlockSponge)} ***) + HiDist(D)^{BlockSponge(P),P} ~ HiDist(D)^{IBlockSponge,HiSim(S)(IBlockSponge)} + => D^{Core(P),P} ~ D^{ICore,S(ICore)} ***) section PROOF. declare module P : PRIMITIVE { Low.ICORE, IBlockSponge, HiSim }. declare module S : Low.SIMULATOR { Low.ICORE, IBlockSponge, HiSim, P }. - declare module D : DISTINGUISHER { Low.ICORE, IBlockSponge, HiSim, P, S }. + declare module D : Low.DISTINGUISHER { Low.ICORE, IBlockSponge, HiSim, P, S }. + + + + (* FIXME : is this the eager we want ? *) + local module EagerCORE (P : Low.PRIMITIVE) : Low.FUNCTIONALITY = { + var order : block list + var capa : capacity + var blo : block + proc init() = { + order <- []; + capa <- c0; + blo <- b0; + CORE(P).init(); + } + proc f (p : block list, n : int) = { + var r : block list; + var i : int; + + (blo,capa) <- (b0,c0); + r <- []; + i <- 0; + if (valid p /\ 0 < n) { + while(i < size p) { + (blo,capa) <@ P.f(blo +^ nth witness p i, capa); + i <- i + 1; + } + i <- 1; + order <- p; + r <- rcons r blo; + while (i < n) { + (blo,capa) <@ P.f(blo,capa); + order <- rcons order b0; + r <- rcons r blo; + i <- i + 1; + } + } + return r; + } + proc ewhile() = { + var i : int <- 0; + while(i < size order) { + (blo,capa) <@ P.f(blo +^ nth witness order i,capa); + i <- i + 1; + } + } + }. + + lemma core_blocksponge &m : + Pr[Low.Indif(CORE(P),P,D).main() @ &m: res] = + Pr[Indif(BlockSponge(P),P,HiDist(D)).main() @ &m: res]. + proof. + (* cut->: *) + (* Pr[Low.Indif(EagerCORE(P),P,D).main() @ &m: res] = *) + (* Pr[Low.Indif(CORE(P),P,D).main() @ &m: res]. *) + byequiv(: ={glob D, glob P} ==>_)=>//=;proc. + call (_: ={glob P}); first 2 by sim. + + proc=> /=; sp;if=>//=. + inline*;sp;wp. + (* eager part *) + admit. + + by inline*;auto;call(:true);auto. + qed. + + + + lemma icore_iblocksponge &m : + Pr[Low.Indif(ICORE,S(ICORE),D).main() @ &m: res] = + Pr[Indif(IBlockSponge,HiSim(S,IBlockSponge),HiDist(D)).main() @ &m: res]. + proof. + byequiv(: ={glob D, glob S} ==>_)=>//=;proc. + call (_: ={glob S} /\ INV IBlockSponge.m{2} ICORE.m{1}). + + proc (INV IBlockSponge.m{2} ICORE.m{1})=> //. + proc=> /=; sp;if=> [&1 &2 [#] <*>| |] //=. + inline{2} 1.1. + inline*. + while( INV IBlockSponge.m{2} ICORE.m{1} + /\ 0 < i{1} <= n{1} + 1 + /\ ={n,p,r,i} + /\ valid p{1} + /\ 0 < n{1} + /\ (forall j, 0 < j < i{1} => + format p{2} j \in dom IBlockSponge.m{2}));last auto=>/#. + rcondt{2}5;auto;1:smt(parseK). + swap{2}6-1;sp. + conseq(:_==> INV IBlockSponge.m{2} ICORE.m{1} /\ + (forall j, 0 < j <= n0{1} => + format p0{1} j \in dom IBlockSponge.m{2}));1:smt(parseK formatK). + conseq(: INV IBlockSponge.m{2} ICORE.m{1} /\ (forall (j : int), + 0 < j < n0{1} => format p0{1} j \in dom IBlockSponge.m{2}) /\ + (p0,n0){1} = parse x1{2} /\ (x=x1){2} /\ ={p0,n0} /\ + n0{1} = i{2} /\ 0 <= i0{2} < i{2} + ==> _);1:smt(parseK formatK). + seq 1 1 : (INV IBlockSponge.m{2} ICORE.m{1} /\ 0 < n0{2} /\ + (forall (j : int), 0 < j <= n0{1} => + format p0{1} j \in dom IBlockSponge.m{2}) /\ + (p0,n0){1} = parse x1{2} /\ ={p0,n0} /\ (x=x1){2});last first. + + rcondf{2}1;auto;smt(parseK formatK). + splitwhile{2}1:(i0+1 + format p0{1} j \in dom IBlockSponge.m{2}) /\ + (p0,n0){1} = parse x1{2} /\ ={p0,n0} /\ (x=x1){2});last first. + + rcondt{2}1;1:auto=>/#;rcondf{2}4;1: by progress;sp;if;auto=>/#. + sp;if;auto;progress. + + rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. + cut->/=:!size p0{2} + i0{2} < size p0{2} by rewrite/#. + smt(in_dom formatK). + + move:H3;rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. + cut->/=:!size p0{2} + i0{2} < size p0{2} by rewrite/#. + smt(in_dom formatK). + + rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. + smt(getP parseK formatK). + + rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. + smt(in_dom getP parseK formatK). + + case(j=i0{2} + 1)=>//=;2:rewrite/#. + smt(in_dom getP parseK formatK). + while{2}((p0{2}, n0{2}) = parse x1{2} /\ (x=x1){2} /\ 0 <= i0{2} < n0{2} /\ + INV IBlockSponge.m{2} ICORE.m{1} /\ (p0,n0){1} = parse x1{2} /\ + ={p0,n0} /\ (forall (j : int), 0 < j < n0{2} => + format p0{2} j \in dom IBlockSponge.m{2}))(n0{2}-i0{2});progress. + + sp;rcondf 1;auto;progress. + + rewrite-(formatK x1{hr})-H3/=take_cat addzAC/=/=take_nseq/min/=. + cut->/=:!size p0{hr} + i0{hr} < size p0{hr} by rewrite/#. + by cut/#:=H4 (i0{hr}+1). + + by rewrite/#. + by rewrite/#. + by auto=>/#. + + + proc (INV IBlockSponge.m{2} ICORE.m{1})=> //. + proc=> /=; sp;if=> [&1 &2 [#] <*>| |] //=. + inline{2} 1.1. + inline*. + while( INV IBlockSponge.m{2} ICORE.m{1} + /\ 0 < i{1} <= n{1} + 1 + /\ ={n,p,r,i} + /\ valid p{1} + /\ 0 < n{1} + /\ (forall j, 0 < j < i{1} => + format p{2} j \in dom IBlockSponge.m{2}));last auto=>/#. + rcondt{2}5;auto;1:smt(parseK). + swap{2}6-1;sp. + conseq(:_==> INV IBlockSponge.m{2} ICORE.m{1} /\ + (forall j, 0 < j <= n0{1} => + format p0{1} j \in dom IBlockSponge.m{2}));1:smt(parseK formatK). + conseq(: INV IBlockSponge.m{2} ICORE.m{1} /\ (forall (j : int), + 0 < j < n0{1} => format p0{1} j \in dom IBlockSponge.m{2}) /\ + (p0,n0){1} = parse x1{2} /\ (x=x1){2} /\ ={p0,n0} /\ + n0{1} = i{2} /\ 0 <= i0{2} < i{2} + ==> _);1:smt(parseK formatK). + seq 1 1 : (INV IBlockSponge.m{2} ICORE.m{1} /\ 0 < n0{2} /\ + (forall (j : int), 0 < j <= n0{1} => + format p0{1} j \in dom IBlockSponge.m{2}) /\ + (p0,n0){1} = parse x1{2} /\ ={p0,n0} /\ (x=x1){2});last first. + + rcondf{2}1;auto;smt(parseK formatK). + splitwhile{2}1:(i0+1 + format p0{1} j \in dom IBlockSponge.m{2}) /\ + (p0,n0){1} = parse x1{2} /\ ={p0,n0} /\ (x=x1){2});last first. + + rcondt{2}1;1:auto=>/#;rcondf{2}4;1: by progress;sp;if;auto=>/#. + sp;if;auto;progress. + + rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. + cut->/=:!size p0{2} + i0{2} < size p0{2} by rewrite/#. + smt(in_dom formatK). + + move:H3;rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. + cut->/=:!size p0{2} + i0{2} < size p0{2} by rewrite/#. + smt(in_dom formatK). + + rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. + smt(getP parseK formatK). + + rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. + smt(in_dom getP parseK formatK). + + case(j=i0{2} + 1)=>//=;2:rewrite/#. + smt(in_dom getP parseK formatK). + while{2}((p0{2}, n0{2}) = parse x1{2} /\ (x=x1){2} /\ 0 <= i0{2} < n0{2} /\ + INV IBlockSponge.m{2} ICORE.m{1} /\ (p0,n0){1} = parse x1{2} /\ + ={p0,n0} /\ (forall (j : int), 0 < j < n0{2} => + format p0{2} j \in dom IBlockSponge.m{2}))(n0{2}-i0{2});progress. + + sp;rcondf 1;auto;progress. + + rewrite-(formatK x1{hr})-H3/=take_cat addzAC/=/=take_nseq/min/=. + cut->/=:!size p0{hr} + i0{hr} < size p0{hr} by rewrite/#. + by cut/#:=H4 (i0{hr}+1). + + by rewrite/#. + by rewrite/#. + by auto=>/#. + + + + proc=> /=; sp;if=> [&1 &2 [#] <*>| |] //=. + inline{2} 1.1. + inline*. + while( INV IBlockSponge.m{2} ICORE.m{1} + /\ 0 < i{1} <= n{1} + 1 + /\ ={n,p,r,i} + /\ valid p{1} + /\ 0 < n{1} + /\ (forall j, 0 < j < i{1} => + format p{2} j \in dom IBlockSponge.m{2}));last auto=>/#. + rcondt{2}5;auto;1:smt(parseK). + swap{2}6-1;sp. + conseq(:_==> INV IBlockSponge.m{2} ICORE.m{1} /\ + (forall (j : int), 0 < j <= i{2} => + format p{2} j \in dom IBlockSponge.m{2}));1:smt(formatK parseK). + seq 1 1 :(INV IBlockSponge.m{2} ICORE.m{1} /\ 0 < i{2} /\ + (forall (j : int), 0 < j <= i{2} => + format p{2} j \in dom IBlockSponge.m{2}) /\ + x1{2} = format p{2} i{2});last first. + + rcondf{2}1;auto=>/#. + conseq(:_==> INV IBlockSponge.m{2} ICORE.m{1} /\ + (forall (j : int), 0 < j <= i{2} => + format p{2} j \in dom IBlockSponge.m{2}));1:smt(formatK parseK). + if{1}. + + splitwhile{2}1:i0+1/#. + by while(i0 i0=n0-1 /\ IBlockSponge.m = m /\ p = p0 /\ i = n0);progress. + + by rewrite take_cat addzAC/=take_nseq/min/=;smt(in_dom formatK parseK). + conseq(:_==> i0=n0-1 /\ IBlockSponge.m = m);1:smt(formatK parseK). + while(0 <= i0 < n0 /\ (forall (j : int), 0 <= j < n0 - 1 => + take (size p0 + j) x \in dom m) /\ IBlockSponge.m = m);progress. + + rcondf 2;auto=>/#. + auto;progress;1,3:smt(formatK parseK). + rewrite take_cat addzAC/=take_nseq. + cut->/=:p0{hr}=p{hr} by smt(parseK formatK). + cut h:i{hr}=n0{hr} by smt(formatK parseK). + by rewrite h;cut/#:=H5 (j+1). + wp;rnd=>/=. + alias{2} 1 m = IBlockSponge.m;sp. + conseq(:_==> i0{2} = n0{2} - 1 /\ IBlockSponge.m{2} = m{2} /\ + x0{2} = format p{2} n0{2});1:smt(formatK parseK getP dom_set in_dom). + wp;conseq(:_==> i0{2} = n0{2} - 1 /\ m{2} = IBlockSponge.m{2});progress. + + rewrite take_cat addzAC/=take_nseq. + cut->/=:p0{2}=p{2} by smt(parseK formatK). + cut h:i{2}=n0{2} by smt(formatK parseK). + by rewrite h min_lel///format;smt(nseq0 cats0). + while{2}(0 <= i0{2} < n0{2} /\ (forall (j : int), 0 <= j < n0{2} - 1 => + take (size p0{2} + j) x{2} \in dom m{2}) /\ + IBlockSponge.m{2} = m{2})(n0{2}-i0{2}-1);progress. + + rcondf 2;auto=>/#. + auto;progress;1,3..:smt(formatK parseK). + rewrite take_cat addzAC/=take_nseq. + cut->/=:p0{2}=p{2} by smt(parseK formatK). + cut h:i{2}=n0{2} by smt(formatK parseK). + by rewrite h;cut/#:=H5 (j+1). + rewrite/=. + alias{2}1 m = IBlockSponge.m;sp. + conseq(:_==> m{2} = IBlockSponge.m{2});1:smt(in_dom formatK parseK). + while{2}(0 <= i0{2} <= n0{2} /\ (forall (j : int), 0 <= j < n0{2} => + take (size p0{2} + j) x{2} \in dom m{2}) /\ + IBlockSponge.m{2} = m{2})(n0{2}-i0{2});progress. + + rcondf 2;auto=>/#. + auto;progress;1,3..:smt(formatK parseK). + rewrite take_cat addzAC/=take_nseq. + cut->/=:p0{2}=p{2} by smt(parseK formatK). + cut h:i{2}=n0{2} by smt(formatK parseK). + rewrite h;case(j=0)=>[->/=|]. + + rewrite-take_nseq take0 cats0. + by cut/=:=H5 1;smt(in_dom parseK formatK nseq0 cats0). + cut->/=:!size p{2} + j < size p{2} by rewrite/#. + by cut:=H5 (j+1);smt(in_dom parseK formatK nseq0 cats0). + + by inline*;auto;call(:true);auto;smt(in_dom dom0 in_fset0). + qed. + + + lemma LiftInd &m: - `| Pr[Low.Indif(CORE(P),P,LoDist(D)).main() @ &m: res] - - Pr[Low.Indif(ICORE,S(ICORE),LoDist(D)).main() @ &m: res] | - = `| Pr[Indif(BlockSponge(P),P,D).main() @ &m: res] - - Pr[Indif(IBlockSponge,HiSim(S,IBlockSponge),D).main() @ &m: res] |. + `| Pr[Low.Indif(CORE(P),P,D).main() @ &m: res] + - Pr[Low.Indif(ICORE,S(ICORE),D).main() @ &m: res] | + = `| Pr[Indif(BlockSponge(P),P,HiDist(D)).main() @ &m: res] + - Pr[Indif(IBlockSponge,HiSim(S,IBlockSponge),HiDist(D)).main() @ &m: res] |. proof. do !congr. + byequiv (_: ={glob D, glob P} ==> _ )=> //=; proc. @@ -374,3 +644,18 @@ section PROOF. by inline*;auto;call(:true);auto;smt(in_dom dom0 in_fset0). qed. end section PROOF. + + +require import Gconcl. +print Gconcl. +print SLCommon.GReal. +print SLCommon.SqueezelessSponge. +print SLCommon.IdealIndif. +print SLCommon.RealIndif. +print SLCommon.DPRestr. +print SLCommon.DISTINGUISHER. +print DISTINGUISHER. +print SLCommon.DFUNCTIONALITY. +print SLCommon.DPRIMITIVE. +print DFUNCTIONALITY. +print DPRIMITIVE. \ No newline at end of file From 31ce208f3e81b56c2b5d1804e4c0d30e34f0c729 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Tue, 9 Jan 2018 17:28:48 -0500 Subject: [PATCH 253/525] Fix two typos in documentation. --- proof/Sponge.ec | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/proof/Sponge.ec b/proof/Sponge.ec index f812a3a..333ab74 100644 --- a/proof/Sponge.ec +++ b/proof/Sponge.ec @@ -513,7 +513,7 @@ lemma HybridIROExper_Lazy_Eager proof. by apply (HybridIROExper_Lazy_Eager' D &m). qed. (* turn a Hybrid IRO implementation (lazy or eager) into top-level - ideal functionality; its f procedure only uses IH.g *) + ideal functionality; its f procedure only uses HI.g *) module RaiseHybridIRO (HI : HYBRID_IRO) : FUNCTIONALITY = { proc init() = { @@ -710,7 +710,7 @@ auto; progress [-delta]; auto. qed. -(* invariant relating maps of HybridIROEager and BlockSponge.BIRO.IRO *) +(* invariant relating maps of BlockSponge.BIRO.IRO and HybridIROEager *) pred eager_invar (mp1 : (block list * int, block) fmap, From 0b4f1ae1591d0d668638dfcd38d5b67ba0f0c8a3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Wed, 10 Jan 2018 18:29:59 +0100 Subject: [PATCH 254/525] . --- proof/clean/BlockSponge.eca | 586 ++++++++++++++++++++++-------------- 1 file changed, 367 insertions(+), 219 deletions(-) diff --git a/proof/clean/BlockSponge.eca b/proof/clean/BlockSponge.eca index 00f2d31..bf27b16 100644 --- a/proof/clean/BlockSponge.eca +++ b/proof/clean/BlockSponge.eca @@ -1,8 +1,11 @@ require import Core Logic Distr. require import Int IntExtra Real List NewFMap FSet. +require (*--*) StdBigop. +(*---*) import StdBigop.Bigint. require import StdOrder. (*---*) import IntOrder. +print StdBigop. require import NewCommon. (*---*) import Block DBlock Capacity DCapacity. @@ -160,20 +163,71 @@ module (HiDist (D : Low.DISTINGUISHER) : DISTINGUISHER) proc distinguish = D(HiF,P).distinguish }. +print Low. + +module (C (P : PRIMITIVE) : PRIMITIVE) = { + var c : int + proc init() = { + c <- 0; + P.init(); + } + proc f(x) = { + var y; + c <- c + 1; + y <@ P.f(x); + return y; + } + proc fi(x) = { + var y; + c <- c + 1; + y <@ P.fi(x); + return y; + } +}. + +module DFCn (F : Low.FUNCTIONALITY) : Low.FUNCTIONALITY = { + proc init() = { + C.c <- 0; + F.init(); + } + proc f(bs,n) = { + var r : block list <- []; + if (valid bs /\ 0 < n) { + C.c <- C.c + sumid (size bs) (size bs + n); + r <@ F.f(bs,n); + } + return r; + } +}. + +module DFC1 (F : FUNCTIONALITY) : FUNCTIONALITY = { + proc init() = { + C.c <- 0; + F.init(); + } + proc f(x) = { + var b : block <- b0; + if (let (bs,n) = parse x in valid bs /\ 0 < n) { + C.c <- C.c + size x; + b <@ F.f(x); + } + return b; + } +}. (*** PROOF forall P D S, HiDist(D)^{BlockSponge(P),P} ~ HiDist(D)^{IBlockSponge,HiSim(S)(IBlockSponge)} => D^{Core(P),P} ~ D^{ICore,S(ICore)} ***) section PROOF. - declare module P : PRIMITIVE { Low.ICORE, IBlockSponge, HiSim }. - declare module S : Low.SIMULATOR { Low.ICORE, IBlockSponge, HiSim, P }. - declare module D : Low.DISTINGUISHER { Low.ICORE, IBlockSponge, HiSim, P, S }. + declare module P : PRIMITIVE { Low.ICORE, IBlockSponge, HiSim, C }. + declare module S : Low.SIMULATOR { Low.ICORE, IBlockSponge, HiSim, C, P }. + declare module D : Low.DISTINGUISHER { Low.ICORE, IBlockSponge, HiSim, C, P, S }. (* FIXME : is this the eager we want ? *) - local module EagerCORE (P : Low.PRIMITIVE) : Low.FUNCTIONALITY = { + local module EagerCORE (P : Low.PRIMITIVE) = { var order : block list var capa : capacity var blo : block @@ -199,8 +253,8 @@ section PROOF. order <- p; r <- rcons r blo; while (i < n) { - (blo,capa) <@ P.f(blo,capa); order <- rcons order b0; + (blo,capa) <@ P.f(blo,capa); r <- rcons r blo; i <- i + 1; } @@ -209,6 +263,8 @@ section PROOF. } proc ewhile() = { var i : int <- 0; + blo <- b0; + capa <- c0; while(i < size order) { (blo,capa) <@ P.f(blo +^ nth witness order i,capa); i <- i + 1; @@ -216,21 +272,111 @@ section PROOF. } }. - lemma core_blocksponge &m : - Pr[Low.Indif(CORE(P),P,D).main() @ &m: res] = - Pr[Indif(BlockSponge(P),P,HiDist(D)).main() @ &m: res]. + local module EagCORE (P : Low.PRIMITIVE) : Low.FUNCTIONALITY = { + proc init = EagerCORE(P).init + + + proc f (p : block list, n : int) = { + var r : block list; + var i : int; + + (EagerCORE.blo,EagerCORE.capa) <- (b0,c0); + r <- []; + i <- 0; + if (valid p /\ 0 < n) { + i <- 1; + EagerCORE.order <- p; + EagerCORE(P).ewhile(); + r <- rcons r EagerCORE.blo; + while (i < n) { + EagerCORE.order <- rcons EagerCORE.order b0; + EagerCORE(P).ewhile(); + r <- rcons r EagerCORE.blo; + i <- i + 1; + } + } + return r; + } + }. + + equiv core_blocksponge : + Low.Indif(DFCn(CORE(P)),C(P),D).main ~ + Indif(DFC1(BlockSponge(P)),C(P),HiDist(D)).main : + ={glob D, glob P} ==> ={res, C.c}. proof. - (* cut->: *) - (* Pr[Low.Indif(EagerCORE(P),P,D).main() @ &m: res] = *) - (* Pr[Low.Indif(CORE(P),P,D).main() @ &m: res]. *) - byequiv(: ={glob D, glob P} ==>_)=>//=;proc. - call (_: ={glob P}); first 2 by sim. - + proc=> /=; sp;if=>//=. - inline*;sp;wp. - (* eager part *) - admit. - - by inline*;auto;call(:true);auto. + transitivity Low.Indif(DFCn(EagerCORE(P)),C(P),D).main + (={glob D, glob P} ==> ={res, C.c}) + (={glob D, glob P} ==> ={res, C.c});progress;1:rewrite/#. + + proc=>/=;call (_: ={glob P, C.c}); first 2 by sim. + + proc=> /=;inline*;sp;if=>//=;sim;sp;if;progress;sim. + by while( ={i,p,glob P} /\ sc{1} = EagerCORE.capa{2} + /\ sa{1} = EagerCORE.blo{2});auto;call(:true);auto. + + by inline*;auto;call(:true);auto. + + transitivity Low.Indif(DFCn(EagCORE(P)),C(P),D).main + (={glob D, glob P} ==> ={res, C.c}) + (={glob D, glob P} ==> ={res, C.c});progress;1:rewrite/#. + + proc. + call (_: ={glob P, C.c}); first 2 by sim. + + proc=> /=; sp;if=>//=;inline{1}2;inline{2}2;sp;if;progress;2:auto. + swap{2}2;swap{1}3-2;sp;sim. + conseq(:_==> ={r0,glob P});progress. + replace{1} { while ; rest } by { + EagerCORE(P).ewhile(); + rest; + } + (={glob P, EagerCORE.order, r0, n0} /\ i{1} = 0 + /\ (EagerCORE.blo,EagerCORE.capa,EagerCORE.order){1} = (b0,c0,p{1}) + ==> ={r0, glob P}) + (={glob P,glob EagerCORE, n0,r0} ==> ={r0, glob P}); + progress;1:rewrite/#;first inline*;sim;auto;progress. + + (* eager part *) + admit. + + by inline*;auto;call(:true);auto. + + + + proc;call (_: ={glob P, C.c});..2:sim;last first. + + by inline*;auto;call(:true);auto. + proc=> /=; sp;if=>//=;sp;inline*;sp. + rcondt{1}1;1:auto=>/#;sp. + rcondt{2}1;1:(auto;smt(parseK formatK));sp. + rcondt{2}1;1:(auto;smt(parseK formatK));sp. + rcondt{2}1;1:(auto;smt(parseK formatK));sp;wp. + while( ={glob P,n} /\ (format p i){2} = rcons EagerCORE.order{1} b0 + /\ i{2} = i{1} + 1 /\ (sa,sc){2} = (EagerCORE.blo,EagerCORE.capa){1} + /\ valid p{2} /\ 0 < n{2} /\ 0 < i{1} /\ r0{1} = r{2} /\ n0{1} = n{2} + /\ C.c{1} = C.c{2} + sumid (size EagerCORE.order{1} + 1)(size p{2} + n{1}) + /\ 1 <= i{1} <= n0{1} + ). + + sp;rcondt{2}1;auto;1:smt(formatK parseK). + sp;rcondt{2}1;auto;1:smt(formatK parseK). + conseq(:_==> ={glob P,C.c} + /\ (sa,sc){2} = (EagerCORE.blo,EagerCORE.capa){1});progress. + + smt(rcons_cat nseqSr). + + smt(rcons_cat nseqSr). + + rewrite H0 size_rcons BIA.big_ltn_cond;2:rewrite/#. + by rewrite-(size_rcons _ b0)-H0 size_cat-addzA/=size_nseq/max H3/=/#. + + smt(rcons_cat nseqSr). + + smt(rcons_cat nseqSr). + + smt(rcons_cat nseqSr). + while(={glob P,C.c} /\ 0 <= i0{2} <= size p0{2} /\ (sa,sc,i0,p0){2} = + (EagerCORE.blo,EagerCORE.capa,i1,EagerCORE.order){1} + /\ i{2} = i{1} + 1 /\ n0{2} = i{2}); + auto;1:call(:true);auto;progress;..2,4..:smt(size_rcons size_ge0 formatK parseK). + admit. + + wp=>/=. + by while(={glob P,i0} /\ (sa,sc,p0){1} = + (EagerCORE.blo,EagerCORE.capa,EagerCORE.order){2}); + auto;1:call(:true);auto; + smt(nseq0 cats0 valid_spec size_ge0 size_eq0 nseq1 cats1). + + by inline*;auto;call(:true);auto. + + byequiv(: ={glob D, glob P} ==>_)=>//=; qed. @@ -440,209 +586,211 @@ section PROOF. - lemma LiftInd &m: - `| Pr[Low.Indif(CORE(P),P,D).main() @ &m: res] - - Pr[Low.Indif(ICORE,S(ICORE),D).main() @ &m: res] | - = `| Pr[Indif(BlockSponge(P),P,HiDist(D)).main() @ &m: res] - - Pr[Indif(IBlockSponge,HiSim(S,IBlockSponge),HiDist(D)).main() @ &m: res] |. - proof. - do !congr. - + byequiv (_: ={glob D, glob P} ==> _ )=> //=; proc. - call (_: ={glob P}); first 2 by sim. - + proc=> /=; sp;if=>//=;1:progress=>/#. - inline*;sp;wp. - rcondt{1}1;progress. - splitwhile{2}1: i < size x. - seq 3 1:( ={glob P,sa,sc,p} - /\ (x,n,p0,n0){1} = (x,n,x,n){2} - /\ valid x{1} - /\ i{2} = size x{2} - /\ i{1} = 1 - /\ r0{1} = [sa{1}] - /\ (x{2}, n{2}) = parse p{2} - /\ 0 < n{1}). - + wp;conseq(:_==> ={glob P,sa,sc,i,p,x,n} - /\ i{2} = size x{2} - /\ (x,n,p0,n0){1} = (x,n,x,n){2});progress. - while( ={glob P,sa,sc,i,p,x,n} - /\ (x{2}, n{2}) = parse p{2} - /\ (p0,n0){1} = (x,n){2} - /\ 0 <= i{2} <= size x{2} <= size p{2});auto;1:call(:true);auto;progress;2..9,-3..-1:smt(size_ge0). - + by rewrite-(formatK p{2})-H/=/format nth_cat H3. - + by rewrite-(formatK p{2})-H/=/format size_cat;smt(size_ge0). - by rewrite-(formatK p{2})-H/=/format size_cat;smt(size_ge0). - - while( ={glob P,sa,sc,p} - /\ i{1} - 1 = i{2} - size x{2} - /\ size x{2} <= i{2} <= size p{2} - /\ sa{1} = last b0 r0{1} - /\ (x{2}, n{2}) = parse p{2} - /\ (x{1}, n{1}) = parse p{1} - /\ valid x{1} - /\ 0 < n{1} - /\ size p{2} = size x{2} + n{2} - 1 - /\ n0{1} = n{2} - );auto;last first. - + progress. - + by rewrite-(formatK p{2})-H0/=/format size_cat size_nseq/#. - + by rewrite-(formatK p{2})-H0/=/format size_cat size_nseq/#. - + by rewrite-(formatK p{2})-H0/=/format size_cat size_nseq/#. - by move:H2;rewrite-(formatK p{2})-H0/=/format size_cat size_nseq/#. - - call(:true);auto;progress;2..5,-2..:smt(last_rcons). - rewrite -(formatK p{2})-H2/=/format nth_cat nth_nseq_if. - cut->//=:!i{2} < size x{2} by rewrite/#. - cut->//=: 0 <= i{2} - size x{2} by rewrite/#. - rewrite-H. - cut->/=:i{1} - 1 < n{2} - 1 by rewrite/#. - by rewrite BlockMonoid.addr0. +(* lemma LiftInd &m: *) +(* `| Pr[Low.Indif(CORE(P),P,D).main() @ &m: res] *) +(* - Pr[Low.Indif(ICORE,S(ICORE),D).main() @ &m: res] | *) +(* = `| Pr[Indif(BlockSponge(P),P,HiDist(D)).main() @ &m: res] *) +(* - Pr[Indif(IBlockSponge,HiSim(S,IBlockSponge),HiDist(D)).main() @ &m: res] |. *) +(* proof. *) +(* do !congr. *) +(* + byequiv (_: ={glob D, glob P} ==> _ )=> //=; proc. *) +(* call (_: ={glob P}); first 2 by sim. *) +(* + proc=> /=; sp;if=>//=;1:progress=>/#. *) +(* inline*;sp;wp. *) +(* rcondt{1}1;progress. *) +(* splitwhile{2}1: i < size x. *) +(* seq 3 1:( ={glob P,sa,sc,p} *) +(* /\ (x,n,p0,n0){1} = (x,n,x,n){2} *) +(* /\ valid x{1} *) +(* /\ i{2} = size x{2} *) +(* /\ i{1} = 1 *) +(* /\ r0{1} = [sa{1}] *) +(* /\ (x{2}, n{2}) = parse p{2} *) +(* /\ 0 < n{1}). *) +(* + wp;conseq(:_==> ={glob P,sa,sc,i,p,x,n} *) +(* /\ i{2} = size x{2} *) +(* /\ (x,n,p0,n0){1} = (x,n,x,n){2});progress. *) +(* while( ={glob P,sa,sc,i,p,x,n} *) +(* /\ (x{2}, n{2}) = parse p{2} *) +(* /\ (p0,n0){1} = (x,n){2} *) +(* /\ 0 <= i{2} <= size x{2} <= size p{2});auto;1:call(:true);auto;progress;2..9,-3..-1:smt(size_ge0). *) +(* + by rewrite-(formatK p{2})-H/=/format nth_cat H3. *) +(* + by rewrite-(formatK p{2})-H/=/format size_cat;smt(size_ge0). *) +(* by rewrite-(formatK p{2})-H/=/format size_cat;smt(size_ge0). *) + +(* while( ={glob P,sa,sc,p} *) +(* /\ i{1} - 1 = i{2} - size x{2} *) +(* /\ size x{2} <= i{2} <= size p{2} *) +(* /\ sa{1} = last b0 r0{1} *) +(* /\ (x{2}, n{2}) = parse p{2} *) +(* /\ (x{1}, n{1}) = parse p{1} *) +(* /\ valid x{1} *) +(* /\ 0 < n{1} *) +(* /\ size p{2} = size x{2} + n{2} - 1 *) +(* /\ n0{1} = n{2} *) +(* );auto;last first. *) +(* + progress. *) +(* + by rewrite-(formatK p{2})-H0/=/format size_cat size_nseq/#. *) +(* + by rewrite-(formatK p{2})-H0/=/format size_cat size_nseq/#. *) +(* + by rewrite-(formatK p{2})-H0/=/format size_cat size_nseq/#. *) +(* by move:H2;rewrite-(formatK p{2})-H0/=/format size_cat size_nseq/#. *) + +(* call(:true);auto;progress;2..5,-2..:smt(last_rcons). *) +(* rewrite -(formatK p{2})-H2/=/format nth_cat nth_nseq_if. *) +(* cut->//=:!i{2} < size x{2} by rewrite/#. *) +(* cut->//=: 0 <= i{2} - size x{2} by rewrite/#. *) +(* rewrite-H. *) +(* cut->/=:i{1} - 1 < n{2} - 1 by rewrite/#. *) +(* by rewrite BlockMonoid.addr0. *) - by inline*;auto;call(:true);auto. - - byequiv (_: ={glob D, glob S} ==> _)=> //=; proc. - call (_: ={glob S} /\ INV IBlockSponge.m{2} ICORE.m{1}). - + proc (INV IBlockSponge.m{2} ICORE.m{1})=> //. - proc=> /=; sp;if=> [&1 &2 [#] <*>| |] //=. - inline{2} 1.1. - inline*. - while( INV IBlockSponge.m{2} ICORE.m{1} - /\ 0 < i{1} <= n{1} + 1 - /\ ={n,p,r,i} - /\ valid p{1} - /\ 0 < n{1} - /\ (forall j, 0 < j < i{1} => - format p{2} j \in dom IBlockSponge.m{2}));last auto=>/#. - rcondt{2}5;auto;1:smt(parseK). - swap{2}6-1;sp. - conseq(:_==> INV IBlockSponge.m{2} ICORE.m{1} /\ - (forall j, 0 < j <= n0{1} => - format p0{1} j \in dom IBlockSponge.m{2}));1:smt(parseK formatK). - conseq(: INV IBlockSponge.m{2} ICORE.m{1} /\ (forall (j : int), - 0 < j < n0{1} => format p0{1} j \in dom IBlockSponge.m{2}) /\ - (p0,n0){1} = parse x1{2} /\ (x=x1){2} /\ ={p0,n0} /\ - n0{1} = i{2} /\ 0 <= i0{2} < i{2} - ==> _);1:smt(parseK formatK). - seq 1 1 : (INV IBlockSponge.m{2} ICORE.m{1} /\ 0 < n0{2} /\ - (forall (j : int), 0 < j <= n0{1} => - format p0{1} j \in dom IBlockSponge.m{2}) /\ - (p0,n0){1} = parse x1{2} /\ ={p0,n0} /\ (x=x1){2});last first. - + rcondf{2}1;auto;smt(parseK formatK). - splitwhile{2}1:(i0+1 - format p0{1} j \in dom IBlockSponge.m{2}) /\ - (p0,n0){1} = parse x1{2} /\ ={p0,n0} /\ (x=x1){2});last first. - + rcondt{2}1;1:auto=>/#;rcondf{2}4;1: by progress;sp;if;auto=>/#. - sp;if;auto;progress. - + rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. - cut->/=:!size p0{2} + i0{2} < size p0{2} by rewrite/#. - smt(in_dom formatK). - + move:H3;rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. - cut->/=:!size p0{2} + i0{2} < size p0{2} by rewrite/#. - smt(in_dom formatK). - + rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. - smt(getP parseK formatK). - + rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. - smt(in_dom getP parseK formatK). - + case(j=i0{2} + 1)=>//=;2:rewrite/#. - smt(in_dom getP parseK formatK). - while{2}((p0{2}, n0{2}) = parse x1{2} /\ (x=x1){2} /\ 0 <= i0{2} < n0{2} /\ - INV IBlockSponge.m{2} ICORE.m{1} /\ (p0,n0){1} = parse x1{2} /\ - ={p0,n0} /\ (forall (j : int), 0 < j < n0{2} => - format p0{2} j \in dom IBlockSponge.m{2}))(n0{2}-i0{2});progress. - + sp;rcondf 1;auto;progress. - + rewrite-(formatK x1{hr})-H3/=take_cat addzAC/=/=take_nseq/min/=. - cut->/=:!size p0{hr} + i0{hr} < size p0{hr} by rewrite/#. - by cut/#:=H4 (i0{hr}+1). - + by rewrite/#. - by rewrite/#. - by auto=>/#. +(* by inline*;auto;call(:true);auto. *) + +(* byequiv (_: ={glob D, glob S} ==> _)=> //=; proc. *) +(* call (_: ={glob S} /\ INV IBlockSponge.m{2} ICORE.m{1}). *) +(* + proc (INV IBlockSponge.m{2} ICORE.m{1})=> //. *) +(* proc=> /=; sp;if=> [&1 &2 [#] <*>| |] //=. *) +(* inline{2} 1.1. *) +(* inline*. *) +(* while( INV IBlockSponge.m{2} ICORE.m{1} *) +(* /\ 0 < i{1} <= n{1} + 1 *) +(* /\ ={n,p,r,i} *) +(* /\ valid p{1} *) +(* /\ 0 < n{1} *) +(* /\ (forall j, 0 < j < i{1} => *) +(* format p{2} j \in dom IBlockSponge.m{2}));last auto=>/#. *) +(* rcondt{2}5;auto;1:smt(parseK). *) +(* swap{2}6-1;sp. *) +(* conseq(:_==> INV IBlockSponge.m{2} ICORE.m{1} /\ *) +(* (forall j, 0 < j <= n0{1} => *) +(* format p0{1} j \in dom IBlockSponge.m{2}));1:smt(parseK formatK). *) +(* conseq(: INV IBlockSponge.m{2} ICORE.m{1} /\ (forall (j : int), *) +(* 0 < j < n0{1} => format p0{1} j \in dom IBlockSponge.m{2}) /\ *) +(* (p0,n0){1} = parse x1{2} /\ (x=x1){2} /\ ={p0,n0} /\ *) +(* n0{1} = i{2} /\ 0 <= i0{2} < i{2} *) +(* ==> _);1:smt(parseK formatK). *) +(* seq 1 1 : (INV IBlockSponge.m{2} ICORE.m{1} /\ 0 < n0{2} /\ *) +(* (forall (j : int), 0 < j <= n0{1} => *) +(* format p0{1} j \in dom IBlockSponge.m{2}) /\ *) +(* (p0,n0){1} = parse x1{2} /\ ={p0,n0} /\ (x=x1){2});last first. *) +(* + rcondf{2}1;auto;smt(parseK formatK). *) +(* splitwhile{2}1:(i0+1 *) +(* format p0{1} j \in dom IBlockSponge.m{2}) /\ *) +(* (p0,n0){1} = parse x1{2} /\ ={p0,n0} /\ (x=x1){2});last first. *) +(* + rcondt{2}1;1:auto=>/#;rcondf{2}4;1: by progress;sp;if;auto=>/#. *) +(* sp;if;auto;progress. *) +(* + rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. *) +(* cut->/=:!size p0{2} + i0{2} < size p0{2} by rewrite/#. *) +(* smt(in_dom formatK). *) +(* + move:H3;rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. *) +(* cut->/=:!size p0{2} + i0{2} < size p0{2} by rewrite/#. *) +(* smt(in_dom formatK). *) +(* + rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. *) +(* smt(getP parseK formatK). *) +(* + rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. *) +(* smt(in_dom getP parseK formatK). *) +(* + case(j=i0{2} + 1)=>//=;2:rewrite/#. *) +(* smt(in_dom getP parseK formatK). *) +(* while{2}((p0{2}, n0{2}) = parse x1{2} /\ (x=x1){2} /\ 0 <= i0{2} < n0{2} /\ *) +(* INV IBlockSponge.m{2} ICORE.m{1} /\ (p0,n0){1} = parse x1{2} /\ *) +(* ={p0,n0} /\ (forall (j : int), 0 < j < n0{2} => *) +(* format p0{2} j \in dom IBlockSponge.m{2}))(n0{2}-i0{2});progress. *) +(* + sp;rcondf 1;auto;progress. *) +(* + rewrite-(formatK x1{hr})-H3/=take_cat addzAC/=/=take_nseq/min/=. *) +(* cut->/=:!size p0{hr} + i0{hr} < size p0{hr} by rewrite/#. *) +(* by cut/#:=H4 (i0{hr}+1). *) +(* + by rewrite/#. *) +(* by rewrite/#. *) +(* by auto=>/#. *) + +(* + proc (INV IBlockSponge.m{2} ICORE.m{1})=> //. *) +(* proc=> /=; sp;if=> [&1 &2 [#] <*>| |] //=. *) +(* inline{2} 1.1. *) +(* inline*. *) +(* while( INV IBlockSponge.m{2} ICORE.m{1} *) +(* /\ 0 < i{1} <= n{1} + 1 *) +(* /\ ={n,p,r,i} *) +(* /\ valid p{1} *) +(* /\ 0 < n{1} *) +(* /\ (forall j, 0 < j < i{1} => *) +(* format p{2} j \in dom IBlockSponge.m{2}));last auto=>/#. *) +(* rcondt{2}5;auto;1:smt(parseK). *) +(* swap{2}6-1;sp. *) +(* conseq(:_==> INV IBlockSponge.m{2} ICORE.m{1} /\ *) +(* (forall j, 0 < j <= n0{1} => *) +(* format p0{1} j \in dom IBlockSponge.m{2}));1:smt(parseK formatK). *) +(* conseq(: INV IBlockSponge.m{2} ICORE.m{1} /\ (forall (j : int), *) +(* 0 < j < n0{1} => format p0{1} j \in dom IBlockSponge.m{2}) /\ *) +(* (p0,n0){1} = parse x1{2} /\ (x=x1){2} /\ ={p0,n0} /\ *) +(* n0{1} = i{2} /\ 0 <= i0{2} < i{2} *) +(* ==> _);1:smt(parseK formatK). *) +(* seq 1 1 : (INV IBlockSponge.m{2} ICORE.m{1} /\ 0 < n0{2} /\ *) +(* (forall (j : int), 0 < j <= n0{1} => *) +(* format p0{1} j \in dom IBlockSponge.m{2}) /\ *) +(* (p0,n0){1} = parse x1{2} /\ ={p0,n0} /\ (x=x1){2});last first. *) +(* + rcondf{2}1;auto;smt(parseK formatK). *) +(* splitwhile{2}1:(i0+1 *) +(* format p0{1} j \in dom IBlockSponge.m{2}) /\ *) +(* (p0,n0){1} = parse x1{2} /\ ={p0,n0} /\ (x=x1){2});last first. *) +(* + rcondt{2}1;1:auto=>/#;rcondf{2}4;1: by progress;sp;if;auto=>/#. *) +(* sp;if;auto;progress. *) +(* + rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. *) +(* cut->/=:!size p0{2} + i0{2} < size p0{2} by rewrite/#. *) +(* smt(in_dom formatK). *) +(* + move:H3;rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. *) +(* cut->/=:!size p0{2} + i0{2} < size p0{2} by rewrite/#. *) +(* smt(in_dom formatK). *) +(* + rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. *) +(* smt(getP parseK formatK). *) +(* + rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. *) +(* smt(in_dom getP parseK formatK). *) +(* + case(j=i0{2} + 1)=>//=;2:rewrite/#. *) +(* smt(in_dom getP parseK formatK). *) +(* while{2}((p0{2}, n0{2}) = parse x1{2} /\ (x=x1){2} /\ 0 <= i0{2} < n0{2} /\ *) +(* INV IBlockSponge.m{2} ICORE.m{1} /\ (p0,n0){1} = parse x1{2} /\ *) +(* ={p0,n0} /\ (forall (j : int), 0 < j < n0{2} => *) +(* format p0{2} j \in dom IBlockSponge.m{2}))(n0{2}-i0{2});progress. *) +(* + sp;rcondf 1;auto;progress. *) +(* + rewrite-(formatK x1{hr})-H3/=take_cat addzAC/=/=take_nseq/min/=. *) +(* cut->/=:!size p0{hr} + i0{hr} < size p0{hr} by rewrite/#. *) +(* by cut/#:=H4 (i0{hr}+1). *) +(* + by rewrite/#. *) +(* by rewrite/#. *) +(* by auto=>/#. *) + +(* + proc. *) +(* sp;if=> [&1 &2 [#] <*>/#| |] //=. *) +(* inline*;sp;rcondt{1}1;auto. *) +(* swap{2}1;sp. *) +(* conseq(:_==> last Block.b0 r0{1} = oget IBlockSponge.m{2}.[x{2}] /\ *) +(* INV IBlockSponge.m{2} ICORE.m{1});progress. *) +(* seq 1 1 :(last Block.b0 r0{1} = oget IBlockSponge.m{2}.[x{2}] /\ *) +(* INV IBlockSponge.m{2} ICORE.m{1} /\ *) +(* x1{2} \in dom IBlockSponge.m{2});last by rcondf{2}1;auto=>/#. *) +(* conseq(:_==> INV IBlockSponge.m{2} ICORE.m{1} /\ i{2} = n{2} /\ *) +(* Some (last Block.b0 r0{1}) = *) +(* IBlockSponge.m{2}.[take (size p + i){2} x{2}]);progress. *) +(* + move:H5;rewrite take_oversize;2:smt(oget_some). *) +(* by rewrite-formatK/=-H/=size_cat size_nseq/#. *) +(* + move:H5;rewrite take_oversize. *) +(* + by rewrite-formatK/=-H/=size_cat size_nseq/#. *) +(* by rewrite in_dom/#. *) +(* while( i{1} = i{2}+1 /\ n0{1} = n{2} /\ p{2} = p0{1} *) +(* /\ valid p0{1} /\ 0 < i{1} /\ i{2} <= n{2} *) +(* /\ (i{2} = n{2} => Some (last Block.b0 r0{1}) = *) +(* IBlockSponge.m{2}.[take (size p{2} + i{2}) x{2}]) *) +(* /\ INV IBlockSponge.m{2} ICORE.m{1} *) +(* /\ parse x{2} = (p0{1},n0{1}));auto;last first. *) +(* + progress=>/#. *) +(* sp;if;auto;smt(take_nseq parseK in_dom formatK take_cat getP last_rcons). *) + +(* by inline*;auto;call(:true);auto;smt(in_dom dom0 in_fset0). *) +(* qed. *) - + proc (INV IBlockSponge.m{2} ICORE.m{1})=> //. - proc=> /=; sp;if=> [&1 &2 [#] <*>| |] //=. - inline{2} 1.1. - inline*. - while( INV IBlockSponge.m{2} ICORE.m{1} - /\ 0 < i{1} <= n{1} + 1 - /\ ={n,p,r,i} - /\ valid p{1} - /\ 0 < n{1} - /\ (forall j, 0 < j < i{1} => - format p{2} j \in dom IBlockSponge.m{2}));last auto=>/#. - rcondt{2}5;auto;1:smt(parseK). - swap{2}6-1;sp. - conseq(:_==> INV IBlockSponge.m{2} ICORE.m{1} /\ - (forall j, 0 < j <= n0{1} => - format p0{1} j \in dom IBlockSponge.m{2}));1:smt(parseK formatK). - conseq(: INV IBlockSponge.m{2} ICORE.m{1} /\ (forall (j : int), - 0 < j < n0{1} => format p0{1} j \in dom IBlockSponge.m{2}) /\ - (p0,n0){1} = parse x1{2} /\ (x=x1){2} /\ ={p0,n0} /\ - n0{1} = i{2} /\ 0 <= i0{2} < i{2} - ==> _);1:smt(parseK formatK). - seq 1 1 : (INV IBlockSponge.m{2} ICORE.m{1} /\ 0 < n0{2} /\ - (forall (j : int), 0 < j <= n0{1} => - format p0{1} j \in dom IBlockSponge.m{2}) /\ - (p0,n0){1} = parse x1{2} /\ ={p0,n0} /\ (x=x1){2});last first. - + rcondf{2}1;auto;smt(parseK formatK). - splitwhile{2}1:(i0+1 - format p0{1} j \in dom IBlockSponge.m{2}) /\ - (p0,n0){1} = parse x1{2} /\ ={p0,n0} /\ (x=x1){2});last first. - + rcondt{2}1;1:auto=>/#;rcondf{2}4;1: by progress;sp;if;auto=>/#. - sp;if;auto;progress. - + rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. - cut->/=:!size p0{2} + i0{2} < size p0{2} by rewrite/#. - smt(in_dom formatK). - + move:H3;rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. - cut->/=:!size p0{2} + i0{2} < size p0{2} by rewrite/#. - smt(in_dom formatK). - + rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. - smt(getP parseK formatK). - + rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. - smt(in_dom getP parseK formatK). - + case(j=i0{2} + 1)=>//=;2:rewrite/#. - smt(in_dom getP parseK formatK). - while{2}((p0{2}, n0{2}) = parse x1{2} /\ (x=x1){2} /\ 0 <= i0{2} < n0{2} /\ - INV IBlockSponge.m{2} ICORE.m{1} /\ (p0,n0){1} = parse x1{2} /\ - ={p0,n0} /\ (forall (j : int), 0 < j < n0{2} => - format p0{2} j \in dom IBlockSponge.m{2}))(n0{2}-i0{2});progress. - + sp;rcondf 1;auto;progress. - + rewrite-(formatK x1{hr})-H3/=take_cat addzAC/=/=take_nseq/min/=. - cut->/=:!size p0{hr} + i0{hr} < size p0{hr} by rewrite/#. - by cut/#:=H4 (i0{hr}+1). - + by rewrite/#. - by rewrite/#. - by auto=>/#. - - + proc. - sp;if=> [&1 &2 [#] <*>/#| |] //=. - inline*;sp;rcondt{1}1;auto. - swap{2}1;sp. - conseq(:_==> last Block.b0 r0{1} = oget IBlockSponge.m{2}.[x{2}] /\ - INV IBlockSponge.m{2} ICORE.m{1});progress. - seq 1 1 :(last Block.b0 r0{1} = oget IBlockSponge.m{2}.[x{2}] /\ - INV IBlockSponge.m{2} ICORE.m{1} /\ - x1{2} \in dom IBlockSponge.m{2});last by rcondf{2}1;auto=>/#. - conseq(:_==> INV IBlockSponge.m{2} ICORE.m{1} /\ i{2} = n{2} /\ - Some (last Block.b0 r0{1}) = - IBlockSponge.m{2}.[take (size p + i){2} x{2}]);progress. - + move:H5;rewrite take_oversize;2:smt(oget_some). - by rewrite-formatK/=-H/=size_cat size_nseq/#. - + move:H5;rewrite take_oversize. - + by rewrite-formatK/=-H/=size_cat size_nseq/#. - by rewrite in_dom/#. - while( i{1} = i{2}+1 /\ n0{1} = n{2} /\ p{2} = p0{1} - /\ valid p0{1} /\ 0 < i{1} /\ i{2} <= n{2} - /\ (i{2} = n{2} => Some (last Block.b0 r0{1}) = - IBlockSponge.m{2}.[take (size p{2} + i{2}) x{2}]) - /\ INV IBlockSponge.m{2} ICORE.m{1} - /\ parse x{2} = (p0{1},n0{1}));auto;last first. - + progress=>/#. - sp;if;auto;smt(take_nseq parseK in_dom formatK take_cat getP last_rcons). - by inline*;auto;call(:true);auto;smt(in_dom dom0 in_fset0). -qed. end section PROOF. From 6d0119a1ed090d0d85a01749b6b4f8858c08e1b7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Fri, 12 Jan 2018 17:41:10 +0100 Subject: [PATCH 255/525] . --- proof/clean/BlockSponge.eca | 806 +++++++++++++----------------------- 1 file changed, 283 insertions(+), 523 deletions(-) diff --git a/proof/clean/BlockSponge.eca b/proof/clean/BlockSponge.eca index bf27b16..b2629c8 100644 --- a/proof/clean/BlockSponge.eca +++ b/proof/clean/BlockSponge.eca @@ -5,9 +5,8 @@ require (*--*) StdBigop. require import StdOrder. (*---*) import IntOrder. -print StdBigop. -require import NewCommon. -(*---*) import Block DBlock Capacity DCapacity. +require import NewCommon Gconcl. +(*---*) import Block DBlock Capacity DCapacity SLCommon. (*** THEORY PARAMETERS ***) (** Validity of Functionality Queries **) @@ -42,6 +41,16 @@ case(i + 1 <= j)=>hi1j. rewrite take_oversize;smt(size_nseq). qed. +lemma sumid_leq (n m p : int) : 0 <= n => m <= p => sumid n m <= sumid n p. +proof. +move=>Hn0 Hmp. +case(m<=n)=>Hmn. search BIA.big 0 (<=). ++ rewrite BIA.big_geq//. + by apply sumr_ge0_seq=>//=;smt(mem_iota size_ge0). +rewrite(BIA.big_cat_int m n p) 1:/# //. +cut/#:0<=sumid m p. +by apply sumr_ge0_seq=>//=;smt(mem_iota size_ge0). +qed. (*** DEFINITIONS ***) (** Low-Level Definitions **) @@ -95,12 +104,12 @@ module IBlockSponge : FUNCTIONALITY = { proc f(x : block list) = { var bs <- b0; - var i <- 0; + var i <- 1; var (p,n) <- parse x; if (valid p /\ 0 < n) { while (i < n) { - fill_in(take (size p + i) x); + fill_in(format p i); i <- i + 1; } bs <@ fill_in(x); @@ -112,23 +121,19 @@ module IBlockSponge : FUNCTIONALITY = { (* Parametric Simulator *) -module (HiSim (S : Low.SIMULATOR) : SIMULATOR) (F : DFUNCTIONALITY) = { +module (LowSim (S : SIMULATOR) : Low.SIMULATOR) (F : Low.DFUNCTIONALITY) = { module LoF = { - proc f(p : block list, n : int): block list = { + proc f(x : block list) = { var r <- []; - var b; + var b <- b0; var i <- 1; - if (valid p /\ 0 < n) + if (let (p,n) = parse x in valid p /\ 0 < n) { - while (i <= n) { - b <@ F.f(format p i); - r <- rcons r b; - i <- i + 1; - } - + r <@ F.f(parse x); + b <- last b0 r; } - return r; + return b; } } @@ -143,15 +148,17 @@ pred INV (mc : (block list,block) fmap) (mb : (block list * int,block) fmap) = (* Constructed Distinguisher *) module (HiDist (D : Low.DISTINGUISHER) : DISTINGUISHER) (F : DFUNCTIONALITY) (P : DPRIMITIVE) = { + var c : int module HiF = { proc f(p : block list, n : int) = { var r <- []; var b <- b0; var i <- 1; - if (valid p /\ 0 < n) { + if (valid p /\ 0 < n /\ c + sumid (size p) (size p + n) <= max_size) { while(i <= n) { b <@ F.f(format p i); + c <- c + size p + i - 1; r <- rcons r b; i <- i + 1; } @@ -159,55 +166,73 @@ module (HiDist (D : Low.DISTINGUISHER) : DISTINGUISHER) return r; } } + module C = { + proc f (x) = { + var y <- (b0,c0); + if (c + 1 <= max_size) { + c <- c + 1; + y <@ P.f(x); + } + return y; + } + proc fi (x) = { + var y <- (b0,c0); + if (c + 1 <= max_size) { + c <- c + 1; + y <@ P.fi(x); + } + return y; + } + } - proc distinguish = D(HiF,P).distinguish + proc distinguish() = { + var a; + c <- 0; + a <@ D(HiF,C).distinguish(); + return a; + } }. -print Low. +module DFCn (F : Low.FUNCTIONALITY) : Low.FUNCTIONALITY = { + proc init = F.init + proc f(p : block list, n : int) = { + var r : block list <- []; + if(C.c + sumid (size p) (size p + n) <= max_size /\ valid p /\ 0 < n) { + r <@ F.f(p,n); + C.c <- C.c + sumid (size p) (size p + n); + } + return r; + } +}. -module (C (P : PRIMITIVE) : PRIMITIVE) = { - var c : int - proc init() = { - c <- 0; +module DPC (P : PRIMITIVE) : PRIMITIVE = { + proc init () = { + C.init(); P.init(); } proc f(x) = { - var y; - c <- c + 1; - y <@ P.f(x); + var y <- (b0,c0); + if (C.c + 1 <= max_size) { + y <@ P.f(x); + C.c <- C.c + 1; + } return y; } proc fi(x) = { - var y; - c <- c + 1; - y <@ P.fi(x); - return y; - } -}. - -module DFCn (F : Low.FUNCTIONALITY) : Low.FUNCTIONALITY = { - proc init() = { - C.c <- 0; - F.init(); - } - proc f(bs,n) = { - var r : block list <- []; - if (valid bs /\ 0 < n) { - C.c <- C.c + sumid (size bs) (size bs + n); - r <@ F.f(bs,n); + var y <- (b0,c0); + if (C.c + 1 <= max_size) { + y <@ P.fi(x); + C.c <- C.c + 1; } - return r; + return y; } }. module DFC1 (F : FUNCTIONALITY) : FUNCTIONALITY = { - proc init() = { - C.c <- 0; - F.init(); - } - proc f(x) = { + proc init = F.init + proc f(x : block list) = { var b : block <- b0; - if (let (bs,n) = parse x in valid bs /\ 0 < n) { + if (C.c + size x <= max_size) { C.c <- C.c + size x; b <@ F.f(x); } @@ -217,12 +242,12 @@ module DFC1 (F : FUNCTIONALITY) : FUNCTIONALITY = { (*** PROOF forall P D S, - HiDist(D)^{BlockSponge(P),P} ~ HiDist(D)^{IBlockSponge,HiSim(S)(IBlockSponge)} - => D^{Core(P),P} ~ D^{ICore,S(ICore)} ***) + HiDist(D)^{BlockSponge(P),P} ~ HiDist(D)^{IBlockSponge,S(IBlockSponge)} + => D^{Core(P),P} ~ D^{ICore,LowSim(S,ICore)} ***) section PROOF. - declare module P : PRIMITIVE { Low.ICORE, IBlockSponge, HiSim, C }. - declare module S : Low.SIMULATOR { Low.ICORE, IBlockSponge, HiSim, C, P }. - declare module D : Low.DISTINGUISHER { Low.ICORE, IBlockSponge, HiSim, C, P, S }. + declare module P : PRIMITIVE { Low.ICORE, IBlockSponge, HiDist, C }. + declare module S : SIMULATOR { Low.ICORE, IBlockSponge, HiDist, C, P }. + declare module D : Low.DISTINGUISHER { Low.ICORE, IBlockSponge, HiDist, C, P, S }. @@ -299,35 +324,38 @@ section PROOF. } }. + equiv core_blocksponge : - Low.Indif(DFCn(CORE(P)),C(P),D).main ~ - Indif(DFC1(BlockSponge(P)),C(P),HiDist(D)).main : - ={glob D, glob P} ==> ={res, C.c}. + Low.Indif(DFCn(CORE(P)),DPC(P),D).main ~ + Indif(DFC1(BlockSponge(P)),DPC(P),HiDist(D)).main : + ={glob D, glob P} ==> ={res, C.c} /\ ={c}(C,HiDist). proof. - transitivity Low.Indif(DFCn(EagerCORE(P)),C(P),D).main + transitivity Low.Indif(DFCn(EagerCORE(P)),DPC(P),D).main (={glob D, glob P} ==> ={res, C.c}) - (={glob D, glob P} ==> ={res, C.c});progress;1:rewrite/#. + (={glob D, glob P} ==> ={res, C.c} /\ ={c}(C,HiDist));progress;1:rewrite/#. + proc=>/=;call (_: ={glob P, C.c}); first 2 by sim. - + proc=> /=;inline*;sp;if=>//=;sim;sp;if;progress;sim. - by while( ={i,p,glob P} /\ sc{1} = EagerCORE.capa{2} + + proc=> /=;inline*;sp;if;auto;sp;if;auto;sim. + conseq(:_==> sc{1} = EagerCORE.capa{2} /\ sa{1} = EagerCORE.blo{2} + /\ ={glob P});progress. + by while( ={i,p0,glob P} /\ sc{1} = EagerCORE.capa{2} /\ sa{1} = EagerCORE.blo{2});auto;call(:true);auto. by inline*;auto;call(:true);auto. - transitivity Low.Indif(DFCn(EagCORE(P)),C(P),D).main + transitivity Low.Indif(DFCn(EagCORE(P)),DPC(P),D).main (={glob D, glob P} ==> ={res, C.c}) - (={glob D, glob P} ==> ={res, C.c});progress;1:rewrite/#. + (={glob D, glob P} ==> ={res, C.c} /\ ={c}(C,HiDist));progress;1:rewrite/#. + proc. call (_: ={glob P, C.c}); first 2 by sim. - + proc=> /=; sp;if=>//=;inline{1}2;inline{2}2;sp;if;progress;2:auto. - swap{2}2;swap{1}3-2;sp;sim. - conseq(:_==> ={r0,glob P});progress. + + proc=> /=; sp. + if=>//=;auto;inline{1}1;inline{2}1;sp;if;auto;swap{1}3-2;swap{2}2. + conseq(:_==> ={r0,glob P});progress;sp. replace{1} { while ; rest } by { EagerCORE(P).ewhile(); rest; } (={glob P, EagerCORE.order, r0, n0} /\ i{1} = 0 - /\ (EagerCORE.blo,EagerCORE.capa,EagerCORE.order){1} = (b0,c0,p{1}) + /\ (EagerCORE.blo,EagerCORE.capa,EagerCORE.order){1} = (b0,c0,p0{1}) ==> ={r0, glob P}) (={glob P,glob EagerCORE, n0,r0} ==> ={r0, glob P}); progress;1:rewrite/#;first inline*;sim;auto;progress. @@ -338,472 +366,204 @@ section PROOF. by inline*;auto;call(:true);auto. - + proc;call (_: ={glob P, C.c});..2:sim;last first. - + by inline*;auto;call(:true);auto. - proc=> /=; sp;if=>//=;sp;inline*;sp. + + proc;inline{2}3;wp;call (_: ={glob P, C.c} /\ ={c}(C,HiDist)). + + by proc;inline*;sp;auto;if;auto;sp;rcondt{2}1;auto;call(:true);auto. + + by proc;inline*;sp;auto;if;auto;sp;rcondt{2}1;auto;call(:true);auto. + proc;inline*;sp;auto. + if;1:progress=>/#;sp;wp. rcondt{1}1;1:auto=>/#;sp. - rcondt{2}1;1:(auto;smt(parseK formatK));sp. - rcondt{2}1;1:(auto;smt(parseK formatK));sp. - rcondt{2}1;1:(auto;smt(parseK formatK));sp;wp. - while( ={glob P,n} /\ (format p i){2} = rcons EagerCORE.order{1} b0 - /\ i{2} = i{1} + 1 /\ (sa,sc){2} = (EagerCORE.blo,EagerCORE.capa){1} - /\ valid p{2} /\ 0 < n{2} /\ 0 < i{1} /\ r0{1} = r{2} /\ n0{1} = n{2} - /\ C.c{1} = C.c{2} + sumid (size EagerCORE.order{1} + 1)(size p{2} + n{1}) - /\ 1 <= i{1} <= n0{1} - ). - + sp;rcondt{2}1;auto;1:smt(formatK parseK). - sp;rcondt{2}1;auto;1:smt(formatK parseK). - conseq(:_==> ={glob P,C.c} - /\ (sa,sc){2} = (EagerCORE.blo,EagerCORE.capa){1});progress. - + smt(rcons_cat nseqSr). - + smt(rcons_cat nseqSr). - + rewrite H0 size_rcons BIA.big_ltn_cond;2:rewrite/#. - by rewrite-(size_rcons _ b0)-H0 size_cat-addzA/=size_nseq/max H3/=/#. - + smt(rcons_cat nseqSr). - + smt(rcons_cat nseqSr). - + smt(rcons_cat nseqSr). - while(={glob P,C.c} /\ 0 <= i0{2} <= size p0{2} /\ (sa,sc,i0,p0){2} = - (EagerCORE.blo,EagerCORE.capa,i1,EagerCORE.order){1} - /\ i{2} = i{1} + 1 /\ n0{2} = i{2}); - auto;1:call(:true);auto;progress;..2,4..:smt(size_rcons size_ge0 formatK parseK). - admit. - - wp=>/=. - by while(={glob P,i0} /\ (sa,sc,p0){1} = - (EagerCORE.blo,EagerCORE.capa,EagerCORE.order){2}); - auto;1:call(:true);auto; - smt(nseq0 cats0 valid_spec size_ge0 size_eq0 nseq1 cats1). - - by inline*;auto;call(:true);auto. - - byequiv(: ={glob D, glob P} ==>_)=>//=; + rcondt{2}1;1:auto=>/#;sp. + rcondt{2}1;1:auto;progress. + + rewrite size_cat nseq0/=. + cut/#:size p{hr} <= sumid (size p{hr}) (size p{hr} + n{hr}). + rewrite BIA.big_ltn 1:/# /=. + cut/#:=sumr_ge0_seq predT(fun n=>n)(range (size p{hr} + 1) (size p{hr} + n{hr})) _. + smt(mem_iota size_ge0). + sp;rcondt{2}1;1:(auto;smt(parseK formatK));sp. + conseq(:_==> r0{1} = r{2} /\ ={glob P} /\ C.c{2} = HiDist.c{2} + /\ i{1} = n{1} + /\ C.c{1} + sumid (size p{1}) (size p{1} + i{1}) = C.c{2});progress. + while( r0{1} = r{2} /\ ={glob P,p} /\ C.c{2} = HiDist.c{2} + /\ C.c{1} + sumid (size p{1}) (size p{1} + n{2}) <= max_size + /\ C.c{1} + sumid (size p{1}) (size p{1} + i{1}) = C.c{2} + /\ (n0, EagerCORE.blo, EagerCORE.capa){1} = (n, sa, sc){2} + /\ EagerCORE.order{1} = format p{2} i{1} + /\ i{2} = i{1} + 1 + /\ 0 < i{1} <= n0{1} + /\ valid p{2}). + + sp;rcondt{2}1;auto;progress. + + cut/#:sumid (size p{hr}) (size p{hr} + i{m}) + + size (format p{hr} (i{m} + 1)) <= + sumid (size p{hr}) (size p{hr} + n{hr}). + rewrite size_cat size_nseq-addzA/=/max H0/=. + cut/=<-:=BIA.big_int_recr (size p{hr} + i{m})(size p{hr})(fun n=>n)_;1:rewrite/#. + smt(sumid_leq size_ge0). + swap{2}5;sp;auto. + rcondt{2}1;1:(auto;smt(formatK parseK)). + conseq(:_==> ={glob P} /\ + (EagerCORE.blo, EagerCORE.capa){1} = (sa, sc){2});progress. + + rewrite size_cat-(addzA _ 1)/=size_nseq/max H1/=/#. + + rewrite size_cat-(addzA _ 1)/=size_nseq/max H1/=. search BIA.big (+) 1. + by cut/#:=BIA.big_int_recr_cond(size p{2} + i{1})(size p{2})predT(fun n=>n)_;rewrite/#. + + by rewrite rcons_cat-nseqSr 1:/# -addzA/=/format-addzA/=. + + rewrite/#. + + rewrite/#. + + rewrite/#. + while(={glob P} /\ + (i1,EagerCORE.order,EagerCORE.blo,EagerCORE.capa){1} = (i0,p0,sa,sc){2});auto. + + by call(:true);auto. + progress. + + by rewrite rcons_cat-nseqSr 1:/# -addzA/=/format-addzA/=. + + by move:H6;rewrite rcons_cat-nseqSr 1:/# -addzA/=/format-addzA/=. + by move:H6;rewrite rcons_cat-nseqSr 1:/# -addzA/=/format-addzA/=. + wp;conseq(:_==> ={glob P} /\ + (EagerCORE.blo, EagerCORE.capa){1} = (sa, sc){2});progress. + + by rewrite size_cat nseq0/#. + + by rewrite size_cat nseq0/= BIA.big_int1. + + by rewrite/format nseq0 cats0/#. + + rewrite/#. + + rewrite/#. + + rewrite/#. + + rewrite/#. + while(={glob P} /\ + (i0,EagerCORE.order,EagerCORE.blo,EagerCORE.capa){1} = (i0,p0,sa,sc){2});auto. + + by call(:true);auto. + progress. + + by rewrite/format nseq0 cats0/#. + + by rewrite size_cat nseq0/#. + + by move:H3;rewrite size_cat nseq0/#. + by auto;progress. + by inline*;auto;call(:true);auto. qed. - - - - lemma icore_iblocksponge &m : - Pr[Low.Indif(ICORE,S(ICORE),D).main() @ &m: res] = - Pr[Indif(IBlockSponge,HiSim(S,IBlockSponge),HiDist(D)).main() @ &m: res]. + + equiv icore_iblocksponge : + Low.Indif(DFCn(ICORE),DPC(LowSim(S,ICORE)),D).main ~ + Indif(DFC1(IBlockSponge),DPC(S(IBlockSponge)),HiDist(D)).main : + ={glob S, glob D} ==> ={res, C.c} /\ ={c}(C,HiDist). proof. - byequiv(: ={glob D, glob S} ==>_)=>//=;proc. - call (_: ={glob S} /\ INV IBlockSponge.m{2} ICORE.m{1}). - + proc (INV IBlockSponge.m{2} ICORE.m{1})=> //. - proc=> /=; sp;if=> [&1 &2 [#] <*>| |] //=. - inline{2} 1.1. - inline*. - while( INV IBlockSponge.m{2} ICORE.m{1} - /\ 0 < i{1} <= n{1} + 1 - /\ ={n,p,r,i} - /\ valid p{1} - /\ 0 < n{1} - /\ (forall j, 0 < j < i{1} => - format p{2} j \in dom IBlockSponge.m{2}));last auto=>/#. - rcondt{2}5;auto;1:smt(parseK). - swap{2}6-1;sp. + proc;inline{2}3;wp;call (_: + ={glob S,C.c} /\ ={c}(C,HiDist) + /\ INV IBlockSponge.m{2} ICORE.m{1}). + + proc;inline*;sp;if;auto. + swap{2}3;sp;rcondt{2}1;auto. + call(: ={C.c} /\ ={c}(C,HiDist) /\ INV IBlockSponge.m{2} ICORE.m{1})=>/=;auto. + proc=> /=; sp;if;1:progress=>/#;inline*;sp;auto. + rcondt{1}1;1:auto=>/#. + wp. + splitwhile{1}1:i0/#;sp;if;auto=>/#. + rcondf{1}8;progress. + + wp;seq 1:(i0=n);2:(sp;if;auto=>/#). + by while(i0<=n);2:auto=>/#;sp;if;auto=>/#. + wp. conseq(:_==> INV IBlockSponge.m{2} ICORE.m{1} /\ - (forall j, 0 < j <= n0{1} => - format p0{1} j \in dom IBlockSponge.m{2}));1:smt(parseK formatK). - conseq(: INV IBlockSponge.m{2} ICORE.m{1} /\ (forall (j : int), - 0 < j < n0{1} => format p0{1} j \in dom IBlockSponge.m{2}) /\ - (p0,n0){1} = parse x1{2} /\ (x=x1){2} /\ ={p0,n0} /\ - n0{1} = i{2} /\ 0 <= i0{2} < i{2} - ==> _);1:smt(parseK formatK). - seq 1 1 : (INV IBlockSponge.m{2} ICORE.m{1} /\ 0 < n0{2} /\ - (forall (j : int), 0 < j <= n0{1} => - format p0{1} j \in dom IBlockSponge.m{2}) /\ - (p0,n0){1} = parse x1{2} /\ ={p0,n0} /\ (x=x1){2});last first. - + rcondf{2}1;auto;smt(parseK formatK). - splitwhile{2}1:(i0+1 - format p0{1} j \in dom IBlockSponge.m{2}) /\ - (p0,n0){1} = parse x1{2} /\ ={p0,n0} /\ (x=x1){2});last first. - + rcondt{2}1;1:auto=>/#;rcondf{2}4;1: by progress;sp;if;auto=>/#. - sp;if;auto;progress. - + rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. - cut->/=:!size p0{2} + i0{2} < size p0{2} by rewrite/#. - smt(in_dom formatK). - + move:H3;rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. - cut->/=:!size p0{2} + i0{2} < size p0{2} by rewrite/#. - smt(in_dom formatK). - + rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. - smt(getP parseK formatK). - + rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. - smt(in_dom getP parseK formatK). - + case(j=i0{2} + 1)=>//=;2:rewrite/#. - smt(in_dom getP parseK formatK). - while{2}((p0{2}, n0{2}) = parse x1{2} /\ (x=x1){2} /\ 0 <= i0{2} < n0{2} /\ - INV IBlockSponge.m{2} ICORE.m{1} /\ (p0,n0){1} = parse x1{2} /\ - ={p0,n0} /\ (forall (j : int), 0 < j < n0{2} => - format p0{2} j \in dom IBlockSponge.m{2}))(n0{2}-i0{2});progress. - + sp;rcondf 1;auto;progress. - + rewrite-(formatK x1{hr})-H3/=take_cat addzAC/=/=take_nseq/min/=. - cut->/=:!size p0{hr} + i0{hr} < size p0{hr} by rewrite/#. - by cut/#:=H4 (i0{hr}+1). - + by rewrite/#. - by rewrite/#. - by auto=>/#. - - + proc (INV IBlockSponge.m{2} ICORE.m{1})=> //. - proc=> /=; sp;if=> [&1 &2 [#] <*>| |] //=. - inline{2} 1.1. - inline*. - while( INV IBlockSponge.m{2} ICORE.m{1} - /\ 0 < i{1} <= n{1} + 1 - /\ ={n,p,r,i} - /\ valid p{1} - /\ 0 < n{1} - /\ (forall j, 0 < j < i{1} => - format p{2} j \in dom IBlockSponge.m{2}));last auto=>/#. - rcondt{2}5;auto;1:smt(parseK). - swap{2}6-1;sp. + ICORE.m{1}.[(p0{1}, n0{1})] = IBlockSponge.m{2}.[x1{2}]);progress. + + smt(last_rcons). + seq 3 2 : (INV IBlockSponge.m{2} ICORE.m{1} /\ + parse x1{2} = (p0{1}, n0{1}) /\ valid p0{1} /\ 0 < n0{1}); + last if;1:smt(in_dom);auto;smt(getP formatK parseK). + wp;conseq(:_==> INV IBlockSponge.m{2} ICORE.m{1} /\ i0{1} = n{1});1:progress=>/#. + while( ={n,p} /\ INV IBlockSponge.m{2} ICORE.m{1} + /\ i0{1} = i{2} /\ valid p{1} /\ 0 < n{2} /\ 0 < i0{1} <= n{1}). + + sp;if;auto;smt(in_dom formatK parseK getP). + by auto;smt(in_dom formatK parseK getP). + + + proc;sp;if;auto;swap{2}1;inline{2}1;sp;rcondt{2}1;auto. + call(: ={C.c} /\ C.c{1} = HiDist.c{2}/\ INV IBlockSponge.m{2} ICORE.m{1})=> //. + proc=> /=; sp;if;1:progress=>/#;inline*;sp;auto. + rcondt{1}1;1:auto=>/#. + wp. + splitwhile{1}1:i0/#;sp;if;auto=>/#. + rcondf{1}8;progress. + + wp;seq 1:(i0=n);2:(sp;if;auto=>/#). + by while(i0<=n);2:auto=>/#;sp;if;auto=>/#. + wp. conseq(:_==> INV IBlockSponge.m{2} ICORE.m{1} /\ - (forall j, 0 < j <= n0{1} => - format p0{1} j \in dom IBlockSponge.m{2}));1:smt(parseK formatK). - conseq(: INV IBlockSponge.m{2} ICORE.m{1} /\ (forall (j : int), - 0 < j < n0{1} => format p0{1} j \in dom IBlockSponge.m{2}) /\ - (p0,n0){1} = parse x1{2} /\ (x=x1){2} /\ ={p0,n0} /\ - n0{1} = i{2} /\ 0 <= i0{2} < i{2} - ==> _);1:smt(parseK formatK). - seq 1 1 : (INV IBlockSponge.m{2} ICORE.m{1} /\ 0 < n0{2} /\ - (forall (j : int), 0 < j <= n0{1} => - format p0{1} j \in dom IBlockSponge.m{2}) /\ - (p0,n0){1} = parse x1{2} /\ ={p0,n0} /\ (x=x1){2});last first. - + rcondf{2}1;auto;smt(parseK formatK). - splitwhile{2}1:(i0+1 - format p0{1} j \in dom IBlockSponge.m{2}) /\ - (p0,n0){1} = parse x1{2} /\ ={p0,n0} /\ (x=x1){2});last first. - + rcondt{2}1;1:auto=>/#;rcondf{2}4;1: by progress;sp;if;auto=>/#. - sp;if;auto;progress. - + rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. - cut->/=:!size p0{2} + i0{2} < size p0{2} by rewrite/#. - smt(in_dom formatK). - + move:H3;rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. - cut->/=:!size p0{2} + i0{2} < size p0{2} by rewrite/#. - smt(in_dom formatK). - + rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. - smt(getP parseK formatK). - + rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. - smt(in_dom getP parseK formatK). - + case(j=i0{2} + 1)=>//=;2:rewrite/#. - smt(in_dom getP parseK formatK). - while{2}((p0{2}, n0{2}) = parse x1{2} /\ (x=x1){2} /\ 0 <= i0{2} < n0{2} /\ - INV IBlockSponge.m{2} ICORE.m{1} /\ (p0,n0){1} = parse x1{2} /\ - ={p0,n0} /\ (forall (j : int), 0 < j < n0{2} => - format p0{2} j \in dom IBlockSponge.m{2}))(n0{2}-i0{2});progress. - + sp;rcondf 1;auto;progress. - + rewrite-(formatK x1{hr})-H3/=take_cat addzAC/=/=take_nseq/min/=. - cut->/=:!size p0{hr} + i0{hr} < size p0{hr} by rewrite/#. - by cut/#:=H4 (i0{hr}+1). - + by rewrite/#. - by rewrite/#. - by auto=>/#. - - - + proc=> /=; sp;if=> [&1 &2 [#] <*>| |] //=. - inline{2} 1.1. - inline*. + ICORE.m{1}.[(p0{1}, n0{1})] = IBlockSponge.m{2}.[x1{2}]);progress. + + smt(last_rcons). + seq 3 2 : (INV IBlockSponge.m{2} ICORE.m{1} /\ + parse x1{2} = (p0{1}, n0{1}) /\ valid p0{1} /\ 0 < n0{1}); + last if;1:smt(in_dom);auto;smt(getP formatK parseK). + wp;conseq(:_==> INV IBlockSponge.m{2} ICORE.m{1} /\ i0{1} = n{1});1:progress=>/#. + while( ={n,p} /\ INV IBlockSponge.m{2} ICORE.m{1} + /\ i0{1} = i{2} /\ valid p{1} /\ 0 < n{2} /\ 0 < i0{1} <= n{1}). + + sp;if;auto;smt(in_dom formatK parseK getP). + by auto;smt(in_dom formatK parseK getP). + + + proc=> /=; sp;if;1:progress=>/#;inline*;sp;auto. + rcondt{1}1;1:auto=>/#;wp. + conseq(:_==> INV IBlockSponge.m{2} ICORE.m{1} + /\ C.c{1} + sumid (size p{1}) (size p{1} + n{1}) = C.c{2} + /\ HiDist.c{2} = C.c{2} /\ r0{1} = r{2});progress. while( INV IBlockSponge.m{2} ICORE.m{1} - /\ 0 < i{1} <= n{1} + 1 - /\ ={n,p,r,i} - /\ valid p{1} - /\ 0 < n{1} + /\ ={i,p,n} /\ n0{1} = n{2} /\ p0{1} = p{1} + /\ valid p{1} /\ 0 < n{1} /\ 0 < i{1} <= n0{1} + 1 + /\ C.c{1} + sumid (size p{1}) (size (format p{1} i{1})) = C.c{2} + /\ C.c{1} + sumid (size p{1}) (size p{1} + n{1}) <= max_size /\ (forall j, 0 < j < i{1} => - format p{2} j \in dom IBlockSponge.m{2}));last auto=>/#. - rcondt{2}5;auto;1:smt(parseK). - swap{2}6-1;sp. - conseq(:_==> INV IBlockSponge.m{2} ICORE.m{1} /\ - (forall (j : int), 0 < j <= i{2} => - format p{2} j \in dom IBlockSponge.m{2}));1:smt(formatK parseK). - seq 1 1 :(INV IBlockSponge.m{2} ICORE.m{1} /\ 0 < i{2} /\ - (forall (j : int), 0 < j <= i{2} => - format p{2} j \in dom IBlockSponge.m{2}) /\ - x1{2} = format p{2} i{2});last first. - + rcondf{2}1;auto=>/#. - conseq(:_==> INV IBlockSponge.m{2} ICORE.m{1} /\ - (forall (j : int), 0 < j <= i{2} => - format p{2} j \in dom IBlockSponge.m{2}));1:smt(formatK parseK). - if{1}. - + splitwhile{2}1:i0+1/#. - by while(i0 i0=n0-1 /\ IBlockSponge.m = m /\ p = p0 /\ i = n0);progress. - + by rewrite take_cat addzAC/=take_nseq/min/=;smt(in_dom formatK parseK). - conseq(:_==> i0=n0-1 /\ IBlockSponge.m = m);1:smt(formatK parseK). - while(0 <= i0 < n0 /\ (forall (j : int), 0 <= j < n0 - 1 => - take (size p0 + j) x \in dom m) /\ IBlockSponge.m = m);progress. - + rcondf 2;auto=>/#. - auto;progress;1,3:smt(formatK parseK). - rewrite take_cat addzAC/=take_nseq. - cut->/=:p0{hr}=p{hr} by smt(parseK formatK). - cut h:i{hr}=n0{hr} by smt(formatK parseK). - by rewrite h;cut/#:=H5 (j+1). - wp;rnd=>/=. - alias{2} 1 m = IBlockSponge.m;sp. - conseq(:_==> i0{2} = n0{2} - 1 /\ IBlockSponge.m{2} = m{2} /\ - x0{2} = format p{2} n0{2});1:smt(formatK parseK getP dom_set in_dom). - wp;conseq(:_==> i0{2} = n0{2} - 1 /\ m{2} = IBlockSponge.m{2});progress. - + rewrite take_cat addzAC/=take_nseq. - cut->/=:p0{2}=p{2} by smt(parseK formatK). - cut h:i{2}=n0{2} by smt(formatK parseK). - by rewrite h min_lel///format;smt(nseq0 cats0). - while{2}(0 <= i0{2} < n0{2} /\ (forall (j : int), 0 <= j < n0{2} - 1 => - take (size p0{2} + j) x{2} \in dom m{2}) /\ - IBlockSponge.m{2} = m{2})(n0{2}-i0{2}-1);progress. - + rcondf 2;auto=>/#. - auto;progress;1,3..:smt(formatK parseK). - rewrite take_cat addzAC/=take_nseq. - cut->/=:p0{2}=p{2} by smt(parseK formatK). - cut h:i{2}=n0{2} by smt(formatK parseK). - by rewrite h;cut/#:=H5 (j+1). - rewrite/=. - alias{2}1 m = IBlockSponge.m;sp. - conseq(:_==> m{2} = IBlockSponge.m{2});1:smt(in_dom formatK parseK). - while{2}(0 <= i0{2} <= n0{2} /\ (forall (j : int), 0 <= j < n0{2} => - take (size p0{2} + j) x{2} \in dom m{2}) /\ - IBlockSponge.m{2} = m{2})(n0{2}-i0{2});progress. - + rcondf 2;auto=>/#. - auto;progress;1,3..:smt(formatK parseK). - rewrite take_cat addzAC/=take_nseq. - cut->/=:p0{2}=p{2} by smt(parseK formatK). - cut h:i{2}=n0{2} by smt(formatK parseK). - rewrite h;case(j=0)=>[->/=|]. - + rewrite-take_nseq take0 cats0. - by cut/=:=H5 1;smt(in_dom parseK formatK nseq0 cats0). - cut->/=:!size p{2} + j < size p{2} by rewrite/#. - by cut:=H5 (j+1);smt(in_dom parseK formatK nseq0 cats0). + format p{2} j \in dom IBlockSponge.m{2}) + /\ HiDist.c{2} = C.c{2} /\ r0{1} = r{2});last first. + + auto;progress. + + rewrite/#. + + by rewrite size_cat nseq0/= BIA.big_geq/=. + + smt(in_dom). + by rewrite size_cat size_nseq max_ler /#. + sp. + rcondt{2}1;1:auto;progress. + + rewrite-addzA. + cut/=<-:=BIA.big_int_recr_cond(size (format p{hr} i{hr}))(size p{hr})predT(fun n=>n)_. + + by rewrite size_cat size_nseq max_ler/#. + cut/#:=sumid_leq(size p{hr})(size (format p{hr} i{hr}) + 1)(size p{hr} + n{hr})_ _;1:smt(size_ge0). + by rewrite size_cat size_nseq max_ler/#. + swap{2}1 7;sp. + wp=>/=. + conseq(:_==> INV IBlockSponge.m{2} ICORE.m{1} + /\ (forall (j : int), + 0 < j < i{1} + 1 => format p{2} j \in dom IBlockSponge.m{2}) + /\ oget ICORE.m{1}.[(p1{1}, n1{1})] = bs{2});progress. + + rewrite/#. + + rewrite/#. + + rewrite -addzA;congr=>//. + rewrite 2!size_cat-addzA/=2!size_nseq{1}/max H3/=max_ler 1:/#. + cut/#:=BIA.big_int_recr_cond(size p{2} + (i{2} -1))(size p{2})predT(fun n=>n)_;rewrite/#. + + rewrite -4!addzA;congr=>//;congr. + by rewrite size_cat/=size_nseq max_ler 1:/#. + rcondt{2}1;1:(auto;smt(parseK formatK)). + alias{2}1 m = IBlockSponge.m;sp;wp=>/=;swap{2}2-1;sp. + if{1};2:rcondf{2}2;1:rcondt{2}2;progress. + + while(!(format p0 n0) \in dom IBlockSponge.m /\ 0 < i0 );auto. + + sp;if;auto;progress. + + by rewrite dom_set in_fsetU1 H/=/format;smt(catsI size_nseq). + + by rewrite/#. + + by rewrite/#. + smt(in_dom formatK parseK). + rnd=>//=. + conseq(:_==> INV m{2} ICORE.m{1} /\ IBlockSponge.m{2} = m{2});progress. + + smt(getP formatK parseK in_dom). + + smt(getP formatK parseK in_dom). + + smt(getP formatK parseK in_dom). + conseq(:_==> IBlockSponge.m{2} = m{2});progress. + while{2}(IBlockSponge.m{2} = m{2} /\ 0 < i0{2} /\ (forall (j : int), + 0 < j < n0{2} => format p0{2} j \in dom m{2}))(n0{2}-i0{2});auto. + + sp;rcondf 1;auto=>/#. + smt(parseK formatK). + + conseq(:_==> IBlockSponge.m = m);1:smt(in_dom parseK formatK). + while(IBlockSponge.m = m /\ 0 < i0 /\ (forall (j : int), + 0 < j < n0 => format p0 j \in dom m));auto. + + sp;rcondf 1;auto=>/#. + smt(parseK formatK). + + conseq(:_==> IBlockSponge.m{2} = m{2});1:smt(in_dom parseK formatK). + while{2}(IBlockSponge.m{2} = m{2} /\ 0 < i0{2} /\ (forall (j : int), + 0 < j < n0{2} => format p0{2} j \in dom m{2}))(n0{2}-i0{2});auto. + + sp;rcondf 1;auto=>/#. + smt(parseK formatK). by inline*;auto;call(:true);auto;smt(in_dom dom0 in_fset0). qed. - -(* lemma LiftInd &m: *) -(* `| Pr[Low.Indif(CORE(P),P,D).main() @ &m: res] *) -(* - Pr[Low.Indif(ICORE,S(ICORE),D).main() @ &m: res] | *) -(* = `| Pr[Indif(BlockSponge(P),P,HiDist(D)).main() @ &m: res] *) -(* - Pr[Indif(IBlockSponge,HiSim(S,IBlockSponge),HiDist(D)).main() @ &m: res] |. *) -(* proof. *) -(* do !congr. *) -(* + byequiv (_: ={glob D, glob P} ==> _ )=> //=; proc. *) -(* call (_: ={glob P}); first 2 by sim. *) -(* + proc=> /=; sp;if=>//=;1:progress=>/#. *) -(* inline*;sp;wp. *) -(* rcondt{1}1;progress. *) -(* splitwhile{2}1: i < size x. *) -(* seq 3 1:( ={glob P,sa,sc,p} *) -(* /\ (x,n,p0,n0){1} = (x,n,x,n){2} *) -(* /\ valid x{1} *) -(* /\ i{2} = size x{2} *) -(* /\ i{1} = 1 *) -(* /\ r0{1} = [sa{1}] *) -(* /\ (x{2}, n{2}) = parse p{2} *) -(* /\ 0 < n{1}). *) -(* + wp;conseq(:_==> ={glob P,sa,sc,i,p,x,n} *) -(* /\ i{2} = size x{2} *) -(* /\ (x,n,p0,n0){1} = (x,n,x,n){2});progress. *) -(* while( ={glob P,sa,sc,i,p,x,n} *) -(* /\ (x{2}, n{2}) = parse p{2} *) -(* /\ (p0,n0){1} = (x,n){2} *) -(* /\ 0 <= i{2} <= size x{2} <= size p{2});auto;1:call(:true);auto;progress;2..9,-3..-1:smt(size_ge0). *) -(* + by rewrite-(formatK p{2})-H/=/format nth_cat H3. *) -(* + by rewrite-(formatK p{2})-H/=/format size_cat;smt(size_ge0). *) -(* by rewrite-(formatK p{2})-H/=/format size_cat;smt(size_ge0). *) - -(* while( ={glob P,sa,sc,p} *) -(* /\ i{1} - 1 = i{2} - size x{2} *) -(* /\ size x{2} <= i{2} <= size p{2} *) -(* /\ sa{1} = last b0 r0{1} *) -(* /\ (x{2}, n{2}) = parse p{2} *) -(* /\ (x{1}, n{1}) = parse p{1} *) -(* /\ valid x{1} *) -(* /\ 0 < n{1} *) -(* /\ size p{2} = size x{2} + n{2} - 1 *) -(* /\ n0{1} = n{2} *) -(* );auto;last first. *) -(* + progress. *) -(* + by rewrite-(formatK p{2})-H0/=/format size_cat size_nseq/#. *) -(* + by rewrite-(formatK p{2})-H0/=/format size_cat size_nseq/#. *) -(* + by rewrite-(formatK p{2})-H0/=/format size_cat size_nseq/#. *) -(* by move:H2;rewrite-(formatK p{2})-H0/=/format size_cat size_nseq/#. *) - -(* call(:true);auto;progress;2..5,-2..:smt(last_rcons). *) -(* rewrite -(formatK p{2})-H2/=/format nth_cat nth_nseq_if. *) -(* cut->//=:!i{2} < size x{2} by rewrite/#. *) -(* cut->//=: 0 <= i{2} - size x{2} by rewrite/#. *) -(* rewrite-H. *) -(* cut->/=:i{1} - 1 < n{2} - 1 by rewrite/#. *) -(* by rewrite BlockMonoid.addr0. *) - -(* by inline*;auto;call(:true);auto. *) - -(* byequiv (_: ={glob D, glob S} ==> _)=> //=; proc. *) -(* call (_: ={glob S} /\ INV IBlockSponge.m{2} ICORE.m{1}). *) -(* + proc (INV IBlockSponge.m{2} ICORE.m{1})=> //. *) -(* proc=> /=; sp;if=> [&1 &2 [#] <*>| |] //=. *) -(* inline{2} 1.1. *) -(* inline*. *) -(* while( INV IBlockSponge.m{2} ICORE.m{1} *) -(* /\ 0 < i{1} <= n{1} + 1 *) -(* /\ ={n,p,r,i} *) -(* /\ valid p{1} *) -(* /\ 0 < n{1} *) -(* /\ (forall j, 0 < j < i{1} => *) -(* format p{2} j \in dom IBlockSponge.m{2}));last auto=>/#. *) -(* rcondt{2}5;auto;1:smt(parseK). *) -(* swap{2}6-1;sp. *) -(* conseq(:_==> INV IBlockSponge.m{2} ICORE.m{1} /\ *) -(* (forall j, 0 < j <= n0{1} => *) -(* format p0{1} j \in dom IBlockSponge.m{2}));1:smt(parseK formatK). *) -(* conseq(: INV IBlockSponge.m{2} ICORE.m{1} /\ (forall (j : int), *) -(* 0 < j < n0{1} => format p0{1} j \in dom IBlockSponge.m{2}) /\ *) -(* (p0,n0){1} = parse x1{2} /\ (x=x1){2} /\ ={p0,n0} /\ *) -(* n0{1} = i{2} /\ 0 <= i0{2} < i{2} *) -(* ==> _);1:smt(parseK formatK). *) -(* seq 1 1 : (INV IBlockSponge.m{2} ICORE.m{1} /\ 0 < n0{2} /\ *) -(* (forall (j : int), 0 < j <= n0{1} => *) -(* format p0{1} j \in dom IBlockSponge.m{2}) /\ *) -(* (p0,n0){1} = parse x1{2} /\ ={p0,n0} /\ (x=x1){2});last first. *) -(* + rcondf{2}1;auto;smt(parseK formatK). *) -(* splitwhile{2}1:(i0+1 *) -(* format p0{1} j \in dom IBlockSponge.m{2}) /\ *) -(* (p0,n0){1} = parse x1{2} /\ ={p0,n0} /\ (x=x1){2});last first. *) -(* + rcondt{2}1;1:auto=>/#;rcondf{2}4;1: by progress;sp;if;auto=>/#. *) -(* sp;if;auto;progress. *) -(* + rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. *) -(* cut->/=:!size p0{2} + i0{2} < size p0{2} by rewrite/#. *) -(* smt(in_dom formatK). *) -(* + move:H3;rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. *) -(* cut->/=:!size p0{2} + i0{2} < size p0{2} by rewrite/#. *) -(* smt(in_dom formatK). *) -(* + rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. *) -(* smt(getP parseK formatK). *) -(* + rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. *) -(* smt(in_dom getP parseK formatK). *) -(* + case(j=i0{2} + 1)=>//=;2:rewrite/#. *) -(* smt(in_dom getP parseK formatK). *) -(* while{2}((p0{2}, n0{2}) = parse x1{2} /\ (x=x1){2} /\ 0 <= i0{2} < n0{2} /\ *) -(* INV IBlockSponge.m{2} ICORE.m{1} /\ (p0,n0){1} = parse x1{2} /\ *) -(* ={p0,n0} /\ (forall (j : int), 0 < j < n0{2} => *) -(* format p0{2} j \in dom IBlockSponge.m{2}))(n0{2}-i0{2});progress. *) -(* + sp;rcondf 1;auto;progress. *) -(* + rewrite-(formatK x1{hr})-H3/=take_cat addzAC/=/=take_nseq/min/=. *) -(* cut->/=:!size p0{hr} + i0{hr} < size p0{hr} by rewrite/#. *) -(* by cut/#:=H4 (i0{hr}+1). *) -(* + by rewrite/#. *) -(* by rewrite/#. *) -(* by auto=>/#. *) - -(* + proc (INV IBlockSponge.m{2} ICORE.m{1})=> //. *) -(* proc=> /=; sp;if=> [&1 &2 [#] <*>| |] //=. *) -(* inline{2} 1.1. *) -(* inline*. *) -(* while( INV IBlockSponge.m{2} ICORE.m{1} *) -(* /\ 0 < i{1} <= n{1} + 1 *) -(* /\ ={n,p,r,i} *) -(* /\ valid p{1} *) -(* /\ 0 < n{1} *) -(* /\ (forall j, 0 < j < i{1} => *) -(* format p{2} j \in dom IBlockSponge.m{2}));last auto=>/#. *) -(* rcondt{2}5;auto;1:smt(parseK). *) -(* swap{2}6-1;sp. *) -(* conseq(:_==> INV IBlockSponge.m{2} ICORE.m{1} /\ *) -(* (forall j, 0 < j <= n0{1} => *) -(* format p0{1} j \in dom IBlockSponge.m{2}));1:smt(parseK formatK). *) -(* conseq(: INV IBlockSponge.m{2} ICORE.m{1} /\ (forall (j : int), *) -(* 0 < j < n0{1} => format p0{1} j \in dom IBlockSponge.m{2}) /\ *) -(* (p0,n0){1} = parse x1{2} /\ (x=x1){2} /\ ={p0,n0} /\ *) -(* n0{1} = i{2} /\ 0 <= i0{2} < i{2} *) -(* ==> _);1:smt(parseK formatK). *) -(* seq 1 1 : (INV IBlockSponge.m{2} ICORE.m{1} /\ 0 < n0{2} /\ *) -(* (forall (j : int), 0 < j <= n0{1} => *) -(* format p0{1} j \in dom IBlockSponge.m{2}) /\ *) -(* (p0,n0){1} = parse x1{2} /\ ={p0,n0} /\ (x=x1){2});last first. *) -(* + rcondf{2}1;auto;smt(parseK formatK). *) -(* splitwhile{2}1:(i0+1 *) -(* format p0{1} j \in dom IBlockSponge.m{2}) /\ *) -(* (p0,n0){1} = parse x1{2} /\ ={p0,n0} /\ (x=x1){2});last first. *) -(* + rcondt{2}1;1:auto=>/#;rcondf{2}4;1: by progress;sp;if;auto=>/#. *) -(* sp;if;auto;progress. *) -(* + rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. *) -(* cut->/=:!size p0{2} + i0{2} < size p0{2} by rewrite/#. *) -(* smt(in_dom formatK). *) -(* + move:H3;rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. *) -(* cut->/=:!size p0{2} + i0{2} < size p0{2} by rewrite/#. *) -(* smt(in_dom formatK). *) -(* + rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. *) -(* smt(getP parseK formatK). *) -(* + rewrite-(formatK x1{2})-H2/=take_cat addzAC/=-addzA/=take_nseq/min/=. *) -(* smt(in_dom getP parseK formatK). *) -(* + case(j=i0{2} + 1)=>//=;2:rewrite/#. *) -(* smt(in_dom getP parseK formatK). *) -(* while{2}((p0{2}, n0{2}) = parse x1{2} /\ (x=x1){2} /\ 0 <= i0{2} < n0{2} /\ *) -(* INV IBlockSponge.m{2} ICORE.m{1} /\ (p0,n0){1} = parse x1{2} /\ *) -(* ={p0,n0} /\ (forall (j : int), 0 < j < n0{2} => *) -(* format p0{2} j \in dom IBlockSponge.m{2}))(n0{2}-i0{2});progress. *) -(* + sp;rcondf 1;auto;progress. *) -(* + rewrite-(formatK x1{hr})-H3/=take_cat addzAC/=/=take_nseq/min/=. *) -(* cut->/=:!size p0{hr} + i0{hr} < size p0{hr} by rewrite/#. *) -(* by cut/#:=H4 (i0{hr}+1). *) -(* + by rewrite/#. *) -(* by rewrite/#. *) -(* by auto=>/#. *) - -(* + proc. *) -(* sp;if=> [&1 &2 [#] <*>/#| |] //=. *) -(* inline*;sp;rcondt{1}1;auto. *) -(* swap{2}1;sp. *) -(* conseq(:_==> last Block.b0 r0{1} = oget IBlockSponge.m{2}.[x{2}] /\ *) -(* INV IBlockSponge.m{2} ICORE.m{1});progress. *) -(* seq 1 1 :(last Block.b0 r0{1} = oget IBlockSponge.m{2}.[x{2}] /\ *) -(* INV IBlockSponge.m{2} ICORE.m{1} /\ *) -(* x1{2} \in dom IBlockSponge.m{2});last by rcondf{2}1;auto=>/#. *) -(* conseq(:_==> INV IBlockSponge.m{2} ICORE.m{1} /\ i{2} = n{2} /\ *) -(* Some (last Block.b0 r0{1}) = *) -(* IBlockSponge.m{2}.[take (size p + i){2} x{2}]);progress. *) -(* + move:H5;rewrite take_oversize;2:smt(oget_some). *) -(* by rewrite-formatK/=-H/=size_cat size_nseq/#. *) -(* + move:H5;rewrite take_oversize. *) -(* + by rewrite-formatK/=-H/=size_cat size_nseq/#. *) -(* by rewrite in_dom/#. *) -(* while( i{1} = i{2}+1 /\ n0{1} = n{2} /\ p{2} = p0{1} *) -(* /\ valid p0{1} /\ 0 < i{1} /\ i{2} <= n{2} *) -(* /\ (i{2} = n{2} => Some (last Block.b0 r0{1}) = *) -(* IBlockSponge.m{2}.[take (size p{2} + i{2}) x{2}]) *) -(* /\ INV IBlockSponge.m{2} ICORE.m{1} *) -(* /\ parse x{2} = (p0{1},n0{1}));auto;last first. *) -(* + progress=>/#. *) -(* sp;if;auto;smt(take_nseq parseK in_dom formatK take_cat getP last_rcons). *) - -(* by inline*;auto;call(:true);auto;smt(in_dom dom0 in_fset0). *) -(* qed. *) - - end section PROOF. - - -require import Gconcl. -print Gconcl. -print SLCommon.GReal. -print SLCommon.SqueezelessSponge. -print SLCommon.IdealIndif. -print SLCommon.RealIndif. -print SLCommon.DPRestr. -print SLCommon.DISTINGUISHER. -print DISTINGUISHER. -print SLCommon.DFUNCTIONALITY. -print SLCommon.DPRIMITIVE. -print DFUNCTIONALITY. -print DPRIMITIVE. \ No newline at end of file From 13e49a987b6438d018de4dd7e95d7552bbb1fa22 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Mon, 15 Jan 2018 18:32:49 +0100 Subject: [PATCH 256/525] . --- proof/Common.ec | 23 ++-- proof/clean/BlockSponge.eca | 256 +++++++++++++++++++++++++++++++++--- proof/clean/NewCore.eca | 2 +- proof/core/Gconcl.ec | 2 +- 4 files changed, 252 insertions(+), 31 deletions(-) diff --git a/proof/Common.ec b/proof/Common.ec index 08fbb22..b509940 100644 --- a/proof/Common.ec +++ b/proof/Common.ec @@ -16,6 +16,7 @@ require (*--*) FinType BitWord RP Monoid. pragma +implicits. + (* -------------------------------------------------------------------- *) op r : { int | 2 <= r } as ge2_r. op c : { int | 0 < c } as gt0_c. @@ -24,6 +25,7 @@ type block. (* ~ bitstrings of size r *) type capacity. (* ~ bitstrings of size c *) (* -------------------------------------------------------------------- *) + lemma gt0_r: 0 < r. proof. by apply/(ltr_le_trans 2)/ge2_r. qed. @@ -36,22 +38,23 @@ clone BitWord as Capacity with op n <- c proof gt0_n by apply/gt0_c - rename "dword" as "cdistr" - "word" as "cap" - "zerow" as "c0". - -op cdistr = Capacity.DWord.dunifin. + rename "word" as "capacity" + "dunifin" as "cdistr" + "Word" as "Capacity" + "zerow" as "c0". +export Capacity DCapacity. clone export BitWord as Block with type word <- block, op n <- r proof gt0_n by apply/gt0_r - rename "word" as "block" - "Word" as "Block" - "zerow" as "b0". + rename "word" as "block" + "Word" as "Block" + "zerow" as "b0" + "dunifin" as "bdistr". +export DBlock. -op bdistr = DBlock.dunifin. (* ------------------------- Auxiliary Lemmas ------------------------- *) @@ -105,7 +108,7 @@ by rewrite (@last_nonempty y z). qed. (*------------------------------ Primitive -----------------------------*) - +print Block. clone export RP as Perm with type t <- block * capacity, op dt <- bdistr `*` cdistr diff --git a/proof/clean/BlockSponge.eca b/proof/clean/BlockSponge.eca index b2629c8..0fe48ea 100644 --- a/proof/clean/BlockSponge.eca +++ b/proof/clean/BlockSponge.eca @@ -5,8 +5,9 @@ require (*--*) StdBigop. require import StdOrder. (*---*) import IntOrder. -require import NewCommon Gconcl. -(*---*) import Block DBlock Capacity DCapacity SLCommon. +require import Gconcl. +(*---*) import Common SLCommon. +(*---*) import Block DBlock Capacity DCapacity. (*** THEORY PARAMETERS ***) (** Validity of Functionality Queries **) @@ -240,28 +241,35 @@ module DFC1 (F : FUNCTIONALITY) : FUNCTIONALITY = { } }. +module P = Common.Perm.Perm. +print Real_Ideal. (*** PROOF forall P D S, HiDist(D)^{BlockSponge(P),P} ~ HiDist(D)^{IBlockSponge,S(IBlockSponge)} => D^{Core(P),P} ~ D^{ICore,LowSim(S,ICore)} ***) section PROOF. - declare module P : PRIMITIVE { Low.ICORE, IBlockSponge, HiDist, C }. declare module S : SIMULATOR { Low.ICORE, IBlockSponge, HiDist, C, P }. declare module D : Low.DISTINGUISHER { Low.ICORE, IBlockSponge, HiDist, C, P, S }. - - (* FIXME : is this the eager we want ? *) local module EagerCORE (P : Low.PRIMITIVE) = { var order : block list var capa : capacity var blo : block + var map : (block * capacity) list proc init() = { order <- []; capa <- c0; blo <- b0; + map <- []; CORE(P).init(); } + proc g(bi,ci) = { + var bj, cj; + (bj,cj) <@ P.f(bi,ci); + map <- rcons map (bi,ci); + return (bj,cj); + } proc f (p : block list, n : int) = { var r : block list; var i : int; @@ -290,11 +298,42 @@ section PROOF. var i : int <- 0; blo <- b0; capa <- c0; + map <- []; while(i < size order) { - (blo,capa) <@ P.f(blo +^ nth witness order i,capa); + (blo,capa) <@ g(blo +^ nth witness order i,capa); + i <- i + 1; + } + } + proc nwhile(k : int) : block list = { + var i : int <- 1; + var result : block list <- []; + ewhile(); + result <- rcons result EagerCORE.blo; + while(i < k) { + EagerCORE.order <- rcons EagerCORE.order b0; + (blo,capa) <@ g(blo,capa); + result <- rcons result EagerCORE.blo; i <- i + 1; - } + } + return result; } + proc enwhile(k : int) : block list = { + var i : int <- 1; + var m : (block * capacity) list <- []; + var result : block list <- []; + ewhile(); + result <- rcons result EagerCORE.blo; + while(i < k) { + EagerCORE.order <- rcons EagerCORE.order b0; + m <- rcons EagerCORE.map (EagerCORE.blo, EagerCORE.capa); + ewhile(); + EagerCORE.map <- m; + result <- rcons result EagerCORE.blo; + i <- i + 1; + } + return result; + } + }. local module EagCORE (P : Low.PRIMITIVE) : Low.FUNCTIONALITY = { @@ -325,6 +364,138 @@ section PROOF. }. + local equiv nwhile_enwhile (n : int) : + EagerCORE(P).nwhile ~ EagerCORE(P).enwhile : + ={arg, glob P, glob EagerCORE} /\ arg{1} = n ==> ={res, glob P, glob EagerCORE}. + proof. + move:n;elim/natind=>n Hn0. + + by proc;sp;rcondf{1}3;progress;2:rcondf{2}3;progress;-1:sim; + (inline*;wp;while(!i/#). + move=>Hind;case(1 <= n)=>Hn1;last first. + + by proc;sp;rcondf{1}3;2:rcondf{2}3;-1:sim;progress;inline*; + by wp;while(!i/#. + proc. + replace{1} { (!<-) as init ; rest} by { + init; + result <@ EagerCORE(P).nwhile(n); + EagerCORE.order <- rcons EagerCORE.order b0; + (EagerCORE.blo,EagerCORE.capa) <@ EagerCORE(P).g(EagerCORE.blo,EagerCORE.capa); + result <- rcons result EagerCORE.blo; + i <- i + 1; + } + (={glob P, glob EagerCORE} /\ k{1} = n + 1 + ==> ={result, glob P, glob EagerCORE}) + (={glob P, glob EagerCORE} /\ k{2} = n + 1 + ==> ={result, glob P, glob EagerCORE}); + progress;1:rewrite/#. + + sp;inline{2}1;sp;sim. + splitwhile{1}3: i < n. + rcondt{1}4;progress. + + inline*;while(i <= n /\ k = n + 1);1:(sp;if;auto=>/#). + by conseq(:_==> true);1:progress=>/#;auto. + rcondf{1}8;progress. + + inline*;sp;wp;conseq(:_==> i=n);progress. + seq 3 : (i = n);last by sp;if;auto. + while(i <= n);first by sp;if;auto=>/#. + by conseq(:_==> true);2:auto;progress=>/#. + wp;sim. + while(={glob P, glob EagerCORE} /\ (result,i,n){1} = (result0,i0,k0){2} + /\ k{1} = n + 1);1:(inline*;sp;if;auto=>/#). + by wp;conseq(:_==> ={glob P, glob EagerCORE});1:progress=>/#;sim. + + replace{2} { (!<-) as init ; rest} by { + init; + result <@ EagerCORE(P).enwhile(n); + EagerCORE.order <- rcons EagerCORE.order b0; + m <- rcons EagerCORE.map (EagerCORE.blo, EagerCORE.capa); + EagerCORE(P).ewhile(); + EagerCORE.map <- m; + result <- rcons result EagerCORE.blo; + i <- i + 1; + } + (={glob P, glob EagerCORE} + ==> ={result, glob P, glob EagerCORE}) + (={glob P, glob EagerCORE} /\ k{2} = n + 1 + ==> ={result, glob P, glob EagerCORE}); + progress;1:rewrite/#;last first. + + sp;inline{1}1;sp;sim. + splitwhile{2}3: i < n. + rcondt{2}4;2:rcondf{2}10;progress. + + by while(i <= n /\ k = n + 1);by inline*;sp;wp;conseq(:_==> true);auto=>/#. + + wp;conseq(:_==> i = n);progress. + seq 3 : (i = n);last by inline*;conseq(:_==> true);auto. + by while(i <= n /\ k = n + 1); by inline*;sp;wp;conseq(:_==> true);auto=>/#. + sim. + while(={glob P, glob EagerCORE} /\ (result,i,n){2} = (result0,i0,k0){1} + /\ k{2} = n + 1);1:inline*. + + by sp;wp;conseq(:_==> ={glob P, glob EagerCORE} /\ i1{1} = i0{2}); + 1:progress=>/#;sim. + by wp;conseq(:_==> ={glob P, glob EagerCORE});1:progress=>/#;sim. + + replace{2} { (! <- as before); <@ ; after} by { + before; + result <@ EagerCORE(P).nwhile(n); + after; + } + (={glob P, glob EagerCORE} ==> ={result, glob P, glob EagerCORE}) + (={glob P, glob EagerCORE} ==> ={result, glob P, glob EagerCORE}); + progress;1:rewrite/#;last by sim;call(Hind);auto. + + sp;sim. (* TODO : reprendre ici *) + + + seq 1 1 : (={glob P, glob EagerCORE, result} + /\ size EagerCORE.order{2} = size EagerCORE.map{1} + /\ (forall j, 0 <= j < size EagerCORE.map{1} => + nth (b0,c0) EagerCORE.map{1} j \in dom Perm.m{1}) + /\ Some (EagerCORE.blo,EagerCORE.capa){1} = + Perm.m{2}.[last (b0,c0) EagerCORE.map{1}] + /\ (forall j, 0 <= j < size EagerCORE.map{1} - 1 => + let v = nth (b0,c0) EagerCORE.map{1} j in + let (e,f) = nth (b0,c0) EagerCORE.map{1} (j+1) in + let ej = nth witness EagerCORE.order{1} (j+1) in + Perm.m{1}.[v] = Some (e +^ ej, f)));last first. + + inline*. + splitwhile{2}7:i0 < size EagerCORE.order - 1. + rcondt{2}8;2:rcondf{2}16;progress. + + by while(i0 < size EagerCORE.order);1:(sp;if);auto;smt(size_rcons size_ge0). + + wp;conseq(:_==> i0 = size EagerCORE.order-1);1:progress=>/#. + seq 7:(i0 = size EagerCORE.order-1);2:(sp;if;auto=>/#). + by while(i0 <= size EagerCORE.order - 1);1:(sp;if);auto;smt(size_rcons size_ge0). + sim. + swap{1}-3;sim;sp 1 2;wp. + conseq(:_==> ={Perm.m, Perm.mi, EagerCORE.blo, EagerCORE.capa} + /\ i0{2} = size EagerCORE.order{2} - 1);progress. + + by rewrite nth_rcons size_rcons-addzA/=Block.WRing.addr0/#. + while{2}( ={Perm.m, Perm.mi, EagerCORE.order} + /\ 0 <= i0{2} <= size EagerCORE.order{2} - 1 + /\ take i0{2} EagerCORE.map{1} = EagerCORE.map{2} + /\ m{2} = EagerCORE.map{1} + /\ (EagerCORE.blo{2} +^ nth witness EagerCORE.order{2} i0{2}, + EagerCORE.capa{2}) = nth (b0,c0) m{2} i0{2} + /\ size EagerCORE.order{2} = size EagerCORE.map{1} + /\ (forall j, 0 <= j < size EagerCORE.map{1} => + nth (b0,c0) EagerCORE.map{1} j \in dom Perm.m{2}) + /\ (forall j, 0 <= j < size EagerCORE.map{1} - 1 => + let v = nth (b0,c0) EagerCORE.map{1} j in + let e = nth (b0,c0) EagerCORE.map{1} (j+1) in + let ej = nth witness EagerCORE.order{1} (j+1) in + Perm.m{2}.[v] = Some (e.`1 +^ ej, e.`2)) + )(size EagerCORE.order{2} - 1 - i0{2});progress;auto. + + rcondf 4;auto;progress;..4,6:smt(take_nth). + + by rewrite H1;cut->/=:=H4 i0{hr} _;1:rewrite/#; + rewrite oget_some/= -Block.WRing.addrA Block.WRing.addrN Block.WRing.addr0/#. + progress. + + smt(size_rcons size_ge0). + + smt(size_rcons size_ge0). + + smt(size_rcons size_ge0). + + smt(size_rcons size_ge0). + + smt(size_rcons size_ge0). + + smt(size_rcons size_ge0). + + smt(size_rcons size_ge0). + + qed. + equiv core_blocksponge : Low.Indif(DFCn(CORE(P)),DPC(P),D).main ~ Indif(DFC1(BlockSponge(P)),DPC(P),HiDist(D)).main : @@ -334,11 +505,7 @@ section PROOF. (={glob D, glob P} ==> ={res, C.c}) (={glob D, glob P} ==> ={res, C.c} /\ ={c}(C,HiDist));progress;1:rewrite/#. + proc=>/=;call (_: ={glob P, C.c}); first 2 by sim. - + proc=> /=;inline*;sp;if;auto;sp;if;auto;sim. - conseq(:_==> sc{1} = EagerCORE.capa{2} /\ sa{1} = EagerCORE.blo{2} - /\ ={glob P});progress. - by while( ={i,p0,glob P} /\ sc{1} = EagerCORE.capa{2} - /\ sa{1} = EagerCORE.blo{2});auto;call(:true);auto. + + by proc=> /=;inline*;sp;if;auto;sp;if;auto;sim. by inline*;auto;call(:true);auto. @@ -354,21 +521,72 @@ section PROOF. EagerCORE(P).ewhile(); rest; } - (={glob P, EagerCORE.order, r0, n0} /\ i{1} = 0 + (={glob P, EagerCORE.order, r0, p0, n0} /\ i{1} = 0 /\ (EagerCORE.blo,EagerCORE.capa,EagerCORE.order){1} = (b0,c0,p0{1}) ==> ={r0, glob P}) - (={glob P,glob EagerCORE, n0,r0} ==> ={r0, glob P}); + (={glob P,glob EagerCORE, n0, p0, r0} ==> ={r0, glob P}); progress;1:rewrite/#;first inline*;sim;auto;progress. (* eager part *) - admit. + replace{2} {| (<@ as ewhile); rest } by { + rest; + EagerCORE.order <- take (size EagerCORE.order - 1) EagerCORE.order; + ewhile; + } + (={glob P, glob EagerCORE, n0, p0, r0} ==> ={r0, glob P}) + (={glob P, glob EagerCORE, n0, p0, r0} ==> ={r0, glob P}); + progress;1:rewrite/#;last first. + + + + + replace{2} { begin ; while } by { + begin; + while(i < n0) { + EagerCORE(Perm).ewhile(); + EagerCORE.order <- rcons EagerCORE.order b0; + i <- i + 1; + (EagerCORE.blo, EagerCORE.capa) <@ + Perm.f(EagerCORE.blo, EagerCORE.capa); + r0 <- rcons r0 EagerCORE.blo; + } + } + (={glob P, glob EagerCORE, n0, p0, r0} ==> ={r0, glob P}) + (={glob P, glob EagerCORE, n0, p0, r0} ==> ={r0, glob P}); + progress;1:rewrite/#;last first. + + while(={r0, p0, n0, i, glob P, glob EagerCORE}); + last by conseq(:_==> ={r0, p0, n0, i, glob P, glob EagerCORE});progress;sim. + inline*;sp. swap{1}3 2;wp=>//=. + splitwhile{2}1: i0 < size EagerCORE.order - 1. + rcondt{2}2;progress. + + by while(i0 < size EagerCORE.order);1:(sp;if);auto;smt(size_ge0). + rcondf{2}6;progress. + + seq 1 : (i0 = size EagerCORE.order - 1);last by sp;if;auto=>/#. + by while(0 <= i0 < size EagerCORE.order);1:(sp;if);auto;smt(size_ge0 size_rcons). + wp=>/=. + conseq(:_==> ={glob P, glob EagerCORE, r0, x});progress;sim. + wp. + conseq(:_==> ={glob P, EagerCORE.blo, EagerCORE.capa, r0} + /\ i0{2} = size EagerCORE.order{2} - 1 + /\ rcons EagerCORE.order{1} b0 = EagerCORE.order{2});progress. + + by rewrite nth_rcons size_rcons-addzA/=Block.WRing.addr0. + conseq(:_==> ={glob P, EagerCORE.blo, EagerCORE.capa, r0} + /\ i0{2} = size EagerCORE.order{1});progress. + + smt(size_rcons). + while( ={glob P, EagerCORE.blo, EagerCORE.capa, r0, i0} + /\ rcons EagerCORE.order{1} b0 = EagerCORE.order{2} + /\ 0 <= i0{2} <= size EagerCORE.order{1}); + last auto;smt(size_ge0 size_rcons). + wp;conseq(:_==> ={glob P, EagerCORE.blo, EagerCORE.capa, r0, i0} + /\ x0{1} = x{2});1:smt(size_rcons). + by sp;sim;smt(nth_rcons size_rcons). + + by inline*;auto;call(:true);auto. + proc;inline{2}3;wp;call (_: ={glob P, C.c} /\ ={c}(C,HiDist)). - + by proc;inline*;sp;auto;if;auto;sp;rcondt{2}1;auto;call(:true);auto. - + by proc;inline*;sp;auto;if;auto;sp;rcondt{2}1;auto;call(:true);auto. + + by proc;inline*;sp;auto;if;auto;sp;rcondt{2}1;auto;sp;if;auto. + + by proc;inline*;sp;auto;if;auto;sp;rcondt{2}1;auto;sp;if;auto. proc;inline*;sp;auto. if;1:progress=>/#;sp;wp. rcondt{1}1;1:auto=>/#;sp. @@ -411,7 +629,7 @@ section PROOF. + rewrite/#. while(={glob P} /\ (i1,EagerCORE.order,EagerCORE.blo,EagerCORE.capa){1} = (i0,p0,sa,sc){2});auto. - + by call(:true);auto. + + by sp;if;auto. progress. + by rewrite rcons_cat-nseqSr 1:/# -addzA/=/format-addzA/=. + by move:H6;rewrite rcons_cat-nseqSr 1:/# -addzA/=/format-addzA/=. @@ -427,7 +645,7 @@ section PROOF. + rewrite/#. while(={glob P} /\ (i0,EagerCORE.order,EagerCORE.blo,EagerCORE.capa){1} = (i0,p0,sa,sc){2});auto. - + by call(:true);auto. + + by sp;if;auto. progress. + by rewrite/format nseq0 cats0/#. + by rewrite size_cat nseq0/#. diff --git a/proof/clean/NewCore.eca b/proof/clean/NewCore.eca index 56a5c10..b42ce5c 100644 --- a/proof/clean/NewCore.eca +++ b/proof/clean/NewCore.eca @@ -4,7 +4,7 @@ require import StdOrder Ring DProd. require (*..*) RP Indifferentiability. -require import NewCommon. +require import Common. (*---*) import Block DBlock Capacity DCapacity. (** Validity of Functionality Queries **) diff --git a/proof/core/Gconcl.ec b/proof/core/Gconcl.ec index 1215e7e..38284c7 100644 --- a/proof/core/Gconcl.ec +++ b/proof/core/Gconcl.ec @@ -5,7 +5,6 @@ require import DProd Dexcepted. (*...*) import Capacity IntOrder Bigreal RealOrder BRA. require (*..*) Gext. -print F.RO. module IF = { proc init = F.RO.init @@ -364,6 +363,7 @@ axiom D_ll : islossless P.f => islossless P.fi => islossless F.f => islossless D(F, P).distinguish. + lemma Real_Ideal &m: Pr[GReal(D).main() @ &m: res /\ C.c <= max_size] <= Pr[IdealIndif(IF,S,DRestr(D)).main() @ &m :res] + From cad0d6a2c8786ea34dc65dced5a85ce5dab57a5a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Tue, 16 Jan 2018 18:47:54 +0100 Subject: [PATCH 257/525] . --- proof/clean/BlockSponge.eca | 285 ++++++++++++++++++++++++++++++------ 1 file changed, 244 insertions(+), 41 deletions(-) diff --git a/proof/clean/BlockSponge.eca b/proof/clean/BlockSponge.eca index 0fe48ea..016009e 100644 --- a/proof/clean/BlockSponge.eca +++ b/proof/clean/BlockSponge.eca @@ -80,7 +80,7 @@ module (BlockSponge : CONSTRUCTION) (P : DPRIMITIVE) : FUNCTIONALITY = { if (valid x /\ 0 < n) { while (i < size p) { - (sa,sc) <@ P.f((sa +^ nth witness p i,sc)); + (sa,sc) <@ P.f((sa +^ nth b0 p i,sc)); i <- i + 1; } } @@ -279,7 +279,7 @@ section PROOF. i <- 0; if (valid p /\ 0 < n) { while(i < size p) { - (blo,capa) <@ P.f(blo +^ nth witness p i, capa); + (blo,capa) <@ P.f(blo +^ nth b0 p i, capa); i <- i + 1; } i <- 1; @@ -300,7 +300,7 @@ section PROOF. capa <- c0; map <- []; while(i < size order) { - (blo,capa) <@ g(blo +^ nth witness order i,capa); + (blo,capa) <@ g(blo +^ nth b0 order i,capa); i <- i + 1; } } @@ -441,20 +441,24 @@ section PROOF. (={glob P, glob EagerCORE} ==> ={result, glob P, glob EagerCORE}); progress;1:rewrite/#;last by sim;call(Hind);auto. - sp;sim. (* TODO : reprendre ici *) - - + sp;sim. + + inline{2}4. seq 1 1 : (={glob P, glob EagerCORE, result} /\ size EagerCORE.order{2} = size EagerCORE.map{1} - /\ (forall j, 0 <= j < size EagerCORE.map{1} => - nth (b0,c0) EagerCORE.map{1} j \in dom Perm.m{1}) - /\ Some (EagerCORE.blo,EagerCORE.capa){1} = - Perm.m{2}.[last (b0,c0) EagerCORE.map{1}] - /\ (forall j, 0 <= j < size EagerCORE.map{1} - 1 => - let v = nth (b0,c0) EagerCORE.map{1} j in - let (e,f) = nth (b0,c0) EagerCORE.map{1} (j+1) in - let ej = nth witness EagerCORE.order{1} (j+1) in - Perm.m{1}.[v] = Some (e +^ ej, f)));last first. + /\ nth (b0,c0) EagerCORE.map{1} 0 = (nth b0 EagerCORE.order{1} 0, c0) + /\ (forall y, y \in EagerCORE.map{1} => y \in dom Perm.m{1}) + /\ (0 = size EagerCORE.map{1} => + (EagerCORE.blo,EagerCORE.capa){1} = (b0,c0)) + /\ (0 < size EagerCORE.map{1} => + (EagerCORE.blo,EagerCORE.capa){1} = + oget Perm.m{1}.[last (b0,c0) EagerCORE.map{1}]) + /\ (forall j, 0 < j < size EagerCORE.map{1} => + let ej = nth (b0,c0) EagerCORE.map{1} j in + let ej1 = nth (b0,c0) EagerCORE.map{1} (j-1) in + let mj = nth b0 EagerCORE.order{1} j in + Perm.m{1}.[ej1] = Some (ej.`1 +^ mj, ej.`2)));last first. + + inline*. splitwhile{2}7:i0 < size EagerCORE.order - 1. rcondt{2}8;2:rcondf{2}16;progress. @@ -467,33 +471,232 @@ section PROOF. conseq(:_==> ={Perm.m, Perm.mi, EagerCORE.blo, EagerCORE.capa} /\ i0{2} = size EagerCORE.order{2} - 1);progress. + by rewrite nth_rcons size_rcons-addzA/=Block.WRing.addr0/#. - while{2}( ={Perm.m, Perm.mi, EagerCORE.order} + alias{2}1 permm = Perm.m. + alias{2}1 permmi = Perm.mi. + sp 0 2;conseq(:_==> m{2} = rcons EagerCORE.map{1} (EagerCORE.blo{1}, EagerCORE.capa{1}) + /\ (EagerCORE.blo{2}, EagerCORE.capa{2}) = last (b0, c0) m{2} + /\ i0{2} = size EagerCORE.order{2} - 1 + /\ (Perm.m = permm /\ Perm.mi = permmi){2});1:smt(last_rcons). + + while{2}(={glob P, EagerCORE.order} + /\ (i0 = 0 => (EagerCORE.blo,EagerCORE.capa)=(b0,c0)){2} /\ 0 <= i0{2} <= size EagerCORE.order{2} - 1 - /\ take i0{2} EagerCORE.map{1} = EagerCORE.map{2} - /\ m{2} = EagerCORE.map{1} - /\ (EagerCORE.blo{2} +^ nth witness EagerCORE.order{2} i0{2}, - EagerCORE.capa{2}) = nth (b0,c0) m{2} i0{2} - /\ size EagerCORE.order{2} = size EagerCORE.map{1} - /\ (forall j, 0 <= j < size EagerCORE.map{1} => - nth (b0,c0) EagerCORE.map{1} j \in dom Perm.m{2}) - /\ (forall j, 0 <= j < size EagerCORE.map{1} - 1 => - let v = nth (b0,c0) EagerCORE.map{1} j in - let e = nth (b0,c0) EagerCORE.map{1} (j+1) in - let ej = nth witness EagerCORE.order{1} (j+1) in - Perm.m{2}.[v] = Some (e.`1 +^ ej, e.`2)) - )(size EagerCORE.order{2} - 1 - i0{2});progress;auto. - + rcondf 4;auto;progress;..4,6:smt(take_nth). - + by rewrite H1;cut->/=:=H4 i0{hr} _;1:rewrite/#; - rewrite oget_some/= -Block.WRing.addrA Block.WRing.addrN Block.WRing.addr0/#. - progress. - + smt(size_rcons size_ge0). - + smt(size_rcons size_ge0). - + smt(size_rcons size_ge0). - + smt(size_rcons size_ge0). - + smt(size_rcons size_ge0). - + smt(size_rcons size_ge0). - + smt(size_rcons size_ge0). - + /\ i0{2} = size EagerCORE.map{2} + /\ size EagerCORE.order{2}-1 = size EagerCORE.map{1} + /\ rcons EagerCORE.map{1} (last (b0,c0) m{2}) = m{2} + /\ nth (b0,c0) EagerCORE.map{1} 0 = (nth b0 EagerCORE.order{1} 0, c0) + /\ (0 < i0{2} => (EagerCORE.blo,EagerCORE.capa){2} = + oget Perm.m{1}.[last (b0,c0) EagerCORE.map{2}]) + /\ EagerCORE.map{2} = take i0{2} m{2} + /\ (Perm.m = permm /\ Perm.mi = permmi){2} + /\ (forall y, y \in EagerCORE.map{1} => y \in dom Perm.m{1}) + /\ (forall j, 0 < j < size EagerCORE.map{1} => + let ej = nth (b0,c0) EagerCORE.map{1} j in + let ej1 = nth (b0,c0) EagerCORE.map{1} (j-1) in + let mj = nth b0 EagerCORE.order{1} j in + Perm.m{1}.[ej1] = Some (ej.`1 +^ mj, ej.`2)) + /\ (EagerCORE.blo{1}, EagerCORE.capa{1}) = last (b0, c0) m{2} + /\ 1 <= size EagerCORE.order{1} + ) + (size EagerCORE.order{2} - 1 - i0{2}); + progress;1:auto. + + sp;rcondf 1;auto;progress. + + case(0Hi0;last first. + + cut h:EagerCORE.map{hr} = [] by smt(size_eq0). + rewrite h/=;cut[->->]:=H _;1:rewrite/#. + by rewrite Block.WRing.add0r H7-H4 mem_nth/#. + cut:=H5 Hi0;rewrite-nth_last. + rewrite {1}H6 nth_take 1,2:/# -H3 nth_rcons-H2. + cut->/=:size EagerCORE.map{hr} - 1 < size EagerCORE.order{hr}-1 by rewrite/#. + rewrite H8 1:/# oget_some/==>[[->->]]. + rewrite -Block.WRing.addrA Block.xorwK Block.WRing.addr0//=. + rewrite H7 H6 size_take;1:smt(size_ge0). + rewrite-H3 size_rcons-H2-addzA/= H11/=. + by cut/#:=mem_nth (b0,c0)EagerCORE.map{m}(size EagerCORE.map{hr})_;smt(size_ge0). + + by rewrite/#. + + by rewrite/#. + + by rewrite/#. + + by rewrite/#. + + smt(size_rcons). + + by rewrite last_rcons/#. + + case(0Hi0;last first. + + cut h:EagerCORE.map{hr} = [] by smt(size_eq0). + rewrite h/=;cut[->->]:=H _;1:rewrite/#. + rewrite Block.WRing.add0r(take_nth(b0,c0)0)/= 2:/#. + smt(size_rcons size_ge0). + rewrite(take_nth(b0,c0));1:smt(size_rcons size_ge0). + congr;cut:=H5 Hi0. + rewrite-nth_last {1}H6 {2}H6. + rewrite nth_take 1,2:/#. + rewrite size_take 1:/#. + rewrite-H3 size_rcons-H2-addzA/=H11/=nth_rcons. + rewrite-H3-H2/=. + cut->/=:size EagerCORE.map{hr} - 1 < size EagerCORE.order{hr} - 1 by rewrite/#. + rewrite H8 1:/# oget_some/==>[[->->]]. + rewrite -Block.WRing.addrA Block.xorwK Block.WRing.addr0//=. + rewrite nth_rcons. + by rewrite-H3-H2/=H12/=/#. + by rewrite/#. + + sp;auto;progress. + + smt(size_ge0 size_rcons). + + smt(size_ge0 size_rcons). + + smt(last_rcons). + + smt(nth_rcons size_ge0). + + smt(take0). + + smt(nth_rcons). + + smt(last_rcons). + + smt(size_ge0 size_rcons). + + smt(size_ge0 size_rcons). + + case(size map_R = 0)=>HmapR. + + cut:=size_eq0 map_R;rewrite HmapR/==>{HmapR}HmapR. + cut Hmap1:(size EagerCORE.map{1} = 0) by rewrite/#. + cut:=size_eq0 EagerCORE.map{1};rewrite Hmap1/==>{Hmap1}Hmap1. + rewrite Hmap1=>/={Hind}. + move:H6;rewrite HmapR/==>[[->->]]. + by move:H2;rewrite Hmap1/==>[[->->]]. + cut h:size order_R = size map_R by rewrite/#. + rewrite last_rcons H12 1:/# -nth_last {1}H13 nth_take 1,2:/#. + rewrite nth_rcons-H9 size_rcons-addzA/=h. + cut->/=:size map_R - 1 < size map_R by rewrite/#. + cut->:size map_R = size EagerCORE.map{1} by rewrite/#. + by rewrite nth_last/#. + smt(size_ge0 size_rcons). + + inline*;wp. + case(size EagerCORE.order{1} = 0). + + sp;rcondf{1}1;2:rcondf{2}1;auto;progress;1,2:smt(size_eq0 size_ge0). + while(={Perm.mi, Perm.m, k0} /\ i0{1} = i1{2} /\ k0{1} = n /\ + ={EagerCORE.map, EagerCORE.blo, EagerCORE.capa, EagerCORE.order} /\ + ={result0} /\ + size EagerCORE.order{2} = size EagerCORE.map{1} /\ + nth (b0, c0) EagerCORE.map{1} 0 = (nth b0 EagerCORE.order{1} 0, c0) /\ + (forall (y1 : block * capacity), + y1 \in EagerCORE.map{1} => y1 \in dom Perm.m{1}) /\ + (0 = size EagerCORE.map{1} => + EagerCORE.blo{1} = b0 && EagerCORE.capa{1} = c0) /\ + (0 < size EagerCORE.map{1} => + (EagerCORE.blo{1}, EagerCORE.capa{1}) = + oget Perm.m{1}.[last (b0, c0) EagerCORE.map{1}]) /\ + forall (j : int), + 0 < j < size EagerCORE.map{1} => + Perm.m{1}.[nth (b0, c0) EagerCORE.map{1} (j - 1)] = + Some + ((nth (b0, c0) EagerCORE.map{1} j).`1 +^ + nth b0 EagerCORE.order{1} j, (nth (b0, c0) EagerCORE.map{1} j).`2));auto;progress. + + sp;if;auto;progress. + + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0 nth_rcons). + + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0 nth_rcons). + + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0 nth_rcons). + + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0 nth_rcons). + + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0 nth_rcons). + + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0 nth_rcons). + + rewrite getP !nth_rcons. rewrite size_rcons in H11. + cut->/=:j - 1 < size EagerCORE.map{2} by rewrite/#. + rewrite H. + case(jHj/=. + + cut->/=:!nth (b0, c0) EagerCORE.map{2} (j - 1) = + (EagerCORE.blo{2}, EagerCORE.capa{2}) + by cut/#:nth (b0, c0) EagerCORE.map{2} (j - 1) \in dom Perm.m{2};smt(mem_nth). + by rewrite H4//. + cut->/=:j=size EagerCORE.map{2} by rewrite/#. + cut->/=:!nth (b0, c0) EagerCORE.map{2} (size EagerCORE.map{2} - 1) = + (EagerCORE.blo{2}, EagerCORE.capa{2}) by smt(mem_nth). + by rewrite Block.WRing.addr0 H3;smt(get_oget mem_nth nth_last). + + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0 nth_rcons). + + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0 nth_rcons). + + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0 nth_rcons). + + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0 nth_rcons). + + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0 nth_rcons). + + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0 nth_rcons). + + rewrite !nth_rcons. rewrite size_rcons in H9. + cut->/=:j - 1 < size EagerCORE.map{2} by rewrite/#. + rewrite H. + case(jHj/=. + by rewrite H4//. + cut->/=:j=size EagerCORE.map{2} by rewrite/#. + by rewrite Block.WRing.addr0 H3;smt(get_oget mem_nth nth_last). + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0 nth_rcons size_eq0). + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0 nth_rcons). + + + while(={glob P, glob EagerCORE, result0, k0} + /\ size EagerCORE.order{2} = size EagerCORE.map{1} + /\ i1{2} <= size EagerCORE.order{2} + /\ 1 <= i1{2} <= k0{2} /\ k0{2} = n + /\ i1{2} = i0{1} + /\ nth (b0, c0) EagerCORE.map{1} 0 = (nth b0 EagerCORE.order{1} 0, c0) + /\ (forall (y1 : block * capacity), + y1 \in EagerCORE.map{1} => y1 \in dom Perm.m{1}) + /\ (0 = size EagerCORE.map{1} => + (EagerCORE.blo{1}, EagerCORE.capa{1}) = (b0, c0)) + /\ (0 < size EagerCORE.order{1} => + (EagerCORE.blo{1}, EagerCORE.capa{1}) = + oget Perm.m{1}.[last (b0, c0) EagerCORE.map{1}]) + /\ (forall (j : int), 0 < j < size EagerCORE.map{1} => + let ej = nth (b0, c0) EagerCORE.map{1} j in + let ej1 = nth (b0, c0) EagerCORE.map{1} (j - 1) in + let mj = nth b0 EagerCORE.order{1} j in + Perm.m{1}.[ej1] = Some (ej.`1 +^ mj, ej.`2))). + + sp;if;auto;progress. + + smt(size_rcons size_ge0). + + smt(size_rcons size_ge0). + + smt(size_rcons size_ge0). + + smt(size_rcons size_ge0). + + smt(size_rcons size_ge0 nth_rcons). + + smt(mem_rcons dom_set in_fsetU1). + + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0). + + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0). + + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0). + + rewrite getP !nth_rcons. rewrite size_rcons in H14. + cut->/=:j - 1 < size EagerCORE.map{2} by rewrite/#. + rewrite H. + case(jHj/=. + + cut->/=:!nth (b0, c0) EagerCORE.map{2} (j - 1) = + (EagerCORE.blo{2}, EagerCORE.capa{2}) + by cut/#:nth (b0, c0) EagerCORE.map{2} (j - 1) \in dom Perm.m{2};smt(mem_nth). + by rewrite H7//. + cut->/=:j=size EagerCORE.map{2} by rewrite/#. + cut->/=:!nth (b0, c0) EagerCORE.map{2} (size EagerCORE.map{2} - 1) = + (EagerCORE.blo{2}, EagerCORE.capa{2}) by smt(mem_nth). + by rewrite Block.WRing.addr0 H6;smt(get_oget mem_nth nth_last). + + + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0). + + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0). + + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0). + + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0 nth_rcons). + + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0 nth_rcons). + + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0 nth_rcons). + + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0 nth_rcons). + + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0 nth_rcons). + + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0 nth_rcons). + + rewrite !nth_rcons. rewrite size_rcons in H12. + cut->/=:j - 1 < size EagerCORE.map{2} by rewrite/#. + rewrite H. + case(jHj/=. + by rewrite H7//. + cut->/=:j=size EagerCORE.map{2} by rewrite/#. + by rewrite Block.WRing.addr0 H6;smt(get_oget mem_nth nth_last). + wp;sp. + + conseq(:_==> ={glob P, glob EagerCORE, result0, k0} + /\ size EagerCORE.order{2} = size EagerCORE.map{1} + /\ nth (b0, c0) EagerCORE.map{1} 0 = (nth b0 EagerCORE.order{1} 0, c0) + /\ (forall (y1 : block * capacity), + y1 \in EagerCORE.map{1} => y1 \in dom Perm.m{1}) + /\ (0 = size EagerCORE.map{1} => + (EagerCORE.blo{1}, EagerCORE.capa{1}) = (b0, c0)) + /\ (0 < size EagerCORE.order{1} => + (EagerCORE.blo{1}, EagerCORE.capa{1}) = + oget Perm.m{1}.[last (b0, c0) EagerCORE.map{1}]) + /\ (forall (j : int), 0 < j < size EagerCORE.map{1} => + let ej = nth (b0, c0) EagerCORE.map{1} j in + let ej1 = nth (b0, c0) EagerCORE.map{1} (j - 1) in + let mj = nth b0 EagerCORE.order{1} j in + Perm.m{1}.[ej1] = Some (ej.`1 +^ mj, ej.`2)));1:smt(size_ge0). + + (* TODO : reprendre ici *) + admit. qed. equiv core_blocksponge : From 79e16c3cb28f76b3388e3e347a5af165d304ea49 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Thu, 18 Jan 2018 16:03:17 +0100 Subject: [PATCH 258/525] minor fixes --- proof/Common.ec | 11 ++- proof/clean/BlockSponge.eca | 154 +++++++++++++++++++++--------------- proof/core/Gext.eca | 18 ++--- proof/core/Handle.eca | 26 +++--- 4 files changed, 118 insertions(+), 91 deletions(-) diff --git a/proof/Common.ec b/proof/Common.ec index b509940..5ec5802 100644 --- a/proof/Common.ec +++ b/proof/Common.ec @@ -33,14 +33,14 @@ lemma ge0_r: 0 <= r. proof. by apply/ltrW/gt0_r. qed. (* -------------------------------------------------------------------- *) -clone BitWord as Capacity with +clone export BitWord as Capacity with type word <- capacity, op n <- c proof gt0_n by apply/gt0_c rename "word" as "capacity" - "dunifin" as "cdistr" "Word" as "Capacity" + (* "dunifin" as "cdistr" *) "zerow" as "c0". export Capacity DCapacity. @@ -51,11 +51,14 @@ clone export BitWord as Block with rename "word" as "block" "Word" as "Block" - "zerow" as "b0" - "dunifin" as "bdistr". + (* "dunifin" as "bdistr" *) + "zerow" as "b0". export DBlock. +op cdistr = DCapacity.dunifin. +op bdistr = DBlock.dunifin. + (* ------------------------- Auxiliary Lemmas ------------------------- *) lemma dvdz_close (n : int) : diff --git a/proof/clean/BlockSponge.eca b/proof/clean/BlockSponge.eca index 016009e..bcb4796 100644 --- a/proof/clean/BlockSponge.eca +++ b/proof/clean/BlockSponge.eca @@ -696,7 +696,60 @@ section PROOF. Perm.m{1}.[ej1] = Some (ej.`1 +^ mj, ej.`2)));1:smt(size_ge0). (* TODO : reprendre ici *) - admit. + while( ={glob P, glob EagerCORE, result0, k0} + /\ i1{1} = i2{2} + /\ 0 <= i1{1} <= size EagerCORE.order{1} + /\ i1{1} = size EagerCORE.map{1} + /\ (0 < i1{1} => nth (b0, c0) EagerCORE.map{1} 0 = (nth b0 EagerCORE.order{1} 0, c0)) + /\ (forall (y1 : block * capacity), + y1 \in EagerCORE.map{1} => y1 \in dom Perm.m{1}) + /\ (0 = size EagerCORE.map{1} => + (EagerCORE.blo{1}, EagerCORE.capa{1}) = (b0, c0)) + /\ (0 < size EagerCORE.map{1} => + (EagerCORE.blo{1}, EagerCORE.capa{1}) = + oget Perm.m{1}.[last (b0, c0) EagerCORE.map{1}]) + /\ (forall (j : int), 0 < j < size EagerCORE.map{1} => + let ej = nth (b0, c0) EagerCORE.map{1} j in + let ej1 = nth (b0, c0) EagerCORE.map{1} (j - 1) in + let mj = nth b0 EagerCORE.order{1} j in + Perm.m{1}.[ej1] = Some (ej.`1 +^ mj, ej.`2)));last first. + + auto;smt(size_ge0). + sp;if;auto;progress. + + smt(size_ge0). + + smt(size_ge0). + + smt(size_ge0 size_rcons). + + rewrite nth_rcons;case(0Hsize//=;1:rewrite/#. + move:H3;cut->/=[->->]/=:EagerCORE.map{2} = [] by smt(size_eq0 size_ge0). + by rewrite Block.WRing.add0r. + + smt(mem_rcons dom_set in_fsetU1). + + smt(size_rcons). + + smt(size_rcons). + + smt(last_rcons). + + rewrite size_rcons in H12;rewrite getP !nth_rcons. + cut->/=:j - 1 < size EagerCORE.map{2} by rewrite/#. + pose x:=nth _ _ _;pose y:=(_,_). + cut->/=:!x=y by smt(mem_nth). + case(j//=[/#|Hsize]. + rewrite/x/y=>{x y};cut Hj/=:j = size EagerCORE.map{2} by rewrite/#. + rewrite Hj/=. + by rewrite -Block.WRing.addrA Block.xorwK Block.WRing.addr0/=;smt(get_oget mem_nth nth_last). + + smt(size_rcons). + + smt(size_rcons). + + smt(size_rcons). + + rewrite nth_rcons;case(0Hsize//=;1:rewrite/#. + move:H3;cut->/=[->->]/=:EagerCORE.map{2} = [] by smt(size_eq0 size_ge0). + by rewrite Block.WRing.add0r. + + smt(size_rcons mem_rcons). + + smt(size_rcons). + + smt(size_rcons). + + smt(size_rcons last_rcons). + rewrite size_rcons in H10;rewrite !nth_rcons. + cut->/=:j - 1 < size EagerCORE.map{2} by rewrite/#. + case(j//=[/#|Hsize]. + cut Hj/=:j = size EagerCORE.map{2} by rewrite/#. + rewrite Hj/=. + by rewrite -Block.WRing.addrA Block.xorwK Block.WRing.addr0/=;smt(get_oget mem_nth nth_last). + qed. equiv core_blocksponge : @@ -708,7 +761,15 @@ section PROOF. (={glob D, glob P} ==> ={res, C.c}) (={glob D, glob P} ==> ={res, C.c} /\ ={c}(C,HiDist));progress;1:rewrite/#. + proc=>/=;call (_: ={glob P, C.c}); first 2 by sim. - + by proc=> /=;inline*;sp;if;auto;sp;if;auto;sim. + + proc=> /=;inline*;sp;if;auto;sp;if;auto;sim. + conseq(:_==> ={glob P} /\ sc{1} = EagerCORE.capa{2} + /\ sa{1} = EagerCORE.blo{2});progress. + by while(={glob P, p0, i} /\ 0 <= i{1} <= size p0{1} + /\ (i < size p0 => nth witness p0 i = nth b0 p0 i){1} + /\ sc{1} = EagerCORE.capa{2} + /\ sa{1} = EagerCORE.blo{2});1:(sp;if);auto; + smt(nth_onth onth_nth size_ge0). + by inline*;auto;call(:true);auto. @@ -718,72 +779,35 @@ section PROOF. + proc. call (_: ={glob P, C.c}); first 2 by sim. + proc=> /=; sp. - if=>//=;auto;inline{1}1;inline{2}1;sp;if;auto;swap{1}3-2;swap{2}2. - conseq(:_==> ={r0,glob P});progress;sp. - replace{1} { while ; rest } by { - EagerCORE(P).ewhile(); - rest; + if=>//=;auto. + conseq(:_==> ={r,glob P});progress. + transitivity{1} { + EagerCORE.capa <- c0; + EagerCORE.blo <- b0; + EagerCORE.map <- []; + EagerCORE.order <- p; + r <@ EagerCORE(P).nwhile(n); } - (={glob P, EagerCORE.order, r0, p0, n0} /\ i{1} = 0 - /\ (EagerCORE.blo,EagerCORE.capa,EagerCORE.order){1} = (b0,c0,p0{1}) - ==> ={r0, glob P}) - (={glob P,glob EagerCORE, n0, p0, r0} ==> ={r0, glob P}); - progress;1:rewrite/#;first inline*;sim;auto;progress. - - (* eager part *) - replace{2} {| (<@ as ewhile); rest } by { - rest; - EagerCORE.order <- take (size EagerCORE.order - 1) EagerCORE.order; - ewhile; + (={glob P, p, n} /\ valid p{1} /\ 0 < n{1} ==> ={glob P, r}) + (={glob P, p, n} /\ valid p{1} /\ 0 < n{1} ==> ={glob P, r}); + progress;1:rewrite/#. + + inline*;sim. rcondt{1}6;1:auto;sim;sp;sim. + wp;conseq(:_==> ={EagerCORE.blo, EagerCORE.capa, glob P});progress. + by while( ={EagerCORE.blo, EagerCORE.capa, glob P} + /\ (i,p0){1} = (i0,EagerCORE.order){2});1:(sp;if);auto;progress. + transitivity{1} { + EagerCORE.capa <- c0; + EagerCORE.blo <- b0; + EagerCORE.map <- []; + EagerCORE.order <- p; + r <@ EagerCORE(P).enwhile(n); } - (={glob P, glob EagerCORE, n0, p0, r0} ==> ={r0, glob P}) - (={glob P, glob EagerCORE, n0, p0, r0} ==> ={r0, glob P}); + (={glob P, p, n} ==> ={glob P, r}) + (={glob P, p, n} /\ valid p{1} /\ 0 < n{1} ==> ={glob P, r}); progress;1:rewrite/#;last first. - + - - - replace{2} { begin ; while } by { - begin; - while(i < n0) { - EagerCORE(Perm).ewhile(); - EagerCORE.order <- rcons EagerCORE.order b0; - i <- i + 1; - (EagerCORE.blo, EagerCORE.capa) <@ - Perm.f(EagerCORE.blo, EagerCORE.capa); - r0 <- rcons r0 EagerCORE.blo; - } - } - (={glob P, glob EagerCORE, n0, p0, r0} ==> ={r0, glob P}) - (={glob P, glob EagerCORE, n0, p0, r0} ==> ={r0, glob P}); - progress;1:rewrite/#;last first. - + while(={r0, p0, n0, i, glob P, glob EagerCORE}); - last by conseq(:_==> ={r0, p0, n0, i, glob P, glob EagerCORE});progress;sim. - inline*;sp. swap{1}3 2;wp=>//=. - splitwhile{2}1: i0 < size EagerCORE.order - 1. - rcondt{2}2;progress. - + by while(i0 < size EagerCORE.order);1:(sp;if);auto;smt(size_ge0). - rcondf{2}6;progress. - + seq 1 : (i0 = size EagerCORE.order - 1);last by sp;if;auto=>/#. - by while(0 <= i0 < size EagerCORE.order);1:(sp;if);auto;smt(size_ge0 size_rcons). - wp=>/=. - conseq(:_==> ={glob P, glob EagerCORE, r0, x});progress;sim. - wp. - conseq(:_==> ={glob P, EagerCORE.blo, EagerCORE.capa, r0} - /\ i0{2} = size EagerCORE.order{2} - 1 - /\ rcons EagerCORE.order{1} b0 = EagerCORE.order{2});progress. - + by rewrite nth_rcons size_rcons-addzA/=Block.WRing.addr0. - conseq(:_==> ={glob P, EagerCORE.blo, EagerCORE.capa, r0} - /\ i0{2} = size EagerCORE.order{1});progress. - + smt(size_rcons). - while( ={glob P, EagerCORE.blo, EagerCORE.capa, r0, i0} - /\ rcons EagerCORE.order{1} b0 = EagerCORE.order{2} - /\ 0 <= i0{2} <= size EagerCORE.order{1}); - last auto;smt(size_ge0 size_rcons). - wp;conseq(:_==> ={glob P, EagerCORE.blo, EagerCORE.capa, r0, i0} - /\ x0{1} = x{2});1:smt(size_rcons). - by sp;sim;smt(nth_rcons size_rcons). - + - + + by inline*;sim;rcondt{2}6;1:auto;sim;auto. + by sp;exists*n{1};elim*=>n;call(nwhile_enwhile n);auto. + by inline*;auto;call(:true);auto. diff --git a/proof/core/Gext.eca b/proof/core/Gext.eca index c7439d7..988a9a2 100644 --- a/proof/core/Gext.eca +++ b/proof/core/Gext.eca @@ -2,7 +2,7 @@ pragma -oldip. require import Core Int Real RealExtra StdOrder Ring StdBigop IntExtra. require import List FSet NewFMap Utils Common SLCommon RndO FelTactic Mu_mem. require import DProd Dexcepted. -(*...*) import Capacity IntOrder Bigreal RealOrder BRA. +(*...*) import Capacity IntOrder Bigreal RealOrder BRA DCapacity. require (*..*) Gcol. @@ -201,7 +201,7 @@ section. + by move=> &m;auto;rewrite /in_dom_with. (* auto=> |>. (* Bug ???? *) *) auto;progress. - + by apply DWord.dunifin_ll. + + by apply sampleto_ll. + rewrite /inv_ext1=>/H{H}[->//|[/in_rng[h]Hh|[[x1 x2] h [Hx Hh]]]]. + case (h = (oget G1.mh{2}.[(x{2}.`1, hx2{2})]).`2)=> [->>|Hneq]. + by left;rewrite Hh oget_some. @@ -238,7 +238,7 @@ section. + inline *;rcondt{2} 4. + by move=> &m;auto;rewrite /in_dom_with. auto;progress. - + by apply DWord.dunifin_ll. + + by apply sampleto_ll. + rewrite /inv_ext1=>/H{H}[->//|[/in_rng[h]Hh|[[x1 x2] h [Hx Hh]]]]. + case (h = (oget G1.mhi{2}.[(x{2}.`1, hx2{2})]).`2)=> [->>|Hneq]. + by left;rewrite Hh oget_some. @@ -556,8 +556,8 @@ section EXT. + inline *;rcondt{1} 4;1:by auto=>/#. rcondt{2} 5;1:by auto;smt w=(sizeE size_ge0). rcondt{2} 10. by auto;progress;rewrite dom_set !inE. - wp;rnd{2};auto=> /= ??[#]!-> @/inv_lt @/inv_le [#] mlt milt clt cle Hin 3?->/=. - rewrite DWord.dunifin_ll /= => ? _;rewrite /bad_ext !getP /= !oget_some /= set_set_eq /=. + wp;rnd{2};auto=> /= ??[#]!-> @/inv_lt @/inv_le [#] mlt milt clt cle Hin 3?->/=. + rewrite/Distr.is_lossless (sampleto_ll 0)/= => ? _;rewrite /bad_ext !getP /= !oget_some /= set_set_eq /=. rewrite !(imageU,inE) restr_set /= size_rem dom_restr Hin //=; smt w=size_set_le. by call RROset_inv_lt;auto;smt w=size_set_le. @@ -579,7 +579,7 @@ section EXT. rcondt{2} 5;1:by auto;smt w=(sizeE size_ge0). rcondt{2} 10. by auto;progress;rewrite dom_set !inE. wp;rnd{2};auto=> /= ??[#]!-> @/inv_lt @/inv_le [#] mlt milt clt cle Hin 3?->/=. - rewrite DWord.dunifin_ll /= => ? _;rewrite /bad_ext !getP /= !oget_some /= set_set_eq /=. + rewrite/Distr.is_lossless (sampleto_ll 0) /= => ? _;rewrite /bad_ext !getP /= !oget_some /= set_set_eq /=. rewrite !(imageU,inE) restr_set /= size_rem dom_restr Hin //=; smt w=size_set_le. by call RROset_inv_lt;auto;smt w=size_set_le. @@ -622,8 +622,8 @@ section EXT. wp; rnd (mem (image snd (dom G1.m `|` dom G1.mi ))); skip=> /> &hr ? ? -> /= ? ?. rewrite (Mu_mem.mu_mem (image snd (dom G1.m{hr} `|` dom G1.mi{hr})) - cdistr (1%r/(2^c)%r))//. - + by move=>x _;rewrite DWord.dunifin1E cap_card. + cdistr (1%r/(2^c)%r))//. print DCapacity. + + by move=>x _;rewrite DCapacity.dunifin1E capacity_card. rewrite ler_wpmul2r;1:by apply divr_ge0=>//;apply /c_ge0r. rewrite imageU fcardU le_fromint. move:(fcard_image_leq snd (dom G1.m{hr}))(fcard_image_leq snd (dom G1.mi{hr})). @@ -634,7 +634,7 @@ section EXT. + proc;rcondt 2;1:by auto. wp;rnd (mem (image snd (dom G1.m `|` dom G1.mi) `|` fset1 x));skip=> /> &hr ??-> /= ??. rewrite (Mu_mem.mu_mem (image snd (dom G1.m{hr}`|`dom G1.mi{hr}) `|` fset1 x{hr}) cdistr (1%r/(2^c)%r))//. - + by move=>x _;rewrite DWord.dunifin1E cap_card. + + by move=>x _;rewrite DCapacity.dunifin1E capacity_card. rewrite ler_wpmul2r;1:by apply divr_ge0=>//;apply /c_ge0r. rewrite imageU !fcardU le_fromint fcard1. move:(fcard_image_leq snd (dom G1.m{hr}))(fcard_image_leq snd (dom G1.mi{hr})). diff --git a/proof/core/Handle.eca b/proof/core/Handle.eca index 9fb10b9..a0c147d 100644 --- a/proof/core/Handle.eca +++ b/proof/core/Handle.eca @@ -2,7 +2,7 @@ pragma -oldip. pragma +implicits. require import Core Int Real StdOrder Ring IntExtra. require import List FSet NewFMap Utils Common SLCommon RndO. require import DProd Dexcepted. -(*...*) import Capacity IntOrder. +(*...*) import Capacity IntOrder DCapacity. require ConcreteF. @@ -10,7 +10,7 @@ clone import GenEager as ROhandle with type from <- handle, type to <- capacity, op sampleto <- fun (_:int) => cdistr - proof sampleto_ll by apply DWord.dunifin_ll. + proof sampleto_ll by apply DCapacity.dunifin_ll. module G1(D:DISTINGUISHER) = { var m, mi : smap @@ -1289,7 +1289,7 @@ case @[ambient]: {-1}(Gmi.[(xa,xc)]) (eq_refl Gmi.[(xa,xc)])=> [|[ya' yc'] ^] Gm move=> [? ? ? ?] [#]; rewrite hs_hx hs_hy=> /= [#] <<*> [#] <<*>. case: fx hs_hx=> hs_hx /= => [_|[#]]; first by exists hx. by have /invG_of_INV [] -> := inv0; rewrite Gmi_xaxc. print Block.DBlock. - smt (@Block.DBlock @Capacity.DWord). + smt (@Block.DBlock @Capacity.DCapacity). have /incli_of_INV <- := inv0; 1:by rewrite Gmi_xaxc. rewrite Pmi_xaxc=> /= [#] <<*>. rcondf{2} 1; 1:by auto=> &hr [#] <<*>; rewrite in_dom Gmi_xaxc. @@ -1364,7 +1364,7 @@ proof. by have := size_drop (i{m2} + 1) p{m2};case (drop (i{m2} + 1) p{m2}) => //= [/#| ];smt w=size_ge0. case ((G1.bcol{2} \/ G1.bext{2})). + wp;conseq (_: _ ==> (G1.bcol{2} \/ G1.bext{2}))=> //. - by if{1};if{2};auto;2:(swap{2} 4 -3;auto); smt w=(Block.DBlock.dunifin_ll DWord.dunifin_ll). + by if{1};if{2};auto;2:(swap{2} 4 -3;auto); smt w=(Block.DBlock.dunifin_ll DCapacity.dunifin_ll). conseq (_: (x{1} = (sa{1} +^ head witness p{1}, sc{1}) /\ (p{1} = drop i{2} p{2} /\ 0 <= i{2} <= size p{2} /\ @@ -1782,7 +1782,7 @@ section AUX. + by have /hs_of_INV []:= inv0. by rewrite /in_dom_with in_dom hs_hy2. rcondt{2} 14; first by auto=> &hr [#] !<<- _ _ ->> _ /=; rewrite in_dom pi_x2. - auto=> &1 &2 [#] !<<- -> -> ->> _ /=; rewrite Block.DBlock.dunifin_ll Capacity.DWord.dunifin_ll /=. + auto=> &1 &2 [#] !<<- -> -> ->> _ /=; rewrite Block.DBlock.dunifin_ll Capacity.DCapacity.dunifin_ll /=. move=> _ _ _ _; rewrite PFm_x1x2 pi_x2 !oget_some //=. rewrite (@huniq_hinvK_h hx2 hs0 x2) // ?oget_some. + by have /hs_of_INV []:= inv0. @@ -1790,22 +1790,22 @@ section AUX. exact/(@lemma3 _ _ _ _ _ _ _ _ _ _ _ _ hx2 _ _ hy2). (* lossless PF.f *) + move=> &2 _; proc; if=> //=; wp; rnd predT; rnd predT; auto. - smt (@Block.DBlock @Capacity.DWord). + smt (@Block.DBlock @Capacity.DCapacity). (* lossless and do not reset bad G1.S.f *) + move=> _; proc; if; auto. conseq (_: _ ==> G1.bcol \/ G1.bext); 1:smt (). inline *; if=> //=; wp; rnd predT; wp; rnd predT; auto. - + smt (@Block.DBlock @Capacity.DWord). - smt (@Block.DBlock @Capacity.DWord). + + smt (@Block.DBlock @Capacity.DCapacity). + smt (@Block.DBlock @Capacity.DCapacity). (** proofs for G1.S.fi *) (* equiv PF.P.fi G1.S.fi *) + by conseq (eq_fi D)=> /#. (* lossless PF.P.fi *) + move=> &2 _; proc; if=> //=; wp; rnd predT; rnd predT; auto. - smt (@Block.DBlock @Capacity.DWord). + smt (@Block.DBlock @Capacity.DCapacity). (* lossless and do not reset bad G1.S.fi *) + move=> _; proc; if; 2:by auto. - by wp; do 2!rnd predT; auto => &hr [#]; smt (@Block.DBlock @Capacity.DWord). + by wp; do 2!rnd predT; auto => &hr [#]; smt (@Block.DBlock @Capacity.DCapacity). (** proofs for G1.C.f *) (* equiv PF.C.f G1.C.f *) + proc. @@ -1813,15 +1813,15 @@ section AUX. (* lossless PF.C.f *) + move=> &2 _; proc; inline *; while (true) (size p); auto. + sp; if; 2:by auto; smt (size_behead). - by wp; do 2!rnd predT; auto; smt (size_behead @Block.DBlock @Capacity.DWord). + by wp; do 2!rnd predT; auto; smt (size_behead @Block.DBlock @Capacity.DCapacity). smt (size_ge0). (* lossless and do not reset bad G1.C.f *) + move=> _; proc; inline *; wp; rnd predT; auto. while (G1.bcol \/ G1.bext) (size p - i)=> [z|]. + if; 1:by auto=> /#. wp; rnd predT; wp; rnd predT; auto. - smt (@Block.DBlock @Capacity.DWord). - by auto; smt (@Block.DBlock @Capacity.DWord). + smt (@Block.DBlock @Capacity.DCapacity). + by auto; smt (@Block.DBlock @Capacity.DCapacity). (* Init ok *) inline *; auto=> />; split=> [|/#]. (do !split; last 3 smt (getP map0P build_hpath_map0)); last 5 by move=> ? ? ? ?; rewrite map0P. From 480dee1e870c1a82fe4ecbf7c9243489b788af47 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Fri, 19 Jan 2018 18:01:39 +0100 Subject: [PATCH 259/525] . --- proof/core/Gconcl.ec | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/proof/core/Gconcl.ec b/proof/core/Gconcl.ec index 38284c7..bf80aed 100644 --- a/proof/core/Gconcl.ec +++ b/proof/core/Gconcl.ec @@ -220,14 +220,14 @@ proof. [rcondt{1} 3;2:rcondt{2} 3| rcondf{1} 3;2:rcondf{2} 3]; 1,2,4,5:(by move=>?;conseq (_:true);auto);2:by sim. inline *;rcondt{1} 6;1:by auto=>/>. - wp;rnd;auto;progress[-split];rewrite DWord.dunifin_ll /= => ?_?->. + wp;rnd;auto;progress[-split];rewrite DCapacity.dunifin_ll /= => ?_?->. by rewrite !getP /= oget_some. case ((mem (dom G1.mh) (x.`1, hx2) /\ t){1}); [rcondt{1} 4;2:rcondt{2} 4| rcondf{1} 4;2:rcondf{2} 4]; 1,2,4,5:(by move=>?;conseq (_:true);auto);2:by sim. inline *;rcondt{1} 7;1:by auto=>/>. wp;rnd;auto;rnd{1};auto;progress[-split]. - rewrite Block.DBlock.supp_dunifin DWord.dunifin_ll /==> ?_?->. + rewrite Block.DBlock.supp_dunifin DCapacity.dunifin_ll /==> ?_?->. by rewrite !getP /= oget_some. + proc;sp;if=>//. @@ -241,7 +241,7 @@ proof. [rcondt{1} 3;2:rcondt{2} 3| rcondf{1} 3;2:rcondf{2} 3]; 1,2,4,5:(by move=>?;conseq (_:true);auto);2:by sim. inline *;rcondt{1} 6;1:by auto=>/>. - wp;rnd;auto;progress[-split];rewrite DWord.dunifin_ll /= => ?_?->. + wp;rnd;auto;progress[-split];rewrite DCapacity.dunifin_ll /= => ?_?->. by rewrite !getP /= oget_some. proc;sp;if=>//. @@ -342,7 +342,7 @@ proof. call (_: ={G1.m,G1.mi,G1.paths,F.RO.m,C.c});last by auto. sp;sim; while(={i,p,F.RO.m})=>//. inline F.RO.sample F.RO.get;if{1};1:by auto. - by sim;inline *;auto;progress;apply DWord.dunifin_ll. + by sim;inline *;auto;progress;apply DCapacity.dunifin_ll. qed. local equiv G4_Ideal : G4(F.LRO).distinguish ~ IdealIndif(IF,S,DRestr(D)).main : From 1cf25d0575aca7a7a14a7582b56fff944ff3c78d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Mon, 22 Jan 2018 18:17:13 +0100 Subject: [PATCH 260/525] . --- proof/smart_counter/ConcreteF.eca | 186 ++ proof/smart_counter/CoreToBlockSponge.eca | 165 ++ proof/smart_counter/Gcol.eca | 317 ++++ proof/smart_counter/Gconcl.ec | 384 +++++ proof/smart_counter/Gext.eca | 675 ++++++++ proof/smart_counter/Handle.eca | 1866 +++++++++++++++++++++ proof/smart_counter/IndifPadding.ec | 123 ++ proof/smart_counter/LazyRO.eca | 22 + proof/smart_counter/SLCommon.ec | 498 ++++++ proof/smart_counter/Utils.ec | 63 + 10 files changed, 4299 insertions(+) create mode 100644 proof/smart_counter/ConcreteF.eca create mode 100644 proof/smart_counter/CoreToBlockSponge.eca create mode 100644 proof/smart_counter/Gcol.eca create mode 100644 proof/smart_counter/Gconcl.ec create mode 100644 proof/smart_counter/Gext.eca create mode 100644 proof/smart_counter/Handle.eca create mode 100644 proof/smart_counter/IndifPadding.ec create mode 100644 proof/smart_counter/LazyRO.eca create mode 100644 proof/smart_counter/SLCommon.ec create mode 100644 proof/smart_counter/Utils.ec diff --git a/proof/smart_counter/ConcreteF.eca b/proof/smart_counter/ConcreteF.eca new file mode 100644 index 0000000..89fb7ce --- /dev/null +++ b/proof/smart_counter/ConcreteF.eca @@ -0,0 +1,186 @@ +require import Core Int Real StdOrder Ring Distr IntExtra. +require import List FSet NewFMap Utils Common SLCommon DProd Dexcepted. + +(*...*) import Capacity IntOrder RealOrder. + +require (*..*) Strong_RP_RF_C. + +module PF = { + var m, mi: (state,state) fmap + + proc init(): unit = { + m <- map0; + mi <- map0; + } + + proc f(x : state): state = { + var y1, y2; + + if (!mem (dom m) x) { + y1 <$ bdistr; + y2 <$ cdistr; + m.[x] <- (y1,y2); + mi.[(y1,y2)] <- x; + } + return oget m.[x]; + } + + proc fi(x : state): state = { + var y1, y2; + + if (!mem (dom mi) x) { + y1 <$ bdistr; + y2 <$ cdistr; + mi.[x] <- (y1,y2); + m.[(y1,y2)] <- x; + } + return oget mi.[x]; + } + +}. + +module CF(D:DISTINGUISHER) = Indif(SqueezelessSponge(PF), PF, D). + +section. + declare module D : DISTINGUISHER {Perm, C, PF}. + + axiom D_ll (F <: DFUNCTIONALITY{D}) (P <: DPRIMITIVE{D}): + islossless P.f => islossless P.fi => islossless F.f => + islossless D(F, P).distinguish. + + local module GReal' = Indif(FC(SqueezelessSponge(Perm)), PC(Perm), D). + + local clone import Strong_RP_RF_C as Switching with + type D <- state, + op uD <- dstate, + type K <- unit, + op dK <- (MUnit.dunit<:unit> tt), + op q <- max_size + proof *. + realize ge0_q by smt w=max_ge0. + realize uD_uf_fu. + split. + case=> [x y]; rewrite supp_dprod /=. + rewrite Block.DBlock.supp_dunifin Capacity.DCapacity.supp_dunifin/=. + smt(dprod1E Block.DBlock.dunifin_funi Capacity.DCapacity.dunifin_funi). + split. + smt(dprod_ll Block.DBlock.dunifin_ll Capacity.DCapacity.dunifin_ll). + apply/dprod_fu. + rewrite Block.DBlock.dunifin_fu. + by rewrite Capacity.DCapacity.dunifin_fu. + qed. + realize dK_ll. + by rewrite /is_lossless MUnit.dunit_ll. + qed. + + (* TODO move this *) + lemma size_behead (l : 'a list) : l <> [] => size (behead l) = size l - 1. + proof. by case l=> // ?? /=; ring. qed. + + local module (D': PRPt.Distinguisher) (P' : PRPt.Oracles) = { + proc distinguish = DRestr(D,SqueezelessSponge(P'),P').distinguish + }. + + local lemma DoubleBounding (P <: PRPt.StrongPRP {D, C, DBounder}) &m: + Pr[PRPt.IND(P,D').main() @ &m: res] + = Pr[PRPt.IND(P,DBounder(D')).main() @ &m: res]. + proof. + byequiv=> //=; proc; inline *. + wp. + call (_: ={glob C, glob P} /\ DBounder.FBounder.c{2} = C.c{2}). + + proc; sp; if=> //=; inline *. + rcondt{2} 4; 1: by auto=> /#. + by wp; call (_: true); auto. + + proc; sp; if=> //=; inline *. + rcondt{2} 4; 1: by auto=> /#. + by wp; call (_: true); auto. + + proc; sp; if=> //=; inline *. + wp; while ( ={glob C, glob P, p, sa, sc} + /\ C.c{2} <= max_size + /\ DBounder.FBounder.c{2} = C.c{2} - size p{2}). + rcondt{2} 3; 1: by auto; smt w=size_ge0. + by wp; call (_: true); auto=> /#. + by auto; progress; ring. + by wp; call (_: true). + qed. + + local clone import ProdSampling with + type t1 <- block, + op d1 <- bdistr, + type t2 <- capacity, + op d2 <- cdistr. + + lemma Real_Concrete &m : + Pr[GReal(D).main()@ &m: res /\ C.c <= max_size] <= + Pr[CF(DRestr(D)).main()@ &m: res] + (max_size ^ 2)%r * mu dstate (pred1 witness). + proof. + cut->: + Pr[RealIndif(SqueezelessSponge,PC(Perm),D).main()@ &m: + res /\ C.c <= max_size] = Pr[GReal'.main()@ &m: res/\ C.c <= max_size]. + + byequiv=>//;proc;inline *;call (_: ={C.c,glob Perm});last by auto. + + by sim. + by sim. + proc; inline *; wp. + while (={glob Perm,sc,sa,p} /\ (C.c + size p){1} = C.c{2});2:by auto. + by sp; if=> //=; auto=> /> &2 cL /size_behead=> ->; progress; ring. + have p_ll := P_f_ll _ _. + + apply/dprod_ll; split. + + exact/Block.DBlock.dunifin_ll. + exact/Capacity.DCapacity.dunifin_ll. + + apply/fun_ext=>- [] a b; rewrite supp_dprod. + by rewrite/=/predT/=Block.DBlock.dunifin_fu Capacity.DCapacity.dunifin_fu. + have pi_ll := P_fi_ll _ _. + + apply/dprod_ll; split. + + exact/Block.DBlock.dunifin_ll. + exact/Capacity.DCapacity.dunifin_ll. + + apply/fun_ext=>- [] a b; rewrite supp_dprod. + by rewrite/=/predT/=Block.DBlock.dunifin_fu Capacity.DCapacity.dunifin_fu. + have f_ll : islossless SqueezelessSponge(Perm).f. + + proc; while true (size p)=> //=. + * by move=> z; wp; call p_ll; skip=> /> &hr /size_behead /#. + by auto; smt w=size_ge0. + apply (ler_trans _ _ _ + (Pr_restr Perm SqueezelessSponge D p_ll pi_ll f_ll D_ll &m)). + have ->: Pr[Indif(SqueezelessSponge(Perm), Perm, DRestr(D)).main() @ &m: res] + = Pr[PRPt.IND(PRPi.PRPi,DBounder(D')).main() @ &m: res]. + + rewrite -(DoubleBounding PRPi.PRPi &m). + byequiv=> //=; proc; inline *; sim (_: ={m,mi}(Perm,PRPi.PRPi) /\ ={glob C}). + * by proc; if=> //=; auto. + by proc; if=> //=; auto. + have ->: Pr[CF(DRestr(D)).main() @ &m: res] + = Pr[PRPt.IND(ARP,DBounder(D')).main() @ &m: res]. + + rewrite -(DoubleBounding ARP &m). + byequiv=> //=; proc; inline *; sim (_: ={m,mi}(PF,ARP)). + * proc; if=> //=; auto; conseq (_: true ==> (y1,y2){1} = x{2})=> //=. + transitivity{1} { (y1,y2) <@ S.sample2(); } + (true ==> ={y1,y2}) + (true ==> (y1,y2){1} = x{2})=> //=. + - by inline *; auto. + transitivity{2} { x <@ S.sample(); } + (true ==> (y1,y2){1} = x{2}) + (true ==> ={x})=> //=. + - by symmetry; call sample_sample2; skip=> /> []. + by inline *; auto. + proc; if=> //=; auto; conseq (_: true ==> (y1,y2){1} = y{2})=> //=. + transitivity{1} { (y1,y2) <@ S.sample2(); } + (true ==> ={y1,y2}) + (true ==> (y1,y2){1} = y{2})=> //=. + - by inline *; auto. + transitivity{2} { y <@ S.sample(); } + (true ==> (y1,y2){1} = y{2}) + (true ==> ={y})=> //=. + - by symmetry; call sample_sample2; skip=> /> []. + by inline *; auto. + have /#:= Conclusion D' &m _. + move=> O O_f_ll O_fi_ll. + proc; call (_: true)=> //=. + + apply D_ll. + + by proc; sp; if=> //=; call O_f_ll; auto. + + by proc; sp; if=> //=; call O_fi_ll; auto. + + proc; inline *; sp; if=> //=; auto. + while true (size p). + * by auto; call O_f_ll; auto=> /#. + by auto; smt w=size_ge0. + by inline *; auto. + qed. + +end section. diff --git a/proof/smart_counter/CoreToBlockSponge.eca b/proof/smart_counter/CoreToBlockSponge.eca new file mode 100644 index 0000000..6cf2b01 --- /dev/null +++ b/proof/smart_counter/CoreToBlockSponge.eca @@ -0,0 +1,165 @@ +(* -------------------------------------------------------------------- *) +require import Option Pair Int Real Distr List FSet NewFMap DProd. +require import BlockSponge. + +require (*--*) Core. + +op max_query : int. +axiom max_query_ge0: 0 <= max_query. + +clone Core as CoreConstruction with + op Block.r <- Common.r, + type Block.block <- Common.block, + op Block.b0 <- Common.Block.b0, + op Block.(+^) <- Common.Block.(+^), + op Block.enum <- Common.Block.blocks, + op Capacity.c <- Common.c, + type Capacity.capacity <- Common.capacity, + op Capacity.c0 <- Common.Capacity.c0, + op Capacity.enum <- Common.Capacity.caps, + op max_query <- max_query +proof *. +realize Block.r_ge0 by exact/Common.ge0_r. +search Common.Block.(+^). +realize Block.addbA by exact/Common.Block.addwA. + +(*---*) import Common Perm. + +(* -------------------------------------------------------------------- *) +section PROOF. + declare module D:DISTINGUISHER { Perm, Gconcl.IF, SLCommon.C, Gconcl.S, BIRO.IRO }. + + module Wrap (D : DISTINGUISHER) (F : DFUNCTIONALITY) (P : DPRIMITIVE) = { + module WF = { + proc f(x : block list * int) = { + var r <- []; + var p, n; + + (p,n) <- x; + if (valid_block p /\ 0 < n) { + r <@ F.f(x); + } + return r; + } + } + + proc distinguish = D(WF,P).distinguish + }. + + module LowerF (F:DFUNCTIONALITY) = { + proc f(m:block list) : block = { + var r <- []; + var p, n; + + (p,n) <- strip m; + if (p <> []) { + r <- F.f(p,n); + } + return last b0 r; + } + }. + + module RaiseF (F:SLCommon.DFUNCTIONALITY) = { + proc f(m:block list, n:int) : block list = { + var i, r, b; + r <- []; + + if (m <> []) { + i <- 0; + b <- b0; + while (i < n) { + b <- F.f(extend m i); + r <- rcons r b; + i <- i + 1; + + } + } + return r; + } + }. + + module LowerDist(D : DISTINGUISHER, F : SLCommon.DFUNCTIONALITY) = + D(RaiseF(F)). + + module RaiseSim(S:SLCommon.SIMULATOR, F:DFUNCTIONALITY) = + S(LowerF(F)). + + local equiv f_f: BIRO.IRO.f ~ RaiseF(Gconcl.IF).f: + ={n} /\ x{1} = m{2} + /\ 0 <= n{2} + /\ valid_block x{1} + /\ (forall p n, BIRO.IRO.mp{1}.[(p,n)] <> None => last b0 p <> b0) + /\ (forall p, SLCommon.F.RO.m{2}.[p] = BIRO.IRO.mp{1}.[strip p]) + ==> ={res} + /\ (forall p n, BIRO.IRO.mp{1}.[(p,n)] <> None => last b0 p <> b0) + /\ (forall p, SLCommon.F.RO.m{2}.[p] = BIRO.IRO.mp{1}.[strip p]). + proof. + proc. rcondt{2} 2; 1:by auto=> /#. rcondt{1} 3; 1:by auto=> /#. + inline *. wp. + while ( ={i,n} /\ x{1} = m{2} /\ bs{1} = r{2} + /\ 0 <= i{2} <= n{2} + /\ last b0 x{1} <> b0 + /\ (forall p n, BIRO.IRO.mp{1}.[(p,n)] <> None => last b0 p <> b0) + /\ (forall p, SLCommon.F.RO.m{2}.[p] = BIRO.IRO.mp{1}.[strip p])). + + sp; if{1}. + + rcondt{2} 2. + + auto=> &hr [#] !->> i_ge0 i_lt_n wf hinv1 hinv2 _ _ + _ _. + by rewrite !in_dom /= hinv2 extendK. + auto=> &1 &2 /= [#] !->> i_ge0 _ wf inv1 inv2 i_lt_n _. + rewrite in_dom wf=> mp_xi r -> /=; split; first by rewrite !getP. + split=> [/#|]; split=> [p n|p]. + + by rewrite getP; case: ((p,n) = (m,i){2})=> [[#] <*>|_ /inv1]. + rewrite !getP; case: (strip p = (m,i){2})=> [strip_p|]. + + by have := stripK p; rewrite strip_p=> /= ->. + case: (p = extend m{2} i{2})=> [<*>|_ _]; first by rewrite extendK. + exact/inv2. + rcondf{2} 2. + + auto=> &hr [#] !->> i_ge0 i_lt_n wf hinv1 hinv2 _ _ + _ _. + by rewrite !in_dom /= hinv2 extendK. + by auto=> &1 &2; smt (DWord.bdistr_ll extendK). + by auto; smt (valid_block_ends_not_b0). + qed. + + lemma conclusion &m: + `| Pr[RealIndif(Sponge,Perm,Wrap(D)).main() @ &m : res] + - Pr[IdealIndif(BIRO.IRO,RaiseSim(Gconcl.S),Wrap(D)).main() @ &m : res] | + = `| Pr[SLCommon.RealIndif(SLCommon.SqueezelessSponge,SLCommon.PC(Perm),LowerDist(Wrap(D))).main() @ &m : res] + - Pr[SLCommon.IdealIndif(Gconcl.IF,Gconcl.S,LowerDist(Wrap(D))).main() @ &m : res] |. + proof. + do 3?congr. + + byequiv (_: ={glob D} ==> _)=> //; proc; inline *. + call (_: ={glob Perm}). + + by proc; inline *; wp; sim. + + by proc; inline *; wp; sim. + + proc; sp; if=> //. + call (_: ={glob Perm, arg} + /\ valid_block xs{1} /\ 0 < n{1} + ==> ={glob Perm, res}). + + proc. rcondt{1} 4; 1:by auto. rcondt{2} 2; 1:by auto; smt (valid_block_ends_not_b0). + rcondt{2} 4; 1:by auto. + inline{2} SLCommon.SqueezelessSponge(SLCommon.PC(Perm)).f. + seq 4 6: ( ={glob Perm, n, i, sa, sc} + /\ (* some notion of path through Perm.m *) true). + + while ( ={glob Perm, sa, sc} + /\ xs{1} = p{2} + /\ (* some notion of path through Perm.m *) true). + + wp; call (_: ={glob Perm}). + + by inline *; wp; sim. + by auto=> /> /#. + by auto=> &1 &2 [#] !<<- vblock n_gt0 /=; rewrite /extend nseq0 cats0. + (* make sure that the notion of path guarantees that only the last call of each iteration adds something to the map, and that it is exactly the right call *) + admit. + by auto=> /#. + by auto. + byequiv (_: ={glob D} ==> _)=> //; proc; inline *. + call (_: ={glob S} + /\ (forall p n, BIRO.IRO.mp{1}.[(p,n)] <> None => last b0 p <> b0) + /\ (forall p, SLCommon.F.RO.m{2}.[p] = BIRO.IRO.mp{1}.[strip p]) + /\ (* relation between S.paths and presence in the RO map *) true). + + proc. if=> //=; last by auto. if=> //=; last by auto. + inline *. admit. (* something about valid queries *) + + admit. (* prove: S(LowerF(BIRO.IRO)).fi ~ S(IF).fi *) + + by proc; sp; if=> //; call (f_f); auto=> /#. + by auto=> />; split=> [?|] ?; rewrite !map0P. + qed. +end section PROOF. diff --git a/proof/smart_counter/Gcol.eca b/proof/smart_counter/Gcol.eca new file mode 100644 index 0000000..fcc397c --- /dev/null +++ b/proof/smart_counter/Gcol.eca @@ -0,0 +1,317 @@ +pragma -oldip. +require import Core Int Real RealExtra StdOrder Ring StdBigop IntExtra. +require import List FSet NewFMap Utils Common SLCommon RndO FelTactic Mu_mem. +require import DProd Dexcepted. +(*...*) import Capacity IntOrder Bigreal RealOrder BRA. + +require (*..*) Handle. + +clone export Handle as Handle0. + export ROhandle. + +(* -------------------------------------------------------------------------- *) + + (* TODO: move this *) + lemma c_gt0r : 0%r < (2^c)%r. + proof. by rewrite lt_fromint;apply /powPos. qed. + + lemma c_ge0r : 0%r <= (2^c)%r. + proof. by apply /ltrW/c_gt0r. qed. + + lemma eps_ge0 : 0%r <= (2 * max_size)%r / (2 ^ c)%r. + proof. + apply divr_ge0;1:by rewrite le_fromint;smt ml=0 w=max_ge0. + by apply c_ge0r. + qed. + +section PROOF. + declare module D: DISTINGUISHER{C, PF, G1}. + + axiom D_ll (F <: DFUNCTIONALITY{D}) (P <: DPRIMITIVE{D}): + islossless P.f => islossless P.fi => + islossless F.f => islossless D(F, P).distinguish. + + local module Gcol = { + + var count : int + + proc sample_c () = { + var c=c0; + if (card (image fst (rng FRO.m)) <= 2*max_size /\ + count < max_size) { + c <$ cdistr; + G1.bcol <- G1.bcol \/ mem (image fst (rng FRO.m)) c; + count <- count + 1; + } + + return c; + } + + module C = { + + proc f(p : block list): block = { + var sa, sa', sc; + var h, i <- 0; + sa <- b0; + while (i < size p ) { + if (mem (dom G1.mh) (sa +^ nth witness p i, h)) { + (sa, h) <- oget G1.mh.[(sa +^ nth witness p i, h)]; + } else { + sc <@ sample_c(); + sa' <- F.RO.get(take (i+1) p); + sa <- sa +^ nth witness p i; + G1.mh.[(sa,h)] <- (sa', G1.chandle); + G1.mhi.[(sa',G1.chandle)] <- (sa, h); + (sa,h) <- (sa',G1.chandle); + FRO.m.[G1.chandle] <- (sc,Unknown); + G1.chandle <- G1.chandle + 1; + } + i <- i + 1; + } + sa <- F.RO.get(p); + return sa; + } + } + + module S = { + + proc f(x : state): state = { + var p, v, y, y1, y2, hy2, hx2; + + if (!mem (dom G1.m) x) { + if (!(mem (rng FRO.m) (x.`2, Known))) { + FRO.m.[G1.chandle] <- (x.`2, Known); + G1.chandle <- G1.chandle + 1; + } + hx2 <- oget (hinvK FRO.m x.`2); + if (mem (dom G1.paths) x.`2) { + (p,v) <- oget G1.paths.[x.`2]; + y1 <- F.RO.get (rcons p (v +^ x.`1)); + y2 <@ sample_c(); + } else { + y1 <$ bdistr; + y2 <@ sample_c(); + + } + y <- (y1,y2); + if (mem (dom G1.mh) (x.`1, hx2) /\ + in_dom_with FRO.m (oget G1.mh.[(x.`1,hx2)]).`2 Unknown) { + hy2 <- (oget G1.mh.[(x.`1, hx2)]).`2; + y <- (y.`1, (oget FRO.m.[hy2]).`1); + FRO.m.[hy2] <- (y.`2, Known); + G1.m.[x] <- y; + G1.mi.[y] <- x; + } else { + hy2 <- G1.chandle; + G1.chandle <- G1.chandle + 1; + FRO.m.[hy2] <- (y.`2, Known); + G1.m.[x] <- y; + G1.mh.[(x.`1, hx2)] <- (y.`1, hy2); + G1.mi.[y] <- x; + G1.mhi.[(y.`1, hy2)] <- (x.`1, hx2); + } + if (mem (dom G1.paths) x.`2) { + (p,v) <- oget G1.paths.[x.`2]; + G1.paths.[y.`2] <- (rcons p (v +^ x.`1), y.`1); + } + } else { + y <- oget G1.m.[x]; + } + return y; + } + + proc fi(x : state): state = { + var y, y1, y2, hx2, hy2; + + if (!mem (dom G1.mi) x) { + if (!(mem (rng FRO.m) (x.`2, Known))) { + FRO.m.[G1.chandle] <- (x.`2, Known); + G1.chandle <- G1.chandle + 1; + } + hx2 <- oget (hinvK FRO.m x.`2); + y1 <$ bdistr; + y2 <@ sample_c(); + y <- (y1,y2); + if (mem (dom G1.mhi) (x.`1, hx2) /\ + in_dom_with FRO.m (oget G1.mhi.[(x.`1,hx2)]).`2 Unknown) { + (y1,hy2) <- oget G1.mhi.[(x.`1, hx2)]; + y <- (y.`1, (oget FRO.m.[hy2]).`1); + FRO.m.[hy2] <- (y.`2, Known); + G1.mi.[x] <- y; + G1.m.[y] <- x; + } else { + hy2 <- G1.chandle; + G1.chandle <- G1.chandle + 1; + FRO.m.[hy2] <- (y.`2, Known); + G1.mi.[x] <- y; + G1.mhi.[(x.`1, hx2)] <- (y.`1, hy2); + G1.m.[y] <- x; + G1.mh.[(y.`1, hy2)] <- (x.`1, hx2); + } + } else { + y <- oget G1.mi.[x]; + } + return y; + } + + } + + proc main(): bool = { + var b; + + F.RO.m <- map0; + G1.m <- map0; + G1.mi <- map0; + G1.mh <- map0; + G1.mhi <- map0; + G1.bcol <- false; + + FRO.m <- map0.[0 <- (c0, Known)]; + G1.paths <- map0.[c0 <- ([<:block>],b0)]; + G1.chandle <- 1; + count <- 0; + b <@ DRestr(D,C,S).distinguish(); + return b; + } + }. + + lemma card_rng_set (m:('a,'b)fmap) x y: card(rng m.[x<-y]) <= card(rng m) + 1. + proof. + rewrite rng_set fcardU fcard1. + cut := subset_leq_fcard (rng (rem x m)) (rng m) _;2:smt ml=0 w=fcard_ge0. + rewrite subsetP=> z;apply rng_rem_le. + qed. + + lemma hinv_image handles c: + hinv handles c <> None => + mem (image fst (rng handles)) c. + proof. + case: (hinv handles c) (hinvP handles c)=>//= h[f] Heq. + rewrite imageP;exists (c,f)=>@/fst/=. + by rewrite in_rng;exists (oget (Some h)). + qed. + + local equiv G1col : G1(DRestr(D)).main ~ Gcol.main : + ={glob D} ==> (G1.bcol{1} => G1.bcol{2}) /\ Gcol.count{2} <= max_size. + proof. + proc;inline*;wp. + call (_: ={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m,C.c}/\ + (G1.bcol{1} => G1.bcol{2}) /\ + (card (rng FRO.m) <= 2*C.c + 1 /\ + Gcol.count <= C.c <= max_size){2}). + + proc;sp 1 1;if=>//. + inline G1(DRestr(D)).S.f Gcol.S.f. + seq 2 2 : (={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m, + C.c,x0} /\ + (G1.bcol{1} => G1.bcol{2}) /\ + (card(rng FRO.m) + 2 <= 2*C.c + 1/\ + Gcol.count + 1 <= C.c <= max_size){2});1:by auto=>/#. + if=>//;last by auto=>/#. + swap{1}[3..5]-2. + seq 3 2:(={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m, + C.c,x0,hx2} /\ + (G1.bcol{1} => G1.bcol{2}) /\ + (card (rng FRO.m) + 1 <= 2 * C.c + 1/\ + Gcol.count + 1 <= C.c <= max_size){2}). + + auto;smt ml=0 w=card_rng_set. + seq 2 2: + (={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m, + C.c,x0,hx2,y0} /\ + ((G1.bcol\/hinv FRO.m y0.`2 <> None){1} => G1.bcol{2}) /\ + (card (rng FRO.m) + 1 <= 2 * C.c + 1 /\ + Gcol.count <= C.c <= max_size){2});last by auto;smt ml=0 w=card_rng_set. + wp;if=>//;inline Gcol.sample_c. + + rcondt{2}4. + + auto;conseq (_:true)=>//;progress;2: smt ml=0. + by cut /#:= fcard_image_leq fst (rng FRO.m{hr}). + wp;conseq (_: ={p,v,F.RO.m,y1} /\ y2{1}=c{2})=>//;1:smt ml=0 w=hinv_image. + by sim. + rcondt{2}3. + + by auto;progress;cut /#:= fcard_image_leq fst (rng FRO.m{hr}). + auto;progress;smt w=hinv_image. + + + proc;sp 1 1;if=>//. + inline G1(DRestr(D)).S.fi Gcol.S.fi. + seq 2 2 : (={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m, + C.c,x0} /\ + (G1.bcol{1} => G1.bcol{2}) /\ + (card(rng FRO.m) + 2 <= 2*C.c + 1 /\ + Gcol.count + 1 <= C.c <= max_size){2});1:by auto=>/#. + if=>//;last by auto=>/#. + seq 3 2:(={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m, + C.c,x0,hx2} /\ + (G1.bcol{1} => G1.bcol{2}) /\ + (card (rng FRO.m) + 1 <= 2 * C.c + 1 /\ + Gcol.count + 1 <= C.c <= max_size){2}). + + by auto;smt ml=0 w=card_rng_set. + seq 3 3: + (={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m, + C.c,x0,hx2,y0,y1,y2} /\ y0{1} = (y1,y2){1} /\ + ((G1.bcol\/hinv FRO.m y0.`2 <> None){1} => G1.bcol{2}) /\ + (card (rng FRO.m) + 1 <= 2 * C.c + 1 /\ + Gcol.count <= C.c <= max_size){2});2:by auto;smt w=card_rng_set. + inline Gcol.sample_c. + rcondt{2}3. + + by auto;progress;cut /#:= fcard_image_leq fst (rng FRO.m{hr}). +(* BUG: auto=> /> ?? Himp _ _ _ ?_?_ [/Himp->// | H]. marche pas ???? *) + auto=> /> ?? Himp _ _ _ ?_?_ [/Himp->// | X];right;apply hinv_image=> //. + + + proc;sp 1 1;if=>//. + inline G1(DRestr(D)).C.f Gcol.C.f. + seq 5 5: + (={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m,C.c,b, + p,h,i,sa} /\ i{1}=0 /\ + (G1.bcol{1} => G1.bcol{2}) /\ + card (rng FRO.m{2}) + 2*(size p{2}) <= 2 * C.c{2} + 1 /\ + Gcol.count{2} + size p{2} <= C.c{2} <= max_size);1:by auto=>/#. + wp;call (_: ={F.RO.m});1:by sim. + while + (={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m,C.c,b, + p,h,i,sa} /\ (i <= size p){1} /\ + (G1.bcol{1} => G1.bcol{2}) /\ + (card (rng FRO.m) + 2*(size p - i) <= 2 * C.c + 1 /\ + Gcol.count + size p - i <= C.c <= max_size){2}); + last by auto; smt ml=0 w=size_ge0. + if=>//;auto;1:smt ml=0 w=size_ge0. + call (_: ={F.RO.m});1:by sim. + inline *;rcondt{2} 2. + + auto;progress;cut /#:= fcard_image_leq fst (rng FRO.m{hr}). + auto;smt ml=0 w=(hinv_image card_rng_set). + + auto;progress;3:by smt ml=0. + + by rewrite rng_set rem0 rng0 fset0U fcard1. + by apply max_ge0. + qed. + + local lemma Pr_col &m : + Pr[Gcol.main()@&m : G1.bcol /\ Gcol.count <= max_size] <= + max_size%r * ((2*max_size)%r / (2^c)%r). + proof. + fel 10 Gcol.count (fun x=> (2*max_size)%r / (2^c)%r) + max_size G1.bcol + [Gcol.sample_c : (card (image fst (rng FRO.m)) <= 2*max_size /\ Gcol.count < max_size)]=>//;2:by auto. + + rewrite /felsum Bigreal.sumr_const count_predT size_range. + apply ler_wpmul2r;1:by apply eps_ge0. + by rewrite le_fromint;smt ml=0 w=max_ge0. + + proc;sp;if;2:by hoare=>//??;apply eps_ge0. + wp. + rnd (mem (image fst (rng FRO.m)));skip;progress;2:smt ml=0. + cut->:=(Mu_mem.mu_mem (image fst (rng FRO.m{hr})) cdistr (1%r/(2^c)%r) _). + + move=>x _; rewrite DWord.dunifin1E;do !congr;exact cap_card. + apply ler_wpmul2r;2:by rewrite le_fromint. + by apply divr_ge0=>//;apply /c_ge0r. + + move=>ci;proc;rcondt 2;auto=>/#. + move=> b c;proc;sp;if;auto;smt ml=0. + qed. + + lemma Pr_G1col &m: + Pr[G1(DRestr(D)).main() @ &m : G1.bcol] <= max_size%r * ((2*max_size)%r / (2^c)%r). + proof. + apply (ler_trans Pr[Gcol.main()@&m : G1.bcol /\ Gcol.count <= max_size]). + + byequiv G1col=> //#. + apply (Pr_col &m). + qed. + +end section PROOF. + + diff --git a/proof/smart_counter/Gconcl.ec b/proof/smart_counter/Gconcl.ec new file mode 100644 index 0000000..bf80aed --- /dev/null +++ b/proof/smart_counter/Gconcl.ec @@ -0,0 +1,384 @@ +pragma -oldip. +require import Core Int Real RealExtra StdOrder Ring StdBigop IntExtra. +require import List FSet NewFMap Utils Common SLCommon RndO FelTactic Mu_mem. +require import DProd Dexcepted. +(*...*) import Capacity IntOrder Bigreal RealOrder BRA. + +require (*..*) Gext. + +module IF = { + proc init = F.RO.init + proc f = F.RO.get +}. + +module S(F : DFUNCTIONALITY) = { + var m, mi : smap + var paths : (capacity, block list * block) fmap + + proc init() = { + m <- map0; + mi <- map0; + (* the empty path is initially known by the adversary to lead to capacity 0^c *) + paths <- map0.[c0 <- ([<:block>],b0)]; + } + + proc f(x : state): state = { + var p, v, y, y1, y2; + + if (!mem (dom m) x) { + if (mem (dom paths) x.`2) { + (p,v) <- oget paths.[x.`2]; + y1 <- F.f (rcons p (v +^ x.`1)); + } else { + y1 <$ bdistr; + } + y2 <$ cdistr; + y <- (y1,y2); + m.[x] <- y; + mi.[y] <- x; + if (mem (dom paths) x.`2) { + (p,v) <- oget paths.[x.`2]; + paths.[y.`2] <- (rcons p (v +^ x.`1), y.`1); + } + } else { + y <- oget m.[x]; + } + return y; + } + + proc fi(x : state): state = { + var y, y1, y2; + + if (!mem (dom mi) x) { + y1 <$ bdistr; + y2 <$ cdistr; + y <- (y1,y2); + mi.[x] <- y; + m.[y] <- x; + } else { + y <- oget mi.[x]; + } + return y; + } + +}. + +section. + +declare module D: DISTINGUISHER{C, Perm, F.RO, F.FRO,S }. +local clone import Gext as Gext0. + +local module G3(RO:F.RO) = { + + module C = { + + proc f(p : block list): block = { + var sa, sa'; + var h, i <- 0; + sa <- b0; + while (i < size p ) { + if (mem (dom G1.mh) (sa +^ nth witness p i, h)) { + RO.sample(take (i+1) p); + (sa, h) <- oget G1.mh.[(sa +^ nth witness p i, h)]; + } else { + RRO.sample(G1.chandle); + sa' <@ RO.get(take (i+1) p); + sa <- sa +^ nth witness p i; + G1.mh.[(sa,h)] <- (sa', G1.chandle); + G1.mhi.[(sa',G1.chandle)] <- (sa, h); + (sa,h) <- (sa',G1.chandle); + G1.chandle <- G1.chandle + 1; + } + i <- i + 1; + } + sa <- RO.get(p); + return sa; + } + } + + module S = { + + proc f(x : state): state = { + var p, v, y, y1, y2, hy2, hx2, handles_,t; + + if (!mem (dom G1.m) x) { + if (mem (dom G1.paths) x.`2) { + (p,v) <- oget G1.paths.[x.`2]; + y1 <- RO.get (rcons p (v +^ x.`1)); + } else { + y1 <$ bdistr; + } + y2 <$ cdistr; + y <- (y1, y2); + handles_ <@ RRO.restrK(); + if (!mem (rng handles_) x.`2) { + RRO.set(G1.chandle, x.`2); + G1.chandle <- G1.chandle + 1; + } + handles_ <- RRO.restrK(); + hx2 <- oget (hinvc handles_ x.`2); + t <@ RRO.in_dom((oget G1.mh.[(x.`1,hx2)]).`2, Unknown); + if (mem (dom G1.mh) (x.`1, hx2) /\ t) { + hy2 <- (oget G1.mh.[(x.`1, hx2)]).`2; + FRO.m.[hy2] <- (y2,Known); + G1.m.[x] <- y; + G1.mi.[y] <- x; + } else { + hy2 <- G1.chandle; + G1.chandle <- G1.chandle + 1; + RRO.set(hy2, y.`2); + G1.m.[x] <- y; + G1.mh.[(x.`1, hx2)] <- (y.`1, hy2); + G1.mi.[y] <- x; + G1.mhi.[(y.`1, hy2)] <- (x.`1, hx2); + } + if (mem (dom G1.paths) x.`2) { + (p,v) <- oget G1.paths.[x.`2]; + G1.paths.[y.`2] <- (rcons p (v +^ x.`1), y.`1); + } + } else { + y <- oget G1.m.[x]; + } + return y; + } + + proc fi(x : state): state = { + var y, y1, y2, hx2, hy2, handles_, t; + + if (!mem (dom G1.mi) x) { + handles_ <@ RRO.restrK(); + if (!mem (rng handles_) x.`2) { + RRO.set(G1.chandle, x.`2); + G1.chandle <- G1.chandle + 1; + } + handles_ <@ RRO.restrK(); + hx2 <- oget (hinvc handles_ x.`2); + t <@ RRO.in_dom((oget G1.mhi.[(x.`1,hx2)]).`2, Unknown); + y1 <$ bdistr; + y2 <$ cdistr; + y <- (y1,y2); + if (mem (dom G1.mhi) (x.`1, hx2) /\ t) { + (y1,hy2) <- oget G1.mhi.[(x.`1, hx2)]; + FRO.m.[hy2] <- (y2,Known); + G1.mi.[x] <- y; + G1.m.[y] <- x; + } else { + hy2 <- G1.chandle; + G1.chandle <- G1.chandle + 1; + RRO.set(hy2, y.`2); + G1.mi.[x] <- y; + G1.mhi.[(x.`1, hx2)] <- (y.`1, hy2); + G1.m.[y] <- x; + G1.mh.[(y.`1, hy2)] <- (x.`1, hx2); + } + } else { + y <- oget G1.mi.[x]; + } + return y; + } + + } + + proc distinguish(): bool = { + var b; + + RO.init(); + G1.m <- map0; + G1.mi <- map0; + G1.mh <- map0; + G1.mhi <- map0; + + (* the empty path is initially known by the adversary to lead to capacity 0^c *) + RRO.init(); + RRO.set(0,c0); + G1.paths <- map0.[c0 <- ([<:block>],b0)]; + G1.chandle <- 1; + b <@ DRestr(D,C,S).distinguish(); + return b; + } +}. + +local equiv G2_G3: Eager(G2(DRestr(D))).main2 ~ G3(F.LRO).distinguish : ={glob D} ==> ={res}. +proof. + proc;wp;call{1} RRO_resample_ll;inline *;wp. + call (_: ={FRO.m,F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.chandle,G1.paths,C.c}); last by auto. + + + proc;sp;if=> //. + call (_: ={FRO.m,F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.chandle,G1.paths,C.c});2:by auto. + if=> //;2:by sim. + swap{1} [3..7] -2;swap{2} [4..8] -3. + seq 5 5:(={hx2,t,x,FRO.m,F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.chandle,G1.paths,C.c} /\ + (t = in_dom_with FRO.m (oget G1.mh.[(x.`1, hx2)]).`2 Unknown){1}); + 1:by inline *;auto. + seq 3 4:(={y,x,FRO.m,F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.chandle,G1.paths,C.c}); + 2:by sim. + if=>//. + + seq 2 2:(={y1,hx2,t,x,FRO.m,F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.chandle,G1.paths,C.c} + /\ (t = in_dom_with FRO.m (oget G1.mh.[(x.`1, hx2)]).`2 Unknown){1}). + + by inline *;auto=> /> ? _;rewrite Block.DWord.bdistr_ll. + case ((mem (dom G1.mh) (x.`1, hx2) /\ t){1}); + [rcondt{1} 3;2:rcondt{2} 3| rcondf{1} 3;2:rcondf{2} 3]; + 1,2,4,5:(by move=>?;conseq (_:true);auto);2:by sim. + inline *;rcondt{1} 6;1:by auto=>/>. + wp;rnd;auto;progress[-split];rewrite DCapacity.dunifin_ll /= => ?_?->. + by rewrite !getP /= oget_some. + case ((mem (dom G1.mh) (x.`1, hx2) /\ t){1}); + [rcondt{1} 4;2:rcondt{2} 4| rcondf{1} 4;2:rcondf{2} 4]; + 1,2,4,5:(by move=>?;conseq (_:true);auto);2:by sim. + inline *;rcondt{1} 7;1:by auto=>/>. + wp;rnd;auto;rnd{1};auto;progress[-split]. + rewrite Block.DBlock.supp_dunifin DCapacity.dunifin_ll /==> ?_?->. + by rewrite !getP /= oget_some. + + + proc;sp;if=>//. + call (_: ={FRO.m,F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.chandle,G1.paths,C.c});2:by auto. + if=> //;2:sim. + swap{1} 8 -3. + seq 6 6 : (={y1,hx2,t,x,FRO.m,F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.chandle,G1.paths,C.c} + /\ (t = in_dom_with FRO.m (oget G1.mhi.[(x.`1, hx2)]).`2 Unknown){1}). + + by inline *;auto. + case ((mem (dom G1.mhi) (x.`1, hx2) /\ t){1}); + [rcondt{1} 3;2:rcondt{2} 3| rcondf{1} 3;2:rcondf{2} 3]; + 1,2,4,5:(by move=>?;conseq (_:true);auto);2:by sim. + inline *;rcondt{1} 6;1:by auto=>/>. + wp;rnd;auto;progress[-split];rewrite DCapacity.dunifin_ll /= => ?_?->. + by rewrite !getP /= oget_some. + + proc;sp;if=>//. + call (_: ={FRO.m,F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.chandle,G1.paths,C.c});2:by auto. + by inline F.LRO.sample;sim. +qed. + +local module G4(RO:F.RO) = { + + module C = { + + proc f(p : block list): block = { + var sa; + var h, i <- 0; + sa <- b0; + while (i < size p ) { + RO.sample(take (i+1) p); + i <- i + 1; + } + sa <- RO.get(p); + return sa; + } + } + + module S = { + + proc f(x : state): state = { + var p, v, y, y1, y2; + + if (!mem (dom G1.m) x) { + if (mem (dom G1.paths) x.`2) { + (p,v) <- oget G1.paths.[x.`2]; + y1 <- RO.get (rcons p (v +^ x.`1)); + } else { + y1 <$ bdistr; + } + y2 <$ cdistr; + y <- (y1,y2); + G1.m.[x] <- y; + G1.mi.[y] <- x; + if (mem (dom G1.paths) x.`2) { + (p,v) <- oget G1.paths.[x.`2]; + G1.paths.[y.`2] <- (rcons p (v +^ x.`1), y.`1); + } + } else { + y <- oget G1.m.[x]; + } + return y; + } + + proc fi(x : state): state = { + var y, y1, y2; + + if (!mem (dom G1.mi) x) { + y1 <$ bdistr; + y2 <$ cdistr; + y <- (y1,y2); + G1.mi.[x] <- y; + G1.m.[y] <- x; + } else { + y <- oget G1.mi.[x]; + } + return y; + } + + } + + proc distinguish(): bool = { + var b; + + RO.init(); + G1.m <- map0; + G1.mi <- map0; + (* the empty path is initially known by the adversary to lead to capacity 0^c *) + G1.paths <- map0.[c0 <- ([<:block>],b0)]; + b <@ DRestr(D,C,S).distinguish(); + return b; + } +}. + +local equiv G3_G4 : G3(F.RO).distinguish ~ G4(F.RO).distinguish : ={glob D} ==> ={res}. +proof. + proc;inline *;wp. + call (_: ={G1.m,G1.mi,G1.paths,F.RO.m,C.c});last by auto. + + proc;sp;if=>//. + call (_: ={G1.m,G1.mi,G1.paths,F.RO.m,C.c});last by auto. + if => //;2:sim. + seq 3 3: (={x,y1,y2,y,G1.m,G1.mi,G1.paths,F.RO.m,C.c});1:by sim. + sim;seq 5 0: (={x,y1,y2,y,G1.m,G1.mi,G1.paths,F.RO.m,C.c});1:by inline *;auto. + by if{1};sim;inline *;auto. + + proc;sp;if=>//. + call (_: ={G1.m,G1.mi,G1.paths,F.RO.m,C.c});last by auto. + if => //;2:sim. + seq 5 0: (={x,G1.m,G1.mi,G1.paths,F.RO.m,C.c});1:by inline *;auto. + seq 3 3: (={x,y1,y2,y,G1.m,G1.mi,G1.paths,F.RO.m,C.c});1:by sim. + by if{1};sim;inline *;auto. + proc;sp;if=>//. + call (_: ={G1.m,G1.mi,G1.paths,F.RO.m,C.c});last by auto. + sp;sim; while(={i,p,F.RO.m})=>//. + inline F.RO.sample F.RO.get;if{1};1:by auto. + by sim;inline *;auto;progress;apply DCapacity.dunifin_ll. +qed. + +local equiv G4_Ideal : G4(F.LRO).distinguish ~ IdealIndif(IF,S,DRestr(D)).main : + ={glob D} ==> ={res}. +proof. + proc;inline *;wp. + call (_: ={C.c,F.RO.m} /\ G1.m{1}=S.m{2} /\ G1.mi{1}=S.mi{2} /\ G1.paths{1}=S.paths{2}). + + by sim. + by sim. + + proc;sp;if=>//. + call (_: ={F.RO.m});2:by auto. + inline F.LRO.get F.FRO.sample;wp 7 2;sim. + by while{1} (true) (size p - i){1};auto;1:inline*;auto=>/#. + by auto. +qed. + +axiom D_ll : + forall (F <: DFUNCTIONALITY{D}) (P <: DPRIMITIVE{D}), + islossless P.f => + islossless P.fi => islossless F.f => islossless D(F, P).distinguish. + + +lemma Real_Ideal &m: + Pr[GReal(D).main() @ &m: res /\ C.c <= max_size] <= + Pr[IdealIndif(IF,S,DRestr(D)).main() @ &m :res] + + (max_size ^ 2)%r * mu dstate (pred1 witness) + + max_size%r * ((2*max_size)%r / (2^c)%r) + + max_size%r * ((2*max_size)%r / (2^c)%r). +proof. + apply (ler_trans _ _ _ (Real_G2 D D_ll &m)). + rewrite !(ler_add2l, ler_add2r);apply lerr_eq. + apply (eq_trans _ Pr[G3(F.LRO).distinguish() @ &m : res]);1:by byequiv G2_G3. + apply (eq_trans _ Pr[G3(F.RO ).distinguish() @ &m : res]). + + by byequiv (_: ={glob G3, F.RO.m} ==> _)=>//;symmetry;conseq (F.RO_LRO_D G3). + apply (eq_trans _ Pr[G4(F.RO ).distinguish() @ &m : res]);1:by byequiv G3_G4. + apply (eq_trans _ Pr[G4(F.LRO).distinguish() @ &m : res]);1:by byequiv (F.RO_LRO_D G4). + by byequiv G4_Ideal. +qed. + +end section. diff --git a/proof/smart_counter/Gext.eca b/proof/smart_counter/Gext.eca new file mode 100644 index 0000000..2182665 --- /dev/null +++ b/proof/smart_counter/Gext.eca @@ -0,0 +1,675 @@ +pragma -oldip. +require import Core Int Real RealExtra StdOrder Ring StdBigop IntExtra. +require import List FSet NewFMap Utils Common SLCommon RndO FelTactic Mu_mem. +require import DProd Dexcepted. +(*...*) import Capacity IntOrder Bigreal RealOrder BRA DCapacity. + +require (*..*) Gcol. + +clone export Gcol as Gcol0. +print Eager. +op bad_ext (m mi:smap) y = + mem (image snd (dom m)) y \/ + mem (image snd (dom mi)) y. + +op hinvc (m:(handle,capacity)fmap) (c:capacity) = + find (+ pred1 c) m. + +module G2(D:DISTINGUISHER,HS:FRO) = { + + module C = { + + proc f(p : block list): block = { + var sa, sa'; + var h, i <- 0; + sa <- b0; + while (i < size p ) { + if (mem (dom G1.mh) (sa +^ nth witness p i, h)) { + (sa, h) <- oget G1.mh.[(sa +^ nth witness p i, h)]; + } else { + HS.sample(G1.chandle); + sa' <@ F.RO.get(take (i+1) p); + sa <- sa +^ nth witness p i; + G1.mh.[(sa,h)] <- (sa', G1.chandle); + G1.mhi.[(sa',G1.chandle)] <- (sa, h); + (sa,h) <- (sa',G1.chandle); + G1.chandle <- G1.chandle + 1; + } + i <- i + 1; + } + sa <- F.RO.get(p); + return sa; + } + } + + module S = { + + proc f(x : state): state = { + var p, v, y, y1, y2, hy2, hx2, handles_,t; + + if (!mem (dom G1.m) x) { + if (mem (dom G1.paths) x.`2) { + (p,v) <- oget G1.paths.[x.`2]; + y1 <- F.RO.get (rcons p (v +^ x.`1)); + y2 <$ cdistr; + } else { + y1 <$ bdistr; + y2 <$ cdistr; + } + y <- (y1, y2); + + handles_ <@ HS.restrK(); + if (!mem (rng handles_) x.`2) { + HS.set(G1.chandle, x.`2); + G1.chandle <- G1.chandle + 1; + } + handles_ <- HS.restrK(); + hx2 <- oget (hinvc handles_ x.`2); + t <@ HS.in_dom((oget G1.mh.[(x.`1,hx2)]).`2, Unknown); + if (mem (dom G1.mh) (x.`1, hx2) /\ t) { + hy2 <- (oget G1.mh.[(x.`1, hx2)]).`2; + y2 <@ HS.get(hy2); + G1.bext <- G1.bext \/ bad_ext G1.m G1.mi y2 \/ y2 = x.`2; + y <- (y.`1, y2); + G1.m.[x] <- y; + G1.mi.[y] <- x; + } else { + hy2 <- G1.chandle; + G1.chandle <- G1.chandle + 1; + HS.set(hy2, y.`2); + G1.m.[x] <- y; + G1.mh.[(x.`1, hx2)] <- (y.`1, hy2); + G1.mi.[y] <- x; + G1.mhi.[(y.`1, hy2)] <- (x.`1, hx2); + } + if (mem (dom G1.paths) x.`2) { + (p,v) <- oget G1.paths.[x.`2]; + G1.paths.[y.`2] <- (rcons p (v +^ x.`1), y.`1); + } + } else { + y <- oget G1.m.[x]; + } + return y; + } + + proc fi(x : state): state = { + var y, y1, y2, hx2, hy2, handles_, t; + + if (!mem (dom G1.mi) x) { + handles_ <@ HS.restrK(); + if (!mem (rng handles_) x.`2) { + HS.set(G1.chandle, x.`2); + G1.chandle <- G1.chandle + 1; + } + handles_ <@ HS.restrK(); + hx2 <- oget (hinvc handles_ x.`2); + y1 <$ bdistr; + y2 <$ cdistr; + y <- (y1,y2); + t <@ HS.in_dom((oget G1.mhi.[(x.`1,hx2)]).`2, Unknown); + if (mem (dom G1.mhi) (x.`1, hx2) /\ t) { + (y1,hy2) <- oget G1.mhi.[(x.`1, hx2)]; + y2 <@ HS.get(hy2); + y <- (y.`1, y2); + G1.bext <- G1.bext \/ bad_ext G1.m G1.mi y2 \/ y2 = x.`2; + G1.mi.[x] <- y; + G1.m.[y] <- x; + } else { + hy2 <- G1.chandle; + G1.chandle <- G1.chandle + 1; + HS.set(hy2, y.`2); + G1.mi.[x] <- y; + G1.mhi.[(x.`1, hx2)] <- (y.`1, hy2); + G1.m.[y] <- x; + G1.mh.[(y.`1, hy2)] <- (x.`1, hx2); + } + } else { + y <- oget G1.mi.[x]; + } + return y; + } + + } + + proc distinguish(): bool = { + var b; + + F.RO.m <- map0; + G1.m <- map0; + G1.mi <- map0; + G1.mh <- map0; + G1.mhi <- map0; + G1.bext <- false; + + (* the empty path is initially known by the adversary to lead to capacity 0^c *) + HS.set(0,c0); + G1.paths <- map0.[c0 <- ([<:block>],b0)]; + G1.chandle <- 1; + b <@ D(C,S).distinguish(); + return b; + } +}. + +section. + + declare module D: DISTINGUISHER{G1, G2, FRO}. + + op inv_ext (m mi:smap) (FROm:handles) = + exists x h, mem (dom m `|` dom mi) x /\ FROm.[h] = Some (x.`2, Unknown). + + op inv_ext1 bext1 bext2 (m mi:smap) (FROm:handles) = + bext1 => (bext2 \/ inv_ext m mi FROm). + + lemma rng_restr (m : ('from, 'to * 'flag) fmap) f x: + mem (rng (restr f m)) x <=> mem (rng m) (x,f). + proof. + rewrite !in_rng;split=>-[z]H;exists z;move:H;rewrite restrP; case m.[z]=>//=. + by move=> [t f'] /=;case (f'=f). + qed. + + equiv G1_G2 : G1(D).main ~ Eager(G2(D)).main1 : + ={glob D} ==> ={res} /\ inv_ext1 G1.bext{1} G1.bext{2} G1.m{2} G1.mi{2} FRO.m{2}. + proof. + proc;inline{2} FRO.init G2(D, FRO).distinguish;wp. + call (_: ={F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.paths,G1.chandle,FRO.m} /\ + inv_ext1 G1.bext{1} G1.bext{2} G1.m{2} G1.mi{2} FRO.m{2} /\ + (forall h, mem (dom FRO.m) h => h < G1.chandle){1}). + + proc;if=>//;last by auto. + seq 2 2: (={F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.paths,G1.chandle,FRO.m,x,y} /\ + inv_ext1 G1.bext{1} G1.bext{2} G1.m{2} G1.mi{2} FRO.m{2} /\ + (forall h, mem (dom FRO.m) h => h < G1.chandle){1} /\ + ! mem (dom G1.m{1}) x{1}). + + by if=>//;auto;call (_: ={F.RO.m});[sim |auto]. + seq 3 5: + (={F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.paths,G1.chandle,FRO.m,hx2,x,y,hx2} /\ + t{2} = (in_dom_with FRO.m (oget G1.mh.[(x.`1, hx2)]).`2 Unknown){1} /\ + (G1.bext{1} => (G1.bext{2} \/ (mem (rng FRO.m) (x.`2, Unknown)){2} \/ + inv_ext G1.m{2} G1.mi{2} FRO.m{2})) /\ + (forall h, mem (dom FRO.m) h => h < G1.chandle){1} /\ + ! mem (dom G1.m{1}) x{1}). + + inline *;auto=> &ml&mr[#]10!-> Hi Hhand -> /=. + rewrite -dom_restr rng_restr /=;progress; 3:by smt ml=0. + + rewrite rng_set !inE rem_id 1:/#;move:H0=>[/Hi[->|[x' h][]H1 H2]|->]//. + right;right;exists x' h;rewrite getP. + by cut ->//:(h<> G1.chandle{mr});move:(Hhand h);rewrite in_dom H2 /#. + by move:H0;rewrite dom_set !inE /#. + seq 1 1: (={x,y,F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.paths,G1.chandle,FRO.m} /\ + inv_ext1 G1.bext{1} G1.bext{2} G1.m{2} G1.mi{2} FRO.m{2} /\ + forall (h : handle), mem (dom FRO.m{1}) h => h < G1.chandle{1});2:by auto. + if=>//. + + inline *;rcondt{2} 4. + + by move=> &m;auto;rewrite /in_dom_with. +(* auto=> |>. (* Bug ???? *) *) + auto;progress. + + by apply sampleto_ll. + + rewrite /inv_ext1=>/H{H}[->//|[/in_rng[h]Hh|[[x1 x2] h [Hx Hh]]]]. + + case (h = (oget G1.mh{2}.[(x{2}.`1, hx2{2})]).`2)=> [->>|Hneq]. + + by left;rewrite Hh oget_some. + by right;exists x{2} h;rewrite dom_set getP Hneq !inE. + case (h = (oget G1.mh{2}.[(x{2}.`1, hx2{2})]).`2)=> [->>|Hneq]. + + rewrite Hh /bad_ext oget_some /= <@ Hx;rewrite !inE. + by move=>[|]/(mem_image snd)->. + right;exists (x1,x2) h;rewrite !dom_set getP Hneq //=. + by move:Hx;rewrite !inE Hh=>-[]->. + by move:H6 H2;rewrite /in_dom_with dom_set !inE /#. + inline *;auto;progress;last by move:H3;rewrite dom_set !inE /#. + rewrite /inv_ext1=> /H [->//|[/in_rng[h]Hh|[x' h [Hx Hh]]]]. + + right;exists x{2} h;rewrite getP dom_set !inE /=. + by move:(H0 h);rewrite in_dom Hh /#. + right;exists x' h;rewrite getP !dom_set !inE;split. + + by move:Hx;rewrite !inE=>-[]->. + by move:(H0 h);rewrite !in_dom Hh /#. + + + proc;if=>//;last by auto. + seq 6 8: + (={F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.paths,G1.chandle,FRO.m,hx2,x,y,hx2} /\ + t{2} = (in_dom_with FRO.m (oget G1.mhi.[(x.`1, hx2)]).`2 Unknown){1} /\ + (G1.bext{1} => (G1.bext{2} \/ (mem (rng FRO.m) (x.`2, Unknown)){2} \/ + inv_ext G1.m{2} G1.mi{2} FRO.m{2})) /\ + (forall h, mem (dom FRO.m) h => h < G1.chandle){1} /\ + ! mem (dom G1.mi{1}) x{1}). + + inline *;auto=> &ml&mr[#]9!-> Hi Hhand -> /=. + rewrite -dom_restr rng_restr /=;progress; 3:by smt ml=0. + + rewrite rng_set !inE rem_id 1:/#;move:H4=>[/Hi[->|[x' h][]HH1 HH2]|->]//. + right;right;exists x' h;rewrite getP. + by cut ->//:(h<> G1.chandle{mr});move:(Hhand h);rewrite in_dom HH2 /#. + by move:H4;rewrite dom_set !inE /#. + if=>//. + + inline *;rcondt{2} 4. + + by move=> &m;auto;rewrite /in_dom_with. + auto;progress. + + by apply sampleto_ll. + + rewrite /inv_ext1=>/H{H}[->//|[/in_rng[h]Hh|[[x1 x2] h [Hx Hh]]]]. + + case (h = (oget G1.mhi{2}.[(x{2}.`1, hx2{2})]).`2)=> [->>|Hneq]. + + by left;rewrite Hh oget_some. + by right;exists x{2} h;rewrite !dom_set getP Hneq !inE. + case (h = (oget G1.mhi{2}.[(x{2}.`1, hx2{2})]).`2)=> [->>|Hneq]. + + rewrite Hh /bad_ext oget_some /= <@ Hx;rewrite !inE. + by move=>[|]/(mem_image snd)->. + right;exists (x1,x2) h;rewrite !dom_set getP Hneq //=. + by move:Hx;rewrite !inE Hh=>-[]->. + by move:H6 H2;rewrite /in_dom_with dom_set !inE /#. + inline *;auto;progress;last by move:H3;rewrite dom_set !inE /#. + rewrite /inv_ext1=> /H [->//|[/in_rng[h]Hh|[x' h [Hx Hh]]]]. + + right;exists x{2} h;rewrite getP !dom_set !inE /=. + by move:(H0 h);rewrite in_dom Hh /#. + right;exists x' h;rewrite getP !dom_set !inE;split. + + by move:Hx;rewrite !inE=>-[]->. + by move:(H0 h);rewrite !in_dom Hh /#. + + + proc; + conseq (_: ={sa,G1.mh,G1.mhi,F.RO.m, G1.chandle, FRO.m} /\ + inv_ext1 G1.bext{1} G1.bext{2} G1.m{2} G1.mi{2} FRO.m{2} /\ + forall (h0 : handle), mem (dom FRO.m{1}) h0 => h0 < G1.chandle{1})=>//. + sp 3 3;call (_: ={F.RO.m});1:by sim. + while (={sa,G1.mh,G1.mhi,F.RO.m,G1.chandle,FRO.m,i,h,sa,p} /\ + inv_ext1 G1.bext{1} G1.bext{2} G1.m{2} G1.mi{2} FRO.m{2} /\ + forall (h0 : handle), mem (dom FRO.m{1}) h0 => h0 < G1.chandle{1})=>//. + if=>//;inline *;1:by auto. + rcondt{2} 3;1:by auto=>/#. + auto=> &m1&m2 [#] 10!-> Hinv Hhand Hi _ _ /= ?->?->/=;split=>/= _;split. + + move:Hinv;rewrite /inv_ext1=> H/H{H}[->//|[x h]];rewrite inE=>-[Hmem Hh]. + by right;exists x h;rewrite !inE Hmem getP;smt w=in_dom. + + by move=>h;rewrite dom_set !inE /#. + + move:Hinv;rewrite /inv_ext1=> H/H{H}[->//|[x h]];rewrite inE=>-[Hmem Hh]. + by right;exists x h;rewrite !inE Hmem getP;smt w=in_dom. + by move=>h;rewrite dom_set !inE /#. + + (* **************** *) + inline *;auto;progress. + by move:H;rewrite dom_set dom0 !inE=>->. + qed. + +end section. + +section EXT. + + declare module D: DISTINGUISHER{C, PF, G1, G2, Perm, RO }. + + local module ReSample = { + var count:int + proc f (h:handle) = { + var c; + c <$ cdistr; + if (size G1.m <= max_size /\ size G1.mi <= max_size /\ ReSample.count < max_size) { + G1.bext <- G1.bext \/ mem (image snd (dom G1.m `|` dom G1.mi)) c; + FRO.m.[h] <- (c,Unknown); + count = count + 1 ; + } + } + + proc f1 (x:capacity,h:handle) = { + var c; + c <$ cdistr; + if (size G1.m < max_size /\ size G1.mi < max_size /\ ReSample.count < max_size) { + G1.bext <- G1.bext \/ mem (image snd (dom G1.m `|` dom G1.mi) `|` fset1 x) c; + FRO.m.[h] <- (c,Unknown); + count = count + 1; + } + } + + }. + + local module Gext = { + + proc resample () = { + Iter(ReSample).iter (elems (dom (restr Unknown FRO.m))); + } + + module C = { + + proc f(p : block list): block = { + var sa, sa'; + var h, i <- 0; + sa <- b0; + while (i < size p ) { + if (mem (dom G1.mh) (sa +^ nth witness p i, h)) { + (sa, h) <- oget G1.mh.[(sa +^ nth witness p i, h)]; + } else { + RRO.sample(G1.chandle); + sa' <@ F.RO.get(take (i+1) p); + sa <- sa +^ nth witness p i; + G1.mh.[(sa,h)] <- (sa', G1.chandle); + G1.mhi.[(sa',G1.chandle)] <- (sa, h); + (sa,h) <- (sa',G1.chandle); + G1.chandle <- G1.chandle + 1; + } + i <- i + 1; + } + sa <- F.RO.get(p); + return sa; + } + } + + module S = { + + proc f(x : state): state = { + var p, v, y, y1, y2, hy2, hx2, handles_,t; + + if (!mem (dom G1.m) x) { + if (mem (dom G1.paths) x.`2) { + (p,v) <- oget G1.paths.[x.`2]; + y1 <- F.RO.get (rcons p (v +^ x.`1)); + } else { + y1 <$ bdistr; + } + y2 <$ cdistr; + y <- (y1, y2); + (* exists x h, mem (dom G1.m) x /\ handles.[h] = Some (x.2, I) *) + + handles_ <@ RRO.restrK(); + if (!mem (rng handles_) x.`2) { + RRO.set(G1.chandle, x.`2); + G1.chandle <- G1.chandle + 1; + } + handles_ <- RRO.restrK(); + hx2 <- oget (hinvc handles_ x.`2); + t <@ RRO.in_dom((oget G1.mh.[(x.`1,hx2)]).`2, Unknown); + if (mem (dom G1.mh) (x.`1, hx2) /\ t) { + hy2 <- (oget G1.mh.[(x.`1, hx2)]).`2; + ReSample.f1(x.`2, hy2); + y2 <@ FRO.get(hy2); + y <- (y.`1, y2); + G1.m.[x] <- y; + G1.mi.[y] <- x; + } else { + hy2 <- G1.chandle; + G1.chandle <- G1.chandle + 1; + RRO.set(hy2, y.`2); + G1.m.[x] <- y; + G1.mh.[(x.`1, hx2)] <- (y.`1, hy2); + G1.mi.[y] <- x; + G1.mhi.[(y.`1, hy2)] <- (x.`1, hx2); + } + if (mem (dom G1.paths) x.`2) { + (p,v) <- oget G1.paths.[x.`2]; + G1.paths.[y.`2] <- (rcons p (v +^ x.`1), y.`1); + } + } else { + y <- oget G1.m.[x]; + } + return y; + } + + proc fi(x : state): state = { + var y, y1, y2, hx2, hy2, handles_, t; + + if (!mem (dom G1.mi) x) { + handles_ <@ RRO.restrK(); + if (!mem (rng handles_) x.`2) { + RRO.set(G1.chandle, x.`2); + G1.chandle <- G1.chandle + 1; + } + handles_ <@ RRO.restrK(); + hx2 <- oget (hinvc handles_ x.`2); + y1 <$ bdistr; + y2 <$ cdistr; + y <- (y1,y2); + t <@ RRO.in_dom((oget G1.mhi.[(x.`1,hx2)]).`2, Unknown); + if (mem (dom G1.mhi) (x.`1, hx2) /\ t) { + (y1,hy2) <- oget G1.mhi.[(x.`1, hx2)]; + ReSample.f1(x.`2,hy2); + y2 <@ FRO.get(hy2); + y <- (y.`1, y2); + + G1.mi.[x] <- y; + G1.m.[y] <- x; + } else { + hy2 <- G1.chandle; + G1.chandle <- G1.chandle + 1; + RRO.set(hy2, y.`2); + G1.mi.[x] <- y; + G1.mhi.[(x.`1, hx2)] <- (y.`1, hy2); + G1.m.[y] <- x; + G1.mh.[(y.`1, hy2)] <- (x.`1, hx2); + } + } else { + y <- oget G1.mi.[x]; + } + return y; + } + + } + + proc distinguish(): bool = { + var b; + + SLCommon.C.c <- 0; + F.RO.m <- map0; + G1.m <- map0; + G1.mi <- map0; + G1.mh <- map0; + G1.mhi <- map0; + G1.bext <- false; + ReSample.count <- 0; + FRO.m <- map0; + + (* the empty path is initially known by the adversary to lead to capacity 0^c *) + RRO.set(0,c0); + G1.paths <- map0.[c0 <- ([<:block>],b0)]; + G1.chandle <- 1; + b <@ DRestr(D,C,S).distinguish(); + resample(); + return b; + } + }. + + op inv_lt (m2 mi2:smap) c1 (Fm2:handles) count2 = + size m2 < c1 /\ size mi2 < c1 /\ + count2 + size (restr Unknown Fm2) < c1 /\ + c1 <= max_size. + + op inv_le (m2 mi2:smap) c1 (Fm2:handles) count2 = + size m2 <= c1 /\ size mi2 <= c1 /\ + count2 + size (restr Unknown Fm2) <= c1 /\ + c1 <= max_size. + + lemma fset0_eqP (s:'a fset): s = fset0 <=> forall x, !mem s x. + proof. + split=>[-> x|Hmem];1:by rewrite inE. + by apply fsetP=>x;rewrite inE Hmem. + qed. + + lemma size_set (m:('a,'b)fmap) (x:'a) (y:'b): + size (m.[x<-y]) = if mem (dom m) x then size m else size m + 1. + proof. + rewrite sizeE dom_set;case (mem (dom m) x)=> Hx. + + by rewrite fsetUC subset_fsetU_id 2:sizeE 2:// => z; rewrite ?inE. + rewrite fcardUI_indep 1:fset0_eqP=>[z|]. + + by rewrite !inE;case (z=x)=>//. + by rewrite fcard1 sizeE. + qed. + + lemma size_set_le (m:('a,'b)fmap) (x:'a) (y:'b): size (m.[x<-y]) <= size m + 1. + proof. rewrite size_set /#. qed. + + lemma size_rem (m:('a,'b)fmap) (x:'a): + size (rem x m) = if mem (dom m) x then size m - 1 else size m. + proof. + rewrite !sizeE dom_rem fcardD;case (mem (dom m) x)=> Hx. + + by rewrite subset_fsetI_id 2:fcard1// => z;rewrite !inE. + by rewrite (eq_fcards0 (_ `&` _)) 2:// fset0_eqP=>z;rewrite !inE /#. + qed. + + lemma size_rem_le (m:('a,'b)fmap) x : size (rem x m) <= size m. + proof. by rewrite size_rem /#. qed. + + lemma size_ge0 (m:('a,'b)fmap) : 0 <= size m. + proof. rewrite sizeE fcard_ge0. qed. + + lemma size0 : size map0<:'a,'b> = 0. + proof. by rewrite sizeE dom0 fcards0. qed. + + local equiv RROset_inv_lt : RRO.set ~ RRO.set : + ={x,y,FRO.m} /\ inv_lt G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2} ==> + ={res,FRO.m} /\ inv_lt G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2}. + proof. + proc;auto=> &ml&mr[#]3!-> /= @/inv_lt [*]. + rewrite restr_set /=;smt w=(size_set_le size_rem_le). + qed. + + local equiv EG2_Gext : Eager(G2(DRestr(D))).main2 ~ Gext.distinguish: + ={glob D} ==> + ReSample.count{2} <= max_size /\ + ((G1.bext{1} \/ inv_ext G1.m{1} G1.mi{1} FRO.m{1}) => G1.bext{2}). + proof. + proc;inline *;wp. + while (={l,FRO.m,G1.m,G1.mi} /\ size G1.m{2} <= max_size /\ + size G1.mi{2} <= max_size /\ + ReSample.count{2} + size l{2} <= max_size /\ + ((G1.bext{1} \/ + exists (x : state) (h : handle), + mem (dom G1.m{1} `|` dom G1.mi{1}) x /\ + FRO.m{1}.[h] = Some (x.`2, Unknown) /\ !mem l{1} h) => + G1.bext{2})). + + rcondt{2} 3. + + move=> &m;auto=> &m'[#] 6!-> /= + _ _;case (l{m'})=>//=; smt w=List.size_ge0. + auto=> &ml&mr[#]6!->;case(l{mr})=>[//|h1 l1/=Hle Hext c->/=];split. + + smt w=(drop0 size_ge0). + rewrite drop0=>-[H|[x h][#]];1:by rewrite Hext // H. + rewrite getP;case (h=h1)=> [/=->Hin->_ | Hneq ???]. + + by right;apply (mem_image snd _ x). + by rewrite Hext 2://;right;exists x h;rewrite Hneq. + wp; call (_: ={F.RO.m,FRO.m,G1.paths,G1.mh,G1.mhi,G1.m,G1.mi,G1.chandle,G1.bext, C.c} /\ + inv_le G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2}). + + proc;sp;if=> //. + call (_: ={x,F.RO.m,FRO.m,G1.paths,G1.mh,G1.mhi,G1.m,G1.mi,G1.chandle,G1.bext,C.c} /\ + inv_lt G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2} ==> + ={res,F.RO.m,FRO.m,G1.paths,G1.mh,G1.mhi,G1.m,G1.mi,G1.chandle,G1.bext,C.c} /\ + inv_le G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2});last by auto=> /#. + proc;if=>//;last by auto=>/#. + seq 8 9 : (={x, y, F.RO.m, FRO.m, G1.paths, G1.mh, G1.mhi, G1.m, G1.mi, G1.chandle, + G1.bext, C.c} /\ + inv_le G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2});2:by auto. + seq 2 3 : + (={y,x,F.RO.m,FRO.m,G1.paths,G1.mh,G1.mhi,G1.m,G1.mi,G1.chandle,G1.bext, C.c} /\ + inv_lt G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2}). + + by if=>//;auto;call (_: ={F.RO.m});auto. + seq 5 5 : + (={t,y,x,hx2,F.RO.m,FRO.m,G1.paths,G1.mh,G1.mhi,G1.m,G1.mi,G1.chandle,G1.bext, C.c} /\ + inv_lt G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2} /\ + (t => in_dom_with FRO.m (oget G1.mh.[(x.`1, hx2)]).`2 Unknown){1}). + + inline RRO.in_dom; wp;call (_: ={FRO.m});1:by sim. + inline RRO.restrK;sp 1 1;if=>//. + by wp;call RROset_inv_lt;auto. + if=>//;wp. + + inline *;rcondt{1} 4;1:by auto=>/#. + rcondt{2} 5;1:by auto;smt w=(sizeE size_ge0). + rcondt{2} 10. by auto;progress;rewrite dom_set !inE. + wp;rnd{2};auto=> /= ??[#]!-> @/inv_lt @/inv_le [#] mlt milt clt cle Hin 3?->/=. + rewrite/Distr.is_lossless (sampleto_ll 0)/= => ? _;rewrite /bad_ext !getP /= !oget_some /= set_set_eq /=. + rewrite !(imageU,inE) restr_set /= size_rem dom_restr Hin //=; smt w=size_set_le. + by call RROset_inv_lt;auto;smt w=size_set_le. + + + proc;sp;if=> //. + call (_: ={x,F.RO.m,FRO.m,G1.paths,G1.mh,G1.mhi,G1.m,G1.mi,G1.chandle,G1.bext,C.c} /\ + inv_lt G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2} ==> + ={res,F.RO.m,FRO.m,G1.paths,G1.mh,G1.mhi,G1.m,G1.mi,G1.chandle,G1.bext,C.c} /\ + inv_le G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2});last by auto=> /#. + proc;if=>//;last by auto=>/#. + seq 8 8 : + (={t,y,x,hx2,F.RO.m,FRO.m,G1.paths,G1.mh,G1.mhi,G1.m,G1.mi,G1.chandle,G1.bext, C.c} /\ + inv_lt G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2} /\ + (t => in_dom_with FRO.m (oget G1.mhi.[(x.`1, hx2)]).`2 Unknown){1}). + + inline RRO.in_dom; auto;call (_: ={FRO.m});1:by sim. + inline RRO.restrK;sp 1 1;if=>//. + by wp;call RROset_inv_lt;auto. + if=>//;wp. + + inline *;rcondt{1} 4;1:by auto=>/#. + rcondt{2} 5;1:by auto;smt w=(sizeE size_ge0). + rcondt{2} 10. by auto;progress;rewrite dom_set !inE. + wp;rnd{2};auto=> /= ??[#]!-> @/inv_lt @/inv_le [#] mlt milt clt cle Hin 3?->/=. + rewrite/Distr.is_lossless (sampleto_ll 0) /= => ? _;rewrite /bad_ext !getP /= !oget_some /= set_set_eq /=. + rewrite !(imageU,inE) restr_set /= size_rem dom_restr Hin //=; smt w=size_set_le. + by call RROset_inv_lt;auto;smt w=size_set_le. + + + proc;sp 1 1;if=>//. + inline G2(DRestr(D), RRO).C.f Gext.C.f. + sp 5 5;elim *=> c0L c0R. + wp;call (_: ={F.RO.m});1:by sim. + while (={i,p,G1.mh,sa,h,FRO.m,F.RO.m,G1.mh,G1.mhi,G1.chandle} /\ 0 <= i{1} <= size p{1}/\ + c0R + size p{1} <= max_size /\ + inv_le G1.m{2} G1.mi{2} (c0R + i){2} FRO.m{2} ReSample.count{2}); + last by auto;smt w=List.size_ge0. + if=> //;1:by auto=>/#. + auto;call (_: ={F.RO.m});1:by sim. + inline *;auto=> ?&mr [#]!->@/inv_le Hi [#]. + case (p{mr})=> [/#|/=p1 p2] 4?_ /= 2?-> /=;split=>/= Hmem 4? [#]2->/= => [|/#]. + by rewrite restr_set /= size_set dom_restr /in_dom_with Hmem/= /#. + + auto;progress[delta];rewrite ?(size0,restr0,restr_set,rem0,max_ge0,-sizeE,-cardE) //=. + + smt ml=0. + smt ml=0. + smt ml=0. + + elim H7=>// [[x h] [#]];rewrite -memE dom_restr /in_dom_with in_dom=> _ ->/=. + by rewrite oget_some. + apply H10=>//. + qed. + + local lemma Pr_ext &m: + Pr[Gext.distinguish()@&m : G1.bext /\ ReSample.count <= max_size] <= + max_size%r * ((2*max_size)%r / (2^c)%r). + proof. + fel 8 ReSample.count (fun x=> (2*max_size)%r / (2^c)%r) + max_size G1.bext + [ReSample.f : + (size G1.m <= max_size /\ size G1.mi <= max_size /\ ReSample.count < max_size); + ReSample.f1 : + (size G1.m < max_size /\ size G1.mi < max_size /\ ReSample.count < max_size) + ]=> //; 2:by auto. + + rewrite /felsum Bigreal.sumr_const count_predT size_range. + apply ler_wpmul2r;1:by apply eps_ge0. + by rewrite le_fromint;smt ml=0 w=max_ge0. + + proc;rcondt 2;1:by auto. + wp; rnd (mem (image snd (dom G1.m `|` dom G1.mi ))); skip=> /> &hr ? ? -> /= ? ?. + rewrite (Mu_mem.mu_mem + (image snd (dom G1.m{hr} `|` dom G1.mi{hr})) + cdistr (1%r/(2^c)%r))//. print DCapacity. + + by move=>x _;rewrite DCapacity.dunifin1E capacity_card. + rewrite ler_wpmul2r;1:by apply divr_ge0=>//;apply /c_ge0r. + rewrite imageU fcardU le_fromint. + move:(fcard_image_leq snd (dom G1.m{hr}))(fcard_image_leq snd (dom G1.mi{hr})). + by rewrite -!sizeE;smt w=fcard_ge0. + + rewrite/#. + + by move=>c1;proc;auto=> &hr [^H 2->]/#. + + by move=> b1 c1;proc;auto=> /#. + + proc;rcondt 2;1:by auto. + wp;rnd (mem (image snd (dom G1.m `|` dom G1.mi) `|` fset1 x));skip=> /> &hr ??-> /= ??. + rewrite (Mu_mem.mu_mem (image snd (dom G1.m{hr}`|`dom G1.mi{hr}) `|` fset1 x{hr}) cdistr (1%r/(2^c)%r))//. + + by move=>x _;rewrite DCapacity.dunifin1E capacity_card. + rewrite ler_wpmul2r;1:by apply divr_ge0=>//;apply /c_ge0r. + rewrite imageU !fcardU le_fromint fcard1. + move:(fcard_image_leq snd (dom G1.m{hr}))(fcard_image_leq snd (dom G1.mi{hr})). + by rewrite -!sizeE;smt w=fcard_ge0. + + rewrite/#. + + by move=>c1;proc;auto=> &hr [^H 2->]/#. + move=> b1 c1;proc;auto=> /#. + qed. + + axiom D_ll: + forall (F <: DFUNCTIONALITY{D}) (P <: DPRIMITIVE{D}), + islossless P.f => islossless P.fi => islossless F.f => islossless D(F, P).distinguish. + + lemma Real_G2 &m: + Pr[GReal(D).main() @ &m: res /\ C.c <= max_size] <= + Pr[Eager(G2(DRestr(D))).main2() @ &m: res] + + (max_size ^ 2)%r * mu dstate (pred1 witness) + + max_size%r * ((2*max_size)%r / (2^c)%r) + + max_size%r * ((2*max_size)%r / (2^c)%r). + proof. + apply (ler_trans _ _ _ (Real_G1 D D_ll &m)). + do !apply ler_add => //. + + cut ->: Pr[G1(DRestr(D)).main() @ &m : res] = Pr[Eager(G2(DRestr(D))).main1() @ &m : res]. + + by byequiv (G1_G2 (DRestr(D))). + by apply lerr_eq;byequiv (Eager_1_2 (G2(DRestr(D)))). + + by apply (Pr_G1col D D_ll &m). + apply (ler_trans Pr[Eager(G2(DRestr(D))).main1()@&m: G1.bext \/ inv_ext G1.m G1.mi FRO.m]). + + by byequiv (G1_G2 (DRestr(D)))=>//#. + apply (ler_trans Pr[Eager(G2(DRestr(D))).main2()@&m : G1.bext \/ inv_ext G1.m G1.mi FRO.m]). + + by apply lerr_eq;byequiv (Eager_1_2 (G2(DRestr(D)))). + apply (ler_trans _ _ _ _ (Pr_ext &m)). + byequiv EG2_Gext=>//#. + qed. + +end section EXT. + + + diff --git a/proof/smart_counter/Handle.eca b/proof/smart_counter/Handle.eca new file mode 100644 index 0000000..1694dc7 --- /dev/null +++ b/proof/smart_counter/Handle.eca @@ -0,0 +1,1866 @@ +pragma -oldip. pragma +implicits. +require import Core Int Real StdOrder Ring IntExtra. +require import List FSet NewFMap Utils Common SLCommon RndO. +require import DProd Dexcepted. +(*...*) import Capacity IntOrder DCapacity. + +require ConcreteF. + +clone import GenEager as ROhandle with + type from <- handle, + type to <- capacity, + op sampleto <- fun (_:int) => cdistr + proof sampleto_ll by apply DCapacity.dunifin_ll. + +print FRO. +module G1(D:DISTINGUISHER) = { + var m, mi : smap + var mh, mhi : hsmap + var chandle : int + var paths : (capacity, block list * block) fmap + var bext, bcol : bool + + module C = { + + proc f(p : block list): block = { + var sa, sa', sc; + var h, i <- 0; + sa <- b0; + while (i < size p ) { + if (mem (dom mh) (sa +^ nth witness p i, h)) { + (sa, h) <- oget mh.[(sa +^ nth witness p i, h)]; + } else { + sc <$ cdistr; + bcol <- bcol \/ hinv FRO.m sc <> None; + sa' <@ F.RO.get(take (i+1) p); + sa <- sa +^ nth witness p i; + mh.[(sa,h)] <- (sa', chandle); + mhi.[(sa',chandle)] <- (sa, h); + (sa,h) <- (sa',chandle); + FRO.m.[chandle] <- (sc,Unknown); + chandle <- chandle + 1; + } + i <- i + 1; + } + sa <- F.RO.get(p); + return sa; + } + } + + module S = { + + proc f(x : state): state = { + var p, v, y, y1, y2, hy2, hx2; + + if (!mem (dom m) x) { + if (mem (dom paths) x.`2) { + (p,v) <- oget paths.[x.`2]; + y1 <- F.RO.get (rcons p (v +^ x.`1)); + y2 <$ cdistr; + } else { + y1 <$ bdistr; + y2 <$ cdistr; + } + y <- (y1, y2); + bext <- bext \/ mem (rng FRO.m) (x.`2, Unknown); + if (!(mem (rng FRO.m) (x.`2, Known))) { + FRO.m.[chandle] <- (x.`2, Known); + chandle <- chandle + 1; + } + hx2 <- oget (hinvK FRO.m x.`2); + if (mem (dom mh) (x.`1, hx2) /\ in_dom_with FRO.m (oget mh.[(x.`1,hx2)]).`2 Unknown) { + hy2 <- (oget mh.[(x.`1, hx2)]).`2; + y <- (y.`1, (oget FRO.m.[hy2]).`1); + FRO.m.[hy2] <- (y.`2, Known); + m.[x] <- y; + mi.[y] <- x; + } else { + bcol <- bcol \/ hinv FRO.m y.`2 <> None; + hy2 <- chandle; + chandle <- chandle + 1; + FRO.m.[hy2] <- (y.`2, Known); + m.[x] <- y; + mh.[(x.`1, hx2)] <- (y.`1, hy2); + mi.[y] <- x; + mhi.[(y.`1, hy2)] <- (x.`1, hx2); + } + if (mem (dom paths) x.`2) { + (p,v) <- oget paths.[x.`2]; + paths.[y.`2] <- (rcons p (v +^ x.`1), y.`1); + } + } else { + y <- oget m.[x]; + } + return y; + } + + proc fi(x : state): state = { + var y, y1, y2, hx2, hy2; + + if (!mem (dom mi) x) { + bext <- bext \/ mem (rng FRO.m) (x.`2, Unknown); + if (!(mem (rng FRO.m) (x.`2, Known))) { + FRO.m.[chandle] <- (x.`2, Known); + chandle <- chandle + 1; + } + hx2 <- oget (hinvK FRO.m x.`2); + y1 <$ bdistr; + y2 <$ cdistr; + y <- (y1,y2); + if (mem (dom mhi) (x.`1,hx2) /\ + in_dom_with FRO.m (oget mhi.[(x.`1,hx2)]).`2 Unknown) { + (y1,hy2) <- oget mhi.[(x.`1, hx2)]; + y <- (y.`1, (oget FRO.m.[hy2]).`1); + FRO.m.[hy2] <- (y.`2, Known); + mi.[x] <- y; + m.[y] <- x; + } else { + bcol <- bcol \/ hinv FRO.m y.`2 <> None; + hy2 <- chandle; + chandle <- chandle + 1; + FRO.m.[hy2] <- (y.`2, Known); + mi.[x] <- y; + mhi.[(x.`1, hx2)] <- (y.`1, hy2); + m.[y] <- x; + mh.[(y.`1, hy2)] <- (x.`1, hx2); + } + } else { + y <- oget mi.[x]; + } + return y; + } + + } + + proc main(): bool = { + var b; + + F.RO.m <- map0; + m <- map0; + mi <- map0; + mh <- map0; + mhi <- map0; + bext <- false; + bcol <- false; + + (* the empty path is initially known by the adversary to lead to capacity 0^c *) + FRO.m <- map0.[0 <- (c0, Known)]; + paths <- map0.[c0 <- ([<:block>],b0)]; + chandle <- 1; + b <@ D(C,S).distinguish(); + return b; + } +}. + +(* -------------------------------------------------------------------------- *) +(** The state of CF contains only the map PF.m. + The state of G1 contains: + - the map hs that associates handles to flagged capacities; + - the map G1.m that represents the *public* view of map PF.m; + - the map G1.mh that represents PF.m with handle-based indirection; + - the map ro that represents the functionality; + - the map pi that returns *the* known path to a capacity if it exists. + The following invariants encode these facts, and some auxiliary + knowledge that can most likely be deduced but is useful in the proof. **) + +(** RELATIONAL: Map, Handle-Map and Handles are compatible **) +inductive m_mh (hs : handles) (m : smap) (mh : hsmap) = + | INV_m_mh of (forall xa xc ya yc, + m.[(xa,xc)] = Some (ya,yc) => + exists hx fx hy fy, + hs.[hx] = Some (xc,fx) + /\ hs.[hy] = Some (yc,fy) + /\ mh.[(xa,hx)] = Some (ya,hy)) + & (forall xa hx ya hy, + mh.[(xa,hx)] = Some (ya,hy) => + exists xc fx yc fy, + hs.[hx] = Some (xc,fx) + /\ hs.[hy] = Some (yc,fy) + /\ m.[(xa,xc)] = Some (ya,yc)). + +(* WELL-FORMEDNESS<2>: Handles, Map, Handle-Map and RO are compatible *) +inductive mh_spec (hs : handles) (Gm : smap) (mh : hsmap) (ro : (block list,block) fmap) = + | INV_mh of (forall xa hx ya hy, + mh.[(xa,hx)] = Some (ya,hy) => + exists xc fx yc fy, + hs.[hx] = Some (xc,fx) + /\ hs.[hy] = Some (yc,fy) + /\ if fy = Known + then Gm.[(xa,xc)] = Some (ya,yc) + /\ fx = Known + else exists p v, + ro.[rcons p (v +^ xa)] = Some ya + /\ build_hpath mh p = Some (v,hx)) + & (forall p bn b, + ro.[rcons p bn] = Some b <=> + exists v hx hy, + build_hpath mh p = Some (v,hx) + /\ mh.[(v +^ bn,hx)] = Some (b,hy)) + & (forall p v p' v' hx, + build_hpath mh p = Some (v,hx) + => build_hpath mh p' = Some (v',hx) + => p = p' /\ v = v'). + +(* WELL-FORMEDNESS<2>: Handles, Handle-Map and Paths are compatible *) +inductive pi_spec (hs : handles) (mh : hsmap) (pi : (capacity,block list * block) fmap) = + | INV_pi of (forall c p v, + pi.[c] = Some (p,v) <=> + exists h, + build_hpath mh p = Some(v,h) + /\ hs.[h] = Some (c,Known)). + +(* WELL-FORMEDNESS<2>: Handles are well-formed *) +inductive hs_spec hs ch = + | INV_hs of (huniq hs) + & (hs.[0] = Some (c0,Known)) + & (forall cf h, hs.[h] = Some cf => h < ch). + +(* Useless stuff *) +inductive inv_spec (m:('a,'b) fmap) mi = + | INV_inv of (forall x y, m.[x] = Some y <=> mi.[y] = Some x). + +(* Invariant: maybe we should split relational and non-relational parts? *) +inductive INV_CF_G1 (hs : handles) ch (Pm Pmi Gm Gmi : smap) + (mh mhi : hsmap) (ro : (block list,block) fmap) pi = + | HCF_G1 of (hs_spec hs ch) + & (inv_spec Gm Gmi) + & (inv_spec mh mhi) + & (m_mh hs Pm mh) + & (m_mh hs Pmi mhi) + & (incl Gm Pm) + & (incl Gmi Pmi) + & (mh_spec hs Gm mh ro) + & (pi_spec hs mh pi). + +(** Structural Projections **) +lemma m_mh_of_INV (ch : handle) + (mi1 m2 mi2 : smap) (mhi2 : hsmap) + (ro : (block list, block) fmap) + (pi : (capacity, block list * block) fmap) + hs m1 mh2: + INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi => + m_mh hs m1 mh2. +proof. by case. qed. + +lemma mi_mhi_of_INV (ch : handle) + (m1 m2 mi2 : smap) (mh2 : hsmap) + (ro : (block list, block) fmap) + (pi : (capacity, block list * block) fmap) + hs mi1 mhi2: + INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi => + m_mh hs mi1 mhi2. +proof. by case. qed. + +lemma incl_of_INV (hs : handles) (ch : handle) + (mi1 mi2 : smap) (mh2 mhi2: hsmap) + (ro : (block list, block) fmap) + (pi : (capacity, block list * block) fmap) + m1 m2: + INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi => + incl m2 m1. +proof. by case. qed. + +lemma incli_of_INV (hs : handles) (ch : handle) + (m1 m2 : smap) (mh2 mhi2: hsmap) + (ro : (block list, block) fmap) + (pi : (capacity, block list * block) fmap) + mi1 mi2: + INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi => + incl mi2 mi1. +proof. by case. qed. + +lemma mh_of_INV (ch : handle) + (m1 mi1 mi2 : smap) (mhi2 : hsmap) + (pi : (capacity, block list * block) fmap) + hs m2 mh2 ro: + INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi => + mh_spec hs m2 mh2 ro. +proof. by case. qed. + +lemma pi_of_INV (ch : handle) + (m1 m2 mi1 mi2: smap) (mhi2: hsmap) + (ro : (block list, block) fmap) + hs mh2 pi: + INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi => + pi_spec hs mh2 pi. +proof. by case. qed. + +lemma hs_of_INV (m1 m2 mi1 mi2 : smap) (mh2 mhi2 : hsmap) + (ro : (block list, block) fmap) + (pi : (capacity, block list * block) fmap) + hs ch: + INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi => + hs_spec hs ch. +proof. by case. qed. + +lemma inv_of_INV hs ch m1 mi1 m2 mi2 ro pi + mh2 mhi2: + INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi => + inv_spec mh2 mhi2. +proof. by case. qed. + +lemma invG_of_INV hs ch m1 mi1 mh2 mhi2 ro pi m2 mi2: + INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi => + inv_spec m2 mi2. +proof. by case. qed. + +(** Useful Lemmas **) +lemma ch_gt0 hs ch : hs_spec hs ch => 0 < ch. +proof. by case=> _ + Hlt -/Hlt. qed. + +lemma ch_neq0 hs ch : hs_spec hs ch => 0 <> ch. +proof. by move=> /ch_gt0/ltr_eqF. qed. + +lemma ch_notin_dom_hs hs ch: hs_spec hs ch => hs.[ch] = None. +proof. +by move=> [] _ _ dom_hs; case: {-1}(hs.[ch]) (eq_refl hs.[ch])=> [//|cf/dom_hs]. +qed. + +lemma Sch_notin_dom_hs hs ch: hs_spec hs ch => hs.[ch + 1] = None. +proof. +by move=> [] _ _ dom_hs; case: {-1}(hs.[ch + 1]) (eq_refl hs.[ch + 1])=> [//|cg/dom_hs/#]. +qed. + +lemma ch_notin_dom2_mh hs m mh xa ch: + m_mh hs m mh + => hs_spec hs ch + => mh.[(xa,ch)] = None. +proof. +move=> [] Hm_mh Hmh_m [] _ _ dom_hs. +case: {-1}(mh.[(xa,ch)]) (eq_refl mh.[(xa,ch)])=> [//=|[ya hy] /Hmh_m]. +by move=> [xc0 fx0 yc fy] [#] /dom_hs. +qed. + +lemma Sch_notin_dom2_mh hs m mh xa ch: + m_mh hs m mh + => hs_spec hs ch + => mh.[(xa,ch + 1)] = None. +proof. +move=> [] Hm_mh Hmh_m [] _ _ dom_hs. +case: {-1}(mh.[(xa,ch + 1)]) (eq_refl mh.[(xa,ch + 1)])=> [//=|[ya hy] /Hmh_m]. +by move=> [xc0 fx0 yc fy] [#] /dom_hs /#. +qed. + +lemma dom_hs_neq_ch hs ch hx xc fx: + hs_spec hs ch + => hs.[hx] = Some (xc,fx) + => hx <> ch. +proof. by move=> [] _ _ dom_hs /dom_hs /#. qed. + +lemma dom_hs_neq_Sch hs ch hx xc fx: + hs_spec hs ch + => hs.[hx] = Some(xc,fx) + => hx <> ch + 1. +proof. by move=> [] _ _ dom_hs /dom_hs /#. qed. + +lemma notin_m_notin_mh hs m mh xa xc hx fx: + m_mh hs m mh + => m.[(xa,xc)] = None + => hs.[hx] = Some (xc,fx) + => mh.[(xa,hx)] = None. +proof. +move=> [] _ Hmh_m m_xaxc hs_hx; case: {-1}(mh.[(xa,hx)]) (eq_refl mh.[(xa,hx)])=> [//|]. +by move=> [ya hy] /Hmh_m [xc0 fx0 yc0 fy0] [#]; rewrite hs_hx=> [#] <*>; rewrite m_xaxc. +qed. + +lemma notin_m_notin_Gm (m Gm : ('a,'b) fmap) x: + incl Gm m + => m.[x] = None + => Gm.[x] = None. +proof. by move=> Gm_leq_m; apply/contraLR=> ^ /Gm_leq_m ->. qed. + +lemma notin_hs_notin_dom2_mh hs m mh xa hx: + m_mh hs m mh + => hs.[hx] = None + => mh.[(xa,hx)] = None. +proof. +move=> [] _ Hmh_m hs_hx; case: {-1}(mh.[(xa,hx)]) (eq_refl mh.[(xa,hx)])=> [//|]. +by move=> [ya hy] /Hmh_m [xc fx yc fy] [#]; rewrite hs_hx. +qed. + +(** Preservation of m_mh **) +lemma m_mh_addh hs ch m mh xc fx: + hs_spec hs ch + => m_mh hs m mh + => m_mh hs.[ch <- (xc, fx)] m mh. +proof. +move=> ^Hhs [] Hhuniq hs_0 dom_hs [] Hm_mh Hmh_m; split. ++ move=> xa0 xc0 ya yc /Hm_mh [hx0 fx0 hy fy] [#] hs_hx0 hs_hy mh_xaxc0. + exists hx0 fx0 hy fy; rewrite !getP mh_xaxc0 hs_hx0 hs_hy /=. + move: hs_hx0=> /dom_hs/ltr_eqF -> /=. + by move: hs_hy=> /dom_hs/ltr_eqF -> /=. +move=> xa hx ya hy /Hmh_m [xc0 fx0 yc fy] [#] hs_hx hs_hy m_xaxc0. +exists xc0 fx0 yc fy; rewrite !getP m_xaxc0 hs_hx hs_hy. +move: hs_hx=> /dom_hs/ltr_eqF -> /=. +by move: hs_hy=> /dom_hs/ltr_eqF -> /=. +qed. + +lemma m_mh_updh fy0 hs m mh yc hy fy: + m_mh hs m mh + => hs.[hy] = Some (yc,fy0) + => m_mh hs.[hy <- (yc,fy)] m mh. +proof. +move=> Im_mh hs_hy; split. ++ move=> xa' xc' ya' yc'; have [] H _ /H {H}:= Im_mh. + move=> [hx' fx' hy' fy'] [#] hs_hx' hs_hy' mh_xahx'. + case: (hx' = hy); case: (hy' = hy)=> //= <*> => [|Hhy'|Hhx'|Hhx' Hhy']. + + by exists hy fy hy fy; rewrite !getP /= /#. + + by exists hy fy hy' fy'; rewrite !getP Hhy' /#. + + by exists hx' fx' hy fy; rewrite !getP Hhx' /#. + by exists hx' fx' hy' fy'; rewrite !getP Hhx' Hhy'. +move=> xa' hx' ya' hy'; have [] _ H /H {H}:= Im_mh. +move=> [xc' fx' yc' fy'] [#] hs_hx' hs_hy' m_xaxc'. +case: (hx' = hy); case: (hy' = hy)=> //= <*> => [|Hhy'|Hhx'|Hhx' Hhy']. ++ by exists yc fy yc fy; rewrite !getP /= /#. ++ by exists yc fy yc' fy'; rewrite !getP Hhy' /#. ++ by exists xc' fx' yc fy; rewrite !getP Hhx' /#. +by exists xc' fx' yc' fy'; rewrite !getP Hhx' Hhy'. +qed. + +lemma m_mh_addh_addm hs Pm mh hx xa xc hy ya yc f f': + m_mh hs Pm mh => + huniq hs => + hs.[hx] = Some (xc, f) => + hs.[hy] = None => + m_mh hs.[hy <- (yc,f')] Pm.[(xa,xc) <- (ya,yc)] mh.[(xa,hx) <- (ya,hy)]. +proof. +move=> [] Hm_mh Hmh_m Hhuniq hs_hx hs_hy. +split=> [xa0 xc0 ya0 yc0|xa0 hx0 ya0 hy0]; rewrite getP. ++ case: ((xa0,xc0) = (xa,xc))=> [[#] <<*> [#] <<*>|] /=. + + by exists hx f hy f'; rewrite !getP /= /#. + move=> xaxc0_neq_xaxc /Hm_mh [hx0 fx0 hy0 fy0] [#] hs_hx0 hs_hy0 mh_xahx0. + by exists hx0 fx0 hy0 fy0; rewrite !getP /#. +case: ((xa0,hx0) = (xa,hx))=> [[#] <*>> [#] <<*>|] /=. ++ by exists xc f yc f'; rewrite !getP /= /#. +rewrite andaE=> /negb_and xahx0_neq_xahx /Hmh_m [xc0 fx0 yc0 fy0] [#] hs_hx0 hs_hy0 Pm_xaxc0. +exists xc0 fx0 yc0 fy0; rewrite !getP; do !split=> [/#|/#|/=]. +move: xahx0_neq_xahx; case: (xa0 = xa)=> [/= <*>>|//=]; case: (xc0 = xc)=> [<*>>|//=]. +by move: hs_hx=> /(Hhuniq _ _ _ _ hs_hx0). +qed. + +lemma mi_mhi_addh_addmi (hs : handles) mi mhi hx xa xc hy ya yc fx fy: + m_mh hs mi mhi => + (forall f h, hs.[h] <> Some (yc,f)) => + hs.[hx] = Some (xc,fx) => + hs.[hy] = None => + m_mh hs.[hy <- (yc,fy)] mi.[(ya,yc) <- (xa,xc)] mhi.[(ya,hy) <- (xa,hx)]. +proof. +move=> [] Hm_mh Hmh_m yc_notin_rng1_hs hs_hx hs_hy; split. ++ move=> ya0 yc0 xa0 xc0; rewrite getP; case: ((ya0,yc0) = (ya,yc))=> [[#] <*>> [#] <*>>|]. + + by exists hy fy hx fx; rewrite !getP /= /#. + move=> yayc0_neq_yayc /Hm_mh [hy0 fy0 hx0 fx0] [#] hs_hy0 hs_hx0 mhi_yayc0. + by exists hy0 fy0 hx0 fx0; rewrite !getP /#. +move=> ya0 hy0 xa0 hx0; rewrite getP; case: ((ya0,hy0) = (ya,hy))=> [[#] <*>> [#] <<*>|]. ++ by exists yc fy xc fx; rewrite !getP //= /#. +rewrite /= andaE=> /negb_and yahy0_neq_yahy /Hmh_m [yc0 fy0 xc0 fx0] [#] hs_hy0 hs_hx0 mi_yayc0. +exists yc0 fy0 xc0 fx0; rewrite !getP; do !split=> [/#|/#|]. +move: yahy0_neq_yahy; case: (ya0 = ya)=> [<<*> //=|/#]; case: (yc0 = yc)=> [<*>> /=|//=]. +by move: hs_hy0; rewrite yc_notin_rng1_hs. +qed. + +(** Inversion **) +lemma inv_mh_inv_Pm hs Pm Pmi mh mhi: + m_mh hs Pm mh + => m_mh hs Pmi mhi + => inv_spec mh mhi + => inv_spec Pm Pmi. +proof. +move=> Hm_mh Hmi_mhi [] Hinv; split=>- [xa xc] [ya yc]; split. ++ have [] H _ /H {H} [hx fx hy fy] [#] hs_hx hs_hy /Hinv := Hm_mh. + have [] _ H /H {H} [? ? ? ?] [#] := Hmi_mhi. + by rewrite hs_hx hs_hy=> /= [#] <<*> [#] <<*>. +have [] H _ /H {H} [hy fy hx fx] [#] hs_hy hs_hx /Hinv := Hmi_mhi. +have [] _ H /H {H} [? ? ? ?] [#] := Hm_mh. +by rewrite hs_hx hs_hy=> /= [#] <<*> [#] <<*>. +qed. + +lemma inv_incl_none Pm Pmi Gm (x : 'a) Gmi (y : 'b): + inv_spec Pm Pmi + => inv_spec Gm Gmi + => incl Gm Pm + => incl Gmi Pmi + => Pm.[x] = Some y + => (Gm.[x] = None <=> Gmi.[y] = None). +proof. +move=> [] invP [] invG Gm_leq_Pm Gmi_leq_Pmi ^P_x; rewrite invP=> Pi_y. +split=> [G_x | Gi_y]. ++ case: {-1}(Gmi.[y]) (eq_refl Gmi.[y])=> [//|x']. + move=> ^Gmi_y; rewrite -Gmi_leq_Pmi 1:Gmi_y// Pi_y /= -negP=> <<*>. + by move: Gmi_y; rewrite -invG G_x. +case: {-1}(Gm.[x]) (eq_refl Gm.[x])=> [//|y']. +move=> ^Gm_y; rewrite -Gm_leq_Pm 1:Gm_y// P_x /= -negP=> <<*>. +by move: Gm_y; rewrite invG Gi_y. +qed. + +(** Preservation of hs_spec **) +lemma huniq_addh hs h c f: + huniq hs + => (forall f' h', hs.[h'] <> Some (c,f')) + => huniq hs.[h <- (c,f)]. +proof. +move=> Hhuniq c_notin_rng1_hs h1 h2 [c1 f1] [c2 f2]; rewrite !getP. +case: (h1 = h); case: (h2 = h)=> //= [Hh2 + [#]|+ Hh1 + [#]|_ _] - <*>. ++ by rewrite c_notin_rng1_hs. ++ by rewrite c_notin_rng1_hs. +exact/Hhuniq. +qed. + +lemma hs_addh hs ch xc fx: + hs_spec hs ch + => (forall f h, hs.[h] <> Some (xc,f)) + => hs_spec hs.[ch <- (xc,fx)] (ch + 1). +proof. +move=> ^Hhs [] Hhuniq hs_0 dom_hs xc_notin_rng1_hs; split. ++ move=> h1 h2 [c1 f1] [c2 f2]; rewrite !getP /=. + case: (h1 = ch); case: (h2 = ch)=> //= [+ + [#]|+ + + [#]|]=> <*>; + first 2 by rewrite xc_notin_rng1_hs. + by move=> _ _ hs_h1 /(Hhuniq _ _ _ _ hs_h1). ++ by rewrite getP (ch_neq0 _ Hhs). ++ move=> [c f] h; rewrite !getP; case: (h = ch)=> [<*> /#|_]. +by move=> /dom_hs /#. +qed. + +lemma hs_updh hs ch fx hx xc fx': + hs_spec hs ch + => 0 <> hx + => hs.[hx] = Some (xc,fx) + => hs_spec hs.[hx <- (xc,fx')] ch. +proof. +move=> ^Hhs [] Hhuniq hs_0 dom_hs hx_neq0 hs_hx; split. ++ by move=> h1 h2 [c1 f1] [c2 f2]; rewrite !getP /= /#. ++ by rewrite getP hx_neq0. +move=> cf h; rewrite getP; case: (h = hx)=> [<*> _|_ /dom_hs //]. +by move: hs_hx=> /dom_hs. +qed. + +(** Preservation of mh_spec **) +lemma mh_addh hs ch Gm mh ro xc fx: + hs_spec hs ch + => mh_spec hs Gm mh ro + => mh_spec hs.[ch <- (xc,fx)] Gm mh ro. +proof. +move=> [] _ _ dom_hs [] Hmh ? ?; split=> //. +move=> xa hx ya hy /Hmh [xc0 fx0 yc0 fy0] [#] hs_hx hs_hy Hite. +exists xc0 fx0 yc0 fy0; rewrite !getP Hite hs_hx hs_hy /=. +rewrite ltr_eqF /=; 1:by apply/(dom_hs _ hs_hx). +by rewrite ltr_eqF /=; 1:by apply/(dom_hs _ hs_hy). +qed. + +(** Preservation of inv_spec **) +lemma inv_addm (m : ('a,'b) fmap) mi x y: + inv_spec m mi + => m.[x] = None + => mi.[y] = None + => inv_spec m.[x <- y] mi.[y <- x]. +proof. +move=> [] Hinv m_x mi_y; split=> x' y'; rewrite !getP; split. ++ case: (x' = x)=> /= [[#] <*> //=|_ /Hinv ^ + ->]. + by move: mi_y; case: (y' = y)=> [[#] <*> ->|]. +case: (y' = y)=> /= [[#] <*> //=|_ /Hinv ^ + ->]. +by move: m_x; case: (x' = x)=> [[#] <*> ->|]. +qed. + +(** Preservation of incl **) +lemma incl_addm (m m' : ('a,'b) fmap) x y: + incl m m' + => incl m.[x <- y] m'.[x <- y]. +proof. by move=> m_leq_m' x'; rewrite !getP; case: (x' = x)=> [|_ /m_leq_m']. qed. + +(** getflag: retrieve the flag of a capacity **) +op getflag (hs : handles) xc = + omap snd (obind ("_.[_]" hs) (hinv hs xc)). + +lemma getflagP_none hs xc: + (getflag hs xc = None <=> forall f h, hs.[h] <> Some (xc,f)). +proof. by rewrite /getflag; case: (hinvP hs xc)=> [->|] //= /#. qed. + +lemma getflagP_some hs xc f: + huniq hs + => (getflag hs xc = Some f <=> mem (rng hs) (xc,f)). +proof. +move=> huniq_hs; split. ++ rewrite /getflag; case: (hinvP hs xc)=> [-> //|]. + rewrite in_rng; case: (hinv hs xc)=> //= h [f']. + rewrite oget_some=> ^ hs_h -> @/snd /= ->>. + by exists h. +rewrite in_rng=> -[h] hs_h. +move: (hinvP hs xc)=> [_ /(_ h f) //|]. +rewrite /getflag; case: (hinv hs xc)=> // h' _ [f']; rewrite oget_some. +move=> /(huniq_hs _ h _ (xc,f)) /(_ hs_h) /= ->>. +by rewrite hs_h. +qed. + +(** Stuff about paths **) +lemma build_hpath_prefix mh p b v h: + build_hpath mh (rcons p b) = Some (v,h) + <=> (exists v' h', build_hpath mh p = Some (v',h') /\ mh.[(v' +^ b,h')] = Some (v,h)). +proof. +rewrite build_hpathP; split=> [[/#|p' b' v' h' [#] + Hhpath Hmh]|[v' h'] [] Hhpath Hmh]. ++ by move=> ^/rconsIs <<- {b'} /rconssI <<- {p'}; exists v' h'. +exact/(Extend _ _ _ _ _ Hhpath Hmh). +qed. + +lemma build_hpath_up mh xa hx ya hy p za hz: + build_hpath mh p = Some (za,hz) + => mh.[(xa,hx)] = None + => build_hpath mh.[(xa,hx) <- (ya,hy)] p = Some (za,hz). +proof. +move=> + mh_xahx; elim/last_ind: p za hz=> [za hz|p b ih za hz]. ++ by rewrite /build_hpath. +move=> /build_hpath_prefix [b' h'] [#] /ih Hpath Hmh. +apply/build_hpathP/(@Extend _ _ _ _ p b b' h' _ Hpath _)=> //. +by rewrite getP /#. +qed. + +lemma build_hpath_down mh xa hx ya hy p v h: + (forall p v, build_hpath mh p <> Some (v,hx)) + => build_hpath mh.[(xa,hx) <- (ya,hy)] p = Some (v,h) + => build_hpath mh p = Some (v,h). +proof. +move=> no_path_to_hx. +elim/last_ind: p v h=> [v h /build_hpathP [<*>|/#] //=|p b ih]. +move=> v h /build_hpathP [/#|p' b' + + ^/rconsIs <<- /rconssI <<-]. +move=> v' h' /ih; rewrite getP. +case: ((v' +^ b,h') = (xa,hx))=> [/#|_ Hpath Hextend]. +exact/build_hpathP/(Extend _ _ _ _ _ Hpath Hextend). +qed. + +lemma known_path_uniq hs mh pi xc hx p xa p' xa': + pi_spec hs mh pi + => hs.[hx] = Some (xc,Known) + => build_hpath mh p = Some (xa, hx) + => build_hpath mh p' = Some (xa',hx) + => p = p' /\ xa = xa'. +proof. +move=> [] Ipi hs_hy path_p path_p'. +have /iffRL /(_ _):= Ipi xc p xa; first by exists hx. +have /iffRL /(_ _):= Ipi xc p' xa'; first by exists hx. +by move=> ->. +qed. + +(* Useful? Not sure... *) +lemma path_split hs ch m mh xc hx p xa: + hs_spec hs ch + => m_mh hs m mh + => hs.[hx] = Some (xc,Unknown) + => build_hpath mh p = Some (xa,hx) + => exists pk ya yc hy b za zc hz pu, + p = (rcons pk b) ++ pu + /\ build_hpath mh pk = Some (ya,hy) + /\ hs.[hy] = Some (yc,Known) + /\ mh.[(ya +^ b,hy)] = Some (za,hz) + /\ hs.[hz] = Some (zc,Unknown). +proof. +move=> Ihs [] _ Imh_m. +elim/last_ind: p hx xa xc=> [hx xa xc + /build_hpathP [_ <*>|/#]|]. ++ by have [] _ -> _ [#]:= Ihs. +move=> p b ih hx xa xc hs_hx /build_hpath_prefix. +move=> [ya hy] [#] path_p_hy ^mh_yabh' /Imh_m [yc fy ? ?] [#] hs_hy. +rewrite hs_hx=> /= [#] <<*> _; case: fy hs_hy. ++ move=> /ih /(_ ya _) // [pk ya' yc' hy' b' za zc hz pu] [#] <*>. + move=> Hpath hs_hy' mh_tahy' hs_hz. + by exists pk ya' yc' hy' b' za zc hz (rcons pu b); rewrite rcons_cat. +by move=> hs_hy; exists p ya yc hy b xa xc hx []; rewrite cats0. +qed. + +(** Path-specific lemmas **) +lemma lemma1 hs ch Pm Pmi Gm Gmi mh mhi ro pi x1 x2 y1 y2: + INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi + => x2 <> y2 + => Pm.[(x1,x2)] = None + => Gm.[(x1,x2)] = None + => (forall f h, hs.[h] <> Some (x2,f)) + => (forall f h, hs.[h] <> Some (y2,f)) + => INV_CF_G1 + hs.[ch <- (x2,Known)].[ch + 1 <- (y2,Known)] (ch + 2) + Pm.[(x1,x2) <- (y1,y2)] Pmi.[(y1,y2) <- (x1,x2)] + Gm.[(x1,x2) <- (y1,y2)] Gmi.[(y1,y2) <- (x1,x2)] + mh.[(x1,ch) <- (y1,ch + 1)] mhi.[(y1,ch + 1) <- (x1,ch)] + ro pi. +proof. +move=> HINV x2_neq_y2 Pm_x Gm_x x2_notin_rng1_hs y2_notin_rng1_hs; split. ++ rewrite (@addzA ch 1 1); apply/hs_addh. + + by move: HINV=> /hs_of_INV/hs_addh=> ->. + by move=> f h; rewrite getP; case: (h = ch)=> [/#|_]; exact/y2_notin_rng1_hs. ++ apply/inv_addm=> //; 1:by case: HINV. + case: {-1}(Gmi.[(y1,y2)]) (eq_refl Gmi.[(y1,y2)])=> [//|[xa xc]]. + + have /incli_of_INV @/incl + ^h - <- := HINV; 1: by rewrite h. + have /mi_mhi_of_INV [] H _ /H {H} [hx fx hy fy] [#] := HINV. + by rewrite y2_notin_rng1_hs. ++ apply/inv_addm; 1:by case: HINV. + + have ^ /m_mh_of_INV Hm_mh /hs_of_INV Hhs := HINV. + by apply/(ch_notin_dom2_mh _ _ Hm_mh Hhs). + have ^ /mi_mhi_of_INV Hmi_mhi /hs_of_INV Hhs := HINV. + by apply/(Sch_notin_dom2_mh _ _ Hmi_mhi Hhs). ++ apply/(@m_mh_addh_addm hs.[ch <- (x2,Known)] Pm mh ch x1 x2 (ch + 1) y1 y2 Known). + + by move: HINV=> ^/hs_of_INV Hhs /m_mh_of_INV; exact/(m_mh_addh Hhs). + + by move: HINV => /hs_of_INV /hs_addh /(_ x2 Known _) // []. + + by rewrite getP. + by rewrite getP gtr_eqF 1:/# /=; apply/Sch_notin_dom_hs; case: HINV. ++ apply/(@mi_mhi_addh_addmi hs.[ch <- (x2,Known)] Pmi mhi ch x1 x2 (ch + 1) y1 y2 Known Known). + + by move: HINV=> ^/hs_of_INV Hhs /mi_mhi_of_INV; exact/(m_mh_addh Hhs). + + move=> f h; rewrite getP; case: (h = ch)=> [_ //=|_ //=]; first by rewrite x2_neq_y2. + by rewrite y2_notin_rng1_hs. + + by rewrite getP. + by rewrite getP gtr_eqF 1:/# /=; apply/Sch_notin_dom_hs; case: HINV. ++ by apply/incl_addm; case: HINV. ++ by apply/incl_addm; case: HINV. ++ split. + + move=> xa hx ya hy; rewrite getP; case: ((xa,hx) = (x1,ch))=> [|]. + + by move=> [#] <*> [#] <*>; exists x2 Known y2 Known; rewrite !getP /#. + move=> xahx_neq_x1ch; have ^ /hs_of_INV Hhs /mh_of_INV [] Hmh _ _ /Hmh {Hmh} := HINV. + move=> [xc fx yc fy] [#] hs_hx hs_hy Hite. + exists xc fx yc fy; do 2?split; first 2 by smt (dom_hs_neq_ch dom_hs_neq_Sch getP). + case: fy Hite hs_hy=> /= [[p v] [Hro Hpath] hs_hy|[#] Gm_xaxc <*> hs_hy] /=; last first. + + by rewrite getP; case: ((xa,xc) = (x1,x2))=> [/#|]. + exists p v; rewrite Hro /=; apply/build_hpath_up=> //. + have /m_mh_of_INV /notin_hs_notin_dom2_mh H:= HINV. + exact/H/ch_notin_dom_hs/Hhs. + + move=> p xa b; have /mh_of_INV [] _ -> _ := HINV. + apply/exists_iff=> v /=; apply/exists_iff=> hx /=; apply/exists_iff=> hy /=. + have mh_x1ch: mh.[(x1,ch)] = None. + + by apply/(notin_hs_notin_dom2_mh hs Pm)/ch_notin_dom_hs; case: HINV. + have ch_notin_rng2_mh: forall a h a', mh.[(a,h)] <> Some (a',ch). + + move=> a h a'; rewrite -negP; have /m_mh_of_INV [] _ Hmh_m /Hmh_m {Hmh_m} := HINV. + by move=> [xc fx yc fy] [#] _; rewrite ch_notin_dom_hs; case: HINV. + split=> -[#]. + + move=> Hpath mh_vxahx; rewrite getP; case: ((v +^ xa,hx) = (x1,ch))=> [/#|_]. + by rewrite mh_vxahx //=; apply/build_hpath_up=> //=; rewrite mh_x1ch. + have H /H {H}:= build_hpath_down mh x1 ch y1 (ch + 1) p v hx _. + + move=> p0 v0; rewrite -negP=> /build_hpathP [<*>|]. + + by have /hs_of_INV [] _ + H - /H {H} := HINV. + by move=> p' b' v' h' <*>; rewrite ch_notin_rng2_mh. + move=> ^ /build_hpathP + -> /=; rewrite getP. + by case=> [<*>|/#]; move: HINV=> /hs_of_INV [] _ + H - /H {H} /#. + move=> p v p' v' hx. + have: (forall p v, build_hpath mh p <> Some (v,ch)). + + move=> p0 v0; rewrite -negP=> /build_hpathP [<*>|]. + + by have /hs_of_INV [] _ + H - /H {H} := HINV. + move=> p'0 b'0 v'0 h'0 <*> _; have /m_mh_of_INV [] _ H /H {H} := HINV. + by move=> [xc fx yc fy] [#] _; have /hs_of_INV [] _ _ H /H {H}:= HINV. + move=> ^ + /build_hpath_down H /H {H} - /build_hpath_down H + /H {H}. + by have /mh_of_INV [] _ _ /(_ p v p' v' hx) := HINV. +split=> c p v; have ^/hs_of_INV [] _ _ dom_hs /pi_of_INV [] -> := HINV. +apply/exists_iff=> h /=; split=> [#]. ++ move=> /(build_hpath_up mh x1 ch y1 (ch + 1) p v h) /(_ _). + + by apply/(notin_hs_notin_dom2_mh hs Pm)/ch_notin_dom_hs; case: HINV. + by move=> -> /= ^ /dom_hs; rewrite !getP /#. +have ch_notin_rng2_mh: forall a h a', mh.[(a,h)] <> Some (a',ch). ++ move=> a h' a'; rewrite -negP; have /m_mh_of_INV [] _ Hmh_m /Hmh_m {Hmh_m} := HINV. + by move=> [xc fx yc fy] [#] _; rewrite ch_notin_dom_hs; case: HINV. +have Sch_notin_rng2_mh: forall a h a', mh.[(a,h)] <> Some (a',ch + 1). ++ move=> a h' a'; rewrite -negP; have /m_mh_of_INV [] _ Hmh_m /Hmh_m {Hmh_m} := HINV. + by move=> [xc fx yc fy] [#] _; rewrite Sch_notin_dom_hs; case: HINV. +have H /H {H}:= build_hpath_down mh x1 ch y1 (ch + 1) p v h _. ++ move=> p0 v0; rewrite -negP=> /build_hpathP [<*>|]. + + by have /hs_of_INV [] _ + H - /H {H} := HINV. + by move=> p' b' v' h' <*>; rewrite ch_notin_rng2_mh. +move=> ^ /build_hpathP + -> /=; rewrite !getP. +by case=> [<*>|/#]; move: HINV=> /hs_of_INV [] _ + H - /H {H} /#. +qed. + +lemma lemma1' hs ch Pm Pmi Gm Gmi mh mhi ro pi x1 x2 y1 y2: + INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi + => x2 <> y2 + => Pmi.[(x1,x2)] = None + => Gmi.[(x1,x2)] = None + => (forall f h, hs.[h] <> Some (x2,f)) + => (forall f h, hs.[h] <> Some (y2,f)) + => INV_CF_G1 + hs.[ch <- (x2,Known)].[ch + 1 <- (y2,Known)] (ch + 2) + Pm.[(y1,y2) <- (x1,x2)] Pmi.[(x1,x2) <- (y1,y2)] + Gm.[(y1,y2) <- (x1,x2)] Gmi.[(x1,x2) <- (y1,y2)] + mh.[(y1,ch + 1) <- (x1,ch)] mhi.[(x1,ch) <- (y1,ch + 1)] + ro pi. +proof. +move=> HINV x2_neq_y2 Pm_x Gm_x xc_notin_rng1_hs yc_notin_rng1_hs; split. ++ rewrite (@addzA ch 1 1); apply/hs_addh. + + by move: HINV=> /hs_of_INV/hs_addh=> ->. + by move=> f h; rewrite getP; case: (h = ch)=> [/#|_]; exact/yc_notin_rng1_hs. ++ apply/inv_addm=> //; 1:by case: HINV. + case: {-1}(Gm.[(y1,y2)]) (eq_refl Gm.[(y1,y2)])=> [//|[xa xc]]. + + have /incl_of_INV + ^h - <- := HINV; 1: by rewrite h. + have /m_mh_of_INV [] H _ /H {H} [hx fx hy fy] [#] := HINV. + by rewrite yc_notin_rng1_hs. ++ apply/inv_addm; 1:by case: HINV. + + have ^ /m_mh_of_INV Hm_mh /hs_of_INV Hhs := HINV. + by apply/(Sch_notin_dom2_mh _ _ Hm_mh Hhs). + have ^ /mi_mhi_of_INV Hmi_mhi /hs_of_INV Hhs := HINV. + by apply/(ch_notin_dom2_mh _ _ Hmi_mhi Hhs). ++ apply/(@mi_mhi_addh_addmi hs.[ch <- (x2,Known)] Pm mh ch x1 x2 (ch + 1) y1 y2 Known Known). + + by move: HINV=> ^/hs_of_INV Hhs /m_mh_of_INV; exact/(m_mh_addh Hhs). + + by move=> f h; rewrite getP; case: (h = ch)=> [<*> /#|]; rewrite yc_notin_rng1_hs. + + by rewrite getP. + by rewrite getP gtr_eqF 1:/# /=; apply/Sch_notin_dom_hs; case: HINV. ++ apply/(@m_mh_addh_addm hs.[ch <- (x2,Known)] Pmi mhi ch x1 x2 (ch + 1) y1 y2 Known). + + by move: HINV=> ^/hs_of_INV Hhs /mi_mhi_of_INV; exact/(m_mh_addh Hhs). + + by have /hs_of_INV /hs_addh /(_ x2 Known _) // []:= HINV. + + by rewrite getP. + by rewrite getP gtr_eqF 1:/# /=; apply/Sch_notin_dom_hs; case: HINV. ++ by apply/incl_addm; case: HINV. ++ by apply/incl_addm; case: HINV. ++ split. + + move=> ya hy xa hx; rewrite getP; case: ((ya,hy) = (y1,ch + 1))=> [|]. + + by move=> [#] <*> [#] <*>; exists y2 Known x2 Known; rewrite !getP /#. + move=> yahy_neq_y1Sch; have ^ /hs_of_INV Hhs /mh_of_INV [] Hmh _ _ /Hmh {Hmh} := HINV. + move=> [yc fy xc fx] [#] hs_hy hs_hx Hite. + exists yc fy xc fx; do 2?split; first 2 by smt (dom_hs_neq_ch dom_hs_neq_Sch getP). + case: fx Hite hs_hx=> /= [[p v] [Hro Hpath] hs_hx|[#] Gm_yayc <*> hs_hx] /=; last first. + + by rewrite getP; case: ((ya,yc) = (y1,y2))=> [/#|]. + exists p v; rewrite Hro /=; apply/build_hpath_up=> //. + have /m_mh_of_INV /notin_hs_notin_dom2_mh H:= HINV. + exact/H/Sch_notin_dom_hs/Hhs. + + move=> p ya b; have /mh_of_INV [] _ -> _ := HINV. + apply/exists_iff=> v /=; apply/exists_iff=> hx /=; apply/exists_iff=> hy /=. + have mh_y1Sch: mh.[(y1,ch + 1)] = None. + + by apply/(notin_hs_notin_dom2_mh hs Pm)/Sch_notin_dom_hs; case: HINV. + have Sch_notin_rng2_mh: forall a h a', mh.[(a,h)] <> Some (a',ch + 1). + + move=> a h a'; rewrite -negP; have /m_mh_of_INV [] _ Hmh_m /Hmh_m {Hmh_m} := HINV. + by move=> [yc fy xc fx] [#] _; rewrite Sch_notin_dom_hs; case: HINV. + split=> -[#]. + + move=> Hpath mh_vxahx; rewrite getP; case: ((v +^ ya,hx) = (y1,ch + 1))=> [/#|_]. + by rewrite mh_vxahx //=; apply/build_hpath_up=> //=; rewrite mh_y1ch. + have H /H {H}:= build_hpath_down mh y1 (ch + 1) x1 ch p v hx _. + + move=> p0 v0; rewrite -negP=> /build_hpathP [<*>|]. + + by have /hs_of_INV [] _ + H - /H {H} /# := HINV. + by move=> p' b' v' h' <*>; rewrite Sch_notin_rng2_mh. + move=> ^ /build_hpathP + -> /=; rewrite getP. + by case=> [<*>|/#]; move: HINV=> /hs_of_INV [] _ + H - /H {H} /#. + move=> p v p' v' hx. + have: (forall p v, build_hpath mh p <> Some (v,ch + 1)). + + move=> p0 v0; rewrite -negP=> /build_hpathP [<*>|]. + + by have /hs_of_INV [] _ + H - /H {H} /# := HINV. + move=> p'0 b'0 v'0 h'0 <*> _; have /m_mh_of_INV [] _ H /H {H} := HINV. + by move=> [xc fx yc fy] [#] _; have /hs_of_INV [] _ _ H /H {H} /#:= HINV. + move=> ^ + /build_hpath_down H /H {H} - /build_hpath_down H + /H {H}. + by have /mh_of_INV [] _ _ /(_ p v p' v' hx) := HINV. +split=> c p v; have ^/hs_of_INV [] _ _ dom_hs /pi_of_INV [] -> := HINV. +apply/exists_iff=> h /=; split=> [#]. ++ move=> /(build_hpath_up mh y1 (ch + 1) x1 ch p v h) /(_ _). + + by apply/(notin_hs_notin_dom2_mh hs Pm)/Sch_notin_dom_hs; case: HINV. + by move=> -> /= ^ /dom_hs; rewrite !getP /#. +have ch_notin_rng2_mh: forall a h a', mh.[(a,h)] <> Some (a',ch). ++ move=> a h' a'; rewrite -negP; have /m_mh_of_INV [] _ Hmh_m /Hmh_m {Hmh_m} := HINV. + by move=> [xc fx yc fy] [#] _; rewrite ch_notin_dom_hs; case: HINV. +have Sch_notin_rng2_mh: forall a h a', mh.[(a,h)] <> Some (a',ch + 1). ++ move=> a h' a'; rewrite -negP; have /m_mh_of_INV [] _ Hmh_m /Hmh_m {Hmh_m} := HINV. + by move=> [xc fx yc fy] [#] _; rewrite Sch_notin_dom_hs; case: HINV. +have H /H {H}:= build_hpath_down mh y1 (ch + 1) x1 ch p v h _. ++ move=> p0 v0; rewrite -negP=> /build_hpathP [<*>|]. + + by have /hs_of_INV [] _ + H - /H {H} /# := HINV. + by move=> p' b' v' h' <*>; rewrite Sch_notin_rng2_mh. +move=> ^ /build_hpathP + -> /=; rewrite !getP. +by case=> [<*>|/#]; move: HINV=> /hs_of_INV [] _ + H - /H {H} /#. +qed. + +lemma lemma2 hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi x1 x2 y1 y2 hx: + INV_CF_G1 hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi + => PFm.[(x1,x2)] = None + => G1m.[(x1,x2)] = None + => pi.[x2] = None + => hs.[hx] = Some (x2,Known) + => (forall f h, hs.[h] <> Some (y2,f)) + => INV_CF_G1 hs.[ch <- (y2,Known)] (ch + 1) + PFm.[(x1,x2) <- (y1,y2)] PFmi.[(y1,y2) <- (x1,x2)] + G1m.[(x1,x2) <- (y1,y2)] G1mi.[(y1,y2) <- (x1,x2)] + G1mh.[(x1,hx) <- (y1,ch)] G1mhi.[(y1,ch) <- (x1,hx)] + ro pi. +proof. +move=> HINV PFm_x1x2 G1m_x1x2 pi_x2 hs_hx y2_notin_rng1_hs. +split. ++ by apply/hs_addh=> //=; case: HINV. ++ apply/inv_addm=> //; 1:by case: HINV. + case: {-1}(G1mi.[(y1,y2)]) (eq_refl G1mi.[(y1,y2)])=> [//|[xa xc]]. + + have /incli_of_INV @/incl + ^h - <- := HINV; 1: by rewrite h. + have /mi_mhi_of_INV [] H _ /H {H} [hx' fx' hy' fy'] [#] := HINV. + by rewrite y2_notin_rng1_hs. ++ apply/inv_addm; 1:by case: HINV. + + have ^ /m_mh_of_INV Hm_mh /hs_of_INV Hhs := HINV. + by apply/(notin_m_notin_mh _ _ _ _ Hm_mh PFm_x1x2 hs_hx). + have ^ /mi_mhi_of_INV Hmi_mhi /hs_of_INV Hhs := HINV. + by apply/(ch_notin_dom2_mh _ _ Hmi_mhi Hhs). ++ have ^ /hs_of_INV ^ Hhs [] Hhuniq _ _ /m_mh_of_INV := HINV. + move=> /m_mh_addh_addm /(_ hx x1 x2 ch y1 y2 Known Known Hhuniq hs_hx _) //. + exact/ch_notin_dom_hs. ++ have ^ /hs_of_INV ^ Hhs [] Hhuniq _ _ /mi_mhi_of_INV := HINV. + move=> /mi_mhi_addh_addmi /(_ hx x1 x2 ch y1 y2 Known Known _ hs_hx _) //. + exact/ch_notin_dom_hs. ++ by have /incl_of_INV/incl_addm ->:= HINV. ++ by have /incli_of_INV/incl_addm ->:= HINV. ++ split. + + move=> xa' hx' ya' hy'; rewrite getP; case: ((xa',hx') = (x1,hx))=> [[#] <*>> [#] <<*> /=|]. + + exists x2 Known y2 Known=> //=; rewrite !getP /=. + by have /hs_of_INV [] _ _ dom_hs /#:= HINV. + move=> xahx'_neq_x1hx; have /mh_of_INV [] Hmh _ _ /Hmh {Hmh} := HINV. + move=> [xc fx yc] [] /= [#] hs_hx' hs_hy'=> [[p v] [Hro Hpath]|<*> Gm_xa'xc]. + + exists xc fx yc Unknown=> /=; rewrite !getP hs_hx' hs_hy'. + rewrite (dom_hs_neq_ch hs xc fx _ hs_hx') /=; 1:by case: HINV. + rewrite (dom_hs_neq_ch hs yc Unknown _ hs_hy')/= ; 1:by case: HINV. + exists p v; rewrite Hro /=; apply/build_hpath_up/(notin_m_notin_mh _ _ _ _ _ PFm_x1x2 hs_hx). + + done. + by case: HINV. + exists xc Known yc Known=> //=; rewrite !getP; case: ((xa',xc) = (x1,x2))=> [/#|]. + rewrite Gm_xa'xc /= (dom_hs_neq_ch hs xc Known _ hs_hx') /=; 1:by case: HINV. + by rewrite (dom_hs_neq_ch hs yc Known _ hs_hy')/= ; 1:by case: HINV. + + move=> p xa b; have /mh_of_INV [] _ -> _ := HINV; split. + + move=> [v hi hf] [#] Hpath mh_vxahi; exists v hi hf. + rewrite getP; case: ((v +^ xa,hi) = (x1,hx))=> [[#] <*>|_]. + + move: mh_vxahi; have /m_mh_of_INV [] _ H /H {H}:= HINV. + by move=> [xc fx yc fy] [#]; rewrite hs_hx=> [#] <*>; rewrite PFm_x1x2. + rewrite mh_vxahi /=; apply/build_hpath_up=> //. + by apply/(notin_m_notin_mh _ _ _ _ _ PFm_x1x2 hs_hx); case: HINV. + move=> [v hi hf] [#]. + have no_path_to_hx: forall p0 v0, build_hpath G1mh p0 <> Some (v0,hx). + + have /pi_of_INV [] /(_ x2):= HINV; rewrite pi_x2 /=. + by move=> + p0 v0 - /(_ p0 v0) /negb_exists /(_ hx) /=; rewrite hs_hx. + have H /H {H} := build_hpath_down G1mh x1 hx y1 ch p v hi no_path_to_hx. + rewrite getP. case: ((v +^ xa,hi) = (x1,hx))=> [[#] <*>|_ Hpath Hextend]. + + by rewrite no_path_to_hx. + by exists v hi hf. + move=> p v p' v' h0. + have: forall p0 v0, build_hpath G1mh p0 <> Some (v0,hx). + + have /pi_of_INV [] /(_ x2):= HINV; rewrite pi_x2 /=. + by move=> + p0 v0 - /(_ p0 v0) /negb_exists /(_ hx) /=; rewrite hs_hx. + move=> ^ + /build_hpath_down H /H {H} - /build_hpath_down H + /H {H}. + by have /mh_of_INV [] _ _ /(_ p v p' v' h0):= HINV. +split=> c p v; have /pi_of_INV [] -> := HINV. +apply/exists_iff=> h /=; split=> [#]. ++ move=> /build_hpath_up /(_ x1 hx y1 ch _). + + by apply/(notin_m_notin_mh hs PFm x2 Known); case:HINV. + move=> -> /=; rewrite getP. + by have /hs_of_INV [] _ _ dom_hs ^ + /dom_hs /#:= HINV. +have no_path_to_hx: forall p0 v0, build_hpath G1mh p0 <> Some (v0,hx). ++ have /pi_of_INV [] /(_ x2):= HINV; rewrite pi_x2 /=. + by move=> + p0 v0 - /(_ p0 v0) /negb_exists /(_ hx) /=; rewrite hs_hx. +have H /H {H} := build_hpath_down G1mh x1 hx y1 ch p v h no_path_to_hx. +move=> ^ Hpath -> /=; rewrite getP; case: (h = ch)=> [<*> /= [#] <*>|//=]. +move: Hpath=> /build_hpathP [<*>|]. ++ by have /hs_of_INV [] _ + H - /H {H}:= HINV. +move=> p' b' v' h' <*> _; have /m_mh_of_INV [] _ H /H {H}:= HINV. +by move=> [xc fx yc fy] [#] _; have /hs_of_INV [] _ _ H /H {H}:= HINV. +qed. + +lemma lemma2' hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi x1 x2 y1 y2 hx: + INV_CF_G1 hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi + => PFmi.[(x1,x2)] = None + => G1mi.[(x1,x2)] = None + => hs.[hx] = Some (x2,Known) + => (forall f h, hs.[h] <> Some (y2,f)) + => INV_CF_G1 hs.[ch <- (y2,Known)] (ch + 1) + PFm.[(y1,y2) <- (x1,x2)] PFmi.[(x1,x2) <- (y1,y2)] + G1m.[(y1,y2) <- (x1,x2)] G1mi.[(x1,x2) <- (y1,y2)] + G1mh.[(y1,ch) <- (x1,hx)] G1mhi.[(x1,hx) <- (y1,ch)] + ro pi. +proof. +move=> HINV PFmi_x1x2 G1mi_x1x2 hs_hx y2_notin_rng1_hs. +split. ++ by apply/hs_addh=> //=; case: HINV. ++ apply/inv_addm=> //; 1:by case: HINV. + case: {-1}(G1m.[(y1,y2)]) (eq_refl G1m.[(y1,y2)])=> [//|[xa xc]]. + + have /incl_of_INV + ^h - <- := HINV; 1: by rewrite h. + have /m_mh_of_INV [] H _ /H {H} [hx' fx' hy' fy'] [#] := HINV. + by rewrite y2_notin_rng1_hs. ++ apply/inv_addm; 1:by case: HINV. + + have ^ /m_mh_of_INV Hm_mh /hs_of_INV Hhs := HINV. + by apply/(ch_notin_dom2_mh _ _ Hm_mh Hhs). + have ^ /mi_mhi_of_INV Hm_mh /hs_of_INV Hhs := HINV. + by apply/(notin_m_notin_mh _ _ _ _ Hm_mh PFmi_x1x2 hs_hx). ++ have ^ /hs_of_INV ^ Hhs [] Hhuniq _ _ /m_mh_of_INV := HINV. + move=> /mi_mhi_addh_addmi /(_ hx x1 x2 ch y1 y2 Known Known _ hs_hx _) //. + exact/ch_notin_dom_hs. ++ have ^ /hs_of_INV ^ Hhs [] Hhuniq _ _ /mi_mhi_of_INV := HINV. + move=> /m_mh_addh_addm /(_ hx x1 x2 ch y1 y2 Known Known _ hs_hx _) //. + exact/ch_notin_dom_hs. ++ by have /incl_of_INV/incl_addm ->:= HINV. ++ by have /incli_of_INV/incl_addm ->:= HINV. ++ split. + + move=> ya' hy' xa' hx'; rewrite getP; case: ((ya',hy') = (y1,ch))=> [[#] <*>> [#] <<*> /=|]. + + exists y2 Known x2 Known=> //=; rewrite !getP /=. + by have /hs_of_INV [] _ _ dom_hs /#:= HINV. + move=> yahy'_neq_y1ch; have /mh_of_INV [] Hmh _ _ /Hmh {Hmh} := HINV. + move=> [yc fy xc] [] /= [#] hs_hy' hs_hx'=> [[p v] [#] Hro Hpath|Gm_ya'yc <*>]. + + exists yc fy xc Unknown => /=; rewrite !getP hs_hx' hs_hy'. + rewrite (dom_hs_neq_ch hs yc fy _ hs_hy') /=; 1:by case: HINV. + rewrite (dom_hs_neq_ch hs xc Unknown _ hs_hx')/= ; 1:by case: HINV. + exists p v; rewrite Hro /=; apply/build_hpath_up=> //. + case: {-1}(G1mh.[(y1,ch)]) (eq_refl G1mh.[(y1,ch)])=> [//|[za zc]]. + have /m_mh_of_INV [] _ H /H {H} [? ? ? ?] [#]:= HINV. + by have /hs_of_INV [] _ _ H /H {H} := HINV. + exists yc Known xc Known=> //=; rewrite !getP; case: ((ya',yc) = (y1,y2))=> [/#|]. + rewrite Gm_ya'yc /= (dom_hs_neq_ch hs yc Known _ hs_hy') /=; 1:by case: HINV. + by rewrite (dom_hs_neq_ch hs xc Known _ hs_hx')/= ; 1:by case: HINV. + + move=> p ya b; have /mh_of_INV [] _ -> _ := HINV. + apply/exists_iff=> v /=; apply/exists_iff=> hx' /=; apply/exists_iff=> hy' /=. + split=> [#]. + + move=> /(@build_hpath_up _ y1 ch x1 hx) /(_ _). + + apply/(@notin_hs_notin_dom2_mh hs PFm)/(ch_notin_dom_hs); by case: HINV. + move=> -> /=; rewrite getP /=; case: (hx' = ch)=> <*> //. + have /m_mh_of_INV [] _ H /H {H} [xc fx yc fy] [#] := HINV. + by have /hs_of_INV [] _ _ H /H {H} := HINV. + have no_path_to_ch: forall p0 v0, build_hpath G1mh p0 <> Some (v0,ch). + + move=> p0 v0; elim/last_ind: p0. + + by have /hs_of_INV [] /# := HINV. + move=> p0 b0 _; rewrite build_hpath_prefix. + apply/negb_exists=> b' /=; apply/negb_exists=> h' /=; apply/negb_and=> /=; right. + rewrite -negP; have /mh_of_INV [] H _ _ /H {H} [? ? ? ?] [#] _ := HINV. + by have /hs_of_INV [] _ _ H /H {H} := HINV. + have H /H {H} := build_hpath_down G1mh y1 ch x1 hx p v hx' no_path_to_ch. + rewrite getP. case: ((v +^ ya,hx') = (y1,ch))=> [[#] <*>|_ Hpath Hextend //=]. + by rewrite no_path_to_ch. + move=> p v p' v' h0. + have: forall p0 v0, build_hpath G1mh p0 <> Some (v0,ch). + + move=> p0 v0; elim/last_ind: p0. + + by have /hs_of_INV [] /# := HINV. + move=> p0 b0 _; rewrite build_hpath_prefix. + apply/negb_exists=> b' /=; apply/negb_exists=> h' /=; apply/negb_and=> /=; right. + rewrite -negP; have /mh_of_INV [] H _ _ /H {H} [? ? ? ?] [#] _ := HINV. + by have /hs_of_INV [] _ _ H /H {H} := HINV. + move=> ^ + /build_hpath_down H /H {H} - /build_hpath_down H + /H {H}. + by have /mh_of_INV [] _ _ /(_ p v p' v' h0):= HINV. +split=> c p v; have /pi_of_INV [] -> := HINV. +apply/exists_iff=> h /=; split=> [#]. ++ move=> /build_hpath_up /(_ y1 ch x1 hx _). + + have ^ /m_mh_of_INV [] _ H /hs_of_INV [] _ _ H' := HINV. + case: {-1}(G1mh.[(y1,ch)]) (eq_refl (G1mh.[(y1,ch)]))=> [//|]. + by move=> [za zc] /H [? ? ? ?] [#] /H'. + move=> -> /=; rewrite getP. + by have /hs_of_INV [] _ _ dom_hs ^ + /dom_hs /#:= HINV. +have no_path_to_ch: forall p0 v0, build_hpath G1mh p0 <> Some (v0,ch). ++ move=> p0 v0; elim/last_ind: p0. + + by have /hs_of_INV [] /# := HINV. + move=> p0 b0 _; rewrite build_hpath_prefix. + apply/negb_exists=> b' /=; apply/negb_exists=> h' /=; apply/negb_and=> /=; right. + rewrite -negP; have /mh_of_INV [] H _ _ /H {H} [? ? ? ?] [#] _ := HINV. + by have /hs_of_INV [] _ _ H /H {H} := HINV. +have H /H {H} := build_hpath_down G1mh y1 ch x1 hx p v h no_path_to_ch. +move=> ^ Hpath -> /=; rewrite getP; case: (h = ch)=> [<*> /= [#] <*>|//=]. +move: Hpath=> /build_hpathP [<*>|]. ++ by have /hs_of_INV [] _ + H - /H {H}:= HINV. +move=> p' b' v' h' <*> _; have /m_mh_of_INV [] _ H /H {H}:= HINV. +by move=> [xc fx yc fy] [#] _; have /hs_of_INV [] _ _ H /H {H}:= HINV. +qed. + +lemma lemma3 hs ch Pm Pmi Gm Gmi mh mhi ro pi xa xc hx ya yc hy p b: + INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi + => Pm.[(xa,xc)] = Some (ya,yc) + => Gm.[(xa,xc)] = None + => mh.[(xa,hx)] = Some (ya,hy) + => hs.[hx] = Some (xc,Known) + => hs.[hy] = Some (yc,Unknown) + => pi.[xc] = Some (p,b) + => INV_CF_G1 hs.[hy <- (yc,Known)] ch + Pm Pmi + Gm.[(xa,xc) <- (ya,yc)] Gmi.[(ya,yc) <- (xa,xc)] + mh mhi + ro pi.[yc <- (rcons p (b +^ xa),ya)]. +proof. +move=> HINV Pm_xaxc Gm_xaxc mh_xahx hs_hx hs_hy pi_xc. +split. ++ have /hs_of_INV /hs_updh /(_ Unknown) H := HINV; apply/H=> {H} //. + by rewrite -negP=> <*>; move: hs_hy; have /hs_of_INV [] _ -> := HINV. ++ apply/inv_addm=> //; 1:by case: HINV. + case: {-1}(Gmi.[(ya,yc)]) (eq_refl Gmi.[(ya,yc)])=> [//|[xa' xc']]. + have /incli_of_INV + ^h - <- := HINV; 1:by rewrite h. + move: Pm_xaxc; have [] -> -> /= := inv_mh_inv_Pm hs Pm Pmi mh mhi _ _ _; first 3 by case: HINV. + rewrite andaE -negP=> [#] <<*>. + move: h; have /invG_of_INV [] <- := HINV. + by rewrite Gm_xaxc. ++ by case: HINV. ++ by apply/(m_mh_updh Unknown)=> //; case: HINV. ++ by apply/(m_mh_updh Unknown)=> //; case: HINV. ++ move=> [za zc]; rewrite getP; case: ((za,zc) = (xa,xc))=> // _. + by have /incl_of_INV H /H {H}:= HINV. ++ move: mh_xahx; have /inv_of_INV [] H /H {H}:= HINV. + have /mi_mhi_of_INV [] _ H /H {H} [xct fxt yct fyt] [#] := HINV. + rewrite hs_hx hs_hy=> /= [#] 2!<<- {xct fxt} [#] 2!<<- {yct fyt} Pmi_yayc. + move=> [za zc]; rewrite getP; case: ((za,zc) = (ya,yc))=> // _. + by have /incli_of_INV H /H {H}:= HINV. ++ split; last 2 by have /mh_of_INV [] _:= HINV. + move=> xa' hx' ya' hy'; case: ((xa',hx') = (xa,hx))=> [[#] <*>|]. + + rewrite mh_xahx=> /= [#] <<*>; rewrite !getP /=. + case: (hx = hy)=> [<*>|_]; first by move: hs_hx; rewrite hs_hy. + by exists xc Known yc Known; rewrite getP. + move=> Hxahx' mh_xahx'. + have ^path_to_hy: build_hpath mh (rcons p (b +^ xa)) = Some (ya,hy). + + apply/build_hpath_prefix; exists b hx. + rewrite xorwA xorwK xorwC xorw0 mh_xahx /=. + move: pi_xc; have /pi_of_INV [] -> [h] [#] := HINV. + by have /hs_of_INV [] H _ _ + /H {H} /(_ _ _ hs_hx _) := HINV. + have /mh_of_INV [] /(_ _ _ _ _ mh_xahx') + ro_def H /H {H} unique_path_to_hy := HINV. + move=> [xc' fx' yc' fy'] /= [#]. + case: (hy' = hy)=> [<*> hs_hx'|Hhy']. + + rewrite hs_hy=> /= [#] <<*> /= [p' b'] [#] ro_pbxa' path_hx'. + have:= unique_path_to_hy (rcons p' (b' +^ xa')) ya' _. + + by apply/build_hpath_prefix; exists b' hx'; rewrite xorwA xorwK xorwC xorw0. + move=> [#] ^/rconsIs + /rconssI - <<*>. + by move: mh_xahx' Hxahx' mh_xahx; have /inv_of_INV [] ^ + -> - -> -> /= -> := HINV. + rewrite (@getP _ _ _ hy') Hhy'=> /= hs_hx' ^ hs_hy' -> Hite. + exists xc' (if hx' = hy then Known else fx') yc' fy'. + rewrite (@getP Gm) (_: (xa',xc') <> (xa,xc)) /=. + + move: Hxahx'=> /=; case: (xa' = xa)=> [<*> /=|//]. + by apply/contra=> <*>; have /hs_of_INV [] + _ _ - /(_ _ _ _ _ hs_hx' hs_hx _) := HINV. + rewrite getP; case: (hx' = hy)=> /= [<*>|//]. + move: hs_hx'; rewrite hs_hy=> /= [#] <<*> /=. + by move: Hite=> /= [#]; case: fy' hs_hy'=> //= _ ->. +split=> c p' b'; rewrite !getP; case: (yc = c)=> [<<*> /=|yc_neq_c]; last first. ++ rewrite (@eq_sym c) yc_neq_c /=; have /pi_of_INV [] -> := HINV. + apply/exists_iff=> h /=; rewrite getP; case: (h = hy)=> [<*> /=|//=]. + by rewrite yc_neq_c hs_hy /=. +split=> [[#] <<*>|]. ++ exists hy; rewrite getP /=; apply/build_hpath_prefix. + exists b hx; rewrite xorwA xorwK xorwC xorw0 mh_xahx /=. + move: pi_xc; have /pi_of_INV [] -> [h] [#] + hs_h:= HINV. + by have /hs_of_INV [] + _ _ - /(_ _ _ _ _ hs_hx hs_h _) := HINV. +move=> [h]; rewrite getP; case: (h = hy)=> [<*> /=|]; last first. ++ by have /hs_of_INV [] H _ _ + [#] _ /H {H} /(_ _ _ hs_hy _) // <*> := HINV. +have /mh_of_INV [] _ _ /(_ p' b') H /H {H} /(_ (rcons p (b +^ xa)) ya _) //:= HINV. +apply/build_hpath_prefix; exists b hx; rewrite xorwA xorwK xorwC xorw0 mh_xahx /=. +move: pi_xc; have /pi_of_INV [] -> [h] [#] + hs_h:= HINV. +by have /hs_of_INV [] + _ _ - /(_ _ _ _ _ hs_hx hs_h _) := HINV. +qed. + +clone export ConcreteF as ConcreteF1. + +lemma m_mh_None hs0 PFm G1mh hx2 x2 k x1: + m_mh hs0 PFm G1mh => + hs0.[hx2] = Some (x2, k) => + PFm.[(x1, x2)] = None => + G1mh.[(x1,hx2)] = None. +proof. + move=> [] HP /(_ x1 hx2) + Hhx2;case (G1mh.[(x1, hx2)]) => //. + by move=> -[ya hy] /(_ ya hy) /= [] ????; rewrite Hhx2 => /= [#] <- _ _ ->. +qed. + +lemma build_hpath_None (G1mh:hsmap) p: + foldl (step_hpath G1mh) None p = None. +proof. by elim:p. qed. + +lemma build_hpath_upd_ch ha ch mh xa ya p v hx: + 0 <> ch => ha <> ch => (forall xa xb ha hb, mh.[(xa,ha)] = Some(xb, hb) => ha <> ch /\ hb <> ch) => + build_hpath mh.[(xa, ha) <- (ya, ch)] p = Some (v, hx) => + if hx = ch then + (exists p0 x, build_hpath mh p0 = Some (x, ha) /\ p = rcons p0 (x +^ xa) /\ v = ya) + else + build_hpath mh p = Some (v, hx). +proof. + move=> Hch0 Hha Hch. + elim/last_ind: p v hx=> /=. + + by move=> v hx;rewrite /build_hpath /= => -[!<<-];rewrite Hch0. + move=> p x Hrec v hx /build_hpath_prefix [v' h' [/Hrec{Hrec}]]. + rewrite getP /=;case (h' = ch) => [->> | ]. + + by rewrite (@eq_sym ch) Hha /= => _ /Hch. + case (v' +^ x = xa && h' = ha) => [[!<<-] /= ?? [!->>] /=| ]. + + by exists p v';rewrite xorwA xorwK xorwC xorw0. + case (hx = ch)=> [->> _ _ _ /Hch //|??? Hbu Hg]. + by rewrite build_hpath_prefix;exists v' h'. +qed. + +lemma build_hpath_up_None (G1mh:hsmap) bi1 bi2 bi p: + G1mh.[bi1] = None => + build_hpath G1mh p = Some bi => + build_hpath G1mh.[bi1 <- bi2] p = Some bi. +proof. + rewrite /build_hpath;move=> Hbi1. + elim: p (Some (b0,0)) => //= b p Hrec obi. + rewrite {2 4}/step_hpath /=;case: obi => //= [ | bi'];1:by apply Hrec. + rewrite oget_some. + rewrite getP. case ((bi'.`1 +^ b, bi'.`2) = bi1) => [-> | _];2:by apply Hrec. + by rewrite Hbi1 build_hpath_None. +qed. + +(* +lemma build_hpath_down_None h ch mh xa ha ya a p: + h <> ch => ha <> ch => + (forall ya, mh.[(ya,ch)] = None) => + build_hpath mh.[(xa,ha) <- (ya,ch)] p = Some (a,h) => + build_hpath mh p = Some (a,h). +proof. + move=> Hh Hha Hmh;rewrite /build_hpath;move: (Some (b0, 0)). + elim: p => //= b p Hrec [ | bi] /=;rewrite {2 4}/step_hpath /= ?build_hpath_None //. + rewrite oget_some getP;case ((bi.`1 +^ b, bi.`2) = (xa, ha)) => _;2:by apply Hrec. + move=> {Hrec};case: p=> /= [[_ ->>]| b' p];1: by move:Hh. + by rewrite {2}/step_hpath /= oget_some /= getP_neq /= ?Hha // Hmh build_hpath_None. +qed. +*) + +lemma build_hpath_upd_ch_iff ha ch mh xa ya p v hx: + mh.[(xa,ha)] = None => + 0 <> ch => ha <> ch => (forall xa xb ha hb, mh.[(xa,ha)] = Some(xb, hb) => ha <> ch /\ hb <> ch) => + build_hpath mh.[(xa, ha) <- (ya, ch)] p = Some (v, hx) <=> + if hx = ch then + (exists p0 x, build_hpath mh p0 = Some (x, ha) /\ p = rcons p0 (x +^ xa) /\ v = ya) + else + build_hpath mh p = Some (v, hx). +proof. + move=> Ha Hch0 Hha Hch;split;1: by apply build_hpath_upd_ch. + case (hx = ch);2: by move=> ?;apply build_hpath_up_None. + move=> ->> [p0 x [? [!->>]]]. + rewrite build_hpath_prefix;exists x ha. + by rewrite xorwA xorwK xorwC xorw0 getP_eq /=;apply build_hpath_up_None. +qed. + + + + +(* we should do a lemma to have the equivalence *) + +equiv eq_fi (D <: DISTINGUISHER {PF, RO, G1}): PF.fi ~ G1(D).S.fi: + !G1.bcol{2} + /\ !G1.bext{2} + /\ ={x} + /\ INV_CF_G1 FRO.m{2} G1.chandle{2} + PF.m{1} PF.mi{1} + G1.m{2} G1.mi{2} + G1.mh{2} G1.mhi{2} + F.RO.m{2} G1.paths{2} + ==> !G1.bcol{2} + => !G1.bext{2} + => ={res} + /\ INV_CF_G1 FRO.m{2} G1.chandle{2} + PF.m{1} PF.mi{1} + G1.m{2} G1.mi{2} + G1.mh{2} G1.mhi{2} + F.RO.m{2} G1.paths{2}. +proof. +exists* FRO.m{2}, G1.chandle{2}, PF.m{1}, PF.mi{1}, + G1.m{2}, G1.mi{2}, G1.mh{2}, G1.mhi{2}, + F.RO.m{2}, G1.paths{2}, x{2}. +elim* => hs ch Pm Pmi Gm Gmi mh mhi ro pi [xa xc]. +case @[ambient]: + {-1}(INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi) + (eq_refl (INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi)); last first. ++ by move=> inv0; exfalso=> ? ? [#] <<*>; rewrite inv0. +move=> /eqT inv0; proc. +case @[ambient]: {-1}(Pmi.[(xa,xc)]) (eq_refl Pmi.[(xa,xc)])=> [Pmi_xaxc|[ya yc] Pmi_xaxc]. ++ have /incli_of_INV /(_ (xa,xc)) := inv0; rewrite Pmi_xaxc /=. + case: {-1}(Gmi.[(xa,xc)]) (eq_refl Gmi.[(xa,xc)])=> //= Gmi_xaxc. + rcondt{1} 1; 1:by auto=> &hr [#] <<*>; rewrite in_dom Pmi_xaxc. + rcondt{2} 1; 1:by auto=> &hr [#] <<*>; rewrite in_dom Gmi_xaxc. + case @[ambient]: {-1}(getflag hs xc) (eq_refl (getflag hs xc)). + + move=> /getflagP_none xc_notin_rng1_hs. + rcondt{2} 2. + + auto=> &hr [#] <<*> _ _ _; rewrite in_rng negb_exists=> h /=. + by rewrite xc_notin_rng1_hs. + rcondf{2} 8. + + auto=> &hr [#] !<<- _ _ ->> _ /= _ _ _ _. + rewrite negb_and in_dom; left. + rewrite (@huniq_hinvK_h ch) 3:oget_some /=. + + by apply/huniq_addh=> //; have /hs_of_INV [] := inv0. + + by rewrite getP. + apply/(@notin_m_notin_mh hs.[ch <- (xc,Known)] Pmi _ _ xc ch Known)=> //. + + by apply/m_mh_addh=> //; case: inv0. + by rewrite getP. + auto=> ? ? [#] !<<- -> -> ->> _ /= ya -> /= yc -> /=. + case: (hinvP (hs.[ch <- (xc,Known)]) yc)=> [_|-> //] yc_notin_rng1_hs_addh _ _. + rewrite getP /= oget_some /= -addzA /=. + rewrite(@huniq_hinvK_h ch) 3:oget_some /=. + + by apply/huniq_addh=> //; have /hs_of_INV [] := inv0. + + by rewrite getP. + apply/(@lemma1' hs ch Pm Pmi Gm Gmi mh mhi ro pi xa xc ya yc inv0 _ Pmi_xaxc Gmi_xaxc)=> //. + + rewrite -negP=> <*>; move: yc_notin_rng1_hs_addh => /=. + apply/negb_forall=> /=; exists ch; apply/negb_forall=> /=; exists Known. + by rewrite getP. + + move=> f h; move: (yc_notin_rng1_hs_addh h f); rewrite getP. + case: (h = ch)=> <*> //= _; rewrite -negP. + by have /hs_of_INV [] _ _ H /H {H} := inv0. + have /hs_of_INV [] Hhuniq _ _ [] /(getflagP_some _ _ _ Hhuniq):= inv0. + + move=> x2_is_U; conseq (_: _ ==> G1.bext{2})=> //. + by auto=> ? ? [#] !<<- _ -> ->> _ /=; rewrite x2_is_U. + move=> ^x2_is_K; rewrite in_rng=> -[hx2] hs_hx2. + rcondf{2} 2; 1:by auto=> &hr [#] <*> /=; rewrite x2_is_K. + rcondf{2} 6. + + auto=> &hr [#] !<<- _ _ ->> _. + rewrite (@huniq_hinvK_h hx2) // oget_some /= => _ _ _ _. + rewrite negb_and in_dom /=; left. + by apply/(@notin_m_notin_mh hs Pmi _ _ xc _ Known)=> //; case: inv0. + auto=> ? ? [#] !<<- -> -> ->> _. + rewrite (@huniq_hinvK_h hx2) // oget_some /= => y1 -> /= y2 -> /=. + case: (hinvP hs y2)=> [_ y2_notin_rng1_hs _ _|/#]. + rewrite getP /= oget_some /=. + by apply/lemma2'=> // f h; exact/y2_notin_rng1_hs. +rcondf{1} 1; 1:by auto=> &hr [#] <<*>; rewrite in_dom Pmi_xaxc. +case @[ambient]: {-1}(Gmi.[(xa,xc)]) (eq_refl Gmi.[(xa,xc)])=> [|[ya' yc'] ^] Gmi_xaxc. ++ rcondt{2} 1; 1:by auto=> &hr [#] <<*>; rewrite in_dom Gmi_xaxc. + conseq (_: _ ==> G1.bext{2})=> //. + auto=> &1 &2 [#] !<<- _ -> ->> _ />. + rewrite !in_rng; have ->: exists hx, hs.[hx] = Some (xc,Unknown). + + move: Pmi_xaxc; have /mi_mhi_of_INV [] H _ /H {H} := inv0. + move=> [hx fx hy fy] [#] hs_hx hs_hy. + have ^/inv_of_INV [] <- /mh_of_INV [] H _ _ /H {H} := inv0. + move=> [? ? ? ?] [#]; rewrite hs_hx hs_hy=> /= [#] <<*> [#] <<*>. + case: fx hs_hx=> hs_hx /= => [_|[#]]; first by exists hx. + by have /invG_of_INV [] -> := inv0; rewrite Gmi_xaxc. print Block.DBlock. + smt (@Block.DBlock @Capacity.DCapacity). +have /incli_of_INV <- := inv0; 1:by rewrite Gmi_xaxc. +rewrite Pmi_xaxc=> /= [#] <<*>. +rcondf{2} 1; 1:by auto=> &hr [#] <<*>; rewrite in_dom Gmi_xaxc. +by auto=> &1 &2 /#. +qed. + +lemma head_nth (w:'a) l : head w l = nth w l 0. +proof. by case l. qed. + +lemma drop_add (n1 n2:int) (l:'a list) : 0 <= n1 => 0 <= n2 => drop (n1 + n2) l = drop n2 (drop n1 l). +proof. + move=> Hn1 Hn2;elim: n1 Hn1 l => /= [ | n1 Hn1 Hrec] l;1: by rewrite drop0. + by case: l => //= a l /#. +qed. + +lemma behead_drop (l:'a list) : behead l = drop 1 l. +proof. by case l => //= l;rewrite drop0. qed. + +lemma incl_upd_nin (m1 m2:('a,'b)fmap) x y: incl m1 m2 => !mem (dom m2) x => incl m1 m2.[x <- y]. +proof. + move=> Hincl Hdom w ^/Hincl <- => Hw. + rewrite getP_neq // -negP => ->>. + by move: Hdom;rewrite in_dom. +qed. + + + +equiv PFf_Cf (D<:DISTINGUISHER): SqueezelessSponge(PF).f ~ G1(D).C.f : + ! (G1.bcol{2} \/ G1.bext{2}) /\ + ={p} /\ p{1} <> [] /\ + INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} ==> + ! (G1.bcol{2} \/ G1.bext{2}) => + ={res} /\ INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2}. +proof. + proc; seq 2 4: + ((!(G1.bcol{2} \/ G1.bext{2}) => + (INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} /\ + F.RO.m.[p]{2} = Some sa{1})));last first. + + case : (! (G1.bcol{2} \/ G1.bext{2})); + 2: by conseq (_:_ ==> true)=> //; inline *;auto;rewrite Block.DBlock.dunifin_ll. + inline *; rcondf{2} 3. + + by move=> &m;auto=> &hr [#] H /H[_ H1] ??;rewrite in_dom H1. + by auto=> /> &m1 &m2;rewrite Block.DBlock.dunifin_ll /= => H /H [-> ->];rewrite oget_some. + while ( + p{1} = (drop i p){2} /\ (0 <= i <= size p){2} /\ + (!(G1.bcol{2} \/ G1.bext{2}) => + (INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} /\ + ={sa} /\ + (exists f, FRO.m.[h]{2} = Some (sc{1}, f)) /\ + (build_hpath G1.mh (take i p) = Some (sa,h)){2} /\ + if i{2} = 0 then (sa,h){2} = (b0, 0) + else F.RO.m.[take i p]{2} = Some sa{1})));last first. + + auto=> &m1 &m2 [#] -> -> Hp ^ Hinv -> /=;rewrite drop0 size_ge0 /=;split. + + split;[split|];1: by exists Known;case Hinv => -[] _ ->. + + by rewrite take0. + by case (p{m2}) => //=;smt w=size_ge0. + move=> ????? ????? ?? iR ? ->> ?[#] _ ?? H /H{H} [#] -> ->> _ ?. + have -> : iR = size p{m2} by smt (). + have -> /= : size p{m2} <> 0 by smt (size_ge0). + by rewrite take_size. + inline *;sp 1 0;wp=> /=. + conseq (_: _ ==> (! (G1.bcol{2} \/ G1.bext{2}) => + INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} + G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} /\ + (oget PF.m{1}.[x{1}]).`1 = sa{2} /\ + (exists (f : flag), FRO.m{2}.[h{2}] = Some ((oget PF.m{1}.[x{1}]).`2, f)) /\ + (build_hpath G1.mh (take (i + 1) p) = Some (sa,h)){2} /\ + if i{2} + 1 = 0 then sa{2} = b0 && h{2} = 0 + else F.RO.m{2}.[take (i{2} + 1) p{2}] = Some (oget PF.m{1}.[x{1}]).`1)). + + move=> &m1 &m2 [#] 2!->> ?? H ?? ?????????? H'. + rewrite behead_drop -drop_add //=;split=>[/#|]. + by have := size_drop (i{m2} + 1) p{m2};case (drop (i{m2} + 1) p{m2}) => //= [/#| ];smt w=size_ge0. + case ((G1.bcol{2} \/ G1.bext{2})). + + wp;conseq (_: _ ==> (G1.bcol{2} \/ G1.bext{2}))=> //. + by if{1};if{2};auto;2:(swap{2} 4 -3;auto); smt w=(Block.DBlock.dunifin_ll DCapacity.dunifin_ll). + conseq (_: (x{1} = (sa{1} +^ head witness p{1}, sc{1}) /\ + (p{1} = drop i{2} p{2} /\ + 0 <= i{2} <= size p{2} /\ + (INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} + G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} /\ + ={sa} /\ + (exists (f : flag), FRO.m{2}.[h{2}] = Some (sc{1}, f)) /\ + (build_hpath G1.mh (take i p) = Some (sa,h)){2} /\ + if i{2} = 0 then (sa{2}, h{2}) = (b0, 0) + else F.RO.m{2}.[take i{2} p{2}] = Some sa{1})) /\ + p{1} <> [] /\ i{2} < size p{2}) /\ + ! (G1.bcol{2} \/ G1.bext{2}) /\ + (mem (dom PF.m) x){1} = (mem (dom G1.mh) (sa +^ nth witness p i, h)){2} ==> _). + + move=> &m1 &m2 [#] 2!->> ?? H ?? ^ /H [#] /= Hinv ->> Hf -> -> ? /= />. + case: Hf=> f Hm; rewrite head_nth nth_drop // addz0 !in_dom. + pose X := sa{m2} +^ nth witness p{m2} i{m2}. + case (Hinv)=> -[Hu _ _] _ _ [] /(_ X sc{m1}) Hpf ^ HG1 /(_ X h{m2}) Hmh _ _ _ _ _. + case: {-1}(PF.m{m1}.[(X,sc{m1})]) (eq_refl (PF.m{m1}.[(X,sc{m1})])) Hpf Hmh. + + case (G1.mh{m2}.[(X, h{m2})]) => //= -[ya hy] Hpf. + by rewrite -negP => /(_ ya hy) [] ????[#];rewrite Hm /= => -[<-];rewrite Hpf. + move=> [ya yc] Hpf/(_ ya yc) [hx fx hy fy [#]] Hhx Hhy ^ /HG1 [xc fx0 yc0 fy0]. + rewrite Hhx => /= [#] 2!<<-;rewrite Hhy Hpf /= => -[] !->> _. + by have /= <<- -> := Hu _ _ _ _ Hm Hhx. + if{1};[rcondf{2} 1| rcondt{2} 1];1,3:(by auto;smt ());last first. + + auto => /> /= &m1 &m2 ?? [] Hhs Hinv Hinvi Hmmh Hmmhi Hincl Hincli Hmh Hpi f. + rewrite head_nth nth_drop // addz0 => Heq Hbu ????. + rewrite !in_dom. + have -> /= : i{m2} + 1 <> 0 by smt (). + pose sa' := sa{m2} +^ nth witness p{m2} i{m2}. + case (Hmmh) => /(_ sa' sc{m1});case (PF.m{m1}.[(sa', sc{m1})])=> //= -[ya yc] /(_ ya yc) /=. + move=> [hx fx hy fy]; case (Hhs) => Hu _ _ [#] Heq'. + have /= <<- /= Hhy ^? ->:= Hu _ _ _ _ Heq Heq'. + rewrite !oget_some /= => _;split;1: by exists fy. + rewrite (@take_nth witness) 1://. + case (Hmh) => _ -> _;rewrite build_hpath_prefix Hbu /#. + rcondt{2} 5. + + move=> &m;auto=> &hr /> ?? Hinv f. + rewrite head_nth nth_drop // addz0; pose sa' := sa{hr} +^ nth witness p{hr} i{hr}. + move=> ?Hbu????->Hmem ????. + case (Hinv) => ??????? [] H1 H2 H3 ?. + rewrite (@take_nth witness) 1:// -negP in_dom. + pose p' := (take i{hr} p{hr}); pose w:= (nth witness p{hr} i{hr}). + case {-1}(F.RO.m{hr}.[rcons p' w]) (eq_refl (F.RO.m{hr}.[rcons p' w]))=> //. + move=> ? /H2 [???];rewrite Hbu => -[] [!<<-] HG1. + by move: Hmem;rewrite in_dom HG1. + swap{2} 4 -3;auto => &m1 &m2 [#] 2!->?? [] Hhs Hinv Hinvi Hmmh Hmmhi Hincl Hincli Hmh Hpi -> /=. + move=> Hsc Hpa Hif Hdrop Hlt Hbad. + rewrite head_nth nth_drop // addz0; pose sa' := sa{m2} +^ nth witness p{m2} i{m2}. + move=> Heq Hdom y1L-> /= y2L-> /=. + have -> /= : i{m2} + 1 <> 0 by smt (). + rewrite !getP_eq !oget_some /=. + pose p' := (take (i{m2} + 1) p{m2});rewrite/==> [#] ? /=. + split;last first. + + split;1: by exists Unknown. + rewrite /p' (@take_nth witness) 1:// build_hpath_prefix. + exists sa{m2} h{m2}. + rewrite /sa' getP_eq /=;apply build_hpath_up => //. + by move: Hdom;rewrite Heq /sa' in_dom. + have Hy1L := ch_notin_dom2_mh _ _ _ y1L G1.chandle{m2} Hmmhi Hhs. + have := hinvP FRO.m{m2} y2L;rewrite /= => Hy2L. + have g1_sa' : G1.mh{m2}.[(sa', h{m2})] = None by move: Hdom;rewrite Heq in_dom. + case :Hsc => f Hsc; have Hh := dom_hs_neq_ch _ _ _ _ _ Hhs Hsc. + have Hch : FRO.m{m2}.[G1.chandle{m2}] = None. + + case Hhs => _ _ H. + by case {-1}(FRO.m{m2}.[G1.chandle{m2}]) (eq_refl (FRO.m{m2}.[G1.chandle{m2}])) => // ? /H. + have Hy2_mi: ! mem (dom PF.mi{m1}) (y1L, y2L). + + rewrite in_dom;case {-1}( PF.mi{m1}.[(y1L, y2L)]) (eq_refl (PF.mi{m1}.[(y1L, y2L)])) => //. + by move=> [] ??;case Hmmhi=> H _ /H [] ????/#. + have ch_0 := ch_neq0 _ _ Hhs. + have ch_None : + forall xa xb ha hb, G1.mh{m2}.[(xa,ha)] = Some(xb, hb) => + ha <> G1.chandle{m2} /\ hb <> G1.chandle{m2}. + + move=> xa xb ha hb;case Hmmh=> _ H /H [xc fx yc fy [#]]. + by move=> /(dom_hs_neq_ch _ _ _ _ _ Hhs) -> /(dom_hs_neq_ch _ _ _ _ _ Hhs). + split=> //. + + by apply hs_addh => // ??/#. + + by apply inv_addm. + + by apply (m_mh_addh_addm f) => //;case Hhs. + + by apply (mi_mhi_addh_addmi f)=> // ??/#. + + by apply incl_upd_nin. + + by apply incl_upd_nin. + + case (Hmh)=> H1 H2 H3;split. + + move=> xa hx ya hy;rewrite getP;case((xa, hx) = (sa', h{m2}))=> [[2!->>] [2!<<-] | Hdiff]. + + exists sc{m1} f y2L Unknown. + rewrite getP_eq getP_neq 1:eq_sym //= Hsc /=. + exists (take i{m2} p{m2}) sa{m2}. + rewrite /p' (@take_nth witness) 1:// /sa' xorwA xorwK xorwC xorw0 getP_eq /=. + by apply build_hpath_up_None. + move=> /H1 [xc fx yc fy] [#] Hhx Hhy Hfy; exists xc fx yc fy. + rewrite !getP_neq. + + by rewrite eq_sym;apply (dom_hs_neq_ch _ _ _ Hhs Hhx). + + by rewrite eq_sym;apply (dom_hs_neq_ch _ _ _ Hhs Hhy). + rewrite Hhx Hhy /=;case: fy Hhy Hfy => //= Hhy [p v [Hro Hpath]]. + exists p v;rewrite getP_neq 1:-negP 1:/p' 1:(@take_nth witness) 1://. + + move => ^ /rconssI <<-;move: Hpath;rewrite Hpa=> -[!<<-] /rconsIs Heq'. + by move:Hdiff=> /=;rewrite /sa' Heq' xorwA xorwK xorwC xorw0. + by rewrite Hro /=;apply build_hpath_up_None. + + move=> p1 bn b; rewrite getP /p' (@take_nth witness) //. + case (rcons p1 bn = rcons (take i{m2} p{m2}) (nth witness p{m2} i{m2})). + + move=> ^ /rconssI ->> /rconsIs ->> /=; split => [<<- | ]. + + exists sa{m2} h{m2} G1.chandle{m2}. + by rewrite /sa' getP_eq /= (build_hpath_up Hpa) //. + move=> [v hx hy []] Heq1;rewrite getP /sa'. + case ((v +^ nth witness p{m2} i{m2}, hx) = (sa{m2} +^ nth witness p{m2} i{m2}, h{m2})) => //. + have := build_hpath_up_None G1.mh{m2} (sa', h{m2}) (y1L, G1.chandle{m2}) _ _ g1_sa' Hpa. + by rewrite Heq1 => -[!->>]. + move=> Hdiff;rewrite H2. + apply exists_iff=> v /= ;apply exists_iff => hx /=;apply exists_iff => hy /=. + have Hhx2 := dom_hs_neq_ch _ _ _ _ _ Hhs Hsc. + rewrite build_hpath_upd_ch_iff //. + case (hx = G1.chandle{m2}) => [->>|?]. + + split;1: by move=> [] _ /ch_None. + move=> [[p0' x [Hhx2']]]. + have [!<<-] [!->>]:= H3 _ _ _ _ _ Hpa Hhx2'. + by rewrite getP_neq /= ?Hhx2 // => /ch_None. + rewrite getP; case ((v +^ bn, hx) = (sa', h{m2})) => //= -[Hsa' ->>]. + rewrite Hsa' g1_sa' /= -negP => [#] Hbu !<<-. + have [!<<-]:= H3 _ _ _ _ _ Hpa Hbu. + move: Hsa'=> /Block.WRing.addrI /#. + move=> p1 v p2 v' hx. + rewrite !build_hpath_upd_ch_iff //. + case (hx = G1.chandle{m2})=> [->> | Hdiff ];2:by apply H3. + by move=> /> ?? Hp1 ?? Hp2;have [!->>] := H3 _ _ _ _ _ Hp1 Hp2. + case (Hpi) => H1;split=> c p1 v1;rewrite H1 => {H1}. + apply exists_iff => h1 /=. rewrite getP build_hpath_upd_ch_iff //. + by case (h1 = G1.chandle{m2}) => [->> /#|]. +qed. + +section AUX. + + declare module D : DISTINGUISHER {PF, RO, G1}. + + axiom D_ll (F <: DFUNCTIONALITY{D}) (P <: DPRIMITIVE{D}): + islossless P.f => islossless P.fi => islossless F.f => + islossless D(F, P).distinguish. + + equiv CF_G1 : CF(D).main ~ G1(D).main: + ={glob D} ==> !(G1.bcol \/ G1.bext){2} => ={res}. + proof. + proc. + call (_: G1.bcol \/ G1.bext, + INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} + G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2}). + (* lossless D *) + + exact/D_ll. + (** proofs for G1.S.f *) + (* equivalence up to bad of PF.f and G1.S.f *) + + conseq (_: !G1.bcol{2} + /\ !G1.bext{2} + /\ ={x} + /\ INV_CF_G1 FRO.m{2} G1.chandle{2} + PF.m{1} PF.mi{1} + G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} + F.RO.m{2} G1.paths{2} + ==> !G1.bcol{2} + => !G1.bext{2} + => ={res} + /\ INV_CF_G1 FRO.m{2} G1.chandle{2} + PF.m{1} PF.mi{1} + G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} + F.RO.m{2} G1.paths{2}). + + by move=> &1 &2; rewrite negb_or. + + by move=> &1 &2 _ ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? [#]; rewrite negb_or. + (* For now, everything is completely directed by the syntax of + programs, so we can *try* to identify general principles of that + weird data structure and of its invariant. I'm not sure we'll ever + be able to do that, though. *) + (* We want to name everything for now, to make it easier to manage complexity *) + exists * FRO.m{2}, G1.chandle{2}, + PF.m{1}, PF.mi{1}, + G1.m{2}, G1.mi{2}, G1.mh{2}, G1.mhi{2}, + F.RO.m{2}, G1.paths{2}, + x{2}. + elim * => hs0 ch0 PFm PFmi G1m G1mi G1mh G1mhi ro0 pi0 [] x1 x2. + (* poor man's extraction of a fact from a precondition *) + case @[ambient]: {-1}(INV_CF_G1 hs0 ch0 PFm PFmi G1m G1mi G1mh G1mhi ro0 pi0) + (eq_refl (INV_CF_G1 hs0 ch0 PFm PFmi G1m G1mi G1mh G1mhi ro0 pi0)); last first. + + by move=> h; exfalso=> &1 &2 [#] <*>; rewrite h. + move=> /eqT inv0; proc; case @[ambient] {-1}(PFm.[(x1,x2)]) (eq_refl (PFm.[(x1,x2)])). + + move=> PFm_x1x2. + have /incl_of_INV /(notin_m_notin_Gm _ _ (x1,x2)) /(_ _) // Gm_x1x2 := inv0. + rcondt{1} 1; 1:by move=> //= &1; skip=> &2 [#] <*>; rewrite in_dom PFm_x1x2. + rcondt{2} 1; 1:by move=> //= &1; skip=> &2 [#] <*>; rewrite in_dom Gm_x1x2. + case @[ambient]: {-1}(pi0.[x2]) (eq_refl (pi0.[x2])). + + move=> x2_in_pi; rcondf{2} 1. + + by move=> //= &1; skip=> &2 [#] <*>; rewrite in_dom x2_in_pi. + rcondf{2} 8. + + by move=> //= &1; auto=> &2 [#] !<<-; rewrite !in_dom x2_in_pi. + seq 2 2: ( hs0 = FRO.m{2} + /\ ch0 = G1.chandle{2} + /\ PFm = PF.m{1} + /\ PFmi = PF.mi{1} + /\ G1m = G1.m{2} + /\ G1mi = G1.mi{2} + /\ G1mh = G1.mh{2} + /\ G1mhi = G1.mhi{2} + /\ ro0 = F.RO.m{2} + /\ pi0 = G1.paths{2} + /\ (x1,x2) = x{2} + /\ !G1.bcol{2} + /\ !G1.bext{2} + /\ ={x, y1, y2} + /\ INV_CF_G1 hs0 ch0 PFm PFmi G1m G1mi G1mh G1mhi ro0 pi0). + + by auto. + case @[ambient]: {-1}(getflag hs0 x2) (eq_refl (getflag hs0 x2)). + + rewrite getflagP_none => x2f_notin_rng_hs0; rcondt{2} 3. + + move=> &1; auto=> &2 /> _ _ _; rewrite in_rng negb_exists /=. + exact/(@x2f_notin_rng_hs0 Known). + rcondf{2} 6. + + move=> &1; auto=> &2 />. + have ->: hinvK FRO.m{2}.[G1.chandle{2} <- (x2,Known)] x2 = Some G1.chandle{2}. + + rewrite (@huniq_hinvK_h G1.chandle{2} FRO.m{2}.[G1.chandle{2} <- (x2,Known)] x2) //. + + move=> hx hy [] xc xf [] yc yf /=. + rewrite !getP; case: (hx = G1.chandle{2}); case: (hy = G1.chandle{2})=> //=. + + by move=> _ + [#] - <*>; have:= (x2f_notin_rng_hs0 yf hy). + + by move=> + _ + [#] - <*>; have:= (x2f_notin_rng_hs0 xf hx). + by move=> _ _; have /hs_of_INV [] + _ _ - /(_ hx hy (xc,xf) (yc,yf)) := inv0. + by rewrite !getP. + rewrite oget_some=> _ _ _. + have -> //: !mem (dom G1.mh{2}) (x1,G1.chandle{2}). + rewrite in_dom /=; case: {-1}(G1.mh.[(x1,G1.chandle)]{2}) (eq_refl (G1.mh.[(x1,G1.chandle)]{2}))=> //= -[xa xh]; rewrite -negP. + have ^/m_mh_of_INV [] _ + /hs_of_INV [] _ _ h_handles := inv0. + by move=> /(_ x1 G1.chandle{2} xa xh) h /h [] xc xf yc yf [#] /h_handles. + case: (x2 <> y2{2} /\ (forall f h, hs0.[h] <> Some (y2{2},f))). + + auto=> &1 &2 [#] !<<- -> -> !->> {&1} /= _ x2_neq_y2 y2_notin_hs _ _. + rewrite getP /= oget_some /= -addzA /=. + rewrite (@huniq_hinvK_h ch0 hs0.[ch0 <- (x2,Known)] x2); 2:by rewrite getP. + + move=> @/huniq h1 h2 [c1 f1] [c2 f2]; rewrite !getP /=. + case: (h1 = ch0); case: (h2 = ch0)=> //=. + + by move=> _ + [#] - <*>; move: (x2f_notin_rng_hs0 f2 h2). + + by move=> + _ + [#] <*> - <*>; move: (x2f_notin_rng_hs0 f1 h1). + have /hs_of_INV [] + _ _ _ _ - h := inv0. + by apply/h; rewrite getP. + by rewrite oget_some; exact/lemma1. + conseq (_: _ ==> G1.bcol{2})=> //=. + auto=> &1 &2 [#] !<<- -> _ ->> !<<- _ /=. + case: (hinvP hs0.[ch0 <- (x2,Known)] y2{1})=> //= -> /=. + move=> hs0_spec; split=> [|f]. + + by have:= hs0_spec ch0 Known; rewrite getP. + move=> h; have:= hs0_spec h f; rewrite getP; case: (h = ch0)=> [<*>|//=]. + by move=> _; rewrite -negP; have /hs_of_INV [] _ _ H /H {H}:= inv0. + case; rewrite getflagP_some; 1,3:by have /hs_of_INV []:= inv0. + + by move=> x2_is_U; conseq (_: G1.bext{2})=> //=; auto=> &1 &2 />; rewrite x2_is_U. + move=> x2_is_K; rcondf{2} 3; 1:by move=> &1; auto. + have:= x2_is_K; rewrite in_rng=> - [hx] hs0_hx. + seq 0 3: ( hs0 = FRO.m{2} + /\ ch0 = G1.chandle{2} + /\ PFm = PF.m{1} + /\ PFmi = PF.mi{1} + /\ G1m = G1.m{2} + /\ G1mi = G1.mi{2} + /\ G1mh = G1.mh{2} + /\ G1mhi = G1.mhi{2} + /\ ro0 = F.RO.m{2} + /\ pi0 = G1.paths{2} + /\ (x1,x2) = x{2} + /\ !G1.bcol{2} + /\ !G1.bext{2} + /\ ={x,y1,y2} + /\ y{2} = (y1,y2){2} + /\ hx2{2} = hx + /\ INV_CF_G1 hs0 ch0 PFm PFmi G1m G1mi G1mh G1mhi ro0 pi0). + + auto=> &1 &2 /> _ -> /= _; split. + + move: x2_is_K; rewrite in_rng /= => -[hx2] hs_hx2. + rewrite in_rng negb_exists /==> h; rewrite -negP=> hs_h. + have /hs_of_INV [] Hhuniq _ _ := inv0. + by move: (Hhuniq _ _ _ _ hs_hx2 hs_h)=> ht; move: ht hs_h=> /= <*>; rewrite hs_hx2. + rewrite (@huniq_hinvK_h hx FRO.m{2} x2) //. + by have /hs_of_INV [] := inv0. + have x1hx_notin_G1m: !mem (dom G1mh) (x1,hx). + + rewrite in_dom; case: {-1}(G1mh.[(x1,hx)]) (eq_refl G1mh.[(x1,hx)])=> //=. + move=> [mhx1 mhx2]; rewrite -negP=> h. + have /m_mh_of_INV [] _ hg := inv0. + have [xa xh ya yh] := hg _ _ _ _ h. + by rewrite hs0_hx=> [#] <*>; rewrite PFm_x1x2. + rcondf{2} 1. + + by move=> &m; auto=> //= &hr [#] <*>; rewrite x1hx_notin_G1m. + auto=> &1 &2 [#] !<<- -> -> !->> _ /= hinv_y2_none. + rewrite getP /= oget_some /=; apply/lemma2=> //. + + by case: (hinvP hs0 y2{2})=> [_ + f h|//=] - ->. + move=> [p0 v0] ^ pi_x2. have /pi_of_INV [] -> [hx2] [#] Hpath hs_hx2:= inv0. + rcondt{2} 1. by move=> &m; auto=> &hr [#] !<<- _ _ ->> /= _; rewrite in_dom pi_x2. + rcondf{2} 6. + + auto; inline *; auto=> &hr [#] !<<- _ _ !->> _ /= _ _ _ _ /=. + by rewrite in_rng; exists hx2. + rcondf{2} 7. + + auto; inline *; auto=> &hr [#] !<<- _ _ !->> _ /= _ _ _ _ /=. + rewrite negb_and; left; rewrite (@huniq_hinvK_h hx2 hs0 x2) // 2:oget_some. + + by have /hs_of_INV []:= inv0. + rewrite in_dom; case: {-1}(G1mh.[(x1,hx2)]) (eq_refl (G1mh.[(x1,hx2)]))=> [//=|[xa xc] G1mh_x1hx2]. + have /m_mh_of_INV [] _ /(_ _ _ _ _ G1mh_x1hx2) [xc0 xf0 yc0 yf0] := inv0. + by move=> [#]; rewrite hs_hx2=> [#] !<<- {xc0 xf0}; rewrite PFm_x1x2. + rcondt{2} 15. + + auto; inline *; auto=> &hr [#] !<<- _ _ !->> _ /= _ _ _ _ /=. + by rewrite in_dom pi_x2. + inline F.RO.get. rcondt{2} 4. + + auto=> &hr [#] !<<- _ _ !->> _ /= _ _; rewrite pi_x2 oget_some /=. + rewrite in_dom; case: {-1}(ro0.[rcons p0 (v0 +^ x1)]) (eq_refl (ro0.[rcons p0 (v0 +^ x1)])). + + done. + move=> bo ^ro_pvx1 /=. have /mh_of_INV [] _ -> _:= inv0. + rewrite negb_exists=> ? /=; rewrite negb_exists=> ? /=; rewrite negb_exists=> yh /=. + rewrite Hpath /=; rewrite negb_and -implyNb /= => [#] !<<-. + rewrite xorwA xorwK xorwC xorw0 -negP=> G1mh_x1hx2. + have /m_mh_of_INV [] _ /(_ _ _ _ _ G1mh_x1hx2) := inv0. + move=> [xc xf yc yf] [#]; rewrite hs_hx2=> [#] <*>. + by rewrite PFm_x1x2. + auto => &m1 &m2 [#] !<- _ _ -> /= _ y1L -> y2L -> /=. + rewrite !getP_eq pi_x2 !oget_some /=. + have /hs_of_INV [] Hu _ _:= inv0; have -> := huniq_hinvK_h _ _ _ Hu hs_hx2. + rewrite oget_some => /= ? Hy2L . + case:inv0=> Hhs Hinv HinvG Hmmh Hmmhi Hincl Hincli Hmh Hpi. + have Hhx2:= dom_hs_neq_ch _ _ _ _ _ Hhs hs_hx2. + have mh_hx2: G1mh.[(x1,hx2)] = None. + + case Hmmh => _ /(_ x1 hx2);case (G1mh.[(x1, hx2)]) => // -[ya hy] /(_ ya hy) /=. + by rewrite -negP=> -[xc fx yc fy];rewrite hs_hx2 => -[[!<<-]];rewrite PFm_x1x2. + have ch_0 := ch_neq0 _ _ Hhs. + have ch_None : forall xa xb ha hb, G1mh.[(xa,ha)] = Some(xb, hb) => ha <> ch0 /\ hb <> ch0. + + move=> xa xb ha hb;case Hmmh=> _ H /H [xc fx yc fy [#]]. + by move=> /(dom_hs_neq_ch _ _ _ _ _ Hhs) -> /(dom_hs_neq_ch _ _ _ _ _ Hhs). + split. + + by apply hs_addh => //;have /# := hinvP hs0 y2L. + + apply inv_addm=> //; case: {-1}(G1mi.[(y1L,y2L)]) (eq_refl G1mi.[(y1L,y2L)])=> //. + move=> [x1L x2L] ^G1mi_y; rewrite -Hincli 1:G1mi_y//. + case: Hmmhi Hy2L => H _ + /H {H} [hx fx hy fy] [#]. + by case: (hinvP hs0 y2L)=> [_ ->|//]/#. + + by apply inv_addm=>//; apply (ch_notin_dom2_mh _ _ Hmmhi Hhs). + + by apply (m_mh_addh_addm _ Hmmh _ hs_hx2)=>//;apply ch_notin_dom_hs. + + apply (mi_mhi_addh_addmi _ Hmmhi _ hs_hx2);last by apply ch_notin_dom_hs. + by have := hinvP hs0 y2L;rewrite /#. + + by apply incl_addm. + by apply incl_addm. + + split. + + move=> xa hx ya hy;rewrite getP;case ((xa, hx) = (x1, hx2))=> /=. + + move=> [] !-> [] !<-; exists x2 Known y2L Known. + by rewrite !getP_eq /= getP_neq // eq_sym; apply (dom_hs_neq_ch _ _ _ Hhs hs_hx2). + move=> Hdiff Hxa; case Hmh=> /(_ _ _ _ _ Hxa) [] xc fx yc fy [#] Hhx Hhy HG1 _ _. + exists xc fx yc fy;rewrite !getP_neq //. + + by rewrite eq_sym;apply (dom_hs_neq_ch _ _ _ Hhs Hhx). + + by rewrite eq_sym;apply (dom_hs_neq_ch _ _ _ Hhs Hhy). + + rewrite /= -negP=> -[] <<- <<-;apply Hdiff=> /=. + by apply (Hu hx (x2, fx) (x2, Known)). + rewrite Hhx Hhy=> /=;move: HG1. + case: fy Hhy=> Hhy //= [p v [Hro Hbu]]. + exists p v;split. + + rewrite getP_neq // -negP => ^ /rconssI <<- /rconsIs. + move: Hbu;rewrite Hpath /= => -[!<<-] /=. + by rewrite -negP=> /Block.WRing.addrI /#. + by apply build_hpath_up=> //; move: hs_hx2 PFm_x1x2;apply: m_mh_None. + + move=> p bn b; rewrite getP. + case (rcons p bn = rcons p0 (v0 +^ x1)). + + move=> ^ /rconssI <<- /rconsIs ->> /=; split => [<<- | ]. + + exists v0 hx2 ch0. + rewrite (build_hpath_up Hpath) /=;1:by move: hs_hx2 PFm_x1x2;apply: m_mh_None. + by rewrite xorwA xorwK Block.WRing.add0r getP_eq. + move=> [v hx hy] [];rewrite getP ;case ((v +^ (v0 +^ x1), hx) = (x1, hx2)) => //. + move=> Hdiff;have HG1 := m_mh_None _ _ _ _ _ _ _ Hmmh hs_hx2 PFm_x1x2. + have -> /= [->> <<-]:= build_hpath_up_None _ _ (y1L, ch0) _ _ HG1 Hpath. + by move:Hdiff;rewrite xorwA xorwK Block.WRing.add0r. + move=> Hdiff; case Hmh => ? -> Huni. + apply exists_iff=> v /= ;apply exists_iff => hx /=;apply exists_iff => hy /=. + rewrite build_hpath_upd_ch_iff //. + case (hx = ch0) => [->>|?]. + + split;1: by move=> [] _ /ch_None. + move=> [[p0' x [Hhx2']]]. + have [!->>] [!->>]:= Huni _ _ _ _ _ Hpath Hhx2'. + by rewrite getP_neq /= ?Hhx2 // => /ch_None. + rewrite getP;case ((v +^ bn, hx) = (x1, hx2)) => //= -[<<- ->>]. + split=> -[H];have [!->>]:= Huni _ _ _ _ _ Hpath H;move:Hdiff; + by rewrite xorwA xorwK Block.WRing.add0r. + move=> p v p' v' hx;case Hmh => _ _ Huni. + rewrite !build_hpath_upd_ch_iff //. + case (hx = ch0) => [->> [?? [# H1 -> ->]] [?? [# H2 -> ->]]|_ ] /=. + + by have [!->>] := Huni _ _ _ _ _ H1 H2. + by apply Huni. + split=> c p v;rewrite getP. case (c = y2L) => [->> /= | Hc]. + + split. + + move=> [!<<-];exists ch0;rewrite getP_eq /= build_hpath_prefix. + exists v0 hx2;rewrite xorwA xorwK Block.WRing.add0r getP_eq /=. + have HG1 := m_mh_None _ _ _ _ _ _ _ Hmmh hs_hx2 PFm_x1x2. + by apply build_hpath_up_None. + move=> [h []];rewrite getP build_hpath_upd_ch_iff //. + case (h=ch0)=> [->> /= [??[# H1 -> ->]]| Hh] /=. + + by case Hmh => _ _ /(_ _ _ _ _ _ Hpath H1). + by have := hinvP hs0 y2L;rewrite /= => /#. + case Hpi => ->;apply exists_iff => h /=. + rewrite build_hpath_upd_ch_iff // getP;case (h = ch0) => [->> | //]. + split;1: by move=> [_ /(dom_hs_neq_ch _ _ _ _ _ Hhs)]. + by move=> /= [_ <<-];move:Hc. + + move=> [xa xc] PFm_x1x2. rcondf{1} 1; 1:by auto=> &hr [#] !<<- _ _ ->>; rewrite in_dom PFm_x1x2. + have /m_mh_of_INV [] + _ - /(_ _ _ _ _ PFm_x1x2) := inv0. + move=> [hx2 fx2 hy2 fy2] [#] hs_hx2 hs_hy2 G1mh_x1hx2. + case @[ambient]: {-1}(G1m.[(x1,x2)]) (eq_refl (G1m.[(x1,x2)])); last first. + + move=> [ya yc] G1m_x1x2; rcondf{2} 1; 1:by auto=> &hr [#] !<<- _ _ ->>; rewrite in_dom G1m_x1x2. + auto=> &1 &2 [#] <*> -> -> -> /=; have /incl_of_INV /(_ (x1,x2)) := inv0. + by rewrite PFm_x1x2 G1m_x1x2 /= => [#] !<<- {ya yc}. + move=> x1x2_notin_G1m; rcondt{2} 1; 1:by auto=> &hr [#] !<<- _ _ ->>; rewrite in_dom x1x2_notin_G1m. + have <*>: fy2 = Unknown. + + have /mh_of_INV [] /(_ _ _ _ _ G1mh_x1hx2) + _ := inv0. + move=> [xc0 xf0 yc0 yf0] [#]; rewrite hs_hx2 hs_hy2=> [#] !<<- [#] !<<- {xc0 xf0 yc0 yf0}. + by case: fy2 hs_hy2 G1mh_x1hx2=> //=; rewrite x1x2_notin_G1m. + case @[ambient]: fx2 hs_hx2=> hs_hx2. + + swap{2} 3 -2; seq 0 1: (G1.bext{2}); last by inline*; if{2}; auto; smt (@Block @Capacity). + by auto=> ? ? [#] !<<- _ -> ->> _ /=; rewrite in_rng; exists hx2. + have /mh_of_INV []/(_ _ _ _ _ G1mh_x1hx2) + _ _:= inv0. + move=> [xc0 xf0 yc0 yf0] [#]; rewrite hs_hx2 hs_hy2=> [#] !<<- [#] !<<- {xc0 xf0 yc0 yf0} /= [p0 v0] [#] Hro Hpath. + have /pi_of_INV [] /(_ x2 p0 v0) /iffRL /(_ _) := inv0. + + by exists hx2. + move=> pi_x2; rcondt{2} 1; 1:by auto=> &hr [#] <*>; rewrite in_dom pi_x2. + inline F.RO.get. + rcondf{2} 4; first by auto=> &hr [#] !<<- _ _ ->> _ /=; rewrite pi_x2 oget_some /= in_dom Hro. + rcondf{2} 8; first by auto=> &hr [#] !<<- _ _ ->> _ /= _ _ _ _; rewrite in_rng; exists hx2. + rcondt{2} 9. + + auto=> &hr [#] !<<- _ _ ->> _ /= _ _ _ _. + rewrite (@huniq_hinvK_h hx2 hs0 x2) // 2:in_dom 2:G1mh_x1hx2 2:!oget_some /=. + + by have /hs_of_INV []:= inv0. + by rewrite /in_dom_with in_dom hs_hy2. + rcondt{2} 14; first by auto=> &hr [#] !<<- _ _ ->> _ /=; rewrite in_dom pi_x2. + auto=> &1 &2 [#] !<<- -> -> ->> _ /=; rewrite Block.DBlock.dunifin_ll Capacity.DCapacity.dunifin_ll /=. + move=> _ _ _ _; rewrite PFm_x1x2 pi_x2 !oget_some //=. + rewrite (@huniq_hinvK_h hx2 hs0 x2) // ?oget_some. + + by have /hs_of_INV []:= inv0. + rewrite Hro G1mh_x1hx2 hs_hy2 ?oget_some //= => _. + exact/(@lemma3 _ _ _ _ _ _ _ _ _ _ _ _ hx2 _ _ hy2). + (* lossless PF.f *) + + move=> &2 _; proc; if=> //=; wp; rnd predT; rnd predT; auto. + smt (@Block.DBlock @Capacity.DCapacity). + (* lossless and do not reset bad G1.S.f *) + + move=> _; proc; if; auto. + conseq (_: _ ==> G1.bcol \/ G1.bext); 1:smt (). + inline *; if=> //=; wp; rnd predT; wp; rnd predT; auto. + + smt (@Block.DBlock @Capacity.DCapacity). + smt (@Block.DBlock @Capacity.DCapacity). + (** proofs for G1.S.fi *) + (* equiv PF.P.fi G1.S.fi *) + + by conseq (eq_fi D)=> /#. + (* lossless PF.P.fi *) + + move=> &2 _; proc; if=> //=; wp; rnd predT; rnd predT; auto. + smt (@Block.DBlock @Capacity.DCapacity). + (* lossless and do not reset bad G1.S.fi *) + + move=> _; proc; if; 2:by auto. + by wp; do 2!rnd predT; auto => &hr [#]; smt (@Block.DBlock @Capacity.DCapacity). + (** proofs for G1.C.f *) + (* equiv PF.C.f G1.C.f *) + + proc. + inline*;sp. admit. (* this is false *) + (* lossless PF.C.f *) + + move=> &2 _; proc; inline *; while (true) (size p); auto. + + sp; if; 2:by auto; smt (size_behead). + by wp; do 2!rnd predT; auto; smt (size_behead @Block.DBlock @Capacity.DCapacity). + smt (size_ge0). + (* lossless and do not reset bad G1.C.f *) + + move=> _; proc; inline *; wp; rnd predT; auto. + while (G1.bcol \/ G1.bext) (size p - i)=> [z|]. + + if; 1:by auto=> /#. + wp; rnd predT; wp; rnd predT; auto. + smt (@Block.DBlock @Capacity.DCapacity). + by auto; smt (@Block.DBlock @Capacity.DCapacity). + (* Init ok *) + inline *; auto=> />; split=> [|/#]. + (do !split; last 3 smt (getP map0P build_hpath_map0)); last 5 by move=> ? ? ? ?; rewrite map0P. + + move=> h1 h2 ? ?; rewrite !getP !map0P. + by case: (h1 = 0); case: (h2 = 0)=> //=. + + by rewrite getP. + + by move=> ? h; rewrite getP map0P; case: (h = 0). + + by move=> ? ?; rewrite !map0P. + by move=> ? ?; rewrite !map0P. +qed. + +end section AUX. + +section. + + declare module D: DISTINGUISHER{Perm, C, PF, G1, RO}. + + axiom D_ll (F <: DFUNCTIONALITY{D}) (P <: DPRIMITIVE{D}): + islossless P.f => islossless P.fi => + islossless F.f => islossless D(F, P).distinguish. + + lemma Real_G1 &m: + Pr[GReal(D).main() @ &m: res /\ C.c <= max_size] <= + Pr[G1(DRestr(D)).main() @ &m: res] + (max_size ^ 2)%r * mu dstate (pred1 witness) + + Pr[G1(DRestr(D)).main() @&m: G1.bcol] + Pr[G1(DRestr(D)).main() @&m: G1.bext]. + proof. + apply (@RealOrder.ler_trans _ _ _ (Real_Concrete D D_ll &m)). + cut : Pr[CF(DRestr(D)).main() @ &m : res] <= + Pr[G1(DRestr(D)).main() @ &m : res] + + Pr[G1(DRestr(D)).main() @ &m : G1.bcol \/ G1.bext]. + + byequiv (CF_G1 (DRestr(D)) _)=>//;1:by apply (DRestr_ll D D_ll). + smt ml=0. + cut /# : Pr[G1(DRestr(D)).main() @ &m : G1.bcol \/ G1.bext] <= + Pr[G1(DRestr(D)).main() @ &m : G1.bcol] + + Pr[G1(DRestr(D)).main() @ &m : G1.bext]. + rewrite Pr [mu_or]; smt. + qed. + +end section. + + diff --git a/proof/smart_counter/IndifPadding.ec b/proof/smart_counter/IndifPadding.ec new file mode 100644 index 0000000..192ca69 --- /dev/null +++ b/proof/smart_counter/IndifPadding.ec @@ -0,0 +1,123 @@ +require import Fun Pair Real NewFMap. +require (*..*) Indifferentiability LazyRO. + +clone import Indifferentiability as Ind1. + +clone import Indifferentiability as Ind2 + with type p <- Ind1.p, + type f_out <- Ind1.f_out. + +op pad : Ind2.f_in -> Ind1.f_in. +op padinv : Ind1.f_in -> Ind2.f_in. +axiom cancel_pad : cancel pad padinv. +axiom cancel_padinv : cancel padinv pad. + +clone import LazyRO as RO1 + with type from <- Ind1.f_in, + type to <- Ind1.f_out. + +clone import LazyRO as RO2 + with type from <- Ind2.f_in, + type to <- Ind1.f_out, + op d <- RO1.d. + +module ConstrPad (FC:Ind1.CONSTRUCTION, P:Ind1.DPRIMITIVE) = { + module C = FC(P) + + proc init = C.init + + proc f (x:Ind2.f_in) : f_out = { + var r; + r = C.f(pad x); + return r; + } +}. + +module DistPad(FD: Ind2.DISTINGUISHER, F:Ind1.DFUNCTIONALITY, P:Ind1.DPRIMITIVE) = { + module Fpad = { + proc f(x:Ind2.f_in) : f_out = { + var r; + r = F.f(pad x); + return r; + } + } + + proc distinguish = FD(Fpad,P).distinguish +}. + +module SimPadinv(S:Ind1.SIMULATOR, F2:Ind2.DFUNCTIONALITY) = { + module F1 = { + proc f(x:Ind1.f_in):Ind1.f_out = { + var r; + r = F2.f(padinv x); + return r; + } + } + + module S2 = S(F1) + + proc init = S2.init + + proc f = S2.f + proc fi = S2.fi +}. + +section Reduction. + declare module P : Ind1.PRIMITIVE. (* It is compatible with Ind2.Primitive *) + declare module C : Ind1.CONSTRUCTION {P}. + declare module S : Ind1.SIMULATOR{ RO1.H, RO2.H}. + + declare module D' : Ind2.DISTINGUISHER{P,C, RO1.H, RO2.H, S}. + + local equiv ConstrDistPad: + Ind2.GReal(ConstrPad(C), P, D').main ~ + Ind1.GReal(C, P, DistPad(D')).main : ={glob P, glob C, glob D'} ==> + ={glob P, glob C, glob D', res}. + proof. by sim. qed. + + local lemma PrConstrDistPad &m: + Pr[ Ind2.GReal(ConstrPad(C), P, D').main() @ &m : res] = + Pr[ Ind1.GReal(C, P, DistPad(D')).main() @ &m : res]. + proof. by byequiv ConstrDistPad. qed. + + local equiv DistH2H1: + Ind2.GIdeal(RO2.H, SimPadinv(S), D').main ~ + Ind1.GIdeal(RO1.H, S, DistPad(D')).main : + ={glob D', glob S} ==> + ={glob D',glob S, res} /\ forall x, RO2.H.m{1}.[padinv x] = RO1.H.m{2}.[x]. + proof. + proc. + call (_: ={glob S} /\ forall x, RO2.H.m{1}.[padinv x] = RO1.H.m{2}.[x]). + + proc *;inline *. + call (_: forall x, RO2.H.m{1}.[padinv x] = RO1.H.m{2}.[x]);auto. + proc;inline *;wp;sp;if;first by progress [-split];rewrite !in_dom H. + + auto;progress;first by rewrite !getP_eq. + by rewrite !getP (can_eq _ _ cancel_padinv) H. + by auto;progress;rewrite H. + + proc *;inline *. + call (_: forall x, RO2.H.m{1}.[padinv x] = RO1.H.m{2}.[x]);auto. + proc;inline *;wp;sp;if;first by progress [-split];rewrite !in_dom H. + + auto;progress;first by rewrite !getP_eq. + by rewrite !getP (can_eq _ _ cancel_padinv) H. + by auto;progress;rewrite H. + + proc;inline *;wp;sp;if;first by progress[-split];rewrite -{1}(cancel_pad x{2}) !in_dom H. + + auto;progress;first by rewrite !getP_eq. + by rewrite !getP (eq_sym x1) (can2_eq _ _ cancel_pad cancel_padinv) (eq_sym x{2}) H. + by auto;progress;rewrite -H cancel_pad. + inline *;wp. call (_: ={glob D'}). + auto;progress;by rewrite !map0P. + qed. + + local lemma PrDistH2H1 &m: + Pr[Ind2.GIdeal(RO2.H,SimPadinv(S),D').main() @ &m : res] = + Pr[Ind1.GIdeal(RO1.H,S, DistPad(D')).main() @ &m : res]. + proof. by byequiv DistH2H1. qed. + + lemma Conclusion &m: + `| Pr[Ind2.GReal (ConstrPad(C), P , D' ).main() @ &m : res] - + Pr[Ind2.GIdeal(RO2.H , SimPadinv(S), D' ).main() @ &m : res] | = + `| Pr[Ind1.GReal (C , P , DistPad(D')).main() @ &m : res] - + Pr[Ind1.GIdeal(RO1.H , S , DistPad(D')).main() @ &m : res] |. + proof. by rewrite (PrConstrDistPad &m) (PrDistH2H1 &m). qed. + +end section Reduction. diff --git a/proof/smart_counter/LazyRO.eca b/proof/smart_counter/LazyRO.eca new file mode 100644 index 0000000..96136e7 --- /dev/null +++ b/proof/smart_counter/LazyRO.eca @@ -0,0 +1,22 @@ +require import Option FSet NewFMap. +require (*..*) NewROM. + +type from, to. +op d: to distr. + +clone include NewROM with + type from <- from, + type to <- to, + op dsample <- fun (x:from) => d. + + +module H = { + var m : (from, to) fmap + + proc init() = { m = map0; } + + proc f(x) = { + if (!mem (dom m) x) m.[x] = $d; + return oget m.[x]; + } +}. diff --git a/proof/smart_counter/SLCommon.ec b/proof/smart_counter/SLCommon.ec new file mode 100644 index 0000000..8453ae9 --- /dev/null +++ b/proof/smart_counter/SLCommon.ec @@ -0,0 +1,498 @@ +(** This is a theory for the Squeezeless sponge: where the ideal + functionality is a fixed-output-length random oracle whose output + length is the input block size. We prove its security even when + padding is not prefix-free. **) +require import Core Int Real StdOrder Ring IntExtra. +require import List FSet NewFMap Utils Common RndO DProd Dexcepted. + +require (*..*) Indifferentiability. +(*...*) import Capacity IntOrder. + +type state = block * capacity. +op dstate = bdistr `*` cdistr. + +clone include Indifferentiability with + type p <- state, + type f_in <- block list, + type f_out <- block + rename [module] "GReal" as "RealIndif" + [module] "GIdeal" as "IdealIndif". + +(** max number of call to the permutation and its inverse, + including those performed by the construction. *) +op max_size : { int | 0 <= max_size } as max_ge0. + +(** Ideal Functionality **) +clone export Tuple as TupleBl with + type t <- block, + op Support.enum <- Block.blocks + proof Support.enum_spec by exact Block.enum_spec. + +op bl_enum = flatten (mkseq (fun i => wordn i) (max_size + 1)). +op bl_univ = FSet.oflist bl_enum. + +(* -------------------------------------------------------------------------- *) +(* Random oracle from block list to block *) +clone import RndO.GenEager as F with + type from <- block list, + type to <- block, + op sampleto <- fun (_:block list)=> bdistr + proof * by exact Block.DBlock.dunifin_ll. + +(** We can now define the squeezeless sponge construction **) +module SqueezelessSponge (P:DPRIMITIVE): FUNCTIONALITY = { + proc init () = {} + + proc f(p : block list): block = { + var (sa,sc) <- (b0,c0); + + while (p <> []) { (* Absorption *) + (sa,sc) <@ P.f((sa +^ head witness p,sc)); + p <- behead p; + } + + return sa; (* Squeezing phase (non-iterated) *) + } +}. + +clone export DProd.ProdSampling as Sample2 with + type t1 <- block, + type t2 <- capacity, + op d1 <- bdistr, + op d2 <- cdistr. + +(* -------------------------------------------------------------------------- *) +(** TODO move this **) + +op incl (m m':('a,'b)fmap) = + forall x, m .[x] <> None => m'.[x] = m.[x]. + +(* -------------------------------------------------------------------------- *) +(** usefull type and operators for the proof **) + +type handle = int. + +type hstate = block * handle. + +type ccapacity = capacity * flag. + +type smap = (state , state ) fmap. +type hsmap = (hstate, hstate ) fmap. +type handles = (handle, ccapacity) fmap. + +pred is_pre_permutation (m mi : ('a,'a) fmap) = + (forall x, mem (rng m) x => mem (dom mi) x) + /\ (forall x, mem (rng mi) x => mem (dom m) x). + +lemma half_permutation_set (m' mi' : ('a,'a) fmap) x' y': + (forall x, mem (rng m') x => mem (dom mi') x) + => (forall x, mem (rng m'.[x' <- y']) x => mem (dom mi'.[y' <- x']) x). +proof. + move=> h x0. + rewrite rng_set domP !in_fsetU in_fset1 => -[/rng_rem_le in_rng|//=]. + by rewrite h. +qed. + +lemma pre_permutation_set (m mi : ('a,'a) fmap) x y: + is_pre_permutation m mi => + is_pre_permutation m.[x <- y] mi.[y <- x]. +proof. + move=> [dom_mi dom_m]. + by split; apply/half_permutation_set. +qed. + +(* Functionnal version of the construction using handle *) + +op step_hpath (mh:hsmap) (sah:hstate option) (b:block) = + if sah = None then None + else + let sah = oget sah in + mh.[(sah.`1 +^ b, sah.`2)]. + +op build_hpath (mh:hsmap) (bs:block list) = + foldl (step_hpath mh) (Some (b0,0)) bs. + +inductive build_hpath_spec mh p v h = + | Empty of (p = []) + & (v = b0) + & (h = 0) + | Extend p' b v' h' of (p = rcons p' b) + & (build_hpath mh p' = Some (v',h')) + & (mh.[(v' +^ b,h')] = Some (v,h)). + +lemma build_hpathP mh p v h: + build_hpath mh p = Some (v,h) <=> build_hpath_spec mh p v h. +proof. +elim/last_ind: p v h=> @/build_hpath //= [v h|p b ih v h]. ++ by rewrite andaE; split=> [!~#] <*>; [exact/Empty|move=> [] /#]. +rewrite -{1}cats1 foldl_cat {1}/step_hpath /=. +case: {-1}(foldl _ _ _) (eq_refl (foldl (step_hpath mh) (Some (b0,0)) p))=> //=. ++ apply/implybN; case=> [/#|p' b0 v' h']. + move=> ^/rconssI <<- {p'} /rconsIs ->> {b}. + by rewrite /build_hpath=> ->. +move=> [v' h']; rewrite oget_some /= -/(build_hpath _ _)=> build. +split. ++ by move=> mh__; apply/(Extend mh (rcons p b) v h p b v' h' _ build mh__). +case=> [/#|] p' b' v'' h'' ^/rconssI <<- {p'} /rconsIs <<- {b'}. +by rewrite build /= => [#] <*>. +qed. + +lemma build_hpath_map0 p: + build_hpath map0 p + = if p = [] then Some (b0,0) else None. +proof. +elim/last_ind: p=> //= p b _. +by rewrite -{1}cats1 foldl_cat {1}/step_hpath /= map0P /= /#. +qed. + +(* -------------------------------------------------------------------------- *) +theory Prefixe. + +op prefixe ['a] (s t : 'a list) = + with s = x :: s', t = y :: t' => if x = y then 1 + prefixe s' t' else 0 + with s = _ :: _ , t = [] => 0 + with s = [] , t = _ :: _ => 0 + with s = [] , t = [] => 0. + +lemma prefixe_eq (l : 'a list) : prefixe l l = size l. +proof. elim:l=>//=/#. qed. + + +lemma prefixeC (l1 l2 : 'a list) : + prefixe l1 l2 = prefixe l2 l1. +proof. +move:l1;elim l2=>//=;first by move=>l1;elim l1=>//=. +move=>e2 l2 Hind l1;move:e2 l2 Hind;elim l1=>//=. +move=>e1 l1 Hind e2 l2 Hind1;rewrite Hind1/#. +qed. + + +lemma prefixe_ge0 (l1 l2 : 'a list) : + 0 <= prefixe l1 l2. +proof. +move:l2;elim:l1=>//=;first move=>l2;elim:l2=>//=. +move=>e1 l1 Hind l2;move:e1 l1 Hind;elim l2=>//=. +move=>e2 l2 Hind2 e1 l1 Hind1/#. +qed. + +lemma prefixe_sizel (l1 l2 : 'a list) : + prefixe l1 l2 <= size l1. +proof. +move:l2;elim :l1=>//=;first by move=>l2;elim l2=>//=. +move=>e1 l1 Hind l2;move:e1 l1 Hind;elim l2=>//=;1:smt(size_ge0). +move=>e2 l2 Hind2 e1 l1 Hind1/#. +qed. + +lemma prefixe_sizer (l1 l2 : 'a list) : + prefixe l1 l2 <= size l2. +proof. +by rewrite prefixeC prefixe_sizel. +qed. + + +lemma prefixe_take (l1 l2 : 'a list) : + take (prefixe l1 l2) l1 = take (prefixe l1 l2) l2. +proof. +move:l2;elim l1=>//=; first by move=>l2;elim l2=>//=. +move=>e1 l1 Hind l2/=;move:e1 l1 Hind;elim l2=>//=. +move=>e2 l2 Hind1 e1 l1 Hind2=>//=. +by case(e1=e2)=>[->//=/#|//=]. +qed. + +lemma prefixe_nth (l1 l2 : 'a list) : + let i = prefixe l1 l2 in + forall j, 0 <= j < i => + nth witness l1 j = nth witness l2 j. +proof. +rewrite/=. +cut Htake:=prefixe_take l1 l2. search nth take. +move=>j[Hj0 Hjp];rewrite-(nth_take witness (prefixe l1 l2))1:prefixe_ge0//. +by rewrite-(nth_take witness (prefixe l1 l2) l2)1:prefixe_ge0//Htake. +qed. + + +op max_prefixe (l1 l2 : 'a list) (ll : 'a list list) = + with ll = "[]" => l2 + with ll = (::) l' ll' => + if prefixe l1 l2 < prefixe l1 l' then max_prefixe l1 l' ll' + else max_prefixe l1 l2 ll'. + + +op get_max_prefixe (l : 'a list) (ll : 'a list list) = + with ll = "[]" => [] + with ll = (::) l' ll' => max_prefixe l l' ll'. + + + +end Prefixe. + +(* -------------------------------------------------------------------------- *) + +module C = { + var c : int + var m : (state, state) fmap + var mi : (state, state) fmap + proc init () = { + c <- 0; + m <- map0; + mi <- map0; + } +}. + +module PC (P:PRIMITIVE) = { + + proc init () = { + C.init(); + P.init(); + } + + proc f (x:state) = { + var y; + y <@ P.f(x); + if (!x \in dom C.m) { + C.c <- C.c + 1; + C.m.[x] <- y; + C.mi.[y] <- x; + } + return y; + } + + proc fi(x:state) = { + var y; + y <@ P.fi(x); + if (!x \in dom C.mi) { + C.c <- C.c + 1; + C.mi.[x] <- y; + C.m.[y] <- x; + } + return y; + } + +}. + +module DPRestr (P:DPRIMITIVE) = { + + proc f (x:state) = { + var y=(b0,c0); + if (C.c + 1 <= max_size) { + y <@ P.f(x); + if (!x \in dom C.m) { + C.c <- C.c + 1; + C.m.[x] <- y; + C.mi.[y] <- x; + } + } + return y; + } + + proc fi(x:state) = { + var y=(b0,c0); + if (C.c + 1 <= max_size) { + y <@ P.fi(x); + if (!x \in dom C.mi) { + C.c <- C.c + 1; + C.mi.[x] <- y; + C.m.[y] <- x; + } + } + return y; + } + +}. + +module PRestr (P:PRIMITIVE) = { + + proc init () = { + C.init(); + P.init(); + } + + proc f = DPRestr(P).f + + proc fi = DPRestr(P).fi + +}. + +module FC(F:FUNCTIONALITY) = { + + proc init = F.init + + proc f (bs:block list) = { + var b= b0; + C.c <- C.c + size bs; + b <@ F.f(bs); + return b; + } +}. + +module DFRestr(F:DFUNCTIONALITY) = { + + proc f (bs:block list) = { + var b= b0; + if (C.c + size bs <= max_size) { + C.c <- C.c + size bs; + b <@ F.f(bs); + } + return b; + } +}. + +module FRestr(F:FUNCTIONALITY) = { + + proc init = F.init + + proc f = DFRestr(F).f + +}. + +(* -------------------------------------------------------------------------- *) +(* This allow swap the counting from oracle to adversary *) +module DRestr(D:DISTINGUISHER, F:DFUNCTIONALITY, P:DPRIMITIVE) = { + proc distinguish() = { + var b; + C.init(); + b <@ D(DFRestr(F), DPRestr(P)).distinguish(); + return b; + } +}. + +lemma rp_ll (P<:DPRIMITIVE): islossless P.f => islossless DPRestr(P).f. +proof. move=>Hll;proc;sp;if=>//;call Hll;auto. qed. + +lemma rpi_ll (P<:DPRIMITIVE): islossless P.fi => islossless DPRestr(P).fi. +proof. move=>Hll;proc;sp;if=>//;call Hll;auto. qed. + +lemma rf_ll (F<:DFUNCTIONALITY): islossless F.f => islossless DFRestr(F).f. +proof. move=>Hll;proc;sp;if=>//;call Hll;auto. qed. + +lemma DRestr_ll (D<:DISTINGUISHER{C}): + (forall (F<:DFUNCTIONALITY{D})(P<:DPRIMITIVE{D}), + islossless P.f => islossless P.fi => islossless F.f => + islossless D(F,P).distinguish) => + forall (F <: DFUNCTIONALITY{DRestr(D)}) (P <: DPRIMITIVE{DRestr(D)}), + islossless P.f => + islossless P.fi => islossless F.f => islossless DRestr(D, F, P).distinguish. +proof. + move=> D_ll F P p_ll pi_ll f_ll;proc. + call (D_ll (DFRestr(F)) (DPRestr(P)) _ _ _). + + by apply (rp_ll P). + by apply (rpi_ll P). + by apply (rf_ll F). + by inline *;auto. +qed. + +section RESTR. + + declare module F:FUNCTIONALITY{C}. + declare module P:PRIMITIVE{C,F}. + declare module D:DISTINGUISHER{F,P,C}. + + lemma swap_restr &m: + Pr[Indif(FRestr(F), PRestr(P), D).main()@ &m: res] = + Pr[Indif(F,P,DRestr(D)).main()@ &m: res]. + proof. + byequiv=>//. + proc;inline *;wp;swap{1}1 2;sim. + qed. + +end section RESTR. + +section COUNT. + + declare module P:PRIMITIVE{C}. + declare module CO:CONSTRUCTION{C,P}. + declare module D:DISTINGUISHER{C,P,CO}. + + axiom f_ll : islossless P.f. + axiom fi_ll : islossless P.fi. + + axiom CO_ll : islossless CO(P).f. + + axiom D_ll (F <: DFUNCTIONALITY{D}) (P <: DPRIMITIVE{D}): + islossless P.f => islossless P.fi => islossless F.f => + islossless D(F, P).distinguish. + + lemma Pr_restr &m : + Pr[Indif(FC(CO(P)), PC(P), D).main()@ &m:res /\ C.c <= max_size] <= + Pr[Indif(CO(P), P, DRestr(D)).main()@ &m:res]. + proof. + byequiv (_: ={glob D, glob P, glob CO} ==> C.c{1} <= max_size => ={res})=>//; + 2:by move=> ??H[]?/H<-. + symmetry;proc;inline *;wp;swap{2}1 2. + call (_: max_size < C.c, ={glob P, glob CO, glob C}). + + apply D_ll. + + proc; sp 1 0;if{1};1:by call(_:true);auto. + by call{2} f_ll;auto=>/#. + + by move=> ?_;proc;sp;if;auto;call f_ll;auto. + + by move=> _;proc;call f_ll;auto=>/#. + + proc;sp 1 0;if{1};1:by call(_:true);auto. + by call{2} fi_ll;auto=>/#. + + by move=> ?_;proc;sp;if;auto;call fi_ll;auto. + + by move=> _;proc;call fi_ll;auto=>/#. + + proc;sp 1 0;if{1};1:by call(_: ={glob P});auto;sim. + by call{2} CO_ll;auto=>/#. + + by move=> ?_;proc;sp;if;auto;call CO_ll;auto. + + move=> _;proc;call CO_ll;auto;smt ml=0 w=size_ge0. + wp;call (_:true);call(_:true);auto=>/#. + qed. + +end section COUNT. + +(* -------------------------------------------------------------------------- *) +(** Operators and properties of handles *) +op hinv (handles:handles) (c:capacity) = + find (fun _ => pred1 c \o fst) handles. + +op hinvK (handles:handles) (c:capacity) = + find (fun _ => pred1 c) (restr Known handles). + +op huniq (handles:handles) = + forall h1 h2 cf1 cf2, + handles.[h1] = Some cf1 => + handles.[h2] = Some cf2 => + cf1.`1 = cf2.`1 => h1 = h2. + +lemma hinvP handles c: + if hinv handles c = None then forall h f, handles.[h] <> Some(c,f) + else exists f, handles.[oget (hinv handles c)] = Some(c,f). +proof. + cut @/pred1@/(\o)/=[[h []->[]Hmem <<-]|[]->H h f]/= := + findP (fun (_ : handle) => pred1 c \o fst) handles. + + by exists (oget handles.[h]).`2;rewrite oget_some get_oget;2:case (oget handles.[h]). + cut := H h;rewrite in_dom/#. +qed. + +lemma huniq_hinv (handles:handles) (h:handle): + huniq handles => mem (dom handles) h => hinv handles (oget handles.[h]).`1 = Some h. +proof. + move=> Huniq;pose c := (oget handles.[h]).`1. + cut:=Huniq h;cut:=hinvP handles c. + case (hinv _ _)=> /=[Hdiff _| h' +/(_ h')];1:by rewrite in_dom /#. + by move=> [f ->] /(_ (oget handles.[h]) (c,f)) H1 H2;rewrite H1 // get_oget. +qed. + +lemma hinvKP handles c: + if hinvK handles c = None then forall h, handles.[h] <> Some(c,Known) + else handles.[oget (hinvK handles c)] = Some(c,Known). +proof. + rewrite /hinvK. + cut @/pred1/= [[h]|][->/=]:= findP (+ pred1 c) (restr Known handles). + + by rewrite oget_some in_dom restrP;case (handles.[h])=>//= /#. + by move=>+h-/(_ h);rewrite in_dom restrP => H1/#. +qed. + +lemma huniq_hinvK (handles:handles) c: + huniq handles => mem (rng handles) (c,Known) => handles.[oget (hinvK handles c)] = Some(c,Known). +proof. + move=> Huniq;rewrite in_rng=> -[h]H;case: (hinvK _ _) (Huniq h) (hinvKP handles c)=>//=. + by move=>_/(_ h);rewrite H. +qed. + +lemma huniq_hinvK_h h (handles:handles) c: + huniq handles => handles.[h] = Some (c,Known) => hinvK handles c = Some h. +proof. + move=> Huniq;case: (hinvK _ _) (hinvKP handles c)=>/= [H|h'];1: by apply H. + by rewrite oget_some=> /Huniq H/H. +qed. + +(* -------------------------------------------------------------------------- *) +(** The initial Game *) +module GReal(D:DISTINGUISHER) = RealIndif(SqueezelessSponge, PC(Perm), D). diff --git a/proof/smart_counter/Utils.ec b/proof/smart_counter/Utils.ec new file mode 100644 index 0000000..3f2b506 --- /dev/null +++ b/proof/smart_counter/Utils.ec @@ -0,0 +1,63 @@ +(** These should make it into the standard libs **) +require import Core List FSet NewFMap. + +(* -------------------------------------------------------------------- *) + (* In NewFMap *) + +op reindex (f : 'a -> 'c) (m : ('a, 'b) fmap) = + NewFMap.oflist (map (fun (x : 'a * 'b) => (f x.`1,x.`2)) (elems m)) + axiomatized by reindexE. + + + +lemma dom_reindex (f : 'a -> 'c) (m : ('a, 'b) fmap) x: + mem (dom (reindex f m)) x <=> mem (image f (dom m)) x. +proof. + rewrite reindexE dom_oflist imageP mapP /fst; split. + move=> [[x' y] [+ ->>]]. + rewrite mapP=> -[[x0 y0]] /= [h [->> ->>]] {x' y}. + by exists x0; rewrite domE mem_oflist mapP /fst; exists (x0,y0). + move=> [a] [a_in_m <<-]. + exists (f a,oget m.[a])=> /=; rewrite mapP /=. + exists (a,oget m.[a])=> //=. + have:= a_in_m; rewrite in_dom; case {-1}(m.[a]) (eq_refl m.[a])=> //=. + by move=> y; rewrite getE mem_assoc_uniq 1:uniq_keys. +qed. + + +lemma reindex_injective_on (f : 'a -> 'c) (m : ('a, 'b) fmap): + (forall x y, mem (dom m) x => f x = f y => x = y) => + (forall x, m.[x] = (reindex f m).[f x]). +proof. + move=> f_pinj x. + pose s:= elems (reindex f m). + case (assocP s (f x)). + rewrite -dom_oflist {1}/s elemsK dom_reindex imageP. + move=> [[a]] [] /f_pinj h /(h x) ->> {a}. + rewrite !getE. + move=> [y] [+ ->]. + rewrite /s reindexE. + pose s':= map (fun (x : 'a * 'b) => (f x.`1,x.`2)) (elems m). + have <- := (perm_eq_mem _ _ (oflistK s')). + (** FIXME: make this a lemma **) + have h' /h': forall (s : ('c * 'b) list) x, mem (reduce s) x => mem s x. + rewrite /reduce=> s0 x0; rewrite -{2}(cat0s s0); pose acc:= []. + elim s0 acc x0=> {s'} [acc x0 /=|x' s' ih acc x0 /=]. + by rewrite cats0. + move=> /ih; rewrite -cat1s catA cats1 !mem_cat=> -[|-> //=]. + rewrite /augment; case (mem (map fst acc) x'.`1)=> _ h'; left=> //. + by rewrite mem_rcons /=; right. + rewrite /s' mapP=> -[[a' b']] /= [xy_in_m []]. + rewrite eq_sym. have h0 /h0 ->> <<- {a' b'}:= f_pinj a' x _; 1:by smt. + by apply/mem_assoc_uniq; 1:exact uniq_keys. + rewrite -mem_oflist {1}/s -domE=> -[] h; have := h; rewrite dom_reindex. + rewrite imageP=> h'. have {h'} h': forall (a : 'a), !mem (dom m) a \/ f a <> f x by smt. + have /= := h' x. + rewrite in_dom !getE /=. + by move=> -> ->. +qed. + +lemma reindex_injective (f : 'a -> 'c) (m : ('a, 'b) fmap): + injective f => + (forall x, m.[x] = (reindex f m).[f x]). +proof. by move=> f_inj; apply/reindex_injective_on=> + + _. qed. From 2ec61e80eda6a442ab19a16b85dc6e476d70bafb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Tue, 23 Jan 2018 20:23:13 +0100 Subject: [PATCH 261/525] . --- proof/smart_counter/ConcreteF.eca | 58 ++++++-- proof/smart_counter/Handle.eca | 2 +- proof/smart_counter/SLCommon.ec | 229 +++++++++++++++++++++++++----- 3 files changed, 238 insertions(+), 51 deletions(-) diff --git a/proof/smart_counter/ConcreteF.eca b/proof/smart_counter/ConcreteF.eca index 89fb7ce..8cf3f69 100644 --- a/proof/smart_counter/ConcreteF.eca +++ b/proof/smart_counter/ConcreteF.eca @@ -56,8 +56,8 @@ section. type K <- unit, op dK <- (MUnit.dunit<:unit> tt), op q <- max_size - proof *. - realize ge0_q by smt w=max_ge0. + proof *. + realize ge0_q by rewrite max_ge0. realize uD_uf_fu. split. case=> [x y]; rewrite supp_dprod /=. @@ -77,24 +77,56 @@ section. lemma size_behead (l : 'a list) : l <> [] => size (behead l) = size l - 1. proof. by case l=> // ?? /=; ring. qed. + local module CP' (P' : PRPt.Oracles) = { + proc f (x : state) = { + var y <- (b0,c0); + if (!x \in dom C.m) { + y <@ P'.f(x); + C.m.[x] <- y; + C.mi.[y] <- x; + } else { + y <- oget C.m.[x]; + } + return y; + } + proc fi (x : state) = { + var y <- (b0,c0); + if (!x \in dom C.mi) { + y <@ P'.f(x); + C.mi.[x] <- y; + C.m.[y] <- x; + } else { + y <- oget C.mi.[x]; + } + return y; + } + }. + local module (D': PRPt.Distinguisher) (P' : PRPt.Oracles) = { - proc distinguish = DRestr(D,SqueezelessSponge(P'),P').distinguish + proc distinguish = DRestr(D,SqueezelessSponge(CP'(P')),P').distinguish }. + + local lemma DoubleBounding (P <: PRPt.StrongPRP {D, C, DBounder}) &m: Pr[PRPt.IND(P,D').main() @ &m: res] = Pr[PRPt.IND(P,DBounder(D')).main() @ &m: res]. proof. byequiv=> //=; proc; inline *. - wp. - call (_: ={glob C, glob P} /\ DBounder.FBounder.c{2} = C.c{2}). - + proc; sp; if=> //=; inline *. - rcondt{2} 4; 1: by auto=> /#. - by wp; call (_: true); auto. - + proc; sp; if=> //=; inline *. - rcondt{2} 4; 1: by auto=> /#. - by wp; call (_: true); auto. - + proc; sp; if=> //=; inline *. + wp. print prefixe_inv. + call (_: ={glob C, glob P} + /\ prefixe_inv C.queries{1} C.m{1} + /\ ={m,mi}(C,DBounder.FBounder) + /\ DBounder.FBounder.c{2} <= C.c{2}). + + proc; sp; if;auto;if=> //=; inline *. + rcondt{2} 3; 1: by auto=> /#. + rcondt{2} 4;first by auto;call(:true);auto. + by wp; call (_: true); auto;smt(prefixe_inv_set). + + proc; sp; if; auto; if=> //=; inline *. + rcondt{2} 3; 1: by auto=> /#. + rcondt{2} 4;first by auto;call(:true);auto. + wp; call (_: true); auto;progress. smt. admit. admit. + + proc; sp; if; auto; if=> //=; inline *. wp; while ( ={glob C, glob P, p, sa, sc} /\ C.c{2} <= max_size /\ DBounder.FBounder.c{2} = C.c{2} - size p{2}). @@ -112,7 +144,7 @@ section. lemma Real_Concrete &m : Pr[GReal(D).main()@ &m: res /\ C.c <= max_size] <= - Pr[CF(DRestr(D)).main()@ &m: res] + (max_size ^ 2)%r * mu dstate (pred1 witness). + Pr[CF(DRestr(D)).main()@ &m: res] + (max_size ^ 2)%r * inv 2%r * mu dstate (pred1 witness). proof. cut->: Pr[RealIndif(SqueezelessSponge,PC(Perm),D).main()@ &m: diff --git a/proof/smart_counter/Handle.eca b/proof/smart_counter/Handle.eca index 1694dc7..6dbc866 100644 --- a/proof/smart_counter/Handle.eca +++ b/proof/smart_counter/Handle.eca @@ -1846,7 +1846,7 @@ section. lemma Real_G1 &m: Pr[GReal(D).main() @ &m: res /\ C.c <= max_size] <= - Pr[G1(DRestr(D)).main() @ &m: res] + (max_size ^ 2)%r * mu dstate (pred1 witness) + + Pr[G1(DRestr(D)).main() @ &m: res] + (max_size ^ 2)%r * inv 2%r * mu dstate (pred1 witness) + Pr[G1(DRestr(D)).main() @&m: G1.bcol] + Pr[G1(DRestr(D)).main() @&m: G1.bext]. proof. apply (@RealOrder.ler_trans _ _ _ (Real_Concrete D D_ll &m)). diff --git a/proof/smart_counter/SLCommon.ec b/proof/smart_counter/SLCommon.ec index 8453ae9..9f4b155 100644 --- a/proof/smart_counter/SLCommon.ec +++ b/proof/smart_counter/SLCommon.ec @@ -223,8 +223,143 @@ op get_max_prefixe (l : 'a list) (ll : 'a list list) = with ll = (::) l' ll' => max_prefixe l l' ll'. +pred invm (m mi : ('a * 'b, 'a * 'b) fmap) = + forall x y, m.[x] = Some y <=> mi.[y] = Some x. +print foldl. + + +op blocksponge (l : block list) (m : (state, state) fmap) (bc : state) = + with l = "[]" => (l,bc) + with l = (::) b' l' => + let (b,c) = (bc.`1,bc.`2) in + if ((b +^ b', c) \in dom m) then blocksponge l' m (oget m.[(b +^ b', c)]) + else (l,(b,c)). + +op s0 : state = (b0,c0). + +lemma blocksponge_size_leq l m bc : + size (blocksponge l m bc).`1 <= size l. +proof. +move:m bc;elim l=>//=. +move=>e l Hind m bc/#. +qed. + + +lemma blocksponge_set l m bc x y : + (x \in dom m => y = oget m.[x]) => + let bs1 = blocksponge l m bc in + let bs2 = blocksponge l m.[x <- y] bc in + let l1 = bs1.`1 in let l2 = bs2.`1 in let bc1 = bs1.`2 in let bc2 = bs2.`2 in + size l2 <= size l1 /\ (size l1 = size l2 => (l1 = l2 /\ bc1 = bc2)). +proof. +move=>Hxy/=;split. ++ move:m bc x y Hxy;elim l=>//=. + move=>/=e l Hind m bc x y Hxy/=;rewrite dom_set in_fsetU1. + case((bc.`1 +^ e, bc.`2) = x)=>//=[->//=|hx]. + + rewrite getP/=oget_some;case(x\in dom m)=>//=[/#|]. + smt(blocksponge_size_leq getP). + rewrite getP hx/=. + case((bc.`1 +^ e, bc.`2) \in dom m)=>//=Hdom. + by cut//:=Hind m (oget m.[(bc.`1 +^ e, bc.`2)]) x y Hxy. +move:m bc x y Hxy;elim l=>//=. +move=>e l Hind m bx x y Hxy. +rewrite!dom_set !in_fsetU1 !getP. +case((bx.`1 +^ e, bx.`2) \in dom m)=>//=Hdom. ++ case(((bx.`1 +^ e, bx.`2) = x))=>//=Hx. + + move:Hdom;rewrite Hx=>Hdom. + cut:=Hxy;rewrite Hdom/==>Hxy2. + rewrite oget_some -Hxy2/=. + by cut:=Hind m y x y Hxy. + by cut:=Hind m (oget m.[(bx.`1 +^ e, bx.`2)]) x y Hxy. +case(((bx.`1 +^ e, bx.`2) = x))=>//=;smt(blocksponge_size_leq). +qed. + + +lemma blocksponge_cat m l1 l2 bc : + blocksponge (l1 ++ l2) m bc = + let lbc = blocksponge l1 m bc in + blocksponge (lbc.`1 ++ l2) m (lbc.`2). +proof. +rewrite/=. +move:m bc l2;elim l1=>//= e1 l1 Hind m bc b. +case((bc.`1 +^ e1, bc.`2) \in dom m)=>//=[|->//=]Hdom. +by cut//:=Hind m (oget m.[(bc.`1 +^ e1, bc.`2)]) b. +qed. + + +lemma blocksponge_rcons m l bc b : + blocksponge (rcons l b) m bc = + let lbc = blocksponge l m bc in + blocksponge (rcons lbc.`1 b) m (lbc.`2). +proof. +by rewrite/=-2!cats1 blocksponge_cat/=. +qed. + + +pred prefixe_inv (queries : (block list, block) fmap) + (m : (state, state) fmap) = + forall (bs : block list), + bs \in dom queries => + forall i, 0 <= i < size bs => + let bc = (blocksponge (take i bs) m s0).`2 in + (bc.`1 +^ nth b0 bs i, bc.`2) \in dom m. + + + +lemma prefixe_inv_bs_fst_nil queries m : + prefixe_inv queries m => + forall l, l \in dom queries => + forall i, 0 <= i <= size l => + (blocksponge (take i l) m s0).`1 = []. +proof. +move=>Hinv l Hdom i [Hi0 Hisize];move:i Hi0 l Hisize Hdom;apply intind=>//=. ++ by move=>l;rewrite take0/=. +move=>i Hi0 Hind l Hil Hldom. +rewrite(take_nth b0)1:/#. +rewrite blocksponge_rcons/=. +cut->/=:=Hind l _ Hldom;1:rewrite/#. +by cut/=->/=:=Hinv _ Hldom i _;1:rewrite/#. +qed. + + +lemma prefixe_inv_set queries m x y : + !x \in dom m => + prefixe_inv queries m => + prefixe_inv queries m.[x <- y]. +proof. +move=>Hxdom Hpref bs/=Hbsdom i [Hi0 Hisize]. +cut->:blocksponge (take i bs) m.[x <- y] s0 = blocksponge (take i bs) m s0. ++ move:i Hi0 bs Hisize Hbsdom;apply intind=>//=i;first by rewrite take0//=. + move=>Hi0 Hind bs Hsize Hbsdom. + rewrite (take_nth b0)1:/#. + rewrite 2!blocksponge_rcons/=. + cut->/=:=prefixe_inv_bs_fst_nil _ _ Hpref _ Hbsdom i _;1:rewrite/#. + cut/=->/=:=Hpref _ Hbsdom i _;1:rewrite/#. + cut->/=:=Hind bs _ Hbsdom;1:rewrite/#. + cut->/=:=prefixe_inv_bs_fst_nil _ _ Hpref _ Hbsdom i _;1:rewrite/#. + rewrite dom_set in_fsetU1. + cut/=->/=:=Hpref _ Hbsdom i _;1:rewrite/#. + rewrite getP. + cut/#:=Hpref _ Hbsdom i _;1:rewrite/#. +rewrite dom_set in_fsetU1. +cut/#:=Hpref _ Hbsdom i _;1:rewrite/#. +qed. + + +lemma size_blocksponge queries m l : + prefixe_inv queries m => + size (blocksponge l m s0).`1 <= size l - prefixe l (get_max_prefixe l (elems (dom queries))). +proof. +move=>Hinv. +pose l2:=get_max_prefixe _ _;pose p:=prefixe _ _. search take drop. +rewrite-{1}(cat_take_drop p l)blocksponge_cat/=. +rewrite(prefixe_take). + +qed. + end Prefixe. +export Prefixe. (* -------------------------------------------------------------------------- *) @@ -232,10 +367,12 @@ module C = { var c : int var m : (state, state) fmap var mi : (state, state) fmap + var queries : (block list, block) fmap proc init () = { - c <- 0; - m <- map0; - mi <- map0; + c <- 0; + m <- map0; + mi <- map0; + queries <- map0; } }. @@ -247,23 +384,27 @@ module PC (P:PRIMITIVE) = { } proc f (x:state) = { - var y; - y <@ P.f(x); + var y <- (b0,c0); if (!x \in dom C.m) { + y <@ P.f(x); C.c <- C.c + 1; C.m.[x] <- y; C.mi.[y] <- x; + } else { + y <- oget C.m.[x]; } return y; } proc fi(x:state) = { - var y; - y <@ P.fi(x); + var y <- (b0,c0); if (!x \in dom C.mi) { + y <@ P.fi(x); C.c <- C.c + 1; C.mi.[x] <- y; C.m.[y] <- x; + } else { + y <- oget C.mi.[x]; } return y; } @@ -273,27 +414,31 @@ module PC (P:PRIMITIVE) = { module DPRestr (P:DPRIMITIVE) = { proc f (x:state) = { - var y=(b0,c0); - if (C.c + 1 <= max_size) { - y <@ P.f(x); - if (!x \in dom C.m) { + var y <- (b0,c0); + if (!x \in dom C.m) { + if (C.c + 1 <= max_size) { + y <@ P.f(x); C.c <- C.c + 1; C.m.[x] <- y; C.mi.[y] <- x; } + } else { + y <- oget C.m.[x]; } return y; } proc fi(x:state) = { - var y=(b0,c0); - if (C.c + 1 <= max_size) { - y <@ P.fi(x); - if (!x \in dom C.mi) { + var y <- (b0,c0); + if (!x \in dom C.mi) { + if (C.c + 1 <= max_size) { + y <@ P.fi(x); C.c <- C.c + 1; C.mi.[x] <- y; C.m.[y] <- x; } + } else { + y <- oget C.mi.[x]; } return y; } @@ -318,9 +463,14 @@ module FC(F:FUNCTIONALITY) = { proc init = F.init proc f (bs:block list) = { - var b= b0; - C.c <- C.c + size bs; - b <@ F.f(bs); + var b <- b0; + if (!bs \in dom C.queries) { + C.c <- C.c + size bs - prefixe bs (get_max_prefixe bs (elems (dom C.queries))); + b <@ F.f(bs); + C.queries.[bs] <- b; + } else { + b <- oget C.queries.[bs]; + } return b; } }. @@ -329,9 +479,14 @@ module DFRestr(F:DFUNCTIONALITY) = { proc f (bs:block list) = { var b= b0; - if (C.c + size bs <= max_size) { - C.c <- C.c + size bs; - b <@ F.f(bs); + if (!bs \in dom C.queries) { + if (C.c + size bs - prefixe bs (get_max_prefixe bs (elems (dom C.queries))) <= max_size) { + C.c <- C.c + size bs - prefixe bs (get_max_prefixe bs (elems (dom C.queries))); + b <@ F.f(bs); + C.queries.[bs] <- b; + } + } else { + b <- oget C.queries.[bs]; } return b; } @@ -356,14 +511,14 @@ module DRestr(D:DISTINGUISHER, F:DFUNCTIONALITY, P:DPRIMITIVE) = { } }. -lemma rp_ll (P<:DPRIMITIVE): islossless P.f => islossless DPRestr(P).f. -proof. move=>Hll;proc;sp;if=>//;call Hll;auto. qed. +lemma rp_ll (P<:DPRIMITIVE{C}): islossless P.f => islossless DPRestr(P).f. +proof. move=>Hll;proc;sp;if;auto;if;auto;call Hll;auto. qed. -lemma rpi_ll (P<:DPRIMITIVE): islossless P.fi => islossless DPRestr(P).fi. -proof. move=>Hll;proc;sp;if=>//;call Hll;auto. qed. +lemma rpi_ll (P<:DPRIMITIVE{C}): islossless P.fi => islossless DPRestr(P).fi. +proof. move=>Hll;proc;sp;if;auto;if;auto;call Hll;auto. qed. -lemma rf_ll (F<:DFUNCTIONALITY): islossless F.f => islossless DFRestr(F).f. -proof. move=>Hll;proc;sp;if=>//;call Hll;auto. qed. +lemma rf_ll (F<:DFUNCTIONALITY{C}): islossless F.f => islossless DFRestr(F).f. +proof. move=>Hll;proc;sp;if;auto;if=>//;auto;call Hll;auto. qed. lemma DRestr_ll (D<:DISTINGUISHER{C}): (forall (F<:DFUNCTIONALITY{D})(P<:DPRIMITIVE{D}), @@ -390,7 +545,7 @@ section RESTR. Pr[Indif(F,P,DRestr(D)).main()@ &m: res]. proof. byequiv=>//. - proc;inline *;wp;swap{1}1 2;sim. + proc;inline *;wp;swap{1}1 2;sim;auto;call(:true);auto;call(:true);auto. qed. end section RESTR. @@ -419,18 +574,18 @@ section COUNT. symmetry;proc;inline *;wp;swap{2}1 2. call (_: max_size < C.c, ={glob P, glob CO, glob C}). + apply D_ll. - + proc; sp 1 0;if{1};1:by call(_:true);auto. + + proc; sp;if;auto;if{1};1:by auto;call(_:true);auto. by call{2} f_ll;auto=>/#. - + by move=> ?_;proc;sp;if;auto;call f_ll;auto. - + by move=> _;proc;call f_ll;auto=>/#. - + proc;sp 1 0;if{1};1:by call(_:true);auto. + + by move=> ?_;proc;sp;if;auto;if;auto;call f_ll;auto. + + by move=> _;proc;sp;if;auto;call f_ll;auto=>/#. + + proc;sp;if;auto;if{1};1:by auto;call(_:true);auto. by call{2} fi_ll;auto=>/#. - + by move=> ?_;proc;sp;if;auto;call fi_ll;auto. - + by move=> _;proc;call fi_ll;auto=>/#. - + proc;sp 1 0;if{1};1:by call(_: ={glob P});auto;sim. + + by move=> ?_;proc;sp;if;auto;if;auto;call fi_ll;auto. + + by move=> _;proc;sp;if;auto;call fi_ll;auto=>/#. + + proc;inline*;sp 1 1;if;auto;if{1};auto;1:by call(_: ={glob P});auto;sim. by call{2} CO_ll;auto=>/#. - + by move=> ?_;proc;sp;if;auto;call CO_ll;auto. - + move=> _;proc;call CO_ll;auto;smt ml=0 w=size_ge0. + + by move=> ?_;proc;sp;if;auto;if;auto;call CO_ll;auto. + + by move=> _;proc;sp;if;auto;call CO_ll;auto;smt(prefixe_sizel). wp;call (_:true);call(_:true);auto=>/#. qed. From fe962eb790beee8d72d215277718360eefc68013 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Wed, 7 Feb 2018 17:40:24 +0100 Subject: [PATCH 262/525] . --- proof/smart_counter/ConcreteF.eca | 270 ++++++++++++++++++++++++++++-- proof/smart_counter/Handle.eca | 8 +- proof/smart_counter/SLCommon.ec | 57 +++++-- 3 files changed, 303 insertions(+), 32 deletions(-) diff --git a/proof/smart_counter/ConcreteF.eca b/proof/smart_counter/ConcreteF.eca index 8cf3f69..8565349 100644 --- a/proof/smart_counter/ConcreteF.eca +++ b/proof/smart_counter/ConcreteF.eca @@ -19,8 +19,10 @@ module PF = { if (!mem (dom m) x) { y1 <$ bdistr; y2 <$ cdistr; + if (!(y1,y2) \in dom mi) { + mi.[(y1,y2)] <- x; + } m.[x] <- (y1,y2); - mi.[(y1,y2)] <- x; } return oget m.[x]; } @@ -31,8 +33,10 @@ module PF = { if (!mem (dom mi) x) { y1 <$ bdistr; y2 <$ cdistr; + if (!(y1,y2) \in dom m) { + m.[(y1,y2)] <- x; + } mi.[x] <- (y1,y2); - m.[(y1,y2)] <- x; } return oget mi.[x]; } @@ -82,8 +86,10 @@ section. var y <- (b0,c0); if (!x \in dom C.m) { y <@ P'.f(x); + if (!y \in dom C.mi) { + C.mi.[y] <- x; + } C.m.[x] <- y; - C.mi.[y] <- x; } else { y <- oget C.m.[x]; } @@ -93,8 +99,10 @@ section. var y <- (b0,c0); if (!x \in dom C.mi) { y <@ P'.f(x); + if (!y \in dom C.m) { + C.m.[y] <- x; + } C.mi.[x] <- y; - C.m.[y] <- x; } else { y <- oget C.mi.[x]; } @@ -106,14 +114,14 @@ section. proc distinguish = DRestr(D,SqueezelessSponge(CP'(P')),P').distinguish }. - +print DRestr. local lemma DoubleBounding (P <: PRPt.StrongPRP {D, C, DBounder}) &m: Pr[PRPt.IND(P,D').main() @ &m: res] = Pr[PRPt.IND(P,DBounder(D')).main() @ &m: res]. proof. byequiv=> //=; proc; inline *. - wp. print prefixe_inv. + wp. call (_: ={glob C, glob P} /\ prefixe_inv C.queries{1} C.m{1} /\ ={m,mi}(C,DBounder.FBounder) @@ -125,15 +133,231 @@ section. + proc; sp; if; auto; if=> //=; inline *. rcondt{2} 3; 1: by auto=> /#. rcondt{2} 4;first by auto;call(:true);auto. - wp; call (_: true); auto;progress. smt. admit. admit. + wp; call (_: true); auto;progress. + + smt(prefixe_inv_set). + + rewrite/#. + + rewrite/#. + proc; sp; if; auto; if=> //=; inline *. - wp; while ( ={glob C, glob P, p, sa, sc} - /\ C.c{2} <= max_size - /\ DBounder.FBounder.c{2} = C.c{2} - size p{2}). - rcondt{2} 3; 1: by auto; smt w=size_ge0. - by wp; call (_: true); auto=> /#. - by auto; progress; ring. - by wp; call (_: true). + splitwhile{1} 4 : (sa +^ head witness p, sc) \in dom C.m. + splitwhile{2} 4 : (sa +^ head witness p, sc) \in dom C.m. + wp=>//=;swap 1 4;wp=>//=. + conseq(:_==> ={sa, C.mi, C.m, glob P} /\ C.m{1} = DBounder.FBounder.m{2} + /\ C.mi{1} = DBounder.FBounder.mi{2} + /\ prefixe_inv C.queries{1} C.m{1} + /\ DBounder.FBounder.c{2} <= C.c{2} + size bs{2} - + prefixe bs{2} (get_max_prefixe bs{2} (elems (dom C.queries{2}))) + /\ (forall (i : int), + 0 <= i < size bs{2} => + let bc = (blocksponge (take i bs{2}) C.m{1} s0).`2 in + (bc.`1 +^ nth b0 bs{2} i, bc.`2) \in dom C.m{1})); + 1:smt(dom_set in_fsetU1). + + while(={sa, sc, C.mi, C.m, glob P, p, bs, C.c, C.queries} + /\ C.m{1} = DBounder.FBounder.m{2} + /\ C.mi{1} = DBounder.FBounder.mi{2} + /\ (exists i, p{2} = drop i bs{2} /\ 0 <= i <= size bs{2} + /\ blocksponge (take i bs{2}) C.m{1} s0 = ([], (sa{1},sc{1}))) + /\ prefixe_inv C.queries{1} C.m{1} + /\ C.c{1} + size bs{1} - prefixe bs{1} + (get_max_prefixe bs{1} (elems (dom C.queries{1}))) <= max_size + /\ DBounder.FBounder.c{2} <= C.c{2} + size bs{2} - size p{2} - + prefixe bs{2} (get_max_prefixe bs{2} (elems (dom C.queries{2}))) + /\ (forall (i : int), + 0 <= i < size bs{2} - size p{2} => + let bc = (blocksponge (take i bs{2}) C.m{1} s0).`2 in + (bc.`1 +^ nth b0 bs{2} i, bc.`2) \in dom C.m{1}) + /\ (forall (i : int), + 0 <= i < size bs{2} - size p{2} => + (blocksponge (take i bs{2}) C.m{1} s0).`1 = [])). + + sp;if;1,3:auto;last first;progress. + - exists (i+1);rewrite(drop_nth witness)//=;2:split;1,2:smt(drop_oversize). + rewrite (take_nth witness);1:smt(drop_oversize). + move:H9;rewrite (drop_nth witness)/=;1:smt(drop_oversize). + move=>?. + rewrite blocksponge_rcons H1/=H9/=/#. + - rewrite size_behead//=/#. + - move:H11;rewrite size_behead//=. + case(i0 < size bs{2} - size (drop i bs{2}))=>[/#|]h h1. + cut->:i0 = size bs{2} - size (drop i bs{2}) by rewrite/#. + rewrite size_drop//=max_ler 1:/#/=. + cut->:(size bs{2} - (size bs{2} - i)) = i by ring. + rewrite H1/=. + by move:H9;rewrite (drop_nth b0)/=;1:smt(drop_oversize). + - move:H11;rewrite size_behead//=. + case(i0 < size bs{2} - size (drop i bs{2}))=>[/#|]h h1. + cut->:i0 = size bs{2} - size (drop i bs{2}) by rewrite/#. + rewrite size_drop//=max_ler 1:/#/=. + cut->:(size bs{2} - (size bs{2} - i)) = i by ring. + by rewrite H1/=. + + rcondt{2}3;1:(auto;smt(size_ge0 size_eq0)). + rcondt{2}4;1:by auto;call(:true);auto. + wp;call(:true);auto;progress. + - exists (i+1);rewrite(drop_nth witness)//=;2:split;1,2:smt(drop_oversize). + rewrite (take_nth witness);1:smt(drop_oversize). + move:H9;rewrite (drop_nth witness)/=;1:smt(drop_oversize). + move=>h. + rewrite blocksponge_rcons/=. + cut/=:=blocksponge_set_nil (take i bs{2}) DBounder.FBounder.m{2} s0 + (sa{2} +^ nth witness bs{2} i, sc{2}) result_R h. + rewrite H1/=/==>->/=;rewrite dom_set in_fsetU1/=getP/=oget_some/#. + - smt(prefixe_inv_set). + - smt(size_ge0 size_eq0). + - move:H12;rewrite size_behead//==>?. + move:H9;rewrite (drop_nth witness)/=;1:smt(drop_oversize). + move=>h. + case(i0 < size bs{2} - size (drop i bs{2}))=>[|]?. + + cut//=->/=:=blocksponge_set_nil (take i0 bs{2}) DBounder.FBounder.m{2} s0 + (sa{2} +^ nth witness bs{2} i, sc{2}) result_R h (H6 i0 _);1:rewrite/#. + by rewrite dom_set in_fsetU1/#. + cut hii0:i0=i by move:H9 H12;rewrite!size_drop//=max_ler /#. + rewrite hii0. + cut//=:=blocksponge_set_nil (take i bs{2}) DBounder.FBounder.m{2} s0 + (sa{2} +^ nth witness bs{2} i, sc{2}) result_R h. + rewrite H1/==>->/=;rewrite dom_set in_fsetU1//=;right;congr. + by rewrite nth_onth (onth_nth witness)//=;smt(size_ge0 size_eq0). + + move:H9;rewrite (drop_nth witness)/=;1:smt(drop_oversize). + move=>h. + case(i0 < size bs{2} - size (drop i bs{2}))=>[|]?. + + smt(blocksponge_set_nil). + cut hii0:i0=i by move:H12;rewrite size_behead//==>?; + move:H9 H12;rewrite!size_drop//=max_ler /#. + rewrite hii0;smt(blocksponge_set_nil). + + exists (i+1);rewrite(drop_nth witness)//=;2:split;1,2:smt(drop_oversize). + rewrite (take_nth witness);1:smt(drop_oversize). + move:H9;rewrite (drop_nth witness)/=;1:smt(drop_oversize). + move=>h. + rewrite blocksponge_rcons/=. + cut/=:=blocksponge_set_nil (take i bs{2}) DBounder.FBounder.m{2} s0 + (sa{2} +^ nth witness bs{2} i, sc{2}) result_R h. + rewrite H1/=/==>->/=;rewrite dom_set in_fsetU1/=getP/=oget_some/#. + - smt(prefixe_inv_set). + - smt(size_ge0 size_eq0). + - move:H12;rewrite size_behead//==>?. + move:H9;rewrite (drop_nth witness)/=;1:smt(drop_oversize). + move=>h. + case(i0 < size bs{2} - size (drop i bs{2}))=>[|]?. + + cut//=->/=:=blocksponge_set_nil (take i0 bs{2}) DBounder.FBounder.m{2} s0 + (sa{2} +^ nth witness bs{2} i, sc{2}) result_R h (H6 i0 _);1:rewrite/#. + by rewrite dom_set in_fsetU1/#. + cut hii0:i0=i by move:H9 H12;rewrite!size_drop//=max_ler /#. + rewrite hii0. + cut//=:=blocksponge_set_nil (take i bs{2}) DBounder.FBounder.m{2} s0 + (sa{2} +^ nth witness bs{2} i, sc{2}) result_R h. + rewrite H1/==>->/=;rewrite dom_set in_fsetU1//=;right;congr. + by rewrite nth_onth (onth_nth witness)//=;smt(size_ge0 size_eq0). + + move:H9;rewrite (drop_nth witness)/=;1:smt(drop_oversize). + move=>h. + case(i0 < size bs{2} - size (drop i bs{2}))=>[|]?. + + smt(blocksponge_set_nil). + cut hii0:i0=i by move:H12;rewrite size_behead//==>?; + move:H9 H12;rewrite!size_drop//=max_ler /#. + rewrite hii0;smt(blocksponge_set_nil). + + conseq(:_==> ={sa, sc, C.mi, C.m, glob P, p, bs, C.c, C.queries} + /\ C.m{1} = DBounder.FBounder.m{2} + /\ C.mi{1} = DBounder.FBounder.mi{2} + /\ (exists i, p{2} = drop i bs{2} /\ 0 <= i <= size bs{2} + /\ blocksponge (take i bs{2}) C.m{1} s0 = ([], (sa{1},sc{1}))) + /\ prefixe_inv C.queries{1} C.m{1} + /\ C.c{1} + size bs{1} - prefixe bs{1} + (get_max_prefixe bs{1} (elems (dom C.queries{1}))) <= max_size + /\ DBounder.FBounder.c{2} <= C.c{2} + size bs{2} - size p{2} - + prefixe bs{2} (get_max_prefixe bs{2} (elems (dom C.queries{2}))) + /\ (forall (i : int), + 0 <= i < size bs{2} - size p{2} => + let bc = (blocksponge (take i bs{2}) C.m{1} s0).`2 in + (bc.`1 +^ nth b0 bs{2} i, bc.`2) \in dom C.m{1}) + /\ (forall (i : int), + 0 <= i < size bs{2} - size p{2} => + (blocksponge (take i bs{2}) C.m{1} s0).`1 = []));1:rewrite/#. + + alias{2} 1 k = DBounder.FBounder.c;sp 0 1. + alias{2} 1 dm = DBounder.FBounder.m;sp 0 1. + alias{2} 1 dmi = DBounder.FBounder.mi;sp 0 1. + alias{2} 1 cm = C.m;sp 0 1. + alias{2} 1 cmi = C.mi;sp 0 1. + conseq(:_==> ={sa, sc, C.mi, C.m, glob P, p, bs, C.c} + /\ C.m{1} = cm{2} + /\ DBounder.FBounder.m{2} = dm{2} + /\ C.mi{1} = cmi{2} + /\ DBounder.FBounder.mi{2} = dmi{2} + /\ (exists i, p{2} = drop i bs{2} /\ 0 <= i <= size bs{2} + /\ blocksponge (take i bs{2}) C.m{1} s0 = ([], (sa{1},sc{1}))) + /\ prefixe bs{1} (get_max_prefixe bs{1} (elems (dom C.queries{1}))) <= size bs{1} - size p{1} + /\ DBounder.FBounder.c{2} = k{2} + /\ (forall (i : int), + 0 <= i < size bs{2} - size p{2} => + let bc = (blocksponge (take i bs{2}) C.m{1} s0).`2 in + (bc.`1 +^ nth b0 bs{2} i, bc.`2) \in dom C.m{1}) + /\ (forall (i : int), + 0 <= i < size bs{2} - size p{2} => + (blocksponge (take i bs{2}) C.m{1} s0).`1 = []));progress. + + rewrite/#. + + smt(size_ge0 size_drop). + + while(={sa, sc, C.mi, C.m, glob P, p, bs, C.c} + /\ prefixe_inv C.queries{1} C.m{1} + /\ C.m{1} = cm{2} + /\ DBounder.FBounder.m{2} = dm{2} + /\ C.mi{1} = cmi{2} + /\ DBounder.FBounder.mi{2} = dmi{2} + /\ (exists i, p{2} = drop i bs{2} /\ 0 <= i <= size bs{2} + /\ blocksponge (take i bs{2}) C.m{1} s0 = ([], (sa{1},sc{1}))) + /\ DBounder.FBounder.c{2} = k{2} + /\ (forall (i : int), + 0 <= i < size bs{2} - size p{2} => + let bc = (blocksponge (take i bs{2}) C.m{1} s0).`2 in + (bc.`1 +^ nth b0 bs{2} i, bc.`2) \in dom C.m{1}) + /\ (forall (i : int), + 0 <= i < size bs{2} - size p{2} => + (blocksponge (take i bs{2}) C.m{1} s0).`1 = []));last first. + + auto;progress. + smt(drop0 size_ge0). + smt(drop0 size_ge0). + smt(drop0 size_ge0). + smt(drop0 size_ge0). + move:H4;rewrite negb_and/==>[]. + case(drop i bs{2} = [])=>[hdropi|hdropi]//=. + + rewrite hdropi/=;smt(prefixe_sizel). + rewrite size_drop//=max_ler 1:/#. + cut->:size bs{2} - (size bs{2} - i) = i by rewrite/#. + rewrite(drop_nth b0)//=;1:smt(size_ge0 size_eq0 size_drop). print prefixe_inv. + apply absurd=>//=hi. + cut->:nth b0 bs{2} i = nth b0 (get_max_prefixe bs{2} (elems (dom C.queries{2}))) i. + + rewrite 2!nth_onth (onth_nth witness);1:smt(size_drop size_eq0). + cut/=h:=prefixe_nth bs{2} (get_max_prefixe bs{2} (elems (dom C.queries{2}))). + cut->:=h i _;1:smt(size_drop size_eq0). + by rewrite (onth_nth witness)/=;1:smt(size_drop size_eq0 prefixe_sizer). + cut:=H (get_max_prefixe bs{2} (elems (dom C.queries{2}))) _;last first. + + move=>h;cut:=h i _;1:smt(prefixe_sizer). + cut:=H8;cut->/#:(take i bs{2}) = (take i (get_max_prefixe bs{2} (elems (dom C.queries{2})))). + by apply (eq_from_nth b0 _ _ _ _); + smt(size_take prefixe_sizer prefixe_sizel nth_take prefixe_nth nth_onth onth_nth). + cut h:forall (l1 l2:block list) ll, max_prefixe l1 l2 ll = l2 \/ max_prefixe l1 l2 ll \in ll. + + clear P &m &1 &2 H H0 H H1 H2 P_R sa_R sc_R H5 i H3 H6 H7 H8 H9 H10 hdropi hi. + by move=>l1 l2 ll;move:ll l1 l2;move=>ll;elim:ll=>//=/#. + cut h1:forall (l : block list) ll, get_max_prefixe l ll <> [] => ll <> []. + + clear P &m &1 &2 H H0 H H1 H2 P_R sa_R sc_R H5 i H3 H6 H7 H8 H9 H10 hdropi hi. + by move=>l ll;move:ll l=>ll;elim:ll=>//=. + rewrite memE;smt(prefixe_sizer). + sp;rcondf{1}1;2:rcondf{2}1;auto;progress. + - exists (i+1);rewrite(drop_nth witness)//=;2:split;1,2:smt(drop_oversize). + rewrite (take_nth witness);1:smt(drop_oversize). + move:H8;rewrite (drop_nth witness)/=;1:smt(drop_oversize). + move=>h. + rewrite blocksponge_rcons/=H2/=h/=/#. + - move:H10;rewrite size_behead//=. + case(i0 < size bs{2} - size (drop i bs{2}))=>??;1:rewrite/#. + cut hii0:i0=i by smt(size_drop). + rewrite hii0 H2/=. + move:H8;rewrite (drop_nth witness)/=;1:smt(drop_oversize). + by rewrite nth_onth (onth_nth b0)/=;1:smt(size_eq0). + - move:H10;rewrite size_behead//=. + case(i0 < size bs{2} - size (drop i bs{2}))=>??;1:rewrite/#. + cut hii0:i0=i by smt(size_drop). + by rewrite hii0 H2/=. + auto;progress;call(:true);auto;smt(dom0 in_fset0). qed. local clone import ProdSampling with @@ -149,9 +373,23 @@ section. cut->: Pr[RealIndif(SqueezelessSponge,PC(Perm),D).main()@ &m: res /\ C.c <= max_size] = Pr[GReal'.main()@ &m: res/\ C.c <= max_size]. - + byequiv=>//;proc;inline *;call (_: ={C.c,glob Perm});last by auto. - + by sim. + by sim. + + byequiv=>//;proc;inline *;call (_: ={glob C,glob Perm} + /\ prefixe_inv C.queries{1} Perm.m{1} /\ inv Perm.m{1} Perm.mi{1}); + last by auto;smt(dom0 in_fset0 map0P). + + proc;inline*;sp;if;auto;sp;if;auto;progress. + - smt(getP oget_some prefixe_inv_set). + - smt(in_dom inv_dom_rng invC getP oget_some supp_dexcepted). + - smt(getP oget_some prefixe_inv_set). + - smt(in_dom inv_dom_rng invC getP oget_some supp_dexcepted). + + proc;inline*;sp;if;auto;sp;if;auto;progress. + - smt(getP oget_some prefixe_inv_set invC inv_dom_rng supp_dexcepted). + - smt(in_dom inv_dom_rng invC getP oget_some supp_dexcepted). + - smt(getP oget_some prefixe_inv_set invC inv_dom_rng supp_dexcepted). + - smt(in_dom inv_dom_rng invC getP oget_some supp_dexcepted). proc; inline *; wp. + sp;if{2}. + (* TODO : reprendre ici *) + + while (={glob Perm,sc,sa,p} /\ (C.c + size p){1} = C.c{2});2:by auto. by sp; if=> //=; auto=> /> &2 cL /size_behead=> ->; progress; ring. have p_ll := P_f_ll _ _. diff --git a/proof/smart_counter/Handle.eca b/proof/smart_counter/Handle.eca index 6dbc866..01ff87e 100644 --- a/proof/smart_counter/Handle.eca +++ b/proof/smart_counter/Handle.eca @@ -4,7 +4,7 @@ require import List FSet NewFMap Utils Common SLCommon RndO. require import DProd Dexcepted. (*...*) import Capacity IntOrder DCapacity. -require ConcreteF. +(* require ConcreteF. *) clone import GenEager as ROhandle with type from <- handle, @@ -12,7 +12,7 @@ clone import GenEager as ROhandle with op sampleto <- fun (_:int) => cdistr proof sampleto_ll by apply DCapacity.dunifin_ll. -print FRO. + module G1(D:DISTINGUISHER) = { var m, mi : smap var mh, mhi : hsmap @@ -1119,7 +1119,7 @@ move: pi_xc; have /pi_of_INV [] -> [h] [#] + hs_h:= HINV. by have /hs_of_INV [] + _ _ - /(_ _ _ _ _ hs_hx hs_h _) := HINV. qed. -clone export ConcreteF as ConcreteF1. +(* clone export ConcreteF as ConcreteF1. *) lemma m_mh_None hs0 PFm G1mh hx2 x2 k x1: m_mh hs0 PFm G1mh => @@ -1204,6 +1204,8 @@ qed. (* we should do a lemma to have the equivalence *) + + equiv eq_fi (D <: DISTINGUISHER {PF, RO, G1}): PF.fi ~ G1(D).S.fi: !G1.bcol{2} /\ !G1.bext{2} diff --git a/proof/smart_counter/SLCommon.ec b/proof/smart_counter/SLCommon.ec index 9f4b155..239f700 100644 --- a/proof/smart_counter/SLCommon.ec +++ b/proof/smart_counter/SLCommon.ec @@ -225,8 +225,18 @@ op get_max_prefixe (l : 'a list) (ll : 'a list list) = pred invm (m mi : ('a * 'b, 'a * 'b) fmap) = forall x y, m.[x] = Some y <=> mi.[y] = Some x. -print foldl. +lemma invm_set (m mi : ('a * 'b, 'a * 'b) fmap) x y : + ! x \in dom m => ! y \in rng m => invm m mi => invm m.[x <- y] mi.[y <- x]. +proof. +move=>Hxdom Hyrng Hinv a b;rewrite!getP;split. ++ case(a=x)=>//=hax hab;cut->/#:b<>y. + by cut/#:b\in rng m;rewrite in_rng/#. +case(a=x)=>//=hax. ++ case(b=y)=>//=hby. + by rewrite (eq_sym y b)hby/=-Hinv hax;rewrite in_dom/=/# in Hxdom. +by rewrite Hinv/#. +qed. op blocksponge (l : block list) (m : (state, state) fmap) (bc : state) = with l = "[]" => (l,bc) @@ -346,17 +356,30 @@ cut/#:=Hpref _ Hbsdom i _;1:rewrite/#. qed. -lemma size_blocksponge queries m l : - prefixe_inv queries m => - size (blocksponge l m s0).`1 <= size l - prefixe l (get_max_prefixe l (elems (dom queries))). +lemma blocksponge_set_nil l m bc x y : + !x \in dom m => + let bs1 = blocksponge l m bc in + let bs2 = blocksponge l m.[x <- y] bc in + bs1.`1 = [] => + bs2 = ([], bs1.`2). proof. -move=>Hinv. -pose l2:=get_max_prefixe _ _;pose p:=prefixe _ _. search take drop. -rewrite-{1}(cat_take_drop p l)blocksponge_cat/=. -rewrite(prefixe_take). - +rewrite/==>hdom bs1. +cut/=:=blocksponge_set l m bc x y. +smt(size_ge0 size_eq0). qed. +(* lemma size_blocksponge queries m l : *) +(* prefixe_inv queries m => *) +(* size (blocksponge l m s0).`1 <= size l - prefixe l (get_max_prefixe l (elems (dom queries))). *) +(* proof. *) +(* move=>Hinv. *) +(* pose l2:=get_max_prefixe _ _;pose p:=prefixe _ _. search take drop. *) +(* rewrite-{1}(cat_take_drop p l)blocksponge_cat/=. *) +(* rewrite(prefixe_take). *) +(* qed. *) + + + end Prefixe. export Prefixe. @@ -389,7 +412,9 @@ module PC (P:PRIMITIVE) = { y <@ P.f(x); C.c <- C.c + 1; C.m.[x] <- y; - C.mi.[y] <- x; + if (! y \in dom C.mi) { + C.mi.[y] <- x; + } } else { y <- oget C.m.[x]; } @@ -402,7 +427,9 @@ module PC (P:PRIMITIVE) = { y <@ P.fi(x); C.c <- C.c + 1; C.mi.[x] <- y; - C.m.[y] <- x; + if (! y \in dom C.m) { + C.m.[y] <- x; + } } else { y <- oget C.mi.[x]; } @@ -420,7 +447,9 @@ module DPRestr (P:DPRIMITIVE) = { y <@ P.f(x); C.c <- C.c + 1; C.m.[x] <- y; - C.mi.[y] <- x; + if (! y \in dom C.mi) { + C.mi.[y] <- x; + } } } else { y <- oget C.m.[x]; @@ -435,7 +464,9 @@ module DPRestr (P:DPRIMITIVE) = { y <@ P.fi(x); C.c <- C.c + 1; C.mi.[x] <- y; - C.m.[y] <- x; + if (! y \in dom C.m) { + C.m.[y] <- x; + } } } else { y <- oget C.mi.[x]; From 2c1797bb24d6a10c019605b724535bb9e2874039 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Fri, 16 Feb 2018 18:10:26 +0100 Subject: [PATCH 263/525] ConcreteF.eca : completed Handle.eca : TODO --- proof/smart_counter/ConcreteF.eca | 558 +++++++++++------------- proof/smart_counter/Handle.eca | 2 +- proof/smart_counter/SLCommon.ec | 684 ++++++++++++++++++++++++------ 3 files changed, 810 insertions(+), 434 deletions(-) diff --git a/proof/smart_counter/ConcreteF.eca b/proof/smart_counter/ConcreteF.eca index 8565349..91a57bd 100644 --- a/proof/smart_counter/ConcreteF.eca +++ b/proof/smart_counter/ConcreteF.eca @@ -3,7 +3,7 @@ require import List FSet NewFMap Utils Common SLCommon DProd Dexcepted. (*...*) import Capacity IntOrder RealOrder. -require (*..*) Strong_RP_RF_C. +require (*..*) Strong_RP_RF. module PF = { var m, mi: (state,state) fmap @@ -19,10 +19,8 @@ module PF = { if (!mem (dom m) x) { y1 <$ bdistr; y2 <$ cdistr; - if (!(y1,y2) \in dom mi) { - mi.[(y1,y2)] <- x; - } m.[x] <- (y1,y2); + mi.[(y1,y2)] <- x; } return oget m.[x]; } @@ -33,10 +31,8 @@ module PF = { if (!mem (dom mi) x) { y1 <$ bdistr; y2 <$ cdistr; - if (!(y1,y2) \in dom m) { - m.[(y1,y2)] <- x; - } mi.[x] <- (y1,y2); + m.[(y1,y2)] <- x; } return oget mi.[x]; } @@ -46,7 +42,7 @@ module PF = { module CF(D:DISTINGUISHER) = Indif(SqueezelessSponge(PF), PF, D). section. - declare module D : DISTINGUISHER {Perm, C, PF}. + declare module D : DISTINGUISHER {Perm, C, PF, Redo}. axiom D_ll (F <: DFUNCTIONALITY{D}) (P <: DPRIMITIVE{D}): islossless P.f => islossless P.fi => islossless F.f => @@ -54,14 +50,14 @@ section. local module GReal' = Indif(FC(SqueezelessSponge(Perm)), PC(Perm), D). - local clone import Strong_RP_RF_C as Switching with + local clone import Strong_RP_RF as Switching with type D <- state, op uD <- dstate, type K <- unit, op dK <- (MUnit.dunit<:unit> tt), op q <- max_size - proof *. - realize ge0_q by rewrite max_ge0. + proof *. + realize ge0_q by smt w=max_ge0. realize uD_uf_fu. split. case=> [x y]; rewrite supp_dprod /=. @@ -81,283 +77,124 @@ section. lemma size_behead (l : 'a list) : l <> [] => size (behead l) = size l - 1. proof. by case l=> // ?? /=; ring. qed. - local module CP' (P' : PRPt.Oracles) = { - proc f (x : state) = { - var y <- (b0,c0); - if (!x \in dom C.m) { - y <@ P'.f(x); - if (!y \in dom C.mi) { - C.mi.[y] <- x; - } - C.m.[x] <- y; - } else { - y <- oget C.m.[x]; - } - return y; - } - proc fi (x : state) = { - var y <- (b0,c0); - if (!x \in dom C.mi) { - y <@ P'.f(x); - if (!y \in dom C.m) { - C.m.[y] <- x; - } - C.mi.[x] <- y; - } else { - y <- oget C.mi.[x]; - } - return y; - } - }. - local module (D': PRPt.Distinguisher) (P' : PRPt.Oracles) = { - proc distinguish = DRestr(D,SqueezelessSponge(CP'(P')),P').distinguish + proc distinguish () : bool = { + var b : bool; + Redo.init(); + b <@ DRestr(D,SqueezelessSponge(P'),P').distinguish(); + return b; + } }. -print DRestr. - - local lemma DoubleBounding (P <: PRPt.StrongPRP {D, C, DBounder}) &m: + local lemma DoubleBounding (P <: PRPt.StrongPRP {D, C, DBounder, Redo}) &m: Pr[PRPt.IND(P,D').main() @ &m: res] = Pr[PRPt.IND(P,DBounder(D')).main() @ &m: res]. proof. byequiv=> //=; proc; inline *. wp. - call (_: ={glob C, glob P} - /\ prefixe_inv C.queries{1} C.m{1} - /\ ={m,mi}(C,DBounder.FBounder) - /\ DBounder.FBounder.c{2} <= C.c{2}). - + proc; sp; if;auto;if=> //=; inline *. + call (_: ={glob C, glob P, glob Redo} + /\ all_prefixes Redo.prefixes{2} + /\ Redo.prefixes{2}.[[]] = Some (b0,c0) + /\ dom C.queries{2} <= dom Redo.prefixes{2} + /\ prefixe_inv C.queries{2} Redo.prefixes{2} + /\ DBounder.FBounder.c{2} = C.c{2}). + + proc; sp; if=> //=; inline *. rcondt{2} 3; 1: by auto=> /#. - rcondt{2} 4;first by auto;call(:true);auto. - by wp; call (_: true); auto;smt(prefixe_inv_set). - + proc; sp; if; auto; if=> //=; inline *. + by wp; call (_: true); auto. + + proc; sp; if=> //=; inline *. rcondt{2} 3; 1: by auto=> /#. - rcondt{2} 4;first by auto;call(:true);auto. - wp; call (_: true); auto;progress. - + smt(prefixe_inv_set). - + rewrite/#. - + rewrite/#. - + proc; sp; if; auto; if=> //=; inline *. - splitwhile{1} 4 : (sa +^ head witness p, sc) \in dom C.m. - splitwhile{2} 4 : (sa +^ head witness p, sc) \in dom C.m. - wp=>//=;swap 1 4;wp=>//=. - conseq(:_==> ={sa, C.mi, C.m, glob P} /\ C.m{1} = DBounder.FBounder.m{2} - /\ C.mi{1} = DBounder.FBounder.mi{2} - /\ prefixe_inv C.queries{1} C.m{1} - /\ DBounder.FBounder.c{2} <= C.c{2} + size bs{2} - - prefixe bs{2} (get_max_prefixe bs{2} (elems (dom C.queries{2}))) - /\ (forall (i : int), - 0 <= i < size bs{2} => - let bc = (blocksponge (take i bs{2}) C.m{1} s0).`2 in - (bc.`1 +^ nth b0 bs{2} i, bc.`2) \in dom C.m{1})); - 1:smt(dom_set in_fsetU1). - - while(={sa, sc, C.mi, C.m, glob P, p, bs, C.c, C.queries} - /\ C.m{1} = DBounder.FBounder.m{2} - /\ C.mi{1} = DBounder.FBounder.mi{2} - /\ (exists i, p{2} = drop i bs{2} /\ 0 <= i <= size bs{2} - /\ blocksponge (take i bs{2}) C.m{1} s0 = ([], (sa{1},sc{1}))) - /\ prefixe_inv C.queries{1} C.m{1} - /\ C.c{1} + size bs{1} - prefixe bs{1} - (get_max_prefixe bs{1} (elems (dom C.queries{1}))) <= max_size - /\ DBounder.FBounder.c{2} <= C.c{2} + size bs{2} - size p{2} - - prefixe bs{2} (get_max_prefixe bs{2} (elems (dom C.queries{2}))) - /\ (forall (i : int), - 0 <= i < size bs{2} - size p{2} => - let bc = (blocksponge (take i bs{2}) C.m{1} s0).`2 in - (bc.`1 +^ nth b0 bs{2} i, bc.`2) \in dom C.m{1}) - /\ (forall (i : int), - 0 <= i < size bs{2} - size p{2} => - (blocksponge (take i bs{2}) C.m{1} s0).`1 = [])). - + sp;if;1,3:auto;last first;progress. - - exists (i+1);rewrite(drop_nth witness)//=;2:split;1,2:smt(drop_oversize). - rewrite (take_nth witness);1:smt(drop_oversize). - move:H9;rewrite (drop_nth witness)/=;1:smt(drop_oversize). - move=>?. - rewrite blocksponge_rcons H1/=H9/=/#. - - rewrite size_behead//=/#. - - move:H11;rewrite size_behead//=. - case(i0 < size bs{2} - size (drop i bs{2}))=>[/#|]h h1. - cut->:i0 = size bs{2} - size (drop i bs{2}) by rewrite/#. - rewrite size_drop//=max_ler 1:/#/=. - cut->:(size bs{2} - (size bs{2} - i)) = i by ring. - rewrite H1/=. - by move:H9;rewrite (drop_nth b0)/=;1:smt(drop_oversize). - - move:H11;rewrite size_behead//=. - case(i0 < size bs{2} - size (drop i bs{2}))=>[/#|]h h1. - cut->:i0 = size bs{2} - size (drop i bs{2}) by rewrite/#. - rewrite size_drop//=max_ler 1:/#/=. - cut->:(size bs{2} - (size bs{2} - i)) = i by ring. - by rewrite H1/=. - - rcondt{2}3;1:(auto;smt(size_ge0 size_eq0)). - rcondt{2}4;1:by auto;call(:true);auto. - wp;call(:true);auto;progress. - - exists (i+1);rewrite(drop_nth witness)//=;2:split;1,2:smt(drop_oversize). - rewrite (take_nth witness);1:smt(drop_oversize). - move:H9;rewrite (drop_nth witness)/=;1:smt(drop_oversize). - move=>h. - rewrite blocksponge_rcons/=. - cut/=:=blocksponge_set_nil (take i bs{2}) DBounder.FBounder.m{2} s0 - (sa{2} +^ nth witness bs{2} i, sc{2}) result_R h. - rewrite H1/=/==>->/=;rewrite dom_set in_fsetU1/=getP/=oget_some/#. - - smt(prefixe_inv_set). - - smt(size_ge0 size_eq0). - - move:H12;rewrite size_behead//==>?. - move:H9;rewrite (drop_nth witness)/=;1:smt(drop_oversize). - move=>h. - case(i0 < size bs{2} - size (drop i bs{2}))=>[|]?. - + cut//=->/=:=blocksponge_set_nil (take i0 bs{2}) DBounder.FBounder.m{2} s0 - (sa{2} +^ nth witness bs{2} i, sc{2}) result_R h (H6 i0 _);1:rewrite/#. - by rewrite dom_set in_fsetU1/#. - cut hii0:i0=i by move:H9 H12;rewrite!size_drop//=max_ler /#. - rewrite hii0. - cut//=:=blocksponge_set_nil (take i bs{2}) DBounder.FBounder.m{2} s0 - (sa{2} +^ nth witness bs{2} i, sc{2}) result_R h. - rewrite H1/==>->/=;rewrite dom_set in_fsetU1//=;right;congr. - by rewrite nth_onth (onth_nth witness)//=;smt(size_ge0 size_eq0). - + move:H9;rewrite (drop_nth witness)/=;1:smt(drop_oversize). - move=>h. - case(i0 < size bs{2} - size (drop i bs{2}))=>[|]?. - + smt(blocksponge_set_nil). - cut hii0:i0=i by move:H12;rewrite size_behead//==>?; - move:H9 H12;rewrite!size_drop//=max_ler /#. - rewrite hii0;smt(blocksponge_set_nil). - + exists (i+1);rewrite(drop_nth witness)//=;2:split;1,2:smt(drop_oversize). - rewrite (take_nth witness);1:smt(drop_oversize). - move:H9;rewrite (drop_nth witness)/=;1:smt(drop_oversize). - move=>h. - rewrite blocksponge_rcons/=. - cut/=:=blocksponge_set_nil (take i bs{2}) DBounder.FBounder.m{2} s0 - (sa{2} +^ nth witness bs{2} i, sc{2}) result_R h. - rewrite H1/=/==>->/=;rewrite dom_set in_fsetU1/=getP/=oget_some/#. - - smt(prefixe_inv_set). - - smt(size_ge0 size_eq0). - - move:H12;rewrite size_behead//==>?. - move:H9;rewrite (drop_nth witness)/=;1:smt(drop_oversize). - move=>h. - case(i0 < size bs{2} - size (drop i bs{2}))=>[|]?. - + cut//=->/=:=blocksponge_set_nil (take i0 bs{2}) DBounder.FBounder.m{2} s0 - (sa{2} +^ nth witness bs{2} i, sc{2}) result_R h (H6 i0 _);1:rewrite/#. - by rewrite dom_set in_fsetU1/#. - cut hii0:i0=i by move:H9 H12;rewrite!size_drop//=max_ler /#. - rewrite hii0. - cut//=:=blocksponge_set_nil (take i bs{2}) DBounder.FBounder.m{2} s0 - (sa{2} +^ nth witness bs{2} i, sc{2}) result_R h. - rewrite H1/==>->/=;rewrite dom_set in_fsetU1//=;right;congr. - by rewrite nth_onth (onth_nth witness)//=;smt(size_ge0 size_eq0). - + move:H9;rewrite (drop_nth witness)/=;1:smt(drop_oversize). - move=>h. - case(i0 < size bs{2} - size (drop i bs{2}))=>[|]?. - + smt(blocksponge_set_nil). - cut hii0:i0=i by move:H12;rewrite size_behead//==>?; - move:H9 H12;rewrite!size_drop//=max_ler /#. - rewrite hii0;smt(blocksponge_set_nil). + by wp; call (_: true); auto. + + proc; sp; if=> //=; inline *;1:if;auto. - conseq(:_==> ={sa, sc, C.mi, C.m, glob P, p, bs, C.c, C.queries} - /\ C.m{1} = DBounder.FBounder.m{2} - /\ C.mi{1} = DBounder.FBounder.mi{2} - /\ (exists i, p{2} = drop i bs{2} /\ 0 <= i <= size bs{2} - /\ blocksponge (take i bs{2}) C.m{1} s0 = ([], (sa{1},sc{1}))) - /\ prefixe_inv C.queries{1} C.m{1} - /\ C.c{1} + size bs{1} - prefixe bs{1} - (get_max_prefixe bs{1} (elems (dom C.queries{1}))) <= max_size - /\ DBounder.FBounder.c{2} <= C.c{2} + size bs{2} - size p{2} - - prefixe bs{2} (get_max_prefixe bs{2} (elems (dom C.queries{2}))) - /\ (forall (i : int), - 0 <= i < size bs{2} - size p{2} => - let bc = (blocksponge (take i bs{2}) C.m{1} s0).`2 in - (bc.`1 +^ nth b0 bs{2} i, bc.`2) \in dom C.m{1}) - /\ (forall (i : int), - 0 <= i < size bs{2} - size p{2} => - (blocksponge (take i bs{2}) C.m{1} s0).`1 = []));1:rewrite/#. + splitwhile{1}5:take (i+1) p \in dom Redo.prefixes. + splitwhile{2}5:take (i+1) p \in dom Redo.prefixes. - alias{2} 1 k = DBounder.FBounder.c;sp 0 1. - alias{2} 1 dm = DBounder.FBounder.m;sp 0 1. - alias{2} 1 dmi = DBounder.FBounder.mi;sp 0 1. - alias{2} 1 cm = C.m;sp 0 1. - alias{2} 1 cmi = C.mi;sp 0 1. - conseq(:_==> ={sa, sc, C.mi, C.m, glob P, p, bs, C.c} - /\ C.m{1} = cm{2} - /\ DBounder.FBounder.m{2} = dm{2} - /\ C.mi{1} = cmi{2} - /\ DBounder.FBounder.mi{2} = dmi{2} - /\ (exists i, p{2} = drop i bs{2} /\ 0 <= i <= size bs{2} - /\ blocksponge (take i bs{2}) C.m{1} s0 = ([], (sa{1},sc{1}))) - /\ prefixe bs{1} (get_max_prefixe bs{1} (elems (dom C.queries{1}))) <= size bs{1} - size p{1} - /\ DBounder.FBounder.c{2} = k{2} - /\ (forall (i : int), - 0 <= i < size bs{2} - size p{2} => - let bc = (blocksponge (take i bs{2}) C.m{1} s0).`2 in - (bc.`1 +^ nth b0 bs{2} i, bc.`2) \in dom C.m{1}) - /\ (forall (i : int), - 0 <= i < size bs{2} - size p{2} => - (blocksponge (take i bs{2}) C.m{1} s0).`1 = []));progress. - + rewrite/#. - + smt(size_ge0 size_drop). - - while(={sa, sc, C.mi, C.m, glob P, p, bs, C.c} - /\ prefixe_inv C.queries{1} C.m{1} - /\ C.m{1} = cm{2} - /\ DBounder.FBounder.m{2} = dm{2} - /\ C.mi{1} = cmi{2} - /\ DBounder.FBounder.mi{2} = dmi{2} - /\ (exists i, p{2} = drop i bs{2} /\ 0 <= i <= size bs{2} - /\ blocksponge (take i bs{2}) C.m{1} s0 = ([], (sa{1},sc{1}))) - /\ DBounder.FBounder.c{2} = k{2} - /\ (forall (i : int), - 0 <= i < size bs{2} - size p{2} => - let bc = (blocksponge (take i bs{2}) C.m{1} s0).`2 in - (bc.`1 +^ nth b0 bs{2} i, bc.`2) \in dom C.m{1}) - /\ (forall (i : int), - 0 <= i < size bs{2} - size p{2} => - (blocksponge (take i bs{2}) C.m{1} s0).`1 = []));last first. - + auto;progress. - smt(drop0 size_ge0). - smt(drop0 size_ge0). - smt(drop0 size_ge0). - smt(drop0 size_ge0). - move:H4;rewrite negb_and/==>[]. - case(drop i bs{2} = [])=>[hdropi|hdropi]//=. - + rewrite hdropi/=;smt(prefixe_sizel). - rewrite size_drop//=max_ler 1:/#. - cut->:size bs{2} - (size bs{2} - i) = i by rewrite/#. - rewrite(drop_nth b0)//=;1:smt(size_ge0 size_eq0 size_drop). print prefixe_inv. - apply absurd=>//=hi. - cut->:nth b0 bs{2} i = nth b0 (get_max_prefixe bs{2} (elems (dom C.queries{2}))) i. - + rewrite 2!nth_onth (onth_nth witness);1:smt(size_drop size_eq0). - cut/=h:=prefixe_nth bs{2} (get_max_prefixe bs{2} (elems (dom C.queries{2}))). - cut->:=h i _;1:smt(size_drop size_eq0). - by rewrite (onth_nth witness)/=;1:smt(size_drop size_eq0 prefixe_sizer). - cut:=H (get_max_prefixe bs{2} (elems (dom C.queries{2}))) _;last first. - + move=>h;cut:=h i _;1:smt(prefixe_sizer). - cut:=H8;cut->/#:(take i bs{2}) = (take i (get_max_prefixe bs{2} (elems (dom C.queries{2})))). - by apply (eq_from_nth b0 _ _ _ _); - smt(size_take prefixe_sizer prefixe_sizel nth_take prefixe_nth nth_onth onth_nth). - cut h:forall (l1 l2:block list) ll, max_prefixe l1 l2 ll = l2 \/ max_prefixe l1 l2 ll \in ll. - + clear P &m &1 &2 H H0 H H1 H2 P_R sa_R sc_R H5 i H3 H6 H7 H8 H9 H10 hdropi hi. - by move=>l1 l2 ll;move:ll l1 l2;move=>ll;elim:ll=>//=/#. - cut h1:forall (l : block list) ll, get_max_prefixe l ll <> [] => ll <> []. - + clear P &m &1 &2 H H0 H H1 H2 P_R sa_R sc_R H5 i H3 H6 H7 H8 H9 H10 hdropi hi. - by move=>l ll;move:ll l=>ll;elim:ll=>//=. - rewrite memE;smt(prefixe_sizer). - sp;rcondf{1}1;2:rcondf{2}1;auto;progress. - - exists (i+1);rewrite(drop_nth witness)//=;2:split;1,2:smt(drop_oversize). - rewrite (take_nth witness);1:smt(drop_oversize). - move:H8;rewrite (drop_nth witness)/=;1:smt(drop_oversize). - move=>h. - rewrite blocksponge_rcons/=H2/=h/=/#. - - move:H10;rewrite size_behead//=. - case(i0 < size bs{2} - size (drop i bs{2}))=>??;1:rewrite/#. - cut hii0:i0=i by smt(size_drop). - rewrite hii0 H2/=. - move:H8;rewrite (drop_nth witness)/=;1:smt(drop_oversize). - by rewrite nth_onth (onth_nth b0)/=;1:smt(size_eq0). - - move:H10;rewrite size_behead//=. - case(i0 < size bs{2} - size (drop i bs{2}))=>??;1:rewrite/#. - cut hii0:i0=i by smt(size_drop). - by rewrite hii0 H2/=. - auto;progress;call(:true);auto;smt(dom0 in_fset0). + alias{1}1 pref = Redo.prefixes;alias{2}1 pref = Redo.prefixes;sp 1 1=>/=. + alias{1}1 query = C.queries;alias{2}1 query = C.queries;sp 1 1=>/=. + conseq(:_==> ={sa, Redo.prefixes, glob P, i, C.c} + /\ all_prefixes Redo.prefixes{2} + /\ dom query{2} <= dom Redo.prefixes{2} + /\ i{1} = size bs{1} + /\ Redo.prefixes{1}.[take i{1} bs{1}] = Some (sa{1},sc{1}) + /\ (forall y, y \in dom pref{1} => pref{1}.[y] = Redo.prefixes{1}.[y]) + /\ (forall y, y \in dom Redo.prefixes{1} <=> (y \in dom pref{1} \/ + (exists j, 0 <= j <= i{1} /\ y = take j bs{1}))) + /\ DBounder.FBounder.c{2} = C.c{2} - size bs{1} + i{1}); + progress;..-2:smt(in_dom dom_set in_fsetU1 getP oget_some take_size cat_take_drop). + while( ={sa, Redo.prefixes, glob P, i, C.c, p, sc} /\ p{1} = bs{1} + /\ all_prefixes Redo.prefixes{2} + /\ Redo.prefixes{2}.[[]] = Some (b0, c0) + /\ dom query{2} <= dom Redo.prefixes{2} + /\ (i{1} < size p{1} => ! take (i{1} + 1) p{1} \in dom Redo.prefixes{1}) + /\ 0 <= prefixe bs{1} (get_max_prefixe bs{1} (elems (dom C.queries{1}))) <= i{1} <= size bs{1} + /\ C.c{1} <= max_size + /\ Redo.prefixes{1}.[take i{1} bs{1}] = Some (sa{1},sc{1}) + /\ (forall y, y \in dom pref{1} => pref{1}.[y] = Redo.prefixes{1}.[y]) + /\ (forall y, y \in dom Redo.prefixes{1} <=> (y \in dom pref{1} \/ + (exists j, 0 <= j <= i{1} /\ y = take j bs{1}))) + /\ DBounder.FBounder.c{2} = C.c{2} - size bs{1} + i{1}). + + if;auto;1:smt(get_oget in_dom). + sp;rcondt{2}1;1:auto=>/#;auto;1:call(:true);auto;progress. + * move=>x;rewrite dom_set in_fsetU1=>[][|-> j];1:smt(in_fsetU1). + case(0 <= j)=>hj0;last first. + + by rewrite (take_le0 j)1:/# in_fsetU1 in_dom H0//=. + rewrite take_take in_fsetU1/min/#. + * smt(dom_set in_fsetU1 take_take in_dom getP oget_some). + * smt(dom_set in_fsetU1 take_take in_dom getP oget_some). + * rewrite dom_set in_fsetU1 negb_or H9 negb_or/=negb_exists/=. + cut htake:take (i{2} + 1) bs{1} = take (i{2} + 1) (take (i{2} + 1 + 1) bs{1}); + smt(take_take size_take). + * rewrite/#. + * rewrite/#. + * smt(dom_set in_fsetU1 take_take in_dom getP oget_some). + * smt(dom_set in_fsetU1 take_take in_dom getP oget_some). + * smt(dom_set in_fsetU1 take_take in_dom getP oget_some). + * smt(dom_set in_fsetU1 take_take in_dom getP oget_some). + * smt(dom_set in_fsetU1 take_take in_dom getP oget_some). + sp; + conseq(:_==> ={sa, Redo.prefixes, glob P, i, C.c, p, sc, bs} /\ p{1} = bs{1} + /\ Redo.prefixes{2} = pref{2} + /\ dom query{2} <= dom Redo.prefixes{2} + /\ C.c{1} <= max_size + /\ i{1} = prefixe bs{1} (get_max_prefixe bs{1} (elems (dom C.queries{1}))) + /\ Redo.prefixes{1}.[take i{1} bs{1}] = Some (sa{1},sc{1}) + /\ DBounder.FBounder.c{2} = C.c{2} - size bs{1} + + prefixe bs{1} (get_max_prefixe bs{1} (elems (dom C.queries{1})))); + progress;..4,6..-2: + smt(prefixe_ge0 prefixe_lt_size prefixe_sizel prefixe_exchange prefixe_lt_size memE). + + move:H8=>[]//=[]j [[hj0 hjsize] htake]. + rewrite htake. + apply take_get_max_prefixe2=>//=;1:smt(in_dom memE). + by rewrite-(prefixe_exchange _ _ _ H2 H). + alias{2} 1 k = DBounder.FBounder.c;sp; + conseq(:_==> ={sa, Redo.prefixes, glob P, i, C.c, p, sc, bs} /\ p{1} = bs{1} + /\ Redo.prefixes{2} = pref{2} + /\ dom query{2} <= dom Redo.prefixes{2} + /\ C.c{2} <= max_size + /\ i{1} = prefixe bs{1} (get_max_prefixe bs{1} (elems (dom C.queries{1}))) + /\ Redo.prefixes{1}.[take i{1} bs{1}] = Some (sa{1},sc{1}) + /\ DBounder.FBounder.c{2} = k{2});1:progress=>/#. + while( ={sa, Redo.prefixes, glob P, i, C.c, p, sc, bs, C.queries} /\ p{1} = bs{1} + /\ Redo.prefixes{2} = pref{2} + /\ dom query{2} <= dom Redo.prefixes{2} + /\ prefixe_inv C.queries{2} Redo.prefixes{2} + /\ all_prefixes Redo.prefixes{2} + /\ C.c{2} <= max_size + /\ 0 <= i{1} <= prefixe bs{1} (get_max_prefixe bs{1} (elems (dom C.queries{1}))) + /\ (forall j, 0 <= j <= prefixe bs{1} (get_max_prefixe bs{1} (elems (dom C.queries{1}))) + => take j bs{2} \in dom Redo.prefixes{1}) + /\ Redo.prefixes{1}.[take i{1} bs{1}] = Some (sa{1},sc{1}) + /\ DBounder.FBounder.c{2} = k{2}). + + rcondt{1}1;2:rcondt{2}1;auto;progress. + * by rewrite/#. + * by rewrite(prefixe_exchange _ _ bs{2} H0 H1)all_take_in//=/#. + * smt(get_oget in_dom). + auto;progress. smt(prefixe_ge0). + * apply take_get_max_prefixe2=>//=;1:smt(in_dom memE). + by rewrite-(prefixe_exchange _ _ _ H2 H). + * smt(get_oget in_dom). + * smt(@Prefixe). + auto;call(:true);auto;smt(dom0 in_fset0 dom_set in_fsetU1 getP oget_some). qed. local clone import ProdSampling with @@ -368,30 +205,142 @@ print DRestr. lemma Real_Concrete &m : Pr[GReal(D).main()@ &m: res /\ C.c <= max_size] <= - Pr[CF(DRestr(D)).main()@ &m: res] + (max_size ^ 2)%r * inv 2%r * mu dstate (pred1 witness). + Pr[CF(DRestr(D)).main()@ &m: res] + (max_size ^ 2)%r * mu dstate (pred1 witness). proof. cut->: Pr[RealIndif(SqueezelessSponge,PC(Perm),D).main()@ &m: res /\ C.c <= max_size] = Pr[GReal'.main()@ &m: res/\ C.c <= max_size]. - + byequiv=>//;proc;inline *;call (_: ={glob C,glob Perm} - /\ prefixe_inv C.queries{1} Perm.m{1} /\ inv Perm.m{1} Perm.mi{1}); - last by auto;smt(dom0 in_fset0 map0P). - + proc;inline*;sp;if;auto;sp;if;auto;progress. - - smt(getP oget_some prefixe_inv_set). - - smt(in_dom inv_dom_rng invC getP oget_some supp_dexcepted). - - smt(getP oget_some prefixe_inv_set). - - smt(in_dom inv_dom_rng invC getP oget_some supp_dexcepted). - + proc;inline*;sp;if;auto;sp;if;auto;progress. - - smt(getP oget_some prefixe_inv_set invC inv_dom_rng supp_dexcepted). - - smt(in_dom inv_dom_rng invC getP oget_some supp_dexcepted). - - smt(getP oget_some prefixe_inv_set invC inv_dom_rng supp_dexcepted). - - smt(in_dom inv_dom_rng invC getP oget_some supp_dexcepted). - proc; inline *; wp. - sp;if{2}. - (* TODO : reprendre ici *) - + - while (={glob Perm,sc,sa,p} /\ (C.c + size p){1} = C.c{2});2:by auto. - by sp; if=> //=; auto=> /> &2 cL /size_behead=> ->; progress; ring. + + byequiv=>//;proc;inline *; + call (_: ={C.c, glob Perm, Redo.prefixes} + /\ prefixe_inv C.queries{2} Redo.prefixes{1} + /\ Redo.prefixes{1}.[[]] = Some (b0, c0) + /\ all_prefixes Redo.prefixes{1}); + last first. + + auto;smt(dom0 in_fset0 dom_set in_fsetU1 getP oget_some). + + by proc; inline*; sp; if; auto. + + by proc; inline*; sp; if; auto. + proc; inline *; wp; sp. + if{2};sp;wp;last first. + + conseq(:_==> sa{1} = (oget Redo.prefixes{1}.[take i{1} p{1}]).`1 + /\ i{1} = size p{1} + /\ Redo.prefixes{1}.[[]] = Some (b0, c0) + /\ ={Perm.m, Perm.mi, Redo.prefixes, C.c});1:smt(take_size). + + while{1}( ={Perm.m, Perm.mi, Redo.prefixes, C.c} + /\ p{1} \in dom C.queries{2} + /\ prefixe_inv C.queries{2} Redo.prefixes{1} + /\ 0 <= i{1} <= size p{1} + /\ Redo.prefixes{1}.[[]] = Some (b0, c0) + /\ (sa{1},sc{1}) = oget Redo.prefixes{1}.[take i{1} p{1}] + /\ all_prefixes Redo.prefixes{1})(size p{1} - i{1}). + + auto;sp;rcondt 1;auto;smt(excepted_lossless). + by auto;smt(size_ge0 take0 take_size). + + splitwhile{1} 1 : take (i+1) p \in dom Redo.prefixes; + splitwhile{2} 1 : take (i+1) p \in dom Redo.prefixes. + + alias{1}1 pref = Redo.prefixes;alias{2}1 pref = Redo.prefixes;sp 1 1=>/=. + alias{2}1 query = C.queries;sp 0 1=>/=. + + conseq(:_==> ={sa,Perm.m,Perm.mi,Redo.prefixes,i,p} + /\ C.c{1} = C.c{2} - size p{2} + i{2} + /\ i{2} = size p{2} + /\ Redo.prefixes{2}.[take i{2} p{2}] = Some (sa{2}, sc{2}) + /\ (forall l, l \in dom pref{2} => pref{2}.[l] = Redo.prefixes{2}.[l]) + /\ (forall j, 0 <= j <= i{2} => take j p{2} \in dom Redo.prefixes{2}) + /\ (forall l, l \in dom Redo.prefixes{2} => + l \in dom pref{2} \/ (exists j, 0 <= j <= i{2} /\ l = take j p{2}))); + progress. + * by rewrite/#. + * move:H3 H7;rewrite take_size dom_set in_fsetU1 getP;case(bs0 = bs{2})=>//=[->|]h. + * by rewrite h oget_some/=. + * move:H=>[?[??]];move=>? ?. + by rewrite -H4;1:smt(take_size);rewrite H//=. + * smt(dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0). + * smt(dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop). + * smt(dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop). + * smt(dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop). + while(={sa,sc,Perm.m,Perm.mi,Redo.prefixes,i,p} + /\ C.c{1} = C.c{2} - size p{2} + i{2} + /\ all_prefixes Redo.prefixes{2} + /\ all_prefixes pref{2} + /\ prefixe_inv C.queries{2} pref{2} + /\ prefixe p{2} (get_max_prefixe p{2} (elems (dom C.queries{2}))) <= i{2} <= size p{2} + /\ Redo.prefixes{2}.[take i{2} p{2}] = Some (sa{2}, sc{2}) + /\ (forall l, l \in dom pref{2} => pref{2}.[l] = Redo.prefixes{2}.[l]) + /\ (forall j, 0 <= j <= i{2} => take j p{2} \in dom Redo.prefixes{2}) + /\ (forall l, l \in dom Redo.prefixes{2} => + l \in dom pref{2} \/ (exists j, 0 <= j <= i{2} /\ l = take j p{2}))). + + rcondf{1}1;2:rcondf{2}1;..2:auto;progress. + * cut:=H7 (take (i{m0}+1) p{m0}). + case((take (i{m0} + 1) p{m0} \in dom Redo.prefixes{m0}))=>//=_. + rewrite negb_or negb_exists/=;progress. + + by rewrite memE prefixe_lt_size//=-(prefixe_exchange _ _ p{m0} H1 H0)//=/#. + case(0<=a<=i{m0})=>//=ha;smt(size_take). + * cut:=H7 (take (i{hr}+1) p{hr}). + case((take (i{hr} + 1) p{hr} \in dom Redo.prefixes{hr}))=>//=_. + rewrite negb_or negb_exists/=;progress. + + by rewrite memE prefixe_lt_size//=-(prefixe_exchange _ _ p{hr} H1 H0)//=/#. + case(0<=a<=i{hr})=>//=ha;smt(size_take). + + sp;auto;if;auto;progress. + * rewrite/#. + * move=>x;rewrite dom_set in_fsetU1=>[][|h];1: + smt(dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop). + rewrite h=>j;rewrite take_take in_fsetU1/min. + case(j//=hij. + cut->:take j p{2} = take j (take i{2} p{2});smt(take_take take_le0). + * smt(prefixe_lt_size dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop memE). + * smt(prefixe_lt_size dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop memE). + * smt(prefixe_lt_size dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop memE). + * rewrite!getP/=. + cut/#: !take (i{2} + 1) p{2} \in dom pref{2}. + by rewrite memE prefixe_lt_size//=-(prefixe_exchange _ _ _ H1 H0)//=/#. + * smt(prefixe_lt_size dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop memE). + * smt(prefixe_lt_size dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop memE). + * smt(prefixe_lt_size dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop memE). + * move=>x;rewrite dom_set in_fsetU1=>[][|h];1: + smt(dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop). + rewrite h=>j;rewrite take_take in_fsetU1/min. + case(j//=hij. + cut->:take j p{2} = take j (take i{2} p{2});smt(take_take take_le0). + * smt(prefixe_lt_size dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop memE). + * smt(prefixe_lt_size dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop memE). + * smt(prefixe_lt_size dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop memE). + * rewrite!getP/=. + cut/#: !take (i{2} + 1) p{2} \in dom pref{2}. + by rewrite memE prefixe_lt_size//=-(prefixe_exchange _ _ _ H1 H0)//=/#. + * smt(prefixe_lt_size dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop memE). + * smt(prefixe_lt_size dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop memE). + conseq(:_==> ={sa,sc,Perm.m,Perm.mi,Redo.prefixes,i,p} + /\ C.c{1} = C.c{2} - size p{2} + i{2} + /\ pref{2} = Redo.prefixes{2} + /\ all_prefixes pref{2} + /\ prefixe_inv C.queries{2} pref{2} + /\ prefixe p{2} (get_max_prefixe p{2} (elems (dom C.queries{2}))) = i{2} + /\ Redo.prefixes{2}.[take i{2} p{2}] = Some (sa{2}, sc{2}));1: + smt(prefixe_sizel take_get_max_prefixe2 in_dom prefixe_exchange). + + while( ={sa,sc,Perm.m,Perm.mi,Redo.prefixes,i,p} + /\ C.c{1} = C.c{2} - size p{2} + prefixe p{2} (get_max_prefixe p{2} (elems (dom C.queries{2}))) + /\ pref{2} = Redo.prefixes{2} + /\ all_prefixes pref{2} + /\ prefixe_inv C.queries{2} pref{2} + /\ 0 <= i{2} <= prefixe p{2} (get_max_prefixe p{2} (elems (dom C.queries{2}))) + /\ Redo.prefixes{2}.[take i{2} p{2}] = Some (sa{2}, sc{2})). + + rcondt{1}1;2:rcondt{2}1;auto;progress. + * rewrite/#. search get_max_prefixe (<=) take mem. + * rewrite(prefixe_inv_leq _ _ _ _ _ _ H H7 H0)//= 1:/#. + cut:=H0=>[][h1 [h2 h3]]. + cut:=h3 _ _ _ H7;last smt(memE). + smt(size_eq0 size_take). + * smt(get_oget in_dom). + auto;progress. + * rewrite/#. + * smt(prefixe_ge0). + * smt(take0). + * smt(prefixe_sizel @Prefixe memE). + * smt(prefixe_sizel @Prefixe memE). + have p_ll := P_f_ll _ _. + apply/dprod_ll; split. + exact/Block.DBlock.dunifin_ll. @@ -405,8 +354,8 @@ print DRestr. + apply/fun_ext=>- [] a b; rewrite supp_dprod. by rewrite/=/predT/=Block.DBlock.dunifin_fu Capacity.DCapacity.dunifin_fu. have f_ll : islossless SqueezelessSponge(Perm).f. - + proc; while true (size p)=> //=. - * by move=> z; wp; call p_ll; skip=> /> &hr /size_behead /#. + + proc; while true (size p - i)=> //=. + * move=> z; wp;if;auto; 2:call p_ll; auto=>/#. by auto; smt w=size_ge0. apply (ler_trans _ _ _ (Pr_restr Perm SqueezelessSponge D p_ll pi_ll f_ll D_ll &m)). @@ -442,15 +391,14 @@ print DRestr. by inline *; auto. have /#:= Conclusion D' &m _. move=> O O_f_ll O_fi_ll. - proc; call (_: true)=> //=. + proc;inline*;sp;wp; call (_: true)=> //=. + apply D_ll. - + by proc; sp; if=> //=; call O_f_ll; auto. - + by proc; sp; if=> //=; call O_fi_ll; auto. - + proc; inline *; sp; if=> //=; auto. - while true (size p). - * by auto; call O_f_ll; auto=> /#. + + by proc; inline*; sp; if=> //=; auto; call O_f_ll; auto. + + by proc; inline*; sp; if=> //=; auto; call O_fi_ll; auto. + + proc; inline *; sp; if=> //=; auto; if; auto. + while true (size p - i);auto. + * sp; if; auto; 2:call O_f_ll; auto=> /#. by auto; smt w=size_ge0. - by inline *; auto. qed. end section. diff --git a/proof/smart_counter/Handle.eca b/proof/smart_counter/Handle.eca index 01ff87e..8b52526 100644 --- a/proof/smart_counter/Handle.eca +++ b/proof/smart_counter/Handle.eca @@ -1327,7 +1327,7 @@ equiv PFf_Cf (D<:DISTINGUISHER): SqueezelessSponge(PF).f ~ G1(D).C.f : ! (G1.bcol{2} \/ G1.bext{2}) => ={res} /\ INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2}. proof. - proc; seq 2 4: + proc. ; seq 2 4: ((!(G1.bcol{2} \/ G1.bext{2}) => (INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} /\ F.RO.m.[p]{2} = Some sa{1})));last first. diff --git a/proof/smart_counter/SLCommon.ec b/proof/smart_counter/SLCommon.ec index 239f700..d0629e5 100644 --- a/proof/smart_counter/SLCommon.ec +++ b/proof/smart_counter/SLCommon.ec @@ -39,16 +39,34 @@ clone import RndO.GenEager as F with op sampleto <- fun (_:block list)=> bdistr proof * by exact Block.DBlock.dunifin_ll. + +module Redo = { + var prefixes : (block list, state) fmap + + proc init() : unit = { + prefixes <- map0.[[] <- (b0,c0)]; + } +}. + (** We can now define the squeezeless sponge construction **) module SqueezelessSponge (P:DPRIMITIVE): FUNCTIONALITY = { - proc init () = {} + proc init () = { + Redo.init(); + } proc f(p : block list): block = { var (sa,sc) <- (b0,c0); - - while (p <> []) { (* Absorption *) - (sa,sc) <@ P.f((sa +^ head witness p,sc)); - p <- behead p; + var i : int <- 0; + + while (i < size p) { (* Absorption *) + if (take (i+1) p \in dom Redo.prefixes) { + (sa,sc) <- oget Redo.prefixes.[take (i+1) p]; + } else { + (sa,sc) <- (sa +^ nth witness p i, sc); + (sa,sc) <@ P.f((sa,sc)); + Redo.prefixes.[take (i+1) p] <- (sa,sc); + } + i <- i + 1; } return sa; (* Squeezing phase (non-iterated) *) @@ -199,6 +217,32 @@ move=>e2 l2 Hind1 e1 l1 Hind2=>//=. by case(e1=e2)=>[->//=/#|//=]. qed. +lemma take_take (l : 'a list) (i j : int) : + take i (take j l) = take (min i j) l. +proof. +case(i <= j)=>Hij. ++ case(j < size l)=>Hjsize;last smt(take_oversize). + case(0 <= i)=>Hi0;last smt(take_le0). + apply (eq_from_nth witness);1:smt(size_take). + move=>k;rewrite !size_take//=1:/# Hjsize/=. + cut->: (if i < j then i else j) = i by rewrite/#. + move=>[Hk0 Hki]. + by rewrite !nth_take//=/#. +case(0//=Hj0;last smt(take_le0). +rewrite min_ler 1:/#. +pose l':=take j l. +rewrite take_oversize//=. +rewrite/l' size_take /#. +qed. + +lemma prefixe_take_leq (l1 l2 : 'a list) (i : int) : + i <= prefixe l1 l2 => take i l1 = take i l2. +proof. +move=>Hi. +cut->:i = min i (prefixe l1 l2) by smt(min_lel). +by rewrite-(take_take l1 i _)-(take_take l2 i _) prefixe_take. +qed. + lemma prefixe_nth (l1 l2 : 'a list) : let i = prefixe l1 l2 in forall j, 0 <= j < i => @@ -223,6 +267,414 @@ op get_max_prefixe (l : 'a list) (ll : 'a list list) = with ll = (::) l' ll' => max_prefixe l l' ll'. +pred prefixe_inv (queries : (block list, block) fmap) + (prefixes : (block list, state) fmap) = + (forall (bs : block list), + bs \in dom queries => oget queries.[bs] = (oget prefixes.[bs]).`1) && + (forall (bs : block list), + bs \in dom queries => forall i, take i bs \in dom prefixes) && + (forall (bs : block list), + forall i, take i bs <> [] => + take i bs \in dom prefixes => + exists l2, (take i bs) ++ l2 \in dom queries). + +pred all_prefixes (prefixes : (block list, state) fmap) = + forall (bs : block list), bs \in dom prefixes => forall i, take i bs \in dom prefixes. + +lemma aux_mem_get_max_prefixe (l1 l2 : 'a list) ll : + max_prefixe l1 l2 ll = l2 \/ max_prefixe l1 l2 ll \in ll. +proof. +move:l1 l2;elim:ll=>//=l3 ll Hind l1 l2. +case(prefixe l1 l2 < prefixe l1 l3)=>//=hmax. ++ cut/#:=Hind l1 l3. +cut/#:=Hind l1 l2. +qed. + + +lemma mem_get_max_prefixe (l : 'a list) ll : + ll <> [] => get_max_prefixe l ll \in ll. +proof. +move:l;elim:ll=>//=l2 ll Hind l1. +exact aux_mem_get_max_prefixe. +qed. + + +lemma take_get_max_prefixe l prefixes : + (exists b, b \in dom prefixes) => + all_prefixes prefixes => + take (prefixe l (get_max_prefixe l (elems (dom prefixes)))) l \in dom prefixes. +proof. +move=>nil_in_dom all_pref. +rewrite prefixe_take all_pref memE mem_get_max_prefixe;smt(memE). +qed. + +lemma take_get_max_prefixe2 l prefixes i : + (exists b, b \in dom prefixes) => + all_prefixes prefixes => + i <= prefixe l (get_max_prefixe l (elems (dom prefixes))) => + take i l \in dom prefixes. +proof. +move=>nil_in_dom all_pref hi. +rewrite (prefixe_take_leq _ _ i hi) all_pref memE mem_get_max_prefixe;smt(memE). +qed. + + +lemma prefixe_cat (l l1 l2 : 'a list) : + prefixe (l ++ l1) (l ++ l2) = size l + prefixe l1 l2. +proof. +move:l1 l2;elim l=>//=/#. +qed. + + +lemma prefixe_leq_take (l1 l2 : 'a list) i : + 0 <= i <= min (size l1) (size l2) => + take i l1 = take i l2 => + i <= prefixe l1 l2. +proof. +move=> [hi0 himax] htake. +rewrite-(cat_take_drop i l1)-(cat_take_drop i l2)htake. +rewrite prefixe_cat size_take//=;smt(prefixe_ge0). +qed. + +lemma prefixe0 (l1 l2 : 'a list) : + prefixe l1 l2 = 0 <=> l1 = [] \/ l2 = [] \/ head witness l1 <> head witness l2 . +proof. +move:l2;elim:l1=>//=;1:rewrite/#;move=>e1 l1 Hind l2;move:e1 l1 Hind;elim:l2=>//=e2 l2 Hind2 e1 l1 Hind1. +smt(prefixe_ge0). +qed. + +lemma head_nth0 (l : 'a list) : head witness l = nth witness l 0. +proof. by elim:l. qed. + + +lemma get_prefixe (l1 l2 : 'a list) i : + 0 <= i <= min (size l1) (size l2)=> + (drop i l1 = [] \/ drop i l2 = [] \/ + (i < min (size l1) (size l2) /\ + nth witness l1 i <> nth witness l2 i)) => + take i l1 = take i l2 => + i = prefixe l1 l2. +proof. +move=>[hi0 hisize] [|[]]. ++ move=>hi. + cut:=size_eq0 (drop i l1);rewrite {2}hi/=size_drop// =>h. + cut hsize: size l1 = i by rewrite/#. + rewrite -hsize take_size. + rewrite-{2}(cat_take_drop (size l1) l2)=><-. + by rewrite-{2}(cats0 l1)prefixe_cat/#. ++ move=>hi. + cut:=size_eq0 (drop i l2);rewrite {2}hi/=size_drop// =>h. + cut hsize: size l2 = i by rewrite/#. + rewrite -hsize take_size. + rewrite-{2}(cat_take_drop (size l2) l1)=>->. + by rewrite-{4}(cats0 l2)prefixe_cat/#. +move=>[himax hnth] htake. +rewrite-(cat_take_drop i l1)-(cat_take_drop i l2)htake. +rewrite prefixe_cat size_take//=. ++ cut[_ ->]:=prefixe0 (drop i l1) (drop i l2). + case(i = size l1)=>hi1//=. + + by rewrite hi1 drop_size//=. + case(i = size l2)=>hi2//=. + + by rewrite hi2 drop_size//=. + by rewrite 2!head_nth0 nth_drop//=nth_drop//= hnth. +rewrite/#. +qed. + +lemma get_max_prefixe_leq (l1 l2 : 'a list) (ll : 'a list list) : + prefixe l1 l2 <= prefixe l1 (max_prefixe l1 l2 ll). +proof. +move:l1 l2;elim:ll=>//=/#. +qed. + +lemma get_max_prefixe_is_max (l1 l2 : 'a list) (ll : 'a list list) : + forall l3, l3 \in ll => prefixe l1 l3 <= prefixe l1 (max_prefixe l1 l2 ll). +proof. +move:l1 l2;elim:ll=>//=. +move=>l4 ll Hind l1 l2 l3. +case(prefixe l1 l2 < prefixe l1 l4)=>//=h [];smt( get_max_prefixe_leq ). +qed. + +lemma get_max_prefixe_max (l : 'a list) (ll : 'a list list) : + forall l2, l2 \in ll => prefixe l l2 <= prefixe l (get_max_prefixe l ll). +proof. smt(get_max_prefixe_is_max get_max_prefixe_leq). qed. + +lemma all_take_in (l : block list) i prefixes : + 0 <= i <= size l => + all_prefixes prefixes => + take i l \in dom prefixes => + i <= prefixe l (get_max_prefixe l (elems (dom prefixes))). +proof. +move=>[hi0 hisize] all_prefixe take_in_dom. +cut->:i = prefixe l (take i l);2:smt(get_max_prefixe_max memE). +apply get_prefixe. ++ smt(size_take). ++ by right;left;apply size_eq0;rewrite size_drop//size_take//=/#. +smt(take_take). +qed. + +lemma prefixe_inv_leq (l : block list) i prefixes queries : + 0 <= i <= size l => + elems (dom queries) <> [] => + all_prefixes prefixes => + take i l \in dom prefixes => + prefixe_inv queries prefixes => + i <= prefixe l (get_max_prefixe l (elems (dom queries))). +proof. +move=>h_i h_nil h_all_prefixes take_in_dom [?[h_prefixe_inv h_exist]]. +case(take i l = [])=>//=h_take_neq_nil. ++ smt(prefixe_ge0 size_eq0). +cut[l2 h_l2_mem]:=h_exist l i h_take_neq_nil take_in_dom. +rewrite memE in h_l2_mem. +rewrite(StdOrder.IntOrder.ler_trans _ _ _ _ (get_max_prefixe_max _ _ _ h_l2_mem)). +rewrite-{1}(cat_take_drop i l)prefixe_cat size_take 1:/#;smt(prefixe_ge0). +qed. + + +lemma max_prefixe_eq (l : 'a list) (ll : 'a list list) : + max_prefixe l l ll = l. +proof. +move:l;elim:ll=>//=l2 ll Hind l1;smt( prefixe_eq prefixe_sizel). +qed. + +lemma prefixe_max_prefixe_eq_size (l1 l2 : 'a list) (ll : 'a list list) : + l1 = l2 \/ l1 \in ll => + prefixe l1 (max_prefixe l1 l2 ll) = size l1. +proof. +move:l1 l2;elim:ll=>//=;1:smt(prefixe_eq). +move=>l3 ll Hind l1 l2[->|[->|h1]]. ++ rewrite prefixe_eq max_prefixe_eq;smt(max_prefixe_eq prefixe_eq prefixe_sizer). ++ rewrite prefixe_eq max_prefixe_eq. + case(prefixe l3 l2 < size l3)=>//=h;1:by rewrite prefixe_eq. + cut h1:prefixe l3 l2 = size l3 by smt(prefixe_sizel). + cut: size l3 <= prefixe l3 (max_prefixe l3 l2 ll);2:smt(prefixe_sizel). + rewrite-h1. + by clear Hind l1 h h1;move:l2 l3;elim:ll=>//=l3 ll Hind l1 l2/#. +by case(prefixe l1 l2 < prefixe l1 l3)=>//=/#. +qed. + +lemma prefixe_get_max_prefixe_eq_size (l : 'a list) (ll : 'a list list) : + l \in ll => + prefixe l (get_max_prefixe l ll) = size l. +proof. +move:l;elim:ll=>//;smt(prefixe_max_prefixe_eq_size). +qed. + +lemma get_max_prefixe_exists (l : 'a list) (ll : 'a list list) : + ll <> [] => + exists l2, take (prefixe l (get_max_prefixe l ll)) l ++ l2 \in ll. +proof. +move:l;elim:ll=>//=l2 ll Hind l1;clear Hind;move:l1 l2;elim:ll=>//=. ++ smt(cat_take_drop prefixe_take). +move=>l3 ll Hind l1 l2. +case( prefixe l1 l2 < prefixe l1 l3 )=>//=h/#. +qed. + +lemma prefixe_geq (l1 l2 : 'a list) : + prefixe l1 l2 = prefixe (take (prefixe l1 l2) l1) (take (prefixe l1 l2) l2). +proof. +move:l2;elim:l1=>//=[/#|]e1 l1 Hind l2;elim:l2=>//=e2 l2 Hind2. +case(e1=e2)=>//=h12. +cut->/=:! 1 + prefixe l1 l2 <= 0 by smt(prefixe_ge0). +rewrite h12/=/#. +qed. + +lemma prefixe_take_prefixe (l1 l2 : 'a list) : + prefixe (take (prefixe l1 l2) l1) l2 = prefixe l1 l2. +proof. +move:l2;elim:l1=>//=e1 l1 Hind l2;elim:l2=>//=e2 l2 Hind2. +case(e1=e2)=>//=h12. +cut->/=:! 1 + prefixe l1 l2 <= 0 by smt(prefixe_ge0). +rewrite h12/=/#. +qed. + +lemma prefixe_leq_prefixe_cat (l1 l2 l3 : 'a list) : + prefixe l1 l2 <= prefixe (l1 ++ l3) l2. +proof. +move:l2 l3;elim l1=>//=;1:smt(take_le0 prefixe_ge0). +move=>e1 l1 hind1 l2;elim:l2=>//=e2 l2 hind2 l3/#. +qed. + +lemma prefixe_take_leq_prefixe (l1 l2 : 'a list) i : + prefixe (take i l1) l2 <= prefixe l1 l2. +proof. +rewrite-{2}(cat_take_drop i l1). +move:(take i l1)(drop i l1);clear i l1=>l1 l3. +exact prefixe_leq_prefixe_cat. +qed. + +lemma prefixe_take_geq_prefixe (l1 l2 : 'a list) i : + prefixe l1 l2 <= i => + prefixe l1 l2 = prefixe (take i l1) l2. +proof. +move=>hi. +cut:prefixe (take i l1) l2 <= prefixe l1 l2. ++ rewrite-{2}(cat_take_drop i l1) prefixe_leq_prefixe_cat. +cut/#:prefixe l1 l2 <= prefixe (take i l1) l2. +rewrite -prefixe_take_prefixe. +rewrite-(cat_take_drop (prefixe l1 l2) (take i l1))take_take min_lel// prefixe_leq_prefixe_cat. +qed. + +lemma get_max_prefixe_take (l : 'a list) (ll : 'a list list) i : + prefixe l (get_max_prefixe l ll) <= i => + get_max_prefixe l ll = get_max_prefixe (take i l) ll. +proof. +move:l;elim:ll=>//=l2 ll Hind l1;clear Hind;move:l1 l2;elim:ll=>//=l3 ll Hind l1 l2. +case( prefixe l1 l2 < prefixe l1 l3 )=>//=h hi. ++ rewrite -prefixe_take_geq_prefixe//=;1:smt(get_max_prefixe_leq). + rewrite -prefixe_take_geq_prefixe//=;1:smt(get_max_prefixe_leq). + rewrite h/=/#. +rewrite -prefixe_take_geq_prefixe//=;1:smt(get_max_prefixe_leq). +rewrite -prefixe_take_geq_prefixe//=;1:smt(get_max_prefixe_leq). +rewrite h/=/#. +qed. + + +lemma drop_prefixe_neq (l1 l2 : 'a list) : + drop (prefixe l1 l2) l1 = [] \/ drop (prefixe l1 l2) l1 <> drop (prefixe l1 l2) l2. +proof. +move:l2;elim:l1=>//=e1 l1 hind1 l2;elim:l2=>//=e2 l2 hind2/#. +qed. + + +lemma prefixe_prefixe_prefixe (l1 l2 l3 : 'a list) (ll : 'a list list) : + prefixe l1 l2 <= prefixe l1 l3 => + prefixe l1 (max_prefixe l1 l2 ll) <= prefixe l1 (max_prefixe l1 l3 ll). +proof. +move:l1 l2 l3;elim:ll=>//=l4 ll hind l1 l2 l3 h123/#. +qed. + +lemma prefixe_lt_size (l : 'a list) (ll : 'a list list) : + prefixe l (get_max_prefixe l ll) < size l => + forall i, prefixe l (get_max_prefixe l ll) < i => + ! take i l \in ll. +proof. +move:l;elim:ll=>//=l2 ll Hind l1;clear Hind;move:l1 l2;elim:ll=>//=. ++ progress. + rewrite-(cat_take_drop (prefixe l1 l2) (take i l1)) + -{3}(cat_take_drop (prefixe l1 l2) l2)take_take/min H0/=. + rewrite prefixe_take. + cut:drop (prefixe l1 l2) (take i l1) <> drop (prefixe l1 l2) l2;2:smt(catsI). + rewrite (prefixe_take_geq_prefixe l1 l2 i) 1:/#. + cut:=drop_prefixe_neq (take i l1) l2. + cut/#:drop (prefixe (take i l1) l2) (take i l1) <> []. + cut:0 < size (drop (prefixe (take i l1) l2) (take i l1));2:smt(size_eq0). + rewrite size_drop 1:prefixe_ge0 size_take;1:smt(prefixe_ge0). + by rewrite-prefixe_take_geq_prefixe /#. + +move=>l3 ll hind l1 l2. +case(prefixe l1 l2 < prefixe l1 l3)=>//=h;progress. ++ rewrite!negb_or/=. + cut:=hind l1 l3 H i H0;rewrite negb_or=>[][->->]/=. + cut:=hind l1 l2 _ i _;smt(prefixe_prefixe_prefixe). +smt(prefixe_prefixe_prefixe). +qed. + +lemma asfadst queries prefixes (bs : block list) : + prefixe_inv queries prefixes => + elems (dom queries ) <> [] => + all_prefixes prefixes => + (forall j, 0 <= j <= size bs => take j bs \in dom prefixes) => + take (prefixe bs (get_max_prefixe bs (elems (dom queries))) + 1) bs = bs. +proof. +progress. +cut h:=prefixe_inv_leq bs (size bs) prefixes queries _ _ _ _ _;rewrite//=. ++ exact size_ge0. ++ rewrite H2//=;exact size_ge0. +cut->/=:prefixe bs (get_max_prefixe bs (elems (dom queries))) = size bs by smt(prefixe_sizel). +rewrite take_oversize/#. +qed. + + +lemma prefixe_exchange_prefixe_inv (ll1 ll2 : 'a list list) (l : 'a list) : + (forall l2, l2 \in ll1 => l2 \in ll2) => + (forall (l2 : 'a list), l2 \in ll1 => forall i, take i l2 \in ll2) => + (forall l2, l2 \in ll2 => exists l3, l2 ++ l3 \in ll1) => + prefixe l (get_max_prefixe l ll1) = prefixe l (get_max_prefixe l ll2). +proof. +case(ll1 = [])=>//=[->/#|]//=ll1_nil. +move=>incl all_prefix incl2 ;cut ll2_nil:ll2 <> [] by rewrite/#. +cut:=get_max_prefixe_max l ll2 (get_max_prefixe l ll1) _. ++ by rewrite incl mem_get_max_prefixe ll1_nil. +cut mem_ll2:=mem_get_max_prefixe l ll2 ll2_nil. +cut[]l3 mem_ll1:=incl2 _ mem_ll2. +cut:=get_max_prefixe_max l ll1 _ mem_ll1. +smt(prefixeC prefixe_leq_prefixe_cat). +qed. + +lemma prefixe_inv_nil queries prefixes : + prefixe_inv queries prefixes => + elems (dom queries) = [] => dom prefixes <= fset1 []. +proof. +move=>[h1 [h2 h3]] h4 x h5;rewrite in_fset1. +cut:=h3 x (size x). +rewrite take_size h5/=;apply absurd=>//=h6. +rewrite h6/=negb_exists/=;smt(memE). +qed. + + +lemma aux_prefixe_exchange queries prefixes (l : block list) : + prefixe_inv queries prefixes => all_prefixes prefixes => + elems (dom queries) <> [] => + prefixe l (get_max_prefixe l (elems (dom queries))) = + prefixe l (get_max_prefixe l (elems (dom prefixes))). +proof. +move=>[h1[h2 h3]] h5 h4;apply prefixe_exchange_prefixe_inv. ++ smt(memE take_size). ++ smt(memE). +move=>l2;rewrite-memE=> mem_l2. +case(l2=[])=>//=hl2;1:rewrite hl2/=. ++ move:h4;apply absurd=>//=;rewrite negb_exists/=/#. +smt(memE take_size). +qed. + +lemma prefixe_exchange queries prefixes (l : block list) : + prefixe_inv queries prefixes => all_prefixes prefixes => + prefixe l (get_max_prefixe l (elems (dom queries))) = + prefixe l (get_max_prefixe l (elems (dom prefixes))). +proof. +move=>[h1[h2 h3]] h5. +case(elems (dom queries) = [])=>//=h4;2:smt(aux_prefixe_exchange). +cut h6:=prefixe_inv_nil queries prefixes _ h4;1:rewrite/#. +rewrite h4/=. search FSet.(<=). +case(elems (dom prefixes) = [])=>//=[->//=|]h7. +cut h8:elems (dom prefixes) = [[]]. ++ cut [hh1 hh2]:[] \in dom prefixes /\ forall x, x \in elems (dom prefixes) => x = [] by smt(memE). + cut h9:=subset_leq_fcard _ _ h6. + apply (eq_from_nth witness)=>//=. + + rewrite-cardE-(fcard1 [<:block>]);move:h9;rewrite!fcard1!cardE=>h9. + cut/#:0 < size (elems (dom prefixes));smt(size_eq0 size_ge0 fcard1). + move:h9;rewrite!fcard1!cardE=>h9 i [hi0 hi1]. + cut->/=:i = 0 by rewrite/#. + by apply hh2;rewrite mem_nth/#. +by rewrite h8=>//=. +qed. + + +(* lemma prefixe_inv_prefixe queries prefixes l : *) +(* prefixe_inv queries prefixes => *) +(* all_prefixes prefixes => *) +(* (elems (dom queries) = [] => elems (dom prefixes) = [[]]) => *) +(* prefixe l (get_max_prefixe l (elems (dom queries))) = *) +(* prefixe l (get_max_prefixe l (elems (dom prefixes))). *) +(* proof. *) +(* move=>[? h_prefixe_inv] h_all_prefixes. *) +(* case(elems (dom queries) = [])=>//=h_nil. *) +(* + by rewrite h_nil//==>->/=. *) +(* cut h_mem_queries:=mem_get_max_prefixe l (elems (dom queries)) h_nil. *) +(* cut h_leq :=all_take_in l (prefixe l (get_max_prefixe l (elems (dom queries)))) _ _ h_all_prefixes _. *) +(* + smt(prefixe_ge0 prefixe_sizel). *) +(* + by rewrite prefixe_take h_prefixe_inv memE h_mem_queries. *) +(* cut:=all_take_in l (prefixe l (get_max_prefixe l (elems (dom prefixes)))) _ _ h_all_prefixes _. *) +(* + smt(prefixe_ge0 prefixe_sizel). *) +(* + *) +(* rewrite prefixe_take. *) + +(* rewrite -take_size. *) + +(* print mem_get_max_prefixe. *) + +(* qed. *) + pred invm (m mi : ('a * 'b, 'a * 'b) fmap) = forall x y, m.[x] = Some y <=> mi.[y] = Some x. @@ -306,67 +758,73 @@ by rewrite/=-2!cats1 blocksponge_cat/=. qed. -pred prefixe_inv (queries : (block list, block) fmap) - (m : (state, state) fmap) = - forall (bs : block list), - bs \in dom queries => - forall i, 0 <= i < size bs => - let bc = (blocksponge (take i bs) m s0).`2 in - (bc.`1 +^ nth b0 bs i, bc.`2) \in dom m. - - - -lemma prefixe_inv_bs_fst_nil queries m : - prefixe_inv queries m => - forall l, l \in dom queries => - forall i, 0 <= i <= size l => - (blocksponge (take i l) m s0).`1 = []. -proof. -move=>Hinv l Hdom i [Hi0 Hisize];move:i Hi0 l Hisize Hdom;apply intind=>//=. -+ by move=>l;rewrite take0/=. -move=>i Hi0 Hind l Hil Hldom. -rewrite(take_nth b0)1:/#. -rewrite blocksponge_rcons/=. -cut->/=:=Hind l _ Hldom;1:rewrite/#. -by cut/=->/=:=Hinv _ Hldom i _;1:rewrite/#. -qed. - - -lemma prefixe_inv_set queries m x y : - !x \in dom m => - prefixe_inv queries m => - prefixe_inv queries m.[x <- y]. -proof. -move=>Hxdom Hpref bs/=Hbsdom i [Hi0 Hisize]. -cut->:blocksponge (take i bs) m.[x <- y] s0 = blocksponge (take i bs) m s0. -+ move:i Hi0 bs Hisize Hbsdom;apply intind=>//=i;first by rewrite take0//=. - move=>Hi0 Hind bs Hsize Hbsdom. - rewrite (take_nth b0)1:/#. - rewrite 2!blocksponge_rcons/=. - cut->/=:=prefixe_inv_bs_fst_nil _ _ Hpref _ Hbsdom i _;1:rewrite/#. - cut/=->/=:=Hpref _ Hbsdom i _;1:rewrite/#. - cut->/=:=Hind bs _ Hbsdom;1:rewrite/#. - cut->/=:=prefixe_inv_bs_fst_nil _ _ Hpref _ Hbsdom i _;1:rewrite/#. - rewrite dom_set in_fsetU1. - cut/=->/=:=Hpref _ Hbsdom i _;1:rewrite/#. - rewrite getP. - cut/#:=Hpref _ Hbsdom i _;1:rewrite/#. -rewrite dom_set in_fsetU1. -cut/#:=Hpref _ Hbsdom i _;1:rewrite/#. -qed. - - -lemma blocksponge_set_nil l m bc x y : - !x \in dom m => - let bs1 = blocksponge l m bc in - let bs2 = blocksponge l m.[x <- y] bc in - bs1.`1 = [] => - bs2 = ([], bs1.`2). -proof. -rewrite/==>hdom bs1. -cut/=:=blocksponge_set l m bc x y. -smt(size_ge0 size_eq0). -qed. +(* lemma prefixe_inv_bs_fst_nil queries prefixes m : *) +(* prefixe_inv queries prefixes m => *) +(* forall l, l \in dom queries => *) +(* forall i, 0 <= i <= size l => *) +(* (blocksponge (take i l) m s0).`1 = []. *) +(* proof. *) +(* move=>[h2 [h3 Hinv]] l Hdom i [Hi0 Hisize];move:i Hi0 l Hisize Hdom;apply intind=>//=. *) +(* + by move=>l;rewrite take0/=. *) +(* move=>i Hi0 Hind l Hil Hldom. *) +(* rewrite(take_nth b0)1:/#. *) +(* rewrite blocksponge_rcons/=. *) +(* cut->/=:=Hind l _ Hldom;1:rewrite/#. *) +(* by cut/=->/=/#:=Hinv _ Hldom i. *) +(* qed. *) + + +(* lemma blocksponge_drop l m bc : *) +(* exists i, 0 <= i <= List.size l /\ (blocksponge l m bc).`1 = drop i l. *) +(* proof. *) +(* move:l bc=>l;elim:l=>//=;1:exists 0=>//=;progress. *) +(* case((bc.`1 +^ x, bc.`2) \in dom m)=>//=h. *) +(* + cut[i [[hi0 His] Hi]]:=H (oget m.[(bc.`1 +^ x, bc.`2)]). *) +(* exists(i+1)=>/#. *) +(* cut[i [[hi0 His] Hi]]:=H (oget m.[(bc.`1 +^ x, bc.`2)]). *) +(* exists 0=>/#. *) +(* qed. *) + + +(* lemma prefixe_inv_set queries prefixes m x y : *) +(* !x \in dom m => *) +(* prefixe_inv queries prefixes m => *) +(* prefixe_inv queries prefixes m.[x <- y]. *) +(* proof. *) +(* move=>Hxdom Hpref;progress=>//=. *) +(* + rewrite/#. *) +(* + rewrite/#. *) +(* cut->:blocksponge (take i bs) m.[x <- y] s0 = blocksponge (take i bs) m s0. *) +(* + move:i H2 bs H3 H1;apply intind=>//=i;first smt(take0). *) +(* move=>Hi0 Hind bs Hisize Hbsdom. *) +(* rewrite (take_nth b0)1:/#. *) +(* rewrite 2!blocksponge_rcons/=. *) +(* cut[?[? Hpre]]:=Hpref. *) +(* cut->/=:=prefixe_inv_bs_fst_nil _ _ _ Hpref _ Hbsdom i _;1:rewrite/#. *) +(* cut/=->/=:=Hpre _ Hbsdom i _;1:rewrite/#. *) +(* cut->/=:=Hind bs _ Hbsdom;1:rewrite/#. *) +(* cut->/=:=prefixe_inv_bs_fst_nil _ _ _ Hpref _ Hbsdom i _;1:rewrite/#. *) +(* rewrite dom_set in_fsetU1. *) +(* cut/=->/=:=Hpre _ Hbsdom i _;1:rewrite/#. *) +(* rewrite getP. *) +(* cut/#:=Hpre _ Hbsdom i _;1:rewrite/#. *) +(* rewrite dom_set in_fsetU1. *) +(* cut[?[? Hpre]]:=Hpref. *) +(* cut/#:=Hpre _ H1 i _;1:rewrite/#. *) +(* qed. *) + + +(* lemma blocksponge_set_nil l m bc x y : *) +(* !x \in dom m => *) +(* let bs1 = blocksponge l m bc in *) +(* let bs2 = blocksponge l m.[x <- y] bc in *) +(* bs1.`1 = [] => *) +(* bs2 = ([], bs1.`2). *) +(* proof. *) +(* rewrite/==>hdom bs1. *) +(* cut/=:=blocksponge_set l m bc x y. *) +(* smt(size_ge0 size_eq0). *) +(* qed. *) (* lemma size_blocksponge queries m l : *) (* prefixe_inv queries m => *) @@ -388,13 +846,9 @@ export Prefixe. module C = { var c : int - var m : (state, state) fmap - var mi : (state, state) fmap var queries : (block list, block) fmap - proc init () = { + proc init () = { c <- 0; - m <- map0; - mi <- map0; queries <- map0; } }. @@ -408,31 +862,15 @@ module PC (P:PRIMITIVE) = { proc f (x:state) = { var y <- (b0,c0); - if (!x \in dom C.m) { - y <@ P.f(x); - C.c <- C.c + 1; - C.m.[x] <- y; - if (! y \in dom C.mi) { - C.mi.[y] <- x; - } - } else { - y <- oget C.m.[x]; - } + y <@ P.f(x); + C.c <- C.c + 1; return y; } proc fi(x:state) = { var y <- (b0,c0); - if (!x \in dom C.mi) { - y <@ P.fi(x); - C.c <- C.c + 1; - C.mi.[x] <- y; - if (! y \in dom C.m) { - C.m.[y] <- x; - } - } else { - y <- oget C.mi.[x]; - } + y <@ P.fi(x); + C.c <- C.c + 1; return y; } @@ -442,34 +880,18 @@ module DPRestr (P:DPRIMITIVE) = { proc f (x:state) = { var y <- (b0,c0); - if (!x \in dom C.m) { - if (C.c + 1 <= max_size) { - y <@ P.f(x); - C.c <- C.c + 1; - C.m.[x] <- y; - if (! y \in dom C.mi) { - C.mi.[y] <- x; - } - } - } else { - y <- oget C.m.[x]; + if (C.c + 1 <= max_size) { + y <@ P.f(x); + C.c <- C.c + 1; } return y; } proc fi(x:state) = { var y <- (b0,c0); - if (!x \in dom C.mi) { - if (C.c + 1 <= max_size) { - y <@ P.fi(x); - C.c <- C.c + 1; - C.mi.[x] <- y; - if (! y \in dom C.m) { - C.m.[y] <- x; - } - } - } else { - y <- oget C.mi.[x]; + if (C.c + 1 <= max_size) { + y <@ P.fi(x); + C.c <- C.c + 1; } return y; } @@ -491,7 +913,9 @@ module PRestr (P:PRIMITIVE) = { module FC(F:FUNCTIONALITY) = { - proc init = F.init + proc init() = { + F.init(); + } proc f (bs:block list) = { var b <- b0; @@ -525,7 +949,10 @@ module DFRestr(F:DFUNCTIONALITY) = { module FRestr(F:FUNCTIONALITY) = { - proc init = F.init + proc init() = { + Redo.init(); + F.init(); + } proc f = DFRestr(F).f @@ -543,10 +970,10 @@ module DRestr(D:DISTINGUISHER, F:DFUNCTIONALITY, P:DPRIMITIVE) = { }. lemma rp_ll (P<:DPRIMITIVE{C}): islossless P.f => islossless DPRestr(P).f. -proof. move=>Hll;proc;sp;if;auto;if;auto;call Hll;auto. qed. +proof. move=>Hll;proc;sp;if;auto;call Hll;auto. qed. lemma rpi_ll (P<:DPRIMITIVE{C}): islossless P.fi => islossless DPRestr(P).fi. -proof. move=>Hll;proc;sp;if;auto;if;auto;call Hll;auto. qed. +proof. move=>Hll;proc;sp;if;auto;call Hll;auto. qed. lemma rf_ll (F<:DFUNCTIONALITY{C}): islossless F.f => islossless DFRestr(F).f. proof. move=>Hll;proc;sp;if;auto;if=>//;auto;call Hll;auto. qed. @@ -575,8 +1002,9 @@ section RESTR. Pr[Indif(FRestr(F), PRestr(P), D).main()@ &m: res] = Pr[Indif(F,P,DRestr(D)).main()@ &m: res]. proof. - byequiv=>//. - proc;inline *;wp;swap{1}1 2;sim;auto;call(:true);auto;call(:true);auto. + byequiv=>//;auto. + proc;inline *;wp. + swap{1}[1..2] 3;sim;auto;call(:true);auto. qed. end section RESTR. @@ -602,22 +1030,22 @@ section COUNT. proof. byequiv (_: ={glob D, glob P, glob CO} ==> C.c{1} <= max_size => ={res})=>//; 2:by move=> ??H[]?/H<-. - symmetry;proc;inline *;wp;swap{2}1 2. + symmetry;proc;inline *;wp. call (_: max_size < C.c, ={glob P, glob CO, glob C}). + apply D_ll. - + proc; sp;if;auto;if{1};1:by auto;call(_:true);auto. - by call{2} f_ll;auto=>/#. - + by move=> ?_;proc;sp;if;auto;if;auto;call f_ll;auto. - + by move=> _;proc;sp;if;auto;call f_ll;auto=>/#. - + proc;sp;if;auto;if{1};1:by auto;call(_:true);auto. + + proc; sp;if{1};1:by auto;call(_:true);auto. + by auto;call{2} f_ll;auto=>/#. + + by move=> ?_;proc;sp;auto;if;auto;call f_ll;auto. + + by move=> _;proc;sp;auto;call f_ll;auto=>/#. + + proc;sp;auto;if{1};1:by auto;call(_:true);auto. by call{2} fi_ll;auto=>/#. - + by move=> ?_;proc;sp;if;auto;if;auto;call fi_ll;auto. - + by move=> _;proc;sp;if;auto;call fi_ll;auto=>/#. + + by move=> ?_;proc;sp;auto;if;auto;call fi_ll;auto. + + by move=> _;proc;sp;auto;call fi_ll;auto=>/#. + proc;inline*;sp 1 1;if;auto;if{1};auto;1:by call(_: ={glob P});auto;sim. by call{2} CO_ll;auto=>/#. + by move=> ?_;proc;sp;if;auto;if;auto;call CO_ll;auto. + by move=> _;proc;sp;if;auto;call CO_ll;auto;smt(prefixe_sizel). - wp;call (_:true);call(_:true);auto=>/#. + auto;call (_:true);auto;call(:true);auto=>/#. qed. end section COUNT. From 5370480a1da6fc7cedb5955a54246f3ae35f0da5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Tue, 20 Feb 2018 18:54:27 +0100 Subject: [PATCH 264/525] ConcreteF.eca : reduce the probability of Strong_RP_RF by a factor of 1/2. Handle.eca : pass the invariant INV_CF_G1 with the prefixes map: - Primitve.f : DONE. - Functionality.f : to finish. - CF ~ G1 : to do. --- proof/smart_counter/ConcreteF.eca | 2 +- proof/smart_counter/Handle.eca | 461 ++++++++++++++++++++++++------ 2 files changed, 368 insertions(+), 95 deletions(-) diff --git a/proof/smart_counter/ConcreteF.eca b/proof/smart_counter/ConcreteF.eca index 91a57bd..beff777 100644 --- a/proof/smart_counter/ConcreteF.eca +++ b/proof/smart_counter/ConcreteF.eca @@ -205,7 +205,7 @@ section. lemma Real_Concrete &m : Pr[GReal(D).main()@ &m: res /\ C.c <= max_size] <= - Pr[CF(DRestr(D)).main()@ &m: res] + (max_size ^ 2)%r * mu dstate (pred1 witness). + Pr[CF(DRestr(D)).main()@ &m: res] + (max_size ^ 2)%r / 2%r * mu dstate (pred1 witness). proof. cut->: Pr[RealIndif(SqueezelessSponge,PC(Perm),D).main()@ &m: diff --git a/proof/smart_counter/Handle.eca b/proof/smart_counter/Handle.eca index 8b52526..713edf2 100644 --- a/proof/smart_counter/Handle.eca +++ b/proof/smart_counter/Handle.eca @@ -4,7 +4,7 @@ require import List FSet NewFMap Utils Common SLCommon RndO. require import DProd Dexcepted. (*...*) import Capacity IntOrder DCapacity. -(* require ConcreteF. *) +require (*--*) ConcreteF. clone import GenEager as ROhandle with type from <- handle, @@ -13,6 +13,7 @@ clone import GenEager as ROhandle with proof sampleto_ll by apply DCapacity.dunifin_ll. + module G1(D:DISTINGUISHER) = { var m, mi : smap var mh, mhi : hsmap @@ -26,6 +27,7 @@ module G1(D:DISTINGUISHER) = { var sa, sa', sc; var h, i <- 0; sa <- b0; + sc <- c0; while (i < size p ) { if (mem (dom mh) (sa +^ nth witness p i, h)) { (sa, h) <- oget mh.[(sa +^ nth witness p i, h)]; @@ -153,7 +155,10 @@ module G1(D:DISTINGUISHER) = { }. (* -------------------------------------------------------------------------- *) -(** The state of CF contains only the map PF.m. +(** The state of CF contains + - the map PF.m that represents the primitive's map. + - the map Redo.prefixes that contains all the prefixes computations of the + sponge construction. The state of G1 contains: - the map hs that associates handles to flagged capacities; - the map G1.m that represents the *public* view of map PF.m; @@ -178,6 +183,20 @@ inductive m_mh (hs : handles) (m : smap) (mh : hsmap) = /\ hs.[hy] = Some (yc,fy) /\ m.[(xa,xc)] = Some (ya,yc)). + +(* WELL-FORMEDNESS<1>: Map and Prefixes are compatible *) +inductive m_p (m : smap) (p : (block list, state) fmap) = + | INV_m_p of (p.[[]] = Some (b0,c0)) + & (forall (l : block list), + l \in dom p => + (forall i, 0 <= i < size l => + exists sa sc, p.[take i l] = Some (sa, sc) /\ + m.[(sa +^ nth witness l i, sc)] = p.[take (i+1) l])). + +(** RELATIONAL : Prefixes and RO are compatible. **) +inductive ro_p (ro : (block list, block) fmap) (p : (block list, state) fmap) = + | INV_ro_p of (ro = map (+ (fun (a:state)=> a.`1)) p). + (* WELL-FORMEDNESS<2>: Handles, Map, Handle-Map and RO are compatible *) inductive mh_spec (hs : handles) (Gm : smap) (mh : hsmap) (ro : (block list,block) fmap) = | INV_mh of (forall xa hx ya hy, @@ -221,7 +240,8 @@ inductive inv_spec (m:('a,'b) fmap) mi = (* Invariant: maybe we should split relational and non-relational parts? *) inductive INV_CF_G1 (hs : handles) ch (Pm Pmi Gm Gmi : smap) - (mh mhi : hsmap) (ro : (block list,block) fmap) pi = + (mh mhi : hsmap) (ro : (block list,block) fmap) pi + (p : (block list, state) fmap) = | HCF_G1 of (hs_spec hs ch) & (inv_spec Gm Gmi) & (inv_spec mh mhi) @@ -230,15 +250,17 @@ inductive INV_CF_G1 (hs : handles) ch (Pm Pmi Gm Gmi : smap) & (incl Gm Pm) & (incl Gmi Pmi) & (mh_spec hs Gm mh ro) - & (pi_spec hs mh pi). + & (pi_spec hs mh pi) + (* & (ro_p ro p) *) + & (m_p Pm p). (** Structural Projections **) lemma m_mh_of_INV (ch : handle) (mi1 m2 mi2 : smap) (mhi2 : hsmap) (ro : (block list, block) fmap) (pi : (capacity, block list * block) fmap) - hs m1 mh2: - INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi => + hs m1 mh2 p: + INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi p => m_mh hs m1 mh2. proof. by case. qed. @@ -246,8 +268,8 @@ lemma mi_mhi_of_INV (ch : handle) (m1 m2 mi2 : smap) (mh2 : hsmap) (ro : (block list, block) fmap) (pi : (capacity, block list * block) fmap) - hs mi1 mhi2: - INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi => + hs mi1 mhi2 p: + INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi p => m_mh hs mi1 mhi2. proof. by case. qed. @@ -255,8 +277,8 @@ lemma incl_of_INV (hs : handles) (ch : handle) (mi1 mi2 : smap) (mh2 mhi2: hsmap) (ro : (block list, block) fmap) (pi : (capacity, block list * block) fmap) - m1 m2: - INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi => + m1 m2 p: + INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi p => incl m2 m1. proof. by case. qed. @@ -264,46 +286,72 @@ lemma incli_of_INV (hs : handles) (ch : handle) (m1 m2 : smap) (mh2 mhi2: hsmap) (ro : (block list, block) fmap) (pi : (capacity, block list * block) fmap) - mi1 mi2: - INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi => + mi1 mi2 p: + INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi p => incl mi2 mi1. proof. by case. qed. lemma mh_of_INV (ch : handle) (m1 mi1 mi2 : smap) (mhi2 : hsmap) (pi : (capacity, block list * block) fmap) - hs m2 mh2 ro: - INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi => + hs m2 mh2 ro p: + INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi p => mh_spec hs m2 mh2 ro. proof. by case. qed. lemma pi_of_INV (ch : handle) (m1 m2 mi1 mi2: smap) (mhi2: hsmap) (ro : (block list, block) fmap) - hs mh2 pi: - INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi => + hs mh2 pi p: + INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi p => pi_spec hs mh2 pi. proof. by case. qed. lemma hs_of_INV (m1 m2 mi1 mi2 : smap) (mh2 mhi2 : hsmap) (ro : (block list, block) fmap) (pi : (capacity, block list * block) fmap) - hs ch: - INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi => + hs ch p: + INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi p => hs_spec hs ch. proof. by case. qed. lemma inv_of_INV hs ch m1 mi1 m2 mi2 ro pi - mh2 mhi2: - INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi => + mh2 mhi2 p: + INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi p=> inv_spec mh2 mhi2. proof. by case. qed. -lemma invG_of_INV hs ch m1 mi1 mh2 mhi2 ro pi m2 mi2: - INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi => +lemma invG_of_INV hs ch m1 mi1 mh2 mhi2 ro pi m2 mi2 p: + INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi p => inv_spec m2 mi2. proof. by case. qed. +lemma m_p_of_INV hs ch m1 mi1 mh2 mhi2 ro pi m2 mi2 p: + INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi p => + m_p m1 p. +proof. by case. qed. + +lemma all_prefixes_of_m_p m1 p: + m_p m1 p => all_prefixes p. +proof. +case=>_ h l hl i. +case(l = [])=>//=l_notnil. +case(0 <= i)=>hi0;last first. ++ rewrite take_le0 1:/#;cut<-:=take0 l;smt(in_dom size_ge0). +case(i < size l)=>hisize;last smt(take_oversize). +smt(in_dom). +qed. + +lemma all_prefixes_of_INV hs ch m1 mi1 mh2 mhi2 ro pi m2 mi2 p: + INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi p => + all_prefixes p. +proof. case=>? ? ? ? ? ? ? ? ? ? h ?;exact(all_prefixes_of_m_p _ h). qed. + +lemma ro_p_of_INV hs ch m1 mi1 mh2 mhi2 ro pi m2 mi2 p: + INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi p => + ro_p ro p. +proof. by case. qed. + (** Useful Lemmas **) lemma ch_gt0 hs ch : hs_spec hs ch => 0 < ch. proof. by case=> _ + Hlt -/Hlt. qed. @@ -664,8 +712,8 @@ by move=> hs_hy; exists p ya yc hy b xa xc hx []; rewrite cats0. qed. (** Path-specific lemmas **) -lemma lemma1 hs ch Pm Pmi Gm Gmi mh mhi ro pi x1 x2 y1 y2: - INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi +lemma lemma1 hs ch Pm Pmi Gm Gmi mh mhi ro pi x1 x2 y1 y2 prefixes: + INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes => x2 <> y2 => Pm.[(x1,x2)] = None => Gm.[(x1,x2)] = None @@ -676,7 +724,7 @@ lemma lemma1 hs ch Pm Pmi Gm Gmi mh mhi ro pi x1 x2 y1 y2: Pm.[(x1,x2) <- (y1,y2)] Pmi.[(y1,y2) <- (x1,x2)] Gm.[(x1,x2) <- (y1,y2)] Gmi.[(y1,y2) <- (x1,x2)] mh.[(x1,ch) <- (y1,ch + 1)] mhi.[(y1,ch + 1) <- (x1,ch)] - ro pi. + ro pi prefixes. proof. move=> HINV x2_neq_y2 Pm_x Gm_x x2_notin_rng1_hs y2_notin_rng1_hs; split. + rewrite (@addzA ch 1 1); apply/hs_addh. @@ -755,12 +803,22 @@ have H /H {H}:= build_hpath_down mh x1 ch y1 (ch + 1) p v h _. + move=> p0 v0; rewrite -negP=> /build_hpathP [<*>|]. + by have /hs_of_INV [] _ + H - /H {H} := HINV. by move=> p' b' v' h' <*>; rewrite ch_notin_rng2_mh. -move=> ^ /build_hpathP + -> /=; rewrite !getP. -by case=> [<*>|/#]; move: HINV=> /hs_of_INV [] _ + H - /H {H} /#. ++ move=> ^ /build_hpathP + -> /=; rewrite !getP. + by case=> [<*>|/#]; move: HINV=> /hs_of_INV [] _ + H - /H {H} /#. ++ by apply(ro_p_of_INV _ _ _ _ _ _ _ _ _ HINV). +split=>[]. ++ by case:HINV=>_ _ _ _ _ _ _ _ _ [] _ [] ->//. +move=>l hmem i hi. +cut[]_ h2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. +cut[]sa sc[]:=h2 l hmem i hi. +cut h1:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. +smt(in_dom getP). qed. -lemma lemma1' hs ch Pm Pmi Gm Gmi mh mhi ro pi x1 x2 y1 y2: - INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi + +lemma lemma1' hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes x1 x2 y1 y2: + INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes + => ! (y1,y2) \in dom Pm => x2 <> y2 => Pmi.[(x1,x2)] = None => Gmi.[(x1,x2)] = None @@ -771,9 +829,9 @@ lemma lemma1' hs ch Pm Pmi Gm Gmi mh mhi ro pi x1 x2 y1 y2: Pm.[(y1,y2) <- (x1,x2)] Pmi.[(x1,x2) <- (y1,y2)] Gm.[(y1,y2) <- (x1,x2)] Gmi.[(x1,x2) <- (y1,y2)] mh.[(y1,ch + 1) <- (x1,ch)] mhi.[(x1,ch) <- (y1,ch + 1)] - ro pi. + ro pi prefixes. proof. -move=> HINV x2_neq_y2 Pm_x Gm_x xc_notin_rng1_hs yc_notin_rng1_hs; split. +move=> HINV hh x2_neq_y2 Pm_x Gm_x xc_notin_rng1_hs yc_notin_rng1_hs; split. + rewrite (@addzA ch 1 1); apply/hs_addh. + by move: HINV=> /hs_of_INV/hs_addh=> ->. by move=> f h; rewrite getP; case: (h = ch)=> [/#|_]; exact/yc_notin_rng1_hs. @@ -849,12 +907,20 @@ have H /H {H}:= build_hpath_down mh y1 (ch + 1) x1 ch p v h _. + move=> p0 v0; rewrite -negP=> /build_hpathP [<*>|]. + by have /hs_of_INV [] _ + H - /H {H} /# := HINV. by move=> p' b' v' h' <*>; rewrite Sch_notin_rng2_mh. -move=> ^ /build_hpathP + -> /=; rewrite !getP. -by case=> [<*>|/#]; move: HINV=> /hs_of_INV [] _ + H - /H {H} /#. ++ move=> ^ /build_hpathP + -> /=; rewrite !getP. + by case=> [<*>|/#]; move: HINV=> /hs_of_INV [] _ + H - /H {H} /#. ++ by apply(ro_p_of_INV _ _ _ _ _ _ _ _ _ HINV). +split=>[]. ++ by case:HINV=>_ _ _ _ _ _ _ _ _ [] _ [] ->//. +move=>l hmem i hi. +cut[]_ h2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. +cut[]sa sc[]:=h2 l hmem i hi. +cut h1:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. +smt(in_dom getP). qed. -lemma lemma2 hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi x1 x2 y1 y2 hx: - INV_CF_G1 hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi +lemma lemma2 hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi prefixes x1 x2 y1 y2 hx: + INV_CF_G1 hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi prefixes => PFm.[(x1,x2)] = None => G1m.[(x1,x2)] = None => pi.[x2] = None @@ -864,7 +930,7 @@ lemma lemma2 hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi x1 x2 y1 y2 hx: PFm.[(x1,x2) <- (y1,y2)] PFmi.[(y1,y2) <- (x1,x2)] G1m.[(x1,x2) <- (y1,y2)] G1mi.[(y1,y2) <- (x1,x2)] G1mh.[(x1,hx) <- (y1,ch)] G1mhi.[(y1,ch) <- (x1,hx)] - ro pi. + ro pi prefixes. proof. move=> HINV PFm_x1x2 G1m_x1x2 pi_x2 hs_hx y2_notin_rng1_hs. split. @@ -936,12 +1002,21 @@ have H /H {H} := build_hpath_down G1mh x1 hx y1 ch p v h no_path_to_hx. move=> ^ Hpath -> /=; rewrite getP; case: (h = ch)=> [<*> /= [#] <*>|//=]. move: Hpath=> /build_hpathP [<*>|]. + by have /hs_of_INV [] _ + H - /H {H}:= HINV. -move=> p' b' v' h' <*> _; have /m_mh_of_INV [] _ H /H {H}:= HINV. -by move=> [xc fx yc fy] [#] _; have /hs_of_INV [] _ _ H /H {H}:= HINV. ++ move=> p' b' v' h' <*> _; have /m_mh_of_INV [] _ H /H {H}:= HINV. + by move=> [xc fx yc fy] [#] _; have /hs_of_INV [] _ _ H /H {H}:= HINV. ++ by apply(ro_p_of_INV _ _ _ _ _ _ _ _ _ HINV). +split=>[]. ++ by case:HINV=>_ _ _ _ _ _ _ _ _ [] _ [] ->//. +move=>l hmem i hi. +cut[]_ h2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. +cut[]sa sc[]:=h2 l hmem i hi. +cut h1:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. +smt(in_dom getP). qed. -lemma lemma2' hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi x1 x2 y1 y2 hx: - INV_CF_G1 hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi +lemma lemma2' hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi prefixes x1 x2 y1 y2 hx: + INV_CF_G1 hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi prefixes + => ! (y1,y2) \in dom PFm => PFmi.[(x1,x2)] = None => G1mi.[(x1,x2)] = None => hs.[hx] = Some (x2,Known) @@ -950,9 +1025,9 @@ lemma lemma2' hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi x1 x2 y1 y2 hx: PFm.[(y1,y2) <- (x1,x2)] PFmi.[(x1,x2) <- (y1,y2)] G1m.[(y1,y2) <- (x1,x2)] G1mi.[(x1,x2) <- (y1,y2)] G1mh.[(y1,ch) <- (x1,hx)] G1mhi.[(x1,hx) <- (y1,ch)] - ro pi. + ro pi prefixes. proof. -move=> HINV PFmi_x1x2 G1mi_x1x2 hs_hx y2_notin_rng1_hs. +move=> HINV hh PFmi_x1x2 G1mi_x1x2 hs_hx y2_notin_rng1_hs. split. + by apply/hs_addh=> //=; case: HINV. + apply/inv_addm=> //; 1:by case: HINV. @@ -1032,16 +1107,24 @@ have no_path_to_ch: forall p0 v0, build_hpath G1mh p0 <> Some (v0,ch). apply/negb_exists=> b' /=; apply/negb_exists=> h' /=; apply/negb_and=> /=; right. rewrite -negP; have /mh_of_INV [] H _ _ /H {H} [? ? ? ?] [#] _ := HINV. by have /hs_of_INV [] _ _ H /H {H} := HINV. -have H /H {H} := build_hpath_down G1mh y1 ch x1 hx p v h no_path_to_ch. -move=> ^ Hpath -> /=; rewrite getP; case: (h = ch)=> [<*> /= [#] <*>|//=]. -move: Hpath=> /build_hpathP [<*>|]. -+ by have /hs_of_INV [] _ + H - /H {H}:= HINV. -move=> p' b' v' h' <*> _; have /m_mh_of_INV [] _ H /H {H}:= HINV. -by move=> [xc fx yc fy] [#] _; have /hs_of_INV [] _ _ H /H {H}:= HINV. ++ have H /H {H} := build_hpath_down G1mh y1 ch x1 hx p v h no_path_to_ch. + move=> ^ Hpath -> /=; rewrite getP; case: (h = ch)=> [<*> /= [#] <*>|//=]. + move: Hpath=> /build_hpathP [<*>|]. + + by have /hs_of_INV [] _ + H - /H {H}:= HINV. + move=> p' b' v' h' <*> _; have /m_mh_of_INV [] _ H /H {H}:= HINV. + by move=> [xc fx yc fy] [#] _; have /hs_of_INV [] _ _ H /H {H}:= HINV. ++ by apply(ro_p_of_INV _ _ _ _ _ _ _ _ _ HINV). +split=>[]. ++ by case:HINV=>_ _ _ _ _ _ _ _ _ [] _ [] ->//. +move=>l hmem i hi. +cut[]_ h2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. +cut[]sa sc[]:=h2 l hmem i hi. +cut h1:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. +smt(in_dom getP). qed. -lemma lemma3 hs ch Pm Pmi Gm Gmi mh mhi ro pi xa xc hx ya yc hy p b: - INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi +lemma lemma3 hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes xa xc hx ya yc hy p b: + INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes => Pm.[(xa,xc)] = Some (ya,yc) => Gm.[(xa,xc)] = None => mh.[(xa,hx)] = Some (ya,hy) @@ -1052,7 +1135,7 @@ lemma lemma3 hs ch Pm Pmi Gm Gmi mh mhi ro pi xa xc hx ya yc hy p b: Pm Pmi Gm.[(xa,xc) <- (ya,yc)] Gmi.[(ya,yc) <- (xa,xc)] mh mhi - ro pi.[yc <- (rcons p (b +^ xa),ya)]. + ro pi.[yc <- (rcons p (b +^ xa),ya)] prefixes. proof. move=> HINV Pm_xaxc Gm_xaxc mh_xahx hs_hx hs_hy pi_xc. split. @@ -1102,24 +1185,32 @@ split. rewrite getP; case: (hx' = hy)=> /= [<*>|//]. move: hs_hx'; rewrite hs_hy=> /= [#] <<*> /=. by move: Hite=> /= [#]; case: fy' hs_hy'=> //= _ ->. -split=> c p' b'; rewrite !getP; case: (yc = c)=> [<<*> /=|yc_neq_c]; last first. -+ rewrite (@eq_sym c) yc_neq_c /=; have /pi_of_INV [] -> := HINV. - apply/exists_iff=> h /=; rewrite getP; case: (h = hy)=> [<*> /=|//=]. - by rewrite yc_neq_c hs_hy /=. -split=> [[#] <<*>|]. -+ exists hy; rewrite getP /=; apply/build_hpath_prefix. - exists b hx; rewrite xorwA xorwK xorwC xorw0 mh_xahx /=. ++ split=> c p' b'; rewrite !getP; case: (yc = c)=> [<<*> /=|yc_neq_c]; last first. + + rewrite (@eq_sym c) yc_neq_c /=; have /pi_of_INV [] -> := HINV. + apply/exists_iff=> h /=; rewrite getP; case: (h = hy)=> [<*> /=|//=]. + by rewrite yc_neq_c hs_hy /=. + split=> [[#] <<*>|]. + + exists hy; rewrite getP /=; apply/build_hpath_prefix. + exists b hx; rewrite xorwA xorwK xorwC xorw0 mh_xahx /=. + move: pi_xc; have /pi_of_INV [] -> [h] [#] + hs_h:= HINV. + by have /hs_of_INV [] + _ _ - /(_ _ _ _ _ hs_hx hs_h _) := HINV. + move=> [h]; rewrite getP; case: (h = hy)=> [<*> /=|]; last first. + + by have /hs_of_INV [] H _ _ + [#] _ /H {H} /(_ _ _ hs_hy _) // <*> := HINV. + have /mh_of_INV [] _ _ /(_ p' b') H /H {H} /(_ (rcons p (b +^ xa)) ya _) //:= HINV. + apply/build_hpath_prefix; exists b hx; rewrite xorwA xorwK xorwC xorw0 mh_xahx /=. move: pi_xc; have /pi_of_INV [] -> [h] [#] + hs_h:= HINV. by have /hs_of_INV [] + _ _ - /(_ _ _ _ _ hs_hx hs_h _) := HINV. -move=> [h]; rewrite getP; case: (h = hy)=> [<*> /=|]; last first. -+ by have /hs_of_INV [] H _ _ + [#] _ /H {H} /(_ _ _ hs_hy _) // <*> := HINV. -have /mh_of_INV [] _ _ /(_ p' b') H /H {H} /(_ (rcons p (b +^ xa)) ya _) //:= HINV. -apply/build_hpath_prefix; exists b hx; rewrite xorwA xorwK xorwC xorw0 mh_xahx /=. -move: pi_xc; have /pi_of_INV [] -> [h] [#] + hs_h:= HINV. -by have /hs_of_INV [] + _ _ - /(_ _ _ _ _ hs_hx hs_h _) := HINV. ++ by apply(ro_p_of_INV _ _ _ _ _ _ _ _ _ HINV). +split=>[]. ++ by case:HINV=>_ _ _ _ _ _ _ _ _ [] _ [] ->//. +move=>l hmem i hi. +cut[]_ h2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. +cut[]sa sc[]:=h2 l hmem i hi. +cut h1:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. +smt(in_dom getP). qed. -(* clone export ConcreteF as ConcreteF1. *) +clone export ConcreteF as ConcreteF1. lemma m_mh_None hs0 PFm G1mh hx2 x2 k x1: m_mh hs0 PFm G1mh => @@ -1200,10 +1291,29 @@ proof. qed. - - -(* we should do a lemma to have the equivalence *) +lemma lemma4 hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes i p sa sc h f: + INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes +=> 0 <= i < List.size p +=> take (i + 1) p \in dom prefixes +=> prefixes.[take i p] = Some (sa,sc) +=> build_hpath mh (take i p) = Some (sa,h) +=> hs.[h] = Some (sc, f) +=> (sa +^ nth witness p i, h) \in dom mh. +proof. +move=>inv0 hi take_i1_p_in_prefixes prefixes_sa_sc build_hpath_i_p hs_h_sc_f. +cut[]_ m_prefixe:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ inv0. +cut[]b1 c1[]:=m_prefixe _ take_i1_p_in_prefixes i _;1:smt(size_take). +rewrite!take_take!min_lel 1,2:/# nth_take 1,2:/# prefixes_sa_sc/==>[][<-<-]{b1 c1}Pm_prefixe. +cut[]hh1 hh2 hh3:=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ inv0. +cut:ro.[take (i+1) p] = Some (oget prefixes.[take (i+1) p]).`1 + by cut[]->:=(ro_p_of_INV _ _ _ _ _ _ _ _ _ _ _ inv0);smt(mapP get_oget). +cut{1}->:=(take_nth witness i p);1:smt(size_take);move=>h1. +cut:=hh2 (take i p) (nth witness p i) (oget prefixes.[take (i + 1) p]).`1. +rewrite h1/==>[][] v hx hy;rewrite build_hpath_i_p/==>[][][?<-];smt(in_dom). +qed. + +(* we should do a lemma to have the equivalence *) equiv eq_fi (D <: DISTINGUISHER {PF, RO, G1}): PF.fi ~ G1(D).S.fi: @@ -1215,6 +1325,7 @@ equiv eq_fi (D <: DISTINGUISHER {PF, RO, G1}): PF.fi ~ G1(D).S.fi: G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} + Redo.prefixes{1} ==> !G1.bcol{2} => !G1.bext{2} => ={res} @@ -1222,15 +1333,16 @@ equiv eq_fi (D <: DISTINGUISHER {PF, RO, G1}): PF.fi ~ G1(D).S.fi: PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} - F.RO.m{2} G1.paths{2}. + F.RO.m{2} G1.paths{2} + Redo.prefixes{1}. proof. exists* FRO.m{2}, G1.chandle{2}, PF.m{1}, PF.mi{1}, G1.m{2}, G1.mi{2}, G1.mh{2}, G1.mhi{2}, - F.RO.m{2}, G1.paths{2}, x{2}. -elim* => hs ch Pm Pmi Gm Gmi mh mhi ro pi [xa xc]. + F.RO.m{2}, G1.paths{2}, x{2}, Redo.prefixes{1}. +elim* => hs ch Pm Pmi Gm Gmi mh mhi ro pi [xa xc] prefixes. case @[ambient]: - {-1}(INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi) - (eq_refl (INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi)); last first. + {-1}(INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes) + (eq_refl (INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes)); last first. + by move=> inv0; exfalso=> ? ? [#] <<*>; rewrite inv0. move=> /eqT inv0; proc. case @[ambient]: {-1}(Pmi.[(xa,xc)]) (eq_refl Pmi.[(xa,xc)])=> [Pmi_xaxc|[ya yc] Pmi_xaxc]. @@ -1258,13 +1370,22 @@ case @[ambient]: {-1}(Pmi.[(xa,xc)]) (eq_refl Pmi.[(xa,xc)])=> [Pmi_xaxc|[ya yc] rewrite(@huniq_hinvK_h ch) 3:oget_some /=. + by apply/huniq_addh=> //; have /hs_of_INV [] := inv0. + by rewrite getP. - apply/(@lemma1' hs ch Pm Pmi Gm Gmi mh mhi ro pi xa xc ya yc inv0 _ Pmi_xaxc Gmi_xaxc)=> //. + apply/(@lemma1' hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes xa xc ya yc inv0 _ _ Pmi_xaxc Gmi_xaxc)=> //;first last. + rewrite -negP=> <*>; move: yc_notin_rng1_hs_addh => /=. apply/negb_forall=> /=; exists ch; apply/negb_forall=> /=; exists Known. by rewrite getP. + move=> f h; move: (yc_notin_rng1_hs_addh h f); rewrite getP. case: (h = ch)=> <*> //= _; rewrite -negP. by have /hs_of_INV [] _ _ H /H {H} := inv0. + + rewrite in_dom/=;cut[]h1 h2:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ inv0. + cut h1':=h1 ya yc. + cut :Pm.[(ya, yc)] <> None => exists (hx : handle) (fx : flag), hs.[hx] = Some (yc, fx) by rewrite/#. + case(Pm.[(ya, yc)] = None)=>//=h; + rewrite negb_exists/==>a;rewrite negb_exists/==>b. + cut:=yc_notin_rng1_hs_addh a b;rewrite getP;case(a=ch)=>//=hach. search (&&). + case(xc=yc)=>[/#|]hxyc. + cut[]_ _ help:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ inv0. + by cut/#:=help (yc,b) a. have /hs_of_INV [] Hhuniq _ _ [] /(getflagP_some _ _ _ Hhuniq):= inv0. + move=> x2_is_U; conseq (_: _ ==> G1.bext{2})=> //. by auto=> ? ? [#] !<<- _ -> ->> _ /=; rewrite x2_is_U. @@ -1279,7 +1400,14 @@ case @[ambient]: {-1}(Pmi.[(xa,xc)]) (eq_refl Pmi.[(xa,xc)])=> [Pmi_xaxc|[ya yc] rewrite (@huniq_hinvK_h hx2) // oget_some /= => y1 -> /= y2 -> /=. case: (hinvP hs y2)=> [_ y2_notin_rng1_hs _ _|/#]. rewrite getP /= oget_some /=. - by apply/lemma2'=> // f h; exact/y2_notin_rng1_hs. + apply/lemma2'=> //. + + rewrite in_dom/=;cut[]h1 _:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ inv0. + cut h1':=h1 y1 y2. + cut :Pm.[(y1, y2)] <> None => exists (hx : handle) (fx : flag), hs.[hx] = Some (y2, fx) by rewrite/#. + case(Pm.[(y1, y2)] = None)=>//=h; + rewrite negb_exists/==>a;rewrite negb_exists/==>b. + exact(y2_notin_rng1_hs). + move=> f h; exact/y2_notin_rng1_hs. rcondf{1} 1; 1:by auto=> &hr [#] <<*>; rewrite in_dom Pmi_xaxc. case @[ambient]: {-1}(Gmi.[(xa,xc)]) (eq_refl Gmi.[(xa,xc)])=> [|[ya' yc'] ^] Gmi_xaxc. + rcondt{2} 1; 1:by auto=> &hr [#] <<*>; rewrite in_dom Gmi_xaxc. @@ -1291,7 +1419,7 @@ case @[ambient]: {-1}(Gmi.[(xa,xc)]) (eq_refl Gmi.[(xa,xc)])=> [|[ya' yc'] ^] Gm have ^/inv_of_INV [] <- /mh_of_INV [] H _ _ /H {H} := inv0. move=> [? ? ? ?] [#]; rewrite hs_hx hs_hy=> /= [#] <<*> [#] <<*>. case: fx hs_hx=> hs_hx /= => [_|[#]]; first by exists hx. - by have /invG_of_INV [] -> := inv0; rewrite Gmi_xaxc. print Block.DBlock. + by have /invG_of_INV [] -> := inv0; rewrite Gmi_xaxc. smt (@Block.DBlock @Capacity.DCapacity). have /incli_of_INV <- := inv0; 1:by rewrite Gmi_xaxc. rewrite Pmi_xaxc=> /= [#] <<*>. @@ -1323,37 +1451,182 @@ qed. equiv PFf_Cf (D<:DISTINGUISHER): SqueezelessSponge(PF).f ~ G1(D).C.f : ! (G1.bcol{2} \/ G1.bext{2}) /\ ={p} /\ p{1} <> [] /\ - INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} ==> + INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} + G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} Redo.prefixes{1} ==> ! (G1.bcol{2} \/ G1.bext{2}) => - ={res} /\ INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2}. + ={res} /\ INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} + G1.mi{2} G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} Redo.prefixes{1}. proof. - proc. ; seq 2 4: + proc;sp. + seq 1 1: ((!(G1.bcol{2} \/ G1.bext{2}) => - (INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} /\ + (INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} + G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} Redo.prefixes{1} /\ F.RO.m.[p]{2} = Some sa{1})));last first. + case : (! (G1.bcol{2} \/ G1.bext{2})); 2: by conseq (_:_ ==> true)=> //; inline *;auto;rewrite Block.DBlock.dunifin_ll. inline *; rcondf{2} 3. + by move=> &m;auto=> &hr [#] H /H[_ H1] ??;rewrite in_dom H1. by auto=> /> &m1 &m2;rewrite Block.DBlock.dunifin_ll /= => H /H [-> ->];rewrite oget_some. - while ( - p{1} = (drop i p){2} /\ (0 <= i <= size p){2} /\ - (!(G1.bcol{2} \/ G1.bext{2}) => - (INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} /\ - ={sa} /\ + while ( ={p, i} /\ (0 <= i <= size p){2} /\ + (Redo.prefixes.[take i p]{1} = Some (sa,sc){1}) /\ + (take i p \in dom Redo.prefixes){1} /\ + (!(G1.bcol{2} \/ G1.bext{2}) => + (INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} + G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} Redo.prefixes{1} /\ + ={sa} /\ (exists f, FRO.m.[h]{2} = Some (sc{1}, f)) /\ (build_hpath G1.mh (take i p) = Some (sa,h)){2} /\ if i{2} = 0 then (sa,h){2} = (b0, 0) else F.RO.m.[take i p]{2} = Some sa{1})));last first. - + auto=> &m1 &m2 [#] -> -> Hp ^ Hinv -> /=;rewrite drop0 size_ge0 /=;split. - + split;[split|];1: by exists Known;case Hinv => -[] _ ->. - + by rewrite take0. - by case (p{m2}) => //=;smt w=size_ge0. - move=> ????? ????? ?? iR ? ->> ?[#] _ ?? H /H{H} [#] -> ->> _ ?. - have -> : iR = size p{m2} by smt (). - have -> /= : size p{m2} <> 0 by smt (size_ge0). - by rewrite take_size. - inline *;sp 1 0;wp=> /=. + + auto=> &m1 &m2 [#]->->-> _->->->->-> Hp ^ Hinv -> /=;rewrite size_ge0/=;split. + + split;-1: split;-1: split;-2: by exists Known;case Hinv => -[] _ ->. + + by rewrite take0;case:Hinv=>_ _ _ _ _ _ _ _ _ _ []->//. + + by rewrite take0 in_dom;case:Hinv=>_ _ _ _ _ _ _ _ _ _ []->//. + by rewrite take0. + progress. + + rewrite/#. + + smt(size_eq0 size_ge0 take_size). + if{1}. + + case : (! (G1.bcol{2} \/ G1.bext{2}));last first. + + wp;conseq(:_==> (G1.bcol{2} \/ G1.bext{2}));1:smt(get_oget). + by inline*;if{2};auto;smt(DCapacity.dunifin_ll DBlock.dunifin_ll). + rcondt{2}1;1:auto;progress. + * smt(lemma4). + auto;progress. + * rewrite/#. + * rewrite/#. + * smt(get_oget). + * rewrite/#. + * move:H3;rewrite H7/==>[];progress. + cut:=lemma4 _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ H3 _ H6 H1 H10 H9;1:rewrite/#. + rewrite in_dom=>hG1. + cut[]b1 h1 hb1h1:exists b1 h1, G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2})] = Some (b1, h1) by rewrite/#. + cut[]_ h:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ H3. + cut[]b' c':=h _ H6 i{2} _;1:smt(size_take). + rewrite!take_take!min_lel 1,2:/# nth_take 1,2:/#H1/==>[][][<<-<<-]{b' c'} h'{h}. + rewrite-h' hb1h1/=oget_some/=. + cut[]hh1 hh2:= m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ H3. + cut[]a b c d:=hh2 _ _ _ _ hb1h1. + by rewrite H9/==>[][][]->>->>[]_->;rewrite !oget_some/=/#. + + * move:H3;rewrite H7=>//=[];progress. + cut:=lemma4 _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ H3 _ H6 H1 H10 H9;1:rewrite/#. + rewrite in_dom=>hG1. + cut[]b1 h1 hb1h1:exists b1 h1, G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2})] = Some (b1, h1) by rewrite/#. + cut[]_ h:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ H3. + cut[]b' c':=h _ H6 i{2} _;1:smt(size_take). + rewrite!take_take!min_lel 1,2:/# nth_take 1,2:/#H1/==>[][][<<-<<-]{b' c'} h'{h}. + rewrite-h' hb1h1/=oget_some/=. + cut[]hh1 hh2:= m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ H3. + cut[]a b c d:=hh2 _ _ _ _ hb1h1. + by rewrite H9/==>[][][]->>->>[]->->;rewrite !oget_some/=/#. + + * move:H3;rewrite H7=>//=[];progress. + cut:=lemma4 _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ H3 _ H6 H1 H10 H9;1:rewrite/#. + rewrite in_dom=>hG1. + cut[]b1 h1 hb1h1:exists b1 h1, G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2})] = Some (b1, h1) by rewrite/#. + cut->:=(take_nth witness i{2} p{2} _);rewrite//=. + by rewrite build_hpath_prefix H10/=hb1h1/=;smt(oget_some). + * rewrite/#. + * rewrite/#. + * move:H3;rewrite H7/==>[];progress. + by cut[]->:=ro_p_of_INV _ _ _ _ _ _ _ _ _ _ _ H3;smt(mapP get_oget). + inline *;sp 2 0;wp=> /=. + conseq(:_==> (! (G1.bcol{2} \/ G1.bext{2}) => (oget PF.m{1}.[x{1}]).`1 = sa{2} + /\ build_hpath G1.mh{2} (take (i{2} + 1) p{2}) = Some (sa{2}, h{2}) + /\ (exists (f : flag), FRO.m{2}.[h{2}] = Some ((oget PF.m{1}.[x{1}]).`2, f)) + /\ INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} + G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} + Redo.prefixes{1}.[take (i{1} + 1) p{1} <- + ((oget PF.m{1}.[x{1}]).`1, (oget PF.m{1}.[x{1}]).`2)])); + progress;..-3:smt(getP dom_set in_fsetU1 mapP getP). + * by move:H7;rewrite H8/==>[][] _ []_ [] _ [] _ _ _ _ _ _ _ _ _ [] -> _/=;rewrite mapP/=getP/=/#. + case ((G1.bcol{2} \/ G1.bext{2})). + + wp;conseq (_: _ ==> (G1.bcol{2} \/ G1.bext{2}))=> //;progress. + by if{1};if{2};auto;2:(swap{2} 4 -3;auto); smt w=(Block.DBlock.dunifin_ll DCapacity.dunifin_ll). + conseq(:INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} + G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} Redo.prefixes{1} + /\ (exists (f : flag), FRO.m{2}.[h{2}] = Some (sc{1}, f)) + /\ x{1} = (sa{1}, sc{1}) + /\ sa{1} = sa{2} +^ nth witness p{1} i{1} + /\ ={p, i} /\ 0 <= i{1} < size p{1} + /\ Redo.prefixes{1}.[take i{1} p{1}] = Some (sa{2}, sc{1}) + /\ build_hpath G1.mh{2} (take i{2} p{2}) = Some (sa{2}, h{2}) + /\ (if i{2} = 0 then sa{2} = b0 && h{2} = 0 + else F.RO.m{2}.[take i{2} p{2}] = Some sa{2}) + /\ (take i{1} p{1} \in dom Redo.prefixes{1}) + /\ ! (take (i{1} + 1) p{1} \in dom Redo.prefixes{1}) + /\ ! (G1.bcol{2} \/ G1.bext{2}) + /\ (x \in dom PF.m){1} = ((sa +^ nth witness p i, h) \in dom G1.mh){2} + ==>_);progress;..-3:rewrite/#. + * move:H3;rewrite H7/=;progress. + rewrite !in_dom. + pose X := sa{2} +^ nth witness p{2} i{2}. + case (H3)=> -[Hu _ _] _ _ [] /(_ X sc{1}) Hpf ^ HG1 /(_ X h{2}) Hmh _ _ _ _ _. + case: {-1}(PF.m{1}.[(X,sc{1})]) (eq_refl (PF.m{1}.[(X,sc{1})])) Hpf Hmh. + + case (G1.mh{2}.[(X, h{2})]) => //= -[ya hy] Hpf. + by rewrite -negP => /(_ ya hy) [] ????[#];rewrite H8 /= => -[<-];rewrite Hpf. + move=> [ya yc] Hpf/(_ ya yc) [hx fx hy fy [#]] Hhx Hhy ^ /HG1 [xc fx0 yc0 fy0]. + rewrite Hhx => /= [#] 2!<<-;rewrite Hhy Hpf /= => -[] !->> _;progress. print huniq. + by cut/=->>:=Hu h{2} hx(sc{1}, f)(sc{1}, fx)H8 Hhx;rewrite H11. + + if{1};2:(rcondt{2}1; first by auto=>/#);1:(rcondf{2}1;first by auto=>/#);last first. + + auto;progress. + * move:H9 H10;pose sa' := sa{2} +^ nth witness p{2} i{2};move=>H9 H10. + case (H)=> -[Hu _ _] _ _ [] /(_ sa' sc{1}) Hpf ^ HG1 /(_ sa' h{2}) Hmh _ _ _ _ _. + cut:(sa', h{2}) \in dom G1.mh{2} by rewrite -H9 H10. + move:H10;rewrite!in_dom;progress. + case: {-1}(PF.m{1}.[(sa',sc{1})]) (eq_refl (PF.m{1}.[(sa',sc{1})])) Hpf Hmh=>//=. + move=> [ya yc] Hpf/(_ ya yc) [hx fx hy fy [#]] Hhx Hhy ^ /HG1 [xc fx0 yc0 fy0]. + rewrite Hhx => /= [#] 2!<<-;rewrite Hhy Hpf /= => -[] !->> _;progress. + by cut/=->>:=Hu h{2} hx(sc{1}, f)(sc{1}, fx) H0 Hhx;rewrite H15 !oget_some/=. + * cut->:=take_nth witness i{2} p{2};1:smt(size_take). + rewrite build_hpath_prefix H4/=;smt(get_oget). + * move:H9 H10;pose sa' := sa{2} +^ nth witness p{2} i{2};move=>H9 H10. + case (H)=> -[Hu _ _] _ _ [] /(_ sa' sc{1}) Hpf ^ HG1 /(_ sa' h{2}) Hmh _ _ _ _ _. + cut:(sa', h{2}) \in dom G1.mh{2} by rewrite -H9 H10. + move:H10;rewrite!in_dom;progress. + case: {-1}(PF.m{1}.[(sa',sc{1})]) (eq_refl (PF.m{1}.[(sa',sc{1})])) Hpf Hmh=>//=. + move=> [ya yc] Hpf/(_ ya yc) [hx fx hy fy [#]] Hhx Hhy ^ /HG1 [xc fx0 yc0 fy0]. + rewrite Hhx => /= [#] 2!<<-;rewrite Hhy Hpf /= => -[] !->> _;progress. + by cut/=->>:=Hu h{2} hx(sc{1}, f)(sc{1}, fx) H0 Hhx;rewrite H15 !oget_some/=Hhy/#. + * do !split=>//=. + * by cut[]:=. + * by cut[]:=Hhs. + * by cut[]:=Hhs. + * by cut[]:=Hinv. + * by cut[]:=Hinvi. + * by cut[]:=Hmmh. + * by cut[]:=Hmmh. + * by cut[]:=Hmmhi. + * by cut[]:=Hmmhi. + * by cut[]:=Hmh. + * by cut[]:=Hmh. + * by cut[]:=Hmh. + * by cut[]:=Hpi. + * by cut[]:=H. + + rewrite head_nth nth_drop // addz0 => Heq Hbu ????. + rewrite !in_dom. + have -> /= : i{m2} + 1 <> 0 by smt (). + pose sa' := sa{m2} +^ nth witness p{m2} i{m2}. + case (Hmmh) => /(_ sa' sc{m1});case (PF.m{m1}.[(sa', sc{m1})])=> //= -[ya yc] /(_ ya yc) /=. + move=> [hx fx hy fy]; case (Hhs) => Hu _ _ [#] Heq'. + have /= <<- /= Hhy ^? ->:= Hu _ _ _ _ Heq Heq'. + rewrite !oget_some /= => _;split;1: by exists fy. + rewrite (@take_nth witness) 1://. + case (Hmh) => _ -> _;rewrite build_hpath_prefix Hbu /#. + * auto;progress. +move:H3;rewrite H7/=;progress. + rewrite in_dom/=;rewrite in_dom/= in H8. +search None. + cut H_m_mh:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ H3. + apply(notin_hs_notin_dom2_mh _ _ H_m_mh). + * smt(DBlock.dunifin_ll DCapacity.dunifin_ll). + * smt(DBlock.dunifin_ll DCapacity.dunifin_ll). + * rewrite getP/=oget_some. + conseq (_: _ ==> (! (G1.bcol{2} \/ G1.bext{2}) => INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} /\ From 8225862f01eabe687a8de095465d1ce55f2a5114 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Tue, 20 Feb 2018 18:58:13 +0100 Subject: [PATCH 265/525] miss save --- proof/smart_counter/Handle.eca | 114 +++++++++++++++++++++------------ 1 file changed, 73 insertions(+), 41 deletions(-) diff --git a/proof/smart_counter/Handle.eca b/proof/smart_counter/Handle.eca index 713edf2..09e8848 100644 --- a/proof/smart_counter/Handle.eca +++ b/proof/smart_counter/Handle.eca @@ -345,12 +345,12 @@ qed. lemma all_prefixes_of_INV hs ch m1 mi1 mh2 mhi2 ro pi m2 mi2 p: INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi p => all_prefixes p. -proof. case=>? ? ? ? ? ? ? ? ? ? h ?;exact(all_prefixes_of_m_p _ h). qed. +proof. case=>? ? ? ? ? ? ? ? ? h ?;exact(all_prefixes_of_m_p _ h). qed. -lemma ro_p_of_INV hs ch m1 mi1 mh2 mhi2 ro pi m2 mi2 p: - INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi p => - ro_p ro p. -proof. by case. qed. +(* lemma ro_p_of_INV hs ch m1 mi1 mh2 mhi2 ro pi m2 mi2 p: *) +(* INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi p => *) +(* ro_p ro p. *) +(* proof. by case. qed. *) (** Useful Lemmas **) lemma ch_gt0 hs ch : hs_spec hs ch => 0 < ch. @@ -805,9 +805,9 @@ have H /H {H}:= build_hpath_down mh x1 ch y1 (ch + 1) p v h _. by move=> p' b' v' h' <*>; rewrite ch_notin_rng2_mh. + move=> ^ /build_hpathP + -> /=; rewrite !getP. by case=> [<*>|/#]; move: HINV=> /hs_of_INV [] _ + H - /H {H} /#. -+ by apply(ro_p_of_INV _ _ _ _ _ _ _ _ _ HINV). +(* + by apply(ro_p_of_INV _ _ _ _ _ _ _ _ _ HINV). *) split=>[]. -+ by case:HINV=>_ _ _ _ _ _ _ _ _ [] _ [] ->//. ++ by case:HINV=>_ _ _ _ _ _ _ _ (* _ *) [] _ [] ->//. move=>l hmem i hi. cut[]_ h2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. cut[]sa sc[]:=h2 l hmem i hi. @@ -909,9 +909,9 @@ have H /H {H}:= build_hpath_down mh y1 (ch + 1) x1 ch p v h _. by move=> p' b' v' h' <*>; rewrite Sch_notin_rng2_mh. + move=> ^ /build_hpathP + -> /=; rewrite !getP. by case=> [<*>|/#]; move: HINV=> /hs_of_INV [] _ + H - /H {H} /#. -+ by apply(ro_p_of_INV _ _ _ _ _ _ _ _ _ HINV). +(* + by apply(ro_p_of_INV _ _ _ _ _ _ _ _ _ HINV). *) split=>[]. -+ by case:HINV=>_ _ _ _ _ _ _ _ _ [] _ [] ->//. ++ by case:HINV=>_ _ _ _ _ _ _ _ (* _ *) [] _ [] ->//. move=>l hmem i hi. cut[]_ h2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. cut[]sa sc[]:=h2 l hmem i hi. @@ -1004,9 +1004,9 @@ move: Hpath=> /build_hpathP [<*>|]. + by have /hs_of_INV [] _ + H - /H {H}:= HINV. + move=> p' b' v' h' <*> _; have /m_mh_of_INV [] _ H /H {H}:= HINV. by move=> [xc fx yc fy] [#] _; have /hs_of_INV [] _ _ H /H {H}:= HINV. -+ by apply(ro_p_of_INV _ _ _ _ _ _ _ _ _ HINV). +(* + by apply(ro_p_of_INV _ _ _ _ _ _ _ _ _ HINV). *) split=>[]. -+ by case:HINV=>_ _ _ _ _ _ _ _ _ [] _ [] ->//. ++ by case:HINV=>_ _ _ _ _ _ _ _ (* _ *) [] _ [] ->//. move=>l hmem i hi. cut[]_ h2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. cut[]sa sc[]:=h2 l hmem i hi. @@ -1113,9 +1113,9 @@ have no_path_to_ch: forall p0 v0, build_hpath G1mh p0 <> Some (v0,ch). + by have /hs_of_INV [] _ + H - /H {H}:= HINV. move=> p' b' v' h' <*> _; have /m_mh_of_INV [] _ H /H {H}:= HINV. by move=> [xc fx yc fy] [#] _; have /hs_of_INV [] _ _ H /H {H}:= HINV. -+ by apply(ro_p_of_INV _ _ _ _ _ _ _ _ _ HINV). +(* + by apply(ro_p_of_INV _ _ _ _ _ _ _ _ _ HINV). *) split=>[]. -+ by case:HINV=>_ _ _ _ _ _ _ _ _ [] _ [] ->//. ++ by case:HINV=>_ _ _ _ _ _ _ _ (* _ *) [] _ [] ->//. move=>l hmem i hi. cut[]_ h2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. cut[]sa sc[]:=h2 l hmem i hi. @@ -1200,9 +1200,9 @@ split. apply/build_hpath_prefix; exists b hx; rewrite xorwA xorwK xorwC xorw0 mh_xahx /=. move: pi_xc; have /pi_of_INV [] -> [h] [#] + hs_h:= HINV. by have /hs_of_INV [] + _ _ - /(_ _ _ _ _ hs_hx hs_h _) := HINV. -+ by apply(ro_p_of_INV _ _ _ _ _ _ _ _ _ HINV). +(* + by apply(ro_p_of_INV _ _ _ _ _ _ _ _ _ HINV). *) split=>[]. -+ by case:HINV=>_ _ _ _ _ _ _ _ _ [] _ [] ->//. ++ by case:HINV=>_ _ _ _ _ _ _ _ (* _ *) [] _ [] ->//. move=>l hmem i hi. cut[]_ h2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. cut[]sa sc[]:=h2 l hmem i hi. @@ -1297,17 +1297,16 @@ lemma lemma4 hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes i p sa sc h f: => take (i + 1) p \in dom prefixes => prefixes.[take i p] = Some (sa,sc) => build_hpath mh (take i p) = Some (sa,h) +=> ro.[take (i+1) p] = Some (oget prefixes.[take (i+1) p]).`1 => hs.[h] = Some (sc, f) => (sa +^ nth witness p i, h) \in dom mh. proof. -move=>inv0 hi take_i1_p_in_prefixes prefixes_sa_sc build_hpath_i_p hs_h_sc_f. +move=>inv0 hi take_i1_p_in_prefixes prefixes_sa_sc build_hpath_i_p ro_prefixe hs_h_sc_f. cut[]_ m_prefixe:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ inv0. cut[]b1 c1[]:=m_prefixe _ take_i1_p_in_prefixes i _;1:smt(size_take). rewrite!take_take!min_lel 1,2:/# nth_take 1,2:/# prefixes_sa_sc/==>[][<-<-]{b1 c1}Pm_prefixe. cut[]hh1 hh2 hh3:=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ inv0. -cut:ro.[take (i+1) p] = Some (oget prefixes.[take (i+1) p]).`1 - by cut[]->:=(ro_p_of_INV _ _ _ _ _ _ _ _ _ _ _ inv0);smt(mapP get_oget). -cut{1}->:=(take_nth witness i p);1:smt(size_take);move=>h1. +move:ro_prefixe;cut{1}->:=(take_nth witness i p);1:smt(size_take);move=>h1. cut:=hh2 (take i p) (nth witness p i) (oget prefixes.[take (i + 1) p]).`1. rewrite h1/==>[][] v hx hy;rewrite build_hpath_i_p/==>[][][?<-];smt(in_dom). qed. @@ -1481,8 +1480,8 @@ proof. else F.RO.m.[take i p]{2} = Some sa{1})));last first. + auto=> &m1 &m2 [#]->->-> _->->->->-> Hp ^ Hinv -> /=;rewrite size_ge0/=;split. + split;-1: split;-1: split;-2: by exists Known;case Hinv => -[] _ ->. - + by rewrite take0;case:Hinv=>_ _ _ _ _ _ _ _ _ _ []->//. - + by rewrite take0 in_dom;case:Hinv=>_ _ _ _ _ _ _ _ _ _ []->//. + + by rewrite take0;case:Hinv=>_ _ _ _ _ _ _ _ _ []->//. + + by rewrite take0 in_dom;case:Hinv=>_ _ _ _ _ _ _ _ _ []->//. by rewrite take0. progress. + rewrite/#. @@ -1491,57 +1490,90 @@ proof. + case : (! (G1.bcol{2} \/ G1.bext{2}));last first. + wp;conseq(:_==> (G1.bcol{2} \/ G1.bext{2}));1:smt(get_oget). by inline*;if{2};auto;smt(DCapacity.dunifin_ll DBlock.dunifin_ll). - rcondt{2}1;1:auto;progress. - * smt(lemma4). + + conseq(: ={p, i, sa} + /\ 0 <= i{2} < size p{2} + /\ Redo.prefixes{1}.[take i{1} p{1}] = Some (sa{1}, sc{1}) + /\ (take i{1} p{1} \in dom Redo.prefixes{1}) + /\ INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} + G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} Redo.prefixes{1} + /\ (exists (f : flag), FRO.m{2}.[h{2}] = Some (sc{1}, f)) + /\ build_hpath G1.mh{2} (take i{2} p{2}) = Some (sa{2}, h{2}) + /\ (if i{2} = 0 then (sa{2}, h{2}) = (b0, 0) + else F.RO.m{2}.[take i{2} p{2}] = Some sa{1}) + /\ (take (i{1} + 1) p{1} \in dom Redo.prefixes{1}) + /\ ! (G1.bcol{2} \/ G1.bext{2}) + /\ F.RO.m{2}.[take (i{2} + 1) p{2}] = + Some (oget Redo.prefixes{1}.[take (i{2} + 1) p{2}]).`1 + && ((sa +^ nth witness p i, h) \in dom G1.mh){2} ==> _);progress. + * rewrite/#. + * rewrite/#. + * rewrite/#. + * rewrite/#. + * rewrite/#. + * rewrite/#. + * rewrite/#. + * move:H3;rewrite H7/=;progress. + cut[]prefixe_nil prefixes:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ H3. + cut[]b1 c1:=prefixes _ H6 i{2} _;1:smt(size_take). + rewrite!take_take!min_lel//=1:/# nth_take 1,2:/# H1/==>[][][->>->>]h. + rewrite -h. + cut[]h1 h2 h3:=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ H3. + cut->:=take_nth witness i{2} p{2} _;1:smt(size_take). + rewrite h2 H9/=. exists b1 h{2}=>//=. + clear h1 h2 h3 prefixes prefixe_nil. + cut[]h1 h2:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ H3. + cut[]a b c d[]e[]g j:=h1 (b1 +^ nth witness p{2} i{2}) c1 + (oget Redo.prefixes{1}.[take (i{2} + 1) p{2}]).`1 + (oget Redo.prefixes{1}.[take (i{2} + 1) p{2}]).`2 _;1:smt(get_oget). + cut[]hu _ _:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ H3. + by cut/=<<-/#:=hu _ _ _ _ H8 e. + * move:H3;rewrite H7/=;progress. + cut/#:=lemma4 _ _ _ _ _ _ _ _ _ _ _ i{2} p{2} _ _ _ _ H3 _ H6 H1 H10 H8 H9. + by rewrite/#. + rcondt{2}1;1:auto. auto;progress. * rewrite/#. * rewrite/#. * smt(get_oget). - * rewrite/#. - * move:H3;rewrite H7/==>[];progress. - cut:=lemma4 _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ H3 _ H6 H1 H10 H9;1:rewrite/#. + * cut:=lemma4 _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ H3 _ H7 H1 H5 H9 H4;1:rewrite/#. rewrite in_dom=>hG1. cut[]b1 h1 hb1h1:exists b1 h1, G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2})] = Some (b1, h1) by rewrite/#. cut[]_ h:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ H3. - cut[]b' c':=h _ H6 i{2} _;1:smt(size_take). + cut[]b' c':=h _ H7 i{2} _;1:smt(size_take). rewrite!take_take!min_lel 1,2:/# nth_take 1,2:/#H1/==>[][][<<-<<-]{b' c'} h'{h}. rewrite-h' hb1h1/=oget_some/=. cut[]hh1 hh2:= m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ H3. cut[]a b c d:=hh2 _ _ _ _ hb1h1. - by rewrite H9/==>[][][]->>->>[]_->;rewrite !oget_some/=/#. - - * move:H3;rewrite H7=>//=[];progress. - cut:=lemma4 _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ H3 _ H6 H1 H10 H9;1:rewrite/#. + by rewrite H4/==>[][][]->>->>[]_->;rewrite !oget_some/=/#. + * cut:=lemma4 _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ H3 _ H7 H1 H5 H9 H4;1:rewrite/#. rewrite in_dom=>hG1. cut[]b1 h1 hb1h1:exists b1 h1, G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2})] = Some (b1, h1) by rewrite/#. cut[]_ h:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ H3. - cut[]b' c':=h _ H6 i{2} _;1:smt(size_take). + cut[]b' c':=h _ H7 i{2} _;1:smt(size_take). rewrite!take_take!min_lel 1,2:/# nth_take 1,2:/#H1/==>[][][<<-<<-]{b' c'} h'{h}. rewrite-h' hb1h1/=oget_some/=. cut[]hh1 hh2:= m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ H3. cut[]a b c d:=hh2 _ _ _ _ hb1h1. - by rewrite H9/==>[][][]->>->>[]->->;rewrite !oget_some/=/#. - - * move:H3;rewrite H7=>//=[];progress. - cut:=lemma4 _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ H3 _ H6 H1 H10 H9;1:rewrite/#. + by rewrite H4/==>[][][]->>->>[]->->;rewrite !oget_some/=/#. + * cut:=lemma4 _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ H3 _ H7 H1 H5 H9 H4;1:rewrite/#. rewrite in_dom=>hG1. cut[]b1 h1 hb1h1:exists b1 h1, G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2})] = Some (b1, h1) by rewrite/#. cut->:=(take_nth witness i{2} p{2} _);rewrite//=. - by rewrite build_hpath_prefix H10/=hb1h1/=;smt(oget_some). + by rewrite build_hpath_prefix H5/=hb1h1/=;smt(oget_some). * rewrite/#. * rewrite/#. - * move:H3;rewrite H7/==>[];progress. - by cut[]->:=ro_p_of_INV _ _ _ _ _ _ _ _ _ _ _ H3;smt(mapP get_oget). inline *;sp 2 0;wp=> /=. conseq(:_==> (! (G1.bcol{2} \/ G1.bext{2}) => (oget PF.m{1}.[x{1}]).`1 = sa{2} /\ build_hpath G1.mh{2} (take (i{2} + 1) p{2}) = Some (sa{2}, h{2}) /\ (exists (f : flag), FRO.m{2}.[h{2}] = Some ((oget PF.m{1}.[x{1}]).`2, f)) + /\ F.RO.m{2}.[take (i{2} + 1) p{2}] = Some (oget PF.m{1}.[x{1}]).`1 /\ INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} Redo.prefixes{1}.[take (i{1} + 1) p{1} <- ((oget PF.m{1}.[x{1}]).`1, (oget PF.m{1}.[x{1}]).`2)])); - progress;..-3:smt(getP dom_set in_fsetU1 mapP getP). - * by move:H7;rewrite H8/==>[][] _ []_ [] _ [] _ _ _ _ _ _ _ _ _ [] -> _/=;rewrite mapP/=getP/=/#. + progress;..-2:smt(getP dom_set in_fsetU1). + case ((G1.bcol{2} \/ G1.bext{2})). + wp;conseq (_: _ ==> (G1.bcol{2} \/ G1.bext{2}))=> //;progress. by if{1};if{2};auto;2:(swap{2} 4 -3;auto); smt w=(Block.DBlock.dunifin_ll DCapacity.dunifin_ll). From 5cf27ce7e74e8621c806c90c8622aead0477f42e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Wed, 28 Feb 2018 17:38:03 +0100 Subject: [PATCH 266/525] G1(D) ~ CF(D) : completed when greatest common prefix is not counted. --- proof/smart_counter/Handle.eca | 537 +++++++++++++++++++++------------ 1 file changed, 341 insertions(+), 196 deletions(-) diff --git a/proof/smart_counter/Handle.eca b/proof/smart_counter/Handle.eca index 09e8848..72620ae 100644 --- a/proof/smart_counter/Handle.eca +++ b/proof/smart_counter/Handle.eca @@ -1311,7 +1311,6 @@ cut:=hh2 (take i p) (nth witness p i) (oget prefixes.[take (i + 1) p]).`1. rewrite h1/==>[][] v hx hy;rewrite build_hpath_i_p/==>[][][?<-];smt(in_dom). qed. - (* we should do a lemma to have the equivalence *) @@ -1612,7 +1611,7 @@ proof. case: {-1}(PF.m{1}.[(sa',sc{1})]) (eq_refl (PF.m{1}.[(sa',sc{1})])) Hpf Hmh=>//=. move=> [ya yc] Hpf/(_ ya yc) [hx fx hy fy [#]] Hhx Hhy ^ /HG1 [xc fx0 yc0 fy0]. rewrite Hhx => /= [#] 2!<<-;rewrite Hhy Hpf /= => -[] !->> _;progress. - by cut/=->>:=Hu h{2} hx(sc{1}, f)(sc{1}, fx) H0 Hhx;rewrite H15 !oget_some/=. + by cut/=->>:=Hu h{2} hx(sc{1}, f)(sc{1}, fx) H0 Hhx;rewrite H14 !oget_some/=. * cut->:=take_nth witness i{2} p{2};1:smt(size_take). rewrite build_hpath_prefix H4/=;smt(get_oget). * move:H9 H10;pose sa' := sa{2} +^ nth witness p{2} i{2};move=>H9 H10. @@ -1622,188 +1621,324 @@ proof. case: {-1}(PF.m{1}.[(sa',sc{1})]) (eq_refl (PF.m{1}.[(sa',sc{1})])) Hpf Hmh=>//=. move=> [ya yc] Hpf/(_ ya yc) [hx fx hy fy [#]] Hhx Hhy ^ /HG1 [xc fx0 yc0 fy0]. rewrite Hhx => /= [#] 2!<<-;rewrite Hhy Hpf /= => -[] !->> _;progress. - by cut/=->>:=Hu h{2} hx(sc{1}, f)(sc{1}, fx) H0 Hhx;rewrite H15 !oget_some/=Hhy/#. - * do !split=>//=. - * by cut[]:=. - * by cut[]:=Hhs. - * by cut[]:=Hhs. - * by cut[]:=Hinv. - * by cut[]:=Hinvi. - * by cut[]:=Hmmh. - * by cut[]:=Hmmh. - * by cut[]:=Hmmhi. - * by cut[]:=Hmmhi. - * by cut[]:=Hmh. - * by cut[]:=Hmh. - * by cut[]:=Hmh. - * by cut[]:=Hpi. - * by cut[]:=H. - - rewrite head_nth nth_drop // addz0 => Heq Hbu ????. - rewrite !in_dom. - have -> /= : i{m2} + 1 <> 0 by smt (). - pose sa' := sa{m2} +^ nth witness p{m2} i{m2}. - case (Hmmh) => /(_ sa' sc{m1});case (PF.m{m1}.[(sa', sc{m1})])=> //= -[ya yc] /(_ ya yc) /=. - move=> [hx fx hy fy]; case (Hhs) => Hu _ _ [#] Heq'. - have /= <<- /= Hhy ^? ->:= Hu _ _ _ _ Heq Heq'. - rewrite !oget_some /= => _;split;1: by exists fy. - rewrite (@take_nth witness) 1://. - case (Hmh) => _ -> _;rewrite build_hpath_prefix Hbu /#. - * auto;progress. -move:H3;rewrite H7/=;progress. - rewrite in_dom/=;rewrite in_dom/= in H8. -search None. - cut H_m_mh:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ H3. - apply(notin_hs_notin_dom2_mh _ _ H_m_mh). - * smt(DBlock.dunifin_ll DCapacity.dunifin_ll). - * smt(DBlock.dunifin_ll DCapacity.dunifin_ll). - * rewrite getP/=oget_some. - - conseq (_: _ ==> (! (G1.bcol{2} \/ G1.bext{2}) => - INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} - G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} /\ - (oget PF.m{1}.[x{1}]).`1 = sa{2} /\ - (exists (f : flag), FRO.m{2}.[h{2}] = Some ((oget PF.m{1}.[x{1}]).`2, f)) /\ - (build_hpath G1.mh (take (i + 1) p) = Some (sa,h)){2} /\ - if i{2} + 1 = 0 then sa{2} = b0 && h{2} = 0 - else F.RO.m{2}.[take (i{2} + 1) p{2}] = Some (oget PF.m{1}.[x{1}]).`1)). - + move=> &m1 &m2 [#] 2!->> ?? H ?? ?????????? H'. - rewrite behead_drop -drop_add //=;split=>[/#|]. - by have := size_drop (i{m2} + 1) p{m2};case (drop (i{m2} + 1) p{m2}) => //= [/#| ];smt w=size_ge0. - case ((G1.bcol{2} \/ G1.bext{2})). - + wp;conseq (_: _ ==> (G1.bcol{2} \/ G1.bext{2}))=> //. - by if{1};if{2};auto;2:(swap{2} 4 -3;auto); smt w=(Block.DBlock.dunifin_ll DCapacity.dunifin_ll). - conseq (_: (x{1} = (sa{1} +^ head witness p{1}, sc{1}) /\ - (p{1} = drop i{2} p{2} /\ - 0 <= i{2} <= size p{2} /\ - (INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} - G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} /\ - ={sa} /\ - (exists (f : flag), FRO.m{2}.[h{2}] = Some (sc{1}, f)) /\ - (build_hpath G1.mh (take i p) = Some (sa,h)){2} /\ - if i{2} = 0 then (sa{2}, h{2}) = (b0, 0) - else F.RO.m{2}.[take i{2} p{2}] = Some sa{1})) /\ - p{1} <> [] /\ i{2} < size p{2}) /\ - ! (G1.bcol{2} \/ G1.bext{2}) /\ - (mem (dom PF.m) x){1} = (mem (dom G1.mh) (sa +^ nth witness p i, h)){2} ==> _). - + move=> &m1 &m2 [#] 2!->> ?? H ?? ^ /H [#] /= Hinv ->> Hf -> -> ? /= />. - case: Hf=> f Hm; rewrite head_nth nth_drop // addz0 !in_dom. - pose X := sa{m2} +^ nth witness p{m2} i{m2}. - case (Hinv)=> -[Hu _ _] _ _ [] /(_ X sc{m1}) Hpf ^ HG1 /(_ X h{m2}) Hmh _ _ _ _ _. - case: {-1}(PF.m{m1}.[(X,sc{m1})]) (eq_refl (PF.m{m1}.[(X,sc{m1})])) Hpf Hmh. - + case (G1.mh{m2}.[(X, h{m2})]) => //= -[ya hy] Hpf. - by rewrite -negP => /(_ ya hy) [] ????[#];rewrite Hm /= => -[<-];rewrite Hpf. - move=> [ya yc] Hpf/(_ ya yc) [hx fx hy fy [#]] Hhx Hhy ^ /HG1 [xc fx0 yc0 fy0]. - rewrite Hhx => /= [#] 2!<<-;rewrite Hhy Hpf /= => -[] !->> _. - by have /= <<- -> := Hu _ _ _ _ Hm Hhx. - if{1};[rcondf{2} 1| rcondt{2} 1];1,3:(by auto;smt ());last first. - + auto => /> /= &m1 &m2 ?? [] Hhs Hinv Hinvi Hmmh Hmmhi Hincl Hincli Hmh Hpi f. - rewrite head_nth nth_drop // addz0 => Heq Hbu ????. - rewrite !in_dom. - have -> /= : i{m2} + 1 <> 0 by smt (). - pose sa' := sa{m2} +^ nth witness p{m2} i{m2}. - case (Hmmh) => /(_ sa' sc{m1});case (PF.m{m1}.[(sa', sc{m1})])=> //= -[ya yc] /(_ ya yc) /=. - move=> [hx fx hy fy]; case (Hhs) => Hu _ _ [#] Heq'. - have /= <<- /= Hhy ^? ->:= Hu _ _ _ _ Heq Heq'. - rewrite !oget_some /= => _;split;1: by exists fy. - rewrite (@take_nth witness) 1://. - case (Hmh) => _ -> _;rewrite build_hpath_prefix Hbu /#. - rcondt{2} 5. - + move=> &m;auto=> &hr /> ?? Hinv f. - rewrite head_nth nth_drop // addz0; pose sa' := sa{hr} +^ nth witness p{hr} i{hr}. - move=> ?Hbu????->Hmem ????. - case (Hinv) => ??????? [] H1 H2 H3 ?. - rewrite (@take_nth witness) 1:// -negP in_dom. - pose p' := (take i{hr} p{hr}); pose w:= (nth witness p{hr} i{hr}). - case {-1}(F.RO.m{hr}.[rcons p' w]) (eq_refl (F.RO.m{hr}.[rcons p' w]))=> //. - move=> ? /H2 [???];rewrite Hbu => -[] [!<<-] HG1. - by move: Hmem;rewrite in_dom HG1. - swap{2} 4 -3;auto => &m1 &m2 [#] 2!->?? [] Hhs Hinv Hinvi Hmmh Hmmhi Hincl Hincli Hmh Hpi -> /=. - move=> Hsc Hpa Hif Hdrop Hlt Hbad. - rewrite head_nth nth_drop // addz0; pose sa' := sa{m2} +^ nth witness p{m2} i{m2}. - move=> Heq Hdom y1L-> /= y2L-> /=. - have -> /= : i{m2} + 1 <> 0 by smt (). - rewrite !getP_eq !oget_some /=. - pose p' := (take (i{m2} + 1) p{m2});rewrite/==> [#] ? /=. - split;last first. - + split;1: by exists Unknown. - rewrite /p' (@take_nth witness) 1:// build_hpath_prefix. - exists sa{m2} h{m2}. - rewrite /sa' getP_eq /=;apply build_hpath_up => //. - by move: Hdom;rewrite Heq /sa' in_dom. - have Hy1L := ch_notin_dom2_mh _ _ _ y1L G1.chandle{m2} Hmmhi Hhs. - have := hinvP FRO.m{m2} y2L;rewrite /= => Hy2L. - have g1_sa' : G1.mh{m2}.[(sa', h{m2})] = None by move: Hdom;rewrite Heq in_dom. - case :Hsc => f Hsc; have Hh := dom_hs_neq_ch _ _ _ _ _ Hhs Hsc. - have Hch : FRO.m{m2}.[G1.chandle{m2}] = None. - + case Hhs => _ _ H. - by case {-1}(FRO.m{m2}.[G1.chandle{m2}]) (eq_refl (FRO.m{m2}.[G1.chandle{m2}])) => // ? /H. - have Hy2_mi: ! mem (dom PF.mi{m1}) (y1L, y2L). - + rewrite in_dom;case {-1}( PF.mi{m1}.[(y1L, y2L)]) (eq_refl (PF.mi{m1}.[(y1L, y2L)])) => //. - by move=> [] ??;case Hmmhi=> H _ /H [] ????/#. - have ch_0 := ch_neq0 _ _ Hhs. - have ch_None : - forall xa xb ha hb, G1.mh{m2}.[(xa,ha)] = Some(xb, hb) => - ha <> G1.chandle{m2} /\ hb <> G1.chandle{m2}. - + move=> xa xb ha hb;case Hmmh=> _ H /H [xc fx yc fy [#]]. - by move=> /(dom_hs_neq_ch _ _ _ _ _ Hhs) -> /(dom_hs_neq_ch _ _ _ _ _ Hhs). - split=> //. - + by apply hs_addh => // ??/#. - + by apply inv_addm. - + by apply (m_mh_addh_addm f) => //;case Hhs. - + by apply (mi_mhi_addh_addmi f)=> // ??/#. - + by apply incl_upd_nin. - + by apply incl_upd_nin. - + case (Hmh)=> H1 H2 H3;split. - + move=> xa hx ya hy;rewrite getP;case((xa, hx) = (sa', h{m2}))=> [[2!->>] [2!<<-] | Hdiff]. - + exists sc{m1} f y2L Unknown. - rewrite getP_eq getP_neq 1:eq_sym //= Hsc /=. - exists (take i{m2} p{m2}) sa{m2}. - rewrite /p' (@take_nth witness) 1:// /sa' xorwA xorwK xorwC xorw0 getP_eq /=. - by apply build_hpath_up_None. - move=> /H1 [xc fx yc fy] [#] Hhx Hhy Hfy; exists xc fx yc fy. - rewrite !getP_neq. - + by rewrite eq_sym;apply (dom_hs_neq_ch _ _ _ Hhs Hhx). - + by rewrite eq_sym;apply (dom_hs_neq_ch _ _ _ Hhs Hhy). - rewrite Hhx Hhy /=;case: fy Hhy Hfy => //= Hhy [p v [Hro Hpath]]. - exists p v;rewrite getP_neq 1:-negP 1:/p' 1:(@take_nth witness) 1://. - + move => ^ /rconssI <<-;move: Hpath;rewrite Hpa=> -[!<<-] /rconsIs Heq'. - by move:Hdiff=> /=;rewrite /sa' Heq' xorwA xorwK xorwC xorw0. - by rewrite Hro /=;apply build_hpath_up_None. - + move=> p1 bn b; rewrite getP /p' (@take_nth witness) //. - case (rcons p1 bn = rcons (take i{m2} p{m2}) (nth witness p{m2} i{m2})). - + move=> ^ /rconssI ->> /rconsIs ->> /=; split => [<<- | ]. - + exists sa{m2} h{m2} G1.chandle{m2}. - by rewrite /sa' getP_eq /= (build_hpath_up Hpa) //. - move=> [v hx hy []] Heq1;rewrite getP /sa'. - case ((v +^ nth witness p{m2} i{m2}, hx) = (sa{m2} +^ nth witness p{m2} i{m2}, h{m2})) => //. - have := build_hpath_up_None G1.mh{m2} (sa', h{m2}) (y1L, G1.chandle{m2}) _ _ g1_sa' Hpa. - by rewrite Heq1 => -[!->>]. - move=> Hdiff;rewrite H2. - apply exists_iff=> v /= ;apply exists_iff => hx /=;apply exists_iff => hy /=. - have Hhx2 := dom_hs_neq_ch _ _ _ _ _ Hhs Hsc. - rewrite build_hpath_upd_ch_iff //. - case (hx = G1.chandle{m2}) => [->>|?]. - + split;1: by move=> [] _ /ch_None. - move=> [[p0' x [Hhx2']]]. - have [!<<-] [!->>]:= H3 _ _ _ _ _ Hpa Hhx2'. - by rewrite getP_neq /= ?Hhx2 // => /ch_None. - rewrite getP; case ((v +^ bn, hx) = (sa', h{m2})) => //= -[Hsa' ->>]. - rewrite Hsa' g1_sa' /= -negP => [#] Hbu !<<-. - have [!<<-]:= H3 _ _ _ _ _ Hpa Hbu. - move: Hsa'=> /Block.WRing.addrI /#. - move=> p1 v p2 v' hx. - rewrite !build_hpath_upd_ch_iff //. - case (hx = G1.chandle{m2})=> [->> | Hdiff ];2:by apply H3. - by move=> /> ?? Hp1 ?? Hp2;have [!->>] := H3 _ _ _ _ _ Hp1 Hp2. - case (Hpi) => H1;split=> c p1 v1;rewrite H1 => {H1}. - apply exists_iff => h1 /=. rewrite getP build_hpath_upd_ch_iff //. - by case (h1 = G1.chandle{m2}) => [->> /#|]. + by cut/=->>:=Hu h{2} hx(sc{1}, f)(sc{1}, fx) H0 Hhx;rewrite H14 !oget_some/=Hhy/#. + * cut[] a b hab:exists a b, PF.m{1}.[(sa{2} +^ nth witness p{2} i{2}, sc{1})] = Some (a,b) by + move:H10;rewrite in_dom/#. + cut[]h1 h2 h3:=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ H. + cut->:=take_nth witness i{2} p{2};1:smt(size_take). + rewrite h2 H4/=;exists sa{2} h{2}=>/=;rewrite hab oget_some/=. + cut[]hh1 hh2:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ H. + cut[]c d e i[]hcd[]hei hG1:=hh1 _ _ _ _ hab. + cut[]hu _ _:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ H. + by cut/=<<-/#:=hu _ _ _ _ H0 hcd. + * split;..-2:case:H=>//=;progress. + split;first cut[]:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ H;smt(size_take getP size_eq0). + progress;cut[]_ h:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ H. + rewrite !getP. + move:H12;rewrite dom_set in_fsetU1. + case(l=take (i{2}+1) p{2})=>//=;last first. + + cut all_pref l_diff l_in_dom:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ H. + cut->/=:take i0 l <> take (i{2} + 1) p{2} by rewrite/#. + cut->/=/#:take (i0+1) l <> take (i{2} + 1) p{2} by rewrite/#. + move=>->>;rewrite!take_take. + cut hii0:i0 <= i{2} by move:H14;rewrite size_take /#. + rewrite!min_lel //1,2:/# nth_take 1,2:/#. + cut->/=:take i0 p{2} <> take (i{2} + 1) p{2} by smt(size_take). + case(i0=i{2})=>//=[->>|i_neq_i0]/=;1: by rewrite H3/=;smt(get_oget). + cut->/=:!take (i0 + 1) p{2} = take (i{2} + 1) p{2} by smt(size_take). + cut:=h _ H6 i0 _;1:smt(size_take). + by rewrite!take_take!min_lel 1,2:/# nth_take 1,2:/#. + + rcondt{2}5;progress;1:auto;progress. + + cut[]hh1 hh2 hh3 :=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ H. + rewrite(@take_nth witness)1:/#in_dom/=. + cut:=hh2 (take i{hr} p{hr}) (nth witness p{hr} i{hr});rewrite H4/=. + cut:=H10;rewrite H9 in_dom/=. + case(F.RO.m{hr}.[rcons (take i{hr} p{hr}) (nth witness p{hr} i{hr})] = None)=>//=h. + cut[]b hb:exists b, F.RO.m{hr}.[rcons (take i{hr} p{hr}) (nth witness p{hr} i{hr})] = Some b + by move:h;case:(F.RO.m{hr}.[rcons (take i{hr} p{hr}) (nth witness p{hr} i{hr})])=>//=/#. + rewrite negb_forall/==>h2;rewrite hb/=;exists b=>//=. + rewrite negb_exists=>v/=. + rewrite negb_exists=>hx/=. + rewrite negb_exists=>hy/=. + case(sa{hr} = v)=>//=->>. + by case(h{hr} = hx)=>//=->>;rewrite h2. + + swap{2}4-3;wp;progress=>/=. + conseq(:_==> hinv FRO.m{2} sc{2} = None + => y1{1} = r{2} + && build_hpath G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- + (r{2}, G1.chandle{2})] (take (i{2} + 1) p{2}) = Some (r{2}, G1.chandle{2}) + && sc{2} = y2{1} + && INV_CF_G1 FRO.m{2}.[G1.chandle{2} <- (sc{2}, Unknown)] (G1.chandle{2} + 1) + PF.m{1}.[x{1} <- (y1{1}, y2{1})] PF.mi{1}.[(y1{1}, y2{1}) <- x{1}] + G1.m{2} G1.mi{2} + G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- (r{2}, G1.chandle{2})] + G1.mhi{2}.[(r{2}, G1.chandle{2}) <- (sa{2} +^ nth witness p{2} i{2}, h{2})] + F.RO.m{2}.[take (i{2} + 1) p{2} <- r{2}] G1.paths{2} + Redo.prefixes{1}.[take (i{1} + 1) p{1} <- (y1{1}, y2{1})]);1:smt(getP oget_some). + conseq(:_==> (y1,y2){1} = (r,sc){2});-1:by sim. + move=> &1 &2[][]inv0[][]flag h_flag[]->>[]->>[][]->>->>[]Hi[]. + move=>prefixe_p_i[] hpath[]ro_p_i[];rewrite in_dom prefixe_p_i/==>[][]preifxe_p_i1. + rewrite!negb_or !in_dom/==>[][][]bcol bext h_pf_g1 h_pf b1 c1 b2 c2 []->>->> hinv_none/=. + move:preifxe_p_i1;cut->:=take_nth witness i{2} p{2};1:smt(size_take). + move=>prefixe_p_i1. + split;1:rewrite build_hpath_prefix/=. + * by exists sa{2} h{2};rewrite getP/=;apply build_hpath_up=>//=;smt(in_dom). + cut:=inv0;case. + move=>H_hs_spec H_inv_spec H_inv_spech H_m_mh H_mi_mhi H_incl_m H_incl_mi H_mh_spec H_pi_spec H_m_p h_build_hpath_rcons. + cut:hs_spec FRO.m{2}.[G1.chandle{2} <- (c2, Unknown)] (G1.chandle{2}+1) + && inv_spec G1.m{2} G1.mi{2} + && inv_spec G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- (b2, G1.chandle{2})] + G1.mhi{2}.[(b2, G1.chandle{2}) <- (sa{2} +^ nth witness p{2} i{2}, h{2})] + && m_mh FRO.m{2}.[G1.chandle{2} <- (c2, Unknown)] + PF.m{1}.[(sa{2} +^ nth witness p{2} i{2}, sc{1}) <- (b2, c2)] + G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- (b2, G1.chandle{2})] + && m_mh FRO.m{2}.[G1.chandle{2} <- (c2, Unknown)] + PF.mi{1}.[(b2, c2) <- (sa{2} +^ nth witness p{2} i{2}, sc{1})] + G1.mhi{2}.[(b2, G1.chandle{2}) <- (sa{2} +^ nth witness p{2} i{2}, h{2})] + && incl G1.m{2} PF.m{1}.[(sa{2} +^ nth witness p{2} i{2}, sc{1}) <- (b2, c2)] + && incl G1.mi{2} PF.mi{1}.[(b2, c2) <- (sa{2} +^ nth witness p{2} i{2}, sc{1})] + && pi_spec FRO.m{2}.[G1.chandle{2} <- (c2, Unknown)] + G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- (b2, G1.chandle{2})] G1.paths{2} + && mh_spec FRO.m{2}.[G1.chandle{2} <- (c2, Unknown)] G1.m{2} + G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- (b2, G1.chandle{2})] + F.RO.m{2}.[rcons (take i{2} p{2}) (nth witness p{2} i{2}) <- b2] + && m_p PF.m{1}.[(sa{2} +^ nth witness p{2} i{2}, sc{1}) <- (b2, c2)] + Redo.prefixes{1}.[rcons (take i{2} p{2}) (nth witness p{2} i{2}) <- (b2, c2)];last by progress;split=>//. + split. + + apply hs_addh;1:cut//:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ inv0. + by cut:=hinvP FRO.m{2} c2;rewrite hinv_none/=/#. + move=>H2_hs_spec;split. + + by cut:=invG_of_INV _ _ _ _ _ _ _ _ _ _ _ inv0. + move=>H2_inv_spec;split. + + apply inv_addm=>//;1:cut//:=inv_of_INV _ _ _ _ _ _ _ _ _ _ _ inv0. + - rewrite/#. + cut hj:=mi_mhi_of_INV _ _ _ _ _ _ _ _ _ _ _ inv0. + cut hs_sp:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ inv0. + apply (notin_hs_notin_dom2_mh FRO.m{2} PF.mi{1})=>//=. + by apply ch_notin_dom_hs=>//=. + move=>H2_inv_spech;split. + + cut//=:=(m_mh_addh_addm FRO.m{2} PF.m{1} G1.mh{2} h{2} (sa{2} +^ nth witness p{2} i{2}) sc{1} G1.chandle{2} b2 c2 flag Unknown _ _ _ _);rewrite//. + - by cut[]:=H_hs_spec. + by rewrite ch_notin_dom_hs. + move=>H2_m_mh;split. + + cut->//=:=(mi_mhi_addh_addmi FRO.m{2} PF.mi{1} G1.mhi{2} h{2} (sa{2} +^ nth witness p{2} i{2}) sc{1} G1.chandle{2} b2 c2 flag Unknown _ _ _ _);rewrite//. + - by cut/#:=hinvP FRO.m{2} c2. + by rewrite ch_notin_dom_hs. + move=>H2_mi_mhi;split. + + move=>x;rewrite getP/=. + by cut:=H_incl_m (sa{2} +^ nth witness p{2} i{2}, sc{1});smt(in_dom). + move=>H2_incl_m;split. + + move=>x;rewrite getP/=. + cut/#:G1.mi{2}.[(b2, c2)] = None;move=>{x}. + cut help//=:=hinvP FRO.m{2} c2. + rewrite hinv_none/= in help. + cut->//=:=notin_m_notin_Gm _ _ (b2,c2) H_incl_mi. + cut/#:forall a b, PF.mi{1}.[(b2,c2)] <> Some (a,b). + move=>a b;move:help;apply absurd=>//=;rewrite negb_forall//=. + cut[] inv1 inv2 hab:=H_mi_mhi. + by cut/#:=inv1 _ _ _ _ hab. + cut :=h_pf_g1;rewrite h_pf/=eq_sym neqF/==>h_g1. + move=>H2_incl_mi;split. print mh_spec. search pi_spec. + + (* pi_spec *) + split;progress. + - cut[]h:=H_pi_spec;cut:=h c p0 v;rewrite H/==>[][]h1[] h'1 h'2. + exists h1;rewrite -h'2 getP/=. + cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h'2. + by apply build_hpath_up=>//=. + move:H0;rewrite getP/==>hh0. + cut h0_neq_ch:h0 <> G1.chandle{2} by rewrite/#. + cut[]->:=H_pi_spec;rewrite-hh0 h0_neq_ch/=;exists h0=>/=. search build_hpath None. + cut:=H;cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) b2 p0 v h0. + rewrite h_g1/=H/=h0_neq_ch/=. + cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h_flag. + by cut->/=->//=:=ch_neq0 _ _ H_hs_spec;progress;cut[]hh1 hh2 hh3:=H_mh_spec;smt(dom_hs_neq_ch). + move=>H2_pi_spec;split. + + (* mh_spec *) + (* cut: *) + (* (forall (xa : block) (hx : handle) (ya : block) (hy : handle), *) + (* G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- (b2, G1.chandle{2})].[( *) + (* xa, hx)] = Some (ya, hy) => *) + (* exists (xc : capacity) (fx : flag) (yc : capacity) (fy : flag), *) + (* FRO.m{2}.[G1.chandle{2} <- (c2, Unknown)].[hx] = Some (xc, fx) /\ *) + (* FRO.m{2}.[G1.chandle{2} <- (c2, Unknown)].[hy] = Some (yc, fy) /\ *) + (* if fy = Known then G1.m{2}.[(xa, xc)] = Some (ya, yc) /\ fx = Known *) + (* else *) + (* exists (p1 : block list) (v : block), *) + (* F.RO.m{2}.[rcons (take i{2} p{2}) (nth witness p{2} i{2}) <- b2].[ *) + (* rcons p1 (v +^ xa)] = Some ya /\ build_hpath *) + (* G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- *) + (* (b2, G1.chandle{2})] p1 = Some (v, hx)) *) + (* && *) + (* (forall (p1 : block list) (v : block) (p2 : block list) (v' : block) (hx : handle), *) + (* build_hpath *) + (* G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- (b2, G1.chandle{2})] *) + (* p1 = Some (v, hx) => *) + (* build_hpath *) + (* G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- (b2, G1.chandle{2})] *) + (* p2 = Some (v', hx) => p1 = p2 /\ v = v') *) + (* && *) + (* (forall (p1 : block list) (bn b : block), *) + (* F.RO.m{2}.[rcons (take i{2} p{2}) (nth witness p{2} i{2}) <- b2].[rcons p1 bn] = *) + (* Some b <=> *) + (* exists (v : block) (hx hy : handle), build_hpath *) + (* G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- (b2, G1.chandle{2})] p1 = *) + (* Some (v, hx) /\ *) + (* G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- (b2, G1.chandle{2})].[(v +^ bn, hx)] = Some (b, hy)); *) + (* last by progress;split=>/#. *) + split=>//=. + - move=>x hx y hy;rewrite !getP. + case((x, hx) = (sa{2} +^ nth witness p{2} i{2}, h{2}))=>//=. + * move=>[->> ->>][<<- <<-]/=. + cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h_flag. + rewrite h_flag/=. + exists sc{1} flag c2 Unknown=>//=. + by exists (take i{2} p{2}) (sa{2})=>//=;rewrite getP Block.WRing.addKr/=;apply build_hpath_up=>//=/#. + move=> neq h1. + cut[]hh1 hh2 hh3:=H_mh_spec. + cut[]xc hxx yc hyc []h2[]h3 h4:=hh1 _ _ _ _ h1. + cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h2. + cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h3. + rewrite h2 h3/=;exists xc hxx yc hyc=>//=. + move:h4;case(hyc = Known)=>//=neq2[]p0 b[]hp0 hb. + exists p0 b;rewrite getP. + cut->/=:=build_hpath_up _ _ _ b2 G1.chandle{2} _ _ _ hb h_g1. + cut/#:!rcons p0 (b +^ x) = rcons (take i{2} p{2}) (nth witness p{2} i{2});move:neq;apply absurd=>//=h'. + cut<<-:take i{2} p{2}=p0 by rewrite/#. + cut hbex:b +^ x = nth witness p{2} i{2} by rewrite/#. + by cut:=hb;rewrite hpath/==>[][->>->>]/=;rewrite-hbex Block.WRing.addKr/=. + (* move=>hh1;split. *) + (* - progress. search build_hpath Some. *) + + + - progress. search build_hpath. + * move:H;rewrite getP/=. + case(p0 = (take i{2} p{2}))=>[->>|hpp0]. search build_hpath None. + + cut->/=:=build_hpath_up _ _ _ b2 G1.chandle{2} _ _ _ hpath h_g1. + case(bn = (nth witness p{2} i{2}))=>[->>/=->>|hbni]/=. + - by exists sa{2} h{2} G1.chandle{2}=>//=;rewrite getP/=. + cut->/=:!rcons (take i{2} p{2}) bn = rcons (take i{2} p{2}) (nth witness p{2} i{2}). + - move:hbni;apply absurd=>//=h. + cut->:bn = nth witness (rcons (take i{2} p{2}) bn) i{2}. + * by rewrite nth_rcons size_take /#. + by rewrite h nth_rcons size_take /#. + move=>h_ro_p_bn. + cut[]_ hh4 _:=H_mh_spec. + by cut:=hh4 (take i{2} p{2}) bn b;rewrite h_ro_p_bn/=hpath/=;smt(getP @Block.WRing). + cut->/=:!rcons p0 bn = rcons (take i{2} p{2}) (nth witness p{2} i{2}). + + move:hpp0;apply absurd=>/=h. + cut:size p0 = size (take i{2} p{2}) by smt(size_rcons). + move:h;pose p' := take i{2} p{2};pose e := nth witness p{2} i{2}. + by move=>h h';move:p0 p' h' bn e h;apply seq2_ind=>//=/#. + move=>h_ro_p_bn. + cut[]_ hh4 _:=H_mh_spec. + cut:=hh4 p0 bn b;rewrite h_ro_p_bn/==>[][];progress. + cut help:(sa{2} +^ nth witness p{2} i{2}, h{2}) <> (v +^ bn, hx) by rewrite/#. + exists v hx hy=>//=;rewrite getP;rewrite eq_sym in help;rewrite help/=H0/=. + by apply build_hpath_up=>//=. + move:H H0;rewrite!getP=>h_build_hpath_set. + case(hy = G1.chandle{2})=>//=[->>|hy_neq_ch]/=. + + move=>h;cut h_eq:v +^ bn = sa{2} +^ nth witness p{2} i{2} && hx = h{2}. + + cut/#:G1.mh{2}.[(v +^ bn, hx)] <> Some (b, G1.chandle{2}). search hs_spec. + cut[]_ hh2:=H_m_mh. + cut:=hh2 (v +^ bn) hx b G1.chandle{2}. + case(G1.mh{2}.[(v +^ bn, hx)] = Some (b, G1.chandle{2}))=>//=. + rewrite negb_exists/=;progress; + rewrite negb_exists/=;progress; + rewrite negb_exists/=;progress; + rewrite negb_exists/=;progress;rewrite !negb_and. + by cut[]/#:=H_hs_spec. + cut[]eq_xor ->>:=h_eq. + move:h;rewrite h_eq/==>->>. + cut/#:!(p0 = (take i{2} p{2}) /\ bn = (nth witness p{2} i{2})) => + F.RO.m{2}.[rcons p0 bn] = Some b. + move:h_flag;case:flag=>h_flag;last first. + - cut:=known_path_uniq _ _ _ sc{1} h{2} p0 v (take i{2} p{2}) sa{2} H2_pi_spec _ h_build_hpath_set _. + * rewrite getP/=h_flag. + by cut->//=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h_flag. search build_hpath. + * by apply build_hpath_up=>//=. + move=>[]->>->>/=;smt(@Block.WRing). + + cut[]hh1 hh2 hh3:=H_mh_spec. + cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) b p0 v h{2}. + rewrite h_build_hpath_set/=h_g1/=. + cut->/=:=ch_neq0 _ _ H_hs_spec. + cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h_flag. + move=>help;cut:= help _;1:smt(dom_hs_neq_ch). + move=>h_build_hpath_p0. + rewrite hh2 h_build_hpath_p0/==>h_neq. + exists v h{2}=>//=. + rewrite eq_xor h_g1/=;move:h_neq;apply absurd=>//=. + by cut:=hh3 _ _ _ _ _ hpath h_build_hpath_p0;smt(@Block.WRing). + + move=>help;cut h_neq:! (v +^ bn = sa{2} +^ nth witness p{2} i{2} && hx = h{2}) by rewrite/#. + move:help;rewrite h_neq/==>h_g1_v_bn_hx. + cut[]hh1 hh2 hh3:=H_mh_spec. + cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) b2 p0 v hx. + rewrite h_build_hpath_set/=h_g1/=. + cut->/=:=ch_neq0 _ _ H_hs_spec. + by cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h_flag;smt(dom_hs_neq_ch). + + progress. + + cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) b2 p0 v hx. + cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) b2 p' v' hx. + rewrite H H0/=. + cut->/=:=ch_neq0 _ _ H_hs_spec. + cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h_flag. + rewrite h_g1/=. + by cut[]:=H_mh_spec;smt(dom_hs_neq_ch). + + cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) b2 p0 v hx. + cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) b2 p' v' hx. + rewrite H H0/=. + cut->/=:=ch_neq0 _ _ H_hs_spec. + cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h_flag. + rewrite h_g1/=. + by cut[]:=H_mh_spec;smt(dom_hs_neq_ch). + + move=>H2_mh_spec;split;progress. + + by cut[]:=H_m_p;smt(getP size_rcons size_eq0 size_ge0). + move:H;rewrite dom_set in_fsetU1. + case(l \in dom Redo.prefixes{1})=>//=hdom. + + cut[]_ h:=H_m_p. + cut[]sa' sc'[]h_pref h_pref2:=h _ hdom i0 _;1:rewrite/#. + exists sa' sc';rewrite!getP/=. + cut->/=:!take i0 l = rcons (take i{2} p{2}) (nth witness p{2} i{2}) by smt(in_dom). + rewrite h_pref/=. + cut->/=:!take (i0 + 1) l = rcons (take i{2} p{2}) (nth witness p{2} i{2}) by smt(in_dom take_size). + rewrite-h_pref2/=. + by cut->/=:! (sa' +^ nth witness l i0 = sa{2} +^ nth witness p{2} i{2} && sc' = sc{1}) by smt(in_dom take_size). + move=>->>;case(i0=i{2})=>[->>|i0_neq_i]//=. + + exists sa{2} sc{1}=>//=;rewrite!getP/=. + move:H1;rewrite !size_rcons !size_take//. + rewrite!nth_rcons-take_nth// !take_take!size_take 1:/#. + cut->/=hii:i{2}< size p{2} by rewrite/#. + rewrite !min_lel 1,2:/#. + by cut->/=:! take i{2} p{2} = take (i{2} + 1) p{2} by smt(size_take). + move:H1;rewrite !size_rcons !size_take//1:/#. + rewrite!nth_rcons-take_nth// !take_take!size_take 1:/#. + cut->/=hii:i{2}< size p{2} by rewrite/#. + rewrite i0_neq_i/=!min_lel 1,2:/#. + cut->/=:i0 < i{2} by rewrite/#. + rewrite!getP. + cut->/=:! take i0 p{2} = take (i{2} + 1) p{2} by smt(size_take). + cut[]_ h_pref:=H_m_p. + cut[]:= h_pref (take i{2} p{2}) _ i0 _;1:smt(in_dom);1:smt(size_take). + move=>b3 c3;rewrite!take_take!min_lel 1,2:/#=>[][]-> h. + cut->/=:!take (i0 + 1) p{2} = take (i{2} + 1) p{2} by smt(size_take). + exists b3 c3=>//=;rewrite getP/=. + cut/#:!(b3 +^ nth witness (take i{2} p{2}) i0 = sa{2} +^ nth witness p{2} i{2} && + c3 = sc{1}). + cut:(b3 +^ nth witness (take i{2} p{2}) i0, c3) \in dom PF.m{1};2:smt(in_dom). + cut:take (i0 + 1) p{2} \in dom Redo.prefixes{1};2:smt(in_dom). + cut->:take (i0 + 1) p{2} = take (i0 + 1) (take i{2} p{2});1:smt(take_take). + smt(in_dom take_oversize). qed. section AUX. - declare module D : DISTINGUISHER {PF, RO, G1}. + declare module D : DISTINGUISHER {PF, RO, G1, Redo}. axiom D_ll (F <: DFUNCTIONALITY{D}) (P <: DPRIMITIVE{D}): islossless P.f => islossless P.fi => islossless F.f => @@ -1815,7 +1950,8 @@ section AUX. proc. call (_: G1.bcol \/ G1.bext, INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} - G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2}). + G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} F.RO.m{2} + G1.paths{2} Redo.prefixes{1}). (* lossless D *) + exact/D_ll. (** proofs for G1.S.f *) @@ -1826,14 +1962,14 @@ section AUX. /\ INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} - F.RO.m{2} G1.paths{2} + F.RO.m{2} G1.paths{2} Redo.prefixes{1} ==> !G1.bcol{2} => !G1.bext{2} => ={res} /\ INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} - F.RO.m{2} G1.paths{2}). + F.RO.m{2} G1.paths{2} Redo.prefixes{1}). + by move=> &1 &2; rewrite negb_or. + by move=> &1 &2 _ ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? [#]; rewrite negb_or. (* For now, everything is completely directed by the syntax of @@ -1844,12 +1980,12 @@ section AUX. exists * FRO.m{2}, G1.chandle{2}, PF.m{1}, PF.mi{1}, G1.m{2}, G1.mi{2}, G1.mh{2}, G1.mhi{2}, - F.RO.m{2}, G1.paths{2}, + F.RO.m{2}, G1.paths{2}, Redo.prefixes{1}, x{2}. - elim * => hs0 ch0 PFm PFmi G1m G1mi G1mh G1mhi ro0 pi0 [] x1 x2. + elim * => hs0 ch0 PFm PFmi G1m G1mi G1mh G1mhi ro0 pi0 pref [] x1 x2. (* poor man's extraction of a fact from a precondition *) - case @[ambient]: {-1}(INV_CF_G1 hs0 ch0 PFm PFmi G1m G1mi G1mh G1mhi ro0 pi0) - (eq_refl (INV_CF_G1 hs0 ch0 PFm PFmi G1m G1mi G1mh G1mhi ro0 pi0)); last first. + case @[ambient]: {-1}(INV_CF_G1 hs0 ch0 PFm PFmi G1m G1mi G1mh G1mhi ro0 pi0 pref) + (eq_refl (INV_CF_G1 hs0 ch0 PFm PFmi G1m G1mi G1mh G1mhi ro0 pi0 pref)); last first. + by move=> h; exfalso=> &1 &2 [#] <*>; rewrite h. move=> /eqT inv0; proc; case @[ambient] {-1}(PFm.[(x1,x2)]) (eq_refl (PFm.[(x1,x2)])). + move=> PFm_x1x2. @@ -1871,11 +2007,12 @@ section AUX. /\ G1mhi = G1.mhi{2} /\ ro0 = F.RO.m{2} /\ pi0 = G1.paths{2} + /\ pref = Redo.prefixes{1} /\ (x1,x2) = x{2} /\ !G1.bcol{2} /\ !G1.bext{2} /\ ={x, y1, y2} - /\ INV_CF_G1 hs0 ch0 PFm PFmi G1m G1mi G1mh G1mhi ro0 pi0). + /\ INV_CF_G1 hs0 ch0 PFm PFmi G1m G1mi G1mh G1mhi ro0 pi0 pref). + by auto. case @[ambient]: {-1}(getflag hs0 x2) (eq_refl (getflag hs0 x2)). + rewrite getflagP_none => x2f_notin_rng_hs0; rcondt{2} 3. @@ -1928,13 +2065,14 @@ section AUX. /\ G1mhi = G1.mhi{2} /\ ro0 = F.RO.m{2} /\ pi0 = G1.paths{2} + /\ pref = Redo.prefixes{1} /\ (x1,x2) = x{2} /\ !G1.bcol{2} /\ !G1.bext{2} /\ ={x,y1,y2} /\ y{2} = (y1,y2){2} /\ hx2{2} = hx - /\ INV_CF_G1 hs0 ch0 PFm PFmi G1m G1mi G1mh G1mhi ro0 pi0). + /\ INV_CF_G1 hs0 ch0 PFm PFmi G1m G1mi G1mh G1mhi ro0 pi0 pref). + auto=> &1 &2 /> _ -> /= _; split. + move: x2_is_K; rewrite in_rng /= => -[hx2] hs_hx2. rewrite in_rng negb_exists /==> h; rewrite -negP=> hs_h. @@ -1983,7 +2121,7 @@ section AUX. rewrite !getP_eq pi_x2 !oget_some /=. have /hs_of_INV [] Hu _ _:= inv0; have -> := huniq_hinvK_h _ _ _ Hu hs_hx2. rewrite oget_some => /= ? Hy2L . - case:inv0=> Hhs Hinv HinvG Hmmh Hmmhi Hincl Hincli Hmh Hpi. + case:inv0=> Hhs Hinv HinvG Hmmh Hmmhi Hincl Hincli Hmh Hpi Hmp. have Hhx2:= dom_hs_neq_ch _ _ _ _ _ Hhs hs_hx2. have mh_hx2: G1mh.[(x1,hx2)] = None. + case Hmmh => _ /(_ x1 hx2);case (G1mh.[(x1, hx2)]) => // -[ya hy] /(_ ya hy) /=. @@ -2060,6 +2198,11 @@ section AUX. rewrite build_hpath_upd_ch_iff // getP;case (h = ch0) => [->> | //]. split;1: by move=> [_ /(dom_hs_neq_ch _ _ _ _ _ Hhs)]. by move=> /= [_ <<-];move:Hc. + split. + by cut[]/#:=Hmp. + cut[]_ h l hdom i hi:=Hmp. + cut[]b c[]->h':=h l hdom i hi. + by exists b c=>//=;rewrite getP/=-h';smt(in_dom take_oversize). move=> [xa xc] PFm_x1x2. rcondf{1} 1; 1:by auto=> &hr [#] !<<- _ _ ->>; rewrite in_dom PFm_x1x2. have /m_mh_of_INV [] + _ - /(_ _ _ _ _ PFm_x1x2) := inv0. @@ -2095,7 +2238,7 @@ section AUX. rewrite (@huniq_hinvK_h hx2 hs0 x2) // ?oget_some. + by have /hs_of_INV []:= inv0. rewrite Hro G1mh_x1hx2 hs_hy2 ?oget_some //= => _. - exact/(@lemma3 _ _ _ _ _ _ _ _ _ _ _ _ hx2 _ _ hy2). + exact/(@lemma3 _ _ _ _ _ _ _ _ _ _ _ _ _ hx2 _ _ hy2). (* lossless PF.f *) + move=> &2 _; proc; if=> //=; wp; rnd predT; rnd predT; auto. smt (@Block.DBlock @Capacity.DCapacity). @@ -2119,8 +2262,9 @@ section AUX. + proc. inline*;sp. admit. (* this is false *) (* lossless PF.C.f *) - + move=> &2 _; proc; inline *; while (true) (size p); auto. - + sp; if; 2:by auto; smt (size_behead). + + move=> &2 _; proc; inline *; while (true) (size p - i); auto. + + if; 1:auto=>/#. + sp; if; 2: auto=>/#. by wp; do 2!rnd predT; auto; smt (size_behead @Block.DBlock @Capacity.DCapacity). smt (size_ge0). (* lossless and do not reset bad G1.C.f *) @@ -2132,20 +2276,21 @@ section AUX. by auto; smt (@Block.DBlock @Capacity.DCapacity). (* Init ok *) inline *; auto=> />; split=> [|/#]. - (do !split; last 3 smt (getP map0P build_hpath_map0)); last 5 by move=> ? ? ? ?; rewrite map0P. + (do !split; -5..-2: smt (getP map0P build_hpath_map0)); -6..-2: by move=> ? ? ? ?; rewrite map0P. + move=> h1 h2 ? ?; rewrite !getP !map0P. by case: (h1 = 0); case: (h2 = 0)=> //=. + by rewrite getP. + by move=> ? h; rewrite getP map0P; case: (h = 0). + by move=> ? ?; rewrite !map0P. - by move=> ? ?; rewrite !map0P. + + by move=> ? ?; rewrite !map0P. + by move=>l;rewrite dom_set in_fsetU1 dom0 in_fset0/==>->>/=/#. qed. end section AUX. section. - declare module D: DISTINGUISHER{Perm, C, PF, G1, RO}. + declare module D: DISTINGUISHER{Perm, C, PF, G1, RO, Redo}. axiom D_ll (F <: DFUNCTIONALITY{D}) (P <: DPRIMITIVE{D}): islossless P.f => islossless P.fi => From 842d620d07479b9faef63ab45ee5059bfeb61b8a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Wed, 28 Feb 2018 18:23:42 +0100 Subject: [PATCH 267/525] killing last admit in Handle.eca --- proof/smart_counter/Handle.eca | 65 ++++++++++++++++++++-------------- 1 file changed, 39 insertions(+), 26 deletions(-) diff --git a/proof/smart_counter/Handle.eca b/proof/smart_counter/Handle.eca index 72620ae..37bd14d 100644 --- a/proof/smart_counter/Handle.eca +++ b/proof/smart_counter/Handle.eca @@ -44,7 +44,9 @@ module G1(D:DISTINGUISHER) = { } i <- i + 1; } - sa <- F.RO.get(p); + if (p <> []) { + sa <- F.RO.get(p); + } return sa; } } @@ -1446,7 +1448,7 @@ qed. -equiv PFf_Cf (D<:DISTINGUISHER): SqueezelessSponge(PF).f ~ G1(D).C.f : +equiv PFf_Cf_not_nil (D<:DISTINGUISHER): SqueezelessSponge(PF).f ~ G1(D).C.f : ! (G1.bcol{2} \/ G1.bext{2}) /\ ={p} /\ p{1} <> [] /\ INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} @@ -1459,13 +1461,18 @@ proof. seq 1 1: ((!(G1.bcol{2} \/ G1.bext{2}) => (INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} - G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} Redo.prefixes{1} /\ + G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} Redo.prefixes{1} /\ ={sa} /\ F.RO.m.[p]{2} = Some sa{1})));last first. + case : (! (G1.bcol{2} \/ G1.bext{2})); - 2: by conseq (_:_ ==> true)=> //; inline *;auto;rewrite Block.DBlock.dunifin_ll. - inline *; rcondf{2} 3. - + by move=> &m;auto=> &hr [#] H /H[_ H1] ??;rewrite in_dom H1. - by auto=> /> &m1 &m2;rewrite Block.DBlock.dunifin_ll /= => H /H [-> ->];rewrite oget_some. + 2: conseq (_:_ ==> true)=> //; inline *;auto;progress. + + if{2};1:rcondf{2} 3;auto;progress. + + smt(in_dom). + + smt(Block.DBlock.dunifin_ll). + + rewrite/#. + + rewrite/#. + + rewrite/#. + + rewrite/#. + if{2};auto;progress;smt(Block.DBlock.dunifin_ll). while ( ={p, i} /\ (0 <= i <= size p){2} /\ (Redo.prefixes.[take i p]{1} = Some (sa,sc){1}) /\ (take i p \in dom Redo.prefixes){1} /\ @@ -1485,11 +1492,11 @@ proof. progress. + rewrite/#. + smt(size_eq0 size_ge0 take_size). + + smt(size_eq0 size_ge0 take_size). if{1}. + case : (! (G1.bcol{2} \/ G1.bext{2}));last first. + wp;conseq(:_==> (G1.bcol{2} \/ G1.bext{2}));1:smt(get_oget). by inline*;if{2};auto;smt(DCapacity.dunifin_ll DBlock.dunifin_ll). - conseq(: ={p, i, sa} /\ 0 <= i{2} < size p{2} /\ Redo.prefixes{1}.[take i{1} p{1}] = Some (sa{1}, sc{1}) @@ -1572,8 +1579,7 @@ proof. Redo.prefixes{1}.[take (i{1} + 1) p{1} <- ((oget PF.m{1}.[x{1}]).`1, (oget PF.m{1}.[x{1}]).`2)])); progress;..-2:smt(getP dom_set in_fsetU1). - - case ((G1.bcol{2} \/ G1.bext{2})). + case ((G1.bcol{2} \/ G1.bext{2})). + wp;conseq (_: _ ==> (G1.bcol{2} \/ G1.bext{2}))=> //;progress. by if{1};if{2};auto;2:(swap{2} 4 -3;auto); smt w=(Block.DBlock.dunifin_ll DCapacity.dunifin_ll). conseq(:INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} @@ -1601,7 +1607,6 @@ proof. move=> [ya yc] Hpf/(_ ya yc) [hx fx hy fy [#]] Hhx Hhy ^ /HG1 [xc fx0 yc0 fy0]. rewrite Hhx => /= [#] 2!<<-;rewrite Hhy Hpf /= => -[] !->> _;progress. print huniq. by cut/=->>:=Hu h{2} hx(sc{1}, f)(sc{1}, fx)H8 Hhx;rewrite H11. - if{1};2:(rcondt{2}1; first by auto=>/#);1:(rcondf{2}1;first by auto=>/#);last first. + auto;progress. * move:H9 H10;pose sa' := sa{2} +^ nth witness p{2} i{2};move=>H9 H10. @@ -1648,7 +1653,6 @@ proof. cut->/=:!take (i0 + 1) p{2} = take (i{2} + 1) p{2} by smt(size_take). cut:=h _ H6 i0 _;1:smt(size_take). by rewrite!take_take!min_lel 1,2:/# nth_take 1,2:/#. - rcondt{2}5;progress;1:auto;progress. + cut[]hh1 hh2 hh3 :=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ H. rewrite(@take_nth witness)1:/#in_dom/=. @@ -1663,7 +1667,6 @@ proof. rewrite negb_exists=>hy/=. case(sa{hr} = v)=>//=->>. by case(h{hr} = hx)=>//=->>;rewrite h2. - swap{2}4-3;wp;progress=>/=. conseq(:_==> hinv FRO.m{2} sc{2} = None => y1{1} = r{2} @@ -1808,10 +1811,6 @@ proof. cut<<-:take i{2} p{2}=p0 by rewrite/#. cut hbex:b +^ x = nth witness p{2} i{2} by rewrite/#. by cut:=hb;rewrite hpath/==>[][->>->>]/=;rewrite-hbex Block.WRing.addKr/=. - (* move=>hh1;split. *) - (* - progress. search build_hpath Some. *) - - - progress. search build_hpath. * move:H;rewrite getP/=. case(p0 = (take i{2} p{2}))=>[->>|hpp0]. search build_hpath None. @@ -1859,7 +1858,6 @@ proof. by cut->//=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h_flag. search build_hpath. * by apply build_hpath_up=>//=. move=>[]->>->>/=;smt(@Block.WRing). - cut[]hh1 hh2 hh3:=H_mh_spec. cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) b p0 v h{2}. rewrite h_build_hpath_set/=h_g1/=. @@ -1871,7 +1869,6 @@ proof. exists v h{2}=>//=. rewrite eq_xor h_g1/=;move:h_neq;apply absurd=>//=. by cut:=hh3 _ _ _ _ _ hpath h_build_hpath_p0;smt(@Block.WRing). - move=>help;cut h_neq:! (v +^ bn = sa{2} +^ nth witness p{2} i{2} && hx = h{2}) by rewrite/#. move:help;rewrite h_neq/==>h_g1_v_bn_hx. cut[]hh1 hh2 hh3:=H_mh_spec. @@ -1879,7 +1876,6 @@ proof. rewrite h_build_hpath_set/=h_g1/=. cut->/=:=ch_neq0 _ _ H_hs_spec. by cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h_flag;smt(dom_hs_neq_ch). - progress. + cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) b2 p0 v hx. cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) b2 p' v' hx. @@ -1888,7 +1884,6 @@ proof. cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h_flag. rewrite h_g1/=. by cut[]:=H_mh_spec;smt(dom_hs_neq_ch). - cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) b2 p0 v hx. cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) b2 p' v' hx. rewrite H H0/=. @@ -1896,7 +1891,6 @@ proof. cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h_flag. rewrite h_g1/=. by cut[]:=H_mh_spec;smt(dom_hs_neq_ch). - move=>H2_mh_spec;split;progress. + by cut[]:=H_m_p;smt(getP size_rcons size_eq0 size_ge0). move:H;rewrite dom_set in_fsetU1. @@ -1936,6 +1930,22 @@ proof. smt(in_dom take_oversize). qed. + +equiv PFf_Cf (D<:DISTINGUISHER): SqueezelessSponge(PF).f ~ G1(D).C.f : + ! (G1.bcol{2} \/ G1.bext{2}) /\ + ={p} /\ + INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} + G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} Redo.prefixes{1} ==> + ! (G1.bcol{2} \/ G1.bext{2}) => + ={res} /\ INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} + G1.mi{2} G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} Redo.prefixes{1}. +proof. +exists*p{1};elim* =>input;case(input = [])=>input_nil;1:rewrite input_nil;2:conseq(PFf_Cf_not_nil D);progress. +proc;inline*;auto;sp. +by rcondf{1}1;auto;rcondf{2}1;auto;rcondf{2}1;auto. +qed. + + section AUX. declare module D : DISTINGUISHER {PF, RO, G1, Redo}. @@ -2258,9 +2268,8 @@ section AUX. + move=> _; proc; if; 2:by auto. by wp; do 2!rnd predT; auto => &hr [#]; smt (@Block.DBlock @Capacity.DCapacity). (** proofs for G1.C.f *) - (* equiv PF.C.f G1.C.f *) - + proc. - inline*;sp. admit. (* this is false *) + (* equiv PF.C.f G1.C.f *) + + conseq(PFf_Cf D);auto;progress. (* lossless PF.C.f *) + move=> &2 _; proc; inline *; while (true) (size p - i); auto. + if; 1:auto=>/#. @@ -2268,7 +2277,11 @@ section AUX. by wp; do 2!rnd predT; auto; smt (size_behead @Block.DBlock @Capacity.DCapacity). smt (size_ge0). (* lossless and do not reset bad G1.C.f *) - + move=> _; proc; inline *; wp; rnd predT; auto. + + move=> _; proc; inline *; wp. + case(p = [])=>//=. + - by sp;rcondf 1;auto;sp;rcondf 1;auto. + rcondt 6;first by auto;while(p <> []);auto;sp;if;auto. + wp;rnd predT; auto. while (G1.bcol \/ G1.bext) (size p - i)=> [z|]. + if; 1:by auto=> /#. wp; rnd predT; wp; rnd predT; auto. From ea3854ef7dfdae6018644891d8e9a2269523e941 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Thu, 1 Mar 2018 11:27:08 +0100 Subject: [PATCH 268/525] An empty list as input was a problem, now it's not. --- proof/smart_counter/Handle.eca | 186 ++++++++++++++++++++++++++++++-- proof/smart_counter/SLCommon.ec | 2 +- 2 files changed, 177 insertions(+), 11 deletions(-) diff --git a/proof/smart_counter/Handle.eca b/proof/smart_counter/Handle.eca index 37bd14d..4045341 100644 --- a/proof/smart_counter/Handle.eca +++ b/proof/smart_counter/Handle.eca @@ -44,9 +44,7 @@ module G1(D:DISTINGUISHER) = { } i <- i + 1; } - if (p <> []) { - sa <- F.RO.get(p); - } + sa <- F.RO.get(p); return sa; } } @@ -1448,7 +1446,146 @@ qed. -equiv PFf_Cf_not_nil (D<:DISTINGUISHER): SqueezelessSponge(PF).f ~ G1(D).C.f : +module G1'(D:DISTINGUISHER) = { + + module C = { + + proc f(p : block list): block = { + var sa, sa', sc; + var h, i <- 0; + sa <- b0; + sc <- c0; + while (i < size p ) { + if (mem (dom G1.mh) (sa +^ nth witness p i, h)) { + (sa, h) <- oget G1.mh.[(sa +^ nth witness p i, h)]; + } else { + sc <$ cdistr; + G1.bcol <- G1.bcol \/ hinv FRO.m sc <> None; + sa' <@ F.RO.get(take (i+1) p); + sa <- sa +^ nth witness p i; + G1.mh.[(sa,h)] <- (sa', G1.chandle); + G1.mhi.[(sa',G1.chandle)] <- (sa, h); + (sa,h) <- (sa',G1.chandle); + FRO.m.[G1.chandle] <- (sc,Unknown); + G1.chandle <- G1.chandle + 1; + } + i <- i + 1; + } + if (p <> []) { + sa <- F.RO.get(p); + } + return sa; + } + } + + module S = { + + proc f(x : state): state = { + var p, v, y, y1, y2, hy2, hx2; + + if (!mem (dom G1.m) x) { + if (mem (dom G1.paths) x.`2) { + (p,v) <- oget G1.paths.[x.`2]; + y1 <- F.RO.get (rcons p (v +^ x.`1)); + y2 <$ cdistr; + } else { + y1 <$ bdistr; + y2 <$ cdistr; + } + y <- (y1, y2); + G1.bext <- G1.bext \/ mem (rng FRO.m) (x.`2, Unknown); + if (!(mem (rng FRO.m) (x.`2, Known))) { + FRO.m.[G1.chandle] <- (x.`2, Known); + G1.chandle <- G1.chandle + 1; + } + hx2 <- oget (hinvK FRO.m x.`2); + if (mem (dom G1.mh) (x.`1, hx2) /\ in_dom_with FRO.m (oget G1.mh.[(x.`1,hx2)]).`2 Unknown) { + hy2 <- (oget G1.mh.[(x.`1, hx2)]).`2; + y <- (y.`1, (oget FRO.m.[hy2]).`1); + FRO.m.[hy2] <- (y.`2, Known); + G1.m.[x] <- y; + G1.mi.[y] <- x; + } else { + G1.bcol <- G1.bcol \/ hinv FRO.m y.`2 <> None; + hy2 <- G1.chandle; + G1.chandle <- G1.chandle + 1; + FRO.m.[hy2] <- (y.`2, Known); + G1.m.[x] <- y; + G1.mh.[(x.`1, hx2)] <- (y.`1, hy2); + G1.mi.[y] <- x; + G1.mhi.[(y.`1, hy2)] <- (x.`1, hx2); + } + if (mem (dom G1.paths) x.`2) { + (p,v) <- oget G1.paths.[x.`2]; + G1.paths.[y.`2] <- (rcons p (v +^ x.`1), y.`1); + } + } else { + y <- oget G1.m.[x]; + } + return y; + } + + proc fi(x : state): state = { + var y, y1, y2, hx2, hy2; + + if (!mem (dom G1.mi) x) { + G1.bext <- G1.bext \/ mem (rng FRO.m) (x.`2, Unknown); + if (!(mem (rng FRO.m) (x.`2, Known))) { + FRO.m.[G1.chandle] <- (x.`2, Known); + G1.chandle <- G1.chandle + 1; + } + hx2 <- oget (hinvK FRO.m x.`2); + y1 <$ bdistr; + y2 <$ cdistr; + y <- (y1,y2); + if (mem (dom G1.mhi) (x.`1,hx2) /\ + in_dom_with FRO.m (oget G1.mhi.[(x.`1,hx2)]).`2 Unknown) { + (y1,hy2) <- oget G1.mhi.[(x.`1, hx2)]; + y <- (y.`1, (oget FRO.m.[hy2]).`1); + FRO.m.[hy2] <- (y.`2, Known); + G1.mi.[x] <- y; + G1.m.[y] <- x; + } else { + G1.bcol <- G1.bcol \/ hinv FRO.m y.`2 <> None; + hy2 <- G1.chandle; + G1.chandle <- G1.chandle + 1; + FRO.m.[hy2] <- (y.`2, Known); + G1.mi.[x] <- y; + G1.mhi.[(x.`1, hx2)] <- (y.`1, hy2); + G1.m.[y] <- x; + G1.mh.[(y.`1, hy2)] <- (x.`1, hx2); + } + } else { + y <- oget G1.mi.[x]; + } + return y; + } + + } + + proc main(): bool = { + var b; + + F.RO.m <- map0; + G1.m <- map0; + G1.mi <- map0; + G1.mh <- map0; + G1.mhi <- map0; + G1.bext <- false; + G1.bcol <- false; + + (* the empty path is initially known by the adversary to lead to capacity 0^c *) + FRO.m <- map0.[0 <- (c0, Known)]; + G1.paths <- map0.[c0 <- ([<:block>],b0)]; + G1.chandle <- 1; + b <@ D(C,S).distinguish(); + return b; + } +}. + + + +equiv PFf_Cf_not_nil (D<:DISTINGUISHER): SqueezelessSponge(PF).f ~ G1'(D).C.f : ! (G1.bcol{2} \/ G1.bext{2}) /\ ={p} /\ p{1} <> [] /\ INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} @@ -1931,7 +2068,7 @@ proof. qed. -equiv PFf_Cf (D<:DISTINGUISHER): SqueezelessSponge(PF).f ~ G1(D).C.f : +equiv PFf_Cf (D<:DISTINGUISHER): SqueezelessSponge(PF).f ~ G1'(D).C.f : ! (G1.bcol{2} \/ G1.bext{2}) /\ ={p} /\ INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} @@ -1954,7 +2091,7 @@ section AUX. islossless P.f => islossless P.fi => islossless F.f => islossless D(F, P).distinguish. - equiv CF_G1 : CF(D).main ~ G1(D).main: + equiv CF_G1' : CF(D).main ~ G1'(D).main: ={glob D} ==> !(G1.bcol \/ G1.bext){2} => ={res}. proof. proc. @@ -2260,7 +2397,16 @@ section AUX. smt (@Block.DBlock @Capacity.DCapacity). (** proofs for G1.S.fi *) (* equiv PF.P.fi G1.S.fi *) - + by conseq (eq_fi D)=> /#. + + transitivity G1(D).S.fi + (! (G1.bcol{2} \/ G1.bext{2}) /\ ={x} /\ + INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} G1.mh{2} + G1.mhi{2} F.RO.m{2} G1.paths{2} Redo.prefixes{1} + ==> ! (G1.bcol{2} \/ G1.bext{2}) => ={res} /\ + INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} G1.mh{2} + G1.mhi{2} F.RO.m{2} G1.paths{2} Redo.prefixes{1}) + (={glob G1(D).S, x} ==> ={glob G1(D).S, res});progress;1:rewrite/#. + - by conseq (eq_fi D)=> /#. + by proc;inline*;sim. (* lossless PF.P.fi *) + move=> &2 _; proc; if=> //=; wp; rnd predT; rnd predT; auto. smt (@Block.DBlock @Capacity.DCapacity). @@ -2297,8 +2443,9 @@ section AUX. + by move=> ? ?; rewrite !map0P. + by move=> ? ?; rewrite !map0P. by move=>l;rewrite dom_set in_fsetU1 dom0 in_fset0/==>->>/=/#. -qed. + qed. + end section AUX. section. @@ -2309,6 +2456,25 @@ section. islossless P.f => islossless P.fi => islossless F.f => islossless D(F, P).distinguish. + local equiv CF_G1 : + CF(DRestr(D)).main ~ G1(DRestr(D)).main: + ={glob D, glob C} ==> !(G1.bcol \/ G1.bext){2} => ={res}. + proof. + transitivity G1'(DRestr(D)).main + (={glob D, glob C} ==> !(G1.bcol \/ G1.bext){2} => ={res}) + (={glob D, glob C} ==> ={res, glob G1(D)});progress;1:rewrite/#. + + by conseq(CF_G1' (DRestr(D)) (DRestr_ll D D_ll));progress. + proc;inline*;auto;sp. + call(: ={glob G1, glob C} /\ [] \in dom C.queries{1});auto;last first. + + smt(dom_set in_fsetU1). + + by proc;inline*;sp;if;auto;conseq(:_==> ={y0, glob G1, glob C});progress;sim. + + by proc;inline*;sp;if;auto;conseq(:_==> ={y0, glob G1, glob C});progress;sim. + proc;inline*;sp;if;auto;if;1,3:auto. + rcondt{1}8;first by auto;while(p <> []);auto;1:(sp;if);auto=>/#. + by wp 12 12;conseq(:_==> ={b, glob G1, glob C});1:smt(dom_set in_fsetU1);sim. + qed. + + lemma Real_G1 &m: Pr[GReal(D).main() @ &m: res /\ C.c <= max_size] <= Pr[G1(DRestr(D)).main() @ &m: res] + (max_size ^ 2)%r * inv 2%r * mu dstate (pred1 witness) + @@ -2318,12 +2484,12 @@ section. cut : Pr[CF(DRestr(D)).main() @ &m : res] <= Pr[G1(DRestr(D)).main() @ &m : res] + Pr[G1(DRestr(D)).main() @ &m : G1.bcol \/ G1.bext]. - + byequiv (CF_G1 (DRestr(D)) _)=>//;1:by apply (DRestr_ll D D_ll). + + byequiv (CF_G1)=>//. smt ml=0. cut /# : Pr[G1(DRestr(D)).main() @ &m : G1.bcol \/ G1.bext] <= Pr[G1(DRestr(D)).main() @ &m : G1.bcol] + Pr[G1(DRestr(D)).main() @ &m : G1.bext]. - rewrite Pr [mu_or]; smt. + rewrite Pr [mu_or]; smt(Distr.mu_bounded). qed. end section. diff --git a/proof/smart_counter/SLCommon.ec b/proof/smart_counter/SLCommon.ec index d0629e5..97ba58a 100644 --- a/proof/smart_counter/SLCommon.ec +++ b/proof/smart_counter/SLCommon.ec @@ -849,7 +849,7 @@ module C = { var queries : (block list, block) fmap proc init () = { c <- 0; - queries <- map0; + queries <- map0.[[] <- b0]; } }. From 11e38ea18daac0ce26193f1f14f8bd469fa710c8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Mon, 12 Mar 2018 17:53:24 +0100 Subject: [PATCH 269/525] Strong_rp_rf added --- proof/smart_counter/ConcreteF.eca | 38 +- proof/smart_counter/Gcol.eca | 82 ++-- proof/smart_counter/Gconcl.ec | 52 +-- proof/smart_counter/Gext.eca | 246 ++++++----- proof/smart_counter/Handle.eca | 10 +- proof/smart_counter/SLCommon.ec | 35 +- proof/smart_counter/Strong_rp_rf.eca | 604 +++++++++++++++++++++++++++ 7 files changed, 871 insertions(+), 196 deletions(-) create mode 100644 proof/smart_counter/Strong_rp_rf.eca diff --git a/proof/smart_counter/ConcreteF.eca b/proof/smart_counter/ConcreteF.eca index beff777..4d4a963 100644 --- a/proof/smart_counter/ConcreteF.eca +++ b/proof/smart_counter/ConcreteF.eca @@ -3,7 +3,7 @@ require import List FSet NewFMap Utils Common SLCommon DProd Dexcepted. (*...*) import Capacity IntOrder RealOrder. -require (*..*) Strong_RP_RF. +require (*..*) Strong_rp_rf. module PF = { var m, mi: (state,state) fmap @@ -50,7 +50,7 @@ section. local module GReal' = Indif(FC(SqueezelessSponge(Perm)), PC(Perm), D). - local clone import Strong_RP_RF as Switching with + local clone import Strong_rp_rf as Switching with type D <- state, op uD <- dstate, type K <- unit, @@ -95,7 +95,7 @@ section. call (_: ={glob C, glob P, glob Redo} /\ all_prefixes Redo.prefixes{2} /\ Redo.prefixes{2}.[[]] = Some (b0,c0) - /\ dom C.queries{2} <= dom Redo.prefixes{2} + /\ dom C.queries{2} \subset dom Redo.prefixes{2} /\ prefixe_inv C.queries{2} Redo.prefixes{2} /\ DBounder.FBounder.c{2} = C.c{2}). + proc; sp; if=> //=; inline *. @@ -113,7 +113,7 @@ section. alias{1}1 query = C.queries;alias{2}1 query = C.queries;sp 1 1=>/=. conseq(:_==> ={sa, Redo.prefixes, glob P, i, C.c} /\ all_prefixes Redo.prefixes{2} - /\ dom query{2} <= dom Redo.prefixes{2} + /\ dom query{2} \subset dom Redo.prefixes{2} /\ i{1} = size bs{1} /\ Redo.prefixes{1}.[take i{1} bs{1}] = Some (sa{1},sc{1}) /\ (forall y, y \in dom pref{1} => pref{1}.[y] = Redo.prefixes{1}.[y]) @@ -124,7 +124,7 @@ section. while( ={sa, Redo.prefixes, glob P, i, C.c, p, sc} /\ p{1} = bs{1} /\ all_prefixes Redo.prefixes{2} /\ Redo.prefixes{2}.[[]] = Some (b0, c0) - /\ dom query{2} <= dom Redo.prefixes{2} + /\ dom query{2} \subset dom Redo.prefixes{2} /\ (i{1} < size p{1} => ! take (i{1} + 1) p{1} \in dom Redo.prefixes{1}) /\ 0 <= prefixe bs{1} (get_max_prefixe bs{1} (elems (dom C.queries{1}))) <= i{1} <= size bs{1} /\ C.c{1} <= max_size @@ -137,7 +137,7 @@ section. sp;rcondt{2}1;1:auto=>/#;auto;1:call(:true);auto;progress. * move=>x;rewrite dom_set in_fsetU1=>[][|-> j];1:smt(in_fsetU1). case(0 <= j)=>hj0;last first. - + by rewrite (take_le0 j)1:/# in_fsetU1 in_dom H0//=. + + by rewrite (@take_le0 j)1:/# in_fsetU1 in_dom H0//=. rewrite take_take in_fsetU1/min/#. * smt(dom_set in_fsetU1 take_take in_dom getP oget_some). * smt(dom_set in_fsetU1 take_take in_dom getP oget_some). @@ -154,7 +154,7 @@ section. sp; conseq(:_==> ={sa, Redo.prefixes, glob P, i, C.c, p, sc, bs} /\ p{1} = bs{1} /\ Redo.prefixes{2} = pref{2} - /\ dom query{2} <= dom Redo.prefixes{2} + /\ dom query{2} \subset dom Redo.prefixes{2} /\ C.c{1} <= max_size /\ i{1} = prefixe bs{1} (get_max_prefixe bs{1} (elems (dom C.queries{1}))) /\ Redo.prefixes{1}.[take i{1} bs{1}] = Some (sa{1},sc{1}) @@ -165,18 +165,18 @@ section. + move:H8=>[]//=[]j [[hj0 hjsize] htake]. rewrite htake. apply take_get_max_prefixe2=>//=;1:smt(in_dom memE). - by rewrite-(prefixe_exchange _ _ _ H2 H). + by rewrite-(@prefixe_exchange _ _ _ H2 H). alias{2} 1 k = DBounder.FBounder.c;sp; conseq(:_==> ={sa, Redo.prefixes, glob P, i, C.c, p, sc, bs} /\ p{1} = bs{1} /\ Redo.prefixes{2} = pref{2} - /\ dom query{2} <= dom Redo.prefixes{2} + /\ dom query{2} \subset dom Redo.prefixes{2} /\ C.c{2} <= max_size /\ i{1} = prefixe bs{1} (get_max_prefixe bs{1} (elems (dom C.queries{1}))) /\ Redo.prefixes{1}.[take i{1} bs{1}] = Some (sa{1},sc{1}) /\ DBounder.FBounder.c{2} = k{2});1:progress=>/#. while( ={sa, Redo.prefixes, glob P, i, C.c, p, sc, bs, C.queries} /\ p{1} = bs{1} /\ Redo.prefixes{2} = pref{2} - /\ dom query{2} <= dom Redo.prefixes{2} + /\ dom query{2} \subset dom Redo.prefixes{2} /\ prefixe_inv C.queries{2} Redo.prefixes{2} /\ all_prefixes Redo.prefixes{2} /\ C.c{2} <= max_size @@ -187,11 +187,11 @@ section. /\ DBounder.FBounder.c{2} = k{2}). + rcondt{1}1;2:rcondt{2}1;auto;progress. * by rewrite/#. - * by rewrite(prefixe_exchange _ _ bs{2} H0 H1)all_take_in//=/#. + * by rewrite(@prefixe_exchange _ _ bs{2} H0 H1)all_take_in//=/#. * smt(get_oget in_dom). auto;progress. smt(prefixe_ge0). * apply take_get_max_prefixe2=>//=;1:smt(in_dom memE). - by rewrite-(prefixe_exchange _ _ _ H2 H). + by rewrite-(@prefixe_exchange _ _ _ H2 H). * smt(get_oget in_dom). * smt(@Prefixe). auto;call(:true);auto;smt(dom0 in_fset0 dom_set in_fsetU1 getP oget_some). @@ -253,7 +253,7 @@ section. * by rewrite/#. * move:H3 H7;rewrite take_size dom_set in_fsetU1 getP;case(bs0 = bs{2})=>//=[->|]h. * by rewrite h oget_some/=. - * move:H=>[?[??]];move=>? ?. + * move:H=>[H []];progress. by rewrite -H4;1:smt(take_size);rewrite H//=. * smt(dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0). * smt(dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop). @@ -274,12 +274,12 @@ section. * cut:=H7 (take (i{m0}+1) p{m0}). case((take (i{m0} + 1) p{m0} \in dom Redo.prefixes{m0}))=>//=_. rewrite negb_or negb_exists/=;progress. - + by rewrite memE prefixe_lt_size//=-(prefixe_exchange _ _ p{m0} H1 H0)//=/#. + + by rewrite memE prefixe_lt_size//=-(@prefixe_exchange _ _ p{m0} H1 H0)//=/#. case(0<=a<=i{m0})=>//=ha;smt(size_take). * cut:=H7 (take (i{hr}+1) p{hr}). case((take (i{hr} + 1) p{hr} \in dom Redo.prefixes{hr}))=>//=_. rewrite negb_or negb_exists/=;progress. - + by rewrite memE prefixe_lt_size//=-(prefixe_exchange _ _ p{hr} H1 H0)//=/#. + + by rewrite memE prefixe_lt_size//=-(@prefixe_exchange _ _ p{hr} H1 H0)//=/#. case(0<=a<=i{hr})=>//=ha;smt(size_take). sp;auto;if;auto;progress. @@ -294,7 +294,7 @@ section. * smt(prefixe_lt_size dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop memE). * rewrite!getP/=. cut/#: !take (i{2} + 1) p{2} \in dom pref{2}. - by rewrite memE prefixe_lt_size//=-(prefixe_exchange _ _ _ H1 H0)//=/#. + by rewrite memE prefixe_lt_size//=-(@prefixe_exchange _ _ _ H1 H0)//=/#. * smt(prefixe_lt_size dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop memE). * smt(prefixe_lt_size dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop memE). * smt(prefixe_lt_size dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop memE). @@ -308,7 +308,7 @@ section. * smt(prefixe_lt_size dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop memE). * rewrite!getP/=. cut/#: !take (i{2} + 1) p{2} \in dom pref{2}. - by rewrite memE prefixe_lt_size//=-(prefixe_exchange _ _ _ H1 H0)//=/#. + by rewrite memE prefixe_lt_size//=-(@prefixe_exchange _ _ _ H1 H0)//=/#. * smt(prefixe_lt_size dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop memE). * smt(prefixe_lt_size dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop memE). conseq(:_==> ={sa,sc,Perm.m,Perm.mi,Redo.prefixes,i,p} @@ -329,7 +329,7 @@ section. /\ Redo.prefixes{2}.[take i{2} p{2}] = Some (sa{2}, sc{2})). + rcondt{1}1;2:rcondt{2}1;auto;progress. * rewrite/#. search get_max_prefixe (<=) take mem. - * rewrite(prefixe_inv_leq _ _ _ _ _ _ H H7 H0)//= 1:/#. + * rewrite(@prefixe_inv_leq _ _ _ _ _ _ H H7 H0)//= 1:/#. cut:=H0=>[][h1 [h2 h3]]. cut:=h3 _ _ _ H7;last smt(memE). smt(size_eq0 size_take). @@ -357,7 +357,7 @@ section. + proc; while true (size p - i)=> //=. * move=> z; wp;if;auto; 2:call p_ll; auto=>/#. by auto; smt w=size_ge0. - apply (ler_trans _ _ _ + apply (@ler_trans _ _ _ (Pr_restr Perm SqueezelessSponge D p_ll pi_ll f_ll D_ll &m)). have ->: Pr[Indif(SqueezelessSponge(Perm), Perm, DRestr(D)).main() @ &m: res] = Pr[PRPt.IND(PRPi.PRPi,DBounder(D')).main() @ &m: res]. diff --git a/proof/smart_counter/Gcol.eca b/proof/smart_counter/Gcol.eca index fcc397c..1d7a678 100644 --- a/proof/smart_counter/Gcol.eca +++ b/proof/smart_counter/Gcol.eca @@ -38,7 +38,7 @@ section PROOF. proc sample_c () = { var c=c0; if (card (image fst (rng FRO.m)) <= 2*max_size /\ - count < max_size) { + count < max_size /\ ! G1.bcol /\ ! G1.bext) { c <$ cdistr; G1.bcol <- G1.bcol \/ mem (image fst (rng FRO.m)) c; count <- count + 1; @@ -191,38 +191,53 @@ section PROOF. by rewrite in_rng;exists (oget (Some h)). qed. + local lemma Pr_col &m : + Pr[Gcol.main()@&m : G1.bcol /\ Gcol.count <= max_size] <= + max_size%r * ((2*max_size)%r / (2^c)%r). + proof. + fel 10 Gcol.count (fun x=> (2*max_size)%r / (2^c)%r) + max_size G1.bcol + [Gcol.sample_c : (card (image fst (rng FRO.m)) <= 2*max_size /\ Gcol.count < max_size)]=>//;2:by auto. + + rewrite /felsum Bigreal.sumr_const count_predT size_range. + apply ler_wpmul2r;1:by apply eps_ge0. + by rewrite le_fromint;smt ml=0 w=max_ge0. + + proc;sp;if;2:by hoare=>//??;apply eps_ge0. + wp. + rnd (mem (image fst (rng FRO.m)));skip;progress;2:smt ml=0. + cut->:=(Mu_mem.mu_mem (image fst (rng FRO.m{hr})) cdistr (1%r/(2^c)%r) _). + + move=>x _; rewrite DCapacity.dunifin1E;do !congr;smt(@Capacity). + apply ler_wpmul2r;2:by rewrite le_fromint. + by apply divr_ge0=>//;apply /c_ge0r. + + move=>ci;proc;rcondt 2;auto=>/#. + move=> b c;proc;sp;if;auto;smt ml=0. + qed. + local equiv G1col : G1(DRestr(D)).main ~ Gcol.main : ={glob D} ==> (G1.bcol{1} => G1.bcol{2}) /\ Gcol.count{2} <= max_size. proof. proc;inline*;wp. - call (_: ={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m,C.c}/\ + call (_: ={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m,C.c,C.queries}/\ (G1.bcol{1} => G1.bcol{2}) /\ (card (rng FRO.m) <= 2*C.c + 1 /\ Gcol.count <= C.c <= max_size){2}). - + proc;sp 1 1;if=>//. - inline G1(DRestr(D)).S.f Gcol.S.f. - seq 2 2 : (={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m, - C.c,x0} /\ - (G1.bcol{1} => G1.bcol{2}) /\ - (card(rng FRO.m) + 2 <= 2*C.c + 1/\ - Gcol.count + 1 <= C.c <= max_size){2});1:by auto=>/#. - if=>//;last by auto=>/#. + + proc;sp 1 1;if=>//;inline G1(DRestr(D)).S.f Gcol.S.f;swap -3. + sp;if;1,3:auto=>/#. swap{1}[3..5]-2. seq 3 2:(={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m, - C.c,x0,hx2} /\ + C.c,C.queries,x0,hx2} /\ (G1.bcol{1} => G1.bcol{2}) /\ - (card (rng FRO.m) + 1 <= 2 * C.c + 1/\ + (card (rng FRO.m) + 1 <= 2 * C.c + 1 /\ Gcol.count + 1 <= C.c <= max_size){2}). + auto;smt ml=0 w=card_rng_set. seq 2 2: (={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m, - C.c,x0,hx2,y0} /\ + C.c,C.queries,x0,hx2,y0} /\ ((G1.bcol\/hinv FRO.m y0.`2 <> None){1} => G1.bcol{2}) /\ (card (rng FRO.m) + 1 <= 2 * C.c + 1 /\ - Gcol.count <= C.c <= max_size){2});last by auto;smt ml=0 w=card_rng_set. + Gcol.count <= C.c <= max_size){2});last by auto;smt ml=0 w=card_rng_set. wp;if=>//;inline Gcol.sample_c. + rcondt{2}4. - + auto;conseq (_:true)=>//;progress;2: smt ml=0. + + auto;conseq (_:true)=>//;progress;2: smt ml=0. by cut /#:= fcard_image_leq fst (rng FRO.m{hr}). wp;conseq (_: ={p,v,F.RO.m,y1} /\ y2{1}=c{2})=>//;1:smt ml=0 w=hinv_image. by sim. @@ -231,22 +246,22 @@ section PROOF. auto;progress;smt w=hinv_image. + proc;sp 1 1;if=>//. - inline G1(DRestr(D)).S.fi Gcol.S.fi. + inline G1(DRestr(D)).S.fi Gcol.S.fi;swap-3. seq 2 2 : (={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m, - C.c,x0} /\ + C.c,C.queries,x0} /\ (G1.bcol{1} => G1.bcol{2}) /\ (card(rng FRO.m) + 2 <= 2*C.c + 1 /\ Gcol.count + 1 <= C.c <= max_size){2});1:by auto=>/#. if=>//;last by auto=>/#. seq 3 2:(={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m, - C.c,x0,hx2} /\ + C.c,C.queries,x0,hx2} /\ (G1.bcol{1} => G1.bcol{2}) /\ (card (rng FRO.m) + 1 <= 2 * C.c + 1 /\ Gcol.count + 1 <= C.c <= max_size){2}). + by auto;smt ml=0 w=card_rng_set. seq 3 3: (={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m, - C.c,x0,hx2,y0,y1,y2} /\ y0{1} = (y1,y2){1} /\ + C.c,C.queries,x0,hx2,y0,y1,y2} /\ y0{1} = (y1,y2){1} /\ ((G1.bcol\/hinv FRO.m y0.`2 <> None){1} => G1.bcol{2}) /\ (card (rng FRO.m) + 1 <= 2 * C.c + 1 /\ Gcol.count <= C.c <= max_size){2});2:by auto;smt w=card_rng_set. @@ -256,11 +271,11 @@ section PROOF. (* BUG: auto=> /> ?? Himp _ _ _ ?_?_ [/Himp->// | H]. marche pas ???? *) auto=> /> ?? Himp _ _ _ ?_?_ [/Himp->// | X];right;apply hinv_image=> //. - + proc;sp 1 1;if=>//. - inline G1(DRestr(D)).C.f Gcol.C.f. + + proc;sp 1 1;if=>//;2:auto;sp;if=>//. + inline G1(DRestr(D)).C.f Gcol.C.f. sp. seq 5 5: - (={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m,C.c,b, - p,h,i,sa} /\ i{1}=0 /\ + (={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m,C.c, + C.queries,b,p,h,i,sa} /\ i{1}=0 /\ (G1.bcol{1} => G1.bcol{2}) /\ card (rng FRO.m{2}) + 2*(size p{2}) <= 2 * C.c{2} + 1 /\ Gcol.count{2} + size p{2} <= C.c{2} <= max_size);1:by auto=>/#. @@ -283,27 +298,6 @@ section PROOF. by apply max_ge0. qed. - local lemma Pr_col &m : - Pr[Gcol.main()@&m : G1.bcol /\ Gcol.count <= max_size] <= - max_size%r * ((2*max_size)%r / (2^c)%r). - proof. - fel 10 Gcol.count (fun x=> (2*max_size)%r / (2^c)%r) - max_size G1.bcol - [Gcol.sample_c : (card (image fst (rng FRO.m)) <= 2*max_size /\ Gcol.count < max_size)]=>//;2:by auto. - + rewrite /felsum Bigreal.sumr_const count_predT size_range. - apply ler_wpmul2r;1:by apply eps_ge0. - by rewrite le_fromint;smt ml=0 w=max_ge0. - + proc;sp;if;2:by hoare=>//??;apply eps_ge0. - wp. - rnd (mem (image fst (rng FRO.m)));skip;progress;2:smt ml=0. - cut->:=(Mu_mem.mu_mem (image fst (rng FRO.m{hr})) cdistr (1%r/(2^c)%r) _). - + move=>x _; rewrite DWord.dunifin1E;do !congr;exact cap_card. - apply ler_wpmul2r;2:by rewrite le_fromint. - by apply divr_ge0=>//;apply /c_ge0r. - + move=>ci;proc;rcondt 2;auto=>/#. - move=> b c;proc;sp;if;auto;smt ml=0. - qed. - lemma Pr_G1col &m: Pr[G1(DRestr(D)).main() @ &m : G1.bcol] <= max_size%r * ((2*max_size)%r / (2^c)%r). proof. diff --git a/proof/smart_counter/Gconcl.ec b/proof/smart_counter/Gconcl.ec index bf80aed..9356a7f 100644 --- a/proof/smart_counter/Gconcl.ec +++ b/proof/smart_counter/Gconcl.ec @@ -65,7 +65,7 @@ module S(F : DFUNCTIONALITY) = { section. -declare module D: DISTINGUISHER{C, Perm, F.RO, F.FRO,S }. +declare module D: DISTINGUISHER{C, Perm, F.RO, F.FRO, S, Redo}. local clone import Gext as Gext0. local module G3(RO:F.RO) = { @@ -201,19 +201,19 @@ local module G3(RO:F.RO) = { local equiv G2_G3: Eager(G2(DRestr(D))).main2 ~ G3(F.LRO).distinguish : ={glob D} ==> ={res}. proof. proc;wp;call{1} RRO_resample_ll;inline *;wp. - call (_: ={FRO.m,F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.chandle,G1.paths,C.c}); last by auto. + call (_: ={FRO.m,F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.chandle,G1.paths,C.c,C.queries}); last by auto. - + proc;sp;if=> //. - call (_: ={FRO.m,F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.chandle,G1.paths,C.c});2:by auto. + + proc;sp;if=> //;sim. + call (_: ={FRO.m,F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.chandle,G1.paths,C.c,C.queries});2:by auto. if=> //;2:by sim. swap{1} [3..7] -2;swap{2} [4..8] -3. - seq 5 5:(={hx2,t,x,FRO.m,F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.chandle,G1.paths,C.c} /\ + seq 5 5:(={hx2,t,x,FRO.m,F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.chandle,G1.paths,C.c,C.queries} /\ (t = in_dom_with FRO.m (oget G1.mh.[(x.`1, hx2)]).`2 Unknown){1}); 1:by inline *;auto. - seq 3 4:(={y,x,FRO.m,F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.chandle,G1.paths,C.c}); + seq 3 4:(={y,x,FRO.m,F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.chandle,G1.paths,C.c,C.queries}); 2:by sim. if=>//. - + seq 2 2:(={y1,hx2,t,x,FRO.m,F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.chandle,G1.paths,C.c} + + seq 2 2:(={y1,hx2,t,x,FRO.m,F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.chandle,G1.paths,C.c,C.queries} /\ (t = in_dom_with FRO.m (oget G1.mh.[(x.`1, hx2)]).`2 Unknown){1}). + by inline *;auto=> /> ? _;rewrite Block.DWord.bdistr_ll. case ((mem (dom G1.mh) (x.`1, hx2) /\ t){1}); @@ -230,11 +230,11 @@ proof. rewrite Block.DBlock.supp_dunifin DCapacity.dunifin_ll /==> ?_?->. by rewrite !getP /= oget_some. - + proc;sp;if=>//. - call (_: ={FRO.m,F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.chandle,G1.paths,C.c});2:by auto. + + proc;sp;if=>//;sim. + call (_: ={FRO.m,F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.chandle,G1.paths,C.c,C.queries});2:by auto. if=> //;2:sim. swap{1} 8 -3. - seq 6 6 : (={y1,hx2,t,x,FRO.m,F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.chandle,G1.paths,C.c} + seq 6 6 : (={y1,hx2,t,x,FRO.m,F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.chandle,G1.paths,C.c,C.queries} /\ (t = in_dom_with FRO.m (oget G1.mhi.[(x.`1, hx2)]).`2 Unknown){1}). + by inline *;auto. case ((mem (dom G1.mhi) (x.`1, hx2) /\ t){1}); @@ -244,8 +244,8 @@ proof. wp;rnd;auto;progress[-split];rewrite DCapacity.dunifin_ll /= => ?_?->. by rewrite !getP /= oget_some. - proc;sp;if=>//. - call (_: ={FRO.m,F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.chandle,G1.paths,C.c});2:by auto. + proc;sp;if=>//;auto;if;1:auto;sim. + call (_: ={FRO.m,F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.chandle,G1.paths,C.c,C.queries});2:by auto. by inline F.LRO.sample;sim. qed. @@ -325,21 +325,21 @@ local module G4(RO:F.RO) = { local equiv G3_G4 : G3(F.RO).distinguish ~ G4(F.RO).distinguish : ={glob D} ==> ={res}. proof. proc;inline *;wp. - call (_: ={G1.m,G1.mi,G1.paths,F.RO.m,C.c});last by auto. - + proc;sp;if=>//. - call (_: ={G1.m,G1.mi,G1.paths,F.RO.m,C.c});last by auto. + call (_: ={G1.m,G1.mi,G1.paths,F.RO.m,C.c,C.queries});last by auto. + + proc;sp;if=>//;sim. + call (_: ={G1.m,G1.mi,G1.paths,F.RO.m,C.c,C.queries});last by auto. if => //;2:sim. - seq 3 3: (={x,y1,y2,y,G1.m,G1.mi,G1.paths,F.RO.m,C.c});1:by sim. - sim;seq 5 0: (={x,y1,y2,y,G1.m,G1.mi,G1.paths,F.RO.m,C.c});1:by inline *;auto. + seq 3 3: (={x,y1,y2,y,G1.m,G1.mi,G1.paths,F.RO.m,C.c,C.queries});1:by sim. + sim;seq 5 0: (={x,y1,y2,y,G1.m,G1.mi,G1.paths,F.RO.m,C.c,C.queries});1:by inline *;auto. by if{1};sim;inline *;auto. - + proc;sp;if=>//. - call (_: ={G1.m,G1.mi,G1.paths,F.RO.m,C.c});last by auto. + + proc;sp;if=>//;sim. + call (_: ={G1.m,G1.mi,G1.paths,F.RO.m,C.c,C.queries});last by auto. if => //;2:sim. - seq 5 0: (={x,G1.m,G1.mi,G1.paths,F.RO.m,C.c});1:by inline *;auto. - seq 3 3: (={x,y1,y2,y,G1.m,G1.mi,G1.paths,F.RO.m,C.c});1:by sim. + seq 5 0: (={x,G1.m,G1.mi,G1.paths,F.RO.m,C.c,C.queries});1:by inline *;auto. + seq 3 3: (={x,y1,y2,y,G1.m,G1.mi,G1.paths,F.RO.m,C.c,C.queries});1:by sim. by if{1};sim;inline *;auto. - proc;sp;if=>//. - call (_: ={G1.m,G1.mi,G1.paths,F.RO.m,C.c});last by auto. + proc;sp;if=>//;auto;if=>//;sim. + call (_: ={G1.m,G1.mi,G1.paths,F.RO.m,C.c,C.queries});last by auto. sp;sim; while(={i,p,F.RO.m})=>//. inline F.RO.sample F.RO.get;if{1};1:by auto. by sim;inline *;auto;progress;apply DCapacity.dunifin_ll. @@ -349,9 +349,9 @@ local equiv G4_Ideal : G4(F.LRO).distinguish ~ IdealIndif(IF,S,DRestr(D)).main : ={glob D} ==> ={res}. proof. proc;inline *;wp. - call (_: ={C.c,F.RO.m} /\ G1.m{1}=S.m{2} /\ G1.mi{1}=S.mi{2} /\ G1.paths{1}=S.paths{2}). + call (_: ={C.c,C.queries,F.RO.m} /\ G1.m{1}=S.m{2} /\ G1.mi{1}=S.mi{2} /\ G1.paths{1}=S.paths{2}). + by sim. + by sim. - + proc;sp;if=>//. + + proc;sp;if=>//;auto;if=>//;auto. call (_: ={F.RO.m});2:by auto. inline F.LRO.get F.FRO.sample;wp 7 2;sim. by while{1} (true) (size p - i){1};auto;1:inline*;auto=>/#. @@ -367,7 +367,7 @@ axiom D_ll : lemma Real_Ideal &m: Pr[GReal(D).main() @ &m: res /\ C.c <= max_size] <= Pr[IdealIndif(IF,S,DRestr(D)).main() @ &m :res] + - (max_size ^ 2)%r * mu dstate (pred1 witness) + + (max_size ^ 2)%r / 2%r * mu dstate (pred1 witness) + max_size%r * ((2*max_size)%r / (2^c)%r) + max_size%r * ((2*max_size)%r / (2^c)%r). proof. diff --git a/proof/smart_counter/Gext.eca b/proof/smart_counter/Gext.eca index 2182665..5e485f2 100644 --- a/proof/smart_counter/Gext.eca +++ b/proof/smart_counter/Gext.eca @@ -277,6 +277,7 @@ section. (* **************** *) inline *;auto;progress. + auto;inline*;auto;progress. by move:H;rewrite dom_set dom0 !inE=>->. qed. @@ -284,7 +285,7 @@ end section. section EXT. - declare module D: DISTINGUISHER{C, PF, G1, G2, Perm, RO }. + declare module D: DISTINGUISHER{C, PF, G1, G2, Perm, RO, Redo}. local module ReSample = { var count:int @@ -488,7 +489,7 @@ section EXT. proof. rewrite !sizeE dom_rem fcardD;case (mem (dom m) x)=> Hx. + by rewrite subset_fsetI_id 2:fcard1// => z;rewrite !inE. - by rewrite (eq_fcards0 (_ `&` _)) 2:// fset0_eqP=>z;rewrite !inE /#. + by rewrite (@eq_fcards0 (dom m `&` fset1 x)) 2:// fset0_eqP=>z;rewrite !inE /#. qed. lemma size_rem_le (m:('a,'b)fmap) x : size (rem x m) <= size m. @@ -508,102 +509,6 @@ section EXT. rewrite restr_set /=;smt w=(size_set_le size_rem_le). qed. - local equiv EG2_Gext : Eager(G2(DRestr(D))).main2 ~ Gext.distinguish: - ={glob D} ==> - ReSample.count{2} <= max_size /\ - ((G1.bext{1} \/ inv_ext G1.m{1} G1.mi{1} FRO.m{1}) => G1.bext{2}). - proof. - proc;inline *;wp. - while (={l,FRO.m,G1.m,G1.mi} /\ size G1.m{2} <= max_size /\ - size G1.mi{2} <= max_size /\ - ReSample.count{2} + size l{2} <= max_size /\ - ((G1.bext{1} \/ - exists (x : state) (h : handle), - mem (dom G1.m{1} `|` dom G1.mi{1}) x /\ - FRO.m{1}.[h] = Some (x.`2, Unknown) /\ !mem l{1} h) => - G1.bext{2})). - + rcondt{2} 3. - + move=> &m;auto=> &m'[#] 6!-> /= + _ _;case (l{m'})=>//=; smt w=List.size_ge0. - auto=> &ml&mr[#]6!->;case(l{mr})=>[//|h1 l1/=Hle Hext c->/=];split. - + smt w=(drop0 size_ge0). - rewrite drop0=>-[H|[x h][#]];1:by rewrite Hext // H. - rewrite getP;case (h=h1)=> [/=->Hin->_ | Hneq ???]. - + by right;apply (mem_image snd _ x). - by rewrite Hext 2://;right;exists x h;rewrite Hneq. - wp; call (_: ={F.RO.m,FRO.m,G1.paths,G1.mh,G1.mhi,G1.m,G1.mi,G1.chandle,G1.bext, C.c} /\ - inv_le G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2}). - + proc;sp;if=> //. - call (_: ={x,F.RO.m,FRO.m,G1.paths,G1.mh,G1.mhi,G1.m,G1.mi,G1.chandle,G1.bext,C.c} /\ - inv_lt G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2} ==> - ={res,F.RO.m,FRO.m,G1.paths,G1.mh,G1.mhi,G1.m,G1.mi,G1.chandle,G1.bext,C.c} /\ - inv_le G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2});last by auto=> /#. - proc;if=>//;last by auto=>/#. - seq 8 9 : (={x, y, F.RO.m, FRO.m, G1.paths, G1.mh, G1.mhi, G1.m, G1.mi, G1.chandle, - G1.bext, C.c} /\ - inv_le G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2});2:by auto. - seq 2 3 : - (={y,x,F.RO.m,FRO.m,G1.paths,G1.mh,G1.mhi,G1.m,G1.mi,G1.chandle,G1.bext, C.c} /\ - inv_lt G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2}). - + by if=>//;auto;call (_: ={F.RO.m});auto. - seq 5 5 : - (={t,y,x,hx2,F.RO.m,FRO.m,G1.paths,G1.mh,G1.mhi,G1.m,G1.mi,G1.chandle,G1.bext, C.c} /\ - inv_lt G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2} /\ - (t => in_dom_with FRO.m (oget G1.mh.[(x.`1, hx2)]).`2 Unknown){1}). - + inline RRO.in_dom; wp;call (_: ={FRO.m});1:by sim. - inline RRO.restrK;sp 1 1;if=>//. - by wp;call RROset_inv_lt;auto. - if=>//;wp. - + inline *;rcondt{1} 4;1:by auto=>/#. - rcondt{2} 5;1:by auto;smt w=(sizeE size_ge0). - rcondt{2} 10. by auto;progress;rewrite dom_set !inE. - wp;rnd{2};auto=> /= ??[#]!-> @/inv_lt @/inv_le [#] mlt milt clt cle Hin 3?->/=. - rewrite/Distr.is_lossless (sampleto_ll 0)/= => ? _;rewrite /bad_ext !getP /= !oget_some /= set_set_eq /=. - rewrite !(imageU,inE) restr_set /= size_rem dom_restr Hin //=; smt w=size_set_le. - by call RROset_inv_lt;auto;smt w=size_set_le. - - + proc;sp;if=> //. - call (_: ={x,F.RO.m,FRO.m,G1.paths,G1.mh,G1.mhi,G1.m,G1.mi,G1.chandle,G1.bext,C.c} /\ - inv_lt G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2} ==> - ={res,F.RO.m,FRO.m,G1.paths,G1.mh,G1.mhi,G1.m,G1.mi,G1.chandle,G1.bext,C.c} /\ - inv_le G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2});last by auto=> /#. - proc;if=>//;last by auto=>/#. - seq 8 8 : - (={t,y,x,hx2,F.RO.m,FRO.m,G1.paths,G1.mh,G1.mhi,G1.m,G1.mi,G1.chandle,G1.bext, C.c} /\ - inv_lt G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2} /\ - (t => in_dom_with FRO.m (oget G1.mhi.[(x.`1, hx2)]).`2 Unknown){1}). - + inline RRO.in_dom; auto;call (_: ={FRO.m});1:by sim. - inline RRO.restrK;sp 1 1;if=>//. - by wp;call RROset_inv_lt;auto. - if=>//;wp. - + inline *;rcondt{1} 4;1:by auto=>/#. - rcondt{2} 5;1:by auto;smt w=(sizeE size_ge0). - rcondt{2} 10. by auto;progress;rewrite dom_set !inE. - wp;rnd{2};auto=> /= ??[#]!-> @/inv_lt @/inv_le [#] mlt milt clt cle Hin 3?->/=. - rewrite/Distr.is_lossless (sampleto_ll 0) /= => ? _;rewrite /bad_ext !getP /= !oget_some /= set_set_eq /=. - rewrite !(imageU,inE) restr_set /= size_rem dom_restr Hin //=; smt w=size_set_le. - by call RROset_inv_lt;auto;smt w=size_set_le. - - + proc;sp 1 1;if=>//. - inline G2(DRestr(D), RRO).C.f Gext.C.f. - sp 5 5;elim *=> c0L c0R. - wp;call (_: ={F.RO.m});1:by sim. - while (={i,p,G1.mh,sa,h,FRO.m,F.RO.m,G1.mh,G1.mhi,G1.chandle} /\ 0 <= i{1} <= size p{1}/\ - c0R + size p{1} <= max_size /\ - inv_le G1.m{2} G1.mi{2} (c0R + i){2} FRO.m{2} ReSample.count{2}); - last by auto;smt w=List.size_ge0. - if=> //;1:by auto=>/#. - auto;call (_: ={F.RO.m});1:by sim. - inline *;auto=> ?&mr [#]!->@/inv_le Hi [#]. - case (p{mr})=> [/#|/=p1 p2] 4?_ /= 2?-> /=;split=>/= Hmem 4? [#]2->/= => [|/#]. - by rewrite restr_set /= size_set dom_restr /in_dom_with Hmem/= /#. - - auto;progress[delta];rewrite ?(size0,restr0,restr_set,rem0,max_ge0,-sizeE,-cardE) //=. - + smt ml=0. + smt ml=0. + smt ml=0. - + elim H7=>// [[x h] [#]];rewrite -memE dom_restr /in_dom_with in_dom=> _ ->/=. - by rewrite oget_some. - apply H10=>//. - qed. - local lemma Pr_ext &m: Pr[Gext.distinguish()@&m : G1.bext /\ ReSample.count <= max_size] <= max_size%r * ((2*max_size)%r / (2^c)%r). @@ -644,6 +549,149 @@ section EXT. move=> b1 c1;proc;auto=> /#. qed. + local equiv EG2_Gext : Eager(G2(DRestr(D))).main2 ~ Gext.distinguish: + ={glob D} ==> + ((G1.bext{1} \/ inv_ext G1.m{1} G1.mi{1} FRO.m{1}) => + ReSample.count{2} <= max_size /\ G1.bext{2}). + proof. + proc;inline *;wp;sp. + swap{1}[2..3]2;swap{2}2 2;wp. print inv_ext. + while (={l,G1.m,G1.mi} + /\ ((!G1.bext{1} /\ forall (x : state) (h : handle), + !mem (dom G1.m{1} `|` dom G1.mi{1}) x \/ + FRO.m{1}.[h] <> Some (x.`2, Unknown) \/ mem l{1} h) => + ={FRO.m} + /\ size G1.m{2} <= max_size /\ size G1.mi{2} <= max_size + /\ ReSample.count{2} + size l{2} <= max_size) + /\ ((G1.bext{1} \/ exists (x : state) (h : handle), + mem (dom G1.m{1} `|` dom G1.mi{1}) x /\ + FRO.m{1}.[h] = Some (x.`2, Unknown) /\ !mem l{1} h) => + G1.bext{2})). + + case(G1.bext{1} \/ exists (x1 : state) (h0 : handle), + (x1 \in dom G1.m{1} `|` dom G1.mi{1}) /\ + FRO.m{1}.[h0] = Some (x1.`2, Unknown) /\ ! (h0 \in l{1}))=>//=. + auto;progress. + + move:H3;rewrite H9/==>[][]a b. + cut[->//=|[|]]:=H10 a b. + + rewrite getP;case(b = head witness l{2})=>[->>|hb->//=]/=. + by rewrite-(@mem_head_behead witness)//. + by move=>h;cut->//=:=mem_drop _ _ _ h. + + rewrite size_drop//=. + cut/#:=H _;rewrite H9/==>x h. + cut:=H10 x h;rewrite getP/==>[][->|[|]]//=. + + case(h=head witness l{2})=>[->>|hb->//=]/=. + by rewrite-(@mem_head_behead witness)//. + by move=>h2;cut->//=:=mem_drop _ _ _ h2. + + by cut->:=H0 H3. + + admit. + + admit. + + admit. + + admit. + + admit. + + admit. + + admit. +(* rcondt{2} 3. *) +(* + move=> &m;auto=> &m'[#] 6!-> /= + _ _;case (l{m'})=>//=; smt w=List.size_ge0. *) +(* auto=> &ml&mr[#]6!->;case(l{mr})=>[//|h1 l1/=Hle Hext c->/=];split. *) +(* + smt w=(drop0 size_ge0). *) +(* rewrite drop0=>-[H|[x h][#]];1:by rewrite Hext // H. *) +(* rewrite getP;case (h=h1)=> [/=->Hin->_ | Hneq ???]. *) +(* + by right;apply (@mem_image snd _ x). *) +(* by rewrite Hext 2://;right;exists x h;rewrite Hneq. *) +(* conseq(:_==> (={l,FRO.m,G1.m,G1.mi} /\ *) +(* size G1.m{2} <= max_size /\ *) +(* size G1.mi{2} <= max_size /\ *) +(* ReSample.count{2} + size l{2} <= max_size /\ *) +(* ((G1.bext{1} \/ *) +(* exists (x : state) (h : handle), *) +(* mem (dom G1.m{1} `|` dom G1.mi{1}) x /\ *) +(* FRO.m{1}.[h] = Some (x.`2, Unknown) /\ !mem l{1} h) => *) +(* G1.bext{2})));1:progress=>/#;wp=>/=. *) + +(* call (_: ={F.RO.m,FRO.m,G1.paths,G1.mh,G1.mhi,G1.m,G1.mi,G1.chandle,G1.bext,C.c,C.queries} /\ *) +(* inv_le G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2}). *) +(* + proc;sp;if=> //;swap -1. *) +(* call (_: ={x,F.RO.m,FRO.m,G1.paths,G1.mh,G1.mhi,G1.m,G1.mi,G1.chandle,G1.bext,C.c,C.queries} /\ *) +(* inv_lt G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2} ==> *) +(* ={res,F.RO.m,FRO.m,G1.paths,G1.mh,G1.mhi,G1.m,G1.mi,G1.chandle,G1.bext,C.c,C.queries} /\ *) +(* inv_le G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2});last by auto=>/#. *) +(* proc;if=>//;last by auto=>/#. *) +(* seq 8 9 : (={x, y, F.RO.m, FRO.m, G1.paths, G1.mh, G1.mhi, G1.m, G1.mi, G1.chandle, *) +(* G1.bext, C.c,C.queries} /\ *) +(* inv_le G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2});2:by auto. *) +(* seq 2 3 : *) +(* (={y,x,F.RO.m,FRO.m,G1.paths,G1.mh,G1.mhi,G1.m,G1.mi,G1.chandle,G1.bext, C.c,C.queries} /\ *) +(* inv_lt G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2}). *) +(* + by if=>//;auto;call (_: ={F.RO.m});auto. *) +(* seq 5 5 : *) +(* (={t,y,x,hx2,F.RO.m,FRO.m,G1.paths,G1.mh,G1.mhi,G1.m,G1.mi,G1.chandle,G1.bext, C.c,C.queries} /\ *) +(* inv_lt G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2} /\ *) +(* (t => in_dom_with FRO.m (oget G1.mh.[(x.`1, hx2)]).`2 Unknown){1}). *) +(* + inline RRO.in_dom; wp;call (_: ={FRO.m});1:by sim. *) +(* inline RRO.restrK;sp 1 1;if=>//. *) +(* by wp;call RROset_inv_lt;auto. *) +(* if=>//;wp. *) +(* + inline *;rcondt{1} 4;1:by auto=>/#. *) +(* rcondt{2} 5;1:by auto;smt w=(sizeE size_ge0). *) +(* rcondt{2} 10. by auto;progress;rewrite dom_set !inE. *) +(* wp;rnd{2};auto=> /= ??[#]!-> @/inv_lt @/inv_le [#] mlt milt clt cle Hin 3?->/=. *) +(* rewrite/Distr.is_lossless (sampleto_ll 0)/= => ? _;rewrite /bad_ext !getP /= !oget_some /= set_set_eq /=. *) +(* rewrite !(imageU,inE) restr_set /= size_rem dom_restr Hin //=; smt w=size_set_le. *) +(* by call RROset_inv_lt;auto;smt w=size_set_le. *) + +(* + proc;sp;if=> //;swap -1. *) +(* call (_: ={x,F.RO.m,FRO.m,G1.paths,G1.mh,G1.mhi,G1.m,G1.mi,G1.chandle,G1.bext,C.c,C.queries} /\ *) +(* inv_lt G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2} ==> *) +(* ={res,F.RO.m,FRO.m,G1.paths,G1.mh,G1.mhi,G1.m,G1.mi,G1.chandle,G1.bext,C.c,C.queries} /\ *) +(* inv_le G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2});last by auto=> /#. *) +(* proc;if=>//;last by auto=>/#. *) +(* seq 8 8 : *) +(* (={t,y,x,hx2,F.RO.m,FRO.m,G1.paths,G1.mh,G1.mhi,G1.m,G1.mi,G1.chandle,G1.bext,C.c,C.queries} /\ *) +(* inv_lt G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2} /\ *) +(* (t => in_dom_with FRO.m (oget G1.mhi.[(x.`1, hx2)]).`2 Unknown){1}). *) +(* + inline RRO.in_dom; auto;call (_: ={FRO.m});1:by sim. *) +(* inline RRO.restrK;sp 1 1;if=>//. *) +(* by wp;call RROset_inv_lt;auto. *) +(* if=>//;wp. *) +(* + inline *;rcondt{1} 4;1:by auto=>/#. *) +(* rcondt{2} 5;1:by auto;smt w=(sizeE size_ge0). *) +(* rcondt{2} 10. by auto;progress;rewrite dom_set !inE. *) +(* wp;rnd{2};auto=> /= ??[#]!-> @/inv_lt @/inv_le [#] mlt milt clt cle Hin 3?->/=. *) +(* rewrite/Distr.is_lossless (sampleto_ll 0) /= => ? _;rewrite /bad_ext !getP /= !oget_some /= set_set_eq /=. *) +(* rewrite !(imageU,inE) restr_set /= size_rem dom_restr Hin //=; smt w=size_set_le. *) +(* by call RROset_inv_lt;auto;smt w=size_set_le. *) + +(* + proc;sp 1 1. *) +(* if;auto. *) +(* if=>//. *) +(* inline G2(DRestr(D), RRO).C.f Gext.C.f. *) +(* sp 5 5;elim *=> c0L c0R. *) +(* wp;call (_: ={F.RO.m});1:by sim. *) +(* while (={i,p,G1.mh,sa,h,FRO.m,F.RO.m,G1.mh,G1.mhi,G1.chandle} /\ 0 <= i{1} <= size p{1}/\ *) +(* c0R + size p{1} - prefixe bs{1} (get_max_prefixe bs{1} (elems (dom C.queries{1}))) <= max_size /\ *) +(* inv_le G1.m{2} G1.mi{2} (c0R + i){2} FRO.m{2} ReSample.count{2}); *) +(* last first. *) +(* + auto;progress. *) +(* admit. *) +(* admit. *) +(* admit. *) +(* admit. *) +(* admit. *) +(* (* - smt(size_ge0) *) *) +(* (* by auto;smt(List.size_ge0 @Prefixe). *) *) +(* (* if=> //;1:by auto=>/#. *) *) +(* (* auto;call (_: ={F.RO.m});1:by sim. *) *) +(* (* inline *;auto=> ?&mr [#]!->@/inv_le Hi [#]. *) *) +(* (* case (p{mr})=> [/#|/=p1 p2] 4?_ /= 2?-> /=;split=>/= Hmem 4? [#]2->/= => [|/#]. *) *) +(* (* by rewrite restr_set /= size_set dom_restr /in_dom_with Hmem/= /#. *) *) + +(* auto;progress[delta];rewrite ?(size0,restr0,restr_set,rem0,max_ge0,-sizeE,-cardE) //=. *) +(* + smt ml=0. + smt ml=0. + smt ml=0. *) +(* + elim H7=>// [[x h] [#]];rewrite -memE dom_restr /in_dom_with in_dom=> _ ->/=. *) +(* by rewrite oget_some. *) +(* apply H10=>//. *) + qed. + axiom D_ll: forall (F <: DFUNCTIONALITY{D}) (P <: DPRIMITIVE{D}), islossless P.f => islossless P.fi => islossless F.f => islossless D(F, P).distinguish. @@ -651,7 +699,7 @@ section EXT. lemma Real_G2 &m: Pr[GReal(D).main() @ &m: res /\ C.c <= max_size] <= Pr[Eager(G2(DRestr(D))).main2() @ &m: res] + - (max_size ^ 2)%r * mu dstate (pred1 witness) + + (max_size ^ 2)%r / 2%r * mu dstate (pred1 witness) + max_size%r * ((2*max_size)%r / (2^c)%r) + max_size%r * ((2*max_size)%r / (2^c)%r). proof. diff --git a/proof/smart_counter/Handle.eca b/proof/smart_counter/Handle.eca index 4045341..ebb10c2 100644 --- a/proof/smart_counter/Handle.eca +++ b/proof/smart_counter/Handle.eca @@ -2477,8 +2477,9 @@ section. lemma Real_G1 &m: Pr[GReal(D).main() @ &m: res /\ C.c <= max_size] <= - Pr[G1(DRestr(D)).main() @ &m: res] + (max_size ^ 2)%r * inv 2%r * mu dstate (pred1 witness) + - Pr[G1(DRestr(D)).main() @&m: G1.bcol] + Pr[G1(DRestr(D)).main() @&m: G1.bext]. + Pr[G1(DRestr(D)).main() @ &m: res] + + (max_size ^ 2)%r * inv 2%r * mu dstate (pred1 witness) + + Pr[G1(DRestr(D)).main() @&m: G1.bcol \/ G1.bext]. proof. apply (@RealOrder.ler_trans _ _ _ (Real_Concrete D D_ll &m)). cut : Pr[CF(DRestr(D)).main() @ &m : res] <= @@ -2486,10 +2487,7 @@ section. Pr[G1(DRestr(D)).main() @ &m : G1.bcol \/ G1.bext]. + byequiv (CF_G1)=>//. smt ml=0. - cut /# : Pr[G1(DRestr(D)).main() @ &m : G1.bcol \/ G1.bext] <= - Pr[G1(DRestr(D)).main() @ &m : G1.bcol] + - Pr[G1(DRestr(D)).main() @ &m : G1.bext]. - rewrite Pr [mu_or]; smt(Distr.mu_bounded). + smt ml=0. qed. end section. diff --git a/proof/smart_counter/SLCommon.ec b/proof/smart_counter/SLCommon.ec index 97ba58a..0de9947 100644 --- a/proof/smart_counter/SLCommon.ec +++ b/proof/smart_counter/SLCommon.ec @@ -603,7 +603,7 @@ qed. lemma prefixe_inv_nil queries prefixes : prefixe_inv queries prefixes => - elems (dom queries) = [] => dom prefixes <= fset1 []. + elems (dom queries) = [] => dom prefixes \subset fset1 []. proof. move=>[h1 [h2 h3]] h4 x h5;rewrite in_fset1. cut:=h3 x (size x). @@ -635,7 +635,7 @@ proof. move=>[h1[h2 h3]] h5. case(elems (dom queries) = [])=>//=h4;2:smt(aux_prefixe_exchange). cut h6:=prefixe_inv_nil queries prefixes _ h4;1:rewrite/#. -rewrite h4/=. search FSet.(<=). +rewrite h4/=. case(elems (dom prefixes) = [])=>//=[->//=|]h7. cut h8:elems (dom prefixes) = [[]]. + cut [hh1 hh2]:[] \in dom prefixes /\ forall x, x \in elems (dom prefixes) => x = [] by smt(memE). @@ -650,6 +650,37 @@ by rewrite h8=>//=. qed. +pred all_prefixes_fset (prefixes : block list fset) = + forall bs, bs \in prefixes => forall i, take i bs \in prefixes. + +pred inv_prefixe_block (queries : (block list, block) fmap) + (prefixes : (block list, block) fmap) = + (forall (bs : block list), + bs \in dom queries => queries.[bs] = prefixes.[bs]) && + (forall (bs : block list), + bs \in dom queries => forall i, take i bs \in dom prefixes). + +lemma prefixe_gt0_mem l (ll : 'a list list) : + 0 < prefixe l (get_max_prefixe l ll) => + get_max_prefixe l ll \in ll. +proof. +move:l;elim:ll=>//=;first by move=>l;elim:l. +move=>l2 ll hind l1;clear hind;move:l1 l2;elim:ll=>//=l3 ll hind l1 l2. +by case(prefixe l1 l2 < prefixe l1 l3)=>//=/#. +qed. + +lemma inv_prefixe_block_mem_take queries prefixes l i : + inv_prefixe_block queries prefixes => + 0 <= i < prefixe l (get_max_prefixe l (elems (dom queries))) => + take i l \in dom prefixes. +proof. +move=>[]H_incl H_all_prefixes Hi. +rewrite (prefixe_take_leq _ (get_max_prefixe l (elems (dom queries))))1:/#. +rewrite H_all_prefixes. +cut:get_max_prefixe l (elems (dom queries)) \in dom queries;2:smt(in_dom). +by rewrite memE;apply prefixe_gt0_mem=>/#. +qed. + (* lemma prefixe_inv_prefixe queries prefixes l : *) (* prefixe_inv queries prefixes => *) (* all_prefixes prefixes => *) diff --git a/proof/smart_counter/Strong_rp_rf.eca b/proof/smart_counter/Strong_rp_rf.eca new file mode 100644 index 0000000..99d42fe --- /dev/null +++ b/proof/smart_counter/Strong_rp_rf.eca @@ -0,0 +1,604 @@ +(* -------------------------------------------------------------------- + * Copyright (c) - 2012--2016 - IMDEA Software Institute + * Copyright (c) - 2012--2018 - Inria + * Copyright (c) - 2012--2018 - Ecole Polytechnique + * + * Distributed under the terms of the CeCILL-B-V1 license + * -------------------------------------------------------------------- *) + +require import AllCore Distr List FSet NewFMap StdRing StdOrder. +require import Dexcepted. +require (*--*) NewPRP StrongPRP IdealPRP FelTactic. +(*---*) import RField RealOrder. + +(** We assume a finite domain D, equipped with its uniform + distribution. **) +type D. +op uD: { D distr | is_uniform uD /\ is_lossless uD /\ is_full uD } as uD_uf_fu. + +(** and a type K equipped with a lossless distribution **) +type K. +op dK: { K distr | is_lossless dK } as dK_ll. + +clone import StrongPRP as PRPt with + type K <- K, + op dK <- dK, + type D <- D +proof * by smt ml=0 w=dK_ll +rename "StrongPRP_" as "". + +clone import IdealPRP as PRPi with + type K <- K, + op dK <- dK, + type D <- D, + op dD <- uD +proof * by smt ml=0 w=(dK_ll uD_uf_fu) +rename "RandomPermutation" as "PRPi". + +(* This is an "Almost (Random Permutation)" (the Almost applies to Permutation) *) +(* We keep track of collisions explicitly because it's going to be useful anyway *) +module ARP = { + var coll : bool + var m, mi: (D,D) fmap + + proc init(): unit = { + m <- map0; + mi <- map0; + coll <- false; + } + + proc f(x : D) = { + var y; + + if (!mem (dom m) x) { + y <$ uD; + coll <- coll \/ mem (rng m) y; + m.[x] <- y; + mi.[y] <- x; + } + return oget m.[x]; + } + + proc fi(y : D) = { + var x; + + if (!mem (dom mi) y) { + x <$ uD; + coll <- coll \/ mem (rng mi) x; + m.[x] <- y; + mi.[y] <- x; + } + return oget mi.[y]; + } +}. + +op q : { int | 0 <= q } as ge0_q. + +(** To factor out the difficult step, we parameterize the PRP by a + procedure that samples its output, and provide two instantiations + of it. **) +module type Sample_t = { + proc sample(X:D fset): D +}. + +module Direct = { + proc sample(X:D fset): D = { + var r; + + r = $uD \ (mem X); + return r; + } +}. + +module Indirect = { + proc sample(X:D fset): D = { + var r; + + r = $uD; + if (mem X r) { + r = $uD \ (mem X); + } + return r; + } +}. + +module PRPi'(S:Sample_t) = { + proc init = PRPi.init + + proc f(x:D): D = { + if (!mem (dom PRPi.m) x) { + PRPi.m.[x] = S.sample(rng PRPi.m); + PRPi.mi.[oget PRPi.m.[x]] <- x; + } + return oget PRPi.m.[x]; + } + + proc fi(x:D): D = { + if (!mem (dom PRPi.mi) x) { + PRPi.mi.[x] = S.sample(rng PRPi.mi); + PRPi.m.[oget PRPi.mi.[x]] <- x; + } + return oget PRPi.mi.[x]; + } +}. + +(* Some losslessness lemmas *) +(* FIXME: cleanup *) + +(* FIXME: Duplicate lemmas with RP_RF *) +lemma nosmt notin_supportIP (P : 'a -> bool) (d : 'a distr): + (exists a, support d a /\ !P a) <=> mu d P < mu d predT. +proof. +rewrite (mu_split _ predT P) /predI /predT /predC /=. +rewrite (exists_eq (fun a => support d a /\ !P a) (fun a => !P a /\ a \in d)) /=. ++ by move=> a /=; rewrite andbC. +by rewrite -(witness_support (predC P)) -/(predC _) /#. +qed. + +lemma excepted_lossless (m:(D,D) fmap): + (exists x, !mem (dom m) x) => + mu (uD \ (mem (rng m))) predT = 1%r. +proof. +move=> /endo_dom_rng [x h]; rewrite dexcepted_ll //. ++ smt w=uD_uf_fu. +have [?[<- @/is_full Hsupp]]:= uD_uf_fu. +apply/notin_supportIP;exists x => />;apply Hsupp. +qed. + +phoare Indirect_ll: [Indirect.sample: exists x, support uD x /\ !mem X x ==> true] = 1%r. +proof. +proc; seq 1: (exists x, support uD x /\ !mem X x)=> //=. ++ by rnd (predT); skip; smt ml=0 w=uD_uf_fu. +if=> //=. ++ rnd (predT); skip. + by progress [-split]; split=> //=; smt. +by hoare; rnd=> //=; skip=> &hr ->. +qed. + +lemma PRPi'_Indirect_f_ll: islossless PRPi'(Indirect).f. +proof. +proc; if=> //=; auto; call Indirect_ll. +skip=> /> &hr x_notin_m. +have [x0] x0_notinr_m := endo_dom_rng PRPi.m{hr} _; first by exists x{hr}. +by exists x0; rewrite x0_notinr_m /=; smt w=uD_uf_fu. +qed. + +lemma PRPi'_Indirect_fi_ll: islossless PRPi'(Indirect).fi. +proof. +proc; if=> //=; auto; call Indirect_ll. +skip=> /> &hr x_notin_mi. +have [x0] x0_notinr_mi := endo_dom_rng PRPi.mi{hr} _; first by exists x{hr}. +by exists x0; rewrite x0_notinr_mi; smt w=uD_uf_fu. +qed. + +(** The proof is cut into 3 parts (sections): + - We first focus on proving + Pr[IND(PRPi'(Indirect),D).main() @ &m: res] + <= Pr[IND(PRFi,D).main() @ &m: res] + + Pr[IND(PRFi,D).main() @ &m: collision PRFi.m]. + - Second, we concretely bound (when the PRF oracle stops + answering queries after the q-th): + Pr[IND(PRFi,D).main() @ &m: collision PRFi.m] + <= q^2 * Pr[x = $uD: x = witness] + - We conclude by proving (difficult!) + Pr[IND(PRPi,D).main() @ &m: res] + = Pr[IND(PRPi'(Indirect),D).main() @ &m: res]. + + Purists are then invited to turn the security statement about + restricted oracles into a security statement about restricted + adversaries. **) +section Upto. + declare module D:Distinguisher {PRPi, ARP}. + axiom D_ll (O <: Oracles {D}): islossless O.f => islossless O.fi => islossless D(O).distinguish. + + local module PRP_indirect_bad = { + var bad : bool + + proc init(): unit = { + PRPi.init(); + bad <- false; + } + + proc sample(X:D fset): D = { + var r; + + r = $uD; + if (mem X r) { + bad <- true; + r = $uD \ (mem X); + } + return r; + } + + proc f(x:D): D = { + if (!mem (dom PRPi.m) x) { + PRPi.m.[x] = sample(rng PRPi.m); + PRPi.mi.[oget PRPi.m.[x]] <- x; + } + return oget PRPi.m.[x]; + } + + proc fi(y:D): D = { + if (!mem (dom PRPi.mi) y) { + PRPi.mi.[y] = sample(rng PRPi.mi); + PRPi.m.[oget PRPi.mi.[y]] <- y; + } + return oget PRPi.mi.[y]; + } + }. + + local lemma PRPi'_Indirect_eq &m: + Pr[IND(PRPi'(Indirect),D).main() @ &m: res] + = Pr[IND(PRP_indirect_bad,D).main() @ &m: res]. + proof. by byequiv=> //=; proc; inline *; sim. qed. + + (** Upto failure: if a collision does not occur in PRFi.m, then the + programs are equivalent **) + lemma pr_PRPi'_Indirect_ARP &m: + `|Pr[IND(PRPi'(Indirect),D).main() @ &m: res] + - Pr[IND(ARP,D).main() @ &m: res]| + <= Pr[IND(ARP,D).main() @ &m: ARP.coll]. + proof. + rewrite (PRPi'_Indirect_eq &m). + byequiv: PRP_indirect_bad.bad=> //=; 2:smt ml=0. + proc. + call (_: ARP.coll, + !PRP_indirect_bad.bad{1} /\ ={m,mi}(PRPi,ARP), + (PRP_indirect_bad.bad{1} <=> ARP.coll{2})). + + exact D_ll. + + proc. if=> //=; inline *. + swap{1} 1. + seq 1 4: (={x} /\ + !mem (dom PRPi.m{1}) x{1} /\ + ARP.m{2} = PRPi.m.[x <- r]{1} /\ + ARP.mi{2} = PRPi.mi.[r <- x]{1} /\ + ((PRP_indirect_bad.bad \/ mem (rng PRPi.m) r){1} <=> ARP.coll{2})). + by auto=> /#. + sp; if{1}. + conseq (_: PRP_indirect_bad.bad{1} /\ ARP.coll{2})=> //=. + auto; progress [-split]; split=> //= [|_]; 1:smt. + by progress; right. + by auto; progress [-split]; rewrite H0 /=; split=> //=; rewrite getP. + + move=> &2 bad; conseq (_: true ==> true: =1%r) + (_: PRP_indirect_bad.bad ==> PRP_indirect_bad.bad)=> //=. + by proc; if=> //=; inline *; seq 2: PRP_indirect_bad.bad; [auto|if=> //=; auto]. + proc; if=> //=; inline *. + seq 2: (X = rng PRPi.m /\ !mem (dom PRPi.m) x) 1%r 1%r 0%r _ => //=. + by auto; rewrite -/predT; smt ml=0 w=uD_uf_fu. (* predT should be an abbreviation *) + by if=> //=; auto; smt. + by hoare; auto. + + move=> &1. + proc; if; auto; progress [-split]; rewrite -/predT; split=> //= [|_]; 1:smt ml=0 w=uD_uf_fu. + by progress [-split]; rewrite H. + + proc. if=> //=; inline *. + swap{1} 1. + seq 1 4: (={y} /\ + !mem (dom PRPi.mi{1}) y{1} /\ + ARP.m{2} = PRPi.m.[r <- y]{1} /\ + ARP.mi{2} = PRPi.mi.[y <- r]{1} /\ + ((PRP_indirect_bad.bad \/ mem (rng PRPi.mi) r){1} <=> ARP.coll{2})). + by auto=> /#. + sp; if{1}. + conseq (_: PRP_indirect_bad.bad{1} /\ ARP.coll{2})=> //=. + auto; progress [-split]; split=> //= [|_]; 1:smt. + by progress; right. + by auto; progress [-split]; rewrite H0 /=; split=> //=; rewrite getP. + + move=> &2 bad; conseq (_: true ==> true: =1%r) + (_: PRP_indirect_bad.bad ==> PRP_indirect_bad.bad)=> //=. + by proc; if=> //=; inline *; seq 2: PRP_indirect_bad.bad; [auto|if=> //=; auto]. + proc; if=> //=; inline *. + seq 2: (X = rng PRPi.mi /\ !mem (dom PRPi.mi) y) 1%r 1%r 0%r _ => //=. + by auto; rewrite -/predT; smt ml=0 w=uD_uf_fu. (* predT should be an abbreviation *) + by if=> //=; auto; smt. + by hoare; auto. + + move=> &1. + proc; if; auto; progress [-split]; rewrite -/predT; split=> //= [|_]; 1:smt ml=0 w=uD_uf_fu. + by progress [-split]; rewrite H. + by inline *; auto; progress; smt. + qed. +end section Upto. + +(** We now bound the probability of collisions. We cannot do so + by instantiating the generic Birthday Bound result. It's still + the Birthday Bound, though, just not generic: + Pr[IND(ARP,DBounder(D)).main() @ &m: ARP.coll] + <= q^2 * Pr[x = $uD: x = witness], + + where DBounder prevents the distinguisher from calling the + f-oracle more than q times. **) +module DBounder (D:Distinguisher,F:Oracles) = { + module FBounder = { + var c:int + + proc f(x:D): D = { + var r = witness; + + if (c < q) { + r = F.f(x); + c = c + 1; + } + return r; + } + + proc fi(x:D): D = { + var r = witness; + + if (c < q) { + r = F.fi(x); + c = c + 1; + } + return r; + } + } + + proc distinguish(): bool = { + var b; + + FBounder.c <- 0; + b <@ D(FBounder).distinguish(); + return b; + } +}. + +section CollisionProbability. + require import Mu_mem. + (*---*) import StdBigop StdRing StdOrder IntExtra. + (*---*) import Bigreal.BRA RField RField.AddMonoid IntOrder. + + declare module D:Distinguisher {ARP, DBounder}. + axiom D_ll (O <: Oracles {D}): islossless O.f => islossless O.fi => islossless D(O).distinguish. + + local module FEL (D : Distinguisher) = { + var c : int + + module FBounder = { + proc f(x:D): D = { + var r = witness; + + if (c < q) { + if (card (rng ARP.m) < q) { + r = ARP.f(x); + } + c = c + 1; + } + return r; + } + + proc fi(x:D): D = { + var r = witness; + + if (c < q) { + if (card (rng ARP.mi) < q) { + r = ARP.fi(x); + } + c = c + 1; + } + return r; + } + } + + proc main(): bool = { + var b : bool; + + ARP.init(); + c <- 0; + b <@ D(FBounder).distinguish(); + return b; + } + }. + + lemma pr_PRFi_collision &m: + Pr[IND(ARP,DBounder(D)).main() @ &m: ARP.coll] + <= (q^2)%r / 2%r * mu uD (pred1 witness). + proof. + have ->: Pr[IND(ARP,DBounder(D)).main() @ &m: ARP.coll] + = Pr[IND(ARP,DBounder(D)).main() @ &m: ARP.coll /\ DBounder.FBounder.c <= q]. + + byequiv=> //=; conseq (_: ={glob D} ==> ={ARP.coll,DBounder.FBounder.c}) + (_: true ==> DBounder.FBounder.c <= q)=> //=. + * proc; inline *; wp; call (_: DBounder.FBounder.c <= q). + - by proc; sp; if=> //=; inline*; sp; if=> //=; auto=> /#. + - by proc; sp; if=> //=; inline*; sp; if=> //=; auto=> /#. + by auto=> /=; apply/ge0_q. + by sim. + have ->: Pr[IND(ARP,DBounder(D)).main() @ &m: ARP.coll /\ DBounder.FBounder.c <= q] + = Pr[FEL(D).main() @ &m: ARP.coll /\ FEL.c <= q]. + + byequiv=> //=; proc; inline *; wp. + call (_: ={glob ARP} /\ ={c}(DBounder.FBounder,FEL) /\ card (rng ARP.m){1} <= FEL.c{2} /\ card (rng ARP.mi){1} <= FEL.c{2}). + * proc; sp; if=> //=. rcondt{2} 1; first by auto=> /#. + inline *; sp; if=> //=; auto. + - progress. + + apply/(ler_trans (card (rng ARP.m{2} `|` fset1 yL))). + apply/subset_leq_fcard=> x; rewrite rng_set !inE rng_rem in_rng. + by move=> [[a] [] _ ma|-> //=]; left; exists a. + smt. + + apply/(ler_trans (card (rng ARP.mi{2} `|` fset1 x{2}))). + apply/subset_leq_fcard=> x; rewrite rng_set !inE rng_rem in_rng. + by move=> [[a] [] _ ma|-> //=]; left; exists a. + smt. + - smt ml=0. + * proc; sp; if=> //=. rcondt{2} 1; first by auto=> /#. + inline *; sp; if=> //=; auto. + - progress. + + apply/(ler_trans (card (rng ARP.m{2} `|` fset1 x{2}))). + apply/subset_leq_fcard=> x; rewrite rng_set !inE rng_rem in_rng. + by move=> [[a] [] _ ma|-> //=]; left; exists a. + smt. + + apply/(ler_trans (card (rng ARP.mi{2} `|` fset1 x0L))). + apply/subset_leq_fcard=> x; rewrite rng_set !inE rng_rem in_rng. + by move=> [[a] [] _ ma|-> //=]; left; exists a. + smt. + - smt ml=0. + by auto; progress; rewrite rng0 fcards0. + fel 2 FEL.c (fun x, x%r * mu uD (pred1 witness)) q (ARP.coll) [FEL(D).FBounder.f: (FEL.c < q); FEL(D).FBounder.fi: (FEL.c < q)] (size ARP.m <= FEL.c /\ size ARP.mi <= FEL.c)=> //. + + rewrite-mulr_suml Bigreal.sumidE 1:ge0_q. + by rewrite (powS 1) // pow1;smt(mu_bounded ge0_q). + + by inline*; auto; smt(dom0 fcards0 sizeE). + + exists*FEL.c;elim*=> c. + conseq(:_==>_ : (c%r * mu1 uD witness));progress. + proc; sp; rcondt 1=> //. + inline *; sp; if=> //=; last first. + * hoare; auto=> // /> &hr _ _ _ _ _ _. + by apply/RealOrder.mulr_ge0; smt w=(mu_bounded ge0_q). + sp; if=> //=. + * wp; rnd (mem (rng ARP.m)); skip. + progress. + - apply/(RealOrder.ler_trans ((card (rng ARP.m{hr}))%r * mu uD (pred1 witness))). + apply/mu_mem_le; move=> x _; have [] uD_suf [] ? uD_fu:= uD_uf_fu. + apply/RealOrder.lerr_eq/uD_suf; 1,2:rewrite uD_fu //. + by apply/RealOrder.ler_wpmul2r; smt w=(mu_bounded lt_fromint ltrW sizeE leq_card_rng_dom). + - by move: H9;rewrite H1. + * by hoare; auto=> //=; smt w=(RealOrder.mulr_ge0 mu_bounded ge0_q). + + move=> c; proc. rcondt 2; 1:by auto. + sp; if=> //=. + * inline*;sp;if;auto;smt(size_set). + * by auto=> /#. + + by move=> b c; proc; rcondf 2; auto. + + exists*FEL.c;elim*=> c. + conseq(:_==>_ : (c%r * mu1 uD witness));progress. + proc; sp; rcondt 1=> //=. + inline *; sp; if=> //=; last by hoare; auto; smt w=(RealOrder.mulr_ge0 mu_bounded ge0_q). + sp; if=> //=. + * wp; rnd (mem (rng ARP.mi)); skip. + progress. + - apply/(RealOrder.ler_trans ((card (rng ARP.mi{hr}))%r * mu uD (pred1 witness))). + apply/mu_mem_le; move=> x _; have [] uD_suf [] _ uD_fu:= uD_uf_fu. + apply/RealOrder.lerr_eq/uD_suf; 1,2:rewrite uD_fu //. + smt w=(RealOrder.ler_wpmul2r mu_bounded le_fromint ltrW sizeE leq_card_rng_dom). + - by move: H9; rewrite H1. + * by hoare; auto; smt w=(RealOrder.mulr_ge0 mu_bounded ge0_q). + + move=> c; proc; rcondt 2; 1:by auto. + sp; if=> //=. + * inline*;sp;if;auto;smt(size_set). + * by auto=> /#. + + by move=> b c; proc; rcondf 2; auto. + qed. +end section CollisionProbability. + +(* We pull together the results of the first two sections *) +lemma PartialConclusion (D <: Distinguisher {PRPi, ARP, DBounder}) &m: + (forall (O <: Oracles {D}), islossless O.f => islossless O.fi => islossless D(O).distinguish) => + `|Pr[IND(PRPi'(Indirect),DBounder(D)).main() @ &m: res] + - Pr[IND(ARP,DBounder(D)).main() @ &m: res]| + <= (q^2)%r / 2%r * mu uD (pred1 witness). +proof. +move=> D_ll. +have:= pr_PRFi_collision D D_ll &m. +have /#:= pr_PRPi'_Indirect_ARP (DBounder(D)) _ &m. +move=> O O_f_ll O_fi_ll; proc. +call (D_ll (<: DBounder(D,O).FBounder) _ _). + by proc; sp; if=> //=; wp; call O_f_ll. + by proc; sp; if=> //=; wp; call O_fi_ll. +by auto. +qed. + +(** This section proves the equivalence between the Ideal PRP and the + module PRPi'(Indirect) used in section Upto. **) +section PRPi_PRPi'_Indirect. + (* The key is in proving that Direct.sample and Indirect.sample + define the same distribution. We do this by extensional equality + of distributions: + forall a, Pr[Direct.sample: res = a] = Pr[Indirect.sample: res = a]. *) + equiv eq_Direct_Indirect: Direct.sample ~ Indirect.sample: ={X} ==> ={res}. + proof. + bypr (res{1}) (res{2})=> //. (* Pointwise equality of distributions *) + progress. + (* We first perform the computation on the easy side,... *) + cut ->: Pr[Direct.sample(X{1}) @ &1: res = a] = mu (uD \ (mem X){1}) (pred1 a). + byphoare (_: X = X{1} ==> _)=> //=. + by proc; rnd=> //=; auto. + subst X{1}. + (* ... and we are left with the difficult side *) + byphoare (_: X = X{2} ==> _)=> //=. + (* We deal separately with the case where a is in X and thus has + probability 0 of being sampled) *) + case (mem X{2} a)=> [a_in_X | a_notin_X]. + conseq (_: _ ==> _: 0%r); first smt. + proc. + seq 1: (mem X r) + _ 0%r + _ 0%r + (X = X{2}). + by auto. + by rcondt 1=> //=; rnd=> //=; skip; smt. + by rcondf 1=> //=; hoare; skip; smt. + done. + (* And we are now left with the case where a is not in X *) + proc. + alias 2 r0 = r. + (* There are two scenarios that lead to a = r: + - r0 = a /\ r = a (with probability mu uD (pred1 a)); + - r0 <> a /\ r = a (with probability mu uD (fun x, mem x X) * mu (uD \ X) (pred1 a)). *) + phoare split (mu uD (pred1 a)) (mu uD (mem X) * mu (uD \ (mem X)) (pred1 a)): (r0 = a). + (* Bound *) + progress. + rewrite dexcepted1E. + have [] uD_suf [] uD_ll uD_fu /=:= uD_uf_fu. + cut not_empty: mu uD predT - mu uD (mem X{2}) <> 0%r. + rewrite -mu_not. + cut: 0%r < mu uD (predC (mem X{2})); last smt. + by rewrite witness_support; exists a; rewrite uD_fu /= /predC a_notin_X. + by smt ml=0 w=uD_uf_fu. + (* case r0 = a *) + seq 2: (a = r0) (mu uD (pred1 a)) 1%r _ 0%r (r0 = r /\ X = X{2}). + by auto. + by wp; rnd; skip; progress; rewrite pred1E -(etaE ((=) a)) etaP. + by rcondf 1. + by hoare; conseq (_: _ ==> true)=> //=; smt. + done. + (* case r0 <> a *) + seq 2: (!mem X r) + _ 0%r + (mu uD (mem X)) (mu (uD \ (mem X)) (pred1 a)) + (r0 = r /\ X = X{2}). + by auto. + by hoare; rcondf 1=> //=; skip; smt. + by wp; rnd. + rcondt 1=> //=; rnd (pred1 a). + by skip; smt. + done. + qed. + + (* The rest is easy *) + local equiv eq_PRPi_PRPi'_f_Indirect: PRPi.f ~ PRPi'(Indirect).f: + ={x, PRPi.m, PRPi.mi} ==> ={res, PRPi.m, PRPi.mi}. + proof. + transitivity PRPi'(Direct).f (={PRPi.m,PRPi.mi,x} ==> ={PRPi.m,PRPi.mi,res}) (={PRPi.m,PRPi.mi,x} ==> ={PRPi.m,PRPi.mi,res}). + + by move=> &1 &2 [->> [->> ->>]]; exists PRPi.m{2} PRPi.mi{2} x{2}. + + done. + + by proc; inline *; if=> //=; auto; progress; rewrite getP. + + by proc; if=> //=; wp; call eq_Direct_Indirect. + qed. + + local equiv eq_PRPi_PRPi'_fi_Indirect: PRPi.fi ~ PRPi'(Indirect).fi: + y{1} = x{2} /\ ={PRPi.m, PRPi.mi} ==> ={res, PRPi.m, PRPi.mi}. + proof. + transitivity PRPi'(Direct).fi (={PRPi.m,PRPi.mi} /\ y{1} = x{2} ==> ={PRPi.m,PRPi.mi,res}) (={PRPi.m,PRPi.mi,x} ==> ={PRPi.m,PRPi.mi,res}). + + by move=> &1 &2 [->> [->> ->>]]; exists PRPi.m{2} PRPi.mi{2} x{2}. + + done. + + by proc; inline *; if=> //=; auto; progress; rewrite getP. + + by proc; if=> //=; wp; call eq_Direct_Indirect. + qed. + + declare module D:Distinguisher {PRPi}. + + lemma pr_PRPi_PRPi'_Indirect &m: + Pr[IND(PRPi,D).main() @ &m: res] = Pr[IND(PRPi'(Indirect),D).main() @ &m: res]. + proof. + byequiv=> //=. + proc. + call (_: ={PRPi.m,PRPi.mi}). + by apply eq_PRPi_PRPi'_f_Indirect. + by apply eq_PRPi_PRPi'_fi_Indirect. + by inline*; auto. + qed. +end section PRPi_PRPi'_Indirect. + +lemma Conclusion (D <: Distinguisher {PRPi, ARP, DBounder}) &m: + (forall (O <: Oracles {D}), islossless O.f => islossless O.fi => islossless D(O).distinguish) => + `|Pr[IND(PRPi,DBounder(D)).main() @ &m: res] + - Pr[IND(ARP,DBounder(D)).main() @ &m: res]| + <= (q^2)%r / 2%r * mu uD (pred1 witness). +proof. +move=> D_ll. +by rewrite (pr_PRPi_PRPi'_Indirect (DBounder(D)) &m) (PartialConclusion D &m D_ll). +qed. From d7e5fad58f060c42086a7bb6b726df0d38faa2ea Mon Sep 17 00:00:00 2001 From: Pierre-Yves Strub Date: Mon, 26 Mar 2018 09:24:09 +0200 Subject: [PATCH 270/525] CI --- .gitlab-ci.yml | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) create mode 100644 .gitlab-ci.yml diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml new file mode 100644 index 0000000..fe632d6 --- /dev/null +++ b/.gitlab-ci.yml @@ -0,0 +1,16 @@ +image: docker:latest +variables: + DOCKER_DRIVER: overlay +services: +- docker:dind +before_script: +- docker info +- docker pull easycryptpa/ec-test-box +mpc: + only: + - master + - ci + script: + - >- + docker run -v $PWD:/home/ci/sha3 easycryptpa/ec-test-box + sh -c 'cd sha3 && opam config exec -- make check' From 07d52f982a4ec1f62cd89e4c7442984e74b37a85 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Mon, 26 Mar 2018 18:59:49 +0200 Subject: [PATCH 271/525] . --- proof/smart_counter/Gcol.eca | 163 ++-- proof/smart_counter/Handle.eca | 1535 +++++++++++++++++++------------ proof/smart_counter/SLCommon.ec | 5 +- 3 files changed, 1055 insertions(+), 648 deletions(-) diff --git a/proof/smart_counter/Gcol.eca b/proof/smart_counter/Gcol.eca index 1d7a678..2047d12 100644 --- a/proof/smart_counter/Gcol.eca +++ b/proof/smart_counter/Gcol.eca @@ -4,10 +4,9 @@ require import List FSet NewFMap Utils Common SLCommon RndO FelTactic Mu_mem. require import DProd Dexcepted. (*...*) import Capacity IntOrder Bigreal RealOrder BRA. -require (*..*) Handle. +require (*..*) Gcol_ext. -clone export Handle as Handle0. - export ROhandle. +clone export Gcol_ext as Handle0. (* -------------------------------------------------------------------------- *) @@ -38,7 +37,7 @@ section PROOF. proc sample_c () = { var c=c0; if (card (image fst (rng FRO.m)) <= 2*max_size /\ - count < max_size /\ ! G1.bcol /\ ! G1.bext) { + count < max_size) { c <$ cdistr; G1.bcol <- G1.bcol \/ mem (image fst (rng FRO.m)) c; count <- count + 1; @@ -57,14 +56,16 @@ section PROOF. if (mem (dom G1.mh) (sa +^ nth witness p i, h)) { (sa, h) <- oget G1.mh.[(sa +^ nth witness p i, h)]; } else { - sc <@ sample_c(); - sa' <- F.RO.get(take (i+1) p); - sa <- sa +^ nth witness p i; - G1.mh.[(sa,h)] <- (sa', G1.chandle); - G1.mhi.[(sa',G1.chandle)] <- (sa, h); - (sa,h) <- (sa',G1.chandle); - FRO.m.[G1.chandle] <- (sc,Unknown); - G1.chandle <- G1.chandle + 1; + if (! G1.bcol /\ ! G1.bext) { + sc <@ sample_c(); + sa' <- F.RO.get(take (i+1) p); + sa <- sa +^ nth witness p i; + G1.mh.[(sa,h)] <- (sa', G1.chandle); + G1.mhi.[(sa',G1.chandle)] <- (sa, h); + (sa,h) <- (sa',G1.chandle); + FRO.m.[G1.chandle] <- (sc,Unknown); + G1.chandle <- G1.chandle + 1; + } } i <- i + 1; } @@ -79,40 +80,43 @@ section PROOF. var p, v, y, y1, y2, hy2, hx2; if (!mem (dom G1.m) x) { - if (!(mem (rng FRO.m) (x.`2, Known))) { - FRO.m.[G1.chandle] <- (x.`2, Known); - G1.chandle <- G1.chandle + 1; - } - hx2 <- oget (hinvK FRO.m x.`2); - if (mem (dom G1.paths) x.`2) { - (p,v) <- oget G1.paths.[x.`2]; - y1 <- F.RO.get (rcons p (v +^ x.`1)); - y2 <@ sample_c(); - } else { - y1 <$ bdistr; - y2 <@ sample_c(); + y <- (b0,c0); + if (! G1.bcol /\ ! G1.bext) { + if (!(mem (rng FRO.m) (x.`2, Known))) { + FRO.m.[G1.chandle] <- (x.`2, Known); + G1.chandle <- G1.chandle + 1; + } + hx2 <- oget (hinvK FRO.m x.`2); + if (mem (dom G1.paths) x.`2) { + (p,v) <- oget G1.paths.[x.`2]; + y1 <- F.RO.get (rcons p (v +^ x.`1)); + y2 <@ sample_c(); + } else { + y1 <$ bdistr; + y2 <@ sample_c(); - } - y <- (y1,y2); - if (mem (dom G1.mh) (x.`1, hx2) /\ - in_dom_with FRO.m (oget G1.mh.[(x.`1,hx2)]).`2 Unknown) { - hy2 <- (oget G1.mh.[(x.`1, hx2)]).`2; - y <- (y.`1, (oget FRO.m.[hy2]).`1); - FRO.m.[hy2] <- (y.`2, Known); - G1.m.[x] <- y; - G1.mi.[y] <- x; - } else { - hy2 <- G1.chandle; - G1.chandle <- G1.chandle + 1; - FRO.m.[hy2] <- (y.`2, Known); - G1.m.[x] <- y; - G1.mh.[(x.`1, hx2)] <- (y.`1, hy2); - G1.mi.[y] <- x; - G1.mhi.[(y.`1, hy2)] <- (x.`1, hx2); - } - if (mem (dom G1.paths) x.`2) { - (p,v) <- oget G1.paths.[x.`2]; - G1.paths.[y.`2] <- (rcons p (v +^ x.`1), y.`1); + } + y <- (y1,y2); + if (mem (dom G1.mh) (x.`1, hx2) /\ + in_dom_with FRO.m (oget G1.mh.[(x.`1,hx2)]).`2 Unknown) { + hy2 <- (oget G1.mh.[(x.`1, hx2)]).`2; + y <- (y.`1, (oget FRO.m.[hy2]).`1); + FRO.m.[hy2] <- (y.`2, Known); + G1.m.[x] <- y; + G1.mi.[y] <- x; + } else { + hy2 <- G1.chandle; + G1.chandle <- G1.chandle + 1; + FRO.m.[hy2] <- (y.`2, Known); + G1.m.[x] <- y; + G1.mh.[(x.`1, hx2)] <- (y.`1, hy2); + G1.mi.[y] <- x; + G1.mhi.[(y.`1, hy2)] <- (x.`1, hx2); + } + if (mem (dom G1.paths) x.`2) { + (p,v) <- oget G1.paths.[x.`2]; + G1.paths.[y.`2] <- (rcons p (v +^ x.`1), y.`1); + } } } else { y <- oget G1.m.[x]; @@ -124,29 +128,32 @@ section PROOF. var y, y1, y2, hx2, hy2; if (!mem (dom G1.mi) x) { - if (!(mem (rng FRO.m) (x.`2, Known))) { - FRO.m.[G1.chandle] <- (x.`2, Known); - G1.chandle <- G1.chandle + 1; - } - hx2 <- oget (hinvK FRO.m x.`2); - y1 <$ bdistr; - y2 <@ sample_c(); - y <- (y1,y2); - if (mem (dom G1.mhi) (x.`1, hx2) /\ - in_dom_with FRO.m (oget G1.mhi.[(x.`1,hx2)]).`2 Unknown) { - (y1,hy2) <- oget G1.mhi.[(x.`1, hx2)]; - y <- (y.`1, (oget FRO.m.[hy2]).`1); - FRO.m.[hy2] <- (y.`2, Known); - G1.mi.[x] <- y; - G1.m.[y] <- x; - } else { - hy2 <- G1.chandle; - G1.chandle <- G1.chandle + 1; - FRO.m.[hy2] <- (y.`2, Known); - G1.mi.[x] <- y; - G1.mhi.[(x.`1, hx2)] <- (y.`1, hy2); - G1.m.[y] <- x; - G1.mh.[(y.`1, hy2)] <- (x.`1, hx2); + y <- (b0,c0); + if (! G1.bcol /\ !G1.bext) { + if (!(mem (rng FRO.m) (x.`2, Known))) { + FRO.m.[G1.chandle] <- (x.`2, Known); + G1.chandle <- G1.chandle + 1; + } + hx2 <- oget (hinvK FRO.m x.`2); + y1 <$ bdistr; + y2 <@ sample_c(); + y <- (y1,y2); + if (mem (dom G1.mhi) (x.`1, hx2) /\ + in_dom_with FRO.m (oget G1.mhi.[(x.`1,hx2)]).`2 Unknown) { + (y1,hy2) <- oget G1.mhi.[(x.`1, hx2)]; + y <- (y.`1, (oget FRO.m.[hy2]).`1); + FRO.m.[hy2] <- (y.`2, Known); + G1.mi.[x] <- y; + G1.m.[y] <- x; + } else { + hy2 <- G1.chandle; + G1.chandle <- G1.chandle + 1; + FRO.m.[hy2] <- (y.`2, Known); + G1.mi.[x] <- y; + G1.mhi.[(x.`1, hx2)] <- (y.`1, hy2); + G1.m.[y] <- x; + G1.mh.[(y.`1, hy2)] <- (x.`1, hx2); + } } } else { y <- oget G1.mi.[x]; @@ -159,14 +166,14 @@ section PROOF. proc main(): bool = { var b; - F.RO.m <- map0; + F.RO.m <- map0; G1.m <- map0; G1.mi <- map0; G1.mh <- map0; G1.mhi <- map0; G1.bcol <- false; - FRO.m <- map0.[0 <- (c0, Known)]; + FRO.m <- map0.[0 <- (c0, Known)]; G1.paths <- map0.[c0 <- ([<:block>],b0)]; G1.chandle <- 1; count <- 0; @@ -212,16 +219,20 @@ section PROOF. move=> b c;proc;sp;if;auto;smt ml=0. qed. - local equiv G1col : G1(DRestr(D)).main ~ Gcol.main : + local equiv Gpr_col : Gpr(DRestr(D)).main ~ Gcol.main : ={glob D} ==> (G1.bcol{1} => G1.bcol{2}) /\ Gcol.count{2} <= max_size. proof. proc;inline*;wp. call (_: ={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m,C.c,C.queries}/\ (G1.bcol{1} => G1.bcol{2}) /\ + ((!G1.bext /\ !G1.bcol) => mh_spec FRO.m G1.m G1.mh F.RO.m + /\ pi_spec FRO.m G1.mh G1.paths + /\ hs_spec FRO.m G1.chandle){1} /\ (card (rng FRO.m) <= 2*C.c + 1 /\ Gcol.count <= C.c <= max_size){2}). - + proc;sp 1 1;if=>//;inline G1(DRestr(D)).S.f Gcol.S.f;swap -3. - sp;if;1,3:auto=>/#. + + proc;sp 1 1;if=>//;inline Gpr(DRestr(D)).S.f Gcol.S.f;swap -3. + sp;if;1,3:auto=>/#;sp;wp;if;auto;progress. + - rewrite/ swap{1}[3..5]-2. seq 3 2:(={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m, C.c,C.queries,x0,hx2} /\ @@ -246,7 +257,7 @@ section PROOF. auto;progress;smt w=hinv_image. + proc;sp 1 1;if=>//. - inline G1(DRestr(D)).S.fi Gcol.S.fi;swap-3. + inline Gpr(DRestr(D)).S.fi Gcol.S.fi;swap-3. seq 2 2 : (={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m, C.c,C.queries,x0} /\ (G1.bcol{1} => G1.bcol{2}) /\ @@ -272,7 +283,7 @@ section PROOF. auto=> /> ?? Himp _ _ _ ?_?_ [/Himp->// | X];right;apply hinv_image=> //. + proc;sp 1 1;if=>//;2:auto;sp;if=>//. - inline G1(DRestr(D)).C.f Gcol.C.f. sp. + inline Gpr(DRestr(D)).C.f Gcol.C.f. sp. seq 5 5: (={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m,C.c, C.queries,b,p,h,i,sa} /\ i{1}=0 /\ @@ -299,7 +310,7 @@ section PROOF. qed. lemma Pr_G1col &m: - Pr[G1(DRestr(D)).main() @ &m : G1.bcol] <= max_size%r * ((2*max_size)%r / (2^c)%r). + Pr[Gpr(DRestr(D)).main() @ &m : G1.bcol] <= max_size%r * ((2*max_size)%r / (2^c)%r). proof. apply (ler_trans Pr[Gcol.main()@&m : G1.bcol /\ Gcol.count <= max_size]). + byequiv G1col=> //#. diff --git a/proof/smart_counter/Handle.eca b/proof/smart_counter/Handle.eca index ebb10c2..8bb05ef 100644 --- a/proof/smart_counter/Handle.eca +++ b/proof/smart_counter/Handle.eca @@ -12,7 +12,7 @@ clone import GenEager as ROhandle with op sampleto <- fun (_:int) => cdistr proof sampleto_ll by apply DCapacity.dunifin_ll. - +clone export ConcreteF as ConcreteF1. module G1(D:DISTINGUISHER) = { var m, mi : smap @@ -21,7 +21,7 @@ module G1(D:DISTINGUISHER) = { var paths : (capacity, block list * block) fmap var bext, bcol : bool - module C = { + module M = { proc f(p : block list): block = { var sa, sa', sc; @@ -149,7 +149,7 @@ module G1(D:DISTINGUISHER) = { FRO.m <- map0.[0 <- (c0, Known)]; paths <- map0.[c0 <- ([<:block>],b0)]; chandle <- 1; - b <@ D(C,S).distinguish(); + b <@ D(M,S).distinguish(); return b; } }. @@ -184,7 +184,7 @@ inductive m_mh (hs : handles) (m : smap) (mh : hsmap) = /\ m.[(xa,xc)] = Some (ya,yc)). -(* WELL-FORMEDNESS<1>: Map and Prefixes are compatible *) +(* WELL-FORMEDNESS<1 >: Map and Prefixes are compatible *) inductive m_p (m : smap) (p : (block list, state) fmap) = | INV_m_p of (p.[[]] = Some (b0,c0)) & (forall (l : block list), @@ -251,7 +251,7 @@ inductive INV_CF_G1 (hs : handles) ch (Pm Pmi Gm Gmi : smap) & (incl Gmi Pmi) & (mh_spec hs Gm mh ro) & (pi_spec hs mh pi) - (* & (ro_p ro p) *) + & (all_prefixes_fset (dom ro)) & (m_p Pm p). (** Structural Projections **) @@ -326,6 +326,11 @@ lemma invG_of_INV hs ch m1 mi1 mh2 mhi2 ro pi m2 mi2 p: inv_spec m2 mi2. proof. by case. qed. +lemma all_prefixes_fset_of_INV hs ch m1 mi1 mh2 mhi2 ro pi m2 mi2 p: + INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi p => + all_prefixes_fset (dom ro). +proof. by case. qed. + lemma m_p_of_INV hs ch m1 mi1 mh2 mhi2 ro pi m2 mi2 p: INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi p => m_p m1 p. @@ -343,9 +348,9 @@ smt(in_dom). qed. lemma all_prefixes_of_INV hs ch m1 mi1 mh2 mhi2 ro pi m2 mi2 p: - INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi p => + INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi p=> all_prefixes p. -proof. case=>? ? ? ? ? ? ? ? ? h ?;exact(all_prefixes_of_m_p _ h). qed. +proof. case=>? ? ? ? ? ? ? ? ? ? h ?;exact(all_prefixes_of_m_p _ h). qed. (* lemma ro_p_of_INV hs ch m1 mi1 mh2 mhi2 ro pi m2 mi2 p: *) (* INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi p => *) @@ -806,13 +811,14 @@ have H /H {H}:= build_hpath_down mh x1 ch y1 (ch + 1) p v h _. + move=> ^ /build_hpathP + -> /=; rewrite !getP. by case=> [<*>|/#]; move: HINV=> /hs_of_INV [] _ + H - /H {H} /#. (* + by apply(ro_p_of_INV _ _ _ _ _ _ _ _ _ HINV). *) ++ by case:HINV. split=>[]. -+ by case:HINV=>_ _ _ _ _ _ _ _ (* _ *) [] _ [] ->//. -move=>l hmem i hi. -cut[]_ h2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. -cut[]sa sc[]:=h2 l hmem i hi. -cut h1:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. -smt(in_dom getP). ++ by case:HINV=>_ _ _ _ _ _ _ _ (* _ *) [] _ _ [] ->//. ++ move=>l hmem i hi. + cut[]_ h2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. + cut[]sa sc[]:=h2 l hmem i hi. + cut h1:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. + smt(in_dom getP). qed. @@ -910,13 +916,14 @@ have H /H {H}:= build_hpath_down mh y1 (ch + 1) x1 ch p v h _. + move=> ^ /build_hpathP + -> /=; rewrite !getP. by case=> [<*>|/#]; move: HINV=> /hs_of_INV [] _ + H - /H {H} /#. (* + by apply(ro_p_of_INV _ _ _ _ _ _ _ _ _ HINV). *) ++ by case:HINV. split=>[]. -+ by case:HINV=>_ _ _ _ _ _ _ _ (* _ *) [] _ [] ->//. -move=>l hmem i hi. -cut[]_ h2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. -cut[]sa sc[]:=h2 l hmem i hi. -cut h1:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. -smt(in_dom getP). ++ by case:HINV=>_ _ _ _ _ _ _ _ (* _ *) [] _ _ [] ->//. ++ move=>l hmem i hi. + cut[]_ h2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. + cut[]sa sc[]:=h2 l hmem i hi. + cut h1:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. + smt(in_dom getP). qed. lemma lemma2 hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi prefixes x1 x2 y1 y2 hx: @@ -1005,13 +1012,14 @@ move: Hpath=> /build_hpathP [<*>|]. + move=> p' b' v' h' <*> _; have /m_mh_of_INV [] _ H /H {H}:= HINV. by move=> [xc fx yc fy] [#] _; have /hs_of_INV [] _ _ H /H {H}:= HINV. (* + by apply(ro_p_of_INV _ _ _ _ _ _ _ _ _ HINV). *) ++ by case:HINV. split=>[]. -+ by case:HINV=>_ _ _ _ _ _ _ _ (* _ *) [] _ [] ->//. -move=>l hmem i hi. -cut[]_ h2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. -cut[]sa sc[]:=h2 l hmem i hi. -cut h1:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. -smt(in_dom getP). ++ by case:HINV=>_ _ _ _ _ _ _ _ (* _ *) [] _ _ [] ->//. ++ move=>l hmem i hi. + cut[]_ h2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. + cut[]sa sc[]:=h2 l hmem i hi. + cut h1:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. + smt(in_dom getP). qed. lemma lemma2' hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi prefixes x1 x2 y1 y2 hx: @@ -1114,13 +1122,14 @@ have no_path_to_ch: forall p0 v0, build_hpath G1mh p0 <> Some (v0,ch). move=> p' b' v' h' <*> _; have /m_mh_of_INV [] _ H /H {H}:= HINV. by move=> [xc fx yc fy] [#] _; have /hs_of_INV [] _ _ H /H {H}:= HINV. (* + by apply(ro_p_of_INV _ _ _ _ _ _ _ _ _ HINV). *) ++ by case:HINV. split=>[]. -+ by case:HINV=>_ _ _ _ _ _ _ _ (* _ *) [] _ [] ->//. -move=>l hmem i hi. -cut[]_ h2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. -cut[]sa sc[]:=h2 l hmem i hi. -cut h1:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. -smt(in_dom getP). ++ by case:HINV=>_ _ _ _ _ _ _ _ (* _ *) [] _ _ [] ->//. ++ move=>l hmem i hi. + cut[]_ h2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. + cut[]sa sc[]:=h2 l hmem i hi. + cut h1:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. + smt(in_dom getP). qed. lemma lemma3 hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes xa xc hx ya yc hy p b: @@ -1201,16 +1210,16 @@ split. move: pi_xc; have /pi_of_INV [] -> [h] [#] + hs_h:= HINV. by have /hs_of_INV [] + _ _ - /(_ _ _ _ _ hs_hx hs_h _) := HINV. (* + by apply(ro_p_of_INV _ _ _ _ _ _ _ _ _ HINV). *) ++ by case:HINV. split=>[]. -+ by case:HINV=>_ _ _ _ _ _ _ _ (* _ *) [] _ [] ->//. -move=>l hmem i hi. -cut[]_ h2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. -cut[]sa sc[]:=h2 l hmem i hi. -cut h1:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. -smt(in_dom getP). ++ by case:HINV=>_ _ _ _ _ _ _ _ (* _ *) [] _ _ [] ->//. ++ move=>l hmem i hi. + cut[]_ h2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. + cut[]sa sc[]:=h2 l hmem i hi. + cut h1:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. + smt(in_dom getP). qed. -clone export ConcreteF as ConcreteF1. lemma m_mh_None hs0 PFm G1mh hx2 x2 k x1: m_mh hs0 PFm G1mh => @@ -1447,33 +1456,39 @@ qed. module G1'(D:DISTINGUISHER) = { + var m, mi : smap + var mh, mhi : hsmap + var chandle : int + var paths : (capacity, block list * block) fmap + var bext, bcol : bool - module C = { + module M = { proc f(p : block list): block = { var sa, sa', sc; - var h, i <- 0; + var h, i, counter <- 0; sa <- b0; sc <- c0; while (i < size p ) { - if (mem (dom G1.mh) (sa +^ nth witness p i, h)) { - (sa, h) <- oget G1.mh.[(sa +^ nth witness p i, h)]; + if (mem (dom mh) (sa +^ nth witness p i, h)) { + (sa, h) <- oget mh.[(sa +^ nth witness p i, h)]; } else { - sc <$ cdistr; - G1.bcol <- G1.bcol \/ hinv FRO.m sc <> None; - sa' <@ F.RO.get(take (i+1) p); - sa <- sa +^ nth witness p i; - G1.mh.[(sa,h)] <- (sa', G1.chandle); - G1.mhi.[(sa',G1.chandle)] <- (sa, h); - (sa,h) <- (sa',G1.chandle); - FRO.m.[G1.chandle] <- (sc,Unknown); - G1.chandle <- G1.chandle + 1; + if (counter < size p - prefixe p (get_max_prefixe p (elems (dom C.queries)))) { + sc <$ cdistr; + bcol <- bcol \/ hinv FRO.m sc <> None; + sa' <@ F.RO.get(take (i+1) p); + sa <- sa +^ nth witness p i; + mh.[(sa,h)] <- (sa', chandle); + mhi.[(sa',chandle)] <- (sa, h); + (sa,h) <- (sa',chandle); + FRO.m.[chandle] <- (sc,Unknown); + chandle <- chandle + 1; + counter <- counter + 1; + } } i <- i + 1; } - if (p <> []) { - sa <- F.RO.get(p); - } + sa <- F.RO.get(p); return sa; } } @@ -1483,9 +1498,9 @@ module G1'(D:DISTINGUISHER) = { proc f(x : state): state = { var p, v, y, y1, y2, hy2, hx2; - if (!mem (dom G1.m) x) { - if (mem (dom G1.paths) x.`2) { - (p,v) <- oget G1.paths.[x.`2]; + if (!mem (dom m) x) { + if (mem (dom paths) x.`2) { + (p,v) <- oget paths.[x.`2]; y1 <- F.RO.get (rcons p (v +^ x.`1)); y2 <$ cdistr; } else { @@ -1493,34 +1508,34 @@ module G1'(D:DISTINGUISHER) = { y2 <$ cdistr; } y <- (y1, y2); - G1.bext <- G1.bext \/ mem (rng FRO.m) (x.`2, Unknown); + bext <- bext \/ mem (rng FRO.m) (x.`2, Unknown); if (!(mem (rng FRO.m) (x.`2, Known))) { - FRO.m.[G1.chandle] <- (x.`2, Known); - G1.chandle <- G1.chandle + 1; + FRO.m.[chandle] <- (x.`2, Known); + chandle <- chandle + 1; } hx2 <- oget (hinvK FRO.m x.`2); - if (mem (dom G1.mh) (x.`1, hx2) /\ in_dom_with FRO.m (oget G1.mh.[(x.`1,hx2)]).`2 Unknown) { - hy2 <- (oget G1.mh.[(x.`1, hx2)]).`2; - y <- (y.`1, (oget FRO.m.[hy2]).`1); - FRO.m.[hy2] <- (y.`2, Known); - G1.m.[x] <- y; - G1.mi.[y] <- x; + if (mem (dom mh) (x.`1, hx2) /\ in_dom_with FRO.m (oget mh.[(x.`1,hx2)]).`2 Unknown) { + hy2 <- (oget mh.[(x.`1, hx2)]).`2; + y <- (y.`1, (oget FRO.m.[hy2]).`1); + FRO.m.[hy2] <- (y.`2, Known); + m.[x] <- y; + mi.[y] <- x; } else { - G1.bcol <- G1.bcol \/ hinv FRO.m y.`2 <> None; - hy2 <- G1.chandle; - G1.chandle <- G1.chandle + 1; - FRO.m.[hy2] <- (y.`2, Known); - G1.m.[x] <- y; - G1.mh.[(x.`1, hx2)] <- (y.`1, hy2); - G1.mi.[y] <- x; - G1.mhi.[(y.`1, hy2)] <- (x.`1, hx2); + bcol <- bcol \/ hinv FRO.m y.`2 <> None; + hy2 <- chandle; + chandle <- chandle + 1; + FRO.m.[hy2] <- (y.`2, Known); + m.[x] <- y; + mh.[(x.`1, hx2)] <- (y.`1, hy2); + mi.[y] <- x; + mhi.[(y.`1, hy2)] <- (x.`1, hx2); } - if (mem (dom G1.paths) x.`2) { - (p,v) <- oget G1.paths.[x.`2]; - G1.paths.[y.`2] <- (rcons p (v +^ x.`1), y.`1); + if (mem (dom paths) x.`2) { + (p,v) <- oget paths.[x.`2]; + paths.[y.`2] <- (rcons p (v +^ x.`1), y.`1); } } else { - y <- oget G1.m.[x]; + y <- oget m.[x]; } return y; } @@ -1528,35 +1543,35 @@ module G1'(D:DISTINGUISHER) = { proc fi(x : state): state = { var y, y1, y2, hx2, hy2; - if (!mem (dom G1.mi) x) { - G1.bext <- G1.bext \/ mem (rng FRO.m) (x.`2, Unknown); + if (!mem (dom mi) x) { + bext <- bext \/ mem (rng FRO.m) (x.`2, Unknown); if (!(mem (rng FRO.m) (x.`2, Known))) { - FRO.m.[G1.chandle] <- (x.`2, Known); - G1.chandle <- G1.chandle + 1; + FRO.m.[chandle] <- (x.`2, Known); + chandle <- chandle + 1; } hx2 <- oget (hinvK FRO.m x.`2); y1 <$ bdistr; y2 <$ cdistr; y <- (y1,y2); - if (mem (dom G1.mhi) (x.`1,hx2) /\ - in_dom_with FRO.m (oget G1.mhi.[(x.`1,hx2)]).`2 Unknown) { - (y1,hy2) <- oget G1.mhi.[(x.`1, hx2)]; - y <- (y.`1, (oget FRO.m.[hy2]).`1); - FRO.m.[hy2] <- (y.`2, Known); - G1.mi.[x] <- y; - G1.m.[y] <- x; + if (mem (dom mhi) (x.`1,hx2) /\ + in_dom_with FRO.m (oget mhi.[(x.`1,hx2)]).`2 Unknown) { + (y1,hy2) <- oget mhi.[(x.`1, hx2)]; + y <- (y.`1, (oget FRO.m.[hy2]).`1); + FRO.m.[hy2] <- (y.`2, Known); + mi.[x] <- y; + m.[y] <- x; } else { - G1.bcol <- G1.bcol \/ hinv FRO.m y.`2 <> None; - hy2 <- G1.chandle; - G1.chandle <- G1.chandle + 1; - FRO.m.[hy2] <- (y.`2, Known); - G1.mi.[x] <- y; - G1.mhi.[(x.`1, hx2)] <- (y.`1, hy2); - G1.m.[y] <- x; - G1.mh.[(y.`1, hy2)] <- (x.`1, hx2); + bcol <- bcol \/ hinv FRO.m y.`2 <> None; + hy2 <- chandle; + chandle <- chandle + 1; + FRO.m.[hy2] <- (y.`2, Known); + mi.[x] <- y; + mhi.[(x.`1, hx2)] <- (y.`1, hy2); + m.[y] <- x; + mh.[(y.`1, hy2)] <- (x.`1, hx2); } } else { - y <- oget G1.mi.[x]; + y <- oget mi.[x]; } return y; } @@ -1566,506 +1581,886 @@ module G1'(D:DISTINGUISHER) = { proc main(): bool = { var b; - F.RO.m <- map0; - G1.m <- map0; - G1.mi <- map0; - G1.mh <- map0; - G1.mhi <- map0; - G1.bext <- false; - G1.bcol <- false; + F.RO.m <- map0; + m <- map0; + mi <- map0; + mh <- map0; + mhi <- map0; + bext <- false; + bcol <- false; (* the empty path is initially known by the adversary to lead to capacity 0^c *) - FRO.m <- map0.[0 <- (c0, Known)]; - G1.paths <- map0.[c0 <- ([<:block>],b0)]; - G1.chandle <- 1; - b <@ D(C,S).distinguish(); + FRO.m <- map0.[0 <- (c0, Known)]; + paths <- map0.[c0 <- ([<:block>],b0)]; + chandle <- 1; + b <@ D(M,S).distinguish(); return b; } }. +lemma lemma5 hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes i (p : block list) b c h: + INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes + => 0 <= i < size p + => take (i + 1) p \in dom prefixes + => prefixes.[take i p] = Some (b,c) + => (exists f, hs.[h] = Some (c,f)) + => exists b' c' h', + Pm.[(b +^ nth witness p i, c)] = Some (b',c') /\ + mh.[(b +^ nth witness p i, h)] = Some (b',h'). +proof. +move=>Hinv H_size H_take_iS H_take_i H_hs_h. +cut[]_ H:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ Hinv. +cut[]sa sc:=H _ H_take_iS i _;1:smt(size_take). +rewrite!take_take !min_lel//= 1:/# nth_take 1,2:/#H_take_i=>[][]/=[->>->>] H_pm. +cut[]b' c' H_Pm:exists b' c', Pm.[(sa +^ nth witness p i, sc)] = Some (b',c') by smt(in_dom). +exists b' c';rewrite -H_Pm/=. +cut[]h_Pm _:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ Hinv. +cut[]h' f' hy fy[]H_h'[]H_hy H_mh:=h_Pm _ _ _ _ H_Pm. +cut[]h_huniq _ _:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ Hinv. print huniq. +cut[]f H_h := H_hs_h. +cut/=<<-:=h_huniq _ _ _ _ H_h H_h'. +by rewrite H_mh/=/#. +qed. -equiv PFf_Cf_not_nil (D<:DISTINGUISHER): SqueezelessSponge(PF).f ~ G1'(D).C.f : - ! (G1.bcol{2} \/ G1.bext{2}) /\ - ={p} /\ p{1} <> [] /\ - INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} - G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} Redo.prefixes{1} ==> - ! (G1.bcol{2} \/ G1.bext{2}) => - ={res} /\ INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} - G1.mi{2} G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} Redo.prefixes{1}. + +lemma lemma5' hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes i (p : block list) b c h: + INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes + => 0 <= i < size p + => prefixes.[take i p] = Some (b,c) + => (exists f, hs.[h] = Some (c,f)) + => (exists b' c' h', + Pm.[(b +^ nth witness p i, c)] = Some (b',c') /\ + mh.[(b +^ nth witness p i, h)] = Some (b',h')) \/ + (Pm.[(b +^ nth witness p i, c)] = None /\ + mh.[(b +^ nth witness p i, h)] = None). +proof. +move=>Hinv H_size H_take_i H_hs_h. +case(Pm.[(b +^ nth witness p i, c)] = None)=>//=H_Pm. ++ right;move:H_Pm;apply absurd=>H_mh. + cut[]b1 h1 H_mh1:exists b1 h1, mh.[(b +^ nth witness p i, h)] = Some (b1,h1) by rewrite/#. + cut[]H_Pm H_Gmh:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ Hinv. + by cut/#:=H_Gmh _ _ _ _ H_mh1. +cut[]b1 c1 H_Pm1:exists b1 c1, Pm.[(b +^ nth witness p i, c)] = Some (b1,c1) + by exists (oget Pm.[(b +^ nth witness p i, c)]).`1 + (oget Pm.[(b +^ nth witness p i, c)]).`2;smt(get_oget in_dom). +cut[]H_P_m H_Gmh:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ Hinv. +cut:=H_P_m _ _ _ _ H_Pm1. +by cut[]/#:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ Hinv. +qed. + + +equiv PFf_Cf_not_nil (D<:DISTINGUISHER): + + DFRestr(SqueezelessSponge(PF)).f ~ DFRestr(G1(D).M).f : + + ! (G1.bcol{2} \/ G1.bext{2}) /\ + ={arg} /\ ={glob C} /\ [] \in dom C.queries{2} /\ + INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} + G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} Redo.prefixes{1} + ==> + ! (G1.bcol{2} \/ G1.bext{2}) => ={glob C} /\ ={res} /\ + INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} + G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} Redo.prefixes{1} /\ + [] \in dom C.queries{2}. proof. - proc;sp. - seq 1 1: - ((!(G1.bcol{2} \/ G1.bext{2}) => + proc;sp;inline*;sp. + if;1,3:auto;if;1,3:auto;swap{1}4;swap{2}11;sp;wp 1 5. + sp;conseq(:_==> ! (G1.bcol{2} \/ G1.bext{2}) => + ={glob C, sa} /\ + INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} G1.mh{2} + G1.mhi{2} F.RO.m{2} G1.paths{2} Redo.prefixes{1} /\ + [] \in dom C.queries{2} /\ + F.RO.m.[p]{2} = Some sa{2});progress. + + rewrite/#. + + rewrite/#. + + rewrite/#. + + smt(dom_set in_fsetU1). + seq 1 1: + (={i, p, glob C} /\ i{1} = size p{1} /\ p{2} = bs{1} /\ + (!(G1.bcol{2} \/ G1.bext{2}) => (INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} - G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} Redo.prefixes{1} /\ ={sa} /\ + G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} Redo.prefixes{1} /\ + [] \in dom C.queries{2} /\ ={sa} /\ F.RO.m.[p]{2} = Some sa{1})));last first. - + case : (! (G1.bcol{2} \/ G1.bext{2})); - 2: conseq (_:_ ==> true)=> //; inline *;auto;progress. - + if{2};1:rcondf{2} 3;auto;progress. - + smt(in_dom). - + smt(Block.DBlock.dunifin_ll). - + rewrite/#. - + rewrite/#. - + rewrite/#. - + rewrite/#. - if{2};auto;progress;smt(Block.DBlock.dunifin_ll). - while ( ={p, i} /\ (0 <= i <= size p){2} /\ + + case : (! (G1.bcol{2} \/ G1.bext{2}));last first. + - by conseq(:_==>true);progress;auto;smt(DBlock.dunifin_ll DCapacity.dunifin_ll take_size). + by rcondf{2}3;auto;smt(in_dom DBlock.dunifin_ll DCapacity.dunifin_ll take_size). + + while ( ={p, i, glob C} /\ (0 <= i <= size p){2} /\ (Redo.prefixes.[take i p]{1} = Some (sa,sc){1}) /\ (take i p \in dom Redo.prefixes){1} /\ - (!(G1.bcol{2} \/ G1.bext{2}) => - (INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} + (!(G1.bcol{2} \/ G1.bext{2}) => + (INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} Redo.prefixes{1} /\ + [] \in dom C.queries{2} /\ ={sa} /\ - (exists f, FRO.m.[h]{2} = Some (sc{1}, f)) /\ - (build_hpath G1.mh (take i p) = Some (sa,h)){2} /\ - if i{2} = 0 then (sa,h){2} = (b0, 0) - else F.RO.m.[take i p]{2} = Some sa{1})));last first. - + auto=> &m1 &m2 [#]->->-> _->->->->-> Hp ^ Hinv -> /=;rewrite size_ge0/=;split. - + split;-1: split;-1: split;-2: by exists Known;case Hinv => -[] _ ->. - + by rewrite take0;case:Hinv=>_ _ _ _ _ _ _ _ _ []->//. - + by rewrite take0 in_dom;case:Hinv=>_ _ _ _ _ _ _ _ _ []->//. - by rewrite take0. - progress. - + rewrite/#. - + smt(size_eq0 size_ge0 take_size). - + smt(size_eq0 size_ge0 take_size). + (exists f, FRO.m.[h]{2} = Some (sc{1}, f)) /\ + (build_hpath G1.mh (take i p) = Some (sa,h)){2} /\ + if i{2} = 0 then (sa,h){2} = (b0, 0) + else F.RO.m.[take i p]{2} = Some sa{1})));last first. + + auto;progress. + - smt(size_ge0). + - case:H1=>_ _ _ _ _ _ _ _ _ _ [];smt(take0). + - case:H1=>_ _ _ _ _ _ _ _ _ _ [];smt(take0 in_dom). + - cut[]/#:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ H1. + - cut[]/#:=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ H1. + - rewrite/#. + - rewrite/#. + - rewrite/#. + - smt(size_eq0 size_ge0 take_le0 take_size). + case : (! (G1.bcol{2} \/ G1.bext{2}));last first. + - wp 1 1=>/=. + conseq(:_==> Redo.prefixes{1}.[take (i{1}+1) p{1}] = Some (sa{1}, sc{1}) + /\ (take (i{1} + 1) p{1} \in dom Redo.prefixes{1}) + /\ (G1.bcol{2} \/ G1.bext{2}));1:rewrite/#. + if{1};sp;2:if{1};if{2};sp;auto;4:swap{2}4-3;auto; + smt(getP get_oget dom_set in_fsetU1 DBlock.dunifin_ll DCapacity.dunifin_ll). if{1}. - + case : (! (G1.bcol{2} \/ G1.bext{2}));last first. - + wp;conseq(:_==> (G1.bcol{2} \/ G1.bext{2}));1:smt(get_oget). - by inline*;if{2};auto;smt(DCapacity.dunifin_ll DBlock.dunifin_ll). - conseq(: ={p, i, sa} - /\ 0 <= i{2} < size p{2} - /\ Redo.prefixes{1}.[take i{1} p{1}] = Some (sa{1}, sc{1}) - /\ (take i{1} p{1} \in dom Redo.prefixes{1}) - /\ INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} - G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} Redo.prefixes{1} - /\ (exists (f : flag), FRO.m{2}.[h{2}] = Some (sc{1}, f)) - /\ build_hpath G1.mh{2} (take i{2} p{2}) = Some (sa{2}, h{2}) - /\ (if i{2} = 0 then (sa{2}, h{2}) = (b0, 0) - else F.RO.m{2}.[take i{2} p{2}] = Some sa{1}) - /\ (take (i{1} + 1) p{1} \in dom Redo.prefixes{1}) - /\ ! (G1.bcol{2} \/ G1.bext{2}) - /\ F.RO.m{2}.[take (i{2} + 1) p{2}] = - Some (oget Redo.prefixes{1}.[take (i{2} + 1) p{2}]).`1 - && ((sa +^ nth witness p i, h) \in dom G1.mh){2} ==> _);progress. - * rewrite/#. - * rewrite/#. - * rewrite/#. - * rewrite/#. - * rewrite/#. - * rewrite/#. - * rewrite/#. - * move:H3;rewrite H7/=;progress. - cut[]prefixe_nil prefixes:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ H3. - cut[]b1 c1:=prefixes _ H6 i{2} _;1:smt(size_take). - rewrite!take_take!min_lel//=1:/# nth_take 1,2:/# H1/==>[][][->>->>]h. - rewrite -h. - cut[]h1 h2 h3:=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ H3. - cut->:=take_nth witness i{2} p{2} _;1:smt(size_take). - rewrite h2 H9/=. exists b1 h{2}=>//=. - clear h1 h2 h3 prefixes prefixe_nil. - cut[]h1 h2:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ H3. - cut[]a b c d[]e[]g j:=h1 (b1 +^ nth witness p{2} i{2}) c1 - (oget Redo.prefixes{1}.[take (i{2} + 1) p{2}]).`1 - (oget Redo.prefixes{1}.[take (i{2} + 1) p{2}]).`2 _;1:smt(get_oget). - cut[]hu _ _:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ H3. - by cut/=<<-/#:=hu _ _ _ _ H8 e. - * move:H3;rewrite H7/=;progress. - cut/#:=lemma4 _ _ _ _ _ _ _ _ _ _ _ i{2} p{2} _ _ _ _ H3 _ H6 H1 H10 H8 H9. - by rewrite/#. - rcondt{2}1;1:auto. - auto;progress. + + rcondt{2}1;auto;progress. + - cut[]HINV:=H3 H6. + by cut//=:=lemma5 _ _ _ _ _ _ _ _ _ _ _ i{hr} p{hr} sa{hr} sc{m} h{hr} HINV;smt(in_dom). + - rewrite/#. + - rewrite/#. + - smt(get_oget). + - rewrite/#. + - rewrite/#. + - cut[]HINV[]H_dom[]->>[][]f H_h[]H_path H_F_RO:=H3 H6. + cut//=[]:=lemma5 _ _ _ _ _ _ _ _ _ _ _ i{2} p{2} sa{2} sc{1} h{2} HINV _ _ _ _. + * rewrite/#. + * rewrite/#. + * rewrite/#. + * rewrite/#. + move=>b' c' h'[]H_Pm ->/=;rewrite oget_some/=. + cut[]_ H_pref:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. + cut[]b1 c1[]:=H_pref _ H7 i{2} _;1:smt(size_take). + by rewrite !take_take!min_lel 1,2:/# nth_take 1,2:/# H1/==>[][]->>->><-/#. + - cut[]HINV[]H_dom[]->>[][]f H_h[]H_path H_F_RO:=H3 H6. + cut//=[]:=lemma5 _ _ _ _ _ _ _ _ _ _ _ i{2} p{2} sa{2} sc{1} h{2} HINV _ _ _ _. + * rewrite/#. + * rewrite/#. + * rewrite/#. + * rewrite/#. + move=>b' c' h'[]H_Pm H_mh/=. + rewrite H_mh/=oget_some/=. + cut[]_ H_Gmh:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. + cut[]c1 h1 c2 h2:=H_Gmh _ _ _ _ H_mh;rewrite H_h/==>[][][<<-<<-][];rewrite H_Pm/=. + move=>help ->>;move:help. + cut[]_ H_pref:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. + cut[]b3 c3[]:=H_pref _ H7 i{2} _;1:smt(size_take). + rewrite !take_take!min_lel 1,2:/# nth_take 1,2:/# H1/==>[][]->>->><-. + by rewrite H_Pm oget_some/=/#. + - cut[]HINV[]H_dom[]->>[][]f H_h[]H_path H_F_RO:=H3 H6. + cut//=[]b1 c1 h1[]H_Pm H_mh:=lemma5 _ _ _ _ _ _ _ _ _ _ _ i{2} p{2} sa{2} sc{1} h{2} HINV _ _ _ _. + * rewrite/#. + * rewrite/#. + * rewrite/#. + * rewrite/#. + by rewrite H_mh/=oget_some/=(@take_nth witness)1:/#build_hpath_prefix H_path/=/#. + - rewrite/#. + - rewrite/#. + - cut[]HINV[]H_dom[]->>[][]f H_h[]H_path H_F_RO:=H3 H6. + cut[]_ H_pref:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. + cut[]b3 c3[]:=H_pref _ H7 i{2} _;1:smt(size_take). + rewrite !take_take!min_lel 1,2:/# nth_take 1,2:/# H1/==>[][]->>->>. + cut//=[]b1 c1 h1[]H_Pm H_mh:=lemma5 _ _ _ _ _ _ _ _ _ _ _ i{2} p{2} b3 c3 h{2} HINV _ _ _ _. + * rewrite/#. + * rewrite/#. + * rewrite/#. + * rewrite/#. + rewrite H_Pm=>H_pref_Pm;rewrite -H_pref_Pm oget_some/=. + rewrite(@take_nth witness)1:/#. + by cut[]_ -> _/#:=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. + + sp;wp=>/=. + if{1};2:rcondt{2}1;first last;3:rcondf{2}1;..3:auto. + + smt(lemma5' in_dom). + + progress. + - rewrite/#. + - rewrite/#. + - smt(getP get_oget in_dom). + - smt(getP get_oget in_dom). + - cut[]HINV[]H_nil_in_dom[]->>[][]f H_h[]H_path H_F_RO:=H3 H6. + split;case:HINV=>//=_ _ _ _ _ _ _ _ _ _[] H0' H_m_p;split. + + by rewrite getP; smt(size_take take0 size_eq0 size_ge0). + move=>l;rewrite dom_set in_fsetU1. + case(l = take (i{2} + 1) p{2})=>//=[->>|H_l H_dom]. + * move=>j H_size;rewrite!getP/=. + cut h_size:0 <= j <= i{2} by smt(size_take). + cut->/=:!take j (take (i{2} + 1) p{2}) = take (i{2} + 1) p{2} by smt(size_take). + rewrite!take_take!min_lel 1,2:/# nth_take 1,2:/#. + case(j=i{2})=>[->>|H_ij]/=. + + smt(get_oget in_dom). + cut->/=:!(take (j + 1) p{2}) = take (i{2} + 1) p{2} by smt(size_take). + cut[]:=H_m_p _ H2 j _;1:smt(size_take). + by rewrite!take_take!min_lel 1,2:/# nth_take /#. + move=>i Hi;rewrite!getP. + cut:take i l \in dom Redo.prefixes{1} by smt(in_dom). + by cut/#:take (i+1) l \in dom Redo.prefixes{1} by smt(in_dom take_oversize). + - rewrite/#. + - smt(lemma5' in_dom). + - cut[]HINV[]H_nil_in_dom[]->>[][]f H_h[]H_path H_F_RO:=H3 H6. + cut:=lemma5' _ _ _ _ _ _ _ _ _ _ _ i{2} p{2} sa{2} sc{1} h{2} HINV _ _ _. + * rewrite/#. + * rewrite/#. + * rewrite/#. + cut:=H8;rewrite in_dom=>->/=[]b1 c1 h1[]H_Pm1 H_Gmh1. + rewrite H_Pm1 H_Gmh1 !oget_some/=. + by cut[]/#:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. + - cut[]HINV[]H_nil_in_dom[]->>[][]f H_h[]H_path H_F_RO:=H3 H6. + cut:=lemma5' _ _ _ _ _ _ _ _ _ _ _ i{2} p{2} sa{2} sc{1} h{2} HINV _ _ _. + * rewrite/#. + * rewrite/#. + * rewrite/#. + cut:=H8;rewrite in_dom=>->/=[]b1 c1 h1[]H_Pm1 H_Gmh1. + by rewrite H_Gmh1 oget_some/=(@take_nth witness)1:/#build_hpath_prefix H_path/=/#. + - rewrite/#. + - rewrite/#. + - cut[]HINV[]H_nil_in_dom[]->>[][]f H_h[]H_path H_F_RO:=H3 H6. + cut:=lemma5' _ _ _ _ _ _ _ _ _ _ _ i{2} p{2} sa{2} sc{1} h{2} HINV _ _ _. + * rewrite/#. + * rewrite/#. + * rewrite/#. + cut:=H8;rewrite in_dom=>->/=[]b1 c1 h1[]H_Pm1 H_Gmh1. + rewrite H_Pm1 !oget_some/=(@take_nth witness)1:/#. + by cut[]/#:=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. + + smt(lemma5' in_dom). + rcondt{2}5;auto;progress. + * rewrite(@take_nth witness)1:/# in_dom. + cut[]HINV[]H_nil_in_dom[]->>[][]f H_h[]H_path H_F_RO:=H3 H6. + cut[]:=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. + cut:=lemma5' _ _ _ _ _ _ _ _ _ _ _ i{hr} p{hr} sa{hr} sc{m} h{hr} HINV _ _ _. * rewrite/#. * rewrite/#. - * smt(get_oget). - * cut:=lemma4 _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ H3 _ H7 H1 H5 H9 H4;1:rewrite/#. - rewrite in_dom=>hG1. - cut[]b1 h1 hb1h1:exists b1 h1, G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2})] = Some (b1, h1) by rewrite/#. - cut[]_ h:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ H3. - cut[]b' c':=h _ H7 i{2} _;1:smt(size_take). - rewrite!take_take!min_lel 1,2:/# nth_take 1,2:/#H1/==>[][][<<-<<-]{b' c'} h'{h}. - rewrite-h' hb1h1/=oget_some/=. - cut[]hh1 hh2:= m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ H3. - cut[]a b c d:=hh2 _ _ _ _ hb1h1. - by rewrite H4/==>[][][]->>->>[]_->;rewrite !oget_some/=/#. - * cut:=lemma4 _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ H3 _ H7 H1 H5 H9 H4;1:rewrite/#. - rewrite in_dom=>hG1. - cut[]b1 h1 hb1h1:exists b1 h1, G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2})] = Some (b1, h1) by rewrite/#. - cut[]_ h:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ H3. - cut[]b' c':=h _ H7 i{2} _;1:smt(size_take). - rewrite!take_take!min_lel 1,2:/# nth_take 1,2:/#H1/==>[][][<<-<<-]{b' c'} h'{h}. - rewrite-h' hb1h1/=oget_some/=. - cut[]hh1 hh2:= m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ H3. - cut[]a b c d:=hh2 _ _ _ _ hb1h1. - by rewrite H4/==>[][][]->>->>[]->->;rewrite !oget_some/=/#. - * cut:=lemma4 _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ H3 _ H7 H1 H5 H9 H4;1:rewrite/#. - rewrite in_dom=>hG1. - cut[]b1 h1 hb1h1:exists b1 h1, G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2})] = Some (b1, h1) by rewrite/#. - cut->:=(take_nth witness i{2} p{2} _);rewrite//=. - by rewrite build_hpath_prefix H5/=hb1h1/=;smt(oget_some). * rewrite/#. + cut:=H8;rewrite in_dom =>/=->/=H_Gmh _ H_ H_path_uniq. + cut help:=H_ (take i{hr} p{hr}) (nth witness p{hr} i{hr});rewrite H_path/= in help. + cut:forall (b : block), + F.RO.m{hr}.[rcons (take i{hr} p{hr}) (nth witness p{hr} i{hr})] = Some b + <=> exists hy, G1.mh{hr}.[(sa{hr} +^ nth witness p{hr} i{hr}, h{hr})] = Some (b, hy) by rewrite/#. + move:help=>_ help;move:H_Gmh;apply absurd=>//=H_F_Ro. + by cut:=get_oget F.RO.m{hr} (rcons (take i{hr} p{hr}) (nth witness p{hr} i{hr}));rewrite in_dom H_F_Ro/=help=>[]/#. + swap{2}-3;auto;progress. + * rewrite/#. + * rewrite/#. + * by rewrite!getP/=. + * smt(getP dom_set in_fsetU1). + * rewrite!getP/=!oget_some/=. + * cut[]HINV[]H_nil_in_dom[]->>[][]f H_h[]H_path H_F_RO:=H3 H6. + cut:=H13;rewrite !negb_or/==>[][][]bad1 hinv_none bad2. + cut H_hs_spec:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. + cut H_mh_spec:=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. + cut H_m_mh:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. + cut H_mi_mhi:=mi_mhi_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. + cut H_pi_spec:=pi_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. + cut :=lemma5' _ _ _ _ _ _ _ _ _ _ _ i{2} p{2} sa{2} sc{1} h{2} HINV _ _ _. + * by rewrite H H4/=. + * exact H1. * rewrite/#. - inline *;sp 2 0;wp=> /=. - conseq(:_==> (! (G1.bcol{2} \/ G1.bext{2}) => (oget PF.m{1}.[x{1}]).`1 = sa{2} - /\ build_hpath G1.mh{2} (take (i{2} + 1) p{2}) = Some (sa{2}, h{2}) - /\ (exists (f : flag), FRO.m{2}.[h{2}] = Some ((oget PF.m{1}.[x{1}]).`2, f)) - /\ F.RO.m{2}.[take (i{2} + 1) p{2}] = Some (oget PF.m{1}.[x{1}]).`1 - /\ INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} - G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} - Redo.prefixes{1}.[take (i{1} + 1) p{1} <- - ((oget PF.m{1}.[x{1}]).`1, (oget PF.m{1}.[x{1}]).`2)])); - progress;..-2:smt(getP dom_set in_fsetU1). - case ((G1.bcol{2} \/ G1.bext{2})). - + wp;conseq (_: _ ==> (G1.bcol{2} \/ G1.bext{2}))=> //;progress. - by if{1};if{2};auto;2:(swap{2} 4 -3;auto); smt w=(Block.DBlock.dunifin_ll DCapacity.dunifin_ll). - conseq(:INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} - G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} Redo.prefixes{1} - /\ (exists (f : flag), FRO.m{2}.[h{2}] = Some (sc{1}, f)) - /\ x{1} = (sa{1}, sc{1}) - /\ sa{1} = sa{2} +^ nth witness p{1} i{1} - /\ ={p, i} /\ 0 <= i{1} < size p{1} - /\ Redo.prefixes{1}.[take i{1} p{1}] = Some (sa{2}, sc{1}) - /\ build_hpath G1.mh{2} (take i{2} p{2}) = Some (sa{2}, h{2}) - /\ (if i{2} = 0 then sa{2} = b0 && h{2} = 0 - else F.RO.m{2}.[take i{2} p{2}] = Some sa{2}) - /\ (take i{1} p{1} \in dom Redo.prefixes{1}) - /\ ! (take (i{1} + 1) p{1} \in dom Redo.prefixes{1}) - /\ ! (G1.bcol{2} \/ G1.bext{2}) - /\ (x \in dom PF.m){1} = ((sa +^ nth witness p i, h) \in dom G1.mh){2} - ==>_);progress;..-3:rewrite/#. - * move:H3;rewrite H7/=;progress. - rewrite !in_dom. - pose X := sa{2} +^ nth witness p{2} i{2}. - case (H3)=> -[Hu _ _] _ _ [] /(_ X sc{1}) Hpf ^ HG1 /(_ X h{2}) Hmh _ _ _ _ _. - case: {-1}(PF.m{1}.[(X,sc{1})]) (eq_refl (PF.m{1}.[(X,sc{1})])) Hpf Hmh. - + case (G1.mh{2}.[(X, h{2})]) => //= -[ya hy] Hpf. - by rewrite -negP => /(_ ya hy) [] ????[#];rewrite H8 /= => -[<-];rewrite Hpf. - move=> [ya yc] Hpf/(_ ya yc) [hx fx hy fy [#]] Hhx Hhy ^ /HG1 [xc fx0 yc0 fy0]. - rewrite Hhx => /= [#] 2!<<-;rewrite Hhy Hpf /= => -[] !->> _;progress. print huniq. - by cut/=->>:=Hu h{2} hx(sc{1}, f)(sc{1}, fx)H8 Hhx;rewrite H11. - if{1};2:(rcondt{2}1; first by auto=>/#);1:(rcondf{2}1;first by auto=>/#);last first. - + auto;progress. - * move:H9 H10;pose sa' := sa{2} +^ nth witness p{2} i{2};move=>H9 H10. - case (H)=> -[Hu _ _] _ _ [] /(_ sa' sc{1}) Hpf ^ HG1 /(_ sa' h{2}) Hmh _ _ _ _ _. - cut:(sa', h{2}) \in dom G1.mh{2} by rewrite -H9 H10. - move:H10;rewrite!in_dom;progress. - case: {-1}(PF.m{1}.[(sa',sc{1})]) (eq_refl (PF.m{1}.[(sa',sc{1})])) Hpf Hmh=>//=. - move=> [ya yc] Hpf/(_ ya yc) [hx fx hy fy [#]] Hhx Hhy ^ /HG1 [xc fx0 yc0 fy0]. - rewrite Hhx => /= [#] 2!<<-;rewrite Hhy Hpf /= => -[] !->> _;progress. - by cut/=->>:=Hu h{2} hx(sc{1}, f)(sc{1}, fx) H0 Hhx;rewrite H14 !oget_some/=. - * cut->:=take_nth witness i{2} p{2};1:smt(size_take). - rewrite build_hpath_prefix H4/=;smt(get_oget). - * move:H9 H10;pose sa' := sa{2} +^ nth witness p{2} i{2};move=>H9 H10. - case (H)=> -[Hu _ _] _ _ [] /(_ sa' sc{1}) Hpf ^ HG1 /(_ sa' h{2}) Hmh _ _ _ _ _. - cut:(sa', h{2}) \in dom G1.mh{2} by rewrite -H9 H10. - move:H10;rewrite!in_dom;progress. - case: {-1}(PF.m{1}.[(sa',sc{1})]) (eq_refl (PF.m{1}.[(sa',sc{1})])) Hpf Hmh=>//=. - move=> [ya yc] Hpf/(_ ya yc) [hx fx hy fy [#]] Hhx Hhy ^ /HG1 [xc fx0 yc0 fy0]. - rewrite Hhx => /= [#] 2!<<-;rewrite Hhy Hpf /= => -[] !->> _;progress. - by cut/=->>:=Hu h{2} hx(sc{1}, f)(sc{1}, fx) H0 Hhx;rewrite H14 !oget_some/=Hhy/#. - * cut[] a b hab:exists a b, PF.m{1}.[(sa{2} +^ nth witness p{2} i{2}, sc{1})] = Some (a,b) by - move:H10;rewrite in_dom/#. - cut[]h1 h2 h3:=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ H. - cut->:=take_nth witness i{2} p{2};1:smt(size_take). - rewrite h2 H4/=;exists sa{2} h{2}=>/=;rewrite hab oget_some/=. - cut[]hh1 hh2:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ H. - cut[]c d e i[]hcd[]hei hG1:=hh1 _ _ _ _ hab. - cut[]hu _ _:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ H. - by cut/=<<-/#:=hu _ _ _ _ H0 hcd. - * split;..-2:case:H=>//=;progress. - split;first cut[]:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ H;smt(size_take getP size_eq0). - progress;cut[]_ h:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ H. - rewrite !getP. - move:H12;rewrite dom_set in_fsetU1. - case(l=take (i{2}+1) p{2})=>//=;last first. - + cut all_pref l_diff l_in_dom:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ H. - cut->/=:take i0 l <> take (i{2} + 1) p{2} by rewrite/#. - cut->/=/#:take (i0+1) l <> take (i{2} + 1) p{2} by rewrite/#. - move=>->>;rewrite!take_take. - cut hii0:i0 <= i{2} by move:H14;rewrite size_take /#. - rewrite!min_lel //1,2:/# nth_take 1,2:/#. - cut->/=:take i0 p{2} <> take (i{2} + 1) p{2} by smt(size_take). - case(i0=i{2})=>//=[->>|i_neq_i0]/=;1: by rewrite H3/=;smt(get_oget). - cut->/=:!take (i0 + 1) p{2} = take (i{2} + 1) p{2} by smt(size_take). - cut:=h _ H6 i0 _;1:smt(size_take). - by rewrite!take_take!min_lel 1,2:/# nth_take 1,2:/#. - rcondt{2}5;progress;1:auto;progress. - + cut[]hh1 hh2 hh3 :=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ H. - rewrite(@take_nth witness)1:/#in_dom/=. - cut:=hh2 (take i{hr} p{hr}) (nth witness p{hr} i{hr});rewrite H4/=. - cut:=H10;rewrite H9 in_dom/=. - case(F.RO.m{hr}.[rcons (take i{hr} p{hr}) (nth witness p{hr} i{hr})] = None)=>//=h. - cut[]b hb:exists b, F.RO.m{hr}.[rcons (take i{hr} p{hr}) (nth witness p{hr} i{hr})] = Some b - by move:h;case:(F.RO.m{hr}.[rcons (take i{hr} p{hr}) (nth witness p{hr} i{hr})])=>//=/#. - rewrite negb_forall/==>h2;rewrite hb/=;exists b=>//=. - rewrite negb_exists=>v/=. - rewrite negb_exists=>hx/=. - rewrite negb_exists=>hy/=. - case(sa{hr} = v)=>//=->>. - by case(h{hr} = hx)=>//=->>;rewrite h2. - swap{2}4-3;wp;progress=>/=. - conseq(:_==> hinv FRO.m{2} sc{2} = None - => y1{1} = r{2} - && build_hpath G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- - (r{2}, G1.chandle{2})] (take (i{2} + 1) p{2}) = Some (r{2}, G1.chandle{2}) - && sc{2} = y2{1} - && INV_CF_G1 FRO.m{2}.[G1.chandle{2} <- (sc{2}, Unknown)] (G1.chandle{2} + 1) - PF.m{1}.[x{1} <- (y1{1}, y2{1})] PF.mi{1}.[(y1{1}, y2{1}) <- x{1}] - G1.m{2} G1.mi{2} - G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- (r{2}, G1.chandle{2})] - G1.mhi{2}.[(r{2}, G1.chandle{2}) <- (sa{2} +^ nth witness p{2} i{2}, h{2})] - F.RO.m{2}.[take (i{2} + 1) p{2} <- r{2}] G1.paths{2} - Redo.prefixes{1}.[take (i{1} + 1) p{1} <- (y1{1}, y2{1})]);1:smt(getP oget_some). - conseq(:_==> (y1,y2){1} = (r,sc){2});-1:by sim. - move=> &1 &2[][]inv0[][]flag h_flag[]->>[]->>[][]->>->>[]Hi[]. - move=>prefixe_p_i[] hpath[]ro_p_i[];rewrite in_dom prefixe_p_i/==>[][]preifxe_p_i1. - rewrite!negb_or !in_dom/==>[][][]bcol bext h_pf_g1 h_pf b1 c1 b2 c2 []->>->> hinv_none/=. - move:preifxe_p_i1;cut->:=take_nth witness i{2} p{2};1:smt(size_take). - move=>prefixe_p_i1. - split;1:rewrite build_hpath_prefix/=. - * by exists sa{2} h{2};rewrite getP/=;apply build_hpath_up=>//=;smt(in_dom). - cut:=inv0;case. - move=>H_hs_spec H_inv_spec H_inv_spech H_m_mh H_mi_mhi H_incl_m H_incl_mi H_mh_spec H_pi_spec H_m_p h_build_hpath_rcons. - cut:hs_spec FRO.m{2}.[G1.chandle{2} <- (c2, Unknown)] (G1.chandle{2}+1) - && inv_spec G1.m{2} G1.mi{2} - && inv_spec G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- (b2, G1.chandle{2})] - G1.mhi{2}.[(b2, G1.chandle{2}) <- (sa{2} +^ nth witness p{2} i{2}, h{2})] - && m_mh FRO.m{2}.[G1.chandle{2} <- (c2, Unknown)] - PF.m{1}.[(sa{2} +^ nth witness p{2} i{2}, sc{1}) <- (b2, c2)] - G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- (b2, G1.chandle{2})] - && m_mh FRO.m{2}.[G1.chandle{2} <- (c2, Unknown)] - PF.mi{1}.[(b2, c2) <- (sa{2} +^ nth witness p{2} i{2}, sc{1})] - G1.mhi{2}.[(b2, G1.chandle{2}) <- (sa{2} +^ nth witness p{2} i{2}, h{2})] - && incl G1.m{2} PF.m{1}.[(sa{2} +^ nth witness p{2} i{2}, sc{1}) <- (b2, c2)] - && incl G1.mi{2} PF.mi{1}.[(b2, c2) <- (sa{2} +^ nth witness p{2} i{2}, sc{1})] - && pi_spec FRO.m{2}.[G1.chandle{2} <- (c2, Unknown)] - G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- (b2, G1.chandle{2})] G1.paths{2} - && mh_spec FRO.m{2}.[G1.chandle{2} <- (c2, Unknown)] G1.m{2} - G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- (b2, G1.chandle{2})] - F.RO.m{2}.[rcons (take i{2} p{2}) (nth witness p{2} i{2}) <- b2] - && m_p PF.m{1}.[(sa{2} +^ nth witness p{2} i{2}, sc{1}) <- (b2, c2)] - Redo.prefixes{1}.[rcons (take i{2} p{2}) (nth witness p{2} i{2}) <- (b2, c2)];last by progress;split=>//. - split. - + apply hs_addh;1:cut//:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ inv0. - by cut:=hinvP FRO.m{2} c2;rewrite hinv_none/=/#. - move=>H2_hs_spec;split. - + by cut:=invG_of_INV _ _ _ _ _ _ _ _ _ _ _ inv0. - move=>H2_inv_spec;split. - + apply inv_addm=>//;1:cut//:=inv_of_INV _ _ _ _ _ _ _ _ _ _ _ inv0. - - rewrite/#. - cut hj:=mi_mhi_of_INV _ _ _ _ _ _ _ _ _ _ _ inv0. - cut hs_sp:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ inv0. - apply (notin_hs_notin_dom2_mh FRO.m{2} PF.mi{1})=>//=. - by apply ch_notin_dom_hs=>//=. - move=>H2_inv_spech;split. - + cut//=:=(m_mh_addh_addm FRO.m{2} PF.m{1} G1.mh{2} h{2} (sa{2} +^ nth witness p{2} i{2}) sc{1} G1.chandle{2} b2 c2 flag Unknown _ _ _ _);rewrite//. - - by cut[]:=H_hs_spec. - by rewrite ch_notin_dom_hs. - move=>H2_m_mh;split. - + cut->//=:=(mi_mhi_addh_addmi FRO.m{2} PF.mi{1} G1.mhi{2} h{2} (sa{2} +^ nth witness p{2} i{2}) sc{1} G1.chandle{2} b2 c2 flag Unknown _ _ _ _);rewrite//. - - by cut/#:=hinvP FRO.m{2} c2. - by rewrite ch_notin_dom_hs. - move=>H2_mi_mhi;split. - + move=>x;rewrite getP/=. - by cut:=H_incl_m (sa{2} +^ nth witness p{2} i{2}, sc{1});smt(in_dom). - move=>H2_incl_m;split. - + move=>x;rewrite getP/=. - cut/#:G1.mi{2}.[(b2, c2)] = None;move=>{x}. - cut help//=:=hinvP FRO.m{2} c2. - rewrite hinv_none/= in help. - cut->//=:=notin_m_notin_Gm _ _ (b2,c2) H_incl_mi. - cut/#:forall a b, PF.mi{1}.[(b2,c2)] <> Some (a,b). - move=>a b;move:help;apply absurd=>//=;rewrite negb_forall//=. - cut[] inv1 inv2 hab:=H_mi_mhi. - by cut/#:=inv1 _ _ _ _ hab. - cut :=h_pf_g1;rewrite h_pf/=eq_sym neqF/==>h_g1. - move=>H2_incl_mi;split. print mh_spec. search pi_spec. - + (* pi_spec *) - split;progress. - - cut[]h:=H_pi_spec;cut:=h c p0 v;rewrite H/==>[][]h1[] h'1 h'2. - exists h1;rewrite -h'2 getP/=. - cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h'2. - by apply build_hpath_up=>//=. - move:H0;rewrite getP/==>hh0. - cut h0_neq_ch:h0 <> G1.chandle{2} by rewrite/#. - cut[]->:=H_pi_spec;rewrite-hh0 h0_neq_ch/=;exists h0=>/=. search build_hpath None. - cut:=H;cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) b2 p0 v h0. - rewrite h_g1/=H/=h0_neq_ch/=. - cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h_flag. - by cut->/=->//=:=ch_neq0 _ _ H_hs_spec;progress;cut[]hh1 hh2 hh3:=H_mh_spec;smt(dom_hs_neq_ch). - move=>H2_pi_spec;split. - + (* mh_spec *) - (* cut: *) - (* (forall (xa : block) (hx : handle) (ya : block) (hy : handle), *) - (* G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- (b2, G1.chandle{2})].[( *) - (* xa, hx)] = Some (ya, hy) => *) - (* exists (xc : capacity) (fx : flag) (yc : capacity) (fy : flag), *) - (* FRO.m{2}.[G1.chandle{2} <- (c2, Unknown)].[hx] = Some (xc, fx) /\ *) - (* FRO.m{2}.[G1.chandle{2} <- (c2, Unknown)].[hy] = Some (yc, fy) /\ *) - (* if fy = Known then G1.m{2}.[(xa, xc)] = Some (ya, yc) /\ fx = Known *) - (* else *) - (* exists (p1 : block list) (v : block), *) - (* F.RO.m{2}.[rcons (take i{2} p{2}) (nth witness p{2} i{2}) <- b2].[ *) - (* rcons p1 (v +^ xa)] = Some ya /\ build_hpath *) - (* G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- *) - (* (b2, G1.chandle{2})] p1 = Some (v, hx)) *) - (* && *) - (* (forall (p1 : block list) (v : block) (p2 : block list) (v' : block) (hx : handle), *) - (* build_hpath *) - (* G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- (b2, G1.chandle{2})] *) - (* p1 = Some (v, hx) => *) - (* build_hpath *) - (* G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- (b2, G1.chandle{2})] *) - (* p2 = Some (v', hx) => p1 = p2 /\ v = v') *) - (* && *) - (* (forall (p1 : block list) (bn b : block), *) - (* F.RO.m{2}.[rcons (take i{2} p{2}) (nth witness p{2} i{2}) <- b2].[rcons p1 bn] = *) - (* Some b <=> *) - (* exists (v : block) (hx hy : handle), build_hpath *) - (* G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- (b2, G1.chandle{2})] p1 = *) - (* Some (v, hx) /\ *) - (* G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- (b2, G1.chandle{2})].[(v +^ bn, hx)] = Some (b, hy)); *) - (* last by progress;split=>/#. *) - split=>//=. - - move=>x hx y hy;rewrite !getP. - case((x, hx) = (sa{2} +^ nth witness p{2} i{2}, h{2}))=>//=. - * move=>[->> ->>][<<- <<-]/=. - cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h_flag. - rewrite h_flag/=. - exists sc{1} flag c2 Unknown=>//=. - by exists (take i{2} p{2}) (sa{2})=>//=;rewrite getP Block.WRing.addKr/=;apply build_hpath_up=>//=/#. - move=> neq h1. - cut[]hh1 hh2 hh3:=H_mh_spec. - cut[]xc hxx yc hyc []h2[]h3 h4:=hh1 _ _ _ _ h1. - cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h2. - cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h3. - rewrite h2 h3/=;exists xc hxx yc hyc=>//=. - move:h4;case(hyc = Known)=>//=neq2[]p0 b[]hp0 hb. - exists p0 b;rewrite getP. - cut->/=:=build_hpath_up _ _ _ b2 G1.chandle{2} _ _ _ hb h_g1. - cut/#:!rcons p0 (b +^ x) = rcons (take i{2} p{2}) (nth witness p{2} i{2});move:neq;apply absurd=>//=h'. - cut<<-:take i{2} p{2}=p0 by rewrite/#. - cut hbex:b +^ x = nth witness p{2} i{2} by rewrite/#. - by cut:=hb;rewrite hpath/==>[][->>->>]/=;rewrite-hbex Block.WRing.addKr/=. - - progress. search build_hpath. - * move:H;rewrite getP/=. - case(p0 = (take i{2} p{2}))=>[->>|hpp0]. search build_hpath None. - + cut->/=:=build_hpath_up _ _ _ b2 G1.chandle{2} _ _ _ hpath h_g1. - case(bn = (nth witness p{2} i{2}))=>[->>/=->>|hbni]/=. - - by exists sa{2} h{2} G1.chandle{2}=>//=;rewrite getP/=. - cut->/=:!rcons (take i{2} p{2}) bn = rcons (take i{2} p{2}) (nth witness p{2} i{2}). - - move:hbni;apply absurd=>//=h. - cut->:bn = nth witness (rcons (take i{2} p{2}) bn) i{2}. - * by rewrite nth_rcons size_take /#. - by rewrite h nth_rcons size_take /#. + cut:=H8;rewrite in_dom/==>->/=h_g1. + cut H2_pi_spec:pi_spec FRO.m{2}.[G1.chandle{2} <- (y2L, Unknown)] + G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- (y1L, G1.chandle{2})] + G1.paths{2}. + + split;progress. + - cut[]h:=H_pi_spec;cut:=h c p0 v;rewrite H14/==>[][]h1[] h'1 h'2. + exists h1;rewrite -h'2 getP/=. + cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h'2. + by apply build_hpath_up=>//=. + move:H15;rewrite getP/==>hh0. + cut h0_neq_ch:h0 <> G1.chandle{2} by rewrite/#. + cut[]->:=H_pi_spec;rewrite-hh0 h0_neq_ch/=;exists h0=>/=. + cut:=H;cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) y1L p0 v h0. + rewrite h_g1/=H/=h0_neq_ch/=. + cut->//=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec H_h. + cut -> /= <-//=:=ch_neq0 _ _ H_hs_spec;progress;cut[]hh1 hh2 hh3:=H_mh_spec;smt(dom_hs_neq_ch). + split. + + apply hs_addh;1:cut//:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. + by cut:=hinvP FRO.m{2} y2L;rewrite hinv_none/=/#. + + by cut:=invG_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. + + apply inv_addm=>//;1:cut//:=inv_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. + apply (notin_hs_notin_dom2_mh FRO.m{2} PF.mi{1})=>//=. + by apply ch_notin_dom_hs;cut:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. + + cut[] H_huniq _ _:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. + apply (m_mh_addh_addm _ H_m_mh H_huniq H_h)=>//=. + by apply ch_notin_dom_hs;cut:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. + + cut[] H_huniq _ _:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. + apply (mi_mhi_addh_addmi _ H_mi_mhi _ H_h _)=>//=. + - smt(hinvP). + by apply ch_notin_dom_hs;cut:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. + + apply incl_upd_nin=>//=. + by cut:=incl_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. + + apply incl_upd_nin=>//=. + - by cut:=incli_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. + cut:=hinvP FRO.m{2} y2L;rewrite in_dom hinv_none/=;apply absurd=>H_P_mi. + rewrite negb_forall/=. + cut H_inv_Gmh:=inv_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. + cut[]H_inv_Pm:=inv_mh_inv_Pm _ _ _ _ _ H_m_mh H_mi_mhi H_inv_Gmh. + cut[]H_Pmi H_Gmhi:=mi_mhi_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. + by cut[]/#:=H_Pmi y1L y2L (oget PF.mi{1}.[(y1L, y2L)]).`1 + (oget PF.mi{1}.[(y1L, y2L)]).`2 _;1:smt(get_oget in_dom). + + cut H_take_Si:=take_nth witness i{2} p{2} _;1:rewrite/#. + split=>//=. + - move=>x hx y hy;rewrite !getP. + case((x, hx) = (sa{2} +^ nth witness p{2} i{2}, h{2}))=>//=. + * move=>[->> ->>][<<- <<-]/=. + cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec H_h. + rewrite H_h/=. + exists sc{1} f y2L Unknown=>//=. + exists (take i{2} p{2}) (sa{2})=>//=;rewrite getP Block.WRing.addKr/=. + by rewrite(@take_nth witness)1:/#/=;apply build_hpath_up=>//=;smt(in_dom). + move=> neq h1. + cut[]hh1 hh2 hh3:=H_mh_spec. + cut[]xc hxx yc hyc []h2[]h3 h4:=hh1 _ _ _ _ h1. + cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h2. + cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h3. + rewrite h2 h3/=;exists xc hxx yc hyc=>//=. + move:h4;case(hyc = Known)=>//=neq2[]p0 b[]hp0 hb. + exists p0 b;rewrite getP. + cut->/=:=build_hpath_up _ _ _ y1L G1.chandle{2} _ _ _ hb h_g1. + cut/#:!rcons p0 (b +^ x) = rcons (take i{2} p{2}) (nth witness p{2} i{2});move:neq;apply absurd=>//=h'. + cut<<-:take i{2} p{2}=p0 by rewrite/#. + cut hbex:b +^ x = nth witness p{2} i{2} by rewrite/#. + by cut:=hb;rewrite H_path/==>[][->>->>]/=;rewrite-hbex Block.WRing.addKr/=. + - progress. + * move:H14;rewrite getP/=H_take_Si/=. + case(p0 = (take i{2} p{2}))=>[->>|hpp0]. + + cut->/=:=build_hpath_up _ _ _ y1L G1.chandle{2} _ _ _ H_path h_g1. + case(bn = (nth witness p{2} i{2}))=>[->> /= ->>|hbni]/=. + - by exists sa{2} h{2} G1.chandle{2}=>//=;rewrite getP/=. + cut->/=:!rcons (take i{2} p{2}) bn = rcons (take i{2} p{2}) (nth witness p{2} i{2}). + - move:hbni;apply absurd=>//=h. + cut->:bn = nth witness (rcons (take i{2} p{2}) bn) i{2}. + * by rewrite nth_rcons size_take /#. + by rewrite h nth_rcons size_take /#. + move=>h_ro_p_bn. + cut[]_ hh4 _:=H_mh_spec. + by cut:=hh4 (take i{2} p{2}) bn b0;rewrite h_ro_p_bn/=H_path/=;smt(getP @Block.WRing). + cut->/=:!rcons p0 bn = rcons (take i{2} p{2}) (nth witness p{2} i{2}). + + move:hpp0;apply absurd=>/=h. + cut:size p0 = size (take i{2} p{2}) by smt(size_rcons). + move:h;pose p' := take i{2} p{2};pose e := nth witness p{2} i{2}. + by move=>h h';move:p0 p' h' bn e h;apply seq2_ind=>//=/#. move=>h_ro_p_bn. cut[]_ hh4 _:=H_mh_spec. - by cut:=hh4 (take i{2} p{2}) bn b;rewrite h_ro_p_bn/=hpath/=;smt(getP @Block.WRing). - cut->/=:!rcons p0 bn = rcons (take i{2} p{2}) (nth witness p{2} i{2}). - + move:hpp0;apply absurd=>/=h. - cut:size p0 = size (take i{2} p{2}) by smt(size_rcons). - move:h;pose p' := take i{2} p{2};pose e := nth witness p{2} i{2}. - by move=>h h';move:p0 p' h' bn e h;apply seq2_ind=>//=/#. - move=>h_ro_p_bn. - cut[]_ hh4 _:=H_mh_spec. - cut:=hh4 p0 bn b;rewrite h_ro_p_bn/==>[][];progress. - cut help:(sa{2} +^ nth witness p{2} i{2}, h{2}) <> (v +^ bn, hx) by rewrite/#. - exists v hx hy=>//=;rewrite getP;rewrite eq_sym in help;rewrite help/=H0/=. - by apply build_hpath_up=>//=. - move:H H0;rewrite!getP=>h_build_hpath_set. - case(hy = G1.chandle{2})=>//=[->>|hy_neq_ch]/=. - + move=>h;cut h_eq:v +^ bn = sa{2} +^ nth witness p{2} i{2} && hx = h{2}. - + cut/#:G1.mh{2}.[(v +^ bn, hx)] <> Some (b, G1.chandle{2}). search hs_spec. - cut[]_ hh2:=H_m_mh. - cut:=hh2 (v +^ bn) hx b G1.chandle{2}. - case(G1.mh{2}.[(v +^ bn, hx)] = Some (b, G1.chandle{2}))=>//=. - rewrite negb_exists/=;progress; - rewrite negb_exists/=;progress; - rewrite negb_exists/=;progress; - rewrite negb_exists/=;progress;rewrite !negb_and. - by cut[]/#:=H_hs_spec. - cut[]eq_xor ->>:=h_eq. - move:h;rewrite h_eq/==>->>. - cut/#:!(p0 = (take i{2} p{2}) /\ bn = (nth witness p{2} i{2})) => - F.RO.m{2}.[rcons p0 bn] = Some b. - move:h_flag;case:flag=>h_flag;last first. - - cut:=known_path_uniq _ _ _ sc{1} h{2} p0 v (take i{2} p{2}) sa{2} H2_pi_spec _ h_build_hpath_set _. - * rewrite getP/=h_flag. - by cut->//=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h_flag. search build_hpath. - * by apply build_hpath_up=>//=. - move=>[]->>->>/=;smt(@Block.WRing). + cut:=hh4 p0 bn b0;rewrite h_ro_p_bn/==>[][];progress. + cut help:(sa{2} +^ nth witness p{2} i{2}, h{2}) <> (v +^ bn, hx) by rewrite/#. + exists v hx hy=>//=;rewrite getP;rewrite eq_sym in help;rewrite help/=H15/=. + by apply build_hpath_up=>//=. + move:H14 H15;rewrite!getP=>h_build_hpath_set. + case(hy = G1.chandle{2})=>//=[->>|hy_neq_ch]/=. + + move=>h;cut h_eq:v +^ bn = sa{2} +^ nth witness p{2} i{2} && hx = h{2}. + + cut/#:G1.mh{2}.[(v +^ bn, hx)] <> Some (b0, G1.chandle{2}). + cut[]_ hh2:=H_m_mh. + cut:=hh2 (v +^ bn) hx b0 G1.chandle{2}. + case(G1.mh{2}.[(v +^ bn, hx)] = Some (b0, G1.chandle{2}))=>//=. + rewrite negb_exists/=;progress; + rewrite negb_exists/=;progress; + rewrite negb_exists/=;progress; + rewrite negb_exists/=;progress;rewrite !negb_and. + by cut[]/#:=H_hs_spec. + cut[]eq_xor ->>:=h_eq. + move:h;rewrite h_eq/==>->>. + cut/#:!(p0 = (take i{2} p{2}) /\ bn = (nth witness p{2} i{2})) => + F.RO.m{2}.[rcons p0 bn] = Some b0. + move:H_h;case:f=>h_flag;last first. + - cut:=known_path_uniq _ _ _ sc{1} h{2} p0 v (take i{2} p{2}) sa{2} H2_pi_spec _ h_build_hpath_set _. + * rewrite getP/=h_flag. + by cut->//=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h_flag. + * by apply build_hpath_up=>//=. + move=>[]->>->>/=;apply absurd=>//=_. + cut->:bn = sa{2} +^ sa{2} +^ bn;smt(@Block). + cut[]hh1 hh2 hh3:=H_mh_spec. + cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) b0 p0 v h{2}. + rewrite h_build_hpath_set/=h_g1/=. + cut->/=:=ch_neq0 _ _ H_hs_spec. + cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h_flag. + move=>help;cut:= help _;1:smt(dom_hs_neq_ch). + move=>h_build_hpath_p0. + rewrite hh2 h_build_hpath_p0/==>h_neq. + exists v h{2}=>//=. + rewrite eq_xor h_g1/=;move:h_neq;apply absurd=>//=. + cut:=hh3 _ _ _ _ _ H_path h_build_hpath_p0. + cut->:bn = sa{2} +^ sa{2} +^ bn;smt(@Block). + move=>help;cut h_neq:! (v +^ bn = sa{2} +^ nth witness p{2} i{2} && hx = h{2}) by rewrite/#. + move:help;rewrite h_neq/==>h_g1_v_bn_hx. cut[]hh1 hh2 hh3:=H_mh_spec. - cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) b p0 v h{2}. + cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) y1L p0 v hx. rewrite h_build_hpath_set/=h_g1/=. cut->/=:=ch_neq0 _ _ H_hs_spec. - cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h_flag. - move=>help;cut:= help _;1:smt(dom_hs_neq_ch). - move=>h_build_hpath_p0. - rewrite hh2 h_build_hpath_p0/==>h_neq. - exists v h{2}=>//=. - rewrite eq_xor h_g1/=;move:h_neq;apply absurd=>//=. - by cut:=hh3 _ _ _ _ _ hpath h_build_hpath_p0;smt(@Block.WRing). - move=>help;cut h_neq:! (v +^ bn = sa{2} +^ nth witness p{2} i{2} && hx = h{2}) by rewrite/#. - move:help;rewrite h_neq/==>h_g1_v_bn_hx. - cut[]hh1 hh2 hh3:=H_mh_spec. - cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) b2 p0 v hx. - rewrite h_build_hpath_set/=h_g1/=. - cut->/=:=ch_neq0 _ _ H_hs_spec. - by cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h_flag;smt(dom_hs_neq_ch). - progress. - + cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) b2 p0 v hx. - cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) b2 p' v' hx. - rewrite H H0/=. + by cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec H_h;smt(dom_hs_neq_ch). + progress. + + cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) y1L p0 v hx. + cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) y1L p' v' hx. + rewrite H14 H15/=. + cut->/=:=ch_neq0 _ _ H_hs_spec. + cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec H_h. + rewrite h_g1/=. + by cut[]:=H_mh_spec;smt(dom_hs_neq_ch). + cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) y1L p0 v hx. + cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) y1L p' v' hx. + rewrite H14 H15/=. cut->/=:=ch_neq0 _ _ H_hs_spec. - cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h_flag. + cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec H_h. rewrite h_g1/=. by cut[]:=H_mh_spec;smt(dom_hs_neq_ch). - cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) b2 p0 v hx. - cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) b2 p' v' hx. - rewrite H H0/=. - cut->/=:=ch_neq0 _ _ H_hs_spec. - cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h_flag. - rewrite h_g1/=. - by cut[]:=H_mh_spec;smt(dom_hs_neq_ch). - move=>H2_mh_spec;split;progress. - + by cut[]:=H_m_p;smt(getP size_rcons size_eq0 size_ge0). - move:H;rewrite dom_set in_fsetU1. - case(l \in dom Redo.prefixes{1})=>//=hdom. - + cut[]_ h:=H_m_p. - cut[]sa' sc'[]h_pref h_pref2:=h _ hdom i0 _;1:rewrite/#. - exists sa' sc';rewrite!getP/=. - cut->/=:!take i0 l = rcons (take i{2} p{2}) (nth witness p{2} i{2}) by smt(in_dom). - rewrite h_pref/=. - cut->/=:!take (i0 + 1) l = rcons (take i{2} p{2}) (nth witness p{2} i{2}) by smt(in_dom take_size). - rewrite-h_pref2/=. - by cut->/=:! (sa' +^ nth witness l i0 = sa{2} +^ nth witness p{2} i{2} && sc' = sc{1}) by smt(in_dom take_size). - move=>->>;case(i0=i{2})=>[->>|i0_neq_i]//=. - + exists sa{2} sc{1}=>//=;rewrite!getP/=. - move:H1;rewrite !size_rcons !size_take//. - rewrite!nth_rcons-take_nth// !take_take!size_take 1:/#. - cut->/=hii:i{2}< size p{2} by rewrite/#. - rewrite !min_lel 1,2:/#. - by cut->/=:! take i{2} p{2} = take (i{2} + 1) p{2} by smt(size_take). - move:H1;rewrite !size_rcons !size_take//1:/#. - rewrite!nth_rcons-take_nth// !take_take!size_take 1:/#. - cut->/=hii:i{2}< size p{2} by rewrite/#. - rewrite i0_neq_i/=!min_lel 1,2:/#. - cut->/=:i0 < i{2} by rewrite/#. - rewrite!getP. - cut->/=:! take i0 p{2} = take (i{2} + 1) p{2} by smt(size_take). - cut[]_ h_pref:=H_m_p. - cut[]:= h_pref (take i{2} p{2}) _ i0 _;1:smt(in_dom);1:smt(size_take). - move=>b3 c3;rewrite!take_take!min_lel 1,2:/#=>[][]-> h. - cut->/=:!take (i0 + 1) p{2} = take (i{2} + 1) p{2} by smt(size_take). - exists b3 c3=>//=;rewrite getP/=. - cut/#:!(b3 +^ nth witness (take i{2} p{2}) i0 = sa{2} +^ nth witness p{2} i{2} && - c3 = sc{1}). - cut:(b3 +^ nth witness (take i{2} p{2}) i0, c3) \in dom PF.m{1};2:smt(in_dom). - cut:take (i0 + 1) p{2} \in dom Redo.prefixes{1};2:smt(in_dom). - cut->:take (i0 + 1) p{2} = take (i0 + 1) (take i{2} p{2});1:smt(take_take). - smt(in_dom take_oversize). -qed. + + exact H2_pi_spec. + + move=>l;rewrite dom_set in_fsetU1. + case(l \in dom F.RO.m{2})=>/=[H_dom i|H_not_dom ->> j]. + + by rewrite in_fsetU1;left;case:HINV=>/#. + cut H_pref:=all_prefixes_fset_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. + case(0 <= j)=>Hj0;last first. + + rewrite + case(l \in dom Redo.prefixes{1})=>//=hdom. + + cut[]_ h:=H_m_p. + cut[]sa' sc'[]h_pref h_pref2:=h _ hdom i0 _;1:rewrite/#. + exists sa' sc';rewrite!getP/=. + cut->/=:!take i0 l = rcons (take i{2} p{2}) (nth witness p{2} i{2}) by smt(in_dom). + rewrite h_pref/=. + cut->/=:!take (i0 + 1) l = rcons (take i{2} p{2}) (nth witness p{2} i{2}) by smt(in_dom take_size). + rewrite-h_pref2/=. + by cut->/=:! (sa' +^ nth witness l i0 = sa{2} +^ nth witness p{2} i{2} && sc' = sc{1}) by smt(in_dom take_size). + move=>->>;case(i0=i{2})=>[->>|i0_neq_i]//=. + + exists sa{2} sc{1}=>//=;rewrite!getP/=. + move:H1;rewrite !size_rcons !size_take//. + rewrite!nth_rcons-take_nth// !take_take!size_take 1:/#. + cut->/=hii:i{2}< size p{2} by rewrite/#. + rewrite !min_lel 1,2:/#. + by cut->/=:! take i{2} p{2} = take (i{2} + 1) p{2} by smt(size_take). + move:H1;rewrite !size_rcons !size_take//1:/#. + rewrite!nth_rcons-take_nth// !take_take!size_take 1:/#. + cut->/=hii:i{2}< size p{2} by rewrite/#. + rewrite i0_neq_i/=!min_lel 1,2:/#. + cut->/=:i0 < i{2} by rewrite/#. + rewrite!getP. + cut->/=:! take i0 p{2} = take (i{2} + 1) p{2} by smt(size_take). + cut[]_ h_pref:=H_m_p. + cut[]:= h_pref (take i{2} p{2}) _ i0 _;1:smt(in_dom);1:smt(size_take). + move=>b3 c3;rewrite!take_take!min_lel 1,2:/#=>[][]-> h. + cut->/=:!take (i0 + 1) p{2} = take (i{2} + 1) p{2} by smt(size_take). + exists b3 c3=>//=;rewrite getP/=. + cut/#:!(b3 +^ nth witness (take i{2} p{2}) i0 = sa{2} +^ nth witness p{2} i{2} && + c3 = sc{1}). + cut:(b3 +^ nth witness (take i{2} p{2}) i0, c3) \in dom PF.m{1};2:smt(in_dom). + cut:take (i0 + 1) p{2} \in dom Redo.prefixes{1};2:smt(in_dom). + cut->:take (i0 + 1) p{2} = take (i0 + 1) (take i{2} p{2});1:smt(take_take). + smt(in_dom take_oversize). + - split. + + search hs_spec 0. + smt(getP). + * rewrite/#. + * by rewrite!getP/=!oget_some. + * by rewrite !getP/=oget_some/#. + * rewrite!getP/=!oget_some/=(@take_nth witness)1:/# build_hpath_prefix/=. + cut[]HINV[]H_nil_in_dom[]->>[][]f H_h[]H_path H_F_RO:=H3 H6. + cut:=H8;rewrite in_dom/==>H_none. + cut:=lemma5' _ _ _ _ _ _ _ _ _ _ _ i{2} p{2} sa{2} sc{1} h{2} HINV _ _ _ _. + * rewrite/#. + * rewrite/#. + * rewrite/#. + * rewrite/#. + rewrite H_none/==>H_Gmh_none. + by cut->/=:=build_hpath_up G1.mh{2} _ _ y1L G1.chandle{2} _ _ _ H_path H_Gmh_none;smt(getP). + * rewrite/#. + * rewrite/#. + * by rewrite!getP/=!oget_some/=. + qed. + +(* * rewrite/#. *) +(* * rewrite/#. *) +(* * by rewrite !getP/=. *) +(* * by rewrite dom_set in_fsetU1/=. *) +(* * rewrite!getP/=!oget_some/=. *) +(* * admit. *) +(* * rewrite/#. *) +(* * rewrite!getP/=. *) +(* * rewrite/#. *) +(* * rewrite/#. *) +(* * rewrite/#. *) +(* * rewrite/#. *) +(* * rewrite/#. *) +(* * rewrite/#. *) +(* * rewrite/#. *) +(* * rewrite/#. *) +(* * rewrite/#. *) + + +(* rcondf{1}1;1:auto;progress. *) +(* - cut[][]HINV[]->>[]H_inv_prefixe[][]f H_flag[]H_path H_prefixe[]H_val[]H_pref_exists H_F_RO:=H6 H9. *) +(* cut[]hh0 hh1 hh2 hh3:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. search prefixe get_max_prefixe. *) +(* cut h_pref_exchange:=prefixe_exchange_prefixe_inv (elems (dom C.queries{m})) (elems (dom Redo.prefixes{hr})) p{m} _ _ _. *) +(* * move=>l2;rewrite-!memE=>H_dom;smt(in_dom). *) +(* * move=>l2;rewrite-!memE=>H_dom j;rewrite -memE. *) +(* case(0 <= j)=>hj0;last first. *) +(* + by rewrite take_le0 1:/#in_dom hh0. *) +(* case(j < size l2)=>hjsize;last first. *) +(* + by rewrite take_oversize 1:/#;smt(in_dom). *) +(* smt(in_dom). *) +(* * smt(memE). *) +(* by rewrite memE;apply prefixe_lt_size=>/#. *) +(* inline *;sp 2 0;wp=> /=. *) +(* conseq(: ={glob C, p, i} *) +(* /\ sa{1} = sa{2} +^ nth witness p{1} i{1} *) +(* /\ x{1} = (sa{1}, sc{1}) *) +(* /\ 0 <= i{2} < size p{2} *) +(* /\ Redo.prefixes{1}.[take i{1} p{1}] = Some (sa{2}, sc{1}) *) +(* /\ (take i{1} p{1} \in dom Redo.prefixes{1}) *) +(* /\ prefixe p{2} (get_max_prefixe p{2} (elems (dom C.queries{2}))) <= i{2} *) +(* /\ 0 <= counter{2} <= i{2} - *) +(* prefixe p{2} (get_max_prefixe p{2} (elems (dom C.queries{2}))) *) +(* /\ INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} *) +(* G1.mi{2} G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} *) +(* Redo.prefixes{1} C.queries{1} *) +(* /\ inv_prefixe_block C.queries{2} F.RO.m{2} *) +(* /\ (exists (f : flag), FRO.m{2}.[h{2}] = Some (sc{1}, f)) *) +(* /\ build_hpath G1.mh{2} (take i{2} p{2}) = Some (sa{2}, h{2}) *) +(* /\ (forall (j : int), 0 < j <= i{2} => take j p{2} \in dom F.RO.m{2}) *) +(* /\ (forall (l : block list), l \in dom Redo.prefixes{1} => *) +(* exists (l2 : block list), *) +(* l ++ l2 = p{2} \/ (l ++ l2 \in dom C.queries{1})) *) +(* /\ (if i{2} = 0 then sa{2} = b0 && h{2} = 0 *) +(* else F.RO.m{2}.[take i{2} p{2}] = Some sa{2}) *) +(* /\ ! (G1.bcol{2} \/ G1.bext{2}) *) +(* /\ (x \in dom PF.m){1} = ((sa +^ nth witness p i, h) \in dom G1.mh){2} ==>_); *) +(* progress;..-3:rewrite/#. *) +(* - move:H6;rewrite H9/=;progress. *) +(* rewrite !in_dom. *) +(* pose X := sa{2} +^ nth witness p{2} i{2}. *) +(* case (H6)=> -[Hu _ _] _ _ [] /(_ X sc{1}) Hpf ^ HG1 /(_ X h{2}) Hmh _ _ _ _ _. *) +(* case: {-1}(PF.m{1}.[(X,sc{1})]) (eq_refl (PF.m{1}.[(X,sc{1})])) Hpf Hmh. *) +(* + case (G1.mh{2}.[(X, h{2})]) => //= -[ya hy] Hpf. *) +(* by rewrite -negP => /(_ ya hy) [] ????[#];rewrite H11 /= => -[<-];rewrite Hpf. *) +(* move=> [ya yc] Hpf/(_ ya yc) [hx fx hy fy [#]] Hhx Hhy ^ /HG1 [xc fx0 yc0 fy0]. *) +(* rewrite Hhx => /= [#] 2!<<-;rewrite Hhy Hpf /= => -[] !->> _;progress. *) +(* by cut/=->>/#:=Hu h{2} hx(sc{1}, f)(sc{1}, fx)H11 Hhx. *) +(* if{1};2:(rcondt{2}1; first by auto=>/#);1:(rcondf{2}1;first by auto=>/#);last first. *) +(* + auto;progress. *) +(* * rewrite/#. *) +(* * rewrite/#. *) +(* * by rewrite!getP/=. *) +(* * smt(dom_set in_fsetU1). *) +(* * smt(dom_set in_fsetU1). *) +(* * smt(dom_set in_fsetU1). *) +(* * move:H9 H10;pose sa' := sa{2} +^ nth witness p{2} i{2};move=>H9 H10. *) +(* case (H6)=> -[Hu _ _] _ _ [] /(_ sa' sc{1}) Hpf ^ HG1 /(_ sa' h{2}) Hmh _ _ _ _ _. *) +(* cut:(sa', h{2}) \in dom G1.mh{2} by rewrite -H14 H15. *) +(* move:H10;rewrite!in_dom;progress. *) +(* case: {-1}(PF.m{1}.[(sa',sc{1})]) (eq_refl (PF.m{1}.[(sa',sc{1})])) Hpf Hmh=>//=. *) +(* move=> [ya yc] Hpf/(_ ya yc) [hx fx hy fy [#]] Hhx Hhy ^ /HG1 [xc fx0 yc0 fy0]. *) +(* rewrite Hhx => /= [#] 2!<<-;rewrite Hhy Hpf /= => -[] !->> _;progress. *) +(* by cut/=->>:=Hu h{2} hx(sc{1}, f)(sc{1}, fx) H0 Hhx;rewrite H14 !oget_some/=. *) +(* * cut->:=take_nth witness i{2} p{2};1:smt(size_take). *) +(* rewrite build_hpath_prefix H4/=;smt(get_oget). *) +(* * move:H9 H10;pose sa' := sa{2} +^ nth witness p{2} i{2};move=>H9 H10. *) +(* case (H)=> -[Hu _ _] _ _ [] /(_ sa' sc{1}) Hpf ^ HG1 /(_ sa' h{2}) Hmh _ _ _ _ _. *) +(* cut:(sa', h{2}) \in dom G1.mh{2} by rewrite -H9 H10. *) +(* move:H10;rewrite!in_dom;progress. *) +(* case: {-1}(PF.m{1}.[(sa',sc{1})]) (eq_refl (PF.m{1}.[(sa',sc{1})])) Hpf Hmh=>//=. *) +(* move=> [ya yc] Hpf/(_ ya yc) [hx fx hy fy [#]] Hhx Hhy ^ /HG1 [xc fx0 yc0 fy0]. *) +(* rewrite Hhx => /= [#] 2!<<-;rewrite Hhy Hpf /= => -[] !->> _;progress. *) +(* by cut/=->>:=Hu h{2} hx(sc{1}, f)(sc{1}, fx) H0 Hhx;rewrite H14 !oget_some/=Hhy/#. *) +(* * cut[] a b hab:exists a b, PF.m{1}.[(sa{2} +^ nth witness p{2} i{2}, sc{1})] = Some (a,b) by *) +(* move:H10;rewrite in_dom/#. *) +(* cut[]h1 h2 h3:=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ H. *) +(* cut->:=take_nth witness i{2} p{2};1:smt(size_take). *) +(* rewrite h2 H4/=;exists sa{2} h{2}=>/=;rewrite hab oget_some/=. *) +(* cut[]hh1 hh2:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ H. *) +(* cut[]c d e i[]hcd[]hei hG1:=hh1 _ _ _ _ hab. *) +(* cut[]hu _ _:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ H. *) +(* by cut/=<<-/#:=hu _ _ _ _ H0 hcd. *) +(* * split;..-2:case:H=>//=;progress. *) +(* split;first cut[]:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ H;smt(size_take getP size_eq0). *) +(* progress;cut[]_ h:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ H. *) +(* rewrite !getP. *) +(* move:H12;rewrite dom_set in_fsetU1. *) +(* case(l=take (i{2}+1) p{2})=>//=;last first. *) +(* + cut all_pref l_diff l_in_dom:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ H. *) +(* cut->/=:take i0 l <> take (i{2} + 1) p{2} by rewrite/#. *) +(* cut->/=/#:take (i0+1) l <> take (i{2} + 1) p{2} by rewrite/#. *) +(* move=>->>;rewrite!take_take. *) +(* cut hii0:i0 <= i{2} by move:H14;rewrite size_take /#. *) +(* rewrite!min_lel //1,2:/# nth_take 1,2:/#. *) +(* cut->/=:take i0 p{2} <> take (i{2} + 1) p{2} by smt(size_take). *) +(* case(i0=i{2})=>//=[->>|i_neq_i0]/=;1: by rewrite H3/=;smt(get_oget). *) +(* cut->/=:!take (i0 + 1) p{2} = take (i{2} + 1) p{2} by smt(size_take). *) +(* cut:=h _ H6 i0 _;1:smt(size_take). *) +(* by rewrite!take_take!min_lel 1,2:/# nth_take 1,2:/#. *) +(* rcondt{2}5;progress;1:auto;progress. *) +(* + cut[]hh1 hh2 hh3 :=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ H. *) +(* rewrite(@take_nth witness)1:/#in_dom/=. *) +(* cut:=hh2 (take i{hr} p{hr}) (nth witness p{hr} i{hr});rewrite H4/=. *) +(* cut:=H10;rewrite H9 in_dom/=. *) +(* case(F.RO.m{hr}.[rcons (take i{hr} p{hr}) (nth witness p{hr} i{hr})] = None)=>//=h. *) +(* cut[]b hb:exists b, F.RO.m{hr}.[rcons (take i{hr} p{hr}) (nth witness p{hr} i{hr})] = Some b *) +(* by move:h;case:(F.RO.m{hr}.[rcons (take i{hr} p{hr}) (nth witness p{hr} i{hr})])=>//=/#. *) +(* rewrite negb_forall/==>h2;rewrite hb/=;exists b=>//=. *) +(* rewrite negb_exists=>v/=. *) +(* rewrite negb_exists=>hx/=. *) +(* rewrite negb_exists=>hy/=. *) +(* case(sa{hr} = v)=>//=->>. *) +(* by case(h{hr} = hx)=>//=->>;rewrite h2. *) +(* swap{2}4-3;wp;progress=>/=. *) +(* conseq(:_==> hinv FRO.m{2} sc{2} = None *) +(* => y1{1} = r{2} *) +(* && build_hpath G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- *) +(* (r{2}, G1.chandle{2})] (take (i{2} + 1) p{2}) = Some (r{2}, G1.chandle{2}) *) +(* && sc{2} = y2{1} *) +(* && INV_CF_G1 FRO.m{2}.[G1.chandle{2} <- (sc{2}, Unknown)] (G1.chandle{2} + 1) *) +(* PF.m{1}.[x{1} <- (y1{1}, y2{1})] PF.mi{1}.[(y1{1}, y2{1}) <- x{1}] *) +(* G1.m{2} G1.mi{2} *) +(* G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- (r{2}, G1.chandle{2})] *) +(* G1.mhi{2}.[(r{2}, G1.chandle{2}) <- (sa{2} +^ nth witness p{2} i{2}, h{2})] *) +(* F.RO.m{2}.[take (i{2} + 1) p{2} <- r{2}] G1.paths{2} *) +(* Redo.prefixes{1}.[take (i{1} + 1) p{1} <- (y1{1}, y2{1})]);1:smt(getP oget_some). *) +(* conseq(:_==> (y1,y2){1} = (r,sc){2});-1:by sim. *) +(* move=> &1 &2[][]inv0[][]flag h_flag[]->>[]->>[][]->>->>[]Hi[]. *) +(* move=>prefixe_p_i[] hpath[]ro_p_i[];rewrite in_dom prefixe_p_i/==>[][]preifxe_p_i1. *) +(* rewrite!negb_or !in_dom/==>[][][]bcol bext h_pf_g1 h_pf b1 c1 b2 c2 []->>->> hinv_none/=. *) +(* move:preifxe_p_i1;cut->:=take_nth witness i{2} p{2};1:smt(size_take). *) +(* move=>prefixe_p_i1. *) +(* split;1:rewrite build_hpath_prefix/=. *) +(* * by exists sa{2} h{2};rewrite getP/=;apply build_hpath_up=>//=;smt(in_dom). *) +(* cut:=inv0;case. *) +(* move=>H_hs_spec H_inv_spec H_inv_spech H_m_mh H_mi_mhi H_incl_m H_incl_mi H_mh_spec H_pi_spec H_m_p h_build_hpath_rcons. *) +(* cut:hs_spec FRO.m{2}.[G1.chandle{2} <- (c2, Unknown)] (G1.chandle{2}+1) *) +(* && inv_spec G1.m{2} G1.mi{2} *) +(* && inv_spec G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- (b2, G1.chandle{2})] *) +(* G1.mhi{2}.[(b2, G1.chandle{2}) <- (sa{2} +^ nth witness p{2} i{2}, h{2})] *) +(* && m_mh FRO.m{2}.[G1.chandle{2} <- (c2, Unknown)] *) +(* PF.m{1}.[(sa{2} +^ nth witness p{2} i{2}, sc{1}) <- (b2, c2)] *) +(* G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- (b2, G1.chandle{2})] *) +(* && m_mh FRO.m{2}.[G1.chandle{2} <- (c2, Unknown)] *) +(* PF.mi{1}.[(b2, c2) <- (sa{2} +^ nth witness p{2} i{2}, sc{1})] *) +(* G1.mhi{2}.[(b2, G1.chandle{2}) <- (sa{2} +^ nth witness p{2} i{2}, h{2})] *) +(* && incl G1.m{2} PF.m{1}.[(sa{2} +^ nth witness p{2} i{2}, sc{1}) <- (b2, c2)] *) +(* && incl G1.mi{2} PF.mi{1}.[(b2, c2) <- (sa{2} +^ nth witness p{2} i{2}, sc{1})] *) +(* && pi_spec FRO.m{2}.[G1.chandle{2} <- (c2, Unknown)] *) +(* G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- (b2, G1.chandle{2})] G1.paths{2} *) +(* && mh_spec FRO.m{2}.[G1.chandle{2} <- (c2, Unknown)] G1.m{2} *) +(* G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- (b2, G1.chandle{2})] *) +(* F.RO.m{2}.[rcons (take i{2} p{2}) (nth witness p{2} i{2}) <- b2] *) +(* && m_p PF.m{1}.[(sa{2} +^ nth witness p{2} i{2}, sc{1}) <- (b2, c2)] *) +(* Redo.prefixes{1}.[rcons (take i{2} p{2}) (nth witness p{2} i{2}) <- (b2, c2)];last by progress;split=>//. *) +(* split. *) +(* + apply hs_addh;1:cut//:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ inv0. *) +(* by cut:=hinvP FRO.m{2} c2;rewrite hinv_none/=/#. *) +(* move=>H2_hs_spec;split. *) +(* + by cut:=invG_of_INV _ _ _ _ _ _ _ _ _ _ _ inv0. *) +(* move=>H2_inv_spec;split. *) +(* + apply inv_addm=>//;1:cut//:=inv_of_INV _ _ _ _ _ _ _ _ _ _ _ inv0. *) +(* - rewrite/#. *) +(* cut hj:=mi_mhi_of_INV _ _ _ _ _ _ _ _ _ _ _ inv0. *) +(* cut hs_sp:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ inv0. *) +(* apply (notin_hs_notin_dom2_mh FRO.m{2} PF.mi{1})=>//=. *) +(* by apply ch_notin_dom_hs=>//=. *) +(* move=>H2_inv_spech;split. *) +(* + cut//=:=(m_mh_addh_addm FRO.m{2} PF.m{1} G1.mh{2} h{2} (sa{2} +^ nth witness p{2} i{2}) sc{1} G1.chandle{2} b2 c2 flag Unknown _ _ _ _);rewrite//. *) +(* - by cut[]:=H_hs_spec. *) +(* by rewrite ch_notin_dom_hs. *) +(* move=>H2_m_mh;split. *) +(* + cut->//=:=(mi_mhi_addh_addmi FRO.m{2} PF.mi{1} G1.mhi{2} h{2} (sa{2} +^ nth witness p{2} i{2}) sc{1} G1.chandle{2} b2 c2 flag Unknown _ _ _ _);rewrite//. *) +(* - by cut/#:=hinvP FRO.m{2} c2. *) +(* by rewrite ch_notin_dom_hs. *) +(* move=>H2_mi_mhi;split. *) +(* + move=>x;rewrite getP/=. *) +(* by cut:=H_incl_m (sa{2} +^ nth witness p{2} i{2}, sc{1});smt(in_dom). *) +(* move=>H2_incl_m;split. *) +(* + move=>x;rewrite getP/=. *) +(* cut/#:G1.mi{2}.[(b2, c2)] = None;move=>{x}. *) +(* cut help//=:=hinvP FRO.m{2} c2. *) +(* rewrite hinv_none/= in help. *) +(* cut->//=:=notin_m_notin_Gm _ _ (b2,c2) H_incl_mi. *) +(* cut/#:forall a b, PF.mi{1}.[(b2,c2)] <> Some (a,b). *) +(* move=>a b;move:help;apply absurd=>//=;rewrite negb_forall//=. *) +(* cut[] inv1 inv2 hab:=H_mi_mhi. *) +(* by cut/#:=inv1 _ _ _ _ hab. *) +(* cut :=h_pf_g1;rewrite h_pf/=eq_sym neqF/==>h_g1. *) +(* move=>H2_incl_mi;split. print mh_spec. search pi_spec. *) +(* + (* pi_spec *) *) +(* split;progress. *) +(* - cut[]h:=H_pi_spec;cut:=h c p0 v;rewrite H/==>[][]h1[] h'1 h'2. *) +(* exists h1;rewrite -h'2 getP/=. *) +(* cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h'2. *) +(* by apply build_hpath_up=>//=. *) +(* move:H0;rewrite getP/==>hh0. *) +(* cut h0_neq_ch:h0 <> G1.chandle{2} by rewrite/#. *) +(* cut[]->:=H_pi_spec;rewrite-hh0 h0_neq_ch/=;exists h0=>/=. search build_hpath None. *) +(* cut:=H;cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) b2 p0 v h0. *) +(* rewrite h_g1/=H/=h0_neq_ch/=. *) +(* cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h_flag. *) +(* by cut->/=->//=:=ch_neq0 _ _ H_hs_spec;progress;cut[]hh1 hh2 hh3:=H_mh_spec;smt(dom_hs_neq_ch). *) +(* move=>H2_pi_spec;split. *) +(* + (* mh_spec *) *) +(* (* cut: *) *) +(* (* (forall (xa : block) (hx : handle) (ya : block) (hy : handle), *) *) +(* (* G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- (b2, G1.chandle{2})].[( *) *) +(* (* xa, hx)] = Some (ya, hy) => *) *) +(* (* exists (xc : capacity) (fx : flag) (yc : capacity) (fy : flag), *) *) +(* (* FRO.m{2}.[G1.chandle{2} <- (c2, Unknown)].[hx] = Some (xc, fx) /\ *) *) +(* (* FRO.m{2}.[G1.chandle{2} <- (c2, Unknown)].[hy] = Some (yc, fy) /\ *) *) +(* (* if fy = Known then G1.m{2}.[(xa, xc)] = Some (ya, yc) /\ fx = Known *) *) +(* (* else *) *) +(* (* exists (p1 : block list) (v : block), *) *) +(* (* F.RO.m{2}.[rcons (take i{2} p{2}) (nth witness p{2} i{2}) <- b2].[ *) *) +(* (* rcons p1 (v +^ xa)] = Some ya /\ build_hpath *) *) +(* (* G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- *) *) +(* (* (b2, G1.chandle{2})] p1 = Some (v, hx)) *) *) +(* (* && *) *) +(* (* (forall (p1 : block list) (v : block) (p2 : block list) (v' : block) (hx : handle), *) *) +(* (* build_hpath *) *) +(* (* G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- (b2, G1.chandle{2})] *) *) +(* (* p1 = Some (v, hx) => *) *) +(* (* build_hpath *) *) +(* (* G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- (b2, G1.chandle{2})] *) *) +(* (* p2 = Some (v', hx) => p1 = p2 /\ v = v') *) *) +(* (* && *) *) +(* (* (forall (p1 : block list) (bn b : block), *) *) +(* (* F.RO.m{2}.[rcons (take i{2} p{2}) (nth witness p{2} i{2}) <- b2].[rcons p1 bn] = *) *) +(* (* Some b <=> *) *) +(* (* exists (v : block) (hx hy : handle), build_hpath *) *) +(* (* G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- (b2, G1.chandle{2})] p1 = *) *) +(* (* Some (v, hx) /\ *) *) +(* (* G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- (b2, G1.chandle{2})].[(v +^ bn, hx)] = Some (b, hy)); *) *) +(* (* last by progress;split=>/#. *) *) +(* split=>//=. *) +(* - move=>x hx y hy;rewrite !getP. *) +(* case((x, hx) = (sa{2} +^ nth witness p{2} i{2}, h{2}))=>//=. *) +(* * move=>[->> ->>][<<- <<-]/=. *) +(* cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h_flag. *) +(* rewrite h_flag/=. *) +(* exists sc{1} flag c2 Unknown=>//=. *) +(* by exists (take i{2} p{2}) (sa{2})=>//=;rewrite getP Block.WRing.addKr/=;apply build_hpath_up=>//=/#. *) +(* move=> neq h1. *) +(* cut[]hh1 hh2 hh3:=H_mh_spec. *) +(* cut[]xc hxx yc hyc []h2[]h3 h4:=hh1 _ _ _ _ h1. *) +(* cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h2. *) +(* cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h3. *) +(* rewrite h2 h3/=;exists xc hxx yc hyc=>//=. *) +(* move:h4;case(hyc = Known)=>//=neq2[]p0 b[]hp0 hb. *) +(* exists p0 b;rewrite getP. *) +(* cut->/=:=build_hpath_up _ _ _ b2 G1.chandle{2} _ _ _ hb h_g1. *) +(* cut/#:!rcons p0 (b +^ x) = rcons (take i{2} p{2}) (nth witness p{2} i{2});move:neq;apply absurd=>//=h'. *) +(* cut<<-:take i{2} p{2}=p0 by rewrite/#. *) +(* cut hbex:b +^ x = nth witness p{2} i{2} by rewrite/#. *) +(* by cut:=hb;rewrite hpath/==>[][->>->>]/=;rewrite-hbex Block.WRing.addKr/=. *) +(* - progress. search build_hpath. *) +(* * move:H;rewrite getP/=. *) +(* case(p0 = (take i{2} p{2}))=>[->>|hpp0]. search build_hpath None. *) +(* + cut->/=:=build_hpath_up _ _ _ b2 G1.chandle{2} _ _ _ hpath h_g1. *) +(* case(bn = (nth witness p{2} i{2}))=>[->>/=->>|hbni]/=. *) +(* - by exists sa{2} h{2} G1.chandle{2}=>//=;rewrite getP/=. *) +(* cut->/=:!rcons (take i{2} p{2}) bn = rcons (take i{2} p{2}) (nth witness p{2} i{2}). *) +(* - move:hbni;apply absurd=>//=h. *) +(* cut->:bn = nth witness (rcons (take i{2} p{2}) bn) i{2}. *) +(* * by rewrite nth_rcons size_take /#. *) +(* by rewrite h nth_rcons size_take /#. *) +(* move=>h_ro_p_bn. *) +(* cut[]_ hh4 _:=H_mh_spec. *) +(* by cut:=hh4 (take i{2} p{2}) bn b;rewrite h_ro_p_bn/=hpath/=;smt(getP @Block.WRing). *) +(* cut->/=:!rcons p0 bn = rcons (take i{2} p{2}) (nth witness p{2} i{2}). *) +(* + move:hpp0;apply absurd=>/=h. *) +(* cut:size p0 = size (take i{2} p{2}) by smt(size_rcons). *) +(* move:h;pose p' := take i{2} p{2};pose e := nth witness p{2} i{2}. *) +(* by move=>h h';move:p0 p' h' bn e h;apply seq2_ind=>//=/#. *) +(* move=>h_ro_p_bn. *) +(* cut[]_ hh4 _:=H_mh_spec. *) +(* cut:=hh4 p0 bn b;rewrite h_ro_p_bn/==>[][];progress. *) +(* cut help:(sa{2} +^ nth witness p{2} i{2}, h{2}) <> (v +^ bn, hx) by rewrite/#. *) +(* exists v hx hy=>//=;rewrite getP;rewrite eq_sym in help;rewrite help/=H0/=. *) +(* by apply build_hpath_up=>//=. *) +(* move:H H0;rewrite!getP=>h_build_hpath_set. *) +(* case(hy = G1.chandle{2})=>//=[->>|hy_neq_ch]/=. *) +(* + move=>h;cut h_eq:v +^ bn = sa{2} +^ nth witness p{2} i{2} && hx = h{2}. *) +(* + cut/#:G1.mh{2}.[(v +^ bn, hx)] <> Some (b, G1.chandle{2}). search hs_spec. *) +(* cut[]_ hh2:=H_m_mh. *) +(* cut:=hh2 (v +^ bn) hx b G1.chandle{2}. *) +(* case(G1.mh{2}.[(v +^ bn, hx)] = Some (b, G1.chandle{2}))=>//=. *) +(* rewrite negb_exists/=;progress; *) +(* rewrite negb_exists/=;progress; *) +(* rewrite negb_exists/=;progress; *) +(* rewrite negb_exists/=;progress;rewrite !negb_and. *) +(* by cut[]/#:=H_hs_spec. *) +(* cut[]eq_xor ->>:=h_eq. *) +(* move:h;rewrite h_eq/==>->>. *) +(* cut/#:!(p0 = (take i{2} p{2}) /\ bn = (nth witness p{2} i{2})) => *) +(* F.RO.m{2}.[rcons p0 bn] = Some b. *) +(* move:h_flag;case:flag=>h_flag;last first. *) +(* - cut:=known_path_uniq _ _ _ sc{1} h{2} p0 v (take i{2} p{2}) sa{2} H2_pi_spec _ h_build_hpath_set _. *) +(* * rewrite getP/=h_flag. *) +(* by cut->//=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h_flag. search build_hpath. *) +(* * by apply build_hpath_up=>//=. *) +(* move=>[]->>->>/=;smt(@Block.WRing). *) +(* cut[]hh1 hh2 hh3:=H_mh_spec. *) +(* cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) b p0 v h{2}. *) +(* rewrite h_build_hpath_set/=h_g1/=. *) +(* cut->/=:=ch_neq0 _ _ H_hs_spec. *) +(* cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h_flag. *) +(* move=>help;cut:= help _;1:smt(dom_hs_neq_ch). *) +(* move=>h_build_hpath_p0. *) +(* rewrite hh2 h_build_hpath_p0/==>h_neq. *) +(* exists v h{2}=>//=. *) +(* rewrite eq_xor h_g1/=;move:h_neq;apply absurd=>//=. *) +(* by cut:=hh3 _ _ _ _ _ hpath h_build_hpath_p0;smt(@Block.WRing). *) +(* move=>help;cut h_neq:! (v +^ bn = sa{2} +^ nth witness p{2} i{2} && hx = h{2}) by rewrite/#. *) +(* move:help;rewrite h_neq/==>h_g1_v_bn_hx. *) +(* cut[]hh1 hh2 hh3:=H_mh_spec. *) +(* cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) b2 p0 v hx. *) +(* rewrite h_build_hpath_set/=h_g1/=. *) +(* cut->/=:=ch_neq0 _ _ H_hs_spec. *) +(* by cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h_flag;smt(dom_hs_neq_ch). *) +(* progress. *) +(* + cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) b2 p0 v hx. *) +(* cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) b2 p' v' hx. *) +(* rewrite H H0/=. *) +(* cut->/=:=ch_neq0 _ _ H_hs_spec. *) +(* cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h_flag. *) +(* rewrite h_g1/=. *) +(* by cut[]:=H_mh_spec;smt(dom_hs_neq_ch). *) +(* cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) b2 p0 v hx. *) +(* cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) b2 p' v' hx. *) +(* rewrite H H0/=. *) +(* cut->/=:=ch_neq0 _ _ H_hs_spec. *) +(* cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h_flag. *) +(* rewrite h_g1/=. *) +(* by cut[]:=H_mh_spec;smt(dom_hs_neq_ch). *) +(* move=>H2_mh_spec;split;progress. *) +(* + by cut[]:=H_m_p;smt(getP size_rcons size_eq0 size_ge0). *) +(* move:H;rewrite dom_set in_fsetU1. *) +(* case(l \in dom Redo.prefixes{1})=>//=hdom. *) +(* + cut[]_ h:=H_m_p. *) +(* cut[]sa' sc'[]h_pref h_pref2:=h _ hdom i0 _;1:rewrite/#. *) +(* exists sa' sc';rewrite!getP/=. *) +(* cut->/=:!take i0 l = rcons (take i{2} p{2}) (nth witness p{2} i{2}) by smt(in_dom). *) +(* rewrite h_pref/=. *) +(* cut->/=:!take (i0 + 1) l = rcons (take i{2} p{2}) (nth witness p{2} i{2}) by smt(in_dom take_size). *) +(* rewrite-h_pref2/=. *) +(* by cut->/=:! (sa' +^ nth witness l i0 = sa{2} +^ nth witness p{2} i{2} && sc' = sc{1}) by smt(in_dom take_size). *) +(* move=>->>;case(i0=i{2})=>[->>|i0_neq_i]//=. *) +(* + exists sa{2} sc{1}=>//=;rewrite!getP/=. *) +(* move:H1;rewrite !size_rcons !size_take//. *) +(* rewrite!nth_rcons-take_nth// !take_take!size_take 1:/#. *) +(* cut->/=hii:i{2}< size p{2} by rewrite/#. *) +(* rewrite !min_lel 1,2:/#. *) +(* by cut->/=:! take i{2} p{2} = take (i{2} + 1) p{2} by smt(size_take). *) +(* move:H1;rewrite !size_rcons !size_take//1:/#. *) +(* rewrite!nth_rcons-take_nth// !take_take!size_take 1:/#. *) +(* cut->/=hii:i{2}< size p{2} by rewrite/#. *) +(* rewrite i0_neq_i/=!min_lel 1,2:/#. *) +(* cut->/=:i0 < i{2} by rewrite/#. *) +(* rewrite!getP. *) +(* cut->/=:! take i0 p{2} = take (i{2} + 1) p{2} by smt(size_take). *) +(* cut[]_ h_pref:=H_m_p. *) +(* cut[]:= h_pref (take i{2} p{2}) _ i0 _;1:smt(in_dom);1:smt(size_take). *) +(* move=>b3 c3;rewrite!take_take!min_lel 1,2:/#=>[][]-> h. *) +(* cut->/=:!take (i0 + 1) p{2} = take (i{2} + 1) p{2} by smt(size_take). *) +(* exists b3 c3=>//=;rewrite getP/=. *) +(* cut/#:!(b3 +^ nth witness (take i{2} p{2}) i0 = sa{2} +^ nth witness p{2} i{2} && *) +(* c3 = sc{1}). *) +(* cut:(b3 +^ nth witness (take i{2} p{2}) i0, c3) \in dom PF.m{1};2:smt(in_dom). *) +(* cut:take (i0 + 1) p{2} \in dom Redo.prefixes{1};2:smt(in_dom). *) +(* cut->:take (i0 + 1) p{2} = take (i0 + 1) (take i{2} p{2});1:smt(take_take). *) +(* smt(in_dom take_oversize). *) +(* qed. *) equiv PFf_Cf (D<:DISTINGUISHER): SqueezelessSponge(PF).f ~ G1'(D).C.f : diff --git a/proof/smart_counter/SLCommon.ec b/proof/smart_counter/SLCommon.ec index 0de9947..2757b7f 100644 --- a/proof/smart_counter/SLCommon.ec +++ b/proof/smart_counter/SLCommon.ec @@ -658,7 +658,7 @@ pred inv_prefixe_block (queries : (block list, block) fmap) (forall (bs : block list), bs \in dom queries => queries.[bs] = prefixes.[bs]) && (forall (bs : block list), - bs \in dom queries => forall i, take i bs \in dom prefixes). + bs \in dom queries => forall i, 0 < i <= size bs => take i bs \in dom prefixes). lemma prefixe_gt0_mem l (ll : 'a list list) : 0 < prefixe l (get_max_prefixe l ll) => @@ -671,7 +671,7 @@ qed. lemma inv_prefixe_block_mem_take queries prefixes l i : inv_prefixe_block queries prefixes => - 0 <= i < prefixe l (get_max_prefixe l (elems (dom queries))) => + 0 < i < prefixe l (get_max_prefixe l (elems (dom queries))) => take i l \in dom prefixes. proof. move=>[]H_incl H_all_prefixes Hi. @@ -679,6 +679,7 @@ rewrite (prefixe_take_leq _ (get_max_prefixe l (elems (dom queries))))1:/#. rewrite H_all_prefixes. cut:get_max_prefixe l (elems (dom queries)) \in dom queries;2:smt(in_dom). by rewrite memE;apply prefixe_gt0_mem=>/#. +smt(prefixe_sizer). qed. (* lemma prefixe_inv_prefixe queries prefixes l : *) From 764faea8a9179210ac38ecfa78850ccb97ed1425 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Thu, 29 Mar 2018 17:42:25 +0200 Subject: [PATCH 272/525] Handle.eca --- proof/smart_counter/Handle.eca | 2447 +++++++++++++++----------------- 1 file changed, 1168 insertions(+), 1279 deletions(-) diff --git a/proof/smart_counter/Handle.eca b/proof/smart_counter/Handle.eca index 8bb05ef..3a7b09c 100644 --- a/proof/smart_counter/Handle.eca +++ b/proof/smart_counter/Handle.eca @@ -25,22 +25,24 @@ module G1(D:DISTINGUISHER) = { proc f(p : block list): block = { var sa, sa', sc; - var h, i <- 0; + var h, i, counter <- 0; sa <- b0; sc <- c0; while (i < size p ) { if (mem (dom mh) (sa +^ nth witness p i, h)) { (sa, h) <- oget mh.[(sa +^ nth witness p i, h)]; } else { - sc <$ cdistr; - bcol <- bcol \/ hinv FRO.m sc <> None; - sa' <@ F.RO.get(take (i+1) p); - sa <- sa +^ nth witness p i; - mh.[(sa,h)] <- (sa', chandle); - mhi.[(sa',chandle)] <- (sa, h); - (sa,h) <- (sa',chandle); - FRO.m.[chandle] <- (sc,Unknown); - chandle <- chandle + 1; + if (counter < size p - prefixe p (get_max_prefixe p (elems (dom C.queries)))) { + sc <$ cdistr; + bcol <- bcol \/ hinv FRO.m sc <> None; + sa' <@ F.RO.get(take (i+1) p); + sa <- sa +^ nth witness p i; + mh.[(sa,h)] <- (sa', chandle); + mhi.[(sa',chandle)] <- (sa, h); + (sa,h) <- (sa',chandle); + FRO.m.[chandle] <- (sc,Unknown); + chandle <- chandle + 1; + } } i <- i + 1; } @@ -185,13 +187,19 @@ inductive m_mh (hs : handles) (m : smap) (mh : hsmap) = (* WELL-FORMEDNESS<1 >: Map and Prefixes are compatible *) -inductive m_p (m : smap) (p : (block list, state) fmap) = +inductive m_p (m : smap) (p : (block list, state) fmap) + (q : (block list, block) fmap) = | INV_m_p of (p.[[]] = Some (b0,c0)) + & (q.[[]] = Some b0) & (forall (l : block list), l \in dom p => (forall i, 0 <= i < size l => exists sa sc, p.[take i l] = Some (sa, sc) /\ - m.[(sa +^ nth witness l i, sc)] = p.[take (i+1) l])). + m.[(sa +^ nth witness l i, sc)] = p.[take (i+1) l])) + & (forall (l : block list), + l \in dom q => exists c, p.[l] = Some (oget q.[l], c)) + & (forall (l : block list), + l \in dom p => exists (l2 : block list), l ++ l2 \in dom q). (** RELATIONAL : Prefixes and RO are compatible. **) inductive ro_p (ro : (block list, block) fmap) (p : (block list, state) fmap) = @@ -241,7 +249,8 @@ inductive inv_spec (m:('a,'b) fmap) mi = (* Invariant: maybe we should split relational and non-relational parts? *) inductive INV_CF_G1 (hs : handles) ch (Pm Pmi Gm Gmi : smap) (mh mhi : hsmap) (ro : (block list,block) fmap) pi - (p : (block list, state) fmap) = + (p : (block list, state) fmap) + (q : (block list, block) fmap) = | HCF_G1 of (hs_spec hs ch) & (inv_spec Gm Gmi) & (inv_spec mh mhi) @@ -251,16 +260,16 @@ inductive INV_CF_G1 (hs : handles) ch (Pm Pmi Gm Gmi : smap) & (incl Gmi Pmi) & (mh_spec hs Gm mh ro) & (pi_spec hs mh pi) - & (all_prefixes_fset (dom ro)) - & (m_p Pm p). + (* & (all_prefixes_fset (dom ro)) *) + & (m_p Pm p q). (** Structural Projections **) lemma m_mh_of_INV (ch : handle) (mi1 m2 mi2 : smap) (mhi2 : hsmap) (ro : (block list, block) fmap) (pi : (capacity, block list * block) fmap) - hs m1 mh2 p: - INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi p => + hs m1 mh2 p q: + INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi p q => m_mh hs m1 mh2. proof. by case. qed. @@ -268,8 +277,8 @@ lemma mi_mhi_of_INV (ch : handle) (m1 m2 mi2 : smap) (mh2 : hsmap) (ro : (block list, block) fmap) (pi : (capacity, block list * block) fmap) - hs mi1 mhi2 p: - INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi p => + hs mi1 mhi2 p q: + INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi p q => m_mh hs mi1 mhi2. proof. by case. qed. @@ -277,8 +286,8 @@ lemma incl_of_INV (hs : handles) (ch : handle) (mi1 mi2 : smap) (mh2 mhi2: hsmap) (ro : (block list, block) fmap) (pi : (capacity, block list * block) fmap) - m1 m2 p: - INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi p => + m1 m2 p q: + INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi p q => incl m2 m1. proof. by case. qed. @@ -286,60 +295,60 @@ lemma incli_of_INV (hs : handles) (ch : handle) (m1 m2 : smap) (mh2 mhi2: hsmap) (ro : (block list, block) fmap) (pi : (capacity, block list * block) fmap) - mi1 mi2 p: - INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi p => + mi1 mi2 p q: + INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi p q => incl mi2 mi1. proof. by case. qed. lemma mh_of_INV (ch : handle) (m1 mi1 mi2 : smap) (mhi2 : hsmap) (pi : (capacity, block list * block) fmap) - hs m2 mh2 ro p: - INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi p => + hs m2 mh2 ro p q: + INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi p q => mh_spec hs m2 mh2 ro. proof. by case. qed. lemma pi_of_INV (ch : handle) (m1 m2 mi1 mi2: smap) (mhi2: hsmap) (ro : (block list, block) fmap) - hs mh2 pi p: - INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi p => + hs mh2 pi p q: + INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi p q => pi_spec hs mh2 pi. proof. by case. qed. lemma hs_of_INV (m1 m2 mi1 mi2 : smap) (mh2 mhi2 : hsmap) (ro : (block list, block) fmap) (pi : (capacity, block list * block) fmap) - hs ch p: - INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi p => + hs ch p q: + INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi p q => hs_spec hs ch. proof. by case. qed. lemma inv_of_INV hs ch m1 mi1 m2 mi2 ro pi - mh2 mhi2 p: - INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi p=> + mh2 mhi2 p q: + INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi p q=> inv_spec mh2 mhi2. proof. by case. qed. -lemma invG_of_INV hs ch m1 mi1 mh2 mhi2 ro pi m2 mi2 p: - INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi p => +lemma invG_of_INV hs ch m1 mi1 mh2 mhi2 ro pi m2 mi2 p q: + INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi p q => inv_spec m2 mi2. proof. by case. qed. -lemma all_prefixes_fset_of_INV hs ch m1 mi1 mh2 mhi2 ro pi m2 mi2 p: - INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi p => - all_prefixes_fset (dom ro). -proof. by case. qed. +(* lemma all_prefixes_fset_of_INV hs ch m1 mi1 mh2 mhi2 ro pi m2 mi2 p q: *) +(* INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi p q => *) +(* all_prefixes_fset (dom ro). *) +(* proof. by case. qed. *) -lemma m_p_of_INV hs ch m1 mi1 mh2 mhi2 ro pi m2 mi2 p: - INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi p => - m_p m1 p. +lemma m_p_of_INV hs ch m1 mi1 mh2 mhi2 ro pi m2 mi2 p q: + INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi p q => + m_p m1 p q. proof. by case. qed. -lemma all_prefixes_of_m_p m1 p: - m_p m1 p => all_prefixes p. +lemma all_prefixes_of_m_p m1 p q: + m_p m1 p q => all_prefixes p. proof. -case=>_ h l hl i. +case=>h0 h0' h1 h2 _ l hl i. case(l = [])=>//=l_notnil. case(0 <= i)=>hi0;last first. + rewrite take_le0 1:/#;cut<-:=take0 l;smt(in_dom size_ge0). @@ -347,10 +356,10 @@ case(i < size l)=>hisize;last smt(take_oversize). smt(in_dom). qed. -lemma all_prefixes_of_INV hs ch m1 mi1 mh2 mhi2 ro pi m2 mi2 p: - INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi p=> +lemma all_prefixes_of_INV hs ch m1 mi1 mh2 mhi2 ro pi m2 mi2 p q: + INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi p q=> all_prefixes p. -proof. case=>? ? ? ? ? ? ? ? ? ? h ?;exact(all_prefixes_of_m_p _ h). qed. +proof. case=>? ? ? ? ? ? ? ? ? h ?;exact(all_prefixes_of_m_p _ _ h). qed. (* lemma ro_p_of_INV hs ch m1 mi1 mh2 mhi2 ro pi m2 mi2 p: *) (* INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi p => *) @@ -717,8 +726,8 @@ by move=> hs_hy; exists p ya yc hy b xa xc hx []; rewrite cats0. qed. (** Path-specific lemmas **) -lemma lemma1 hs ch Pm Pmi Gm Gmi mh mhi ro pi x1 x2 y1 y2 prefixes: - INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes +lemma lemma1 hs ch Pm Pmi Gm Gmi mh mhi ro pi x1 x2 y1 y2 prefixes queries: + INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes queries => x2 <> y2 => Pm.[(x1,x2)] = None => Gm.[(x1,x2)] = None @@ -729,7 +738,7 @@ lemma lemma1 hs ch Pm Pmi Gm Gmi mh mhi ro pi x1 x2 y1 y2 prefixes: Pm.[(x1,x2) <- (y1,y2)] Pmi.[(y1,y2) <- (x1,x2)] Gm.[(x1,x2) <- (y1,y2)] Gmi.[(y1,y2) <- (x1,x2)] mh.[(x1,ch) <- (y1,ch + 1)] mhi.[(y1,ch + 1) <- (x1,ch)] - ro pi prefixes. + ro pi prefixes queries. proof. move=> HINV x2_neq_y2 Pm_x Gm_x x2_notin_rng1_hs y2_notin_rng1_hs; split. + rewrite (@addzA ch 1 1); apply/hs_addh. @@ -811,19 +820,21 @@ have H /H {H}:= build_hpath_down mh x1 ch y1 (ch + 1) p v h _. + move=> ^ /build_hpathP + -> /=; rewrite !getP. by case=> [<*>|/#]; move: HINV=> /hs_of_INV [] _ + H - /H {H} /#. (* + by apply(ro_p_of_INV _ _ _ _ _ _ _ _ _ HINV). *) -+ by case:HINV. split=>[]. -+ by case:HINV=>_ _ _ _ _ _ _ _ (* _ *) [] _ _ [] ->//. ++ by case:HINV=>_ _ _ _ _ _ _ _ (* _ *) [] _ [] ->//. ++ by case:HINV=>_ _ _ _ _ _ _ _ (* _ *) [] _ [] //. + move=>l hmem i hi. - cut[]_ h2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. + cut[]_ _ h2 h3:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. cut[]sa sc[]:=h2 l hmem i hi. - cut h1:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. + cut h1:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. smt(in_dom getP). +by case:HINV=>_ _ _ _ _ _ _ _ _ []. +by case:HINV=>_ _ _ _ _ _ _ _ _ []. qed. -lemma lemma1' hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes x1 x2 y1 y2: - INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes +lemma lemma1' hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes queries x1 x2 y1 y2: + INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes queries => ! (y1,y2) \in dom Pm => x2 <> y2 => Pmi.[(x1,x2)] = None @@ -835,7 +846,7 @@ lemma lemma1' hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes x1 x2 y1 y2: Pm.[(y1,y2) <- (x1,x2)] Pmi.[(x1,x2) <- (y1,y2)] Gm.[(y1,y2) <- (x1,x2)] Gmi.[(x1,x2) <- (y1,y2)] mh.[(y1,ch + 1) <- (x1,ch)] mhi.[(x1,ch) <- (y1,ch + 1)] - ro pi prefixes. + ro pi prefixes queries. proof. move=> HINV hh x2_neq_y2 Pm_x Gm_x xc_notin_rng1_hs yc_notin_rng1_hs; split. + rewrite (@addzA ch 1 1); apply/hs_addh. @@ -916,18 +927,20 @@ have H /H {H}:= build_hpath_down mh y1 (ch + 1) x1 ch p v h _. + move=> ^ /build_hpathP + -> /=; rewrite !getP. by case=> [<*>|/#]; move: HINV=> /hs_of_INV [] _ + H - /H {H} /#. (* + by apply(ro_p_of_INV _ _ _ _ _ _ _ _ _ HINV). *) -+ by case:HINV. split=>[]. -+ by case:HINV=>_ _ _ _ _ _ _ _ (* _ *) [] _ _ [] ->//. ++ by case:HINV=>_ _ _ _ _ _ _ _ (* _ *) [] _ [] ->//. ++ by case:HINV=>_ _ _ _ _ _ _ _ (* _ *) [] _ []. + move=>l hmem i hi. - cut[]_ h2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. + cut[]_ _ h2 h3:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. cut[]sa sc[]:=h2 l hmem i hi. - cut h1:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. + cut h1:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. smt(in_dom getP). +by case:HINV=>_ _ _ _ _ _ _ _ _ []. +by case:HINV=>_ _ _ _ _ _ _ _ _ []. qed. -lemma lemma2 hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi prefixes x1 x2 y1 y2 hx: - INV_CF_G1 hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi prefixes +lemma lemma2 hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi prefixes queries x1 x2 y1 y2 hx: + INV_CF_G1 hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi prefixes queries => PFm.[(x1,x2)] = None => G1m.[(x1,x2)] = None => pi.[x2] = None @@ -937,7 +950,7 @@ lemma lemma2 hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi prefixes x1 x2 y1 y2 hx: PFm.[(x1,x2) <- (y1,y2)] PFmi.[(y1,y2) <- (x1,x2)] G1m.[(x1,x2) <- (y1,y2)] G1mi.[(y1,y2) <- (x1,x2)] G1mh.[(x1,hx) <- (y1,ch)] G1mhi.[(y1,ch) <- (x1,hx)] - ro pi prefixes. + ro pi prefixes queries. proof. move=> HINV PFm_x1x2 G1m_x1x2 pi_x2 hs_hx y2_notin_rng1_hs. split. @@ -1012,18 +1025,20 @@ move: Hpath=> /build_hpathP [<*>|]. + move=> p' b' v' h' <*> _; have /m_mh_of_INV [] _ H /H {H}:= HINV. by move=> [xc fx yc fy] [#] _; have /hs_of_INV [] _ _ H /H {H}:= HINV. (* + by apply(ro_p_of_INV _ _ _ _ _ _ _ _ _ HINV). *) -+ by case:HINV. split=>[]. -+ by case:HINV=>_ _ _ _ _ _ _ _ (* _ *) [] _ _ [] ->//. ++ by case:HINV=>_ _ _ _ _ _ _ _ (* _ *) [] _ [] ->//. ++ by case:HINV=>_ _ _ _ _ _ _ _ (* _ *) [] _ []. + move=>l hmem i hi. - cut[]_ h2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. + cut[]_ _ h2 _:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. cut[]sa sc[]:=h2 l hmem i hi. - cut h1:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. + cut h1:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. smt(in_dom getP). +by case:HINV=>_ _ _ _ _ _ _ _ _ []. +by case:HINV=>_ _ _ _ _ _ _ _ _ []. qed. -lemma lemma2' hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi prefixes x1 x2 y1 y2 hx: - INV_CF_G1 hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi prefixes +lemma lemma2' hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi prefixes queries x1 x2 y1 y2 hx: + INV_CF_G1 hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi prefixes queries => ! (y1,y2) \in dom PFm => PFmi.[(x1,x2)] = None => G1mi.[(x1,x2)] = None @@ -1033,7 +1048,7 @@ lemma lemma2' hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi prefixes x1 x2 y1 y2 hx: PFm.[(y1,y2) <- (x1,x2)] PFmi.[(x1,x2) <- (y1,y2)] G1m.[(y1,y2) <- (x1,x2)] G1mi.[(x1,x2) <- (y1,y2)] G1mh.[(y1,ch) <- (x1,hx)] G1mhi.[(x1,hx) <- (y1,ch)] - ro pi prefixes. + ro pi prefixes queries. proof. move=> HINV hh PFmi_x1x2 G1mi_x1x2 hs_hx y2_notin_rng1_hs. split. @@ -1122,18 +1137,20 @@ have no_path_to_ch: forall p0 v0, build_hpath G1mh p0 <> Some (v0,ch). move=> p' b' v' h' <*> _; have /m_mh_of_INV [] _ H /H {H}:= HINV. by move=> [xc fx yc fy] [#] _; have /hs_of_INV [] _ _ H /H {H}:= HINV. (* + by apply(ro_p_of_INV _ _ _ _ _ _ _ _ _ HINV). *) -+ by case:HINV. split=>[]. -+ by case:HINV=>_ _ _ _ _ _ _ _ (* _ *) [] _ _ [] ->//. ++ by case:HINV=>_ _ _ _ _ _ _ _ (* _ *) [] _ []. ++ by case:HINV=>_ _ _ _ _ _ _ _ (* _ *) [] _ []. + move=>l hmem i hi. - cut[]_ h2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. + cut[]_ _ h2 _:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. cut[]sa sc[]:=h2 l hmem i hi. - cut h1:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. + cut h1:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. smt(in_dom getP). +by case:HINV=>_ _ _ _ _ _ _ _ _ []. +by case:HINV=>_ _ _ _ _ _ _ _ _ []. qed. -lemma lemma3 hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes xa xc hx ya yc hy p b: - INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes +lemma lemma3 hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes queries xa xc hx ya yc hy p b: + INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes queries => Pm.[(xa,xc)] = Some (ya,yc) => Gm.[(xa,xc)] = None => mh.[(xa,hx)] = Some (ya,hy) @@ -1144,7 +1161,7 @@ lemma lemma3 hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes xa xc hx ya yc hy p b: Pm Pmi Gm.[(xa,xc) <- (ya,yc)] Gmi.[(ya,yc) <- (xa,xc)] mh mhi - ro pi.[yc <- (rcons p (b +^ xa),ya)] prefixes. + ro pi.[yc <- (rcons p (b +^ xa),ya)] prefixes queries. proof. move=> HINV Pm_xaxc Gm_xaxc mh_xahx hs_hx hs_hy pi_xc. split. @@ -1211,13 +1228,6 @@ split. by have /hs_of_INV [] + _ _ - /(_ _ _ _ _ hs_hx hs_h _) := HINV. (* + by apply(ro_p_of_INV _ _ _ _ _ _ _ _ _ HINV). *) + by case:HINV. -split=>[]. -+ by case:HINV=>_ _ _ _ _ _ _ _ (* _ *) [] _ _ [] ->//. -+ move=>l hmem i hi. - cut[]_ h2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. - cut[]sa sc[]:=h2 l hmem i hi. - cut h1:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. - smt(in_dom getP). qed. @@ -1300,8 +1310,8 @@ proof. qed. -lemma lemma4 hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes i p sa sc h f: - INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes +lemma lemma4 hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes queries i p sa sc h f: + INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes queries => 0 <= i < List.size p => take (i + 1) p \in dom prefixes => prefixes.[take i p] = Some (sa,sc) @@ -1311,10 +1321,10 @@ lemma lemma4 hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes i p sa sc h f: => (sa +^ nth witness p i, h) \in dom mh. proof. move=>inv0 hi take_i1_p_in_prefixes prefixes_sa_sc build_hpath_i_p ro_prefixe hs_h_sc_f. -cut[]_ m_prefixe:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ inv0. +cut[]_ _ m_prefixe _:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. cut[]b1 c1[]:=m_prefixe _ take_i1_p_in_prefixes i _;1:smt(size_take). rewrite!take_take!min_lel 1,2:/# nth_take 1,2:/# prefixes_sa_sc/==>[][<-<-]{b1 c1}Pm_prefixe. -cut[]hh1 hh2 hh3:=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ inv0. +cut[]hh1 hh2 hh3:=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. move:ro_prefixe;cut{1}->:=(take_nth witness i p);1:smt(size_take);move=>h1. cut:=hh2 (take i p) (nth witness p i) (oget prefixes.[take (i + 1) p]).`1. rewrite h1/==>[][] v hx hy;rewrite build_hpath_i_p/==>[][][?<-];smt(in_dom). @@ -1323,16 +1333,36 @@ qed. (* we should do a lemma to have the equivalence *) -equiv eq_fi (D <: DISTINGUISHER {PF, RO, G1}): PF.fi ~ G1(D).S.fi: +equiv eq_fi (D <: DISTINGUISHER {PF, RO, G1}): DPRestr(PF).fi ~ DPRestr(G1(DRestr(D)).S).fi: !G1.bcol{2} /\ !G1.bext{2} + /\ ={arg} /\ ={glob C} + /\ INV_CF_G1 FRO.m{2} G1.chandle{2} + PF.m{1} PF.mi{1} + G1.m{2} G1.mi{2} + G1.mh{2} G1.mhi{2} + F.RO.m{2} G1.paths{2} + Redo.prefixes{1} C.queries{2} + ==> if G1.bcol{2} \/ G1.bext{2} + then ([] \in dom C.queries{1}) /\ ([] \in dom C.queries{2}) + else ={res} /\ ={glob C} + /\ INV_CF_G1 FRO.m{2} G1.chandle{2} + PF.m{1} PF.mi{1} + G1.m{2} G1.mi{2} + G1.mh{2} G1.mhi{2} + F.RO.m{2} G1.paths{2} + Redo.prefixes{1} C.queries{2}. +proof. +proc;sp;if;auto. +call(: !G1.bcol{2} + /\ !G1.bext{2} /\ ={x} /\ INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} - Redo.prefixes{1} + Redo.prefixes{1} C.queries{2} ==> !G1.bcol{2} => !G1.bext{2} => ={res} @@ -1341,15 +1371,14 @@ equiv eq_fi (D <: DISTINGUISHER {PF, RO, G1}): PF.fi ~ G1(D).S.fi: G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} - Redo.prefixes{1}. -proof. + Redo.prefixes{1} C.queries{2});auto. exists* FRO.m{2}, G1.chandle{2}, PF.m{1}, PF.mi{1}, G1.m{2}, G1.mi{2}, G1.mh{2}, G1.mhi{2}, - F.RO.m{2}, G1.paths{2}, x{2}, Redo.prefixes{1}. -elim* => hs ch Pm Pmi Gm Gmi mh mhi ro pi [xa xc] prefixes. + F.RO.m{2}, G1.paths{2}, x{2}, Redo.prefixes{1}, C.queries{2}. +elim* => hs ch Pm Pmi Gm Gmi mh mhi ro pi [xa xc] prefixes queries. case @[ambient]: - {-1}(INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes) - (eq_refl (INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes)); last first. + {-1}(INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes queries) + (eq_refl (INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes queries)); last first. + by move=> inv0; exfalso=> ? ? [#] <<*>; rewrite inv0. move=> /eqT inv0; proc. case @[ambient]: {-1}(Pmi.[(xa,xc)]) (eq_refl Pmi.[(xa,xc)])=> [Pmi_xaxc|[ya yc] Pmi_xaxc]. @@ -1377,21 +1406,21 @@ case @[ambient]: {-1}(Pmi.[(xa,xc)]) (eq_refl Pmi.[(xa,xc)])=> [Pmi_xaxc|[ya yc] rewrite(@huniq_hinvK_h ch) 3:oget_some /=. + by apply/huniq_addh=> //; have /hs_of_INV [] := inv0. + by rewrite getP. - apply/(@lemma1' hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes xa xc ya yc inv0 _ _ Pmi_xaxc Gmi_xaxc)=> //;first last. + apply/(@lemma1' hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes queries xa xc ya yc inv0 _ _ Pmi_xaxc Gmi_xaxc)=> //;first last. + rewrite -negP=> <*>; move: yc_notin_rng1_hs_addh => /=. apply/negb_forall=> /=; exists ch; apply/negb_forall=> /=; exists Known. by rewrite getP. + move=> f h; move: (yc_notin_rng1_hs_addh h f); rewrite getP. case: (h = ch)=> <*> //= _; rewrite -negP. by have /hs_of_INV [] _ _ H /H {H} := inv0. - + rewrite in_dom/=;cut[]h1 h2:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ inv0. + + rewrite in_dom/=;cut[]h1 h2:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. cut h1':=h1 ya yc. cut :Pm.[(ya, yc)] <> None => exists (hx : handle) (fx : flag), hs.[hx] = Some (yc, fx) by rewrite/#. case(Pm.[(ya, yc)] = None)=>//=h; rewrite negb_exists/==>a;rewrite negb_exists/==>b. cut:=yc_notin_rng1_hs_addh a b;rewrite getP;case(a=ch)=>//=hach. search (&&). case(xc=yc)=>[/#|]hxyc. - cut[]_ _ help:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ inv0. + cut[]_ _ help:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. by cut/#:=help (yc,b) a. have /hs_of_INV [] Hhuniq _ _ [] /(getflagP_some _ _ _ Hhuniq):= inv0. + move=> x2_is_U; conseq (_: _ ==> G1.bext{2})=> //. @@ -1408,7 +1437,7 @@ case @[ambient]: {-1}(Pmi.[(xa,xc)]) (eq_refl Pmi.[(xa,xc)])=> [Pmi_xaxc|[ya yc] case: (hinvP hs y2)=> [_ y2_notin_rng1_hs _ _|/#]. rewrite getP /= oget_some /=. apply/lemma2'=> //. - + rewrite in_dom/=;cut[]h1 _:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ inv0. + + rewrite in_dom/=;cut[]h1 _:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. cut h1':=h1 y1 y2. cut :Pm.[(y1, y2)] <> None => exists (hx : handle) (fx : flag), hs.[hx] = Some (y2, fx) by rewrite/#. case(Pm.[(y1, y2)] = None)=>//=h; @@ -1432,1102 +1461,59 @@ have /incli_of_INV <- := inv0; 1:by rewrite Gmi_xaxc. rewrite Pmi_xaxc=> /= [#] <<*>. rcondf{2} 1; 1:by auto=> &hr [#] <<*>; rewrite in_dom Gmi_xaxc. by auto=> &1 &2 /#. -qed. - -lemma head_nth (w:'a) l : head w l = nth w l 0. -proof. by case l. qed. - -lemma drop_add (n1 n2:int) (l:'a list) : 0 <= n1 => 0 <= n2 => drop (n1 + n2) l = drop n2 (drop n1 l). -proof. - move=> Hn1 Hn2;elim: n1 Hn1 l => /= [ | n1 Hn1 Hrec] l;1: by rewrite drop0. - by case: l => //= a l /#. -qed. - -lemma behead_drop (l:'a list) : behead l = drop 1 l. -proof. by case l => //= l;rewrite drop0. qed. - -lemma incl_upd_nin (m1 m2:('a,'b)fmap) x y: incl m1 m2 => !mem (dom m2) x => incl m1 m2.[x <- y]. -proof. - move=> Hincl Hdom w ^/Hincl <- => Hw. - rewrite getP_neq // -negP => ->>. - by move: Hdom;rewrite in_dom. -qed. - - - -module G1'(D:DISTINGUISHER) = { - var m, mi : smap - var mh, mhi : hsmap - var chandle : int - var paths : (capacity, block list * block) fmap - var bext, bcol : bool - - module M = { - - proc f(p : block list): block = { - var sa, sa', sc; - var h, i, counter <- 0; - sa <- b0; - sc <- c0; - while (i < size p ) { - if (mem (dom mh) (sa +^ nth witness p i, h)) { - (sa, h) <- oget mh.[(sa +^ nth witness p i, h)]; - } else { - if (counter < size p - prefixe p (get_max_prefixe p (elems (dom C.queries)))) { - sc <$ cdistr; - bcol <- bcol \/ hinv FRO.m sc <> None; - sa' <@ F.RO.get(take (i+1) p); - sa <- sa +^ nth witness p i; - mh.[(sa,h)] <- (sa', chandle); - mhi.[(sa',chandle)] <- (sa, h); - (sa,h) <- (sa',chandle); - FRO.m.[chandle] <- (sc,Unknown); - chandle <- chandle + 1; - counter <- counter + 1; - } - } - i <- i + 1; - } - sa <- F.RO.get(p); - return sa; - } - } - - module S = { - - proc f(x : state): state = { - var p, v, y, y1, y2, hy2, hx2; - - if (!mem (dom m) x) { - if (mem (dom paths) x.`2) { - (p,v) <- oget paths.[x.`2]; - y1 <- F.RO.get (rcons p (v +^ x.`1)); - y2 <$ cdistr; - } else { - y1 <$ bdistr; - y2 <$ cdistr; - } - y <- (y1, y2); - bext <- bext \/ mem (rng FRO.m) (x.`2, Unknown); - if (!(mem (rng FRO.m) (x.`2, Known))) { - FRO.m.[chandle] <- (x.`2, Known); - chandle <- chandle + 1; - } - hx2 <- oget (hinvK FRO.m x.`2); - if (mem (dom mh) (x.`1, hx2) /\ in_dom_with FRO.m (oget mh.[(x.`1,hx2)]).`2 Unknown) { - hy2 <- (oget mh.[(x.`1, hx2)]).`2; - y <- (y.`1, (oget FRO.m.[hy2]).`1); - FRO.m.[hy2] <- (y.`2, Known); - m.[x] <- y; - mi.[y] <- x; - } else { - bcol <- bcol \/ hinv FRO.m y.`2 <> None; - hy2 <- chandle; - chandle <- chandle + 1; - FRO.m.[hy2] <- (y.`2, Known); - m.[x] <- y; - mh.[(x.`1, hx2)] <- (y.`1, hy2); - mi.[y] <- x; - mhi.[(y.`1, hy2)] <- (x.`1, hx2); - } - if (mem (dom paths) x.`2) { - (p,v) <- oget paths.[x.`2]; - paths.[y.`2] <- (rcons p (v +^ x.`1), y.`1); - } - } else { - y <- oget m.[x]; - } - return y; - } - - proc fi(x : state): state = { - var y, y1, y2, hx2, hy2; - - if (!mem (dom mi) x) { - bext <- bext \/ mem (rng FRO.m) (x.`2, Unknown); - if (!(mem (rng FRO.m) (x.`2, Known))) { - FRO.m.[chandle] <- (x.`2, Known); - chandle <- chandle + 1; - } - hx2 <- oget (hinvK FRO.m x.`2); - y1 <$ bdistr; - y2 <$ cdistr; - y <- (y1,y2); - if (mem (dom mhi) (x.`1,hx2) /\ - in_dom_with FRO.m (oget mhi.[(x.`1,hx2)]).`2 Unknown) { - (y1,hy2) <- oget mhi.[(x.`1, hx2)]; - y <- (y.`1, (oget FRO.m.[hy2]).`1); - FRO.m.[hy2] <- (y.`2, Known); - mi.[x] <- y; - m.[y] <- x; - } else { - bcol <- bcol \/ hinv FRO.m y.`2 <> None; - hy2 <- chandle; - chandle <- chandle + 1; - FRO.m.[hy2] <- (y.`2, Known); - mi.[x] <- y; - mhi.[(x.`1, hx2)] <- (y.`1, hy2); - m.[y] <- x; - mh.[(y.`1, hy2)] <- (x.`1, hx2); - } - } else { - y <- oget mi.[x]; - } - return y; - } - - } - - proc main(): bool = { - var b; - - F.RO.m <- map0; - m <- map0; - mi <- map0; - mh <- map0; - mhi <- map0; - bext <- false; - bcol <- false; - - (* the empty path is initially known by the adversary to lead to capacity 0^c *) - FRO.m <- map0.[0 <- (c0, Known)]; - paths <- map0.[c0 <- ([<:block>],b0)]; - chandle <- 1; - b <@ D(M,S).distinguish(); - return b; - } -}. - - -lemma lemma5 hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes i (p : block list) b c h: - INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes - => 0 <= i < size p - => take (i + 1) p \in dom prefixes - => prefixes.[take i p] = Some (b,c) - => (exists f, hs.[h] = Some (c,f)) - => exists b' c' h', - Pm.[(b +^ nth witness p i, c)] = Some (b',c') /\ - mh.[(b +^ nth witness p i, h)] = Some (b',h'). -proof. -move=>Hinv H_size H_take_iS H_take_i H_hs_h. -cut[]_ H:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ Hinv. -cut[]sa sc:=H _ H_take_iS i _;1:smt(size_take). -rewrite!take_take !min_lel//= 1:/# nth_take 1,2:/#H_take_i=>[][]/=[->>->>] H_pm. -cut[]b' c' H_Pm:exists b' c', Pm.[(sa +^ nth witness p i, sc)] = Some (b',c') by smt(in_dom). -exists b' c';rewrite -H_Pm/=. -cut[]h_Pm _:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ Hinv. -cut[]h' f' hy fy[]H_h'[]H_hy H_mh:=h_Pm _ _ _ _ H_Pm. -cut[]h_huniq _ _:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ Hinv. print huniq. -cut[]f H_h := H_hs_h. -cut/=<<-:=h_huniq _ _ _ _ H_h H_h'. -by rewrite H_mh/=/#. +progress;cut[]//=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H1;smt(in_dom). +progress;cut[]//=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H1;smt(in_dom). qed. -lemma lemma5' hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes i (p : block list) b c h: - INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes - => 0 <= i < size p - => prefixes.[take i p] = Some (b,c) - => (exists f, hs.[h] = Some (c,f)) - => (exists b' c' h', - Pm.[(b +^ nth witness p i, c)] = Some (b',c') /\ - mh.[(b +^ nth witness p i, h)] = Some (b',h')) \/ - (Pm.[(b +^ nth witness p i, c)] = None /\ - mh.[(b +^ nth witness p i, h)] = None). +equiv eq_f (D <: DISTINGUISHER {PF, RO, G1}): DPRestr(PF).f ~ DPRestr(G1(DRestr(D)).S).f: + !G1.bcol{2} + /\ !G1.bext{2} + /\ ={x} /\ ={glob C} + /\ INV_CF_G1 FRO.m{2} G1.chandle{2} + PF.m{1} PF.mi{1} + G1.m{2} G1.mi{2} + G1.mh{2} G1.mhi{2} + F.RO.m{2} G1.paths{2} + Redo.prefixes{1} C.queries{2} + ==> if G1.bcol{2} \/ G1.bext{2} + then ([] \in dom C.queries{2}) + else ={res} /\ ={glob C} + /\ INV_CF_G1 FRO.m{2} G1.chandle{2} + PF.m{1} PF.mi{1} + G1.m{2} G1.mi{2} + G1.mh{2} G1.mhi{2} + F.RO.m{2} G1.paths{2} + Redo.prefixes{1} C.queries{2}. proof. -move=>Hinv H_size H_take_i H_hs_h. -case(Pm.[(b +^ nth witness p i, c)] = None)=>//=H_Pm. -+ right;move:H_Pm;apply absurd=>H_mh. - cut[]b1 h1 H_mh1:exists b1 h1, mh.[(b +^ nth witness p i, h)] = Some (b1,h1) by rewrite/#. - cut[]H_Pm H_Gmh:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ Hinv. - by cut/#:=H_Gmh _ _ _ _ H_mh1. -cut[]b1 c1 H_Pm1:exists b1 c1, Pm.[(b +^ nth witness p i, c)] = Some (b1,c1) - by exists (oget Pm.[(b +^ nth witness p i, c)]).`1 - (oget Pm.[(b +^ nth witness p i, c)]).`2;smt(get_oget in_dom). -cut[]H_P_m H_Gmh:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ Hinv. -cut:=H_P_m _ _ _ _ H_Pm1. -by cut[]/#:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ Hinv. -qed. - - -equiv PFf_Cf_not_nil (D<:DISTINGUISHER): - - DFRestr(SqueezelessSponge(PF)).f ~ DFRestr(G1(D).M).f : - - ! (G1.bcol{2} \/ G1.bext{2}) /\ - ={arg} /\ ={glob C} /\ [] \in dom C.queries{2} /\ - INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} - G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} Redo.prefixes{1} - ==> - ! (G1.bcol{2} \/ G1.bext{2}) => ={glob C} /\ ={res} /\ - INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} - G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} Redo.prefixes{1} /\ - [] \in dom C.queries{2}. -proof. - proc;sp;inline*;sp. - if;1,3:auto;if;1,3:auto;swap{1}4;swap{2}11;sp;wp 1 5. - sp;conseq(:_==> ! (G1.bcol{2} \/ G1.bext{2}) => - ={glob C, sa} /\ - INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} G1.mh{2} - G1.mhi{2} F.RO.m{2} G1.paths{2} Redo.prefixes{1} /\ - [] \in dom C.queries{2} /\ - F.RO.m.[p]{2} = Some sa{2});progress. - + rewrite/#. - + rewrite/#. - + rewrite/#. - + smt(dom_set in_fsetU1). - seq 1 1: - (={i, p, glob C} /\ i{1} = size p{1} /\ p{2} = bs{1} /\ - (!(G1.bcol{2} \/ G1.bext{2}) => - (INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} - G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} Redo.prefixes{1} /\ - [] \in dom C.queries{2} /\ ={sa} /\ - F.RO.m.[p]{2} = Some sa{1})));last first. - + case : (! (G1.bcol{2} \/ G1.bext{2}));last first. - - by conseq(:_==>true);progress;auto;smt(DBlock.dunifin_ll DCapacity.dunifin_ll take_size). - by rcondf{2}3;auto;smt(in_dom DBlock.dunifin_ll DCapacity.dunifin_ll take_size). - - while ( ={p, i, glob C} /\ (0 <= i <= size p){2} /\ - (Redo.prefixes.[take i p]{1} = Some (sa,sc){1}) /\ - (take i p \in dom Redo.prefixes){1} /\ - (!(G1.bcol{2} \/ G1.bext{2}) => - (INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} - G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} Redo.prefixes{1} /\ - [] \in dom C.queries{2} /\ - ={sa} /\ - (exists f, FRO.m.[h]{2} = Some (sc{1}, f)) /\ - (build_hpath G1.mh (take i p) = Some (sa,h)){2} /\ - if i{2} = 0 then (sa,h){2} = (b0, 0) - else F.RO.m.[take i p]{2} = Some sa{1})));last first. - + auto;progress. - - smt(size_ge0). - - case:H1=>_ _ _ _ _ _ _ _ _ _ [];smt(take0). - - case:H1=>_ _ _ _ _ _ _ _ _ _ [];smt(take0 in_dom). - - cut[]/#:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ H1. - - cut[]/#:=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ H1. - - rewrite/#. - - rewrite/#. - - rewrite/#. - - smt(size_eq0 size_ge0 take_le0 take_size). - case : (! (G1.bcol{2} \/ G1.bext{2}));last first. - - wp 1 1=>/=. - conseq(:_==> Redo.prefixes{1}.[take (i{1}+1) p{1}] = Some (sa{1}, sc{1}) - /\ (take (i{1} + 1) p{1} \in dom Redo.prefixes{1}) - /\ (G1.bcol{2} \/ G1.bext{2}));1:rewrite/#. - if{1};sp;2:if{1};if{2};sp;auto;4:swap{2}4-3;auto; - smt(getP get_oget dom_set in_fsetU1 DBlock.dunifin_ll DCapacity.dunifin_ll). - if{1}. - + rcondt{2}1;auto;progress. - - cut[]HINV:=H3 H6. - by cut//=:=lemma5 _ _ _ _ _ _ _ _ _ _ _ i{hr} p{hr} sa{hr} sc{m} h{hr} HINV;smt(in_dom). - - rewrite/#. - - rewrite/#. - - smt(get_oget). - - rewrite/#. - - rewrite/#. - - cut[]HINV[]H_dom[]->>[][]f H_h[]H_path H_F_RO:=H3 H6. - cut//=[]:=lemma5 _ _ _ _ _ _ _ _ _ _ _ i{2} p{2} sa{2} sc{1} h{2} HINV _ _ _ _. - * rewrite/#. - * rewrite/#. - * rewrite/#. - * rewrite/#. - move=>b' c' h'[]H_Pm ->/=;rewrite oget_some/=. - cut[]_ H_pref:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. - cut[]b1 c1[]:=H_pref _ H7 i{2} _;1:smt(size_take). - by rewrite !take_take!min_lel 1,2:/# nth_take 1,2:/# H1/==>[][]->>->><-/#. - - cut[]HINV[]H_dom[]->>[][]f H_h[]H_path H_F_RO:=H3 H6. - cut//=[]:=lemma5 _ _ _ _ _ _ _ _ _ _ _ i{2} p{2} sa{2} sc{1} h{2} HINV _ _ _ _. - * rewrite/#. - * rewrite/#. - * rewrite/#. - * rewrite/#. - move=>b' c' h'[]H_Pm H_mh/=. - rewrite H_mh/=oget_some/=. - cut[]_ H_Gmh:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. - cut[]c1 h1 c2 h2:=H_Gmh _ _ _ _ H_mh;rewrite H_h/==>[][][<<-<<-][];rewrite H_Pm/=. - move=>help ->>;move:help. - cut[]_ H_pref:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. - cut[]b3 c3[]:=H_pref _ H7 i{2} _;1:smt(size_take). - rewrite !take_take!min_lel 1,2:/# nth_take 1,2:/# H1/==>[][]->>->><-. - by rewrite H_Pm oget_some/=/#. - - cut[]HINV[]H_dom[]->>[][]f H_h[]H_path H_F_RO:=H3 H6. - cut//=[]b1 c1 h1[]H_Pm H_mh:=lemma5 _ _ _ _ _ _ _ _ _ _ _ i{2} p{2} sa{2} sc{1} h{2} HINV _ _ _ _. - * rewrite/#. - * rewrite/#. - * rewrite/#. - * rewrite/#. - by rewrite H_mh/=oget_some/=(@take_nth witness)1:/#build_hpath_prefix H_path/=/#. - - rewrite/#. - - rewrite/#. - - cut[]HINV[]H_dom[]->>[][]f H_h[]H_path H_F_RO:=H3 H6. - cut[]_ H_pref:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. - cut[]b3 c3[]:=H_pref _ H7 i{2} _;1:smt(size_take). - rewrite !take_take!min_lel 1,2:/# nth_take 1,2:/# H1/==>[][]->>->>. - cut//=[]b1 c1 h1[]H_Pm H_mh:=lemma5 _ _ _ _ _ _ _ _ _ _ _ i{2} p{2} b3 c3 h{2} HINV _ _ _ _. - * rewrite/#. - * rewrite/#. - * rewrite/#. - * rewrite/#. - rewrite H_Pm=>H_pref_Pm;rewrite -H_pref_Pm oget_some/=. - rewrite(@take_nth witness)1:/#. - by cut[]_ -> _/#:=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. - - sp;wp=>/=. - if{1};2:rcondt{2}1;first last;3:rcondf{2}1;..3:auto. - + smt(lemma5' in_dom). - + progress. - - rewrite/#. - - rewrite/#. - - smt(getP get_oget in_dom). - - smt(getP get_oget in_dom). - - cut[]HINV[]H_nil_in_dom[]->>[][]f H_h[]H_path H_F_RO:=H3 H6. - split;case:HINV=>//=_ _ _ _ _ _ _ _ _ _[] H0' H_m_p;split. - + by rewrite getP; smt(size_take take0 size_eq0 size_ge0). - move=>l;rewrite dom_set in_fsetU1. - case(l = take (i{2} + 1) p{2})=>//=[->>|H_l H_dom]. - * move=>j H_size;rewrite!getP/=. - cut h_size:0 <= j <= i{2} by smt(size_take). - cut->/=:!take j (take (i{2} + 1) p{2}) = take (i{2} + 1) p{2} by smt(size_take). - rewrite!take_take!min_lel 1,2:/# nth_take 1,2:/#. - case(j=i{2})=>[->>|H_ij]/=. - + smt(get_oget in_dom). - cut->/=:!(take (j + 1) p{2}) = take (i{2} + 1) p{2} by smt(size_take). - cut[]:=H_m_p _ H2 j _;1:smt(size_take). - by rewrite!take_take!min_lel 1,2:/# nth_take /#. - move=>i Hi;rewrite!getP. - cut:take i l \in dom Redo.prefixes{1} by smt(in_dom). - by cut/#:take (i+1) l \in dom Redo.prefixes{1} by smt(in_dom take_oversize). - - rewrite/#. - - smt(lemma5' in_dom). - - cut[]HINV[]H_nil_in_dom[]->>[][]f H_h[]H_path H_F_RO:=H3 H6. - cut:=lemma5' _ _ _ _ _ _ _ _ _ _ _ i{2} p{2} sa{2} sc{1} h{2} HINV _ _ _. - * rewrite/#. - * rewrite/#. - * rewrite/#. - cut:=H8;rewrite in_dom=>->/=[]b1 c1 h1[]H_Pm1 H_Gmh1. - rewrite H_Pm1 H_Gmh1 !oget_some/=. - by cut[]/#:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. - - cut[]HINV[]H_nil_in_dom[]->>[][]f H_h[]H_path H_F_RO:=H3 H6. - cut:=lemma5' _ _ _ _ _ _ _ _ _ _ _ i{2} p{2} sa{2} sc{1} h{2} HINV _ _ _. - * rewrite/#. - * rewrite/#. - * rewrite/#. - cut:=H8;rewrite in_dom=>->/=[]b1 c1 h1[]H_Pm1 H_Gmh1. - by rewrite H_Gmh1 oget_some/=(@take_nth witness)1:/#build_hpath_prefix H_path/=/#. - - rewrite/#. - - rewrite/#. - - cut[]HINV[]H_nil_in_dom[]->>[][]f H_h[]H_path H_F_RO:=H3 H6. - cut:=lemma5' _ _ _ _ _ _ _ _ _ _ _ i{2} p{2} sa{2} sc{1} h{2} HINV _ _ _. - * rewrite/#. - * rewrite/#. - * rewrite/#. - cut:=H8;rewrite in_dom=>->/=[]b1 c1 h1[]H_Pm1 H_Gmh1. - rewrite H_Pm1 !oget_some/=(@take_nth witness)1:/#. - by cut[]/#:=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. - + smt(lemma5' in_dom). - rcondt{2}5;auto;progress. - * rewrite(@take_nth witness)1:/# in_dom. - cut[]HINV[]H_nil_in_dom[]->>[][]f H_h[]H_path H_F_RO:=H3 H6. - cut[]:=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. - cut:=lemma5' _ _ _ _ _ _ _ _ _ _ _ i{hr} p{hr} sa{hr} sc{m} h{hr} HINV _ _ _. - * rewrite/#. - * rewrite/#. - * rewrite/#. - cut:=H8;rewrite in_dom =>/=->/=H_Gmh _ H_ H_path_uniq. - cut help:=H_ (take i{hr} p{hr}) (nth witness p{hr} i{hr});rewrite H_path/= in help. - cut:forall (b : block), - F.RO.m{hr}.[rcons (take i{hr} p{hr}) (nth witness p{hr} i{hr})] = Some b - <=> exists hy, G1.mh{hr}.[(sa{hr} +^ nth witness p{hr} i{hr}, h{hr})] = Some (b, hy) by rewrite/#. - move:help=>_ help;move:H_Gmh;apply absurd=>//=H_F_Ro. - by cut:=get_oget F.RO.m{hr} (rcons (take i{hr} p{hr}) (nth witness p{hr} i{hr}));rewrite in_dom H_F_Ro/=help=>[]/#. - swap{2}-3;auto;progress. - * rewrite/#. - * rewrite/#. - * by rewrite!getP/=. - * smt(getP dom_set in_fsetU1). - * rewrite!getP/=!oget_some/=. - * cut[]HINV[]H_nil_in_dom[]->>[][]f H_h[]H_path H_F_RO:=H3 H6. - cut:=H13;rewrite !negb_or/==>[][][]bad1 hinv_none bad2. - cut H_hs_spec:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. - cut H_mh_spec:=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. - cut H_m_mh:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. - cut H_mi_mhi:=mi_mhi_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. - cut H_pi_spec:=pi_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. - cut :=lemma5' _ _ _ _ _ _ _ _ _ _ _ i{2} p{2} sa{2} sc{1} h{2} HINV _ _ _. - * by rewrite H H4/=. - * exact H1. - * rewrite/#. - cut:=H8;rewrite in_dom/==>->/=h_g1. - cut H2_pi_spec:pi_spec FRO.m{2}.[G1.chandle{2} <- (y2L, Unknown)] - G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- (y1L, G1.chandle{2})] - G1.paths{2}. - + split;progress. - - cut[]h:=H_pi_spec;cut:=h c p0 v;rewrite H14/==>[][]h1[] h'1 h'2. - exists h1;rewrite -h'2 getP/=. - cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h'2. - by apply build_hpath_up=>//=. - move:H15;rewrite getP/==>hh0. - cut h0_neq_ch:h0 <> G1.chandle{2} by rewrite/#. - cut[]->:=H_pi_spec;rewrite-hh0 h0_neq_ch/=;exists h0=>/=. - cut:=H;cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) y1L p0 v h0. - rewrite h_g1/=H/=h0_neq_ch/=. - cut->//=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec H_h. - cut -> /= <-//=:=ch_neq0 _ _ H_hs_spec;progress;cut[]hh1 hh2 hh3:=H_mh_spec;smt(dom_hs_neq_ch). - split. - + apply hs_addh;1:cut//:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. - by cut:=hinvP FRO.m{2} y2L;rewrite hinv_none/=/#. - + by cut:=invG_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. - + apply inv_addm=>//;1:cut//:=inv_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. - apply (notin_hs_notin_dom2_mh FRO.m{2} PF.mi{1})=>//=. - by apply ch_notin_dom_hs;cut:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. - + cut[] H_huniq _ _:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. - apply (m_mh_addh_addm _ H_m_mh H_huniq H_h)=>//=. - by apply ch_notin_dom_hs;cut:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. - + cut[] H_huniq _ _:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. - apply (mi_mhi_addh_addmi _ H_mi_mhi _ H_h _)=>//=. - - smt(hinvP). - by apply ch_notin_dom_hs;cut:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. - + apply incl_upd_nin=>//=. - by cut:=incl_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. - + apply incl_upd_nin=>//=. - - by cut:=incli_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. - cut:=hinvP FRO.m{2} y2L;rewrite in_dom hinv_none/=;apply absurd=>H_P_mi. - rewrite negb_forall/=. - cut H_inv_Gmh:=inv_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. - cut[]H_inv_Pm:=inv_mh_inv_Pm _ _ _ _ _ H_m_mh H_mi_mhi H_inv_Gmh. - cut[]H_Pmi H_Gmhi:=mi_mhi_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. - by cut[]/#:=H_Pmi y1L y2L (oget PF.mi{1}.[(y1L, y2L)]).`1 - (oget PF.mi{1}.[(y1L, y2L)]).`2 _;1:smt(get_oget in_dom). - + cut H_take_Si:=take_nth witness i{2} p{2} _;1:rewrite/#. - split=>//=. - - move=>x hx y hy;rewrite !getP. - case((x, hx) = (sa{2} +^ nth witness p{2} i{2}, h{2}))=>//=. - * move=>[->> ->>][<<- <<-]/=. - cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec H_h. - rewrite H_h/=. - exists sc{1} f y2L Unknown=>//=. - exists (take i{2} p{2}) (sa{2})=>//=;rewrite getP Block.WRing.addKr/=. - by rewrite(@take_nth witness)1:/#/=;apply build_hpath_up=>//=;smt(in_dom). - move=> neq h1. - cut[]hh1 hh2 hh3:=H_mh_spec. - cut[]xc hxx yc hyc []h2[]h3 h4:=hh1 _ _ _ _ h1. - cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h2. - cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h3. - rewrite h2 h3/=;exists xc hxx yc hyc=>//=. - move:h4;case(hyc = Known)=>//=neq2[]p0 b[]hp0 hb. - exists p0 b;rewrite getP. - cut->/=:=build_hpath_up _ _ _ y1L G1.chandle{2} _ _ _ hb h_g1. - cut/#:!rcons p0 (b +^ x) = rcons (take i{2} p{2}) (nth witness p{2} i{2});move:neq;apply absurd=>//=h'. - cut<<-:take i{2} p{2}=p0 by rewrite/#. - cut hbex:b +^ x = nth witness p{2} i{2} by rewrite/#. - by cut:=hb;rewrite H_path/==>[][->>->>]/=;rewrite-hbex Block.WRing.addKr/=. - - progress. - * move:H14;rewrite getP/=H_take_Si/=. - case(p0 = (take i{2} p{2}))=>[->>|hpp0]. - + cut->/=:=build_hpath_up _ _ _ y1L G1.chandle{2} _ _ _ H_path h_g1. - case(bn = (nth witness p{2} i{2}))=>[->> /= ->>|hbni]/=. - - by exists sa{2} h{2} G1.chandle{2}=>//=;rewrite getP/=. - cut->/=:!rcons (take i{2} p{2}) bn = rcons (take i{2} p{2}) (nth witness p{2} i{2}). - - move:hbni;apply absurd=>//=h. - cut->:bn = nth witness (rcons (take i{2} p{2}) bn) i{2}. - * by rewrite nth_rcons size_take /#. - by rewrite h nth_rcons size_take /#. - move=>h_ro_p_bn. - cut[]_ hh4 _:=H_mh_spec. - by cut:=hh4 (take i{2} p{2}) bn b0;rewrite h_ro_p_bn/=H_path/=;smt(getP @Block.WRing). - cut->/=:!rcons p0 bn = rcons (take i{2} p{2}) (nth witness p{2} i{2}). - + move:hpp0;apply absurd=>/=h. - cut:size p0 = size (take i{2} p{2}) by smt(size_rcons). - move:h;pose p' := take i{2} p{2};pose e := nth witness p{2} i{2}. - by move=>h h';move:p0 p' h' bn e h;apply seq2_ind=>//=/#. - move=>h_ro_p_bn. - cut[]_ hh4 _:=H_mh_spec. - cut:=hh4 p0 bn b0;rewrite h_ro_p_bn/==>[][];progress. - cut help:(sa{2} +^ nth witness p{2} i{2}, h{2}) <> (v +^ bn, hx) by rewrite/#. - exists v hx hy=>//=;rewrite getP;rewrite eq_sym in help;rewrite help/=H15/=. - by apply build_hpath_up=>//=. - move:H14 H15;rewrite!getP=>h_build_hpath_set. - case(hy = G1.chandle{2})=>//=[->>|hy_neq_ch]/=. - + move=>h;cut h_eq:v +^ bn = sa{2} +^ nth witness p{2} i{2} && hx = h{2}. - + cut/#:G1.mh{2}.[(v +^ bn, hx)] <> Some (b0, G1.chandle{2}). - cut[]_ hh2:=H_m_mh. - cut:=hh2 (v +^ bn) hx b0 G1.chandle{2}. - case(G1.mh{2}.[(v +^ bn, hx)] = Some (b0, G1.chandle{2}))=>//=. - rewrite negb_exists/=;progress; - rewrite negb_exists/=;progress; - rewrite negb_exists/=;progress; - rewrite negb_exists/=;progress;rewrite !negb_and. - by cut[]/#:=H_hs_spec. - cut[]eq_xor ->>:=h_eq. - move:h;rewrite h_eq/==>->>. - cut/#:!(p0 = (take i{2} p{2}) /\ bn = (nth witness p{2} i{2})) => - F.RO.m{2}.[rcons p0 bn] = Some b0. - move:H_h;case:f=>h_flag;last first. - - cut:=known_path_uniq _ _ _ sc{1} h{2} p0 v (take i{2} p{2}) sa{2} H2_pi_spec _ h_build_hpath_set _. - * rewrite getP/=h_flag. - by cut->//=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h_flag. - * by apply build_hpath_up=>//=. - move=>[]->>->>/=;apply absurd=>//=_. - cut->:bn = sa{2} +^ sa{2} +^ bn;smt(@Block). - cut[]hh1 hh2 hh3:=H_mh_spec. - cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) b0 p0 v h{2}. - rewrite h_build_hpath_set/=h_g1/=. - cut->/=:=ch_neq0 _ _ H_hs_spec. - cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h_flag. - move=>help;cut:= help _;1:smt(dom_hs_neq_ch). - move=>h_build_hpath_p0. - rewrite hh2 h_build_hpath_p0/==>h_neq. - exists v h{2}=>//=. - rewrite eq_xor h_g1/=;move:h_neq;apply absurd=>//=. - cut:=hh3 _ _ _ _ _ H_path h_build_hpath_p0. - cut->:bn = sa{2} +^ sa{2} +^ bn;smt(@Block). - move=>help;cut h_neq:! (v +^ bn = sa{2} +^ nth witness p{2} i{2} && hx = h{2}) by rewrite/#. - move:help;rewrite h_neq/==>h_g1_v_bn_hx. - cut[]hh1 hh2 hh3:=H_mh_spec. - cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) y1L p0 v hx. - rewrite h_build_hpath_set/=h_g1/=. - cut->/=:=ch_neq0 _ _ H_hs_spec. - by cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec H_h;smt(dom_hs_neq_ch). - progress. - + cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) y1L p0 v hx. - cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) y1L p' v' hx. - rewrite H14 H15/=. - cut->/=:=ch_neq0 _ _ H_hs_spec. - cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec H_h. - rewrite h_g1/=. - by cut[]:=H_mh_spec;smt(dom_hs_neq_ch). - cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) y1L p0 v hx. - cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) y1L p' v' hx. - rewrite H14 H15/=. - cut->/=:=ch_neq0 _ _ H_hs_spec. - cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec H_h. - rewrite h_g1/=. - by cut[]:=H_mh_spec;smt(dom_hs_neq_ch). - + exact H2_pi_spec. - + move=>l;rewrite dom_set in_fsetU1. - case(l \in dom F.RO.m{2})=>/=[H_dom i|H_not_dom ->> j]. - + by rewrite in_fsetU1;left;case:HINV=>/#. - cut H_pref:=all_prefixes_fset_of_INV _ _ _ _ _ _ _ _ _ _ _ HINV. - case(0 <= j)=>Hj0;last first. - + rewrite - case(l \in dom Redo.prefixes{1})=>//=hdom. - + cut[]_ h:=H_m_p. - cut[]sa' sc'[]h_pref h_pref2:=h _ hdom i0 _;1:rewrite/#. - exists sa' sc';rewrite!getP/=. - cut->/=:!take i0 l = rcons (take i{2} p{2}) (nth witness p{2} i{2}) by smt(in_dom). - rewrite h_pref/=. - cut->/=:!take (i0 + 1) l = rcons (take i{2} p{2}) (nth witness p{2} i{2}) by smt(in_dom take_size). - rewrite-h_pref2/=. - by cut->/=:! (sa' +^ nth witness l i0 = sa{2} +^ nth witness p{2} i{2} && sc' = sc{1}) by smt(in_dom take_size). - move=>->>;case(i0=i{2})=>[->>|i0_neq_i]//=. - + exists sa{2} sc{1}=>//=;rewrite!getP/=. - move:H1;rewrite !size_rcons !size_take//. - rewrite!nth_rcons-take_nth// !take_take!size_take 1:/#. - cut->/=hii:i{2}< size p{2} by rewrite/#. - rewrite !min_lel 1,2:/#. - by cut->/=:! take i{2} p{2} = take (i{2} + 1) p{2} by smt(size_take). - move:H1;rewrite !size_rcons !size_take//1:/#. - rewrite!nth_rcons-take_nth// !take_take!size_take 1:/#. - cut->/=hii:i{2}< size p{2} by rewrite/#. - rewrite i0_neq_i/=!min_lel 1,2:/#. - cut->/=:i0 < i{2} by rewrite/#. - rewrite!getP. - cut->/=:! take i0 p{2} = take (i{2} + 1) p{2} by smt(size_take). - cut[]_ h_pref:=H_m_p. - cut[]:= h_pref (take i{2} p{2}) _ i0 _;1:smt(in_dom);1:smt(size_take). - move=>b3 c3;rewrite!take_take!min_lel 1,2:/#=>[][]-> h. - cut->/=:!take (i0 + 1) p{2} = take (i{2} + 1) p{2} by smt(size_take). - exists b3 c3=>//=;rewrite getP/=. - cut/#:!(b3 +^ nth witness (take i{2} p{2}) i0 = sa{2} +^ nth witness p{2} i{2} && - c3 = sc{1}). - cut:(b3 +^ nth witness (take i{2} p{2}) i0, c3) \in dom PF.m{1};2:smt(in_dom). - cut:take (i0 + 1) p{2} \in dom Redo.prefixes{1};2:smt(in_dom). - cut->:take (i0 + 1) p{2} = take (i0 + 1) (take i{2} p{2});1:smt(take_take). - smt(in_dom take_oversize). - - split. - - search hs_spec 0. - smt(getP). - * rewrite/#. - * by rewrite!getP/=!oget_some. - * by rewrite !getP/=oget_some/#. - * rewrite!getP/=!oget_some/=(@take_nth witness)1:/# build_hpath_prefix/=. - cut[]HINV[]H_nil_in_dom[]->>[][]f H_h[]H_path H_F_RO:=H3 H6. - cut:=H8;rewrite in_dom/==>H_none. - cut:=lemma5' _ _ _ _ _ _ _ _ _ _ _ i{2} p{2} sa{2} sc{1} h{2} HINV _ _ _ _. - * rewrite/#. - * rewrite/#. - * rewrite/#. - * rewrite/#. - rewrite H_none/==>H_Gmh_none. - by cut->/=:=build_hpath_up G1.mh{2} _ _ y1L G1.chandle{2} _ _ _ H_path H_Gmh_none;smt(getP). - * rewrite/#. - * rewrite/#. - * by rewrite!getP/=!oget_some/=. - qed. - -(* * rewrite/#. *) -(* * rewrite/#. *) -(* * by rewrite !getP/=. *) -(* * by rewrite dom_set in_fsetU1/=. *) -(* * rewrite!getP/=!oget_some/=. *) -(* * admit. *) -(* * rewrite/#. *) -(* * rewrite!getP/=. *) -(* * rewrite/#. *) -(* * rewrite/#. *) -(* * rewrite/#. *) -(* * rewrite/#. *) -(* * rewrite/#. *) -(* * rewrite/#. *) -(* * rewrite/#. *) -(* * rewrite/#. *) -(* * rewrite/#. *) - - -(* rcondf{1}1;1:auto;progress. *) -(* - cut[][]HINV[]->>[]H_inv_prefixe[][]f H_flag[]H_path H_prefixe[]H_val[]H_pref_exists H_F_RO:=H6 H9. *) -(* cut[]hh0 hh1 hh2 hh3:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. search prefixe get_max_prefixe. *) -(* cut h_pref_exchange:=prefixe_exchange_prefixe_inv (elems (dom C.queries{m})) (elems (dom Redo.prefixes{hr})) p{m} _ _ _. *) -(* * move=>l2;rewrite-!memE=>H_dom;smt(in_dom). *) -(* * move=>l2;rewrite-!memE=>H_dom j;rewrite -memE. *) -(* case(0 <= j)=>hj0;last first. *) -(* + by rewrite take_le0 1:/#in_dom hh0. *) -(* case(j < size l2)=>hjsize;last first. *) -(* + by rewrite take_oversize 1:/#;smt(in_dom). *) -(* smt(in_dom). *) -(* * smt(memE). *) -(* by rewrite memE;apply prefixe_lt_size=>/#. *) -(* inline *;sp 2 0;wp=> /=. *) -(* conseq(: ={glob C, p, i} *) -(* /\ sa{1} = sa{2} +^ nth witness p{1} i{1} *) -(* /\ x{1} = (sa{1}, sc{1}) *) -(* /\ 0 <= i{2} < size p{2} *) -(* /\ Redo.prefixes{1}.[take i{1} p{1}] = Some (sa{2}, sc{1}) *) -(* /\ (take i{1} p{1} \in dom Redo.prefixes{1}) *) -(* /\ prefixe p{2} (get_max_prefixe p{2} (elems (dom C.queries{2}))) <= i{2} *) -(* /\ 0 <= counter{2} <= i{2} - *) -(* prefixe p{2} (get_max_prefixe p{2} (elems (dom C.queries{2}))) *) -(* /\ INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} *) -(* G1.mi{2} G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} *) -(* Redo.prefixes{1} C.queries{1} *) -(* /\ inv_prefixe_block C.queries{2} F.RO.m{2} *) -(* /\ (exists (f : flag), FRO.m{2}.[h{2}] = Some (sc{1}, f)) *) -(* /\ build_hpath G1.mh{2} (take i{2} p{2}) = Some (sa{2}, h{2}) *) -(* /\ (forall (j : int), 0 < j <= i{2} => take j p{2} \in dom F.RO.m{2}) *) -(* /\ (forall (l : block list), l \in dom Redo.prefixes{1} => *) -(* exists (l2 : block list), *) -(* l ++ l2 = p{2} \/ (l ++ l2 \in dom C.queries{1})) *) -(* /\ (if i{2} = 0 then sa{2} = b0 && h{2} = 0 *) -(* else F.RO.m{2}.[take i{2} p{2}] = Some sa{2}) *) -(* /\ ! (G1.bcol{2} \/ G1.bext{2}) *) -(* /\ (x \in dom PF.m){1} = ((sa +^ nth witness p i, h) \in dom G1.mh){2} ==>_); *) -(* progress;..-3:rewrite/#. *) -(* - move:H6;rewrite H9/=;progress. *) -(* rewrite !in_dom. *) -(* pose X := sa{2} +^ nth witness p{2} i{2}. *) -(* case (H6)=> -[Hu _ _] _ _ [] /(_ X sc{1}) Hpf ^ HG1 /(_ X h{2}) Hmh _ _ _ _ _. *) -(* case: {-1}(PF.m{1}.[(X,sc{1})]) (eq_refl (PF.m{1}.[(X,sc{1})])) Hpf Hmh. *) -(* + case (G1.mh{2}.[(X, h{2})]) => //= -[ya hy] Hpf. *) -(* by rewrite -negP => /(_ ya hy) [] ????[#];rewrite H11 /= => -[<-];rewrite Hpf. *) -(* move=> [ya yc] Hpf/(_ ya yc) [hx fx hy fy [#]] Hhx Hhy ^ /HG1 [xc fx0 yc0 fy0]. *) -(* rewrite Hhx => /= [#] 2!<<-;rewrite Hhy Hpf /= => -[] !->> _;progress. *) -(* by cut/=->>/#:=Hu h{2} hx(sc{1}, f)(sc{1}, fx)H11 Hhx. *) -(* if{1};2:(rcondt{2}1; first by auto=>/#);1:(rcondf{2}1;first by auto=>/#);last first. *) -(* + auto;progress. *) -(* * rewrite/#. *) -(* * rewrite/#. *) -(* * by rewrite!getP/=. *) -(* * smt(dom_set in_fsetU1). *) -(* * smt(dom_set in_fsetU1). *) -(* * smt(dom_set in_fsetU1). *) -(* * move:H9 H10;pose sa' := sa{2} +^ nth witness p{2} i{2};move=>H9 H10. *) -(* case (H6)=> -[Hu _ _] _ _ [] /(_ sa' sc{1}) Hpf ^ HG1 /(_ sa' h{2}) Hmh _ _ _ _ _. *) -(* cut:(sa', h{2}) \in dom G1.mh{2} by rewrite -H14 H15. *) -(* move:H10;rewrite!in_dom;progress. *) -(* case: {-1}(PF.m{1}.[(sa',sc{1})]) (eq_refl (PF.m{1}.[(sa',sc{1})])) Hpf Hmh=>//=. *) -(* move=> [ya yc] Hpf/(_ ya yc) [hx fx hy fy [#]] Hhx Hhy ^ /HG1 [xc fx0 yc0 fy0]. *) -(* rewrite Hhx => /= [#] 2!<<-;rewrite Hhy Hpf /= => -[] !->> _;progress. *) -(* by cut/=->>:=Hu h{2} hx(sc{1}, f)(sc{1}, fx) H0 Hhx;rewrite H14 !oget_some/=. *) -(* * cut->:=take_nth witness i{2} p{2};1:smt(size_take). *) -(* rewrite build_hpath_prefix H4/=;smt(get_oget). *) -(* * move:H9 H10;pose sa' := sa{2} +^ nth witness p{2} i{2};move=>H9 H10. *) -(* case (H)=> -[Hu _ _] _ _ [] /(_ sa' sc{1}) Hpf ^ HG1 /(_ sa' h{2}) Hmh _ _ _ _ _. *) -(* cut:(sa', h{2}) \in dom G1.mh{2} by rewrite -H9 H10. *) -(* move:H10;rewrite!in_dom;progress. *) -(* case: {-1}(PF.m{1}.[(sa',sc{1})]) (eq_refl (PF.m{1}.[(sa',sc{1})])) Hpf Hmh=>//=. *) -(* move=> [ya yc] Hpf/(_ ya yc) [hx fx hy fy [#]] Hhx Hhy ^ /HG1 [xc fx0 yc0 fy0]. *) -(* rewrite Hhx => /= [#] 2!<<-;rewrite Hhy Hpf /= => -[] !->> _;progress. *) -(* by cut/=->>:=Hu h{2} hx(sc{1}, f)(sc{1}, fx) H0 Hhx;rewrite H14 !oget_some/=Hhy/#. *) -(* * cut[] a b hab:exists a b, PF.m{1}.[(sa{2} +^ nth witness p{2} i{2}, sc{1})] = Some (a,b) by *) -(* move:H10;rewrite in_dom/#. *) -(* cut[]h1 h2 h3:=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ H. *) -(* cut->:=take_nth witness i{2} p{2};1:smt(size_take). *) -(* rewrite h2 H4/=;exists sa{2} h{2}=>/=;rewrite hab oget_some/=. *) -(* cut[]hh1 hh2:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ H. *) -(* cut[]c d e i[]hcd[]hei hG1:=hh1 _ _ _ _ hab. *) -(* cut[]hu _ _:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ H. *) -(* by cut/=<<-/#:=hu _ _ _ _ H0 hcd. *) -(* * split;..-2:case:H=>//=;progress. *) -(* split;first cut[]:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ H;smt(size_take getP size_eq0). *) -(* progress;cut[]_ h:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ H. *) -(* rewrite !getP. *) -(* move:H12;rewrite dom_set in_fsetU1. *) -(* case(l=take (i{2}+1) p{2})=>//=;last first. *) -(* + cut all_pref l_diff l_in_dom:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ H. *) -(* cut->/=:take i0 l <> take (i{2} + 1) p{2} by rewrite/#. *) -(* cut->/=/#:take (i0+1) l <> take (i{2} + 1) p{2} by rewrite/#. *) -(* move=>->>;rewrite!take_take. *) -(* cut hii0:i0 <= i{2} by move:H14;rewrite size_take /#. *) -(* rewrite!min_lel //1,2:/# nth_take 1,2:/#. *) -(* cut->/=:take i0 p{2} <> take (i{2} + 1) p{2} by smt(size_take). *) -(* case(i0=i{2})=>//=[->>|i_neq_i0]/=;1: by rewrite H3/=;smt(get_oget). *) -(* cut->/=:!take (i0 + 1) p{2} = take (i{2} + 1) p{2} by smt(size_take). *) -(* cut:=h _ H6 i0 _;1:smt(size_take). *) -(* by rewrite!take_take!min_lel 1,2:/# nth_take 1,2:/#. *) -(* rcondt{2}5;progress;1:auto;progress. *) -(* + cut[]hh1 hh2 hh3 :=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ H. *) -(* rewrite(@take_nth witness)1:/#in_dom/=. *) -(* cut:=hh2 (take i{hr} p{hr}) (nth witness p{hr} i{hr});rewrite H4/=. *) -(* cut:=H10;rewrite H9 in_dom/=. *) -(* case(F.RO.m{hr}.[rcons (take i{hr} p{hr}) (nth witness p{hr} i{hr})] = None)=>//=h. *) -(* cut[]b hb:exists b, F.RO.m{hr}.[rcons (take i{hr} p{hr}) (nth witness p{hr} i{hr})] = Some b *) -(* by move:h;case:(F.RO.m{hr}.[rcons (take i{hr} p{hr}) (nth witness p{hr} i{hr})])=>//=/#. *) -(* rewrite negb_forall/==>h2;rewrite hb/=;exists b=>//=. *) -(* rewrite negb_exists=>v/=. *) -(* rewrite negb_exists=>hx/=. *) -(* rewrite negb_exists=>hy/=. *) -(* case(sa{hr} = v)=>//=->>. *) -(* by case(h{hr} = hx)=>//=->>;rewrite h2. *) -(* swap{2}4-3;wp;progress=>/=. *) -(* conseq(:_==> hinv FRO.m{2} sc{2} = None *) -(* => y1{1} = r{2} *) -(* && build_hpath G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- *) -(* (r{2}, G1.chandle{2})] (take (i{2} + 1) p{2}) = Some (r{2}, G1.chandle{2}) *) -(* && sc{2} = y2{1} *) -(* && INV_CF_G1 FRO.m{2}.[G1.chandle{2} <- (sc{2}, Unknown)] (G1.chandle{2} + 1) *) -(* PF.m{1}.[x{1} <- (y1{1}, y2{1})] PF.mi{1}.[(y1{1}, y2{1}) <- x{1}] *) -(* G1.m{2} G1.mi{2} *) -(* G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- (r{2}, G1.chandle{2})] *) -(* G1.mhi{2}.[(r{2}, G1.chandle{2}) <- (sa{2} +^ nth witness p{2} i{2}, h{2})] *) -(* F.RO.m{2}.[take (i{2} + 1) p{2} <- r{2}] G1.paths{2} *) -(* Redo.prefixes{1}.[take (i{1} + 1) p{1} <- (y1{1}, y2{1})]);1:smt(getP oget_some). *) -(* conseq(:_==> (y1,y2){1} = (r,sc){2});-1:by sim. *) -(* move=> &1 &2[][]inv0[][]flag h_flag[]->>[]->>[][]->>->>[]Hi[]. *) -(* move=>prefixe_p_i[] hpath[]ro_p_i[];rewrite in_dom prefixe_p_i/==>[][]preifxe_p_i1. *) -(* rewrite!negb_or !in_dom/==>[][][]bcol bext h_pf_g1 h_pf b1 c1 b2 c2 []->>->> hinv_none/=. *) -(* move:preifxe_p_i1;cut->:=take_nth witness i{2} p{2};1:smt(size_take). *) -(* move=>prefixe_p_i1. *) -(* split;1:rewrite build_hpath_prefix/=. *) -(* * by exists sa{2} h{2};rewrite getP/=;apply build_hpath_up=>//=;smt(in_dom). *) -(* cut:=inv0;case. *) -(* move=>H_hs_spec H_inv_spec H_inv_spech H_m_mh H_mi_mhi H_incl_m H_incl_mi H_mh_spec H_pi_spec H_m_p h_build_hpath_rcons. *) -(* cut:hs_spec FRO.m{2}.[G1.chandle{2} <- (c2, Unknown)] (G1.chandle{2}+1) *) -(* && inv_spec G1.m{2} G1.mi{2} *) -(* && inv_spec G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- (b2, G1.chandle{2})] *) -(* G1.mhi{2}.[(b2, G1.chandle{2}) <- (sa{2} +^ nth witness p{2} i{2}, h{2})] *) -(* && m_mh FRO.m{2}.[G1.chandle{2} <- (c2, Unknown)] *) -(* PF.m{1}.[(sa{2} +^ nth witness p{2} i{2}, sc{1}) <- (b2, c2)] *) -(* G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- (b2, G1.chandle{2})] *) -(* && m_mh FRO.m{2}.[G1.chandle{2} <- (c2, Unknown)] *) -(* PF.mi{1}.[(b2, c2) <- (sa{2} +^ nth witness p{2} i{2}, sc{1})] *) -(* G1.mhi{2}.[(b2, G1.chandle{2}) <- (sa{2} +^ nth witness p{2} i{2}, h{2})] *) -(* && incl G1.m{2} PF.m{1}.[(sa{2} +^ nth witness p{2} i{2}, sc{1}) <- (b2, c2)] *) -(* && incl G1.mi{2} PF.mi{1}.[(b2, c2) <- (sa{2} +^ nth witness p{2} i{2}, sc{1})] *) -(* && pi_spec FRO.m{2}.[G1.chandle{2} <- (c2, Unknown)] *) -(* G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- (b2, G1.chandle{2})] G1.paths{2} *) -(* && mh_spec FRO.m{2}.[G1.chandle{2} <- (c2, Unknown)] G1.m{2} *) -(* G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- (b2, G1.chandle{2})] *) -(* F.RO.m{2}.[rcons (take i{2} p{2}) (nth witness p{2} i{2}) <- b2] *) -(* && m_p PF.m{1}.[(sa{2} +^ nth witness p{2} i{2}, sc{1}) <- (b2, c2)] *) -(* Redo.prefixes{1}.[rcons (take i{2} p{2}) (nth witness p{2} i{2}) <- (b2, c2)];last by progress;split=>//. *) -(* split. *) -(* + apply hs_addh;1:cut//:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ inv0. *) -(* by cut:=hinvP FRO.m{2} c2;rewrite hinv_none/=/#. *) -(* move=>H2_hs_spec;split. *) -(* + by cut:=invG_of_INV _ _ _ _ _ _ _ _ _ _ _ inv0. *) -(* move=>H2_inv_spec;split. *) -(* + apply inv_addm=>//;1:cut//:=inv_of_INV _ _ _ _ _ _ _ _ _ _ _ inv0. *) -(* - rewrite/#. *) -(* cut hj:=mi_mhi_of_INV _ _ _ _ _ _ _ _ _ _ _ inv0. *) -(* cut hs_sp:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ inv0. *) -(* apply (notin_hs_notin_dom2_mh FRO.m{2} PF.mi{1})=>//=. *) -(* by apply ch_notin_dom_hs=>//=. *) -(* move=>H2_inv_spech;split. *) -(* + cut//=:=(m_mh_addh_addm FRO.m{2} PF.m{1} G1.mh{2} h{2} (sa{2} +^ nth witness p{2} i{2}) sc{1} G1.chandle{2} b2 c2 flag Unknown _ _ _ _);rewrite//. *) -(* - by cut[]:=H_hs_spec. *) -(* by rewrite ch_notin_dom_hs. *) -(* move=>H2_m_mh;split. *) -(* + cut->//=:=(mi_mhi_addh_addmi FRO.m{2} PF.mi{1} G1.mhi{2} h{2} (sa{2} +^ nth witness p{2} i{2}) sc{1} G1.chandle{2} b2 c2 flag Unknown _ _ _ _);rewrite//. *) -(* - by cut/#:=hinvP FRO.m{2} c2. *) -(* by rewrite ch_notin_dom_hs. *) -(* move=>H2_mi_mhi;split. *) -(* + move=>x;rewrite getP/=. *) -(* by cut:=H_incl_m (sa{2} +^ nth witness p{2} i{2}, sc{1});smt(in_dom). *) -(* move=>H2_incl_m;split. *) -(* + move=>x;rewrite getP/=. *) -(* cut/#:G1.mi{2}.[(b2, c2)] = None;move=>{x}. *) -(* cut help//=:=hinvP FRO.m{2} c2. *) -(* rewrite hinv_none/= in help. *) -(* cut->//=:=notin_m_notin_Gm _ _ (b2,c2) H_incl_mi. *) -(* cut/#:forall a b, PF.mi{1}.[(b2,c2)] <> Some (a,b). *) -(* move=>a b;move:help;apply absurd=>//=;rewrite negb_forall//=. *) -(* cut[] inv1 inv2 hab:=H_mi_mhi. *) -(* by cut/#:=inv1 _ _ _ _ hab. *) -(* cut :=h_pf_g1;rewrite h_pf/=eq_sym neqF/==>h_g1. *) -(* move=>H2_incl_mi;split. print mh_spec. search pi_spec. *) -(* + (* pi_spec *) *) -(* split;progress. *) -(* - cut[]h:=H_pi_spec;cut:=h c p0 v;rewrite H/==>[][]h1[] h'1 h'2. *) -(* exists h1;rewrite -h'2 getP/=. *) -(* cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h'2. *) -(* by apply build_hpath_up=>//=. *) -(* move:H0;rewrite getP/==>hh0. *) -(* cut h0_neq_ch:h0 <> G1.chandle{2} by rewrite/#. *) -(* cut[]->:=H_pi_spec;rewrite-hh0 h0_neq_ch/=;exists h0=>/=. search build_hpath None. *) -(* cut:=H;cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) b2 p0 v h0. *) -(* rewrite h_g1/=H/=h0_neq_ch/=. *) -(* cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h_flag. *) -(* by cut->/=->//=:=ch_neq0 _ _ H_hs_spec;progress;cut[]hh1 hh2 hh3:=H_mh_spec;smt(dom_hs_neq_ch). *) -(* move=>H2_pi_spec;split. *) -(* + (* mh_spec *) *) -(* (* cut: *) *) -(* (* (forall (xa : block) (hx : handle) (ya : block) (hy : handle), *) *) -(* (* G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- (b2, G1.chandle{2})].[( *) *) -(* (* xa, hx)] = Some (ya, hy) => *) *) -(* (* exists (xc : capacity) (fx : flag) (yc : capacity) (fy : flag), *) *) -(* (* FRO.m{2}.[G1.chandle{2} <- (c2, Unknown)].[hx] = Some (xc, fx) /\ *) *) -(* (* FRO.m{2}.[G1.chandle{2} <- (c2, Unknown)].[hy] = Some (yc, fy) /\ *) *) -(* (* if fy = Known then G1.m{2}.[(xa, xc)] = Some (ya, yc) /\ fx = Known *) *) -(* (* else *) *) -(* (* exists (p1 : block list) (v : block), *) *) -(* (* F.RO.m{2}.[rcons (take i{2} p{2}) (nth witness p{2} i{2}) <- b2].[ *) *) -(* (* rcons p1 (v +^ xa)] = Some ya /\ build_hpath *) *) -(* (* G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- *) *) -(* (* (b2, G1.chandle{2})] p1 = Some (v, hx)) *) *) -(* (* && *) *) -(* (* (forall (p1 : block list) (v : block) (p2 : block list) (v' : block) (hx : handle), *) *) -(* (* build_hpath *) *) -(* (* G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- (b2, G1.chandle{2})] *) *) -(* (* p1 = Some (v, hx) => *) *) -(* (* build_hpath *) *) -(* (* G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- (b2, G1.chandle{2})] *) *) -(* (* p2 = Some (v', hx) => p1 = p2 /\ v = v') *) *) -(* (* && *) *) -(* (* (forall (p1 : block list) (bn b : block), *) *) -(* (* F.RO.m{2}.[rcons (take i{2} p{2}) (nth witness p{2} i{2}) <- b2].[rcons p1 bn] = *) *) -(* (* Some b <=> *) *) -(* (* exists (v : block) (hx hy : handle), build_hpath *) *) -(* (* G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- (b2, G1.chandle{2})] p1 = *) *) -(* (* Some (v, hx) /\ *) *) -(* (* G1.mh{2}.[(sa{2} +^ nth witness p{2} i{2}, h{2}) <- (b2, G1.chandle{2})].[(v +^ bn, hx)] = Some (b, hy)); *) *) -(* (* last by progress;split=>/#. *) *) -(* split=>//=. *) -(* - move=>x hx y hy;rewrite !getP. *) -(* case((x, hx) = (sa{2} +^ nth witness p{2} i{2}, h{2}))=>//=. *) -(* * move=>[->> ->>][<<- <<-]/=. *) -(* cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h_flag. *) -(* rewrite h_flag/=. *) -(* exists sc{1} flag c2 Unknown=>//=. *) -(* by exists (take i{2} p{2}) (sa{2})=>//=;rewrite getP Block.WRing.addKr/=;apply build_hpath_up=>//=/#. *) -(* move=> neq h1. *) -(* cut[]hh1 hh2 hh3:=H_mh_spec. *) -(* cut[]xc hxx yc hyc []h2[]h3 h4:=hh1 _ _ _ _ h1. *) -(* cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h2. *) -(* cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h3. *) -(* rewrite h2 h3/=;exists xc hxx yc hyc=>//=. *) -(* move:h4;case(hyc = Known)=>//=neq2[]p0 b[]hp0 hb. *) -(* exists p0 b;rewrite getP. *) -(* cut->/=:=build_hpath_up _ _ _ b2 G1.chandle{2} _ _ _ hb h_g1. *) -(* cut/#:!rcons p0 (b +^ x) = rcons (take i{2} p{2}) (nth witness p{2} i{2});move:neq;apply absurd=>//=h'. *) -(* cut<<-:take i{2} p{2}=p0 by rewrite/#. *) -(* cut hbex:b +^ x = nth witness p{2} i{2} by rewrite/#. *) -(* by cut:=hb;rewrite hpath/==>[][->>->>]/=;rewrite-hbex Block.WRing.addKr/=. *) -(* - progress. search build_hpath. *) -(* * move:H;rewrite getP/=. *) -(* case(p0 = (take i{2} p{2}))=>[->>|hpp0]. search build_hpath None. *) -(* + cut->/=:=build_hpath_up _ _ _ b2 G1.chandle{2} _ _ _ hpath h_g1. *) -(* case(bn = (nth witness p{2} i{2}))=>[->>/=->>|hbni]/=. *) -(* - by exists sa{2} h{2} G1.chandle{2}=>//=;rewrite getP/=. *) -(* cut->/=:!rcons (take i{2} p{2}) bn = rcons (take i{2} p{2}) (nth witness p{2} i{2}). *) -(* - move:hbni;apply absurd=>//=h. *) -(* cut->:bn = nth witness (rcons (take i{2} p{2}) bn) i{2}. *) -(* * by rewrite nth_rcons size_take /#. *) -(* by rewrite h nth_rcons size_take /#. *) -(* move=>h_ro_p_bn. *) -(* cut[]_ hh4 _:=H_mh_spec. *) -(* by cut:=hh4 (take i{2} p{2}) bn b;rewrite h_ro_p_bn/=hpath/=;smt(getP @Block.WRing). *) -(* cut->/=:!rcons p0 bn = rcons (take i{2} p{2}) (nth witness p{2} i{2}). *) -(* + move:hpp0;apply absurd=>/=h. *) -(* cut:size p0 = size (take i{2} p{2}) by smt(size_rcons). *) -(* move:h;pose p' := take i{2} p{2};pose e := nth witness p{2} i{2}. *) -(* by move=>h h';move:p0 p' h' bn e h;apply seq2_ind=>//=/#. *) -(* move=>h_ro_p_bn. *) -(* cut[]_ hh4 _:=H_mh_spec. *) -(* cut:=hh4 p0 bn b;rewrite h_ro_p_bn/==>[][];progress. *) -(* cut help:(sa{2} +^ nth witness p{2} i{2}, h{2}) <> (v +^ bn, hx) by rewrite/#. *) -(* exists v hx hy=>//=;rewrite getP;rewrite eq_sym in help;rewrite help/=H0/=. *) -(* by apply build_hpath_up=>//=. *) -(* move:H H0;rewrite!getP=>h_build_hpath_set. *) -(* case(hy = G1.chandle{2})=>//=[->>|hy_neq_ch]/=. *) -(* + move=>h;cut h_eq:v +^ bn = sa{2} +^ nth witness p{2} i{2} && hx = h{2}. *) -(* + cut/#:G1.mh{2}.[(v +^ bn, hx)] <> Some (b, G1.chandle{2}). search hs_spec. *) -(* cut[]_ hh2:=H_m_mh. *) -(* cut:=hh2 (v +^ bn) hx b G1.chandle{2}. *) -(* case(G1.mh{2}.[(v +^ bn, hx)] = Some (b, G1.chandle{2}))=>//=. *) -(* rewrite negb_exists/=;progress; *) -(* rewrite negb_exists/=;progress; *) -(* rewrite negb_exists/=;progress; *) -(* rewrite negb_exists/=;progress;rewrite !negb_and. *) -(* by cut[]/#:=H_hs_spec. *) -(* cut[]eq_xor ->>:=h_eq. *) -(* move:h;rewrite h_eq/==>->>. *) -(* cut/#:!(p0 = (take i{2} p{2}) /\ bn = (nth witness p{2} i{2})) => *) -(* F.RO.m{2}.[rcons p0 bn] = Some b. *) -(* move:h_flag;case:flag=>h_flag;last first. *) -(* - cut:=known_path_uniq _ _ _ sc{1} h{2} p0 v (take i{2} p{2}) sa{2} H2_pi_spec _ h_build_hpath_set _. *) -(* * rewrite getP/=h_flag. *) -(* by cut->//=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h_flag. search build_hpath. *) -(* * by apply build_hpath_up=>//=. *) -(* move=>[]->>->>/=;smt(@Block.WRing). *) -(* cut[]hh1 hh2 hh3:=H_mh_spec. *) -(* cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) b p0 v h{2}. *) -(* rewrite h_build_hpath_set/=h_g1/=. *) -(* cut->/=:=ch_neq0 _ _ H_hs_spec. *) -(* cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h_flag. *) -(* move=>help;cut:= help _;1:smt(dom_hs_neq_ch). *) -(* move=>h_build_hpath_p0. *) -(* rewrite hh2 h_build_hpath_p0/==>h_neq. *) -(* exists v h{2}=>//=. *) -(* rewrite eq_xor h_g1/=;move:h_neq;apply absurd=>//=. *) -(* by cut:=hh3 _ _ _ _ _ hpath h_build_hpath_p0;smt(@Block.WRing). *) -(* move=>help;cut h_neq:! (v +^ bn = sa{2} +^ nth witness p{2} i{2} && hx = h{2}) by rewrite/#. *) -(* move:help;rewrite h_neq/==>h_g1_v_bn_hx. *) -(* cut[]hh1 hh2 hh3:=H_mh_spec. *) -(* cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) b2 p0 v hx. *) -(* rewrite h_build_hpath_set/=h_g1/=. *) -(* cut->/=:=ch_neq0 _ _ H_hs_spec. *) -(* by cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h_flag;smt(dom_hs_neq_ch). *) -(* progress. *) -(* + cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) b2 p0 v hx. *) -(* cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) b2 p' v' hx. *) -(* rewrite H H0/=. *) -(* cut->/=:=ch_neq0 _ _ H_hs_spec. *) -(* cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h_flag. *) -(* rewrite h_g1/=. *) -(* by cut[]:=H_mh_spec;smt(dom_hs_neq_ch). *) -(* cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) b2 p0 v hx. *) -(* cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness p{2} i{2}) b2 p' v' hx. *) -(* rewrite H H0/=. *) -(* cut->/=:=ch_neq0 _ _ H_hs_spec. *) -(* cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h_flag. *) -(* rewrite h_g1/=. *) -(* by cut[]:=H_mh_spec;smt(dom_hs_neq_ch). *) -(* move=>H2_mh_spec;split;progress. *) -(* + by cut[]:=H_m_p;smt(getP size_rcons size_eq0 size_ge0). *) -(* move:H;rewrite dom_set in_fsetU1. *) -(* case(l \in dom Redo.prefixes{1})=>//=hdom. *) -(* + cut[]_ h:=H_m_p. *) -(* cut[]sa' sc'[]h_pref h_pref2:=h _ hdom i0 _;1:rewrite/#. *) -(* exists sa' sc';rewrite!getP/=. *) -(* cut->/=:!take i0 l = rcons (take i{2} p{2}) (nth witness p{2} i{2}) by smt(in_dom). *) -(* rewrite h_pref/=. *) -(* cut->/=:!take (i0 + 1) l = rcons (take i{2} p{2}) (nth witness p{2} i{2}) by smt(in_dom take_size). *) -(* rewrite-h_pref2/=. *) -(* by cut->/=:! (sa' +^ nth witness l i0 = sa{2} +^ nth witness p{2} i{2} && sc' = sc{1}) by smt(in_dom take_size). *) -(* move=>->>;case(i0=i{2})=>[->>|i0_neq_i]//=. *) -(* + exists sa{2} sc{1}=>//=;rewrite!getP/=. *) -(* move:H1;rewrite !size_rcons !size_take//. *) -(* rewrite!nth_rcons-take_nth// !take_take!size_take 1:/#. *) -(* cut->/=hii:i{2}< size p{2} by rewrite/#. *) -(* rewrite !min_lel 1,2:/#. *) -(* by cut->/=:! take i{2} p{2} = take (i{2} + 1) p{2} by smt(size_take). *) -(* move:H1;rewrite !size_rcons !size_take//1:/#. *) -(* rewrite!nth_rcons-take_nth// !take_take!size_take 1:/#. *) -(* cut->/=hii:i{2}< size p{2} by rewrite/#. *) -(* rewrite i0_neq_i/=!min_lel 1,2:/#. *) -(* cut->/=:i0 < i{2} by rewrite/#. *) -(* rewrite!getP. *) -(* cut->/=:! take i0 p{2} = take (i{2} + 1) p{2} by smt(size_take). *) -(* cut[]_ h_pref:=H_m_p. *) -(* cut[]:= h_pref (take i{2} p{2}) _ i0 _;1:smt(in_dom);1:smt(size_take). *) -(* move=>b3 c3;rewrite!take_take!min_lel 1,2:/#=>[][]-> h. *) -(* cut->/=:!take (i0 + 1) p{2} = take (i{2} + 1) p{2} by smt(size_take). *) -(* exists b3 c3=>//=;rewrite getP/=. *) -(* cut/#:!(b3 +^ nth witness (take i{2} p{2}) i0 = sa{2} +^ nth witness p{2} i{2} && *) -(* c3 = sc{1}). *) -(* cut:(b3 +^ nth witness (take i{2} p{2}) i0, c3) \in dom PF.m{1};2:smt(in_dom). *) -(* cut:take (i0 + 1) p{2} \in dom Redo.prefixes{1};2:smt(in_dom). *) -(* cut->:take (i0 + 1) p{2} = take (i0 + 1) (take i{2} p{2});1:smt(take_take). *) -(* smt(in_dom take_oversize). *) -(* qed. *) - - -equiv PFf_Cf (D<:DISTINGUISHER): SqueezelessSponge(PF).f ~ G1'(D).C.f : - ! (G1.bcol{2} \/ G1.bext{2}) /\ - ={p} /\ - INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} - G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} Redo.prefixes{1} ==> - ! (G1.bcol{2} \/ G1.bext{2}) => - ={res} /\ INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} - G1.mi{2} G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} Redo.prefixes{1}. -proof. -exists*p{1};elim* =>input;case(input = [])=>input_nil;1:rewrite input_nil;2:conseq(PFf_Cf_not_nil D);progress. -proc;inline*;auto;sp. -by rcondf{1}1;auto;rcondf{2}1;auto;rcondf{2}1;auto. -qed. - - -section AUX. - - declare module D : DISTINGUISHER {PF, RO, G1, Redo}. - - axiom D_ll (F <: DFUNCTIONALITY{D}) (P <: DPRIMITIVE{D}): - islossless P.f => islossless P.fi => islossless F.f => - islossless D(F, P).distinguish. - - equiv CF_G1' : CF(D).main ~ G1'(D).main: - ={glob D} ==> !(G1.bcol \/ G1.bext){2} => ={res}. - proof. - proc. - call (_: G1.bcol \/ G1.bext, - INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} - G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} F.RO.m{2} - G1.paths{2} Redo.prefixes{1}). - (* lossless D *) - + exact/D_ll. - (** proofs for G1.S.f *) - (* equivalence up to bad of PF.f and G1.S.f *) - + conseq (_: !G1.bcol{2} - /\ !G1.bext{2} - /\ ={x} - /\ INV_CF_G1 FRO.m{2} G1.chandle{2} - PF.m{1} PF.mi{1} - G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} - F.RO.m{2} G1.paths{2} Redo.prefixes{1} - ==> !G1.bcol{2} - => !G1.bext{2} - => ={res} - /\ INV_CF_G1 FRO.m{2} G1.chandle{2} - PF.m{1} PF.mi{1} - G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} - F.RO.m{2} G1.paths{2} Redo.prefixes{1}). - + by move=> &1 &2; rewrite negb_or. - + by move=> &1 &2 _ ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? [#]; rewrite negb_or. - (* For now, everything is completely directed by the syntax of - programs, so we can *try* to identify general principles of that - weird data structure and of its invariant. I'm not sure we'll ever - be able to do that, though. *) - (* We want to name everything for now, to make it easier to manage complexity *) +proc;sp;if;auto. +call(: !G1.bcol{2} + /\ !G1.bext{2} + /\ ={arg} + /\ INV_CF_G1 FRO.m{2} G1.chandle{2} + PF.m{1} PF.mi{1} + G1.m{2} G1.mi{2} + G1.mh{2} G1.mhi{2} + F.RO.m{2} G1.paths{2} + Redo.prefixes{1} C.queries{2} + ==> if G1.bcol{2} \/ G1.bext{2} + then ([] \in dom C.queries{2}) + else ={res} + /\ INV_CF_G1 FRO.m{2} G1.chandle{2} + PF.m{1} PF.mi{1} + G1.m{2} G1.mi{2} + G1.mh{2} G1.mhi{2} + F.RO.m{2} G1.paths{2} + Redo.prefixes{1} C.queries{2});auto. exists * FRO.m{2}, G1.chandle{2}, PF.m{1}, PF.mi{1}, G1.m{2}, G1.mi{2}, G1.mh{2}, G1.mhi{2}, - F.RO.m{2}, G1.paths{2}, Redo.prefixes{1}, + F.RO.m{2}, G1.paths{2}, Redo.prefixes{1}, C.queries{2}, x{2}. - elim * => hs0 ch0 PFm PFmi G1m G1mi G1mh G1mhi ro0 pi0 pref [] x1 x2. + elim * => hs0 ch0 PFm PFmi G1m G1mi G1mh G1mhi ro0 pi0 pref queries [] x1 x2. (* poor man's extraction of a fact from a precondition *) - case @[ambient]: {-1}(INV_CF_G1 hs0 ch0 PFm PFmi G1m G1mi G1mh G1mhi ro0 pi0 pref) - (eq_refl (INV_CF_G1 hs0 ch0 PFm PFmi G1m G1mi G1mh G1mhi ro0 pi0 pref)); last first. + case @[ambient]: {-1}(INV_CF_G1 hs0 ch0 PFm PFmi G1m G1mi G1mh G1mhi ro0 pi0 pref queries) + (eq_refl (INV_CF_G1 hs0 ch0 PFm PFmi G1m G1mi G1mh G1mhi ro0 pi0 pref queries)); last first. + by move=> h; exfalso=> &1 &2 [#] <*>; rewrite h. move=> /eqT inv0; proc; case @[ambient] {-1}(PFm.[(x1,x2)]) (eq_refl (PFm.[(x1,x2)])). + move=> PFm_x1x2. @@ -2550,11 +1536,12 @@ section AUX. /\ ro0 = F.RO.m{2} /\ pi0 = G1.paths{2} /\ pref = Redo.prefixes{1} + /\ queries = C.queries{2} /\ (x1,x2) = x{2} /\ !G1.bcol{2} /\ !G1.bext{2} /\ ={x, y1, y2} - /\ INV_CF_G1 hs0 ch0 PFm PFmi G1m G1mi G1mh G1mhi ro0 pi0 pref). + /\ INV_CF_G1 hs0 ch0 PFm PFmi G1m G1mi G1mh G1mhi ro0 pi0 pref queries). + by auto. case @[ambient]: {-1}(getflag hs0 x2) (eq_refl (getflag hs0 x2)). + rewrite getflagP_none => x2f_notin_rng_hs0; rcondt{2} 3. @@ -2576,7 +1563,7 @@ section AUX. have ^/m_mh_of_INV [] _ + /hs_of_INV [] _ _ h_handles := inv0. by move=> /(_ x1 G1.chandle{2} xa xh) h /h [] xc xf yc yf [#] /h_handles. case: (x2 <> y2{2} /\ (forall f h, hs0.[h] <> Some (y2{2},f))). - + auto=> &1 &2 [#] !<<- -> -> !->> {&1} /= _ x2_neq_y2 y2_notin_hs _ _. + + auto=> &1 &2 [#] !<<- -> -> !->> /= _ x2_neq_y2 y2_notin_hs. rewrite getP /= oget_some /= -addzA /=. rewrite (@huniq_hinvK_h ch0 hs0.[ch0 <- (x2,Known)] x2); 2:by rewrite getP. + move=> @/huniq h1 h2 [c1 f1] [c2 f2]; rewrite !getP /=. @@ -2585,16 +1572,21 @@ section AUX. + by move=> + _ + [#] <*> - <*>; move: (x2f_notin_rng_hs0 f1 h1). have /hs_of_INV [] + _ _ _ _ - h := inv0. by apply/h; rewrite getP. - by rewrite oget_some; exact/lemma1. + rewrite !oget_some;rewrite in_dom;cut[]_ -> _ _ _ /=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. + smt(lemma1). conseq (_: _ ==> G1.bcol{2})=> //=. - auto=> &1 &2 [#] !<<- -> _ ->> !<<- _ /=. + + by auto=> &1 &2 [#] !<<- bad1 bad2 -> _ ->> !<<- _ /=/>; + rewrite in_dom;cut[]_ ->_ _ _/=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. + auto=> &1 &2 [#] !<<- -> _ ->> !<<- _ /=/>. case: (hinvP hs0.[ch0 <- (x2,Known)] y2{1})=> //= -> /=. move=> hs0_spec; split=> [|f]. + by have:= hs0_spec ch0 Known; rewrite getP. move=> h; have:= hs0_spec h f; rewrite getP; case: (h = ch0)=> [<*>|//=]. by move=> _; rewrite -negP; have /hs_of_INV [] _ _ H /H {H}:= inv0. case; rewrite getflagP_some; 1,3:by have /hs_of_INV []:= inv0. - + by move=> x2_is_U; conseq (_: G1.bext{2})=> //=; auto=> &1 &2 />; rewrite x2_is_U. + + move=> x2_is_U; conseq (_: G1.bext{2})=> //=; auto=> &1 &2 /> _ _ hinv0 . + + by rewrite in_dom;cut[]_ -> _ _ _/=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. + rewrite/#. move=> x2_is_K; rcondf{2} 3; 1:by move=> &1; auto. have:= x2_is_K; rewrite in_rng=> - [hx] hs0_hx. seq 0 3: ( hs0 = FRO.m{2} @@ -2608,13 +1600,14 @@ section AUX. /\ ro0 = F.RO.m{2} /\ pi0 = G1.paths{2} /\ pref = Redo.prefixes{1} + /\ queries = C.queries{2} /\ (x1,x2) = x{2} /\ !G1.bcol{2} /\ !G1.bext{2} /\ ={x,y1,y2} /\ y{2} = (y1,y2){2} /\ hx2{2} = hx - /\ INV_CF_G1 hs0 ch0 PFm PFmi G1m G1mi G1mh G1mhi ro0 pi0 pref). + /\ INV_CF_G1 hs0 ch0 PFm PFmi G1m G1mi G1mh G1mhi ro0 pi0 pref queries). + auto=> &1 &2 /> _ -> /= _; split. + move: x2_is_K; rewrite in_rng /= => -[hx2] hs_hx2. rewrite in_rng negb_exists /==> h; rewrite -negP=> hs_h. @@ -2630,9 +1623,10 @@ section AUX. by rewrite hs0_hx=> [#] <*>; rewrite PFm_x1x2. rcondf{2} 1. + by move=> &m; auto=> //= &hr [#] <*>; rewrite x1hx_notin_G1m. - auto=> &1 &2 [#] !<<- -> -> !->> _ /= hinv_y2_none. - rewrite getP /= oget_some /=; apply/lemma2=> //. - + by case: (hinvP hs0 y2{2})=> [_ + f h|//=] - ->. + auto=> &1 &2 [#] !<<- -> -> !->> _ /=. + rewrite in_dom;cut[]_ -> _ _ _ /=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. + case(hinv hs0 y2{2} = None)=>//=h; + rewrite getP /= oget_some /=;smt(lemma2 hinvP). move=> [p0 v0] ^ pi_x2. have /pi_of_INV [] -> [hx2] [#] Hpath hs_hx2:= inv0. rcondt{2} 1. by move=> &m; auto=> &hr [#] !<<- _ _ ->> /= _; rewrite in_dom pi_x2. rcondf{2} 6. @@ -2662,7 +1656,8 @@ section AUX. auto => &m1 &m2 [#] !<- _ _ -> /= _ y1L -> y2L -> /=. rewrite !getP_eq pi_x2 !oget_some /=. have /hs_of_INV [] Hu _ _:= inv0; have -> := huniq_hinvK_h _ _ _ Hu hs_hx2. - rewrite oget_some => /= ? Hy2L . + rewrite oget_some in_dom => /= ;cut[]_->_ _ _/=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. + case(G1.bcol{m2} \/ hinv hs0 y2L <> None)=>//=;rewrite !negb_or/==>[][]? hinv0[]? hinv1. case:inv0=> Hhs Hinv HinvG Hmmh Hmmhi Hincl Hincli Hmh Hpi Hmp. have Hhx2:= dom_hs_neq_ch _ _ _ _ _ Hhs hs_hx2. have mh_hx2: G1mh.[(x1,hx2)] = None. @@ -2676,7 +1671,7 @@ section AUX. + by apply hs_addh => //;have /# := hinvP hs0 y2L. + apply inv_addm=> //; case: {-1}(G1mi.[(y1L,y2L)]) (eq_refl G1mi.[(y1L,y2L)])=> //. move=> [x1L x2L] ^G1mi_y; rewrite -Hincli 1:G1mi_y//. - case: Hmmhi Hy2L => H _ + /H {H} [hx fx hy fy] [#]. + case: Hmmhi hinv0 => H _ + /H {H} [hx fx hy fy] [#]. by case: (hinvP hs0 y2L)=> [_ ->|//]/#. + by apply inv_addm=>//; apply (ch_notin_dom2_mh _ _ Hmmhi Hhs). + by apply (m_mh_addh_addm _ Hmmh _ hs_hx2)=>//;apply ch_notin_dom_hs. @@ -2741,11 +1736,13 @@ section AUX. split;1: by move=> [_ /(dom_hs_neq_ch _ _ _ _ _ Hhs)]. by move=> /= [_ <<-];move:Hc. split. - by cut[]/#:=Hmp. - cut[]_ h l hdom i hi:=Hmp. - cut[]b c[]->h':=h l hdom i hi. - by exists b c=>//=;rewrite getP/=-h';smt(in_dom take_oversize). - + + by cut[]/#:=Hmp. + + by cut[]/#:=Hmp. + + cut[]_ _ h _ _ l hdom i hi:=Hmp. + cut[]b c[]->h':=h l hdom i hi. + by exists b c=>//=;rewrite getP/=-h';smt(in_dom take_oversize). + + by cut[]/#:=Hmp. + + by cut[]/#:=Hmp. move=> [xa xc] PFm_x1x2. rcondf{1} 1; 1:by auto=> &hr [#] !<<- _ _ ->>; rewrite in_dom PFm_x1x2. have /m_mh_of_INV [] + _ - /(_ _ _ _ _ PFm_x1x2) := inv0. move=> [hx2 fx2 hy2 fy2] [#] hs_hx2 hs_hy2 G1mh_x1hx2. @@ -2759,12 +1756,18 @@ section AUX. move=> [xc0 xf0 yc0 yf0] [#]; rewrite hs_hx2 hs_hy2=> [#] !<<- [#] !<<- {xc0 xf0 yc0 yf0}. by case: fy2 hs_hy2 G1mh_x1hx2=> //=; rewrite x1x2_notin_G1m. case @[ambient]: fx2 hs_hx2=> hs_hx2. - + swap{2} 3 -2; seq 0 1: (G1.bext{2}); last by inline*; if{2}; auto; smt (@Block @Capacity). - by auto=> ? ? [#] !<<- _ -> ->> _ /=; rewrite in_rng; exists hx2. + + swap{2} 3 -2; seq 0 1: (queries = C.queries{2} /\ G1.bext{2}). + - by auto=> ? ? [#] !<<- _ -> ->> _ /=; rewrite in_rng; exists hx2. + conseq(:_==> (! (G1.bcol{2} \/ G1.bext{2})) => oget PF.m{1}.[x{1}] = y{2} /\ + INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} + G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} Redo.prefixes{1} C.queries{2}); + progress;2..-2:rewrite/#. + - by rewrite in_dom;cut[]_->_ _ _/=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. + inline*; if{2}; auto; smt (@Block @Capacity). have /mh_of_INV []/(_ _ _ _ _ G1mh_x1hx2) + _ _:= inv0. move=> [xc0 xf0 yc0 yf0] [#]; rewrite hs_hx2 hs_hy2=> [#] !<<- [#] !<<- {xc0 xf0 yc0 yf0} /= [p0 v0] [#] Hro Hpath. have /pi_of_INV [] /(_ x2 p0 v0) /iffRL /(_ _) := inv0. - + by exists hx2. + + by exists hx2=>/#. move=> pi_x2; rcondt{2} 1; 1:by auto=> &hr [#] <*>; rewrite in_dom pi_x2. inline F.RO.get. rcondf{2} 4; first by auto=> &hr [#] !<<- _ _ ->> _ /=; rewrite pi_x2 oget_some /= in_dom Hro. @@ -2779,65 +1782,970 @@ section AUX. move=> _ _ _ _; rewrite PFm_x1x2 pi_x2 !oget_some //=. rewrite (@huniq_hinvK_h hx2 hs0 x2) // ?oget_some. + by have /hs_of_INV []:= inv0. - rewrite Hro G1mh_x1hx2 hs_hy2 ?oget_some //= => _. - exact/(@lemma3 _ _ _ _ _ _ _ _ _ _ _ _ _ hx2 _ _ hy2). - (* lossless PF.f *) - + move=> &2 _; proc; if=> //=; wp; rnd predT; rnd predT; auto. - smt (@Block.DBlock @Capacity.DCapacity). - (* lossless and do not reset bad G1.S.f *) - + move=> _; proc; if; auto. - conseq (_: _ ==> G1.bcol \/ G1.bext); 1:smt (). - inline *; if=> //=; wp; rnd predT; wp; rnd predT; auto. - + smt (@Block.DBlock @Capacity.DCapacity). - smt (@Block.DBlock @Capacity.DCapacity). - (** proofs for G1.S.fi *) - (* equiv PF.P.fi G1.S.fi *) - + transitivity G1(D).S.fi - (! (G1.bcol{2} \/ G1.bext{2}) /\ ={x} /\ - INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} G1.mh{2} - G1.mhi{2} F.RO.m{2} G1.paths{2} Redo.prefixes{1} - ==> ! (G1.bcol{2} \/ G1.bext{2}) => ={res} /\ - INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} G1.mh{2} - G1.mhi{2} F.RO.m{2} G1.paths{2} Redo.prefixes{1}) - (={glob G1(D).S, x} ==> ={glob G1(D).S, res});progress;1:rewrite/#. - - by conseq (eq_fi D)=> /#. - by proc;inline*;sim. - (* lossless PF.P.fi *) - + move=> &2 _; proc; if=> //=; wp; rnd predT; rnd predT; auto. - smt (@Block.DBlock @Capacity.DCapacity). - (* lossless and do not reset bad G1.S.fi *) - + move=> _; proc; if; 2:by auto. - by wp; do 2!rnd predT; auto => &hr [#]; smt (@Block.DBlock @Capacity.DCapacity). - (** proofs for G1.C.f *) - (* equiv PF.C.f G1.C.f *) - + conseq(PFf_Cf D);auto;progress. - (* lossless PF.C.f *) - + move=> &2 _; proc; inline *; while (true) (size p - i); auto. - + if; 1:auto=>/#. - sp; if; 2: auto=>/#. - by wp; do 2!rnd predT; auto; smt (size_behead @Block.DBlock @Capacity.DCapacity). - smt (size_ge0). - (* lossless and do not reset bad G1.C.f *) - + move=> _; proc; inline *; wp. - case(p = [])=>//=. - - by sp;rcondf 1;auto;sp;rcondf 1;auto. - rcondt 6;first by auto;while(p <> []);auto;sp;if;auto. - wp;rnd predT; auto. + rewrite Hro G1mh_x1hx2 hs_hy2 ?oget_some //=in_dom. + cut[]_->_ _ _//=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. + case((x2, Unknown) \in rng hs0)=>//=_. + exact/(@lemma3 _ _ _ _ _ _ _ _ _ _ _ _ _ _ hx2 _ _ hy2). + progress;cut[]//=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H1;smt(in_dom). +qed. + +lemma head_nth (w:'a) l : head w l = nth w l 0. +proof. by case l. qed. + +lemma drop_add (n1 n2:int) (l:'a list) : 0 <= n1 => 0 <= n2 => drop (n1 + n2) l = drop n2 (drop n1 l). +proof. + move=> Hn1 Hn2;elim: n1 Hn1 l => /= [ | n1 Hn1 Hrec] l;1: by rewrite drop0. + by case: l => //= a l /#. +qed. + +lemma behead_drop (l:'a list) : behead l = drop 1 l. +proof. by case l => //= l;rewrite drop0. qed. + +lemma incl_upd_nin (m1 m2:('a,'b)fmap) x y: incl m1 m2 => !mem (dom m2) x => incl m1 m2.[x <- y]. +proof. + move=> Hincl Hdom w ^/Hincl <- => Hw. + rewrite getP_neq // -negP => ->>. + by move: Hdom;rewrite in_dom. +qed. + + + +module G1'(D:DISTINGUISHER) = { + var m, mi : smap + var mh, mhi : hsmap + var chandle : int + var paths : (capacity, block list * block) fmap + var bext, bcol : bool + + module M = { + + proc f(p : block list): block = { + var sa, sa', sc; + var h, i, counter <- 0; + sa <- b0; + sc <- c0; + while (i < size p ) { + if (mem (dom mh) (sa +^ nth witness p i, h)) { + (sa, h) <- oget mh.[(sa +^ nth witness p i, h)]; + } else { + if (counter < size p - prefixe p (get_max_prefixe p (elems (dom C.queries)))) { + sc <$ cdistr; + bcol <- bcol \/ hinv FRO.m sc <> None; + sa' <@ F.RO.get(take (i+1) p); + sa <- sa +^ nth witness p i; + mh.[(sa,h)] <- (sa', chandle); + mhi.[(sa',chandle)] <- (sa, h); + (sa,h) <- (sa',chandle); + FRO.m.[chandle] <- (sc,Unknown); + chandle <- chandle + 1; + counter <- counter + 1; + } + } + i <- i + 1; + } + sa <- F.RO.get(p); + return sa; + } + } + + module S = { + + proc f(x : state): state = { + var p, v, y, y1, y2, hy2, hx2; + + if (!mem (dom m) x) { + if (mem (dom paths) x.`2) { + (p,v) <- oget paths.[x.`2]; + y1 <- F.RO.get (rcons p (v +^ x.`1)); + y2 <$ cdistr; + } else { + y1 <$ bdistr; + y2 <$ cdistr; + } + y <- (y1, y2); + bext <- bext \/ mem (rng FRO.m) (x.`2, Unknown); + if (!(mem (rng FRO.m) (x.`2, Known))) { + FRO.m.[chandle] <- (x.`2, Known); + chandle <- chandle + 1; + } + hx2 <- oget (hinvK FRO.m x.`2); + if (mem (dom mh) (x.`1, hx2) /\ in_dom_with FRO.m (oget mh.[(x.`1,hx2)]).`2 Unknown) { + hy2 <- (oget mh.[(x.`1, hx2)]).`2; + y <- (y.`1, (oget FRO.m.[hy2]).`1); + FRO.m.[hy2] <- (y.`2, Known); + m.[x] <- y; + mi.[y] <- x; + } else { + bcol <- bcol \/ hinv FRO.m y.`2 <> None; + hy2 <- chandle; + chandle <- chandle + 1; + FRO.m.[hy2] <- (y.`2, Known); + m.[x] <- y; + mh.[(x.`1, hx2)] <- (y.`1, hy2); + mi.[y] <- x; + mhi.[(y.`1, hy2)] <- (x.`1, hx2); + } + if (mem (dom paths) x.`2) { + (p,v) <- oget paths.[x.`2]; + paths.[y.`2] <- (rcons p (v +^ x.`1), y.`1); + } + } else { + y <- oget m.[x]; + } + return y; + } + + proc fi(x : state): state = { + var y, y1, y2, hx2, hy2; + + if (!mem (dom mi) x) { + bext <- bext \/ mem (rng FRO.m) (x.`2, Unknown); + if (!(mem (rng FRO.m) (x.`2, Known))) { + FRO.m.[chandle] <- (x.`2, Known); + chandle <- chandle + 1; + } + hx2 <- oget (hinvK FRO.m x.`2); + y1 <$ bdistr; + y2 <$ cdistr; + y <- (y1,y2); + if (mem (dom mhi) (x.`1,hx2) /\ + in_dom_with FRO.m (oget mhi.[(x.`1,hx2)]).`2 Unknown) { + (y1,hy2) <- oget mhi.[(x.`1, hx2)]; + y <- (y.`1, (oget FRO.m.[hy2]).`1); + FRO.m.[hy2] <- (y.`2, Known); + mi.[x] <- y; + m.[y] <- x; + } else { + bcol <- bcol \/ hinv FRO.m y.`2 <> None; + hy2 <- chandle; + chandle <- chandle + 1; + FRO.m.[hy2] <- (y.`2, Known); + mi.[x] <- y; + mhi.[(x.`1, hx2)] <- (y.`1, hy2); + m.[y] <- x; + mh.[(y.`1, hy2)] <- (x.`1, hx2); + } + } else { + y <- oget mi.[x]; + } + return y; + } + + } + + proc main(): bool = { + var b; + + F.RO.m <- map0; + m <- map0; + mi <- map0; + mh <- map0; + mhi <- map0; + bext <- false; + bcol <- false; + + (* the empty path is initially known by the adversary to lead to capacity 0^c *) + FRO.m <- map0.[0 <- (c0, Known)]; + paths <- map0.[c0 <- ([<:block>],b0)]; + chandle <- 1; + b <@ D(M,S).distinguish(); + return b; + } +}. + + +lemma lemma5 hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes queries i (p : block list) b c h: + INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes queries + => 0 <= i < size p + => take (i + 1) p \in dom prefixes + => prefixes.[take i p] = Some (b,c) + => (exists f, hs.[h] = Some (c,f)) + => exists b' c' h', + Pm.[(b +^ nth witness p i, c)] = Some (b',c') /\ + mh.[(b +^ nth witness p i, h)] = Some (b',h'). +proof. +move=>Hinv H_size H_take_iS H_take_i H_hs_h. +cut[]_ _ H _ _:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ Hinv. +cut[]sa sc:=H _ H_take_iS i _;1:smt(size_take). +rewrite!take_take !min_lel//= 1:/# nth_take 1,2:/#H_take_i=>[][]/=[->>->>] H_pm. +cut[]b' c' H_Pm:exists b' c', Pm.[(sa +^ nth witness p i, sc)] = Some (b',c') by smt(in_dom). +exists b' c';rewrite -H_Pm/=. +cut[]h_Pm _:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ Hinv. +cut[]h' f' hy fy[]H_h'[]H_hy H_mh:=h_Pm _ _ _ _ H_Pm. +cut[]h_huniq _ _:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ Hinv. +cut[]f H_h := H_hs_h. +cut/=<<-:=h_huniq _ _ _ _ H_h H_h'. +by rewrite H_mh/=/#. +qed. + + +lemma lemma5' hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes queries i (p : block list) b c h: + INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes queries + => 0 <= i < size p + => prefixes.[take i p] = Some (b,c) + => (exists f, hs.[h] = Some (c,f)) + => (exists b' c' h', + Pm.[(b +^ nth witness p i, c)] = Some (b',c') /\ + mh.[(b +^ nth witness p i, h)] = Some (b',h')) \/ + (Pm.[(b +^ nth witness p i, c)] = None /\ + mh.[(b +^ nth witness p i, h)] = None). +proof. +move=>Hinv H_size H_take_i H_hs_h. +case(Pm.[(b +^ nth witness p i, c)] = None)=>//=H_Pm. ++ right;move:H_Pm;apply absurd=>H_mh. + cut[]b1 h1 H_mh1:exists b1 h1, mh.[(b +^ nth witness p i, h)] = Some (b1,h1) by rewrite/#. + cut[]H_Pm H_Gmh:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ Hinv. + by cut/#:=H_Gmh _ _ _ _ H_mh1. +cut[]b1 c1 H_Pm1:exists b1 c1, Pm.[(b +^ nth witness p i, c)] = Some (b1,c1) + by exists (oget Pm.[(b +^ nth witness p i, c)]).`1 + (oget Pm.[(b +^ nth witness p i, c)]).`2;smt(get_oget in_dom). +cut[]H_P_m H_Gmh:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ Hinv. +cut:=H_P_m _ _ _ _ H_Pm1. +by cut[]/#:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ Hinv. +qed. + + +equiv PFf_Cf (D<:DISTINGUISHER): + + DFRestr(SqueezelessSponge(PF)).f ~ DFRestr(G1(DRestr(D)).M).f : + + ! (G1.bcol{2} \/ G1.bext{2}) /\ + ={arg} /\ ={glob C} /\ + INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} + G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} Redo.prefixes{1} C.queries{2} + ==> + if G1.bcol{2} \/ G1.bext{2} + then ([] \in dom C.queries{2}) + else ={glob C} /\ ={res} /\ + INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} + G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} Redo.prefixes{1} C.queries{2}. +proof. + proc;sp;inline*;sp. + if;1,3:auto;if;1,3:auto;swap{1}4;swap{2}11;sp;wp 1 5. + sp;conseq(:_==> ! (G1.bcol{2} \/ G1.bext{2}) => + ={glob C, sa} /\ + INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} G1.mh{2} + G1.mhi{2} F.RO.m{2} G1.paths{2} Redo.prefixes{1} C.queries{2}.[bs{1} <- sa{1}] /\ + F.RO.m.[p]{2} = Some sa{2});progress. + + by rewrite dom_set in_fsetU1 in_dom;left;cut[]_->_ _ _//=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H0. + + smt(dom_set in_fsetU1). + + smt(dom_set in_fsetU1). + + smt(dom_set in_fsetU1). + seq 1 1: + (={i, p, glob C} /\ i{1} = size p{1} /\ p{2} = bs{1} /\ + (!(G1.bcol{2} \/ G1.bext{2}) => + (INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} + G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} Redo.prefixes{1} + C.queries{2}.[bs{1} <- sa{1}] + /\ ={sa} /\ F.RO.m.[p]{2} = Some sa{1})));last first. + + case : (! (G1.bcol{2} \/ G1.bext{2}));last first. + - by conseq(:_==>true);progress;auto;smt(DBlock.dunifin_ll DCapacity.dunifin_ll take_size). + by rcondf{2}3;auto;smt(in_dom DBlock.dunifin_ll DCapacity.dunifin_ll take_size). + + conseq(:_==> ={i, p, glob C} /\ i{1} = size p{1} /\ p{2} = bs{1} /\ + (!(G1.bcol{2} \/ G1.bext{2}) => + (INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} + G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} Redo.prefixes{1} + C.queries{2}.[take i{2} bs{1} <- sa{1}] + /\ ={sa} /\ F.RO.m.[p]{2} = Some sa{1})));1:smt(take_size). + + splitwhile{1} 1 : i < prefixe p (get_max_prefixe p (elems (dom C.queries))). + splitwhile{2} 1 : i < prefixe p (get_max_prefixe p (elems (dom C.queries))). + + seq 1 1 : (={p, i, glob C, bs} /\ bs{2} = p{2} /\ + (prefixe p (get_max_prefixe p (elems (dom C.queries))) = i){2} /\ + (Redo.prefixes.[take i p]{1} = Some (sa,sc){1}) /\ + (take i p \in dom Redo.prefixes){1} /\ + (C.queries.[[]] = Some b0){1} /\ + (! p{2} \in dom C.queries{2}) /\ + (!(G1.bcol{2} \/ G1.bext{2}) => + (INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} + G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} Redo.prefixes{1} + C.queries{2} /\ + ={sa} /\ counter{2} = 0 /\ + (exists f, FRO.m.[h]{2} = Some (sc{1}, f)) /\ + (build_hpath G1.mh (take i p) = Some (sa,h)){2} /\ + if i{2} = 0 then (sa,h){2} = (b0, 0) + else F.RO.m.[take i p]{2} = Some sa{1})) /\ + (i{2} = 0 => sa{1} = b0) /\ 0 < size p{2}). + + while(={p, i, glob C} /\ bs{2} = p{2} /\ (i{2} = 0 => sa{1} = b0) /\ + (0 <= i <= prefixe p (get_max_prefixe p (elems (dom C.queries)))){2} /\ + (Redo.prefixes.[take i p]{1} = Some (sa,sc){1}) /\ + (take i p \in dom Redo.prefixes){1} /\ + (C.queries.[[]] = Some b0){1} /\ + (! p{2} \in dom C.queries{2}) /\ + (!(G1.bcol{2} \/ G1.bext{2}) => + (INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} + G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} Redo.prefixes{1} + C.queries{2} /\ + ={sa} /\ counter{2} = 0 /\ + (exists f, FRO.m.[h]{2} = Some (sc{1}, f)) /\ + (build_hpath G1.mh (take i p) = Some (sa,h)){2} /\ + if i{2} = 0 then (sa,h){2} = (b0, 0) + else F.RO.m.[take i p]{2} = Some sa{1})) /\ 0 < size p{2});last first. + - auto;progress. + * smt(@Prefixe). + * by cut[]:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H0;smt(take0 in_dom). + * by cut[]:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H0;smt(take0 in_dom). + * by cut[]:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H0;smt(take0 in_dom set_eq). + * by cut[]:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H0;smt(take0 in_dom). + * smt. + * by cut[]:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H0;smt(take0 in_dom size_take size_eq0). + * smt(prefixe_sizel). + + case(G1.bcol{2} \/ G1.bext{2}). + - by if{1};auto;conseq(:_==> (G1.bcol{2} \/ G1.bext{2}));1,3:smt(get_oget in_dom getP); + (if{2};2:if{2});auto;1:smt(DBlock.dunifin_ll DCapacity.dunifin_ll); + sp;if{1};auto;smt(DBlock.dunifin_ll DCapacity.dunifin_ll). + conseq(: ={p, i, glob C} /\ bs{2} = p{2} /\ (i{2} = 0 => sa{1} = b0) /\ + 0 <= i{2} <= prefixe p{2} (get_max_prefixe p{2} (elems (dom C.queries{2}))) /\ + Redo.prefixes{1}.[take i{1} p{1}] = Some (sa{1}, sc{1}) /\ + (C.queries.[[]] = Some b0){1} /\ (! p{2} \in dom C.queries{2}) /\ + (take i{1} p{1} \in dom Redo.prefixes{1}) /\ + (! (G1.bcol{2} \/ G1.bext{2}) => + INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} + G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} Redo.prefixes{1} + C.queries{2} /\ + ={sa} /\ + counter{2} = 0 /\ + (exists (f : flag), FRO.m{2}.[h{2}] = Some (sc{1}, f)) /\ + build_hpath G1.mh{2} (take i{2} p{2}) = Some (sa{2}, h{2}) /\ + if i{2} = 0 then (sa{2}, h{2}) = (b0, 0) + else F.RO.m{2}.[take i{2} p{2}] = Some sa{1}) /\ + (i{1} < size p{1} /\ + i{1} < prefixe p{1} (get_max_prefixe p{1} (elems (dom C.queries{1})))) /\ + i{2} < size p{2} /\ + i{2} < prefixe p{2} (get_max_prefixe p{2} (elems (dom C.queries{2}))) /\ + ! (G1.bcol{2} \/ G1.bext{2}) /\ (take (i+1) p \in dom Redo.prefixes){1} /\ + 0 < size p{2} + ==>_);progress. + - cut:=prefixe_gt0_mem p{2} (elems (dom C.queries{2})) _;1:rewrite/#. + rewrite-memE=>H_dom_q. + cut[]HINV[]->>/=[]->>/=[]H_h[]H_path H_F_RO:=H6 H12. + cut[]_ _ h1 h2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + cut:=h2 (get_max_prefixe p{2} (elems (dom C.queries{2}))) _;1:rewrite /#. + move=>[]c; + cut H_dom_p:get_max_prefixe p{2} (elems (dom C.queries{2})) \in dom Redo.prefixes{1} by smt(in_dom). + cut->/=:=prefixe_take_leq p{2} (get_max_prefixe p{2} (elems (dom C.queries{2}))) (i{2}+1) _;1:rewrite/#. + smt(in_dom take_oversize prefixe_sizer). + rcondt{1}1;1:auto;progress. + rcondt{2}1;1:auto;progress. + - cut[]HINV[]->>/=[]->>/=[]H_h[]H_path H_F_RO:=H6 H11. + cut//=:=lemma5 _ _ _ _ _ _ _ _ _ _ _ _ i{hr} p{hr} sa{hr} sc{m} h{hr} HINV _ _ _ _. + * by rewrite H0/=H7/=. + * smt(in_dom). + * rewrite/#. + * rewrite/#. + by move=>[]b2 c2 h2[]H_PFm H_Gmh;rewrite in_dom H_Gmh/=. + auto;progress. + - rewrite /#. + - rewrite /#. + - rewrite /#. + - smt(get_oget in_dom). + - cut[]HINV[]->>/=[]->>/=[]H_h[]H_path H_F_RO/#:=H6 H11. + - cut[]HINV[]->>/=[]->>/=[]H_h[]H_path H_F_RO:=H6 H11. + cut[]H01 H02 H_pref1 H_pref2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + cut//=:=lemma5 _ _ _ _ _ _ _ _ _ _ _ _ i{2} p{2} sa{2} sc{1} h{2} HINV _ _ _ _. + * by rewrite H0/=H7/=. + * smt(in_dom). + * rewrite/#. + * rewrite/#. + move=>[]b2 c2 h2[]H_PFm H_Gmh. + rewrite H_Gmh/=oget_some/=. + cut[]b6 c6[]:=H_pref1 _ H12 i{2} _;1:smt(size_take). + by rewrite!take_take !min_lel 1,2:/# nth_take 1,2:/# H2/==>[][]->>->><-;rewrite H_PFm oget_some. + - rewrite/#. + - cut[]HINV[]->>/=[]->>/=[]H_h[]H_path H_F_RO:=H6 H11. + cut[]H01 H02 H_pref1 H_pref2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + cut//=:=lemma5 _ _ _ _ _ _ _ _ _ _ _ _ i{2} p{2} sa{2} sc{1} h{2} HINV _ _ _ _. + * by rewrite H0/=H7/=. + * smt(in_dom). + * rewrite/#. + * rewrite/#. + move=>[]b2 c2 h2[]H_PFm H_Gmh. + cut[]b6 c6[]:=H_pref1 _ H12 i{2} _;1:smt(size_take). + rewrite!take_take !min_lel 1,2:/# nth_take 1,2:/# H2/=H_Gmh oget_some=>[][]<<-<<-<-. + rewrite H_PFm oget_some/=. + by cut[]help1 help2/# :=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + - cut[]HINV[]->>/=[]->>/=[]H_h[]H_path H_F_RO:=H6 H11. + cut[]H01 H02 H_pref1 H_pref2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + cut//=:=lemma5 _ _ _ _ _ _ _ _ _ _ _ _ i{2} p{2} sa{2} sc{1} h{2} HINV _ _ _ _. + * by rewrite H0/=H7/=. + * smt(in_dom). + * rewrite/#. + * rewrite/#. + move=>[]b2 c2 h2[]H_PFm H_Gmh. + by rewrite H_Gmh/=oget_some/=(@take_nth witness) 1:/# build_hpath_prefix/#. + - rewrite/#. + - rewrite/#. + - cut[]HINV[]->>/=[]->>/=[]H_h[]H_path H_F_RO:=H6 H11. + cut[]H01 H02 H_pref1 H_pref2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + cut//=:=lemma5 _ _ _ _ _ _ _ _ _ _ _ _ i{2} p{2} sa{2} sc{1} h{2} HINV _ _ _ _. + * by rewrite H0/=H7/=. + * smt(in_dom). + * rewrite/#. + * rewrite/#. + move=>[]b2 c2 h2[]H_PFm H_Gmh. + cut[]b6 c6[]:=H_pref1 _ H12 i{2} _;1:smt(size_take). + rewrite!take_take !min_lel 1,2:/# nth_take 1,2:/# H2/==>[][]<<-<<-<-. + rewrite H_PFm/=oget_some/=(@take_nth witness)1:/#. + by cut[]help1 help2/# :=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + + alias{1} 1 prefixes = Redo.prefixes;sp. + alias{2} 1 bad1 = G1.bcol;sp. + (* conseq(:_ ==> ={i, p, glob C} /\ i{1} = size p{1} /\ *) + (* p{2} = bs{1} /\ (! (G1.bcol{2} \/ G1.bext{2}) => *) + (* INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} *) + (* G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} prefixes{1} *) + (* C.queries{2} /\ (! (bad1{2} \/ G1.bext{2})) /\ *) + (* Redo.prefixes{1}.[take i{2} p{2}] = Some (sa{1}, sc{1}) /\ *) + (* (forall l, l \in dom prefixes{1} => *) + (* prefixes{1}.[l] = Redo.prefixes{1}.[l]) /\ *) + (* (forall l, l \in dom Redo.prefixes{1} => *) + (* exists l2, l ++ l2 = take i{2} p{2} \/ l ++ l2 \in dom C.queries{2}) /\ *) + (* (forall l, l \in dom Redo.prefixes{1} => *) + (* l \in dom prefixes{1} \/ exists j, 0 <= j < i{2} /\ take j p{2} = l) /\ *) + (* (forall j, 0 <= j < i{1} => exists (sa : block) (sc : capacity), *) + (* Redo.prefixes{1}.[take j p{2}] = Some (sa, sc) /\ *) + (* PF.m{1}.[(sa +^ nth witness p{2} j, sc)] = *) + (* Redo.prefixes{1}.[take (j + 1) p{2}]) /\ *) + (* ={sa} /\ F.RO.m{2}.[p{2}] = Some sa{1}));progress. *) + (* + cut[]HINV[]H_bad1[]H_prefixe[]H_pref[]H_pref2[]H_pref3[]H_pref4[]->> H_m_R0:=H6 H7. *) + (* cut[]HINV'[]->>[]->>[]H_h[]H_path H_F_RO:=H3 H_bad1. *) + (* rewrite take_size;split;..-2:by case:HINV=>//=. *) + (* cut[]H01 H02 H_m_p1 H_m_p2 H_m_p3:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ *) + (* HINV;split=>//=. *) + (* - cut[]H01' H02' H_m_p1' H_m_p2' H_m_p3':=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ *) + (* HINV'. *) + (* smt(in_dom). *) + (* - smt(in_dom getP). *) + (* - move=>l H_l_dom j Hj. *) + (* cut[]:=H_pref3 _ H_l_dom. *) + (* * move=>H_dom;cut:=H_m_p1 l H_dom j Hj;smt(in_dom take_oversize). *) + (* move=>[]k [][Hk0 Hk] <<-. *) + (* move:Hj;rewrite size_take 1:/# Hk/==>[][]Hj0 Hjk. *) + (* rewrite!take_take!min_lel// 1,2:/# nth_take 1,2:/#;smt(in_dom take_oversize). *) + (* - smt(dom_set in_fsetU1 getP dom_set in_dom take_size). *) + (* move=>l H_dom;cut:=H_pref3 l H_dom. *) + (* case(l \in dom Redo.prefixes{1})=>H_dom1/=;1:smt(dom_set in_fsetU1). *) + (* move=>[]j[][]Hj0 Hj_size <<-. *) + (* by exists (drop j p{2});rewrite cat_take_drop dom_set in_fsetU1. *) + (* + by rewrite/#. *) + (* + by rewrite/#. *) + + while ( ={i, p, C.queries, C.c} + /\ prefixe p{2} (get_max_prefixe p{2} (elems (dom C.queries{2}))) <= + i{1} <= size p{1} + /\ Redo.prefixes{1}.[take i{2} p{2}] = Some (sa{1}, sc{1}) + /\ p{2} = bs{1} + /\ (! p{2} \in dom C.queries{2}) + /\ (! (G1.bcol{2} \/ G1.bext{2}) => + INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} + G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} Redo.prefixes{1} + C.queries{2}.[take i{2} bs{1} <- sa{1}] + /\ ! (bad1{2} \/ G1.bext{2}) + /\ m_p PF.m{1} prefixes{1} C.queries{2} + /\ (forall (l : block list), + l \in dom prefixes{1} => prefixes{1}.[l] = Redo.prefixes{1}.[l]) + /\ (forall (l : block list), l \in dom Redo.prefixes{1} => + (l \in dom prefixes{1}) \/ + exists (j : int), 0 <= j <= i{2} /\ take j p{2} = l) + /\ ={sa} + /\ counter{2} <= i{2} - prefixe p{2} + (get_max_prefixe p{2} (elems (dom C.queries{2}))) + /\ (exists (f : flag), FRO.m{2}.[h{2}] = Some (sc{1}, f)) + /\ build_hpath G1.mh{2} (take i{2} p{2}) = Some (sa{2}, h{2}) + /\ (if i{2} = 0 then (sa{2}, h{2}) = (b0, 0) + else F.RO.m{2}.[take i{2} p{2}] = Some sa{1}) + /\ (i{2} < size p{2} => ! take (i{2}+1) p{2} \in dom Redo.prefixes{1})));last first. + + auto;progress. + - smt(prefixe_sizel). + - cut[]HINV _:=H3 H6;split;..-2:case:HINV=>//=. + by cut[]Hmp01 Hmp02 Hmp1 Hmp2 Hmp3:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV; + split=>//=;smt(take0 getP dom_set in_fsetU1 take_oversize take_le0). + - by cut[]HINV _:=H3 H6;cut:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + - rewrite/#. + - rewrite/#. + - rewrite/#. + - rewrite/#. + - rewrite/#. + - rewrite/#. + - rewrite/#. + - rewrite/#. + - cut[]HINV[]->>[]->>[]H_h[]H_path H_F_RO:=H3 H6. + cut[]H01 H02 Hmp1 Hmp2 Hmp3:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + cut H_pref_eq:=prefixe_exchange_prefixe_inv (elems (dom C.queries{2})) + (elems (dom Redo.prefixes{1})) p{2} _ _ _. + * smt(memE in_dom). + * smt(memE in_dom take_oversize size_take take_take nth_take take_le0). + * smt(memE in_dom take_oversize size_take take_take nth_take take_le0). + by rewrite memE prefixe_lt_size 1:-H_pref_eq /#. + - rewrite/#. + - rewrite/#. + - rewrite/#. + - smt(take_size). + + case : (! (G1.bcol{2} \/ G1.bext{2}));last first. + - wp 1 1=>/=. + conseq(:_==> Redo.prefixes{1}.[take (i{1}+1) p{1}] = Some (sa{1}, sc{1}) + /\ (take (i{1} + 1) p{1} \in dom Redo.prefixes{1}) + /\ (G1.bcol{2} \/ G1.bext{2}));1:smt(prefixe_ge0). + if{1};sp;2:if{1};(if{2};2:if{2});sp;auto;5:swap{2}4-3;auto; + smt(getP get_oget dom_set in_fsetU1 DBlock.dunifin_ll DCapacity.dunifin_ll). + rcondf{1}1;1:auto=>/#. + sp;wp. + if{1};2:rcondt{2}1;first last;3:rcondf{2}1;..3:auto. + + progress. + cut[]HINV[]Hbad[]HINV0[]Hp1[]Hp2[]->>[]H_counter[]H_h[]H_path[]H_F_RO H_take_not_in:=H3 H6. + cut:=lemma5' _ _ _ _ _ _ _ _ _ _ _ _ i{hr} bs{m} sa{hr} sc{m} h{hr} HINV _ _ _. + - smt(prefixe_ge0). + - exact H1. + - exact H_h. + by cut:=H7;rewrite !in_dom=>->/=/#. + + progress. + - rewrite/#. + - rewrite/#. + - by rewrite getP. + - cut[]HINV[]Hbad[]H_m_p0[]Hp1[]Hp2[]->>[]H_counter[]H_h[]H_path[]H_F_RO H_take_not_in:=H3 H6. + split;..-2:case:HINV=>//=. + cut[]Hmp01 Hmp02 Hmp1 Hmp2 Hmp3:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV;split=>//=. + * smt(getP size_take size_eq0 size_ge0 prefixe_ge0). + * by cut[]_ Hmp02' _ _ _:=H_m_p0; + smt(getP size_take size_eq0 size_ge0 prefixe_ge0 take0). + * move=>l;rewrite!dom_set !in_fsetU1. + case(l = take (i{2} + 1) bs{1})=>//=[->>|]. + + move=>j;rewrite size_take;1:smt(prefixe_ge0). + cut->/=:(if i{2} + 1 < size bs{1} then i{2} + 1 else size bs{1}) = i{2} + 1 by rewrite/#. + move=>[]H0j HjiS;rewrite!getP. + cut->/=:! take j (take (i{2} + 1) bs{1}) = take (i{2} + 1) bs{1} by smt(size_take). + rewrite!take_take!min_lel 1,2:/# nth_take 2:/#;1:smt(prefixe_ge0). + case(j < i{2})=>Hij. + - cut->/=:!take (j + 1) bs{1} = take (i{2} + 1) bs{1} by smt(size_take). + by cut:=Hmp1(take i{2} bs{1}) _ j _; + smt(in_dom take_take nth_take prefixe_ge0 size_take). + cut->>:j = i{2} by rewrite/#. + by exists sa{2} sc{1};rewrite H1/=;smt(get_oget). + move=>h H_dom j []Hi0 Hisize;rewrite!getP. + cut->/=:!take j l = take (i{2} + 1) bs{1} by smt(in_dom take_oversize size_take take_take). + by cut->/=/#:!take (j+1) l = take (i{2} + 1) bs{1} + by smt(in_dom take_oversize size_take take_take). + * move=>l;rewrite dom_set in_fsetU1. + case(l = take (i{2} + 1) bs{1})=>//=[->>|]. + + by rewrite!getP/=oget_some/=/#. + move=>h H_dom;rewrite!getP h/=. + cut[]H2mp01 H2mp02 H2mp1 H2mp2 H2mp3:=H_m_p0. + rewrite-Hp1;1:smt(in_dom). + by apply H2mp2. + move=>l;rewrite !dom_set !in_fsetU1. + case(l = take (i{2} + 1) bs{1})=>//=[->>|]. + + by exists []; smt(cats0 dom_set in_fsetU1). + move=>H_neq H_dom;cut[]l1:=Hmp3 _ H_dom;rewrite!dom_set!in_fsetU1;case=>H_case. + + exists l1;by rewrite in_fsetU1 H_case. + exists (rcons l1 (nth witness bs{1} i{2}));rewrite in_fsetU1;right. search rcons (++). + by rewrite-rcons_cat (@take_nth witness);smt(prefixe_ge0). + - rewrite/#. + - rewrite/#. + - smt(in_dom getP). + - move:H9;rewrite dom_set in_fsetU1;case;smt(prefixe_ge0). + - cut[]HINV[]Hbad[]HINV0[]Hp1[]Hp2[]->>[]H_counter[]H_h[]H_path[]H_F_RO H_take_not_in:=H3 H6. + cut:=lemma5' _ _ _ _ _ _ _ _ _ _ _ _ i{2} bs{1} sa{2} sc{1} h{2} HINV _ _ _. + - smt(prefixe_ge0). + - exact H1. + - exact H_h. + by cut:=H7;rewrite !in_dom=>->/=/#. + - rewrite/#. + - cut[]HINV[]Hbad[]HINV0[]Hp1[]Hp2[]->>[]H_counter[]H_h[]H_path[]H_F_RO H_take_not_in:=H3 H6. + cut:=lemma5' _ _ _ _ _ _ _ _ _ _ _ _ i{2} bs{1} sa{2} sc{1} h{2} HINV _ _ _. + - smt(prefixe_ge0). + - exact H1. + - exact H_h. + cut:=H7;rewrite !in_dom=>->/=[]b4 c4 h4[]H_PFm H_Gmh;rewrite H_PFm H_Gmh !oget_some/=. + cut[]_ help:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + cut:=help _ _ _ _ H_Gmh. + by cut[]f H_h':=H_h;rewrite H_h'/==>[][]a b c d[][]->>->>[];rewrite H_PFm/==>[]h'->>/#. + - cut[]HINV[]Hbad[]HINV0[]Hp1[]Hp2[]->>[]H_counter[]H_h[]H_path[]H_F_RO H_take_not_in:=H3 H6. + cut:=lemma5' _ _ _ _ _ _ _ _ _ _ _ _ i{2} bs{1} sa{2} sc{1} h{2} HINV _ _ _. + - smt(prefixe_ge0). + - exact H1. + - exact H_h. + cut:=H7;rewrite !in_dom=>->/=[]b4 c4 h4[]H_PFm H_Gmh. + rewrite (@take_nth witness);1:smt(prefixe_ge0). + by rewrite build_hpath_prefix H_path/=;smt(get_oget in_dom). + - smt(prefixe_ge0). + - smt(prefixe_ge0). + - cut[]HINV[]Hbad[]H_m_p0[]Hp1[]Hp2[]->>[]H_counter[]H_h[]H_path[]H_F_RO H_take_not_in:=H3 H6. + cut:=lemma5' _ _ _ _ _ _ _ _ _ _ _ _ i{2} bs{1} sa{2} sc{1} h{2} HINV _ _ _. + - smt(prefixe_ge0). + - exact H1. + - exact H_h. + cut:=H7;rewrite !in_dom=>->/=[]b4 c4 h4[]H_PFm H_Gmh. + rewrite(@take_nth witness);1:smt(prefixe_ge0). + cut[]_ help H_uniq_path:=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + by rewrite help H_path;smt(get_oget in_dom). + - cut[]HINV[]Hbad[]H_m_p0[]Hp1[]Hp2[]->>[]H_counter[]H_h[]H_path[]H_F_RO H_take_not_in:=H3 H6. + rewrite dom_set in_fsetU1 negb_or/=;split;2:smt(size_take prefixe_ge0 take_oversize). + cut:=Hp2 (take (i{2} + 1 + 1) bs{1}). + pose P:= _ \/ _;cut/#:!P;rewrite/P;clear P;rewrite negb_or/=negb_exists/=;split. + * cut:=prefixe_exchange_prefixe_inv(elems (dom C.queries{2}))(elems (dom prefixes{1}))bs{1} _ _ _. + + by cut[]:=H_m_p0;smt(in_dom memE). + + cut[]Hmp01 Hmp02 Hmp1 Hmp2 Hmp3:=H_m_p0. + by cut:=all_prefixes_of_m_p _ _ _ H_m_p0;smt(memE in_dom). + + by cut[]:=H_m_p0;smt(memE in_dom). + by move=>H_pref_eq;rewrite memE prefixe_lt_size//= -H_pref_eq/#. + by move=>j;case(0<=j<=i{2})=>//=[][]Hj0 Hji;smt(size_take prefixe_ge0 take_le0). + + progress. + cut[]HINV[]Hbad[]H_m_p0[]Hp1[]Hp2[]->>[]H_counter[]H_h[]H_path[]H_F_RO H_take_not_in:=H3 H6. + cut:=lemma5' _ _ _ _ _ _ _ _ _ _ _ _ i{hr} bs{m} sa{hr} sc{m} h{hr} HINV _ _ _. + - smt(prefixe_ge0). + - exact H1. + - exact H_h. + by cut:=H7;rewrite !in_dom=>/=->/=. + rcondt{2}1;1:auto=>/#. + rcondt{2}5;auto;progress. + * rewrite(@take_nth witness);1:smt(prefixe_ge0);rewrite in_dom. + cut[]HINV[]H_bad[]H_m_p0[]Hp1[]Hp2[]->>[]H_counter[]H_h[]H_path[]H_F_RO H_i:=H3 H6. + cut[]:=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + cut:=lemma5' _ _ _ _ _ _ _ _ _ _ _ _ i{hr} bs{m} sa{hr} sc{m} h{hr} HINV _ _ _. + * smt(prefixe_ge0). + * rewrite/#. + * rewrite/#. + cut:=H7;rewrite in_dom =>/=->/=H_Gmh _ H_ H_path_uniq. + cut help:=H_ (take i{hr} bs{m}) (nth witness bs{m} i{hr});rewrite H_path/= in help. + cut:forall (b : block), + F.RO.m{hr}.[rcons (take i{hr} bs{m}) (nth witness bs{m} i{hr})] = Some b + <=> exists hy, G1.mh{hr}.[(sa{hr} +^ nth witness bs{m} i{hr}, h{hr})] = Some (b, hy) by rewrite/#. + move:help=>_ help;move:H_Gmh;apply absurd=>//=H_F_Ro. + by cut:=get_oget F.RO.m{hr} (rcons (take i{hr} bs{m}) (nth witness bs{m} i{hr}));rewrite in_dom H_F_Ro/=help=>[]/#. + swap{2}-3;auto;progress. + * rewrite/#. + * rewrite/#. + * by rewrite!getP/=. + * cut[]HINV[]H_bad[]H_m_p0[]Hp1[]Hp2[]->>[]H_counter[][]f H_h[]H_path[]H_F_RO H_i:=H3 H6. + cut:=H12;rewrite !negb_or/==>[][][]bad1 hinv_none bad2. + cut H_hs_spec:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + cut H_mh_spec:=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + cut H_m_mh:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + cut H_mi_mhi:=mi_mhi_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + cut H_pi_spec:=pi_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + cut :=lemma5' _ _ _ _ _ _ _ _ _ _ _ _ i{2} bs{1} sa{2} sc{1} h{2} HINV _ _ _. + * smt(prefixe_ge0). + * exact H1. + * rewrite/#. + cut:=H7;rewrite in_dom/==>->/=h_g1. + cut H2_pi_spec:pi_spec FRO.m{2}.[G1.chandle{2} <- (y2L, Unknown)] + G1.mh{2}.[(sa{2} +^ nth witness bs{1} i{2}, h{2}) <- (y1L, G1.chandle{2})] + G1.paths{2}. + + split;progress. + - cut[]h:=H_pi_spec;cut:=h c p0 v;rewrite H13/==>[][]h1[] h'1 h'2. + exists h1;rewrite -h'2 getP/=. + cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h'2. + by apply build_hpath_up=>//=. + move:H14;rewrite getP/==>hh0. + cut h0_neq_ch:h0 <> G1.chandle{2} by rewrite/#. + cut[]->:=H_pi_spec;rewrite-hh0 h0_neq_ch/=;exists h0=>/=. + cut:=H;cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness bs{1} i{2}) y1L p0 v h0. + rewrite h_g1/=H/=h0_neq_ch/=. + cut->//=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec H_h. + cut -> /= <-//=:=ch_neq0 _ _ H_hs_spec;progress;cut[]hh1 hh2 hh3:=H_mh_spec;smt(dom_hs_neq_ch). + split. + + apply hs_addh;1:cut//:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + by cut:=hinvP FRO.m{2} y2L;rewrite hinv_none/=/#. + + by cut:=invG_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + + apply inv_addm=>//;1:cut//:=inv_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + apply (notin_hs_notin_dom2_mh FRO.m{2} PF.mi{1})=>//=. + by apply ch_notin_dom_hs;cut:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + + cut[] H_huniq _ _:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + rewrite!getP/=oget_some. + apply (m_mh_addh_addm _ H_m_mh H_huniq H_h _)=>//=. + by apply ch_notin_dom_hs;cut:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + + cut[] H_huniq _ _:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + rewrite!getP/=oget_some;apply (mi_mhi_addh_addmi _ H_mi_mhi _ H_h _)=>//=. + - smt(hinvP). + by apply ch_notin_dom_hs;cut:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + + apply incl_upd_nin=>//=. + by cut:=incl_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + + apply incl_upd_nin=>//=. + - by cut:=incli_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + cut:=hinvP FRO.m{2} y2L;rewrite in_dom hinv_none/=;apply absurd=>H_P_mi. + rewrite negb_forall/=. + cut H_inv_Gmh:=inv_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + cut[]H_inv_Pm:=inv_mh_inv_Pm _ _ _ _ _ H_m_mh H_mi_mhi H_inv_Gmh. + cut[]H_Pmi H_Gmhi:=mi_mhi_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + by cut[]/#:=H_Pmi y1L y2L (oget PF.mi{1}.[(y1L, y2L)]).`1 + (oget PF.mi{1}.[(y1L, y2L)]).`2 _;1:smt(get_oget in_dom). + + cut H_take_Si:=take_nth witness i{2} bs{1} _;1:smt(prefixe_ge0). + split=>//=. + - move=>x hx y hy;rewrite !getP. + case((x, hx) = (sa{2} +^ nth witness bs{1} i{2}, h{2}))=>//=. + * move=>[->> ->>][<<- <<-]/=. + cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec H_h. + rewrite H_h/=. + exists sc{1} f y2L Unknown=>//=. + exists (take i{2} bs{1}) (sa{2})=>//=;rewrite getP Block.WRing.addKr/=. + rewrite oget_some/=(@take_nth witness)/=;1:smt(prefixe_ge0). + by apply build_hpath_up=>//=;smt(in_dom). + move=> neq h1. + cut[]hh1 hh2 hh3:=H_mh_spec. + cut[]xc hxx yc hyc []h2[]h3 h4:=hh1 _ _ _ _ h1. + cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h2. + cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h3. + rewrite h2 h3/=;exists xc hxx yc hyc=>//=. + move:h4;case(hyc = Known)=>//=neq2[]p0 b[]hp0 hb. + exists p0 b;rewrite getP. + cut->/=:=build_hpath_up _ _ _ y1L G1.chandle{2} _ _ _ hb h_g1. + cut/#:!rcons p0 (b +^ x) = rcons (take i{2} bs{1}) (nth witness bs{1} i{2});move:neq;apply absurd=>//=h'. + cut<<-:take i{2} bs{1}=p0 by rewrite/#. + cut hbex:b +^ x = nth witness bs{1} i{2} by rewrite/#. + by cut:=hb;rewrite H_path/==>[][->>->>]/=;rewrite-hbex Block.WRing.addKr/=. + - progress. + * move:H13;rewrite getP/=H_take_Si/=. + case(p0 = (take i{2} bs{1}))=>[->>|hpp0];rewrite!getP/=!oget_some/=. + + cut->/=:=build_hpath_up _ _ _ y1L G1.chandle{2} _ _ _ H_path h_g1. + case(bn = (nth witness bs{1} i{2}))=>[->> /= ->>|hbni]/=. + - by exists sa{2} h{2} G1.chandle{2}=>//=;rewrite getP/=. + cut->/=:!rcons (take i{2} bs{1}) bn = rcons (take i{2} bs{1}) (nth witness bs{1} i{2}). + - move:hbni;apply absurd=>//=h. + cut->:bn = nth witness (rcons (take i{2} bs{1}) bn) i{2}. + * by rewrite nth_rcons size_take;smt(prefixe_ge0). + by rewrite h nth_rcons size_take;smt(prefixe_ge0). + move=>h_ro_p_bn. + cut[]_ hh4 _:=H_mh_spec. + by cut:=hh4 (take i{2} bs{1}) bn b0;rewrite h_ro_p_bn/=H_path/=;smt(getP @Block.WRing). + cut->/=:!rcons p0 bn = rcons (take i{2} bs{1}) (nth witness bs{1} i{2}). + + move:hpp0;apply absurd=>/=h. + cut:size p0 = size (take i{2} bs{1}) by smt(size_rcons). + move:h;pose p' := take i{2} bs{1};pose e := nth witness bs{1} i{2}. + by move=>h h';move:p0 p' h' bn e h;apply seq2_ind=>//=/#. + move=>h_ro_p_bn. + cut[]_ hh4 _:=H_mh_spec. + cut:=hh4 p0 bn b0;rewrite h_ro_p_bn/==>[][];progress. + cut help:(sa{2} +^ nth witness bs{1} i{2}, h{2}) <> (v +^ bn, hx) by rewrite/#. + exists v hx hy=>//=;rewrite getP;rewrite eq_sym in help;rewrite help/=H14/=. + by apply build_hpath_up=>//=. + move:H13 H14;rewrite!getP/=!oget_some/==>h_build_hpath_set. + case(hy = G1.chandle{2})=>//=[->>|hy_neq_ch]/=. + + move=>h;cut h_eq:v +^ bn = sa{2} +^ nth witness bs{1} i{2} && hx = h{2}. + + cut/#:G1.mh{2}.[(v +^ bn, hx)] <> Some (b0, G1.chandle{2}). + cut[]_ hh2:=H_m_mh. + cut:=hh2 (v +^ bn) hx b0 G1.chandle{2}. + case(G1.mh{2}.[(v +^ bn, hx)] = Some (b0, G1.chandle{2}))=>//=. + rewrite negb_exists/=;progress; + rewrite negb_exists/=;progress; + rewrite negb_exists/=;progress; + rewrite negb_exists/=;progress;rewrite !negb_and. + by cut[]/#:=H_hs_spec. + cut[]eq_xor ->>:=h_eq. + move:h;rewrite h_eq/==>->>. + cut/#:!(p0 = (take i{2} bs{1}) /\ bn = (nth witness bs{1} i{2})) => + F.RO.m{2}.[rcons p0 bn] = Some b0. + move:H_h;case:f=>h_flag;last first. + - cut:=known_path_uniq _ _ _ sc{1} h{2} p0 v (take i{2} bs{1}) sa{2} H2_pi_spec _ h_build_hpath_set _. + * rewrite getP/=h_flag. + by cut->//=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h_flag. + * by apply build_hpath_up=>//=. + move=>[]->>->>/=;apply absurd=>//=_. + cut->:bn = sa{2} +^ sa{2} +^ bn;smt(@Block). + cut[]hh1 hh2 hh3:=H_mh_spec. + cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness bs{1} i{2}) b0 p0 v h{2}. + rewrite h_build_hpath_set/=h_g1/=. + cut->/=:=ch_neq0 _ _ H_hs_spec. + cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h_flag. + move=>help;cut:= help _;1:smt(dom_hs_neq_ch). + move=>h_build_hpath_p0. + rewrite hh2 h_build_hpath_p0/==>h_neq. + exists v h{2}=>//=. + rewrite eq_xor h_g1/=;move:h_neq;apply absurd=>//=. + cut:=hh3 _ _ _ _ _ H_path h_build_hpath_p0. + cut->:bn = sa{2} +^ sa{2} +^ bn;smt(@Block). + move=>help;cut h_neq:! (v +^ bn = sa{2} +^ nth witness bs{1} i{2} && hx = h{2}) by rewrite/#. + move:help;rewrite h_neq/==>h_g1_v_bn_hx. + cut[]hh1 hh2 hh3:=H_mh_spec. + cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness bs{1} i{2}) y1L p0 v hx. + rewrite h_build_hpath_set/=h_g1/=. + cut->/=:=ch_neq0 _ _ H_hs_spec. + by cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec H_h;smt(dom_hs_neq_ch). + progress. + + cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness bs{1} i{2}) y1L p0 v hx. + cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness bs{1} i{2}) y1L p' v' hx. + move:H13 H14;rewrite!getP/=!oget_some/==>H13 H14;rewrite H13 H14. + cut->/=:=ch_neq0 _ _ H_hs_spec. + cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec H_h. + rewrite h_g1/=. + by cut[]:=H_mh_spec;smt(dom_hs_neq_ch). + cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness bs{1} i{2}) y1L p0 v hx. + cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness bs{1} i{2}) y1L p' v' hx. + move:H13 H14;rewrite!getP/=!oget_some/==>H13 H14;rewrite H13 H14/=. + cut->/=:=ch_neq0 _ _ H_hs_spec. + cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec H_h. + rewrite h_g1/=. + by cut[]:=H_mh_spec;smt(dom_hs_neq_ch). + + rewrite!getP/=oget_some;exact H2_pi_spec. + + rewrite!getP/=!oget_some/=. + cut H_m_p:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + cut H_all_prefixes:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + split;case:H_m_p=>//=Hmp01 Hmp02 Hmp1 Hmp2 Hmp3. + - smt(getP size_take prefixe_ge0). + - by cut[]:=H_m_p0;smt(getP size_take prefixe_ge0). + - move=>l;rewrite dom_set in_fsetU1;case=>H_case j []Hj0. + * move=>Hjsize;rewrite!getP/=. + cut->/=:!take j l = take (i{2} + 1) bs{1} by rewrite/#. + cut->/=:!take (j+1) l = take (i{2} + 1) bs{1} by rewrite/#. + smt(in_dom getP). + cut->>:=H_case;rewrite size_take;1:smt(prefixe_ge0). + cut->/=:(if i{2} + 1 < size bs{1} then i{2} + 1 else size bs{1}) = i{2} + 1 by rewrite/#. + move=>HjiS;rewrite!getP. + cut->/=:! take j (take (i{2} + 1) bs{1}) = take (i{2} + 1) bs{1} by smt(size_take). + rewrite!take_take!min_lel 1,2:/# nth_take 2:/#;1:smt(prefixe_ge0). + case(j < i{2})=>Hij. + - cut->/=:!take (j + 1) bs{1} = take (i{2} + 1) bs{1} by smt(size_take). + by cut:=Hmp1(take i{2} bs{1}) _ j _;smt(in_dom take_take nth_take prefixe_ge0 size_take getP). + cut->>:j = i{2} by rewrite/#. + by exists sa{2} sc{1};rewrite H1/=;smt(get_oget getP in_dom). + - move=>l;rewrite dom_set in_fsetU1. + case(l = take (i{2} + 1) bs{1})=>//=[->>|]. + + by rewrite!getP/=oget_some/=/#. + move=>h H_dom;rewrite!getP h/=. + cut[]H2mp01 H2mp02 H2mp1 H2mp2 H2mp3:=H_m_p0. + rewrite-Hp1;1:smt(in_dom). + by apply H2mp2. + move=>l;rewrite !dom_set !in_fsetU1. + case(l = take (i{2} + 1) bs{1})=>//=[->>|]. + + by exists []; smt(cats0 dom_set in_fsetU1). + move=>H_neq H_dom;cut[]l1:=Hmp3 _ H_dom;rewrite!dom_set!in_fsetU1;case=>H_case. + + exists l1;by rewrite in_fsetU1 H_case. + exists (rcons l1 (nth witness bs{1} i{2}));rewrite in_fsetU1;right. + by rewrite-rcons_cat (@take_nth witness);smt(prefixe_ge0). + * rewrite/#. + * cut[]HINV[]H_bad[]H_m_p0[]Hp1[]Hp2[]->>[]H_counter[][]f H_h[]H_path[]H_F_RO H_i:=H3 H6. + by split;cut[]//=:=H_m_p0;smt(getP in_dom take_take take_nth size_take + prefixe_ge0 nth_take take_oversize take_le0). + + rewrite!getP/=oget_some;smt(in_dom). + + smt(getP in_dom take_take size_take prefixe_ge0 nth_take take_oversize take_le0). + + rewrite!getP/=oget_some;smt(in_dom). + + rewrite/#. + + by rewrite!getP/=oget_some/#. + + rewrite!getP/=oget_some(@take_nth witness);1:smt(prefixe_ge0);rewrite build_hpath_prefix. + cut[]HINV[]H_bad[]H_m_p0[]Hp1[]Hp2[]->>[]H_counter[][]f H_h[]H_path[]H_F_RO H_i:=H3 H6. + cut:=lemma5' _ _ _ _ _ _ _ _ _ _ _ _ i{2} bs{1} sa{2} sc{1} h{2} HINV _ _ _. + - smt(prefixe_ge0). + - exact H1. + - rewrite/#. + cut:=H7;rewrite in_dom=>/=->/=H_Gmh. + cut->/=:=build_hpath_up_None _ _ (y1L, G1.chandle{2})_ _ H_Gmh H_path;smt(getP). + + smt(prefixe_ge0). + + smt(prefixe_ge0). + + by rewrite!getP/=oget_some. + rewrite!dom_set!in_fsetU1 negb_or/=;split;2:smt(prefixe_ge0 size_take prefixe_ge0 take_oversize). + cut[]HINV[]H_bad[]H_m_p0[]Hp1[]Hp2[]->>[]H_counter[][]f H_h[]H_path[]H_F_RO H_i:=H3 H6. + cut:=Hp2 (take (i{2} + 1 + 1) bs{1}). + pose P:= _ \/ _;cut/#:!P;rewrite/P;clear P;rewrite negb_or/=negb_exists/=;split. + * cut:=prefixe_exchange_prefixe_inv(elems (dom C.queries{2}))(elems (dom prefixes{1}))bs{1} _ _ _. + + by cut[]:=H_m_p0;smt(in_dom memE). + + cut[]Hmp01 Hmp02 Hmp1 Hmp2 Hmp3:=H_m_p0. + by cut:=all_prefixes_of_m_p _ _ _ H_m_p0;smt(memE in_dom). + + by cut[]:=H_m_p0;smt(memE in_dom). + by move=>H_pref_eq;rewrite memE prefixe_lt_size//= -H_pref_eq/#. + by move=>j;case(0<=j<=i{2})=>//=[][]Hj0 Hji;smt(size_take prefixe_ge0 take_le0). +qed. + + +section AUX. + + declare module D : DISTINGUISHER {PF, RO, G1, Redo, C}. + + axiom D_ll (F <: DFUNCTIONALITY{D}) (P <: DPRIMITIVE{D}): + islossless P.f => islossless P.fi => islossless F.f => + islossless D(F, P).distinguish. + + equiv CF_G1 : CF(DRestr(D)).main ~ G1(DRestr(D)).main: + ={glob D} ==> !(G1.bcol \/ G1.bext){2} => ={res}. + proof. + proc;inline*;wp. + call (_: G1.bcol \/ G1.bext, ={glob C} /\ + INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} + G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} F.RO.m{2} + G1.paths{2} Redo.prefixes{1} C.queries{2}, + [] \in dom C.queries{2}). + (* lossless D *) + + exact/D_ll. + (** proofs for G1.S.f *) + (* equivalence up to bad of PF.f and G1.S.f *) + + conseq (_: !G1.bcol{2} + /\ !G1.bext{2} + /\ ={x, glob C} + /\ INV_CF_G1 FRO.m{2} G1.chandle{2} + PF.m{1} PF.mi{1} + G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} + F.RO.m{2} G1.paths{2} + Redo.prefixes{1} C.queries{2} + ==> !G1.bcol{2} + => !G1.bext{2} + => ={res, glob C} + /\ INV_CF_G1 FRO.m{2} G1.chandle{2} + PF.m{1} PF.mi{1} + G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} + F.RO.m{2} G1.paths{2} + Redo.prefixes{1} C.queries{2}). + + by move=> &1 &2; rewrite negb_or. + + progress;cut[]:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H0;smt(in_dom). + (* For now, everything is completely directed by the syntax of + programs, so we can *try* to identify general principles of that + weird data structure and of its invariant. I'm not sure we'll ever + be able to do that, though. *) + conseq(eq_f D);progress=>/#. + (* lossless PF.f *) + + move=> &2 _; proc;inline*; sp;if=> //=; auto; sp;if;auto;smt (@Block.DBlock @Capacity.DCapacity). + (* lossless and do not reset bad G1.S.f *) + + move=> &1; proc; inline*;sp;if;auto;sp;if;auto. + conseq (_: _ ==> G1.bcol \/ G1.bext); 1:smt (). + inline *; if=> //=; wp; rnd predT; wp; rnd predT; auto. + + smt (@Block.DBlock @Capacity.DCapacity). + smt (@Block.DBlock @Capacity.DCapacity). + (** proofs for G1.S.fi *) + (* equiv PF.P.fi G1.S.fi *) + + conseq(eq_fi D)=>/#. + (* lossless PF.P.fi *) + + move=> &2 _; proc; inline*; sp; if; auto; sp; if; auto; smt (@Block.DBlock @Capacity.DCapacity). + (* lossless and do not reset bad G1.S.fi *) + + move=> &1; proc; inline*; sp; if; auto; sp; if;auto;smt (@Block.DBlock @Capacity.DCapacity). + (** proofs for G1.C.f *) + (* equiv PF.C.f G1.C.f *) + + conseq(PFf_Cf D);auto=>/#. + (* lossless PF.C.f *) + + move=> &2 _; proc; inline *; sp; if; auto; if; auto; while (true) (size p - i); auto. + + if; 1:auto=>/#. + sp; if; 2: auto=>/#. + by wp; do 2!rnd predT; auto; smt (size_behead @Block.DBlock @Capacity.DCapacity). + smt (size_ge0). + (* lossless and do not reset bad G1.C.f *) + + move=> _; proc; inline *; wp;sp;if;auto;sp;if;auto;sp. + conseq(:_==> (G1.bcol \/ G1.bext));1:smt(@DBlock @DCapacity dom_set in_fsetU1). while (G1.bcol \/ G1.bext) (size p - i)=> [z|]. + if; 1:by auto=> /#. - wp; rnd predT; wp; rnd predT; auto. + if;2:auto=>/#;wp; rnd predT; wp; rnd predT; auto. smt (@Block.DBlock @Capacity.DCapacity). by auto; smt (@Block.DBlock @Capacity.DCapacity). (* Init ok *) inline *; auto=> />; split=> [|/#]. - (do !split; -5..-2: smt (getP map0P build_hpath_map0)); -6..-2: by move=> ? ? ? ?; rewrite map0P. - + move=> h1 h2 ? ?; rewrite !getP !map0P. - by case: (h1 = 0); case: (h2 = 0)=> //=. - + by rewrite getP. - + by move=> ? h; rewrite getP map0P; case: (h = 0). - + by move=> ? ?; rewrite !map0P. - + by move=> ? ?; rewrite !map0P. - by move=>l;rewrite dom_set in_fsetU1 dom0 in_fset0/==>->>/=/#. + do !split. + + smt (getP map0P build_hpath_map0). + + smt (getP map0P build_hpath_map0). + + smt (getP map0P build_hpath_map0). + + smt (getP map0P build_hpath_map0). + + smt (getP map0P build_hpath_map0). + + smt (getP map0P build_hpath_map0). + + smt (getP map0P build_hpath_map0). + + smt (getP map0P build_hpath_map0). + + smt (getP map0P build_hpath_map0). + + smt (getP map0P build_hpath_map0). + + smt (getP map0P build_hpath_map0). + + smt (getP map0P build_hpath_map0). + + smt (getP map0P build_hpath_map0). + + smt (getP map0P build_hpath_map0). + + smt (getP map0P build_hpath_map0). + + by move=>l;rewrite dom_set in_fsetU1 dom0 in_fset0/==>->>/=/#. + + by move=>l;rewrite dom_set in_fsetU1 dom0 in_fset0/=!getP/==>->>/=/#. + + by move=>l;rewrite dom_set in_fsetU1 dom0 in_fset0/=/==>->>/=;exists[];rewrite dom_set in_fsetU1//=. qed. @@ -2851,25 +2759,6 @@ section. islossless P.f => islossless P.fi => islossless F.f => islossless D(F, P).distinguish. - local equiv CF_G1 : - CF(DRestr(D)).main ~ G1(DRestr(D)).main: - ={glob D, glob C} ==> !(G1.bcol \/ G1.bext){2} => ={res}. - proof. - transitivity G1'(DRestr(D)).main - (={glob D, glob C} ==> !(G1.bcol \/ G1.bext){2} => ={res}) - (={glob D, glob C} ==> ={res, glob G1(D)});progress;1:rewrite/#. - + by conseq(CF_G1' (DRestr(D)) (DRestr_ll D D_ll));progress. - proc;inline*;auto;sp. - call(: ={glob G1, glob C} /\ [] \in dom C.queries{1});auto;last first. - + smt(dom_set in_fsetU1). - + by proc;inline*;sp;if;auto;conseq(:_==> ={y0, glob G1, glob C});progress;sim. - + by proc;inline*;sp;if;auto;conseq(:_==> ={y0, glob G1, glob C});progress;sim. - proc;inline*;sp;if;auto;if;1,3:auto. - rcondt{1}8;first by auto;while(p <> []);auto;1:(sp;if);auto=>/#. - by wp 12 12;conseq(:_==> ={b, glob G1, glob C});1:smt(dom_set in_fsetU1);sim. - qed. - - lemma Real_G1 &m: Pr[GReal(D).main() @ &m: res /\ C.c <= max_size] <= Pr[G1(DRestr(D)).main() @ &m: res] @@ -2880,7 +2769,7 @@ section. cut : Pr[CF(DRestr(D)).main() @ &m : res] <= Pr[G1(DRestr(D)).main() @ &m : res] + Pr[G1(DRestr(D)).main() @ &m : G1.bcol \/ G1.bext]. - + byequiv (CF_G1)=>//. + + byequiv (CF_G1 D D_ll)=>//. smt ml=0. smt ml=0. qed. From e11cee51109c609c2df3f993f643430a233cf614 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Thu, 5 Apr 2018 13:39:58 +0200 Subject: [PATCH 273/525] Gconcl.ec : done, cleaning todo Translating from a output block to a output list of blocks : TODO --- proof/smart_counter/Gcol.eca | 262 ++++++++++++---------- proof/smart_counter/Gconcl.ec | 31 ++- proof/smart_counter/Gext.eca | 382 +++++++++++++++----------------- proof/smart_counter/Handle.eca | 161 +------------- proof/smart_counter/SLCommon.ec | 75 +++++++ 5 files changed, 430 insertions(+), 481 deletions(-) diff --git a/proof/smart_counter/Gcol.eca b/proof/smart_counter/Gcol.eca index 2047d12..1af352a 100644 --- a/proof/smart_counter/Gcol.eca +++ b/proof/smart_counter/Gcol.eca @@ -4,10 +4,10 @@ require import List FSet NewFMap Utils Common SLCommon RndO FelTactic Mu_mem. require import DProd Dexcepted. (*...*) import Capacity IntOrder Bigreal RealOrder BRA. -require (*..*) Gcol_ext. - -clone export Gcol_ext as Handle0. +require (*..*) Handle. +clone export Handle as Handle0. +import ROhandle. (* -------------------------------------------------------------------------- *) (* TODO: move this *) @@ -46,17 +46,17 @@ section PROOF. return c; } - module C = { + module M = { proc f(p : block list): block = { var sa, sa', sc; - var h, i <- 0; + var h, i, counter <- 0; sa <- b0; while (i < size p ) { if (mem (dom G1.mh) (sa +^ nth witness p i, h)) { (sa, h) <- oget G1.mh.[(sa +^ nth witness p i, h)]; } else { - if (! G1.bcol /\ ! G1.bext) { + if (counter < size p - prefixe p (get_max_prefixe p (elems (dom C.queries)))) { sc <@ sample_c(); sa' <- F.RO.get(take (i+1) p); sa <- sa +^ nth witness p i; @@ -65,6 +65,7 @@ section PROOF. (sa,h) <- (sa',G1.chandle); FRO.m.[G1.chandle] <- (sc,Unknown); G1.chandle <- G1.chandle + 1; + counter <- counter + 1; } } i <- i + 1; @@ -81,42 +82,39 @@ section PROOF. if (!mem (dom G1.m) x) { y <- (b0,c0); - if (! G1.bcol /\ ! G1.bext) { - if (!(mem (rng FRO.m) (x.`2, Known))) { - FRO.m.[G1.chandle] <- (x.`2, Known); - G1.chandle <- G1.chandle + 1; - } - hx2 <- oget (hinvK FRO.m x.`2); - if (mem (dom G1.paths) x.`2) { - (p,v) <- oget G1.paths.[x.`2]; - y1 <- F.RO.get (rcons p (v +^ x.`1)); - y2 <@ sample_c(); - } else { - y1 <$ bdistr; - y2 <@ sample_c(); - - } - y <- (y1,y2); - if (mem (dom G1.mh) (x.`1, hx2) /\ - in_dom_with FRO.m (oget G1.mh.[(x.`1,hx2)]).`2 Unknown) { - hy2 <- (oget G1.mh.[(x.`1, hx2)]).`2; - y <- (y.`1, (oget FRO.m.[hy2]).`1); - FRO.m.[hy2] <- (y.`2, Known); - G1.m.[x] <- y; - G1.mi.[y] <- x; - } else { - hy2 <- G1.chandle; - G1.chandle <- G1.chandle + 1; - FRO.m.[hy2] <- (y.`2, Known); - G1.m.[x] <- y; - G1.mh.[(x.`1, hx2)] <- (y.`1, hy2); - G1.mi.[y] <- x; - G1.mhi.[(y.`1, hy2)] <- (x.`1, hx2); - } - if (mem (dom G1.paths) x.`2) { - (p,v) <- oget G1.paths.[x.`2]; - G1.paths.[y.`2] <- (rcons p (v +^ x.`1), y.`1); - } + if (!(mem (rng FRO.m) (x.`2, Known))) { + FRO.m.[G1.chandle] <- (x.`2, Known); + G1.chandle <- G1.chandle + 1; + } + hx2 <- oget (hinvK FRO.m x.`2); + if (mem (dom G1.paths) x.`2) { + (p,v) <- oget G1.paths.[x.`2]; + y1 <- F.RO.get (rcons p (v +^ x.`1)); + y2 <@ sample_c(); + } else { + y1 <$ bdistr; + y2 <@ sample_c(); + } + y <- (y1,y2); + if (mem (dom G1.mh) (x.`1, hx2) /\ + in_dom_with FRO.m (oget G1.mh.[(x.`1,hx2)]).`2 Unknown) { + hy2 <- (oget G1.mh.[(x.`1, hx2)]).`2; + y <- (y.`1, (oget FRO.m.[hy2]).`1); + FRO.m.[hy2] <- (y.`2, Known); + G1.m.[x] <- y; + G1.mi.[y] <- x; + } else { + hy2 <- G1.chandle; + G1.chandle <- G1.chandle + 1; + FRO.m.[hy2] <- (y.`2, Known); + G1.m.[x] <- y; + G1.mh.[(x.`1, hx2)] <- (y.`1, hy2); + G1.mi.[y] <- x; + G1.mhi.[(y.`1, hy2)] <- (x.`1, hx2); + } + if (mem (dom G1.paths) x.`2) { + (p,v) <- oget G1.paths.[x.`2]; + G1.paths.[y.`2] <- (rcons p (v +^ x.`1), y.`1); } } else { y <- oget G1.m.[x]; @@ -129,31 +127,29 @@ section PROOF. if (!mem (dom G1.mi) x) { y <- (b0,c0); - if (! G1.bcol /\ !G1.bext) { - if (!(mem (rng FRO.m) (x.`2, Known))) { - FRO.m.[G1.chandle] <- (x.`2, Known); - G1.chandle <- G1.chandle + 1; - } - hx2 <- oget (hinvK FRO.m x.`2); - y1 <$ bdistr; - y2 <@ sample_c(); - y <- (y1,y2); - if (mem (dom G1.mhi) (x.`1, hx2) /\ - in_dom_with FRO.m (oget G1.mhi.[(x.`1,hx2)]).`2 Unknown) { - (y1,hy2) <- oget G1.mhi.[(x.`1, hx2)]; - y <- (y.`1, (oget FRO.m.[hy2]).`1); - FRO.m.[hy2] <- (y.`2, Known); - G1.mi.[x] <- y; - G1.m.[y] <- x; - } else { - hy2 <- G1.chandle; - G1.chandle <- G1.chandle + 1; - FRO.m.[hy2] <- (y.`2, Known); - G1.mi.[x] <- y; - G1.mhi.[(x.`1, hx2)] <- (y.`1, hy2); - G1.m.[y] <- x; - G1.mh.[(y.`1, hy2)] <- (x.`1, hx2); - } + if (!(mem (rng FRO.m) (x.`2, Known))) { + FRO.m.[G1.chandle] <- (x.`2, Known); + G1.chandle <- G1.chandle + 1; + } + hx2 <- oget (hinvK FRO.m x.`2); + y1 <$ bdistr; + y2 <@ sample_c(); + y <- (y1,y2); + if (mem (dom G1.mhi) (x.`1, hx2) /\ + in_dom_with FRO.m (oget G1.mhi.[(x.`1,hx2)]).`2 Unknown) { + (y1,hy2) <- oget G1.mhi.[(x.`1, hx2)]; + y <- (y.`1, (oget FRO.m.[hy2]).`1); + FRO.m.[hy2] <- (y.`2, Known); + G1.mi.[x] <- y; + G1.m.[y] <- x; + } else { + hy2 <- G1.chandle; + G1.chandle <- G1.chandle + 1; + FRO.m.[hy2] <- (y.`2, Known); + G1.mi.[x] <- y; + G1.mhi.[(x.`1, hx2)] <- (y.`1, hy2); + G1.m.[y] <- x; + G1.mh.[(y.`1, hy2)] <- (x.`1, hx2); } } else { y <- oget G1.mi.[x]; @@ -177,7 +173,7 @@ section PROOF. G1.paths <- map0.[c0 <- ([<:block>],b0)]; G1.chandle <- 1; count <- 0; - b <@ DRestr(D,C,S).distinguish(); + b <@ DRestr(D,M,S).distinguish(); return b; } }. @@ -219,57 +215,76 @@ section PROOF. move=> b c;proc;sp;if;auto;smt ml=0. qed. - local equiv Gpr_col : Gpr(DRestr(D)).main ~ Gcol.main : + local equiv G1_col : G1(DRestr(D)).main ~ Gcol.main : ={glob D} ==> (G1.bcol{1} => G1.bcol{2}) /\ Gcol.count{2} <= max_size. proof. proc;inline*;wp. call (_: ={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m,C.c,C.queries}/\ (G1.bcol{1} => G1.bcol{2}) /\ - ((!G1.bext /\ !G1.bcol) => mh_spec FRO.m G1.m G1.mh F.RO.m - /\ pi_spec FRO.m G1.mh G1.paths - /\ hs_spec FRO.m G1.chandle){1} /\ (card (rng FRO.m) <= 2*C.c + 1 /\ Gcol.count <= C.c <= max_size){2}). - + proc;sp 1 1;if=>//;inline Gpr(DRestr(D)).S.f Gcol.S.f;swap -3. - sp;if;1,3:auto=>/#;sp;wp;if;auto;progress. - - rewrite/ - swap{1}[3..5]-2. - seq 3 2:(={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m, - C.c,C.queries,x0,hx2} /\ - (G1.bcol{1} => G1.bcol{2}) /\ - (card (rng FRO.m) + 1 <= 2 * C.c + 1 /\ - Gcol.count + 1 <= C.c <= max_size){2}). - + auto;smt ml=0 w=card_rng_set. - seq 2 2: - (={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m, - C.c,C.queries,x0,hx2,y0} /\ - ((G1.bcol\/hinv FRO.m y0.`2 <> None){1} => G1.bcol{2}) /\ - (card (rng FRO.m) + 1 <= 2 * C.c + 1 /\ - Gcol.count <= C.c <= max_size){2});last by auto;smt ml=0 w=card_rng_set. - wp;if=>//;inline Gcol.sample_c. - + rcondt{2}4. - + auto;conseq (_:true)=>//;progress;2: smt ml=0. - by cut /#:= fcard_image_leq fst (rng FRO.m{hr}). - wp;conseq (_: ={p,v,F.RO.m,y1} /\ y2{1}=c{2})=>//;1:smt ml=0 w=hinv_image. - by sim. - rcondt{2}3. - + by auto;progress;cut /#:= fcard_image_leq fst (rng FRO.m{hr}). - auto;progress;smt w=hinv_image. + + proc;sp 1 1;if=>//;inline G1(DRestr(D)).S.f Gcol.S.f;swap -3. + sp;if;1,3:auto=>/#;swap{1}[1..2]3;sp 1 1. + seq 5 5 : (={x0, y0, F.RO.m, G1.mi, G1.paths, G1.m, G1.mhi, G1.chandle, + G1.mh, FRO.m, C.c, C.queries} + /\ (G1.bcol{1} => G1.bcol{2}) + /\ card (rng FRO.m{2}) <= 2 * C.c{2} + 1 + /\ Gcol.count{2} <= C.c{2} <= max_size );last by if;auto. + seq 2 2 : (={x0, hx2, F.RO.m, G1.mi, G1.paths, G1.m, G1.mhi, G1.chandle, + G1.mh, FRO.m, C.c, C.queries} + /\ (G1.bcol{1} => G1.bcol{2}) + /\ card (rng FRO.m{2}) <= 2 * C.c{2} + /\ Gcol.count{2} + 1 <= C.c{2} <= max_size);1: by if;auto;smt(card_rng_set). + if;1:auto. + - inline Gcol.sample_c;rcondt{2}4. + * auto;inline*;auto;progress. + + by cut/#:=fcard_image_leq (fun (p : capacity * flag) => p.`1) (rng FRO.m{hr}). + rewrite/#. + seq 3 4 : (={x0, p, v, y1, hx2, F.RO.m, G1.mi, G1.paths, G1.m, G1.mhi, + G1.chandle, G1.mh, FRO.m, C.c, C.queries} + /\ (G1.bcol{1} => G1.bcol{2}) + /\ card (rng FRO.m{2}) <= 2 * C.c{2} + /\ Gcol.count{2} + 1 <= C.c{2} <= max_size + /\ (x0{1}.`2 \in dom G1.paths{1}) + /\ y2{1} = c{2});1: by inline*;auto. + sp 1 4;if;auto;progress. + + by cut->:=(H H6). + + smt(card_rng_set). + + case:H5=>/=[h|H_hinv];1: by cut->:=H h. + by cut:=hinvP FRO.m{2} c{2};rewrite H_hinv/=imageP/==>[][]f H_f;smt(in_rng). + smt(card_rng_set). + inline Gcol.sample_c;rcondt{2}3. + * auto;progress. + + by cut/#:=fcard_image_leq (fun (p : capacity * flag) => p.`1) (rng FRO.m{hr}). + rewrite/#. + seq 2 3 : (={x0, y1, hx2, F.RO.m, G1.mi, G1.paths, G1.m, G1.mhi, + G1.chandle, G1.mh, FRO.m, C.c, C.queries} + /\ (G1.bcol{1} => G1.bcol{2}) + /\ card (rng FRO.m{2}) <= 2 * C.c{2} + /\ Gcol.count{2} + 1 <= C.c{2} <= max_size + /\ ! (x0{1}.`2 \in dom G1.paths{1}) + /\ y2{1} = c{2});1: by auto. + sp 1 4;if;auto;progress. + + by cut->:=(H H6). + + smt(card_rng_set). + + case:H5=>/=[h|H_hinv];1: by cut->:=H h. + by cut:=hinvP FRO.m{2} c{2};rewrite H_hinv/=imageP/==>[][]f H_f;smt(in_rng). + smt(card_rng_set). + proc;sp 1 1;if=>//. - inline Gpr(DRestr(D)).S.fi Gcol.S.fi;swap-3. + inline G1(DRestr(D)).S.fi Gcol.S.fi;swap-3. seq 2 2 : (={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m, C.c,C.queries,x0} /\ (G1.bcol{1} => G1.bcol{2}) /\ (card(rng FRO.m) + 2 <= 2*C.c + 1 /\ Gcol.count + 1 <= C.c <= max_size){2});1:by auto=>/#. if=>//;last by auto=>/#. - seq 3 2:(={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m, + seq 3 3:(={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m, C.c,C.queries,x0,hx2} /\ (G1.bcol{1} => G1.bcol{2}) /\ (card (rng FRO.m) + 1 <= 2 * C.c + 1 /\ Gcol.count + 1 <= C.c <= max_size){2}). - + by auto;smt ml=0 w=card_rng_set. + + sp 1 1;if;auto;smt ml=0 w=card_rng_set. seq 3 3: (={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m, C.c,C.queries,x0,hx2,y0,y1,y2} /\ y0{1} = (y1,y2){1} /\ @@ -282,38 +297,51 @@ section PROOF. (* BUG: auto=> /> ?? Himp _ _ _ ?_?_ [/Himp->// | H]. marche pas ???? *) auto=> /> ?? Himp _ _ _ ?_?_ [/Himp->// | X];right;apply hinv_image=> //. - + proc;sp 1 1;if=>//;2:auto;sp;if=>//. - inline Gpr(DRestr(D)).C.f Gcol.C.f. sp. - seq 5 5: + + proc;sp 1 1;if=>//;2:auto;sp;if=>//;swap 1;wp. + inline G1(DRestr(D)).M.f Gcol.M.f;sp;wp. + seq 1 1: (={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m,C.c, - C.queries,b,p,h,i,sa} /\ i{1}=0 /\ - (G1.bcol{1} => G1.bcol{2}) /\ - card (rng FRO.m{2}) + 2*(size p{2}) <= 2 * C.c{2} + 1 /\ - Gcol.count{2} + size p{2} <= C.c{2} <= max_size);1:by auto=>/#. - wp;call (_: ={F.RO.m});1:by sim. + C.queries,b,p,h,i,sa,bs,counter} /\ i{1}=size p{2} /\ p{2} = bs{2} /\ + (G1.bcol{1} => G1.bcol{2}) /\ + (0 <= counter{2} <= size p{2} - + prefixe p{2} (get_max_prefixe p{2} (elems (dom C.queries{1})))) /\ + card (rng FRO.m{2}) <= 2 * (C.c{2} + counter{2}) + 1 /\ + Gcol.count{2} + size p{2} - + prefixe p{2} (get_max_prefixe p{2} (elems (dom C.queries{1}))) + - counter{2} <= C.c{2} + size p{2} - + prefixe p{2} (get_max_prefixe p{2} (elems (dom C.queries{1}))) + <= max_size); + last by inline*;auto;smt(size_ge0 prefixe_sizel). while (={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m,C.c,b, - p,h,i,sa} /\ (i <= size p){1} /\ + p,h,i,sa,counter,C.queries} /\ (0 <= i <= size p){1} /\ (G1.bcol{1} => G1.bcol{2}) /\ - (card (rng FRO.m) + 2*(size p - i) <= 2 * C.c + 1 /\ - Gcol.count + size p - i <= C.c <= max_size){2}); - last by auto; smt ml=0 w=size_ge0. + (0 <= counter{2} <= size p{2} - + prefixe p{2} (get_max_prefixe p{2} (elems (dom C.queries{1})))) /\ + card (rng FRO.m{2}) <= 2 * (C.c{2} + counter{2}) + 1 /\ + Gcol.count{2} + size p{2} - + prefixe p{2} (get_max_prefixe p{2} (elems (dom C.queries{1}))) + - counter{2} <= C.c{2} + size p{2} - + prefixe p{2} (get_max_prefixe p{2} (elems (dom C.queries{1}))) + <= max_size);last by auto;smt(size_ge0 prefixe_sizel prefixe_ge0). if=>//;auto;1:smt ml=0 w=size_ge0. - call (_: ={F.RO.m});1:by sim. + if=>//;2:auto;2:smt(size_ge0 prefixe_sizel). + auto;call (_: ={F.RO.m})=>/=;1:by sim. inline *;rcondt{2} 2. - + auto;progress;cut /#:= fcard_image_leq fst (rng FRO.m{hr}). + + auto;progress. + - apply(StdOrder.IntOrder.ler_trans _ _ _ (fcard_image_leq fst (rng FRO.m{hr})))=>/#. + smt(size_ge0 prefixe_sizel). auto;smt ml=0 w=(hinv_image card_rng_set). - auto;progress;3:by smt ml=0. + by rewrite rng_set rem0 rng0 fset0U fcard1. by apply max_ge0. qed. lemma Pr_G1col &m: - Pr[Gpr(DRestr(D)).main() @ &m : G1.bcol] <= max_size%r * ((2*max_size)%r / (2^c)%r). + Pr[G1(DRestr(D)).main() @ &m : G1.bcol] <= max_size%r * ((2*max_size)%r / (2^c)%r). proof. apply (ler_trans Pr[Gcol.main()@&m : G1.bcol /\ Gcol.count <= max_size]). - + byequiv G1col=> //#. + + byequiv G1_col=> //#. apply (Pr_col &m). qed. diff --git a/proof/smart_counter/Gconcl.ec b/proof/smart_counter/Gconcl.ec index 9356a7f..0803dcb 100644 --- a/proof/smart_counter/Gconcl.ec +++ b/proof/smart_counter/Gconcl.ec @@ -68,26 +68,32 @@ section. declare module D: DISTINGUISHER{C, Perm, F.RO, F.FRO, S, Redo}. local clone import Gext as Gext0. + local module G3(RO:F.RO) = { - module C = { + module M = { proc f(p : block list): block = { var sa, sa'; - var h, i <- 0; + var h, i, counter <- 0; sa <- b0; while (i < size p ) { if (mem (dom G1.mh) (sa +^ nth witness p i, h)) { RO.sample(take (i+1) p); (sa, h) <- oget G1.mh.[(sa +^ nth witness p i, h)]; } else { - RRO.sample(G1.chandle); - sa' <@ RO.get(take (i+1) p); - sa <- sa +^ nth witness p i; - G1.mh.[(sa,h)] <- (sa', G1.chandle); - G1.mhi.[(sa',G1.chandle)] <- (sa, h); - (sa,h) <- (sa',G1.chandle); - G1.chandle <- G1.chandle + 1; + if (counter < size p - prefixe p (get_max_prefixe p (elems (dom C.queries)))) { + RRO.sample(G1.chandle); + sa' <@ RO.get(take (i+1) p); + sa <- sa +^ nth witness p i; + G1.mh.[(sa,h)] <- (sa', G1.chandle); + G1.mhi.[(sa',G1.chandle)] <- (sa, h); + (sa,h) <- (sa',G1.chandle); + G1.chandle <- G1.chandle + 1; + counter <- counter + 1; + } else { + RO.sample(take (i+1) p); + } } i <- i + 1; } @@ -193,7 +199,7 @@ local module G3(RO:F.RO) = { RRO.set(0,c0); G1.paths <- map0.[c0 <- ([<:block>],b0)]; G1.chandle <- 1; - b <@ DRestr(D,C,S).distinguish(); + b <@ DRestr(D,M,S).distinguish(); return b; } }. @@ -246,7 +252,7 @@ proof. proc;sp;if=>//;auto;if;1:auto;sim. call (_: ={FRO.m,F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.chandle,G1.paths,C.c,C.queries});2:by auto. - by inline F.LRO.sample;sim. + by inline*;sim. qed. local module G4(RO:F.RO) = { @@ -342,7 +348,8 @@ proof. call (_: ={G1.m,G1.mi,G1.paths,F.RO.m,C.c,C.queries});last by auto. sp;sim; while(={i,p,F.RO.m})=>//. inline F.RO.sample F.RO.get;if{1};1:by auto. - by sim;inline *;auto;progress;apply DCapacity.dunifin_ll. + if{1};2:by auto. + by sim;inline *;auto;progress;smt(DCapacity.dunifin_ll). qed. local equiv G4_Ideal : G4(F.LRO).distinguish ~ IdealIndif(IF,S,DRestr(D)).main : diff --git a/proof/smart_counter/Gext.eca b/proof/smart_counter/Gext.eca index 5e485f2..34225b6 100644 --- a/proof/smart_counter/Gext.eca +++ b/proof/smart_counter/Gext.eca @@ -7,7 +7,7 @@ require import DProd Dexcepted. require (*..*) Gcol. clone export Gcol as Gcol0. -print Eager. + op bad_ext (m mi:smap) y = mem (image snd (dom m)) y \/ mem (image snd (dom mi)) y. @@ -17,23 +17,26 @@ op hinvc (m:(handle,capacity)fmap) (c:capacity) = module G2(D:DISTINGUISHER,HS:FRO) = { - module C = { + module M = { proc f(p : block list): block = { var sa, sa'; - var h, i <- 0; + var h, i, counter <- 0; sa <- b0; while (i < size p ) { if (mem (dom G1.mh) (sa +^ nth witness p i, h)) { (sa, h) <- oget G1.mh.[(sa +^ nth witness p i, h)]; } else { - HS.sample(G1.chandle); - sa' <@ F.RO.get(take (i+1) p); - sa <- sa +^ nth witness p i; - G1.mh.[(sa,h)] <- (sa', G1.chandle); - G1.mhi.[(sa',G1.chandle)] <- (sa, h); - (sa,h) <- (sa',G1.chandle); - G1.chandle <- G1.chandle + 1; + if (counter < size p - prefixe p (get_max_prefixe p (elems (dom C.queries)))) { + HS.sample(G1.chandle); + sa' <@ F.RO.get(take (i+1) p); + sa <- sa +^ nth witness p i; + G1.mh.[(sa,h)] <- (sa', G1.chandle); + G1.mhi.[(sa',G1.chandle)] <- (sa, h); + (sa,h) <- (sa',G1.chandle); + G1.chandle <- G1.chandle + 1; + counter <- counter + 1; + } } i <- i + 1; } @@ -134,25 +137,25 @@ module G2(D:DISTINGUISHER,HS:FRO) = { proc distinguish(): bool = { var b; - F.RO.m <- map0; + F.RO.m <- map0; G1.m <- map0; G1.mi <- map0; G1.mh <- map0; G1.mhi <- map0; G1.bext <- false; - + C.queries<- map0.[[] <- b0]; (* the empty path is initially known by the adversary to lead to capacity 0^c *) HS.set(0,c0); G1.paths <- map0.[c0 <- ([<:block>],b0)]; G1.chandle <- 1; - b <@ D(C,S).distinguish(); + b <@ D(M,S).distinguish(); return b; } }. section. - declare module D: DISTINGUISHER{G1, G2, FRO}. + declare module D: DISTINGUISHER{G1, G2, FRO, C}. op inv_ext (m mi:smap) (FROm:handles) = exists x h, mem (dom m `|` dom mi) x /\ FROm.[h] = Some (x.`2, Unknown). @@ -167,34 +170,37 @@ section. by move=> [t f'] /=;case (f'=f). qed. - equiv G1_G2 : G1(D).main ~ Eager(G2(D)).main1 : + equiv G1_G2 : G1(DRestr(D)).main ~ Eager(G2(DRestr(D))).main1 : ={glob D} ==> ={res} /\ inv_ext1 G1.bext{1} G1.bext{2} G1.m{2} G1.mi{2} FRO.m{2}. proof. proc;inline{2} FRO.init G2(D, FRO).distinguish;wp. - call (_: ={F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.paths,G1.chandle,FRO.m} /\ + inline*;wp. + call (_: ={F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.paths,G1.chandle,FRO.m,C.queries,C.c} /\ inv_ext1 G1.bext{1} G1.bext{2} G1.m{2} G1.mi{2} FRO.m{2} /\ (forall h, mem (dom FRO.m) h => h < G1.chandle){1}). - + proc;if=>//;last by auto. - seq 2 2: (={F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.paths,G1.chandle,FRO.m,x,y} /\ - inv_ext1 G1.bext{1} G1.bext{2} G1.m{2} G1.mi{2} FRO.m{2} /\ + + proc. + sp;if;auto;inline G1(DRestr(D)).S.f G2(DRestr(D), FRO).S.f;sp;wp. + if=>//;last by auto. + seq 2 2: (={F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.paths,G1.chandle,FRO.m,x,x0,y0,C.queries,C.c} /\ + inv_ext1 G1.bext{1} G1.bext{2} G1.m{2} G1.mi{2} FRO.m{2} /\ x{1} = x0{1} /\ (forall h, mem (dom FRO.m) h => h < G1.chandle){1} /\ - ! mem (dom G1.m{1}) x{1}). + ! mem (dom G1.m{1}) x0{1}). + by if=>//;auto;call (_: ={F.RO.m});[sim |auto]. seq 3 5: - (={F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.paths,G1.chandle,FRO.m,hx2,x,y,hx2} /\ - t{2} = (in_dom_with FRO.m (oget G1.mh.[(x.`1, hx2)]).`2 Unknown){1} /\ + (={F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.paths,G1.chandle,FRO.m,hx2,x,x0,y0,hx2,C.queries,C.c} /\ + t{2} = (in_dom_with FRO.m (oget G1.mh.[(x.`1, hx2)]).`2 Unknown){1} /\ x{1} = x0{1} /\ (G1.bext{1} => (G1.bext{2} \/ (mem (rng FRO.m) (x.`2, Unknown)){2} \/ inv_ext G1.m{2} G1.mi{2} FRO.m{2})) /\ (forall h, mem (dom FRO.m) h => h < G1.chandle){1} /\ - ! mem (dom G1.m{1}) x{1}). - + inline *;auto=> &ml&mr[#]10!-> Hi Hhand -> /=. - rewrite -dom_restr rng_restr /=;progress; 3:by smt ml=0. + ! mem (dom G1.m{1}) x0{1}). + + inline *;auto=> &ml&mr[#]10!-> -> ->->Hi-> Hhand -> /=. + rewrite -dom_restr rng_restr /=;progress;3:by smt ml=0. + rewrite rng_set !inE rem_id 1:/#;move:H0=>[/Hi[->|[x' h][]H1 H2]|->]//. right;right;exists x' h;rewrite getP. by cut ->//:(h<> G1.chandle{mr});move:(Hhand h);rewrite in_dom H2 /#. by move:H0;rewrite dom_set !inE /#. - seq 1 1: (={x,y,F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.paths,G1.chandle,FRO.m} /\ - inv_ext1 G1.bext{1} G1.bext{2} G1.m{2} G1.mi{2} FRO.m{2} /\ + seq 1 1: (={x0,y0,x,F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.paths,G1.chandle,FRO.m,C.queries,C.c} /\ + inv_ext1 G1.bext{1} G1.bext{2} G1.m{2} G1.mi{2} FRO.m{2} /\ x{1} = x0{1} /\ forall (h : handle), mem (dom FRO.m{1}) h => h < G1.chandle{1});2:by auto. if=>//. + inline *;rcondt{2} 4. @@ -203,10 +209,10 @@ section. auto;progress. + by apply sampleto_ll. + rewrite /inv_ext1=>/H{H}[->//|[/in_rng[h]Hh|[[x1 x2] h [Hx Hh]]]]. - + case (h = (oget G1.mh{2}.[(x{2}.`1, hx2{2})]).`2)=> [->>|Hneq]. - + by left;rewrite Hh oget_some. - by right;exists x{2} h;rewrite dom_set getP Hneq !inE. - case (h = (oget G1.mh{2}.[(x{2}.`1, hx2{2})]).`2)=> [->>|Hneq]. + + case (h = (oget G1.mh{2}.[(x0{2}.`1, hx2{2})]).`2)=> [->>|Hneq]. + + by rewrite Hh oget_some/#. + by right;exists x0{2} h;rewrite dom_set getP Hneq !inE. + case (h = (oget G1.mh{2}.[(x0{2}.`1, hx2{2})]).`2)=> [->>|Hneq]. + rewrite Hh /bad_ext oget_some /= <@ Hx;rewrite !inE. by move=>[|]/(mem_image snd)->. right;exists (x1,x2) h;rewrite !dom_set getP Hneq //=. @@ -214,21 +220,22 @@ section. by move:H6 H2;rewrite /in_dom_with dom_set !inE /#. inline *;auto;progress;last by move:H3;rewrite dom_set !inE /#. rewrite /inv_ext1=> /H [->//|[/in_rng[h]Hh|[x' h [Hx Hh]]]]. - + right;exists x{2} h;rewrite getP dom_set !inE /=. + + right;exists x0{2} h;rewrite getP dom_set !inE /=. by move:(H0 h);rewrite in_dom Hh /#. right;exists x' h;rewrite getP !dom_set !inE;split. + by move:Hx;rewrite !inE=>-[]->. by move:(H0 h);rewrite !in_dom Hh /#. - + proc;if=>//;last by auto. + + proc;sp;if;auto;inline G1(DRestr(D)).S.fi G2(DRestr(D), FRO).S.fi;sp;wp. + if=>//;last by auto. seq 6 8: - (={F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.paths,G1.chandle,FRO.m,hx2,x,y,hx2} /\ - t{2} = (in_dom_with FRO.m (oget G1.mhi.[(x.`1, hx2)]).`2 Unknown){1} /\ + (={F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.paths,G1.chandle,FRO.m,hx2,x,x0,y0,hx2,C.queries,C.c} /\ + t{2} = (in_dom_with FRO.m (oget G1.mhi.[(x.`1, hx2)]).`2 Unknown){1} /\ x{1} = x0{1} /\ (G1.bext{1} => (G1.bext{2} \/ (mem (rng FRO.m) (x.`2, Unknown)){2} \/ inv_ext G1.m{2} G1.mi{2} FRO.m{2})) /\ (forall h, mem (dom FRO.m) h => h < G1.chandle){1} /\ ! mem (dom G1.mi{1}) x{1}). - + inline *;auto=> &ml&mr[#]9!-> Hi Hhand -> /=. + + inline *;auto=> &ml&mr[#]-><-_ _9!-> Hi Hhand _ -> /=. rewrite -dom_restr rng_restr /=;progress; 3:by smt ml=0. + rewrite rng_set !inE rem_id 1:/#;move:H4=>[/Hi[->|[x' h][]HH1 HH2]|->]//. right;right;exists x' h;rewrite getP. @@ -240,10 +247,10 @@ section. auto;progress. + by apply sampleto_ll. + rewrite /inv_ext1=>/H{H}[->//|[/in_rng[h]Hh|[[x1 x2] h [Hx Hh]]]]. - + case (h = (oget G1.mhi{2}.[(x{2}.`1, hx2{2})]).`2)=> [->>|Hneq]. + + case (h = (oget G1.mhi{2}.[(x0{2}.`1, hx2{2})]).`2)=> [->>|Hneq]. + by left;rewrite Hh oget_some. - by right;exists x{2} h;rewrite !dom_set getP Hneq !inE. - case (h = (oget G1.mhi{2}.[(x{2}.`1, hx2{2})]).`2)=> [->>|Hneq]. + by right;exists x0{2} h;rewrite !dom_set getP Hneq !inE. + case (h = (oget G1.mhi{2}.[(x0{2}.`1, hx2{2})]).`2)=> [->>|Hneq]. + rewrite Hh /bad_ext oget_some /= <@ Hx;rewrite !inE. by move=>[|]/(mem_image snd)->. right;exists (x1,x2) h;rewrite !dom_set getP Hneq //=. @@ -251,34 +258,35 @@ section. by move:H6 H2;rewrite /in_dom_with dom_set !inE /#. inline *;auto;progress;last by move:H3;rewrite dom_set !inE /#. rewrite /inv_ext1=> /H [->//|[/in_rng[h]Hh|[x' h [Hx Hh]]]]. - + right;exists x{2} h;rewrite getP !dom_set !inE /=. + + right;exists x0{2} h;rewrite getP !dom_set !inE /=. by move:(H0 h);rewrite in_dom Hh /#. right;exists x' h;rewrite getP !dom_set !inE;split. + by move:Hx;rewrite !inE=>-[]->. by move:(H0 h);rewrite !in_dom Hh /#. - + proc; - conseq (_: ={sa,G1.mh,G1.mhi,F.RO.m, G1.chandle, FRO.m} /\ + + proc;sp;if;auto;sp;if;auto;sp. + inline G1(DRestr(D)).M.f G2(DRestr(D), FRO).M.f;sp;wp. + conseq (_: ={sa,G1.mh,G1.mhi,F.RO.m, G1.chandle, FRO.m,C.queries,C.c} /\ inv_ext1 G1.bext{1} G1.bext{2} G1.m{2} G1.mi{2} FRO.m{2} /\ forall (h0 : handle), mem (dom FRO.m{1}) h0 => h0 < G1.chandle{1})=>//. - sp 3 3;call (_: ={F.RO.m});1:by sim. - while (={sa,G1.mh,G1.mhi,F.RO.m,G1.chandle,FRO.m,i,h,sa,p} /\ - inv_ext1 G1.bext{1} G1.bext{2} G1.m{2} G1.mi{2} FRO.m{2} /\ + sp;call (_: ={F.RO.m});1:by sim. + while (={sa,G1.mh,G1.mhi,F.RO.m,G1.chandle,FRO.m,i,h,sa,p,C.queries,counter,bs} /\ + inv_ext1 G1.bext{1} G1.bext{2} G1.m{2} G1.mi{2} FRO.m{2} /\ p{2} = bs{2} /\ forall (h0 : handle), mem (dom FRO.m{1}) h0 => h0 < G1.chandle{1})=>//. if=>//;inline *;1:by auto. + if;1,3:auto;progress. rcondt{2} 3;1:by auto=>/#. - auto=> &m1&m2 [#] 10!-> Hinv Hhand Hi _ _ /= ?->?->/=;split=>/= _;split. - + move:Hinv;rewrite /inv_ext1=> H/H{H}[->//|[x h]];rewrite inE=>-[Hmem Hh]. - by right;exists x h;rewrite !inE Hmem getP;smt w=in_dom. - + by move=>h;rewrite dom_set !inE /#. - + move:Hinv;rewrite /inv_ext1=> H/H{H}[->//|[x h]];rewrite inE=>-[Hmem Hh]. - by right;exists x h;rewrite !inE Hmem getP;smt w=in_dom. - by move=>h;rewrite dom_set !inE /#. + auto;progress. + + move=>bad1;cut[/=->//|]:=H bad1;rewrite/inv_ext=>[][]x h[]H_dom Hh;right. + by exists x h;rewrite H_dom/=getP/= Hh;smt(in_dom getP). + + smt(dom_set in_fsetU1). + + move=>bad1;cut[/=->//|]:=H bad1;rewrite/inv_ext=>[][]x h[]H_dom Hh;right. + by exists x h;rewrite H_dom/=getP/= Hh;smt(in_dom getP). + + smt(dom_set in_fsetU1). (* **************** *) inline *;auto;progress. - auto;inline*;auto;progress. - by move:H;rewrite dom_set dom0 !inE=>->. + smt(dom_set in_fsetU1 dom0 in_fset0). qed. end section. @@ -317,23 +325,26 @@ section EXT. Iter(ReSample).iter (elems (dom (restr Unknown FRO.m))); } - module C = { + module M = { proc f(p : block list): block = { var sa, sa'; - var h, i <- 0; + var h, i, counter <- 0; sa <- b0; while (i < size p ) { if (mem (dom G1.mh) (sa +^ nth witness p i, h)) { (sa, h) <- oget G1.mh.[(sa +^ nth witness p i, h)]; } else { - RRO.sample(G1.chandle); - sa' <@ F.RO.get(take (i+1) p); - sa <- sa +^ nth witness p i; - G1.mh.[(sa,h)] <- (sa', G1.chandle); - G1.mhi.[(sa',G1.chandle)] <- (sa, h); - (sa,h) <- (sa',G1.chandle); - G1.chandle <- G1.chandle + 1; + if (counter < size p - prefixe p (get_max_prefixe p (elems (dom C.queries)))) { + RRO.sample(G1.chandle); + sa' <@ F.RO.get(take (i+1) p); + sa <- sa +^ nth witness p i; + G1.mh.[(sa,h)] <- (sa', G1.chandle); + G1.mhi.[(sa',G1.chandle)] <- (sa, h); + (sa,h) <- (sa',G1.chandle); + G1.chandle <- G1.chandle + 1; + counter <- counter + 1; + } } i <- i + 1; } @@ -449,7 +460,7 @@ section EXT. RRO.set(0,c0); G1.paths <- map0.[c0 <- ([<:block>],b0)]; G1.chandle <- 1; - b <@ DRestr(D,C,S).distinguish(); + b <@ DRestr(D,M,S).distinguish(); resample(); return b; } @@ -549,147 +560,114 @@ section EXT. move=> b1 c1;proc;auto=> /#. qed. + local equiv EG2_Gext : Eager(G2(DRestr(D))).main2 ~ Gext.distinguish: - ={glob D} ==> - ((G1.bext{1} \/ inv_ext G1.m{1} G1.mi{1} FRO.m{1}) => - ReSample.count{2} <= max_size /\ G1.bext{2}). + ={glob D} ==> + ReSample.count{2} <= max_size /\ + ((G1.bext{1} \/ inv_ext G1.m{1} G1.mi{1} FRO.m{1}) => G1.bext{2}). proof. - proc;inline *;wp;sp. - swap{1}[2..3]2;swap{2}2 2;wp. print inv_ext. - while (={l,G1.m,G1.mi} - /\ ((!G1.bext{1} /\ forall (x : state) (h : handle), - !mem (dom G1.m{1} `|` dom G1.mi{1}) x \/ - FRO.m{1}.[h] <> Some (x.`2, Unknown) \/ mem l{1} h) => - ={FRO.m} - /\ size G1.m{2} <= max_size /\ size G1.mi{2} <= max_size - /\ ReSample.count{2} + size l{2} <= max_size) - /\ ((G1.bext{1} \/ exists (x : state) (h : handle), + proc;inline *;wp. + while (={l,FRO.m,G1.m,G1.mi} /\ size G1.m{2} <= max_size /\ + size G1.mi{2} <= max_size /\ + ReSample.count{2} + size l{2} <= max_size /\ + ((G1.bext{1} \/ + exists (x : state) (h : handle), mem (dom G1.m{1} `|` dom G1.mi{1}) x /\ FRO.m{1}.[h] = Some (x.`2, Unknown) /\ !mem l{1} h) => G1.bext{2})). - + case(G1.bext{1} \/ exists (x1 : state) (h0 : handle), - (x1 \in dom G1.m{1} `|` dom G1.mi{1}) /\ - FRO.m{1}.[h0] = Some (x1.`2, Unknown) /\ ! (h0 \in l{1}))=>//=. - auto;progress. - + move:H3;rewrite H9/==>[][]a b. - cut[->//=|[|]]:=H10 a b. - + rewrite getP;case(b = head witness l{2})=>[->>|hb->//=]/=. - by rewrite-(@mem_head_behead witness)//. - by move=>h;cut->//=:=mem_drop _ _ _ h. - + rewrite size_drop//=. - cut/#:=H _;rewrite H9/==>x h. - cut:=H10 x h;rewrite getP/==>[][->|[|]]//=. - + case(h=head witness l{2})=>[->>|hb->//=]/=. - by rewrite-(@mem_head_behead witness)//. - by move=>h2;cut->//=:=mem_drop _ _ _ h2. - + by cut->:=H0 H3. - + admit. - + admit. - + admit. - + admit. - + admit. - + admit. - + admit. -(* rcondt{2} 3. *) -(* + move=> &m;auto=> &m'[#] 6!-> /= + _ _;case (l{m'})=>//=; smt w=List.size_ge0. *) -(* auto=> &ml&mr[#]6!->;case(l{mr})=>[//|h1 l1/=Hle Hext c->/=];split. *) -(* + smt w=(drop0 size_ge0). *) -(* rewrite drop0=>-[H|[x h][#]];1:by rewrite Hext // H. *) -(* rewrite getP;case (h=h1)=> [/=->Hin->_ | Hneq ???]. *) -(* + by right;apply (@mem_image snd _ x). *) -(* by rewrite Hext 2://;right;exists x h;rewrite Hneq. *) -(* conseq(:_==> (={l,FRO.m,G1.m,G1.mi} /\ *) -(* size G1.m{2} <= max_size /\ *) -(* size G1.mi{2} <= max_size /\ *) -(* ReSample.count{2} + size l{2} <= max_size /\ *) -(* ((G1.bext{1} \/ *) -(* exists (x : state) (h : handle), *) -(* mem (dom G1.m{1} `|` dom G1.mi{1}) x /\ *) -(* FRO.m{1}.[h] = Some (x.`2, Unknown) /\ !mem l{1} h) => *) -(* G1.bext{2})));1:progress=>/#;wp=>/=. *) - -(* call (_: ={F.RO.m,FRO.m,G1.paths,G1.mh,G1.mhi,G1.m,G1.mi,G1.chandle,G1.bext,C.c,C.queries} /\ *) -(* inv_le G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2}). *) -(* + proc;sp;if=> //;swap -1. *) -(* call (_: ={x,F.RO.m,FRO.m,G1.paths,G1.mh,G1.mhi,G1.m,G1.mi,G1.chandle,G1.bext,C.c,C.queries} /\ *) -(* inv_lt G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2} ==> *) -(* ={res,F.RO.m,FRO.m,G1.paths,G1.mh,G1.mhi,G1.m,G1.mi,G1.chandle,G1.bext,C.c,C.queries} /\ *) -(* inv_le G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2});last by auto=>/#. *) -(* proc;if=>//;last by auto=>/#. *) -(* seq 8 9 : (={x, y, F.RO.m, FRO.m, G1.paths, G1.mh, G1.mhi, G1.m, G1.mi, G1.chandle, *) -(* G1.bext, C.c,C.queries} /\ *) -(* inv_le G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2});2:by auto. *) -(* seq 2 3 : *) -(* (={y,x,F.RO.m,FRO.m,G1.paths,G1.mh,G1.mhi,G1.m,G1.mi,G1.chandle,G1.bext, C.c,C.queries} /\ *) -(* inv_lt G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2}). *) -(* + by if=>//;auto;call (_: ={F.RO.m});auto. *) -(* seq 5 5 : *) -(* (={t,y,x,hx2,F.RO.m,FRO.m,G1.paths,G1.mh,G1.mhi,G1.m,G1.mi,G1.chandle,G1.bext, C.c,C.queries} /\ *) -(* inv_lt G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2} /\ *) -(* (t => in_dom_with FRO.m (oget G1.mh.[(x.`1, hx2)]).`2 Unknown){1}). *) -(* + inline RRO.in_dom; wp;call (_: ={FRO.m});1:by sim. *) -(* inline RRO.restrK;sp 1 1;if=>//. *) -(* by wp;call RROset_inv_lt;auto. *) -(* if=>//;wp. *) -(* + inline *;rcondt{1} 4;1:by auto=>/#. *) -(* rcondt{2} 5;1:by auto;smt w=(sizeE size_ge0). *) -(* rcondt{2} 10. by auto;progress;rewrite dom_set !inE. *) -(* wp;rnd{2};auto=> /= ??[#]!-> @/inv_lt @/inv_le [#] mlt milt clt cle Hin 3?->/=. *) -(* rewrite/Distr.is_lossless (sampleto_ll 0)/= => ? _;rewrite /bad_ext !getP /= !oget_some /= set_set_eq /=. *) -(* rewrite !(imageU,inE) restr_set /= size_rem dom_restr Hin //=; smt w=size_set_le. *) -(* by call RROset_inv_lt;auto;smt w=size_set_le. *) - -(* + proc;sp;if=> //;swap -1. *) -(* call (_: ={x,F.RO.m,FRO.m,G1.paths,G1.mh,G1.mhi,G1.m,G1.mi,G1.chandle,G1.bext,C.c,C.queries} /\ *) -(* inv_lt G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2} ==> *) -(* ={res,F.RO.m,FRO.m,G1.paths,G1.mh,G1.mhi,G1.m,G1.mi,G1.chandle,G1.bext,C.c,C.queries} /\ *) -(* inv_le G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2});last by auto=> /#. *) -(* proc;if=>//;last by auto=>/#. *) -(* seq 8 8 : *) -(* (={t,y,x,hx2,F.RO.m,FRO.m,G1.paths,G1.mh,G1.mhi,G1.m,G1.mi,G1.chandle,G1.bext,C.c,C.queries} /\ *) -(* inv_lt G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2} /\ *) -(* (t => in_dom_with FRO.m (oget G1.mhi.[(x.`1, hx2)]).`2 Unknown){1}). *) -(* + inline RRO.in_dom; auto;call (_: ={FRO.m});1:by sim. *) -(* inline RRO.restrK;sp 1 1;if=>//. *) -(* by wp;call RROset_inv_lt;auto. *) -(* if=>//;wp. *) -(* + inline *;rcondt{1} 4;1:by auto=>/#. *) -(* rcondt{2} 5;1:by auto;smt w=(sizeE size_ge0). *) -(* rcondt{2} 10. by auto;progress;rewrite dom_set !inE. *) -(* wp;rnd{2};auto=> /= ??[#]!-> @/inv_lt @/inv_le [#] mlt milt clt cle Hin 3?->/=. *) -(* rewrite/Distr.is_lossless (sampleto_ll 0) /= => ? _;rewrite /bad_ext !getP /= !oget_some /= set_set_eq /=. *) -(* rewrite !(imageU,inE) restr_set /= size_rem dom_restr Hin //=; smt w=size_set_le. *) -(* by call RROset_inv_lt;auto;smt w=size_set_le. *) - -(* + proc;sp 1 1. *) -(* if;auto. *) -(* if=>//. *) -(* inline G2(DRestr(D), RRO).C.f Gext.C.f. *) -(* sp 5 5;elim *=> c0L c0R. *) -(* wp;call (_: ={F.RO.m});1:by sim. *) -(* while (={i,p,G1.mh,sa,h,FRO.m,F.RO.m,G1.mh,G1.mhi,G1.chandle} /\ 0 <= i{1} <= size p{1}/\ *) -(* c0R + size p{1} - prefixe bs{1} (get_max_prefixe bs{1} (elems (dom C.queries{1}))) <= max_size /\ *) -(* inv_le G1.m{2} G1.mi{2} (c0R + i){2} FRO.m{2} ReSample.count{2}); *) -(* last first. *) -(* + auto;progress. *) -(* admit. *) -(* admit. *) -(* admit. *) -(* admit. *) -(* admit. *) -(* (* - smt(size_ge0) *) *) -(* (* by auto;smt(List.size_ge0 @Prefixe). *) *) -(* (* if=> //;1:by auto=>/#. *) *) -(* (* auto;call (_: ={F.RO.m});1:by sim. *) *) -(* (* inline *;auto=> ?&mr [#]!->@/inv_le Hi [#]. *) *) -(* (* case (p{mr})=> [/#|/=p1 p2] 4?_ /= 2?-> /=;split=>/= Hmem 4? [#]2->/= => [|/#]. *) *) -(* (* by rewrite restr_set /= size_set dom_restr /in_dom_with Hmem/= /#. *) *) - -(* auto;progress[delta];rewrite ?(size0,restr0,restr_set,rem0,max_ge0,-sizeE,-cardE) //=. *) -(* + smt ml=0. + smt ml=0. + smt ml=0. *) -(* + elim H7=>// [[x h] [#]];rewrite -memE dom_restr /in_dom_with in_dom=> _ ->/=. *) -(* by rewrite oget_some. *) -(* apply H10=>//. *) + + rcondt{2} 3. + + move=> &m;auto=> &m'[#] 6!-> /= + _ _;case (l{m'})=>//=; smt w=List.size_ge0. + auto=> &ml&mr[#]6!->;case(l{mr})=>[//|h1 l1/=Hle Hext c->/=];split. + + smt w=(drop0 size_ge0). + rewrite drop0=>-[H|[x h][#]];1:by rewrite Hext // H. + rewrite getP;case (h=h1)=> [/=->Hin->_ | Hneq ???]. + + by right;apply (mem_image snd _ x). + by rewrite Hext 2://;right;exists x h;rewrite Hneq. + wp; call (_: ={F.RO.m,FRO.m,G1.paths,G1.mh,G1.mhi,G1.m,G1.mi,G1.chandle,G1.bext, C.c,C.queries} /\ + inv_le G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2}). + + proc;sp;if=>//=;swap -1. + call (_: ={x,F.RO.m,FRO.m,G1.paths,G1.mh,G1.mhi,G1.m,G1.mi,G1.chandle,G1.bext,C.c,C.queries} /\ + inv_lt G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2} ==> + ={res,F.RO.m,FRO.m,G1.paths,G1.mh,G1.mhi,G1.m,G1.mi,G1.chandle,G1.bext,C.c,C.queries} /\ + inv_le G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2});last by auto=>/#. + proc;if=>//;last by auto=>/#. + seq 8 9 : (={x, y, F.RO.m, FRO.m, G1.paths, G1.mh, G1.mhi, G1.m, G1.mi, G1.chandle, + G1.bext, C.c, C.queries} /\ + inv_le G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2});2:by auto. + seq 2 3 : + (={y,x,F.RO.m,FRO.m,G1.paths,G1.mh,G1.mhi,G1.m,G1.mi,G1.chandle,G1.bext, C.c,C.queries} /\ + inv_lt G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2}). + + by if=>//;auto;call (_: ={F.RO.m});auto. + seq 5 5 : + (={t,y,x,hx2,F.RO.m,FRO.m,G1.paths,G1.mh,G1.mhi,G1.m,G1.mi,G1.chandle,G1.bext, C.c,C.queries} /\ + inv_lt G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2} /\ + (t => in_dom_with FRO.m (oget G1.mh.[(x.`1, hx2)]).`2 Unknown){1}). + + inline RRO.in_dom; wp;call (_: ={FRO.m});1:by sim. + inline RRO.restrK;sp 1 1;if=>//. + by wp;call RROset_inv_lt;auto. + if=>//;wp. + + inline *;rcondt{1} 4;1:by auto=>/#. + rcondt{2} 5;1:by auto;smt w=(sizeE size_ge0). + rcondt{2} 10. by auto;progress;rewrite dom_set !inE. + wp;rnd{2};auto=> /= ??[#]!-> @/inv_lt @/inv_le [#] mlt milt clt cle Hin 3?->/=. + rewrite/Distr.is_lossless (sampleto_ll 0)/= => ? _;rewrite /bad_ext !getP /= !oget_some /= set_set_eq /=. + rewrite !(imageU,inE) restr_set /= size_rem dom_restr Hin //=; smt w=size_set_le. + by call RROset_inv_lt;auto;smt w=size_set_le. + + + proc;sp;if=> //;swap -1. + call (_: ={x,F.RO.m,FRO.m,G1.paths,G1.mh,G1.mhi,G1.m,G1.mi,G1.chandle,G1.bext,C.c} /\ + inv_lt G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2} ==> + ={res,F.RO.m,FRO.m,G1.paths,G1.mh,G1.mhi,G1.m,G1.mi,G1.chandle,G1.bext,C.c} /\ + inv_le G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2});last by auto=> /#. + proc;if=>//;last by auto=>/#. + seq 8 8 : + (={t,y,x,hx2,F.RO.m,FRO.m,G1.paths,G1.mh,G1.mhi,G1.m,G1.mi,G1.chandle,G1.bext, C.c} /\ + inv_lt G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2} /\ + (t => in_dom_with FRO.m (oget G1.mhi.[(x.`1, hx2)]).`2 Unknown){1}). + + inline RRO.in_dom; auto;call (_: ={FRO.m});1:by sim. + inline RRO.restrK;sp 1 1;if=>//. + by wp;call RROset_inv_lt;auto. + if=>//;wp. + + inline *;rcondt{1} 4;1:by auto=>/#. + rcondt{2} 5;1:by auto;smt w=(sizeE size_ge0). + rcondt{2} 10. by auto;progress;rewrite dom_set !inE. + wp;rnd{2};auto=> /= ??[#]!-> @/inv_lt @/inv_le [#] mlt milt clt cle Hin 3?->/=. + rewrite/Distr.is_lossless (sampleto_ll 0) /= => ? _;rewrite /bad_ext !getP /= !oget_some /= set_set_eq /=. + rewrite !(imageU,inE) restr_set /= size_rem dom_restr Hin //=; smt w=size_set_le. + by call RROset_inv_lt;auto;smt w=size_set_le. + + + proc;sp 1 1;if;auto;if;auto=>//. + inline G2(DRestr(D), RRO).M.f Gext.M.f. + sp 6 6;elim *=> c0L c0R. + wp;call (_: ={F.RO.m});1:by sim. + conseq(:_==> ={i,p,G1.mh,sa,h,FRO.m,F.RO.m,G1.mh,G1.mhi,G1.chandle,counter} /\ + 0 <= i{1} <= size p{1} /\ + 0 <= counter{1} <= size p{1} - + prefixe bs{1} (get_max_prefixe bs{1} (elems (dom C.queries{1}))) /\ + c0R + size p{1} - + prefixe bs{1} (get_max_prefixe bs{1} (elems (dom C.queries{1}))) <= max_size /\ + inv_le G1.m{2} G1.mi{2} (c0R + counter){2} FRO.m{2} ReSample.count{2});1:smt(List.size_ge0). + while (={bs,i,p,G1.mh,sa,h,FRO.m,F.RO.m,G1.mh,G1.mhi,G1.chandle,counter,C.queries} /\ + bs{1} = p{1} /\ 0 <= i{1} <= size p{1} /\ + 0 <= counter{1} <= size p{1} - + prefixe bs{1} (get_max_prefixe bs{1} (elems (dom C.queries{1}))) /\ + c0R + size p{1} - + prefixe bs{1} (get_max_prefixe bs{1} (elems (dom C.queries{1}))) <= max_size /\ + inv_le G1.m{2} G1.mi{2} (c0R + counter){2} FRO.m{2} ReSample.count{2}); + last by auto;smt(List.size_ge0 prefixe_sizel). + if=> //;1:by auto=>/#. + if=> //;2:by auto=>/#. + auto;call (_: ={F.RO.m});1:by sim. + inline *;auto=> &ml &mr [#]!->@/inv_le Hi0[#] _ H_c_0 H_c_max H1 [#]H_size_m H_size_mi H_count H2 H3/=. + rewrite H3/==>H_nin_dom H_counter_prefixe c;rewrite DCapacity.dunifin_fu/=. + case(G1.chandle{mr} \in dom FRO.m{mr})=>//=[/#|]H_handle_in_dom. + progress;..-3,-1: rewrite/#; by rewrite restr_set_eq size_set/=/#. + + auto;progress[delta];rewrite ?(size0,restr0,restr_set,rem0,max_ge0,-sizeE,-cardE) //=. + + smt ml=0. + smt ml=0. + smt ml=0. + + elim H7=>// [[x h] [#]];rewrite -memE dom_restr /in_dom_with in_dom=> _ ->/=. + by rewrite oget_some. + apply H10=>//. qed. axiom D_ll: @@ -706,11 +684,11 @@ section EXT. apply (ler_trans _ _ _ (Real_G1 D D_ll &m)). do !apply ler_add => //. + cut ->: Pr[G1(DRestr(D)).main() @ &m : res] = Pr[Eager(G2(DRestr(D))).main1() @ &m : res]. - + by byequiv (G1_G2 (DRestr(D))). + + by byequiv (G1_G2 D). by apply lerr_eq;byequiv (Eager_1_2 (G2(DRestr(D)))). + by apply (Pr_G1col D D_ll &m). apply (ler_trans Pr[Eager(G2(DRestr(D))).main1()@&m: G1.bext \/ inv_ext G1.m G1.mi FRO.m]). - + by byequiv (G1_G2 (DRestr(D)))=>//#. + + by byequiv (G1_G2 D)=>//#. apply (ler_trans Pr[Eager(G2(DRestr(D))).main2()@&m : G1.bext \/ inv_ext G1.m G1.mi FRO.m]). + by apply lerr_eq;byequiv (Eager_1_2 (G2(DRestr(D)))). apply (ler_trans _ _ _ _ (Pr_ext &m)). diff --git a/proof/smart_counter/Handle.eca b/proof/smart_counter/Handle.eca index 3a7b09c..aca0768 100644 --- a/proof/smart_counter/Handle.eca +++ b/proof/smart_counter/Handle.eca @@ -6,7 +6,7 @@ require import DProd Dexcepted. require (*--*) ConcreteF. -clone import GenEager as ROhandle with +clone export GenEager as ROhandle with type from <- handle, type to <- capacity, op sampleto <- fun (_:int) => cdistr @@ -42,6 +42,7 @@ module G1(D:DISTINGUISHER) = { (sa,h) <- (sa',chandle); FRO.m.[chandle] <- (sc,Unknown); chandle <- chandle + 1; + counter <- counter + 1; } } i <- i + 1; @@ -146,6 +147,7 @@ module G1(D:DISTINGUISHER) = { mhi <- map0; bext <- false; bcol <- false; + C.queries<- map0.[[] <- b0]; (* the empty path is initially known by the adversary to lead to capacity 0^c *) FRO.m <- map0.[0 <- (c0, Known)]; @@ -1810,150 +1812,6 @@ qed. -module G1'(D:DISTINGUISHER) = { - var m, mi : smap - var mh, mhi : hsmap - var chandle : int - var paths : (capacity, block list * block) fmap - var bext, bcol : bool - - module M = { - - proc f(p : block list): block = { - var sa, sa', sc; - var h, i, counter <- 0; - sa <- b0; - sc <- c0; - while (i < size p ) { - if (mem (dom mh) (sa +^ nth witness p i, h)) { - (sa, h) <- oget mh.[(sa +^ nth witness p i, h)]; - } else { - if (counter < size p - prefixe p (get_max_prefixe p (elems (dom C.queries)))) { - sc <$ cdistr; - bcol <- bcol \/ hinv FRO.m sc <> None; - sa' <@ F.RO.get(take (i+1) p); - sa <- sa +^ nth witness p i; - mh.[(sa,h)] <- (sa', chandle); - mhi.[(sa',chandle)] <- (sa, h); - (sa,h) <- (sa',chandle); - FRO.m.[chandle] <- (sc,Unknown); - chandle <- chandle + 1; - counter <- counter + 1; - } - } - i <- i + 1; - } - sa <- F.RO.get(p); - return sa; - } - } - - module S = { - - proc f(x : state): state = { - var p, v, y, y1, y2, hy2, hx2; - - if (!mem (dom m) x) { - if (mem (dom paths) x.`2) { - (p,v) <- oget paths.[x.`2]; - y1 <- F.RO.get (rcons p (v +^ x.`1)); - y2 <$ cdistr; - } else { - y1 <$ bdistr; - y2 <$ cdistr; - } - y <- (y1, y2); - bext <- bext \/ mem (rng FRO.m) (x.`2, Unknown); - if (!(mem (rng FRO.m) (x.`2, Known))) { - FRO.m.[chandle] <- (x.`2, Known); - chandle <- chandle + 1; - } - hx2 <- oget (hinvK FRO.m x.`2); - if (mem (dom mh) (x.`1, hx2) /\ in_dom_with FRO.m (oget mh.[(x.`1,hx2)]).`2 Unknown) { - hy2 <- (oget mh.[(x.`1, hx2)]).`2; - y <- (y.`1, (oget FRO.m.[hy2]).`1); - FRO.m.[hy2] <- (y.`2, Known); - m.[x] <- y; - mi.[y] <- x; - } else { - bcol <- bcol \/ hinv FRO.m y.`2 <> None; - hy2 <- chandle; - chandle <- chandle + 1; - FRO.m.[hy2] <- (y.`2, Known); - m.[x] <- y; - mh.[(x.`1, hx2)] <- (y.`1, hy2); - mi.[y] <- x; - mhi.[(y.`1, hy2)] <- (x.`1, hx2); - } - if (mem (dom paths) x.`2) { - (p,v) <- oget paths.[x.`2]; - paths.[y.`2] <- (rcons p (v +^ x.`1), y.`1); - } - } else { - y <- oget m.[x]; - } - return y; - } - - proc fi(x : state): state = { - var y, y1, y2, hx2, hy2; - - if (!mem (dom mi) x) { - bext <- bext \/ mem (rng FRO.m) (x.`2, Unknown); - if (!(mem (rng FRO.m) (x.`2, Known))) { - FRO.m.[chandle] <- (x.`2, Known); - chandle <- chandle + 1; - } - hx2 <- oget (hinvK FRO.m x.`2); - y1 <$ bdistr; - y2 <$ cdistr; - y <- (y1,y2); - if (mem (dom mhi) (x.`1,hx2) /\ - in_dom_with FRO.m (oget mhi.[(x.`1,hx2)]).`2 Unknown) { - (y1,hy2) <- oget mhi.[(x.`1, hx2)]; - y <- (y.`1, (oget FRO.m.[hy2]).`1); - FRO.m.[hy2] <- (y.`2, Known); - mi.[x] <- y; - m.[y] <- x; - } else { - bcol <- bcol \/ hinv FRO.m y.`2 <> None; - hy2 <- chandle; - chandle <- chandle + 1; - FRO.m.[hy2] <- (y.`2, Known); - mi.[x] <- y; - mhi.[(x.`1, hx2)] <- (y.`1, hy2); - m.[y] <- x; - mh.[(y.`1, hy2)] <- (x.`1, hx2); - } - } else { - y <- oget mi.[x]; - } - return y; - } - - } - - proc main(): bool = { - var b; - - F.RO.m <- map0; - m <- map0; - mi <- map0; - mh <- map0; - mhi <- map0; - bext <- false; - bcol <- false; - - (* the empty path is initially known by the adversary to lead to capacity 0^c *) - FRO.m <- map0.[0 <- (c0, Known)]; - paths <- map0.[c0 <- ([<:block>],b0)]; - chandle <- 1; - b <@ D(M,S).distinguish(); - return b; - } -}. - - lemma lemma5 hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes queries i (p : block list) b c h: INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes queries => 0 <= i < size p @@ -2763,15 +2621,18 @@ section. Pr[GReal(D).main() @ &m: res /\ C.c <= max_size] <= Pr[G1(DRestr(D)).main() @ &m: res] + (max_size ^ 2)%r * inv 2%r * mu dstate (pred1 witness) - + Pr[G1(DRestr(D)).main() @&m: G1.bcol \/ G1.bext]. + + Pr[G1(DRestr(D)).main() @&m: G1.bcol] + + Pr[G1(DRestr(D)).main() @&m: G1.bext]. proof. - apply (@RealOrder.ler_trans _ _ _ (Real_Concrete D D_ll &m)). + apply (@RealOrder.ler_trans _ _ _ (Real_Concrete D D_ll &m))=>//=. cut : Pr[CF(DRestr(D)).main() @ &m : res] <= Pr[G1(DRestr(D)).main() @ &m : res] + Pr[G1(DRestr(D)).main() @ &m : G1.bcol \/ G1.bext]. - + byequiv (CF_G1 D D_ll)=>//. - smt ml=0. - smt ml=0. + + byequiv (CF_G1 D D_ll)=>//=/#. + cut/#:Pr[G1(DRestr(D)).main() @ &m : G1.bcol \/ G1.bext] + <= Pr[G1(DRestr(D)).main() @&m: G1.bcol] + + Pr[G1(DRestr(D)).main() @&m: G1.bext]. + rewrite Pr[mu_or];smt(Distr.mu_bounded). qed. end section. diff --git a/proof/smart_counter/SLCommon.ec b/proof/smart_counter/SLCommon.ec index 2757b7f..8476601 100644 --- a/proof/smart_counter/SLCommon.ec +++ b/proof/smart_counter/SLCommon.ec @@ -682,6 +682,81 @@ by rewrite memE;apply prefixe_gt0_mem=>/#. smt(prefixe_sizer). qed. +lemma prefixe_cat_leq_prefixe_size (l1 l2 l3 : 'a list): + prefixe (l1 ++ l2) l3 <= prefixe l1 l3 + size l2. +proof. +move:l2 l3;elim:l1=>//=;1:smt(prefixe_sizel). +move=>e1 l1 hind1 l2 l3;move:e1 l1 l2 hind1;elim:l3=>//=;1:smt(size_ge0). +by move=>e3 l3 hind3 e1 l1 l2 hind1;case(e1=e3)=>//=[->>/#|h];exact size_ge0. +qed. + + +lemma prefixe_cat1 (l1 l2 l3 : 'a list) : + prefixe (l1 ++ l2) l3 = prefixe l1 l3 + + if prefixe l1 l3 = size l1 + then prefixe l2 (drop (size l1) l3) + else 0. +proof. +move:l2 l3;elim:l1=>//=;1:smt(prefixe_sizel). +move=>e1 l1 hind1 l2 l3;move:e1 l1 l2 hind1;elim:l3=>//=;1:smt(size_ge0). +by move=>e3 l3 hind3 e1 l1 l2 hind1;case(e1=e3)=>//=[->>|h];smt(size_ge0). +qed. + + +lemma prefixe_leq_prefixe_cat_size (l1 l2 : 'a list) (ll : 'a list list) : + prefixe (l1++l2) (get_max_prefixe (l1++l2) ll) <= + prefixe l1 (get_max_prefixe l1 ll) + + if (prefixe l1 (get_max_prefixe l1 ll) = size l1) + then prefixe l2 (get_max_prefixe l2 (map (drop (size l1)) ll)) + else 0. +proof. +move:l1 l2;elim:ll=>//=;1:smt(size_cat size_ge0). +move=>l3 ll hind{hind};move:l3;elim:ll=>//=;1:smt(prefixe_cat1). +move=>l4 ll hind l3 l1 l2. +case(prefixe (l1 ++ l2) l3 < prefixe (l1 ++ l2) l4)=>//=. ++ rewrite 2!prefixe_cat1. + case(prefixe l1 l3 = size l1)=>//=H_l1l3;case(prefixe l1 l4 = size l1)=>//=H_l1l4. + - rewrite H_l1l4 H_l1l3/=ltz_add2l=>h;rewrite h/=. + rewrite(StdOrder.IntOrder.ler_trans _ _ _ (hind _ _ _)). + cut->/=:prefixe l1 (max_prefixe l1 l4 ll) = size l1 + by move:{hind};elim:ll=>//=;smt(prefixe_sizel). + by cut->/=:prefixe l1 (max_prefixe l1 l3 ll) = size l1 + by move:{hind};elim:ll=>//=;smt(prefixe_sizel). + - smt(prefixe_sizel prefixe_ge0). + - cut->/=h:prefixe l1 l3 < prefixe l1 l4 by smt(prefixe_sizel). + rewrite(StdOrder.IntOrder.ler_trans _ _ _ (hind _ _ _)). + cut->/=:prefixe l1 (max_prefixe l1 l4 ll) = size l1 + by move:{hind};elim:ll=>//=;smt(prefixe_sizel). + smt(prefixe_prefixe_prefixe). + move=>H_l3l4;rewrite H_l3l4/=. + rewrite(StdOrder.IntOrder.ler_trans _ _ _ (hind _ _ _)). + by case(prefixe l1 (max_prefixe l1 l4 ll) = size l1)=>//=->; + smt(prefixe_prefixe_prefixe). +rewrite 2!prefixe_cat1. +case(prefixe l1 l3 = size l1)=>//=H_l1l3;case(prefixe l1 l4 = size l1)=>//=H_l1l4. ++ by rewrite H_l1l4 H_l1l3/=ltz_add2l=>h;rewrite h/=hind. ++ rewrite H_l1l3. + cut->/=:!size l1 < prefixe l1 l4 by smt(prefixe_sizel). + rewrite(StdOrder.IntOrder.ler_trans _ _ _ (hind _ _ _))//=. + cut->//=:prefixe l1 (max_prefixe l1 l3 ll) = size l1 + by move:{hind};elim:ll=>//=;smt(prefixe_sizel). + smt(prefixe_prefixe_prefixe). ++ smt(prefixe_sizel prefixe_ge0). +move=>H_l3l4;rewrite H_l3l4/=. +rewrite(StdOrder.IntOrder.ler_trans _ _ _ (hind _ _ _))//=. +smt(prefixe_prefixe_prefixe). +qed. + + +lemma diff_size_prefixe_leq_cat (l1 l2 : 'a list) (ll : 'a list list) : + size l1 - prefixe l1 (get_max_prefixe l1 ll) <= + size (l1++l2) - prefixe (l1++l2) (get_max_prefixe (l1++l2) ll). +proof. +smt(prefixe_leq_prefixe_cat_size prefixe_sizel prefixe_ge0 size_ge0 prefixe_sizer size_cat). +qed. + + + (* lemma prefixe_inv_prefixe queries prefixes l : *) (* prefixe_inv queries prefixes => *) (* all_prefixes prefixes => *) From 2ebafc8dabc7ff8c680b5181846c8f0c7ae4f259 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Tue, 10 Apr 2018 16:56:17 +0200 Subject: [PATCH 274/525] Gconcl_list.ec : file that contains the transformations from a functionality to a n-functionality --- proof/smart_counter/Gconcl_list.ec | 644 +++++++++++++++++++++++++++++ 1 file changed, 644 insertions(+) create mode 100644 proof/smart_counter/Gconcl_list.ec diff --git a/proof/smart_counter/Gconcl_list.ec b/proof/smart_counter/Gconcl_list.ec new file mode 100644 index 0000000..b1b8c8e --- /dev/null +++ b/proof/smart_counter/Gconcl_list.ec @@ -0,0 +1,644 @@ +pragma -oldip. +require import Core Int Real RealExtra StdOrder Ring StdBigop IntExtra. +require import List FSet NewFMap Utils Common SLCommon RndO FelTactic Mu_mem. +require import DProd Dexcepted. +(*...*) import Capacity IntOrder Bigreal RealOrder BRA. + +require (*--*) Handle. + + +clone export Handle as Handle0. + +(*** THEORY PARAMETERS ***) +(** Validity of Functionality Queries **) +op valid: block list -> bool. +axiom valid_spec p: valid p => p <> []. + +(** Validity and Parsing/Formatting of Functionality Queries **) +op format (p : block list) (n : int) = p ++ nseq (n - 1) b0. +op parse: block list -> (block list * int). + +axiom formatK bs: format (parse bs).`1 (parse bs).`2 = bs. +axiom parseK p n: 0 < n => valid p => parse (format p n) = (p,n). +axiom parse_nil: parse [] = ([],0). + +lemma parse_injective: injective parse. +proof. by move=> bs1 bs2 eq_format; rewrite -formatK eq_format (@formatK bs2). qed. + +lemma parse_valid p: valid p => parse p = (p,1). +proof. +move=>h;cut{1}->:p=format p 1;2:smt(parseK). +by rewrite/format/=nseq0 cats0. +qed. + + +module type NFUNCTIONALITY = { + proc init () : unit + proc f (p : block list, n : int) : block list +}. + +module type NDFUNCTIONALITY = { + proc f (p : block list, n : int) : block list +}. + +module type NDISTINGUISHER (F : NDFUNCTIONALITY, P : DPRIMITIVE) = { + proc distinguish () : bool +}. + + +module NC = { + var c : int + var queries : (block list * int, block list) fmap +}. + +module NFC (F : NDFUNCTIONALITY) : NDFUNCTIONALITY = { + proc f (bl : block list, nb : int) = { + var r : block list <- []; + if (valid bl /\ 0 < nb) { + if (! (bl,nb) \in dom NC.queries) { + NC.c <- NC.c + size bl + nb - 1; + r <@ F.f(bl,nb); + NC.queries.[(bl,nb)] <- r; + } else { + r <- oget NC.queries.[(bl,nb)]; + } + } + return r; + } +}. + + + +module NPC (P : DPRIMITIVE) : DPRIMITIVE = { + proc f (a : state) = { + var z : state; + z <@ P.f(a); + NC.c <- NC.c + 1; + return z; + } + proc fi (a : state) = { + var z : state; + z <@ P.fi(a); + NC.c <- NC.c + 1; + return z; + } +}. + +module (DSqueeze (F : DFUNCTIONALITY) : NDFUNCTIONALITY) = { + proc f (p : block list, n : int) : block list = { + var lres : block list <- []; + var b : block <- b0; + var i : int <- 0; + while (i < n) { + i <- i + 1; + if (! (p,i) \in dom NC.queries) { + b <@ F.f(format p i); + lres <- rcons lres b; + NC.queries.[(p,i)] <- lres; + } else { + lres <- oget NC.queries.[(p,i)]; + } + } + return lres; + } +}. + + +module (Squeeze (F : FUNCTIONALITY) : NFUNCTIONALITY) = { + proc init () : unit = { + NC.queries <- map0; + NC.c <- 0; + F.init(); + } + proc f = DSqueeze(F).f +}. + + +module NDFRestr (F : NDFUNCTIONALITY) = { + proc f (bl : block list, nb : int) = { + var b : block <- b0; + var lres : block list <- []; + var i : int <- 0; + + if (valid bl /\ 0 < nb) { + if (! (bl,nb) \in dom NC.queries) { + if (NC.c + size bl + nb - 1 <= max_size) { + NC.c <- NC.c + size bl + nb - 1; + lres <@ F.f(bl,nb); + } + } else { + lres <- oget NC.queries.[(bl,nb)]; + } + } + return lres; + } +}. + + +module NDPRestr (P : DPRIMITIVE) : DPRIMITIVE = { + proc f (a : state) = { + var z : state; + if (NC.c + 1 <= max_size) { + z <@ P.f(a); + NC.c <- NC.c + 1; + } + return z; + } + proc fi (a : state) = { + var z : state; + if (NC.c + 1 <= max_size) { + z <@ P.fi(a); + NC.c <- NC.c + 1; + } + return z; + } +}. + + + +module (NDRestr (D : NDISTINGUISHER) : NDISTINGUISHER) + (F : NDFUNCTIONALITY) (P : DPRIMITIVE) = D(NDFRestr(F),NDPRestr(P)). + + + +module (A (D : NDISTINGUISHER) : DISTINGUISHER) + (F : DFUNCTIONALITY) (P : DPRIMITIVE) = { + proc distinguish() : bool = { + var b : bool; + NC.queries <- map0; + NC.c <- 0; + b <@ D(NFC(DSqueeze(F)),NPC(P)).distinguish(); + return b; + } +}. + + + +module NIndif (F : NFUNCTIONALITY, P : PRIMITIVE, D : NDISTINGUISHER) = { + proc main () : bool = { + var b : bool; + C.init(); + P.init(); + F.init(); + b <@ D(F,P).distinguish(); + return b; + } +}. + + +module DC (D : NDISTINGUISHER) (F : NDFUNCTIONALITY) (P : DPRIMITIVE) = D(NFC(F),NPC(P)). + + +module P = Perm. + + +section. + + pred inv_ideal (squeeze : (block list * int, block list) fmap) + (c : (block list, block) fmap) = + (forall p n, (p,n) \in dom squeeze => + forall i, 1 <= i <= n => (p,i) = parse (format p i)) /\ + (forall p n, (p,n) \in dom squeeze => + forall i, 1 <= i <= n => format p i \in dom c) /\ + (forall l, l \in dom c => + forall i, 1 <= i <= (parse l).`2 => ((parse l).`1,i) \in dom squeeze). + + + inductive m_p (m : (state, state) fmap) (p : (block list, state) fmap) + (q : (block list * int, block list) fmap) = + | IND_M_P of (p.[[]] = Some (b0, c0)) + & (forall l, l \in dom p => forall i, 0 <= i < size l => + exists b c, p.[take i l] = Some (b,c) /\ + m.[(b +^ nth witness l i, c)] = p.[take (i+1) l]) + & (forall l n, (l,n) \in dom q => + valid l /\ 0 < n /\ + (forall i, 0 < i <= n => q.[(l,i)] = Some (take i (oget q.[(l,n)])))) + & (forall l n, (l,n) \in dom q => format l n \in dom p) + & (forall l, l \in dom p => l <> [] => exists l2, parse (l ++ l2) \in dom q). + + + inductive INV_Real + (c1 c2 : int) + (m mi : (state, state) fmap) + (p : (block list, state) fmap) + (q : (block list * int, block list) fmap) = + | INV_real of (c1 <= c2) + & (m_p m p q) + & (invm m mi). + + local lemma INV_Real_incr c1 c2 m mi p q : + INV_Real c1 c2 m mi p q => + INV_Real (c1 + 1) (c2 + 1) m mi p q. + proof. by case;progress;split=>//=/#. qed. + + local lemma INV_Real_addm_mi c1 c2 m mi p q x y : + INV_Real c1 c2 m mi p q => + ! x \in dom m => + ! y \in rng m => + INV_Real c1 c2 m.[x <- y] mi.[y <- x] p q. + proof. + case=> H_c1c2 H_m_p H_invm H_x_dom H_y_rng;split=>//=. + + split;case:H_m_p=>//=; + smt(getP in_dom oget_some take_oversize size_take take_take). + exact invm_set. + qed. + + local lemma invmC' (m mi : (state, state) fmap) : + invm m mi => invm mi m. + proof. by rewrite /#. qed. + + local lemma invmC (m mi : (state, state) fmap) : + invm m mi <=> invm mi m. + proof. by split;exact invmC'. qed. + + local lemma invm_dom_rng (m mi : (state, state) fmap) : + invm m mi => dom m = rng mi. + proof. by move=>h;rewrite fsetP=>x;split;rewrite in_dom in_rng/#. qed. + + local lemma lemma1 c1 c2 m mi p q bs n i (l : block list): + INV_Real c1 c2 m mi p q => + ! (bs,i) \in dom q => + valid bs => + 0 < i <= n => + size l = i => + format bs i \in dom p => + (forall j, 0 < j < i => q.[(bs,j)] = Some (take j l)) => + INV_Real c1 c2 m mi p q.[(bs,i) <- l]. + proof. + move=>INV0 H_bs_n_dom H_bs_valid H0in H_size H_format_dom H_pref_quer. + split;cut[]//=H_c1c2 H_m_p H_invm:=INV0. + split;cut[]//H_mp0 H_mp1 H_mp2 H_mp3 H_mp4:=H_m_p. + + move=>l1 n1;rewrite dom_set in_fsetU1. + case((l1, n1) = (bs, i))=>[[]->>->>|H_neq]//=. + - rewrite H_bs_valid/=;split;1:rewrite/#;move=>j []Hj0 Hj1. + rewrite!getP/=oget_some. + by case(j=i)=>[->>|/#]//=;1:rewrite -H_size take_size//=. + move=>H_dom;cut[]->[]->/=help j[]hj0 hji:=H_mp2 _ _ H_dom. + rewrite !getP/=. + cut:=H_neq;case(l1=bs)=>[->>H_n1i|]//=;smt(in_dom). + + smt(dom_set in_fsetU1). + + smt(dom_set in_fsetU1). + qed. + + local lemma all_prefixes_of_INV_real c1 c2 m mi p q: + INV_Real c1 c2 m mi p q => + all_prefixes p. + proof. + move=>[]_[]Hp0 Hmp1 _ _ _ _ l H_dom i. + smt(take_le0 take_oversize size_take take_take take_size nth_take in_dom). + qed. + + local lemma equiv_sponge (D <: NDISTINGUISHER {P, NC, Redo, C}) : + equiv [ GReal(A(D)).main + ~ NIndif(Squeeze(SqueezelessSponge(P)),P,DC(D)).main + : ={glob D} ==> ={res, glob D, glob P, glob NC} /\ C.c{1} <= NC.c{2}]. + proof. + proc;inline*;sp;wp. + call(: ={Redo.prefixes, glob P, glob NC} /\ + INV_Real C.c{1} NC.c{2} Perm.m{1} Perm.mi{1} Redo.prefixes{1} NC.queries{1});auto;last first. + + by progress;1:(split=>//=;1:split;smt(dom0 in_fset0 dom_set in_fsetU1 getP map0P));case:H0=>//=. + + by proc;inline*;auto;sp;if;auto;smt(INV_Real_addm_mi INV_Real_incr supp_dexcepted). + + proc;inline*;auto;sp;if;auto;progress. + + apply INV_Real_incr=>//=. + apply INV_Real_addm_mi=>//=. + + case:H=>H_c H_m_p H_invm;rewrite (invm_dom_rng _ _ H_invm)//=. + by move:H1;rewrite supp_dexcepted. + case:H=>H_c H_m_p H_invm;cut<-//:=(invm_dom_rng Perm.mi{2} Perm.m{2}). + by rewrite invmC. + + exact INV_Real_incr. + + proc;inline*;sp;if;auto;sp;if;auto. + swap 6;wp;sp=>/=;rcondt{1}1;1:auto;rcondt{2}1;1:auto. + conseq(:_==> ={i,nb,bl,n,p,glob NC,glob Redo,glob P,lres} /\ (n,p){1} = (nb,bl){1} /\ + i{1} = nb{1} /\ + format p{1} i{1} \in dom Redo.prefixes{1} /\ + INV_Real C.c{1} (NC.c{1} + size bl{2} + i{1} - 1) Perm.m{1} Perm.mi{1} + Redo.prefixes{1} NC.queries{1}.[(bl{1}, i{1}) <- lres{1}]);progress. + while(={i,nb,bl,n,p,glob NC,glob Redo,glob P,lres} /\ (n,p){1} = (nb,bl){1} /\ + 0 < i{1} <= nb{1} /\ (0 < i{1} => Some lres{1} = NC.queries{1}.[(bl{1}, i{1})]) /\ + format p{1} i{1} \in dom Redo.prefixes{1} /\ + INV_Real C.c{1} (NC.c{1} + size bl{2} + i{1} - 1) Perm.m{1} Perm.mi{1} + Redo.prefixes{1} NC.queries{1}.[(bl{1}, i{1}) <- lres{1}]);last first. + + sp;conseq(:_ ==> ={i,nb,bl,n,p,glob NC,glob Redo,glob P,lres} /\ (n,p){1} = (nb,bl){1} /\ + 0 < i{1} <= nb{1} /\ (0 < i{1} => Some lres{1} = NC.queries{1}.[(bl{1}, i{1})]) /\ + format p{1} i{1} \in dom Redo.prefixes{1} /\ + INV_Real C.c{1} (NC.c{1} + size bl{2} + i{1} - 1) Perm.m{1} Perm.mi{1} + Redo.prefixes{1} NC.queries{1}.[(bl{1}, i{1}) <- lres{1}]);1:progress=>/#. + sp;if;auto;last first. + * progress. + - by rewrite/#. + - by cut INV0:=H;cut[]//=H_c1c2 H_m_p H_invm:=INV0;cut[]/#:=H_m_p. + - by cut[]_[]_ _ _ help _ _:=H;cut:=help _ _ H3. + by rewrite set_eq 1:get_oget//=;split;case:H=>//=;smt(size_ge0). + sp=>/=. + exists* Redo.prefixes{1}, C.c{1};elim*=>pref count;progress. + conseq(:_==> ={i0,p0,i,p,n,nb,bl,sa,lres,glob NC,glob Redo,glob Perm} + /\ n{1} = nb{1} /\ p{1} = bl{1} /\ p0{1} = p{1} /\ i0{1} = size p{1} + /\ Redo.prefixes{1}.[take i0{1} p{1}] = Some (sa{1},sc{1}) + /\ INV_Real count NC.c{1} Perm.m{1} Perm.mi{1} pref NC.queries{1} + /\ (forall l, l \in dom Redo.prefixes{1} => + l \in dom pref \/ (exists j, 0 < j <= i0{2} /\ l = take j p{1})) + /\ (forall l, l \in dom pref => pref.[l] = Redo.prefixes{1}.[l]) + /\ C.c{1} <= count + i0{1} <= NC.c{1} + i0{1} + /\ (forall j, 0 <= j < i0{1} => + exists b c, Redo.prefixes{1}.[take j p{1}] = Some (b,c) /\ + Perm.m{1}.[(b +^ nth witness p{1} j, c)] = Redo.prefixes{1}.[take (j+1) p{1}])); + progress. + + by rewrite/#. + + by rewrite getP/=. + + by rewrite/format/=nseq0 cats0//-take_size in_dom H5. + + rewrite set_set/=. + cut inv0:=H6;cut[]h_c1c2[]Hmp0 Hmp1 Hmp2 Hmp3 Hmp4 Hinvm:=inv0;split=>//=. + - rewrite/#. + split=>//=. + - smt(in_dom). + - move=>l H_dom_R i []Hi0 Hisize;cut:=H7 l H_dom_R. + case(l \in dom Redo.prefixes{2})=>H_in_pref//=. + * cut:=Hmp1 l H_in_pref i _;rewrite//=. + rewrite ?H8//=;1:smt(in_dom). + case(i+1 < size l)=>h;1:smt(in_dom). + by rewrite take_oversize 1:/#. + move=>[]j[][]hj0 hjsize ->>. + cut:=Hisize;rewrite size_take 1:/#. + pose k:=if _ then _ else _;cut->>Hij{k}:k=j by rewrite/#. + by rewrite!take_take!min_lel 1,2:/# nth_take 1,2:/#;smt(in_dom). + - by move=>l n;rewrite!dom_set in_fsetU1=>[][];smt(getP oget_some in_dom take_oversize). + - move=>l n;rewrite dom_set in_fsetU1;case=>//=;1:smt(in_dom). + by move=>[]<<-->>;rewrite/format/=nseq0 cats0/=-take_size in_dom H5. + - move=>l H_dom_R H_not_nil;rewrite dom_set. + cut:=H7 l H_dom_R;case;1:smt(in_fsetU1). + move=>[]j[][]hj0 hjsize ->>;exists(drop j bl{2}). + by rewrite cat_take_drop parse_valid//=in_fsetU1. + while( ={i0,p0,i,p,n,nb,bl,sa,sc,lres,glob NC,glob Redo,glob Perm} + /\ n{1} = nb{1} /\ p{1} = bl{1} /\ p0{1} = p{1} /\ 0 <= i0{1} <= size p{1} + /\ Redo.prefixes{1}.[take i0{1} p{1}] = Some (sa{1},sc{1}) + /\ INV_Real count NC.c{1} Perm.m{1} Perm.mi{1} pref NC.queries{1} + /\ (forall l, l \in dom Redo.prefixes{1} => + l \in dom pref \/ (exists j, 0 < j <= i0{2} /\ l = take j p{1})) + /\ (forall l, l \in dom pref => pref.[l] = Redo.prefixes{1}.[l]) + /\ C.c{1} <= count + i0{1} <= NC.c{1} + i0{1} + /\ (i0{1} < size p0{1} => + take (i0{1}+1) p{1} \in dom Redo.prefixes{1} => + Redo.prefixes{1} = pref) + /\ all_prefixes Redo.prefixes{1} + /\ (forall j, 0 <= j < i0{1} => + exists b c, Redo.prefixes{1}.[take j p{1}] = Some (b,c) /\ + Perm.m{1}.[(b +^ nth witness p{1} j, c)] = + Redo.prefixes{1}.[take (j+1) p{1}]));last first. + + auto;progress. + - by rewrite /format/=nseq0 cats0. + - exact size_ge0. + - by rewrite take0;cut[]_[]->//=:=H. + - by rewrite/#. + - by cut[]->//=:=H. + - smt(all_prefixes_of_INV_real). + - by rewrite/#. + by rewrite/#. + if;auto;progress. + + by rewrite/#. + + by rewrite/#. + + smt(get_oget in_dom). + + smt(in_dom take_take take_oversize size_take). + + by rewrite/#. + + by rewrite/#. + + by rewrite/#. + + case(jh;1:rewrite/#;cut<<-:j=i0{2} by rewrite/#. + cut->>:=H7 H10 H12. + by cut[]_[]_ help _ _ _ _:=H2;cut:=help _ H12 j _;smt(take_take nth_take size_take). + sp;if;auto;progress. + + by rewrite/#. + + by rewrite/#. + + by rewrite!getP/=. + + by apply INV_Real_addm_mi=>//=;smt(supp_dexcepted). + + by move:H16;rewrite dom_set in_fsetU1/#. + + by rewrite!getP/=;smt(in_dom). + + by rewrite/#. + + by rewrite/#. + + move:H12;apply absurd=>//=_. + move:H17;rewrite dom_set in_fsetU1. + cut->/=:!take (i0{2} + 1 + 1) bl{2} = take (i0{2} + 1) bl{2} by smt(size_take). + smt(take_take size_take). + + move=>l;rewrite!dom_set in_fsetU1;case. + - move=>H_dom;cut[]:=H3 l H_dom. + * by move=>Hdom i;rewrite in_fsetU1/=; + smt(in_dom all_prefixes_of_INV_real). + move=>[]j[][]hj0 hji0->>k. + rewrite in_fsetU1 take_take;left. + cut[]:=H3 _ H_dom;smt(in_dom take_take take_le0 take0 take_oversize). + move=>->>k. + rewrite in_fsetU1 take_take;case(0 <= k)=>hk0; + last smt(in_fsetU1 in_dom take_take take_le0 take0 take_oversize). + case(k < i0{2})=>hki01; + first smt(in_fsetU1 in_dom take_take take_le0 take0 take_oversize). + by case(k <= i0{2} + 1)=>hki02;smt(in_dom). + + rewrite!getP/=oget_some. + cut->/=:!take j bl{2} = take (i0{2} + 1) bl{2} by smt(size_take). + case(j < i0{2})=>hj0;2:smt(getP oget_some size_take). + cut->/=:!take (j + 1) bl{2} = take (i0{2} + 1) bl{2} by smt(size_take). + by cut:=H9 j _;1:rewrite hj0 H16//=;smt(in_rng getP in_dom). + + by rewrite/#. + + by rewrite/#. + + by rewrite!getP/=. + + by move:H14;rewrite dom_set in_fsetU1/#. + + by rewrite!getP/=;smt(in_dom). + + by rewrite/#. + + by rewrite/#. + + move:H12;apply absurd=>//=_. + move:H15;rewrite dom_set in_fsetU1. + cut->/=:!take (i0{2} + 1 + 1) bl{2} = take (i0{2} + 1) bl{2} by smt(size_take). + by move=>h;cut:=H8 _ h (i0{2}+1);rewrite take_take/#. + + move=>l;rewrite!dom_set in_fsetU1;case. + - move=>H_dom;cut[]:=H3 l H_dom. + * by move=>Hdom i;rewrite in_fsetU1/=; + smt(in_dom all_prefixes_of_INV_real). + move=>[]j[][]hj0 hji0->>k. + rewrite in_fsetU1 take_take;left. + cut[]:=H3 _ H_dom;smt(in_dom take_take take_le0 take0 take_oversize). + move=>->>k. + rewrite in_fsetU1 take_take;case(0 <= k)=>hk0; + last smt(in_fsetU1 in_dom take_take take_le0 take0 take_oversize). + case(k < i0{2})=>hki01; + first smt(in_fsetU1 in_dom take_take take_le0 take0 take_oversize). + by case(k <= i0{2} + 1)=>hki02;smt(in_dom). + rewrite!getP/=. + cut->/=:!take j bl{2} = take (i0{2} + 1) bl{2} by smt(size_take). + by case(j < i0{2})=>hj0;smt(get_oget in_dom oget_some size_take). + + sp;if;auto;last first;progress. + + rewrite/#. + + rewrite/#. + + by rewrite get_oget//=. + + by cut[]_[]_ _ _ help _ _:=H3;cut->//=:=help bl{2} (i_R+1);rewrite dom_set in_fsetU1 H6. + + by rewrite set_eq//=1:get_oget//=;split;cut:=H3;rewrite set_eq 1:H1//==>[][]//=/#. + + sp. + splitwhile{1} 1 : i0 < size p0 - 1;splitwhile{2} 1 : i0 < size p0 - 1. + rcondt{1}2;2:rcondt{2}2;1,2:by auto; + while(i0 < size p0);auto;1:if;2:(sp;if);auto;smt(size_cat size_nseq size_ge0). + rcondf{1}4;2:rcondf{2}4;1,2:by auto; + seq 1 : (i0 = size p0 - 1);1:(auto; + while(i0 < size p0);auto;1:if;2:(sp;if);auto;smt(size_cat size_nseq size_ge0)); + if;sp;2:if;auto;smt(size_cat size_nseq size_ge0). + (* TODO *) + + qed. + + + + local lemma equiv_ideal + (IF <: FUNCTIONALITY{DSqueeze,C}) + (S <: SIMULATOR{DSqueeze,C,IF}) + (D <: NDISTINGUISHER{C,DSqueeze,IF,S}) : + equiv [ S(IF).init ~ S(IF).init : true ==> ={glob S} ] => + equiv [ IF.init ~ IF.init : true ==> ={glob IF} ] => + equiv [ Indif(IF,S(IF),DRestr(A(D))).main + ~ NIndif(Squeeze(IF),S(IF),NDRestr(D)).main + : ={glob D} + ==> + ={res, glob D, glob IF, glob S, glob NC, C.c} ]. + proof. + move=>S_init IF_init. + proc;inline*;sp;wp;swap{2}2-1;swap{1}[3..5]-2;sp. + call(: ={glob IF, glob S, C.c, glob DSqueeze} + /\ C.c{1} <= NC.c{1} <= max_size + /\ inv_ideal NC.queries{1} C.queries{1});auto;last first. + + call IF_init;auto;call S_init;auto;smt(dom_set in_fsetU1 dom0 in_fset0 parse_nil max_ge0). + + proc;inline*;sp;if;auto;1:call(: ={glob IF});auto;1:proc(true);progress=>//=. + + by proc;inline*;sp;if;auto;1:call(: ={glob IF});auto;proc(true)=>//=. + proc;inline*;sp=>/=;if;auto;if{2};last first. + + wp;conseq(:_==> lres{1} = oget NC.queries.[(p,i)]{1} + /\ i{1} = n{1} + /\ inv_ideal NC.queries{1} C.queries{1} + /\ ={glob IF, glob S, C.c, NC.queries});progress. + while{1}((0 < i{1} => lres{1} = oget NC.queries.[(p,i)]{1}) + /\ 0 <= i{1} <= n{1} + /\ ((p{1}, n{1}) \in dom NC.queries{1}) + /\ valid p{1} /\ 0 < n{1} + /\ inv_ideal NC.queries{1} C.queries{1} + /\ ={glob IF, glob S, C.c, NC.queries})(n{1}-i{1});progress. + - sp;rcondf 1;auto;progress;2..:rewrite/#. + cut[]h1[]h2 h3 :=H5. + cut h5:=h2 _ _ H2 n{hr} _;1:rewrite/#. + cut :=h3 _ h5 (i2+1) _;1:rewrite/#. + by cut<-/= :=h1 _ _ H2 n{hr} _;1:rewrite/#. + by auto=>/#. + + sp;if{2}. + + rcondt{2}7;1:auto;wp;sp. print inv_ideal. + while(={glob IF, glob S, C.c, NC.queries} /\ + (i,n,p,lres){1} = (i0,n0,p0,lres0){2} /\ + inv_ideal NC.queries{1} C.queries{1} /\ + + alias + + + + sp;auto=>/=. + rcondf{2}1;1:auto;progress. + + move:H4;pose s:= List.map _ _;pose c:=C.c{hr};pose p:=p{hr};pose n:=n{hr}. + apply absurd=>//=. + print diff_size_prefixe_leq_cat. prefixe_leq_prefixe_cat_size. + search prefixe (++). + + cut h:size (format p n) = size p + n - 1 by rewrite size_cat size_nseq max_ler /#. +sear + cut h':max_size < c + size (format p n) + smt(prefixe_sizel). + while{1}(={n, p, glob IF, glob S, NC.queries} + /\ i{1} = nb_iter{2} /\ lres{1} = r{2} + /\ inv_ideal NC.queries{1} C.queries{1} + /\ max_size <= C.c{1} + + + conseq(:_ ==> lres{1} = mkseq (+Block.b0) i{1} /\ i{1} = n{1} + /\ ={glob IF, glob S} /\ C.c{1} = max_size + /\ inv_ideal NC.queries{1} C.queries{1} + /\ NC.queries{1} = NC.queries{2}.[(p{1}, n{1}) <- lres{1}]); + 1:smt(min_ler min_lel max_ler max_ler). + while{1}(lres{1} = mkseq (+Block.b0) i{1} /\ i{1} = n{1} + /\ ={glob IF, glob S} /\ C.c{1} = max_size + /\ inv_ideal NC.queries{1} C.queries{1} + /\ NC.queries{1} = NC.queries{2}.[(p{1}, n{1}) <- lres{1}]) + (n{1}-i{1}); + + rcondt{2}1;1:auto;progress. search min. + + pose m:=C.c{hr}+_. + cut/#:1 <=min n{hr} (max 0 (n{hr} + max_size - m)). + apply min_is_glb=>[/#|]. + + rewrite /min/max. + qed. + +print RealIndif. + + +module IF = { + proc init = F.RO.init + proc f = F.RO.get +}. + +module S(F : DFUNCTIONALITY) = { + var m, mi : smap + var paths : (capacity, block list * block) fmap + + proc init() = { + m <- map0; + mi <- map0; + (* the empty path is initially known by the adversary to lead to capacity 0^c *) + paths <- map0.[c0 <- ([<:block>],b0)]; + } + + proc f(x : state): state = { + var p, v, y, y1, y2; + if (!mem (dom m) x) { + if (mem (dom paths) x.`2) { + (p,v) <- oget paths.[x.`2]; + y1 <- F.f (rcons p (v +^ x.`1)); + } else { + y1 <$ bdistr; + } + y2 <$ cdistr; + y <- (y1,y2); + m.[x] <- y; + mi.[y] <- x; + if (mem (dom paths) x.`2) { + (p,v) <- oget paths.[x.`2]; + paths.[y.`2] <- (rcons p (v +^ x.`1), y.`1); + } + } else { + y <- oget m.[x]; + } + return y; + } + + proc fi(x : state): state = { + var y, y1, y2; + if (!mem (dom mi) x) { + y1 <$ bdistr; + y2 <$ cdistr; + y <- (y1,y2); + mi.[x] <- y; + m.[y] <- x; + } else { + y <- oget mi.[x]; + } + return y; + } +}. + +lemma Real_Ideal &m (D <: DISTINGUISHER): + Pr[Indif(SqueezelessSponge(PC(Perm)), PC(Perm), D).main() @ &m: res /\ C.c <= max_size] <= + Pr[Indif(IF,S(IF),DRestr(D)).main() @ &m :res] + + (max_size ^ 2)%r / 2%r * mu dstate (pred1 witness) + + max_size%r * ((2*max_size)%r / (2^c)%r) + + max_size%r * ((2*max_size)%r / (2^c)%r). +proof. +search max_size. + apply (ler_trans _ _ _ (Pr_restr _ _ _ _ _ _ &m)). + rewrite !(ler_add2l, ler_add2r);apply lerr_eq. + apply (eq_trans _ Pr[G3(F.LRO).distinguish() @ &m : res]);1:by byequiv G2_G3. + apply (eq_trans _ Pr[G3(F.RO ).distinguish() @ &m : res]). + + by byequiv (_: ={glob G3, F.RO.m} ==> _)=>//;symmetry;conseq (F.RO_LRO_D G3). + apply (eq_trans _ Pr[G4(F.RO ).distinguish() @ &m : res]);1:by byequiv G3_G4. + apply (eq_trans _ Pr[G4(F.LRO).distinguish() @ &m : res]);1:by byequiv (F.RO_LRO_D G4). + by byequiv G4_Ideal. +qed. + From 7eba2b66ed3d7faf60d3a023aee80ba60ad90790 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Wed, 18 Apr 2018 13:01:33 +0200 Subject: [PATCH 275/525] Removed print leftover from debugging. --- proof/Common.ec | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/proof/Common.ec b/proof/Common.ec index 5ec5802..fcb9dbf 100644 --- a/proof/Common.ec +++ b/proof/Common.ec @@ -111,7 +111,7 @@ by rewrite (@last_nonempty y z). qed. (*------------------------------ Primitive -----------------------------*) -print Block. + clone export RP as Perm with type t <- block * capacity, op dt <- bdistr `*` cdistr From 40fb53552e1c4469918ea573b75ec93363efa885 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Wed, 18 Apr 2018 13:30:42 +0200 Subject: [PATCH 276/525] . --- proof/smart_counter/Gconcl_list.ec | 520 +++++++++++++++++++++++++++-- 1 file changed, 489 insertions(+), 31 deletions(-) diff --git a/proof/smart_counter/Gconcl_list.ec b/proof/smart_counter/Gconcl_list.ec index b1b8c8e..aab08f0 100644 --- a/proof/smart_counter/Gconcl_list.ec +++ b/proof/smart_counter/Gconcl_list.ec @@ -41,14 +41,44 @@ module type NDFUNCTIONALITY = { proc f (p : block list, n : int) : block list }. -module type NDISTINGUISHER (F : NDFUNCTIONALITY, P : DPRIMITIVE) = { - proc distinguish () : bool -}. - module NC = { var c : int var queries : (block list * int, block list) fmap + proc init() = { + c <- 0; + queries <- map0; + } +}. + + +module BlockSponge (P : PRIMITIVE) : NFUNCTIONALITY = { + proc init() = { + P.init(); + } + proc f (p : block list, n : int) : block list = { + var r : block list <- []; + var i : int <- 0; + var (b,c) <- (b0,c0); + while (i < size p) { + (b,c) <@ P.f(b +^ nth witness p i, c); + i <- i + 1; + } + i <- 1; + r <- rcons r b; + NC.queries.[(p,1)] <- r; + while (i < n) { + (b,c) <@ P.f(b, c); + r <- rcons r b; + i <- i + 1; + NC.queries.[(p,i)] <- r; + } + return r; + } +}. + +module type NDISTINGUISHER (F : NDFUNCTIONALITY, P : DPRIMITIVE) = { + proc distinguish () : bool }. module NFC (F : NDFUNCTIONALITY) : NDFUNCTIONALITY = { @@ -165,8 +195,7 @@ module (A (D : NDISTINGUISHER) : DISTINGUISHER) (F : DFUNCTIONALITY) (P : DPRIMITIVE) = { proc distinguish() : bool = { var b : bool; - NC.queries <- map0; - NC.c <- 0; + NC.init(); b <@ D(NFC(DSqueeze(F)),NPC(P)).distinguish(); return b; } @@ -186,7 +215,14 @@ module NIndif (F : NFUNCTIONALITY, P : PRIMITIVE, D : NDISTINGUISHER) = { }. -module DC (D : NDISTINGUISHER) (F : NDFUNCTIONALITY) (P : DPRIMITIVE) = D(NFC(F),NPC(P)). +module DC (D : NDISTINGUISHER) (F : NDFUNCTIONALITY) (P : DPRIMITIVE) = { + proc distinguish () : bool = { + var b : bool; + NC.init(); + b <@ D(NFC(F),NPC(P)).distinguish(); + return b; + } +}. module P = Perm. @@ -211,9 +247,9 @@ section. exists b c, p.[take i l] = Some (b,c) /\ m.[(b +^ nth witness l i, c)] = p.[take (i+1) l]) & (forall l n, (l,n) \in dom q => - valid l /\ 0 < n /\ + valid l /\ 0 < n /\ size (oget q.[(l,n)]) = n /\ (forall i, 0 < i <= n => q.[(l,i)] = Some (take i (oget q.[(l,n)])))) - & (forall l n, (l,n) \in dom q => format l n \in dom p) + & (forall l n, (l,n) \in dom q => exists c, p.[format l n] = Some (last b0 (oget q.[(l,n)]),c)) & (forall l, l \in dom p => l <> [] => exists l2, parse (l ++ l2) \in dom q). @@ -255,13 +291,13 @@ section. invm m mi => dom m = rng mi. proof. by move=>h;rewrite fsetP=>x;split;rewrite in_dom in_rng/#. qed. - local lemma lemma1 c1 c2 m mi p q bs n i (l : block list): + local lemma lemma1 c1 c2 m mi p q bs i (l : block list): INV_Real c1 c2 m mi p q => ! (bs,i) \in dom q => valid bs => - 0 < i <= n => + 0 < i => size l = i => - format bs i \in dom p => + (exists c, p.[format bs i] = Some (last b0 l, c)) => (forall j, 0 < j < i => q.[(bs,j)] = Some (take j l)) => INV_Real c1 c2 m mi p q.[(bs,i) <- l]. proof. @@ -270,13 +306,16 @@ section. split;cut[]//H_mp0 H_mp1 H_mp2 H_mp3 H_mp4:=H_m_p. + move=>l1 n1;rewrite dom_set in_fsetU1. case((l1, n1) = (bs, i))=>[[]->>->>|H_neq]//=. - - rewrite H_bs_valid/=;split;1:rewrite/#;move=>j []Hj0 Hj1. - rewrite!getP/=oget_some. - by case(j=i)=>[->>|/#]//=;1:rewrite -H_size take_size//=. - move=>H_dom;cut[]->[]->/=help j[]hj0 hji:=H_mp2 _ _ H_dom. + - rewrite H_bs_valid getP/= oget_some/=H_size//=;split;1:rewrite/#;move=>j []Hj0 Hj1. + rewrite getP/=;case(j=i)=>[->>|/#]//=;1:rewrite -H_size take_size//=. + rewrite getP/=;move=>H_dom;cut[]->[]->[]H_size_get/=help:=H_mp2 _ _ H_dom;split. + - by rewrite H_neq/=H_size_get. + move=> j[]hj0 hji. rewrite !getP/=. cut:=H_neq;case(l1=bs)=>[->>H_n1i|]//=;smt(in_dom). - + smt(dom_set in_fsetU1). + + move=>m1 j;rewrite dom_set in_fsetU1 getP. + case((m1, j) = (bs, i))=>//=h H_dom. + by cut[]c ->/#:=H_mp3 _ _ H_dom. + smt(dom_set in_fsetU1). qed. @@ -288,6 +327,97 @@ section. smt(take_le0 take_oversize size_take take_take take_size nth_take in_dom). qed. + local lemma lemma2 c1 c2 m mi p q bl i sa sc lres: + INV_Real c1 c2 m mi p q => + 1 < i => + valid bl => + (sa,sc) \in dom m => + ! (format bl i) \in dom p => + ! (bl, i) \in dom q => + p.[format bl (i-1)] = Some (sa,sc) => + q.[(bl,i-1)] = Some lres => + INV_Real c1 c2 m mi p.[format bl i <- oget m.[(sa,sc)]] + q.[(bl,i) <- rcons lres (oget m.[(sa,sc)]).`1]. + proof. + move=>inv0 h1i h_valid H_dom_m H_dom_p H_dom_q H_p_val H_q_val. + split;cut[]//=_[] hmp0 hmp1 hmp2 hmp3 hmp4 hinvm:=inv0;split=>//=. + + by rewrite getP;smt(size_cat size_nseq size_ge0). + + move=>l;rewrite dom_set in_fsetU1;case;1:smt(all_prefixes_of_INV_real getP). + move=>->>j[]hj0 hjsize;rewrite getP/=. + cut:=hmp1 (format bl (i - 1));rewrite in_dom H_p_val/==>help. + cut:=hjsize;rewrite !size_cat !size_nseq/=!max_ler 1:/#=>hjsizei. + cut->/=:!take j (format bl i) = format bl i by smt(size_take). + cut h:forall k, 0 <= k <= size bl + i - 2 => + take k (format bl (i - 1)) = take k (format bl i). + * move=>k[]hk0 hkjS;rewrite !take_cat;case(k//=hksize;congr. + apply (eq_from_nth witness);1:rewrite!size_take//=1,2:/#!size_nseq!max_ler/#. + rewrite!size_take//=1:/#!size_nseq!max_ler 1:/#. + pose o:=if _ then _ else _;cut->/={o}:o = k - size bl by smt(). + by progress;rewrite!nth_take//= 1,2:/# !nth_nseq//=/#. + case(j < size bl + i - 2)=>hj. + - cut:=help j _;1:smt(size_cat size_nseq). + move=>[]b c[]. + cut->:nth witness (format bl (i - 1)) j = nth witness (format bl i) j. + + by rewrite-(nth_take witness (j+1)) 1,2:/# eq_sym -(nth_take witness (j+1)) 1,2:/# !h//=/#. + rewrite h 1:/# h 1:/# => -> h';exists b c=>//=;rewrite h'/=getP/=. + smt(size_take size_cat size_nseq). + cut->>/=:j = size (format bl (i-1)) by smt(size_cat size_nseq). + rewrite getP/=. + cut h':size (format bl (i-1)) = size bl + i - 2 by smt(size_cat size_nseq). + rewrite h'/=-(addzA _ _ 1)/=. + cut h'':(size bl + i - 1) = size (format bl i) by smt(size_cat size_nseq). + rewrite h'' take_size/=-h 1:/# -h' take_size. + rewrite nth_cat h';cut->/=:! size bl + i - 2 < size bl by smt(). + by rewrite nth_nseq 1:/#;smt(Block.WRing.AddMonoid.addm0 in_dom get_oget). + + move=>bs n;rewrite dom_set in_fsetU1;case=>//=[Hdom|[]->>->>]//=;do!split=>//=. + - by cut//:=hmp2 _ _ Hdom. + - by cut//:=hmp2 _ _ Hdom. + - by cut[]H_valid[]Hn0[]H_size H_prefixe:=hmp2 _ _ Hdom;rewrite getP/=;smt(). + - cut[]H_valid[]Hn0[]H_size H_prefixe k[]hk0 hksize:=hmp2 _ _ Hdom. + rewrite!getP/=;cut->/=:!(bs = bl && n = i) by smt(). + by rewrite-H_prefixe//=;smt(in_dom). + - smt(). + - by rewrite getP/=oget_some/=size_rcons;smt(in_dom get_oget). + move=>j[]hj0 hji;rewrite!getP/=oget_some-{2}cats1 take_cat. + case(i=j)=>[->>|]//=. + - by cut<-/=:j - 1 = size lres;smt(in_dom get_oget cats1). + move=>hij;cut->/=:j<>i by smt(). + cut->:size lres = i - 1 by smt(in_dom get_oget cats1). + case(j < i - 1)=>//=hh;1:smt(in_dom get_oget cats1). + by cut->>/=: j = i - 1;smt(cats0). + + move=>bs n;rewrite dom_set in_fsetU1;case=>[Hdom|[]->>->>]. + - rewrite !getP/=;smt(in_dom). + by rewrite!getP/=oget_some last_rcons/=;smt(get_oget in_dom). + move=>l;rewrite dom_set in_fsetU1;case=>[H_dom|->>]l_n_nil. + + smt(dom_set in_fsetU1). + by exists [];rewrite cats0 parseK//= 1:/# dom_set in_fsetU1. + qed. + + local lemma take_nseq (a : 'a) i j : + take j (nseq i a) = if j <= i then nseq j a else nseq i a. + proof. + case(0 <= j)=>hj0;last first. + + rewrite take_le0 1:/#;smt(nseq0_le). + case(j <= i)=>hij//=;last smt(take_oversize size_nseq). + apply(eq_from_nth witness). + + smt(size_take size_nseq). + smt(size_nseq size_take nth_take nth_nseq). + qed. + + local lemma take_format (bl : block list) n i : + 0 < n => + 0 <= i < size bl + n => + take i (format bl n) = + if i <= size bl then take i bl else format bl (i - size bl + 1). + proof. + move=>Hn0[]Hi0 Hisize;rewrite take_cat take_nseq. + case(i < size bl)=>//=[/#|H_isize']. + cut->/=:i - size bl <= n - 1 by smt(). + case(i = size bl)=>[->>|H_isize'']//=;1:by rewrite nseq0 take_size cats0. + smt(). + qed. + + local lemma equiv_sponge (D <: NDISTINGUISHER {P, NC, Redo, C}) : equiv [ GReal(A(D)).main ~ NIndif(Squeeze(SqueezelessSponge(P)),P,DC(D)).main @@ -315,19 +445,21 @@ section. Redo.prefixes{1} NC.queries{1}.[(bl{1}, i{1}) <- lres{1}]);progress. while(={i,nb,bl,n,p,glob NC,glob Redo,glob P,lres} /\ (n,p){1} = (nb,bl){1} /\ 0 < i{1} <= nb{1} /\ (0 < i{1} => Some lres{1} = NC.queries{1}.[(bl{1}, i{1})]) /\ - format p{1} i{1} \in dom Redo.prefixes{1} /\ + format p{1} i{1} \in dom Redo.prefixes{1} /\ valid p{1} /\ size lres{1} = i{1} /\ INV_Real C.c{1} (NC.c{1} + size bl{2} + i{1} - 1) Perm.m{1} Perm.mi{1} Redo.prefixes{1} NC.queries{1}.[(bl{1}, i{1}) <- lres{1}]);last first. + sp;conseq(:_ ==> ={i,nb,bl,n,p,glob NC,glob Redo,glob P,lres} /\ (n,p){1} = (nb,bl){1} /\ 0 < i{1} <= nb{1} /\ (0 < i{1} => Some lres{1} = NC.queries{1}.[(bl{1}, i{1})]) /\ - format p{1} i{1} \in dom Redo.prefixes{1} /\ + format p{1} i{1} \in dom Redo.prefixes{1} /\ size lres{1} = i{1} /\ INV_Real C.c{1} (NC.c{1} + size bl{2} + i{1} - 1) Perm.m{1} Perm.mi{1} - Redo.prefixes{1} NC.queries{1}.[(bl{1}, i{1}) <- lres{1}]);1:progress=>/#. + Redo.prefixes{1} NC.queries{1}.[(bl{1}, i{1}) <- lres{1}]);1:progress=>/#. sp;if;auto;last first. * progress. - by rewrite/#. - by cut INV0:=H;cut[]//=H_c1c2 H_m_p H_invm:=INV0;cut[]/#:=H_m_p. - - by cut[]_[]_ _ _ help _ _:=H;cut:=help _ _ H3. + - by cut[]_[]_ _ _ help _ _:=H;cut:=help _ _ H3;smt(in_dom). + - cut[]_[]Hmp0 Hmp1 Hmp2 Hmp3 Hmp4 Hinvm:=H. + cut//=:=Hmp2 bl{2} 1 H3;rewrite H0/==>help;cut/=->/=:=help 1;rewrite oget_some size_take//=. by rewrite set_eq 1:get_oget//=;split;case:H=>//=;smt(size_ge0). sp=>/=. exists* Redo.prefixes{1}, C.c{1};elim*=>pref count;progress. @@ -362,8 +494,9 @@ section. pose k:=if _ then _ else _;cut->>Hij{k}:k=j by rewrite/#. by rewrite!take_take!min_lel 1,2:/# nth_take 1,2:/#;smt(in_dom). - by move=>l n;rewrite!dom_set in_fsetU1=>[][];smt(getP oget_some in_dom take_oversize). - - move=>l n;rewrite dom_set in_fsetU1;case=>//=;1:smt(in_dom). - by move=>[]<<-->>;rewrite/format/=nseq0 cats0/=-take_size in_dom H5. + - move=>l n;rewrite dom_set in_fsetU1 getP;case((l, n) = (bl{2}, 1))=>//=[[->>->>]|]. + * by rewrite oget_some/=/format/=nseq0 cats0-take_size H5/#. + move=>h H_dom;cut[]c:=Hmp3 _ _ H_dom;smt(in_dom). - move=>l H_dom_R H_not_nil;rewrite dom_set. cut:=H7 l H_dom_R;case;1:smt(in_fsetU1). move=>[]j[][]hj0 hjsize ->>;exists(drop j bl{2}). @@ -462,14 +595,16 @@ section. rewrite!getP/=. cut->/=:!take j bl{2} = take (i0{2} + 1) bl{2} by smt(size_take). by case(j < i0{2})=>hj0;smt(get_oget in_dom oget_some size_take). - sp;if;auto;last first;progress. + rewrite/#. + rewrite/#. + by rewrite get_oget//=. - + by cut[]_[]_ _ _ help _ _:=H3;cut->//=:=help bl{2} (i_R+1);rewrite dom_set in_fsetU1 H6. - + by rewrite set_eq//=1:get_oget//=;split;cut:=H3;rewrite set_eq 1:H1//==>[][]//=/#. - + + rewrite in_dom;cut[]_[]_ _ _ help _ _:=H4. + by cut//=:=help bl{2} (size lres{2}+1);rewrite dom_set in_fsetU1 H7/==>[][]c->. + + cut[]_[]_ _ help _ _ _:=H4. + cut:=help bl{2} (size lres{2}+1);rewrite dom_set in_fsetU1//=H7/=H3/=!getP/=. + by cut->/=[]_[]->//:!size lres{2} + 1 = size lres{2} by smt(). + + by rewrite set_eq//=1:get_oget//=;split;cut:=H4;rewrite set_eq 1:H1//==>[][]//=/#. sp. splitwhile{1} 1 : i0 < size p0 - 1;splitwhile{2} 1 : i0 < size p0 - 1. rcondt{1}2;2:rcondt{2}2;1,2:by auto; @@ -478,11 +613,334 @@ section. seq 1 : (i0 = size p0 - 1);1:(auto; while(i0 < size p0);auto;1:if;2:(sp;if);auto;smt(size_cat size_nseq size_ge0)); if;sp;2:if;auto;smt(size_cat size_nseq size_ge0). - (* TODO *) + wp;conseq(:_==> ={sa,sc,glob Redo,glob Perm} + /\ INV_Real C.c{1} (NC.c{1} + size bl{2} + i{1} - 1) Perm.m{1} Perm.mi{1} + Redo.prefixes{1} NC.queries{1}.[(p{1}, i{1}) <- rcons lres{1} sa{1}] + /\ (format p{1} i{1} \in dom Redo.prefixes{1}));progress. + + smt(size_ge0). + + smt(size_ge0). + + by rewrite getP/=. + + exact size_rcons. + + by rewrite set_set//=. + seq 1 1 : (={nb,bl,n,p,p0,i,i0,lres,sa,sc,glob NC,glob Redo,glob Perm} + /\ n{1} = nb{1} /\ p{1} = bl{1} /\ p0{1} = format p{1} i{1} + /\ 1 < i{1} <= n{1} /\ valid p{1} /\ i0{1} = size p0{1} - 1 + /\ Some lres{1} = NC.queries{1}.[(bl{1}, i{1}-1)] + /\ ! ((p{1}, i{1}) \in dom NC.queries{1}) + /\ Redo.prefixes{1}.[format p{1} (i{1}-1)] = Some (sa{1},sc{1}) + /\ INV_Real C.c{1} (NC.c{1} + size bl{2} + i{1} - 2) Perm.m{1} Perm.mi{1} + Redo.prefixes{1} NC.queries{1}.[(bl{1}, i{1} - 1) <- lres{1}]);last first. + + if;auto;progress. + - move:H6;rewrite -addzA/=take_size=>H_dom. + move:H5;rewrite set_eq 1:H2//= =>inv0. + apply lemma1=>//=. + * split;case:inv0=>//=/#. + * smt(). + * rewrite size_rcons;cut[]//=Hc[]Hmp0 Hmp1 Hmp2 Hmp3 Hmp4 Hinvm:=inv0. + by cut:=Hmp2 bl{2} (i{2}-1);rewrite in_dom -H2/=H1/=oget_some/#. + * rewrite last_rcons;smt(get_oget in_dom). + move=>j[]hj0 hji. + cut[]//=Hc[]Hmp0 Hmp1 Hmp2 Hmp3 Hmp4 Hinvm:=inv0;cut:=Hmp2 bl{2} (i{2}-1). + rewrite in_dom -H2/=H1/=oget_some=>[][]hi10[]hsize->;1:smt(). + congr;rewrite-cats1 take_cat;case(j < size lres{2})=>//=hsize2. + cut->//=:j = size lres{2} by smt(). + by rewrite cats0 take_size. + - by move:H6;rewrite -(addzA _ _ 1)/=take_size. + sp;if;auto;progress. + - move:H6 H7;rewrite!getP/=!oget_some nth_last -(addzA _ _ 1)/=take_size. + rewrite last_cat last_nseq 1:/# Block.WRing.addr0;progress. + cut//=:=lemma2(C.c{1} + 1)(NC.c{2} + size bl{2} + i{2} - 1) + Perm.m{2}.[(sa_R, sc{2}) <- y0L] Perm.mi{2}.[y0L <- (sa_R, sc{2})] + Redo.prefixes{2} NC.queries{2} bl{2} i{2} sa_R sc{2} lres{2}. + rewrite H/=H1/=H2/=H4/=H6/=H3/=dom_set in_fsetU1/=getP/=oget_some. + cut->->//=:y0L = (y0L.`1, y0L.`2) by smt(). + rewrite INV_Real_addm_mi//=;2:smt(supp_dexcepted). + by cut:=H5;rewrite set_eq 1:H2//==>hinv0;split;case:hinv0=>//=/#. + - by rewrite dom_set in_fsetU1//=-(addzA _ _ 1)/=take_size. + - move:H6 H7;rewrite nth_last -(addzA _ _ 1)/=take_size. + rewrite last_cat last_nseq 1:/# Block.WRing.addr0;progress. + pose a:=(_, _);cut->/={a}:a = oget Perm.m{2}.[(sa_R, sc{2})] by smt(). + apply lemma2=>//=;first cut:=H5;rewrite set_eq 1:H2//==>hinv0;split;case:hinv0=>//=/#. + rewrite H2//=. + - by rewrite dom_set in_fsetU1//=-(addzA _ _ 1)/=take_size. + alias{1} 1 pref = Redo.prefixes;sp;alias{1} 1 count = C.c. + alias{1} 1 pm = Perm.m;sp;alias{1} 1 pmi = Perm.mi;sp. + conseq(:_==> ={nb,bl,n,p,p0,i,i0,lres,sa,sc,glob NC,glob Redo,glob Perm} + /\ pmi{1} = Perm.mi{1} /\ pm{1} = Perm.m{1} + /\ pref{1} = Redo.prefixes{1} /\ C.c{1} = count{1} + /\ n{1} = nb{1} /\ p{1} = bl{1} /\ p0{1} = format p{1} i{1} + /\ i0{1} = size p0{1} - 1 + /\ Redo.prefixes{1}.[format p{1} (i0{1} - size p{1} + 1)] = Some (sa{1}, sc{1})); + 1:smt(size_cat size_nseq). + splitwhile{1}1:i0 < size p;splitwhile{2}1:i0 < size p. + while(={nb,bl,n,p,p0,i,i0,lres,sa,sc,glob NC,glob Redo,glob Perm} + /\ pmi{1} = Perm.mi{1} /\ pm{1} = Perm.m{1} /\ 0 < i{1} + /\ pref{1} = Redo.prefixes{1} /\ C.c{1} = count{1} + /\ n{1} = nb{1} /\ p{1} = bl{1} /\ p0{1} = format p{1} i{1} + /\ size p{1} <= i0{1} <= size p0{1} - 1 /\ valid p{1} + /\ (format p{1} (i{1}-1) \in dom Redo.prefixes{1}) + /\ INV_Real C.c{1} (NC.c{1} + size bl{2} + i{1} - 2) Perm.m{1} Perm.mi{1} + Redo.prefixes{1} NC.queries{1} + /\ Redo.prefixes{1}.[format p{1} (i0{1} - size p{1} + 1)] = Some (sa{1}, sc{1}) ). + + rcondt{1}1;2:rcondt{2}1;auto;progress. + - rewrite take_format;1,2:smt(size_cat size_ge0 size_nseq). + cut->/=:! i0{m} + 1 <= size bl{m} by smt(). + cut:=take_format bl{m} (i{m}-1) (i0{m} + 1) _ _;1,2:smt(size_cat size_ge0 size_nseq). + cut->/=<-:! i0{m} + 1 <= size bl{m} by smt(). + by cut/#:=all_prefixes_of_INV_real. + - rewrite take_format;1,2:smt(size_cat size_ge0 size_nseq). + cut->/=:! i0{hr} + 1 <= size bl{hr} by smt(). + cut:=take_format bl{hr} (i{hr}-1) (i0{hr} + 1) _ _;1,2:smt(size_cat size_ge0 size_nseq). + cut->/=<-:! i0{hr} + 1 <= size bl{hr} by smt(). + by cut/#:=all_prefixes_of_INV_real. + - smt(). + - smt(). + - rewrite take_format//=;1:smt(size_cat size_ge0 size_nseq). + cut->/=:!i0{2} + 1 <= size bl{2} by smt(). + rewrite get_oget 2:/#. + cut:=take_format bl{2} (i{2}-1) (i0{2} + 1) _ _;1,2:smt(size_cat size_ge0 size_nseq). + cut->/=:!i0{2} + 1 <= size bl{2} by smt(). + by cut/#:=all_prefixes_of_INV_real. + conseq(:_==> ={nb,bl,n,p,p0,i,i0,lres,sa,sc,glob NC,glob Redo,glob Perm} + /\ pmi{1} = Perm.mi{1} /\ pm{1} = Perm.m{1} /\ 0 < i{1} + /\ pref{1} = Redo.prefixes{1} /\ C.c{1} = count{1} + /\ n{1} = nb{1} /\ p{1} = bl{1} /\ p0{1} = format p{1} i{1} + /\ size p{1} = i0{1} /\ valid p{1} + /\ (format p{1} (i{1}-1) \in dom Redo.prefixes{1}) + /\ INV_Real C.c{1} (NC.c{1} + size bl{2} + i{1} - 2) Perm.m{1} Perm.mi{1} + Redo.prefixes{1} NC.queries{1} + /\ Redo.prefixes{1}.[take i0{1} p{1}] = Some (sa{1}, sc{1})); + progress. + + smt(size_cat size_ge0 size_nseq). + + by rewrite /format/=nseq0 cats0 -take_size;exact H12. + + smt(). + while( ={nb,bl,n,p,p0,i,i0,lres,sa,sc,glob NC,glob Redo,glob Perm} + /\ pmi{1} = Perm.mi{1} /\ pm{1} = Perm.m{1} /\ 1 < i{1} + /\ pref{1} = Redo.prefixes{1} /\ C.c{1} = count{1} + /\ n{1} = nb{1} /\ p{1} = bl{1} /\ p0{1} = format p{1} i{1} + /\ 0 <= i0{1} <= size p{1} /\ valid p{1} + /\ (format p{1} (i{1}-1) \in dom Redo.prefixes{1}) + /\ INV_Real C.c{1} (NC.c{1} + size bl{2} + i{1} - 2) Perm.m{1} Perm.mi{1} + Redo.prefixes{1} NC.queries{1} + /\ Redo.prefixes{1}.[take i0{1} p{1}] = Some (sa{1}, sc{1}) );last first. + + auto;progress. + - smt(size_ge0). + - smt(size_ge0). + - smt(). + - smt(set_eq in_dom). + - by rewrite take0;case:H4=>[]_[]//=. + - smt(size_cat size_nseq size_ge0). + - smt(size_cat size_nseq size_ge0). + rcondt{1}1;2:rcondt{2}1;auto;progress. + + cut->:take (i0{m} + 1) (format bl{m} i{m}) = + take (i0{m} + 1) (format bl{m} (i{m} - 1)) + by rewrite!take_format//=;smt(size_cat size_ge0 size_nseq). + by cut/#:=all_prefixes_of_INV_real. + + cut->:take (i0{hr} + 1) (format bl{hr} i{hr}) = + take (i0{hr} + 1) (format bl{hr} (i{hr} - 1)) + by rewrite!take_format//=;smt(size_cat size_ge0 size_nseq). + by cut/#:=all_prefixes_of_INV_real. + + smt(). + + smt(). + cut->:take (i0{2} + 1) (format bl{2} i{2}) = + take (i0{2} + 1) (format bl{2} (i{2} - 1)) + by rewrite!take_format//=;smt(size_cat size_ge0 size_nseq). + cut->:take (i0{2} + 1) bl{2} = take (i0{2} + 1) (format bl{2} (i{2} - 1)) + by rewrite take_format;smt(size_cat size_ge0 size_nseq). + by cut:=all_prefixes_of_INV_real _ _ _ _ _ _ H4 _ H3;smt(in_dom). + qed. + + + local lemma lemma3 c c' m mi p q bl i sa sc lres: + INV_Real c c' m mi p q => + 0 < i => + q.[(bl,i)] = Some lres => + p.[format bl i] = Some (sa,sc) => + (bl,i+1) \in dom q => + q.[(bl,i+1)] = Some (rcons lres (oget m.[(sa,sc)]).`1). + proof. + move=>inv0 H_i0 H_q_i H_p_i H_dom_iS. + cut[]_[]_ hmp1 hmp2 hmp3 _ _:=inv0. + cut[]c2 h2:=hmp3 _ _ H_dom_iS. + cut:=hmp1 (format bl (i+1));rewrite in_dom h2/==>help. + cut:=help (size (format bl i)) _;1:smt(size_ge0 size_cat size_nseq). + move=>[]b3 c3;rewrite!take_format;..4:smt(size_ge0 size_cat size_nseq). + cut->/=:!size (format bl i) + 1 <= size bl by smt(size_cat size_nseq size_ge0). + rewrite nth_cat. + cut->/=:!size (format bl i) < size bl by smt(size_cat size_ge0). + rewrite nth_nseq 1:size_cat 1:size_nseq 1:/#. + pose x:=if _ then _ else _;cut->/={x}:x = format bl i. + + rewrite/x;case(i = 1)=>//=[->>|hi1]. + - by rewrite/format/=nseq0 cats0//=take_size. + by rewrite size_cat size_nseq/#. + pose x:=List.size _ + 1 - List.size _ + 1;cut->/={x}:x=i+1 + by rewrite/x size_cat size_nseq;smt(). + rewrite H_p_i h2=>[]/=[][]->>->>. + rewrite Block.WRing.addr0=>H_pm;rewrite H_pm/=oget_some. + cut[]_[]_[]H_size H:=hmp2 _ _ H_dom_iS. + cut H_q_i':=H i _;1:smt(). + cut:=H (i+1) _;1:smt(). + rewrite (take_nth witness)1:/# =>H_q_iS. + rewrite H_q_iS/=oget_some last_rcons;congr. + by cut:=H_q_i';rewrite H_q_i/=. + qed. + + + local lemma lemma3' c c' m mi p q bl i sa sc lres: + INV_Real c c' m mi p q => + 0 < i => + q.[(bl,i)] = Some lres => + p.[format bl i] = Some (sa,sc) => + (bl,i+1) \in dom q => + q.[(bl,i+1)] = Some (rcons lres (oget p.[format bl (i+1)]).`1). + proof. + move=>inv0 H_i0 H_q_i H_p_i H_dom_iS. + cut[]_[]_ hmp1 hmp2 hmp3 _ _:=inv0. + cut->:=lemma3 _ _ _ _ _ _ _ _ _ _ _ inv0 H_i0 H_q_i H_p_i H_dom_iS;congr;congr. + cut[]b3 c3[]:=hmp1 (format bl (i+1)) _ (size (format bl i)) _. + + rewrite in_dom;smt(). + + rewrite!size_cat!size_nseq;smt(size_ge0). + rewrite nth_cat nth_nseq;1:smt(size_cat size_nseq size_ge0). + cut->/=:!size (format bl i) < size bl by smt(size_cat size_nseq size_ge0). + rewrite Block.WRing.addr0 !take_format 1,3:/#;1,2:smt(size_cat size_nseq size_ge0). + cut->/=:!size (format bl i) + 1 <= size bl by smt(size_cat size_nseq size_ge0). + cut->:size (format bl i) + 1 - size bl = i by smt(size_cat size_nseq). + case(size (format bl i) <= size bl)=>//=Hi;last first. + + cut->:size (format bl i) - size bl + 1 = i by smt(size_cat size_nseq). + by rewrite H_p_i/==>[][]->>->>->//. + cut->>/=:i = 1 by smt(size_cat size_nseq). + by cut:=H_p_i;rewrite /(format bl 1)/=nseq0 cats0 take_size=>->/=[]->>->>->//. + qed. + + + local lemma lemma4 c c' m mi p q bl i sa sc lres: + INV_Real c c' m mi p q => + 0 < i => + q.[(bl,i)] = Some lres => + p.[format bl i] = Some (sa,sc) => + (bl,i+1) \in dom q => + p.[format bl (i+1)] = m.[(sa,sc)]. + proof. + move=>inv0 H_i0 H_q_i H_p_i H_dom_iS. + cut[]_[]_ hmp1 hmp2 hmp3 _ _:=inv0. + cut[]c2 h2:=hmp3 _ _ H_dom_iS. + cut:=hmp1 (format bl (i+1));rewrite in_dom h2/==>help. + cut:=help (size (format bl i)) _;1:smt(size_ge0 size_cat size_nseq). + move=>[]b3 c3;rewrite!take_format;..4:smt(size_ge0 size_cat size_nseq). + cut->/=:!size (format bl i) + 1 <= size bl by smt(size_cat size_nseq size_ge0). + rewrite nth_cat. + cut->/=:!size (format bl i) < size bl by smt(size_cat size_ge0). + rewrite nth_nseq 1:size_cat 1:size_nseq 1:/#. + pose x:=if _ then _ else _;cut->/={x}:x = format bl i. + + rewrite/x;case(i = 1)=>//=[->>|hi1]. + - by rewrite/format/=nseq0 cats0//=take_size. + by rewrite size_cat size_nseq/#. + pose x:=List.size _ + 1 - List.size _ + 1;cut->/={x}:x=i+1 + by rewrite/x size_cat size_nseq;smt(). + rewrite H_p_i h2=>[]/=[][]->>->>. + rewrite Block.WRing.addr0=>H_pm;rewrite H_pm/=. + cut[]_[]_[]H_size H:=hmp2 _ _ H_dom_iS. + cut H_q_i':=H i _;1:smt(). + cut:=H (i+1) _;1:smt(). + by rewrite (take_nth witness)1:/# =>H_q_iS. qed. + local lemma squeeze_squeezeless (D <: NDISTINGUISHER {P, NC, Redo, C}) : + equiv [ NIndif(Squeeze(SqueezelessSponge(P)),P,DC(D)).main + ~ NIndif(BlockSponge(P),P,DC(D)).main + : ={glob D} ==> ={res, glob P, glob D, NC.c}]. + proof. + proc;inline*;sp;wp. + call(: ={glob Perm,glob NC} + /\ INV_Real 0 NC.c{1} Perm.m{1} Perm.mi{1} Redo.prefixes{1} + NC.queries{1});auto;last first. + + progress. + split=>//=;1:split=>//=;smt(getP dom0 map0P in_fset0 dom_set in_fsetU1). + + proc;inline*;auto;sp;if;auto;progress. + - by rewrite INV_Real_addm_mi;2..:smt(supp_dexcepted);split;case:H=>//=;smt(). + - by split;case:H=>//=;smt(). + + proc;inline*;auto;sp;if;auto;progress. + - rewrite INV_Real_addm_mi;1: by split;case:H=>//=;smt(). + * case:H;smt(invm_dom_rng invmC supp_dexcepted). + case:H;smt(invm_dom_rng invmC supp_dexcepted). + - by split;case:H=>//=;smt(). + proc;inline*;sp;auto;if;auto;if;auto;sp. + rcondt{1}1;auto;sp. + seq 1 4 : (={glob Perm, glob NC, i, p, n, bl, nb} /\ nb{1} = n{1} + /\ (lres,sa,sc){1} = (r0,b,c){2} /\ bl{1} = p{2} + /\ NC.queries{1}.[(p{1},i{1})] = Some lres{1} + /\ valid p{1} /\ i{1} <= n{1} /\ i{1} = 1 + /\ ! ((p,n) \in dom NC.queries){1} + /\ INV_Real 0 NC.c{1} Perm.m{1} Perm.mi{1} Redo.prefixes{1} + NC.queries{1}.[(p{1}, i{1}) <- lres{1}] + /\ Redo.prefixes{1}.[p{1}] = Some (sa{1},sc{1}));last first. + + auto=>/=. + while(={glob Perm, glob NC, i, p, n, bl, nb} /\ nb{1} = n{1} + /\ (lres){1} = (r0){2} /\ bl{1} = p{2} /\ 0 < i{2} <= n{1} + /\ valid p{1} + /\ NC.queries{1}.[(p{1},i{1})] = Some lres{1} + /\ ! ((p,n) \in dom NC.queries){1} + /\ INV_Real 0 NC.c{1} Perm.m{1} Perm.mi{1} Redo.prefixes{1} + NC.queries{1}.[(p{1}, i{1}) <- lres{1}] + /\ Redo.prefixes{1}.[format p{1} i{1}] = Some (b{2},c{2}));last first. + - auto;progress. + * by rewrite/format/=nseq0 cats0 H4//=. + * smt(). + sp;if{1};last first. + - rcondf{2}1;auto;progress. + * cut:=H4;rewrite set_eq//=in_dom=>inv0. + cut[]_[]_ hmp1 hmp2 hmp3 _ _:=inv0. + cut:=hmp1 (format p{hr} (i{hr}+1));rewrite in_dom//=. + cut[]c3 h3:=hmp3 _ _ H8;rewrite h3/= => help. + cut[]b4 c4:=help (size p{hr} + i{hr} - 1) _;1:smt(size_cat size_nseq size_ge0). + rewrite !take_format 1,3:/#;1,2:smt(size_cat size_nseq size_ge0). + rewrite nth_cat/=nth_nseq/=1:/# -(addzA _ (-1) 1)/=. + cut->/=:!size p{hr} + i{hr} <= size p{hr} by smt(). + cut->/=:!size p{hr} + i{hr} - 1 < size p{hr} by smt(). + pose x:=if _ then _ else _;cut->/={x}:x = format p{hr} i{hr}. + + rewrite/x;case(i{hr}=1)=>[->>|/#]//=. + by rewrite -(addzA _ 1 (-1))/= take_size/format/=nseq0 cats0. + by rewrite Block.WRing.addr0 (addzAC _ i{hr})/=H5/==>[][][]->>->>->;rewrite h3. + * rewrite set_eq//=. + cut:=H4;rewrite set_eq//==>inv0. + by cut->:=lemma3 _ _ _ _ _ _ _ _ _ _ _ inv0 H H2 H5 H8. + * cut:=H4;rewrite set_eq//==>inv0. + by cut->:=lemma3 _ _ _ _ _ _ _ _ _ _ _ inv0 H H2 H5 H8. + * smt(). + * smt(). + * smt(get_oget in_dom). + * smt(set_eq get_oget in_dom). + * cut:=H4;rewrite set_eq//==>inv0. + cut->:=lemma4 _ _ _ _ _ _ _ _ _ _ _ inv0 H H2 H5 H8;rewrite get_oget 2:/#. + cut[]_[]_ hmp1 hmp2 hmp3 _ _:=inv0. + cut:=hmp1 (format p{2} (i{2}+1));rewrite in_dom//=. + cut[]c3 h3:=hmp3 _ _ H8;rewrite h3/= => help. + cut[]b4 c4:=help (size p{2} + i{2} - 1) _;1:smt(size_cat size_nseq size_ge0). + rewrite !take_format 1,3:/#;1,2:smt(size_cat size_nseq size_ge0). + rewrite nth_cat/=nth_nseq/=1:/# -(addzA _ (-1) 1)/=. + cut->/=:!size p{2} + i{2} <= size p{2} by smt(). + cut->/=:!size p{2} + i{2} - 1 < size p{2} by smt(). + pose x:=if _ then _ else _;cut->/={x}:x = format p{2} i{2}. + + rewrite/x;case(i{2}=1)=>[->>|/#]//=. + by rewrite -(addzA _ 1 (-1))/= take_size/format/=nseq0 cats0. + by rewrite in_dom Block.WRing.addr0 (addzAC _ i{2})/=H5/==>[][][]->>->>->;rewrite h3. + swap{2}4-3;wp;sp=>/=. + splitwhile{1}1:i0 < size p0 - 1. + rcondt{1}2;2:rcondf{1}4;auto. + + while(0 <= i0 <= size p0 -1);last by auto;smt(size_cat size_nseq size_ge0). + if;auto;1:smt(size_cat size_nseq size_ge0). + by sp;if;auto;smt(size_cat size_nseq size_ge0). + + seq 1 : (i0 = size p0 - 1). + - while(0 <= i0 <= size p0 -1);last by auto;smt(size_cat size_nseq size_ge0). + if;auto;1:smt(size_cat size_nseq size_ge0). + by sp;if;auto;smt(size_cat size_nseq size_ge0). + by if;auto;1:smt();sp;if;auto;smt(). + seq 1 1 : + + + qed. local lemma equiv_ideal (IF <: FUNCTIONALITY{DSqueeze,C}) @@ -624,9 +1082,9 @@ module S(F : DFUNCTIONALITY) = { } }. -lemma Real_Ideal &m (D <: DISTINGUISHER): - Pr[Indif(SqueezelessSponge(PC(Perm)), PC(Perm), D).main() @ &m: res /\ C.c <= max_size] <= - Pr[Indif(IF,S(IF),DRestr(D)).main() @ &m :res] + +lemma Real_Ideal &m (D <: NDISTINGUISHER): + Pr[NIndif(BlockSponge(PC(Perm)), PC(Perm), D).main() @ &m: res /\ C.c <= max_size] <= + Pr[NIndif(IF,S(IF),DRestr(D)).main() @ &m : res] + (max_size ^ 2)%r / 2%r * mu dstate (pred1 witness) + max_size%r * ((2*max_size)%r / (2^c)%r) + max_size%r * ((2*max_size)%r / (2^c)%r). From 870e242b11ef6c2cb25f12081ff7a85f29d3c6c6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Thu, 19 Apr 2018 16:43:27 +0200 Subject: [PATCH 277/525] BlockSponge: - DRestr defined and explained. - The lemma we want to prove at the end of my part. - Definition of the simulator (it uses the definition of the simulator in the very low level). --- proof/BlockSponge.ec | 112 +++++++++++++++++++++++++++++++++++++++---- 1 file changed, 103 insertions(+), 9 deletions(-) diff --git a/proof/BlockSponge.ec b/proof/BlockSponge.ec index 5c9956d..ba95d77 100644 --- a/proof/BlockSponge.ec +++ b/proof/BlockSponge.ec @@ -1,8 +1,8 @@ (*-------------------- Padded Block Sponge Construction ----------------*) -require import Core Int Real List. -require (*--*) IRO Indifferentiability. -require import Common. +require import AllCore Int Real List. +require (*--*) IRO Indifferentiability Gconcl. +require import Common SLCommon. (*------------------------- Indifferentiability ------------------------*) @@ -24,6 +24,101 @@ clone import IRO as BIRO with op valid <- valid_block, op dto <- bdistr. + +(*------ Validity and Parsing/Formatting of Functionality Queries ------*) + +op format (p : block list) (n : int) = p ++ nseq (n - 1) b0. +op parse: block list -> (block list * int). + +axiom formatK bs: format (parse bs).`1 (parse bs).`2 = bs. +axiom parseK p n: 0 < n => valid_block p => parse (format p n) = (p,n). +axiom parse_nil: parse [] = ([],0). + +lemma parse_injective: injective parse. +proof. by move=> bs1 bs2 eq_format; rewrite -formatK eq_format (@formatK bs2). qed. + +lemma parse_valid p: valid_block p => parse p = (p,1). +proof. +move=>h;cut{1}->:p=format p 1;2:smt(parseK). +by rewrite/format/=nseq0 cats0. +qed. + + +(*------------------------------ Counter -------------------------------*) + +module C = { + var c : int + proc init() = { + c <- 0; + } +}. + +(*---------------------------- Restrictions ----------------------------*) + +(** The counter for the functionnality counts the number of times the + underlying primitive is called inside the functionality. This + number is equal to the sum of the number of blocks the input + message contains and the number of additional blocks the squeezing + phase has to output. + *) +module FC (F : DFUNCTIONALITY) = { + proc init () : unit = {} + proc f (bl : block list, nb : int) = { + var r : block list <- []; + if (0 < nb) { + if (C.c + size bl + nb - 1 <= max_size) { + C.c <- C.c + size bl + nb - 1; + r <@ F.f(bl,nb); + } + } + return r; + } +}. + + +module PC (P : DPRIMITIVE) = { + proc init() = {} + proc f (a : state) = { + var z : state <- (b0,c0); + if (C.c + 1 <= max_size) { + z <@ P.f(a); + C.c <- C.c + 1; + } + return z; + } + proc fi (a : state) = { + var z : state <- (b0,c0); + if (C.c + 1 <= max_size) { + z <@ P.fi(a); + C.c <- C.c + 1; + } + return z; + } +}. + +module DRestr (D : DISTINGUISHER) (F : DFUNCTIONALITY) (P : DPRIMITIVE) = { + proc distinguish () : bool = { + var b : bool; + C.init(); + b <@ D(FC(F),PC(P)).distinguish(); + return b; + } +}. + + +(*----------------------------- Simulator ------------------------------*) + +module Last (F : DFUNCTIONALITY) : SLCommon.DFUNCTIONALITY = { + proc init() = {} + proc f (p : block list) : block = { + var r : block list <- []; + r <@ F.f(parse p); + return last b0 r; + } +}. + +module (S : SIMULATOR) (F : DFUNCTIONALITY) = Gconcl.S(Last(F)). + (*------------------------- Sponge Construction ------------------------*) module (Sponge : CONSTRUCTION) (P : DPRIMITIVE) : FUNCTIONALITY = { @@ -57,14 +152,13 @@ module (Sponge : CONSTRUCTION) (P : DPRIMITIVE) : FUNCTIONALITY = { (* this is just for typechecking, right now: *) -op eps : real. - lemma conclusion : - exists (S <: SIMULATOR), forall (D <: DISTINGUISHER) &m, - `| Pr[RealIndif(Sponge, Perm, D).main() @ &m : res] - - Pr[IdealIndif(IRO, S, D).main() @ &m : res]| - < eps. + `| Pr[RealIndif(Sponge, Perm, DRestr(D)).main() @ &m : res] + - Pr[IdealIndif(IRO, S, DRestr(D)).main() @ &m : res]| + <= (max_size ^ 2)%r / 2%r * Distr.mu1 dstate witness + + max_size%r * ((2 * max_size)%r / (2 ^ c)%r) + + max_size%r * ((2 * max_size)%r / (2 ^ c)%r). proof. admit. qed. From 6e505081f7346170b89dba513ab249416f4c14f8 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Thu, 19 Apr 2018 17:50:39 +0200 Subject: [PATCH 278/525] Updating to include smart_counter in EasyCrypt load path. --- proof/.dir-locals.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/proof/.dir-locals.el b/proof/.dir-locals.el index a0bbb33..0337f77 100644 --- a/proof/.dir-locals.el +++ b/proof/.dir-locals.el @@ -1,4 +1,4 @@ ((easycrypt-mode . ((eval . (flet ((pre (s) (concat (locate-dominating-file buffer-file-name ".dir-locals.el") s))) - (setq easycrypt-load-path `(,(pre ".") ,(pre "core")))))))) + (setq easycrypt-load-path `(,(pre ".") ,(pre "core") ,(pre "smart_counter")))))))) From 132fe35f73f64c021cce071be379153d181a4be7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Thu, 19 Apr 2018 17:58:03 +0200 Subject: [PATCH 279/525] Real : 1 step finished, 1 step 90% finished, 1 step todo. Ideal : all steps todo (should not be hard). --- proof/smart_counter/Gconcl_list.ec | 704 ++++++++++++++++++----------- 1 file changed, 434 insertions(+), 270 deletions(-) diff --git a/proof/smart_counter/Gconcl_list.ec b/proof/smart_counter/Gconcl_list.ec index aab08f0..ce418ba 100644 --- a/proof/smart_counter/Gconcl_list.ec +++ b/proof/smart_counter/Gconcl_list.ec @@ -1,132 +1,45 @@ pragma -oldip. require import Core Int Real RealExtra StdOrder Ring StdBigop IntExtra. require import List FSet NewFMap Utils Common SLCommon RndO FelTactic Mu_mem. -require import DProd Dexcepted. +require import DProd Dexcepted BlockSponge. (*...*) import Capacity IntOrder Bigreal RealOrder BRA. require (*--*) Handle. -clone export Handle as Handle0. - (*** THEORY PARAMETERS ***) (** Validity of Functionality Queries **) -op valid: block list -> bool. +op valid: block list -> bool = valid_block. axiom valid_spec p: valid p => p <> []. -(** Validity and Parsing/Formatting of Functionality Queries **) -op format (p : block list) (n : int) = p ++ nseq (n - 1) b0. -op parse: block list -> (block list * int). - -axiom formatK bs: format (parse bs).`1 (parse bs).`2 = bs. -axiom parseK p n: 0 < n => valid p => parse (format p n) = (p,n). -axiom parse_nil: parse [] = ([],0). - -lemma parse_injective: injective parse. -proof. by move=> bs1 bs2 eq_format; rewrite -formatK eq_format (@formatK bs2). qed. - -lemma parse_valid p: valid p => parse p = (p,1). -proof. -move=>h;cut{1}->:p=format p 1;2:smt(parseK). -by rewrite/format/=nseq0 cats0. -qed. - -module type NFUNCTIONALITY = { - proc init () : unit - proc f (p : block list, n : int) : block list -}. - -module type NDFUNCTIONALITY = { - proc f (p : block list, n : int) : block list -}. +clone export Handle as Handle0. module NC = { - var c : int var queries : (block list * int, block list) fmap proc init() = { - c <- 0; queries <- map0; } }. -module BlockSponge (P : PRIMITIVE) : NFUNCTIONALITY = { - proc init() = { - P.init(); - } - proc f (p : block list, n : int) : block list = { - var r : block list <- []; - var i : int <- 0; - var (b,c) <- (b0,c0); - while (i < size p) { - (b,c) <@ P.f(b +^ nth witness p i, c); - i <- i + 1; - } - i <- 1; - r <- rcons r b; - NC.queries.[(p,1)] <- r; - while (i < n) { - (b,c) <@ P.f(b, c); - r <- rcons r b; - i <- i + 1; - NC.queries.[(p,i)] <- r; - } - return r; - } -}. - -module type NDISTINGUISHER (F : NDFUNCTIONALITY, P : DPRIMITIVE) = { - proc distinguish () : bool -}. - -module NFC (F : NDFUNCTIONALITY) : NDFUNCTIONALITY = { - proc f (bl : block list, nb : int) = { - var r : block list <- []; - if (valid bl /\ 0 < nb) { - if (! (bl,nb) \in dom NC.queries) { - NC.c <- NC.c + size bl + nb - 1; - r <@ F.f(bl,nb); - NC.queries.[(bl,nb)] <- r; - } else { - r <- oget NC.queries.[(bl,nb)]; - } - } - return r; - } -}. - - - -module NPC (P : DPRIMITIVE) : DPRIMITIVE = { - proc f (a : state) = { - var z : state; - z <@ P.f(a); - NC.c <- NC.c + 1; - return z; - } - proc fi (a : state) = { - var z : state; - z <@ P.fi(a); - NC.c <- NC.c + 1; - return z; - } -}. - -module (DSqueeze (F : DFUNCTIONALITY) : NDFUNCTIONALITY) = { +module DSqueeze (F : SLCommon.DFUNCTIONALITY) = { + proc init () : unit = {} proc f (p : block list, n : int) : block list = { var lres : block list <- []; var b : block <- b0; var i : int <- 0; - while (i < n) { - i <- i + 1; - if (! (p,i) \in dom NC.queries) { - b <@ F.f(format p i); - lres <- rcons lres b; - NC.queries.[(p,i)] <- lres; - } else { - lres <- oget NC.queries.[(p,i)]; + if (valid p /\ 0 < n) { + while (i < n) { + i <- i + 1; + if (! (p,i) \in dom NC.queries) { + b <@ F.f(format p i); + lres <- rcons lres b; + NC.queries.[(p,i)] <- lres; + } else { + lres <- oget NC.queries.[(p,i)]; + } } } return lres; @@ -134,76 +47,30 @@ module (DSqueeze (F : DFUNCTIONALITY) : NDFUNCTIONALITY) = { }. -module (Squeeze (F : FUNCTIONALITY) : NFUNCTIONALITY) = { +module (Squeeze (F : SLCommon.FUNCTIONALITY) : FUNCTIONALITY) = { proc init () : unit = { - NC.queries <- map0; - NC.c <- 0; + NC.init(); + C.init(); F.init(); } proc f = DSqueeze(F).f }. -module NDFRestr (F : NDFUNCTIONALITY) = { - proc f (bl : block list, nb : int) = { - var b : block <- b0; - var lres : block list <- []; - var i : int <- 0; - - if (valid bl /\ 0 < nb) { - if (! (bl,nb) \in dom NC.queries) { - if (NC.c + size bl + nb - 1 <= max_size) { - NC.c <- NC.c + size bl + nb - 1; - lres <@ F.f(bl,nb); - } - } else { - lres <- oget NC.queries.[(bl,nb)]; - } - } - return lres; - } -}. - - -module NDPRestr (P : DPRIMITIVE) : DPRIMITIVE = { - proc f (a : state) = { - var z : state; - if (NC.c + 1 <= max_size) { - z <@ P.f(a); - NC.c <- NC.c + 1; - } - return z; - } - proc fi (a : state) = { - var z : state; - if (NC.c + 1 <= max_size) { - z <@ P.fi(a); - NC.c <- NC.c + 1; - } - return z; - } -}. - - - -module (NDRestr (D : NDISTINGUISHER) : NDISTINGUISHER) - (F : NDFUNCTIONALITY) (P : DPRIMITIVE) = D(NDFRestr(F),NDPRestr(P)). - - - -module (A (D : NDISTINGUISHER) : DISTINGUISHER) - (F : DFUNCTIONALITY) (P : DPRIMITIVE) = { +module (A (D : DISTINGUISHER) : SLCommon.DISTINGUISHER) + (F : SLCommon.DFUNCTIONALITY) (P : DPRIMITIVE) = { proc distinguish() : bool = { var b : bool; NC.init(); - b <@ D(NFC(DSqueeze(F)),NPC(P)).distinguish(); + C.init(); + b <@ D(FC(DSqueeze(F)),PC(P)).distinguish(); return b; } }. -module NIndif (F : NFUNCTIONALITY, P : PRIMITIVE, D : NDISTINGUISHER) = { +module NIndif (F : FUNCTIONALITY, P : PRIMITIVE, D : DISTINGUISHER) = { proc main () : bool = { var b : bool; C.init(); @@ -215,11 +82,12 @@ module NIndif (F : NFUNCTIONALITY, P : PRIMITIVE, D : NDISTINGUISHER) = { }. -module DC (D : NDISTINGUISHER) (F : NDFUNCTIONALITY) (P : DPRIMITIVE) = { +module DC (D : DISTINGUISHER) (F : DFUNCTIONALITY) (P : DPRIMITIVE) = { proc distinguish () : bool = { var b : bool; NC.init(); - b <@ D(NFC(F),NPC(P)).distinguish(); + C.init(); + b <@ D(FC(F),PC(P)).distinguish(); return b; } }. @@ -228,8 +96,11 @@ module DC (D : NDISTINGUISHER) (F : NDFUNCTIONALITY) (P : DPRIMITIVE) = { module P = Perm. -section. +section Real_Ideal. + + + pred inv_ideal (squeeze : (block list * int, block list) fmap) (c : (block list, block) fmap) = (forall p n, (p,n) \in dom squeeze => @@ -418,75 +289,80 @@ section. qed. - local lemma equiv_sponge (D <: NDISTINGUISHER {P, NC, Redo, C}) : + local lemma equiv_sponge (D <: DISTINGUISHER {P, NC, Redo, C, SLCommon.C}) : equiv [ GReal(A(D)).main ~ NIndif(Squeeze(SqueezelessSponge(P)),P,DC(D)).main - : ={glob D} ==> ={res, glob D, glob P, glob NC} /\ C.c{1} <= NC.c{2}]. + : ={glob D} ==> ={res, glob D, glob P, NC.queries, C.c} /\ SLCommon.C.c{1} <= C.c{2}]. proof. proc;inline*;sp;wp. - call(: ={Redo.prefixes, glob P, glob NC} /\ - INV_Real C.c{1} NC.c{2} Perm.m{1} Perm.mi{1} Redo.prefixes{1} NC.queries{1});auto;last first. + call(: ={Redo.prefixes, glob P, NC.queries, C.c} /\ + INV_Real SLCommon.C.c{1} C.c{2} Perm.m{1} Perm.mi{1} Redo.prefixes{1} NC.queries{1});auto;last first. + by progress;1:(split=>//=;1:split;smt(dom0 in_fset0 dom_set in_fsetU1 getP map0P));case:H0=>//=. - + by proc;inline*;auto;sp;if;auto;smt(INV_Real_addm_mi INV_Real_incr supp_dexcepted). - + proc;inline*;auto;sp;if;auto;progress. + + by proc;inline*;auto;sp;if;auto;sp;if;auto; + smt(INV_Real_addm_mi INV_Real_incr supp_dexcepted). + + proc;inline*;auto;sp;if;auto;sp;if;auto;progress. + apply INV_Real_incr=>//=. apply INV_Real_addm_mi=>//=. + case:H=>H_c H_m_p H_invm;rewrite (invm_dom_rng _ _ H_invm)//=. - by move:H1;rewrite supp_dexcepted. + by move:H2;rewrite supp_dexcepted. case:H=>H_c H_m_p H_invm;cut<-//:=(invm_dom_rng Perm.mi{2} Perm.m{2}). by rewrite invmC. + exact INV_Real_incr. - + proc;inline*;sp;if;auto;sp;if;auto. - swap 6;wp;sp=>/=;rcondt{1}1;1:auto;rcondt{2}1;1:auto. - conseq(:_==> ={i,nb,bl,n,p,glob NC,glob Redo,glob P,lres} /\ (n,p){1} = (nb,bl){1} /\ - i{1} = nb{1} /\ - format p{1} i{1} \in dom Redo.prefixes{1} /\ - INV_Real C.c{1} (NC.c{1} + size bl{2} + i{1} - 1) Perm.m{1} Perm.mi{1} - Redo.prefixes{1} NC.queries{1}.[(bl{1}, i{1}) <- lres{1}]);progress. - while(={i,nb,bl,n,p,glob NC,glob Redo,glob P,lres} /\ (n,p){1} = (nb,bl){1} /\ - 0 < i{1} <= nb{1} /\ (0 < i{1} => Some lres{1} = NC.queries{1}.[(bl{1}, i{1})]) /\ - format p{1} i{1} \in dom Redo.prefixes{1} /\ valid p{1} /\ size lres{1} = i{1} /\ - INV_Real C.c{1} (NC.c{1} + size bl{2} + i{1} - 1) Perm.m{1} Perm.mi{1} - Redo.prefixes{1} NC.queries{1}.[(bl{1}, i{1}) <- lres{1}]);last first. - + sp;conseq(:_ ==> ={i,nb,bl,n,p,glob NC,glob Redo,glob P,lres} /\ (n,p){1} = (nb,bl){1} /\ - 0 < i{1} <= nb{1} /\ (0 < i{1} => Some lres{1} = NC.queries{1}.[(bl{1}, i{1})]) /\ - format p{1} i{1} \in dom Redo.prefixes{1} /\ size lres{1} = i{1} /\ - INV_Real C.c{1} (NC.c{1} + size bl{2} + i{1} - 1) Perm.m{1} Perm.mi{1} - Redo.prefixes{1} NC.queries{1}.[(bl{1}, i{1}) <- lres{1}]);1:progress=>/#. + + proc;inline*;sp;if;auto;if;auto. + swap 6;wp;sp=>/=;if;auto;last by progress;split;case:H=>//=;smt(size_ge0). + rcondt{1}1;1:auto;rcondt{2}1;1:auto;sp. + conseq(:_==> ={i,nb,bl,n,p,NC.queries, C.c,glob Redo,glob P,lres} + /\ (n,p){1} = (nb,bl){1} /\ i{1} = nb{1} + /\ format p{1} i{1} \in dom Redo.prefixes{1} + /\ INV_Real SLCommon.C.c{1} (C.c{1} + size bl{2} + i{1} - 1) + Perm.m{1} Perm.mi{1} Redo.prefixes{1} NC.queries{1});progress. + while(={i,nb,bl,n,p,NC.queries,C.c,glob Redo,glob P,lres} + /\ (n,p){1} = (nb,bl){1} /\ 0 < i{1} <= nb{1} + /\ (0 < i{1} => Some lres{1} = NC.queries{1}.[(bl{1}, i{1})]) + /\ format p{1} i{1} \in dom Redo.prefixes{1} /\ valid p{1} + /\ size lres{1} = i{1} + /\ INV_Real SLCommon.C.c{1} (C.c{1} + size bl{2} + i{1} - 1) Perm.m{1} Perm.mi{1} + Redo.prefixes{1} NC.queries{1});last first. + + sp;conseq(:_ ==> ={i,nb,bl,n,p,NC.queries,C.c,glob Redo,glob P,lres} + /\ (n,p){1} = (nb,bl){1} /\ 0 < i{1} <= nb{1} + /\ (0 < i{1} => Some lres{1} = NC.queries{1}.[(bl{1}, i{1})]) + /\ format p{1} i{1} \in dom Redo.prefixes{1} /\ size lres{1} = i{1} + /\ INV_Real SLCommon.C.c{1} (C.c{1} + size bl{2} + i{1} - 1) + Perm.m{1} Perm.mi{1} Redo.prefixes{1} NC.queries{1});1:progress=>/#. sp;if;auto;last first. * progress. - by rewrite/#. - - by cut INV0:=H;cut[]//=H_c1c2 H_m_p H_invm:=INV0;cut[]/#:=H_m_p. - - by cut[]_[]_ _ _ help _ _:=H;cut:=help _ _ H3;smt(in_dom). + - by rewrite get_oget//. + - by cut INV0:=H;cut[]//=H_c1c2 H_m_p H_invm:=INV0;cut[]:=H_m_p;smt(in_dom). - cut[]_[]Hmp0 Hmp1 Hmp2 Hmp3 Hmp4 Hinvm:=H. - cut//=:=Hmp2 bl{2} 1 H3;rewrite H0/==>help;cut/=->/=:=help 1;rewrite oget_some size_take//=. - by rewrite set_eq 1:get_oget//=;split;case:H=>//=;smt(size_ge0). + by cut//=:=Hmp2 bl{2} 1 H4;rewrite H0/==>help;cut/=->/=:=help 1; + rewrite oget_some size_take. + by split;case:H=>//=;smt(size_ge0). sp=>/=. - exists* Redo.prefixes{1}, C.c{1};elim*=>pref count;progress. - conseq(:_==> ={i0,p0,i,p,n,nb,bl,sa,lres,glob NC,glob Redo,glob Perm} + exists* Redo.prefixes{1}, SLCommon.C.c{1};elim*=>pref count;progress. + conseq(:_==> ={i0,p0,i,p,n,nb,bl,sa,lres,NC.queries,C.c,glob Redo,glob Perm} /\ n{1} = nb{1} /\ p{1} = bl{1} /\ p0{1} = p{1} /\ i0{1} = size p{1} /\ Redo.prefixes{1}.[take i0{1} p{1}] = Some (sa{1},sc{1}) - /\ INV_Real count NC.c{1} Perm.m{1} Perm.mi{1} pref NC.queries{1} + /\ INV_Real count C.c{1} Perm.m{1} Perm.mi{1} pref NC.queries{1} /\ (forall l, l \in dom Redo.prefixes{1} => l \in dom pref \/ (exists j, 0 < j <= i0{2} /\ l = take j p{1})) /\ (forall l, l \in dom pref => pref.[l] = Redo.prefixes{1}.[l]) - /\ C.c{1} <= count + i0{1} <= NC.c{1} + i0{1} + /\ SLCommon.C.c{1} <= count + i0{1} <= C.c{1} + i0{1} /\ (forall j, 0 <= j < i0{1} => exists b c, Redo.prefixes{1}.[take j p{1}] = Some (b,c) /\ Perm.m{1}.[(b +^ nth witness p{1} j, c)] = Redo.prefixes{1}.[take (j+1) p{1}])); progress. + by rewrite/#. + by rewrite getP/=. - + by rewrite/format/=nseq0 cats0//-take_size in_dom H5. - + rewrite set_set/=. - cut inv0:=H6;cut[]h_c1c2[]Hmp0 Hmp1 Hmp2 Hmp3 Hmp4 Hinvm:=inv0;split=>//=. - - rewrite/#. + + by rewrite/format/=nseq0 cats0//-take_size in_dom H6. + + cut inv0:=H7;cut[]h_c1c2[]Hmp0 Hmp1 Hmp2 Hmp3 Hmp4 Hinvm:=inv0;split=>//=. + - case:inv0;smt(size_ge0). split=>//=. - smt(in_dom). - - move=>l H_dom_R i []Hi0 Hisize;cut:=H7 l H_dom_R. + - move=>l H_dom_R i []Hi0 Hisize;cut:=H8 l H_dom_R. case(l \in dom Redo.prefixes{2})=>H_in_pref//=. * cut:=Hmp1 l H_in_pref i _;rewrite//=. - rewrite ?H8//=;1:smt(in_dom). + rewrite ?H9//=;1:smt(in_dom). case(i+1 < size l)=>h;1:smt(in_dom). by rewrite take_oversize 1:/#. move=>[]j[][]hj0 hjsize ->>. @@ -495,20 +371,20 @@ section. by rewrite!take_take!min_lel 1,2:/# nth_take 1,2:/#;smt(in_dom). - by move=>l n;rewrite!dom_set in_fsetU1=>[][];smt(getP oget_some in_dom take_oversize). - move=>l n;rewrite dom_set in_fsetU1 getP;case((l, n) = (bl{2}, 1))=>//=[[->>->>]|]. - * by rewrite oget_some/=/format/=nseq0 cats0-take_size H5/#. + * by rewrite oget_some/=/format/=nseq0 cats0-take_size H6/#. move=>h H_dom;cut[]c:=Hmp3 _ _ H_dom;smt(in_dom). - move=>l H_dom_R H_not_nil;rewrite dom_set. - cut:=H7 l H_dom_R;case;1:smt(in_fsetU1). + cut:=H8 l H_dom_R;case;1:smt(in_fsetU1). move=>[]j[][]hj0 hjsize ->>;exists(drop j bl{2}). by rewrite cat_take_drop parse_valid//=in_fsetU1. - while( ={i0,p0,i,p,n,nb,bl,sa,sc,lres,glob NC,glob Redo,glob Perm} + while( ={i0,p0,i,p,n,nb,bl,sa,sc,lres,NC.queries,C.c,glob Redo,glob Perm} /\ n{1} = nb{1} /\ p{1} = bl{1} /\ p0{1} = p{1} /\ 0 <= i0{1} <= size p{1} /\ Redo.prefixes{1}.[take i0{1} p{1}] = Some (sa{1},sc{1}) - /\ INV_Real count NC.c{1} Perm.m{1} Perm.mi{1} pref NC.queries{1} + /\ INV_Real count C.c{1} Perm.m{1} Perm.mi{1} pref NC.queries{1} /\ (forall l, l \in dom Redo.prefixes{1} => l \in dom pref \/ (exists j, 0 < j <= i0{2} /\ l = take j p{1})) /\ (forall l, l \in dom pref => pref.[l] = Redo.prefixes{1}.[l]) - /\ C.c{1} <= count + i0{1} <= NC.c{1} + i0{1} + /\ SLCommon.C.c{1} <= count + i0{1} <= C.c{1} + i0{1} /\ (i0{1} < size p0{1} => take (i0{1}+1) p{1} \in dom Redo.prefixes{1} => Redo.prefixes{1} = pref) @@ -600,11 +476,10 @@ section. + rewrite/#. + by rewrite get_oget//=. + rewrite in_dom;cut[]_[]_ _ _ help _ _:=H4. - by cut//=:=help bl{2} (size lres{2}+1);rewrite dom_set in_fsetU1 H7/==>[][]c->. + by cut//=:=help bl{2} (size lres{2}+1);rewrite H7/==>[][]c->. + cut[]_[]_ _ help _ _ _:=H4. - cut:=help bl{2} (size lres{2}+1);rewrite dom_set in_fsetU1//=H7/=H3/=!getP/=. - by cut->/=[]_[]->//:!size lres{2} + 1 = size lres{2} by smt(). - + by rewrite set_eq//=1:get_oget//=;split;cut:=H4;rewrite set_eq 1:H1//==>[][]//=/#. + by cut:=help bl{2} (size lres{2}+1);rewrite H7/=H3/==>[][]_[]->//=. + + by split;cut[]//=/#:=H4. sp. splitwhile{1} 1 : i0 < size p0 - 1;splitwhile{2} 1 : i0 < size p0 - 1. rcondt{1}2;2:rcondt{2}2;1,2:by auto; @@ -614,21 +489,20 @@ section. while(i0 < size p0);auto;1:if;2:(sp;if);auto;smt(size_cat size_nseq size_ge0)); if;sp;2:if;auto;smt(size_cat size_nseq size_ge0). wp;conseq(:_==> ={sa,sc,glob Redo,glob Perm} - /\ INV_Real C.c{1} (NC.c{1} + size bl{2} + i{1} - 1) Perm.m{1} Perm.mi{1} + /\ INV_Real SLCommon.C.c{1} (C.c{1} + size bl{2} + i{1} - 1) Perm.m{1} Perm.mi{1} Redo.prefixes{1} NC.queries{1}.[(p{1}, i{1}) <- rcons lres{1} sa{1}] /\ (format p{1} i{1} \in dom Redo.prefixes{1}));progress. + smt(size_ge0). + smt(size_ge0). + by rewrite getP/=. + exact size_rcons. - + by rewrite set_set//=. - seq 1 1 : (={nb,bl,n,p,p0,i,i0,lres,sa,sc,glob NC,glob Redo,glob Perm} + seq 1 1 : (={nb,bl,n,p,p0,i,i0,lres,sa,sc,NC.queries,C.c,glob Redo,glob Perm} /\ n{1} = nb{1} /\ p{1} = bl{1} /\ p0{1} = format p{1} i{1} /\ 1 < i{1} <= n{1} /\ valid p{1} /\ i0{1} = size p0{1} - 1 /\ Some lres{1} = NC.queries{1}.[(bl{1}, i{1}-1)] /\ ! ((p{1}, i{1}) \in dom NC.queries{1}) /\ Redo.prefixes{1}.[format p{1} (i{1}-1)] = Some (sa{1},sc{1}) - /\ INV_Real C.c{1} (NC.c{1} + size bl{2} + i{1} - 2) Perm.m{1} Perm.mi{1} + /\ INV_Real SLCommon.C.c{1} (C.c{1} + size bl{2} + i{1} - 2) Perm.m{1} Perm.mi{1} Redo.prefixes{1} NC.queries{1}.[(bl{1}, i{1} - 1) <- lres{1}]);last first. + if;auto;progress. - move:H6;rewrite -addzA/=take_size=>H_dom. @@ -649,7 +523,7 @@ section. sp;if;auto;progress. - move:H6 H7;rewrite!getP/=!oget_some nth_last -(addzA _ _ 1)/=take_size. rewrite last_cat last_nseq 1:/# Block.WRing.addr0;progress. - cut//=:=lemma2(C.c{1} + 1)(NC.c{2} + size bl{2} + i{2} - 1) + cut//=:=lemma2(SLCommon.C.c{1} + 1)(C.c{2} + size bl{2} + i{2} - 1) Perm.m{2}.[(sa_R, sc{2}) <- y0L] Perm.mi{2}.[y0L <- (sa_R, sc{2})] Redo.prefixes{2} NC.queries{2} bl{2} i{2} sa_R sc{2} lres{2}. rewrite H/=H1/=H2/=H4/=H6/=H3/=dom_set in_fsetU1/=getP/=oget_some. @@ -663,24 +537,24 @@ section. apply lemma2=>//=;first cut:=H5;rewrite set_eq 1:H2//==>hinv0;split;case:hinv0=>//=/#. rewrite H2//=. - by rewrite dom_set in_fsetU1//=-(addzA _ _ 1)/=take_size. - alias{1} 1 pref = Redo.prefixes;sp;alias{1} 1 count = C.c. + alias{1} 1 pref = Redo.prefixes;sp;alias{1} 1 count = SLCommon.C.c. alias{1} 1 pm = Perm.m;sp;alias{1} 1 pmi = Perm.mi;sp. - conseq(:_==> ={nb,bl,n,p,p0,i,i0,lres,sa,sc,glob NC,glob Redo,glob Perm} + conseq(:_==> ={nb,bl,n,p,p0,i,i0,lres,sa,sc,NC.queries,C.c,glob Redo,glob Perm} /\ pmi{1} = Perm.mi{1} /\ pm{1} = Perm.m{1} - /\ pref{1} = Redo.prefixes{1} /\ C.c{1} = count{1} + /\ pref{1} = Redo.prefixes{1} /\ SLCommon.C.c{1} = count{1} /\ n{1} = nb{1} /\ p{1} = bl{1} /\ p0{1} = format p{1} i{1} /\ i0{1} = size p0{1} - 1 - /\ Redo.prefixes{1}.[format p{1} (i0{1} - size p{1} + 1)] = Some (sa{1}, sc{1})); - 1:smt(size_cat size_nseq). + /\ Redo.prefixes{1}.[format p{1} (i0{1} - size p{1} + 1)] = + Some (sa{1}, sc{1}));1:smt(size_cat size_nseq set_eq in_dom). splitwhile{1}1:i0 < size p;splitwhile{2}1:i0 < size p. - while(={nb,bl,n,p,p0,i,i0,lres,sa,sc,glob NC,glob Redo,glob Perm} + while(={nb,bl,n,p,p0,i,i0,lres,sa,sc,NC.queries, C.c,glob Redo,glob Perm} /\ pmi{1} = Perm.mi{1} /\ pm{1} = Perm.m{1} /\ 0 < i{1} - /\ pref{1} = Redo.prefixes{1} /\ C.c{1} = count{1} + /\ pref{1} = Redo.prefixes{1} /\ SLCommon.C.c{1} = count{1} /\ n{1} = nb{1} /\ p{1} = bl{1} /\ p0{1} = format p{1} i{1} /\ size p{1} <= i0{1} <= size p0{1} - 1 /\ valid p{1} /\ (format p{1} (i{1}-1) \in dom Redo.prefixes{1}) - /\ INV_Real C.c{1} (NC.c{1} + size bl{2} + i{1} - 2) Perm.m{1} Perm.mi{1} - Redo.prefixes{1} NC.queries{1} + /\ INV_Real SLCommon.C.c{1} (C.c{1} + size bl{2} + i{1} - 2) + Perm.m{1} Perm.mi{1} Redo.prefixes{1} NC.queries{1} /\ Redo.prefixes{1}.[format p{1} (i0{1} - size p{1} + 1)] = Some (sa{1}, sc{1}) ). + rcondt{1}1;2:rcondt{2}1;auto;progress. - rewrite take_format;1,2:smt(size_cat size_ge0 size_nseq). @@ -701,26 +575,26 @@ section. cut:=take_format bl{2} (i{2}-1) (i0{2} + 1) _ _;1,2:smt(size_cat size_ge0 size_nseq). cut->/=:!i0{2} + 1 <= size bl{2} by smt(). by cut/#:=all_prefixes_of_INV_real. - conseq(:_==> ={nb,bl,n,p,p0,i,i0,lres,sa,sc,glob NC,glob Redo,glob Perm} + conseq(:_==> ={nb,bl,n,p,p0,i,i0,lres,sa,sc,NC.queries, C.c,glob Redo,glob Perm} /\ pmi{1} = Perm.mi{1} /\ pm{1} = Perm.m{1} /\ 0 < i{1} - /\ pref{1} = Redo.prefixes{1} /\ C.c{1} = count{1} + /\ pref{1} = Redo.prefixes{1} /\ SLCommon.C.c{1} = count{1} /\ n{1} = nb{1} /\ p{1} = bl{1} /\ p0{1} = format p{1} i{1} /\ size p{1} = i0{1} /\ valid p{1} /\ (format p{1} (i{1}-1) \in dom Redo.prefixes{1}) - /\ INV_Real C.c{1} (NC.c{1} + size bl{2} + i{1} - 2) Perm.m{1} Perm.mi{1} + /\ INV_Real SLCommon.C.c{1} (C.c{1} + size bl{2} + i{1} - 2) Perm.m{1} Perm.mi{1} Redo.prefixes{1} NC.queries{1} /\ Redo.prefixes{1}.[take i0{1} p{1}] = Some (sa{1}, sc{1})); progress. + smt(size_cat size_ge0 size_nseq). + by rewrite /format/=nseq0 cats0 -take_size;exact H12. + smt(). - while( ={nb,bl,n,p,p0,i,i0,lres,sa,sc,glob NC,glob Redo,glob Perm} + while( ={nb,bl,n,p,p0,i,i0,lres,sa,sc,NC.queries, C.c,glob Redo,glob Perm} /\ pmi{1} = Perm.mi{1} /\ pm{1} = Perm.m{1} /\ 1 < i{1} - /\ pref{1} = Redo.prefixes{1} /\ C.c{1} = count{1} + /\ pref{1} = Redo.prefixes{1} /\ SLCommon.C.c{1} = count{1} /\ n{1} = nb{1} /\ p{1} = bl{1} /\ p0{1} = format p{1} i{1} /\ 0 <= i0{1} <= size p{1} /\ valid p{1} /\ (format p{1} (i{1}-1) \in dom Redo.prefixes{1}) - /\ INV_Real C.c{1} (NC.c{1} + size bl{2} + i{1} - 2) Perm.m{1} Perm.mi{1} + /\ INV_Real SLCommon.C.c{1} (C.c{1} + size bl{2} + i{1} - 2) Perm.m{1} Perm.mi{1} Redo.prefixes{1} NC.queries{1} /\ Redo.prefixes{1}.[take i0{1} p{1}] = Some (sa{1}, sc{1}) );last first. + auto;progress. @@ -847,53 +721,115 @@ section. qed. - local lemma squeeze_squeezeless (D <: NDISTINGUISHER {P, NC, Redo, C}) : + + local lemma lemma4' c c' m mi p q bl i sa sc lres: + INV_Real c c' m mi p q => + 0 < i => + q.[(bl,i)] = Some lres => + p.[format bl i] = Some (sa,sc) => + format bl (i+1) \in dom p => + p.[format bl (i+1)] = m.[(sa,sc)]. + proof. + move=>inv0 H_i0 H_q_i H_p_i H_p_dom_iS. + cut[]_[]_ hmp1 hmp2 hmp3 hmp4 _:=inv0. + cut[]:=hmp4 _ H_p_dom_iS _. + + smt(size_ge0 size_eq0 size_cat valid_spec size_nseq). + move=>l;pose pn := parse (format bl (i + 1) ++ l). + cut->/=H_dom_iS:pn = (pn.`1,pn.`2) by smt(). + cut[]c2:=hmp3 _ _ H_dom_iS. + cut->/=:format pn.`1 pn.`2 = (format bl (i + 1) ++ l) by smt(parseK formatK). + move:H_dom_iS;cut->/={pn}H_dom_iS H_p_iS_l:(pn.`1, pn.`2) = parse (format bl (i + 1) ++ l) by smt(). + cut help:=hmp1 (format bl (i + 1) ++ l) _;1:by rewrite in_dom H_p_iS_l. + cut[]b3 c3:=help (size (format bl i)) _. + + smt(size_ge0 size_cat size_nseq). + rewrite take_cat take_format//=1:/#. + + smt(size_ge0 size_cat size_nseq). + cut->/=:size (format bl i) < size (format bl (i + 1)) by smt(size_cat size_nseq). + pose x:=if _ then _ else _;cut->/={x}:x = format bl i. + + rewrite/x;rewrite size_cat size_nseq max_ler 1:/#. + case(size bl + (i - 1) <= size bl)=>//=[h|/#]. + by cut->>/=:i=1;smt(take_size nseq0 cats0). + rewrite H_p_i/==>[][][]->>->>. + rewrite nth_cat/=. + cut->/=:size (format bl i) < size (format bl (i + 1)) by smt(size_cat size_nseq). + rewrite nth_cat. + cut->/=:!size (format bl i) < size bl by smt(size_cat size_nseq size_ge0). + rewrite nth_nseq 1:size_cat 1:size_nseq 1:/#. + rewrite take_cat. + cut->/=:size (format bl i) + 1 = size (format bl (i + 1)) by smt(size_cat size_nseq). + rewrite take0 cats0 Block.WRing.addr0 =>->//=. + qed. + + + module QBlockSponge (P : DPRIMITIVE) : FUNCTIONALITY = { + proc init() = {} + proc f (p : block list, n : int) : block list = { + var r : block list <- []; + var i : int <- 0; + var (b,c) <- (b0,c0); + if (valid p /\ 0 < n) { + while (i < size p) { + (b,c) <@ P.f(b +^ nth witness p i, c); + i <- i + 1; + } + i <- 1; + r <- rcons r b; + while (i < n) { + (b,c) <@ P.f(b, c); + r <- rcons r b; + i <- i + 1; + } + } + return r; + } + }. + + local lemma squeeze_squeezeless (D <: DISTINGUISHER {P, NC, Redo, C, SLCommon.C}) : equiv [ NIndif(Squeeze(SqueezelessSponge(P)),P,DC(D)).main - ~ NIndif(BlockSponge(P),P,DC(D)).main - : ={glob D} ==> ={res, glob P, glob D, NC.c}]. + ~ RealIndif(QBlockSponge,P,DRestr(D)).main + : ={glob D} ==> ={res, glob P, glob D, C.c}]. proof. proc;inline*;sp;wp. - call(: ={glob Perm,glob NC} - /\ INV_Real 0 NC.c{1} Perm.m{1} Perm.mi{1} Redo.prefixes{1} + call(: ={glob Perm,C.c} + /\ INV_Real 0 C.c{1} Perm.m{1} Perm.mi{1} Redo.prefixes{1} NC.queries{1});auto;last first. + progress. split=>//=;1:split=>//=;smt(getP dom0 map0P in_fset0 dom_set in_fsetU1). - + proc;inline*;auto;sp;if;auto;progress. + + proc;inline*;auto;sp;if;auto;sp;if;auto;progress. - by rewrite INV_Real_addm_mi;2..:smt(supp_dexcepted);split;case:H=>//=;smt(). - by split;case:H=>//=;smt(). - + proc;inline*;auto;sp;if;auto;progress. + + proc;inline*;auto;sp;if;auto;sp;if;auto;progress. - rewrite INV_Real_addm_mi;1: by split;case:H=>//=;smt(). * case:H;smt(invm_dom_rng invmC supp_dexcepted). case:H;smt(invm_dom_rng invmC supp_dexcepted). - by split;case:H=>//=;smt(). - proc;inline*;sp;auto;if;auto;if;auto;sp. + proc;inline*;sp;auto;if;auto;if;auto;sp;if;auto; + last by progress;split;case:H=>//=;smt(size_ge0). rcondt{1}1;auto;sp. - seq 1 4 : (={glob Perm, glob NC, i, p, n, bl, nb} /\ nb{1} = n{1} - /\ (lres,sa,sc){1} = (r0,b,c){2} /\ bl{1} = p{2} + seq 1 3 : (={glob Perm, C.c, i, p, n, bl, nb} /\ nb{1} = n{1} + /\ (lres){1} = (r0){2} /\ bl{1} = p{2} /\ NC.queries{1}.[(p{1},i{1})] = Some lres{1} /\ valid p{1} /\ i{1} <= n{1} /\ i{1} = 1 - /\ ! ((p,n) \in dom NC.queries){1} - /\ INV_Real 0 NC.c{1} Perm.m{1} Perm.mi{1} Redo.prefixes{1} + /\ INV_Real 0 C.c{1} Perm.m{1} Perm.mi{1} Redo.prefixes{1} NC.queries{1}.[(p{1}, i{1}) <- lres{1}] - /\ Redo.prefixes{1}.[p{1}] = Some (sa{1},sc{1}));last first. + /\ Redo.prefixes{1}.[p{1}] = Some (b,c){2});last first. + auto=>/=. - while(={glob Perm, glob NC, i, p, n, bl, nb} /\ nb{1} = n{1} + while(={glob Perm, C.c, i, p, n, bl, nb} /\ nb{1} = n{1} /\ (lres){1} = (r0){2} /\ bl{1} = p{2} /\ 0 < i{2} <= n{1} /\ valid p{1} /\ NC.queries{1}.[(p{1},i{1})] = Some lres{1} - /\ ! ((p,n) \in dom NC.queries){1} - /\ INV_Real 0 NC.c{1} Perm.m{1} Perm.mi{1} Redo.prefixes{1} - NC.queries{1}.[(p{1}, i{1}) <- lres{1}] + /\ INV_Real 0 C.c{1} Perm.m{1} Perm.mi{1} Redo.prefixes{1} + NC.queries{1} /\ Redo.prefixes{1}.[format p{1} i{1}] = Some (b{2},c{2}));last first. - auto;progress. - * by rewrite/format/=nseq0 cats0 H4//=. - * smt(). + * cut:=H2;rewrite set_eq//=. + * by rewrite/format/=nseq0 cats0 H3//=. sp;if{1};last first. - rcondf{2}1;auto;progress. - * cut:=H4;rewrite set_eq//=in_dom=>inv0. + * cut:=H3;rewrite in_dom=>inv0. cut[]_[]_ hmp1 hmp2 hmp3 _ _:=inv0. cut:=hmp1 (format p{hr} (i{hr}+1));rewrite in_dom//=. - cut[]c3 h3:=hmp3 _ _ H8;rewrite h3/= => help. + cut[]c3 h3:=hmp3 _ _ H7;rewrite h3/= => help. cut[]b4 c4:=help (size p{hr} + i{hr} - 1) _;1:smt(size_cat size_nseq size_ge0). rewrite !take_format 1,3:/#;1,2:smt(size_cat size_nseq size_ge0). rewrite nth_cat/=nth_nseq/=1:/# -(addzA _ (-1) 1)/=. @@ -902,21 +838,19 @@ section. pose x:=if _ then _ else _;cut->/={x}:x = format p{hr} i{hr}. + rewrite/x;case(i{hr}=1)=>[->>|/#]//=. by rewrite -(addzA _ 1 (-1))/= take_size/format/=nseq0 cats0. - by rewrite Block.WRing.addr0 (addzAC _ i{hr})/=H5/==>[][][]->>->>->;rewrite h3. - * rewrite set_eq//=. - cut:=H4;rewrite set_eq//==>inv0. - by cut->:=lemma3 _ _ _ _ _ _ _ _ _ _ _ inv0 H H2 H5 H8. - * cut:=H4;rewrite set_eq//==>inv0. - by cut->:=lemma3 _ _ _ _ _ _ _ _ _ _ _ inv0 H H2 H5 H8. + by rewrite Block.WRing.addr0 (addzAC _ i{hr})/=H4/==>[][][]->>->>->;rewrite h3. + * cut:=H3;move=>inv0. + by cut->:=lemma3 _ _ _ _ _ _ _ _ _ _ _ inv0 H H2 H4 H7. + (* * cut:=H3;rewrite //==>inv0. *) + (* by cut->:=lemma3 _ _ _ _ _ _ _ _ _ _ _ inv0 H H2 H4 H7. *) * smt(). * smt(). * smt(get_oget in_dom). - * smt(set_eq get_oget in_dom). - * cut:=H4;rewrite set_eq//==>inv0. - cut->:=lemma4 _ _ _ _ _ _ _ _ _ _ _ inv0 H H2 H5 H8;rewrite get_oget 2:/#. + * cut:=H3;rewrite //==>inv0. + cut->:=lemma4 _ _ _ _ _ _ _ _ _ _ _ inv0 H H2 H4 H7;rewrite get_oget 2:/#. cut[]_[]_ hmp1 hmp2 hmp3 _ _:=inv0. cut:=hmp1 (format p{2} (i{2}+1));rewrite in_dom//=. - cut[]c3 h3:=hmp3 _ _ H8;rewrite h3/= => help. + cut[]c3 h3:=hmp3 _ _ H7;rewrite h3/= => help. cut[]b4 c4:=help (size p{2} + i{2} - 1) _;1:smt(size_cat size_nseq size_ge0). rewrite !take_format 1,3:/#;1,2:smt(size_cat size_nseq size_ge0). rewrite nth_cat/=nth_nseq/=1:/# -(addzA _ (-1) 1)/=. @@ -925,7 +859,7 @@ section. pose x:=if _ then _ else _;cut->/={x}:x = format p{2} i{2}. + rewrite/x;case(i{2}=1)=>[->>|/#]//=. by rewrite -(addzA _ 1 (-1))/= take_size/format/=nseq0 cats0. - by rewrite in_dom Block.WRing.addr0 (addzAC _ i{2})/=H5/==>[][][]->>->>->;rewrite h3. + by rewrite in_dom Block.WRing.addr0 (addzAC _ i{2})/=H4/==>[][][]->>->>->;rewrite h3. swap{2}4-3;wp;sp=>/=. splitwhile{1}1:i0 < size p0 - 1. rcondt{1}2;2:rcondf{1}4;auto. @@ -937,10 +871,240 @@ section. if;auto;1:smt(size_cat size_nseq size_ge0). by sp;if;auto;smt(size_cat size_nseq size_ge0). by if;auto;1:smt();sp;if;auto;smt(). - seq 1 1 : - - - qed. + seq 1 0 : (={glob P, C.c, i, p, n, bl, nb} + /\ nb{1} = n{1} /\ lres{1} = r0{2} /\ bl{1} = p{1} + /\ x0{2} = (sa,sc){1} /\ p0{1} = format p{1} i{1} + /\ i0{1} = size p{1} + i{1} - 2 /\ 1 < i{1} <= n{1} + /\ valid p{1} /\ 0 < n{1} + /\ ! ((p{1}, i{1}) \in dom NC.queries{1}) + /\ NC.queries{1}.[(p{1},i{1}-1)] = Some lres{1} + /\ Redo.prefixes{1}.[format p{1} (i{1}-1)] = Some (sa,sc){1} + /\ INV_Real 0 C.c{1} Perm.m{1} Perm.mi{1} Redo.prefixes{1} + NC.queries{1});last first. + + if{1}. + - wp;rcondf{2}1. + * auto;progress. + cut[]_[]_ hmp1 hmp2 hmp3 hmp4 _:=H6. + cut:=hmp4 _ H7 _. + + rewrite-size_eq0 size_take;1:smt(size_ge0). + by rewrite size_cat size_nseq;smt(valid_spec size_eq0 size_ge0). + move=>[]l;rewrite take_oversize;1:rewrite size_cat size_nseq/#. + move=>H_dom. + pose x:= (parse (format p{hr} i{hr} ++ l)).`1. + pose y:= (parse (format p{hr} i{hr} ++ l)).`2. + cut[]:=hmp3 x y _;1:smt();cut->/=:format x y = (format p{hr} i{hr} ++ l) by smt(formatK). + cut->/={x y}c H_dom_c:(x, y) = (parse (format p{hr} i{hr} ++ l)) by smt(). + cut help:=hmp1 (format p{hr} i{hr} ++ l) _;1:by rewrite in_dom H_dom_c. + cut:=help (size (format p{hr} i{hr})-1) _;1:split. + - smt(size_cat size_nseq size_ge0 size_eq0 valid_spec). + - move=>_;rewrite !size_cat. + cut:size l <> 0;2:smt(size_ge0). + by rewrite size_eq0;smt(in_dom cats0 formatK parseK). + move=>[]b2 c2;rewrite take_cat nth_cat/=. + cut->/=:size (format p{hr} i{hr}) - 1 < size (format p{hr} i{hr}) by smt(). + rewrite nth_cat nth_nseq. + - smt(size_cat size_nseq size_ge0 size_eq0 valid_spec). + cut->/=:!size (format p{hr} i{hr}) - 1 < size p{hr} + by smt(size_cat size_nseq size_ge0 size_eq0 valid_spec). + rewrite take_format 1:/#. + - smt(size_cat size_nseq size_ge0 size_eq0 valid_spec). + pose x:=if _ then _ else _;cut->/={x}:x = format p{hr} (i{hr}-1). + - rewrite /x;rewrite size_cat size_nseq/=/max/=. + cut->/=:0 < i{hr} - 1 by smt(). + case(size p{hr} + (i{hr} - 1) - 1 <= size p{hr})=>//=[h|/#]. + cut->>/=:i{hr}=2 by smt(). + smt(take_size nseq0 cats0). + rewrite H5=>//=[][][]->>->>;rewrite Block.WRing.addr0 take_cat. + rewrite-(addzA _ _ 1)//=take0 cats0=>h. + cut:=help (size (format p{hr} i{hr})) _. + - cut:size l <> 0;2:smt(size_ge0 size_cat). + by rewrite size_eq0;smt(in_dom cats0 formatK parseK). + by move=>[]b5 c5;rewrite take_cat take_size/=take0 cats0 in_dom h=>[][]->//=. + auto;progress. + * move:H7;rewrite take_oversize;1:rewrite size_cat size_nseq/#. + move=>H_dom. + cut:=lemma4' _ _ _ _ _ _ _ _ _ _ _ H6 _ H4 H5 _;1,2:smt(). + by rewrite-(addzA _ _ 1)/==>->//=. + (* * move:H7;rewrite take_oversize;1:rewrite size_cat size_nseq/#. *) + (* move=>H_dom. *) + (* cut:=lemma4' _ _ _ _ _ _ _ _ _ _ _ H6 _ H4 H5 _;1,2:smt(). *) + (* by rewrite-(addzA _ _ 1)/==>->//=. *) + * smt(). + * move:H7;rewrite take_oversize;1:rewrite size_cat size_nseq/#. + move=>H_dom. + cut:=lemma4' _ _ _ _ _ _ _ _ _ _ _ H6 _ H4 H5 _;1,2:smt(). + by rewrite-(addzA _ _ 1)/==>->//=;rewrite getP/=. + * move:H7;rewrite take_oversize;1:rewrite size_cat size_nseq/#. + cut H_i_size:i{2}-1 = size r0{2}. + + cut[]_[]_ hmp1 hmp2 hmp3 hmp4 _:=H6. + cut:=hmp2 p{2} (i{2}-1);rewrite in_dom H4/==>[][]_[]_[]. + by rewrite oget_some=>->/=/#. + move=>H_l;apply(lemma1 _ _ _ _ _ _ _ _ _ H6 H3 H1 _ _ _ _);1:smt(). + + by rewrite size_rcons-H_i_size;ring. + + by rewrite get_oget//last_rcons oget_some/#. + move=>j[]hj0 hji;rewrite -cats1 take_cat-H_i_size. + pose x:=if _ then _ else _;cut->/={x}:x = take j r0{2}. + - rewrite /x;case(j//=h;cut->>/=:j=i{2}-1 by smt(). + by rewrite H_i_size cats0 take_size. + cut[]_[]_ hmp1 hmp2 hmp3 hmp4 _:=H6. + by cut:=hmp2 p{2} (i{2}-1);rewrite in_dom H4//=oget_some/#. + move:H7;rewrite take_oversize;1:rewrite size_cat size_nseq/#. + move=>H_dom. + cut:=lemma4' _ _ _ _ _ _ _ _ _ _ _ H6 _ H4 H5 _;1,2:smt(). + by rewrite-(addzA _ _ 1)/==><-//=;smt(get_oget in_dom). + sp;wp;if;auto;progress. + - move:H8;rewrite nth_cat;cut->/=:!size p{2} + i{2} - 2 < size p{2} by smt(). + rewrite nth_nseq;1:smt(size_ge0 valid_spec size_eq0 size_cat size_nseq). + by rewrite Block.WRing.addr0. + - rewrite nth_cat;cut->/=:!size p{2} + i{2} - 2 < size p{2} by smt(). + rewrite nth_nseq;1:smt(size_ge0 valid_spec size_eq0 size_cat size_nseq). + by rewrite Block.WRing.addr0. + - rewrite nth_cat;cut->/=:!size p{2} + i{2} - 2 < size p{2} by smt(). + rewrite nth_nseq;1:smt(size_ge0 valid_spec size_eq0 size_cat size_nseq). + by rewrite Block.WRing.addr0. + - rewrite nth_cat;cut->/=:!size p{2} + i{2} - 2 < size p{2} by smt(). + rewrite nth_nseq;1:smt(size_ge0 valid_spec size_eq0 size_cat size_nseq). + by rewrite Block.WRing.addr0. + - rewrite nth_cat;cut->/=:!size p{2} + i{2} - 2 < size p{2} by smt(). + rewrite nth_nseq;1:smt(size_ge0 valid_spec size_eq0 size_cat size_nseq). + by rewrite Block.WRing.addr0. + (* - rewrite nth_cat;cut->/=:!size p{2} + i{2} - 2 < size p{2} by smt(). *) + (* rewrite nth_nseq;1:smt(size_ge0 valid_spec size_eq0 size_cat size_nseq). *) + (* by rewrite Block.WRing.addr0. *) + - smt(). + - rewrite nth_cat;cut->/=:!size p{2} + i{2} - 2 < size p{2} by smt(). + rewrite nth_nseq;1:smt(size_ge0 valid_spec size_eq0 size_cat size_nseq). + by rewrite Block.WRing.addr0 getP/=. + - move:H7 H8;rewrite take_oversize;1:rewrite size_cat size_nseq/#. + rewrite nth_cat;cut->/=:!size p{2} + i{2} - 2 < size p{2} by smt(). + rewrite nth_nseq;1:smt(size_ge0 valid_spec size_eq0 size_cat size_nseq). + rewrite Block.WRing.addr0/==>H_dom h;rewrite getP/=oget_some. + cut//=:=lemma2 0 C.c{2}Perm.m{2}.[(sa_L, sc{1}) <- yL] + Perm.mi{2}.[yL <- (sa_L, sc{1})]Redo.prefixes{1} + NC.queries{1}p{2}i{2}sa_L sc{1} r0{2} _ _ _ _ _ _ _ _;rewrite//=. + * by apply INV_Real_addm_mi=>//=;1:smt(supp_dexcepted). + * by rewrite dom_set in_fsetU1. + by rewrite!getP/=oget_some/#. + - move:H8;rewrite nth_cat;cut->/=:!size p{2} + i{2} - 2 < size p{2} by smt(). + rewrite nth_nseq;1:smt(size_ge0 valid_spec size_eq0 size_cat size_nseq). + by rewrite Block.WRing.addr0 !getP/=oget_some/=take_oversize//=size_cat size_nseq/#. + - move:H8;rewrite nth_cat;cut->/=:!size p{2} + i{2} - 2 < size p{2} by smt(). + rewrite nth_nseq;1:smt(size_ge0 valid_spec size_eq0 size_cat size_nseq). + by rewrite Block.WRing.addr0. + (* - move:H8;rewrite nth_cat;cut->/=:!size p{2} + i{2} - 2 < size p{2} by smt(). *) + (* rewrite nth_nseq;1:smt(size_ge0 valid_spec size_eq0 size_cat size_nseq). *) + (* by rewrite Block.WRing.addr0. *) + - smt(). + - move:H8;rewrite nth_cat;cut->/=:!size p{2} + i{2} - 2 < size p{2} by smt(). + rewrite nth_nseq;1:smt(size_ge0 valid_spec size_eq0 size_cat size_nseq). + by rewrite Block.WRing.addr0 getP/=. + - move:H7 H8;rewrite take_oversize;1:rewrite size_cat size_nseq/#. + rewrite nth_cat;cut->/=:!size p{2} + i{2} - 2 < size p{2} by smt(). + rewrite nth_nseq;1:smt(size_ge0 valid_spec size_eq0 size_cat size_nseq). + rewrite Block.WRing.addr0/==>H_dom h. + by cut//=:=lemma2 0 C.c{2}Perm.m{2}Perm.mi{2}Redo.prefixes{1} + NC.queries{1}p{2}i{2}sa_L sc{1} r0{2} _ _ _ _ _ _ _ _;rewrite//=/#. + move:H8;rewrite nth_cat;cut->/=:!size p{2} + i{2} - 2 < size p{2} by smt(). + rewrite nth_nseq;1:smt(size_ge0 valid_spec size_eq0 size_cat size_nseq). + by rewrite Block.WRing.addr0 getP/=take_oversize//=size_cat size_nseq/#. + alias{1} 1 pref = Redo.prefixes;sp. + conseq(:_==> ={glob P} /\ i0{1} = size p{1} + i{1} - 2 /\ Redo.prefixes{1} = pref{1} + /\ Redo.prefixes{1}.[take i0{1} (format p{1} (i{1} - 1))] = Some (sa{1}, sc{1}));progress. + + by cut:=H8;rewrite take_oversize 2:-(addzA _ 1)/=2:H4//=size_cat size_nseq;smt(). + + by cut:=H8;rewrite take_oversize 2:-(addzA _ 1)/=2:H4//=size_cat size_nseq;smt(). + + smt(). + + smt(). + + smt(). + + smt(dom_set in_fsetU1). + + by cut:=H8;rewrite take_oversize 2:-(addzA _ 1)//=size_cat size_nseq;smt(). + while{1}( ={glob P} /\ 0 <= i0{1} <= size p{1} + i{1} - 2 + /\ 1 < i{1} <= n{1} + /\ Redo.prefixes{1} = pref{1} /\ p0{1} = format p{1} i{1} + /\ format p{1} (i{1}-1) \in dom Redo.prefixes{1} + /\ INV_Real 0 C.c{1} Perm.m{1} Perm.mi{1} Redo.prefixes{1} NC.queries{1} + /\ Redo.prefixes{1}.[take i0{1} (format p{1} (i{1} - 1))] = + Some (sa{1}, sc{1}))(size p0{1} - 1 - i0{1});auto;last first. + + auto;progress. + + smt(size_ge0). + + smt(in_dom). + + smt(). + + smt(in_dom). + + cut[]_[]:=H3;smt(take0 in_dom). + + smt(). + + smt(size_cat size_nseq). + rcondt 1;auto;progress. + + cut->:take (i0{hr} + 1) (format p{hr} i{hr}) = + take (i0{hr} + 1) (format p{hr} (i{hr}-1)); + last by smt(in_dom all_prefixes_of_INV_real). + by rewrite!take_format//= 1,3:/#;1,2:smt(size_cat size_nseq). + + smt(). + + smt(size_cat size_nseq). + + cut->:take (i0{hr} + 1) (format p{hr} i{hr}) = + take (i0{hr} + 1) (format p{hr} (i{hr}-1)); + last by smt(in_dom all_prefixes_of_INV_real). + by rewrite!take_format//= 1,3:/#;1,2:smt(size_cat size_nseq). + smt(). + + if{1};last first. + + wp=>//=. + conseq(:_==> ={glob P} /\ INV_Real 0 C.c{1} Perm.m{1} Perm.mi{1} + Redo.prefixes{1} NC.queries{1} + /\ i{2} = size p{2} + /\ Redo.prefixes{1}.[take i{2} p{2}] = Some (b,c){2} + /\ (0 < i{2} => Perm.m.[x]{2} = Some (b,c){2}));progress. + - cut[]_[]_ hmp1 hmp2 hmp3 hmp4 _:=H5. + cut/=[]_[]H_size H':=hmp2 _ _ H4. + cut/=[]c3:=hmp3 _ _ H4;rewrite/format/=nseq0 cats0-{1}take_size H6/==>[][]H_b ->>//=. + rewrite get_oget//=;apply (eq_from_nth b0)=>//=i. + rewrite H_size=>h;cut->>/=:i = 0 by smt(). + cut->:0 = size (oget NC.queries{1}.[(bl{2}, 1)]) - 1 by rewrite H_size. + by rewrite nth_last H_b. + (* - cut[]_[]_ hmp1 hmp2 hmp3 hmp4 _:=H5. *) + (* cut/=[]_[]H_size H':=hmp2 _ _ H4. *) + (* cut/=[]c3:=hmp3 _ _ H4;rewrite/format/=nseq0 cats0-{1}take_size H6/==>[][]H_b ->>//=. *) + (* rewrite get_oget//=;apply (eq_from_nth b0)=>//=i. *) + (* rewrite H_size=>h;cut->>/=:i = 0 by smt(). *) + (* cut->:0 = size (oget NC.queries{2}.[(bl{2}, 1)]) - 1 by rewrite H_size. *) + (* by rewrite nth_last H_b. *) + - smt(get_oget in_dom). + - smt(). + - smt(set_eq get_oget in_dom). + - smt(take_size). + while{2}(={glob P} /\ INV_Real 0 C.c{1} Perm.m{1} Perm.mi{1} + Redo.prefixes{1} NC.queries{1} + /\ 0 <= i{2} <= size p{2} + /\ ((p{2}, 1) \in dom NC.queries{1}) + /\ Redo.prefixes{1}.[take i{2} p{2}] = Some (b,c){2} + /\ (0 < i{2} => Perm.m.[x]{2} = Some (b,c){2}))(size p{2}-i{2}); + progress;last first. + - auto;progress. + * split;case:H=>//=;smt(size_ge0 size_eq0 valid_spec). + * exact size_ge0. + * by rewrite take0;cut[]_[]->//:=H. + * smt(). + * smt(). + sp;rcondf 1;auto;progress. + - cut[]_[]_ hmp1 hmp2 hmp3 _ _:=H. + cut[]c3:=hmp3 p{hr} 1 H2;rewrite/(format _ 1)/=nseq0 cats0=> H_pref. + cut:=hmp1 p{hr};rewrite 2!in_dom H_pref/==>help. + by cut[]b4 c4 []:=help i{hr} _;1:smt();rewrite H3/==>[][]->>->>->; + smt(in_dom all_prefixes_of_INV_real). + - smt(). + - smt(). + - cut[]_[]_ hmp1 hmp2 hmp3 _ _:=H. + cut[]c3:=hmp3 p{hr} 1 H2;rewrite/(format _ 1)/=nseq0 cats0=> H_pref. + cut:=hmp1 p{hr};rewrite in_dom H_pref/==>help. + by cut[]b4 c4 []:=help i{hr} _;1:smt();rewrite H3/==>[][]->>->>->; + smt(in_dom all_prefixes_of_INV_real get_oget). + - cut[]_[]_ hmp1 hmp2 hmp3 _ _:=H. + cut[]c3:=hmp3 p{hr} 1 H2;rewrite/(format _ 1)/=nseq0 cats0=> H_pref. + cut:=hmp1 p{hr};rewrite in_dom H_pref/==>help. + by cut[]b4 c4 []:=help i{hr} _;1:smt();rewrite H3/==>[][]->>->>->; + smt(in_dom all_prefixes_of_INV_real get_oget). + - smt(). + sp;wp. + (* TODO *) + qed. local lemma equiv_ideal (IF <: FUNCTIONALITY{DSqueeze,C}) @@ -952,12 +1116,12 @@ section. ~ NIndif(Squeeze(IF),S(IF),NDRestr(D)).main : ={glob D} ==> - ={res, glob D, glob IF, glob S, glob NC, C.c} ]. + ={res, glob D, glob IF, glob S, NC.queries, C.c, C.c} ]. proof. move=>S_init IF_init. proc;inline*;sp;wp;swap{2}2-1;swap{1}[3..5]-2;sp. call(: ={glob IF, glob S, C.c, glob DSqueeze} - /\ C.c{1} <= NC.c{1} <= max_size + /\ SLCommon.C.c{1} <= NC.c{1} <= max_size /\ inv_ideal NC.queries{1} C.queries{1});auto;last first. + call IF_init;auto;call S_init;auto;smt(dom_set in_fsetU1 dom0 in_fset0 parse_nil max_ge0). + proc;inline*;sp;if;auto;1:call(: ={glob IF});auto;1:proc(true);progress=>//=. @@ -1003,16 +1167,16 @@ sear while{1}(={n, p, glob IF, glob S, NC.queries} /\ i{1} = nb_iter{2} /\ lres{1} = r{2} /\ inv_ideal NC.queries{1} C.queries{1} - /\ max_size <= C.c{1} + /\ max_size <= SLCommon.C.c{1} conseq(:_ ==> lres{1} = mkseq (+Block.b0) i{1} /\ i{1} = n{1} - /\ ={glob IF, glob S} /\ C.c{1} = max_size + /\ ={glob IF, glob S} /\ SLCommon.C.c{1} = max_size /\ inv_ideal NC.queries{1} C.queries{1} /\ NC.queries{1} = NC.queries{2}.[(p{1}, n{1}) <- lres{1}]); 1:smt(min_ler min_lel max_ler max_ler). while{1}(lres{1} = mkseq (+Block.b0) i{1} /\ i{1} = n{1} - /\ ={glob IF, glob S} /\ C.c{1} = max_size + /\ ={glob IF, glob S} /\ SLCommon.C.c{1} = max_size /\ inv_ideal NC.queries{1} C.queries{1} /\ NC.queries{1} = NC.queries{2}.[(p{1}, n{1}) <- lres{1}]) (n{1}-i{1}); @@ -1082,9 +1246,9 @@ module S(F : DFUNCTIONALITY) = { } }. -lemma Real_Ideal &m (D <: NDISTINGUISHER): - Pr[NIndif(BlockSponge(PC(Perm)), PC(Perm), D).main() @ &m: res /\ C.c <= max_size] <= - Pr[NIndif(IF,S(IF),DRestr(D)).main() @ &m : res] + +lemma Real_Ideal &m (D <: DISTINGUISHER): + Pr[Indif(SqueezelessSponge(PC(Perm)), PC(Perm), D).main() @ &m: res /\ C.c <= max_size] <= + Pr[Indif(IF,S(IF),DRestr(D)).main() @ &m :res] + (max_size ^ 2)%r / 2%r * mu dstate (pred1 witness) + max_size%r * ((2*max_size)%r / (2^c)%r) + max_size%r * ((2*max_size)%r / (2^c)%r). From 83eb7fa290d50f040c46fc08911319ec5ac4e392 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Fri, 20 Apr 2018 11:46:51 +0200 Subject: [PATCH 280/525] Proof of top-level security. --- proof/BlockSponge.ec | 53 ++++++----- proof/Common.ec | 10 ++- proof/SHA3-Security.ec | 195 +++++++++++++++++++++++++++++++++++++++++ 3 files changed, 230 insertions(+), 28 deletions(-) create mode 100644 proof/SHA3-Security.ec diff --git a/proof/BlockSponge.ec b/proof/BlockSponge.ec index ba95d77..c2e3531 100644 --- a/proof/BlockSponge.ec +++ b/proof/BlockSponge.ec @@ -24,7 +24,6 @@ clone import IRO as BIRO with op valid <- valid_block, op dto <- bdistr. - (*------ Validity and Parsing/Formatting of Functionality Queries ------*) op format (p : block list) (n : int) = p ++ nseq (n - 1) b0. @@ -35,7 +34,9 @@ axiom parseK p n: 0 < n => valid_block p => parse (format p n) = (p,n). axiom parse_nil: parse [] = ([],0). lemma parse_injective: injective parse. -proof. by move=> bs1 bs2 eq_format; rewrite -formatK eq_format (@formatK bs2). qed. +proof. +by move=> bs1 bs2 eq_format; rewrite -formatK eq_format (@formatK bs2). +qed. lemma parse_valid p: valid_block p => parse p = (p,1). proof. @@ -43,8 +44,14 @@ move=>h;cut{1}->:p=format p 1;2:smt(parseK). by rewrite/format/=nseq0 cats0. qed. +(*---------------------------- Restrictions ----------------------------*) -(*------------------------------ Counter -------------------------------*) +(** The counter for the functionnality counts the number of times the + underlying primitive is called inside the functionality. This + number is equal to the sum of the number of blocks the input + message contains and the number of additional blocks the squeezing + phase has to output. + *) module C = { var c : int @@ -53,41 +60,33 @@ module C = { } }. -(*---------------------------- Restrictions ----------------------------*) - -(** The counter for the functionnality counts the number of times the - underlying primitive is called inside the functionality. This - number is equal to the sum of the number of blocks the input - message contains and the number of additional blocks the squeezing - phase has to output. - *) module FC (F : DFUNCTIONALITY) = { proc init () : unit = {} + proc f (bl : block list, nb : int) = { - var r : block list <- []; - if (0 < nb) { - if (C.c + size bl + nb - 1 <= max_size) { - C.c <- C.c + size bl + nb - 1; - r <@ F.f(bl,nb); - } + var z : block list <- []; + if (C.c + size bl + (max (nb - 1) 0) <= max_size) { + C.c <- C.c + size bl + (max (nb - 1) 0); + z <@ F.f(bl, nb); } - return r; + return z; } }. - module PC (P : DPRIMITIVE) = { proc init() = {} + proc f (a : state) = { - var z : state <- (b0,c0); + var z : state <- (b0, c0); if (C.c + 1 <= max_size) { z <@ P.f(a); C.c <- C.c + 1; } return z; } + proc fi (a : state) = { - var z : state <- (b0,c0); + var z : state <- (b0, c0); if (C.c + 1 <= max_size) { z <@ P.fi(a); C.c <- C.c + 1; @@ -100,7 +99,7 @@ module DRestr (D : DISTINGUISHER) (F : DFUNCTIONALITY) (P : DPRIMITIVE) = { proc distinguish () : bool = { var b : bool; C.init(); - b <@ D(FC(F),PC(P)).distinguish(); + b <@ D(FC(F), PC(P)).distinguish(); return b; } }. @@ -111,13 +110,13 @@ module DRestr (D : DISTINGUISHER) (F : DFUNCTIONALITY) (P : DPRIMITIVE) = { module Last (F : DFUNCTIONALITY) : SLCommon.DFUNCTIONALITY = { proc init() = {} proc f (p : block list) : block = { - var r : block list <- []; - r <@ F.f(parse p); - return last b0 r; + var z : block list <- []; + z <@ F.f(parse p); + return last b0 z; } }. -module (S : SIMULATOR) (F : DFUNCTIONALITY) = Gconcl.S(Last(F)). +module (Sim : SIMULATOR) (F : DFUNCTIONALITY) = Gconcl.S(Last(F)). (*------------------------- Sponge Construction ------------------------*) @@ -155,7 +154,7 @@ module (Sponge : CONSTRUCTION) (P : DPRIMITIVE) : FUNCTIONALITY = { lemma conclusion : forall (D <: DISTINGUISHER) &m, `| Pr[RealIndif(Sponge, Perm, DRestr(D)).main() @ &m : res] - - Pr[IdealIndif(IRO, S, DRestr(D)).main() @ &m : res]| + - Pr[IdealIndif(IRO, Sim, DRestr(D)).main() @ &m : res]| <= (max_size ^ 2)%r / 2%r * Distr.mu1 dstate witness + max_size%r * ((2 * max_size)%r / (2 ^ c)%r) + max_size%r * ((2 * max_size)%r / (2 ^ c)%r). diff --git a/proof/Common.ec b/proof/Common.ec index fcb9dbf..df98d4f 100644 --- a/proof/Common.ec +++ b/proof/Common.ec @@ -55,7 +55,6 @@ clone export BitWord as Block with "zerow" as "b0". export DBlock. - op cdistr = DCapacity.dunifin. op bdistr = DBlock.dunifin. @@ -483,6 +482,15 @@ proof. apply /(pcan_inj pad2blocks unpad_blocks) /pad2blocksK. qed. +lemma size_pad2blocks s : + size (pad2blocks s) = (size s + 1) %/ r + 1. +proof. +rewrite /pad2blocks /bits2blocks /(\o) size_map size_chunk size_pad. +have -> : (size s + 1) %/ r * r + r = ((size s + 1) %/r + 1) * r + by rewrite mulzDl mul1r. +by rewrite mulzK 1:gtr_eqF 1:gt0_r. +qed. + (*-------------------------- Extending/Stripping -----------------------*) op extend (xs : block list) (n : int) = diff --git a/proof/SHA3-Security.ec b/proof/SHA3-Security.ec new file mode 100644 index 0000000..ed0780c --- /dev/null +++ b/proof/SHA3-Security.ec @@ -0,0 +1,195 @@ +(* Top Level *) + +require import AllCore List IntDiv StdOrder Common Sponge. import BIRO. +require SLCommon BlockSponge. + +(* FIX: would be nicer to define limit at top-level and then clone + BlockSponge with it - so BlockSponge would then clone lower-level + theories with it + +op limit : {int | 0 < limit} as gt0_max_limit. +*) + +op limit : int = SLCommon.max_size. + +(* FIX: don't want this in bound *) + +op dstate : (block * capacity) distr = SLCommon.dstate. + +(*---------------------------- Restrictions ----------------------------*) + +(** The counter for the functionality counts the number of times the + underlying primitive is called inside the functionality. This + number is equal to the sum of the number of blocks in the padding + of the input, plus the number of additional blocks the squeezing + phase has to output. + *) + +module Cntr = { + var c : int + + proc init() = { + c <- 0; + } +}. + +module FC (F : DFUNCTIONALITY) = { + proc init () : unit = {} + + (* ((size bs + 1) %/ r + 1) = size (pad2blocks bs): *) + + proc f (bs : bool list, n : int) : bool list = { + var z : bool list <- []; + if (Cntr.c + + ((size bs + 1) %/ r + 1) + + (max ((n + r - 1) %/ r - 1) 0) <= limit) { + Cntr.c <- + Cntr.c + + ((size bs + 1) %/ r + 1) + + (max ((n + r - 1) %/ r - 1) 0); + z <@ F.f(bs, n); + } + return z; + } +}. + +module PC (P : DPRIMITIVE) = { + proc init() = {} + + proc f (a : block * capacity) = { + var z : block * capacity <- (b0, c0); + if (Cntr.c + 1 <= limit) { + z <@ P.f(a); + Cntr.c <- Cntr.c + 1; + } + return z; + } + proc fi (a : block * capacity) = { + var z : block * capacity <- (b0, c0); + if (Cntr.c + 1 <= limit) { + z <@ P.fi(a); + Cntr.c <- Cntr.c + 1; + } + return z; + } +}. + +module DRestr (D : DISTINGUISHER) (F : DFUNCTIONALITY) (P : DPRIMITIVE) = { + proc distinguish () : bool = { + var b : bool; + Cntr.init(); + b <@ D(FC(F),PC(P)).distinguish(); + return b; + } +}. + +section. + +declare module Dist : + DISTINGUISHER{Perm, BlockSponge.Sim, IRO, Cntr, BlockSponge.BIRO.IRO, + BlockSponge.C}. + +lemma drestr_commute1 &m : + Pr[BlockSponge.RealIndif + (BlockSponge.Sponge, Perm, + LowerDist(DRestr(Dist))).main() @ &m : res] = + Pr[BlockSponge.RealIndif + (BlockSponge.Sponge, Perm, + BlockSponge.DRestr(LowerDist(Dist))).main() @ &m : res]. +proof. +byequiv=> //; proc. +seq 2 2 : (={glob Dist} /\ ={Perm.m, Perm.mi} ); first sim. +inline*; wp; sp. +call (_ : ={c}(Cntr, BlockSponge.C) /\ ={Perm.m, Perm.mi}). +proc; sp; if=> //; sp; sim. +proc; sp; if=> //; sp; sim. +proc=> /=. +inline BlockSponge.FC(BlockSponge.Sponge(Perm)).f. +wp; sp. +if=> //. +progress; smt(size_pad2blocks). +seq 1 1 : + (={n} /\ nb{2} = (n{2} + r - 1) %/ r /\ bl{2} = pad2blocks bs{1} /\ + Cntr.c{1} = BlockSponge.C.c{2} /\ ={Perm.m, Perm.mi}). +auto; progress; by rewrite size_pad2blocks. +inline RaiseFun(BlockSponge.Sponge(Perm)).f. +wp; sp. +call (_ : ={Perm.m, Perm.mi}); first sim. +auto. +auto; progress; by rewrite blocks2bits_nil. +auto. +qed. + +lemma drestr_commute2 &m : + Pr[BlockSponge.IdealIndif + (BlockSponge.BIRO.IRO, BlockSponge.Sim, + LowerDist(DRestr(Dist))).main() @ &m : res] = + Pr[BlockSponge.IdealIndif + (BlockSponge.BIRO.IRO, BlockSponge.Sim, + BlockSponge.DRestr(LowerDist(Dist))).main() @ &m : res]. +proof. +byequiv=> //; proc. +seq 2 2 : + (={glob Dist, BlockSponge.BIRO.IRO.mp, + glob BlockSponge.Sim}); first sim. +inline*; wp; sp. +call + (_ : + ={c}(Cntr, BlockSponge.C) /\ ={BlockSponge.BIRO.IRO.mp} /\ + ={glob BlockSponge.Sim}). +proc; sp; if=> //; sim. +proc; sp; if=> //; sim. +proc=> /=. +inline BlockSponge.FC(BlockSponge.BIRO.IRO).f. +sp; wp. +if=> //. +progress; smt(size_pad2blocks). +seq 1 1 : + (={n} /\ nb{2} = (n{2} + r - 1) %/ r /\ bl{2} = pad2blocks bs{1} /\ + Cntr.c{1} = BlockSponge.C.c{2} /\ + ={BlockSponge.BIRO.IRO.mp, Gconcl.S.paths, Gconcl.S.mi, Gconcl.S.m}). +auto; progress. +rewrite size_pad2blocks //. +inline RaiseFun(BlockSponge.BIRO.IRO).f. +wp; sp. +call (_ : ={BlockSponge.BIRO.IRO.mp}); first sim. +auto. +auto; progress; by rewrite blocks2bits_nil. +auto. +qed. + +lemma security &m : + `|Pr[RealIndif(Sponge, Perm, DRestr(Dist)).main() @ &m : res] - + Pr[IdealIndif + (IRO, RaiseSim(BlockSponge.Sim), + DRestr(Dist)).main() @ &m : res]| <= + (limit ^ 2)%r / 2%r * Distr.mu1 dstate witness + + limit%r * ((2 * limit)%r / (2 ^ c)%r) + + limit%r * ((2 * limit)%r / (2 ^ c)%r). +proof. +rewrite + (RealOrder.ler_trans + (`|Pr[BlockSponge.RealIndif + (BlockSponge.Sponge, Perm, LowerDist(DRestr(Dist))).main() @ &m : res] - + Pr[BlockSponge.IdealIndif + (BlockSponge.BIRO.IRO, BlockSponge.Sim, + LowerDist(DRestr(Dist))).main() @ &m : res]|)) + 1:RealOrder.lerr_eq + 1:(conclusion BlockSponge.Sim (DRestr(Dist)) &m) // + (drestr_commute1 &m) (drestr_commute2 &m) + (BlockSponge.conclusion (LowerDist(Dist)) &m). +qed. + +end section. + +lemma SHA3Security + (Dist <: + DISTINGUISHER{Perm, IRO, BlockSponge.BIRO.IRO, Cntr, + BlockSponge.Sim, BlockSponge.C}) &m : + `|Pr[RealIndif(Sponge, Perm, DRestr(Dist)).main() @ &m : res] - + Pr[IdealIndif + (IRO, RaiseSim(BlockSponge.Sim), DRestr(Dist)).main() @ &m : res]| <= + (limit ^ 2)%r / 2%r * (Distr.mu1 dstate witness)%Distr + + limit%r * ((2 * limit)%r / (2 ^ c)%r) + + limit%r * ((2 * limit)%r / (2 ^ c)%r). +proof. apply (security Dist &m). qed. From 63f7ca89ba99f8596b22fceb7a5ac2b321727d1a Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Fri, 20 Apr 2018 19:03:19 +0200 Subject: [PATCH 281/525] Made upper bound of top-level result more succinct. --- proof/Common.ec | 9 +++++++-- proof/SHA3-Security.ec | 45 ++++++++++++++++++++++++++++++------------ 2 files changed, 39 insertions(+), 15 deletions(-) diff --git a/proof/Common.ec b/proof/Common.ec index df98d4f..8555c2b 100644 --- a/proof/Common.ec +++ b/proof/Common.ec @@ -26,12 +26,15 @@ type capacity. (* ~ bitstrings of size c *) (* -------------------------------------------------------------------- *) -lemma gt0_r: 0 < r. +lemma gt0_r : 0 < r. proof. by apply/(ltr_le_trans 2)/ge2_r. qed. -lemma ge0_r: 0 <= r. +lemma ge0_r : 0 <= r. proof. by apply/ltrW/gt0_r. qed. +lemma ge0_c : 0 <= c. +proof. by apply/ltrW/gt0_c. qed. + (* -------------------------------------------------------------------- *) clone export BitWord as Capacity with type word <- capacity, @@ -57,6 +60,8 @@ export DBlock. op cdistr = DCapacity.dunifin. op bdistr = DBlock.dunifin. +search c. + (* ------------------------- Auxiliary Lemmas ------------------------- *) diff --git a/proof/SHA3-Security.ec b/proof/SHA3-Security.ec index ed0780c..d295459 100644 --- a/proof/SHA3-Security.ec +++ b/proof/SHA3-Security.ec @@ -1,6 +1,9 @@ -(* Top Level *) +(* Top-level Proof of SHA-3 Security *) + +require import AllCore List IntDiv StdOrder Distr. + +require import Common Sponge. import BIRO. -require import AllCore List IntDiv StdOrder Common Sponge. import BIRO. require SLCommon BlockSponge. (* FIX: would be nicer to define limit at top-level and then clone @@ -12,10 +15,6 @@ op limit : {int | 0 < limit} as gt0_max_limit. op limit : int = SLCommon.max_size. -(* FIX: don't want this in bound *) - -op dstate : (block * capacity) distr = SLCommon.dstate. - (*---------------------------- Restrictions ----------------------------*) (** The counter for the functionality counts the number of times the @@ -158,15 +157,37 @@ auto; progress; by rewrite blocks2bits_nil. auto. qed. +op wit_pair : block * capacity = witness. + lemma security &m : `|Pr[RealIndif(Sponge, Perm, DRestr(Dist)).main() @ &m : res] - Pr[IdealIndif (IRO, RaiseSim(BlockSponge.Sim), DRestr(Dist)).main() @ &m : res]| <= - (limit ^ 2)%r / 2%r * Distr.mu1 dstate witness + - limit%r * ((2 * limit)%r / (2 ^ c)%r) + - limit%r * ((2 * limit)%r / (2 ^ c)%r). + (limit ^ 2)%r / (2 ^ (r + c + 1))%r + (4 * limit ^ 2)%r / (2 ^ c)%r. proof. +rewrite powS 1:addz_ge0 1:ge0_r 1:ge0_c -pow_add 1:ge0_r 1:ge0_c. +have -> : + (limit ^ 2)%r / (2 * (2 ^ r * 2 ^ c))%r = + ((limit ^ 2)%r / 2%r) * (1%r / (2 ^ r)%r) * (1%r / (2 ^ c)%r). + rewrite (fromintM 2) StdRing.RField.invfM StdRing.RField.mulrA + -!StdRing.RField.mulrA. + congr. + rewrite (fromintM (2 ^ r)) StdRing.RField.invfM StdRing.RField.mulrA + -!StdRing.RField.mulrA. + congr; by rewrite StdRing.RField.mul1r. +rewrite -{1}block_card -{1}capacity_card + -(DBlock.dunifin1E wit_pair.`1) -(DCapacity.dunifin1E wit_pair.`2) + -StdRing.RField.mulrA -DProd.dprod1E. +have -> : (wit_pair.`1, wit_pair.`2) = witness + by rewrite /wit_pair // {3}(pairS witness). +have -> : + (4 * limit ^ 2)%r / (2 ^ c)%r = + limit%r * ((2 * limit)%r / (2 ^ c)%r) + limit%r * ((2 * limit)%r / (2 ^ c)%r). + have -> : 4 = 2 * 2 by trivial. + have {3}-> : 2 = 1 + 1 by trivial. + rewrite powS // pow1 /#. +rewrite -/SLCommon.dstate /limit. rewrite (RealOrder.ler_trans (`|Pr[BlockSponge.RealIndif @@ -176,7 +197,7 @@ rewrite LowerDist(DRestr(Dist))).main() @ &m : res]|)) 1:RealOrder.lerr_eq 1:(conclusion BlockSponge.Sim (DRestr(Dist)) &m) // - (drestr_commute1 &m) (drestr_commute2 &m) + (drestr_commute1 &m) (drestr_commute2 &m) StdRing.RField.addrA (BlockSponge.conclusion (LowerDist(Dist)) &m). qed. @@ -189,7 +210,5 @@ lemma SHA3Security `|Pr[RealIndif(Sponge, Perm, DRestr(Dist)).main() @ &m : res] - Pr[IdealIndif (IRO, RaiseSim(BlockSponge.Sim), DRestr(Dist)).main() @ &m : res]| <= - (limit ^ 2)%r / 2%r * (Distr.mu1 dstate witness)%Distr + - limit%r * ((2 * limit)%r / (2 ^ c)%r) + - limit%r * ((2 * limit)%r / (2 ^ c)%r). + (limit ^ 2)%r / (2 ^ (r + c + 1))%r + (4 * limit ^ 2)%r / (2 ^ c)%r. proof. apply (security Dist &m). qed. From 6e96d9a77a5bcb11f1f3fa8b59e8bf30aadbd508 Mon Sep 17 00:00:00 2001 From: Pierre-Yves Strub Date: Tue, 24 Apr 2018 08:29:18 +0200 Subject: [PATCH 282/525] Import NewFMap --- proof/NewFMap.ec | 818 +++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 818 insertions(+) create mode 100644 proof/NewFMap.ec diff --git a/proof/NewFMap.ec b/proof/NewFMap.ec new file mode 100644 index 0000000..6d5b089 --- /dev/null +++ b/proof/NewFMap.ec @@ -0,0 +1,818 @@ +(* -------------------------------------------------------------------- + * Copyright (c) - 2012--2016 - IMDEA Software Institute + * Copyright (c) - 2012--2018 - Inria + * Copyright (c) - 2012--2018 - Ecole Polytechnique + * + * Distributed under the terms of the CeCILL-B-V1 license + * -------------------------------------------------------------------- *) + +(* -------------------------------------------------------------------- *) +require import AllCore Int List FSet. + +pragma -oldip. +pragma +implicits. + +(* -------------------------------------------------------------------- *) +lemma perm_eq_uniq_map (f : 'a -> 'b) (s1 s2 : 'a list): + perm_eq s1 s2 => uniq (map f s1) <=> uniq (map f s2). +proof. by move=> /(perm_eq_map f) /perm_eq_uniq ->. qed. + +lemma uniq_perm_eq_map (s1 s2 : ('a * 'b) list) (f: 'a * 'b -> 'c): + uniq (map f s1) => uniq (map f s2) + => (forall (x : 'a * 'b), mem s1 x <=> mem s2 x) + => perm_eq s1 s2. +proof. by move=> /uniq_map h1 /uniq_map h2 /(uniq_perm_eq _ _ h1 h2). qed. + +(* -------------------------------------------------------------------- *) +op augment (s : ('a * 'b) list) (kv : 'a * 'b) = + if mem (map fst s) kv.`1 then s else rcons s kv. + +lemma nosmt augment_nil (kv : 'a * 'b): augment [] kv = [kv]. +proof. by []. qed. + +lemma augmentP (s : ('a * 'b) list) x y: + ( mem (map fst s) x /\ augment s (x, y) = s) + \/ (! mem (map fst s) x /\ augment s (x, y) = rcons s (x, y)). +proof. by case: (mem (map fst s) x)=> //=; rewrite /augment => ->. qed. + +op reduce (xs : ('a * 'b) list): ('a * 'b) list = + foldl augment [] xs. + +lemma reduce_nil: reduce [<:'a * 'b>] = []. +proof. by []. qed. + +lemma nosmt reduce_cat (r s : ('a * 'b) list): + foldl augment r s + = r ++ filter (predC (mem (map fst r)) \o fst) (foldl augment [] s). +proof. +rewrite -(@revK s) !foldl_rev; pose f := fun x z => augment z x. +elim/last_ind: s r => /=. + by move=> r; rewrite !rev_nil /= cats0. +move=> s [x y] ih r; rewrite !rev_rcons /= ih => {ih}. +rewrite {1}/f {1}/augment map_cat mem_cat /=. +pose t1 := map fst _; pose t2 := map fst _. +case: (mem t1 x \/ mem t2 x) => //; last first. + rewrite negb_or => -[t1_x t2_x]; rewrite rcons_cat; congr. + rewrite {2}/f /augment /=; pose t := map fst _. + case: (mem t x) => h; last first. + by rewrite filter_rcons /= /(\o) /predC t1_x. + have: mem t2 x; rewrite // /t2 /(\o). + have <- := filter_map<:'a, 'a * 'b> fst (predC (mem t1)). + by rewrite mem_filter /predC t1_x. +case=> h; congr; rewrite {2}/f /augment /=; last first. + move: h; rewrite /t2 => /mapP [z] [h ->>]. + by move: h; rewrite mem_filter => -[_ /(map_f fst) ->]. +case: (List.mem _ _) => //=; rewrite filter_rcons. +by rewrite /(\o) /predC h. +qed. + +lemma reduce_cons (x : 'a) (y : 'b) s: + reduce ((x, y) :: s) + = (x, y) :: filter (predC1 x \o fst) (reduce s). +proof. by rewrite {1}/reduce /= augment_nil reduce_cat cat1s. qed. + +lemma assoc_reduce (s : ('a * 'b) list): + forall x, assoc (reduce s) x = assoc s x. +proof. +move=> x; elim: s => //; case=> x' y' s ih. +rewrite reduce_cons !assoc_cons; case: (x = x')=> // ne_xx'. +by rewrite assoc_filter /predC1 ne_xx'. +qed. + +lemma dom_reduce (s : ('a * 'b) list): + forall x, mem (map fst (reduce s)) x <=> mem (map fst s) x. +proof. +move=> x; elim: s => [|[x' y] s ih] /=; 1: by rewrite reduce_nil. +rewrite reduce_cons /=; apply/orb_id2l. +rewrite /(\o) /= => ne_xx'. +by rewrite -(@filter_map _ (predC1 x')) mem_filter /predC1 ne_xx' /= ih. +qed. + +lemma reduced_reduce (s : ('a * 'b) list): uniq (map fst (reduce s)). +proof. +elim: s => [|[x y] s ih]; 1: by rewrite reduce_nil. +rewrite reduce_cons /= ; split. ++ by apply/negP=> /mapP [[x' y']]; rewrite mem_filter=> -[# h1 h2 ->>]. +rewrite /(\o); have <- := filter_map fst<:'a, 'b> (predC1 x). +by rewrite filter_uniq. +qed. + +lemma reduce_reduced (s : ('a * 'b) list): + uniq (map fst s) => reduce s = s. +proof. +elim: s => [|[x y] s ih]; 1: by rewrite reduce_nil. +rewrite reduce_cons /= => -[x_notin_s /ih ->]. +rewrite (@eq_in_filter _ predT) ?filter_predT /predT //=. +case=> x' y' /(map_f fst) x'_in_s; apply/negP => <<-. +by move: x_notin_s. +qed. + +lemma reduceK (xs : ('a * 'b) list): reduce (reduce xs) = reduce xs. +proof. by rewrite reduce_reduced 1:reduced_reduce. qed. + +lemma mem_reduce_head (xs : ('a * 'b) list) a b: + mem (reduce ((a, b) :: xs)) (a, b). +proof. by rewrite reduce_cons. qed. + +(* -------------------------------------------------------------------- *) +(* Finite maps are abstractely represented as the quotient by *) +(* [perm_eq] of lists of pairs without first projection duplicates. *) + +type ('a, 'b) fmap. + +op elems : ('a, 'b) fmap -> ('a * 'b) list. +op oflist : ('a * 'b) list -> ('a,'b) fmap. + +axiom elemsK (m : ('a, 'b) fmap) : Self.oflist (elems m) = m. +axiom oflistK (s : ('a * 'b) list): perm_eq (reduce s) (elems (Self.oflist s)). + +lemma uniq_keys (m : ('a, 'b) fmap): uniq (map fst (elems m)). +proof. +rewrite -elemsK; move: (elems m) => {m} m. +apply (@perm_eq_uniq (map fst (reduce m)) _). ++ by apply perm_eq_map; apply oflistK. +by apply reduced_reduce. +qed. + +axiom fmap_eq (s1 s2 : ('a,'b) fmap): + (perm_eq (elems s1) (elems s2)) <=> (s1 = s2). + +(* -------------------------------------------------------------------- *) +lemma fmapW (p : ('a, 'b) fmap -> bool): + (forall m, uniq (map fst m) => p (Self.oflist m)) + => forall m, p m. +proof. by move=> ih m; rewrite -elemsK; apply/ih/uniq_keys. qed. + +(* -------------------------------------------------------------------- *) +op "_.[_]" (m : ('a,'b) fmap) (x : 'a) = assoc (elems m) x + axiomatized by getE. + +lemma get_oflist (s : ('a * 'b) list): + forall x, (Self.oflist s).[x] = assoc s x. +proof. +move=> x; rewrite getE; rewrite -(@assoc_reduce s). +apply/eq_sym/perm_eq_assoc; 1: by apply/uniq_keys. +by apply/oflistK. +qed. + +lemma fmapP (m1 m2 : ('a,'b) fmap): + (m1 = m2) <=> (forall x, m1.[x] = m2.[x]). +proof. +split=> // h; apply/fmap_eq/uniq_perm_eq; ~3:by apply/(@uniq_map fst)/uniq_keys. +case=> x y; move: (h x); rewrite !getE => {h} h. +by rewrite !mem_assoc_uniq ?uniq_keys // h. +qed. + +(* -------------------------------------------------------------------- *) +op map0 ['a,'b] = Self.oflist [<:'a * 'b>] axiomatized by map0E. + +(* -------------------------------------------------------------------- *) +op "_.[_<-_]" (m : ('a, 'b) fmap) (a : 'a) (b : 'b) = + Self.oflist (reduce ((a, b) :: elems m)) + axiomatized by setE. + +lemma getP (m : ('a, 'b) fmap) (a : 'a) (b : 'b) (x : 'a): + m.[a <- b].[x] = if x = a then Some b else m.[x]. +proof. +by rewrite setE get_oflist assoc_reduce assoc_cons getE; case: (x = a). +qed. + +lemma getP_eq (m : ('a, 'b) fmap) (a : 'a) (b : 'b): + m.[a <- b].[a] = Some b. +proof. by rewrite getP. qed. + +lemma getP_neq (m : ('a, 'b) fmap) (a1 a2 : 'a) (b : 'b): + a1 <> a2 => + m.[a1 <- b].[a2] = m.[a2]. +proof. by rewrite getP eq_sym=> ->. qed. + +lemma set_set (m : ('a,'b) fmap) x x' y y': + m.[x <- y].[x' <- y'] = if x = x' then m.[x' <- y'] + else m.[x' <- y'].[x <- y]. +proof. +rewrite fmapP=> a; case (x = x')=> [<<- {x'} | ne_x_x']; rewrite !getP. ++ by case (a = x). +by case (a = x')=> //; case (a = x)=> // ->;rewrite ne_x_x'. +qed. + +lemma nosmt set_set_eq y (m : ('a, 'b) fmap) x y': + m.[x <- y].[x <- y'] = m.[x <- y']. +proof. by rewrite fmapP=> a; rewrite set_set. qed. + +(* -------------------------------------------------------------------- *) +op rem (a : 'a) (m : ('a, 'b) fmap) = + Self.oflist (filter (predC1 a \o fst) (elems m)) + axiomatized by remE. + +lemma remP (a : 'a) (m : ('a, 'b) fmap): + forall x, (rem a m).[x] = if x = a then None else m.[x]. +proof. +move=> x; rewrite remE get_oflist assoc_filter; case (x = a)=> //=. +by rewrite /predC1 getE=> ->. +qed. + +(* -------------------------------------------------------------------- *) +op dom ['a 'b] (m : ('a, 'b) fmap) = + FSet.oflist (map fst (elems m)) + axiomatized by domE. + +lemma dom_oflist (s : ('a * 'b) list): + forall x, mem (dom (Self.oflist s)) x <=> mem (map fst s) x. +proof. +move=> x; rewrite domE mem_oflist. +have/perm_eq_sym/(perm_eq_map fst) := oflistK s. +by move/perm_eq_mem=> ->; apply/dom_reduce. +qed. + +lemma mem_domE (m : ('a, 'b) fmap) x: + mem (dom m) x <=> mem (map fst (elems m)) x. +proof. by rewrite domE mem_oflist. qed. + +lemma in_dom (m : ('a, 'b) fmap) x: + mem (dom m) x <=> m.[x] <> None. +proof. +rewrite mem_domE getE. +by case: (assocP (elems m) x)=> [[-> [y [_ ->]]] | [-> ->]]. +qed. + +lemma fmap_domP (m1 m2 : ('a, 'b) fmap): + (m1 = m2) <=> (forall x, mem (dom m1) x = mem (dom m2) x) + /\ (forall x, mem (dom m1) x => m1.[x] = m2.[x]). +proof. +split=> // [[]] eq_dom eq_on_dom. +apply fmapP=> x; case: (mem (dom m1) x). ++ by apply eq_on_dom. +move=> ^; rewrite {2}eq_dom !in_dom /=. +by move=> -> ->. +qed. + +lemma get_oget (m:('a,'b)fmap) (x:'a) : + mem (dom m) x => m.[x] = Some (oget m.[x]). +proof. by rewrite in_dom; case: (m.[x]). qed. + +(* -------------------------------------------------------------------- *) +op rng ['a 'b] (m : ('a, 'b) fmap) = + FSet.oflist (map snd (elems m)) + axiomatized by rngE. + +lemma mem_rngE (m : ('a, 'b) fmap) y: + mem (rng m) y <=> mem (map snd (elems m)) y. +proof. by rewrite rngE mem_oflist. qed. + +lemma in_rng (m: ('a,'b) fmap) (b : 'b): + mem (rng m) b <=> (exists a, m.[a] = Some b). +proof. +rewrite mem_rngE; split. ++ move/List.mapP=> [] [x y] [h ->]; exists x. + by rewrite getE -mem_assoc_uniq 1:uniq_keys. +case=> x; rewrite getE -mem_assoc_uniq ?uniq_keys // => h. +by apply/List.mapP; exists (x, b). +qed. + +(* -------------------------------------------------------------------- *) +op has (p : 'a -> 'b -> bool) (m : ('a, 'b) fmap) = + List.has (fun (x : 'a * 'b), p x.`1 x.`2) (elems m) + axiomatized by hasE. + +lemma hasP p (m : ('a, 'b) fmap): + has p m <=> (exists x, mem (dom m) x /\ p x (oget m.[x])). +proof. +rewrite hasE hasP /=; split=> [[[a b]] /= [^ab_in_m+ p_a_b] |[a] []]. ++ rewrite mem_assoc_uniq 1:uniq_keys // -getE => ma_b. + by exists a; rewrite ma_b mem_domE /oget /= p_a_b /= mem_map_fst; exists b. +rewrite mem_domE mem_map_fst=> -[b] ^ab_in_m+. +by rewrite mem_assoc_uniq 1:uniq_keys // getE /oget=> -> /= p_a_b; exists (a,b). +qed. + +(* FIXME: name *) +lemma has_le p' (m : ('a, 'b) fmap) (p : 'a -> 'b -> bool): + (forall x y, mem (dom m) x /\ p x y => mem (dom m) x /\ p' x y) => + has p m => + has p' m. +proof. +by move=> le_p_p'; rewrite !hasP=> -[x] /le_p_p' [p'_x x_in_m]; exists x. +qed. + +(* -------------------------------------------------------------------- *) +op all (p : 'a -> 'b -> bool) (m : ('a, 'b) fmap) = + List.all (fun (x : 'a * 'b), p x.`1 x.`2) (elems m) + axiomatized by allE. + +lemma allP p (m : ('a, 'b) fmap): + all p m <=> (forall x, mem (dom m) x => p x (oget m.[x])). +proof. +rewrite allE allP; split=> [h a|h [a b] /= ^ab_in_m]. ++ rewrite mem_domE mem_map_fst=> -[b] ^ab_in_m+. + by rewrite mem_assoc_uniq 1:uniq_keys -getE /oget=> ->; apply (@h (a,b)). +rewrite mem_assoc_uniq 1:uniq_keys -getE=> /(@congr1 oget) <-. +by apply/h; rewrite mem_domE mem_map_fst; exists b. +qed. + +lemma all_le p' (m : ('a, 'b) fmap) (p : 'a -> 'b -> bool): + (forall x y, mem (dom m) x /\ p x y => mem (dom m) x /\ p' x y) => + all p m => + all p' m. +proof. +move=> le_p_p'. rewrite !allP=> h x ^x_in_m /h p_x. +exact/(andWr _ (:@le_p_p' x (oget m.[x]) _)). +qed. + +(* -------------------------------------------------------------------- *) +lemma has_all (m : ('a, 'b) fmap) (p : 'a -> 'b -> bool): + has p m <=> !all (fun x y, !p x y) m. +proof. +rewrite hasP allP negb_forall /=; split=> [[x] [x_in_m p_x]|[] x]. ++ by exists x; rewrite p_x. +by rewrite negb_imply /= => h; exists x. +qed. + +(* -------------------------------------------------------------------- *) +op (+) (m1 m2 : ('a, 'b) fmap) = Self.oflist (elems m2 ++ elems m1) + axiomatized by joinE. + +lemma joinP (m1 m2 : ('a, 'b) fmap) x: + (m1 + m2).[x] = if mem (dom m2) x then m2.[x] else m1.[x]. +proof. by rewrite joinE get_oflist mem_domE assoc_cat -!getE. qed. + +(* -------------------------------------------------------------------- *) +op find (p : 'a -> 'b -> bool) (m : ('a, 'b) fmap) = + onth (map fst (elems m)) (find (fun (x : 'a * 'b), p x.`1 x.`2) (elems m)) + axiomatized by findE. + +(** The following are inspired from lemmas on List.find. findP is a + total characterization, but a more usable interface may be useful. **) +lemma find_none (p : 'a -> 'b -> bool) (m : ('a, 'b) fmap): + has p m <=> find p m <> None. +proof. +rewrite hasE /= findE List.has_find; split=> [h|]. ++ by rewrite (@onth_nth witness) 1:find_ge0/= 1:size_map. +by apply/contraLR=> h; rewrite onth_nth_map -map_comp nth_default 1:size_map 1:lezNgt. +qed. + +lemma findP (p : 'a -> 'b -> bool) (m : ('a, 'b) fmap): + (exists x, find p m = Some x /\ mem (dom m) x /\ p x (oget m.[x])) + \/ (find p m = None /\ forall x, mem (dom m) x => !p x (oget m.[x])). +proof. +case: (has p m)=> [^has_p | ^all_not_p]. ++ rewrite hasE has_find. + have:= find_ge0 (fun (x : 'a * 'b) => p x.`1 x.`2) (elems m). + pose i:= find _ (elems m); move => le0_i lt_i_sizem; left. + exists (nth witness (map ofst (elems m)) i); split. + + by rewrite findE -/i (@onth_nth witness) 1:size_map. + split. + + by rewrite mem_domE -index_mem index_uniq 1,3:size_map 2:uniq_keys. + have /= := nth_find witness (fun (x : 'a * 'b) => p (ofst x) (osnd x)) (elems m) _. + + by rewrite -hasE. + rewrite -/i -(@nth_map _ witness) // getE /assoc + (@index_uniq witness i (map fst (elems m))). + + by rewrite size_map. + + exact/uniq_keys. + by rewrite (@onth_nth witness) //. +rewrite has_all /= allP /= => h; right. +by split=> //; move: all_not_p; rewrite find_none. +qed. + +(* -------------------------------------------------------------------- *) +op filter (p : 'a -> 'b -> bool) (m : ('a, 'b) fmap) = + oflist (filter (fun (x : 'a * 'b) => p x.`1 x.`2) (elems m)) + axiomatized by filterE. + +(* FIXME: Move me *) +lemma filter_mem_map (p : 'a -> bool) (f : 'a -> 'b) (s : 'a list) x': + mem (map f (filter p s)) x' => mem (map f s) x'. +proof. by elim s=> //= x xs ih; case (p x)=> [_ [//= |] | _] /ih ->. qed. + +(* FIXME: Move me *) +lemma uniq_map_filter (p : 'a -> bool) (f : 'a -> 'b) (s : 'a list): + uniq (map f s) => uniq (map f (filter p s)). +proof. + elim s=> //= x xs ih [fx_notin_fxs uniq_fxs]. + by case (p x); rewrite ih //= -negP => h {h} /filter_mem_map. +qed. + +lemma perm_eq_elems_filter (m : ('a, 'b) fmap) (p: 'a -> 'b -> bool): + perm_eq (filter (fun (x : 'a * 'b) => p x.`1 x.`2) (elems m)) + (elems (filter p m)). +proof. + (* FIXME: curry-uncurry should probably go into Pair for some chosen arities *) + rewrite filterE; pose P:= fun (x : 'a * 'b) => p x.`1 x.`2. + apply (perm_eq_trans _ _ (:@oflistK _)). + rewrite reduce_reduced 2:perm_eq_refl //. + by apply/uniq_map_filter/uniq_keys. +qed. + +lemma mem_elems_filter (m : ('a, 'b) fmap) (p: 'a -> 'b -> bool) x y: + mem (filter (fun (x : 'a * 'b) => p x.`1 x.`2) (elems m)) (x,y) + <=> mem (elems (filter p m)) (x,y). +proof. by apply/perm_eq_mem/perm_eq_elems_filter. qed. + +lemma mem_map_filter_elems (p : 'a -> 'b -> bool) (f : ('a * 'b) -> 'c) (m : ('a, 'b) fmap) a: + mem (map f (filter (fun (x : 'a * 'b) => p x.`1 x.`2) (elems m))) a + <=> mem (map f (elems (filter p m))) a. +proof. by apply/perm_eq_mem/perm_eq_map/perm_eq_elems_filter. qed. + +lemma assoc_elems_filter (m : ('a, 'b) fmap) (p: 'a -> 'b -> bool) x: + assoc (filter (fun (x : 'a * 'b) => p x.`1 x.`2) (elems m)) x + = assoc (elems (filter p m)) x. +proof. by apply/perm_eq_assoc/perm_eq_elems_filter/uniq_keys. qed. + +lemma dom_filter (p : 'a -> 'b -> bool) (m : ('a,'b) fmap) x: + mem (dom (filter p m)) x <=> mem (dom m) x /\ p x (oget m.[x]). +proof. + (* FIXME: curry-uncurry should probably go into Pair for some chosen arities *) + pose P := fun (x : 'a * 'b) => p x.`1 x.`2. + rewrite !mem_domE !mem_map_fst; split=> [[y] | [[y] xy_in_m]]. + rewrite -mem_elems_filter mem_filter getE /= => -[p_x_y xy_in_pm]. + split; 1:by exists y. + by move: xy_in_pm; rewrite mem_assoc_uniq 1:uniq_keys // => ->. + have:= xy_in_m; rewrite mem_assoc_uniq 1:uniq_keys // getE /oget=> -> /= p_x_y. + by exists y; rewrite -mem_elems_filter mem_filter. +qed. + +lemma filterP (p : 'a -> 'b -> bool) (m : ('a, 'b) fmap) x: + (filter p m).[x] = if mem (dom m) x /\ p x (oget m.[x]) + then m.[x] + else None. +proof. + case (mem (dom m) x /\ p x (oget m.[x])); rewrite -dom_filter in_dom //=. + case {-1}((filter p m).[x]) (eq_refl (filter p m).[x])=> //= y. + rewrite getE -mem_assoc_uniq 1:uniq_keys //. + rewrite -mem_elems_filter mem_filter /= mem_assoc_uniq 1:uniq_keys //. + by rewrite getE=> -[_ ->]. +qed. + +lemma filter_eq_dom (m:('a,'b)fmap) (p1 p2:'a->'b->bool): + (forall a, mem (dom m) a=> p1 a (oget m.[a]) = p2 a (oget m.[a])) => + filter p1 m = filter p2 m. +proof. + by move=> Hp;apply fmapP=>z;rewrite !filterP;case (mem (dom m) z)=>// Hz;rewrite Hp. +qed. + +lemma filter_eq (m:('a,'b)fmap) (p1 p2:'a->'b->bool): + (forall a b, p1 a b = p2 a b) => + filter p1 m = filter p2 m. +proof. by move=>Hp;apply filter_eq_dom=>?_;apply Hp. qed. + +lemma filter_dom (m : ('a,'b) fmap) (p : 'a -> 'b -> bool): + filter (relI p (fun a (_ : 'b)=> mem (dom m) a)) m = filter p m. +proof. by apply/filter_eq_dom=> a @/relI ->. qed. + +(* -------------------------------------------------------------------- *) +op map (f : 'a -> 'b -> 'c) (m : ('a, 'b) fmap) = + oflist (map (fun (x : 'a * 'b) => (x.`1,f x.`1 x.`2)) (elems m)) + axiomatized by mapE. + +lemma dom_map (m : ('a,'b) fmap) (f : 'a -> 'b -> 'c) x: + mem (dom (map f m)) x <=> mem (dom m) x. +proof. + rewrite mapE dom_oflist domE mem_oflist. + by elim (elems m)=> //= [[a b] l] /= ->. +qed. + +lemma perm_eq_elems_map (m : ('a, 'b) fmap) (f : 'a -> 'b -> 'c): + perm_eq (map (fun (x : 'a * 'b) => (x.`1,f x.`1 x.`2)) (elems m)) + (elems (map f m)). +proof. + pose F := fun (x : 'a * 'b) => (x.`1,f x.`1 x.`2). + apply (@perm_eq_trans (reduce (map F (elems m)))). + rewrite -{1}(@reduce_reduced (map F (elems m))) 2:perm_eq_refl //. + have ->: forall s, map fst (map F s) = map fst s by elim. + exact/uniq_keys. + by rewrite mapE; apply/oflistK. +qed. + +lemma mem_elems_map (m : ('a, 'b) fmap) (f : 'a -> 'b -> 'c) x y: + mem (map (fun (x : 'a * 'b) => (x.`1,f x.`1 x.`2)) (elems m)) (x,y) + <=> mem (elems (map f m)) (x,y). +proof. by apply/perm_eq_mem/perm_eq_elems_map. qed. + +lemma mapP (f : 'a -> 'b -> 'c) (m : ('a, 'b) fmap) x: + (map f m).[x] = omap (f x) m.[x]. +proof. + pose F := fun (x : 'a * 'b) => (x.`1,f x.`1 x.`2). + case (mem (dom (map f m)) x)=> h //=. + case {-1}((map f m).[x]) (eq_refl (map f m).[x])=> [nh | y]. + by move: h; rewrite in_dom nh. + rewrite getE -mem_assoc_uniq 1:uniq_keys// -mem_elems_map mapP=> -[[a b]] /=. + by rewrite mem_assoc_uniq 1:uniq_keys// -getE andbC=> -[[<<- ->>]] ->. + have:= h; rewrite dom_map=> h'. + by move: h h'; rewrite !in_dom /= => -> ->. +qed. + +(* -------------------------------------------------------------------- *) +op eq_except (m1 m2 : ('a, 'b) fmap) (X : 'a -> bool) = + filter (fun x y => !X x) m1 + = filter (fun x y => !X x) m2 + axiomatized by eq_exceptE. + +lemma eq_except_refl (m : ('a, 'b) fmap) X: eq_except m m X. +proof. by rewrite eq_exceptE. qed. + +lemma eq_except_sym (m1 m2 : ('a, 'b) fmap) X: + eq_except m1 m2 X <=> eq_except m2 m1 X. +proof. by rewrite eq_exceptE eq_sym -eq_exceptE. qed. + +lemma eq_except_trans (m2 m1 m3 : ('a, 'b) fmap) X: + eq_except m1 m2 X => + eq_except m2 m3 X => + eq_except m1 m3 X. +proof. by rewrite !eq_exceptE; apply eq_trans. qed. + +lemma eq_exceptP (m1 m2 : ('a, 'b) fmap) X: + eq_except m1 m2 X <=> + (forall x, !X x => m1.[x] = m2.[x]). +proof. + rewrite eq_exceptE fmapP; split=> h x. + move=> x_notin_X; have:= h x; rewrite !filterP /= x_notin_X /=. + case (mem (dom m1) x); case (mem (dom m2) x); rewrite !in_dom=> //=. + (* FIXME: Should the following two be dealt with by `trivial'? *) + by rewrite eq_sym. + by move=> -> ->. + by rewrite !filterP /=; case (X x)=> //= /h; rewrite !in_dom=> ->. +qed. + +(* -------------------------------------------------------------------- *) +op size (m : ('a, 'b) fmap) = card (dom m) + axiomatized by sizeE. + +(* -------------------------------------------------------------------- *) +(* TODO: Do we need unary variants of has, all, find and map? *) + +(* -------------------------------------------------------------------- *) +lemma map0P x: (map0<:'a, 'b>).[x] = None. +proof. by rewrite map0E get_oflist. qed. + +lemma map0_eq0 (m : ('a,'b) fmap): + (forall x, m.[x] = None) => m = map0. +proof. by move=> h; apply fmapP=> x; rewrite h map0P. qed. + +lemma remP_eq (a : 'a) (m : ('a,'b) fmap): (rem a m).[a] = None. +proof. by rewrite remP. qed. + +lemma rem_rem (a : 'a) (m : ('a, 'b) fmap): + rem a (rem a m) = rem a m. +proof. by rewrite fmapP=> x; rewrite !remP; case (x = a). qed. + +lemma dom0: dom map0<:'a, 'b> = fset0. +proof. by apply/fsetP=> x; rewrite map0E dom_oflist in_fset0. qed. + +lemma dom_eq0 (m : ('a,'b) fmap): + dom m = fset0 => m = map0. +proof. + move=> eq_dom; apply fmap_domP; rewrite eq_dom dom0 //= => x; + by rewrite in_fset0. +qed. + +lemma domP (m : ('a, 'b) fmap) (a : 'a) (b : 'b): + forall x, mem (dom m.[a <- b]) x <=> mem (dom m `|` fset1 a) x. +proof. + move=> x; rewrite in_fsetU in_fset1 !in_dom getP; + by case (x = a). +qed. + +lemma domP_eq (m : ('a, 'b) fmap) (a : 'a) (b : 'b): + mem (dom m.[a <- b]) a. +proof. by rewrite domP in_fsetU in_fset1. qed. + +lemma dom_set (m:('a,'b) fmap) a b : + dom m.[a<-b] = dom m `|` fset1 a. +proof. by apply/fsetP/domP. qed. + +lemma dom_rem (a : 'a) (m : ('a, 'b) fmap): + dom (rem a m) = dom m `\` fset1 a. +proof. + by rewrite fsetP=> x; rewrite in_fsetD in_fset1 !in_dom remP; case (x = a). +qed. + +lemma dom_rem_eq (a : 'a) (m : ('a, 'b) fmap): !mem (dom (rem a m)) a. +proof. by rewrite dom_rem in_fsetD in_fset1. qed. + +lemma rng0: rng map0<:'a, 'b> = fset0. +proof. + apply/fsetP=> x; rewrite in_fset0 //= in_rng. + by rewrite negb_exists => a; rewrite /= map0P. +qed. + +lemma find_set (m:('a,'b) fmap) y x (p:'a -> 'b -> bool): + (forall x, mem (dom m) x => !p x (oget m.[x])) => + find p m.[x <- y] = if p x y then Some x else None. +proof. + cut [[a []->[]] | []-> Hp Hnp]:= findP p (m.[x<-y]);1: rewrite getP dom_set !inE /#. + by case (p x y)=> //; cut := Hp x;rewrite getP dom_set !inE /= oget_some. +qed. + +lemma rng_set (m : ('a, 'b) fmap) (a : 'a) (b : 'b): + rng m.[a<-b] = rng (rem a m) `|` fset1 b. +proof. + rewrite fsetP=> y; rewrite in_fsetU in_fset1 !in_rng; split=> [[] x |]. + rewrite getP; case (x = a)=> [->> /= <<- |ne_xa mx_y]; [right=> // |left]. + by exists x; rewrite remP ne_xa /=. + rewrite orbC -oraE=> -[->> | ]. + by exists a; rewrite getP_eq. + move=> ne_yb [] x; rewrite remP. + case (x = a)=> //= ne_xa <-. + by exists x; rewrite getP ne_xa. +qed. + +lemma rng_set_eq (m : ('a, 'b) fmap) (a : 'a) (b : 'b): + mem (rng m.[a<-b]) b. +proof. by rewrite rng_set in_fsetU in_fset1. qed. + +lemma rng_rem (a : 'a) (m : ('a, 'b) fmap) (b : 'b): + mem (rng (rem a m)) b <=> (exists x, x <> a /\ m.[x] = Some b). +proof. + rewrite in_rng; split=> [[x]|[x] [ne_x_a mx_b]]. + rewrite remP; case (x = a)=> //=. + by move=> ne_x_a mx_b; exists x. + by exists x; rewrite remP ne_x_a. +qed. + +lemma dom_join (m1 m2 : ('a, 'b) fmap): + forall x, mem (dom (m1 + m2)) x <=> mem (dom m1 `|` dom m2) x. +proof. + by move=> x; rewrite in_fsetU !in_dom joinP in_dom; case (m2.[x]). +qed. + +lemma has_join (p : 'a -> 'b -> bool) (m1 m2 : ('a, 'b) fmap): + has p (m1 + m2) <=> has (fun x y => p x y /\ !mem (dom m2) x) m1 \/ has p m2. +proof. +rewrite !hasP; split=> [[x]|]. + rewrite joinP dom_join in_fsetU. + by case: (mem (dom m2) x)=> //= + [x_in_m2 p_x_m2x|x_notin_m2 [x_in_m1 p_x_m1x]]; + [right|left]; exists x. +by move=> [[]|[]] x /> => [x_in_m1|h] p_x => [h|]; exists x; rewrite dom_join joinP in_fsetU h. +qed. + +lemma get_find (p : 'a -> 'b -> bool) (m : ('a, 'b) fmap): + has p m => p (oget (find p m)) (oget m.[oget (find p m)]). +proof. by rewrite find_none; have:= findP p m; case (find p m). qed. + +lemma has_find (p : 'a -> 'b -> bool) (m : ('a, 'b) fmap): + has p m <=> exists x, find p m = Some x /\ mem (dom m) x. +proof. + rewrite find_none; have:= findP p m. + by case (find p m)=> //= x [x'] [eq_xx' [x'_in_m _]]; exists x'. +qed. + +lemma find_some (p:'a -> 'b -> bool) m x: + find p m = Some x => + mem (dom m) x /\ p x (oget m.[x]). +proof. by have:= findP p m; case (find p m). qed. + +lemma rem_filter (m : ('a, 'b) fmap) x: + rem x m = filter (fun x' y => x' <> x) m. +proof. + apply fmapP=> x'; rewrite remP filterP; case (mem (dom m) x'). + by case (x' = x). + by rewrite in_dom /= => ->. +qed. + +lemma filter_predI (p1 p2: 'a -> 'b -> bool) (m : ('a, 'b) fmap): + filter (fun a b => p1 a b /\ p2 a b) m = filter p1 (filter p2 m). +proof. by rewrite fmapP=>x;rewrite !(filterP, dom_filter)/#. qed. + +lemma filter_filter (p : 'a -> 'b -> bool) (m : ('a, 'b) fmap): + filter p (filter p m) = filter p m. +proof. by rewrite -filter_predI;apply filter_eq => /#. qed. + +lemma filter_rem (p:'a->'b->bool) (m:('a,'b)fmap) x: + filter p (rem x m) = rem x (filter p m). +proof. rewrite !rem_filter -!filter_predI;apply filter_eq=>/#. qed. + +lemma join_filter (p : 'a -> 'b -> bool) (m : ('a, 'b) fmap): + (filter p m) + (filter (fun x y=> !p x y) m) = m. +proof. + rewrite fmapP=> x; rewrite joinP dom_filter /= !filterP. + case (mem (dom m) x)=> /=. + by case (p x (oget m.[x])). + by rewrite in_dom /= eq_sym. +qed. + +lemma eq_except_set a b (m1 m2 : ('a, 'b) fmap) X: + eq_except m1 m2 X => + eq_except m1.[a <- b] m2.[a <- b] X. +proof. + rewrite !eq_exceptP=> h x x_notin_X. + rewrite !getP; case (x = a)=> //=. + by rewrite h. +qed. + +lemma filter_eq_except (m : ('a, 'b) fmap) (X : 'a -> bool): + eq_except (filter (fun x y => !X x) m) m X. +proof. by rewrite eq_exceptE filter_filter. qed. + +lemma eq_except_rem (m1 m2:('a,'b)fmap) (s:'a -> bool) x: + s x => eq_except m1 m2 s => eq_except m1 (rem x m2) s. +proof. + rewrite !eq_exceptE rem_filter -filter_predI=> Hmem ->;apply filter_eq=>/#. +qed. + +lemma set_eq_except x b (m : ('a, 'b) fmap): + eq_except m.[x <- b] m (pred1 x). +proof. by rewrite eq_exceptP=> x'; rewrite !getP=> ->. qed. + +lemma set2_eq_except x b b' (m : ('a, 'b) fmap): + eq_except m.[x <- b] m.[x <- b'] (pred1 x). +proof. by rewrite eq_exceptP=> x'; rewrite !getP=> ->. qed. + +lemma eq_except_set_eq (m1 m2 : ('a, 'b) fmap) x: + mem (dom m1) x => + eq_except m1 m2 (pred1 x) => + m1 = m2.[x <- oget m1.[x]]. +proof. + rewrite eq_exceptP fmapP=> x_in_m1 eqe x'. + rewrite !getP /oget; case (x' = x)=> [->> |]. + by move: x_in_m1; rewrite in_dom; case (m1.[x]). + by exact/eqe. +qed. + +(* -------------------------------------------------------------------- *) +lemma rem_id (x : 'a) (m : ('a,'b) fmap): + !mem (dom m) x => rem x m = m. +proof. +rewrite in_dom /= => x_notin_m; apply/fmapP=> x'; rewrite remP. +by case: (x' = x)=> //= ->>; rewrite x_notin_m. +qed. + +lemma dom_rem_le (x : 'a) (m : ('a,'b) fmap) (x' : 'a): + mem (dom (rem x m)) x' => mem (dom m) x'. +proof. by rewrite dom_rem in_fsetD. qed. + +lemma rng_rem_le (x : 'a) (m : ('a,'b) fmap) (x' : 'b): + mem (rng (rem x m)) x' => mem (rng m) x'. +proof. by rewrite rng_rem in_rng=> -[x0] [_ h]; exists x0. qed. + +(* -------------------------------------------------------------------- *) +(** FIXME: these two were minimally imported from old and need cleaning *) +lemma leq_card_rng_dom (m:('a,'b) fmap): + card (rng m) <= card (dom m). +proof. +elim/fset_ind: (dom m) {-2}m (eq_refl (dom m))=> {m} [m /dom_eq0 ->|]. ++ by rewrite rng0 dom0 !fcards0. +move=> x s x_notin_s ih m dom_m. +cut ->: m = (rem x m).[x <- oget m.[x]]. ++ apply fmapP=> x'; rewrite getP remP; case: (x' = x)=> [->|//]. + have /fsetP /(_ x):= dom_m; rewrite in_fsetU in_fset1 /= in_dom. + by case: m.[x]. +have ->:= rng_set (rem x m) x (oget m.[x]). +rewrite fcardU rem_rem fsetI1 fun_if !fcard1 fcards0. +rewrite dom_set fcardUI_indep 2:fcard1. ++ by apply/fsetP=> x0; rewrite in_fsetI dom_rem !inE -andbA andNb. +rewrite StdOrder.IntOrder.ler_subl_addr; apply/StdOrder.IntOrder.ler_paddr. ++ by case: (mem (rng _) _). +apply/StdOrder.IntOrder.ler_add2r/ih/fsetP=> x0. +by rewrite dom_rem dom_m !inE; case: (x0 = x). +qed. + +lemma endo_dom_rng (m:('a,'a) fmap): + (exists x, !mem (dom m) x) => + exists x, !mem (rng m) x. +proof. +elim=> x x_notin_m. +have h: 0 < card (((dom m) `|` fset1 x) `\` (rng m)); last first. ++ by have: forall (X : 'a fset), 0 < card X => exists x, mem X x; smt. +rewrite fcardD fcardUI_indep. ++ by apply/fsetP=> x'; rewrite !inE /#. +rewrite fcard1 fsetIUl fcardUI_indep. ++ by apply/fsetP=> x'; rewrite !inE /#. +have ->: card (fset1 x `&` rng m) = if mem (rng m) x then 1 else 0. ++ smt (@FSet). +smt (leq_card_rng_dom @FSet). +qed. + +(** TODO: lots of lemmas *) +lemma rem0 (a : 'a) : rem a map0<:'a,'b> = map0. +proof. + by apply map0_eq0=>x;rewrite remP;case (x=a)=>//=;rewrite map0P. +qed. + +lemma set_eq (m:('a,'b)fmap) x y: m.[x] = Some y => m.[x<-y] = m. +proof. + by rewrite fmapP=> Hx x';rewrite getP;case (x'=x)=>//->;rewrite Hx. +qed. + +lemma map_map0 (f:'a -> 'b -> 'c): map f map0 = map0. +proof. by rewrite fmapP=> x;rewrite mapP !map0P. qed. + +lemma map_set (f:'a -> 'b -> 'c) m x y : + map f m.[x<-y] = (map f m).[x<- f x y]. +proof. + by rewrite fmapP=>z;rewrite mapP !getP;case (z=x)=>// _;rewrite mapP. +qed. + +lemma map_rem (f:'a -> 'b -> 'c) m x: map f (rem x m) = rem x (map f m). +proof. by rewrite fmapP=>z;rewrite !(mapP,remP)/#. qed. + +lemma rem_set (m:('a,'b)fmap) x y v: + rem x (m.[y<-v]) = if x = y then rem x m else (rem x m).[y<-v]. +proof. + rewrite fmapP=>z;case (x=y)=>[->|]; rewrite !(remP,getP) /#. +qed. + +lemma map_comp (f1:'a->'b->'c) (f2:'a->'c->'d) (m:('a,'b)fmap): + map f2 (map f1 m) = map (fun a b => f2 a (f1 a b)) m. +proof. by rewrite fmapP=>x;rewrite !mapP;case (m.[x]). qed. + +lemma map_id (m:('a,'b)fmap): map (fun _ b => b) m = m. +proof. by rewrite fmapP=>x;rewrite mapP;case (m.[x]). qed. From 1e2468f21a5894b4a96b76c23cccad9da869108e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Tue, 24 Apr 2018 19:03:28 +0200 Subject: [PATCH 283/525] Real : all done. Ideal : TODO. --- proof/smart_counter/Gconcl_list.ec | 1327 +++++++++++----------------- 1 file changed, 519 insertions(+), 808 deletions(-) diff --git a/proof/smart_counter/Gconcl_list.ec b/proof/smart_counter/Gconcl_list.ec index ce418ba..a0de715 100644 --- a/proof/smart_counter/Gconcl_list.ec +++ b/proof/smart_counter/Gconcl_list.ec @@ -7,6 +7,7 @@ require import DProd Dexcepted BlockSponge. require (*--*) Handle. + (*** THEORY PARAMETERS ***) (** Validity of Functionality Queries **) op valid: block list -> bool = valid_block. @@ -15,30 +16,19 @@ axiom valid_spec p: valid p => p <> []. clone export Handle as Handle0. - -module NC = { - var queries : (block list * int, block list) fmap - proc init() = { - queries <- map0; - } -}. - - module DSqueeze (F : SLCommon.DFUNCTIONALITY) = { proc init () : unit = {} proc f (p : block list, n : int) : block list = { var lres : block list <- []; var b : block <- b0; var i : int <- 0; - if (valid p /\ 0 < n) { + if (valid p) { + b <@ F.f(p); while (i < n) { i <- i + 1; - if (! (p,i) \in dom NC.queries) { - b <@ F.f(format p i); - lres <- rcons lres b; - NC.queries.[(p,i)] <- lres; - } else { - lres <- oget NC.queries.[(p,i)]; + lres <- rcons lres b; + if (i < n) { + b <@ F.f(format p (i+1)); } } } @@ -49,7 +39,6 @@ module DSqueeze (F : SLCommon.DFUNCTIONALITY) = { module (Squeeze (F : SLCommon.FUNCTIONALITY) : FUNCTIONALITY) = { proc init () : unit = { - NC.init(); C.init(); F.init(); } @@ -61,9 +50,8 @@ module (A (D : DISTINGUISHER) : SLCommon.DISTINGUISHER) (F : SLCommon.DFUNCTIONALITY) (P : DPRIMITIVE) = { proc distinguish() : bool = { var b : bool; - NC.init(); C.init(); - b <@ D(FC(DSqueeze(F)),PC(P)).distinguish(); + b <@ DRestr(D,DSqueeze(F),P).distinguish(); return b; } }. @@ -82,16 +70,6 @@ module NIndif (F : FUNCTIONALITY, P : PRIMITIVE, D : DISTINGUISHER) = { }. -module DC (D : DISTINGUISHER) (F : DFUNCTIONALITY) (P : DPRIMITIVE) = { - proc distinguish () : bool = { - var b : bool; - NC.init(); - C.init(); - b <@ D(FC(F),PC(P)).distinguish(); - return b; - } -}. - module P = Perm. @@ -111,38 +89,31 @@ section Real_Ideal. forall i, 1 <= i <= (parse l).`2 => ((parse l).`1,i) \in dom squeeze). - inductive m_p (m : (state, state) fmap) (p : (block list, state) fmap) - (q : (block list * int, block list) fmap) = + inductive m_p (m : (state, state) fmap) (p : (block list, state) fmap) = | IND_M_P of (p.[[]] = Some (b0, c0)) & (forall l, l \in dom p => forall i, 0 <= i < size l => exists b c, p.[take i l] = Some (b,c) /\ - m.[(b +^ nth witness l i, c)] = p.[take (i+1) l]) - & (forall l n, (l,n) \in dom q => - valid l /\ 0 < n /\ size (oget q.[(l,n)]) = n /\ - (forall i, 0 < i <= n => q.[(l,i)] = Some (take i (oget q.[(l,n)])))) - & (forall l n, (l,n) \in dom q => exists c, p.[format l n] = Some (last b0 (oget q.[(l,n)]),c)) - & (forall l, l \in dom p => l <> [] => exists l2, parse (l ++ l2) \in dom q). + m.[(b +^ nth witness l i, c)] = p.[take (i+1) l]). inductive INV_Real (c1 c2 : int) (m mi : (state, state) fmap) - (p : (block list, state) fmap) - (q : (block list * int, block list) fmap) = + (p : (block list, state) fmap) = | INV_real of (c1 <= c2) - & (m_p m p q) + & (m_p m p) & (invm m mi). - local lemma INV_Real_incr c1 c2 m mi p q : - INV_Real c1 c2 m mi p q => - INV_Real (c1 + 1) (c2 + 1) m mi p q. + local lemma INV_Real_incr c1 c2 m mi p : + INV_Real c1 c2 m mi p => + INV_Real (c1 + 1) (c2 + 1) m mi p. proof. by case;progress;split=>//=/#. qed. - local lemma INV_Real_addm_mi c1 c2 m mi p q x y : - INV_Real c1 c2 m mi p q => + local lemma INV_Real_addm_mi c1 c2 m mi p x y : + INV_Real c1 c2 m mi p => ! x \in dom m => ! y \in rng m => - INV_Real c1 c2 m.[x <- y] mi.[y <- x] p q. + INV_Real c1 c2 m.[x <- y] mi.[y <- x] p. proof. case=> H_c1c2 H_m_p H_invm H_x_dom H_y_rng;split=>//=. + split;case:H_m_p=>//=; @@ -162,56 +133,25 @@ section Real_Ideal. invm m mi => dom m = rng mi. proof. by move=>h;rewrite fsetP=>x;split;rewrite in_dom in_rng/#. qed. - local lemma lemma1 c1 c2 m mi p q bs i (l : block list): - INV_Real c1 c2 m mi p q => - ! (bs,i) \in dom q => - valid bs => - 0 < i => - size l = i => - (exists c, p.[format bs i] = Some (last b0 l, c)) => - (forall j, 0 < j < i => q.[(bs,j)] = Some (take j l)) => - INV_Real c1 c2 m mi p q.[(bs,i) <- l]. - proof. - move=>INV0 H_bs_n_dom H_bs_valid H0in H_size H_format_dom H_pref_quer. - split;cut[]//=H_c1c2 H_m_p H_invm:=INV0. - split;cut[]//H_mp0 H_mp1 H_mp2 H_mp3 H_mp4:=H_m_p. - + move=>l1 n1;rewrite dom_set in_fsetU1. - case((l1, n1) = (bs, i))=>[[]->>->>|H_neq]//=. - - rewrite H_bs_valid getP/= oget_some/=H_size//=;split;1:rewrite/#;move=>j []Hj0 Hj1. - rewrite getP/=;case(j=i)=>[->>|/#]//=;1:rewrite -H_size take_size//=. - rewrite getP/=;move=>H_dom;cut[]->[]->[]H_size_get/=help:=H_mp2 _ _ H_dom;split. - - by rewrite H_neq/=H_size_get. - move=> j[]hj0 hji. - rewrite !getP/=. - cut:=H_neq;case(l1=bs)=>[->>H_n1i|]//=;smt(in_dom). - + move=>m1 j;rewrite dom_set in_fsetU1 getP. - case((m1, j) = (bs, i))=>//=h H_dom. - by cut[]c ->/#:=H_mp3 _ _ H_dom. - + smt(dom_set in_fsetU1). - qed. - - local lemma all_prefixes_of_INV_real c1 c2 m mi p q: - INV_Real c1 c2 m mi p q => + local lemma all_prefixes_of_INV_real c1 c2 m mi p: + INV_Real c1 c2 m mi p => all_prefixes p. proof. - move=>[]_[]Hp0 Hmp1 _ _ _ _ l H_dom i. + move=>[]_[]Hp0 Hmp1 _ l H_dom i. smt(take_le0 take_oversize size_take take_take take_size nth_take in_dom). qed. - local lemma lemma2 c1 c2 m mi p q bl i sa sc lres: - INV_Real c1 c2 m mi p q => + local lemma lemma2 c1 c2 m mi p bl i sa sc: + INV_Real c1 c2 m mi p => 1 < i => valid bl => (sa,sc) \in dom m => ! (format bl i) \in dom p => - ! (bl, i) \in dom q => p.[format bl (i-1)] = Some (sa,sc) => - q.[(bl,i-1)] = Some lres => - INV_Real c1 c2 m mi p.[format bl i <- oget m.[(sa,sc)]] - q.[(bl,i) <- rcons lres (oget m.[(sa,sc)]).`1]. + INV_Real c1 c2 m mi p.[format bl i <- oget m.[(sa,sc)]]. proof. - move=>inv0 h1i h_valid H_dom_m H_dom_p H_dom_q H_p_val H_q_val. - split;cut[]//=_[] hmp0 hmp1 hmp2 hmp3 hmp4 hinvm:=inv0;split=>//=. + move=>inv0 h1i h_valid H_dom_m H_dom_p H_p_val. + split;cut[]//=_[] hmp0 hmp1 hinvm:=inv0;split=>//=. + by rewrite getP;smt(size_cat size_nseq size_ge0). + move=>l;rewrite dom_set in_fsetU1;case;1:smt(all_prefixes_of_INV_real getP). move=>->>j[]hj0 hjsize;rewrite getP/=. @@ -240,28 +180,6 @@ section Real_Ideal. rewrite h'' take_size/=-h 1:/# -h' take_size. rewrite nth_cat h';cut->/=:! size bl + i - 2 < size bl by smt(). by rewrite nth_nseq 1:/#;smt(Block.WRing.AddMonoid.addm0 in_dom get_oget). - + move=>bs n;rewrite dom_set in_fsetU1;case=>//=[Hdom|[]->>->>]//=;do!split=>//=. - - by cut//:=hmp2 _ _ Hdom. - - by cut//:=hmp2 _ _ Hdom. - - by cut[]H_valid[]Hn0[]H_size H_prefixe:=hmp2 _ _ Hdom;rewrite getP/=;smt(). - - cut[]H_valid[]Hn0[]H_size H_prefixe k[]hk0 hksize:=hmp2 _ _ Hdom. - rewrite!getP/=;cut->/=:!(bs = bl && n = i) by smt(). - by rewrite-H_prefixe//=;smt(in_dom). - - smt(). - - by rewrite getP/=oget_some/=size_rcons;smt(in_dom get_oget). - move=>j[]hj0 hji;rewrite!getP/=oget_some-{2}cats1 take_cat. - case(i=j)=>[->>|]//=. - - by cut<-/=:j - 1 = size lres;smt(in_dom get_oget cats1). - move=>hij;cut->/=:j<>i by smt(). - cut->:size lres = i - 1 by smt(in_dom get_oget cats1). - case(j < i - 1)=>//=hh;1:smt(in_dom get_oget cats1). - by cut->>/=: j = i - 1;smt(cats0). - + move=>bs n;rewrite dom_set in_fsetU1;case=>[Hdom|[]->>->>]. - - rewrite !getP/=;smt(in_dom). - by rewrite!getP/=oget_some last_rcons/=;smt(get_oget in_dom). - move=>l;rewrite dom_set in_fsetU1;case=>[H_dom|->>]l_n_nil. - + smt(dom_set in_fsetU1). - by exists [];rewrite cats0 parseK//= 1:/# dom_set in_fsetU1. qed. local lemma take_nseq (a : 'a) i j : @@ -289,14 +207,14 @@ section Real_Ideal. qed. - local lemma equiv_sponge (D <: DISTINGUISHER {P, NC, Redo, C, SLCommon.C}) : + local lemma equiv_sponge (D <: DISTINGUISHER {P, Redo, C, SLCommon.C}) : equiv [ GReal(A(D)).main - ~ NIndif(Squeeze(SqueezelessSponge(P)),P,DC(D)).main - : ={glob D} ==> ={res, glob D, glob P, NC.queries, C.c} /\ SLCommon.C.c{1} <= C.c{2}]. + ~ NIndif(Squeeze(SqueezelessSponge(P)),P,DRestr(D)).main + : ={glob D} ==> ={res, glob D, glob P, C.c} /\ SLCommon.C.c{1} <= C.c{2}]. proof. proc;inline*;sp;wp. - call(: ={Redo.prefixes, glob P, NC.queries, C.c} /\ - INV_Real SLCommon.C.c{1} C.c{2} Perm.m{1} Perm.mi{1} Redo.prefixes{1} NC.queries{1});auto;last first. + call(: ={Redo.prefixes, glob P, C.c} /\ + INV_Real SLCommon.C.c{1} C.c{2} Perm.m{1} Perm.mi{1} Redo.prefixes{1});auto;last first. + by progress;1:(split=>//=;1:split;smt(dom0 in_fset0 dom_set in_fsetU1 getP map0P));case:H0=>//=. + by proc;inline*;auto;sp;if;auto;sp;if;auto; smt(INV_Real_addm_mi INV_Real_incr supp_dexcepted). @@ -308,79 +226,48 @@ section Real_Ideal. case:H=>H_c H_m_p H_invm;cut<-//:=(invm_dom_rng Perm.mi{2} Perm.m{2}). by rewrite invmC. + exact INV_Real_incr. - + proc;inline*;sp;if;auto;if;auto. + + proc;inline*;sp;if;auto. swap 6;wp;sp=>/=;if;auto;last by progress;split;case:H=>//=;smt(size_ge0). - rcondt{1}1;1:auto;rcondt{2}1;1:auto;sp. - conseq(:_==> ={i,nb,bl,n,p,NC.queries, C.c,glob Redo,glob P,lres} - /\ (n,p){1} = (nb,bl){1} /\ i{1} = nb{1} - /\ format p{1} i{1} \in dom Redo.prefixes{1} - /\ INV_Real SLCommon.C.c{1} (C.c{1} + size bl{2} + i{1} - 1) - Perm.m{1} Perm.mi{1} Redo.prefixes{1} NC.queries{1});progress. - while(={i,nb,bl,n,p,NC.queries,C.c,glob Redo,glob P,lres} - /\ (n,p){1} = (nb,bl){1} /\ 0 < i{1} <= nb{1} - /\ (0 < i{1} => Some lres{1} = NC.queries{1}.[(bl{1}, i{1})]) - /\ format p{1} i{1} \in dom Redo.prefixes{1} /\ valid p{1} - /\ size lres{1} = i{1} - /\ INV_Real SLCommon.C.c{1} (C.c{1} + size bl{2} + i{1} - 1) Perm.m{1} Perm.mi{1} - Redo.prefixes{1} NC.queries{1});last first. - + sp;conseq(:_ ==> ={i,nb,bl,n,p,NC.queries,C.c,glob Redo,glob P,lres} - /\ (n,p){1} = (nb,bl){1} /\ 0 < i{1} <= nb{1} - /\ (0 < i{1} => Some lres{1} = NC.queries{1}.[(bl{1}, i{1})]) - /\ format p{1} i{1} \in dom Redo.prefixes{1} /\ size lres{1} = i{1} - /\ INV_Real SLCommon.C.c{1} (C.c{1} + size bl{2} + i{1} - 1) - Perm.m{1} Perm.mi{1} Redo.prefixes{1} NC.queries{1});1:progress=>/#. - sp;if;auto;last first. - * progress. - - by rewrite/#. - - by rewrite get_oget//. - - by cut INV0:=H;cut[]//=H_c1c2 H_m_p H_invm:=INV0;cut[]:=H_m_p;smt(in_dom). - - cut[]_[]Hmp0 Hmp1 Hmp2 Hmp3 Hmp4 Hinvm:=H. - by cut//=:=Hmp2 bl{2} 1 H4;rewrite H0/==>help;cut/=->/=:=help 1; - rewrite oget_some size_take. - by split;case:H=>//=;smt(size_ge0). - sp=>/=. - exists* Redo.prefixes{1}, SLCommon.C.c{1};elim*=>pref count;progress. - conseq(:_==> ={i0,p0,i,p,n,nb,bl,sa,lres,NC.queries,C.c,glob Redo,glob Perm} + sp. + seq 2 2:(={i,n,p,lres,nb,bl,b,glob P,glob C,glob Redo} + /\ INV_Real SLCommon.C.c{1} (C.c{2} + size bl{2}) + Perm.m{1} Perm.mi{1} Redo.prefixes{1} + /\ (n,p){1} = (nb,bl){1} /\ lres{1} = [] /\ i{1} = 0 + /\ valid p{1} + /\ Redo.prefixes.[p]{1} = Some (b,sc){1}). + + exists* Redo.prefixes{1},SLCommon.C.c{1};elim* => pref count/=. + wp;conseq(:_==> ={i0,p0,i,p,n,nb,bl,sa,lres,C.c,glob Redo,glob Perm} /\ n{1} = nb{1} /\ p{1} = bl{1} /\ p0{1} = p{1} /\ i0{1} = size p{1} /\ Redo.prefixes{1}.[take i0{1} p{1}] = Some (sa{1},sc{1}) - /\ INV_Real count C.c{1} Perm.m{1} Perm.mi{1} pref NC.queries{1} + /\ INV_Real count C.c{1} Perm.m{1} Perm.mi{1} pref /\ (forall l, l \in dom Redo.prefixes{1} => l \in dom pref \/ (exists j, 0 < j <= i0{2} /\ l = take j p{1})) /\ (forall l, l \in dom pref => pref.[l] = Redo.prefixes{1}.[l]) /\ SLCommon.C.c{1} <= count + i0{1} <= C.c{1} + i0{1} /\ (forall j, 0 <= j < i0{1} => exists b c, Redo.prefixes{1}.[take j p{1}] = Some (b,c) /\ - Perm.m{1}.[(b +^ nth witness p{1} j, c)] = Redo.prefixes{1}.[take (j+1) p{1}])); - progress. - + by rewrite/#. - + by rewrite getP/=. - + by rewrite/format/=nseq0 cats0//-take_size in_dom H6. - + cut inv0:=H7;cut[]h_c1c2[]Hmp0 Hmp1 Hmp2 Hmp3 Hmp4 Hinvm:=inv0;split=>//=. + Perm.m{1}.[(b +^ nth witness p{1} j, c)] = + Redo.prefixes{1}.[take (j+1) p{1}])); + progress. + - cut inv0:=H3;cut[]h_c1c2[]Hmp0 Hmp1 Hinvm:=inv0;split=>//=. - case:inv0;smt(size_ge0). split=>//=. - smt(in_dom). - - move=>l H_dom_R i []Hi0 Hisize;cut:=H8 l H_dom_R. + - move=>l H_dom_R i []Hi0 Hisize;cut:=H4 l H_dom_R. case(l \in dom Redo.prefixes{2})=>H_in_pref//=. * cut:=Hmp1 l H_in_pref i _;rewrite//=. - rewrite ?H9//=;1:smt(in_dom). + rewrite ?H5//=;1:smt(in_dom). case(i+1 < size l)=>h;1:smt(in_dom). by rewrite take_oversize 1:/#. move=>[]j[][]hj0 hjsize ->>. cut:=Hisize;rewrite size_take 1:/#. pose k:=if _ then _ else _;cut->>Hij{k}:k=j by rewrite/#. by rewrite!take_take!min_lel 1,2:/# nth_take 1,2:/#;smt(in_dom). - - by move=>l n;rewrite!dom_set in_fsetU1=>[][];smt(getP oget_some in_dom take_oversize). - - move=>l n;rewrite dom_set in_fsetU1 getP;case((l, n) = (bl{2}, 1))=>//=[[->>->>]|]. - * by rewrite oget_some/=/format/=nseq0 cats0-take_size H6/#. - move=>h H_dom;cut[]c:=Hmp3 _ _ H_dom;smt(in_dom). - - move=>l H_dom_R H_not_nil;rewrite dom_set. - cut:=H8 l H_dom_R;case;1:smt(in_fsetU1). - move=>[]j[][]hj0 hjsize ->>;exists(drop j bl{2}). - by rewrite cat_take_drop parse_valid//=in_fsetU1. - while( ={i0,p0,i,p,n,nb,bl,sa,sc,lres,NC.queries,C.c,glob Redo,glob Perm} + - smt(getP oget_some in_dom take_oversize). + while( ={i0,p0,i,p,n,nb,bl,sa,sc,lres,C.c,glob Redo,glob Perm} /\ n{1} = nb{1} /\ p{1} = bl{1} /\ p0{1} = p{1} /\ 0 <= i0{1} <= size p{1} /\ Redo.prefixes{1}.[take i0{1} p{1}] = Some (sa{1},sc{1}) - /\ INV_Real count C.c{1} Perm.m{1} Perm.mi{1} pref NC.queries{1} + /\ INV_Real count C.c{1} Perm.m{1} Perm.mi{1} pref /\ (forall l, l \in dom Redo.prefixes{1} => l \in dom pref \/ (exists j, 0 < j <= i0{2} /\ l = take j p{1})) /\ (forall l, l \in dom pref => pref.[l] = Redo.prefixes{1}.[l]) @@ -393,313 +280,242 @@ section Real_Ideal. exists b c, Redo.prefixes{1}.[take j p{1}] = Some (b,c) /\ Perm.m{1}.[(b +^ nth witness p{1} j, c)] = Redo.prefixes{1}.[take (j+1) p{1}]));last first. - + auto;progress. - - by rewrite /format/=nseq0 cats0. - - exact size_ge0. - - by rewrite take0;cut[]_[]->//=:=H. - - by rewrite/#. - - by cut[]->//=:=H. - - smt(all_prefixes_of_INV_real). - - by rewrite/#. - by rewrite/#. - if;auto;progress. - + by rewrite/#. - + by rewrite/#. - + smt(get_oget in_dom). - + smt(in_dom take_take take_oversize size_take). - + by rewrite/#. - + by rewrite/#. - + by rewrite/#. - + case(jh;1:rewrite/#;cut<<-:j=i0{2} by rewrite/#. - cut->>:=H7 H10 H12. - by cut[]_[]_ help _ _ _ _:=H2;cut:=help _ H12 j _;smt(take_take nth_take size_take). - sp;if;auto;progress. - + by rewrite/#. - + by rewrite/#. - + by rewrite!getP/=. - + by apply INV_Real_addm_mi=>//=;smt(supp_dexcepted). - + by move:H16;rewrite dom_set in_fsetU1/#. - + by rewrite!getP/=;smt(in_dom). - + by rewrite/#. - + by rewrite/#. - + move:H12;apply absurd=>//=_. - move:H17;rewrite dom_set in_fsetU1. - cut->/=:!take (i0{2} + 1 + 1) bl{2} = take (i0{2} + 1) bl{2} by smt(size_take). - smt(take_take size_take). - + move=>l;rewrite!dom_set in_fsetU1;case. - - move=>H_dom;cut[]:=H3 l H_dom. - * by move=>Hdom i;rewrite in_fsetU1/=; - smt(in_dom all_prefixes_of_INV_real). - move=>[]j[][]hj0 hji0->>k. - rewrite in_fsetU1 take_take;left. - cut[]:=H3 _ H_dom;smt(in_dom take_take take_le0 take0 take_oversize). - move=>->>k. - rewrite in_fsetU1 take_take;case(0 <= k)=>hk0; - last smt(in_fsetU1 in_dom take_take take_le0 take0 take_oversize). - case(k < i0{2})=>hki01; - first smt(in_fsetU1 in_dom take_take take_le0 take0 take_oversize). - by case(k <= i0{2} + 1)=>hki02;smt(in_dom). - + rewrite!getP/=oget_some. - cut->/=:!take j bl{2} = take (i0{2} + 1) bl{2} by smt(size_take). - case(j < i0{2})=>hj0;2:smt(getP oget_some size_take). - cut->/=:!take (j + 1) bl{2} = take (i0{2} + 1) bl{2} by smt(size_take). - by cut:=H9 j _;1:rewrite hj0 H16//=;smt(in_rng getP in_dom). - + by rewrite/#. - + by rewrite/#. - + by rewrite!getP/=. - + by move:H14;rewrite dom_set in_fsetU1/#. - + by rewrite!getP/=;smt(in_dom). - + by rewrite/#. - + by rewrite/#. - + move:H12;apply absurd=>//=_. - move:H15;rewrite dom_set in_fsetU1. - cut->/=:!take (i0{2} + 1 + 1) bl{2} = take (i0{2} + 1) bl{2} by smt(size_take). - by move=>h;cut:=H8 _ h (i0{2}+1);rewrite take_take/#. - + move=>l;rewrite!dom_set in_fsetU1;case. - - move=>H_dom;cut[]:=H3 l H_dom. - * by move=>Hdom i;rewrite in_fsetU1/=; - smt(in_dom all_prefixes_of_INV_real). - move=>[]j[][]hj0 hji0->>k. - rewrite in_fsetU1 take_take;left. - cut[]:=H3 _ H_dom;smt(in_dom take_take take_le0 take0 take_oversize). - move=>->>k. - rewrite in_fsetU1 take_take;case(0 <= k)=>hk0; - last smt(in_fsetU1 in_dom take_take take_le0 take0 take_oversize). - case(k < i0{2})=>hki01; - first smt(in_fsetU1 in_dom take_take take_le0 take0 take_oversize). - by case(k <= i0{2} + 1)=>hki02;smt(in_dom). - rewrite!getP/=. - cut->/=:!take j bl{2} = take (i0{2} + 1) bl{2} by smt(size_take). - by case(j < i0{2})=>hj0;smt(get_oget in_dom oget_some size_take). - sp;if;auto;last first;progress. - + rewrite/#. - + rewrite/#. - + by rewrite get_oget//=. - + rewrite in_dom;cut[]_[]_ _ _ help _ _:=H4. - by cut//=:=help bl{2} (size lres{2}+1);rewrite H7/==>[][]c->. - + cut[]_[]_ _ help _ _ _:=H4. - by cut:=help bl{2} (size lres{2}+1);rewrite H7/=H3/==>[][]_[]->//=. - + by split;cut[]//=/#:=H4. + + auto;progress. + - exact size_ge0. + - by rewrite take0;cut[]_[]->//=:=H. + - smt(). + - by cut[]->//=:=H. + - smt(all_prefixes_of_INV_real). + - smt(). + - smt(). + if;auto;progress. + - smt(). + - smt(). + - smt(get_oget in_dom). + - smt(in_dom). + - smt(). + - smt(). + - smt(all_prefixes_of_INV_real in_dom take_take size_take). + - case(j < i0{2})=>hj;1:smt(). + cut<<-/=:j = i0{2} by smt(). + cut->>:=H7 H10 H12. + cut[]_[]hmp0 hmp1 _:=H2. + cut[]b3 c3:=hmp1 _ H12 j _;1:smt(size_take). + smt(take_take nth_take size_take). + sp;if;auto;progress. + - smt(). + - smt(). + - smt(getP get_oget in_dom). + - rewrite INV_Real_addm_mi//=;smt(supp_dexcepted). + - smt(dom_set in_fsetU1). + - smt(getP in_dom). + - smt(). + - smt(). + - move:H17;apply absurd=>//=_;rewrite dom_set in_fsetU1. + pose x:=_ = _;cut->/={x}:x=false by smt(size_take). + move:H12;apply absurd=>//=. + smt(all_prefixes_of_INV_real dom_set in_fsetU1 take_take size_take). + - move=>l;rewrite!dom_set!in_fsetU1;case=>[H_dom|->>]/=;1:smt(in_fsetU1). + move=>j;rewrite in_fsetU1. + case(0 <= j)=>hj0;2:smt(in_dom take_le0). + case(j < i0{2} + 1)=>hjiS;2:smt(in_dom take_take). + rewrite take_take/min hjiS//=;left. + cut:=(take_take bl{2} j i0{2});rewrite min_lel 1:/#=><-. + smt(all_prefixes_of_INV_real in_dom). + - smt(getP get_oget in_dom dom_set in_fsetU1). + - smt(getP get_oget in_dom). + - smt(). + - smt(getP get_oget in_dom). + - smt(dom_set in_fsetU1). + - smt(getP in_dom). + - smt(). + - smt(). + - move:H15;apply absurd=>//=_;rewrite dom_set in_fsetU1. + pose x:=_ = _;cut->/={x}:x=false by smt(size_take). + move:H12;apply absurd=>//=. + cut:=take_take bl{2}(i0{2} + 1)(i0{2} + 1 + 1);rewrite min_lel 1:/# =><-h. + by rewrite (H8 _ h). + - move=>l;rewrite!dom_set!in_fsetU1;case=>[H_dom|->>]/=;1:smt(in_fsetU1). + move=>j;rewrite in_fsetU1. + case(0 <= j)=>hj0;2:smt(in_dom take_le0). + case(j < i0{2} + 1)=>hjiS;2:smt(in_dom take_take). + rewrite take_take/min hjiS//=;left. + cut:=(take_take bl{2} j i0{2});rewrite min_lel 1:/#=><-. + smt(all_prefixes_of_INV_real in_dom). + - smt(getP get_oget in_dom dom_set in_fsetU1). + sp;case(0 < n{1});last first. + - rcondf{1}1;2:rcondf{2}1;auto;1:smt(). + splitwhile{1} 1 : i + 1 < n;splitwhile{2} 1 : i + 1 < n. + rcondt{1}2;2:rcondt{2}2;auto;progress. + + while(i < n);auto. + by sp;if;auto;sp;while(i < n);auto;if;auto;sp;if;auto. + + while(i < n);auto. + by sp;if;auto;sp;while(i < n);auto;if;auto;sp;if;auto. + rcondf{1}4;2:rcondf{2}4;auto. + + while(i < n);auto;2:smt(). + by sp;if;auto;sp;while(i < n);auto;if;auto;sp;if;auto. + + while(i < n);auto;2:smt(). + by sp;if;auto;sp;while(i < n);auto;if;auto;sp;if;auto. + rcondf{1}4;2:rcondf{2}4;1,2:auto. + + while(i < n);auto;2:smt(). + by sp;if;auto;sp;while(i < n);auto;if;auto;sp;if;auto. + + while(i < n);auto;2:smt(). + by sp;if;auto;sp;while(i < n);auto;if;auto;sp;if;auto. + conseq(:_==> ={i,n,p,lres,nb,bl,b,glob P,glob C,glob Redo} + /\ INV_Real SLCommon.C.c{1} (C.c{2} + size bl{2} + i{1} - 1) + Perm.m{1} Perm.mi{1} Redo.prefixes{1} + /\ i{1} = n{1});1:smt();wp. + conseq(:_==> ={i,n,p,lres,nb,bl,b,glob P,glob C,glob Redo} + /\ INV_Real SLCommon.C.c{1} (C.c{2} + size bl{2} + i{1}) + Perm.m{1} Perm.mi{1} Redo.prefixes{1} + /\ i{1}+1 = n{1});1:smt(). + while(={i,n,p,lres,nb,bl,b,glob P,glob C,glob Redo} + /\ INV_Real SLCommon.C.c{1} (C.c{2} + size bl{2} + i{1}) + Perm.m{1} Perm.mi{1} Redo.prefixes{1} + /\ (n,p){1} = (nb,bl){1} /\ 0 < i{1}+1 <= n{1} + /\ valid p{1} + /\ (exists c2, Redo.prefixes.[format p (i+1)]{1} = Some (b,c2){1})); + last by auto;smt(nseq0 cats0). + sp;rcondt{1}1;2:rcondt{2}1;auto. sp. - splitwhile{1} 1 : i0 < size p0 - 1;splitwhile{2} 1 : i0 < size p0 - 1. + splitwhile{1} 1 : i1 < size p1 - 1;splitwhile{2} 1 : i1 < size p1 - 1. rcondt{1}2;2:rcondt{2}2;1,2:by auto; - while(i0 < size p0);auto;1:if;2:(sp;if);auto;smt(size_cat size_nseq size_ge0). + while(i1 < size p1);auto;1:if;2:(sp;if);auto;smt(size_cat size_nseq size_ge0). rcondf{1}4;2:rcondf{2}4;1,2:by auto; - seq 1 : (i0 = size p0 - 1);1:(auto; - while(i0 < size p0);auto;1:if;2:(sp;if);auto;smt(size_cat size_nseq size_ge0)); + seq 1 : (i1 = size p1 - 1);1:(auto; + while(i1 < size p1);auto;1:if;2:(sp;if);auto;smt(size_cat size_nseq size_ge0)); if;sp;2:if;auto;smt(size_cat size_nseq size_ge0). - wp;conseq(:_==> ={sa,sc,glob Redo,glob Perm} - /\ INV_Real SLCommon.C.c{1} (C.c{1} + size bl{2} + i{1} - 1) Perm.m{1} Perm.mi{1} - Redo.prefixes{1} NC.queries{1}.[(p{1}, i{1}) <- rcons lres{1} sa{1}] - /\ (format p{1} i{1} \in dom Redo.prefixes{1}));progress. + wp=>//=. + wp;conseq(:_==> ={sa0,sc0,glob Redo,glob Perm} + /\ INV_Real SLCommon.C.c{1} (C.c{1} + size bl{2} + i{1}) + Perm.m{1} Perm.mi{1} Redo.prefixes{1} + /\ (format p{1} i{1} \in dom Redo.prefixes{1}) + /\ exists (c2 : capacity), Redo.prefixes{1}.[format p{1} (i{1}+1)] = Some (sa0{1}, c2));progress. + smt(size_ge0). + smt(size_ge0). - + by rewrite getP/=. - + exact size_rcons. - seq 1 1 : (={nb,bl,n,p,p0,i,i0,lres,sa,sc,NC.queries,C.c,glob Redo,glob Perm} - /\ n{1} = nb{1} /\ p{1} = bl{1} /\ p0{1} = format p{1} i{1} - /\ 1 < i{1} <= n{1} /\ valid p{1} /\ i0{1} = size p0{1} - 1 - /\ Some lres{1} = NC.queries{1}.[(bl{1}, i{1}-1)] - /\ ! ((p{1}, i{1}) \in dom NC.queries{1}) - /\ Redo.prefixes{1}.[format p{1} (i{1}-1)] = Some (sa{1},sc{1}) - /\ INV_Real SLCommon.C.c{1} (C.c{1} + size bl{2} + i{1} - 2) Perm.m{1} Perm.mi{1} - Redo.prefixes{1} NC.queries{1}.[(bl{1}, i{1} - 1) <- lres{1}]);last first. + + smt(). + seq 1 1 : (={nb,bl,n,p,p1,i,i1,lres,sa0,sc0,C.c,glob Redo,glob Perm} + /\ n{1} = nb{1} /\ p{1} = bl{1} /\ p1{1} = format p{1} (i{1}+1) + /\ 1 <= i{1} < n{1} /\ valid p{1} /\ i1{1} = size p1{1} - 1 + /\ Redo.prefixes{1}.[format p{1} i{1}] = Some (sa0{1},sc0{1}) + /\ INV_Real SLCommon.C.c{1} (C.c{1} + size bl{2} + i{1} - 1) Perm.m{1} Perm.mi{1} + Redo.prefixes{1});last first. + if;auto;progress. - - move:H6;rewrite -addzA/=take_size=>H_dom. - move:H5;rewrite set_eq 1:H2//= =>inv0. - apply lemma1=>//=. - * split;case:inv0=>//=/#. - * smt(). - * rewrite size_rcons;cut[]//=Hc[]Hmp0 Hmp1 Hmp2 Hmp3 Hmp4 Hinvm:=inv0. - by cut:=Hmp2 bl{2} (i{2}-1);rewrite in_dom -H2/=H1/=oget_some/#. - * rewrite last_rcons;smt(get_oget in_dom). - move=>j[]hj0 hji. - cut[]//=Hc[]Hmp0 Hmp1 Hmp2 Hmp3 Hmp4 Hinvm:=inv0;cut:=Hmp2 bl{2} (i{2}-1). - rewrite in_dom -H2/=H1/=oget_some=>[][]hi10[]hsize->;1:smt(). - congr;rewrite-cats1 take_cat;case(j < size lres{2})=>//=hsize2. - cut->//=:j = size lres{2} by smt(). - by rewrite cats0 take_size. - - by move:H6;rewrite -(addzA _ _ 1)/=take_size. + - by split;case:H3=>//=;smt(). + - by rewrite in_dom H2//=. + - by move:H4;rewrite -(addzA _ _ 1)/=take_size;smt(get_oget in_dom). sp;if;auto;progress. - - move:H6 H7;rewrite!getP/=!oget_some nth_last -(addzA _ _ 1)/=take_size. + - move:H4 H5;rewrite!getP/=!oget_some nth_last -(addzA _ _ 1)/=take_size. rewrite last_cat last_nseq 1:/# Block.WRing.addr0;progress. - cut//=:=lemma2(SLCommon.C.c{1} + 1)(C.c{2} + size bl{2} + i{2} - 1) - Perm.m{2}.[(sa_R, sc{2}) <- y0L] Perm.mi{2}.[y0L <- (sa_R, sc{2})] - Redo.prefixes{2} NC.queries{2} bl{2} i{2} sa_R sc{2} lres{2}. - rewrite H/=H1/=H2/=H4/=H6/=H3/=dom_set in_fsetU1/=getP/=oget_some. - cut->->//=:y0L = (y0L.`1, y0L.`2) by smt(). + cut//=:=lemma2(SLCommon.C.c{1} + 1)(C.c{2} + size bl{2} + i{2}) + Perm.m{2}.[(sa0_R, sc0{2}) <- y2L] Perm.mi{2}.[y2L <- (sa0_R, sc0{2})] + Redo.prefixes{2} bl{2} (i{2}+1) sa0_R sc0{2}. + rewrite -(addzA _ 1)/=H1/=!dom_set!in_fsetU1/=H4/=H2/=getP/=oget_some/=. + cut->->//=:y2L = (y2L.`1, y2L.`2);1,-1:smt(). rewrite INV_Real_addm_mi//=;2:smt(supp_dexcepted). - by cut:=H5;rewrite set_eq 1:H2//==>hinv0;split;case:hinv0=>//=/#. - - by rewrite dom_set in_fsetU1//=-(addzA _ _ 1)/=take_size. - - move:H6 H7;rewrite nth_last -(addzA _ _ 1)/=take_size. + by cut:=H3=>hinv0;split;case:hinv0=>//=/#. + - by rewrite dom_set in_fsetU1//=-(addzA _ _ 1)/=take_size in_dom H2. + - by rewrite!getP-(addzA _ _ 1)/=take_size/=;smt(). + - move:H4 H5;rewrite nth_last -(addzA _ _ 1)/=take_size. rewrite last_cat last_nseq 1:/# Block.WRing.addr0;progress. - pose a:=(_, _);cut->/={a}:a = oget Perm.m{2}.[(sa_R, sc{2})] by smt(). - apply lemma2=>//=;first cut:=H5;rewrite set_eq 1:H2//==>hinv0;split;case:hinv0=>//=/#. - rewrite H2//=. - - by rewrite dom_set in_fsetU1//=-(addzA _ _ 1)/=take_size. + pose a:=(_, _);cut->/={a}:a = oget Perm.m{2}.[(sa0_R, sc0{2})] by smt(). + apply lemma2=>//=;first cut:=H3=>hinv0;split;case:hinv0=>//=/#. + smt(). + smt(). + - by rewrite dom_set in_fsetU1//=-(addzA _ _ 1)/=take_size;smt(in_dom). + - by rewrite!getP-(addzA _ _ 1)/=take_size/=;smt(). alias{1} 1 pref = Redo.prefixes;sp;alias{1} 1 count = SLCommon.C.c. alias{1} 1 pm = Perm.m;sp;alias{1} 1 pmi = Perm.mi;sp. - conseq(:_==> ={nb,bl,n,p,p0,i,i0,lres,sa,sc,NC.queries,C.c,glob Redo,glob Perm} + conseq(:_==> ={nb,bl,n,p,p1,i,i1,lres,sa0,sc0,C.c,glob Redo,glob Perm} /\ pmi{1} = Perm.mi{1} /\ pm{1} = Perm.m{1} /\ pref{1} = Redo.prefixes{1} /\ SLCommon.C.c{1} = count{1} - /\ n{1} = nb{1} /\ p{1} = bl{1} /\ p0{1} = format p{1} i{1} - /\ i0{1} = size p0{1} - 1 - /\ Redo.prefixes{1}.[format p{1} (i0{1} - size p{1} + 1)] = - Some (sa{1}, sc{1}));1:smt(size_cat size_nseq set_eq in_dom). - splitwhile{1}1:i0 < size p;splitwhile{2}1:i0 < size p. - while(={nb,bl,n,p,p0,i,i0,lres,sa,sc,NC.queries, C.c,glob Redo,glob Perm} - /\ pmi{1} = Perm.mi{1} /\ pm{1} = Perm.m{1} /\ 0 < i{1} + /\ n{1} = nb{1} /\ p{1} = bl{1} /\ p1{1} = format p{1} (i{1}+1) + /\ i1{1} = size p1{1} - 1 + /\ Redo.prefixes{1}.[format p{1} (i1{1} - size p{1} + 1)] = + Some (sa0{1}, sc0{1}));progress. + + smt(size_cat size_nseq set_eq in_dom). + + move:H8;rewrite size_cat size_nseq-(addzA _ 1 (-1))/=/max H0/=. + by pose x:= Int.(+) _ _;cut->/={x}: x = i_R + 1 by smt(). + + move:H8;rewrite size_cat size_nseq-(addzA _ 1 (-1))/=/max H0/=;smt(). + splitwhile{1}1:i1 < size p;splitwhile{2}1:i1 < size p. + while(={nb,bl,n,p,p1,i,i1,lres,sa0,sc0,C.c,glob Redo,glob Perm} + /\ INV_Real SLCommon.C.c{1} (C.c{1} + size bl{2} + i{1} - 1) + Perm.m{1} Perm.mi{1} Redo.prefixes{1} + /\ pmi{1} = Perm.mi{1} /\ pm{1} = Perm.m{1} /\ pref{1} = Redo.prefixes{1} /\ SLCommon.C.c{1} = count{1} - /\ n{1} = nb{1} /\ p{1} = bl{1} /\ p0{1} = format p{1} i{1} - /\ size p{1} <= i0{1} <= size p0{1} - 1 /\ valid p{1} - /\ (format p{1} (i{1}-1) \in dom Redo.prefixes{1}) - /\ INV_Real SLCommon.C.c{1} (C.c{1} + size bl{2} + i{1} - 2) - Perm.m{1} Perm.mi{1} Redo.prefixes{1} NC.queries{1} - /\ Redo.prefixes{1}.[format p{1} (i0{1} - size p{1} + 1)] = Some (sa{1}, sc{1}) ). + /\ n{1} = nb{1} /\ p{1} = bl{1} /\ p1{1} = format p{1} (i{1}+1) + /\ (format p{1} i{1} \in dom Redo.prefixes{1}) + /\ size p{1} <= i1{1} <= size p1{1} - 1 /\ valid p{1} + /\ Redo.prefixes{1}.[format p{1} (i1{1} - size p{1} + 1)] = + Some (sa0{1}, sc0{1})). + rcondt{1}1;2:rcondt{2}1;auto;progress. - - rewrite take_format;1,2:smt(size_cat size_ge0 size_nseq). - cut->/=:! i0{m} + 1 <= size bl{m} by smt(). - cut:=take_format bl{m} (i{m}-1) (i0{m} + 1) _ _;1,2:smt(size_cat size_ge0 size_nseq). - cut->/=<-:! i0{m} + 1 <= size bl{m} by smt(). - by cut/#:=all_prefixes_of_INV_real. - - rewrite take_format;1,2:smt(size_cat size_ge0 size_nseq). - cut->/=:! i0{hr} + 1 <= size bl{hr} by smt(). - cut:=take_format bl{hr} (i{hr}-1) (i0{hr} + 1) _ _;1,2:smt(size_cat size_ge0 size_nseq). - cut->/=<-:! i0{hr} + 1 <= size bl{hr} by smt(). - by cut/#:=all_prefixes_of_INV_real. - - smt(). - - smt(). - - rewrite take_format//=;1:smt(size_cat size_ge0 size_nseq). - cut->/=:!i0{2} + 1 <= size bl{2} by smt(). - rewrite get_oget 2:/#. - cut:=take_format bl{2} (i{2}-1) (i0{2} + 1) _ _;1,2:smt(size_cat size_ge0 size_nseq). - cut->/=:!i0{2} + 1 <= size bl{2} by smt(). - by cut/#:=all_prefixes_of_INV_real. - conseq(:_==> ={nb,bl,n,p,p0,i,i0,lres,sa,sc,NC.queries, C.c,glob Redo,glob Perm} - /\ pmi{1} = Perm.mi{1} /\ pm{1} = Perm.m{1} /\ 0 < i{1} + + cut->:take (i1{m} + 1) (format bl{m} (i{m} + 1)) = + take (i1{m} + 1) (format bl{m} i{m});2:smt(all_prefixes_of_INV_real). + smt(take_format size_ge0 size_eq0 valid_spec size_cat size_nseq). + + cut->:take (i1{hr} + 1) (format bl{hr} (i{hr} + 1)) = + take (i1{hr} + 1) (format bl{hr} i{hr});2:smt(all_prefixes_of_INV_real). + smt(take_format size_ge0 size_eq0 valid_spec size_cat size_nseq). + + smt(). + + smt(size_cat size_nseq). + + rewrite get_oget;2:smt(take_format size_ge0 size_eq0 valid_spec size_cat size_nseq). + cut->:format bl{2} (i1{2} + 1 - size bl{2} + 1) = + take (i1{2} + 1) (format bl{2} i{2}) + by smt(take_format size_ge0 size_eq0 valid_spec size_cat size_nseq). + smt(all_prefixes_of_INV_real). + conseq(:_==> ={nb,bl,n,p,p1,i,i1,lres,sa0,sc0,C.c,glob Redo,glob Perm} + /\ INV_Real SLCommon.C.c{1} (C.c{1} + size bl{2} + i{1} - 1) + Perm.m{1} Perm.mi{1} Redo.prefixes{1} + /\ pmi{1} = Perm.mi{1} /\ pm{1} = Perm.m{1} /\ pref{1} = Redo.prefixes{1} /\ SLCommon.C.c{1} = count{1} - /\ n{1} = nb{1} /\ p{1} = bl{1} /\ p0{1} = format p{1} i{1} - /\ size p{1} = i0{1} /\ valid p{1} - /\ (format p{1} (i{1}-1) \in dom Redo.prefixes{1}) - /\ INV_Real SLCommon.C.c{1} (C.c{1} + size bl{2} + i{1} - 2) Perm.m{1} Perm.mi{1} - Redo.prefixes{1} NC.queries{1} - /\ Redo.prefixes{1}.[take i0{1} p{1}] = Some (sa{1}, sc{1})); - progress. - + smt(size_cat size_ge0 size_nseq). - + by rewrite /format/=nseq0 cats0 -take_size;exact H12. - + smt(). - while( ={nb,bl,n,p,p0,i,i0,lres,sa,sc,NC.queries, C.c,glob Redo,glob Perm} - /\ pmi{1} = Perm.mi{1} /\ pm{1} = Perm.m{1} /\ 1 < i{1} + /\ n{1} = nb{1} /\ p{1} = bl{1} /\ p1{1} = format p{1} (i{1}+1) + /\ (format p{1} i{1} \in dom Redo.prefixes{1}) + /\ i1{1} = size p{1} /\ valid p{1} + /\ Redo.prefixes{1}.[take i1{1} p{1}] = Some (sa0{1}, sc0{1})); + 1:smt(size_cat size_nseq nseq0 cats0 take_size). + while(={nb,bl,n,p,p1,i,i1,lres,sa0,sc0,C.c,glob Redo,glob Perm} + /\ INV_Real SLCommon.C.c{1} (C.c{1} + size bl{2} + i{1} - 1) + Perm.m{1} Perm.mi{1} Redo.prefixes{1} + /\ pmi{1} = Perm.mi{1} /\ pm{1} = Perm.m{1} /\ pref{1} = Redo.prefixes{1} /\ SLCommon.C.c{1} = count{1} - /\ n{1} = nb{1} /\ p{1} = bl{1} /\ p0{1} = format p{1} i{1} - /\ 0 <= i0{1} <= size p{1} /\ valid p{1} - /\ (format p{1} (i{1}-1) \in dom Redo.prefixes{1}) - /\ INV_Real SLCommon.C.c{1} (C.c{1} + size bl{2} + i{1} - 2) Perm.m{1} Perm.mi{1} - Redo.prefixes{1} NC.queries{1} - /\ Redo.prefixes{1}.[take i0{1} p{1}] = Some (sa{1}, sc{1}) );last first. + /\ n{1} = nb{1} /\ p{1} = bl{1} /\ p1{1} = format p{1} (i{1}+1) + /\ (format p{1} i{1} \in dom Redo.prefixes{1}) + /\ 0 <= i1{1} <= size p{1} /\ valid p{1} + /\ Redo.prefixes{1}.[take i1{1} p{1}] = Some (sa0{1}, sc0{1}));last first. + auto;progress. - - smt(size_ge0). - - smt(size_ge0). - smt(). - - smt(set_eq in_dom). - - by rewrite take0;case:H4=>[]_[]//=. - - smt(size_cat size_nseq size_ge0). - - smt(size_cat size_nseq size_ge0). + - cut[]_[]:=H;smt(in_dom). + - exact size_ge0. + - cut[]_[]:=H;smt(in_dom take0). + - smt(size_cat size_nseq). rcondt{1}1;2:rcondt{2}1;auto;progress. - + cut->:take (i0{m} + 1) (format bl{m} i{m}) = - take (i0{m} + 1) (format bl{m} (i{m} - 1)) - by rewrite!take_format//=;smt(size_cat size_ge0 size_nseq). - by cut/#:=all_prefixes_of_INV_real. - + cut->:take (i0{hr} + 1) (format bl{hr} i{hr}) = - take (i0{hr} + 1) (format bl{hr} (i{hr} - 1)) - by rewrite!take_format//=;smt(size_cat size_ge0 size_nseq). - by cut/#:=all_prefixes_of_INV_real. - + smt(). - + smt(). - cut->:take (i0{2} + 1) (format bl{2} i{2}) = - take (i0{2} + 1) (format bl{2} (i{2} - 1)) - by rewrite!take_format//=;smt(size_cat size_ge0 size_nseq). - cut->:take (i0{2} + 1) bl{2} = take (i0{2} + 1) (format bl{2} (i{2} - 1)) - by rewrite take_format;smt(size_cat size_ge0 size_nseq). - by cut:=all_prefixes_of_INV_real _ _ _ _ _ _ H4 _ H3;smt(in_dom). - qed. - - - - local lemma lemma3 c c' m mi p q bl i sa sc lres: - INV_Real c c' m mi p q => - 0 < i => - q.[(bl,i)] = Some lres => - p.[format bl i] = Some (sa,sc) => - (bl,i+1) \in dom q => - q.[(bl,i+1)] = Some (rcons lres (oget m.[(sa,sc)]).`1). - proof. - move=>inv0 H_i0 H_q_i H_p_i H_dom_iS. - cut[]_[]_ hmp1 hmp2 hmp3 _ _:=inv0. - cut[]c2 h2:=hmp3 _ _ H_dom_iS. - cut:=hmp1 (format bl (i+1));rewrite in_dom h2/==>help. - cut:=help (size (format bl i)) _;1:smt(size_ge0 size_cat size_nseq). - move=>[]b3 c3;rewrite!take_format;..4:smt(size_ge0 size_cat size_nseq). - cut->/=:!size (format bl i) + 1 <= size bl by smt(size_cat size_nseq size_ge0). - rewrite nth_cat. - cut->/=:!size (format bl i) < size bl by smt(size_cat size_ge0). - rewrite nth_nseq 1:size_cat 1:size_nseq 1:/#. - pose x:=if _ then _ else _;cut->/={x}:x = format bl i. - + rewrite/x;case(i = 1)=>//=[->>|hi1]. - - by rewrite/format/=nseq0 cats0//=take_size. - by rewrite size_cat size_nseq/#. - pose x:=List.size _ + 1 - List.size _ + 1;cut->/={x}:x=i+1 - by rewrite/x size_cat size_nseq;smt(). - rewrite H_p_i h2=>[]/=[][]->>->>. - rewrite Block.WRing.addr0=>H_pm;rewrite H_pm/=oget_some. - cut[]_[]_[]H_size H:=hmp2 _ _ H_dom_iS. - cut H_q_i':=H i _;1:smt(). - cut:=H (i+1) _;1:smt(). - rewrite (take_nth witness)1:/# =>H_q_iS. - rewrite H_q_iS/=oget_some last_rcons;congr. - by cut:=H_q_i';rewrite H_q_i/=. + - cut->:take (i1{m} + 1) (format bl{m} (i{m} + 1)) = + take (i1{m} + 1) (format bl{m} i{m});2:smt(all_prefixes_of_INV_real). + smt(take_format size_ge0 size_eq0 valid_spec size_cat size_nseq). + - cut->:take (i1{hr} + 1) (format bl{hr} (i{hr} + 1)) = + take (i1{hr} + 1) (format bl{hr} i{hr});2:smt(all_prefixes_of_INV_real). + smt(take_format size_ge0 size_eq0 valid_spec size_cat size_nseq). + - smt(). + - smt(). + - cut->:take (i1{2} + 1) (format bl{2} (i{2} + 1)) = + take (i1{2} + 1) (format bl{2} i{2}) + by smt(take_format size_ge0 size_eq0 valid_spec size_cat size_nseq). + cut->:take (i1{2} + 1) bl{2} = + take (i1{2} + 1) (format bl{2} i{2}) + by smt(take_cat take_le0 cats0). + rewrite get_oget//=;smt(all_prefixes_of_INV_real). qed. - local lemma lemma3' c c' m mi p q bl i sa sc lres: - INV_Real c c' m mi p q => + local lemma lemma4 c c' m mi p bl i sa sc: + INV_Real c c' m mi p => 0 < i => - q.[(bl,i)] = Some lres => p.[format bl i] = Some (sa,sc) => - (bl,i+1) \in dom q => - q.[(bl,i+1)] = Some (rcons lres (oget p.[format bl (i+1)]).`1). - proof. - move=>inv0 H_i0 H_q_i H_p_i H_dom_iS. - cut[]_[]_ hmp1 hmp2 hmp3 _ _:=inv0. - cut->:=lemma3 _ _ _ _ _ _ _ _ _ _ _ inv0 H_i0 H_q_i H_p_i H_dom_iS;congr;congr. - cut[]b3 c3[]:=hmp1 (format bl (i+1)) _ (size (format bl i)) _. - + rewrite in_dom;smt(). - + rewrite!size_cat!size_nseq;smt(size_ge0). - rewrite nth_cat nth_nseq;1:smt(size_cat size_nseq size_ge0). - cut->/=:!size (format bl i) < size bl by smt(size_cat size_nseq size_ge0). - rewrite Block.WRing.addr0 !take_format 1,3:/#;1,2:smt(size_cat size_nseq size_ge0). - cut->/=:!size (format bl i) + 1 <= size bl by smt(size_cat size_nseq size_ge0). - cut->:size (format bl i) + 1 - size bl = i by smt(size_cat size_nseq). - case(size (format bl i) <= size bl)=>//=Hi;last first. - + cut->:size (format bl i) - size bl + 1 = i by smt(size_cat size_nseq). - by rewrite H_p_i/==>[][]->>->>->//. - cut->>/=:i = 1 by smt(size_cat size_nseq). - by cut:=H_p_i;rewrite /(format bl 1)/=nseq0 cats0 take_size=>->/=[]->>->>->//. - qed. - - - local lemma lemma4 c c' m mi p q bl i sa sc lres: - INV_Real c c' m mi p q => - 0 < i => - q.[(bl,i)] = Some lres => - p.[format bl i] = Some (sa,sc) => - (bl,i+1) \in dom q => + format bl (i+1) \in dom p => p.[format bl (i+1)] = m.[(sa,sc)]. proof. - move=>inv0 H_i0 H_q_i H_p_i H_dom_iS. - cut[]_[]_ hmp1 hmp2 hmp3 _ _:=inv0. - cut[]c2 h2:=hmp3 _ _ H_dom_iS. - cut:=hmp1 (format bl (i+1));rewrite in_dom h2/==>help. + move=>inv0 H_i0 H_p_i H_dom_iS. + cut[]_[]_ hmp1 _ :=inv0. + cut:=hmp1 (format bl (i+1)) H_dom_iS=>help. cut:=help (size (format bl i)) _;1:smt(size_ge0 size_cat size_nseq). move=>[]b3 c3;rewrite!take_format;..4:smt(size_ge0 size_cat size_nseq). cut->/=:!size (format bl i) + 1 <= size bl by smt(size_cat size_nseq size_ge0). @@ -712,88 +528,49 @@ section Real_Ideal. by rewrite size_cat size_nseq/#. pose x:=List.size _ + 1 - List.size _ + 1;cut->/={x}:x=i+1 by rewrite/x size_cat size_nseq;smt(). - rewrite H_p_i h2=>[]/=[][]->>->>. - rewrite Block.WRing.addr0=>H_pm;rewrite H_pm/=. - cut[]_[]_[]H_size H:=hmp2 _ _ H_dom_iS. - cut H_q_i':=H i _;1:smt(). - cut:=H (i+1) _;1:smt(). - by rewrite (take_nth witness)1:/# =>H_q_iS. + rewrite H_p_i=>[]/=[][]->>->>. + by rewrite Block.WRing.addr0=>H_pm;rewrite H_pm/=. qed. - - - local lemma lemma4' c c' m mi p q bl i sa sc lres: - INV_Real c c' m mi p q => - 0 < i => - q.[(bl,i)] = Some lres => - p.[format bl i] = Some (sa,sc) => - format bl (i+1) \in dom p => - p.[format bl (i+1)] = m.[(sa,sc)]. + local lemma lemma3 c1 c2 m mi p bl b (sa:block) sc: + INV_Real c1 c2 m mi p => + (sa +^ b,sc) \in dom m => + ! rcons bl b \in dom p => + p.[bl] = Some (sa,sc) => + INV_Real c1 c2 m mi p.[rcons bl b <- oget m.[(sa +^ b,sc)]]. proof. - move=>inv0 H_i0 H_q_i H_p_i H_p_dom_iS. - cut[]_[]_ hmp1 hmp2 hmp3 hmp4 _:=inv0. - cut[]:=hmp4 _ H_p_dom_iS _. - + smt(size_ge0 size_eq0 size_cat valid_spec size_nseq). - move=>l;pose pn := parse (format bl (i + 1) ++ l). - cut->/=H_dom_iS:pn = (pn.`1,pn.`2) by smt(). - cut[]c2:=hmp3 _ _ H_dom_iS. - cut->/=:format pn.`1 pn.`2 = (format bl (i + 1) ++ l) by smt(parseK formatK). - move:H_dom_iS;cut->/={pn}H_dom_iS H_p_iS_l:(pn.`1, pn.`2) = parse (format bl (i + 1) ++ l) by smt(). - cut help:=hmp1 (format bl (i + 1) ++ l) _;1:by rewrite in_dom H_p_iS_l. - cut[]b3 c3:=help (size (format bl i)) _. - + smt(size_ge0 size_cat size_nseq). - rewrite take_cat take_format//=1:/#. - + smt(size_ge0 size_cat size_nseq). - cut->/=:size (format bl i) < size (format bl (i + 1)) by smt(size_cat size_nseq). - pose x:=if _ then _ else _;cut->/={x}:x = format bl i. - + rewrite/x;rewrite size_cat size_nseq max_ler 1:/#. - case(size bl + (i - 1) <= size bl)=>//=[h|/#]. - by cut->>/=:i=1;smt(take_size nseq0 cats0). - rewrite H_p_i/==>[][][]->>->>. - rewrite nth_cat/=. - cut->/=:size (format bl i) < size (format bl (i + 1)) by smt(size_cat size_nseq). - rewrite nth_cat. - cut->/=:!size (format bl i) < size bl by smt(size_cat size_nseq size_ge0). - rewrite nth_nseq 1:size_cat 1:size_nseq 1:/#. - rewrite take_cat. - cut->/=:size (format bl i) + 1 = size (format bl (i + 1)) by smt(size_cat size_nseq). - rewrite take0 cats0 Block.WRing.addr0 =>->//=. + move=>inv0 H_dom_m H_dom_p H_p_val. + split;cut[]//=_[] hmp0 hmp1 hinvm:=inv0;split=>//=. + + by rewrite getP;smt(size_cat size_nseq size_ge0). + + move=>l;rewrite dom_set in_fsetU1;case;1:smt(all_prefixes_of_INV_real getP). + move=>->>j[]hj0 hjsize;rewrite getP/=. + cut:=hmp1 bl;rewrite in_dom H_p_val/==>help. + cut->/=:!take j (rcons bl b) = rcons bl b by smt(size_take). + move:hjsize;rewrite size_rcons=>hjsize. + rewrite-cats1 !take_cat. + pose x := if _ then _ else _;cut->/={x}: x = take j bl by smt(take_le0 cats0 take_size). + rewrite nth_cat. + case(j < size bl)=>//=hj;last first. + + cut->>/=:j = size bl by smt(). + by rewrite take_size H_p_val/=;exists sa sc=>//=;smt(getP get_oget). + cut->/=:j + 1 - size bl <= 0 by smt(). + rewrite cats0. + pose x := if _ then _ else _;cut->/={x}: x = take (j+1) bl by smt(take_le0 cats0 take_size). + cut:=hmp1 bl;rewrite in_dom H_p_val/==>hep. + cut:=hep j _;rewrite//=;smt(getP size_cat size_take). qed. - module QBlockSponge (P : DPRIMITIVE) : FUNCTIONALITY = { - proc init() = {} - proc f (p : block list, n : int) : block list = { - var r : block list <- []; - var i : int <- 0; - var (b,c) <- (b0,c0); - if (valid p /\ 0 < n) { - while (i < size p) { - (b,c) <@ P.f(b +^ nth witness p i, c); - i <- i + 1; - } - i <- 1; - r <- rcons r b; - while (i < n) { - (b,c) <@ P.f(b, c); - r <- rcons r b; - i <- i + 1; - } - } - return r; - } - }. - local lemma squeeze_squeezeless (D <: DISTINGUISHER {P, NC, Redo, C, SLCommon.C}) : - equiv [ NIndif(Squeeze(SqueezelessSponge(P)),P,DC(D)).main - ~ RealIndif(QBlockSponge,P,DRestr(D)).main + local lemma squeeze_squeezeless (D <: DISTINGUISHER {P, Redo, C, SLCommon.C}) : + equiv [ NIndif(Squeeze(SqueezelessSponge(P)),P,DRestr(D)).main + ~ RealIndif(Sponge,P,DRestr(D)).main : ={glob D} ==> ={res, glob P, glob D, C.c}]. proof. proc;inline*;sp;wp. call(: ={glob Perm,C.c} - /\ INV_Real 0 C.c{1} Perm.m{1} Perm.mi{1} Redo.prefixes{1} - NC.queries{1});auto;last first. - + progress. + /\ INV_Real 0 C.c{1} Perm.m{1} Perm.mi{1} Redo.prefixes{1});auto;last first. + + progress. split=>//=;1:split=>//=;smt(getP dom0 map0P in_fset0 dom_set in_fsetU1). + proc;inline*;auto;sp;if;auto;sp;if;auto;progress. - by rewrite INV_Real_addm_mi;2..:smt(supp_dexcepted);split;case:H=>//=;smt(). @@ -803,308 +580,242 @@ section Real_Ideal. * case:H;smt(invm_dom_rng invmC supp_dexcepted). case:H;smt(invm_dom_rng invmC supp_dexcepted). - by split;case:H=>//=;smt(). - proc;inline*;sp;auto;if;auto;if;auto;sp;if;auto; + proc;inline*;sp;auto;if;auto;sp;if;auto; last by progress;split;case:H=>//=;smt(size_ge0). - rcondt{1}1;auto;sp. - seq 1 3 : (={glob Perm, C.c, i, p, n, bl, nb} /\ nb{1} = n{1} - /\ (lres){1} = (r0){2} /\ bl{1} = p{2} - /\ NC.queries{1}.[(p{1},i{1})] = Some lres{1} - /\ valid p{1} /\ i{1} <= n{1} /\ i{1} = 1 - /\ INV_Real 0 C.c{1} Perm.m{1} Perm.mi{1} Redo.prefixes{1} - NC.queries{1}.[(p{1}, i{1}) <- lres{1}] - /\ Redo.prefixes{1}.[p{1}] = Some (b,c){2});last first. - + auto=>/=. - while(={glob Perm, C.c, i, p, n, bl, nb} /\ nb{1} = n{1} - /\ (lres){1} = (r0){2} /\ bl{1} = p{2} /\ 0 < i{2} <= n{1} - /\ valid p{1} - /\ NC.queries{1}.[(p{1},i{1})] = Some lres{1} - /\ INV_Real 0 C.c{1} Perm.m{1} Perm.mi{1} Redo.prefixes{1} - NC.queries{1} - /\ Redo.prefixes{1}.[format p{1} i{1}] = Some (b{2},c{2}));last first. - - auto;progress. - * cut:=H2;rewrite set_eq//=. - * by rewrite/format/=nseq0 cats0 H3//=. - sp;if{1};last first. - - rcondf{2}1;auto;progress. - * cut:=H3;rewrite in_dom=>inv0. - cut[]_[]_ hmp1 hmp2 hmp3 _ _:=inv0. - cut:=hmp1 (format p{hr} (i{hr}+1));rewrite in_dom//=. - cut[]c3 h3:=hmp3 _ _ H7;rewrite h3/= => help. - cut[]b4 c4:=help (size p{hr} + i{hr} - 1) _;1:smt(size_cat size_nseq size_ge0). - rewrite !take_format 1,3:/#;1,2:smt(size_cat size_nseq size_ge0). - rewrite nth_cat/=nth_nseq/=1:/# -(addzA _ (-1) 1)/=. - cut->/=:!size p{hr} + i{hr} <= size p{hr} by smt(). - cut->/=:!size p{hr} + i{hr} - 1 < size p{hr} by smt(). - pose x:=if _ then _ else _;cut->/={x}:x = format p{hr} i{hr}. - + rewrite/x;case(i{hr}=1)=>[->>|/#]//=. - by rewrite -(addzA _ 1 (-1))/= take_size/format/=nseq0 cats0. - by rewrite Block.WRing.addr0 (addzAC _ i{hr})/=H4/==>[][][]->>->>->;rewrite h3. - * cut:=H3;move=>inv0. - by cut->:=lemma3 _ _ _ _ _ _ _ _ _ _ _ inv0 H H2 H4 H7. - (* * cut:=H3;rewrite //==>inv0. *) - (* by cut->:=lemma3 _ _ _ _ _ _ _ _ _ _ _ inv0 H H2 H4 H7. *) - * smt(). - * smt(). - * smt(get_oget in_dom). - * cut:=H3;rewrite //==>inv0. - cut->:=lemma4 _ _ _ _ _ _ _ _ _ _ _ inv0 H H2 H4 H7;rewrite get_oget 2:/#. - cut[]_[]_ hmp1 hmp2 hmp3 _ _:=inv0. - cut:=hmp1 (format p{2} (i{2}+1));rewrite in_dom//=. - cut[]c3 h3:=hmp3 _ _ H7;rewrite h3/= => help. - cut[]b4 c4:=help (size p{2} + i{2} - 1) _;1:smt(size_cat size_nseq size_ge0). - rewrite !take_format 1,3:/#;1,2:smt(size_cat size_nseq size_ge0). - rewrite nth_cat/=nth_nseq/=1:/# -(addzA _ (-1) 1)/=. - cut->/=:!size p{2} + i{2} <= size p{2} by smt(). - cut->/=:!size p{2} + i{2} - 1 < size p{2} by smt(). - pose x:=if _ then _ else _;cut->/={x}:x = format p{2} i{2}. - + rewrite/x;case(i{2}=1)=>[->>|/#]//=. - by rewrite -(addzA _ 1 (-1))/= take_size/format/=nseq0 cats0. - by rewrite in_dom Block.WRing.addr0 (addzAC _ i{2})/=H4/==>[][][]->>->>->;rewrite h3. - swap{2}4-3;wp;sp=>/=. - splitwhile{1}1:i0 < size p0 - 1. - rcondt{1}2;2:rcondf{1}4;auto. - + while(0 <= i0 <= size p0 -1);last by auto;smt(size_cat size_nseq size_ge0). - if;auto;1:smt(size_cat size_nseq size_ge0). - by sp;if;auto;smt(size_cat size_nseq size_ge0). - + seq 1 : (i0 = size p0 - 1). - - while(0 <= i0 <= size p0 -1);last by auto;smt(size_cat size_nseq size_ge0). - if;auto;1:smt(size_cat size_nseq size_ge0). - by sp;if;auto;smt(size_cat size_nseq size_ge0). - by if;auto;1:smt();sp;if;auto;smt(). - seq 1 0 : (={glob P, C.c, i, p, n, bl, nb} - /\ nb{1} = n{1} /\ lres{1} = r0{2} /\ bl{1} = p{1} - /\ x0{2} = (sa,sc){1} /\ p0{1} = format p{1} i{1} - /\ i0{1} = size p{1} + i{1} - 2 /\ 1 < i{1} <= n{1} - /\ valid p{1} /\ 0 < n{1} - /\ ! ((p{1}, i{1}) \in dom NC.queries{1}) - /\ NC.queries{1}.[(p{1},i{1}-1)] = Some lres{1} - /\ Redo.prefixes{1}.[format p{1} (i{1}-1)] = Some (sa,sc){1} + sp. + seq 2 1 : (={glob P, i, n, C.c,sa,sc} + /\ b{1} = sa{2} /\ Redo.prefixes.[p]{1} = Some (sa,sc){2} + /\ lres{1} = z0{2} /\ i{1} = 0 /\ valid p{1} + /\ INV_Real 0 C.c{1} Perm.m{1} Perm.mi{1} Redo.prefixes{1}). + + conseq(:_==> ={glob P, n, C.c,sa,sc} /\ b{1} = sa{2} /\ i0{1} = size p0{1} + /\ Redo.prefixes{1}.[take i0{1} p0{1}] = Some (sa{1}, sc{1}) + /\ lres{1} = z0{2} /\ xs{2} = drop i0{1} p0{1} + /\ INV_Real 0 C.c{1} Perm.m{1} Perm.mi{1} Redo.prefixes{1});1:smt(take_size drop_size). + wp;while(={glob P, n, C.c,sa,sc} /\ sa{1} = sa{2} /\ sc{1} = sc{2} + /\ 0 <= i0{1} <= size p0{1} + /\ Redo.prefixes{1}.[take i0{1} p0{1}] = Some (sa{1}, sc{1}) + /\ lres{1} = z0{2} /\ xs{2} = drop i0{1} p0{1} + /\ INV_Real 0 C.c{1} Perm.m{1} Perm.mi{1} Redo.prefixes{1}). + + if{1};auto. + + sp;rcondf{2}1;auto;progress. + + rewrite head_nth nth_drop//=. + cut[]_[]_ hmp1 _ :=H2;cut:=hmp1 _ H5 i0{m} _;1:smt(size_take). + move=>[]b3 c3;rewrite!take_take!nth_take 1,2:/# !min_lel//= 1:/#. + rewrite H1=>//=[][][]->>->>. + by rewrite nth_onth (onth_nth b0)//=;smt(in_dom). + + rewrite head_nth nth_drop//=. + cut[]_[]_ hmp1 _ :=H2;cut:=hmp1 _ H5 i0{1} _;1:smt(size_take). + move=>[]b3 c3;rewrite!take_take!nth_take 1,2:/# !min_lel//= 1:/#. + rewrite H1=>//=[][][]->>->>. + by rewrite nth_onth (onth_nth b0)//=;smt(in_dom). + + rewrite head_nth nth_drop//=. + cut[]_[]_ hmp1 _ :=H2;cut:=hmp1 _ H5 i0{1} _;1:smt(size_take). + move=>[]b3 c3;rewrite!take_take!nth_take 1,2:/# !min_lel//= 1:/#. + rewrite H1=>//=[][][]->>->>. + by rewrite nth_onth (onth_nth b0)//=;smt(in_dom). + + rewrite head_nth nth_drop//=. + cut[]_[]_ hmp1 _ :=H2;cut:=hmp1 _ H5 i0{1} _;1:smt(size_take). + move=>[]b3 c3;rewrite!take_take!nth_take 1,2:/# !min_lel//= 1:/#. + rewrite H1=>//=[][][]->>->>. + by rewrite nth_onth (onth_nth b0)//=;smt(in_dom). + + rewrite head_nth nth_drop//=. + cut[]_[]_ hmp1 _ :=H2;cut:=hmp1 _ H5 i0{1} _;1:smt(size_take). + move=>[]b3 c3;rewrite!take_take!nth_take 1,2:/# !min_lel//= 1:/#. + rewrite H1=>//=[][][]->>->>. + by rewrite nth_onth (onth_nth b0)//=;smt(in_dom). + + smt(). + + smt(). + + smt(get_oget). + + smt(behead_drop drop_add). + + smt(size_drop size_eq0). + + smt(size_drop size_eq0). + sp=>//=. + if;auto;progress. + + by rewrite head_nth nth_drop //=nth_onth (onth_nth witness)//=. + + by move:H6;rewrite head_nth nth_drop //=nth_onth (onth_nth witness)//=. + + by rewrite head_nth nth_drop //=nth_onth (onth_nth b0)//=. + + by rewrite head_nth nth_drop //=nth_onth (onth_nth b0)//=. + + by rewrite head_nth nth_drop //=nth_onth (onth_nth b0)//=. + + by rewrite head_nth nth_drop //=nth_onth (onth_nth b0)//=. + + by rewrite head_nth nth_drop //=nth_onth (onth_nth b0)//=. + + by rewrite head_nth nth_drop //=nth_onth (onth_nth b0)//=. + + smt(). + + smt(). + + by rewrite getP/=. + + by rewrite behead_drop drop_add. + + rewrite!getP/=oget_some. + cut:=lemma3 0 C.c{2}Perm.m{2}.[(sa{2} +^ nth witness p0{1} i0{1}, sc{2}) <- yL] + Perm.mi{2}.[yL <- (sa{2} +^ nth witness p0{1} i0{1}, sc{2})] Redo.prefixes{1} + (take i0{1} p0{1}) (nth witness p0{1} i0{1}) sa{2} sc{2}. + rewrite!dom_set!in_fsetU1/=-take_nth//=H5/=H1/=getP/=oget_some. + cut->->//=:(yL.`1, yL.`2) = yL by smt(). + rewrite INV_Real_addm_mi=>//=;smt(supp_dexcepted). + + smt(size_drop size_eq0). + + smt(size_drop size_eq0). + + by rewrite head_nth nth_drop //=nth_onth (onth_nth b0)//=. + + by rewrite head_nth nth_drop //=nth_onth (onth_nth b0)//=. + + by rewrite head_nth nth_drop //=nth_onth (onth_nth b0)//=. + + by rewrite head_nth nth_drop //=nth_onth (onth_nth b0)//=. + + smt(). + + smt(). + + by rewrite getP. + + by rewrite behead_drop drop_add. + + rewrite(take_nth witness)//=. + cut:=lemma3 0 C.c{2} Perm.m{2} Perm.mi{2} Redo.prefixes{1} + (take i0{1} p0{1}) (nth witness p0{1} i0{1}) sa{2} sc{2}. + by rewrite-take_nth//= H5/=H1/=H2/=H6/=;smt(). + + smt(size_drop size_eq0). + + smt(size_drop size_eq0). + auto;progress. + + exact size_ge0. + + by rewrite take0;cut[]_[]->:=H. + + by rewrite drop0. + + split;case:H=>//=;smt(size_ge0). + + smt(size_ge0 size_eq0). + + smt(size_ge0 size_eq0). + + smt(). + case(0 < n{1});last by rcondf{1}1;2:rcondf{2}1;auto;progress. + splitwhile{1} 1 : i + 1 < n;splitwhile{2} 1 : i + 1 < n. + rcondt{1}2;2:rcondt{2}2;auto;progress. + + by while(i ={i,n,glob P,C.c} /\ lres{1} = z0{2} /\ b{1} = sa{2} + /\ INV_Real 0 C.c{1} Perm.m{1} Perm.mi{1} Redo.prefixes{1} + /\ Redo.prefixes{1}.[format p{1} (i{1}+1)] = Some (sa,sc){2});progress. + while(={i,n,glob P,C.c} /\ lres{1} = z0{2} /\ b{1} = sa{2} /\ 0 <= i{1} < n{1} + /\ INV_Real 0 C.c{1} Perm.m{1} Perm.mi{1} Redo.prefixes{1} /\ valid p{1} + /\ Redo.prefixes{1}.[format p{1} (i{1}+1)] = Some (sa,sc){2});last first. + + auto;1:smt(nseq0 cats0). + sp;if;auto;sp. + splitwhile{1}1: i1 < size p1 - 1. + rcondt{1}2;2:rcondf{1}4;1,2:auto. + + while(i1 < size p1);auto;2:smt(size_cat size_nseq size_ge0 size_eq0 valid_spec). + by if;auto;1:smt();sp;if;auto;progress;smt(). + + seq 1 : (i1 = size p1 - 1). + - while(i1 < size p1);auto;2:smt(size_cat size_nseq size_ge0 size_eq0 valid_spec). + by if;auto;1:smt();sp;if;auto;progress;smt(). + by if;auto;1:smt();sp;if;auto;smt(). + seq 1 0 : (={i,n,glob P,C.c} /\ x0{2} = (sa{2}, sc{2}) /\ 0 < i{1} < n{1} + /\ p1{1} = format p{1} (i{1} + 1) /\ (sa0,sc0){1} = x0{2} + /\ i1{1} = size p{1} + i{1} - 1 /\ lres{1} = z0{2} /\ valid p{1} + /\ Redo.prefixes{1}.[format p{1} i{1}] = Some (sa{2}, sc{2}) /\ INV_Real 0 C.c{1} Perm.m{1} Perm.mi{1} Redo.prefixes{1} - NC.queries{1});last first. - + if{1}. - - wp;rcondf{2}1. - * auto;progress. - cut[]_[]_ hmp1 hmp2 hmp3 hmp4 _:=H6. - cut:=hmp4 _ H7 _. - + rewrite-size_eq0 size_take;1:smt(size_ge0). - by rewrite size_cat size_nseq;smt(valid_spec size_eq0 size_ge0). - move=>[]l;rewrite take_oversize;1:rewrite size_cat size_nseq/#. - move=>H_dom. - pose x:= (parse (format p{hr} i{hr} ++ l)).`1. - pose y:= (parse (format p{hr} i{hr} ++ l)).`2. - cut[]:=hmp3 x y _;1:smt();cut->/=:format x y = (format p{hr} i{hr} ++ l) by smt(formatK). - cut->/={x y}c H_dom_c:(x, y) = (parse (format p{hr} i{hr} ++ l)) by smt(). - cut help:=hmp1 (format p{hr} i{hr} ++ l) _;1:by rewrite in_dom H_dom_c. - cut:=help (size (format p{hr} i{hr})-1) _;1:split. - - smt(size_cat size_nseq size_ge0 size_eq0 valid_spec). - - move=>_;rewrite !size_cat. - cut:size l <> 0;2:smt(size_ge0). - by rewrite size_eq0;smt(in_dom cats0 formatK parseK). - move=>[]b2 c2;rewrite take_cat nth_cat/=. - cut->/=:size (format p{hr} i{hr}) - 1 < size (format p{hr} i{hr}) by smt(). - rewrite nth_cat nth_nseq. - - smt(size_cat size_nseq size_ge0 size_eq0 valid_spec). - cut->/=:!size (format p{hr} i{hr}) - 1 < size p{hr} - by smt(size_cat size_nseq size_ge0 size_eq0 valid_spec). - rewrite take_format 1:/#. - - smt(size_cat size_nseq size_ge0 size_eq0 valid_spec). - pose x:=if _ then _ else _;cut->/={x}:x = format p{hr} (i{hr}-1). - - rewrite /x;rewrite size_cat size_nseq/=/max/=. - cut->/=:0 < i{hr} - 1 by smt(). - case(size p{hr} + (i{hr} - 1) - 1 <= size p{hr})=>//=[h|/#]. - cut->>/=:i{hr}=2 by smt(). - smt(take_size nseq0 cats0). - rewrite H5=>//=[][][]->>->>;rewrite Block.WRing.addr0 take_cat. - rewrite-(addzA _ _ 1)//=take0 cats0=>h. - cut:=help (size (format p{hr} i{hr})) _. - - cut:size l <> 0;2:smt(size_ge0 size_cat). - by rewrite size_eq0;smt(in_dom cats0 formatK parseK). - by move=>[]b5 c5;rewrite take_cat take_size/=take0 cats0 in_dom h=>[][]->//=. - auto;progress. - * move:H7;rewrite take_oversize;1:rewrite size_cat size_nseq/#. - move=>H_dom. - cut:=lemma4' _ _ _ _ _ _ _ _ _ _ _ H6 _ H4 H5 _;1,2:smt(). - by rewrite-(addzA _ _ 1)/==>->//=. - (* * move:H7;rewrite take_oversize;1:rewrite size_cat size_nseq/#. *) - (* move=>H_dom. *) - (* cut:=lemma4' _ _ _ _ _ _ _ _ _ _ _ H6 _ H4 H5 _;1,2:smt(). *) - (* by rewrite-(addzA _ _ 1)/==>->//=. *) - * smt(). - * move:H7;rewrite take_oversize;1:rewrite size_cat size_nseq/#. - move=>H_dom. - cut:=lemma4' _ _ _ _ _ _ _ _ _ _ _ H6 _ H4 H5 _;1,2:smt(). - by rewrite-(addzA _ _ 1)/==>->//=;rewrite getP/=. - * move:H7;rewrite take_oversize;1:rewrite size_cat size_nseq/#. - cut H_i_size:i{2}-1 = size r0{2}. - + cut[]_[]_ hmp1 hmp2 hmp3 hmp4 _:=H6. - cut:=hmp2 p{2} (i{2}-1);rewrite in_dom H4/==>[][]_[]_[]. - by rewrite oget_some=>->/=/#. - move=>H_l;apply(lemma1 _ _ _ _ _ _ _ _ _ H6 H3 H1 _ _ _ _);1:smt(). - + by rewrite size_rcons-H_i_size;ring. - + by rewrite get_oget//last_rcons oget_some/#. - move=>j[]hj0 hji;rewrite -cats1 take_cat-H_i_size. - pose x:=if _ then _ else _;cut->/={x}:x = take j r0{2}. - - rewrite /x;case(j//=h;cut->>/=:j=i{2}-1 by smt(). - by rewrite H_i_size cats0 take_size. - cut[]_[]_ hmp1 hmp2 hmp3 hmp4 _:=H6. - by cut:=hmp2 p{2} (i{2}-1);rewrite in_dom H4//=oget_some/#. - move:H7;rewrite take_oversize;1:rewrite size_cat size_nseq/#. - move=>H_dom. - cut:=lemma4' _ _ _ _ _ _ _ _ _ _ _ H6 _ H4 H5 _;1,2:smt(). - by rewrite-(addzA _ _ 1)/==><-//=;smt(get_oget in_dom). - sp;wp;if;auto;progress. - - move:H8;rewrite nth_cat;cut->/=:!size p{2} + i{2} - 2 < size p{2} by smt(). - rewrite nth_nseq;1:smt(size_ge0 valid_spec size_eq0 size_cat size_nseq). - by rewrite Block.WRing.addr0. - - rewrite nth_cat;cut->/=:!size p{2} + i{2} - 2 < size p{2} by smt(). - rewrite nth_nseq;1:smt(size_ge0 valid_spec size_eq0 size_cat size_nseq). - by rewrite Block.WRing.addr0. - - rewrite nth_cat;cut->/=:!size p{2} + i{2} - 2 < size p{2} by smt(). - rewrite nth_nseq;1:smt(size_ge0 valid_spec size_eq0 size_cat size_nseq). - by rewrite Block.WRing.addr0. - - rewrite nth_cat;cut->/=:!size p{2} + i{2} - 2 < size p{2} by smt(). - rewrite nth_nseq;1:smt(size_ge0 valid_spec size_eq0 size_cat size_nseq). - by rewrite Block.WRing.addr0. - - rewrite nth_cat;cut->/=:!size p{2} + i{2} - 2 < size p{2} by smt(). - rewrite nth_nseq;1:smt(size_ge0 valid_spec size_eq0 size_cat size_nseq). - by rewrite Block.WRing.addr0. - (* - rewrite nth_cat;cut->/=:!size p{2} + i{2} - 2 < size p{2} by smt(). *) - (* rewrite nth_nseq;1:smt(size_ge0 valid_spec size_eq0 size_cat size_nseq). *) - (* by rewrite Block.WRing.addr0. *) - - smt(). - - rewrite nth_cat;cut->/=:!size p{2} + i{2} - 2 < size p{2} by smt(). - rewrite nth_nseq;1:smt(size_ge0 valid_spec size_eq0 size_cat size_nseq). - by rewrite Block.WRing.addr0 getP/=. - - move:H7 H8;rewrite take_oversize;1:rewrite size_cat size_nseq/#. - rewrite nth_cat;cut->/=:!size p{2} + i{2} - 2 < size p{2} by smt(). - rewrite nth_nseq;1:smt(size_ge0 valid_spec size_eq0 size_cat size_nseq). - rewrite Block.WRing.addr0/==>H_dom h;rewrite getP/=oget_some. - cut//=:=lemma2 0 C.c{2}Perm.m{2}.[(sa_L, sc{1}) <- yL] - Perm.mi{2}.[yL <- (sa_L, sc{1})]Redo.prefixes{1} - NC.queries{1}p{2}i{2}sa_L sc{1} r0{2} _ _ _ _ _ _ _ _;rewrite//=. - * by apply INV_Real_addm_mi=>//=;1:smt(supp_dexcepted). - * by rewrite dom_set in_fsetU1. - by rewrite!getP/=oget_some/#. - - move:H8;rewrite nth_cat;cut->/=:!size p{2} + i{2} - 2 < size p{2} by smt(). - rewrite nth_nseq;1:smt(size_ge0 valid_spec size_eq0 size_cat size_nseq). - by rewrite Block.WRing.addr0 !getP/=oget_some/=take_oversize//=size_cat size_nseq/#. - - move:H8;rewrite nth_cat;cut->/=:!size p{2} + i{2} - 2 < size p{2} by smt(). - rewrite nth_nseq;1:smt(size_ge0 valid_spec size_eq0 size_cat size_nseq). - by rewrite Block.WRing.addr0. - (* - move:H8;rewrite nth_cat;cut->/=:!size p{2} + i{2} - 2 < size p{2} by smt(). *) - (* rewrite nth_nseq;1:smt(size_ge0 valid_spec size_eq0 size_cat size_nseq). *) - (* by rewrite Block.WRing.addr0. *) - - smt(). - - move:H8;rewrite nth_cat;cut->/=:!size p{2} + i{2} - 2 < size p{2} by smt(). - rewrite nth_nseq;1:smt(size_ge0 valid_spec size_eq0 size_cat size_nseq). - by rewrite Block.WRing.addr0 getP/=. - - move:H7 H8;rewrite take_oversize;1:rewrite size_cat size_nseq/#. - rewrite nth_cat;cut->/=:!size p{2} + i{2} - 2 < size p{2} by smt(). - rewrite nth_nseq;1:smt(size_ge0 valid_spec size_eq0 size_cat size_nseq). - rewrite Block.WRing.addr0/==>H_dom h. - by cut//=:=lemma2 0 C.c{2}Perm.m{2}Perm.mi{2}Redo.prefixes{1} - NC.queries{1}p{2}i{2}sa_L sc{1} r0{2} _ _ _ _ _ _ _ _;rewrite//=/#. - move:H8;rewrite nth_cat;cut->/=:!size p{2} + i{2} - 2 < size p{2} by smt(). - rewrite nth_nseq;1:smt(size_ge0 valid_spec size_eq0 size_cat size_nseq). - by rewrite Block.WRing.addr0 getP/=take_oversize//=size_cat size_nseq/#. - alias{1} 1 pref = Redo.prefixes;sp. - conseq(:_==> ={glob P} /\ i0{1} = size p{1} + i{1} - 2 /\ Redo.prefixes{1} = pref{1} - /\ Redo.prefixes{1}.[take i0{1} (format p{1} (i{1} - 1))] = Some (sa{1}, sc{1}));progress. - + by cut:=H8;rewrite take_oversize 2:-(addzA _ 1)/=2:H4//=size_cat size_nseq;smt(). - + by cut:=H8;rewrite take_oversize 2:-(addzA _ 1)/=2:H4//=size_cat size_nseq;smt(). + /\ valid p{1});last first. + + if{1};auto. + + rcondf{2}1;auto;progress. + + move:H5;rewrite take_oversize;1:rewrite size_cat size_nseq max_ler/#. + move=>H_dom;rewrite in_dom. + by cut<-:=lemma4 _ _ _ _ _ _ _ _ _ H3 H H2 H_dom;rewrite-in_dom. + + move:H5;rewrite take_oversize;1:rewrite size_cat size_nseq max_ler/#;move=>H_dom. + by cut:=lemma4 _ _ _ _ _ _ _ _ _ H3 H H2 H_dom;smt(in_dom). + + smt(). + + move:H5;rewrite take_oversize;1:rewrite size_cat size_nseq max_ler/#;move=>H_dom. + by cut:=lemma4 _ _ _ _ _ _ _ _ _ H3 H H2 H_dom;smt(in_dom). + sp;if;auto;progress. + + move:H6;rewrite nth_cat nth_nseq;1:smt(size_ge0). + cut->/=:!size p{1} + i{2} - 1 < size p{1} by smt(). + by rewrite Block.WRing.addr0. + + move:H6;rewrite nth_cat nth_nseq;1:smt(size_ge0). + cut->/=:!size p{1} + i{2} - 1 < size p{1} by smt(). + by rewrite Block.WRing.addr0. + + move:H6;rewrite nth_cat nth_nseq;1:smt(size_ge0). + cut->/=:!size p{1} + i{2} - 1 < size p{1} by smt(). + by rewrite Block.WRing.addr0. + + move:H6;rewrite nth_cat nth_nseq;1:smt(size_ge0). + cut->/=:!size p{1} + i{2} - 1 < size p{1} by smt(). + by rewrite Block.WRing.addr0. + + move:H6;rewrite nth_cat nth_nseq;1:smt(size_ge0). + cut->/=:!size p{1} + i{2} - 1 < size p{1} by smt(). + by rewrite Block.WRing.addr0. + smt(). + + move:H5 H6;rewrite nth_cat nth_nseq;1:smt(size_ge0). + cut->/=:!size p{1} + i{2} - 1 < size p{1} by smt(). + rewrite Block.WRing.addr0 !getP/=oget_some take_oversize;1:rewrite size_cat size_nseq/#. + move=>H_dom_iS H_dom_p. + cut:=lemma2 0 C.c{2} Perm.m{2}.[(sa{2}, sc{2}) <- y0L] + Perm.mi{2}.[y0L <- (sa{2}, sc{2})] Redo.prefixes{1} + p{1} (i{2}+1) sa{2} sc{2} _ _ H4 _ H_dom_iS. + + by rewrite INV_Real_addm_mi//=;smt(supp_dexcepted). + + smt(). + + by rewrite dom_set in_fsetU1. + by rewrite!getP/=oget_some-(addzA)/=H2/=;smt(). + + by rewrite!getP/=take_oversize//=size_cat size_nseq/#. + + rewrite nth_cat;cut->/=:! size p{1} + i{2} - 1 < size p{1} by smt(). + by rewrite nth_nseq//=1:/# Block.WRing.addr0. + smt(). + + move:H5 H6;rewrite take_oversize 1:size_cat 1:size_nseq 1:/#. + rewrite nth_cat;cut->/=:! size p{1} + i{2} - 1 < size p{1} by smt(). + rewrite nth_nseq//=1:/# Block.WRing.addr0 =>h1 h2. + by cut:=lemma2 0 C.c{2} Perm.m{2} Perm.mi{2} Redo.prefixes{1} + p{1} (i{2}+1) sa{2} sc{2} H3 _ H1 h2 h1;smt(). + + move:H5 H6;rewrite take_oversize 1:size_cat 1:size_nseq 1:/#. + rewrite nth_cat;cut->/=:! size p{1} + i{2} - 1 < size p{1} by smt(). + by rewrite nth_nseq//=1:/# Block.WRing.addr0 !getP//=. + alias{1} 1 pref = Redo.prefixes;sp. + conseq(:_==> ={glob P} + /\ p1{1} = format p{1} (i{1} + 1) /\ pref{1} = Redo.prefixes{1} + /\ i1{1} = size p1{1} - 1 + /\ Redo.prefixes{1}.[take i1{1} p1{1}] = Some (sa0{1}, sc0{1}) + /\ INV_Real 0 C.c{1} Perm.m{1} Perm.mi{1} Redo.prefixes{1});progress. + + smt(). + + move:H9;rewrite take_format/=1:/#;1:smt(size_ge0 size_cat size_nseq). + pose x := if _ then _ else _ ;cut->/={x}: x = format p{1} (i_R+1). + + rewrite/x size_cat size_nseq-(addzA _ 1 (-1))/=!max_ler 1:/#-(addzA _ _ (-1))-(addzA _ _ (-1))/=. + case(size p{1} + i_R <= size p{1})=>//=h;2:smt(size_ge0 size_cat size_nseq). + cut->>/=:i_R = 0 by smt(). + by rewrite take_size/format nseq0 cats0. + by rewrite H3/==>[][]->>->>. + + move:H9;rewrite take_format/=1:/#;1:smt(size_ge0 size_cat size_nseq). + pose x := if _ then _ else _ ;cut->/={x}: x = format p{1} (i_R+1). + + rewrite/x size_cat size_nseq-(addzA _ 1 (-1))/=!max_ler 1:/#-(addzA _ _ (-1))-(addzA _ _ (-1))/=. + case(size p{1} + i_R <= size p{1})=>//=h;2:smt(size_ge0 size_cat size_nseq). + cut->>/=:i_R = 0 by smt(). + by rewrite take_size/format nseq0 cats0. + by rewrite H3/=. + + by rewrite size_cat size_nseq;smt(). + while{1}(={glob P} /\ 0 <= i1{1} <= size p1{1} - 1 /\ 0 < i{1} < n{1} + /\ p1{1} = format p{1} (i{1} + 1) /\ pref{1} = Redo.prefixes{1} + /\ format p{1} i{1} \in dom pref{1} + /\ Redo.prefixes{1}.[take i1{1} p1{1}] = Some (sa0{1}, sc0{1}) + /\ INV_Real 0 C.c{1} Perm.m{1} Perm.mi{1} Redo.prefixes{1}) + (size p1{1}-i1{1}-1);auto;last first. + + progress. + + smt(size_cat size_nseq size_ge0 size_eq0 valid_spec). + smt(). - + smt(dom_set in_fsetU1). - + by cut:=H8;rewrite take_oversize 2:-(addzA _ 1)//=size_cat size_nseq;smt(). - while{1}( ={glob P} /\ 0 <= i0{1} <= size p{1} + i{1} - 2 - /\ 1 < i{1} <= n{1} - /\ Redo.prefixes{1} = pref{1} /\ p0{1} = format p{1} i{1} - /\ format p{1} (i{1}-1) \in dom Redo.prefixes{1} - /\ INV_Real 0 C.c{1} Perm.m{1} Perm.mi{1} Redo.prefixes{1} NC.queries{1} - /\ Redo.prefixes{1}.[take i0{1} (format p{1} (i{1} - 1))] = - Some (sa{1}, sc{1}))(size p0{1} - 1 - i0{1});auto;last first. - + auto;progress. - + smt(size_ge0). - + smt(in_dom). - + smt(). - + smt(in_dom). - + cut[]_[]:=H3;smt(take0 in_dom). - + smt(). - + smt(size_cat size_nseq). - rcondt 1;auto;progress. - + cut->:take (i0{hr} + 1) (format p{hr} i{hr}) = - take (i0{hr} + 1) (format p{hr} (i{hr}-1)); - last by smt(in_dom all_prefixes_of_INV_real). - by rewrite!take_format//= 1,3:/#;1,2:smt(size_cat size_nseq). + + by rewrite in_dom H3. + + by rewrite take0;cut[]_[]:=H1. + smt(). - + smt(size_cat size_nseq). - + cut->:take (i0{hr} + 1) (format p{hr} i{hr}) = - take (i0{hr} + 1) (format p{hr} (i{hr}-1)); - last by smt(in_dom all_prefixes_of_INV_real). - by rewrite!take_format//= 1,3:/#;1,2:smt(size_cat size_nseq). - smt(). - - if{1};last first. - + wp=>//=. - conseq(:_==> ={glob P} /\ INV_Real 0 C.c{1} Perm.m{1} Perm.mi{1} - Redo.prefixes{1} NC.queries{1} - /\ i{2} = size p{2} - /\ Redo.prefixes{1}.[take i{2} p{2}] = Some (b,c){2} - /\ (0 < i{2} => Perm.m.[x]{2} = Some (b,c){2}));progress. - - cut[]_[]_ hmp1 hmp2 hmp3 hmp4 _:=H5. - cut/=[]_[]H_size H':=hmp2 _ _ H4. - cut/=[]c3:=hmp3 _ _ H4;rewrite/format/=nseq0 cats0-{1}take_size H6/==>[][]H_b ->>//=. - rewrite get_oget//=;apply (eq_from_nth b0)=>//=i. - rewrite H_size=>h;cut->>/=:i = 0 by smt(). - cut->:0 = size (oget NC.queries{1}.[(bl{2}, 1)]) - 1 by rewrite H_size. - by rewrite nth_last H_b. - (* - cut[]_[]_ hmp1 hmp2 hmp3 hmp4 _:=H5. *) - (* cut/=[]_[]H_size H':=hmp2 _ _ H4. *) - (* cut/=[]c3:=hmp3 _ _ H4;rewrite/format/=nseq0 cats0-{1}take_size H6/==>[][]H_b ->>//=. *) - (* rewrite get_oget//=;apply (eq_from_nth b0)=>//=i. *) - (* rewrite H_size=>h;cut->>/=:i = 0 by smt(). *) - (* cut->:0 = size (oget NC.queries{2}.[(bl{2}, 1)]) - 1 by rewrite H_size. *) - (* by rewrite nth_last H_b. *) - - smt(get_oget in_dom). - - smt(). - - smt(set_eq get_oget in_dom). - - smt(take_size). - while{2}(={glob P} /\ INV_Real 0 C.c{1} Perm.m{1} Perm.mi{1} - Redo.prefixes{1} NC.queries{1} - /\ 0 <= i{2} <= size p{2} - /\ ((p{2}, 1) \in dom NC.queries{1}) - /\ Redo.prefixes{1}.[take i{2} p{2}] = Some (b,c){2} - /\ (0 < i{2} => Perm.m.[x]{2} = Some (b,c){2}))(size p{2}-i{2}); - progress;last first. - - auto;progress. - * split;case:H=>//=;smt(size_ge0 size_eq0 valid_spec). - * exact size_ge0. - * by rewrite take0;cut[]_[]->//:=H. - * smt(). - * smt(). - sp;rcondf 1;auto;progress. - - cut[]_[]_ hmp1 hmp2 hmp3 _ _:=H. - cut[]c3:=hmp3 p{hr} 1 H2;rewrite/(format _ 1)/=nseq0 cats0=> H_pref. - cut:=hmp1 p{hr};rewrite 2!in_dom H_pref/==>help. - by cut[]b4 c4 []:=help i{hr} _;1:smt();rewrite H3/==>[][]->>->>->; - smt(in_dom all_prefixes_of_INV_real). - - smt(). - - smt(). - - cut[]_[]_ hmp1 hmp2 hmp3 _ _:=H. - cut[]c3:=hmp3 p{hr} 1 H2;rewrite/(format _ 1)/=nseq0 cats0=> H_pref. - cut:=hmp1 p{hr};rewrite in_dom H_pref/==>help. - by cut[]b4 c4 []:=help i{hr} _;1:smt();rewrite H3/==>[][]->>->>->; - smt(in_dom all_prefixes_of_INV_real get_oget). - - cut[]_[]_ hmp1 hmp2 hmp3 _ _:=H. - cut[]c3:=hmp3 p{hr} 1 H2;rewrite/(format _ 1)/=nseq0 cats0=> H_pref. - cut:=hmp1 p{hr};rewrite in_dom H_pref/==>help. - by cut[]b4 c4 []:=help i{hr} _;1:smt();rewrite H3/==>[][]->>->>->; - smt(in_dom all_prefixes_of_INV_real get_oget). - - smt(). - sp;wp. - (* TODO *) + + smt(). + rcondt 1;auto;progress. + + cut->:take (i1{hr} + 1) (format p{hr} (i{hr} + 1)) = + take (i1{hr} + 1) (format p{hr} i{hr});2:smt(all_prefixes_of_INV_real in_dom). + rewrite!take_format;smt(valid_spec size_ge0 size_eq0 size_cat size_nseq). + + smt(). + + smt(valid_spec size_ge0 size_eq0 size_cat size_nseq). + + cut->:take (i1{hr} + 1) (format p{hr} (i{hr} + 1)) = + take (i1{hr} + 1) (format p{hr} i{hr});2:smt(all_prefixes_of_INV_real in_dom). + rewrite!take_format;smt(valid_spec size_ge0 size_eq0 size_cat size_nseq). + smt(). qed. + + + local lemma pr_real (D <: DISTINGUISHER{SLCommon.C, C, Perm, Redo}) &m : + Pr [ GReal(A(D)).main() @ &m : res ] = + Pr [ RealIndif(Sponge,P,DRestr(D)).main() @ &m : res ]. + proof. + cut->:Pr [ RealIndif(Sponge, P, DRestr(D)).main() @ &m : res ] = + Pr [ NIndif(Squeeze(SqueezelessSponge(P)),P,DRestr(D)).main() @ &m : res ]. + + by rewrite eq_sym;byequiv (squeeze_squeezeless D)=>//=. + by byequiv (equiv_sponge D)=>//=. + qed. + + (* TODO : Ideal *) local lemma equiv_ideal (IF <: FUNCTIONALITY{DSqueeze,C}) @@ -1263,4 +974,4 @@ search max_size. apply (eq_trans _ Pr[G4(F.LRO).distinguish() @ &m : res]);1:by byequiv (F.RO_LRO_D G4). by byequiv G4_Ideal. qed. - + From eacc82b749a64438548270509bbfbce89d198f7e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Thu, 26 Apr 2018 17:06:38 +0200 Subject: [PATCH 284/525] Ideal : Step 1 : todo, step 2 : 70%, step 3 : todo --- proof/smart_counter/Gconcl_list.ec | 364 ++++++++++++++++++++++++++--- 1 file changed, 338 insertions(+), 26 deletions(-) diff --git a/proof/smart_counter/Gconcl_list.ec b/proof/smart_counter/Gconcl_list.ec index a0de715..aaae1e9 100644 --- a/proof/smart_counter/Gconcl_list.ec +++ b/proof/smart_counter/Gconcl_list.ec @@ -1,19 +1,16 @@ pragma -oldip. require import Core Int Real RealExtra StdOrder Ring StdBigop IntExtra. require import List FSet NewFMap Utils Common SLCommon RndO FelTactic Mu_mem. -require import DProd Dexcepted BlockSponge. +require import DProd Dexcepted BlockSponge Gconcl. (*...*) import Capacity IntOrder Bigreal RealOrder BRA. require (*--*) Handle. - - (*** THEORY PARAMETERS ***) (** Validity of Functionality Queries **) op valid: block list -> bool = valid_block. axiom valid_spec p: valid p => p <> []. - clone export Handle as Handle0. module DSqueeze (F : SLCommon.DFUNCTIONALITY) = { @@ -74,7 +71,6 @@ module NIndif (F : FUNCTIONALITY, P : PRIMITIVE, D : DISTINGUISHER) = { module P = Perm. - section Real_Ideal. @@ -210,24 +206,38 @@ section Real_Ideal. local lemma equiv_sponge (D <: DISTINGUISHER {P, Redo, C, SLCommon.C}) : equiv [ GReal(A(D)).main ~ NIndif(Squeeze(SqueezelessSponge(P)),P,DRestr(D)).main - : ={glob D} ==> ={res, glob D, glob P, C.c} /\ SLCommon.C.c{1} <= C.c{2}]. + : ={glob D} ==> ={res, glob D, glob P, C.c} /\ SLCommon.C.c{1} <= C.c{2} <= max_size]. proof. proc;inline*;sp;wp. - call(: ={Redo.prefixes, glob P, C.c} /\ + call(: ={Redo.prefixes, glob P, C.c} /\ C.c{1} <= max_size /\ INV_Real SLCommon.C.c{1} C.c{2} Perm.m{1} Perm.mi{1} Redo.prefixes{1});auto;last first. - + by progress;1:(split=>//=;1:split;smt(dom0 in_fset0 dom_set in_fsetU1 getP map0P));case:H0=>//=. + + progress. + + exact max_ge0. + + by split=>//=;1:split;smt(dom0 in_fset0 dom_set in_fsetU1 getP map0P). + by case:H2=>//=. + by proc;inline*;auto;sp;if;auto;sp;if;auto; smt(INV_Real_addm_mi INV_Real_incr supp_dexcepted). + proc;inline*;auto;sp;if;auto;sp;if;auto;progress. + apply INV_Real_incr=>//=. apply INV_Real_addm_mi=>//=. - + case:H=>H_c H_m_p H_invm;rewrite (invm_dom_rng _ _ H_invm)//=. - by move:H2;rewrite supp_dexcepted. - case:H=>H_c H_m_p H_invm;cut<-//:=(invm_dom_rng Perm.mi{2} Perm.m{2}). + + case:H0=>H_c H_m_p H_invm;rewrite (invm_dom_rng _ _ H_invm)//=. + by move:H3;rewrite supp_dexcepted. + case:H0=>H_c H_m_p H_invm;cut<-//:=(invm_dom_rng Perm.mi{2} Perm.m{2}). by rewrite invmC. + exact INV_Real_incr. + proc;inline*;sp;if;auto. - swap 6;wp;sp=>/=;if;auto;last by progress;split;case:H=>//=;smt(size_ge0). + swap 6;wp;sp=>/=;if;auto;last by progress;split;case:H0=>//=;smt(size_ge0). + conseq(: p{2} = bl{2} /\ n{2} = nb{2} /\ lres{2} = [] /\ b{2} = b0 /\ + i{2} = 0 /\ p{1} = bl{1} /\ n{1} = nb{1} /\ lres{1} = [] /\ b{1} = b0 /\ + i{1} = 0 /\ z{2} = [] /\ z{1} = [] /\ ={bl, nb} /\ ={Redo.prefixes} /\ + ={Perm.mi, Perm.m} /\ ={C.c} /\ + INV_Real SLCommon.C.c{1} C.c{2} Perm.m{1} Perm.mi{1} Redo.prefixes{1} /\ + C.c{1} + size bl{1} + max (nb{1} - 1) 0 <= max_size /\ valid p{1} + ==> ={lres} /\ ={Redo.prefixes} /\ ={Perm.mi, Perm.m} /\ + C.c{1} + size bl{1} + max (nb{1} - 1) 0 = + C.c{2} + size bl{2} + max (nb{2} - 1) 0 /\ + INV_Real SLCommon.C.c{1} (C.c{2} + size bl{2} + max (nb{2} - 1) 0) + Perm.m{1} Perm.mi{1} Redo.prefixes{1});progress. sp. seq 2 2:(={i,n,p,lres,nb,bl,b,glob P,glob C,glob Redo} /\ INV_Real SLCommon.C.c{1} (C.c{2} + size bl{2}) @@ -565,23 +575,34 @@ section Real_Ideal. local lemma squeeze_squeezeless (D <: DISTINGUISHER {P, Redo, C, SLCommon.C}) : equiv [ NIndif(Squeeze(SqueezelessSponge(P)),P,DRestr(D)).main ~ RealIndif(Sponge,P,DRestr(D)).main - : ={glob D} ==> ={res, glob P, glob D, C.c}]. + : ={glob D} ==> ={res, glob P, glob D, C.c} /\ C.c{1} <= max_size]. proof. proc;inline*;sp;wp. - call(: ={glob Perm,C.c} + call(: ={glob Perm,C.c} /\ C.c{1} <= max_size /\ INV_Real 0 C.c{1} Perm.m{1} Perm.mi{1} Redo.prefixes{1});auto;last first. - + progress. + + progress. + + exact max_ge0. split=>//=;1:split=>//=;smt(getP dom0 map0P in_fset0 dom_set in_fsetU1). + proc;inline*;auto;sp;if;auto;sp;if;auto;progress. - - by rewrite INV_Real_addm_mi;2..:smt(supp_dexcepted);split;case:H=>//=;smt(). - - by split;case:H=>//=;smt(). + - by rewrite INV_Real_addm_mi;2..:smt(supp_dexcepted);split;case:H0=>//=;smt(). + - by split;case:H0=>//=;smt(). + proc;inline*;auto;sp;if;auto;sp;if;auto;progress. - - rewrite INV_Real_addm_mi;1: by split;case:H=>//=;smt(). - * case:H;smt(invm_dom_rng invmC supp_dexcepted). - case:H;smt(invm_dom_rng invmC supp_dexcepted). - - by split;case:H=>//=;smt(). + - rewrite INV_Real_addm_mi;1: by split;case:H0=>//=;smt(). + * case:H0;smt(invm_dom_rng invmC supp_dexcepted). + case:H0;smt(invm_dom_rng invmC supp_dexcepted). + - by split;case:H0=>//=;smt(). proc;inline*;sp;auto;if;auto;sp;if;auto; - last by progress;split;case:H=>//=;smt(size_ge0). + last by progress;split;case:H0=>//=;smt(size_ge0). + conseq(: (exists (c_R : int), + C.c{2} = c_R + size bl{2} + max (nb{2} - 1) 0 /\ xs{2} = bl{2} /\ + n{2} = nb{2} /\ z0{2} = [] /\ sc{2} = c0 /\ sa{2} = b0 /\ i{2} = 0 /\ + exists (c_L : int), C.c{1} = c_L + size bl{1} + max (nb{1} - 1) 0 /\ + p{1} = bl{1} /\ n{1} = nb{1} /\ lres{1} = [] /\ b{1} = b0 /\ + i{1} = 0 /\ z{2} = [] /\ z{1} = [] /\ ={bl, nb} /\ + ={Perm.mi, Perm.m} /\ c_L = c_R /\ + INV_Real 0 c_L Perm.m{1} Perm.mi{1} Redo.prefixes{1} /\ valid p{1}) + ==> lres{1} = z0{2} /\ ={Perm.mi, Perm.m} /\ ={C.c} /\ + INV_Real 0 C.c{1} Perm.m{1} Perm.mi{1} Redo.prefixes{1});1,2:smt(). sp. seq 2 1 : (={glob P, i, n, C.c,sa,sc} /\ b{1} = sa{2} /\ Redo.prefixes.[p]{1} = Some (sa,sc){2} @@ -805,14 +826,305 @@ section Real_Ideal. qed. + local lemma pr_real (D <: DISTINGUISHER{SLCommon.C, C, Perm, Redo}) &m : - Pr [ GReal(A(D)).main() @ &m : res ] = - Pr [ RealIndif(Sponge,P,DRestr(D)).main() @ &m : res ]. + Pr [ GReal(A(D)).main() @ &m : res /\ SLCommon.C.c <= max_size] <= + Pr [ RealIndif(Sponge,P,DRestr(D)).main() @ &m : res]. proof. cut->:Pr [ RealIndif(Sponge, P, DRestr(D)).main() @ &m : res ] = - Pr [ NIndif(Squeeze(SqueezelessSponge(P)),P,DRestr(D)).main() @ &m : res ]. + Pr [ NIndif(Squeeze(SqueezelessSponge(P)),P,DRestr(D)).main() @ &m : res /\ C.c <= max_size ]. + by rewrite eq_sym;byequiv (squeeze_squeezeless D)=>//=. - by byequiv (equiv_sponge D)=>//=. + byequiv (equiv_sponge D)=>//=;progress. + qed. + + + print Real_Ideal. + + print SLCommon.SIMULATOR. + + print Last. + + module SimLast (S : SLCommon.SIMULATOR) (F : DFUNCTIONALITY) = S(Last(F)). + + op (<=) (m1 m2 : (block list, 'b) fmap) = + forall x, x <> [] => x \in dom m1 => m1.[x] = m2.[x]. + + local lemma leq_add_nin (m1 m2 : (block list, 'b) fmap) (x : block list) (y : 'b): + m1 <= m2 => + ! x \in dom m2 => + m1 <= m2.[x <- y]. + proof. + move=>h_leq H_n_dom a H_a_dom;rewrite getP/=;smt(in_dom). + qed. + + + local lemma leq_add_in (m1 m2 : (block list, 'b) fmap) (x : block list) : + m1 <= m2 => + x \in dom m2 => + m1.[x <- oget m2.[x]] <= m2. + proof. + move=>h_leq H_n_dom a H_a_dom;rewrite getP/=;smt(in_dom getP). + qed. + + local lemma leq_nin_dom (m1 m2 : (block list, 'b) fmap) (x : block list) : + m1 <= m2 => + x <> [] => + ! x \in dom m2 => ! x \in dom m1 by smt(in_dom). + + local lemma prefixe_leq1 (l : block list) (m : (block list,block) fmap) i : + 0 <= i => + format l (i+1) \in dom m => + size (format l (i+1)) <= prefixe (format l (i+1+1)) + (get_max_prefixe (format l (i+1+1)) (elems (dom m))) <= size (format l (i+1+1)). + proof. + rewrite memE;move=>hi0 H_dom. + cut->:(format l (i + 1 + 1)) = format l (i + 1) ++ [b0]. + + by rewrite/format/=-2!(addzA _ 1 (-1))//=nseqSr//-cats1 catA. + cut:=prefixe_leq_prefixe_cat_size (format l (i + 1))[b0](elems (dom m)). + rewrite (prefixe_get_max_prefixe_eq_size _ _ H_dom)//=. + rewrite (size_cat _ [b0])/=;pose x:= format _ _. + cut:=get_max_prefixe_max (x ++ [b0]) _ _ H_dom. + cut->:prefixe (x ++ [b0]) (format l (i + 1)) = size x + by rewrite prefixeC-{1}(cats0 (format l (i+1)))/x prefixe_cat//=. + smt(prefixe_sizel size_cat prefixe_ge0 ). + qed. + + local lemma prefixe_le1 (l : block list) (m : (block list,block) fmap) i : + 0 <= i => + format l (i+1) \in dom m => + size (format l (i+1+1)) - prefixe (format l (i+1+1)) + (get_max_prefixe (format l (i+1+1)) (elems (dom m))) <= 1. + proof. + smt(prefixe_leq1 size_ge0 size_cat size_nseq). + qed. + + local lemma leq_add2 (m1 m2 : (block list, 'b) fmap) (x : block list) (y : 'b) : + m1 <= m2 => + ! x \in dom m2 => + m1.[x <- y] <= m2.[x <- y] by smt(in_dom getP dom_set in_fsetU1). + + + local equiv ideal_equiv (D <: DISTINGUISHER{SLCommon.C, C, IF, BIRO.IRO, S}) : + SLCommon.IdealIndif(IF, S, SLCommon.DRestr(A(D))).main + ~ + SLCommon.IdealIndif(IF, S, A(D)).main + : + ={glob D} ==> ={glob D, res}. + proof. + proc;inline*;auto;sp. + call(: ={glob IF, glob S, glob A} /\ SLCommon.C.c{1} <= C.c{1} + /\ SLCommon.C.queries{1} <= F.RO.m{2});auto;last first. + + progress. + by move=>x;rewrite getP/=dom_set in_fsetU1 dom0 in_fset0//==>->. + + proc;inline*;sp;if;auto;sp;rcondt{1}1;1:auto=>/#;sp;if=>//=;2:auto=>/#. + wp 7 6;conseq(:_==> ={y} /\ ={F.RO.m} /\ ={S.paths, S.mi, S.m} + /\ SLCommon.C.queries{1} <= F.RO.m{2});1:smt(). + if;auto;smt(leq_add_nin). + + by proc;inline*;sp;if;auto;sp;rcondt{1}1;1:auto=>/#;sp;if;auto;smt(). + proc;inline*;sp;if;auto;swap 6;auto;sp;if;auto;2:smt(size_ge0). + case(0 < n{1});last first. + + sp;rcondf{1}3;2:rcondf{2}4;1,2:auto. + - by if;auto;if;auto. + by if{1};2:auto;1:if{1};auto; + smt(prefixe_ge0 leq_add_in DBlock.dunifin_ll in_dom size_ge0 getP leq_add2). + splitwhile{1}5: i + 1 < n;splitwhile{2}5: i + 1 < n. + rcondt{1}6;2:rcondt{2}6;auto. + * by while(i < n);auto;sp;if;auto;sp;if;auto;if;auto. + * by while(i < n);auto;sp;if;auto;sp;if;auto;if;auto. + rcondf{1}8;2:rcondf{2}8;auto. + * while(i < n);auto. + by sp;if;auto;sp;if;auto;if;auto. + sp;if;auto;2:smt();if;auto;smt(). + * while(i < n);auto;2:smt();sp;if;auto;sp;if;auto;if;auto. + rcondf{1}8;2:rcondf{2}8;auto. + * while(i < n);auto. + by sp;if;auto;sp;if;auto;if;auto. + sp;if;auto;2:smt();if;auto;smt(). + * by while(i < n);auto;2:smt();sp;if;auto;sp;if;auto;if;auto. + conseq(:_==> ={b,lres,F.RO.m,S.paths,S.mi,S.m} + /\ i{1} = n{1} - 1 + /\ SLCommon.C.c{1} <= C.c{1} + size bl{1} + i{1} + /\ SLCommon.C.queries{1} <= F.RO.m{2});1:smt(). + while(={lres,F.RO.m,S.paths,S.mi,S.m,i,n,p,nb,b,bl} + /\ 0 <= i{1} <= n{1} - 1 + /\ SLCommon.C.queries.[format p (i+1)]{1} = Some b{1} + /\ p{1} = bs{1} /\ valid p{1} /\ p{1} = bl{1} + /\ C.c{1} + size p{1} + n{1} - 1 <= max_size + /\ SLCommon.C.c{1} <= C.c{1} + size bl{1} + i{1} + /\ SLCommon.C.queries{1} <= F.RO.m{2});progress. + sp;rcondt{1}1;2:rcondt{2}1;1,2:auto;sp. + case((x0 \in dom F.RO.m){2});last first. + * rcondt{2}2;1:auto;rcondt{1}1;1:(auto;smt(leq_nin_dom size_cat size_eq0 size_nseq valid_spec)). + rcondt{1}1;1:auto;1:smt(prefixe_le1 in_dom size_cat size_nseq). + sp;rcondt{1}2;auto;progress. + - smt(). + - smt(). + - by rewrite!getP/=. + - smt(prefixe_le1 in_dom). + - by rewrite!getP/=oget_some leq_add2//=. + if{1}. + * rcondt{1}1;1:auto;1:smt(prefixe_le1 in_dom size_cat size_nseq). + sp;rcondf{1}2;2:rcondf{2}2;auto;progress. + - smt(). + - smt(). + - by rewrite!getP/=. + - smt(prefixe_ge0 prefixe_le1 in_dom). + - smt(leq_add_in in_dom). + rcondf{2}2;auto;progress. + - smt(DBlock.dunifin_ll). + - smt(). + - smt(). + - smt(). + - smt(set_eq in_dom). + - smt(). + sp;conseq(:_==> ={F.RO.m,b} + /\ SLCommon.C.queries.[p]{1} = Some b{1} + /\ SLCommon.C.c{1} <= C.c{1} + size bl{1} + /\ SLCommon.C.queries{1} <= F.RO.m{2});progress. + - smt(). + - smt(nseq0 cats0). + - smt(size_ge0). + - smt(). + case(p{2} \in dom F.RO.m{2}). + + rcondf{2}2;1:auto. + sp;if{1}. + - rcondt{1}1;1:auto;1:smt(prefixe_ge0). + sp;rcondf{1}2;auto;progress. + * by rewrite!getP/=. + * smt(prefixe_ge0). + * smt(leq_add_in in_dom). + auto;progress. + - exact DBlock.dunifin_ll. + - smt(in_dom). + - smt(in_dom get_oget). + - smt(size_ge0). + rcondt{1}1;1:auto;1:smt(leq_nin_dom in_dom). + rcondt{1}1;1:auto;1:smt(prefixe_ge0). + sp;auto;progress. + + by rewrite!getP/=. + + smt(prefixe_ge0). + + rewrite getP/=oget_some leq_add2//=. + + by rewrite!getP/=. + + smt(prefixe_ge0). + + exact leq_add_in. + qed. + + + local module IF'(F : F.RO) = { + proc init = F.init + proc f (x : block list) : block = { + var b : block <- b0; + var i : int <- 0; + var p,n; + (p,n) <- parse x; + if (valid p) { + while (i < n) { + i <- i + 1; + F.sample(format p i); + } + b <@ F.get(x); + } + return b; + } + }. + + + local module SampleFirst (I : BIRO.IRO) = { + proc init = I.init + proc f (m : block list, k : int) = { + var r : block list <- []; + if (k <= 0) { + I.f(m,1); + } else { + r <- I.f(m,k); + } + return r; + } + }. + + + axiom valid_gt0 x : valid (parse x).`1 => 0 < (parse x).`2. + axiom valid_uniq p1 p2 n1 n2 : + valid p1 => valid p2 => format p1 n1 = format p2 n2 => p1 = p2 /\ n1 = n2. + + op inv_map (m1 : (block list, block) fmap) (m2 : (block list * int, block) fmap) = + (forall p n, valid p => (p,n) \in dom m2 <=> format p (n+1) \in dom m1) + /\ (forall x, x \in dom m1 <=> ((parse x).`1,(parse x).`2-1) \in dom m2) + /\ (forall p n, valid p => m2.[(p,n-1)] = m1.[format p n]) + /\ (forall x, m1.[x] = m2.[((parse x).`1,(parse x).`2-1)]). + +print BIRO. + + local equiv Ideal_equiv (D <: DISTINGUISHER{SLCommon.C, C, IF, BIRO.IRO, S}) : + SLCommon.IdealIndif(IF'(F.RO), S, A(D)).main + ~ + IdealIndif(SampleFirst(BIRO.IRO), SimLast(S), DRestr(D)).main + : + ={glob D} ==> ={glob D, res}. + proof. + proc;inline*;auto;sp. + call(: ={glob S, glob C} /\ inv_map F.RO.m{1} BIRO.IRO.mp{2});auto;last first. + + smt(dom0 in_fset0 map0P). + + proc;inline*;auto;sp;if;1,3:auto;sp;if;1,3:auto;if;1,3:auto;sp. + if{1};last by auto;if{2};auto;sp;rcondf{2}1;auto;smt(). + rcondf{2}1;1:auto;1:smt(parse_valid valid_gt0). + sp;rcondt{2}1;1:auto=>/#. + seq 8 6 : (={x,y,glob S,C.c} /\ inv_map F.RO.m{1} BIRO.IRO.mp{2}); + last by conseq(:_==> ={z,glob S,C.c});progress;sim;progress. + wp;rnd;auto=>//=;rcondt{1}1;2:rcondt{2}1;1,2:by auto;smt(valid_gt0). + sp;conseq(:_==> (x0{1} \in dom F.RO.m{1}) + /\ inv_map F.RO.m{1} BIRO.IRO.mp{2} + /\ oget F.RO.m.[x0]{1} = last b0 bs0{2}); + 1:smt(DBlock.dunifin_ll getP dom_set in_fsetU1). + conseq(:_==> format p0{1} i{1} \in dom F.RO.m{1} + /\ inv_map F.RO.m{1} BIRO.IRO.mp{2} + /\ i{1} = n{1} + /\ oget F.RO.m.[format p0{1} i{1}]{1} = last b0 bs0{2});1:smt(). + while((i,n){1} = (i0,n0){2} /\ x1{2} = p0{1} /\ valid p0{1} + /\ format p0{1} i{1} \in dom F.RO.m{1} + /\ inv_map F.RO.m{1} BIRO.IRO.mp{2} /\ 0 < i{1} <= n{1} + /\ oget F.RO.m.[format p0{1} i{1}]{1} = last b0 bs0{2});progress. + - sp;if{2}. + * rcondt{1}2;1:auto=>/#;wp;rnd;skip;smt(dom_set in_fsetU1 valid_uniq + formatK parseK getP in_dom last_rcons). + by rcondf{1}2;auto;smt(dom_set in_fsetU1 valid_uniq formatK parseK getP + in_dom DBlock.dunifin_ll last_rcons). + sp;if{2}. + - rcondt{1}2;1:auto=>/#;wp;rnd;skip;smt(dom_set in_fsetU1 valid_uniq + formatK parseK getP in_dom last_rcons valid_gt0). + by rcondf{1}2;auto;smt(dom_set in_fsetU1 valid_uniq formatK parseK getP + in_dom DBlock.dunifin_ll last_rcons valid_gt0). + + by proc;inline*;auto;sp;if;auto;sp;if;auto. + proc;inline*;auto;sp;if;auto;sp. + if{2};sp. + + if;auto;sp;rcondt{1}1;1:auto;1:smt(parse_valid). + rcondt{1}1;auto;1:smt(parse_valid);sp. + rcondf{1}3;auto;1:smt(parse_valid);sp. + rcondf{1}5;auto;1:smt(dom_set in_fsetU1 nseq0 cats0 parse_valid). + rcondt{2}1;auto;rcondf{2}7;1:by auto;sp;if;auto. + swap{1}4 3;auto;conseq(:_==> lres{1} = bs{2} /\ ={S.paths, S.mi, S.m} + /\ ={C.c} /\ inv_map F.RO.m{1} BIRO.IRO.mp{2});1:smt(DBlock.dunifin_ll). + rcondf{1}6;1:auto;1:smt(dom_set in_fsetU1 nseq0 cats0 parse_valid). + sp;if{2}. + - by rcondt{1}2;auto;smt(parse_valid dom_set in_fsetU1 valid_uniq formatK + parseK getP in_dom DBlock.dunifin_ll last_rcons). + rcondf{1}2;auto;smt(parse_valid dom_set in_fsetU1 valid_uniq formatK parseK + getP in_dom DBlock.dunifin_ll last_rcons). + if;auto;sp;rcondt{1}1;auto;1:smt(parse_valid). + rcondt{1}1;auto;1:smt(parse_valid);sp. + rcondf{1}3;auto;1:smt(parse_valid). + rcondf{1}5;auto;1:smt(dom_set in_fsetU1 nseq0 cats0 parse_valid). + swap{1}4 3;auto;conseq(:_==> lres{1} = bs0{2} /\ ={S.paths, S.mi, S.m} + /\ ={C.c} /\ inv_map F.RO.m{1} BIRO.IRO.mp{2});1:smt(DBlock.dunifin_ll). + rcondt{1}6;1:auto=>/#. + rcondt{2}1;1:auto=>/#. + (* TODO *) + + rcondt{2}1;auto;rcondf{2}7;1:by auto;sp;if;auto. + rcondf{1}7;auto. + + while + + qed. (* TODO : Ideal *) From 8a1ca656de0d40939b66b299ee533497d97ca7d1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Fri, 27 Apr 2018 18:48:08 +0200 Subject: [PATCH 285/525] GIdeal : step 1 : todo (easy), step 2,3 : done, step 4 : problem to solve --- proof/smart_counter/Gconcl_list.ec | 1187 +++++++++++++++------------- 1 file changed, 657 insertions(+), 530 deletions(-) diff --git a/proof/smart_counter/Gconcl_list.ec b/proof/smart_counter/Gconcl_list.ec index aaae1e9..c4be026 100644 --- a/proof/smart_counter/Gconcl_list.ec +++ b/proof/smart_counter/Gconcl_list.ec @@ -74,227 +74,605 @@ module P = Perm. section Real_Ideal. - - pred inv_ideal (squeeze : (block list * int, block list) fmap) - (c : (block list, block) fmap) = - (forall p n, (p,n) \in dom squeeze => - forall i, 1 <= i <= n => (p,i) = parse (format p i)) /\ - (forall p n, (p,n) \in dom squeeze => - forall i, 1 <= i <= n => format p i \in dom c) /\ - (forall l, l \in dom c => - forall i, 1 <= i <= (parse l).`2 => ((parse l).`1,i) \in dom squeeze). - - - inductive m_p (m : (state, state) fmap) (p : (block list, state) fmap) = - | IND_M_P of (p.[[]] = Some (b0, c0)) - & (forall l, l \in dom p => forall i, 0 <= i < size l => - exists b c, p.[take i l] = Some (b,c) /\ - m.[(b +^ nth witness l i, c)] = p.[take (i+1) l]). - - - inductive INV_Real - (c1 c2 : int) - (m mi : (state, state) fmap) - (p : (block list, state) fmap) = - | INV_real of (c1 <= c2) - & (m_p m p) - & (invm m mi). + module SimLast (S : SLCommon.SIMULATOR) (F : DFUNCTIONALITY) = S(Last(F)). - local lemma INV_Real_incr c1 c2 m mi p : - INV_Real c1 c2 m mi p => - INV_Real (c1 + 1) (c2 + 1) m mi p. - proof. by case;progress;split=>//=/#. qed. + op (<=) (m1 m2 : (block list, 'b) fmap) = + forall x, x <> [] => x \in dom m1 => m1.[x] = m2.[x]. - local lemma INV_Real_addm_mi c1 c2 m mi p x y : - INV_Real c1 c2 m mi p => - ! x \in dom m => - ! y \in rng m => - INV_Real c1 c2 m.[x <- y] mi.[y <- x] p. + local lemma leq_add_nin (m1 m2 : (block list, 'b) fmap) (x : block list) (y : 'b): + m1 <= m2 => + ! x \in dom m2 => + m1 <= m2.[x <- y]. proof. - case=> H_c1c2 H_m_p H_invm H_x_dom H_y_rng;split=>//=. - + split;case:H_m_p=>//=; - smt(getP in_dom oget_some take_oversize size_take take_take). - exact invm_set. + move=>h_leq H_n_dom a H_a_dom;rewrite getP/=;smt(in_dom). qed. - local lemma invmC' (m mi : (state, state) fmap) : - invm m mi => invm mi m. - proof. by rewrite /#. qed. - - local lemma invmC (m mi : (state, state) fmap) : - invm m mi <=> invm mi m. - proof. by split;exact invmC'. qed. - - local lemma invm_dom_rng (m mi : (state, state) fmap) : - invm m mi => dom m = rng mi. - proof. by move=>h;rewrite fsetP=>x;split;rewrite in_dom in_rng/#. qed. - local lemma all_prefixes_of_INV_real c1 c2 m mi p: - INV_Real c1 c2 m mi p => - all_prefixes p. + local lemma leq_add_in (m1 m2 : (block list, 'b) fmap) (x : block list) : + m1 <= m2 => + x \in dom m2 => + m1.[x <- oget m2.[x]] <= m2. proof. - move=>[]_[]Hp0 Hmp1 _ l H_dom i. - smt(take_le0 take_oversize size_take take_take take_size nth_take in_dom). + move=>h_leq H_n_dom a H_a_dom;rewrite getP/=;smt(in_dom getP). qed. - local lemma lemma2 c1 c2 m mi p bl i sa sc: - INV_Real c1 c2 m mi p => - 1 < i => - valid bl => - (sa,sc) \in dom m => - ! (format bl i) \in dom p => - p.[format bl (i-1)] = Some (sa,sc) => - INV_Real c1 c2 m mi p.[format bl i <- oget m.[(sa,sc)]]. - proof. - move=>inv0 h1i h_valid H_dom_m H_dom_p H_p_val. - split;cut[]//=_[] hmp0 hmp1 hinvm:=inv0;split=>//=. - + by rewrite getP;smt(size_cat size_nseq size_ge0). - + move=>l;rewrite dom_set in_fsetU1;case;1:smt(all_prefixes_of_INV_real getP). - move=>->>j[]hj0 hjsize;rewrite getP/=. - cut:=hmp1 (format bl (i - 1));rewrite in_dom H_p_val/==>help. - cut:=hjsize;rewrite !size_cat !size_nseq/=!max_ler 1:/#=>hjsizei. - cut->/=:!take j (format bl i) = format bl i by smt(size_take). - cut h:forall k, 0 <= k <= size bl + i - 2 => - take k (format bl (i - 1)) = take k (format bl i). - * move=>k[]hk0 hkjS;rewrite !take_cat;case(k//=hksize;congr. - apply (eq_from_nth witness);1:rewrite!size_take//=1,2:/#!size_nseq!max_ler/#. - rewrite!size_take//=1:/#!size_nseq!max_ler 1:/#. - pose o:=if _ then _ else _;cut->/={o}:o = k - size bl by smt(). - by progress;rewrite!nth_take//= 1,2:/# !nth_nseq//=/#. - case(j < size bl + i - 2)=>hj. - - cut:=help j _;1:smt(size_cat size_nseq). - move=>[]b c[]. - cut->:nth witness (format bl (i - 1)) j = nth witness (format bl i) j. - + by rewrite-(nth_take witness (j+1)) 1,2:/# eq_sym -(nth_take witness (j+1)) 1,2:/# !h//=/#. - rewrite h 1:/# h 1:/# => -> h';exists b c=>//=;rewrite h'/=getP/=. - smt(size_take size_cat size_nseq). - cut->>/=:j = size (format bl (i-1)) by smt(size_cat size_nseq). - rewrite getP/=. - cut h':size (format bl (i-1)) = size bl + i - 2 by smt(size_cat size_nseq). - rewrite h'/=-(addzA _ _ 1)/=. - cut h'':(size bl + i - 1) = size (format bl i) by smt(size_cat size_nseq). - rewrite h'' take_size/=-h 1:/# -h' take_size. - rewrite nth_cat h';cut->/=:! size bl + i - 2 < size bl by smt(). - by rewrite nth_nseq 1:/#;smt(Block.WRing.AddMonoid.addm0 in_dom get_oget). - qed. + local lemma leq_nin_dom (m1 m2 : (block list, 'b) fmap) (x : block list) : + m1 <= m2 => + x <> [] => + ! x \in dom m2 => ! x \in dom m1 by smt(in_dom). - local lemma take_nseq (a : 'a) i j : - take j (nseq i a) = if j <= i then nseq j a else nseq i a. - proof. - case(0 <= j)=>hj0;last first. - + rewrite take_le0 1:/#;smt(nseq0_le). - case(j <= i)=>hij//=;last smt(take_oversize size_nseq). - apply(eq_from_nth witness). - + smt(size_take size_nseq). - smt(size_nseq size_take nth_take nth_nseq). + local lemma prefixe_leq1 (l : block list) (m : (block list,block) fmap) i : + 0 <= i => + format l (i+1) \in dom m => + size (format l (i+1)) <= prefixe (format l (i+1+1)) + (get_max_prefixe (format l (i+1+1)) (elems (dom m))) <= size (format l (i+1+1)). + proof. + rewrite memE;move=>hi0 H_dom. + cut->:(format l (i + 1 + 1)) = format l (i + 1) ++ [b0]. + + by rewrite/format/=-2!(addzA _ 1 (-1))//=nseqSr//-cats1 catA. + cut:=prefixe_leq_prefixe_cat_size (format l (i + 1))[b0](elems (dom m)). + rewrite (prefixe_get_max_prefixe_eq_size _ _ H_dom)//=. + rewrite (size_cat _ [b0])/=;pose x:= format _ _. + cut:=get_max_prefixe_max (x ++ [b0]) _ _ H_dom. + cut->:prefixe (x ++ [b0]) (format l (i + 1)) = size x + by rewrite prefixeC-{1}(cats0 (format l (i+1)))/x prefixe_cat//=. + smt(prefixe_sizel size_cat prefixe_ge0 ). qed. - local lemma take_format (bl : block list) n i : - 0 < n => - 0 <= i < size bl + n => - take i (format bl n) = - if i <= size bl then take i bl else format bl (i - size bl + 1). - proof. - move=>Hn0[]Hi0 Hisize;rewrite take_cat take_nseq. - case(i < size bl)=>//=[/#|H_isize']. - cut->/=:i - size bl <= n - 1 by smt(). - case(i = size bl)=>[->>|H_isize'']//=;1:by rewrite nseq0 take_size cats0. - smt(). + local lemma prefixe_le1 (l : block list) (m : (block list,block) fmap) i : + 0 <= i => + format l (i+1) \in dom m => + size (format l (i+1+1)) - prefixe (format l (i+1+1)) + (get_max_prefixe (format l (i+1+1)) (elems (dom m))) <= 1. + proof. + smt(prefixe_leq1 size_ge0 size_cat size_nseq). qed. + local lemma leq_add2 (m1 m2 : (block list, 'b) fmap) (x : block list) (y : 'b) : + m1 <= m2 => + ! x \in dom m2 => + m1.[x <- y] <= m2.[x <- y] by smt(in_dom getP dom_set in_fsetU1). - local lemma equiv_sponge (D <: DISTINGUISHER {P, Redo, C, SLCommon.C}) : - equiv [ GReal(A(D)).main - ~ NIndif(Squeeze(SqueezelessSponge(P)),P,DRestr(D)).main - : ={glob D} ==> ={res, glob D, glob P, C.c} /\ SLCommon.C.c{1} <= C.c{2} <= max_size]. + + local equiv ideal_equiv (D <: DISTINGUISHER{SLCommon.C, C, IF, BIRO.IRO, S}) : + SLCommon.IdealIndif(IF, S, SLCommon.DRestr(A(D))).main + ~ + SLCommon.IdealIndif(IF, S, A(D)).main + : + ={glob D} ==> ={glob D, res}. proof. - proc;inline*;sp;wp. - call(: ={Redo.prefixes, glob P, C.c} /\ C.c{1} <= max_size /\ - INV_Real SLCommon.C.c{1} C.c{2} Perm.m{1} Perm.mi{1} Redo.prefixes{1});auto;last first. - + progress. - + exact max_ge0. - + by split=>//=;1:split;smt(dom0 in_fset0 dom_set in_fsetU1 getP map0P). - by case:H2=>//=. - + by proc;inline*;auto;sp;if;auto;sp;if;auto; - smt(INV_Real_addm_mi INV_Real_incr supp_dexcepted). - + proc;inline*;auto;sp;if;auto;sp;if;auto;progress. - + apply INV_Real_incr=>//=. - apply INV_Real_addm_mi=>//=. - + case:H0=>H_c H_m_p H_invm;rewrite (invm_dom_rng _ _ H_invm)//=. - by move:H3;rewrite supp_dexcepted. - case:H0=>H_c H_m_p H_invm;cut<-//:=(invm_dom_rng Perm.mi{2} Perm.m{2}). - by rewrite invmC. - + exact INV_Real_incr. - + proc;inline*;sp;if;auto. - swap 6;wp;sp=>/=;if;auto;last by progress;split;case:H0=>//=;smt(size_ge0). - conseq(: p{2} = bl{2} /\ n{2} = nb{2} /\ lres{2} = [] /\ b{2} = b0 /\ - i{2} = 0 /\ p{1} = bl{1} /\ n{1} = nb{1} /\ lres{1} = [] /\ b{1} = b0 /\ - i{1} = 0 /\ z{2} = [] /\ z{1} = [] /\ ={bl, nb} /\ ={Redo.prefixes} /\ - ={Perm.mi, Perm.m} /\ ={C.c} /\ - INV_Real SLCommon.C.c{1} C.c{2} Perm.m{1} Perm.mi{1} Redo.prefixes{1} /\ - C.c{1} + size bl{1} + max (nb{1} - 1) 0 <= max_size /\ valid p{1} - ==> ={lres} /\ ={Redo.prefixes} /\ ={Perm.mi, Perm.m} /\ - C.c{1} + size bl{1} + max (nb{1} - 1) 0 = - C.c{2} + size bl{2} + max (nb{2} - 1) 0 /\ - INV_Real SLCommon.C.c{1} (C.c{2} + size bl{2} + max (nb{2} - 1) 0) - Perm.m{1} Perm.mi{1} Redo.prefixes{1});progress. - sp. - seq 2 2:(={i,n,p,lres,nb,bl,b,glob P,glob C,glob Redo} - /\ INV_Real SLCommon.C.c{1} (C.c{2} + size bl{2}) - Perm.m{1} Perm.mi{1} Redo.prefixes{1} - /\ (n,p){1} = (nb,bl){1} /\ lres{1} = [] /\ i{1} = 0 - /\ valid p{1} - /\ Redo.prefixes.[p]{1} = Some (b,sc){1}). - + exists* Redo.prefixes{1},SLCommon.C.c{1};elim* => pref count/=. - wp;conseq(:_==> ={i0,p0,i,p,n,nb,bl,sa,lres,C.c,glob Redo,glob Perm} - /\ n{1} = nb{1} /\ p{1} = bl{1} /\ p0{1} = p{1} /\ i0{1} = size p{1} - /\ Redo.prefixes{1}.[take i0{1} p{1}] = Some (sa{1},sc{1}) - /\ INV_Real count C.c{1} Perm.m{1} Perm.mi{1} pref - /\ (forall l, l \in dom Redo.prefixes{1} => - l \in dom pref \/ (exists j, 0 < j <= i0{2} /\ l = take j p{1})) - /\ (forall l, l \in dom pref => pref.[l] = Redo.prefixes{1}.[l]) - /\ SLCommon.C.c{1} <= count + i0{1} <= C.c{1} + i0{1} - /\ (forall j, 0 <= j < i0{1} => - exists b c, Redo.prefixes{1}.[take j p{1}] = Some (b,c) /\ - Perm.m{1}.[(b +^ nth witness p{1} j, c)] = - Redo.prefixes{1}.[take (j+1) p{1}])); - progress. - - cut inv0:=H3;cut[]h_c1c2[]Hmp0 Hmp1 Hinvm:=inv0;split=>//=. - - case:inv0;smt(size_ge0). - split=>//=. - - smt(in_dom). - - move=>l H_dom_R i []Hi0 Hisize;cut:=H4 l H_dom_R. - case(l \in dom Redo.prefixes{2})=>H_in_pref//=. - * cut:=Hmp1 l H_in_pref i _;rewrite//=. - rewrite ?H5//=;1:smt(in_dom). - case(i+1 < size l)=>h;1:smt(in_dom). - by rewrite take_oversize 1:/#. - move=>[]j[][]hj0 hjsize ->>. - cut:=Hisize;rewrite size_take 1:/#. - pose k:=if _ then _ else _;cut->>Hij{k}:k=j by rewrite/#. - by rewrite!take_take!min_lel 1,2:/# nth_take 1,2:/#;smt(in_dom). - - smt(getP oget_some in_dom take_oversize). - while( ={i0,p0,i,p,n,nb,bl,sa,sc,lres,C.c,glob Redo,glob Perm} - /\ n{1} = nb{1} /\ p{1} = bl{1} /\ p0{1} = p{1} /\ 0 <= i0{1} <= size p{1} - /\ Redo.prefixes{1}.[take i0{1} p{1}] = Some (sa{1},sc{1}) - /\ INV_Real count C.c{1} Perm.m{1} Perm.mi{1} pref - /\ (forall l, l \in dom Redo.prefixes{1} => - l \in dom pref \/ (exists j, 0 < j <= i0{2} /\ l = take j p{1})) - /\ (forall l, l \in dom pref => pref.[l] = Redo.prefixes{1}.[l]) - /\ SLCommon.C.c{1} <= count + i0{1} <= C.c{1} + i0{1} - /\ (i0{1} < size p0{1} => - take (i0{1}+1) p{1} \in dom Redo.prefixes{1} => - Redo.prefixes{1} = pref) - /\ all_prefixes Redo.prefixes{1} - /\ (forall j, 0 <= j < i0{1} => - exists b c, Redo.prefixes{1}.[take j p{1}] = Some (b,c) /\ - Perm.m{1}.[(b +^ nth witness p{1} j, c)] = - Redo.prefixes{1}.[take (j+1) p{1}]));last first. - + auto;progress. - - exact size_ge0. - - by rewrite take0;cut[]_[]->//=:=H. - - smt(). - - by cut[]->//=:=H. + proc;inline*;auto;sp. + call(: ={glob IF, glob S, glob A} /\ SLCommon.C.c{1} <= C.c{1} + /\ SLCommon.C.queries{1} <= F.RO.m{2});auto;last first. + + progress. + by move=>x;rewrite getP/=dom_set in_fsetU1 dom0 in_fset0//==>->. + + proc;inline*;sp;if;auto;sp;rcondt{1}1;1:auto=>/#;sp;if=>//=;2:auto=>/#. + wp 7 6;conseq(:_==> ={y} /\ ={F.RO.m} /\ ={S.paths, S.mi, S.m} + /\ SLCommon.C.queries{1} <= F.RO.m{2});1:smt(). + if;auto;smt(leq_add_nin). + + by proc;inline*;sp;if;auto;sp;rcondt{1}1;1:auto=>/#;sp;if;auto;smt(). + proc;inline*;sp;if;auto;swap 6;auto;sp;if;auto;2:smt(size_ge0). + case(0 < n{1});last first. + + sp;rcondf{1}3;2:rcondf{2}4;1,2:auto. + - by if;auto;if;auto. + by if{1};2:auto;1:if{1};auto; + smt(prefixe_ge0 leq_add_in DBlock.dunifin_ll in_dom size_ge0 getP leq_add2). + splitwhile{1}5: i + 1 < n;splitwhile{2}5: i + 1 < n. + rcondt{1}6;2:rcondt{2}6;auto. + * by while(i < n);auto;sp;if;auto;sp;if;auto;if;auto. + * by while(i < n);auto;sp;if;auto;sp;if;auto;if;auto. + rcondf{1}8;2:rcondf{2}8;auto. + * while(i < n);auto. + by sp;if;auto;sp;if;auto;if;auto. + sp;if;auto;2:smt();if;auto;smt(). + * while(i < n);auto;2:smt();sp;if;auto;sp;if;auto;if;auto. + rcondf{1}8;2:rcondf{2}8;auto. + * while(i < n);auto. + by sp;if;auto;sp;if;auto;if;auto. + sp;if;auto;2:smt();if;auto;smt(). + * by while(i < n);auto;2:smt();sp;if;auto;sp;if;auto;if;auto. + conseq(:_==> ={b,lres,F.RO.m,S.paths,S.mi,S.m} + /\ i{1} = n{1} - 1 + /\ SLCommon.C.c{1} <= C.c{1} + size bl{1} + i{1} + /\ SLCommon.C.queries{1} <= F.RO.m{2});1:smt(). + while(={lres,F.RO.m,S.paths,S.mi,S.m,i,n,p,nb,b,bl} + /\ 0 <= i{1} <= n{1} - 1 + /\ SLCommon.C.queries.[format p (i+1)]{1} = Some b{1} + /\ p{1} = bs{1} /\ valid p{1} /\ p{1} = bl{1} + /\ C.c{1} + size p{1} + n{1} - 1 <= max_size + /\ SLCommon.C.c{1} <= C.c{1} + size bl{1} + i{1} + /\ SLCommon.C.queries{1} <= F.RO.m{2});progress. + sp;rcondt{1}1;2:rcondt{2}1;1,2:auto;sp. + case((x0 \in dom F.RO.m){2});last first. + * rcondt{2}2;1:auto;rcondt{1}1;1:(auto;smt(leq_nin_dom size_cat size_eq0 size_nseq valid_spec)). + rcondt{1}1;1:auto;1:smt(prefixe_le1 in_dom size_cat size_nseq). + sp;rcondt{1}2;auto;progress. + - smt(). + - smt(). + - by rewrite!getP/=. + - smt(prefixe_le1 in_dom). + - by rewrite!getP/=oget_some leq_add2//=. + if{1}. + * rcondt{1}1;1:auto;1:smt(prefixe_le1 in_dom size_cat size_nseq). + sp;rcondf{1}2;2:rcondf{2}2;auto;progress. + - smt(). + - smt(). + - by rewrite!getP/=. + - smt(prefixe_ge0 prefixe_le1 in_dom). + - smt(leq_add_in in_dom). + rcondf{2}2;auto;progress. + - smt(DBlock.dunifin_ll). + - smt(). + - smt(). + - smt(). + - smt(set_eq in_dom). + - smt(). + sp;conseq(:_==> ={F.RO.m,b} + /\ SLCommon.C.queries.[p]{1} = Some b{1} + /\ SLCommon.C.c{1} <= C.c{1} + size bl{1} + /\ SLCommon.C.queries{1} <= F.RO.m{2});progress. + - smt(). + - smt(nseq0 cats0). + - smt(size_ge0). + - smt(). + case(p{2} \in dom F.RO.m{2}). + + rcondf{2}2;1:auto. + sp;if{1}. + - rcondt{1}1;1:auto;1:smt(prefixe_ge0). + sp;rcondf{1}2;auto;progress. + * by rewrite!getP/=. + * smt(prefixe_ge0). + * smt(leq_add_in in_dom). + auto;progress. + - exact DBlock.dunifin_ll. + - smt(in_dom). + - smt(in_dom get_oget). + - smt(size_ge0). + rcondt{1}1;1:auto;1:smt(leq_nin_dom in_dom). + rcondt{1}1;1:auto;1:smt(prefixe_ge0). + sp;auto;progress. + + by rewrite!getP/=. + + smt(prefixe_ge0). + + rewrite getP/=oget_some leq_add2//=. + + by rewrite!getP/=. + + smt(prefixe_ge0). + + exact leq_add_in. + qed. + + + local module IF'(F : F.RO) = { + proc init = F.init + proc f (x : block list) : block = { + var b : block <- b0; + var i : int <- 0; + var p,n; + (p,n) <- parse x; + if (valid p) { + while (i < n) { + i <- i + 1; + F.sample(format p i); + } + b <@ F.get(x); + } + return b; + } + }. + + + local module SampleFirst (I : BIRO.IRO) = { + proc init = I.init + proc f (m : block list, k : int) = { + var r : block list <- []; + if (k <= 0) { + I.f(m,1); + } else { + r <- I.f(m,k); + } + return r; + } + }. + + + axiom valid_gt0 x : valid (parse x).`1 => 0 < (parse x).`2. + axiom valid_uniq p1 p2 n1 n2 : + valid p1 => valid p2 => format p1 n1 = format p2 n2 => p1 = p2 /\ n1 = n2. + + op inv_map (m1 : (block list, block) fmap) (m2 : (block list * int, block) fmap) = + (forall p n, valid p => (p,n) \in dom m2 <=> format p (n+1) \in dom m1) + /\ (forall x, x \in dom m1 <=> ((parse x).`1,(parse x).`2-1) \in dom m2) + /\ (forall p n, valid p => m2.[(p,n-1)] = m1.[format p n]) + /\ (forall x, m1.[x] = m2.[((parse x).`1,(parse x).`2-1)]). + + + local module L (D : DISTINGUISHER) (F : F.RO) = SLCommon.IdealIndif(IF'(F), S, A(D)). + + local equiv Ideal_equiv (D <: DISTINGUISHER{SLCommon.C, C, IF, BIRO.IRO, S}) : + L(D,F.RO).main + ~ + IdealIndif(SampleFirst(BIRO.IRO), SimLast(S), DRestr(D)).main + : + ={glob D} ==> ={glob D, res}. + proof. + proc;inline*;auto;sp. + call(: ={glob S, glob C} /\ inv_map F.RO.m{1} BIRO.IRO.mp{2});auto;last first. + + smt(dom0 in_fset0 map0P). + + proc;inline*;auto;sp;if;1,3:auto;sp;if;1,3:auto;if;1,3:auto;sp. + if{1};last by auto;if{2};auto;sp;rcondf{2}1;auto;smt(). + rcondf{2}1;1:auto;1:smt(parse_valid valid_gt0). + sp;rcondt{2}1;1:auto=>/#. + seq 8 6 : (={x,y,glob S,C.c} /\ inv_map F.RO.m{1} BIRO.IRO.mp{2}); + last by conseq(:_==> ={z,glob S,C.c});progress;sim;progress. + wp;rnd;auto=>//=;rcondt{1}1;2:rcondt{2}1;1,2:by auto;smt(valid_gt0). + sp;conseq(:_==> (x0{1} \in dom F.RO.m{1}) + /\ inv_map F.RO.m{1} BIRO.IRO.mp{2} + /\ oget F.RO.m.[x0]{1} = last b0 bs0{2}); + 1:smt(DBlock.dunifin_ll getP dom_set in_fsetU1). + conseq(:_==> format p0{1} i{1} \in dom F.RO.m{1} + /\ inv_map F.RO.m{1} BIRO.IRO.mp{2} + /\ i{1} = n{1} + /\ oget F.RO.m.[format p0{1} i{1}]{1} = last b0 bs0{2});1:smt(). + while((i,n){1} = (i0,n0){2} /\ x1{2} = p0{1} /\ valid p0{1} + /\ format p0{1} i{1} \in dom F.RO.m{1} + /\ inv_map F.RO.m{1} BIRO.IRO.mp{2} /\ 0 < i{1} <= n{1} + /\ oget F.RO.m.[format p0{1} i{1}]{1} = last b0 bs0{2});progress. + - sp;if{2}. + * rcondt{1}2;1:auto=>/#;wp;rnd;skip;smt(dom_set in_fsetU1 valid_uniq + formatK parseK getP in_dom last_rcons). + by rcondf{1}2;auto;smt(dom_set in_fsetU1 valid_uniq formatK parseK getP + in_dom DBlock.dunifin_ll last_rcons). + sp;if{2}. + - rcondt{1}2;1:auto=>/#;wp;rnd;skip;smt(dom_set in_fsetU1 valid_uniq + formatK parseK getP in_dom last_rcons valid_gt0). + by rcondf{1}2;auto;smt(dom_set in_fsetU1 valid_uniq formatK parseK getP + in_dom DBlock.dunifin_ll last_rcons valid_gt0). + + by proc;inline*;auto;sp;if;auto;sp;if;auto. + proc;inline*;auto;sp;if;auto;sp. + if{2};sp. + + if;auto;sp;rcondt{1}1;1:auto;1:smt(parse_valid). + rcondt{1}1;auto;1:smt(parse_valid);sp. + rcondf{1}3;auto;1:smt(parse_valid);sp. + rcondf{1}5;auto;1:smt(dom_set in_fsetU1 nseq0 cats0 parse_valid). + rcondt{2}1;auto;rcondf{2}7;1:by auto;sp;if;auto. + swap{1}4 3;auto;conseq(:_==> lres{1} = bs{2} /\ ={S.paths, S.mi, S.m} + /\ ={C.c} /\ inv_map F.RO.m{1} BIRO.IRO.mp{2});1:smt(DBlock.dunifin_ll). + rcondf{1}6;1:auto;1:smt(dom_set in_fsetU1 nseq0 cats0 parse_valid). + sp;if{2}. + - by rcondt{1}2;auto;smt(parse_valid dom_set in_fsetU1 valid_uniq formatK + parseK getP in_dom DBlock.dunifin_ll last_rcons). + rcondf{1}2;auto;smt(parse_valid dom_set in_fsetU1 valid_uniq formatK parseK + getP in_dom DBlock.dunifin_ll last_rcons). + if;auto;sp;rcondt{1}1;auto;1:smt(parse_valid). + rcondt{1}1;auto;1:smt(parse_valid);sp. + rcondf{1}3;auto;1:smt(parse_valid). + rcondf{1}5;auto;1:smt(dom_set in_fsetU1 nseq0 cats0 parse_valid). + swap{1}4 3;auto;conseq(:_==> lres{1} = bs0{2} /\ ={S.paths, S.mi, S.m} + /\ ={C.c} /\ inv_map F.RO.m{1} BIRO.IRO.mp{2});1:smt(DBlock.dunifin_ll). + rcondt{2}1;1:auto=>/#;sp. + splitwhile{1} 6 : i + 1 < n. + rcondt{1}7;1:auto. + + by while(i < n);auto;2:smt();sp;if;auto;sp;if;auto;while(i < n);auto. + rcondf{1}9;1:auto. + + by while(i < n);auto;2:smt();sp;if;auto;sp;if;auto;while(i < n);auto. + rcondf{1}9;1:auto. + + by while(i < n);auto;2:smt();sp;if;auto;sp;if;auto;while(i < n);auto. + auto. + conseq(:_==> rcons lres{1} b{1} = bs0{2} + /\ inv_map F.RO.m{1} BIRO.IRO.mp{2});auto. + while(i{1} + 1 = i0{2} /\ n{1} = n0{2} /\ valid p{1} + /\ F.RO.m.[format p (i+1)]{1} = Some b{1} + /\ (forall j, 0 < j <= i{1} + 1 => format p{1} j \in dom F.RO.m{1}) + /\ x0{2} = p{1} /\ 0 <= i{1} < n{1} + /\ rcons lres{1} b{1} = bs0{2} + /\ inv_map F.RO.m{1} BIRO.IRO.mp{2}). + + sp;rcondt{1}1;1:auto;sp;rcondt{1}1;1:auto;1:smt(parseK). + wp 4 1=>/=;swap{1}1;sp. + conseq(:_==> (forall j, 0 < j <= i{1}+1 => format p{1} j \in dom F.RO.m{1}) + /\ inv_map F.RO.m{1} BIRO.IRO.mp{2});1:smt(get_oget in_dom). + splitwhile{1}1 : i1 + 1 < n1. + rcondt{1}2;first by auto;while(i1 < n1);auto;smt(parseK). + rcondf{1}7;first by auto;while(i1 < n1);auto;smt(parseK). + seq 4 0:( (forall j, 0 < j <= i{1} => format p{1} j \in dom F.RO.m{1}) + /\ inv_map F.RO.m{1} BIRO.IRO.mp{2} /\ valid p{1} + /\ x4{1} = format p{1} (i{1} + 1) /\ 0 <= i{1} /\ x6{1} = x4{1} + /\ x2{2} = p{1} /\ n2{2} = i{1});last first. + - rcondf{1}4;1:auto;1:smt(dom_set in_fsetU1);rnd{1}. + if{2}. + * by rcondt{1}2;auto;smt(parse_valid dom_set in_fsetU1 valid_uniq formatK + parseK getP in_dom DBlock.dunifin_ll last_rcons dom_set in_fsetU1). + by rcondf{1}2;auto;smt(parse_valid dom_set in_fsetU1 valid_uniq formatK parseK + getP in_dom DBlock.dunifin_ll last_rcons). + alias{1} 1 m = F.RO.m;sp. + wp;conseq(:_==> F.RO.m{1} = m{1} /\ i1{1} = n1{1}-1);1:smt(parseK). + while{1}((forall j, 0 < j < n1{1} => format p1{1} j \in dom F.RO.m{1}) + /\ 0 <= i1{1} < n1{1} /\ p1{1} = p{1} + /\ F.RO.m{1} = m{1})(n1{1}-1-i1{1});progress. + + by sp;rcondf 2;auto;smt(DBlock.dunifin_ll). + by auto;smt(parseK). + if{2}. + + by rcondt{1}2;auto;smt(parse_valid dom_set in_fsetU1 valid_uniq formatK + parseK getP in_dom DBlock.dunifin_ll last_rcons dom_set in_fsetU1). + by rcondf{1}2;auto;smt(parse_valid dom_set in_fsetU1 valid_uniq formatK parseK + getP in_dom DBlock.dunifin_ll last_rcons). + qed. + + + local module Valid (F : F.RO) = { + proc init = F.init + proc f (q : block list) = { + var r : block <- b0; + var s,t; + (s,t) <- parse q; + if (valid s) { + r <@ F.get(q); + } else { + F.sample(q); + } + return r; + } + }. + + local module L2 (D : DISTINGUISHER) (F : F.RO) = + SLCommon.IdealIndif(Valid(F), S, A(D)). + + local equiv Ideal_equiv_valid (D <: DISTINGUISHER{SLCommon.C, C, IF, BIRO.IRO, S}) : + L(D,F.LRO).main + ~ + L2(D,F.LRO).main + : + ={glob D} ==> ={glob D, res}. + proof. + proc;inline*;sp;wp. + call(: ={glob F.RO, glob S, glob C});auto. + + proc;sp;if;auto. + call(: ={glob IF,glob S});auto. + sp;if;auto;if;auto;sp. + - call(: ={glob IF});2:auto;2:smt();sp;if;auto;1:smt(). + inline F.LRO.sample;call(: ={glob IF});auto;progress. + by while{1}(true)(n{1}-i{1});auto;smt(). + by inline*;auto. + + by proc;sim. + proc;sp;if;auto;sp;call(: ={glob IF,glob S});auto. + sp;if;auto. + while(={glob S,glob IF,lres,i,n,p,b}). + + sp;if;auto. + call(: ={glob IF});auto. + sp;if;auto;progress;1,2:smt(). + + call(: ={glob IF});auto. + conseq(:_==> true);auto. + by inline*;while{1}(true)(n{1}-i{1});auto;smt(). + by inline*;auto. + call(: ={glob IF});auto;sp;if;auto;1:smt(). + + call(: ={glob IF});auto. + conseq(:_==> true);auto. + by inline*;while{1}(true)(n{1}-i{1});auto;smt(). + by inline*;auto. + qed. + + + (* Real part *) + + + + pred inv_ideal (squeeze : (block list * int, block list) fmap) + (c : (block list, block) fmap) = + (forall p n, (p,n) \in dom squeeze => + forall i, 1 <= i <= n => (p,i) = parse (format p i)) /\ + (forall p n, (p,n) \in dom squeeze => + forall i, 1 <= i <= n => format p i \in dom c) /\ + (forall l, l \in dom c => + forall i, 1 <= i <= (parse l).`2 => ((parse l).`1,i) \in dom squeeze). + + + inductive m_p (m : (state, state) fmap) (p : (block list, state) fmap) = + | IND_M_P of (p.[[]] = Some (b0, c0)) + & (forall l, l \in dom p => forall i, 0 <= i < size l => + exists b c, p.[take i l] = Some (b,c) /\ + m.[(b +^ nth witness l i, c)] = p.[take (i+1) l]). + + + inductive INV_Real + (c1 c2 : int) + (m mi : (state, state) fmap) + (p : (block list, state) fmap) = + | INV_real of (c1 <= c2) + & (m_p m p) + & (invm m mi). + + local lemma INV_Real_incr c1 c2 m mi p : + INV_Real c1 c2 m mi p => + INV_Real (c1 + 1) (c2 + 1) m mi p. + proof. by case;progress;split=>//=/#. qed. + + local lemma INV_Real_addm_mi c1 c2 m mi p x y : + INV_Real c1 c2 m mi p => + ! x \in dom m => + ! y \in rng m => + INV_Real c1 c2 m.[x <- y] mi.[y <- x] p. + proof. + case=> H_c1c2 H_m_p H_invm H_x_dom H_y_rng;split=>//=. + + split;case:H_m_p=>//=; + smt(getP in_dom oget_some take_oversize size_take take_take). + exact invm_set. + qed. + + local lemma invmC' (m mi : (state, state) fmap) : + invm m mi => invm mi m. + proof. by rewrite /#. qed. + + local lemma invmC (m mi : (state, state) fmap) : + invm m mi <=> invm mi m. + proof. by split;exact invmC'. qed. + + local lemma invm_dom_rng (m mi : (state, state) fmap) : + invm m mi => dom m = rng mi. + proof. by move=>h;rewrite fsetP=>x;split;rewrite in_dom in_rng/#. qed. + + local lemma all_prefixes_of_INV_real c1 c2 m mi p: + INV_Real c1 c2 m mi p => + all_prefixes p. + proof. + move=>[]_[]Hp0 Hmp1 _ l H_dom i. + smt(take_le0 take_oversize size_take take_take take_size nth_take in_dom). + qed. + + local lemma lemma2 c1 c2 m mi p bl i sa sc: + INV_Real c1 c2 m mi p => + 1 < i => + valid bl => + (sa,sc) \in dom m => + ! (format bl i) \in dom p => + p.[format bl (i-1)] = Some (sa,sc) => + INV_Real c1 c2 m mi p.[format bl i <- oget m.[(sa,sc)]]. + proof. + move=>inv0 h1i h_valid H_dom_m H_dom_p H_p_val. + split;cut[]//=_[] hmp0 hmp1 hinvm:=inv0;split=>//=. + + by rewrite getP;smt(size_cat size_nseq size_ge0). + + move=>l;rewrite dom_set in_fsetU1;case;1:smt(all_prefixes_of_INV_real getP). + move=>->>j[]hj0 hjsize;rewrite getP/=. + cut:=hmp1 (format bl (i - 1));rewrite in_dom H_p_val/==>help. + cut:=hjsize;rewrite !size_cat !size_nseq/=!max_ler 1:/#=>hjsizei. + cut->/=:!take j (format bl i) = format bl i by smt(size_take). + cut h:forall k, 0 <= k <= size bl + i - 2 => + take k (format bl (i - 1)) = take k (format bl i). + * move=>k[]hk0 hkjS;rewrite !take_cat;case(k//=hksize;congr. + apply (eq_from_nth witness);1:rewrite!size_take//=1,2:/#!size_nseq!max_ler/#. + rewrite!size_take//=1:/#!size_nseq!max_ler 1:/#. + pose o:=if _ then _ else _;cut->/={o}:o = k - size bl by smt(). + by progress;rewrite!nth_take//= 1,2:/# !nth_nseq//=/#. + case(j < size bl + i - 2)=>hj. + - cut:=help j _;1:smt(size_cat size_nseq). + move=>[]b c[]. + cut->:nth witness (format bl (i - 1)) j = nth witness (format bl i) j. + + by rewrite-(nth_take witness (j+1)) 1,2:/# eq_sym -(nth_take witness (j+1)) 1,2:/# !h//=/#. + rewrite h 1:/# h 1:/# => -> h';exists b c=>//=;rewrite h'/=getP/=. + smt(size_take size_cat size_nseq). + cut->>/=:j = size (format bl (i-1)) by smt(size_cat size_nseq). + rewrite getP/=. + cut h':size (format bl (i-1)) = size bl + i - 2 by smt(size_cat size_nseq). + rewrite h'/=-(addzA _ _ 1)/=. + cut h'':(size bl + i - 1) = size (format bl i) by smt(size_cat size_nseq). + rewrite h'' take_size/=-h 1:/# -h' take_size. + rewrite nth_cat h';cut->/=:! size bl + i - 2 < size bl by smt(). + by rewrite nth_nseq 1:/#;smt(Block.WRing.AddMonoid.addm0 in_dom get_oget). + qed. + + local lemma take_nseq (a : 'a) i j : + take j (nseq i a) = if j <= i then nseq j a else nseq i a. + proof. + case(0 <= j)=>hj0;last first. + + rewrite take_le0 1:/#;smt(nseq0_le). + case(j <= i)=>hij//=;last smt(take_oversize size_nseq). + apply(eq_from_nth witness). + + smt(size_take size_nseq). + smt(size_nseq size_take nth_take nth_nseq). + qed. + + local lemma take_format (bl : block list) n i : + 0 < n => + 0 <= i < size bl + n => + take i (format bl n) = + if i <= size bl then take i bl else format bl (i - size bl + 1). + proof. + move=>Hn0[]Hi0 Hisize;rewrite take_cat take_nseq. + case(i < size bl)=>//=[/#|H_isize']. + cut->/=:i - size bl <= n - 1 by smt(). + case(i = size bl)=>[->>|H_isize'']//=;1:by rewrite nseq0 take_size cats0. + smt(). + qed. + + + local lemma equiv_sponge (D <: DISTINGUISHER {P, Redo, C, SLCommon.C}) : + equiv [ GReal(A(D)).main + ~ NIndif(Squeeze(SqueezelessSponge(P)),P,DRestr(D)).main + : ={glob D} ==> ={res, glob D, glob P, C.c} /\ SLCommon.C.c{1} <= C.c{2} <= max_size]. + proof. + proc;inline*;sp;wp. + call(: ={Redo.prefixes, glob P, C.c} /\ C.c{1} <= max_size /\ + INV_Real SLCommon.C.c{1} C.c{2} Perm.m{1} Perm.mi{1} Redo.prefixes{1});auto;last first. + + progress. + + exact max_ge0. + + by split=>//=;1:split;smt(dom0 in_fset0 dom_set in_fsetU1 getP map0P). + by case:H2=>//=. + + by proc;inline*;auto;sp;if;auto;sp;if;auto; + smt(INV_Real_addm_mi INV_Real_incr supp_dexcepted). + + proc;inline*;auto;sp;if;auto;sp;if;auto;progress. + + apply INV_Real_incr=>//=. + apply INV_Real_addm_mi=>//=. + + case:H0=>H_c H_m_p H_invm;rewrite (invm_dom_rng _ _ H_invm)//=. + by move:H3;rewrite supp_dexcepted. + case:H0=>H_c H_m_p H_invm;cut<-//:=(invm_dom_rng Perm.mi{2} Perm.m{2}). + by rewrite invmC. + + exact INV_Real_incr. + + proc;inline*;sp;if;auto. + swap 6;wp;sp=>/=;if;auto;last by progress;split;case:H0=>//=;smt(size_ge0). + conseq(: p{2} = bl{2} /\ n{2} = nb{2} /\ lres{2} = [] /\ b{2} = b0 /\ + i{2} = 0 /\ p{1} = bl{1} /\ n{1} = nb{1} /\ lres{1} = [] /\ b{1} = b0 /\ + i{1} = 0 /\ z{2} = [] /\ z{1} = [] /\ ={bl, nb} /\ ={Redo.prefixes} /\ + ={Perm.mi, Perm.m} /\ ={C.c} /\ + INV_Real SLCommon.C.c{1} C.c{2} Perm.m{1} Perm.mi{1} Redo.prefixes{1} /\ + C.c{1} + size bl{1} + max (nb{1} - 1) 0 <= max_size /\ valid p{1} + ==> ={lres} /\ ={Redo.prefixes} /\ ={Perm.mi, Perm.m} /\ + C.c{1} + size bl{1} + max (nb{1} - 1) 0 = + C.c{2} + size bl{2} + max (nb{2} - 1) 0 /\ + INV_Real SLCommon.C.c{1} (C.c{2} + size bl{2} + max (nb{2} - 1) 0) + Perm.m{1} Perm.mi{1} Redo.prefixes{1});progress. + sp. + seq 2 2:(={i,n,p,lres,nb,bl,b,glob P,glob C,glob Redo} + /\ INV_Real SLCommon.C.c{1} (C.c{2} + size bl{2}) + Perm.m{1} Perm.mi{1} Redo.prefixes{1} + /\ (n,p){1} = (nb,bl){1} /\ lres{1} = [] /\ i{1} = 0 + /\ valid p{1} + /\ Redo.prefixes.[p]{1} = Some (b,sc){1}). + + exists* Redo.prefixes{1},SLCommon.C.c{1};elim* => pref count/=. + wp;conseq(:_==> ={i0,p0,i,p,n,nb,bl,sa,lres,C.c,glob Redo,glob Perm} + /\ n{1} = nb{1} /\ p{1} = bl{1} /\ p0{1} = p{1} /\ i0{1} = size p{1} + /\ Redo.prefixes{1}.[take i0{1} p{1}] = Some (sa{1},sc{1}) + /\ INV_Real count C.c{1} Perm.m{1} Perm.mi{1} pref + /\ (forall l, l \in dom Redo.prefixes{1} => + l \in dom pref \/ (exists j, 0 < j <= i0{2} /\ l = take j p{1})) + /\ (forall l, l \in dom pref => pref.[l] = Redo.prefixes{1}.[l]) + /\ SLCommon.C.c{1} <= count + i0{1} <= C.c{1} + i0{1} + /\ (forall j, 0 <= j < i0{1} => + exists b c, Redo.prefixes{1}.[take j p{1}] = Some (b,c) /\ + Perm.m{1}.[(b +^ nth witness p{1} j, c)] = + Redo.prefixes{1}.[take (j+1) p{1}])); + progress. + - cut inv0:=H3;cut[]h_c1c2[]Hmp0 Hmp1 Hinvm:=inv0;split=>//=. + - case:inv0;smt(size_ge0). + split=>//=. + - smt(in_dom). + - move=>l H_dom_R i []Hi0 Hisize;cut:=H4 l H_dom_R. + case(l \in dom Redo.prefixes{2})=>H_in_pref//=. + * cut:=Hmp1 l H_in_pref i _;rewrite//=. + rewrite ?H5//=;1:smt(in_dom). + case(i+1 < size l)=>h;1:smt(in_dom). + by rewrite take_oversize 1:/#. + move=>[]j[][]hj0 hjsize ->>. + cut:=Hisize;rewrite size_take 1:/#. + pose k:=if _ then _ else _;cut->>Hij{k}:k=j by rewrite/#. + by rewrite!take_take!min_lel 1,2:/# nth_take 1,2:/#;smt(in_dom). + - smt(getP oget_some in_dom take_oversize). + while( ={i0,p0,i,p,n,nb,bl,sa,sc,lres,C.c,glob Redo,glob Perm} + /\ n{1} = nb{1} /\ p{1} = bl{1} /\ p0{1} = p{1} /\ 0 <= i0{1} <= size p{1} + /\ Redo.prefixes{1}.[take i0{1} p{1}] = Some (sa{1},sc{1}) + /\ INV_Real count C.c{1} Perm.m{1} Perm.mi{1} pref + /\ (forall l, l \in dom Redo.prefixes{1} => + l \in dom pref \/ (exists j, 0 < j <= i0{2} /\ l = take j p{1})) + /\ (forall l, l \in dom pref => pref.[l] = Redo.prefixes{1}.[l]) + /\ SLCommon.C.c{1} <= count + i0{1} <= C.c{1} + i0{1} + /\ (i0{1} < size p0{1} => + take (i0{1}+1) p{1} \in dom Redo.prefixes{1} => + Redo.prefixes{1} = pref) + /\ all_prefixes Redo.prefixes{1} + /\ (forall j, 0 <= j < i0{1} => + exists b c, Redo.prefixes{1}.[take j p{1}] = Some (b,c) /\ + Perm.m{1}.[(b +^ nth witness p{1} j, c)] = + Redo.prefixes{1}.[take (j+1) p{1}]));last first. + + auto;progress. + - exact size_ge0. + - by rewrite take0;cut[]_[]->//=:=H. + - smt(). + - by cut[]->//=:=H. - smt(all_prefixes_of_INV_real). - smt(). - smt(). @@ -789,346 +1167,95 @@ section Real_Ideal. pose x := if _ then _ else _ ;cut->/={x}: x = format p{1} (i_R+1). + rewrite/x size_cat size_nseq-(addzA _ 1 (-1))/=!max_ler 1:/#-(addzA _ _ (-1))-(addzA _ _ (-1))/=. case(size p{1} + i_R <= size p{1})=>//=h;2:smt(size_ge0 size_cat size_nseq). - cut->>/=:i_R = 0 by smt(). - by rewrite take_size/format nseq0 cats0. - by rewrite H3/==>[][]->>->>. - + move:H9;rewrite take_format/=1:/#;1:smt(size_ge0 size_cat size_nseq). - pose x := if _ then _ else _ ;cut->/={x}: x = format p{1} (i_R+1). - + rewrite/x size_cat size_nseq-(addzA _ 1 (-1))/=!max_ler 1:/#-(addzA _ _ (-1))-(addzA _ _ (-1))/=. - case(size p{1} + i_R <= size p{1})=>//=h;2:smt(size_ge0 size_cat size_nseq). - cut->>/=:i_R = 0 by smt(). - by rewrite take_size/format nseq0 cats0. - by rewrite H3/=. - + by rewrite size_cat size_nseq;smt(). - while{1}(={glob P} /\ 0 <= i1{1} <= size p1{1} - 1 /\ 0 < i{1} < n{1} - /\ p1{1} = format p{1} (i{1} + 1) /\ pref{1} = Redo.prefixes{1} - /\ format p{1} i{1} \in dom pref{1} - /\ Redo.prefixes{1}.[take i1{1} p1{1}] = Some (sa0{1}, sc0{1}) - /\ INV_Real 0 C.c{1} Perm.m{1} Perm.mi{1} Redo.prefixes{1}) - (size p1{1}-i1{1}-1);auto;last first. - + progress. - + smt(size_cat size_nseq size_ge0 size_eq0 valid_spec). - + smt(). - + by rewrite in_dom H3. - + by rewrite take0;cut[]_[]:=H1. - + smt(). - + smt(). - rcondt 1;auto;progress. - + cut->:take (i1{hr} + 1) (format p{hr} (i{hr} + 1)) = - take (i1{hr} + 1) (format p{hr} i{hr});2:smt(all_prefixes_of_INV_real in_dom). - rewrite!take_format;smt(valid_spec size_ge0 size_eq0 size_cat size_nseq). - + smt(). - + smt(valid_spec size_ge0 size_eq0 size_cat size_nseq). - + cut->:take (i1{hr} + 1) (format p{hr} (i{hr} + 1)) = - take (i1{hr} + 1) (format p{hr} i{hr});2:smt(all_prefixes_of_INV_real in_dom). - rewrite!take_format;smt(valid_spec size_ge0 size_eq0 size_cat size_nseq). - smt(). - qed. - - - - local lemma pr_real (D <: DISTINGUISHER{SLCommon.C, C, Perm, Redo}) &m : - Pr [ GReal(A(D)).main() @ &m : res /\ SLCommon.C.c <= max_size] <= - Pr [ RealIndif(Sponge,P,DRestr(D)).main() @ &m : res]. - proof. - cut->:Pr [ RealIndif(Sponge, P, DRestr(D)).main() @ &m : res ] = - Pr [ NIndif(Squeeze(SqueezelessSponge(P)),P,DRestr(D)).main() @ &m : res /\ C.c <= max_size ]. - + by rewrite eq_sym;byequiv (squeeze_squeezeless D)=>//=. - byequiv (equiv_sponge D)=>//=;progress. - qed. - - - print Real_Ideal. - - print SLCommon.SIMULATOR. - - print Last. - - module SimLast (S : SLCommon.SIMULATOR) (F : DFUNCTIONALITY) = S(Last(F)). - - op (<=) (m1 m2 : (block list, 'b) fmap) = - forall x, x <> [] => x \in dom m1 => m1.[x] = m2.[x]. - - local lemma leq_add_nin (m1 m2 : (block list, 'b) fmap) (x : block list) (y : 'b): - m1 <= m2 => - ! x \in dom m2 => - m1 <= m2.[x <- y]. - proof. - move=>h_leq H_n_dom a H_a_dom;rewrite getP/=;smt(in_dom). - qed. - - - local lemma leq_add_in (m1 m2 : (block list, 'b) fmap) (x : block list) : - m1 <= m2 => - x \in dom m2 => - m1.[x <- oget m2.[x]] <= m2. - proof. - move=>h_leq H_n_dom a H_a_dom;rewrite getP/=;smt(in_dom getP). - qed. - - local lemma leq_nin_dom (m1 m2 : (block list, 'b) fmap) (x : block list) : - m1 <= m2 => - x <> [] => - ! x \in dom m2 => ! x \in dom m1 by smt(in_dom). - - local lemma prefixe_leq1 (l : block list) (m : (block list,block) fmap) i : - 0 <= i => - format l (i+1) \in dom m => - size (format l (i+1)) <= prefixe (format l (i+1+1)) - (get_max_prefixe (format l (i+1+1)) (elems (dom m))) <= size (format l (i+1+1)). - proof. - rewrite memE;move=>hi0 H_dom. - cut->:(format l (i + 1 + 1)) = format l (i + 1) ++ [b0]. - + by rewrite/format/=-2!(addzA _ 1 (-1))//=nseqSr//-cats1 catA. - cut:=prefixe_leq_prefixe_cat_size (format l (i + 1))[b0](elems (dom m)). - rewrite (prefixe_get_max_prefixe_eq_size _ _ H_dom)//=. - rewrite (size_cat _ [b0])/=;pose x:= format _ _. - cut:=get_max_prefixe_max (x ++ [b0]) _ _ H_dom. - cut->:prefixe (x ++ [b0]) (format l (i + 1)) = size x - by rewrite prefixeC-{1}(cats0 (format l (i+1)))/x prefixe_cat//=. - smt(prefixe_sizel size_cat prefixe_ge0 ). - qed. - - local lemma prefixe_le1 (l : block list) (m : (block list,block) fmap) i : - 0 <= i => - format l (i+1) \in dom m => - size (format l (i+1+1)) - prefixe (format l (i+1+1)) - (get_max_prefixe (format l (i+1+1)) (elems (dom m))) <= 1. - proof. - smt(prefixe_leq1 size_ge0 size_cat size_nseq). - qed. + cut->>/=:i_R = 0 by smt(). + by rewrite take_size/format nseq0 cats0. + by rewrite H3/==>[][]->>->>. + + move:H9;rewrite take_format/=1:/#;1:smt(size_ge0 size_cat size_nseq). + pose x := if _ then _ else _ ;cut->/={x}: x = format p{1} (i_R+1). + + rewrite/x size_cat size_nseq-(addzA _ 1 (-1))/=!max_ler 1:/#-(addzA _ _ (-1))-(addzA _ _ (-1))/=. + case(size p{1} + i_R <= size p{1})=>//=h;2:smt(size_ge0 size_cat size_nseq). + cut->>/=:i_R = 0 by smt(). + by rewrite take_size/format nseq0 cats0. + by rewrite H3/=. + + by rewrite size_cat size_nseq;smt(). + while{1}(={glob P} /\ 0 <= i1{1} <= size p1{1} - 1 /\ 0 < i{1} < n{1} + /\ p1{1} = format p{1} (i{1} + 1) /\ pref{1} = Redo.prefixes{1} + /\ format p{1} i{1} \in dom pref{1} + /\ Redo.prefixes{1}.[take i1{1} p1{1}] = Some (sa0{1}, sc0{1}) + /\ INV_Real 0 C.c{1} Perm.m{1} Perm.mi{1} Redo.prefixes{1}) + (size p1{1}-i1{1}-1);auto;last first. + + progress. + + smt(size_cat size_nseq size_ge0 size_eq0 valid_spec). + + smt(). + + by rewrite in_dom H3. + + by rewrite take0;cut[]_[]:=H1. + + smt(). + + smt(). + rcondt 1;auto;progress. + + cut->:take (i1{hr} + 1) (format p{hr} (i{hr} + 1)) = + take (i1{hr} + 1) (format p{hr} i{hr});2:smt(all_prefixes_of_INV_real in_dom). + rewrite!take_format;smt(valid_spec size_ge0 size_eq0 size_cat size_nseq). + + smt(). + + smt(valid_spec size_ge0 size_eq0 size_cat size_nseq). + + cut->:take (i1{hr} + 1) (format p{hr} (i{hr} + 1)) = + take (i1{hr} + 1) (format p{hr} i{hr});2:smt(all_prefixes_of_INV_real in_dom). + rewrite!take_format;smt(valid_spec size_ge0 size_eq0 size_cat size_nseq). + smt(). + qed. - local lemma leq_add2 (m1 m2 : (block list, 'b) fmap) (x : block list) (y : 'b) : - m1 <= m2 => - ! x \in dom m2 => - m1.[x <- y] <= m2.[x <- y] by smt(in_dom getP dom_set in_fsetU1). - local equiv ideal_equiv (D <: DISTINGUISHER{SLCommon.C, C, IF, BIRO.IRO, S}) : - SLCommon.IdealIndif(IF, S, SLCommon.DRestr(A(D))).main - ~ - SLCommon.IdealIndif(IF, S, A(D)).main - : - ={glob D} ==> ={glob D, res}. + local lemma pr_real (D <: DISTINGUISHER{SLCommon.C, C, Perm, Redo}) &m : + Pr [ GReal(A(D)).main() @ &m : res /\ SLCommon.C.c <= max_size] <= + Pr [ RealIndif(Sponge,P,DRestr(D)).main() @ &m : res]. proof. - proc;inline*;auto;sp. - call(: ={glob IF, glob S, glob A} /\ SLCommon.C.c{1} <= C.c{1} - /\ SLCommon.C.queries{1} <= F.RO.m{2});auto;last first. - + progress. - by move=>x;rewrite getP/=dom_set in_fsetU1 dom0 in_fset0//==>->. - + proc;inline*;sp;if;auto;sp;rcondt{1}1;1:auto=>/#;sp;if=>//=;2:auto=>/#. - wp 7 6;conseq(:_==> ={y} /\ ={F.RO.m} /\ ={S.paths, S.mi, S.m} - /\ SLCommon.C.queries{1} <= F.RO.m{2});1:smt(). - if;auto;smt(leq_add_nin). - + by proc;inline*;sp;if;auto;sp;rcondt{1}1;1:auto=>/#;sp;if;auto;smt(). - proc;inline*;sp;if;auto;swap 6;auto;sp;if;auto;2:smt(size_ge0). - case(0 < n{1});last first. - + sp;rcondf{1}3;2:rcondf{2}4;1,2:auto. - - by if;auto;if;auto. - by if{1};2:auto;1:if{1};auto; - smt(prefixe_ge0 leq_add_in DBlock.dunifin_ll in_dom size_ge0 getP leq_add2). - splitwhile{1}5: i + 1 < n;splitwhile{2}5: i + 1 < n. - rcondt{1}6;2:rcondt{2}6;auto. - * by while(i < n);auto;sp;if;auto;sp;if;auto;if;auto. - * by while(i < n);auto;sp;if;auto;sp;if;auto;if;auto. - rcondf{1}8;2:rcondf{2}8;auto. - * while(i < n);auto. - by sp;if;auto;sp;if;auto;if;auto. - sp;if;auto;2:smt();if;auto;smt(). - * while(i < n);auto;2:smt();sp;if;auto;sp;if;auto;if;auto. - rcondf{1}8;2:rcondf{2}8;auto. - * while(i < n);auto. - by sp;if;auto;sp;if;auto;if;auto. - sp;if;auto;2:smt();if;auto;smt(). - * by while(i < n);auto;2:smt();sp;if;auto;sp;if;auto;if;auto. - conseq(:_==> ={b,lres,F.RO.m,S.paths,S.mi,S.m} - /\ i{1} = n{1} - 1 - /\ SLCommon.C.c{1} <= C.c{1} + size bl{1} + i{1} - /\ SLCommon.C.queries{1} <= F.RO.m{2});1:smt(). - while(={lres,F.RO.m,S.paths,S.mi,S.m,i,n,p,nb,b,bl} - /\ 0 <= i{1} <= n{1} - 1 - /\ SLCommon.C.queries.[format p (i+1)]{1} = Some b{1} - /\ p{1} = bs{1} /\ valid p{1} /\ p{1} = bl{1} - /\ C.c{1} + size p{1} + n{1} - 1 <= max_size - /\ SLCommon.C.c{1} <= C.c{1} + size bl{1} + i{1} - /\ SLCommon.C.queries{1} <= F.RO.m{2});progress. - sp;rcondt{1}1;2:rcondt{2}1;1,2:auto;sp. - case((x0 \in dom F.RO.m){2});last first. - * rcondt{2}2;1:auto;rcondt{1}1;1:(auto;smt(leq_nin_dom size_cat size_eq0 size_nseq valid_spec)). - rcondt{1}1;1:auto;1:smt(prefixe_le1 in_dom size_cat size_nseq). - sp;rcondt{1}2;auto;progress. - - smt(). - - smt(). - - by rewrite!getP/=. - - smt(prefixe_le1 in_dom). - - by rewrite!getP/=oget_some leq_add2//=. - if{1}. - * rcondt{1}1;1:auto;1:smt(prefixe_le1 in_dom size_cat size_nseq). - sp;rcondf{1}2;2:rcondf{2}2;auto;progress. - - smt(). - - smt(). - - by rewrite!getP/=. - - smt(prefixe_ge0 prefixe_le1 in_dom). - - smt(leq_add_in in_dom). - rcondf{2}2;auto;progress. - - smt(DBlock.dunifin_ll). - - smt(). - - smt(). - - smt(). - - smt(set_eq in_dom). - - smt(). - sp;conseq(:_==> ={F.RO.m,b} - /\ SLCommon.C.queries.[p]{1} = Some b{1} - /\ SLCommon.C.c{1} <= C.c{1} + size bl{1} - /\ SLCommon.C.queries{1} <= F.RO.m{2});progress. - - smt(). - - smt(nseq0 cats0). - - smt(size_ge0). - - smt(). - case(p{2} \in dom F.RO.m{2}). - + rcondf{2}2;1:auto. - sp;if{1}. - - rcondt{1}1;1:auto;1:smt(prefixe_ge0). - sp;rcondf{1}2;auto;progress. - * by rewrite!getP/=. - * smt(prefixe_ge0). - * smt(leq_add_in in_dom). - auto;progress. - - exact DBlock.dunifin_ll. - - smt(in_dom). - - smt(in_dom get_oget). - - smt(size_ge0). - rcondt{1}1;1:auto;1:smt(leq_nin_dom in_dom). - rcondt{1}1;1:auto;1:smt(prefixe_ge0). - sp;auto;progress. - + by rewrite!getP/=. - + smt(prefixe_ge0). - + rewrite getP/=oget_some leq_add2//=. - + by rewrite!getP/=. - + smt(prefixe_ge0). - + exact leq_add_in. + cut->:Pr [ RealIndif(Sponge, P, DRestr(D)).main() @ &m : res ] = + Pr [ NIndif(Squeeze(SqueezelessSponge(P)),P,DRestr(D)).main() @ &m : res /\ C.c <= max_size ]. + + by rewrite eq_sym;byequiv (squeeze_squeezeless D)=>//=. + byequiv (equiv_sponge D)=>//=;progress. qed. - local module IF'(F : F.RO) = { - proc init = F.init - proc f (x : block list) : block = { - var b : block <- b0; - var i : int <- 0; - var p,n; - (p,n) <- parse x; - if (valid p) { - while (i < n) { - i <- i + 1; - F.sample(format p i); - } - b <@ F.get(x); - } - return b; - } - }. - - - local module SampleFirst (I : BIRO.IRO) = { - proc init = I.init - proc f (m : block list, k : int) = { - var r : block list <- []; - if (k <= 0) { - I.f(m,1); - } else { - r <- I.f(m,k); - } - return r; - } - }. - - - axiom valid_gt0 x : valid (parse x).`1 => 0 < (parse x).`2. - axiom valid_uniq p1 p2 n1 n2 : - valid p1 => valid p2 => format p1 n1 = format p2 n2 => p1 = p2 /\ n1 = n2. - - op inv_map (m1 : (block list, block) fmap) (m2 : (block list * int, block) fmap) = - (forall p n, valid p => (p,n) \in dom m2 <=> format p (n+1) \in dom m1) - /\ (forall x, x \in dom m1 <=> ((parse x).`1,(parse x).`2-1) \in dom m2) - /\ (forall p n, valid p => m2.[(p,n-1)] = m1.[format p n]) - /\ (forall x, m1.[x] = m2.[((parse x).`1,(parse x).`2-1)]). - -print BIRO. +(* This lemma is false, overuse of valid tests *) - local equiv Ideal_equiv (D <: DISTINGUISHER{SLCommon.C, C, IF, BIRO.IRO, S}) : - SLCommon.IdealIndif(IF'(F.RO), S, A(D)).main + local equiv Ideal_equiv_valid (D <: DISTINGUISHER{SLCommon.C, C, IF, BIRO.IRO, S}) : + L2(D,F.RO).main ~ - IdealIndif(SampleFirst(BIRO.IRO), SimLast(S), DRestr(D)).main + SLCommon.IdealIndif(IF, S, A(D)).main : ={glob D} ==> ={glob D, res}. proof. - proc;inline*;auto;sp. - call(: ={glob S, glob C} /\ inv_map F.RO.m{1} BIRO.IRO.mp{2});auto;last first. - + smt(dom0 in_fset0 map0P). - + proc;inline*;auto;sp;if;1,3:auto;sp;if;1,3:auto;if;1,3:auto;sp. - if{1};last by auto;if{2};auto;sp;rcondf{2}1;auto;smt(). - rcondf{2}1;1:auto;1:smt(parse_valid valid_gt0). - sp;rcondt{2}1;1:auto=>/#. - seq 8 6 : (={x,y,glob S,C.c} /\ inv_map F.RO.m{1} BIRO.IRO.mp{2}); - last by conseq(:_==> ={z,glob S,C.c});progress;sim;progress. - wp;rnd;auto=>//=;rcondt{1}1;2:rcondt{2}1;1,2:by auto;smt(valid_gt0). - sp;conseq(:_==> (x0{1} \in dom F.RO.m{1}) - /\ inv_map F.RO.m{1} BIRO.IRO.mp{2} - /\ oget F.RO.m.[x0]{1} = last b0 bs0{2}); - 1:smt(DBlock.dunifin_ll getP dom_set in_fsetU1). - conseq(:_==> format p0{1} i{1} \in dom F.RO.m{1} - /\ inv_map F.RO.m{1} BIRO.IRO.mp{2} - /\ i{1} = n{1} - /\ oget F.RO.m.[format p0{1} i{1}]{1} = last b0 bs0{2});1:smt(). - while((i,n){1} = (i0,n0){2} /\ x1{2} = p0{1} /\ valid p0{1} - /\ format p0{1} i{1} \in dom F.RO.m{1} - /\ inv_map F.RO.m{1} BIRO.IRO.mp{2} /\ 0 < i{1} <= n{1} - /\ oget F.RO.m.[format p0{1} i{1}]{1} = last b0 bs0{2});progress. - - sp;if{2}. - * rcondt{1}2;1:auto=>/#;wp;rnd;skip;smt(dom_set in_fsetU1 valid_uniq - formatK parseK getP in_dom last_rcons). - by rcondf{1}2;auto;smt(dom_set in_fsetU1 valid_uniq formatK parseK getP - in_dom DBlock.dunifin_ll last_rcons). - sp;if{2}. - - rcondt{1}2;1:auto=>/#;wp;rnd;skip;smt(dom_set in_fsetU1 valid_uniq - formatK parseK getP in_dom last_rcons valid_gt0). - by rcondf{1}2;auto;smt(dom_set in_fsetU1 valid_uniq formatK parseK getP - in_dom DBlock.dunifin_ll last_rcons valid_gt0). - + by proc;inline*;auto;sp;if;auto;sp;if;auto. - proc;inline*;auto;sp;if;auto;sp. - if{2};sp. - + if;auto;sp;rcondt{1}1;1:auto;1:smt(parse_valid). - rcondt{1}1;auto;1:smt(parse_valid);sp. - rcondf{1}3;auto;1:smt(parse_valid);sp. - rcondf{1}5;auto;1:smt(dom_set in_fsetU1 nseq0 cats0 parse_valid). - rcondt{2}1;auto;rcondf{2}7;1:by auto;sp;if;auto. - swap{1}4 3;auto;conseq(:_==> lres{1} = bs{2} /\ ={S.paths, S.mi, S.m} - /\ ={C.c} /\ inv_map F.RO.m{1} BIRO.IRO.mp{2});1:smt(DBlock.dunifin_ll). - rcondf{1}6;1:auto;1:smt(dom_set in_fsetU1 nseq0 cats0 parse_valid). - sp;if{2}. - - by rcondt{1}2;auto;smt(parse_valid dom_set in_fsetU1 valid_uniq formatK - parseK getP in_dom DBlock.dunifin_ll last_rcons). - rcondf{1}2;auto;smt(parse_valid dom_set in_fsetU1 valid_uniq formatK parseK - getP in_dom DBlock.dunifin_ll last_rcons). - if;auto;sp;rcondt{1}1;auto;1:smt(parse_valid). - rcondt{1}1;auto;1:smt(parse_valid);sp. - rcondf{1}3;auto;1:smt(parse_valid). - rcondf{1}5;auto;1:smt(dom_set in_fsetU1 nseq0 cats0 parse_valid). - swap{1}4 3;auto;conseq(:_==> lres{1} = bs0{2} /\ ={S.paths, S.mi, S.m} - /\ ={C.c} /\ inv_map F.RO.m{1} BIRO.IRO.mp{2});1:smt(DBlock.dunifin_ll). - rcondt{1}6;1:auto=>/#. - rcondt{2}1;1:auto=>/#. - (* TODO *) - - rcondt{2}1;auto;rcondf{2}7;1:by auto;sp;if;auto. - rcondf{1}7;auto. - + while - - - qed. + proc;inline*;sp;wp. + call(: ={glob F.RO, glob S, glob C});auto. + + proc;sp;if;auto. + call(: ={glob IF,glob S});auto. + sp;if;auto;if;auto;sp. + - call(: ={glob IF});2:auto;2:smt();sp;if;auto;1:smt(). + inline F.LRO.sample;call(: ={glob IF});auto;progress. + by while{1}(true)(n{1}-i{1});auto;smt(). + by inline*;auto. + + by proc;sim. + proc;sp;if;auto;sp;call(: ={glob IF,glob S});auto. + sp;if;auto. + while(={glob S,glob IF,lres,i,n,p,b}). + + sp;if;auto. + call(: ={glob IF});auto. + sp;if;auto;progress;1,2:smt(). + + call(: ={glob IF});auto. + conseq(:_==> true);auto. + by inline*;while{1}(true)(n{1}-i{1});auto;smt(). + by inline*;auto. + call(: ={glob IF});auto;sp;if;auto;1:smt(). + + call(: ={glob IF});auto. + conseq(:_==> true);auto. + by inline*;while{1}(true)(n{1}-i{1});auto;smt(). + by inline*;auto. + qed. (* TODO : Ideal *) + + local lemma equiv_ideal (IF <: FUNCTIONALITY{DSqueeze,C}) (S <: SIMULATOR{DSqueeze,C,IF}) From 34be904ab25521c3bf22bfdf061437738e10d1de Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Mon, 14 May 2018 15:53:12 +0200 Subject: [PATCH 286/525] forgot to commit. again. --- proof/smart_counter/Gconcl_list.ec | 613 ++++++++++++++--------------- 1 file changed, 291 insertions(+), 322 deletions(-) diff --git a/proof/smart_counter/Gconcl_list.ec b/proof/smart_counter/Gconcl_list.ec index c4be026..f2a77f9 100644 --- a/proof/smart_counter/Gconcl_list.ec +++ b/proof/smart_counter/Gconcl_list.ec @@ -10,6 +10,10 @@ require (*--*) Handle. (** Validity of Functionality Queries **) op valid: block list -> bool = valid_block. axiom valid_spec p: valid p => p <> []. +axiom valid_ge0 x: 0 <= (parse x).`2. +axiom valid_gt0 x: valid (parse x).`1 => 0 < (parse x).`2. + + clone export Handle as Handle0. @@ -73,8 +77,18 @@ module P = Perm. section Real_Ideal. + module Valid (F : DFUNCTIONALITY) = { + proc init () = {} + proc f (q : block list, k : int) = { + var re : block list <- []; + if (valid q) { + re <@ F.f(q,k); + } + return re; + } + }. - module SimLast (S : SLCommon.SIMULATOR) (F : DFUNCTIONALITY) = S(Last(F)). + module SimLast (S : SLCommon.SIMULATOR) (F : DFUNCTIONALITY) = S(Last(Valid(F))). op (<=) (m1 m2 : (block list, 'b) fmap) = forall x, x <> [] => x \in dom m1 => m1.[x] = m2.[x]. @@ -273,7 +287,6 @@ section Real_Ideal. }. - axiom valid_gt0 x : valid (parse x).`1 => 0 < (parse x).`2. axiom valid_uniq p1 p2 n1 n2 : valid p1 => valid p2 => format p1 n1 = format p2 n2 => p1 = p2 /\ n1 = n2. @@ -284,119 +297,12 @@ section Real_Ideal. /\ (forall x, m1.[x] = m2.[((parse x).`1,(parse x).`2-1)]). - local module L (D : DISTINGUISHER) (F : F.RO) = SLCommon.IdealIndif(IF'(F), S, A(D)). - - local equiv Ideal_equiv (D <: DISTINGUISHER{SLCommon.C, C, IF, BIRO.IRO, S}) : - L(D,F.RO).main - ~ - IdealIndif(SampleFirst(BIRO.IRO), SimLast(S), DRestr(D)).main - : - ={glob D} ==> ={glob D, res}. - proof. - proc;inline*;auto;sp. - call(: ={glob S, glob C} /\ inv_map F.RO.m{1} BIRO.IRO.mp{2});auto;last first. - + smt(dom0 in_fset0 map0P). - + proc;inline*;auto;sp;if;1,3:auto;sp;if;1,3:auto;if;1,3:auto;sp. - if{1};last by auto;if{2};auto;sp;rcondf{2}1;auto;smt(). - rcondf{2}1;1:auto;1:smt(parse_valid valid_gt0). - sp;rcondt{2}1;1:auto=>/#. - seq 8 6 : (={x,y,glob S,C.c} /\ inv_map F.RO.m{1} BIRO.IRO.mp{2}); - last by conseq(:_==> ={z,glob S,C.c});progress;sim;progress. - wp;rnd;auto=>//=;rcondt{1}1;2:rcondt{2}1;1,2:by auto;smt(valid_gt0). - sp;conseq(:_==> (x0{1} \in dom F.RO.m{1}) - /\ inv_map F.RO.m{1} BIRO.IRO.mp{2} - /\ oget F.RO.m.[x0]{1} = last b0 bs0{2}); - 1:smt(DBlock.dunifin_ll getP dom_set in_fsetU1). - conseq(:_==> format p0{1} i{1} \in dom F.RO.m{1} - /\ inv_map F.RO.m{1} BIRO.IRO.mp{2} - /\ i{1} = n{1} - /\ oget F.RO.m.[format p0{1} i{1}]{1} = last b0 bs0{2});1:smt(). - while((i,n){1} = (i0,n0){2} /\ x1{2} = p0{1} /\ valid p0{1} - /\ format p0{1} i{1} \in dom F.RO.m{1} - /\ inv_map F.RO.m{1} BIRO.IRO.mp{2} /\ 0 < i{1} <= n{1} - /\ oget F.RO.m.[format p0{1} i{1}]{1} = last b0 bs0{2});progress. - - sp;if{2}. - * rcondt{1}2;1:auto=>/#;wp;rnd;skip;smt(dom_set in_fsetU1 valid_uniq - formatK parseK getP in_dom last_rcons). - by rcondf{1}2;auto;smt(dom_set in_fsetU1 valid_uniq formatK parseK getP - in_dom DBlock.dunifin_ll last_rcons). - sp;if{2}. - - rcondt{1}2;1:auto=>/#;wp;rnd;skip;smt(dom_set in_fsetU1 valid_uniq - formatK parseK getP in_dom last_rcons valid_gt0). - by rcondf{1}2;auto;smt(dom_set in_fsetU1 valid_uniq formatK parseK getP - in_dom DBlock.dunifin_ll last_rcons valid_gt0). - + by proc;inline*;auto;sp;if;auto;sp;if;auto. - proc;inline*;auto;sp;if;auto;sp. - if{2};sp. - + if;auto;sp;rcondt{1}1;1:auto;1:smt(parse_valid). - rcondt{1}1;auto;1:smt(parse_valid);sp. - rcondf{1}3;auto;1:smt(parse_valid);sp. - rcondf{1}5;auto;1:smt(dom_set in_fsetU1 nseq0 cats0 parse_valid). - rcondt{2}1;auto;rcondf{2}7;1:by auto;sp;if;auto. - swap{1}4 3;auto;conseq(:_==> lres{1} = bs{2} /\ ={S.paths, S.mi, S.m} - /\ ={C.c} /\ inv_map F.RO.m{1} BIRO.IRO.mp{2});1:smt(DBlock.dunifin_ll). - rcondf{1}6;1:auto;1:smt(dom_set in_fsetU1 nseq0 cats0 parse_valid). - sp;if{2}. - - by rcondt{1}2;auto;smt(parse_valid dom_set in_fsetU1 valid_uniq formatK - parseK getP in_dom DBlock.dunifin_ll last_rcons). - rcondf{1}2;auto;smt(parse_valid dom_set in_fsetU1 valid_uniq formatK parseK - getP in_dom DBlock.dunifin_ll last_rcons). - if;auto;sp;rcondt{1}1;auto;1:smt(parse_valid). - rcondt{1}1;auto;1:smt(parse_valid);sp. - rcondf{1}3;auto;1:smt(parse_valid). - rcondf{1}5;auto;1:smt(dom_set in_fsetU1 nseq0 cats0 parse_valid). - swap{1}4 3;auto;conseq(:_==> lres{1} = bs0{2} /\ ={S.paths, S.mi, S.m} - /\ ={C.c} /\ inv_map F.RO.m{1} BIRO.IRO.mp{2});1:smt(DBlock.dunifin_ll). - rcondt{2}1;1:auto=>/#;sp. - splitwhile{1} 6 : i + 1 < n. - rcondt{1}7;1:auto. - + by while(i < n);auto;2:smt();sp;if;auto;sp;if;auto;while(i < n);auto. - rcondf{1}9;1:auto. - + by while(i < n);auto;2:smt();sp;if;auto;sp;if;auto;while(i < n);auto. - rcondf{1}9;1:auto. - + by while(i < n);auto;2:smt();sp;if;auto;sp;if;auto;while(i < n);auto. - auto. - conseq(:_==> rcons lres{1} b{1} = bs0{2} - /\ inv_map F.RO.m{1} BIRO.IRO.mp{2});auto. - while(i{1} + 1 = i0{2} /\ n{1} = n0{2} /\ valid p{1} - /\ F.RO.m.[format p (i+1)]{1} = Some b{1} - /\ (forall j, 0 < j <= i{1} + 1 => format p{1} j \in dom F.RO.m{1}) - /\ x0{2} = p{1} /\ 0 <= i{1} < n{1} - /\ rcons lres{1} b{1} = bs0{2} - /\ inv_map F.RO.m{1} BIRO.IRO.mp{2}). - + sp;rcondt{1}1;1:auto;sp;rcondt{1}1;1:auto;1:smt(parseK). - wp 4 1=>/=;swap{1}1;sp. - conseq(:_==> (forall j, 0 < j <= i{1}+1 => format p{1} j \in dom F.RO.m{1}) - /\ inv_map F.RO.m{1} BIRO.IRO.mp{2});1:smt(get_oget in_dom). - splitwhile{1}1 : i1 + 1 < n1. - rcondt{1}2;first by auto;while(i1 < n1);auto;smt(parseK). - rcondf{1}7;first by auto;while(i1 < n1);auto;smt(parseK). - seq 4 0:( (forall j, 0 < j <= i{1} => format p{1} j \in dom F.RO.m{1}) - /\ inv_map F.RO.m{1} BIRO.IRO.mp{2} /\ valid p{1} - /\ x4{1} = format p{1} (i{1} + 1) /\ 0 <= i{1} /\ x6{1} = x4{1} - /\ x2{2} = p{1} /\ n2{2} = i{1});last first. - - rcondf{1}4;1:auto;1:smt(dom_set in_fsetU1);rnd{1}. - if{2}. - * by rcondt{1}2;auto;smt(parse_valid dom_set in_fsetU1 valid_uniq formatK - parseK getP in_dom DBlock.dunifin_ll last_rcons dom_set in_fsetU1). - by rcondf{1}2;auto;smt(parse_valid dom_set in_fsetU1 valid_uniq formatK parseK - getP in_dom DBlock.dunifin_ll last_rcons). - alias{1} 1 m = F.RO.m;sp. - wp;conseq(:_==> F.RO.m{1} = m{1} /\ i1{1} = n1{1}-1);1:smt(parseK). - while{1}((forall j, 0 < j < n1{1} => format p1{1} j \in dom F.RO.m{1}) - /\ 0 <= i1{1} < n1{1} /\ p1{1} = p{1} - /\ F.RO.m{1} = m{1})(n1{1}-1-i1{1});progress. - + by sp;rcondf 2;auto;smt(DBlock.dunifin_ll). - by auto;smt(parseK). - if{2}. - + by rcondt{1}2;auto;smt(parse_valid dom_set in_fsetU1 valid_uniq formatK - parseK getP in_dom DBlock.dunifin_ll last_rcons dom_set in_fsetU1). - by rcondf{1}2;auto;smt(parse_valid dom_set in_fsetU1 valid_uniq formatK parseK - getP in_dom DBlock.dunifin_ll last_rcons). - qed. + local module (L (D : DISTINGUISHER) : F.RO_Distinguisher) (F : F.RO) = { + proc distinguish = SLCommon.IdealIndif(IF'(F), S, A(D)).main + }. - local module Valid (F : F.RO) = { + local module Valid2 (F : F.RO) = { proc init = F.init proc f (q : block list) = { var r : block <- b0; @@ -404,20 +310,19 @@ section Real_Ideal. (s,t) <- parse q; if (valid s) { r <@ F.get(q); - } else { - F.sample(q); } return r; } }. - local module L2 (D : DISTINGUISHER) (F : F.RO) = - SLCommon.IdealIndif(Valid(F), S, A(D)). + local module (L2 (D : DISTINGUISHER) : F.RO_Distinguisher) (F : F.RO) = { + proc distinguish = SLCommon.IdealIndif(Valid2(F), S, A(D)).main + }. local equiv Ideal_equiv_valid (D <: DISTINGUISHER{SLCommon.C, C, IF, BIRO.IRO, S}) : - L(D,F.LRO).main + L(D,F.LRO).distinguish ~ - L2(D,F.LRO).main + L2(D,F.LRO).distinguish : ={glob D} ==> ={glob D, res}. proof. @@ -426,10 +331,9 @@ section Real_Ideal. + proc;sp;if;auto. call(: ={glob IF,glob S});auto. sp;if;auto;if;auto;sp. - - call(: ={glob IF});2:auto;2:smt();sp;if;auto;1:smt(). - inline F.LRO.sample;call(: ={glob IF});auto;progress. - by while{1}(true)(n{1}-i{1});auto;smt(). - by inline*;auto. + call(: ={glob IF});2:auto;2:smt();sp;if;auto;1:smt(). + inline F.LRO.sample;call(: ={glob IF});auto;progress. + by while{1}(true)(n{1}-i{1});auto;smt(). + by proc;sim. proc;sp;if;auto;sp;call(: ={glob IF,glob S});auto. sp;if;auto. @@ -437,18 +341,243 @@ section Real_Ideal. + sp;if;auto. call(: ={glob IF});auto. sp;if;auto;progress;1,2:smt(). - + call(: ={glob IF});auto. - conseq(:_==> true);auto. - by inline*;while{1}(true)(n{1}-i{1});auto;smt(). - by inline*;auto. - call(: ={glob IF});auto;sp;if;auto;1:smt(). - + call(: ={glob IF});auto. + call(: ={glob IF});auto. conseq(:_==> true);auto. by inline*;while{1}(true)(n{1}-i{1});auto;smt(). - by inline*;auto. + call(: ={glob IF});auto;sp;if;auto;1:smt(). + call(: ={glob IF});auto. + conseq(:_==> true);auto. + by inline*;while{1}(true)(n{1}-i{1});auto;smt(). qed. + local equiv ideal_equiv2 (D <: DISTINGUISHER{SLCommon.C, C, IF, BIRO.IRO, S}) : + L2(D,F.RO).distinguish ~ SLCommon.IdealIndif(IF,S,A(D)).main + : ={glob D} ==> ={glob D, res}. + proof. + proc;inline*;sp;wp. + call(: ={glob F.RO, glob S, glob C});auto. + + proc;auto;sp;if;auto. + call(: ={glob F.RO, glob S});auto. + if;1,3:auto;sim;if;auto. + call(: ={glob F.RO});2:auto. + (* This is false *) + admit. + + by proc;sim. + proc;sp;if;auto;sp. + call(: ={glob F.RO});auto;sp;if;auto;inline*;auto;sp. + rcondt{1}1;1:auto;1:smt(parse_valid parseK formatK);sp. + case(0 < n{1});last first. + + by rcondf{2}4;1:auto;rcondf{1}5;auto. + while(={lres,F.RO.m,i,n,p,b} /\ valid p{1} /\ 0 <= i{1} <= n{1}). + + sp;if;1:auto. + - by sp;rcondt{1}1;auto;smt(parse_valid parseK formatK). + auto;smt(parse_valid parseK formatK). + auto;smt(parse_valid parseK formatK). + qed. + + + local module IF2(F : F.RO) = { + proc init = F.init + proc f (x : block list) : block = { + var b : block <- b0; + var i : int <- 0; + var p,n; + (p,n) <- parse x; + if (valid p) { + if (0 < n) { + while (i < n) { + i <- i + 1; + F.sample(format p i); + } + b <@ F.get(x); + } else { + F.sample(x); + } + } + return b; + } + }. + + + local module (L3 (D : DISTINGUISHER) : F.RO_Distinguisher) (F : F.RO) = { + proc distinguish = SLCommon.IdealIndif(IF2(F), S, A(D)).main + }. + + + + local equiv Ideal_equiv3 (D <: DISTINGUISHER{SLCommon.C, C, IF, BIRO.IRO, S}) : + L(D,F.RO).distinguish ~ L3(D,F.RO).distinguish + : ={glob D} ==> ={glob D, res}. + proof. + proc;inline*;auto;sp. + call(: ={glob S, glob F.RO, glob C});auto;first last. + + by proc;sim. + + proc;sp;if;auto;call(: ={glob F.RO});auto;sp. + inline*;if;auto;sp. + rcondt{1}1;1:auto;1:smt(parse_valid parseK formatK). + rcondt{2}1;1:auto;1:smt(parse_valid parseK formatK). + rcondt{2}1;1:auto;1:smt(parse_valid parseK formatK). + rcondt{1}1;1:auto;1:smt(parse_valid parseK formatK);sp. + rcondf{1}3;1:auto;1:smt(parse_valid parseK formatK);sp. + rcondt{2}1;1:auto;1:smt(parse_valid parseK formatK);sp. + rcondf{2}3;1:auto;1:smt(parse_valid parseK formatK);sp. + case(0 < n{1});auto;last first. + - by rcondf{1}8;1:auto;rcondf{2}8;1:auto;sim=>/#. + while(={i,n,p,lres,b,F.RO.m} /\ valid p{1} /\ 0 <= i{1} <= n{1}). + - sp;if;1,3:auto=>/#. + sp;rcondt{2}1;1:auto;1:smt(parse_valid parseK formatK). + rcondt{1}1;2:rcondt{2}1;1,2:(auto;smt(parseK formatK parse_valid)). + conseq(:_==> ={b,F.RO.m});2:sim;progress=>/#. + by wp 5 5;conseq(:_==> ={F.RO.m,r,x2});2:sim;smt(). + proc;sp;if;auto;call(: ={F.RO.m, glob S});auto. + if;1,3:auto;sim;if;auto. + call(: ={glob F.RO});auto;sp;inline*. + if;1,3:auto;1:smt(). + rcondt{2}1;1:auto;1:smt(parse_valid parseK formatK valid_gt0);sim;smt(). + qed. + + local module D2 (D : DISTINGUISHER) (F : F.RO) = { + proc distinguish = D(FC(DSqueeze(Valid2(F))), PC(S(Valid2(F)))).distinguish + }. + + local module D3 (D : DISTINGUISHER) (F : F.RO) = { + proc distinguish = D(FC(DSqueeze(IF'(F))), PC(S(IF'(F)))).distinguish + }. + + + local lemma equiv_ideal (D <: DISTINGUISHER{SLCommon.C, C, IF, BIRO.IRO, S,F.FRO}) &m: + Pr[SLCommon.IdealIndif(IF,S,SLCommon.DRestr(A(D))).main() @ &m : res] = + Pr[L3(D,F.RO).distinguish() @ &m : res]. + proof. + cut->:Pr[SLCommon.IdealIndif(IF, S, SLCommon.DRestr(A(D))).main() @ &m : res] + = Pr[SLCommon.IdealIndif(IF, S, A(D)).main() @ &m : res]. + + by byequiv(ideal_equiv D)=>//=. + cut<-:Pr[L(D, F.RO).distinguish() @ &m : res] = + Pr[L3(D, F.RO).distinguish() @ &m : res]. + + by byequiv(Ideal_equiv3 D). + cut<-:Pr[L2(D,F.RO).distinguish() @ &m : res] = + Pr[SLCommon.IdealIndif(IF,S,A(D)).main() @ &m : res]. + + by byequiv(ideal_equiv2 D). + cut->:Pr[L2(D, F.RO).distinguish() @ &m : res] = + Pr[L2(D,F.LRO).distinguish() @ &m : res]. + + byequiv=>//=;proc;sp;inline*;sp;wp. + transitivity{1} { + b1 <@ D2(D,F.RO).distinguish(); + } + (={glob D, glob F.RO, glob C, glob S} ==> ={b1}) + (={glob D, glob F.RO, glob C, glob S} ==> ={b1});progress;1:smt();1:sim. + transitivity{1} { + b1 <@ D2(D,F.LRO).distinguish(); + } + (={glob D, glob F.RO, glob C, glob S} ==> ={b1}) + (={glob D, glob F.RO, glob C, glob S} ==> ={b1});progress;1:smt();2:sim. + by call(F.RO_LRO_D (D2(D)));auto. + cut->:Pr[L(D, F.RO).distinguish() @ &m : res] = + Pr[L(D,F.LRO).distinguish() @ &m : res]. + + byequiv=>//=;proc;sp;inline*;sp;wp. + transitivity{1} { + b1 <@ D3(D,F.RO).distinguish(); + } + (={glob D, glob F.RO, glob C, glob S} ==> ={b1}) + (={glob D, glob F.RO, glob C, glob S} ==> ={b1});progress;1:smt();1:sim. + transitivity{1} { + b1 <@ D3(D,F.LRO).distinguish(); + } + (={glob D, glob F.RO, glob C, glob S} ==> ={b1}) + (={glob D, glob F.RO, glob C, glob S} ==> ={b1});progress;1:smt();2:sim. + by call(F.RO_LRO_D (D3(D)));auto. + rewrite eq_sym. + by byequiv(Ideal_equiv_valid D). + qed. + + + local equiv double_squeeze : + DSqueeze(IF2(F.RO)).f ~ Squeeze(IF).f : + ={arg, F.RO.m} ==> ={res, F.RO.m}. + proof. + proc;inline*;auto;sp;if;auto;sp. + rcondt{1}1;1:(auto;smt(parse_valid valid_gt0)). + rcondt{1}1;1:(auto;smt(parse_valid valid_gt0)). + rcondt{1}1;1:(auto;smt(parse_valid valid_gt0));sp. + rcondf{1}3;1:(auto;smt(parse_valid valid_gt0));sp. + case(0 < n{1});last first. + + rcondf{2}4;1:auto=>/#. + rcondf{1}8;1:auto=>/#. + rcondf{1}5. + + auto;smt(nseq0 cats0 dom_set in_fsetU1 parse_valid). + by wp;rnd{1};auto;smt(DBlock.dunifin_ll nseq0 cats0 parse_valid set_eq in_dom). + while(={F.RO.m,n,b,i,lres,p} /\ valid p{1} /\ 0 < n{1} /\ 0 <= i{1} <= n{1} + /\ (i{1}+1 < n{1} => (forall j, 0 <= j <= i{1} => format p{1} (j+1) \in dom F.RO.m{1}))). + + sp;if;1,3:auto=>/#. + sp;rcondt{1}1;1:(auto;smt(parseK formatK)). + rcondt{1}1;1:(auto;smt(parseK formatK valid_gt0)). + conseq(:_==> ={b,F.RO.m} /\ (forall (j : int), 0 <= j <= i{1} => + format p{1} (j+1) \in dom F.RO.m{2}));1:smt(). + splitwhile{1} 1 : i1 + 1 < n1. + rcondt{1}2;1:auto. + + by while(i1 < n1);auto;smt(valid_gt0 parseK formatK). + rcondf{1}7;1:auto. + + by while(i1 < n1);auto;smt(valid_gt0 parseK formatK). + seq 3 0 : (={F.RO.m,x0} /\ x0{1} = format p{1} (i{1}+1) /\ x4{1} = x0{1} /\ + (forall (j : int), 0 <= j < i{1} => format p{1} (j+1) \in dom F.RO.m{2}));last first. + + sp;rcondf{1}5;1:auto;1:smt(dom_set in_fsetU1). + by wp;rnd{1};auto;smt(DBlock.dunifin_ll dom_set in_fsetU1). + wp. + conseq(:_==> ={F.RO.m} /\ i1{1} + 1 = n1{1});1:smt(parseK formatK). + while{1}(={F.RO.m} /\ 0 < i1{1} + 1 <= n1{1} <= n{1} /\ + (forall j, 0 <= j < n1{1}-1 => format p1{1} (j+1) \in dom F.RO.m{1}))(n1{1}-i1{1}). + + by progress;sp;rcondf 2;auto;smt(DBlock.dunifin_ll). + by auto;smt(formatK parseK). + by rcondf{1}5;2:(wp;rnd{1});auto;smt(DBlock.dunifin_ll dom_set in_fsetU1 nseq0 cats0 parse_valid). + qed. + + + local equiv Ideal_equiv (D <: DISTINGUISHER{SLCommon.C, C, IF, BIRO.IRO, S}) : + L3(D,F.RO).distinguish + ~ + IdealIndif(Squeeze(IF), SimLast(S), DRestr(D)).main + : + ={glob D} ==> ={glob D, res}. + proof. + proc;inline*;auto;sp. + call(: ={glob S, glob C, F.RO.m});auto;first last. + + by proc;inline*;sp;if;auto;sp;if;auto. + + proc;sp;if;auto;sp. + by call(double_squeeze);auto;progress. + proc;sp;if;auto;inline{1}1;inline{2}1;sp;if;1:auto;sim;if;auto. + sp;inline*;sp;if;1,3:(auto;smt(parse_valid));sp. + rcondt{1}1;1:(auto;smt(parse_valid valid_gt0)). + rcondt{2}1;1:(auto;smt(parse_valid valid_gt0));sp. + rcondt{1}1;1:(auto;smt(parse_valid valid_gt0));sp. + splitwhile{2}4: i + 1 < n. + rcondt{2}5;1:auto. + + while(i < n);1:(sp;if);auto;smt(valid_gt0). + rcondf{2}7;1:auto. + + while(i < n);1:(sp;if);auto;smt(valid_gt0). + rcondf{2}7;1:auto. + + while(i < n);1:(sp;if);auto;smt(valid_gt0). + seq 3 4 : (F.RO.m.[x0]{1} = Some b{2} /\ ={x, C.c, S.paths, F.RO.m});last first. + + sp;rcondf{1}2;auto;smt(in_dom DBlock.dunifin_ll last_rcons). + conseq(: _==> F.RO.m{1}.[format p0{1} i{1}] = Some b{2} /\ i{1} = n{1} /\ ={F.RO.m});progress. + + rewrite-H7;congr;smt(parseK formatK). + while(={F.RO.m,n} /\ i{1} = i{2} + 1 /\ p0{1} = p1{2} /\ i{1} <= n{1} + /\ F.RO.m{1}.[format p0{1} i{1}] = Some b{2}). + + sp;rcondt{2}1;auto;smt(get_oget in_dom getP). + auto;smt(in_dom get_oget getP formatK parseK nseq0 cats0 valid_gt0). + qed. + + + + local lemma equiv_ideal' (D <: DISTINGUISHER{SLCommon.C, C, IF, BIRO.IRO, S,F.FRO}) &m: + Pr[SLCommon.IdealIndif(IF,S,SLCommon.DRestr(A(D))).main() @ &m : res] = + Pr[IdealIndif(Squeeze(IF), SimLast(S), DRestr(D)).main() @ &m : res]. + proof. + rewrite (equiv_ideal D &m). + byequiv(Ideal_equiv D)=>//. + qed. + + (* Real part *) @@ -1206,211 +1335,51 @@ section Real_Ideal. local lemma pr_real (D <: DISTINGUISHER{SLCommon.C, C, Perm, Redo}) &m : - Pr [ GReal(A(D)).main() @ &m : res /\ SLCommon.C.c <= max_size] <= + Pr [ GReal(A(D)).main() @ &m : res /\ SLCommon.C.c <= max_size] = Pr [ RealIndif(Sponge,P,DRestr(D)).main() @ &m : res]. proof. cut->:Pr [ RealIndif(Sponge, P, DRestr(D)).main() @ &m : res ] = Pr [ NIndif(Squeeze(SqueezelessSponge(P)),P,DRestr(D)).main() @ &m : res /\ C.c <= max_size ]. + by rewrite eq_sym;byequiv (squeeze_squeezeless D)=>//=. - byequiv (equiv_sponge D)=>//=;progress. + byequiv (equiv_sponge D)=>//=;progress;smt(). qed. -(* This lemma is false, overuse of valid tests *) + declare module D : DISTINGUISHER{SLCommon.C, C, Perm, Redo, F.RO, F.RRO, S, BIRO.IRO}. - local equiv Ideal_equiv_valid (D <: DISTINGUISHER{SLCommon.C, C, IF, BIRO.IRO, S}) : - L2(D,F.RO).main - ~ - SLCommon.IdealIndif(IF, S, A(D)).main - : - ={glob D} ==> ={glob D, res}. - proof. - proc;inline*;sp;wp. - call(: ={glob F.RO, glob S, glob C});auto. - + proc;sp;if;auto. - call(: ={glob IF,glob S});auto. - sp;if;auto;if;auto;sp. - - call(: ={glob IF});2:auto;2:smt();sp;if;auto;1:smt(). - inline F.LRO.sample;call(: ={glob IF});auto;progress. - by while{1}(true)(n{1}-i{1});auto;smt(). - by inline*;auto. - + by proc;sim. - proc;sp;if;auto;sp;call(: ={glob IF,glob S});auto. - sp;if;auto. - while(={glob S,glob IF,lres,i,n,p,b}). - + sp;if;auto. - call(: ={glob IF});auto. - sp;if;auto;progress;1,2:smt(). - + call(: ={glob IF});auto. - conseq(:_==> true);auto. - by inline*;while{1}(true)(n{1}-i{1});auto;smt(). - by inline*;auto. - call(: ={glob IF});auto;sp;if;auto;1:smt(). - + call(: ={glob IF});auto. - conseq(:_==> true);auto. - by inline*;while{1}(true)(n{1}-i{1});auto;smt(). - by inline*;auto. - qed. + axiom D_lossless (F0 <: DFUNCTIONALITY{D}) (P0 <: DPRIMITIVE{D}) : + islossless P0.f => islossless P0.fi => islossless F0.f => + islossless D(F0, P0).distinguish. - (* TODO : Ideal *) - - - local lemma equiv_ideal - (IF <: FUNCTIONALITY{DSqueeze,C}) - (S <: SIMULATOR{DSqueeze,C,IF}) - (D <: NDISTINGUISHER{C,DSqueeze,IF,S}) : - equiv [ S(IF).init ~ S(IF).init : true ==> ={glob S} ] => - equiv [ IF.init ~ IF.init : true ==> ={glob IF} ] => - equiv [ Indif(IF,S(IF),DRestr(A(D))).main - ~ NIndif(Squeeze(IF),S(IF),NDRestr(D)).main - : ={glob D} - ==> - ={res, glob D, glob IF, glob S, NC.queries, C.c, C.c} ]. + lemma A_lossless (F <: SLCommon.DFUNCTIONALITY{A(D)}) + (P0 <: SLCommon.DPRIMITIVE{A(D)}) : + islossless P0.f => + islossless P0.fi => islossless F.f => islossless A(D, F, P0).distinguish. proof. - move=>S_init IF_init. - proc;inline*;sp;wp;swap{2}2-1;swap{1}[3..5]-2;sp. - call(: ={glob IF, glob S, C.c, glob DSqueeze} - /\ SLCommon.C.c{1} <= NC.c{1} <= max_size - /\ inv_ideal NC.queries{1} C.queries{1});auto;last first. - + call IF_init;auto;call S_init;auto;smt(dom_set in_fsetU1 dom0 in_fset0 parse_nil max_ge0). - + proc;inline*;sp;if;auto;1:call(: ={glob IF});auto;1:proc(true);progress=>//=. - + by proc;inline*;sp;if;auto;1:call(: ={glob IF});auto;proc(true)=>//=. - proc;inline*;sp=>/=;if;auto;if{2};last first. - + wp;conseq(:_==> lres{1} = oget NC.queries.[(p,i)]{1} - /\ i{1} = n{1} - /\ inv_ideal NC.queries{1} C.queries{1} - /\ ={glob IF, glob S, C.c, NC.queries});progress. - while{1}((0 < i{1} => lres{1} = oget NC.queries.[(p,i)]{1}) - /\ 0 <= i{1} <= n{1} - /\ ((p{1}, n{1}) \in dom NC.queries{1}) - /\ valid p{1} /\ 0 < n{1} - /\ inv_ideal NC.queries{1} C.queries{1} - /\ ={glob IF, glob S, C.c, NC.queries})(n{1}-i{1});progress. - - sp;rcondf 1;auto;progress;2..:rewrite/#. - cut[]h1[]h2 h3 :=H5. - cut h5:=h2 _ _ H2 n{hr} _;1:rewrite/#. - cut :=h3 _ h5 (i2+1) _;1:rewrite/#. - by cut<-/= :=h1 _ _ H2 n{hr} _;1:rewrite/#. - by auto=>/#. - - sp;if{2}. - + rcondt{2}7;1:auto;wp;sp. print inv_ideal. - while(={glob IF, glob S, C.c, NC.queries} /\ - (i,n,p,lres){1} = (i0,n0,p0,lres0){2} /\ - inv_ideal NC.queries{1} C.queries{1} /\ - - alias - - - + sp;auto=>/=. - rcondf{2}1;1:auto;progress. - + move:H4;pose s:= List.map _ _;pose c:=C.c{hr};pose p:=p{hr};pose n:=n{hr}. - apply absurd=>//=. - print diff_size_prefixe_leq_cat. prefixe_leq_prefixe_cat_size. - search prefixe (++). - - cut h:size (format p n) = size p + n - 1 by rewrite size_cat size_nseq max_ler /#. -sear - cut h':max_size < c + size (format p n) - smt(prefixe_sizel). - while{1}(={n, p, glob IF, glob S, NC.queries} - /\ i{1} = nb_iter{2} /\ lres{1} = r{2} - /\ inv_ideal NC.queries{1} C.queries{1} - /\ max_size <= SLCommon.C.c{1} - - - conseq(:_ ==> lres{1} = mkseq (+Block.b0) i{1} /\ i{1} = n{1} - /\ ={glob IF, glob S} /\ SLCommon.C.c{1} = max_size - /\ inv_ideal NC.queries{1} C.queries{1} - /\ NC.queries{1} = NC.queries{2}.[(p{1}, n{1}) <- lres{1}]); - 1:smt(min_ler min_lel max_ler max_ler). - while{1}(lres{1} = mkseq (+Block.b0) i{1} /\ i{1} = n{1} - /\ ={glob IF, glob S} /\ SLCommon.C.c{1} = max_size - /\ inv_ideal NC.queries{1} C.queries{1} - /\ NC.queries{1} = NC.queries{2}.[(p{1}, n{1}) <- lres{1}]) - (n{1}-i{1}); - - rcondt{2}1;1:auto;progress. search min. - + pose m:=C.c{hr}+_. - cut/#:1 <=min n{hr} (max 0 (n{hr} + max_size - m)). - apply min_is_glb=>[/#|]. - - rewrite /min/max. + progress;proc;inline*;sp;wp. + call(:true);auto. + + exact D_lossless. + + proc;inline*;sp;if;auto;call H;auto. + + proc;inline*;sp;if;auto;call H0;auto. + proc;inline*;sp;if;auto;sp;if;auto. + while(true)(n-i);auto. + + by sp;if;auto;1:call H1;auto;smt(). + call H1;auto;smt(). qed. -print RealIndif. - + (* REAL & IDEAL *) -module IF = { - proc init = F.RO.init - proc f = F.RO.get -}. - -module S(F : DFUNCTIONALITY) = { - var m, mi : smap - var paths : (capacity, block list * block) fmap - - proc init() = { - m <- map0; - mi <- map0; - (* the empty path is initially known by the adversary to lead to capacity 0^c *) - paths <- map0.[c0 <- ([<:block>],b0)]; - } - - proc f(x : state): state = { - var p, v, y, y1, y2; - if (!mem (dom m) x) { - if (mem (dom paths) x.`2) { - (p,v) <- oget paths.[x.`2]; - y1 <- F.f (rcons p (v +^ x.`1)); - } else { - y1 <$ bdistr; - } - y2 <$ cdistr; - y <- (y1,y2); - m.[x] <- y; - mi.[y] <- x; - if (mem (dom paths) x.`2) { - (p,v) <- oget paths.[x.`2]; - paths.[y.`2] <- (rcons p (v +^ x.`1), y.`1); - } - } else { - y <- oget m.[x]; - } - return y; - } - - proc fi(x : state): state = { - var y, y1, y2; - if (!mem (dom mi) x) { - y1 <$ bdistr; - y2 <$ cdistr; - y <- (y1,y2); - mi.[x] <- y; - m.[y] <- x; - } else { - y <- oget mi.[x]; - } - return y; - } -}. + lemma concl &m : + Pr [ RealIndif(Sponge,P,DRestr(D)).main() @ &m : res ] <= + Pr [ IdealIndif(Squeeze(IF), SimLast(S), DRestr(D)).main() @ &m : res ] + + (max_size ^ 2)%r / 2%r * mu dstate (pred1 witness) + + max_size%r * ((2*max_size)%r / (2^c)%r) + + max_size%r * ((2*max_size)%r / (2^c)%r). + proof. + rewrite-(pr_real D &m). + rewrite-(equiv_ideal' D &m). + apply(Real_Ideal (A(D)) A_lossless &m). + qed. -lemma Real_Ideal &m (D <: DISTINGUISHER): - Pr[Indif(SqueezelessSponge(PC(Perm)), PC(Perm), D).main() @ &m: res /\ C.c <= max_size] <= - Pr[Indif(IF,S(IF),DRestr(D)).main() @ &m :res] + - (max_size ^ 2)%r / 2%r * mu dstate (pred1 witness) + - max_size%r * ((2*max_size)%r / (2^c)%r) + - max_size%r * ((2*max_size)%r / (2^c)%r). -proof. -search max_size. - apply (ler_trans _ _ _ (Pr_restr _ _ _ _ _ _ &m)). - rewrite !(ler_add2l, ler_add2r);apply lerr_eq. - apply (eq_trans _ Pr[G3(F.LRO).distinguish() @ &m : res]);1:by byequiv G2_G3. - apply (eq_trans _ Pr[G3(F.RO ).distinguish() @ &m : res]). - + by byequiv (_: ={glob G3, F.RO.m} ==> _)=>//;symmetry;conseq (F.RO_LRO_D G3). - apply (eq_trans _ Pr[G4(F.RO ).distinguish() @ &m : res]);1:by byequiv G3_G4. - apply (eq_trans _ Pr[G4(F.LRO).distinguish() @ &m : res]);1:by byequiv (F.RO_LRO_D G4). - by byequiv G4_Ideal. -qed. - +end section Real_Ideal. \ No newline at end of file From a8c0c87f7a9cfb138259c81fb4a58294ee5e80ec Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Wed, 16 May 2018 15:05:01 +0200 Subject: [PATCH 287/525] Proof completed of the transformation : (block list -> block) ==> ((block list * int) -> block list). --- proof/smart_counter/Gconcl_list.ec | 794 +++++++++++++++++++++-------- 1 file changed, 572 insertions(+), 222 deletions(-) diff --git a/proof/smart_counter/Gconcl_list.ec b/proof/smart_counter/Gconcl_list.ec index f2a77f9..7645d37 100644 --- a/proof/smart_counter/Gconcl_list.ec +++ b/proof/smart_counter/Gconcl_list.ec @@ -10,9 +10,14 @@ require (*--*) Handle. (** Validity of Functionality Queries **) op valid: block list -> bool = valid_block. axiom valid_spec p: valid p => p <> []. -axiom valid_ge0 x: 0 <= (parse x).`2. -axiom valid_gt0 x: valid (parse x).`1 => 0 < (parse x).`2. - +axiom parse_gt0 x: 0 < (parse x).`2. +axiom parse_not_valid x : + !valid (parse x).`1 => + forall i, ! valid (parse (format (parse x).`1 i)).`1. +axiom parse_twice p n x : + (p,n) = parse x => forall i, 0 < i <= n => parse (format p i) = (p,i). +axiom valid_uniq p1 p2 n1 n2 : + valid p1 => valid p2 => format p1 n1 = format p2 n2 => p1 = p2 /\ n1 = n2. clone export Handle as Handle0. @@ -74,21 +79,39 @@ module NIndif (F : FUNCTIONALITY, P : PRIMITIVE, D : DISTINGUISHER) = { module P = Perm. +clone IRO as BIRO2 with + type from <- block list, + type to <- block, + op valid <- predT, + op dto <- bdistr. + +module Valid (F : DFUNCTIONALITY) = { + proc init () = {} + proc f (q : block list, k : int) = { + var re : block list <- []; + (q,k) <- parse (format q k); + if (valid q) { + re <@ F.f(q,k); + } else { + re <@ BIRO2.IRO.f(q,k); + } + return re; + } +}. -section Real_Ideal. +module SimLast (S : SLCommon.SIMULATOR) (F : DFUNCTIONALITY) = { + proc init() = { + BIRO2.IRO.init(); + S(Last(Valid(F))).init(); + } + proc f = S(Last(Valid(F))).f + proc fi = S(Last(Valid(F))).fi +}. + +clone F as F2. - module Valid (F : DFUNCTIONALITY) = { - proc init () = {} - proc f (q : block list, k : int) = { - var re : block list <- []; - if (valid q) { - re <@ F.f(q,k); - } - return re; - } - }. - module SimLast (S : SLCommon.SIMULATOR) (F : DFUNCTIONALITY) = S(Last(Valid(F))). +section Ideal. op (<=) (m1 m2 : (block list, 'b) fmap) = forall x, x <> [] => x \in dom m1 => m1.[x] = m2.[x]. @@ -148,7 +171,7 @@ section Real_Ideal. m1.[x <- y] <= m2.[x <- y] by smt(in_dom getP dom_set in_fsetU1). - local equiv ideal_equiv (D <: DISTINGUISHER{SLCommon.C, C, IF, BIRO.IRO, S}) : + local equiv ideal_equiv (D <: DISTINGUISHER{SLCommon.C, C, IF, S}) : SLCommon.IdealIndif(IF, S, SLCommon.DRestr(A(D))).main ~ SLCommon.IdealIndif(IF, S, A(D)).main @@ -261,56 +284,29 @@ section Real_Ideal. var i : int <- 0; var p,n; (p,n) <- parse x; - if (valid p) { - while (i < n) { - i <- i + 1; - F.sample(format p i); - } - b <@ F.get(x); + while (i < n) { + i <- i + 1; + F.sample(format p i); } + b <@ F.get(x); return b; } }. - local module SampleFirst (I : BIRO.IRO) = { - proc init = I.init - proc f (m : block list, k : int) = { - var r : block list <- []; - if (k <= 0) { - I.f(m,1); - } else { - r <- I.f(m,k); - } - return r; - } - }. - - - axiom valid_uniq p1 p2 n1 n2 : - valid p1 => valid p2 => format p1 n1 = format p2 n2 => p1 = p2 /\ n1 = n2. - - op inv_map (m1 : (block list, block) fmap) (m2 : (block list * int, block) fmap) = - (forall p n, valid p => (p,n) \in dom m2 <=> format p (n+1) \in dom m1) - /\ (forall x, x \in dom m1 <=> ((parse x).`1,(parse x).`2-1) \in dom m2) - /\ (forall p n, valid p => m2.[(p,n-1)] = m1.[format p n]) - /\ (forall x, m1.[x] = m2.[((parse x).`1,(parse x).`2-1)]). local module (L (D : DISTINGUISHER) : F.RO_Distinguisher) (F : F.RO) = { proc distinguish = SLCommon.IdealIndif(IF'(F), S, A(D)).main }. - local module Valid2 (F : F.RO) = { proc init = F.init proc f (q : block list) = { var r : block <- b0; var s,t; (s,t) <- parse q; - if (valid s) { - r <@ F.get(q); - } + r <@ F.get(q); return r; } }. @@ -319,7 +315,7 @@ section Real_Ideal. proc distinguish = SLCommon.IdealIndif(Valid2(F), S, A(D)).main }. - local equiv Ideal_equiv_valid (D <: DISTINGUISHER{SLCommon.C, C, IF, BIRO.IRO, S}) : + local equiv Ideal_equiv_valid (D <: DISTINGUISHER{SLCommon.C, C, IF, S}) : L(D,F.LRO).distinguish ~ L2(D,F.LRO).distinguish @@ -327,11 +323,11 @@ section Real_Ideal. ={glob D} ==> ={glob D, res}. proof. proc;inline*;sp;wp. - call(: ={glob F.RO, glob S, glob C});auto. + call(: ={glob S, glob C, glob F.RO});auto. + proc;sp;if;auto. - call(: ={glob IF,glob S});auto. + call(: ={glob S,glob F.RO});auto. sp;if;auto;if;auto;sp. - call(: ={glob IF});2:auto;2:smt();sp;if;auto;1:smt(). + call(: ={glob F.RO});2:auto;2:smt(). inline F.LRO.sample;call(: ={glob IF});auto;progress. by while{1}(true)(n{1}-i{1});auto;smt(). + by proc;sim. @@ -340,18 +336,17 @@ section Real_Ideal. while(={glob S,glob IF,lres,i,n,p,b}). + sp;if;auto. call(: ={glob IF});auto. - sp;if;auto;progress;1,2:smt(). call(: ={glob IF});auto. conseq(:_==> true);auto. by inline*;while{1}(true)(n{1}-i{1});auto;smt(). - call(: ={glob IF});auto;sp;if;auto;1:smt(). + call(: ={glob IF});auto. call(: ={glob IF});auto. conseq(:_==> true);auto. by inline*;while{1}(true)(n{1}-i{1});auto;smt(). qed. - local equiv ideal_equiv2 (D <: DISTINGUISHER{SLCommon.C, C, IF, BIRO.IRO, S}) : + local equiv ideal_equiv2 (D <: DISTINGUISHER{SLCommon.C, C, IF, S}) : L2(D,F.RO).distinguish ~ SLCommon.IdealIndif(IF,S,A(D)).main : ={glob D} ==> ={glob D, res}. proof. @@ -361,39 +356,47 @@ section Real_Ideal. call(: ={glob F.RO, glob S});auto. if;1,3:auto;sim;if;auto. call(: ={glob F.RO});2:auto. - (* This is false *) - admit. + by inline*;sp;wp 2 2;sim. + by proc;sim. proc;sp;if;auto;sp. call(: ={glob F.RO});auto;sp;if;auto;inline*;auto;sp. - rcondt{1}1;1:auto;1:smt(parse_valid parseK formatK);sp. case(0 < n{1});last first. + by rcondf{2}4;1:auto;rcondf{1}5;auto. while(={lres,F.RO.m,i,n,p,b} /\ valid p{1} /\ 0 <= i{1} <= n{1}). + sp;if;1:auto. - - by sp;rcondt{1}1;auto;smt(parse_valid parseK formatK). - auto;smt(parse_valid parseK formatK). - auto;smt(parse_valid parseK formatK). + - by auto;smt(parse_valid parseK formatK). + by auto;smt(parse_valid parseK formatK). + by auto;smt(parse_valid parseK formatK). qed. - local module IF2(F : F.RO) = { - proc init = F.init + inductive inv_L_L3 (m1 m2 m3 : (block list, block) fmap) = + | INV of (m1 = m2 + m3) + & (forall l, l \in dom m2 => valid (parse l).`1) + & (forall l, l \in dom m3 => ! valid (parse l).`1). + + local module IF2(F : F.RO) (F2 : F2.RO) = { + proc init () = { + F.init(); + F2.init(); + } proc f (x : block list) : block = { var b : block <- b0; var i : int <- 0; var p,n; (p,n) <- parse x; if (valid p) { - if (0 < n) { - while (i < n) { - i <- i + 1; - F.sample(format p i); - } - b <@ F.get(x); - } else { - F.sample(x); + while (i < n) { + i <- i + 1; + F.sample(format p i); } + b <@ F.get(x); + } else { + while (i < n) { + i <- i + 1; + F2.sample(format p i); + } + b <@ F2.get(x); } return b; } @@ -401,40 +404,169 @@ section Real_Ideal. local module (L3 (D : DISTINGUISHER) : F.RO_Distinguisher) (F : F.RO) = { - proc distinguish = SLCommon.IdealIndif(IF2(F), S, A(D)).main + proc distinguish = SLCommon.IdealIndif(IF2(F,F2.RO), S, A(D)).main }. - + local lemma lemma1 m1 m2 m3 p i r: + inv_L_L3 m1 m2 m3 => + valid p => + 0 < i => + ! format p i \in dom m1 => + ! format p i \in dom m2 => + inv_L_L3 m1.[format p i <- r] m2.[format p i <- r] m3. + proof. + move=>INV0 p_valid i_gt0 nin_dom1 nin_dom2;split;cut[]add_maps valid_dom nvalid_dom:=INV0. + + rewrite add_maps fmapP=>x. + by rewrite getP !joinP getP;smt(parseK formatK). + + smt(dom_set in_fsetU1 parseK formatK). + + smt(dom_set in_fsetU1 parseK formatK). + qed. + + local lemma lemma2 m1 m2 m3 p i: + inv_L_L3 m1 m2 m3 => + valid p => + 0 < i => + format p i \in dom m1 => + format p i \in dom m2. + proof. + move=>INV0 p_valid i_gt0 in_dom1;cut[]add_maps valid_dom nvalid_dom:=INV0. + cut:=in_dom1;rewrite add_maps dom_join in_fsetU=>[][]//=in_dom3. + by cut:=nvalid_dom _ in_dom3;rewrite parseK//=. + qed. + + + local lemma incl_dom m1 m2 m3 l : + inv_L_L3 m1 m2 m3 => + l \in dom m1 <=> (l \in dom m2 \/ l \in dom m3). + proof. + move=>INV0;cut[]add_maps valid_dom nvalid_dom:=INV0. + by rewrite add_maps dom_join in_fsetU. + qed. + - local equiv Ideal_equiv3 (D <: DISTINGUISHER{SLCommon.C, C, IF, BIRO.IRO, S}) : + local lemma lemma3 m1 m2 m3 x r: + inv_L_L3 m1 m2 m3 => + ! valid (parse x).`1 => + ! x \in dom m1 => + inv_L_L3 m1.[x <- r] m2 m3.[x <- r]. + proof. + move=>INV0 not_valid nin_dom1;cut[]add_maps h1 h2:=INV0. + cut nin_dom3: ! x \in dom m3 by smt(incl_dom). + split. + + by rewrite fmapP=>y;rewrite add_maps !getP!joinP!getP dom_set in_fsetU1/#. + + exact h1. + smt(dom_set in_fsetU1). + qed. + + + local equiv Ideal_equiv3 (D <: DISTINGUISHER{SLCommon.C, C, IF, S, F2.RO}) : L(D,F.RO).distinguish ~ L3(D,F.RO).distinguish : ={glob D} ==> ={glob D, res}. proof. proc;inline*;auto;sp. - call(: ={glob S, glob F.RO, glob C});auto;first last. - + by proc;sim. - + proc;sp;if;auto;call(: ={glob F.RO});auto;sp. + call(: ={glob S, glob C} /\ inv_L_L3 F.RO.m{1} F.RO.m{2} F2.RO.m{2});auto;first last. + + proc;sp;if;auto. + by call(: ={glob S});auto;sim. + + proc;sp;if;auto;call(: inv_L_L3 F.RO.m{1} F.RO.m{2} F2.RO.m{2});auto;sp. inline*;if;auto;sp. rcondt{1}1;1:auto;1:smt(parse_valid parseK formatK). rcondt{2}1;1:auto;1:smt(parse_valid parseK formatK). - rcondt{2}1;1:auto;1:smt(parse_valid parseK formatK). - rcondt{1}1;1:auto;1:smt(parse_valid parseK formatK);sp. - rcondf{1}3;1:auto;1:smt(parse_valid parseK formatK);sp. rcondt{2}1;1:auto;1:smt(parse_valid parseK formatK);sp. + rcondf{1}3;1:auto;1:smt(parse_valid parseK formatK);sp. rcondf{2}3;1:auto;1:smt(parse_valid parseK formatK);sp. + rcondf{1}5;2:rcondf{2}5; + 1,2:by auto;smt(dom_set in_fsetU1 nseq0 cats0 parse_valid). case(0 < n{1});auto;last first. - - by rcondf{1}8;1:auto;rcondf{2}8;1:auto;sim=>/#. - while(={i,n,p,lres,b,F.RO.m} /\ valid p{1} /\ 0 <= i{1} <= n{1}). + - rcondf{1}7;1:auto;rcondf{2}7;1:auto. + by wp;rnd;auto;progress;smt(lemma1 nseq0 cats0 lemma2 incl_dom + parse_valid parseK formatK in_fsetU). + while(={i,n,p,lres,b} /\ valid p{1} /\ 0 <= i{1} <= n{1} + /\ inv_L_L3 F.RO.m{1} F.RO.m{2} F2.RO.m{2}). - sp;if;1,3:auto=>/#. sp;rcondt{2}1;1:auto;1:smt(parse_valid parseK formatK). - rcondt{1}1;2:rcondt{2}1;1,2:(auto;smt(parseK formatK parse_valid)). - conseq(:_==> ={b,F.RO.m});2:sim;progress=>/#. - by wp 5 5;conseq(:_==> ={F.RO.m,r,x2});2:sim;smt(). - proc;sp;if;auto;call(: ={F.RO.m, glob S});auto. - if;1,3:auto;sim;if;auto. - call(: ={glob F.RO});auto;sp;inline*. - if;1,3:auto;1:smt(). - rcondt{2}1;1:auto;1:smt(parse_valid parseK formatK valid_gt0);sim;smt(). + conseq(:_==> ={b} /\ inv_L_L3 F.RO.m{1} F.RO.m{2} F2.RO.m{2});1:progress=>/#. + auto=>/=. + conseq(:_==> inv_L_L3 F.RO.m{1} F.RO.m{2} F2.RO.m{2});progress. + * by rewrite!getP//=. + * smt(lemma1 parse_valid). + * smt(lemma2 parse_valid). + * smt(lemma2 parse_valid). + * smt(incl_dom). + * smt(incl_dom). + * case:H8;smt(joinP). + while(={i1,n1,p1} /\ valid p1{1} /\ 0 <= i1{1} <= n1{1} + /\ inv_L_L3 F.RO.m{1} F.RO.m{2} F2.RO.m{2}). + * sp;conseq(:_==> inv_L_L3 F.RO.m{1} F.RO.m{2} F2.RO.m{2});1:smt(). + case(x6{1} \in dom F.RO.m{1}). + + by rcondf{1}2;2:rcondf{2}2;auto;smt(incl_dom lemma2). + by rcondt{1}2;2:rcondt{2}2;auto;smt(lemma2 incl_dom lemma1). + by auto;smt(parseK). + wp;rnd;wp 2 2. + conseq(:_==> F.RO.m{1}.[p{1}] = F.RO.m{2}.[p{2}] + /\ inv_L_L3 F.RO.m{1} F.RO.m{2} F2.RO.m{2});progress. + + cut[]add_maps h1 h2:=H5;rewrite add_maps joinP//=;smt(parse_valid). + + smt(). + case(x5{1} \in dom F.RO.m{1}). + - rcondf{1}2;2:rcondf{2}2;auto;progress. + * smt(lemma2 incl_dom parse_valid). + by cut[]add_maps h1 h2:=H1;rewrite add_maps joinP//=;smt(parse_valid). + rcondt{1}2;2:rcondt{2}2;auto;progress. + - smt(lemma2 incl_dom parse_valid). + - cut[]add_maps h1 h2:=H1;rewrite add_maps !getP joinP//=;smt(parse_valid nseq0 cats0). + - cut:=H;rewrite -H0=>//=[][]->>->>;apply lemma1=>//=;1:smt(parse_valid). + cut[]add_maps h1 h2:=H1;smt(parse_valid formatK parseK incl_dom). + + progress;split. + - by rewrite fmapP=>x;rewrite joinP map0P//=. + - smt(dom0 in_fset0). + - smt(dom0 in_fset0). + proc;sp;if;auto;call(: ={glob S} /\ inv_L_L3 F.RO.m{1} F.RO.m{2} F2.RO.m{2});auto. + if;1,3:auto. + seq 1 1 : (={x, y1, S.paths, S.mi, S.m} /\ inv_L_L3 F.RO.m{1} F.RO.m{2} F2.RO.m{2});last first. + + by conseq(:_==> ={y, S.paths, S.mi, S.m});progress;sim. + if;auto. + call(: inv_L_L3 F.RO.m{1} F.RO.m{2} F2.RO.m{2});auto;sp;inline*. + if{2}. + + seq 1 1 : (={x,p,n} /\ parse x{1} = (p,n){1} /\ valid p{1} + /\ inv_L_L3 F.RO.m{1} F.RO.m{2} F2.RO.m{2});last first. + - sp;case(x1{1} \in dom F.RO.m{1}). + * rcondf{1}2;2:rcondf{2}2;auto;progress. + + cut:=H2;rewrite -formatK H/=;smt(lemma2 incl_dom parse_gt0). + cut[]add_maps h1 h2:=H1;rewrite add_maps joinP. + cut:=H2;rewrite -formatK H/==>in_dom1. + case(format p{2} n{2} \in dom F2.RO.m{2})=>//=in_dom3. + by cut:=h2 _ in_dom3;rewrite parseK//=;smt(parse_gt0). + rcondt{1}2;2:rcondt{2}2;auto;progress. + + smt(incl_dom lemma2). + + cut[]:=H1;smt(getP joinP). + by cut:=H2;rewrite-formatK H/==>nin_dom1;rewrite lemma1//=;smt(parse_gt0 lemma2 incl_dom). + conseq(:_==> inv_L_L3 F.RO.m{1} F.RO.m{2} F2.RO.m{2});1:smt(). + while(={i,n,p} /\ 0 <= i{1} /\ valid p{1} /\ inv_L_L3 F.RO.m{1} F.RO.m{2} F2.RO.m{2}). + + sp;case(x2{1} \in dom F.RO.m{1}). + - by rcondf{1}2;2:rcondf{2}2;auto;smt(lemma2). + by rcondt{1}2;2:rcondt{2}2;auto;progress;smt(incl_dom lemma1). + auto;smt(). + seq 1 1 : (={x,p,n} /\ parse x{1} = (p,n){1} /\ ! valid p{1} + /\ inv_L_L3 F.RO.m{1} F.RO.m{2} F2.RO.m{2});last first. + + sp;case(x1{1} \in dom F.RO.m{1}). + - rcondf{1}2;2:rcondf{2}2;auto;progress. + * cut[]:=H1;smt(incl_dom). + cut[]:=H1;smt(joinP incl_dom). + rcondt{1}2;2:rcondt{2}2;auto;progress. + * cut[]:=H1;smt(incl_dom). + * cut[]:=H1;smt(joinP incl_dom getP). + by rewrite(lemma3 _ _ _ _ rL H1 _ H2)H//=. + conseq(:_==> inv_L_L3 F.RO.m{1} F.RO.m{2} F2.RO.m{2});1:smt(). + while(={i,n,p,x} /\ 0 <= i{1} /\ ! valid p{1} /\ parse x{1} = (p,n){1} + /\ inv_L_L3 F.RO.m{1} F.RO.m{2} F2.RO.m{2}). + + sp;case(x2{1} \in dom F.RO.m{1}). + - rcondf{1}2;2:rcondf{2}2;auto;progress. + * cut[]:=H2;smt(incl_dom lemma2 formatK parse_not_valid). + smt(). + rcondt{1}2;2:rcondt{2}2;auto;progress. + * smt(incl_dom lemma1). + * smt(). + * by cut:=lemma3 _ _ _ _ r0L H2 _ H5;smt(parse_not_valid). + auto;smt(). qed. local module D2 (D : DISTINGUISHER) (F : F.RO) = { @@ -446,151 +578,368 @@ section Real_Ideal. }. - local lemma equiv_ideal (D <: DISTINGUISHER{SLCommon.C, C, IF, BIRO.IRO, S,F.FRO}) &m: - Pr[SLCommon.IdealIndif(IF,S,SLCommon.DRestr(A(D))).main() @ &m : res] = - Pr[L3(D,F.RO).distinguish() @ &m : res]. - proof. - cut->:Pr[SLCommon.IdealIndif(IF, S, SLCommon.DRestr(A(D))).main() @ &m : res] - = Pr[SLCommon.IdealIndif(IF, S, A(D)).main() @ &m : res]. - + by byequiv(ideal_equiv D)=>//=. - cut<-:Pr[L(D, F.RO).distinguish() @ &m : res] = - Pr[L3(D, F.RO).distinguish() @ &m : res]. - + by byequiv(Ideal_equiv3 D). - cut<-:Pr[L2(D,F.RO).distinguish() @ &m : res] = - Pr[SLCommon.IdealIndif(IF,S,A(D)).main() @ &m : res]. - + by byequiv(ideal_equiv2 D). - cut->:Pr[L2(D, F.RO).distinguish() @ &m : res] = - Pr[L2(D,F.LRO).distinguish() @ &m : res]. - + byequiv=>//=;proc;sp;inline*;sp;wp. - transitivity{1} { - b1 <@ D2(D,F.RO).distinguish(); + module DSqueeze2 (F : F.RO) (F2 : F2.RO) = { + proc init () : unit = { + F.init(); + F2.init(); + } + proc f (p : block list, n : int) : block list = { + var lres : block list <- []; + var b : block <- b0; + var i : int <- 0; + var pp, nn; + (pp,nn) <- parse (format p n); + if (valid p) { + if (n <= 0) { + F.sample(p); } - (={glob D, glob F.RO, glob C, glob S} ==> ={b1}) - (={glob D, glob F.RO, glob C, glob S} ==> ={b1});progress;1:smt();1:sim. - transitivity{1} { - b1 <@ D2(D,F.LRO).distinguish(); + while (i < n) { + i <- i + 1; + b <@ F.get(format p i); + lres <- rcons lres b; } - (={glob D, glob F.RO, glob C, glob S} ==> ={b1}) - (={glob D, glob F.RO, glob C, glob S} ==> ={b1});progress;1:smt();2:sim. - by call(F.RO_LRO_D (D2(D)));auto. - cut->:Pr[L(D, F.RO).distinguish() @ &m : res] = - Pr[L(D,F.LRO).distinguish() @ &m : res]. - + byequiv=>//=;proc;sp;inline*;sp;wp. - transitivity{1} { - b1 <@ D3(D,F.RO).distinguish(); + } else { + if (nn <= 0) { + F2.sample(pp); } - (={glob D, glob F.RO, glob C, glob S} ==> ={b1}) - (={glob D, glob F.RO, glob C, glob S} ==> ={b1});progress;1:smt();1:sim. - transitivity{1} { - b1 <@ D3(D,F.LRO).distinguish(); + while (i < nn - n) { + i <- i + 1; + F2.sample(format pp i); } - (={glob D, glob F.RO, glob C, glob S} ==> ={b1}) - (={glob D, glob F.RO, glob C, glob S} ==> ={b1});progress;1:smt();2:sim. - by call(F.RO_LRO_D (D3(D)));auto. - rewrite eq_sym. - by byequiv(Ideal_equiv_valid D). - qed. + while (i < n) { + i <- i + 1; + b <@ F2.get(format pp i); + lres <- rcons lres b; + } + } + return lres; + } + }. + + + local module FValid (F : DFUNCTIONALITY) = { + proc f (p : block list, n : int) = { + var r : block list <- []; + if (valid p) { + r <@ F.f(p,n); + } + return r; + } + }. + local module DValid (D : DISTINGUISHER) (F : DFUNCTIONALITY) (P : DPRIMITIVE) = D(FValid(F),P). - local equiv double_squeeze : - DSqueeze(IF2(F.RO)).f ~ Squeeze(IF).f : - ={arg, F.RO.m} ==> ={res, F.RO.m}. + local module S2 (F : DFUNCTIONALITY) = S(Last(F)). + + local module L4 (D : DISTINGUISHER) (F : F.RO) (F2 : F2.RO) = { + proc distinguish = IdealIndif(DSqueeze2(F,F2),S2,DValid(DRestr(D))).main + }. + + local equiv equiv_L3_L4 (D <: DISTINGUISHER{SLCommon.C, C, IF, S, F2.RO, BIRO.IRO, BIRO2.IRO}) : + L3(D,F.RO).distinguish + ~ + L4(D,F.RO,F2.RO).distinguish + : + ={glob D} ==> ={glob D, res}. proof. - proc;inline*;auto;sp;if;auto;sp. - rcondt{1}1;1:(auto;smt(parse_valid valid_gt0)). - rcondt{1}1;1:(auto;smt(parse_valid valid_gt0)). - rcondt{1}1;1:(auto;smt(parse_valid valid_gt0));sp. - rcondf{1}3;1:(auto;smt(parse_valid valid_gt0));sp. - case(0 < n{1});last first. - + rcondf{2}4;1:auto=>/#. - rcondf{1}8;1:auto=>/#. - rcondf{1}5. - + auto;smt(nseq0 cats0 dom_set in_fsetU1 parse_valid). - by wp;rnd{1};auto;smt(DBlock.dunifin_ll nseq0 cats0 parse_valid set_eq in_dom). - while(={F.RO.m,n,b,i,lres,p} /\ valid p{1} /\ 0 < n{1} /\ 0 <= i{1} <= n{1} - /\ (i{1}+1 < n{1} => (forall j, 0 <= j <= i{1} => format p{1} (j+1) \in dom F.RO.m{1}))). - + sp;if;1,3:auto=>/#. - sp;rcondt{1}1;1:(auto;smt(parseK formatK)). - rcondt{1}1;1:(auto;smt(parseK formatK valid_gt0)). - conseq(:_==> ={b,F.RO.m} /\ (forall (j : int), 0 <= j <= i{1} => - format p{1} (j+1) \in dom F.RO.m{2}));1:smt(). + proc; inline*; auto; sp. + call(: ={glob S, glob C, glob F.RO, glob F2.RO}); auto;first last. + + by proc; sim. + + proc; sp; if; auto; call(: ={glob F.RO, glob F2.RO}); auto; sp; if; auto; inline*; sp. + rcondt{1}1; 1:(auto; smt(parse_valid parse_gt0)); sp. + rcondt{1}1; 1:(auto; smt(parse_valid parse_gt0)); sp. + (* rcondt{1}1; 1:(auto; smt(parse_valid parse_gt0)); sp. *) + rcondf{1}3; 1:(auto; smt(parse_valid parse_gt0)); sp. + rcondt{2}1; 1:(auto; smt(parse_valid parse_gt0 parseK formatK)); sp; wp. + if{2};sp. + - rcondf{2}3; 1:(auto; smt(parse_valid parse_gt0)); sp. + rcondf{1}8; 1:(auto; smt(parse_valid parse_gt0)); sp. + rcondf{1}5; 1:(auto; smt(parse_valid parse_gt0 dom_set in_fsetU1 nseq0 cats0)); sp. + wp 4 2;rnd{1};wp 2 2. + by conseq(:_==> ={F.RO.m} /\ r3{1} = r2{2} /\ x9{1} = x4{2});2:sim; + smt(DBlock.dunifin_ll nseq0 cats0 parse_valid);progress. + rcondt{2}1; 1:(auto; smt(parse_valid parse_gt0)); sp; wp. + splitwhile{1} 8 : i + 1 < n. + rcondt{1}9;1:auto. + - by while(i < n);auto;2:smt();sp;if;auto;1:(sp;if;auto);while(i < n);auto. + rcondf{1}11;1:auto. + - by while(i < n);auto;2:smt();sp;if;auto;1:(sp;if;auto);while(i < n);auto. + rcondf{1}11;1:auto. + - by while(i < n);auto;2:smt();sp;if;auto;1:(sp;if;auto);while(i < n);auto. + wp. + while((n,p){1} = (n0,p0){2} /\ i{1} + 1 = i{2} /\ valid p{1} /\ 0 < n{1} + /\ 0 <= i{2} <= n{1} + /\ (forall j, 1 <= j <= i{2} => format p{1} j \in dom F.RO.m{1}) + /\ rcons lres{1} b{1} = lres{2} /\ ={F.RO.m, F2.RO.m});last first. + - rcondf{1}5;1:auto;1:smt(dom_set in_fsetU1 nseq0 cats0 parse_valid). + wp 4 2;rnd{1};wp 2 2. + conseq(:_==> ={F.RO.m} /\ r3{1} = r0{2} /\ x9{1} \in dom F.RO.m{1}); + 1:smt(DBlock.dunifin_ll nseq0 cats0 parse_valid). + by auto;smt(parse_valid nseq0 cats0 dom_set in_fsetU1). + sp. + rcondt{1}1;1:auto;sp. + rcondt{1}1;1:(auto;smt(parse_valid parseK formatK)). + (* rcondt{1}1;1:(auto;smt(parse_valid parseK formatK parse_gt0)). *) splitwhile{1} 1 : i1 + 1 < n1. rcondt{1}2;1:auto. - + by while(i1 < n1);auto;smt(valid_gt0 parseK formatK). + - by while(i1 < n1);auto;smt(parse_gt0 parse_valid parseK formatK). rcondf{1}7;1:auto. - + by while(i1 < n1);auto;smt(valid_gt0 parseK formatK). - seq 3 0 : (={F.RO.m,x0} /\ x0{1} = format p{1} (i{1}+1) /\ x4{1} = x0{1} /\ - (forall (j : int), 0 <= j < i{1} => format p{1} (j+1) \in dom F.RO.m{2}));last first. - + sp;rcondf{1}5;1:auto;1:smt(dom_set in_fsetU1). - by wp;rnd{1};auto;smt(DBlock.dunifin_ll dom_set in_fsetU1). - wp. - conseq(:_==> ={F.RO.m} /\ i1{1} + 1 = n1{1});1:smt(parseK formatK). - while{1}(={F.RO.m} /\ 0 < i1{1} + 1 <= n1{1} <= n{1} /\ - (forall j, 0 <= j < n1{1}-1 => format p1{1} (j+1) \in dom F.RO.m{1}))(n1{1}-i1{1}). - + by progress;sp;rcondf 2;auto;smt(DBlock.dunifin_ll). - by auto;smt(formatK parseK). - by rcondf{1}5;2:(wp;rnd{1});auto;smt(DBlock.dunifin_ll dom_set in_fsetU1 nseq0 cats0 parse_valid). + - by while(i1 < n1);auto;smt(parse_gt0 parse_valid parseK formatK). + rcondf{1}9;1:auto. + - conseq(:_==> i1 + 1 = n1);1:smt(dom_set in_fsetU1 parseK parse_valid formatK). + by while(i1 + 1 <= n1);auto;smt(parse_gt0 parse_valid parseK formatK). + wp 8 2;rnd{1};wp 6 2. + conseq(:_==> n1{1} = i{2} /\ ={F.RO.m} /\ i1{1} = n1{1} + /\ (forall (j : int), 1 <= j <= i{2} => + format p1{1} j \in dom F.RO.m{1})); + 1:smt(parseK formatK parse_valid DBlock.dunifin_ll). + seq 2 0 : (={F.RO.m,x0} /\ i1{1} = n1{1} /\ x0{2} = format p{1} i{2} + /\ n1{1} = i{1} + 1 /\ p1{1} = p{1} /\ i{2} = i{1} + 1 /\ forall (j : int), + 1 <= j <= i{1} => format p{1} j \in dom F.RO.m{1});last first. + - auto;smt(dom_set in_fsetU1). + wp;conseq(:_==> ={F.RO.m} /\ i1{1} + 1 = n1{1} + /\ (forall (j : int), 1 <= j < n1{1} => + format p1{1} j \in dom F.RO.m{1}));1:smt(parseK). + while{1}(={F.RO.m} /\ 0 <= i1{1} /\ i1{1} + 1 <= n1{1} /\ i{2} = n1{1} /\ i{2} = i{1} + 1 + /\ (forall (j : int), 1 <= j < n1{1} => + format p1{1} j \in dom F.RO.m{1}))(n1{1}-i1{1}-1);progress. + + by sp;rcondf 2;auto;smt(DBlock.dunifin_ll). + by auto;smt(parse_gt0 parseK formatK parse_valid). + proc; sp; if; auto; call(: ={glob S, glob F.RO, glob F2.RO}); auto. + if; 1,3:auto; sim; if; auto; sim; sp. + call(: ={glob F.RO, glob F2.RO});auto;last smt(). + inline*;auto;sp. + if;1:auto;1:smt(). + + (* rcondt{1}1;1:(auto;smt(parse_valid parse_gt0)). *) + rcondf{2}1;1:(auto;smt(parse_valid parse_gt0)). + splitwhile{1} 1 : i + 1 < n;splitwhile{2} 1 : i + 1 < n. + rcondt{1}2;1:auto. + - by while(i ={F.RO.m} /\ p{2} = x0{2});progress. + + smt(DBlock.dunifin_ll). smt(last_rcons formatK parseK). + seq 3 3 : (={F.RO.m,i,x0} /\ x0{1} = p{2}); + last by conseq(:_==> ={F.RO.m});progress;sim. + auto;conseq(:_==> ={F.RO.m,i,n} /\ p{1} = p0{2} /\ i{1} + 1 = n{2});1:smt(formatK). + by while(={F.RO.m,i,n} /\ p{1} = p0{2} /\ 0 <= i{1} /\ i{1} + 1 <= n{2}); + auto;smt(parse_gt0). + sp;rcondf{2}1;1:(auto;smt(parse_gt0)). + rcondf{2}1;1:auto;1:smt(parseK formatK). + splitwhile{1} 1 : i + 1 < n;splitwhile{2} 1 : i + 1 < n. + rcondt{1}2;1:auto. + - by while(i ={F2.RO.m} /\ format pp{2} n{2} = x3{2});1:smt(DBlock.dunifin_ll last_rcons formatK parseK). + seq 3 3 : (={F2.RO.m,i} /\ x2{1} = x3{2} /\ pp{2} = p{1} /\ format pp{2} n{2} = x3{2}); + last by conseq(:_==> ={F2.RO.m});progress;sim. + auto;conseq(:_==> ={F2.RO.m,i,n} /\ i{1} + 1 = n{2});1:smt(formatK). + by while(={F2.RO.m,i,n} /\ p{1} = pp{2} /\ 0 <= i{1} /\ i{1} + 1 <= n{2}); + auto;smt(parse_gt0 parseK formatK). qed. - local equiv Ideal_equiv (D <: DISTINGUISHER{SLCommon.C, C, IF, BIRO.IRO, S}) : - L3(D,F.RO).distinguish + op inv_map (m1 : (block list, block) fmap) (m2 : (block list * int, block) fmap) = + (forall p n x, parse x = (p,n+1) => (p,n) \in dom m2 <=> x \in dom m1) + /\ (forall p n x, parse x = (p,n+1) => x \in dom m1 <=> (p,n) \in dom m2) + /\ (forall p n x, parse x = (p,n+1) => m2.[(p,n)] = m1.[x]) + /\ (forall p n x, parse x = (p,n+1) => m1.[x] = m2.[(p,n)]). + + inductive INV_L4_ideal m1 m2 m3 m4 = + | inv_maps of (inv_map m1 m2) + & (inv_map m3 m4) + & (forall p n, (p,n) \in dom m2 => valid p /\ 0 <= n) + & (forall p n, (p,n) \in dom m4 => ! valid p /\ 0 <= n). + + + local lemma lemma5 m1 m2 m3 m4 p i r : + INV_L4_ideal m1 m2 m3 m4 => + ! (p,i) \in dom m2 => + 0 <= i => + valid p => + INV_L4_ideal m1.[format p (i+1) <- r] m2.[(p,i) <- r] m3 m4. + proof. + move=>INV0 nin_dom1 i_gt0 valid_p;cut[]inv12 inv34 dom2 dom4:=INV0;cut[]h1[]h2[]h3 h4:=inv12;split=>//=. + + progress. + - move:H0;rewrite 2!dom_set 2!in_fsetU1=>[][/#|]/=[]->>->>;smt(parseK formatK). + - move:H0;rewrite 2!dom_set 2!in_fsetU1=>[][/#|]/=->>;smt(parseK formatK). + - move:H0;rewrite 2!dom_set 2!in_fsetU1=>[][/#|]/=->>;smt(parseK formatK). + - move:H0;rewrite 2!dom_set 2!in_fsetU1=>[][/#|]/=;smt(parseK formatK). + - smt(getP parseK formatK). + smt(getP parseK formatK). + smt(getP parseK formatK dom_set in_fsetU1). + qed. + + local lemma lemma5bis m1 m2 m3 m4 p i r : + INV_L4_ideal m1 m2 m3 m4 => + ! (p,i) \in dom m4 => + 0 <= i => + ! valid p => + parse (format p (i+1)) = (p,i+1) => + INV_L4_ideal m1 m2 m3.[format p (i+1) <- r] m4.[(p,i) <- r]. + proof. + move=>INV0 nin_dom1 i_gt0 nvalid_p parseK_p_i; + cut[]inv12 inv34 dom2 dom4:=INV0; + cut[]h1[]h2[]h3 h4:=inv34; + split=>//=. + + progress. + - move:H0;rewrite 2!dom_set 2!in_fsetU1=>[][/#|]/=[]->>->>;smt(parseK formatK). + - move:H0;rewrite 2!dom_set 2!in_fsetU1=>[][/#|]/=->>;smt(parseK formatK). + - move:H0;rewrite 2!dom_set 2!in_fsetU1=>[][/#|]/=->>;smt(parseK formatK). + - move:H0;rewrite 2!dom_set 2!in_fsetU1=>[][/#|]/=;smt(parseK formatK). + - smt(getP parseK formatK). + smt(getP parseK formatK). + smt(getP parseK formatK dom_set in_fsetU1). + qed. + + + + local equiv equiv_L4_ideal (D <: DISTINGUISHER{SLCommon.C, C, IF, S, F2.RO, BIRO.IRO, BIRO2.IRO}) : + L4(D,F.LRO,F2.LRO).distinguish ~ - IdealIndif(Squeeze(IF), SimLast(S), DRestr(D)).main + IdealIndif(BIRO.IRO,SimLast(S),DRestr(D)).main : ={glob D} ==> ={glob D, res}. proof. - proc;inline*;auto;sp. - call(: ={glob S, glob C, F.RO.m});auto;first last. - + by proc;inline*;sp;if;auto;sp;if;auto. - + proc;sp;if;auto;sp. - by call(double_squeeze);auto;progress. - proc;sp;if;auto;inline{1}1;inline{2}1;sp;if;1:auto;sim;if;auto. - sp;inline*;sp;if;1,3:(auto;smt(parse_valid));sp. - rcondt{1}1;1:(auto;smt(parse_valid valid_gt0)). - rcondt{2}1;1:(auto;smt(parse_valid valid_gt0));sp. - rcondt{1}1;1:(auto;smt(parse_valid valid_gt0));sp. - splitwhile{2}4: i + 1 < n. - rcondt{2}5;1:auto. - + while(i < n);1:(sp;if);auto;smt(valid_gt0). - rcondf{2}7;1:auto. - + while(i < n);1:(sp;if);auto;smt(valid_gt0). - rcondf{2}7;1:auto. - + while(i < n);1:(sp;if);auto;smt(valid_gt0). - seq 3 4 : (F.RO.m.[x0]{1} = Some b{2} /\ ={x, C.c, S.paths, F.RO.m});last first. - + sp;rcondf{1}2;auto;smt(in_dom DBlock.dunifin_ll last_rcons). - conseq(: _==> F.RO.m{1}.[format p0{1} i{1}] = Some b{2} /\ i{1} = n{1} /\ ={F.RO.m});progress. - + rewrite-H7;congr;smt(parseK formatK). - while(={F.RO.m,n} /\ i{1} = i{2} + 1 /\ p0{1} = p1{2} /\ i{1} <= n{1} - /\ F.RO.m{1}.[format p0{1} i{1}] = Some b{2}). - + sp;rcondt{2}1;auto;smt(get_oget in_dom getP). - auto;smt(in_dom get_oget getP formatK parseK nseq0 cats0 valid_gt0). + proc; inline*; auto; sp. + call(: ={glob S, glob C} + /\ INV_L4_ideal F.RO.m{1} BIRO.IRO.mp{2} F2.RO.m{1} BIRO2.IRO.mp{2}); + auto; -1:(progress;split;smt(dom0 in_fset0 map0P)). + + proc;sp;if;auto;call(: ={glob S} + /\ INV_L4_ideal F.RO.m{1} BIRO.IRO.mp{2} F2.RO.m{1} BIRO2.IRO.mp{2}); auto. + if;1,3:auto. seq 1 1 : (={y1, x, glob S} + /\ INV_L4_ideal F.RO.m{1} BIRO.IRO.mp{2} F2.RO.m{1} BIRO2.IRO.mp{2}); + last by conseq(:_==> ={y, glob S});progress;sim. + if;auto;call(: INV_L4_ideal F.RO.m{1} BIRO.IRO.mp{2} F2.RO.m{1} BIRO2.IRO.mp{2});auto. + inline*;auto;sp;if;auto;1:smt(parseK parse_gt0 formatK);1:sp 0 4;2:sp 0 3. + - rcondt{2}1;1:auto;1:smt(parseK parse_gt0 formatK). + while(lres{1} = bs{2} /\ ={i,n} /\ x{2} = p0{1} /\ valid p0{1} /\ 0 <= i{1} + /\ INV_L4_ideal F.RO.m{1} BIRO.IRO.mp{2} F2.RO.m{1} BIRO2.IRO.mp{2});progress. + * sp;if{2}. + + rcondt{1}2;auto;progress. + - cut[]h1 _ _ _:=H1;cut[]h'1 _:=h1;smt(parseK). + - smt(getP). + - smt(). + - exact lemma5. + rcondf{1}2;auto;progress. + - cut[]h1 _ _ _:=H1;cut[]h'1 _:=h1;smt(parseK). + - smt(DBlock.dunifin_ll). + - cut[]h1:=H1;cut[]:=h1;smt(parseK). + smt(). + by if{1};auto;smt(parseK parse_gt0 formatK). + rcondf{1}1;1:auto;1:smt(parse_gt0);sp. + rcondt{2}1;1:auto. + while(lres{1} = bs0{2} /\ (i,n,pp){1} = (i0,n0,x0){2} + /\ (x0{2}, n0{2}) = parse (format q{2} k{2}) /\ ! valid x0{2} /\ 0 <= i{1} + /\ INV_L4_ideal F.RO.m{1} BIRO.IRO.mp{2} F2.RO.m{1} BIRO2.IRO.mp{2});progress. + * sp;if{2}. + + rcondt{1}2;auto;progress. + - cut[]_ h1 _ _:=H2;cut[]:=h1;progress. + cut:=H7 x0{m} i0{m} (format x0{m} (i0{m} + 1));rewrite H5/==>->//=. + cut->/#:=parse_twice _ _ _ H. + - smt(getP). + - smt(). + - apply lemma5bis=>//=. + rewrite(parse_twice _ _ _ H)/#. + rcondf{1}2;auto;progress. + - cut[]_ h1 _ _:=H2;cut[]:=h1;progress. + cut:=H7 x0{m} i0{m} (format x0{m} (i0{m} + 1));rewrite H5/==>->//=. + cut->/#:=parse_twice _ _ _ H. + - smt(DBlock.dunifin_ll). + - cut[]_ h1 _ _:=H2;cut[]h'1 _:=h1;smt(parseK parse_twice). + - smt(). + by rcondf{1}1;auto;smt(parseK formatK). + + by proc;inline*;conseq(:_==> ={glob C, glob S, z});progress;sim. + proc;sp;if;auto;call(: INV_L4_ideal F.RO.m{1} BIRO.IRO.mp{2} + F2.RO.m{1} BIRO2.IRO.mp{2});auto. + inline*;sp;if;auto;sp. + rcondt{1}1;1:auto;if{1};sp. + - by rcondf{1}1;2:rcondf{2}1;auto;smt(). + while(lres{1} = bs{2} /\ ={i} /\ n0{1} = n{2} /\ x{2} = p0{1} /\ valid p0{1} /\ 0 <= i{1} + /\ INV_L4_ideal F.RO.m{1} BIRO.IRO.mp{2} F2.RO.m{1} BIRO2.IRO.mp{2});progress. + sp;if{2}. + + rcondt{1}2;auto;progress. + - cut[]h1 _ _ _:=H1;cut[]h'1 _:=h1;smt(parseK). + - smt(getP). + - smt(). + - exact lemma5. + rcondf{1}2;auto;progress. + - cut[]h1 _ _ _:=H1;cut[]h'1 _:=h1;smt(parseK). + - smt(DBlock.dunifin_ll). + - cut[]h1:=H1;cut[]:=h1;smt(parseK). + smt(). qed. + local module D5 (D : DISTINGUISHER) (F : F.RO) = + D(FC(FValid(DSqueeze2(F, F2.RO))), PC(S(Last(DSqueeze2(F, F2.RO))))). + local module D6 (D : DISTINGUISHER) (F2 : F2.RO) = + D(FC(FValid(DSqueeze2(F.LRO, F2))), PC(S(Last(DSqueeze2(F.LRO, F2))))). - local lemma equiv_ideal' (D <: DISTINGUISHER{SLCommon.C, C, IF, BIRO.IRO, S,F.FRO}) &m: + lemma equiv_ideal (D <: DISTINGUISHER{SLCommon.C, C, IF, S, + F.FRO, F2.RO, F2.FRO, BIRO.IRO, BIRO2.IRO}) &m: Pr[SLCommon.IdealIndif(IF,S,SLCommon.DRestr(A(D))).main() @ &m : res] = - Pr[IdealIndif(Squeeze(IF), SimLast(S), DRestr(D)).main() @ &m : res]. + Pr[IdealIndif(BIRO.IRO,SimLast(S),DRestr(D)).main() @ &m : res]. proof. - rewrite (equiv_ideal D &m). - byequiv(Ideal_equiv D)=>//. + cut->:Pr[SLCommon.IdealIndif(IF, S, SLCommon.DRestr(A(D))).main() @ &m : res] + = Pr[SLCommon.IdealIndif(IF, S, A(D)).main() @ &m : res]. + + by byequiv(ideal_equiv D)=>//=. + cut<-:Pr[L2(D,F.RO).distinguish() @ &m : res] = + Pr[SLCommon.IdealIndif(IF,S,A(D)).main() @ &m : res]. + + by byequiv(ideal_equiv2 D). + cut->:Pr[L2(D, F.RO).distinguish() @ &m : res] = + Pr[L2(D,F.LRO).distinguish() @ &m : res]. + + byequiv=>//=;proc;sp;inline*;sp;wp. + by call(F.RO_LRO_D (D2(D)));auto. + cut->:Pr[IdealIndif(BIRO.IRO, SimLast(S), DRestr(D)).main() @ &m : res] = + Pr[L4(D,F.LRO,F2.LRO).distinguish() @ &m : res]. + + by rewrite eq_sym;byequiv(equiv_L4_ideal D)=>//=. + cut<-:Pr[L4(D, F.RO, F2.RO).distinguish() @ &m : res] = + Pr[L4(D,F.LRO,F2.LRO).distinguish() @ &m : res]. + + cut->:Pr[L4(D, F.RO, F2.RO).distinguish() @ &m : res] = + Pr[L4(D,F.LRO, F2.RO).distinguish() @ &m : res]. + - byequiv=>//=;proc;sp;inline*;sp;wp. + by call(F.RO_LRO_D (D5(D)));auto. + byequiv=>//=;proc;sp;inline*;sp;wp. + by call(F2.RO_LRO_D (D6(D)));auto. + cut<-:Pr[L3(D, F.RO).distinguish() @ &m : res] = + Pr[L4(D, F.RO, F2.RO).distinguish() @ &m : res]. + + by byequiv(equiv_L3_L4 D)=>//=. + cut<-:Pr[L(D, F.RO).distinguish() @ &m : res] = + Pr[L3(D, F.RO).distinguish() @ &m : res]. + + by byequiv(Ideal_equiv3 D). + cut->:Pr[L(D, F.RO).distinguish() @ &m : res] = + Pr[L(D,F.LRO).distinguish() @ &m : res]. + + byequiv=>//=;proc;sp;inline*;sp;wp. + by call(F.RO_LRO_D (D3(D)));auto. + rewrite eq_sym. + by byequiv(Ideal_equiv_valid D). qed. +end section Ideal. - (* Real part *) + (* Real part *) - - pred inv_ideal (squeeze : (block list * int, block list) fmap) - (c : (block list, block) fmap) = - (forall p n, (p,n) \in dom squeeze => - forall i, 1 <= i <= n => (p,i) = parse (format p i)) /\ - (forall p n, (p,n) \in dom squeeze => - forall i, 1 <= i <= n => format p i \in dom c) /\ - (forall l, l \in dom c => - forall i, 1 <= i <= (parse l).`2 => ((parse l).`1,i) \in dom squeeze). +section Real. inductive m_p (m : (state, state) fmap) (p : (block list, state) fmap) = | IND_M_P of (p.[[]] = Some (b0, c0)) @@ -598,7 +947,6 @@ section Real_Ideal. exists b c, p.[take i l] = Some (b,c) /\ m.[(b +^ nth witness l i, c)] = p.[take (i+1) l]). - inductive INV_Real (c1 c2 : int) (m mi : (state, state) fmap) @@ -644,7 +992,7 @@ section Real_Ideal. smt(take_le0 take_oversize size_take take_take take_size nth_take in_dom). qed. - local lemma lemma2 c1 c2 m mi p bl i sa sc: + local lemma lemma2' c1 c2 m mi p bl i sa sc: INV_Real c1 c2 m mi p => 1 < i => valid bl => @@ -924,7 +1272,7 @@ section Real_Ideal. sp;if;auto;progress. - move:H4 H5;rewrite!getP/=!oget_some nth_last -(addzA _ _ 1)/=take_size. rewrite last_cat last_nseq 1:/# Block.WRing.addr0;progress. - cut//=:=lemma2(SLCommon.C.c{1} + 1)(C.c{2} + size bl{2} + i{2}) + cut//=:=lemma2'(SLCommon.C.c{1} + 1)(C.c{2} + size bl{2} + i{2}) Perm.m{2}.[(sa0_R, sc0{2}) <- y2L] Perm.mi{2}.[y2L <- (sa0_R, sc0{2})] Redo.prefixes{2} bl{2} (i{2}+1) sa0_R sc0{2}. rewrite -(addzA _ 1)/=H1/=!dom_set!in_fsetU1/=H4/=H2/=getP/=oget_some/=. @@ -936,7 +1284,7 @@ section Real_Ideal. - move:H4 H5;rewrite nth_last -(addzA _ _ 1)/=take_size. rewrite last_cat last_nseq 1:/# Block.WRing.addr0;progress. pose a:=(_, _);cut->/={a}:a = oget Perm.m{2}.[(sa0_R, sc0{2})] by smt(). - apply lemma2=>//=;first cut:=H3=>hinv0;split;case:hinv0=>//=/#. + apply lemma2'=>//=;first cut:=H3=>hinv0;split;case:hinv0=>//=/#. smt(). smt(). - by rewrite dom_set in_fsetU1//=-(addzA _ _ 1)/=take_size;smt(in_dom). @@ -1049,7 +1397,7 @@ section Real_Ideal. by rewrite Block.WRing.addr0=>H_pm;rewrite H_pm/=. qed. - local lemma lemma3 c1 c2 m mi p bl b (sa:block) sc: + local lemma lemma_3 c1 c2 m mi p bl b (sa:block) sc: INV_Real c1 c2 m mi p => (sa +^ b,sc) \in dom m => ! rcons bl b \in dom p => @@ -1172,7 +1520,7 @@ section Real_Ideal. + by rewrite getP/=. + by rewrite behead_drop drop_add. + rewrite!getP/=oget_some. - cut:=lemma3 0 C.c{2}Perm.m{2}.[(sa{2} +^ nth witness p0{1} i0{1}, sc{2}) <- yL] + cut:=lemma_3 0 C.c{2}Perm.m{2}.[(sa{2} +^ nth witness p0{1} i0{1}, sc{2}) <- yL] Perm.mi{2}.[yL <- (sa{2} +^ nth witness p0{1} i0{1}, sc{2})] Redo.prefixes{1} (take i0{1} p0{1}) (nth witness p0{1} i0{1}) sa{2} sc{2}. rewrite!dom_set!in_fsetU1/=-take_nth//=H5/=H1/=getP/=oget_some. @@ -1189,7 +1537,7 @@ section Real_Ideal. + by rewrite getP. + by rewrite behead_drop drop_add. + rewrite(take_nth witness)//=. - cut:=lemma3 0 C.c{2} Perm.m{2} Perm.mi{2} Redo.prefixes{1} + cut:=lemma_3 0 C.c{2} Perm.m{2} Perm.mi{2} Redo.prefixes{1} (take i0{1} p0{1}) (nth witness p0{1} i0{1}) sa{2} sc{2}. by rewrite-take_nth//= H5/=H1/=H2/=H6/=;smt(). + smt(size_drop size_eq0). @@ -1266,7 +1614,7 @@ section Real_Ideal. cut->/=:!size p{1} + i{2} - 1 < size p{1} by smt(). rewrite Block.WRing.addr0 !getP/=oget_some take_oversize;1:rewrite size_cat size_nseq/#. move=>H_dom_iS H_dom_p. - cut:=lemma2 0 C.c{2} Perm.m{2}.[(sa{2}, sc{2}) <- y0L] + cut:=lemma2' 0 C.c{2} Perm.m{2}.[(sa{2}, sc{2}) <- y0L] Perm.mi{2}.[y0L <- (sa{2}, sc{2})] Redo.prefixes{1} p{1} (i{2}+1) sa{2} sc{2} _ _ H4 _ H_dom_iS. + by rewrite INV_Real_addm_mi//=;smt(supp_dexcepted). @@ -1280,7 +1628,7 @@ section Real_Ideal. + move:H5 H6;rewrite take_oversize 1:size_cat 1:size_nseq 1:/#. rewrite nth_cat;cut->/=:! size p{1} + i{2} - 1 < size p{1} by smt(). rewrite nth_nseq//=1:/# Block.WRing.addr0 =>h1 h2. - by cut:=lemma2 0 C.c{2} Perm.m{2} Perm.mi{2} Redo.prefixes{1} + by cut:=lemma2' 0 C.c{2} Perm.m{2} Perm.mi{2} Redo.prefixes{1} p{1} (i{2}+1) sa{2} sc{2} H3 _ H1 h2 h1;smt(). + move:H5 H6;rewrite take_oversize 1:size_cat 1:size_nseq 1:/#. rewrite nth_cat;cut->/=:! size p{1} + i{2} - 1 < size p{1} by smt(). @@ -1334,7 +1682,7 @@ section Real_Ideal. - local lemma pr_real (D <: DISTINGUISHER{SLCommon.C, C, Perm, Redo}) &m : + lemma pr_real (D <: DISTINGUISHER{SLCommon.C, C, Perm, Redo}) &m : Pr [ GReal(A(D)).main() @ &m : res /\ SLCommon.C.c <= max_size] = Pr [ RealIndif(Sponge,P,DRestr(D)).main() @ &m : res]. proof. @@ -1344,8 +1692,12 @@ section Real_Ideal. byequiv (equiv_sponge D)=>//=;progress;smt(). qed. +end section Real. - declare module D : DISTINGUISHER{SLCommon.C, C, Perm, Redo, F.RO, F.RRO, S, BIRO.IRO}. + +section Real_Ideal. + (* REAL & IDEAL *) + declare module D : DISTINGUISHER{SLCommon.C, C, Perm, Redo, F.RO, F.RRO, S}. axiom D_lossless (F0 <: DFUNCTIONALITY{D}) (P0 <: DPRIMITIVE{D}) : islossless P0.f => islossless P0.fi => islossless F0.f => @@ -1368,17 +1720,15 @@ section Real_Ideal. call H1;auto;smt(). qed. - (* REAL & IDEAL *) - lemma concl &m : Pr [ RealIndif(Sponge,P,DRestr(D)).main() @ &m : res ] <= - Pr [ IdealIndif(Squeeze(IF), SimLast(S), DRestr(D)).main() @ &m : res ] + + Pr [ IdealIndif(BIRO.IRO, SimLast(S), DRestr(D)).main() @ &m : res ] + (max_size ^ 2)%r / 2%r * mu dstate (pred1 witness) + max_size%r * ((2*max_size)%r / (2^c)%r) + max_size%r * ((2*max_size)%r / (2^c)%r). proof. - rewrite-(pr_real D &m). - rewrite-(equiv_ideal' D &m). + rewrite-(pr_real D &m). + rewrite-(equiv_ideal D &m). apply(Real_Ideal (A(D)) A_lossless &m). qed. From e3c341425b08a378dc2adf8d9654c6e23d72e00f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Thu, 17 May 2018 11:30:02 +0200 Subject: [PATCH 288/525] Proof completed until high-level. Cleaning to do (e.g. distinguisher's restrictions). --- proof/BlockSponge.ec | 20 ++-- proof/SHA3-Security.ec | 73 ++++++++------ proof/smart_counter/Gconcl_list.ec | 155 ++++++++++++++++++++++++++++- 3 files changed, 200 insertions(+), 48 deletions(-) diff --git a/proof/BlockSponge.ec b/proof/BlockSponge.ec index c2e3531..acdaf0d 100644 --- a/proof/BlockSponge.ec +++ b/proof/BlockSponge.ec @@ -151,13 +151,13 @@ module (Sponge : CONSTRUCTION) (P : DPRIMITIVE) : FUNCTIONALITY = { (* this is just for typechecking, right now: *) -lemma conclusion : - forall (D <: DISTINGUISHER) &m, - `| Pr[RealIndif(Sponge, Perm, DRestr(D)).main() @ &m : res] - - Pr[IdealIndif(IRO, Sim, DRestr(D)).main() @ &m : res]| - <= (max_size ^ 2)%r / 2%r * Distr.mu1 dstate witness + - max_size%r * ((2 * max_size)%r / (2 ^ c)%r) + - max_size%r * ((2 * max_size)%r / (2 ^ c)%r). -proof. -admit. -qed. +(* lemma conclusion : *) +(* forall (D <: DISTINGUISHER) &m, *) +(* `| Pr[RealIndif(Sponge, Perm, DRestr(D)).main() @ &m : res] *) +(* - Pr[IdealIndif(IRO, Sim, DRestr(D)).main() @ &m : res]| *) +(* <= (max_size ^ 2)%r / 2%r * Distr.mu1 dstate witness + *) +(* max_size%r * ((2 * max_size)%r / (2 ^ c)%r) + *) +(* max_size%r * ((2 * max_size)%r / (2 ^ c)%r). *) +(* proof. *) +(* admit. *) +(* qed. *) diff --git a/proof/SHA3-Security.ec b/proof/SHA3-Security.ec index d295459..05e892a 100644 --- a/proof/SHA3-Security.ec +++ b/proof/SHA3-Security.ec @@ -4,7 +4,7 @@ require import AllCore List IntDiv StdOrder Distr. require import Common Sponge. import BIRO. -require SLCommon BlockSponge. +require SLCommon Gconcl_list. (* FIX: would be nicer to define limit at top-level and then clone BlockSponge with it - so BlockSponge would then clone lower-level @@ -85,8 +85,14 @@ module DRestr (D : DISTINGUISHER) (F : DFUNCTIONALITY) (P : DPRIMITIVE) = { section. declare module Dist : - DISTINGUISHER{Perm, BlockSponge.Sim, IRO, Cntr, BlockSponge.BIRO.IRO, - BlockSponge.C}. + DISTINGUISHER{Perm, Gconcl_list.SimLast, IRO, Cntr, BlockSponge.BIRO.IRO, + BlockSponge.C, Gconcl.S, + SLCommon.F.RO, SLCommon.F.RRO, SLCommon.Redo, SLCommon.C, + Gconcl_list.BIRO2.IRO, Gconcl_list.F2.RO, Gconcl_list.F2.RRO}. + +axiom Dist_lossless (F <: DFUNCTIONALITY) (P <: DPRIMITIVE) : + islossless P.f => islossless P.fi => islossless F.f => + islossless Dist(F,P).distinguish. lemma drestr_commute1 &m : Pr[BlockSponge.RealIndif @@ -121,21 +127,21 @@ qed. lemma drestr_commute2 &m : Pr[BlockSponge.IdealIndif - (BlockSponge.BIRO.IRO, BlockSponge.Sim, + (BlockSponge.BIRO.IRO, Gconcl_list.SimLast(Gconcl.S), LowerDist(DRestr(Dist))).main() @ &m : res] = Pr[BlockSponge.IdealIndif - (BlockSponge.BIRO.IRO, BlockSponge.Sim, + (BlockSponge.BIRO.IRO, Gconcl_list.SimLast(Gconcl.S), BlockSponge.DRestr(LowerDist(Dist))).main() @ &m : res]. proof. byequiv=> //; proc. seq 2 2 : (={glob Dist, BlockSponge.BIRO.IRO.mp, - glob BlockSponge.Sim}); first sim. + glob Gconcl_list.SimLast(Gconcl.S)}); first sim. inline*; wp; sp. call - (_ : - ={c}(Cntr, BlockSponge.C) /\ ={BlockSponge.BIRO.IRO.mp} /\ - ={glob BlockSponge.Sim}). + (_ : ={BlockSponge.BIRO.IRO.mp,Gconcl_list.BIRO2.IRO.mp} /\ + ={c}(Cntr, BlockSponge.C) /\ + ={glob Gconcl_list.SimLast(Gconcl.S)}). proc; sp; if=> //; sim. proc; sp; if=> //; sim. proc=> /=. @@ -146,14 +152,15 @@ progress; smt(size_pad2blocks). seq 1 1 : (={n} /\ nb{2} = (n{2} + r - 1) %/ r /\ bl{2} = pad2blocks bs{1} /\ Cntr.c{1} = BlockSponge.C.c{2} /\ - ={BlockSponge.BIRO.IRO.mp, Gconcl.S.paths, Gconcl.S.mi, Gconcl.S.m}). + ={BlockSponge.BIRO.IRO.mp, Gconcl_list.BIRO2.IRO.mp, + Gconcl.S.paths, Gconcl.S.mi, Gconcl.S.m}). auto; progress. rewrite size_pad2blocks //. inline RaiseFun(BlockSponge.BIRO.IRO).f. wp; sp. call (_ : ={BlockSponge.BIRO.IRO.mp}); first sim. auto. -auto; progress; by rewrite blocks2bits_nil. +auto; progress. by rewrite blocks2bits_nil. auto. qed. @@ -162,7 +169,7 @@ op wit_pair : block * capacity = witness. lemma security &m : `|Pr[RealIndif(Sponge, Perm, DRestr(Dist)).main() @ &m : res] - Pr[IdealIndif - (IRO, RaiseSim(BlockSponge.Sim), + (IRO, RaiseSim(Gconcl_list.SimLast(Gconcl.S)), DRestr(Dist)).main() @ &m : res]| <= (limit ^ 2)%r / (2 ^ (r + c + 1))%r + (4 * limit ^ 2)%r / (2 ^ c)%r. proof. @@ -176,11 +183,7 @@ have -> : rewrite (fromintM (2 ^ r)) StdRing.RField.invfM StdRing.RField.mulrA -!StdRing.RField.mulrA. congr; by rewrite StdRing.RField.mul1r. -rewrite -{1}block_card -{1}capacity_card - -(DBlock.dunifin1E wit_pair.`1) -(DCapacity.dunifin1E wit_pair.`2) - -StdRing.RField.mulrA -DProd.dprod1E. -have -> : (wit_pair.`1, wit_pair.`2) = witness - by rewrite /wit_pair // {3}(pairS witness). +rewrite/=. have -> : (4 * limit ^ 2)%r / (2 ^ c)%r = limit%r * ((2 * limit)%r / (2 ^ c)%r) + limit%r * ((2 * limit)%r / (2 ^ c)%r). @@ -188,27 +191,31 @@ have -> : have {3}-> : 2 = 1 + 1 by trivial. rewrite powS // pow1 /#. rewrite -/SLCommon.dstate /limit. -rewrite - (RealOrder.ler_trans - (`|Pr[BlockSponge.RealIndif - (BlockSponge.Sponge, Perm, LowerDist(DRestr(Dist))).main() @ &m : res] - - Pr[BlockSponge.IdealIndif - (BlockSponge.BIRO.IRO, BlockSponge.Sim, - LowerDist(DRestr(Dist))).main() @ &m : res]|)) - 1:RealOrder.lerr_eq - 1:(conclusion BlockSponge.Sim (DRestr(Dist)) &m) // - (drestr_commute1 &m) (drestr_commute2 &m) StdRing.RField.addrA - (BlockSponge.conclusion (LowerDist(Dist)) &m). +cut->:=conclusion (Gconcl_list.SimLast(Gconcl.S)) (DRestr(Dist)) &m. +cut//=:=(Gconcl_list.Real_Ideal (LowerDist(Dist)) _ &m). ++ move=>F P hp hpi hf'//=. + cut hf:islossless RaiseFun(F).f. + - proc;call hf';auto. + exact(Dist_lossless (RaiseFun(F)) P hp hpi hf). +by rewrite(drestr_commute1 &m) (drestr_commute2 &m);smt(). qed. end section. lemma SHA3Security - (Dist <: - DISTINGUISHER{Perm, IRO, BlockSponge.BIRO.IRO, Cntr, - BlockSponge.Sim, BlockSponge.C}) &m : + (Dist <: DISTINGUISHER{ + Perm, IRO, BlockSponge.BIRO.IRO, Cntr, + Gconcl_list.SimLast(Gconcl.S), BlockSponge.C, Gconcl.S, + SLCommon.F.RO, SLCommon.F.RRO, SLCommon.Redo, SLCommon.C, + Gconcl_list.BIRO2.IRO, Gconcl_list.F2.RO, Gconcl_list.F2.RRO}) + &m : + (forall (F <: DFUNCTIONALITY) (P <: DPRIMITIVE), + islossless P.f => + islossless P.fi => + islossless F.f => + islossless Dist(F,P).distinguish) => `|Pr[RealIndif(Sponge, Perm, DRestr(Dist)).main() @ &m : res] - Pr[IdealIndif - (IRO, RaiseSim(BlockSponge.Sim), DRestr(Dist)).main() @ &m : res]| <= + (IRO, RaiseSim(Gconcl_list.SimLast(Gconcl.S)), DRestr(Dist)).main() @ &m : res]| <= (limit ^ 2)%r / (2 ^ (r + c + 1))%r + (4 * limit ^ 2)%r / (2 ^ c)%r. -proof. apply (security Dist &m). qed. +proof. move=>h;apply (security Dist h &m). qed. diff --git a/proof/smart_counter/Gconcl_list.ec b/proof/smart_counter/Gconcl_list.ec index 7645d37..e998c81 100644 --- a/proof/smart_counter/Gconcl_list.ec +++ b/proof/smart_counter/Gconcl_list.ec @@ -1697,7 +1697,7 @@ end section Real. section Real_Ideal. (* REAL & IDEAL *) - declare module D : DISTINGUISHER{SLCommon.C, C, Perm, Redo, F.RO, F.RRO, S}. + declare module D : DISTINGUISHER{SLCommon.C, C, Perm, Redo, F.RO, F.RRO, S, BIRO.IRO, BIRO2.IRO, F2.RO, F2.FRO}. axiom D_lossless (F0 <: DFUNCTIONALITY{D}) (P0 <: DPRIMITIVE{D}) : islossless P0.f => islossless P0.fi => islossless F0.f => @@ -1723,13 +1723,158 @@ section Real_Ideal. lemma concl &m : Pr [ RealIndif(Sponge,P,DRestr(D)).main() @ &m : res ] <= Pr [ IdealIndif(BIRO.IRO, SimLast(S), DRestr(D)).main() @ &m : res ] + - (max_size ^ 2)%r / 2%r * mu dstate (pred1 witness) + + (max_size ^ 2)%r / 2%r / (2^r)%r / (2^c)%r + max_size%r * ((2*max_size)%r / (2^c)%r) + max_size%r * ((2*max_size)%r / (2^c)%r). proof. rewrite-(pr_real D &m). - rewrite-(equiv_ideal D &m). - apply(Real_Ideal (A(D)) A_lossless &m). + rewrite-(equiv_ideal D &m). + cut:=Real_Ideal (A(D)) A_lossless &m. print DProd. + pose x:=witness;elim:x=>a b. + by rewrite/dstate DProd.dprod1E DBlock.dunifin1E DCapacity.dunifin1E/= + block_card capacity_card;smt(). qed. -end section Real_Ideal. \ No newline at end of file + +end section Real_Ideal. + + +require import AdvAbsVal. + +print AdvAbsVal. + +section Real_Ideal_Abs. + + declare module D : DISTINGUISHER{SLCommon.C, C, Perm, Redo, F.RO, F.RRO, S, BIRO.IRO, BIRO2.IRO, F2.RO, F2.FRO}. + + axiom D_lossless (F0 <: DFUNCTIONALITY{D}) (P0 <: DPRIMITIVE{D}) : + islossless P0.f => islossless P0.fi => islossless F0.f => + islossless D(F0, P0).distinguish. + + + local module Neg_D (D : DISTINGUISHER) (F : DFUNCTIONALITY) (P : DPRIMITIVE) = { + proc distinguish () : bool = { + var b : bool; + b <@ D(F,P).distinguish(); + return !b; + } + }. + + + local lemma Neg_D_lossless (F <: DFUNCTIONALITY{Neg_D(D)}) (P <: DPRIMITIVE{Neg_D(D)}) : + islossless P.f => islossless P.fi => + islossless F.f => islossless Neg_D(D, F, P).distinguish. + proof. + by progress;proc;inline*;call(D_lossless F P H H0 H1);auto. + qed. + + + local lemma useful m mi a : + invm m mi => ! a \in dom m => Distr.is_lossless ((bdistr `*` cdistr) \ mem (rng m)). + proof. + move=>hinvm nin_dom. + cut prod_ll:Distr.is_lossless (bdistr `*` cdistr). + + by rewrite dprod_ll DBlock.dunifin_ll DCapacity.dunifin_ll. + apply dexcepted_ll=>//=;rewrite-prod_ll. + cut->:predT = predU (predC (mem (rng m))) (mem (rng m));1:rewrite predCU//=. + rewrite Distr.mu_disjoint 1:predCI//=StdRing.RField.addrC. + cut/=->:=ltr_add2l (mu (bdistr `*` cdistr) (mem (rng m))) 0%r. + rewrite Distr.witness_support/predC. + move:nin_dom;apply absurd=>//=;rewrite negb_exists/==>hyp. + cut{hyp}hyp:forall x, x \in rng m by smt(supp_dprod DBlock.supp_dunifin DCapacity.supp_dunifin). + move:a. + cut:=eqEcard (dom m) (rng m);rewrite leq_card_rng_dom/=. + cut->//=/#:dom m \subset rng m;rewrite subsetP=>x;rewrite hyp//=. + qed. + + local lemma invmC (m mi : (state, state) fmap) : + invm m mi <=> invm mi m. + proof. smt(). qed. + + + local lemma Real_lossless : + islossless RealIndif(Sponge, P, DRestr(Neg_D(D))).main. + proof. + proc;inline*;auto;call(: invm Perm.m Perm.mi);2..:auto. + + exact D_lossless. + + proc;inline*;sp;if;auto;sp;if;auto;progress. + - by cut:=useful _ _ _ H H1. + - smt(invm_set dexcepted1E). + + proc;inline*;sp;if;auto;sp;if;auto;progress. + - cut:=H;rewrite invmC=>h;cut/#:=useful _ _ _ h H1. + - move:H;rewrite invmC=>H;rewrite invmC;smt(invm_set dexcepted1E in_dom in_rng). + + proc;inline*;sp;if;auto;sp;if;auto. + while(invm Perm.m Perm.mi)(n-i);auto. + - sp;if;auto;2:smt();sp;if;auto;2:smt();progress. + * by cut:=useful _ _ _ H H2. + * smt(invm_set dexcepted1E). + smt(). + conseq(:_==> invm Perm.m Perm.mi);1:smt(). + while(invm Perm.m Perm.mi)(size xs);auto. + - sp;if;auto;progress. + * by cut:=useful _ _ _ H H1. + * smt(invm_set dexcepted1E). + * smt(size_behead). + * smt(size_behead). + smt(size_ge0 size_eq0). + smt(map0P). + qed. + + + local lemma Ideal_lossless : + islossless IdealIndif(BIRO.IRO, SimLast(S), DRestr(Neg_D(D))).main. + proof. + proc;inline*;auto;call(D_lossless (FC(BIRO.IRO)) (PC(SimLast(S, BIRO.IRO))) _ _ _);auto. + + proc;inline*;sp;if;auto;sp;if;auto;sp;if;auto;2:smt(DBlock.dunifin_ll DCapacity.dunifin_ll). + sp;if;auto;sp;if;auto;2,4:smt(DBlock.dunifin_ll DCapacity.dunifin_ll). + * while(true)(n-i);auto;2:smt(DBlock.dunifin_ll DCapacity.dunifin_ll). + by sp;if;auto;smt(DBlock.dunifin_ll). + while(true)(n0-i0);auto;2:smt(DBlock.dunifin_ll DCapacity.dunifin_ll). + by sp;if;auto;smt(DBlock.dunifin_ll). + + by proc;inline*;sp;if;auto;sp;if;auto;smt(DBlock.dunifin_ll DCapacity.dunifin_ll). + proc;inline*;sp;if;auto;sp;if;auto;while(true)(n-i);auto;2:smt(). + by sp;if;auto;smt(DBlock.dunifin_ll). + qed. + + + + + local lemma neg_D_concl &m : + Pr [ IdealIndif(BIRO.IRO, SimLast(S), DRestr(D)).main() @ &m : res ] <= + Pr [ RealIndif(Sponge,P,DRestr(D)).main() @ &m : res ] + + (max_size ^ 2)%r / 2%r / (2^r)%r / (2^c)%r + + max_size%r * ((2*max_size)%r / (2^c)%r) + + max_size%r * ((2*max_size)%r / (2^c)%r). + proof. + cut->:Pr[IdealIndif(BIRO.IRO, SimLast(S), DRestr(D)).main() @ &m : res] = + Pr[Neg_main(IdealIndif(BIRO.IRO, SimLast(S), DRestr(Neg_D(D)))).main() @ &m : res]. + + by byequiv=>//=;proc;inline*;auto;conseq(:_==> b0{1} = b2{2});progress;sim. + cut->:Pr [ RealIndif(Sponge,P,DRestr(D)).main() @ &m : res ] = + Pr [ Neg_main(RealIndif(Sponge,P,DRestr(Neg_D(D)))).main() @ &m : res ]. + + by byequiv=>//=;proc;inline*;auto;conseq(:_==> b0{1} = b2{2});progress;sim. + cut h1 := Neg_A_Pr_minus (RealIndif(Sponge,P,DRestr(Neg_D(D)))) &m Real_lossless. + cut h2 := Neg_A_Pr_minus (IdealIndif(BIRO.IRO, SimLast(S), DRestr(Neg_D(D)))) &m Ideal_lossless. + cut/#:=concl (Neg_D(D)) _ &m;progress. + by proc;call(D_lossless F0 P0 H H0 H1);auto. + qed. + + lemma Real_Ideal &m : + `|Pr [ RealIndif(Sponge,Perm,DRestr(D)).main() @ &m : res ] - + Pr [ IdealIndif(BIRO.IRO, SimLast(S), DRestr(D)).main() @ &m : res ]| <= + (max_size ^ 2)%r / 2%r / (2^r)%r / (2^c)%r + + max_size%r * ((2*max_size)%r / (2^c)%r) + + max_size%r * ((2*max_size)%r / (2^c)%r). + proof. + cut := concl D D_lossless &m. + cut := neg_D_concl &m. + pose p1 := Pr[IdealIndif(BIRO.IRO, SimLast(S), DRestr(D)).main() @ &m : res]. + pose p2 := Pr[RealIndif(Sponge, Perm, DRestr(D)).main() @ &m : res]. + rewrite-5!(StdRing.RField.addrA). + pose p3 := (max_size ^ 2)%r / 2%r / (2 ^ r)%r / (2 ^ c)%r + + (max_size%r * ((2 * max_size)%r / (2 ^ c)%r) + + max_size%r * ((2 * max_size)%r / (2 ^ c)%r)). + smt(). + qed. + +end section Real_Ideal_Abs. + From ae9c18c6c6027f2e3987c80ea94b5d3b77b964d7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Fri, 18 May 2018 15:47:59 +0200 Subject: [PATCH 289/525] inlined simulator to help the simulator's complexity analysis --- proof/SHA3-Security.ec | 130 +++++++++++++++++++++++++++++++++++++---- 1 file changed, 120 insertions(+), 10 deletions(-) diff --git a/proof/SHA3-Security.ec b/proof/SHA3-Security.ec index 05e892a..3cbd007 100644 --- a/proof/SHA3-Security.ec +++ b/proof/SHA3-Security.ec @@ -1,10 +1,10 @@ (* Top-level Proof of SHA-3 Security *) -require import AllCore List IntDiv StdOrder Distr. +require import AllCore List IntDiv StdOrder Distr NewFMap FSet. require import Common Sponge. import BIRO. -require SLCommon Gconcl_list. +require SLCommon Gconcl_list BlockSponge. (* FIX: would be nicer to define limit at top-level and then clone BlockSponge with it - so BlockSponge would then clone lower-level @@ -12,9 +12,73 @@ require SLCommon Gconcl_list. op limit : {int | 0 < limit} as gt0_max_limit. *) - op limit : int = SLCommon.max_size. + + +(* The last inlined simulator *) +type state = SLCommon.state. +op parse = BlockSponge.parse. +op valid = Gconcl_list.valid. + + +module Simulator (F : DFUNCTIONALITY) = { + var m : (state, state) fmap + var mi : (state, state) fmap + var paths : (capacity, block list * block) fmap + proc init() = { + m <- map0; + mi <- map0; + paths <- map0.[c0 <- ([],b0)]; + Gconcl_list.BIRO2.IRO.init(); + } + proc f (x : state) : state = { + var p,v,z,q,k,cs,y,y1,y2; + if (! x \in dom m) { + if (x.`2 \in dom paths) { + (p,v) <- oget paths.[x.`2]; + z <- []; + (q,k) <- parse (rcons p (v +^ x.`1)); + if (valid q) { + cs <@ F.f(oget (unpad_blocks q), k * r); + z <- bits2blocks cs; + } else { + z <- Gconcl_list.BIRO2.IRO.f(q,k); + } + y1 <- last b0 z; + } else { + y1 <$ bdistr; + } + y2 <$ cdistr; + y <- (y1,y2); + m.[x] <- y; + mi.[y] <- x; + if (x.`2 \in dom paths) { + (p,v) <-oget paths.[x.`2]; + paths.[y2] <- (rcons p (v +^ x.`1),y.`1); + } + } else { + y <- oget m.[x]; + } + return y; + } + proc fi (x : state) : state = { + var y,y1,y2; + if (! x \in dom mi) { + y1 <$ bdistr; + y2 <$ cdistr; + y <- (y1,y2); + mi.[x] <- y; + m.[y] <- x; + } else { + y <- oget mi.[x]; + } + return y; + } +}. + + + (*---------------------------- Restrictions ----------------------------*) (** The counter for the functionality counts the number of times the @@ -86,7 +150,7 @@ section. declare module Dist : DISTINGUISHER{Perm, Gconcl_list.SimLast, IRO, Cntr, BlockSponge.BIRO.IRO, - BlockSponge.C, Gconcl.S, + Simulator, BlockSponge.C, Gconcl.S, SLCommon.F.RO, SLCommon.F.RRO, SLCommon.Redo, SLCommon.C, Gconcl_list.BIRO2.IRO, Gconcl_list.F2.RO, Gconcl_list.F2.RRO}. @@ -166,13 +230,55 @@ qed. op wit_pair : block * capacity = witness. +local equiv equiv_sim_f (F <: DFUNCTIONALITY{Gconcl.S, Simulator}) : + RaiseSim(Gconcl_list.SimLast(Gconcl.S),F).f + ~ + Simulator(F).f + : + ={arg, glob F, glob Gconcl_list.BIRO2.IRO} /\ ={m, mi, paths}(Gconcl.S,Simulator) + ==> + ={res, glob F, glob Gconcl_list.BIRO2.IRO} /\ ={m, mi, paths}(Gconcl.S,Simulator). +proof. +proc;inline*;if;1,3:auto=>/#. +wp;conseq(:_==> ={y1, y2, glob F, glob Gconcl_list.BIRO2.IRO} + /\ ={m, mi, paths}(Gconcl.S,Simulator));progress;sim. +if;1,3:auto=>/#;wp;sp;if;1:(auto;smt(BlockSponge.parseK BlockSponge.formatK)); + last sim;smt(BlockSponge.parseK BlockSponge.formatK). +by sp;wp;rcondt{1}1;auto;call(: true);auto;smt(BlockSponge.parseK BlockSponge.formatK). +qed. + + +local equiv equiv_sim_fi (F <: DFUNCTIONALITY{Gconcl.S, Simulator}) : + RaiseSim(Gconcl_list.SimLast(Gconcl.S),F).fi + ~ + Simulator(F).fi + : + ={arg, glob F, glob Gconcl_list.BIRO2.IRO} /\ ={m, mi, paths}(Gconcl.S,Simulator) + ==> + ={res, glob F, glob Gconcl_list.BIRO2.IRO} /\ ={m, mi, paths}(Gconcl.S,Simulator). +proof. by proc;inline*;if;auto=>/#. qed. + +local lemma replace_simulator &m : + Pr[IdealIndif(IRO, RaiseSim(Gconcl_list.SimLast(Gconcl.S)), + DRestr(Dist)).main() @ &m : res] = + Pr[IdealIndif(IRO, Simulator, DRestr(Dist)).main() @ &m : res]. +proof. +byequiv=>//=;proc;inline*;sp;wp. +call(: ={glob IRO, glob DRestr, glob Gconcl_list.BIRO2.IRO} + /\ ={m, mi, paths}(Gconcl.S,Simulator));auto. ++ by proc;sp;if;auto;call(equiv_sim_f IRO);auto. ++ by proc;sp;if;auto;call(equiv_sim_fi IRO);auto. +by proc;sim. +qed. + + + lemma security &m : `|Pr[RealIndif(Sponge, Perm, DRestr(Dist)).main() @ &m : res] - - Pr[IdealIndif - (IRO, RaiseSim(Gconcl_list.SimLast(Gconcl.S)), - DRestr(Dist)).main() @ &m : res]| <= + Pr[IdealIndif(IRO, Simulator, DRestr(Dist)).main() @ &m : res]| <= (limit ^ 2)%r / (2 ^ (r + c + 1))%r + (4 * limit ^ 2)%r / (2 ^ c)%r. proof. +rewrite -(replace_simulator &m). rewrite powS 1:addz_ge0 1:ge0_r 1:ge0_c -pow_add 1:ge0_r 1:ge0_c. have -> : (limit ^ 2)%r / (2 * (2 ^ r * 2 ^ c))%r = @@ -200,11 +306,14 @@ cut//=:=(Gconcl_list.Real_Ideal (LowerDist(Dist)) _ &m). by rewrite(drestr_commute1 &m) (drestr_commute2 &m);smt(). qed. + + + end section. lemma SHA3Security (Dist <: DISTINGUISHER{ - Perm, IRO, BlockSponge.BIRO.IRO, Cntr, + Perm, IRO, BlockSponge.BIRO.IRO, Cntr, Simulator, Gconcl_list.SimLast(Gconcl.S), BlockSponge.C, Gconcl.S, SLCommon.F.RO, SLCommon.F.RRO, SLCommon.Redo, SLCommon.C, Gconcl_list.BIRO2.IRO, Gconcl_list.F2.RO, Gconcl_list.F2.RRO}) @@ -215,7 +324,8 @@ lemma SHA3Security islossless F.f => islossless Dist(F,P).distinguish) => `|Pr[RealIndif(Sponge, Perm, DRestr(Dist)).main() @ &m : res] - - Pr[IdealIndif - (IRO, RaiseSim(Gconcl_list.SimLast(Gconcl.S)), DRestr(Dist)).main() @ &m : res]| <= + Pr[IdealIndif(IRO, Simulator, DRestr(Dist)).main() @ &m : res]| <= (limit ^ 2)%r / (2 ^ (r + c + 1))%r + (4 * limit ^ 2)%r / (2 ^ c)%r. proof. move=>h;apply (security Dist h &m). qed. + + From d77c48783c4d3b2d9f8cf81f0507abe62122f4cf Mon Sep 17 00:00:00 2001 From: Pierre-Yves Strub Date: Sun, 20 May 2018 08:39:33 +0200 Subject: [PATCH 290/525] CI --- Makefile | 6 ++++-- config/tests.config | 2 +- 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/Makefile b/Makefile index 3c2e3bd..59ef4f4 100644 --- a/Makefile +++ b/Makefile @@ -18,9 +18,11 @@ endif endif # -------------------------------------------------------------------- -.PHONY: default check check-xunit +.PHONY: default usage check check-xunit -default: +default: check + +usage: @echo "Usage: make where in [check|check-xunit]" >&2 check: diff --git a/config/tests.config b/config/tests.config index b386ecb..9a3096e 100644 --- a/config/tests.config +++ b/config/tests.config @@ -1,5 +1,5 @@ [default] -bin = ec.native +bin = easycrypt args = -I proof -I proof/variant -I proof/core [test-sha3] From fc4431811f3d822e8d5c66f36903309a4e62a647 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Wed, 23 May 2018 13:00:13 +0200 Subject: [PATCH 291/525] remove unnecessary files --- proof/RP.eca | 79 - proof/attic/LeakyAbsorb.ec | 416 ----- proof/clean/BlockSponge.eca | 1014 ----------- proof/clean/NewCommon.ec | 73 - proof/clean/NewCore.eca | 139 -- proof/core/ConcreteF.eca | 186 -- proof/core/CoreToBlockSponge.eca | 165 -- proof/core/Gcol.eca | 317 ---- proof/core/Gconcl.ec | 384 ----- proof/core/Gext.eca | 675 -------- proof/core/Handle.eca | 1865 --------------------- proof/core/IndifPadding.ec | 123 -- proof/core/LazyRO.eca | 22 - proof/core/SLCommon.ec | 395 ----- proof/core/Utils.ec | 63 - proof/smart_counter/CoreToBlockSponge.eca | 165 -- proof/smart_counter/IndifPadding.ec | 123 -- proof/smart_counter/LazyRO.eca | 22 - 18 files changed, 6226 deletions(-) delete mode 100644 proof/RP.eca delete mode 100644 proof/attic/LeakyAbsorb.ec delete mode 100644 proof/clean/BlockSponge.eca delete mode 100644 proof/clean/NewCommon.ec delete mode 100644 proof/clean/NewCore.eca delete mode 100644 proof/core/ConcreteF.eca delete mode 100644 proof/core/CoreToBlockSponge.eca delete mode 100644 proof/core/Gcol.eca delete mode 100644 proof/core/Gconcl.ec delete mode 100644 proof/core/Gext.eca delete mode 100644 proof/core/Handle.eca delete mode 100644 proof/core/IndifPadding.ec delete mode 100644 proof/core/LazyRO.eca delete mode 100644 proof/core/SLCommon.ec delete mode 100644 proof/core/Utils.ec delete mode 100644 proof/smart_counter/CoreToBlockSponge.eca delete mode 100644 proof/smart_counter/IndifPadding.ec delete mode 100644 proof/smart_counter/LazyRO.eca diff --git a/proof/RP.eca b/proof/RP.eca deleted file mode 100644 index 6c54150..0000000 --- a/proof/RP.eca +++ /dev/null @@ -1,79 +0,0 @@ -(*************************- Random Permutation -*************************) - -require import Core Real FSet NewFMap Distr. -require import Dexcepted StdOrder. import RealOrder. -require import Ring StdRing. import RField. -require Monoid. import AddMonoid. - -type t. -op dt : t distr. - -module type RP = { - proc init() : unit - proc f(x : t) : t - proc fi(x : t) : t -}. - -module type DRP = { - proc f(x : t) : t - proc fi(x : t) : t -}. - -module P : RP, DRP = { - var m : (t, t) fmap - var mi : (t, t) fmap - - proc init() = { m = map0; mi = map0; } - - proc f(x) = { - var y; - - if (! mem (dom m) x) { - y <$ dt \ (mem (rng m)); - m.[x] <- y; - mi.[y] <- x; - } - return oget m.[x]; - } - - proc fi(x) = { - var y; - - if (! mem (dom mi) x) { - y <$ dt \ (mem (rng mi)); - mi.[x] <- y; - m.[y] <- x; - } - return oget mi.[x]; - } -}. - -lemma P_init_ll: islossless P.init. -proof. by proc; auto. qed. - -(* maybe a useful standard lemma? *) - -lemma mu_except ['a] (d : 'a distr, y : 'a, P : 'a -> bool) : - y \in d => ! P y => mu d P < mu d predT. -proof. -move=> in_supp_yd notP_y. -have -> : mu d P = mu d predT - mu d (predC P) - by rewrite (mu_split d predT P) mu_not mu_and #ring. -rewrite ltr_subl_addl (ltr_le_trans (mu d (pred1 y) + mu d predT)). -by rewrite -(add0r (mu _ _)) 1:ltr_le_add. -by rewrite ler_add mu_sub /pred1; first move=> ?. -qed. - -lemma P_f_ll: is_lossless dt => support dt = predT => islossless P.f. -proof. -move=> d_ll d_fu; proc; if=> //=; auto=> &m /= x_notin_m. -have [y not_mem_y_rng_m] := endo_dom_rng P.m{m} _; first by exists x{m}. -by rewrite dexcepted_ll // -d_ll (mu_except dt y) -/(support _ _) 1:d_fu. -qed. - -lemma P_fi_ll: is_lossless dt => support dt = predT => islossless P.fi. -proof. -move=> d_ll d_fu; proc; if=> //=; auto=> &m /= x_notin_m. -have [y not_mem_y_rng_mi] := endo_dom_rng P.mi{m} _; first by exists x{m}. -by rewrite dexcepted_ll // -d_ll (mu_except dt y) -/(support _ _) 1:d_fu. -qed. diff --git a/proof/attic/LeakyAbsorb.ec b/proof/attic/LeakyAbsorb.ec deleted file mode 100644 index 8f03201..0000000 --- a/proof/attic/LeakyAbsorb.ec +++ /dev/null @@ -1,416 +0,0 @@ -(* -------------------------------------------------------------------- *) -require import Option Pair Int Real Distr List FSet NewFMap DProd. -require (*--*) LazyRP RndOrcl. - -(* -------------------------------------------------------------------- *) - -type block. (* = {0,1}^r *) -type capacity. (* = {0,1}^c *) - -op cdist : capacity distr. -op bdist : block distr. -axiom bdist_ll : weight bdist = 1%r. - -(* isomorphic to the {0,1}^? uniform distributions *) - -op b0 : block. -op c0 : capacity. - -op (^) : block -> block -> block. - -(* -------------------------------------------------------------------- *) -clone import LazyRP as Perm with - type D <- block * capacity, - op d <- bdist `*` cdist - - rename [module] "P" as "Perm". - - -(* -------------------------------------------------------------------- *) -module type WeirdIRO = { - proc init(): unit - - proc f(_: block list * int): block list -}. - -module type WeirdIRO_ = { - proc f(_: block list * int): block list -}. - -op valid_query : block list -> int -> bool. -op valid_queries : (block list) fset. -axiom valid_queryP : forall m n, valid_query m n => forall k, 0 <= k <= n => mem valid_queries (m ++ mkseq (fun x => b0) k). -axiom valid_query_take : forall m n, valid_query m n => forall i, 0 <= i <= size m => mem valid_queries (take i m). -axiom valid_query_take1 : - forall m n, valid_query m n => forall i, 0 <= i <= size m => valid_query (take i m) 1. -axiom valid_query_size : forall m n, valid_query m n => 1 <= size m. - -module type RO = { - proc init () : unit - proc f(_:block list) : block -}. - -module Ro = { - var h : (block list,block) fmap - - proc init() = { h = map0; } - - proc f(m : block list) = { - var r; - r <$ bdist; - if (!mem (dom h) m) h.[m] <- r ; - return oget h.[m]; - } -}. - -module GenIdealFunctionalityThatDoesNotAbsorb(Ro:RO) = { - proc init = Ro.init - - proc f(m : block list, n : int) = { - var i <- 1; - var j <- 1; - var z <- []; - var b <- b0; - - if (valid_query m n) { - while (j <= size m) { - z <- rcons z b; - b <@ Ro.f(take j m); - j <- j + 1; - } - while (i < n) { - z <- rcons z b; - m <- rcons m b0; - b <@ Ro.f(m); - i <- i + 1; - } - } - return z; - } -}. - -module IdealFunctionalityThatDoesNotAbsorb = GenIdealFunctionalityThatDoesNotAbsorb(Ro). - -module GenIdealFunctionalityThatAbsorbs(Ro:RO) = { - proc init = Ro.init - - proc f(m : block list, n : int) = { - var i <- 1; - var z <- []; - var b; - - if (valid_query m n) { - b <@ Ro.f(m); - while (i < n) { - z <- rcons z b; - m <- rcons m b0; - b <@ Ro.f(m); - i<- i + 1; - } - } - return z; - } -}. - -module IdealFunctionalityThatAbsorbs = GenIdealFunctionalityThatAbsorbs(Ro). - -(* -------------------------------------------------------------------- *) -module type CONSTRUCTION(P : RP) = { - proc init() : unit - - proc f(bp : block list, n : int) : block list -}. - -module type SIMULATOR(F : WeirdIRO_) = { - proc init() : unit - - proc f(_ : block * capacity) : block * capacity - - proc fi(_ : block * capacity) : block * capacity -}. - -module type DISTINGUISHER(F : WeirdIRO_, P : RP_) = { - proc distinguish() : bool -}. - -(* -------------------------------------------------------------------- *) -module Experiment(F : WeirdIRO, P : RP, D : DISTINGUISHER) = { - proc main() : bool = { - var b; - - F.init(); - P.init(); - b <@ D(F, P).distinguish(); - - return b; - } -}. - -(* -------------------------------------------------------------------- *) -module SpongeThatDoesNotAbsorb (P : RP) : WeirdIRO, CONSTRUCTION(P) = { - proc init () = { } - - proc f(p : block list, n : int): block list = { - var z <- []; - var (sa,sc) <- (b0, c0); - var i <- 0; - var l <- size p; - - if (valid_query p n) { - (* Absorption *) - while (p <> []) { - z <- rcons z sa; - (sa,sc) <@ P.f(sa ^ head b0 p, sc); - p <- behead p; - } - (* Squeezing *) - while (i < n) { - z <- rcons z sa; - (sa,sc) <@ P.f(sa,sc); - } - } - - return z; - } -}. - -module SpongeThatAbsorbs (P : RP) : WeirdIRO, CONSTRUCTION(P) = { - proc init () = {} - - proc f(p : block list, n : int): block list = { - var z <- []; - var (sa,sc) <- (b0, c0); - var i <- 0; - - if (valid_query p n) { - (* Absorption *) - while (p <> []) { - (sa,sc) <@ P.f(sa ^ head b0 p, sc); - p <- behead p; - } - (* Squeezing *) - while (i < n) { - z <- rcons z sa; - (sa,sc) <@ P.f(sa,sc); - } - } - - return z; - } -}. - -(* -------------------------------------------------------------------- *) -section PROOF. - declare module S:SIMULATOR { IdealFunctionalityThatDoesNotAbsorb }. - declare module D:DISTINGUISHER { Perm, IdealFunctionalityThatDoesNotAbsorb, S }. - - (* From DoNot to Absorb *) - - module MkF(F:WeirdIRO_) = { - proc f(m:block list, n:int) = { - var r = []; - if (valid_query m n) { - r <@ F.f(m,n); - r <- drop (size m) r; - } - return r; - } - }. - - (* From Absord to do Not *) - module MkD (D:DISTINGUISHER, F:WeirdIRO_, P:RP_) = D(MkF(F),P). - - module MkFdoNot1 (F:WeirdIRO_) = { - proc f(m:block list, n:int) : block list = { - var i, r, tl, b; - r <- []; - if (valid_query m n) { - i <- 1; - b <- [b0]; - while (i <= size m) { - r <- r ++ b; - b <- F.f(take i m, 1); - i <- i + 1; - - } - tl <- F.f(m,n); - r <- r ++ tl; - } - return r; - } - }. - - module MkFdoNot (F:WeirdIRO) = { - proc init = F.init - proc f = MkFdoNot1(F).f - }. - - module MkS(S:SIMULATOR, F:WeirdIRO) = S(MkFdoNot(F)). - - local clone RndOrcl as RndOrcl0 with - type from <- block list, - type to <- block. - - local clone RndOrcl0.RestrIdeal as RI with - op sample <- fun (bl:block list) => bdist, - op test <- (mem valid_queries), - op univ <- valid_queries, - op dfl <- b0 - proof *. - realize sample_ll. by move=> _;apply bdist_ll. qed. - realize testP. by []. qed. - import RI. - - local module E1 (Ro:RO) = { - module F = { - proc f = GenIdealFunctionalityThatDoesNotAbsorb(Ro).f - } - module P = S(F) - proc distinguish () : bool = { - var b; - P.init(); - b <@ MkD(D, F, P).distinguish(); - return b; - } - }. - - local module E2 (Ro:RO) = { - module F = { - proc f = GenIdealFunctionalityThatAbsorbs(Ro).f - } - module P = S(MkFdoNot1(F)) - proc distinguish () : bool = { - var b; - P.init(); - b <@ D(F, P).distinguish(); - return b; - } - }. - - local equiv f_f : - GenIdealFunctionalityThatDoesNotAbsorb(Ro).f ~ E1(Restr(RO)).F.f : - ={m, n} /\ Ro.h{1} = RO.m{2} ==> ={res} /\ Ro.h{1} = RO.m{2}. - proof. - proc;sp;if => //. - inline{2} Restr(RO).f. - while (={z,i,n,b,m} /\ Ro.h{1} = RO.m{2} /\ - (forall k, 0 <= k <= n - i => mem valid_queries (m ++ map (fun x => b0) (iota_ 0 k))){2}). - + rcondt{2} 5=> //. - + auto;progress; rewrite - cats1;cut := H 1 _; [by smt| by rewrite iota1]. - auto; call (_:Ro.h{1} = RO.m{2});[by sim | auto;progress]. - cut := H (k+1) _;1:by smt. - rewrite iotaS //= -cats1 -catA /= (_: map (fun (x : int) => b0) (iota_ 1 k) = map (fun (x : int) => b0) (iota_ 0 k)) //. - by rewrite (iota_addl 1 0 k) -map_comp;apply eq_map. - while (={z,j,n,b,m} /\ Ro.h{1} = RO.m{2} /\ valid_query m{1} n{1} /\ 0 <= j{1}). - + rcondt{2} 4=> //. - + auto;progress;apply (valid_query_take _ _ H)=> //. - auto; call (_:Ro.h{1} = RO.m{2});[by sim | auto;progress;smt]. - skip;progress;apply (valid_queryP _ _ H2);smt. - qed. - - local equiv f_f_a : GenIdealFunctionalityThatAbsorbs(Ro).f ~ E2(Restr(RO)).F.f : ={m,n} /\ Ro.h{1} = RO.m{2} ==> ={res} /\ Ro.h{1} = RO.m{2}. - proof. - proc; sp;if=> //;inline{2} Restr(RO).f;sp. - rcondt{2} 1=> //. - + auto;progress;cut := valid_query_take _ _ H (size m{hr}). - rewrite take_size=> HH;apply HH;smt. - while (={z,i,n,b,m} /\ Ro.h{1} = RO.m{2} /\ - (forall k, 0 <= k <= n - i => mem valid_queries (m ++ map (fun x => b0) (iota_ 0 k))){2}). - + rcondt{2} 5=> //. - + auto;progress; rewrite -cats1;cut := H 1 _; [by smt| by rewrite iota1]. - auto; call (_:Ro.h{1} = RO.m{2});[by sim | auto;progress]. - cut := H (k+1) _;1:by smt. - rewrite iotaS //= -cats1 -catA /= (_: map (fun (x : int) => b0) (iota_ 1 k) = map (fun (x : int) => b0) (iota_ 0 k)) //. - by rewrite (iota_addl 1 0 k) -map_comp;apply eq_map. - wp;call (_:Ro.h{1} = RO.m{2});[by sim | auto;progress]. - apply (valid_queryP _ _ H);smt. - qed. - - local equiv f_f' : - MkFdoNot(GenIdealFunctionalityThatAbsorbs(Ro)).f ~ MkFdoNot1(E2(Restr(RO)).F).f : - ={m, n} /\ Ro.h{1} = RO.m{2} ==> - ={res} /\ Ro.h{1} = RO.m{2}. - proof. - proc;sp;if => //;wp. - call f_f_a. - while (={i,m,r,b} /\ Ro.h{1} = RO.m{2} /\ valid_query m{1} n{1} /\ 0 <= i{1});last by auto. - wp; call f_f_a;auto;progress;smt. - qed. - - local equiv f_dN : E1(ERO).F.f ~ MkFdoNot1(E2(ERO).F).f : ={m, n} /\ ={RO.m} ==> ={res, RO.m}. - proof. - proc;sp;if=> //;sp. - inline {2} E2(ERO).F.f. - rcondt{2} 6;auto; 1: by conseq (_: _ ==> true). - while (={RO.m} /\ z{1} = r{2} ++ z0{2} /\ i{1} = i1{2} /\ n{1} = n1{2} /\ b{1} = b1{2} /\ - m{1} = m1{2}). - + inline *;auto;progress;smt. - inline ERO.f;auto. - while (={RO.m,m,n} /\ z{1} = r{2} /\ b{2} = [b{1}] /\ valid_query m{1} n{1} /\ - j{1} = i{2} /\ 0 <= i{2} /\ - (1 < j => b = mem valid_queries (take j m) ? oget RO.m.[x] : Self.b0){1}). - + rcondt{2} 6;1:by auto;progress;smt. - rcondf{2} 8;1:by auto. - auto;progress;smt. - auto;progress;smt. - qed. - - lemma conclusion &m: - `| Pr[Experiment(SpongeThatDoesNotAbsorb(Perm), Perm, MkD(D)).main() @ &m : res] - - Pr[Experiment(IdealFunctionalityThatDoesNotAbsorb, - S(IdealFunctionalityThatDoesNotAbsorb), MkD(D)).main() @ &m : res] | = - `|Pr[Experiment(SpongeThatAbsorbs(Perm),Perm,D).main() @ &m : res] - - Pr[Experiment(IdealFunctionalityThatAbsorbs, MkS(S,IdealFunctionalityThatAbsorbs), D).main() @ &m : res]|. - proof. - do 3?congr. - + byequiv (_: ={glob D} ==> _) => //;proc;inline *. - call (_: ={glob Perm});1,2:(by sim); last by auto. - proc;inline{1}SpongeThatDoesNotAbsorb(Perm).f;sp 1 3;if=> //. - sp;rcondt{1} 1=> //;wp. - while (={glob Perm, i, sa, sc} /\ n0{1} = n{2} /\ z{1} = take (size m{1}) z{1} ++ z{2} /\ size m{1} <= size z{1}). - + call (_ : ={glob Perm});[by sim|auto;progress [-split];smt]. - while (={glob Perm, p, sa,sc} /\ (size z = size m - size p){1}). - + wp;call (_ : ={glob Perm});[by sim|auto;progress [-split]]. - by rewrite size_rcons H; move: H0; case: (p{2})=> //= x xs; ring. - by auto;progress [-split];smt. - cut -> : Pr[Experiment(IdealFunctionalityThatDoesNotAbsorb, S(IdealFunctionalityThatDoesNotAbsorb), MkD(D)).main () @ &m : res] = - Pr[RndOrcl0.IND(Restr(RO), E1).main() @ &m : res]. - + byequiv=> //. (* PY: BUG printer res *) - proc;inline{2} E1(Restr(RO)).distinguish;auto. - call (_: ={glob S} /\ Ro.h{1} = RO.m{2}). - + by proc (Ro.h{1} = RO.m{2}) => //;apply f_f. - + by proc (Ro.h{1} = RO.m{2}) => //;apply f_f. - + by proc;sp;if=> //;wp;call f_f. - by inline *; call (_: Ro.h{1} = RO.m{2});auto;apply f_f. - cut -> : Pr[Experiment(IdealFunctionalityThatAbsorbs, MkS(S, IdealFunctionalityThatAbsorbs), D).main() @ &m : res] = - Pr[RndOrcl0.IND(Restr(RO), E2).main() @ &m : res]. - + byequiv=> //. - proc;inline{2} E2(Restr(RO)).distinguish;auto. - call (_: ={glob S} /\ Ro.h{1} = RO.m{2}). - + proc (Ro.h{1} = RO.m{2}) => //; apply f_f'. - + by proc (Ro.h{1} = RO.m{2}) => //;apply f_f'. - + conseq f_f_a => //. - by inline *;call (_:Ro.h{1} = RO.m{2});[apply f_f'|auto]. - cut -> : Pr[RndOrcl0.IND(Restr(RO), E1).main() @ &m : res] = - Pr[RndOrcl0.IND(ERO, E1).main() @ &m : res]. - + byequiv (Eager E1)=> //. - cut -> : Pr[RndOrcl0.IND(Restr(RO), E2).main() @ &m : res] = - Pr[RndOrcl0.IND(ERO, E2).main() @ &m : res]. - + byequiv (Eager E2)=> //. - byequiv=> //. - proc; inline *;wp. - call (_: ={RO.m, glob S}). - + by proc (={RO.m})=> //;apply f_dN. - + by proc (={RO.m})=> //;apply f_dN. - + proc;sp;if => //. - inline{1} E1(ERO).F.f;sp;rcondt{1} 1; 1:by auto. - wp;while (={RO.m,i,b} /\ n0{1} = n{2} /\ m0{1} = m{2} /\ z{1} = take (size m{1}) z{1} ++ z{2} /\ (size m <= size z){1}). - + inline *;auto;progress [-split]; smt. - inline *;splitwhile{1} 1 : (j < size m0). - wp;seq 1 0 : (={i,RO.m, m, glob S} /\ n0{1} = n{2} /\ m0{1} = m{2} /\ size m0{1} - 1 = size z{1} /\ size m0{1} = j{1} /\ z{2} = []). - while{1} (size z{1} = j{1} - 1 /\ j{1} <= size m0{1}) ((size m0 - j){1});auto;progress [-split]; smt. - rcondt{1} 1;1:by auto. - rcondf{1} 5;auto;progress[-split];smt. - call (_: ={RO.m})=> //;1:by apply f_dN. - sim : (={glob S, glob D, RO.m})=> //. - qed. diff --git a/proof/clean/BlockSponge.eca b/proof/clean/BlockSponge.eca deleted file mode 100644 index bcb4796..0000000 --- a/proof/clean/BlockSponge.eca +++ /dev/null @@ -1,1014 +0,0 @@ -require import Core Logic Distr. -require import Int IntExtra Real List NewFMap FSet. -require (*--*) StdBigop. -(*---*) import StdBigop.Bigint. -require import StdOrder. -(*---*) import IntOrder. - -require import Gconcl. -(*---*) import Common SLCommon. -(*---*) import Block DBlock Capacity DCapacity. - -(*** THEORY PARAMETERS ***) -(** Validity of Functionality Queries **) -op valid: block list -> bool. -axiom valid_spec p: valid p => p <> []. - -(** Validity and Parsing/Formatting of Functionality Queries **) -op format (p : block list) (n : int) = p ++ nseq (n - 1) b0. -op parse: block list -> (block list * int). - -axiom formatK bs: format (parse bs).`1 (parse bs).`2 = bs. -axiom parseK p n: 0 < n => valid p => parse (format p n) = (p,n). - -lemma parse_injective: injective parse. -proof. by move=> bs1 bs2 eq_format; rewrite -formatK eq_format (@formatK bs2). qed. - -lemma parse_valid p: valid p => parse p = (p,1). -proof. -move=>h;cut{1}->:p=format p 1;2:smt(parseK). -by rewrite/format/=nseq0 cats0. -qed. - -(******************* Useful lemmas ******************) -lemma take_nseq (b:block) i j : take i (nseq j b) = nseq (min i j) b. -proof. -move:i;elim/natind=>//=. -+ smt(take_le0 nseq0_le). -move=>i hi0 hind. -case(i + 1 <= j)=>hi1j. -+ rewrite (take_nth b);1:smt(size_nseq). - rewrite hind nth_nseq 1:/# //=-nseqSr/#. -rewrite take_oversize;smt(size_nseq). -qed. - -lemma sumid_leq (n m p : int) : 0 <= n => m <= p => sumid n m <= sumid n p. -proof. -move=>Hn0 Hmp. -case(m<=n)=>Hmn. search BIA.big 0 (<=). -+ rewrite BIA.big_geq//. - by apply sumr_ge0_seq=>//=;smt(mem_iota size_ge0). -rewrite(BIA.big_cat_int m n p) 1:/# //. -cut/#:0<=sumid m p. -by apply sumr_ge0_seq=>//=;smt(mem_iota size_ge0). -qed. - -(*** DEFINITIONS ***) -(** Low-Level Definitions **) -require (*--*) NewCore. - -clone import NewCore as Low with - op valid bs <- let (b,s) = bs in valid b /\ 0 < s -proof * by done. - -(** High-Level Definitions **) -(* Indifferentiability *) -clone import Indifferentiability as BS_Ind with - type p <- block * capacity, - type f_in <- block list, - type f_out <- block -proof * by done. - -(* BlockSponge Construction *) -module (BlockSponge : CONSTRUCTION) (P : DPRIMITIVE) : FUNCTIONALITY = { - proc init() = {} - - proc f(p : block list) : block = { - var (sa,sc) <- (b0,c0); - var i <- 0; - var (x,n) <- parse p; - - if (valid x /\ 0 < n) { - while (i < size p) { - (sa,sc) <@ P.f((sa +^ nth b0 p i,sc)); - i <- i + 1; - } - } - return sa; - } -}. - -(* Ideal Block Sponge Functionality *) -module IBlockSponge : FUNCTIONALITY = { - var m : (block list,block) fmap - - proc init() = { - m <- map0; - } - - proc fill_in(x) = { - if (!mem (dom m) x) { - m.[x] <$ bdistr; - } - return oget m.[x]; - } - - proc f(x : block list) = { - var bs <- b0; - var i <- 1; - - var (p,n) <- parse x; - if (valid p /\ 0 < n) { - while (i < n) { - fill_in(format p i); - i <- i + 1; - } - bs <@ fill_in(x); - } - - return bs; - } -}. - - -(* Parametric Simulator *) -module (LowSim (S : SIMULATOR) : Low.SIMULATOR) (F : Low.DFUNCTIONALITY) = { - module LoF = { - proc f(x : block list) = { - var r <- []; - var b <- b0; - var i <- 1; - - if (let (p,n) = parse x in valid p /\ 0 < n) - { - r <@ F.f(parse x); - b <- last b0 r; - } - return b; - } - } - - proc init = S(LoF).init - proc f = S(LoF).f - proc fi = S(LoF).fi -}. - -pred INV (mc : (block list,block) fmap) (mb : (block list * int,block) fmap) = - forall p, mc.[p] = mb.[parse p]. - -(* Constructed Distinguisher *) -module (HiDist (D : Low.DISTINGUISHER) : DISTINGUISHER) - (F : DFUNCTIONALITY) (P : DPRIMITIVE) = { - var c : int - module HiF = { - proc f(p : block list, n : int) = { - var r <- []; - var b <- b0; - var i <- 1; - - if (valid p /\ 0 < n /\ c + sumid (size p) (size p + n) <= max_size) { - while(i <= n) { - b <@ F.f(format p i); - c <- c + size p + i - 1; - r <- rcons r b; - i <- i + 1; - } - } - return r; - } - } - module C = { - proc f (x) = { - var y <- (b0,c0); - if (c + 1 <= max_size) { - c <- c + 1; - y <@ P.f(x); - } - return y; - } - proc fi (x) = { - var y <- (b0,c0); - if (c + 1 <= max_size) { - c <- c + 1; - y <@ P.fi(x); - } - return y; - } - } - - proc distinguish() = { - var a; - c <- 0; - a <@ D(HiF,C).distinguish(); - return a; - } -}. - -module DFCn (F : Low.FUNCTIONALITY) : Low.FUNCTIONALITY = { - proc init = F.init - proc f(p : block list, n : int) = { - var r : block list <- []; - if(C.c + sumid (size p) (size p + n) <= max_size /\ valid p /\ 0 < n) { - r <@ F.f(p,n); - C.c <- C.c + sumid (size p) (size p + n); - } - return r; - } -}. - -module DPC (P : PRIMITIVE) : PRIMITIVE = { - proc init () = { - C.init(); - P.init(); - } - proc f(x) = { - var y <- (b0,c0); - if (C.c + 1 <= max_size) { - y <@ P.f(x); - C.c <- C.c + 1; - } - return y; - } - proc fi(x) = { - var y <- (b0,c0); - if (C.c + 1 <= max_size) { - y <@ P.fi(x); - C.c <- C.c + 1; - } - return y; - } -}. - -module DFC1 (F : FUNCTIONALITY) : FUNCTIONALITY = { - proc init = F.init - proc f(x : block list) = { - var b : block <- b0; - if (C.c + size x <= max_size) { - C.c <- C.c + size x; - b <@ F.f(x); - } - return b; - } -}. - -module P = Common.Perm.Perm. -print Real_Ideal. -(*** PROOF - forall P D S, - HiDist(D)^{BlockSponge(P),P} ~ HiDist(D)^{IBlockSponge,S(IBlockSponge)} - => D^{Core(P),P} ~ D^{ICore,LowSim(S,ICore)} ***) -section PROOF. - declare module S : SIMULATOR { Low.ICORE, IBlockSponge, HiDist, C, P }. - declare module D : Low.DISTINGUISHER { Low.ICORE, IBlockSponge, HiDist, C, P, S }. - - - local module EagerCORE (P : Low.PRIMITIVE) = { - var order : block list - var capa : capacity - var blo : block - var map : (block * capacity) list - proc init() = { - order <- []; - capa <- c0; - blo <- b0; - map <- []; - CORE(P).init(); - } - proc g(bi,ci) = { - var bj, cj; - (bj,cj) <@ P.f(bi,ci); - map <- rcons map (bi,ci); - return (bj,cj); - } - proc f (p : block list, n : int) = { - var r : block list; - var i : int; - - (blo,capa) <- (b0,c0); - r <- []; - i <- 0; - if (valid p /\ 0 < n) { - while(i < size p) { - (blo,capa) <@ P.f(blo +^ nth b0 p i, capa); - i <- i + 1; - } - i <- 1; - order <- p; - r <- rcons r blo; - while (i < n) { - order <- rcons order b0; - (blo,capa) <@ P.f(blo,capa); - r <- rcons r blo; - i <- i + 1; - } - } - return r; - } - proc ewhile() = { - var i : int <- 0; - blo <- b0; - capa <- c0; - map <- []; - while(i < size order) { - (blo,capa) <@ g(blo +^ nth b0 order i,capa); - i <- i + 1; - } - } - proc nwhile(k : int) : block list = { - var i : int <- 1; - var result : block list <- []; - ewhile(); - result <- rcons result EagerCORE.blo; - while(i < k) { - EagerCORE.order <- rcons EagerCORE.order b0; - (blo,capa) <@ g(blo,capa); - result <- rcons result EagerCORE.blo; - i <- i + 1; - } - return result; - } - proc enwhile(k : int) : block list = { - var i : int <- 1; - var m : (block * capacity) list <- []; - var result : block list <- []; - ewhile(); - result <- rcons result EagerCORE.blo; - while(i < k) { - EagerCORE.order <- rcons EagerCORE.order b0; - m <- rcons EagerCORE.map (EagerCORE.blo, EagerCORE.capa); - ewhile(); - EagerCORE.map <- m; - result <- rcons result EagerCORE.blo; - i <- i + 1; - } - return result; - } - - }. - - local module EagCORE (P : Low.PRIMITIVE) : Low.FUNCTIONALITY = { - proc init = EagerCORE(P).init - - - proc f (p : block list, n : int) = { - var r : block list; - var i : int; - - (EagerCORE.blo,EagerCORE.capa) <- (b0,c0); - r <- []; - i <- 0; - if (valid p /\ 0 < n) { - i <- 1; - EagerCORE.order <- p; - EagerCORE(P).ewhile(); - r <- rcons r EagerCORE.blo; - while (i < n) { - EagerCORE.order <- rcons EagerCORE.order b0; - EagerCORE(P).ewhile(); - r <- rcons r EagerCORE.blo; - i <- i + 1; - } - } - return r; - } - }. - - - local equiv nwhile_enwhile (n : int) : - EagerCORE(P).nwhile ~ EagerCORE(P).enwhile : - ={arg, glob P, glob EagerCORE} /\ arg{1} = n ==> ={res, glob P, glob EagerCORE}. - proof. - move:n;elim/natind=>n Hn0. - + by proc;sp;rcondf{1}3;progress;2:rcondf{2}3;progress;-1:sim; - (inline*;wp;while(!i/#). - move=>Hind;case(1 <= n)=>Hn1;last first. - + by proc;sp;rcondf{1}3;2:rcondf{2}3;-1:sim;progress;inline*; - by wp;while(!i/#. - proc. - replace{1} { (!<-) as init ; rest} by { - init; - result <@ EagerCORE(P).nwhile(n); - EagerCORE.order <- rcons EagerCORE.order b0; - (EagerCORE.blo,EagerCORE.capa) <@ EagerCORE(P).g(EagerCORE.blo,EagerCORE.capa); - result <- rcons result EagerCORE.blo; - i <- i + 1; - } - (={glob P, glob EagerCORE} /\ k{1} = n + 1 - ==> ={result, glob P, glob EagerCORE}) - (={glob P, glob EagerCORE} /\ k{2} = n + 1 - ==> ={result, glob P, glob EagerCORE}); - progress;1:rewrite/#. - + sp;inline{2}1;sp;sim. - splitwhile{1}3: i < n. - rcondt{1}4;progress. - + inline*;while(i <= n /\ k = n + 1);1:(sp;if;auto=>/#). - by conseq(:_==> true);1:progress=>/#;auto. - rcondf{1}8;progress. - + inline*;sp;wp;conseq(:_==> i=n);progress. - seq 3 : (i = n);last by sp;if;auto. - while(i <= n);first by sp;if;auto=>/#. - by conseq(:_==> true);2:auto;progress=>/#. - wp;sim. - while(={glob P, glob EagerCORE} /\ (result,i,n){1} = (result0,i0,k0){2} - /\ k{1} = n + 1);1:(inline*;sp;if;auto=>/#). - by wp;conseq(:_==> ={glob P, glob EagerCORE});1:progress=>/#;sim. - - replace{2} { (!<-) as init ; rest} by { - init; - result <@ EagerCORE(P).enwhile(n); - EagerCORE.order <- rcons EagerCORE.order b0; - m <- rcons EagerCORE.map (EagerCORE.blo, EagerCORE.capa); - EagerCORE(P).ewhile(); - EagerCORE.map <- m; - result <- rcons result EagerCORE.blo; - i <- i + 1; - } - (={glob P, glob EagerCORE} - ==> ={result, glob P, glob EagerCORE}) - (={glob P, glob EagerCORE} /\ k{2} = n + 1 - ==> ={result, glob P, glob EagerCORE}); - progress;1:rewrite/#;last first. - + sp;inline{1}1;sp;sim. - splitwhile{2}3: i < n. - rcondt{2}4;2:rcondf{2}10;progress. - + by while(i <= n /\ k = n + 1);by inline*;sp;wp;conseq(:_==> true);auto=>/#. - + wp;conseq(:_==> i = n);progress. - seq 3 : (i = n);last by inline*;conseq(:_==> true);auto. - by while(i <= n /\ k = n + 1); by inline*;sp;wp;conseq(:_==> true);auto=>/#. - sim. - while(={glob P, glob EagerCORE} /\ (result,i,n){2} = (result0,i0,k0){1} - /\ k{2} = n + 1);1:inline*. - + by sp;wp;conseq(:_==> ={glob P, glob EagerCORE} /\ i1{1} = i0{2}); - 1:progress=>/#;sim. - by wp;conseq(:_==> ={glob P, glob EagerCORE});1:progress=>/#;sim. - - replace{2} { (! <- as before); <@ ; after} by { - before; - result <@ EagerCORE(P).nwhile(n); - after; - } - (={glob P, glob EagerCORE} ==> ={result, glob P, glob EagerCORE}) - (={glob P, glob EagerCORE} ==> ={result, glob P, glob EagerCORE}); - progress;1:rewrite/#;last by sim;call(Hind);auto. - - sp;sim. - - inline{2}4. - seq 1 1 : (={glob P, glob EagerCORE, result} - /\ size EagerCORE.order{2} = size EagerCORE.map{1} - /\ nth (b0,c0) EagerCORE.map{1} 0 = (nth b0 EagerCORE.order{1} 0, c0) - /\ (forall y, y \in EagerCORE.map{1} => y \in dom Perm.m{1}) - /\ (0 = size EagerCORE.map{1} => - (EagerCORE.blo,EagerCORE.capa){1} = (b0,c0)) - /\ (0 < size EagerCORE.map{1} => - (EagerCORE.blo,EagerCORE.capa){1} = - oget Perm.m{1}.[last (b0,c0) EagerCORE.map{1}]) - /\ (forall j, 0 < j < size EagerCORE.map{1} => - let ej = nth (b0,c0) EagerCORE.map{1} j in - let ej1 = nth (b0,c0) EagerCORE.map{1} (j-1) in - let mj = nth b0 EagerCORE.order{1} j in - Perm.m{1}.[ej1] = Some (ej.`1 +^ mj, ej.`2)));last first. - - + inline*. - splitwhile{2}7:i0 < size EagerCORE.order - 1. - rcondt{2}8;2:rcondf{2}16;progress. - + by while(i0 < size EagerCORE.order);1:(sp;if);auto;smt(size_rcons size_ge0). - + wp;conseq(:_==> i0 = size EagerCORE.order-1);1:progress=>/#. - seq 7:(i0 = size EagerCORE.order-1);2:(sp;if;auto=>/#). - by while(i0 <= size EagerCORE.order - 1);1:(sp;if);auto;smt(size_rcons size_ge0). - sim. - swap{1}-3;sim;sp 1 2;wp. - conseq(:_==> ={Perm.m, Perm.mi, EagerCORE.blo, EagerCORE.capa} - /\ i0{2} = size EagerCORE.order{2} - 1);progress. - + by rewrite nth_rcons size_rcons-addzA/=Block.WRing.addr0/#. - alias{2}1 permm = Perm.m. - alias{2}1 permmi = Perm.mi. - sp 0 2;conseq(:_==> m{2} = rcons EagerCORE.map{1} (EagerCORE.blo{1}, EagerCORE.capa{1}) - /\ (EagerCORE.blo{2}, EagerCORE.capa{2}) = last (b0, c0) m{2} - /\ i0{2} = size EagerCORE.order{2} - 1 - /\ (Perm.m = permm /\ Perm.mi = permmi){2});1:smt(last_rcons). - - while{2}(={glob P, EagerCORE.order} - /\ (i0 = 0 => (EagerCORE.blo,EagerCORE.capa)=(b0,c0)){2} - /\ 0 <= i0{2} <= size EagerCORE.order{2} - 1 - /\ i0{2} = size EagerCORE.map{2} - /\ size EagerCORE.order{2}-1 = size EagerCORE.map{1} - /\ rcons EagerCORE.map{1} (last (b0,c0) m{2}) = m{2} - /\ nth (b0,c0) EagerCORE.map{1} 0 = (nth b0 EagerCORE.order{1} 0, c0) - /\ (0 < i0{2} => (EagerCORE.blo,EagerCORE.capa){2} = - oget Perm.m{1}.[last (b0,c0) EagerCORE.map{2}]) - /\ EagerCORE.map{2} = take i0{2} m{2} - /\ (Perm.m = permm /\ Perm.mi = permmi){2} - /\ (forall y, y \in EagerCORE.map{1} => y \in dom Perm.m{1}) - /\ (forall j, 0 < j < size EagerCORE.map{1} => - let ej = nth (b0,c0) EagerCORE.map{1} j in - let ej1 = nth (b0,c0) EagerCORE.map{1} (j-1) in - let mj = nth b0 EagerCORE.order{1} j in - Perm.m{1}.[ej1] = Some (ej.`1 +^ mj, ej.`2)) - /\ (EagerCORE.blo{1}, EagerCORE.capa{1}) = last (b0, c0) m{2} - /\ 1 <= size EagerCORE.order{1} - ) - (size EagerCORE.order{2} - 1 - i0{2}); - progress;1:auto. - + sp;rcondf 1;auto;progress. - + case(0Hi0;last first. - + cut h:EagerCORE.map{hr} = [] by smt(size_eq0). - rewrite h/=;cut[->->]:=H _;1:rewrite/#. - by rewrite Block.WRing.add0r H7-H4 mem_nth/#. - cut:=H5 Hi0;rewrite-nth_last. - rewrite {1}H6 nth_take 1,2:/# -H3 nth_rcons-H2. - cut->/=:size EagerCORE.map{hr} - 1 < size EagerCORE.order{hr}-1 by rewrite/#. - rewrite H8 1:/# oget_some/==>[[->->]]. - rewrite -Block.WRing.addrA Block.xorwK Block.WRing.addr0//=. - rewrite H7 H6 size_take;1:smt(size_ge0). - rewrite-H3 size_rcons-H2-addzA/= H11/=. - by cut/#:=mem_nth (b0,c0)EagerCORE.map{m}(size EagerCORE.map{hr})_;smt(size_ge0). - + by rewrite/#. - + by rewrite/#. - + by rewrite/#. - + by rewrite/#. - + smt(size_rcons). - + by rewrite last_rcons/#. - + case(0Hi0;last first. - + cut h:EagerCORE.map{hr} = [] by smt(size_eq0). - rewrite h/=;cut[->->]:=H _;1:rewrite/#. - rewrite Block.WRing.add0r(take_nth(b0,c0)0)/= 2:/#. - smt(size_rcons size_ge0). - rewrite(take_nth(b0,c0));1:smt(size_rcons size_ge0). - congr;cut:=H5 Hi0. - rewrite-nth_last {1}H6 {2}H6. - rewrite nth_take 1,2:/#. - rewrite size_take 1:/#. - rewrite-H3 size_rcons-H2-addzA/=H11/=nth_rcons. - rewrite-H3-H2/=. - cut->/=:size EagerCORE.map{hr} - 1 < size EagerCORE.order{hr} - 1 by rewrite/#. - rewrite H8 1:/# oget_some/==>[[->->]]. - rewrite -Block.WRing.addrA Block.xorwK Block.WRing.addr0//=. - rewrite nth_rcons. - by rewrite-H3-H2/=H12/=/#. - by rewrite/#. - - sp;auto;progress. - + smt(size_ge0 size_rcons). - + smt(size_ge0 size_rcons). - + smt(last_rcons). - + smt(nth_rcons size_ge0). - + smt(take0). - + smt(nth_rcons). - + smt(last_rcons). - + smt(size_ge0 size_rcons). - + smt(size_ge0 size_rcons). - + case(size map_R = 0)=>HmapR. - + cut:=size_eq0 map_R;rewrite HmapR/==>{HmapR}HmapR. - cut Hmap1:(size EagerCORE.map{1} = 0) by rewrite/#. - cut:=size_eq0 EagerCORE.map{1};rewrite Hmap1/==>{Hmap1}Hmap1. - rewrite Hmap1=>/={Hind}. - move:H6;rewrite HmapR/==>[[->->]]. - by move:H2;rewrite Hmap1/==>[[->->]]. - cut h:size order_R = size map_R by rewrite/#. - rewrite last_rcons H12 1:/# -nth_last {1}H13 nth_take 1,2:/#. - rewrite nth_rcons-H9 size_rcons-addzA/=h. - cut->/=:size map_R - 1 < size map_R by rewrite/#. - cut->:size map_R = size EagerCORE.map{1} by rewrite/#. - by rewrite nth_last/#. - smt(size_ge0 size_rcons). - - inline*;wp. - case(size EagerCORE.order{1} = 0). - + sp;rcondf{1}1;2:rcondf{2}1;auto;progress;1,2:smt(size_eq0 size_ge0). - while(={Perm.mi, Perm.m, k0} /\ i0{1} = i1{2} /\ k0{1} = n /\ - ={EagerCORE.map, EagerCORE.blo, EagerCORE.capa, EagerCORE.order} /\ - ={result0} /\ - size EagerCORE.order{2} = size EagerCORE.map{1} /\ - nth (b0, c0) EagerCORE.map{1} 0 = (nth b0 EagerCORE.order{1} 0, c0) /\ - (forall (y1 : block * capacity), - y1 \in EagerCORE.map{1} => y1 \in dom Perm.m{1}) /\ - (0 = size EagerCORE.map{1} => - EagerCORE.blo{1} = b0 && EagerCORE.capa{1} = c0) /\ - (0 < size EagerCORE.map{1} => - (EagerCORE.blo{1}, EagerCORE.capa{1}) = - oget Perm.m{1}.[last (b0, c0) EagerCORE.map{1}]) /\ - forall (j : int), - 0 < j < size EagerCORE.map{1} => - Perm.m{1}.[nth (b0, c0) EagerCORE.map{1} (j - 1)] = - Some - ((nth (b0, c0) EagerCORE.map{1} j).`1 +^ - nth b0 EagerCORE.order{1} j, (nth (b0, c0) EagerCORE.map{1} j).`2));auto;progress. - + sp;if;auto;progress. - + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0 nth_rcons). - + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0 nth_rcons). - + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0 nth_rcons). - + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0 nth_rcons). - + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0 nth_rcons). - + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0 nth_rcons). - + rewrite getP !nth_rcons. rewrite size_rcons in H11. - cut->/=:j - 1 < size EagerCORE.map{2} by rewrite/#. - rewrite H. - case(jHj/=. - + cut->/=:!nth (b0, c0) EagerCORE.map{2} (j - 1) = - (EagerCORE.blo{2}, EagerCORE.capa{2}) - by cut/#:nth (b0, c0) EagerCORE.map{2} (j - 1) \in dom Perm.m{2};smt(mem_nth). - by rewrite H4//. - cut->/=:j=size EagerCORE.map{2} by rewrite/#. - cut->/=:!nth (b0, c0) EagerCORE.map{2} (size EagerCORE.map{2} - 1) = - (EagerCORE.blo{2}, EagerCORE.capa{2}) by smt(mem_nth). - by rewrite Block.WRing.addr0 H3;smt(get_oget mem_nth nth_last). - + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0 nth_rcons). - + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0 nth_rcons). - + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0 nth_rcons). - + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0 nth_rcons). - + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0 nth_rcons). - + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0 nth_rcons). - + rewrite !nth_rcons. rewrite size_rcons in H9. - cut->/=:j - 1 < size EagerCORE.map{2} by rewrite/#. - rewrite H. - case(jHj/=. - by rewrite H4//. - cut->/=:j=size EagerCORE.map{2} by rewrite/#. - by rewrite Block.WRing.addr0 H3;smt(get_oget mem_nth nth_last). - smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0 nth_rcons size_eq0). - smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0 nth_rcons). - - - while(={glob P, glob EagerCORE, result0, k0} - /\ size EagerCORE.order{2} = size EagerCORE.map{1} - /\ i1{2} <= size EagerCORE.order{2} - /\ 1 <= i1{2} <= k0{2} /\ k0{2} = n - /\ i1{2} = i0{1} - /\ nth (b0, c0) EagerCORE.map{1} 0 = (nth b0 EagerCORE.order{1} 0, c0) - /\ (forall (y1 : block * capacity), - y1 \in EagerCORE.map{1} => y1 \in dom Perm.m{1}) - /\ (0 = size EagerCORE.map{1} => - (EagerCORE.blo{1}, EagerCORE.capa{1}) = (b0, c0)) - /\ (0 < size EagerCORE.order{1} => - (EagerCORE.blo{1}, EagerCORE.capa{1}) = - oget Perm.m{1}.[last (b0, c0) EagerCORE.map{1}]) - /\ (forall (j : int), 0 < j < size EagerCORE.map{1} => - let ej = nth (b0, c0) EagerCORE.map{1} j in - let ej1 = nth (b0, c0) EagerCORE.map{1} (j - 1) in - let mj = nth b0 EagerCORE.order{1} j in - Perm.m{1}.[ej1] = Some (ej.`1 +^ mj, ej.`2))). - + sp;if;auto;progress. - + smt(size_rcons size_ge0). - + smt(size_rcons size_ge0). - + smt(size_rcons size_ge0). - + smt(size_rcons size_ge0). - + smt(size_rcons size_ge0 nth_rcons). - + smt(mem_rcons dom_set in_fsetU1). - + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0). - + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0). - + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0). - + rewrite getP !nth_rcons. rewrite size_rcons in H14. - cut->/=:j - 1 < size EagerCORE.map{2} by rewrite/#. - rewrite H. - case(jHj/=. - + cut->/=:!nth (b0, c0) EagerCORE.map{2} (j - 1) = - (EagerCORE.blo{2}, EagerCORE.capa{2}) - by cut/#:nth (b0, c0) EagerCORE.map{2} (j - 1) \in dom Perm.m{2};smt(mem_nth). - by rewrite H7//. - cut->/=:j=size EagerCORE.map{2} by rewrite/#. - cut->/=:!nth (b0, c0) EagerCORE.map{2} (size EagerCORE.map{2} - 1) = - (EagerCORE.blo{2}, EagerCORE.capa{2}) by smt(mem_nth). - by rewrite Block.WRing.addr0 H6;smt(get_oget mem_nth nth_last). - - + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0). - + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0). - + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0). - + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0 nth_rcons). - + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0 nth_rcons). - + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0 nth_rcons). - + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0 nth_rcons). - + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0 nth_rcons). - + smt(mem_rcons dom_set in_fsetU1 last_rcons size_rcons size_ge0 nth_rcons). - + rewrite !nth_rcons. rewrite size_rcons in H12. - cut->/=:j - 1 < size EagerCORE.map{2} by rewrite/#. - rewrite H. - case(jHj/=. - by rewrite H7//. - cut->/=:j=size EagerCORE.map{2} by rewrite/#. - by rewrite Block.WRing.addr0 H6;smt(get_oget mem_nth nth_last). - wp;sp. - - conseq(:_==> ={glob P, glob EagerCORE, result0, k0} - /\ size EagerCORE.order{2} = size EagerCORE.map{1} - /\ nth (b0, c0) EagerCORE.map{1} 0 = (nth b0 EagerCORE.order{1} 0, c0) - /\ (forall (y1 : block * capacity), - y1 \in EagerCORE.map{1} => y1 \in dom Perm.m{1}) - /\ (0 = size EagerCORE.map{1} => - (EagerCORE.blo{1}, EagerCORE.capa{1}) = (b0, c0)) - /\ (0 < size EagerCORE.order{1} => - (EagerCORE.blo{1}, EagerCORE.capa{1}) = - oget Perm.m{1}.[last (b0, c0) EagerCORE.map{1}]) - /\ (forall (j : int), 0 < j < size EagerCORE.map{1} => - let ej = nth (b0, c0) EagerCORE.map{1} j in - let ej1 = nth (b0, c0) EagerCORE.map{1} (j - 1) in - let mj = nth b0 EagerCORE.order{1} j in - Perm.m{1}.[ej1] = Some (ej.`1 +^ mj, ej.`2)));1:smt(size_ge0). - - (* TODO : reprendre ici *) - while( ={glob P, glob EagerCORE, result0, k0} - /\ i1{1} = i2{2} - /\ 0 <= i1{1} <= size EagerCORE.order{1} - /\ i1{1} = size EagerCORE.map{1} - /\ (0 < i1{1} => nth (b0, c0) EagerCORE.map{1} 0 = (nth b0 EagerCORE.order{1} 0, c0)) - /\ (forall (y1 : block * capacity), - y1 \in EagerCORE.map{1} => y1 \in dom Perm.m{1}) - /\ (0 = size EagerCORE.map{1} => - (EagerCORE.blo{1}, EagerCORE.capa{1}) = (b0, c0)) - /\ (0 < size EagerCORE.map{1} => - (EagerCORE.blo{1}, EagerCORE.capa{1}) = - oget Perm.m{1}.[last (b0, c0) EagerCORE.map{1}]) - /\ (forall (j : int), 0 < j < size EagerCORE.map{1} => - let ej = nth (b0, c0) EagerCORE.map{1} j in - let ej1 = nth (b0, c0) EagerCORE.map{1} (j - 1) in - let mj = nth b0 EagerCORE.order{1} j in - Perm.m{1}.[ej1] = Some (ej.`1 +^ mj, ej.`2)));last first. - + auto;smt(size_ge0). - sp;if;auto;progress. - + smt(size_ge0). - + smt(size_ge0). - + smt(size_ge0 size_rcons). - + rewrite nth_rcons;case(0Hsize//=;1:rewrite/#. - move:H3;cut->/=[->->]/=:EagerCORE.map{2} = [] by smt(size_eq0 size_ge0). - by rewrite Block.WRing.add0r. - + smt(mem_rcons dom_set in_fsetU1). - + smt(size_rcons). - + smt(size_rcons). - + smt(last_rcons). - + rewrite size_rcons in H12;rewrite getP !nth_rcons. - cut->/=:j - 1 < size EagerCORE.map{2} by rewrite/#. - pose x:=nth _ _ _;pose y:=(_,_). - cut->/=:!x=y by smt(mem_nth). - case(j//=[/#|Hsize]. - rewrite/x/y=>{x y};cut Hj/=:j = size EagerCORE.map{2} by rewrite/#. - rewrite Hj/=. - by rewrite -Block.WRing.addrA Block.xorwK Block.WRing.addr0/=;smt(get_oget mem_nth nth_last). - + smt(size_rcons). - + smt(size_rcons). - + smt(size_rcons). - + rewrite nth_rcons;case(0Hsize//=;1:rewrite/#. - move:H3;cut->/=[->->]/=:EagerCORE.map{2} = [] by smt(size_eq0 size_ge0). - by rewrite Block.WRing.add0r. - + smt(size_rcons mem_rcons). - + smt(size_rcons). - + smt(size_rcons). - + smt(size_rcons last_rcons). - rewrite size_rcons in H10;rewrite !nth_rcons. - cut->/=:j - 1 < size EagerCORE.map{2} by rewrite/#. - case(j//=[/#|Hsize]. - cut Hj/=:j = size EagerCORE.map{2} by rewrite/#. - rewrite Hj/=. - by rewrite -Block.WRing.addrA Block.xorwK Block.WRing.addr0/=;smt(get_oget mem_nth nth_last). - - qed. - - equiv core_blocksponge : - Low.Indif(DFCn(CORE(P)),DPC(P),D).main ~ - Indif(DFC1(BlockSponge(P)),DPC(P),HiDist(D)).main : - ={glob D, glob P} ==> ={res, C.c} /\ ={c}(C,HiDist). - proof. - transitivity Low.Indif(DFCn(EagerCORE(P)),DPC(P),D).main - (={glob D, glob P} ==> ={res, C.c}) - (={glob D, glob P} ==> ={res, C.c} /\ ={c}(C,HiDist));progress;1:rewrite/#. - + proc=>/=;call (_: ={glob P, C.c}); first 2 by sim. - + proc=> /=;inline*;sp;if;auto;sp;if;auto;sim. - conseq(:_==> ={glob P} /\ sc{1} = EagerCORE.capa{2} - /\ sa{1} = EagerCORE.blo{2});progress. - by while(={glob P, p0, i} /\ 0 <= i{1} <= size p0{1} - /\ (i < size p0 => nth witness p0 i = nth b0 p0 i){1} - /\ sc{1} = EagerCORE.capa{2} - /\ sa{1} = EagerCORE.blo{2});1:(sp;if);auto; - smt(nth_onth onth_nth size_ge0). - - - by inline*;auto;call(:true);auto. - - transitivity Low.Indif(DFCn(EagCORE(P)),DPC(P),D).main - (={glob D, glob P} ==> ={res, C.c}) - (={glob D, glob P} ==> ={res, C.c} /\ ={c}(C,HiDist));progress;1:rewrite/#. - + proc. - call (_: ={glob P, C.c}); first 2 by sim. - + proc=> /=; sp. - if=>//=;auto. - conseq(:_==> ={r,glob P});progress. - transitivity{1} { - EagerCORE.capa <- c0; - EagerCORE.blo <- b0; - EagerCORE.map <- []; - EagerCORE.order <- p; - r <@ EagerCORE(P).nwhile(n); - } - (={glob P, p, n} /\ valid p{1} /\ 0 < n{1} ==> ={glob P, r}) - (={glob P, p, n} /\ valid p{1} /\ 0 < n{1} ==> ={glob P, r}); - progress;1:rewrite/#. - + inline*;sim. rcondt{1}6;1:auto;sim;sp;sim. - wp;conseq(:_==> ={EagerCORE.blo, EagerCORE.capa, glob P});progress. - by while( ={EagerCORE.blo, EagerCORE.capa, glob P} - /\ (i,p0){1} = (i0,EagerCORE.order){2});1:(sp;if);auto;progress. - transitivity{1} { - EagerCORE.capa <- c0; - EagerCORE.blo <- b0; - EagerCORE.map <- []; - EagerCORE.order <- p; - r <@ EagerCORE(P).enwhile(n); - } - (={glob P, p, n} ==> ={glob P, r}) - (={glob P, p, n} /\ valid p{1} /\ 0 < n{1} ==> ={glob P, r}); - progress;1:rewrite/#;last first. - + by inline*;sim;rcondt{2}6;1:auto;sim;auto. - by sp;exists*n{1};elim*=>n;call(nwhile_enwhile n);auto. - - by inline*;auto;call(:true);auto. - - - + proc;inline{2}3;wp;call (_: ={glob P, C.c} /\ ={c}(C,HiDist)). - + by proc;inline*;sp;auto;if;auto;sp;rcondt{2}1;auto;sp;if;auto. - + by proc;inline*;sp;auto;if;auto;sp;rcondt{2}1;auto;sp;if;auto. - proc;inline*;sp;auto. - if;1:progress=>/#;sp;wp. - rcondt{1}1;1:auto=>/#;sp. - rcondt{2}1;1:auto=>/#;sp. - rcondt{2}1;1:auto;progress. - + rewrite size_cat nseq0/=. - cut/#:size p{hr} <= sumid (size p{hr}) (size p{hr} + n{hr}). - rewrite BIA.big_ltn 1:/# /=. - cut/#:=sumr_ge0_seq predT(fun n=>n)(range (size p{hr} + 1) (size p{hr} + n{hr})) _. - smt(mem_iota size_ge0). - sp;rcondt{2}1;1:(auto;smt(parseK formatK));sp. - conseq(:_==> r0{1} = r{2} /\ ={glob P} /\ C.c{2} = HiDist.c{2} - /\ i{1} = n{1} - /\ C.c{1} + sumid (size p{1}) (size p{1} + i{1}) = C.c{2});progress. - while( r0{1} = r{2} /\ ={glob P,p} /\ C.c{2} = HiDist.c{2} - /\ C.c{1} + sumid (size p{1}) (size p{1} + n{2}) <= max_size - /\ C.c{1} + sumid (size p{1}) (size p{1} + i{1}) = C.c{2} - /\ (n0, EagerCORE.blo, EagerCORE.capa){1} = (n, sa, sc){2} - /\ EagerCORE.order{1} = format p{2} i{1} - /\ i{2} = i{1} + 1 - /\ 0 < i{1} <= n0{1} - /\ valid p{2}). - + sp;rcondt{2}1;auto;progress. - + cut/#:sumid (size p{hr}) (size p{hr} + i{m}) + - size (format p{hr} (i{m} + 1)) <= - sumid (size p{hr}) (size p{hr} + n{hr}). - rewrite size_cat size_nseq-addzA/=/max H0/=. - cut/=<-:=BIA.big_int_recr (size p{hr} + i{m})(size p{hr})(fun n=>n)_;1:rewrite/#. - smt(sumid_leq size_ge0). - swap{2}5;sp;auto. - rcondt{2}1;1:(auto;smt(formatK parseK)). - conseq(:_==> ={glob P} /\ - (EagerCORE.blo, EagerCORE.capa){1} = (sa, sc){2});progress. - + rewrite size_cat-(addzA _ 1)/=size_nseq/max H1/=/#. - + rewrite size_cat-(addzA _ 1)/=size_nseq/max H1/=. search BIA.big (+) 1. - by cut/#:=BIA.big_int_recr_cond(size p{2} + i{1})(size p{2})predT(fun n=>n)_;rewrite/#. - + by rewrite rcons_cat-nseqSr 1:/# -addzA/=/format-addzA/=. - + rewrite/#. - + rewrite/#. - + rewrite/#. - while(={glob P} /\ - (i1,EagerCORE.order,EagerCORE.blo,EagerCORE.capa){1} = (i0,p0,sa,sc){2});auto. - + by sp;if;auto. - progress. - + by rewrite rcons_cat-nseqSr 1:/# -addzA/=/format-addzA/=. - + by move:H6;rewrite rcons_cat-nseqSr 1:/# -addzA/=/format-addzA/=. - by move:H6;rewrite rcons_cat-nseqSr 1:/# -addzA/=/format-addzA/=. - wp;conseq(:_==> ={glob P} /\ - (EagerCORE.blo, EagerCORE.capa){1} = (sa, sc){2});progress. - + by rewrite size_cat nseq0/#. - + by rewrite size_cat nseq0/= BIA.big_int1. - + by rewrite/format nseq0 cats0/#. - + rewrite/#. - + rewrite/#. - + rewrite/#. - + rewrite/#. - while(={glob P} /\ - (i0,EagerCORE.order,EagerCORE.blo,EagerCORE.capa){1} = (i0,p0,sa,sc){2});auto. - + by sp;if;auto. - progress. - + by rewrite/format nseq0 cats0/#. - + by rewrite size_cat nseq0/#. - + by move:H3;rewrite size_cat nseq0/#. - by auto;progress. - by inline*;auto;call(:true);auto. - qed. - - equiv icore_iblocksponge : - Low.Indif(DFCn(ICORE),DPC(LowSim(S,ICORE)),D).main ~ - Indif(DFC1(IBlockSponge),DPC(S(IBlockSponge)),HiDist(D)).main : - ={glob S, glob D} ==> ={res, C.c} /\ ={c}(C,HiDist). - proof. - proc;inline{2}3;wp;call (_: - ={glob S,C.c} /\ ={c}(C,HiDist) - /\ INV IBlockSponge.m{2} ICORE.m{1}). - + proc;inline*;sp;if;auto. - swap{2}3;sp;rcondt{2}1;auto. - call(: ={C.c} /\ ={c}(C,HiDist) /\ INV IBlockSponge.m{2} ICORE.m{1})=>/=;auto. - proc=> /=; sp;if;1:progress=>/#;inline*;sp;auto. - rcondt{1}1;1:auto=>/#. - wp. - splitwhile{1}1:i0/#;sp;if;auto=>/#. - rcondf{1}8;progress. - + wp;seq 1:(i0=n);2:(sp;if;auto=>/#). - by while(i0<=n);2:auto=>/#;sp;if;auto=>/#. - wp. - conseq(:_==> INV IBlockSponge.m{2} ICORE.m{1} /\ - ICORE.m{1}.[(p0{1}, n0{1})] = IBlockSponge.m{2}.[x1{2}]);progress. - + smt(last_rcons). - seq 3 2 : (INV IBlockSponge.m{2} ICORE.m{1} /\ - parse x1{2} = (p0{1}, n0{1}) /\ valid p0{1} /\ 0 < n0{1}); - last if;1:smt(in_dom);auto;smt(getP formatK parseK). - wp;conseq(:_==> INV IBlockSponge.m{2} ICORE.m{1} /\ i0{1} = n{1});1:progress=>/#. - while( ={n,p} /\ INV IBlockSponge.m{2} ICORE.m{1} - /\ i0{1} = i{2} /\ valid p{1} /\ 0 < n{2} /\ 0 < i0{1} <= n{1}). - + sp;if;auto;smt(in_dom formatK parseK getP). - by auto;smt(in_dom formatK parseK getP). - - + proc;sp;if;auto;swap{2}1;inline{2}1;sp;rcondt{2}1;auto. - call(: ={C.c} /\ C.c{1} = HiDist.c{2}/\ INV IBlockSponge.m{2} ICORE.m{1})=> //. - proc=> /=; sp;if;1:progress=>/#;inline*;sp;auto. - rcondt{1}1;1:auto=>/#. - wp. - splitwhile{1}1:i0/#;sp;if;auto=>/#. - rcondf{1}8;progress. - + wp;seq 1:(i0=n);2:(sp;if;auto=>/#). - by while(i0<=n);2:auto=>/#;sp;if;auto=>/#. - wp. - conseq(:_==> INV IBlockSponge.m{2} ICORE.m{1} /\ - ICORE.m{1}.[(p0{1}, n0{1})] = IBlockSponge.m{2}.[x1{2}]);progress. - + smt(last_rcons). - seq 3 2 : (INV IBlockSponge.m{2} ICORE.m{1} /\ - parse x1{2} = (p0{1}, n0{1}) /\ valid p0{1} /\ 0 < n0{1}); - last if;1:smt(in_dom);auto;smt(getP formatK parseK). - wp;conseq(:_==> INV IBlockSponge.m{2} ICORE.m{1} /\ i0{1} = n{1});1:progress=>/#. - while( ={n,p} /\ INV IBlockSponge.m{2} ICORE.m{1} - /\ i0{1} = i{2} /\ valid p{1} /\ 0 < n{2} /\ 0 < i0{1} <= n{1}). - + sp;if;auto;smt(in_dom formatK parseK getP). - by auto;smt(in_dom formatK parseK getP). - - + proc=> /=; sp;if;1:progress=>/#;inline*;sp;auto. - rcondt{1}1;1:auto=>/#;wp. - conseq(:_==> INV IBlockSponge.m{2} ICORE.m{1} - /\ C.c{1} + sumid (size p{1}) (size p{1} + n{1}) = C.c{2} - /\ HiDist.c{2} = C.c{2} /\ r0{1} = r{2});progress. - while( INV IBlockSponge.m{2} ICORE.m{1} - /\ ={i,p,n} /\ n0{1} = n{2} /\ p0{1} = p{1} - /\ valid p{1} /\ 0 < n{1} /\ 0 < i{1} <= n0{1} + 1 - /\ C.c{1} + sumid (size p{1}) (size (format p{1} i{1})) = C.c{2} - /\ C.c{1} + sumid (size p{1}) (size p{1} + n{1}) <= max_size - /\ (forall j, 0 < j < i{1} => - format p{2} j \in dom IBlockSponge.m{2}) - /\ HiDist.c{2} = C.c{2} /\ r0{1} = r{2});last first. - + auto;progress. - + rewrite/#. - + by rewrite size_cat nseq0/= BIA.big_geq/=. - + smt(in_dom). - by rewrite size_cat size_nseq max_ler /#. - sp. - rcondt{2}1;1:auto;progress. - + rewrite-addzA. - cut/=<-:=BIA.big_int_recr_cond(size (format p{hr} i{hr}))(size p{hr})predT(fun n=>n)_. - + by rewrite size_cat size_nseq max_ler/#. - cut/#:=sumid_leq(size p{hr})(size (format p{hr} i{hr}) + 1)(size p{hr} + n{hr})_ _;1:smt(size_ge0). - by rewrite size_cat size_nseq max_ler/#. - swap{2}1 7;sp. - wp=>/=. - conseq(:_==> INV IBlockSponge.m{2} ICORE.m{1} - /\ (forall (j : int), - 0 < j < i{1} + 1 => format p{2} j \in dom IBlockSponge.m{2}) - /\ oget ICORE.m{1}.[(p1{1}, n1{1})] = bs{2});progress. - + rewrite/#. - + rewrite/#. - + rewrite -addzA;congr=>//. - rewrite 2!size_cat-addzA/=2!size_nseq{1}/max H3/=max_ler 1:/#. - cut/#:=BIA.big_int_recr_cond(size p{2} + (i{2} -1))(size p{2})predT(fun n=>n)_;rewrite/#. - + rewrite -4!addzA;congr=>//;congr. - by rewrite size_cat/=size_nseq max_ler 1:/#. - rcondt{2}1;1:(auto;smt(parseK formatK)). - alias{2}1 m = IBlockSponge.m;sp;wp=>/=;swap{2}2-1;sp. - if{1};2:rcondf{2}2;1:rcondt{2}2;progress. - + while(!(format p0 n0) \in dom IBlockSponge.m /\ 0 < i0 );auto. - + sp;if;auto;progress. - + by rewrite dom_set in_fsetU1 H/=/format;smt(catsI size_nseq). - + by rewrite/#. - + by rewrite/#. - smt(in_dom formatK parseK). - rnd=>//=. - conseq(:_==> INV m{2} ICORE.m{1} /\ IBlockSponge.m{2} = m{2});progress. - + smt(getP formatK parseK in_dom). - + smt(getP formatK parseK in_dom). - + smt(getP formatK parseK in_dom). - conseq(:_==> IBlockSponge.m{2} = m{2});progress. - while{2}(IBlockSponge.m{2} = m{2} /\ 0 < i0{2} /\ (forall (j : int), - 0 < j < n0{2} => format p0{2} j \in dom m{2}))(n0{2}-i0{2});auto. - + sp;rcondf 1;auto=>/#. - smt(parseK formatK). - + conseq(:_==> IBlockSponge.m = m);1:smt(in_dom parseK formatK). - while(IBlockSponge.m = m /\ 0 < i0 /\ (forall (j : int), - 0 < j < n0 => format p0 j \in dom m));auto. - + sp;rcondf 1;auto=>/#. - smt(parseK formatK). - + conseq(:_==> IBlockSponge.m{2} = m{2});1:smt(in_dom parseK formatK). - while{2}(IBlockSponge.m{2} = m{2} /\ 0 < i0{2} /\ (forall (j : int), - 0 < j < n0{2} => format p0{2} j \in dom m{2}))(n0{2}-i0{2});auto. - + sp;rcondf 1;auto=>/#. - smt(parseK formatK). - - by inline*;auto;call(:true);auto;smt(in_dom dom0 in_fset0). - qed. - - - -end section PROOF. diff --git a/proof/clean/NewCommon.ec b/proof/clean/NewCommon.ec deleted file mode 100644 index e2055d1..0000000 --- a/proof/clean/NewCommon.ec +++ /dev/null @@ -1,73 +0,0 @@ -require import Core Logic Distr. -require import Int IntExtra Real List NewFMap FSet. -require import StdOrder. -(*---*) import IntOrder. - -(*** THEORY PARAMETERS ***) -(** Block/Rate **) -theory Block. - op r : int. - axiom r_ge0: 0 <= r. - - type block. - - op b0: block. - op (+^): block -> block -> block. - - axiom addbA b1 b2 b3: b1 +^ (b2 +^ b3) = b1 +^ b2 +^ b3. - axiom addbC b1 b2: b1 +^ b2 = b2 +^ b1. - axiom add0b b: b0 +^ b = b. - axiom addbK b: b +^ b = b0. - - op blocks: block list. - axiom blocks_spec b: count (pred1 b) blocks = 1. - axiom card_block: size blocks = 2^r. - - clone import Ring.ZModule as BlockMonoid with - type t <- block, - op zeror <- b0, - op ( + ) <- (+^), - op [ - ] (b : block) <- b - remove abbrev (-) - proof *. - realize addrA by exact/addbA. - realize addrC by exact/addbC. - realize add0r by exact/add0b. - realize addNr by exact/addbK. - - clone import MFinite as DBlock with - type t <- block, - op Support.enum <- blocks - rename "dunifin" as "bdistr" - "duniform" as "bdistr" - proof *. - realize Support.enum_spec by exact/blocks_spec. -end Block. -import Block DBlock. - -(** Capacity **) -theory Capacity. - op c : int. - axiom c_ge0: 0 <= c. - - type capacity. - - op c0: capacity. - - op caps: capacity list. - axiom caps_spec b: count (pred1 b) caps = 1. - axiom card_capacity: size caps = 2^c. - - clone import MFinite as DCapacity with - type t <- capacity, - op Support.enum <- caps - rename "dunifin" as "cdistr" - "duniform" as "cdistr" - proof *. - realize Support.enum_spec by exact/caps_spec. -end Capacity. -import Capacity DCapacity. - -(** Query Bound **) -op max_query: int. -axiom max_query_ge0: 0 <= max_query. \ No newline at end of file diff --git a/proof/clean/NewCore.eca b/proof/clean/NewCore.eca deleted file mode 100644 index b42ce5c..0000000 --- a/proof/clean/NewCore.eca +++ /dev/null @@ -1,139 +0,0 @@ -require import Core Int Real List FSet NewFMap Distr. -require import StdOrder Ring DProd. -(*---*) import IntOrder. - -require (*..*) RP Indifferentiability. - -require import Common. -(*---*) import Block DBlock Capacity DCapacity. - -(** Validity of Functionality Queries **) -op valid: block list * int -> bool. - -(*** DEFINITIONS ***) -type state = block * capacity. -op dstate = bdistr `*` cdistr. - -(** Indifferentiability Experiment **) -clone include Indifferentiability with - type p <- state, - type f_in <- block list * int, - type f_out <- block list - rename [module] "GReal" as "RealIndif" - [module] "GIdeal" as "IdealIndif". - -(** CORE Construction **) -module (CORE : CONSTRUCTION) (P : DPRIMITIVE): FUNCTIONALITY = { - proc init () = {} - - proc f(p : block list, n : int): block list = { - var (sa,sc) <- (b0,c0); - var r <- []; - var i <- 0; - - if (valid (p,n)) { - while (i < size p) { - (sa,sc) <@ P.f((sa +^ nth witness p i,sc)); - i <- i + 1; - } - i <- 1; - r <- rcons r sa; - while(i < n) { - (sa,sc) <@ P.f(sa,sc); - r <- rcons r sa; - i <- i + 1; - } - } - return r; - } -}. - -(** Ideal CORE Functionality **) -module ICORE : FUNCTIONALITY = { - var m : (block list * int,block) fmap - - proc init() = { - m = map0; - } - - proc fill_in(p : block list, n : int): block = { - if (!mem (dom m) (p,n)) { - m.[(p,n)] <$ bdistr; - } - return oget m.[(p,n)]; - } - - proc f(p : block list, n : int): block list = { - var r <- []; - var i <- 1; - var b; - - if (valid (p,n)) { - while (i <= n) { - b <@ fill_in(p,i); - r <- rcons r b; - i <- i + 1; - } - } - return r; - } -}. - -(** CORE Simulator **) -module (S : SIMULATOR) (F : DFUNCTIONALITY) : PRIMITIVE = { - var m, mi : (state,state) fmap - var pi : (capacity, block list * block) fmap - - proc init() = { - m <- map0; - mi <- map0; - pi <- map0.[c0 <- ([<:block>],b0)]; - } - - proc f(x : state): state = { - var p, v, y, y1, y2; - var b; - - if (!mem (dom m) x) { - if (mem (dom pi) x.`2) { - (p,v) <- oget pi.[x.`2]; - b <- F.f (rcons p (v +^ x.`1),1); - y1 <- last b0 b; - } else { - y1 <$ bdistr; - } - y2 <$ cdistr; - y <- (y1,y2); - m.[x] <- y; - mi.[y] <- x; - if (mem (dom pi) x.`2) { - (p,v) <- oget pi.[x.`2]; - pi.[y.`2] <- (rcons p (v +^ x.`1), y.`1); - } - } else { - y <- oget m.[x]; - } - return y; - } - - proc fi(x : state): state = { - var y, y1, y2; - - if (!mem (dom mi) x) { - y1 <$ bdistr; - y2 <$ cdistr; - y <- (y1,y2); - mi.[x] <- y; - m.[y] <- x; - } else { - y <- oget mi.[x]; - } - return y; - } -}. - - -(* we want to build S such that, - forall D, - D^{Core(P),P} ~ D^{ICore,S(ICore)} -*) \ No newline at end of file diff --git a/proof/core/ConcreteF.eca b/proof/core/ConcreteF.eca deleted file mode 100644 index dde9a3c..0000000 --- a/proof/core/ConcreteF.eca +++ /dev/null @@ -1,186 +0,0 @@ -require import Core Int Real StdOrder Ring Distr IntExtra. -require import List FSet NewFMap Utils Common SLCommon DProd Dexcepted. - -(*...*) import Capacity IntOrder RealOrder. - -require (*..*) Strong_RP_RF. - -module PF = { - var m, mi: (state,state) fmap - - proc init(): unit = { - m <- map0; - mi <- map0; - } - - proc f(x : state): state = { - var y1, y2; - - if (!mem (dom m) x) { - y1 <$ bdistr; - y2 <$ cdistr; - m.[x] <- (y1,y2); - mi.[(y1,y2)] <- x; - } - return oget m.[x]; - } - - proc fi(x : state): state = { - var y1, y2; - - if (!mem (dom mi) x) { - y1 <$ bdistr; - y2 <$ cdistr; - mi.[x] <- (y1,y2); - m.[(y1,y2)] <- x; - } - return oget mi.[x]; - } - -}. - -module CF(D:DISTINGUISHER) = Indif(SqueezelessSponge(PF), PF, D). - -section. - declare module D : DISTINGUISHER {Perm, C, PF}. - - axiom D_ll (F <: DFUNCTIONALITY{D}) (P <: DPRIMITIVE{D}): - islossless P.f => islossless P.fi => islossless F.f => - islossless D(F, P).distinguish. - - local module GReal' = Indif(FC(SqueezelessSponge(Perm)), PC(Perm), D). - - local clone import Strong_RP_RF as Switching with - type D <- state, - op uD <- dstate, - type K <- unit, - op dK <- (MUnit.dunit<:unit> tt), - op q <- max_size - proof *. - realize ge0_q by smt w=max_ge0. - realize uD_uf_fu. - split. - case=> [x y]; rewrite supp_dprod /=. - rewrite Block.DBlock.supp_dunifin Capacity.DWord.supp_dunifin/=. - smt(dprod1E Block.DBlock.dunifin_funi Capacity.DWord.dunifin_funi). - split. - smt(dprod_ll Block.DBlock.dunifin_ll Capacity.DWord.dunifin_ll). - apply/dprod_fu. - rewrite Block.DBlock.dunifin_fu. - by rewrite Capacity.DWord.dunifin_fu. - qed. - realize dK_ll. - by rewrite /is_lossless MUnit.dunit_ll. - qed. - - (* TODO move this *) - lemma size_behead (l : 'a list) : l <> [] => size (behead l) = size l - 1. - proof. by case l=> // ?? /=; ring. qed. - - local module (D': PRPt.Distinguisher) (P' : PRPt.Oracles) = { - proc distinguish = DRestr(D,SqueezelessSponge(P'),P').distinguish - }. - - local lemma DoubleBounding (P <: PRPt.StrongPRP {D, C, DBounder}) &m: - Pr[PRPt.IND(P,D').main() @ &m: res] - = Pr[PRPt.IND(P,DBounder(D')).main() @ &m: res]. - proof. - byequiv=> //=; proc; inline *. - wp. - call (_: ={glob C, glob P} /\ DBounder.FBounder.c{2} = C.c{2}). - + proc; sp; if=> //=; inline *. - rcondt{2} 4; 1: by auto=> /#. - by wp; call (_: true); auto. - + proc; sp; if=> //=; inline *. - rcondt{2} 4; 1: by auto=> /#. - by wp; call (_: true); auto. - + proc; sp; if=> //=; inline *. - wp; while ( ={glob C, glob P, p, sa, sc} - /\ C.c{2} <= max_size - /\ DBounder.FBounder.c{2} = C.c{2} - size p{2}). - rcondt{2} 3; 1: by auto; smt w=size_ge0. - by wp; call (_: true); auto=> /#. - by auto; progress; ring. - by wp; call (_: true). - qed. - - local clone import ProdSampling with - type t1 <- block, - op d1 <- bdistr, - type t2 <- capacity, - op d2 <- cdistr. - - lemma Real_Concrete &m : - Pr[GReal(D).main()@ &m: res /\ C.c <= max_size] <= - Pr[CF(DRestr(D)).main()@ &m: res] + (max_size ^ 2)%r * mu dstate (pred1 witness). - proof. - cut->: - Pr[RealIndif(SqueezelessSponge,PC(Perm),D).main()@ &m: - res /\ C.c <= max_size] = Pr[GReal'.main()@ &m: res/\ C.c <= max_size]. - + byequiv=>//;proc;inline *;call (_: ={C.c,glob Perm});last by auto. - + by sim. + by sim. - proc; inline *; wp. - while (={glob Perm,sc,sa,p} /\ (C.c + size p){1} = C.c{2});2:by auto. - by sp; if=> //=; auto=> /> &2 cL /size_behead=> ->; progress; ring. - have p_ll := P_f_ll _ _. - + apply/dprod_ll; split. - + exact/Block.DBlock.dunifin_ll. - exact/Capacity.DWord.dunifin_ll. - + apply/fun_ext=>- [] a b; rewrite supp_dprod. - by rewrite/=/predT/=Block.DBlock.dunifin_fu Capacity.DWord.dunifin_fu. - have pi_ll := P_fi_ll _ _. - + apply/dprod_ll; split. - + exact/Block.DBlock.dunifin_ll. - exact/Capacity.DWord.dunifin_ll. - + apply/fun_ext=>- [] a b; rewrite supp_dprod. - by rewrite/=/predT/=Block.DBlock.dunifin_fu Capacity.DWord.dunifin_fu. - have f_ll : islossless SqueezelessSponge(Perm).f. - + proc; while true (size p)=> //=. - * by move=> z; wp; call p_ll; skip=> /> &hr /size_behead /#. - by auto; smt w=size_ge0. - apply (ler_trans _ _ _ - (Pr_restr Perm SqueezelessSponge D p_ll pi_ll f_ll D_ll &m)). - have ->: Pr[Indif(SqueezelessSponge(Perm), Perm, DRestr(D)).main() @ &m: res] - = Pr[PRPt.IND(PRPi.PRPi,DBounder(D')).main() @ &m: res]. - + rewrite -(DoubleBounding PRPi.PRPi &m). - byequiv=> //=; proc; inline *; sim (_: ={m,mi}(Perm,PRPi.PRPi) /\ ={glob C}). - * by proc; if=> //=; auto. - by proc; if=> //=; auto. - have ->: Pr[CF(DRestr(D)).main() @ &m: res] - = Pr[PRPt.IND(ARP,DBounder(D')).main() @ &m: res]. - + rewrite -(DoubleBounding ARP &m). - byequiv=> //=; proc; inline *; sim (_: ={m,mi}(PF,ARP)). - * proc; if=> //=; auto; conseq (_: true ==> (y1,y2){1} = x{2})=> //=. - transitivity{1} { (y1,y2) <@ S.sample2(); } - (true ==> ={y1,y2}) - (true ==> (y1,y2){1} = x{2})=> //=. - - by inline *; auto. - transitivity{2} { x <@ S.sample(); } - (true ==> (y1,y2){1} = x{2}) - (true ==> ={x})=> //=. - - by symmetry; call sample_sample2; skip=> /> []. - by inline *; auto. - proc; if=> //=; auto; conseq (_: true ==> (y1,y2){1} = y{2})=> //=. - transitivity{1} { (y1,y2) <@ S.sample2(); } - (true ==> ={y1,y2}) - (true ==> (y1,y2){1} = y{2})=> //=. - - by inline *; auto. - transitivity{2} { y <@ S.sample(); } - (true ==> (y1,y2){1} = y{2}) - (true ==> ={y})=> //=. - - by symmetry; call sample_sample2; skip=> /> []. - by inline *; auto. - have /#:= Conclusion D' &m _. - move=> O O_f_ll O_fi_ll. - proc; call (_: true)=> //=. - + apply D_ll. - + by proc; sp; if=> //=; call O_f_ll; auto. - + by proc; sp; if=> //=; call O_fi_ll; auto. - + proc; inline *; sp; if=> //=; auto. - while true (size p). - * by auto; call O_f_ll; auto=> /#. - by auto; smt w=size_ge0. - by inline *; auto. - qed. - -end section. diff --git a/proof/core/CoreToBlockSponge.eca b/proof/core/CoreToBlockSponge.eca deleted file mode 100644 index 6cf2b01..0000000 --- a/proof/core/CoreToBlockSponge.eca +++ /dev/null @@ -1,165 +0,0 @@ -(* -------------------------------------------------------------------- *) -require import Option Pair Int Real Distr List FSet NewFMap DProd. -require import BlockSponge. - -require (*--*) Core. - -op max_query : int. -axiom max_query_ge0: 0 <= max_query. - -clone Core as CoreConstruction with - op Block.r <- Common.r, - type Block.block <- Common.block, - op Block.b0 <- Common.Block.b0, - op Block.(+^) <- Common.Block.(+^), - op Block.enum <- Common.Block.blocks, - op Capacity.c <- Common.c, - type Capacity.capacity <- Common.capacity, - op Capacity.c0 <- Common.Capacity.c0, - op Capacity.enum <- Common.Capacity.caps, - op max_query <- max_query -proof *. -realize Block.r_ge0 by exact/Common.ge0_r. -search Common.Block.(+^). -realize Block.addbA by exact/Common.Block.addwA. - -(*---*) import Common Perm. - -(* -------------------------------------------------------------------- *) -section PROOF. - declare module D:DISTINGUISHER { Perm, Gconcl.IF, SLCommon.C, Gconcl.S, BIRO.IRO }. - - module Wrap (D : DISTINGUISHER) (F : DFUNCTIONALITY) (P : DPRIMITIVE) = { - module WF = { - proc f(x : block list * int) = { - var r <- []; - var p, n; - - (p,n) <- x; - if (valid_block p /\ 0 < n) { - r <@ F.f(x); - } - return r; - } - } - - proc distinguish = D(WF,P).distinguish - }. - - module LowerF (F:DFUNCTIONALITY) = { - proc f(m:block list) : block = { - var r <- []; - var p, n; - - (p,n) <- strip m; - if (p <> []) { - r <- F.f(p,n); - } - return last b0 r; - } - }. - - module RaiseF (F:SLCommon.DFUNCTIONALITY) = { - proc f(m:block list, n:int) : block list = { - var i, r, b; - r <- []; - - if (m <> []) { - i <- 0; - b <- b0; - while (i < n) { - b <- F.f(extend m i); - r <- rcons r b; - i <- i + 1; - - } - } - return r; - } - }. - - module LowerDist(D : DISTINGUISHER, F : SLCommon.DFUNCTIONALITY) = - D(RaiseF(F)). - - module RaiseSim(S:SLCommon.SIMULATOR, F:DFUNCTIONALITY) = - S(LowerF(F)). - - local equiv f_f: BIRO.IRO.f ~ RaiseF(Gconcl.IF).f: - ={n} /\ x{1} = m{2} - /\ 0 <= n{2} - /\ valid_block x{1} - /\ (forall p n, BIRO.IRO.mp{1}.[(p,n)] <> None => last b0 p <> b0) - /\ (forall p, SLCommon.F.RO.m{2}.[p] = BIRO.IRO.mp{1}.[strip p]) - ==> ={res} - /\ (forall p n, BIRO.IRO.mp{1}.[(p,n)] <> None => last b0 p <> b0) - /\ (forall p, SLCommon.F.RO.m{2}.[p] = BIRO.IRO.mp{1}.[strip p]). - proof. - proc. rcondt{2} 2; 1:by auto=> /#. rcondt{1} 3; 1:by auto=> /#. - inline *. wp. - while ( ={i,n} /\ x{1} = m{2} /\ bs{1} = r{2} - /\ 0 <= i{2} <= n{2} - /\ last b0 x{1} <> b0 - /\ (forall p n, BIRO.IRO.mp{1}.[(p,n)] <> None => last b0 p <> b0) - /\ (forall p, SLCommon.F.RO.m{2}.[p] = BIRO.IRO.mp{1}.[strip p])). - + sp; if{1}. - + rcondt{2} 2. - + auto=> &hr [#] !->> i_ge0 i_lt_n wf hinv1 hinv2 _ _ + _ _. - by rewrite !in_dom /= hinv2 extendK. - auto=> &1 &2 /= [#] !->> i_ge0 _ wf inv1 inv2 i_lt_n _. - rewrite in_dom wf=> mp_xi r -> /=; split; first by rewrite !getP. - split=> [/#|]; split=> [p n|p]. - + by rewrite getP; case: ((p,n) = (m,i){2})=> [[#] <*>|_ /inv1]. - rewrite !getP; case: (strip p = (m,i){2})=> [strip_p|]. - + by have := stripK p; rewrite strip_p=> /= ->. - case: (p = extend m{2} i{2})=> [<*>|_ _]; first by rewrite extendK. - exact/inv2. - rcondf{2} 2. - + auto=> &hr [#] !->> i_ge0 i_lt_n wf hinv1 hinv2 _ _ + _ _. - by rewrite !in_dom /= hinv2 extendK. - by auto=> &1 &2; smt (DWord.bdistr_ll extendK). - by auto; smt (valid_block_ends_not_b0). - qed. - - lemma conclusion &m: - `| Pr[RealIndif(Sponge,Perm,Wrap(D)).main() @ &m : res] - - Pr[IdealIndif(BIRO.IRO,RaiseSim(Gconcl.S),Wrap(D)).main() @ &m : res] | - = `| Pr[SLCommon.RealIndif(SLCommon.SqueezelessSponge,SLCommon.PC(Perm),LowerDist(Wrap(D))).main() @ &m : res] - - Pr[SLCommon.IdealIndif(Gconcl.IF,Gconcl.S,LowerDist(Wrap(D))).main() @ &m : res] |. - proof. - do 3?congr. - + byequiv (_: ={glob D} ==> _)=> //; proc; inline *. - call (_: ={glob Perm}). - + by proc; inline *; wp; sim. - + by proc; inline *; wp; sim. - + proc; sp; if=> //. - call (_: ={glob Perm, arg} - /\ valid_block xs{1} /\ 0 < n{1} - ==> ={glob Perm, res}). - + proc. rcondt{1} 4; 1:by auto. rcondt{2} 2; 1:by auto; smt (valid_block_ends_not_b0). - rcondt{2} 4; 1:by auto. - inline{2} SLCommon.SqueezelessSponge(SLCommon.PC(Perm)).f. - seq 4 6: ( ={glob Perm, n, i, sa, sc} - /\ (* some notion of path through Perm.m *) true). - + while ( ={glob Perm, sa, sc} - /\ xs{1} = p{2} - /\ (* some notion of path through Perm.m *) true). - + wp; call (_: ={glob Perm}). - + by inline *; wp; sim. - by auto=> /> /#. - by auto=> &1 &2 [#] !<<- vblock n_gt0 /=; rewrite /extend nseq0 cats0. - (* make sure that the notion of path guarantees that only the last call of each iteration adds something to the map, and that it is exactly the right call *) - admit. - by auto=> /#. - by auto. - byequiv (_: ={glob D} ==> _)=> //; proc; inline *. - call (_: ={glob S} - /\ (forall p n, BIRO.IRO.mp{1}.[(p,n)] <> None => last b0 p <> b0) - /\ (forall p, SLCommon.F.RO.m{2}.[p] = BIRO.IRO.mp{1}.[strip p]) - /\ (* relation between S.paths and presence in the RO map *) true). - + proc. if=> //=; last by auto. if=> //=; last by auto. - inline *. admit. (* something about valid queries *) - + admit. (* prove: S(LowerF(BIRO.IRO)).fi ~ S(IF).fi *) - + by proc; sp; if=> //; call (f_f); auto=> /#. - by auto=> />; split=> [?|] ?; rewrite !map0P. - qed. -end section PROOF. diff --git a/proof/core/Gcol.eca b/proof/core/Gcol.eca deleted file mode 100644 index fcc397c..0000000 --- a/proof/core/Gcol.eca +++ /dev/null @@ -1,317 +0,0 @@ -pragma -oldip. -require import Core Int Real RealExtra StdOrder Ring StdBigop IntExtra. -require import List FSet NewFMap Utils Common SLCommon RndO FelTactic Mu_mem. -require import DProd Dexcepted. -(*...*) import Capacity IntOrder Bigreal RealOrder BRA. - -require (*..*) Handle. - -clone export Handle as Handle0. - export ROhandle. - -(* -------------------------------------------------------------------------- *) - - (* TODO: move this *) - lemma c_gt0r : 0%r < (2^c)%r. - proof. by rewrite lt_fromint;apply /powPos. qed. - - lemma c_ge0r : 0%r <= (2^c)%r. - proof. by apply /ltrW/c_gt0r. qed. - - lemma eps_ge0 : 0%r <= (2 * max_size)%r / (2 ^ c)%r. - proof. - apply divr_ge0;1:by rewrite le_fromint;smt ml=0 w=max_ge0. - by apply c_ge0r. - qed. - -section PROOF. - declare module D: DISTINGUISHER{C, PF, G1}. - - axiom D_ll (F <: DFUNCTIONALITY{D}) (P <: DPRIMITIVE{D}): - islossless P.f => islossless P.fi => - islossless F.f => islossless D(F, P).distinguish. - - local module Gcol = { - - var count : int - - proc sample_c () = { - var c=c0; - if (card (image fst (rng FRO.m)) <= 2*max_size /\ - count < max_size) { - c <$ cdistr; - G1.bcol <- G1.bcol \/ mem (image fst (rng FRO.m)) c; - count <- count + 1; - } - - return c; - } - - module C = { - - proc f(p : block list): block = { - var sa, sa', sc; - var h, i <- 0; - sa <- b0; - while (i < size p ) { - if (mem (dom G1.mh) (sa +^ nth witness p i, h)) { - (sa, h) <- oget G1.mh.[(sa +^ nth witness p i, h)]; - } else { - sc <@ sample_c(); - sa' <- F.RO.get(take (i+1) p); - sa <- sa +^ nth witness p i; - G1.mh.[(sa,h)] <- (sa', G1.chandle); - G1.mhi.[(sa',G1.chandle)] <- (sa, h); - (sa,h) <- (sa',G1.chandle); - FRO.m.[G1.chandle] <- (sc,Unknown); - G1.chandle <- G1.chandle + 1; - } - i <- i + 1; - } - sa <- F.RO.get(p); - return sa; - } - } - - module S = { - - proc f(x : state): state = { - var p, v, y, y1, y2, hy2, hx2; - - if (!mem (dom G1.m) x) { - if (!(mem (rng FRO.m) (x.`2, Known))) { - FRO.m.[G1.chandle] <- (x.`2, Known); - G1.chandle <- G1.chandle + 1; - } - hx2 <- oget (hinvK FRO.m x.`2); - if (mem (dom G1.paths) x.`2) { - (p,v) <- oget G1.paths.[x.`2]; - y1 <- F.RO.get (rcons p (v +^ x.`1)); - y2 <@ sample_c(); - } else { - y1 <$ bdistr; - y2 <@ sample_c(); - - } - y <- (y1,y2); - if (mem (dom G1.mh) (x.`1, hx2) /\ - in_dom_with FRO.m (oget G1.mh.[(x.`1,hx2)]).`2 Unknown) { - hy2 <- (oget G1.mh.[(x.`1, hx2)]).`2; - y <- (y.`1, (oget FRO.m.[hy2]).`1); - FRO.m.[hy2] <- (y.`2, Known); - G1.m.[x] <- y; - G1.mi.[y] <- x; - } else { - hy2 <- G1.chandle; - G1.chandle <- G1.chandle + 1; - FRO.m.[hy2] <- (y.`2, Known); - G1.m.[x] <- y; - G1.mh.[(x.`1, hx2)] <- (y.`1, hy2); - G1.mi.[y] <- x; - G1.mhi.[(y.`1, hy2)] <- (x.`1, hx2); - } - if (mem (dom G1.paths) x.`2) { - (p,v) <- oget G1.paths.[x.`2]; - G1.paths.[y.`2] <- (rcons p (v +^ x.`1), y.`1); - } - } else { - y <- oget G1.m.[x]; - } - return y; - } - - proc fi(x : state): state = { - var y, y1, y2, hx2, hy2; - - if (!mem (dom G1.mi) x) { - if (!(mem (rng FRO.m) (x.`2, Known))) { - FRO.m.[G1.chandle] <- (x.`2, Known); - G1.chandle <- G1.chandle + 1; - } - hx2 <- oget (hinvK FRO.m x.`2); - y1 <$ bdistr; - y2 <@ sample_c(); - y <- (y1,y2); - if (mem (dom G1.mhi) (x.`1, hx2) /\ - in_dom_with FRO.m (oget G1.mhi.[(x.`1,hx2)]).`2 Unknown) { - (y1,hy2) <- oget G1.mhi.[(x.`1, hx2)]; - y <- (y.`1, (oget FRO.m.[hy2]).`1); - FRO.m.[hy2] <- (y.`2, Known); - G1.mi.[x] <- y; - G1.m.[y] <- x; - } else { - hy2 <- G1.chandle; - G1.chandle <- G1.chandle + 1; - FRO.m.[hy2] <- (y.`2, Known); - G1.mi.[x] <- y; - G1.mhi.[(x.`1, hx2)] <- (y.`1, hy2); - G1.m.[y] <- x; - G1.mh.[(y.`1, hy2)] <- (x.`1, hx2); - } - } else { - y <- oget G1.mi.[x]; - } - return y; - } - - } - - proc main(): bool = { - var b; - - F.RO.m <- map0; - G1.m <- map0; - G1.mi <- map0; - G1.mh <- map0; - G1.mhi <- map0; - G1.bcol <- false; - - FRO.m <- map0.[0 <- (c0, Known)]; - G1.paths <- map0.[c0 <- ([<:block>],b0)]; - G1.chandle <- 1; - count <- 0; - b <@ DRestr(D,C,S).distinguish(); - return b; - } - }. - - lemma card_rng_set (m:('a,'b)fmap) x y: card(rng m.[x<-y]) <= card(rng m) + 1. - proof. - rewrite rng_set fcardU fcard1. - cut := subset_leq_fcard (rng (rem x m)) (rng m) _;2:smt ml=0 w=fcard_ge0. - rewrite subsetP=> z;apply rng_rem_le. - qed. - - lemma hinv_image handles c: - hinv handles c <> None => - mem (image fst (rng handles)) c. - proof. - case: (hinv handles c) (hinvP handles c)=>//= h[f] Heq. - rewrite imageP;exists (c,f)=>@/fst/=. - by rewrite in_rng;exists (oget (Some h)). - qed. - - local equiv G1col : G1(DRestr(D)).main ~ Gcol.main : - ={glob D} ==> (G1.bcol{1} => G1.bcol{2}) /\ Gcol.count{2} <= max_size. - proof. - proc;inline*;wp. - call (_: ={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m,C.c}/\ - (G1.bcol{1} => G1.bcol{2}) /\ - (card (rng FRO.m) <= 2*C.c + 1 /\ - Gcol.count <= C.c <= max_size){2}). - + proc;sp 1 1;if=>//. - inline G1(DRestr(D)).S.f Gcol.S.f. - seq 2 2 : (={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m, - C.c,x0} /\ - (G1.bcol{1} => G1.bcol{2}) /\ - (card(rng FRO.m) + 2 <= 2*C.c + 1/\ - Gcol.count + 1 <= C.c <= max_size){2});1:by auto=>/#. - if=>//;last by auto=>/#. - swap{1}[3..5]-2. - seq 3 2:(={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m, - C.c,x0,hx2} /\ - (G1.bcol{1} => G1.bcol{2}) /\ - (card (rng FRO.m) + 1 <= 2 * C.c + 1/\ - Gcol.count + 1 <= C.c <= max_size){2}). - + auto;smt ml=0 w=card_rng_set. - seq 2 2: - (={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m, - C.c,x0,hx2,y0} /\ - ((G1.bcol\/hinv FRO.m y0.`2 <> None){1} => G1.bcol{2}) /\ - (card (rng FRO.m) + 1 <= 2 * C.c + 1 /\ - Gcol.count <= C.c <= max_size){2});last by auto;smt ml=0 w=card_rng_set. - wp;if=>//;inline Gcol.sample_c. - + rcondt{2}4. - + auto;conseq (_:true)=>//;progress;2: smt ml=0. - by cut /#:= fcard_image_leq fst (rng FRO.m{hr}). - wp;conseq (_: ={p,v,F.RO.m,y1} /\ y2{1}=c{2})=>//;1:smt ml=0 w=hinv_image. - by sim. - rcondt{2}3. - + by auto;progress;cut /#:= fcard_image_leq fst (rng FRO.m{hr}). - auto;progress;smt w=hinv_image. - - + proc;sp 1 1;if=>//. - inline G1(DRestr(D)).S.fi Gcol.S.fi. - seq 2 2 : (={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m, - C.c,x0} /\ - (G1.bcol{1} => G1.bcol{2}) /\ - (card(rng FRO.m) + 2 <= 2*C.c + 1 /\ - Gcol.count + 1 <= C.c <= max_size){2});1:by auto=>/#. - if=>//;last by auto=>/#. - seq 3 2:(={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m, - C.c,x0,hx2} /\ - (G1.bcol{1} => G1.bcol{2}) /\ - (card (rng FRO.m) + 1 <= 2 * C.c + 1 /\ - Gcol.count + 1 <= C.c <= max_size){2}). - + by auto;smt ml=0 w=card_rng_set. - seq 3 3: - (={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m, - C.c,x0,hx2,y0,y1,y2} /\ y0{1} = (y1,y2){1} /\ - ((G1.bcol\/hinv FRO.m y0.`2 <> None){1} => G1.bcol{2}) /\ - (card (rng FRO.m) + 1 <= 2 * C.c + 1 /\ - Gcol.count <= C.c <= max_size){2});2:by auto;smt w=card_rng_set. - inline Gcol.sample_c. - rcondt{2}3. - + by auto;progress;cut /#:= fcard_image_leq fst (rng FRO.m{hr}). -(* BUG: auto=> /> ?? Himp _ _ _ ?_?_ [/Himp->// | H]. marche pas ???? *) - auto=> /> ?? Himp _ _ _ ?_?_ [/Himp->// | X];right;apply hinv_image=> //. - - + proc;sp 1 1;if=>//. - inline G1(DRestr(D)).C.f Gcol.C.f. - seq 5 5: - (={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m,C.c,b, - p,h,i,sa} /\ i{1}=0 /\ - (G1.bcol{1} => G1.bcol{2}) /\ - card (rng FRO.m{2}) + 2*(size p{2}) <= 2 * C.c{2} + 1 /\ - Gcol.count{2} + size p{2} <= C.c{2} <= max_size);1:by auto=>/#. - wp;call (_: ={F.RO.m});1:by sim. - while - (={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m,C.c,b, - p,h,i,sa} /\ (i <= size p){1} /\ - (G1.bcol{1} => G1.bcol{2}) /\ - (card (rng FRO.m) + 2*(size p - i) <= 2 * C.c + 1 /\ - Gcol.count + size p - i <= C.c <= max_size){2}); - last by auto; smt ml=0 w=size_ge0. - if=>//;auto;1:smt ml=0 w=size_ge0. - call (_: ={F.RO.m});1:by sim. - inline *;rcondt{2} 2. - + auto;progress;cut /#:= fcard_image_leq fst (rng FRO.m{hr}). - auto;smt ml=0 w=(hinv_image card_rng_set). - - auto;progress;3:by smt ml=0. - + by rewrite rng_set rem0 rng0 fset0U fcard1. - by apply max_ge0. - qed. - - local lemma Pr_col &m : - Pr[Gcol.main()@&m : G1.bcol /\ Gcol.count <= max_size] <= - max_size%r * ((2*max_size)%r / (2^c)%r). - proof. - fel 10 Gcol.count (fun x=> (2*max_size)%r / (2^c)%r) - max_size G1.bcol - [Gcol.sample_c : (card (image fst (rng FRO.m)) <= 2*max_size /\ Gcol.count < max_size)]=>//;2:by auto. - + rewrite /felsum Bigreal.sumr_const count_predT size_range. - apply ler_wpmul2r;1:by apply eps_ge0. - by rewrite le_fromint;smt ml=0 w=max_ge0. - + proc;sp;if;2:by hoare=>//??;apply eps_ge0. - wp. - rnd (mem (image fst (rng FRO.m)));skip;progress;2:smt ml=0. - cut->:=(Mu_mem.mu_mem (image fst (rng FRO.m{hr})) cdistr (1%r/(2^c)%r) _). - + move=>x _; rewrite DWord.dunifin1E;do !congr;exact cap_card. - apply ler_wpmul2r;2:by rewrite le_fromint. - by apply divr_ge0=>//;apply /c_ge0r. - + move=>ci;proc;rcondt 2;auto=>/#. - move=> b c;proc;sp;if;auto;smt ml=0. - qed. - - lemma Pr_G1col &m: - Pr[G1(DRestr(D)).main() @ &m : G1.bcol] <= max_size%r * ((2*max_size)%r / (2^c)%r). - proof. - apply (ler_trans Pr[Gcol.main()@&m : G1.bcol /\ Gcol.count <= max_size]). - + byequiv G1col=> //#. - apply (Pr_col &m). - qed. - -end section PROOF. - - diff --git a/proof/core/Gconcl.ec b/proof/core/Gconcl.ec deleted file mode 100644 index bf80aed..0000000 --- a/proof/core/Gconcl.ec +++ /dev/null @@ -1,384 +0,0 @@ -pragma -oldip. -require import Core Int Real RealExtra StdOrder Ring StdBigop IntExtra. -require import List FSet NewFMap Utils Common SLCommon RndO FelTactic Mu_mem. -require import DProd Dexcepted. -(*...*) import Capacity IntOrder Bigreal RealOrder BRA. - -require (*..*) Gext. - -module IF = { - proc init = F.RO.init - proc f = F.RO.get -}. - -module S(F : DFUNCTIONALITY) = { - var m, mi : smap - var paths : (capacity, block list * block) fmap - - proc init() = { - m <- map0; - mi <- map0; - (* the empty path is initially known by the adversary to lead to capacity 0^c *) - paths <- map0.[c0 <- ([<:block>],b0)]; - } - - proc f(x : state): state = { - var p, v, y, y1, y2; - - if (!mem (dom m) x) { - if (mem (dom paths) x.`2) { - (p,v) <- oget paths.[x.`2]; - y1 <- F.f (rcons p (v +^ x.`1)); - } else { - y1 <$ bdistr; - } - y2 <$ cdistr; - y <- (y1,y2); - m.[x] <- y; - mi.[y] <- x; - if (mem (dom paths) x.`2) { - (p,v) <- oget paths.[x.`2]; - paths.[y.`2] <- (rcons p (v +^ x.`1), y.`1); - } - } else { - y <- oget m.[x]; - } - return y; - } - - proc fi(x : state): state = { - var y, y1, y2; - - if (!mem (dom mi) x) { - y1 <$ bdistr; - y2 <$ cdistr; - y <- (y1,y2); - mi.[x] <- y; - m.[y] <- x; - } else { - y <- oget mi.[x]; - } - return y; - } - -}. - -section. - -declare module D: DISTINGUISHER{C, Perm, F.RO, F.FRO,S }. -local clone import Gext as Gext0. - -local module G3(RO:F.RO) = { - - module C = { - - proc f(p : block list): block = { - var sa, sa'; - var h, i <- 0; - sa <- b0; - while (i < size p ) { - if (mem (dom G1.mh) (sa +^ nth witness p i, h)) { - RO.sample(take (i+1) p); - (sa, h) <- oget G1.mh.[(sa +^ nth witness p i, h)]; - } else { - RRO.sample(G1.chandle); - sa' <@ RO.get(take (i+1) p); - sa <- sa +^ nth witness p i; - G1.mh.[(sa,h)] <- (sa', G1.chandle); - G1.mhi.[(sa',G1.chandle)] <- (sa, h); - (sa,h) <- (sa',G1.chandle); - G1.chandle <- G1.chandle + 1; - } - i <- i + 1; - } - sa <- RO.get(p); - return sa; - } - } - - module S = { - - proc f(x : state): state = { - var p, v, y, y1, y2, hy2, hx2, handles_,t; - - if (!mem (dom G1.m) x) { - if (mem (dom G1.paths) x.`2) { - (p,v) <- oget G1.paths.[x.`2]; - y1 <- RO.get (rcons p (v +^ x.`1)); - } else { - y1 <$ bdistr; - } - y2 <$ cdistr; - y <- (y1, y2); - handles_ <@ RRO.restrK(); - if (!mem (rng handles_) x.`2) { - RRO.set(G1.chandle, x.`2); - G1.chandle <- G1.chandle + 1; - } - handles_ <- RRO.restrK(); - hx2 <- oget (hinvc handles_ x.`2); - t <@ RRO.in_dom((oget G1.mh.[(x.`1,hx2)]).`2, Unknown); - if (mem (dom G1.mh) (x.`1, hx2) /\ t) { - hy2 <- (oget G1.mh.[(x.`1, hx2)]).`2; - FRO.m.[hy2] <- (y2,Known); - G1.m.[x] <- y; - G1.mi.[y] <- x; - } else { - hy2 <- G1.chandle; - G1.chandle <- G1.chandle + 1; - RRO.set(hy2, y.`2); - G1.m.[x] <- y; - G1.mh.[(x.`1, hx2)] <- (y.`1, hy2); - G1.mi.[y] <- x; - G1.mhi.[(y.`1, hy2)] <- (x.`1, hx2); - } - if (mem (dom G1.paths) x.`2) { - (p,v) <- oget G1.paths.[x.`2]; - G1.paths.[y.`2] <- (rcons p (v +^ x.`1), y.`1); - } - } else { - y <- oget G1.m.[x]; - } - return y; - } - - proc fi(x : state): state = { - var y, y1, y2, hx2, hy2, handles_, t; - - if (!mem (dom G1.mi) x) { - handles_ <@ RRO.restrK(); - if (!mem (rng handles_) x.`2) { - RRO.set(G1.chandle, x.`2); - G1.chandle <- G1.chandle + 1; - } - handles_ <@ RRO.restrK(); - hx2 <- oget (hinvc handles_ x.`2); - t <@ RRO.in_dom((oget G1.mhi.[(x.`1,hx2)]).`2, Unknown); - y1 <$ bdistr; - y2 <$ cdistr; - y <- (y1,y2); - if (mem (dom G1.mhi) (x.`1, hx2) /\ t) { - (y1,hy2) <- oget G1.mhi.[(x.`1, hx2)]; - FRO.m.[hy2] <- (y2,Known); - G1.mi.[x] <- y; - G1.m.[y] <- x; - } else { - hy2 <- G1.chandle; - G1.chandle <- G1.chandle + 1; - RRO.set(hy2, y.`2); - G1.mi.[x] <- y; - G1.mhi.[(x.`1, hx2)] <- (y.`1, hy2); - G1.m.[y] <- x; - G1.mh.[(y.`1, hy2)] <- (x.`1, hx2); - } - } else { - y <- oget G1.mi.[x]; - } - return y; - } - - } - - proc distinguish(): bool = { - var b; - - RO.init(); - G1.m <- map0; - G1.mi <- map0; - G1.mh <- map0; - G1.mhi <- map0; - - (* the empty path is initially known by the adversary to lead to capacity 0^c *) - RRO.init(); - RRO.set(0,c0); - G1.paths <- map0.[c0 <- ([<:block>],b0)]; - G1.chandle <- 1; - b <@ DRestr(D,C,S).distinguish(); - return b; - } -}. - -local equiv G2_G3: Eager(G2(DRestr(D))).main2 ~ G3(F.LRO).distinguish : ={glob D} ==> ={res}. -proof. - proc;wp;call{1} RRO_resample_ll;inline *;wp. - call (_: ={FRO.m,F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.chandle,G1.paths,C.c}); last by auto. - - + proc;sp;if=> //. - call (_: ={FRO.m,F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.chandle,G1.paths,C.c});2:by auto. - if=> //;2:by sim. - swap{1} [3..7] -2;swap{2} [4..8] -3. - seq 5 5:(={hx2,t,x,FRO.m,F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.chandle,G1.paths,C.c} /\ - (t = in_dom_with FRO.m (oget G1.mh.[(x.`1, hx2)]).`2 Unknown){1}); - 1:by inline *;auto. - seq 3 4:(={y,x,FRO.m,F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.chandle,G1.paths,C.c}); - 2:by sim. - if=>//. - + seq 2 2:(={y1,hx2,t,x,FRO.m,F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.chandle,G1.paths,C.c} - /\ (t = in_dom_with FRO.m (oget G1.mh.[(x.`1, hx2)]).`2 Unknown){1}). - + by inline *;auto=> /> ? _;rewrite Block.DWord.bdistr_ll. - case ((mem (dom G1.mh) (x.`1, hx2) /\ t){1}); - [rcondt{1} 3;2:rcondt{2} 3| rcondf{1} 3;2:rcondf{2} 3]; - 1,2,4,5:(by move=>?;conseq (_:true);auto);2:by sim. - inline *;rcondt{1} 6;1:by auto=>/>. - wp;rnd;auto;progress[-split];rewrite DCapacity.dunifin_ll /= => ?_?->. - by rewrite !getP /= oget_some. - case ((mem (dom G1.mh) (x.`1, hx2) /\ t){1}); - [rcondt{1} 4;2:rcondt{2} 4| rcondf{1} 4;2:rcondf{2} 4]; - 1,2,4,5:(by move=>?;conseq (_:true);auto);2:by sim. - inline *;rcondt{1} 7;1:by auto=>/>. - wp;rnd;auto;rnd{1};auto;progress[-split]. - rewrite Block.DBlock.supp_dunifin DCapacity.dunifin_ll /==> ?_?->. - by rewrite !getP /= oget_some. - - + proc;sp;if=>//. - call (_: ={FRO.m,F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.chandle,G1.paths,C.c});2:by auto. - if=> //;2:sim. - swap{1} 8 -3. - seq 6 6 : (={y1,hx2,t,x,FRO.m,F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.chandle,G1.paths,C.c} - /\ (t = in_dom_with FRO.m (oget G1.mhi.[(x.`1, hx2)]).`2 Unknown){1}). - + by inline *;auto. - case ((mem (dom G1.mhi) (x.`1, hx2) /\ t){1}); - [rcondt{1} 3;2:rcondt{2} 3| rcondf{1} 3;2:rcondf{2} 3]; - 1,2,4,5:(by move=>?;conseq (_:true);auto);2:by sim. - inline *;rcondt{1} 6;1:by auto=>/>. - wp;rnd;auto;progress[-split];rewrite DCapacity.dunifin_ll /= => ?_?->. - by rewrite !getP /= oget_some. - - proc;sp;if=>//. - call (_: ={FRO.m,F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.chandle,G1.paths,C.c});2:by auto. - by inline F.LRO.sample;sim. -qed. - -local module G4(RO:F.RO) = { - - module C = { - - proc f(p : block list): block = { - var sa; - var h, i <- 0; - sa <- b0; - while (i < size p ) { - RO.sample(take (i+1) p); - i <- i + 1; - } - sa <- RO.get(p); - return sa; - } - } - - module S = { - - proc f(x : state): state = { - var p, v, y, y1, y2; - - if (!mem (dom G1.m) x) { - if (mem (dom G1.paths) x.`2) { - (p,v) <- oget G1.paths.[x.`2]; - y1 <- RO.get (rcons p (v +^ x.`1)); - } else { - y1 <$ bdistr; - } - y2 <$ cdistr; - y <- (y1,y2); - G1.m.[x] <- y; - G1.mi.[y] <- x; - if (mem (dom G1.paths) x.`2) { - (p,v) <- oget G1.paths.[x.`2]; - G1.paths.[y.`2] <- (rcons p (v +^ x.`1), y.`1); - } - } else { - y <- oget G1.m.[x]; - } - return y; - } - - proc fi(x : state): state = { - var y, y1, y2; - - if (!mem (dom G1.mi) x) { - y1 <$ bdistr; - y2 <$ cdistr; - y <- (y1,y2); - G1.mi.[x] <- y; - G1.m.[y] <- x; - } else { - y <- oget G1.mi.[x]; - } - return y; - } - - } - - proc distinguish(): bool = { - var b; - - RO.init(); - G1.m <- map0; - G1.mi <- map0; - (* the empty path is initially known by the adversary to lead to capacity 0^c *) - G1.paths <- map0.[c0 <- ([<:block>],b0)]; - b <@ DRestr(D,C,S).distinguish(); - return b; - } -}. - -local equiv G3_G4 : G3(F.RO).distinguish ~ G4(F.RO).distinguish : ={glob D} ==> ={res}. -proof. - proc;inline *;wp. - call (_: ={G1.m,G1.mi,G1.paths,F.RO.m,C.c});last by auto. - + proc;sp;if=>//. - call (_: ={G1.m,G1.mi,G1.paths,F.RO.m,C.c});last by auto. - if => //;2:sim. - seq 3 3: (={x,y1,y2,y,G1.m,G1.mi,G1.paths,F.RO.m,C.c});1:by sim. - sim;seq 5 0: (={x,y1,y2,y,G1.m,G1.mi,G1.paths,F.RO.m,C.c});1:by inline *;auto. - by if{1};sim;inline *;auto. - + proc;sp;if=>//. - call (_: ={G1.m,G1.mi,G1.paths,F.RO.m,C.c});last by auto. - if => //;2:sim. - seq 5 0: (={x,G1.m,G1.mi,G1.paths,F.RO.m,C.c});1:by inline *;auto. - seq 3 3: (={x,y1,y2,y,G1.m,G1.mi,G1.paths,F.RO.m,C.c});1:by sim. - by if{1};sim;inline *;auto. - proc;sp;if=>//. - call (_: ={G1.m,G1.mi,G1.paths,F.RO.m,C.c});last by auto. - sp;sim; while(={i,p,F.RO.m})=>//. - inline F.RO.sample F.RO.get;if{1};1:by auto. - by sim;inline *;auto;progress;apply DCapacity.dunifin_ll. -qed. - -local equiv G4_Ideal : G4(F.LRO).distinguish ~ IdealIndif(IF,S,DRestr(D)).main : - ={glob D} ==> ={res}. -proof. - proc;inline *;wp. - call (_: ={C.c,F.RO.m} /\ G1.m{1}=S.m{2} /\ G1.mi{1}=S.mi{2} /\ G1.paths{1}=S.paths{2}). - + by sim. + by sim. - + proc;sp;if=>//. - call (_: ={F.RO.m});2:by auto. - inline F.LRO.get F.FRO.sample;wp 7 2;sim. - by while{1} (true) (size p - i){1};auto;1:inline*;auto=>/#. - by auto. -qed. - -axiom D_ll : - forall (F <: DFUNCTIONALITY{D}) (P <: DPRIMITIVE{D}), - islossless P.f => - islossless P.fi => islossless F.f => islossless D(F, P).distinguish. - - -lemma Real_Ideal &m: - Pr[GReal(D).main() @ &m: res /\ C.c <= max_size] <= - Pr[IdealIndif(IF,S,DRestr(D)).main() @ &m :res] + - (max_size ^ 2)%r * mu dstate (pred1 witness) + - max_size%r * ((2*max_size)%r / (2^c)%r) + - max_size%r * ((2*max_size)%r / (2^c)%r). -proof. - apply (ler_trans _ _ _ (Real_G2 D D_ll &m)). - rewrite !(ler_add2l, ler_add2r);apply lerr_eq. - apply (eq_trans _ Pr[G3(F.LRO).distinguish() @ &m : res]);1:by byequiv G2_G3. - apply (eq_trans _ Pr[G3(F.RO ).distinguish() @ &m : res]). - + by byequiv (_: ={glob G3, F.RO.m} ==> _)=>//;symmetry;conseq (F.RO_LRO_D G3). - apply (eq_trans _ Pr[G4(F.RO ).distinguish() @ &m : res]);1:by byequiv G3_G4. - apply (eq_trans _ Pr[G4(F.LRO).distinguish() @ &m : res]);1:by byequiv (F.RO_LRO_D G4). - by byequiv G4_Ideal. -qed. - -end section. diff --git a/proof/core/Gext.eca b/proof/core/Gext.eca deleted file mode 100644 index 988a9a2..0000000 --- a/proof/core/Gext.eca +++ /dev/null @@ -1,675 +0,0 @@ -pragma -oldip. -require import Core Int Real RealExtra StdOrder Ring StdBigop IntExtra. -require import List FSet NewFMap Utils Common SLCommon RndO FelTactic Mu_mem. -require import DProd Dexcepted. -(*...*) import Capacity IntOrder Bigreal RealOrder BRA DCapacity. - -require (*..*) Gcol. - -clone export Gcol as Gcol0. - -op bad_ext (m mi:smap) y = - mem (image snd (dom m)) y \/ - mem (image snd (dom mi)) y. - -op hinvc (m:(handle,capacity)fmap) (c:capacity) = - find (+ pred1 c) m. - -module G2(D:DISTINGUISHER,HS:FRO) = { - - module C = { - - proc f(p : block list): block = { - var sa, sa'; - var h, i <- 0; - sa <- b0; - while (i < size p ) { - if (mem (dom G1.mh) (sa +^ nth witness p i, h)) { - (sa, h) <- oget G1.mh.[(sa +^ nth witness p i, h)]; - } else { - HS.sample(G1.chandle); - sa' <@ F.RO.get(take (i+1) p); - sa <- sa +^ nth witness p i; - G1.mh.[(sa,h)] <- (sa', G1.chandle); - G1.mhi.[(sa',G1.chandle)] <- (sa, h); - (sa,h) <- (sa',G1.chandle); - G1.chandle <- G1.chandle + 1; - } - i <- i + 1; - } - sa <- F.RO.get(p); - return sa; - } - } - - module S = { - - proc f(x : state): state = { - var p, v, y, y1, y2, hy2, hx2, handles_,t; - - if (!mem (dom G1.m) x) { - if (mem (dom G1.paths) x.`2) { - (p,v) <- oget G1.paths.[x.`2]; - y1 <- F.RO.get (rcons p (v +^ x.`1)); - y2 <$ cdistr; - } else { - y1 <$ bdistr; - y2 <$ cdistr; - } - y <- (y1, y2); - - handles_ <@ HS.restrK(); - if (!mem (rng handles_) x.`2) { - HS.set(G1.chandle, x.`2); - G1.chandle <- G1.chandle + 1; - } - handles_ <- HS.restrK(); - hx2 <- oget (hinvc handles_ x.`2); - t <@ HS.in_dom((oget G1.mh.[(x.`1,hx2)]).`2, Unknown); - if (mem (dom G1.mh) (x.`1, hx2) /\ t) { - hy2 <- (oget G1.mh.[(x.`1, hx2)]).`2; - y2 <@ HS.get(hy2); - G1.bext <- G1.bext \/ bad_ext G1.m G1.mi y2 \/ y2 = x.`2; - y <- (y.`1, y2); - G1.m.[x] <- y; - G1.mi.[y] <- x; - } else { - hy2 <- G1.chandle; - G1.chandle <- G1.chandle + 1; - HS.set(hy2, y.`2); - G1.m.[x] <- y; - G1.mh.[(x.`1, hx2)] <- (y.`1, hy2); - G1.mi.[y] <- x; - G1.mhi.[(y.`1, hy2)] <- (x.`1, hx2); - } - if (mem (dom G1.paths) x.`2) { - (p,v) <- oget G1.paths.[x.`2]; - G1.paths.[y.`2] <- (rcons p (v +^ x.`1), y.`1); - } - } else { - y <- oget G1.m.[x]; - } - return y; - } - - proc fi(x : state): state = { - var y, y1, y2, hx2, hy2, handles_, t; - - if (!mem (dom G1.mi) x) { - handles_ <@ HS.restrK(); - if (!mem (rng handles_) x.`2) { - HS.set(G1.chandle, x.`2); - G1.chandle <- G1.chandle + 1; - } - handles_ <@ HS.restrK(); - hx2 <- oget (hinvc handles_ x.`2); - y1 <$ bdistr; - y2 <$ cdistr; - y <- (y1,y2); - t <@ HS.in_dom((oget G1.mhi.[(x.`1,hx2)]).`2, Unknown); - if (mem (dom G1.mhi) (x.`1, hx2) /\ t) { - (y1,hy2) <- oget G1.mhi.[(x.`1, hx2)]; - y2 <@ HS.get(hy2); - y <- (y.`1, y2); - G1.bext <- G1.bext \/ bad_ext G1.m G1.mi y2 \/ y2 = x.`2; - G1.mi.[x] <- y; - G1.m.[y] <- x; - } else { - hy2 <- G1.chandle; - G1.chandle <- G1.chandle + 1; - HS.set(hy2, y.`2); - G1.mi.[x] <- y; - G1.mhi.[(x.`1, hx2)] <- (y.`1, hy2); - G1.m.[y] <- x; - G1.mh.[(y.`1, hy2)] <- (x.`1, hx2); - } - } else { - y <- oget G1.mi.[x]; - } - return y; - } - - } - - proc distinguish(): bool = { - var b; - - F.RO.m <- map0; - G1.m <- map0; - G1.mi <- map0; - G1.mh <- map0; - G1.mhi <- map0; - G1.bext <- false; - - (* the empty path is initially known by the adversary to lead to capacity 0^c *) - HS.set(0,c0); - G1.paths <- map0.[c0 <- ([<:block>],b0)]; - G1.chandle <- 1; - b <@ D(C,S).distinguish(); - return b; - } -}. - -section. - - declare module D: DISTINGUISHER{G1, G2, FRO}. - - op inv_ext (m mi:smap) (FROm:handles) = - exists x h, mem (dom m `|` dom mi) x /\ FROm.[h] = Some (x.`2, Unknown). - - op inv_ext1 bext1 bext2 (m mi:smap) (FROm:handles) = - bext1 => (bext2 \/ inv_ext m mi FROm). - - lemma rng_restr (m : ('from, 'to * 'flag) fmap) f x: - mem (rng (restr f m)) x <=> mem (rng m) (x,f). - proof. - rewrite !in_rng;split=>-[z]H;exists z;move:H;rewrite restrP; case m.[z]=>//=. - by move=> [t f'] /=;case (f'=f). - qed. - - equiv G1_G2 : G1(D).main ~ Eager(G2(D)).main1 : - ={glob D} ==> ={res} /\ inv_ext1 G1.bext{1} G1.bext{2} G1.m{2} G1.mi{2} FRO.m{2}. - proof. - proc;inline{2} FRO.init G2(D, FRO).distinguish;wp. - call (_: ={F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.paths,G1.chandle,FRO.m} /\ - inv_ext1 G1.bext{1} G1.bext{2} G1.m{2} G1.mi{2} FRO.m{2} /\ - (forall h, mem (dom FRO.m) h => h < G1.chandle){1}). - + proc;if=>//;last by auto. - seq 2 2: (={F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.paths,G1.chandle,FRO.m,x,y} /\ - inv_ext1 G1.bext{1} G1.bext{2} G1.m{2} G1.mi{2} FRO.m{2} /\ - (forall h, mem (dom FRO.m) h => h < G1.chandle){1} /\ - ! mem (dom G1.m{1}) x{1}). - + by if=>//;auto;call (_: ={F.RO.m});[sim |auto]. - seq 3 5: - (={F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.paths,G1.chandle,FRO.m,hx2,x,y,hx2} /\ - t{2} = (in_dom_with FRO.m (oget G1.mh.[(x.`1, hx2)]).`2 Unknown){1} /\ - (G1.bext{1} => (G1.bext{2} \/ (mem (rng FRO.m) (x.`2, Unknown)){2} \/ - inv_ext G1.m{2} G1.mi{2} FRO.m{2})) /\ - (forall h, mem (dom FRO.m) h => h < G1.chandle){1} /\ - ! mem (dom G1.m{1}) x{1}). - + inline *;auto=> &ml&mr[#]10!-> Hi Hhand -> /=. - rewrite -dom_restr rng_restr /=;progress; 3:by smt ml=0. - + rewrite rng_set !inE rem_id 1:/#;move:H0=>[/Hi[->|[x' h][]H1 H2]|->]//. - right;right;exists x' h;rewrite getP. - by cut ->//:(h<> G1.chandle{mr});move:(Hhand h);rewrite in_dom H2 /#. - by move:H0;rewrite dom_set !inE /#. - seq 1 1: (={x,y,F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.paths,G1.chandle,FRO.m} /\ - inv_ext1 G1.bext{1} G1.bext{2} G1.m{2} G1.mi{2} FRO.m{2} /\ - forall (h : handle), mem (dom FRO.m{1}) h => h < G1.chandle{1});2:by auto. - if=>//. - + inline *;rcondt{2} 4. - + by move=> &m;auto;rewrite /in_dom_with. -(* auto=> |>. (* Bug ???? *) *) - auto;progress. - + by apply sampleto_ll. - + rewrite /inv_ext1=>/H{H}[->//|[/in_rng[h]Hh|[[x1 x2] h [Hx Hh]]]]. - + case (h = (oget G1.mh{2}.[(x{2}.`1, hx2{2})]).`2)=> [->>|Hneq]. - + by left;rewrite Hh oget_some. - by right;exists x{2} h;rewrite dom_set getP Hneq !inE. - case (h = (oget G1.mh{2}.[(x{2}.`1, hx2{2})]).`2)=> [->>|Hneq]. - + rewrite Hh /bad_ext oget_some /= <@ Hx;rewrite !inE. - by move=>[|]/(mem_image snd)->. - right;exists (x1,x2) h;rewrite !dom_set getP Hneq //=. - by move:Hx;rewrite !inE Hh=>-[]->. - by move:H6 H2;rewrite /in_dom_with dom_set !inE /#. - inline *;auto;progress;last by move:H3;rewrite dom_set !inE /#. - rewrite /inv_ext1=> /H [->//|[/in_rng[h]Hh|[x' h [Hx Hh]]]]. - + right;exists x{2} h;rewrite getP dom_set !inE /=. - by move:(H0 h);rewrite in_dom Hh /#. - right;exists x' h;rewrite getP !dom_set !inE;split. - + by move:Hx;rewrite !inE=>-[]->. - by move:(H0 h);rewrite !in_dom Hh /#. - - + proc;if=>//;last by auto. - seq 6 8: - (={F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.paths,G1.chandle,FRO.m,hx2,x,y,hx2} /\ - t{2} = (in_dom_with FRO.m (oget G1.mhi.[(x.`1, hx2)]).`2 Unknown){1} /\ - (G1.bext{1} => (G1.bext{2} \/ (mem (rng FRO.m) (x.`2, Unknown)){2} \/ - inv_ext G1.m{2} G1.mi{2} FRO.m{2})) /\ - (forall h, mem (dom FRO.m) h => h < G1.chandle){1} /\ - ! mem (dom G1.mi{1}) x{1}). - + inline *;auto=> &ml&mr[#]9!-> Hi Hhand -> /=. - rewrite -dom_restr rng_restr /=;progress; 3:by smt ml=0. - + rewrite rng_set !inE rem_id 1:/#;move:H4=>[/Hi[->|[x' h][]HH1 HH2]|->]//. - right;right;exists x' h;rewrite getP. - by cut ->//:(h<> G1.chandle{mr});move:(Hhand h);rewrite in_dom HH2 /#. - by move:H4;rewrite dom_set !inE /#. - if=>//. - + inline *;rcondt{2} 4. - + by move=> &m;auto;rewrite /in_dom_with. - auto;progress. - + by apply sampleto_ll. - + rewrite /inv_ext1=>/H{H}[->//|[/in_rng[h]Hh|[[x1 x2] h [Hx Hh]]]]. - + case (h = (oget G1.mhi{2}.[(x{2}.`1, hx2{2})]).`2)=> [->>|Hneq]. - + by left;rewrite Hh oget_some. - by right;exists x{2} h;rewrite !dom_set getP Hneq !inE. - case (h = (oget G1.mhi{2}.[(x{2}.`1, hx2{2})]).`2)=> [->>|Hneq]. - + rewrite Hh /bad_ext oget_some /= <@ Hx;rewrite !inE. - by move=>[|]/(mem_image snd)->. - right;exists (x1,x2) h;rewrite !dom_set getP Hneq //=. - by move:Hx;rewrite !inE Hh=>-[]->. - by move:H6 H2;rewrite /in_dom_with dom_set !inE /#. - inline *;auto;progress;last by move:H3;rewrite dom_set !inE /#. - rewrite /inv_ext1=> /H [->//|[/in_rng[h]Hh|[x' h [Hx Hh]]]]. - + right;exists x{2} h;rewrite getP !dom_set !inE /=. - by move:(H0 h);rewrite in_dom Hh /#. - right;exists x' h;rewrite getP !dom_set !inE;split. - + by move:Hx;rewrite !inE=>-[]->. - by move:(H0 h);rewrite !in_dom Hh /#. - - + proc; - conseq (_: ={sa,G1.mh,G1.mhi,F.RO.m, G1.chandle, FRO.m} /\ - inv_ext1 G1.bext{1} G1.bext{2} G1.m{2} G1.mi{2} FRO.m{2} /\ - forall (h0 : handle), mem (dom FRO.m{1}) h0 => h0 < G1.chandle{1})=>//. - sp 3 3;call (_: ={F.RO.m});1:by sim. - while (={sa,G1.mh,G1.mhi,F.RO.m,G1.chandle,FRO.m,i,h,sa,p} /\ - inv_ext1 G1.bext{1} G1.bext{2} G1.m{2} G1.mi{2} FRO.m{2} /\ - forall (h0 : handle), mem (dom FRO.m{1}) h0 => h0 < G1.chandle{1})=>//. - if=>//;inline *;1:by auto. - rcondt{2} 3;1:by auto=>/#. - auto=> &m1&m2 [#] 10!-> Hinv Hhand Hi _ _ /= ?->?->/=;split=>/= _;split. - + move:Hinv;rewrite /inv_ext1=> H/H{H}[->//|[x h]];rewrite inE=>-[Hmem Hh]. - by right;exists x h;rewrite !inE Hmem getP;smt w=in_dom. - + by move=>h;rewrite dom_set !inE /#. - + move:Hinv;rewrite /inv_ext1=> H/H{H}[->//|[x h]];rewrite inE=>-[Hmem Hh]. - by right;exists x h;rewrite !inE Hmem getP;smt w=in_dom. - by move=>h;rewrite dom_set !inE /#. - - (* **************** *) - inline *;auto;progress. - by move:H;rewrite dom_set dom0 !inE=>->. - qed. - -end section. - -section EXT. - - declare module D: DISTINGUISHER{C, PF, G1, G2, Perm, RO }. - - local module ReSample = { - var count:int - proc f (h:handle) = { - var c; - c <$ cdistr; - if (size G1.m <= max_size /\ size G1.mi <= max_size /\ ReSample.count < max_size) { - G1.bext <- G1.bext \/ mem (image snd (dom G1.m `|` dom G1.mi)) c; - FRO.m.[h] <- (c,Unknown); - count = count + 1 ; - } - } - - proc f1 (x:capacity,h:handle) = { - var c; - c <$ cdistr; - if (size G1.m < max_size /\ size G1.mi < max_size /\ ReSample.count < max_size) { - G1.bext <- G1.bext \/ mem (image snd (dom G1.m `|` dom G1.mi) `|` fset1 x) c; - FRO.m.[h] <- (c,Unknown); - count = count + 1; - } - } - - }. - - local module Gext = { - - proc resample () = { - Iter(ReSample).iter (elems (dom (restr Unknown FRO.m))); - } - - module C = { - - proc f(p : block list): block = { - var sa, sa'; - var h, i <- 0; - sa <- b0; - while (i < size p ) { - if (mem (dom G1.mh) (sa +^ nth witness p i, h)) { - (sa, h) <- oget G1.mh.[(sa +^ nth witness p i, h)]; - } else { - RRO.sample(G1.chandle); - sa' <@ F.RO.get(take (i+1) p); - sa <- sa +^ nth witness p i; - G1.mh.[(sa,h)] <- (sa', G1.chandle); - G1.mhi.[(sa',G1.chandle)] <- (sa, h); - (sa,h) <- (sa',G1.chandle); - G1.chandle <- G1.chandle + 1; - } - i <- i + 1; - } - sa <- F.RO.get(p); - return sa; - } - } - - module S = { - - proc f(x : state): state = { - var p, v, y, y1, y2, hy2, hx2, handles_,t; - - if (!mem (dom G1.m) x) { - if (mem (dom G1.paths) x.`2) { - (p,v) <- oget G1.paths.[x.`2]; - y1 <- F.RO.get (rcons p (v +^ x.`1)); - } else { - y1 <$ bdistr; - } - y2 <$ cdistr; - y <- (y1, y2); - (* exists x h, mem (dom G1.m) x /\ handles.[h] = Some (x.2, I) *) - - handles_ <@ RRO.restrK(); - if (!mem (rng handles_) x.`2) { - RRO.set(G1.chandle, x.`2); - G1.chandle <- G1.chandle + 1; - } - handles_ <- RRO.restrK(); - hx2 <- oget (hinvc handles_ x.`2); - t <@ RRO.in_dom((oget G1.mh.[(x.`1,hx2)]).`2, Unknown); - if (mem (dom G1.mh) (x.`1, hx2) /\ t) { - hy2 <- (oget G1.mh.[(x.`1, hx2)]).`2; - ReSample.f1(x.`2, hy2); - y2 <@ FRO.get(hy2); - y <- (y.`1, y2); - G1.m.[x] <- y; - G1.mi.[y] <- x; - } else { - hy2 <- G1.chandle; - G1.chandle <- G1.chandle + 1; - RRO.set(hy2, y.`2); - G1.m.[x] <- y; - G1.mh.[(x.`1, hx2)] <- (y.`1, hy2); - G1.mi.[y] <- x; - G1.mhi.[(y.`1, hy2)] <- (x.`1, hx2); - } - if (mem (dom G1.paths) x.`2) { - (p,v) <- oget G1.paths.[x.`2]; - G1.paths.[y.`2] <- (rcons p (v +^ x.`1), y.`1); - } - } else { - y <- oget G1.m.[x]; - } - return y; - } - - proc fi(x : state): state = { - var y, y1, y2, hx2, hy2, handles_, t; - - if (!mem (dom G1.mi) x) { - handles_ <@ RRO.restrK(); - if (!mem (rng handles_) x.`2) { - RRO.set(G1.chandle, x.`2); - G1.chandle <- G1.chandle + 1; - } - handles_ <@ RRO.restrK(); - hx2 <- oget (hinvc handles_ x.`2); - y1 <$ bdistr; - y2 <$ cdistr; - y <- (y1,y2); - t <@ RRO.in_dom((oget G1.mhi.[(x.`1,hx2)]).`2, Unknown); - if (mem (dom G1.mhi) (x.`1, hx2) /\ t) { - (y1,hy2) <- oget G1.mhi.[(x.`1, hx2)]; - ReSample.f1(x.`2,hy2); - y2 <@ FRO.get(hy2); - y <- (y.`1, y2); - - G1.mi.[x] <- y; - G1.m.[y] <- x; - } else { - hy2 <- G1.chandle; - G1.chandle <- G1.chandle + 1; - RRO.set(hy2, y.`2); - G1.mi.[x] <- y; - G1.mhi.[(x.`1, hx2)] <- (y.`1, hy2); - G1.m.[y] <- x; - G1.mh.[(y.`1, hy2)] <- (x.`1, hx2); - } - } else { - y <- oget G1.mi.[x]; - } - return y; - } - - } - - proc distinguish(): bool = { - var b; - - SLCommon.C.c <- 0; - F.RO.m <- map0; - G1.m <- map0; - G1.mi <- map0; - G1.mh <- map0; - G1.mhi <- map0; - G1.bext <- false; - ReSample.count <- 0; - FRO.m <- map0; - - (* the empty path is initially known by the adversary to lead to capacity 0^c *) - RRO.set(0,c0); - G1.paths <- map0.[c0 <- ([<:block>],b0)]; - G1.chandle <- 1; - b <@ DRestr(D,C,S).distinguish(); - resample(); - return b; - } - }. - - op inv_lt (m2 mi2:smap) c1 (Fm2:handles) count2 = - size m2 < c1 /\ size mi2 < c1 /\ - count2 + size (restr Unknown Fm2) < c1 /\ - c1 <= max_size. - - op inv_le (m2 mi2:smap) c1 (Fm2:handles) count2 = - size m2 <= c1 /\ size mi2 <= c1 /\ - count2 + size (restr Unknown Fm2) <= c1 /\ - c1 <= max_size. - - lemma fset0_eqP (s:'a fset): s = fset0 <=> forall x, !mem s x. - proof. - split=>[-> x|Hmem];1:by rewrite inE. - by apply fsetP=>x;rewrite inE Hmem. - qed. - - lemma size_set (m:('a,'b)fmap) (x:'a) (y:'b): - size (m.[x<-y]) = if mem (dom m) x then size m else size m + 1. - proof. - rewrite sizeE dom_set;case (mem (dom m) x)=> Hx. - + by rewrite fsetUC subset_fsetU_id 2:sizeE 2:// => z; rewrite ?inE. - rewrite fcardUI_indep 1:fset0_eqP=>[z|]. - + by rewrite !inE;case (z=x)=>//. - by rewrite fcard1 sizeE. - qed. - - lemma size_set_le (m:('a,'b)fmap) (x:'a) (y:'b): size (m.[x<-y]) <= size m + 1. - proof. rewrite size_set /#. qed. - - lemma size_rem (m:('a,'b)fmap) (x:'a): - size (rem x m) = if mem (dom m) x then size m - 1 else size m. - proof. - rewrite !sizeE dom_rem fcardD;case (mem (dom m) x)=> Hx. - + by rewrite subset_fsetI_id 2:fcard1// => z;rewrite !inE. - by rewrite (eq_fcards0 (_ `&` _)) 2:// fset0_eqP=>z;rewrite !inE /#. - qed. - - lemma size_rem_le (m:('a,'b)fmap) x : size (rem x m) <= size m. - proof. by rewrite size_rem /#. qed. - - lemma size_ge0 (m:('a,'b)fmap) : 0 <= size m. - proof. rewrite sizeE fcard_ge0. qed. - - lemma size0 : size map0<:'a,'b> = 0. - proof. by rewrite sizeE dom0 fcards0. qed. - - local equiv RROset_inv_lt : RRO.set ~ RRO.set : - ={x,y,FRO.m} /\ inv_lt G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2} ==> - ={res,FRO.m} /\ inv_lt G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2}. - proof. - proc;auto=> &ml&mr[#]3!-> /= @/inv_lt [*]. - rewrite restr_set /=;smt w=(size_set_le size_rem_le). - qed. - - local equiv EG2_Gext : Eager(G2(DRestr(D))).main2 ~ Gext.distinguish: - ={glob D} ==> - ReSample.count{2} <= max_size /\ - ((G1.bext{1} \/ inv_ext G1.m{1} G1.mi{1} FRO.m{1}) => G1.bext{2}). - proof. - proc;inline *;wp. - while (={l,FRO.m,G1.m,G1.mi} /\ size G1.m{2} <= max_size /\ - size G1.mi{2} <= max_size /\ - ReSample.count{2} + size l{2} <= max_size /\ - ((G1.bext{1} \/ - exists (x : state) (h : handle), - mem (dom G1.m{1} `|` dom G1.mi{1}) x /\ - FRO.m{1}.[h] = Some (x.`2, Unknown) /\ !mem l{1} h) => - G1.bext{2})). - + rcondt{2} 3. - + move=> &m;auto=> &m'[#] 6!-> /= + _ _;case (l{m'})=>//=; smt w=List.size_ge0. - auto=> &ml&mr[#]6!->;case(l{mr})=>[//|h1 l1/=Hle Hext c->/=];split. - + smt w=(drop0 size_ge0). - rewrite drop0=>-[H|[x h][#]];1:by rewrite Hext // H. - rewrite getP;case (h=h1)=> [/=->Hin->_ | Hneq ???]. - + by right;apply (mem_image snd _ x). - by rewrite Hext 2://;right;exists x h;rewrite Hneq. - wp; call (_: ={F.RO.m,FRO.m,G1.paths,G1.mh,G1.mhi,G1.m,G1.mi,G1.chandle,G1.bext, C.c} /\ - inv_le G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2}). - + proc;sp;if=> //. - call (_: ={x,F.RO.m,FRO.m,G1.paths,G1.mh,G1.mhi,G1.m,G1.mi,G1.chandle,G1.bext,C.c} /\ - inv_lt G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2} ==> - ={res,F.RO.m,FRO.m,G1.paths,G1.mh,G1.mhi,G1.m,G1.mi,G1.chandle,G1.bext,C.c} /\ - inv_le G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2});last by auto=> /#. - proc;if=>//;last by auto=>/#. - seq 8 9 : (={x, y, F.RO.m, FRO.m, G1.paths, G1.mh, G1.mhi, G1.m, G1.mi, G1.chandle, - G1.bext, C.c} /\ - inv_le G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2});2:by auto. - seq 2 3 : - (={y,x,F.RO.m,FRO.m,G1.paths,G1.mh,G1.mhi,G1.m,G1.mi,G1.chandle,G1.bext, C.c} /\ - inv_lt G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2}). - + by if=>//;auto;call (_: ={F.RO.m});auto. - seq 5 5 : - (={t,y,x,hx2,F.RO.m,FRO.m,G1.paths,G1.mh,G1.mhi,G1.m,G1.mi,G1.chandle,G1.bext, C.c} /\ - inv_lt G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2} /\ - (t => in_dom_with FRO.m (oget G1.mh.[(x.`1, hx2)]).`2 Unknown){1}). - + inline RRO.in_dom; wp;call (_: ={FRO.m});1:by sim. - inline RRO.restrK;sp 1 1;if=>//. - by wp;call RROset_inv_lt;auto. - if=>//;wp. - + inline *;rcondt{1} 4;1:by auto=>/#. - rcondt{2} 5;1:by auto;smt w=(sizeE size_ge0). - rcondt{2} 10. by auto;progress;rewrite dom_set !inE. - wp;rnd{2};auto=> /= ??[#]!-> @/inv_lt @/inv_le [#] mlt milt clt cle Hin 3?->/=. - rewrite/Distr.is_lossless (sampleto_ll 0)/= => ? _;rewrite /bad_ext !getP /= !oget_some /= set_set_eq /=. - rewrite !(imageU,inE) restr_set /= size_rem dom_restr Hin //=; smt w=size_set_le. - by call RROset_inv_lt;auto;smt w=size_set_le. - - + proc;sp;if=> //. - call (_: ={x,F.RO.m,FRO.m,G1.paths,G1.mh,G1.mhi,G1.m,G1.mi,G1.chandle,G1.bext,C.c} /\ - inv_lt G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2} ==> - ={res,F.RO.m,FRO.m,G1.paths,G1.mh,G1.mhi,G1.m,G1.mi,G1.chandle,G1.bext,C.c} /\ - inv_le G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2});last by auto=> /#. - proc;if=>//;last by auto=>/#. - seq 8 8 : - (={t,y,x,hx2,F.RO.m,FRO.m,G1.paths,G1.mh,G1.mhi,G1.m,G1.mi,G1.chandle,G1.bext, C.c} /\ - inv_lt G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2} /\ - (t => in_dom_with FRO.m (oget G1.mhi.[(x.`1, hx2)]).`2 Unknown){1}). - + inline RRO.in_dom; auto;call (_: ={FRO.m});1:by sim. - inline RRO.restrK;sp 1 1;if=>//. - by wp;call RROset_inv_lt;auto. - if=>//;wp. - + inline *;rcondt{1} 4;1:by auto=>/#. - rcondt{2} 5;1:by auto;smt w=(sizeE size_ge0). - rcondt{2} 10. by auto;progress;rewrite dom_set !inE. - wp;rnd{2};auto=> /= ??[#]!-> @/inv_lt @/inv_le [#] mlt milt clt cle Hin 3?->/=. - rewrite/Distr.is_lossless (sampleto_ll 0) /= => ? _;rewrite /bad_ext !getP /= !oget_some /= set_set_eq /=. - rewrite !(imageU,inE) restr_set /= size_rem dom_restr Hin //=; smt w=size_set_le. - by call RROset_inv_lt;auto;smt w=size_set_le. - - + proc;sp 1 1;if=>//. - inline G2(DRestr(D), RRO).C.f Gext.C.f. - sp 5 5;elim *=> c0L c0R. - wp;call (_: ={F.RO.m});1:by sim. - while (={i,p,G1.mh,sa,h,FRO.m,F.RO.m,G1.mh,G1.mhi,G1.chandle} /\ 0 <= i{1} <= size p{1}/\ - c0R + size p{1} <= max_size /\ - inv_le G1.m{2} G1.mi{2} (c0R + i){2} FRO.m{2} ReSample.count{2}); - last by auto;smt w=List.size_ge0. - if=> //;1:by auto=>/#. - auto;call (_: ={F.RO.m});1:by sim. - inline *;auto=> ?&mr [#]!->@/inv_le Hi [#]. - case (p{mr})=> [/#|/=p1 p2] 4?_ /= 2?-> /=;split=>/= Hmem 4? [#]2->/= => [|/#]. - by rewrite restr_set /= size_set dom_restr /in_dom_with Hmem/= /#. - - auto;progress[delta];rewrite ?(size0,restr0,restr_set,rem0,max_ge0,-sizeE,-cardE) //=. - + smt ml=0. + smt ml=0. + smt ml=0. - + elim H7=>// [[x h] [#]];rewrite -memE dom_restr /in_dom_with in_dom=> _ ->/=. - by rewrite oget_some. - apply H10=>//. - qed. - - local lemma Pr_ext &m: - Pr[Gext.distinguish()@&m : G1.bext /\ ReSample.count <= max_size] <= - max_size%r * ((2*max_size)%r / (2^c)%r). - proof. - fel 8 ReSample.count (fun x=> (2*max_size)%r / (2^c)%r) - max_size G1.bext - [ReSample.f : - (size G1.m <= max_size /\ size G1.mi <= max_size /\ ReSample.count < max_size); - ReSample.f1 : - (size G1.m < max_size /\ size G1.mi < max_size /\ ReSample.count < max_size) - ]=> //; 2:by auto. - + rewrite /felsum Bigreal.sumr_const count_predT size_range. - apply ler_wpmul2r;1:by apply eps_ge0. - by rewrite le_fromint;smt ml=0 w=max_ge0. - + proc;rcondt 2;1:by auto. - wp; rnd (mem (image snd (dom G1.m `|` dom G1.mi ))); skip=> /> &hr ? ? -> /= ? ?. - rewrite (Mu_mem.mu_mem - (image snd (dom G1.m{hr} `|` dom G1.mi{hr})) - cdistr (1%r/(2^c)%r))//. print DCapacity. - + by move=>x _;rewrite DCapacity.dunifin1E capacity_card. - rewrite ler_wpmul2r;1:by apply divr_ge0=>//;apply /c_ge0r. - rewrite imageU fcardU le_fromint. - move:(fcard_image_leq snd (dom G1.m{hr}))(fcard_image_leq snd (dom G1.mi{hr})). - by rewrite -!sizeE;smt w=fcard_ge0. - + rewrite/#. - + by move=>c1;proc;auto=> &hr [^H 2->]/#. - + by move=> b1 c1;proc;auto=> /#. - + proc;rcondt 2;1:by auto. - wp;rnd (mem (image snd (dom G1.m `|` dom G1.mi) `|` fset1 x));skip=> /> &hr ??-> /= ??. - rewrite (Mu_mem.mu_mem (image snd (dom G1.m{hr}`|`dom G1.mi{hr}) `|` fset1 x{hr}) cdistr (1%r/(2^c)%r))//. - + by move=>x _;rewrite DCapacity.dunifin1E capacity_card. - rewrite ler_wpmul2r;1:by apply divr_ge0=>//;apply /c_ge0r. - rewrite imageU !fcardU le_fromint fcard1. - move:(fcard_image_leq snd (dom G1.m{hr}))(fcard_image_leq snd (dom G1.mi{hr})). - by rewrite -!sizeE;smt w=fcard_ge0. - + rewrite/#. - + by move=>c1;proc;auto=> &hr [^H 2->]/#. - move=> b1 c1;proc;auto=> /#. - qed. - - axiom D_ll: - forall (F <: DFUNCTIONALITY{D}) (P <: DPRIMITIVE{D}), - islossless P.f => islossless P.fi => islossless F.f => islossless D(F, P).distinguish. - - lemma Real_G2 &m: - Pr[GReal(D).main() @ &m: res /\ C.c <= max_size] <= - Pr[Eager(G2(DRestr(D))).main2() @ &m: res] + - (max_size ^ 2)%r * mu dstate (pred1 witness) + - max_size%r * ((2*max_size)%r / (2^c)%r) + - max_size%r * ((2*max_size)%r / (2^c)%r). - proof. - apply (ler_trans _ _ _ (Real_G1 D D_ll &m)). - do !apply ler_add => //. - + cut ->: Pr[G1(DRestr(D)).main() @ &m : res] = Pr[Eager(G2(DRestr(D))).main1() @ &m : res]. - + by byequiv (G1_G2 (DRestr(D))). - by apply lerr_eq;byequiv (Eager_1_2 (G2(DRestr(D)))). - + by apply (Pr_G1col D D_ll &m). - apply (ler_trans Pr[Eager(G2(DRestr(D))).main1()@&m: G1.bext \/ inv_ext G1.m G1.mi FRO.m]). - + by byequiv (G1_G2 (DRestr(D)))=>//#. - apply (ler_trans Pr[Eager(G2(DRestr(D))).main2()@&m : G1.bext \/ inv_ext G1.m G1.mi FRO.m]). - + by apply lerr_eq;byequiv (Eager_1_2 (G2(DRestr(D)))). - apply (ler_trans _ _ _ _ (Pr_ext &m)). - byequiv EG2_Gext=>//#. - qed. - -end section EXT. - - - diff --git a/proof/core/Handle.eca b/proof/core/Handle.eca deleted file mode 100644 index a0c147d..0000000 --- a/proof/core/Handle.eca +++ /dev/null @@ -1,1865 +0,0 @@ -pragma -oldip. pragma +implicits. -require import Core Int Real StdOrder Ring IntExtra. -require import List FSet NewFMap Utils Common SLCommon RndO. -require import DProd Dexcepted. -(*...*) import Capacity IntOrder DCapacity. - -require ConcreteF. - -clone import GenEager as ROhandle with - type from <- handle, - type to <- capacity, - op sampleto <- fun (_:int) => cdistr - proof sampleto_ll by apply DCapacity.dunifin_ll. - -module G1(D:DISTINGUISHER) = { - var m, mi : smap - var mh, mhi : hsmap - var chandle : int - var paths : (capacity, block list * block) fmap - var bext, bcol : bool - - module C = { - - proc f(p : block list): block = { - var sa, sa', sc; - var h, i <- 0; - sa <- b0; - while (i < size p ) { - if (mem (dom mh) (sa +^ nth witness p i, h)) { - (sa, h) <- oget mh.[(sa +^ nth witness p i, h)]; - } else { - sc <$ cdistr; - bcol <- bcol \/ hinv FRO.m sc <> None; - sa' <@ F.RO.get(take (i+1) p); - sa <- sa +^ nth witness p i; - mh.[(sa,h)] <- (sa', chandle); - mhi.[(sa',chandle)] <- (sa, h); - (sa,h) <- (sa',chandle); - FRO.m.[chandle] <- (sc,Unknown); - chandle <- chandle + 1; - } - i <- i + 1; - } - sa <- F.RO.get(p); - return sa; - } - } - - module S = { - - proc f(x : state): state = { - var p, v, y, y1, y2, hy2, hx2; - - if (!mem (dom m) x) { - if (mem (dom paths) x.`2) { - (p,v) <- oget paths.[x.`2]; - y1 <- F.RO.get (rcons p (v +^ x.`1)); - y2 <$ cdistr; - } else { - y1 <$ bdistr; - y2 <$ cdistr; - } - y <- (y1, y2); - bext <- bext \/ mem (rng FRO.m) (x.`2, Unknown); - if (!(mem (rng FRO.m) (x.`2, Known))) { - FRO.m.[chandle] <- (x.`2, Known); - chandle <- chandle + 1; - } - hx2 <- oget (hinvK FRO.m x.`2); - if (mem (dom mh) (x.`1, hx2) /\ in_dom_with FRO.m (oget mh.[(x.`1,hx2)]).`2 Unknown) { - hy2 <- (oget mh.[(x.`1, hx2)]).`2; - y <- (y.`1, (oget FRO.m.[hy2]).`1); - FRO.m.[hy2] <- (y.`2, Known); - m.[x] <- y; - mi.[y] <- x; - } else { - bcol <- bcol \/ hinv FRO.m y.`2 <> None; - hy2 <- chandle; - chandle <- chandle + 1; - FRO.m.[hy2] <- (y.`2, Known); - m.[x] <- y; - mh.[(x.`1, hx2)] <- (y.`1, hy2); - mi.[y] <- x; - mhi.[(y.`1, hy2)] <- (x.`1, hx2); - } - if (mem (dom paths) x.`2) { - (p,v) <- oget paths.[x.`2]; - paths.[y.`2] <- (rcons p (v +^ x.`1), y.`1); - } - } else { - y <- oget m.[x]; - } - return y; - } - - proc fi(x : state): state = { - var y, y1, y2, hx2, hy2; - - if (!mem (dom mi) x) { - bext <- bext \/ mem (rng FRO.m) (x.`2, Unknown); - if (!(mem (rng FRO.m) (x.`2, Known))) { - FRO.m.[chandle] <- (x.`2, Known); - chandle <- chandle + 1; - } - hx2 <- oget (hinvK FRO.m x.`2); - y1 <$ bdistr; - y2 <$ cdistr; - y <- (y1,y2); - if (mem (dom mhi) (x.`1,hx2) /\ - in_dom_with FRO.m (oget mhi.[(x.`1,hx2)]).`2 Unknown) { - (y1,hy2) <- oget mhi.[(x.`1, hx2)]; - y <- (y.`1, (oget FRO.m.[hy2]).`1); - FRO.m.[hy2] <- (y.`2, Known); - mi.[x] <- y; - m.[y] <- x; - } else { - bcol <- bcol \/ hinv FRO.m y.`2 <> None; - hy2 <- chandle; - chandle <- chandle + 1; - FRO.m.[hy2] <- (y.`2, Known); - mi.[x] <- y; - mhi.[(x.`1, hx2)] <- (y.`1, hy2); - m.[y] <- x; - mh.[(y.`1, hy2)] <- (x.`1, hx2); - } - } else { - y <- oget mi.[x]; - } - return y; - } - - } - - proc main(): bool = { - var b; - - F.RO.m <- map0; - m <- map0; - mi <- map0; - mh <- map0; - mhi <- map0; - bext <- false; - bcol <- false; - - (* the empty path is initially known by the adversary to lead to capacity 0^c *) - FRO.m <- map0.[0 <- (c0, Known)]; - paths <- map0.[c0 <- ([<:block>],b0)]; - chandle <- 1; - b <@ D(C,S).distinguish(); - return b; - } -}. - -(* -------------------------------------------------------------------------- *) -(** The state of CF contains only the map PF.m. - The state of G1 contains: - - the map hs that associates handles to flagged capacities; - - the map G1.m that represents the *public* view of map PF.m; - - the map G1.mh that represents PF.m with handle-based indirection; - - the map ro that represents the functionality; - - the map pi that returns *the* known path to a capacity if it exists. - The following invariants encode these facts, and some auxiliary - knowledge that can most likely be deduced but is useful in the proof. **) - -(** RELATIONAL: Map, Handle-Map and Handles are compatible **) -inductive m_mh (hs : handles) (m : smap) (mh : hsmap) = - | INV_m_mh of (forall xa xc ya yc, - m.[(xa,xc)] = Some (ya,yc) => - exists hx fx hy fy, - hs.[hx] = Some (xc,fx) - /\ hs.[hy] = Some (yc,fy) - /\ mh.[(xa,hx)] = Some (ya,hy)) - & (forall xa hx ya hy, - mh.[(xa,hx)] = Some (ya,hy) => - exists xc fx yc fy, - hs.[hx] = Some (xc,fx) - /\ hs.[hy] = Some (yc,fy) - /\ m.[(xa,xc)] = Some (ya,yc)). - -(* WELL-FORMEDNESS<2>: Handles, Map, Handle-Map and RO are compatible *) -inductive mh_spec (hs : handles) (Gm : smap) (mh : hsmap) (ro : (block list,block) fmap) = - | INV_mh of (forall xa hx ya hy, - mh.[(xa,hx)] = Some (ya,hy) => - exists xc fx yc fy, - hs.[hx] = Some (xc,fx) - /\ hs.[hy] = Some (yc,fy) - /\ if fy = Known - then Gm.[(xa,xc)] = Some (ya,yc) - /\ fx = Known - else exists p v, - ro.[rcons p (v +^ xa)] = Some ya - /\ build_hpath mh p = Some (v,hx)) - & (forall p bn b, - ro.[rcons p bn] = Some b <=> - exists v hx hy, - build_hpath mh p = Some (v,hx) - /\ mh.[(v +^ bn,hx)] = Some (b,hy)) - & (forall p v p' v' hx, - build_hpath mh p = Some (v,hx) - => build_hpath mh p' = Some (v',hx) - => p = p' /\ v = v'). - -(* WELL-FORMEDNESS<2>: Handles, Handle-Map and Paths are compatible *) -inductive pi_spec (hs : handles) (mh : hsmap) (pi : (capacity,block list * block) fmap) = - | INV_pi of (forall c p v, - pi.[c] = Some (p,v) <=> - exists h, - build_hpath mh p = Some(v,h) - /\ hs.[h] = Some (c,Known)). - -(* WELL-FORMEDNESS<2>: Handles are well-formed *) -inductive hs_spec hs ch = - | INV_hs of (huniq hs) - & (hs.[0] = Some (c0,Known)) - & (forall cf h, hs.[h] = Some cf => h < ch). - -(* Useless stuff *) -inductive inv_spec (m:('a,'b) fmap) mi = - | INV_inv of (forall x y, m.[x] = Some y <=> mi.[y] = Some x). - -(* Invariant: maybe we should split relational and non-relational parts? *) -inductive INV_CF_G1 (hs : handles) ch (Pm Pmi Gm Gmi : smap) - (mh mhi : hsmap) (ro : (block list,block) fmap) pi = - | HCF_G1 of (hs_spec hs ch) - & (inv_spec Gm Gmi) - & (inv_spec mh mhi) - & (m_mh hs Pm mh) - & (m_mh hs Pmi mhi) - & (incl Gm Pm) - & (incl Gmi Pmi) - & (mh_spec hs Gm mh ro) - & (pi_spec hs mh pi). - -(** Structural Projections **) -lemma m_mh_of_INV (ch : handle) - (mi1 m2 mi2 : smap) (mhi2 : hsmap) - (ro : (block list, block) fmap) - (pi : (capacity, block list * block) fmap) - hs m1 mh2: - INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi => - m_mh hs m1 mh2. -proof. by case. qed. - -lemma mi_mhi_of_INV (ch : handle) - (m1 m2 mi2 : smap) (mh2 : hsmap) - (ro : (block list, block) fmap) - (pi : (capacity, block list * block) fmap) - hs mi1 mhi2: - INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi => - m_mh hs mi1 mhi2. -proof. by case. qed. - -lemma incl_of_INV (hs : handles) (ch : handle) - (mi1 mi2 : smap) (mh2 mhi2: hsmap) - (ro : (block list, block) fmap) - (pi : (capacity, block list * block) fmap) - m1 m2: - INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi => - incl m2 m1. -proof. by case. qed. - -lemma incli_of_INV (hs : handles) (ch : handle) - (m1 m2 : smap) (mh2 mhi2: hsmap) - (ro : (block list, block) fmap) - (pi : (capacity, block list * block) fmap) - mi1 mi2: - INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi => - incl mi2 mi1. -proof. by case. qed. - -lemma mh_of_INV (ch : handle) - (m1 mi1 mi2 : smap) (mhi2 : hsmap) - (pi : (capacity, block list * block) fmap) - hs m2 mh2 ro: - INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi => - mh_spec hs m2 mh2 ro. -proof. by case. qed. - -lemma pi_of_INV (ch : handle) - (m1 m2 mi1 mi2: smap) (mhi2: hsmap) - (ro : (block list, block) fmap) - hs mh2 pi: - INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi => - pi_spec hs mh2 pi. -proof. by case. qed. - -lemma hs_of_INV (m1 m2 mi1 mi2 : smap) (mh2 mhi2 : hsmap) - (ro : (block list, block) fmap) - (pi : (capacity, block list * block) fmap) - hs ch: - INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi => - hs_spec hs ch. -proof. by case. qed. - -lemma inv_of_INV hs ch m1 mi1 m2 mi2 ro pi - mh2 mhi2: - INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi => - inv_spec mh2 mhi2. -proof. by case. qed. - -lemma invG_of_INV hs ch m1 mi1 mh2 mhi2 ro pi m2 mi2: - INV_CF_G1 hs ch m1 mi1 m2 mi2 mh2 mhi2 ro pi => - inv_spec m2 mi2. -proof. by case. qed. - -(** Useful Lemmas **) -lemma ch_gt0 hs ch : hs_spec hs ch => 0 < ch. -proof. by case=> _ + Hlt -/Hlt. qed. - -lemma ch_neq0 hs ch : hs_spec hs ch => 0 <> ch. -proof. by move=> /ch_gt0/ltr_eqF. qed. - -lemma ch_notin_dom_hs hs ch: hs_spec hs ch => hs.[ch] = None. -proof. -by move=> [] _ _ dom_hs; case: {-1}(hs.[ch]) (eq_refl hs.[ch])=> [//|cf/dom_hs]. -qed. - -lemma Sch_notin_dom_hs hs ch: hs_spec hs ch => hs.[ch + 1] = None. -proof. -by move=> [] _ _ dom_hs; case: {-1}(hs.[ch + 1]) (eq_refl hs.[ch + 1])=> [//|cg/dom_hs/#]. -qed. - -lemma ch_notin_dom2_mh hs m mh xa ch: - m_mh hs m mh - => hs_spec hs ch - => mh.[(xa,ch)] = None. -proof. -move=> [] Hm_mh Hmh_m [] _ _ dom_hs. -case: {-1}(mh.[(xa,ch)]) (eq_refl mh.[(xa,ch)])=> [//=|[ya hy] /Hmh_m]. -by move=> [xc0 fx0 yc fy] [#] /dom_hs. -qed. - -lemma Sch_notin_dom2_mh hs m mh xa ch: - m_mh hs m mh - => hs_spec hs ch - => mh.[(xa,ch + 1)] = None. -proof. -move=> [] Hm_mh Hmh_m [] _ _ dom_hs. -case: {-1}(mh.[(xa,ch + 1)]) (eq_refl mh.[(xa,ch + 1)])=> [//=|[ya hy] /Hmh_m]. -by move=> [xc0 fx0 yc fy] [#] /dom_hs /#. -qed. - -lemma dom_hs_neq_ch hs ch hx xc fx: - hs_spec hs ch - => hs.[hx] = Some (xc,fx) - => hx <> ch. -proof. by move=> [] _ _ dom_hs /dom_hs /#. qed. - -lemma dom_hs_neq_Sch hs ch hx xc fx: - hs_spec hs ch - => hs.[hx] = Some(xc,fx) - => hx <> ch + 1. -proof. by move=> [] _ _ dom_hs /dom_hs /#. qed. - -lemma notin_m_notin_mh hs m mh xa xc hx fx: - m_mh hs m mh - => m.[(xa,xc)] = None - => hs.[hx] = Some (xc,fx) - => mh.[(xa,hx)] = None. -proof. -move=> [] _ Hmh_m m_xaxc hs_hx; case: {-1}(mh.[(xa,hx)]) (eq_refl mh.[(xa,hx)])=> [//|]. -by move=> [ya hy] /Hmh_m [xc0 fx0 yc0 fy0] [#]; rewrite hs_hx=> [#] <*>; rewrite m_xaxc. -qed. - -lemma notin_m_notin_Gm (m Gm : ('a,'b) fmap) x: - incl Gm m - => m.[x] = None - => Gm.[x] = None. -proof. by move=> Gm_leq_m; apply/contraLR=> ^ /Gm_leq_m ->. qed. - -lemma notin_hs_notin_dom2_mh hs m mh xa hx: - m_mh hs m mh - => hs.[hx] = None - => mh.[(xa,hx)] = None. -proof. -move=> [] _ Hmh_m hs_hx; case: {-1}(mh.[(xa,hx)]) (eq_refl mh.[(xa,hx)])=> [//|]. -by move=> [ya hy] /Hmh_m [xc fx yc fy] [#]; rewrite hs_hx. -qed. - -(** Preservation of m_mh **) -lemma m_mh_addh hs ch m mh xc fx: - hs_spec hs ch - => m_mh hs m mh - => m_mh hs.[ch <- (xc, fx)] m mh. -proof. -move=> ^Hhs [] Hhuniq hs_0 dom_hs [] Hm_mh Hmh_m; split. -+ move=> xa0 xc0 ya yc /Hm_mh [hx0 fx0 hy fy] [#] hs_hx0 hs_hy mh_xaxc0. - exists hx0 fx0 hy fy; rewrite !getP mh_xaxc0 hs_hx0 hs_hy /=. - move: hs_hx0=> /dom_hs/ltr_eqF -> /=. - by move: hs_hy=> /dom_hs/ltr_eqF -> /=. -move=> xa hx ya hy /Hmh_m [xc0 fx0 yc fy] [#] hs_hx hs_hy m_xaxc0. -exists xc0 fx0 yc fy; rewrite !getP m_xaxc0 hs_hx hs_hy. -move: hs_hx=> /dom_hs/ltr_eqF -> /=. -by move: hs_hy=> /dom_hs/ltr_eqF -> /=. -qed. - -lemma m_mh_updh fy0 hs m mh yc hy fy: - m_mh hs m mh - => hs.[hy] = Some (yc,fy0) - => m_mh hs.[hy <- (yc,fy)] m mh. -proof. -move=> Im_mh hs_hy; split. -+ move=> xa' xc' ya' yc'; have [] H _ /H {H}:= Im_mh. - move=> [hx' fx' hy' fy'] [#] hs_hx' hs_hy' mh_xahx'. - case: (hx' = hy); case: (hy' = hy)=> //= <*> => [|Hhy'|Hhx'|Hhx' Hhy']. - + by exists hy fy hy fy; rewrite !getP /= /#. - + by exists hy fy hy' fy'; rewrite !getP Hhy' /#. - + by exists hx' fx' hy fy; rewrite !getP Hhx' /#. - by exists hx' fx' hy' fy'; rewrite !getP Hhx' Hhy'. -move=> xa' hx' ya' hy'; have [] _ H /H {H}:= Im_mh. -move=> [xc' fx' yc' fy'] [#] hs_hx' hs_hy' m_xaxc'. -case: (hx' = hy); case: (hy' = hy)=> //= <*> => [|Hhy'|Hhx'|Hhx' Hhy']. -+ by exists yc fy yc fy; rewrite !getP /= /#. -+ by exists yc fy yc' fy'; rewrite !getP Hhy' /#. -+ by exists xc' fx' yc fy; rewrite !getP Hhx' /#. -by exists xc' fx' yc' fy'; rewrite !getP Hhx' Hhy'. -qed. - -lemma m_mh_addh_addm hs Pm mh hx xa xc hy ya yc f f': - m_mh hs Pm mh => - huniq hs => - hs.[hx] = Some (xc, f) => - hs.[hy] = None => - m_mh hs.[hy <- (yc,f')] Pm.[(xa,xc) <- (ya,yc)] mh.[(xa,hx) <- (ya,hy)]. -proof. -move=> [] Hm_mh Hmh_m Hhuniq hs_hx hs_hy. -split=> [xa0 xc0 ya0 yc0|xa0 hx0 ya0 hy0]; rewrite getP. -+ case: ((xa0,xc0) = (xa,xc))=> [[#] <<*> [#] <<*>|] /=. - + by exists hx f hy f'; rewrite !getP /= /#. - move=> xaxc0_neq_xaxc /Hm_mh [hx0 fx0 hy0 fy0] [#] hs_hx0 hs_hy0 mh_xahx0. - by exists hx0 fx0 hy0 fy0; rewrite !getP /#. -case: ((xa0,hx0) = (xa,hx))=> [[#] <*>> [#] <<*>|] /=. -+ by exists xc f yc f'; rewrite !getP /= /#. -rewrite andaE=> /negb_and xahx0_neq_xahx /Hmh_m [xc0 fx0 yc0 fy0] [#] hs_hx0 hs_hy0 Pm_xaxc0. -exists xc0 fx0 yc0 fy0; rewrite !getP; do !split=> [/#|/#|/=]. -move: xahx0_neq_xahx; case: (xa0 = xa)=> [/= <*>>|//=]; case: (xc0 = xc)=> [<*>>|//=]. -by move: hs_hx=> /(Hhuniq _ _ _ _ hs_hx0). -qed. - -lemma mi_mhi_addh_addmi (hs : handles) mi mhi hx xa xc hy ya yc fx fy: - m_mh hs mi mhi => - (forall f h, hs.[h] <> Some (yc,f)) => - hs.[hx] = Some (xc,fx) => - hs.[hy] = None => - m_mh hs.[hy <- (yc,fy)] mi.[(ya,yc) <- (xa,xc)] mhi.[(ya,hy) <- (xa,hx)]. -proof. -move=> [] Hm_mh Hmh_m yc_notin_rng1_hs hs_hx hs_hy; split. -+ move=> ya0 yc0 xa0 xc0; rewrite getP; case: ((ya0,yc0) = (ya,yc))=> [[#] <*>> [#] <*>>|]. - + by exists hy fy hx fx; rewrite !getP /= /#. - move=> yayc0_neq_yayc /Hm_mh [hy0 fy0 hx0 fx0] [#] hs_hy0 hs_hx0 mhi_yayc0. - by exists hy0 fy0 hx0 fx0; rewrite !getP /#. -move=> ya0 hy0 xa0 hx0; rewrite getP; case: ((ya0,hy0) = (ya,hy))=> [[#] <*>> [#] <<*>|]. -+ by exists yc fy xc fx; rewrite !getP //= /#. -rewrite /= andaE=> /negb_and yahy0_neq_yahy /Hmh_m [yc0 fy0 xc0 fx0] [#] hs_hy0 hs_hx0 mi_yayc0. -exists yc0 fy0 xc0 fx0; rewrite !getP; do !split=> [/#|/#|]. -move: yahy0_neq_yahy; case: (ya0 = ya)=> [<<*> //=|/#]; case: (yc0 = yc)=> [<*>> /=|//=]. -by move: hs_hy0; rewrite yc_notin_rng1_hs. -qed. - -(** Inversion **) -lemma inv_mh_inv_Pm hs Pm Pmi mh mhi: - m_mh hs Pm mh - => m_mh hs Pmi mhi - => inv_spec mh mhi - => inv_spec Pm Pmi. -proof. -move=> Hm_mh Hmi_mhi [] Hinv; split=>- [xa xc] [ya yc]; split. -+ have [] H _ /H {H} [hx fx hy fy] [#] hs_hx hs_hy /Hinv := Hm_mh. - have [] _ H /H {H} [? ? ? ?] [#] := Hmi_mhi. - by rewrite hs_hx hs_hy=> /= [#] <<*> [#] <<*>. -have [] H _ /H {H} [hy fy hx fx] [#] hs_hy hs_hx /Hinv := Hmi_mhi. -have [] _ H /H {H} [? ? ? ?] [#] := Hm_mh. -by rewrite hs_hx hs_hy=> /= [#] <<*> [#] <<*>. -qed. - -lemma inv_incl_none Pm Pmi Gm (x : 'a) Gmi (y : 'b): - inv_spec Pm Pmi - => inv_spec Gm Gmi - => incl Gm Pm - => incl Gmi Pmi - => Pm.[x] = Some y - => (Gm.[x] = None <=> Gmi.[y] = None). -proof. -move=> [] invP [] invG Gm_leq_Pm Gmi_leq_Pmi ^P_x; rewrite invP=> Pi_y. -split=> [G_x | Gi_y]. -+ case: {-1}(Gmi.[y]) (eq_refl Gmi.[y])=> [//|x']. - move=> ^Gmi_y; rewrite -Gmi_leq_Pmi 1:Gmi_y// Pi_y /= -negP=> <<*>. - by move: Gmi_y; rewrite -invG G_x. -case: {-1}(Gm.[x]) (eq_refl Gm.[x])=> [//|y']. -move=> ^Gm_y; rewrite -Gm_leq_Pm 1:Gm_y// P_x /= -negP=> <<*>. -by move: Gm_y; rewrite invG Gi_y. -qed. - -(** Preservation of hs_spec **) -lemma huniq_addh hs h c f: - huniq hs - => (forall f' h', hs.[h'] <> Some (c,f')) - => huniq hs.[h <- (c,f)]. -proof. -move=> Hhuniq c_notin_rng1_hs h1 h2 [c1 f1] [c2 f2]; rewrite !getP. -case: (h1 = h); case: (h2 = h)=> //= [Hh2 + [#]|+ Hh1 + [#]|_ _] - <*>. -+ by rewrite c_notin_rng1_hs. -+ by rewrite c_notin_rng1_hs. -exact/Hhuniq. -qed. - -lemma hs_addh hs ch xc fx: - hs_spec hs ch - => (forall f h, hs.[h] <> Some (xc,f)) - => hs_spec hs.[ch <- (xc,fx)] (ch + 1). -proof. -move=> ^Hhs [] Hhuniq hs_0 dom_hs xc_notin_rng1_hs; split. -+ move=> h1 h2 [c1 f1] [c2 f2]; rewrite !getP /=. - case: (h1 = ch); case: (h2 = ch)=> //= [+ + [#]|+ + + [#]|]=> <*>; - first 2 by rewrite xc_notin_rng1_hs. - by move=> _ _ hs_h1 /(Hhuniq _ _ _ _ hs_h1). -+ by rewrite getP (ch_neq0 _ Hhs). -+ move=> [c f] h; rewrite !getP; case: (h = ch)=> [<*> /#|_]. -by move=> /dom_hs /#. -qed. - -lemma hs_updh hs ch fx hx xc fx': - hs_spec hs ch - => 0 <> hx - => hs.[hx] = Some (xc,fx) - => hs_spec hs.[hx <- (xc,fx')] ch. -proof. -move=> ^Hhs [] Hhuniq hs_0 dom_hs hx_neq0 hs_hx; split. -+ by move=> h1 h2 [c1 f1] [c2 f2]; rewrite !getP /= /#. -+ by rewrite getP hx_neq0. -move=> cf h; rewrite getP; case: (h = hx)=> [<*> _|_ /dom_hs //]. -by move: hs_hx=> /dom_hs. -qed. - -(** Preservation of mh_spec **) -lemma mh_addh hs ch Gm mh ro xc fx: - hs_spec hs ch - => mh_spec hs Gm mh ro - => mh_spec hs.[ch <- (xc,fx)] Gm mh ro. -proof. -move=> [] _ _ dom_hs [] Hmh ? ?; split=> //. -move=> xa hx ya hy /Hmh [xc0 fx0 yc0 fy0] [#] hs_hx hs_hy Hite. -exists xc0 fx0 yc0 fy0; rewrite !getP Hite hs_hx hs_hy /=. -rewrite ltr_eqF /=; 1:by apply/(dom_hs _ hs_hx). -by rewrite ltr_eqF /=; 1:by apply/(dom_hs _ hs_hy). -qed. - -(** Preservation of inv_spec **) -lemma inv_addm (m : ('a,'b) fmap) mi x y: - inv_spec m mi - => m.[x] = None - => mi.[y] = None - => inv_spec m.[x <- y] mi.[y <- x]. -proof. -move=> [] Hinv m_x mi_y; split=> x' y'; rewrite !getP; split. -+ case: (x' = x)=> /= [[#] <*> //=|_ /Hinv ^ + ->]. - by move: mi_y; case: (y' = y)=> [[#] <*> ->|]. -case: (y' = y)=> /= [[#] <*> //=|_ /Hinv ^ + ->]. -by move: m_x; case: (x' = x)=> [[#] <*> ->|]. -qed. - -(** Preservation of incl **) -lemma incl_addm (m m' : ('a,'b) fmap) x y: - incl m m' - => incl m.[x <- y] m'.[x <- y]. -proof. by move=> m_leq_m' x'; rewrite !getP; case: (x' = x)=> [|_ /m_leq_m']. qed. - -(** getflag: retrieve the flag of a capacity **) -op getflag (hs : handles) xc = - omap snd (obind ("_.[_]" hs) (hinv hs xc)). - -lemma getflagP_none hs xc: - (getflag hs xc = None <=> forall f h, hs.[h] <> Some (xc,f)). -proof. by rewrite /getflag; case: (hinvP hs xc)=> [->|] //= /#. qed. - -lemma getflagP_some hs xc f: - huniq hs - => (getflag hs xc = Some f <=> mem (rng hs) (xc,f)). -proof. -move=> huniq_hs; split. -+ rewrite /getflag; case: (hinvP hs xc)=> [-> //|]. - rewrite in_rng; case: (hinv hs xc)=> //= h [f']. - rewrite oget_some=> ^ hs_h -> @/snd /= ->>. - by exists h. -rewrite in_rng=> -[h] hs_h. -move: (hinvP hs xc)=> [_ /(_ h f) //|]. -rewrite /getflag; case: (hinv hs xc)=> // h' _ [f']; rewrite oget_some. -move=> /(huniq_hs _ h _ (xc,f)) /(_ hs_h) /= ->>. -by rewrite hs_h. -qed. - -(** Stuff about paths **) -lemma build_hpath_prefix mh p b v h: - build_hpath mh (rcons p b) = Some (v,h) - <=> (exists v' h', build_hpath mh p = Some (v',h') /\ mh.[(v' +^ b,h')] = Some (v,h)). -proof. -rewrite build_hpathP; split=> [[/#|p' b' v' h' [#] + Hhpath Hmh]|[v' h'] [] Hhpath Hmh]. -+ by move=> ^/rconsIs <<- {b'} /rconssI <<- {p'}; exists v' h'. -exact/(Extend _ _ _ _ _ Hhpath Hmh). -qed. - -lemma build_hpath_up mh xa hx ya hy p za hz: - build_hpath mh p = Some (za,hz) - => mh.[(xa,hx)] = None - => build_hpath mh.[(xa,hx) <- (ya,hy)] p = Some (za,hz). -proof. -move=> + mh_xahx; elim/last_ind: p za hz=> [za hz|p b ih za hz]. -+ by rewrite /build_hpath. -move=> /build_hpath_prefix [b' h'] [#] /ih Hpath Hmh. -apply/build_hpathP/(@Extend _ _ _ _ p b b' h' _ Hpath _)=> //. -by rewrite getP /#. -qed. - -lemma build_hpath_down mh xa hx ya hy p v h: - (forall p v, build_hpath mh p <> Some (v,hx)) - => build_hpath mh.[(xa,hx) <- (ya,hy)] p = Some (v,h) - => build_hpath mh p = Some (v,h). -proof. -move=> no_path_to_hx. -elim/last_ind: p v h=> [v h /build_hpathP [<*>|/#] //=|p b ih]. -move=> v h /build_hpathP [/#|p' b' + + ^/rconsIs <<- /rconssI <<-]. -move=> v' h' /ih; rewrite getP. -case: ((v' +^ b,h') = (xa,hx))=> [/#|_ Hpath Hextend]. -exact/build_hpathP/(Extend _ _ _ _ _ Hpath Hextend). -qed. - -lemma known_path_uniq hs mh pi xc hx p xa p' xa': - pi_spec hs mh pi - => hs.[hx] = Some (xc,Known) - => build_hpath mh p = Some (xa, hx) - => build_hpath mh p' = Some (xa',hx) - => p = p' /\ xa = xa'. -proof. -move=> [] Ipi hs_hy path_p path_p'. -have /iffRL /(_ _):= Ipi xc p xa; first by exists hx. -have /iffRL /(_ _):= Ipi xc p' xa'; first by exists hx. -by move=> ->. -qed. - -(* Useful? Not sure... *) -lemma path_split hs ch m mh xc hx p xa: - hs_spec hs ch - => m_mh hs m mh - => hs.[hx] = Some (xc,Unknown) - => build_hpath mh p = Some (xa,hx) - => exists pk ya yc hy b za zc hz pu, - p = (rcons pk b) ++ pu - /\ build_hpath mh pk = Some (ya,hy) - /\ hs.[hy] = Some (yc,Known) - /\ mh.[(ya +^ b,hy)] = Some (za,hz) - /\ hs.[hz] = Some (zc,Unknown). -proof. -move=> Ihs [] _ Imh_m. -elim/last_ind: p hx xa xc=> [hx xa xc + /build_hpathP [_ <*>|/#]|]. -+ by have [] _ -> _ [#]:= Ihs. -move=> p b ih hx xa xc hs_hx /build_hpath_prefix. -move=> [ya hy] [#] path_p_hy ^mh_yabh' /Imh_m [yc fy ? ?] [#] hs_hy. -rewrite hs_hx=> /= [#] <<*> _; case: fy hs_hy. -+ move=> /ih /(_ ya _) // [pk ya' yc' hy' b' za zc hz pu] [#] <*>. - move=> Hpath hs_hy' mh_tahy' hs_hz. - by exists pk ya' yc' hy' b' za zc hz (rcons pu b); rewrite rcons_cat. -by move=> hs_hy; exists p ya yc hy b xa xc hx []; rewrite cats0. -qed. - -(** Path-specific lemmas **) -lemma lemma1 hs ch Pm Pmi Gm Gmi mh mhi ro pi x1 x2 y1 y2: - INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi - => x2 <> y2 - => Pm.[(x1,x2)] = None - => Gm.[(x1,x2)] = None - => (forall f h, hs.[h] <> Some (x2,f)) - => (forall f h, hs.[h] <> Some (y2,f)) - => INV_CF_G1 - hs.[ch <- (x2,Known)].[ch + 1 <- (y2,Known)] (ch + 2) - Pm.[(x1,x2) <- (y1,y2)] Pmi.[(y1,y2) <- (x1,x2)] - Gm.[(x1,x2) <- (y1,y2)] Gmi.[(y1,y2) <- (x1,x2)] - mh.[(x1,ch) <- (y1,ch + 1)] mhi.[(y1,ch + 1) <- (x1,ch)] - ro pi. -proof. -move=> HINV x2_neq_y2 Pm_x Gm_x x2_notin_rng1_hs y2_notin_rng1_hs; split. -+ rewrite (@addzA ch 1 1); apply/hs_addh. - + by move: HINV=> /hs_of_INV/hs_addh=> ->. - by move=> f h; rewrite getP; case: (h = ch)=> [/#|_]; exact/y2_notin_rng1_hs. -+ apply/inv_addm=> //; 1:by case: HINV. - case: {-1}(Gmi.[(y1,y2)]) (eq_refl Gmi.[(y1,y2)])=> [//|[xa xc]]. - + have /incli_of_INV @/incl + ^h - <- := HINV; 1: by rewrite h. - have /mi_mhi_of_INV [] H _ /H {H} [hx fx hy fy] [#] := HINV. - by rewrite y2_notin_rng1_hs. -+ apply/inv_addm; 1:by case: HINV. - + have ^ /m_mh_of_INV Hm_mh /hs_of_INV Hhs := HINV. - by apply/(ch_notin_dom2_mh _ _ Hm_mh Hhs). - have ^ /mi_mhi_of_INV Hmi_mhi /hs_of_INV Hhs := HINV. - by apply/(Sch_notin_dom2_mh _ _ Hmi_mhi Hhs). -+ apply/(@m_mh_addh_addm hs.[ch <- (x2,Known)] Pm mh ch x1 x2 (ch + 1) y1 y2 Known). - + by move: HINV=> ^/hs_of_INV Hhs /m_mh_of_INV; exact/(m_mh_addh Hhs). - + by move: HINV => /hs_of_INV /hs_addh /(_ x2 Known _) // []. - + by rewrite getP. - by rewrite getP gtr_eqF 1:/# /=; apply/Sch_notin_dom_hs; case: HINV. -+ apply/(@mi_mhi_addh_addmi hs.[ch <- (x2,Known)] Pmi mhi ch x1 x2 (ch + 1) y1 y2 Known Known). - + by move: HINV=> ^/hs_of_INV Hhs /mi_mhi_of_INV; exact/(m_mh_addh Hhs). - + move=> f h; rewrite getP; case: (h = ch)=> [_ //=|_ //=]; first by rewrite x2_neq_y2. - by rewrite y2_notin_rng1_hs. - + by rewrite getP. - by rewrite getP gtr_eqF 1:/# /=; apply/Sch_notin_dom_hs; case: HINV. -+ by apply/incl_addm; case: HINV. -+ by apply/incl_addm; case: HINV. -+ split. - + move=> xa hx ya hy; rewrite getP; case: ((xa,hx) = (x1,ch))=> [|]. - + by move=> [#] <*> [#] <*>; exists x2 Known y2 Known; rewrite !getP /#. - move=> xahx_neq_x1ch; have ^ /hs_of_INV Hhs /mh_of_INV [] Hmh _ _ /Hmh {Hmh} := HINV. - move=> [xc fx yc fy] [#] hs_hx hs_hy Hite. - exists xc fx yc fy; do 2?split; first 2 by smt (dom_hs_neq_ch dom_hs_neq_Sch getP). - case: fy Hite hs_hy=> /= [[p v] [Hro Hpath] hs_hy|[#] Gm_xaxc <*> hs_hy] /=; last first. - + by rewrite getP; case: ((xa,xc) = (x1,x2))=> [/#|]. - exists p v; rewrite Hro /=; apply/build_hpath_up=> //. - have /m_mh_of_INV /notin_hs_notin_dom2_mh H:= HINV. - exact/H/ch_notin_dom_hs/Hhs. - + move=> p xa b; have /mh_of_INV [] _ -> _ := HINV. - apply/exists_iff=> v /=; apply/exists_iff=> hx /=; apply/exists_iff=> hy /=. - have mh_x1ch: mh.[(x1,ch)] = None. - + by apply/(notin_hs_notin_dom2_mh hs Pm)/ch_notin_dom_hs; case: HINV. - have ch_notin_rng2_mh: forall a h a', mh.[(a,h)] <> Some (a',ch). - + move=> a h a'; rewrite -negP; have /m_mh_of_INV [] _ Hmh_m /Hmh_m {Hmh_m} := HINV. - by move=> [xc fx yc fy] [#] _; rewrite ch_notin_dom_hs; case: HINV. - split=> -[#]. - + move=> Hpath mh_vxahx; rewrite getP; case: ((v +^ xa,hx) = (x1,ch))=> [/#|_]. - by rewrite mh_vxahx //=; apply/build_hpath_up=> //=; rewrite mh_x1ch. - have H /H {H}:= build_hpath_down mh x1 ch y1 (ch + 1) p v hx _. - + move=> p0 v0; rewrite -negP=> /build_hpathP [<*>|]. - + by have /hs_of_INV [] _ + H - /H {H} := HINV. - by move=> p' b' v' h' <*>; rewrite ch_notin_rng2_mh. - move=> ^ /build_hpathP + -> /=; rewrite getP. - by case=> [<*>|/#]; move: HINV=> /hs_of_INV [] _ + H - /H {H} /#. - move=> p v p' v' hx. - have: (forall p v, build_hpath mh p <> Some (v,ch)). - + move=> p0 v0; rewrite -negP=> /build_hpathP [<*>|]. - + by have /hs_of_INV [] _ + H - /H {H} := HINV. - move=> p'0 b'0 v'0 h'0 <*> _; have /m_mh_of_INV [] _ H /H {H} := HINV. - by move=> [xc fx yc fy] [#] _; have /hs_of_INV [] _ _ H /H {H}:= HINV. - move=> ^ + /build_hpath_down H /H {H} - /build_hpath_down H + /H {H}. - by have /mh_of_INV [] _ _ /(_ p v p' v' hx) := HINV. -split=> c p v; have ^/hs_of_INV [] _ _ dom_hs /pi_of_INV [] -> := HINV. -apply/exists_iff=> h /=; split=> [#]. -+ move=> /(build_hpath_up mh x1 ch y1 (ch + 1) p v h) /(_ _). - + by apply/(notin_hs_notin_dom2_mh hs Pm)/ch_notin_dom_hs; case: HINV. - by move=> -> /= ^ /dom_hs; rewrite !getP /#. -have ch_notin_rng2_mh: forall a h a', mh.[(a,h)] <> Some (a',ch). -+ move=> a h' a'; rewrite -negP; have /m_mh_of_INV [] _ Hmh_m /Hmh_m {Hmh_m} := HINV. - by move=> [xc fx yc fy] [#] _; rewrite ch_notin_dom_hs; case: HINV. -have Sch_notin_rng2_mh: forall a h a', mh.[(a,h)] <> Some (a',ch + 1). -+ move=> a h' a'; rewrite -negP; have /m_mh_of_INV [] _ Hmh_m /Hmh_m {Hmh_m} := HINV. - by move=> [xc fx yc fy] [#] _; rewrite Sch_notin_dom_hs; case: HINV. -have H /H {H}:= build_hpath_down mh x1 ch y1 (ch + 1) p v h _. -+ move=> p0 v0; rewrite -negP=> /build_hpathP [<*>|]. - + by have /hs_of_INV [] _ + H - /H {H} := HINV. - by move=> p' b' v' h' <*>; rewrite ch_notin_rng2_mh. -move=> ^ /build_hpathP + -> /=; rewrite !getP. -by case=> [<*>|/#]; move: HINV=> /hs_of_INV [] _ + H - /H {H} /#. -qed. - -lemma lemma1' hs ch Pm Pmi Gm Gmi mh mhi ro pi x1 x2 y1 y2: - INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi - => x2 <> y2 - => Pmi.[(x1,x2)] = None - => Gmi.[(x1,x2)] = None - => (forall f h, hs.[h] <> Some (x2,f)) - => (forall f h, hs.[h] <> Some (y2,f)) - => INV_CF_G1 - hs.[ch <- (x2,Known)].[ch + 1 <- (y2,Known)] (ch + 2) - Pm.[(y1,y2) <- (x1,x2)] Pmi.[(x1,x2) <- (y1,y2)] - Gm.[(y1,y2) <- (x1,x2)] Gmi.[(x1,x2) <- (y1,y2)] - mh.[(y1,ch + 1) <- (x1,ch)] mhi.[(x1,ch) <- (y1,ch + 1)] - ro pi. -proof. -move=> HINV x2_neq_y2 Pm_x Gm_x xc_notin_rng1_hs yc_notin_rng1_hs; split. -+ rewrite (@addzA ch 1 1); apply/hs_addh. - + by move: HINV=> /hs_of_INV/hs_addh=> ->. - by move=> f h; rewrite getP; case: (h = ch)=> [/#|_]; exact/yc_notin_rng1_hs. -+ apply/inv_addm=> //; 1:by case: HINV. - case: {-1}(Gm.[(y1,y2)]) (eq_refl Gm.[(y1,y2)])=> [//|[xa xc]]. - + have /incl_of_INV + ^h - <- := HINV; 1: by rewrite h. - have /m_mh_of_INV [] H _ /H {H} [hx fx hy fy] [#] := HINV. - by rewrite yc_notin_rng1_hs. -+ apply/inv_addm; 1:by case: HINV. - + have ^ /m_mh_of_INV Hm_mh /hs_of_INV Hhs := HINV. - by apply/(Sch_notin_dom2_mh _ _ Hm_mh Hhs). - have ^ /mi_mhi_of_INV Hmi_mhi /hs_of_INV Hhs := HINV. - by apply/(ch_notin_dom2_mh _ _ Hmi_mhi Hhs). -+ apply/(@mi_mhi_addh_addmi hs.[ch <- (x2,Known)] Pm mh ch x1 x2 (ch + 1) y1 y2 Known Known). - + by move: HINV=> ^/hs_of_INV Hhs /m_mh_of_INV; exact/(m_mh_addh Hhs). - + by move=> f h; rewrite getP; case: (h = ch)=> [<*> /#|]; rewrite yc_notin_rng1_hs. - + by rewrite getP. - by rewrite getP gtr_eqF 1:/# /=; apply/Sch_notin_dom_hs; case: HINV. -+ apply/(@m_mh_addh_addm hs.[ch <- (x2,Known)] Pmi mhi ch x1 x2 (ch + 1) y1 y2 Known). - + by move: HINV=> ^/hs_of_INV Hhs /mi_mhi_of_INV; exact/(m_mh_addh Hhs). - + by have /hs_of_INV /hs_addh /(_ x2 Known _) // []:= HINV. - + by rewrite getP. - by rewrite getP gtr_eqF 1:/# /=; apply/Sch_notin_dom_hs; case: HINV. -+ by apply/incl_addm; case: HINV. -+ by apply/incl_addm; case: HINV. -+ split. - + move=> ya hy xa hx; rewrite getP; case: ((ya,hy) = (y1,ch + 1))=> [|]. - + by move=> [#] <*> [#] <*>; exists y2 Known x2 Known; rewrite !getP /#. - move=> yahy_neq_y1Sch; have ^ /hs_of_INV Hhs /mh_of_INV [] Hmh _ _ /Hmh {Hmh} := HINV. - move=> [yc fy xc fx] [#] hs_hy hs_hx Hite. - exists yc fy xc fx; do 2?split; first 2 by smt (dom_hs_neq_ch dom_hs_neq_Sch getP). - case: fx Hite hs_hx=> /= [[p v] [Hro Hpath] hs_hx|[#] Gm_yayc <*> hs_hx] /=; last first. - + by rewrite getP; case: ((ya,yc) = (y1,y2))=> [/#|]. - exists p v; rewrite Hro /=; apply/build_hpath_up=> //. - have /m_mh_of_INV /notin_hs_notin_dom2_mh H:= HINV. - exact/H/Sch_notin_dom_hs/Hhs. - + move=> p ya b; have /mh_of_INV [] _ -> _ := HINV. - apply/exists_iff=> v /=; apply/exists_iff=> hx /=; apply/exists_iff=> hy /=. - have mh_y1Sch: mh.[(y1,ch + 1)] = None. - + by apply/(notin_hs_notin_dom2_mh hs Pm)/Sch_notin_dom_hs; case: HINV. - have Sch_notin_rng2_mh: forall a h a', mh.[(a,h)] <> Some (a',ch + 1). - + move=> a h a'; rewrite -negP; have /m_mh_of_INV [] _ Hmh_m /Hmh_m {Hmh_m} := HINV. - by move=> [yc fy xc fx] [#] _; rewrite Sch_notin_dom_hs; case: HINV. - split=> -[#]. - + move=> Hpath mh_vxahx; rewrite getP; case: ((v +^ ya,hx) = (y1,ch + 1))=> [/#|_]. - by rewrite mh_vxahx //=; apply/build_hpath_up=> //=; rewrite mh_y1ch. - have H /H {H}:= build_hpath_down mh y1 (ch + 1) x1 ch p v hx _. - + move=> p0 v0; rewrite -negP=> /build_hpathP [<*>|]. - + by have /hs_of_INV [] _ + H - /H {H} /# := HINV. - by move=> p' b' v' h' <*>; rewrite Sch_notin_rng2_mh. - move=> ^ /build_hpathP + -> /=; rewrite getP. - by case=> [<*>|/#]; move: HINV=> /hs_of_INV [] _ + H - /H {H} /#. - move=> p v p' v' hx. - have: (forall p v, build_hpath mh p <> Some (v,ch + 1)). - + move=> p0 v0; rewrite -negP=> /build_hpathP [<*>|]. - + by have /hs_of_INV [] _ + H - /H {H} /# := HINV. - move=> p'0 b'0 v'0 h'0 <*> _; have /m_mh_of_INV [] _ H /H {H} := HINV. - by move=> [xc fx yc fy] [#] _; have /hs_of_INV [] _ _ H /H {H} /#:= HINV. - move=> ^ + /build_hpath_down H /H {H} - /build_hpath_down H + /H {H}. - by have /mh_of_INV [] _ _ /(_ p v p' v' hx) := HINV. -split=> c p v; have ^/hs_of_INV [] _ _ dom_hs /pi_of_INV [] -> := HINV. -apply/exists_iff=> h /=; split=> [#]. -+ move=> /(build_hpath_up mh y1 (ch + 1) x1 ch p v h) /(_ _). - + by apply/(notin_hs_notin_dom2_mh hs Pm)/Sch_notin_dom_hs; case: HINV. - by move=> -> /= ^ /dom_hs; rewrite !getP /#. -have ch_notin_rng2_mh: forall a h a', mh.[(a,h)] <> Some (a',ch). -+ move=> a h' a'; rewrite -negP; have /m_mh_of_INV [] _ Hmh_m /Hmh_m {Hmh_m} := HINV. - by move=> [xc fx yc fy] [#] _; rewrite ch_notin_dom_hs; case: HINV. -have Sch_notin_rng2_mh: forall a h a', mh.[(a,h)] <> Some (a',ch + 1). -+ move=> a h' a'; rewrite -negP; have /m_mh_of_INV [] _ Hmh_m /Hmh_m {Hmh_m} := HINV. - by move=> [xc fx yc fy] [#] _; rewrite Sch_notin_dom_hs; case: HINV. -have H /H {H}:= build_hpath_down mh y1 (ch + 1) x1 ch p v h _. -+ move=> p0 v0; rewrite -negP=> /build_hpathP [<*>|]. - + by have /hs_of_INV [] _ + H - /H {H} /# := HINV. - by move=> p' b' v' h' <*>; rewrite Sch_notin_rng2_mh. -move=> ^ /build_hpathP + -> /=; rewrite !getP. -by case=> [<*>|/#]; move: HINV=> /hs_of_INV [] _ + H - /H {H} /#. -qed. - -lemma lemma2 hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi x1 x2 y1 y2 hx: - INV_CF_G1 hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi - => PFm.[(x1,x2)] = None - => G1m.[(x1,x2)] = None - => pi.[x2] = None - => hs.[hx] = Some (x2,Known) - => (forall f h, hs.[h] <> Some (y2,f)) - => INV_CF_G1 hs.[ch <- (y2,Known)] (ch + 1) - PFm.[(x1,x2) <- (y1,y2)] PFmi.[(y1,y2) <- (x1,x2)] - G1m.[(x1,x2) <- (y1,y2)] G1mi.[(y1,y2) <- (x1,x2)] - G1mh.[(x1,hx) <- (y1,ch)] G1mhi.[(y1,ch) <- (x1,hx)] - ro pi. -proof. -move=> HINV PFm_x1x2 G1m_x1x2 pi_x2 hs_hx y2_notin_rng1_hs. -split. -+ by apply/hs_addh=> //=; case: HINV. -+ apply/inv_addm=> //; 1:by case: HINV. - case: {-1}(G1mi.[(y1,y2)]) (eq_refl G1mi.[(y1,y2)])=> [//|[xa xc]]. - + have /incli_of_INV @/incl + ^h - <- := HINV; 1: by rewrite h. - have /mi_mhi_of_INV [] H _ /H {H} [hx' fx' hy' fy'] [#] := HINV. - by rewrite y2_notin_rng1_hs. -+ apply/inv_addm; 1:by case: HINV. - + have ^ /m_mh_of_INV Hm_mh /hs_of_INV Hhs := HINV. - by apply/(notin_m_notin_mh _ _ _ _ Hm_mh PFm_x1x2 hs_hx). - have ^ /mi_mhi_of_INV Hmi_mhi /hs_of_INV Hhs := HINV. - by apply/(ch_notin_dom2_mh _ _ Hmi_mhi Hhs). -+ have ^ /hs_of_INV ^ Hhs [] Hhuniq _ _ /m_mh_of_INV := HINV. - move=> /m_mh_addh_addm /(_ hx x1 x2 ch y1 y2 Known Known Hhuniq hs_hx _) //. - exact/ch_notin_dom_hs. -+ have ^ /hs_of_INV ^ Hhs [] Hhuniq _ _ /mi_mhi_of_INV := HINV. - move=> /mi_mhi_addh_addmi /(_ hx x1 x2 ch y1 y2 Known Known _ hs_hx _) //. - exact/ch_notin_dom_hs. -+ by have /incl_of_INV/incl_addm ->:= HINV. -+ by have /incli_of_INV/incl_addm ->:= HINV. -+ split. - + move=> xa' hx' ya' hy'; rewrite getP; case: ((xa',hx') = (x1,hx))=> [[#] <*>> [#] <<*> /=|]. - + exists x2 Known y2 Known=> //=; rewrite !getP /=. - by have /hs_of_INV [] _ _ dom_hs /#:= HINV. - move=> xahx'_neq_x1hx; have /mh_of_INV [] Hmh _ _ /Hmh {Hmh} := HINV. - move=> [xc fx yc] [] /= [#] hs_hx' hs_hy'=> [[p v] [Hro Hpath]|<*> Gm_xa'xc]. - + exists xc fx yc Unknown=> /=; rewrite !getP hs_hx' hs_hy'. - rewrite (dom_hs_neq_ch hs xc fx _ hs_hx') /=; 1:by case: HINV. - rewrite (dom_hs_neq_ch hs yc Unknown _ hs_hy')/= ; 1:by case: HINV. - exists p v; rewrite Hro /=; apply/build_hpath_up/(notin_m_notin_mh _ _ _ _ _ PFm_x1x2 hs_hx). - + done. - by case: HINV. - exists xc Known yc Known=> //=; rewrite !getP; case: ((xa',xc) = (x1,x2))=> [/#|]. - rewrite Gm_xa'xc /= (dom_hs_neq_ch hs xc Known _ hs_hx') /=; 1:by case: HINV. - by rewrite (dom_hs_neq_ch hs yc Known _ hs_hy')/= ; 1:by case: HINV. - + move=> p xa b; have /mh_of_INV [] _ -> _ := HINV; split. - + move=> [v hi hf] [#] Hpath mh_vxahi; exists v hi hf. - rewrite getP; case: ((v +^ xa,hi) = (x1,hx))=> [[#] <*>|_]. - + move: mh_vxahi; have /m_mh_of_INV [] _ H /H {H}:= HINV. - by move=> [xc fx yc fy] [#]; rewrite hs_hx=> [#] <*>; rewrite PFm_x1x2. - rewrite mh_vxahi /=; apply/build_hpath_up=> //. - by apply/(notin_m_notin_mh _ _ _ _ _ PFm_x1x2 hs_hx); case: HINV. - move=> [v hi hf] [#]. - have no_path_to_hx: forall p0 v0, build_hpath G1mh p0 <> Some (v0,hx). - + have /pi_of_INV [] /(_ x2):= HINV; rewrite pi_x2 /=. - by move=> + p0 v0 - /(_ p0 v0) /negb_exists /(_ hx) /=; rewrite hs_hx. - have H /H {H} := build_hpath_down G1mh x1 hx y1 ch p v hi no_path_to_hx. - rewrite getP. case: ((v +^ xa,hi) = (x1,hx))=> [[#] <*>|_ Hpath Hextend]. - + by rewrite no_path_to_hx. - by exists v hi hf. - move=> p v p' v' h0. - have: forall p0 v0, build_hpath G1mh p0 <> Some (v0,hx). - + have /pi_of_INV [] /(_ x2):= HINV; rewrite pi_x2 /=. - by move=> + p0 v0 - /(_ p0 v0) /negb_exists /(_ hx) /=; rewrite hs_hx. - move=> ^ + /build_hpath_down H /H {H} - /build_hpath_down H + /H {H}. - by have /mh_of_INV [] _ _ /(_ p v p' v' h0):= HINV. -split=> c p v; have /pi_of_INV [] -> := HINV. -apply/exists_iff=> h /=; split=> [#]. -+ move=> /build_hpath_up /(_ x1 hx y1 ch _). - + by apply/(notin_m_notin_mh hs PFm x2 Known); case:HINV. - move=> -> /=; rewrite getP. - by have /hs_of_INV [] _ _ dom_hs ^ + /dom_hs /#:= HINV. -have no_path_to_hx: forall p0 v0, build_hpath G1mh p0 <> Some (v0,hx). -+ have /pi_of_INV [] /(_ x2):= HINV; rewrite pi_x2 /=. - by move=> + p0 v0 - /(_ p0 v0) /negb_exists /(_ hx) /=; rewrite hs_hx. -have H /H {H} := build_hpath_down G1mh x1 hx y1 ch p v h no_path_to_hx. -move=> ^ Hpath -> /=; rewrite getP; case: (h = ch)=> [<*> /= [#] <*>|//=]. -move: Hpath=> /build_hpathP [<*>|]. -+ by have /hs_of_INV [] _ + H - /H {H}:= HINV. -move=> p' b' v' h' <*> _; have /m_mh_of_INV [] _ H /H {H}:= HINV. -by move=> [xc fx yc fy] [#] _; have /hs_of_INV [] _ _ H /H {H}:= HINV. -qed. - -lemma lemma2' hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi x1 x2 y1 y2 hx: - INV_CF_G1 hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi - => PFmi.[(x1,x2)] = None - => G1mi.[(x1,x2)] = None - => hs.[hx] = Some (x2,Known) - => (forall f h, hs.[h] <> Some (y2,f)) - => INV_CF_G1 hs.[ch <- (y2,Known)] (ch + 1) - PFm.[(y1,y2) <- (x1,x2)] PFmi.[(x1,x2) <- (y1,y2)] - G1m.[(y1,y2) <- (x1,x2)] G1mi.[(x1,x2) <- (y1,y2)] - G1mh.[(y1,ch) <- (x1,hx)] G1mhi.[(x1,hx) <- (y1,ch)] - ro pi. -proof. -move=> HINV PFmi_x1x2 G1mi_x1x2 hs_hx y2_notin_rng1_hs. -split. -+ by apply/hs_addh=> //=; case: HINV. -+ apply/inv_addm=> //; 1:by case: HINV. - case: {-1}(G1m.[(y1,y2)]) (eq_refl G1m.[(y1,y2)])=> [//|[xa xc]]. - + have /incl_of_INV + ^h - <- := HINV; 1: by rewrite h. - have /m_mh_of_INV [] H _ /H {H} [hx' fx' hy' fy'] [#] := HINV. - by rewrite y2_notin_rng1_hs. -+ apply/inv_addm; 1:by case: HINV. - + have ^ /m_mh_of_INV Hm_mh /hs_of_INV Hhs := HINV. - by apply/(ch_notin_dom2_mh _ _ Hm_mh Hhs). - have ^ /mi_mhi_of_INV Hm_mh /hs_of_INV Hhs := HINV. - by apply/(notin_m_notin_mh _ _ _ _ Hm_mh PFmi_x1x2 hs_hx). -+ have ^ /hs_of_INV ^ Hhs [] Hhuniq _ _ /m_mh_of_INV := HINV. - move=> /mi_mhi_addh_addmi /(_ hx x1 x2 ch y1 y2 Known Known _ hs_hx _) //. - exact/ch_notin_dom_hs. -+ have ^ /hs_of_INV ^ Hhs [] Hhuniq _ _ /mi_mhi_of_INV := HINV. - move=> /m_mh_addh_addm /(_ hx x1 x2 ch y1 y2 Known Known _ hs_hx _) //. - exact/ch_notin_dom_hs. -+ by have /incl_of_INV/incl_addm ->:= HINV. -+ by have /incli_of_INV/incl_addm ->:= HINV. -+ split. - + move=> ya' hy' xa' hx'; rewrite getP; case: ((ya',hy') = (y1,ch))=> [[#] <*>> [#] <<*> /=|]. - + exists y2 Known x2 Known=> //=; rewrite !getP /=. - by have /hs_of_INV [] _ _ dom_hs /#:= HINV. - move=> yahy'_neq_y1ch; have /mh_of_INV [] Hmh _ _ /Hmh {Hmh} := HINV. - move=> [yc fy xc] [] /= [#] hs_hy' hs_hx'=> [[p v] [#] Hro Hpath|Gm_ya'yc <*>]. - + exists yc fy xc Unknown => /=; rewrite !getP hs_hx' hs_hy'. - rewrite (dom_hs_neq_ch hs yc fy _ hs_hy') /=; 1:by case: HINV. - rewrite (dom_hs_neq_ch hs xc Unknown _ hs_hx')/= ; 1:by case: HINV. - exists p v; rewrite Hro /=; apply/build_hpath_up=> //. - case: {-1}(G1mh.[(y1,ch)]) (eq_refl G1mh.[(y1,ch)])=> [//|[za zc]]. - have /m_mh_of_INV [] _ H /H {H} [? ? ? ?] [#]:= HINV. - by have /hs_of_INV [] _ _ H /H {H} := HINV. - exists yc Known xc Known=> //=; rewrite !getP; case: ((ya',yc) = (y1,y2))=> [/#|]. - rewrite Gm_ya'yc /= (dom_hs_neq_ch hs yc Known _ hs_hy') /=; 1:by case: HINV. - by rewrite (dom_hs_neq_ch hs xc Known _ hs_hx')/= ; 1:by case: HINV. - + move=> p ya b; have /mh_of_INV [] _ -> _ := HINV. - apply/exists_iff=> v /=; apply/exists_iff=> hx' /=; apply/exists_iff=> hy' /=. - split=> [#]. - + move=> /(@build_hpath_up _ y1 ch x1 hx) /(_ _). - + apply/(@notin_hs_notin_dom2_mh hs PFm)/(ch_notin_dom_hs); by case: HINV. - move=> -> /=; rewrite getP /=; case: (hx' = ch)=> <*> //. - have /m_mh_of_INV [] _ H /H {H} [xc fx yc fy] [#] := HINV. - by have /hs_of_INV [] _ _ H /H {H} := HINV. - have no_path_to_ch: forall p0 v0, build_hpath G1mh p0 <> Some (v0,ch). - + move=> p0 v0; elim/last_ind: p0. - + by have /hs_of_INV [] /# := HINV. - move=> p0 b0 _; rewrite build_hpath_prefix. - apply/negb_exists=> b' /=; apply/negb_exists=> h' /=; apply/negb_and=> /=; right. - rewrite -negP; have /mh_of_INV [] H _ _ /H {H} [? ? ? ?] [#] _ := HINV. - by have /hs_of_INV [] _ _ H /H {H} := HINV. - have H /H {H} := build_hpath_down G1mh y1 ch x1 hx p v hx' no_path_to_ch. - rewrite getP. case: ((v +^ ya,hx') = (y1,ch))=> [[#] <*>|_ Hpath Hextend //=]. - by rewrite no_path_to_ch. - move=> p v p' v' h0. - have: forall p0 v0, build_hpath G1mh p0 <> Some (v0,ch). - + move=> p0 v0; elim/last_ind: p0. - + by have /hs_of_INV [] /# := HINV. - move=> p0 b0 _; rewrite build_hpath_prefix. - apply/negb_exists=> b' /=; apply/negb_exists=> h' /=; apply/negb_and=> /=; right. - rewrite -negP; have /mh_of_INV [] H _ _ /H {H} [? ? ? ?] [#] _ := HINV. - by have /hs_of_INV [] _ _ H /H {H} := HINV. - move=> ^ + /build_hpath_down H /H {H} - /build_hpath_down H + /H {H}. - by have /mh_of_INV [] _ _ /(_ p v p' v' h0):= HINV. -split=> c p v; have /pi_of_INV [] -> := HINV. -apply/exists_iff=> h /=; split=> [#]. -+ move=> /build_hpath_up /(_ y1 ch x1 hx _). - + have ^ /m_mh_of_INV [] _ H /hs_of_INV [] _ _ H' := HINV. - case: {-1}(G1mh.[(y1,ch)]) (eq_refl (G1mh.[(y1,ch)]))=> [//|]. - by move=> [za zc] /H [? ? ? ?] [#] /H'. - move=> -> /=; rewrite getP. - by have /hs_of_INV [] _ _ dom_hs ^ + /dom_hs /#:= HINV. -have no_path_to_ch: forall p0 v0, build_hpath G1mh p0 <> Some (v0,ch). -+ move=> p0 v0; elim/last_ind: p0. - + by have /hs_of_INV [] /# := HINV. - move=> p0 b0 _; rewrite build_hpath_prefix. - apply/negb_exists=> b' /=; apply/negb_exists=> h' /=; apply/negb_and=> /=; right. - rewrite -negP; have /mh_of_INV [] H _ _ /H {H} [? ? ? ?] [#] _ := HINV. - by have /hs_of_INV [] _ _ H /H {H} := HINV. -have H /H {H} := build_hpath_down G1mh y1 ch x1 hx p v h no_path_to_ch. -move=> ^ Hpath -> /=; rewrite getP; case: (h = ch)=> [<*> /= [#] <*>|//=]. -move: Hpath=> /build_hpathP [<*>|]. -+ by have /hs_of_INV [] _ + H - /H {H}:= HINV. -move=> p' b' v' h' <*> _; have /m_mh_of_INV [] _ H /H {H}:= HINV. -by move=> [xc fx yc fy] [#] _; have /hs_of_INV [] _ _ H /H {H}:= HINV. -qed. - -lemma lemma3 hs ch Pm Pmi Gm Gmi mh mhi ro pi xa xc hx ya yc hy p b: - INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi - => Pm.[(xa,xc)] = Some (ya,yc) - => Gm.[(xa,xc)] = None - => mh.[(xa,hx)] = Some (ya,hy) - => hs.[hx] = Some (xc,Known) - => hs.[hy] = Some (yc,Unknown) - => pi.[xc] = Some (p,b) - => INV_CF_G1 hs.[hy <- (yc,Known)] ch - Pm Pmi - Gm.[(xa,xc) <- (ya,yc)] Gmi.[(ya,yc) <- (xa,xc)] - mh mhi - ro pi.[yc <- (rcons p (b +^ xa),ya)]. -proof. -move=> HINV Pm_xaxc Gm_xaxc mh_xahx hs_hx hs_hy pi_xc. -split. -+ have /hs_of_INV /hs_updh /(_ Unknown) H := HINV; apply/H=> {H} //. - by rewrite -negP=> <*>; move: hs_hy; have /hs_of_INV [] _ -> := HINV. -+ apply/inv_addm=> //; 1:by case: HINV. - case: {-1}(Gmi.[(ya,yc)]) (eq_refl Gmi.[(ya,yc)])=> [//|[xa' xc']]. - have /incli_of_INV + ^h - <- := HINV; 1:by rewrite h. - move: Pm_xaxc; have [] -> -> /= := inv_mh_inv_Pm hs Pm Pmi mh mhi _ _ _; first 3 by case: HINV. - rewrite andaE -negP=> [#] <<*>. - move: h; have /invG_of_INV [] <- := HINV. - by rewrite Gm_xaxc. -+ by case: HINV. -+ by apply/(m_mh_updh Unknown)=> //; case: HINV. -+ by apply/(m_mh_updh Unknown)=> //; case: HINV. -+ move=> [za zc]; rewrite getP; case: ((za,zc) = (xa,xc))=> // _. - by have /incl_of_INV H /H {H}:= HINV. -+ move: mh_xahx; have /inv_of_INV [] H /H {H}:= HINV. - have /mi_mhi_of_INV [] _ H /H {H} [xct fxt yct fyt] [#] := HINV. - rewrite hs_hx hs_hy=> /= [#] 2!<<- {xct fxt} [#] 2!<<- {yct fyt} Pmi_yayc. - move=> [za zc]; rewrite getP; case: ((za,zc) = (ya,yc))=> // _. - by have /incli_of_INV H /H {H}:= HINV. -+ split; last 2 by have /mh_of_INV [] _:= HINV. - move=> xa' hx' ya' hy'; case: ((xa',hx') = (xa,hx))=> [[#] <*>|]. - + rewrite mh_xahx=> /= [#] <<*>; rewrite !getP /=. - case: (hx = hy)=> [<*>|_]; first by move: hs_hx; rewrite hs_hy. - by exists xc Known yc Known; rewrite getP. - move=> Hxahx' mh_xahx'. - have ^path_to_hy: build_hpath mh (rcons p (b +^ xa)) = Some (ya,hy). - + apply/build_hpath_prefix; exists b hx. - rewrite xorwA xorwK xorwC xorw0 mh_xahx /=. - move: pi_xc; have /pi_of_INV [] -> [h] [#] := HINV. - by have /hs_of_INV [] H _ _ + /H {H} /(_ _ _ hs_hx _) := HINV. - have /mh_of_INV [] /(_ _ _ _ _ mh_xahx') + ro_def H /H {H} unique_path_to_hy := HINV. - move=> [xc' fx' yc' fy'] /= [#]. - case: (hy' = hy)=> [<*> hs_hx'|Hhy']. - + rewrite hs_hy=> /= [#] <<*> /= [p' b'] [#] ro_pbxa' path_hx'. - have:= unique_path_to_hy (rcons p' (b' +^ xa')) ya' _. - + by apply/build_hpath_prefix; exists b' hx'; rewrite xorwA xorwK xorwC xorw0. - move=> [#] ^/rconsIs + /rconssI - <<*>. - by move: mh_xahx' Hxahx' mh_xahx; have /inv_of_INV [] ^ + -> - -> -> /= -> := HINV. - rewrite (@getP _ _ _ hy') Hhy'=> /= hs_hx' ^ hs_hy' -> Hite. - exists xc' (if hx' = hy then Known else fx') yc' fy'. - rewrite (@getP Gm) (_: (xa',xc') <> (xa,xc)) /=. - + move: Hxahx'=> /=; case: (xa' = xa)=> [<*> /=|//]. - by apply/contra=> <*>; have /hs_of_INV [] + _ _ - /(_ _ _ _ _ hs_hx' hs_hx _) := HINV. - rewrite getP; case: (hx' = hy)=> /= [<*>|//]. - move: hs_hx'; rewrite hs_hy=> /= [#] <<*> /=. - by move: Hite=> /= [#]; case: fy' hs_hy'=> //= _ ->. -split=> c p' b'; rewrite !getP; case: (yc = c)=> [<<*> /=|yc_neq_c]; last first. -+ rewrite (@eq_sym c) yc_neq_c /=; have /pi_of_INV [] -> := HINV. - apply/exists_iff=> h /=; rewrite getP; case: (h = hy)=> [<*> /=|//=]. - by rewrite yc_neq_c hs_hy /=. -split=> [[#] <<*>|]. -+ exists hy; rewrite getP /=; apply/build_hpath_prefix. - exists b hx; rewrite xorwA xorwK xorwC xorw0 mh_xahx /=. - move: pi_xc; have /pi_of_INV [] -> [h] [#] + hs_h:= HINV. - by have /hs_of_INV [] + _ _ - /(_ _ _ _ _ hs_hx hs_h _) := HINV. -move=> [h]; rewrite getP; case: (h = hy)=> [<*> /=|]; last first. -+ by have /hs_of_INV [] H _ _ + [#] _ /H {H} /(_ _ _ hs_hy _) // <*> := HINV. -have /mh_of_INV [] _ _ /(_ p' b') H /H {H} /(_ (rcons p (b +^ xa)) ya _) //:= HINV. -apply/build_hpath_prefix; exists b hx; rewrite xorwA xorwK xorwC xorw0 mh_xahx /=. -move: pi_xc; have /pi_of_INV [] -> [h] [#] + hs_h:= HINV. -by have /hs_of_INV [] + _ _ - /(_ _ _ _ _ hs_hx hs_h _) := HINV. -qed. - -clone export ConcreteF as ConcreteF1. - -lemma m_mh_None hs0 PFm G1mh hx2 x2 k x1: - m_mh hs0 PFm G1mh => - hs0.[hx2] = Some (x2, k) => - PFm.[(x1, x2)] = None => - G1mh.[(x1,hx2)] = None. -proof. - move=> [] HP /(_ x1 hx2) + Hhx2;case (G1mh.[(x1, hx2)]) => //. - by move=> -[ya hy] /(_ ya hy) /= [] ????; rewrite Hhx2 => /= [#] <- _ _ ->. -qed. - -lemma build_hpath_None (G1mh:hsmap) p: - foldl (step_hpath G1mh) None p = None. -proof. by elim:p. qed. - -lemma build_hpath_upd_ch ha ch mh xa ya p v hx: - 0 <> ch => ha <> ch => (forall xa xb ha hb, mh.[(xa,ha)] = Some(xb, hb) => ha <> ch /\ hb <> ch) => - build_hpath mh.[(xa, ha) <- (ya, ch)] p = Some (v, hx) => - if hx = ch then - (exists p0 x, build_hpath mh p0 = Some (x, ha) /\ p = rcons p0 (x +^ xa) /\ v = ya) - else - build_hpath mh p = Some (v, hx). -proof. - move=> Hch0 Hha Hch. - elim/last_ind: p v hx=> /=. - + by move=> v hx;rewrite /build_hpath /= => -[!<<-];rewrite Hch0. - move=> p x Hrec v hx /build_hpath_prefix [v' h' [/Hrec{Hrec}]]. - rewrite getP /=;case (h' = ch) => [->> | ]. - + by rewrite (@eq_sym ch) Hha /= => _ /Hch. - case (v' +^ x = xa && h' = ha) => [[!<<-] /= ?? [!->>] /=| ]. - + by exists p v';rewrite xorwA xorwK xorwC xorw0. - case (hx = ch)=> [->> _ _ _ /Hch //|??? Hbu Hg]. - by rewrite build_hpath_prefix;exists v' h'. -qed. - -lemma build_hpath_up_None (G1mh:hsmap) bi1 bi2 bi p: - G1mh.[bi1] = None => - build_hpath G1mh p = Some bi => - build_hpath G1mh.[bi1 <- bi2] p = Some bi. -proof. - rewrite /build_hpath;move=> Hbi1. - elim: p (Some (b0,0)) => //= b p Hrec obi. - rewrite {2 4}/step_hpath /=;case: obi => //= [ | bi'];1:by apply Hrec. - rewrite oget_some. - rewrite getP. case ((bi'.`1 +^ b, bi'.`2) = bi1) => [-> | _];2:by apply Hrec. - by rewrite Hbi1 build_hpath_None. -qed. - -(* -lemma build_hpath_down_None h ch mh xa ha ya a p: - h <> ch => ha <> ch => - (forall ya, mh.[(ya,ch)] = None) => - build_hpath mh.[(xa,ha) <- (ya,ch)] p = Some (a,h) => - build_hpath mh p = Some (a,h). -proof. - move=> Hh Hha Hmh;rewrite /build_hpath;move: (Some (b0, 0)). - elim: p => //= b p Hrec [ | bi] /=;rewrite {2 4}/step_hpath /= ?build_hpath_None //. - rewrite oget_some getP;case ((bi.`1 +^ b, bi.`2) = (xa, ha)) => _;2:by apply Hrec. - move=> {Hrec};case: p=> /= [[_ ->>]| b' p];1: by move:Hh. - by rewrite {2}/step_hpath /= oget_some /= getP_neq /= ?Hha // Hmh build_hpath_None. -qed. -*) - -lemma build_hpath_upd_ch_iff ha ch mh xa ya p v hx: - mh.[(xa,ha)] = None => - 0 <> ch => ha <> ch => (forall xa xb ha hb, mh.[(xa,ha)] = Some(xb, hb) => ha <> ch /\ hb <> ch) => - build_hpath mh.[(xa, ha) <- (ya, ch)] p = Some (v, hx) <=> - if hx = ch then - (exists p0 x, build_hpath mh p0 = Some (x, ha) /\ p = rcons p0 (x +^ xa) /\ v = ya) - else - build_hpath mh p = Some (v, hx). -proof. - move=> Ha Hch0 Hha Hch;split;1: by apply build_hpath_upd_ch. - case (hx = ch);2: by move=> ?;apply build_hpath_up_None. - move=> ->> [p0 x [? [!->>]]]. - rewrite build_hpath_prefix;exists x ha. - by rewrite xorwA xorwK xorwC xorw0 getP_eq /=;apply build_hpath_up_None. -qed. - - - - -(* we should do a lemma to have the equivalence *) - -equiv eq_fi (D <: DISTINGUISHER {PF, RO, G1}): PF.fi ~ G1(D).S.fi: - !G1.bcol{2} - /\ !G1.bext{2} - /\ ={x} - /\ INV_CF_G1 FRO.m{2} G1.chandle{2} - PF.m{1} PF.mi{1} - G1.m{2} G1.mi{2} - G1.mh{2} G1.mhi{2} - F.RO.m{2} G1.paths{2} - ==> !G1.bcol{2} - => !G1.bext{2} - => ={res} - /\ INV_CF_G1 FRO.m{2} G1.chandle{2} - PF.m{1} PF.mi{1} - G1.m{2} G1.mi{2} - G1.mh{2} G1.mhi{2} - F.RO.m{2} G1.paths{2}. -proof. -exists* FRO.m{2}, G1.chandle{2}, PF.m{1}, PF.mi{1}, - G1.m{2}, G1.mi{2}, G1.mh{2}, G1.mhi{2}, - F.RO.m{2}, G1.paths{2}, x{2}. -elim* => hs ch Pm Pmi Gm Gmi mh mhi ro pi [xa xc]. -case @[ambient]: - {-1}(INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi) - (eq_refl (INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi)); last first. -+ by move=> inv0; exfalso=> ? ? [#] <<*>; rewrite inv0. -move=> /eqT inv0; proc. -case @[ambient]: {-1}(Pmi.[(xa,xc)]) (eq_refl Pmi.[(xa,xc)])=> [Pmi_xaxc|[ya yc] Pmi_xaxc]. -+ have /incli_of_INV /(_ (xa,xc)) := inv0; rewrite Pmi_xaxc /=. - case: {-1}(Gmi.[(xa,xc)]) (eq_refl Gmi.[(xa,xc)])=> //= Gmi_xaxc. - rcondt{1} 1; 1:by auto=> &hr [#] <<*>; rewrite in_dom Pmi_xaxc. - rcondt{2} 1; 1:by auto=> &hr [#] <<*>; rewrite in_dom Gmi_xaxc. - case @[ambient]: {-1}(getflag hs xc) (eq_refl (getflag hs xc)). - + move=> /getflagP_none xc_notin_rng1_hs. - rcondt{2} 2. - + auto=> &hr [#] <<*> _ _ _; rewrite in_rng negb_exists=> h /=. - by rewrite xc_notin_rng1_hs. - rcondf{2} 8. - + auto=> &hr [#] !<<- _ _ ->> _ /= _ _ _ _. - rewrite negb_and in_dom; left. - rewrite (@huniq_hinvK_h ch) 3:oget_some /=. - + by apply/huniq_addh=> //; have /hs_of_INV [] := inv0. - + by rewrite getP. - apply/(@notin_m_notin_mh hs.[ch <- (xc,Known)] Pmi _ _ xc ch Known)=> //. - + by apply/m_mh_addh=> //; case: inv0. - by rewrite getP. - auto=> ? ? [#] !<<- -> -> ->> _ /= ya -> /= yc -> /=. - case: (hinvP (hs.[ch <- (xc,Known)]) yc)=> [_|-> //] yc_notin_rng1_hs_addh _ _. - rewrite getP /= oget_some /= -addzA /=. - rewrite(@huniq_hinvK_h ch) 3:oget_some /=. - + by apply/huniq_addh=> //; have /hs_of_INV [] := inv0. - + by rewrite getP. - apply/(@lemma1' hs ch Pm Pmi Gm Gmi mh mhi ro pi xa xc ya yc inv0 _ Pmi_xaxc Gmi_xaxc)=> //. - + rewrite -negP=> <*>; move: yc_notin_rng1_hs_addh => /=. - apply/negb_forall=> /=; exists ch; apply/negb_forall=> /=; exists Known. - by rewrite getP. - + move=> f h; move: (yc_notin_rng1_hs_addh h f); rewrite getP. - case: (h = ch)=> <*> //= _; rewrite -negP. - by have /hs_of_INV [] _ _ H /H {H} := inv0. - have /hs_of_INV [] Hhuniq _ _ [] /(getflagP_some _ _ _ Hhuniq):= inv0. - + move=> x2_is_U; conseq (_: _ ==> G1.bext{2})=> //. - by auto=> ? ? [#] !<<- _ -> ->> _ /=; rewrite x2_is_U. - move=> ^x2_is_K; rewrite in_rng=> -[hx2] hs_hx2. - rcondf{2} 2; 1:by auto=> &hr [#] <*> /=; rewrite x2_is_K. - rcondf{2} 6. - + auto=> &hr [#] !<<- _ _ ->> _. - rewrite (@huniq_hinvK_h hx2) // oget_some /= => _ _ _ _. - rewrite negb_and in_dom /=; left. - by apply/(@notin_m_notin_mh hs Pmi _ _ xc _ Known)=> //; case: inv0. - auto=> ? ? [#] !<<- -> -> ->> _. - rewrite (@huniq_hinvK_h hx2) // oget_some /= => y1 -> /= y2 -> /=. - case: (hinvP hs y2)=> [_ y2_notin_rng1_hs _ _|/#]. - rewrite getP /= oget_some /=. - by apply/lemma2'=> // f h; exact/y2_notin_rng1_hs. -rcondf{1} 1; 1:by auto=> &hr [#] <<*>; rewrite in_dom Pmi_xaxc. -case @[ambient]: {-1}(Gmi.[(xa,xc)]) (eq_refl Gmi.[(xa,xc)])=> [|[ya' yc'] ^] Gmi_xaxc. -+ rcondt{2} 1; 1:by auto=> &hr [#] <<*>; rewrite in_dom Gmi_xaxc. - conseq (_: _ ==> G1.bext{2})=> //. - auto=> &1 &2 [#] !<<- _ -> ->> _ />. - rewrite !in_rng; have ->: exists hx, hs.[hx] = Some (xc,Unknown). - + move: Pmi_xaxc; have /mi_mhi_of_INV [] H _ /H {H} := inv0. - move=> [hx fx hy fy] [#] hs_hx hs_hy. - have ^/inv_of_INV [] <- /mh_of_INV [] H _ _ /H {H} := inv0. - move=> [? ? ? ?] [#]; rewrite hs_hx hs_hy=> /= [#] <<*> [#] <<*>. - case: fx hs_hx=> hs_hx /= => [_|[#]]; first by exists hx. - by have /invG_of_INV [] -> := inv0; rewrite Gmi_xaxc. print Block.DBlock. - smt (@Block.DBlock @Capacity.DCapacity). -have /incli_of_INV <- := inv0; 1:by rewrite Gmi_xaxc. -rewrite Pmi_xaxc=> /= [#] <<*>. -rcondf{2} 1; 1:by auto=> &hr [#] <<*>; rewrite in_dom Gmi_xaxc. -by auto=> &1 &2 /#. -qed. - -lemma head_nth (w:'a) l : head w l = nth w l 0. -proof. by case l. qed. - -lemma drop_add (n1 n2:int) (l:'a list) : 0 <= n1 => 0 <= n2 => drop (n1 + n2) l = drop n2 (drop n1 l). -proof. - move=> Hn1 Hn2;elim: n1 Hn1 l => /= [ | n1 Hn1 Hrec] l;1: by rewrite drop0. - by case: l => //= a l /#. -qed. - -lemma behead_drop (l:'a list) : behead l = drop 1 l. -proof. by case l => //= l;rewrite drop0. qed. - -lemma incl_upd_nin (m1 m2:('a,'b)fmap) x y: incl m1 m2 => !mem (dom m2) x => incl m1 m2.[x <- y]. -proof. - move=> Hincl Hdom w ^/Hincl <- => Hw. - rewrite getP_neq // -negP => ->>. - by move: Hdom;rewrite in_dom. -qed. - - - -equiv PFf_Cf (D<:DISTINGUISHER): SqueezelessSponge(PF).f ~ G1(D).C.f : - ! (G1.bcol{2} \/ G1.bext{2}) /\ - ={p} /\ p{1} <> [] /\ - INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} ==> - ! (G1.bcol{2} \/ G1.bext{2}) => - ={res} /\ INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2}. -proof. - proc; seq 2 4: - ((!(G1.bcol{2} \/ G1.bext{2}) => - (INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} /\ - F.RO.m.[p]{2} = Some sa{1})));last first. - + case : (! (G1.bcol{2} \/ G1.bext{2})); - 2: by conseq (_:_ ==> true)=> //; inline *;auto;rewrite Block.DBlock.dunifin_ll. - inline *; rcondf{2} 3. - + by move=> &m;auto=> &hr [#] H /H[_ H1] ??;rewrite in_dom H1. - by auto=> /> &m1 &m2;rewrite Block.DBlock.dunifin_ll /= => H /H [-> ->];rewrite oget_some. - while ( - p{1} = (drop i p){2} /\ (0 <= i <= size p){2} /\ - (!(G1.bcol{2} \/ G1.bext{2}) => - (INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} /\ - ={sa} /\ - (exists f, FRO.m.[h]{2} = Some (sc{1}, f)) /\ - (build_hpath G1.mh (take i p) = Some (sa,h)){2} /\ - if i{2} = 0 then (sa,h){2} = (b0, 0) - else F.RO.m.[take i p]{2} = Some sa{1})));last first. - + auto=> &m1 &m2 [#] -> -> Hp ^ Hinv -> /=;rewrite drop0 size_ge0 /=;split. - + split;[split|];1: by exists Known;case Hinv => -[] _ ->. - + by rewrite take0. - by case (p{m2}) => //=;smt w=size_ge0. - move=> ????? ????? ?? iR ? ->> ?[#] _ ?? H /H{H} [#] -> ->> _ ?. - have -> : iR = size p{m2} by smt (). - have -> /= : size p{m2} <> 0 by smt (size_ge0). - by rewrite take_size. - inline *;sp 1 0;wp=> /=. - conseq (_: _ ==> (! (G1.bcol{2} \/ G1.bext{2}) => - INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} - G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} /\ - (oget PF.m{1}.[x{1}]).`1 = sa{2} /\ - (exists (f : flag), FRO.m{2}.[h{2}] = Some ((oget PF.m{1}.[x{1}]).`2, f)) /\ - (build_hpath G1.mh (take (i + 1) p) = Some (sa,h)){2} /\ - if i{2} + 1 = 0 then sa{2} = b0 && h{2} = 0 - else F.RO.m{2}.[take (i{2} + 1) p{2}] = Some (oget PF.m{1}.[x{1}]).`1)). - + move=> &m1 &m2 [#] 2!->> ?? H ?? ?????????? H'. - rewrite behead_drop -drop_add //=;split=>[/#|]. - by have := size_drop (i{m2} + 1) p{m2};case (drop (i{m2} + 1) p{m2}) => //= [/#| ];smt w=size_ge0. - case ((G1.bcol{2} \/ G1.bext{2})). - + wp;conseq (_: _ ==> (G1.bcol{2} \/ G1.bext{2}))=> //. - by if{1};if{2};auto;2:(swap{2} 4 -3;auto); smt w=(Block.DBlock.dunifin_ll DCapacity.dunifin_ll). - conseq (_: (x{1} = (sa{1} +^ head witness p{1}, sc{1}) /\ - (p{1} = drop i{2} p{2} /\ - 0 <= i{2} <= size p{2} /\ - (INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} - G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} /\ - ={sa} /\ - (exists (f : flag), FRO.m{2}.[h{2}] = Some (sc{1}, f)) /\ - (build_hpath G1.mh (take i p) = Some (sa,h)){2} /\ - if i{2} = 0 then (sa{2}, h{2}) = (b0, 0) - else F.RO.m{2}.[take i{2} p{2}] = Some sa{1})) /\ - p{1} <> [] /\ i{2} < size p{2}) /\ - ! (G1.bcol{2} \/ G1.bext{2}) /\ - (mem (dom PF.m) x){1} = (mem (dom G1.mh) (sa +^ nth witness p i, h)){2} ==> _). - + move=> &m1 &m2 [#] 2!->> ?? H ?? ^ /H [#] /= Hinv ->> Hf -> -> ? /= />. - case: Hf=> f Hm; rewrite head_nth nth_drop // addz0 !in_dom. - pose X := sa{m2} +^ nth witness p{m2} i{m2}. - case (Hinv)=> -[Hu _ _] _ _ [] /(_ X sc{m1}) Hpf ^ HG1 /(_ X h{m2}) Hmh _ _ _ _ _. - case: {-1}(PF.m{m1}.[(X,sc{m1})]) (eq_refl (PF.m{m1}.[(X,sc{m1})])) Hpf Hmh. - + case (G1.mh{m2}.[(X, h{m2})]) => //= -[ya hy] Hpf. - by rewrite -negP => /(_ ya hy) [] ????[#];rewrite Hm /= => -[<-];rewrite Hpf. - move=> [ya yc] Hpf/(_ ya yc) [hx fx hy fy [#]] Hhx Hhy ^ /HG1 [xc fx0 yc0 fy0]. - rewrite Hhx => /= [#] 2!<<-;rewrite Hhy Hpf /= => -[] !->> _. - by have /= <<- -> := Hu _ _ _ _ Hm Hhx. - if{1};[rcondf{2} 1| rcondt{2} 1];1,3:(by auto;smt ());last first. - + auto => /> /= &m1 &m2 ?? [] Hhs Hinv Hinvi Hmmh Hmmhi Hincl Hincli Hmh Hpi f. - rewrite head_nth nth_drop // addz0 => Heq Hbu ????. - rewrite !in_dom. - have -> /= : i{m2} + 1 <> 0 by smt (). - pose sa' := sa{m2} +^ nth witness p{m2} i{m2}. - case (Hmmh) => /(_ sa' sc{m1});case (PF.m{m1}.[(sa', sc{m1})])=> //= -[ya yc] /(_ ya yc) /=. - move=> [hx fx hy fy]; case (Hhs) => Hu _ _ [#] Heq'. - have /= <<- /= Hhy ^? ->:= Hu _ _ _ _ Heq Heq'. - rewrite !oget_some /= => _;split;1: by exists fy. - rewrite (@take_nth witness) 1://. - case (Hmh) => _ -> _;rewrite build_hpath_prefix Hbu /#. - rcondt{2} 5. - + move=> &m;auto=> &hr /> ?? Hinv f. - rewrite head_nth nth_drop // addz0; pose sa' := sa{hr} +^ nth witness p{hr} i{hr}. - move=> ?Hbu????->Hmem ????. - case (Hinv) => ??????? [] H1 H2 H3 ?. - rewrite (@take_nth witness) 1:// -negP in_dom. - pose p' := (take i{hr} p{hr}); pose w:= (nth witness p{hr} i{hr}). - case {-1}(F.RO.m{hr}.[rcons p' w]) (eq_refl (F.RO.m{hr}.[rcons p' w]))=> //. - move=> ? /H2 [???];rewrite Hbu => -[] [!<<-] HG1. - by move: Hmem;rewrite in_dom HG1. - swap{2} 4 -3;auto => &m1 &m2 [#] 2!->?? [] Hhs Hinv Hinvi Hmmh Hmmhi Hincl Hincli Hmh Hpi -> /=. - move=> Hsc Hpa Hif Hdrop Hlt Hbad. - rewrite head_nth nth_drop // addz0; pose sa' := sa{m2} +^ nth witness p{m2} i{m2}. - move=> Heq Hdom y1L-> /= y2L-> /=. - have -> /= : i{m2} + 1 <> 0 by smt (). - rewrite !getP_eq !oget_some /=. - pose p' := (take (i{m2} + 1) p{m2});rewrite/==> [#] ? /=. - split;last first. - + split;1: by exists Unknown. - rewrite /p' (@take_nth witness) 1:// build_hpath_prefix. - exists sa{m2} h{m2}. - rewrite /sa' getP_eq /=;apply build_hpath_up => //. - by move: Hdom;rewrite Heq /sa' in_dom. - have Hy1L := ch_notin_dom2_mh _ _ _ y1L G1.chandle{m2} Hmmhi Hhs. - have := hinvP FRO.m{m2} y2L;rewrite /= => Hy2L. - have g1_sa' : G1.mh{m2}.[(sa', h{m2})] = None by move: Hdom;rewrite Heq in_dom. - case :Hsc => f Hsc; have Hh := dom_hs_neq_ch _ _ _ _ _ Hhs Hsc. - have Hch : FRO.m{m2}.[G1.chandle{m2}] = None. - + case Hhs => _ _ H. - by case {-1}(FRO.m{m2}.[G1.chandle{m2}]) (eq_refl (FRO.m{m2}.[G1.chandle{m2}])) => // ? /H. - have Hy2_mi: ! mem (dom PF.mi{m1}) (y1L, y2L). - + rewrite in_dom;case {-1}( PF.mi{m1}.[(y1L, y2L)]) (eq_refl (PF.mi{m1}.[(y1L, y2L)])) => //. - by move=> [] ??;case Hmmhi=> H _ /H [] ????/#. - have ch_0 := ch_neq0 _ _ Hhs. - have ch_None : - forall xa xb ha hb, G1.mh{m2}.[(xa,ha)] = Some(xb, hb) => - ha <> G1.chandle{m2} /\ hb <> G1.chandle{m2}. - + move=> xa xb ha hb;case Hmmh=> _ H /H [xc fx yc fy [#]]. - by move=> /(dom_hs_neq_ch _ _ _ _ _ Hhs) -> /(dom_hs_neq_ch _ _ _ _ _ Hhs). - split=> //. - + by apply hs_addh => // ??/#. - + by apply inv_addm. - + by apply (m_mh_addh_addm f) => //;case Hhs. - + by apply (mi_mhi_addh_addmi f)=> // ??/#. - + by apply incl_upd_nin. - + by apply incl_upd_nin. - + case (Hmh)=> H1 H2 H3;split. - + move=> xa hx ya hy;rewrite getP;case((xa, hx) = (sa', h{m2}))=> [[2!->>] [2!<<-] | Hdiff]. - + exists sc{m1} f y2L Unknown. - rewrite getP_eq getP_neq 1:eq_sym //= Hsc /=. - exists (take i{m2} p{m2}) sa{m2}. - rewrite /p' (@take_nth witness) 1:// /sa' xorwA xorwK xorwC xorw0 getP_eq /=. - by apply build_hpath_up_None. - move=> /H1 [xc fx yc fy] [#] Hhx Hhy Hfy; exists xc fx yc fy. - rewrite !getP_neq. - + by rewrite eq_sym;apply (dom_hs_neq_ch _ _ _ Hhs Hhx). - + by rewrite eq_sym;apply (dom_hs_neq_ch _ _ _ Hhs Hhy). - rewrite Hhx Hhy /=;case: fy Hhy Hfy => //= Hhy [p v [Hro Hpath]]. - exists p v;rewrite getP_neq 1:-negP 1:/p' 1:(@take_nth witness) 1://. - + move => ^ /rconssI <<-;move: Hpath;rewrite Hpa=> -[!<<-] /rconsIs Heq'. - by move:Hdiff=> /=;rewrite /sa' Heq' xorwA xorwK xorwC xorw0. - by rewrite Hro /=;apply build_hpath_up_None. - + move=> p1 bn b; rewrite getP /p' (@take_nth witness) //. - case (rcons p1 bn = rcons (take i{m2} p{m2}) (nth witness p{m2} i{m2})). - + move=> ^ /rconssI ->> /rconsIs ->> /=; split => [<<- | ]. - + exists sa{m2} h{m2} G1.chandle{m2}. - by rewrite /sa' getP_eq /= (build_hpath_up Hpa) //. - move=> [v hx hy []] Heq1;rewrite getP /sa'. - case ((v +^ nth witness p{m2} i{m2}, hx) = (sa{m2} +^ nth witness p{m2} i{m2}, h{m2})) => //. - have := build_hpath_up_None G1.mh{m2} (sa', h{m2}) (y1L, G1.chandle{m2}) _ _ g1_sa' Hpa. - by rewrite Heq1 => -[!->>]. - move=> Hdiff;rewrite H2. - apply exists_iff=> v /= ;apply exists_iff => hx /=;apply exists_iff => hy /=. - have Hhx2 := dom_hs_neq_ch _ _ _ _ _ Hhs Hsc. - rewrite build_hpath_upd_ch_iff //. - case (hx = G1.chandle{m2}) => [->>|?]. - + split;1: by move=> [] _ /ch_None. - move=> [[p0' x [Hhx2']]]. - have [!<<-] [!->>]:= H3 _ _ _ _ _ Hpa Hhx2'. - by rewrite getP_neq /= ?Hhx2 // => /ch_None. - rewrite getP; case ((v +^ bn, hx) = (sa', h{m2})) => //= -[Hsa' ->>]. - rewrite Hsa' g1_sa' /= -negP => [#] Hbu !<<-. - have [!<<-]:= H3 _ _ _ _ _ Hpa Hbu. - move: Hsa'=> /Block.WRing.addrI /#. - move=> p1 v p2 v' hx. - rewrite !build_hpath_upd_ch_iff //. - case (hx = G1.chandle{m2})=> [->> | Hdiff ];2:by apply H3. - by move=> /> ?? Hp1 ?? Hp2;have [!->>] := H3 _ _ _ _ _ Hp1 Hp2. - case (Hpi) => H1;split=> c p1 v1;rewrite H1 => {H1}. - apply exists_iff => h1 /=. rewrite getP build_hpath_upd_ch_iff //. - by case (h1 = G1.chandle{m2}) => [->> /#|]. -qed. - -section AUX. - - declare module D : DISTINGUISHER {PF, RO, G1}. - - axiom D_ll (F <: DFUNCTIONALITY{D}) (P <: DPRIMITIVE{D}): - islossless P.f => islossless P.fi => islossless F.f => - islossless D(F, P).distinguish. - - equiv CF_G1 : CF(D).main ~ G1(D).main: - ={glob D} ==> !(G1.bcol \/ G1.bext){2} => ={res}. - proof. - proc. - call (_: G1.bcol \/ G1.bext, - INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} - G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2}). - (* lossless D *) - + exact/D_ll. - (** proofs for G1.S.f *) - (* equivalence up to bad of PF.f and G1.S.f *) - + conseq (_: !G1.bcol{2} - /\ !G1.bext{2} - /\ ={x} - /\ INV_CF_G1 FRO.m{2} G1.chandle{2} - PF.m{1} PF.mi{1} - G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} - F.RO.m{2} G1.paths{2} - ==> !G1.bcol{2} - => !G1.bext{2} - => ={res} - /\ INV_CF_G1 FRO.m{2} G1.chandle{2} - PF.m{1} PF.mi{1} - G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} - F.RO.m{2} G1.paths{2}). - + by move=> &1 &2; rewrite negb_or. - + by move=> &1 &2 _ ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? [#]; rewrite negb_or. - (* For now, everything is completely directed by the syntax of - programs, so we can *try* to identify general principles of that - weird data structure and of its invariant. I'm not sure we'll ever - be able to do that, though. *) - (* We want to name everything for now, to make it easier to manage complexity *) - exists * FRO.m{2}, G1.chandle{2}, - PF.m{1}, PF.mi{1}, - G1.m{2}, G1.mi{2}, G1.mh{2}, G1.mhi{2}, - F.RO.m{2}, G1.paths{2}, - x{2}. - elim * => hs0 ch0 PFm PFmi G1m G1mi G1mh G1mhi ro0 pi0 [] x1 x2. - (* poor man's extraction of a fact from a precondition *) - case @[ambient]: {-1}(INV_CF_G1 hs0 ch0 PFm PFmi G1m G1mi G1mh G1mhi ro0 pi0) - (eq_refl (INV_CF_G1 hs0 ch0 PFm PFmi G1m G1mi G1mh G1mhi ro0 pi0)); last first. - + by move=> h; exfalso=> &1 &2 [#] <*>; rewrite h. - move=> /eqT inv0; proc; case @[ambient] {-1}(PFm.[(x1,x2)]) (eq_refl (PFm.[(x1,x2)])). - + move=> PFm_x1x2. - have /incl_of_INV /(notin_m_notin_Gm _ _ (x1,x2)) /(_ _) // Gm_x1x2 := inv0. - rcondt{1} 1; 1:by move=> //= &1; skip=> &2 [#] <*>; rewrite in_dom PFm_x1x2. - rcondt{2} 1; 1:by move=> //= &1; skip=> &2 [#] <*>; rewrite in_dom Gm_x1x2. - case @[ambient]: {-1}(pi0.[x2]) (eq_refl (pi0.[x2])). - + move=> x2_in_pi; rcondf{2} 1. - + by move=> //= &1; skip=> &2 [#] <*>; rewrite in_dom x2_in_pi. - rcondf{2} 8. - + by move=> //= &1; auto=> &2 [#] !<<-; rewrite !in_dom x2_in_pi. - seq 2 2: ( hs0 = FRO.m{2} - /\ ch0 = G1.chandle{2} - /\ PFm = PF.m{1} - /\ PFmi = PF.mi{1} - /\ G1m = G1.m{2} - /\ G1mi = G1.mi{2} - /\ G1mh = G1.mh{2} - /\ G1mhi = G1.mhi{2} - /\ ro0 = F.RO.m{2} - /\ pi0 = G1.paths{2} - /\ (x1,x2) = x{2} - /\ !G1.bcol{2} - /\ !G1.bext{2} - /\ ={x, y1, y2} - /\ INV_CF_G1 hs0 ch0 PFm PFmi G1m G1mi G1mh G1mhi ro0 pi0). - + by auto. - case @[ambient]: {-1}(getflag hs0 x2) (eq_refl (getflag hs0 x2)). - + rewrite getflagP_none => x2f_notin_rng_hs0; rcondt{2} 3. - + move=> &1; auto=> &2 /> _ _ _; rewrite in_rng negb_exists /=. - exact/(@x2f_notin_rng_hs0 Known). - rcondf{2} 6. - + move=> &1; auto=> &2 />. - have ->: hinvK FRO.m{2}.[G1.chandle{2} <- (x2,Known)] x2 = Some G1.chandle{2}. - + rewrite (@huniq_hinvK_h G1.chandle{2} FRO.m{2}.[G1.chandle{2} <- (x2,Known)] x2) //. - + move=> hx hy [] xc xf [] yc yf /=. - rewrite !getP; case: (hx = G1.chandle{2}); case: (hy = G1.chandle{2})=> //=. - + by move=> _ + [#] - <*>; have:= (x2f_notin_rng_hs0 yf hy). - + by move=> + _ + [#] - <*>; have:= (x2f_notin_rng_hs0 xf hx). - by move=> _ _; have /hs_of_INV [] + _ _ - /(_ hx hy (xc,xf) (yc,yf)) := inv0. - by rewrite !getP. - rewrite oget_some=> _ _ _. - have -> //: !mem (dom G1.mh{2}) (x1,G1.chandle{2}). - rewrite in_dom /=; case: {-1}(G1.mh.[(x1,G1.chandle)]{2}) (eq_refl (G1.mh.[(x1,G1.chandle)]{2}))=> //= -[xa xh]; rewrite -negP. - have ^/m_mh_of_INV [] _ + /hs_of_INV [] _ _ h_handles := inv0. - by move=> /(_ x1 G1.chandle{2} xa xh) h /h [] xc xf yc yf [#] /h_handles. - case: (x2 <> y2{2} /\ (forall f h, hs0.[h] <> Some (y2{2},f))). - + auto=> &1 &2 [#] !<<- -> -> !->> {&1} /= _ x2_neq_y2 y2_notin_hs _ _. - rewrite getP /= oget_some /= -addzA /=. - rewrite (@huniq_hinvK_h ch0 hs0.[ch0 <- (x2,Known)] x2); 2:by rewrite getP. - + move=> @/huniq h1 h2 [c1 f1] [c2 f2]; rewrite !getP /=. - case: (h1 = ch0); case: (h2 = ch0)=> //=. - + by move=> _ + [#] - <*>; move: (x2f_notin_rng_hs0 f2 h2). - + by move=> + _ + [#] <*> - <*>; move: (x2f_notin_rng_hs0 f1 h1). - have /hs_of_INV [] + _ _ _ _ - h := inv0. - by apply/h; rewrite getP. - by rewrite oget_some; exact/lemma1. - conseq (_: _ ==> G1.bcol{2})=> //=. - auto=> &1 &2 [#] !<<- -> _ ->> !<<- _ /=. - case: (hinvP hs0.[ch0 <- (x2,Known)] y2{1})=> //= -> /=. - move=> hs0_spec; split=> [|f]. - + by have:= hs0_spec ch0 Known; rewrite getP. - move=> h; have:= hs0_spec h f; rewrite getP; case: (h = ch0)=> [<*>|//=]. - by move=> _; rewrite -negP; have /hs_of_INV [] _ _ H /H {H}:= inv0. - case; rewrite getflagP_some; 1,3:by have /hs_of_INV []:= inv0. - + by move=> x2_is_U; conseq (_: G1.bext{2})=> //=; auto=> &1 &2 />; rewrite x2_is_U. - move=> x2_is_K; rcondf{2} 3; 1:by move=> &1; auto. - have:= x2_is_K; rewrite in_rng=> - [hx] hs0_hx. - seq 0 3: ( hs0 = FRO.m{2} - /\ ch0 = G1.chandle{2} - /\ PFm = PF.m{1} - /\ PFmi = PF.mi{1} - /\ G1m = G1.m{2} - /\ G1mi = G1.mi{2} - /\ G1mh = G1.mh{2} - /\ G1mhi = G1.mhi{2} - /\ ro0 = F.RO.m{2} - /\ pi0 = G1.paths{2} - /\ (x1,x2) = x{2} - /\ !G1.bcol{2} - /\ !G1.bext{2} - /\ ={x,y1,y2} - /\ y{2} = (y1,y2){2} - /\ hx2{2} = hx - /\ INV_CF_G1 hs0 ch0 PFm PFmi G1m G1mi G1mh G1mhi ro0 pi0). - + auto=> &1 &2 /> _ -> /= _; split. - + move: x2_is_K; rewrite in_rng /= => -[hx2] hs_hx2. - rewrite in_rng negb_exists /==> h; rewrite -negP=> hs_h. - have /hs_of_INV [] Hhuniq _ _ := inv0. - by move: (Hhuniq _ _ _ _ hs_hx2 hs_h)=> ht; move: ht hs_h=> /= <*>; rewrite hs_hx2. - rewrite (@huniq_hinvK_h hx FRO.m{2} x2) //. - by have /hs_of_INV [] := inv0. - have x1hx_notin_G1m: !mem (dom G1mh) (x1,hx). - + rewrite in_dom; case: {-1}(G1mh.[(x1,hx)]) (eq_refl G1mh.[(x1,hx)])=> //=. - move=> [mhx1 mhx2]; rewrite -negP=> h. - have /m_mh_of_INV [] _ hg := inv0. - have [xa xh ya yh] := hg _ _ _ _ h. - by rewrite hs0_hx=> [#] <*>; rewrite PFm_x1x2. - rcondf{2} 1. - + by move=> &m; auto=> //= &hr [#] <*>; rewrite x1hx_notin_G1m. - auto=> &1 &2 [#] !<<- -> -> !->> _ /= hinv_y2_none. - rewrite getP /= oget_some /=; apply/lemma2=> //. - + by case: (hinvP hs0 y2{2})=> [_ + f h|//=] - ->. - move=> [p0 v0] ^ pi_x2. have /pi_of_INV [] -> [hx2] [#] Hpath hs_hx2:= inv0. - rcondt{2} 1. by move=> &m; auto=> &hr [#] !<<- _ _ ->> /= _; rewrite in_dom pi_x2. - rcondf{2} 6. - + auto; inline *; auto=> &hr [#] !<<- _ _ !->> _ /= _ _ _ _ /=. - by rewrite in_rng; exists hx2. - rcondf{2} 7. - + auto; inline *; auto=> &hr [#] !<<- _ _ !->> _ /= _ _ _ _ /=. - rewrite negb_and; left; rewrite (@huniq_hinvK_h hx2 hs0 x2) // 2:oget_some. - + by have /hs_of_INV []:= inv0. - rewrite in_dom; case: {-1}(G1mh.[(x1,hx2)]) (eq_refl (G1mh.[(x1,hx2)]))=> [//=|[xa xc] G1mh_x1hx2]. - have /m_mh_of_INV [] _ /(_ _ _ _ _ G1mh_x1hx2) [xc0 xf0 yc0 yf0] := inv0. - by move=> [#]; rewrite hs_hx2=> [#] !<<- {xc0 xf0}; rewrite PFm_x1x2. - rcondt{2} 15. - + auto; inline *; auto=> &hr [#] !<<- _ _ !->> _ /= _ _ _ _ /=. - by rewrite in_dom pi_x2. - inline F.RO.get. rcondt{2} 4. - + auto=> &hr [#] !<<- _ _ !->> _ /= _ _; rewrite pi_x2 oget_some /=. - rewrite in_dom; case: {-1}(ro0.[rcons p0 (v0 +^ x1)]) (eq_refl (ro0.[rcons p0 (v0 +^ x1)])). - + done. - move=> bo ^ro_pvx1 /=. have /mh_of_INV [] _ -> _:= inv0. - rewrite negb_exists=> ? /=; rewrite negb_exists=> ? /=; rewrite negb_exists=> yh /=. - rewrite Hpath /=; rewrite negb_and -implyNb /= => [#] !<<-. - rewrite xorwA xorwK xorwC xorw0 -negP=> G1mh_x1hx2. - have /m_mh_of_INV [] _ /(_ _ _ _ _ G1mh_x1hx2) := inv0. - move=> [xc xf yc yf] [#]; rewrite hs_hx2=> [#] <*>. - by rewrite PFm_x1x2. - auto => &m1 &m2 [#] !<- _ _ -> /= _ y1L -> y2L -> /=. - rewrite !getP_eq pi_x2 !oget_some /=. - have /hs_of_INV [] Hu _ _:= inv0; have -> := huniq_hinvK_h _ _ _ Hu hs_hx2. - rewrite oget_some => /= ? Hy2L . - case:inv0=> Hhs Hinv HinvG Hmmh Hmmhi Hincl Hincli Hmh Hpi. - have Hhx2:= dom_hs_neq_ch _ _ _ _ _ Hhs hs_hx2. - have mh_hx2: G1mh.[(x1,hx2)] = None. - + case Hmmh => _ /(_ x1 hx2);case (G1mh.[(x1, hx2)]) => // -[ya hy] /(_ ya hy) /=. - by rewrite -negP=> -[xc fx yc fy];rewrite hs_hx2 => -[[!<<-]];rewrite PFm_x1x2. - have ch_0 := ch_neq0 _ _ Hhs. - have ch_None : forall xa xb ha hb, G1mh.[(xa,ha)] = Some(xb, hb) => ha <> ch0 /\ hb <> ch0. - + move=> xa xb ha hb;case Hmmh=> _ H /H [xc fx yc fy [#]]. - by move=> /(dom_hs_neq_ch _ _ _ _ _ Hhs) -> /(dom_hs_neq_ch _ _ _ _ _ Hhs). - split. - + by apply hs_addh => //;have /# := hinvP hs0 y2L. - + apply inv_addm=> //; case: {-1}(G1mi.[(y1L,y2L)]) (eq_refl G1mi.[(y1L,y2L)])=> //. - move=> [x1L x2L] ^G1mi_y; rewrite -Hincli 1:G1mi_y//. - case: Hmmhi Hy2L => H _ + /H {H} [hx fx hy fy] [#]. - by case: (hinvP hs0 y2L)=> [_ ->|//]/#. - + by apply inv_addm=>//; apply (ch_notin_dom2_mh _ _ Hmmhi Hhs). - + by apply (m_mh_addh_addm _ Hmmh _ hs_hx2)=>//;apply ch_notin_dom_hs. - + apply (mi_mhi_addh_addmi _ Hmmhi _ hs_hx2);last by apply ch_notin_dom_hs. - by have := hinvP hs0 y2L;rewrite /#. - + by apply incl_addm. + by apply incl_addm. - + split. - + move=> xa hx ya hy;rewrite getP;case ((xa, hx) = (x1, hx2))=> /=. - + move=> [] !-> [] !<-; exists x2 Known y2L Known. - by rewrite !getP_eq /= getP_neq // eq_sym; apply (dom_hs_neq_ch _ _ _ Hhs hs_hx2). - move=> Hdiff Hxa; case Hmh=> /(_ _ _ _ _ Hxa) [] xc fx yc fy [#] Hhx Hhy HG1 _ _. - exists xc fx yc fy;rewrite !getP_neq //. - + by rewrite eq_sym;apply (dom_hs_neq_ch _ _ _ Hhs Hhx). - + by rewrite eq_sym;apply (dom_hs_neq_ch _ _ _ Hhs Hhy). - + rewrite /= -negP=> -[] <<- <<-;apply Hdiff=> /=. - by apply (Hu hx (x2, fx) (x2, Known)). - rewrite Hhx Hhy=> /=;move: HG1. - case: fy Hhy=> Hhy //= [p v [Hro Hbu]]. - exists p v;split. - + rewrite getP_neq // -negP => ^ /rconssI <<- /rconsIs. - move: Hbu;rewrite Hpath /= => -[!<<-] /=. - by rewrite -negP=> /Block.WRing.addrI /#. - by apply build_hpath_up=> //; move: hs_hx2 PFm_x1x2;apply: m_mh_None. - + move=> p bn b; rewrite getP. - case (rcons p bn = rcons p0 (v0 +^ x1)). - + move=> ^ /rconssI <<- /rconsIs ->> /=; split => [<<- | ]. - + exists v0 hx2 ch0. - rewrite (build_hpath_up Hpath) /=;1:by move: hs_hx2 PFm_x1x2;apply: m_mh_None. - by rewrite xorwA xorwK Block.WRing.add0r getP_eq. - move=> [v hx hy] [];rewrite getP ;case ((v +^ (v0 +^ x1), hx) = (x1, hx2)) => //. - move=> Hdiff;have HG1 := m_mh_None _ _ _ _ _ _ _ Hmmh hs_hx2 PFm_x1x2. - have -> /= [->> <<-]:= build_hpath_up_None _ _ (y1L, ch0) _ _ HG1 Hpath. - by move:Hdiff;rewrite xorwA xorwK Block.WRing.add0r. - move=> Hdiff; case Hmh => ? -> Huni. - apply exists_iff=> v /= ;apply exists_iff => hx /=;apply exists_iff => hy /=. - rewrite build_hpath_upd_ch_iff //. - case (hx = ch0) => [->>|?]. - + split;1: by move=> [] _ /ch_None. - move=> [[p0' x [Hhx2']]]. - have [!->>] [!->>]:= Huni _ _ _ _ _ Hpath Hhx2'. - by rewrite getP_neq /= ?Hhx2 // => /ch_None. - rewrite getP;case ((v +^ bn, hx) = (x1, hx2)) => //= -[<<- ->>]. - split=> -[H];have [!->>]:= Huni _ _ _ _ _ Hpath H;move:Hdiff; - by rewrite xorwA xorwK Block.WRing.add0r. - move=> p v p' v' hx;case Hmh => _ _ Huni. - rewrite !build_hpath_upd_ch_iff //. - case (hx = ch0) => [->> [?? [# H1 -> ->]] [?? [# H2 -> ->]]|_ ] /=. - + by have [!->>] := Huni _ _ _ _ _ H1 H2. - by apply Huni. - split=> c p v;rewrite getP. case (c = y2L) => [->> /= | Hc]. - + split. - + move=> [!<<-];exists ch0;rewrite getP_eq /= build_hpath_prefix. - exists v0 hx2;rewrite xorwA xorwK Block.WRing.add0r getP_eq /=. - have HG1 := m_mh_None _ _ _ _ _ _ _ Hmmh hs_hx2 PFm_x1x2. - by apply build_hpath_up_None. - move=> [h []];rewrite getP build_hpath_upd_ch_iff //. - case (h=ch0)=> [->> /= [??[# H1 -> ->]]| Hh] /=. - + by case Hmh => _ _ /(_ _ _ _ _ _ Hpath H1). - by have := hinvP hs0 y2L;rewrite /= => /#. - case Hpi => ->;apply exists_iff => h /=. - rewrite build_hpath_upd_ch_iff // getP;case (h = ch0) => [->> | //]. - split;1: by move=> [_ /(dom_hs_neq_ch _ _ _ _ _ Hhs)]. - by move=> /= [_ <<-];move:Hc. - - move=> [xa xc] PFm_x1x2. rcondf{1} 1; 1:by auto=> &hr [#] !<<- _ _ ->>; rewrite in_dom PFm_x1x2. - have /m_mh_of_INV [] + _ - /(_ _ _ _ _ PFm_x1x2) := inv0. - move=> [hx2 fx2 hy2 fy2] [#] hs_hx2 hs_hy2 G1mh_x1hx2. - case @[ambient]: {-1}(G1m.[(x1,x2)]) (eq_refl (G1m.[(x1,x2)])); last first. - + move=> [ya yc] G1m_x1x2; rcondf{2} 1; 1:by auto=> &hr [#] !<<- _ _ ->>; rewrite in_dom G1m_x1x2. - auto=> &1 &2 [#] <*> -> -> -> /=; have /incl_of_INV /(_ (x1,x2)) := inv0. - by rewrite PFm_x1x2 G1m_x1x2 /= => [#] !<<- {ya yc}. - move=> x1x2_notin_G1m; rcondt{2} 1; 1:by auto=> &hr [#] !<<- _ _ ->>; rewrite in_dom x1x2_notin_G1m. - have <*>: fy2 = Unknown. - + have /mh_of_INV [] /(_ _ _ _ _ G1mh_x1hx2) + _ := inv0. - move=> [xc0 xf0 yc0 yf0] [#]; rewrite hs_hx2 hs_hy2=> [#] !<<- [#] !<<- {xc0 xf0 yc0 yf0}. - by case: fy2 hs_hy2 G1mh_x1hx2=> //=; rewrite x1x2_notin_G1m. - case @[ambient]: fx2 hs_hx2=> hs_hx2. - + swap{2} 3 -2; seq 0 1: (G1.bext{2}); last by inline*; if{2}; auto; smt (@Block @Capacity). - by auto=> ? ? [#] !<<- _ -> ->> _ /=; rewrite in_rng; exists hx2. - have /mh_of_INV []/(_ _ _ _ _ G1mh_x1hx2) + _ _:= inv0. - move=> [xc0 xf0 yc0 yf0] [#]; rewrite hs_hx2 hs_hy2=> [#] !<<- [#] !<<- {xc0 xf0 yc0 yf0} /= [p0 v0] [#] Hro Hpath. - have /pi_of_INV [] /(_ x2 p0 v0) /iffRL /(_ _) := inv0. - + by exists hx2. - move=> pi_x2; rcondt{2} 1; 1:by auto=> &hr [#] <*>; rewrite in_dom pi_x2. - inline F.RO.get. - rcondf{2} 4; first by auto=> &hr [#] !<<- _ _ ->> _ /=; rewrite pi_x2 oget_some /= in_dom Hro. - rcondf{2} 8; first by auto=> &hr [#] !<<- _ _ ->> _ /= _ _ _ _; rewrite in_rng; exists hx2. - rcondt{2} 9. - + auto=> &hr [#] !<<- _ _ ->> _ /= _ _ _ _. - rewrite (@huniq_hinvK_h hx2 hs0 x2) // 2:in_dom 2:G1mh_x1hx2 2:!oget_some /=. - + by have /hs_of_INV []:= inv0. - by rewrite /in_dom_with in_dom hs_hy2. - rcondt{2} 14; first by auto=> &hr [#] !<<- _ _ ->> _ /=; rewrite in_dom pi_x2. - auto=> &1 &2 [#] !<<- -> -> ->> _ /=; rewrite Block.DBlock.dunifin_ll Capacity.DCapacity.dunifin_ll /=. - move=> _ _ _ _; rewrite PFm_x1x2 pi_x2 !oget_some //=. - rewrite (@huniq_hinvK_h hx2 hs0 x2) // ?oget_some. - + by have /hs_of_INV []:= inv0. - rewrite Hro G1mh_x1hx2 hs_hy2 ?oget_some //= => _. - exact/(@lemma3 _ _ _ _ _ _ _ _ _ _ _ _ hx2 _ _ hy2). - (* lossless PF.f *) - + move=> &2 _; proc; if=> //=; wp; rnd predT; rnd predT; auto. - smt (@Block.DBlock @Capacity.DCapacity). - (* lossless and do not reset bad G1.S.f *) - + move=> _; proc; if; auto. - conseq (_: _ ==> G1.bcol \/ G1.bext); 1:smt (). - inline *; if=> //=; wp; rnd predT; wp; rnd predT; auto. - + smt (@Block.DBlock @Capacity.DCapacity). - smt (@Block.DBlock @Capacity.DCapacity). - (** proofs for G1.S.fi *) - (* equiv PF.P.fi G1.S.fi *) - + by conseq (eq_fi D)=> /#. - (* lossless PF.P.fi *) - + move=> &2 _; proc; if=> //=; wp; rnd predT; rnd predT; auto. - smt (@Block.DBlock @Capacity.DCapacity). - (* lossless and do not reset bad G1.S.fi *) - + move=> _; proc; if; 2:by auto. - by wp; do 2!rnd predT; auto => &hr [#]; smt (@Block.DBlock @Capacity.DCapacity). - (** proofs for G1.C.f *) - (* equiv PF.C.f G1.C.f *) - + proc. - inline*;sp. admit. (* this is false *) - (* lossless PF.C.f *) - + move=> &2 _; proc; inline *; while (true) (size p); auto. - + sp; if; 2:by auto; smt (size_behead). - by wp; do 2!rnd predT; auto; smt (size_behead @Block.DBlock @Capacity.DCapacity). - smt (size_ge0). - (* lossless and do not reset bad G1.C.f *) - + move=> _; proc; inline *; wp; rnd predT; auto. - while (G1.bcol \/ G1.bext) (size p - i)=> [z|]. - + if; 1:by auto=> /#. - wp; rnd predT; wp; rnd predT; auto. - smt (@Block.DBlock @Capacity.DCapacity). - by auto; smt (@Block.DBlock @Capacity.DCapacity). - (* Init ok *) - inline *; auto=> />; split=> [|/#]. - (do !split; last 3 smt (getP map0P build_hpath_map0)); last 5 by move=> ? ? ? ?; rewrite map0P. - + move=> h1 h2 ? ?; rewrite !getP !map0P. - by case: (h1 = 0); case: (h2 = 0)=> //=. - + by rewrite getP. - + by move=> ? h; rewrite getP map0P; case: (h = 0). - + by move=> ? ?; rewrite !map0P. - by move=> ? ?; rewrite !map0P. -qed. - -end section AUX. - -section. - - declare module D: DISTINGUISHER{Perm, C, PF, G1, RO}. - - axiom D_ll (F <: DFUNCTIONALITY{D}) (P <: DPRIMITIVE{D}): - islossless P.f => islossless P.fi => - islossless F.f => islossless D(F, P).distinguish. - - lemma Real_G1 &m: - Pr[GReal(D).main() @ &m: res /\ C.c <= max_size] <= - Pr[G1(DRestr(D)).main() @ &m: res] + (max_size ^ 2)%r * mu dstate (pred1 witness) + - Pr[G1(DRestr(D)).main() @&m: G1.bcol] + Pr[G1(DRestr(D)).main() @&m: G1.bext]. - proof. - apply (@RealOrder.ler_trans _ _ _ (Real_Concrete D D_ll &m)). - cut : Pr[CF(DRestr(D)).main() @ &m : res] <= - Pr[G1(DRestr(D)).main() @ &m : res] + - Pr[G1(DRestr(D)).main() @ &m : G1.bcol \/ G1.bext]. - + byequiv (CF_G1 (DRestr(D)) _)=>//;1:by apply (DRestr_ll D D_ll). - smt ml=0. - cut /# : Pr[G1(DRestr(D)).main() @ &m : G1.bcol \/ G1.bext] <= - Pr[G1(DRestr(D)).main() @ &m : G1.bcol] + - Pr[G1(DRestr(D)).main() @ &m : G1.bext]. - rewrite Pr [mu_or]; smt. - qed. - -end section. - - diff --git a/proof/core/IndifPadding.ec b/proof/core/IndifPadding.ec deleted file mode 100644 index 192ca69..0000000 --- a/proof/core/IndifPadding.ec +++ /dev/null @@ -1,123 +0,0 @@ -require import Fun Pair Real NewFMap. -require (*..*) Indifferentiability LazyRO. - -clone import Indifferentiability as Ind1. - -clone import Indifferentiability as Ind2 - with type p <- Ind1.p, - type f_out <- Ind1.f_out. - -op pad : Ind2.f_in -> Ind1.f_in. -op padinv : Ind1.f_in -> Ind2.f_in. -axiom cancel_pad : cancel pad padinv. -axiom cancel_padinv : cancel padinv pad. - -clone import LazyRO as RO1 - with type from <- Ind1.f_in, - type to <- Ind1.f_out. - -clone import LazyRO as RO2 - with type from <- Ind2.f_in, - type to <- Ind1.f_out, - op d <- RO1.d. - -module ConstrPad (FC:Ind1.CONSTRUCTION, P:Ind1.DPRIMITIVE) = { - module C = FC(P) - - proc init = C.init - - proc f (x:Ind2.f_in) : f_out = { - var r; - r = C.f(pad x); - return r; - } -}. - -module DistPad(FD: Ind2.DISTINGUISHER, F:Ind1.DFUNCTIONALITY, P:Ind1.DPRIMITIVE) = { - module Fpad = { - proc f(x:Ind2.f_in) : f_out = { - var r; - r = F.f(pad x); - return r; - } - } - - proc distinguish = FD(Fpad,P).distinguish -}. - -module SimPadinv(S:Ind1.SIMULATOR, F2:Ind2.DFUNCTIONALITY) = { - module F1 = { - proc f(x:Ind1.f_in):Ind1.f_out = { - var r; - r = F2.f(padinv x); - return r; - } - } - - module S2 = S(F1) - - proc init = S2.init - - proc f = S2.f - proc fi = S2.fi -}. - -section Reduction. - declare module P : Ind1.PRIMITIVE. (* It is compatible with Ind2.Primitive *) - declare module C : Ind1.CONSTRUCTION {P}. - declare module S : Ind1.SIMULATOR{ RO1.H, RO2.H}. - - declare module D' : Ind2.DISTINGUISHER{P,C, RO1.H, RO2.H, S}. - - local equiv ConstrDistPad: - Ind2.GReal(ConstrPad(C), P, D').main ~ - Ind1.GReal(C, P, DistPad(D')).main : ={glob P, glob C, glob D'} ==> - ={glob P, glob C, glob D', res}. - proof. by sim. qed. - - local lemma PrConstrDistPad &m: - Pr[ Ind2.GReal(ConstrPad(C), P, D').main() @ &m : res] = - Pr[ Ind1.GReal(C, P, DistPad(D')).main() @ &m : res]. - proof. by byequiv ConstrDistPad. qed. - - local equiv DistH2H1: - Ind2.GIdeal(RO2.H, SimPadinv(S), D').main ~ - Ind1.GIdeal(RO1.H, S, DistPad(D')).main : - ={glob D', glob S} ==> - ={glob D',glob S, res} /\ forall x, RO2.H.m{1}.[padinv x] = RO1.H.m{2}.[x]. - proof. - proc. - call (_: ={glob S} /\ forall x, RO2.H.m{1}.[padinv x] = RO1.H.m{2}.[x]). - + proc *;inline *. - call (_: forall x, RO2.H.m{1}.[padinv x] = RO1.H.m{2}.[x]);auto. - proc;inline *;wp;sp;if;first by progress [-split];rewrite !in_dom H. - + auto;progress;first by rewrite !getP_eq. - by rewrite !getP (can_eq _ _ cancel_padinv) H. - by auto;progress;rewrite H. - + proc *;inline *. - call (_: forall x, RO2.H.m{1}.[padinv x] = RO1.H.m{2}.[x]);auto. - proc;inline *;wp;sp;if;first by progress [-split];rewrite !in_dom H. - + auto;progress;first by rewrite !getP_eq. - by rewrite !getP (can_eq _ _ cancel_padinv) H. - by auto;progress;rewrite H. - + proc;inline *;wp;sp;if;first by progress[-split];rewrite -{1}(cancel_pad x{2}) !in_dom H. - + auto;progress;first by rewrite !getP_eq. - by rewrite !getP (eq_sym x1) (can2_eq _ _ cancel_pad cancel_padinv) (eq_sym x{2}) H. - by auto;progress;rewrite -H cancel_pad. - inline *;wp. call (_: ={glob D'}). - auto;progress;by rewrite !map0P. - qed. - - local lemma PrDistH2H1 &m: - Pr[Ind2.GIdeal(RO2.H,SimPadinv(S),D').main() @ &m : res] = - Pr[Ind1.GIdeal(RO1.H,S, DistPad(D')).main() @ &m : res]. - proof. by byequiv DistH2H1. qed. - - lemma Conclusion &m: - `| Pr[Ind2.GReal (ConstrPad(C), P , D' ).main() @ &m : res] - - Pr[Ind2.GIdeal(RO2.H , SimPadinv(S), D' ).main() @ &m : res] | = - `| Pr[Ind1.GReal (C , P , DistPad(D')).main() @ &m : res] - - Pr[Ind1.GIdeal(RO1.H , S , DistPad(D')).main() @ &m : res] |. - proof. by rewrite (PrConstrDistPad &m) (PrDistH2H1 &m). qed. - -end section Reduction. diff --git a/proof/core/LazyRO.eca b/proof/core/LazyRO.eca deleted file mode 100644 index 96136e7..0000000 --- a/proof/core/LazyRO.eca +++ /dev/null @@ -1,22 +0,0 @@ -require import Option FSet NewFMap. -require (*..*) NewROM. - -type from, to. -op d: to distr. - -clone include NewROM with - type from <- from, - type to <- to, - op dsample <- fun (x:from) => d. - - -module H = { - var m : (from, to) fmap - - proc init() = { m = map0; } - - proc f(x) = { - if (!mem (dom m) x) m.[x] = $d; - return oget m.[x]; - } -}. diff --git a/proof/core/SLCommon.ec b/proof/core/SLCommon.ec deleted file mode 100644 index d46259d..0000000 --- a/proof/core/SLCommon.ec +++ /dev/null @@ -1,395 +0,0 @@ -(** This is a theory for the Squeezeless sponge: where the ideal - functionality is a fixed-output-length random oracle whose output - length is the input block size. We prove its security even when - padding is not prefix-free. **) -require import Core Int Real StdOrder Ring. -require import List FSet NewFMap Utils Common RndO DProd Dexcepted. - -require (*..*) Indifferentiability. -(*...*) import Capacity IntOrder. - -type state = block * capacity. -op dstate = bdistr `*` cdistr. - -clone include Indifferentiability with - type p <- state, - type f_in <- block list, - type f_out <- block - rename [module] "GReal" as "RealIndif" - [module] "GIdeal" as "IdealIndif". - -(** max number of call to the permutation and its inverse, - including those performed by the construction. *) -op max_size : { int | 0 <= max_size } as max_ge0. - -(** Ideal Functionality **) -clone export Tuple as TupleBl with - type t <- block, - op Support.enum <- Block.blocks - proof Support.enum_spec by exact Block.enum_spec. - -op bl_enum = flatten (mkseq (fun i => wordn i) (max_size + 1)). -op bl_univ = FSet.oflist bl_enum. - -(* -------------------------------------------------------------------------- *) -(* Random oracle from block list to block *) -clone import RndO.GenEager as F with - type from <- block list, - type to <- block, - op sampleto <- fun (_:block list)=> bdistr - proof * by exact Block.DBlock.dunifin_ll. - -(** We can now define the squeezeless sponge construction **) -module SqueezelessSponge (P:DPRIMITIVE): FUNCTIONALITY = { - proc init () = {} - - proc f(p : block list): block = { - var (sa,sc) <- (b0,c0); - - while (p <> []) { (* Absorption *) - (sa,sc) <@ P.f((sa +^ head witness p,sc)); - p <- behead p; - } - - return sa; (* Squeezing phase (non-iterated) *) - } -}. - -clone export DProd.ProdSampling as Sample2 with - type t1 <- block, - type t2 <- capacity, - op d1 <- bdistr, - op d2 <- cdistr. - -(* -------------------------------------------------------------------------- *) -(** TODO move this **) - -op incl (m m':('a,'b)fmap) = - forall x, m .[x] <> None => m'.[x] = m.[x]. - -(* -------------------------------------------------------------------------- *) -(** usefull type and operators for the proof **) - -type handle = int. - -type hstate = block * handle. - -type ccapacity = capacity * flag. - -type smap = (state , state ) fmap. -type hsmap = (hstate, hstate ) fmap. -type handles = (handle, ccapacity) fmap. - -pred is_pre_permutation (m mi : ('a,'a) fmap) = - (forall x, mem (rng m) x => mem (dom mi) x) - /\ (forall x, mem (rng mi) x => mem (dom m) x). - -lemma half_permutation_set (m' mi' : ('a,'a) fmap) x' y': - (forall x, mem (rng m') x => mem (dom mi') x) - => (forall x, mem (rng m'.[x' <- y']) x => mem (dom mi'.[y' <- x']) x). -proof. - move=> h x0. - rewrite rng_set domP !in_fsetU in_fset1 => -[/rng_rem_le in_rng|//=]. - by rewrite h. -qed. - -lemma pre_permutation_set (m mi : ('a,'a) fmap) x y: - is_pre_permutation m mi => - is_pre_permutation m.[x <- y] mi.[y <- x]. -proof. - move=> [dom_mi dom_m]. - by split; apply/half_permutation_set. -qed. - -(* Functionnal version of the construction using handle *) - -op step_hpath (mh:hsmap) (sah:hstate option) (b:block) = - if sah = None then None - else - let sah = oget sah in - mh.[(sah.`1 +^ b, sah.`2)]. - -op build_hpath (mh:hsmap) (bs:block list) = - foldl (step_hpath mh) (Some (b0,0)) bs. - -inductive build_hpath_spec mh p v h = - | Empty of (p = []) - & (v = b0) - & (h = 0) - | Extend p' b v' h' of (p = rcons p' b) - & (build_hpath mh p' = Some (v',h')) - & (mh.[(v' +^ b,h')] = Some (v,h)). - -lemma build_hpathP mh p v h: - build_hpath mh p = Some (v,h) <=> build_hpath_spec mh p v h. -proof. -elim/last_ind: p v h=> @/build_hpath //= [v h|p b ih v h]. -+ by rewrite andaE; split=> [!~#] <*>; [exact/Empty|move=> [] /#]. -rewrite -{1}cats1 foldl_cat {1}/step_hpath /=. -case: {-1}(foldl _ _ _) (eq_refl (foldl (step_hpath mh) (Some (b0,0)) p))=> //=. -+ apply/implybN; case=> [/#|p' b0 v' h']. - move=> ^/rconssI <<- {p'} /rconsIs ->> {b}. - by rewrite /build_hpath=> ->. -move=> [v' h']; rewrite oget_some /= -/(build_hpath _ _)=> build. -split. -+ by move=> mh__; apply/(Extend mh (rcons p b) v h p b v' h' _ build mh__). -case=> [/#|] p' b' v'' h'' ^/rconssI <<- {p'} /rconsIs <<- {b'}. -by rewrite build /= => [#] <*>. -qed. - -lemma build_hpath_map0 p: - build_hpath map0 p - = if p = [] then Some (b0,0) else None. -proof. -elim/last_ind: p=> //= p b _. -by rewrite -{1}cats1 foldl_cat {1}/step_hpath /= map0P /= /#. -qed. - -(* -------------------------------------------------------------------------- *) - -module C = { - var c:int - proc init () = { c <- 0; } -}. - -module PC (P:PRIMITIVE) = { - - proc init () = { - C.init(); - P.init(); - } - - proc f (x:state) = { - var y; - C.c <- C.c + 1; - y <@ P.f(x); - return y; - } - - proc fi(x:state) = { - var y; - C.c <- C.c + 1; - y <@ P.fi(x); - return y; - } - -}. - -module DPRestr (P:DPRIMITIVE) = { - - proc f (x:state) = { - var y=(b0,c0); - if (C.c + 1 <= max_size) { - C.c <- C.c + 1; - y <@ P.f(x); - } - return y; - } - - proc fi(x:state) = { - var y=(b0,c0); - if (C.c + 1 <= max_size) { - C.c <- C.c + 1; - y <@ P.fi(x); - } - return y; - } - -}. - -module PRestr (P:PRIMITIVE) = { - - proc init () = { - C.init(); - P.init(); - } - - proc f = DPRestr(P).f - - proc fi = DPRestr(P).fi - -}. - -module FC(F:FUNCTIONALITY) = { - - proc init = F.init - - proc f (bs:block list) = { - var b= b0; - C.c <- C.c + size bs; - b <@ F.f(bs); - return b; - } -}. - -module DFRestr(F:DFUNCTIONALITY) = { - - proc f (bs:block list) = { - var b= b0; - if (C.c + size bs <= max_size) { - C.c <- C.c + size bs; - b <@ F.f(bs); - } - return b; - } -}. - -module FRestr(F:FUNCTIONALITY) = { - - proc init = F.init - - proc f = DFRestr(F).f - -}. - -(* -------------------------------------------------------------------------- *) -(* This allow swap the counting from oracle to adversary *) -module DRestr(D:DISTINGUISHER, F:DFUNCTIONALITY, P:DPRIMITIVE) = { - proc distinguish() = { - var b; - C.init(); - b <@ D(DFRestr(F), DPRestr(P)).distinguish(); - return b; - } -}. - -lemma rp_ll (P<:DPRIMITIVE): islossless P.f => islossless DPRestr(P).f. -proof. move=>Hll;proc;sp;if=>//;call Hll;auto. qed. - -lemma rpi_ll (P<:DPRIMITIVE): islossless P.fi => islossless DPRestr(P).fi. -proof. move=>Hll;proc;sp;if=>//;call Hll;auto. qed. - -lemma rf_ll (F<:DFUNCTIONALITY): islossless F.f => islossless DFRestr(F).f. -proof. move=>Hll;proc;sp;if=>//;call Hll;auto. qed. - -lemma DRestr_ll (D<:DISTINGUISHER{C}): - (forall (F<:DFUNCTIONALITY{D})(P<:DPRIMITIVE{D}), - islossless P.f => islossless P.fi => islossless F.f => - islossless D(F,P).distinguish) => - forall (F <: DFUNCTIONALITY{DRestr(D)}) (P <: DPRIMITIVE{DRestr(D)}), - islossless P.f => - islossless P.fi => islossless F.f => islossless DRestr(D, F, P).distinguish. -proof. - move=> D_ll F P p_ll pi_ll f_ll;proc. - call (D_ll (DFRestr(F)) (DPRestr(P)) _ _ _). - + by apply (rp_ll P). + by apply (rpi_ll P). + by apply (rf_ll F). - by inline *;auto. -qed. - -section RESTR. - - declare module F:FUNCTIONALITY{C}. - declare module P:PRIMITIVE{C,F}. - declare module D:DISTINGUISHER{F,P,C}. - - lemma swap_restr &m: - Pr[Indif(FRestr(F), PRestr(P), D).main()@ &m: res] = - Pr[Indif(F,P,DRestr(D)).main()@ &m: res]. - proof. - byequiv=>//. - proc;inline *;wp;swap{1}1 2;sim. - qed. - -end section RESTR. - -section COUNT. - - declare module P:PRIMITIVE{C}. - declare module CO:CONSTRUCTION{C,P}. - declare module D:DISTINGUISHER{C,P,CO}. - - axiom f_ll : islossless P.f. - axiom fi_ll : islossless P.fi. - - axiom CO_ll : islossless CO(P).f. - - axiom D_ll (F <: DFUNCTIONALITY{D}) (P <: DPRIMITIVE{D}): - islossless P.f => islossless P.fi => islossless F.f => - islossless D(F, P).distinguish. - - lemma Pr_restr &m : - Pr[Indif(FC(CO(P)), PC(P), D).main()@ &m:res /\ C.c <= max_size] <= - Pr[Indif(CO(P), P, DRestr(D)).main()@ &m:res]. - proof. - byequiv (_: ={glob D, glob P, glob CO} ==> C.c{1} <= max_size => ={res})=>//; - 2:by move=> ??H[]?/H<-. - symmetry;proc;inline *;wp;swap{2}1 2. - call (_: max_size < C.c, ={glob P, glob CO, glob C}). - + apply D_ll. - + proc; sp 1 0;if{1};1:by call(_:true);auto. - by call{2} f_ll;auto=>/#. - + by move=> ?_;proc;sp;if;auto;call f_ll;auto. - + by move=> _;proc;call f_ll;auto=>/#. - + proc;sp 1 0;if{1};1:by call(_:true);auto. - by call{2} fi_ll;auto=>/#. - + by move=> ?_;proc;sp;if;auto;call fi_ll;auto. - + by move=> _;proc;call fi_ll;auto=>/#. - + proc;sp 1 0;if{1};1:by call(_: ={glob P});auto;sim. - by call{2} CO_ll;auto=>/#. - + by move=> ?_;proc;sp;if;auto;call CO_ll;auto. - + move=> _;proc;call CO_ll;auto;smt ml=0 w=size_ge0. - wp;call (_:true);call(_:true);auto=>/#. - qed. - -end section COUNT. - -(* -------------------------------------------------------------------------- *) -(** Operators and properties of handles *) -op hinv (handles:handles) (c:capacity) = - find (fun _ => pred1 c \o fst) handles. - -op hinvK (handles:handles) (c:capacity) = - find (fun _ => pred1 c) (restr Known handles). - -op huniq (handles:handles) = - forall h1 h2 cf1 cf2, - handles.[h1] = Some cf1 => - handles.[h2] = Some cf2 => - cf1.`1 = cf2.`1 => h1 = h2. - -lemma hinvP handles c: - if hinv handles c = None then forall h f, handles.[h] <> Some(c,f) - else exists f, handles.[oget (hinv handles c)] = Some(c,f). -proof. - cut @/pred1@/(\o)/=[[h []->[]Hmem <<-]|[]->H h f]/= := - findP (fun (_ : handle) => pred1 c \o fst) handles. - + by exists (oget handles.[h]).`2;rewrite oget_some get_oget;2:case (oget handles.[h]). - cut := H h;rewrite in_dom/#. -qed. - -lemma huniq_hinv (handles:handles) (h:handle): - huniq handles => mem (dom handles) h => hinv handles (oget handles.[h]).`1 = Some h. -proof. - move=> Huniq;pose c := (oget handles.[h]).`1. - cut:=Huniq h;cut:=hinvP handles c. - case (hinv _ _)=> /=[Hdiff _| h' +/(_ h')];1:by rewrite in_dom /#. - by move=> [f ->] /(_ (oget handles.[h]) (c,f)) H1 H2;rewrite H1 // get_oget. -qed. - -lemma hinvKP handles c: - if hinvK handles c = None then forall h, handles.[h] <> Some(c,Known) - else handles.[oget (hinvK handles c)] = Some(c,Known). -proof. - rewrite /hinvK. - cut @/pred1/= [[h]|][->/=]:= findP (+ pred1 c) (restr Known handles). - + by rewrite oget_some in_dom restrP;case (handles.[h])=>//= /#. - by move=>+h-/(_ h);rewrite in_dom restrP => H1/#. -qed. - -lemma huniq_hinvK (handles:handles) c: - huniq handles => mem (rng handles) (c,Known) => handles.[oget (hinvK handles c)] = Some(c,Known). -proof. - move=> Huniq;rewrite in_rng=> -[h]H;case: (hinvK _ _) (Huniq h) (hinvKP handles c)=>//=. - by move=>_/(_ h);rewrite H. -qed. - -lemma huniq_hinvK_h h (handles:handles) c: - huniq handles => handles.[h] = Some (c,Known) => hinvK handles c = Some h. -proof. - move=> Huniq;case: (hinvK _ _) (hinvKP handles c)=>/= [H|h'];1: by apply H. - by rewrite oget_some=> /Huniq H/H. -qed. - -(* -------------------------------------------------------------------------- *) -(** The initial Game *) -module GReal(D:DISTINGUISHER) = RealIndif(SqueezelessSponge, PC(Perm), D). diff --git a/proof/core/Utils.ec b/proof/core/Utils.ec deleted file mode 100644 index 3f2b506..0000000 --- a/proof/core/Utils.ec +++ /dev/null @@ -1,63 +0,0 @@ -(** These should make it into the standard libs **) -require import Core List FSet NewFMap. - -(* -------------------------------------------------------------------- *) - (* In NewFMap *) - -op reindex (f : 'a -> 'c) (m : ('a, 'b) fmap) = - NewFMap.oflist (map (fun (x : 'a * 'b) => (f x.`1,x.`2)) (elems m)) - axiomatized by reindexE. - - - -lemma dom_reindex (f : 'a -> 'c) (m : ('a, 'b) fmap) x: - mem (dom (reindex f m)) x <=> mem (image f (dom m)) x. -proof. - rewrite reindexE dom_oflist imageP mapP /fst; split. - move=> [[x' y] [+ ->>]]. - rewrite mapP=> -[[x0 y0]] /= [h [->> ->>]] {x' y}. - by exists x0; rewrite domE mem_oflist mapP /fst; exists (x0,y0). - move=> [a] [a_in_m <<-]. - exists (f a,oget m.[a])=> /=; rewrite mapP /=. - exists (a,oget m.[a])=> //=. - have:= a_in_m; rewrite in_dom; case {-1}(m.[a]) (eq_refl m.[a])=> //=. - by move=> y; rewrite getE mem_assoc_uniq 1:uniq_keys. -qed. - - -lemma reindex_injective_on (f : 'a -> 'c) (m : ('a, 'b) fmap): - (forall x y, mem (dom m) x => f x = f y => x = y) => - (forall x, m.[x] = (reindex f m).[f x]). -proof. - move=> f_pinj x. - pose s:= elems (reindex f m). - case (assocP s (f x)). - rewrite -dom_oflist {1}/s elemsK dom_reindex imageP. - move=> [[a]] [] /f_pinj h /(h x) ->> {a}. - rewrite !getE. - move=> [y] [+ ->]. - rewrite /s reindexE. - pose s':= map (fun (x : 'a * 'b) => (f x.`1,x.`2)) (elems m). - have <- := (perm_eq_mem _ _ (oflistK s')). - (** FIXME: make this a lemma **) - have h' /h': forall (s : ('c * 'b) list) x, mem (reduce s) x => mem s x. - rewrite /reduce=> s0 x0; rewrite -{2}(cat0s s0); pose acc:= []. - elim s0 acc x0=> {s'} [acc x0 /=|x' s' ih acc x0 /=]. - by rewrite cats0. - move=> /ih; rewrite -cat1s catA cats1 !mem_cat=> -[|-> //=]. - rewrite /augment; case (mem (map fst acc) x'.`1)=> _ h'; left=> //. - by rewrite mem_rcons /=; right. - rewrite /s' mapP=> -[[a' b']] /= [xy_in_m []]. - rewrite eq_sym. have h0 /h0 ->> <<- {a' b'}:= f_pinj a' x _; 1:by smt. - by apply/mem_assoc_uniq; 1:exact uniq_keys. - rewrite -mem_oflist {1}/s -domE=> -[] h; have := h; rewrite dom_reindex. - rewrite imageP=> h'. have {h'} h': forall (a : 'a), !mem (dom m) a \/ f a <> f x by smt. - have /= := h' x. - rewrite in_dom !getE /=. - by move=> -> ->. -qed. - -lemma reindex_injective (f : 'a -> 'c) (m : ('a, 'b) fmap): - injective f => - (forall x, m.[x] = (reindex f m).[f x]). -proof. by move=> f_inj; apply/reindex_injective_on=> + + _. qed. diff --git a/proof/smart_counter/CoreToBlockSponge.eca b/proof/smart_counter/CoreToBlockSponge.eca deleted file mode 100644 index 6cf2b01..0000000 --- a/proof/smart_counter/CoreToBlockSponge.eca +++ /dev/null @@ -1,165 +0,0 @@ -(* -------------------------------------------------------------------- *) -require import Option Pair Int Real Distr List FSet NewFMap DProd. -require import BlockSponge. - -require (*--*) Core. - -op max_query : int. -axiom max_query_ge0: 0 <= max_query. - -clone Core as CoreConstruction with - op Block.r <- Common.r, - type Block.block <- Common.block, - op Block.b0 <- Common.Block.b0, - op Block.(+^) <- Common.Block.(+^), - op Block.enum <- Common.Block.blocks, - op Capacity.c <- Common.c, - type Capacity.capacity <- Common.capacity, - op Capacity.c0 <- Common.Capacity.c0, - op Capacity.enum <- Common.Capacity.caps, - op max_query <- max_query -proof *. -realize Block.r_ge0 by exact/Common.ge0_r. -search Common.Block.(+^). -realize Block.addbA by exact/Common.Block.addwA. - -(*---*) import Common Perm. - -(* -------------------------------------------------------------------- *) -section PROOF. - declare module D:DISTINGUISHER { Perm, Gconcl.IF, SLCommon.C, Gconcl.S, BIRO.IRO }. - - module Wrap (D : DISTINGUISHER) (F : DFUNCTIONALITY) (P : DPRIMITIVE) = { - module WF = { - proc f(x : block list * int) = { - var r <- []; - var p, n; - - (p,n) <- x; - if (valid_block p /\ 0 < n) { - r <@ F.f(x); - } - return r; - } - } - - proc distinguish = D(WF,P).distinguish - }. - - module LowerF (F:DFUNCTIONALITY) = { - proc f(m:block list) : block = { - var r <- []; - var p, n; - - (p,n) <- strip m; - if (p <> []) { - r <- F.f(p,n); - } - return last b0 r; - } - }. - - module RaiseF (F:SLCommon.DFUNCTIONALITY) = { - proc f(m:block list, n:int) : block list = { - var i, r, b; - r <- []; - - if (m <> []) { - i <- 0; - b <- b0; - while (i < n) { - b <- F.f(extend m i); - r <- rcons r b; - i <- i + 1; - - } - } - return r; - } - }. - - module LowerDist(D : DISTINGUISHER, F : SLCommon.DFUNCTIONALITY) = - D(RaiseF(F)). - - module RaiseSim(S:SLCommon.SIMULATOR, F:DFUNCTIONALITY) = - S(LowerF(F)). - - local equiv f_f: BIRO.IRO.f ~ RaiseF(Gconcl.IF).f: - ={n} /\ x{1} = m{2} - /\ 0 <= n{2} - /\ valid_block x{1} - /\ (forall p n, BIRO.IRO.mp{1}.[(p,n)] <> None => last b0 p <> b0) - /\ (forall p, SLCommon.F.RO.m{2}.[p] = BIRO.IRO.mp{1}.[strip p]) - ==> ={res} - /\ (forall p n, BIRO.IRO.mp{1}.[(p,n)] <> None => last b0 p <> b0) - /\ (forall p, SLCommon.F.RO.m{2}.[p] = BIRO.IRO.mp{1}.[strip p]). - proof. - proc. rcondt{2} 2; 1:by auto=> /#. rcondt{1} 3; 1:by auto=> /#. - inline *. wp. - while ( ={i,n} /\ x{1} = m{2} /\ bs{1} = r{2} - /\ 0 <= i{2} <= n{2} - /\ last b0 x{1} <> b0 - /\ (forall p n, BIRO.IRO.mp{1}.[(p,n)] <> None => last b0 p <> b0) - /\ (forall p, SLCommon.F.RO.m{2}.[p] = BIRO.IRO.mp{1}.[strip p])). - + sp; if{1}. - + rcondt{2} 2. - + auto=> &hr [#] !->> i_ge0 i_lt_n wf hinv1 hinv2 _ _ + _ _. - by rewrite !in_dom /= hinv2 extendK. - auto=> &1 &2 /= [#] !->> i_ge0 _ wf inv1 inv2 i_lt_n _. - rewrite in_dom wf=> mp_xi r -> /=; split; first by rewrite !getP. - split=> [/#|]; split=> [p n|p]. - + by rewrite getP; case: ((p,n) = (m,i){2})=> [[#] <*>|_ /inv1]. - rewrite !getP; case: (strip p = (m,i){2})=> [strip_p|]. - + by have := stripK p; rewrite strip_p=> /= ->. - case: (p = extend m{2} i{2})=> [<*>|_ _]; first by rewrite extendK. - exact/inv2. - rcondf{2} 2. - + auto=> &hr [#] !->> i_ge0 i_lt_n wf hinv1 hinv2 _ _ + _ _. - by rewrite !in_dom /= hinv2 extendK. - by auto=> &1 &2; smt (DWord.bdistr_ll extendK). - by auto; smt (valid_block_ends_not_b0). - qed. - - lemma conclusion &m: - `| Pr[RealIndif(Sponge,Perm,Wrap(D)).main() @ &m : res] - - Pr[IdealIndif(BIRO.IRO,RaiseSim(Gconcl.S),Wrap(D)).main() @ &m : res] | - = `| Pr[SLCommon.RealIndif(SLCommon.SqueezelessSponge,SLCommon.PC(Perm),LowerDist(Wrap(D))).main() @ &m : res] - - Pr[SLCommon.IdealIndif(Gconcl.IF,Gconcl.S,LowerDist(Wrap(D))).main() @ &m : res] |. - proof. - do 3?congr. - + byequiv (_: ={glob D} ==> _)=> //; proc; inline *. - call (_: ={glob Perm}). - + by proc; inline *; wp; sim. - + by proc; inline *; wp; sim. - + proc; sp; if=> //. - call (_: ={glob Perm, arg} - /\ valid_block xs{1} /\ 0 < n{1} - ==> ={glob Perm, res}). - + proc. rcondt{1} 4; 1:by auto. rcondt{2} 2; 1:by auto; smt (valid_block_ends_not_b0). - rcondt{2} 4; 1:by auto. - inline{2} SLCommon.SqueezelessSponge(SLCommon.PC(Perm)).f. - seq 4 6: ( ={glob Perm, n, i, sa, sc} - /\ (* some notion of path through Perm.m *) true). - + while ( ={glob Perm, sa, sc} - /\ xs{1} = p{2} - /\ (* some notion of path through Perm.m *) true). - + wp; call (_: ={glob Perm}). - + by inline *; wp; sim. - by auto=> /> /#. - by auto=> &1 &2 [#] !<<- vblock n_gt0 /=; rewrite /extend nseq0 cats0. - (* make sure that the notion of path guarantees that only the last call of each iteration adds something to the map, and that it is exactly the right call *) - admit. - by auto=> /#. - by auto. - byequiv (_: ={glob D} ==> _)=> //; proc; inline *. - call (_: ={glob S} - /\ (forall p n, BIRO.IRO.mp{1}.[(p,n)] <> None => last b0 p <> b0) - /\ (forall p, SLCommon.F.RO.m{2}.[p] = BIRO.IRO.mp{1}.[strip p]) - /\ (* relation between S.paths and presence in the RO map *) true). - + proc. if=> //=; last by auto. if=> //=; last by auto. - inline *. admit. (* something about valid queries *) - + admit. (* prove: S(LowerF(BIRO.IRO)).fi ~ S(IF).fi *) - + by proc; sp; if=> //; call (f_f); auto=> /#. - by auto=> />; split=> [?|] ?; rewrite !map0P. - qed. -end section PROOF. diff --git a/proof/smart_counter/IndifPadding.ec b/proof/smart_counter/IndifPadding.ec deleted file mode 100644 index 192ca69..0000000 --- a/proof/smart_counter/IndifPadding.ec +++ /dev/null @@ -1,123 +0,0 @@ -require import Fun Pair Real NewFMap. -require (*..*) Indifferentiability LazyRO. - -clone import Indifferentiability as Ind1. - -clone import Indifferentiability as Ind2 - with type p <- Ind1.p, - type f_out <- Ind1.f_out. - -op pad : Ind2.f_in -> Ind1.f_in. -op padinv : Ind1.f_in -> Ind2.f_in. -axiom cancel_pad : cancel pad padinv. -axiom cancel_padinv : cancel padinv pad. - -clone import LazyRO as RO1 - with type from <- Ind1.f_in, - type to <- Ind1.f_out. - -clone import LazyRO as RO2 - with type from <- Ind2.f_in, - type to <- Ind1.f_out, - op d <- RO1.d. - -module ConstrPad (FC:Ind1.CONSTRUCTION, P:Ind1.DPRIMITIVE) = { - module C = FC(P) - - proc init = C.init - - proc f (x:Ind2.f_in) : f_out = { - var r; - r = C.f(pad x); - return r; - } -}. - -module DistPad(FD: Ind2.DISTINGUISHER, F:Ind1.DFUNCTIONALITY, P:Ind1.DPRIMITIVE) = { - module Fpad = { - proc f(x:Ind2.f_in) : f_out = { - var r; - r = F.f(pad x); - return r; - } - } - - proc distinguish = FD(Fpad,P).distinguish -}. - -module SimPadinv(S:Ind1.SIMULATOR, F2:Ind2.DFUNCTIONALITY) = { - module F1 = { - proc f(x:Ind1.f_in):Ind1.f_out = { - var r; - r = F2.f(padinv x); - return r; - } - } - - module S2 = S(F1) - - proc init = S2.init - - proc f = S2.f - proc fi = S2.fi -}. - -section Reduction. - declare module P : Ind1.PRIMITIVE. (* It is compatible with Ind2.Primitive *) - declare module C : Ind1.CONSTRUCTION {P}. - declare module S : Ind1.SIMULATOR{ RO1.H, RO2.H}. - - declare module D' : Ind2.DISTINGUISHER{P,C, RO1.H, RO2.H, S}. - - local equiv ConstrDistPad: - Ind2.GReal(ConstrPad(C), P, D').main ~ - Ind1.GReal(C, P, DistPad(D')).main : ={glob P, glob C, glob D'} ==> - ={glob P, glob C, glob D', res}. - proof. by sim. qed. - - local lemma PrConstrDistPad &m: - Pr[ Ind2.GReal(ConstrPad(C), P, D').main() @ &m : res] = - Pr[ Ind1.GReal(C, P, DistPad(D')).main() @ &m : res]. - proof. by byequiv ConstrDistPad. qed. - - local equiv DistH2H1: - Ind2.GIdeal(RO2.H, SimPadinv(S), D').main ~ - Ind1.GIdeal(RO1.H, S, DistPad(D')).main : - ={glob D', glob S} ==> - ={glob D',glob S, res} /\ forall x, RO2.H.m{1}.[padinv x] = RO1.H.m{2}.[x]. - proof. - proc. - call (_: ={glob S} /\ forall x, RO2.H.m{1}.[padinv x] = RO1.H.m{2}.[x]). - + proc *;inline *. - call (_: forall x, RO2.H.m{1}.[padinv x] = RO1.H.m{2}.[x]);auto. - proc;inline *;wp;sp;if;first by progress [-split];rewrite !in_dom H. - + auto;progress;first by rewrite !getP_eq. - by rewrite !getP (can_eq _ _ cancel_padinv) H. - by auto;progress;rewrite H. - + proc *;inline *. - call (_: forall x, RO2.H.m{1}.[padinv x] = RO1.H.m{2}.[x]);auto. - proc;inline *;wp;sp;if;first by progress [-split];rewrite !in_dom H. - + auto;progress;first by rewrite !getP_eq. - by rewrite !getP (can_eq _ _ cancel_padinv) H. - by auto;progress;rewrite H. - + proc;inline *;wp;sp;if;first by progress[-split];rewrite -{1}(cancel_pad x{2}) !in_dom H. - + auto;progress;first by rewrite !getP_eq. - by rewrite !getP (eq_sym x1) (can2_eq _ _ cancel_pad cancel_padinv) (eq_sym x{2}) H. - by auto;progress;rewrite -H cancel_pad. - inline *;wp. call (_: ={glob D'}). - auto;progress;by rewrite !map0P. - qed. - - local lemma PrDistH2H1 &m: - Pr[Ind2.GIdeal(RO2.H,SimPadinv(S),D').main() @ &m : res] = - Pr[Ind1.GIdeal(RO1.H,S, DistPad(D')).main() @ &m : res]. - proof. by byequiv DistH2H1. qed. - - lemma Conclusion &m: - `| Pr[Ind2.GReal (ConstrPad(C), P , D' ).main() @ &m : res] - - Pr[Ind2.GIdeal(RO2.H , SimPadinv(S), D' ).main() @ &m : res] | = - `| Pr[Ind1.GReal (C , P , DistPad(D')).main() @ &m : res] - - Pr[Ind1.GIdeal(RO1.H , S , DistPad(D')).main() @ &m : res] |. - proof. by rewrite (PrConstrDistPad &m) (PrDistH2H1 &m). qed. - -end section Reduction. diff --git a/proof/smart_counter/LazyRO.eca b/proof/smart_counter/LazyRO.eca deleted file mode 100644 index 96136e7..0000000 --- a/proof/smart_counter/LazyRO.eca +++ /dev/null @@ -1,22 +0,0 @@ -require import Option FSet NewFMap. -require (*..*) NewROM. - -type from, to. -op d: to distr. - -clone include NewROM with - type from <- from, - type to <- to, - op dsample <- fun (x:from) => d. - - -module H = { - var m : (from, to) fmap - - proc init() = { m = map0; } - - proc f(x) = { - if (!mem (dom m) x) m.[x] = $d; - return oget m.[x]; - } -}. From a74c974c477a9482d203f158b7a90bc3d15c141e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Wed, 23 May 2018 12:26:04 +0100 Subject: [PATCH 292/525] update CI to follow EC's deploy-sha3 branch --- .gitlab-ci.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index fe632d6..71d0d69 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -5,12 +5,12 @@ services: - docker:dind before_script: - docker info -- docker pull easycryptpa/ec-test-box +- docker pull easycryptpa/ec-test-box:sha3 mpc: only: - master - ci script: - >- - docker run -v $PWD:/home/ci/sha3 easycryptpa/ec-test-box + docker run -v $PWD:/home/ci/sha3 easycryptpa/ec-test-box:sha3 sh -c 'cd sha3 && opam config exec -- make check' From aa8bff0fa6e29454be9a8724b89e1d43d16fc950 Mon Sep 17 00:00:00 2001 From: Pierre-Yves Strub Date: Wed, 23 May 2018 16:18:46 +0200 Subject: [PATCH 293/525] increase timeout for CI --- config/tests.config | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/config/tests.config b/config/tests.config index 9a3096e..501321f 100644 --- a/config/tests.config +++ b/config/tests.config @@ -1,6 +1,6 @@ [default] bin = easycrypt -args = -I proof -I proof/variant -I proof/core +args = -I proof -I proof/variant -I proof/core -timeout 180 [test-sha3] okdirs = !proof From 9ff0107cca3f1d265782d4518682c7fc620d56ca Mon Sep 17 00:00:00 2001 From: Pierre-Yves Strub Date: Wed, 23 May 2018 16:42:56 +0200 Subject: [PATCH 294/525] fix include paths --- config/tests.config | 2 +- proof/.dir-locals.el | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/config/tests.config b/config/tests.config index 501321f..d5c1ee1 100644 --- a/config/tests.config +++ b/config/tests.config @@ -1,6 +1,6 @@ [default] bin = easycrypt -args = -I proof -I proof/variant -I proof/core -timeout 180 +args = -I proof -I proof/smart_counter -timeout 180 [test-sha3] okdirs = !proof diff --git a/proof/.dir-locals.el b/proof/.dir-locals.el index 0337f77..9c03066 100644 --- a/proof/.dir-locals.el +++ b/proof/.dir-locals.el @@ -1,4 +1,4 @@ ((easycrypt-mode . ((eval . (flet ((pre (s) (concat (locate-dominating-file buffer-file-name ".dir-locals.el") s))) - (setq easycrypt-load-path `(,(pre ".") ,(pre "core") ,(pre "smart_counter")))))))) + (setq easycrypt-load-path `(,(pre "smart_counter")))))))) From 9bba874307b6edc5bc6b4c8ea9f10342ea66c443 Mon Sep 17 00:00:00 2001 From: Pierre-Yves Strub Date: Wed, 23 May 2018 17:22:44 +0200 Subject: [PATCH 295/525] RP.eca is back --- proof/RP.eca | 79 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 79 insertions(+) create mode 100644 proof/RP.eca diff --git a/proof/RP.eca b/proof/RP.eca new file mode 100644 index 0000000..6c54150 --- /dev/null +++ b/proof/RP.eca @@ -0,0 +1,79 @@ +(*************************- Random Permutation -*************************) + +require import Core Real FSet NewFMap Distr. +require import Dexcepted StdOrder. import RealOrder. +require import Ring StdRing. import RField. +require Monoid. import AddMonoid. + +type t. +op dt : t distr. + +module type RP = { + proc init() : unit + proc f(x : t) : t + proc fi(x : t) : t +}. + +module type DRP = { + proc f(x : t) : t + proc fi(x : t) : t +}. + +module P : RP, DRP = { + var m : (t, t) fmap + var mi : (t, t) fmap + + proc init() = { m = map0; mi = map0; } + + proc f(x) = { + var y; + + if (! mem (dom m) x) { + y <$ dt \ (mem (rng m)); + m.[x] <- y; + mi.[y] <- x; + } + return oget m.[x]; + } + + proc fi(x) = { + var y; + + if (! mem (dom mi) x) { + y <$ dt \ (mem (rng mi)); + mi.[x] <- y; + m.[y] <- x; + } + return oget mi.[x]; + } +}. + +lemma P_init_ll: islossless P.init. +proof. by proc; auto. qed. + +(* maybe a useful standard lemma? *) + +lemma mu_except ['a] (d : 'a distr, y : 'a, P : 'a -> bool) : + y \in d => ! P y => mu d P < mu d predT. +proof. +move=> in_supp_yd notP_y. +have -> : mu d P = mu d predT - mu d (predC P) + by rewrite (mu_split d predT P) mu_not mu_and #ring. +rewrite ltr_subl_addl (ltr_le_trans (mu d (pred1 y) + mu d predT)). +by rewrite -(add0r (mu _ _)) 1:ltr_le_add. +by rewrite ler_add mu_sub /pred1; first move=> ?. +qed. + +lemma P_f_ll: is_lossless dt => support dt = predT => islossless P.f. +proof. +move=> d_ll d_fu; proc; if=> //=; auto=> &m /= x_notin_m. +have [y not_mem_y_rng_m] := endo_dom_rng P.m{m} _; first by exists x{m}. +by rewrite dexcepted_ll // -d_ll (mu_except dt y) -/(support _ _) 1:d_fu. +qed. + +lemma P_fi_ll: is_lossless dt => support dt = predT => islossless P.fi. +proof. +move=> d_ll d_fu; proc; if=> //=; auto=> &m /= x_notin_m. +have [y not_mem_y_rng_mi] := endo_dom_rng P.mi{m} _; first by exists x{m}. +by rewrite dexcepted_ll // -d_ll (mu_except dt y) -/(support _ _) 1:d_fu. +qed. From 645fd855359eba01210c36a73f3199746f72fa1f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Fri, 25 May 2018 03:08:45 +0100 Subject: [PATCH 296/525] Update PG include path --- proof/.dir-locals.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/proof/.dir-locals.el b/proof/.dir-locals.el index 9c03066..542d7f0 100644 --- a/proof/.dir-locals.el +++ b/proof/.dir-locals.el @@ -1,4 +1,4 @@ ((easycrypt-mode . ((eval . (flet ((pre (s) (concat (locate-dominating-file buffer-file-name ".dir-locals.el") s))) - (setq easycrypt-load-path `(,(pre "smart_counter")))))))) + (setq easycrypt-load-path `(,(pre ".") ,(pre "smart_counter")))))))) From 314f53eb72da4fc2c266a635e329c90e099ea4c0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Fri, 25 May 2018 03:08:59 +0100 Subject: [PATCH 297/525] Remove large timeout --- config/tests.config | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/config/tests.config b/config/tests.config index d5c1ee1..73f88f9 100644 --- a/config/tests.config +++ b/config/tests.config @@ -1,6 +1,6 @@ [default] bin = easycrypt -args = -I proof -I proof/smart_counter -timeout 180 +args = -I proof -I proof/smart_counter [test-sha3] okdirs = !proof From 985f8c25ddc572576bc058129247dff44fdb1463 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Fri, 25 May 2018 03:09:40 +0100 Subject: [PATCH 298/525] Simplify some smt calls in Handle --- proof/smart_counter/Handle.eca | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/proof/smart_counter/Handle.eca b/proof/smart_counter/Handle.eca index aca0768..b821d31 100644 --- a/proof/smart_counter/Handle.eca +++ b/proof/smart_counter/Handle.eca @@ -1463,8 +1463,8 @@ have /incli_of_INV <- := inv0; 1:by rewrite Gmi_xaxc. rewrite Pmi_xaxc=> /= [#] <<*>. rcondf{2} 1; 1:by auto=> &hr [#] <<*>; rewrite in_dom Gmi_xaxc. by auto=> &1 &2 /#. -progress;cut[]//=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H1;smt(in_dom). -progress;cut[]//=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H1;smt(in_dom). ++ by move=> /> &1 &2 _ _ /m_p_of_INV []; smt(in_dom). +by move=> /> &1 &2 -> ->. qed. @@ -1765,7 +1765,7 @@ call(: !G1.bcol{2} G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} Redo.prefixes{1} C.queries{2}); progress;2..-2:rewrite/#. - by rewrite in_dom;cut[]_->_ _ _/=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. - inline*; if{2}; auto; smt (@Block @Capacity). + by inline*; if{2}; auto=> &1 &2 />; smt(F.sampleto_ll sampleto_ll). have /mh_of_INV []/(_ _ _ _ _ G1mh_x1hx2) + _ _:= inv0. move=> [xc0 xf0 yc0 yf0] [#]; rewrite hs_hx2 hs_hy2=> [#] !<<- [#] !<<- {xc0 xf0 yc0 yf0} /= [p0 v0] [#] Hro Hpath. have /pi_of_INV [] /(_ x2 p0 v0) /iffRL /(_ _) := inv0. @@ -1788,7 +1788,7 @@ call(: !G1.bcol{2} cut[]_->_ _ _//=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. case((x2, Unknown) \in rng hs0)=>//=_. exact/(@lemma3 _ _ _ _ _ _ _ _ _ _ _ _ _ _ hx2 _ _ hy2). - progress;cut[]//=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H1;smt(in_dom). + by move=> /> &1 &2 -> ->. qed. lemma head_nth (w:'a) l : head w l = nth w l 0. @@ -1946,8 +1946,8 @@ proof. * by cut[]:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H0;smt(take0 in_dom). * by cut[]:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H0;smt(take0 in_dom). * by cut[]:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H0;smt(take0 in_dom set_eq). - * by cut[]:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H0;smt(take0 in_dom). - * smt. + * by cut[]:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H0;smt(take0 in_dom). + * by rewrite build_hpathP; apply/Empty=> //; exact/take0. * by cut[]:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H0;smt(take0 in_dom size_take size_eq0). * smt(prefixe_sizel). From 9e9215ff0a0e29c31fa9ab2e1150aa033406b585 Mon Sep 17 00:00:00 2001 From: Pierre-Yves Strub Date: Fri, 25 May 2018 23:05:33 +0200 Subject: [PATCH 299/525] --- config/tests.config | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/config/tests.config b/config/tests.config index 73f88f9..1c6b73e 100644 --- a/config/tests.config +++ b/config/tests.config @@ -1,6 +1,6 @@ [default] bin = easycrypt -args = -I proof -I proof/smart_counter +args = -I proof -I proof/smart_counter -timeout 10 [test-sha3] okdirs = !proof From 6e8baa3c83f91bfb5ab8dba5d90c8d5ae65d0e5a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Mon, 30 Jul 2018 17:45:30 +0100 Subject: [PATCH 300/525] CI: rename job --- .gitlab-ci.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 71d0d69..6bb9c3a 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -6,7 +6,7 @@ services: before_script: - docker info - docker pull easycryptpa/ec-test-box:sha3 -mpc: +sha3: only: - master - ci From 12134f59ffd3ce76c5eb145b6ddec7a42ab1d303 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Mon, 30 Jul 2018 17:45:53 +0100 Subject: [PATCH 301/525] Fix Strong_rp_rf proof --- proof/smart_counter/Strong_rp_rf.eca | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/proof/smart_counter/Strong_rp_rf.eca b/proof/smart_counter/Strong_rp_rf.eca index 99d42fe..fae5908 100644 --- a/proof/smart_counter/Strong_rp_rf.eca +++ b/proof/smart_counter/Strong_rp_rf.eca @@ -24,7 +24,7 @@ clone import StrongPRP as PRPt with type K <- K, op dK <- dK, type D <- D -proof * by smt ml=0 w=dK_ll +proof * by smt(dK_ll) rename "StrongPRP_" as "". clone import IdealPRP as PRPi with @@ -450,7 +450,7 @@ section CollisionProbability. * by hoare; auto=> //=; smt w=(RealOrder.mulr_ge0 mu_bounded ge0_q). + move=> c; proc. rcondt 2; 1:by auto. sp; if=> //=. - * inline*;sp;if;auto;smt(size_set). + * inline*;sp;if;auto=> /#. * by auto=> /#. + by move=> b c; proc; rcondf 2; auto. + exists*FEL.c;elim*=> c. @@ -468,7 +468,7 @@ section CollisionProbability. * by hoare; auto; smt w=(RealOrder.mulr_ge0 mu_bounded ge0_q). + move=> c; proc; rcondt 2; 1:by auto. sp; if=> //=. - * inline*;sp;if;auto;smt(size_set). + * inline*;sp;if;auto=> /#. * by auto=> /#. + by move=> b c; proc; rcondf 2; auto. qed. From 8644bb53831a63ec3eef1a7156b21a0070efbb1c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Mon, 30 Jul 2018 17:49:26 +0100 Subject: [PATCH 302/525] Fix Utils proof --- proof/smart_counter/Utils.ec | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/proof/smart_counter/Utils.ec b/proof/smart_counter/Utils.ec index 3f2b506..37ccdfa 100644 --- a/proof/smart_counter/Utils.ec +++ b/proof/smart_counter/Utils.ec @@ -48,10 +48,14 @@ proof. rewrite /augment; case (mem (map fst acc) x'.`1)=> _ h'; left=> //. by rewrite mem_rcons /=; right. rewrite /s' mapP=> -[[a' b']] /= [xy_in_m []]. - rewrite eq_sym. have h0 /h0 ->> <<- {a' b'}:= f_pinj a' x _; 1:by smt. + rewrite eq_sym. + have h0 /h0 ->> <<- {a' b'}:= f_pinj a' x _. + + by rewrite domE mem_oflist mapP; exists (a',b'). by apply/mem_assoc_uniq; 1:exact uniq_keys. rewrite -mem_oflist {1}/s -domE=> -[] h; have := h; rewrite dom_reindex. - rewrite imageP=> h'. have {h'} h': forall (a : 'a), !mem (dom m) a \/ f a <> f x by smt. + rewrite imageP=> h'. + have {h'} h': forall (a : 'a), !mem (dom m) a \/ f a <> f x. + + by move: h'=> /negb_exists /= + a - /(_ a) /negb_and. have /= := h' x. rewrite in_dom !getE /=. by move=> -> ->. @@ -60,4 +64,4 @@ qed. lemma reindex_injective (f : 'a -> 'c) (m : ('a, 'b) fmap): injective f => (forall x, m.[x] = (reindex f m).[f x]). -proof. by move=> f_inj; apply/reindex_injective_on=> + + _. qed. +proof. by move=> f_inj; apply/reindex_injective_on=> + + _. qed. \ No newline at end of file From 422fa9615d210d026f1d69deb122a4d396259a5e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Mon, 30 Jul 2018 18:18:12 +0100 Subject: [PATCH 303/525] Actually do some fixing on Strong_rp_rf. Probably still some goals that only went through with eprover in final reasoning on probs --- proof/smart_counter/Strong_rp_rf.eca | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/proof/smart_counter/Strong_rp_rf.eca b/proof/smart_counter/Strong_rp_rf.eca index fae5908..bf36112 100644 --- a/proof/smart_counter/Strong_rp_rf.eca +++ b/proof/smart_counter/Strong_rp_rf.eca @@ -450,7 +450,9 @@ section CollisionProbability. * by hoare; auto=> //=; smt w=(RealOrder.mulr_ge0 mu_bounded ge0_q). + move=> c; proc. rcondt 2; 1:by auto. sp; if=> //=. - * inline*;sp;if;auto=> /#. + * inline*;sp;if;auto; 2:smt(). + move=> &hr /> + + + + + y. + by rewrite !sizeE !dom_set !fcardU !fcard1; smt(fcard_ge0). * by auto=> /#. + by move=> b c; proc; rcondf 2; auto. + exists*FEL.c;elim*=> c. @@ -468,7 +470,9 @@ section CollisionProbability. * by hoare; auto; smt w=(RealOrder.mulr_ge0 mu_bounded ge0_q). + move=> c; proc; rcondt 2; 1:by auto. sp; if=> //=. - * inline*;sp;if;auto=> /#. + * inline*;sp;if;auto; 2:smt(). + move=> &hr /> + + + + + x. + by rewrite !sizeE !dom_set !fcardU !fcard1; smt(fcard_ge0). * by auto=> /#. + by move=> b c; proc; rcondf 2; auto. qed. From c64c0fc85eab80a6b87f9e22d15bcd50e2695904 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Tue, 31 Jul 2018 14:58:05 +0100 Subject: [PATCH 304/525] CI: produce verbose logs as artifacts on failure --- .gitlab-ci.yml | 4 ++++ Makefile | 2 +- 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 6bb9c3a..b8b597e 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -14,3 +14,7 @@ sha3: - >- docker run -v $PWD:/home/ci/sha3 easycryptpa/ec-test-box:sha3 sh -c 'cd sha3 && opam config exec -- make check' + artifacts: + when: on_failure + paths: + - xunit.xml diff --git a/Makefile b/Makefile index 59ef4f4..3687a13 100644 --- a/Makefile +++ b/Makefile @@ -29,4 +29,4 @@ check: $(ECCHECK) --bin-args="$(ECARGS)" $(ECCONF) $(CHECKS) check-xunit: - $(ECCHECK) --bin-args="$(ECARGS)" --xunit=$(XUNITOUT) $(ECCONF) $(CHECKS) + $(ECCHECK) --bin-args="$(ECARGS)" --report=$(XUNITOUT) $(ECCONF) $(CHECKS) From a06bc6c070750a0407cd34b0798144bf104f4ee7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Sat, 15 Sep 2018 12:36:57 +0100 Subject: [PATCH 305/525] Remove prints --- proof/smart_counter/Gconcl_list.ec | 4 +--- proof/smart_counter/Gext.eca | 2 +- 2 files changed, 2 insertions(+), 4 deletions(-) diff --git a/proof/smart_counter/Gconcl_list.ec b/proof/smart_counter/Gconcl_list.ec index e998c81..ca43009 100644 --- a/proof/smart_counter/Gconcl_list.ec +++ b/proof/smart_counter/Gconcl_list.ec @@ -1729,7 +1729,7 @@ section Real_Ideal. proof. rewrite-(pr_real D &m). rewrite-(equiv_ideal D &m). - cut:=Real_Ideal (A(D)) A_lossless &m. print DProd. + cut:=Real_Ideal (A(D)) A_lossless &m. pose x:=witness;elim:x=>a b. by rewrite/dstate DProd.dprod1E DBlock.dunifin1E DCapacity.dunifin1E/= block_card capacity_card;smt(). @@ -1741,8 +1741,6 @@ end section Real_Ideal. require import AdvAbsVal. -print AdvAbsVal. - section Real_Ideal_Abs. declare module D : DISTINGUISHER{SLCommon.C, C, Perm, Redo, F.RO, F.RRO, S, BIRO.IRO, BIRO2.IRO, F2.RO, F2.FRO}. diff --git a/proof/smart_counter/Gext.eca b/proof/smart_counter/Gext.eca index 34225b6..88f2077 100644 --- a/proof/smart_counter/Gext.eca +++ b/proof/smart_counter/Gext.eca @@ -538,7 +538,7 @@ section EXT. wp; rnd (mem (image snd (dom G1.m `|` dom G1.mi ))); skip=> /> &hr ? ? -> /= ? ?. rewrite (Mu_mem.mu_mem (image snd (dom G1.m{hr} `|` dom G1.mi{hr})) - cdistr (1%r/(2^c)%r))//. print DCapacity. + cdistr (1%r/(2^c)%r))//. + by move=>x _;rewrite DCapacity.dunifin1E capacity_card. rewrite ler_wpmul2r;1:by apply divr_ge0=>//;apply /c_ge0r. rewrite imageU fcardU le_fromint. From 6e43cb1d83bf9d1515d415e3d5c6cb650fbc4e1f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Sat, 15 Sep 2018 19:15:21 +0100 Subject: [PATCH 306/525] push some stuff through with current easycrypt HEAD this will fail in the CI. --- proof/Common.ec | 25 +- proof/Indifferentiability.eca | 6 +- proof/RndO.ec | 5 +- proof/smart_counter/ConcreteF.eca | 271 +++++---- proof/smart_counter/SLCommon.ec | 919 ++++++++++++++++-------------- proof/smart_counter/Utils.ec | 7 +- 6 files changed, 654 insertions(+), 579 deletions(-) diff --git a/proof/Common.ec b/proof/Common.ec index 8555c2b..d8f6046 100644 --- a/proof/Common.ec +++ b/proof/Common.ec @@ -1,18 +1,11 @@ (*------------------- Common Definitions and Lemmas --------------------*) -(* checks with both Alt-Ergo and Z3; all smt applications are - restricted to specific lemmas *) - -(* -prover ["Z3"]. -prover ["Alt-Ergo"]. -*) +prover quorum=2 ["Z3" "Alt-Ergo"]. require import Core Int IntExtra IntDiv Real List Distr. require import Ring StdRing StdOrder StdBigop BitEncoding DProd. -require (*--*) FinType BitWord RP Monoid. +require (*--*) FinType BitWord IdealPRP Monoid. (*---*) import IntID IntOrder Bigint Bigint.BIA IntDiv. -(* require import NewLogic. *) pragma +implicits. @@ -116,12 +109,16 @@ qed. (*------------------------------ Primitive -----------------------------*) -clone export RP as Perm with - type t <- block * capacity, - op dt <- bdistr `*` cdistr +clone export IdealPRP as Perm with + type D <- block * capacity, + op dD <- bdistr `*` cdistr rename - [module type] "RP" as "PRIMITIVE" - [module] "P" as "Perm". + [module type] "PRP" as "PRIMITIVE" + [module] "RandomPermutation" as "Perm" + proof dD_ll. +realize dD_ll. +by apply/dprod_ll; rewrite Block.DBlock.dunifin_ll Capacity.DCapacity.dunifin_ll. +qed. (*---------------------- Needed Blocks Computation ---------------------*) diff --git a/proof/Indifferentiability.eca b/proof/Indifferentiability.eca index d0cf65e..842756c 100644 --- a/proof/Indifferentiability.eca +++ b/proof/Indifferentiability.eca @@ -1,9 +1,6 @@ (** A primitive: the building block we assume ideal **) type p. -(** A functionality: the target construction **) -type f_in, f_out. - module type PRIMITIVE = { proc init(): unit proc f(x : p): p @@ -15,6 +12,9 @@ module type DPRIMITIVE = { proc fi(x : p): p }. +(** A functionality: the target construction **) +type f_in, f_out. + module type FUNCTIONALITY = { proc init(): unit proc f(x : f_in): f_out diff --git a/proof/RndO.ec b/proof/RndO.ec index fdc6799..f2bed8e 100644 --- a/proof/RndO.ec +++ b/proof/RndO.ec @@ -1,9 +1,10 @@ -pragma -oldip. require import Core List FSet NewFMap Distr. require IterProc. +pragma -oldip. + (* FIXME notation *) -abbrev ([+]) ['a 'b](x : 'b) = fun (_ : 'a) => x. +abbrev ([+]) ['a 'b] (x : 'b) = fun (_ : 'a) => x. type flag = [ Unknown | Known ]. diff --git a/proof/smart_counter/ConcreteF.eca b/proof/smart_counter/ConcreteF.eca index 4d4a963..76c32a9 100644 --- a/proof/smart_counter/ConcreteF.eca +++ b/proof/smart_counter/ConcreteF.eca @@ -1,22 +1,22 @@ require import Core Int Real StdOrder Ring Distr IntExtra. -require import List FSet NewFMap Utils Common SLCommon DProd Dexcepted. +require import List FSet SmtMap Common SLCommon DProd Dexcepted. (*...*) import Capacity IntOrder RealOrder. -require (*..*) Strong_rp_rf. +require (*..*) Strong_RP_RF. module PF = { var m, mi: (state,state) fmap proc init(): unit = { - m <- map0; - mi <- map0; + m <- empty; + mi <- empty; } proc f(x : state): state = { var y1, y2; - if (!mem (dom m) x) { + if (x \notin m) { y1 <$ bdistr; y2 <$ cdistr; m.[x] <- (y1,y2); @@ -28,7 +28,7 @@ module PF = { proc fi(x : state): state = { var y1, y2; - if (!mem (dom mi) x) { + if (x \notin mi) { y1 <$ bdistr; y2 <$ cdistr; mi.[x] <- (y1,y2); @@ -50,7 +50,7 @@ section. local module GReal' = Indif(FC(SqueezelessSponge(Perm)), PC(Perm), D). - local clone import Strong_rp_rf as Switching with + local clone import Strong_RP_RF as Switching with type D <- state, op uD <- dstate, type K <- unit, @@ -95,8 +95,8 @@ section. call (_: ={glob C, glob P, glob Redo} /\ all_prefixes Redo.prefixes{2} /\ Redo.prefixes{2}.[[]] = Some (b0,c0) - /\ dom C.queries{2} \subset dom Redo.prefixes{2} - /\ prefixe_inv C.queries{2} Redo.prefixes{2} + /\ (forall x, x \in C.queries{2} => x \in Redo.prefixes{2}) + /\ prefix_inv C.queries{2} Redo.prefixes{2} /\ DBounder.FBounder.c{2} = C.c{2}). + proc; sp; if=> //=; inline *. rcondt{2} 3; 1: by auto=> /#. @@ -106,95 +106,110 @@ section. by wp; call (_: true); auto. + proc; sp; if=> //=; inline *;1:if;auto. - splitwhile{1}5:take (i+1) p \in dom Redo.prefixes. - splitwhile{2}5:take (i+1) p \in dom Redo.prefixes. + splitwhile{1}5:take (i+1) p \in Redo.prefixes. + splitwhile{2}5:take (i+1) p \in Redo.prefixes. alias{1}1 pref = Redo.prefixes;alias{2}1 pref = Redo.prefixes;sp 1 1=>/=. alias{1}1 query = C.queries;alias{2}1 query = C.queries;sp 1 1=>/=. conseq(:_==> ={sa, Redo.prefixes, glob P, i, C.c} /\ all_prefixes Redo.prefixes{2} - /\ dom query{2} \subset dom Redo.prefixes{2} + /\ (forall x, x \in query{2} => x \in Redo.prefixes{2}) /\ i{1} = size bs{1} /\ Redo.prefixes{1}.[take i{1} bs{1}] = Some (sa{1},sc{1}) - /\ (forall y, y \in dom pref{1} => pref{1}.[y] = Redo.prefixes{1}.[y]) - /\ (forall y, y \in dom Redo.prefixes{1} <=> (y \in dom pref{1} \/ + /\ (forall y, y \in pref{1} => pref{1}.[y] = Redo.prefixes{1}.[y]) + /\ (forall y, y \in Redo.prefixes{1} <=> (y \in pref{1} \/ (exists j, 0 <= j <= i{1} /\ y = take j bs{1}))) /\ DBounder.FBounder.c{2} = C.c{2} - size bs{1} + i{1}); - progress;..-2:smt(in_dom dom_set in_fsetU1 getP oget_some take_size cat_take_drop). + progress;..-2:smt(domE mem_set get_setE oget_some take_size cat_take_drop). while( ={sa, Redo.prefixes, glob P, i, C.c, p, sc} /\ p{1} = bs{1} /\ all_prefixes Redo.prefixes{2} /\ Redo.prefixes{2}.[[]] = Some (b0, c0) - /\ dom query{2} \subset dom Redo.prefixes{2} - /\ (i{1} < size p{1} => ! take (i{1} + 1) p{1} \in dom Redo.prefixes{1}) - /\ 0 <= prefixe bs{1} (get_max_prefixe bs{1} (elems (dom C.queries{1}))) <= i{1} <= size bs{1} + /\ (forall x, x \in query{2} => x \in Redo.prefixes{2}) + /\ (i{1} < size p{1} => ! take (i{1} + 1) p{1} \in Redo.prefixes{1}) + /\ 0 <= prefix bs{1} (get_max_prefix bs{1} (elems (fdom C.queries{1}))) <= i{1} <= size bs{1} /\ C.c{1} <= max_size /\ Redo.prefixes{1}.[take i{1} bs{1}] = Some (sa{1},sc{1}) - /\ (forall y, y \in dom pref{1} => pref{1}.[y] = Redo.prefixes{1}.[y]) - /\ (forall y, y \in dom Redo.prefixes{1} <=> (y \in dom pref{1} \/ + /\ (forall y, y \in pref{1} => pref{1}.[y] = Redo.prefixes{1}.[y]) + /\ (forall y, y \in Redo.prefixes{1} <=> (y \in pref{1} \/ (exists j, 0 <= j <= i{1} /\ y = take j bs{1}))) /\ DBounder.FBounder.c{2} = C.c{2} - size bs{1} + i{1}). - + if;auto;1:smt(get_oget in_dom). + + if; auto; 1:smt(domE). sp;rcondt{2}1;1:auto=>/#;auto;1:call(:true);auto;progress. - * move=>x;rewrite dom_set in_fsetU1=>[][|-> j];1:smt(in_fsetU1). + * move=>x;rewrite mem_set=>[][|-> j]; 1:smt(mem_set). case(0 <= j)=>hj0;last first. - + by rewrite (@take_le0 j)1:/# in_fsetU1 in_dom H0//=. - rewrite take_take in_fsetU1/min/#. - * smt(dom_set in_fsetU1 take_take in_dom getP oget_some). - * smt(dom_set in_fsetU1 take_take in_dom getP oget_some). - * rewrite dom_set in_fsetU1 negb_or H9 negb_or/=negb_exists/=. + + by rewrite (@take_le0 j)1:/# domE get_setE H0 /#. + by rewrite take_take /min; case: (j < i{2} + 1)=> _; rewrite mem_set //= /#. + * smt(mem_set take_take domE get_setE oget_some). + * smt(mem_set take_take domE get_setE oget_some). + * rewrite mem_set negb_or H9 negb_or/=negb_exists/=. cut htake:take (i{2} + 1) bs{1} = take (i{2} + 1) (take (i{2} + 1 + 1) bs{1}); smt(take_take size_take). * rewrite/#. * rewrite/#. - * smt(dom_set in_fsetU1 take_take in_dom getP oget_some). - * smt(dom_set in_fsetU1 take_take in_dom getP oget_some). - * smt(dom_set in_fsetU1 take_take in_dom getP oget_some). - * smt(dom_set in_fsetU1 take_take in_dom getP oget_some). - * smt(dom_set in_fsetU1 take_take in_dom getP oget_some). + * smt(mem_set take_take domE get_setE oget_some). + * smt(mem_set take_take domE get_setE oget_some). + * smt(mem_set take_take domE get_setE oget_some). + * smt(mem_set take_take domE get_setE oget_some). + * smt(mem_set take_take domE get_setE oget_some). sp; conseq(:_==> ={sa, Redo.prefixes, glob P, i, C.c, p, sc, bs} /\ p{1} = bs{1} /\ Redo.prefixes{2} = pref{2} - /\ dom query{2} \subset dom Redo.prefixes{2} + /\ (forall x, x \in query{2} => x \in Redo.prefixes{2}) /\ C.c{1} <= max_size - /\ i{1} = prefixe bs{1} (get_max_prefixe bs{1} (elems (dom C.queries{1}))) + /\ i{1} = prefix bs{1} (get_max_prefix bs{1} (elems (fdom C.queries{1}))) /\ Redo.prefixes{1}.[take i{1} bs{1}] = Some (sa{1},sc{1}) /\ DBounder.FBounder.c{2} = C.c{2} - size bs{1} + - prefixe bs{1} (get_max_prefixe bs{1} (elems (dom C.queries{1})))); - progress;..4,6..-2: - smt(prefixe_ge0 prefixe_lt_size prefixe_sizel prefixe_exchange prefixe_lt_size memE). - + move:H8=>[]//=[]j [[hj0 hjsize] htake]. - rewrite htake. - apply take_get_max_prefixe2=>//=;1:smt(in_dom memE). - by rewrite-(@prefixe_exchange _ _ _ H2 H). + prefix bs{1} (get_max_prefix bs{1} (elems (fdom C.queries{1}))))=> />. + progress. + + rewrite -negP. + move: H9; rewrite (prefix_exchange _ Redo.prefixes{2} _)=> //= H9. + by rewrite -mem_fdom memE; apply/prefix_lt_size=> /#. + + exact/prefix_ge0. + + exact/prefix_sizel. + + case: H9=> //= - [j] [#] H42 H72. print take_take. + have ->: j = min j (prefix bs{2} (get_max_prefix bs{2} (elems (fdom C.queries{2})))) by smt(). + rewrite -(take_take bs{2} j (prefix bs{2} (get_max_prefix bs{2} (elems (fdom C.queries{2}))))). + by move=> ->; rewrite H domE //= H8. + + smt(). alias{2} 1 k = DBounder.FBounder.c;sp; conseq(:_==> ={sa, Redo.prefixes, glob P, i, C.c, p, sc, bs} /\ p{1} = bs{1} /\ Redo.prefixes{2} = pref{2} - /\ dom query{2} \subset dom Redo.prefixes{2} + /\ (forall x, x \in query{2} => x \in Redo.prefixes{2}) /\ C.c{2} <= max_size - /\ i{1} = prefixe bs{1} (get_max_prefixe bs{1} (elems (dom C.queries{1}))) + /\ i{1} = prefix bs{1} (get_max_prefix bs{1} (elems (fdom C.queries{1}))) /\ Redo.prefixes{1}.[take i{1} bs{1}] = Some (sa{1},sc{1}) /\ DBounder.FBounder.c{2} = k{2});1:progress=>/#. while( ={sa, Redo.prefixes, glob P, i, C.c, p, sc, bs, C.queries} /\ p{1} = bs{1} /\ Redo.prefixes{2} = pref{2} - /\ dom query{2} \subset dom Redo.prefixes{2} - /\ prefixe_inv C.queries{2} Redo.prefixes{2} + /\ (forall x, x \in query{2} => x \in Redo.prefixes{2}) + /\ prefix_inv C.queries{2} Redo.prefixes{2} /\ all_prefixes Redo.prefixes{2} /\ C.c{2} <= max_size - /\ 0 <= i{1} <= prefixe bs{1} (get_max_prefixe bs{1} (elems (dom C.queries{1}))) - /\ (forall j, 0 <= j <= prefixe bs{1} (get_max_prefixe bs{1} (elems (dom C.queries{1}))) - => take j bs{2} \in dom Redo.prefixes{1}) + /\ 0 <= i{1} <= prefix bs{1} (get_max_prefix bs{1} (elems (fdom C.queries{1}))) + /\ (forall j, 0 <= j <= prefix bs{1} (get_max_prefix bs{1} (elems (fdom C.queries{1}))) + => take j bs{2} \in Redo.prefixes{1}) /\ Redo.prefixes{1}.[take i{1} bs{1}] = Some (sa{1},sc{1}) /\ DBounder.FBounder.c{2} = k{2}). + rcondt{1}1;2:rcondt{2}1;auto;progress. - * by rewrite/#. - * by rewrite(@prefixe_exchange _ _ bs{2} H0 H1)all_take_in//=/#. - * smt(get_oget in_dom). - auto;progress. smt(prefixe_ge0). - * apply take_get_max_prefixe2=>//=;1:smt(in_dom memE). - by rewrite-(@prefixe_exchange _ _ _ H2 H). - * smt(get_oget in_dom). - * smt(@Prefixe). - auto;call(:true);auto;smt(dom0 in_fset0 dom_set in_fsetU1 getP oget_some). + * by smt(). + * by rewrite(@prefix_exchange _ _ bs{2} H0 H1)all_take_in//=/#. + * smt(domE). + auto;progress. smt(prefix_ge0). + + apply/take_get_max_prefix2=> //=. + + by exists []; rewrite domE H0. + by rewrite-(@prefix_exchange _ _ _ H2 H). + * smt(domE take0). + * smt(@Prefix). + auto; call(: true); auto=> />. + (** TODO: send to smt with cast into infinite maps **) + do!split. + + rewrite/all_prefixes; smt(mem_set mem_empty). + + exact/get_set_sameE. + + smt(mem_empty mem_set). + + smt(mem_empty mem_set get_setE). + move=> ?; split=> [|_]. + + smt(mem_set mem_empty). + smt(mem_empty mem_set). qed. local clone import ProdSampling with @@ -212,11 +227,11 @@ section. res /\ C.c <= max_size] = Pr[GReal'.main()@ &m: res/\ C.c <= max_size]. + byequiv=>//;proc;inline *; call (_: ={C.c, glob Perm, Redo.prefixes} - /\ prefixe_inv C.queries{2} Redo.prefixes{1} + /\ prefix_inv C.queries{2} Redo.prefixes{1} /\ Redo.prefixes{1}.[[]] = Some (b0, c0) /\ all_prefixes Redo.prefixes{1}); last first. - + auto;smt(dom0 in_fset0 dom_set in_fsetU1 getP oget_some). + + auto;smt(mem_empty mem_set get_setE oget_some). + by proc; inline*; sp; if; auto. + by proc; inline*; sp; if; auto. proc; inline *; wp; sp. @@ -226,8 +241,8 @@ section. /\ Redo.prefixes{1}.[[]] = Some (b0, c0) /\ ={Perm.m, Perm.mi, Redo.prefixes, C.c});1:smt(take_size). + while{1}( ={Perm.m, Perm.mi, Redo.prefixes, C.c} - /\ p{1} \in dom C.queries{2} - /\ prefixe_inv C.queries{2} Redo.prefixes{1} + /\ p{1} \in C.queries{2} + /\ prefix_inv C.queries{2} Redo.prefixes{1} /\ 0 <= i{1} <= size p{1} /\ Redo.prefixes{1}.[[]] = Some (b0, c0) /\ (sa{1},sc{1}) = oget Redo.prefixes{1}.[take i{1} p{1}] @@ -235,8 +250,8 @@ section. + auto;sp;rcondt 1;auto;smt(excepted_lossless). by auto;smt(size_ge0 take0 take_size). - splitwhile{1} 1 : take (i+1) p \in dom Redo.prefixes; - splitwhile{2} 1 : take (i+1) p \in dom Redo.prefixes. + splitwhile{1} 1 : take (i+1) p \in Redo.prefixes; + splitwhile{2} 1 : take (i+1) p \in Redo.prefixes. alias{1}1 pref = Redo.prefixes;alias{2}1 pref = Redo.prefixes;sp 1 1=>/=. alias{2}1 query = C.queries;sp 0 1=>/=. @@ -245,101 +260,119 @@ section. /\ C.c{1} = C.c{2} - size p{2} + i{2} /\ i{2} = size p{2} /\ Redo.prefixes{2}.[take i{2} p{2}] = Some (sa{2}, sc{2}) - /\ (forall l, l \in dom pref{2} => pref{2}.[l] = Redo.prefixes{2}.[l]) - /\ (forall j, 0 <= j <= i{2} => take j p{2} \in dom Redo.prefixes{2}) - /\ (forall l, l \in dom Redo.prefixes{2} => - l \in dom pref{2} \/ (exists j, 0 <= j <= i{2} /\ l = take j p{2}))); + /\ (forall l, l \in pref{2} => pref{2}.[l] = Redo.prefixes{2}.[l]) + /\ (forall j, 0 <= j <= i{2} => take j p{2} \in Redo.prefixes{2}) + /\ (forall l, l \in Redo.prefixes{2} => + l \in pref{2} \/ (exists j, 0 <= j <= i{2} /\ l = take j p{2}))); progress. * by rewrite/#. - * move:H3 H7;rewrite take_size dom_set in_fsetU1 getP;case(bs0 = bs{2})=>//=[->|]h. + * move:H3 H7;rewrite take_size mem_set get_setE;case(bs0 = bs{2})=>//=[->|]h. * by rewrite h oget_some/=. * move:H=>[H []];progress. - by rewrite -H4;1:smt(take_size);rewrite H//=. - * smt(dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0). - * smt(dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop). - * smt(dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop). - * smt(dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop). + by rewrite -H4; move: (H3 _ H9 (size bs0)); rewrite take_size //= H. + * smt(mem_set take_size oget_some get_setE domE take_oversize take_le0). + * elim: (H6 _ H10). + + elim: H=> _; rewrite andaE=> [#] _ /(_ bs0 i0 H9) h /h [l2] hl2. + by exists l2; rewrite mem_set hl2. + by move=> [j] [] hj ->; exists (drop j bs{2}); rewrite cat_take_drop mem_set. + * smt(mem_set take_size oget_some get_setE domE take_oversize take_le0 take_take cat_take_drop). + * smt(mem_set take_size oget_some get_setE domE take_oversize take_le0 take_take cat_take_drop). while(={sa,sc,Perm.m,Perm.mi,Redo.prefixes,i,p} /\ C.c{1} = C.c{2} - size p{2} + i{2} /\ all_prefixes Redo.prefixes{2} /\ all_prefixes pref{2} - /\ prefixe_inv C.queries{2} pref{2} - /\ prefixe p{2} (get_max_prefixe p{2} (elems (dom C.queries{2}))) <= i{2} <= size p{2} + /\ prefix_inv C.queries{2} pref{2} + /\ prefix p{2} (get_max_prefix p{2} (elems (fdom C.queries{2}))) <= i{2} <= size p{2} /\ Redo.prefixes{2}.[take i{2} p{2}] = Some (sa{2}, sc{2}) - /\ (forall l, l \in dom pref{2} => pref{2}.[l] = Redo.prefixes{2}.[l]) - /\ (forall j, 0 <= j <= i{2} => take j p{2} \in dom Redo.prefixes{2}) - /\ (forall l, l \in dom Redo.prefixes{2} => - l \in dom pref{2} \/ (exists j, 0 <= j <= i{2} /\ l = take j p{2}))). + /\ (forall l, l \in pref{2} => pref{2}.[l] = Redo.prefixes{2}.[l]) + /\ (forall j, 0 <= j <= i{2} => take j p{2} \in Redo.prefixes{2}) + /\ (forall l, l \in Redo.prefixes{2} => + l \in pref{2} \/ (exists j, 0 <= j <= i{2} /\ l = take j p{2}))). + rcondf{1}1;2:rcondf{2}1;..2:auto;progress. * cut:=H7 (take (i{m0}+1) p{m0}). - case((take (i{m0} + 1) p{m0} \in dom Redo.prefixes{m0}))=>//=_. - rewrite negb_or negb_exists/=;progress. - + by rewrite memE prefixe_lt_size//=-(@prefixe_exchange _ _ p{m0} H1 H0)//=/#. + case((take (i{m0} + 1) p{m0} \in Redo.prefixes{m0}))=>//=_. + rewrite negb_or negb_exists/=;progress. + + by rewrite -mem_fdom memE prefix_lt_size//=-(@prefix_exchange _ _ p{m0} H1 H0)//=/#. case(0<=a<=i{m0})=>//=ha;smt(size_take). * cut:=H7 (take (i{hr}+1) p{hr}). - case((take (i{hr} + 1) p{hr} \in dom Redo.prefixes{hr}))=>//=_. + case((take (i{hr} + 1) p{hr} \in Redo.prefixes{hr}))=>//=_. rewrite negb_or negb_exists/=;progress. - + by rewrite memE prefixe_lt_size//=-(@prefixe_exchange _ _ p{hr} H1 H0)//=/#. + + by rewrite -mem_fdom memE prefix_lt_size//=-(@prefix_exchange _ _ p{hr} H1 H0)//=/#. case(0<=a<=i{hr})=>//=ha;smt(size_take). - + sp;auto;if;auto;progress. * rewrite/#. - * move=>x;rewrite dom_set in_fsetU1=>[][|h];1: - smt(dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop). - rewrite h=>j;rewrite take_take in_fsetU1/min. + * move=>x;rewrite mem_set=>[][|h];1: + smt(mem_set take_size oget_some get_setE domE take_oversize take_le0 take_take cat_take_drop). + rewrite h=>j;rewrite take_take /min. case(j//=hij. - cut->:take j p{2} = take j (take i{2} p{2});smt(take_take take_le0). - * smt(prefixe_lt_size dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop memE). - * smt(prefixe_lt_size dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop memE). - * smt(prefixe_lt_size dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop memE). - * rewrite!getP/=. - cut/#: !take (i{2} + 1) p{2} \in dom pref{2}. - by rewrite memE prefixe_lt_size//=-(@prefixe_exchange _ _ _ H1 H0)//=/#. - * smt(prefixe_lt_size dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop memE). - * smt(prefixe_lt_size dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop memE). - * smt(prefixe_lt_size dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop memE). - * move=>x;rewrite dom_set in_fsetU1=>[][|h];1: - smt(dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop). - rewrite h=>j;rewrite take_take in_fsetU1/min. + case: (0 <= j)=> hj //=. + + by rewrite mem_set; left; apply/H6=> /#. + rewrite mem_set (take_le0 j) 1:/#; left. + by rewrite -(take0 (take i{2} p{2})); apply/H/domE; rewrite H4. + * smt(prefix_lt_size mem_set take_size oget_some get_setE domE take_oversize take_le0 take_take cat_take_drop memE). + * smt(prefix_lt_size mem_set take_size oget_some get_setE domE take_oversize take_le0 take_take cat_take_drop memE). + * smt(prefix_lt_size mem_set take_size oget_some get_setE domE take_oversize take_le0 take_take cat_take_drop memE). + * rewrite!get_setE/=. + cut/#: !take (i{2} + 1) p{2} \in pref{2}. + by rewrite -mem_fdom memE prefix_lt_size//=-(@prefix_exchange _ _ _ H1 H0)//=/#. + * rewrite get_set_sameE !oget_some. + have: take (i{2} + 1) p{2} \notin Redo.prefixes{2}. + + move: (H7 (take (i{2} + 1) p{2})); case: (take (i{2} + 1) p{2} \in Redo.prefixes{2})=> //= _. + rewrite negb_or negb_exists //=; split. + + rewrite -mem_fdom memE; apply/prefix_lt_size. + + by rewrite -(prefix_exchange C.queries{2}) // /#. + by rewrite -(prefix_exchange C.queries{2}) // /#. + smt(size_take). + rewrite domE=> /= H728; rewrite get_set_neqE 2:H5 //. + have /H5:= H13. + by apply/contraLR=> /= ->>; move: H13; rewrite domE H728=> ->. + * smt(prefix_lt_size mem_set take_size oget_some get_setE domE take_oversize take_le0 take_take cat_take_drop memE mem_fdom). + * smt(prefix_lt_size mem_set take_size oget_some get_setE domE take_oversize take_le0 take_take cat_take_drop memE). + * smt(). + * move=>x;rewrite mem_set =>[][|h];1: + smt(mem_set take_size oget_some get_setE domE take_oversize take_le0 take_take cat_take_drop). + rewrite h=>j;rewrite take_take /min. case(j//=hij. +(** HERE! CECILE! WE ARE HERE! **) cut->:take j p{2} = take j (take i{2} p{2});smt(take_take take_le0). - * smt(prefixe_lt_size dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop memE). - * smt(prefixe_lt_size dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop memE). - * smt(prefixe_lt_size dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop memE). + * smt(prefix_lt_size dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop memE). + * smt(prefix_lt_size dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop memE). + * smt(prefix_lt_size dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop memE). * rewrite!getP/=. - cut/#: !take (i{2} + 1) p{2} \in dom pref{2}. - by rewrite memE prefixe_lt_size//=-(@prefixe_exchange _ _ _ H1 H0)//=/#. - * smt(prefixe_lt_size dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop memE). - * smt(prefixe_lt_size dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop memE). + cut/#: !take (i{2} + 1) p{2} \in pref{2}. + by rewrite memE prefix_lt_size//=-(@prefix_exchange _ _ _ H1 H0)//=/#. + * smt(prefix_lt_size dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop memE). + * smt(prefix_lt_size dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop memE). conseq(:_==> ={sa,sc,Perm.m,Perm.mi,Redo.prefixes,i,p} /\ C.c{1} = C.c{2} - size p{2} + i{2} /\ pref{2} = Redo.prefixes{2} /\ all_prefixes pref{2} - /\ prefixe_inv C.queries{2} pref{2} - /\ prefixe p{2} (get_max_prefixe p{2} (elems (dom C.queries{2}))) = i{2} + /\ prefix_inv C.queries{2} pref{2} + /\ prefix p{2} (get_max_prefix p{2} (elems (dom C.queries{2}))) = i{2} /\ Redo.prefixes{2}.[take i{2} p{2}] = Some (sa{2}, sc{2}));1: - smt(prefixe_sizel take_get_max_prefixe2 in_dom prefixe_exchange). + smt(prefix_sizel take_get_max_prefix2 in_dom prefix_exchange). while( ={sa,sc,Perm.m,Perm.mi,Redo.prefixes,i,p} - /\ C.c{1} = C.c{2} - size p{2} + prefixe p{2} (get_max_prefixe p{2} (elems (dom C.queries{2}))) + /\ C.c{1} = C.c{2} - size p{2} + prefix p{2} (get_max_prefix p{2} (elems (dom C.queries{2}))) /\ pref{2} = Redo.prefixes{2} /\ all_prefixes pref{2} - /\ prefixe_inv C.queries{2} pref{2} - /\ 0 <= i{2} <= prefixe p{2} (get_max_prefixe p{2} (elems (dom C.queries{2}))) + /\ prefix_inv C.queries{2} pref{2} + /\ 0 <= i{2} <= prefix p{2} (get_max_prefix p{2} (elems (dom C.queries{2}))) /\ Redo.prefixes{2}.[take i{2} p{2}] = Some (sa{2}, sc{2})). + rcondt{1}1;2:rcondt{2}1;auto;progress. - * rewrite/#. search get_max_prefixe (<=) take mem. - * rewrite(@prefixe_inv_leq _ _ _ _ _ _ H H7 H0)//= 1:/#. + * rewrite/#. search get_max_prefix (<=) take mem. + * rewrite(@prefix_inv_leq _ _ _ _ _ _ H H7 H0)//= 1:/#. cut:=H0=>[][h1 [h2 h3]]. cut:=h3 _ _ _ H7;last smt(memE). smt(size_eq0 size_take). * smt(get_oget in_dom). auto;progress. * rewrite/#. - * smt(prefixe_ge0). + * smt(prefix_ge0). * smt(take0). - * smt(prefixe_sizel @Prefixe memE). - * smt(prefixe_sizel @Prefixe memE). + * smt(prefix_sizel @Prefix memE). + * smt(prefix_sizel @Prefix memE). have p_ll := P_f_ll _ _. + apply/dprod_ll; split. diff --git a/proof/smart_counter/SLCommon.ec b/proof/smart_counter/SLCommon.ec index 8476601..4fda277 100644 --- a/proof/smart_counter/SLCommon.ec +++ b/proof/smart_counter/SLCommon.ec @@ -3,11 +3,16 @@ length is the input block size. We prove its security even when padding is not prefix-free. **) require import Core Int Real StdOrder Ring IntExtra. -require import List FSet NewFMap Utils Common RndO DProd Dexcepted. +require import List FSet SmtMap Common PROM DProd Dexcepted. require (*..*) Indifferentiability. (*...*) import Capacity IntOrder. +pragma -oldip. + +(** Really? **) +abbrev ([+]) ['a 'b] (x : 'b) = fun (_ : 'a) => x. + type state = block * capacity. op dstate = bdistr `*` cdistr. @@ -33,18 +38,17 @@ op bl_univ = FSet.oflist bl_enum. (* -------------------------------------------------------------------------- *) (* Random oracle from block list to block *) -clone import RndO.GenEager as F with +clone import PROM.GenEager as F with type from <- block list, type to <- block, op sampleto <- fun (_:block list)=> bdistr proof * by exact Block.DBlock.dunifin_ll. - module Redo = { var prefixes : (block list, state) fmap proc init() : unit = { - prefixes <- map0.[[] <- (b0,c0)]; + prefixes <- empty.[[] <- (b0,c0)]; } }. @@ -59,7 +63,7 @@ module SqueezelessSponge (P:DPRIMITIVE): FUNCTIONALITY = { var i : int <- 0; while (i < size p) { (* Absorption *) - if (take (i+1) p \in dom Redo.prefixes) { + if (take (i+1) p \in Redo.prefixes) { (sa,sc) <- oget Redo.prefixes.[take (i+1) p]; } else { (sa,sc) <- (sa +^ nth witness p i, sc); @@ -99,686 +103,683 @@ type hsmap = (hstate, hstate ) fmap. type handles = (handle, ccapacity) fmap. pred is_pre_permutation (m mi : ('a,'a) fmap) = - (forall x, mem (rng m) x => mem (dom mi) x) - /\ (forall x, mem (rng mi) x => mem (dom m) x). + (forall x, rng m x => dom mi x) + /\ (forall x, rng mi x => dom m x). lemma half_permutation_set (m' mi' : ('a,'a) fmap) x' y': - (forall x, mem (rng m') x => mem (dom mi') x) - => (forall x, mem (rng m'.[x' <- y']) x => mem (dom mi'.[y' <- x']) x). + (forall x, rng m' x => dom mi' x) + => (forall x, rng m'.[x' <- y'] x => dom mi'.[y' <- x'] x). proof. - move=> h x0. - rewrite rng_set domP !in_fsetU in_fset1 => -[/rng_rem_le in_rng|//=]. - by rewrite h. +move=> h x0; rewrite rngE=> - /= [x]; case: (x = x')=> [<*>|]. ++ by rewrite get_set_sameE=> /= <*>; rewrite domE get_set_sameE. +rewrite get_setE=> -> /= m'x_x0; move: (h x0 _). ++ by rewrite rngE; exists x. +by rewrite mem_set=> ->. qed. lemma pre_permutation_set (m mi : ('a,'a) fmap) x y: is_pre_permutation m mi => is_pre_permutation m.[x <- y] mi.[y <- x]. proof. - move=> [dom_mi dom_m]. - by split; apply/half_permutation_set. +move=> [dom_mi dom_m]. +by split; apply/half_permutation_set. qed. (* Functionnal version of the construction using handle *) - op step_hpath (mh:hsmap) (sah:hstate option) (b:block) = - if sah = None then None - else - let sah = oget sah in - mh.[(sah.`1 +^ b, sah.`2)]. + if sah = None + then None + else + let sah = oget sah in + mh.[(sah.`1 +^ b, sah.`2)]. op build_hpath (mh:hsmap) (bs:block list) = - foldl (step_hpath mh) (Some (b0,0)) bs. + foldl (step_hpath mh) (Some (b0,0)) bs. inductive build_hpath_spec mh p v h = - | Empty of (p = []) - & (v = b0) - & (h = 0) - | Extend p' b v' h' of (p = rcons p' b) - & (build_hpath mh p' = Some (v',h')) - & (mh.[(v' +^ b,h')] = Some (v,h)). +| Empty of (p = []) + & (v = b0) + & (h = 0) +| Extend p' b v' h' of (p = rcons p' b) + & (build_hpath mh p' = Some (v',h')) + & (mh.[(v' +^ b,h')] = Some (v,h)). lemma build_hpathP mh p v h: build_hpath mh p = Some (v,h) <=> build_hpath_spec mh p v h. proof. -elim/last_ind: p v h=> @/build_hpath //= [v h|p b ih v h]. -+ by rewrite andaE; split=> [!~#] <*>; [exact/Empty|move=> [] /#]. +elim/last_ind: p v h=> @/build_hpath //= [v h|p b ih v h]. ++ by rewrite andaE; split=> [!~#] <*>; [exact/Empty|move=> []]; smt(size_rcons size_ge0). rewrite -{1}cats1 foldl_cat {1}/step_hpath /=. case: {-1}(foldl _ _ _) (eq_refl (foldl (step_hpath mh) (Some (b0,0)) p))=> //=. -+ apply/implybN; case=> [/#|p' b0 v' h']. ++ apply/implybN; case=> [|p' b0 v' h']. + + smt(size_rcons size_ge0). move=> ^/rconssI <<- {p'} /rconsIs ->> {b}. by rewrite /build_hpath=> ->. move=> [v' h']; rewrite oget_some /= -/(build_hpath _ _)=> build. split. + by move=> mh__; apply/(Extend mh (rcons p b) v h p b v' h' _ build mh__). -case=> [/#|] p' b' v'' h'' ^/rconssI <<- {p'} /rconsIs <<- {b'}. +case=> [| p' b' v'' h'']. ++ smt(size_rcons size_ge0). +move=> ^/rconssI <<- {p'} /rconsIs <<- {b'}. by rewrite build /= => [#] <*>. qed. lemma build_hpath_map0 p: - build_hpath map0 p - = if p = [] then Some (b0,0) else None. + build_hpath empty p = if p = [] then Some (b0,0) else None. proof. elim/last_ind: p=> //= p b _. -by rewrite -{1}cats1 foldl_cat {1}/step_hpath /= map0P /= /#. +by rewrite -{1}cats1 foldl_cat {1}/step_hpath /= emptyE /= [smt(size_rcons size_ge0)]. qed. (* -------------------------------------------------------------------------- *) -theory Prefixe. +theory Prefix. -op prefixe ['a] (s t : 'a list) = - with s = x :: s', t = y :: t' => if x = y then 1 + prefixe s' t' else 0 +op prefix ['a] (s t : 'a list) = + with s = x :: s', t = y :: t' => if x = y then 1 + prefix s' t' else 0 with s = _ :: _ , t = [] => 0 with s = [] , t = _ :: _ => 0 with s = [] , t = [] => 0. -lemma prefixe_eq (l : 'a list) : prefixe l l = size l. +lemma prefix0s (s : 'a list): prefix [] s = 0. +proof. by elim: s. qed. + +lemma prefixs0 (s : 'a list): prefix s [] = 0. +proof. by elim: s. qed. + +lemma prefix_eq (l : 'a list) : prefix l l = size l. proof. elim:l=>//=/#. qed. -lemma prefixeC (l1 l2 : 'a list) : - prefixe l1 l2 = prefixe l2 l1. +lemma prefixC (l1 l2 : 'a list) : + prefix l1 l2 = prefix l2 l1. proof. -move:l1;elim l2=>//=;first by move=>l1;elim l1=>//=. -move=>e2 l2 Hind l1;move:e2 l2 Hind;elim l1=>//=. -move=>e1 l1 Hind e2 l2 Hind1;rewrite Hind1/#. +move:l1; elim: l2=> //=; first by (move=> l1; elim: l1=> //=). +move=> e2 l2 Hind l1; move: e2 l2 Hind; elim: l1=> //=. +move=> e1 l1 Hind e2 l2 Hind1; rewrite Hind1 /#. qed. - -lemma prefixe_ge0 (l1 l2 : 'a list) : - 0 <= prefixe l1 l2. +lemma prefix_ge0 (l1 l2 : 'a list) : + 0 <= prefix l1 l2. proof. -move:l2;elim:l1=>//=;first move=>l2;elim:l2=>//=. -move=>e1 l1 Hind l2;move:e1 l1 Hind;elim l2=>//=. -move=>e2 l2 Hind2 e1 l1 Hind1/#. +move: l2; elim: l1=> //=; first (move=> l2; elim: l2=> //=). +move=> e1 l1 Hind l2; move: e1 l1 Hind; elim: l2=> //=. +move=> e2 l2 Hind2 e1 l1 Hind1 /#. qed. -lemma prefixe_sizel (l1 l2 : 'a list) : - prefixe l1 l2 <= size l1. +lemma prefix_sizel (l1 l2 : 'a list) : + prefix l1 l2 <= size l1. proof. -move:l2;elim :l1=>//=;first by move=>l2;elim l2=>//=. -move=>e1 l1 Hind l2;move:e1 l1 Hind;elim l2=>//=;1:smt(size_ge0). -move=>e2 l2 Hind2 e1 l1 Hind1/#. +move: l2; elim: l1=> //=; first by (move=> l2; elim: l2=> //=). +move=> e1 l1 Hind l2; move: e1 l1 Hind; elim: l2=> //=; 1:smt(size_ge0). +by move=> e2 l2 Hind2 e1 l1 Hind1; smt(size_ge0). qed. -lemma prefixe_sizer (l1 l2 : 'a list) : - prefixe l1 l2 <= size l2. +lemma prefix_sizer (l1 l2 : 'a list) : + prefix l1 l2 <= size l2. proof. -by rewrite prefixeC prefixe_sizel. +by rewrite prefixC prefix_sizel. qed. - -lemma prefixe_take (l1 l2 : 'a list) : - take (prefixe l1 l2) l1 = take (prefixe l1 l2) l2. +lemma prefix_take (l1 l2 : 'a list) : + take (prefix l1 l2) l1 = take (prefix l1 l2) l2. proof. -move:l2;elim l1=>//=; first by move=>l2;elim l2=>//=. -move=>e1 l1 Hind l2/=;move:e1 l1 Hind;elim l2=>//=. -move=>e2 l2 Hind1 e1 l1 Hind2=>//=. -by case(e1=e2)=>[->//=/#|//=]. +move: l2; elim: l1=> //=; first by (move=> l2; elim: l2=> //=). +move=> e1 l1 Hind l2 /=; move: e1 l1 Hind; elim: l2=> //=. +move=> e2 l2 Hind1 e1 l1 Hind2=> //=. +by case: (e1 = e2)=> [-> /#|]. qed. lemma take_take (l : 'a list) (i j : int) : - take i (take j l) = take (min i j) l. + take i (take j l) = take (min i j) l. proof. -case(i <= j)=>Hij. -+ case(j < size l)=>Hjsize;last smt(take_oversize). - case(0 <= i)=>Hi0;last smt(take_le0). - apply (eq_from_nth witness);1:smt(size_take). - move=>k;rewrite !size_take//=1:/# Hjsize/=. - cut->: (if i < j then i else j) = i by rewrite/#. - move=>[Hk0 Hki]. - by rewrite !nth_take//=/#. -case(0//=Hj0;last smt(take_le0). -rewrite min_ler 1:/#. -pose l':=take j l. -rewrite take_oversize//=. -rewrite/l' size_take /#. +case: (i <= j)=> Hij. ++ case: (j < size l)=> Hjsize; last smt(take_oversize). + case: (0 <= i)=> Hi0; last smt(take_le0). + apply: (eq_from_nth witness); 1:smt(size_take). + move=> k; rewrite !size_take //= 1:/# Hjsize /=. + have ->: (if i < j then i else j) = i by smt(). + move=> [Hk0 Hki]. + by rewrite !nth_take /#. +case: (0 < j)=> //= Hj0; last smt(take_le0). +rewrite min_ler 1:/#. +by rewrite take_oversize //= size_take /#. qed. -lemma prefixe_take_leq (l1 l2 : 'a list) (i : int) : - i <= prefixe l1 l2 => take i l1 = take i l2. +lemma prefix_take_leq (l1 l2 : 'a list) (i : int) : + i <= prefix l1 l2 => take i l1 = take i l2. proof. -move=>Hi. -cut->:i = min i (prefixe l1 l2) by smt(min_lel). -by rewrite-(take_take l1 i _)-(take_take l2 i _) prefixe_take. +move=> Hi; have ->: i = min i (prefix l1 l2) by smt(min_lel). +by rewrite -(take_take l1 i _) -(take_take l2 i _) prefix_take. qed. -lemma prefixe_nth (l1 l2 : 'a list) : - let i = prefixe l1 l2 in - forall j, 0 <= j < i => - nth witness l1 j = nth witness l2 j. +lemma prefix_nth (l1 l2 : 'a list) : + let i = prefix l1 l2 in + forall j, 0 <= j < i => + nth witness l1 j = nth witness l2 j. proof. -rewrite/=. -cut Htake:=prefixe_take l1 l2. search nth take. -move=>j[Hj0 Hjp];rewrite-(nth_take witness (prefixe l1 l2))1:prefixe_ge0//. -by rewrite-(nth_take witness (prefixe l1 l2) l2)1:prefixe_ge0//Htake. +move=> /=; have Htake:= prefix_take l1 l2. +move=> j [Hj0 Hjp]; rewrite -(nth_take witness (prefix l1 l2)) 1:prefix_ge0 //. +by rewrite -(nth_take witness (prefix l1 l2) l2) 1:prefix_ge0 // Htake. qed. - -op max_prefixe (l1 l2 : 'a list) (ll : 'a list list) = +(* TODO: can we define this as a fold on a set instead of on a list? *) +op max_prefix (l1 l2 : 'a list) (ll : 'a list list) = with ll = "[]" => l2 with ll = (::) l' ll' => - if prefixe l1 l2 < prefixe l1 l' then max_prefixe l1 l' ll' - else max_prefixe l1 l2 ll'. - + if prefix l1 l2 < prefix l1 l' then max_prefix l1 l' ll' + else max_prefix l1 l2 ll'. -op get_max_prefixe (l : 'a list) (ll : 'a list list) = +op get_max_prefix (l : 'a list) (ll : 'a list list) = with ll = "[]" => [] - with ll = (::) l' ll' => max_prefixe l l' ll'. + with ll = (::) l' ll' => max_prefix l l' ll'. - -pred prefixe_inv (queries : (block list, block) fmap) - (prefixes : (block list, state) fmap) = +pred prefix_inv (queries : (block list, block) fmap) + (prefixes : (block list, state) fmap) = (forall (bs : block list), - bs \in dom queries => oget queries.[bs] = (oget prefixes.[bs]).`1) && + bs \in queries => oget queries.[bs] = (oget prefixes.[bs]).`1) && (forall (bs : block list), - bs \in dom queries => forall i, take i bs \in dom prefixes) && + bs \in queries => forall i, take i bs \in prefixes) && (forall (bs : block list), forall i, take i bs <> [] => - take i bs \in dom prefixes => - exists l2, (take i bs) ++ l2 \in dom queries). + take i bs \in prefixes => + exists l2, (take i bs) ++ l2 \in queries). pred all_prefixes (prefixes : (block list, state) fmap) = - forall (bs : block list), bs \in dom prefixes => forall i, take i bs \in dom prefixes. + forall (bs : block list), bs \in prefixes => forall i, take i bs \in prefixes. -lemma aux_mem_get_max_prefixe (l1 l2 : 'a list) ll : - max_prefixe l1 l2 ll = l2 \/ max_prefixe l1 l2 ll \in ll. +lemma aux_mem_get_max_prefix (l1 l2 : 'a list) ll : + max_prefix l1 l2 ll = l2 \/ max_prefix l1 l2 ll \in ll. proof. -move:l1 l2;elim:ll=>//=l3 ll Hind l1 l2. -case(prefixe l1 l2 < prefixe l1 l3)=>//=hmax. -+ cut/#:=Hind l1 l3. -cut/#:=Hind l1 l2. +move: l1 l2; elim: ll=> //= l3 ll Hind l1 l2. +case: (prefix l1 l2 < prefix l1 l3)=> //= hmax. ++ by have /#:= Hind l1 l3. +by have /#:= Hind l1 l2. qed. - -lemma mem_get_max_prefixe (l : 'a list) ll : - ll <> [] => get_max_prefixe l ll \in ll. +lemma mem_get_max_prefix (l : 'a list) ll : + ll <> [] => get_max_prefix l ll \in ll. proof. -move:l;elim:ll=>//=l2 ll Hind l1. -exact aux_mem_get_max_prefixe. +move: l; elim: ll=> //= l2 ll Hind l1. +exact/aux_mem_get_max_prefix. qed. - -lemma take_get_max_prefixe l prefixes : - (exists b, b \in dom prefixes) => - all_prefixes prefixes => - take (prefixe l (get_max_prefixe l (elems (dom prefixes)))) l \in dom prefixes. +lemma take_get_max_prefix l (prefixes : (block list,state) fmap) : + (exists b, b \in prefixes) => + all_prefixes prefixes => + take (prefix l (get_max_prefix l (elems (fdom prefixes)))) l \in prefixes. proof. -move=>nil_in_dom all_pref. -rewrite prefixe_take all_pref memE mem_get_max_prefixe;smt(memE). +move=> nil_in_dom all_pref. +rewrite prefix_take all_pref -mem_fdom memE mem_get_max_prefix; smt(memE mem_fdom). qed. -lemma take_get_max_prefixe2 l prefixes i : - (exists b, b \in dom prefixes) => - all_prefixes prefixes => - i <= prefixe l (get_max_prefixe l (elems (dom prefixes))) => - take i l \in dom prefixes. +lemma take_get_max_prefix2 l (prefixes : (block list,state) fmap) i : + (exists b, b \in prefixes) => + all_prefixes prefixes => + i <= prefix l (get_max_prefix l (elems (fdom prefixes))) => + take i l \in prefixes. proof. -move=>nil_in_dom all_pref hi. -rewrite (prefixe_take_leq _ _ i hi) all_pref memE mem_get_max_prefixe;smt(memE). +move=> nil_in_dom all_pref hi. +rewrite (prefix_take_leq _ _ i hi) all_pref -mem_fdom memE mem_get_max_prefix. +smt(memE mem_fdom). qed. +lemma prefix_cat (l l1 l2 : 'a list) : + prefix (l ++ l1) (l ++ l2) = size l + prefix l1 l2. +proof. by move: l1 l2; elim: l=> /#. qed. -lemma prefixe_cat (l l1 l2 : 'a list) : - prefixe (l ++ l1) (l ++ l2) = size l + prefixe l1 l2. -proof. -move:l1 l2;elim l=>//=/#. -qed. - - -lemma prefixe_leq_take (l1 l2 : 'a list) i : - 0 <= i <= min (size l1) (size l2) => - take i l1 = take i l2 => - i <= prefixe l1 l2. +lemma prefix_leq_take (l1 l2 : 'a list) i : + 0 <= i <= min (size l1) (size l2) => + take i l1 = take i l2 => + i <= prefix l1 l2. proof. move=> [hi0 himax] htake. -rewrite-(cat_take_drop i l1)-(cat_take_drop i l2)htake. -rewrite prefixe_cat size_take//=;smt(prefixe_ge0). +rewrite -(cat_take_drop i l1) -(cat_take_drop i l2) htake. +rewrite prefix_cat size_take //=; smt(prefix_ge0). qed. -lemma prefixe0 (l1 l2 : 'a list) : - prefixe l1 l2 = 0 <=> l1 = [] \/ l2 = [] \/ head witness l1 <> head witness l2 . +lemma prefix0 (l1 l2 : 'a list) : + prefix l1 l2 = 0 <=> l1 = [] \/ l2 = [] \/ head witness l1 <> head witness l2 . proof. -move:l2;elim:l1=>//=;1:rewrite/#;move=>e1 l1 Hind l2;move:e1 l1 Hind;elim:l2=>//=e2 l2 Hind2 e1 l1 Hind1. -smt(prefixe_ge0). +move: l2; elim: l1=> //= [[] //=|]. +move=> e1 l1 Hind l2; move: e1 l1 Hind; elim: l2=> //= e2 l2 Hind2 e1 l1 Hind1. +smt(prefix_ge0). qed. lemma head_nth0 (l : 'a list) : head witness l = nth witness l 0. -proof. by elim:l. qed. - - -lemma get_prefixe (l1 l2 : 'a list) i : - 0 <= i <= min (size l1) (size l2)=> - (drop i l1 = [] \/ drop i l2 = [] \/ - (i < min (size l1) (size l2) /\ - nth witness l1 i <> nth witness l2 i)) => - take i l1 = take i l2 => - i = prefixe l1 l2. +proof. by elim: l. qed. + +lemma get_prefix (l1 l2 : 'a list) i : + 0 <= i <= min (size l1) (size l2)=> + (drop i l1 = [] \/ drop i l2 = [] \/ + (i < min (size l1) (size l2) /\ + nth witness l1 i <> nth witness l2 i)) => + take i l1 = take i l2 => + i = prefix l1 l2. proof. move=>[hi0 hisize] [|[]]. -+ move=>hi. - cut:=size_eq0 (drop i l1);rewrite {2}hi/=size_drop// =>h. - cut hsize: size l1 = i by rewrite/#. ++ move=> hi. + have:= size_eq0 (drop i l1); rewrite {2}hi /= size_drop // => h. + have hsize: size l1 = i by smt(). rewrite -hsize take_size. - rewrite-{2}(cat_take_drop (size l1) l2)=><-. - by rewrite-{2}(cats0 l1)prefixe_cat/#. -+ move=>hi. - cut:=size_eq0 (drop i l2);rewrite {2}hi/=size_drop// =>h. - cut hsize: size l2 = i by rewrite/#. + rewrite -{2}(cat_take_drop (size l1) l2)=> <-. + by rewrite -{2}(cats0 l1) prefix_cat; case: (drop (size l1) l2). ++ move=> hi. + have:= size_eq0 (drop i l2); rewrite {2}hi /= size_drop // => h. + have hsize: size l2 = i by rewrite /#. rewrite -hsize take_size. - rewrite-{2}(cat_take_drop (size l2) l1)=>->. - by rewrite-{4}(cats0 l2)prefixe_cat/#. -move=>[himax hnth] htake. -rewrite-(cat_take_drop i l1)-(cat_take_drop i l2)htake. -rewrite prefixe_cat size_take//=. -+ cut[_ ->]:=prefixe0 (drop i l1) (drop i l2). - case(i = size l1)=>hi1//=. - + by rewrite hi1 drop_size//=. - case(i = size l2)=>hi2//=. - + by rewrite hi2 drop_size//=. - by rewrite 2!head_nth0 nth_drop//=nth_drop//= hnth. -rewrite/#. + rewrite -{2}(cat_take_drop (size l2) l1)=> ->. + by rewrite -{4}(cats0 l2) prefix_cat; case: (drop (size l2) l1). +move=> [himax hnth] htake. +rewrite -(cat_take_drop i l1) -(cat_take_drop i l2) htake. +rewrite prefix_cat size_take //=. +have [_ ->]:= prefix0 (drop i l1) (drop i l2). ++ case: (i = size l1)=> hi1 //=. + + by rewrite hi1 drop_size //=. + case: (i = size l2)=> hi2 //=. + + by rewrite hi2 drop_size //=. + by rewrite 2!head_nth0 nth_drop //= nth_drop //= hnth. +smt(). qed. -lemma get_max_prefixe_leq (l1 l2 : 'a list) (ll : 'a list list) : - prefixe l1 l2 <= prefixe l1 (max_prefixe l1 l2 ll). -proof. -move:l1 l2;elim:ll=>//=/#. -qed. +lemma get_max_prefix_leq (l1 l2 : 'a list) (ll : 'a list list) : + prefix l1 l2 <= prefix l1 (max_prefix l1 l2 ll). +proof. by move: l1 l2; elim: ll=> /#. qed. -lemma get_max_prefixe_is_max (l1 l2 : 'a list) (ll : 'a list list) : - forall l3, l3 \in ll => prefixe l1 l3 <= prefixe l1 (max_prefixe l1 l2 ll). +lemma get_max_prefix_is_max (l1 l2 : 'a list) (ll : 'a list list) : + forall l3, l3 \in ll => prefix l1 l3 <= prefix l1 (max_prefix l1 l2 ll). proof. -move:l1 l2;elim:ll=>//=. -move=>l4 ll Hind l1 l2 l3. -case(prefixe l1 l2 < prefixe l1 l4)=>//=h [];smt( get_max_prefixe_leq ). +move: l1 l2; elim: ll=> //= l4 ll Hind l1 l2 l3. +by case: (prefix l1 l2 < prefix l1 l4)=> //= h []; smt(get_max_prefix_leq). qed. -lemma get_max_prefixe_max (l : 'a list) (ll : 'a list list) : - forall l2, l2 \in ll => prefixe l l2 <= prefixe l (get_max_prefixe l ll). -proof. smt(get_max_prefixe_is_max get_max_prefixe_leq). qed. +lemma get_max_prefix_max (l : 'a list) (ll : 'a list list) : + forall l2, l2 \in ll => prefix l l2 <= prefix l (get_max_prefix l ll). +proof. smt(get_max_prefix_is_max get_max_prefix_leq). qed. +(** TODO: NOT PRETTY! **) lemma all_take_in (l : block list) i prefixes : - 0 <= i <= size l => - all_prefixes prefixes => - take i l \in dom prefixes => - i <= prefixe l (get_max_prefixe l (elems (dom prefixes))). + 0 <= i <= size l => + all_prefixes prefixes => + take i l \in prefixes => + i <= prefix l (get_max_prefix l (elems (fdom prefixes))). proof. -move=>[hi0 hisize] all_prefixe take_in_dom. -cut->:i = prefixe l (take i l);2:smt(get_max_prefixe_max memE). -apply get_prefixe. +move=>[hi0 hisize] all_prefix take_in_dom. +cut->:i = prefix l (take i l);2:smt(get_max_prefix_max memE mem_fdom). +apply get_prefix. + smt(size_take). + by right;left;apply size_eq0;rewrite size_drop//size_take//=/#. smt(take_take). qed. -lemma prefixe_inv_leq (l : block list) i prefixes queries : +lemma prefix_inv_leq (l : block list) i prefixes queries : 0 <= i <= size l => - elems (dom queries) <> [] => + elems (fdom queries) <> [] => all_prefixes prefixes => - take i l \in dom prefixes => - prefixe_inv queries prefixes => - i <= prefixe l (get_max_prefixe l (elems (dom queries))). + take i l \in prefixes => + prefix_inv queries prefixes => + i <= prefix l (get_max_prefix l (elems (fdom queries))). proof. -move=>h_i h_nil h_all_prefixes take_in_dom [?[h_prefixe_inv h_exist]]. +move=>h_i h_nil h_all_prefixes take_in_dom [?[h_prefix_inv h_exist]]. case(take i l = [])=>//=h_take_neq_nil. -+ smt(prefixe_ge0 size_eq0). ++ smt(prefix_ge0 size_take). cut[l2 h_l2_mem]:=h_exist l i h_take_neq_nil take_in_dom. -rewrite memE in h_l2_mem. -rewrite(StdOrder.IntOrder.ler_trans _ _ _ _ (get_max_prefixe_max _ _ _ h_l2_mem)). -rewrite-{1}(cat_take_drop i l)prefixe_cat size_take 1:/#;smt(prefixe_ge0). +rewrite -mem_fdom memE in h_l2_mem. +rewrite(StdOrder.IntOrder.ler_trans _ _ _ _ (get_max_prefix_max _ _ _ h_l2_mem)). +rewrite-{1}(cat_take_drop i l)prefix_cat size_take 1:/#;smt(prefix_ge0). qed. -lemma max_prefixe_eq (l : 'a list) (ll : 'a list list) : - max_prefixe l l ll = l. +lemma max_prefix_eq (l : 'a list) (ll : 'a list list) : + max_prefix l l ll = l. proof. -move:l;elim:ll=>//=l2 ll Hind l1;smt( prefixe_eq prefixe_sizel). +move:l;elim:ll=>//=l2 ll Hind l1;smt( prefix_eq prefix_sizel). qed. -lemma prefixe_max_prefixe_eq_size (l1 l2 : 'a list) (ll : 'a list list) : +lemma prefix_max_prefix_eq_size (l1 l2 : 'a list) (ll : 'a list list) : l1 = l2 \/ l1 \in ll => - prefixe l1 (max_prefixe l1 l2 ll) = size l1. + prefix l1 (max_prefix l1 l2 ll) = size l1. proof. -move:l1 l2;elim:ll=>//=;1:smt(prefixe_eq). +move:l1 l2;elim:ll=>//=;1:smt(prefix_eq). move=>l3 ll Hind l1 l2[->|[->|h1]]. -+ rewrite prefixe_eq max_prefixe_eq;smt(max_prefixe_eq prefixe_eq prefixe_sizer). -+ rewrite prefixe_eq max_prefixe_eq. - case(prefixe l3 l2 < size l3)=>//=h;1:by rewrite prefixe_eq. - cut h1:prefixe l3 l2 = size l3 by smt(prefixe_sizel). - cut: size l3 <= prefixe l3 (max_prefixe l3 l2 ll);2:smt(prefixe_sizel). ++ rewrite prefix_eq max_prefix_eq;smt(max_prefix_eq prefix_eq prefix_sizer). ++ rewrite prefix_eq max_prefix_eq. + case(prefix l3 l2 < size l3)=>//=h;1:by rewrite prefix_eq. + cut h1:prefix l3 l2 = size l3 by smt(prefix_sizel). + cut: size l3 <= prefix l3 (max_prefix l3 l2 ll);2:smt(prefix_sizel). rewrite-h1. by clear Hind l1 h h1;move:l2 l3;elim:ll=>//=l3 ll Hind l1 l2/#. -by case(prefixe l1 l2 < prefixe l1 l3)=>//=/#. +by case(prefix l1 l2 < prefix l1 l3)=>//=/#. qed. -lemma prefixe_get_max_prefixe_eq_size (l : 'a list) (ll : 'a list list) : +lemma prefix_get_max_prefix_eq_size (l : 'a list) (ll : 'a list list) : l \in ll => - prefixe l (get_max_prefixe l ll) = size l. + prefix l (get_max_prefix l ll) = size l. proof. -move:l;elim:ll=>//;smt(prefixe_max_prefixe_eq_size). +move:l;elim:ll=>//;smt(prefix_max_prefix_eq_size). qed. -lemma get_max_prefixe_exists (l : 'a list) (ll : 'a list list) : +lemma get_max_prefix_exists (l : 'a list) (ll : 'a list list) : ll <> [] => - exists l2, take (prefixe l (get_max_prefixe l ll)) l ++ l2 \in ll. + exists l2, take (prefix l (get_max_prefix l ll)) l ++ l2 \in ll. proof. move:l;elim:ll=>//=l2 ll Hind l1;clear Hind;move:l1 l2;elim:ll=>//=. -+ smt(cat_take_drop prefixe_take). ++ smt(cat_take_drop prefix_take). move=>l3 ll Hind l1 l2. -case( prefixe l1 l2 < prefixe l1 l3 )=>//=h/#. +case( prefix l1 l2 < prefix l1 l3 )=>//=h/#. qed. -lemma prefixe_geq (l1 l2 : 'a list) : - prefixe l1 l2 = prefixe (take (prefixe l1 l2) l1) (take (prefixe l1 l2) l2). +lemma prefix_geq (l1 l2 : 'a list) : + prefix l1 l2 = prefix (take (prefix l1 l2) l1) (take (prefix l1 l2) l2). proof. -move:l2;elim:l1=>//=[/#|]e1 l1 Hind l2;elim:l2=>//=e2 l2 Hind2. +move:l2;elim:l1=>//=[[] //=|] e1 l1 Hind l2;elim:l2=>//=e2 l2 Hind2. case(e1=e2)=>//=h12. -cut->/=:! 1 + prefixe l1 l2 <= 0 by smt(prefixe_ge0). +cut->/=:! 1 + prefix l1 l2 <= 0 by smt(prefix_ge0). rewrite h12/=/#. qed. -lemma prefixe_take_prefixe (l1 l2 : 'a list) : - prefixe (take (prefixe l1 l2) l1) l2 = prefixe l1 l2. +lemma prefix_take_prefix (l1 l2 : 'a list) : + prefix (take (prefix l1 l2) l1) l2 = prefix l1 l2. proof. move:l2;elim:l1=>//=e1 l1 Hind l2;elim:l2=>//=e2 l2 Hind2. case(e1=e2)=>//=h12. -cut->/=:! 1 + prefixe l1 l2 <= 0 by smt(prefixe_ge0). +cut->/=:! 1 + prefix l1 l2 <= 0 by smt(prefix_ge0). rewrite h12/=/#. qed. -lemma prefixe_leq_prefixe_cat (l1 l2 l3 : 'a list) : - prefixe l1 l2 <= prefixe (l1 ++ l3) l2. +lemma prefix_leq_prefix_cat (l1 l2 l3 : 'a list) : + prefix l1 l2 <= prefix (l1 ++ l3) l2. proof. -move:l2 l3;elim l1=>//=;1:smt(take_le0 prefixe_ge0). +move:l2 l3;elim l1=>//= [[]|]; 1,2:smt(take_le0 prefix_ge0). move=>e1 l1 hind1 l2;elim:l2=>//=e2 l2 hind2 l3/#. qed. -lemma prefixe_take_leq_prefixe (l1 l2 : 'a list) i : - prefixe (take i l1) l2 <= prefixe l1 l2. +lemma prefix_take_leq_prefix (l1 l2 : 'a list) i : + prefix (take i l1) l2 <= prefix l1 l2. proof. rewrite-{2}(cat_take_drop i l1). move:(take i l1)(drop i l1);clear i l1=>l1 l3. -exact prefixe_leq_prefixe_cat. +exact prefix_leq_prefix_cat. qed. -lemma prefixe_take_geq_prefixe (l1 l2 : 'a list) i : - prefixe l1 l2 <= i => - prefixe l1 l2 = prefixe (take i l1) l2. +lemma prefix_take_geq_prefix (l1 l2 : 'a list) i : + prefix l1 l2 <= i => + prefix l1 l2 = prefix (take i l1) l2. proof. move=>hi. -cut:prefixe (take i l1) l2 <= prefixe l1 l2. -+ rewrite-{2}(cat_take_drop i l1) prefixe_leq_prefixe_cat. -cut/#:prefixe l1 l2 <= prefixe (take i l1) l2. -rewrite -prefixe_take_prefixe. -rewrite-(cat_take_drop (prefixe l1 l2) (take i l1))take_take min_lel// prefixe_leq_prefixe_cat. +cut:prefix (take i l1) l2 <= prefix l1 l2. ++ rewrite-{2}(cat_take_drop i l1) prefix_leq_prefix_cat. +cut/#:prefix l1 l2 <= prefix (take i l1) l2. +rewrite -prefix_take_prefix. +rewrite-(cat_take_drop (prefix l1 l2) (take i l1))take_take min_lel// prefix_leq_prefix_cat. qed. -lemma get_max_prefixe_take (l : 'a list) (ll : 'a list list) i : - prefixe l (get_max_prefixe l ll) <= i => - get_max_prefixe l ll = get_max_prefixe (take i l) ll. +lemma get_max_prefix_take (l : 'a list) (ll : 'a list list) i : + prefix l (get_max_prefix l ll) <= i => + get_max_prefix l ll = get_max_prefix (take i l) ll. proof. move:l;elim:ll=>//=l2 ll Hind l1;clear Hind;move:l1 l2;elim:ll=>//=l3 ll Hind l1 l2. -case( prefixe l1 l2 < prefixe l1 l3 )=>//=h hi. -+ rewrite -prefixe_take_geq_prefixe//=;1:smt(get_max_prefixe_leq). - rewrite -prefixe_take_geq_prefixe//=;1:smt(get_max_prefixe_leq). +case( prefix l1 l2 < prefix l1 l3 )=>//=h hi. ++ rewrite -prefix_take_geq_prefix//=;1:smt(get_max_prefix_leq). + rewrite -prefix_take_geq_prefix//=;1:smt(get_max_prefix_leq). rewrite h/=/#. -rewrite -prefixe_take_geq_prefixe//=;1:smt(get_max_prefixe_leq). -rewrite -prefixe_take_geq_prefixe//=;1:smt(get_max_prefixe_leq). +rewrite -prefix_take_geq_prefix//=;1:smt(get_max_prefix_leq). +rewrite -prefix_take_geq_prefix//=;1:smt(get_max_prefix_leq). rewrite h/=/#. qed. -lemma drop_prefixe_neq (l1 l2 : 'a list) : - drop (prefixe l1 l2) l1 = [] \/ drop (prefixe l1 l2) l1 <> drop (prefixe l1 l2) l2. +lemma drop_prefix_neq (l1 l2 : 'a list) : + drop (prefix l1 l2) l1 = [] \/ drop (prefix l1 l2) l1 <> drop (prefix l1 l2) l2. proof. -move:l2;elim:l1=>//=e1 l1 hind1 l2;elim:l2=>//=e2 l2 hind2/#. +move: l2; elim: l1=> //= e1 l1 hind1; elim=> //= e2 l2 //= hind2 //=. +smt(prefix_ge0). qed. - -lemma prefixe_prefixe_prefixe (l1 l2 l3 : 'a list) (ll : 'a list list) : - prefixe l1 l2 <= prefixe l1 l3 => - prefixe l1 (max_prefixe l1 l2 ll) <= prefixe l1 (max_prefixe l1 l3 ll). +lemma prefix_prefix_prefix (l1 l2 l3 : 'a list) (ll : 'a list list) : + prefix l1 l2 <= prefix l1 l3 => + prefix l1 (max_prefix l1 l2 ll) <= prefix l1 (max_prefix l1 l3 ll). proof. move:l1 l2 l3;elim:ll=>//=l4 ll hind l1 l2 l3 h123/#. qed. -lemma prefixe_lt_size (l : 'a list) (ll : 'a list list) : - prefixe l (get_max_prefixe l ll) < size l => - forall i, prefixe l (get_max_prefixe l ll) < i => +lemma prefix_lt_size (l : 'a list) (ll : 'a list list) : + prefix l (get_max_prefix l ll) < size l => + forall i, prefix l (get_max_prefix l ll) < i => ! take i l \in ll. proof. move:l;elim:ll=>//=l2 ll Hind l1;clear Hind;move:l1 l2;elim:ll=>//=. + progress. - rewrite-(cat_take_drop (prefixe l1 l2) (take i l1)) - -{3}(cat_take_drop (prefixe l1 l2) l2)take_take/min H0/=. - rewrite prefixe_take. - cut:drop (prefixe l1 l2) (take i l1) <> drop (prefixe l1 l2) l2;2:smt(catsI). - rewrite (prefixe_take_geq_prefixe l1 l2 i) 1:/#. - cut:=drop_prefixe_neq (take i l1) l2. - cut/#:drop (prefixe (take i l1) l2) (take i l1) <> []. - cut:0 < size (drop (prefixe (take i l1) l2) (take i l1));2:smt(size_eq0). - rewrite size_drop 1:prefixe_ge0 size_take;1:smt(prefixe_ge0). - by rewrite-prefixe_take_geq_prefixe /#. + rewrite-(cat_take_drop (prefix l1 l2) (take i l1)) + -{3}(cat_take_drop (prefix l1 l2) l2)take_take/min H0/=. + rewrite prefix_take. + cut:drop (prefix l1 l2) (take i l1) <> drop (prefix l1 l2) l2;2:smt(catsI). + rewrite (prefix_take_geq_prefix l1 l2 i) 1:/#. + cut:=drop_prefix_neq (take i l1) l2. + cut/#:drop (prefix (take i l1) l2) (take i l1) <> []. + cut:0 < size (drop (prefix (take i l1) l2) (take i l1));2:smt(size_eq0). + rewrite size_drop 1:prefix_ge0 size_take;1:smt(prefix_ge0). + by rewrite-prefix_take_geq_prefix /#. move=>l3 ll hind l1 l2. -case(prefixe l1 l2 < prefixe l1 l3)=>//=h;progress. +case(prefix l1 l2 < prefix l1 l3)=>//=h;progress. + rewrite!negb_or/=. cut:=hind l1 l3 H i H0;rewrite negb_or=>[][->->]/=. - cut:=hind l1 l2 _ i _;smt(prefixe_prefixe_prefixe). -smt(prefixe_prefixe_prefixe). + cut:=hind l1 l2 _ i _;smt(prefix_prefix_prefix). +smt(prefix_prefix_prefix). qed. lemma asfadst queries prefixes (bs : block list) : - prefixe_inv queries prefixes => - elems (dom queries ) <> [] => + prefix_inv queries prefixes => + elems (fdom queries ) <> [] => all_prefixes prefixes => - (forall j, 0 <= j <= size bs => take j bs \in dom prefixes) => - take (prefixe bs (get_max_prefixe bs (elems (dom queries))) + 1) bs = bs. + (forall j, 0 <= j <= size bs => take j bs \in prefixes) => + take (prefix bs (get_max_prefix bs (elems (fdom queries))) + 1) bs = bs. proof. progress. -cut h:=prefixe_inv_leq bs (size bs) prefixes queries _ _ _ _ _;rewrite//=. +cut h:=prefix_inv_leq bs (size bs) prefixes queries _ _ _ _ _;rewrite//=. + exact size_ge0. + rewrite H2//=;exact size_ge0. -cut->/=:prefixe bs (get_max_prefixe bs (elems (dom queries))) = size bs by smt(prefixe_sizel). +cut->/=:prefix bs (get_max_prefix bs (elems (fdom queries))) = size bs by smt(prefix_sizel). rewrite take_oversize/#. qed. -lemma prefixe_exchange_prefixe_inv (ll1 ll2 : 'a list list) (l : 'a list) : +lemma prefix_exchange_prefix_inv (ll1 ll2 : 'a list list) (l : 'a list) : (forall l2, l2 \in ll1 => l2 \in ll2) => (forall (l2 : 'a list), l2 \in ll1 => forall i, take i l2 \in ll2) => (forall l2, l2 \in ll2 => exists l3, l2 ++ l3 \in ll1) => - prefixe l (get_max_prefixe l ll1) = prefixe l (get_max_prefixe l ll2). + prefix l (get_max_prefix l ll1) = prefix l (get_max_prefix l ll2). proof. -case(ll1 = [])=>//=[->/#|]//=ll1_nil. -move=>incl all_prefix incl2 ;cut ll2_nil:ll2 <> [] by rewrite/#. -cut:=get_max_prefixe_max l ll2 (get_max_prefixe l ll1) _. -+ by rewrite incl mem_get_max_prefixe ll1_nil. -cut mem_ll2:=mem_get_max_prefixe l ll2 ll2_nil. +case(ll1 = [])=>//=[-> _ _|]. ++ by case: (ll2 = [])=> [->> //=|] //= + /mem_eq0. +move=> ll1_nil incl all_prefix incl2; have ll2_nil: ll2 <> [] by smt(mem_eq0). +have:= get_max_prefix_max l ll2 (get_max_prefix l ll1) _. ++ by rewrite incl mem_get_max_prefix ll1_nil. +cut mem_ll2:=mem_get_max_prefix l ll2 ll2_nil. cut[]l3 mem_ll1:=incl2 _ mem_ll2. -cut:=get_max_prefixe_max l ll1 _ mem_ll1. -smt(prefixeC prefixe_leq_prefixe_cat). +cut:=get_max_prefix_max l ll1 _ mem_ll1. +smt(prefixC prefix_leq_prefix_cat). qed. -lemma prefixe_inv_nil queries prefixes : - prefixe_inv queries prefixes => - elems (dom queries) = [] => dom prefixes \subset fset1 []. +lemma prefix_inv_nil queries prefixes : + prefix_inv queries prefixes => + elems (fdom queries) = [] => fdom prefixes \subset fset1 []. proof. move=>[h1 [h2 h3]] h4 x h5;rewrite in_fset1. cut:=h3 x (size x). -rewrite take_size h5/=;apply absurd=>//=h6. -rewrite h6/=negb_exists/=;smt(memE). +rewrite take_size -mem_fdom h5/=;apply absurd=>//=h6. +rewrite h6/=negb_exists/=;smt(memE mem_fdom). qed. - -lemma aux_prefixe_exchange queries prefixes (l : block list) : - prefixe_inv queries prefixes => all_prefixes prefixes => - elems (dom queries) <> [] => - prefixe l (get_max_prefixe l (elems (dom queries))) = - prefixe l (get_max_prefixe l (elems (dom prefixes))). +lemma aux_prefix_exchange queries prefixes (l : block list) : + prefix_inv queries prefixes => all_prefixes prefixes => + elems (fdom queries) <> [] => + prefix l (get_max_prefix l (elems (fdom queries))) = + prefix l (get_max_prefix l (elems (fdom prefixes))). proof. -move=>[h1[h2 h3]] h5 h4;apply prefixe_exchange_prefixe_inv. -+ smt(memE take_size). -+ smt(memE). -move=>l2;rewrite-memE=> mem_l2. +move=>[h1[h2 h3]] h5 h4;apply prefix_exchange_prefix_inv. ++ move=> l2; rewrite -memE mem_fdom=> /h2 /(_ (size l2)). + by rewrite take_size -mem_fdom memE. ++ move=> l2; rewrite -memE mem_fdom=> /h2 + i - /(_ i). + by rewrite -mem_fdom memE. +move=>l2; rewrite -memE=> mem_l2. case(l2=[])=>//=hl2;1:rewrite hl2/=. -+ move:h4;apply absurd=>//=;rewrite negb_exists/=/#. -smt(memE take_size). ++ move:h4;apply absurd=>//=;rewrite negb_exists/= => /mem_eq0 //=. +have:= h3 l2 (size l2); rewrite take_size hl2 -mem_fdom mem_l2. +by move=> /= [] l3 hl3; exists l3; rewrite -memE mem_fdom. qed. -lemma prefixe_exchange queries prefixes (l : block list) : - prefixe_inv queries prefixes => all_prefixes prefixes => - prefixe l (get_max_prefixe l (elems (dom queries))) = - prefixe l (get_max_prefixe l (elems (dom prefixes))). +lemma prefix_exchange queries prefixes (l : block list) : + prefix_inv queries prefixes => all_prefixes prefixes => + prefix l (get_max_prefix l (elems (fdom queries))) = + prefix l (get_max_prefix l (elems (fdom prefixes))). proof. -move=>[h1[h2 h3]] h5. -case(elems (dom queries) = [])=>//=h4;2:smt(aux_prefixe_exchange). -cut h6:=prefixe_inv_nil queries prefixes _ h4;1:rewrite/#. -rewrite h4/=. -case(elems (dom prefixes) = [])=>//=[->//=|]h7. -cut h8:elems (dom prefixes) = [[]]. -+ cut [hh1 hh2]:[] \in dom prefixes /\ forall x, x \in elems (dom prefixes) => x = [] by smt(memE). - cut h9:=subset_leq_fcard _ _ h6. - apply (eq_from_nth witness)=>//=. - + rewrite-cardE-(fcard1 [<:block>]);move:h9;rewrite!fcard1!cardE=>h9. - cut/#:0 < size (elems (dom prefixes));smt(size_eq0 size_ge0 fcard1). - move:h9;rewrite!fcard1!cardE=>h9 i [hi0 hi1]. - cut->/=:i = 0 by rewrite/#. - by apply hh2;rewrite mem_nth/#. -by rewrite h8=>//=. +move=> [h1[h2 h3]] h5. +case: (elems (fdom queries) = [])=> h4. ++ cut h6:=prefix_inv_nil queries prefixes _ h4;1:rewrite/#. + rewrite h4/=. + have fdom_prefixP: fdom prefixes = fset0 \/ fdom prefixes = fset1 []. + + by move: h6; rewrite !fsetP /(\subset); smt(in_fset0 in_fset1). + case(elems (fdom prefixes) = [])=>//=[->//=|]h7. + cut h8:elems (fdom prefixes) = [[]]. + + have []:= fdom_prefixP. + + by move=> h8; move: h7; rewrite h8 elems_fset0. + by move=> ->; rewrite elems_fset1. + by rewrite h8=>//=. +by apply/(aux_prefix_exchange _ _ _ _ h5 h4). qed. - pred all_prefixes_fset (prefixes : block list fset) = forall bs, bs \in prefixes => forall i, take i bs \in prefixes. -pred inv_prefixe_block (queries : (block list, block) fmap) +pred inv_prefix_block (queries : (block list, block) fmap) (prefixes : (block list, block) fmap) = (forall (bs : block list), - bs \in dom queries => queries.[bs] = prefixes.[bs]) && + bs \in queries => queries.[bs] = prefixes.[bs]) && (forall (bs : block list), - bs \in dom queries => forall i, 0 < i <= size bs => take i bs \in dom prefixes). + bs \in queries => forall i, 0 < i <= size bs => take i bs \in prefixes). -lemma prefixe_gt0_mem l (ll : 'a list list) : - 0 < prefixe l (get_max_prefixe l ll) => - get_max_prefixe l ll \in ll. +lemma prefix_gt0_mem l (ll : 'a list list) : + 0 < prefix l (get_max_prefix l ll) => + get_max_prefix l ll \in ll. proof. move:l;elim:ll=>//=;first by move=>l;elim:l. move=>l2 ll hind l1;clear hind;move:l1 l2;elim:ll=>//=l3 ll hind l1 l2. -by case(prefixe l1 l2 < prefixe l1 l3)=>//=/#. +by case(prefix l1 l2 < prefix l1 l3)=>//=/#. qed. -lemma inv_prefixe_block_mem_take queries prefixes l i : - inv_prefixe_block queries prefixes => - 0 < i < prefixe l (get_max_prefixe l (elems (dom queries))) => - take i l \in dom prefixes. +lemma inv_prefix_block_mem_take queries prefixes l i : + inv_prefix_block queries prefixes => + 0 < i < prefix l (get_max_prefix l (elems (fdom queries))) => + take i l \in prefixes. proof. move=>[]H_incl H_all_prefixes Hi. -rewrite (prefixe_take_leq _ (get_max_prefixe l (elems (dom queries))))1:/#. +rewrite (prefix_take_leq _ (get_max_prefix l (elems (fdom queries))))1:/#. rewrite H_all_prefixes. -cut:get_max_prefixe l (elems (dom queries)) \in dom queries;2:smt(in_dom). -by rewrite memE;apply prefixe_gt0_mem=>/#. -smt(prefixe_sizer). +cut:get_max_prefix l (elems (fdom queries)) \in queries;2:smt(domE). +by rewrite -mem_fdom memE;apply prefix_gt0_mem=>/#. +smt(prefix_sizer). qed. -lemma prefixe_cat_leq_prefixe_size (l1 l2 l3 : 'a list): - prefixe (l1 ++ l2) l3 <= prefixe l1 l3 + size l2. +lemma prefix_cat_leq_prefix_size (l1 l2 l3 : 'a list): + prefix (l1 ++ l2) l3 <= prefix l1 l3 + size l2. proof. -move:l2 l3;elim:l1=>//=;1:smt(prefixe_sizel). +move:l2 l3;elim:l1=>//=. ++ by move=> l2 []; smt(prefix_sizel). move=>e1 l1 hind1 l2 l3;move:e1 l1 l2 hind1;elim:l3=>//=;1:smt(size_ge0). by move=>e3 l3 hind3 e1 l1 l2 hind1;case(e1=e3)=>//=[->>/#|h];exact size_ge0. qed. - -lemma prefixe_cat1 (l1 l2 l3 : 'a list) : - prefixe (l1 ++ l2) l3 = prefixe l1 l3 + - if prefixe l1 l3 = size l1 - then prefixe l2 (drop (size l1) l3) +lemma prefix_cat1 (l1 l2 l3 : 'a list) : + prefix (l1 ++ l2) l3 = prefix l1 l3 + + if prefix l1 l3 = size l1 + then prefix l2 (drop (size l1) l3) else 0. proof. -move:l2 l3;elim:l1=>//=;1:smt(prefixe_sizel). +move:l2 l3;elim:l1=>//=. ++ by move=> l2 []; smt(prefix_sizel). move=>e1 l1 hind1 l2 l3;move:e1 l1 l2 hind1;elim:l3=>//=;1:smt(size_ge0). by move=>e3 l3 hind3 e1 l1 l2 hind1;case(e1=e3)=>//=[->>|h];smt(size_ge0). qed. -lemma prefixe_leq_prefixe_cat_size (l1 l2 : 'a list) (ll : 'a list list) : - prefixe (l1++l2) (get_max_prefixe (l1++l2) ll) <= - prefixe l1 (get_max_prefixe l1 ll) + - if (prefixe l1 (get_max_prefixe l1 ll) = size l1) - then prefixe l2 (get_max_prefixe l2 (map (drop (size l1)) ll)) +lemma prefix_leq_prefix_cat_size (l1 l2 : 'a list) (ll : 'a list list) : + prefix (l1++l2) (get_max_prefix (l1++l2) ll) <= + prefix l1 (get_max_prefix l1 ll) + + if (prefix l1 (get_max_prefix l1 ll) = size l1) + then prefix l2 (get_max_prefix l2 (map (drop (size l1)) ll)) else 0. proof. -move:l1 l2;elim:ll=>//=;1:smt(size_cat size_ge0). -move=>l3 ll hind{hind};move:l3;elim:ll=>//=;1:smt(prefixe_cat1). +move:l1 l2;elim:ll=>//=. ++ smt(prefixs0). +move=>l3 ll hind{hind};move:l3;elim:ll=>//=;1:smt(prefix_cat1). move=>l4 ll hind l3 l1 l2. -case(prefixe (l1 ++ l2) l3 < prefixe (l1 ++ l2) l4)=>//=. -+ rewrite 2!prefixe_cat1. - case(prefixe l1 l3 = size l1)=>//=H_l1l3;case(prefixe l1 l4 = size l1)=>//=H_l1l4. +case(prefix (l1 ++ l2) l3 < prefix (l1 ++ l2) l4)=>//=. ++ rewrite 2!prefix_cat1. + case(prefix l1 l3 = size l1)=>//=H_l1l3;case(prefix l1 l4 = size l1)=>//=H_l1l4. - rewrite H_l1l4 H_l1l3/=ltz_add2l=>h;rewrite h/=. rewrite(StdOrder.IntOrder.ler_trans _ _ _ (hind _ _ _)). - cut->/=:prefixe l1 (max_prefixe l1 l4 ll) = size l1 - by move:{hind};elim:ll=>//=;smt(prefixe_sizel). - by cut->/=:prefixe l1 (max_prefixe l1 l3 ll) = size l1 - by move:{hind};elim:ll=>//=;smt(prefixe_sizel). - - smt(prefixe_sizel prefixe_ge0). - - cut->/=h:prefixe l1 l3 < prefixe l1 l4 by smt(prefixe_sizel). + cut->/=:prefix l1 (max_prefix l1 l4 ll) = size l1 + by move:{hind};elim:ll=>//=;smt(prefix_sizel). + by cut->/=:prefix l1 (max_prefix l1 l3 ll) = size l1 + by move:{hind};elim:ll=>//=;smt(prefix_sizel). + - smt(prefix_sizel prefix_ge0). + - cut->/=h:prefix l1 l3 < prefix l1 l4 by smt(prefix_sizel). rewrite(StdOrder.IntOrder.ler_trans _ _ _ (hind _ _ _)). - cut->/=:prefixe l1 (max_prefixe l1 l4 ll) = size l1 - by move:{hind};elim:ll=>//=;smt(prefixe_sizel). - smt(prefixe_prefixe_prefixe). + cut->/=:prefix l1 (max_prefix l1 l4 ll) = size l1 + by move:{hind};elim:ll=>//=;smt(prefix_sizel). + smt(prefix_prefix_prefix). move=>H_l3l4;rewrite H_l3l4/=. rewrite(StdOrder.IntOrder.ler_trans _ _ _ (hind _ _ _)). - by case(prefixe l1 (max_prefixe l1 l4 ll) = size l1)=>//=->; - smt(prefixe_prefixe_prefixe). -rewrite 2!prefixe_cat1. -case(prefixe l1 l3 = size l1)=>//=H_l1l3;case(prefixe l1 l4 = size l1)=>//=H_l1l4. + by case(prefix l1 (max_prefix l1 l4 ll) = size l1)=>//=->; + smt(prefix_prefix_prefix). +rewrite 2!prefix_cat1. +case(prefix l1 l3 = size l1)=>//=H_l1l3;case(prefix l1 l4 = size l1)=>//=H_l1l4. + by rewrite H_l1l4 H_l1l3/=ltz_add2l=>h;rewrite h/=hind. + rewrite H_l1l3. - cut->/=:!size l1 < prefixe l1 l4 by smt(prefixe_sizel). + cut->/=:!size l1 < prefix l1 l4 by smt(prefix_sizel). rewrite(StdOrder.IntOrder.ler_trans _ _ _ (hind _ _ _))//=. - cut->//=:prefixe l1 (max_prefixe l1 l3 ll) = size l1 - by move:{hind};elim:ll=>//=;smt(prefixe_sizel). - smt(prefixe_prefixe_prefixe). -+ smt(prefixe_sizel prefixe_ge0). + cut->//=:prefix l1 (max_prefix l1 l3 ll) = size l1 + by move:{hind};elim:ll=>//=;smt(prefix_sizel). + smt(prefix_prefix_prefix). ++ smt(prefix_sizel prefix_ge0). move=>H_l3l4;rewrite H_l3l4/=. rewrite(StdOrder.IntOrder.ler_trans _ _ _ (hind _ _ _))//=. -smt(prefixe_prefixe_prefixe). +smt(prefix_prefix_prefix). qed. -lemma diff_size_prefixe_leq_cat (l1 l2 : 'a list) (ll : 'a list list) : - size l1 - prefixe l1 (get_max_prefixe l1 ll) <= - size (l1++l2) - prefixe (l1++l2) (get_max_prefixe (l1++l2) ll). +lemma diff_size_prefix_leq_cat (l1 l2 : 'a list) (ll : 'a list list) : + size l1 - prefix l1 (get_max_prefix l1 ll) <= + size (l1++l2) - prefix (l1++l2) (get_max_prefix (l1++l2) ll). proof. -smt(prefixe_leq_prefixe_cat_size prefixe_sizel prefixe_ge0 size_ge0 prefixe_sizer size_cat). +smt(prefix_leq_prefix_cat_size prefix_sizel prefix_ge0 size_ge0 prefix_sizer size_cat). qed. -(* lemma prefixe_inv_prefixe queries prefixes l : *) -(* prefixe_inv queries prefixes => *) +(* lemma prefix_inv_prefix queries prefixes l : *) +(* prefix_inv queries prefixes => *) (* all_prefixes prefixes => *) -(* (elems (dom queries) = [] => elems (dom prefixes) = [[]]) => *) -(* prefixe l (get_max_prefixe l (elems (dom queries))) = *) -(* prefixe l (get_max_prefixe l (elems (dom prefixes))). *) +(* (elems (fdom queries) = [] => elems (fdom prefixes) = [[]]) => *) +(* prefix l (get_max_prefix l (elems (fdom queries))) = *) +(* prefix l (get_max_prefix l (elems (fdom prefixes))). *) (* proof. *) -(* move=>[? h_prefixe_inv] h_all_prefixes. *) -(* case(elems (dom queries) = [])=>//=h_nil. *) +(* move=>[? h_prefix_inv] h_all_prefixes. *) +(* case(elems (fdom queries) = [])=>//=h_nil. *) (* + by rewrite h_nil//==>->/=. *) -(* cut h_mem_queries:=mem_get_max_prefixe l (elems (dom queries)) h_nil. *) -(* cut h_leq :=all_take_in l (prefixe l (get_max_prefixe l (elems (dom queries)))) _ _ h_all_prefixes _. *) -(* + smt(prefixe_ge0 prefixe_sizel). *) -(* + by rewrite prefixe_take h_prefixe_inv memE h_mem_queries. *) -(* cut:=all_take_in l (prefixe l (get_max_prefixe l (elems (dom prefixes)))) _ _ h_all_prefixes _. *) -(* + smt(prefixe_ge0 prefixe_sizel). *) +(* cut h_mem_queries:=mem_get_max_prefix l (elems (fdom queries)) h_nil. *) +(* cut h_leq :=all_take_in l (prefix l (get_max_prefix l (elems (fdom queries)))) _ _ h_all_prefixes _. *) +(* + smt(prefix_ge0 prefix_sizel). *) +(* + by rewrite prefix_take h_prefix_inv memE h_mem_queries. *) +(* cut:=all_take_in l (prefix l (get_max_prefix l (elems (fdom prefixes)))) _ _ h_all_prefixes _. *) +(* + smt(prefix_ge0 prefix_sizel). *) (* + *) -(* rewrite prefixe_take. *) +(* rewrite prefix_take. *) (* rewrite -take_size. *) -(* print mem_get_max_prefixe. *) +(* print mem_get_max_prefix. *) (* qed. *) @@ -786,22 +787,23 @@ pred invm (m mi : ('a * 'b, 'a * 'b) fmap) = forall x y, m.[x] = Some y <=> mi.[y] = Some x. lemma invm_set (m mi : ('a * 'b, 'a * 'b) fmap) x y : - ! x \in dom m => ! y \in rng m => invm m mi => invm m.[x <- y] mi.[y <- x]. + ! x \in m => ! rng m y => invm m mi => invm m.[x <- y] mi.[y <- x]. proof. -move=>Hxdom Hyrng Hinv a b;rewrite!getP;split. +move=>Hxdom Hyrng Hinv a b; rewrite !get_setE; split. + case(a=x)=>//=hax hab;cut->/#:b<>y. - by cut/#:b\in rng m;rewrite in_rng/#. + by cut/#: rng m b;rewrite rngE /#. case(a=x)=>//=hax. + case(b=y)=>//=hby. - by rewrite (eq_sym y b)hby/=-Hinv hax;rewrite in_dom/=/# in Hxdom. + by rewrite (eq_sym y b)hby/=-Hinv hax;rewrite domE /=/# in Hxdom. by rewrite Hinv/#. qed. +(** ???? op blocksponge (l : block list) (m : (state, state) fmap) (bc : state) = with l = "[]" => (l,bc) with l = (::) b' l' => let (b,c) = (bc.`1,bc.`2) in - if ((b +^ b', c) \in dom m) then blocksponge l' m (oget m.[(b +^ b', c)]) + if ((b +^ b', c) \in m) then blocksponge l' m (oget m.[(b +^ b', c)]) else (l,(b,c)). op s0 : state = (b0,c0). @@ -815,7 +817,7 @@ qed. lemma blocksponge_set l m bc x y : - (x \in dom m => y = oget m.[x]) => + (x \in m => y = oget m.[x]) => let bs1 = blocksponge l m bc in let bs2 = blocksponge l m.[x <- y] bc in let l1 = bs1.`1 in let l2 = bs2.`1 in let bc1 = bs1.`2 in let bc2 = bs2.`2 in @@ -865,8 +867,8 @@ by rewrite/=-2!cats1 blocksponge_cat/=. qed. -(* lemma prefixe_inv_bs_fst_nil queries prefixes m : *) -(* prefixe_inv queries prefixes m => *) +(* lemma prefix_inv_bs_fst_nil queries prefixes m : *) +(* prefix_inv queries prefixes m => *) (* forall l, l \in dom queries => *) (* forall i, 0 <= i <= size l => *) (* (blocksponge (take i l) m s0).`1 = []. *) @@ -893,10 +895,10 @@ qed. (* qed. *) -(* lemma prefixe_inv_set queries prefixes m x y : *) +(* lemma prefix_inv_set queries prefixes m x y : *) (* !x \in dom m => *) -(* prefixe_inv queries prefixes m => *) -(* prefixe_inv queries prefixes m.[x <- y]. *) +(* prefix_inv queries prefixes m => *) +(* prefix_inv queries prefixes m.[x <- y]. *) (* proof. *) (* move=>Hxdom Hpref;progress=>//=. *) (* + rewrite/#. *) @@ -907,10 +909,10 @@ qed. (* rewrite (take_nth b0)1:/#. *) (* rewrite 2!blocksponge_rcons/=. *) (* cut[?[? Hpre]]:=Hpref. *) -(* cut->/=:=prefixe_inv_bs_fst_nil _ _ _ Hpref _ Hbsdom i _;1:rewrite/#. *) +(* cut->/=:=prefix_inv_bs_fst_nil _ _ _ Hpref _ Hbsdom i _;1:rewrite/#. *) (* cut/=->/=:=Hpre _ Hbsdom i _;1:rewrite/#. *) (* cut->/=:=Hind bs _ Hbsdom;1:rewrite/#. *) -(* cut->/=:=prefixe_inv_bs_fst_nil _ _ _ Hpref _ Hbsdom i _;1:rewrite/#. *) +(* cut->/=:=prefix_inv_bs_fst_nil _ _ _ Hpref _ Hbsdom i _;1:rewrite/#. *) (* rewrite dom_set in_fsetU1. *) (* cut/=->/=:=Hpre _ Hbsdom i _;1:rewrite/#. *) (* rewrite getP. *) @@ -934,20 +936,20 @@ qed. (* qed. *) (* lemma size_blocksponge queries m l : *) -(* prefixe_inv queries m => *) -(* size (blocksponge l m s0).`1 <= size l - prefixe l (get_max_prefixe l (elems (dom queries))). *) +(* prefix_inv queries m => *) +(* size (blocksponge l m s0).`1 <= size l - prefix l (get_max_prefix l (elems (fdom queries))). *) (* proof. *) (* move=>Hinv. *) -(* pose l2:=get_max_prefixe _ _;pose p:=prefixe _ _. search take drop. *) +(* pose l2:=get_max_prefix _ _;pose p:=prefix _ _. search take drop. *) (* rewrite-{1}(cat_take_drop p l)blocksponge_cat/=. *) -(* rewrite(prefixe_take). *) +(* rewrite(prefix_take). *) (* qed. *) +**) - -end Prefixe. -export Prefixe. +end Prefix. +export Prefix. (* -------------------------------------------------------------------------- *) @@ -956,7 +958,7 @@ module C = { var queries : (block list, block) fmap proc init () = { c <- 0; - queries <- map0.[[] <- b0]; + queries <- empty.[[] <- b0]; } }. @@ -1026,8 +1028,8 @@ module FC(F:FUNCTIONALITY) = { proc f (bs:block list) = { var b <- b0; - if (!bs \in dom C.queries) { - C.c <- C.c + size bs - prefixe bs (get_max_prefixe bs (elems (dom C.queries))); + if (bs \notin C.queries) { + C.c <- C.c + size bs - prefix bs (get_max_prefix bs (elems (fdom C.queries))); b <@ F.f(bs); C.queries.[bs] <- b; } else { @@ -1041,9 +1043,9 @@ module DFRestr(F:DFUNCTIONALITY) = { proc f (bs:block list) = { var b= b0; - if (!bs \in dom C.queries) { - if (C.c + size bs - prefixe bs (get_max_prefixe bs (elems (dom C.queries))) <= max_size) { - C.c <- C.c + size bs - prefixe bs (get_max_prefixe bs (elems (dom C.queries))); + if (bs \notin C.queries) { + if (C.c + size bs - prefix bs (get_max_prefix bs (elems (fdom C.queries))) <= max_size) { + C.c <- C.c + size bs - prefix bs (get_max_prefix bs (elems (fdom C.queries))); b <@ F.f(bs); C.queries.[bs] <- b; } @@ -1151,13 +1153,50 @@ section COUNT. + proc;inline*;sp 1 1;if;auto;if{1};auto;1:by call(_: ={glob P});auto;sim. by call{2} CO_ll;auto=>/#. + by move=> ?_;proc;sp;if;auto;if;auto;call CO_ll;auto. - + by move=> _;proc;sp;if;auto;call CO_ll;auto;smt(prefixe_sizel). + + by move=> _;proc;sp;if;auto;call CO_ll;auto;smt(prefix_sizel). auto;call (_:true);auto;call(:true);auto=>/#. qed. end section COUNT. (* -------------------------------------------------------------------------- *) +op has (P : 'a -> 'b -> bool) (m : ('a,'b) fmap) = + List.has (fun x=> x \in m /\ P x (oget m.[x])) (elems (fdom m)). + +lemma hasP (P : 'a -> 'b -> bool) (m : ('a,'b) fmap): + has P m <=> exists x, x \in m /\ P x (oget m.[x]). +proof. +rewrite hasP; split=> [] [x] [#]. ++ by move=> _ x_in_m Pxmx; exists x. +by move=> x_in_m Pxmx; exists x; rewrite -memE mem_fdom. +qed. + +op find (P : 'a -> 'b -> bool) (m : ('a,'b) fmap) = + onth (elems (fdom m)) (find (fun x=> x \in m /\ P x (oget m.[x])) (elems (fdom m))). + +lemma find_none (P : 'a -> 'b -> bool) (m : ('a,'b) fmap): + has P m <=> find P m <> None. +proof. +rewrite has_find; split=> [h|]. ++ by rewrite (onth_nth witness) 1:find_ge0 /=. +by apply/contraLR=> h; rewrite onth_nth_map nth_default 1:size_map 1:lezNgt. +qed. + +lemma findP (P : 'a -> 'b -> bool) (m : ('a,'b) fmap): + (exists x, find P m = Some x /\ x \in m /\ P x (oget m.[x])) \/ + (find P m = None /\ forall x, x \in m => !P x (oget m.[x])). +proof. +case: (has P m)=> ^ => [hasPm|nothasPm]; rewrite hasP. ++ move=> [x] [] x_in_m Pxmx; left. + exists (nth witness (elems (fdom m)) (find (fun x=> x \in m /\ P x (oget m.[x])) (elems (fdom m)))). + rewrite /find (onth_nth witness) /=. + + by rewrite find_ge0 /=; apply/has_find/hasPm. + by move: hasPm=> /(nth_find witness) /=. +rewrite negb_exists /=. +move: nothasPm; rewrite find_none=> /= -> h; right=> /= x. +by move: (h x); rewrite negb_and=> /#. +qed. + (** Operators and properties of handles *) op hinv (handles:handles) (c:capacity) = find (fun _ => pred1 c \o fst) handles. @@ -1177,17 +1216,21 @@ lemma hinvP handles c: proof. cut @/pred1@/(\o)/=[[h []->[]Hmem <<-]|[]->H h f]/= := findP (fun (_ : handle) => pred1 c \o fst) handles. - + by exists (oget handles.[h]).`2;rewrite oget_some get_oget;2:case (oget handles.[h]). - cut := H h;rewrite in_dom/#. + + exists (oget handles.[h]).`2;rewrite oget_some. + by move: Hmem; rewrite domE; case: (handles.[h])=> //= - []. + by cut := H h;rewrite domE /#. qed. lemma huniq_hinv (handles:handles) (h:handle): - huniq handles => mem (dom handles) h => hinv handles (oget handles.[h]).`1 = Some h. + huniq handles => dom handles h => hinv handles (oget handles.[h]).`1 = Some h. proof. move=> Huniq;pose c := (oget handles.[h]).`1. cut:=Huniq h;cut:=hinvP handles c. - case (hinv _ _)=> /=[Hdiff _| h' +/(_ h')];1:by rewrite in_dom /#. - by move=> [f ->] /(_ (oget handles.[h]) (c,f)) H1 H2;rewrite H1 // get_oget. + case (hinv _ _)=> /=[Hdiff _| h' +/(_ h')]. + + rewrite domE /=; move: (Hdiff h (oget handles.[h]).`2). + by rewrite /c; case: handles.[h]=> //= - []. + move=> [f ->] /(_ (oget handles.[h]) (c,f)) H1 H2;rewrite H1 //. + by move: H2; rewrite domE; case: (handles.[h]). qed. lemma hinvKP handles c: @@ -1196,14 +1239,14 @@ lemma hinvKP handles c: proof. rewrite /hinvK. cut @/pred1/= [[h]|][->/=]:= findP (+ pred1 c) (restr Known handles). - + by rewrite oget_some in_dom restrP;case (handles.[h])=>//= /#. - by move=>+h-/(_ h);rewrite in_dom restrP => H1/#. + + by rewrite oget_some domE restrP;case (handles.[h])=>//= /#. + by move=>+h-/(_ h);rewrite domE restrP => H1/#. qed. lemma huniq_hinvK (handles:handles) c: - huniq handles => mem (rng handles) (c,Known) => handles.[oget (hinvK handles c)] = Some(c,Known). + huniq handles => rng handles (c,Known) => handles.[oget (hinvK handles c)] = Some(c,Known). proof. - move=> Huniq;rewrite in_rng=> -[h]H;case: (hinvK _ _) (Huniq h) (hinvKP handles c)=>//=. + move=> Huniq;rewrite rngE=> -[h]H;case: (hinvK _ _) (Huniq h) (hinvKP handles c)=>//=. by move=>_/(_ h);rewrite H. qed. diff --git a/proof/smart_counter/Utils.ec b/proof/smart_counter/Utils.ec index 37ccdfa..042cc64 100644 --- a/proof/smart_counter/Utils.ec +++ b/proof/smart_counter/Utils.ec @@ -1,11 +1,12 @@ (** These should make it into the standard libs **) -require import Core List FSet NewFMap. +require import Core List FSet SmtMap. (* -------------------------------------------------------------------- *) - (* In NewFMap *) +(* In SmtMap *) op reindex (f : 'a -> 'c) (m : ('a, 'b) fmap) = - NewFMap.oflist (map (fun (x : 'a * 'b) => (f x.`1,x.`2)) (elems m)) + SmtMap.ofmap ( + SmtMap.oflist (map (fun (x : 'a * 'b) => (f x.`1,x.`2)) (elems m)) axiomatized by reindexE. From e758738d0faa11f2f59b8690fcd5a25735aa4b46 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Mon, 17 Sep 2018 11:21:07 +0100 Subject: [PATCH 307/525] push ConcreteF through almost --- proof/smart_counter/ConcreteF.eca | 72 +++++++++++++++---------------- 1 file changed, 35 insertions(+), 37 deletions(-) diff --git a/proof/smart_counter/ConcreteF.eca b/proof/smart_counter/ConcreteF.eca index 76c32a9..da7600e 100644 --- a/proof/smart_counter/ConcreteF.eca +++ b/proof/smart_counter/ConcreteF.eca @@ -334,39 +334,44 @@ section. smt(mem_set take_size oget_some get_setE domE take_oversize take_le0 take_take cat_take_drop). rewrite h=>j;rewrite take_take /min. case(j//=hij. -(** HERE! CECILE! WE ARE HERE! **) - cut->:take j p{2} = take j (take i{2} p{2});smt(take_take take_le0). - * smt(prefix_lt_size dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop memE). - * smt(prefix_lt_size dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop memE). - * smt(prefix_lt_size dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop memE). - * rewrite!getP/=. + case(0 <= j)=> //= hj. + + by rewrite mem_set H6 /#. + rewrite (take_le0 j) 1:/# mem_set. + have:= (H (take i{2} p{2}) _ 0). + + by rewrite domE H4. + by rewrite take0=> ->. + * smt(prefix_lt_size mem_set take_size oget_some get_setE domE take_oversize take_le0 take_take cat_take_drop memE mem_fdom). + * smt(prefix_lt_size mem_set take_size oget_some get_setE domE take_oversize take_le0 take_take cat_take_drop memE mem_fdom). + * smt(prefix_lt_size mem_set take_size oget_some get_setE domE take_oversize take_le0 take_take cat_take_drop memE mem_fdom). + * by rewrite!get_setE. + * rewrite !get_setE//=. cut/#: !take (i{2} + 1) p{2} \in pref{2}. - by rewrite memE prefix_lt_size//=-(@prefix_exchange _ _ _ H1 H0)//=/#. - * smt(prefix_lt_size dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop memE). - * smt(prefix_lt_size dom_set in_fsetU1 take_size oget_some getP in_dom take_oversize take_le0 take_take cat_take_drop memE). + by rewrite -mem_fdom memE prefix_lt_size//=-(@prefix_exchange _ _ _ H1 H0)//=/#. + * smt(prefix_lt_size mem_set take_size oget_some get_setE domE take_oversize take_le0 take_take cat_take_drop memE mem_fdom). + * smt(prefix_lt_size mem_set take_size oget_some get_setE domE take_oversize take_le0 take_take cat_take_drop memE mem_fdom). conseq(:_==> ={sa,sc,Perm.m,Perm.mi,Redo.prefixes,i,p} /\ C.c{1} = C.c{2} - size p{2} + i{2} /\ pref{2} = Redo.prefixes{2} /\ all_prefixes pref{2} /\ prefix_inv C.queries{2} pref{2} - /\ prefix p{2} (get_max_prefix p{2} (elems (dom C.queries{2}))) = i{2} + /\ prefix p{2} (get_max_prefix p{2} (elems (fdom C.queries{2}))) = i{2} /\ Redo.prefixes{2}.[take i{2} p{2}] = Some (sa{2}, sc{2}));1: - smt(prefix_sizel take_get_max_prefix2 in_dom prefix_exchange). + smt(prefix_sizel take_get_max_prefix2 domE prefix_exchange). while( ={sa,sc,Perm.m,Perm.mi,Redo.prefixes,i,p} - /\ C.c{1} = C.c{2} - size p{2} + prefix p{2} (get_max_prefix p{2} (elems (dom C.queries{2}))) + /\ C.c{1} = C.c{2} - size p{2} + prefix p{2} (get_max_prefix p{2} (elems (fdom C.queries{2}))) /\ pref{2} = Redo.prefixes{2} /\ all_prefixes pref{2} /\ prefix_inv C.queries{2} pref{2} - /\ 0 <= i{2} <= prefix p{2} (get_max_prefix p{2} (elems (dom C.queries{2}))) + /\ 0 <= i{2} <= prefix p{2} (get_max_prefix p{2} (elems (fdom C.queries{2}))) /\ Redo.prefixes{2}.[take i{2} p{2}] = Some (sa{2}, sc{2})). + rcondt{1}1;2:rcondt{2}1;auto;progress. * rewrite/#. search get_max_prefix (<=) take mem. * rewrite(@prefix_inv_leq _ _ _ _ _ _ H H7 H0)//= 1:/#. cut:=H0=>[][h1 [h2 h3]]. - cut:=h3 _ _ _ H7;last smt(memE). + cut:=h3 _ _ _ H7;last smt(memE mem_fdom). smt(size_eq0 size_take). - * smt(get_oget in_dom). + * smt(domE). auto;progress. * rewrite/#. * smt(prefix_ge0). @@ -374,18 +379,10 @@ section. * smt(prefix_sizel @Prefix memE). * smt(prefix_sizel @Prefix memE). - have p_ll := P_f_ll _ _. - + apply/dprod_ll; split. - + exact/Block.DBlock.dunifin_ll. - exact/Capacity.DCapacity.dunifin_ll. - + apply/fun_ext=>- [] a b; rewrite supp_dprod. - by rewrite/=/predT/=Block.DBlock.dunifin_fu Capacity.DCapacity.dunifin_fu. - have pi_ll := P_fi_ll _ _. - + apply/dprod_ll; split. - + exact/Block.DBlock.dunifin_ll. - exact/Capacity.DCapacity.dunifin_ll. - + apply/fun_ext=>- [] a b; rewrite supp_dprod. - by rewrite/=/predT/=Block.DBlock.dunifin_fu Capacity.DCapacity.dunifin_fu. + have p_ll := f_ll _. + + by move=> [b c]; rewrite supp_dprod /= Block.DBlock.dunifin_fu Capacity.DCapacity.dunifin_fu. + have pi_ll := fi_ll _. + + by move=> [b c]; rewrite supp_dprod /= Block.DBlock.dunifin_fu Capacity.DCapacity.dunifin_fu. have f_ll : islossless SqueezelessSponge(Perm).f. + proc; while true (size p - i)=> //=. * move=> z; wp;if;auto; 2:call p_ll; auto=>/#. @@ -422,16 +419,17 @@ section. (true ==> ={y})=> //=. - by symmetry; call sample_sample2; skip=> /> []. by inline *; auto. - have /#:= Conclusion D' &m _. - move=> O O_f_ll O_fi_ll. - proc;inline*;sp;wp; call (_: true)=> //=. - + apply D_ll. - + by proc; inline*; sp; if=> //=; auto; call O_f_ll; auto. - + by proc; inline*; sp; if=> //=; auto; call O_fi_ll; auto. - + proc; inline *; sp; if=> //=; auto; if; auto. - while true (size p - i);auto. - * sp; if; auto; 2:call O_f_ll; auto=> /#. - by auto; smt w=size_ge0. + have:= Conclusion D' &m _. + + move=> O O_f_ll O_fi_ll. + proc;inline*;sp;wp; call (_: true)=> //=. + + apply D_ll. + + by proc; inline*; sp; if=> //=; auto; call O_f_ll; auto. + + by proc; inline*; sp; if=> //=; auto; call O_fi_ll; auto. + + proc; inline *; sp; if=> //=; auto; if; auto. + while true (size p - i);auto. + * sp; if; auto; 2:call O_f_ll; auto=> /#. + by auto; smt w=size_ge0. + smt(). (** This needs Cecile's improvements to Strong_RP_RF to be pushed to stdlib. **) qed. end section. From 26e0a26e179f17983208369ae9c135e3d416d374 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Mon, 17 Sep 2018 11:23:29 +0100 Subject: [PATCH 308/525] disable CI for now --- .gitlab-ci.yml | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index b8b597e..da33dc6 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -8,8 +8,7 @@ before_script: - docker pull easycryptpa/ec-test-box:sha3 sha3: only: - - master - - ci + - none script: - >- docker run -v $PWD:/home/ci/sha3 easycryptpa/ec-test-box:sha3 From b4b3a488a30d387f294eae3213329f023f5b2c11 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Mon, 17 Sep 2018 18:15:05 +0200 Subject: [PATCH 309/525] push ConcreteF & Handle : finished --- proof/smart_counter/ConcreteF.eca | 4 +- proof/smart_counter/Handle.eca | 1061 ++++++++++++++--------------- 2 files changed, 517 insertions(+), 548 deletions(-) diff --git a/proof/smart_counter/ConcreteF.eca b/proof/smart_counter/ConcreteF.eca index da7600e..a116ae8 100644 --- a/proof/smart_counter/ConcreteF.eca +++ b/proof/smart_counter/ConcreteF.eca @@ -220,7 +220,7 @@ section. lemma Real_Concrete &m : Pr[GReal(D).main()@ &m: res /\ C.c <= max_size] <= - Pr[CF(DRestr(D)).main()@ &m: res] + (max_size ^ 2)%r / 2%r * mu dstate (pred1 witness). + Pr[CF(DRestr(D)).main()@ &m: res] + (max_size ^ 2 - max_size)%r / 2%r * mu dstate (pred1 witness). proof. cut->: Pr[RealIndif(SqueezelessSponge,PC(Perm),D).main()@ &m: @@ -429,7 +429,7 @@ section. while true (size p - i);auto. * sp; if; auto; 2:call O_f_ll; auto=> /#. by auto; smt w=size_ge0. - smt(). (** This needs Cecile's improvements to Strong_RP_RF to be pushed to stdlib. **) + smt(). qed. end section. diff --git a/proof/smart_counter/Handle.eca b/proof/smart_counter/Handle.eca index b821d31..2c4c4f0 100644 --- a/proof/smart_counter/Handle.eca +++ b/proof/smart_counter/Handle.eca @@ -1,12 +1,12 @@ pragma -oldip. pragma +implicits. require import Core Int Real StdOrder Ring IntExtra. -require import List FSet NewFMap Utils Common SLCommon RndO. -require import DProd Dexcepted. +require import List FSet SmtMap Common SLCommon. +require import DProd Dexcepted PROM. (*...*) import Capacity IntOrder DCapacity. -require (*--*) ConcreteF. +require (*--*) ConcreteF PROM. -clone export GenEager as ROhandle with +clone export PROM.GenEager as ROhandle with type from <- handle, type to <- capacity, op sampleto <- fun (_:int) => cdistr @@ -14,6 +14,7 @@ clone export GenEager as ROhandle with clone export ConcreteF as ConcreteF1. + module G1(D:DISTINGUISHER) = { var m, mi : smap var mh, mhi : hsmap @@ -29,10 +30,10 @@ module G1(D:DISTINGUISHER) = { sa <- b0; sc <- c0; while (i < size p ) { - if (mem (dom mh) (sa +^ nth witness p i, h)) { + if ((sa +^ nth witness p i, h) \in mh) { (sa, h) <- oget mh.[(sa +^ nth witness p i, h)]; } else { - if (counter < size p - prefixe p (get_max_prefixe p (elems (dom C.queries)))) { + if (counter < size p - prefix p (get_max_prefix p (elems (fdom C.queries)))) { sc <$ cdistr; bcol <- bcol \/ hinv FRO.m sc <> None; sa' <@ F.RO.get(take (i+1) p); @@ -57,8 +58,8 @@ module G1(D:DISTINGUISHER) = { proc f(x : state): state = { var p, v, y, y1, y2, hy2, hx2; - if (!mem (dom m) x) { - if (mem (dom paths) x.`2) { + if (x \notin m) { + if (x.`2 \in paths) { (p,v) <- oget paths.[x.`2]; y1 <- F.RO.get (rcons p (v +^ x.`1)); y2 <$ cdistr; @@ -67,13 +68,13 @@ module G1(D:DISTINGUISHER) = { y2 <$ cdistr; } y <- (y1, y2); - bext <- bext \/ mem (rng FRO.m) (x.`2, Unknown); - if (!(mem (rng FRO.m) (x.`2, Known))) { + bext <- bext \/ rng FRO.m (x.`2, Unknown); + if (!(rng FRO.m (x.`2, Known))) { FRO.m.[chandle] <- (x.`2, Known); chandle <- chandle + 1; } hx2 <- oget (hinvK FRO.m x.`2); - if (mem (dom mh) (x.`1, hx2) /\ in_dom_with FRO.m (oget mh.[(x.`1,hx2)]).`2 Unknown) { + if ((x.`1, hx2) \in mh /\ in_dom_with FRO.m (oget mh.[(x.`1,hx2)]).`2 Unknown) { hy2 <- (oget mh.[(x.`1, hx2)]).`2; y <- (y.`1, (oget FRO.m.[hy2]).`1); FRO.m.[hy2] <- (y.`2, Known); @@ -89,7 +90,7 @@ module G1(D:DISTINGUISHER) = { mi.[y] <- x; mhi.[(y.`1, hy2)] <- (x.`1, hx2); } - if (mem (dom paths) x.`2) { + if (x.`2 \in paths) { (p,v) <- oget paths.[x.`2]; paths.[y.`2] <- (rcons p (v +^ x.`1), y.`1); } @@ -102,9 +103,9 @@ module G1(D:DISTINGUISHER) = { proc fi(x : state): state = { var y, y1, y2, hx2, hy2; - if (!mem (dom mi) x) { - bext <- bext \/ mem (rng FRO.m) (x.`2, Unknown); - if (!(mem (rng FRO.m) (x.`2, Known))) { + if (x \notin mi) { + bext <- bext \/ rng FRO.m (x.`2, Unknown); + if (!(rng FRO.m (x.`2, Known))) { FRO.m.[chandle] <- (x.`2, Known); chandle <- chandle + 1; } @@ -112,7 +113,7 @@ module G1(D:DISTINGUISHER) = { y1 <$ bdistr; y2 <$ cdistr; y <- (y1,y2); - if (mem (dom mhi) (x.`1,hx2) /\ + if ((x.`1,hx2) \in mhi /\ in_dom_with FRO.m (oget mhi.[(x.`1,hx2)]).`2 Unknown) { (y1,hy2) <- oget mhi.[(x.`1, hx2)]; y <- (y.`1, (oget FRO.m.[hy2]).`1); @@ -140,18 +141,18 @@ module G1(D:DISTINGUISHER) = { proc main(): bool = { var b; - F.RO.m <- map0; - m <- map0; - mi <- map0; - mh <- map0; - mhi <- map0; + F.RO.m <- empty; + m <- empty; + mi <- empty; + mh <- empty; + mhi <- empty; bext <- false; bcol <- false; - C.queries<- map0.[[] <- b0]; + C.queries<- empty.[[] <- b0]; (* the empty path is initially known by the adversary to lead to capacity 0^c *) - FRO.m <- map0.[0 <- (c0, Known)]; - paths <- map0.[c0 <- ([<:block>],b0)]; + FRO.m <- empty.[0 <- (c0, Known)]; + paths <- empty.[c0 <- ([<:block>],b0)]; chandle <- 1; b <@ D(M,S).distinguish(); return b; @@ -194,14 +195,14 @@ inductive m_p (m : smap) (p : (block list, state) fmap) | INV_m_p of (p.[[]] = Some (b0,c0)) & (q.[[]] = Some b0) & (forall (l : block list), - l \in dom p => + l \in p => (forall i, 0 <= i < size l => exists sa sc, p.[take i l] = Some (sa, sc) /\ m.[(sa +^ nth witness l i, sc)] = p.[take (i+1) l])) & (forall (l : block list), - l \in dom q => exists c, p.[l] = Some (oget q.[l], c)) + l \in q => exists c, p.[l] = Some (oget q.[l], c)) & (forall (l : block list), - l \in dom p => exists (l2 : block list), l ++ l2 \in dom q). + l \in p => exists (l2 : block list), l ++ l2 \in q). (** RELATIONAL : Prefixes and RO are compatible. **) inductive ro_p (ro : (block list, block) fmap) (p : (block list, state) fmap) = @@ -353,9 +354,9 @@ proof. case=>h0 h0' h1 h2 _ l hl i. case(l = [])=>//=l_notnil. case(0 <= i)=>hi0;last first. -+ rewrite take_le0 1:/#;cut<-:=take0 l;smt(in_dom size_ge0). ++ rewrite take_le0 1:/#;cut<-:=take0 l;smt(domE size_ge0). case(i < size l)=>hisize;last smt(take_oversize). -smt(in_dom). +smt(domE). qed. lemma all_prefixes_of_INV hs ch m1 mi1 mh2 mhi2 ro pi m2 mi2 p q: @@ -375,17 +376,17 @@ proof. by case=> _ + Hlt -/Hlt. qed. lemma ch_neq0 hs ch : hs_spec hs ch => 0 <> ch. proof. by move=> /ch_gt0/ltr_eqF. qed. -lemma ch_notin_dom_hs hs ch: hs_spec hs ch => hs.[ch] = None. +lemma ch_notdomE_hs hs ch: hs_spec hs ch => hs.[ch] = None. proof. by move=> [] _ _ dom_hs; case: {-1}(hs.[ch]) (eq_refl hs.[ch])=> [//|cf/dom_hs]. qed. -lemma Sch_notin_dom_hs hs ch: hs_spec hs ch => hs.[ch + 1] = None. +lemma Sch_notdomE_hs hs ch: hs_spec hs ch => hs.[ch + 1] = None. proof. by move=> [] _ _ dom_hs; case: {-1}(hs.[ch + 1]) (eq_refl hs.[ch + 1])=> [//|cg/dom_hs/#]. qed. -lemma ch_notin_dom2_mh hs m mh xa ch: +lemma ch_notdomE2_mh hs m mh xa ch: m_mh hs m mh => hs_spec hs ch => mh.[(xa,ch)] = None. @@ -395,7 +396,7 @@ case: {-1}(mh.[(xa,ch)]) (eq_refl mh.[(xa,ch)])=> [//=|[ya hy] /Hmh_m]. by move=> [xc0 fx0 yc fy] [#] /dom_hs. qed. -lemma Sch_notin_dom2_mh hs m mh xa ch: +lemma Sch_notdomE2_mh hs m mh xa ch: m_mh hs m mh => hs_spec hs ch => mh.[(xa,ch + 1)] = None. @@ -433,7 +434,7 @@ lemma notin_m_notin_Gm (m Gm : ('a,'b) fmap) x: => Gm.[x] = None. proof. by move=> Gm_leq_m; apply/contraLR=> ^ /Gm_leq_m ->. qed. -lemma notin_hs_notin_dom2_mh hs m mh xa hx: +lemma notin_hs_notdomE2_mh hs m mh xa hx: m_mh hs m mh => hs.[hx] = None => mh.[(xa,hx)] = None. @@ -450,11 +451,11 @@ lemma m_mh_addh hs ch m mh xc fx: proof. move=> ^Hhs [] Hhuniq hs_0 dom_hs [] Hm_mh Hmh_m; split. + move=> xa0 xc0 ya yc /Hm_mh [hx0 fx0 hy fy] [#] hs_hx0 hs_hy mh_xaxc0. - exists hx0 fx0 hy fy; rewrite !getP mh_xaxc0 hs_hx0 hs_hy /=. + exists hx0 fx0 hy fy; rewrite !get_setE mh_xaxc0 hs_hx0 hs_hy /=. move: hs_hx0=> /dom_hs/ltr_eqF -> /=. by move: hs_hy=> /dom_hs/ltr_eqF -> /=. move=> xa hx ya hy /Hmh_m [xc0 fx0 yc fy] [#] hs_hx hs_hy m_xaxc0. -exists xc0 fx0 yc fy; rewrite !getP m_xaxc0 hs_hx hs_hy. +exists xc0 fx0 yc fy; rewrite !get_setE m_xaxc0 hs_hx hs_hy. move: hs_hx=> /dom_hs/ltr_eqF -> /=. by move: hs_hy=> /dom_hs/ltr_eqF -> /=. qed. @@ -468,17 +469,17 @@ move=> Im_mh hs_hy; split. + move=> xa' xc' ya' yc'; have [] H _ /H {H}:= Im_mh. move=> [hx' fx' hy' fy'] [#] hs_hx' hs_hy' mh_xahx'. case: (hx' = hy); case: (hy' = hy)=> //= <*> => [|Hhy'|Hhx'|Hhx' Hhy']. - + by exists hy fy hy fy; rewrite !getP /= /#. - + by exists hy fy hy' fy'; rewrite !getP Hhy' /#. - + by exists hx' fx' hy fy; rewrite !getP Hhx' /#. - by exists hx' fx' hy' fy'; rewrite !getP Hhx' Hhy'. + + by exists hy fy hy fy; rewrite !get_setE /= /#. + + by exists hy fy hy' fy'; rewrite !get_setE Hhy' /#. + + by exists hx' fx' hy fy; rewrite !get_setE Hhx' /#. + by exists hx' fx' hy' fy'; rewrite !get_setE Hhx' Hhy'. move=> xa' hx' ya' hy'; have [] _ H /H {H}:= Im_mh. move=> [xc' fx' yc' fy'] [#] hs_hx' hs_hy' m_xaxc'. case: (hx' = hy); case: (hy' = hy)=> //= <*> => [|Hhy'|Hhx'|Hhx' Hhy']. -+ by exists yc fy yc fy; rewrite !getP /= /#. -+ by exists yc fy yc' fy'; rewrite !getP Hhy' /#. -+ by exists xc' fx' yc fy; rewrite !getP Hhx' /#. -by exists xc' fx' yc' fy'; rewrite !getP Hhx' Hhy'. ++ by exists yc fy yc fy; rewrite !get_setE /= /#. ++ by exists yc fy yc' fy'; rewrite !get_setE Hhy' /#. ++ by exists xc' fx' yc fy; rewrite !get_setE Hhx' /#. +by exists xc' fx' yc' fy'; rewrite !get_setE Hhx' Hhy'. qed. lemma m_mh_addh_addm hs Pm mh hx xa xc hy ya yc f f': @@ -489,15 +490,15 @@ lemma m_mh_addh_addm hs Pm mh hx xa xc hy ya yc f f': m_mh hs.[hy <- (yc,f')] Pm.[(xa,xc) <- (ya,yc)] mh.[(xa,hx) <- (ya,hy)]. proof. move=> [] Hm_mh Hmh_m Hhuniq hs_hx hs_hy. -split=> [xa0 xc0 ya0 yc0|xa0 hx0 ya0 hy0]; rewrite getP. +split=> [xa0 xc0 ya0 yc0|xa0 hx0 ya0 hy0]; rewrite get_setE. + case: ((xa0,xc0) = (xa,xc))=> [[#] <<*> [#] <<*>|] /=. - + by exists hx f hy f'; rewrite !getP /= /#. + + by exists hx f hy f'; rewrite !get_setE /= /#. move=> xaxc0_neq_xaxc /Hm_mh [hx0 fx0 hy0 fy0] [#] hs_hx0 hs_hy0 mh_xahx0. - by exists hx0 fx0 hy0 fy0; rewrite !getP /#. + by exists hx0 fx0 hy0 fy0; rewrite !get_setE /#. case: ((xa0,hx0) = (xa,hx))=> [[#] <*>> [#] <<*>|] /=. -+ by exists xc f yc f'; rewrite !getP /= /#. ++ by exists xc f yc f'; rewrite !get_setE /= /#. rewrite andaE=> /negb_and xahx0_neq_xahx /Hmh_m [xc0 fx0 yc0 fy0] [#] hs_hx0 hs_hy0 Pm_xaxc0. -exists xc0 fx0 yc0 fy0; rewrite !getP; do !split=> [/#|/#|/=]. +exists xc0 fx0 yc0 fy0; rewrite !get_setE; do !split=> [/#|/#|/=]. move: xahx0_neq_xahx; case: (xa0 = xa)=> [/= <*>>|//=]; case: (xc0 = xc)=> [<*>>|//=]. by move: hs_hx=> /(Hhuniq _ _ _ _ hs_hx0). qed. @@ -510,14 +511,14 @@ lemma mi_mhi_addh_addmi (hs : handles) mi mhi hx xa xc hy ya yc fx fy: m_mh hs.[hy <- (yc,fy)] mi.[(ya,yc) <- (xa,xc)] mhi.[(ya,hy) <- (xa,hx)]. proof. move=> [] Hm_mh Hmh_m yc_notin_rng1_hs hs_hx hs_hy; split. -+ move=> ya0 yc0 xa0 xc0; rewrite getP; case: ((ya0,yc0) = (ya,yc))=> [[#] <*>> [#] <*>>|]. - + by exists hy fy hx fx; rewrite !getP /= /#. ++ move=> ya0 yc0 xa0 xc0; rewrite get_setE; case: ((ya0,yc0) = (ya,yc))=> [[#] <*>> [#] <*>>|]. + + by exists hy fy hx fx; rewrite !get_setE /= /#. move=> yayc0_neq_yayc /Hm_mh [hy0 fy0 hx0 fx0] [#] hs_hy0 hs_hx0 mhi_yayc0. - by exists hy0 fy0 hx0 fx0; rewrite !getP /#. -move=> ya0 hy0 xa0 hx0; rewrite getP; case: ((ya0,hy0) = (ya,hy))=> [[#] <*>> [#] <<*>|]. -+ by exists yc fy xc fx; rewrite !getP //= /#. + by exists hy0 fy0 hx0 fx0; rewrite !get_setE /#. +move=> ya0 hy0 xa0 hx0; rewrite get_setE; case: ((ya0,hy0) = (ya,hy))=> [[#] <*>> [#] <<*>|]. ++ by exists yc fy xc fx; rewrite !get_setE //= /#. rewrite /= andaE=> /negb_and yahy0_neq_yahy /Hmh_m [yc0 fy0 xc0 fx0] [#] hs_hy0 hs_hx0 mi_yayc0. -exists yc0 fy0 xc0 fx0; rewrite !getP; do !split=> [/#|/#|]. +exists yc0 fy0 xc0 fx0; rewrite !get_setE; do !split=> [/#|/#|]. move: yahy0_neq_yahy; case: (ya0 = ya)=> [<<*> //=|/#]; case: (yc0 = yc)=> [<*>> /=|//=]. by move: hs_hy0; rewrite yc_notin_rng1_hs. qed. @@ -562,7 +563,7 @@ lemma huniq_addh hs h c f: => (forall f' h', hs.[h'] <> Some (c,f')) => huniq hs.[h <- (c,f)]. proof. -move=> Hhuniq c_notin_rng1_hs h1 h2 [c1 f1] [c2 f2]; rewrite !getP. +move=> Hhuniq c_notin_rng1_hs h1 h2 [c1 f1] [c2 f2]; rewrite !get_setE. case: (h1 = h); case: (h2 = h)=> //= [Hh2 + [#]|+ Hh1 + [#]|_ _] - <*>. + by rewrite c_notin_rng1_hs. + by rewrite c_notin_rng1_hs. @@ -575,12 +576,12 @@ lemma hs_addh hs ch xc fx: => hs_spec hs.[ch <- (xc,fx)] (ch + 1). proof. move=> ^Hhs [] Hhuniq hs_0 dom_hs xc_notin_rng1_hs; split. -+ move=> h1 h2 [c1 f1] [c2 f2]; rewrite !getP /=. ++ move=> h1 h2 [c1 f1] [c2 f2]; rewrite !get_setE /=. case: (h1 = ch); case: (h2 = ch)=> //= [+ + [#]|+ + + [#]|]=> <*>; first 2 by rewrite xc_notin_rng1_hs. by move=> _ _ hs_h1 /(Hhuniq _ _ _ _ hs_h1). -+ by rewrite getP (ch_neq0 _ Hhs). -+ move=> [c f] h; rewrite !getP; case: (h = ch)=> [<*> /#|_]. ++ by rewrite get_setE (ch_neq0 _ Hhs). ++ move=> [c f] h; rewrite !get_setE; case: (h = ch)=> [<*> /#|_]. by move=> /dom_hs /#. qed. @@ -591,9 +592,9 @@ lemma hs_updh hs ch fx hx xc fx': => hs_spec hs.[hx <- (xc,fx')] ch. proof. move=> ^Hhs [] Hhuniq hs_0 dom_hs hx_neq0 hs_hx; split. -+ by move=> h1 h2 [c1 f1] [c2 f2]; rewrite !getP /= /#. -+ by rewrite getP hx_neq0. -move=> cf h; rewrite getP; case: (h = hx)=> [<*> _|_ /dom_hs //]. ++ by move=> h1 h2 [c1 f1] [c2 f2]; rewrite !get_setE /= /#. ++ by rewrite get_setE hx_neq0. +move=> cf h; rewrite get_setE; case: (h = hx)=> [<*> _|_ /dom_hs //]. by move: hs_hx=> /dom_hs. qed. @@ -605,7 +606,7 @@ lemma mh_addh hs ch Gm mh ro xc fx: proof. move=> [] _ _ dom_hs [] Hmh ? ?; split=> //. move=> xa hx ya hy /Hmh [xc0 fx0 yc0 fy0] [#] hs_hx hs_hy Hite. -exists xc0 fx0 yc0 fy0; rewrite !getP Hite hs_hx hs_hy /=. +exists xc0 fx0 yc0 fy0; rewrite !get_setE Hite hs_hx hs_hy /=. rewrite ltr_eqF /=; 1:by apply/(dom_hs _ hs_hx). by rewrite ltr_eqF /=; 1:by apply/(dom_hs _ hs_hy). qed. @@ -617,7 +618,7 @@ lemma inv_addm (m : ('a,'b) fmap) mi x y: => mi.[y] = None => inv_spec m.[x <- y] mi.[y <- x]. proof. -move=> [] Hinv m_x mi_y; split=> x' y'; rewrite !getP; split. +move=> [] Hinv m_x mi_y; split=> x' y'; rewrite !get_setE; split. + case: (x' = x)=> /= [[#] <*> //=|_ /Hinv ^ + ->]. by move: mi_y; case: (y' = y)=> [[#] <*> ->|]. case: (y' = y)=> /= [[#] <*> //=|_ /Hinv ^ + ->]. @@ -628,7 +629,7 @@ qed. lemma incl_addm (m m' : ('a,'b) fmap) x y: incl m m' => incl m.[x <- y] m'.[x <- y]. -proof. by move=> m_leq_m' x'; rewrite !getP; case: (x' = x)=> [|_ /m_leq_m']. qed. +proof. by move=> m_leq_m' x'; rewrite !get_setE; case: (x' = x)=> [|_ /m_leq_m']. qed. (** getflag: retrieve the flag of a capacity **) op getflag (hs : handles) xc = @@ -640,14 +641,14 @@ proof. by rewrite /getflag; case: (hinvP hs xc)=> [->|] //= /#. qed. lemma getflagP_some hs xc f: huniq hs - => (getflag hs xc = Some f <=> mem (rng hs) (xc,f)). + => (getflag hs xc = Some f <=> rng hs (xc,f)). proof. move=> huniq_hs; split. + rewrite /getflag; case: (hinvP hs xc)=> [-> //|]. - rewrite in_rng; case: (hinv hs xc)=> //= h [f']. + rewrite rngE; case: (hinv hs xc)=> //= h [f']. rewrite oget_some=> ^ hs_h -> @/snd /= ->>. by exists h. -rewrite in_rng=> -[h] hs_h. +rewrite rngE=> -[h] hs_h. move: (hinvP hs xc)=> [_ /(_ h f) //|]. rewrite /getflag; case: (hinv hs xc)=> // h' _ [f']; rewrite oget_some. move=> /(huniq_hs _ h _ (xc,f)) /(_ hs_h) /= ->>. @@ -673,7 +674,7 @@ move=> + mh_xahx; elim/last_ind: p za hz=> [za hz|p b ih za hz]. + by rewrite /build_hpath. move=> /build_hpath_prefix [b' h'] [#] /ih Hpath Hmh. apply/build_hpathP/(@Extend _ _ _ _ p b b' h' _ Hpath _)=> //. -by rewrite getP /#. +by rewrite get_setE /#. qed. lemma build_hpath_down mh xa hx ya hy p v h: @@ -684,7 +685,7 @@ proof. move=> no_path_to_hx. elim/last_ind: p v h=> [v h /build_hpathP [<*>|/#] //=|p b ih]. move=> v h /build_hpathP [/#|p' b' + + ^/rconsIs <<- /rconssI <<-]. -move=> v' h' /ih; rewrite getP. +move=> v' h' /ih; rewrite get_setE. case: ((v' +^ b,h') = (xa,hx))=> [/#|_ Hpath Hextend]. exact/build_hpathP/(Extend _ _ _ _ _ Hpath Hextend). qed. @@ -742,59 +743,59 @@ lemma lemma1 hs ch Pm Pmi Gm Gmi mh mhi ro pi x1 x2 y1 y2 prefixes queries: mh.[(x1,ch) <- (y1,ch + 1)] mhi.[(y1,ch + 1) <- (x1,ch)] ro pi prefixes queries. proof. -move=> HINV x2_neq_y2 Pm_x Gm_x x2_notin_rng1_hs y2_notin_rng1_hs; split. +move=> HINV x2_neq_y2 Pm_x Gm_x x2_notrngE1_hs y2_notrngE1_hs; split. + rewrite (@addzA ch 1 1); apply/hs_addh. + by move: HINV=> /hs_of_INV/hs_addh=> ->. - by move=> f h; rewrite getP; case: (h = ch)=> [/#|_]; exact/y2_notin_rng1_hs. + by move=> f h; rewrite get_setE; case: (h = ch)=> [/#|_]; exact/y2_notrngE1_hs. + apply/inv_addm=> //; 1:by case: HINV. case: {-1}(Gmi.[(y1,y2)]) (eq_refl Gmi.[(y1,y2)])=> [//|[xa xc]]. + have /incli_of_INV @/incl + ^h - <- := HINV; 1: by rewrite h. have /mi_mhi_of_INV [] H _ /H {H} [hx fx hy fy] [#] := HINV. - by rewrite y2_notin_rng1_hs. + by rewrite y2_notrngE1_hs. + apply/inv_addm; 1:by case: HINV. + have ^ /m_mh_of_INV Hm_mh /hs_of_INV Hhs := HINV. - by apply/(ch_notin_dom2_mh _ _ Hm_mh Hhs). + by apply/(ch_notdomE2_mh _ _ Hm_mh Hhs). have ^ /mi_mhi_of_INV Hmi_mhi /hs_of_INV Hhs := HINV. - by apply/(Sch_notin_dom2_mh _ _ Hmi_mhi Hhs). + by apply/(Sch_notdomE2_mh _ _ Hmi_mhi Hhs). + apply/(@m_mh_addh_addm hs.[ch <- (x2,Known)] Pm mh ch x1 x2 (ch + 1) y1 y2 Known). + by move: HINV=> ^/hs_of_INV Hhs /m_mh_of_INV; exact/(m_mh_addh Hhs). + by move: HINV => /hs_of_INV /hs_addh /(_ x2 Known _) // []. - + by rewrite getP. - by rewrite getP gtr_eqF 1:/# /=; apply/Sch_notin_dom_hs; case: HINV. + + by rewrite get_setE. + by rewrite get_setE gtr_eqF 1:/# /=; apply/Sch_notdomE_hs; case: HINV. + apply/(@mi_mhi_addh_addmi hs.[ch <- (x2,Known)] Pmi mhi ch x1 x2 (ch + 1) y1 y2 Known Known). + by move: HINV=> ^/hs_of_INV Hhs /mi_mhi_of_INV; exact/(m_mh_addh Hhs). - + move=> f h; rewrite getP; case: (h = ch)=> [_ //=|_ //=]; first by rewrite x2_neq_y2. - by rewrite y2_notin_rng1_hs. - + by rewrite getP. - by rewrite getP gtr_eqF 1:/# /=; apply/Sch_notin_dom_hs; case: HINV. + + move=> f h; rewrite get_setE; case: (h = ch)=> [_ //=|_ //=]; first by rewrite x2_neq_y2. + by rewrite y2_notrngE1_hs. + + by rewrite get_setE. + by rewrite get_setE gtr_eqF 1:/# /=; apply/Sch_notdomE_hs; case: HINV. + by apply/incl_addm; case: HINV. + by apply/incl_addm; case: HINV. + split. - + move=> xa hx ya hy; rewrite getP; case: ((xa,hx) = (x1,ch))=> [|]. - + by move=> [#] <*> [#] <*>; exists x2 Known y2 Known; rewrite !getP /#. + + move=> xa hx ya hy; rewrite get_setE; case: ((xa,hx) = (x1,ch))=> [|]. + + by move=> [#] <*> [#] <*>; exists x2 Known y2 Known; rewrite !get_setE /#. move=> xahx_neq_x1ch; have ^ /hs_of_INV Hhs /mh_of_INV [] Hmh _ _ /Hmh {Hmh} := HINV. move=> [xc fx yc fy] [#] hs_hx hs_hy Hite. - exists xc fx yc fy; do 2?split; first 2 by smt (dom_hs_neq_ch dom_hs_neq_Sch getP). + exists xc fx yc fy; do 2?split; first 2 by smt (dom_hs_neq_ch dom_hs_neq_Sch get_setE). case: fy Hite hs_hy=> /= [[p v] [Hro Hpath] hs_hy|[#] Gm_xaxc <*> hs_hy] /=; last first. - + by rewrite getP; case: ((xa,xc) = (x1,x2))=> [/#|]. + + by rewrite get_setE; case: ((xa,xc) = (x1,x2))=> [/#|]. exists p v; rewrite Hro /=; apply/build_hpath_up=> //. - have /m_mh_of_INV /notin_hs_notin_dom2_mh H:= HINV. - exact/H/ch_notin_dom_hs/Hhs. + have /m_mh_of_INV /notin_hs_notdomE2_mh H:= HINV. + exact/H/ch_notdomE_hs/Hhs. + move=> p xa b; have /mh_of_INV [] _ -> _ := HINV. apply/exists_iff=> v /=; apply/exists_iff=> hx /=; apply/exists_iff=> hy /=. have mh_x1ch: mh.[(x1,ch)] = None. - + by apply/(notin_hs_notin_dom2_mh hs Pm)/ch_notin_dom_hs; case: HINV. - have ch_notin_rng2_mh: forall a h a', mh.[(a,h)] <> Some (a',ch). + + by apply/(notin_hs_notdomE2_mh hs Pm)/ch_notdomE_hs; case: HINV. + have ch_notrngE2_mh: forall a h a', mh.[(a,h)] <> Some (a',ch). + move=> a h a'; rewrite -negP; have /m_mh_of_INV [] _ Hmh_m /Hmh_m {Hmh_m} := HINV. - by move=> [xc fx yc fy] [#] _; rewrite ch_notin_dom_hs; case: HINV. + by move=> [xc fx yc fy] [#] _; rewrite ch_notdomE_hs; case: HINV. split=> -[#]. - + move=> Hpath mh_vxahx; rewrite getP; case: ((v +^ xa,hx) = (x1,ch))=> [/#|_]. + + move=> Hpath mh_vxahx; rewrite get_setE; case: ((v +^ xa,hx) = (x1,ch))=> [/#|_]. by rewrite mh_vxahx //=; apply/build_hpath_up=> //=; rewrite mh_x1ch. have H /H {H}:= build_hpath_down mh x1 ch y1 (ch + 1) p v hx _. + move=> p0 v0; rewrite -negP=> /build_hpathP [<*>|]. + by have /hs_of_INV [] _ + H - /H {H} := HINV. - by move=> p' b' v' h' <*>; rewrite ch_notin_rng2_mh. - move=> ^ /build_hpathP + -> /=; rewrite getP. + by move=> p' b' v' h' <*>; rewrite ch_notrngE2_mh. + move=> ^ /build_hpathP + -> /=; rewrite get_setE. by case=> [<*>|/#]; move: HINV=> /hs_of_INV [] _ + H - /H {H} /#. move=> p v p' v' hx. have: (forall p v, build_hpath mh p <> Some (v,ch)). @@ -807,19 +808,19 @@ move=> HINV x2_neq_y2 Pm_x Gm_x x2_notin_rng1_hs y2_notin_rng1_hs; split. split=> c p v; have ^/hs_of_INV [] _ _ dom_hs /pi_of_INV [] -> := HINV. apply/exists_iff=> h /=; split=> [#]. + move=> /(build_hpath_up mh x1 ch y1 (ch + 1) p v h) /(_ _). - + by apply/(notin_hs_notin_dom2_mh hs Pm)/ch_notin_dom_hs; case: HINV. - by move=> -> /= ^ /dom_hs; rewrite !getP /#. -have ch_notin_rng2_mh: forall a h a', mh.[(a,h)] <> Some (a',ch). + + by apply/(notin_hs_notdomE2_mh hs Pm)/ch_notdomE_hs; case: HINV. + by move=> -> /= ^ /dom_hs; rewrite !get_setE /#. +have ch_notrngE2_mh: forall a h a', mh.[(a,h)] <> Some (a',ch). + move=> a h' a'; rewrite -negP; have /m_mh_of_INV [] _ Hmh_m /Hmh_m {Hmh_m} := HINV. - by move=> [xc fx yc fy] [#] _; rewrite ch_notin_dom_hs; case: HINV. -have Sch_notin_rng2_mh: forall a h a', mh.[(a,h)] <> Some (a',ch + 1). + by move=> [xc fx yc fy] [#] _; rewrite ch_notdomE_hs; case: HINV. +have Sch_notrngE2_mh: forall a h a', mh.[(a,h)] <> Some (a',ch + 1). + move=> a h' a'; rewrite -negP; have /m_mh_of_INV [] _ Hmh_m /Hmh_m {Hmh_m} := HINV. - by move=> [xc fx yc fy] [#] _; rewrite Sch_notin_dom_hs; case: HINV. + by move=> [xc fx yc fy] [#] _; rewrite Sch_notdomE_hs; case: HINV. have H /H {H}:= build_hpath_down mh x1 ch y1 (ch + 1) p v h _. + move=> p0 v0; rewrite -negP=> /build_hpathP [<*>|]. + by have /hs_of_INV [] _ + H - /H {H} := HINV. - by move=> p' b' v' h' <*>; rewrite ch_notin_rng2_mh. -+ move=> ^ /build_hpathP + -> /=; rewrite !getP. + by move=> p' b' v' h' <*>; rewrite ch_notrngE2_mh. ++ move=> ^ /build_hpathP + -> /=; rewrite !get_setE. by case=> [<*>|/#]; move: HINV=> /hs_of_INV [] _ + H - /H {H} /#. (* + by apply(ro_p_of_INV _ _ _ _ _ _ _ _ _ HINV). *) split=>[]. @@ -829,7 +830,7 @@ split=>[]. cut[]_ _ h2 h3:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. cut[]sa sc[]:=h2 l hmem i hi. cut h1:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. - smt(in_dom getP). + smt(domE get_setE). by case:HINV=>_ _ _ _ _ _ _ _ _ []. by case:HINV=>_ _ _ _ _ _ _ _ _ []. qed. @@ -837,7 +838,7 @@ qed. lemma lemma1' hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes queries x1 x2 y1 y2: INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes queries - => ! (y1,y2) \in dom Pm + => ! (y1,y2) \in Pm => x2 <> y2 => Pmi.[(x1,x2)] = None => Gmi.[(x1,x2)] = None @@ -850,58 +851,58 @@ lemma lemma1' hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes queries x1 x2 y1 y2: mh.[(y1,ch + 1) <- (x1,ch)] mhi.[(x1,ch) <- (y1,ch + 1)] ro pi prefixes queries. proof. -move=> HINV hh x2_neq_y2 Pm_x Gm_x xc_notin_rng1_hs yc_notin_rng1_hs; split. +move=> HINV hh x2_neq_y2 Pm_x Gm_x xc_notrngE1_hs yc_notrngE1_hs; split. + rewrite (@addzA ch 1 1); apply/hs_addh. + by move: HINV=> /hs_of_INV/hs_addh=> ->. - by move=> f h; rewrite getP; case: (h = ch)=> [/#|_]; exact/yc_notin_rng1_hs. + by move=> f h; rewrite get_setE; case: (h = ch)=> [/#|_]; exact/yc_notrngE1_hs. + apply/inv_addm=> //; 1:by case: HINV. case: {-1}(Gm.[(y1,y2)]) (eq_refl Gm.[(y1,y2)])=> [//|[xa xc]]. + have /incl_of_INV + ^h - <- := HINV; 1: by rewrite h. have /m_mh_of_INV [] H _ /H {H} [hx fx hy fy] [#] := HINV. - by rewrite yc_notin_rng1_hs. + by rewrite yc_notrngE1_hs. + apply/inv_addm; 1:by case: HINV. + have ^ /m_mh_of_INV Hm_mh /hs_of_INV Hhs := HINV. - by apply/(Sch_notin_dom2_mh _ _ Hm_mh Hhs). + by apply/(Sch_notdomE2_mh _ _ Hm_mh Hhs). have ^ /mi_mhi_of_INV Hmi_mhi /hs_of_INV Hhs := HINV. - by apply/(ch_notin_dom2_mh _ _ Hmi_mhi Hhs). + by apply/(ch_notdomE2_mh _ _ Hmi_mhi Hhs). + apply/(@mi_mhi_addh_addmi hs.[ch <- (x2,Known)] Pm mh ch x1 x2 (ch + 1) y1 y2 Known Known). + by move: HINV=> ^/hs_of_INV Hhs /m_mh_of_INV; exact/(m_mh_addh Hhs). - + by move=> f h; rewrite getP; case: (h = ch)=> [<*> /#|]; rewrite yc_notin_rng1_hs. - + by rewrite getP. - by rewrite getP gtr_eqF 1:/# /=; apply/Sch_notin_dom_hs; case: HINV. + + by move=> f h; rewrite get_setE; case: (h = ch)=> [<*> /#|]; rewrite yc_notrngE1_hs. + + by rewrite get_setE. + by rewrite get_setE gtr_eqF 1:/# /=; apply/Sch_notdomE_hs; case: HINV. + apply/(@m_mh_addh_addm hs.[ch <- (x2,Known)] Pmi mhi ch x1 x2 (ch + 1) y1 y2 Known). + by move: HINV=> ^/hs_of_INV Hhs /mi_mhi_of_INV; exact/(m_mh_addh Hhs). + by have /hs_of_INV /hs_addh /(_ x2 Known _) // []:= HINV. - + by rewrite getP. - by rewrite getP gtr_eqF 1:/# /=; apply/Sch_notin_dom_hs; case: HINV. + + by rewrite get_setE. + by rewrite get_setE gtr_eqF 1:/# /=; apply/Sch_notdomE_hs; case: HINV. + by apply/incl_addm; case: HINV. + by apply/incl_addm; case: HINV. + split. - + move=> ya hy xa hx; rewrite getP; case: ((ya,hy) = (y1,ch + 1))=> [|]. - + by move=> [#] <*> [#] <*>; exists y2 Known x2 Known; rewrite !getP /#. + + move=> ya hy xa hx; rewrite get_setE; case: ((ya,hy) = (y1,ch + 1))=> [|]. + + by move=> [#] <*> [#] <*>; exists y2 Known x2 Known; rewrite !get_setE /#. move=> yahy_neq_y1Sch; have ^ /hs_of_INV Hhs /mh_of_INV [] Hmh _ _ /Hmh {Hmh} := HINV. move=> [yc fy xc fx] [#] hs_hy hs_hx Hite. - exists yc fy xc fx; do 2?split; first 2 by smt (dom_hs_neq_ch dom_hs_neq_Sch getP). + exists yc fy xc fx; do 2?split; first 2 by smt (dom_hs_neq_ch dom_hs_neq_Sch get_setE). case: fx Hite hs_hx=> /= [[p v] [Hro Hpath] hs_hx|[#] Gm_yayc <*> hs_hx] /=; last first. - + by rewrite getP; case: ((ya,yc) = (y1,y2))=> [/#|]. + + by rewrite get_setE; case: ((ya,yc) = (y1,y2))=> [/#|]. exists p v; rewrite Hro /=; apply/build_hpath_up=> //. - have /m_mh_of_INV /notin_hs_notin_dom2_mh H:= HINV. - exact/H/Sch_notin_dom_hs/Hhs. + have /m_mh_of_INV /notin_hs_notdomE2_mh H:= HINV. + exact/H/Sch_notdomE_hs/Hhs. + move=> p ya b; have /mh_of_INV [] _ -> _ := HINV. apply/exists_iff=> v /=; apply/exists_iff=> hx /=; apply/exists_iff=> hy /=. have mh_y1Sch: mh.[(y1,ch + 1)] = None. - + by apply/(notin_hs_notin_dom2_mh hs Pm)/Sch_notin_dom_hs; case: HINV. - have Sch_notin_rng2_mh: forall a h a', mh.[(a,h)] <> Some (a',ch + 1). + + by apply/(notin_hs_notdomE2_mh hs Pm)/Sch_notdomE_hs; case: HINV. + have Sch_notrngE2_mh: forall a h a', mh.[(a,h)] <> Some (a',ch + 1). + move=> a h a'; rewrite -negP; have /m_mh_of_INV [] _ Hmh_m /Hmh_m {Hmh_m} := HINV. - by move=> [yc fy xc fx] [#] _; rewrite Sch_notin_dom_hs; case: HINV. + by move=> [yc fy xc fx] [#] _; rewrite Sch_notdomE_hs; case: HINV. split=> -[#]. - + move=> Hpath mh_vxahx; rewrite getP; case: ((v +^ ya,hx) = (y1,ch + 1))=> [/#|_]. + + move=> Hpath mh_vxahx; rewrite get_setE; case: ((v +^ ya,hx) = (y1,ch + 1))=> [/#|_]. by rewrite mh_vxahx //=; apply/build_hpath_up=> //=; rewrite mh_y1ch. have H /H {H}:= build_hpath_down mh y1 (ch + 1) x1 ch p v hx _. + move=> p0 v0; rewrite -negP=> /build_hpathP [<*>|]. + by have /hs_of_INV [] _ + H - /H {H} /# := HINV. - by move=> p' b' v' h' <*>; rewrite Sch_notin_rng2_mh. - move=> ^ /build_hpathP + -> /=; rewrite getP. + by move=> p' b' v' h' <*>; rewrite Sch_notrngE2_mh. + move=> ^ /build_hpathP + -> /=; rewrite get_setE. by case=> [<*>|/#]; move: HINV=> /hs_of_INV [] _ + H - /H {H} /#. move=> p v p' v' hx. have: (forall p v, build_hpath mh p <> Some (v,ch + 1)). @@ -914,19 +915,19 @@ move=> HINV hh x2_neq_y2 Pm_x Gm_x xc_notin_rng1_hs yc_notin_rng1_hs; split. split=> c p v; have ^/hs_of_INV [] _ _ dom_hs /pi_of_INV [] -> := HINV. apply/exists_iff=> h /=; split=> [#]. + move=> /(build_hpath_up mh y1 (ch + 1) x1 ch p v h) /(_ _). - + by apply/(notin_hs_notin_dom2_mh hs Pm)/Sch_notin_dom_hs; case: HINV. - by move=> -> /= ^ /dom_hs; rewrite !getP /#. -have ch_notin_rng2_mh: forall a h a', mh.[(a,h)] <> Some (a',ch). + + by apply/(notin_hs_notdomE2_mh hs Pm)/Sch_notdomE_hs; case: HINV. + by move=> -> /= ^ /dom_hs; rewrite !get_setE /#. +have ch_notrngE2_mh: forall a h a', mh.[(a,h)] <> Some (a',ch). + move=> a h' a'; rewrite -negP; have /m_mh_of_INV [] _ Hmh_m /Hmh_m {Hmh_m} := HINV. - by move=> [xc fx yc fy] [#] _; rewrite ch_notin_dom_hs; case: HINV. -have Sch_notin_rng2_mh: forall a h a', mh.[(a,h)] <> Some (a',ch + 1). + by move=> [xc fx yc fy] [#] _; rewrite ch_notdomE_hs; case: HINV. +have Sch_notrngE2_mh: forall a h a', mh.[(a,h)] <> Some (a',ch + 1). + move=> a h' a'; rewrite -negP; have /m_mh_of_INV [] _ Hmh_m /Hmh_m {Hmh_m} := HINV. - by move=> [xc fx yc fy] [#] _; rewrite Sch_notin_dom_hs; case: HINV. + by move=> [xc fx yc fy] [#] _; rewrite Sch_notdomE_hs; case: HINV. have H /H {H}:= build_hpath_down mh y1 (ch + 1) x1 ch p v h _. + move=> p0 v0; rewrite -negP=> /build_hpathP [<*>|]. + by have /hs_of_INV [] _ + H - /H {H} /# := HINV. - by move=> p' b' v' h' <*>; rewrite Sch_notin_rng2_mh. -+ move=> ^ /build_hpathP + -> /=; rewrite !getP. + by move=> p' b' v' h' <*>; rewrite Sch_notrngE2_mh. ++ move=> ^ /build_hpathP + -> /=; rewrite !get_setE. by case=> [<*>|/#]; move: HINV=> /hs_of_INV [] _ + H - /H {H} /#. (* + by apply(ro_p_of_INV _ _ _ _ _ _ _ _ _ HINV). *) split=>[]. @@ -936,7 +937,7 @@ split=>[]. cut[]_ _ h2 h3:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. cut[]sa sc[]:=h2 l hmem i hi. cut h1:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. - smt(in_dom getP). + smt(domE get_setE). by case:HINV=>_ _ _ _ _ _ _ _ _ []. by case:HINV=>_ _ _ _ _ _ _ _ _ []. qed. @@ -954,45 +955,45 @@ lemma lemma2 hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi prefixes queries x1 x2 y1 G1mh.[(x1,hx) <- (y1,ch)] G1mhi.[(y1,ch) <- (x1,hx)] ro pi prefixes queries. proof. -move=> HINV PFm_x1x2 G1m_x1x2 pi_x2 hs_hx y2_notin_rng1_hs. +move=> HINV PFm_x1x2 G1m_x1x2 pi_x2 hs_hx y2_notrngE1_hs. split. + by apply/hs_addh=> //=; case: HINV. + apply/inv_addm=> //; 1:by case: HINV. case: {-1}(G1mi.[(y1,y2)]) (eq_refl G1mi.[(y1,y2)])=> [//|[xa xc]]. + have /incli_of_INV @/incl + ^h - <- := HINV; 1: by rewrite h. have /mi_mhi_of_INV [] H _ /H {H} [hx' fx' hy' fy'] [#] := HINV. - by rewrite y2_notin_rng1_hs. + by rewrite y2_notrngE1_hs. + apply/inv_addm; 1:by case: HINV. + have ^ /m_mh_of_INV Hm_mh /hs_of_INV Hhs := HINV. by apply/(notin_m_notin_mh _ _ _ _ Hm_mh PFm_x1x2 hs_hx). have ^ /mi_mhi_of_INV Hmi_mhi /hs_of_INV Hhs := HINV. - by apply/(ch_notin_dom2_mh _ _ Hmi_mhi Hhs). + by apply/(ch_notdomE2_mh _ _ Hmi_mhi Hhs). + have ^ /hs_of_INV ^ Hhs [] Hhuniq _ _ /m_mh_of_INV := HINV. move=> /m_mh_addh_addm /(_ hx x1 x2 ch y1 y2 Known Known Hhuniq hs_hx _) //. - exact/ch_notin_dom_hs. + exact/ch_notdomE_hs. + have ^ /hs_of_INV ^ Hhs [] Hhuniq _ _ /mi_mhi_of_INV := HINV. move=> /mi_mhi_addh_addmi /(_ hx x1 x2 ch y1 y2 Known Known _ hs_hx _) //. - exact/ch_notin_dom_hs. + exact/ch_notdomE_hs. + by have /incl_of_INV/incl_addm ->:= HINV. + by have /incli_of_INV/incl_addm ->:= HINV. + split. - + move=> xa' hx' ya' hy'; rewrite getP; case: ((xa',hx') = (x1,hx))=> [[#] <*>> [#] <<*> /=|]. - + exists x2 Known y2 Known=> //=; rewrite !getP /=. + + move=> xa' hx' ya' hy'; rewrite get_setE; case: ((xa',hx') = (x1,hx))=> [[#] <*>> [#] <<*> /=|]. + + exists x2 Known y2 Known=> //=; rewrite !get_setE /=. by have /hs_of_INV [] _ _ dom_hs /#:= HINV. move=> xahx'_neq_x1hx; have /mh_of_INV [] Hmh _ _ /Hmh {Hmh} := HINV. move=> [xc fx yc] [] /= [#] hs_hx' hs_hy'=> [[p v] [Hro Hpath]|<*> Gm_xa'xc]. - + exists xc fx yc Unknown=> /=; rewrite !getP hs_hx' hs_hy'. + + exists xc fx yc Unknown=> /=; rewrite !get_setE hs_hx' hs_hy'. rewrite (dom_hs_neq_ch hs xc fx _ hs_hx') /=; 1:by case: HINV. rewrite (dom_hs_neq_ch hs yc Unknown _ hs_hy')/= ; 1:by case: HINV. exists p v; rewrite Hro /=; apply/build_hpath_up/(notin_m_notin_mh _ _ _ _ _ PFm_x1x2 hs_hx). + done. by case: HINV. - exists xc Known yc Known=> //=; rewrite !getP; case: ((xa',xc) = (x1,x2))=> [/#|]. + exists xc Known yc Known=> //=; rewrite !get_setE; case: ((xa',xc) = (x1,x2))=> [/#|]. rewrite Gm_xa'xc /= (dom_hs_neq_ch hs xc Known _ hs_hx') /=; 1:by case: HINV. by rewrite (dom_hs_neq_ch hs yc Known _ hs_hy')/= ; 1:by case: HINV. + move=> p xa b; have /mh_of_INV [] _ -> _ := HINV; split. + move=> [v hi hf] [#] Hpath mh_vxahi; exists v hi hf. - rewrite getP; case: ((v +^ xa,hi) = (x1,hx))=> [[#] <*>|_]. + rewrite get_setE; case: ((v +^ xa,hi) = (x1,hx))=> [[#] <*>|_]. + move: mh_vxahi; have /m_mh_of_INV [] _ H /H {H}:= HINV. by move=> [xc fx yc fy] [#]; rewrite hs_hx=> [#] <*>; rewrite PFm_x1x2. rewrite mh_vxahi /=; apply/build_hpath_up=> //. @@ -1002,7 +1003,7 @@ split. + have /pi_of_INV [] /(_ x2):= HINV; rewrite pi_x2 /=. by move=> + p0 v0 - /(_ p0 v0) /negb_exists /(_ hx) /=; rewrite hs_hx. have H /H {H} := build_hpath_down G1mh x1 hx y1 ch p v hi no_path_to_hx. - rewrite getP. case: ((v +^ xa,hi) = (x1,hx))=> [[#] <*>|_ Hpath Hextend]. + rewrite get_setE. case: ((v +^ xa,hi) = (x1,hx))=> [[#] <*>|_ Hpath Hextend]. + by rewrite no_path_to_hx. by exists v hi hf. move=> p v p' v' h0. @@ -1015,13 +1016,13 @@ split=> c p v; have /pi_of_INV [] -> := HINV. apply/exists_iff=> h /=; split=> [#]. + move=> /build_hpath_up /(_ x1 hx y1 ch _). + by apply/(notin_m_notin_mh hs PFm x2 Known); case:HINV. - move=> -> /=; rewrite getP. + move=> -> /=; rewrite get_setE. by have /hs_of_INV [] _ _ dom_hs ^ + /dom_hs /#:= HINV. have no_path_to_hx: forall p0 v0, build_hpath G1mh p0 <> Some (v0,hx). + have /pi_of_INV [] /(_ x2):= HINV; rewrite pi_x2 /=. by move=> + p0 v0 - /(_ p0 v0) /negb_exists /(_ hx) /=; rewrite hs_hx. have H /H {H} := build_hpath_down G1mh x1 hx y1 ch p v h no_path_to_hx. -move=> ^ Hpath -> /=; rewrite getP; case: (h = ch)=> [<*> /= [#] <*>|//=]. +move=> ^ Hpath -> /=; rewrite get_setE; case: (h = ch)=> [<*> /= [#] <*>|//=]. move: Hpath=> /build_hpathP [<*>|]. + by have /hs_of_INV [] _ + H - /H {H}:= HINV. + move=> p' b' v' h' <*> _; have /m_mh_of_INV [] _ H /H {H}:= HINV. @@ -1034,14 +1035,14 @@ split=>[]. cut[]_ _ h2 _:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. cut[]sa sc[]:=h2 l hmem i hi. cut h1:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. - smt(in_dom getP). + smt(domE get_setE). by case:HINV=>_ _ _ _ _ _ _ _ _ []. by case:HINV=>_ _ _ _ _ _ _ _ _ []. qed. lemma lemma2' hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi prefixes queries x1 x2 y1 y2 hx: INV_CF_G1 hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi prefixes queries - => ! (y1,y2) \in dom PFm + => ! (y1,y2) \in PFm => PFmi.[(x1,x2)] = None => G1mi.[(x1,x2)] = None => hs.[hx] = Some (x2,Known) @@ -1052,49 +1053,49 @@ lemma lemma2' hs ch PFm PFmi G1m G1mi G1mh G1mhi ro pi prefixes queries x1 x2 y1 G1mh.[(y1,ch) <- (x1,hx)] G1mhi.[(x1,hx) <- (y1,ch)] ro pi prefixes queries. proof. -move=> HINV hh PFmi_x1x2 G1mi_x1x2 hs_hx y2_notin_rng1_hs. +move=> HINV hh PFmi_x1x2 G1mi_x1x2 hs_hx y2_notrngE1_hs. split. + by apply/hs_addh=> //=; case: HINV. + apply/inv_addm=> //; 1:by case: HINV. case: {-1}(G1m.[(y1,y2)]) (eq_refl G1m.[(y1,y2)])=> [//|[xa xc]]. + have /incl_of_INV + ^h - <- := HINV; 1: by rewrite h. have /m_mh_of_INV [] H _ /H {H} [hx' fx' hy' fy'] [#] := HINV. - by rewrite y2_notin_rng1_hs. + by rewrite y2_notrngE1_hs. + apply/inv_addm; 1:by case: HINV. + have ^ /m_mh_of_INV Hm_mh /hs_of_INV Hhs := HINV. - by apply/(ch_notin_dom2_mh _ _ Hm_mh Hhs). + by apply/(ch_notdomE2_mh _ _ Hm_mh Hhs). have ^ /mi_mhi_of_INV Hm_mh /hs_of_INV Hhs := HINV. by apply/(notin_m_notin_mh _ _ _ _ Hm_mh PFmi_x1x2 hs_hx). + have ^ /hs_of_INV ^ Hhs [] Hhuniq _ _ /m_mh_of_INV := HINV. move=> /mi_mhi_addh_addmi /(_ hx x1 x2 ch y1 y2 Known Known _ hs_hx _) //. - exact/ch_notin_dom_hs. + exact/ch_notdomE_hs. + have ^ /hs_of_INV ^ Hhs [] Hhuniq _ _ /mi_mhi_of_INV := HINV. move=> /m_mh_addh_addm /(_ hx x1 x2 ch y1 y2 Known Known _ hs_hx _) //. - exact/ch_notin_dom_hs. + exact/ch_notdomE_hs. + by have /incl_of_INV/incl_addm ->:= HINV. + by have /incli_of_INV/incl_addm ->:= HINV. + split. - + move=> ya' hy' xa' hx'; rewrite getP; case: ((ya',hy') = (y1,ch))=> [[#] <*>> [#] <<*> /=|]. - + exists y2 Known x2 Known=> //=; rewrite !getP /=. + + move=> ya' hy' xa' hx'; rewrite get_setE; case: ((ya',hy') = (y1,ch))=> [[#] <*>> [#] <<*> /=|]. + + exists y2 Known x2 Known=> //=; rewrite !get_setE /=. by have /hs_of_INV [] _ _ dom_hs /#:= HINV. move=> yahy'_neq_y1ch; have /mh_of_INV [] Hmh _ _ /Hmh {Hmh} := HINV. move=> [yc fy xc] [] /= [#] hs_hy' hs_hx'=> [[p v] [#] Hro Hpath|Gm_ya'yc <*>]. - + exists yc fy xc Unknown => /=; rewrite !getP hs_hx' hs_hy'. + + exists yc fy xc Unknown => /=; rewrite !get_setE hs_hx' hs_hy'. rewrite (dom_hs_neq_ch hs yc fy _ hs_hy') /=; 1:by case: HINV. rewrite (dom_hs_neq_ch hs xc Unknown _ hs_hx')/= ; 1:by case: HINV. exists p v; rewrite Hro /=; apply/build_hpath_up=> //. case: {-1}(G1mh.[(y1,ch)]) (eq_refl G1mh.[(y1,ch)])=> [//|[za zc]]. have /m_mh_of_INV [] _ H /H {H} [? ? ? ?] [#]:= HINV. by have /hs_of_INV [] _ _ H /H {H} := HINV. - exists yc Known xc Known=> //=; rewrite !getP; case: ((ya',yc) = (y1,y2))=> [/#|]. + exists yc Known xc Known=> //=; rewrite !get_setE; case: ((ya',yc) = (y1,y2))=> [/#|]. rewrite Gm_ya'yc /= (dom_hs_neq_ch hs yc Known _ hs_hy') /=; 1:by case: HINV. by rewrite (dom_hs_neq_ch hs xc Known _ hs_hx')/= ; 1:by case: HINV. + move=> p ya b; have /mh_of_INV [] _ -> _ := HINV. apply/exists_iff=> v /=; apply/exists_iff=> hx' /=; apply/exists_iff=> hy' /=. split=> [#]. + move=> /(@build_hpath_up _ y1 ch x1 hx) /(_ _). - + apply/(@notin_hs_notin_dom2_mh hs PFm)/(ch_notin_dom_hs); by case: HINV. - move=> -> /=; rewrite getP /=; case: (hx' = ch)=> <*> //. + + apply/(@notin_hs_notdomE2_mh hs PFm)/(ch_notdomE_hs); by case: HINV. + move=> -> /=; rewrite get_setE /=; case: (hx' = ch)=> <*> //. have /m_mh_of_INV [] _ H /H {H} [xc fx yc fy] [#] := HINV. by have /hs_of_INV [] _ _ H /H {H} := HINV. have no_path_to_ch: forall p0 v0, build_hpath G1mh p0 <> Some (v0,ch). @@ -1105,7 +1106,7 @@ split. rewrite -negP; have /mh_of_INV [] H _ _ /H {H} [? ? ? ?] [#] _ := HINV. by have /hs_of_INV [] _ _ H /H {H} := HINV. have H /H {H} := build_hpath_down G1mh y1 ch x1 hx p v hx' no_path_to_ch. - rewrite getP. case: ((v +^ ya,hx') = (y1,ch))=> [[#] <*>|_ Hpath Hextend //=]. + rewrite get_setE. case: ((v +^ ya,hx') = (y1,ch))=> [[#] <*>|_ Hpath Hextend //=]. by rewrite no_path_to_ch. move=> p v p' v' h0. have: forall p0 v0, build_hpath G1mh p0 <> Some (v0,ch). @@ -1123,7 +1124,7 @@ apply/exists_iff=> h /=; split=> [#]. + have ^ /m_mh_of_INV [] _ H /hs_of_INV [] _ _ H' := HINV. case: {-1}(G1mh.[(y1,ch)]) (eq_refl (G1mh.[(y1,ch)]))=> [//|]. by move=> [za zc] /H [? ? ? ?] [#] /H'. - move=> -> /=; rewrite getP. + move=> -> /=; rewrite get_setE. by have /hs_of_INV [] _ _ dom_hs ^ + /dom_hs /#:= HINV. have no_path_to_ch: forall p0 v0, build_hpath G1mh p0 <> Some (v0,ch). + move=> p0 v0; elim/last_ind: p0. @@ -1133,7 +1134,7 @@ have no_path_to_ch: forall p0 v0, build_hpath G1mh p0 <> Some (v0,ch). rewrite -negP; have /mh_of_INV [] H _ _ /H {H} [? ? ? ?] [#] _ := HINV. by have /hs_of_INV [] _ _ H /H {H} := HINV. + have H /H {H} := build_hpath_down G1mh y1 ch x1 hx p v h no_path_to_ch. - move=> ^ Hpath -> /=; rewrite getP; case: (h = ch)=> [<*> /= [#] <*>|//=]. + move=> ^ Hpath -> /=; rewrite get_setE; case: (h = ch)=> [<*> /= [#] <*>|//=]. move: Hpath=> /build_hpathP [<*>|]. + by have /hs_of_INV [] _ + H - /H {H}:= HINV. move=> p' b' v' h' <*> _; have /m_mh_of_INV [] _ H /H {H}:= HINV. @@ -1146,7 +1147,7 @@ split=>[]. cut[]_ _ h2 _:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. cut[]sa sc[]:=h2 l hmem i hi. cut h1:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. - smt(in_dom getP). + smt(domE get_setE). by case:HINV=>_ _ _ _ _ _ _ _ _ []. by case:HINV=>_ _ _ _ _ _ _ _ _ []. qed. @@ -1179,18 +1180,18 @@ split. + by case: HINV. + by apply/(m_mh_updh Unknown)=> //; case: HINV. + by apply/(m_mh_updh Unknown)=> //; case: HINV. -+ move=> [za zc]; rewrite getP; case: ((za,zc) = (xa,xc))=> // _. ++ move=> [za zc]; rewrite get_setE; case: ((za,zc) = (xa,xc))=> // _. by have /incl_of_INV H /H {H}:= HINV. + move: mh_xahx; have /inv_of_INV [] H /H {H}:= HINV. have /mi_mhi_of_INV [] _ H /H {H} [xct fxt yct fyt] [#] := HINV. rewrite hs_hx hs_hy=> /= [#] 2!<<- {xct fxt} [#] 2!<<- {yct fyt} Pmi_yayc. - move=> [za zc]; rewrite getP; case: ((za,zc) = (ya,yc))=> // _. + move=> [za zc]; rewrite get_setE; case: ((za,zc) = (ya,yc))=> // _. by have /incli_of_INV H /H {H}:= HINV. + split; last 2 by have /mh_of_INV [] _:= HINV. move=> xa' hx' ya' hy'; case: ((xa',hx') = (xa,hx))=> [[#] <*>|]. - + rewrite mh_xahx=> /= [#] <<*>; rewrite !getP /=. + + rewrite mh_xahx=> /= [#] <<*>; rewrite !get_setE /=. case: (hx = hy)=> [<*>|_]; first by move: hs_hx; rewrite hs_hy. - by exists xc Known yc Known; rewrite getP. + by exists xc Known yc Known; rewrite get_setE. move=> Hxahx' mh_xahx'. have ^path_to_hy: build_hpath mh (rcons p (b +^ xa)) = Some (ya,hy). + apply/build_hpath_prefix; exists b hx. @@ -1205,24 +1206,24 @@ split. + by apply/build_hpath_prefix; exists b' hx'; rewrite xorwA xorwK xorwC xorw0. move=> [#] ^/rconsIs + /rconssI - <<*>. by move: mh_xahx' Hxahx' mh_xahx; have /inv_of_INV [] ^ + -> - -> -> /= -> := HINV. - rewrite (@getP _ _ _ hy') Hhy'=> /= hs_hx' ^ hs_hy' -> Hite. + rewrite (@get_set_neqE _ _ hy' _ Hhy')=> /= hs_hx' ^ hs_hy' -> Hite. exists xc' (if hx' = hy then Known else fx') yc' fy'. - rewrite (@getP Gm) (_: (xa',xc') <> (xa,xc)) /=. + rewrite (@get_setE Gm) (_: (xa',xc') <> (xa,xc)) /=. + move: Hxahx'=> /=; case: (xa' = xa)=> [<*> /=|//]. by apply/contra=> <*>; have /hs_of_INV [] + _ _ - /(_ _ _ _ _ hs_hx' hs_hx _) := HINV. - rewrite getP; case: (hx' = hy)=> /= [<*>|//]. + rewrite get_setE; case: (hx' = hy)=> /= [<*>|//]. move: hs_hx'; rewrite hs_hy=> /= [#] <<*> /=. by move: Hite=> /= [#]; case: fy' hs_hy'=> //= _ ->. -+ split=> c p' b'; rewrite !getP; case: (yc = c)=> [<<*> /=|yc_neq_c]; last first. ++ split=> c p' b'; rewrite !get_setE; case: (yc = c)=> [<<*> /=|yc_neq_c]; last first. + rewrite (@eq_sym c) yc_neq_c /=; have /pi_of_INV [] -> := HINV. - apply/exists_iff=> h /=; rewrite getP; case: (h = hy)=> [<*> /=|//=]. + apply/exists_iff=> h /=; rewrite get_setE; case: (h = hy)=> [<*> /=|//=]. by rewrite yc_neq_c hs_hy /=. split=> [[#] <<*>|]. - + exists hy; rewrite getP /=; apply/build_hpath_prefix. + + exists hy; rewrite get_setE /=; apply/build_hpath_prefix. exists b hx; rewrite xorwA xorwK xorwC xorw0 mh_xahx /=. move: pi_xc; have /pi_of_INV [] -> [h] [#] + hs_h:= HINV. by have /hs_of_INV [] + _ _ - /(_ _ _ _ _ hs_hx hs_h _) := HINV. - move=> [h]; rewrite getP; case: (h = hy)=> [<*> /=|]; last first. + move=> [h]; rewrite get_setE; case: (h = hy)=> [<*> /=|]; last first. + by have /hs_of_INV [] H _ _ + [#] _ /H {H} /(_ _ _ hs_hy _) // <*> := HINV. have /mh_of_INV [] _ _ /(_ p' b') H /H {H} /(_ (rcons p (b +^ xa)) ya _) //:= HINV. apply/build_hpath_prefix; exists b hx; rewrite xorwA xorwK xorwC xorw0 mh_xahx /=. @@ -1259,7 +1260,7 @@ proof. elim/last_ind: p v hx=> /=. + by move=> v hx;rewrite /build_hpath /= => -[!<<-];rewrite Hch0. move=> p x Hrec v hx /build_hpath_prefix [v' h' [/Hrec{Hrec}]]. - rewrite getP /=;case (h' = ch) => [->> | ]. + rewrite get_setE /=;case (h' = ch) => [->> | ]. + by rewrite (@eq_sym ch) Hha /= => _ /Hch. case (v' +^ x = xa && h' = ha) => [[!<<-] /= ?? [!->>] /=| ]. + by exists p v';rewrite xorwA xorwK xorwC xorw0. @@ -1276,7 +1277,7 @@ proof. elim: p (Some (b0,0)) => //= b p Hrec obi. rewrite {2 4}/step_hpath /=;case: obi => //= [ | bi'];1:by apply Hrec. rewrite oget_some. - rewrite getP. case ((bi'.`1 +^ b, bi'.`2) = bi1) => [-> | _];2:by apply Hrec. + rewrite get_setE. case ((bi'.`1 +^ b, bi'.`2) = bi1) => [-> | _];2:by apply Hrec. by rewrite Hbi1 build_hpath_None. qed. @@ -1289,9 +1290,9 @@ lemma build_hpath_down_None h ch mh xa ha ya a p: proof. move=> Hh Hha Hmh;rewrite /build_hpath;move: (Some (b0, 0)). elim: p => //= b p Hrec [ | bi] /=;rewrite {2 4}/step_hpath /= ?build_hpath_None //. - rewrite oget_some getP;case ((bi.`1 +^ b, bi.`2) = (xa, ha)) => _;2:by apply Hrec. + rewrite oget_some get_setE;case ((bi.`1 +^ b, bi.`2) = (xa, ha)) => _;2:by apply Hrec. move=> {Hrec};case: p=> /= [[_ ->>]| b' p];1: by move:Hh. - by rewrite {2}/step_hpath /= oget_some /= getP_neq /= ?Hha // Hmh build_hpath_None. + by rewrite {2}/step_hpath /= oget_some /= get_setE_neq /= ?Hha // Hmh build_hpath_None. qed. *) @@ -1308,28 +1309,28 @@ proof. case (hx = ch);2: by move=> ?;apply build_hpath_up_None. move=> ->> [p0 x [? [!->>]]]. rewrite build_hpath_prefix;exists x ha. - by rewrite xorwA xorwK xorwC xorw0 getP_eq /=;apply build_hpath_up_None. + by rewrite xorwA xorwK xorwC xorw0 get_set_sameE /=;apply build_hpath_up_None. qed. lemma lemma4 hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes queries i p sa sc h f: INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes queries => 0 <= i < List.size p -=> take (i + 1) p \in dom prefixes +=> take (i + 1) p \in prefixes => prefixes.[take i p] = Some (sa,sc) => build_hpath mh (take i p) = Some (sa,h) => ro.[take (i+1) p] = Some (oget prefixes.[take (i+1) p]).`1 => hs.[h] = Some (sc, f) -=> (sa +^ nth witness p i, h) \in dom mh. +=> (sa +^ nth witness p i, h) \in mh. proof. -move=>inv0 hi take_i1_p_in_prefixes prefixes_sa_sc build_hpath_i_p ro_prefixe hs_h_sc_f. -cut[]_ _ m_prefixe _:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. -cut[]b1 c1[]:=m_prefixe _ take_i1_p_in_prefixes i _;1:smt(size_take). -rewrite!take_take!min_lel 1,2:/# nth_take 1,2:/# prefixes_sa_sc/==>[][<-<-]{b1 c1}Pm_prefixe. +move=>inv0 hi take_i1_p_in_prefixes prefixes_sa_sc build_hpath_i_p ro_prefix hs_h_sc_f. +cut[]_ _ m_prefix _:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. +cut[]b1 c1[]:=m_prefix _ take_i1_p_in_prefixes i _;1:smt(size_take). +rewrite!take_take!min_lel 1,2:/# nth_take 1,2:/# prefixes_sa_sc/==>[][<-<-]{b1 c1}Pm_prefix. cut[]hh1 hh2 hh3:=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. -move:ro_prefixe;cut{1}->:=(take_nth witness i p);1:smt(size_take);move=>h1. +move:ro_prefix;cut{1}->:=(take_nth witness i p);1:smt(size_take);move=>h1. cut:=hh2 (take i p) (nth witness p i) (oget prefixes.[take (i + 1) p]).`1. -rewrite h1/==>[][] v hx hy;rewrite build_hpath_i_p/==>[][][?<-];smt(in_dom). +rewrite h1/==>[][] v hx hy;rewrite build_hpath_i_p/==>[][][?<-];smt(domE). qed. (* we should do a lemma to have the equivalence *) @@ -1346,7 +1347,7 @@ equiv eq_fi (D <: DISTINGUISHER {PF, RO, G1}): DPRestr(PF).fi ~ DPRestr(G1(DRest F.RO.m{2} G1.paths{2} Redo.prefixes{1} C.queries{2} ==> if G1.bcol{2} \/ G1.bext{2} - then ([] \in dom C.queries{1}) /\ ([] \in dom C.queries{2}) + then ([] \in C.queries{1}) /\ ([] \in C.queries{2}) else ={res} /\ ={glob C} /\ INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} @@ -1386,72 +1387,72 @@ move=> /eqT inv0; proc. case @[ambient]: {-1}(Pmi.[(xa,xc)]) (eq_refl Pmi.[(xa,xc)])=> [Pmi_xaxc|[ya yc] Pmi_xaxc]. + have /incli_of_INV /(_ (xa,xc)) := inv0; rewrite Pmi_xaxc /=. case: {-1}(Gmi.[(xa,xc)]) (eq_refl Gmi.[(xa,xc)])=> //= Gmi_xaxc. - rcondt{1} 1; 1:by auto=> &hr [#] <<*>; rewrite in_dom Pmi_xaxc. - rcondt{2} 1; 1:by auto=> &hr [#] <<*>; rewrite in_dom Gmi_xaxc. + rcondt{1} 1; 1:by auto=> &hr [#] <<*>; rewrite domE Pmi_xaxc. + rcondt{2} 1; 1:by auto=> &hr [#] <<*>; rewrite domE Gmi_xaxc. case @[ambient]: {-1}(getflag hs xc) (eq_refl (getflag hs xc)). - + move=> /getflagP_none xc_notin_rng1_hs. + + move=> /getflagP_none xc_notrngE1_hs. rcondt{2} 2. - + auto=> &hr [#] <<*> _ _ _; rewrite in_rng negb_exists=> h /=. - by rewrite xc_notin_rng1_hs. + + auto=> &hr [#] <<*> _ _ _; rewrite rngE /= negb_exists=> h /=. + by rewrite xc_notrngE1_hs. rcondf{2} 8. + auto=> &hr [#] !<<- _ _ ->> _ /= _ _ _ _. - rewrite negb_and in_dom; left. + rewrite negb_and domE; left. rewrite (@huniq_hinvK_h ch) 3:oget_some /=. + by apply/huniq_addh=> //; have /hs_of_INV [] := inv0. - + by rewrite getP. + + by rewrite get_setE. apply/(@notin_m_notin_mh hs.[ch <- (xc,Known)] Pmi _ _ xc ch Known)=> //. + by apply/m_mh_addh=> //; case: inv0. - by rewrite getP. + by rewrite get_setE. auto=> ? ? [#] !<<- -> -> ->> _ /= ya -> /= yc -> /=. - case: (hinvP (hs.[ch <- (xc,Known)]) yc)=> [_|-> //] yc_notin_rng1_hs_addh _ _. - rewrite getP /= oget_some /= -addzA /=. + case: (hinvP (hs.[ch <- (xc,Known)]) yc)=> [_|-> //] yc_notrngE1_hs_addh _ _. + rewrite get_setE /= oget_some /=. rewrite(@huniq_hinvK_h ch) 3:oget_some /=. + by apply/huniq_addh=> //; have /hs_of_INV [] := inv0. - + by rewrite getP. + + by rewrite get_setE. apply/(@lemma1' hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes queries xa xc ya yc inv0 _ _ Pmi_xaxc Gmi_xaxc)=> //;first last. - + rewrite -negP=> <*>; move: yc_notin_rng1_hs_addh => /=. + + rewrite -negP=> <*>; move: yc_notrngE1_hs_addh => /=. apply/negb_forall=> /=; exists ch; apply/negb_forall=> /=; exists Known. - by rewrite getP. - + move=> f h; move: (yc_notin_rng1_hs_addh h f); rewrite getP. + by rewrite get_setE. + + move=> f h; move: (yc_notrngE1_hs_addh h f); rewrite get_setE. case: (h = ch)=> <*> //= _; rewrite -negP. by have /hs_of_INV [] _ _ H /H {H} := inv0. - + rewrite in_dom/=;cut[]h1 h2:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. + + rewrite domE/=;cut[]h1 h2:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. cut h1':=h1 ya yc. cut :Pm.[(ya, yc)] <> None => exists (hx : handle) (fx : flag), hs.[hx] = Some (yc, fx) by rewrite/#. case(Pm.[(ya, yc)] = None)=>//=h; rewrite negb_exists/==>a;rewrite negb_exists/==>b. - cut:=yc_notin_rng1_hs_addh a b;rewrite getP;case(a=ch)=>//=hach. search (&&). + cut:=yc_notrngE1_hs_addh a b;rewrite get_setE;case(a=ch)=>//=hach. search (&&). case(xc=yc)=>[/#|]hxyc. cut[]_ _ help:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. by cut/#:=help (yc,b) a. have /hs_of_INV [] Hhuniq _ _ [] /(getflagP_some _ _ _ Hhuniq):= inv0. + move=> x2_is_U; conseq (_: _ ==> G1.bext{2})=> //. by auto=> ? ? [#] !<<- _ -> ->> _ /=; rewrite x2_is_U. - move=> ^x2_is_K; rewrite in_rng=> -[hx2] hs_hx2. + move=> ^x2_is_K; rewrite rngE=> -[hx2] hs_hx2. rcondf{2} 2; 1:by auto=> &hr [#] <*> /=; rewrite x2_is_K. rcondf{2} 6. + auto=> &hr [#] !<<- _ _ ->> _. rewrite (@huniq_hinvK_h hx2) // oget_some /= => _ _ _ _. - rewrite negb_and in_dom /=; left. + rewrite negb_and domE /=; left. by apply/(@notin_m_notin_mh hs Pmi _ _ xc _ Known)=> //; case: inv0. auto=> ? ? [#] !<<- -> -> ->> _. rewrite (@huniq_hinvK_h hx2) // oget_some /= => y1 -> /= y2 -> /=. - case: (hinvP hs y2)=> [_ y2_notin_rng1_hs _ _|/#]. - rewrite getP /= oget_some /=. + case: (hinvP hs y2)=> [_ y2_notrngE1_hs _ _|/#]. + rewrite get_setE /= oget_some /=. apply/lemma2'=> //. - + rewrite in_dom/=;cut[]h1 _:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. + + rewrite domE/=;cut[]h1 _:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. cut h1':=h1 y1 y2. cut :Pm.[(y1, y2)] <> None => exists (hx : handle) (fx : flag), hs.[hx] = Some (y2, fx) by rewrite/#. case(Pm.[(y1, y2)] = None)=>//=h; rewrite negb_exists/==>a;rewrite negb_exists/==>b. - exact(y2_notin_rng1_hs). - move=> f h; exact/y2_notin_rng1_hs. -rcondf{1} 1; 1:by auto=> &hr [#] <<*>; rewrite in_dom Pmi_xaxc. + exact(y2_notrngE1_hs). + move=> f h; exact/y2_notrngE1_hs. +rcondf{1} 1; 1:by auto=> &hr [#] <<*>; rewrite domE Pmi_xaxc. case @[ambient]: {-1}(Gmi.[(xa,xc)]) (eq_refl Gmi.[(xa,xc)])=> [|[ya' yc'] ^] Gmi_xaxc. -+ rcondt{2} 1; 1:by auto=> &hr [#] <<*>; rewrite in_dom Gmi_xaxc. ++ rcondt{2} 1; 1:by auto=> &hr [#] <<*>; rewrite domE Gmi_xaxc. conseq (_: _ ==> G1.bext{2})=> //. auto=> &1 &2 [#] !<<- _ -> ->> _ />. - rewrite !in_rng; have ->: exists hx, hs.[hx] = Some (xc,Unknown). + rewrite !rngE /=; have ->: exists hx, hs.[hx] = Some (xc,Unknown). + move: Pmi_xaxc; have /mi_mhi_of_INV [] H _ /H {H} := inv0. move=> [hx fx hy fy] [#] hs_hx hs_hy. have ^/inv_of_INV [] <- /mh_of_INV [] H _ _ /H {H} := inv0. @@ -1461,9 +1462,9 @@ case @[ambient]: {-1}(Gmi.[(xa,xc)]) (eq_refl Gmi.[(xa,xc)])=> [|[ya' yc'] ^] Gm smt (@Block.DBlock @Capacity.DCapacity). have /incli_of_INV <- := inv0; 1:by rewrite Gmi_xaxc. rewrite Pmi_xaxc=> /= [#] <<*>. -rcondf{2} 1; 1:by auto=> &hr [#] <<*>; rewrite in_dom Gmi_xaxc. +rcondf{2} 1; 1:by auto=> &hr [#] <<*>; rewrite domE Gmi_xaxc. by auto=> &1 &2 /#. -+ by move=> /> &1 &2 _ _ /m_p_of_INV []; smt(in_dom). ++ by move=> /> &1 &2 _ _ /m_p_of_INV []; smt(domE). by move=> /> &1 &2 -> ->. qed. @@ -1479,7 +1480,7 @@ equiv eq_f (D <: DISTINGUISHER {PF, RO, G1}): DPRestr(PF).f ~ DPRestr(G1(DRestr( F.RO.m{2} G1.paths{2} Redo.prefixes{1} C.queries{2} ==> if G1.bcol{2} \/ G1.bext{2} - then ([] \in dom C.queries{2}) + then ([] \in C.queries{2}) else ={res} /\ ={glob C} /\ INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} @@ -1499,7 +1500,7 @@ call(: !G1.bcol{2} F.RO.m{2} G1.paths{2} Redo.prefixes{1} C.queries{2} ==> if G1.bcol{2} \/ G1.bext{2} - then ([] \in dom C.queries{2}) + then ([] \in C.queries{2}) else ={res} /\ INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} @@ -1520,13 +1521,13 @@ call(: !G1.bcol{2} move=> /eqT inv0; proc; case @[ambient] {-1}(PFm.[(x1,x2)]) (eq_refl (PFm.[(x1,x2)])). + move=> PFm_x1x2. have /incl_of_INV /(notin_m_notin_Gm _ _ (x1,x2)) /(_ _) // Gm_x1x2 := inv0. - rcondt{1} 1; 1:by move=> //= &1; skip=> &2 [#] <*>; rewrite in_dom PFm_x1x2. - rcondt{2} 1; 1:by move=> //= &1; skip=> &2 [#] <*>; rewrite in_dom Gm_x1x2. + rcondt{1} 1; 1:by move=> //= &1; skip=> &2 [#] <*>; rewrite domE PFm_x1x2. + rcondt{2} 1; 1:by move=> //= &1; skip=> &2 [#] <*>; rewrite domE Gm_x1x2. case @[ambient]: {-1}(pi0.[x2]) (eq_refl (pi0.[x2])). + move=> x2_in_pi; rcondf{2} 1. - + by move=> //= &1; skip=> &2 [#] <*>; rewrite in_dom x2_in_pi. + + by move=> //= &1; skip=> &2 [#] <*>; rewrite domE x2_in_pi. rcondf{2} 8. - + by move=> //= &1; auto=> &2 [#] !<<-; rewrite !in_dom x2_in_pi. + + by move=> //= &1; auto=> &2 [#] !<<-; rewrite !domE x2_in_pi. seq 2 2: ( hs0 = FRO.m{2} /\ ch0 = G1.chandle{2} /\ PFm = PF.m{1} @@ -1546,51 +1547,50 @@ call(: !G1.bcol{2} /\ INV_CF_G1 hs0 ch0 PFm PFmi G1m G1mi G1mh G1mhi ro0 pi0 pref queries). + by auto. case @[ambient]: {-1}(getflag hs0 x2) (eq_refl (getflag hs0 x2)). - + rewrite getflagP_none => x2f_notin_rng_hs0; rcondt{2} 3. - + move=> &1; auto=> &2 /> _ _ _; rewrite in_rng negb_exists /=. - exact/(@x2f_notin_rng_hs0 Known). + + rewrite getflagP_none => x2f_notrngE_hs0; rcondt{2} 3. + + move=> &1; auto=> &2 /> _ _ _; rewrite rngE /= negb_exists /=. + exact/(@x2f_notrngE_hs0 Known). rcondf{2} 6. + move=> &1; auto=> &2 />. have ->: hinvK FRO.m{2}.[G1.chandle{2} <- (x2,Known)] x2 = Some G1.chandle{2}. + rewrite (@huniq_hinvK_h G1.chandle{2} FRO.m{2}.[G1.chandle{2} <- (x2,Known)] x2) //. + move=> hx hy [] xc xf [] yc yf /=. - rewrite !getP; case: (hx = G1.chandle{2}); case: (hy = G1.chandle{2})=> //=. - + by move=> _ + [#] - <*>; have:= (x2f_notin_rng_hs0 yf hy). - + by move=> + _ + [#] - <*>; have:= (x2f_notin_rng_hs0 xf hx). + rewrite !get_setE; case: (hx = G1.chandle{2}); case: (hy = G1.chandle{2})=> //=. + + by move=> _ + [#] - <*>; have:= (x2f_notrngE_hs0 yf hy). + + by move=> + _ + [#] - <*>; have:= (x2f_notrngE_hs0 xf hx). by move=> _ _; have /hs_of_INV [] + _ _ - /(_ hx hy (xc,xf) (yc,yf)) := inv0. - by rewrite !getP. + by rewrite !get_setE. rewrite oget_some=> _ _ _. - have -> //: !mem (dom G1.mh{2}) (x1,G1.chandle{2}). - rewrite in_dom /=; case: {-1}(G1.mh.[(x1,G1.chandle)]{2}) (eq_refl (G1.mh.[(x1,G1.chandle)]{2}))=> //= -[xa xh]; rewrite -negP. + have -> //: (x1,G1.chandle{2}) \notin G1.mh{2}. + rewrite domE /=; case: {-1}(G1.mh.[(x1,G1.chandle)]{2}) (eq_refl (G1.mh.[(x1,G1.chandle)]{2}))=> //= -[xa xh]; rewrite -negP. have ^/m_mh_of_INV [] _ + /hs_of_INV [] _ _ h_handles := inv0. by move=> /(_ x1 G1.chandle{2} xa xh) h /h [] xc xf yc yf [#] /h_handles. case: (x2 <> y2{2} /\ (forall f h, hs0.[h] <> Some (y2{2},f))). + auto=> &1 &2 [#] !<<- -> -> !->> /= _ x2_neq_y2 y2_notin_hs. - rewrite getP /= oget_some /= -addzA /=. - rewrite (@huniq_hinvK_h ch0 hs0.[ch0 <- (x2,Known)] x2); 2:by rewrite getP. - + move=> @/huniq h1 h2 [c1 f1] [c2 f2]; rewrite !getP /=. + rewrite get_setE /= oget_some /=. + rewrite (@huniq_hinvK_h ch0 hs0.[ch0 <- (x2,Known)] x2); 2:by rewrite get_setE. + + move=> @/huniq h1 h2 [c1 f1] [c2 f2]; rewrite !get_setE /=. case: (h1 = ch0); case: (h2 = ch0)=> //=. - + by move=> _ + [#] - <*>; move: (x2f_notin_rng_hs0 f2 h2). - + by move=> + _ + [#] <*> - <*>; move: (x2f_notin_rng_hs0 f1 h1). + + by move=> _ + [#] - <*>; move: (x2f_notrngE_hs0 f2 h2). + + by move=> + _ + [#] <*> - <*>; move: (x2f_notrngE_hs0 f1 h1). have /hs_of_INV [] + _ _ _ _ - h := inv0. - by apply/h; rewrite getP. - rewrite !oget_some;rewrite in_dom;cut[]_ -> _ _ _ /=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. + by apply/h; rewrite get_setE. + rewrite !oget_some;rewrite domE;cut[]_ -> _ _ _ /=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. smt(lemma1). conseq (_: _ ==> G1.bcol{2})=> //=. + by auto=> &1 &2 [#] !<<- bad1 bad2 -> _ ->> !<<- _ /=/>; - rewrite in_dom;cut[]_ ->_ _ _/=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. + rewrite domE;cut[]_ ->_ _ _/=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. auto=> &1 &2 [#] !<<- -> _ ->> !<<- _ /=/>. case: (hinvP hs0.[ch0 <- (x2,Known)] y2{1})=> //= -> /=. move=> hs0_spec; split=> [|f]. - + by have:= hs0_spec ch0 Known; rewrite getP. - move=> h; have:= hs0_spec h f; rewrite getP; case: (h = ch0)=> [<*>|//=]. + + by have:= hs0_spec ch0 Known; rewrite get_setE. + move=> h; have:= hs0_spec h f; rewrite get_setE; case: (h = ch0)=> [<*>|//=]. by move=> _; rewrite -negP; have /hs_of_INV [] _ _ H /H {H}:= inv0. case; rewrite getflagP_some; 1,3:by have /hs_of_INV []:= inv0. + move=> x2_is_U; conseq (_: G1.bext{2})=> //=; auto=> &1 &2 /> _ _ hinv0 . - + by rewrite in_dom;cut[]_ -> _ _ _/=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. - rewrite/#. + by rewrite domE;cut[]_ -> _ _ _/=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. move=> x2_is_K; rcondf{2} 3; 1:by move=> &1; auto. - have:= x2_is_K; rewrite in_rng=> - [hx] hs0_hx. + have:= x2_is_K; rewrite rngE=> - [hx] hs0_hx. seq 0 3: ( hs0 = FRO.m{2} /\ ch0 = G1.chandle{2} /\ PFm = PF.m{1} @@ -1610,15 +1610,16 @@ call(: !G1.bcol{2} /\ y{2} = (y1,y2){2} /\ hx2{2} = hx /\ INV_CF_G1 hs0 ch0 PFm PFmi G1m G1mi G1mh G1mhi ro0 pi0 pref queries). - + auto=> &1 &2 /> _ -> /= _; split. - + move: x2_is_K; rewrite in_rng /= => -[hx2] hs_hx2. - rewrite in_rng negb_exists /==> h; rewrite -negP=> hs_h. + (* TODO : reduce the example to reproduce the problem with : auto=> &1 &2 /> *) + + auto=> &1 &2 [#] 13!<<- 2!-> 3!->> HINV0 /=;split. + + move: x2_is_K; rewrite rngE /= => -[hx2] hs_hx2. + rewrite negb_exists /==> h; rewrite -negP=> hs_h. have /hs_of_INV [] Hhuniq _ _ := inv0. by move: (Hhuniq _ _ _ _ hs_hx2 hs_h)=> ht; move: ht hs_h=> /= <*>; rewrite hs_hx2. - rewrite (@huniq_hinvK_h hx FRO.m{2} x2) //. + rewrite (@huniq_hinvK_h hx hs0 x2) //. by have /hs_of_INV [] := inv0. - have x1hx_notin_G1m: !mem (dom G1mh) (x1,hx). - + rewrite in_dom; case: {-1}(G1mh.[(x1,hx)]) (eq_refl G1mh.[(x1,hx)])=> //=. + have x1hx_notin_G1m: (x1,hx) \notin G1mh. + + rewrite domE; case: {-1}(G1mh.[(x1,hx)]) (eq_refl G1mh.[(x1,hx)])=> //=. move=> [mhx1 mhx2]; rewrite -negP=> h. have /m_mh_of_INV [] _ hg := inv0. have [xa xh ya yh] := hg _ _ _ _ h. @@ -1626,27 +1627,27 @@ call(: !G1.bcol{2} rcondf{2} 1. + by move=> &m; auto=> //= &hr [#] <*>; rewrite x1hx_notin_G1m. auto=> &1 &2 [#] !<<- -> -> !->> _ /=. - rewrite in_dom;cut[]_ -> _ _ _ /=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. + rewrite domE;cut[]_ -> _ _ _ /=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. case(hinv hs0 y2{2} = None)=>//=h; - rewrite getP /= oget_some /=;smt(lemma2 hinvP). + rewrite get_setE /= oget_some /=;smt(lemma2 hinvP). move=> [p0 v0] ^ pi_x2. have /pi_of_INV [] -> [hx2] [#] Hpath hs_hx2:= inv0. - rcondt{2} 1. by move=> &m; auto=> &hr [#] !<<- _ _ ->> /= _; rewrite in_dom pi_x2. + rcondt{2} 1. by move=> &m; auto=> &hr [#] !<<- _ _ ->> /= _; rewrite domE pi_x2. rcondf{2} 6. + auto; inline *; auto=> &hr [#] !<<- _ _ !->> _ /= _ _ _ _ /=. - by rewrite in_rng; exists hx2. + by rewrite rngE; exists hx2. rcondf{2} 7. + auto; inline *; auto=> &hr [#] !<<- _ _ !->> _ /= _ _ _ _ /=. rewrite negb_and; left; rewrite (@huniq_hinvK_h hx2 hs0 x2) // 2:oget_some. + by have /hs_of_INV []:= inv0. - rewrite in_dom; case: {-1}(G1mh.[(x1,hx2)]) (eq_refl (G1mh.[(x1,hx2)]))=> [//=|[xa xc] G1mh_x1hx2]. + rewrite domE; case: {-1}(G1mh.[(x1,hx2)]) (eq_refl (G1mh.[(x1,hx2)]))=> [//=|[xa xc] G1mh_x1hx2]. have /m_mh_of_INV [] _ /(_ _ _ _ _ G1mh_x1hx2) [xc0 xf0 yc0 yf0] := inv0. by move=> [#]; rewrite hs_hx2=> [#] !<<- {xc0 xf0}; rewrite PFm_x1x2. rcondt{2} 15. + auto; inline *; auto=> &hr [#] !<<- _ _ !->> _ /= _ _ _ _ /=. - by rewrite in_dom pi_x2. + by rewrite domE pi_x2. inline F.RO.get. rcondt{2} 4. + auto=> &hr [#] !<<- _ _ !->> _ /= _ _; rewrite pi_x2 oget_some /=. - rewrite in_dom; case: {-1}(ro0.[rcons p0 (v0 +^ x1)]) (eq_refl (ro0.[rcons p0 (v0 +^ x1)])). + rewrite domE; case: {-1}(ro0.[rcons p0 (v0 +^ x1)]) (eq_refl (ro0.[rcons p0 (v0 +^ x1)])). + done. move=> bo ^ro_pvx1 /=. have /mh_of_INV [] _ -> _:= inv0. rewrite negb_exists=> ? /=; rewrite negb_exists=> ? /=; rewrite negb_exists=> yh /=. @@ -1656,9 +1657,9 @@ call(: !G1.bcol{2} move=> [xc xf yc yf] [#]; rewrite hs_hx2=> [#] <*>. by rewrite PFm_x1x2. auto => &m1 &m2 [#] !<- _ _ -> /= _ y1L -> y2L -> /=. - rewrite !getP_eq pi_x2 !oget_some /=. + rewrite !get_set_sameE pi_x2 !oget_some /=. have /hs_of_INV [] Hu _ _:= inv0; have -> := huniq_hinvK_h _ _ _ Hu hs_hx2. - rewrite oget_some in_dom => /= ;cut[]_->_ _ _/=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. + rewrite oget_some domE => /= ;cut[]_->_ _ _/=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. case(G1.bcol{m2} \/ hinv hs0 y2L <> None)=>//=;rewrite !negb_or/==>[][]? hinv0[]? hinv1. case:inv0=> Hhs Hinv HinvG Hmmh Hmmhi Hincl Hincli Hmh Hpi Hmp. have Hhx2:= dom_hs_neq_ch _ _ _ _ _ Hhs hs_hx2. @@ -1675,35 +1676,35 @@ call(: !G1.bcol{2} move=> [x1L x2L] ^G1mi_y; rewrite -Hincli 1:G1mi_y//. case: Hmmhi hinv0 => H _ + /H {H} [hx fx hy fy] [#]. by case: (hinvP hs0 y2L)=> [_ ->|//]/#. - + by apply inv_addm=>//; apply (ch_notin_dom2_mh _ _ Hmmhi Hhs). - + by apply (m_mh_addh_addm _ Hmmh _ hs_hx2)=>//;apply ch_notin_dom_hs. - + apply (mi_mhi_addh_addmi _ Hmmhi _ hs_hx2);last by apply ch_notin_dom_hs. + + by apply inv_addm=>//; apply (ch_notdomE2_mh _ _ Hmmhi Hhs). + + by apply (m_mh_addh_addm _ Hmmh _ hs_hx2)=>//;apply ch_notdomE_hs. + + apply (mi_mhi_addh_addmi _ Hmmhi _ hs_hx2);last by apply ch_notdomE_hs. by have := hinvP hs0 y2L;rewrite /#. + by apply incl_addm. + by apply incl_addm. + split. - + move=> xa hx ya hy;rewrite getP;case ((xa, hx) = (x1, hx2))=> /=. + + move=> xa hx ya hy;rewrite get_setE;case ((xa, hx) = (x1, hx2))=> /=. + move=> [] !-> [] !<-; exists x2 Known y2L Known. - by rewrite !getP_eq /= getP_neq // eq_sym; apply (dom_hs_neq_ch _ _ _ Hhs hs_hx2). + by rewrite !get_set_sameE /= get_set_neqE // eq_sym; apply (dom_hs_neq_ch _ _ _ Hhs hs_hx2). move=> Hdiff Hxa; case Hmh=> /(_ _ _ _ _ Hxa) [] xc fx yc fy [#] Hhx Hhy HG1 _ _. - exists xc fx yc fy;rewrite !getP_neq //. - + by rewrite eq_sym;apply (dom_hs_neq_ch _ _ _ Hhs Hhx). - + by rewrite eq_sym;apply (dom_hs_neq_ch _ _ _ Hhs Hhy). + exists xc fx yc fy;rewrite !get_set_neqE //. + + by apply (dom_hs_neq_ch _ _ _ Hhs Hhx). + + by apply (dom_hs_neq_ch _ _ _ Hhs Hhy). + rewrite /= -negP=> -[] <<- <<-;apply Hdiff=> /=. - by apply (Hu hx (x2, fx) (x2, Known)). + by apply (Hu hx (xc, fx) (xc, Known)). rewrite Hhx Hhy=> /=;move: HG1. case: fy Hhy=> Hhy //= [p v [Hro Hbu]]. exists p v;split. - + rewrite getP_neq // -negP => ^ /rconssI <<- /rconsIs. + + rewrite get_set_neqE // -negP => ^ /rconssI <<- /rconsIs. move: Hbu;rewrite Hpath /= => -[!<<-] /=. by rewrite -negP=> /Block.WRing.addrI /#. by apply build_hpath_up=> //; move: hs_hx2 PFm_x1x2;apply: m_mh_None. - + move=> p bn b; rewrite getP. + + move=> p bn b; rewrite get_setE. case (rcons p bn = rcons p0 (v0 +^ x1)). + move=> ^ /rconssI <<- /rconsIs ->> /=; split => [<<- | ]. + exists v0 hx2 ch0. rewrite (build_hpath_up Hpath) /=;1:by move: hs_hx2 PFm_x1x2;apply: m_mh_None. - by rewrite xorwA xorwK Block.WRing.add0r getP_eq. - move=> [v hx hy] [];rewrite getP ;case ((v +^ (v0 +^ x1), hx) = (x1, hx2)) => //. + by rewrite xorwA xorwK Block.WRing.add0r get_set_sameE. + move=> [v hx hy] [];rewrite get_setE ;case ((v +^ (v0 +^ x1), hx) = (x1, hx2)) => //. move=> Hdiff;have HG1 := m_mh_None _ _ _ _ _ _ _ Hmmh hs_hx2 PFm_x1x2. have -> /= [->> <<-]:= build_hpath_up_None _ _ (y1L, ch0) _ _ HG1 Hpath. by move:Hdiff;rewrite xorwA xorwK Block.WRing.add0r. @@ -1714,8 +1715,10 @@ call(: !G1.bcol{2} + split;1: by move=> [] _ /ch_None. move=> [[p0' x [Hhx2']]]. have [!->>] [!->>]:= Huni _ _ _ _ _ Hpath Hhx2'. - by rewrite getP_neq /= ?Hhx2 // => /ch_None. - rewrite getP;case ((v +^ bn, hx) = (x1, hx2)) => //= -[<<- ->>]. + rewrite get_set_neqE /=. + + by rewrite (@eq_sym ch0 hx2) Hhx2. + by move => /ch_None. + rewrite get_setE;case ((v +^ bn, hx) = (x1, hx2)) => //= -[<<- ->>]. split=> -[H];have [!->>]:= Huni _ _ _ _ _ Hpath H;move:Hdiff; by rewrite xorwA xorwK Block.WRing.add0r. move=> p v p' v' hx;case Hmh => _ _ Huni. @@ -1723,18 +1726,18 @@ call(: !G1.bcol{2} case (hx = ch0) => [->> [?? [# H1 -> ->]] [?? [# H2 -> ->]]|_ ] /=. + by have [!->>] := Huni _ _ _ _ _ H1 H2. by apply Huni. - split=> c p v;rewrite getP. case (c = y2L) => [->> /= | Hc]. + split=> c p v;rewrite get_setE. case (c = y2L) => [->> /= | Hc]. + split. - + move=> [!<<-];exists ch0;rewrite getP_eq /= build_hpath_prefix. - exists v0 hx2;rewrite xorwA xorwK Block.WRing.add0r getP_eq /=. + + move=> [!<<-];exists ch0;rewrite get_set_sameE /= build_hpath_prefix. + exists v0 hx2;rewrite xorwA xorwK Block.WRing.add0r get_set_sameE /=. have HG1 := m_mh_None _ _ _ _ _ _ _ Hmmh hs_hx2 PFm_x1x2. by apply build_hpath_up_None. - move=> [h []];rewrite getP build_hpath_upd_ch_iff //. + move=> [h []];rewrite get_setE build_hpath_upd_ch_iff //. case (h=ch0)=> [->> /= [??[# H1 -> ->]]| Hh] /=. + by case Hmh => _ _ /(_ _ _ _ _ _ Hpath H1). by have := hinvP hs0 y2L;rewrite /= => /#. case Hpi => ->;apply exists_iff => h /=. - rewrite build_hpath_upd_ch_iff // getP;case (h = ch0) => [->> | //]. + rewrite build_hpath_upd_ch_iff // get_setE;case (h = ch0) => [->> | //]. split;1: by move=> [_ /(dom_hs_neq_ch _ _ _ _ _ Hhs)]. by move=> /= [_ <<-];move:Hc. split. @@ -1742,51 +1745,51 @@ call(: !G1.bcol{2} + by cut[]/#:=Hmp. + cut[]_ _ h _ _ l hdom i hi:=Hmp. cut[]b c[]->h':=h l hdom i hi. - by exists b c=>//=;rewrite getP/=-h';smt(in_dom take_oversize). + by exists b c=>//=;rewrite get_setE/=-h';smt(domE take_oversize). + by cut[]/#:=Hmp. + by cut[]/#:=Hmp. - move=> [xa xc] PFm_x1x2. rcondf{1} 1; 1:by auto=> &hr [#] !<<- _ _ ->>; rewrite in_dom PFm_x1x2. + move=> [xa xc] PFm_x1x2. rcondf{1} 1; 1:by auto=> &hr [#] !<<- _ _ ->>; rewrite domE PFm_x1x2. have /m_mh_of_INV [] + _ - /(_ _ _ _ _ PFm_x1x2) := inv0. move=> [hx2 fx2 hy2 fy2] [#] hs_hx2 hs_hy2 G1mh_x1hx2. case @[ambient]: {-1}(G1m.[(x1,x2)]) (eq_refl (G1m.[(x1,x2)])); last first. - + move=> [ya yc] G1m_x1x2; rcondf{2} 1; 1:by auto=> &hr [#] !<<- _ _ ->>; rewrite in_dom G1m_x1x2. + + move=> [ya yc] G1m_x1x2; rcondf{2} 1; 1:by auto=> &hr [#] !<<- _ _ ->>; rewrite domE G1m_x1x2. auto=> &1 &2 [#] <*> -> -> -> /=; have /incl_of_INV /(_ (x1,x2)) := inv0. by rewrite PFm_x1x2 G1m_x1x2 /= => [#] !<<- {ya yc}. - move=> x1x2_notin_G1m; rcondt{2} 1; 1:by auto=> &hr [#] !<<- _ _ ->>; rewrite in_dom x1x2_notin_G1m. + move=> x1x2_notin_G1m; rcondt{2} 1; 1:by auto=> &hr [#] !<<- _ _ ->>; rewrite domE x1x2_notin_G1m. have <*>: fy2 = Unknown. + have /mh_of_INV [] /(_ _ _ _ _ G1mh_x1hx2) + _ := inv0. move=> [xc0 xf0 yc0 yf0] [#]; rewrite hs_hx2 hs_hy2=> [#] !<<- [#] !<<- {xc0 xf0 yc0 yf0}. by case: fy2 hs_hy2 G1mh_x1hx2=> //=; rewrite x1x2_notin_G1m. case @[ambient]: fx2 hs_hx2=> hs_hx2. + swap{2} 3 -2; seq 0 1: (queries = C.queries{2} /\ G1.bext{2}). - - by auto=> ? ? [#] !<<- _ -> ->> _ /=; rewrite in_rng; exists hx2. + - by auto=> ? ? [#] !<<- _ -> ->> _ /=; rewrite rngE; exists hx2. conseq(:_==> (! (G1.bcol{2} \/ G1.bext{2})) => oget PF.m{1}.[x{1}] = y{2} /\ INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} Redo.prefixes{1} C.queries{2}); progress;2..-2:rewrite/#. - - by rewrite in_dom;cut[]_->_ _ _/=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. + - by rewrite domE;cut[]_->_ _ _/=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. by inline*; if{2}; auto=> &1 &2 />; smt(F.sampleto_ll sampleto_ll). have /mh_of_INV []/(_ _ _ _ _ G1mh_x1hx2) + _ _:= inv0. move=> [xc0 xf0 yc0 yf0] [#]; rewrite hs_hx2 hs_hy2=> [#] !<<- [#] !<<- {xc0 xf0 yc0 yf0} /= [p0 v0] [#] Hro Hpath. have /pi_of_INV [] /(_ x2 p0 v0) /iffRL /(_ _) := inv0. + by exists hx2=>/#. - move=> pi_x2; rcondt{2} 1; 1:by auto=> &hr [#] <*>; rewrite in_dom pi_x2. + move=> pi_x2; rcondt{2} 1; 1:by auto=> &hr [#] <*>; rewrite domE pi_x2. inline F.RO.get. - rcondf{2} 4; first by auto=> &hr [#] !<<- _ _ ->> _ /=; rewrite pi_x2 oget_some /= in_dom Hro. - rcondf{2} 8; first by auto=> &hr [#] !<<- _ _ ->> _ /= _ _ _ _; rewrite in_rng; exists hx2. + rcondf{2} 4; first by auto=> &hr [#] !<<- _ _ ->> _ /=; rewrite pi_x2 oget_some /= domE Hro. + rcondf{2} 8; first by auto=> &hr [#] !<<- _ _ ->> _ /= _ _ _ _; rewrite rngE; exists hx2. rcondt{2} 9. + auto=> &hr [#] !<<- _ _ ->> _ /= _ _ _ _. - rewrite (@huniq_hinvK_h hx2 hs0 x2) // 2:in_dom 2:G1mh_x1hx2 2:!oget_some /=. + rewrite (@huniq_hinvK_h hx2 hs0 x2) // 2:domE 2:G1mh_x1hx2 2:!oget_some /=. + by have /hs_of_INV []:= inv0. - by rewrite /in_dom_with in_dom hs_hy2. - rcondt{2} 14; first by auto=> &hr [#] !<<- _ _ ->> _ /=; rewrite in_dom pi_x2. + by rewrite /in_dom_with domE hs_hy2. + rcondt{2} 14; first by auto=> &hr [#] !<<- _ _ ->> _ /=; rewrite domE pi_x2. auto=> &1 &2 [#] !<<- -> -> ->> _ /=; rewrite Block.DBlock.dunifin_ll Capacity.DCapacity.dunifin_ll /=. move=> _ _ _ _; rewrite PFm_x1x2 pi_x2 !oget_some //=. rewrite (@huniq_hinvK_h hx2 hs0 x2) // ?oget_some. + by have /hs_of_INV []:= inv0. - rewrite Hro G1mh_x1hx2 hs_hy2 ?oget_some //=in_dom. + rewrite Hro G1mh_x1hx2 hs_hy2 ?oget_some //=domE. cut[]_->_ _ _//=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. - case((x2, Unknown) \in rng hs0)=>//=_. + case(rng hs0 (x2, Unknown))=>//=_. exact/(@lemma3 _ _ _ _ _ _ _ _ _ _ _ _ _ _ hx2 _ _ hy2). by move=> /> &1 &2 -> ->. qed. @@ -1803,11 +1806,11 @@ qed. lemma behead_drop (l:'a list) : behead l = drop 1 l. proof. by case l => //= l;rewrite drop0. qed. -lemma incl_upd_nin (m1 m2:('a,'b)fmap) x y: incl m1 m2 => !mem (dom m2) x => incl m1 m2.[x <- y]. +lemma incl_upd_nin (m1 m2:('a,'b)fmap) x y: incl m1 m2 => x \notin m2 => incl m1 m2.[x <- y]. proof. move=> Hincl Hdom w ^/Hincl <- => Hw. - rewrite getP_neq // -negP => ->>. - by move: Hdom;rewrite in_dom. + rewrite get_set_neqE // -negP => ->>. + by move: Hdom;rewrite domE. qed. @@ -1815,7 +1818,7 @@ qed. lemma lemma5 hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes queries i (p : block list) b c h: INV_CF_G1 hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes queries => 0 <= i < size p - => take (i + 1) p \in dom prefixes + => take (i + 1) p \in prefixes => prefixes.[take i p] = Some (b,c) => (exists f, hs.[h] = Some (c,f)) => exists b' c' h', @@ -1826,7 +1829,9 @@ move=>Hinv H_size H_take_iS H_take_i H_hs_h. cut[]_ _ H _ _:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ Hinv. cut[]sa sc:=H _ H_take_iS i _;1:smt(size_take). rewrite!take_take !min_lel//= 1:/# nth_take 1,2:/#H_take_i=>[][]/=[->>->>] H_pm. -cut[]b' c' H_Pm:exists b' c', Pm.[(sa +^ nth witness p i, sc)] = Some (b',c') by smt(in_dom). +cut[]b' c' H_Pm:exists b' c', Pm.[(sa +^ nth witness p i, sc)] = Some (b',c'). ++ rewrite H_pm. exists (oget prefixes.[take (i + 1) p]).`1 (oget prefixes.[take (i + 1) p]).`2. + by move: H_take_iS; rewrite domE; case: (prefixes.[take (i + 1) p])=> //= - []. exists b' c';rewrite -H_Pm/=. cut[]h_Pm _:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ Hinv. cut[]h' f' hy fy[]H_h'[]H_hy H_mh:=h_Pm _ _ _ _ H_Pm. @@ -1856,7 +1861,7 @@ case(Pm.[(b +^ nth witness p i, c)] = None)=>//=H_Pm. by cut/#:=H_Gmh _ _ _ _ H_mh1. cut[]b1 c1 H_Pm1:exists b1 c1, Pm.[(b +^ nth witness p i, c)] = Some (b1,c1) by exists (oget Pm.[(b +^ nth witness p i, c)]).`1 - (oget Pm.[(b +^ nth witness p i, c)]).`2;smt(get_oget in_dom). + (oget Pm.[(b +^ nth witness p i, c)]).`2;smt(domE). cut[]H_P_m H_Gmh:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ Hinv. cut:=H_P_m _ _ _ _ H_Pm1. by cut[]/#:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ Hinv. @@ -1873,7 +1878,7 @@ equiv PFf_Cf (D<:DISTINGUISHER): G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} Redo.prefixes{1} C.queries{2} ==> if G1.bcol{2} \/ G1.bext{2} - then ([] \in dom C.queries{2}) + then ([] \in C.queries{2}) else ={glob C} /\ ={res} /\ INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} Redo.prefixes{1} C.queries{2}. @@ -1885,10 +1890,10 @@ proof. INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} Redo.prefixes{1} C.queries{2}.[bs{1} <- sa{1}] /\ F.RO.m.[p]{2} = Some sa{2});progress. - + by rewrite dom_set in_fsetU1 in_dom;left;cut[]_->_ _ _//=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H0. - + smt(dom_set in_fsetU1). - + smt(dom_set in_fsetU1). - + smt(dom_set in_fsetU1). + + by rewrite mem_set domE;left;cut[]_->_ _ _//=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H0. + + smt(mem_set). + + smt(mem_set). + + smt(mem_set). seq 1 1: (={i, p, glob C} /\ i{1} = size p{1} /\ p{2} = bs{1} /\ (!(G1.bcol{2} \/ G1.bext{2}) => @@ -1898,7 +1903,7 @@ proof. /\ ={sa} /\ F.RO.m.[p]{2} = Some sa{1})));last first. + case : (! (G1.bcol{2} \/ G1.bext{2}));last first. - by conseq(:_==>true);progress;auto;smt(DBlock.dunifin_ll DCapacity.dunifin_ll take_size). - by rcondf{2}3;auto;smt(in_dom DBlock.dunifin_ll DCapacity.dunifin_ll take_size). + by rcondf{2}3;auto;smt(domE DBlock.dunifin_ll DCapacity.dunifin_ll take_size). conseq(:_==> ={i, p, glob C} /\ i{1} = size p{1} /\ p{2} = bs{1} /\ (!(G1.bcol{2} \/ G1.bext{2}) => @@ -1907,15 +1912,15 @@ proof. C.queries{2}.[take i{2} bs{1} <- sa{1}] /\ ={sa} /\ F.RO.m.[p]{2} = Some sa{1})));1:smt(take_size). - splitwhile{1} 1 : i < prefixe p (get_max_prefixe p (elems (dom C.queries))). - splitwhile{2} 1 : i < prefixe p (get_max_prefixe p (elems (dom C.queries))). + splitwhile{1} 1 : i < prefix p (get_max_prefix p (elems (fdom C.queries))). + splitwhile{2} 1 : i < prefix p (get_max_prefix p (elems (fdom C.queries))). seq 1 1 : (={p, i, glob C, bs} /\ bs{2} = p{2} /\ - (prefixe p (get_max_prefixe p (elems (dom C.queries))) = i){2} /\ + (prefix p (get_max_prefix p (elems (fdom C.queries))) = i){2} /\ (Redo.prefixes.[take i p]{1} = Some (sa,sc){1}) /\ - (take i p \in dom Redo.prefixes){1} /\ + (take i p \in Redo.prefixes){1} /\ (C.queries.[[]] = Some b0){1} /\ - (! p{2} \in dom C.queries{2}) /\ + (! p{2} \in C.queries{2}) /\ (!(G1.bcol{2} \/ G1.bext{2}) => (INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} Redo.prefixes{1} @@ -1927,11 +1932,11 @@ proof. else F.RO.m.[take i p]{2} = Some sa{1})) /\ (i{2} = 0 => sa{1} = b0) /\ 0 < size p{2}). + while(={p, i, glob C} /\ bs{2} = p{2} /\ (i{2} = 0 => sa{1} = b0) /\ - (0 <= i <= prefixe p (get_max_prefixe p (elems (dom C.queries)))){2} /\ + (0 <= i <= prefix p (get_max_prefix p (elems (fdom C.queries)))){2} /\ (Redo.prefixes.[take i p]{1} = Some (sa,sc){1}) /\ - (take i p \in dom Redo.prefixes){1} /\ + (take i p \in Redo.prefixes){1} /\ (C.queries.[[]] = Some b0){1} /\ - (! p{2} \in dom C.queries{2}) /\ + (! p{2} \in C.queries{2}) /\ (!(G1.bcol{2} \/ G1.bext{2}) => (INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} Redo.prefixes{1} @@ -1942,24 +1947,24 @@ proof. if i{2} = 0 then (sa,h){2} = (b0, 0) else F.RO.m.[take i p]{2} = Some sa{1})) /\ 0 < size p{2});last first. - auto;progress. - * smt(@Prefixe). - * by cut[]:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H0;smt(take0 in_dom). - * by cut[]:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H0;smt(take0 in_dom). - * by cut[]:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H0;smt(take0 in_dom set_eq). - * by cut[]:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H0;smt(take0 in_dom). + * smt(@Prefix). + * by cut[]:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H0;smt(take0 domE). + * by cut[]:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H0;smt(take0 domE). + * by cut[]:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H0. + * by cut[]:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H0;smt(take0 domE). * by rewrite build_hpathP; apply/Empty=> //; exact/take0. - * by cut[]:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H0;smt(take0 in_dom size_take size_eq0). - * smt(prefixe_sizel). + * by cut[]:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H0;smt(take0 domE size_take size_eq0). + * smt(prefix_sizel). case(G1.bcol{2} \/ G1.bext{2}). - - by if{1};auto;conseq(:_==> (G1.bcol{2} \/ G1.bext{2}));1,3:smt(get_oget in_dom getP); + - by if{1};auto;conseq(:_==> (G1.bcol{2} \/ G1.bext{2}));1,3:smt(domE get_setE); (if{2};2:if{2});auto;1:smt(DBlock.dunifin_ll DCapacity.dunifin_ll); sp;if{1};auto;smt(DBlock.dunifin_ll DCapacity.dunifin_ll). conseq(: ={p, i, glob C} /\ bs{2} = p{2} /\ (i{2} = 0 => sa{1} = b0) /\ - 0 <= i{2} <= prefixe p{2} (get_max_prefixe p{2} (elems (dom C.queries{2}))) /\ + 0 <= i{2} <= prefix p{2} (get_max_prefix p{2} (elems (fdom C.queries{2}))) /\ Redo.prefixes{1}.[take i{1} p{1}] = Some (sa{1}, sc{1}) /\ - (C.queries.[[]] = Some b0){1} /\ (! p{2} \in dom C.queries{2}) /\ - (take i{1} p{1} \in dom Redo.prefixes{1}) /\ + (C.queries.[[]] = Some b0){1} /\ (! p{2} \in C.queries{2}) /\ + (take i{1} p{1} \in Redo.prefixes{1}) /\ (! (G1.bcol{2} \/ G1.bext{2}) => INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} Redo.prefixes{1} @@ -1971,41 +1976,41 @@ proof. if i{2} = 0 then (sa{2}, h{2}) = (b0, 0) else F.RO.m{2}.[take i{2} p{2}] = Some sa{1}) /\ (i{1} < size p{1} /\ - i{1} < prefixe p{1} (get_max_prefixe p{1} (elems (dom C.queries{1})))) /\ + i{1} < prefix p{1} (get_max_prefix p{1} (elems (fdom C.queries{1})))) /\ i{2} < size p{2} /\ - i{2} < prefixe p{2} (get_max_prefixe p{2} (elems (dom C.queries{2}))) /\ - ! (G1.bcol{2} \/ G1.bext{2}) /\ (take (i+1) p \in dom Redo.prefixes){1} /\ + i{2} < prefix p{2} (get_max_prefix p{2} (elems (fdom C.queries{2}))) /\ + ! (G1.bcol{2} \/ G1.bext{2}) /\ (take (i+1) p \in Redo.prefixes){1} /\ 0 < size p{2} ==>_);progress. - - cut:=prefixe_gt0_mem p{2} (elems (dom C.queries{2})) _;1:rewrite/#. + - cut:=prefix_gt0_mem p{2} (elems (fdom C.queries{2})) _;1:rewrite/#. rewrite-memE=>H_dom_q. cut[]HINV[]->>/=[]->>/=[]H_h[]H_path H_F_RO:=H6 H12. cut[]_ _ h1 h2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. - cut:=h2 (get_max_prefixe p{2} (elems (dom C.queries{2}))) _;1:rewrite /#. + cut:=h2 (get_max_prefix p{2} (elems (fdom C.queries{2}))) _; 1:smt(mem_fdom). move=>[]c; - cut H_dom_p:get_max_prefixe p{2} (elems (dom C.queries{2})) \in dom Redo.prefixes{1} by smt(in_dom). - cut->/=:=prefixe_take_leq p{2} (get_max_prefixe p{2} (elems (dom C.queries{2}))) (i{2}+1) _;1:rewrite/#. - smt(in_dom take_oversize prefixe_sizer). + cut H_dom_p:get_max_prefix p{2} (elems (fdom C.queries{2})) \in Redo.prefixes{1} by smt(domE mem_fdom). + cut->/=:=prefix_take_leq p{2} (get_max_prefix p{2} (elems (fdom C.queries{2}))) (i{2}+1) _;1:rewrite/#. + smt(domE take_oversize prefix_sizer). rcondt{1}1;1:auto;progress. rcondt{2}1;1:auto;progress. - cut[]HINV[]->>/=[]->>/=[]H_h[]H_path H_F_RO:=H6 H11. cut//=:=lemma5 _ _ _ _ _ _ _ _ _ _ _ _ i{hr} p{hr} sa{hr} sc{m} h{hr} HINV _ _ _ _. * by rewrite H0/=H7/=. - * smt(in_dom). + * smt(domE). * rewrite/#. * rewrite/#. - by move=>[]b2 c2 h2[]H_PFm H_Gmh;rewrite in_dom H_Gmh/=. + by move=>[]b2 c2 h2[]H_PFm H_Gmh;rewrite domE H_Gmh/=. auto;progress. - rewrite /#. - rewrite /#. - rewrite /#. - - smt(get_oget in_dom). + - smt(domE). - cut[]HINV[]->>/=[]->>/=[]H_h[]H_path H_F_RO/#:=H6 H11. - cut[]HINV[]->>/=[]->>/=[]H_h[]H_path H_F_RO:=H6 H11. cut[]H01 H02 H_pref1 H_pref2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. cut//=:=lemma5 _ _ _ _ _ _ _ _ _ _ _ _ i{2} p{2} sa{2} sc{1} h{2} HINV _ _ _ _. * by rewrite H0/=H7/=. - * smt(in_dom). + * smt(domE). * rewrite/#. * rewrite/#. move=>[]b2 c2 h2[]H_PFm H_Gmh. @@ -2017,7 +2022,7 @@ proof. cut[]H01 H02 H_pref1 H_pref2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. cut//=:=lemma5 _ _ _ _ _ _ _ _ _ _ _ _ i{2} p{2} sa{2} sc{1} h{2} HINV _ _ _ _. * by rewrite H0/=H7/=. - * smt(in_dom). + * smt(domE). * rewrite/#. * rewrite/#. move=>[]b2 c2 h2[]H_PFm H_Gmh. @@ -2029,7 +2034,7 @@ proof. cut[]H01 H02 H_pref1 H_pref2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. cut//=:=lemma5 _ _ _ _ _ _ _ _ _ _ _ _ i{2} p{2} sa{2} sc{1} h{2} HINV _ _ _ _. * by rewrite H0/=H7/=. - * smt(in_dom). + * smt(domE). * rewrite/#. * rewrite/#. move=>[]b2 c2 h2[]H_PFm H_Gmh. @@ -2040,7 +2045,7 @@ proof. cut[]H01 H02 H_pref1 H_pref2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. cut//=:=lemma5 _ _ _ _ _ _ _ _ _ _ _ _ i{2} p{2} sa{2} sc{1} h{2} HINV _ _ _ _. * by rewrite H0/=H7/=. - * smt(in_dom). + * smt(domE). * rewrite/#. * rewrite/#. move=>[]b2 c2 h2[]H_PFm H_Gmh. @@ -2051,52 +2056,13 @@ proof. alias{1} 1 prefixes = Redo.prefixes;sp. alias{2} 1 bad1 = G1.bcol;sp. - (* conseq(:_ ==> ={i, p, glob C} /\ i{1} = size p{1} /\ *) - (* p{2} = bs{1} /\ (! (G1.bcol{2} \/ G1.bext{2}) => *) - (* INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} *) - (* G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} prefixes{1} *) - (* C.queries{2} /\ (! (bad1{2} \/ G1.bext{2})) /\ *) - (* Redo.prefixes{1}.[take i{2} p{2}] = Some (sa{1}, sc{1}) /\ *) - (* (forall l, l \in dom prefixes{1} => *) - (* prefixes{1}.[l] = Redo.prefixes{1}.[l]) /\ *) - (* (forall l, l \in dom Redo.prefixes{1} => *) - (* exists l2, l ++ l2 = take i{2} p{2} \/ l ++ l2 \in dom C.queries{2}) /\ *) - (* (forall l, l \in dom Redo.prefixes{1} => *) - (* l \in dom prefixes{1} \/ exists j, 0 <= j < i{2} /\ take j p{2} = l) /\ *) - (* (forall j, 0 <= j < i{1} => exists (sa : block) (sc : capacity), *) - (* Redo.prefixes{1}.[take j p{2}] = Some (sa, sc) /\ *) - (* PF.m{1}.[(sa +^ nth witness p{2} j, sc)] = *) - (* Redo.prefixes{1}.[take (j + 1) p{2}]) /\ *) - (* ={sa} /\ F.RO.m{2}.[p{2}] = Some sa{1}));progress. *) - (* + cut[]HINV[]H_bad1[]H_prefixe[]H_pref[]H_pref2[]H_pref3[]H_pref4[]->> H_m_R0:=H6 H7. *) - (* cut[]HINV'[]->>[]->>[]H_h[]H_path H_F_RO:=H3 H_bad1. *) - (* rewrite take_size;split;..-2:by case:HINV=>//=. *) - (* cut[]H01 H02 H_m_p1 H_m_p2 H_m_p3:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ *) - (* HINV;split=>//=. *) - (* - cut[]H01' H02' H_m_p1' H_m_p2' H_m_p3':=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ *) - (* HINV'. *) - (* smt(in_dom). *) - (* - smt(in_dom getP). *) - (* - move=>l H_l_dom j Hj. *) - (* cut[]:=H_pref3 _ H_l_dom. *) - (* * move=>H_dom;cut:=H_m_p1 l H_dom j Hj;smt(in_dom take_oversize). *) - (* move=>[]k [][Hk0 Hk] <<-. *) - (* move:Hj;rewrite size_take 1:/# Hk/==>[][]Hj0 Hjk. *) - (* rewrite!take_take!min_lel// 1,2:/# nth_take 1,2:/#;smt(in_dom take_oversize). *) - (* - smt(dom_set in_fsetU1 getP dom_set in_dom take_size). *) - (* move=>l H_dom;cut:=H_pref3 l H_dom. *) - (* case(l \in dom Redo.prefixes{1})=>H_dom1/=;1:smt(dom_set in_fsetU1). *) - (* move=>[]j[][]Hj0 Hj_size <<-. *) - (* by exists (drop j p{2});rewrite cat_take_drop dom_set in_fsetU1. *) - (* + by rewrite/#. *) - (* + by rewrite/#. *) while ( ={i, p, C.queries, C.c} - /\ prefixe p{2} (get_max_prefixe p{2} (elems (dom C.queries{2}))) <= + /\ prefix p{2} (get_max_prefix p{2} (elems (fdom C.queries{2}))) <= i{1} <= size p{1} /\ Redo.prefixes{1}.[take i{2} p{2}] = Some (sa{1}, sc{1}) /\ p{2} = bs{1} - /\ (! p{2} \in dom C.queries{2}) + /\ (! p{2} \in C.queries{2}) /\ (! (G1.bcol{2} \/ G1.bext{2}) => INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} Redo.prefixes{1} @@ -2104,23 +2070,23 @@ proof. /\ ! (bad1{2} \/ G1.bext{2}) /\ m_p PF.m{1} prefixes{1} C.queries{2} /\ (forall (l : block list), - l \in dom prefixes{1} => prefixes{1}.[l] = Redo.prefixes{1}.[l]) - /\ (forall (l : block list), l \in dom Redo.prefixes{1} => - (l \in dom prefixes{1}) \/ + l \in prefixes{1} => prefixes{1}.[l] = Redo.prefixes{1}.[l]) + /\ (forall (l : block list), l \in Redo.prefixes{1} => + (l \in prefixes{1}) \/ exists (j : int), 0 <= j <= i{2} /\ take j p{2} = l) /\ ={sa} - /\ counter{2} <= i{2} - prefixe p{2} - (get_max_prefixe p{2} (elems (dom C.queries{2}))) + /\ counter{2} <= i{2} - prefix p{2} + (get_max_prefix p{2} (elems (fdom C.queries{2}))) /\ (exists (f : flag), FRO.m{2}.[h{2}] = Some (sc{1}, f)) /\ build_hpath G1.mh{2} (take i{2} p{2}) = Some (sa{2}, h{2}) /\ (if i{2} = 0 then (sa{2}, h{2}) = (b0, 0) else F.RO.m{2}.[take i{2} p{2}] = Some sa{1}) - /\ (i{2} < size p{2} => ! take (i{2}+1) p{2} \in dom Redo.prefixes{1})));last first. + /\ (i{2} < size p{2} => ! take (i{2}+1) p{2} \in Redo.prefixes{1})));last first. + auto;progress. - - smt(prefixe_sizel). + - smt(prefix_sizel). - cut[]HINV _:=H3 H6;split;..-2:case:HINV=>//=. by cut[]Hmp01 Hmp02 Hmp1 Hmp2 Hmp3:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV; - split=>//=;smt(take0 getP dom_set in_fsetU1 take_oversize take_le0). + split=>//=;smt(take0 get_setE mem_set take_oversize take_le0). - by cut[]HINV _:=H3 H6;cut:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. - rewrite/#. - rewrite/#. @@ -2132,12 +2098,12 @@ proof. - rewrite/#. - cut[]HINV[]->>[]->>[]H_h[]H_path H_F_RO:=H3 H6. cut[]H01 H02 Hmp1 Hmp2 Hmp3:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. - cut H_pref_eq:=prefixe_exchange_prefixe_inv (elems (dom C.queries{2})) - (elems (dom Redo.prefixes{1})) p{2} _ _ _. - * smt(memE in_dom). - * smt(memE in_dom take_oversize size_take take_take nth_take take_le0). - * smt(memE in_dom take_oversize size_take take_take nth_take take_le0). - by rewrite memE prefixe_lt_size 1:-H_pref_eq /#. + cut H_pref_eq:=prefix_exchange_prefix_inv (elems (fdom C.queries{2})) + (elems (fdom Redo.prefixes{1})) p{2} _ _ _. + * smt(memE domE mem_fdom). + * smt(memE mem_fdom domE take_oversize size_take take_take nth_take take_le0). + * smt(memE mem_fdom domE take_oversize size_take take_take nth_take take_le0). + by rewrite -mem_fdom memE prefix_lt_size 1:-H_pref_eq /#. - rewrite/#. - rewrite/#. - rewrite/#. @@ -2146,138 +2112,140 @@ proof. case : (! (G1.bcol{2} \/ G1.bext{2}));last first. - wp 1 1=>/=. conseq(:_==> Redo.prefixes{1}.[take (i{1}+1) p{1}] = Some (sa{1}, sc{1}) - /\ (take (i{1} + 1) p{1} \in dom Redo.prefixes{1}) - /\ (G1.bcol{2} \/ G1.bext{2}));1:smt(prefixe_ge0). + /\ (take (i{1} + 1) p{1} \in Redo.prefixes{1}) + /\ (G1.bcol{2} \/ G1.bext{2}));1:smt(prefix_ge0). if{1};sp;2:if{1};(if{2};2:if{2});sp;auto;5:swap{2}4-3;auto; - smt(getP get_oget dom_set in_fsetU1 DBlock.dunifin_ll DCapacity.dunifin_ll). + smt(get_setE mem_set DBlock.dunifin_ll DCapacity.dunifin_ll). rcondf{1}1;1:auto=>/#. sp;wp. if{1};2:rcondt{2}1;first last;3:rcondf{2}1;..3:auto. + progress. cut[]HINV[]Hbad[]HINV0[]Hp1[]Hp2[]->>[]H_counter[]H_h[]H_path[]H_F_RO H_take_not_in:=H3 H6. cut:=lemma5' _ _ _ _ _ _ _ _ _ _ _ _ i{hr} bs{m} sa{hr} sc{m} h{hr} HINV _ _ _. - - smt(prefixe_ge0). + - smt(prefix_ge0). - exact H1. - exact H_h. - by cut:=H7;rewrite !in_dom=>->/=/#. + by cut:=H7;rewrite !domE=>->/=/#. + progress. - rewrite/#. - rewrite/#. - - by rewrite getP. + - by rewrite get_setE. - cut[]HINV[]Hbad[]H_m_p0[]Hp1[]Hp2[]->>[]H_counter[]H_h[]H_path[]H_F_RO H_take_not_in:=H3 H6. split;..-2:case:HINV=>//=. cut[]Hmp01 Hmp02 Hmp1 Hmp2 Hmp3:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV;split=>//=. - * smt(getP size_take size_eq0 size_ge0 prefixe_ge0). + * smt(get_setE size_take size_eq0 size_ge0 prefix_ge0). * by cut[]_ Hmp02' _ _ _:=H_m_p0; - smt(getP size_take size_eq0 size_ge0 prefixe_ge0 take0). - * move=>l;rewrite!dom_set !in_fsetU1. + smt(get_setE size_take size_eq0 size_ge0 prefix_ge0 take0). + * move=>l;rewrite!mem_set. case(l = take (i{2} + 1) bs{1})=>//=[->>|]. - + move=>j;rewrite size_take;1:smt(prefixe_ge0). + + move=>j;rewrite size_take;1:smt(prefix_ge0). cut->/=:(if i{2} + 1 < size bs{1} then i{2} + 1 else size bs{1}) = i{2} + 1 by rewrite/#. - move=>[]H0j HjiS;rewrite!getP. + move=>[]H0j HjiS;rewrite!get_setE. cut->/=:! take j (take (i{2} + 1) bs{1}) = take (i{2} + 1) bs{1} by smt(size_take). - rewrite!take_take!min_lel 1,2:/# nth_take 2:/#;1:smt(prefixe_ge0). + rewrite!take_take!min_lel 1,2:/# nth_take 2:/#;1:smt(prefix_ge0). case(j < i{2})=>Hij. - cut->/=:!take (j + 1) bs{1} = take (i{2} + 1) bs{1} by smt(size_take). by cut:=Hmp1(take i{2} bs{1}) _ j _; - smt(in_dom take_take nth_take prefixe_ge0 size_take). + smt(domE take_take nth_take prefix_ge0 size_take). cut->>:j = i{2} by rewrite/#. - by exists sa{2} sc{1};rewrite H1/=;smt(get_oget). - move=>h H_dom j []Hi0 Hisize;rewrite!getP. - cut->/=:!take j l = take (i{2} + 1) bs{1} by smt(in_dom take_oversize size_take take_take). + by exists sa{2} sc{1};rewrite H1/=;smt(). + move=>h H_dom j []Hi0 Hisize;rewrite!get_setE. + cut->/=:!take j l = take (i{2} + 1) bs{1} by smt(domE take_oversize size_take take_take). by cut->/=/#:!take (j+1) l = take (i{2} + 1) bs{1} - by smt(in_dom take_oversize size_take take_take). - * move=>l;rewrite dom_set in_fsetU1. + by smt(domE take_oversize size_take take_take). + * move=>l;rewrite mem_set. case(l = take (i{2} + 1) bs{1})=>//=[->>|]. - + by rewrite!getP/=oget_some/=/#. - move=>h H_dom;rewrite!getP h/=. + + by rewrite!get_setE/=oget_some/=/#. + move=>h H_dom;rewrite!get_setE h/=. cut[]H2mp01 H2mp02 H2mp1 H2mp2 H2mp3:=H_m_p0. - rewrite-Hp1;1:smt(in_dom). + rewrite-Hp1;1:smt(domE). by apply H2mp2. - move=>l;rewrite !dom_set !in_fsetU1. + move=>l;rewrite !mem_set. case(l = take (i{2} + 1) bs{1})=>//=[->>|]. - + by exists []; smt(cats0 dom_set in_fsetU1). - move=>H_neq H_dom;cut[]l1:=Hmp3 _ H_dom;rewrite!dom_set!in_fsetU1;case=>H_case. - + exists l1;by rewrite in_fsetU1 H_case. - exists (rcons l1 (nth witness bs{1} i{2}));rewrite in_fsetU1;right. search rcons (++). - by rewrite-rcons_cat (@take_nth witness);smt(prefixe_ge0). + + by exists []; smt(cats0 mem_set). + move=>H_neq H_dom;cut[]l1:=Hmp3 _ H_dom;rewrite!mem_set;case=>H_case. + + exists l1;by rewrite mem_set H_case. + exists (rcons l1 (nth witness bs{1} i{2}));rewrite mem_set;right. + by rewrite-rcons_cat (@take_nth witness);smt(prefix_ge0). - rewrite/#. - rewrite/#. - - smt(in_dom getP). - - move:H9;rewrite dom_set in_fsetU1;case;smt(prefixe_ge0). + - smt(domE get_setE). + - move:H9;rewrite mem_set;case;smt(prefix_ge0). - cut[]HINV[]Hbad[]HINV0[]Hp1[]Hp2[]->>[]H_counter[]H_h[]H_path[]H_F_RO H_take_not_in:=H3 H6. cut:=lemma5' _ _ _ _ _ _ _ _ _ _ _ _ i{2} bs{1} sa{2} sc{1} h{2} HINV _ _ _. - - smt(prefixe_ge0). + - smt(prefix_ge0). - exact H1. - exact H_h. - by cut:=H7;rewrite !in_dom=>->/=/#. + by cut:=H7;rewrite !domE=>->/=/#. - rewrite/#. - cut[]HINV[]Hbad[]HINV0[]Hp1[]Hp2[]->>[]H_counter[]H_h[]H_path[]H_F_RO H_take_not_in:=H3 H6. cut:=lemma5' _ _ _ _ _ _ _ _ _ _ _ _ i{2} bs{1} sa{2} sc{1} h{2} HINV _ _ _. - - smt(prefixe_ge0). + - smt(prefix_ge0). - exact H1. - exact H_h. - cut:=H7;rewrite !in_dom=>->/=[]b4 c4 h4[]H_PFm H_Gmh;rewrite H_PFm H_Gmh !oget_some/=. + cut:=H7;rewrite !domE=>->/=[]b4 c4 h4[]H_PFm H_Gmh;rewrite H_PFm H_Gmh !oget_some/=. cut[]_ help:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. cut:=help _ _ _ _ H_Gmh. by cut[]f H_h':=H_h;rewrite H_h'/==>[][]a b c d[][]->>->>[];rewrite H_PFm/==>[]h'->>/#. - cut[]HINV[]Hbad[]HINV0[]Hp1[]Hp2[]->>[]H_counter[]H_h[]H_path[]H_F_RO H_take_not_in:=H3 H6. cut:=lemma5' _ _ _ _ _ _ _ _ _ _ _ _ i{2} bs{1} sa{2} sc{1} h{2} HINV _ _ _. - - smt(prefixe_ge0). + - smt(prefix_ge0). - exact H1. - exact H_h. - cut:=H7;rewrite !in_dom=>->/=[]b4 c4 h4[]H_PFm H_Gmh. - rewrite (@take_nth witness);1:smt(prefixe_ge0). - by rewrite build_hpath_prefix H_path/=;smt(get_oget in_dom). - - smt(prefixe_ge0). - - smt(prefixe_ge0). + cut:=H7;rewrite !domE=>->/=[]b4 c4 h4[]H_PFm H_Gmh. + rewrite (@take_nth witness);1:smt(prefix_ge0). + by rewrite build_hpath_prefix H_path/=;smt(domE). + - smt(prefix_ge0). + - smt(prefix_ge0). - cut[]HINV[]Hbad[]H_m_p0[]Hp1[]Hp2[]->>[]H_counter[]H_h[]H_path[]H_F_RO H_take_not_in:=H3 H6. cut:=lemma5' _ _ _ _ _ _ _ _ _ _ _ _ i{2} bs{1} sa{2} sc{1} h{2} HINV _ _ _. - - smt(prefixe_ge0). + - smt(prefix_ge0). - exact H1. - exact H_h. - cut:=H7;rewrite !in_dom=>->/=[]b4 c4 h4[]H_PFm H_Gmh. - rewrite(@take_nth witness);1:smt(prefixe_ge0). + cut:=H7;rewrite !domE=>->/=[]b4 c4 h4[]H_PFm H_Gmh. + rewrite(@take_nth witness);1:smt(prefix_ge0). cut[]_ help H_uniq_path:=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. - by rewrite help H_path;smt(get_oget in_dom). + by rewrite help H_path;smt(domE). - cut[]HINV[]Hbad[]H_m_p0[]Hp1[]Hp2[]->>[]H_counter[]H_h[]H_path[]H_F_RO H_take_not_in:=H3 H6. - rewrite dom_set in_fsetU1 negb_or/=;split;2:smt(size_take prefixe_ge0 take_oversize). + rewrite mem_set negb_or/=;split;2:smt(size_take prefix_ge0 take_oversize). cut:=Hp2 (take (i{2} + 1 + 1) bs{1}). pose P:= _ \/ _;cut/#:!P;rewrite/P;clear P;rewrite negb_or/=negb_exists/=;split. - * cut:=prefixe_exchange_prefixe_inv(elems (dom C.queries{2}))(elems (dom prefixes{1}))bs{1} _ _ _. - + by cut[]:=H_m_p0;smt(in_dom memE). + * cut:=prefix_exchange_prefix_inv(elems (fdom C.queries{2}))(elems (fdom prefixes{1}))bs{1} _ _ _. + + by cut[]:=H_m_p0;smt(domE memE mem_fdom). + cut[]Hmp01 Hmp02 Hmp1 Hmp2 Hmp3:=H_m_p0. - by cut:=all_prefixes_of_m_p _ _ _ H_m_p0;smt(memE in_dom). - + by cut[]:=H_m_p0;smt(memE in_dom). - by move=>H_pref_eq;rewrite memE prefixe_lt_size//= -H_pref_eq/#. - by move=>j;case(0<=j<=i{2})=>//=[][]Hj0 Hji;smt(size_take prefixe_ge0 take_le0). + by cut:=all_prefixes_of_m_p _ _ _ H_m_p0;smt(memE domE mem_fdom). + + by cut[]:=H_m_p0;smt(memE domE mem_fdom). + by move=>H_pref_eq;rewrite -mem_fdom memE prefix_lt_size//= -H_pref_eq/#. + by move=>j;case(0<=j<=i{2})=>//=[][]Hj0 Hji;smt(size_take prefix_ge0 take_le0). + progress. cut[]HINV[]Hbad[]H_m_p0[]Hp1[]Hp2[]->>[]H_counter[]H_h[]H_path[]H_F_RO H_take_not_in:=H3 H6. cut:=lemma5' _ _ _ _ _ _ _ _ _ _ _ _ i{hr} bs{m} sa{hr} sc{m} h{hr} HINV _ _ _. - - smt(prefixe_ge0). + - smt(prefix_ge0). - exact H1. - exact H_h. - by cut:=H7;rewrite !in_dom=>/=->/=. + by cut:=H7;rewrite !domE=>/=->/=. rcondt{2}1;1:auto=>/#. rcondt{2}5;auto;progress. - * rewrite(@take_nth witness);1:smt(prefixe_ge0);rewrite in_dom. + * rewrite(@take_nth witness);1:smt(prefix_ge0);rewrite domE. cut[]HINV[]H_bad[]H_m_p0[]Hp1[]Hp2[]->>[]H_counter[]H_h[]H_path[]H_F_RO H_i:=H3 H6. cut[]:=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. cut:=lemma5' _ _ _ _ _ _ _ _ _ _ _ _ i{hr} bs{m} sa{hr} sc{m} h{hr} HINV _ _ _. - * smt(prefixe_ge0). + * smt(prefix_ge0). * rewrite/#. * rewrite/#. - cut:=H7;rewrite in_dom =>/=->/=H_Gmh _ H_ H_path_uniq. + cut:=H7;rewrite domE =>/=->/=H_Gmh _ H_ H_path_uniq. cut help:=H_ (take i{hr} bs{m}) (nth witness bs{m} i{hr});rewrite H_path/= in help. cut:forall (b : block), F.RO.m{hr}.[rcons (take i{hr} bs{m}) (nth witness bs{m} i{hr})] = Some b <=> exists hy, G1.mh{hr}.[(sa{hr} +^ nth witness bs{m} i{hr}, h{hr})] = Some (b, hy) by rewrite/#. move:help=>_ help;move:H_Gmh;apply absurd=>//=H_F_Ro. - by cut:=get_oget F.RO.m{hr} (rcons (take i{hr} bs{m}) (nth witness bs{m} i{hr}));rewrite in_dom H_F_Ro/=help=>[]/#. + have[]b h: exists b, F.RO.m{hr}.[rcons (take i{hr} bs{m}) (nth witness bs{m} i{hr})] = Some b. + + by move: H_F_Ro; case: (F.RO.m{hr}.[rcons (take i{hr} bs{m}) (nth witness bs{m} i{hr})])=> //= /#. + by have:= (help b); rewrite h; smt(). swap{2}-3;auto;progress. * rewrite/#. * rewrite/#. - * by rewrite!getP/=. + * by rewrite!get_setE/=. * cut[]HINV[]H_bad[]H_m_p0[]Hp1[]Hp2[]->>[]H_counter[][]f H_h[]H_path[]H_F_RO H_i:=H3 H6. cut:=H12;rewrite !negb_or/==>[][][]bad1 hinv_none bad2. cut H_hs_spec:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. @@ -2286,19 +2254,19 @@ proof. cut H_mi_mhi:=mi_mhi_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. cut H_pi_spec:=pi_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. cut :=lemma5' _ _ _ _ _ _ _ _ _ _ _ _ i{2} bs{1} sa{2} sc{1} h{2} HINV _ _ _. - * smt(prefixe_ge0). + * smt(prefix_ge0). * exact H1. * rewrite/#. - cut:=H7;rewrite in_dom/==>->/=h_g1. + cut:=H7;rewrite domE/==>->/=h_g1. cut H2_pi_spec:pi_spec FRO.m{2}.[G1.chandle{2} <- (y2L, Unknown)] G1.mh{2}.[(sa{2} +^ nth witness bs{1} i{2}, h{2}) <- (y1L, G1.chandle{2})] G1.paths{2}. + split;progress. - cut[]h:=H_pi_spec;cut:=h c p0 v;rewrite H13/==>[][]h1[] h'1 h'2. - exists h1;rewrite -h'2 getP/=. + exists h1;rewrite -h'2 get_setE/=. cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h'2. by apply build_hpath_up=>//=. - move:H14;rewrite getP/==>hh0. + move:H14;rewrite get_setE/==>hh0. cut h0_neq_ch:h0 <> G1.chandle{2} by rewrite/#. cut[]->:=H_pi_spec;rewrite-hh0 h0_neq_ch/=;exists h0=>/=. cut:=H;cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness bs{1} i{2}) y1L p0 v h0. @@ -2310,38 +2278,38 @@ proof. by cut:=hinvP FRO.m{2} y2L;rewrite hinv_none/=/#. + by cut:=invG_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + apply inv_addm=>//;1:cut//:=inv_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. - apply (notin_hs_notin_dom2_mh FRO.m{2} PF.mi{1})=>//=. - by apply ch_notin_dom_hs;cut:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + apply (notin_hs_notdomE2_mh FRO.m{2} PF.mi{1})=>//=. + by apply ch_notdomE_hs;cut:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + cut[] H_huniq _ _:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. - rewrite!getP/=oget_some. + rewrite!get_setE/=oget_some. apply (m_mh_addh_addm _ H_m_mh H_huniq H_h _)=>//=. - by apply ch_notin_dom_hs;cut:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + by apply ch_notdomE_hs;cut:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + cut[] H_huniq _ _:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. - rewrite!getP/=oget_some;apply (mi_mhi_addh_addmi _ H_mi_mhi _ H_h _)=>//=. + rewrite!get_setE/=oget_some;apply (mi_mhi_addh_addmi _ H_mi_mhi _ H_h _)=>//=. - smt(hinvP). - by apply ch_notin_dom_hs;cut:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + by apply ch_notdomE_hs;cut:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + apply incl_upd_nin=>//=. by cut:=incl_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + apply incl_upd_nin=>//=. - by cut:=incli_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. - cut:=hinvP FRO.m{2} y2L;rewrite in_dom hinv_none/=;apply absurd=>H_P_mi. + cut:=hinvP FRO.m{2} y2L;rewrite domE hinv_none/=;apply absurd=>H_P_mi. rewrite negb_forall/=. cut H_inv_Gmh:=inv_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. cut[]H_inv_Pm:=inv_mh_inv_Pm _ _ _ _ _ H_m_mh H_mi_mhi H_inv_Gmh. cut[]H_Pmi H_Gmhi:=mi_mhi_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. by cut[]/#:=H_Pmi y1L y2L (oget PF.mi{1}.[(y1L, y2L)]).`1 - (oget PF.mi{1}.[(y1L, y2L)]).`2 _;1:smt(get_oget in_dom). - + cut H_take_Si:=take_nth witness i{2} bs{1} _;1:smt(prefixe_ge0). + (oget PF.mi{1}.[(y1L, y2L)]).`2 _;1:smt(domE). + + cut H_take_Si:=take_nth witness i{2} bs{1} _;1:smt(prefix_ge0). split=>//=. - - move=>x hx y hy;rewrite !getP. + - move=>x hx y hy;rewrite !get_setE. case((x, hx) = (sa{2} +^ nth witness bs{1} i{2}, h{2}))=>//=. * move=>[->> ->>][<<- <<-]/=. cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec H_h. rewrite H_h/=. exists sc{1} f y2L Unknown=>//=. - exists (take i{2} bs{1}) (sa{2})=>//=;rewrite getP Block.WRing.addKr/=. - rewrite oget_some/=(@take_nth witness)/=;1:smt(prefixe_ge0). - by apply build_hpath_up=>//=;smt(in_dom). + exists (take i{2} bs{1}) (sa{2})=>//=;rewrite get_setE Block.WRing.addKr/=. + rewrite oget_some/=(@take_nth witness)/=;1:smt(prefix_ge0). + by apply build_hpath_up=>//=;smt(domE). move=> neq h1. cut[]hh1 hh2 hh3:=H_mh_spec. cut[]xc hxx yc hyc []h2[]h3 h4:=hh1 _ _ _ _ h1. @@ -2349,26 +2317,24 @@ proof. cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h3. rewrite h2 h3/=;exists xc hxx yc hyc=>//=. move:h4;case(hyc = Known)=>//=neq2[]p0 b[]hp0 hb. - exists p0 b;rewrite getP. + exists p0 b;rewrite get_setE. cut->/=:=build_hpath_up _ _ _ y1L G1.chandle{2} _ _ _ hb h_g1. cut/#:!rcons p0 (b +^ x) = rcons (take i{2} bs{1}) (nth witness bs{1} i{2});move:neq;apply absurd=>//=h'. cut<<-:take i{2} bs{1}=p0 by rewrite/#. cut hbex:b +^ x = nth witness bs{1} i{2} by rewrite/#. by cut:=hb;rewrite H_path/==>[][->>->>]/=;rewrite-hbex Block.WRing.addKr/=. - progress. - * move:H13;rewrite getP/=H_take_Si/=. - case(p0 = (take i{2} bs{1}))=>[->>|hpp0];rewrite!getP/=!oget_some/=. + * move:H13;rewrite get_setE/=H_take_Si/=. + case(p0 = (take i{2} bs{1}))=>[->>|hpp0];rewrite!get_setE/=!oget_some/=. + cut->/=:=build_hpath_up _ _ _ y1L G1.chandle{2} _ _ _ H_path h_g1. case(bn = (nth witness bs{1} i{2}))=>[->> /= ->>|hbni]/=. - - by exists sa{2} h{2} G1.chandle{2}=>//=;rewrite getP/=. + - by exists sa{2} h{2} G1.chandle{2}=>//=;rewrite get_setE/=. cut->/=:!rcons (take i{2} bs{1}) bn = rcons (take i{2} bs{1}) (nth witness bs{1} i{2}). - move:hbni;apply absurd=>//=h. - cut->:bn = nth witness (rcons (take i{2} bs{1}) bn) i{2}. - * by rewrite nth_rcons size_take;smt(prefixe_ge0). - by rewrite h nth_rcons size_take;smt(prefixe_ge0). + exact/(rconsIs _ _ h). move=>h_ro_p_bn. cut[]_ hh4 _:=H_mh_spec. - by cut:=hh4 (take i{2} bs{1}) bn b0;rewrite h_ro_p_bn/=H_path/=;smt(getP @Block.WRing). + by cut:=hh4 (take i{2} bs{1}) bn b0;rewrite h_ro_p_bn/=H_path/=;smt(get_setE @Block.WRing). cut->/=:!rcons p0 bn = rcons (take i{2} bs{1}) (nth witness bs{1} i{2}). + move:hpp0;apply absurd=>/=h. cut:size p0 = size (take i{2} bs{1}) by smt(size_rcons). @@ -2378,9 +2344,9 @@ proof. cut[]_ hh4 _:=H_mh_spec. cut:=hh4 p0 bn b0;rewrite h_ro_p_bn/==>[][];progress. cut help:(sa{2} +^ nth witness bs{1} i{2}, h{2}) <> (v +^ bn, hx) by rewrite/#. - exists v hx hy=>//=;rewrite getP;rewrite eq_sym in help;rewrite help/=H14/=. + exists v hx hy=>//=;rewrite get_setE;rewrite eq_sym in help;rewrite help/=H14/=. by apply build_hpath_up=>//=. - move:H13 H14;rewrite!getP/=!oget_some/==>h_build_hpath_set. + move:H13 H14;rewrite!get_setE/=!oget_some/==>h_build_hpath_set. case(hy = G1.chandle{2})=>//=[->>|hy_neq_ch]/=. + move=>h;cut h_eq:v +^ bn = sa{2} +^ nth witness bs{1} i{2} && hx = h{2}. + cut/#:G1.mh{2}.[(v +^ bn, hx)] <> Some (b0, G1.chandle{2}). @@ -2398,7 +2364,7 @@ proof. F.RO.m{2}.[rcons p0 bn] = Some b0. move:H_h;case:f=>h_flag;last first. - cut:=known_path_uniq _ _ _ sc{1} h{2} p0 v (take i{2} bs{1}) sa{2} H2_pi_spec _ h_build_hpath_set _. - * rewrite getP/=h_flag. + * rewrite get_setE/=h_flag. by cut->//=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h_flag. * by apply build_hpath_up=>//=. move=>[]->>->>/=;apply absurd=>//=_. @@ -2425,85 +2391,88 @@ proof. progress. + cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness bs{1} i{2}) y1L p0 v hx. cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness bs{1} i{2}) y1L p' v' hx. - move:H13 H14;rewrite!getP/=!oget_some/==>H13 H14;rewrite H13 H14. + move:H13 H14;rewrite!get_setE/=!oget_some/==>H13 H14;rewrite H13 H14. cut->/=:=ch_neq0 _ _ H_hs_spec. cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec H_h. rewrite h_g1/=. by cut[]:=H_mh_spec;smt(dom_hs_neq_ch). cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness bs{1} i{2}) y1L p0 v hx. cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness bs{1} i{2}) y1L p' v' hx. - move:H13 H14;rewrite!getP/=!oget_some/==>H13 H14;rewrite H13 H14/=. + move:H13 H14;rewrite!get_setE/=!oget_some/==>H13 H14;rewrite H13 H14/=. cut->/=:=ch_neq0 _ _ H_hs_spec. cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec H_h. rewrite h_g1/=. by cut[]:=H_mh_spec;smt(dom_hs_neq_ch). - + rewrite!getP/=oget_some;exact H2_pi_spec. - + rewrite!getP/=!oget_some/=. + + rewrite!get_setE/=oget_some;exact H2_pi_spec. + + rewrite!get_setE/=!oget_some/=. cut H_m_p:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. cut H_all_prefixes:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. split;case:H_m_p=>//=Hmp01 Hmp02 Hmp1 Hmp2 Hmp3. - - smt(getP size_take prefixe_ge0). - - by cut[]:=H_m_p0;smt(getP size_take prefixe_ge0). - - move=>l;rewrite dom_set in_fsetU1;case=>H_case j []Hj0. - * move=>Hjsize;rewrite!getP/=. + - smt(get_setE size_take prefix_ge0). + - by cut[]:=H_m_p0;smt(get_setE size_take prefix_ge0). + - move=>l;rewrite mem_set;case=>H_case j []Hj0. + * move=>Hjsize;rewrite!get_setE/=. cut->/=:!take j l = take (i{2} + 1) bs{1} by rewrite/#. cut->/=:!take (j+1) l = take (i{2} + 1) bs{1} by rewrite/#. - smt(in_dom getP). - cut->>:=H_case;rewrite size_take;1:smt(prefixe_ge0). + smt(domE get_setE). + cut->>:=H_case;rewrite size_take;1:smt(prefix_ge0). cut->/=:(if i{2} + 1 < size bs{1} then i{2} + 1 else size bs{1}) = i{2} + 1 by rewrite/#. - move=>HjiS;rewrite!getP. + move=>HjiS;rewrite!get_setE. cut->/=:! take j (take (i{2} + 1) bs{1}) = take (i{2} + 1) bs{1} by smt(size_take). - rewrite!take_take!min_lel 1,2:/# nth_take 2:/#;1:smt(prefixe_ge0). + rewrite!take_take!min_lel 1,2:/# nth_take 2:/#;1:smt(prefix_ge0). case(j < i{2})=>Hij. - cut->/=:!take (j + 1) bs{1} = take (i{2} + 1) bs{1} by smt(size_take). - by cut:=Hmp1(take i{2} bs{1}) _ j _;smt(in_dom take_take nth_take prefixe_ge0 size_take getP). + by cut:=Hmp1(take i{2} bs{1}) _ j _;smt(domE take_take nth_take prefix_ge0 size_take get_setE). cut->>:j = i{2} by rewrite/#. - by exists sa{2} sc{1};rewrite H1/=;smt(get_oget getP in_dom). - - move=>l;rewrite dom_set in_fsetU1. + by exists sa{2} sc{1};rewrite H1/=;smt(get_setE domE). + - move=>l;rewrite mem_set. case(l = take (i{2} + 1) bs{1})=>//=[->>|]. - + by rewrite!getP/=oget_some/=/#. - move=>h H_dom;rewrite!getP h/=. + + by rewrite!get_setE/=oget_some/=/#. + move=>h H_dom;rewrite!get_setE h/=. cut[]H2mp01 H2mp02 H2mp1 H2mp2 H2mp3:=H_m_p0. - rewrite-Hp1;1:smt(in_dom). + rewrite-Hp1;1:smt(domE). by apply H2mp2. - move=>l;rewrite !dom_set !in_fsetU1. + move=>l;rewrite !mem_set. case(l = take (i{2} + 1) bs{1})=>//=[->>|]. - + by exists []; smt(cats0 dom_set in_fsetU1). - move=>H_neq H_dom;cut[]l1:=Hmp3 _ H_dom;rewrite!dom_set!in_fsetU1;case=>H_case. - + exists l1;by rewrite in_fsetU1 H_case. - exists (rcons l1 (nth witness bs{1} i{2}));rewrite in_fsetU1;right. - by rewrite-rcons_cat (@take_nth witness);smt(prefixe_ge0). + + by exists []; smt(cats0 mem_set). + move=>H_neq H_dom;cut[]l1:=Hmp3 _ H_dom;rewrite!mem_set;case=>H_case. + + exists l1;by rewrite mem_set H_case. + exists (rcons l1 (nth witness bs{1} i{2}));rewrite mem_set;right. + by rewrite-rcons_cat (@take_nth witness);smt(prefix_ge0). * rewrite/#. * cut[]HINV[]H_bad[]H_m_p0[]Hp1[]Hp2[]->>[]H_counter[][]f H_h[]H_path[]H_F_RO H_i:=H3 H6. - by split;cut[]//=:=H_m_p0;smt(getP in_dom take_take take_nth size_take - prefixe_ge0 nth_take take_oversize take_le0). - + rewrite!getP/=oget_some;smt(in_dom). - + smt(getP in_dom take_take size_take prefixe_ge0 nth_take take_oversize take_le0). - + rewrite!getP/=oget_some;smt(in_dom). + split;cut[]//=:=H_m_p0; smt(get_setE domE take_take take_nth size_take + prefix_ge0 nth_take take_oversize take_le0 mem_fdom fdom_set). + + rewrite!get_setE/=oget_some;smt(domE). + + smt(get_setE domE take_take size_take prefix_ge0 nth_take take_oversize take_le0). + + rewrite!get_setE/=oget_some;smt(domE). + rewrite/#. - + by rewrite!getP/=oget_some/#. - + rewrite!getP/=oget_some(@take_nth witness);1:smt(prefixe_ge0);rewrite build_hpath_prefix. + + by rewrite!get_setE/=oget_some/#. + + rewrite!get_setE/=oget_some(@take_nth witness);1:smt(prefix_ge0);rewrite build_hpath_prefix. cut[]HINV[]H_bad[]H_m_p0[]Hp1[]Hp2[]->>[]H_counter[][]f H_h[]H_path[]H_F_RO H_i:=H3 H6. cut:=lemma5' _ _ _ _ _ _ _ _ _ _ _ _ i{2} bs{1} sa{2} sc{1} h{2} HINV _ _ _. - - smt(prefixe_ge0). + - smt(prefix_ge0). - exact H1. - rewrite/#. - cut:=H7;rewrite in_dom=>/=->/=H_Gmh. - cut->/=:=build_hpath_up_None _ _ (y1L, G1.chandle{2})_ _ H_Gmh H_path;smt(getP). - + smt(prefixe_ge0). - + smt(prefixe_ge0). - + by rewrite!getP/=oget_some. - rewrite!dom_set!in_fsetU1 negb_or/=;split;2:smt(prefixe_ge0 size_take prefixe_ge0 take_oversize). + cut:=H7;rewrite domE=>/=->/=H_Gmh. + cut->/=:=build_hpath_up_None _ _ (y1L, G1.chandle{2})_ _ H_Gmh H_path;smt(get_setE). + + smt(prefix_ge0). + + smt(prefix_ge0). + + by rewrite!get_setE/=oget_some. + rewrite!mem_set negb_or/=;split;2:smt(prefix_ge0 size_take prefix_ge0 take_oversize). cut[]HINV[]H_bad[]H_m_p0[]Hp1[]Hp2[]->>[]H_counter[][]f H_h[]H_path[]H_F_RO H_i:=H3 H6. cut:=Hp2 (take (i{2} + 1 + 1) bs{1}). pose P:= _ \/ _;cut/#:!P;rewrite/P;clear P;rewrite negb_or/=negb_exists/=;split. - * cut:=prefixe_exchange_prefixe_inv(elems (dom C.queries{2}))(elems (dom prefixes{1}))bs{1} _ _ _. - + by cut[]:=H_m_p0;smt(in_dom memE). + * cut:=prefix_exchange_prefix_inv(elems (fdom C.queries{2}))(elems (fdom prefixes{1}))bs{1} _ _ _. + + by cut[]:=H_m_p0;smt(domE memE mem_fdom). + cut[]Hmp01 Hmp02 Hmp1 Hmp2 Hmp3:=H_m_p0. - by cut:=all_prefixes_of_m_p _ _ _ H_m_p0;smt(memE in_dom). - + by cut[]:=H_m_p0;smt(memE in_dom). - by move=>H_pref_eq;rewrite memE prefixe_lt_size//= -H_pref_eq/#. - by move=>j;case(0<=j<=i{2})=>//=[][]Hj0 Hji;smt(size_take prefixe_ge0 take_le0). + cut:=all_prefixes_of_m_p _ _ _ H_m_p0. + move=> + l2; rewrite -memE mem_fdom=> + /Hmp2 [c] l2_in_q - /(_ l2 _). + + by rewrite domE l2_in_q. + by move=> + i - /(_ i); rewrite -memE mem_fdom. + + by cut[]:=H_m_p0;smt(memE domE mem_fdom). + by move=>H_pref_eq;rewrite -mem_fdom memE prefix_lt_size//= -H_pref_eq/#. + by move=>j;case(0<=j<=i{2})=>//=[][]Hj0 Hji;smt(size_take prefix_ge0 take_le0). qed. @@ -2523,7 +2492,7 @@ section AUX. INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} Redo.prefixes{1} C.queries{2}, - [] \in dom C.queries{2}). + [] \in C.queries{2}). (* lossless D *) + exact/D_ll. (** proofs for G1.S.f *) @@ -2545,7 +2514,7 @@ section AUX. F.RO.m{2} G1.paths{2} Redo.prefixes{1} C.queries{2}). + by move=> &1 &2; rewrite negb_or. - + progress;cut[]:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H0;smt(in_dom). + + progress;cut[]:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H0;smt(domE). (* For now, everything is completely directed by the syntax of programs, so we can *try* to identify general principles of that weird data structure and of its invariant. I'm not sure we'll ever @@ -2577,7 +2546,7 @@ section AUX. smt (size_ge0). (* lossless and do not reset bad G1.C.f *) + move=> _; proc; inline *; wp;sp;if;auto;sp;if;auto;sp. - conseq(:_==> (G1.bcol \/ G1.bext));1:smt(@DBlock @DCapacity dom_set in_fsetU1). + conseq(:_==> (G1.bcol \/ G1.bext));1:smt(@DBlock @DCapacity mem_set). while (G1.bcol \/ G1.bext) (size p - i)=> [z|]. + if; 1:by auto=> /#. if;2:auto=>/#;wp; rnd predT; wp; rnd predT; auto. @@ -2586,24 +2555,24 @@ section AUX. (* Init ok *) inline *; auto=> />; split=> [|/#]. do !split. - + smt (getP map0P build_hpath_map0). - + smt (getP map0P build_hpath_map0). - + smt (getP map0P build_hpath_map0). - + smt (getP map0P build_hpath_map0). - + smt (getP map0P build_hpath_map0). - + smt (getP map0P build_hpath_map0). - + smt (getP map0P build_hpath_map0). - + smt (getP map0P build_hpath_map0). - + smt (getP map0P build_hpath_map0). - + smt (getP map0P build_hpath_map0). - + smt (getP map0P build_hpath_map0). - + smt (getP map0P build_hpath_map0). - + smt (getP map0P build_hpath_map0). - + smt (getP map0P build_hpath_map0). - + smt (getP map0P build_hpath_map0). - + by move=>l;rewrite dom_set in_fsetU1 dom0 in_fset0/==>->>/=/#. - + by move=>l;rewrite dom_set in_fsetU1 dom0 in_fset0/=!getP/==>->>/=/#. - + by move=>l;rewrite dom_set in_fsetU1 dom0 in_fset0/=/==>->>/=;exists[];rewrite dom_set in_fsetU1//=. + + smt (get_setE emptyE build_hpath_map0). + + smt (get_setE emptyE build_hpath_map0). + + smt (get_setE emptyE build_hpath_map0). + + smt (get_setE emptyE build_hpath_map0). + + smt (get_setE emptyE build_hpath_map0). + + smt (get_setE emptyE build_hpath_map0). + + smt (get_setE emptyE build_hpath_map0). + + smt (get_setE emptyE build_hpath_map0). + + smt (get_setE emptyE build_hpath_map0). + + smt (get_setE emptyE build_hpath_map0). + + smt (get_setE emptyE build_hpath_map0). + + smt (get_setE emptyE build_hpath_map0). + + smt (get_setE emptyE build_hpath_map0). + + smt (get_setE emptyE build_hpath_map0). + + smt (get_setE emptyE build_hpath_map0). + + smt (get_setE emptyE build_hpath_map0). + + smt (get_setE emptyE build_hpath_map0). + smt (get_setE emptyE build_hpath_map0). qed. @@ -2620,7 +2589,7 @@ section. lemma Real_G1 &m: Pr[GReal(D).main() @ &m: res /\ C.c <= max_size] <= Pr[G1(DRestr(D)).main() @ &m: res] - + (max_size ^ 2)%r * inv 2%r * mu dstate (pred1 witness) + + (max_size ^ 2 - max_size)%r * inv 2%r * mu dstate (pred1 witness) + Pr[G1(DRestr(D)).main() @&m: G1.bcol] + Pr[G1(DRestr(D)).main() @&m: G1.bext]. proof. From 820a78b293fa18bcf7eb0bea017eeb1701fa0b5d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Mon, 17 Sep 2018 19:33:11 +0200 Subject: [PATCH 310/525] push Gcol : beginning --- proof/smart_counter/Gcol.eca | 111 ++++++++++++++++++----------------- 1 file changed, 57 insertions(+), 54 deletions(-) diff --git a/proof/smart_counter/Gcol.eca b/proof/smart_counter/Gcol.eca index 1af352a..b0d6e4f 100644 --- a/proof/smart_counter/Gcol.eca +++ b/proof/smart_counter/Gcol.eca @@ -1,6 +1,6 @@ pragma -oldip. require import Core Int Real RealExtra StdOrder Ring StdBigop IntExtra. -require import List FSet NewFMap Utils Common SLCommon RndO FelTactic Mu_mem. +require import List FSet SmtMap Common SLCommon PROM FelTactic Mu_mem. require import DProd Dexcepted. (*...*) import Capacity IntOrder Bigreal RealOrder BRA. @@ -36,10 +36,10 @@ section PROOF. proc sample_c () = { var c=c0; - if (card (image fst (rng FRO.m)) <= 2*max_size /\ + if (card (image fst (frng FRO.m)) <= 2*max_size /\ count < max_size) { c <$ cdistr; - G1.bcol <- G1.bcol \/ mem (image fst (rng FRO.m)) c; + G1.bcol <- G1.bcol \/ mem (image fst (frng FRO.m)) c; count <- count + 1; } @@ -53,10 +53,10 @@ section PROOF. var h, i, counter <- 0; sa <- b0; while (i < size p ) { - if (mem (dom G1.mh) (sa +^ nth witness p i, h)) { + if ((sa +^ nth witness p i, h) \in G1.mh) { (sa, h) <- oget G1.mh.[(sa +^ nth witness p i, h)]; } else { - if (counter < size p - prefixe p (get_max_prefixe p (elems (dom C.queries)))) { + if (counter < size p - prefix p (get_max_prefix p (elems (fdom C.queries)))) { sc <@ sample_c(); sa' <- F.RO.get(take (i+1) p); sa <- sa +^ nth witness p i; @@ -80,14 +80,14 @@ section PROOF. proc f(x : state): state = { var p, v, y, y1, y2, hy2, hx2; - if (!mem (dom G1.m) x) { + if (x \notin G1.m) { y <- (b0,c0); - if (!(mem (rng FRO.m) (x.`2, Known))) { + if (!(rng FRO.m (x.`2, Known))) { FRO.m.[G1.chandle] <- (x.`2, Known); G1.chandle <- G1.chandle + 1; } hx2 <- oget (hinvK FRO.m x.`2); - if (mem (dom G1.paths) x.`2) { + if (x.`2 \in G1.paths) { (p,v) <- oget G1.paths.[x.`2]; y1 <- F.RO.get (rcons p (v +^ x.`1)); y2 <@ sample_c(); @@ -96,7 +96,7 @@ section PROOF. y2 <@ sample_c(); } y <- (y1,y2); - if (mem (dom G1.mh) (x.`1, hx2) /\ + if ((x.`1, hx2) \in G1.mh /\ in_dom_with FRO.m (oget G1.mh.[(x.`1,hx2)]).`2 Unknown) { hy2 <- (oget G1.mh.[(x.`1, hx2)]).`2; y <- (y.`1, (oget FRO.m.[hy2]).`1); @@ -112,7 +112,7 @@ section PROOF. G1.mi.[y] <- x; G1.mhi.[(y.`1, hy2)] <- (x.`1, hx2); } - if (mem (dom G1.paths) x.`2) { + if (x.`2 \in G1.paths) { (p,v) <- oget G1.paths.[x.`2]; G1.paths.[y.`2] <- (rcons p (v +^ x.`1), y.`1); } @@ -125,9 +125,9 @@ section PROOF. proc fi(x : state): state = { var y, y1, y2, hx2, hy2; - if (!mem (dom G1.mi) x) { + if (x \notin G1.mi) { y <- (b0,c0); - if (!(mem (rng FRO.m) (x.`2, Known))) { + if (!(rng FRO.m (x.`2, Known))) { FRO.m.[G1.chandle] <- (x.`2, Known); G1.chandle <- G1.chandle + 1; } @@ -135,7 +135,7 @@ section PROOF. y1 <$ bdistr; y2 <@ sample_c(); y <- (y1,y2); - if (mem (dom G1.mhi) (x.`1, hx2) /\ + if ((x.`1, hx2) \in G1.mhi /\ in_dom_with FRO.m (oget G1.mhi.[(x.`1,hx2)]).`2 Unknown) { (y1,hy2) <- oget G1.mhi.[(x.`1, hx2)]; y <- (y.`1, (oget FRO.m.[hy2]).`1); @@ -162,15 +162,15 @@ section PROOF. proc main(): bool = { var b; - F.RO.m <- map0; - G1.m <- map0; - G1.mi <- map0; - G1.mh <- map0; - G1.mhi <- map0; + F.RO.m <- empty; + G1.m <- empty; + G1.mi <- empty; + G1.mh <- empty; + G1.mhi <- empty; G1.bcol <- false; - FRO.m <- map0.[0 <- (c0, Known)]; - G1.paths <- map0.[c0 <- ([<:block>],b0)]; + FRO.m <- empty.[0 <- (c0, Known)]; + G1.paths <- empty.[c0 <- ([<:block>],b0)]; G1.chandle <- 1; count <- 0; b <@ DRestr(D,M,S).distinguish(); @@ -178,20 +178,22 @@ section PROOF. } }. - lemma card_rng_set (m:('a,'b)fmap) x y: card(rng m.[x<-y]) <= card(rng m) + 1. - proof. - rewrite rng_set fcardU fcard1. - cut := subset_leq_fcard (rng (rem x m)) (rng m) _;2:smt ml=0 w=fcard_ge0. - rewrite subsetP=> z;apply rng_rem_le. + lemma card_rng_set (m:('a,'b)fmap) x y: card(frng m.[x<-y]) <= card(frng m) + 1. + proof. + have: frng m.[x <- y] \subset frng m `|` fset1 y. + + move=> b; rewrite in_fsetU1 2!mem_frng 2!rngE /= => [] [] a. + rewrite get_setE; case: (a = x) =>[->>|hax] //= hmab; left. + by exists a. + move=> /subset_leq_fcard; rewrite fcardU fcard1; smt(fcard_ge0). qed. lemma hinv_image handles c: hinv handles c <> None => - mem (image fst (rng handles)) c. + mem (image fst (frng handles)) c. proof. case: (hinv handles c) (hinvP handles c)=>//= h[f] Heq. rewrite imageP;exists (c,f)=>@/fst/=. - by rewrite in_rng;exists (oget (Some h)). + by rewrite mem_frng rngE /=; exists (oget (Some h)). qed. local lemma Pr_col &m : @@ -200,14 +202,14 @@ section PROOF. proof. fel 10 Gcol.count (fun x=> (2*max_size)%r / (2^c)%r) max_size G1.bcol - [Gcol.sample_c : (card (image fst (rng FRO.m)) <= 2*max_size /\ Gcol.count < max_size)]=>//;2:by auto. + [Gcol.sample_c : (card (image fst (frng FRO.m)) <= 2*max_size /\ Gcol.count < max_size)]=>//;2:by auto. + rewrite /felsum Bigreal.sumr_const count_predT size_range. apply ler_wpmul2r;1:by apply eps_ge0. by rewrite le_fromint;smt ml=0 w=max_ge0. + proc;sp;if;2:by hoare=>//??;apply eps_ge0. wp. - rnd (mem (image fst (rng FRO.m)));skip;progress;2:smt ml=0. - cut->:=(Mu_mem.mu_mem (image fst (rng FRO.m{hr})) cdistr (1%r/(2^c)%r) _). + rnd (mem (image fst (frng FRO.m)));skip;progress;2:smt ml=0. + cut->:=(Mu_mem.mu_mem (image fst (frng FRO.m{hr})) cdistr (1%r/(2^c)%r) _). + move=>x _; rewrite DCapacity.dunifin1E;do !congr;smt(@Capacity). apply ler_wpmul2r;2:by rewrite le_fromint. by apply divr_ge0=>//;apply /c_ge0r. @@ -221,48 +223,49 @@ section PROOF. proc;inline*;wp. call (_: ={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m,C.c,C.queries}/\ (G1.bcol{1} => G1.bcol{2}) /\ - (card (rng FRO.m) <= 2*C.c + 1 /\ + (card (frng FRO.m) <= 2*C.c + 1 /\ Gcol.count <= C.c <= max_size){2}). + proc;sp 1 1;if=>//;inline G1(DRestr(D)).S.f Gcol.S.f;swap -3. sp;if;1,3:auto=>/#;swap{1}[1..2]3;sp 1 1. seq 5 5 : (={x0, y0, F.RO.m, G1.mi, G1.paths, G1.m, G1.mhi, G1.chandle, G1.mh, FRO.m, C.c, C.queries} /\ (G1.bcol{1} => G1.bcol{2}) - /\ card (rng FRO.m{2}) <= 2 * C.c{2} + 1 + /\ card (frng FRO.m{2}) <= 2 * C.c{2} + 1 /\ Gcol.count{2} <= C.c{2} <= max_size );last by if;auto. seq 2 2 : (={x0, hx2, F.RO.m, G1.mi, G1.paths, G1.m, G1.mhi, G1.chandle, G1.mh, FRO.m, C.c, C.queries} /\ (G1.bcol{1} => G1.bcol{2}) - /\ card (rng FRO.m{2}) <= 2 * C.c{2} + /\ card (frng FRO.m{2}) <= 2 * C.c{2} /\ Gcol.count{2} + 1 <= C.c{2} <= max_size);1: by if;auto;smt(card_rng_set). if;1:auto. - inline Gcol.sample_c;rcondt{2}4. * auto;inline*;auto;progress. - + by cut/#:=fcard_image_leq (fun (p : capacity * flag) => p.`1) (rng FRO.m{hr}). + + by cut/#:=fcard_image_leq (fun (p : capacity * flag) => p.`1) (frng FRO.m{hr}). rewrite/#. seq 3 4 : (={x0, p, v, y1, hx2, F.RO.m, G1.mi, G1.paths, G1.m, G1.mhi, G1.chandle, G1.mh, FRO.m, C.c, C.queries} /\ (G1.bcol{1} => G1.bcol{2}) - /\ card (rng FRO.m{2}) <= 2 * C.c{2} + /\ card (frng FRO.m{2}) <= 2 * C.c{2} /\ Gcol.count{2} + 1 <= C.c{2} <= max_size - /\ (x0{1}.`2 \in dom G1.paths{1}) + /\ (x0{1}.`2 \in G1.paths{1}) /\ y2{1} = c{2});1: by inline*;auto. sp 1 4;if;auto;progress. + by cut->:=(H H6). + smt(card_rng_set). + case:H5=>/=[h|H_hinv];1: by cut->:=H h. - by cut:=hinvP FRO.m{2} c{2};rewrite H_hinv/=imageP/==>[][]f H_f;smt(in_rng). + cut:=hinvP FRO.m{2} c{2};rewrite H_hinv/=imageP/==>[][]f H_f. + by right; exists (c{2}, f)=> //=; rewrite mem_frng rngE/= /#. smt(card_rng_set). inline Gcol.sample_c;rcondt{2}3. * auto;progress. - + by cut/#:=fcard_image_leq (fun (p : capacity * flag) => p.`1) (rng FRO.m{hr}). + + by cut/#:=fcard_image_leq (fun (p : capacity * flag) => p.`1) (frng FRO.m{hr}). rewrite/#. seq 2 3 : (={x0, y1, hx2, F.RO.m, G1.mi, G1.paths, G1.m, G1.mhi, G1.chandle, G1.mh, FRO.m, C.c, C.queries} /\ (G1.bcol{1} => G1.bcol{2}) - /\ card (rng FRO.m{2}) <= 2 * C.c{2} + /\ card (frng FRO.m{2}) <= 2 * C.c{2} /\ Gcol.count{2} + 1 <= C.c{2} <= max_size - /\ ! (x0{1}.`2 \in dom G1.paths{1}) + /\ ! (x0{1}.`2 \in G1.paths{1}) /\ y2{1} = c{2});1: by auto. sp 1 4;if;auto;progress. + by cut->:=(H H6). @@ -282,14 +285,14 @@ section PROOF. seq 3 3:(={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m, C.c,C.queries,x0,hx2} /\ (G1.bcol{1} => G1.bcol{2}) /\ - (card (rng FRO.m) + 1 <= 2 * C.c + 1 /\ + (card (frng FRO.m) + 1 <= 2 * C.c + 1 /\ Gcol.count + 1 <= C.c <= max_size){2}). + sp 1 1;if;auto;smt ml=0 w=card_rng_set. seq 3 3: (={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m, C.c,C.queries,x0,hx2,y0,y1,y2} /\ y0{1} = (y1,y2){1} /\ ((G1.bcol\/hinv FRO.m y0.`2 <> None){1} => G1.bcol{2}) /\ - (card (rng FRO.m) + 1 <= 2 * C.c + 1 /\ + (card (frng FRO.m) + 1 <= 2 * C.c + 1 /\ Gcol.count <= C.c <= max_size){2});2:by auto;smt w=card_rng_set. inline Gcol.sample_c. rcondt{2}3. @@ -304,33 +307,33 @@ section PROOF. C.queries,b,p,h,i,sa,bs,counter} /\ i{1}=size p{2} /\ p{2} = bs{2} /\ (G1.bcol{1} => G1.bcol{2}) /\ (0 <= counter{2} <= size p{2} - - prefixe p{2} (get_max_prefixe p{2} (elems (dom C.queries{1})))) /\ - card (rng FRO.m{2}) <= 2 * (C.c{2} + counter{2}) + 1 /\ + prefix p{2} (get_max_prefix p{2} (elems (dom C.queries{1})))) /\ + card (frng FRO.m{2}) <= 2 * (C.c{2} + counter{2}) + 1 /\ Gcol.count{2} + size p{2} - - prefixe p{2} (get_max_prefixe p{2} (elems (dom C.queries{1}))) + prefix p{2} (get_max_prefix p{2} (elems (dom C.queries{1}))) - counter{2} <= C.c{2} + size p{2} - - prefixe p{2} (get_max_prefixe p{2} (elems (dom C.queries{1}))) + prefix p{2} (get_max_prefix p{2} (elems (dom C.queries{1}))) <= max_size); - last by inline*;auto;smt(size_ge0 prefixe_sizel). + last by inline*;auto;smt(size_ge0 prefix_sizel). while (={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m,C.c,b, p,h,i,sa,counter,C.queries} /\ (0 <= i <= size p){1} /\ (G1.bcol{1} => G1.bcol{2}) /\ (0 <= counter{2} <= size p{2} - - prefixe p{2} (get_max_prefixe p{2} (elems (dom C.queries{1})))) /\ - card (rng FRO.m{2}) <= 2 * (C.c{2} + counter{2}) + 1 /\ + prefix p{2} (get_max_prefix p{2} (elems (dom C.queries{1})))) /\ + card (frng FRO.m{2}) <= 2 * (C.c{2} + counter{2}) + 1 /\ Gcol.count{2} + size p{2} - - prefixe p{2} (get_max_prefixe p{2} (elems (dom C.queries{1}))) + prefix p{2} (get_max_prefix p{2} (elems (dom C.queries{1}))) - counter{2} <= C.c{2} + size p{2} - - prefixe p{2} (get_max_prefixe p{2} (elems (dom C.queries{1}))) - <= max_size);last by auto;smt(size_ge0 prefixe_sizel prefixe_ge0). + prefix p{2} (get_max_prefix p{2} (elems (dom C.queries{1}))) + <= max_size);last by auto;smt(size_ge0 prefix_sizel prefix_ge0). if=>//;auto;1:smt ml=0 w=size_ge0. - if=>//;2:auto;2:smt(size_ge0 prefixe_sizel). + if=>//;2:auto;2:smt(size_ge0 prefix_sizel). auto;call (_: ={F.RO.m})=>/=;1:by sim. inline *;rcondt{2} 2. + auto;progress. - apply(StdOrder.IntOrder.ler_trans _ _ _ (fcard_image_leq fst (rng FRO.m{hr})))=>/#. - smt(size_ge0 prefixe_sizel). + smt(size_ge0 prefix_sizel). auto;smt ml=0 w=(hinv_image card_rng_set). auto;progress;3:by smt ml=0. + by rewrite rng_set rem0 rng0 fset0U fcard1. From fd13c4aa5ae1ab15c911591f9dce9b87258ebf78 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Mon, 17 Sep 2018 21:31:24 +0100 Subject: [PATCH 311/525] Gcol: finish --- proof/smart_counter/Gcol.eca | 25 ++++++++++++++----------- 1 file changed, 14 insertions(+), 11 deletions(-) diff --git a/proof/smart_counter/Gcol.eca b/proof/smart_counter/Gcol.eca index b0d6e4f..5fa1634 100644 --- a/proof/smart_counter/Gcol.eca +++ b/proof/smart_counter/Gcol.eca @@ -271,7 +271,9 @@ section PROOF. + by cut->:=(H H6). + smt(card_rng_set). + case:H5=>/=[h|H_hinv];1: by cut->:=H h. - by cut:=hinvP FRO.m{2} c{2};rewrite H_hinv/=imageP/==>[][]f H_f;smt(in_rng). + cut:= hinvP FRO.m{2} c{2}. + rewrite H_hinv /= imageP /= => [] [] f H_f. + by right; exists (c{2},f); rewrite mem_frng rngE /=; exists (oget (hinv FRO.m{2} c{2})). smt(card_rng_set). + proc;sp 1 1;if=>//. @@ -279,7 +281,7 @@ section PROOF. seq 2 2 : (={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m, C.c,C.queries,x0} /\ (G1.bcol{1} => G1.bcol{2}) /\ - (card(rng FRO.m) + 2 <= 2*C.c + 1 /\ + (card (frng FRO.m) + 2 <= 2*C.c + 1 /\ Gcol.count + 1 <= C.c <= max_size){2});1:by auto=>/#. if=>//;last by auto=>/#. seq 3 3:(={F.RO.m,G1.mi,G1.paths,G1.m,G1.mhi,G1.chandle,G1.mh,FRO.m, @@ -296,7 +298,7 @@ section PROOF. Gcol.count <= C.c <= max_size){2});2:by auto;smt w=card_rng_set. inline Gcol.sample_c. rcondt{2}3. - + by auto;progress;cut /#:= fcard_image_leq fst (rng FRO.m{hr}). + + by auto;progress;cut /#:= fcard_image_leq fst (frng FRO.m{hr}). (* BUG: auto=> /> ?? Himp _ _ _ ?_?_ [/Himp->// | H]. marche pas ???? *) auto=> /> ?? Himp _ _ _ ?_?_ [/Himp->// | X];right;apply hinv_image=> //. @@ -307,12 +309,12 @@ section PROOF. C.queries,b,p,h,i,sa,bs,counter} /\ i{1}=size p{2} /\ p{2} = bs{2} /\ (G1.bcol{1} => G1.bcol{2}) /\ (0 <= counter{2} <= size p{2} - - prefix p{2} (get_max_prefix p{2} (elems (dom C.queries{1})))) /\ + prefix p{2} (get_max_prefix p{2} (elems (fdom C.queries{1})))) /\ card (frng FRO.m{2}) <= 2 * (C.c{2} + counter{2}) + 1 /\ Gcol.count{2} + size p{2} - - prefix p{2} (get_max_prefix p{2} (elems (dom C.queries{1}))) + prefix p{2} (get_max_prefix p{2} (elems (fdom C.queries{1}))) - counter{2} <= C.c{2} + size p{2} - - prefix p{2} (get_max_prefix p{2} (elems (dom C.queries{1}))) + prefix p{2} (get_max_prefix p{2} (elems (fdom C.queries{1}))) <= max_size); last by inline*;auto;smt(size_ge0 prefix_sizel). while @@ -320,23 +322,24 @@ section PROOF. p,h,i,sa,counter,C.queries} /\ (0 <= i <= size p){1} /\ (G1.bcol{1} => G1.bcol{2}) /\ (0 <= counter{2} <= size p{2} - - prefix p{2} (get_max_prefix p{2} (elems (dom C.queries{1})))) /\ + prefix p{2} (get_max_prefix p{2} (elems (fdom C.queries{1})))) /\ card (frng FRO.m{2}) <= 2 * (C.c{2} + counter{2}) + 1 /\ Gcol.count{2} + size p{2} - - prefix p{2} (get_max_prefix p{2} (elems (dom C.queries{1}))) + prefix p{2} (get_max_prefix p{2} (elems (fdom C.queries{1}))) - counter{2} <= C.c{2} + size p{2} - - prefix p{2} (get_max_prefix p{2} (elems (dom C.queries{1}))) + prefix p{2} (get_max_prefix p{2} (elems (fdom C.queries{1}))) <= max_size);last by auto;smt(size_ge0 prefix_sizel prefix_ge0). if=>//;auto;1:smt ml=0 w=size_ge0. if=>//;2:auto;2:smt(size_ge0 prefix_sizel). auto;call (_: ={F.RO.m})=>/=;1:by sim. inline *;rcondt{2} 2. + auto;progress. - - apply(StdOrder.IntOrder.ler_trans _ _ _ (fcard_image_leq fst (rng FRO.m{hr})))=>/#. + - apply(StdOrder.IntOrder.ler_trans _ _ _ (fcard_image_leq fst (frng FRO.m{hr})))=>/#. smt(size_ge0 prefix_sizel). auto;smt ml=0 w=(hinv_image card_rng_set). auto;progress;3:by smt ml=0. - + by rewrite rng_set rem0 rng0 fset0U fcard1. + + rewrite -(add0z 1) -{2}fcards0<:capacity*flag> -(frng0<:int,_>). + exact/card_rng_set/max_ge0. by apply max_ge0. qed. From 94504b198c52dbe2d41b99dda21f9ff332bb582f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Tue, 18 Sep 2018 13:02:36 +0200 Subject: [PATCH 312/525] push Gext --- proof/smart_counter/Gext.eca | 321 +++++++++++++++++++---------------- 1 file changed, 170 insertions(+), 151 deletions(-) diff --git a/proof/smart_counter/Gext.eca b/proof/smart_counter/Gext.eca index 88f2077..fbdec43 100644 --- a/proof/smart_counter/Gext.eca +++ b/proof/smart_counter/Gext.eca @@ -1,6 +1,6 @@ pragma -oldip. require import Core Int Real RealExtra StdOrder Ring StdBigop IntExtra. -require import List FSet NewFMap Utils Common SLCommon RndO FelTactic Mu_mem. +require import List FSet SmtMap Common SLCommon PROM FelTactic Mu_mem. require import DProd Dexcepted. (*...*) import Capacity IntOrder Bigreal RealOrder BRA DCapacity. @@ -9,8 +9,8 @@ require (*..*) Gcol. clone export Gcol as Gcol0. op bad_ext (m mi:smap) y = - mem (image snd (dom m)) y \/ - mem (image snd (dom mi)) y. + mem (image snd (fdom m)) y \/ + mem (image snd (fdom mi)) y. op hinvc (m:(handle,capacity)fmap) (c:capacity) = find (+ pred1 c) m. @@ -24,10 +24,10 @@ module G2(D:DISTINGUISHER,HS:FRO) = { var h, i, counter <- 0; sa <- b0; while (i < size p ) { - if (mem (dom G1.mh) (sa +^ nth witness p i, h)) { + if ((sa +^ nth witness p i, h) \in G1.mh) { (sa, h) <- oget G1.mh.[(sa +^ nth witness p i, h)]; } else { - if (counter < size p - prefixe p (get_max_prefixe p (elems (dom C.queries)))) { + if (counter < size p - prefix p (get_max_prefix p (elems (fdom C.queries)))) { HS.sample(G1.chandle); sa' <@ F.RO.get(take (i+1) p); sa <- sa +^ nth witness p i; @@ -50,8 +50,8 @@ module G2(D:DISTINGUISHER,HS:FRO) = { proc f(x : state): state = { var p, v, y, y1, y2, hy2, hx2, handles_,t; - if (!mem (dom G1.m) x) { - if (mem (dom G1.paths) x.`2) { + if (x \notin G1.m) { + if (x.`2 \in G1.paths) { (p,v) <- oget G1.paths.[x.`2]; y1 <- F.RO.get (rcons p (v +^ x.`1)); y2 <$ cdistr; @@ -62,14 +62,14 @@ module G2(D:DISTINGUISHER,HS:FRO) = { y <- (y1, y2); handles_ <@ HS.restrK(); - if (!mem (rng handles_) x.`2) { + if (!rng handles_ x.`2) { HS.set(G1.chandle, x.`2); G1.chandle <- G1.chandle + 1; } handles_ <- HS.restrK(); hx2 <- oget (hinvc handles_ x.`2); t <@ HS.in_dom((oget G1.mh.[(x.`1,hx2)]).`2, Unknown); - if (mem (dom G1.mh) (x.`1, hx2) /\ t) { + if ((x.`1, hx2) \in G1.mh /\ t) { hy2 <- (oget G1.mh.[(x.`1, hx2)]).`2; y2 <@ HS.get(hy2); G1.bext <- G1.bext \/ bad_ext G1.m G1.mi y2 \/ y2 = x.`2; @@ -85,7 +85,7 @@ module G2(D:DISTINGUISHER,HS:FRO) = { G1.mi.[y] <- x; G1.mhi.[(y.`1, hy2)] <- (x.`1, hx2); } - if (mem (dom G1.paths) x.`2) { + if (x.`2 \in G1.paths) { (p,v) <- oget G1.paths.[x.`2]; G1.paths.[y.`2] <- (rcons p (v +^ x.`1), y.`1); } @@ -98,9 +98,9 @@ module G2(D:DISTINGUISHER,HS:FRO) = { proc fi(x : state): state = { var y, y1, y2, hx2, hy2, handles_, t; - if (!mem (dom G1.mi) x) { + if (x \notin G1.mi) { handles_ <@ HS.restrK(); - if (!mem (rng handles_) x.`2) { + if (!rng handles_ x.`2) { HS.set(G1.chandle, x.`2); G1.chandle <- G1.chandle + 1; } @@ -110,7 +110,7 @@ module G2(D:DISTINGUISHER,HS:FRO) = { y2 <$ cdistr; y <- (y1,y2); t <@ HS.in_dom((oget G1.mhi.[(x.`1,hx2)]).`2, Unknown); - if (mem (dom G1.mhi) (x.`1, hx2) /\ t) { + if ((x.`1, hx2) \in G1.mhi /\ t) { (y1,hy2) <- oget G1.mhi.[(x.`1, hx2)]; y2 <@ HS.get(hy2); y <- (y.`1, y2); @@ -137,16 +137,16 @@ module G2(D:DISTINGUISHER,HS:FRO) = { proc distinguish(): bool = { var b; - F.RO.m <- map0; - G1.m <- map0; - G1.mi <- map0; - G1.mh <- map0; - G1.mhi <- map0; + F.RO.m <- empty; + G1.m <- empty; + G1.mi <- empty; + G1.mh <- empty; + G1.mhi <- empty; G1.bext <- false; - C.queries<- map0.[[] <- b0]; + C.queries<- empty.[[] <- b0]; (* the empty path is initially known by the adversary to lead to capacity 0^c *) HS.set(0,c0); - G1.paths <- map0.[c0 <- ([<:block>],b0)]; + G1.paths <- empty.[c0 <- ([<:block>],b0)]; G1.chandle <- 1; b <@ D(M,S).distinguish(); return b; @@ -158,15 +158,15 @@ section. declare module D: DISTINGUISHER{G1, G2, FRO, C}. op inv_ext (m mi:smap) (FROm:handles) = - exists x h, mem (dom m `|` dom mi) x /\ FROm.[h] = Some (x.`2, Unknown). + exists x h, mem (fdom m `|` fdom mi) x /\ FROm.[h] = Some (x.`2, Unknown). op inv_ext1 bext1 bext2 (m mi:smap) (FROm:handles) = bext1 => (bext2 \/ inv_ext m mi FROm). lemma rng_restr (m : ('from, 'to * 'flag) fmap) f x: - mem (rng (restr f m)) x <=> mem (rng m) (x,f). + rng (restr f m) x <=> rng m (x,f). proof. - rewrite !in_rng;split=>-[z]H;exists z;move:H;rewrite restrP; case m.[z]=>//=. + rewrite !rngE;split=>-[z]H;exists z;move:H;rewrite restrP; case m.[z]=>//=. by move=> [t f'] /=;case (f'=f). qed. @@ -177,116 +177,133 @@ section. inline*;wp. call (_: ={F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.paths,G1.chandle,FRO.m,C.queries,C.c} /\ inv_ext1 G1.bext{1} G1.bext{2} G1.m{2} G1.mi{2} FRO.m{2} /\ - (forall h, mem (dom FRO.m) h => h < G1.chandle){1}). + (forall h, h \in FRO.m => h < G1.chandle){1}). + proc. sp;if;auto;inline G1(DRestr(D)).S.f G2(DRestr(D), FRO).S.f;sp;wp. if=>//;last by auto. seq 2 2: (={F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.paths,G1.chandle,FRO.m,x,x0,y0,C.queries,C.c} /\ inv_ext1 G1.bext{1} G1.bext{2} G1.m{2} G1.mi{2} FRO.m{2} /\ x{1} = x0{1} /\ - (forall h, mem (dom FRO.m) h => h < G1.chandle){1} /\ - ! mem (dom G1.m{1}) x0{1}). + (forall h, h \in FRO.m => h < G1.chandle){1} /\ + x0{1} \notin G1.m{1}). + by if=>//;auto;call (_: ={F.RO.m});[sim |auto]. seq 3 5: (={F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.paths,G1.chandle,FRO.m,hx2,x,x0,y0,hx2,C.queries,C.c} /\ t{2} = (in_dom_with FRO.m (oget G1.mh.[(x.`1, hx2)]).`2 Unknown){1} /\ x{1} = x0{1} /\ - (G1.bext{1} => (G1.bext{2} \/ (mem (rng FRO.m) (x.`2, Unknown)){2} \/ + (G1.bext{1} => (G1.bext{2} \/ (rng FRO.m (x.`2, Unknown)){2} \/ inv_ext G1.m{2} G1.mi{2} FRO.m{2})) /\ - (forall h, mem (dom FRO.m) h => h < G1.chandle){1} /\ - ! mem (dom G1.m{1}) x0{1}). + (forall h, h \in FRO.m => h < G1.chandle){1} /\ + x0{1} \notin G1.m{1}). + inline *;auto=> &ml&mr[#]10!-> -> ->->Hi-> Hhand -> /=. - rewrite -dom_restr rng_restr /=;progress;3:by smt ml=0. - + rewrite rng_set !inE rem_id 1:/#;move:H0=>[/Hi[->|[x' h][]H1 H2]|->]//. - right;right;exists x' h;rewrite getP. - by cut ->//:(h<> G1.chandle{mr});move:(Hhand h);rewrite in_dom H2 /#. - by move:H0;rewrite dom_set !inE /#. + rewrite -dom_restr rng_restr /=;progress;3:by smt ml=0. + + rewrite !rngE /=; move: H0=> [/Hi[->|[x h][]H1 H2]|H0]//. + + by right; right; exists x h; rewrite get_setE; smt(). + right; left; move: H0; rewrite rngE /= => [][] h Hh. + exists h; rewrite get_set_neqE //=. + by have:= Hhand h; rewrite domE Hh /#. + by move: H0; rewrite mem_set /#. seq 1 1: (={x0,y0,x,F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.paths,G1.chandle,FRO.m,C.queries,C.c} /\ inv_ext1 G1.bext{1} G1.bext{2} G1.m{2} G1.mi{2} FRO.m{2} /\ x{1} = x0{1} /\ - forall (h : handle), mem (dom FRO.m{1}) h => h < G1.chandle{1});2:by auto. + forall (h : handle), h \in FRO.m{1} => h < G1.chandle{1});2:by auto. if=>//. + inline *;rcondt{2} 4. + by move=> &m;auto;rewrite /in_dom_with. (* auto=> |>. (* Bug ???? *) *) auto;progress. + by apply sampleto_ll. - + rewrite /inv_ext1=>/H{H}[->//|[/in_rng[h]Hh|[[x1 x2] h [Hx Hh]]]]. - + case (h = (oget G1.mh{2}.[(x0{2}.`1, hx2{2})]).`2)=> [->>|Hneq]. + + rewrite /inv_ext1=>/H{H}[->//|[|[[x1 x2] h [Hx Hh]]]]. + + rewrite rngE/==>[][]h Hh. + case (h = (oget G1.mh{2}.[(x0{2}.`1, hx2{2})]).`2)=> [->>|Hneq]. + by rewrite Hh oget_some/#. - by right;exists x0{2} h;rewrite dom_set getP Hneq !inE. + by right;exists x0{2} h; rewrite fdom_set !in_fsetU !in_fset1/= get_set_neqE//. case (h = (oget G1.mh{2}.[(x0{2}.`1, hx2{2})]).`2)=> [->>|Hneq]. + rewrite Hh /bad_ext oget_some /= <@ Hx;rewrite !inE. by move=>[|]/(mem_image snd)->. - right;exists (x1,x2) h;rewrite !dom_set getP Hneq //=. - by move:Hx;rewrite !inE Hh=>-[]->. - by move:H6 H2;rewrite /in_dom_with dom_set !inE /#. - inline *;auto;progress;last by move:H3;rewrite dom_set !inE /#. - rewrite /inv_ext1=> /H [->//|[/in_rng[h]Hh|[x' h [Hx Hh]]]]. - + right;exists x0{2} h;rewrite getP dom_set !inE /=. - by move:(H0 h);rewrite in_dom Hh /#. - right;exists x' h;rewrite getP !dom_set !inE;split. - + by move:Hx;rewrite !inE=>-[]->. - by move:(H0 h);rewrite !in_dom Hh /#. + right;exists (x1,x2) h; move:Hx. + by rewrite !fdom_set !in_fsetU !in_fset1 //= => [][] -> //=; rewrite get_set_neqE. + by move:H6 H2;rewrite /in_dom_with mem_set /#. + inline *;auto;progress;last by move:H3;rewrite mem_set /#. + rewrite /inv_ext1=> /H [->//|[|[x' h [Hx Hh]]]]. + + rewrite rngE=> [][] h Hh. + right;exists x0{2} h; rewrite fdom_set !inE /= get_set_neqE //. + by move:(H0 h);rewrite domE Hh /#. + right;exists x' h; rewrite fdom_set !inE /= !mem_fdom. + move:(H0 h);rewrite domE Hh //= !get_setE => Hh2. + have-> /= : ! h = G1.chandle{2} by smt(). + by rewrite Hh /= mem_set; move: Hx; rewrite in_fsetU !mem_fdom=>[][]->. + proc;sp;if;auto;inline G1(DRestr(D)).S.fi G2(DRestr(D), FRO).S.fi;sp;wp. if=>//;last by auto. seq 6 8: (={F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.paths,G1.chandle,FRO.m,hx2,x,x0,y0,hx2,C.queries,C.c} /\ t{2} = (in_dom_with FRO.m (oget G1.mhi.[(x.`1, hx2)]).`2 Unknown){1} /\ x{1} = x0{1} /\ - (G1.bext{1} => (G1.bext{2} \/ (mem (rng FRO.m) (x.`2, Unknown)){2} \/ + (G1.bext{1} => (G1.bext{2} \/ (rng FRO.m (x.`2, Unknown)){2} \/ inv_ext G1.m{2} G1.mi{2} FRO.m{2})) /\ - (forall h, mem (dom FRO.m) h => h < G1.chandle){1} /\ - ! mem (dom G1.mi{1}) x{1}). + (forall h, h \in FRO.m => h < G1.chandle){1} /\ + x{1} \notin G1.mi{1}). + inline *;auto=> &ml&mr[#]-><-_ _9!-> Hi Hhand _ -> /=. rewrite -dom_restr rng_restr /=;progress; 3:by smt ml=0. - + rewrite rng_set !inE rem_id 1:/#;move:H4=>[/Hi[->|[x' h][]HH1 HH2]|->]//. - right;right;exists x' h;rewrite getP. - by cut ->//:(h<> G1.chandle{mr});move:(Hhand h);rewrite in_dom HH2 /#. - by move:H4;rewrite dom_set !inE /#. + + rewrite rngE/=; case: H4 =>//= H4. + + move:Hi; rewrite/inv_ext1 H4 /= => [][->|] //= [] x h. + move=> [#] H5 Hh; right; right. + exists x h; rewrite H5 get_set_neqE//=. + by move:(Hhand h);rewrite domE Hh /#. + move: H4; rewrite rngE /= => [][] h Hh; right; left. + exists h; rewrite get_set_neqE //=. + by move:(Hhand h);rewrite domE Hh /#. + by move:H4;rewrite mem_set /#. if=>//. + inline *;rcondt{2} 4. + by move=> &m;auto;rewrite /in_dom_with. auto;progress. + by apply sampleto_ll. - + rewrite /inv_ext1=>/H{H}[->//|[/in_rng[h]Hh|[[x1 x2] h [Hx Hh]]]]. - + case (h = (oget G1.mhi{2}.[(x0{2}.`1, hx2{2})]).`2)=> [->>|Hneq]. + + rewrite /inv_ext1=>/H{H}[->//|[|[[x1 x2] h [Hx Hh]]]]. + + rewrite rngE => [][h]Hh. + case (h = (oget G1.mhi{2}.[(x0{2}.`1, hx2{2})]).`2)=> [->>|Hneq]. + by left;rewrite Hh oget_some. - by right;exists x0{2} h;rewrite !dom_set getP Hneq !inE. + right; exists x0{2} h; rewrite !in_fsetU !mem_fdom !mem_set /=. + by rewrite get_set_neqE. case (h = (oget G1.mhi{2}.[(x0{2}.`1, hx2{2})]).`2)=> [->>|Hneq]. + rewrite Hh /bad_ext oget_some /= <@ Hx;rewrite !inE. by move=>[|]/(mem_image snd)->. - right;exists (x1,x2) h;rewrite !dom_set getP Hneq //=. - by move:Hx;rewrite !inE Hh=>-[]->. - by move:H6 H2;rewrite /in_dom_with dom_set !inE /#. - inline *;auto;progress;last by move:H3;rewrite dom_set !inE /#. - rewrite /inv_ext1=> /H [->//|[/in_rng[h]Hh|[x' h [Hx Hh]]]]. - + right;exists x0{2} h;rewrite getP !dom_set !inE /=. - by move:(H0 h);rewrite in_dom Hh /#. - right;exists x' h;rewrite getP !dom_set !inE;split. - + by move:Hx;rewrite !inE=>-[]->. - by move:(H0 h);rewrite !in_dom Hh /#. + right;exists (x1,x2) h;rewrite !in_fsetU !mem_fdom !mem_set /=. + rewrite get_set_neqE //= Hh /=. + by move: Hx; rewrite in_fsetU !mem_fdom=>[][] ->. + by move:H6 H2;rewrite /in_dom_with mem_set /#. + inline *;auto;progress;last by move:H3;rewrite mem_set /#. + rewrite /inv_ext1=> /H [->//|[|[x' h [Hx Hh]]]]. + + rewrite rngE => [][h]Hh. + right;exists x0{2} h;rewrite get_setE in_fsetU !mem_fdom !mem_set /=. + by move:(H0 h);rewrite domE Hh /#. + right;exists x' h;rewrite get_setE in_fsetU !mem_fdom !mem_set /=. + move:Hx; rewrite in_fsetU 2!mem_fdom=>[][]->//=. + + by move:(H0 h);rewrite domE Hh /#. + by move:(H0 h);rewrite domE Hh /#. + proc;sp;if;auto;sp;if;auto;sp. inline G1(DRestr(D)).M.f G2(DRestr(D), FRO).M.f;sp;wp. conseq (_: ={sa,G1.mh,G1.mhi,F.RO.m, G1.chandle, FRO.m,C.queries,C.c} /\ inv_ext1 G1.bext{1} G1.bext{2} G1.m{2} G1.mi{2} FRO.m{2} /\ - forall (h0 : handle), mem (dom FRO.m{1}) h0 => h0 < G1.chandle{1})=>//. + forall (h0 : handle), h0 \in FRO.m{1} => h0 < G1.chandle{1})=>//. sp;call (_: ={F.RO.m});1:by sim. while (={sa,G1.mh,G1.mhi,F.RO.m,G1.chandle,FRO.m,i,h,sa,p,C.queries,counter,bs} /\ inv_ext1 G1.bext{1} G1.bext{2} G1.m{2} G1.mi{2} FRO.m{2} /\ p{2} = bs{2} /\ - forall (h0 : handle), mem (dom FRO.m{1}) h0 => h0 < G1.chandle{1})=>//. + forall (h0 : handle), h0 \in FRO.m{1} => h0 < G1.chandle{1})=>//. if=>//;inline *;1:by auto. if;1,3:auto;progress. rcondt{2} 3;1:by auto=>/#. auto;progress. + move=>bad1;cut[/=->//|]:=H bad1;rewrite/inv_ext=>[][]x h[]H_dom Hh;right. - by exists x h;rewrite H_dom/=getP/= Hh;smt(in_dom getP). - + smt(dom_set in_fsetU1). + exists x h;rewrite H_dom/= get_set_neqE //=. + by move:(H0 h);rewrite domE Hh /#. + + smt(mem_set). + move=>bad1;cut[/=->//|]:=H bad1;rewrite/inv_ext=>[][]x h[]H_dom Hh;right. - by exists x h;rewrite H_dom/=getP/= Hh;smt(in_dom getP). - + smt(dom_set in_fsetU1). + exists x h;rewrite H_dom/= get_set_neqE //=. + by move:(H0 h);rewrite domE Hh /#. + + smt(mem_set). (* **************** *) inline *;auto;progress. - smt(dom_set in_fsetU1 dom0 in_fset0). + smt(mem_set mem_empty). qed. end section. @@ -300,8 +317,9 @@ section EXT. proc f (h:handle) = { var c; c <$ cdistr; - if (size G1.m <= max_size /\ size G1.mi <= max_size /\ ReSample.count < max_size) { - G1.bext <- G1.bext \/ mem (image snd (dom G1.m `|` dom G1.mi)) c; + if (card (fdom G1.m) <= max_size /\ card (fdom G1.mi) <= max_size + /\ ReSample.count < max_size) { + G1.bext <- G1.bext \/ mem (image snd (fdom G1.m `|` fdom G1.mi)) c; FRO.m.[h] <- (c,Unknown); count = count + 1 ; } @@ -310,8 +328,8 @@ section EXT. proc f1 (x:capacity,h:handle) = { var c; c <$ cdistr; - if (size G1.m < max_size /\ size G1.mi < max_size /\ ReSample.count < max_size) { - G1.bext <- G1.bext \/ mem (image snd (dom G1.m `|` dom G1.mi) `|` fset1 x) c; + if (card (fdom G1.m) < max_size /\ card (fdom G1.mi) < max_size /\ ReSample.count < max_size) { + G1.bext <- G1.bext \/ mem (image snd (fdom G1.m `|` fdom G1.mi) `|` fset1 x) c; FRO.m.[h] <- (c,Unknown); count = count + 1; } @@ -322,7 +340,7 @@ section EXT. local module Gext = { proc resample () = { - Iter(ReSample).iter (elems (dom (restr Unknown FRO.m))); + Iter(ReSample).iter (elems (fdom (restr Unknown FRO.m))); } module M = { @@ -332,10 +350,10 @@ section EXT. var h, i, counter <- 0; sa <- b0; while (i < size p ) { - if (mem (dom G1.mh) (sa +^ nth witness p i, h)) { + if ((sa +^ nth witness p i, h) \in G1.mh) { (sa, h) <- oget G1.mh.[(sa +^ nth witness p i, h)]; } else { - if (counter < size p - prefixe p (get_max_prefixe p (elems (dom C.queries)))) { + if (counter < size p - prefix p (get_max_prefix p (elems (fdom C.queries)))) { RRO.sample(G1.chandle); sa' <@ F.RO.get(take (i+1) p); sa <- sa +^ nth witness p i; @@ -358,8 +376,8 @@ section EXT. proc f(x : state): state = { var p, v, y, y1, y2, hy2, hx2, handles_,t; - if (!mem (dom G1.m) x) { - if (mem (dom G1.paths) x.`2) { + if (x \notin G1.m) { + if (x.`2 \in G1.paths) { (p,v) <- oget G1.paths.[x.`2]; y1 <- F.RO.get (rcons p (v +^ x.`1)); } else { @@ -370,14 +388,14 @@ section EXT. (* exists x h, mem (dom G1.m) x /\ handles.[h] = Some (x.2, I) *) handles_ <@ RRO.restrK(); - if (!mem (rng handles_) x.`2) { + if (!rng handles_ x.`2) { RRO.set(G1.chandle, x.`2); G1.chandle <- G1.chandle + 1; } handles_ <- RRO.restrK(); hx2 <- oget (hinvc handles_ x.`2); t <@ RRO.in_dom((oget G1.mh.[(x.`1,hx2)]).`2, Unknown); - if (mem (dom G1.mh) (x.`1, hx2) /\ t) { + if ((x.`1, hx2) \in G1.mh /\ t) { hy2 <- (oget G1.mh.[(x.`1, hx2)]).`2; ReSample.f1(x.`2, hy2); y2 <@ FRO.get(hy2); @@ -393,7 +411,7 @@ section EXT. G1.mi.[y] <- x; G1.mhi.[(y.`1, hy2)] <- (x.`1, hx2); } - if (mem (dom G1.paths) x.`2) { + if (x.`2 \in G1.paths) { (p,v) <- oget G1.paths.[x.`2]; G1.paths.[y.`2] <- (rcons p (v +^ x.`1), y.`1); } @@ -406,9 +424,9 @@ section EXT. proc fi(x : state): state = { var y, y1, y2, hx2, hy2, handles_, t; - if (!mem (dom G1.mi) x) { + if (x \notin G1.mi) { handles_ <@ RRO.restrK(); - if (!mem (rng handles_) x.`2) { + if (!rng handles_ x.`2) { RRO.set(G1.chandle, x.`2); G1.chandle <- G1.chandle + 1; } @@ -418,7 +436,7 @@ section EXT. y2 <$ cdistr; y <- (y1,y2); t <@ RRO.in_dom((oget G1.mhi.[(x.`1,hx2)]).`2, Unknown); - if (mem (dom G1.mhi) (x.`1, hx2) /\ t) { + if ((x.`1, hx2) \in G1.mhi /\ t) { (y1,hy2) <- oget G1.mhi.[(x.`1, hx2)]; ReSample.f1(x.`2,hy2); y2 <@ FRO.get(hy2); @@ -447,18 +465,18 @@ section EXT. var b; SLCommon.C.c <- 0; - F.RO.m <- map0; - G1.m <- map0; - G1.mi <- map0; - G1.mh <- map0; - G1.mhi <- map0; + F.RO.m <- empty; + G1.m <- empty; + G1.mi <- empty; + G1.mh <- empty; + G1.mhi <- empty; G1.bext <- false; ReSample.count <- 0; - FRO.m <- map0; + FRO.m <- empty; (* the empty path is initially known by the adversary to lead to capacity 0^c *) RRO.set(0,c0); - G1.paths <- map0.[c0 <- ([<:block>],b0)]; + G1.paths <- empty.[c0 <- ([<:block>],b0)]; G1.chandle <- 1; b <@ DRestr(D,M,S).distinguish(); resample(); @@ -467,13 +485,13 @@ section EXT. }. op inv_lt (m2 mi2:smap) c1 (Fm2:handles) count2 = - size m2 < c1 /\ size mi2 < c1 /\ - count2 + size (restr Unknown Fm2) < c1 /\ + card (fdom m2) < c1 /\ card (fdom mi2) < c1 /\ + count2 + card (fdom (restr Unknown Fm2)) < c1 /\ c1 <= max_size. op inv_le (m2 mi2:smap) c1 (Fm2:handles) count2 = - size m2 <= c1 /\ size mi2 <= c1 /\ - count2 + size (restr Unknown Fm2) <= c1 /\ + card (fdom m2) <= c1 /\ card (fdom mi2) <= c1 /\ + count2 + card (fdom (restr Unknown Fm2)) <= c1 /\ c1 <= max_size. lemma fset0_eqP (s:'a fset): s = fset0 <=> forall x, !mem s x. @@ -483,34 +501,34 @@ section EXT. qed. lemma size_set (m:('a,'b)fmap) (x:'a) (y:'b): - size (m.[x<-y]) = if mem (dom m) x then size m else size m + 1. + card (fdom (m.[x<-y])) = if x \in m then card (fdom m) else card (fdom m) + 1. proof. - rewrite sizeE dom_set;case (mem (dom m) x)=> Hx. - + by rewrite fsetUC subset_fsetU_id 2:sizeE 2:// => z; rewrite ?inE. + rewrite fdom_set;case (x \in m)=> Hx. + + by rewrite fsetUC subset_fsetU_id 2:// => z; rewrite ?inE mem_fdom. rewrite fcardUI_indep 1:fset0_eqP=>[z|]. - + by rewrite !inE;case (z=x)=>//. - by rewrite fcard1 sizeE. + + by rewrite !inE;case (z=x)=>//; rewrite mem_fdom. + by rewrite fcard1. qed. - lemma size_set_le (m:('a,'b)fmap) (x:'a) (y:'b): size (m.[x<-y]) <= size m + 1. + lemma size_set_le (m:('a,'b)fmap) (x:'a) (y:'b): card (fdom (m.[x<-y])) <= card (fdom m) + 1. proof. rewrite size_set /#. qed. lemma size_rem (m:('a,'b)fmap) (x:'a): - size (rem x m) = if mem (dom m) x then size m - 1 else size m. + card (fdom (rem m x)) = if x \in m then card (fdom m) - 1 else card (fdom m). proof. - rewrite !sizeE dom_rem fcardD;case (mem (dom m) x)=> Hx. - + by rewrite subset_fsetI_id 2:fcard1// => z;rewrite !inE. - by rewrite (@eq_fcards0 (dom m `&` fset1 x)) 2:// fset0_eqP=>z;rewrite !inE /#. + rewrite fdom_rem fcardD;case (x \in m)=> Hx. + + by rewrite subset_fsetI_id 2:fcard1// => z;rewrite !inE mem_fdom. + by rewrite (@eq_fcards0 (fdom m `&` fset1 x)) 2:// fset0_eqP=>z;rewrite !inE mem_fdom/#. qed. - lemma size_rem_le (m:('a,'b)fmap) x : size (rem x m) <= size m. + lemma size_rem_le (m:('a,'b)fmap) (x:'a) : card (fdom (rem m x)) <= card (fdom m). proof. by rewrite size_rem /#. qed. - lemma size_ge0 (m:('a,'b)fmap) : 0 <= size m. - proof. rewrite sizeE fcard_ge0. qed. + lemma size_ge0 (m:('a,'b)fmap) : 0 <= card (fdom m). + proof. rewrite fcard_ge0. qed. - lemma size0 : size map0<:'a,'b> = 0. - proof. by rewrite sizeE dom0 fcards0. qed. + lemma size0 : card (fdom empty<:'a,'b>) = 0. + proof. by rewrite fdom0 fcards0. qed. local equiv RROset_inv_lt : RRO.set ~ RRO.set : ={x,y,FRO.m} /\ inv_lt G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2} ==> @@ -527,37 +545,35 @@ section EXT. fel 8 ReSample.count (fun x=> (2*max_size)%r / (2^c)%r) max_size G1.bext [ReSample.f : - (size G1.m <= max_size /\ size G1.mi <= max_size /\ ReSample.count < max_size); + (card (fdom G1.m) <= max_size /\ card (fdom G1.mi) <= max_size /\ ReSample.count < max_size); ReSample.f1 : - (size G1.m < max_size /\ size G1.mi < max_size /\ ReSample.count < max_size) + (card (fdom G1.m) < max_size /\ card (fdom G1.mi) < max_size /\ ReSample.count < max_size) ]=> //; 2:by auto. + rewrite /felsum Bigreal.sumr_const count_predT size_range. apply ler_wpmul2r;1:by apply eps_ge0. by rewrite le_fromint;smt ml=0 w=max_ge0. + proc;rcondt 2;1:by auto. - wp; rnd (mem (image snd (dom G1.m `|` dom G1.mi ))); skip=> /> &hr ? ? -> /= ? ?. + wp; rnd (mem (image snd (fdom G1.m `|` fdom G1.mi ))); skip=> /> &hr h1 h2 h3 h4 h5. rewrite (Mu_mem.mu_mem - (image snd (dom G1.m{hr} `|` dom G1.mi{hr})) + (image snd (fdom G1.m{hr} `|` fdom G1.mi{hr})) cdistr (1%r/(2^c)%r))//. + by move=>x _;rewrite DCapacity.dunifin1E capacity_card. rewrite ler_wpmul2r;1:by apply divr_ge0=>//;apply /c_ge0r. rewrite imageU fcardU le_fromint. - move:(fcard_image_leq snd (dom G1.m{hr}))(fcard_image_leq snd (dom G1.mi{hr})). - by rewrite -!sizeE;smt w=fcard_ge0. - + rewrite/#. + move:(fcard_image_leq snd (fdom G1.m{hr}))(fcard_image_leq snd (fdom G1.mi{hr})). + smt(fcard_ge0). + by move=>c1;proc;auto=> &hr [^H 2->]/#. + by move=> b1 c1;proc;auto=> /#. + proc;rcondt 2;1:by auto. - wp;rnd (mem (image snd (dom G1.m `|` dom G1.mi) `|` fset1 x));skip=> /> &hr ??-> /= ??. - rewrite (Mu_mem.mu_mem (image snd (dom G1.m{hr}`|`dom G1.mi{hr}) `|` fset1 x{hr}) cdistr (1%r/(2^c)%r))//. + wp;rnd (mem (image snd (fdom G1.m `|` fdom G1.mi) `|` fset1 x));skip=> /> &hr ?????. + rewrite (Mu_mem.mu_mem (image snd (fdom G1.m{hr}`|`fdom G1.mi{hr}) `|` fset1 x{hr}) cdistr (1%r/(2^c)%r))//. + by move=>x _;rewrite DCapacity.dunifin1E capacity_card. rewrite ler_wpmul2r;1:by apply divr_ge0=>//;apply /c_ge0r. rewrite imageU !fcardU le_fromint fcard1. - move:(fcard_image_leq snd (dom G1.m{hr}))(fcard_image_leq snd (dom G1.mi{hr})). - by rewrite -!sizeE;smt w=fcard_ge0. - + rewrite/#. + move:(fcard_image_leq snd (fdom G1.m{hr}))(fcard_image_leq snd (fdom G1.mi{hr})). + smt w=fcard_ge0. + by move=>c1;proc;auto=> &hr [^H 2->]/#. - move=> b1 c1;proc;auto=> /#. + by move=> b1 c1;proc;auto=> /#. qed. @@ -567,12 +583,12 @@ section EXT. ((G1.bext{1} \/ inv_ext G1.m{1} G1.mi{1} FRO.m{1}) => G1.bext{2}). proof. proc;inline *;wp. - while (={l,FRO.m,G1.m,G1.mi} /\ size G1.m{2} <= max_size /\ - size G1.mi{2} <= max_size /\ + while (={l,FRO.m,G1.m,G1.mi} /\ card (fdom G1.m{2}) <= max_size /\ + card (fdom G1.mi{2}) <= max_size /\ ReSample.count{2} + size l{2} <= max_size /\ ((G1.bext{1} \/ exists (x : state) (h : handle), - mem (dom G1.m{1} `|` dom G1.mi{1}) x /\ + mem (fdom G1.m{1} `|` fdom G1.mi{1}) x /\ FRO.m{1}.[h] = Some (x.`2, Unknown) /\ !mem l{1} h) => G1.bext{2})). + rcondt{2} 3. @@ -580,7 +596,7 @@ section EXT. auto=> &ml&mr[#]6!->;case(l{mr})=>[//|h1 l1/=Hle Hext c->/=];split. + smt w=(drop0 size_ge0). rewrite drop0=>-[H|[x h][#]];1:by rewrite Hext // H. - rewrite getP;case (h=h1)=> [/=->Hin->_ | Hneq ???]. + rewrite get_setE;case (h=h1)=> [/=->Hin->_ | Hneq ???]. + by right;apply (mem_image snd _ x). by rewrite Hext 2://;right;exists x h;rewrite Hneq. wp; call (_: ={F.RO.m,FRO.m,G1.paths,G1.mh,G1.mhi,G1.m,G1.mi,G1.chandle,G1.bext, C.c,C.queries} /\ @@ -606,11 +622,11 @@ section EXT. inline RRO.restrK;sp 1 1;if=>//. by wp;call RROset_inv_lt;auto. if=>//;wp. - + inline *;rcondt{1} 4;1:by auto=>/#. - rcondt{2} 5;1:by auto;smt w=(sizeE size_ge0). - rcondt{2} 10. by auto;progress;rewrite dom_set !inE. + + inline *;rcondt{1} 4;1:by auto=>/#. + rcondt{2} 5;1:by auto;smt w=(size_ge0). + rcondt{2} 10. by auto;progress;rewrite mem_set. wp;rnd{2};auto=> /= ??[#]!-> @/inv_lt @/inv_le [#] mlt milt clt cle Hin 3?->/=. - rewrite/Distr.is_lossless (sampleto_ll 0)/= => ? _;rewrite /bad_ext !getP /= !oget_some /= set_set_eq /=. + rewrite/Distr.is_lossless (sampleto_ll 0)/= => ? _;rewrite /bad_ext !get_setE /= !oget_some /= set_set_eqE //=. rewrite !(imageU,inE) restr_set /= size_rem dom_restr Hin //=; smt w=size_set_le. by call RROset_inv_lt;auto;smt w=size_set_le. @@ -629,10 +645,10 @@ section EXT. by wp;call RROset_inv_lt;auto. if=>//;wp. + inline *;rcondt{1} 4;1:by auto=>/#. - rcondt{2} 5;1:by auto;smt w=(sizeE size_ge0). - rcondt{2} 10. by auto;progress;rewrite dom_set !inE. + rcondt{2} 5;1:by auto;smt w=(size_ge0). + rcondt{2} 10. by auto;progress;rewrite mem_set. wp;rnd{2};auto=> /= ??[#]!-> @/inv_lt @/inv_le [#] mlt milt clt cle Hin 3?->/=. - rewrite/Distr.is_lossless (sampleto_ll 0) /= => ? _;rewrite /bad_ext !getP /= !oget_some /= set_set_eq /=. + rewrite/Distr.is_lossless (sampleto_ll 0) /= => ? _;rewrite /bad_ext !get_setE /= !oget_some /= set_set_eqE //=. rewrite !(imageU,inE) restr_set /= size_rem dom_restr Hin //=; smt w=size_set_le. by call RROset_inv_lt;auto;smt w=size_set_le. @@ -643,29 +659,32 @@ section EXT. conseq(:_==> ={i,p,G1.mh,sa,h,FRO.m,F.RO.m,G1.mh,G1.mhi,G1.chandle,counter} /\ 0 <= i{1} <= size p{1} /\ 0 <= counter{1} <= size p{1} - - prefixe bs{1} (get_max_prefixe bs{1} (elems (dom C.queries{1}))) /\ + prefix bs{1} (get_max_prefix bs{1} (elems (fdom C.queries{1}))) /\ c0R + size p{1} - - prefixe bs{1} (get_max_prefixe bs{1} (elems (dom C.queries{1}))) <= max_size /\ + prefix bs{1} (get_max_prefix bs{1} (elems (fdom C.queries{1}))) <= max_size /\ inv_le G1.m{2} G1.mi{2} (c0R + counter){2} FRO.m{2} ReSample.count{2});1:smt(List.size_ge0). while (={bs,i,p,G1.mh,sa,h,FRO.m,F.RO.m,G1.mh,G1.mhi,G1.chandle,counter,C.queries} /\ bs{1} = p{1} /\ 0 <= i{1} <= size p{1} /\ 0 <= counter{1} <= size p{1} - - prefixe bs{1} (get_max_prefixe bs{1} (elems (dom C.queries{1}))) /\ + prefix bs{1} (get_max_prefix bs{1} (elems (fdom C.queries{1}))) /\ c0R + size p{1} - - prefixe bs{1} (get_max_prefixe bs{1} (elems (dom C.queries{1}))) <= max_size /\ + prefix bs{1} (get_max_prefix bs{1} (elems (fdom C.queries{1}))) <= max_size /\ inv_le G1.m{2} G1.mi{2} (c0R + counter){2} FRO.m{2} ReSample.count{2}); - last by auto;smt(List.size_ge0 prefixe_sizel). + last by auto;smt(List.size_ge0 prefix_sizel). if=> //;1:by auto=>/#. if=> //;2:by auto=>/#. auto;call (_: ={F.RO.m});1:by sim. inline *;auto=> &ml &mr [#]!->@/inv_le Hi0[#] _ H_c_0 H_c_max H1 [#]H_size_m H_size_mi H_count H2 H3/=. - rewrite H3/==>H_nin_dom H_counter_prefixe c;rewrite DCapacity.dunifin_fu/=. - case(G1.chandle{mr} \in dom FRO.m{mr})=>//=[/#|]H_handle_in_dom. + rewrite H3/==>H_nin_dom H_counter_prefix c;rewrite DCapacity.dunifin_fu/=. + case(G1.chandle{mr} \in FRO.m{mr})=>//=[/#|]H_handle_in_dom. progress;..-3,-1: rewrite/#; by rewrite restr_set_eq size_set/=/#. - auto;progress[delta];rewrite ?(size0,restr0,restr_set,rem0,max_ge0,-sizeE,-cardE) //=. - + smt ml=0. + smt ml=0. + smt ml=0. - + elim H7=>// [[x h] [#]];rewrite -memE dom_restr /in_dom_with in_dom=> _ ->/=. + auto;progress[delta];rewrite ?(size0,restr0,restr_set,rem0,max_ge0,-sizeE,-cardE) //=. + + smt(size_rem_le size0). + + smt(). + + smt(). + + smt(). + + elim H7=>// [[x h] [#]];rewrite -memE mem_fdom dom_restr /in_dom_with domE=> _ ->/=. by rewrite oget_some. apply H10=>//. qed. @@ -677,7 +696,7 @@ section EXT. lemma Real_G2 &m: Pr[GReal(D).main() @ &m: res /\ C.c <= max_size] <= Pr[Eager(G2(DRestr(D))).main2() @ &m: res] + - (max_size ^ 2)%r / 2%r * mu dstate (pred1 witness) + + (max_size ^ 2 - max_size)%r / 2%r * mu dstate (pred1 witness) + max_size%r * ((2*max_size)%r / (2^c)%r) + max_size%r * ((2*max_size)%r / (2^c)%r). proof. From 6f8a0cfa6778f508be3e51cb705e3e45936937c4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Tue, 18 Sep 2018 14:24:55 +0200 Subject: [PATCH 313/525] push Gconcl --- proof/smart_counter/Gconcl.ec | 74 +++++++++++++++++------------------ 1 file changed, 37 insertions(+), 37 deletions(-) diff --git a/proof/smart_counter/Gconcl.ec b/proof/smart_counter/Gconcl.ec index 0803dcb..a7167ff 100644 --- a/proof/smart_counter/Gconcl.ec +++ b/proof/smart_counter/Gconcl.ec @@ -1,6 +1,6 @@ pragma -oldip. require import Core Int Real RealExtra StdOrder Ring StdBigop IntExtra. -require import List FSet NewFMap Utils Common SLCommon RndO FelTactic Mu_mem. +require import List FSet SmtMap Common SLCommon PROM FelTactic Mu_mem. require import DProd Dexcepted. (*...*) import Capacity IntOrder Bigreal RealOrder BRA. @@ -16,17 +16,17 @@ module S(F : DFUNCTIONALITY) = { var paths : (capacity, block list * block) fmap proc init() = { - m <- map0; - mi <- map0; + m <- empty; + mi <- empty; (* the empty path is initially known by the adversary to lead to capacity 0^c *) - paths <- map0.[c0 <- ([<:block>],b0)]; + paths <- empty.[c0 <- ([<:block>],b0)]; } proc f(x : state): state = { var p, v, y, y1, y2; - if (!mem (dom m) x) { - if (mem (dom paths) x.`2) { + if (x \notin m) { + if (x.`2 \in paths) { (p,v) <- oget paths.[x.`2]; y1 <- F.f (rcons p (v +^ x.`1)); } else { @@ -36,7 +36,7 @@ module S(F : DFUNCTIONALITY) = { y <- (y1,y2); m.[x] <- y; mi.[y] <- x; - if (mem (dom paths) x.`2) { + if (x.`2 \in paths) { (p,v) <- oget paths.[x.`2]; paths.[y.`2] <- (rcons p (v +^ x.`1), y.`1); } @@ -49,7 +49,7 @@ module S(F : DFUNCTIONALITY) = { proc fi(x : state): state = { var y, y1, y2; - if (!mem (dom mi) x) { + if (x \notin mi) { y1 <$ bdistr; y2 <$ cdistr; y <- (y1,y2); @@ -78,11 +78,11 @@ local module G3(RO:F.RO) = { var h, i, counter <- 0; sa <- b0; while (i < size p ) { - if (mem (dom G1.mh) (sa +^ nth witness p i, h)) { + if ((sa +^ nth witness p i, h) \in G1.mh) { RO.sample(take (i+1) p); (sa, h) <- oget G1.mh.[(sa +^ nth witness p i, h)]; } else { - if (counter < size p - prefixe p (get_max_prefixe p (elems (dom C.queries)))) { + if (counter < size p - prefix p (get_max_prefix p (elems (fdom C.queries)))) { RRO.sample(G1.chandle); sa' <@ RO.get(take (i+1) p); sa <- sa +^ nth witness p i; @@ -107,8 +107,8 @@ local module G3(RO:F.RO) = { proc f(x : state): state = { var p, v, y, y1, y2, hy2, hx2, handles_,t; - if (!mem (dom G1.m) x) { - if (mem (dom G1.paths) x.`2) { + if (x \notin G1.m) { + if (x.`2 \in G1.paths) { (p,v) <- oget G1.paths.[x.`2]; y1 <- RO.get (rcons p (v +^ x.`1)); } else { @@ -117,14 +117,14 @@ local module G3(RO:F.RO) = { y2 <$ cdistr; y <- (y1, y2); handles_ <@ RRO.restrK(); - if (!mem (rng handles_) x.`2) { + if (!rng handles_ x.`2) { RRO.set(G1.chandle, x.`2); G1.chandle <- G1.chandle + 1; } handles_ <- RRO.restrK(); hx2 <- oget (hinvc handles_ x.`2); t <@ RRO.in_dom((oget G1.mh.[(x.`1,hx2)]).`2, Unknown); - if (mem (dom G1.mh) (x.`1, hx2) /\ t) { + if ((x.`1, hx2) \in G1.mh /\ t) { hy2 <- (oget G1.mh.[(x.`1, hx2)]).`2; FRO.m.[hy2] <- (y2,Known); G1.m.[x] <- y; @@ -138,7 +138,7 @@ local module G3(RO:F.RO) = { G1.mi.[y] <- x; G1.mhi.[(y.`1, hy2)] <- (x.`1, hx2); } - if (mem (dom G1.paths) x.`2) { + if (x.`2 \in G1.paths) { (p,v) <- oget G1.paths.[x.`2]; G1.paths.[y.`2] <- (rcons p (v +^ x.`1), y.`1); } @@ -151,9 +151,9 @@ local module G3(RO:F.RO) = { proc fi(x : state): state = { var y, y1, y2, hx2, hy2, handles_, t; - if (!mem (dom G1.mi) x) { + if (x \notin G1.mi) { handles_ <@ RRO.restrK(); - if (!mem (rng handles_) x.`2) { + if (!rng handles_ x.`2) { RRO.set(G1.chandle, x.`2); G1.chandle <- G1.chandle + 1; } @@ -163,7 +163,7 @@ local module G3(RO:F.RO) = { y1 <$ bdistr; y2 <$ cdistr; y <- (y1,y2); - if (mem (dom G1.mhi) (x.`1, hx2) /\ t) { + if ((x.`1, hx2) \in G1.mhi /\ t) { (y1,hy2) <- oget G1.mhi.[(x.`1, hx2)]; FRO.m.[hy2] <- (y2,Known); G1.mi.[x] <- y; @@ -189,15 +189,15 @@ local module G3(RO:F.RO) = { var b; RO.init(); - G1.m <- map0; - G1.mi <- map0; - G1.mh <- map0; - G1.mhi <- map0; + G1.m <- empty; + G1.mi <- empty; + G1.mh <- empty; + G1.mhi <- empty; (* the empty path is initially known by the adversary to lead to capacity 0^c *) RRO.init(); RRO.set(0,c0); - G1.paths <- map0.[c0 <- ([<:block>],b0)]; + G1.paths <- empty.[c0 <- ([<:block>],b0)]; G1.chandle <- 1; b <@ DRestr(D,M,S).distinguish(); return b; @@ -222,19 +222,19 @@ proof. + seq 2 2:(={y1,hx2,t,x,FRO.m,F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.chandle,G1.paths,C.c,C.queries} /\ (t = in_dom_with FRO.m (oget G1.mh.[(x.`1, hx2)]).`2 Unknown){1}). + by inline *;auto=> /> ? _;rewrite Block.DWord.bdistr_ll. - case ((mem (dom G1.mh) (x.`1, hx2) /\ t){1}); + case (((x.`1, hx2) \in G1.mh /\ t){1}); [rcondt{1} 3;2:rcondt{2} 3| rcondf{1} 3;2:rcondf{2} 3]; 1,2,4,5:(by move=>?;conseq (_:true);auto);2:by sim. inline *;rcondt{1} 6;1:by auto=>/>. wp;rnd;auto;progress[-split];rewrite DCapacity.dunifin_ll /= => ?_?->. - by rewrite !getP /= oget_some. - case ((mem (dom G1.mh) (x.`1, hx2) /\ t){1}); + by rewrite !get_setE /= oget_some. + case (((x.`1, hx2) \in G1.mh /\ t){1}); [rcondt{1} 4;2:rcondt{2} 4| rcondf{1} 4;2:rcondf{2} 4]; 1,2,4,5:(by move=>?;conseq (_:true);auto);2:by sim. inline *;rcondt{1} 7;1:by auto=>/>. wp;rnd;auto;rnd{1};auto;progress[-split]. rewrite Block.DBlock.supp_dunifin DCapacity.dunifin_ll /==> ?_?->. - by rewrite !getP /= oget_some. + by rewrite !get_setE /= oget_some. + proc;sp;if=>//;sim. call (_: ={FRO.m,F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.chandle,G1.paths,C.c,C.queries});2:by auto. @@ -243,12 +243,12 @@ proof. seq 6 6 : (={y1,hx2,t,x,FRO.m,F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.chandle,G1.paths,C.c,C.queries} /\ (t = in_dom_with FRO.m (oget G1.mhi.[(x.`1, hx2)]).`2 Unknown){1}). + by inline *;auto. - case ((mem (dom G1.mhi) (x.`1, hx2) /\ t){1}); + case (((x.`1, hx2) \in G1.mhi /\ t){1}); [rcondt{1} 3;2:rcondt{2} 3| rcondf{1} 3;2:rcondf{2} 3]; 1,2,4,5:(by move=>?;conseq (_:true);auto);2:by sim. inline *;rcondt{1} 6;1:by auto=>/>. wp;rnd;auto;progress[-split];rewrite DCapacity.dunifin_ll /= => ?_?->. - by rewrite !getP /= oget_some. + by rewrite !get_setE /= oget_some. proc;sp;if=>//;auto;if;1:auto;sim. call (_: ={FRO.m,F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.chandle,G1.paths,C.c,C.queries});2:by auto. @@ -277,8 +277,8 @@ local module G4(RO:F.RO) = { proc f(x : state): state = { var p, v, y, y1, y2; - if (!mem (dom G1.m) x) { - if (mem (dom G1.paths) x.`2) { + if (x \notin G1.m) { + if (x.`2 \in G1.paths) { (p,v) <- oget G1.paths.[x.`2]; y1 <- RO.get (rcons p (v +^ x.`1)); } else { @@ -288,7 +288,7 @@ local module G4(RO:F.RO) = { y <- (y1,y2); G1.m.[x] <- y; G1.mi.[y] <- x; - if (mem (dom G1.paths) x.`2) { + if (x.`2 \in G1.paths) { (p,v) <- oget G1.paths.[x.`2]; G1.paths.[y.`2] <- (rcons p (v +^ x.`1), y.`1); } @@ -301,7 +301,7 @@ local module G4(RO:F.RO) = { proc fi(x : state): state = { var y, y1, y2; - if (!mem (dom G1.mi) x) { + if (x \notin G1.mi) { y1 <$ bdistr; y2 <$ cdistr; y <- (y1,y2); @@ -319,10 +319,10 @@ local module G4(RO:F.RO) = { var b; RO.init(); - G1.m <- map0; - G1.mi <- map0; + G1.m <- empty; + G1.mi <- empty; (* the empty path is initially known by the adversary to lead to capacity 0^c *) - G1.paths <- map0.[c0 <- ([<:block>],b0)]; + G1.paths <- empty.[c0 <- ([<:block>],b0)]; b <@ DRestr(D,C,S).distinguish(); return b; } @@ -374,7 +374,7 @@ axiom D_ll : lemma Real_Ideal &m: Pr[GReal(D).main() @ &m: res /\ C.c <= max_size] <= Pr[IdealIndif(IF,S,DRestr(D)).main() @ &m :res] + - (max_size ^ 2)%r / 2%r * mu dstate (pred1 witness) + + (max_size ^ 2 - max_size)%r / 2%r * mu dstate (pred1 witness) + max_size%r * ((2*max_size)%r / (2^c)%r) + max_size%r * ((2*max_size)%r / (2^c)%r). proof. From fa219ce7f6cecf81b173aee9f6acb1e549bc93a8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Tue, 18 Sep 2018 16:50:50 +0200 Subject: [PATCH 314/525] push Gconcl_list --- proof/smart_counter/Gconcl_list.ec | 540 +++++++++++++++-------------- 1 file changed, 279 insertions(+), 261 deletions(-) diff --git a/proof/smart_counter/Gconcl_list.ec b/proof/smart_counter/Gconcl_list.ec index ca43009..844dcfd 100644 --- a/proof/smart_counter/Gconcl_list.ec +++ b/proof/smart_counter/Gconcl_list.ec @@ -1,6 +1,6 @@ pragma -oldip. require import Core Int Real RealExtra StdOrder Ring StdBigop IntExtra. -require import List FSet NewFMap Utils Common SLCommon RndO FelTactic Mu_mem. +require import List FSet SmtMap Common SLCommon PROM FelTactic Mu_mem. require import DProd Dexcepted BlockSponge Gconcl. (*...*) import Capacity IntOrder Bigreal RealOrder BRA. @@ -114,61 +114,64 @@ clone F as F2. section Ideal. op (<=) (m1 m2 : (block list, 'b) fmap) = - forall x, x <> [] => x \in dom m1 => m1.[x] = m2.[x]. + forall x, x <> [] => x \in m1 => m1.[x] = m2.[x]. local lemma leq_add_nin (m1 m2 : (block list, 'b) fmap) (x : block list) (y : 'b): m1 <= m2 => - ! x \in dom m2 => + ! x \in m2 => m1 <= m2.[x <- y]. proof. - move=>h_leq H_n_dom a H_a_dom;rewrite getP/=;smt(in_dom). + move=>h_leq H_n_dom a H_a_dom;rewrite get_setE/=;smt(domE). qed. local lemma leq_add_in (m1 m2 : (block list, 'b) fmap) (x : block list) : m1 <= m2 => - x \in dom m2 => + x \in m2 => m1.[x <- oget m2.[x]] <= m2. proof. - move=>h_leq H_n_dom a H_a_dom;rewrite getP/=;smt(in_dom getP). + move=>h_leq H_n_dom a H_a_dom;rewrite get_setE/=;smt(domE get_setE). qed. local lemma leq_nin_dom (m1 m2 : (block list, 'b) fmap) (x : block list) : m1 <= m2 => x <> [] => - ! x \in dom m2 => ! x \in dom m1 by smt(in_dom). + ! x \in m2 => ! x \in m1 by smt(domE). - local lemma prefixe_leq1 (l : block list) (m : (block list,block) fmap) i : + local lemma prefix_leq1 (l : block list) (m : (block list,block) fmap) i : 0 <= i => - format l (i+1) \in dom m => - size (format l (i+1)) <= prefixe (format l (i+1+1)) - (get_max_prefixe (format l (i+1+1)) (elems (dom m))) <= size (format l (i+1+1)). + format l (i+1) \in m => + size (format l (i+1)) <= prefix (format l (i+1+1)) + (get_max_prefix (format l (i+1+1)) (elems (fdom m))) <= size (format l (i+1+1)). proof. - rewrite memE;move=>hi0 H_dom. + rewrite -mem_fdom memE;move=>hi0 H_dom. cut->:(format l (i + 1 + 1)) = format l (i + 1) ++ [b0]. - + by rewrite/format/=-2!(addzA _ 1 (-1))//=nseqSr//-cats1 catA. - cut:=prefixe_leq_prefixe_cat_size (format l (i + 1))[b0](elems (dom m)). - rewrite (prefixe_get_max_prefixe_eq_size _ _ H_dom)//=. + + by rewrite/format//=nseqSr//-cats1 catA. + cut:=prefix_leq_prefix_cat_size (format l (i + 1))[b0](elems (fdom m)). + rewrite (prefix_get_max_prefix_eq_size _ _ H_dom)//=. rewrite (size_cat _ [b0])/=;pose x:= format _ _. - cut:=get_max_prefixe_max (x ++ [b0]) _ _ H_dom. - cut->:prefixe (x ++ [b0]) (format l (i + 1)) = size x - by rewrite prefixeC-{1}(cats0 (format l (i+1)))/x prefixe_cat//=. - smt(prefixe_sizel size_cat prefixe_ge0 ). + cut:=get_max_prefix_max (x ++ [b0]) _ _ H_dom. + cut->:prefix (x ++ [b0]) (format l (i + 1)) = size x + by rewrite prefixC-{1}(cats0 (format l (i+1)))/x prefix_cat//=. + smt(prefix_sizel size_cat prefix_ge0 ). qed. - local lemma prefixe_le1 (l : block list) (m : (block list,block) fmap) i : + local lemma prefix_le1 (l : block list) (m : (block list,block) fmap) i : 0 <= i => - format l (i+1) \in dom m => - size (format l (i+1+1)) - prefixe (format l (i+1+1)) - (get_max_prefixe (format l (i+1+1)) (elems (dom m))) <= 1. + format l (i+1) \in m => + size (format l (i+1+1)) - prefix (format l (i+1+1)) + (get_max_prefix (format l (i+1+1)) (elems (fdom m))) <= 1. proof. - smt(prefixe_leq1 size_ge0 size_cat size_nseq). + move=> Hi0 H_liS_in_m. + have:= prefix_leq1 _ _ _ Hi0 H_liS_in_m. + rewrite /format /= nseqSr //-cats1 catA (size_cat(l ++ nseq i b0) [b0]) /=. + smt(size_ge0). qed. local lemma leq_add2 (m1 m2 : (block list, 'b) fmap) (x : block list) (y : 'b) : m1 <= m2 => - ! x \in dom m2 => - m1.[x <- y] <= m2.[x <- y] by smt(in_dom getP dom_set in_fsetU1). + ! x \in m2 => + m1.[x <- y] <= m2.[x <- y] by smt(domE get_setE mem_set in_fsetU1). local equiv ideal_equiv (D <: DISTINGUISHER{SLCommon.C, C, IF, S}) : @@ -182,7 +185,7 @@ section Ideal. call(: ={glob IF, glob S, glob A} /\ SLCommon.C.c{1} <= C.c{1} /\ SLCommon.C.queries{1} <= F.RO.m{2});auto;last first. + progress. - by move=>x;rewrite getP/=dom_set in_fsetU1 dom0 in_fset0//==>->. + by move=>x;rewrite get_setE/=mem_set-mem_fdom fdom0 in_fset0//==>->. + proc;inline*;sp;if;auto;sp;rcondt{1}1;1:auto=>/#;sp;if=>//=;2:auto=>/#. wp 7 6;conseq(:_==> ={y} /\ ={F.RO.m} /\ ={S.paths, S.mi, S.m} /\ SLCommon.C.queries{1} <= F.RO.m{2});1:smt(). @@ -193,7 +196,7 @@ section Ideal. + sp;rcondf{1}3;2:rcondf{2}4;1,2:auto. - by if;auto;if;auto. by if{1};2:auto;1:if{1};auto; - smt(prefixe_ge0 leq_add_in DBlock.dunifin_ll in_dom size_ge0 getP leq_add2). + smt(prefix_ge0 leq_add_in DBlock.dunifin_ll domE size_ge0 get_setE leq_add2). splitwhile{1}5: i + 1 < n;splitwhile{2}5: i + 1 < n. rcondt{1}6;2:rcondt{2}6;auto. * by while(i < n);auto;sp;if;auto;sp;if;auto;if;auto. @@ -220,29 +223,37 @@ section Ideal. /\ SLCommon.C.c{1} <= C.c{1} + size bl{1} + i{1} /\ SLCommon.C.queries{1} <= F.RO.m{2});progress. sp;rcondt{1}1;2:rcondt{2}1;1,2:auto;sp. - case((x0 \in dom F.RO.m){2});last first. + case((x0 \in F.RO.m){2});last first. * rcondt{2}2;1:auto;rcondt{1}1;1:(auto;smt(leq_nin_dom size_cat size_eq0 size_nseq valid_spec)). - rcondt{1}1;1:auto;1:smt(prefixe_le1 in_dom size_cat size_nseq). + rcondt{1}1;1:auto. + - move=> /> &hr i [#] h1 h2 h3 h4 h5 h6 h7 h8 h9 h10. + have//= /#:= prefix_le1 bl{m} SLCommon.C.queries{hr} i h1 _. + by rewrite domE h3. sp;rcondt{1}2;auto;progress. - smt(). - smt(). - - by rewrite!getP/=. - - smt(prefixe_le1 in_dom). - - by rewrite!getP/=oget_some leq_add2//=. + - by rewrite!get_setE/=. + - have//= /#:= prefix_le1 bl{2} SLCommon.C.queries{1} i_R H _. + by rewrite domE H1. + - by rewrite!get_setE/=oget_some leq_add2//=. if{1}. - * rcondt{1}1;1:auto;1:smt(prefixe_le1 in_dom size_cat size_nseq). + * rcondt{1}1;1:auto. + - move=> /> &hr i [#] h1 h2 h3 h4 h5 h6 h7 h8 h9 h10. + have//= /#:= prefix_le1 bl{m} SLCommon.C.queries{hr} i h1 _. + by rewrite domE h3. sp;rcondf{1}2;2:rcondf{2}2;auto;progress. - smt(). - smt(). - - by rewrite!getP/=. - - smt(prefixe_ge0 prefixe_le1 in_dom). - - smt(leq_add_in in_dom). + - by rewrite!get_setE/=. + - have//= /#:= prefix_le1 bl{2} SLCommon.C.queries{1} i_R H _. + by rewrite domE H1. + - smt(leq_add_in domE). rcondf{2}2;auto;progress. - smt(DBlock.dunifin_ll). - smt(). - smt(). - - smt(). - - smt(set_eq in_dom). + - smt(). search "_.[_<-_]". + - by move: H11; rewrite domE; case: (SLCommon.C.queries{1}.[format bl{2} (i_R + 2)]). - smt(). sp;conseq(:_==> ={F.RO.m,b} /\ SLCommon.C.queries.[p]{1} = Some b{1} @@ -252,27 +263,27 @@ section Ideal. - smt(nseq0 cats0). - smt(size_ge0). - smt(). - case(p{2} \in dom F.RO.m{2}). + case(p{2} \in F.RO.m{2}). + rcondf{2}2;1:auto. sp;if{1}. - - rcondt{1}1;1:auto;1:smt(prefixe_ge0). + - rcondt{1}1;1:auto;1:smt(prefix_ge0). sp;rcondf{1}2;auto;progress. - * by rewrite!getP/=. - * smt(prefixe_ge0). - * smt(leq_add_in in_dom). + * by rewrite!get_setE/=. + * smt(prefix_ge0). + * smt(leq_add_in domE). auto;progress. - exact DBlock.dunifin_ll. - - smt(in_dom). - - smt(in_dom get_oget). + - smt(domE). + - smt(domE). - smt(size_ge0). - rcondt{1}1;1:auto;1:smt(leq_nin_dom in_dom). - rcondt{1}1;1:auto;1:smt(prefixe_ge0). + rcondt{1}1;1:auto;1:smt(leq_nin_dom domE). + rcondt{1}1;1:auto;1:smt(prefix_ge0). sp;auto;progress. - + by rewrite!getP/=. - + smt(prefixe_ge0). - + rewrite getP/=oget_some leq_add2//=. - + by rewrite!getP/=. - + smt(prefixe_ge0). + + by rewrite!get_setE/=. + + smt(prefix_ge0). + + rewrite get_setE/=oget_some leq_add2//=. + + by rewrite!get_setE/=. + + smt(prefix_ge0). + exact leq_add_in. qed. @@ -369,11 +380,12 @@ section Ideal. by auto;smt(parse_valid parseK formatK). qed. + require import JointFMap. inductive inv_L_L3 (m1 m2 m3 : (block list, block) fmap) = | INV of (m1 = m2 + m3) - & (forall l, l \in dom m2 => valid (parse l).`1) - & (forall l, l \in dom m3 => ! valid (parse l).`1). + & (forall l, l \in m2 => valid (parse l).`1) + & (forall l, l \in m3 => ! valid (parse l).`1). local module IF2(F : F.RO) (F2 : F2.RO) = { proc init () = { @@ -411,51 +423,50 @@ section Ideal. inv_L_L3 m1 m2 m3 => valid p => 0 < i => - ! format p i \in dom m1 => - ! format p i \in dom m2 => + ! format p i \in m1 => + ! format p i \in m2 => inv_L_L3 m1.[format p i <- r] m2.[format p i <- r] m3. proof. move=>INV0 p_valid i_gt0 nin_dom1 nin_dom2;split;cut[]add_maps valid_dom nvalid_dom:=INV0. - + rewrite add_maps fmapP=>x. - by rewrite getP !joinP getP;smt(parseK formatK). - + smt(dom_set in_fsetU1 parseK formatK). - + smt(dom_set in_fsetU1 parseK formatK). + + rewrite add_maps -fmap_eqP=>x. + by rewrite get_setE !joinE get_setE;smt(parseK formatK). + + smt(mem_set parseK formatK). + + smt(mem_set parseK formatK). qed. local lemma lemma2 m1 m2 m3 p i: inv_L_L3 m1 m2 m3 => valid p => 0 < i => - format p i \in dom m1 => - format p i \in dom m2. + format p i \in m1 => + format p i \in m2. proof. - move=>INV0 p_valid i_gt0 in_dom1;cut[]add_maps valid_dom nvalid_dom:=INV0. - cut:=in_dom1;rewrite add_maps dom_join in_fsetU=>[][]//=in_dom3. - by cut:=nvalid_dom _ in_dom3;rewrite parseK//=. + move=>INV0 p_valid i_gt0 domE1;cut[]add_maps valid_dom nvalid_dom:=INV0. + by have:= domE1; rewrite add_maps mem_join;smt(parseK formatK). qed. local lemma incl_dom m1 m2 m3 l : inv_L_L3 m1 m2 m3 => - l \in dom m1 <=> (l \in dom m2 \/ l \in dom m3). + l \in m1 <=> (l \in m2 \/ l \in m3). proof. move=>INV0;cut[]add_maps valid_dom nvalid_dom:=INV0. - by rewrite add_maps dom_join in_fsetU. + by rewrite add_maps mem_join. qed. local lemma lemma3 m1 m2 m3 x r: inv_L_L3 m1 m2 m3 => ! valid (parse x).`1 => - ! x \in dom m1 => + ! x \in m1 => inv_L_L3 m1.[x <- r] m2 m3.[x <- r]. proof. move=>INV0 not_valid nin_dom1;cut[]add_maps h1 h2:=INV0. - cut nin_dom3: ! x \in dom m3 by smt(incl_dom). + cut nin_dom3: ! x \in m3 by smt(incl_dom). split. - + by rewrite fmapP=>y;rewrite add_maps !getP!joinP!getP dom_set in_fsetU1/#. + + by apply/fmap_eqP=>y;rewrite add_maps !get_setE!joinE!get_setE mem_set/#. + exact h1. - smt(dom_set in_fsetU1). + smt(mem_set). qed. @@ -475,7 +486,7 @@ section Ideal. rcondf{1}3;1:auto;1:smt(parse_valid parseK formatK);sp. rcondf{2}3;1:auto;1:smt(parse_valid parseK formatK);sp. rcondf{1}5;2:rcondf{2}5; - 1,2:by auto;smt(dom_set in_fsetU1 nseq0 cats0 parse_valid). + 1,2:by auto;smt(mem_set nseq0 cats0 parse_valid). case(0 < n{1});auto;last first. - rcondf{1}7;1:auto;rcondf{2}7;1:auto. by wp;rnd;auto;progress;smt(lemma1 nseq0 cats0 lemma2 incl_dom @@ -487,38 +498,38 @@ section Ideal. conseq(:_==> ={b} /\ inv_L_L3 F.RO.m{1} F.RO.m{2} F2.RO.m{2});1:progress=>/#. auto=>/=. conseq(:_==> inv_L_L3 F.RO.m{1} F.RO.m{2} F2.RO.m{2});progress. - * by rewrite!getP//=. + * by rewrite!get_setE//=. * smt(lemma1 parse_valid). * smt(lemma2 parse_valid). * smt(lemma2 parse_valid). * smt(incl_dom). * smt(incl_dom). - * case:H8;smt(joinP). + * case:H8;smt(joinE). while(={i1,n1,p1} /\ valid p1{1} /\ 0 <= i1{1} <= n1{1} /\ inv_L_L3 F.RO.m{1} F.RO.m{2} F2.RO.m{2}). * sp;conseq(:_==> inv_L_L3 F.RO.m{1} F.RO.m{2} F2.RO.m{2});1:smt(). - case(x6{1} \in dom F.RO.m{1}). + case(x6{1} \in F.RO.m{1}). + by rcondf{1}2;2:rcondf{2}2;auto;smt(incl_dom lemma2). by rcondt{1}2;2:rcondt{2}2;auto;smt(lemma2 incl_dom lemma1). by auto;smt(parseK). wp;rnd;wp 2 2. conseq(:_==> F.RO.m{1}.[p{1}] = F.RO.m{2}.[p{2}] /\ inv_L_L3 F.RO.m{1} F.RO.m{2} F2.RO.m{2});progress. - + cut[]add_maps h1 h2:=H5;rewrite add_maps joinP//=;smt(parse_valid). + + cut[]add_maps h1 h2:=H5;rewrite add_maps joinE//=;smt(parse_valid). + smt(). - case(x5{1} \in dom F.RO.m{1}). + case(x5{1} \in F.RO.m{1}). - rcondf{1}2;2:rcondf{2}2;auto;progress. * smt(lemma2 incl_dom parse_valid). - by cut[]add_maps h1 h2:=H1;rewrite add_maps joinP//=;smt(parse_valid). + by cut[]add_maps h1 h2:=H1;rewrite add_maps joinE//=;smt(parse_valid). rcondt{1}2;2:rcondt{2}2;auto;progress. - smt(lemma2 incl_dom parse_valid). - - cut[]add_maps h1 h2:=H1;rewrite add_maps !getP joinP//=;smt(parse_valid nseq0 cats0). + - cut[]add_maps h1 h2:=H1;rewrite add_maps !get_setE joinE//=;smt(parse_valid nseq0 cats0). - cut:=H;rewrite -H0=>//=[][]->>->>;apply lemma1=>//=;1:smt(parse_valid). cut[]add_maps h1 h2:=H1;smt(parse_valid formatK parseK incl_dom). + progress;split. - - by rewrite fmapP=>x;rewrite joinP map0P//=. - - smt(dom0 in_fset0). - - smt(dom0 in_fset0). + - by apply/fmap_eqP=>x;rewrite joinE mem_empty. + - smt(mem_empty). + - smt(mem_empty). proc;sp;if;auto;call(: ={glob S} /\ inv_L_L3 F.RO.m{1} F.RO.m{2} F2.RO.m{2});auto. if;1,3:auto. seq 1 1 : (={x, y1, S.paths, S.mi, S.m} /\ inv_L_L3 F.RO.m{1} F.RO.m{2} F2.RO.m{2});last first. @@ -528,37 +539,37 @@ section Ideal. if{2}. + seq 1 1 : (={x,p,n} /\ parse x{1} = (p,n){1} /\ valid p{1} /\ inv_L_L3 F.RO.m{1} F.RO.m{2} F2.RO.m{2});last first. - - sp;case(x1{1} \in dom F.RO.m{1}). + - sp;case(x1{1} \in F.RO.m{1}). * rcondf{1}2;2:rcondf{2}2;auto;progress. + cut:=H2;rewrite -formatK H/=;smt(lemma2 incl_dom parse_gt0). - cut[]add_maps h1 h2:=H1;rewrite add_maps joinP. + cut[]add_maps h1 h2:=H1;rewrite add_maps joinE. cut:=H2;rewrite -formatK H/==>in_dom1. - case(format p{2} n{2} \in dom F2.RO.m{2})=>//=in_dom3. + case(format p{2} n{2} \in F2.RO.m{2})=>//=in_dom3. by cut:=h2 _ in_dom3;rewrite parseK//=;smt(parse_gt0). rcondt{1}2;2:rcondt{2}2;auto;progress. + smt(incl_dom lemma2). - + cut[]:=H1;smt(getP joinP). + + cut[]:=H1;smt(get_setE joinE). by cut:=H2;rewrite-formatK H/==>nin_dom1;rewrite lemma1//=;smt(parse_gt0 lemma2 incl_dom). conseq(:_==> inv_L_L3 F.RO.m{1} F.RO.m{2} F2.RO.m{2});1:smt(). while(={i,n,p} /\ 0 <= i{1} /\ valid p{1} /\ inv_L_L3 F.RO.m{1} F.RO.m{2} F2.RO.m{2}). - + sp;case(x2{1} \in dom F.RO.m{1}). + + sp;case(x2{1} \in F.RO.m{1}). - by rcondf{1}2;2:rcondf{2}2;auto;smt(lemma2). by rcondt{1}2;2:rcondt{2}2;auto;progress;smt(incl_dom lemma1). auto;smt(). seq 1 1 : (={x,p,n} /\ parse x{1} = (p,n){1} /\ ! valid p{1} /\ inv_L_L3 F.RO.m{1} F.RO.m{2} F2.RO.m{2});last first. - + sp;case(x1{1} \in dom F.RO.m{1}). + + sp;case(x1{1} \in F.RO.m{1}). - rcondf{1}2;2:rcondf{2}2;auto;progress. * cut[]:=H1;smt(incl_dom). - cut[]:=H1;smt(joinP incl_dom). + cut[]:=H1;smt(joinE incl_dom). rcondt{1}2;2:rcondt{2}2;auto;progress. * cut[]:=H1;smt(incl_dom). - * cut[]:=H1;smt(joinP incl_dom getP). + * cut[]:=H1;smt(joinE incl_dom get_setE). by rewrite(lemma3 _ _ _ _ rL H1 _ H2)H//=. conseq(:_==> inv_L_L3 F.RO.m{1} F.RO.m{2} F2.RO.m{2});1:smt(). while(={i,n,p,x} /\ 0 <= i{1} /\ ! valid p{1} /\ parse x{1} = (p,n){1} /\ inv_L_L3 F.RO.m{1} F.RO.m{2} F2.RO.m{2}). - + sp;case(x2{1} \in dom F.RO.m{1}). + + sp;case(x2{1} \in F.RO.m{1}). - rcondf{1}2;2:rcondf{2}2;auto;progress. * cut[]:=H2;smt(incl_dom lemma2 formatK parse_not_valid). smt(). @@ -654,7 +665,7 @@ section Ideal. if{2};sp. - rcondf{2}3; 1:(auto; smt(parse_valid parse_gt0)); sp. rcondf{1}8; 1:(auto; smt(parse_valid parse_gt0)); sp. - rcondf{1}5; 1:(auto; smt(parse_valid parse_gt0 dom_set in_fsetU1 nseq0 cats0)); sp. + rcondf{1}5; 1:(auto; smt(parse_valid parse_gt0 mem_set nseq0 cats0)); sp. wp 4 2;rnd{1};wp 2 2. by conseq(:_==> ={F.RO.m} /\ r3{1} = r2{2} /\ x9{1} = x4{2});2:sim; smt(DBlock.dunifin_ll nseq0 cats0 parse_valid);progress. @@ -669,13 +680,13 @@ section Ideal. wp. while((n,p){1} = (n0,p0){2} /\ i{1} + 1 = i{2} /\ valid p{1} /\ 0 < n{1} /\ 0 <= i{2} <= n{1} - /\ (forall j, 1 <= j <= i{2} => format p{1} j \in dom F.RO.m{1}) + /\ (forall j, 1 <= j <= i{2} => format p{1} j \in F.RO.m{1}) /\ rcons lres{1} b{1} = lres{2} /\ ={F.RO.m, F2.RO.m});last first. - - rcondf{1}5;1:auto;1:smt(dom_set in_fsetU1 nseq0 cats0 parse_valid). + - rcondf{1}5;1:auto;1:smt(mem_set nseq0 cats0 parse_valid). wp 4 2;rnd{1};wp 2 2. - conseq(:_==> ={F.RO.m} /\ r3{1} = r0{2} /\ x9{1} \in dom F.RO.m{1}); + conseq(:_==> ={F.RO.m} /\ r3{1} = r0{2} /\ x9{1} \in F.RO.m{1}); 1:smt(DBlock.dunifin_ll nseq0 cats0 parse_valid). - by auto;smt(parse_valid nseq0 cats0 dom_set in_fsetU1). + by auto;smt(parse_valid nseq0 cats0 mem_set). sp. rcondt{1}1;1:auto;sp. rcondt{1}1;1:(auto;smt(parse_valid parseK formatK)). @@ -686,23 +697,23 @@ section Ideal. rcondf{1}7;1:auto. - by while(i1 < n1);auto;smt(parse_gt0 parse_valid parseK formatK). rcondf{1}9;1:auto. - - conseq(:_==> i1 + 1 = n1);1:smt(dom_set in_fsetU1 parseK parse_valid formatK). + - conseq(:_==> i1 + 1 = n1);1:smt(mem_set parseK parse_valid formatK). by while(i1 + 1 <= n1);auto;smt(parse_gt0 parse_valid parseK formatK). wp 8 2;rnd{1};wp 6 2. conseq(:_==> n1{1} = i{2} /\ ={F.RO.m} /\ i1{1} = n1{1} /\ (forall (j : int), 1 <= j <= i{2} => - format p1{1} j \in dom F.RO.m{1})); + format p1{1} j \in F.RO.m{1})); 1:smt(parseK formatK parse_valid DBlock.dunifin_ll). seq 2 0 : (={F.RO.m,x0} /\ i1{1} = n1{1} /\ x0{2} = format p{1} i{2} /\ n1{1} = i{1} + 1 /\ p1{1} = p{1} /\ i{2} = i{1} + 1 /\ forall (j : int), - 1 <= j <= i{1} => format p{1} j \in dom F.RO.m{1});last first. - - auto;smt(dom_set in_fsetU1). + 1 <= j <= i{1} => format p{1} j \in F.RO.m{1});last first. + - auto;smt(mem_set). wp;conseq(:_==> ={F.RO.m} /\ i1{1} + 1 = n1{1} /\ (forall (j : int), 1 <= j < n1{1} => - format p1{1} j \in dom F.RO.m{1}));1:smt(parseK). + format p1{1} j \in F.RO.m{1}));1:smt(parseK). while{1}(={F.RO.m} /\ 0 <= i1{1} /\ i1{1} + 1 <= n1{1} /\ i{2} = n1{1} /\ i{2} = i{1} + 1 /\ (forall (j : int), 1 <= j < n1{1} => - format p1{1} j \in dom F.RO.m{1}))(n1{1}-i1{1}-1);progress. + format p1{1} j \in F.RO.m{1}))(n1{1}-i1{1}-1);progress. + by sp;rcondf 2;auto;smt(DBlock.dunifin_ll). by auto;smt(parse_gt0 parseK formatK parse_valid). proc; sp; if; auto; call(: ={glob S, glob F.RO, glob F2.RO}); auto. @@ -723,7 +734,7 @@ section Ideal. - by while(i ={F.RO.m} /\ p{2} = x0{2});progress. + smt(DBlock.dunifin_ll). smt(last_rcons formatK parseK). @@ -745,7 +756,7 @@ section Ideal. - by while(i ={F2.RO.m} /\ format pp{2} n{2} = x3{2});1:smt(DBlock.dunifin_ll last_rcons formatK parseK). seq 3 3 : (={F2.RO.m,i} /\ x2{1} = x3{2} /\ pp{2} = p{1} /\ format pp{2} n{2} = x3{2}); @@ -757,39 +768,39 @@ section Ideal. op inv_map (m1 : (block list, block) fmap) (m2 : (block list * int, block) fmap) = - (forall p n x, parse x = (p,n+1) => (p,n) \in dom m2 <=> x \in dom m1) - /\ (forall p n x, parse x = (p,n+1) => x \in dom m1 <=> (p,n) \in dom m2) + (forall p n x, parse x = (p,n+1) => (p,n) \in m2 <=> x \in m1) + /\ (forall p n x, parse x = (p,n+1) => x \in m1 <=> (p,n) \in m2) /\ (forall p n x, parse x = (p,n+1) => m2.[(p,n)] = m1.[x]) /\ (forall p n x, parse x = (p,n+1) => m1.[x] = m2.[(p,n)]). inductive INV_L4_ideal m1 m2 m3 m4 = | inv_maps of (inv_map m1 m2) & (inv_map m3 m4) - & (forall p n, (p,n) \in dom m2 => valid p /\ 0 <= n) - & (forall p n, (p,n) \in dom m4 => ! valid p /\ 0 <= n). + & (forall p n, (p,n) \in m2 => valid p /\ 0 <= n) + & (forall p n, (p,n) \in m4 => ! valid p /\ 0 <= n). local lemma lemma5 m1 m2 m3 m4 p i r : INV_L4_ideal m1 m2 m3 m4 => - ! (p,i) \in dom m2 => + ! (p,i) \in m2 => 0 <= i => valid p => INV_L4_ideal m1.[format p (i+1) <- r] m2.[(p,i) <- r] m3 m4. proof. move=>INV0 nin_dom1 i_gt0 valid_p;cut[]inv12 inv34 dom2 dom4:=INV0;cut[]h1[]h2[]h3 h4:=inv12;split=>//=. + progress. - - move:H0;rewrite 2!dom_set 2!in_fsetU1=>[][/#|]/=[]->>->>;smt(parseK formatK). - - move:H0;rewrite 2!dom_set 2!in_fsetU1=>[][/#|]/=->>;smt(parseK formatK). - - move:H0;rewrite 2!dom_set 2!in_fsetU1=>[][/#|]/=->>;smt(parseK formatK). - - move:H0;rewrite 2!dom_set 2!in_fsetU1=>[][/#|]/=;smt(parseK formatK). - - smt(getP parseK formatK). - smt(getP parseK formatK). - smt(getP parseK formatK dom_set in_fsetU1). + - move:H0;rewrite 2!mem_set=>[][/#|]/=[]->>->>;smt(parseK formatK). + - move:H0;rewrite 2!mem_set=>[][/#|]/=;smt(parseK formatK). + - move:H0;rewrite 2!mem_set=>[][/#|]/=;smt(parseK formatK). + - move:H0;rewrite 2!mem_set=>[][/#|]/=;smt(parseK formatK). + - smt(get_setE parseK formatK). + smt(get_setE parseK formatK). + smt(get_setE parseK formatK mem_set). qed. local lemma lemma5bis m1 m2 m3 m4 p i r : INV_L4_ideal m1 m2 m3 m4 => - ! (p,i) \in dom m4 => + ! (p,i) \in m4 => 0 <= i => ! valid p => parse (format p (i+1)) = (p,i+1) => @@ -800,13 +811,13 @@ section Ideal. cut[]h1[]h2[]h3 h4:=inv34; split=>//=. + progress. - - move:H0;rewrite 2!dom_set 2!in_fsetU1=>[][/#|]/=[]->>->>;smt(parseK formatK). - - move:H0;rewrite 2!dom_set 2!in_fsetU1=>[][/#|]/=->>;smt(parseK formatK). - - move:H0;rewrite 2!dom_set 2!in_fsetU1=>[][/#|]/=->>;smt(parseK formatK). - - move:H0;rewrite 2!dom_set 2!in_fsetU1=>[][/#|]/=;smt(parseK formatK). - - smt(getP parseK formatK). - smt(getP parseK formatK). - smt(getP parseK formatK dom_set in_fsetU1). + - move:H0;rewrite 2!mem_set=>[][/#|]/=[]->>->>;smt(parseK formatK). + - move:H0;rewrite 2!mem_set=>[][/#|]/=;smt(parseK formatK). + - move:H0;rewrite 2!mem_set=>[][/#|]/=;smt(parseK formatK). + - move:H0;rewrite 2!mem_set=>[][/#|]/=;smt(parseK formatK). + - smt(get_setE parseK formatK). + smt(get_setE parseK formatK). + smt(get_setE parseK formatK mem_set). qed. @@ -821,7 +832,7 @@ section Ideal. proc; inline*; auto; sp. call(: ={glob S, glob C} /\ INV_L4_ideal F.RO.m{1} BIRO.IRO.mp{2} F2.RO.m{1} BIRO2.IRO.mp{2}); - auto; -1:(progress;split;smt(dom0 in_fset0 map0P)). + auto; -1:(progress;split;smt(mem_empty in_fset0 emptyE)). + proc;sp;if;auto;call(: ={glob S} /\ INV_L4_ideal F.RO.m{1} BIRO.IRO.mp{2} F2.RO.m{1} BIRO2.IRO.mp{2}); auto. if;1,3:auto. seq 1 1 : (={y1, x, glob S} @@ -835,7 +846,7 @@ section Ideal. * sp;if{2}. + rcondt{1}2;auto;progress. - cut[]h1 _ _ _:=H1;cut[]h'1 _:=h1;smt(parseK). - - smt(getP). + - smt(get_setE). - smt(). - exact lemma5. rcondf{1}2;auto;progress. @@ -854,7 +865,7 @@ section Ideal. - cut[]_ h1 _ _:=H2;cut[]:=h1;progress. cut:=H7 x0{m} i0{m} (format x0{m} (i0{m} + 1));rewrite H5/==>->//=. cut->/#:=parse_twice _ _ _ H. - - smt(getP). + - smt(get_setE). - smt(). - apply lemma5bis=>//=. rewrite(parse_twice _ _ _ H)/#. @@ -877,7 +888,7 @@ section Ideal. sp;if{2}. + rcondt{1}2;auto;progress. - cut[]h1 _ _ _:=H1;cut[]h'1 _:=h1;smt(parseK). - - smt(getP). + - smt(get_setE). - smt(). - exact lemma5. rcondf{1}2;auto;progress. @@ -943,7 +954,7 @@ section Real. inductive m_p (m : (state, state) fmap) (p : (block list, state) fmap) = | IND_M_P of (p.[[]] = Some (b0, c0)) - & (forall l, l \in dom p => forall i, 0 <= i < size l => + & (forall l, l \in p => forall i, 0 <= i < size l => exists b c, p.[take i l] = Some (b,c) /\ m.[(b +^ nth witness l i, c)] = p.[take (i+1) l]). @@ -962,14 +973,14 @@ section Real. local lemma INV_Real_addm_mi c1 c2 m mi p x y : INV_Real c1 c2 m mi p => - ! x \in dom m => - ! y \in rng m => + ! x \in m => + ! rng m y => INV_Real c1 c2 m.[x <- y] mi.[y <- x] p. proof. case=> H_c1c2 H_m_p H_invm H_x_dom H_y_rng;split=>//=. + split;case:H_m_p=>//=; - smt(getP in_dom oget_some take_oversize size_take take_take). - exact invm_set. + smt(get_setE domE oget_some take_oversize size_take take_take). + exact/invm_set. qed. local lemma invmC' (m mi : (state, state) fmap) : @@ -982,31 +993,33 @@ section Real. local lemma invm_dom_rng (m mi : (state, state) fmap) : invm m mi => dom m = rng mi. - proof. by move=>h;rewrite fsetP=>x;split;rewrite in_dom in_rng/#. qed. + proof. + by move=>h; rewrite fun_ext=> x; rewrite domE rngE /=; have := h x; smt(). + qed. local lemma all_prefixes_of_INV_real c1 c2 m mi p: INV_Real c1 c2 m mi p => all_prefixes p. proof. move=>[]_[]Hp0 Hmp1 _ l H_dom i. - smt(take_le0 take_oversize size_take take_take take_size nth_take in_dom). + smt(take_le0 take_oversize size_take take_take take_size nth_take domE). qed. local lemma lemma2' c1 c2 m mi p bl i sa sc: INV_Real c1 c2 m mi p => 1 < i => valid bl => - (sa,sc) \in dom m => - ! (format bl i) \in dom p => + (sa,sc) \in m => + ! (format bl i) \in p => p.[format bl (i-1)] = Some (sa,sc) => INV_Real c1 c2 m mi p.[format bl i <- oget m.[(sa,sc)]]. proof. move=>inv0 h1i h_valid H_dom_m H_dom_p H_p_val. split;cut[]//=_[] hmp0 hmp1 hinvm:=inv0;split=>//=. - + by rewrite getP;smt(size_cat size_nseq size_ge0). - + move=>l;rewrite dom_set in_fsetU1;case;1:smt(all_prefixes_of_INV_real getP). - move=>->>j[]hj0 hjsize;rewrite getP/=. - cut:=hmp1 (format bl (i - 1));rewrite in_dom H_p_val/==>help. + + by rewrite get_setE;smt(size_cat size_nseq size_ge0). + + move=>l;rewrite mem_set;case;1:smt(all_prefixes_of_INV_real get_setE). + move=>->>j[]hj0 hjsize;rewrite get_setE/=. + cut:=hmp1 (format bl (i - 1));rewrite domE H_p_val/==>help. cut:=hjsize;rewrite !size_cat !size_nseq/=!max_ler 1:/#=>hjsizei. cut->/=:!take j (format bl i) = format bl i by smt(size_take). cut h:forall k, 0 <= k <= size bl + i - 2 => @@ -1021,16 +1034,16 @@ section Real. move=>[]b c[]. cut->:nth witness (format bl (i - 1)) j = nth witness (format bl i) j. + by rewrite-(nth_take witness (j+1)) 1,2:/# eq_sym -(nth_take witness (j+1)) 1,2:/# !h//=/#. - rewrite h 1:/# h 1:/# => -> h';exists b c=>//=;rewrite h'/=getP/=. + rewrite h 1:/# h 1:/# => -> h';exists b c=>//=;rewrite h'/=get_setE/=. smt(size_take size_cat size_nseq). cut->>/=:j = size (format bl (i-1)) by smt(size_cat size_nseq). - rewrite getP/=. + rewrite get_setE/=. cut h':size (format bl (i-1)) = size bl + i - 2 by smt(size_cat size_nseq). - rewrite h'/=-(addzA _ _ 1)/=. + rewrite h'/=. cut h'':(size bl + i - 1) = size (format bl i) by smt(size_cat size_nseq). rewrite h'' take_size/=-h 1:/# -h' take_size. rewrite nth_cat h';cut->/=:! size bl + i - 2 < size bl by smt(). - by rewrite nth_nseq 1:/#;smt(Block.WRing.AddMonoid.addm0 in_dom get_oget). + by rewrite nth_nseq 1:/#; exists sa sc; smt(Block.WRing.AddMonoid.addm0 domE). qed. local lemma take_nseq (a : 'a) i j : @@ -1068,7 +1081,7 @@ section Real. INV_Real SLCommon.C.c{1} C.c{2} Perm.m{1} Perm.mi{1} Redo.prefixes{1});auto;last first. + progress. + exact max_ge0. - + by split=>//=;1:split;smt(dom0 in_fset0 dom_set in_fsetU1 getP map0P). + + by split=>//=;1:split;smt(mem_empty in_fset0 mem_set get_setE). by case:H2=>//=. + by proc;inline*;auto;sp;if;auto;sp;if;auto; smt(INV_Real_addm_mi INV_Real_incr supp_dexcepted). @@ -1105,9 +1118,9 @@ section Real. /\ n{1} = nb{1} /\ p{1} = bl{1} /\ p0{1} = p{1} /\ i0{1} = size p{1} /\ Redo.prefixes{1}.[take i0{1} p{1}] = Some (sa{1},sc{1}) /\ INV_Real count C.c{1} Perm.m{1} Perm.mi{1} pref - /\ (forall l, l \in dom Redo.prefixes{1} => - l \in dom pref \/ (exists j, 0 < j <= i0{2} /\ l = take j p{1})) - /\ (forall l, l \in dom pref => pref.[l] = Redo.prefixes{1}.[l]) + /\ (forall l, l \in Redo.prefixes{1} => + l \in pref \/ (exists j, 0 < j <= i0{2} /\ l = take j p{1})) + /\ (forall l, l \in pref => pref.[l] = Redo.prefixes{1}.[l]) /\ SLCommon.C.c{1} <= count + i0{1} <= C.c{1} + i0{1} /\ (forall j, 0 <= j < i0{1} => exists b c, Redo.prefixes{1}.[take j p{1}] = Some (b,c) /\ @@ -1117,28 +1130,28 @@ section Real. - cut inv0:=H3;cut[]h_c1c2[]Hmp0 Hmp1 Hinvm:=inv0;split=>//=. - case:inv0;smt(size_ge0). split=>//=. - - smt(in_dom). + - smt(domE). - move=>l H_dom_R i []Hi0 Hisize;cut:=H4 l H_dom_R. - case(l \in dom Redo.prefixes{2})=>H_in_pref//=. + case(l \in Redo.prefixes{2})=>H_in_pref//=. * cut:=Hmp1 l H_in_pref i _;rewrite//=. - rewrite ?H5//=;1:smt(in_dom). - case(i+1 < size l)=>h;1:smt(in_dom). + rewrite ?H5//=;1:smt(domE). + case(i+1 < size l)=>h;1:smt(domE). by rewrite take_oversize 1:/#. move=>[]j[][]hj0 hjsize ->>. cut:=Hisize;rewrite size_take 1:/#. pose k:=if _ then _ else _;cut->>Hij{k}:k=j by rewrite/#. - by rewrite!take_take!min_lel 1,2:/# nth_take 1,2:/#;smt(in_dom). - - smt(getP oget_some in_dom take_oversize). + by rewrite!take_take!min_lel 1,2:/# nth_take 1,2:/#;smt(domE). + - smt(get_setE oget_some domE take_oversize). while( ={i0,p0,i,p,n,nb,bl,sa,sc,lres,C.c,glob Redo,glob Perm} /\ n{1} = nb{1} /\ p{1} = bl{1} /\ p0{1} = p{1} /\ 0 <= i0{1} <= size p{1} /\ Redo.prefixes{1}.[take i0{1} p{1}] = Some (sa{1},sc{1}) /\ INV_Real count C.c{1} Perm.m{1} Perm.mi{1} pref - /\ (forall l, l \in dom Redo.prefixes{1} => - l \in dom pref \/ (exists j, 0 < j <= i0{2} /\ l = take j p{1})) - /\ (forall l, l \in dom pref => pref.[l] = Redo.prefixes{1}.[l]) + /\ (forall l, l \in Redo.prefixes{1} => + l \in pref \/ (exists j, 0 < j <= i0{2} /\ l = take j p{1})) + /\ (forall l, l \in pref => pref.[l] = Redo.prefixes{1}.[l]) /\ SLCommon.C.c{1} <= count + i0{1} <= C.c{1} + i0{1} /\ (i0{1} < size p0{1} => - take (i0{1}+1) p{1} \in dom Redo.prefixes{1} => + take (i0{1}+1) p{1} \in Redo.prefixes{1} => Redo.prefixes{1} = pref) /\ all_prefixes Redo.prefixes{1} /\ (forall j, 0 <= j < i0{1} => @@ -1156,11 +1169,11 @@ section Real. if;auto;progress. - smt(). - smt(). - - smt(get_oget in_dom). - - smt(in_dom). + - smt(domE). + - smt(domE). - smt(). - smt(). - - smt(all_prefixes_of_INV_real in_dom take_take size_take). + - smt(all_prefixes_of_INV_real domE take_take size_take). - case(j < i0{2})=>hj;1:smt(). cut<<-/=:j = i0{2} by smt(). cut->>:=H7 H10 H12. @@ -1170,44 +1183,45 @@ section Real. sp;if;auto;progress. - smt(). - smt(). - - smt(getP get_oget in_dom). + - smt(get_setE domE). - rewrite INV_Real_addm_mi//=;smt(supp_dexcepted). - - smt(dom_set in_fsetU1). - - smt(getP in_dom). + - smt(mem_set). + - smt(get_setE domE). - smt(). - smt(). - - move:H17;apply absurd=>//=_;rewrite dom_set in_fsetU1. + - move:H17;apply absurd=>//=_;rewrite mem_set. pose x:=_ = _;cut->/={x}:x=false by smt(size_take). - move:H12;apply absurd=>//=. - smt(all_prefixes_of_INV_real dom_set in_fsetU1 take_take size_take). - - move=>l;rewrite!dom_set!in_fsetU1;case=>[H_dom|->>]/=;1:smt(in_fsetU1). - move=>j;rewrite in_fsetU1. - case(0 <= j)=>hj0;2:smt(in_dom take_le0). - case(j < i0{2} + 1)=>hjiS;2:smt(in_dom take_take). - rewrite take_take/min hjiS//=;left. + move:H12;apply absurd=>//= hpref. + have:= H8 _ hpref (i0{2}+1). + smt(mem_set take_take size_take). + - move=>l;rewrite!mem_set;case=>[H_dom i|->>]/=. + * by rewrite mem_set;smt(). + move=>j; case(0 <= j)=>hj0;2:smt(domE take_le0 mem_set). + case(j < i0{2} + 1)=>hjiS;2:smt(domE take_take mem_set). + rewrite mem_set take_take/min hjiS//=;left. cut:=(take_take bl{2} j i0{2});rewrite min_lel 1:/#=><-. - smt(all_prefixes_of_INV_real in_dom). - - smt(getP get_oget in_dom dom_set in_fsetU1). - - smt(getP get_oget in_dom). + smt(all_prefixes_of_INV_real domE). + - smt(get_setE domE mem_set). + - smt(get_setE domE). - smt(). - - smt(getP get_oget in_dom). - - smt(dom_set in_fsetU1). - - smt(getP in_dom). + - smt(get_setE domE). + - smt(mem_set). + - smt(get_setE domE). - smt(). - smt(). - - move:H15;apply absurd=>//=_;rewrite dom_set in_fsetU1. + - move:H15;apply absurd=>//=_;rewrite mem_set. pose x:=_ = _;cut->/={x}:x=false by smt(size_take). move:H12;apply absurd=>//=. cut:=take_take bl{2}(i0{2} + 1)(i0{2} + 1 + 1);rewrite min_lel 1:/# =><-h. by rewrite (H8 _ h). - - move=>l;rewrite!dom_set!in_fsetU1;case=>[H_dom|->>]/=;1:smt(in_fsetU1). - move=>j;rewrite in_fsetU1. - case(0 <= j)=>hj0;2:smt(in_dom take_le0). - case(j < i0{2} + 1)=>hjiS;2:smt(in_dom take_take). + - move=>l;rewrite!mem_set;case=>[H_dom|->>]/=;1:smt(mem_set). + move=>j;rewrite mem_set. + case(0 <= j)=>hj0;2:smt(domE take_le0). + case(j < i0{2} + 1)=>hjiS;2:smt(domE take_take). rewrite take_take/min hjiS//=;left. cut:=(take_take bl{2} j i0{2});rewrite min_lel 1:/#=><-. - smt(all_prefixes_of_INV_real in_dom). - - smt(getP get_oget in_dom dom_set in_fsetU1). + smt(all_prefixes_of_INV_real domE). + - smt(get_setE domE mem_set). sp;case(0 < n{1});last first. - rcondf{1}1;2:rcondf{2}1;auto;1:smt(). splitwhile{1} 1 : i + 1 < n;splitwhile{2} 1 : i + 1 < n. @@ -1254,7 +1268,7 @@ section Real. wp;conseq(:_==> ={sa0,sc0,glob Redo,glob Perm} /\ INV_Real SLCommon.C.c{1} (C.c{1} + size bl{2} + i{1}) Perm.m{1} Perm.mi{1} Redo.prefixes{1} - /\ (format p{1} i{1} \in dom Redo.prefixes{1}) + /\ (format p{1} i{1} \in Redo.prefixes{1}) /\ exists (c2 : capacity), Redo.prefixes{1}.[format p{1} (i{1}+1)] = Some (sa0{1}, c2));progress. + smt(size_ge0). + smt(size_ge0). @@ -1267,28 +1281,28 @@ section Real. Redo.prefixes{1});last first. + if;auto;progress. - by split;case:H3=>//=;smt(). - - by rewrite in_dom H2//=. - - by move:H4;rewrite -(addzA _ _ 1)/=take_size;smt(get_oget in_dom). + - by rewrite domE H2//=. + - move:H4;rewrite take_size /= domE. + by case: (Redo.prefixes{2}.[format bl{2} (i{2} + 1)])=>//=; smt(). sp;if;auto;progress. - - move:H4 H5;rewrite!getP/=!oget_some nth_last -(addzA _ _ 1)/=take_size. + - move:H4 H5;rewrite!get_setE/=!oget_some nth_last/=take_size. rewrite last_cat last_nseq 1:/# Block.WRing.addr0;progress. cut//=:=lemma2'(SLCommon.C.c{1} + 1)(C.c{2} + size bl{2} + i{2}) Perm.m{2}.[(sa0_R, sc0{2}) <- y2L] Perm.mi{2}.[y2L <- (sa0_R, sc0{2})] Redo.prefixes{2} bl{2} (i{2}+1) sa0_R sc0{2}. - rewrite -(addzA _ 1)/=H1/=!dom_set!in_fsetU1/=H4/=H2/=getP/=oget_some/=. + rewrite H1/=!mem_set/=H4/=H2/=get_setE/=oget_some/=. cut->->//=:y2L = (y2L.`1, y2L.`2);1,-1:smt(). rewrite INV_Real_addm_mi//=;2:smt(supp_dexcepted). by cut:=H3=>hinv0;split;case:hinv0=>//=/#. - - by rewrite dom_set in_fsetU1//=-(addzA _ _ 1)/=take_size in_dom H2. - - by rewrite!getP-(addzA _ _ 1)/=take_size/=;smt(). - - move:H4 H5;rewrite nth_last -(addzA _ _ 1)/=take_size. + - by rewrite mem_set//=take_size domE H2. + - by rewrite!get_setE take_size/=;smt(). + - move:H4 H5;rewrite nth_last take_size. rewrite last_cat last_nseq 1:/# Block.WRing.addr0;progress. pose a:=(_, _);cut->/={a}:a = oget Perm.m{2}.[(sa0_R, sc0{2})] by smt(). apply lemma2'=>//=;first cut:=H3=>hinv0;split;case:hinv0=>//=/#. smt(). - smt(). - - by rewrite dom_set in_fsetU1//=-(addzA _ _ 1)/=take_size;smt(in_dom). - - by rewrite!getP-(addzA _ _ 1)/=take_size/=;smt(). + - by rewrite mem_set//=take_size;smt(domE). + - by rewrite!get_setE/=take_size/=;smt(). alias{1} 1 pref = Redo.prefixes;sp;alias{1} 1 count = SLCommon.C.c. alias{1} 1 pm = Perm.m;sp;alias{1} 1 pmi = Perm.mi;sp. conseq(:_==> ={nb,bl,n,p,p1,i,i1,lres,sa0,sc0,C.c,glob Redo,glob Perm} @@ -1298,10 +1312,9 @@ section Real. /\ i1{1} = size p1{1} - 1 /\ Redo.prefixes{1}.[format p{1} (i1{1} - size p{1} + 1)] = Some (sa0{1}, sc0{1}));progress. - + smt(size_cat size_nseq set_eq in_dom). - + move:H8;rewrite size_cat size_nseq-(addzA _ 1 (-1))/=/max H0/=. - by pose x:= Int.(+) _ _;cut->/={x}: x = i_R + 1 by smt(). - + move:H8;rewrite size_cat size_nseq-(addzA _ 1 (-1))/=/max H0/=;smt(). + + smt(). + + by move: H8; rewrite size_cat size_nseq /= max_ler /#. + + move:H8;rewrite size_cat size_nseq/=/max H0/=;smt(). splitwhile{1}1:i1 < size p;splitwhile{2}1:i1 < size p. while(={nb,bl,n,p,p1,i,i1,lres,sa0,sc0,C.c,glob Redo,glob Perm} /\ INV_Real SLCommon.C.c{1} (C.c{1} + size bl{2} + i{1} - 1) @@ -1309,7 +1322,7 @@ section Real. /\ pmi{1} = Perm.mi{1} /\ pm{1} = Perm.m{1} /\ pref{1} = Redo.prefixes{1} /\ SLCommon.C.c{1} = count{1} /\ n{1} = nb{1} /\ p{1} = bl{1} /\ p1{1} = format p{1} (i{1}+1) - /\ (format p{1} i{1} \in dom Redo.prefixes{1}) + /\ (format p{1} i{1} \in Redo.prefixes{1}) /\ size p{1} <= i1{1} <= size p1{1} - 1 /\ valid p{1} /\ Redo.prefixes{1}.[format p{1} (i1{1} - size p{1} + 1)] = Some (sa0{1}, sc0{1})). @@ -1322,18 +1335,21 @@ section Real. smt(take_format size_ge0 size_eq0 valid_spec size_cat size_nseq). + smt(). + smt(size_cat size_nseq). - + rewrite get_oget;2:smt(take_format size_ge0 size_eq0 valid_spec size_cat size_nseq). - cut->:format bl{2} (i1{2} + 1 - size bl{2} + 1) = - take (i1{2} + 1) (format bl{2} i{2}) - by smt(take_format size_ge0 size_eq0 valid_spec size_cat size_nseq). - smt(all_prefixes_of_INV_real). + + have->:take (i1{2} + 1) (format bl{2} (i{2} + 1)) = + take (i1{2} + 1) (format bl{2} i{2}). + - smt(take_format size_ge0 size_eq0 valid_spec size_cat size_nseq). + have->:format bl{2} (i1{2} + 1 - size bl{2} + 1) = + take (i1{2} + 1) (format bl{2} i{2}). + - smt(take_format size_ge0 size_eq0 valid_spec size_cat size_nseq). + cut all_pref:=all_prefixes_of_INV_real _ _ _ _ _ H. + by have:=all_pref _ H0 (i1{2}+1); rewrite domE; smt(). conseq(:_==> ={nb,bl,n,p,p1,i,i1,lres,sa0,sc0,C.c,glob Redo,glob Perm} /\ INV_Real SLCommon.C.c{1} (C.c{1} + size bl{2} + i{1} - 1) Perm.m{1} Perm.mi{1} Redo.prefixes{1} /\ pmi{1} = Perm.mi{1} /\ pm{1} = Perm.m{1} /\ pref{1} = Redo.prefixes{1} /\ SLCommon.C.c{1} = count{1} /\ n{1} = nb{1} /\ p{1} = bl{1} /\ p1{1} = format p{1} (i{1}+1) - /\ (format p{1} i{1} \in dom Redo.prefixes{1}) + /\ (format p{1} i{1} \in Redo.prefixes{1}) /\ i1{1} = size p{1} /\ valid p{1} /\ Redo.prefixes{1}.[take i1{1} p{1}] = Some (sa0{1}, sc0{1})); 1:smt(size_cat size_nseq nseq0 cats0 take_size). @@ -1343,14 +1359,14 @@ section Real. /\ pmi{1} = Perm.mi{1} /\ pm{1} = Perm.m{1} /\ pref{1} = Redo.prefixes{1} /\ SLCommon.C.c{1} = count{1} /\ n{1} = nb{1} /\ p{1} = bl{1} /\ p1{1} = format p{1} (i{1}+1) - /\ (format p{1} i{1} \in dom Redo.prefixes{1}) + /\ (format p{1} i{1} \in Redo.prefixes{1}) /\ 0 <= i1{1} <= size p{1} /\ valid p{1} /\ Redo.prefixes{1}.[take i1{1} p{1}] = Some (sa0{1}, sc0{1}));last first. + auto;progress. - smt(). - - cut[]_[]:=H;smt(in_dom). + - cut[]_[]:=H;smt(domE). - exact size_ge0. - - cut[]_[]:=H;smt(in_dom take0). + - cut[]_[]:=H;smt(domE take0). - smt(size_cat size_nseq). rcondt{1}1;2:rcondt{2}1;auto;progress. - cut->:take (i1{m} + 1) (format bl{m} (i{m} + 1)) = @@ -1367,7 +1383,7 @@ section Real. cut->:take (i1{2} + 1) bl{2} = take (i1{2} + 1) (format bl{2} i{2}) by smt(take_cat take_le0 cats0). - rewrite get_oget//=;smt(all_prefixes_of_INV_real). + smt(all_prefixes_of_INV_real). qed. @@ -1375,7 +1391,7 @@ section Real. INV_Real c c' m mi p => 0 < i => p.[format bl i] = Some (sa,sc) => - format bl (i+1) \in dom p => + format bl (i+1) \in p => p.[format bl (i+1)] = m.[(sa,sc)]. proof. move=>inv0 H_i0 H_p_i H_dom_iS. @@ -1399,17 +1415,17 @@ section Real. local lemma lemma_3 c1 c2 m mi p bl b (sa:block) sc: INV_Real c1 c2 m mi p => - (sa +^ b,sc) \in dom m => - ! rcons bl b \in dom p => + (sa +^ b,sc) \in m => + ! rcons bl b \in p => p.[bl] = Some (sa,sc) => INV_Real c1 c2 m mi p.[rcons bl b <- oget m.[(sa +^ b,sc)]]. proof. move=>inv0 H_dom_m H_dom_p H_p_val. split;cut[]//=_[] hmp0 hmp1 hinvm:=inv0;split=>//=. - + by rewrite getP;smt(size_cat size_nseq size_ge0). - + move=>l;rewrite dom_set in_fsetU1;case;1:smt(all_prefixes_of_INV_real getP). - move=>->>j[]hj0 hjsize;rewrite getP/=. - cut:=hmp1 bl;rewrite in_dom H_p_val/==>help. + + by rewrite get_setE;smt(size_cat size_nseq size_ge0). + + move=>l;rewrite mem_set;case;1:smt(all_prefixes_of_INV_real get_setE). + move=>->>j[]hj0 hjsize;rewrite get_setE/=. + cut:=hmp1 bl;rewrite domE H_p_val/==>help. cut->/=:!take j (rcons bl b) = rcons bl b by smt(size_take). move:hjsize;rewrite size_rcons=>hjsize. rewrite-cats1 !take_cat. @@ -1417,12 +1433,12 @@ section Real. rewrite nth_cat. case(j < size bl)=>//=hj;last first. + cut->>/=:j = size bl by smt(). - by rewrite take_size H_p_val/=;exists sa sc=>//=;smt(getP get_oget). + by rewrite take_size H_p_val/=;exists sa sc=>//=;smt(get_setE). cut->/=:j + 1 - size bl <= 0 by smt(). rewrite cats0. pose x := if _ then _ else _;cut->/={x}: x = take (j+1) bl by smt(take_le0 cats0 take_size). - cut:=hmp1 bl;rewrite in_dom H_p_val/==>hep. - cut:=hep j _;rewrite//=;smt(getP size_cat size_take). + cut:=hmp1 bl;rewrite domE H_p_val/==>hep. + cut:=hep j _;rewrite//=;smt(get_setE size_cat size_take). qed. @@ -1437,7 +1453,7 @@ section Real. /\ INV_Real 0 C.c{1} Perm.m{1} Perm.mi{1} Redo.prefixes{1});auto;last first. + progress. + exact max_ge0. - split=>//=;1:split=>//=;smt(getP dom0 map0P in_fset0 dom_set in_fsetU1). + split=>//=;1:split=>//=;smt(get_setE mem_empty emptyE in_fset0 mem_set). + proc;inline*;auto;sp;if;auto;sp;if;auto;progress. - by rewrite INV_Real_addm_mi;2..:smt(supp_dexcepted);split;case:H0=>//=;smt(). - by split;case:H0=>//=;smt(). @@ -1478,30 +1494,30 @@ section Real. cut[]_[]_ hmp1 _ :=H2;cut:=hmp1 _ H5 i0{m} _;1:smt(size_take). move=>[]b3 c3;rewrite!take_take!nth_take 1,2:/# !min_lel//= 1:/#. rewrite H1=>//=[][][]->>->>. - by rewrite nth_onth (onth_nth b0)//=;smt(in_dom). + by rewrite nth_onth (onth_nth b0)//=;smt(domE). + rewrite head_nth nth_drop//=. cut[]_[]_ hmp1 _ :=H2;cut:=hmp1 _ H5 i0{1} _;1:smt(size_take). move=>[]b3 c3;rewrite!take_take!nth_take 1,2:/# !min_lel//= 1:/#. rewrite H1=>//=[][][]->>->>. - by rewrite nth_onth (onth_nth b0)//=;smt(in_dom). + by rewrite nth_onth (onth_nth b0)//=;smt(domE). + rewrite head_nth nth_drop//=. cut[]_[]_ hmp1 _ :=H2;cut:=hmp1 _ H5 i0{1} _;1:smt(size_take). move=>[]b3 c3;rewrite!take_take!nth_take 1,2:/# !min_lel//= 1:/#. rewrite H1=>//=[][][]->>->>. - by rewrite nth_onth (onth_nth b0)//=;smt(in_dom). + by rewrite nth_onth (onth_nth b0)//=;smt(domE). + rewrite head_nth nth_drop//=. cut[]_[]_ hmp1 _ :=H2;cut:=hmp1 _ H5 i0{1} _;1:smt(size_take). move=>[]b3 c3;rewrite!take_take!nth_take 1,2:/# !min_lel//= 1:/#. rewrite H1=>//=[][][]->>->>. - by rewrite nth_onth (onth_nth b0)//=;smt(in_dom). + by rewrite nth_onth (onth_nth b0)//=;smt(domE). + rewrite head_nth nth_drop//=. cut[]_[]_ hmp1 _ :=H2;cut:=hmp1 _ H5 i0{1} _;1:smt(size_take). move=>[]b3 c3;rewrite!take_take!nth_take 1,2:/# !min_lel//= 1:/#. rewrite H1=>//=[][][]->>->>. - by rewrite nth_onth (onth_nth b0)//=;smt(in_dom). + by rewrite nth_onth (onth_nth b0)//=;smt(domE). + + smt(). + smt(). + smt(). - + smt(get_oget). + smt(behead_drop drop_add). + smt(size_drop size_eq0). + smt(size_drop size_eq0). @@ -1517,13 +1533,13 @@ section Real. + by rewrite head_nth nth_drop //=nth_onth (onth_nth b0)//=. + smt(). + smt(). - + by rewrite getP/=. + + by rewrite get_setE/=. + by rewrite behead_drop drop_add. - + rewrite!getP/=oget_some. + + rewrite!get_setE/=oget_some. cut:=lemma_3 0 C.c{2}Perm.m{2}.[(sa{2} +^ nth witness p0{1} i0{1}, sc{2}) <- yL] Perm.mi{2}.[yL <- (sa{2} +^ nth witness p0{1} i0{1}, sc{2})] Redo.prefixes{1} (take i0{1} p0{1}) (nth witness p0{1} i0{1}) sa{2} sc{2}. - rewrite!dom_set!in_fsetU1/=-take_nth//=H5/=H1/=getP/=oget_some. + rewrite!mem_set/=-take_nth//=H5/=H1/=get_setE/=oget_some. cut->->//=:(yL.`1, yL.`2) = yL by smt(). rewrite INV_Real_addm_mi=>//=;smt(supp_dexcepted). + smt(size_drop size_eq0). @@ -1534,7 +1550,7 @@ section Real. + by rewrite head_nth nth_drop //=nth_onth (onth_nth b0)//=. + smt(). + smt(). - + by rewrite getP. + + by rewrite get_setE. + by rewrite behead_drop drop_add. + rewrite(take_nth witness)//=. cut:=lemma_3 0 C.c{2} Perm.m{2} Perm.mi{2} Redo.prefixes{1} @@ -1576,7 +1592,7 @@ section Real. + seq 1 : (i1 = size p1 - 1). - while(i1 < size p1);auto;2:smt(size_cat size_nseq size_ge0 size_eq0 valid_spec). by if;auto;1:smt();sp;if;auto;progress;smt(). - by if;auto;1:smt();sp;if;auto;smt(). + if;auto;sp;if;auto;smt(). seq 1 0 : (={i,n,glob P,C.c} /\ x0{2} = (sa{2}, sc{2}) /\ 0 < i{1} < n{1} /\ p1{1} = format p{1} (i{1} + 1) /\ (sa0,sc0){1} = x0{2} /\ i1{1} = size p{1} + i{1} - 1 /\ lres{1} = z0{2} /\ valid p{1} @@ -1586,13 +1602,13 @@ section Real. + if{1};auto. + rcondf{2}1;auto;progress. + move:H5;rewrite take_oversize;1:rewrite size_cat size_nseq max_ler/#. - move=>H_dom;rewrite in_dom. - by cut<-:=lemma4 _ _ _ _ _ _ _ _ _ H3 H H2 H_dom;rewrite-in_dom. + move=>H_dom;rewrite domE. + by cut<-:=lemma4 _ _ _ _ _ _ _ _ _ H3 H H2 H_dom;rewrite-domE. + move:H5;rewrite take_oversize;1:rewrite size_cat size_nseq max_ler/#;move=>H_dom. - by cut:=lemma4 _ _ _ _ _ _ _ _ _ H3 H H2 H_dom;smt(in_dom). + by cut:=lemma4 _ _ _ _ _ _ _ _ _ H3 H H2 H_dom;smt(domE). + smt(). + move:H5;rewrite take_oversize;1:rewrite size_cat size_nseq max_ler/#;move=>H_dom. - by cut:=lemma4 _ _ _ _ _ _ _ _ _ H3 H H2 H_dom;smt(in_dom). + by cut:=lemma4 _ _ _ _ _ _ _ _ _ H3 H H2 H_dom;smt(domE). sp;if;auto;progress. + move:H6;rewrite nth_cat nth_nseq;1:smt(size_ge0). cut->/=:!size p{1} + i{2} - 1 < size p{1} by smt(). @@ -1612,16 +1628,16 @@ section Real. + smt(). + move:H5 H6;rewrite nth_cat nth_nseq;1:smt(size_ge0). cut->/=:!size p{1} + i{2} - 1 < size p{1} by smt(). - rewrite Block.WRing.addr0 !getP/=oget_some take_oversize;1:rewrite size_cat size_nseq/#. + rewrite Block.WRing.addr0 !get_setE/=oget_some take_oversize;1:rewrite size_cat size_nseq/#. move=>H_dom_iS H_dom_p. cut:=lemma2' 0 C.c{2} Perm.m{2}.[(sa{2}, sc{2}) <- y0L] Perm.mi{2}.[y0L <- (sa{2}, sc{2})] Redo.prefixes{1} p{1} (i{2}+1) sa{2} sc{2} _ _ H4 _ H_dom_iS. + by rewrite INV_Real_addm_mi//=;smt(supp_dexcepted). + smt(). - + by rewrite dom_set in_fsetU1. - by rewrite!getP/=oget_some-(addzA)/=H2/=;smt(). - + by rewrite!getP/=take_oversize//=size_cat size_nseq/#. + + by rewrite mem_set. + by rewrite!get_setE/=oget_some/=H2/=;smt(). + + by rewrite!get_setE/=take_oversize//=size_cat size_nseq/#. + rewrite nth_cat;cut->/=:! size p{1} + i{2} - 1 < size p{1} by smt(). by rewrite nth_nseq//=1:/# Block.WRing.addr0. + smt(). @@ -1632,7 +1648,7 @@ section Real. p{1} (i{2}+1) sa{2} sc{2} H3 _ H1 h2 h1;smt(). + move:H5 H6;rewrite take_oversize 1:size_cat 1:size_nseq 1:/#. rewrite nth_cat;cut->/=:! size p{1} + i{2} - 1 < size p{1} by smt(). - by rewrite nth_nseq//=1:/# Block.WRing.addr0 !getP//=. + by rewrite nth_nseq//=1:/# Block.WRing.addr0 !get_setE//=. alias{1} 1 pref = Redo.prefixes;sp. conseq(:_==> ={glob P} /\ p1{1} = format p{1} (i{1} + 1) /\ pref{1} = Redo.prefixes{1} @@ -1642,14 +1658,14 @@ section Real. + smt(). + move:H9;rewrite take_format/=1:/#;1:smt(size_ge0 size_cat size_nseq). pose x := if _ then _ else _ ;cut->/={x}: x = format p{1} (i_R+1). - + rewrite/x size_cat size_nseq-(addzA _ 1 (-1))/=!max_ler 1:/#-(addzA _ _ (-1))-(addzA _ _ (-1))/=. + + rewrite/x size_cat size_nseq/=!max_ler 1:/#-(addzA _ _ (-1))-(addzA _ _ (-1))/=. case(size p{1} + i_R <= size p{1})=>//=h;2:smt(size_ge0 size_cat size_nseq). cut->>/=:i_R = 0 by smt(). by rewrite take_size/format nseq0 cats0. by rewrite H3/==>[][]->>->>. + move:H9;rewrite take_format/=1:/#;1:smt(size_ge0 size_cat size_nseq). pose x := if _ then _ else _ ;cut->/={x}: x = format p{1} (i_R+1). - + rewrite/x size_cat size_nseq-(addzA _ 1 (-1))/=!max_ler 1:/#-(addzA _ _ (-1))-(addzA _ _ (-1))/=. + + rewrite/x size_cat size_nseq/=!max_ler 1:/#-(addzA _ _ (-1))-(addzA _ _ (-1))/=. case(size p{1} + i_R <= size p{1})=>//=h;2:smt(size_ge0 size_cat size_nseq). cut->>/=:i_R = 0 by smt(). by rewrite take_size/format nseq0 cats0. @@ -1657,25 +1673,25 @@ section Real. + by rewrite size_cat size_nseq;smt(). while{1}(={glob P} /\ 0 <= i1{1} <= size p1{1} - 1 /\ 0 < i{1} < n{1} /\ p1{1} = format p{1} (i{1} + 1) /\ pref{1} = Redo.prefixes{1} - /\ format p{1} i{1} \in dom pref{1} + /\ format p{1} i{1} \in pref{1} /\ Redo.prefixes{1}.[take i1{1} p1{1}] = Some (sa0{1}, sc0{1}) /\ INV_Real 0 C.c{1} Perm.m{1} Perm.mi{1} Redo.prefixes{1}) (size p1{1}-i1{1}-1);auto;last first. + progress. + smt(size_cat size_nseq size_ge0 size_eq0 valid_spec). + smt(). - + by rewrite in_dom H3. + + by rewrite domE H3. + by rewrite take0;cut[]_[]:=H1. + smt(). + smt(). rcondt 1;auto;progress. + cut->:take (i1{hr} + 1) (format p{hr} (i{hr} + 1)) = - take (i1{hr} + 1) (format p{hr} i{hr});2:smt(all_prefixes_of_INV_real in_dom). + take (i1{hr} + 1) (format p{hr} i{hr});2:smt(all_prefixes_of_INV_real domE). rewrite!take_format;smt(valid_spec size_ge0 size_eq0 size_cat size_nseq). + smt(). + smt(valid_spec size_ge0 size_eq0 size_cat size_nseq). + cut->:take (i1{hr} + 1) (format p{hr} (i{hr} + 1)) = - take (i1{hr} + 1) (format p{hr} i{hr});2:smt(all_prefixes_of_INV_real in_dom). + take (i1{hr} + 1) (format p{hr} i{hr});2:smt(all_prefixes_of_INV_real domE). rewrite!take_format;smt(valid_spec size_ge0 size_eq0 size_cat size_nseq). smt(). qed. @@ -1723,7 +1739,7 @@ section Real_Ideal. lemma concl &m : Pr [ RealIndif(Sponge,P,DRestr(D)).main() @ &m : res ] <= Pr [ IdealIndif(BIRO.IRO, SimLast(S), DRestr(D)).main() @ &m : res ] + - (max_size ^ 2)%r / 2%r / (2^r)%r / (2^c)%r + + (max_size ^ 2 - max_size)%r / 2%r / (2^r)%r / (2^c)%r + max_size%r * ((2*max_size)%r / (2^c)%r) + max_size%r * ((2*max_size)%r / (2^c)%r). proof. @@ -1768,21 +1784,23 @@ section Real_Ideal_Abs. local lemma useful m mi a : - invm m mi => ! a \in dom m => Distr.is_lossless ((bdistr `*` cdistr) \ mem (rng m)). + invm m mi => ! a \in m => Distr.is_lossless ((bdistr `*` cdistr) \ rng m). proof. move=>hinvm nin_dom. cut prod_ll:Distr.is_lossless (bdistr `*` cdistr). + by rewrite dprod_ll DBlock.dunifin_ll DCapacity.dunifin_ll. apply dexcepted_ll=>//=;rewrite-prod_ll. - cut->:predT = predU (predC (mem (rng m))) (mem (rng m));1:rewrite predCU//=. + cut->:predT = predU (predC (rng m)) (rng m);1:rewrite predCU//=. rewrite Distr.mu_disjoint 1:predCI//=StdRing.RField.addrC. - cut/=->:=ltr_add2l (mu (bdistr `*` cdistr) (mem (rng m))) 0%r. + cut/=->:=ltr_add2l (mu (bdistr `*` cdistr) (rng m)) 0%r. rewrite Distr.witness_support/predC. move:nin_dom;apply absurd=>//=;rewrite negb_exists/==>hyp. - cut{hyp}hyp:forall x, x \in rng m by smt(supp_dprod DBlock.supp_dunifin DCapacity.supp_dunifin). + cut{hyp}hyp:forall x, rng m x by smt(supp_dprod DBlock.supp_dunifin DCapacity.supp_dunifin). move:a. - cut:=eqEcard (dom m) (rng m);rewrite leq_card_rng_dom/=. - cut->//=/#:dom m \subset rng m;rewrite subsetP=>x;rewrite hyp//=. + cut:=eqEcard (fdom m) (frng m);rewrite leq_card_rng_dom/=. + cut->//=:fdom m \subset frng m. + + by move=> x; rewrite mem_fdom mem_frng hyp. + smt(mem_fdom mem_frng). qed. local lemma invmC (m mi : (state, state) fmap) : @@ -1800,7 +1818,7 @@ section Real_Ideal_Abs. - smt(invm_set dexcepted1E). + proc;inline*;sp;if;auto;sp;if;auto;progress. - cut:=H;rewrite invmC=>h;cut/#:=useful _ _ _ h H1. - - move:H;rewrite invmC=>H;rewrite invmC;smt(invm_set dexcepted1E in_dom in_rng). + - move:H;rewrite invmC=>H;rewrite invmC;smt(invm_set dexcepted1E domE rngE). + proc;inline*;sp;if;auto;sp;if;auto. while(invm Perm.m Perm.mi)(n-i);auto. - sp;if;auto;2:smt();sp;if;auto;2:smt();progress. @@ -1815,7 +1833,7 @@ section Real_Ideal_Abs. * smt(size_behead). * smt(size_behead). smt(size_ge0 size_eq0). - smt(map0P). + smt(emptyE). qed. @@ -1840,7 +1858,7 @@ section Real_Ideal_Abs. local lemma neg_D_concl &m : Pr [ IdealIndif(BIRO.IRO, SimLast(S), DRestr(D)).main() @ &m : res ] <= Pr [ RealIndif(Sponge,P,DRestr(D)).main() @ &m : res ] + - (max_size ^ 2)%r / 2%r / (2^r)%r / (2^c)%r + + (max_size ^ 2 - max_size)%r / 2%r / (2^r)%r / (2^c)%r + max_size%r * ((2*max_size)%r / (2^c)%r) + max_size%r * ((2*max_size)%r / (2^c)%r). proof. @@ -1859,7 +1877,7 @@ section Real_Ideal_Abs. lemma Real_Ideal &m : `|Pr [ RealIndif(Sponge,Perm,DRestr(D)).main() @ &m : res ] - Pr [ IdealIndif(BIRO.IRO, SimLast(S), DRestr(D)).main() @ &m : res ]| <= - (max_size ^ 2)%r / 2%r / (2^r)%r / (2^c)%r + + (max_size ^ 2 - max_size)%r / 2%r / (2^r)%r / (2^c)%r + max_size%r * ((2*max_size)%r / (2^c)%r) + max_size%r * ((2*max_size)%r / (2^c)%r). proof. From f8e22db16ac5ba5c50fbfcaa3129e90ee6577c62 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Tue, 18 Sep 2018 17:00:14 +0200 Subject: [PATCH 315/525] push IRO + adding joint map --- proof/IRO.eca | 20 ++++++++++---------- proof/smart_counter/JointFMap.ec | 19 +++++++++++++++++++ 2 files changed, 29 insertions(+), 10 deletions(-) create mode 100644 proof/smart_counter/JointFMap.ec diff --git a/proof/IRO.eca b/proof/IRO.eca index 05d512d..bad01db 100644 --- a/proof/IRO.eca +++ b/proof/IRO.eca @@ -3,7 +3,7 @@ independently. We obviously make it lazy. Inputs not satisfying a validity predicate are mapped to the empty list *) -require import Core Int Bool List FSet NewFMap. +require import Core Int Bool List FSet SmtMap. type to, from. @@ -19,15 +19,15 @@ module type IRO = { pred prefix_closed (m : (from * int,to) fmap) = forall x n, - mem (dom m) (x,n) => + (x,n) \in m => (forall i, 0 <= i < n => - mem (dom m) (x,i)). + (x,i) \in m). pred prefix_closed' (m : (from * int,to) fmap) = forall x n i, - mem (dom m) (x,n) => + (x,n) \in m => 0 <= i < n => - mem (dom m) (x,i). + (x,i) \in m. lemma prefix_closed_equiv m: prefix_closed m <=> prefix_closed' m. proof. smt(). qed. @@ -38,11 +38,11 @@ module IRO : IRO = { var mp : (from * int, to) fmap proc init() = { - mp <- map0; + mp <- empty; } proc fill_in(x, n) = { - if (!mem (dom mp) (x, n)) { + if ((x,n) \notin mp) { mp.[(x,n)] <$ dto; } return oget mp.[(x,n)]; @@ -74,7 +74,7 @@ module IRO' : IRO = { proc resample_invisible() = { var work, x; - work <- dom mp `\` visible; + work <- fdom mp `\` visible; while (work <> fset0) { x <- pick work; mp.[x] <$ dto; @@ -83,12 +83,12 @@ module IRO' : IRO = { } proc init() = { - mp <- map0; + mp <- empty; visible <- fset0; } proc fill_in(x,n) = { - if (!mem (dom mp) (x,n)) { + if ((x,n) \notin mp) { mp.[(x,n)] <$ dto; } return oget mp.[(x,n)]; diff --git a/proof/smart_counter/JointFMap.ec b/proof/smart_counter/JointFMap.ec new file mode 100644 index 0000000..7f53422 --- /dev/null +++ b/proof/smart_counter/JointFMap.ec @@ -0,0 +1,19 @@ +require import SmtMap. + +(*****) import Finite FSet List. + +op (+) (m1 m2 : ('a,'b) fmap) : ('a,'b) fmap = + ofmap (Map.offun (fun x=> if x \in m2 then m2.[x] else m1.[x])). + +lemma joinE ['a 'b] (m1 m2 : ('a,'b) fmap) (x : 'a): + (m1 + m2).[x] = if x \in m2 then m2.[x] else m1.[x]. +proof. +rewrite /(+) getE ofmapK /= 2:Map.getE 2:Map.offunK //. +apply/finiteP=> /=; exists (elems (fdom m1) ++ elems (fdom m2))=> x0 /=. +rewrite Map.getE Map.offunK /= mem_cat -!memE !mem_fdom !domE. +by case: (m2.[x0]). +qed. + +lemma mem_join ['a 'b] (m1 m2 : ('a,'b) fmap) (x : 'a): + x \in (m1 + m2) <=> x \in m1 \/ x \in m2. +proof. by rewrite domE joinE !domE; case: (m2.[x]). qed. \ No newline at end of file From b0a25361fb84a2749f01c1867a513fbbf8fa78b6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Tue, 18 Sep 2018 17:58:09 +0200 Subject: [PATCH 316/525] removing Utils that is never used --- proof/smart_counter/Utils.ec | 68 ------------------------------------ 1 file changed, 68 deletions(-) delete mode 100644 proof/smart_counter/Utils.ec diff --git a/proof/smart_counter/Utils.ec b/proof/smart_counter/Utils.ec deleted file mode 100644 index 042cc64..0000000 --- a/proof/smart_counter/Utils.ec +++ /dev/null @@ -1,68 +0,0 @@ -(** These should make it into the standard libs **) -require import Core List FSet SmtMap. - -(* -------------------------------------------------------------------- *) -(* In SmtMap *) - -op reindex (f : 'a -> 'c) (m : ('a, 'b) fmap) = - SmtMap.ofmap ( - SmtMap.oflist (map (fun (x : 'a * 'b) => (f x.`1,x.`2)) (elems m)) - axiomatized by reindexE. - - - -lemma dom_reindex (f : 'a -> 'c) (m : ('a, 'b) fmap) x: - mem (dom (reindex f m)) x <=> mem (image f (dom m)) x. -proof. - rewrite reindexE dom_oflist imageP mapP /fst; split. - move=> [[x' y] [+ ->>]]. - rewrite mapP=> -[[x0 y0]] /= [h [->> ->>]] {x' y}. - by exists x0; rewrite domE mem_oflist mapP /fst; exists (x0,y0). - move=> [a] [a_in_m <<-]. - exists (f a,oget m.[a])=> /=; rewrite mapP /=. - exists (a,oget m.[a])=> //=. - have:= a_in_m; rewrite in_dom; case {-1}(m.[a]) (eq_refl m.[a])=> //=. - by move=> y; rewrite getE mem_assoc_uniq 1:uniq_keys. -qed. - - -lemma reindex_injective_on (f : 'a -> 'c) (m : ('a, 'b) fmap): - (forall x y, mem (dom m) x => f x = f y => x = y) => - (forall x, m.[x] = (reindex f m).[f x]). -proof. - move=> f_pinj x. - pose s:= elems (reindex f m). - case (assocP s (f x)). - rewrite -dom_oflist {1}/s elemsK dom_reindex imageP. - move=> [[a]] [] /f_pinj h /(h x) ->> {a}. - rewrite !getE. - move=> [y] [+ ->]. - rewrite /s reindexE. - pose s':= map (fun (x : 'a * 'b) => (f x.`1,x.`2)) (elems m). - have <- := (perm_eq_mem _ _ (oflistK s')). - (** FIXME: make this a lemma **) - have h' /h': forall (s : ('c * 'b) list) x, mem (reduce s) x => mem s x. - rewrite /reduce=> s0 x0; rewrite -{2}(cat0s s0); pose acc:= []. - elim s0 acc x0=> {s'} [acc x0 /=|x' s' ih acc x0 /=]. - by rewrite cats0. - move=> /ih; rewrite -cat1s catA cats1 !mem_cat=> -[|-> //=]. - rewrite /augment; case (mem (map fst acc) x'.`1)=> _ h'; left=> //. - by rewrite mem_rcons /=; right. - rewrite /s' mapP=> -[[a' b']] /= [xy_in_m []]. - rewrite eq_sym. - have h0 /h0 ->> <<- {a' b'}:= f_pinj a' x _. - + by rewrite domE mem_oflist mapP; exists (a',b'). - by apply/mem_assoc_uniq; 1:exact uniq_keys. - rewrite -mem_oflist {1}/s -domE=> -[] h; have := h; rewrite dom_reindex. - rewrite imageP=> h'. - have {h'} h': forall (a : 'a), !mem (dom m) a \/ f a <> f x. - + by move: h'=> /negb_exists /= + a - /(_ a) /negb_and. - have /= := h' x. - rewrite in_dom !getE /=. - by move=> -> ->. -qed. - -lemma reindex_injective (f : 'a -> 'c) (m : ('a, 'b) fmap): - injective f => - (forall x, m.[x] = (reindex f m).[f x]). -proof. by move=> f_inj; apply/reindex_injective_on=> + + _. qed. \ No newline at end of file From 8d8bade1e5b0c4a631a3c5aff50c68907f1a02eb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Tue, 18 Sep 2018 18:01:59 +0200 Subject: [PATCH 317/525] adding MapAux that is used in Sponge --- proof/MapAux.ec | 146 ++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 146 insertions(+) create mode 100644 proof/MapAux.ec diff --git a/proof/MapAux.ec b/proof/MapAux.ec new file mode 100644 index 0000000..a95f201 --- /dev/null +++ b/proof/MapAux.ec @@ -0,0 +1,146 @@ +(*---------------------- Auxiliary Lemmas on Maps ----------------------*) + +prover [""]. + +require import AllCore SmtMap FSet StdOrder. +import IntOrder. + +lemma get_none (m : ('a, 'b) fmap, x : 'a) : + x \notin m => m.[x] = None. +proof. by rewrite domE. qed. + +lemma get_some (m : ('a, 'b) fmap, x : 'a) : + x \in m => m.[x] = Some (oget m.[x]). +proof. move=> /domE; by case m.[x]. qed. + +lemma set_same (m : ('a, 'b) fmap, x : 'a) : + x \in m => m.[x <- oget m.[x]] = m. +proof. +move=> x_in_m. +apply fmap_eqP => y. +case (y = x) => [->> | ne_y_x]. +by rewrite get_set_sameE get_some. +by rewrite get_setE ne_y_x. +qed. + +lemma set_eq (m : ('a, 'b) fmap, x : 'a, y : 'b) : + m.[x] = Some y => m.[x <- y] = m. +proof. +move=> m_get_x_eq_y. +have x_in_m : x \in m by rewrite domE m_get_x_eq_y. +have -> : y = oget m.[x] by rewrite m_get_x_eq_y oget_some. +by rewrite set_same. +qed. + +lemma frng_set (m : ('a, 'b) fmap, x : 'a, y : 'b) : + frng m.[x <- y] = frng (rem m x) `|` fset1 y. +proof. +apply fsetP => z; rewrite in_fsetU in_fset1 2!mem_frng 2!rngE /=. +split => [[x'] | [[x'] | ->]]. +case (x' = x) => [-> | ne_x'_x]. +by rewrite get_set_sameE /= => ->. +rewrite get_setE ne_x'_x /= => get_x'_some_z. +left; exists x'; by rewrite remE ne_x'_x. +rewrite remE. +case (x' = x) => // ne_x'_x get_x'_some_z. +exists x'; by rewrite get_setE ne_x'_x. +exists x; by rewrite get_set_sameE. +qed. + +lemma eq_except_ne_in (x y : 'a, m1 m2 : ('a, 'b) fmap) : + eq_except (pred1 x) m1 m2 => y <> x => + y \in m1 => y \in m2. +proof. +move=> /eq_exceptP @/pred1 eq_exc ne_y_x. +by rewrite 2!domE eq_exc. +qed. + +lemma eq_except_setr_as_l (m1 m2 : ('a, 'b) fmap) x: + x \in m1 => eq_except (pred1 x) m1 m2 => + m1 = m2.[x <- oget m1.[x]]. +proof. +rewrite eq_exceptP -fmap_eqP=> x_in_m1 eqe x'. +rewrite get_setE /oget; case (x' = x)=> [->> |]. +by move: x_in_m1; rewrite domE; case (m1.[x]). +by move=> ne_x'_x; rewrite eqe. +qed. + +lemma eq_except_set_both x b b' (m : ('a, 'b) fmap): + eq_except (pred1 x) m.[x <- b] m.[x <- b']. +proof. by rewrite eq_exceptP=> x'; rewrite /pred1 !get_setE=> ->. qed. + +lemma eq_except_rem (m1 m2 : ('a,'b) fmap) (X : 'a -> bool) x: + X x => eq_except X m1 m2 => eq_except X m1 (rem m2 x). +proof. +move=> X_x /eq_exceptP eq_exc; rewrite eq_exceptP=> y X_y; rewrite remE. +case (y = x)=> [->> // | ne_y_x]; by apply eq_exc. +qed. + +lemma rem_id (m : ('a, 'b) fmap, x : 'a) : + x \notin m => rem m x = m. +proof. +move=> x_notin_m; apply fmap_eqP => y; rewrite remE. +case (y = x) => // ->. +case (None = m.[x]) => // get_not_none. +rewrite eq_sym -domE // in get_not_none. +qed. + +lemma map_empty (f : 'a -> 'b -> 'c, m : ('a, 'b) fmap) : + map f empty = empty. +proof. by rewrite -fmap_eqP=> x; rewrite mapE 2!emptyE. qed. + +lemma map_rem (f:'a -> 'b -> 'c) m (x:'a) : + map f (rem m x) = rem (map f m) x. +proof. +rewrite -fmap_eqP=> z; by rewrite !(mapE,remE); case (z = x). +qed. + +lemma map_id (m:('a,'b)fmap): map (fun _ b => b) m = m. +proof. by rewrite -fmap_eqP=>x; rewrite mapE; case (m.[x]). qed. + +lemma le_card_frng_fdom (m : ('a, 'b) fmap) : + card (frng m) <= card (fdom m). +proof. +move: m. +elim /fmapW=> [| m k v k_notin_m IH]. +by rewrite frng0 fdom0 2!fcards0. +rewrite mem_fdom in k_notin_m. +rewrite frng_set rem_id // fdom_set (fcardUI_indep _ (fset1 k)) + 1:fsetI1 1:mem_fdom 1:k_notin_m // fcard1 fcardU fcard1 + -addzA ler_add // -{2}(addz0 1) ler_add // oppz_le0 fcard_ge0. +qed. + +lemma fdom_frng_prop (X : 'a fset, m : ('a, 'a) fmap) : + fdom m \proper X => frng m \subset X => frng m \proper X. +proof. +rewrite /(\proper); move=> |>. +case (frng m = X)=> // ^ eq_frng_m_X -> fdom_m_sub_X fdom_m_ne_X _. +have card_fdom_m_lt_card_X : card (fdom m) < card X. + rewrite ltz_def; split. + case (card X = card (fdom m))=> // /eq_sym /subset_cardP. + by rewrite fdom_m_sub_X fdom_m_ne_X. + by rewrite subset_leq_fcard. +have card_X_le_card_fdom_m : card X <= card (fdom m) + by rewrite -eq_frng_m_X le_card_frng_fdom. +by rewrite /= -(ltzz (card X)) (ler_lt_trans (card (fdom m))). +qed. + +lemma fdom_frng_prop_type (m : ('a, 'a) fmap) : + (exists (x : 'a), ! x \in m) => + (exists (y : 'a), ! rng m y). +proof. +move=> [x x_notin_m]. +have : fdom m \proper fdom m `|` frng m `|` fset1 x. + rewrite /(\proper); split. + move=> z; rewrite 2!in_fsetU; move=> />. + case (fdom m = fdom m `|` frng m `|` fset1 x)=> // contra_eq. + rewrite -mem_fdom in x_notin_m. + have // : x \in fdom m by rewrite contra_eq 2!in_fsetU in_fset1. +pose univ := fdom m `|` frng m `|` fset1 x. +have fdom_prop_univ frng_sub_univ : frng m \subset univ + by move=> z @/univ; rewrite 2!in_fsetU; move=> />. +have : frng m \proper univ by apply fdom_frng_prop. +move=> /properP [_ [y [_ y_notin_frng_m]]]. +rewrite mem_frng in y_notin_frng_m. +by exists y. +qed. From d05fee4530b528fa2bfb83726923f12c89398706 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Tue, 18 Sep 2018 18:24:03 +0200 Subject: [PATCH 318/525] Clearing my confusion about branches : push Sponge --- proof/Sponge.ec | 202 ++++++++++++++++++++++++------------------------ 1 file changed, 99 insertions(+), 103 deletions(-) diff --git a/proof/Sponge.ec b/proof/Sponge.ec index 333ab74..72f010a 100644 --- a/proof/Sponge.ec +++ b/proof/Sponge.ec @@ -1,19 +1,13 @@ (*------------------------- Sponge Construction ------------------------*) -(* checks with both Alt-Ergo and Z3; all smt applications are - restricted to specific lemmas *) +prover quorum=2 ["Z3" "Alt-Ergo"]. -(* -prover ["Z3"]. -prover ["Alt-Ergo"]. -*) - -require import Core Int IntDiv Real List FSet NewFMap. +require import Core Int IntDiv Real List FSet SmtMap MapAux. (*---*) import IntExtra. require import Distr DBool DList. require import StdBigop StdOrder. import IntOrder. require import Common. -require (*--*) IRO BlockSponge RndO. +require (*--*) IRO BlockSponge PROM. (*------------------------- Indifferentiability ------------------------*) @@ -222,11 +216,11 @@ module HybridIROLazy : HYBRID_IRO, BlockSponge.BIRO.IRO = { var mp : (block list * int, bool) fmap proc init() : unit = { - mp <- map0; + mp <- empty; } proc fill_in(xs, i) = { - if (! mem (dom mp) (xs, i)) { + if (! dom mp (xs, i)) { mp.[(xs, i)] <$ dbool; } return oget mp.[(xs, i)]; @@ -262,11 +256,11 @@ module HybridIROEager : HYBRID_IRO, BlockSponge.BIRO.IRO = { var mp : (block list * int, bool) fmap proc init() : unit = { - mp <- map0; + mp <- empty; } proc fill_in(xs, i) = { - if (! mem (dom mp) (xs, i)) { + if (! dom mp (xs, i)) { mp.[(xs, i)] <$ dbool; } return oget mp.[(xs, i)]; @@ -312,7 +306,7 @@ section. declare module D : HYBRID_IRO_DIST{HybridIROEager, HybridIROLazy}. -local clone RndO.GenEager as ERO with +local clone PROM.GenEager as ERO with type from <- block list * int, type to <- bool, op sampleto <- fun _ => dbool. @@ -381,7 +375,7 @@ local lemma HybridIROLazy_fill_in_LRO_get : ={res} /\ HybridIROLazy.mp{1} = ERO.RO.m{2}]. proof. proc=> /=. -case (mem (dom HybridIROLazy.mp{1}) (xs{1}, i{1})). +case ((dom HybridIROLazy.mp{1}) (xs{1}, i{1})). rcondf{1} 1; first auto. rcondf{2} 2; first auto. rnd{2}; auto; progress; apply dbool_ll. rcondt{1} 1; first auto. rcondt{2} 2; first auto. @@ -419,7 +413,7 @@ local lemma RO_get_HybridIROEager_fill_in : ={res} /\ ERO.RO.m{1} = HybridIROEager.mp{2}]. proof. proc=> /=. -case (mem (dom HybridIROEager.mp{2}) (xs{2}, i{2})). +case (dom HybridIROEager.mp{2} (xs{2}, i{2})). rcondf{1} 2; first auto. rcondf{2} 1; first auto. rnd{1}; auto; progress; apply dbool_ll. rcondt{1} 2; first auto. rcondt{2} 1; first auto. @@ -432,7 +426,7 @@ local lemma RO_sample_HybridIROEager_fill_in : ERO.RO.m{1} = HybridIROEager.mp{2}]. proof. proc=> /=; inline ERO.RO.get; sp. -case (mem (dom HybridIROEager.mp{2}) (xs{2}, i{2})). +case (dom HybridIROEager.mp{2} (xs{2}, i{2})). rcondf{1} 2; first auto. rcondf{2} 1; first auto. rnd{1}; auto; progress; apply dbool_ll. rcondt{1} 2; first auto. rcondt{2} 1; first auto. @@ -533,40 +527,41 @@ pred lazy_invar (mp1 : (bool list * int, bool) fmap, mp2 : (block list * int, bool) fmap) = (forall (bs : bool list, n : int), - mem (dom mp1) (bs, n) <=> mem (dom mp2) (pad2blocks bs, n)) /\ + dom mp1 (bs, n) <=> dom mp2 (pad2blocks bs, n)) /\ (forall (xs : block list, n), - mem (dom mp2) (xs, n) => valid_block xs) /\ + dom mp2 (xs, n) => valid_block xs) /\ (forall (bs : bool list, n : int), - mem (dom mp1) (bs, n) => + dom mp1 (bs, n) => oget mp1.[(bs, n)] = oget mp2.[(pad2blocks bs, n)]). -lemma lazy_invar0 : lazy_invar map0 map0. +lemma lazy_invar0 : lazy_invar empty empty. proof. -split; first smt(in_fset0 dom0). -split; smt(in_fset0 dom0). +split; first smt(mem_empty). +split; first smt(mem_empty). +smt(mem_empty). qed. lemma lazy_invar_mem_pad2blocks_l2r (mp1 : (bool list * int, bool) fmap, mp2 : (block list * int, bool) fmap, bs : bool list, i : int) : - lazy_invar mp1 mp2 => mem (dom mp1) (bs, i) => - mem (dom mp2) (pad2blocks bs, i). + lazy_invar mp1 mp2 => dom mp1 (bs, i) => + dom mp2 (pad2blocks bs, i). proof. smt(). qed. lemma lazy_invar_mem_pad2blocks_r2l (mp1 : (bool list * int, bool) fmap, mp2 : (block list * int, bool) fmap, bs : bool list, i : int) : - lazy_invar mp1 mp2 => mem (dom mp2) (pad2blocks bs, i) => - mem (dom mp1) (bs, i). + lazy_invar mp1 mp2 => dom mp2 (pad2blocks bs, i) => + dom mp1 (bs, i). proof. smt(). qed. lemma lazy_invar_vb (mp1 : (bool list * int, bool) fmap, mp2 : (block list * int, bool) fmap, xs : block list, n : int) : - lazy_invar mp1 mp2 => mem (dom mp2) (xs, n) => + lazy_invar mp1 mp2 => dom mp2 (xs, n) => valid_block xs. proof. smt(). qed. @@ -574,7 +569,7 @@ lemma lazy_invar_lookup_eq (mp1 : (bool list * int, bool) fmap, mp2 : (block list * int, bool) fmap, bs : bool list, n : int) : - lazy_invar mp1 mp2 => mem (dom mp1) (bs, n) => + lazy_invar mp1 mp2 => dom mp1 (bs, n) => oget mp1.[(bs, n)] = oget mp2.[(pad2blocks bs, n)]. proof. smt(). qed. @@ -583,15 +578,15 @@ lemma lazy_invar_upd_mem_dom_iff mp2 : (block list * int, bool) fmap, bs cs : bool list, n m : int, b : bool) : lazy_invar mp1 mp2 => - mem (dom mp1.[(bs, n) <- b]) (cs, m) <=> - mem (dom mp2.[(pad2blocks bs, n) <- b]) (pad2blocks cs, m). + dom mp1.[(bs, n) <- b] (cs, m) <=> + dom mp2.[(pad2blocks bs, n) <- b] (pad2blocks cs, m). proof. move=> li; split=> [mem_upd_mp1 | mem_upd_mp2]. -rewrite domP in_fsetU1; rewrite domP in_fsetU1 in mem_upd_mp1. +rewrite mem_set; rewrite mem_set in mem_upd_mp1. case: ((cs, m) = (bs, n))=> [cs_m_eq_bs_n | cs_m_neq_bs_n]. right; by elim cs_m_eq_bs_n=> -> ->. left; smt(). -rewrite domP in_fsetU1; rewrite domP in_fsetU1 in mem_upd_mp2. +rewrite mem_set; rewrite mem_set in mem_upd_mp2. case: ((cs, m) = (bs, n))=> [// | cs_m_neq_bs_n]. elim mem_upd_mp2=> [/# | [p2b_cs_p2b_bs eq_mn]]. have /# : cs = bs by apply pad2blocks_inj. @@ -602,11 +597,11 @@ lemma lazy_invar_upd2_vb mp2 : (block list * int, bool) fmap, bs : bool list, xs : block list, n m : int, b : bool) : lazy_invar mp1 mp2 => - mem (dom mp2.[(pad2blocks bs, n) <- b]) (xs, m) => + dom mp2.[(pad2blocks bs, n) <- b] (xs, m) => valid_block xs. proof. move=> li mem_upd_mp2. -rewrite domP in_fsetU1 in mem_upd_mp2. +rewrite mem_set in mem_upd_mp2. elim mem_upd_mp2=> [/# | [-> _]]. apply valid_pad2blocks. qed. @@ -616,18 +611,18 @@ lemma lazy_invar_upd_lu_eq mp2 : (block list * int, bool) fmap, bs cs : bool list, n m : int, b : bool) : lazy_invar mp1 mp2 => - mem (dom mp1.[(bs, n) <- b]) (cs, m) => + dom mp1.[(bs, n) <- b] (cs, m) => oget mp1.[(bs, n) <- b].[(cs, m)] = oget mp2.[(pad2blocks bs, n) <- b].[(pad2blocks cs, m)]. proof. move=> li mem_upd_mp1. case: ((cs, m) = (bs, n))=> [[-> ->] | cs_m_neq_bs_n]. -smt(getP_eq). -rewrite domP in_fsetU1 in mem_upd_mp1. +smt(get_setE). +rewrite mem_set in mem_upd_mp1. elim mem_upd_mp1=> [mem_mp1 | [-> ->]]. case: ((pad2blocks bs, n) = (pad2blocks cs, m))=> [[p2b_bs_p2b_cs eq_mn] | p2b_bs_n_neq_p2b_cs_m]. -smt(pad2blocks_inj). smt(getP). smt(getP). +smt(pad2blocks_inj). smt(get_setE). smt(get_setE). qed. lemma LowerFun_IRO_HybridIROLazy_f : @@ -662,7 +657,7 @@ progress; by apply (lazy_invar_mem_pad2blocks_r2l IRO.mp{1} HybridIROLazy.mp{2} x{1} i{2})]. rnd; auto; progress; - [by rewrite !getP_eq | + [by rewrite !get_setE | by rewrite -(lazy_invar_upd_mem_dom_iff IRO.mp{1}) | by rewrite (lazy_invar_upd_mem_dom_iff IRO.mp{1} HybridIROLazy.mp{2}) | by rewrite (lazy_invar_upd2_vb IRO.mp{1} HybridIROLazy.mp{2} @@ -699,7 +694,7 @@ progress; by apply (lazy_invar_mem_pad2blocks_r2l IRO.mp{1} HybridIROLazy.mp{2} x{1} i{2})]. rnd; auto; progress; - [by rewrite !getP_eq | + [by rewrite !get_setE | by rewrite -(lazy_invar_upd_mem_dom_iff IRO.mp{1}) | by rewrite (lazy_invar_upd_mem_dom_iff IRO.mp{1} HybridIROLazy.mp{2}) | by rewrite (lazy_invar_upd2_vb IRO.mp{1} HybridIROLazy.mp{2} @@ -716,21 +711,21 @@ pred eager_invar (mp1 : (block list * int, block) fmap, mp2 : (block list * int, bool) fmap) = (forall (xs : block list, i : int), - mem (dom mp1) (xs, i) => + dom mp1 (xs, i) => 0 <= i /\ (forall (j : int), i * r <= j < (i + 1) * r => mp2.[(xs, j)] = Some(nth false (ofblock (oget mp1.[(xs, i)])) (j - i * r)))) /\ (forall (xs : block list, j : int), - mem (dom mp2) (xs, j) => mem (dom mp1) (xs, j %/ r)). + dom mp2 (xs, j) => dom mp1 (xs, j %/ r)). pred block_bits_all_in_dom (xs : block list, i : int, mp : (block list * int, bool) fmap) = - forall (j : int), i <= j < i + r => mem (dom mp) (xs, j). + forall (j : int), i <= j < i + r => dom mp (xs, j). pred block_bits_all_out_dom (xs : block list, i : int, mp : (block list * int, bool) fmap) = - forall (j : int), i <= j < i + r => ! mem (dom mp) (xs, j). + forall (j : int), i <= j < i + r => ! dom mp (xs, j). pred block_bits_dom_all_in_or_out (xs : block list, i : int, mp : (block list * int, bool) fmap) = @@ -740,23 +735,23 @@ lemma eager_inv_mem_mp1_ge0 (mp1 : (block list * int, block) fmap, mp2 : (block list * int, bool) fmap, xs : block list, i : int) : - eager_invar mp1 mp2 => mem (dom mp1) (xs, i) => 0 <= i. + eager_invar mp1 mp2 => dom mp1 (xs, i) => 0 <= i. proof. move=> [ei1 ei2] mem_mp1_i; smt(). qed. lemma eager_inv_mem_mp2_ge0 (mp1 : (block list * int, block) fmap, mp2 : (block list * int, bool) fmap, xs : block list, j : int) : - eager_invar mp1 mp2 => mem (dom mp2) (xs, j) => 0 <= j. + eager_invar mp1 mp2 => dom mp2 (xs, j) => 0 <= j. proof. move=> [ei1 ei2] mem_mp2_j. -have mem_mp1_j_div_r : mem (dom mp1) (xs, j %/ r) by smt(). +have mem_mp1_j_div_r : dom mp1 (xs, j %/ r) by smt(). have ge0_j_div_r : 0 <= j %/ r by smt(). smt(divz_ge0 gt0_r). qed. -lemma eager_invar0 : eager_invar map0 map0. -proof. split; smt(dom0 in_fset0). qed. +lemma eager_invar0 : eager_invar empty empty. +proof. split; smt(mem_empty). qed. lemma eager_inv_imp_block_bits_dom (mp1 : (block list * int, block) fmap, @@ -766,15 +761,15 @@ lemma eager_inv_imp_block_bits_dom block_bits_dom_all_in_or_out xs i mp2. proof. move=> ge0_i r_dvd_i [ei1 ei2]. -case: (mem (dom mp1) (xs, i %/ r))=> [mem_mp1 | not_mem_mp1]. +case: (dom mp1 (xs, i %/ r))=> [mem_mp1 | not_mem_mp1]. have ei1_xs_i_div_r := ei1 xs (i %/ r). have [_ mp2_eq_block_bits] := ei1_xs_i_div_r mem_mp1. left=> j j_rng. have mp2_eq_block_bits_j := mp2_eq_block_bits j _. by rewrite divzK // mulzDl /= divzK. -rewrite in_dom /#. +rewrite domE /#. right=> j j_rng. -case: (mem (dom mp2) (xs, j))=> // mem_mp2 /=. +case: (dom mp2 (xs, j))=> // mem_mp2 /=. have mem_mp1 := ei2 xs j mem_mp2. have [k] [k_ran j_eq_i_plus_k] : exists k, 0 <= k < r /\ j = i + k by exists (j - i); smt(). @@ -786,12 +781,12 @@ lemma eager_inv_mem_dom1 (mp1 : (block list * int, block) fmap, mp2 : (block list * int, bool) fmap, xs : block list, i : int) : - eager_invar mp1 mp2 => mem (dom mp1) (xs, i) => + eager_invar mp1 mp2 => dom mp1 (xs, i) => block_bits_all_in_dom xs (i * r) mp2. proof. move=> [ei1 _] mem j j_ran. have [ge0_i eq_mp2_block_i] := ei1 xs i mem. -rewrite in_dom. +rewrite domE. have /# := eq_mp2_block_i j _; smt(). qed. @@ -799,11 +794,11 @@ lemma eager_inv_not_mem_dom1 (mp1 : (block list * int, block) fmap, mp2 : (block list * int, bool) fmap, xs : block list, i : int) : - eager_invar mp1 mp2 => 0 <= i => ! mem (dom mp1) (xs, i) => + eager_invar mp1 mp2 => 0 <= i => ! dom mp1 (xs, i) => block_bits_all_out_dom xs (i * r) mp2. proof. move=> [_ ei2] ge0_i not_mem_mp1_i j j_ran. -case (mem (dom mp2) (xs, j))=> // mem_mp2_j. +case (dom mp2 (xs, j))=> // mem_mp2_j. have mem_mp1_j_div_r := ei2 xs j mem_mp2_j. have /# : j %/ r = i. have [k] [k_ran ->] : exists k, 0 <= k < r /\ j = i * r + k @@ -814,13 +809,13 @@ qed. lemma block_bits_dom_first_in_imp_all_in (xs : block list, i : int, mp : (block list * int, bool) fmap) : - block_bits_dom_all_in_or_out xs i mp => mem (dom mp) (xs, i) => + block_bits_dom_all_in_or_out xs i mp => dom mp (xs, i) => block_bits_all_in_dom xs i mp. proof. smt(). qed. lemma block_bits_dom_first_out_imp_all_out (xs : block list, i : int, mp : (block list * int, bool) fmap) : - block_bits_dom_all_in_or_out xs i mp => ! mem (dom mp) (xs, i) => + block_bits_dom_all_in_or_out xs i mp => ! dom mp (xs, i) => block_bits_all_out_dom xs i mp. proof. smt(). qed. @@ -871,7 +866,7 @@ module HybridIROEagerTrans = { proc next_block_split(xs, i, m : int, bs) = { var b, j, cs; - if (mem (dom HybridIROEager.mp) (xs, i)) { + if (dom HybridIROEager.mp (xs, i)) { while (i < m) { b <- oget HybridIROEager.mp.[(xs, i)]; bs <- rcons bs b; @@ -920,8 +915,8 @@ lemma eager_eq_except_mem_iff mp1 mp2 : (block list * int, bool) fmap) : eager_eq_except xs i j mp1 mp2 => ys <> xs \/ k < i \/ j <= k => - mem (dom mp1) (ys, k) <=> mem (dom mp2) (ys, k). -proof. smt(in_dom get_oget). qed. + dom mp1 (ys, k) <=> dom mp2 (ys, k). +proof. smt(domE get_some). qed. lemma eager_eq_except_upd1_eq_in (xs : block list, i j k : int, y : bool, @@ -931,7 +926,7 @@ lemma eager_eq_except_upd1_eq_in proof. move=> eee le_ik lt_kj ys l disj. have ne : (xs, k) <> (ys, l) by smt(). -smt(getP). +smt(get_setE). qed. lemma eager_eq_except_upd2_eq_in @@ -942,7 +937,7 @@ lemma eager_eq_except_upd2_eq_in proof. move=> eee le_ik lt_kj ys l disj. have ne : (xs, k) <> (ys, l) by smt(). -smt(getP). +smt(get_setE). qed. lemma eager_eq_except_maps_eq @@ -954,7 +949,7 @@ lemma eager_eq_except_maps_eq mp1 = mp2. proof. move=> lt_ij eee ran_k. -apply fmapP=> p. +apply fmap_eqP=> p. have [ys k] -> /# : exists ys k, p = (ys, k) by exists p.`1 p.`2; smt(). qed. @@ -977,12 +972,12 @@ case: (xs = ys)=> [eq_xs_ys | ne_xs_ys]. case: (k = i)=> [eq_k_i | ne_k_i]. split; first smt(). move=> j j_ran. -by rewrite -eq_xs_ys eq_k_i getP_eq mp2'_ran_eq -eq_k_i. -rewrite domP in_fsetU1 in mem_mp1_upd_xs_i_y_ys_k. +by rewrite -eq_xs_ys eq_k_i get_set_sameE mp2'_ran_eq -eq_k_i. +rewrite domE in mem_mp1_upd_xs_i_y_ys_k. have xs_i_ne_ys_k : (xs, i) <> (ys, k) by smt(). -have mem_mp1_ys_k : mem (dom mp1) (ys, k) by smt(). +have mem_mp1_ys_k : dom mp1 (ys, k) by smt(get_setE). split; first smt(eager_inv_mem_mp2_ge0). -move=> j j_ran; rewrite getP. +move=> j j_ran; rewrite get_setE. have -> /= : (ys, k) <> (xs, i) by smt(). have [_ ei1_ys_k_snd] := ei1 ys k mem_mp1_ys_k. have <- : @@ -999,31 +994,31 @@ have /# : j < i * r \/ (i + 1) * r <= j. have le_i_add1_k : i + 1 <= k by rewrite addzC lez_add1r. rewrite (lez_trans (k * r)) 1:ler_pmul2r 1:gt0_r // /#. -rewrite domP in_fsetU1 in mem_mp1_upd_xs_i_y_ys_k. +rewrite domE in mem_mp1_upd_xs_i_y_ys_k. have xs_i_ne_ys_k : (xs, i) <> (ys, k) by smt(). -have mem_mp1_ys_k : mem (dom mp1) (ys, k) by smt(). +have mem_mp1_ys_k : dom mp1 (ys, k) by smt(get_setE). split; first smt(eager_inv_mem_mp2_ge0). -move=> j j_ran; rewrite getP. +move=> j j_ran; rewrite get_setE. have -> /= : (ys, k) <> (xs, i) by smt(). have [_ ei1_ys_k_snd] := ei1 ys k mem_mp1_ys_k. have <- /# : mp2.[(ys, j)] = Some (nth false (ofblock (oget mp1.[(ys, k)])) (j - k * r)) by rewrite ei1_ys_k_snd. -rewrite domP in_fsetU1. +rewrite domE. case: (xs = ys)=> [-> | ne_xs_ys]. case: (k < i * r)=> [lt_k_i_tim_r | not_lt_k_i_tim_r]. -smt(eager_eq_except_mem_iff). +smt(get_setE eager_eq_except_mem_iff). case: ((i + 1) * r <= k)=> [i_add1_tim_r_le_k | not_i_add1_tim_r_le_k]. -smt(eager_eq_except_mem_iff). -right. +smt(get_setE eager_eq_except_mem_iff). have le_i_tim_r_k : i * r <= k by smt(). have lt_k_i_add1_tim_r : k < (i + 1) * r by smt(). have -> // : i = k %/ r. apply eqz_leq; split. by rewrite lez_divRL 1:gt0_r. by rewrite -ltzS ltz_divLR 1:gt0_r. -smt(eager_eq_except_mem_iff). +smt(get_setE eager_eq_except_mem_iff). +smt(get_setE eager_eq_except_mem_iff). qed. lemma HybridIROEagerTrans_next_block_split : @@ -1035,27 +1030,27 @@ lemma HybridIROEagerTrans_next_block_split : ={res, HybridIROEager.mp}]. proof. proc=> /=. -case (mem (dom HybridIROEager.mp{2}) (xs{2}, i{2})). -(* mem (dom HybridIROEager.mp{2}) (xs{2}, i{2}) *) +case (dom HybridIROEager.mp{2} (xs{2}, i{2})). +(* dom HybridIROEager.mp{2} (xs{2}, i{2}) *) rcondt{2} 1; first auto. conseq (_ : ={i, m, xs, bs, HybridIROEager.mp} /\ i{1} <= m{1} /\ (forall (j : int), i{1} <= j < m{1} => - mem (dom HybridIROEager.mp{1}) (xs{1}, j)) ==> + dom HybridIROEager.mp{1} (xs{1}, j)) ==> _). progress; smt(gt0_r). while (={i, m, xs, bs, HybridIROEager.mp} /\ i{1} <= m{1} /\ (forall (j : int), i{1} <= j < m{1} => - mem (dom HybridIROEager.mp{1}) (xs{1}, j))). + dom HybridIROEager.mp{1} (xs{1}, j))). wp; inline*. rcondf{1} 3; first auto; smt(). auto; smt(). auto. -(* ! mem (dom HybridIROEager.mp{2}) (xs{2}, i{2}) *) +(* ! dom HybridIROEager.mp{2} (xs{2}, i{2}) *) rcondf{2} 1; first auto. sp; exists* i{1}; elim*=> i'. conseq @@ -1064,7 +1059,7 @@ conseq i' + r = m{1} /\ size bs{1} = i' /\ cs{2} = [] /\ j{2} = 0 /\ (forall (j : int), i' <= j < i' + r => - ! mem (dom HybridIROEager.mp{1}) (xs{1}, j)) ==> + ! dom HybridIROEager.mp{1} (xs{1}, j)) ==> _). progress; smt(gt0_r). seq 1 2 : @@ -1084,7 +1079,7 @@ while HybridIROEager.mp{1}.[(xs{1}, k)] = Some(nth true bs{1} k)) /\ (forall (k : int), i{1} <= k < i' + r => - ! mem (dom HybridIROEager.mp{1}) (xs{1}, k)) /\ + ! dom HybridIROEager.mp{1} (xs{1}, k)) /\ eager_eq_except xs{1} i' (i' + r) HybridIROEager.mp{1} HybridIROEager.mp{2}). inline*; rcondt{1} 3; first auto; smt(). sp; wp; rnd; skip; progress. @@ -1092,13 +1087,14 @@ smt(size_cat). smt(size_cat). smt(size_cat). smt(size_rcons size_cat). smt(size_cat). rewrite -cats1; smt(size_cat). rewrite -2!cats1 catA; congr; congr. -by rewrite getP_eq oget_some. +by rewrite get_set_sameE oget_some. rewrite nth_rcons /=. case: (k = size (bs{2} ++ cs{2}))=> [-> /= | ne_k_size_bs_cat_cs]. -by rewrite getP_eq oget_some. +by rewrite get_set_sameE oget_some. have -> /= : k < size(bs{2} ++ cs{2}) by smt(). -rewrite getP ne_k_size_bs_cat_cs /= /#. -rewrite domP in_fsetU1 /#. +rewrite get_setE ne_k_size_bs_cat_cs /= /#. +rewrite -mem_fdom fdom_set in_fsetU1 mem_fdom negb_or. +have lt_sz_k : size (bs{2} ++ cs{2}) < k; smt(). by apply eager_eq_except_upd1_eq_in. smt(size_cat). smt(size_cat). skip; progress; smt(gt0_r cats0 size_cat). @@ -1125,7 +1121,7 @@ while{2} HybridIROEager.mp{1} HybridIROEager.mp{2}) (m{2} - i{2}). progress; auto; progress; - [smt() | smt(gt0_r) | smt(getP) | smt() | + [smt() | smt(gt0_r) | smt(get_setE) | smt() | by apply eager_eq_except_upd2_eq_in | smt()]. skip; progress; [smt(gt0_r) | smt() | smt() | smt() | smt(eager_eq_except_maps_eq)]. @@ -1289,8 +1285,8 @@ rewrite i1_eq_i2_tim_r mulr_ge0 // ge0_r. rewrite i1_eq_i2_tim_r dvdz_mull dvdzz. apply HybridIROEagerTrans_next_block_split. proc=> /=; inline*; sp; wp. -case (mem (dom BlockSponge.BIRO.IRO.mp{2}) (x0{2}, n{2})). -(* mem (dom BlockSponge.BIRO.IRO.mp{2}) (x0{2}, n{2}) *) +case (dom BlockSponge.BIRO.IRO.mp{2} (x0{2}, n{2})). +(* dom BlockSponge.BIRO.IRO.mp{2} (x0{2}, n{2}) *) rcondf{2} 1; first auto. rcondt{1} 1; first auto; progress [-delta]. have bb_all_in : @@ -1303,7 +1299,7 @@ conseq i1 = i{1} /\ 0 <= i2 /\ i1 = i2 * r /\ m{1} - i1 = r /\ bs1 = bs{1} /\ size bs{2} = i2 /\ size bs1 = i1 /\ bs1 = blocks2bits bs{2} /\ - mem (dom BlockSponge.BIRO.IRO.mp{2}) (xs{1}, i2) /\ + dom BlockSponge.BIRO.IRO.mp{2} (xs{1}, i2) /\ eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> bs{1} = blocks2bits (rcons bs{2} (oget BlockSponge.BIRO.IRO.mp{2}.[(xs{1}, i2)])) /\ @@ -1316,7 +1312,7 @@ while{1} bs1 ++ take (i{1} - i1) (ofblock (oget(BlockSponge.BIRO.IRO.mp{2}.[(xs{1}, i2)]))) /\ - mem (dom BlockSponge.BIRO.IRO.mp{2}) (xs{1}, i2) /\ + dom BlockSponge.BIRO.IRO.mp{2} (xs{1}, i2) /\ eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}) (m{1} - i{1}). move=> &m z. @@ -1354,7 +1350,7 @@ pose blk := (oget BlockSponge.BIRO.IRO.mp{2}.[(xs{1}, i2)]). have -> : r = size (ofblock blk) by rewrite size_block. by rewrite take_size. split; smt(). -(* ! mem (dom BlockSponge.BIRO.IRO.mp{2}) (x0{2}, n{2}) *) +(* ! dom BlockSponge.BIRO.IRO.mp{2} (x0{2}, n{2}) *) rcondt{2} 1; first auto. rcondf{1} 1; first auto; progress [-delta]. have bb_all_not_in : block_bits_all_out_dom x{m} (size bs{m} * r) HybridIROEager.mp{hr} @@ -1409,7 +1405,7 @@ conseq progress; [by rewrite ofblockK | rewrite size_cat size_blocks2bits /#]. progress; - [by rewrite -cats1 blocks2bits_cat blocks2bits_sing getP_eq + [by rewrite -cats1 blocks2bits_cat blocks2bits_sing get_set_sameE oget_some ofblockK | by rewrite size_rcons]. while{1} @@ -1428,8 +1424,8 @@ split. split; first smt(). split; first smt(eager_eq_except_upd2_eq_in). move=> j i1_le_j j_lt_i_add1. case: (i{hr} = j)=> [-> | ne_ij]. -rewrite getP /=; smt(nth_onth onth_nth). -rewrite getP. +rewrite get_setE /=; smt(nth_onth onth_nth). +rewrite get_setE. have -> /= : (xs{hr}, j) <> (xs{hr}, i{hr}) by smt(). rewrite mp_ran_eq /#. smt(). @@ -1927,13 +1923,13 @@ local lemma Ideal_IRO_Experiment_HybridLazy &m : proof. byequiv=> //; proc. seq 2 2 : - (={glob Dist, glob BlockSim} /\ IRO.mp{1} = NewFMap.map0 /\ - HIRO.HybridIROLazy.mp{2} = NewFMap.map0). + (={glob Dist, glob BlockSim} /\ IRO.mp{1} = empty /\ + HIRO.HybridIROLazy.mp{2} = empty). inline*; wp; call (_ : true); auto. call (_ : ={glob Dist, glob BlockSim} /\ - IRO.mp{1} = map0 /\ HIRO.HybridIROLazy.mp{2} = map0 ==> + IRO.mp{1} = empty /\ HIRO.HybridIROLazy.mp{2} = empty ==> ={res}). proc (={glob BlockSim} /\ @@ -2045,13 +2041,13 @@ local lemma Experiment_HybridEager_Ideal_BlockIRO &m : proof. byequiv=> //; proc. seq 2 2 : - (={glob Dist, glob BlockSim} /\ HIRO.HybridIROEager.mp{1} = NewFMap.map0 /\ - BlockSponge.BIRO.IRO.mp{2} = NewFMap.map0). + (={glob Dist, glob BlockSim} /\ HIRO.HybridIROEager.mp{1} = empty /\ + BlockSponge.BIRO.IRO.mp{2} = empty). inline*; wp; call (_ : true); auto. call (_ : ={glob Dist, glob BlockSim} /\ - HIRO.HybridIROEager.mp{1} = map0 /\ BlockSponge.BIRO.IRO.mp{2} = map0 ==> + HIRO.HybridIROEager.mp{1} = empty /\ BlockSponge.BIRO.IRO.mp{2} = empty ==> ={res}). proc (={glob BlockSim} /\ From cce39d8f6301140176e9f9c35193559b67641132 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Tue, 18 Sep 2018 18:33:10 +0200 Subject: [PATCH 319/525] updating complete --- proof/SHA3-Security.ec | 24 ++++++++++++------------ proof/smart_counter/Gconcl_list.ec | 2 -- 2 files changed, 12 insertions(+), 14 deletions(-) diff --git a/proof/SHA3-Security.ec b/proof/SHA3-Security.ec index 3cbd007..3116fcd 100644 --- a/proof/SHA3-Security.ec +++ b/proof/SHA3-Security.ec @@ -1,6 +1,6 @@ (* Top-level Proof of SHA-3 Security *) -require import AllCore List IntDiv StdOrder Distr NewFMap FSet. +require import AllCore List IntDiv StdOrder Distr SmtMap FSet. require import Common Sponge. import BIRO. @@ -27,15 +27,15 @@ module Simulator (F : DFUNCTIONALITY) = { var mi : (state, state) fmap var paths : (capacity, block list * block) fmap proc init() = { - m <- map0; - mi <- map0; - paths <- map0.[c0 <- ([],b0)]; + m <- empty; + mi <- empty; + paths <- empty.[c0 <- ([],b0)]; Gconcl_list.BIRO2.IRO.init(); } proc f (x : state) : state = { var p,v,z,q,k,cs,y,y1,y2; - if (! x \in dom m) { - if (x.`2 \in dom paths) { + if (x \notin m) { + if (x.`2 \in paths) { (p,v) <- oget paths.[x.`2]; z <- []; (q,k) <- parse (rcons p (v +^ x.`1)); @@ -53,7 +53,7 @@ module Simulator (F : DFUNCTIONALITY) = { y <- (y1,y2); m.[x] <- y; mi.[y] <- x; - if (x.`2 \in dom paths) { + if (x.`2 \in paths) { (p,v) <-oget paths.[x.`2]; paths.[y2] <- (rcons p (v +^ x.`1),y.`1); } @@ -64,7 +64,7 @@ module Simulator (F : DFUNCTIONALITY) = { } proc fi (x : state) : state = { var y,y1,y2; - if (! x \in dom mi) { + if (! x \in mi) { y1 <$ bdistr; y2 <$ cdistr; y <- (y1,y2); @@ -276,13 +276,13 @@ qed. lemma security &m : `|Pr[RealIndif(Sponge, Perm, DRestr(Dist)).main() @ &m : res] - Pr[IdealIndif(IRO, Simulator, DRestr(Dist)).main() @ &m : res]| <= - (limit ^ 2)%r / (2 ^ (r + c + 1))%r + (4 * limit ^ 2)%r / (2 ^ c)%r. + (limit ^ 2 - limit)%r / (2 ^ (r + c + 1))%r + (4 * limit ^ 2)%r / (2 ^ c)%r. proof. rewrite -(replace_simulator &m). rewrite powS 1:addz_ge0 1:ge0_r 1:ge0_c -pow_add 1:ge0_r 1:ge0_c. have -> : - (limit ^ 2)%r / (2 * (2 ^ r * 2 ^ c))%r = - ((limit ^ 2)%r / 2%r) * (1%r / (2 ^ r)%r) * (1%r / (2 ^ c)%r). + (limit ^ 2 - limit)%r / (2 * (2 ^ r * 2 ^ c))%r = + ((limit ^ 2 - limit)%r / 2%r) * (1%r / (2 ^ r)%r) * (1%r / (2 ^ c)%r). rewrite (fromintM 2) StdRing.RField.invfM StdRing.RField.mulrA -!StdRing.RField.mulrA. congr. @@ -325,7 +325,7 @@ lemma SHA3Security islossless Dist(F,P).distinguish) => `|Pr[RealIndif(Sponge, Perm, DRestr(Dist)).main() @ &m : res] - Pr[IdealIndif(IRO, Simulator, DRestr(Dist)).main() @ &m : res]| <= - (limit ^ 2)%r / (2 ^ (r + c + 1))%r + (4 * limit ^ 2)%r / (2 ^ c)%r. + (limit ^ 2 - limit)%r / (2 ^ (r + c + 1))%r + (4 * limit ^ 2)%r / (2 ^ c)%r. proof. move=>h;apply (security Dist h &m). qed. diff --git a/proof/smart_counter/Gconcl_list.ec b/proof/smart_counter/Gconcl_list.ec index 844dcfd..32e7e8d 100644 --- a/proof/smart_counter/Gconcl_list.ec +++ b/proof/smart_counter/Gconcl_list.ec @@ -380,8 +380,6 @@ section Ideal. by auto;smt(parse_valid parseK formatK). qed. - require import JointFMap. - inductive inv_L_L3 (m1 m2 m3 : (block list, block) fmap) = | INV of (m1 = m2 + m3) & (forall l, l \in m2 => valid (parse l).`1) From 4dad63501e619371c1b7a4bc8e0387eb71c37be6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Tue, 18 Sep 2018 19:38:09 +0100 Subject: [PATCH 320/525] cleaning files out and reactivating CI --- .gitlab-ci.yml | 6 +- proof/Common.ec | 6 +- proof/NewFMap.ec | 818 --------------------------- proof/RP.eca | 79 --- proof/RndO.ec | 699 ----------------------- proof/SHA3-Security.ec | 8 +- proof/smart_counter/Handle.eca | 52 +- proof/smart_counter/JointFMap.ec | 19 - proof/smart_counter/Strong_rp_rf.eca | 608 -------------------- 9 files changed, 50 insertions(+), 2245 deletions(-) delete mode 100644 proof/NewFMap.ec delete mode 100644 proof/RP.eca delete mode 100644 proof/RndO.ec delete mode 100644 proof/smart_counter/JointFMap.ec delete mode 100644 proof/smart_counter/Strong_rp_rf.eca diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index da33dc6..067b104 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -5,13 +5,13 @@ services: - docker:dind before_script: - docker info -- docker pull easycryptpa/ec-test-box:sha3 +- docker pull easycryptpa/ec-test-box sha3: only: - - none + - master script: - >- - docker run -v $PWD:/home/ci/sha3 easycryptpa/ec-test-box:sha3 + docker run -v $PWD:/home/ci/sha3 easycryptpa/ec-test-box sh -c 'cd sha3 && opam config exec -- make check' artifacts: when: on_failure diff --git a/proof/Common.ec b/proof/Common.ec index d8f6046..65f6c06 100644 --- a/proof/Common.ec +++ b/proof/Common.ec @@ -98,13 +98,13 @@ proof. by move=> s_cs_r s_ds_r; split=> //=; exact/mkblock_pinj. qed. lemma last_drop_all_but_last (y : 'a, xs : 'a list) : xs = [] \/ drop (size xs - 1) xs = [last y xs]. proof. -elim xs=> // z zs ih /=; have -> : 1 + size zs - 1 = size zs by ring. +elim xs=> // z zs ih /=. case (size zs <= 0)=> [le0_sz_zs | gt0_sz_zs]. have sz_zs_eq0 : size zs = 0 by rewrite (@ler_asym (size zs) 0); split=> // _; rewrite size_ge0. by have -> : zs = [] by rewrite -size_eq0. -case (zs = [])=> // zs_non_nil. elim ih=> // ->. -by rewrite (@last_nonempty y z). +case (zs = [])=> // zs_non_nil. elim ih=> //. +by rewrite addzC (@last_nonempty y z). qed. (*------------------------------ Primitive -----------------------------*) diff --git a/proof/NewFMap.ec b/proof/NewFMap.ec deleted file mode 100644 index 6d5b089..0000000 --- a/proof/NewFMap.ec +++ /dev/null @@ -1,818 +0,0 @@ -(* -------------------------------------------------------------------- - * Copyright (c) - 2012--2016 - IMDEA Software Institute - * Copyright (c) - 2012--2018 - Inria - * Copyright (c) - 2012--2018 - Ecole Polytechnique - * - * Distributed under the terms of the CeCILL-B-V1 license - * -------------------------------------------------------------------- *) - -(* -------------------------------------------------------------------- *) -require import AllCore Int List FSet. - -pragma -oldip. -pragma +implicits. - -(* -------------------------------------------------------------------- *) -lemma perm_eq_uniq_map (f : 'a -> 'b) (s1 s2 : 'a list): - perm_eq s1 s2 => uniq (map f s1) <=> uniq (map f s2). -proof. by move=> /(perm_eq_map f) /perm_eq_uniq ->. qed. - -lemma uniq_perm_eq_map (s1 s2 : ('a * 'b) list) (f: 'a * 'b -> 'c): - uniq (map f s1) => uniq (map f s2) - => (forall (x : 'a * 'b), mem s1 x <=> mem s2 x) - => perm_eq s1 s2. -proof. by move=> /uniq_map h1 /uniq_map h2 /(uniq_perm_eq _ _ h1 h2). qed. - -(* -------------------------------------------------------------------- *) -op augment (s : ('a * 'b) list) (kv : 'a * 'b) = - if mem (map fst s) kv.`1 then s else rcons s kv. - -lemma nosmt augment_nil (kv : 'a * 'b): augment [] kv = [kv]. -proof. by []. qed. - -lemma augmentP (s : ('a * 'b) list) x y: - ( mem (map fst s) x /\ augment s (x, y) = s) - \/ (! mem (map fst s) x /\ augment s (x, y) = rcons s (x, y)). -proof. by case: (mem (map fst s) x)=> //=; rewrite /augment => ->. qed. - -op reduce (xs : ('a * 'b) list): ('a * 'b) list = - foldl augment [] xs. - -lemma reduce_nil: reduce [<:'a * 'b>] = []. -proof. by []. qed. - -lemma nosmt reduce_cat (r s : ('a * 'b) list): - foldl augment r s - = r ++ filter (predC (mem (map fst r)) \o fst) (foldl augment [] s). -proof. -rewrite -(@revK s) !foldl_rev; pose f := fun x z => augment z x. -elim/last_ind: s r => /=. - by move=> r; rewrite !rev_nil /= cats0. -move=> s [x y] ih r; rewrite !rev_rcons /= ih => {ih}. -rewrite {1}/f {1}/augment map_cat mem_cat /=. -pose t1 := map fst _; pose t2 := map fst _. -case: (mem t1 x \/ mem t2 x) => //; last first. - rewrite negb_or => -[t1_x t2_x]; rewrite rcons_cat; congr. - rewrite {2}/f /augment /=; pose t := map fst _. - case: (mem t x) => h; last first. - by rewrite filter_rcons /= /(\o) /predC t1_x. - have: mem t2 x; rewrite // /t2 /(\o). - have <- := filter_map<:'a, 'a * 'b> fst (predC (mem t1)). - by rewrite mem_filter /predC t1_x. -case=> h; congr; rewrite {2}/f /augment /=; last first. - move: h; rewrite /t2 => /mapP [z] [h ->>]. - by move: h; rewrite mem_filter => -[_ /(map_f fst) ->]. -case: (List.mem _ _) => //=; rewrite filter_rcons. -by rewrite /(\o) /predC h. -qed. - -lemma reduce_cons (x : 'a) (y : 'b) s: - reduce ((x, y) :: s) - = (x, y) :: filter (predC1 x \o fst) (reduce s). -proof. by rewrite {1}/reduce /= augment_nil reduce_cat cat1s. qed. - -lemma assoc_reduce (s : ('a * 'b) list): - forall x, assoc (reduce s) x = assoc s x. -proof. -move=> x; elim: s => //; case=> x' y' s ih. -rewrite reduce_cons !assoc_cons; case: (x = x')=> // ne_xx'. -by rewrite assoc_filter /predC1 ne_xx'. -qed. - -lemma dom_reduce (s : ('a * 'b) list): - forall x, mem (map fst (reduce s)) x <=> mem (map fst s) x. -proof. -move=> x; elim: s => [|[x' y] s ih] /=; 1: by rewrite reduce_nil. -rewrite reduce_cons /=; apply/orb_id2l. -rewrite /(\o) /= => ne_xx'. -by rewrite -(@filter_map _ (predC1 x')) mem_filter /predC1 ne_xx' /= ih. -qed. - -lemma reduced_reduce (s : ('a * 'b) list): uniq (map fst (reduce s)). -proof. -elim: s => [|[x y] s ih]; 1: by rewrite reduce_nil. -rewrite reduce_cons /= ; split. -+ by apply/negP=> /mapP [[x' y']]; rewrite mem_filter=> -[# h1 h2 ->>]. -rewrite /(\o); have <- := filter_map fst<:'a, 'b> (predC1 x). -by rewrite filter_uniq. -qed. - -lemma reduce_reduced (s : ('a * 'b) list): - uniq (map fst s) => reduce s = s. -proof. -elim: s => [|[x y] s ih]; 1: by rewrite reduce_nil. -rewrite reduce_cons /= => -[x_notin_s /ih ->]. -rewrite (@eq_in_filter _ predT) ?filter_predT /predT //=. -case=> x' y' /(map_f fst) x'_in_s; apply/negP => <<-. -by move: x_notin_s. -qed. - -lemma reduceK (xs : ('a * 'b) list): reduce (reduce xs) = reduce xs. -proof. by rewrite reduce_reduced 1:reduced_reduce. qed. - -lemma mem_reduce_head (xs : ('a * 'b) list) a b: - mem (reduce ((a, b) :: xs)) (a, b). -proof. by rewrite reduce_cons. qed. - -(* -------------------------------------------------------------------- *) -(* Finite maps are abstractely represented as the quotient by *) -(* [perm_eq] of lists of pairs without first projection duplicates. *) - -type ('a, 'b) fmap. - -op elems : ('a, 'b) fmap -> ('a * 'b) list. -op oflist : ('a * 'b) list -> ('a,'b) fmap. - -axiom elemsK (m : ('a, 'b) fmap) : Self.oflist (elems m) = m. -axiom oflistK (s : ('a * 'b) list): perm_eq (reduce s) (elems (Self.oflist s)). - -lemma uniq_keys (m : ('a, 'b) fmap): uniq (map fst (elems m)). -proof. -rewrite -elemsK; move: (elems m) => {m} m. -apply (@perm_eq_uniq (map fst (reduce m)) _). -+ by apply perm_eq_map; apply oflistK. -by apply reduced_reduce. -qed. - -axiom fmap_eq (s1 s2 : ('a,'b) fmap): - (perm_eq (elems s1) (elems s2)) <=> (s1 = s2). - -(* -------------------------------------------------------------------- *) -lemma fmapW (p : ('a, 'b) fmap -> bool): - (forall m, uniq (map fst m) => p (Self.oflist m)) - => forall m, p m. -proof. by move=> ih m; rewrite -elemsK; apply/ih/uniq_keys. qed. - -(* -------------------------------------------------------------------- *) -op "_.[_]" (m : ('a,'b) fmap) (x : 'a) = assoc (elems m) x - axiomatized by getE. - -lemma get_oflist (s : ('a * 'b) list): - forall x, (Self.oflist s).[x] = assoc s x. -proof. -move=> x; rewrite getE; rewrite -(@assoc_reduce s). -apply/eq_sym/perm_eq_assoc; 1: by apply/uniq_keys. -by apply/oflistK. -qed. - -lemma fmapP (m1 m2 : ('a,'b) fmap): - (m1 = m2) <=> (forall x, m1.[x] = m2.[x]). -proof. -split=> // h; apply/fmap_eq/uniq_perm_eq; ~3:by apply/(@uniq_map fst)/uniq_keys. -case=> x y; move: (h x); rewrite !getE => {h} h. -by rewrite !mem_assoc_uniq ?uniq_keys // h. -qed. - -(* -------------------------------------------------------------------- *) -op map0 ['a,'b] = Self.oflist [<:'a * 'b>] axiomatized by map0E. - -(* -------------------------------------------------------------------- *) -op "_.[_<-_]" (m : ('a, 'b) fmap) (a : 'a) (b : 'b) = - Self.oflist (reduce ((a, b) :: elems m)) - axiomatized by setE. - -lemma getP (m : ('a, 'b) fmap) (a : 'a) (b : 'b) (x : 'a): - m.[a <- b].[x] = if x = a then Some b else m.[x]. -proof. -by rewrite setE get_oflist assoc_reduce assoc_cons getE; case: (x = a). -qed. - -lemma getP_eq (m : ('a, 'b) fmap) (a : 'a) (b : 'b): - m.[a <- b].[a] = Some b. -proof. by rewrite getP. qed. - -lemma getP_neq (m : ('a, 'b) fmap) (a1 a2 : 'a) (b : 'b): - a1 <> a2 => - m.[a1 <- b].[a2] = m.[a2]. -proof. by rewrite getP eq_sym=> ->. qed. - -lemma set_set (m : ('a,'b) fmap) x x' y y': - m.[x <- y].[x' <- y'] = if x = x' then m.[x' <- y'] - else m.[x' <- y'].[x <- y]. -proof. -rewrite fmapP=> a; case (x = x')=> [<<- {x'} | ne_x_x']; rewrite !getP. -+ by case (a = x). -by case (a = x')=> //; case (a = x)=> // ->;rewrite ne_x_x'. -qed. - -lemma nosmt set_set_eq y (m : ('a, 'b) fmap) x y': - m.[x <- y].[x <- y'] = m.[x <- y']. -proof. by rewrite fmapP=> a; rewrite set_set. qed. - -(* -------------------------------------------------------------------- *) -op rem (a : 'a) (m : ('a, 'b) fmap) = - Self.oflist (filter (predC1 a \o fst) (elems m)) - axiomatized by remE. - -lemma remP (a : 'a) (m : ('a, 'b) fmap): - forall x, (rem a m).[x] = if x = a then None else m.[x]. -proof. -move=> x; rewrite remE get_oflist assoc_filter; case (x = a)=> //=. -by rewrite /predC1 getE=> ->. -qed. - -(* -------------------------------------------------------------------- *) -op dom ['a 'b] (m : ('a, 'b) fmap) = - FSet.oflist (map fst (elems m)) - axiomatized by domE. - -lemma dom_oflist (s : ('a * 'b) list): - forall x, mem (dom (Self.oflist s)) x <=> mem (map fst s) x. -proof. -move=> x; rewrite domE mem_oflist. -have/perm_eq_sym/(perm_eq_map fst) := oflistK s. -by move/perm_eq_mem=> ->; apply/dom_reduce. -qed. - -lemma mem_domE (m : ('a, 'b) fmap) x: - mem (dom m) x <=> mem (map fst (elems m)) x. -proof. by rewrite domE mem_oflist. qed. - -lemma in_dom (m : ('a, 'b) fmap) x: - mem (dom m) x <=> m.[x] <> None. -proof. -rewrite mem_domE getE. -by case: (assocP (elems m) x)=> [[-> [y [_ ->]]] | [-> ->]]. -qed. - -lemma fmap_domP (m1 m2 : ('a, 'b) fmap): - (m1 = m2) <=> (forall x, mem (dom m1) x = mem (dom m2) x) - /\ (forall x, mem (dom m1) x => m1.[x] = m2.[x]). -proof. -split=> // [[]] eq_dom eq_on_dom. -apply fmapP=> x; case: (mem (dom m1) x). -+ by apply eq_on_dom. -move=> ^; rewrite {2}eq_dom !in_dom /=. -by move=> -> ->. -qed. - -lemma get_oget (m:('a,'b)fmap) (x:'a) : - mem (dom m) x => m.[x] = Some (oget m.[x]). -proof. by rewrite in_dom; case: (m.[x]). qed. - -(* -------------------------------------------------------------------- *) -op rng ['a 'b] (m : ('a, 'b) fmap) = - FSet.oflist (map snd (elems m)) - axiomatized by rngE. - -lemma mem_rngE (m : ('a, 'b) fmap) y: - mem (rng m) y <=> mem (map snd (elems m)) y. -proof. by rewrite rngE mem_oflist. qed. - -lemma in_rng (m: ('a,'b) fmap) (b : 'b): - mem (rng m) b <=> (exists a, m.[a] = Some b). -proof. -rewrite mem_rngE; split. -+ move/List.mapP=> [] [x y] [h ->]; exists x. - by rewrite getE -mem_assoc_uniq 1:uniq_keys. -case=> x; rewrite getE -mem_assoc_uniq ?uniq_keys // => h. -by apply/List.mapP; exists (x, b). -qed. - -(* -------------------------------------------------------------------- *) -op has (p : 'a -> 'b -> bool) (m : ('a, 'b) fmap) = - List.has (fun (x : 'a * 'b), p x.`1 x.`2) (elems m) - axiomatized by hasE. - -lemma hasP p (m : ('a, 'b) fmap): - has p m <=> (exists x, mem (dom m) x /\ p x (oget m.[x])). -proof. -rewrite hasE hasP /=; split=> [[[a b]] /= [^ab_in_m+ p_a_b] |[a] []]. -+ rewrite mem_assoc_uniq 1:uniq_keys // -getE => ma_b. - by exists a; rewrite ma_b mem_domE /oget /= p_a_b /= mem_map_fst; exists b. -rewrite mem_domE mem_map_fst=> -[b] ^ab_in_m+. -by rewrite mem_assoc_uniq 1:uniq_keys // getE /oget=> -> /= p_a_b; exists (a,b). -qed. - -(* FIXME: name *) -lemma has_le p' (m : ('a, 'b) fmap) (p : 'a -> 'b -> bool): - (forall x y, mem (dom m) x /\ p x y => mem (dom m) x /\ p' x y) => - has p m => - has p' m. -proof. -by move=> le_p_p'; rewrite !hasP=> -[x] /le_p_p' [p'_x x_in_m]; exists x. -qed. - -(* -------------------------------------------------------------------- *) -op all (p : 'a -> 'b -> bool) (m : ('a, 'b) fmap) = - List.all (fun (x : 'a * 'b), p x.`1 x.`2) (elems m) - axiomatized by allE. - -lemma allP p (m : ('a, 'b) fmap): - all p m <=> (forall x, mem (dom m) x => p x (oget m.[x])). -proof. -rewrite allE allP; split=> [h a|h [a b] /= ^ab_in_m]. -+ rewrite mem_domE mem_map_fst=> -[b] ^ab_in_m+. - by rewrite mem_assoc_uniq 1:uniq_keys -getE /oget=> ->; apply (@h (a,b)). -rewrite mem_assoc_uniq 1:uniq_keys -getE=> /(@congr1 oget) <-. -by apply/h; rewrite mem_domE mem_map_fst; exists b. -qed. - -lemma all_le p' (m : ('a, 'b) fmap) (p : 'a -> 'b -> bool): - (forall x y, mem (dom m) x /\ p x y => mem (dom m) x /\ p' x y) => - all p m => - all p' m. -proof. -move=> le_p_p'. rewrite !allP=> h x ^x_in_m /h p_x. -exact/(andWr _ (:@le_p_p' x (oget m.[x]) _)). -qed. - -(* -------------------------------------------------------------------- *) -lemma has_all (m : ('a, 'b) fmap) (p : 'a -> 'b -> bool): - has p m <=> !all (fun x y, !p x y) m. -proof. -rewrite hasP allP negb_forall /=; split=> [[x] [x_in_m p_x]|[] x]. -+ by exists x; rewrite p_x. -by rewrite negb_imply /= => h; exists x. -qed. - -(* -------------------------------------------------------------------- *) -op (+) (m1 m2 : ('a, 'b) fmap) = Self.oflist (elems m2 ++ elems m1) - axiomatized by joinE. - -lemma joinP (m1 m2 : ('a, 'b) fmap) x: - (m1 + m2).[x] = if mem (dom m2) x then m2.[x] else m1.[x]. -proof. by rewrite joinE get_oflist mem_domE assoc_cat -!getE. qed. - -(* -------------------------------------------------------------------- *) -op find (p : 'a -> 'b -> bool) (m : ('a, 'b) fmap) = - onth (map fst (elems m)) (find (fun (x : 'a * 'b), p x.`1 x.`2) (elems m)) - axiomatized by findE. - -(** The following are inspired from lemmas on List.find. findP is a - total characterization, but a more usable interface may be useful. **) -lemma find_none (p : 'a -> 'b -> bool) (m : ('a, 'b) fmap): - has p m <=> find p m <> None. -proof. -rewrite hasE /= findE List.has_find; split=> [h|]. -+ by rewrite (@onth_nth witness) 1:find_ge0/= 1:size_map. -by apply/contraLR=> h; rewrite onth_nth_map -map_comp nth_default 1:size_map 1:lezNgt. -qed. - -lemma findP (p : 'a -> 'b -> bool) (m : ('a, 'b) fmap): - (exists x, find p m = Some x /\ mem (dom m) x /\ p x (oget m.[x])) - \/ (find p m = None /\ forall x, mem (dom m) x => !p x (oget m.[x])). -proof. -case: (has p m)=> [^has_p | ^all_not_p]. -+ rewrite hasE has_find. - have:= find_ge0 (fun (x : 'a * 'b) => p x.`1 x.`2) (elems m). - pose i:= find _ (elems m); move => le0_i lt_i_sizem; left. - exists (nth witness (map ofst (elems m)) i); split. - + by rewrite findE -/i (@onth_nth witness) 1:size_map. - split. - + by rewrite mem_domE -index_mem index_uniq 1,3:size_map 2:uniq_keys. - have /= := nth_find witness (fun (x : 'a * 'b) => p (ofst x) (osnd x)) (elems m) _. - + by rewrite -hasE. - rewrite -/i -(@nth_map _ witness) // getE /assoc - (@index_uniq witness i (map fst (elems m))). - + by rewrite size_map. - + exact/uniq_keys. - by rewrite (@onth_nth witness) //. -rewrite has_all /= allP /= => h; right. -by split=> //; move: all_not_p; rewrite find_none. -qed. - -(* -------------------------------------------------------------------- *) -op filter (p : 'a -> 'b -> bool) (m : ('a, 'b) fmap) = - oflist (filter (fun (x : 'a * 'b) => p x.`1 x.`2) (elems m)) - axiomatized by filterE. - -(* FIXME: Move me *) -lemma filter_mem_map (p : 'a -> bool) (f : 'a -> 'b) (s : 'a list) x': - mem (map f (filter p s)) x' => mem (map f s) x'. -proof. by elim s=> //= x xs ih; case (p x)=> [_ [//= |] | _] /ih ->. qed. - -(* FIXME: Move me *) -lemma uniq_map_filter (p : 'a -> bool) (f : 'a -> 'b) (s : 'a list): - uniq (map f s) => uniq (map f (filter p s)). -proof. - elim s=> //= x xs ih [fx_notin_fxs uniq_fxs]. - by case (p x); rewrite ih //= -negP => h {h} /filter_mem_map. -qed. - -lemma perm_eq_elems_filter (m : ('a, 'b) fmap) (p: 'a -> 'b -> bool): - perm_eq (filter (fun (x : 'a * 'b) => p x.`1 x.`2) (elems m)) - (elems (filter p m)). -proof. - (* FIXME: curry-uncurry should probably go into Pair for some chosen arities *) - rewrite filterE; pose P:= fun (x : 'a * 'b) => p x.`1 x.`2. - apply (perm_eq_trans _ _ (:@oflistK _)). - rewrite reduce_reduced 2:perm_eq_refl //. - by apply/uniq_map_filter/uniq_keys. -qed. - -lemma mem_elems_filter (m : ('a, 'b) fmap) (p: 'a -> 'b -> bool) x y: - mem (filter (fun (x : 'a * 'b) => p x.`1 x.`2) (elems m)) (x,y) - <=> mem (elems (filter p m)) (x,y). -proof. by apply/perm_eq_mem/perm_eq_elems_filter. qed. - -lemma mem_map_filter_elems (p : 'a -> 'b -> bool) (f : ('a * 'b) -> 'c) (m : ('a, 'b) fmap) a: - mem (map f (filter (fun (x : 'a * 'b) => p x.`1 x.`2) (elems m))) a - <=> mem (map f (elems (filter p m))) a. -proof. by apply/perm_eq_mem/perm_eq_map/perm_eq_elems_filter. qed. - -lemma assoc_elems_filter (m : ('a, 'b) fmap) (p: 'a -> 'b -> bool) x: - assoc (filter (fun (x : 'a * 'b) => p x.`1 x.`2) (elems m)) x - = assoc (elems (filter p m)) x. -proof. by apply/perm_eq_assoc/perm_eq_elems_filter/uniq_keys. qed. - -lemma dom_filter (p : 'a -> 'b -> bool) (m : ('a,'b) fmap) x: - mem (dom (filter p m)) x <=> mem (dom m) x /\ p x (oget m.[x]). -proof. - (* FIXME: curry-uncurry should probably go into Pair for some chosen arities *) - pose P := fun (x : 'a * 'b) => p x.`1 x.`2. - rewrite !mem_domE !mem_map_fst; split=> [[y] | [[y] xy_in_m]]. - rewrite -mem_elems_filter mem_filter getE /= => -[p_x_y xy_in_pm]. - split; 1:by exists y. - by move: xy_in_pm; rewrite mem_assoc_uniq 1:uniq_keys // => ->. - have:= xy_in_m; rewrite mem_assoc_uniq 1:uniq_keys // getE /oget=> -> /= p_x_y. - by exists y; rewrite -mem_elems_filter mem_filter. -qed. - -lemma filterP (p : 'a -> 'b -> bool) (m : ('a, 'b) fmap) x: - (filter p m).[x] = if mem (dom m) x /\ p x (oget m.[x]) - then m.[x] - else None. -proof. - case (mem (dom m) x /\ p x (oget m.[x])); rewrite -dom_filter in_dom //=. - case {-1}((filter p m).[x]) (eq_refl (filter p m).[x])=> //= y. - rewrite getE -mem_assoc_uniq 1:uniq_keys //. - rewrite -mem_elems_filter mem_filter /= mem_assoc_uniq 1:uniq_keys //. - by rewrite getE=> -[_ ->]. -qed. - -lemma filter_eq_dom (m:('a,'b)fmap) (p1 p2:'a->'b->bool): - (forall a, mem (dom m) a=> p1 a (oget m.[a]) = p2 a (oget m.[a])) => - filter p1 m = filter p2 m. -proof. - by move=> Hp;apply fmapP=>z;rewrite !filterP;case (mem (dom m) z)=>// Hz;rewrite Hp. -qed. - -lemma filter_eq (m:('a,'b)fmap) (p1 p2:'a->'b->bool): - (forall a b, p1 a b = p2 a b) => - filter p1 m = filter p2 m. -proof. by move=>Hp;apply filter_eq_dom=>?_;apply Hp. qed. - -lemma filter_dom (m : ('a,'b) fmap) (p : 'a -> 'b -> bool): - filter (relI p (fun a (_ : 'b)=> mem (dom m) a)) m = filter p m. -proof. by apply/filter_eq_dom=> a @/relI ->. qed. - -(* -------------------------------------------------------------------- *) -op map (f : 'a -> 'b -> 'c) (m : ('a, 'b) fmap) = - oflist (map (fun (x : 'a * 'b) => (x.`1,f x.`1 x.`2)) (elems m)) - axiomatized by mapE. - -lemma dom_map (m : ('a,'b) fmap) (f : 'a -> 'b -> 'c) x: - mem (dom (map f m)) x <=> mem (dom m) x. -proof. - rewrite mapE dom_oflist domE mem_oflist. - by elim (elems m)=> //= [[a b] l] /= ->. -qed. - -lemma perm_eq_elems_map (m : ('a, 'b) fmap) (f : 'a -> 'b -> 'c): - perm_eq (map (fun (x : 'a * 'b) => (x.`1,f x.`1 x.`2)) (elems m)) - (elems (map f m)). -proof. - pose F := fun (x : 'a * 'b) => (x.`1,f x.`1 x.`2). - apply (@perm_eq_trans (reduce (map F (elems m)))). - rewrite -{1}(@reduce_reduced (map F (elems m))) 2:perm_eq_refl //. - have ->: forall s, map fst (map F s) = map fst s by elim. - exact/uniq_keys. - by rewrite mapE; apply/oflistK. -qed. - -lemma mem_elems_map (m : ('a, 'b) fmap) (f : 'a -> 'b -> 'c) x y: - mem (map (fun (x : 'a * 'b) => (x.`1,f x.`1 x.`2)) (elems m)) (x,y) - <=> mem (elems (map f m)) (x,y). -proof. by apply/perm_eq_mem/perm_eq_elems_map. qed. - -lemma mapP (f : 'a -> 'b -> 'c) (m : ('a, 'b) fmap) x: - (map f m).[x] = omap (f x) m.[x]. -proof. - pose F := fun (x : 'a * 'b) => (x.`1,f x.`1 x.`2). - case (mem (dom (map f m)) x)=> h //=. - case {-1}((map f m).[x]) (eq_refl (map f m).[x])=> [nh | y]. - by move: h; rewrite in_dom nh. - rewrite getE -mem_assoc_uniq 1:uniq_keys// -mem_elems_map mapP=> -[[a b]] /=. - by rewrite mem_assoc_uniq 1:uniq_keys// -getE andbC=> -[[<<- ->>]] ->. - have:= h; rewrite dom_map=> h'. - by move: h h'; rewrite !in_dom /= => -> ->. -qed. - -(* -------------------------------------------------------------------- *) -op eq_except (m1 m2 : ('a, 'b) fmap) (X : 'a -> bool) = - filter (fun x y => !X x) m1 - = filter (fun x y => !X x) m2 - axiomatized by eq_exceptE. - -lemma eq_except_refl (m : ('a, 'b) fmap) X: eq_except m m X. -proof. by rewrite eq_exceptE. qed. - -lemma eq_except_sym (m1 m2 : ('a, 'b) fmap) X: - eq_except m1 m2 X <=> eq_except m2 m1 X. -proof. by rewrite eq_exceptE eq_sym -eq_exceptE. qed. - -lemma eq_except_trans (m2 m1 m3 : ('a, 'b) fmap) X: - eq_except m1 m2 X => - eq_except m2 m3 X => - eq_except m1 m3 X. -proof. by rewrite !eq_exceptE; apply eq_trans. qed. - -lemma eq_exceptP (m1 m2 : ('a, 'b) fmap) X: - eq_except m1 m2 X <=> - (forall x, !X x => m1.[x] = m2.[x]). -proof. - rewrite eq_exceptE fmapP; split=> h x. - move=> x_notin_X; have:= h x; rewrite !filterP /= x_notin_X /=. - case (mem (dom m1) x); case (mem (dom m2) x); rewrite !in_dom=> //=. - (* FIXME: Should the following two be dealt with by `trivial'? *) - by rewrite eq_sym. - by move=> -> ->. - by rewrite !filterP /=; case (X x)=> //= /h; rewrite !in_dom=> ->. -qed. - -(* -------------------------------------------------------------------- *) -op size (m : ('a, 'b) fmap) = card (dom m) - axiomatized by sizeE. - -(* -------------------------------------------------------------------- *) -(* TODO: Do we need unary variants of has, all, find and map? *) - -(* -------------------------------------------------------------------- *) -lemma map0P x: (map0<:'a, 'b>).[x] = None. -proof. by rewrite map0E get_oflist. qed. - -lemma map0_eq0 (m : ('a,'b) fmap): - (forall x, m.[x] = None) => m = map0. -proof. by move=> h; apply fmapP=> x; rewrite h map0P. qed. - -lemma remP_eq (a : 'a) (m : ('a,'b) fmap): (rem a m).[a] = None. -proof. by rewrite remP. qed. - -lemma rem_rem (a : 'a) (m : ('a, 'b) fmap): - rem a (rem a m) = rem a m. -proof. by rewrite fmapP=> x; rewrite !remP; case (x = a). qed. - -lemma dom0: dom map0<:'a, 'b> = fset0. -proof. by apply/fsetP=> x; rewrite map0E dom_oflist in_fset0. qed. - -lemma dom_eq0 (m : ('a,'b) fmap): - dom m = fset0 => m = map0. -proof. - move=> eq_dom; apply fmap_domP; rewrite eq_dom dom0 //= => x; - by rewrite in_fset0. -qed. - -lemma domP (m : ('a, 'b) fmap) (a : 'a) (b : 'b): - forall x, mem (dom m.[a <- b]) x <=> mem (dom m `|` fset1 a) x. -proof. - move=> x; rewrite in_fsetU in_fset1 !in_dom getP; - by case (x = a). -qed. - -lemma domP_eq (m : ('a, 'b) fmap) (a : 'a) (b : 'b): - mem (dom m.[a <- b]) a. -proof. by rewrite domP in_fsetU in_fset1. qed. - -lemma dom_set (m:('a,'b) fmap) a b : - dom m.[a<-b] = dom m `|` fset1 a. -proof. by apply/fsetP/domP. qed. - -lemma dom_rem (a : 'a) (m : ('a, 'b) fmap): - dom (rem a m) = dom m `\` fset1 a. -proof. - by rewrite fsetP=> x; rewrite in_fsetD in_fset1 !in_dom remP; case (x = a). -qed. - -lemma dom_rem_eq (a : 'a) (m : ('a, 'b) fmap): !mem (dom (rem a m)) a. -proof. by rewrite dom_rem in_fsetD in_fset1. qed. - -lemma rng0: rng map0<:'a, 'b> = fset0. -proof. - apply/fsetP=> x; rewrite in_fset0 //= in_rng. - by rewrite negb_exists => a; rewrite /= map0P. -qed. - -lemma find_set (m:('a,'b) fmap) y x (p:'a -> 'b -> bool): - (forall x, mem (dom m) x => !p x (oget m.[x])) => - find p m.[x <- y] = if p x y then Some x else None. -proof. - cut [[a []->[]] | []-> Hp Hnp]:= findP p (m.[x<-y]);1: rewrite getP dom_set !inE /#. - by case (p x y)=> //; cut := Hp x;rewrite getP dom_set !inE /= oget_some. -qed. - -lemma rng_set (m : ('a, 'b) fmap) (a : 'a) (b : 'b): - rng m.[a<-b] = rng (rem a m) `|` fset1 b. -proof. - rewrite fsetP=> y; rewrite in_fsetU in_fset1 !in_rng; split=> [[] x |]. - rewrite getP; case (x = a)=> [->> /= <<- |ne_xa mx_y]; [right=> // |left]. - by exists x; rewrite remP ne_xa /=. - rewrite orbC -oraE=> -[->> | ]. - by exists a; rewrite getP_eq. - move=> ne_yb [] x; rewrite remP. - case (x = a)=> //= ne_xa <-. - by exists x; rewrite getP ne_xa. -qed. - -lemma rng_set_eq (m : ('a, 'b) fmap) (a : 'a) (b : 'b): - mem (rng m.[a<-b]) b. -proof. by rewrite rng_set in_fsetU in_fset1. qed. - -lemma rng_rem (a : 'a) (m : ('a, 'b) fmap) (b : 'b): - mem (rng (rem a m)) b <=> (exists x, x <> a /\ m.[x] = Some b). -proof. - rewrite in_rng; split=> [[x]|[x] [ne_x_a mx_b]]. - rewrite remP; case (x = a)=> //=. - by move=> ne_x_a mx_b; exists x. - by exists x; rewrite remP ne_x_a. -qed. - -lemma dom_join (m1 m2 : ('a, 'b) fmap): - forall x, mem (dom (m1 + m2)) x <=> mem (dom m1 `|` dom m2) x. -proof. - by move=> x; rewrite in_fsetU !in_dom joinP in_dom; case (m2.[x]). -qed. - -lemma has_join (p : 'a -> 'b -> bool) (m1 m2 : ('a, 'b) fmap): - has p (m1 + m2) <=> has (fun x y => p x y /\ !mem (dom m2) x) m1 \/ has p m2. -proof. -rewrite !hasP; split=> [[x]|]. - rewrite joinP dom_join in_fsetU. - by case: (mem (dom m2) x)=> //= - [x_in_m2 p_x_m2x|x_notin_m2 [x_in_m1 p_x_m1x]]; - [right|left]; exists x. -by move=> [[]|[]] x /> => [x_in_m1|h] p_x => [h|]; exists x; rewrite dom_join joinP in_fsetU h. -qed. - -lemma get_find (p : 'a -> 'b -> bool) (m : ('a, 'b) fmap): - has p m => p (oget (find p m)) (oget m.[oget (find p m)]). -proof. by rewrite find_none; have:= findP p m; case (find p m). qed. - -lemma has_find (p : 'a -> 'b -> bool) (m : ('a, 'b) fmap): - has p m <=> exists x, find p m = Some x /\ mem (dom m) x. -proof. - rewrite find_none; have:= findP p m. - by case (find p m)=> //= x [x'] [eq_xx' [x'_in_m _]]; exists x'. -qed. - -lemma find_some (p:'a -> 'b -> bool) m x: - find p m = Some x => - mem (dom m) x /\ p x (oget m.[x]). -proof. by have:= findP p m; case (find p m). qed. - -lemma rem_filter (m : ('a, 'b) fmap) x: - rem x m = filter (fun x' y => x' <> x) m. -proof. - apply fmapP=> x'; rewrite remP filterP; case (mem (dom m) x'). - by case (x' = x). - by rewrite in_dom /= => ->. -qed. - -lemma filter_predI (p1 p2: 'a -> 'b -> bool) (m : ('a, 'b) fmap): - filter (fun a b => p1 a b /\ p2 a b) m = filter p1 (filter p2 m). -proof. by rewrite fmapP=>x;rewrite !(filterP, dom_filter)/#. qed. - -lemma filter_filter (p : 'a -> 'b -> bool) (m : ('a, 'b) fmap): - filter p (filter p m) = filter p m. -proof. by rewrite -filter_predI;apply filter_eq => /#. qed. - -lemma filter_rem (p:'a->'b->bool) (m:('a,'b)fmap) x: - filter p (rem x m) = rem x (filter p m). -proof. rewrite !rem_filter -!filter_predI;apply filter_eq=>/#. qed. - -lemma join_filter (p : 'a -> 'b -> bool) (m : ('a, 'b) fmap): - (filter p m) + (filter (fun x y=> !p x y) m) = m. -proof. - rewrite fmapP=> x; rewrite joinP dom_filter /= !filterP. - case (mem (dom m) x)=> /=. - by case (p x (oget m.[x])). - by rewrite in_dom /= eq_sym. -qed. - -lemma eq_except_set a b (m1 m2 : ('a, 'b) fmap) X: - eq_except m1 m2 X => - eq_except m1.[a <- b] m2.[a <- b] X. -proof. - rewrite !eq_exceptP=> h x x_notin_X. - rewrite !getP; case (x = a)=> //=. - by rewrite h. -qed. - -lemma filter_eq_except (m : ('a, 'b) fmap) (X : 'a -> bool): - eq_except (filter (fun x y => !X x) m) m X. -proof. by rewrite eq_exceptE filter_filter. qed. - -lemma eq_except_rem (m1 m2:('a,'b)fmap) (s:'a -> bool) x: - s x => eq_except m1 m2 s => eq_except m1 (rem x m2) s. -proof. - rewrite !eq_exceptE rem_filter -filter_predI=> Hmem ->;apply filter_eq=>/#. -qed. - -lemma set_eq_except x b (m : ('a, 'b) fmap): - eq_except m.[x <- b] m (pred1 x). -proof. by rewrite eq_exceptP=> x'; rewrite !getP=> ->. qed. - -lemma set2_eq_except x b b' (m : ('a, 'b) fmap): - eq_except m.[x <- b] m.[x <- b'] (pred1 x). -proof. by rewrite eq_exceptP=> x'; rewrite !getP=> ->. qed. - -lemma eq_except_set_eq (m1 m2 : ('a, 'b) fmap) x: - mem (dom m1) x => - eq_except m1 m2 (pred1 x) => - m1 = m2.[x <- oget m1.[x]]. -proof. - rewrite eq_exceptP fmapP=> x_in_m1 eqe x'. - rewrite !getP /oget; case (x' = x)=> [->> |]. - by move: x_in_m1; rewrite in_dom; case (m1.[x]). - by exact/eqe. -qed. - -(* -------------------------------------------------------------------- *) -lemma rem_id (x : 'a) (m : ('a,'b) fmap): - !mem (dom m) x => rem x m = m. -proof. -rewrite in_dom /= => x_notin_m; apply/fmapP=> x'; rewrite remP. -by case: (x' = x)=> //= ->>; rewrite x_notin_m. -qed. - -lemma dom_rem_le (x : 'a) (m : ('a,'b) fmap) (x' : 'a): - mem (dom (rem x m)) x' => mem (dom m) x'. -proof. by rewrite dom_rem in_fsetD. qed. - -lemma rng_rem_le (x : 'a) (m : ('a,'b) fmap) (x' : 'b): - mem (rng (rem x m)) x' => mem (rng m) x'. -proof. by rewrite rng_rem in_rng=> -[x0] [_ h]; exists x0. qed. - -(* -------------------------------------------------------------------- *) -(** FIXME: these two were minimally imported from old and need cleaning *) -lemma leq_card_rng_dom (m:('a,'b) fmap): - card (rng m) <= card (dom m). -proof. -elim/fset_ind: (dom m) {-2}m (eq_refl (dom m))=> {m} [m /dom_eq0 ->|]. -+ by rewrite rng0 dom0 !fcards0. -move=> x s x_notin_s ih m dom_m. -cut ->: m = (rem x m).[x <- oget m.[x]]. -+ apply fmapP=> x'; rewrite getP remP; case: (x' = x)=> [->|//]. - have /fsetP /(_ x):= dom_m; rewrite in_fsetU in_fset1 /= in_dom. - by case: m.[x]. -have ->:= rng_set (rem x m) x (oget m.[x]). -rewrite fcardU rem_rem fsetI1 fun_if !fcard1 fcards0. -rewrite dom_set fcardUI_indep 2:fcard1. -+ by apply/fsetP=> x0; rewrite in_fsetI dom_rem !inE -andbA andNb. -rewrite StdOrder.IntOrder.ler_subl_addr; apply/StdOrder.IntOrder.ler_paddr. -+ by case: (mem (rng _) _). -apply/StdOrder.IntOrder.ler_add2r/ih/fsetP=> x0. -by rewrite dom_rem dom_m !inE; case: (x0 = x). -qed. - -lemma endo_dom_rng (m:('a,'a) fmap): - (exists x, !mem (dom m) x) => - exists x, !mem (rng m) x. -proof. -elim=> x x_notin_m. -have h: 0 < card (((dom m) `|` fset1 x) `\` (rng m)); last first. -+ by have: forall (X : 'a fset), 0 < card X => exists x, mem X x; smt. -rewrite fcardD fcardUI_indep. -+ by apply/fsetP=> x'; rewrite !inE /#. -rewrite fcard1 fsetIUl fcardUI_indep. -+ by apply/fsetP=> x'; rewrite !inE /#. -have ->: card (fset1 x `&` rng m) = if mem (rng m) x then 1 else 0. -+ smt (@FSet). -smt (leq_card_rng_dom @FSet). -qed. - -(** TODO: lots of lemmas *) -lemma rem0 (a : 'a) : rem a map0<:'a,'b> = map0. -proof. - by apply map0_eq0=>x;rewrite remP;case (x=a)=>//=;rewrite map0P. -qed. - -lemma set_eq (m:('a,'b)fmap) x y: m.[x] = Some y => m.[x<-y] = m. -proof. - by rewrite fmapP=> Hx x';rewrite getP;case (x'=x)=>//->;rewrite Hx. -qed. - -lemma map_map0 (f:'a -> 'b -> 'c): map f map0 = map0. -proof. by rewrite fmapP=> x;rewrite mapP !map0P. qed. - -lemma map_set (f:'a -> 'b -> 'c) m x y : - map f m.[x<-y] = (map f m).[x<- f x y]. -proof. - by rewrite fmapP=>z;rewrite mapP !getP;case (z=x)=>// _;rewrite mapP. -qed. - -lemma map_rem (f:'a -> 'b -> 'c) m x: map f (rem x m) = rem x (map f m). -proof. by rewrite fmapP=>z;rewrite !(mapP,remP)/#. qed. - -lemma rem_set (m:('a,'b)fmap) x y v: - rem x (m.[y<-v]) = if x = y then rem x m else (rem x m).[y<-v]. -proof. - rewrite fmapP=>z;case (x=y)=>[->|]; rewrite !(remP,getP) /#. -qed. - -lemma map_comp (f1:'a->'b->'c) (f2:'a->'c->'d) (m:('a,'b)fmap): - map f2 (map f1 m) = map (fun a b => f2 a (f1 a b)) m. -proof. by rewrite fmapP=>x;rewrite !mapP;case (m.[x]). qed. - -lemma map_id (m:('a,'b)fmap): map (fun _ b => b) m = m. -proof. by rewrite fmapP=>x;rewrite mapP;case (m.[x]). qed. diff --git a/proof/RP.eca b/proof/RP.eca deleted file mode 100644 index 6c54150..0000000 --- a/proof/RP.eca +++ /dev/null @@ -1,79 +0,0 @@ -(*************************- Random Permutation -*************************) - -require import Core Real FSet NewFMap Distr. -require import Dexcepted StdOrder. import RealOrder. -require import Ring StdRing. import RField. -require Monoid. import AddMonoid. - -type t. -op dt : t distr. - -module type RP = { - proc init() : unit - proc f(x : t) : t - proc fi(x : t) : t -}. - -module type DRP = { - proc f(x : t) : t - proc fi(x : t) : t -}. - -module P : RP, DRP = { - var m : (t, t) fmap - var mi : (t, t) fmap - - proc init() = { m = map0; mi = map0; } - - proc f(x) = { - var y; - - if (! mem (dom m) x) { - y <$ dt \ (mem (rng m)); - m.[x] <- y; - mi.[y] <- x; - } - return oget m.[x]; - } - - proc fi(x) = { - var y; - - if (! mem (dom mi) x) { - y <$ dt \ (mem (rng mi)); - mi.[x] <- y; - m.[y] <- x; - } - return oget mi.[x]; - } -}. - -lemma P_init_ll: islossless P.init. -proof. by proc; auto. qed. - -(* maybe a useful standard lemma? *) - -lemma mu_except ['a] (d : 'a distr, y : 'a, P : 'a -> bool) : - y \in d => ! P y => mu d P < mu d predT. -proof. -move=> in_supp_yd notP_y. -have -> : mu d P = mu d predT - mu d (predC P) - by rewrite (mu_split d predT P) mu_not mu_and #ring. -rewrite ltr_subl_addl (ltr_le_trans (mu d (pred1 y) + mu d predT)). -by rewrite -(add0r (mu _ _)) 1:ltr_le_add. -by rewrite ler_add mu_sub /pred1; first move=> ?. -qed. - -lemma P_f_ll: is_lossless dt => support dt = predT => islossless P.f. -proof. -move=> d_ll d_fu; proc; if=> //=; auto=> &m /= x_notin_m. -have [y not_mem_y_rng_m] := endo_dom_rng P.m{m} _; first by exists x{m}. -by rewrite dexcepted_ll // -d_ll (mu_except dt y) -/(support _ _) 1:d_fu. -qed. - -lemma P_fi_ll: is_lossless dt => support dt = predT => islossless P.fi. -proof. -move=> d_ll d_fu; proc; if=> //=; auto=> &m /= x_notin_m. -have [y not_mem_y_rng_mi] := endo_dom_rng P.mi{m} _; first by exists x{m}. -by rewrite dexcepted_ll // -d_ll (mu_except dt y) -/(support _ _) 1:d_fu. -qed. diff --git a/proof/RndO.ec b/proof/RndO.ec deleted file mode 100644 index f2bed8e..0000000 --- a/proof/RndO.ec +++ /dev/null @@ -1,699 +0,0 @@ -require import Core List FSet NewFMap Distr. -require IterProc. - -pragma -oldip. - -(* FIXME notation *) -abbrev ([+]) ['a 'b] (x : 'b) = fun (_ : 'a) => x. - -type flag = [ Unknown | Known ]. - -lemma neqK_eqU f : f <> Known <=> f = Unknown. -proof. by case: f. qed. - -op in_dom_with (m:('from, 'to * 'flag)fmap) (x:'from) (f:'flag) = - mem (dom m) x /\ (oget (m.[x])).`2 = f. - -op restr f (m:('from, 'to * 'flag)fmap) = - let m = filter (fun _ (p:'to*'flag) => p.`2=f) m in - map (fun _ (p:'to*'flag) => p.`1) m. - -lemma restrP (m:('from, 'to * 'flag)fmap) f x: - (restr f m).[x] = - obind (fun (p:'to*'flag)=>if p.`2=f then Some p.`1 else None) m.[x]. -proof. - rewrite /restr /= mapP filterP in_dom /=. - by case (m.[x])=>//= -[x0 f'];rewrite oget_some /=;case (f' = f). -qed. - -lemma dom_restr (m:('from, 'to * 'flag)fmap) f x: - mem (dom(restr f m)) x <=> in_dom_with m x f. -proof. - rewrite /in_dom_with !in_dom;case: (m.[x]) (restrP m f x)=>//= -[t f'] /=. - by rewrite oget_some /=;case (f' = f)=> [_ ->|]. -qed. - -lemma restr_set (m:('from, 'to * 'flag)fmap) f1 f2 x y: - restr f1 m.[x<-(y,f2)] = if f1 = f2 then (restr f1 m).[x<-y] else rem x (restr f1 m). -proof. - rewrite fmapP;case (f1=f2)=>[->|Hneq]x0;rewrite !(restrP,getP);1: by case (x0=x). - case (x0=x)=>[->|Hnx];1:by rewrite (eq_sym f2) Hneq remP_eq. - by rewrite remP Hnx restrP. -qed. - -lemma restr_set_eq (m:('from, 'to * 'flag)fmap) f x y: - restr f m.[x<-(y,f)] = (restr f m).[x<-y]. -proof. by rewrite restr_set. qed. - -lemma restr0 f : restr f map0<:'from, 'to * 'flag> = map0. -proof. by apply fmapP=>x;rewrite restrP !map0P. qed. - -lemma restr_set_neq f2 f1 (m:('from, 'to * 'flag)fmap) x y: - !mem (dom m) x => - f2 <> f1 => restr f1 m.[x<-(y,f2)] = restr f1 m. -proof. - by move=>Hm Hneq;rewrite restr_set(eq_sym f1)Hneq rem_id//dom_restr/in_dom_with Hm. -qed. - -lemma restr_rem (m:('from,'to*'flag)fmap) x f: - restr f (rem x m) = - if in_dom_with m x f then rem x (restr f m) else restr f m. -proof. - rewrite fmapP=>z;rewrite restrP;case (in_dom_with m x f); - rewrite !(restrP,remP) /in_dom_with in_dom /#. -qed. - -abstract theory Ideal. - -type from, to. - -op sampleto : from -> to distr. - -module type RO = { - proc init () : unit - proc get (x : from) : to - proc set (x : from, y : to) : unit - proc rem (x : from) : unit - proc sample(x : from) : unit -}. - -module type RO_Distinguisher(G : RO) = { - proc distinguish(): bool -}. - -module type FRO = { - proc init () : unit - proc get (x : from) : to - proc set (x : from, y : to) : unit - proc rem (x : from) : unit - proc sample(x : from) : unit - proc in_dom(x : from,f : flag) : bool - proc restrK() : (from,to)fmap -}. - -module type FRO_Distinguisher(G : FRO) = { - proc distinguish(): bool -}. - -(* -------------------------------------------------------------------------- *) -module RO : RO = { - var m : (from, to)fmap - - proc init () = { m <- map0; } - - proc get(x:from) = { - var r; - r <$ sampleto x; - if (!mem (dom m) x) m.[x] <- r; - return (oget m.[x]); - } - - proc set (x:from, y:to) = { - m.[x] <- y; - } - - proc rem (x:from) = { - m <- rem x m; - } - - proc sample(x:from) = { - get(x); - } - - proc restrK() = { - return m; - } - -}. - -module FRO : FRO = { - var m : (from, to * flag)fmap - - proc init () = { m <- map0; } - - proc get(x:from) = { - var r; - r <$ sampleto x; - if (mem (dom m) x) r <- (oget m.[x]).`1; - m.[x] <- (r,Known); - return r; - } - - proc set (x:from, y:to) = { - m.[x] <- (y,Known); - } - - proc rem (x:from) = { - m <- rem x m; - } - - proc sample(x:from) = { - var c; - c <$ sampleto x; - if (!mem (dom m) x) m.[x] <- (c,Unknown); - } - - proc in_dom(x:from, f:flag) = { - return in_dom_with m x f; - } - - proc restrK() = { - return restr Known m; - } - -}. - -equiv RO_FRO_init : RO.init ~ FRO.init : true ==> RO.m{1} = map (+fst) FRO.m{2}. -proof. by proc;auto=>/=;rewrite map_map0. qed. - -equiv RO_FRO_get : RO.get ~ FRO.get : - ={x} /\ RO.m{1} = map (+fst) FRO.m{2} ==> ={res} /\ RO.m{1} = map (+fst) FRO.m{2}. -proof. - proc;auto=>?&ml[]->->/=?->/=. - rewrite !dom_map !map_set/fst/= getP_eq oget_some;progress. - + by rewrite mapP oget_omap_some // -in_dom. - by apply /eq_sym/set_eq;rewrite get_oget?dom_map// mapP oget_omap_some// -in_dom. -qed. - -equiv RO_FRO_set : RO.set ~ FRO.set : - ={x,y} /\ RO.m{1} = map (+fst) FRO.m{2} ==> RO.m{1} = map (+fst) FRO.m{2}. -proof. by proc;auto=>?&ml[#]3->;rewrite map_set. qed. - -equiv RO_FRO_rem : RO.rem ~ FRO.rem : - ={x} /\ RO.m{1} = map (+fst) FRO.m{2} ==> RO.m{1} = map (+fst) FRO.m{2}. -proof. by proc;auto=>??;rewrite map_rem. qed. - -equiv RO_FRO_sample : RO.sample ~ FRO.sample : - ={x} /\ RO.m{1} = map (+fst) FRO.m{2} ==> RO.m{1} = map (+fst) FRO.m{2}. -proof. - by proc;inline *;auto=>?&ml[]2!->/=?->;rewrite dom_map/= map_set. -qed. - -lemma RO_FRO_D (D<:RO_Distinguisher{RO,FRO}) : - equiv [D(RO).distinguish ~ D(FRO).distinguish : - ={glob D} /\ RO.m{1} = map (+fst) FRO.m{2} ==> - ={res,glob D} /\ RO.m{1} = map (+fst) FRO.m{2} ]. -proof. - proc (RO.m{1} = map (+fst) FRO.m{2})=>//. - + by conseq RO_FRO_init. + by conseq RO_FRO_get. + by conseq RO_FRO_set. - + by conseq RO_FRO_rem. + by conseq RO_FRO_sample. -qed. - -section LL. - -lemma RO_init_ll : islossless RO.init. -proof. by proc;auto. qed. - -lemma FRO_init_ll : islossless FRO.init. -proof. by proc;auto. qed. - -lemma FRO_in_dom_ll : islossless FRO.in_dom. -proof. by proc. qed. - -lemma FRO_restrK_ll : islossless FRO.restrK. -proof. by proc. qed. - -lemma RO_set_ll : islossless RO.set. -proof. by proc;auto. qed. - -lemma FRO_set_ll : islossless FRO.set. -proof. by proc;auto. qed. - -axiom sampleto_ll : forall x, Distr.weight (sampleto x) = 1%r. - -lemma RO_get_ll : islossless RO.get. -proof. by proc;auto;progress;apply sampleto_ll. qed. - -lemma FRO_get_ll : islossless FRO.get. -proof. by proc;auto;progress;apply sampleto_ll. qed. - -lemma RO_sample_ll : islossless RO.sample. -proof. by proc;call RO_get_ll. qed. - -lemma FRO_sample_ll : islossless FRO.sample. -proof. by proc;auto;progress;apply sampleto_ll. qed. - -end section LL. - -end Ideal. - -(* -------------------------------------------------------------------------- *) - -abstract theory GenEager. - -clone include Ideal. - -axiom sampleto_ll : forall x, Distr.weight (sampleto x) = 1%r. - -clone include IterProc with type t <- from. - -(** A module that resample query if the associate value is unknown *) -module RRO : FRO = { - - proc init = FRO.init - - proc get(x:from) = { - var r; - r <$ sampleto x; - if (!mem (dom FRO.m) x || (oget FRO.m.[x]).`2 = Unknown) { - FRO.m.[x] <- (r,Known); - } - return (oget FRO.m.[x]).`1; - } - - proc set = FRO.set - - proc rem = FRO.rem - - proc sample = FRO.sample - - proc in_dom = FRO.in_dom - - proc restrK = FRO.restrK - - module I = { - proc f (x:from) = { - var c; - c <$ sampleto x; - FRO.m.[x] <- (c,Unknown); - } - } - - proc resample () = { - Iter(I).iter (elems (dom (restr Unknown FRO.m))); - } - -}. - -(* A module which is lazy on sample *) -module LRO : RO = { - - proc init = RO.init - - proc get = RO.get - - proc set = RO.set - - proc rem = RO.rem - - proc sample(x:from) = {} - -}. - -lemma RRO_resample_ll : islossless RRO.resample. -proof. - proc;call (iter_ll RRO.I _)=>//;proc;auto=>/=?; - by split; first apply sampleto_ll. -qed. - -lemma eager_init : - eager [RRO.resample(); , FRO.init ~ RRO.init, RRO.resample(); : - ={FRO.m} ==> ={FRO.m} ]. -proof. - eager proc. inline{2} *;rcondf{2}3;auto=>/=. - + by move=>?_;rewrite restr0 dom0 elems_fset0. - by conseq (_:) (_:true==>true: =1%r) _=>//;call RRO_resample_ll. -qed. - -lemma iter_perm2 (i1 i2 : from): - equiv[ Iter(RRO.I).iter_12 ~ Iter(RRO.I).iter_21 : - ={glob RRO.I, t1, t2} ==> ={glob RRO.I}]. -proof. - proc;inline *;case ((t1=t2){1});1:by auto. - by swap{2}[4..5]-3;auto=> &ml&mr[#]3->neq/=?->?->;rewrite set_set neq. -qed. - -equiv I_f_neq x1 mx1: RRO.I.f ~ RRO.I.f : - ={x,FRO.m} /\ x1 <> x{1} /\ FRO.m{1}.[x1] = mx1 ==> - ={FRO.m} /\ FRO.m{1}.[x1] = mx1. -proof. - by proc;auto=>?&mr[#]2->Hneq Heq/=?->;rewrite getP Hneq. -qed. - -equiv I_f_eqex x1 mx1 mx2: RRO.I.f ~ RRO.I.f : - ={x} /\ x1 <> x{1} /\ eq_except FRO.m{1} FRO.m{2} (pred1 x1) /\ - FRO.m{1}.[x1] = mx1 /\ FRO.m{2}.[x1] = mx2 ==> - eq_except FRO.m{1} FRO.m{2} (pred1 x1) /\ - FRO.m{1}.[x1] = mx1 /\ FRO.m{2}.[x1] = mx2. -proof. - by proc;auto=>?&mr[#]->Hneq Heq/= Heq1 Heq2?->/=;rewrite !getP Hneq eq_except_set. -qed. - -equiv I_f_set x1 r1 : RRO.I.f ~ RRO.I.f : - ={x} /\ x1 <> x{1} /\ FRO.m{1}.[x1] = None /\ FRO.m{2} = FRO.m{1}.[x1 <- (r1, Known)] ==> - FRO.m{1}.[x1] = None /\ FRO.m{2} = FRO.m{1}.[x1 <- (r1, Known)]. -proof. - by proc;auto=>?&mr[#]->Hneq H1->/=?->;rewrite getP Hneq/= H1 set_set Hneq. -qed. - -lemma eager_get : - eager [RRO.resample(); , FRO.get ~ RRO.get, RRO.resample(); : - ={x,FRO.m} ==> ={res,FRO.m} ]. -proof. - eager proc. - wp;case ((mem (dom FRO.m) x /\ (oget FRO.m.[x]).`2=Known){1}). - + rnd{1};rcondf{2} 2;1:by auto=> /#. - exists*x{1}, ((oget FRO.m.[x{2}]){1});elim*=>x1 mx;inline RRO.resample. - call (iter_inv RRO.I (fun z=>x1<>z) (fun o1 o2 => o1 = o2 /\ o1.[x1]= Some mx) _)=>/=. - + by conseq (I_f_neq x1 (Some mx))=>//. - auto=>?&mr[#]4->Hd Hget. - split; first apply sampleto_ll. - move=> /=_?_; split. - + by rewrite get_oget//oget_some/==> x;rewrite -memE dom_restr/#. - move=>[#]_ Heq?mr[#]->Heq'. - split=> [| _ r _]; first apply sampleto_ll. - rewrite in_dom Heq' oget_some /= set_eq /#. - case ((mem (dom FRO.m) x){1}). - + inline{1} RRO.resample=>/=;rnd{1}. - transitivity{1} - { Iter(RRO.I).iter_1s(x, elems ((dom (restr Unknown FRO.m)) `\` fset1 x)); } - (={x,FRO.m} /\ mem (dom FRO.m{1}) x{1} /\ (oget FRO.m{1}.[x{1}]).`2 = Unknown ==> - ={x,FRO.m}) - (={x,FRO.m} /\ mem (dom FRO.m{1}) x{1} /\ (oget FRO.m{1}.[x{1}]).`2 = Unknown==> - ={x} /\ eq_except FRO.m{1} FRO.m{2} (pred1 x{1}) /\ - FRO.m{1}.[x{2}] = Some (result{2},Unknown) /\ - FRO.m{2}.[x{2}] = Some (result{2},Known)). - + by move=>?&mr[#]-> -> ??;exists FRO.m{mr} x{mr}=>/#. - + move=>???;rewrite in_dom=>[#]<*>[#]->/eq_except_sym H Hxm Hx2. - split=> [| _ r _]; first apply sampleto_ll. - rewrite /= Hxm oget_some /=;apply /eq_sym. - have /(congr1 oget):= Hx2 => <-;apply eq_except_set_eq=>//. - by rewrite in_dom Hx2. - + symmetry;call (iter1_perm RRO.I iter_perm2). - skip=> &1 &2 [[->> ->>]] [Hdom Hm];split=>//=. - by apply /perm_eq_sym/perm_to_rem/dom_restr;rewrite /in_dom_with Hdom Hm. - inline Iter(RRO.I).iter_1s RRO.I.f RRO.resample. - seq 5 3 : (={x} /\ eq_except FRO.m{1} FRO.m{2} (pred1 x{1}) /\ - (l =elems(dom (restr Unknown FRO.m) `\` fset1 x)){1} /\ - FRO.m{1}.[x{2}] = Some (result{2}, Unknown) /\ - FRO.m{2}.[x{2}] = Some (result{2}, Known)). - + auto=>?&mr[#]2->/=^Hdom->^Hget->?->/=. - by rewrite !getP /=oget_some !restr_set/= dom_set set2_eq_except fsetDK. - exists*x{1}, FRO.m{1}.[x{2}], FRO.m{2}.[x{2}];elim*=>x1 mx1 mx2. - call (iter_inv RRO.I (fun z=>x1<>z) - (fun o1 o2 => eq_except o1 o2 (pred1 x1) /\ o1.[x1]= mx1 /\ o2.[x1]=mx2) - (I_f_eqex x1 mx1 mx2))=>/=;auto=>?&mr[#]4->^H->->^H1->^H2->/=;split. - + congr;rewrite fsetP=>z;rewrite !inE !dom_restr /in_dom_with !in_dom; smt. - by move=>x;rewrite -memE in_fsetD1 eq_sym. - swap{1}-1;seq 1 1 : (={r,x,FRO.m} /\ ! mem (dom FRO.m{1}) x{1});1:by auto. - inline RRO.resample;exists*x{1},r{1};elim*=>x1 r1. - call (iter_inv RRO.I (fun z=>x1<>z) - (fun o1 o2 => o1.[x1] = None /\ o2= o1.[x1<-(r1,Known)]) (I_f_set x1 r1));auto. - move=>?&mr[#]5-> ^Hnin^ + ->/=;rewrite in_dom=>/=->/=;rewrite restr_set_neq //=;split. - + by move=>z; rewrite -memE dom_restr /#. - by move=>_?mr[#]^Hmem 2!->;rewrite in_dom Hmem /= getP /=oget_some. -qed. - -lemma eager_set : - eager [RRO.resample(); , FRO.set ~ RRO.set, RRO.resample(); : - ={x,y} /\ ={FRO.m} ==> ={res,FRO.m} ]. -proof. - eager proc. - inline RRO.resample=>/=;wp. - case ((mem (dom FRO.m) x /\ (oget FRO.m.[x]).`2 = Unknown){1}). - + transitivity{1} { Iter(RRO.I).iter_1s(x,elems ((dom (restr Unknown FRO.m)) `\` fset1 x));} - (={x,y,FRO.m} /\ mem (dom FRO.m{1}) x{1} /\ (oget FRO.m{1}.[x{1}]).`2 = Unknown ==> - ={x,y,FRO.m}) - (={x,y,FRO.m} /\ mem (dom FRO.m{1}) x{1} /\ (oget FRO.m{1}.[x{1}]).`2 = Unknown==> - ={x,y} /\ eq_except FRO.m{1} FRO.m{2} (pred1 x{1}) /\ - FRO.m{2}.[x{2}] = Some (y{2},Known)). - + by move=>?&mr[#]2->???;exists FRO.m{mr} x{mr} y{mr}=>/#. - + move=>?&m&mr[#]<*>[#]2->Hex Hm2. - by rewrite (eq_except_set_eq FRO.m{mr} FRO.m{m} x{mr}) ?in_dom ?Hm2// eq_except_sym. - + symmetry;call (iter1_perm RRO.I iter_perm2);auto=>?&mr[#]3-> Hdom Hm;split=>//=. - by apply /perm_eq_sym/perm_to_rem/dom_restr;rewrite /in_dom_with Hdom. - inline{1}Iter(RRO.I).iter_1s. - seq 3 1: (={x,y} /\ eq_except FRO.m{1} FRO.m{2} (pred1 x{1}) /\ - l{1} = (elems (dom (restr Unknown FRO.m))){2} /\ !mem l{1} x{1} /\ - (FRO.m.[x]=Some(y, Known)){2}). - + inline *;auto=>?&mr[#]3->/=Hmem Hget. - split=> [|_ c _]; first apply sampleto_ll. - by rewrite set2_eq_except getP_eq restr_set /= dom_rem -memE !inE negb_and. - exists* x{1},y{1},(FRO.m.[x]{1});elim*=>x1 y1 mx1;pose mx2:=Some(y1,Known). - call (iter_inv RRO.I (fun z=>x1<>z) - (fun o1 o2 => eq_except o1 o2 (pred1 x1) /\ o1.[x1]= mx1 /\ o2.[x1]=mx2) - (I_f_eqex x1 mx1 mx2))=>/=;auto=>?&mr[#]-><-2!->->>2!->Hmem->/#. - exists* x{1},y{1},(FRO.m.[x]{1});elim*=>x1 y1 mx1;pose mx2:=Some(y1,Known). - call (iter_inv RRO.I (fun z=>x1<>z) - (fun o1 o2 => eq_except o1 o2 (pred1 x1) /\ o1.[x1]= mx1 /\ o2.[x1]=mx2) - (I_f_eqex x1 mx1 mx2))=>/=;auto=>?&mr[#]-><-2!->->>->/= Hidm. - rewrite restr_set getP_eq/mx2 eq_except_sym set_eq_except/=;split;[split|]. - + by congr;apply fsetP=>z;rewrite !(dom_rem,inE,dom_restr) /#. - + by move=>z;rewrite -memE dom_restr /#. - move=>_??[#]Hex HLx HRx;apply /eq_sym. - have/(congr1 oget):=HRx=><-;apply eq_except_set_eq=>//;1:by rewrite in_dom HRx. - by apply /eq_except_sym. -qed. - -lemma eager_rem: - eager [RRO.resample(); , FRO.rem ~ RRO.rem, RRO.resample(); : - ={x} /\ ={FRO.m} ==> ={res,FRO.m} ]. -proof. - eager proc;case ((in_dom_with FRO.m x Unknown){1}). - + inline RRO.resample;wp. - transitivity{1} - { Iter(RRO.I).iter_1s(x,elems (dom (restr Unknown FRO.m) `\` fset1 x)); } - (={x,FRO.m}/\(in_dom_with FRO.m x Unknown){1}==> ={x,FRO.m}) - (={x,FRO.m}/\ (in_dom_with FRO.m x Unknown){1} ==> (rem x FRO.m){1} = FRO.m{2})=>//. - + by move=>?&mr[#]2->?;exists FRO.m{mr} x{mr}. - + symmetry;call (iter1_perm RRO.I iter_perm2);skip=>?&mr[#]2!->?/=;split=>//. - by apply /perm_eq_sym/perm_to_rem/dom_restr. - inline{1}Iter(RRO.I).iter_1s. - seq 3 1: (={x} /\ eq_except FRO.m{1} FRO.m{2} (pred1 x{1}) /\ - l{1} = (elems (dom (restr Unknown FRO.m))){2} /\ !mem l{1} x{1} /\ - (FRO.m.[x]=None){2}). - + inline *;auto=>??[#]2->Hidm/=. - split=> [| _ c _]; first apply sampleto_ll. - rewrite eq_except_rem 2:set_eq_except // remP -memE in_fsetD1 negb_and /=. - by rewrite restr_rem Hidm /= dom_rem. - exists* x{1},(FRO.m.[x]{1});elim*=>x1 mx1. - call (iter_inv RRO.I (fun z=>x1<>z) - (fun o1 o2 => eq_except o1 o2 (pred1 x1) /\ o1.[x1]= mx1 /\ o2.[x1]=None) _). - + by conseq (I_f_eqex x1 mx1 None). - auto=>?&mr[#]3->^Hex 2!->Hmem ^Hx->/=;split=>[/#|_ mL mR[#]/eq_exceptP Hex'?Heq]. - apply fmapP=>z;rewrite remP;case (z=x{mr})=>[->/=|Hneq];1:by rewrite Heq. - by apply Hex'. - inline RRO.resample;wp. - exists *x{1},(FRO.m.[x]{1});elim*=>x1 mx1. - call (iter_inv RRO.I (fun z=>x1<>z) - (fun o1 o2 => eq_except o1 o2 (pred1 x1) /\ o1.[x1]= mx1 /\ o2.[x1]=None) _). - + by conseq (I_f_eqex x1 mx1 None). - auto=>?&mr[#]4->Hin/=. - rewrite restr_rem Hin/= remP eq_except_rem // 1:eq_except_refl /=;split. - + by move=>z;rewrite -memE dom_restr /#. - move=>_ mL mR[#] /eq_exceptP Hex'?Heq. - apply fmapP=>z;rewrite remP;case (z=x{mr})=>[->/=|Hneq];1:by rewrite Heq. - by apply Hex'. -qed. - -lemma eager_in_dom: - eager [RRO.resample(); , FRO.in_dom ~ RRO.in_dom, RRO.resample(); : - ={x,f} /\ ={FRO.m} ==> ={res,FRO.m} ]. -proof. - eager proc;inline *;wp. - while (={l,FRO.m} /\ (forall z, mem l z => in_dom_with FRO.m z Unknown){1} /\ - in_dom_with FRO.m{1} x{1} f{1} = result{2}). - + auto=>?&mr[#]2->Hz <-?_/=?->/=. - split=>[z /mem_drop Hm|]. - rewrite /in_dom_with dom_set getP !inE /#. - rewrite /in_dom_with in Hz. - rewrite /in_dom_with dom_set getP !inE; smt(mem_head_behead). - by auto=>?&mr/=[#]3->/=;split=>// z;rewrite -memE dom_restr. -qed. - -lemma eager_restrK: - eager [RRO.resample(); , FRO.restrK ~ RRO.restrK, RRO.resample(); : - ={FRO.m} ==> ={res,FRO.m} ]. -proof. - eager proc;inline *;wp. - while (={l,FRO.m} /\ (forall z, mem l z => in_dom_with FRO.m z Unknown){1} /\ - restr Known FRO.m{1} = result{2}). - + auto=>?&mr[#]2->Hz<-?H/=?->/=. - split=>[z /mem_drop Hm|];1:by rewrite /in_dom_with dom_set getP !inE /#. - rewrite restr_set rem_id?dom_restr//. - by move:H=>/(mem_head_behead witness) /(_ (head witness l{mr})) /= /Hz /#. - by auto=>?&mr/=->/=;split=>// z;rewrite -memE dom_restr. -qed. - -lemma eager_sample: - eager [RRO.resample(); , FRO.sample ~ RRO.sample, RRO.resample(); : - ={x,FRO.m} ==> ={res,FRO.m} ]. -proof. - eager proc. - case (!mem (dom (FRO.m{2})) x{2}). - + rcondt{2}2;1:by auto. - transitivity{2} { - c <$ sampleto x; FRO.m.[x] <- (c, Unknown); - Iter(RRO.I).iter_1s(x,elems ((dom (restr Unknown FRO.m)) `\` fset1 x));} - (={x,FRO.m} /\ ! mem (dom FRO.m{2}) x{2} ==> ={x,FRO.m}) - (={x,FRO.m} /\ ! mem (dom FRO.m{2}) x{2} ==> ={x,FRO.m})=>//;last first. - + inline{2} RRO.resample;call (iter1_perm RRO.I iter_perm2);auto=>?&mr[#]2->Hmem/=?->/=. - by apply /perm_eq_sym/perm_to_rem;rewrite restr_set/=dom_set !inE. - + by move=>?&mr[#]2->?;exists FRO.m{mr} x{mr}. - inline Iter(RRO.I).iter_1s RRO.I.f RRO.resample;wp;swap{1}-1. - seq 1 7 : (={x} /\ eq_except FRO.m{1} FRO.m{2} (pred1 x{1}) /\ - l{2} = (elems (dom (restr Unknown FRO.m))){1} /\ - (FRO.m.[x]){2} = Some(c{1},Unknown) /\ (FRO.m.[x]){1} = None). - + wp;rnd;auto=>?&mr[#]2->; rewrite in_dom /=. - move=> Heq; split; first apply sampleto_ll. - move=> _ c _ ??; split=> // _. - rewrite getP_eq restr_set/=dom_set fsetDK eq_except_sym set_set Heq/=set_eq_except/=. - congr;apply fsetP=>z;rewrite in_fsetD1 dom_restr /in_dom_with !in_dom /#. - exists*x{1},c{1};elim*=>x1 c1;pose mx2:=Some(c1,Unknown). - call (iter_inv RRO.I (fun z=>x1<>z) - (fun o1 o2 => eq_except o1 o2 (pred1 x1) /\ o1.[x1]= None /\ o2.[x1]=mx2) _). - + by conseq (I_f_eqex x1 None mx2). - auto=>?&mr[#]2<-->^Hex 3!->^Hx1-> @/mx2/=;split=>[z|_ mL mR[#]]. - + rewrite -memE dom_restr /in_dom_with in_dom /#. - rewrite in_dom=>Hex'->HRx/=;apply /eq_sym. - have/(congr1 oget):=HRx=><-;apply eq_except_set_eq;1:by rewrite in_dom HRx. - by apply eq_except_sym. - rcondf{2}2;1:by auto. - swap{1}2-1;inline*;auto. - while (={l,FRO.m} /\ (mem (dom FRO.m) x){1});auto. - by move=>?&mr[#]2->Hm Hl _/=?->;rewrite dom_set !inE Hm. -qed. - -section. - -declare module D:FRO_Distinguisher {FRO}. - -lemma eager_D : eager [RRO.resample(); , D(FRO).distinguish ~ - D(RRO).distinguish, RRO.resample(); : - ={glob D,FRO.m} ==> ={FRO.m, glob D} /\ ={res} ]. -proof. - eager proc (H_: RRO.resample(); ~ RRO.resample();: ={FRO.m} ==> ={FRO.m}) - (={FRO.m})=>//; try by sim. - + by apply eager_init. + by apply eager_get. + by apply eager_set. - + by apply eager_rem. + by apply eager_sample. - + by apply eager_in_dom. + by apply eager_restrK. -qed. - -module Eager (D:FRO_Distinguisher) = { - - proc main1() = { - var b; - FRO.init(); - b <@ D(FRO).distinguish(); - return b; - } - - proc main2() = { - var b; - FRO.init(); - b <@ D(RRO).distinguish(); - RRO.resample(); - return b; - } - -}. - -equiv Eager_1_2: Eager(D).main1 ~ Eager(D).main2 : - ={glob D} ==> ={res,glob FRO, glob D}. -proof. - proc. - transitivity{1} - { FRO.init(); RRO.resample(); b <@ D(FRO).distinguish(); } - (={glob D} ==> ={b,FRO.m,glob D}) - (={glob D} ==> ={b,FRO.m,glob D})=> //. - + by move=> ?&mr->;exists (glob D){mr}. - + inline *;rcondf{2}3;2:by sim. - by auto=>?;rewrite restr0 dom0 elems_fset0. - seq 1 1: (={glob D, FRO.m});1:by inline *;auto. - by eager call eager_D. -qed. - -end section. - -equiv LRO_RRO_init : LRO.init ~ RRO.init : true ==> RO.m{1} = restr Known FRO.m{2}. -proof. by proc;auto=>/=;rewrite restr0. qed. - -equiv LRO_RRO_get : LRO.get ~ RRO.get : - ={x} /\ RO.m{1} = restr Known FRO.m{2} ==> ={res} /\ RO.m{1} = restr Known FRO.m{2}. -proof. - proc;auto=>?&ml[]->->/=?->/=. - rewrite dom_restr orabP negb_and neqK_eqU. - rewrite !restr_set/= !getP_eq oget_some;progress. - by move:H;rewrite negb_or/= restrP in_dom /#. -qed. - -equiv LRO_RRO_set : LRO.set ~ RRO.set : - ={x,y} /\ RO.m{1} = restr Known FRO.m{2} ==> RO.m{1} = restr Known FRO.m{2}. -proof. by proc;auto=>?&ml[#]3->;rewrite restr_set. qed. - -equiv LRO_RRO_rem : LRO.rem ~ RRO.rem : - ={x} /\ RO.m{1} = restr Known FRO.m{2} ==> RO.m{1} = restr Known FRO.m{2}. -proof. - proc;inline *;auto=>?&mr[#]->->. rewrite restr_rem. - case (in_dom_with FRO.m{mr} x{mr} Known)=>// Hidw. - by rewrite rem_id // dom_restr. -qed. - -equiv LRO_RRO_sample : LRO.sample ~ RRO.sample: - ={x} /\ RO.m{1} = restr Known FRO.m{2} ==> RO.m{1} = restr Known FRO.m{2}. -proof. - proc;auto=>?&ml[]_->. -split=> [| _ ? _]; first apply sampleto_ll. -rewrite restr_set /==>Hnd. -by rewrite rem_id // dom_restr /in_dom_with Hnd. -qed. - -lemma LRO_RRO_D (D<:RO_Distinguisher{RO,FRO}) : - equiv [D(LRO).distinguish ~ D(RRO).distinguish : - ={glob D} /\ RO.m{1} = restr Known FRO.m{2} ==> - ={res,glob D} /\ RO.m{1} = restr Known FRO.m{2} ]. -proof. - proc (RO.m{1} = restr Known FRO.m{2})=>//. - + by conseq LRO_RRO_init. + by conseq LRO_RRO_get. + by conseq LRO_RRO_set. - + by conseq LRO_RRO_rem. + by conseq LRO_RRO_sample. -qed. - -section. - -declare module D : RO_Distinguisher{RO,FRO}. - -local module M = { - proc main1() = { - var b; - RRO.resample(); - b <@ D(FRO).distinguish(); - return b; - } - - proc main2() = { - var b; - b <@ D(RRO).distinguish(); - RRO.resample(); - return b; - } -}. - -lemma RO_LRO_D : - equiv [D(RO).distinguish ~ D(LRO).distinguish : - ={glob D,RO.m} ==> ={res,glob D}]. -proof. - transitivity M.main1 - (={glob D} /\ FRO.m{2} = map (fun _ c => (c,Known)) RO.m{1} ==> - ={res,glob D}) - (={glob D} /\ FRO.m{1} = map (fun _ c => (c,Known)) RO.m{2} ==> - ={res,glob D})=>//. - + by move=>?&mr[]2!->;exists (glob D){mr}(map(fun _ c =>(c,Known))RO.m{mr}). - + proc*;inline M.main1;wp;call (RO_FRO_D D);inline *. - rcondf{2}2;auto. - + move=> &mr[]_->;apply mem_eq0=>z;rewrite -memE dom_restr /in_dom_with mapP dom_map in_dom. - by case(RO.m{m}.[_]). - by move=>?&mr[]2!->/=;rewrite map_comp /fst/= map_id. - transitivity M.main2 - (={glob D, FRO.m} ==> ={res, glob D}) - (={glob D} /\ FRO.m{1} = map (fun _ c => (c,Known)) RO.m{2} ==> - ={res,glob D})=>//. - + by move=>?&mr[]2!->;exists (glob D){mr} (map(fun _ c =>(c,Known))RO.m{mr}). - + by proc; eager call (eager_D D);auto. - proc*;inline M.main2;wp;call{1} RRO_resample_ll. - symmetry;call (LRO_RRO_D D);auto=> &ml&mr[#]2->;split=>//=. - by rewrite fmapP=>x;rewrite restrP mapP;case (RO.m{ml}.[x]). -qed. - -end section. - -end GenEager. diff --git a/proof/SHA3-Security.ec b/proof/SHA3-Security.ec index 3116fcd..fad7927 100644 --- a/proof/SHA3-Security.ec +++ b/proof/SHA3-Security.ec @@ -2,9 +2,13 @@ require import AllCore List IntDiv StdOrder Distr SmtMap FSet. -require import Common Sponge. import BIRO. +require (*--*) Common Sponge SLCommon Gconcl_list BlockSponge. -require SLCommon Gconcl_list BlockSponge. +clone import IRO as BIRO with + type from <- bool list, + type to <- bool, + op valid <- predT, + op dto <- {0,1}. (* FIX: would be nicer to define limit at top-level and then clone BlockSponge with it - so BlockSponge would then clone lower-level diff --git a/proof/smart_counter/Handle.eca b/proof/smart_counter/Handle.eca index 2c4c4f0..08febc2 100644 --- a/proof/smart_counter/Handle.eca +++ b/proof/smart_counter/Handle.eca @@ -354,7 +354,7 @@ proof. case=>h0 h0' h1 h2 _ l hl i. case(l = [])=>//=l_notnil. case(0 <= i)=>hi0;last first. -+ rewrite take_le0 1:/#;cut<-:=take0 l;smt(domE size_ge0). ++ by rewrite take_le0 1:/# domE h0. case(i < size l)=>hisize;last smt(take_oversize). smt(domE). qed. @@ -660,7 +660,8 @@ lemma build_hpath_prefix mh p b v h: build_hpath mh (rcons p b) = Some (v,h) <=> (exists v' h', build_hpath mh p = Some (v',h') /\ mh.[(v' +^ b,h')] = Some (v,h)). proof. -rewrite build_hpathP; split=> [[/#|p' b' v' h' [#] + Hhpath Hmh]|[v' h'] [] Hhpath Hmh]. +rewrite build_hpathP; split=> [[|p' b' v' h' [#] + Hhpath Hmh]|[v' h'] [] Hhpath Hmh]. ++ smt(size_rcons size_ge0). + by move=> ^/rconsIs <<- {b'} /rconssI <<- {p'}; exists v' h'. exact/(Extend _ _ _ _ _ Hhpath Hmh). qed. @@ -683,7 +684,8 @@ lemma build_hpath_down mh xa hx ya hy p v h: => build_hpath mh p = Some (v,h). proof. move=> no_path_to_hx. -elim/last_ind: p v h=> [v h /build_hpathP [<*>|/#] //=|p b ih]. +elim/last_ind: p v h=> [v h /build_hpathP [<*>|] //=|p b ih]. ++ smt(size_ge0 size_rcons). move=> v h /build_hpathP [/#|p' b' + + ^/rconsIs <<- /rconssI <<-]. move=> v' h' /ih; rewrite get_setE. case: ((v' +^ b,h') = (xa,hx))=> [/#|_ Hpath Hextend]. @@ -717,8 +719,9 @@ lemma path_split hs ch m mh xc hx p xa: /\ hs.[hz] = Some (zc,Unknown). proof. move=> Ihs [] _ Imh_m. -elim/last_ind: p hx xa xc=> [hx xa xc + /build_hpathP [_ <*>|/#]|]. +elim/last_ind: p hx xa xc=> [hx xa xc + /build_hpathP [_ <*>|]|]. + by have [] _ -> _ [#]:= Ihs. ++ smt(size_ge0 size_rcons). move=> p b ih hx xa xc hs_hx /build_hpath_prefix. move=> [ya hy] [#] path_p_hy ^mh_yabh' /Imh_m [yc fy ? ?] [#] hs_hy. rewrite hs_hx=> /= [#] <<*> _; case: fy hs_hy. @@ -1418,10 +1421,13 @@ case @[ambient]: {-1}(Pmi.[(xa,xc)]) (eq_refl Pmi.[(xa,xc)])=> [Pmi_xaxc|[ya yc] by have /hs_of_INV [] _ _ H /H {H} := inv0. + rewrite domE/=;cut[]h1 h2:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. cut h1':=h1 ya yc. - cut :Pm.[(ya, yc)] <> None => exists (hx : handle) (fx : flag), hs.[hx] = Some (yc, fx) by rewrite/#. + cut :Pm.[(ya, yc)] <> None => exists (hx : handle) (fx : flag), hs.[hx] = Some (yc, fx). + + move=> y_in_Pm; move: (h1' (oget Pm.[(ya,yc)]).`1 (oget Pm.[(ya,yc)]).`2 _). + + by move: y_in_Pm; case: (Pm.[(ya,yc)])=> - //= []. + by move=> [hx fx hy fy] [#] h _ _; exists hx fx. case(Pm.[(ya, yc)] = None)=>//=h; rewrite negb_exists/==>a;rewrite negb_exists/==>b. - cut:=yc_notrngE1_hs_addh a b;rewrite get_setE;case(a=ch)=>//=hach. search (&&). + cut:=yc_notrngE1_hs_addh a b;rewrite get_setE;case(a=ch)=>//=hach. case(xc=yc)=>[/#|]hxyc. cut[]_ _ help:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. by cut/#:=help (yc,b) a. @@ -1442,7 +1448,10 @@ case @[ambient]: {-1}(Pmi.[(xa,xc)]) (eq_refl Pmi.[(xa,xc)])=> [Pmi_xaxc|[ya yc] apply/lemma2'=> //. + rewrite domE/=;cut[]h1 _:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. cut h1':=h1 y1 y2. - cut :Pm.[(y1, y2)] <> None => exists (hx : handle) (fx : flag), hs.[hx] = Some (y2, fx) by rewrite/#. + cut :Pm.[(y1, y2)] <> None => exists (hx : handle) (fx : flag), hs.[hx] = Some (y2, fx). + + move=> y_in_Pm; move: (h1' (oget Pm.[(y1,y2)]).`1 (oget Pm.[(y1,y2)]).`2 _). + + by move: y_in_Pm; case: (Pm.[(y1,y2)])=> - //= []. + by move=> [hx fx hy fy] [#] h _ _; exists hx fx. case(Pm.[(y1, y2)] = None)=>//=h; rewrite negb_exists/==>a;rewrite negb_exists/==>b. exact(y2_notrngE1_hs). @@ -1856,7 +1865,9 @@ proof. move=>Hinv H_size H_take_i H_hs_h. case(Pm.[(b +^ nth witness p i, c)] = None)=>//=H_Pm. + right;move:H_Pm;apply absurd=>H_mh. - cut[]b1 h1 H_mh1:exists b1 h1, mh.[(b +^ nth witness p i, h)] = Some (b1,h1) by rewrite/#. + cut[]b1 h1 H_mh1:exists b1 h1, mh.[(b +^ nth witness p i, h)] = Some (b1,h1). + + exists (oget mh.[(b +^ nth witness p i, h)]).`1 (oget mh.[(b +^ nth witness p i, h)]).`2. + by move: H_mh; case: (mh.[(b +^ nth witness p i, h)])=> //= - []. cut[]H_Pm H_Gmh:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ Hinv. by cut/#:=H_Gmh _ _ _ _ H_mh1. cut[]b1 c1 H_Pm1:exists b1 c1, Pm.[(b +^ nth witness p i, c)] = Some (b1,c1) @@ -1953,7 +1964,7 @@ proof. * by cut[]:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H0. * by cut[]:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H0;smt(take0 domE). * by rewrite build_hpathP; apply/Empty=> //; exact/take0. - * by cut[]:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H0;smt(take0 domE size_take size_eq0). + * by cut[]:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H0; smt(take0 domE size_take size_eq0 size_ge0). * smt(prefix_sizel). case(G1.bcol{2} \/ G1.bext{2}). @@ -2084,9 +2095,18 @@ proof. /\ (i{2} < size p{2} => ! take (i{2}+1) p{2} \in Redo.prefixes{1})));last first. + auto;progress. - smt(prefix_sizel). - - cut[]HINV _:=H3 H6;split;..-2:case:HINV=>//=. - by cut[]Hmp01 Hmp02 Hmp1 Hmp2 Hmp3:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV; - split=>//=;smt(take0 get_setE mem_set take_oversize take_le0). + - cut[]HINV [#] ->> _ _ _ h_sa_b0:=H3 H6;split;..-2:case:HINV=>//=. + cut[]Hmp01 Hmp02 Hmp1 Hmp2 Hmp3:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV; split=> //=. + + move: h_sa_b0; case: (prefix p{2} (get_max_prefix p{2} (elems (fdom C.queries{2}))) = 0). + + by move=> -> [#] ->> _; rewrite take0 get_set_sameE. + smt(size_take get_setE). + + move=> l; rewrite mem_set=> - []. + + move=> /Hmp2 [c] h. + case: (l = take (prefix p{2} (get_max_prefix p{2} (elems (fdom C.queries{2})))) p{2}). + + by move=> ->>; exists sc{1}; rewrite get_set_sameE H. + by move=> n_not_crap; exists c; rewrite get_set_neqE. + by move=> ->>; exists sc{1}; rewrite get_set_sameE H. + by move=> l /Hmp3 [l2] ll2_in_q; exists l2; rewrite mem_set ll2_in_q. - by cut[]HINV _:=H3 H6;cut:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. - rewrite/#. - rewrite/#. @@ -2213,7 +2233,11 @@ proof. * cut:=prefix_exchange_prefix_inv(elems (fdom C.queries{2}))(elems (fdom prefixes{1}))bs{1} _ _ _. + by cut[]:=H_m_p0;smt(domE memE mem_fdom). + cut[]Hmp01 Hmp02 Hmp1 Hmp2 Hmp3:=H_m_p0. - by cut:=all_prefixes_of_m_p _ _ _ H_m_p0;smt(memE domE mem_fdom). + cut:=all_prefixes_of_m_p _ _ _ H_m_p0. + + move=> h_prefixes l2; rewrite -memE mem_fdom=> /Hmp2 [c]. + move=> pl2; move: (h_prefixes l2 _). + + by rewrite domE pl2. + by move=> + i - /(_ i); rewrite -memE mem_fdom. + by cut[]:=H_m_p0;smt(memE domE mem_fdom). by move=>H_pref_eq;rewrite -mem_fdom memE prefix_lt_size//= -H_pref_eq/#. by move=>j;case(0<=j<=i{2})=>//=[][]Hj0 Hji;smt(size_take prefix_ge0 take_le0). @@ -2387,7 +2411,7 @@ proof. cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness bs{1} i{2}) y1L p0 v hx. rewrite h_build_hpath_set/=h_g1/=. cut->/=:=ch_neq0 _ _ H_hs_spec. - by cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec H_h;smt(dom_hs_neq_ch). + by cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec H_h; smt(dom_hs_neq_ch). progress. + cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness bs{1} i{2}) y1L p0 v hx. cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness bs{1} i{2}) y1L p' v' hx. diff --git a/proof/smart_counter/JointFMap.ec b/proof/smart_counter/JointFMap.ec deleted file mode 100644 index 7f53422..0000000 --- a/proof/smart_counter/JointFMap.ec +++ /dev/null @@ -1,19 +0,0 @@ -require import SmtMap. - -(*****) import Finite FSet List. - -op (+) (m1 m2 : ('a,'b) fmap) : ('a,'b) fmap = - ofmap (Map.offun (fun x=> if x \in m2 then m2.[x] else m1.[x])). - -lemma joinE ['a 'b] (m1 m2 : ('a,'b) fmap) (x : 'a): - (m1 + m2).[x] = if x \in m2 then m2.[x] else m1.[x]. -proof. -rewrite /(+) getE ofmapK /= 2:Map.getE 2:Map.offunK //. -apply/finiteP=> /=; exists (elems (fdom m1) ++ elems (fdom m2))=> x0 /=. -rewrite Map.getE Map.offunK /= mem_cat -!memE !mem_fdom !domE. -by case: (m2.[x0]). -qed. - -lemma mem_join ['a 'b] (m1 m2 : ('a,'b) fmap) (x : 'a): - x \in (m1 + m2) <=> x \in m1 \/ x \in m2. -proof. by rewrite domE joinE !domE; case: (m2.[x]). qed. \ No newline at end of file diff --git a/proof/smart_counter/Strong_rp_rf.eca b/proof/smart_counter/Strong_rp_rf.eca deleted file mode 100644 index bf36112..0000000 --- a/proof/smart_counter/Strong_rp_rf.eca +++ /dev/null @@ -1,608 +0,0 @@ -(* -------------------------------------------------------------------- - * Copyright (c) - 2012--2016 - IMDEA Software Institute - * Copyright (c) - 2012--2018 - Inria - * Copyright (c) - 2012--2018 - Ecole Polytechnique - * - * Distributed under the terms of the CeCILL-B-V1 license - * -------------------------------------------------------------------- *) - -require import AllCore Distr List FSet NewFMap StdRing StdOrder. -require import Dexcepted. -require (*--*) NewPRP StrongPRP IdealPRP FelTactic. -(*---*) import RField RealOrder. - -(** We assume a finite domain D, equipped with its uniform - distribution. **) -type D. -op uD: { D distr | is_uniform uD /\ is_lossless uD /\ is_full uD } as uD_uf_fu. - -(** and a type K equipped with a lossless distribution **) -type K. -op dK: { K distr | is_lossless dK } as dK_ll. - -clone import StrongPRP as PRPt with - type K <- K, - op dK <- dK, - type D <- D -proof * by smt(dK_ll) -rename "StrongPRP_" as "". - -clone import IdealPRP as PRPi with - type K <- K, - op dK <- dK, - type D <- D, - op dD <- uD -proof * by smt ml=0 w=(dK_ll uD_uf_fu) -rename "RandomPermutation" as "PRPi". - -(* This is an "Almost (Random Permutation)" (the Almost applies to Permutation) *) -(* We keep track of collisions explicitly because it's going to be useful anyway *) -module ARP = { - var coll : bool - var m, mi: (D,D) fmap - - proc init(): unit = { - m <- map0; - mi <- map0; - coll <- false; - } - - proc f(x : D) = { - var y; - - if (!mem (dom m) x) { - y <$ uD; - coll <- coll \/ mem (rng m) y; - m.[x] <- y; - mi.[y] <- x; - } - return oget m.[x]; - } - - proc fi(y : D) = { - var x; - - if (!mem (dom mi) y) { - x <$ uD; - coll <- coll \/ mem (rng mi) x; - m.[x] <- y; - mi.[y] <- x; - } - return oget mi.[y]; - } -}. - -op q : { int | 0 <= q } as ge0_q. - -(** To factor out the difficult step, we parameterize the PRP by a - procedure that samples its output, and provide two instantiations - of it. **) -module type Sample_t = { - proc sample(X:D fset): D -}. - -module Direct = { - proc sample(X:D fset): D = { - var r; - - r = $uD \ (mem X); - return r; - } -}. - -module Indirect = { - proc sample(X:D fset): D = { - var r; - - r = $uD; - if (mem X r) { - r = $uD \ (mem X); - } - return r; - } -}. - -module PRPi'(S:Sample_t) = { - proc init = PRPi.init - - proc f(x:D): D = { - if (!mem (dom PRPi.m) x) { - PRPi.m.[x] = S.sample(rng PRPi.m); - PRPi.mi.[oget PRPi.m.[x]] <- x; - } - return oget PRPi.m.[x]; - } - - proc fi(x:D): D = { - if (!mem (dom PRPi.mi) x) { - PRPi.mi.[x] = S.sample(rng PRPi.mi); - PRPi.m.[oget PRPi.mi.[x]] <- x; - } - return oget PRPi.mi.[x]; - } -}. - -(* Some losslessness lemmas *) -(* FIXME: cleanup *) - -(* FIXME: Duplicate lemmas with RP_RF *) -lemma nosmt notin_supportIP (P : 'a -> bool) (d : 'a distr): - (exists a, support d a /\ !P a) <=> mu d P < mu d predT. -proof. -rewrite (mu_split _ predT P) /predI /predT /predC /=. -rewrite (exists_eq (fun a => support d a /\ !P a) (fun a => !P a /\ a \in d)) /=. -+ by move=> a /=; rewrite andbC. -by rewrite -(witness_support (predC P)) -/(predC _) /#. -qed. - -lemma excepted_lossless (m:(D,D) fmap): - (exists x, !mem (dom m) x) => - mu (uD \ (mem (rng m))) predT = 1%r. -proof. -move=> /endo_dom_rng [x h]; rewrite dexcepted_ll //. -+ smt w=uD_uf_fu. -have [?[<- @/is_full Hsupp]]:= uD_uf_fu. -apply/notin_supportIP;exists x => />;apply Hsupp. -qed. - -phoare Indirect_ll: [Indirect.sample: exists x, support uD x /\ !mem X x ==> true] = 1%r. -proof. -proc; seq 1: (exists x, support uD x /\ !mem X x)=> //=. -+ by rnd (predT); skip; smt ml=0 w=uD_uf_fu. -if=> //=. -+ rnd (predT); skip. - by progress [-split]; split=> //=; smt. -by hoare; rnd=> //=; skip=> &hr ->. -qed. - -lemma PRPi'_Indirect_f_ll: islossless PRPi'(Indirect).f. -proof. -proc; if=> //=; auto; call Indirect_ll. -skip=> /> &hr x_notin_m. -have [x0] x0_notinr_m := endo_dom_rng PRPi.m{hr} _; first by exists x{hr}. -by exists x0; rewrite x0_notinr_m /=; smt w=uD_uf_fu. -qed. - -lemma PRPi'_Indirect_fi_ll: islossless PRPi'(Indirect).fi. -proof. -proc; if=> //=; auto; call Indirect_ll. -skip=> /> &hr x_notin_mi. -have [x0] x0_notinr_mi := endo_dom_rng PRPi.mi{hr} _; first by exists x{hr}. -by exists x0; rewrite x0_notinr_mi; smt w=uD_uf_fu. -qed. - -(** The proof is cut into 3 parts (sections): - - We first focus on proving - Pr[IND(PRPi'(Indirect),D).main() @ &m: res] - <= Pr[IND(PRFi,D).main() @ &m: res] - + Pr[IND(PRFi,D).main() @ &m: collision PRFi.m]. - - Second, we concretely bound (when the PRF oracle stops - answering queries after the q-th): - Pr[IND(PRFi,D).main() @ &m: collision PRFi.m] - <= q^2 * Pr[x = $uD: x = witness] - - We conclude by proving (difficult!) - Pr[IND(PRPi,D).main() @ &m: res] - = Pr[IND(PRPi'(Indirect),D).main() @ &m: res]. - - Purists are then invited to turn the security statement about - restricted oracles into a security statement about restricted - adversaries. **) -section Upto. - declare module D:Distinguisher {PRPi, ARP}. - axiom D_ll (O <: Oracles {D}): islossless O.f => islossless O.fi => islossless D(O).distinguish. - - local module PRP_indirect_bad = { - var bad : bool - - proc init(): unit = { - PRPi.init(); - bad <- false; - } - - proc sample(X:D fset): D = { - var r; - - r = $uD; - if (mem X r) { - bad <- true; - r = $uD \ (mem X); - } - return r; - } - - proc f(x:D): D = { - if (!mem (dom PRPi.m) x) { - PRPi.m.[x] = sample(rng PRPi.m); - PRPi.mi.[oget PRPi.m.[x]] <- x; - } - return oget PRPi.m.[x]; - } - - proc fi(y:D): D = { - if (!mem (dom PRPi.mi) y) { - PRPi.mi.[y] = sample(rng PRPi.mi); - PRPi.m.[oget PRPi.mi.[y]] <- y; - } - return oget PRPi.mi.[y]; - } - }. - - local lemma PRPi'_Indirect_eq &m: - Pr[IND(PRPi'(Indirect),D).main() @ &m: res] - = Pr[IND(PRP_indirect_bad,D).main() @ &m: res]. - proof. by byequiv=> //=; proc; inline *; sim. qed. - - (** Upto failure: if a collision does not occur in PRFi.m, then the - programs are equivalent **) - lemma pr_PRPi'_Indirect_ARP &m: - `|Pr[IND(PRPi'(Indirect),D).main() @ &m: res] - - Pr[IND(ARP,D).main() @ &m: res]| - <= Pr[IND(ARP,D).main() @ &m: ARP.coll]. - proof. - rewrite (PRPi'_Indirect_eq &m). - byequiv: PRP_indirect_bad.bad=> //=; 2:smt ml=0. - proc. - call (_: ARP.coll, - !PRP_indirect_bad.bad{1} /\ ={m,mi}(PRPi,ARP), - (PRP_indirect_bad.bad{1} <=> ARP.coll{2})). - + exact D_ll. - + proc. if=> //=; inline *. - swap{1} 1. - seq 1 4: (={x} /\ - !mem (dom PRPi.m{1}) x{1} /\ - ARP.m{2} = PRPi.m.[x <- r]{1} /\ - ARP.mi{2} = PRPi.mi.[r <- x]{1} /\ - ((PRP_indirect_bad.bad \/ mem (rng PRPi.m) r){1} <=> ARP.coll{2})). - by auto=> /#. - sp; if{1}. - conseq (_: PRP_indirect_bad.bad{1} /\ ARP.coll{2})=> //=. - auto; progress [-split]; split=> //= [|_]; 1:smt. - by progress; right. - by auto; progress [-split]; rewrite H0 /=; split=> //=; rewrite getP. - + move=> &2 bad; conseq (_: true ==> true: =1%r) - (_: PRP_indirect_bad.bad ==> PRP_indirect_bad.bad)=> //=. - by proc; if=> //=; inline *; seq 2: PRP_indirect_bad.bad; [auto|if=> //=; auto]. - proc; if=> //=; inline *. - seq 2: (X = rng PRPi.m /\ !mem (dom PRPi.m) x) 1%r 1%r 0%r _ => //=. - by auto; rewrite -/predT; smt ml=0 w=uD_uf_fu. (* predT should be an abbreviation *) - by if=> //=; auto; smt. - by hoare; auto. - + move=> &1. - proc; if; auto; progress [-split]; rewrite -/predT; split=> //= [|_]; 1:smt ml=0 w=uD_uf_fu. - by progress [-split]; rewrite H. - + proc. if=> //=; inline *. - swap{1} 1. - seq 1 4: (={y} /\ - !mem (dom PRPi.mi{1}) y{1} /\ - ARP.m{2} = PRPi.m.[r <- y]{1} /\ - ARP.mi{2} = PRPi.mi.[y <- r]{1} /\ - ((PRP_indirect_bad.bad \/ mem (rng PRPi.mi) r){1} <=> ARP.coll{2})). - by auto=> /#. - sp; if{1}. - conseq (_: PRP_indirect_bad.bad{1} /\ ARP.coll{2})=> //=. - auto; progress [-split]; split=> //= [|_]; 1:smt. - by progress; right. - by auto; progress [-split]; rewrite H0 /=; split=> //=; rewrite getP. - + move=> &2 bad; conseq (_: true ==> true: =1%r) - (_: PRP_indirect_bad.bad ==> PRP_indirect_bad.bad)=> //=. - by proc; if=> //=; inline *; seq 2: PRP_indirect_bad.bad; [auto|if=> //=; auto]. - proc; if=> //=; inline *. - seq 2: (X = rng PRPi.mi /\ !mem (dom PRPi.mi) y) 1%r 1%r 0%r _ => //=. - by auto; rewrite -/predT; smt ml=0 w=uD_uf_fu. (* predT should be an abbreviation *) - by if=> //=; auto; smt. - by hoare; auto. - + move=> &1. - proc; if; auto; progress [-split]; rewrite -/predT; split=> //= [|_]; 1:smt ml=0 w=uD_uf_fu. - by progress [-split]; rewrite H. - by inline *; auto; progress; smt. - qed. -end section Upto. - -(** We now bound the probability of collisions. We cannot do so - by instantiating the generic Birthday Bound result. It's still - the Birthday Bound, though, just not generic: - Pr[IND(ARP,DBounder(D)).main() @ &m: ARP.coll] - <= q^2 * Pr[x = $uD: x = witness], - - where DBounder prevents the distinguisher from calling the - f-oracle more than q times. **) -module DBounder (D:Distinguisher,F:Oracles) = { - module FBounder = { - var c:int - - proc f(x:D): D = { - var r = witness; - - if (c < q) { - r = F.f(x); - c = c + 1; - } - return r; - } - - proc fi(x:D): D = { - var r = witness; - - if (c < q) { - r = F.fi(x); - c = c + 1; - } - return r; - } - } - - proc distinguish(): bool = { - var b; - - FBounder.c <- 0; - b <@ D(FBounder).distinguish(); - return b; - } -}. - -section CollisionProbability. - require import Mu_mem. - (*---*) import StdBigop StdRing StdOrder IntExtra. - (*---*) import Bigreal.BRA RField RField.AddMonoid IntOrder. - - declare module D:Distinguisher {ARP, DBounder}. - axiom D_ll (O <: Oracles {D}): islossless O.f => islossless O.fi => islossless D(O).distinguish. - - local module FEL (D : Distinguisher) = { - var c : int - - module FBounder = { - proc f(x:D): D = { - var r = witness; - - if (c < q) { - if (card (rng ARP.m) < q) { - r = ARP.f(x); - } - c = c + 1; - } - return r; - } - - proc fi(x:D): D = { - var r = witness; - - if (c < q) { - if (card (rng ARP.mi) < q) { - r = ARP.fi(x); - } - c = c + 1; - } - return r; - } - } - - proc main(): bool = { - var b : bool; - - ARP.init(); - c <- 0; - b <@ D(FBounder).distinguish(); - return b; - } - }. - - lemma pr_PRFi_collision &m: - Pr[IND(ARP,DBounder(D)).main() @ &m: ARP.coll] - <= (q^2)%r / 2%r * mu uD (pred1 witness). - proof. - have ->: Pr[IND(ARP,DBounder(D)).main() @ &m: ARP.coll] - = Pr[IND(ARP,DBounder(D)).main() @ &m: ARP.coll /\ DBounder.FBounder.c <= q]. - + byequiv=> //=; conseq (_: ={glob D} ==> ={ARP.coll,DBounder.FBounder.c}) - (_: true ==> DBounder.FBounder.c <= q)=> //=. - * proc; inline *; wp; call (_: DBounder.FBounder.c <= q). - - by proc; sp; if=> //=; inline*; sp; if=> //=; auto=> /#. - - by proc; sp; if=> //=; inline*; sp; if=> //=; auto=> /#. - by auto=> /=; apply/ge0_q. - by sim. - have ->: Pr[IND(ARP,DBounder(D)).main() @ &m: ARP.coll /\ DBounder.FBounder.c <= q] - = Pr[FEL(D).main() @ &m: ARP.coll /\ FEL.c <= q]. - + byequiv=> //=; proc; inline *; wp. - call (_: ={glob ARP} /\ ={c}(DBounder.FBounder,FEL) /\ card (rng ARP.m){1} <= FEL.c{2} /\ card (rng ARP.mi){1} <= FEL.c{2}). - * proc; sp; if=> //=. rcondt{2} 1; first by auto=> /#. - inline *; sp; if=> //=; auto. - - progress. - + apply/(ler_trans (card (rng ARP.m{2} `|` fset1 yL))). - apply/subset_leq_fcard=> x; rewrite rng_set !inE rng_rem in_rng. - by move=> [[a] [] _ ma|-> //=]; left; exists a. - smt. - + apply/(ler_trans (card (rng ARP.mi{2} `|` fset1 x{2}))). - apply/subset_leq_fcard=> x; rewrite rng_set !inE rng_rem in_rng. - by move=> [[a] [] _ ma|-> //=]; left; exists a. - smt. - - smt ml=0. - * proc; sp; if=> //=. rcondt{2} 1; first by auto=> /#. - inline *; sp; if=> //=; auto. - - progress. - + apply/(ler_trans (card (rng ARP.m{2} `|` fset1 x{2}))). - apply/subset_leq_fcard=> x; rewrite rng_set !inE rng_rem in_rng. - by move=> [[a] [] _ ma|-> //=]; left; exists a. - smt. - + apply/(ler_trans (card (rng ARP.mi{2} `|` fset1 x0L))). - apply/subset_leq_fcard=> x; rewrite rng_set !inE rng_rem in_rng. - by move=> [[a] [] _ ma|-> //=]; left; exists a. - smt. - - smt ml=0. - by auto; progress; rewrite rng0 fcards0. - fel 2 FEL.c (fun x, x%r * mu uD (pred1 witness)) q (ARP.coll) [FEL(D).FBounder.f: (FEL.c < q); FEL(D).FBounder.fi: (FEL.c < q)] (size ARP.m <= FEL.c /\ size ARP.mi <= FEL.c)=> //. - + rewrite-mulr_suml Bigreal.sumidE 1:ge0_q. - by rewrite (powS 1) // pow1;smt(mu_bounded ge0_q). - + by inline*; auto; smt(dom0 fcards0 sizeE). - + exists*FEL.c;elim*=> c. - conseq(:_==>_ : (c%r * mu1 uD witness));progress. - proc; sp; rcondt 1=> //. - inline *; sp; if=> //=; last first. - * hoare; auto=> // /> &hr _ _ _ _ _ _. - by apply/RealOrder.mulr_ge0; smt w=(mu_bounded ge0_q). - sp; if=> //=. - * wp; rnd (mem (rng ARP.m)); skip. - progress. - - apply/(RealOrder.ler_trans ((card (rng ARP.m{hr}))%r * mu uD (pred1 witness))). - apply/mu_mem_le; move=> x _; have [] uD_suf [] ? uD_fu:= uD_uf_fu. - apply/RealOrder.lerr_eq/uD_suf; 1,2:rewrite uD_fu //. - by apply/RealOrder.ler_wpmul2r; smt w=(mu_bounded lt_fromint ltrW sizeE leq_card_rng_dom). - - by move: H9;rewrite H1. - * by hoare; auto=> //=; smt w=(RealOrder.mulr_ge0 mu_bounded ge0_q). - + move=> c; proc. rcondt 2; 1:by auto. - sp; if=> //=. - * inline*;sp;if;auto; 2:smt(). - move=> &hr /> + + + + + y. - by rewrite !sizeE !dom_set !fcardU !fcard1; smt(fcard_ge0). - * by auto=> /#. - + by move=> b c; proc; rcondf 2; auto. - + exists*FEL.c;elim*=> c. - conseq(:_==>_ : (c%r * mu1 uD witness));progress. - proc; sp; rcondt 1=> //=. - inline *; sp; if=> //=; last by hoare; auto; smt w=(RealOrder.mulr_ge0 mu_bounded ge0_q). - sp; if=> //=. - * wp; rnd (mem (rng ARP.mi)); skip. - progress. - - apply/(RealOrder.ler_trans ((card (rng ARP.mi{hr}))%r * mu uD (pred1 witness))). - apply/mu_mem_le; move=> x _; have [] uD_suf [] _ uD_fu:= uD_uf_fu. - apply/RealOrder.lerr_eq/uD_suf; 1,2:rewrite uD_fu //. - smt w=(RealOrder.ler_wpmul2r mu_bounded le_fromint ltrW sizeE leq_card_rng_dom). - - by move: H9; rewrite H1. - * by hoare; auto; smt w=(RealOrder.mulr_ge0 mu_bounded ge0_q). - + move=> c; proc; rcondt 2; 1:by auto. - sp; if=> //=. - * inline*;sp;if;auto; 2:smt(). - move=> &hr /> + + + + + x. - by rewrite !sizeE !dom_set !fcardU !fcard1; smt(fcard_ge0). - * by auto=> /#. - + by move=> b c; proc; rcondf 2; auto. - qed. -end section CollisionProbability. - -(* We pull together the results of the first two sections *) -lemma PartialConclusion (D <: Distinguisher {PRPi, ARP, DBounder}) &m: - (forall (O <: Oracles {D}), islossless O.f => islossless O.fi => islossless D(O).distinguish) => - `|Pr[IND(PRPi'(Indirect),DBounder(D)).main() @ &m: res] - - Pr[IND(ARP,DBounder(D)).main() @ &m: res]| - <= (q^2)%r / 2%r * mu uD (pred1 witness). -proof. -move=> D_ll. -have:= pr_PRFi_collision D D_ll &m. -have /#:= pr_PRPi'_Indirect_ARP (DBounder(D)) _ &m. -move=> O O_f_ll O_fi_ll; proc. -call (D_ll (<: DBounder(D,O).FBounder) _ _). - by proc; sp; if=> //=; wp; call O_f_ll. - by proc; sp; if=> //=; wp; call O_fi_ll. -by auto. -qed. - -(** This section proves the equivalence between the Ideal PRP and the - module PRPi'(Indirect) used in section Upto. **) -section PRPi_PRPi'_Indirect. - (* The key is in proving that Direct.sample and Indirect.sample - define the same distribution. We do this by extensional equality - of distributions: - forall a, Pr[Direct.sample: res = a] = Pr[Indirect.sample: res = a]. *) - equiv eq_Direct_Indirect: Direct.sample ~ Indirect.sample: ={X} ==> ={res}. - proof. - bypr (res{1}) (res{2})=> //. (* Pointwise equality of distributions *) - progress. - (* We first perform the computation on the easy side,... *) - cut ->: Pr[Direct.sample(X{1}) @ &1: res = a] = mu (uD \ (mem X){1}) (pred1 a). - byphoare (_: X = X{1} ==> _)=> //=. - by proc; rnd=> //=; auto. - subst X{1}. - (* ... and we are left with the difficult side *) - byphoare (_: X = X{2} ==> _)=> //=. - (* We deal separately with the case where a is in X and thus has - probability 0 of being sampled) *) - case (mem X{2} a)=> [a_in_X | a_notin_X]. - conseq (_: _ ==> _: 0%r); first smt. - proc. - seq 1: (mem X r) - _ 0%r - _ 0%r - (X = X{2}). - by auto. - by rcondt 1=> //=; rnd=> //=; skip; smt. - by rcondf 1=> //=; hoare; skip; smt. - done. - (* And we are now left with the case where a is not in X *) - proc. - alias 2 r0 = r. - (* There are two scenarios that lead to a = r: - - r0 = a /\ r = a (with probability mu uD (pred1 a)); - - r0 <> a /\ r = a (with probability mu uD (fun x, mem x X) * mu (uD \ X) (pred1 a)). *) - phoare split (mu uD (pred1 a)) (mu uD (mem X) * mu (uD \ (mem X)) (pred1 a)): (r0 = a). - (* Bound *) - progress. - rewrite dexcepted1E. - have [] uD_suf [] uD_ll uD_fu /=:= uD_uf_fu. - cut not_empty: mu uD predT - mu uD (mem X{2}) <> 0%r. - rewrite -mu_not. - cut: 0%r < mu uD (predC (mem X{2})); last smt. - by rewrite witness_support; exists a; rewrite uD_fu /= /predC a_notin_X. - by smt ml=0 w=uD_uf_fu. - (* case r0 = a *) - seq 2: (a = r0) (mu uD (pred1 a)) 1%r _ 0%r (r0 = r /\ X = X{2}). - by auto. - by wp; rnd; skip; progress; rewrite pred1E -(etaE ((=) a)) etaP. - by rcondf 1. - by hoare; conseq (_: _ ==> true)=> //=; smt. - done. - (* case r0 <> a *) - seq 2: (!mem X r) - _ 0%r - (mu uD (mem X)) (mu (uD \ (mem X)) (pred1 a)) - (r0 = r /\ X = X{2}). - by auto. - by hoare; rcondf 1=> //=; skip; smt. - by wp; rnd. - rcondt 1=> //=; rnd (pred1 a). - by skip; smt. - done. - qed. - - (* The rest is easy *) - local equiv eq_PRPi_PRPi'_f_Indirect: PRPi.f ~ PRPi'(Indirect).f: - ={x, PRPi.m, PRPi.mi} ==> ={res, PRPi.m, PRPi.mi}. - proof. - transitivity PRPi'(Direct).f (={PRPi.m,PRPi.mi,x} ==> ={PRPi.m,PRPi.mi,res}) (={PRPi.m,PRPi.mi,x} ==> ={PRPi.m,PRPi.mi,res}). - + by move=> &1 &2 [->> [->> ->>]]; exists PRPi.m{2} PRPi.mi{2} x{2}. - + done. - + by proc; inline *; if=> //=; auto; progress; rewrite getP. - + by proc; if=> //=; wp; call eq_Direct_Indirect. - qed. - - local equiv eq_PRPi_PRPi'_fi_Indirect: PRPi.fi ~ PRPi'(Indirect).fi: - y{1} = x{2} /\ ={PRPi.m, PRPi.mi} ==> ={res, PRPi.m, PRPi.mi}. - proof. - transitivity PRPi'(Direct).fi (={PRPi.m,PRPi.mi} /\ y{1} = x{2} ==> ={PRPi.m,PRPi.mi,res}) (={PRPi.m,PRPi.mi,x} ==> ={PRPi.m,PRPi.mi,res}). - + by move=> &1 &2 [->> [->> ->>]]; exists PRPi.m{2} PRPi.mi{2} x{2}. - + done. - + by proc; inline *; if=> //=; auto; progress; rewrite getP. - + by proc; if=> //=; wp; call eq_Direct_Indirect. - qed. - - declare module D:Distinguisher {PRPi}. - - lemma pr_PRPi_PRPi'_Indirect &m: - Pr[IND(PRPi,D).main() @ &m: res] = Pr[IND(PRPi'(Indirect),D).main() @ &m: res]. - proof. - byequiv=> //=. - proc. - call (_: ={PRPi.m,PRPi.mi}). - by apply eq_PRPi_PRPi'_f_Indirect. - by apply eq_PRPi_PRPi'_fi_Indirect. - by inline*; auto. - qed. -end section PRPi_PRPi'_Indirect. - -lemma Conclusion (D <: Distinguisher {PRPi, ARP, DBounder}) &m: - (forall (O <: Oracles {D}), islossless O.f => islossless O.fi => islossless D(O).distinguish) => - `|Pr[IND(PRPi,DBounder(D)).main() @ &m: res] - - Pr[IND(ARP,DBounder(D)).main() @ &m: res]| - <= (q^2)%r / 2%r * mu uD (pred1 witness). -proof. -move=> D_ll. -by rewrite (pr_PRPi_PRPi'_Indirect (DBounder(D)) &m) (PartialConclusion D &m D_ll). -qed. From 7867e56f15afbcf11cb4f7c3d17c4009feb2ef1b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Tue, 18 Sep 2018 20:58:50 +0200 Subject: [PATCH 321/525] repush Handle --- proof/smart_counter/Handle.eca | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/proof/smart_counter/Handle.eca b/proof/smart_counter/Handle.eca index 08febc2..ccd780f 100644 --- a/proof/smart_counter/Handle.eca +++ b/proof/smart_counter/Handle.eca @@ -2465,7 +2465,10 @@ proof. by rewrite-rcons_cat (@take_nth witness);smt(prefix_ge0). * rewrite/#. * cut[]HINV[]H_bad[]H_m_p0[]Hp1[]Hp2[]->>[]H_counter[][]f H_h[]H_path[]H_F_RO H_i:=H3 H6. - split;cut[]//=:=H_m_p0; smt(get_setE domE take_take take_nth size_take + split;cut[]//= hmp01 hmp02 hmp1 hmp2 hmp3:=H_m_p0. + move=> l l_in_pref i hisize. + have//[] sa sc [#] pref_sasc pm_pref:= hmp1 l l_in_pref i hisize. + by exists sa sc; smt(get_setE domE take_take take_nth size_take prefix_ge0 nth_take take_oversize take_le0 mem_fdom fdom_set). + rewrite!get_setE/=oget_some;smt(domE). + smt(get_setE domE take_take size_take prefix_ge0 nth_take take_oversize take_le0). From 8bed9cf2e63d39f22e948e9193b144fa19206b2b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Wed, 19 Sep 2018 11:52:06 +0100 Subject: [PATCH 322/525] undoing CI breakage --- proof/SHA3-Security.ec | 2 ++ 1 file changed, 2 insertions(+) diff --git a/proof/SHA3-Security.ec b/proof/SHA3-Security.ec index fad7927..ec8af81 100644 --- a/proof/SHA3-Security.ec +++ b/proof/SHA3-Security.ec @@ -4,6 +4,8 @@ require import AllCore List IntDiv StdOrder Distr SmtMap FSet. require (*--*) Common Sponge SLCommon Gconcl_list BlockSponge. +(*---*) import Common Sponge BIRO. + clone import IRO as BIRO with type from <- bool list, type to <- bool, From b56d323ccdd43306e0487ef0205b66a182ed876b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Wed, 19 Sep 2018 21:49:32 +0200 Subject: [PATCH 323/525] lowering down the simulator's complexity --- proof/smart_counter/Gconcl_list.ec | 309 +++++++++++++++++++++++++++-- 1 file changed, 292 insertions(+), 17 deletions(-) diff --git a/proof/smart_counter/Gconcl_list.ec b/proof/smart_counter/Gconcl_list.ec index 32e7e8d..9c5452e 100644 --- a/proof/smart_counter/Gconcl_list.ec +++ b/proof/smart_counter/Gconcl_list.ec @@ -250,9 +250,9 @@ section Ideal. - smt(leq_add_in domE). rcondf{2}2;auto;progress. - smt(DBlock.dunifin_ll). + - smt(size_cat size_nseq size_eq0 size_ge0). - smt(). - - smt(). - - smt(). search "_.[_<-_]". + - smt(). - by move: H11; rewrite domE; case: (SLCommon.C.queries{1}.[format bl{2} (i_R + 2)]). - smt(). sp;conseq(:_==> ={F.RO.m,b} @@ -513,14 +513,17 @@ section Ideal. wp;rnd;wp 2 2. conseq(:_==> F.RO.m{1}.[p{1}] = F.RO.m{2}.[p{2}] /\ inv_L_L3 F.RO.m{1} F.RO.m{2} F2.RO.m{2});progress. - + cut[]add_maps h1 h2:=H5;rewrite add_maps joinE//=;smt(parse_valid). + + cut[]add_maps h1 h2:=H5;rewrite add_maps joinE//=. + by have:= h2 p{2}; rewrite parse_valid //= H2 /= => h; rewrite h. + smt(). case(x5{1} \in F.RO.m{1}). - rcondf{1}2;2:rcondf{2}2;auto;progress. * smt(lemma2 incl_dom parse_valid). by cut[]add_maps h1 h2:=H1;rewrite add_maps joinE//=;smt(parse_valid). rcondt{1}2;2:rcondt{2}2;auto;progress. - - smt(lemma2 incl_dom parse_valid). + - move:H4;rewrite/format/=nseq0 !cats0 => p0_notin_ROm_m. + case: H1 => joint _ _; move: p0_notin_ROm_m. + by rewrite joint mem_join negb_or; smt(parse_valid). - cut[]add_maps h1 h2:=H1;rewrite add_maps !get_setE joinE//=;smt(parse_valid nseq0 cats0). - cut:=H;rewrite -H0=>//=[][]->>->>;apply lemma1=>//=;1:smt(parse_valid). cut[]add_maps h1 h2:=H1;smt(parse_valid formatK parseK incl_dom). @@ -552,7 +555,12 @@ section Ideal. while(={i,n,p} /\ 0 <= i{1} /\ valid p{1} /\ inv_L_L3 F.RO.m{1} F.RO.m{2} F2.RO.m{2}). + sp;case(x2{1} \in F.RO.m{1}). - by rcondf{1}2;2:rcondf{2}2;auto;smt(lemma2). - by rcondt{1}2;2:rcondt{2}2;auto;progress;smt(incl_dom lemma1). + rcondt{1}2;2:rcondt{2}2;auto;progress. + - smt(incl_dom lemma1). + - smt(incl_dom lemma1). + apply/lemma1=> //=. + - smt(). + smt(incl_dom mem_join). auto;smt(). seq 1 1 : (={x,p,n} /\ parse x{1} = (p,n){1} /\ ! valid p{1} /\ inv_L_L3 F.RO.m{1} F.RO.m{2} F2.RO.m{2});last first. @@ -569,12 +577,17 @@ section Ideal. /\ inv_L_L3 F.RO.m{1} F.RO.m{2} F2.RO.m{2}). + sp;case(x2{1} \in F.RO.m{1}). - rcondf{1}2;2:rcondf{2}2;auto;progress. - * cut[]:=H2;smt(incl_dom lemma2 formatK parse_not_valid). + * cut[]h_join h1 h2:=H2. + have:= H5; rewrite h_join mem_join. + have:= h1 (format p{hr} (i_R + 1)). + have:=parse_not_valid x{hr}; rewrite H1 /= H0 /= => h. + by rewrite (h (i_R+1)) /= => ->. smt(). rcondt{1}2;2:rcondt{2}2;auto;progress. * smt(incl_dom lemma1). * smt(). - * by cut:=lemma3 _ _ _ _ r0L H2 _ H5;smt(parse_not_valid). + * cut//=:=lemma3 _ _ _ _ r0L H2 _ H5. + by have:= parse_not_valid x{2}; rewrite H1 /= H0 /= => h; exact/(h (i_R+1)). auto;smt(). qed. @@ -756,7 +769,10 @@ section Ideal. - by while(i+1<=n);auto; smt(parse_valid parse_gt0 parseK mem_set formatK). wp 8 5;rnd{1};wp 6 5. - conseq(:_==> ={F2.RO.m} /\ format pp{2} n{2} = x3{2});1:smt(DBlock.dunifin_ll last_rcons formatK parseK). + conseq(:_==> ={F2.RO.m} /\ format pp{2} n{2} = x3{2}). + + move=> /> &1 &2 H H0 /= /> [#] H1 H2 m lres. + rewrite DBlock.dunifin_ll /= => ?; rewrite DBlock.supp_dunifin /=. + smt(last_rcons formatK parseK). seq 3 3 : (={F2.RO.m,i} /\ x2{1} = x3{2} /\ pp{2} = p{1} /\ format pp{2} n{2} = x3{2}); last by conseq(:_==> ={F2.RO.m});progress;sim. auto;conseq(:_==> ={F2.RO.m,i,n} /\ i{1} + 1 = n{2});1:smt(formatK). @@ -992,7 +1008,10 @@ section Real. local lemma invm_dom_rng (m mi : (state, state) fmap) : invm m mi => dom m = rng mi. proof. - by move=>h; rewrite fun_ext=> x; rewrite domE rngE /=; have := h x; smt(). + move=>h; rewrite fun_ext=> x; rewrite domE rngE /= eq_iff; have h2 := h x; split. + + move=> m_x_not_None; exists (oget m.[x]); rewrite -h2; move: m_x_not_None. + by case: (m.[x]). + by move=> [] a; rewrite -h2 => ->. qed. local lemma all_prefixes_of_INV_real c1 c2 m mi p: @@ -1194,11 +1213,13 @@ section Real. smt(mem_set take_take size_take). - move=>l;rewrite!mem_set;case=>[H_dom i|->>]/=. * by rewrite mem_set;smt(). - move=>j; case(0 <= j)=>hj0;2:smt(domE take_le0 mem_set). - case(j < i0{2} + 1)=>hjiS;2:smt(domE take_take mem_set). - rewrite mem_set take_take/min hjiS//=;left. - cut:=(take_take bl{2} j i0{2});rewrite min_lel 1:/#=><-. - smt(all_prefixes_of_INV_real domE). + move=>j; case(0 <= j)=>hj0; rewrite mem_set. + * case: (j <= i0{2}) => hjmax; 2:smt(take_oversize size_take). + left; have-> : take j (take (i0{2}+1) bl{2}) = take j (take i0{2} bl{2}). + * by rewrite 2!take_take min_lel 1:/# min_lel. + by apply H8; rewrite domE H1. + rewrite take_le0 1:/#; left. + by rewrite-(take0 (take i0{2} bl{2})) H8 domE H1. - smt(get_setE domE mem_set). - smt(get_setE domE). - smt(). @@ -1214,7 +1235,9 @@ section Real. by rewrite (H8 _ h). - move=>l;rewrite!mem_set;case=>[H_dom|->>]/=;1:smt(mem_set). move=>j;rewrite mem_set. - case(0 <= j)=>hj0;2:smt(domE take_le0). + case(0 <= j)=>hj0; last first. + * rewrite take_le0 1:/#; left. + by rewrite-(take0 (take i0{2} bl{2})) H8 domE H1. case(j < i0{2} + 1)=>hjiS;2:smt(domE take_take). rewrite take_take/min hjiS//=;left. cut:=(take_take bl{2} j i0{2});rewrite min_lel 1:/#=><-. @@ -1280,8 +1303,9 @@ section Real. + if;auto;progress. - by split;case:H3=>//=;smt(). - by rewrite domE H2//=. - - move:H4;rewrite take_size /= domE. - by case: (Redo.prefixes{2}.[format bl{2} (i{2} + 1)])=>//=; smt(). + - move:H4;rewrite take_size /= domE=> h. + exists (oget Redo.prefixes{2}.[format bl{2} (i{2} + 1)]).`2; move: h. + by case: (Redo.prefixes{2}.[format bl{2} (i{2} + 1)]); smt(). sp;if;auto;progress. - move:H4 H5;rewrite!get_setE/=!oget_some nth_last/=take_size. rewrite last_cat last_nseq 1:/# Block.WRing.addr0;progress. @@ -1892,3 +1916,254 @@ section Real_Ideal_Abs. end section Real_Ideal_Abs. + + +module Simulator (F : DFUNCTIONALITY) = { + var m : (state, state) fmap + var mi : (state, state) fmap + var paths : (capacity, block list * block) fmap + var unvalid_map : (block list * int, block) fmap + proc init() = { + m <- empty; + mi <- empty; + paths <- empty.[c0 <- ([],b0)]; + unvalid_map <- empty; + } + proc f (x : state) : state = { + var p,v,z,q,k,cs,y,y1,y2; + if (x \notin m) { + if (x.`2 \in paths) { + (p,v) <- oget paths.[x.`2]; + z <- []; + (q,k) <- parse (rcons p (v +^ x.`1)); + if (valid q) { + cs <@ F.f(q, k); + y1 <- last b0 z; + } else { + if ((q,k) \notin unvalid_map) { + unvalid_map.[(q,k)] <$ bdistr; + } + y1 <- oget unvalid_map.[(q,k)]; + } + } else { + y1 <$ bdistr; + } + y2 <$ cdistr; + y <- (y1,y2); + m.[x] <- y; + mi.[y] <- x; + if (x.`2 \in paths) { + (p,v) <-oget paths.[x.`2]; + paths.[y2] <- (rcons p (v +^ x.`1),y.`1); + } + } else { + y <- oget m.[x]; + } + return y; + } + proc fi (x : state) : state = { + var y,y1,y2; + if (! x \in mi) { + y1 <$ bdistr; + y2 <$ cdistr; + y <- (y1,y2); + mi.[x] <- y; + m.[y] <- x; + } else { + y <- oget mi.[x]; + } + return y; + } +}. + +print BIRO2.IRO. +section Simplify_Simulator. + +declare module D : DISTINGUISHER{Simulator, F.RO, BIRO.IRO, C, S, BIRO2.IRO}. + +axiom D_lossless (F0 <: DFUNCTIONALITY{D}) (P0 <: DPRIMITIVE{D}) : + islossless P0.f => islossless P0.fi => islossless F0.f => + islossless D(F0, P0).distinguish. + +module type FRO_While = { + proc init () : unit + proc f (p : block list, n : int) : block +}. + +local module Simu (FRO : FRO_While) (F : DFUNCTIONALITY) = { + proc init() = { + Simulator(F).init(); + FRO.init(); + } + proc f (x : state) : state = { + var p,q,v,k,cs,y,y1,y2; + if (x \notin Simulator.m) { + if (x.`2 \in Simulator.paths) { + (p,v) <- oget Simulator.paths.[x.`2]; + (q,k) <- parse (rcons p (v +^ x.`1)); + if (valid q) { + cs <@ F.f(q, k); + y1 <- last b0 cs; + } else { + if (0 < k) { + y1 <- FRO.f(q,k); + } else { + y1 <- b0; + } + } + } else { + y1 <$ bdistr; + } + y2 <$ cdistr; + y <- (y1,y2); + Simulator.m.[x] <- y; + Simulator.mi.[y] <- x; + if (x.`2 \in Simulator.paths) { + (p,v) <-oget Simulator.paths.[x.`2]; + Simulator.paths.[y2] <- (rcons p (v +^ x.`1),y.`1); + } + } else { + y <- oget Simulator.m.[x]; + } + return y; + } + proc fi (x : state) : state = { + var y,y1,y2; + if (! x \in Simulator.mi) { + y1 <$ bdistr; + y2 <$ cdistr; + y <- (y1,y2); + Simulator.mi.[x] <- y; + Simulator.m.[y] <- x; + } else { + y <- oget Simulator.mi.[x]; + } + return y; + } +}. + +local module Lator (F : F.RO) : FRO_While = { + proc init() = { + F.init(); + } + proc f (p : block list, n : int) : block = { + var i; + i <- 0; + while (i < n) { + i <- i + 1; + F.sample(format p i); + } + Simulator.unvalid_map.[(p,n)] <@ F.get(format p n); + return oget Simulator.unvalid_map.[(p,n)]; + } +}. + +op inv_map2 (m1 : (block list, block) fmap) (m2 : (block list * int, + block) fmap) : bool = + (forall (p : block list) (n : int) (x : block list), + !valid (parse x).`1 => + x = format p (n + 1) => + (p, n) \in m2 <=> x \in m1) /\ + (forall (p : block list) (n : int) (x : block list), + !valid (parse x).`1 => + x = format p (n + 1) => + x \in m1 <=> (p, n) \in m2) /\ + (forall (p : block list) (n : int) (x : block list), + !valid (parse x).`1 => + x = format p (n + 1) => + m2.[(p, n)] = m1.[x]) /\ + (forall (p : block list) (n : int) (x : block list), + !valid (parse x).`1 => + x = format p (n + 1) => + m1.[x] = m2.[(p, n)]). + +local lemma equal1 &m : + Pr [ IdealIndif(BIRO.IRO, SimLast(S), DRestr(D)).main() @ &m : res ] = + Pr [ IdealIndif(BIRO.IRO, Simu(Lator(F.RO)), DRestr(D)).main() @ &m : res ]. +proof. +byequiv=>//=; proc; inline*; auto. +call (: ={BIRO.IRO.mp,C.c} /\ ={m,mi,paths}(S,Simulator) /\ + inv_map2 F.RO.m{2} BIRO2.IRO.mp{1} /\ + incl Simulator.unvalid_map{2} BIRO2.IRO.mp{1}); first last. ++ by proc; inline*; conseq=>/>; sim. ++ by proc; inline*; conseq=>/>; sim. ++ by auto; progress; smt(mem_empty). +proc;sp;if;auto. +call(: ={BIRO.IRO.mp} /\ ={m,mi,paths}(S,Simulator) /\ + inv_map2 F.RO.m{2} BIRO2.IRO.mp{1} /\ + incl Simulator.unvalid_map{2} BIRO2.IRO.mp{1});auto. +if; 1,3: by auto. +seq 1 1 : (={BIRO.IRO.mp,y1,x} /\ ={m,mi,paths}(S,Simulator) /\ + inv_map2 F.RO.m{2} BIRO2.IRO.mp{1} /\ + incl Simulator.unvalid_map{2} BIRO2.IRO.mp{1}); last first. +- by conseq=>/>; auto. +if; 1,3: by auto. +inline*; sp; if; 1,2: auto. +- move=> /> &1 &2 h1 h2 bl n h3 h4 h5 h6 h7 h8 h9 h10 h11 h12. + have:= h1; rewrite-h3 /= => [#] ->>->>. + have:= h4; rewrite-h2 /= => [#] ->>->>. + have->>/=: q{2} = (parse (rcons p{1} (v{1} +^ x{2}.`1))).`1 by smt(). + have->>/=: k{2} = (parse (rcons p{1} (v{1} +^ x{2}.`1))).`2 by smt(). + move: h5; have-> h5:= formatK (rcons p{1} (v{1} +^ x{2}.`1)). + by have->>/=: q{1} = (parse (rcons p{1} (v{1} +^ x{2}.`1))).`1 by smt(). +- sp; if; auto. + * move=> /> &1 &2 h1 h2 bl n h3 h4 h5 h6 h7 h8 h9 h10 h11 h12. + have:= h1; rewrite-h3 /= => [#] ->>->>. + have:= h4; rewrite-h2 /= => [#] ->>->>. + have->>/=: q{2} = (parse (rcons p{1} (v{1} +^ x{2}.`1))).`1 by smt(). + have->>/=: k{2} = (parse (rcons p{1} (v{1} +^ x{2}.`1))).`2 by smt(). + move: h5; have-> h5:= formatK (rcons p{1} (v{1} +^ x{2}.`1)). + by have->>/=: q{1} = (parse (rcons p{1} (v{1} +^ x{2}.`1))).`1 by smt(). + by conseq(:_ ==> ={bs, BIRO.IRO.mp})=> />; sim=> />; smt(parseK formatK). +sp; rcondt{1} 1; 1: auto; if{2}; last first. ++ by rcondf{1} 1; auto; smt(parseK formatK). +sp; rcondf{2} 4; 1: auto. ++ conseq(:_ ==> format p0 n0 \in F.RO.m)=> />. + splitwhile 1 : i0 + 1 < n0. + rcondt 2; 1:(auto; while (i0 + 1 <= n0); auto; smt()). + rcondf 7; 1:(auto; while (i0 + 1 <= n0); auto; smt()). + seq 1 : (q = p0 /\ n0 = k /\ i0 + 1 = n0). + - by while(q = p0 /\ n0 = k /\ i0 + 1 <= n0); auto; smt(). + by auto=> />; smt(mem_set). +wp; rnd{2}; wp=> /=. +(** TODO : reprendre ici !! **) +conseq(:_==> ={BIRO.IRO.mp, i0, n0, p0, x} /\ i0{1} = n0{1} /\ + (0 < i0{1} => last Block.b0 bs0{1} = oget F.RO.m{2}.[format p0{2} i0{2}]) /\ + inv_map2 F.RO.m{2} BIRO2.IRO.mp{1} /\ + (0 < i0{1} => format p0{2} i0{2} \in F.RO.m{2}));progress. ++ exact/DBlock.dunifin_ll. ++ by rewrite get_set_sameE oget_some H10//=. ++ move=>z; rewrite get_setE; pose y := rcons p{1} (v{1} +^ x{2}.`1). + case: (z = (y,k{2}))=>//= />. + - have[]h1[]h2[]h3 h4:= H4. + have/=:= h3 q{2} k{2} (format y (k{2} + 1)). + have:= H; rewrite -H1 => [#] />. + have:= H3. + have-> : q_L = (parse y).`1 by smt(). + have-> : k_L = (parse y).`2 by smt(). + rewrite (formatK y) => [#]. + have:= H0; rewrite -H2 => [#] />. + have />: k{2} = (parse y).`2 by smt(). + have {1}->: (rcons p{1} (v{1} +^ x{2}.`1)) = (parse y).`1 by smt(). +move: H3; have{1}-> H3: rcons p{1} (v{1} +^ x{2}.`1) = (parse (format(rcons p{1} (v{1} +^ x{2}.`1)) k{2})).`1 by smt(). + have:= parse_not_valid (format q{2} k{2}) H8 (k{2}+1). + have-> : format (parse (format q{2} k{2})).`1 (k{2} + 1) = + format (format (parse (format q{2} k{2})).`1 k{2}) 2. + - rewrite/(format _ 2)/=/format/=-catA; congr. + by rewrite nseq1 cats1 -nseqSr 1:/#. + have{2}-> : k{2} = (parse (format q{2} k{2})).`2 by smt(). + rewrite (formatK (format q{2} k{2})). + have->: format (format q{2} k{2}) 2 = format q{2} (k{2} + 1). + - rewrite/(format _ 2)/=/format/=-catA; congr. + by rewrite nseq1 cats1 -nseqSr 1:/#. + by move=> -> /= ->; move: H11; rewrite domE; case: (m_R.[format q{2} k{2}]). + smt(). + +while(i0{2} <= n0{2} /\ ={i0,p0,n0} /\ inv_map2 F.RO.m{2} BIRO2.IRO.mp{1} /\ + format p0{2} (i0{2} + 1) \in F.RO.m{2} /\ x1{1} = p0{1} /\ + incl Simulator.unvalid_map{2} BIRO2.IRO.mp{1} /\ ! valid p0{2} /\ + (0 < i0{2} => last Block.b0 bs0{1} = + oget F.RO.m{2}.[format p0{2} (i0{2} + 1)])). ++ sp; if{1}; 2: rcondf{2} 2; 1: rcondt{2} 2; auto; progress. + +qed. From 7a010c32a430ccac7dcb8e5a81ed341a1c299fed Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Wed, 19 Sep 2018 19:22:21 -0400 Subject: [PATCH 324/525] The lemmas of MapAux are now in SmtMap on EasyCrypt:deploy-new-prom. Fixed comments to substitute PROM for RndO. --- proof/Sponge.ec | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/proof/Sponge.ec b/proof/Sponge.ec index 72f010a..8df8e7c 100644 --- a/proof/Sponge.ec +++ b/proof/Sponge.ec @@ -2,7 +2,7 @@ prover quorum=2 ["Z3" "Alt-Ergo"]. -require import Core Int IntDiv Real List FSet SmtMap MapAux. +require import Core Int IntDiv Real List FSet SmtMap. (*---*) import IntExtra. require import Distr DBool DList. require import StdBigop StdOrder. import IntOrder. @@ -162,7 +162,7 @@ module RaiseSim (S : BlockSponge.SIMULATOR, F : DFUNCTIONALITY) = Dist).main() @ &m : res] This step is proved using the eager sampling lemma provided by - RndO. + PROM. Step 3: @@ -294,7 +294,7 @@ module HybridIROEager : HYBRID_IRO, BlockSponge.BIRO.IRO = { } }. -(* we are going to use RndO.GenEager to prove: +(* we are going to use PROM.GenEager to prove: lemma HybridIROExper_Lazy_Eager (D <: HYBRID_IRO_DIST{HybridIROEager, HybridIROLazy}) &m : From 59e6a129bca31f00dae1fa824f05b5f34b56c0ab Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Thu, 20 Sep 2018 14:59:19 +0200 Subject: [PATCH 325/525] Making the simulator great again: time complexity improved --- proof/smart_counter/Gconcl_list.ec | 234 ++++++++++++++++------------- 1 file changed, 129 insertions(+), 105 deletions(-) diff --git a/proof/smart_counter/Gconcl_list.ec b/proof/smart_counter/Gconcl_list.ec index 9c5452e..1216a6d 100644 --- a/proof/smart_counter/Gconcl_list.ec +++ b/proof/smart_counter/Gconcl_list.ec @@ -1896,7 +1896,7 @@ section Real_Ideal_Abs. by proc;call(D_lossless F0 P0 H H0 H1);auto. qed. - lemma Real_Ideal &m : + lemma Inefficient_Real_Ideal &m : `|Pr [ RealIndif(Sponge,Perm,DRestr(D)).main() @ &m : res ] - Pr [ IdealIndif(BIRO.IRO, SimLast(S), DRestr(D)).main() @ &m : res ]| <= (max_size ^ 2 - max_size)%r / 2%r / (2^r)%r / (2^c)%r + @@ -1930,20 +1930,23 @@ module Simulator (F : DFUNCTIONALITY) = { unvalid_map <- empty; } proc f (x : state) : state = { - var p,v,z,q,k,cs,y,y1,y2; + var p,v,q,k,cs,y,y1,y2; if (x \notin m) { if (x.`2 \in paths) { (p,v) <- oget paths.[x.`2]; - z <- []; (q,k) <- parse (rcons p (v +^ x.`1)); if (valid q) { cs <@ F.f(q, k); - y1 <- last b0 z; + y1 <- last b0 cs; } else { - if ((q,k) \notin unvalid_map) { - unvalid_map.[(q,k)] <$ bdistr; + if (0 < k) { + if ((q,k-1) \notin unvalid_map) { + unvalid_map.[(q,k-1)] <$ bdistr; + } + y1 <- oget unvalid_map.[(q,k-1)]; + } else { + y1 <- b0; } - y1 <- oget unvalid_map.[(q,k)]; } } else { y1 <$ bdistr; @@ -1976,7 +1979,6 @@ module Simulator (F : DFUNCTIONALITY) = { } }. -print BIRO2.IRO. section Simplify_Simulator. declare module D : DISTINGUISHER{Simulator, F.RO, BIRO.IRO, C, S, BIRO2.IRO}. @@ -1985,18 +1987,19 @@ axiom D_lossless (F0 <: DFUNCTIONALITY{D}) (P0 <: DPRIMITIVE{D}) : islossless P0.f => islossless P0.fi => islossless F0.f => islossless D(F0, P0).distinguish. -module type FRO_While = { - proc init () : unit - proc f (p : block list, n : int) : block -}. +local clone import PROM.GenEager as IRO2 with + type from <- block list * int, + type to <- block, + op sampleto <- fun _, bdistr +proof * by exact/DBlock.dunifin_ll. -local module Simu (FRO : FRO_While) (F : DFUNCTIONALITY) = { +local module Simu (FRO : IRO2.RO) (F : DFUNCTIONALITY) = { proc init() = { Simulator(F).init(); FRO.init(); } proc f (x : state) : state = { - var p,q,v,k,cs,y,y1,y2; + var p,q,v,k,i,cs,y,y1,y2; if (x \notin Simulator.m) { if (x.`2 \in Simulator.paths) { (p,v) <- oget Simulator.paths.[x.`2]; @@ -2006,7 +2009,12 @@ local module Simu (FRO : FRO_While) (F : DFUNCTIONALITY) = { y1 <- last b0 cs; } else { if (0 < k) { - y1 <- FRO.f(q,k); + i <- 0; + while (i < k) { + FRO.sample(q,i); + i <- i + 1; + } + y1 <- FRO.get(q,k-1); } else { y1 <- b0; } @@ -2042,64 +2050,33 @@ local module Simu (FRO : FRO_While) (F : DFUNCTIONALITY) = { } }. -local module Lator (F : F.RO) : FRO_While = { - proc init() = { - F.init(); - } - proc f (p : block list, n : int) : block = { - var i; - i <- 0; - while (i < n) { - i <- i + 1; - F.sample(format p i); - } - Simulator.unvalid_map.[(p,n)] <@ F.get(format p n); - return oget Simulator.unvalid_map.[(p,n)]; - } +local module L (F : IRO2.RO) = { + proc distinguish = IdealIndif(BIRO.IRO, Simu(F), DRestr(D)).main }. -op inv_map2 (m1 : (block list, block) fmap) (m2 : (block list * int, - block) fmap) : bool = - (forall (p : block list) (n : int) (x : block list), - !valid (parse x).`1 => - x = format p (n + 1) => - (p, n) \in m2 <=> x \in m1) /\ - (forall (p : block list) (n : int) (x : block list), - !valid (parse x).`1 => - x = format p (n + 1) => - x \in m1 <=> (p, n) \in m2) /\ - (forall (p : block list) (n : int) (x : block list), - !valid (parse x).`1 => - x = format p (n + 1) => - m2.[(p, n)] = m1.[x]) /\ - (forall (p : block list) (n : int) (x : block list), - !valid (parse x).`1 => - x = format p (n + 1) => - m1.[x] = m2.[(p, n)]). - local lemma equal1 &m : Pr [ IdealIndif(BIRO.IRO, SimLast(S), DRestr(D)).main() @ &m : res ] = - Pr [ IdealIndif(BIRO.IRO, Simu(Lator(F.RO)), DRestr(D)).main() @ &m : res ]. + Pr [ L(IRO2.RO).distinguish() @ &m : res ]. proof. byequiv=>//=; proc; inline*; auto. call (: ={BIRO.IRO.mp,C.c} /\ ={m,mi,paths}(S,Simulator) /\ - inv_map2 F.RO.m{2} BIRO2.IRO.mp{1} /\ + BIRO2.IRO.mp{1} = IRO2.RO.m{2} /\ incl Simulator.unvalid_map{2} BIRO2.IRO.mp{1}); first last. + by proc; inline*; conseq=>/>; sim. + by proc; inline*; conseq=>/>; sim. -+ by auto; progress; smt(mem_empty). -proc;sp;if;auto. ++ by auto. +proc; sp; if; auto. call(: ={BIRO.IRO.mp} /\ ={m,mi,paths}(S,Simulator) /\ - inv_map2 F.RO.m{2} BIRO2.IRO.mp{1} /\ - incl Simulator.unvalid_map{2} BIRO2.IRO.mp{1});auto. + BIRO2.IRO.mp{1} = IRO2.RO.m{2} /\ + incl Simulator.unvalid_map{2} BIRO2.IRO.mp{1});auto. if; 1,3: by auto. -seq 1 1 : (={BIRO.IRO.mp,y1,x} /\ ={m,mi,paths}(S,Simulator) /\ - inv_map2 F.RO.m{2} BIRO2.IRO.mp{1} /\ - incl Simulator.unvalid_map{2} BIRO2.IRO.mp{1}); last first. +seq 1 1: (={BIRO.IRO.mp,y1,x} /\ ={m,mi,paths}(S,Simulator) /\ + BIRO2.IRO.mp{1} = IRO2.RO.m{2} /\ + incl Simulator.unvalid_map{2} BIRO2.IRO.mp{1}); last first. - by conseq=>/>; auto. if; 1,3: by auto. inline*; sp; if; 1,2: auto. -- move=> /> &1 &2 h1 h2 bl n h3 h4 h5 h6 h7 h8 h9 h10 h11 h12. +- move=> /> &1 &2 h1 h2 bl n h3 h4 h5 h6 h7 h8. have:= h1; rewrite-h3 /= => [#] ->>->>. have:= h4; rewrite-h2 /= => [#] ->>->>. have->>/=: q{2} = (parse (rcons p{1} (v{1} +^ x{2}.`1))).`1 by smt(). @@ -2107,7 +2084,7 @@ inline*; sp; if; 1,2: auto. move: h5; have-> h5:= formatK (rcons p{1} (v{1} +^ x{2}.`1)). by have->>/=: q{1} = (parse (rcons p{1} (v{1} +^ x{2}.`1))).`1 by smt(). - sp; if; auto. - * move=> /> &1 &2 h1 h2 bl n h3 h4 h5 h6 h7 h8 h9 h10 h11 h12. + * move=> /> &1 &2 h1 h2 bl n h3 h4 h5 h6 h7 h8 h9 h10. have:= h1; rewrite-h3 /= => [#] ->>->>. have:= h4; rewrite-h2 /= => [#] ->>->>. have->>/=: q{2} = (parse (rcons p{1} (v{1} +^ x{2}.`1))).`1 by smt(). @@ -2118,52 +2095,99 @@ inline*; sp; if; 1,2: auto. sp; rcondt{1} 1; 1: auto; if{2}; last first. + by rcondf{1} 1; auto; smt(parseK formatK). sp; rcondf{2} 4; 1: auto. -+ conseq(:_ ==> format p0 n0 \in F.RO.m)=> />. - splitwhile 1 : i0 + 1 < n0. - rcondt 2; 1:(auto; while (i0 + 1 <= n0); auto; smt()). - rcondf 7; 1:(auto; while (i0 + 1 <= n0); auto; smt()). - seq 1 : (q = p0 /\ n0 = k /\ i0 + 1 = n0). - - by while(q = p0 /\ n0 = k /\ i0 + 1 <= n0); auto; smt(). ++ conseq(:_ ==> (q,k-1) \in RO.m)=> />. + splitwhile 1 : i + 1 < k. + rcondt 2; 1:(auto; while (i + 1 <= k); auto; smt()). + rcondf 7; 1:(auto; while (i + 1 <= k); auto; smt()). + seq 1 : (i + 1 = k). + - by while(i + 1 <= k); auto; smt(). by auto=> />; smt(mem_set). -wp; rnd{2}; wp=> /=. -(** TODO : reprendre ici !! **) -conseq(:_==> ={BIRO.IRO.mp, i0, n0, p0, x} /\ i0{1} = n0{1} /\ - (0 < i0{1} => last Block.b0 bs0{1} = oget F.RO.m{2}.[format p0{2} i0{2}]) /\ - inv_map2 F.RO.m{2} BIRO2.IRO.mp{1} /\ - (0 < i0{1} => format p0{2} i0{2} \in F.RO.m{2}));progress. -+ exact/DBlock.dunifin_ll. -+ by rewrite get_set_sameE oget_some H10//=. -+ move=>z; rewrite get_setE; pose y := rcons p{1} (v{1} +^ x{2}.`1). - case: (z = (y,k{2}))=>//= />. - - have[]h1[]h2[]h3 h4:= H4. - have/=:= h3 q{2} k{2} (format y (k{2} + 1)). - have:= H; rewrite -H1 => [#] />. - have:= H3. - have-> : q_L = (parse y).`1 by smt(). - have-> : k_L = (parse y).`2 by smt(). - rewrite (formatK y) => [#]. - have:= H0; rewrite -H2 => [#] />. - have />: k{2} = (parse y).`2 by smt(). - have {1}->: (rcons p{1} (v{1} +^ x{2}.`1)) = (parse y).`1 by smt(). -move: H3; have{1}-> H3: rcons p{1} (v{1} +^ x{2}.`1) = (parse (format(rcons p{1} (v{1} +^ x{2}.`1)) k{2})).`1 by smt(). - have:= parse_not_valid (format q{2} k{2}) H8 (k{2}+1). - have-> : format (parse (format q{2} k{2})).`1 (k{2} + 1) = - format (format (parse (format q{2} k{2})).`1 k{2}) 2. - - rewrite/(format _ 2)/=/format/=-catA; congr. - by rewrite nseq1 cats1 -nseqSr 1:/#. - have{2}-> : k{2} = (parse (format q{2} k{2})).`2 by smt(). - rewrite (formatK (format q{2} k{2})). - have->: format (format q{2} k{2}) 2 = format q{2} (k{2} + 1). - - rewrite/(format _ 2)/=/format/=-catA; congr. - by rewrite nseq1 cats1 -nseqSr 1:/#. - by move=> -> /= ->; move: H11; rewrite domE; case: (m_R.[format q{2} k{2}]). - smt(). +wp; rnd{2}; wp=> /=; conseq=> />. +conseq(:_==> i{2} = k{2} /\ + (0 < i{2} => last Block.b0 bs0{1} = oget RO.m{2}.[(q{2}, i{2} -1)]) /\ + BIRO2.IRO.mp{1} = RO.m{2} /\ incl Simulator.unvalid_map{2} BIRO2.IRO.mp{1}) =>/>. ++ smt(DBlock.dunifin_ll). +while (i{2} <= k{2} /\ n0{1} = k{2} /\ i0{1} = i{2} /\ x1{1} = q{2} /\ ={k} /\ + (0 < i{2} => last Block.b0 bs0{1} = oget RO.m{2}.[(q{2}, i{2} - 1)]) /\ + BIRO2.IRO.mp{1} = RO.m{2} /\ incl Simulator.unvalid_map{2} BIRO2.IRO.mp{1}). ++ sp; wp 2 2=> /=; conseq=> />. + conseq(:_==> b0{1} = oget RO.m{2}.[(q{2}, i{2})] /\ + BIRO2.IRO.mp{1} = RO.m{2} /\ + incl Simulator.unvalid_map{2} BIRO2.IRO.mp{1}); 1: smt(last_rcons). + if{1}; 2: rcondf{2} 2; 1: rcondt{2} 2; 1,3: auto. + - by auto=> />; smt(incl_upd_nin). + by auto; smt(DBlock.dunifin_ll). +auto=> /> &1 &2 h1 h2 [#] q_L k_L h3 h4 h5 h6 h7 h8 h9 h10;split. ++ have:= h1; rewrite -h3 => [#] />; have:= h4; rewrite -h2 => [#] />. + have:= h5. + cut-> : q{2} = (parse (rcons p{1} (v{1} +^ x{2}.`1))).`1 by smt(). + cut-> : k{2} = (parse (rcons p{1} (v{1} +^ x{2}.`1))).`2 by smt(). + by rewrite (formatK (rcons p{1} (v{1} +^ x{2}.`1)))=> [#] />; smt(). +smt(). +qed. -while(i0{2} <= n0{2} /\ ={i0,p0,n0} /\ inv_map2 F.RO.m{2} BIRO2.IRO.mp{1} /\ - format p0{2} (i0{2} + 1) \in F.RO.m{2} /\ x1{1} = p0{1} /\ - incl Simulator.unvalid_map{2} BIRO2.IRO.mp{1} /\ ! valid p0{2} /\ - (0 < i0{2} => last Block.b0 bs0{1} = - oget F.RO.m{2}.[format p0{2} (i0{2} + 1)])). -+ sp; if{1}; 2: rcondf{2} 2; 1: rcondt{2} 2; auto; progress. - + +local lemma equal2 &m : + Pr [ IdealIndif(BIRO.IRO, Simulator, DRestr(D)).main() @ &m : res ] = + Pr [ L(IRO2.LRO).distinguish() @ &m : res ]. +proof. +byequiv=>//=; proc; inline*; auto. +call (: ={BIRO.IRO.mp,C.c,Simulator.m,Simulator.mi,Simulator.paths} /\ + Simulator.unvalid_map{1} = IRO2.RO.m{2}); first last. ++ by proc; inline*; conseq=> />; sim. ++ by proc; inline*; conseq=> />; sim. ++ by auto=> />. +proc; sp; if; auto. +call(: ={BIRO.IRO.mp,Simulator.m,Simulator.mi,Simulator.paths} /\ + Simulator.unvalid_map{1} = IRO2.RO.m{2}); auto. +if; 1,3: auto. +seq 1 1: (={y1,x, BIRO.IRO.mp, Simulator.m, Simulator.mi, Simulator.paths} /\ + Simulator.unvalid_map{1} = RO.m{2}); 2: by (conseq=> />; sim). +if; 1,3: auto; sp. +conseq=> />. +conseq(: ={q, k, BIRO.IRO.mp} /\ Simulator.unvalid_map{1} = RO.m{2} ==> _)=> />. ++ move=> &1 &2 h1 h2 h3 h4 h5 h6. + by have:= h1; rewrite -h3 => [#] /> /#. +inline*; if; 1: auto; 1: sim. +if; 1,3: auto; sp. +swap{2} 4; while{2}((i<=k){2})(k{2}-i{2}); 1: by (auto; smt()). +by sp; if{1}; 2: rcondf{2} 2; 1: rcondt{2} 2; auto; smt(DBlock.dunifin_ll). +qed. + + + +lemma Simplify_simulator &m : + Pr [ IdealIndif(BIRO.IRO, Simulator, DRestr(D)).main() @ &m : res ] = + Pr [ IdealIndif(BIRO.IRO, SimLast(S), DRestr(D)).main() @ &m : res ]. +proof. +rewrite (equal1 &m) (equal2 &m) eq_sym. +by byequiv(RO_LRO_D L)=>//=. qed. + + +end section Simplify_Simulator. + + + + + +section Real_Ideal. + declare module D : DISTINGUISHER{SLCommon.C, C, Perm, Redo, F.RO, F.RRO, S, BIRO.IRO, BIRO2.IRO, F2.RO, F2.FRO, Simulator}. + + axiom D_lossless (F0 <: DFUNCTIONALITY{D}) (P0 <: DPRIMITIVE{D}) : + islossless P0.f => islossless P0.fi => islossless F0.f => + islossless D(F0, P0).distinguish. + + + lemma Real_Ideal &m : + `|Pr [ RealIndif(Sponge,Perm,DRestr(D)).main() @ &m : res ] - + Pr [ IdealIndif(BIRO.IRO, Simulator, DRestr(D)).main() @ &m : res ]| <= + (max_size ^ 2 - max_size)%r / 2%r / (2^r)%r / (2^c)%r + + max_size%r * ((2*max_size)%r / (2^c)%r) + + max_size%r * ((2*max_size)%r / (2^c)%r). + proof. + rewrite(Simplify_simulator D D_lossless &m). + exact/(Inefficient_Real_Ideal D D_lossless &m). + qed. + +end section Real_Ideal. From c1d351634bfc1a8069a18c4ca198c3ab1126aa54 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Thu, 20 Sep 2018 16:55:38 +0100 Subject: [PATCH 326/525] CI: produce detailed reports on failure --- .gitlab-ci.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 067b104..ffdf384 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -12,7 +12,7 @@ sha3: script: - >- docker run -v $PWD:/home/ci/sha3 easycryptpa/ec-test-box - sh -c 'cd sha3 && opam config exec -- make check' + sh -c 'cd sha3 && opam config exec -- make check-xunit' artifacts: when: on_failure paths: From 7385676877d182accae9a92586cda3e8604076d9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Thu, 20 Sep 2018 17:11:59 +0100 Subject: [PATCH 327/525] push on some painful smt calls in Sponge --- proof/Sponge.ec | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) diff --git a/proof/Sponge.ec b/proof/Sponge.ec index 8df8e7c..c72b857 100644 --- a/proof/Sponge.ec +++ b/proof/Sponge.ec @@ -617,12 +617,16 @@ lemma lazy_invar_upd_lu_eq proof. move=> li mem_upd_mp1. case: ((cs, m) = (bs, n))=> [[-> ->] | cs_m_neq_bs_n]. -smt(get_setE). ++ by rewrite !get_set_sameE. rewrite mem_set in mem_upd_mp1. elim mem_upd_mp1=> [mem_mp1 | [-> ->]]. -case: ((pad2blocks bs, n) = (pad2blocks cs, m))=> - [[p2b_bs_p2b_cs eq_mn] | p2b_bs_n_neq_p2b_cs_m]. -smt(pad2blocks_inj). smt(get_setE). smt(get_setE). ++ case: ((pad2blocks bs, n) = (pad2blocks cs, m))=> + [[p2b_bs_p2b_cs ->>] | p2b_bs_n_neq_p2b_cs_m]. + + move: (pad2blocks_inj _ _ p2b_bs_p2b_cs)=> ->>. + by move: cs_m_neq_bs_n=> //=. + rewrite !get_set_neqE 1:// 1:eq_sym //. + by move: li=> [] _ [] _ /(_ _ _ mem_mp1). +by rewrite !get_set_sameE. qed. lemma LowerFun_IRO_HybridIROLazy_f : @@ -916,7 +920,7 @@ lemma eager_eq_except_mem_iff eager_eq_except xs i j mp1 mp2 => ys <> xs \/ k < i \/ j <= k => dom mp1 (ys, k) <=> dom mp2 (ys, k). -proof. smt(domE get_some). qed. +proof. smt(domE). qed. lemma eager_eq_except_upd1_eq_in (xs : block list, i j k : int, y : bool, From 451ae7400e7e9d94ca6ab46622b912716d90e702 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Fri, 21 Sep 2018 11:40:34 +0100 Subject: [PATCH 328/525] Finally fix CI on SHA3-Security? --- proof/SHA3-Security.ec | 17 ++++++----------- 1 file changed, 6 insertions(+), 11 deletions(-) diff --git a/proof/SHA3-Security.ec b/proof/SHA3-Security.ec index ec8af81..f13740c 100644 --- a/proof/SHA3-Security.ec +++ b/proof/SHA3-Security.ec @@ -2,15 +2,8 @@ require import AllCore List IntDiv StdOrder Distr SmtMap FSet. -require (*--*) Common Sponge SLCommon Gconcl_list BlockSponge. - -(*---*) import Common Sponge BIRO. - -clone import IRO as BIRO with - type from <- bool list, - type to <- bool, - op valid <- predT, - op dto <- {0,1}. +require import Common Sponge. import BIRO. +require (*--*) SLCommon Gconcl_list BlockSponge. (* FIX: would be nicer to define limit at top-level and then clone BlockSponge with it - so BlockSponge would then clone lower-level @@ -158,7 +151,8 @@ declare module Dist : DISTINGUISHER{Perm, Gconcl_list.SimLast, IRO, Cntr, BlockSponge.BIRO.IRO, Simulator, BlockSponge.C, Gconcl.S, SLCommon.F.RO, SLCommon.F.RRO, SLCommon.Redo, SLCommon.C, - Gconcl_list.BIRO2.IRO, Gconcl_list.F2.RO, Gconcl_list.F2.RRO}. + Gconcl_list.BIRO2.IRO, Gconcl_list.F2.RO, Gconcl_list.F2.RRO, + Gconcl_list.Simulator}. axiom Dist_lossless (F <: DFUNCTIONALITY) (P <: DPRIMITIVE) : islossless P.f => islossless P.fi => islossless F.f => @@ -322,7 +316,8 @@ lemma SHA3Security Perm, IRO, BlockSponge.BIRO.IRO, Cntr, Simulator, Gconcl_list.SimLast(Gconcl.S), BlockSponge.C, Gconcl.S, SLCommon.F.RO, SLCommon.F.RRO, SLCommon.Redo, SLCommon.C, - Gconcl_list.BIRO2.IRO, Gconcl_list.F2.RO, Gconcl_list.F2.RRO}) + Gconcl_list.BIRO2.IRO, Gconcl_list.F2.RO, Gconcl_list.F2.RRO, + Gconcl_list.Simulator}) &m : (forall (F <: DFUNCTIONALITY) (P <: DPRIMITIVE), islossless P.f => From e87574d1943ab27c8ffa98c32d9d17468908cbf5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Tue, 20 Nov 2018 10:36:00 +0100 Subject: [PATCH 329/525] A secure RO is preimage, second preimage and collision resistant. --- proof/SecureRO.eca | 444 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 444 insertions(+) create mode 100644 proof/SecureRO.eca diff --git a/proof/SecureRO.eca b/proof/SecureRO.eca new file mode 100644 index 0000000..a3318d2 --- /dev/null +++ b/proof/SecureRO.eca @@ -0,0 +1,444 @@ +require import Int Distr Real SmtMap FSet Mu_mem. +require (****) PROM FelTactic. + + + +abstract theory RO_Security. + + type from, to. + + op sampleto : to distr. + + op bound : int. + axiom bound_gt0 : 0 < bound. + + axiom sampleto_ll: is_lossless sampleto. + axiom sampleto_full: is_full sampleto. + axiom sampleto_fu: is_funiform sampleto. + + clone import PROM.GenEager as RO with + type from <- from, + type to <- to, + op sampleto <- fun _ => sampleto + proof * by exact/sampleto_ll. + + module type RF = { + proc init() : unit + proc get(x : from) : to + }. + + module Bounder (F : RF) : RF = { + var counter : int + proc init () : unit = { + counter <- 0; + F.init(); + } + proc get(x : from) : to = { + var y : to <- witness; + if (counter < bound) { + counter <- counter + 1; + y <- F.get(x); + } + return y; + } + }. + + + module type Oracle = { + proc get(x : from) : to {} + }. + + module type AdvPreimage (F : Oracle) = { + proc guess(h : to) : from + }. + + module Preimage (A : AdvPreimage, F : RF) = { + proc main (hash : to) : bool = { + var b,m,hash'; + Bounder(F).init(); + m <@ A(Bounder(F)).guess(hash); + hash' <@ F.get(m); + b <- hash = hash'; + return b; + } + }. + + section Preimage. + + declare module A : AdvPreimage{RO,Preimage}. + + local module FEL (A : AdvPreimage, F : RF) = { + proc main (hash : to) : from = { + var m; + Bounder(F).init(); + m <@ A(Bounder(F)).guess(hash); + return m; + } + }. + + local module Preimage2 (A : AdvPreimage, F : RF) = { + proc main (hash : to) : bool = { + var b,m,hash'; + m <@ FEL(A,F).main(hash); + hash' <@ F.get(m); + b <- hash = hash'; + return b; + } + }. + + lemma RO_is_preimage_resistant &m (h : to) : + Pr [ Preimage(A,LRO).main(h) @ &m : res ] <= (bound + 1)%r * mu1 sampleto h. + proof. + cut->: Pr [ Preimage (A,LRO).main(h) @ &m : res ] = + Pr [ Preimage2(A,LRO).main(h) @ &m : res ]. + + by byequiv=> //=; proc; inline*; sim. + byphoare(: arg = h ==> _) => //=; proc. + seq 1 : (rng RO.m h) (bound%r * mu1 sampleto h) 1%r 1%r (mu1 sampleto h) + (card (fdom RO.m) <= Bounder.counter <= bound /\ hash = h). + + inline*; auto; call(: card (fdom RO.m) <= Bounder.counter <= bound)=> //=. + - proc; inline*; auto; sp; if; 2:auto; wp. + conseq(:_==> card (fdom RO.m) + 1 <= Bounder.counter <= bound); 2: by auto;smt(). + move=> &h /> H1 _ H2 c r x h1 h2; split; 2: smt(). + by rewrite fdom_set fcardU fcard1; smt(fcard_ge0). + by auto=> />; rewrite fdom0 fcards0; smt(bound_gt0). + + call(: true ==> rng RO.m h)=> //; bypr=> /> {&m} &m. + fel 1 Bounder.counter (fun _, mu1 sampleto h) bound (rng RO.m h) + [Bounder(LRO).get: (card (fdom RO.m) <= Bounder.counter < bound)] + (card (fdom RO.m) <= Bounder.counter <= bound) + =>//. + - rewrite StdBigop.Bigreal.BRA.big_const List.count_predT List.Range.size_range. + rewrite IntExtra.Extrema.max_ler //=; 1:smt(bound_gt0). + rewrite-StdRing.RField.AddMonoid.iteropE-StdRing.RField.intmulpE; 1: smt(bound_gt0). + by rewrite StdRing.RField.intmulr; smt(). + - inline*; auto=> />. + by rewrite mem_rng_empty /= fdom0 fcards0 /=; smt(bound_gt0). + - proc. + sp; if; auto; sp; inline*; sp; wp=> /=. + case: (x0 \in RO.m). + + by hoare; auto; smt(mu_bounded). + rnd (pred1 h); auto=> /> &h c ????????. + rewrite rngE/= => [][] a; rewrite get_setE. + case: (a=x{h}) => [->>|] //=. + by move:H1; rewrite rngE /= negb_exists/= => /(_ a) //=. + - move=> c; proc; inline*; sp; if. + + auto; progress. + + smt(). + + by rewrite fdom_set fcardU fcard1; smt(fcard_ge0). + + smt(). + + smt(). + + smt(). + smt(). + by auto. + move=> b c; proc; sp; if; auto; inline*; auto; progress. + - rewrite 2!rngE /= eq_iff; split=> [][] a. + + by rewrite get_setE; move: H4; rewrite domE /=; smt(). + move=> H7; exists a; rewrite get_setE; move: H4; rewrite domE /=; smt(). + - smt(). + - by rewrite fdom_set fcardU fcard1; smt(fcard_ge0). + - smt(). + - smt(). + - smt(). + smt(). + + by inline*; auto. + + by inline*; auto. + + inline*; sp; wp. + case: (x \in RO.m). + - hoare; auto; progress. + + smt(mu_bounded). + rewrite H2/=; move: H1; rewrite rngE /= negb_exists /=. + by have:=H2; rewrite domE; smt(). + rnd (pred1 h); auto=> //= &hr [#]->>??<<-????. + by rewrite H2 /= get_setE /=; smt(). + smt(). + qed. + + end section Preimage. + + (*-------------------------------------------------------------------------*) + module type AdvSecondPreimage (F : Oracle) = { + proc guess(m : from) : from + }. + + module SecondPreimage (A : AdvSecondPreimage, F : RF) = { + proc main (m1 : from) : bool = { + var m2,hash1,hash2; + Bounder(F).init(); + m2 <@ A(Bounder(F)).guess(m1); + hash1 <@ F.get(m1); + hash2 <@ F.get(m2); + return hash1 = hash2 /\ m1 <> m2; + } + }. + + section SecondPreimage. + + + declare module A : AdvSecondPreimage{Bounder,RO,FRO}. + + local module FEL (A : AdvSecondPreimage, F : RO) = { + proc main (m1 : from) : from = { + var m2; + Bounder(F).init(); + F.sample(m1); + m2 <@ A(Bounder(F)).guess(m1); + return m2; + } + }. + + local module SecondPreimage2 (A : AdvSecondPreimage, F : RO) = { + var m2 : from + proc main (m1 : from) : bool = { + var hash1,hash2; + m2 <@ FEL(A,F).main(m1); + hash1 <@ F.get(m1); + hash2 <@ F.get(m2); + return hash1 = hash2 /\ m1 <> m2; + } + }. + + local module D1 (A : AdvSecondPreimage, F : RO) = { + var m1 : from + proc distinguish () : bool = { + var b; + b <@ SecondPreimage2(A,F).main(m1); + return b; + } + }. + + local module SecondPreimage3 (A : AdvSecondPreimage, F : RO) = { + proc main (m1 : from) : bool = { + var b; + SecondPreimage2.m2 <- witness; + D1.m1 <- m1; + Bounder(F).init(); + b <@ D1(A,F).distinguish(); + return b; + } + }. + + + lemma RO_is_second_preimage_resistant &m (mess1 : from) : + Pr [ SecondPreimage(A,LRO).main(mess1) @ &m : res ] + <= (bound + 1)%r * mu1 sampleto witness. + proof. + have->: Pr [ SecondPreimage(A,LRO).main(mess1) @ &m : res ] = + Pr [ SecondPreimage2(A,LRO).main(mess1) @ &m : res ]. + + by byequiv=> //=; proc; inline*; sim. + have->: Pr [ SecondPreimage2(A,LRO).main(mess1) @ &m : res ] = + Pr [ SecondPreimage2(A,RO).main(mess1) @ &m : res ]. + + have->: Pr [ SecondPreimage2(A,LRO).main(mess1) @ &m : res ] = + Pr [ SecondPreimage3(A,LRO).main(mess1) @ &m : res ]. + - by byequiv=> //=; proc; inline*; wp 15 -2; sim. + have->: Pr [ SecondPreimage3(A,LRO).main(mess1) @ &m : res ] = + Pr [ SecondPreimage3(A,RO).main(mess1) @ &m : res ]. + - rewrite eq_sym. + byequiv=>//=; proc. + by call(RO_LRO_D (D1(A))); inline*; auto. + by byequiv=> //=; proc; inline*; wp -2 18; sim. + byphoare(: arg = mess1 ==> _)=>//=; proc. + seq 1 : (rng (rem RO.m mess1) (oget RO.m.[mess1])) + (bound%r * mu1 sampleto witness) 1%r + 1%r (mu1 sampleto witness) + (card (fdom RO.m) - 1 <= Bounder.counter <= bound + /\ mess1 \in RO.m /\ mess1 = m1). + + inline*; auto; call(: card (fdom RO.m) - 1 <= Bounder.counter <= bound + /\ mess1 \in RO.m). + - proc; inline*; auto; sp; if; auto=> /> &h Hc _ Hdom Hc2 sample. + by rewrite sampleto_full/=!fdom_set !fcardU !fcard1;smt(mem_set fcard_ge0). + auto=> /> &h sample. + by rewrite mem_set mem_empty/= fdom_set fdom0 fset0U fcard1; smt(bound_gt0). + + call(: arg = mess1 ==> rng (rem RO.m mess1) (oget RO.m.[mess1])); auto. + bypr=> {&m} &m h; rewrite h. + fel 2 Bounder.counter (fun _, mu1 sampleto witness) bound + (mess1 \in RO.m /\ rng (rem RO.m mess1) (oget RO.m.[mess1])) + [Bounder(RO).get: (card (fdom RO.m) - 1 <= Bounder.counter < bound)] + (card (fdom RO.m) - 1 <= Bounder.counter <= bound /\ mess1 \in RO.m)=> {h} + =>//. + + rewrite StdBigop.Bigreal.BRA.big_const List.count_predT List.Range.size_range. + rewrite IntExtra.Extrema.max_ler //=; 1:smt(bound_gt0). + rewrite-StdRing.RField.AddMonoid.iteropE-StdRing.RField.intmulpE; 1: smt(bound_gt0). + by rewrite StdRing.RField.intmulr; smt(mu_bounded bound_gt0). + + inline*; auto=> />. + move=> &h r; rewrite mem_empty /= !mem_set mem_empty/= sampleto_full /=. + rewrite get_set_sameE//= fdom_set fdom0 fset0U fcard1 /= rngE /=; split; 2: smt(bound_gt0). + by rewrite negb_exists/= => a; rewrite remE get_setE //= emptyE; smt(). + + proc; inline*; sp; if; last by hoare; auto. + sp; case: (x0 \in RO.m)=> //=. + - hoare; auto; smt(mu_bounded). + rcondt 2; 1: auto; wp=> /=. + conseq(:_ ==> pred1 (oget RO.m.[mess1]) r)=> />. + - move=> /> &h c H0c Hcb Hnrng Hmc _ Hdom1 Hdom2 sample. + rewrite mem_set Hdom1 /= get_set_neqE; 1: smt(). + have->: (rem RO.m{h}.[x{h} <- sample] mess1) = (rem RO.m{h} mess1).[x{h} <- sample]. + + by apply fmap_eqP=> y; rewrite remE 2!get_setE remE; smt(). + move: Hnrng; rewrite Hdom1 /= rngE /= negb_exists /= => Hnrng. + rewrite rngE/= => [][] mess; rewrite get_setE remE. + by have:= Hnrng mess; rewrite remE; smt(). + rnd; auto; progress. + by have ->:= sampleto_fu witness (oget RO.m{hr}.[mess1]). + + move=> c; proc; inline*; sp; if; auto; progress. + - smt(). + - by rewrite fdom_set fcardU fcard1; smt(fcard_ge0). + - smt(). + - smt(mem_set). + - smt(). + - smt(). + - smt(). + + move=> b c; proc; inline*; sp; if; auto; smt(). + + by inline*; auto. + + by auto. + + inline*. + rcondf 3; 1: auto. + case: (SecondPreimage2.m2 \in RO.m). + - rcondf 6; 1: auto; hoare; auto=> /> &h _ _ in_dom1 not_rng in_dom2. + + smt(mu_bounded). + move=> sample2 _ sample1 _; rewrite negb_and/=. + move: not_rng; rewrite rngE /= negb_exists /= => /(_ SecondPreimage2.m2{h}). + rewrite remE; case: (SecondPreimage2.m2{h} = m1{h})=> //=. + by move: in_dom1 in_dom2; smt(). + rcondt 6; 1: auto; wp; rnd (pred1 hash1); auto. + move => /> &h _ _ in_dom1 not_rng nin_dom2 sample2 _. + rewrite (sampleto_fu (oget RO.m{h}.[m1{h}]) witness) /= => sample1 _. + by rewrite get_set_sameE => ->. + smt(). + qed. + + end section SecondPreimage. + + + (*--------------------------------------------------------------------------*) + module type AdvCollision (F : Oracle) = { + proc guess() : from * from + }. + + module Collision (A : AdvCollision, F : RO) = { + proc main () : bool = { + var m1,m2,hash1,hash2; + Bounder(F).init(); + (m1,m2) <@ A(Bounder(F)).guess(); + hash1 <@ F.get(m1); + hash2 <@ F.get(m2); + return hash1 = hash2 /\ m1 <> m2; + } + }. + + section Collision. + + declare module A : AdvCollision {RO, FRO, Bounder}. + + local module FEL (A : AdvCollision, F : RO) = { + proc main () : from * from = { + var m1,m2; + Bounder(F).init(); + (m1,m2) <@ A(Bounder(F)).guess(); + return (m1,m2); + } + }. + + local module Collision2 (A : AdvCollision) (F : RO) = { + proc main () : bool = { + var m1,m2,hash1,hash2; + (m1,m2) <@ FEL(A,F).main(); + hash1 <@ F.get(m1); + hash2 <@ F.get(m2); + return hash1 = hash2 /\ m1 <> m2; + } + }. + + op collision (m : ('a, 'b) fmap) = + exists m1 m2, m1 <> m2 /\ m1 \in m /\ m2 \in m /\ m.[m1] = m.[m2]. + + lemma RO_is_collision_resistant &m : + Pr [ Collision(A,RO).main() @ &m : res ] + <= ((bound * (bound - 1) + 2)%r / 2%r * mu1 sampleto witness). + proof. + have->: Pr [ Collision(A,RO).main() @ &m : res ] = + Pr [ Collision2(A,RO).main() @ &m : res ]. + + by byequiv=>//=; proc; inline*; sim. + byphoare=> //; proc. + seq 1 : (collision RO.m) + ((bound * (bound - 1))%r / 2%r * mu1 sampleto witness) 1%r + 1%r (mu1 sampleto witness) + (card (fdom RO.m) <= Bounder.counter <= bound); first last; first last. + + auto. + + auto. + + inline*. + case: (m1 = m2); 1: (by hoare; auto; smt(bound_gt0 mu_bounded)). + case: (m1 \in RO.m); case: (m2 \in RO.m). + - rcondf 3; 1: auto; rcondf 6; 1: auto; hoare; auto; 1: smt(bound_gt0 mu_bounded). + move=> /> &h _ _ Hcoll neq12 in_dom1 in_dom2 _ _ _ _. + move: Hcoll; rewrite /collision negb_exists /= => /(_ m1{h}). + rewrite negb_exists /= => /(_ m2{h}). + by rewrite neq12 in_dom1 in_dom2 /=; smt(). + - rcondf 3; 1: auto; rcondt 6; 1: auto; wp; rnd (pred1 hash1). + auto=> /> &h Hmc Hcb Hcoll neq12 in_dom1 in_dom2 _ _; split. + * smt(sampleto_fu). + by move=> _ sample _; rewrite get_set_sameE; smt(). + - rcondt 3; 1: auto; rcondf 7; 1: (by auto; smt(mem_set)). + swap 6 -5; wp=> /=; rnd (pred1 (oget RO.m.[m2])); auto. + move=> /> &h _ _ Hcoll neq12 in_dom1 in_dom2 _ _; split. + * smt(sampleto_fu). + move=> _ sample _. + by rewrite get_set_sameE get_set_neqE 1:eq_sym. + rcondt 3; 1: auto; rcondt 7; 1: (by auto; smt(mem_set)). + swap 2 -1; swap 6 -4; wp=> //=; rnd (pred1 r); auto. + move=> /> &h _ _ Hcoll neq12 in_dom1 in_dom2 sample1 _; split. + * smt(sampleto_fu). + move=> _ sample2 _. + by rewrite get_set_sameE get_set_sameE; smt(). + + by move=> />; smt(mu_bounded). + + inline*; wp; call(: card (fdom RO.m) <= Bounder.counter <= bound); auto. + - proc; inline*; sp; if; auto. + move=> /> &h Hbc _ Hcb sample _; split. + * by move=> nin_dom1; rewrite fdom_set fcardU fcard1; smt(fcard_ge0). + by move=> in_dom1; smt(). + by move=> />; rewrite fdom0 fcards0; smt(bound_gt0). + call(: true ==> collision RO.m); auto; bypr=> /> {&m} &m. + fel 1 Bounder.counter (fun i, i%r * mu1 sampleto witness) bound + (collision RO.m) + [Bounder(RO).get: (card (fdom RO.m) <= Bounder.counter < bound)] + (card (fdom RO.m) <= Bounder.counter <= bound)=> //. + + rewrite -StdBigop.Bigreal.BRA.mulr_suml StdRing.RField.mulrAC. + rewrite StdOrder.RealOrder.ler_wpmul2r; 1: smt(mu_bounded). + by rewrite StdBigop.Bigreal.sumidE //; smt(bound_gt0). + + inline*; auto=> />. + rewrite fdom0 fcards0; split; 2: smt(bound_gt0). + rewrite /collision negb_exists /= => a; rewrite negb_exists /= => b. + by rewrite mem_empty. + + bypr=> /> {&m} &m; pose c := Bounder.counter{m}; move=> H0c Hcbound Hcoll Hmc _. + byphoare(: !collision RO.m /\ card (fdom RO.m) <= c ==> _)=>//=. + proc; inline*; sp; if; last first. + - by hoare; auto; smt(mu_bounded). + case: (x \in RO.m). + - by hoare; auto; smt(mu_bounded). + rcondt 4; 1: auto; sp; wp=> /=. + conseq(:_==> r \in frng RO.m). + - move=> /> &h c2 Hcoll2 Hb2c Hc2b nin_dom sample m1 m2 neq. + rewrite 2!mem_set. + case: (m1 = x{h}) => //=. + * move=> <<-; rewrite eq_sym neq /= get_set_sameE get_set_neqE//= 1:eq_sym //. + by rewrite mem_frng rngE /= => _ ->; exists m2. + case: (m2 = x{h}) => //=. + * move=> <<- _ in_dom1. + by rewrite get_set_neqE // get_set_sameE mem_frng rngE/= => <-; exists m1. + move=> neq2 neq1 in_dom1 in_dom2; rewrite get_set_neqE // get_set_neqE //. + have:= Hcoll2; rewrite negb_exists /= => /(_ m1). + rewrite negb_exists /= => /(_ m2). + by rewrite neq in_dom1 in_dom2 /= => ->. + rnd; skip=> /> &h counter _ h _. + rewrite (mu_mem (frng RO.m{h}) sampleto (mu1 sampleto witness)); 1: smt(sampleto_fu). + rewrite StdOrder.RealOrder.ler_wpmul2r //; 1: smt(mu_bounded). + by rewrite RealExtra.le_fromint; smt(le_card_frng_fdom). + + move=> c; proc; sp; if; auto; inline*; auto=> />. + move=> &h h1 h2 _ sample _. + by rewrite fdom_set fcardU fcard1; smt(fcard_ge0). + move=> b c; proc; inline*; sp; if; auto=> />. + move=> &h h1 h2 _ sample _. + by rewrite fdom_set fcardU fcard1; smt(fcard_ge0). + qed. + + + end section Collision. + + +end RO_Security. From f6f304e330c8dd7b5bc0e49865f57a1442cd6f54 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Tue, 20 Nov 2018 10:42:41 +0100 Subject: [PATCH 330/525] normalizing using RO, not LRO. --- proof/SecureRO.eca | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/proof/SecureRO.eca b/proof/SecureRO.eca index a3318d2..d02144a 100644 --- a/proof/SecureRO.eca +++ b/proof/SecureRO.eca @@ -87,10 +87,10 @@ abstract theory RO_Security. }. lemma RO_is_preimage_resistant &m (h : to) : - Pr [ Preimage(A,LRO).main(h) @ &m : res ] <= (bound + 1)%r * mu1 sampleto h. + Pr [ Preimage(A,RO).main(h) @ &m : res ] <= (bound + 1)%r * mu1 sampleto h. proof. - cut->: Pr [ Preimage (A,LRO).main(h) @ &m : res ] = - Pr [ Preimage2(A,LRO).main(h) @ &m : res ]. + cut->: Pr [ Preimage (A,RO).main(h) @ &m : res ] = + Pr [ Preimage2(A,RO).main(h) @ &m : res ]. + by byequiv=> //=; proc; inline*; sim. byphoare(: arg = h ==> _) => //=; proc. seq 1 : (rng RO.m h) (bound%r * mu1 sampleto h) 1%r 1%r (mu1 sampleto h) @@ -103,7 +103,7 @@ abstract theory RO_Security. by auto=> />; rewrite fdom0 fcards0; smt(bound_gt0). + call(: true ==> rng RO.m h)=> //; bypr=> /> {&m} &m. fel 1 Bounder.counter (fun _, mu1 sampleto h) bound (rng RO.m h) - [Bounder(LRO).get: (card (fdom RO.m) <= Bounder.counter < bound)] + [Bounder(RO).get: (card (fdom RO.m) <= Bounder.counter < bound)] (card (fdom RO.m) <= Bounder.counter <= bound) =>//. - rewrite StdBigop.Bigreal.BRA.big_const List.count_predT List.Range.size_range. @@ -218,9 +218,12 @@ abstract theory RO_Security. lemma RO_is_second_preimage_resistant &m (mess1 : from) : - Pr [ SecondPreimage(A,LRO).main(mess1) @ &m : res ] + Pr [ SecondPreimage(A,RO).main(mess1) @ &m : res ] <= (bound + 1)%r * mu1 sampleto witness. proof. + have->: Pr [ SecondPreimage(A,RO).main(mess1) @ &m : res ] = + Pr [ SecondPreimage(A,LRO).main(mess1) @ &m : res ]. + + by byequiv=> //=; proc; inline*; sim. have->: Pr [ SecondPreimage(A,LRO).main(mess1) @ &m : res ] = Pr [ SecondPreimage2(A,LRO).main(mess1) @ &m : res ]. + by byequiv=> //=; proc; inline*; sim. From 09294d27144676a5fb5658c99d782c2d3961fc44 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Mon, 8 Apr 2019 14:28:00 +0100 Subject: [PATCH 331/525] make .dir-locals compatible with emacs >= 26 flet was deprecated in emacs 22 --- proof/.dir-locals.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/proof/.dir-locals.el b/proof/.dir-locals.el index 542d7f0..650cbbf 100644 --- a/proof/.dir-locals.el +++ b/proof/.dir-locals.el @@ -1,4 +1,4 @@ ((easycrypt-mode . ((eval . - (flet ((pre (s) (concat (locate-dominating-file buffer-file-name ".dir-locals.el") s))) + (cl-flet ((pre (s) (concat (locate-dominating-file buffer-file-name ".dir-locals.el") s))) (setq easycrypt-load-path `(,(pre ".") ,(pre "smart_counter")))))))) From 9c6c130ec3183193a42b2c0d3881d743c9cf7498 Mon Sep 17 00:00:00 2001 From: Manuel Barbosa Date: Tue, 9 Apr 2019 13:34:45 +0300 Subject: [PATCH 332/525] Introducing reference implementation --- proof/impl/.dir-locals.el | 4 + proof/impl/JArray.ec | 569 +++++++++ proof/impl/JMemory.ec | 412 +++++++ proof/impl/JModel.ec | 322 +++++ proof/impl/JUtils.ec | 280 +++++ proof/impl/JWord.ec | 2438 +++++++++++++++++++++++++++++++++++++ proof/impl/JWord_array.ec | 263 ++++ proof/impl/Spec.ec | 38 + 8 files changed, 4326 insertions(+) create mode 100644 proof/impl/.dir-locals.el create mode 100644 proof/impl/JArray.ec create mode 100644 proof/impl/JMemory.ec create mode 100644 proof/impl/JModel.ec create mode 100644 proof/impl/JUtils.ec create mode 100644 proof/impl/JWord.ec create mode 100644 proof/impl/JWord_array.ec create mode 100644 proof/impl/Spec.ec diff --git a/proof/impl/.dir-locals.el b/proof/impl/.dir-locals.el new file mode 100644 index 0000000..60e4dfd --- /dev/null +++ b/proof/impl/.dir-locals.el @@ -0,0 +1,4 @@ +((easycrypt-mode . + ((eval . + (cl-flet ((pre (s) (concat (locate-dominating-file buffer-file-name ".dir-locals.el") s))) + (setq easycrypt-load-path `(,(pre "..") ,(pre ".") ,(pre "../smart_counter")))))))) diff --git a/proof/impl/JArray.ec b/proof/impl/JArray.ec new file mode 100644 index 0000000..27cfe5f --- /dev/null +++ b/proof/impl/JArray.ec @@ -0,0 +1,569 @@ +require import AllCore SmtMap List. +(*---*) import CoreMap. +require import JUtils. + +(*-------------------------------------------------------------------- *) + +abstract theory MonoArray. + + type elem. + op dfl : elem. + + op size: int. + + axiom ge0_size : 0 <= size. + + type t. + + op "_.[_]" : t -> int -> elem. + + op init : (int -> elem) -> t. + + axiom get_out (t:t) i : !(0 <= i < size) => t.[i] = dfl. + + axiom initE (f:int -> elem) i : + (init f).[i] = if 0 <= i < size then f i else dfl. + + axiom ext_eq (t1 t2: t) : + (forall x, 0 <= x < size => t1.[x] = t2.[x]) => + t1 = t2. + + lemma tP (t1 t2: t) : + t1 = t2 <=> forall i, 0 <= i < size => t1.[i] = t2.[i]. + proof. by move=> />;apply ext_eq. qed. + + lemma init_ext (f1 f2: int -> elem): + (forall x, 0 <= x < size => f1 x = f2 x) => + init f1 = init f2. + proof. by move=> h;apply ext_eq => i hi;rewrite !initE hi h. qed. + + (* -------------------------------------------------------------------- *) + lemma initiE (f:int -> elem) i : 0 <= i < size => (init f).[i] = f i. + proof. by move=> hi;rewrite initE hi. qed. + + hint simplify initiE. + (* -------------------------------------------------------------------- *) + op "_.[_<-_]" (t:t) (i:int) (e:elem) = + init (fun j => if j = i then e else t.[j]) + axiomatized by setE. + + lemma get_set_if (t:t) (i j :int) (a:elem) : + t.[i <- a].[j] = if 0 <= i < size /\ j = i then a else t.[j]. + proof. + rewrite setE initE /=; smt (get_out). + qed. + + lemma get_setE (t:t) (x y:int) (a:elem) : + 0 <= x < size => t.[x<-a].[y] = if y = x then a else t.[y]. + proof. by move=> hx;rewrite get_set_if hx. qed. + + lemma nosmt set_eqiE (t : t) x y a : + 0 <= x < size => y = x => t.[x <- a].[y] = a. + proof. by move=> h1 ->;rewrite get_setE. qed. + + lemma nosmt set_neqiE (t : t) x y a : + 0 <= x < size => y <> x => t.[x <- a].[y] = t.[y]. + proof. by move=> h1; rewrite get_setE // => ->. qed. + + hint simplify (set_eqiE, set_neqiE). + + lemma set_out (i : int) (e : elem) (t : t): + ! (0 <= i < size) => t.[i <- e] = t. + proof. + by move=> hi; apply ext_eq => j hj; rewrite get_set_if hi. + qed. + + lemma set_neg (i : int) (e : elem) (t : t): + i < 0 => t.[i<- e] = t. + proof. move=> hi;apply set_out => /#. qed. + + lemma set_above (i : int) (e : elem) (t : t): + size <= i => t.[i <- e] = t. + proof. move=> hi;apply set_out => /#. qed. + + lemma set_set_if (t : t) (k k' : int) (x x' : elem): + t.[k <- x].[k' <- x'] + = if k = k' + then t.[k' <- x'] + else t.[k' <- x'].[k <- x]. + proof. + apply ext_eq => i hi;case (k = k') => [<<- | neqk];rewrite !get_set_if /#. + qed. + + lemma set_set_eq (t : t) (k : int) (x x' : elem): + t.[k <- x].[k <- x'] = t.[k <- x']. + proof. by rewrite set_set_if. qed. + + lemma set_set_eq_s (t : t) (k1 k2 : int) (x x' : elem): + k1 = k2 => t.[k1 <- x].[k2 <- x'] = t.[k2 <- x']. + proof. move=> ->; apply set_set_eq. qed. + + hint simplify (set_set_eq_s, set_out). + + lemma set_set_swap (t : t) (k k' : int) (x x' : elem): + k <> k' => t.[k <- x].[k' <- x'] = t.[k' <- x'].[k <- x]. + proof. by rewrite set_set_if => ->. qed. + + lemma set_notmod (t:t) i : t.[i <- t.[i]] = t. + proof. + by apply ext_eq => j hj; rewrite get_set_if; case: (0 <= i < size /\ j = i). + qed. + + (* -------------------------------------------------------------------- *) + op of_list (l:elem list) = + init (fun i => nth dfl l i) + axiomatized by of_listE. + + op to_list (t:t) = + mkseq (fun i => t.[i]) size. + + lemma to_listE (t:t) : to_list t = map (fun i => t.[i]) (iota_ 0 size). + proof. done. qed. + + lemma size_to_list (t:t): size (to_list t) = size. + proof. rewrite /to_listE size_mkseq /max; smt (ge0_size). qed. + + lemma get_of_list (l:elem list) i : 0 <= i < size => + (of_list l).[i] = nth dfl l i. + proof. by move=> hi;rewrite of_listE initiE. qed. + + lemma get_to_list (t : t) i : nth dfl (to_list t) i = t.[i]. + proof. + rewrite nth_mkseq_if; case:(0 <= i < size) => hi //. + rewrite get_out //. + qed. + + lemma of_listK (l : elem list) : size l = size => + to_list (of_list l) = l. + proof. + move=> h; apply (eq_from_nth dfl); 1:by rewrite size_to_list h. + move=> i; rewrite size_to_list => hi. + by rewrite get_to_list // get_of_list. + qed. + + lemma to_listK : cancel to_list of_list. + proof. + move=> t; apply ext_eq => i hi. + by rewrite get_of_list // get_to_list. + qed. + + lemma to_list_inj : injective to_list. + proof. by apply/(can_inj _ _ to_listK). qed. + + hint simplify (get_of_list, get_to_list)@0. + hint simplify to_listK@0. + hint simplify to_listE@1. + + lemma init_of_list f : init f = of_list (map f (iota_ 0 size)). + proof. + apply tP => i hi;rewrite get_of_list // (nth_map 0) 1:size_iota 1:/#. + by rewrite nth_iota // initiE. + qed. + + (* hint simplify init_of_list@1. *) + + (* -------------------------------------------------------------------- *) + op create (a:elem) = init (fun (i:int) => a). + + lemma createiE (a:elem) i : 0 <= i < size => (create a).[i] = a. + proof. by apply initiE. qed. + + lemma createL (a:elem) : create a = of_list (map (fun i => a) (iota_ 0 size)). + proof. by rewrite /create init_of_list. qed. + + hint simplify (createiE, createL). + + (* -------------------------------------------------------------------- *) + op map (f: elem -> elem) (t:t) : t = + init (fun i => f t.[i]) + axiomatized by mapE. + + lemma mapiE f t i : 0 <= i < size => (map f t).[i] = f t.[i]. + proof. by rewrite mapE;apply initiE. qed. + + lemma map_of_list f ws : + map f (of_list ws) = of_list (mapN f dfl ws size). + proof. + by apply tP => i hi; rewrite mapiE // !get_of_list // nth_mapN. + qed. + + lemma map_to_list f t : + map f t = of_list (map f (to_list t)). + proof. by rewrite to_listE mapE /= -map_comp // init_of_list. qed. + + hint simplify (mapiE, map_of_list)@0. +(* hint simplify map_to_list@1. *) + + (* -------------------------------------------------------------------- *) + op map2 (f: elem -> elem -> elem) (t1 t2:t) : t = + init (fun i => f t1.[i] t2.[i]) + axiomatized by map2E. + + lemma map2iE f t1 t2 i : 0 <= i < size => (map2 f t1 t2).[i] = f t1.[i] t2.[i]. + proof. by rewrite map2E;apply initiE. qed. + + lemma map2_of_list f ws1 ws2 : + map2 f (of_list ws1) (of_list ws2) = of_list (mapN2 f dfl dfl ws1 ws2 size). + proof. + by apply tP => i hi; rewrite map2iE // !get_of_list // nth_mapN2. + qed. + + lemma map2_to_list f t1 t2 : + map2 f t1 t2 = of_list (map2 f (to_list t1) (to_list t2)). + proof. + rewrite to_listE map2E map2_zip init_of_list /=;congr. + apply (eq_from_nth dfl). + + by rewrite !size_map size_zip !size_map min_ler. + move=> i; rewrite size_map => hi. + rewrite (nth_map 0) 1:// (nth_map (dfl,dfl)). + + by rewrite size_zip min_ler !size_map. + by rewrite /= nth_zip ?size_map // !(nth_map 0). + qed. + + hint simplify (map2iE, map2_of_list)@0. +(* hint simplify (map2_to_list)@1. *) + + (* -------------------------------------------------------------------- *) + op all_eq (t1 t2: t) = + all (fun x => t1.[x] = t2.[x]) (iota_ 0 size). + + lemma all_eq_eq (t1 t2: t) : all_eq t1 t2 => t1 = t2. + proof. + by move=> /allP h; apply ext_eq => x /mem_range; apply h. + qed. + + lemma all_eqP (t1 t2: t) : all_eq t1 t2 <=> t1 = t2. + proof. + split; 1:by apply all_eq_eq. + by move=> ->;apply /allP. + qed. + + (* -------------------------------------------------------------------- *) + op fill (f : int -> elem) (k len : int) (t : t) = + init (fun i => if k <= i < k + len then f i else t.[i]) + axiomatized by fillE. + + lemma filliE (f : int -> elem) (k len:int) (t : t) i : 0 <= i < size => + (fill f k len t).[i] = if k <= i < k + len then f i else t.[i]. + proof. by move=> hi;rewrite fillE initiE. qed. + + hint simplify filliE. + + (* -------------------------------------------------------------------- *) + op sub (t: t) k len = mkseq (fun (i:int) => t.[k+i]) len. + + lemma size_sub t k len : 0 <= len => size (sub t k len) = len. + proof. move=> hl; rewrite size_mkseq /max /#. qed. + + lemma nth_sub (t : t) k len i : 0 <= i < len => + nth dfl (sub t k len) i = t.[k + i]. + proof. by move=> h0i; rewrite nth_mkseq. qed. + +end MonoArray. + +abstract theory PolyArray. + + op size: int. + + axiom ge0_size : 0 <= size. + + type 'a t. + + op "_.[_]" : 'a t -> int -> 'a. + + op init : (int -> 'a) -> 'a t. + + axiom get_out (t:'a t) i : !(0 <= i < size) => t.[i] = witness. + + axiom initE (f:int -> 'a) i : + (init f).[i] = if 0 <= i < size then f i else witness. + + axiom ext_eq (t1 t2: 'a t) : + (forall x, 0 <= x < size => t1.[x] = t2.[x]) => + t1 = t2. + + lemma tP (t1 t2: 'a t) : + t1 = t2 <=> forall i, 0 <= i < size => t1.[i] = t2.[i]. + proof. by move=> />;apply ext_eq. qed. + + (* -------------------------------------------------------------------- *) + lemma initiE (f:int -> 'a) i : 0 <= i < size => (init f).[i] = f i. + proof. by move=> hi;rewrite initE hi. qed. + + hint simplify initiE. + + (* -------------------------------------------------------------------- *) + op "_.[_<-_]" (t:'a t) (i:int) (e:'a) = + init (fun j => if j = i then e else t.[j]) + axiomatized by setE. + + lemma get_set_if (t:'a t) (i j :int) (a:'a) : + t.[i <- a].[j] = if 0 <= i < size /\ j = i then a else t.[j]. + proof. + rewrite setE initE /=; smt (get_out). + qed. + + lemma get_setE (t:'a t) (x y:int) (a:'a) : + 0 <= x < size => t.[x<-a].[y] = if y = x then a else t.[y]. + proof. by move=> hx; rewrite get_set_if hx. qed. + + lemma nosmt set_eqiE (t : 'a t) x y a : + 0 <= x < size => y = x => t.[x <- a].[y] = a. + proof. by move=> h1 ->;rewrite get_setE. qed. + + lemma nosmt set_neqiE (t : 'a t) x y a : + 0 <= x < size => y <> x => t.[x <- a].[y] = t.[y]. + proof. by move=> h1; rewrite get_setE // => ->. qed. + + hint simplify (set_eqiE, set_neqiE). + + lemma set_out (i : int) (e : 'a) (t : 'a t): + ! (0 <= i < size) => t.[i <- e] = t. + proof. + by move=> hi; apply ext_eq => j hj; rewrite get_set_if hi. + qed. + + lemma set_neg (i : int) (e : 'a) (t : 'a t): + i < 0 => t.[i<- e] = t. + proof. move=> hi;apply set_out => /#. qed. + + lemma set_above (i : int) (e : 'a) (t : 'a t): + size <= i => t.[i <- e] = t. + proof. move=> hi;apply set_out => /#. qed. + + lemma set_set_if (t : 'a t) (k k' : int) (x x' : 'a): + t.[k <- x].[k' <- x'] + = if k = k' + then t.[k' <- x'] + else t.[k' <- x'].[k <- x]. + proof. + apply ext_eq => i hi;case (k = k') => [<<- | neqk];rewrite !get_set_if /#. + qed. + + lemma set_set_eq (t : 'a t) (k : int) (x x' : 'a): + t.[k <- x].[k <- x'] = t.[k <- x']. + proof. by rewrite set_set_if. qed. + + lemma set_set_eq_s (t : 'a t) (k1 k2 : int) (x x' : 'a): + k1 = k2 => t.[k1 <- x].[k2 <- x'] = t.[k2 <- x']. + proof. move=> ->; apply set_set_eq. qed. + + hint simplify (set_set_eq_s, set_out). + + lemma set_set_swap (t : 'a t) (k k' : int) (x x' : 'a): + k <> k' => t.[k <- x].[k' <- x'] = t.[k' <- x'].[k <- x]. + proof. by rewrite set_set_if => ->. qed. + + lemma set_notmod (t:'a t) i : t.[i <- t.[i]] = t. + proof. + by apply ext_eq => j hj; rewrite get_set_if; case: (0 <= i < size /\ j = i). + qed. + + (* -------------------------------------------------------------------- *) + op create (a:'a) = init (fun (i:int) => a) + axiomatized by createE. + + lemma createiE (a:'a) i : 0 <= i < size => (create a).[i] = a. + proof. by rewrite createE;apply initiE. qed. + + hint simplify createiE. + + (* -------------------------------------------------------------------- *) + op map ['a, 'b] (f: 'a -> 'b) (t:'a t) : 'b t = + init (fun i => f t.[i]) + axiomatized by mapE. + + lemma mapiE ['a, 'b] (f: 'a -> 'b) t i : 0 <= i < size => (map f t).[i] = f t.[i]. + proof. by rewrite mapE;apply initiE. qed. + + hint simplify mapiE. + + (* -------------------------------------------------------------------- *) + op map2 ['a, 'b, 'c] (f: 'a -> 'b -> 'c) t1 t2 = + init (fun i => f t1.[i] t2.[i]) + axiomatized by map2E. + + lemma map2iE ['a, 'b, 'c] (f: 'a -> 'b -> 'c) t1 t2 i : 0 <= i < size => + (map2 f t1 t2).[i] = f t1.[i] t2.[i]. + proof. by rewrite map2E;apply initiE. qed. + + hint simplify map2iE. + + (* -------------------------------------------------------------------- *) + op all_eq (t1 t2: 'a t) = + all (fun x => t1.[x] = t2.[x]) (iota_ 0 size). + + lemma ext_eq_all (t1 t2: 'a t) : + all_eq t1 t2 <=> t1 = t2. + proof. + split. + + by move=> /allP h; apply ext_eq => x /mem_range; apply h. + by move=> ->;apply /allP. + qed. + + lemma all_eq_eq (t1 t2: 'a t) : all_eq t1 t2 => t1 = t2. + proof. by move=> /ext_eq_all. qed. + + (* -------------------------------------------------------------------- *) + + op of_list (dfl:'a) (l:'a list) = + init (fun i => nth dfl l i). + + op to_list (t:'a t) = + mkseq (fun i => t.[i]) size. + + lemma size_to_list (t:'a t): size (to_list t) = size. + proof. rewrite size_mkseq /max; smt (ge0_size). qed. + + lemma get_of_list (dfl:'a) (l:'a list) i : 0 <= i < size => + (of_list dfl l).[i] = nth dfl l i. + proof. by move=> hi;rewrite /of_list initiE. qed. + + hint simplify get_of_list. + + lemma get_to_list (t : 'a t) i : + nth witness (to_list t) i = t.[i]. + proof. + rewrite nth_mkseq_if; case:(0 <= i < size) => hi //. + rewrite get_out //. + qed. + + hint simplify (get_of_list, get_to_list). + + lemma of_listK (dfl:'a) (l : 'a list) : size l = size => + to_list (of_list dfl l) = l. + proof. + move=> h; apply (eq_from_nth witness); 1:by rewrite size_to_list h. + move=> i; rewrite size_to_list => hi. + rewrite get_to_list // get_of_list //. + by rewrite nth_onth (onth_nth witness) // h. + qed. + + lemma to_listK (dfl:'a) : cancel to_list (of_list dfl). + proof. + move=> t; apply ext_eq => i hi. + by rewrite get_of_list // nth_onth (onth_nth witness) ?size_to_list //= + get_to_list. + qed. + + lemma to_list_inj ['a] : injective (to_list<:'a>). + proof. by apply/(can_inj _ _ (to_listK witness)). qed. + + (* The following rules are for reduction *) + lemma map_of_list ['a, 'b] (f:'a -> 'b) dfa ws : + map f (of_list dfa ws) = of_list (f dfa) (map f ws). + proof. + apply tP => i hi; rewrite mapiE // !get_of_list //. + case (i < size ws) => isws. + + by rewrite (nth_map dfa) // /#. + by rewrite nth_out 1:/# nth_out // size_map 1:/#. + qed. + + lemma map2_of_list (f:'a -> 'b -> 'c) df1 df2 ws1 ws2 : + map2 f (of_list df1 ws1) (of_list df2 ws2) = + of_list (f df1 df2) (mapN2 f df1 df2 ws1 ws2 size). + proof. + by apply tP => i hi; rewrite map2iE // !get_of_list // nth_mapN2. + qed. + + hint simplify (map_of_list, map2_of_list)@0. + + (* -------------------------------------------------------------------- *) + op fill (f : int -> 'a) (k len : int) (t : 'a t) = + init (fun i => if k <= i < k + len then f i else t.[i]) + axiomatized by fillE. + + lemma filliE (f : int -> 'a) (k len:int) (t : 'a t) i : 0 <= i < size => + (fill f k len t).[i] = if k <= i < k + len then f i else t.[i]. + proof. by move=> hi;rewrite fillE initiE. qed. + + hint simplify filliE. + + (* -------------------------------------------------------------------- *) + op sub (t: 'a t) k len = mkseq (fun (i:int) => t.[k+i]) len. + + lemma size_sub (t:'a t) k len : 0 <= len => size (sub t k len) = len. + proof. move=> hl; rewrite size_mkseq /max /#. qed. + + lemma nth_sub (dfl:'a) (t : 'a t) k len i : 0 <= i < len => + nth dfl (sub t k len) i = t.[k + i]. + proof. by move=> h0i; rewrite nth_mkseq. qed. + + + (* -------------------------------------------------------------------- *) + op all (f : 'a -> bool) (t : 'a t) = + all (fun i => f t.[i]) (iota_ 0 size). + + lemma allP (t: 'a t) f : all f t <=> (forall i, 0 <= i < size => f t.[i]). + proof. + rewrite /all (allP);split => h i /=. + + by move=> hi;apply h;rewrite mem_iota //; case: hi. + by rewrite mem_iota /= => h1; apply h;case h1. + qed. + + (* -------------------------------------------------------------------- *) + op is_init (t: 'a option t) = all is_init t. + + lemma is_init_Some (t:'a t) : is_init (map Some t). + proof. by rewrite allP => i hi; rewrite mapiE. qed. + + hint simplify is_init_Some. + +end PolyArray. + +(*clone export PolyArray as Array0 with op size <- 0. +clone export PolyArray as Array1 with op size <- 1. +clone export PolyArray as Array2 with op size <- 2. +clone export PolyArray as Array3 with op size <- 3. +clone export PolyArray as Array4 with op size <- 4. +clone export PolyArray as Array5 with op size <- 5. +clone export PolyArray as Array6 with op size <- 6. +clone export PolyArray as Array7 with op size <- 7. +clone export PolyArray as Array8 with op size <- 8. +clone export PolyArray as Array9 with op size <- 9. + +clone export PolyArray as Array10 with op size <- 10. +clone export PolyArray as Array11 with op size <- 11. +clone export PolyArray as Array12 with op size <- 12. +clone export PolyArray as Array13 with op size <- 13. +clone export PolyArray as Array14 with op size <- 14. +clone export PolyArray as Array15 with op size <- 15. +clone export PolyArray as Array16 with op size <- 16. +clone export PolyArray as Array17 with op size <- 17. +clone export PolyArray as Array18 with op size <- 18. +clone export PolyArray as Array19 with op size <- 19. + +clone export PolyArray as Array20 with op size <- 20. +clone export PolyArray as Array21 with op size <- 21. +clone export PolyArray as Array22 with op size <- 22. +clone export PolyArray as Array23 with op size <- 23. +clone export PolyArray as Array24 with op size <- 24. +clone export PolyArray as Array25 with op size <- 25. +clone export PolyArray as Array26 with op size <- 26. +clone export PolyArray as Array27 with op size <- 27. +clone export PolyArray as Array28 with op size <- 28. +clone export PolyArray as Array29 with op size <- 29. + +clone export PolyArray as Array30 with op size <- 30. +clone export PolyArray as Array31 with op size <- 31. +clone export PolyArray as Array32 with op size <- 32. +clone export PolyArray as Array33 with op size <- 33. +clone export PolyArray as Array34 with op size <- 34. +clone export PolyArray as Array35 with op size <- 35. +clone export PolyArray as Array36 with op size <- 36. +clone export PolyArray as Array37 with op size <- 37. +clone export PolyArray as Array38 with op size <- 38. +clone export PolyArray as Array39 with op size <- 39. + +clone export PolyArray as Array40 with op size <- 40. +clone export PolyArray as Array41 with op size <- 41. +clone export PolyArray as Array42 with op size <- 42. +clone export PolyArray as Array43 with op size <- 43. +clone export PolyArray as Array44 with op size <- 44. +clone export PolyArray as Array45 with op size <- 45. +clone export PolyArray as Array46 with op size <- 46. +clone export PolyArray as Array47 with op size <- 47. +clone export PolyArray as Array48 with op size <- 48. +clone export PolyArray as Array49 with op size <- 49. *) + + diff --git a/proof/impl/JMemory.ec b/proof/impl/JMemory.ec new file mode 100644 index 0000000..7f974fa --- /dev/null +++ b/proof/impl/JMemory.ec @@ -0,0 +1,412 @@ +(* -------------------------------------------------------------------- *) +require import AllCore SmtMap List IntDiv. +(*---*) import CoreMap StdOrder.IntOrder. +require import JUtils JWord. + +(* -------------------------------------------------------------------- *) +theory W8List. + abbrev "_.[_]" (w : W8.t list) (i : int) = nth (W8.of_int 0) w i. +end W8List. +export W8List. + +(* -------------------------------------------------------------------- *) +type address = int. + +type global_mem_t. + +op "_.[_]" : global_mem_t -> address -> W8.t. +op "_.[_<-_]" : global_mem_t -> address -> W8.t -> global_mem_t. + +axiom mem_eq_ext (m1 m2:global_mem_t) : (forall j, m1.[j] = m2.[j]) => m1 = m2. + +axiom get_setE m x y w : + m.[x <- w].[y] = if y = x then w else m.[y]. + +lemma get_set_eqE_s m x y w : + y = x => m.[x <- w].[y] = w. +proof. by rewrite get_setE => ->. qed. + +lemma get_set_neqE_s m x y w : + y <> x => m.[x <- w].[y] = m.[y]. +proof. by rewrite get_setE => ->. qed. + +hint simplify (get_set_eqE_s, get_set_neqE_s). + +op allocated8 : global_mem_t -> address -> bool. + +axiom allocated8_setE y w m x: allocated8 m.[y<-w] x = allocated8 m x. + +(* ------------------------------------------------------------------- *) + +op stores (m : global_mem_t) (a : address) (w : W8.t list) = + foldl (fun (m:global_mem_t) i => m.[a + i <- w.[i]]) m (iota_ 0 (size w)). + +lemma foldl_in_eq (f1 f2:'a -> 'b -> 'a) (s:'b list) a : + (forall a b, b \in s => f1 a b = f2 a b) => foldl f1 a s = foldl f2 a s. +proof. + elim: s a => [ | b s hrec] a //= hin. + by rewrite hin // hrec // => ?? h;apply hin;rewrite h. +qed. + +lemma stores_cons m a w ws : stores m a (w::ws) = stores (m.[a <- w]) (a + 1) ws. +proof. + rewrite /stores /= iota_add 1:// 1:List.size_ge0. + rewrite foldl_cat (addzC 0 1) iota_addl /=. + rewrite -(revK (iota_ 0 (size ws))) map_rev !foldl_rev foldr_map /=. + rewrite -!foldl_rev !revK;apply foldl_in_eq => m0 i /mem_iota /= h /#. +qed. + +lemma allocated8_stores ws a m x : allocated8 (stores m a ws) x = allocated8 m x. +proof. + elim: ws m a => //= w ws hrec m a. + by rewrite stores_cons hrec allocated8_setE. +qed. + +lemma get_storesE m p l j: (stores m p l).[j] = if p <= j < p + size l then nth W8.zero l (j - p) else m.[j]. +proof. + elim: l m p => [ | w l hrec] m p. + + by rewrite /stores /= /#. + rewrite stores_cons hrec /= get_setE. smt (size_ge0). +qed. + +(* ------------------------------------------------------------------- *) +op loadW8 (m : global_mem_t) (a : address) = m.[a]. + +op loadW16 (m : global_mem_t) (a : address) = + pack2_t (W2u8.Pack.init (fun i => m.[a + i])). + +op loadW32 (m : global_mem_t) (a : address) = + pack4_t (W4u8.Pack.init (fun i => m.[a + i])). + +op loadW64 (m : global_mem_t) (a : address) = + pack8_t (W8u8.Pack.init (fun i => m.[a + i])). + +op loadW128 (m : global_mem_t) (a : address) = + pack16_t (W16u8.Pack.init (fun i => m.[a + i])). + +op loadW256 (m : global_mem_t) (a : address) = + pack32_t (W32u8.Pack.init (fun i => m.[a + i])). + +lemma loadW32_bits8 m p i : 0 <= i < 4 => + loadW32 m p \bits8 i = loadW8 m (p + i). +proof. by move=> hi;rewrite /loadW32 pack4bE // initiE. qed. + +lemma loadW128_bits8 m p i : 0 <= i < 16 => + loadW128 m p \bits8 i = loadW8 m (p + i). +proof. by move=> hi;rewrite /loadW128 pack16bE // initiE. qed. + +lemma loadW128_bits32 m p i : 0 <= i < 4 => + loadW128 m p \bits32 i = loadW32 m (p + i * 4). +proof. + move=> hi; rewrite /loadW128 /loadW32. + apply W32.wordP => j hj. + rewrite bits32iE // pack4wE // initiE; 1:by apply divz_cmp. + rewrite pack16wE; 1:by apply W4u32.in_bound. + rewrite initiE /=; 1:by apply divz_cmp => //=;apply W4u32.in_bound. + have -> : i * 32 = (i * 4) * 8 by ring. + by rewrite modzMDl divzMDl // -addzA. +qed. + +lemma load4u8 mem p : + pack4 + [loadW8 mem p; + loadW8 mem (p + 1); + loadW8 mem (p + 2); + loadW8 mem (p + 3)] = + loadW32 mem p. +proof. + have -> : W4u8.Pack.of_list + [loadW8 mem p; loadW8 mem (p + 1); + loadW8 mem (p + 2); loadW8 mem (p + 3)] = + W4u8.Pack.init (fun i => loadW8 mem (p + i)). + + by apply W4u8.Pack.all_eqP; rewrite /all_eq. + apply (can_inj _ _ W4u8.unpack8K); apply W4u8.Pack.packP => i hi. + by rewrite pack4K initiE. +qed. + +lemma load4u32 mem p : + pack4 + [loadW32 mem p; + loadW32 mem (p + 4); + loadW32 mem (p + 8); + loadW32 mem (p + 12)] = + loadW128 mem p. +proof. + have -> : W4u32.Pack.of_list + [loadW32 mem p; loadW32 mem (p + 4); + loadW32 mem (p + 8); loadW32 mem (p + 12)] = + W4u32.Pack.init (fun i => loadW32 mem (p + i * 4)). + + by apply W4u32.Pack.all_eqP; rewrite /all_eq. + apply (can_inj _ _ W4u32.unpack32K); apply W4u32.Pack.packP => i hi. + by rewrite pack4K initiE //= get_unpack32 // loadW128_bits32. +qed. + +(* ------------------------------------------------------------------- *) +op storeW8 (m : global_mem_t) (a : address) (w : W8.t) = + m.[a <- w] +axiomatized by storeW8E. + +op storeW16 (m : global_mem_t) (a : address) (w : W16.t) = + stores m a (to_list (unpack8 w)) +axiomatized by storeW16E. + +op storeW32 (m : global_mem_t) (a : address) (w : W32.t) = + stores m a (to_list (unpack8 w)) +axiomatized by storeW32E. + +op storeW64 (m : global_mem_t) (a : address) (w : W64.t) = + stores m a (to_list (unpack8 w)) +axiomatized by storeW64E. + +op storeW128 (m : global_mem_t) (a : address) (w : W128.t) = + stores m a (to_list (unpack8 w)) +axiomatized by storeW128E. + +op storeW256 (m : global_mem_t) (a : address) (w : W256.t) = + stores m a (to_list (unpack8 w)) +axiomatized by storeW256E. + +lemma pack4u32_bits8_nth i (ws:W32.t list) : 0 <= i < 16 => + W4u32.pack4 ws \bits8 i = nth W32.zero ws (i %/ 4) \bits8 (i%%4). +proof. + move=> hi; rewrite -W4u32.Pack.get_of_list; first by apply divz_cmp. + move: (W4u32.Pack.of_list ws) => w. + apply W8.wordP => k hk. + rewrite -W4u32.pack4bE; 1: by apply divz_cmp. + rewrite bits8iE // bits8iE // bits32iE; 1: smt(modz_cmp). + congr; rewrite {1}(divz_eq i 4); ring. +qed. + +lemma store4u32 mem ptr w0 w1 w2 w3 : + storeW128 mem ptr (W4u32.pack4 [w0; w1; w2; w3]) = + storeW32 + (storeW32 + (storeW32 + (storeW32 mem ptr w0) + (ptr + 4) w1) + (ptr + 8) w2) + (ptr + 12) w3. +proof. + rewrite storeW128E !storeW32E. + rewrite /W4u8.Pack.to_list /mkseq /= /stores /=. + by rewrite !pack4u32_bits8_nth //. +qed. + +lemma store4u8 mem ptr w0 w1 w2 w3 : + storeW32 mem ptr (W4u8.pack4 [w0; w1; w2; w3]) = + storeW8 + (storeW8 + (storeW8 + (storeW8 mem ptr w0) + (ptr + 1) w1) + (ptr + 2) w2) + (ptr + 3) w3. +proof. by rewrite storeW32E !storeW8E. qed. + +lemma get_storeW32E m p (w:W32.t) j : + (storeW32 m p w).[j] = if p <= j < p + 4 then w \bits8 (j - p) else m.[j]. +proof. rewrite storeW32E /= get_storesE /= /#. qed. + +(* ------------------------------------------------------------------- *) +(* Global Memory *) + +module Glob = { + var mem : global_mem_t +}. + +(* ------------------------------------------------------------------- *) +(* Safety *) + +op is_align (ws:wsize) (a:address) = + wsize_i ws %| a. + +op allocated (m:global_mem_t) (p:address) (N:int) : bool = + forall i, 0 <= i < N => allocated8 m (p + i). + +op is_valid (m:global_mem_t) (a:address) (ws:wsize) = + allocated m a (wsize_i ws) /\ is_align ws a +axiomatized by is_validE. + +op valid_range (w:wsize) (mem:global_mem_t) (ptr:address) (len:int) = + forall i, 0 <= i < len => is_valid mem (ptr + wsize_i w * i) w. + +(* ------------------------------------------------------------------- *) + +lemma is_align_le w2 w1 ptr: + wsize_i w1 <= wsize_i w2 => is_align w2 ptr => is_align w1 ptr. +proof. + by rewrite /is_align => hw; apply dvdz_trans; apply div_le_wsize. +qed. + +lemma is_align_add w ptr ofs: + wsize_i w %| ofs => is_align w ptr => is_align w (ptr + ofs). +proof. + by rewrite /is_align => h1 h2; apply dvdzD. +qed. + +(* ------------------------------------------------------------------- *) + +lemma allocated_stores a1 s mem a2 N: allocated (stores mem a1 s) a2 N = allocated mem a2 N. +proof. + rewrite /allocated /= eq_iff;split => h i hi. + + by rewrite -(allocated8_stores s a1) h. + by rewrite allocated8_stores h. +qed. + +lemma allocate_le m p (N1 N2:int) : + N1 <= N2 => + allocated m p N2 => allocated m p N1. +proof. rewrite /allocated => hle h i hi;apply h => /#. qed. + +(* ------------------------------------------------------------------- *) + +lemma valid_range_le (len1 len2:int) w mem ptr : + len1 <= len2 => + valid_range w mem ptr len2 => + valid_range w mem ptr len1. +proof. by move=> hle hv i hlt; apply hv => /#. qed. + +lemma is_valid_valid_range w1 w2 mem ptr : + wsize_i w1 <= wsize_i w2 => + is_valid mem ptr w2 => + valid_range w1 mem ptr (wsize_i w2 %/ wsize_i w1). +proof. + rewrite /valid_range is_validE => hw [ha hia] i hi. + rewrite is_validE is_align_add /=. + + by apply modzMr. + + by apply: is_align_le hia. + move=> k hk /=;rewrite -addzA;apply ha;split;[smt (gt0_wsize_i)|move=> ?]. + apply: (ltr_le_trans ((i + 1) * wsize_i w1)); 1: smt (). + rewrite (divz_eq (wsize_i w2) (wsize_i w1)). + smt (modz_cmp gt0_wsize_i). +qed. + +lemma valid_range_size_le w1 w2 mem ptr len : + wsize_i w1 <= wsize_i w2 => + valid_range w2 mem ptr len => + valid_range w1 mem ptr (len * (wsize_i w2 %/ wsize_i w1)). +proof. + rewrite /valid_range => hw hv i hi. + pose dw := wsize_i w2 %/ wsize_i w1. + have gt0_dw : 0 < dw. + + by apply ltz_divRL => //; apply div_le_wsize. + have := hv (i %/ dw) _. + + apply divz_cmp => //. + move=> /(is_valid_valid_range _ _ _ _ hw) /(_ (i %% dw) _) /=. + + by apply modz_cmp. + have <- := divzK _ _ (div_le_wsize _ _ hw); rewrite -/dw. + have -> : ptr + dw * wsize_i w1 * (i %/ dw) + wsize_i w1 * (i %% dw) = + ptr + wsize_i w1 * ((i %/ dw) * dw + i %% dw) by ring. + by rewrite -divz_eq. +qed. + +lemma valid_range_is_valid w1 w2 mem ptr : + wsize_i w1 <= wsize_i w2 => + is_align w2 ptr => + valid_range w1 mem ptr (wsize_i w2 %/ wsize_i w1) => + is_valid mem ptr w2. +proof. + move=> hw hia hr; rewrite is_validE. + pose dw := wsize_i w2 %/ wsize_i w1. + have gt0_dw : 0 < dw. + + by apply ltz_divRL => //; apply div_le_wsize. + split;last by (have := hr 0 _). + move=> i hi. + have := hr (i %/ wsize_i w1) _. + + split; 1: by apply divz_ge0;[ apply gt0_wsize_i | case hi]. + move=> ?;apply ltz_divRL => //; 1: by apply div_le_wsize. + by have := divz_eq i (wsize_i w1); have := modz_cmp i (wsize_i w1) _ => // /#. + rewrite is_validE; move => [] /(_ (i%%wsize_i w1) _); 1: by apply modz_cmp. + by rewrite mulzC -addzA -divz_eq. +qed. + +lemma valid_range_size_ge w1 w2 mem ptr len1 len2 : + is_align w2 ptr => + wsize_i w1 <= wsize_i w2 => + (wsize_i w2 %/ wsize_i w1) * len2 <= len1 => + valid_range w1 mem ptr len1 => + valid_range w2 mem ptr len2. +proof. + move=> hia hw hl hv. + have {hv} hv:= valid_range_le _ _ _ _ _ hl hv. + move=> i hi; apply (valid_range_is_valid w1) => //. + + by apply is_align_add => //; apply modzMr. + move=> k hk /=. + have gt0_dw : 0 < wsize_i w2 %/ wsize_i w1. + + by apply ltz_divRL => //; apply div_le_wsize. + have := hv ((wsize_i w2 %/ wsize_i w1) * i + k) _. + + split. smt(). + move=> ?;apply (ltr_le_trans (wsize_i w2 %/ wsize_i w1 * (i + 1))). + + smt(). + by apply ler_wpmul2l;[apply ltzW | smt()]. + rewrite Ring.IntID.mulrDr -mulzA (mulzC(wsize_i w1)) divzK ?addzA //. + by apply div_le_wsize. +qed. + +lemma valid_range_add (k:int) w mem ptr len : + 0 <= k <= len => + valid_range w mem ptr len => + valid_range w mem (ptr + k * wsize_i w) (len - k). +proof. + move=> hk hv i hi /=. + have -> : ptr + k * wsize_i w + wsize_i w * i = ptr + wsize_i w * (k + i) by ring. + apply hv => /#. +qed. + +lemma valid_range_add_split p n w mem ptr : + 0 <= p <= n => + valid_range w mem ptr n => + valid_range w mem ptr p /\ + valid_range w mem (ptr + p * wsize_i w) (n - p). +proof. + move=> hp hv; split. + + by apply: valid_range_le hv;case hp. + by apply valid_range_add. +qed. + +(* ------------------------------------------------------------------- *) + +lemma is_valid_store8 mem sz ptr1 ptr2 w : + is_valid (storeW8 mem ptr2 w) ptr1 sz = is_valid mem ptr1 sz. +proof. + rewrite !is_validE storeW8E /allocated;congr. + rewrite eq_iff;split => h i hi. + + by rewrite -(allocated8_setE ptr2 w) h. + by rewrite allocated8_setE h. +qed. +hint simplify is_valid_store8. + +lemma is_valid_store16 mem sz ptr1 ptr2 w : + is_valid (storeW16 mem ptr2 w) ptr1 sz = is_valid mem ptr1 sz. +proof. + by rewrite !is_validE storeW16E allocated_stores. +qed. +hint simplify is_valid_store16. + +lemma is_valid_store32 mem sz ptr1 ptr2 w : + is_valid (storeW32 mem ptr2 w) ptr1 sz = is_valid mem ptr1 sz. +proof. + by rewrite !is_validE storeW32E allocated_stores. +qed. +hint simplify is_valid_store32. + +lemma is_valid_store64 mem sz ptr1 ptr2 w : + is_valid (storeW64 mem ptr2 w) ptr1 sz = is_valid mem ptr1 sz. +proof. + by rewrite !is_validE storeW64E allocated_stores. +qed. +hint simplify is_valid_store64. + +lemma is_valid_store128 mem sz ptr1 ptr2 w : + is_valid (storeW128 mem ptr2 w) ptr1 sz = is_valid mem ptr1 sz. +proof. + by rewrite !is_validE storeW128E allocated_stores. +qed. +hint simplify is_valid_store128. + +lemma is_valid_store256 mem sz ptr1 ptr2 w : + is_valid (storeW256 mem ptr2 w) ptr1 sz = is_valid mem ptr1 sz. +proof. + by rewrite !is_validE storeW256E allocated_stores. +qed. +hint simplify is_valid_store256. diff --git a/proof/impl/JModel.ec b/proof/impl/JModel.ec new file mode 100644 index 0000000..8d0d652 --- /dev/null +++ b/proof/impl/JModel.ec @@ -0,0 +1,322 @@ +(* -------------------------------------------------------------------- *) +require import AllCore BitEncoding IntDiv SmtMap Ring List StdOrder Bool. +(*---*) import CoreMap Map Ring.IntID IntOrder. +require export JUtils JArray JWord JWord_array JMemory. + +(* -------------------------------------------------------------------- *) +abbrev x86_MOVD_32 (x : W32.t) = pack4 [x; W32.zero; W32.zero; W32.zero]. + +op x86_ROL_32 (x : W32.t) (cnt : W8.t) = + let result = W32.rol x (to_uint cnt) in + let CF = result.[0] in + let OF = Logic.(^) CF result.[31] in + (CF, OF, result) + axiomatized by x86_ROL_32_E. + +(* -------------------------------------------------------------------- *) +op x86_SHLD_32 : + W32.t -> W32.t -> W8.t -> (bool * bool * bool * bool * bool * W32.t). + +op x86_SHRD_32 : + W32.t -> W32.t -> W8.t -> (bool * bool * bool * bool * bool * W32.t). + +op x86_SHLD_64 : + W64.t -> W64.t -> W8.t -> (bool * bool * bool * bool * bool * W64.t). + +op x86_SHRD_64 : + W64.t -> W64.t -> W8.t -> (bool * bool * bool * bool * bool * W64.t). + +(* -------------------------------------------------------------------- *) + +op x86_VPSHUFB_128_B (w:W128.t) (m : W8.t) = + let i = W8.to_uint m in + if 128 <= i then W8.zero + else w \bits8 (i %% 16). + +op x86_VPSHUFB_128 (w m : W128.t) : W128.t = + map (x86_VPSHUFB_128_B w) m. + +op x86_VPSHUFB_256 (w m : W256.t) : W256.t = + map2 x86_VPSHUFB_128 w m. + +hint simplify (W16u8.of_int_bits8_div). +hint simplify (W8.of_uintK)@1. +hint simplify W32.get_out@0. + +abbrev [-printing] const_rotate8_128 = (W128.of_int 18676936380593224926704134051422339075). +abbrev [-printing] const_rotate16_128 = (W128.of_int 17342576855639742879858139805557719810). +abbrev [-printing] const_rotate24_128 = (W128.of_int 16028905388486802350658220295983399425). + +lemma rotate8_128_E w : + x86_VPSHUFB_128 w const_rotate8_128 = W4u32.map (fun w => W32.rol w 8) w. +proof. + have h : W128.all_eq + (x86_VPSHUFB_128 w const_rotate8_128) (W4u32.map (fun w => W32.rol w 8) w). + + by cbv W128.all_eq x86_VPSHUFB_128 x86_VPSHUFB_128_B W16u8.unpack8 edivz. + by apply (W128.all_eq_eq _ _ h). +qed. + +lemma rotate16_128_E w : + x86_VPSHUFB_128 w const_rotate16_128 = W4u32.map (fun w => W32.rol w 16) w. +proof. + have h : W128.all_eq + (x86_VPSHUFB_128 w const_rotate16_128) (W4u32.map (fun w => W32.rol w 16) w). + + by cbv W128.all_eq x86_VPSHUFB_128 x86_VPSHUFB_128_B W16u8.unpack8. + by apply (W128.all_eq_eq _ _ h). +qed. + +lemma rotate24_128_E w : + (x86_VPSHUFB_128 w const_rotate24_128) = W4u32.map (fun w => W32.rol w 24) w. +proof. + have h : W128.all_eq + (x86_VPSHUFB_128 w const_rotate24_128) (W4u32.map (fun w => W32.rol w 24) w). + + by cbv W128.all_eq x86_VPSHUFB_128 x86_VPSHUFB_128_B W16u8.unpack8 edivz. + by apply (W128.all_eq_eq _ _ h). +qed. +hint simplify (rotate8_128_E, rotate16_128_E, rotate24_128_E). + +abbrev [-printing] const_rotate8_256 = + W256.of_int 6355432118420048154175784972596847518577147054203239762089463134348153782275. + +abbrev [-printing] const_rotate16_256 = + W256.of_int 5901373100945378232718128989223044758631764214521116316503579100742837863170. + +abbrev [-printing] const_rotate24_256 = + W256.of_int 5454353864746073763129182254217446065883741921538078285974850505695092212225. + +(*lemma pack8u32_bits128 ws i : 0 <= i < 2 => + W8u32.pack8_t ws \bits128 i = pack4 [ws.[4*i];ws.[4*i+1];ws.[4*i+2];ws.[4*i+3] ]. +proof. + move=> /(mema_iota 0 2 i); move: i; apply /List.allP => /=. + by split; apply W128.all_eq_eq;cbv delta. +qed. *) + +lemma pack2_4u32_8u32 (w0 w1 w2 w3 w4 w5 w6 w7 :W32.t) : + pack2 [pack4 [w0;w1;w2;w3]; pack4 [w4; w5; w6; w7]] = + pack8 [w0; w1; w2; w3; w4; w5; w6; w7]. +proof. by apply W256.all_eq_eq;cbv W256.all_eq edivz. qed. + +lemma rotate8_256_E w : + x86_VPSHUFB_256 w const_rotate8_256 = W8u32.map (fun w => W32.rol w 8) w. +proof. +admitted. +(* + rewrite -(W8u32.unpack32K w) /unpack32 /= /x86_VPSHUFB_256 -{1}pack2_4u32_8u32. + rewrite -(W2u128.unpack128K const_rotate8_256) /unpack128 /=. + rewrite !W2u128.of_int_bits128_div 1,2://. + rewrite -W128.of_int_mod; cbv edivz. + by rewrite pack2_4u32_8u32. +qed. +*) +lemma rotate16_256_E w : + x86_VPSHUFB_256 w const_rotate16_256 = W8u32.map (fun w => W32.rol w 16) w. +proof. +admitted. +(* + rewrite -(W8u32.unpack32K w) /unpack32 /= /x86_VPSHUFB_256 -{1}pack2_4u32_8u32. + rewrite -(W2u128.unpack128K const_rotate16_256) /unpack128 /=. + rewrite !W2u128.of_int_bits128_div 1,2://. + rewrite -W128.of_int_mod; cbv edivz. + by rewrite pack2_4u32_8u32. +qed. +*) +lemma rotate24_256_E w : + x86_VPSHUFB_256 w const_rotate24_256 = W8u32.map (fun w => W32.rol w 24) w. +proof. +admitted. +(* + rewrite -(W8u32.unpack32K w) /unpack32 /= /x86_VPSHUFB_256 -{1}pack2_4u32_8u32. + rewrite -(W2u128.unpack128K const_rotate24_256) /unpack128 /=. + rewrite !W2u128.of_int_bits128_div 1,2://. + rewrite -W128.of_int_mod; cbv edivz. + by rewrite pack2_4u32_8u32. +qed. +*) +hint simplify (rotate8_256_E, rotate16_256_E, rotate24_256_E). + +(* -------------------------------------------------------------------- *) +op x86_VPSHUFD_128_B (w : W128.t) (m : W8.t) (i : int) : W32.t = + let m = W8.to_uint m in + let p = (m %/ (2^(2*i)))%%4 in + w \bits32 p. + +op x86_VPSHUFD_128 (w : W128.t) (m : W8.t) : W128.t = + pack4 (map (x86_VPSHUFD_128_B w m) (iota_ 0 4)). + +op x86_VPSHUFD_256 (w : W256.t) (m : W8.t) : W256.t = + map (fun w => x86_VPSHUFD_128 w m) w. + +(* -------------------------------------------------------------------- *) +abbrev [-printing] x86_VPBROADCASTI_2u128 = x86_VPBROADCAST_2u128. + +(* -------------------------------------------------------------------- *) +abbrev [-printing] subc_8 = W8.subc. +abbrev [-printing] addc_8 = W8.addc. +abbrev [-printing] mulu_8 = W8.mulu. + +abbrev [-printing] subc_16 = W16.subc. +abbrev [-printing] addc_16 = W16.addc. +abbrev [-printing] mulu_16 = W16.mulu. + +abbrev [-printing] subc_32 = W32.subc. +abbrev [-printing] addc_32 = W32.addc. +abbrev [-printing] mulu_32 = W32.mulu. + +abbrev [-printing] subc_64 = W64.subc. +abbrev [-printing] addc_64 = W64.addc. +abbrev [-printing] mulu_64 = W64.mulu. + +op mulu64 (w1 w2 : W64.t) = + (W2u32.zeroextu64 (W2u32.truncateu32 w1)) * + (W2u32.zeroextu64 (W2u32.truncateu32 w2)). + +(* -------------------------------------------------------------------- *) + +(* FIXME it is really the semantics? In particular the last if *) +op x86_VPEXTR_64 (w:W128.t) (i:W8.t) = + if W8.to_uint i = 0 then (w \bits64 0) + else if W8.to_uint i = 1 then (w \bits64 1) + else W64.of_int 0. + +op x86_MOVD_64 (v:W64.t) = + pack2 [v; W64.zero]. + +op x86_VPINSR_2u64 (v1:W128.t) (v2:W64.t) (i:W8.t) = + let i = W8.to_uint i %% 2 in + pack2 (map (fun j => if j = i then v2 else v1 \bits64 j) [0;1]). + +op x86_VPINSR_4u32 (v1:W128.t) (v2:W32.t) (i:W8.t) = + let i = W8.to_uint i %% 4 in + pack4 (map (fun j => if j = i then v2 else v1 \bits32 j) [0;1;2;3]). + +abbrev [-printing] x86_VPAND_128 = W128.(`&`). +abbrev [-printing] x86_VPOR_128 = W128.(`|`). +abbrev [-printing] x86_VPXOR_128 = W128.(`^`). + +abbrev [-printing] x86_VPAND_256 = W256.(`&`). +abbrev [-printing] x86_VPOR_256 = W256.(`|`). +abbrev [-printing] x86_VPXOR_256 = W256.(`^`). + +op x86_VPMULU_128 (w1 w2: W128.t) = + map2 mulu64 w1 w2. + +op x86_VPMULU_256 (w1 w2: W256.t) = + map2 mulu64 w1 w2. + +(* FIXME: check this *) +op x86_VPERM2I128 (w1 w2: W256.t) (i:W8.t) : W256.t = + let choose = fun n => + if i.[n+3] then W128.zero + else + let w = if i.[n+1] then w2 else w1 in + w \bits128 b2i i.[n] in + pack2 [choose 0; choose 4]. + +op x86_VPERMQ (w:W256.t) (i:W8.t) : W256.t = + let choose = fun n => w \bits64 ((to_uint i %/ 2^n) %% 4) in + pack4 [choose 0; choose 1; choose 2; choose 4]. + +op x86_VEXTRACTI128 (w:W256.t) (i:W8.t) : W128.t = + w \bits128 b2i i.[0]. + +(* ------------------------------------------------------------------- *) +op interleave_gen ['elem] + (get:W128.t -> W64.t) (split_v : W64.t -> 'elem list) (pack_2v : 'elem list -> W128.t) + (src1 src2: W128.t) = + let l1 = split_v (get src1) in + let l2 = split_v (get src2) in + pack_2v (_interleave l1 l2). + +op get_lo_2u64 (w:W128.t) = w \bits64 0. +op get_hi_2u64 (w:W128.t) = w \bits64 1. + +op x86_VPUNPCKL_16u8 (w1 w2:W128.t) = + interleave_gen get_lo_2u64 W8u8.to_list W16u8.pack16 w1 w2. + +op x86_VPUNPCKL_8u16 (w1 w2:W128.t) = + interleave_gen get_lo_2u64 W4u16.to_list W8u16.pack8 w1 w2. + +op x86_VPUNPCKL_4u32 (w1 w2:W128.t) = + interleave_gen get_lo_2u64 W2u32.to_list W4u32.pack4 w1 w2. + +op x86_VPUNPCKL_2u64 (w1 w2:W128.t) = + interleave_gen get_lo_2u64 (fun x => [x]) W2u64.pack2 w1 w2. + +op x86_VPUNPCKL_32u8 (w1 w2: W256.t) = + map2 x86_VPUNPCKL_16u8 w1 w2. + +op x86_VPUNPCKL_16u16 (w1 w2: W256.t) = + map2 x86_VPUNPCKL_8u16 w1 w2. + +op x86_VPUNPCKL_8u32 (w1 w2: W256.t) = + map2 x86_VPUNPCKL_4u32 w1 w2. + +op x86_VPUNPCKL_4u64 (w1 w2: W256.t) = + map2 x86_VPUNPCKL_2u64 w1 w2. + +op x86_VPUNPCKH_16u8 (w1 w2:W128.t) = + interleave_gen get_hi_2u64 W8u8.to_list W16u8.pack16 w1 w2. + +op x86_VPUNPCKH_8u16 (w1 w2:W128.t) = + interleave_gen get_hi_2u64 W4u16.to_list W8u16.pack8 w1 w2. + +op x86_VPUNPCKH_4u32 (w1 w2:W128.t) = + interleave_gen get_hi_2u64 W2u32.to_list W4u32.pack4 w1 w2. + +op x86_VPUNPCKH_2u64 (w1 w2:W128.t) = + interleave_gen get_hi_2u64 (fun x => [x]) W2u64.pack2 w1 w2. + +op x86_VPUNPCKH_32u8 (w1 w2: W256.t) = + map2 x86_VPUNPCKH_16u8 w1 w2. + +op x86_VPUNPCKH_16u16 (w1 w2: W256.t) = + map2 x86_VPUNPCKH_8u16 w1 w2. + +op x86_VPUNPCKH_8u32 (w1 w2: W256.t) = + map2 x86_VPUNPCKH_4u32 w1 w2. + +op x86_VPUNPCKH_4u64 (w1 w2: W256.t) = + map2 x86_VPUNPCKH_2u64 w1 w2. + +(* ------------------------------------------------------------------- *) +op x86_VPSLLDQ_128 (w1:W128.t) (w2:W8.t) = + let n = to_uint w2 in + let i = min n 16 in + w1 `<<<` (8 * i). + +op x86_VPSLLDQ_256 (w1:W256.t) (w2:W8.t) = + map (fun w => x86_VPSLLDQ_128 w w2) w1. + +op x86_VPSRLDQ_128 (w1:W128.t) (w2:W8.t) = + let n = to_uint w2 in + let i = min n 16 in + w1 `>>>` (8 * i). + +op x86_VPSRLDQ_256 (w1:W256.t) (w2:W8.t) = + map (fun w => x86_VPSRLDQ_128 w w2) w1. +(* ------------------------------------------------------------------- *) +abbrev [-printing] (\vshr32u128) (w1:W128.t) (w2:W8.t) = x86_VPSRL_4u32 w1 w2. +abbrev [-printing] (\vshl32u128) (w1:W128.t) (w2:W8.t) = x86_VPSLL_4u32 w1 w2. +abbrev [-printing] (\vadd32u128) (w1 w2:W128.t) = x86_VPADD_4u32 w1 w2. + + +abbrev [-printing] (\vshr32u256) (w1:W256.t) (w2:W8.t) = x86_VPSRL_8u32 w1 w2. +abbrev [-printing] (\vshl32u256) (w1:W256.t) (w2:W8.t) = x86_VPSLL_8u32 w1 w2. + +abbrev [-printing] (\vshr64u256) (w1:W256.t) (w2:W8.t) = x86_VPSRL_4u64 w1 w2. +abbrev [-printing] (\vshl64u256) (w1:W256.t) (w2:W8.t) = x86_VPSLL_4u64 w1 w2. + +abbrev [-printing] (\vadd32u256) (w1 w2:W256.t) = x86_VPADD_8u32 w1 w2. +abbrev [-printing] (\vadd64u256) (w1 w2:W256.t) = x86_VPADD_4u64 w1 w2. +(*abbrev [-printing] (\vsub64u256) (w1:W256.t) (w2:W8.t) = x86_VPSUB_4u64 w1 w2.*) + +(* ------------------------------------------------------------------- *) +(* Leakages *) + +type leakage_t = [ + | LeakAddr of address list + | LeakCond of bool + | LeakFor of (int * int) +]. + +type leakages_t = leakage_t list. diff --git a/proof/impl/JUtils.ec b/proof/impl/JUtils.ec new file mode 100644 index 0000000..1c8e429 --- /dev/null +++ b/proof/impl/JUtils.ec @@ -0,0 +1,280 @@ +require import AllCore IntDiv List Bool StdOrder. + +hint simplify (oget_some, oget_none). + +(* -------------------------------------------------------------------- *) + +lemma modz_cmp m d : 0 < d => 0 <= m %% d < d. +proof. smt (edivzP). qed. + +lemma divz_cmp d i n : 0 < d => 0 <= i < n * d => 0 <= i %/ d < n. +proof. + by move=> hd [hi1 hi2]; rewrite divz_ge0 // hi1 /= ltz_divLR. +qed. + +lemma mulz_cmp_r i m r : 0 < m => 0 <= i < r => 0 <= i * m < r * m. +proof. + move=> h0m [h0i hir]; rewrite IntOrder.divr_ge0 //=; 1: by apply ltzW. + by rewrite IntOrder.ltr_pmul2r. +qed. + +lemma cmpW i d : 0 <= i < d => 0 <= i <= d. +proof. by move=> [h1 h2];split => // ?;apply ltzW. qed. + +lemma le_modz m d : 0 <= m => m %% d <= m. +proof. + move=> hm. + have [ ->| [] hd]: d = 0 \/ d < 0 \/ 0 < d by smt(). + + by rewrite modz0. + + by rewrite -modzN {2}(divz_eq m (-d)); smt (divz_ge0). + by rewrite {2}(divz_eq m d); smt (divz_ge0). +qed. + +lemma bound_abs (i j:int) : 0 <= i < j => 0 <= i < `|j| by smt(). +hint solve 0 : bound_abs. + +lemma gt0_pow2 (p:int) : 0 < 2^p. +proof. + case (p <= 0)=> [? | /ltzNge hp]; 1:by rewrite pow_le0. + apply (IntOrder.ltr_le_trans 1) => //. + by rewrite -(pow_le0 0 2) // pow_Mle /= ltzW. +qed. + +lemma dvdmodz d m p : d %| m => d %| p => d %| (p%%m). +proof. move=> h1 h2; rewrite /(%|);rewrite modz_dvd //. qed. + +lemma modz_add_carry k i d : 0 <= k < d => 0 <= i < d => d <= k + i => + (k + i)%% d = (k + i) - d. +proof. + move=> hk hi hd; have [_ <- //]:= euclideUl d 1 ((k + i) - d) (k+i) _ _;last by smt(). + by rewrite -divz_eq; ring. +qed. + +lemma modz_sub_carry k i d : 0 <= k < d => 0 <= i < d => k - i < 0 => + (k - i)%% d = d + (k - i). + move=> hk hi hd; have [_ <- //]:= euclideUl d (-1) (d + (k - i)) (k-i) _ _;last by smt(). + by rewrite -divz_eq; ring. +qed. + +lemma nosmt divz_mod_mul n p i: 0 <= p => 0 <= n => + (i %% (n*p)) %/ p = (i %/ p) %% n. +proof. + move=> [hp | <- //]; move=> [hn | <- //]. + rewrite {2}(divz_eq i (n*p)) {2} (divz_eq (i %% (n * p)) p). + pose i1 := i %% (n * p). + have -> : (i %/ (n * p) * (n * p) + (i1 %/ p * p + i1 %% p)) = + ((i %/ (n * p) * n + i1 %/ p) * p + i1 %% p) by ring. + have hp0 : p <> 0 by smt(). + rewrite divzMDl 1:// (divz_small (i1%%p) p) 2:/=; 1: smt (edivzP). + rewrite modzMDl modz_small 2://. + apply bound_abs;apply divz_cmp => //. + by apply modz_cmp => /#. +qed. + +lemma nosmt divz_mod_div n p i: p %| n => 0 <= p => 0 <= n => + (i %% n) %/ p = (i %/ p) %% (n%/p). +proof. + rewrite dvdz_eq => {2}<- hp hn;apply divz_mod_mul => //. + by case: hp => [hp | <-//]; apply divz_ge0. +qed. + +lemma modz_mod_pow2 i n k : i %% 2^n %% 2^k = i %% 2^(min n k). +proof. + case: (0 <= n) => hn. + + rewrite /min;case (n < k) => hnk. + + rewrite (modz_small (i %% 2^n)) 2://;smt (modz_cmp gt0_pow2 pow_Mle). + case (0 <= k) => hk. + + rewrite modz_dvd 2://;1: by apply dvdz_exp2l => /#. + have hk0 : k <= 0 by smt(). + by rewrite !(powNeg _ _ hk0) modz1. + rewrite /min;case (n < k) => hnk. + + by rewrite powNeg 1:/# (modz1 i). + have hk0 : (k <= 0) by smt(). + by rewrite (powNeg _ _ hk0) modz1. +qed. + +(* FIXME: this is defined in IntDiv but with 0 <= i *) +lemma nosmt modz_pow2_div n p i: 0 <= p <= n => + (i %% 2^n) %/ 2^p = (i %/ 2^p) %% 2^(n-p). +proof. + move=> [h1 h2];rewrite divz_mod_div. + + by apply dvdz_exp2l. + + by apply ltzW; apply gt0_pow2. + + by apply ltzW; apply gt0_pow2. + congr; have {1}->: n = (n - p) + p by ring. + by rewrite -pow_add 1:/# 1:// mulzK //; smt (gt0_pow2). +qed. + +(* -------------------------------------------------------------------- *) +lemma powS_minus (x p:int) : 0 < p => x ^ p = x * x ^ (p-1). +proof. smt (powS). qed. + +hint simplify pow_le0@1. +hint simplify powS_minus@1. + +lemma pow2_1 : 2^1 = 2 by []. +lemma pow2_2 : 2^2 = 4 by []. +lemma pow2_3 : 2^3 = 8 by []. +lemma pow2_4 : 2^4 = 16 by []. +lemma pow2_5 : 2^5 = 32 by []. +lemma pow2_6 : 2^6 = 64 by []. +lemma pow2_7 : 2^7 = 128 by []. +lemma pow2_8 : 2^8 = 256 by []. +lemma pow2_16 : 2^16 = 65536 by []. +lemma pow2_32 : 2 ^ 32 = 4294967296 by []. +lemma pow2_64 : 2 ^ 64 = 18446744073709551616 by []. +lemma pow2_128 : 2 ^ 128 = 340282366920938463463374607431768211456 by []. +lemma pow2_256 : 2 ^ 256 = 115792089237316195423570985008687907853269984665640564039457584007913129639936 by []. + +hint simplify + (pow2_1, pow2_2, pow2_3, pow2_4, pow2_5, pow2_6, pow2_7, pow2_8, + pow2_16, pow2_32, pow2_64, pow2_128, pow2_256)@0. + +(* -------------------------------------------------------------------- *) +lemma iotaS_minus : + forall (i n : int), 0 < n => iota_ i n = i :: iota_ (i + 1) (n - 1). +proof. smt (iotaS). qed. + +hint simplify (iota0, iotaS_minus)@0. + +lemma nseqS_minus n (e:'a) : 0 < n => nseq n e = e :: nseq (n-1) e. +proof. smt (nseqS). qed. + +hint simplify (nseq0, nseqS_minus)@0. + +(* -------------------------------------------------------------------- *) +(* Allow to extend reduction rule with xor *) + +lemma xor1b (b : bool) : true ^^ b = !b. +proof. by rewrite xorC xor_true. qed. + +lemma xor0b (b : bool) : false ^^ b = b. +proof. by rewrite xorC xor_false. qed. + +lemma nosmt xorK_simplify (b1 b2: bool) : b1 = b2 => b1 ^^ b2 = false. +proof. by move=> ->; apply xorK. qed. + +hint simplify (xor1b, xor_true, xor0b, xor_false)@0. +hint simplify xorK_simplify@1. + + + +(* -------------------------------------------------------------------- *) +(* extra stuff on list *) + +op map2 ['a, 'b, 'c] (f:'a -> 'b -> 'c) (s:'a list) (t:'b list) = + with s = "[]" , t = "[]" => [] + with s = _ :: _ , t = "[]" => [] + with s = "[]" , t = _ :: _ => [] + with s = x :: s', t = y :: t' => f x y :: map2 f s' t'. + +lemma map2_zip (f:'a -> 'b -> 'c) s t : + map2 f s t = map (fun (p:'a * 'b) => f p.`1 p.`2) (zip s t). +proof. + by elim: s t => [ | s1 s hrec] [ | t1 t] //=;rewrite hrec. +qed. + +op mapN ['a, 'b] (f:'a -> 'b) dfa (s:'a list) N = + with s = "[]" => + if N <= 0 then [] else nseq N (f dfa) + with s = x :: s' => + if N <= 0 then [] + else f x :: mapN f dfa s' (N-1). + +op mapN2 ['a, 'b, 'c] (f:'a -> 'b -> 'c) dfa dfb (s:'a list) (t:'b list) N = + with s = "[]" , t = "[]" => + if N <= 0 then [] else nseq N (f dfa dfb) + + with s = _ :: _ , t = "[]" => mapN (fun x => f x dfb) dfa s N + + with s = "[]" , t = _ :: _ => mapN (fun y => f dfa y) dfb t N + + with s = x :: s', t = y :: t' => + if N <= 0 then [] + else f x y :: mapN2 f dfa dfb s' t' (N-1). + +lemma nth_mapN ['a, 'b] dfb (f:'a -> 'b) dfa (s:'a list) N i : + 0 <= i < N => + nth dfb (mapN f dfa s N) i = f (nth dfa s i). +proof. + elim: s N i => /= [ | x s hrec] N i hiN; + have -> /= : !(N <= 0) + by apply ltzNge; case hiN; apply IntOrder.ler_lt_trans. + + by rewrite nth_nseq. + by case (i=0) => // ?; apply hrec => /#. +qed. + +lemma nth_mapN2 ['a, 'b, 'c] + (f:'a -> 'b -> 'c) dfa dfb dfc (s:'a list) (t:'b list) N i : + 0 <= i < N => + nth dfc (mapN2 f dfa dfb s t N) i = f (nth dfa s i) (nth dfb t i). +proof. + elim: s t N i => [ | x s hrec] [ | y t] N i hiN /=; + have -> /= : !(N <= 0) + by apply ltzNge; case hiN; apply IntOrder.ler_lt_trans. + + by rewrite nth_nseq. + + by case (i=0) => // neqi; apply nth_mapN => /#. + + by case (i=0) => // neqi; apply nth_mapN => /#. + by case (i=0) => // ?;apply hrec => /#. +qed. + +lemma map2_cat (f:'a -> 'b -> 'c) (l1 l2:'a list) (l1' l2':'b list): + size l1 = size l1' => + map2 f (l1 ++ l2) (l1' ++ l2') = map2 f l1 l1' ++ map2 f l2 l2'. +proof. by move=> hs;rewrite !map2_zip zip_cat // map_cat. qed. + +lemma map2C (f: 'a -> 'a -> 'b) (l1 l2:'a list) : + (forall a1 a2, f a1 a2 = f a2 a1) => + map2 f l1 l2 = map2 f l2 l1. +proof. + move=> hf; elim: l1 l2=> [ | a1 l1 hrec] [ | a2 l2] //=. + by rewrite hf hrec. +qed. + +lemma map2_take1 (f: 'a -> 'b -> 'c) (l1: 'a list) (l2: 'b list) : + map2 f l1 l2 = map2 f (take (size l2) l1) l2. +proof. + elim: l1 l2 => [ | a1 l1 hrec] [ | a2 l2] //=. + smt (size_ge0). +qed. + +lemma map2_take2 (f: 'a -> 'b -> 'c) (l1: 'a list) (l2: 'b list) : + map2 f l1 l2 = map2 f l1 (take (size l1) l2). +proof. + elim: l1 l2 => [ | a1 l1 hrec] [ | a2 l2] //=. + smt (size_ge0). +qed. + +lemma size_map2 (f:'a -> 'b -> 'c) (l1:'a list) l2 : size (map2 f l1 l2) = min (size l1) (size l2). +proof. by rewrite map2_zip size_map size_zip. qed. + +lemma nth_map2 dfla dflb dflc (f:'a -> 'b -> 'c) (l1:'a list) l2 i: + 0 <= i < min (size l1) (size l2) => + nth dflc (map2 f l1 l2) i = f (nth dfla l1 i) (nth dflb l2 i). +proof. + elim: l1 l2 i => [ | a l1 hrec] [ | b l2] i /=; 1..3:smt(size_ge0). + case: (i=0) => [->> // | hi ?]. + apply hrec;smt(). +qed. + +(* FIXME: we can not do l1 = "[]", l2= _ => l2 *) +op _interleave (l1 l2: 'a list) = + with l1 = "[]", l2= "[]" => [] + with l1 = "[]", l2= _::_ => l2 + with l1 = _::_, l2 = "[]" => l1 + with l1 = a1::l1', l2 = a2::l2' => a1::a2::_interleave l1' l2'. + +(* ------------------------------------------------------------------- *) +(* Safety *) + +op in_bound (x n:int) = 0 <= x /\ x < n. +op is_init (x : 'a option) = x <> None. + +lemma is_init_Some (a:'a) : is_init (Some a). +proof. done. qed. + +lemma in_bound_simplify x n : + 0 <= x < n => in_bound x n. +proof. done. qed. + +hint simplify (is_init_Some, in_bound_simplify). \ No newline at end of file diff --git a/proof/impl/JWord.ec b/proof/impl/JWord.ec new file mode 100644 index 0000000..94307cf --- /dev/null +++ b/proof/impl/JWord.ec @@ -0,0 +1,2438 @@ +(* -------------------------------------------------------------------- *) +require import AllCore BitEncoding IntDiv SmtMap List StdOrder BitEncoding Bool. +(*---*) import Ring.IntID IntOrder BS2Int. +require import JUtils JArray. + +(* -------------------------------------------------------------------- *) +abstract theory BitWord. + +op size : {int | 0 < size} as gt0_size. + +clone FinType as Alphabet with + type t <- bool, + op enum <- [true; false], + op card <- 2. + +clone include MonoArray with + type elem <- bool, + op dfl <- false, + op size <- size + rename "of_list" as "bits2w" + "to_list" as "w2bits" + "^tP$" as "wordP" + "sub" as "bits" + proof ge0_size by (apply ltzW; apply gt0_size). + +(* -------------------------------------------------------------------- *) +abbrev modulus = 2 ^ size. + +lemma ge2_modulus : 2 <= modulus. +proof. + rewrite powS_minus ?gt0_size; smt (gt0_size powPos). +qed. + +lemma gt0_modulus : 0 < modulus. +proof. smt (ge2_modulus). qed. + +lemma ge0_modulus : 0 <= modulus. +proof. smt (ge2_modulus). qed. + +lemma max_size : max 0 size = size. +proof. by rewrite /max gt0_size. qed. + +hint exact : ge0_size gt0_size gt0_modulus ge2_modulus ge0_modulus max_size. + +(* --------------------------------------------------------------------- *) +(* Conversions with int *) + +op of_int (x:int) : t = + bits2w (int2bs size (x %% modulus)) +axiomatized by of_intE. + +op to_uint (w:t) = + bs2int (w2bits w) +axiomatized by to_uintE. + +op smod (i:int) = + if 2^(size - 1) <= i then i - modulus + else i. + +op to_sint (w:t) : int = smod (to_uint w) +axiomatized by to_sintE. + +abbrev zero = of_int 0. +abbrev one = of_int 1. + +lemma to_uint_cmp (x : t) : 0 <= to_uint x < modulus. +proof. + rewrite to_uintE bs2int_ge0 -(size_w2bits x) bs2int_le2Xs. +qed. + +lemma of_uintK (x : int) : to_uint (of_int x) = x %% modulus. +proof. + by rewrite to_uintE of_intE bits2wK 1:size_int2bs // int2bsK // modz_cmp. +qed. + +lemma to_uintK : cancel to_uint of_int. +proof. + move=> w; rewrite to_uintE of_intE. + rewrite modz_small. + + by rewrite bs2int_ge0 ger0_norm // -(size_w2bits w) bs2int_le2Xs. + by rewrite -(size_w2bits w) bs2intK w2bitsK. +qed. + +lemma to_uintK' (x: t) : of_int (to_uint x) = x. +proof. by apply to_uintK. qed. + +(*hint simplify of_uintK@1. *) +hint simplify to_uintK'@0. + +lemma of_sintK (x:int) : + to_sint (of_int x) = smod (x %% modulus). +proof. by rewrite to_sintE of_uintK. qed. + +lemma to_uint_mod (x : t) : to_uint x %% modulus = to_uint x. +proof. by rewrite modz_small // ger0_norm // to_uint_cmp. qed. + +lemma of_int_mod (x : int) : of_int (x %% modulus) = of_int x. +proof. by apply/(can_inj _ _ to_uintK); rewrite !of_uintK modz_mod. qed. + +lemma of_int_mod_red (x:int): !(0 <= x < modulus) => of_int x = of_int (x %% modulus). +proof. by rewrite of_int_mod. qed. + +hint simplify of_int_mod_red. + +lemma to_uint_small i : 0 <= i < modulus => to_uint (of_int i) = i. +proof. by move=> h; rewrite of_uintK modz_small;solve. qed. + +lemma to_uint0 : to_uint (of_int 0) = 0 by []. +lemma to_uint1 : to_uint (of_int 1) = 1 by []. + +hint simplify (to_uint0, to_uint1)@0. +hint simplify to_uint_small@1. + +lemma word_modeqP (x y : t) : + to_uint x %% modulus = to_uint y %% modulus => x = y. +proof. +move=> eq_mod; rewrite -(to_uintK x) -(to_uint_mod x). +by rewrite eq_mod to_uint_mod. +qed. + +lemma to_uint_eq (x y:t) : (x = y) <=> (to_uint x = to_uint y). +proof. by rewrite Core.inj_eq // (Core.can_inj _ _ to_uintK). qed. + +(* -------------------------------------------------------------------- *) +op int_bit x i = (x%%modulus) %/ 2 ^ i %% 2 <> 0. + +lemma of_intwE x i : + (of_int x).[i] = (0 <= i < size /\ int_bit x i). +proof. + rewrite of_intE; case (0 <= i < size) => /= hi; last by rewrite get_out. + by rewrite get_bits2w // nth_mkseq. +qed. + +lemma zerowE i: zero.[i] = false. +proof. by rewrite of_intwE /int_bit. qed. +hint simplify zerowE. + +lemma of_int_powm1 p i : + (of_int (2^p - 1)).[i] = (0 <= i < size /\ i < p). +proof. + case: (0 <= i < size) => [[h0i his] | hi]; last by rewrite get_out. + case (0 <= p) => hp; last by rewrite pow_le0 1:/# /= /#. + have aux : forall p, 0 <= p <= size => (of_int (2 ^ p - 1)).[i] = (true /\ i < p). + + move=> {p hp} p hp. + rewrite of_intwE 1:// /int_bit /= (modz_small (2 ^ p - 1)). + + smt (gt0_pow2 pow_Mle). + case (i < p) => hip /=. + + have -> : p = ((p - i - 1) + 1) + i by ring. + rewrite h0i his -pow_add // 1:/# divzMDl; 1: smt (gt0_pow2). + rewrite -pow_add 1:/# //= modzMDl divNz // gt0_pow2. + by rewrite divz_small //; smt (gt0_pow2 pow_Mle). + case : (p <= size) => hps; 1: by apply aux. + rewrite (_:i < p) 1:/# -of_int_mod. + have -> : p = (p-size) + size by ring. + rewrite -pow_add 1:/# 1://. + by rewrite modzMDl -(modzMDl 1 (-1) modulus) /= of_int_mod aux 1:// his. +qed. + +lemma get_to_uint w i : w.[i] = (0 <= i < size /\ to_uint w %/ 2 ^ i %% 2 <> 0). +proof. + case : (0 <= i < size) => hi;last by rewrite get_out. + rewrite -{1}(to_uintK w) of_intwE hi /int_bit (modz_small _ modulus) 2://. + by apply bound_abs; apply to_uint_cmp. +qed. + +lemma b2i_get w i : 0 <= i => b2i w.[i] = to_uint w %/ 2 ^ i %% 2. +proof. + move=> hi;rewrite get_to_uint hi. + case (i < size) => his //=; 1: smt (modz_cmp). + rewrite divz_small //; apply bound_abs. + smt (to_uint_cmp pow_Mle ge0_size). +qed. + +lemma bits_divmod w i j: 0 <= i => 0 <= j => bs2int (bits w i j) = ((to_uint w) %/ 2^i) %% 2^j. +proof. + move => hi; rewrite /bits. + elim /intind: j. + + by rewrite mkseq0 bs2int_nil /=. + move=> j hj hrec; rewrite mkseqS 1:// bs2int_rcons. + rewrite size_mkseq max_ler 1:// /= hrec. + have {2}->:= modz_pow_split (i+j+1) (i+j) (to_uint w) 2 _; 1: smt(). + have hij1 : 2 ^ (i + j + 1) = 2^(j+1) * 2^i. + + rewrite pow_add 1:/# 1://;congr;ring. + have hij : 2 ^ (i + j) = 2^j * 2^i. + + rewrite pow_add 1:/# 1://;congr;ring. + have h2i0 : 2 ^ i <> 0 by smt (gt0_pow2). + rewrite -addzA {2}hij1 -mulzA divzMDl 1://. + rewrite {2}hij -mulzA divzMDl 1://. + rewrite modzMDl !modz_pow2_div; 1,2:smt(). + have -> : i + j + 1 - (i + j) = 1 by ring. + have -> : i + j - i = j by ring. + rewrite -(pow_add 2 j 1) 1,2:// pow2_1 (modz_small _ (2^j * 2)). + + by apply bound_abs; smt (modz_cmp gt0_pow2). + by rewrite addzC mulzC b2i_get 1:/#. +qed. + +lemma bitsE w k len : bits w k len = mkseq (fun (i:int) => w.[k+i]) len. +proof. done. qed. + +lemma to_uintRL (w:t) (x:int) : to_uint w = x %% 2^size => w = of_int x. +proof. + by move=> h;rewrite -of_int_mod; apply: (canRL _ _ _ _ to_uintK). +qed. + +lemma to_uint_bits w : to_uint w = bs2int (bits w 0 size). +proof. by rewrite to_uintE /w2bits /bits. qed. + +(* -------------------------------------------------------------------- *) +op zerow = zero. + +op onew = of_int (modulus - 1) +axiomatized by oneE. + +op (+^) : t -> t -> t = map2 (^^) +axiomatized by xorE. + +op andw : t -> t -> t = map2 (/\) +axiomatized by andE. + +op oppw (w : t): t = w. + +op invw : t -> t = map ([!]) +axiomatized by invE. + +op orw : t -> t -> t = map2 (\/) +axiomatized by orE. + +(* -------------------------------------------------------------------- *) + +lemma zerowiE i: zerow.[i] = false. +proof. apply zerowE. qed. + +lemma onewE i: onew.[i] = (0 <= i < size). +proof. + rewrite oneE; case (0 <= i < size) => hi; 2:by rewrite get_out. + by rewrite of_int_powm1 //= 1:/# hi. +qed. + +lemma xorwE w1 w2 i: (w1 +^ w2).[i] = w1.[i] ^^ w2.[i]. +proof. + by rewrite xorE; case (0 <= i < size) => hi;[ rewrite map2iE | rewrite !get_out]. +qed. + +lemma andwE (w1 w2:t) i: (andw w1 w2).[i] = (w1.[i] /\ w2.[i]). +proof. + by rewrite andE; case (0 <= i < size) => hi;[ rewrite map2iE | rewrite !get_out]. +qed. + +lemma orwE (w1 w2:t) i: (orw w1 w2).[i] = (w1.[i] \/ w2.[i]). +proof. + by rewrite orE; case (0 <= i < size) => hi;[ rewrite map2iE | rewrite !get_out]. +qed. + +lemma invwE (w:t) i: + (invw w).[i] = (0 <= i < size /\ !w.[i]). +proof. by rewrite invE mapE initE;case (0 <= i < _). qed. + +lemma oppwE (w:t) i: (oppw w).[i] = w.[i]. +proof. by []. qed. + +hint rewrite bwordE : zerowE zerowiE onewE xorwE andwE invwE. +hint simplify (zerowE, zerowiE, onewE, xorwE, andwE, invwE, orwE). + +(* -------------------------------------------------------------------- *) +lemma onew_neq0: onew <> zerow. +proof. + apply/negP=> /wordP/(_ 0) /=. + by rewrite negb_imply neqF. +qed. + +lemma xorw0: right_id zero (+^). +proof. by move=> w; apply/wordP=> i _. qed. + +lemma xorwA: associative (+^). +proof. by move=> w1 w2 w3; apply/wordP=> i _; rewrite !bwordE xorA. qed. + +lemma xorwC: commutative (+^). +proof. by move=> w1 w2; apply/wordP=> i _; rewrite !bwordE xorC. qed. + +lemma xorwK: forall x, x +^ x = zero. +proof. by move=> w; apply/wordP=> i _; rewrite !bwordE. qed. + +lemma andw1: right_id onew andw. +proof. by move=> w; apply/wordP=> i h; rewrite !bwordE h. qed. + +lemma andwA: associative andw. +proof. by move=> w1 w2 w3; apply/wordP=> i h; rewrite !bwordE andbA. qed. + +lemma andwC: commutative andw. +proof. by move=> w1 w2; apply/wordP=> i h; rewrite !bwordE andbC. qed. + +lemma andwDl: left_distributive andw (+^). +proof. move=> w1 w2 w3; apply/wordP=> i h; rewrite !bwordE smt. qed. + +lemma andwK: idempotent andw. +proof. by move=> x; apply/wordP=> i h; rewrite !bwordE andbb. qed. + +(* -------------------------------------------------------------------- *) +instance bring with t + op rzero = zerow + op rone = onew + op add = (+^) + op mul = andw + op opp = oppw + + proof oner_neq0 by apply/onew_neq0 + proof addr0 by apply/xorw0 + proof addrA by (move=> w1 w2 w3; rewrite xorwA) + proof addrC by apply/xorwC + proof addrK by apply/xorwK + proof mulr1 by apply andw1 + proof mulrA by (move=> w1 w2 w3; rewrite andwA) + proof mulrC by apply/andwC + proof mulrDl by apply/andwDl + proof mulrK by apply/andwK + proof oppr_id by trivial. + +pred unitw (w:t) = w = onew. +op iandw (w:t) = if w = onew then onew else w. + +clone Ring.ComRing as WRing with + type t <- t, + op zeror <- zero, + op ( + ) <- (+^), + op [ - ] <- oppw, + op oner <- onew, + op ( * ) <- andw, + op invr <- iandw, + pred unit <- unitw +proof *. +realize addrA. proof. apply xorwA. qed. +realize addrC. proof. apply xorwC. qed. +realize add0r. proof. move=> ?;ring. qed. +realize addNr. proof. move=> ?;ring. qed. +realize oner_neq0. proof. apply onew_neq0. qed. +realize mulrA. proof. apply andwA. qed. +realize mulrC. proof. apply andwC. qed. +realize mul1r. proof. move=> ?;ring. qed. +realize mulrDl. proof. apply andwDl. qed. +realize mulVr. proof. move=> ?;rewrite /unitw /iandw => -> /=;ring. qed. +realize unitout. proof. by move=> x;rewrite /unitw /iandw => ->. qed. + +realize unitP. +proof. +move=> x y; rewrite /unitw !wordP => + i Hi -/(_ i Hi). +by rewrite andwE onewE Hi /#. +qed. + +lemma xor0w w : of_int 0 +^ w = w. +proof. by apply WRing.add0r. qed. + +lemma xorw0_s w : w +^ of_int 0 = w. +proof. by apply WRing.addr0. qed. + +lemma xorw1 w : w +^ onew = invw w. +proof. by apply wordP => i hi /=; case (0 <= i < size). qed. + +lemma xor1w w : onew +^ w = invw w. +proof. by apply wordP => i hi /=; case (0 <= i < size). qed. + +lemma and0w w : andw (of_int 0) w = of_int 0. +proof. by apply WRing.mul0r. qed. + +lemma andw0 w : andw w (of_int 0) = of_int 0. +proof. by apply WRing.mulr0. qed. + +lemma and1w w : andw onew w = w. +proof. by apply WRing.mul1r. qed. + +lemma andw1_s w : andw w onew = w. +proof. by apply WRing.mulr1. qed. + +lemma orw0 w : orw w zero = w. +proof. by apply wordP => i hi. qed. + +lemma or0w w : orw zero w = w. +proof. by apply wordP => i hi. qed. + +lemma orw1 w : orw w onew = onew. +proof. by apply wordP => i hi /=; case (0 <= i < size). qed. + +lemma or1w w : orw onew w = onew. +proof. by apply wordP => i hi /=; case (0 <= i < size). qed. + +lemma orwK w : orw w w = w. +proof. by apply wordP => i hi /=; case (w.[i]). qed. + +lemma xorwK_s w1 w2 : w1 = w2 => (w1 +^ w2) = zero. +proof. move=> ->;apply xorwK. qed. + +lemma andwK_s w1 w2 : w1 = w2 => andw w1 w2 = w1. +proof. move=> ->;apply andwK. qed. + +lemma orwK_s w1 w2 : w1 = w2 => orw w1 w2 = w1. +proof. move=> ->;apply orwK. qed. + +hint simplify (xor0w, xorw0_s, xorw1, xor1w, + and0w, andw0, and1w, andw1_s, + or0w, orw0, orw1, or1w, + xorwK_s, andwK_s, orwK_s). + +(* --------------------------------------------------------------------- *) +(* Arimethic operations *) + +op ulift1 (f : int -> int) (w : t) = + of_int (f (to_uint w)). + +op ulift2 (f : int -> int -> int) (w1 w2 : t) = + of_int (f (to_uint w1) (to_uint w2)). + +op slift2 (f : int -> int -> int) (w1 w2 : t) = + of_int (f (to_uint w1) (to_uint w2)). + +op ( + ) = ulift2 Int.( + ) axiomatized by addE. +op ([-]) = ulift1 Int.([-]) axiomatized by oppE. +op ( * ) = ulift2 Int.( * ) axiomatized by mulE. + +op (\udiv) = ulift2 IntDiv.( %/) axiomatized by udivE. +op (\umod) = ulift2 IntDiv.( %/) axiomatized by umodE. + +(* TODO check this *) +op (\sdiv) = slift2 IntDiv.( %/) axiomatized by sdivE. +op (\smod) = slift2 IntDiv.( %/) axiomatized by smodE. + +(* --------------------------------------------------------------------- *) +(* Comparisons *) + +op (\ule) (x y : t) = (to_uint x) <= (to_uint y) axiomatized by uleE. +op (\ult) (x y : t) = (to_uint x) < (to_uint y) axiomatized by ultE. + +op (\sle) (x y : t) = (to_sint x) <= (to_sint y) axiomatized by sleE. +op (\slt) (x y : t) = (to_sint x) < (to_sint y) axiomatized by sltE. + +lemma ult_of_int x y : + (of_int x \ult of_int y) = (x %% modulus < y %% modulus). +proof. by rewrite ultE /= !of_uintK. qed. + +lemma ule_of_int x y : + (of_int x \ule of_int y) = (x %% modulus <= y %% modulus). +proof. by rewrite uleE /= !of_uintK. qed. + +lemma uleNgt x y : x \ule y <=> ! y \ult x. +proof. by rewrite ultE uleE lerNgt. qed. + +lemma ultNge x y: x \ult y <=> ! y \ule x. +proof. by rewrite ultE uleE ltzNge. qed. + +lemma ult_of_int_true x y : + (x %% modulus < y %% modulus) => (of_int x \ult of_int y) = true. +proof. by rewrite ult_of_int => ->. qed. + +lemma ult_of_int_false x y : + !(x %% modulus < y %% modulus) => (of_int x \ult of_int y) = false. +proof. by rewrite ult_of_int => ->. qed. + +lemma ule_of_int_true x y : + (x %% modulus <= y %% modulus) => (of_int x \ule of_int y) = true. +proof. by rewrite ule_of_int => ->. qed. + +lemma ule_of_int_false x y : + !(x %% modulus <= y %% modulus) => (of_int x \ule of_int y) = false. +proof. by rewrite ule_of_int => ->. qed. + +hint simplify (ult_of_int_true, ult_of_int_false, ule_of_int_true, ule_of_int_false). + +(* --------------------------------------------------------------------- *) +(* ComRing *) + +op is_inverse (w wi: t) = wi * w = of_int 1. +op unit (w:t) = exists wi, is_inverse w wi. +op invr (w:t) = Logic.choiceb (is_inverse w) w. + +lemma of_intN (x : int) : of_int (-x) = - of_int x. +proof. +rewrite oppE /ulift1 /=; apply/word_modeqP=> /=. +by rewrite !of_uintK !modz_mod modzNm. +qed. + +lemma to_uintN (x : t) : to_uint (-x) = (- to_uint x) %% modulus. +proof. by rewrite oppE /ulift1 of_uintK. qed. + +lemma of_intD (x y : int) : of_int (x + y) = of_int x + of_int y. +proof. +rewrite addE /ulift2 /=; apply/word_modeqP=> /=. +by rewrite !of_uintK !modz_mod !(modzDml, modzDmr). +qed. + +lemma to_uintD (x y : t) : to_uint (x + y) = (to_uint x + to_uint y) %% modulus. +proof. by rewrite addE /ulift2 of_uintK. qed. + +lemma of_intM (x y : int) : of_int x * of_int y = of_int (x * y). +proof. +rewrite mulE /ulift2 /=; apply/word_modeqP=> /=. +by rewrite !of_uintK !modz_mod !(modzMml, modzMmr). +qed. + +lemma to_uintM (x y : t) : to_uint (x * y) = (to_uint x * to_uint y) %% modulus. +proof. by rewrite mulE /ulift2 !of_uintK. qed. + +lemma to_uintD_small (x y : t) : to_uint x + to_uint y < modulus => + to_uint (x + y) = to_uint x + to_uint y. +proof. + move=> h;rewrite to_uintD modz_small 2://; smt (to_uint_cmp). +qed. + +lemma to_uintM_small (x y : t) : to_uint x * to_uint y < modulus => + to_uint (x * y) = (to_uint x * to_uint y). +proof. + move=> h;rewrite to_uintM modz_small 2://; smt (to_uint_cmp). +qed. + +clone export Ring.ComRing as WRingA with + type t <- t, + op zeror <- of_int 0, + op ( + ) <- BitWord.( + ), + op [ - ] <- BitWord.([-]), + op oner <- of_int 1, + op ( * ) <- BitWord.( * ), + op invr <- invr, + pred unit <- BitWord.unit proof *. + +realize addrA. +proof. + move=> x y z; rewrite addE /ulift2 !to_uintD -of_int_mod modzDmr. + by rewrite -(of_int_mod (_ + to_uint z)) modzDml addrA. +qed. + +realize addrC. +proof. by move=> x y; rewrite !addE /ulift2 addzC. qed. + +realize add0r. +proof. by move=> x; rewrite addE /ulift2; cbv delta. qed. + +realize addNr. +proof. + move=> x; rewrite addE oppE /ulift2 /ulift1 of_uintK. + by rewrite -of_int_mod modzDml addNz. +qed. + +realize oner_neq0. +proof. + apply /negP => heq. + have := of_uintK 1; rewrite heq of_uintK mod0z. + rewrite modz_small //;smt (ge2_modulus). +qed. + +realize mulrA. + move=> x y z; rewrite mulE /ulift2 !to_uintM -of_int_mod modzMmr. + by rewrite -(of_int_mod (_ * to_uint z)) modzMml mulrA. +qed. + +realize mulrC. +proof. by move=> x y; rewrite !mulE /ulift2 mulzC. qed. + +realize mul1r. +proof. by move=> x; rewrite mulE /ulift2 to_uint1. qed. + +realize mulrDl. +proof. + move=> x y z; rewrite !addE !mulE /ulift2. + rewrite !of_uintK -of_int_mod modzMml eq_sym. + by rewrite -of_int_mod modzDml modzDmr mulrDl. +qed. + +realize mulVr. +proof. by move=> x /choicebP /= ->. qed. + +realize unitP. +proof. by move=> w wi hinv;exists wi. qed. + +realize unitout. +proof. by move=> x /negb_exists /=; apply choiceb_dfl. qed. + +abbrev (^) = WRingA.exp. + +lemma ofintS (n : int) : 0 <= n => of_int (n + 1) = of_int 1 + of_int n. +proof. by rewrite of_intD addrC. qed. + +lemma to_uintB (x y: t) : y \ule x => to_uint (x - y) = to_uint x - to_uint y. +proof. + rewrite uleE=> hle. + rewrite to_uintD to_uintN modzDmr modz_small //; smt (to_uint_cmp). +qed. + +(* Add simplification rule for rewriting *) +(* FIXME add direction for hint simplify *) +lemma of_intN' (x : int) : - of_int x = of_int (-x). +proof. by rewrite of_intN. qed. + +lemma of_intS (x y : int) : of_int (x - y) = of_int x - of_int y. +proof. by rewrite of_intD of_intN. qed. + +lemma of_intS' (x y : int) : of_int x - of_int y = of_int (x - y). +proof. by rewrite of_intS. qed. + +lemma of_intD' (x y : int) : of_int x + of_int y = of_int (x + y). +proof. by rewrite of_intD. qed. + +lemma of_intM' (x y : int) : of_int x * of_int y = of_int (x * y). +proof. by rewrite of_intM. qed. + +hint simplify (of_intS', of_intM')@0. +hint simplify (of_intD')@1. + +lemma addr0_s w : w + of_int 0 = w. +proof. by apply addr0. qed. + +lemma add0r_s w : of_int 0 + w = w. +proof. by apply add0r. qed. + +lemma mulr1_s w : w * of_int 1 = w. +proof. by apply mulr1. qed. + +lemma mul1r_s w : of_int 1 * w = w. +proof. by apply mul1r. qed. + +lemma mulr0_s w : w * of_int 0 = of_int 0. +proof. by apply mulr0. qed. + +lemma mul0r_s w : of_int 0 * w = of_int 0. +proof. by apply mul0r. qed. + +lemma addA_ofint w i j : w + of_int i + of_int j = w + of_int (i + j). +proof. by rewrite -addrA. qed. + +lemma addS_ofint w i j : w + of_int i - of_int j = w + of_int (i - j). +proof. by rewrite -addrA -of_intS. qed. + +hint simplify (addr0_s, add0r_s, mul1r_s, mulr1_s, mul0r_s, mulr0_s, addA_ofint). + + + +(* --------------------------------------------------------------------- *) +(* Ring tactic *) + +op zerow_ring = of_int 0. +op onew_ring = of_int 1. + +instance ring with t + op rzero = BitWord.zerow_ring + op rone = BitWord.onew_ring + op add = BitWord.( + ) + op opp = BitWord.([-]) + op mul = BitWord.( * ) + op expr = WRingA.exp + op ofint = BitWord.of_int + + proof oner_neq0 by apply oner_neq0 + proof addr0 by apply addr0 + proof addrA by apply addrA + proof addrC by apply addrC + proof addrN by apply addrN + proof mulr1 by apply mulr1 + proof mulrA by apply mulrA + proof mulrC by apply mulrC + proof mulrDl by apply mulrDl + proof expr0 by apply expr0 + proof exprS by apply exprS + proof ofint0 by done + proof ofint1 by done + proof ofintS by apply ofintS + proof ofintN by apply of_intN. + +(* --------------------------------------------------------------------- *) +(* Exact arithmetic operations *) +op subc : t -> t -> bool -> bool * t. +op addc : t -> t -> bool -> bool * t. +op mulu : t -> t -> t * t. + +(* --------------------------------------------------------------------- *) +(* Bitwize operations *) + +abbrev (`&`) = andw. +abbrev (`|`) = orw. +abbrev (`^`) = (+^). + +op (`>>>`) (x : t) (i : int) = + init (fun j => x.[j + i]) +axiomatized by wlsrE. + +op (`<<<`) (x : t) (i : int) = + init (fun j => x.[j - i]) +axiomatized by wlslE. + +lemma shlwE w k i : (w `<<<` k).[i] = (0 <= i < size && w.[i - k]). +proof. by rewrite wlslE initE. qed. + +lemma shrwE w k i : (w `>>>` k).[i] = (0 <= i < size && w.[i + k]). +proof. by rewrite wlsrE initE. qed. +hint simplify (shrwE, shlwE). + +lemma int_bitMP i j k : 0 <= k => 0 <= j < size => + int_bit (i * 2 ^ k) j = (0 <= j - k < size /\ int_bit i (j - k)). +proof. + move=> hk [h0j hjs];rewrite /int_bit modz_pow2_div 1:/# modz_dvd. + + by apply (dvdz_exp2l 2 1) => /#. + case: (0 <= j - k < size) => [ [hjk1 hjk2] | hjk] /=;last first. + + have hlt : (j < k) by smt(). + have ->: k = (k-j-1) + 1 + j by ring. + rewrite -pow_add 1:/# 1:// -mulzA mulzK; 1: smt (gt0_pow2). + by rewrite -pow_add 1:/# //= -mulzA modzMl. + rewrite (modz_pow2_div size) 1:/# modz_dvd. + + by apply (dvdz_exp2l 2 1) => /#. + have {1}-> : j = (j - k) + k by ring. + by rewrite -pow_add 1,2:// divzMpr 1:gt0_pow2. +qed. + +lemma int_bitDP i j k : 0 <= i < modulus => 0 <= k => 0 <= j < size => + int_bit (i %/ 2 ^ k) j = (0 <= j + k < size /\ int_bit i (j + k)). +proof. + move=> hi hk [h0j hjs];rewrite /int_bit. + rewrite !(modz_small _ modulus); 1,2: apply bound_abs; 2:done. + + by apply divz_cmp; [apply gt0_pow2 | smt (gt0_pow2)]. + case: (0 <= j + k < size) => hjk. + + have {1}->:= divz_eq i (2^(j+k)). + have {1}->:= divz_eq (i %% 2 ^ (j + k)) (2^k). + pose id := i %/ 2 ^ (j + k). pose im := i %% 2 ^ (j + k). + have -> : id * 2 ^ (j + k) + (im %/ 2 ^ k * 2 ^ k + im %% 2 ^ k) = + (id * 2^j + im %/ 2 ^ k) * 2^k + im %% 2 ^ k. + + by rewrite -pow_add 1,2://;ring. + rewrite divzMDl. smt (gt0_pow2). + rewrite (divz_small (im %% 2 ^ k) (2 ^ k)). + + apply bound_abs;apply modz_cmp;apply gt0_pow2. + rewrite /= divzMDl. smt (gt0_pow2). + rewrite (divz_small (im %/ 2 ^ k) (2 ^ j)) 2://. + apply bound_abs; apply divz_cmp; 1:by apply gt0_pow2. + by rewrite pow_add 1,2://;apply modz_cmp;apply gt0_pow2. + rewrite /= (divz_small (i %/ 2 ^ k) (2 ^ j)) 2://. + apply bound_abs;apply divz_cmp; 1: by apply gt0_pow2. + rewrite pow_add 1,2://;smt (pow_Mle). +qed. + +lemma shlMP i k : 0 <= k => (of_int i `<<<` k) = of_int (i * 2^k). +proof. + by move=> hk;apply wordP => j hj; rewrite shlwE !of_intwE hj /= -int_bitMP. +qed. + +lemma shrDP i k : 0 <= k => (of_int i `>>>` k) = of_int (i %% modulus %/ 2^k). +proof. + move=> hk;rewrite -(of_int_mod i). + apply wordP => j hj; rewrite shrwE !of_intwE hj /= -int_bitDP //. + by apply modz_cmp. +qed. + +lemma to_uint_shl (w:t) i : + 0 <= i => to_uint (w `<<<` i) = (to_uint w * 2^ i) %% modulus. +proof. + by move=> hi; rewrite -{1}(to_uintK w) shlMP 1:// of_uintK. +qed. + +lemma to_uint_shr (w:t) i : + 0 <= i => to_uint (w `>>>` i) = to_uint w %/ 2^ i. +proof. + move=> hi;rewrite -{1}(to_uintK w) shrDP 1:// of_uintK. + rewrite (modz_small (to_uint w)). + + by apply bound_abs; apply to_uint_cmp. + rewrite modz_small 2://. + apply bound_abs; apply divz_cmp; [apply gt0_pow2 | ]. + smt (to_uint_cmp gt0_pow2). +qed. + +lemma shrw_shlw w i : w `>>>` i = w `<<<` (-i). +proof. by apply wordP => k hk /=. qed. + +lemma shrw_add w i j : 0 <= i => 0 <= j => w `>>>` i `>>>` j = w `>>>` (i + j). +proof. + move=> hi hj; apply wordP => k hk /=;rewrite hk /=. + case : (0 <= k + j < size) => hkj /=; 1:congr;ring. + by rewrite get_out 1:/#. +qed. + +lemma shrw_out w i : size <= i => w `>>>` i = zero. +proof. + by move=> hi;apply wordP => k hk/=; rewrite get_out 1:/#. +qed. +hint simplify (shrw_add, shrw_out). + +lemma shlw_add w i j : 0 <= i => 0 <= j => w `<<<` i `<<<` j = w `<<<` (i + j). +proof. + move=> hi hj; apply wordP => k hk /=;rewrite hk /=. + case : (0 <= k - j < size) => hkj /=; 1:congr;ring. + by rewrite get_out 1:/#. +qed. + +lemma shlw_out w i : size <= i => w `<<<` i = zero. +proof. + by move=> hi;apply wordP => k hk/=; rewrite get_out 1:/#. +qed. +hint simplify (shlw_add, shlw_out). + +lemma shrw_map2 f w1 w2 i : f false false = false => + (map2 f) (w1 `>>>` i) (w2 `>>>` i) = (map2 f w1 w2) `>>>` i. +proof. + move=> hf;apply wordP => k hk. + rewrite map2iE // !shrwE hk. + case: (0 <= k + i < size) => hki; 1: by rewrite map2iE. + by rewrite !get_out. +qed. + +lemma shlw_map2 f w1 w2 i : f false false = false => + (map2 f) (w1 `<<<` i) (w2 `<<<` i) = (map2 f w1 w2) `<<<` i. +proof. + move=> hf;apply wordP => k hk. + rewrite map2iE // !shlwE hk. + case: (0 <= k - i < size) => hki; 1: by rewrite map2iE. + by rewrite !get_out. +qed. + +lemma shrw_and w1 w2 i : (w1 `>>>` i) `&` (w2 `>>>` i) = (w1 `&` w2) `>>>` i. +proof. by rewrite andE shrw_map2. qed. + +lemma shrw_xor w1 w2 i : (w1 `>>>` i) `^` (w2 `>>>` i) = (w1 `^` w2) `>>>` i. +proof. by rewrite xorE shrw_map2. qed. + +lemma shrw_or w1 w2 i : (w1 `>>>` i) `|` (w2 `>>>` i) = (w1 `|` w2) `>>>` i. +proof. by rewrite orE shrw_map2. qed. + +lemma shlw_and w1 w2 i : (w1 `<<<` i) `&` (w2 `<<<` i) = (w1 `&` w2) `<<<` i. +proof. by rewrite andE shlw_map2. qed. + +lemma shlw_xor w1 w2 i : (w1 `<<<` i) `^` (w2 `<<<` i) = (w1 `^` w2) `<<<` i. +proof. by rewrite xorE shlw_map2. qed. + +lemma shlw_or w1 w2 i : (w1 `<<<` i) `|` (w2 `<<<` i) = (w1 `|` w2) `<<<` i. +proof. by rewrite orE shlw_map2. qed. + +hint simplify (shrw_and, shrw_xor, shrw_or, shlw_and, shlw_xor, shlw_or). + +op ror (x : t) (i : int) = + init (fun j => x.[(j + i) %% size]) +axiomatized by rorE. + +op rol (x : t) (i : int) = + init (fun j => x.[(j - i) %% size]) +axiomatized by rolE. + +lemma rorwE w k i : + (ror w k).[i] = if (0 <= i < size) then w.[(i+k) %% size] else false. +proof. by rewrite rorE initE. qed. + +lemma rolwE w k i : + (rol w k).[i] = if (0 <= i < size) then w.[(i-k) %% size] else false. +proof. by rewrite rolE initE. qed. + +hint simplify (rorwE, rolwE). + +lemma rol_xor w i : 0 <= i < size => + rol w i = (w `<<<` i) `^` (w `>>>` (size - i)). +proof. + move=> hi; apply wordP => k hk /=. + rewrite hk /=. + case (0 <= k - i < size) => hki. + + rewrite modz_small; 1: by apply bound_abs. + by rewrite (get_out _ (k + (size - i))) 1:/#. + rewrite modz_sub_carry // 1:/# (get_out _ _ hki) /=. + by congr;ring. +qed. + +lemma rol_xor_simplify w1 w2 i si: + w1 = w2 => si = size - i => 0 <= i < size => + (w1 `<<<` i) `^` (w2 `>>>` si) = rol w1 i. +proof. by move=> 2!-> hi;rewrite rol_xor. qed. + +(* --------------------------------------------------------------------- *) +(* Like between bitwize operations and arithmetic operations *) + +lemma and_mod k w : + 0 <= k => + w `&` of_int (2^k - 1) = of_int (to_uint w %% 2^k). +proof. + move=> hk;apply wordP => i hi /=. + rewrite of_int_powm1 of_intwE hi /= /int_bit. + rewrite (modz_small _ modulus). + + apply bound_abs; smt (le_modz modz_cmp to_uint_cmp gt0_pow2). + case (i < k) => hik /=. + + rewrite modz_pow2_div 1:/# modz_dvd. + + by apply (dvdz_exp2l 2 1) => /#. + by rewrite get_to_uint hi. + rewrite divz_small 2://; smt (gt0_pow2 modz_cmp pow_Mle). +qed. + +lemma to_uint_and_mod k w : + 0 <= k => + to_uint (w `&` of_int (2^k - 1)) = to_uint w %% 2^k. +proof. + move=> hk ; rewrite and_mod 1:// of_uintK modz_small //. + apply bound_abs; smt (le_modz to_uint_cmp gt0_pow2 modz_cmp). +qed. + +end BitWord. + +theory W8. + abbrev [-printing] size = 8. + clone include BitWord with op size <- 8 + proof gt0_size by done. + + op (`>>`) (w1 w2 : W8.t) = w1 `>>>` (to_uint w2 %% size). + op (`<<`) (w1 w2 : W8.t) = w1 `<<<` (to_uint w2 %% size). + + lemma shr_div w1 w2 : to_uint (w1 `>>` w2) = to_uint w1 %/ 2^ (to_uint w2 %% size). + proof. + rewrite -{1}(to_uintK w1) /(`>>`) shrDP; 1: smt (modz_cmp). + rewrite of_uintK to_uint_mod modz_small 2://. + apply bound_abs; apply divz_cmp; 1: by apply gt0_pow2. + by have:= to_uint_cmp w1; smt (gt0_pow2). + qed. + + lemma shr_div_le w1 i : 0 <= i < size => + to_uint (w1 `>>` (of_int i)) = to_uint w1 %/ 2^i. + proof. + move=> hi;rewrite shr_div of_uintK. + rewrite (modz_small i);1: smt (pow2_8). + by rewrite modz_small. + qed. + + lemma rol_xor_shft w i : 0 < i < size => + rol w i = (w `<<` of_int i) +^ (w `>>` of_int (size - i)). + proof. + move=> hi; rewrite /(`<<`) /(`>>`) !of_uintK /=. + by rewrite !(modz_small _ 256) 1,2:/# !modz_small 1,2:/# rol_xor 1:/#. + qed. +end W8. export W8. + +abstract theory WT. + type t. + op size : int. + axiom gt0_size : 0 < size. + + op "_.[_]" : t -> int -> bool. + op init : (int -> bool) -> t. + + op andw : t -> t -> t. + op orw : t -> t -> t. + op (+^) : t -> t -> t. + + op (+) : t -> t -> t. + + op (`>>`) : t -> W8.t -> t. + op (`<<`) : t -> W8.t -> t. + op rol : t -> int -> t. + op of_int : int -> t. + op to_uint : t -> int. + op to_sint : t -> int. + + op bits : t -> int -> int -> bool list. + + axiom initiE (f : int -> bool) (i : int) : 0 <= i < size => (init f).[i] = f i. + + axiom andwE (w1 w2 : t) (i : int) : (andw w1 w2).[i] = (w1.[i] /\ w2.[i]). + axiom orwE (w1 w2 : t) (i : int) : (orw w1 w2).[i] = (w1.[i] \/ w2.[i]). + axiom xorwE (w1 w2 : t) (i : int) : (w1 +^ w2).[i] = (w1.[i] ^^ w2.[i]). + + axiom wordP (w1 w2 : t) : + w1 = w2 <=> forall (i : int), 0 <= i < size => w1.[i] = w2.[i]. + + axiom to_uint_cmp (x : t) : 0 <= to_uint x < 2^size. + + op int_bit x i = (x%%2^size) %/ 2 ^ i %% 2 <> 0. + + axiom of_intwE x i : + (of_int x).[i] = (0 <= i < size /\ int_bit x i). + + axiom get_to_uint w i : w.[i] = (0 <= i < size /\ to_uint w %/ 2 ^ i %% 2 <> 0). + + axiom bitsE w k len : bits w k len = mkseq (fun (i:int) => w.[k+i]) len. + + axiom bits_divmod w i j: 0 <= i => 0 <= j => + bs2int (bits w i j) = ((to_uint w) %/ 2^i) %% 2^j. + + axiom to_uintRL (w:t) (x:int) : to_uint w = x %% 2^size => w = of_int x. + + axiom to_uint_bits w : to_uint w = bs2int (bits w 0 size). + + axiom of_uintK (x : int) : to_uint (of_int x) = x %% 2^size. + + axiom to_uintK : cancel to_uint of_int. + + axiom of_int_mod (x : int) : of_int (x %% 2^size) = of_int x. + + axiom and_mod k w : + 0 <= k => + andw w (of_int (2^k - 1)) = of_int (to_uint w %% 2^k). + + axiom rol_xor_shft w i : 0 < i < size => + rol w i = (w `<<` W8.of_int i) +^ (w `>>` W8.of_int (size - i)). + +end WT. + +abstract theory W_WS. + + op sizeS : int. + op sizeB : int. + op r : int. + axiom gt0_r : 0 < r. + axiom sizeBrS : sizeB = r * sizeS. + + clone import WT as WS with op size <- sizeS. + clone import WT as WB with op size <- sizeB. + + clone export MonoArray as Pack with + type elem <- WS.t, + op dfl <- WS.of_int 0, + op size <- r + proof ge0_size by smt (gt0_r) + rename [type] "t" as "pack_t" + [lemma] "tP" as "packP". + + hint simplify Pack.map_to_list@1. + hint simplify Pack.map2_to_list@1. + + lemma le_size : sizeS <= sizeB. + proof. rewrite sizeBrS;smt (gt0_r WS.gt0_size WB.gt0_size). qed. + + lemma in_bound i j : 0 <= i < r => 0 <= j < sizeS => 0 <= i * sizeS + j < sizeB. + proof. + move=> hi hj;rewrite sizeBrS;have : i * sizeS + j < (i+1) * sizeS; smt (). + qed. + + (* ------------------------------------------------ *) + + op sigextu'B (w:WS.t) = WB.of_int (WS.to_sint w). + op zeroextu'B (w:WS.t) = WB.of_int (WS.to_uint w). + op truncateu'S (w:WB.t) = WS.of_int (WB.to_uint w). + + hint exact : WS.gt0_size WB.gt0_size. + + lemma size_div : sizeS %| sizeB. + proof. by rewrite dvdzP sizeBrS;exists r. qed. + + lemma div_size : sizeB %/ sizeS = r. + proof. rewrite sizeBrS mulzK; smt (WS.gt0_size). qed. + + op (\bits'S) (w:WB.t) i = WS.init (fun j => w.[ i * sizeS + j]) + axiomatized by bits'SE. + + op unpack'S (w:WB.t) : pack_t = + Pack.init (fun i => w \bits'S i). + + abbrev to_list (w:WB.t) : WS.t list = Pack.to_list (unpack'S w). + + op pack'R_t (ws:pack_t) = + WB.init (fun i => ws.[i %/ sizeS].[i %% sizeS]) + axiomatized by pack'RE. + + abbrev pack'R (ws:WS.t list) = pack'R_t (Pack.of_list ws). + + lemma pack'RwE (ws:pack_t) i : 0 <= i < sizeB => + (pack'R_t ws).[i] = ws.[i %/ sizeS].[i %% sizeS]. + proof. by move=> hi;rewrite pack'RE initiE //. qed. + + lemma get_unpack'S w i : 0 <= i < r => + (unpack'S w).[i] = w \bits'S i. + proof. apply initiE. qed. + + lemma bits'SiE w i j : 0 <= j < sizeS => + (w \bits'S i).[j] = w.[i * sizeS + j]. + proof. by move=> hj; rewrite bits'SE initiE. qed. + + lemma get_bits'S (w:WB.t) i : + 0 <= i < sizeB => + w.[i] = (w \bits'S (i%/ sizeS)).[i %% sizeS]. + proof. + by move=> hi; rewrite bits'SE WS.initiE /= -?divz_eq; 1:by apply modz_cmp. + qed. + + lemma get_out (w:WB.t) i : + !(0 <= i < r) => + w \bits'S i = WS.of_int 0. + proof. + move=> hi;apply WS.wordP => k hk. + rewrite bits'SiE 1:// WS.of_intwE /WS.int_bit /= get_to_uint. + smt(gt0_r WS.gt0_size sizeBrS). + qed. + + lemma get_zero i : WB.of_int 0 \bits'S i = WS.of_int 0. + proof. + apply WS.wordP => k hk. + by rewrite bits'SiE 1:// WS.of_intwE /WS.int_bit /= get_to_uint /= WB.of_uintK. + qed. + + lemma unpack'SK w : pack'R_t (unpack'S w) = w. + proof. + apply wordP => i hi; rewrite pack'RE initiE //= get_bits'S //. + by rewrite get_unpack'S //;apply divz_cmp => //;rewrite -sizeBrS. + qed. + + lemma pack'RbE ws i : 0 <= i < r => pack'R_t ws \bits'S i = ws.[i]. + proof. + move=> hr;apply WS.wordP => j hj. + rewrite bits'SiE // pack'RE initiE /= ?in_bound //. + by rewrite modzMDl divzMDl 1:/# divz_small ?modz_small; solve. + qed. + + lemma pack'RK ws : unpack'S (pack'R_t ws) = ws. + proof. by apply packP => i hi; rewrite get_unpack'S // pack'RbE. qed. + + lemma wordP (w1 w2 :WB.t) : (forall i, 0 <= i < r => w1 \bits'S i = w2 \bits'S i) => w1 = w2. + proof. + move=> h; rewrite -(unpack'SK w1) -(unpack'SK w2); congr. + by apply Pack.packP => i hi; rewrite !get_unpack'S 1,2://; apply h. + qed. + + lemma allP (w1 w2 :WB.t) : all (fun i => w1 \bits'S i = w2 \bits'S i) (iota_ 0 r) => w1 = w2. + proof. rewrite allP => h; apply wordP => i; rewrite -(mema_iota 0 r); apply h. qed. + + abbrev map (f:WS.t -> WS.t) (w:WB.t) = + pack'R_t (map f (unpack'S w)). + + abbrev map2 (f:WS.t -> WS.t -> WS.t) (w1 w2:WB.t) = + pack'R_t (map2 f (unpack'S w1) (unpack'S w2)). + + lemma mapbE f w i : 0 <= i < r => + (map f w) \bits'S i = f (w \bits'S i). + proof. + by move=> hi;rewrite pack'RbE // mapiE // initiE. + qed. + + lemma map2bE f w1 w2 i : 0 <= i < r => + (map2 f w1 w2) \bits'S i = f (w1 \bits'S i) (w2 \bits'S i). + proof. + by move=> hi;rewrite pack'RbE // map2iE // !initiE. + qed. + + lemma andb'SE (w1 w2:WB.t) i : + (WB.andw w1 w2) \bits'S i = WS.andw (w1 \bits'S i) (w2 \bits'S i). + proof. + apply WS.wordP => j hj. + by rewrite bits'SiE // WB.andwE WS.andwE !bits'SiE. + qed. + + lemma orb'SE (w1 w2:WB.t) i : + (WB.orw w1 w2) \bits'S i = WS.orw (w1 \bits'S i) (w2 \bits'S i). + proof. + apply WS.wordP => j hj. + by rewrite bits'SiE // WB.orwE WS.orwE !bits'SiE. + qed. + + lemma xorb'SE (w1 w2:WB.t) i : + (WB.(+^) w1 w2) \bits'S i = WS.(+^) (w1 \bits'S i) (w2 \bits'S i). + proof. + apply WS.wordP => j hj. + by rewrite bits'SiE // WB.xorwE WS.xorwE !bits'SiE. + qed. + + lemma andb'Ru'SE ws1 ws2 : + WB.andw (pack'R_t ws1) (pack'R_t ws2) = pack'R_t (map2 WS.andw ws1 ws2). + proof. + apply (canRL _ _ _ _ unpack'SK); apply packP => i hi. + by rewrite get_unpack'S // map2iE // andb'SE // !pack'RbE. + qed. + + lemma orb'Ru'SE ws1 ws2 : + WB.orw (pack'R_t ws1) (pack'R_t ws2) = pack'R_t (map2 WS.orw ws1 ws2). + proof. + apply (canRL _ _ _ _ unpack'SK); apply packP => i hi. + by rewrite get_unpack'S // map2iE // orb'SE // !pack'RbE. + qed. + + lemma xorb'Ru'SE ws1 ws2 : + WB.(+^) (pack'R_t ws1) (pack'R_t ws2) = pack'R_t (map2 WS.(+^) ws1 ws2). + proof. + apply (canRL _ _ _ _ unpack'SK); apply packP => i hi. + by rewrite get_unpack'S // map2iE // xorb'SE // !pack'RbE. + qed. + + lemma bits'S_div (w:WB.t) i : 0 <= i => + w \bits'S i = WS.of_int (WB.to_uint w %/ (2^(sizeS*i))). + proof. + move=> hi;apply WS.to_uintRL;rewrite -bits_divmod. + + smt (WS.gt0_size). smt (WS.gt0_size). + rewrite to_uint_bits; congr; rewrite WS.bitsE WB.bitsE; apply eq_in_mkseq. + by move=> k hk /=;rewrite bits'SiE 1:// mulzC. + qed. + + lemma of_int_bits'S_div w i : 0 <= i < r => + (WB.of_int w) \bits'S i = WS.of_int (w %/ (2^(sizeS*i))). + proof. + move=> [h0i hir];rewrite bits'S_div //. + rewrite WB.of_uintK modz_pow2_div. + + by rewrite sizeBrS mulzC; apply cmpW; apply mulz_cmp_r. + rewrite -WS.of_int_mod modz_mod_pow2 /min. + have -> /= : !sizeB - sizeS * i < sizeS. + + rewrite sizeBrS. + have -> : r * sizeS - sizeS * i = sizeS * (r - i) by ring. + by rewrite -lezNgt;apply ler_pemulr;[ apply ltzW | smt ()]. + by rewrite WS.of_int_mod. + qed. + + lemma of_int_bits'S_div_red (w i:int) : 0 <= i < r => + 0 <= `|w| => (* Do not remove this condition, it is used to block reduction *) + (WB.of_int w) \bits'S i = WS.of_int (w %/ (2^(sizeS*i))). + proof. by move=> hi hw;apply of_int_bits'S_div. qed. + + hint simplify (pack'RwE, bits'SiE, pack'RbE, get_unpack'S, unpack'SK, pack'RK, + mapbE, map2bE, andb'SE, orb'SE, xorb'SE, + andb'Ru'SE, orb'Ru'SE, xorb'Ru'SE, of_int_bits'S_div_red). + + lemma to_uint_zeroextu'B (w:WS.t) : + WB.to_uint (zeroextu'B w) = WS.to_uint w. + proof. + rewrite /zeroextu'B WB.of_uintK modz_small //. + apply bound_abs;have [h1 h2] := WS.to_uint_cmp w;split => // ?. + apply: (ltr_le_trans (2^sizeS)) => //. + apply pow_Mle;smt (le_size WS.gt0_size). + qed. + + lemma zeroextu'B_bit (w:WS.t) i: (zeroextu'B w).[i] = ((0 <= i < sizeS) /\ w.[i]). + proof. + rewrite /zeroextu'B WB.of_intwE /WB.int_bit (modz_small (to_uint w)). + + smt(gt0_r WS.gt0_size sizeBrS pow_Mle WS.to_uint_cmp). + have -> := WS.get_to_uint w i. + case: (0 <= i < sizeS) => hi /=;1: smt(gt0_r WS.gt0_size sizeBrS). + have [ /#| h]: (i < 0 \/ sizeS <= i) by smt(). + rewrite divz_small 2://. + smt(gt0_r WS.gt0_size sizeBrS pow_Mle WS.to_uint_cmp). + qed. + + lemma to_uint_truncateu'S (w:WB.t) : + WS.to_uint (truncateu'S w) = WB.to_uint w %% 2 ^ sizeS. + proof. by rewrite /truncateu'S WS.of_uintK. qed. + + lemma zeroext_truncateu'S_and (w:WB.t) : + zeroextu'B (truncateu'S w) = andw w (WB.of_int (2^sizeS - 1)). + proof. + rewrite WB.and_mod; 1: smt (le_size WS.gt0_size). + rewrite -(WB.to_uintK (zeroextu'B (truncateu'S w))). + by rewrite to_uint_zeroextu'B to_uint_truncateu'S. + qed. + + lemma of_uint_pack'R i : + (WB.of_int i) = + pack'R (map (fun k => WS.of_int ((i %/ 2^(sizeS * k)) %% 2^sizeS)) (iota_ 0 r)). + proof. + rewrite -(unpack'SK (WB.of_int i)) /unpack'S Pack.init_of_list. + do 2! congr; apply (eq_from_nth (WS.of_int 0)) => [ | k]; rewrite !size_map //. + move=> hk;rewrite !(nth_map 0) //=. + move: hk;rewrite size_iota /max gt0_r /= => hk;rewrite !nth_iota //=. + case: hk => hk1 hk2;rewrite bits'S_div //. + rewrite WB.of_uintK -(WS.of_int_mod (i %% 2 ^ sizeB %/ 2 ^ (sizeS * k))). + congr;rewrite modz_pow2_div 1://. + + by rewrite sizeBrS; smt (WS.gt0_size). + rewrite modz_dvd 2://;apply dvdz_exp2l. + rewrite sizeBrS (_: r * sizeS - sizeS * k = sizeS * (r - k)); 1: by ring. + split; 1: smt (WS.gt0_size). + by move=> ?;apply ler_pemulr => // /#. + qed. + + op x86_VPADD_'Ru'S (w1 : WB.t) (w2:WB.t) = + map2 WS.(+) w1 w2. + +(* op x86_VPSUB_'Ru'S (w1 : WB.t) (w2:WB.t) = + map2 (fun (x y:WS.t) => x - y) w1 w2. + + op x86_VPMUL_'Ru'S (w1 : WB.t) (w2:WB.t) = + map2 WS.( * ) w1 w2. *) + + op x86_VPSLL_'Ru'S (w : WB.t) (cnt : W8.t) = + map (fun (w:WS.t) => w `<<` cnt) w. + + op x86_VPSRL_'Ru'S (w : WB.t) (cnt : W8.t) = + map (fun (w:WS.t) => w `>>` cnt) w. + + op x86_VPBROADCAST_'Ru'S (w: WS.t) = + pack'R (map (fun i => w) (iota_ 0 r)). + + lemma x86_'Ru'S_rol_xor i w : 0 < i < sizeS => + x86_VPSLL_'Ru'S w (W8.of_int i) +^ x86_VPSRL_'Ru'S w (W8.of_int (sizeS - i)) = + map (fun w0 => WS.rol w0 i) w. + proof. + move=> hr;rewrite /x86_VPSRL_'Ru'S /x86_VPSLL_'Ru'S. + rewrite /map;apply wordP => j hj. + by rewrite xorb'SE !pack'RbE 1..3:// !mapiE 1..3:// /= rol_xor_shft. + qed. + + lemma x86_'Ru'S_rol_xor_red w1 w2 i si: + w1 = w2 => W8.to_uint si = sizeS - W8.to_uint i => 0 < W8.to_uint i < sizeS => + x86_VPSLL_'Ru'S w1 i +^ x86_VPSRL_'Ru'S w2 si = + map (fun w0 => WS.rol w0 (W8.to_uint i)) w1. + proof. + by move=> -> hsi hi; rewrite -(W8.to_uintK i) -(W8.to_uintK si) hsi x86_'Ru'S_rol_xor. + qed. + + hint simplify x86_'Ru'S_rol_xor_red. + +end W_WS. + +abstract theory BitWordSH. + op size : int. + axiom size_le_256 : size <= 256. + clone include BitWord with op size <- size. + + op (`>>`) (w1 : t) (w2 : W8.t) = w1 `>>>` (to_uint w2 %% size). + op (`<<`) (w1 : t) (w2 : W8.t) = w1 `<<<` (to_uint w2 %% size). + + lemma shr_div w1 w2 : to_uint (w1 `>>` w2) = to_uint w1 %/ 2^ (to_uint w2 %% size). + proof. + rewrite -{1}(to_uintK w1) /(`>>`) shrDP; 1: smt (modz_cmp gt0_size). + rewrite of_uintK to_uint_mod modz_small 2://. + apply bound_abs; apply divz_cmp; 1: by apply gt0_pow2. + by have:= to_uint_cmp w1; smt (gt0_pow2). + qed. + + lemma shr_div_le w1 i : 0 <= i < size => + to_uint (w1 `>>` (W8.of_int i)) = to_uint w1 %/ 2^ i. + proof. + move=> hi;rewrite shr_div of_uintK. + rewrite (modz_small i) 1:pow2_8; 1: smt (size_le_256). + by rewrite modz_small //;apply bound_abs. + qed. + + lemma rol_xor_shft w i : 0 < i < size => + rol w i = (w `<<` W8.of_int i) +^ (w `>>` W8.of_int (size - i)). + proof. + move=> hi; rewrite /(`<<`) /(`>>`) !W8.of_uintK. + have h : 0 <= i < `|W8.modulus|. + + by rewrite /=; smt (size_le_256). + rewrite !(modz_small _ W8.modulus) 1:// 1:[smt (size_le_256)] !modz_small 1,2:/#. + by rewrite rol_xor 1:/#. + qed. + +end BitWordSH. + +theory W16. + abbrev [-printing] size = 16. + clone include BitWordSH with op size <- size + proof gt0_size by done, + size_le_256 by done. +end W16. export W16. + +clone export W_WS as W2u8 with + op sizeS <- W8.size, op sizeB <- W16.size, op r <- 2, + theory WS <- W8, theory WB <- W16 + proof gt0_r by done, sizeBrS by done + rename [op, lemma] "'Ru'S" as "2u8" "'R" as "2" "'S" as "8" "'B" as "16" . + +theory W32. + abbrev [-printing] size = 32. + clone include BitWordSH with op size <- size + proof gt0_size by done, + size_le_256 by done. +end W32. export W32. + +clone export W_WS as W4u8 with + op sizeS <- W8.size, op sizeB <- W32.size, op r <- 4, + theory WS <- W8, theory WB <- W32 + proof gt0_r by done, sizeBrS by done + rename [op, lemma] "'Ru'S" as "4u8" "'R" as "4" "'S" as "8" "'B" as "32". + +clone export W_WS as W2u16 with + op sizeS <- W16.size, op sizeB <- W32.size, op r <- 2, + theory WS <- W16, theory WB <- W32 + proof gt0_r by done, sizeBrS by done + rename [op, lemma] "'Ru'S" as "2u16" "'R" as "2" "'S" as "16" "'B" as "32". + +theory W64. + abbrev [-printing] size = 64. + clone include BitWordSH with op size <- size + proof gt0_size by done, + size_le_256 by done. +end W64. export W64. + +clone export W_WS as W8u8 with + op sizeS <- W8.size, op sizeB <- W64.size, op r <- 8, + theory WS <- W8, theory WB <- W64 + proof gt0_r by done, sizeBrS by done + rename [op, lemma] "'Ru'S" as "8u8" "'R" as "8" "'S" as "8" "'B" as "64". + +clone export W_WS as W4u16 with + op sizeS <- W16.size, op sizeB <- W64.size, op r <- 4, + theory WS <- W16, theory WB <- W64 + proof gt0_r by done, sizeBrS by done + rename [op, lemma] "'Ru'S" as "4u16" "'R" as "4" "'S" as "16" "'B" as "64". + +clone export W_WS as W2u32 with + op sizeS <- W32.size, op sizeB <- W64.size, op r <- 2, + theory WS <- W32, theory WB <- W64 + proof gt0_r by done, sizeBrS by done + rename [op, lemma] "'Ru'S" as "2u32" "'R" as "2" "'S" as "32" "'B" as "64". + +theory W128. + abbrev [-printing] size = 128. + clone include BitWordSH with op size <- size + proof gt0_size by done, + size_le_256 by done. +end W128. export W128. + +clone export W_WS as W16u8 with + op sizeS <- W8.size, op sizeB <- W128.size, op r <- 16, + theory WS <- W8, theory WB <- W128 + proof gt0_r by done, sizeBrS by done + rename [op, lemma] "'Ru'S" as "16u8" "'R" as "16" "'S" as "8" "'B" as "128". + +clone export W_WS as W8u16 with + op sizeS <- W16.size, op sizeB <- W128.size, op r <- 8, + theory WS <- W16, theory WB <- W128 + proof gt0_r by done, sizeBrS by done + rename [op, lemma] "'Ru'S" as "8u16" "'R" as "8" "'S" as "16" "'B" as "128". + +clone export W_WS as W4u32 with + op sizeS <- W32.size, op sizeB <- W128.size, op r <- 4, + theory WS <- W32, theory WB <- W128 + proof gt0_r by done, sizeBrS by done + rename [op, lemma] "'Ru'S" as "4u32" "'R" as "4" "'S" as "32" "'B" as "128". + +clone export W_WS as W2u64 with + op sizeS <- W64.size, op sizeB <- W128.size, op r <- 2, + theory WS <- W64, theory WB <- W128 + proof gt0_r by done, sizeBrS by done + rename [op, lemma] "'Ru'S" as "2u64" "'R" as "2" "'S" as "64" "'B" as "128". + +theory W256. + abbrev [-printing] size = 256. + clone include BitWordSH with op size <- size + proof gt0_size by done, + size_le_256 by done. +end W256. export W256. + +clone export W_WS as W32u8 with + op sizeS <- W8.size, op sizeB <- W256.size, op r <- 32, + theory WS <- W8, theory WB <- W256 + proof gt0_r by done, sizeBrS by done + rename [op, lemma] "'Ru'S" as "32u8" "'R" as "32" "'S" as "8" "'B" as "256". + +clone export W_WS as W16u16 with + op sizeS <- W16.size, op sizeB <- W256.size, op r <- 16, + theory WS <- W16, theory WB <- W256 + proof gt0_r by done, sizeBrS by done + rename [op, lemma] "'Ru'S" as "16u16" "'R" as "16" "'S" as "16" "'B" as "256". + +clone export W_WS as W8u32 with + op sizeS <- W32.size, op sizeB <- W256.size, op r <- 8, + theory WS <- W32, theory WB <- W256 + proof gt0_r by done, sizeBrS by done + rename [op, lemma] "'Ru'S" as "8u32" "'R" as "8" "'S" as "32" "'B" as "256". + +clone export W_WS as W4u64 with + op sizeS <- W64.size, op sizeB <- W256.size, op r <- 4, + theory WS <- W64, theory WB <- W256 + proof gt0_r by done, sizeBrS by done + rename [op, lemma] "'Ru'S" as "4u64" "'R" as "4" "'S" as "64" "'B" as "256". + +clone export W_WS as W2u128 with + op sizeS <- W128.size, op sizeB <- W256.size, op r <- 2, + theory WS <- W128, theory WB <- W256 + proof gt0_r by done, sizeBrS by done + rename [op, lemma] "'Ru'S" as "2u128" "'R" as "2" "'S" as "128" "'B" as "256". + + +(* -------------------------------------------------------------------- *) +(* Word size *) + +type wsize = [ + | W8 + | W16 + | W32 + | W64 + | W128 + | W256 +]. + +op wsize_i (w:wsize) = + with w = W8 => 1 + with w = W16 => 2 + with w = W32 => 4 + with w = W64 => 8 + with w = W128 => 16 + with w = W256 => 32. + +(* TODO move *) +lemma gt0_wsize_i ws: 0 < wsize_i ws. +proof. by case ws. qed. +hint exact : gt0_wsize_i. + +lemma div_le_wsize ws1 ws2 : wsize_i ws1 <= wsize_i ws2 => wsize_i ws1 %| wsize_i ws2. +proof. by case: ws1 ws2 => -[]. qed. + +lemma div_wsize_modulus ws : wsize_i ws %| W64.modulus. +proof. by case ws. qed. +hint exact : div_wsize_modulus. + +(* +lemma foo (x y:W128.t) (x1 x2 y1 y2:W64.t): + x = pack2 [x1; x2] => + y = pack2 [y1; y2] => + map2 W64.( + ) x y = pack2 [x1 + y1; x2 + y2]. +proof. by move=> -> -> /=. qed. + +op bits_eq (w:W128.t) xs = + all (fun (ix:int * W64.t) => w \bits64 ix.`1 = ix.`2) + (zip (iota_ 0 (size xs)) xs). + +lemma foo1 (x y:W128.t) (x0 x1 y0 y1:W64.t): + (bits_eq x [x0; x1]) => + (bits_eq y [y0; y1]) => + (bits_eq (map2 W64.( + ) x y) [x0 + y0; x1 + y1]). +proof. rewrite /bits_eq /= => />. qed. + +lemma foo (x y:W128.t) (x1 x2 y1 y2:W64.t): + x = pack2 [x1; x2] => + y = pack2 [y1; y2] => + x `|` y = pack2 [x1 `|` y1; x2 `|` y2]. +proof. move=> -> -> /=. +*) + +lemma divmod_mul n d i j : + 0 < n => + 0 <= j < d => + (i * d + j) %/ (n * d) = i%/ n /\ (i * d + j) %% (n * d) = i %% n * d + j. +proof. + move=> hn hj. + have -> : i * d + j = (i %/ n) * (n * d) + (d * (i %% n) + j). + + have [h1 h2]:= edivzP i n. + by rewrite {1 2} h1 divzMDl 1:/# (divz_small (i%%n) n) 1:/# /=; ring. + rewrite divzMDl 1:/# modzMDl. + have hb: 0 <= d * (i %% n) + j < `|n * d|. + + have := modz_cmp i n hn. + have -> : `|n * d| = n * d by smt(). + have -> h : n * d = (n-1) * d + d by ring. + split;1: smt(); move=> ?. + apply ler_lt_add; 2:smt(). + by rewrite mulzC ler_pmul2r /#. + by rewrite (divz_small _ (n*d)) 1:// (modz_small _ (n*d)) 1:// /=; ring. +qed. + +(* --------------------------------------------------------------------------------- *) +(* Lemmas on \bits8 *) +(* --------------------------------------------------------------------------------- *) + +lemma bits8_W2u16 ws i : + W2u16.pack2_t ws \bits8 i = if 0 <= i < 4 then ws.[i%/2] \bits8 (i%%2) else W8.zero. +proof. + apply W8.wordP => j hj; rewrite !bits8iE 1,2://. + case: (0 <= i < 4) => /= hi; last by rewrite W32.get_out 1:/#. + rewrite pack2wE 1:/#; have /= [-> ->] := divmod_mul 2 8 i j _ hj; 1 :done; rewrite W2u8.bits8iE 1:// /#. +qed. + +lemma bits8_W2u16_red ws i : + 0 <= i < 4 => W2u16.pack2_t ws \bits8 i = ws.[i%/2] \bits8 (i%%2). +proof. by move=> h;rewrite bits8_W2u16 h. qed. + +lemma bits8_W4u16 ws i : + W4u16.pack4_t ws \bits8 i = if 0 <= i < 8 then ws.[i%/2] \bits8 (i%%2) else W8.zero. +proof. + apply W8.wordP => j hj; rewrite !bits8iE 1,2://. + case: (0 <= i < 8) => /= hi; last by rewrite W64.get_out 1:/#. + rewrite pack4wE 1:/#; have /= [-> ->] := divmod_mul 2 8 i j _ hj; 1:done; rewrite W2u8.bits8iE 1:// /#. +qed. + +lemma bits8_W4u16_red ws i : + 0 <= i < 8 => W4u16.pack4_t ws \bits8 i = ws.[i%/2] \bits8 (i%%2). +proof. by move=> h;rewrite bits8_W4u16 h. qed. + +lemma bits8_W8u16 ws i : + W8u16.pack8_t ws \bits8 i = if 0 <= i < 16 then ws.[i%/2] \bits8 (i%%2) else W8.zero. +proof. + apply W8.wordP => j hj; rewrite !bits8iE 1,2://. + case: (0 <= i < 16) => /= hi; last by rewrite W128.get_out 1:/#. + rewrite pack8wE 1:/#; have [-> ->] := divmod_mul 2 8 i j _ hj; 1: done; rewrite W2u8.bits8iE 1:// /#. +qed. + +lemma bits8_W8u16_red ws i : + 0 <= i < 16 => W8u16.pack8_t ws \bits8 i = ws.[i%/2] \bits8 (i%%2). +proof. by move=> h;rewrite bits8_W8u16 h. qed. + +lemma bits8_W16u16 ws i : + W16u16.pack16_t ws \bits8 i = if 0 <= i < 32 then ws.[i%/2] \bits8 (i%%2) else W8.zero. +proof. + apply W8.wordP => j hj; rewrite !bits8iE 1,2://. + case: (0 <= i < 32) => /= hi; last by rewrite W256.get_out 1:/#. + rewrite pack16wE 1:/#; have [-> ->] := divmod_mul 2 8 i j _ hj; 1: done; rewrite W2u8.bits8iE 1:// /#. +qed. + +lemma bits8_W16u16_red ws i : + 0 <= i < 32 => W16u16.pack16_t ws \bits8 i = ws.[i%/2] \bits8 (i%%2). +proof. by move=> h;rewrite bits8_W16u16 h. qed. + +hint simplify bits8_W2u16_red, bits8_W4u16_red, bits8_W8u16_red, bits8_W16u16_red. + +lemma bits8_W2u32 ws i : + W2u32.pack2_t ws \bits8 i = if 0 <= i < 8 then ws.[i%/4] \bits8 (i%%4) else W8.zero. +proof. + apply W8.wordP => j hj; rewrite !bits8iE 1,2://. + case: (0 <= i < 8) => /= hi; last by rewrite W64.get_out 1:/#. + rewrite pack2wE 1:/#; have /= [-> ->] := divmod_mul 4 8 i j _ hj; 1: done; rewrite W4u8.bits8iE 1:// /#. +qed. + +lemma bits8_W2u32_red ws i : + 0 <= i < 8 => W2u32.pack2_t ws \bits8 i = ws.[i%/4] \bits8 (i%%4). +proof. by move=> h;rewrite bits8_W2u32 h. qed. + +lemma bits8_W4u32 ws i : + W4u32.pack4_t ws \bits8 i = if 0 <= i < 16 then ws.[i%/4] \bits8 (i%%4) else W8.zero. +proof. + apply W8.wordP => j hj; rewrite !bits8iE 1,2://. + case: (0 <= i < 16) => /= hi; last by rewrite W128.get_out 1:/#. + rewrite pack4wE 1:/#; have /= [-> ->] := divmod_mul 4 8 i j _ hj; 1: done; rewrite W4u8.bits8iE 1:// /#. +qed. + +lemma bits8_W4u32_red ws i : + 0 <= i < 16 => W4u32.pack4_t ws \bits8 i = ws.[i%/4] \bits8 (i%%4). +proof. by move=> h;rewrite bits8_W4u32 h. qed. + +lemma bits8_W8u32 ws i : + W8u32.pack8_t ws \bits8 i = if 0 <= i < 32 then ws.[i%/4] \bits8 (i%%4) else W8.zero. +proof. + apply W8.wordP => j hj; rewrite !bits8iE 1,2://. + case: (0 <= i < 32) => /= hi; last by rewrite W256.get_out 1:/#. + rewrite pack8wE 1:/#; have /= [-> ->] := divmod_mul 4 8 i j _ hj; 1: done; rewrite W4u8.bits8iE 1:// /#. +qed. + +lemma bits8_W8u32_red ws i : + 0 <= i < 32 => W8u32.pack8_t ws \bits8 i = ws.[i%/4] \bits8 (i%%4). +proof. by move=> h;rewrite bits8_W8u32 h. qed. + +hint simplify bits8_W2u32_red, bits8_W4u32_red, bits8_W8u32_red. + +lemma bits8_W2u64 ws i : + W2u64.pack2_t ws \bits8 i = if 0 <= i < 16 then ws.[i%/8] \bits8 (i%%8) else W8.zero. +proof. + apply W8.wordP => j hj; rewrite !bits8iE 1,2://. + case: (0 <= i < 16) => /= hi; last by rewrite W128.get_out 1:/#. + rewrite pack2wE 1:/#; have /= [-> ->] := divmod_mul 8 8 i j _ hj; 1: done; rewrite W8u8.bits8iE 1:// /#. +qed. + +lemma bits8_W2u64_red ws i : + 0 <= i < 16 => W2u64.pack2_t ws \bits8 i = ws.[i%/8] \bits8 (i%%8). +proof. by move=> h;rewrite bits8_W2u64 h. qed. + +lemma bits8_W4u64 ws i : + W4u64.pack4_t ws \bits8 i = if 0 <= i < 32 then ws.[i%/8] \bits8 (i%%8) else W8.zero. +proof. + apply W8.wordP => j hj; rewrite !bits8iE 1,2://. + case: (0 <= i < 32) => /= hi; last by rewrite W256.get_out 1:/#. + rewrite pack4wE 1:/#; have /= [-> ->] := divmod_mul 8 8 i j _ hj; 1: done; rewrite W8u8.bits8iE 1:// /#. +qed. + +lemma bits8_W4u64_red ws i : + 0 <= i < 32 => W4u64.pack4_t ws \bits8 i = ws.[i%/8] \bits8 (i%%8). +proof. by move=> h;rewrite bits8_W4u64 h. qed. + +hint simplify bits8_W2u64_red, bits8_W4u64_red. + +lemma bits8_W2u128 ws i : + W2u128.pack2_t ws \bits8 i = if 0 <= i < 32 then ws.[i%/16] \bits8 (i%%16) else W8.zero. +proof. + apply W8.wordP => j hj; rewrite !bits8iE 1,2://. + case: (0 <= i < 32) => /= hi; last by rewrite W256.get_out 1:/#. + rewrite pack2wE 1:/#; have /= [-> ->] := divmod_mul 16 8 i j _ hj; 1: done; rewrite W16u8.bits8iE 1:// /#. +qed. + +lemma bits8_W2u128_red ws i : + 0 <= i < 32 => W2u128.pack2_t ws \bits8 i = ws.[i%/16] \bits8 (i%%16). +proof. by move=> h;rewrite bits8_W2u128 h. qed. + +hint simplify bits8_W2u128_red. + +lemma W32_bits16_bits8 (w:W32.t) i j: 0 <= j < 2 => w \bits16 i \bits8 j = w \bits8 (2 * i + j). +proof. + move=> hj; apply W8.wordP => k hk. + by rewrite !bits8iE 1,2:// bits16iE 1:/#; congr; ring. +qed. + +lemma W64_bits16_bits8 (w:W64.t) i j: 0 <= j < 2 => w \bits16 i \bits8 j = w \bits8 (2 * i + j). +proof. + move=> hj; apply W8.wordP => k hk. + by rewrite !bits8iE 1,2:// bits16iE 1:/#; congr; ring. +qed. + +lemma W128_bits16_bits8 (w:W128.t) i j: 0 <= j < 2 => w \bits16 i \bits8 j = w \bits8 (2 * i + j). +proof. + move=> hj; apply W8.wordP => k hk. + by rewrite !bits8iE 1,2:// bits16iE 1:/#; congr; ring. +qed. + +lemma W256_bits16_bits8 (w:W256.t) i j: 0 <= j < 2 => w \bits16 i \bits8 j = w \bits8 (2 * i + j). +proof. + move=> hj; apply W8.wordP => k hk. + by rewrite !bits8iE 1,2:// bits16iE 1:/#; congr; ring. +qed. + +hint simplify W32_bits16_bits8, W64_bits16_bits8, W128_bits16_bits8, W256_bits16_bits8. + +lemma W64_bits32_bits8 (w:W64.t) i j: 0 <= j < 4 => w \bits32 i \bits8 j = w \bits8 (4 * i + j). +proof. + move=> hj; apply W8.wordP => k hk. + by rewrite !bits8iE 1,2:// bits32iE 1:/#; congr; ring. +qed. + +lemma W128_bits32_bits8 (w:W128.t) i j: 0 <= j < 4 => w \bits32 i \bits8 j = w \bits8 (4 * i + j). +proof. + move=> hj; apply W8.wordP => k hk. + by rewrite !bits8iE 1,2:// bits32iE 1:/#; congr; ring. +qed. + +lemma W256_bits32_bits8 (w:W256.t) i j: 0 <= j < 4 => w \bits32 i \bits8 j = w \bits8 (4 * i + j). +proof. + move=> hj; apply W8.wordP => k hk. + by rewrite !bits8iE 1,2:// bits32iE 1:/#; congr; ring. +qed. + +hint simplify W64_bits32_bits8, W128_bits32_bits8, W256_bits32_bits8. + +lemma W128_bits64_bits8 (w:W128.t) i j: 0 <= j < 8 => w \bits64 i \bits8 j = w \bits8 (8 * i + j). +proof. + move=> hj; apply W8.wordP => k hk. + by rewrite !bits8iE 1,2:// bits64iE 1:/#; congr; ring. +qed. + +lemma W256_bits64_bits8 (w:W256.t) i j: 0 <= j < 8 => w \bits64 i \bits8 j = w \bits8 (8 * i + j). +proof. + move=> hj; apply W8.wordP => k hk. + by rewrite !bits8iE 1,2:// bits64iE 1:/#; congr; ring. +qed. + +hint simplify W128_bits64_bits8, W256_bits64_bits8. + +lemma W256_bits128_bits8 (w:W256.t) i j: 0 <= j < 16 => w \bits128 i \bits8 j = w \bits8 (16 * i + j). +proof. + move=> hj; apply W8.wordP => k hk. + by rewrite !bits8iE 1,2:// bits128iE 1:/#; congr; ring. +qed. + +hint simplify W256_bits128_bits8. + +(* --------------------------------------------------------------------------------- *) +(* Lemmas on \bits16 *) +(* --------------------------------------------------------------------------------- *) + +lemma bits16_W4u8 ws i : + W4u8.pack4_t ws \bits16 i = if 0 <= i < 2 then W2u8.pack2 [ws.[2 * i]; ws.[2 * i + 1]] else W16.zero. +proof. + apply W2u8.wordP => j hj. + rewrite W32_bits16_bits8 1://. + case: (0 <= i < 2) => hi; last by rewrite W2u8.get_zero W4u8.get_out 1:/#. + rewrite /= W2u8.pack2bE 1:// /= W4u8.pack4bE 1:/#. + by have []-> : j = 0 \/ j = 1 by smt(). +qed. + +lemma bits16_W4u8_red ws i : + 0 <= i < 2 => W4u8.pack4_t ws \bits16 i = W2u8.pack2 [ws.[2 * i]; ws.[2 * i + 1]]. +proof. by move=> h;rewrite bits16_W4u8 h. qed. + +lemma bits16_W8u8 ws i : + W8u8.pack8_t ws \bits16 i = if 0 <= i < 4 then W2u8.pack2 [ws.[2 * i]; ws.[2 * i + 1]] else W16.zero. +proof. + apply W2u8.wordP => j hj. + rewrite W64_bits16_bits8 1://. + case: (0 <= i < 4) => hi; last by rewrite W2u8.get_zero W8u8.get_out 1:/#. + rewrite /= W2u8.pack2bE 1:// /= W8u8.pack8bE 1:/#. + have []-> //: j = 0 \/ j = 1 by smt(). +qed. + +lemma bits16_W8u8_red ws i : + 0 <= i < 4 => W8u8.pack8_t ws \bits16 i = W2u8.pack2 [ws.[2 * i]; ws.[2 * i + 1]]. +proof. by move=> h;rewrite bits16_W8u8 h. qed. + +lemma bits16_W16u8 ws i : + W16u8.pack16_t ws \bits16 i = if 0 <= i < 8 then W2u8.pack2 [ws.[2 * i]; ws.[2 * i + 1]] else W16.zero. +proof. + apply W2u8.wordP => j hj. + rewrite W128_bits16_bits8 1://. + case: (0 <= i < 8) => hi; last by rewrite W2u8.get_zero W16u8.get_out 1:/#. + rewrite /= W2u8.pack2bE 1:// /= W16u8.pack16bE 1:/#. + have []-> //: j = 0 \/ j = 1 by smt(). +qed. + +lemma bits16_W16u8_red ws i : + 0 <= i < 8 => W16u8.pack16_t ws \bits16 i = W2u8.pack2 [ws.[2 * i]; ws.[2 * i + 1]]. +proof. by move=> h;rewrite bits16_W16u8 h. qed. + +lemma bits16_W32u8 ws i : + W32u8.pack32_t ws \bits16 i = if 0 <= i < 16 then W2u8.pack2 [ws.[2 * i]; ws.[2 * i + 1]] else W16.zero. +proof. + apply W2u8.wordP => j hj. + rewrite W256_bits16_bits8 1://. + case: (0 <= i < 16) => hi; last by rewrite W2u8.get_zero W32u8.get_out 1:/#. + rewrite /= W2u8.pack2bE 1:// /= W32u8.pack32bE 1:/#. + have []-> //: j = 0 \/ j = 1 by smt(). +qed. + +lemma bits16_W32u8_red ws i : + 0 <= i < 16 => W32u8.pack32_t ws \bits16 i = W2u8.pack2 [ws.[2 * i]; ws.[2 * i + 1]]. +proof. by move=> h;rewrite bits16_W32u8 h. qed. + +hint simplify bits16_W4u8_red, bits16_W8u8_red, bits16_W16u8_red, bits16_W32u8. + +lemma bits16_W2u32 ws i : + W2u32.pack2_t ws \bits16 i = if 0 <= i < 4 then ws.[i%/2] \bits16 (i%%2) else W16.zero. +proof. + apply W16.wordP => j hj; rewrite !bits16iE 1,2://. + case: (0 <= i < 4) => /= hi; last by rewrite W64.get_out 1:/#. + rewrite pack2wE 1:/#; have /= [-> ->] := divmod_mul 2 16 i j _ hj; 1: done; rewrite W2u16.bits16iE 1:// /#. +qed. + +lemma bits16_W2u32_red ws i : + 0 <= i < 4 => W2u32.pack2_t ws \bits16 i = ws.[i%/2] \bits16 (i%%2). +proof. by move=> h;rewrite bits16_W2u32 h. qed. + +lemma bits16_W4u32 ws i : + W4u32.pack4_t ws \bits16 i = if 0 <= i < 8 then ws.[i%/2] \bits16 (i%%2) else W16.zero. +proof. + apply W16.wordP => j hj; rewrite !bits16iE 1,2://. + case: (0 <= i < 8) => /= hi; last by rewrite W128.get_out 1:/#. + rewrite pack4wE 1:/#; have /= [-> ->] := divmod_mul 2 16 i j _ hj; 1: done; rewrite W2u16.bits16iE 1:// /#. +qed. + +lemma bits16_W4u32_red ws i : + 0 <= i < 8 => W4u32.pack4_t ws \bits16 i = ws.[i%/2] \bits16 (i%%2). +proof. by move=> h;rewrite bits16_W4u32 h. qed. + +lemma bits16_W8u32 ws i : + W8u32.pack8_t ws \bits16 i = if 0 <= i < 16 then ws.[i%/2] \bits16 (i%%2) else W16.zero. +proof. + apply W16.wordP => j hj; rewrite !bits16iE 1,2://. + case: (0 <= i < 16) => /= hi; last by rewrite W256.get_out 1:/#. + rewrite pack8wE 1:/#; have /= [-> ->] := divmod_mul 2 16 i j _ hj; 1: done; rewrite W2u16.bits16iE 1:// /#. +qed. + +lemma bits16_W8u32_red ws i : + 0 <= i < 16 => W8u32.pack8_t ws \bits16 i = ws.[i%/2] \bits16 (i%%2). +proof. by move=> h;rewrite bits16_W8u32 h. qed. + +hint simplify bits16_W2u32_red, bits16_W4u32_red, bits16_W8u32_red. + +lemma bits16_W2u64 ws i : + W2u64.pack2_t ws \bits16 i = if 0 <= i < 8 then ws.[i%/4] \bits16 (i%%4) else W16.zero. +proof. + apply W16.wordP => j hj; rewrite !bits16iE 1,2://. + case: (0 <= i < 8) => /= hi; last by rewrite W128.get_out 1:/#. + rewrite pack2wE 1:/#; have /= [-> ->] := divmod_mul 4 16 i j _ hj; 1: done; rewrite W4u16.bits16iE 1:// /#. +qed. + +lemma bits16_W2u64_red ws i : + 0 <= i < 8 => W2u64.pack2_t ws \bits16 i = ws.[i%/4] \bits16 (i%%4). +proof. by move=> h;rewrite bits16_W2u64 h. qed. + +lemma bits16_W4u64 ws i : + W4u64.pack4_t ws \bits16 i = if 0 <= i < 16 then ws.[i%/4] \bits16 (i%%4) else W16.zero. +proof. + apply W16.wordP => j hj; rewrite !bits16iE 1,2://. + case: (0 <= i < 16) => /= hi; last by rewrite W256.get_out 1:/#. + rewrite pack4wE 1:/#; have /= [-> ->] := divmod_mul 4 16 i j _ hj; 1: done; rewrite W4u16.bits16iE 1:// /#. +qed. + +lemma bits16_W4u64_red ws i : + 0 <= i < 16 => W4u64.pack4_t ws \bits16 i = ws.[i%/4] \bits16 (i%%4). +proof. by move=> h;rewrite bits16_W4u64 h. qed. + +hint simplify bits16_W2u64_red, bits16_W4u64_red. + +lemma bits16_W2u128 ws i : + W2u128.pack2_t ws \bits16 i = if 0 <= i < 16 then ws.[i%/8] \bits16 (i%%8) else W16.zero. +proof. + apply W16.wordP => j hj; rewrite !bits16iE 1,2://. + case: (0 <= i < 16) => /= hi; last by rewrite W256.get_out 1:/#. + rewrite pack2wE 1:/#; have /= [-> ->] := divmod_mul 8 16 i j _ hj; 1: done; rewrite W8u16.bits16iE 1:// /#. +qed. + +lemma bits16_W2u128_red ws i : + 0 <= i < 16 => W2u128.pack2_t ws \bits16 i = ws.[i%/8] \bits16 (i%%8). +proof. by move=> h;rewrite bits16_W2u128 h. qed. + +hint simplify bits16_W2u128_red. + +lemma W64_bits32_bits16 (w:W64.t) i j: 0 <= j < 2 => w \bits32 i \bits16 j = w \bits16 (2 * i + j). +proof. + move=> hj; apply W16.wordP => k hk. + by rewrite !bits16iE 1,2:// bits32iE 1:/#; congr; ring. +qed. + +lemma W128_bits32_bits16 (w:W128.t) i j: 0 <= j < 2 => w \bits32 i \bits16 j = w \bits16 (2 * i + j). +proof. + move=> hj; apply W16.wordP => k hk. + by rewrite !bits16iE 1,2:// bits32iE 1:/#; congr; ring. +qed. + +lemma W256_bits32_bits16 (w:W256.t) i j: 0 <= j < 2 => w \bits32 i \bits16 j = w \bits16 (2 * i + j). +proof. + move=> hj; apply W16.wordP => k hk. + by rewrite !bits16iE 1,2:// bits32iE 1:/#; congr; ring. +qed. + +hint simplify W64_bits32_bits16, W128_bits32_bits16, W256_bits32_bits16. + +lemma W128_bits64_bits16 (w:W128.t) i j: 0 <= j < 4 => w \bits64 i \bits16 j = w \bits16 (4 * i + j). +proof. + move=> hj; apply W16.wordP => k hk. + by rewrite !bits16iE 1,2:// bits64iE 1:/#; congr; ring. +qed. + +lemma W256_bits64_bits16 (w:W256.t) i j: 0 <= j < 4 => w \bits64 i \bits16 j = w \bits16 (4 * i + j). +proof. + move=> hj; apply W16.wordP => k hk. + by rewrite !bits16iE 1,2:// bits64iE 1:/#; congr; ring. +qed. + +lemma W256_bits128_bits16 (w:W256.t) i j: 0 <= j < 8 => w \bits128 i \bits16 j = w \bits16 (8 * i + j). +proof. + move=> hj; apply W16.wordP => k hk. + by rewrite !bits16iE 1,2:// bits128iE 1:/#; congr; ring. +qed. + +hint simplify W128_bits64_bits16, W256_bits64_bits16, W256_bits128_bits16. + +(* --------------------------------------------------------------------------------- *) +(* Lemmas on \bits32 *) +(* --------------------------------------------------------------------------------- *) + +lemma bits32_W8u8 ws i : + W8u8.pack8_t ws \bits32 i = + if 0 <= i < 2 then W4u8.pack4 [ws.[4 * i]; ws.[4 * i + 1]; ws.[4 * i + 2]; ws.[4 * i + 3] ] else W32.zero. +proof. + apply W4u8.wordP => j hj. + rewrite W64_bits32_bits8 1://. + case: (0 <= i < 2) => hi; last by rewrite W4u8.get_zero W8u8.get_out 1:/#. + rewrite /= W4u8.pack4bE 1:// /= W8u8.pack8bE 1:/#. + by have [|[|[|]]]-> : j = 0 \/ j = 1 \/ j = 2 \/ j = 3 by smt(). +qed. + +lemma bits32_W8u8_red ws i : + 0 <= i < 2 => + W8u8.pack8_t ws \bits32 i = + W4u8.pack4 [ws.[4 * i]; ws.[4 * i + 1]; ws.[4 * i + 2]; ws.[4 * i + 3] ]. +proof. by move=> h;rewrite bits32_W8u8 h. qed. + +lemma bits32_W16u8 ws i : + W16u8.pack16_t ws \bits32 i = + if 0 <= i < 4 then W4u8.pack4 [ws.[4 * i]; ws.[4 * i + 1]; ws.[4 * i + 2]; ws.[4 * i + 3] ] else W32.zero. +proof. + apply W4u8.wordP => j hj. + rewrite W128_bits32_bits8 1://. + case: (0 <= i < 4) => hi; last by rewrite W4u8.get_zero W16u8.get_out 1:/#. + rewrite /= W4u8.pack4bE 1:// /= W16u8.pack16bE 1:/#. + by have [|[|[|]]]-> : j = 0 \/ j = 1 \/ j = 2 \/ j = 3 by smt(). +qed. + +lemma bits32_W16u8_red ws i : + 0 <= i < 4 => + W16u8.pack16_t ws \bits32 i = + W4u8.pack4 [ws.[4 * i]; ws.[4 * i + 1]; ws.[4 * i + 2]; ws.[4 * i + 3] ]. +proof. by move=> h;rewrite bits32_W16u8 h. qed. + +lemma bits32_W32u8 ws i : + W32u8.pack32_t ws \bits32 i = + if 0 <= i < 8 then W4u8.pack4 [ws.[4 * i]; ws.[4 * i + 1]; ws.[4 * i + 2]; ws.[4 * i + 3] ] else W32.zero. +proof. + apply W4u8.wordP => j hj. + rewrite W256_bits32_bits8 1://. + case: (0 <= i < 8) => hi; last by rewrite W4u8.get_zero W32u8.get_out 1:/#. + rewrite /= W4u8.pack4bE 1:// /= W32u8.pack32bE 1:/#. + by have [|[|[|]]]-> : j = 0 \/ j = 1 \/ j = 2 \/ j = 3 by smt(). +qed. + +lemma bits32_W32u8_red ws i : + 0 <= i < 8 => + W32u8.pack32_t ws \bits32 i = + W4u8.pack4 [ws.[4 * i]; ws.[4 * i + 1]; ws.[4 * i + 2]; ws.[4 * i + 3] ]. +proof. by move=> h;rewrite bits32_W32u8 h. qed. + +hint simplify bits32_W8u8_red, bits32_W16u8_red, bits32_W32u8_red. + +lemma bits32_W4u16 ws i : + W4u16.pack4_t ws \bits32 i = + if 0 <= i < 2 then W2u16.pack2 [ws.[2 * i]; ws.[2 * i + 1]] else W32.zero. +proof. + apply W2u16.wordP => j hj. + rewrite W64_bits32_bits16 1://. + case: (0 <= i < 2) => hi; last by rewrite W2u16.get_zero W4u16.get_out 1:/#. + rewrite /= W2u16.pack2bE 1:// /= W4u16.pack4bE 1:/#. + by have []-> : j = 0 \/ j = 1 by smt(). +qed. + +lemma bits32_W4u16_red ws i : + 0 <= i < 2 => + W4u16.pack4_t ws \bits32 i = W2u16.pack2 [ws.[2 * i]; ws.[2 * i + 1]]. +proof. by move=> h;rewrite bits32_W4u16 h. qed. + +lemma bits32_W8u16 ws i : + W8u16.pack8_t ws \bits32 i = + if 0 <= i < 4 then W2u16.pack2 [ws.[2 * i]; ws.[2 * i + 1]] else W32.zero. +proof. + apply W2u16.wordP => j hj. + rewrite W128_bits32_bits16 1://. + case: (0 <= i < 4) => hi; last by rewrite W2u16.get_zero W8u16.get_out 1:/#. + rewrite /= W2u16.pack2bE 1:// /= W8u16.pack8bE 1:/#. + by have []-> : j = 0 \/ j = 1 by smt(). +qed. + +lemma bits32_W8u16_red ws i : + 0 <= i < 4 => + W8u16.pack8_t ws \bits32 i = W2u16.pack2 [ws.[2 * i]; ws.[2 * i + 1]]. +proof. by move=> h;rewrite bits32_W8u16 h. qed. + +lemma bits32_W16u16 ws i : + W16u16.pack16_t ws \bits32 i = + if 0 <= i < 8 then W2u16.pack2 [ws.[2 * i]; ws.[2 * i + 1]] else W32.zero. +proof. + apply W2u16.wordP => j hj. + rewrite W256_bits32_bits16 1://. + case: (0 <= i < 8) => hi; last by rewrite W2u16.get_zero W16u16.get_out 1:/#. + rewrite /= W2u16.pack2bE 1:// /= W16u16.pack16bE 1:/#. + by have []-> : j = 0 \/ j = 1 by smt(). +qed. + +lemma bits32_W16u16_red ws i : + 0 <= i < 8 => + W16u16.pack16_t ws \bits32 i = W2u16.pack2 [ws.[2 * i]; ws.[2 * i + 1]]. +proof. by move=> h;rewrite bits32_W16u16 h. qed. + +hint simplify bits32_W4u16_red, bits32_W8u16_red, bits32_W16u16_red. + +lemma bits32_W2u64 ws i : + W2u64.pack2_t ws \bits32 i = if 0 <= i < 4 then ws.[i%/2] \bits32 (i%%2) else W32.zero. +proof. + apply W32.wordP => j hj; rewrite !bits32iE 1,2://. + case: (0 <= i < 4) => /= hi; last by rewrite W128.get_out 1:/#. + rewrite pack2wE 1:/#; have /= [-> ->] := divmod_mul 2 32 i j _ hj; 1: done; rewrite W2u32.bits32iE 1:// /#. +qed. + +lemma bits32_W2u64_red ws i : + 0 <= i < 4 => W2u64.pack2_t ws \bits32 i = ws.[i%/2] \bits32 (i%%2). +proof. by move=> h;rewrite bits32_W2u64 h. qed. + +lemma bits32_W4u64 ws i : + W4u64.pack4_t ws \bits32 i = if 0 <= i < 8 then ws.[i%/2] \bits32 (i%%2) else W32.zero. +proof. + apply W32.wordP => j hj; rewrite !bits32iE 1,2://. + case: (0 <= i < 8) => /= hi; last by rewrite W256.get_out 1:/#. + rewrite pack4wE 1:/#; have /= [-> ->] := divmod_mul 2 32 i j _ hj; 1: done; rewrite W2u32.bits32iE 1:// /#. +qed. + +lemma bits32_W4u64_red ws i : + 0 <= i < 8 => W4u64.pack4_t ws \bits32 i = ws.[i%/2] \bits32 (i%%2). +proof. by move=> h;rewrite bits32_W4u64 h. qed. + +hint simplify bits32_W2u64_red, bits32_W4u64_red. + +lemma bits32_W2u128 ws i : + W2u128.pack2_t ws \bits32 i = if 0 <= i < 8 then ws.[i%/4] \bits32 (i%%4) else W32.zero. +proof. + apply W32.wordP => j hj; rewrite !bits32iE 1,2://. + case: (0 <= i < 8) => /= hi; last by rewrite W256.get_out 1:/#. + rewrite pack2wE 1:/#; have /= [-> ->] := divmod_mul 4 32 i j _ hj; 1: done; rewrite W4u32.bits32iE 1:// /#. +qed. + +lemma bits32_W2u128_red ws i : + 0 <= i < 8 => W2u128.pack2_t ws \bits32 i = ws.[i%/4] \bits32 (i%%4). +proof. by move=> h;rewrite bits32_W2u128 h. qed. + +hint simplify bits32_W2u128_red. + +lemma W128_bits64_bits32 (w:W128.t) i j: 0 <= j < 2 => w \bits64 i \bits32 j = w \bits32 (2 * i + j). +proof. + move=> hj; apply W32.wordP => k hk. + by rewrite !bits32iE 1,2:// bits64iE 1:/#; congr; ring. +qed. + +lemma W256_bits64_bits32 (w:W256.t) i j: 0 <= j < 2 => w \bits64 i \bits32 j = w \bits32 (2 * i + j). +proof. + move=> hj; apply W32.wordP => k hk. + by rewrite !bits32iE 1,2:// bits64iE 1:/#; congr; ring. +qed. + +lemma W256_bits128_bits32 (w:W256.t) i j: 0 <= j < 4 => w \bits128 i \bits32 j = w \bits32 (4 * i + j). +proof. + move=> hj; apply W32.wordP => k hk. + by rewrite !bits32iE 1,2:// bits128iE 1:/#; congr; ring. +qed. + +hint simplify W128_bits64_bits32, W256_bits64_bits32, W256_bits128_bits32. + +(* --------------------------------------------------------------------------------- *) +(* Lemmas on \bits64 *) +(* --------------------------------------------------------------------------------- *) + +lemma bits64_W16u8 ws i : + W16u8.pack16_t ws \bits64 i = + if 0 <= i < 2 then W8u8.pack8 [ws.[8 * i]; ws.[8 * i + 1]; ws.[8 * i + 2]; ws.[8 * i + 3]; + ws.[8 * i + 4]; ws.[8 * i + 5]; ws.[8 * i + 6]; ws.[8 * i + 7]] + else W64.zero. +proof. + apply W8u8.wordP => j hj. + rewrite W128_bits64_bits8 1://. + case: (0 <= i < 2) => hi; last by rewrite W8u8.get_zero W16u8.get_out 1:/#. + rewrite /= W8u8.pack8bE 1:// /= W16u8.pack16bE 1:/#. + by move: hj; rewrite -(mema_iota 0 8) /= => -[|[|[|[|[|[|[|]]]]]]] ->. +qed. + +lemma bits64_W16u8_red ws i : + 0 <= i < 2 => + W16u8.pack16_t ws \bits64 i = + W8u8.pack8 [ws.[8 * i]; ws.[8 * i + 1]; ws.[8 * i + 2]; ws.[8 * i + 3]; + ws.[8 * i + 4]; ws.[8 * i + 5]; ws.[8 * i + 6]; ws.[8 * i + 7]]. +proof. by move=> h;rewrite bits64_W16u8 h. qed. + +lemma bits64_W32u8 ws i : + W32u8.pack32_t ws \bits64 i = + if 0 <= i < 4 then W8u8.pack8 [ws.[8 * i]; ws.[8 * i + 1]; ws.[8 * i + 2]; ws.[8 * i + 3]; + ws.[8 * i + 4]; ws.[8 * i + 5]; ws.[8 * i + 6]; ws.[8 * i + 7]] + else W64.zero. +proof. + apply W8u8.wordP => j hj. + rewrite W256_bits64_bits8 1://. + case: (0 <= i < 4) => hi; last by rewrite W8u8.get_zero W32u8.get_out 1:/#. + rewrite /= W8u8.pack8bE 1:// /= W32u8.pack32bE 1:/#. + by move: hj; rewrite -(mema_iota 0 8) /= => -[|[|[|[|[|[|[|]]]]]]] ->. +qed. + +lemma bits64_W32u8_red ws i : + 0 <= i < 4 => + W32u8.pack32_t ws \bits64 i = + W8u8.pack8 [ws.[8 * i]; ws.[8 * i + 1]; ws.[8 * i + 2]; ws.[8 * i + 3]; + ws.[8 * i + 4]; ws.[8 * i + 5]; ws.[8 * i + 6]; ws.[8 * i + 7]]. +proof. by move=> h;rewrite bits64_W32u8 h. qed. + +hint simplify bits64_W16u8_red, bits64_W32u8_red. + +lemma bits64_W8u16 ws i : + W8u16.pack8_t ws \bits64 i = + if 0 <= i < 2 then W4u16.pack4 [ws.[4 * i]; ws.[4 * i + 1]; ws.[4 * i + 2]; ws.[4 * i + 3] ] else W64.zero. +proof. + apply W4u16.wordP => j hj. + rewrite W128_bits64_bits16 1://. + case: (0 <= i < 2) => hi; last by rewrite W4u16.get_zero W8u16.get_out 1:/#. + rewrite /= W4u16.pack4bE 1:// /= W8u16.pack8bE 1:/#. + by have [|[|[|]]]-> : j = 0 \/ j = 1 \/ j = 2 \/ j = 3 by smt(). +qed. + +lemma bits64_W8u16_red ws i : + 0 <= i < 2 => + W8u16.pack8_t ws \bits64 i = + W4u16.pack4 [ws.[4 * i]; ws.[4 * i + 1]; ws.[4 * i + 2]; ws.[4 * i + 3] ]. +proof. by move=> h;rewrite bits64_W8u16 h. qed. + +lemma bits64_W16u16 ws i : + W16u16.pack16_t ws \bits64 i = + if 0 <= i < 4 then W4u16.pack4 [ws.[4 * i]; ws.[4 * i + 1]; ws.[4 * i + 2]; ws.[4 * i + 3] ] else W64.zero. +proof. + apply W4u16.wordP => j hj. + rewrite W256_bits64_bits16 1://. + case: (0 <= i < 4) => hi; last by rewrite W4u16.get_zero W16u16.get_out 1:/#. + rewrite /= W4u16.pack4bE 1:// /= W16u16.pack16bE 1:/#. + by have [|[|[|]]]-> : j = 0 \/ j = 1 \/ j = 2 \/ j = 3 by smt(). +qed. + +lemma bits64_W16u16_red ws i : + 0 <= i < 4 => + W16u16.pack16_t ws \bits64 i = + W4u16.pack4 [ws.[4 * i]; ws.[4 * i + 1]; ws.[4 * i + 2]; ws.[4 * i + 3] ]. +proof. by move=> h;rewrite bits64_W16u16 h. qed. + +hint simplify bits64_W8u16_red, bits64_W16u16_red. + +lemma bits64_W4u32 ws i : + W4u32.pack4_t ws \bits64 i = + if 0 <= i < 2 then W2u32.pack2 [ws.[2 * i]; ws.[2 * i + 1]] else W64.zero. +proof. + apply W2u32.wordP => j hj. + rewrite W128_bits64_bits32 1://. + case: (0 <= i < 2) => hi; last by rewrite W2u32.get_zero W4u32.get_out 1:/#. + rewrite /= W2u32.pack2bE 1:// /= W4u32.pack4bE 1:/#. + by have [|]-> : j = 0 \/ j = 1 by smt(). +qed. + +lemma bits64_W4u32_red ws i : + 0 <= i < 2 => + W4u32.pack4_t ws \bits64 i = W2u32.pack2 [ws.[2 * i]; ws.[2 * i + 1]]. +proof. by move=> h;rewrite bits64_W4u32 h. qed. + +lemma bits64_W8u32 ws i : + W8u32.pack8_t ws \bits64 i = + if 0 <= i < 4 then W2u32.pack2 [ws.[2 * i]; ws.[2 * i + 1]] else W64.zero. +proof. + apply W2u32.wordP => j hj. + rewrite W256_bits64_bits32 1://. + case: (0 <= i < 4) => hi; last by rewrite W2u32.get_zero W8u32.get_out 1:/#. + rewrite /= W2u32.pack2bE 1:// /= W8u32.pack8bE 1:/#. + have [|]-> //= : j = 0 \/ j = 1 by smt(). +qed. + +lemma bits64_W8u32_red ws i : + 0 <= i < 4 => + W8u32.pack8_t ws \bits64 i = W2u32.pack2 [ws.[2 * i]; ws.[2 * i + 1]]. +proof. by move=> h;rewrite bits64_W8u32 h. qed. + +hint simplify bits64_W4u32_red, bits64_W8u32_red. + +lemma bits64_W2u128 ws i : + W2u128.pack2_t ws \bits64 i = if 0 <= i < 4 then ws.[i%/2] \bits64 (i%%2) else W64.zero. +proof. + apply W64.wordP => j hj; rewrite !bits64iE 1,2://. + case: (0 <= i < 4) => /= hi; last by rewrite W256.get_out 1:/#. + rewrite pack2wE 1:/#; have /= [-> ->] := divmod_mul 2 64 i j _ hj; 1: done; rewrite W2u64.bits64iE 1:// /#. +qed. + +lemma bits64_W2u128_red ws i : + 0 <= i < 4 => W2u128.pack2_t ws \bits64 i = ws.[i%/2] \bits64 (i%%2). +proof. by move=> h;rewrite bits64_W2u128 h. qed. + +hint simplify bits64_W2u128_red. + +lemma W256_bits128_bits64 (w:W256.t) i j: 0 <= j < 2 => w \bits128 i \bits64 j = w \bits64 (2 * i + j). +proof. + move=> hj; apply W64.wordP => k hk. + by rewrite !bits64iE 1,2:// bits128iE 1:/#; congr; ring. +qed. + +hint simplify W256_bits128_bits64. + +(* --------------------------------------------------------------------------------- *) +(* Lemmas on \bits128 *) +(* --------------------------------------------------------------------------------- *) + +lemma bits128_W32u8 ws i : + W32u8.pack32_t ws \bits128 i = + if 0 <= i < 2 then + W16u8.pack16 [ws.[16 * i]; ws.[16 * i + 1]; ws.[16 * i + 2]; ws.[16 * i + 3]; + ws.[16 * i + 4]; ws.[16 * i + 5]; ws.[16 * i + 6]; ws.[16 * i + 7]; + ws.[16 * i + 8]; ws.[16 * i + 9]; ws.[16 * i + 10]; ws.[16 * i + 11]; + ws.[16 * i + 12]; ws.[16 * i + 13]; ws.[16 * i + 14]; ws.[16 * i + 15]] + else W128.zero. +proof. + apply W16u8.wordP => j hj. + rewrite W256_bits128_bits8 1://. + case: (0 <= i < 2) => hi; last by rewrite W16u8.get_zero W32u8.get_out 1:/#. + rewrite /= W32u8.pack32bE 1:/# /= W16u8.pack16bE 1:/#. + by move: hj; rewrite -(mema_iota 0 16) /= => -[|[|[|[|[|[|[|[|[|[|[|[|[|[|[|]]]]]]]]]]]]]]] ->. +qed. + +lemma bits128_W32u8_red ws i : + 0 <= i < 2 => + W32u8.pack32_t ws \bits128 i = + W16u8.pack16 [ws.[16 * i]; ws.[16 * i + 1]; ws.[16 * i + 2]; ws.[16 * i + 3]; + ws.[16 * i + 4]; ws.[16 * i + 5]; ws.[16 * i + 6]; ws.[16 * i + 7]; + ws.[16 * i + 8]; ws.[16 * i + 9]; ws.[16 * i + 10]; ws.[16 * i + 11]; + ws.[16 * i + 12]; ws.[16 * i + 13]; ws.[16 * i + 14]; ws.[16 * i + 15]]. +proof. by move=> hi;rewrite bits128_W32u8 hi. qed. + +lemma bits128_W16u16 ws i : + W16u16.pack16_t ws \bits128 i = + if 0 <= i < 2 then + W8u16.pack8 [ws.[8 * i]; ws.[8 * i + 1]; ws.[8 * i + 2]; ws.[8 * i + 3]; + ws.[8 * i + 4]; ws.[8 * i + 5]; ws.[8 * i + 6]; ws.[8 * i + 7]] + else W128.zero. +proof. + apply W8u16.wordP => j hj. + rewrite W256_bits128_bits16 1://. + case: (0 <= i < 2) => hi; last by rewrite W8u16.get_zero W16u16.get_out 1:/#. + rewrite /= W16u16.pack16bE 1:/# /= W8u16.pack8bE 1:/#. + by move: hj; rewrite -(mema_iota 0 8) /= => -[|[|[|[|[|[|[|]]]]]]] ->. +qed. + +lemma bits128_W16u16_red ws i : + 0 <= i < 2 => + W16u16.pack16_t ws \bits128 i = + W8u16.pack8 [ws.[8 * i]; ws.[8 * i + 1]; ws.[8 * i + 2]; ws.[8 * i + 3]; + ws.[8 * i + 4]; ws.[8 * i + 5]; ws.[8 * i + 6]; ws.[8 * i + 7]]. +proof. by move=> hi;rewrite bits128_W16u16 hi. qed. + +lemma bits128_W8u32 ws i : + W8u32.pack8_t ws \bits128 i = + if 0 <= i < 2 then + W4u32.pack4 [ws.[4 * i]; ws.[4 * i + 1]; ws.[4 * i + 2]; ws.[4 * i + 3]] + else W128.zero. +proof. + apply W4u32.wordP => j hj. + rewrite W256_bits128_bits32 1://. + case: (0 <= i < 2) => hi; last by rewrite W4u32.get_zero W8u32.get_out 1:/#. + rewrite /= W8u32.pack8bE 1:/# /= W4u32.pack4bE 1:/#. + by move: hj; rewrite -(mema_iota 0 4) /= => -[|[|[|]]] ->. +qed. + +lemma bits128_W8u32_red ws i : + 0 <= i < 2 => + W8u32.pack8_t ws \bits128 i = + W4u32.pack4 [ws.[4 * i]; ws.[4 * i + 1]; ws.[4 * i + 2]; ws.[4 * i + 3]]. +proof. by move=> hi;rewrite bits128_W8u32 hi. qed. + +lemma bits128_W4u64 ws i : + W4u64.pack4_t ws \bits128 i = + if 0 <= i < 2 then + W2u64.pack2 [ws.[2 * i]; ws.[2* i + 1]] + else W128.zero. +proof. + apply W2u64.wordP => j hj. + rewrite W256_bits128_bits64 1://. + case: (0 <= i < 2) => hi; last by rewrite W2u64.get_zero W4u64.get_out 1:/#. + rewrite /= W4u64.pack4bE 1:/# /= W2u64.pack2bE 1:// get_of_list 1://. + by move: hj; rewrite -(mema_iota 0 2) /= => -[|] ->. +qed. + +lemma bits128_W4u64_red ws i : + 0 <= i < 2 => + W4u64.pack4_t ws \bits128 i = W2u64.pack2 [ws.[2 * i]; ws.[2* i + 1]]. +proof. by move=> hi;rewrite bits128_W4u64 hi. qed. + +hint simplify bits128_W32u8_red, bits128_W16u16_red, bits128_W8u32_red, bits128_W4u64_red. + +(* --------------------------------------------------------------------------------- *) +(* Lemmas on pack *) +(* --------------------------------------------------------------------------------- *) + +lemma W2u16_W4u8 ws1 ws2 : + pack2 [W2u8.pack2_t ws1; W2u8.pack2_t ws2] = pack4 [ws1.[0]; ws1.[1]; ws2.[0]; ws2.[1]]. +proof. by apply W4u8.allP => /=. qed. + +lemma W4u16_W8u8 ws1 ws2 ws3 ws4 : + pack4 [W2u8.pack2_t ws1; W2u8.pack2_t ws2; W2u8.pack2_t ws3; W2u8.pack2_t ws4] = + pack8 [ws1.[0]; ws1.[1]; ws2.[0]; ws2.[1]; ws3.[0]; ws3.[1]; ws4.[0]; ws4.[1]]. +proof. by apply W8u8.allP => /=. qed. + +lemma W8u16_W16u8 ws1 ws2 ws3 ws4 ws5 ws6 ws7 ws8: + pack8 [W2u8.pack2_t ws1; W2u8.pack2_t ws2; W2u8.pack2_t ws3; W2u8.pack2_t ws4; + W2u8.pack2_t ws5; W2u8.pack2_t ws6; W2u8.pack2_t ws7; W2u8.pack2_t ws8 ] = + pack16 [ws1.[0]; ws1.[1]; ws2.[0]; ws2.[1]; ws3.[0]; ws3.[1]; ws4.[0]; ws4.[1]; + ws5.[0]; ws5.[1]; ws6.[0]; ws6.[1]; ws7.[0]; ws7.[1]; ws8.[0]; ws8.[1]]. +proof. by apply W16u8.allP => /=. qed. + +lemma W16u16_W32u8 ws1 ws2 ws3 ws4 ws5 ws6 ws7 ws8 ws9 ws10 ws11 ws12 ws13 ws14 ws15 ws16: + pack16 [W2u8.pack2_t ws1; W2u8.pack2_t ws2; W2u8.pack2_t ws3; W2u8.pack2_t ws4; + W2u8.pack2_t ws5; W2u8.pack2_t ws6; W2u8.pack2_t ws7; W2u8.pack2_t ws8; + W2u8.pack2_t ws9; W2u8.pack2_t ws10; W2u8.pack2_t ws11; W2u8.pack2_t ws12; + W2u8.pack2_t ws13; W2u8.pack2_t ws14; W2u8.pack2_t ws15; W2u8.pack2_t ws16] = + pack32 [ws1.[0]; ws1.[1]; ws2.[0]; ws2.[1]; ws3.[0]; ws3.[1]; ws4.[0]; ws4.[1]; + ws5.[0]; ws5.[1]; ws6.[0]; ws6.[1]; ws7.[0]; ws7.[1]; ws8.[0]; ws8.[1]; + ws9.[0]; ws9.[1]; ws10.[0]; ws10.[1]; ws11.[0]; ws11.[1]; ws12.[0]; ws12.[1]; + ws13.[0]; ws13.[1]; ws14.[0]; ws14.[1]; ws15.[0]; ws15.[1]; ws16.[0]; ws16.[1]]. +proof. by apply W32u8.allP => /=. qed. + +hint simplify W2u16_W4u8, W4u16_W8u8, W8u16_W16u8, W16u16_W32u8. + +lemma W2u32_W8u8 ws1 ws2 : + pack2 [W4u8.pack4_t ws1; W4u8.pack4_t ws2] = + pack8 [ws1.[0]; ws1.[1]; ws1.[2]; ws1.[3]; ws2.[0]; ws2.[1]; ws2.[2]; ws2.[3]]. +proof. by apply W8u8.allP => /=. qed. + +lemma W4u32_W16u8 ws1 ws2 ws3 ws4 : + pack4 [W4u8.pack4_t ws1; W4u8.pack4_t ws2; W4u8.pack4_t ws3; W4u8.pack4_t ws4] = + pack16 [ws1.[0]; ws1.[1]; ws1.[2]; ws1.[3]; ws2.[0]; ws2.[1]; ws2.[2]; ws2.[3]; + ws3.[0]; ws3.[1]; ws3.[2]; ws3.[3]; ws4.[0]; ws4.[1]; ws4.[2]; ws4.[3]]. +proof. by apply W16u8.allP => /=. qed. + +lemma W8u32_W32u8 ws1 ws2 ws3 ws4 ws5 ws6 ws7 ws8: + pack8 [W4u8.pack4_t ws1; W4u8.pack4_t ws2; W4u8.pack4_t ws3; W4u8.pack4_t ws4; + W4u8.pack4_t ws5; W4u8.pack4_t ws6; W4u8.pack4_t ws7; W4u8.pack4_t ws8 ] = + pack32 [ws1.[0]; ws1.[1]; ws1.[2]; ws1.[3]; ws2.[0]; ws2.[1]; ws2.[2]; ws2.[3]; + ws3.[0]; ws3.[1]; ws3.[2]; ws3.[3]; ws4.[0]; ws4.[1]; ws4.[2]; ws4.[3]; + ws5.[0]; ws5.[1]; ws5.[2]; ws5.[3]; ws6.[0]; ws6.[1]; ws6.[2]; ws6.[3]; + ws7.[0]; ws7.[1]; ws7.[2]; ws7.[3]; ws8.[0]; ws8.[1]; ws8.[2]; ws8.[3]]. +proof. by apply W32u8.allP => /=. qed. + +hint simplify W2u32_W8u8, W4u32_W16u8, W8u32_W32u8. + +lemma W2u64_W16u8 ws1 ws2: + pack2 [W8u8.pack8_t ws1; W8u8.pack8_t ws2] = + pack16 [ws1.[0]; ws1.[1]; ws1.[2]; ws1.[3]; ws1.[4]; ws1.[5]; ws1.[6]; ws1.[7]; + ws2.[0]; ws2.[1]; ws2.[2]; ws2.[3]; ws2.[4]; ws2.[5]; ws2.[6]; ws2.[7]]. +proof. by apply W16u8.allP => /=. qed. + +lemma W4u64_W32u8 ws1 ws2 ws3 ws4: + pack4 [W8u8.pack8_t ws1; W8u8.pack8_t ws2; W8u8.pack8_t ws3; W8u8.pack8_t ws4] = + pack32 [ws1.[0]; ws1.[1]; ws1.[2]; ws1.[3]; ws1.[4]; ws1.[5]; ws1.[6]; ws1.[7]; + ws2.[0]; ws2.[1]; ws2.[2]; ws2.[3]; ws2.[4]; ws2.[5]; ws2.[6]; ws2.[7]; + ws3.[0]; ws3.[1]; ws3.[2]; ws3.[3]; ws3.[4]; ws3.[5]; ws3.[6]; ws3.[7]; + ws4.[0]; ws4.[1]; ws4.[2]; ws4.[3]; ws4.[4]; ws4.[5]; ws4.[6]; ws4.[7]]. +proof. by apply W32u8.allP => /=. qed. + +hint simplify W2u64_W16u8, W4u64_W32u8. + +lemma W2u128_W32u8 ws1 ws2: + pack2 [W16u8.pack16_t ws1; W16u8.pack16_t ws2] = + pack32 [ws1.[0]; ws1.[1]; ws1.[2]; ws1.[3]; ws1.[4]; ws1.[5]; ws1.[6]; ws1.[7]; + ws1.[8]; ws1.[9]; ws1.[10]; ws1.[11]; ws1.[12]; ws1.[13]; ws1.[14]; ws1.[15]; + ws2.[0]; ws2.[1]; ws2.[2]; ws2.[3]; ws2.[4]; ws2.[5]; ws2.[6]; ws2.[7]; + ws2.[8]; ws2.[9]; ws2.[10]; ws2.[11]; ws2.[12]; ws2.[13]; ws2.[14]; ws2.[15]]. +proof. by apply W32u8.allP => /=. qed. + +hint simplify W2u128_W32u8. + +lemma W2u32_W4u16 ws1 ws2 : + pack2 [W2u16.pack2_t ws1; W2u16.pack2_t ws2] = pack4 [ws1.[0]; ws1.[1]; ws2.[0]; ws2.[1]]. +proof. by apply W4u16.allP => /=. qed. + +lemma W4u32_W8u16 ws1 ws2 ws3 ws4 : + pack4 [W2u16.pack2_t ws1; W2u16.pack2_t ws2; W2u16.pack2_t ws3; W2u16.pack2_t ws4] = + pack8 [ws1.[0]; ws1.[1]; ws2.[0]; ws2.[1]; ws3.[0]; ws3.[1]; ws4.[0]; ws4.[1]]. +proof. by apply W8u16.allP => /=. qed. + +lemma W8u32_W16u16 ws1 ws2 ws3 ws4 ws5 ws6 ws7 ws8: + pack8 [W2u16.pack2_t ws1; W2u16.pack2_t ws2; W2u16.pack2_t ws3; W2u16.pack2_t ws4; + W2u16.pack2_t ws5; W2u16.pack2_t ws6; W2u16.pack2_t ws7; W2u16.pack2_t ws8 ] = + pack16 [ws1.[0]; ws1.[1]; ws2.[0]; ws2.[1]; ws3.[0]; ws3.[1]; ws4.[0]; ws4.[1]; + ws5.[0]; ws5.[1]; ws6.[0]; ws6.[1]; ws7.[0]; ws7.[1]; ws8.[0]; ws8.[1]]. +proof. by apply W16u16.allP => /=. qed. + +hint simplify W2u32_W4u16, W4u32_W8u16, W8u32_W16u16. + +lemma W2u64_W8u16 ws1 ws2: + pack2 [W4u16.pack4_t ws1; W4u16.pack4_t ws2] = + pack8 [ws1.[0]; ws1.[1]; ws1.[2]; ws1.[3]; + ws2.[0]; ws2.[1]; ws2.[2]; ws2.[3]]. +proof. by apply W8u16.allP => /=. qed. + +lemma W4u64_W16u16 ws1 ws2 ws3 ws4: + pack4 [W4u16.pack4_t ws1; W4u16.pack4_t ws2; W4u16.pack4_t ws3; W4u16.pack4_t ws4] = + pack16 [ws1.[0]; ws1.[1]; ws1.[2]; ws1.[3]; ws2.[0]; ws2.[1]; ws2.[2]; ws2.[3]; + ws3.[0]; ws3.[1]; ws3.[2]; ws3.[3]; ws4.[0]; ws4.[1]; ws4.[2]; ws4.[3]]. +proof. by apply W16u16.allP => /=. qed. + +hint simplify W2u64_W8u16, W4u64_W16u16. + +lemma W2u64_W4u32 ws1 ws2: + pack2 [W2u32.pack2_t ws1; W2u32.pack2_t ws2] = pack4 [ws1.[0]; ws1.[1]; ws2.[0]; ws2.[1]]. +proof. by apply W4u32.allP => /=. qed. + +lemma W4u64_W8u32 ws1 ws2 ws3 ws4 : + pack4 [W2u32.pack2_t ws1; W2u32.pack2_t ws2; W2u32.pack2_t ws3; W2u32.pack2_t ws4] = + pack8 [ws1.[0]; ws1.[1]; ws2.[0]; ws2.[1]; ws3.[0]; ws3.[1]; ws4.[0]; ws4.[1]]. +proof. by apply W8u32.allP => /=. qed. + +lemma W2u128_W8u32 ws1 ws2 : + pack2 [W4u32.pack4_t ws1; W4u32.pack4_t ws2] = + pack8 [ws1.[0]; ws1.[1]; ws1.[2]; ws1.[3]; ws2.[0]; ws2.[1]; ws2.[2]; ws2.[3]]. +proof. by apply W8u32.allP => /=. qed. + +hint simplify W2u64_W4u32, W4u64_W8u32, W2u128_W8u32. + +lemma W2u128_W4u64 ws1 ws2: + pack2 [W2u64.pack2_t ws1; W2u64.pack2_t ws2] = pack4 [ws1.[0]; ws1.[1]; ws2.[0]; ws2.[1]]. +proof. by apply W4u64.allP => /=. qed. + +hint simplify W2u128_W4u64. + + + + + + diff --git a/proof/impl/JWord_array.ec b/proof/impl/JWord_array.ec new file mode 100644 index 0000000..0f5782f --- /dev/null +++ b/proof/impl/JWord_array.ec @@ -0,0 +1,263 @@ +(* -------------------------------------------------------------------- *) +require import AllCore BitEncoding IntDiv SmtMap List StdOrder BitEncoding Bool. +(*---*) import Ring.IntID IntOrder BS2Int. +require import JUtils JArray JWord. + +abstract theory WArray. + + clone include MonoArray with + type elem <- W8.t, + op dfl <- W8.zero. + + op get8 (t:t) (i:int) : W8.t = t.[i]. + + op get16 (t:t) (i:int) : W16.t = + pack2_t (W2u8.Pack.init (fun j => t.[2*i + j])) + axiomatized by get16E. + + op get32 (t:t) (i:int) : W32.t = + pack4_t (W4u8.Pack.init (fun j => t.[4*i + j])) + axiomatized by get32E. + + op get64 (t:t) (i:int) : W64.t = + pack8_t (W8u8.Pack.init (fun j => t.[8*i + j])) + axiomatized by get64E. + + op get128 (t:t) (i:int) : W128.t = + pack16_t (W16u8.Pack.init (fun j => t.[16*i + j])) + axiomatized by get128E. + + op get256 (t:t) (i:int) : W256.t = + pack32_t (W32u8.Pack.init (fun j => t.[32*i + j])) + axiomatized by get256E. + + op set8 (t:t) (i:int) (w:W8.t) : t = t.[i <- w]. + + op set16 (t:t) (i:int) (w:W16.t) = + init (fun k => if 2*i <= k < 2*(i+1) then w \bits8 (k - 2*i) else t.[k]) + axiomatized by set16E. + + op set32 (t:t) (i:int) (w:W32.t) = + init (fun k => if 4*i <= k < 4*(i+1) then w \bits8 (k - 4*i) else t.[k]) + axiomatized by set32E. + + op set64 (t:t) (i:int) (w:W64.t) = + init (fun k => if 8*i <= k < 8*(i+1) then w \bits8 (k - 8*i) else t.[k]) + axiomatized by set64E. + + op set128 (t:t) (i:int) (w:W128.t) = + init (fun k => if 16*i <= k < 16*(i+1) then w \bits8 (k - 16*i) else t.[k]) + axiomatized by set128E. + + op set256 (t:t) (i:int) (w:W256.t) = + init (fun k => if 32*i <= k < 32*(i+1) then w \bits8 (k - 32*i) else t.[k]) + axiomatized by set256E. + + (* ----------------------------------------------------- *) + + lemma get_set8E t x y w: + 0 <= x < size => + get8 (set8 t x w) y = if y = x then w else get8 t y. + proof. apply get_setE. qed. + + lemma get8_set16E t x y w : + 0 <= x => 2*(x + 1) <= WArray.size => + get8 (set16 t x w) y = if 2*x <= y < 2*(x+1) then w \bits8 (y - 2*x) else get8 t y. + proof. + move=> hx hs; rewrite set16E /get8. + case: (2 * x <= y < 2 * (x + 1)) => hy. + + by rewrite initiE 1:/# /= hy. + case: (0 <= y < WArray.size) => hy1; last by rewrite !get_out. + rewrite initiE //= /#. + qed. + + lemma get_set16E t x y w: + 0 <= x => 2*(x + 1) <= WArray.size => + get16 (set16 t x w) y = if y = x then w else get16 t y. + proof. + move=> hx hs; rewrite set16E !get16E. + case: (y = x) => [-> | hne]. + + rewrite -(W2u8.unpack8K w);congr. + apply W2u8.Pack.ext_eq => k hk; rewrite W2u8.get_unpack8 1:// W2u8.Pack.initiE //= initiE //= /#. + congr; apply W2u8.Pack.init_ext => k hk /=; rewrite initE. + by case: (0 <= 2 * y + k < WArray.size) => [ /# | /get_out ->]. + qed. + + lemma get8_set32E t x y w : + 0 <= x => 4*(x + 1) <= WArray.size => + get8 (set32 t x w) y = if 4*x <= y < 4*(x+1) then w \bits8 (y - 4*x) else get8 t y. + proof. + move=> hx hs; rewrite set32E /get8. + case: (4 * x <= y < 4 * (x + 1)) => hy. + + by rewrite initiE 1:/# /= hy. + case: (0 <= y < WArray.size) => hy1; last by rewrite !get_out. + rewrite initiE //= /#. + qed. + + lemma get_set32E t x y w: + 0 <= x => 4*(x + 1) <= WArray.size => + get32 (set32 t x w) y = if y = x then w else get32 t y. + proof. + move=> hx hs; rewrite set32E !get32E. + case: (y = x) => [-> | hne]. + + rewrite -(W4u8.unpack8K w);congr. + apply W4u8.Pack.ext_eq => k hk; rewrite W4u8.get_unpack8 //= W4u8.Pack.initiE //= initiE /#. + congr; apply W4u8.Pack.init_ext => k hk /=; rewrite initE. + by case: (0 <= 4 * y + k < WArray.size) => [ /# | /get_out ->]. + qed. + + lemma get8_set64E t x y w : + 0 <= x => 8*(x + 1) <= WArray.size => + get8 (set64 t x w) y = if 8*x <= y < 8*(x+1) then w \bits8 (y - 8*x) else get8 t y. + proof. + move=> hx hs; rewrite set64E /get8. + case: (8 * x <= y < 8 * (x + 1)) => hy. + + by rewrite initiE 1:/# /= hy. + case: (0 <= y < WArray.size) => hy1; last by rewrite !get_out. + rewrite initiE //= /#. + qed. + + lemma get_set64E t x y w: + 0 <= x => 8*(x + 1) <= WArray.size => + get64 (set64 t x w) y = if y = x then w else get64 t y. + proof. + move=> hx hs; rewrite set64E !get64E. + case: (y = x) => [-> | hne]. + + rewrite -(W8u8.unpack8K w);congr. + apply W8u8.Pack.ext_eq => k hk; rewrite W8u8.get_unpack8 //= W8u8.Pack.initiE //= initiE /#. + congr; apply W8u8.Pack.init_ext => k hk /=; rewrite initE. + by case: (0 <= 8 * y + k < WArray.size) => [ /# | /get_out ->]. + qed. + + lemma get8_set128E t x y w : + 0 <= x => 16*(x + 1) <= WArray.size => + get8 (set128 t x w) y = if 16*x <= y < 16*(x+1) then w \bits8 (y - 16*x) else get8 t y. + proof. + move=> hx hs; rewrite set128E /get8. + case: (16 * x <= y < 16 * (x + 1)) => hy. + + by rewrite initiE 1:/# /= hy. + case: (0 <= y < WArray.size) => hy1; last by rewrite !get_out. + rewrite initiE //= /#. + qed. + + lemma get_set128E t x y w: + 0 <= x => 16*(x + 1) <= WArray.size => + get128 (set128 t x w) y = if y = x then w else get128 t y. + proof. + move=> hx hs; rewrite set128E !get128E. + case: (y = x) => [-> | hne]. + + rewrite -(W16u8.unpack8K w);congr. + apply W16u8.Pack.ext_eq => k hk; rewrite W16u8.get_unpack8 //= W16u8.Pack.initiE //= initiE /#. + congr; apply W16u8.Pack.init_ext => k hk /=; rewrite initE. + by case: (0 <= 16 * y + k < WArray.size) => [ /# | /get_out ->]. + qed. + + lemma get8_set256E t x y w : + 0 <= x => 32*(x + 1) <= WArray.size => + get8 (set256 t x w) y = if 32*x <= y < 32*(x+1) then w \bits8 (y - 32*x) else get8 t y. + proof. + move=> hx hs; rewrite set256E /get8. + case: (32 * x <= y < 32 * (x + 1)) => hy. + + by rewrite initiE 1:/# /= hy. + case: (0 <= y < WArray.size) => hy1; last by rewrite !get_out. + rewrite initiE //= /#. + qed. + + lemma get_set256E t x y w: + 0 <= x => 32*(x + 1) <= WArray.size => + get256 (set256 t x w) y = if y = x then w else get256 t y. + proof. + move=> hx hs; rewrite set256E !get256E. + case: (y = x) => [-> | hne]. + + rewrite -(W32u8.unpack8K w);congr. + apply W32u8.Pack.ext_eq => k hk; rewrite W32u8.get_unpack8 //= W32u8.Pack.initiE //= initiE /#. + congr; apply W32u8.Pack.init_ext => k hk /=; rewrite initE. + by case: (0 <= 32 * y + k < WArray.size) => [ /# | /get_out ->]. + qed. + + hint simplify get_set8E, get8_set16E, get_set16E, + get8_set32E, get_set32E, + get8_set64E, get_set64E, + get8_set128E, get_set128E, + get8_set256E, get_set256E. + + (* ------------------------------------------------- *) + + op init8 (f:int -> W8.t) = + init f. + + op init16 (f:int -> W16.t) = + init (fun i => f (i %/ 2) \bits8 (i%%2)). + + op init32 (f:int -> W32.t) = + init (fun i => f (i %/ 4) \bits8 (i%%4)). + + op init64 (f:int -> W64.t) = + init (fun i => f (i %/ 8) \bits8 (i%%8)). + + op init128 (f:int -> W128.t) = + init (fun i => f (i %/ 16) \bits8 (i%%16)). + + op init256 (f:int -> W256.t) = + init (fun i => f (i %/ 32) \bits8 (i%%32)). + +end WArray. + +(*clone export WArray as WArray0 with op size <- 0. +clone export WArray as WArray1 with op size <- 1. +clone export WArray as WArray2 with op size <- 2. +clone export WArray as WArray3 with op size <- 3. +clone export WArray as WArray4 with op size <- 4. +clone export WArray as WArray5 with op size <- 5. +clone export WArray as WArray6 with op size <- 6. +clone export WArray as WArray7 with op size <- 7. +clone export WArray as WArray8 with op size <- 8. +clone export WArray as WArray9 with op size <- 9. + +clone export WArray as WArray10 with op size <- 10. +clone export WArray as WArray11 with op size <- 11. +clone export WArray as WArray12 with op size <- 12. +clone export WArray as WArray13 with op size <- 13. +clone export WArray as WArray14 with op size <- 14. +clone export WArray as WArray15 with op size <- 15. +clone export WArray as WArray16 with op size <- 16. +clone export WArray as WArray17 with op size <- 17. +clone export WArray as WArray18 with op size <- 18. +clone export WArray as WArray19 with op size <- 19. + +clone export WArray as WArray20 with op size <- 20. +clone export WArray as WArray21 with op size <- 21. +clone export WArray as WArray22 with op size <- 22. +clone export WArray as WArray23 with op size <- 23. +clone export WArray as WArray24 with op size <- 24. +clone export WArray as WArray25 with op size <- 25. +clone export WArray as WArray26 with op size <- 26. +clone export WArray as WArray27 with op size <- 27. +clone export WArray as WArray28 with op size <- 28. +clone export WArray as WArray29 with op size <- 29. + +clone export WArray as WArray30 with op size <- 30. +clone export WArray as WArray31 with op size <- 31. +clone export WArray as WArray32 with op size <- 32. +clone export WArray as WArray33 with op size <- 33. +clone export WArray as WArray34 with op size <- 34. +clone export WArray as WArray35 with op size <- 35. +clone export WArray as WArray36 with op size <- 36. +clone export WArray as WArray37 with op size <- 37. +clone export WArray as WArray38 with op size <- 38. +clone export WArray as WArray39 with op size <- 39. + +clone export WArray as WArray40 with op size <- 40. +clone export WArray as WArray41 with op size <- 41. +clone export WArray as WArray42 with op size <- 42. +clone export WArray as WArray43 with op size <- 43. +clone export WArray as WArray44 with op size <- 44. +clone export WArray as WArray45 with op size <- 45. +clone export WArray as WArray46 with op size <- 46. +clone export WArray as WArray47 with op size <- 47. +clone export WArray as WArray48 with op size <- 48. +clone export WArray as WArray49 with op size <- 49. +*) + + + \ No newline at end of file diff --git a/proof/impl/Spec.ec b/proof/impl/Spec.ec new file mode 100644 index 0000000..c96038b --- /dev/null +++ b/proof/impl/Spec.ec @@ -0,0 +1,38 @@ +require import AllCore List Int IntDiv. +require import JArray JMemory JModel JUtils JWord JWord_array. +require import Sponge. + +clone export PolyArray as Array25 with op size <- 25. + +op memr2bits : global_mem_t -> int -> int -> bool list. +op eqmem_except : global_mem_t -> global_mem_t -> int -> int -> bool. +op state2bc : W64.t Array25.t -> Common.block * Common.capacity. + +module type PermT = { + proc perm(st : W64.t Array25.t) : W64.t Array25.t +}. + +module Spec(P : PermT) = { + proc f(out : int, outlen : int, inp : int, inlen : int) = { + (* ref impl goes here *) + } +}. + +section. + +declare module Pideal : DPRIMITIVE. +declare module Preal : PermT. + +axiom perm_correct : +equiv [Pideal.f ~ Preal.perm : + x{1} = state2bc st{2} ==> res{1} = state2bc res{2}]. + +lemma spec_correct mem outp outl: +equiv [ Sponge(Pideal).f ~ Spec(Preal).f : + Glob.mem{2} = mem /\ bs{1} = memr2bits mem inp{2} inlen{2} /\ + out{2} = outp /\ outlen{2} = outl /\ outl = n{1} %/ 8 /\ outl %% 8 = 0 + ==> eqmem_except mem Glob.mem{2} outp outl /\ + res{1} = memr2bits Glob.mem{2} outp outl]. +admitted. + +end section. From 710c0f061382bfcf2e377ee1f82f5b155c6edff8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Wed, 10 Apr 2019 15:40:13 +0100 Subject: [PATCH 333/525] Common.ec --- proof/Common.ec | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/proof/Common.ec b/proof/Common.ec index 65f6c06..e02a614 100644 --- a/proof/Common.ec +++ b/proof/Common.ec @@ -74,7 +74,7 @@ have // : 2 < 2 by rewrite (@ler_lt_trans m). qed. lemma chunk_nil' ['a] r : BitChunking.chunk r [<:'a>] = []. -proof. by rewrite /chunk /= div0z mkseq0. qed. +proof. by rewrite /chunk /= mkseq0. qed. lemma chunk_sing' r (xs : bool list) : 0 < r => size xs = r => BitChunking.chunk r xs = [xs]. @@ -274,7 +274,7 @@ lemma size_pad_dvd_r s : r %| size (pad s). proof. by rewrite size_pad dvdzD 1:dvdz_mull dvdzz. qed. lemma dvd_r_num0 (m : int) : r %| (m + num0 m + 2). -proof. by rewrite /num0 /(%|) addrAC modzDmr subrr mod0z. qed. +proof. by rewrite /num0 /(%|) addrAC modzDmr subrr. qed. lemma num0_ge0 (m : int) : 0 <= num0 m. proof. by rewrite /num0 modz_ge0 ?gtr_eqF ?gt0_r. qed. @@ -328,12 +328,12 @@ have lt_is: i < size s by rewrite ltr_neqAle ne_is -size_rev index_size. have [ge0_i lt_siz_s_i] : 0 <= i < size s. have le_siz_s_i : i <= size s by rewrite /i - size_rev index_size. split=> [| _]; [rewrite index_ge0 | rewrite ltr_neqAle //]. -pose j := (size s + _ - _); case: (i = (-(j + 2)) %% r) => // iE. +pose j := (size s + _ - _); case: (i = (-(j + 2)) %% r)=> iE; 2:done. (* => // iE. Loops in deploy-kms *) apply/eq_sym; rewrite -{1}(@cat_take_drop j (rcons _ _)); congr. have jE: j = size s - (i + 1) by rewrite /j #ring. have [ge0_j lt_js]: 0 <= j < size s by move=> /#. rewrite -cats1 drop_cat lt_js /= /mkpad -cats1 -cat_cons; congr=> //=. -rewrite size_take // size_cat /= ltr_spsaddr //= -iE. +rewrite size_take // size_cat /= ltr_spsaddr //= /num0 -iE. have sz_js: size (drop j s) = i+1; last apply/(eq_from_nth false). + by rewrite size_drop //= max_ler ?subr_ge0 ?ltrW // /j #ring. + by rewrite sz_js /= addrC size_nseq max_ler. @@ -376,7 +376,7 @@ lemma chunkK bs : r %| size bs => flatten (chunk bs) = bs. proof. by apply/BitChunking.chunkK/gt0_r. qed. lemma chunk_nil : chunk [] = []. -proof. by apply/chunk_nil'. qed. +proof. by apply/(@chunk_nil' r). qed. lemma chunk_sing (xs : bool list) : size xs = r => chunk xs = [xs]. proof. by apply/chunk_sing'/gt0_r. qed. From 7dc40bb0c3b6f9c7333921c72d7a17bcbb9422ed Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Wed, 10 Apr 2019 18:48:24 +0200 Subject: [PATCH 334/525] proof of collision probability of SHA3 --- proof/IndifRO_is_secure.ec | 124 +++ proof/{SHA3-Security.ec => SHA3Indiff.ec} | 13 +- proof/SHA3Security.ec | 479 ++++++++++++ proof/SecureRO.eca | 873 ++++++++++++---------- 4 files changed, 1085 insertions(+), 404 deletions(-) create mode 100644 proof/IndifRO_is_secure.ec rename proof/{SHA3-Security.ec => SHA3Indiff.ec} (97%) create mode 100644 proof/SHA3Security.ec diff --git a/proof/IndifRO_is_secure.ec b/proof/IndifRO_is_secure.ec new file mode 100644 index 0000000..1abde7d --- /dev/null +++ b/proof/IndifRO_is_secure.ec @@ -0,0 +1,124 @@ +require import AllCore Distr SmtMap. +require (****) SecureRO Indifferentiability. + + +type block. +type f_in. +type f_out. + +op sampleto : f_out distr. +axiom sampleto_ll : is_lossless sampleto. +axiom sampleto_fu : is_funiform sampleto. +axiom sampleto_full : is_full sampleto. + +op limit : int. +axiom limit_gt0 : 0 < limit. + +op bound : real. + + +op bound_counter : int. +axiom bound_counter_ge0 : 0 <= bound_counter. + +op increase_counter : int -> f_in -> int. +axiom increase_counter_spec c m : c <= increase_counter c m. + + +clone import SecureRO as SRO with + type from <- f_in, + type to <- f_out, + + op bound <- limit, + op sampleto <- sampleto, + op increase_counter <- increase_counter, + op bound_counter <- bound_counter + + proof * by smt(sampleto_fu sampleto_ll sampleto_full limit_gt0 + increase_counter_spec bound_counter_ge0). + + +clone import Indifferentiability as Indiff0 with + type p <- block, + type f_in <- f_in, + type f_out <- f_out. + +module RO : FUNCTIONALITY = { + proc init = SRO.RO.RO.init + proc f = SRO.RO.RO.get +}. + +module FInit (F : DFUNCTIONALITY) = { + proc init () = {} + proc get = F.f + proc f = F.f + proc set (a : f_in, b: f_out) = {} + proc sample (a: f_in) = {} + proc rem (a : f_in) = {} +}. + +module GetF (F : SRO.RO.RO) = { + proc init = F.init + proc f = F.get +}. + +module SInit (F : SRO.RO.RO) (S : SIMULATOR) = { + proc init() = { + S(GetF(F)).init(); + F.init(); + } + proc get = F.get + proc set = F.set + proc rem = F.rem + proc sample = F.sample +}. + +module FM (C : CONSTRUCTION) (P : PRIMITIVE) = { + proc init () = { + P.init(); + C(P).init(); + } + proc get = C(P).f + proc f = C(P).f + proc set (a : f_in, b: f_out) = {} + proc sample (a: f_in) = {} + proc rem (a : f_in) = {} +}. + +module D (A : AdvCollision) (F : DFUNCTIONALITY) (P : DPRIMITIVE) = { + proc distinguish = Collision(A,FInit(F)).main +}. + +section Proof. + + declare module A : AdvCollision{Bounder, SRO.RO.RO, SRO.RO.FRO}. + + axiom D_ll (F <: Oracle) : + islossless F.get => islossless A(F).guess. + + lemma coll_resistant_if_indifferentiable + (C <: CONSTRUCTION{A, Bounder}) + (P <: PRIMITIVE{C, A, Bounder}) &m : + (exists (S <: SIMULATOR{Bounder, A}), + (forall (F <: FUNCTIONALITY), islossless F.f => islossless S(F).init) /\ + `|Pr[GReal(C,P,D(A)).main() @ &m : res] - + Pr[GIdeal(RO,S,D(A)).main() @ &m : res]| <= bound) => + Pr[Collision(A,FM(C,P)).main() @ &m : res] <= + bound + ((limit * (limit - 1) + 2)%r / 2%r * mu1 sampleto witness). + proof. + move=>[] S [] S_ll Hbound. + cut->: Pr[Collision(A, FM(C,P)).main() @ &m : res] = + Pr[GReal(C, P, D(A)).main() @ &m : res]. + + byequiv=>//=; proc; inline*; wp; sim. + by swap{1} [1..2] 2; sim. + cut/#:Pr[GIdeal(RO, S, D(A)).main() @ &m : res] <= + (limit * (limit - 1) + 2)%r / 2%r * mu1 sampleto witness. + cut->:Pr[GIdeal(RO, S, D(A)).main() @ &m : res] = + Pr[Collision(A, SRO.RO.RO).main() @ &m : res]. + + byequiv=>//=; proc; inline D(A, RO, S(RO)).distinguish; wp; sim. + inline*; swap{2} 1 1; wp. + call{1} (S_ll RO); auto. + by proc; auto; smt(sampleto_ll). + exact(RO_is_collision_resistant A &m). + qed. + +end section Proof. \ No newline at end of file diff --git a/proof/SHA3-Security.ec b/proof/SHA3Indiff.ec similarity index 97% rename from proof/SHA3-Security.ec rename to proof/SHA3Indiff.ec index f13740c..56fad44 100644 --- a/proof/SHA3-Security.ec +++ b/proof/SHA3Indiff.ec @@ -1,5 +1,3 @@ -(* Top-level Proof of SHA-3 Security *) - require import AllCore List IntDiv StdOrder Distr SmtMap FSet. require import Common Sponge. import BIRO. @@ -303,7 +301,13 @@ cut//=:=(Gconcl_list.Real_Ideal (LowerDist(Dist)) _ &m). cut hf:islossless RaiseFun(F).f. - proc;call hf';auto. exact(Dist_lossless (RaiseFun(F)) P hp hpi hf). -by rewrite(drestr_commute1 &m) (drestr_commute2 &m);smt(). +rewrite(drestr_commute1 &m) (drestr_commute2 &m). +cut->:=Gconcl_list.Simplify_simulator (LowerDist(Dist)) _ &m. ++ move=>F P hp hpi hf'//=. + cut hf:islossless RaiseFun(F).f. + - proc;call hf';auto. + exact(Dist_lossless (RaiseFun(F)) P hp hpi hf). +smt(). qed. @@ -311,7 +315,7 @@ qed. end section. -lemma SHA3Security +lemma SHA3Indiff (Dist <: DISTINGUISHER{ Perm, IRO, BlockSponge.BIRO.IRO, Cntr, Simulator, Gconcl_list.SimLast(Gconcl.S), BlockSponge.C, Gconcl.S, @@ -329,4 +333,3 @@ lemma SHA3Security (limit ^ 2 - limit)%r / (2 ^ (r + c + 1))%r + (4 * limit ^ 2)%r / (2 ^ c)%r. proof. move=>h;apply (security Dist h &m). qed. - diff --git a/proof/SHA3Security.ec b/proof/SHA3Security.ec new file mode 100644 index 0000000..6519085 --- /dev/null +++ b/proof/SHA3Security.ec @@ -0,0 +1,479 @@ +(* Top-level Proof of SHA-3 Security *) + +require import AllCore Distr DList DBool List IntExtra IntDiv Dexcepted DProd SmtMap FSet. +require import Common SLCommon Sponge SHA3Indiff. +require (****) IndifRO_is_secure. + + +op size_out : int. +axiom size_out_gt0 : 0 < size_out. + +op sigma : int. +axiom sigma_gt0 : 0 < sigma. + +type f_out. + +op dout : f_out distr. +axiom dout_ll : is_lossless dout. +axiom dout_fu : is_funiform dout. +axiom dout_full : is_full dout. + + +op to_list : f_out -> bool list. +op of_list : bool list -> f_out option. +axiom spec_dout (l : f_out) : size (to_list l) = size_out. +axiom spec2_dout (l : bool list) : size l = size_out => of_list l <> None. +axiom to_list_inj : injective to_list. +axiom to_listK e l : to_list e = l <=> of_list l = Some e. + +axiom dout_equal_dlist : dmap dout to_list = dlist dbool size_out. + +module CSetSize (F : CONSTRUCTION) (P : DPRIMITIVE) = { + proc init = F(P).init + proc f (x : bool list) = { + var r; + r <@ F(P).f(x,size_out); + return oget (of_list r); + } +}. + +module FSetSize (F : FUNCTIONALITY) = { + proc init = F.init + proc f (x : bool list) = { + var r; + r <@ F.f(x,size_out); + return oget (of_list r); + } +}. + +clone import IndifRO_is_secure as S with + type block <- block * capacity, + type f_in <- bool list, + type f_out <- f_out, + + op sampleto <- dout, + op bound <- (limit ^ 2 - limit)%r / (2 ^ (r + c + 1))%r + + (4 * limit ^ 2)%r / (2 ^ c)%r, + op limit <- sigma, + op bound_counter <- limit, + op increase_counter <- fun c m => c + ((size m + 1) %/ r + 1) + + max ((size_out + r - 1) %/ r - 1) 0 + + proof *. + + +realize bound_counter_ge0 by exact(SLCommon.max_ge0). +realize limit_gt0 by exact(sigma_gt0). +realize sampleto_ll by exact(dout_ll). +realize sampleto_fu by exact(dout_fu). +realize sampleto_full by exact(dout_full). +realize increase_counter_spec by smt(List.size_ge0 divz_ge0 gt0_r). + +module FGetSize (F : Indiff0.DFUNCTIONALITY) = { + proc f (x : bool list, i : int) = { + var r; + r <@ F.f(x); + return to_list r; + } +}. + +module SimSetSize (S : SIMULATOR) (F : Indiff0.DFUNCTIONALITY) = S(FGetSize(F)). + +module DFSetSize (F : DFUNCTIONALITY) = { + proc f (x : bool list) = { + var r; + r <@ F.f(x,size_out); + return oget (of_list r); + } +}. + +module (DSetSize (D : Indiff0.DISTINGUISHER) : DISTINGUISHER) + (F : DFUNCTIONALITY) (P : DPRIMITIVE) = D(DFSetSize(F),P). + + +section Collision. + + declare module A : SRO.AdvCollision{SRO.RO.RO, SRO.RO.FRO, SRO.Bounder, Perm, + Gconcl_list.BIRO2.IRO, Simulator, Cntr, BIRO.IRO, F.RO, F.FRO, Redo, C, + Gconcl.S, BlockSponge.BIRO.IRO, BlockSponge.C, Gconcl_list.F2.RO, + Gconcl_list.F2.FRO, Gconcl_list.Simulator}. + + axiom A_ll (F <: SRO.Oracle) : islossless F.get => islossless A(F).guess. + + local lemma invm_dom_rng (m mi : (state, state) fmap) : + invm m mi => dom m = rng mi. + proof. + move=>h; rewrite fun_ext=> x; rewrite domE rngE /= eq_iff; have h2 := h x; split. + + move=> m_x_not_None; exists (oget m.[x]); rewrite -h2; move: m_x_not_None. + by case: (m.[x]). + by move=> [] a; rewrite -h2 => ->. + qed. + + local lemma invmC' (m mi : (state, state) fmap) : + invm m mi => invm mi m. + proof. by rewrite /#. qed. + + local lemma invmC (m mi : (state, state) fmap) : + invm m mi <=> invm mi m. + proof. by split;exact invmC'. qed. + + local lemma useful m mi a : + invm m mi => ! a \in m => Distr.is_lossless ((bdistr `*` cdistr) \ rng m). + proof. + move=>hinvm nin_dom. + cut prod_ll:Distr.is_lossless (bdistr `*` cdistr). + + by rewrite dprod_ll DBlock.dunifin_ll DCapacity.dunifin_ll. + apply dexcepted_ll=>//=;rewrite-prod_ll. + cut->:predT = predU (predC (rng m)) (rng m);1:rewrite predCU//=. + rewrite Distr.mu_disjoint 1:predCI//=StdRing.RField.addrC. + cut/=->:=StdOrder.RealOrder.ltr_add2l (mu (bdistr `*` cdistr) (rng m)) 0%r. + rewrite Distr.witness_support/predC. + move:nin_dom;apply absurd=>//=;rewrite negb_exists/==>hyp. + cut{hyp}hyp:forall x, rng m x by smt(supp_dprod DBlock.supp_dunifin DCapacity.supp_dunifin). + move:a. + cut:=eqEcard (fdom m) (frng m);rewrite leq_card_rng_dom/=. + cut->//=:fdom m \subset frng m. + + by move=> x; rewrite mem_fdom mem_frng hyp. + smt(mem_fdom mem_frng). + qed. + + + local equiv equiv_sponge_perm c m : + FInit(CSetSize(Sponge, Perm)).get ~ FInit(DFSetSize(FC(Sponge(Perm)))).get : + ={arg, glob Perm} /\ invm Perm.m{1} Perm.mi{1} /\ + Cntr.c{2} = c /\ arg{2} = m /\ + (Cntr.c + ((size arg + 1) %/ Common.r + 1) + + max ((size_out + Common.r - 1) %/ Common.r - 1) 0 <= limit){2} ==> + ={res, glob Perm} /\ invm Perm.m{1} Perm.mi{1} /\ + Cntr.c{2} = c + ((size m + 1) %/ Common.r + 1) + + max ((size_out + Common.r - 1) %/ Common.r - 1) 0. + proof. + proc; inline FC(Sponge(Perm)).f; sp. + rcondt{2} 1; auto; sp. + call(: ={glob Perm} /\ invm Perm.m{1} Perm.mi{1})=>/=; auto; inline*. + while(={i, n, sa, sc, z, glob Perm} /\ invm Perm.m{1} Perm.mi{1}); auto. + + sp; if; auto; sp; if; auto; progress. + rewrite invm_set //=. + by move:H4; rewrite supp_dexcepted. + sp; conseq(:_==> ={i, n, sa, sc, glob Perm} /\ invm Perm.m{1} Perm.mi{1}); auto. + while(={xs, sa, sc, glob Perm} /\ invm Perm.m{1} Perm.mi{1}); auto. + sp; if; auto; progress. + rewrite invm_set=>//=. + by move:H4; rewrite supp_dexcepted. + qed. + + + op same_ro (m1 : (bool list, f_out) fmap) (m2 : (bool list * int, bool) fmap) = + (forall m, m \in m1 => forall i, 0 <= i < size_out => (m,i) \in m2) + && (forall m, (exists i, 0 <= i < size_out /\ (m,i) \in m2) => m \in m1) + && (forall m, m \in m1 => to_list (oget m1.[m]) = map (fun i => oget m2.[(m,i)]) (range 0 size_out)). + + op same_ro2 (m1 : (bool list, bool list) fmap) (m2 : (bool list * int, bool) fmap) = + (forall m, m \in m1 => forall i, 0 <= i < size_out => (m,i) \in m2) + && (forall m, (exists i, 0 <= i < size_out /\ (m,i) \in m2) => m \in m1) + && (forall m, m \in m1 => oget m1.[m] = map (fun i => oget m2.[(m,i)]) (range 0 size_out)). + + clone import Program as Prog with + type t <- bool, + op d <- dbool + proof *. + + local equiv equiv_ro_iro c m : + FInit(RO).get ~ FInit(DFSetSize(FC(BIRO.IRO))).get : + ={arg} /\ same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2} /\ + arg{2} = m /\ Cntr.c{2} = c /\ + (Cntr.c + ((size arg + 1) %/ Common.r + 1) + + max ((size_out + Common.r - 1) %/ Common.r - 1) 0 <= limit){2} + ==> ={res} /\ same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2} /\ + Cntr.c{2} = c + ((size m + 1) %/ Common.r + 1) + + max ((size_out + Common.r - 1) %/ Common.r - 1) 0. + proof. + proc; inline *; sp; rcondt{2} 1; 1: auto. + swap{2} 1 5; sp; wp 2 1. + conseq(:_==> oget SRO.RO.RO.m{1}.[x{1}] = oget (of_list bs0{2}) /\ + same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2}); 1:by auto. + rcondt{2} 1; 1: auto. + case: (x{1} \in SRO.RO.RO.m{1}). + + rcondf{1} 2; auto. + exists* BIRO.IRO.mp{2}; elim* => mp. + while{2}(bs0{2} = map (fun j => oget BIRO.IRO.mp{2}.[(x0{2},j)]) (range 0 i{2}) + /\ n0{2} = size_out /\ x0{2} \in SRO.RO.RO.m{1} /\ 0 <= i{2} <= size_out + /\ same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2} /\ BIRO.IRO.mp{2} = mp) + (size_out - i{2}); auto. + - sp; rcondf 1; auto; 1: smt(). + progress. + * have/=<-:= map_rcons (fun (j : int) => oget BIRO.IRO.mp{hr}.[(x0{hr}, j)]) (range 0 i{hr}) i{hr}. + by rewrite !rangeSr //=. + * smt(). + * smt(). + * smt(). + progress. + - by rewrite range_geq. + - smt(size_out_gt0). + - smt(). + - exact(dout_ll). + - have[] h[#] h1 h2 := H. + cut->:i_R = size_out by smt(). + cut<-:=h2 _ H3. + smt(to_listK). + rcondt{1} 2; 1: auto; wp =>/=. + exists* BIRO.IRO.mp{2}; elim* => mp. + conseq(:_==> + same_ro SRO.RO.RO.m{1} mp /\ i{2} = size_out /\ + (forall (l,j), (l,j) \in mp => (l,j) \in BIRO.IRO.mp{2}) /\ + (forall (l,j), (l,j) \in mp => BIRO.IRO.mp{2}.[(l,j)] = mp.[(l,j)]) /\ + (forall (l,j), (l,j) \in BIRO.IRO.mp{2} => (l,j) \in mp \/ (l = x0{2} /\ 0 <= j < i{2})) /\ + (forall j, 0 <= j < i{2} => (x0{2},j) \in BIRO.IRO.mp{2}) /\ + take i{2} (to_list r{1}) = bs0{2} /\ + take i{2} (to_list r{1}) = map (fun (j : int) => oget BIRO.IRO.mp{2}.[(x0{2}, j)]) (range 0 i{2})); progress=>//=. + + by rewrite get_set_sameE /= oget_some; smt(to_listK take_oversize spec_dout). + + move:H8; rewrite mem_set=>[][]//=h; 1:rewrite H3=>//=. + - by have []h1 []h2 h3:= H2; have->//:=h1 _ h. + by move:h => <<-; rewrite H6 //=. + + rewrite mem_set//=; have[]//=h:= H5 _ _ H11; left. + have []h1 []->//=:= H2. + by exists i0=>//=. + + move:H7; rewrite take_oversize 1:spec_dout//= => H7. + move:H10; rewrite mem_set. + case(m \in SRO.RO.RO.m{1})=>//=h. + - rewrite get_set_neqE; 1:smt(). + have []h1 []h2 ->//=:= H2. + by apply eq_in_map=> j;rewrite mem_range=>[][]hj1 hj2/=; rewrite H4//=h1//=. + by move=><<-; rewrite get_set_eqE//=. + alias{1} 1 l = [<:bool>]. + transitivity{1} { + l <@ Sample.sample(size_out); + r <- oget (of_list l); + } + (={glob SRO.RO.RO, x} ==> ={glob SRO.RO.RO, r}) + (x{1} = x0{2} /\ i{2} = 0 /\ n0{2} = size_out /\ mp = BIRO.IRO.mp{2} /\ + same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2} /\ x{1} \notin SRO.RO.RO.m{1} /\ + bs0{2} = [] + ==> + same_ro SRO.RO.RO.m{1} mp /\ i{2} = size_out /\ + (forall (l,j), (l,j) \in mp => (l,j) \in BIRO.IRO.mp{2}) /\ + (forall (l,j), (l,j) \in mp => BIRO.IRO.mp{2}.[(l,j)] = mp.[(l,j)]) /\ + (forall (l,j), (l,j) \in BIRO.IRO.mp{2} => (l,j) \in mp \/ (l = x0{2} /\ 0 <= j < i{2})) /\ + (forall j, 0 <= j < i{2} => (x0{2},j) \in BIRO.IRO.mp{2}) /\ + take i{2} (to_list r{1}) = bs0{2} /\ + take i{2} (to_list r{1}) = + map (fun (j : int) => oget BIRO.IRO.mp{2}.[(x0{2}, j)]) (range 0 i{2})); + progress. + + smt(). + + inline*; sp; wp. + rnd to_list (fun x => oget (of_list x)); auto; progress. + - smt(spec_dout supp_dlist to_listK spec2_dout size_out_gt0). search dout. + - rewrite -dout_equal_dlist dmap1E; apply mu_eq=> x/=. + smt(to_listK). + - rewrite-dout_equal_dlist supp_dmap; smt(dout_full). + smt(to_listK). + wp=>/=. + conseq(:_==> i{2} = size_out /\ size l{1} = size_out /\ + (forall (l0 : bool list) (j : int), + (l0, j) \in mp => (l0, j) \in BIRO.IRO.mp{2}) /\ + (forall (l0 : bool list) (j : int), + (l0, j) \in mp => BIRO.IRO.mp{2}.[(l0, j)] = mp.[(l0, j)]) /\ + (forall (l0 : bool list) (j : int), + (l0, j) \in BIRO.IRO.mp{2} => ((l0, j) \in mp) \/ (l0 = x0{2} /\ 0 <= j < i{2})) /\ + (forall (j : int), 0 <= j < i{2} => (x0{2}, j) \in BIRO.IRO.mp{2}) /\ + take i{2} l{1} = bs0{2} /\ + take i{2} l{1} = + map (fun (j : int) => oget BIRO.IRO.mp{2}.[(x0{2}, j)]) (range 0 i{2})); + progress. + + have[]//=h h1:=to_listK (oget (of_list l_L)) l_L; rewrite h1//==> {h1 h}. + smt(spec2_dout). + + have[]//=h h1:=to_listK (oget (of_list l_L)) l_L; rewrite h1//==> {h1 h}. + smt(spec2_dout). print Prog. + transitivity{1} { + l <@ LoopSnoc.sample(size_out); + } + (={glob SRO.RO.RO} ==> ={glob SRO.RO.RO, l}) + (x{1} = x0{2} /\ i{2} = 0 /\ n0{2} = size_out /\ mp = BIRO.IRO.mp{2} /\ + same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2} /\ x0{2} \notin SRO.RO.RO.m{1} /\ + bs0{2} = [] + ==> + i{2} = size_out /\ size l{1} = size_out /\ + (forall (l,j), (l,j) \in mp => (l,j) \in BIRO.IRO.mp{2}) /\ + (forall (l,j), (l,j) \in mp => BIRO.IRO.mp{2}.[(l,j)] = mp.[(l,j)]) /\ + (forall (l,j), (l,j) \in BIRO.IRO.mp{2} => (l,j) \in mp \/ (l = x0{2} /\ 0 <= j < i{2})) /\ + (forall j, 0 <= j < i{2} => (x0{2},j) \in BIRO.IRO.mp{2}) /\ + take i{2} l{1} = bs0{2} /\ + take i{2} l{1} = + map (fun (j : int) => oget BIRO.IRO.mp{2}.[(x0{2}, j)]) (range 0 i{2})); + progress. + + smt(). + + by call Sample_LoopSnoc_eq; auto. + inline*; sp; wp. + conseq(:_==> i{2} = size_out /\ size l0{1} = i{2} /\ + same_ro SRO.RO.RO.m{1} mp /\ x0{2} \notin SRO.RO.RO.m{1} /\ + (forall l j, (l,j) \in mp => (l,j) \in BIRO.IRO.mp{2}) /\ + (forall l j, (l,j) \in mp => BIRO.IRO.mp{2}.[(l, j)] = mp.[(l, j)]) /\ + (forall l j, (l, j) \in BIRO.IRO.mp{2} => ((l, j) \in mp) \/ (l = x0{2} /\ 0 <= j < i{2})) /\ + (forall j, 0 <= j < i{2} => (x0{2}, j) \in BIRO.IRO.mp{2}) /\ + l0{1} = bs0{2} /\ bs0{2} = + map (fun (j : int) => oget BIRO.IRO.mp{2}.[(x0{2}, j)]) (range 0 i{2})); progress. + + smt(take_oversize). + + smt(take_oversize). + while(0 <= i{2} <= size_out /\ size l0{1} = i{2} /\ n0{2} = size_out /\ + ={i} /\ n{1} = n0{2} /\ + same_ro SRO.RO.RO.m{1} mp /\ x0{2} \notin SRO.RO.RO.m{1} /\ + (forall l j, (l,j) \in mp => (l,j) \in BIRO.IRO.mp{2}) /\ + (forall l j, (l,j) \in mp => BIRO.IRO.mp{2}.[(l, j)] = mp.[(l, j)]) /\ + (forall l j, (l, j) \in BIRO.IRO.mp{2} => ((l, j) \in mp) \/ (l = x0{2} /\ 0 <= j < i{2})) /\ + (forall j, 0 <= j < i{2} => (x0{2}, j) \in BIRO.IRO.mp{2}) /\ + l0{1} = bs0{2} /\ bs0{2} = + map (fun (j : int) => oget BIRO.IRO.mp{2}.[(x0{2}, j)]) (range 0 i{2})). + + sp; wp=> //=. + rcondt{2} 1; 1:auto; progress. + - have[]h1 [] h2 h3 := H1. + have:=h2 x0{hr}; rewrite H2/= negb_exists/= =>/(_ (size bs0{hr})). + rewrite size_ge0 H9/=; apply absurd =>/= h. + by have //=:= H5 _ _ h. + rnd; auto; progress. + - smt(size_ge0). + - smt(). + - by rewrite size_cat/=. + - by rewrite mem_set; left; rewrite H3. + - rewrite get_setE (H4 _ _ H12). + cut/#: !(l1, j) = (x0{2}, size bs0{2}). + move:H2; apply absurd=> //=[#] <<- ->>. + have[] h1 [] h2 h3 := H1. + by apply h2; smt(). + - move:H12; rewrite mem_set. + case((l1, j) \in BIRO.IRO.mp{2})=>//= h; 1: smt(). + by move=> [#] <<- ->> //=; rewrite size_ge0; smt(). + - rewrite mem_set. + case(j = size bs0{2})=>//=. + move=> h; rewrite h /=; have {H13} H13 {h} : j < size bs0{2} by smt(). + by apply H6. + - by rewrite cats1 get_set_sameE oget_some. + - rewrite get_set_sameE oget_some H7 rangeSr. + rewrite !size_map 1:size_ge0. + rewrite (size_map _ (range 0 (size bs0{2}))) size_range /=. + rewrite max_ler 1:size_ge0 map_rcons /=get_set_sameE oget_some; congr. + apply eq_in_map=> j. + rewrite mem_range /==> [] [] hj1 hj2. + by rewrite get_set_neqE //=; smt(). + auto; progress. + + smt(size_out_gt0). + + smt(). + + smt(). + + by rewrite range_geq. + smt(). + qed. + + lemma SHA3_coll_resistant &m : + Pr[SRO.Collision(A, FM(CSetSize(Sponge), Perm)).main() @ &m : res] <= + (limit ^ 2 - limit)%r / (2 ^ (r + c + 1))%r + + (4 * limit ^ 2)%r / (2 ^ c)%r + + (sigma * (sigma - 1) + 2)%r / 2%r * mu1 dout witness. + proof. + rewrite (coll_resistant_if_indifferentiable A A_ll (CSetSize(Sponge)) Perm &m). + exists (SimSetSize(Simulator)); split. + + by move=> F _; proc; inline*; auto. + cut->:Pr[Indiff0.Indif(CSetSize(Sponge, Perm), Perm, D(A)).main() @ &m : res] = + Pr[RealIndif(Sponge, Perm, DRestr(DSetSize(D(A)))).main() @ &m : res]. + + byequiv=>//=; proc. + inline Perm.init CSetSize(Sponge, Perm).init Sponge(Perm).init + FC(Sponge(Perm)).init; sp. + inline D(A, CSetSize(Sponge, Perm), Perm).distinguish. + inline DRestr(DSetSize(D(A)), Sponge(Perm), Perm).distinguish + DSetSize(D(A), FC(Sponge(Perm)), PC(Perm)).distinguish Cntr.init; wp; sp; sim. + seq 2 2 : (={m1, m2, glob SRO.Counter, glob Perm} + /\ invm Perm.m{1} Perm.mi{1} + /\ ={c}(SRO.Counter,Cntr)); last first. + - if; auto; sp. + case(SRO.Counter.c{1} + ((size m2{1} + 1) %/ r + 1) + + max ((size_out + r - 1) %/ r - 1) 0 < limit); last first. + * rcondf{1} 2; 1: by auto; inline*; auto; conseq(: _ ==> true); auto. + rcondf{2} 2; 1: by auto; inline*; auto; conseq(: _ ==> true); auto. + auto; inline*; auto; sp; conseq(: _ ==> true); auto. + if{2}; sp; auto; sim. + while{1}(invm Perm.m{1} Perm.mi{1}) (((size_out + r - 1) %/ r)-i{1}). + + auto; sp; if; auto. + - sp; if ;auto; progress. + * exact (useful _ _ _ H H2). + * rewrite invm_set=>//=. search (\). + by move:H4; rewrite supp_dexcepted. + * smt(). + smt(). + smt(). + conseq(:_==> invm Perm.m{1} Perm.mi{1}); 1:smt(). + while{1}(invm Perm.m{1} Perm.mi{1})(size xs{1}). + + move=> _ z; auto; sp; if; auto; progress. + * exact (useful _ _ _ H H1). + * rewrite invm_set=>//=. + by move:H3; rewrite supp_dexcepted. + * smt(). + smt(). + auto; smt(size_ge0 size_eq0). + rcondt{1} 2; first by auto; inline*; auto; conseq(:_==> true); auto. + rcondt{2} 2; first by auto; inline*; auto; conseq(:_==> true); auto. + sim. + exists* m1{1}, m2{1}; elim* => a1 a2 c1 c2. + call (equiv_sponge_perm (c2 + ((size a1 + 1) %/ r + 1) + max ((size_out + r - 1) %/ r - 1) 0) a2). + auto; call (equiv_sponge_perm c2 a1); auto; progress. + smt(List.size_ge0 divz_ge0 gt0_r). + smt(List.size_ge0 divz_ge0 gt0_r). + call(: ={glob SRO.Counter, glob Perm, glob SRO.Bounder} + /\ invm Perm.m{1} Perm.mi{1} /\ ={c}(SRO.Counter,Cntr)). + + proc; sp; if; auto; sp; if; auto; sp. + exists * x{1}; elim* => m c1 c2 b1 b2. + by call(equiv_sponge_perm c1 m); auto; smt(). + inline*; auto; progress. + by rewrite /invm=> x y; rewrite 2!emptyE. + cut->:Pr[Indiff0.Indif(RO, SimSetSize(Simulator, RO), D(A)).main() @ &m : res] = + Pr[IdealIndif(BIRO.IRO, Simulator, DRestr(DSetSize(D(A)))).main() @ &m : res]. + + byequiv=>//=; proc. + inline Simulator(FGetSize(RO)).init RO.init Simulator(BIRO.IRO).init + BIRO.IRO.init Gconcl_list.BIRO2.IRO.init; sp. + inline D(A, RO, Simulator(FGetSize(RO))).distinguish. + inline DRestr(DSetSize(D(A)), BIRO.IRO, Simulator(BIRO.IRO)).distinguish + DSetSize(D(A), FC(BIRO.IRO), PC(Simulator(BIRO.IRO))).distinguish; wp; sim. + inline SRO.Bounder(FInit(DFSetSize(FC(BIRO.IRO)))).init + SRO.Bounder(FInit(RO)).init SRO.Counter.init FInit(RO).init + FInit(DFSetSize(FC(BIRO.IRO))).init Cntr.init; sp. + seq 1 1 : (={m1, m2, glob SRO.Counter} + /\ ={c}(SRO.Counter,Cntr) + /\ same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2}); last first. + - if; auto; sp. + case: (SRO.Counter.c{1} + ((size m2{1} + 1) %/ r + 1) + + max ((size_out + r - 1) %/ r - 1) 0 < limit); last first. + * rcondf{1} 2; first by auto; inline*; auto. + rcondf{2} 2; first auto; inline*; auto; sp. + + rcondt 1; first by auto; smt(). + by sp; rcondt 1; auto; conseq(:_==> true); auto. + inline*;sp; auto. + rcondt{2} 1; first by auto; smt(). + conseq(:_==> true); first smt(dout_ll). + sp; rcondt{2} 1; auto; conseq(:_==> true); auto. + by while{2}(true)(n0{2}-i{2}); auto; 1:(sp; if; auto); smt(dbool_ll). + rcondt{1} 2; first by auto; inline*; auto. + rcondt{2} 2; first auto; inline*; auto; sp. + + rcondt 1; first by auto; smt(). + by sp; rcondt 1; auto; conseq(:_==> true); auto. + sim. + exists* m1{1}, m2{1}; elim*=> a1 a2 c1 c2. + call(equiv_ro_iro (c2 + ((size a1 + 1) %/ r + 1) + + max ((size_out + r - 1) %/ r - 1) 0) a2). + auto; call(equiv_ro_iro c2 a1); auto; smt(). + call(: ={glob SRO.Counter, glob SRO.Bounder} /\ ={c}(SRO.Counter,Cntr) + /\ same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2}); auto. + + proc; sp; if; auto; sp; if; auto; sp. + exists* x{1}; elim* => a c1 c2 b1 b2. + call(equiv_ro_iro c1 a); auto; smt(). + smt(mem_empty). print SHA3Indiff. + have->//=:= SHA3Indiff (DSetSize(D(A))) &m _. + move=> F P P_f_ll P_fi_ll F_ll; proc; inline*; auto; sp. + seq 1 : true; auto. print A_ll. + + call (A_ll (SRO.Bounder(FInit(DFSetSize(F))))); auto. + by proc; inline*; sp; if; auto; sp; if; auto; sp; call F_ll; auto. + if; auto; sp. + seq 1 : true; auto. + + by call F_ll; auto. + sp; if; auto; sp; call F_ll; auto. + qed. + + + +end section Collision. \ No newline at end of file diff --git a/proof/SecureRO.eca b/proof/SecureRO.eca index d02144a..283a6b8 100644 --- a/proof/SecureRO.eca +++ b/proof/SecureRO.eca @@ -2,446 +2,521 @@ require import Int Distr Real SmtMap FSet Mu_mem. require (****) PROM FelTactic. +type from, to. -abstract theory RO_Security. +op sampleto : to distr. - type from, to. +op bound : int. +axiom bound_gt0 : 0 < bound. - op sampleto : to distr. +axiom sampleto_ll: is_lossless sampleto. +axiom sampleto_full: is_full sampleto. +axiom sampleto_fu: is_funiform sampleto. - op bound : int. - axiom bound_gt0 : 0 < bound. +clone import PROM.GenEager as RO with + type from <- from, + type to <- to, + op sampleto <- fun _ => sampleto +proof * by exact/sampleto_ll. - axiom sampleto_ll: is_lossless sampleto. - axiom sampleto_full: is_full sampleto. - axiom sampleto_fu: is_funiform sampleto. +op increase_counter (c : int) (m : from) : int. +axiom increase_counter_spec c m : c <= increase_counter c m. - clone import PROM.GenEager as RO with - type from <- from, - type to <- to, - op sampleto <- fun _ => sampleto - proof * by exact/sampleto_ll. +op bound_counter : int. +axiom bound_counter_ge0 : 0 <= bound_counter. - module type RF = { - proc init() : unit - proc get(x : from) : to - }. +module Counter = { + var c : int + proc init() = { + c <- 0; + } +}. - module Bounder (F : RF) : RF = { - var counter : int - proc init () : unit = { - counter <- 0; - F.init(); - } - proc get(x : from) : to = { - var y : to <- witness; - if (counter < bound) { - counter <- counter + 1; +module type RF = { + proc init() : unit + proc get(x : from) : to +}. + +module Bounder (F : RF) : RF = { + var bounder : int + proc init () : unit = { + bounder <- 0; + Counter.init(); + F.init(); + } + proc get(x : from) : to = { + var y : to <- witness; + if (bounder < bound) { + bounder <- bounder + 1; + if (increase_counter Counter.c x < bound_counter) { + Counter.c <- increase_counter Counter.c x; y <- F.get(x); } - return y; } - }. + return y; + } +}. - module type Oracle = { - proc get(x : from) : to {} - }. - - module type AdvPreimage (F : Oracle) = { - proc guess(h : to) : from +module type Oracle = { + proc get(x : from) : to {} +}. + +module type AdvPreimage (F : Oracle) = { + proc guess(h : to) : from +}. + +module Preimage (A : AdvPreimage, F : RF) = { + proc main (hash : to) : bool = { + var b,m,hash'; + Counter.init(); + Bounder(F).init(); + m <@ A(Bounder(F)).guess(hash); + if (increase_counter Counter.c m < bound_counter) { + hash' <@ F.get(m); + b <- hash = hash'; + } else b <- false; + return b; + } +}. + +section Preimage. + + declare module A : AdvPreimage{RO,Preimage}. + + local module FEL (A : AdvPreimage, F : RF) = { + proc main (hash : to) : from = { + var m; + Bounder(F).init(); + m <@ A(Bounder(F)).guess(hash); + return m; + } }. - - module Preimage (A : AdvPreimage, F : RF) = { + + local module Preimage2 (A : AdvPreimage, F : RF) = { proc main (hash : to) : bool = { var b,m,hash'; - Bounder(F).init(); - m <@ A(Bounder(F)).guess(hash); - hash' <@ F.get(m); - b <- hash = hash'; + m <@ FEL(A,F).main(hash); + if (increase_counter Counter.c m < bound_counter) { + hash' <@ F.get(m); + b <- hash = hash'; + } else b <- false; return b; } }. - section Preimage. + lemma RO_is_preimage_resistant &m (h : to) : + Pr [ Preimage(A,RO).main(h) @ &m : res ] <= (bound + 1)%r * mu1 sampleto h. + proof. + cut->: Pr [ Preimage (A,RO).main(h) @ &m : res ] = + Pr [ Preimage2(A,RO).main(h) @ &m : res ]. + + by byequiv=> //=; proc; inline*; sim. + byphoare(: arg = h ==> _) => //=; proc. + seq 1 : (rng RO.m h) (bound%r * mu1 sampleto h) 1%r 1%r (mu1 sampleto h) + (card (fdom RO.m) <= Bounder.bounder <= bound /\ hash = h). + + inline*; auto; call(: card (fdom RO.m) <= Bounder.bounder <= bound)=> //=. + - proc; inline*; auto; sp; if; 2:auto; wp; sp. + if; last by auto; smt(). + wp; conseq(:_==> card (fdom RO.m) + 1 <= Bounder.bounder <= bound); 2: by auto;smt(). + move=> &h /> c H1 _ H2 c2 r x h1 h2; split; 2: smt(). + by rewrite fdom_set fcardU fcard1; smt(fcard_ge0). + by auto=> />; rewrite fdom0 fcards0; smt(bound_gt0). + + call(: true ==> rng RO.m h)=> //; bypr=> /> {&m} &m. + fel 1 Bounder.bounder (fun _, mu1 sampleto h) bound (rng RO.m h) + [Bounder(RO).get: (card (fdom RO.m) <= Bounder.bounder < bound)] + (card (fdom RO.m) <= Bounder.bounder <= bound) + =>//. + - rewrite StdBigop.Bigreal.BRA.big_const List.count_predT List.Range.size_range. + rewrite IntExtra.Extrema.max_ler //=; 1:smt(bound_gt0). + rewrite-StdRing.RField.AddMonoid.iteropE-StdRing.RField.intmulpE; 1: smt(bound_gt0). + by rewrite StdRing.RField.intmulr; smt(). + - inline*; auto=> />. + by rewrite mem_rng_empty /= fdom0 fcards0 /=; smt(bound_gt0). + - proc. + sp; if; auto; sp; inline*; sp; wp=> /=. + if; last by hoare; auto; progress; smt(mu_bounded). + case: (x \in RO.m); wp => //=. + + by hoare; auto; smt(mu_bounded). + rnd (pred1 h); auto=> /> &h c ????????. + rewrite rngE/= => hh [] a; rewrite get_setE. + case: (a=x{h}) => [->>|] //=. + by move:H1; rewrite rngE /= negb_exists/= => /(_ a) //=. + - move=> c; proc; inline*; sp; if; sp. + + if; auto; progress. + + smt(). + + by rewrite fdom_set fcardU fcard1; smt(fcard_ge0). + + smt(). + + smt(). + + smt(). + + smt(). + + smt(). + + smt(). + + smt(). + by auto. + move=> b c; proc; sp; if; auto; inline*; auto; sp; if; auto; progress. + - rewrite 2!rngE /= eq_iff; split=> [][] a. + + by rewrite get_setE; move: H5; rewrite domE /=; smt(). + move=> H8; exists a; rewrite get_setE; move: H5; rewrite domE /=; smt(). + - smt(). + - by rewrite fdom_set fcardU fcard1; smt(fcard_ge0). + - smt(). + - smt(). + - smt(). + - smt(). + - smt(). + - smt(). + smt(). + + by inline*; auto. + + by inline*; auto. + + inline*; sp; wp. + if; sp; wp; last by hoare;auto;progress; smt(mu_bounded). + case: (x \in RO.m). + - hoare; auto; progress. + + smt(mu_bounded). + rewrite H3/=; move: H1; rewrite rngE /= negb_exists /=. + by have:=H3; rewrite domE; smt(). + rnd (pred1 h); auto=> //= &hr [#]->>??<<-????. + by rewrite H3 /= get_setE /=; smt(). + smt(). + qed. - declare module A : AdvPreimage{RO,Preimage}. +end section Preimage. - local module FEL (A : AdvPreimage, F : RF) = { - proc main (hash : to) : from = { - var m; - Bounder(F).init(); - m <@ A(Bounder(F)).guess(hash); - return m; - } - }. +(*-------------------------------------------------------------------------*) +module type AdvSecondPreimage (F : Oracle) = { + proc guess(m : from) : from +}. - local module Preimage2 (A : AdvPreimage, F : RF) = { - proc main (hash : to) : bool = { - var b,m,hash'; - m <@ FEL(A,F).main(hash); - hash' <@ F.get(m); - b <- hash = hash'; - return b; +module SecondPreimage (A : AdvSecondPreimage, F : RF) = { + proc main (m1 : from) : bool = { + var b, m2, hash1, hash2; + Bounder(F).init(); + m2 <@ A(Bounder(F)).guess(m1); + if (increase_counter Counter.c m1 < bound_counter) { + Counter.c <- increase_counter Counter.c m1; + hash1 <@ F.get(m1); + if (increase_counter Counter.c m2 < bound_counter) { + Counter.c <- increase_counter Counter.c m2; + hash2 <@ F.get(m2); + b <- hash1 = hash2 /\ m1 <> m2; + } else b <- false; + } + else b <- false; + return b; + } +}. + +section SecondPreimage. + + + declare module A : AdvSecondPreimage{Bounder,RO,FRO}. + + local module FEL (A : AdvSecondPreimage, F : RO) = { + proc main (m1 : from) : from = { + var m2; + Bounder(F).init(); + F.sample(m1); + m2 <@ A(Bounder(F)).guess(m1); + return m2; + } + }. + + local module SecondPreimage2 (A : AdvSecondPreimage, F : RO) = { + var m2 : from + proc main (m1 : from) : bool = { + var b, hash1,hash2; + m2 <@ FEL(A,F).main(m1); + if (increase_counter Counter.c m1 < bound_counter) { + Counter.c <- increase_counter Counter.c m1; + hash1 <@ F.get(m1); + if (increase_counter Counter.c m2 < bound_counter) { + Counter.c <- increase_counter Counter.c m2; + hash2 <@ F.get(m2); + b <- hash1 = hash2 /\ m1 <> m2; + } else b <- false; } - }. - - lemma RO_is_preimage_resistant &m (h : to) : - Pr [ Preimage(A,RO).main(h) @ &m : res ] <= (bound + 1)%r * mu1 sampleto h. - proof. - cut->: Pr [ Preimage (A,RO).main(h) @ &m : res ] = - Pr [ Preimage2(A,RO).main(h) @ &m : res ]. - + by byequiv=> //=; proc; inline*; sim. - byphoare(: arg = h ==> _) => //=; proc. - seq 1 : (rng RO.m h) (bound%r * mu1 sampleto h) 1%r 1%r (mu1 sampleto h) - (card (fdom RO.m) <= Bounder.counter <= bound /\ hash = h). - + inline*; auto; call(: card (fdom RO.m) <= Bounder.counter <= bound)=> //=. - - proc; inline*; auto; sp; if; 2:auto; wp. - conseq(:_==> card (fdom RO.m) + 1 <= Bounder.counter <= bound); 2: by auto;smt(). - move=> &h /> H1 _ H2 c r x h1 h2; split; 2: smt(). - by rewrite fdom_set fcardU fcard1; smt(fcard_ge0). - by auto=> />; rewrite fdom0 fcards0; smt(bound_gt0). - + call(: true ==> rng RO.m h)=> //; bypr=> /> {&m} &m. - fel 1 Bounder.counter (fun _, mu1 sampleto h) bound (rng RO.m h) - [Bounder(RO).get: (card (fdom RO.m) <= Bounder.counter < bound)] - (card (fdom RO.m) <= Bounder.counter <= bound) - =>//. - - rewrite StdBigop.Bigreal.BRA.big_const List.count_predT List.Range.size_range. - rewrite IntExtra.Extrema.max_ler //=; 1:smt(bound_gt0). - rewrite-StdRing.RField.AddMonoid.iteropE-StdRing.RField.intmulpE; 1: smt(bound_gt0). - by rewrite StdRing.RField.intmulr; smt(). - - inline*; auto=> />. - by rewrite mem_rng_empty /= fdom0 fcards0 /=; smt(bound_gt0). - - proc. - sp; if; auto; sp; inline*; sp; wp=> /=. - case: (x0 \in RO.m). - + by hoare; auto; smt(mu_bounded). - rnd (pred1 h); auto=> /> &h c ????????. - rewrite rngE/= => [][] a; rewrite get_setE. - case: (a=x{h}) => [->>|] //=. - by move:H1; rewrite rngE /= negb_exists/= => /(_ a) //=. - - move=> c; proc; inline*; sp; if. - + auto; progress. - + smt(). - + by rewrite fdom_set fcardU fcard1; smt(fcard_ge0). - + smt(). - + smt(). - + smt(). - smt(). - by auto. - move=> b c; proc; sp; if; auto; inline*; auto; progress. - - rewrite 2!rngE /= eq_iff; split=> [][] a. - + by rewrite get_setE; move: H4; rewrite domE /=; smt(). - move=> H7; exists a; rewrite get_setE; move: H4; rewrite domE /=; smt(). + else b <- false; + return b; + } + }. + + local module D1 (A : AdvSecondPreimage, F : RO) = { + var m1 : from + proc distinguish () : bool = { + var b; + b <@ SecondPreimage2(A,F).main(m1); + return b; + } + }. + + local module SecondPreimage3 (A : AdvSecondPreimage, F : RO) = { + proc main (m1 : from) : bool = { + var b; + SecondPreimage2.m2 <- witness; + D1.m1 <- m1; + Bounder(F).init(); + b <@ D1(A,F).distinguish(); + return b; + } + }. + + + lemma RO_is_second_preimage_resistant &m (mess1 : from) : + Pr [ SecondPreimage(A,RO).main(mess1) @ &m : res ] + <= (bound + 1)%r * mu1 sampleto witness. + proof. + have->: Pr [ SecondPreimage(A,RO).main(mess1) @ &m : res ] = + Pr [ SecondPreimage(A,LRO).main(mess1) @ &m : res ]. + + by byequiv=> //=; proc; inline*; sim. + have->: Pr [ SecondPreimage(A,LRO).main(mess1) @ &m : res ] = + Pr [ SecondPreimage2(A,LRO).main(mess1) @ &m : res ]. + + by byequiv=> //=; proc; inline*; sim. + have->: Pr [ SecondPreimage2(A,LRO).main(mess1) @ &m : res ] = + Pr [ SecondPreimage2(A,RO).main(mess1) @ &m : res ]. + + have->: Pr [ SecondPreimage2(A,LRO).main(mess1) @ &m : res ] = + Pr [ SecondPreimage3(A,LRO).main(mess1) @ &m : res ]. + - by byequiv=> //=; proc; inline*; wp 15 -2; sim. + have->: Pr [ SecondPreimage3(A,LRO).main(mess1) @ &m : res ] = + Pr [ SecondPreimage3(A,RO).main(mess1) @ &m : res ]. + - rewrite eq_sym. + byequiv=>//=; proc. + by call(RO_LRO_D (D1(A))); inline*; auto. + by byequiv=> //=; proc; inline*; wp -2 18; sim. + byphoare(: arg = mess1 ==> _)=>//=; proc. + seq 1 : (rng (rem RO.m mess1) (oget RO.m.[mess1])) + (bound%r * mu1 sampleto witness) 1%r + 1%r (mu1 sampleto witness) + (card (fdom RO.m) - 1 <= Bounder.bounder <= bound + /\ mess1 \in RO.m /\ mess1 = m1). + + inline*; auto; call(: card (fdom RO.m) - 1 <= Bounder.bounder <= bound + /\ mess1 \in RO.m). + - proc; inline*; auto; sp; if; sp; auto; if; last by auto; smt(). + auto=> /> &h c Hc _ Hdom Hc2 _ sample. + by rewrite sampleto_full/=!fdom_set !fcardU !fcard1;smt(mem_set fcard_ge0). + auto=> /> &h sample. + by rewrite mem_set mem_empty/= fdom_set fdom0 fset0U fcard1; smt(bound_gt0). + + call(: arg = mess1 ==> rng (rem RO.m mess1) (oget RO.m.[mess1])); auto. + bypr=> {&m} &m h; rewrite h. + fel 2 Bounder.bounder (fun _, mu1 sampleto witness) bound + (mess1 \in RO.m /\ rng (rem RO.m mess1) (oget RO.m.[mess1])) + [Bounder(RO).get: (card (fdom RO.m) - 1 <= Bounder.bounder < bound)] + (card (fdom RO.m) - 1 <= Bounder.bounder <= bound /\ mess1 \in RO.m)=> {h} + =>//. + + rewrite StdBigop.Bigreal.BRA.big_const List.count_predT List.Range.size_range. + rewrite IntExtra.Extrema.max_ler //=; 1:smt(bound_gt0). + rewrite-StdRing.RField.AddMonoid.iteropE-StdRing.RField.intmulpE; 1: smt(bound_gt0). + by rewrite StdRing.RField.intmulr; smt(mu_bounded bound_gt0). + + inline*; auto=> />. + move=> &h r; rewrite mem_empty /= !mem_set mem_empty/= sampleto_full /=. + rewrite get_set_sameE//= fdom_set fdom0 fset0U fcard1 /= rngE /=; split; 2: smt(bound_gt0). + by rewrite negb_exists/= => a; rewrite remE get_setE //= emptyE; smt(). + + proc; inline*; sp; if; last by hoare; auto. + sp; if; sp; last by hoare; auto; smt(mu_bounded). + case: (x0 \in RO.m)=> //=. + - by hoare; auto; smt(mu_bounded). + rcondt 2; 1: auto; wp=> /=. + conseq(:_ ==> pred1 (oget RO.m.[mess1]) r)=> />. + - move=> /> &h d c H0c Hcb Hnrng Hmc _ Hdom1 _ Hdom2 sample. + rewrite mem_set Hdom1 /= get_set_neqE; 1: smt(). + have->: (rem RO.m{h}.[x{h} <- sample] mess1) = (rem RO.m{h} mess1).[x{h} <- sample]. + + by apply fmap_eqP=> y; rewrite remE 2!get_setE remE; smt(). + move: Hnrng; rewrite Hdom1 /= rngE /= negb_exists /= => Hnrng. + rewrite rngE/= => [][] mess; rewrite get_setE remE. + by have:= Hnrng mess; rewrite remE; smt(). + rnd; auto; progress. + by have ->:= sampleto_fu witness (oget RO.m{hr}.[mess1]). + + move=> c; proc; inline*; sp; if; auto; sp; if; auto; progress. - smt(). - by rewrite fdom_set fcardU fcard1; smt(fcard_ge0). - smt(). + - smt(mem_set). - smt(). - smt(). - smt(). - + by inline*; auto. - + by inline*; auto. - + inline*; sp; wp. - case: (x \in RO.m). - - hoare; auto; progress. - + smt(mu_bounded). - rewrite H2/=; move: H1; rewrite rngE /= negb_exists /=. - by have:=H2; rewrite domE; smt(). - rnd (pred1 h); auto=> //= &hr [#]->>??<<-????. - by rewrite H2 /= get_setE /=; smt(). - smt(). - qed. + - smt(). + - smt(). + - smt(). + - smt(). + + move=> b c; proc; inline*; sp; if; auto; sp; if; auto; smt(). + + by inline*; auto. + + by auto. + + inline*. + if; sp; last by hoare; auto; smt(mu_bounded). + rcondf 2; 1: auto. + case(increase_counter Counter.c SecondPreimage2.m2 < bound_counter); last first. + - by rcondf 3; 1: auto; hoare; auto; smt(mu_bounded). + rcondt 3; 1: auto. + swap 3 -2; sp. + case: (SecondPreimage2.m2 \in RO.m). + - rcondf 5; 1: auto; hoare; auto=> /> &h d _ _ in_dom1 not_rng _ in_dom2. + + smt(mu_bounded). + move=> sample2 _ sample1 _; rewrite negb_and/=. + move: not_rng; rewrite rngE /= negb_exists /= => /(_ SecondPreimage2.m2{h}). + rewrite remE; case: (SecondPreimage2.m2{h} = m1{h})=> //=. + by move: in_dom1 in_dom2; smt(). + rcondt 5; 1: auto; wp; rnd (pred1 hash1); auto. + move => /> &h d _ _ in_dom1 not_rng _ _ nin_dom2 sample2 _. + rewrite (sampleto_fu (oget RO.m{h}.[m1{h}]) witness) /= => sample1 _. + by rewrite get_set_sameE => ->. + smt(). + qed. - end section Preimage. +end section SecondPreimage. - (*-------------------------------------------------------------------------*) - module type AdvSecondPreimage (F : Oracle) = { - proc guess(m : from) : from - }. - - module SecondPreimage (A : AdvSecondPreimage, F : RF) = { - proc main (m1 : from) : bool = { - var m2,hash1,hash2; - Bounder(F).init(); - m2 <@ A(Bounder(F)).guess(m1); + +(*--------------------------------------------------------------------------*) +module type AdvCollision (F : Oracle) = { + proc guess() : from * from +}. + +module Collision (A : AdvCollision, F : RO) = { + proc main () : bool = { + var b,m1,m2,hash1,hash2; + Bounder(F).init(); + (m1,m2) <@ A(Bounder(F)).guess(); + if (increase_counter Counter.c m1 < bound_counter) { + Counter.c <- increase_counter Counter.c m1; hash1 <@ F.get(m1); - hash2 <@ F.get(m2); - return hash1 = hash2 /\ m1 <> m2; - } - }. - - section SecondPreimage. - - - declare module A : AdvSecondPreimage{Bounder,RO,FRO}. - - local module FEL (A : AdvSecondPreimage, F : RO) = { - proc main (m1 : from) : from = { - var m2; - Bounder(F).init(); - F.sample(m1); - m2 <@ A(Bounder(F)).guess(m1); - return m2; - } - }. - - local module SecondPreimage2 (A : AdvSecondPreimage, F : RO) = { - var m2 : from - proc main (m1 : from) : bool = { - var hash1,hash2; - m2 <@ FEL(A,F).main(m1); - hash1 <@ F.get(m1); + if (increase_counter Counter.c m2 < bound_counter) { + Counter.c <- increase_counter Counter.c m2; hash2 <@ F.get(m2); - return hash1 = hash2 /\ m1 <> m2; - } - }. - - local module D1 (A : AdvSecondPreimage, F : RO) = { - var m1 : from - proc distinguish () : bool = { - var b; - b <@ SecondPreimage2(A,F).main(m1); - return b; - } - }. - - local module SecondPreimage3 (A : AdvSecondPreimage, F : RO) = { - proc main (m1 : from) : bool = { - var b; - SecondPreimage2.m2 <- witness; - D1.m1 <- m1; - Bounder(F).init(); - b <@ D1(A,F).distinguish(); - return b; - } - }. - - - lemma RO_is_second_preimage_resistant &m (mess1 : from) : - Pr [ SecondPreimage(A,RO).main(mess1) @ &m : res ] - <= (bound + 1)%r * mu1 sampleto witness. - proof. - have->: Pr [ SecondPreimage(A,RO).main(mess1) @ &m : res ] = - Pr [ SecondPreimage(A,LRO).main(mess1) @ &m : res ]. - + by byequiv=> //=; proc; inline*; sim. - have->: Pr [ SecondPreimage(A,LRO).main(mess1) @ &m : res ] = - Pr [ SecondPreimage2(A,LRO).main(mess1) @ &m : res ]. - + by byequiv=> //=; proc; inline*; sim. - have->: Pr [ SecondPreimage2(A,LRO).main(mess1) @ &m : res ] = - Pr [ SecondPreimage2(A,RO).main(mess1) @ &m : res ]. - + have->: Pr [ SecondPreimage2(A,LRO).main(mess1) @ &m : res ] = - Pr [ SecondPreimage3(A,LRO).main(mess1) @ &m : res ]. - - by byequiv=> //=; proc; inline*; wp 15 -2; sim. - have->: Pr [ SecondPreimage3(A,LRO).main(mess1) @ &m : res ] = - Pr [ SecondPreimage3(A,RO).main(mess1) @ &m : res ]. - - rewrite eq_sym. - byequiv=>//=; proc. - by call(RO_LRO_D (D1(A))); inline*; auto. - by byequiv=> //=; proc; inline*; wp -2 18; sim. - byphoare(: arg = mess1 ==> _)=>//=; proc. - seq 1 : (rng (rem RO.m mess1) (oget RO.m.[mess1])) - (bound%r * mu1 sampleto witness) 1%r - 1%r (mu1 sampleto witness) - (card (fdom RO.m) - 1 <= Bounder.counter <= bound - /\ mess1 \in RO.m /\ mess1 = m1). - + inline*; auto; call(: card (fdom RO.m) - 1 <= Bounder.counter <= bound - /\ mess1 \in RO.m). - - proc; inline*; auto; sp; if; auto=> /> &h Hc _ Hdom Hc2 sample. - by rewrite sampleto_full/=!fdom_set !fcardU !fcard1;smt(mem_set fcard_ge0). - auto=> /> &h sample. - by rewrite mem_set mem_empty/= fdom_set fdom0 fset0U fcard1; smt(bound_gt0). - + call(: arg = mess1 ==> rng (rem RO.m mess1) (oget RO.m.[mess1])); auto. - bypr=> {&m} &m h; rewrite h. - fel 2 Bounder.counter (fun _, mu1 sampleto witness) bound - (mess1 \in RO.m /\ rng (rem RO.m mess1) (oget RO.m.[mess1])) - [Bounder(RO).get: (card (fdom RO.m) - 1 <= Bounder.counter < bound)] - (card (fdom RO.m) - 1 <= Bounder.counter <= bound /\ mess1 \in RO.m)=> {h} - =>//. - + rewrite StdBigop.Bigreal.BRA.big_const List.count_predT List.Range.size_range. - rewrite IntExtra.Extrema.max_ler //=; 1:smt(bound_gt0). - rewrite-StdRing.RField.AddMonoid.iteropE-StdRing.RField.intmulpE; 1: smt(bound_gt0). - by rewrite StdRing.RField.intmulr; smt(mu_bounded bound_gt0). - + inline*; auto=> />. - move=> &h r; rewrite mem_empty /= !mem_set mem_empty/= sampleto_full /=. - rewrite get_set_sameE//= fdom_set fdom0 fset0U fcard1 /= rngE /=; split; 2: smt(bound_gt0). - by rewrite negb_exists/= => a; rewrite remE get_setE //= emptyE; smt(). - + proc; inline*; sp; if; last by hoare; auto. - sp; case: (x0 \in RO.m)=> //=. - - hoare; auto; smt(mu_bounded). - rcondt 2; 1: auto; wp=> /=. - conseq(:_ ==> pred1 (oget RO.m.[mess1]) r)=> />. - - move=> /> &h c H0c Hcb Hnrng Hmc _ Hdom1 Hdom2 sample. - rewrite mem_set Hdom1 /= get_set_neqE; 1: smt(). - have->: (rem RO.m{h}.[x{h} <- sample] mess1) = (rem RO.m{h} mess1).[x{h} <- sample]. - + by apply fmap_eqP=> y; rewrite remE 2!get_setE remE; smt(). - move: Hnrng; rewrite Hdom1 /= rngE /= negb_exists /= => Hnrng. - rewrite rngE/= => [][] mess; rewrite get_setE remE. - by have:= Hnrng mess; rewrite remE; smt(). - rnd; auto; progress. - by have ->:= sampleto_fu witness (oget RO.m{hr}.[mess1]). - + move=> c; proc; inline*; sp; if; auto; progress. - - smt(). - - by rewrite fdom_set fcardU fcard1; smt(fcard_ge0). - - smt(). - - smt(mem_set). - - smt(). - - smt(). - - smt(). - + move=> b c; proc; inline*; sp; if; auto; smt(). - + by inline*; auto. - + by auto. - + inline*. - rcondf 3; 1: auto. - case: (SecondPreimage2.m2 \in RO.m). - - rcondf 6; 1: auto; hoare; auto=> /> &h _ _ in_dom1 not_rng in_dom2. - + smt(mu_bounded). - move=> sample2 _ sample1 _; rewrite negb_and/=. - move: not_rng; rewrite rngE /= negb_exists /= => /(_ SecondPreimage2.m2{h}). - rewrite remE; case: (SecondPreimage2.m2{h} = m1{h})=> //=. - by move: in_dom1 in_dom2; smt(). - rcondt 6; 1: auto; wp; rnd (pred1 hash1); auto. - move => /> &h _ _ in_dom1 not_rng nin_dom2 sample2 _. - rewrite (sampleto_fu (oget RO.m{h}.[m1{h}]) witness) /= => sample1 _. - by rewrite get_set_sameE => ->. - smt(). - qed. - - end section SecondPreimage. - - - (*--------------------------------------------------------------------------*) - module type AdvCollision (F : Oracle) = { - proc guess() : from * from - }. - - module Collision (A : AdvCollision, F : RO) = { - proc main () : bool = { - var m1,m2,hash1,hash2; + b <- hash1 = hash2 /\ m1 <> m2; + } else b <- false; + } + else b <- false; + return b; + } +}. + +section Collision. + + declare module A : AdvCollision {RO, FRO, Bounder}. + + local module FEL (A : AdvCollision, F : RO) = { + proc main () : from * from = { + var m1,m2; Bounder(F).init(); (m1,m2) <@ A(Bounder(F)).guess(); - hash1 <@ F.get(m1); - hash2 <@ F.get(m2); - return hash1 = hash2 /\ m1 <> m2; + return (m1,m2); } }. - - section Collision. - - declare module A : AdvCollision {RO, FRO, Bounder}. - - local module FEL (A : AdvCollision, F : RO) = { - proc main () : from * from = { - var m1,m2; - Bounder(F).init(); - (m1,m2) <@ A(Bounder(F)).guess(); - return (m1,m2); - } - }. - local module Collision2 (A : AdvCollision) (F : RO) = { - proc main () : bool = { - var m1,m2,hash1,hash2; - (m1,m2) <@ FEL(A,F).main(); + local module Collision2 (A : AdvCollision) (F : RO) = { + proc main () : bool = { + var b,m1,m2,hash1,hash2; + (m1,m2) <@ FEL(A,F).main(); + if (increase_counter Counter.c m1 < bound_counter) { + Counter.c <- increase_counter Counter.c m1; hash1 <@ F.get(m1); - hash2 <@ F.get(m2); - return hash1 = hash2 /\ m1 <> m2; + if (increase_counter Counter.c m2 < bound_counter) { + Counter.c <- increase_counter Counter.c m2; + hash2 <@ F.get(m2); + b <- hash1 = hash2 /\ m1 <> m2; + } else b <- false; } - }. + else b <- false; + return b; + } + }. - op collision (m : ('a, 'b) fmap) = - exists m1 m2, m1 <> m2 /\ m1 \in m /\ m2 \in m /\ m.[m1] = m.[m2]. - - lemma RO_is_collision_resistant &m : - Pr [ Collision(A,RO).main() @ &m : res ] - <= ((bound * (bound - 1) + 2)%r / 2%r * mu1 sampleto witness). - proof. - have->: Pr [ Collision(A,RO).main() @ &m : res ] = - Pr [ Collision2(A,RO).main() @ &m : res ]. - + by byequiv=>//=; proc; inline*; sim. - byphoare=> //; proc. - seq 1 : (collision RO.m) - ((bound * (bound - 1))%r / 2%r * mu1 sampleto witness) 1%r - 1%r (mu1 sampleto witness) - (card (fdom RO.m) <= Bounder.counter <= bound); first last; first last. - + auto. - + auto. - + inline*. - case: (m1 = m2); 1: (by hoare; auto; smt(bound_gt0 mu_bounded)). - case: (m1 \in RO.m); case: (m2 \in RO.m). - - rcondf 3; 1: auto; rcondf 6; 1: auto; hoare; auto; 1: smt(bound_gt0 mu_bounded). - move=> /> &h _ _ Hcoll neq12 in_dom1 in_dom2 _ _ _ _. - move: Hcoll; rewrite /collision negb_exists /= => /(_ m1{h}). - rewrite negb_exists /= => /(_ m2{h}). - by rewrite neq12 in_dom1 in_dom2 /=; smt(). - - rcondf 3; 1: auto; rcondt 6; 1: auto; wp; rnd (pred1 hash1). - auto=> /> &h Hmc Hcb Hcoll neq12 in_dom1 in_dom2 _ _; split. - * smt(sampleto_fu). - by move=> _ sample _; rewrite get_set_sameE; smt(). - - rcondt 3; 1: auto; rcondf 7; 1: (by auto; smt(mem_set)). - swap 6 -5; wp=> /=; rnd (pred1 (oget RO.m.[m2])); auto. - move=> /> &h _ _ Hcoll neq12 in_dom1 in_dom2 _ _; split. - * smt(sampleto_fu). - move=> _ sample _. - by rewrite get_set_sameE get_set_neqE 1:eq_sym. - rcondt 3; 1: auto; rcondt 7; 1: (by auto; smt(mem_set)). - swap 2 -1; swap 6 -4; wp=> //=; rnd (pred1 r); auto. - move=> /> &h _ _ Hcoll neq12 in_dom1 in_dom2 sample1 _; split. + op collision (m : ('a, 'b) fmap) = + exists m1 m2, m1 <> m2 /\ m1 \in m /\ m2 \in m /\ m.[m1] = m.[m2]. + + lemma RO_is_collision_resistant &m : + Pr [ Collision(A,RO).main() @ &m : res ] + <= ((bound * (bound - 1) + 2)%r / 2%r * mu1 sampleto witness). + proof. + have->: Pr [ Collision(A,RO).main() @ &m : res ] = + Pr [ Collision2(A,RO).main() @ &m : res ]. + + by byequiv=>//=; proc; inline*; sim. + byphoare=> //; proc. + seq 1 : (collision RO.m) + ((bound * (bound - 1))%r / 2%r * mu1 sampleto witness) 1%r + 1%r (mu1 sampleto witness) + (card (fdom RO.m) <= Bounder.bounder <= bound); first last; first last. + + auto. + + auto. + + inline*. + if; sp; last first. + - by hoare; auto; smt(mu_bounded). + case: (increase_counter Counter.c m2 < bound_counter); last first. + - rcondf 4; 1:auto; hoare; auto; smt(mu_bounded). + rcondt 4; 1: auto. + swap 4 -3. + case: (m1 = m2). + - by hoare; 1: smt(mu_bounded); auto. + case: (m1 \in RO.m); case: (m2 \in RO.m). + - rcondf 3; 1: auto; rcondf 6; 1: auto; hoare; auto; 1: smt(bound_gt0 mu_bounded). + move=> /> &h d _ _ Hcoll _ _ neq12 in_dom1 in_dom2 _ _ _ _. + move: Hcoll; rewrite /collision negb_exists /= => /(_ m1{h}). + rewrite negb_exists /= => /(_ m2{h}). + by rewrite neq12 in_dom1 in_dom2 /=; smt(). + - rcondf 3; 1: auto; rcondt 6; 1: auto; wp; rnd (pred1 hash1). + auto=> /> &h d Hmc Hcb Hcoll _ _ neq12 in_dom1 in_dom2 _ _; split. * smt(sampleto_fu). - move=> _ sample2 _. - by rewrite get_set_sameE get_set_sameE; smt(). - + by move=> />; smt(mu_bounded). - + inline*; wp; call(: card (fdom RO.m) <= Bounder.counter <= bound); auto. - - proc; inline*; sp; if; auto. - move=> /> &h Hbc _ Hcb sample _; split. - * by move=> nin_dom1; rewrite fdom_set fcardU fcard1; smt(fcard_ge0). - by move=> in_dom1; smt(). - by move=> />; rewrite fdom0 fcards0; smt(bound_gt0). - call(: true ==> collision RO.m); auto; bypr=> /> {&m} &m. - fel 1 Bounder.counter (fun i, i%r * mu1 sampleto witness) bound - (collision RO.m) - [Bounder(RO).get: (card (fdom RO.m) <= Bounder.counter < bound)] - (card (fdom RO.m) <= Bounder.counter <= bound)=> //. - + rewrite -StdBigop.Bigreal.BRA.mulr_suml StdRing.RField.mulrAC. - rewrite StdOrder.RealOrder.ler_wpmul2r; 1: smt(mu_bounded). - by rewrite StdBigop.Bigreal.sumidE //; smt(bound_gt0). - + inline*; auto=> />. - rewrite fdom0 fcards0; split; 2: smt(bound_gt0). - rewrite /collision negb_exists /= => a; rewrite negb_exists /= => b. - by rewrite mem_empty. - + bypr=> /> {&m} &m; pose c := Bounder.counter{m}; move=> H0c Hcbound Hcoll Hmc _. - byphoare(: !collision RO.m /\ card (fdom RO.m) <= c ==> _)=>//=. - proc; inline*; sp; if; last first. - - by hoare; auto; smt(mu_bounded). - case: (x \in RO.m). - - by hoare; auto; smt(mu_bounded). - rcondt 4; 1: auto; sp; wp=> /=. - conseq(:_==> r \in frng RO.m). - - move=> /> &h c2 Hcoll2 Hb2c Hc2b nin_dom sample m1 m2 neq. - rewrite 2!mem_set. - case: (m1 = x{h}) => //=. - * move=> <<-; rewrite eq_sym neq /= get_set_sameE get_set_neqE//= 1:eq_sym //. - by rewrite mem_frng rngE /= => _ ->; exists m2. - case: (m2 = x{h}) => //=. - * move=> <<- _ in_dom1. - by rewrite get_set_neqE // get_set_sameE mem_frng rngE/= => <-; exists m1. - move=> neq2 neq1 in_dom1 in_dom2; rewrite get_set_neqE // get_set_neqE //. - have:= Hcoll2; rewrite negb_exists /= => /(_ m1). - rewrite negb_exists /= => /(_ m2). - by rewrite neq in_dom1 in_dom2 /= => ->. - rnd; skip=> /> &h counter _ h _. - rewrite (mu_mem (frng RO.m{h}) sampleto (mu1 sampleto witness)); 1: smt(sampleto_fu). - rewrite StdOrder.RealOrder.ler_wpmul2r //; 1: smt(mu_bounded). - by rewrite RealExtra.le_fromint; smt(le_card_frng_fdom). - + move=> c; proc; sp; if; auto; inline*; auto=> />. - move=> &h h1 h2 _ sample _. - by rewrite fdom_set fcardU fcard1; smt(fcard_ge0). - move=> b c; proc; inline*; sp; if; auto=> />. - move=> &h h1 h2 _ sample _. + by move=> _ sample _; rewrite get_set_sameE; smt(). + - rcondt 3; 1: auto; rcondf 7; 1: (by auto; smt(mem_set)). + swap 6 -5; wp=> /=; rnd (pred1 (oget RO.m.[m2])); auto. + move=> /> &h d _ _ Hcoll _ _ neq12 in_dom1 in_dom2 _ _; split. + * smt(sampleto_fu). + move=> _ sample _. + by rewrite get_set_sameE get_set_neqE 1:eq_sym. + rcondt 3; 1: auto; rcondt 7; 1: (by auto; smt(mem_set)). + swap 2 -1; swap 6 -4; wp=> //=; rnd (pred1 r); auto. + move=> /> &h d _ _ Hcoll _ _ neq12 in_dom1 in_dom2 sample1 _; split. + * smt(sampleto_fu). + move=> _ sample2 _. + by rewrite get_set_sameE get_set_sameE; smt(). + + by move=> />; smt(mu_bounded). + + inline*; wp; call(: card (fdom RO.m) <= Bounder.bounder <= bound); auto. + - proc; inline*; sp; if; auto; sp; if; last by auto; smt(). + auto=> /> &h d Hbc _ _ Hcb sample _; split. + * by move=> nin_dom1; rewrite fdom_set fcardU fcard1; smt(fcard_ge0). + by move=> in_dom1; smt(). + by move=> />; rewrite fdom0 fcards0; smt(bound_gt0). + call(: true ==> collision RO.m); auto; bypr=> /> {&m} &m. + fel 1 Bounder.bounder (fun i, i%r * mu1 sampleto witness) bound + (collision RO.m) + [Bounder(RO).get: (card (fdom RO.m) <= Bounder.bounder < bound)] + (card (fdom RO.m) <= Bounder.bounder <= bound)=> //. + + rewrite -StdBigop.Bigreal.BRA.mulr_suml StdRing.RField.mulrAC. + rewrite StdOrder.RealOrder.ler_wpmul2r; 1: smt(mu_bounded). + by rewrite StdBigop.Bigreal.sumidE //; smt(bound_gt0). + + inline*; auto=> />. + rewrite fdom0 fcards0; split; 2: smt(bound_gt0). + rewrite /collision negb_exists /= => a; rewrite negb_exists /= => b. + by rewrite mem_empty. + + bypr=> /> {&m} &m; pose c := Bounder.bounder{m}; move=> H0c Hcbound Hcoll Hmc _. + byphoare(: !collision RO.m /\ card (fdom RO.m) <= c ==> _)=>//=. + proc; inline*; sp; if; last first. + - by hoare; auto; smt(mu_bounded). + sp; if; last by hoare; auto; smt(mu_bounded). + case: (x \in RO.m). + - by hoare; auto; smt(mu_bounded). + rcondt 4; 1: auto; sp; wp=> /=. + conseq(:_==> r \in frng RO.m). + - move=> /> &h d c2 Hcoll2 Hb2c Hc2b _ nin_dom sample m1 m2 neq. + rewrite 2!mem_set. + case: (m1 = x{h}) => //=. + * move=> <<-; rewrite eq_sym neq /= get_set_sameE get_set_neqE//= 1:eq_sym //. + by rewrite mem_frng rngE /= => _ ->; exists m2. + case: (m2 = x{h}) => //=. + * move=> <<- _ in_dom1. + by rewrite get_set_neqE // get_set_sameE mem_frng rngE/= => <-; exists m1. + move=> neq2 neq1 in_dom1 in_dom2; rewrite get_set_neqE // get_set_neqE //. + have:= Hcoll2; rewrite negb_exists /= => /(_ m1). + rewrite negb_exists /= => /(_ m2). + by rewrite neq in_dom1 in_dom2 /= => ->. + rnd; skip=> /> &h bounder _ h _. + rewrite (mu_mem (frng RO.m{h}) sampleto (mu1 sampleto witness)); 1: smt(sampleto_fu). + rewrite StdOrder.RealOrder.ler_wpmul2r //; 1: smt(mu_bounded). + by rewrite RealExtra.le_fromint; smt(le_card_frng_fdom). + + move=> c; proc; sp; if; auto; inline*; auto; sp; if; last by auto; smt(). + auto=> /> &h d h1 _ h2 _ sample _. by rewrite fdom_set fcardU fcard1; smt(fcard_ge0). - qed. + move=> b c; proc; inline*; sp; if; auto; sp; if; auto; 2: smt(). + move=> /> &h h1 h2 _ _ _ sample _. + by rewrite fdom_set fcardU fcard1; smt(fcard_ge0). + qed. - - end section Collision. - - -end RO_Security. + +end section Collision. From e8898dafe8e4f9c2165f1af2baec73419055cd4a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Wed, 10 Apr 2019 18:31:41 +0100 Subject: [PATCH 335/525] SLCommon and Handle --- proof/smart_counter/Handle.eca | 19 +++++++++---------- proof/smart_counter/SLCommon.ec | 2 +- 2 files changed, 10 insertions(+), 11 deletions(-) diff --git a/proof/smart_counter/Handle.eca b/proof/smart_counter/Handle.eca index ccd780f..0989005 100644 --- a/proof/smart_counter/Handle.eca +++ b/proof/smart_counter/Handle.eca @@ -497,7 +497,7 @@ split=> [xa0 xc0 ya0 yc0|xa0 hx0 ya0 hy0]; rewrite get_setE. by exists hx0 fx0 hy0 fy0; rewrite !get_setE /#. case: ((xa0,hx0) = (xa,hx))=> [[#] <*>> [#] <<*>|] /=. + by exists xc f yc f'; rewrite !get_setE /= /#. -rewrite andaE=> /negb_and xahx0_neq_xahx /Hmh_m [xc0 fx0 yc0 fy0] [#] hs_hx0 hs_hy0 Pm_xaxc0. +move=> /negb_and xahx0_neq_xahx /Hmh_m [xc0 fx0 yc0 fy0] [#] hs_hx0 hs_hy0 Pm_xaxc0. exists xc0 fx0 yc0 fy0; rewrite !get_setE; do !split=> [/#|/#|/=]. move: xahx0_neq_xahx; case: (xa0 = xa)=> [/= <*>>|//=]; case: (xc0 = xc)=> [<*>>|//=]. by move: hs_hx=> /(Hhuniq _ _ _ _ hs_hx0). @@ -517,7 +517,7 @@ move=> [] Hm_mh Hmh_m yc_notin_rng1_hs hs_hx hs_hy; split. by exists hy0 fy0 hx0 fx0; rewrite !get_setE /#. move=> ya0 hy0 xa0 hx0; rewrite get_setE; case: ((ya0,hy0) = (ya,hy))=> [[#] <*>> [#] <<*>|]. + by exists yc fy xc fx; rewrite !get_setE //= /#. -rewrite /= andaE=> /negb_and yahy0_neq_yahy /Hmh_m [yc0 fy0 xc0 fx0] [#] hs_hy0 hs_hx0 mi_yayc0. +move=> /= /negb_and yahy0_neq_yahy /Hmh_m [yc0 fy0 xc0 fx0] [#] hs_hy0 hs_hx0 mi_yayc0. exists yc0 fy0 xc0 fx0; rewrite !get_setE; do !split=> [/#|/#|]. move: yahy0_neq_yahy; case: (ya0 = ya)=> [<<*> //=|/#]; case: (yc0 = yc)=> [<*>> /=|//=]. by move: hs_hy0; rewrite yc_notin_rng1_hs. @@ -1177,7 +1177,7 @@ split. case: {-1}(Gmi.[(ya,yc)]) (eq_refl Gmi.[(ya,yc)])=> [//|[xa' xc']]. have /incli_of_INV + ^h - <- := HINV; 1:by rewrite h. move: Pm_xaxc; have [] -> -> /= := inv_mh_inv_Pm hs Pm Pmi mh mhi _ _ _; first 3 by case: HINV. - rewrite andaE -negP=> [#] <<*>. + rewrite -negP=> [#] <<*>. move: h; have /invG_of_INV [] <- := HINV. by rewrite Gm_xaxc. + by case: HINV. @@ -1265,7 +1265,7 @@ proof. move=> p x Hrec v hx /build_hpath_prefix [v' h' [/Hrec{Hrec}]]. rewrite get_setE /=;case (h' = ch) => [->> | ]. + by rewrite (@eq_sym ch) Hha /= => _ /Hch. - case (v' +^ x = xa && h' = ha) => [[!<<-] /= ?? [!->>] /=| ]. + case (v' +^ x = xa /\ h' = ha) => [[!<<-] /= ?? [!->>] /=| ]. + by exists p v';rewrite xorwA xorwK xorwC xorw0. case (hx = ch)=> [->> _ _ _ /Hch //|??? Hbu Hg]. by rewrite build_hpath_prefix;exists v' h'. @@ -2040,7 +2040,8 @@ proof. cut[]b6 c6[]:=H_pref1 _ H12 i{2} _;1:smt(size_take). rewrite!take_take !min_lel 1,2:/# nth_take 1,2:/# H2/=H_Gmh oget_some=>[][]<<-<<-<-. rewrite H_PFm oget_some/=. - by cut[]help1 help2/# :=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + cut [] help1 help2:= m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + + by have [] xc fx yc fy [#] /# := help2 _ _ _ _ H_Gmh. - cut[]HINV[]->>/=[]->>/=[]H_h[]H_path H_F_RO:=H6 H11. cut[]H01 H02 H_pref1 H_pref2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. cut//=:=lemma5 _ _ _ _ _ _ _ _ _ _ _ _ i{2} p{2} sa{2} sc{1} h{2} HINV _ _ _ _. @@ -2405,7 +2406,7 @@ proof. rewrite eq_xor h_g1/=;move:h_neq;apply absurd=>//=. cut:=hh3 _ _ _ _ _ H_path h_build_hpath_p0. cut->:bn = sa{2} +^ sa{2} +^ bn;smt(@Block). - move=>help;cut h_neq:! (v +^ bn = sa{2} +^ nth witness bs{1} i{2} && hx = h{2}) by rewrite/#. + move=>help;cut h_neq:! (v +^ bn = sa{2} +^ nth witness bs{1} i{2} /\ hx = h{2}) by rewrite/#. move:help;rewrite h_neq/==>h_g1_v_bn_hx. cut[]hh1 hh2 hh3:=H_mh_spec. cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness bs{1} i{2}) y1L p0 v hx. @@ -2573,7 +2574,7 @@ section AUX. smt (size_ge0). (* lossless and do not reset bad G1.C.f *) + move=> _; proc; inline *; wp;sp;if;auto;sp;if;auto;sp. - conseq(:_==> (G1.bcol \/ G1.bext));1:smt(@DBlock @DCapacity mem_set). + conseq(:_==> (G1.bcol \/ G1.bext));1:smt(@DBlock @DCapacity mem_set). while (G1.bcol \/ G1.bext) (size p - i)=> [z|]. + if; 1:by auto=> /#. if;2:auto=>/#;wp; rnd predT; wp; rnd predT; auto. @@ -2631,6 +2632,4 @@ section. rewrite Pr[mu_or];smt(Distr.mu_bounded). qed. -end section. - - +end section. \ No newline at end of file diff --git a/proof/smart_counter/SLCommon.ec b/proof/smart_counter/SLCommon.ec index 4fda277..d392b04 100644 --- a/proof/smart_counter/SLCommon.ec +++ b/proof/smart_counter/SLCommon.ec @@ -148,7 +148,7 @@ lemma build_hpathP mh p v h: build_hpath mh p = Some (v,h) <=> build_hpath_spec mh p v h. proof. elim/last_ind: p v h=> @/build_hpath //= [v h|p b ih v h]. -+ by rewrite andaE; split=> [!~#] <*>; [exact/Empty|move=> []]; smt(size_rcons size_ge0). ++ by split=> [!~#] <*>; [exact/Empty|move=> []]; smt(size_rcons size_ge0). rewrite -{1}cats1 foldl_cat {1}/step_hpath /=. case: {-1}(foldl _ _ _) (eq_refl (foldl (step_hpath mh) (Some (b0,0)) p))=> //=. + apply/implybN; case=> [|p' b0 v' h']. From 5eebfc053f5ae24a738f24ba3aff92d22245cc2c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Wed, 10 Apr 2019 18:32:17 +0100 Subject: [PATCH 336/525] use kms box for CI --- .gitlab-ci.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index ffdf384..8452d80 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -5,13 +5,13 @@ services: - docker:dind before_script: - docker info -- docker pull easycryptpa/ec-test-box +- docker pull easycryptpa/ec-test-box:kms sha3: only: - master script: - >- - docker run -v $PWD:/home/ci/sha3 easycryptpa/ec-test-box + docker run -v $PWD:/home/ci/sha3 easycryptpa/ec-test-box:kms sh -c 'cd sha3 && opam config exec -- make check-xunit' artifacts: when: on_failure From f35e08f96d734deea7c3abcf1c0327ad7b503fcd Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Wed, 10 Apr 2019 18:35:49 +0100 Subject: [PATCH 337/525] activate CI on deploy-kms the bad way --- .gitlab-ci.yml | 1 + 1 file changed, 1 insertion(+) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 8452d80..40b2ec5 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -9,6 +9,7 @@ before_script: sha3: only: - master + - deploy-kms script: - >- docker run -v $PWD:/home/ci/sha3 easycryptpa/ec-test-box:kms From 96a319bb5a25247281299c7898d2ba2f7581e227 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Wed, 10 Apr 2019 22:10:49 +0100 Subject: [PATCH 338/525] Sync with deploy-kms head --- .gitlab-ci.yml | 1 - proof/SHA3Security.ec | 23 ++++++++++------------- proof/impl/JMemory.ec | 3 +-- proof/impl/JWord.ec | 8 +------- 4 files changed, 12 insertions(+), 23 deletions(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 40b2ec5..8452d80 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -9,7 +9,6 @@ before_script: sha3: only: - master - - deploy-kms script: - >- docker run -v $PWD:/home/ci/sha3 easycryptpa/ec-test-box:kms diff --git a/proof/SHA3Security.ec b/proof/SHA3Security.ec index 6519085..c1d714d 100644 --- a/proof/SHA3Security.ec +++ b/proof/SHA3Security.ec @@ -164,14 +164,14 @@ section Collision. op same_ro (m1 : (bool list, f_out) fmap) (m2 : (bool list * int, bool) fmap) = - (forall m, m \in m1 => forall i, 0 <= i < size_out => (m,i) \in m2) - && (forall m, (exists i, 0 <= i < size_out /\ (m,i) \in m2) => m \in m1) - && (forall m, m \in m1 => to_list (oget m1.[m]) = map (fun i => oget m2.[(m,i)]) (range 0 size_out)). + (forall m, m \in m1 => forall i, 0 <= i < size_out => (m,i) \in m2) + /\ (forall m, (exists i, 0 <= i < size_out /\ (m,i) \in m2) => m \in m1) + /\ (forall m, m \in m1 => to_list (oget m1.[m]) = map (fun i => oget m2.[(m,i)]) (range 0 size_out)). op same_ro2 (m1 : (bool list, bool list) fmap) (m2 : (bool list * int, bool) fmap) = - (forall m, m \in m1 => forall i, 0 <= i < size_out => (m,i) \in m2) - && (forall m, (exists i, 0 <= i < size_out /\ (m,i) \in m2) => m \in m1) - && (forall m, m \in m1 => oget m1.[m] = map (fun i => oget m2.[(m,i)]) (range 0 size_out)). + (forall m, m \in m1 => forall i, 0 <= i < size_out => (m,i) \in m2) + /\ (forall m, (exists i, 0 <= i < size_out /\ (m,i) \in m2) => m \in m1) + /\ (forall m, m \in m1 => oget m1.[m] = map (fun i => oget m2.[(m,i)]) (range 0 size_out)). clone import Program as Prog with type t <- bool, @@ -230,11 +230,11 @@ section Collision. + move:H8; rewrite mem_set=>[][]//=h; 1:rewrite H3=>//=. - by have []h1 []h2 h3:= H2; have->//:=h1 _ h. by move:h => <<-; rewrite H6 //=. - + rewrite mem_set//=; have[]//=h:= H5 _ _ H11; left. + + rewrite mem_set //=; have [] //= h:= H5 _ _ H10; left. have []h1 []->//=:= H2. by exists i0=>//=. + move:H7; rewrite take_oversize 1:spec_dout//= => H7. - move:H10; rewrite mem_set. + move:H8; rewrite mem_set. case(m \in SRO.RO.RO.m{1})=>//=h. - rewrite get_set_neqE; 1:smt(). have []h1 []h2 ->//=:= H2. @@ -462,10 +462,10 @@ section Collision. + proc; sp; if; auto; sp; if; auto; sp. exists* x{1}; elim* => a c1 c2 b1 b2. call(equiv_ro_iro c1 a); auto; smt(). - smt(mem_empty). print SHA3Indiff. + smt(mem_empty). have->//=:= SHA3Indiff (DSetSize(D(A))) &m _. move=> F P P_f_ll P_fi_ll F_ll; proc; inline*; auto; sp. - seq 1 : true; auto. print A_ll. + seq 1 : true; auto. + call (A_ll (SRO.Bounder(FInit(DFSetSize(F))))); auto. by proc; inline*; sp; if; auto; sp; if; auto; sp; call F_ll; auto. if; auto; sp. @@ -473,7 +473,4 @@ section Collision. + by call F_ll; auto. sp; if; auto; sp; call F_ll; auto. qed. - - - end section Collision. \ No newline at end of file diff --git a/proof/impl/JMemory.ec b/proof/impl/JMemory.ec index 7f974fa..80c9f4b 100644 --- a/proof/impl/JMemory.ec +++ b/proof/impl/JMemory.ec @@ -188,8 +188,7 @@ lemma store4u32 mem ptr w0 w1 w2 w3 : (ptr + 12) w3. proof. rewrite storeW128E !storeW32E. - rewrite /W4u8.Pack.to_list /mkseq /= /stores /=. - by rewrite !pack4u32_bits8_nth //. + by rewrite /W4u8.Pack.to_list /mkseq /= /stores /=. qed. lemma store4u8 mem ptr w0 w1 w2 w3 : diff --git a/proof/impl/JWord.ec b/proof/impl/JWord.ec index 94307cf..6d11628 100644 --- a/proof/impl/JWord.ec +++ b/proof/impl/JWord.ec @@ -2429,10 +2429,4 @@ lemma W2u128_W4u64 ws1 ws2: pack2 [W2u64.pack2_t ws1; W2u64.pack2_t ws2] = pack4 [ws1.[0]; ws1.[1]; ws2.[0]; ws2.[1]]. proof. by apply W4u64.allP => /=. qed. -hint simplify W2u128_W4u64. - - - - - - +hint simplify W2u128_W4u64. \ No newline at end of file From 7d236dd508a0c034c1867c6543d3f975a07c4115 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Thu, 11 Apr 2019 12:44:18 +0200 Subject: [PATCH 339/525] SHA3Security.ec : Sponge is : - preimage resitant - second preimage resistant - collision resistant --- proof/IndifRO_is_secure.ec | 111 +++++- proof/SHA3Security.ec | 795 +++++++++++++++++++++++++++++++++++-- 2 files changed, 867 insertions(+), 39 deletions(-) diff --git a/proof/IndifRO_is_secure.ec b/proof/IndifRO_is_secure.ec index 1abde7d..dc90d5e 100644 --- a/proof/IndifRO_is_secure.ec +++ b/proof/IndifRO_is_secure.ec @@ -84,11 +84,12 @@ module FM (C : CONSTRUCTION) (P : PRIMITIVE) = { proc rem (a : f_in) = {} }. -module D (A : AdvCollision) (F : DFUNCTIONALITY) (P : DPRIMITIVE) = { + +module DColl (A : AdvCollision) (F : DFUNCTIONALITY) (P : DPRIMITIVE) = { proc distinguish = Collision(A,FInit(F)).main }. -section Proof. +section Collision. declare module A : AdvCollision{Bounder, SRO.RO.RO, SRO.RO.FRO}. @@ -100,25 +101,117 @@ section Proof. (P <: PRIMITIVE{C, A, Bounder}) &m : (exists (S <: SIMULATOR{Bounder, A}), (forall (F <: FUNCTIONALITY), islossless F.f => islossless S(F).init) /\ - `|Pr[GReal(C,P,D(A)).main() @ &m : res] - - Pr[GIdeal(RO,S,D(A)).main() @ &m : res]| <= bound) => + `|Pr[GReal(C,P,DColl(A)).main() @ &m : res] - + Pr[GIdeal(RO,S,DColl(A)).main() @ &m : res]| <= bound) => Pr[Collision(A,FM(C,P)).main() @ &m : res] <= bound + ((limit * (limit - 1) + 2)%r / 2%r * mu1 sampleto witness). proof. move=>[] S [] S_ll Hbound. cut->: Pr[Collision(A, FM(C,P)).main() @ &m : res] = - Pr[GReal(C, P, D(A)).main() @ &m : res]. + Pr[GReal(C, P, DColl(A)).main() @ &m : res]. + byequiv=>//=; proc; inline*; wp; sim. by swap{1} [1..2] 2; sim. - cut/#:Pr[GIdeal(RO, S, D(A)).main() @ &m : res] <= + cut/#:Pr[GIdeal(RO, S, DColl(A)).main() @ &m : res] <= (limit * (limit - 1) + 2)%r / 2%r * mu1 sampleto witness. - cut->:Pr[GIdeal(RO, S, D(A)).main() @ &m : res] = + cut->:Pr[GIdeal(RO, S, DColl(A)).main() @ &m : res] = Pr[Collision(A, SRO.RO.RO).main() @ &m : res]. - + byequiv=>//=; proc; inline D(A, RO, S(RO)).distinguish; wp; sim. + + byequiv=>//=; proc; inline DColl(A, RO, S(RO)).distinguish; wp; sim. inline*; swap{2} 1 1; wp. call{1} (S_ll RO); auto. by proc; auto; smt(sampleto_ll). exact(RO_is_collision_resistant A &m). qed. -end section Proof. \ No newline at end of file +end section Collision. + + +module DPre (A : AdvPreimage) (F : DFUNCTIONALITY) (P : DPRIMITIVE) = { + var h : f_out + proc distinguish () = { + var b; + b <@ Preimage(A,FInit(F)).main(h); + return b; + } +}. + +section Preimage. + + declare module A : AdvPreimage{Bounder, SRO.RO.RO, SRO.RO.FRO, DPre}. + + axiom D_ll (F <: Oracle) : + islossless F.get => islossless A(F).guess. + + lemma preimage_resistant_if_indifferentiable + (C <: CONSTRUCTION{A, Bounder, DPre}) + (P <: PRIMITIVE{C, A, Bounder, DPre}) &m hash : + (DPre.h{m} = hash) => + (exists (S <: SIMULATOR{Bounder, A, DPre}), + (forall (F <: FUNCTIONALITY), islossless F.f => islossless S(F).init) /\ + `|Pr[GReal(C,P,DPre(A)).main() @ &m : res] - + Pr[GIdeal(RO,S,DPre(A)).main() @ &m : res]| <= bound) => + Pr[Preimage(A,FM(C,P)).main(hash) @ &m : res] <= + bound + (limit + 1)%r * mu1 sampleto hash. + proof. + move=>init_hash [] S [] S_ll Hbound. + cut->: Pr[Preimage(A, FM(C,P)).main(hash) @ &m : res] = + Pr[GReal(C, P, DPre(A)).main() @ &m : res]. + + byequiv=>//=; proc; inline*; wp; sp; wp; sim. + by swap{2} [1..2] 4; sim; auto; smt(). + cut/#:Pr[GIdeal(RO, S, DPre(A)).main() @ &m : res] <= + (limit + 1)%r * mu1 sampleto hash. + cut->:Pr[GIdeal(RO, S, DPre(A)).main() @ &m : res] = + Pr[Preimage(A, SRO.RO.RO).main(hash) @ &m : res]. + + byequiv=>//=; proc; inline DPre(A, RO, S(RO)).distinguish; wp; sim. + inline*; swap{2} 1 1; wp; sim; auto. + call{1} (S_ll RO); auto. + by proc; auto; smt(sampleto_ll). + exact(RO_is_preimage_resistant A &m hash). + qed. + +end section Preimage. + + +module D2Pre (A : AdvSecondPreimage) (F : DFUNCTIONALITY) (P : DPRIMITIVE) = { + var m2 : f_in + proc distinguish () = { + var b; + b <@ SecondPreimage(A,FInit(F)).main(m2); + return b; + } +}. + +section SecondPreimage. + + declare module A : AdvSecondPreimage{Bounder, SRO.RO.RO, SRO.RO.FRO, D2Pre}. + + axiom D_ll (F <: Oracle) : + islossless F.get => islossless A(F).guess. + + lemma second_preimage_resistant_if_indifferentiable + (C <: CONSTRUCTION{A, Bounder, D2Pre}) + (P <: PRIMITIVE{C, A, Bounder, D2Pre}) &m mess : + (D2Pre.m2{m} = mess) => + (exists (S <: SIMULATOR{Bounder, A, D2Pre}), + (forall (F <: FUNCTIONALITY), islossless F.f => islossless S(F).init) /\ + `|Pr[GReal(C,P,D2Pre(A)).main() @ &m : res] - + Pr[GIdeal(RO,S,D2Pre(A)).main() @ &m : res]| <= bound) => + Pr[SecondPreimage(A,FM(C,P)).main(mess) @ &m : res] <= + bound + (limit + 1)%r * mu1 sampleto witness. + proof. + move=>init_mess [] S [] S_ll Hbound. + cut->: Pr[SecondPreimage(A, FM(C,P)).main(mess) @ &m : res] = + Pr[GReal(C, P, D2Pre(A)).main() @ &m : res]. + + byequiv=>//=; proc; inline*; wp; sp; wp; sim. + by swap{2} [1..2] 3; sim; auto; smt(). + cut/#:Pr[GIdeal(RO, S, D2Pre(A)).main() @ &m : res] <= + (limit + 1)%r * mu1 sampleto witness. + cut->:Pr[GIdeal(RO, S, D2Pre(A)).main() @ &m : res] = + Pr[SecondPreimage(A, SRO.RO.RO).main(mess) @ &m : res]. + + byequiv=>//=; proc; inline D2Pre(A, RO, S(RO)).distinguish; wp; sim. + inline*; swap{2} 1 1; wp; sim; auto. + call{1} (S_ll RO); auto. + by proc; auto; smt(sampleto_ll). + exact(RO_is_second_preimage_resistant A &m mess). + qed. + +end section SecondPreimage. diff --git a/proof/SHA3Security.ec b/proof/SHA3Security.ec index 6519085..faa8aa7 100644 --- a/proof/SHA3Security.ec +++ b/proof/SHA3Security.ec @@ -91,6 +91,754 @@ module (DSetSize (D : Indiff0.DISTINGUISHER) : DISTINGUISHER) (F : DFUNCTIONALITY) (P : DPRIMITIVE) = D(DFSetSize(F),P). +section Preimage. + + declare module A : SRO.AdvPreimage{SRO.RO.RO, SRO.RO.FRO, SRO.Bounder, Perm, + Gconcl_list.BIRO2.IRO, Simulator, Cntr, BIRO.IRO, F.RO, F.FRO, Redo, C, + Gconcl.S, BlockSponge.BIRO.IRO, BlockSponge.C, Gconcl_list.F2.RO, + Gconcl_list.F2.FRO, Gconcl_list.Simulator, DPre}. + + axiom A_ll (F <: SRO.Oracle) : islossless F.get => islossless A(F).guess. + + local lemma invm_dom_rng (m mi : (state, state) fmap) : + invm m mi => dom m = rng mi. + proof. + move=>h; rewrite fun_ext=> x; rewrite domE rngE /= eq_iff; have h2 := h x; split. + + move=> m_x_not_None; exists (oget m.[x]); rewrite -h2; move: m_x_not_None. + by case: (m.[x]). + by move=> [] a; rewrite -h2 => ->. + qed. + + local lemma invmC' (m mi : (state, state) fmap) : + invm m mi => invm mi m. + proof. by rewrite /#. qed. + + local lemma invmC (m mi : (state, state) fmap) : + invm m mi <=> invm mi m. + proof. by split;exact invmC'. qed. + + local lemma useful m mi a : + invm m mi => ! a \in m => Distr.is_lossless ((bdistr `*` cdistr) \ rng m). + proof. + move=>hinvm nin_dom. + cut prod_ll:Distr.is_lossless (bdistr `*` cdistr). + + by rewrite dprod_ll DBlock.dunifin_ll DCapacity.dunifin_ll. + apply dexcepted_ll=>//=;rewrite-prod_ll. + cut->:predT = predU (predC (rng m)) (rng m);1:rewrite predCU//=. + rewrite Distr.mu_disjoint 1:predCI//=StdRing.RField.addrC. + cut/=->:=StdOrder.RealOrder.ltr_add2l (mu (bdistr `*` cdistr) (rng m)) 0%r. + rewrite Distr.witness_support/predC. + move:nin_dom;apply absurd=>//=;rewrite negb_exists/==>hyp. + cut{hyp}hyp:forall x, rng m x by smt(supp_dprod DBlock.supp_dunifin DCapacity.supp_dunifin). + move:a. + cut:=eqEcard (fdom m) (frng m);rewrite leq_card_rng_dom/=. + cut->//=:fdom m \subset frng m. + + by move=> x; rewrite mem_fdom mem_frng hyp. + smt(mem_fdom mem_frng). + qed. + + + local equiv equiv_sponge_perm c m : + FInit(CSetSize(Sponge, Perm)).get ~ FInit(DFSetSize(FC(Sponge(Perm)))).get : + ={arg, glob Perm} /\ invm Perm.m{1} Perm.mi{1} /\ + Cntr.c{2} = c /\ arg{2} = m /\ + (Cntr.c + ((size arg + 1) %/ Common.r + 1) + + max ((size_out + Common.r - 1) %/ Common.r - 1) 0 <= limit){2} ==> + ={res, glob Perm} /\ invm Perm.m{1} Perm.mi{1} /\ + Cntr.c{2} = c + ((size m + 1) %/ Common.r + 1) + + max ((size_out + Common.r - 1) %/ Common.r - 1) 0. + proof. + proc; inline FC(Sponge(Perm)).f; sp. + rcondt{2} 1; auto; sp. + call(: ={glob Perm} /\ invm Perm.m{1} Perm.mi{1})=>/=; auto; inline*. + while(={i, n, sa, sc, z, glob Perm} /\ invm Perm.m{1} Perm.mi{1}); auto. + + sp; if; auto; sp; if; auto; progress. + rewrite invm_set //=. + by move:H4; rewrite supp_dexcepted. + sp; conseq(:_==> ={i, n, sa, sc, glob Perm} /\ invm Perm.m{1} Perm.mi{1}); auto. + while(={xs, sa, sc, glob Perm} /\ invm Perm.m{1} Perm.mi{1}); auto. + sp; if; auto; progress. + rewrite invm_set=>//=. + by move:H4; rewrite supp_dexcepted. + qed. + + + op same_ro (m1 : (bool list, f_out) fmap) (m2 : (bool list * int, bool) fmap) = + (forall m, m \in m1 => forall i, 0 <= i < size_out => (m,i) \in m2) + && (forall m, (exists i, 0 <= i < size_out /\ (m,i) \in m2) => m \in m1) + && (forall m, m \in m1 => to_list (oget m1.[m]) = map (fun i => oget m2.[(m,i)]) (range 0 size_out)). + + op same_ro2 (m1 : (bool list, bool list) fmap) (m2 : (bool list * int, bool) fmap) = + (forall m, m \in m1 => forall i, 0 <= i < size_out => (m,i) \in m2) + && (forall m, (exists i, 0 <= i < size_out /\ (m,i) \in m2) => m \in m1) + && (forall m, m \in m1 => oget m1.[m] = map (fun i => oget m2.[(m,i)]) (range 0 size_out)). + + clone import Program as Prog with + type t <- bool, + op d <- dbool + proof *. + + local equiv equiv_ro_iro c m : + FInit(RO).get ~ FInit(DFSetSize(FC(BIRO.IRO))).get : + ={arg} /\ same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2} /\ + arg{2} = m /\ Cntr.c{2} = c /\ + (Cntr.c + ((size arg + 1) %/ Common.r + 1) + + max ((size_out + Common.r - 1) %/ Common.r - 1) 0 <= limit){2} + ==> ={res} /\ same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2} /\ + Cntr.c{2} = c + ((size m + 1) %/ Common.r + 1) + + max ((size_out + Common.r - 1) %/ Common.r - 1) 0. + proof. + proc; inline *; sp; rcondt{2} 1; 1: auto. + swap{2} 1 5; sp; wp 2 1. + conseq(:_==> oget SRO.RO.RO.m{1}.[x{1}] = oget (of_list bs0{2}) /\ + same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2}); 1:by auto. + rcondt{2} 1; 1: auto. + case: (x{1} \in SRO.RO.RO.m{1}). + + rcondf{1} 2; auto. + exists* BIRO.IRO.mp{2}; elim* => mp. + while{2}(bs0{2} = map (fun j => oget BIRO.IRO.mp{2}.[(x0{2},j)]) (range 0 i{2}) + /\ n0{2} = size_out /\ x0{2} \in SRO.RO.RO.m{1} /\ 0 <= i{2} <= size_out + /\ same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2} /\ BIRO.IRO.mp{2} = mp) + (size_out - i{2}); auto. + - sp; rcondf 1; auto; 1: smt(). + progress. + * have/=<-:= map_rcons (fun (j : int) => oget BIRO.IRO.mp{hr}.[(x0{hr}, j)]) (range 0 i{hr}) i{hr}. + by rewrite !rangeSr //=. + * smt(). + * smt(). + * smt(). + progress. + - by rewrite range_geq. + - smt(size_out_gt0). + - smt(). + - exact(dout_ll). + - have[] h[#] h1 h2 := H. + cut->:i_R = size_out by smt(). + cut<-:=h2 _ H3. + smt(to_listK). + rcondt{1} 2; 1: auto; wp =>/=. + exists* BIRO.IRO.mp{2}; elim* => mp. + conseq(:_==> + same_ro SRO.RO.RO.m{1} mp /\ i{2} = size_out /\ + (forall (l,j), (l,j) \in mp => (l,j) \in BIRO.IRO.mp{2}) /\ + (forall (l,j), (l,j) \in mp => BIRO.IRO.mp{2}.[(l,j)] = mp.[(l,j)]) /\ + (forall (l,j), (l,j) \in BIRO.IRO.mp{2} => (l,j) \in mp \/ (l = x0{2} /\ 0 <= j < i{2})) /\ + (forall j, 0 <= j < i{2} => (x0{2},j) \in BIRO.IRO.mp{2}) /\ + take i{2} (to_list r{1}) = bs0{2} /\ + take i{2} (to_list r{1}) = map (fun (j : int) => oget BIRO.IRO.mp{2}.[(x0{2}, j)]) (range 0 i{2})); progress=>//=. + + by rewrite get_set_sameE /= oget_some; smt(to_listK take_oversize spec_dout). + + move:H8; rewrite mem_set=>[][]//=h; 1:rewrite H3=>//=. + - by have []h1 []h2 h3:= H2; have->//:=h1 _ h. + by move:h => <<-; rewrite H6 //=. + + rewrite mem_set//=; have[]//=h:= H5 _ _ H11; left. + have []h1 []->//=:= H2. + by exists i0=>//=. + + move:H7; rewrite take_oversize 1:spec_dout//= => H7. + move:H10; rewrite mem_set. + case(m \in SRO.RO.RO.m{1})=>//=h. + - rewrite get_set_neqE; 1:smt(). + have []h1 []h2 ->//=:= H2. + by apply eq_in_map=> j;rewrite mem_range=>[][]hj1 hj2/=; rewrite H4//=h1//=. + by move=><<-; rewrite get_set_eqE//=. + alias{1} 1 l = [<:bool>]. + transitivity{1} { + l <@ Sample.sample(size_out); + r <- oget (of_list l); + } + (={glob SRO.RO.RO, x} ==> ={glob SRO.RO.RO, r}) + (x{1} = x0{2} /\ i{2} = 0 /\ n0{2} = size_out /\ mp = BIRO.IRO.mp{2} /\ + same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2} /\ x{1} \notin SRO.RO.RO.m{1} /\ + bs0{2} = [] + ==> + same_ro SRO.RO.RO.m{1} mp /\ i{2} = size_out /\ + (forall (l,j), (l,j) \in mp => (l,j) \in BIRO.IRO.mp{2}) /\ + (forall (l,j), (l,j) \in mp => BIRO.IRO.mp{2}.[(l,j)] = mp.[(l,j)]) /\ + (forall (l,j), (l,j) \in BIRO.IRO.mp{2} => (l,j) \in mp \/ (l = x0{2} /\ 0 <= j < i{2})) /\ + (forall j, 0 <= j < i{2} => (x0{2},j) \in BIRO.IRO.mp{2}) /\ + take i{2} (to_list r{1}) = bs0{2} /\ + take i{2} (to_list r{1}) = + map (fun (j : int) => oget BIRO.IRO.mp{2}.[(x0{2}, j)]) (range 0 i{2})); + progress. + + smt(). + + inline*; sp; wp. + rnd to_list (fun x => oget (of_list x)); auto; progress. + - smt(spec_dout supp_dlist to_listK spec2_dout size_out_gt0). + - rewrite -dout_equal_dlist dmap1E; apply mu_eq=> x/=. + smt(to_listK). + - rewrite-dout_equal_dlist supp_dmap; smt(dout_full). + smt(to_listK). + wp=>/=. + conseq(:_==> i{2} = size_out /\ size l{1} = size_out /\ + (forall (l0 : bool list) (j : int), + (l0, j) \in mp => (l0, j) \in BIRO.IRO.mp{2}) /\ + (forall (l0 : bool list) (j : int), + (l0, j) \in mp => BIRO.IRO.mp{2}.[(l0, j)] = mp.[(l0, j)]) /\ + (forall (l0 : bool list) (j : int), + (l0, j) \in BIRO.IRO.mp{2} => ((l0, j) \in mp) \/ (l0 = x0{2} /\ 0 <= j < i{2})) /\ + (forall (j : int), 0 <= j < i{2} => (x0{2}, j) \in BIRO.IRO.mp{2}) /\ + take i{2} l{1} = bs0{2} /\ + take i{2} l{1} = + map (fun (j : int) => oget BIRO.IRO.mp{2}.[(x0{2}, j)]) (range 0 i{2})); + progress. + + have[]//=h h1:=to_listK (oget (of_list l_L)) l_L; rewrite h1//==> {h1 h}. + smt(spec2_dout). + + have[]//=h h1:=to_listK (oget (of_list l_L)) l_L; rewrite h1//==> {h1 h}. + smt(spec2_dout). + transitivity{1} { + l <@ LoopSnoc.sample(size_out); + } + (={glob SRO.RO.RO} ==> ={glob SRO.RO.RO, l}) + (x{1} = x0{2} /\ i{2} = 0 /\ n0{2} = size_out /\ mp = BIRO.IRO.mp{2} /\ + same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2} /\ x0{2} \notin SRO.RO.RO.m{1} /\ + bs0{2} = [] + ==> + i{2} = size_out /\ size l{1} = size_out /\ + (forall (l,j), (l,j) \in mp => (l,j) \in BIRO.IRO.mp{2}) /\ + (forall (l,j), (l,j) \in mp => BIRO.IRO.mp{2}.[(l,j)] = mp.[(l,j)]) /\ + (forall (l,j), (l,j) \in BIRO.IRO.mp{2} => (l,j) \in mp \/ (l = x0{2} /\ 0 <= j < i{2})) /\ + (forall j, 0 <= j < i{2} => (x0{2},j) \in BIRO.IRO.mp{2}) /\ + take i{2} l{1} = bs0{2} /\ + take i{2} l{1} = + map (fun (j : int) => oget BIRO.IRO.mp{2}.[(x0{2}, j)]) (range 0 i{2})); + progress. + + smt(). + + by call Sample_LoopSnoc_eq; auto. + inline*; sp; wp. + conseq(:_==> i{2} = size_out /\ size l0{1} = i{2} /\ + same_ro SRO.RO.RO.m{1} mp /\ x0{2} \notin SRO.RO.RO.m{1} /\ + (forall l j, (l,j) \in mp => (l,j) \in BIRO.IRO.mp{2}) /\ + (forall l j, (l,j) \in mp => BIRO.IRO.mp{2}.[(l, j)] = mp.[(l, j)]) /\ + (forall l j, (l, j) \in BIRO.IRO.mp{2} => ((l, j) \in mp) \/ (l = x0{2} /\ 0 <= j < i{2})) /\ + (forall j, 0 <= j < i{2} => (x0{2}, j) \in BIRO.IRO.mp{2}) /\ + l0{1} = bs0{2} /\ bs0{2} = + map (fun (j : int) => oget BIRO.IRO.mp{2}.[(x0{2}, j)]) (range 0 i{2})); progress. + + smt(take_oversize). + + smt(take_oversize). + while(0 <= i{2} <= size_out /\ size l0{1} = i{2} /\ n0{2} = size_out /\ + ={i} /\ n{1} = n0{2} /\ + same_ro SRO.RO.RO.m{1} mp /\ x0{2} \notin SRO.RO.RO.m{1} /\ + (forall l j, (l,j) \in mp => (l,j) \in BIRO.IRO.mp{2}) /\ + (forall l j, (l,j) \in mp => BIRO.IRO.mp{2}.[(l, j)] = mp.[(l, j)]) /\ + (forall l j, (l, j) \in BIRO.IRO.mp{2} => ((l, j) \in mp) \/ (l = x0{2} /\ 0 <= j < i{2})) /\ + (forall j, 0 <= j < i{2} => (x0{2}, j) \in BIRO.IRO.mp{2}) /\ + l0{1} = bs0{2} /\ bs0{2} = + map (fun (j : int) => oget BIRO.IRO.mp{2}.[(x0{2}, j)]) (range 0 i{2})). + + sp; wp=> //=. + rcondt{2} 1; 1:auto; progress. + - have[]h1 [] h2 h3 := H1. + have:=h2 x0{hr}; rewrite H2/= negb_exists/= =>/(_ (size bs0{hr})). + rewrite size_ge0 H9/=; apply absurd =>/= h. + by have //=:= H5 _ _ h. + rnd; auto; progress. + - smt(size_ge0). + - smt(). + - by rewrite size_cat/=. + - by rewrite mem_set; left; rewrite H3. + - rewrite get_setE (H4 _ _ H12). + cut/#: !(l1, j) = (x0{2}, size bs0{2}). + move:H2; apply absurd=> //=[#] <<- ->>. + have[] h1 [] h2 h3 := H1. + by apply h2; smt(). + - move:H12; rewrite mem_set. + case((l1, j) \in BIRO.IRO.mp{2})=>//= h; 1: smt(). + by move=> [#] <<- ->> //=; rewrite size_ge0; smt(). + - rewrite mem_set. + case(j = size bs0{2})=>//=. + move=> h; rewrite h /=; have {H13} H13 {h} : j < size bs0{2} by smt(). + by apply H6. + - by rewrite cats1 get_set_sameE oget_some. + - rewrite get_set_sameE oget_some H7 rangeSr. + rewrite !size_map 1:size_ge0. + rewrite (size_map _ (range 0 (size bs0{2}))) size_range /=. + rewrite max_ler 1:size_ge0 map_rcons /=get_set_sameE oget_some; congr. + apply eq_in_map=> j. + rewrite mem_range /==> [] [] hj1 hj2. + by rewrite get_set_neqE //=; smt(). + auto; progress. + + smt(size_out_gt0). + + smt(). + + smt(). + + by rewrite range_geq. + smt(). + qed. + + lemma SHA3_preimage_resistant &m ha : + (DPre.h{m} = ha) => + Pr[SRO.Preimage(A, FM(CSetSize(Sponge), Perm)).main(ha) @ &m : res] <= + (limit ^ 2 - limit)%r / (2 ^ (r + c + 1))%r + + (4 * limit ^ 2)%r / (2 ^ c)%r + + (sigma + 1)%r * mu1 dout ha. + proof. + move=>init_ha. + rewrite(preimage_resistant_if_indifferentiable A A_ll (CSetSize(Sponge)) Perm &m ha init_ha). + exists (SimSetSize(Simulator))=>//=; split. + + by move=> F _; proc; inline*; auto. + cut->//:Pr[Indiff0.Indif(CSetSize(Sponge, Perm), Perm, DPre(A)).main() @ &m : res] = + Pr[RealIndif(Sponge, Perm, DRestr(DSetSize(DPre(A)))).main() @ &m : res]. + + byequiv=>//=; proc. + inline DPre(A, CSetSize(Sponge, Perm), Perm).distinguish. + inline SRO.Preimage(A, FInit(CSetSize(Sponge, Perm))).main. + inline DRestr(DSetSize(DPre(A)), Sponge(Perm), Perm).distinguish + DSetSize(DPre(A), FC(Sponge(Perm)), PC(Perm)).distinguish + SRO.Preimage(A, FInit(DFSetSize(FC(Sponge(Perm))))).main. + inline Perm.init CSetSize(Sponge, Perm).init Sponge(Perm).init + FC(Sponge(Perm)).init SRO.Counter.init Cntr.init + SRO.Bounder(FInit(CSetSize(Sponge, Perm))).init + SRO.Bounder(FInit(DFSetSize(FC(Sponge(Perm))))).init + FInit(CSetSize(Sponge, Perm)).init + FInit(DFSetSize(FC(Sponge(Perm)))).init; sp. + wp; sp; sim. + seq 1 1 : (={m, hash, glob DPre, glob SRO.Counter, glob Perm} + /\ invm Perm.m{1} Perm.mi{1} /\ DPre.h{1} = ha + /\ ={c}(SRO.Counter,Cntr)); last first. + - if; auto; sp. + exists* m{1}, SRO.Counter.c{1}; elim* => mess c. + by call(equiv_sponge_perm c mess); auto; smt(). + call(: ={glob SRO.Counter, glob Perm, glob DPre, glob SRO.Bounder} + /\ DPre.h{1} = ha + /\ invm Perm.m{1} Perm.mi{1} /\ ={c}(SRO.Counter,Cntr)). + + proc; sp; if; auto; sp; if; auto; sp. + exists * x{1}; elim* => m c1 c2 b1 b2. + by call(equiv_sponge_perm c1 m); auto; smt(). + auto; progress. + by rewrite /invm=> x y; rewrite 2!emptyE. + cut->//:Pr[Indiff0.Indif(RO, SimSetSize(Simulator, RO), DPre(A)).main() @ &m : res] = + Pr[IdealIndif(BIRO.IRO, Simulator, DRestr(DSetSize(DPre(A)))).main() @ &m : res]. + + byequiv=>//=; proc. + inline Simulator(FGetSize(RO)).init RO.init Simulator(BIRO.IRO).init + BIRO.IRO.init Gconcl_list.BIRO2.IRO.init; sp. + inline DPre(A, RO, Simulator(FGetSize(RO))).distinguish. + inline DRestr(DSetSize(DPre(A)), BIRO.IRO, Simulator(BIRO.IRO)).distinguish + DSetSize(DPre(A), FC(BIRO.IRO), PC(Simulator(BIRO.IRO))).distinguish; wp; sim. + inline SRO.Bounder(FInit(DFSetSize(FC(BIRO.IRO)))).init + SRO.Bounder(FInit(RO)).init SRO.Counter.init FInit(RO).init + FInit(DFSetSize(FC(BIRO.IRO))).init Cntr.init; sp. + inline SRO.Preimage(A, FInit(RO)).main + SRO.Preimage(A, FInit(DFSetSize(FC(BIRO.IRO)))).main. + inline SRO.Counter.init SRO.Bounder(FInit(RO)).init + SRO.Bounder(FInit(DFSetSize(FC(BIRO.IRO)))).init + FInit(RO).init FInit(DFSetSize(FC(BIRO.IRO))).init ; sp; sim. + seq 1 1 : (={m, glob SRO.Counter, glob DPre, hash} + /\ ={c}(SRO.Counter,Cntr) /\ DPre.h{1} = hash{1} + /\ same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2}); last first. + - if; auto; sp. + exists * m{1}, SRO.Counter.c{1}; elim* => mess c. + by call(equiv_ro_iro c mess); auto; smt(). + conseq(:_==> ={m, glob SRO.Counter, glob SRO.Bounder, glob DPre} + /\ ={c}(SRO.Counter,Cntr) + /\ same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2}); progress. + call(: ={glob SRO.Counter, glob SRO.Bounder, glob DPre} + /\ ={c}(SRO.Counter,Cntr) + /\ same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2}); auto. + + proc; sp; if; auto; sp; if; auto; sp. + exists* x{1}; elim* => a c1 c2 b1 b2. + call(equiv_ro_iro c1 a); auto; smt(). + smt(mem_empty). + have->//=:= SHA3Indiff (DSetSize(DPre(A))) &m _. + move=> F P P_f_ll P_fi_ll F_ll; proc; inline*; auto; sp; auto. + seq 1 : true; auto. + + call (A_ll (SRO.Bounder(FInit(DFSetSize(F))))); auto. + by proc; inline*; sp; if; auto; sp; if; auto; sp; call F_ll; auto. + if; auto; sp. + by call F_ll; auto. + qed. + +end section Preimage. + + + +section SecondPreimage. + + declare module A : SRO.AdvSecondPreimage{SRO.RO.RO, SRO.RO.FRO, SRO.Bounder, Perm, + Gconcl_list.BIRO2.IRO, Simulator, Cntr, BIRO.IRO, F.RO, F.FRO, Redo, C, + Gconcl.S, BlockSponge.BIRO.IRO, BlockSponge.C, Gconcl_list.F2.RO, + Gconcl_list.F2.FRO, Gconcl_list.Simulator, D2Pre}. + + axiom A_ll (F <: SRO.Oracle) : islossless F.get => islossless A(F).guess. + + local lemma invm_dom_rng (m mi : (state, state) fmap) : + invm m mi => dom m = rng mi. + proof. + move=>h; rewrite fun_ext=> x; rewrite domE rngE /= eq_iff; have h2 := h x; split. + + move=> m_x_not_None; exists (oget m.[x]); rewrite -h2; move: m_x_not_None. + by case: (m.[x]). + by move=> [] a; rewrite -h2 => ->. + qed. + + local lemma invmC' (m mi : (state, state) fmap) : + invm m mi => invm mi m. + proof. by rewrite /#. qed. + + local lemma invmC (m mi : (state, state) fmap) : + invm m mi <=> invm mi m. + proof. by split;exact invmC'. qed. + + local lemma useful m mi a : + invm m mi => ! a \in m => Distr.is_lossless ((bdistr `*` cdistr) \ rng m). + proof. + move=>hinvm nin_dom. + cut prod_ll:Distr.is_lossless (bdistr `*` cdistr). + + by rewrite dprod_ll DBlock.dunifin_ll DCapacity.dunifin_ll. + apply dexcepted_ll=>//=;rewrite-prod_ll. + cut->:predT = predU (predC (rng m)) (rng m);1:rewrite predCU//=. + rewrite Distr.mu_disjoint 1:predCI//=StdRing.RField.addrC. + cut/=->:=StdOrder.RealOrder.ltr_add2l (mu (bdistr `*` cdistr) (rng m)) 0%r. + rewrite Distr.witness_support/predC. + move:nin_dom;apply absurd=>//=;rewrite negb_exists/==>hyp. + cut{hyp}hyp:forall x, rng m x by smt(supp_dprod DBlock.supp_dunifin DCapacity.supp_dunifin). + move:a. + cut:=eqEcard (fdom m) (frng m);rewrite leq_card_rng_dom/=. + cut->//=:fdom m \subset frng m. + + by move=> x; rewrite mem_fdom mem_frng hyp. + smt(mem_fdom mem_frng). + qed. + + + local equiv equiv_sponge_perm c m : + FInit(CSetSize(Sponge, Perm)).get ~ FInit(DFSetSize(FC(Sponge(Perm)))).get : + ={arg, glob Perm} /\ invm Perm.m{1} Perm.mi{1} /\ + Cntr.c{2} = c /\ arg{2} = m /\ + (Cntr.c + ((size arg + 1) %/ Common.r + 1) + + max ((size_out + Common.r - 1) %/ Common.r - 1) 0 <= limit){2} ==> + ={res, glob Perm} /\ invm Perm.m{1} Perm.mi{1} /\ + Cntr.c{2} = c + ((size m + 1) %/ Common.r + 1) + + max ((size_out + Common.r - 1) %/ Common.r - 1) 0. + proof. + proc; inline FC(Sponge(Perm)).f; sp. + rcondt{2} 1; auto; sp. + call(: ={glob Perm} /\ invm Perm.m{1} Perm.mi{1})=>/=; auto; inline*. + while(={i, n, sa, sc, z, glob Perm} /\ invm Perm.m{1} Perm.mi{1}); auto. + + sp; if; auto; sp; if; auto; progress. + rewrite invm_set //=. + by move:H4; rewrite supp_dexcepted. + sp; conseq(:_==> ={i, n, sa, sc, glob Perm} /\ invm Perm.m{1} Perm.mi{1}); auto. + while(={xs, sa, sc, glob Perm} /\ invm Perm.m{1} Perm.mi{1}); auto. + sp; if; auto; progress. + rewrite invm_set=>//=. + by move:H4; rewrite supp_dexcepted. + qed. + + + clone import Program as Prog2 with + type t <- bool, + op d <- dbool + proof *. + + local equiv equiv_ro_iro c m : + FInit(RO).get ~ FInit(DFSetSize(FC(BIRO.IRO))).get : + ={arg} /\ same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2} /\ + arg{2} = m /\ Cntr.c{2} = c /\ + (Cntr.c + ((size arg + 1) %/ Common.r + 1) + + max ((size_out + Common.r - 1) %/ Common.r - 1) 0 <= limit){2} + ==> ={res} /\ same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2} /\ + Cntr.c{2} = c + ((size m + 1) %/ Common.r + 1) + + max ((size_out + Common.r - 1) %/ Common.r - 1) 0. + proof. + proc; inline *; sp; rcondt{2} 1; 1: auto. + swap{2} 1 5; sp; wp 2 1. + conseq(:_==> oget SRO.RO.RO.m{1}.[x{1}] = oget (of_list bs0{2}) /\ + same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2}); 1:by auto. + rcondt{2} 1; 1: auto. + case: (x{1} \in SRO.RO.RO.m{1}). + + rcondf{1} 2; auto. + exists* BIRO.IRO.mp{2}; elim* => mp. + while{2}(bs0{2} = map (fun j => oget BIRO.IRO.mp{2}.[(x0{2},j)]) (range 0 i{2}) + /\ n0{2} = size_out /\ x0{2} \in SRO.RO.RO.m{1} /\ 0 <= i{2} <= size_out + /\ same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2} /\ BIRO.IRO.mp{2} = mp) + (size_out - i{2}); auto. + - sp; rcondf 1; auto; 1: smt(). + progress. + * have/=<-:= map_rcons (fun (j : int) => oget BIRO.IRO.mp{hr}.[(x0{hr}, j)]) (range 0 i{hr}) i{hr}. + by rewrite !rangeSr //=. + * smt(). + * smt(). + * smt(). + progress. + - by rewrite range_geq. + - smt(size_out_gt0). + - smt(). + - exact(dout_ll). + - have[] h[#] h1 h2 := H. + cut->:i_R = size_out by smt(). + cut<-:=h2 _ H3. + smt(to_listK). + rcondt{1} 2; 1: auto; wp =>/=. + exists* BIRO.IRO.mp{2}; elim* => mp. + conseq(:_==> + same_ro SRO.RO.RO.m{1} mp /\ i{2} = size_out /\ + (forall (l,j), (l,j) \in mp => (l,j) \in BIRO.IRO.mp{2}) /\ + (forall (l,j), (l,j) \in mp => BIRO.IRO.mp{2}.[(l,j)] = mp.[(l,j)]) /\ + (forall (l,j), (l,j) \in BIRO.IRO.mp{2} => (l,j) \in mp \/ (l = x0{2} /\ 0 <= j < i{2})) /\ + (forall j, 0 <= j < i{2} => (x0{2},j) \in BIRO.IRO.mp{2}) /\ + take i{2} (to_list r{1}) = bs0{2} /\ + take i{2} (to_list r{1}) = map (fun (j : int) => oget BIRO.IRO.mp{2}.[(x0{2}, j)]) (range 0 i{2})); progress=>//=. + + by rewrite get_set_sameE /= oget_some; smt(to_listK take_oversize spec_dout). + + move:H8; rewrite mem_set=>[][]//=h; 1:rewrite H3=>//=. + - by have []h1 []h2 h3:= H2; have->//:=h1 _ h. + by move:h => <<-; rewrite H6 //=. + + rewrite mem_set//=; have[]//=h:= H5 _ _ H11; left. + have []h1 []->//=:= H2. + by exists i0=>//=. + + move:H7; rewrite take_oversize 1:spec_dout//= => H7. + move:H10; rewrite mem_set. + case(m \in SRO.RO.RO.m{1})=>//=h. + - rewrite get_set_neqE; 1:smt(). + have []h1 []h2 ->//=:= H2. + by apply eq_in_map=> j;rewrite mem_range=>[][]hj1 hj2/=; rewrite H4//=h1//=. + by move=><<-; rewrite get_set_eqE//=. + alias{1} 1 l = [<:bool>]. + transitivity{1} { + l <@ Sample.sample(size_out); + r <- oget (of_list l); + } + (={glob SRO.RO.RO, x} ==> ={glob SRO.RO.RO, r}) + (x{1} = x0{2} /\ i{2} = 0 /\ n0{2} = size_out /\ mp = BIRO.IRO.mp{2} /\ + same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2} /\ x{1} \notin SRO.RO.RO.m{1} /\ + bs0{2} = [] + ==> + same_ro SRO.RO.RO.m{1} mp /\ i{2} = size_out /\ + (forall (l,j), (l,j) \in mp => (l,j) \in BIRO.IRO.mp{2}) /\ + (forall (l,j), (l,j) \in mp => BIRO.IRO.mp{2}.[(l,j)] = mp.[(l,j)]) /\ + (forall (l,j), (l,j) \in BIRO.IRO.mp{2} => (l,j) \in mp \/ (l = x0{2} /\ 0 <= j < i{2})) /\ + (forall j, 0 <= j < i{2} => (x0{2},j) \in BIRO.IRO.mp{2}) /\ + take i{2} (to_list r{1}) = bs0{2} /\ + take i{2} (to_list r{1}) = + map (fun (j : int) => oget BIRO.IRO.mp{2}.[(x0{2}, j)]) (range 0 i{2})); + progress. + + smt(). + + inline*; sp; wp. + rnd to_list (fun x => oget (of_list x)); auto; progress. + - smt(spec_dout supp_dlist to_listK spec2_dout size_out_gt0). + - rewrite -dout_equal_dlist dmap1E; apply mu_eq=> x/=. + smt(to_listK). + - rewrite-dout_equal_dlist supp_dmap; smt(dout_full). + smt(to_listK). + wp=>/=. + conseq(:_==> i{2} = size_out /\ size l{1} = size_out /\ + (forall (l0 : bool list) (j : int), + (l0, j) \in mp => (l0, j) \in BIRO.IRO.mp{2}) /\ + (forall (l0 : bool list) (j : int), + (l0, j) \in mp => BIRO.IRO.mp{2}.[(l0, j)] = mp.[(l0, j)]) /\ + (forall (l0 : bool list) (j : int), + (l0, j) \in BIRO.IRO.mp{2} => ((l0, j) \in mp) \/ (l0 = x0{2} /\ 0 <= j < i{2})) /\ + (forall (j : int), 0 <= j < i{2} => (x0{2}, j) \in BIRO.IRO.mp{2}) /\ + take i{2} l{1} = bs0{2} /\ + take i{2} l{1} = + map (fun (j : int) => oget BIRO.IRO.mp{2}.[(x0{2}, j)]) (range 0 i{2})); + progress. + + have[]//=h h1:=to_listK (oget (of_list l_L)) l_L; rewrite h1//==> {h1 h}. + smt(spec2_dout). + + have[]//=h h1:=to_listK (oget (of_list l_L)) l_L; rewrite h1//==> {h1 h}. + smt(spec2_dout). + transitivity{1} { + l <@ LoopSnoc.sample(size_out); + } + (={glob SRO.RO.RO} ==> ={glob SRO.RO.RO, l}) + (x{1} = x0{2} /\ i{2} = 0 /\ n0{2} = size_out /\ mp = BIRO.IRO.mp{2} /\ + same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2} /\ x0{2} \notin SRO.RO.RO.m{1} /\ + bs0{2} = [] + ==> + i{2} = size_out /\ size l{1} = size_out /\ + (forall (l,j), (l,j) \in mp => (l,j) \in BIRO.IRO.mp{2}) /\ + (forall (l,j), (l,j) \in mp => BIRO.IRO.mp{2}.[(l,j)] = mp.[(l,j)]) /\ + (forall (l,j), (l,j) \in BIRO.IRO.mp{2} => (l,j) \in mp \/ (l = x0{2} /\ 0 <= j < i{2})) /\ + (forall j, 0 <= j < i{2} => (x0{2},j) \in BIRO.IRO.mp{2}) /\ + take i{2} l{1} = bs0{2} /\ + take i{2} l{1} = + map (fun (j : int) => oget BIRO.IRO.mp{2}.[(x0{2}, j)]) (range 0 i{2})); + progress. + + smt(). + + by call Sample_LoopSnoc_eq; auto. + inline*; sp; wp. + conseq(:_==> i{2} = size_out /\ size l0{1} = i{2} /\ + same_ro SRO.RO.RO.m{1} mp /\ x0{2} \notin SRO.RO.RO.m{1} /\ + (forall l j, (l,j) \in mp => (l,j) \in BIRO.IRO.mp{2}) /\ + (forall l j, (l,j) \in mp => BIRO.IRO.mp{2}.[(l, j)] = mp.[(l, j)]) /\ + (forall l j, (l, j) \in BIRO.IRO.mp{2} => ((l, j) \in mp) \/ (l = x0{2} /\ 0 <= j < i{2})) /\ + (forall j, 0 <= j < i{2} => (x0{2}, j) \in BIRO.IRO.mp{2}) /\ + l0{1} = bs0{2} /\ bs0{2} = + map (fun (j : int) => oget BIRO.IRO.mp{2}.[(x0{2}, j)]) (range 0 i{2})); progress. + + smt(take_oversize). + + smt(take_oversize). + while(0 <= i{2} <= size_out /\ size l0{1} = i{2} /\ n0{2} = size_out /\ + ={i} /\ n{1} = n0{2} /\ + same_ro SRO.RO.RO.m{1} mp /\ x0{2} \notin SRO.RO.RO.m{1} /\ + (forall l j, (l,j) \in mp => (l,j) \in BIRO.IRO.mp{2}) /\ + (forall l j, (l,j) \in mp => BIRO.IRO.mp{2}.[(l, j)] = mp.[(l, j)]) /\ + (forall l j, (l, j) \in BIRO.IRO.mp{2} => ((l, j) \in mp) \/ (l = x0{2} /\ 0 <= j < i{2})) /\ + (forall j, 0 <= j < i{2} => (x0{2}, j) \in BIRO.IRO.mp{2}) /\ + l0{1} = bs0{2} /\ bs0{2} = + map (fun (j : int) => oget BIRO.IRO.mp{2}.[(x0{2}, j)]) (range 0 i{2})). + + sp; wp=> //=. + rcondt{2} 1; 1:auto; progress. + - have[]h1 [] h2 h3 := H1. + have:=h2 x0{hr}; rewrite H2/= negb_exists/= =>/(_ (size bs0{hr})). + rewrite size_ge0 H9/=; apply absurd =>/= h. + by have //=:= H5 _ _ h. + rnd; auto; progress. + - smt(size_ge0). + - smt(). + - by rewrite size_cat/=. + - by rewrite mem_set; left; rewrite H3. + - rewrite get_setE (H4 _ _ H12). + cut/#: !(l1, j) = (x0{2}, size bs0{2}). + move:H2; apply absurd=> //=[#] <<- ->>. + have[] h1 [] h2 h3 := H1. + by apply h2; smt(). + - move:H12; rewrite mem_set. + case((l1, j) \in BIRO.IRO.mp{2})=>//= h; 1: smt(). + by move=> [#] <<- ->> //=; rewrite size_ge0; smt(). + - rewrite mem_set. + case(j = size bs0{2})=>//=. + move=> h; rewrite h /=; have {H13} H13 {h} : j < size bs0{2} by smt(). + by apply H6. + - by rewrite cats1 get_set_sameE oget_some. + - rewrite get_set_sameE oget_some H7 rangeSr. + rewrite !size_map 1:size_ge0. + rewrite (size_map _ (range 0 (size bs0{2}))) size_range /=. + rewrite max_ler 1:size_ge0 map_rcons /=get_set_sameE oget_some; congr. + apply eq_in_map=> j. + rewrite mem_range /==> [] [] hj1 hj2. + by rewrite get_set_neqE //=; smt(). + auto; progress. + + smt(size_out_gt0). + + smt(). + + smt(). + + by rewrite range_geq. + smt(). + qed. + + lemma SHA3_second_preimage_resistant &m mess : + (D2Pre.m2{m} = mess) => + Pr[SRO.SecondPreimage(A, FM(CSetSize(Sponge), Perm)).main(mess) @ &m : res] <= + (limit ^ 2 - limit)%r / (2 ^ (r + c + 1))%r + + (4 * limit ^ 2)%r / (2 ^ c)%r + + (sigma + 1)%r * mu1 dout witness. + proof. + move=> init_mess. + rewrite(second_preimage_resistant_if_indifferentiable A A_ll (CSetSize(Sponge)) Perm &m mess init_mess). + exists (SimSetSize(Simulator)); split. + + by move=> F _; proc; inline*; auto. + cut->:Pr[Indiff0.Indif(CSetSize(Sponge, Perm), Perm, D2Pre(A)).main() @ &m : res] = + Pr[RealIndif(Sponge, Perm, DRestr(DSetSize(D2Pre(A)))).main() @ &m : res]. + + byequiv=>//=; proc. + inline Perm.init CSetSize(Sponge, Perm).init Sponge(Perm).init + FC(Sponge(Perm)).init; sp. + inline D2Pre(A, CSetSize(Sponge, Perm), Perm).distinguish. + inline DRestr(DSetSize(D2Pre(A)), Sponge(Perm), Perm).distinguish + DSetSize(D2Pre(A), FC(Sponge(Perm)), PC(Perm)).distinguish Cntr.init. + inline SRO.SecondPreimage(A, FInit(CSetSize(Sponge, Perm))).main + SRO.SecondPreimage(A, FInit(DFSetSize(FC(Sponge(Perm))))).main. + inline SRO.Bounder(FInit(CSetSize(Sponge, Perm))).init + SRO.Bounder(FInit(DFSetSize(FC(Sponge(Perm))))).init + SRO.Counter.init FInit(DFSetSize(FC(Sponge(Perm)))).init + FInit(CSetSize(Sponge, Perm)).init. + wp; sp; sim. + seq 1 1 : (={m1, m2, glob SRO.Counter, glob Perm} + /\ invm Perm.m{1} Perm.mi{1} + /\ ={c}(SRO.Counter,Cntr)); last first. + - if; auto; sp. + case(SRO.Counter.c{1} + ((size m2{1} + 1) %/ r + 1) + + max ((size_out + r - 1) %/ r - 1) 0 < limit); last first. + * rcondf{1} 2; 1: by auto; inline*; auto; conseq(: _ ==> true); auto. + rcondf{2} 2; 1: by auto; inline*; auto; conseq(: _ ==> true); auto. + auto; inline*; auto; sp; conseq(: _ ==> true); auto. + if{2}; sp; auto; sim. + while{1}(invm Perm.m{1} Perm.mi{1}) (((size_out + r - 1) %/ r)-i{1}). + + auto; sp; if; auto. + - sp; if ;auto; progress. + * exact (useful _ _ _ H H2). + * rewrite invm_set=>//=. + by move:H4; rewrite supp_dexcepted. + * smt(). + smt(). + smt(). + conseq(:_==> invm Perm.m{1} Perm.mi{1}); 1:smt(). + while{1}(invm Perm.m{1} Perm.mi{1})(size xs{1}). + + move=> _ z; auto; sp; if; auto; progress. + * exact (useful _ _ _ H H1). + * rewrite invm_set=>//=. + by move:H3; rewrite supp_dexcepted. + * smt(). + smt(). + auto; smt(size_ge0 size_eq0). + rcondt{1} 2; first by auto; inline*; auto; conseq(:_==> true); auto. + rcondt{2} 2; first by auto; inline*; auto; conseq(:_==> true); auto. + sim. + exists* m1{1}, m2{1}; elim* => a1 a2 c1 c2. + call (equiv_sponge_perm (c2 + ((size a1 + 1) %/ r + 1) + max ((size_out + r - 1) %/ r - 1) 0) a2). + auto; call (equiv_sponge_perm c2 a1); auto; progress. + smt(List.size_ge0 divz_ge0 gt0_r). + smt(List.size_ge0 divz_ge0 gt0_r). + call(: ={glob SRO.Counter, glob Perm, glob SRO.Bounder} + /\ invm Perm.m{1} Perm.mi{1} /\ ={c}(SRO.Counter,Cntr)). + + proc; sp; if; auto; sp; if; auto; sp. + exists * x{1}; elim* => m c1 c2 b1 b2. + by call(equiv_sponge_perm c1 m); auto; smt(). + inline*; auto; progress. + by rewrite /invm=> x y; rewrite 2!emptyE. + cut->:Pr[Indiff0.Indif(RO, SimSetSize(Simulator, RO), D2Pre(A)).main() @ &m : res] = + Pr[IdealIndif(BIRO.IRO, Simulator, DRestr(DSetSize(D2Pre(A)))).main() @ &m : res]. + + byequiv=>//=; proc. + inline Simulator(FGetSize(RO)).init RO.init Simulator(BIRO.IRO).init + BIRO.IRO.init Gconcl_list.BIRO2.IRO.init; sp. + inline D2Pre(A, RO, Simulator(FGetSize(RO))).distinguish. + inline DRestr(DSetSize(D2Pre(A)), BIRO.IRO, Simulator(BIRO.IRO)).distinguish + DSetSize(D2Pre(A), FC(BIRO.IRO), PC(Simulator(BIRO.IRO))).distinguish; wp; sim. + inline SRO.Bounder(FInit(DFSetSize(FC(BIRO.IRO)))).init + SRO.Bounder(FInit(RO)).init SRO.Counter.init FInit(RO).init + FInit(DFSetSize(FC(BIRO.IRO))).init Cntr.init; sp. + inline SRO.SecondPreimage(A, FInit(RO)).main + SRO.SecondPreimage(A, FInit(DFSetSize(FC(BIRO.IRO)))).main. + inline SRO.Bounder(FInit(RO)).init + SRO.Bounder(FInit(DFSetSize(FC(BIRO.IRO)))).init SRO.Counter.init + FInit(RO).init FInit(DFSetSize(FC(BIRO.IRO))).init. + sp; sim. + seq 1 1 : (={m1, m2, glob SRO.Counter} + /\ ={c}(SRO.Counter,Cntr) + /\ same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2}); last first. + - if; auto; sp. + case: (SRO.Counter.c{1} + ((size m2{1} + 1) %/ r + 1) + + max ((size_out + r - 1) %/ r - 1) 0 < limit); last first. + * rcondf{1} 2; first by auto; inline*; auto. + rcondf{2} 2; first auto; inline*; auto; sp. + + rcondt 1; first by auto; smt(). + by sp; rcondt 1; auto; conseq(:_==> true); auto. + inline*;sp; auto. + rcondt{2} 1; first by auto; smt(). + conseq(:_==> true); first smt(dout_ll). + sp; rcondt{2} 1; auto; conseq(:_==> true); auto. + by while{2}(true)(n0{2}-i{2}); auto; 1:(sp; if; auto); smt(dbool_ll). + rcondt{1} 2; first by auto; inline*; auto. + rcondt{2} 2; first auto; inline*; auto; sp. + + rcondt 1; first by auto; smt(). + by sp; rcondt 1; auto; conseq(:_==> true); auto. + sim. + exists* m1{1}, m2{1}; elim*=> a1 a2 c1 c2. + call(equiv_ro_iro (c2 + ((size a1 + 1) %/ r + 1) + + max ((size_out + r - 1) %/ r - 1) 0) a2). + auto; call(equiv_ro_iro c2 a1); auto; smt(). + call(: ={glob SRO.Counter, glob SRO.Bounder} /\ ={c}(SRO.Counter,Cntr) + /\ same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2}); auto. + + proc; sp; if; auto; sp; if; auto; sp. + exists* x{1}; elim* => a c1 c2 b1 b2. + call(equiv_ro_iro c1 a); auto; smt(). + smt(mem_empty). + have->//=:= SHA3Indiff (DSetSize(D2Pre(A))) &m _. + move=> F P P_f_ll P_fi_ll F_ll; proc; inline*; auto; sp. + seq 1 : true; auto. + + call (A_ll (SRO.Bounder(FInit(DFSetSize(F))))); auto. + by proc; inline*; sp; if; auto; sp; if; auto; sp; call F_ll; auto. + if; auto; sp. + seq 1 : true; auto. + + by call F_ll; auto. + sp; if; auto; sp; call F_ll; auto. + qed. + +end section SecondPreimage. + + + section Collision. declare module A : SRO.AdvCollision{SRO.RO.RO, SRO.RO.FRO, SRO.Bounder, Perm, @@ -162,18 +910,7 @@ section Collision. by move:H4; rewrite supp_dexcepted. qed. - - op same_ro (m1 : (bool list, f_out) fmap) (m2 : (bool list * int, bool) fmap) = - (forall m, m \in m1 => forall i, 0 <= i < size_out => (m,i) \in m2) - && (forall m, (exists i, 0 <= i < size_out /\ (m,i) \in m2) => m \in m1) - && (forall m, m \in m1 => to_list (oget m1.[m]) = map (fun i => oget m2.[(m,i)]) (range 0 size_out)). - - op same_ro2 (m1 : (bool list, bool list) fmap) (m2 : (bool list * int, bool) fmap) = - (forall m, m \in m1 => forall i, 0 <= i < size_out => (m,i) \in m2) - && (forall m, (exists i, 0 <= i < size_out /\ (m,i) \in m2) => m \in m1) - && (forall m, m \in m1 => oget m1.[m] = map (fun i => oget m2.[(m,i)]) (range 0 size_out)). - - clone import Program as Prog with + clone import Program as Prog3 with type t <- bool, op d <- dbool proof *. @@ -262,7 +999,7 @@ section Collision. + smt(). + inline*; sp; wp. rnd to_list (fun x => oget (of_list x)); auto; progress. - - smt(spec_dout supp_dlist to_listK spec2_dout size_out_gt0). search dout. + - smt(spec_dout supp_dlist to_listK spec2_dout size_out_gt0). - rewrite -dout_equal_dlist dmap1E; apply mu_eq=> x/=. smt(to_listK). - rewrite-dout_equal_dlist supp_dmap; smt(dout_full). @@ -283,7 +1020,7 @@ section Collision. + have[]//=h h1:=to_listK (oget (of_list l_L)) l_L; rewrite h1//==> {h1 h}. smt(spec2_dout). + have[]//=h h1:=to_listK (oget (of_list l_L)) l_L; rewrite h1//==> {h1 h}. - smt(spec2_dout). print Prog. + smt(spec2_dout). transitivity{1} { l <@ LoopSnoc.sample(size_out); } @@ -371,14 +1108,14 @@ section Collision. rewrite (coll_resistant_if_indifferentiable A A_ll (CSetSize(Sponge)) Perm &m). exists (SimSetSize(Simulator)); split. + by move=> F _; proc; inline*; auto. - cut->:Pr[Indiff0.Indif(CSetSize(Sponge, Perm), Perm, D(A)).main() @ &m : res] = - Pr[RealIndif(Sponge, Perm, DRestr(DSetSize(D(A)))).main() @ &m : res]. + cut->:Pr[Indiff0.Indif(CSetSize(Sponge, Perm), Perm, DColl(A)).main() @ &m : res] = + Pr[RealIndif(Sponge, Perm, DRestr(DSetSize(DColl(A)))).main() @ &m : res]. + byequiv=>//=; proc. inline Perm.init CSetSize(Sponge, Perm).init Sponge(Perm).init FC(Sponge(Perm)).init; sp. - inline D(A, CSetSize(Sponge, Perm), Perm).distinguish. - inline DRestr(DSetSize(D(A)), Sponge(Perm), Perm).distinguish - DSetSize(D(A), FC(Sponge(Perm)), PC(Perm)).distinguish Cntr.init; wp; sp; sim. + inline DColl(A, CSetSize(Sponge, Perm), Perm).distinguish. + inline DRestr(DSetSize(DColl(A)), Sponge(Perm), Perm).distinguish + DSetSize(DColl(A), FC(Sponge(Perm)), PC(Perm)).distinguish Cntr.init; wp; sp; sim. seq 2 2 : (={m1, m2, glob SRO.Counter, glob Perm} /\ invm Perm.m{1} Perm.mi{1} /\ ={c}(SRO.Counter,Cntr)); last first. @@ -393,7 +1130,7 @@ section Collision. + auto; sp; if; auto. - sp; if ;auto; progress. * exact (useful _ _ _ H H2). - * rewrite invm_set=>//=. search (\). + * rewrite invm_set=>//=. by move:H4; rewrite supp_dexcepted. * smt(). smt(). @@ -422,14 +1159,14 @@ section Collision. by call(equiv_sponge_perm c1 m); auto; smt(). inline*; auto; progress. by rewrite /invm=> x y; rewrite 2!emptyE. - cut->:Pr[Indiff0.Indif(RO, SimSetSize(Simulator, RO), D(A)).main() @ &m : res] = - Pr[IdealIndif(BIRO.IRO, Simulator, DRestr(DSetSize(D(A)))).main() @ &m : res]. + cut->:Pr[Indiff0.Indif(RO, SimSetSize(Simulator, RO), DColl(A)).main() @ &m : res] = + Pr[IdealIndif(BIRO.IRO, Simulator, DRestr(DSetSize(DColl(A)))).main() @ &m : res]. + byequiv=>//=; proc. inline Simulator(FGetSize(RO)).init RO.init Simulator(BIRO.IRO).init BIRO.IRO.init Gconcl_list.BIRO2.IRO.init; sp. - inline D(A, RO, Simulator(FGetSize(RO))).distinguish. - inline DRestr(DSetSize(D(A)), BIRO.IRO, Simulator(BIRO.IRO)).distinguish - DSetSize(D(A), FC(BIRO.IRO), PC(Simulator(BIRO.IRO))).distinguish; wp; sim. + inline DColl(A, RO, Simulator(FGetSize(RO))).distinguish. + inline DRestr(DSetSize(DColl(A)), BIRO.IRO, Simulator(BIRO.IRO)).distinguish + DSetSize(DColl(A), FC(BIRO.IRO), PC(Simulator(BIRO.IRO))).distinguish; wp; sim. inline SRO.Bounder(FInit(DFSetSize(FC(BIRO.IRO)))).init SRO.Bounder(FInit(RO)).init SRO.Counter.init FInit(RO).init FInit(DFSetSize(FC(BIRO.IRO))).init Cntr.init; sp. @@ -462,10 +1199,10 @@ section Collision. + proc; sp; if; auto; sp; if; auto; sp. exists* x{1}; elim* => a c1 c2 b1 b2. call(equiv_ro_iro c1 a); auto; smt(). - smt(mem_empty). print SHA3Indiff. - have->//=:= SHA3Indiff (DSetSize(D(A))) &m _. + smt(mem_empty). + have->//=:= SHA3Indiff (DSetSize(DColl(A))) &m _. move=> F P P_f_ll P_fi_ll F_ll; proc; inline*; auto; sp. - seq 1 : true; auto. print A_ll. + seq 1 : true; auto. + call (A_ll (SRO.Bounder(FInit(DFSetSize(F))))); auto. by proc; inline*; sp; if; auto; sp; if; auto; sp; call F_ll; auto. if; auto; sp. @@ -474,6 +1211,4 @@ section Collision. sp; if; auto; sp; call F_ll; auto. qed. - - end section Collision. \ No newline at end of file From 98fd0536c0ea9afe819960ebafc3c9a988c7b637 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Thu, 11 Apr 2019 12:49:09 +0200 Subject: [PATCH 340/525] fix to work with deploy-kms --- proof/SHA3Security.ec | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/proof/SHA3Security.ec b/proof/SHA3Security.ec index 3f309d2..bc5287b 100644 --- a/proof/SHA3Security.ec +++ b/proof/SHA3Security.ec @@ -967,11 +967,11 @@ section Collision. + move:H8; rewrite mem_set=>[][]//=h; 1:rewrite H3=>//=. - by have []h1 []h2 h3:= H2; have->//:=h1 _ h. by move:h => <<-; rewrite H6 //=. - + rewrite mem_set //=; have [] //= h:= H5 _ _ H10; left. + + rewrite mem_set //=; have [] //= h:= H5 _ _ H11; left. have []h1 []->//=:= H2. by exists i0=>//=. + move:H7; rewrite take_oversize 1:spec_dout//= => H7. - move:H8; rewrite mem_set. + move:H10; rewrite mem_set. case(m \in SRO.RO.RO.m{1})=>//=h. - rewrite get_set_neqE; 1:smt(). have []h1 []h2 ->//=:= H2. From 6f98e0311f894d08e03c68202802a9c9465fb830 Mon Sep 17 00:00:00 2001 From: Manuel Barbosa Date: Thu, 11 Apr 2019 15:38:02 +0300 Subject: [PATCH 341/525] Making things more concrete --- proof/impl/Spec.ec | 208 ++++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 195 insertions(+), 13 deletions(-) diff --git a/proof/impl/Spec.ec b/proof/impl/Spec.ec index c96038b..003787c 100644 --- a/proof/impl/Spec.ec +++ b/proof/impl/Spec.ec @@ -1,38 +1,220 @@ require import AllCore List Int IntDiv. require import JArray JMemory JModel JUtils JWord JWord_array. require import Sponge. +import Common. +import Block. +import Capacity. clone export PolyArray as Array25 with op size <- 25. -op memr2bits : global_mem_t -> int -> int -> bool list. -op eqmem_except : global_mem_t -> global_mem_t -> int -> int -> bool. -op state2bc : W64.t Array25.t -> Common.block * Common.capacity. +op domain_bits : bool list. + +(* we will fix domain bits without the 1 that signals padding start *) +axiom domain_bits_len : size domain_bits < 8. + +type state = W64.t Array25.t. + +op memr2bits( mem : global_mem_t, ptr : int, len : int) = + foldr (fun w bs => bs ++ (W8.w2bits w)) [] + (map (fun o => mem.[ptr + o]) (iota_ 0 len)). + +op eqmem_except(mem1 : global_mem_t, mem2 : global_mem_t, ptr : int, o : int) = + forall ad, ptr <= ad < ptr + o => mem1.[ad] = mem2.[ad]. + +op state2bc(st : state) : block * capacity = + let stbits = (foldr (fun bl bs => (W64.w2bits bl) ++ bs) [] (to_list st)) + in (mkblock (take r stbits), mkcapacity (drop r stbits)). module type PermT = { - proc perm(st : W64.t Array25.t) : W64.t Array25.t + proc perm(st : state) : state }. +type wblock = W64.t list. + +(* True for all block sizes we will consider *) +axiom wblock_size x : + size (foldr (fun (bl : W64.t) (bs : bool list) => w2bits bl ++ bs) [] x) = r. + +(* This will load all bytes to packed W64, then pack those into blocks. + Domain byte is added as well, which will be domain_bits followed by a 1. + Everything is extended with 0s up to full block. *) +op loadpad2wblocks : global_mem_t -> int -> int -> wblock list. + +(* Stores up to len bytes in memory from list of blocks *) +op storeblocks : global_mem_t -> int -> int -> wblock list -> global_mem_t. + +op state0 : state = Array25.of_list (W64.of_int 0) []. + +op squeezeb(st : state) = take (r %/ 64) (to_list st). + +op wblock0 : wblock = take (r %/ 64) (to_list state0). + +op combine(st : state, wb : wblock) : state = + let stl = to_list st in + let wbst = take (r %/ 64) stl in + let wbstc = map (fun x : W64.t * W64.t => x.`1 `^` x.`2) (zip wbst wb) in + Array25.of_list (W64.of_int 0) (wbstc ++ (drop (r %/ 64) stl)). + +op convb(outl : int) = (outl*8 + r - 1) %/ r. + module Spec(P : PermT) = { proc f(out : int, outlen : int, inp : int, inlen : int) = { - (* ref impl goes here *) + var z,st,i,xs; + z <- []; + st <- state0; + i <- 0; + xs <- loadpad2wblocks Glob.mem inp inlen; + while (xs <> []){ + st <@ P.perm(combine st (head wblock0 xs)); + xs <- behead xs; + } + while (i < convb outlen){ + z <- z ++ [squeezeb st]; + i <- i + 1; + if (i < convb outlen) + st <@ P.perm(st); + } + + Glob.mem <- storeblocks Glob.mem out outlen z; } }. section. declare module Pideal : DPRIMITIVE. -declare module Preal : PermT. +declare module Preal : PermT {Glob}. (* Note it cannot touch memory *) axiom perm_correct : -equiv [Pideal.f ~ Preal.perm : - x{1} = state2bc st{2} ==> res{1} = state2bc res{2}]. + equiv [Pideal.f ~ Preal.perm : + x{1} = state2bc st{2} ==> + res{1} = state2bc res{2}]. + +op wblock2block(wb : wblock) : block = + mkblock (foldr (fun bl bs => (W64.w2bits bl) ++ bs) [] wb). + +op wblocks2bits(wbs : wblock list) : bool list = + foldr (fun bl bs => ofblock (wblock2block bl) ++ bs) [] wbs. + +op wblock2bits_list(wbs : wblock list) : block list = + foldr (fun bl bs => (wblock2block bl) :: bs) [] wbs. + +lemma wblocks2bits_empty : [] = wblocks2bits [] by auto => />. + +lemma state0conv : (b0, c0) = state2bc state0. +rewrite /state2bc. rewrite /b0 /c0 /state0. +admit. (* provable *) +qed. + +(* will need to be proved once loadpad2wblocks is defined *) +lemma paddings_same mem inp inl: + pad (memr2bits mem inp inl ++ domain_bits) = + wblocks2bits (loadpad2wblocks mem inp inl) by admit. + +lemma liftpadding mem inp inl : + pad2blocks (memr2bits mem inp inl ++ domain_bits) = + wblock2bits_list (loadpad2wblocks mem inp inl). +rewrite /pad2blocks /(\o) /wblock2bits_list paddings_same /wblocks2bits. +elim (loadpad2wblocks mem inp inl). +smt. +progress. +move : H. +rewrite /wblock2block. +rewrite ofblockK;first by apply wblock_size. +move => *. +rewrite -H. +rewrite /bits2blocks. +rewrite -map_cons. +rewrite chunk_cat. rewrite wblock_size. by apply dvdzz. +rewrite chunk_sing. rewrite wblock_size. by trivial. +rewrite cat1s. +by trivial. +qed. + +lemma lift_combine sa sc st xs : + (sa, sc) = state2bc st => + (sa +^ head b0 (wblock2bits_list xs), sc) = + state2bc (combine st (head wblock0 xs)) + by admit. (* provable *) + +lemma behead_wblockl xs : + behead (wblock2bits_list xs) = wblock2bits_list (behead xs). +rewrite /wblock2bits_list . +elim xs;smt(). +qed. + +lemma behead_wblocke xs : + behead (wblock2bits_list xs) = [] <=> behead xs = []. +rewrite /wblock2bits_list . +elim xs;smt(). +qed. + +lemma wbblockle xs : + wblock2bits_list xs = [] => xs = []. +rewrite /wblock2bits_list . +elim xs;smt(). +qed. + +lemma wbblockle_ : [] = wblock2bits_list []. +rewrite /wblock2bits_list . +smt(). +qed. + +lemma commuteappend z sa st sc : + (sa, sc) = state2bc st => + wblocks2bits z ++ ofblock sa = wblocks2bits (z ++ [squeezeb st]) + by admit. (* provable *) + +op validins(n : int, outl : int) = + n = outl * 8. + +lemma sizes1 i n1 n2 : validins n1 n2 => + i < (n1 + r - 1) %/ r => + i < convb n2 by smt. + +lemma sizes2 i n1 n2 : validins n1 n2 => + i < convb n2 => + i < (n1 + r - 1) %/ r by smt. + +(* Will need to be proved once storeblocks is defined *) +lemma store_blocks_safe mem out outlen z : + eqmem_except mem (storeblocks mem out outlen z) out outlen by admit. + +(* Will need to be proved once storeblocks is defined *) +lemma storeblocks_correct mem out outlen n z : + validins n outlen => + take n (wblocks2bits z) = + memr2bits (storeblocks mem out outlen z) out outlen by admit. lemma spec_correct mem outp outl: equiv [ Sponge(Pideal).f ~ Spec(Preal).f : - Glob.mem{2} = mem /\ bs{1} = memr2bits mem inp{2} inlen{2} /\ - out{2} = outp /\ outlen{2} = outl /\ outl = n{1} %/ 8 /\ outl %% 8 = 0 + Glob.mem{2} = mem /\ bs{1} = memr2bits mem inp{2} inlen{2} ++ domain_bits /\ + outlen{2} = outl /\ validins n{1} outlen{2} /\ out{2} = outp ==> eqmem_except mem Glob.mem{2} outp outl /\ res{1} = memr2bits Glob.mem{2} outp outl]. -admitted. - -end section. +proc. +seq 4 4 : ( +#pre /\ +z{1} = wblocks2bits z{2} /\ +(sa{1},sc{1}) = state2bc st{2} /\ +={i} /\ xs{1} = wblock2bits_list xs{2} +); first by wp;skip;smt(wblocks2bits_empty state0conv liftpadding). +seq 1 1 : #pre. +while #pre. +by wp;call (perm_correct); wp;skip; smt(lift_combine behead_wblockl behead_wblocke). +by skip; smt(behead_wblockl behead_wblocke). +seq 1 1 : #pre. +while #pre. +seq 2 2 : #[/:-2]pre; first by wp;skip; smt(commuteappend). +if => //=. +progress. +apply(sizes1 i{2} n{1} outlen{2} H) => //=. +apply(sizes2 i{2} n{1} outlen{2} H) => //=. +call perm_correct;skip;progress => //=. +apply(sizes1 i{2} n{1} outlen{2} H) => //=. +skip;progress => //=. +apply(sizes2 i{2} n{1} outlen{2} H) => //=. +skip;progress => //=. +apply(sizes1 i{2} n{1} outlen{2} H) => //=. +apply(sizes2 i{2} n{1} outlen{2} H) => //=. +wp;skip;progress;smt(store_blocks_safe storeblocks_correct). +qed. From 39b2e4bb68c91962ae8b0507fa2a4da415c37c82 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Thu, 11 Apr 2019 15:53:06 +0200 Subject: [PATCH 342/525] replace the "mu _ _" by its value --- proof/SHA3Security.ec | 31 ++++++++++++++++++++++++++++--- 1 file changed, 28 insertions(+), 3 deletions(-) diff --git a/proof/SHA3Security.ec b/proof/SHA3Security.ec index bc5287b..8033ac7 100644 --- a/proof/SHA3Security.ec +++ b/proof/SHA3Security.ec @@ -28,6 +28,28 @@ axiom to_listK e l : to_list e = l <=> of_list l = Some e. axiom dout_equal_dlist : dmap dout to_list = dlist dbool size_out. +lemma doutE1 x : mu1 dout x = inv (2%r ^ size_out). +proof. +cut->:inv (2%r ^ size_out) = mu1 (dlist dbool size_out) (to_list x). ++ rewrite dlist1E. + - smt(size_out_gt0). + rewrite spec_dout/=. + pose p:= StdBigop.Bigreal.BRM.big _ _ _. + cut->: p = StdBigop.Bigreal.BRM.big predT (fun _ => inv 2%r) (to_list x). + - rewrite /p =>{p}. print StdBigop.Bigreal.BRM. + apply StdBigop.Bigreal.BRM.eq_bigr. + by move=> i; rewrite//= dbool1E. + rewrite StdBigop.Bigreal.BRM.big_const count_predT spec_dout=> {p}. search 0 Int.(+) 1 (<=). + have:=size_out_gt0; move/ltzW. + move:size_out;apply intind=> //=. + - by rewrite powr0 iter0 //= fromint1. + move=> i hi0 rec. + by rewrite powrS//iterS// -rec; smt(). +rewrite -dout_equal_dlist dmap1E. +apply mu_eq. +by move=> l; rewrite /pred1/(\o); smt(to_listK). +qed. + module CSetSize (F : CONSTRUCTION) (P : DPRIMITIVE) = { proc init = F(P).init proc f (x : bool list) = { @@ -367,9 +389,10 @@ section Preimage. Pr[SRO.Preimage(A, FM(CSetSize(Sponge), Perm)).main(ha) @ &m : res] <= (limit ^ 2 - limit)%r / (2 ^ (r + c + 1))%r + (4 * limit ^ 2)%r / (2 ^ c)%r + - (sigma + 1)%r * mu1 dout ha. + (sigma + 1)%r / (2%r ^ size_out). proof. move=>init_ha. + rewrite -(doutE1 ha). rewrite(preimage_resistant_if_indifferentiable A A_ll (CSetSize(Sponge)) Perm &m ha init_ha). exists (SimSetSize(Simulator))=>//=; split. + by move=> F _; proc; inline*; auto. @@ -713,9 +736,10 @@ section SecondPreimage. Pr[SRO.SecondPreimage(A, FM(CSetSize(Sponge), Perm)).main(mess) @ &m : res] <= (limit ^ 2 - limit)%r / (2 ^ (r + c + 1))%r + (4 * limit ^ 2)%r / (2 ^ c)%r + - (sigma + 1)%r * mu1 dout witness. + (sigma + 1)%r / (2%r ^ size_out). proof. move=> init_mess. + rewrite -(doutE1 witness). rewrite(second_preimage_resistant_if_indifferentiable A A_ll (CSetSize(Sponge)) Perm &m mess init_mess). exists (SimSetSize(Simulator)); split. + by move=> F _; proc; inline*; auto. @@ -1103,8 +1127,9 @@ section Collision. Pr[SRO.Collision(A, FM(CSetSize(Sponge), Perm)).main() @ &m : res] <= (limit ^ 2 - limit)%r / (2 ^ (r + c + 1))%r + (4 * limit ^ 2)%r / (2 ^ c)%r + - (sigma * (sigma - 1) + 2)%r / 2%r * mu1 dout witness. + (sigma * (sigma - 1) + 2)%r / 2%r / (2%r ^ size_out). proof. + rewrite -(doutE1 witness). rewrite (coll_resistant_if_indifferentiable A A_ll (CSetSize(Sponge)) Perm &m). exists (SimSetSize(Simulator)); split. + by move=> F _; proc; inline*; auto. From 2547a953c84ad416bf1e04cc36720c8636b52118 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Thu, 11 Apr 2019 18:25:51 +0100 Subject: [PATCH 343/525] Attempt at integrating CI with external lib for Jasmin --- .gitlab-ci.yml | 3 +- proof/impl/JArray.ec | 569 --------- proof/impl/JMemory.ec | 411 ------- proof/impl/JModel.ec | 322 ----- proof/impl/JUtils.ec | 280 ----- proof/impl/JWord.ec | 2432 ------------------------------------- proof/impl/JWord_array.ec | 263 ---- proof/impl/Spec.ec | 2 +- 8 files changed, 3 insertions(+), 4279 deletions(-) delete mode 100644 proof/impl/JArray.ec delete mode 100644 proof/impl/JMemory.ec delete mode 100644 proof/impl/JModel.ec delete mode 100644 proof/impl/JUtils.ec delete mode 100644 proof/impl/JWord.ec delete mode 100644 proof/impl/JWord_array.ec diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 8452d80..1a69a6f 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -6,13 +6,14 @@ services: before_script: - docker info - docker pull easycryptpa/ec-test-box:kms +- git clone -b array_cast https://github.com/jasmin-lang/jasmin sha3: only: - master script: - >- docker run -v $PWD:/home/ci/sha3 easycryptpa/ec-test-box:kms - sh -c 'cd sha3 && opam config exec -- make check-xunit' + sh -c 'cd sha3 && ECARGS="-I Jasmin:/home/ci/sha3/jasmin/eclib" opam config exec -- make check-xunit' artifacts: when: on_failure paths: diff --git a/proof/impl/JArray.ec b/proof/impl/JArray.ec deleted file mode 100644 index 27cfe5f..0000000 --- a/proof/impl/JArray.ec +++ /dev/null @@ -1,569 +0,0 @@ -require import AllCore SmtMap List. -(*---*) import CoreMap. -require import JUtils. - -(*-------------------------------------------------------------------- *) - -abstract theory MonoArray. - - type elem. - op dfl : elem. - - op size: int. - - axiom ge0_size : 0 <= size. - - type t. - - op "_.[_]" : t -> int -> elem. - - op init : (int -> elem) -> t. - - axiom get_out (t:t) i : !(0 <= i < size) => t.[i] = dfl. - - axiom initE (f:int -> elem) i : - (init f).[i] = if 0 <= i < size then f i else dfl. - - axiom ext_eq (t1 t2: t) : - (forall x, 0 <= x < size => t1.[x] = t2.[x]) => - t1 = t2. - - lemma tP (t1 t2: t) : - t1 = t2 <=> forall i, 0 <= i < size => t1.[i] = t2.[i]. - proof. by move=> />;apply ext_eq. qed. - - lemma init_ext (f1 f2: int -> elem): - (forall x, 0 <= x < size => f1 x = f2 x) => - init f1 = init f2. - proof. by move=> h;apply ext_eq => i hi;rewrite !initE hi h. qed. - - (* -------------------------------------------------------------------- *) - lemma initiE (f:int -> elem) i : 0 <= i < size => (init f).[i] = f i. - proof. by move=> hi;rewrite initE hi. qed. - - hint simplify initiE. - (* -------------------------------------------------------------------- *) - op "_.[_<-_]" (t:t) (i:int) (e:elem) = - init (fun j => if j = i then e else t.[j]) - axiomatized by setE. - - lemma get_set_if (t:t) (i j :int) (a:elem) : - t.[i <- a].[j] = if 0 <= i < size /\ j = i then a else t.[j]. - proof. - rewrite setE initE /=; smt (get_out). - qed. - - lemma get_setE (t:t) (x y:int) (a:elem) : - 0 <= x < size => t.[x<-a].[y] = if y = x then a else t.[y]. - proof. by move=> hx;rewrite get_set_if hx. qed. - - lemma nosmt set_eqiE (t : t) x y a : - 0 <= x < size => y = x => t.[x <- a].[y] = a. - proof. by move=> h1 ->;rewrite get_setE. qed. - - lemma nosmt set_neqiE (t : t) x y a : - 0 <= x < size => y <> x => t.[x <- a].[y] = t.[y]. - proof. by move=> h1; rewrite get_setE // => ->. qed. - - hint simplify (set_eqiE, set_neqiE). - - lemma set_out (i : int) (e : elem) (t : t): - ! (0 <= i < size) => t.[i <- e] = t. - proof. - by move=> hi; apply ext_eq => j hj; rewrite get_set_if hi. - qed. - - lemma set_neg (i : int) (e : elem) (t : t): - i < 0 => t.[i<- e] = t. - proof. move=> hi;apply set_out => /#. qed. - - lemma set_above (i : int) (e : elem) (t : t): - size <= i => t.[i <- e] = t. - proof. move=> hi;apply set_out => /#. qed. - - lemma set_set_if (t : t) (k k' : int) (x x' : elem): - t.[k <- x].[k' <- x'] - = if k = k' - then t.[k' <- x'] - else t.[k' <- x'].[k <- x]. - proof. - apply ext_eq => i hi;case (k = k') => [<<- | neqk];rewrite !get_set_if /#. - qed. - - lemma set_set_eq (t : t) (k : int) (x x' : elem): - t.[k <- x].[k <- x'] = t.[k <- x']. - proof. by rewrite set_set_if. qed. - - lemma set_set_eq_s (t : t) (k1 k2 : int) (x x' : elem): - k1 = k2 => t.[k1 <- x].[k2 <- x'] = t.[k2 <- x']. - proof. move=> ->; apply set_set_eq. qed. - - hint simplify (set_set_eq_s, set_out). - - lemma set_set_swap (t : t) (k k' : int) (x x' : elem): - k <> k' => t.[k <- x].[k' <- x'] = t.[k' <- x'].[k <- x]. - proof. by rewrite set_set_if => ->. qed. - - lemma set_notmod (t:t) i : t.[i <- t.[i]] = t. - proof. - by apply ext_eq => j hj; rewrite get_set_if; case: (0 <= i < size /\ j = i). - qed. - - (* -------------------------------------------------------------------- *) - op of_list (l:elem list) = - init (fun i => nth dfl l i) - axiomatized by of_listE. - - op to_list (t:t) = - mkseq (fun i => t.[i]) size. - - lemma to_listE (t:t) : to_list t = map (fun i => t.[i]) (iota_ 0 size). - proof. done. qed. - - lemma size_to_list (t:t): size (to_list t) = size. - proof. rewrite /to_listE size_mkseq /max; smt (ge0_size). qed. - - lemma get_of_list (l:elem list) i : 0 <= i < size => - (of_list l).[i] = nth dfl l i. - proof. by move=> hi;rewrite of_listE initiE. qed. - - lemma get_to_list (t : t) i : nth dfl (to_list t) i = t.[i]. - proof. - rewrite nth_mkseq_if; case:(0 <= i < size) => hi //. - rewrite get_out //. - qed. - - lemma of_listK (l : elem list) : size l = size => - to_list (of_list l) = l. - proof. - move=> h; apply (eq_from_nth dfl); 1:by rewrite size_to_list h. - move=> i; rewrite size_to_list => hi. - by rewrite get_to_list // get_of_list. - qed. - - lemma to_listK : cancel to_list of_list. - proof. - move=> t; apply ext_eq => i hi. - by rewrite get_of_list // get_to_list. - qed. - - lemma to_list_inj : injective to_list. - proof. by apply/(can_inj _ _ to_listK). qed. - - hint simplify (get_of_list, get_to_list)@0. - hint simplify to_listK@0. - hint simplify to_listE@1. - - lemma init_of_list f : init f = of_list (map f (iota_ 0 size)). - proof. - apply tP => i hi;rewrite get_of_list // (nth_map 0) 1:size_iota 1:/#. - by rewrite nth_iota // initiE. - qed. - - (* hint simplify init_of_list@1. *) - - (* -------------------------------------------------------------------- *) - op create (a:elem) = init (fun (i:int) => a). - - lemma createiE (a:elem) i : 0 <= i < size => (create a).[i] = a. - proof. by apply initiE. qed. - - lemma createL (a:elem) : create a = of_list (map (fun i => a) (iota_ 0 size)). - proof. by rewrite /create init_of_list. qed. - - hint simplify (createiE, createL). - - (* -------------------------------------------------------------------- *) - op map (f: elem -> elem) (t:t) : t = - init (fun i => f t.[i]) - axiomatized by mapE. - - lemma mapiE f t i : 0 <= i < size => (map f t).[i] = f t.[i]. - proof. by rewrite mapE;apply initiE. qed. - - lemma map_of_list f ws : - map f (of_list ws) = of_list (mapN f dfl ws size). - proof. - by apply tP => i hi; rewrite mapiE // !get_of_list // nth_mapN. - qed. - - lemma map_to_list f t : - map f t = of_list (map f (to_list t)). - proof. by rewrite to_listE mapE /= -map_comp // init_of_list. qed. - - hint simplify (mapiE, map_of_list)@0. -(* hint simplify map_to_list@1. *) - - (* -------------------------------------------------------------------- *) - op map2 (f: elem -> elem -> elem) (t1 t2:t) : t = - init (fun i => f t1.[i] t2.[i]) - axiomatized by map2E. - - lemma map2iE f t1 t2 i : 0 <= i < size => (map2 f t1 t2).[i] = f t1.[i] t2.[i]. - proof. by rewrite map2E;apply initiE. qed. - - lemma map2_of_list f ws1 ws2 : - map2 f (of_list ws1) (of_list ws2) = of_list (mapN2 f dfl dfl ws1 ws2 size). - proof. - by apply tP => i hi; rewrite map2iE // !get_of_list // nth_mapN2. - qed. - - lemma map2_to_list f t1 t2 : - map2 f t1 t2 = of_list (map2 f (to_list t1) (to_list t2)). - proof. - rewrite to_listE map2E map2_zip init_of_list /=;congr. - apply (eq_from_nth dfl). - + by rewrite !size_map size_zip !size_map min_ler. - move=> i; rewrite size_map => hi. - rewrite (nth_map 0) 1:// (nth_map (dfl,dfl)). - + by rewrite size_zip min_ler !size_map. - by rewrite /= nth_zip ?size_map // !(nth_map 0). - qed. - - hint simplify (map2iE, map2_of_list)@0. -(* hint simplify (map2_to_list)@1. *) - - (* -------------------------------------------------------------------- *) - op all_eq (t1 t2: t) = - all (fun x => t1.[x] = t2.[x]) (iota_ 0 size). - - lemma all_eq_eq (t1 t2: t) : all_eq t1 t2 => t1 = t2. - proof. - by move=> /allP h; apply ext_eq => x /mem_range; apply h. - qed. - - lemma all_eqP (t1 t2: t) : all_eq t1 t2 <=> t1 = t2. - proof. - split; 1:by apply all_eq_eq. - by move=> ->;apply /allP. - qed. - - (* -------------------------------------------------------------------- *) - op fill (f : int -> elem) (k len : int) (t : t) = - init (fun i => if k <= i < k + len then f i else t.[i]) - axiomatized by fillE. - - lemma filliE (f : int -> elem) (k len:int) (t : t) i : 0 <= i < size => - (fill f k len t).[i] = if k <= i < k + len then f i else t.[i]. - proof. by move=> hi;rewrite fillE initiE. qed. - - hint simplify filliE. - - (* -------------------------------------------------------------------- *) - op sub (t: t) k len = mkseq (fun (i:int) => t.[k+i]) len. - - lemma size_sub t k len : 0 <= len => size (sub t k len) = len. - proof. move=> hl; rewrite size_mkseq /max /#. qed. - - lemma nth_sub (t : t) k len i : 0 <= i < len => - nth dfl (sub t k len) i = t.[k + i]. - proof. by move=> h0i; rewrite nth_mkseq. qed. - -end MonoArray. - -abstract theory PolyArray. - - op size: int. - - axiom ge0_size : 0 <= size. - - type 'a t. - - op "_.[_]" : 'a t -> int -> 'a. - - op init : (int -> 'a) -> 'a t. - - axiom get_out (t:'a t) i : !(0 <= i < size) => t.[i] = witness. - - axiom initE (f:int -> 'a) i : - (init f).[i] = if 0 <= i < size then f i else witness. - - axiom ext_eq (t1 t2: 'a t) : - (forall x, 0 <= x < size => t1.[x] = t2.[x]) => - t1 = t2. - - lemma tP (t1 t2: 'a t) : - t1 = t2 <=> forall i, 0 <= i < size => t1.[i] = t2.[i]. - proof. by move=> />;apply ext_eq. qed. - - (* -------------------------------------------------------------------- *) - lemma initiE (f:int -> 'a) i : 0 <= i < size => (init f).[i] = f i. - proof. by move=> hi;rewrite initE hi. qed. - - hint simplify initiE. - - (* -------------------------------------------------------------------- *) - op "_.[_<-_]" (t:'a t) (i:int) (e:'a) = - init (fun j => if j = i then e else t.[j]) - axiomatized by setE. - - lemma get_set_if (t:'a t) (i j :int) (a:'a) : - t.[i <- a].[j] = if 0 <= i < size /\ j = i then a else t.[j]. - proof. - rewrite setE initE /=; smt (get_out). - qed. - - lemma get_setE (t:'a t) (x y:int) (a:'a) : - 0 <= x < size => t.[x<-a].[y] = if y = x then a else t.[y]. - proof. by move=> hx; rewrite get_set_if hx. qed. - - lemma nosmt set_eqiE (t : 'a t) x y a : - 0 <= x < size => y = x => t.[x <- a].[y] = a. - proof. by move=> h1 ->;rewrite get_setE. qed. - - lemma nosmt set_neqiE (t : 'a t) x y a : - 0 <= x < size => y <> x => t.[x <- a].[y] = t.[y]. - proof. by move=> h1; rewrite get_setE // => ->. qed. - - hint simplify (set_eqiE, set_neqiE). - - lemma set_out (i : int) (e : 'a) (t : 'a t): - ! (0 <= i < size) => t.[i <- e] = t. - proof. - by move=> hi; apply ext_eq => j hj; rewrite get_set_if hi. - qed. - - lemma set_neg (i : int) (e : 'a) (t : 'a t): - i < 0 => t.[i<- e] = t. - proof. move=> hi;apply set_out => /#. qed. - - lemma set_above (i : int) (e : 'a) (t : 'a t): - size <= i => t.[i <- e] = t. - proof. move=> hi;apply set_out => /#. qed. - - lemma set_set_if (t : 'a t) (k k' : int) (x x' : 'a): - t.[k <- x].[k' <- x'] - = if k = k' - then t.[k' <- x'] - else t.[k' <- x'].[k <- x]. - proof. - apply ext_eq => i hi;case (k = k') => [<<- | neqk];rewrite !get_set_if /#. - qed. - - lemma set_set_eq (t : 'a t) (k : int) (x x' : 'a): - t.[k <- x].[k <- x'] = t.[k <- x']. - proof. by rewrite set_set_if. qed. - - lemma set_set_eq_s (t : 'a t) (k1 k2 : int) (x x' : 'a): - k1 = k2 => t.[k1 <- x].[k2 <- x'] = t.[k2 <- x']. - proof. move=> ->; apply set_set_eq. qed. - - hint simplify (set_set_eq_s, set_out). - - lemma set_set_swap (t : 'a t) (k k' : int) (x x' : 'a): - k <> k' => t.[k <- x].[k' <- x'] = t.[k' <- x'].[k <- x]. - proof. by rewrite set_set_if => ->. qed. - - lemma set_notmod (t:'a t) i : t.[i <- t.[i]] = t. - proof. - by apply ext_eq => j hj; rewrite get_set_if; case: (0 <= i < size /\ j = i). - qed. - - (* -------------------------------------------------------------------- *) - op create (a:'a) = init (fun (i:int) => a) - axiomatized by createE. - - lemma createiE (a:'a) i : 0 <= i < size => (create a).[i] = a. - proof. by rewrite createE;apply initiE. qed. - - hint simplify createiE. - - (* -------------------------------------------------------------------- *) - op map ['a, 'b] (f: 'a -> 'b) (t:'a t) : 'b t = - init (fun i => f t.[i]) - axiomatized by mapE. - - lemma mapiE ['a, 'b] (f: 'a -> 'b) t i : 0 <= i < size => (map f t).[i] = f t.[i]. - proof. by rewrite mapE;apply initiE. qed. - - hint simplify mapiE. - - (* -------------------------------------------------------------------- *) - op map2 ['a, 'b, 'c] (f: 'a -> 'b -> 'c) t1 t2 = - init (fun i => f t1.[i] t2.[i]) - axiomatized by map2E. - - lemma map2iE ['a, 'b, 'c] (f: 'a -> 'b -> 'c) t1 t2 i : 0 <= i < size => - (map2 f t1 t2).[i] = f t1.[i] t2.[i]. - proof. by rewrite map2E;apply initiE. qed. - - hint simplify map2iE. - - (* -------------------------------------------------------------------- *) - op all_eq (t1 t2: 'a t) = - all (fun x => t1.[x] = t2.[x]) (iota_ 0 size). - - lemma ext_eq_all (t1 t2: 'a t) : - all_eq t1 t2 <=> t1 = t2. - proof. - split. - + by move=> /allP h; apply ext_eq => x /mem_range; apply h. - by move=> ->;apply /allP. - qed. - - lemma all_eq_eq (t1 t2: 'a t) : all_eq t1 t2 => t1 = t2. - proof. by move=> /ext_eq_all. qed. - - (* -------------------------------------------------------------------- *) - - op of_list (dfl:'a) (l:'a list) = - init (fun i => nth dfl l i). - - op to_list (t:'a t) = - mkseq (fun i => t.[i]) size. - - lemma size_to_list (t:'a t): size (to_list t) = size. - proof. rewrite size_mkseq /max; smt (ge0_size). qed. - - lemma get_of_list (dfl:'a) (l:'a list) i : 0 <= i < size => - (of_list dfl l).[i] = nth dfl l i. - proof. by move=> hi;rewrite /of_list initiE. qed. - - hint simplify get_of_list. - - lemma get_to_list (t : 'a t) i : - nth witness (to_list t) i = t.[i]. - proof. - rewrite nth_mkseq_if; case:(0 <= i < size) => hi //. - rewrite get_out //. - qed. - - hint simplify (get_of_list, get_to_list). - - lemma of_listK (dfl:'a) (l : 'a list) : size l = size => - to_list (of_list dfl l) = l. - proof. - move=> h; apply (eq_from_nth witness); 1:by rewrite size_to_list h. - move=> i; rewrite size_to_list => hi. - rewrite get_to_list // get_of_list //. - by rewrite nth_onth (onth_nth witness) // h. - qed. - - lemma to_listK (dfl:'a) : cancel to_list (of_list dfl). - proof. - move=> t; apply ext_eq => i hi. - by rewrite get_of_list // nth_onth (onth_nth witness) ?size_to_list //= - get_to_list. - qed. - - lemma to_list_inj ['a] : injective (to_list<:'a>). - proof. by apply/(can_inj _ _ (to_listK witness)). qed. - - (* The following rules are for reduction *) - lemma map_of_list ['a, 'b] (f:'a -> 'b) dfa ws : - map f (of_list dfa ws) = of_list (f dfa) (map f ws). - proof. - apply tP => i hi; rewrite mapiE // !get_of_list //. - case (i < size ws) => isws. - + by rewrite (nth_map dfa) // /#. - by rewrite nth_out 1:/# nth_out // size_map 1:/#. - qed. - - lemma map2_of_list (f:'a -> 'b -> 'c) df1 df2 ws1 ws2 : - map2 f (of_list df1 ws1) (of_list df2 ws2) = - of_list (f df1 df2) (mapN2 f df1 df2 ws1 ws2 size). - proof. - by apply tP => i hi; rewrite map2iE // !get_of_list // nth_mapN2. - qed. - - hint simplify (map_of_list, map2_of_list)@0. - - (* -------------------------------------------------------------------- *) - op fill (f : int -> 'a) (k len : int) (t : 'a t) = - init (fun i => if k <= i < k + len then f i else t.[i]) - axiomatized by fillE. - - lemma filliE (f : int -> 'a) (k len:int) (t : 'a t) i : 0 <= i < size => - (fill f k len t).[i] = if k <= i < k + len then f i else t.[i]. - proof. by move=> hi;rewrite fillE initiE. qed. - - hint simplify filliE. - - (* -------------------------------------------------------------------- *) - op sub (t: 'a t) k len = mkseq (fun (i:int) => t.[k+i]) len. - - lemma size_sub (t:'a t) k len : 0 <= len => size (sub t k len) = len. - proof. move=> hl; rewrite size_mkseq /max /#. qed. - - lemma nth_sub (dfl:'a) (t : 'a t) k len i : 0 <= i < len => - nth dfl (sub t k len) i = t.[k + i]. - proof. by move=> h0i; rewrite nth_mkseq. qed. - - - (* -------------------------------------------------------------------- *) - op all (f : 'a -> bool) (t : 'a t) = - all (fun i => f t.[i]) (iota_ 0 size). - - lemma allP (t: 'a t) f : all f t <=> (forall i, 0 <= i < size => f t.[i]). - proof. - rewrite /all (allP);split => h i /=. - + by move=> hi;apply h;rewrite mem_iota //; case: hi. - by rewrite mem_iota /= => h1; apply h;case h1. - qed. - - (* -------------------------------------------------------------------- *) - op is_init (t: 'a option t) = all is_init t. - - lemma is_init_Some (t:'a t) : is_init (map Some t). - proof. by rewrite allP => i hi; rewrite mapiE. qed. - - hint simplify is_init_Some. - -end PolyArray. - -(*clone export PolyArray as Array0 with op size <- 0. -clone export PolyArray as Array1 with op size <- 1. -clone export PolyArray as Array2 with op size <- 2. -clone export PolyArray as Array3 with op size <- 3. -clone export PolyArray as Array4 with op size <- 4. -clone export PolyArray as Array5 with op size <- 5. -clone export PolyArray as Array6 with op size <- 6. -clone export PolyArray as Array7 with op size <- 7. -clone export PolyArray as Array8 with op size <- 8. -clone export PolyArray as Array9 with op size <- 9. - -clone export PolyArray as Array10 with op size <- 10. -clone export PolyArray as Array11 with op size <- 11. -clone export PolyArray as Array12 with op size <- 12. -clone export PolyArray as Array13 with op size <- 13. -clone export PolyArray as Array14 with op size <- 14. -clone export PolyArray as Array15 with op size <- 15. -clone export PolyArray as Array16 with op size <- 16. -clone export PolyArray as Array17 with op size <- 17. -clone export PolyArray as Array18 with op size <- 18. -clone export PolyArray as Array19 with op size <- 19. - -clone export PolyArray as Array20 with op size <- 20. -clone export PolyArray as Array21 with op size <- 21. -clone export PolyArray as Array22 with op size <- 22. -clone export PolyArray as Array23 with op size <- 23. -clone export PolyArray as Array24 with op size <- 24. -clone export PolyArray as Array25 with op size <- 25. -clone export PolyArray as Array26 with op size <- 26. -clone export PolyArray as Array27 with op size <- 27. -clone export PolyArray as Array28 with op size <- 28. -clone export PolyArray as Array29 with op size <- 29. - -clone export PolyArray as Array30 with op size <- 30. -clone export PolyArray as Array31 with op size <- 31. -clone export PolyArray as Array32 with op size <- 32. -clone export PolyArray as Array33 with op size <- 33. -clone export PolyArray as Array34 with op size <- 34. -clone export PolyArray as Array35 with op size <- 35. -clone export PolyArray as Array36 with op size <- 36. -clone export PolyArray as Array37 with op size <- 37. -clone export PolyArray as Array38 with op size <- 38. -clone export PolyArray as Array39 with op size <- 39. - -clone export PolyArray as Array40 with op size <- 40. -clone export PolyArray as Array41 with op size <- 41. -clone export PolyArray as Array42 with op size <- 42. -clone export PolyArray as Array43 with op size <- 43. -clone export PolyArray as Array44 with op size <- 44. -clone export PolyArray as Array45 with op size <- 45. -clone export PolyArray as Array46 with op size <- 46. -clone export PolyArray as Array47 with op size <- 47. -clone export PolyArray as Array48 with op size <- 48. -clone export PolyArray as Array49 with op size <- 49. *) - - diff --git a/proof/impl/JMemory.ec b/proof/impl/JMemory.ec deleted file mode 100644 index 80c9f4b..0000000 --- a/proof/impl/JMemory.ec +++ /dev/null @@ -1,411 +0,0 @@ -(* -------------------------------------------------------------------- *) -require import AllCore SmtMap List IntDiv. -(*---*) import CoreMap StdOrder.IntOrder. -require import JUtils JWord. - -(* -------------------------------------------------------------------- *) -theory W8List. - abbrev "_.[_]" (w : W8.t list) (i : int) = nth (W8.of_int 0) w i. -end W8List. -export W8List. - -(* -------------------------------------------------------------------- *) -type address = int. - -type global_mem_t. - -op "_.[_]" : global_mem_t -> address -> W8.t. -op "_.[_<-_]" : global_mem_t -> address -> W8.t -> global_mem_t. - -axiom mem_eq_ext (m1 m2:global_mem_t) : (forall j, m1.[j] = m2.[j]) => m1 = m2. - -axiom get_setE m x y w : - m.[x <- w].[y] = if y = x then w else m.[y]. - -lemma get_set_eqE_s m x y w : - y = x => m.[x <- w].[y] = w. -proof. by rewrite get_setE => ->. qed. - -lemma get_set_neqE_s m x y w : - y <> x => m.[x <- w].[y] = m.[y]. -proof. by rewrite get_setE => ->. qed. - -hint simplify (get_set_eqE_s, get_set_neqE_s). - -op allocated8 : global_mem_t -> address -> bool. - -axiom allocated8_setE y w m x: allocated8 m.[y<-w] x = allocated8 m x. - -(* ------------------------------------------------------------------- *) - -op stores (m : global_mem_t) (a : address) (w : W8.t list) = - foldl (fun (m:global_mem_t) i => m.[a + i <- w.[i]]) m (iota_ 0 (size w)). - -lemma foldl_in_eq (f1 f2:'a -> 'b -> 'a) (s:'b list) a : - (forall a b, b \in s => f1 a b = f2 a b) => foldl f1 a s = foldl f2 a s. -proof. - elim: s a => [ | b s hrec] a //= hin. - by rewrite hin // hrec // => ?? h;apply hin;rewrite h. -qed. - -lemma stores_cons m a w ws : stores m a (w::ws) = stores (m.[a <- w]) (a + 1) ws. -proof. - rewrite /stores /= iota_add 1:// 1:List.size_ge0. - rewrite foldl_cat (addzC 0 1) iota_addl /=. - rewrite -(revK (iota_ 0 (size ws))) map_rev !foldl_rev foldr_map /=. - rewrite -!foldl_rev !revK;apply foldl_in_eq => m0 i /mem_iota /= h /#. -qed. - -lemma allocated8_stores ws a m x : allocated8 (stores m a ws) x = allocated8 m x. -proof. - elim: ws m a => //= w ws hrec m a. - by rewrite stores_cons hrec allocated8_setE. -qed. - -lemma get_storesE m p l j: (stores m p l).[j] = if p <= j < p + size l then nth W8.zero l (j - p) else m.[j]. -proof. - elim: l m p => [ | w l hrec] m p. - + by rewrite /stores /= /#. - rewrite stores_cons hrec /= get_setE. smt (size_ge0). -qed. - -(* ------------------------------------------------------------------- *) -op loadW8 (m : global_mem_t) (a : address) = m.[a]. - -op loadW16 (m : global_mem_t) (a : address) = - pack2_t (W2u8.Pack.init (fun i => m.[a + i])). - -op loadW32 (m : global_mem_t) (a : address) = - pack4_t (W4u8.Pack.init (fun i => m.[a + i])). - -op loadW64 (m : global_mem_t) (a : address) = - pack8_t (W8u8.Pack.init (fun i => m.[a + i])). - -op loadW128 (m : global_mem_t) (a : address) = - pack16_t (W16u8.Pack.init (fun i => m.[a + i])). - -op loadW256 (m : global_mem_t) (a : address) = - pack32_t (W32u8.Pack.init (fun i => m.[a + i])). - -lemma loadW32_bits8 m p i : 0 <= i < 4 => - loadW32 m p \bits8 i = loadW8 m (p + i). -proof. by move=> hi;rewrite /loadW32 pack4bE // initiE. qed. - -lemma loadW128_bits8 m p i : 0 <= i < 16 => - loadW128 m p \bits8 i = loadW8 m (p + i). -proof. by move=> hi;rewrite /loadW128 pack16bE // initiE. qed. - -lemma loadW128_bits32 m p i : 0 <= i < 4 => - loadW128 m p \bits32 i = loadW32 m (p + i * 4). -proof. - move=> hi; rewrite /loadW128 /loadW32. - apply W32.wordP => j hj. - rewrite bits32iE // pack4wE // initiE; 1:by apply divz_cmp. - rewrite pack16wE; 1:by apply W4u32.in_bound. - rewrite initiE /=; 1:by apply divz_cmp => //=;apply W4u32.in_bound. - have -> : i * 32 = (i * 4) * 8 by ring. - by rewrite modzMDl divzMDl // -addzA. -qed. - -lemma load4u8 mem p : - pack4 - [loadW8 mem p; - loadW8 mem (p + 1); - loadW8 mem (p + 2); - loadW8 mem (p + 3)] = - loadW32 mem p. -proof. - have -> : W4u8.Pack.of_list - [loadW8 mem p; loadW8 mem (p + 1); - loadW8 mem (p + 2); loadW8 mem (p + 3)] = - W4u8.Pack.init (fun i => loadW8 mem (p + i)). - + by apply W4u8.Pack.all_eqP; rewrite /all_eq. - apply (can_inj _ _ W4u8.unpack8K); apply W4u8.Pack.packP => i hi. - by rewrite pack4K initiE. -qed. - -lemma load4u32 mem p : - pack4 - [loadW32 mem p; - loadW32 mem (p + 4); - loadW32 mem (p + 8); - loadW32 mem (p + 12)] = - loadW128 mem p. -proof. - have -> : W4u32.Pack.of_list - [loadW32 mem p; loadW32 mem (p + 4); - loadW32 mem (p + 8); loadW32 mem (p + 12)] = - W4u32.Pack.init (fun i => loadW32 mem (p + i * 4)). - + by apply W4u32.Pack.all_eqP; rewrite /all_eq. - apply (can_inj _ _ W4u32.unpack32K); apply W4u32.Pack.packP => i hi. - by rewrite pack4K initiE //= get_unpack32 // loadW128_bits32. -qed. - -(* ------------------------------------------------------------------- *) -op storeW8 (m : global_mem_t) (a : address) (w : W8.t) = - m.[a <- w] -axiomatized by storeW8E. - -op storeW16 (m : global_mem_t) (a : address) (w : W16.t) = - stores m a (to_list (unpack8 w)) -axiomatized by storeW16E. - -op storeW32 (m : global_mem_t) (a : address) (w : W32.t) = - stores m a (to_list (unpack8 w)) -axiomatized by storeW32E. - -op storeW64 (m : global_mem_t) (a : address) (w : W64.t) = - stores m a (to_list (unpack8 w)) -axiomatized by storeW64E. - -op storeW128 (m : global_mem_t) (a : address) (w : W128.t) = - stores m a (to_list (unpack8 w)) -axiomatized by storeW128E. - -op storeW256 (m : global_mem_t) (a : address) (w : W256.t) = - stores m a (to_list (unpack8 w)) -axiomatized by storeW256E. - -lemma pack4u32_bits8_nth i (ws:W32.t list) : 0 <= i < 16 => - W4u32.pack4 ws \bits8 i = nth W32.zero ws (i %/ 4) \bits8 (i%%4). -proof. - move=> hi; rewrite -W4u32.Pack.get_of_list; first by apply divz_cmp. - move: (W4u32.Pack.of_list ws) => w. - apply W8.wordP => k hk. - rewrite -W4u32.pack4bE; 1: by apply divz_cmp. - rewrite bits8iE // bits8iE // bits32iE; 1: smt(modz_cmp). - congr; rewrite {1}(divz_eq i 4); ring. -qed. - -lemma store4u32 mem ptr w0 w1 w2 w3 : - storeW128 mem ptr (W4u32.pack4 [w0; w1; w2; w3]) = - storeW32 - (storeW32 - (storeW32 - (storeW32 mem ptr w0) - (ptr + 4) w1) - (ptr + 8) w2) - (ptr + 12) w3. -proof. - rewrite storeW128E !storeW32E. - by rewrite /W4u8.Pack.to_list /mkseq /= /stores /=. -qed. - -lemma store4u8 mem ptr w0 w1 w2 w3 : - storeW32 mem ptr (W4u8.pack4 [w0; w1; w2; w3]) = - storeW8 - (storeW8 - (storeW8 - (storeW8 mem ptr w0) - (ptr + 1) w1) - (ptr + 2) w2) - (ptr + 3) w3. -proof. by rewrite storeW32E !storeW8E. qed. - -lemma get_storeW32E m p (w:W32.t) j : - (storeW32 m p w).[j] = if p <= j < p + 4 then w \bits8 (j - p) else m.[j]. -proof. rewrite storeW32E /= get_storesE /= /#. qed. - -(* ------------------------------------------------------------------- *) -(* Global Memory *) - -module Glob = { - var mem : global_mem_t -}. - -(* ------------------------------------------------------------------- *) -(* Safety *) - -op is_align (ws:wsize) (a:address) = - wsize_i ws %| a. - -op allocated (m:global_mem_t) (p:address) (N:int) : bool = - forall i, 0 <= i < N => allocated8 m (p + i). - -op is_valid (m:global_mem_t) (a:address) (ws:wsize) = - allocated m a (wsize_i ws) /\ is_align ws a -axiomatized by is_validE. - -op valid_range (w:wsize) (mem:global_mem_t) (ptr:address) (len:int) = - forall i, 0 <= i < len => is_valid mem (ptr + wsize_i w * i) w. - -(* ------------------------------------------------------------------- *) - -lemma is_align_le w2 w1 ptr: - wsize_i w1 <= wsize_i w2 => is_align w2 ptr => is_align w1 ptr. -proof. - by rewrite /is_align => hw; apply dvdz_trans; apply div_le_wsize. -qed. - -lemma is_align_add w ptr ofs: - wsize_i w %| ofs => is_align w ptr => is_align w (ptr + ofs). -proof. - by rewrite /is_align => h1 h2; apply dvdzD. -qed. - -(* ------------------------------------------------------------------- *) - -lemma allocated_stores a1 s mem a2 N: allocated (stores mem a1 s) a2 N = allocated mem a2 N. -proof. - rewrite /allocated /= eq_iff;split => h i hi. - + by rewrite -(allocated8_stores s a1) h. - by rewrite allocated8_stores h. -qed. - -lemma allocate_le m p (N1 N2:int) : - N1 <= N2 => - allocated m p N2 => allocated m p N1. -proof. rewrite /allocated => hle h i hi;apply h => /#. qed. - -(* ------------------------------------------------------------------- *) - -lemma valid_range_le (len1 len2:int) w mem ptr : - len1 <= len2 => - valid_range w mem ptr len2 => - valid_range w mem ptr len1. -proof. by move=> hle hv i hlt; apply hv => /#. qed. - -lemma is_valid_valid_range w1 w2 mem ptr : - wsize_i w1 <= wsize_i w2 => - is_valid mem ptr w2 => - valid_range w1 mem ptr (wsize_i w2 %/ wsize_i w1). -proof. - rewrite /valid_range is_validE => hw [ha hia] i hi. - rewrite is_validE is_align_add /=. - + by apply modzMr. - + by apply: is_align_le hia. - move=> k hk /=;rewrite -addzA;apply ha;split;[smt (gt0_wsize_i)|move=> ?]. - apply: (ltr_le_trans ((i + 1) * wsize_i w1)); 1: smt (). - rewrite (divz_eq (wsize_i w2) (wsize_i w1)). - smt (modz_cmp gt0_wsize_i). -qed. - -lemma valid_range_size_le w1 w2 mem ptr len : - wsize_i w1 <= wsize_i w2 => - valid_range w2 mem ptr len => - valid_range w1 mem ptr (len * (wsize_i w2 %/ wsize_i w1)). -proof. - rewrite /valid_range => hw hv i hi. - pose dw := wsize_i w2 %/ wsize_i w1. - have gt0_dw : 0 < dw. - + by apply ltz_divRL => //; apply div_le_wsize. - have := hv (i %/ dw) _. - + apply divz_cmp => //. - move=> /(is_valid_valid_range _ _ _ _ hw) /(_ (i %% dw) _) /=. - + by apply modz_cmp. - have <- := divzK _ _ (div_le_wsize _ _ hw); rewrite -/dw. - have -> : ptr + dw * wsize_i w1 * (i %/ dw) + wsize_i w1 * (i %% dw) = - ptr + wsize_i w1 * ((i %/ dw) * dw + i %% dw) by ring. - by rewrite -divz_eq. -qed. - -lemma valid_range_is_valid w1 w2 mem ptr : - wsize_i w1 <= wsize_i w2 => - is_align w2 ptr => - valid_range w1 mem ptr (wsize_i w2 %/ wsize_i w1) => - is_valid mem ptr w2. -proof. - move=> hw hia hr; rewrite is_validE. - pose dw := wsize_i w2 %/ wsize_i w1. - have gt0_dw : 0 < dw. - + by apply ltz_divRL => //; apply div_le_wsize. - split;last by (have := hr 0 _). - move=> i hi. - have := hr (i %/ wsize_i w1) _. - + split; 1: by apply divz_ge0;[ apply gt0_wsize_i | case hi]. - move=> ?;apply ltz_divRL => //; 1: by apply div_le_wsize. - by have := divz_eq i (wsize_i w1); have := modz_cmp i (wsize_i w1) _ => // /#. - rewrite is_validE; move => [] /(_ (i%%wsize_i w1) _); 1: by apply modz_cmp. - by rewrite mulzC -addzA -divz_eq. -qed. - -lemma valid_range_size_ge w1 w2 mem ptr len1 len2 : - is_align w2 ptr => - wsize_i w1 <= wsize_i w2 => - (wsize_i w2 %/ wsize_i w1) * len2 <= len1 => - valid_range w1 mem ptr len1 => - valid_range w2 mem ptr len2. -proof. - move=> hia hw hl hv. - have {hv} hv:= valid_range_le _ _ _ _ _ hl hv. - move=> i hi; apply (valid_range_is_valid w1) => //. - + by apply is_align_add => //; apply modzMr. - move=> k hk /=. - have gt0_dw : 0 < wsize_i w2 %/ wsize_i w1. - + by apply ltz_divRL => //; apply div_le_wsize. - have := hv ((wsize_i w2 %/ wsize_i w1) * i + k) _. - + split. smt(). - move=> ?;apply (ltr_le_trans (wsize_i w2 %/ wsize_i w1 * (i + 1))). - + smt(). - by apply ler_wpmul2l;[apply ltzW | smt()]. - rewrite Ring.IntID.mulrDr -mulzA (mulzC(wsize_i w1)) divzK ?addzA //. - by apply div_le_wsize. -qed. - -lemma valid_range_add (k:int) w mem ptr len : - 0 <= k <= len => - valid_range w mem ptr len => - valid_range w mem (ptr + k * wsize_i w) (len - k). -proof. - move=> hk hv i hi /=. - have -> : ptr + k * wsize_i w + wsize_i w * i = ptr + wsize_i w * (k + i) by ring. - apply hv => /#. -qed. - -lemma valid_range_add_split p n w mem ptr : - 0 <= p <= n => - valid_range w mem ptr n => - valid_range w mem ptr p /\ - valid_range w mem (ptr + p * wsize_i w) (n - p). -proof. - move=> hp hv; split. - + by apply: valid_range_le hv;case hp. - by apply valid_range_add. -qed. - -(* ------------------------------------------------------------------- *) - -lemma is_valid_store8 mem sz ptr1 ptr2 w : - is_valid (storeW8 mem ptr2 w) ptr1 sz = is_valid mem ptr1 sz. -proof. - rewrite !is_validE storeW8E /allocated;congr. - rewrite eq_iff;split => h i hi. - + by rewrite -(allocated8_setE ptr2 w) h. - by rewrite allocated8_setE h. -qed. -hint simplify is_valid_store8. - -lemma is_valid_store16 mem sz ptr1 ptr2 w : - is_valid (storeW16 mem ptr2 w) ptr1 sz = is_valid mem ptr1 sz. -proof. - by rewrite !is_validE storeW16E allocated_stores. -qed. -hint simplify is_valid_store16. - -lemma is_valid_store32 mem sz ptr1 ptr2 w : - is_valid (storeW32 mem ptr2 w) ptr1 sz = is_valid mem ptr1 sz. -proof. - by rewrite !is_validE storeW32E allocated_stores. -qed. -hint simplify is_valid_store32. - -lemma is_valid_store64 mem sz ptr1 ptr2 w : - is_valid (storeW64 mem ptr2 w) ptr1 sz = is_valid mem ptr1 sz. -proof. - by rewrite !is_validE storeW64E allocated_stores. -qed. -hint simplify is_valid_store64. - -lemma is_valid_store128 mem sz ptr1 ptr2 w : - is_valid (storeW128 mem ptr2 w) ptr1 sz = is_valid mem ptr1 sz. -proof. - by rewrite !is_validE storeW128E allocated_stores. -qed. -hint simplify is_valid_store128. - -lemma is_valid_store256 mem sz ptr1 ptr2 w : - is_valid (storeW256 mem ptr2 w) ptr1 sz = is_valid mem ptr1 sz. -proof. - by rewrite !is_validE storeW256E allocated_stores. -qed. -hint simplify is_valid_store256. diff --git a/proof/impl/JModel.ec b/proof/impl/JModel.ec deleted file mode 100644 index 8d0d652..0000000 --- a/proof/impl/JModel.ec +++ /dev/null @@ -1,322 +0,0 @@ -(* -------------------------------------------------------------------- *) -require import AllCore BitEncoding IntDiv SmtMap Ring List StdOrder Bool. -(*---*) import CoreMap Map Ring.IntID IntOrder. -require export JUtils JArray JWord JWord_array JMemory. - -(* -------------------------------------------------------------------- *) -abbrev x86_MOVD_32 (x : W32.t) = pack4 [x; W32.zero; W32.zero; W32.zero]. - -op x86_ROL_32 (x : W32.t) (cnt : W8.t) = - let result = W32.rol x (to_uint cnt) in - let CF = result.[0] in - let OF = Logic.(^) CF result.[31] in - (CF, OF, result) - axiomatized by x86_ROL_32_E. - -(* -------------------------------------------------------------------- *) -op x86_SHLD_32 : - W32.t -> W32.t -> W8.t -> (bool * bool * bool * bool * bool * W32.t). - -op x86_SHRD_32 : - W32.t -> W32.t -> W8.t -> (bool * bool * bool * bool * bool * W32.t). - -op x86_SHLD_64 : - W64.t -> W64.t -> W8.t -> (bool * bool * bool * bool * bool * W64.t). - -op x86_SHRD_64 : - W64.t -> W64.t -> W8.t -> (bool * bool * bool * bool * bool * W64.t). - -(* -------------------------------------------------------------------- *) - -op x86_VPSHUFB_128_B (w:W128.t) (m : W8.t) = - let i = W8.to_uint m in - if 128 <= i then W8.zero - else w \bits8 (i %% 16). - -op x86_VPSHUFB_128 (w m : W128.t) : W128.t = - map (x86_VPSHUFB_128_B w) m. - -op x86_VPSHUFB_256 (w m : W256.t) : W256.t = - map2 x86_VPSHUFB_128 w m. - -hint simplify (W16u8.of_int_bits8_div). -hint simplify (W8.of_uintK)@1. -hint simplify W32.get_out@0. - -abbrev [-printing] const_rotate8_128 = (W128.of_int 18676936380593224926704134051422339075). -abbrev [-printing] const_rotate16_128 = (W128.of_int 17342576855639742879858139805557719810). -abbrev [-printing] const_rotate24_128 = (W128.of_int 16028905388486802350658220295983399425). - -lemma rotate8_128_E w : - x86_VPSHUFB_128 w const_rotate8_128 = W4u32.map (fun w => W32.rol w 8) w. -proof. - have h : W128.all_eq - (x86_VPSHUFB_128 w const_rotate8_128) (W4u32.map (fun w => W32.rol w 8) w). - + by cbv W128.all_eq x86_VPSHUFB_128 x86_VPSHUFB_128_B W16u8.unpack8 edivz. - by apply (W128.all_eq_eq _ _ h). -qed. - -lemma rotate16_128_E w : - x86_VPSHUFB_128 w const_rotate16_128 = W4u32.map (fun w => W32.rol w 16) w. -proof. - have h : W128.all_eq - (x86_VPSHUFB_128 w const_rotate16_128) (W4u32.map (fun w => W32.rol w 16) w). - + by cbv W128.all_eq x86_VPSHUFB_128 x86_VPSHUFB_128_B W16u8.unpack8. - by apply (W128.all_eq_eq _ _ h). -qed. - -lemma rotate24_128_E w : - (x86_VPSHUFB_128 w const_rotate24_128) = W4u32.map (fun w => W32.rol w 24) w. -proof. - have h : W128.all_eq - (x86_VPSHUFB_128 w const_rotate24_128) (W4u32.map (fun w => W32.rol w 24) w). - + by cbv W128.all_eq x86_VPSHUFB_128 x86_VPSHUFB_128_B W16u8.unpack8 edivz. - by apply (W128.all_eq_eq _ _ h). -qed. -hint simplify (rotate8_128_E, rotate16_128_E, rotate24_128_E). - -abbrev [-printing] const_rotate8_256 = - W256.of_int 6355432118420048154175784972596847518577147054203239762089463134348153782275. - -abbrev [-printing] const_rotate16_256 = - W256.of_int 5901373100945378232718128989223044758631764214521116316503579100742837863170. - -abbrev [-printing] const_rotate24_256 = - W256.of_int 5454353864746073763129182254217446065883741921538078285974850505695092212225. - -(*lemma pack8u32_bits128 ws i : 0 <= i < 2 => - W8u32.pack8_t ws \bits128 i = pack4 [ws.[4*i];ws.[4*i+1];ws.[4*i+2];ws.[4*i+3] ]. -proof. - move=> /(mema_iota 0 2 i); move: i; apply /List.allP => /=. - by split; apply W128.all_eq_eq;cbv delta. -qed. *) - -lemma pack2_4u32_8u32 (w0 w1 w2 w3 w4 w5 w6 w7 :W32.t) : - pack2 [pack4 [w0;w1;w2;w3]; pack4 [w4; w5; w6; w7]] = - pack8 [w0; w1; w2; w3; w4; w5; w6; w7]. -proof. by apply W256.all_eq_eq;cbv W256.all_eq edivz. qed. - -lemma rotate8_256_E w : - x86_VPSHUFB_256 w const_rotate8_256 = W8u32.map (fun w => W32.rol w 8) w. -proof. -admitted. -(* - rewrite -(W8u32.unpack32K w) /unpack32 /= /x86_VPSHUFB_256 -{1}pack2_4u32_8u32. - rewrite -(W2u128.unpack128K const_rotate8_256) /unpack128 /=. - rewrite !W2u128.of_int_bits128_div 1,2://. - rewrite -W128.of_int_mod; cbv edivz. - by rewrite pack2_4u32_8u32. -qed. -*) -lemma rotate16_256_E w : - x86_VPSHUFB_256 w const_rotate16_256 = W8u32.map (fun w => W32.rol w 16) w. -proof. -admitted. -(* - rewrite -(W8u32.unpack32K w) /unpack32 /= /x86_VPSHUFB_256 -{1}pack2_4u32_8u32. - rewrite -(W2u128.unpack128K const_rotate16_256) /unpack128 /=. - rewrite !W2u128.of_int_bits128_div 1,2://. - rewrite -W128.of_int_mod; cbv edivz. - by rewrite pack2_4u32_8u32. -qed. -*) -lemma rotate24_256_E w : - x86_VPSHUFB_256 w const_rotate24_256 = W8u32.map (fun w => W32.rol w 24) w. -proof. -admitted. -(* - rewrite -(W8u32.unpack32K w) /unpack32 /= /x86_VPSHUFB_256 -{1}pack2_4u32_8u32. - rewrite -(W2u128.unpack128K const_rotate24_256) /unpack128 /=. - rewrite !W2u128.of_int_bits128_div 1,2://. - rewrite -W128.of_int_mod; cbv edivz. - by rewrite pack2_4u32_8u32. -qed. -*) -hint simplify (rotate8_256_E, rotate16_256_E, rotate24_256_E). - -(* -------------------------------------------------------------------- *) -op x86_VPSHUFD_128_B (w : W128.t) (m : W8.t) (i : int) : W32.t = - let m = W8.to_uint m in - let p = (m %/ (2^(2*i)))%%4 in - w \bits32 p. - -op x86_VPSHUFD_128 (w : W128.t) (m : W8.t) : W128.t = - pack4 (map (x86_VPSHUFD_128_B w m) (iota_ 0 4)). - -op x86_VPSHUFD_256 (w : W256.t) (m : W8.t) : W256.t = - map (fun w => x86_VPSHUFD_128 w m) w. - -(* -------------------------------------------------------------------- *) -abbrev [-printing] x86_VPBROADCASTI_2u128 = x86_VPBROADCAST_2u128. - -(* -------------------------------------------------------------------- *) -abbrev [-printing] subc_8 = W8.subc. -abbrev [-printing] addc_8 = W8.addc. -abbrev [-printing] mulu_8 = W8.mulu. - -abbrev [-printing] subc_16 = W16.subc. -abbrev [-printing] addc_16 = W16.addc. -abbrev [-printing] mulu_16 = W16.mulu. - -abbrev [-printing] subc_32 = W32.subc. -abbrev [-printing] addc_32 = W32.addc. -abbrev [-printing] mulu_32 = W32.mulu. - -abbrev [-printing] subc_64 = W64.subc. -abbrev [-printing] addc_64 = W64.addc. -abbrev [-printing] mulu_64 = W64.mulu. - -op mulu64 (w1 w2 : W64.t) = - (W2u32.zeroextu64 (W2u32.truncateu32 w1)) * - (W2u32.zeroextu64 (W2u32.truncateu32 w2)). - -(* -------------------------------------------------------------------- *) - -(* FIXME it is really the semantics? In particular the last if *) -op x86_VPEXTR_64 (w:W128.t) (i:W8.t) = - if W8.to_uint i = 0 then (w \bits64 0) - else if W8.to_uint i = 1 then (w \bits64 1) - else W64.of_int 0. - -op x86_MOVD_64 (v:W64.t) = - pack2 [v; W64.zero]. - -op x86_VPINSR_2u64 (v1:W128.t) (v2:W64.t) (i:W8.t) = - let i = W8.to_uint i %% 2 in - pack2 (map (fun j => if j = i then v2 else v1 \bits64 j) [0;1]). - -op x86_VPINSR_4u32 (v1:W128.t) (v2:W32.t) (i:W8.t) = - let i = W8.to_uint i %% 4 in - pack4 (map (fun j => if j = i then v2 else v1 \bits32 j) [0;1;2;3]). - -abbrev [-printing] x86_VPAND_128 = W128.(`&`). -abbrev [-printing] x86_VPOR_128 = W128.(`|`). -abbrev [-printing] x86_VPXOR_128 = W128.(`^`). - -abbrev [-printing] x86_VPAND_256 = W256.(`&`). -abbrev [-printing] x86_VPOR_256 = W256.(`|`). -abbrev [-printing] x86_VPXOR_256 = W256.(`^`). - -op x86_VPMULU_128 (w1 w2: W128.t) = - map2 mulu64 w1 w2. - -op x86_VPMULU_256 (w1 w2: W256.t) = - map2 mulu64 w1 w2. - -(* FIXME: check this *) -op x86_VPERM2I128 (w1 w2: W256.t) (i:W8.t) : W256.t = - let choose = fun n => - if i.[n+3] then W128.zero - else - let w = if i.[n+1] then w2 else w1 in - w \bits128 b2i i.[n] in - pack2 [choose 0; choose 4]. - -op x86_VPERMQ (w:W256.t) (i:W8.t) : W256.t = - let choose = fun n => w \bits64 ((to_uint i %/ 2^n) %% 4) in - pack4 [choose 0; choose 1; choose 2; choose 4]. - -op x86_VEXTRACTI128 (w:W256.t) (i:W8.t) : W128.t = - w \bits128 b2i i.[0]. - -(* ------------------------------------------------------------------- *) -op interleave_gen ['elem] - (get:W128.t -> W64.t) (split_v : W64.t -> 'elem list) (pack_2v : 'elem list -> W128.t) - (src1 src2: W128.t) = - let l1 = split_v (get src1) in - let l2 = split_v (get src2) in - pack_2v (_interleave l1 l2). - -op get_lo_2u64 (w:W128.t) = w \bits64 0. -op get_hi_2u64 (w:W128.t) = w \bits64 1. - -op x86_VPUNPCKL_16u8 (w1 w2:W128.t) = - interleave_gen get_lo_2u64 W8u8.to_list W16u8.pack16 w1 w2. - -op x86_VPUNPCKL_8u16 (w1 w2:W128.t) = - interleave_gen get_lo_2u64 W4u16.to_list W8u16.pack8 w1 w2. - -op x86_VPUNPCKL_4u32 (w1 w2:W128.t) = - interleave_gen get_lo_2u64 W2u32.to_list W4u32.pack4 w1 w2. - -op x86_VPUNPCKL_2u64 (w1 w2:W128.t) = - interleave_gen get_lo_2u64 (fun x => [x]) W2u64.pack2 w1 w2. - -op x86_VPUNPCKL_32u8 (w1 w2: W256.t) = - map2 x86_VPUNPCKL_16u8 w1 w2. - -op x86_VPUNPCKL_16u16 (w1 w2: W256.t) = - map2 x86_VPUNPCKL_8u16 w1 w2. - -op x86_VPUNPCKL_8u32 (w1 w2: W256.t) = - map2 x86_VPUNPCKL_4u32 w1 w2. - -op x86_VPUNPCKL_4u64 (w1 w2: W256.t) = - map2 x86_VPUNPCKL_2u64 w1 w2. - -op x86_VPUNPCKH_16u8 (w1 w2:W128.t) = - interleave_gen get_hi_2u64 W8u8.to_list W16u8.pack16 w1 w2. - -op x86_VPUNPCKH_8u16 (w1 w2:W128.t) = - interleave_gen get_hi_2u64 W4u16.to_list W8u16.pack8 w1 w2. - -op x86_VPUNPCKH_4u32 (w1 w2:W128.t) = - interleave_gen get_hi_2u64 W2u32.to_list W4u32.pack4 w1 w2. - -op x86_VPUNPCKH_2u64 (w1 w2:W128.t) = - interleave_gen get_hi_2u64 (fun x => [x]) W2u64.pack2 w1 w2. - -op x86_VPUNPCKH_32u8 (w1 w2: W256.t) = - map2 x86_VPUNPCKH_16u8 w1 w2. - -op x86_VPUNPCKH_16u16 (w1 w2: W256.t) = - map2 x86_VPUNPCKH_8u16 w1 w2. - -op x86_VPUNPCKH_8u32 (w1 w2: W256.t) = - map2 x86_VPUNPCKH_4u32 w1 w2. - -op x86_VPUNPCKH_4u64 (w1 w2: W256.t) = - map2 x86_VPUNPCKH_2u64 w1 w2. - -(* ------------------------------------------------------------------- *) -op x86_VPSLLDQ_128 (w1:W128.t) (w2:W8.t) = - let n = to_uint w2 in - let i = min n 16 in - w1 `<<<` (8 * i). - -op x86_VPSLLDQ_256 (w1:W256.t) (w2:W8.t) = - map (fun w => x86_VPSLLDQ_128 w w2) w1. - -op x86_VPSRLDQ_128 (w1:W128.t) (w2:W8.t) = - let n = to_uint w2 in - let i = min n 16 in - w1 `>>>` (8 * i). - -op x86_VPSRLDQ_256 (w1:W256.t) (w2:W8.t) = - map (fun w => x86_VPSRLDQ_128 w w2) w1. -(* ------------------------------------------------------------------- *) -abbrev [-printing] (\vshr32u128) (w1:W128.t) (w2:W8.t) = x86_VPSRL_4u32 w1 w2. -abbrev [-printing] (\vshl32u128) (w1:W128.t) (w2:W8.t) = x86_VPSLL_4u32 w1 w2. -abbrev [-printing] (\vadd32u128) (w1 w2:W128.t) = x86_VPADD_4u32 w1 w2. - - -abbrev [-printing] (\vshr32u256) (w1:W256.t) (w2:W8.t) = x86_VPSRL_8u32 w1 w2. -abbrev [-printing] (\vshl32u256) (w1:W256.t) (w2:W8.t) = x86_VPSLL_8u32 w1 w2. - -abbrev [-printing] (\vshr64u256) (w1:W256.t) (w2:W8.t) = x86_VPSRL_4u64 w1 w2. -abbrev [-printing] (\vshl64u256) (w1:W256.t) (w2:W8.t) = x86_VPSLL_4u64 w1 w2. - -abbrev [-printing] (\vadd32u256) (w1 w2:W256.t) = x86_VPADD_8u32 w1 w2. -abbrev [-printing] (\vadd64u256) (w1 w2:W256.t) = x86_VPADD_4u64 w1 w2. -(*abbrev [-printing] (\vsub64u256) (w1:W256.t) (w2:W8.t) = x86_VPSUB_4u64 w1 w2.*) - -(* ------------------------------------------------------------------- *) -(* Leakages *) - -type leakage_t = [ - | LeakAddr of address list - | LeakCond of bool - | LeakFor of (int * int) -]. - -type leakages_t = leakage_t list. diff --git a/proof/impl/JUtils.ec b/proof/impl/JUtils.ec deleted file mode 100644 index 1c8e429..0000000 --- a/proof/impl/JUtils.ec +++ /dev/null @@ -1,280 +0,0 @@ -require import AllCore IntDiv List Bool StdOrder. - -hint simplify (oget_some, oget_none). - -(* -------------------------------------------------------------------- *) - -lemma modz_cmp m d : 0 < d => 0 <= m %% d < d. -proof. smt (edivzP). qed. - -lemma divz_cmp d i n : 0 < d => 0 <= i < n * d => 0 <= i %/ d < n. -proof. - by move=> hd [hi1 hi2]; rewrite divz_ge0 // hi1 /= ltz_divLR. -qed. - -lemma mulz_cmp_r i m r : 0 < m => 0 <= i < r => 0 <= i * m < r * m. -proof. - move=> h0m [h0i hir]; rewrite IntOrder.divr_ge0 //=; 1: by apply ltzW. - by rewrite IntOrder.ltr_pmul2r. -qed. - -lemma cmpW i d : 0 <= i < d => 0 <= i <= d. -proof. by move=> [h1 h2];split => // ?;apply ltzW. qed. - -lemma le_modz m d : 0 <= m => m %% d <= m. -proof. - move=> hm. - have [ ->| [] hd]: d = 0 \/ d < 0 \/ 0 < d by smt(). - + by rewrite modz0. - + by rewrite -modzN {2}(divz_eq m (-d)); smt (divz_ge0). - by rewrite {2}(divz_eq m d); smt (divz_ge0). -qed. - -lemma bound_abs (i j:int) : 0 <= i < j => 0 <= i < `|j| by smt(). -hint solve 0 : bound_abs. - -lemma gt0_pow2 (p:int) : 0 < 2^p. -proof. - case (p <= 0)=> [? | /ltzNge hp]; 1:by rewrite pow_le0. - apply (IntOrder.ltr_le_trans 1) => //. - by rewrite -(pow_le0 0 2) // pow_Mle /= ltzW. -qed. - -lemma dvdmodz d m p : d %| m => d %| p => d %| (p%%m). -proof. move=> h1 h2; rewrite /(%|);rewrite modz_dvd //. qed. - -lemma modz_add_carry k i d : 0 <= k < d => 0 <= i < d => d <= k + i => - (k + i)%% d = (k + i) - d. -proof. - move=> hk hi hd; have [_ <- //]:= euclideUl d 1 ((k + i) - d) (k+i) _ _;last by smt(). - by rewrite -divz_eq; ring. -qed. - -lemma modz_sub_carry k i d : 0 <= k < d => 0 <= i < d => k - i < 0 => - (k - i)%% d = d + (k - i). - move=> hk hi hd; have [_ <- //]:= euclideUl d (-1) (d + (k - i)) (k-i) _ _;last by smt(). - by rewrite -divz_eq; ring. -qed. - -lemma nosmt divz_mod_mul n p i: 0 <= p => 0 <= n => - (i %% (n*p)) %/ p = (i %/ p) %% n. -proof. - move=> [hp | <- //]; move=> [hn | <- //]. - rewrite {2}(divz_eq i (n*p)) {2} (divz_eq (i %% (n * p)) p). - pose i1 := i %% (n * p). - have -> : (i %/ (n * p) * (n * p) + (i1 %/ p * p + i1 %% p)) = - ((i %/ (n * p) * n + i1 %/ p) * p + i1 %% p) by ring. - have hp0 : p <> 0 by smt(). - rewrite divzMDl 1:// (divz_small (i1%%p) p) 2:/=; 1: smt (edivzP). - rewrite modzMDl modz_small 2://. - apply bound_abs;apply divz_cmp => //. - by apply modz_cmp => /#. -qed. - -lemma nosmt divz_mod_div n p i: p %| n => 0 <= p => 0 <= n => - (i %% n) %/ p = (i %/ p) %% (n%/p). -proof. - rewrite dvdz_eq => {2}<- hp hn;apply divz_mod_mul => //. - by case: hp => [hp | <-//]; apply divz_ge0. -qed. - -lemma modz_mod_pow2 i n k : i %% 2^n %% 2^k = i %% 2^(min n k). -proof. - case: (0 <= n) => hn. - + rewrite /min;case (n < k) => hnk. - + rewrite (modz_small (i %% 2^n)) 2://;smt (modz_cmp gt0_pow2 pow_Mle). - case (0 <= k) => hk. - + rewrite modz_dvd 2://;1: by apply dvdz_exp2l => /#. - have hk0 : k <= 0 by smt(). - by rewrite !(powNeg _ _ hk0) modz1. - rewrite /min;case (n < k) => hnk. - + by rewrite powNeg 1:/# (modz1 i). - have hk0 : (k <= 0) by smt(). - by rewrite (powNeg _ _ hk0) modz1. -qed. - -(* FIXME: this is defined in IntDiv but with 0 <= i *) -lemma nosmt modz_pow2_div n p i: 0 <= p <= n => - (i %% 2^n) %/ 2^p = (i %/ 2^p) %% 2^(n-p). -proof. - move=> [h1 h2];rewrite divz_mod_div. - + by apply dvdz_exp2l. - + by apply ltzW; apply gt0_pow2. - + by apply ltzW; apply gt0_pow2. - congr; have {1}->: n = (n - p) + p by ring. - by rewrite -pow_add 1:/# 1:// mulzK //; smt (gt0_pow2). -qed. - -(* -------------------------------------------------------------------- *) -lemma powS_minus (x p:int) : 0 < p => x ^ p = x * x ^ (p-1). -proof. smt (powS). qed. - -hint simplify pow_le0@1. -hint simplify powS_minus@1. - -lemma pow2_1 : 2^1 = 2 by []. -lemma pow2_2 : 2^2 = 4 by []. -lemma pow2_3 : 2^3 = 8 by []. -lemma pow2_4 : 2^4 = 16 by []. -lemma pow2_5 : 2^5 = 32 by []. -lemma pow2_6 : 2^6 = 64 by []. -lemma pow2_7 : 2^7 = 128 by []. -lemma pow2_8 : 2^8 = 256 by []. -lemma pow2_16 : 2^16 = 65536 by []. -lemma pow2_32 : 2 ^ 32 = 4294967296 by []. -lemma pow2_64 : 2 ^ 64 = 18446744073709551616 by []. -lemma pow2_128 : 2 ^ 128 = 340282366920938463463374607431768211456 by []. -lemma pow2_256 : 2 ^ 256 = 115792089237316195423570985008687907853269984665640564039457584007913129639936 by []. - -hint simplify - (pow2_1, pow2_2, pow2_3, pow2_4, pow2_5, pow2_6, pow2_7, pow2_8, - pow2_16, pow2_32, pow2_64, pow2_128, pow2_256)@0. - -(* -------------------------------------------------------------------- *) -lemma iotaS_minus : - forall (i n : int), 0 < n => iota_ i n = i :: iota_ (i + 1) (n - 1). -proof. smt (iotaS). qed. - -hint simplify (iota0, iotaS_minus)@0. - -lemma nseqS_minus n (e:'a) : 0 < n => nseq n e = e :: nseq (n-1) e. -proof. smt (nseqS). qed. - -hint simplify (nseq0, nseqS_minus)@0. - -(* -------------------------------------------------------------------- *) -(* Allow to extend reduction rule with xor *) - -lemma xor1b (b : bool) : true ^^ b = !b. -proof. by rewrite xorC xor_true. qed. - -lemma xor0b (b : bool) : false ^^ b = b. -proof. by rewrite xorC xor_false. qed. - -lemma nosmt xorK_simplify (b1 b2: bool) : b1 = b2 => b1 ^^ b2 = false. -proof. by move=> ->; apply xorK. qed. - -hint simplify (xor1b, xor_true, xor0b, xor_false)@0. -hint simplify xorK_simplify@1. - - - -(* -------------------------------------------------------------------- *) -(* extra stuff on list *) - -op map2 ['a, 'b, 'c] (f:'a -> 'b -> 'c) (s:'a list) (t:'b list) = - with s = "[]" , t = "[]" => [] - with s = _ :: _ , t = "[]" => [] - with s = "[]" , t = _ :: _ => [] - with s = x :: s', t = y :: t' => f x y :: map2 f s' t'. - -lemma map2_zip (f:'a -> 'b -> 'c) s t : - map2 f s t = map (fun (p:'a * 'b) => f p.`1 p.`2) (zip s t). -proof. - by elim: s t => [ | s1 s hrec] [ | t1 t] //=;rewrite hrec. -qed. - -op mapN ['a, 'b] (f:'a -> 'b) dfa (s:'a list) N = - with s = "[]" => - if N <= 0 then [] else nseq N (f dfa) - with s = x :: s' => - if N <= 0 then [] - else f x :: mapN f dfa s' (N-1). - -op mapN2 ['a, 'b, 'c] (f:'a -> 'b -> 'c) dfa dfb (s:'a list) (t:'b list) N = - with s = "[]" , t = "[]" => - if N <= 0 then [] else nseq N (f dfa dfb) - - with s = _ :: _ , t = "[]" => mapN (fun x => f x dfb) dfa s N - - with s = "[]" , t = _ :: _ => mapN (fun y => f dfa y) dfb t N - - with s = x :: s', t = y :: t' => - if N <= 0 then [] - else f x y :: mapN2 f dfa dfb s' t' (N-1). - -lemma nth_mapN ['a, 'b] dfb (f:'a -> 'b) dfa (s:'a list) N i : - 0 <= i < N => - nth dfb (mapN f dfa s N) i = f (nth dfa s i). -proof. - elim: s N i => /= [ | x s hrec] N i hiN; - have -> /= : !(N <= 0) - by apply ltzNge; case hiN; apply IntOrder.ler_lt_trans. - + by rewrite nth_nseq. - by case (i=0) => // ?; apply hrec => /#. -qed. - -lemma nth_mapN2 ['a, 'b, 'c] - (f:'a -> 'b -> 'c) dfa dfb dfc (s:'a list) (t:'b list) N i : - 0 <= i < N => - nth dfc (mapN2 f dfa dfb s t N) i = f (nth dfa s i) (nth dfb t i). -proof. - elim: s t N i => [ | x s hrec] [ | y t] N i hiN /=; - have -> /= : !(N <= 0) - by apply ltzNge; case hiN; apply IntOrder.ler_lt_trans. - + by rewrite nth_nseq. - + by case (i=0) => // neqi; apply nth_mapN => /#. - + by case (i=0) => // neqi; apply nth_mapN => /#. - by case (i=0) => // ?;apply hrec => /#. -qed. - -lemma map2_cat (f:'a -> 'b -> 'c) (l1 l2:'a list) (l1' l2':'b list): - size l1 = size l1' => - map2 f (l1 ++ l2) (l1' ++ l2') = map2 f l1 l1' ++ map2 f l2 l2'. -proof. by move=> hs;rewrite !map2_zip zip_cat // map_cat. qed. - -lemma map2C (f: 'a -> 'a -> 'b) (l1 l2:'a list) : - (forall a1 a2, f a1 a2 = f a2 a1) => - map2 f l1 l2 = map2 f l2 l1. -proof. - move=> hf; elim: l1 l2=> [ | a1 l1 hrec] [ | a2 l2] //=. - by rewrite hf hrec. -qed. - -lemma map2_take1 (f: 'a -> 'b -> 'c) (l1: 'a list) (l2: 'b list) : - map2 f l1 l2 = map2 f (take (size l2) l1) l2. -proof. - elim: l1 l2 => [ | a1 l1 hrec] [ | a2 l2] //=. - smt (size_ge0). -qed. - -lemma map2_take2 (f: 'a -> 'b -> 'c) (l1: 'a list) (l2: 'b list) : - map2 f l1 l2 = map2 f l1 (take (size l1) l2). -proof. - elim: l1 l2 => [ | a1 l1 hrec] [ | a2 l2] //=. - smt (size_ge0). -qed. - -lemma size_map2 (f:'a -> 'b -> 'c) (l1:'a list) l2 : size (map2 f l1 l2) = min (size l1) (size l2). -proof. by rewrite map2_zip size_map size_zip. qed. - -lemma nth_map2 dfla dflb dflc (f:'a -> 'b -> 'c) (l1:'a list) l2 i: - 0 <= i < min (size l1) (size l2) => - nth dflc (map2 f l1 l2) i = f (nth dfla l1 i) (nth dflb l2 i). -proof. - elim: l1 l2 i => [ | a l1 hrec] [ | b l2] i /=; 1..3:smt(size_ge0). - case: (i=0) => [->> // | hi ?]. - apply hrec;smt(). -qed. - -(* FIXME: we can not do l1 = "[]", l2= _ => l2 *) -op _interleave (l1 l2: 'a list) = - with l1 = "[]", l2= "[]" => [] - with l1 = "[]", l2= _::_ => l2 - with l1 = _::_, l2 = "[]" => l1 - with l1 = a1::l1', l2 = a2::l2' => a1::a2::_interleave l1' l2'. - -(* ------------------------------------------------------------------- *) -(* Safety *) - -op in_bound (x n:int) = 0 <= x /\ x < n. -op is_init (x : 'a option) = x <> None. - -lemma is_init_Some (a:'a) : is_init (Some a). -proof. done. qed. - -lemma in_bound_simplify x n : - 0 <= x < n => in_bound x n. -proof. done. qed. - -hint simplify (is_init_Some, in_bound_simplify). \ No newline at end of file diff --git a/proof/impl/JWord.ec b/proof/impl/JWord.ec deleted file mode 100644 index 6d11628..0000000 --- a/proof/impl/JWord.ec +++ /dev/null @@ -1,2432 +0,0 @@ -(* -------------------------------------------------------------------- *) -require import AllCore BitEncoding IntDiv SmtMap List StdOrder BitEncoding Bool. -(*---*) import Ring.IntID IntOrder BS2Int. -require import JUtils JArray. - -(* -------------------------------------------------------------------- *) -abstract theory BitWord. - -op size : {int | 0 < size} as gt0_size. - -clone FinType as Alphabet with - type t <- bool, - op enum <- [true; false], - op card <- 2. - -clone include MonoArray with - type elem <- bool, - op dfl <- false, - op size <- size - rename "of_list" as "bits2w" - "to_list" as "w2bits" - "^tP$" as "wordP" - "sub" as "bits" - proof ge0_size by (apply ltzW; apply gt0_size). - -(* -------------------------------------------------------------------- *) -abbrev modulus = 2 ^ size. - -lemma ge2_modulus : 2 <= modulus. -proof. - rewrite powS_minus ?gt0_size; smt (gt0_size powPos). -qed. - -lemma gt0_modulus : 0 < modulus. -proof. smt (ge2_modulus). qed. - -lemma ge0_modulus : 0 <= modulus. -proof. smt (ge2_modulus). qed. - -lemma max_size : max 0 size = size. -proof. by rewrite /max gt0_size. qed. - -hint exact : ge0_size gt0_size gt0_modulus ge2_modulus ge0_modulus max_size. - -(* --------------------------------------------------------------------- *) -(* Conversions with int *) - -op of_int (x:int) : t = - bits2w (int2bs size (x %% modulus)) -axiomatized by of_intE. - -op to_uint (w:t) = - bs2int (w2bits w) -axiomatized by to_uintE. - -op smod (i:int) = - if 2^(size - 1) <= i then i - modulus - else i. - -op to_sint (w:t) : int = smod (to_uint w) -axiomatized by to_sintE. - -abbrev zero = of_int 0. -abbrev one = of_int 1. - -lemma to_uint_cmp (x : t) : 0 <= to_uint x < modulus. -proof. - rewrite to_uintE bs2int_ge0 -(size_w2bits x) bs2int_le2Xs. -qed. - -lemma of_uintK (x : int) : to_uint (of_int x) = x %% modulus. -proof. - by rewrite to_uintE of_intE bits2wK 1:size_int2bs // int2bsK // modz_cmp. -qed. - -lemma to_uintK : cancel to_uint of_int. -proof. - move=> w; rewrite to_uintE of_intE. - rewrite modz_small. - + by rewrite bs2int_ge0 ger0_norm // -(size_w2bits w) bs2int_le2Xs. - by rewrite -(size_w2bits w) bs2intK w2bitsK. -qed. - -lemma to_uintK' (x: t) : of_int (to_uint x) = x. -proof. by apply to_uintK. qed. - -(*hint simplify of_uintK@1. *) -hint simplify to_uintK'@0. - -lemma of_sintK (x:int) : - to_sint (of_int x) = smod (x %% modulus). -proof. by rewrite to_sintE of_uintK. qed. - -lemma to_uint_mod (x : t) : to_uint x %% modulus = to_uint x. -proof. by rewrite modz_small // ger0_norm // to_uint_cmp. qed. - -lemma of_int_mod (x : int) : of_int (x %% modulus) = of_int x. -proof. by apply/(can_inj _ _ to_uintK); rewrite !of_uintK modz_mod. qed. - -lemma of_int_mod_red (x:int): !(0 <= x < modulus) => of_int x = of_int (x %% modulus). -proof. by rewrite of_int_mod. qed. - -hint simplify of_int_mod_red. - -lemma to_uint_small i : 0 <= i < modulus => to_uint (of_int i) = i. -proof. by move=> h; rewrite of_uintK modz_small;solve. qed. - -lemma to_uint0 : to_uint (of_int 0) = 0 by []. -lemma to_uint1 : to_uint (of_int 1) = 1 by []. - -hint simplify (to_uint0, to_uint1)@0. -hint simplify to_uint_small@1. - -lemma word_modeqP (x y : t) : - to_uint x %% modulus = to_uint y %% modulus => x = y. -proof. -move=> eq_mod; rewrite -(to_uintK x) -(to_uint_mod x). -by rewrite eq_mod to_uint_mod. -qed. - -lemma to_uint_eq (x y:t) : (x = y) <=> (to_uint x = to_uint y). -proof. by rewrite Core.inj_eq // (Core.can_inj _ _ to_uintK). qed. - -(* -------------------------------------------------------------------- *) -op int_bit x i = (x%%modulus) %/ 2 ^ i %% 2 <> 0. - -lemma of_intwE x i : - (of_int x).[i] = (0 <= i < size /\ int_bit x i). -proof. - rewrite of_intE; case (0 <= i < size) => /= hi; last by rewrite get_out. - by rewrite get_bits2w // nth_mkseq. -qed. - -lemma zerowE i: zero.[i] = false. -proof. by rewrite of_intwE /int_bit. qed. -hint simplify zerowE. - -lemma of_int_powm1 p i : - (of_int (2^p - 1)).[i] = (0 <= i < size /\ i < p). -proof. - case: (0 <= i < size) => [[h0i his] | hi]; last by rewrite get_out. - case (0 <= p) => hp; last by rewrite pow_le0 1:/# /= /#. - have aux : forall p, 0 <= p <= size => (of_int (2 ^ p - 1)).[i] = (true /\ i < p). - + move=> {p hp} p hp. - rewrite of_intwE 1:// /int_bit /= (modz_small (2 ^ p - 1)). - + smt (gt0_pow2 pow_Mle). - case (i < p) => hip /=. - + have -> : p = ((p - i - 1) + 1) + i by ring. - rewrite h0i his -pow_add // 1:/# divzMDl; 1: smt (gt0_pow2). - rewrite -pow_add 1:/# //= modzMDl divNz // gt0_pow2. - by rewrite divz_small //; smt (gt0_pow2 pow_Mle). - case : (p <= size) => hps; 1: by apply aux. - rewrite (_:i < p) 1:/# -of_int_mod. - have -> : p = (p-size) + size by ring. - rewrite -pow_add 1:/# 1://. - by rewrite modzMDl -(modzMDl 1 (-1) modulus) /= of_int_mod aux 1:// his. -qed. - -lemma get_to_uint w i : w.[i] = (0 <= i < size /\ to_uint w %/ 2 ^ i %% 2 <> 0). -proof. - case : (0 <= i < size) => hi;last by rewrite get_out. - rewrite -{1}(to_uintK w) of_intwE hi /int_bit (modz_small _ modulus) 2://. - by apply bound_abs; apply to_uint_cmp. -qed. - -lemma b2i_get w i : 0 <= i => b2i w.[i] = to_uint w %/ 2 ^ i %% 2. -proof. - move=> hi;rewrite get_to_uint hi. - case (i < size) => his //=; 1: smt (modz_cmp). - rewrite divz_small //; apply bound_abs. - smt (to_uint_cmp pow_Mle ge0_size). -qed. - -lemma bits_divmod w i j: 0 <= i => 0 <= j => bs2int (bits w i j) = ((to_uint w) %/ 2^i) %% 2^j. -proof. - move => hi; rewrite /bits. - elim /intind: j. - + by rewrite mkseq0 bs2int_nil /=. - move=> j hj hrec; rewrite mkseqS 1:// bs2int_rcons. - rewrite size_mkseq max_ler 1:// /= hrec. - have {2}->:= modz_pow_split (i+j+1) (i+j) (to_uint w) 2 _; 1: smt(). - have hij1 : 2 ^ (i + j + 1) = 2^(j+1) * 2^i. - + rewrite pow_add 1:/# 1://;congr;ring. - have hij : 2 ^ (i + j) = 2^j * 2^i. - + rewrite pow_add 1:/# 1://;congr;ring. - have h2i0 : 2 ^ i <> 0 by smt (gt0_pow2). - rewrite -addzA {2}hij1 -mulzA divzMDl 1://. - rewrite {2}hij -mulzA divzMDl 1://. - rewrite modzMDl !modz_pow2_div; 1,2:smt(). - have -> : i + j + 1 - (i + j) = 1 by ring. - have -> : i + j - i = j by ring. - rewrite -(pow_add 2 j 1) 1,2:// pow2_1 (modz_small _ (2^j * 2)). - + by apply bound_abs; smt (modz_cmp gt0_pow2). - by rewrite addzC mulzC b2i_get 1:/#. -qed. - -lemma bitsE w k len : bits w k len = mkseq (fun (i:int) => w.[k+i]) len. -proof. done. qed. - -lemma to_uintRL (w:t) (x:int) : to_uint w = x %% 2^size => w = of_int x. -proof. - by move=> h;rewrite -of_int_mod; apply: (canRL _ _ _ _ to_uintK). -qed. - -lemma to_uint_bits w : to_uint w = bs2int (bits w 0 size). -proof. by rewrite to_uintE /w2bits /bits. qed. - -(* -------------------------------------------------------------------- *) -op zerow = zero. - -op onew = of_int (modulus - 1) -axiomatized by oneE. - -op (+^) : t -> t -> t = map2 (^^) -axiomatized by xorE. - -op andw : t -> t -> t = map2 (/\) -axiomatized by andE. - -op oppw (w : t): t = w. - -op invw : t -> t = map ([!]) -axiomatized by invE. - -op orw : t -> t -> t = map2 (\/) -axiomatized by orE. - -(* -------------------------------------------------------------------- *) - -lemma zerowiE i: zerow.[i] = false. -proof. apply zerowE. qed. - -lemma onewE i: onew.[i] = (0 <= i < size). -proof. - rewrite oneE; case (0 <= i < size) => hi; 2:by rewrite get_out. - by rewrite of_int_powm1 //= 1:/# hi. -qed. - -lemma xorwE w1 w2 i: (w1 +^ w2).[i] = w1.[i] ^^ w2.[i]. -proof. - by rewrite xorE; case (0 <= i < size) => hi;[ rewrite map2iE | rewrite !get_out]. -qed. - -lemma andwE (w1 w2:t) i: (andw w1 w2).[i] = (w1.[i] /\ w2.[i]). -proof. - by rewrite andE; case (0 <= i < size) => hi;[ rewrite map2iE | rewrite !get_out]. -qed. - -lemma orwE (w1 w2:t) i: (orw w1 w2).[i] = (w1.[i] \/ w2.[i]). -proof. - by rewrite orE; case (0 <= i < size) => hi;[ rewrite map2iE | rewrite !get_out]. -qed. - -lemma invwE (w:t) i: - (invw w).[i] = (0 <= i < size /\ !w.[i]). -proof. by rewrite invE mapE initE;case (0 <= i < _). qed. - -lemma oppwE (w:t) i: (oppw w).[i] = w.[i]. -proof. by []. qed. - -hint rewrite bwordE : zerowE zerowiE onewE xorwE andwE invwE. -hint simplify (zerowE, zerowiE, onewE, xorwE, andwE, invwE, orwE). - -(* -------------------------------------------------------------------- *) -lemma onew_neq0: onew <> zerow. -proof. - apply/negP=> /wordP/(_ 0) /=. - by rewrite negb_imply neqF. -qed. - -lemma xorw0: right_id zero (+^). -proof. by move=> w; apply/wordP=> i _. qed. - -lemma xorwA: associative (+^). -proof. by move=> w1 w2 w3; apply/wordP=> i _; rewrite !bwordE xorA. qed. - -lemma xorwC: commutative (+^). -proof. by move=> w1 w2; apply/wordP=> i _; rewrite !bwordE xorC. qed. - -lemma xorwK: forall x, x +^ x = zero. -proof. by move=> w; apply/wordP=> i _; rewrite !bwordE. qed. - -lemma andw1: right_id onew andw. -proof. by move=> w; apply/wordP=> i h; rewrite !bwordE h. qed. - -lemma andwA: associative andw. -proof. by move=> w1 w2 w3; apply/wordP=> i h; rewrite !bwordE andbA. qed. - -lemma andwC: commutative andw. -proof. by move=> w1 w2; apply/wordP=> i h; rewrite !bwordE andbC. qed. - -lemma andwDl: left_distributive andw (+^). -proof. move=> w1 w2 w3; apply/wordP=> i h; rewrite !bwordE smt. qed. - -lemma andwK: idempotent andw. -proof. by move=> x; apply/wordP=> i h; rewrite !bwordE andbb. qed. - -(* -------------------------------------------------------------------- *) -instance bring with t - op rzero = zerow - op rone = onew - op add = (+^) - op mul = andw - op opp = oppw - - proof oner_neq0 by apply/onew_neq0 - proof addr0 by apply/xorw0 - proof addrA by (move=> w1 w2 w3; rewrite xorwA) - proof addrC by apply/xorwC - proof addrK by apply/xorwK - proof mulr1 by apply andw1 - proof mulrA by (move=> w1 w2 w3; rewrite andwA) - proof mulrC by apply/andwC - proof mulrDl by apply/andwDl - proof mulrK by apply/andwK - proof oppr_id by trivial. - -pred unitw (w:t) = w = onew. -op iandw (w:t) = if w = onew then onew else w. - -clone Ring.ComRing as WRing with - type t <- t, - op zeror <- zero, - op ( + ) <- (+^), - op [ - ] <- oppw, - op oner <- onew, - op ( * ) <- andw, - op invr <- iandw, - pred unit <- unitw -proof *. -realize addrA. proof. apply xorwA. qed. -realize addrC. proof. apply xorwC. qed. -realize add0r. proof. move=> ?;ring. qed. -realize addNr. proof. move=> ?;ring. qed. -realize oner_neq0. proof. apply onew_neq0. qed. -realize mulrA. proof. apply andwA. qed. -realize mulrC. proof. apply andwC. qed. -realize mul1r. proof. move=> ?;ring. qed. -realize mulrDl. proof. apply andwDl. qed. -realize mulVr. proof. move=> ?;rewrite /unitw /iandw => -> /=;ring. qed. -realize unitout. proof. by move=> x;rewrite /unitw /iandw => ->. qed. - -realize unitP. -proof. -move=> x y; rewrite /unitw !wordP => + i Hi -/(_ i Hi). -by rewrite andwE onewE Hi /#. -qed. - -lemma xor0w w : of_int 0 +^ w = w. -proof. by apply WRing.add0r. qed. - -lemma xorw0_s w : w +^ of_int 0 = w. -proof. by apply WRing.addr0. qed. - -lemma xorw1 w : w +^ onew = invw w. -proof. by apply wordP => i hi /=; case (0 <= i < size). qed. - -lemma xor1w w : onew +^ w = invw w. -proof. by apply wordP => i hi /=; case (0 <= i < size). qed. - -lemma and0w w : andw (of_int 0) w = of_int 0. -proof. by apply WRing.mul0r. qed. - -lemma andw0 w : andw w (of_int 0) = of_int 0. -proof. by apply WRing.mulr0. qed. - -lemma and1w w : andw onew w = w. -proof. by apply WRing.mul1r. qed. - -lemma andw1_s w : andw w onew = w. -proof. by apply WRing.mulr1. qed. - -lemma orw0 w : orw w zero = w. -proof. by apply wordP => i hi. qed. - -lemma or0w w : orw zero w = w. -proof. by apply wordP => i hi. qed. - -lemma orw1 w : orw w onew = onew. -proof. by apply wordP => i hi /=; case (0 <= i < size). qed. - -lemma or1w w : orw onew w = onew. -proof. by apply wordP => i hi /=; case (0 <= i < size). qed. - -lemma orwK w : orw w w = w. -proof. by apply wordP => i hi /=; case (w.[i]). qed. - -lemma xorwK_s w1 w2 : w1 = w2 => (w1 +^ w2) = zero. -proof. move=> ->;apply xorwK. qed. - -lemma andwK_s w1 w2 : w1 = w2 => andw w1 w2 = w1. -proof. move=> ->;apply andwK. qed. - -lemma orwK_s w1 w2 : w1 = w2 => orw w1 w2 = w1. -proof. move=> ->;apply orwK. qed. - -hint simplify (xor0w, xorw0_s, xorw1, xor1w, - and0w, andw0, and1w, andw1_s, - or0w, orw0, orw1, or1w, - xorwK_s, andwK_s, orwK_s). - -(* --------------------------------------------------------------------- *) -(* Arimethic operations *) - -op ulift1 (f : int -> int) (w : t) = - of_int (f (to_uint w)). - -op ulift2 (f : int -> int -> int) (w1 w2 : t) = - of_int (f (to_uint w1) (to_uint w2)). - -op slift2 (f : int -> int -> int) (w1 w2 : t) = - of_int (f (to_uint w1) (to_uint w2)). - -op ( + ) = ulift2 Int.( + ) axiomatized by addE. -op ([-]) = ulift1 Int.([-]) axiomatized by oppE. -op ( * ) = ulift2 Int.( * ) axiomatized by mulE. - -op (\udiv) = ulift2 IntDiv.( %/) axiomatized by udivE. -op (\umod) = ulift2 IntDiv.( %/) axiomatized by umodE. - -(* TODO check this *) -op (\sdiv) = slift2 IntDiv.( %/) axiomatized by sdivE. -op (\smod) = slift2 IntDiv.( %/) axiomatized by smodE. - -(* --------------------------------------------------------------------- *) -(* Comparisons *) - -op (\ule) (x y : t) = (to_uint x) <= (to_uint y) axiomatized by uleE. -op (\ult) (x y : t) = (to_uint x) < (to_uint y) axiomatized by ultE. - -op (\sle) (x y : t) = (to_sint x) <= (to_sint y) axiomatized by sleE. -op (\slt) (x y : t) = (to_sint x) < (to_sint y) axiomatized by sltE. - -lemma ult_of_int x y : - (of_int x \ult of_int y) = (x %% modulus < y %% modulus). -proof. by rewrite ultE /= !of_uintK. qed. - -lemma ule_of_int x y : - (of_int x \ule of_int y) = (x %% modulus <= y %% modulus). -proof. by rewrite uleE /= !of_uintK. qed. - -lemma uleNgt x y : x \ule y <=> ! y \ult x. -proof. by rewrite ultE uleE lerNgt. qed. - -lemma ultNge x y: x \ult y <=> ! y \ule x. -proof. by rewrite ultE uleE ltzNge. qed. - -lemma ult_of_int_true x y : - (x %% modulus < y %% modulus) => (of_int x \ult of_int y) = true. -proof. by rewrite ult_of_int => ->. qed. - -lemma ult_of_int_false x y : - !(x %% modulus < y %% modulus) => (of_int x \ult of_int y) = false. -proof. by rewrite ult_of_int => ->. qed. - -lemma ule_of_int_true x y : - (x %% modulus <= y %% modulus) => (of_int x \ule of_int y) = true. -proof. by rewrite ule_of_int => ->. qed. - -lemma ule_of_int_false x y : - !(x %% modulus <= y %% modulus) => (of_int x \ule of_int y) = false. -proof. by rewrite ule_of_int => ->. qed. - -hint simplify (ult_of_int_true, ult_of_int_false, ule_of_int_true, ule_of_int_false). - -(* --------------------------------------------------------------------- *) -(* ComRing *) - -op is_inverse (w wi: t) = wi * w = of_int 1. -op unit (w:t) = exists wi, is_inverse w wi. -op invr (w:t) = Logic.choiceb (is_inverse w) w. - -lemma of_intN (x : int) : of_int (-x) = - of_int x. -proof. -rewrite oppE /ulift1 /=; apply/word_modeqP=> /=. -by rewrite !of_uintK !modz_mod modzNm. -qed. - -lemma to_uintN (x : t) : to_uint (-x) = (- to_uint x) %% modulus. -proof. by rewrite oppE /ulift1 of_uintK. qed. - -lemma of_intD (x y : int) : of_int (x + y) = of_int x + of_int y. -proof. -rewrite addE /ulift2 /=; apply/word_modeqP=> /=. -by rewrite !of_uintK !modz_mod !(modzDml, modzDmr). -qed. - -lemma to_uintD (x y : t) : to_uint (x + y) = (to_uint x + to_uint y) %% modulus. -proof. by rewrite addE /ulift2 of_uintK. qed. - -lemma of_intM (x y : int) : of_int x * of_int y = of_int (x * y). -proof. -rewrite mulE /ulift2 /=; apply/word_modeqP=> /=. -by rewrite !of_uintK !modz_mod !(modzMml, modzMmr). -qed. - -lemma to_uintM (x y : t) : to_uint (x * y) = (to_uint x * to_uint y) %% modulus. -proof. by rewrite mulE /ulift2 !of_uintK. qed. - -lemma to_uintD_small (x y : t) : to_uint x + to_uint y < modulus => - to_uint (x + y) = to_uint x + to_uint y. -proof. - move=> h;rewrite to_uintD modz_small 2://; smt (to_uint_cmp). -qed. - -lemma to_uintM_small (x y : t) : to_uint x * to_uint y < modulus => - to_uint (x * y) = (to_uint x * to_uint y). -proof. - move=> h;rewrite to_uintM modz_small 2://; smt (to_uint_cmp). -qed. - -clone export Ring.ComRing as WRingA with - type t <- t, - op zeror <- of_int 0, - op ( + ) <- BitWord.( + ), - op [ - ] <- BitWord.([-]), - op oner <- of_int 1, - op ( * ) <- BitWord.( * ), - op invr <- invr, - pred unit <- BitWord.unit proof *. - -realize addrA. -proof. - move=> x y z; rewrite addE /ulift2 !to_uintD -of_int_mod modzDmr. - by rewrite -(of_int_mod (_ + to_uint z)) modzDml addrA. -qed. - -realize addrC. -proof. by move=> x y; rewrite !addE /ulift2 addzC. qed. - -realize add0r. -proof. by move=> x; rewrite addE /ulift2; cbv delta. qed. - -realize addNr. -proof. - move=> x; rewrite addE oppE /ulift2 /ulift1 of_uintK. - by rewrite -of_int_mod modzDml addNz. -qed. - -realize oner_neq0. -proof. - apply /negP => heq. - have := of_uintK 1; rewrite heq of_uintK mod0z. - rewrite modz_small //;smt (ge2_modulus). -qed. - -realize mulrA. - move=> x y z; rewrite mulE /ulift2 !to_uintM -of_int_mod modzMmr. - by rewrite -(of_int_mod (_ * to_uint z)) modzMml mulrA. -qed. - -realize mulrC. -proof. by move=> x y; rewrite !mulE /ulift2 mulzC. qed. - -realize mul1r. -proof. by move=> x; rewrite mulE /ulift2 to_uint1. qed. - -realize mulrDl. -proof. - move=> x y z; rewrite !addE !mulE /ulift2. - rewrite !of_uintK -of_int_mod modzMml eq_sym. - by rewrite -of_int_mod modzDml modzDmr mulrDl. -qed. - -realize mulVr. -proof. by move=> x /choicebP /= ->. qed. - -realize unitP. -proof. by move=> w wi hinv;exists wi. qed. - -realize unitout. -proof. by move=> x /negb_exists /=; apply choiceb_dfl. qed. - -abbrev (^) = WRingA.exp. - -lemma ofintS (n : int) : 0 <= n => of_int (n + 1) = of_int 1 + of_int n. -proof. by rewrite of_intD addrC. qed. - -lemma to_uintB (x y: t) : y \ule x => to_uint (x - y) = to_uint x - to_uint y. -proof. - rewrite uleE=> hle. - rewrite to_uintD to_uintN modzDmr modz_small //; smt (to_uint_cmp). -qed. - -(* Add simplification rule for rewriting *) -(* FIXME add direction for hint simplify *) -lemma of_intN' (x : int) : - of_int x = of_int (-x). -proof. by rewrite of_intN. qed. - -lemma of_intS (x y : int) : of_int (x - y) = of_int x - of_int y. -proof. by rewrite of_intD of_intN. qed. - -lemma of_intS' (x y : int) : of_int x - of_int y = of_int (x - y). -proof. by rewrite of_intS. qed. - -lemma of_intD' (x y : int) : of_int x + of_int y = of_int (x + y). -proof. by rewrite of_intD. qed. - -lemma of_intM' (x y : int) : of_int x * of_int y = of_int (x * y). -proof. by rewrite of_intM. qed. - -hint simplify (of_intS', of_intM')@0. -hint simplify (of_intD')@1. - -lemma addr0_s w : w + of_int 0 = w. -proof. by apply addr0. qed. - -lemma add0r_s w : of_int 0 + w = w. -proof. by apply add0r. qed. - -lemma mulr1_s w : w * of_int 1 = w. -proof. by apply mulr1. qed. - -lemma mul1r_s w : of_int 1 * w = w. -proof. by apply mul1r. qed. - -lemma mulr0_s w : w * of_int 0 = of_int 0. -proof. by apply mulr0. qed. - -lemma mul0r_s w : of_int 0 * w = of_int 0. -proof. by apply mul0r. qed. - -lemma addA_ofint w i j : w + of_int i + of_int j = w + of_int (i + j). -proof. by rewrite -addrA. qed. - -lemma addS_ofint w i j : w + of_int i - of_int j = w + of_int (i - j). -proof. by rewrite -addrA -of_intS. qed. - -hint simplify (addr0_s, add0r_s, mul1r_s, mulr1_s, mul0r_s, mulr0_s, addA_ofint). - - - -(* --------------------------------------------------------------------- *) -(* Ring tactic *) - -op zerow_ring = of_int 0. -op onew_ring = of_int 1. - -instance ring with t - op rzero = BitWord.zerow_ring - op rone = BitWord.onew_ring - op add = BitWord.( + ) - op opp = BitWord.([-]) - op mul = BitWord.( * ) - op expr = WRingA.exp - op ofint = BitWord.of_int - - proof oner_neq0 by apply oner_neq0 - proof addr0 by apply addr0 - proof addrA by apply addrA - proof addrC by apply addrC - proof addrN by apply addrN - proof mulr1 by apply mulr1 - proof mulrA by apply mulrA - proof mulrC by apply mulrC - proof mulrDl by apply mulrDl - proof expr0 by apply expr0 - proof exprS by apply exprS - proof ofint0 by done - proof ofint1 by done - proof ofintS by apply ofintS - proof ofintN by apply of_intN. - -(* --------------------------------------------------------------------- *) -(* Exact arithmetic operations *) -op subc : t -> t -> bool -> bool * t. -op addc : t -> t -> bool -> bool * t. -op mulu : t -> t -> t * t. - -(* --------------------------------------------------------------------- *) -(* Bitwize operations *) - -abbrev (`&`) = andw. -abbrev (`|`) = orw. -abbrev (`^`) = (+^). - -op (`>>>`) (x : t) (i : int) = - init (fun j => x.[j + i]) -axiomatized by wlsrE. - -op (`<<<`) (x : t) (i : int) = - init (fun j => x.[j - i]) -axiomatized by wlslE. - -lemma shlwE w k i : (w `<<<` k).[i] = (0 <= i < size && w.[i - k]). -proof. by rewrite wlslE initE. qed. - -lemma shrwE w k i : (w `>>>` k).[i] = (0 <= i < size && w.[i + k]). -proof. by rewrite wlsrE initE. qed. -hint simplify (shrwE, shlwE). - -lemma int_bitMP i j k : 0 <= k => 0 <= j < size => - int_bit (i * 2 ^ k) j = (0 <= j - k < size /\ int_bit i (j - k)). -proof. - move=> hk [h0j hjs];rewrite /int_bit modz_pow2_div 1:/# modz_dvd. - + by apply (dvdz_exp2l 2 1) => /#. - case: (0 <= j - k < size) => [ [hjk1 hjk2] | hjk] /=;last first. - + have hlt : (j < k) by smt(). - have ->: k = (k-j-1) + 1 + j by ring. - rewrite -pow_add 1:/# 1:// -mulzA mulzK; 1: smt (gt0_pow2). - by rewrite -pow_add 1:/# //= -mulzA modzMl. - rewrite (modz_pow2_div size) 1:/# modz_dvd. - + by apply (dvdz_exp2l 2 1) => /#. - have {1}-> : j = (j - k) + k by ring. - by rewrite -pow_add 1,2:// divzMpr 1:gt0_pow2. -qed. - -lemma int_bitDP i j k : 0 <= i < modulus => 0 <= k => 0 <= j < size => - int_bit (i %/ 2 ^ k) j = (0 <= j + k < size /\ int_bit i (j + k)). -proof. - move=> hi hk [h0j hjs];rewrite /int_bit. - rewrite !(modz_small _ modulus); 1,2: apply bound_abs; 2:done. - + by apply divz_cmp; [apply gt0_pow2 | smt (gt0_pow2)]. - case: (0 <= j + k < size) => hjk. - + have {1}->:= divz_eq i (2^(j+k)). - have {1}->:= divz_eq (i %% 2 ^ (j + k)) (2^k). - pose id := i %/ 2 ^ (j + k). pose im := i %% 2 ^ (j + k). - have -> : id * 2 ^ (j + k) + (im %/ 2 ^ k * 2 ^ k + im %% 2 ^ k) = - (id * 2^j + im %/ 2 ^ k) * 2^k + im %% 2 ^ k. - + by rewrite -pow_add 1,2://;ring. - rewrite divzMDl. smt (gt0_pow2). - rewrite (divz_small (im %% 2 ^ k) (2 ^ k)). - + apply bound_abs;apply modz_cmp;apply gt0_pow2. - rewrite /= divzMDl. smt (gt0_pow2). - rewrite (divz_small (im %/ 2 ^ k) (2 ^ j)) 2://. - apply bound_abs; apply divz_cmp; 1:by apply gt0_pow2. - by rewrite pow_add 1,2://;apply modz_cmp;apply gt0_pow2. - rewrite /= (divz_small (i %/ 2 ^ k) (2 ^ j)) 2://. - apply bound_abs;apply divz_cmp; 1: by apply gt0_pow2. - rewrite pow_add 1,2://;smt (pow_Mle). -qed. - -lemma shlMP i k : 0 <= k => (of_int i `<<<` k) = of_int (i * 2^k). -proof. - by move=> hk;apply wordP => j hj; rewrite shlwE !of_intwE hj /= -int_bitMP. -qed. - -lemma shrDP i k : 0 <= k => (of_int i `>>>` k) = of_int (i %% modulus %/ 2^k). -proof. - move=> hk;rewrite -(of_int_mod i). - apply wordP => j hj; rewrite shrwE !of_intwE hj /= -int_bitDP //. - by apply modz_cmp. -qed. - -lemma to_uint_shl (w:t) i : - 0 <= i => to_uint (w `<<<` i) = (to_uint w * 2^ i) %% modulus. -proof. - by move=> hi; rewrite -{1}(to_uintK w) shlMP 1:// of_uintK. -qed. - -lemma to_uint_shr (w:t) i : - 0 <= i => to_uint (w `>>>` i) = to_uint w %/ 2^ i. -proof. - move=> hi;rewrite -{1}(to_uintK w) shrDP 1:// of_uintK. - rewrite (modz_small (to_uint w)). - + by apply bound_abs; apply to_uint_cmp. - rewrite modz_small 2://. - apply bound_abs; apply divz_cmp; [apply gt0_pow2 | ]. - smt (to_uint_cmp gt0_pow2). -qed. - -lemma shrw_shlw w i : w `>>>` i = w `<<<` (-i). -proof. by apply wordP => k hk /=. qed. - -lemma shrw_add w i j : 0 <= i => 0 <= j => w `>>>` i `>>>` j = w `>>>` (i + j). -proof. - move=> hi hj; apply wordP => k hk /=;rewrite hk /=. - case : (0 <= k + j < size) => hkj /=; 1:congr;ring. - by rewrite get_out 1:/#. -qed. - -lemma shrw_out w i : size <= i => w `>>>` i = zero. -proof. - by move=> hi;apply wordP => k hk/=; rewrite get_out 1:/#. -qed. -hint simplify (shrw_add, shrw_out). - -lemma shlw_add w i j : 0 <= i => 0 <= j => w `<<<` i `<<<` j = w `<<<` (i + j). -proof. - move=> hi hj; apply wordP => k hk /=;rewrite hk /=. - case : (0 <= k - j < size) => hkj /=; 1:congr;ring. - by rewrite get_out 1:/#. -qed. - -lemma shlw_out w i : size <= i => w `<<<` i = zero. -proof. - by move=> hi;apply wordP => k hk/=; rewrite get_out 1:/#. -qed. -hint simplify (shlw_add, shlw_out). - -lemma shrw_map2 f w1 w2 i : f false false = false => - (map2 f) (w1 `>>>` i) (w2 `>>>` i) = (map2 f w1 w2) `>>>` i. -proof. - move=> hf;apply wordP => k hk. - rewrite map2iE // !shrwE hk. - case: (0 <= k + i < size) => hki; 1: by rewrite map2iE. - by rewrite !get_out. -qed. - -lemma shlw_map2 f w1 w2 i : f false false = false => - (map2 f) (w1 `<<<` i) (w2 `<<<` i) = (map2 f w1 w2) `<<<` i. -proof. - move=> hf;apply wordP => k hk. - rewrite map2iE // !shlwE hk. - case: (0 <= k - i < size) => hki; 1: by rewrite map2iE. - by rewrite !get_out. -qed. - -lemma shrw_and w1 w2 i : (w1 `>>>` i) `&` (w2 `>>>` i) = (w1 `&` w2) `>>>` i. -proof. by rewrite andE shrw_map2. qed. - -lemma shrw_xor w1 w2 i : (w1 `>>>` i) `^` (w2 `>>>` i) = (w1 `^` w2) `>>>` i. -proof. by rewrite xorE shrw_map2. qed. - -lemma shrw_or w1 w2 i : (w1 `>>>` i) `|` (w2 `>>>` i) = (w1 `|` w2) `>>>` i. -proof. by rewrite orE shrw_map2. qed. - -lemma shlw_and w1 w2 i : (w1 `<<<` i) `&` (w2 `<<<` i) = (w1 `&` w2) `<<<` i. -proof. by rewrite andE shlw_map2. qed. - -lemma shlw_xor w1 w2 i : (w1 `<<<` i) `^` (w2 `<<<` i) = (w1 `^` w2) `<<<` i. -proof. by rewrite xorE shlw_map2. qed. - -lemma shlw_or w1 w2 i : (w1 `<<<` i) `|` (w2 `<<<` i) = (w1 `|` w2) `<<<` i. -proof. by rewrite orE shlw_map2. qed. - -hint simplify (shrw_and, shrw_xor, shrw_or, shlw_and, shlw_xor, shlw_or). - -op ror (x : t) (i : int) = - init (fun j => x.[(j + i) %% size]) -axiomatized by rorE. - -op rol (x : t) (i : int) = - init (fun j => x.[(j - i) %% size]) -axiomatized by rolE. - -lemma rorwE w k i : - (ror w k).[i] = if (0 <= i < size) then w.[(i+k) %% size] else false. -proof. by rewrite rorE initE. qed. - -lemma rolwE w k i : - (rol w k).[i] = if (0 <= i < size) then w.[(i-k) %% size] else false. -proof. by rewrite rolE initE. qed. - -hint simplify (rorwE, rolwE). - -lemma rol_xor w i : 0 <= i < size => - rol w i = (w `<<<` i) `^` (w `>>>` (size - i)). -proof. - move=> hi; apply wordP => k hk /=. - rewrite hk /=. - case (0 <= k - i < size) => hki. - + rewrite modz_small; 1: by apply bound_abs. - by rewrite (get_out _ (k + (size - i))) 1:/#. - rewrite modz_sub_carry // 1:/# (get_out _ _ hki) /=. - by congr;ring. -qed. - -lemma rol_xor_simplify w1 w2 i si: - w1 = w2 => si = size - i => 0 <= i < size => - (w1 `<<<` i) `^` (w2 `>>>` si) = rol w1 i. -proof. by move=> 2!-> hi;rewrite rol_xor. qed. - -(* --------------------------------------------------------------------- *) -(* Like between bitwize operations and arithmetic operations *) - -lemma and_mod k w : - 0 <= k => - w `&` of_int (2^k - 1) = of_int (to_uint w %% 2^k). -proof. - move=> hk;apply wordP => i hi /=. - rewrite of_int_powm1 of_intwE hi /= /int_bit. - rewrite (modz_small _ modulus). - + apply bound_abs; smt (le_modz modz_cmp to_uint_cmp gt0_pow2). - case (i < k) => hik /=. - + rewrite modz_pow2_div 1:/# modz_dvd. - + by apply (dvdz_exp2l 2 1) => /#. - by rewrite get_to_uint hi. - rewrite divz_small 2://; smt (gt0_pow2 modz_cmp pow_Mle). -qed. - -lemma to_uint_and_mod k w : - 0 <= k => - to_uint (w `&` of_int (2^k - 1)) = to_uint w %% 2^k. -proof. - move=> hk ; rewrite and_mod 1:// of_uintK modz_small //. - apply bound_abs; smt (le_modz to_uint_cmp gt0_pow2 modz_cmp). -qed. - -end BitWord. - -theory W8. - abbrev [-printing] size = 8. - clone include BitWord with op size <- 8 - proof gt0_size by done. - - op (`>>`) (w1 w2 : W8.t) = w1 `>>>` (to_uint w2 %% size). - op (`<<`) (w1 w2 : W8.t) = w1 `<<<` (to_uint w2 %% size). - - lemma shr_div w1 w2 : to_uint (w1 `>>` w2) = to_uint w1 %/ 2^ (to_uint w2 %% size). - proof. - rewrite -{1}(to_uintK w1) /(`>>`) shrDP; 1: smt (modz_cmp). - rewrite of_uintK to_uint_mod modz_small 2://. - apply bound_abs; apply divz_cmp; 1: by apply gt0_pow2. - by have:= to_uint_cmp w1; smt (gt0_pow2). - qed. - - lemma shr_div_le w1 i : 0 <= i < size => - to_uint (w1 `>>` (of_int i)) = to_uint w1 %/ 2^i. - proof. - move=> hi;rewrite shr_div of_uintK. - rewrite (modz_small i);1: smt (pow2_8). - by rewrite modz_small. - qed. - - lemma rol_xor_shft w i : 0 < i < size => - rol w i = (w `<<` of_int i) +^ (w `>>` of_int (size - i)). - proof. - move=> hi; rewrite /(`<<`) /(`>>`) !of_uintK /=. - by rewrite !(modz_small _ 256) 1,2:/# !modz_small 1,2:/# rol_xor 1:/#. - qed. -end W8. export W8. - -abstract theory WT. - type t. - op size : int. - axiom gt0_size : 0 < size. - - op "_.[_]" : t -> int -> bool. - op init : (int -> bool) -> t. - - op andw : t -> t -> t. - op orw : t -> t -> t. - op (+^) : t -> t -> t. - - op (+) : t -> t -> t. - - op (`>>`) : t -> W8.t -> t. - op (`<<`) : t -> W8.t -> t. - op rol : t -> int -> t. - op of_int : int -> t. - op to_uint : t -> int. - op to_sint : t -> int. - - op bits : t -> int -> int -> bool list. - - axiom initiE (f : int -> bool) (i : int) : 0 <= i < size => (init f).[i] = f i. - - axiom andwE (w1 w2 : t) (i : int) : (andw w1 w2).[i] = (w1.[i] /\ w2.[i]). - axiom orwE (w1 w2 : t) (i : int) : (orw w1 w2).[i] = (w1.[i] \/ w2.[i]). - axiom xorwE (w1 w2 : t) (i : int) : (w1 +^ w2).[i] = (w1.[i] ^^ w2.[i]). - - axiom wordP (w1 w2 : t) : - w1 = w2 <=> forall (i : int), 0 <= i < size => w1.[i] = w2.[i]. - - axiom to_uint_cmp (x : t) : 0 <= to_uint x < 2^size. - - op int_bit x i = (x%%2^size) %/ 2 ^ i %% 2 <> 0. - - axiom of_intwE x i : - (of_int x).[i] = (0 <= i < size /\ int_bit x i). - - axiom get_to_uint w i : w.[i] = (0 <= i < size /\ to_uint w %/ 2 ^ i %% 2 <> 0). - - axiom bitsE w k len : bits w k len = mkseq (fun (i:int) => w.[k+i]) len. - - axiom bits_divmod w i j: 0 <= i => 0 <= j => - bs2int (bits w i j) = ((to_uint w) %/ 2^i) %% 2^j. - - axiom to_uintRL (w:t) (x:int) : to_uint w = x %% 2^size => w = of_int x. - - axiom to_uint_bits w : to_uint w = bs2int (bits w 0 size). - - axiom of_uintK (x : int) : to_uint (of_int x) = x %% 2^size. - - axiom to_uintK : cancel to_uint of_int. - - axiom of_int_mod (x : int) : of_int (x %% 2^size) = of_int x. - - axiom and_mod k w : - 0 <= k => - andw w (of_int (2^k - 1)) = of_int (to_uint w %% 2^k). - - axiom rol_xor_shft w i : 0 < i < size => - rol w i = (w `<<` W8.of_int i) +^ (w `>>` W8.of_int (size - i)). - -end WT. - -abstract theory W_WS. - - op sizeS : int. - op sizeB : int. - op r : int. - axiom gt0_r : 0 < r. - axiom sizeBrS : sizeB = r * sizeS. - - clone import WT as WS with op size <- sizeS. - clone import WT as WB with op size <- sizeB. - - clone export MonoArray as Pack with - type elem <- WS.t, - op dfl <- WS.of_int 0, - op size <- r - proof ge0_size by smt (gt0_r) - rename [type] "t" as "pack_t" - [lemma] "tP" as "packP". - - hint simplify Pack.map_to_list@1. - hint simplify Pack.map2_to_list@1. - - lemma le_size : sizeS <= sizeB. - proof. rewrite sizeBrS;smt (gt0_r WS.gt0_size WB.gt0_size). qed. - - lemma in_bound i j : 0 <= i < r => 0 <= j < sizeS => 0 <= i * sizeS + j < sizeB. - proof. - move=> hi hj;rewrite sizeBrS;have : i * sizeS + j < (i+1) * sizeS; smt (). - qed. - - (* ------------------------------------------------ *) - - op sigextu'B (w:WS.t) = WB.of_int (WS.to_sint w). - op zeroextu'B (w:WS.t) = WB.of_int (WS.to_uint w). - op truncateu'S (w:WB.t) = WS.of_int (WB.to_uint w). - - hint exact : WS.gt0_size WB.gt0_size. - - lemma size_div : sizeS %| sizeB. - proof. by rewrite dvdzP sizeBrS;exists r. qed. - - lemma div_size : sizeB %/ sizeS = r. - proof. rewrite sizeBrS mulzK; smt (WS.gt0_size). qed. - - op (\bits'S) (w:WB.t) i = WS.init (fun j => w.[ i * sizeS + j]) - axiomatized by bits'SE. - - op unpack'S (w:WB.t) : pack_t = - Pack.init (fun i => w \bits'S i). - - abbrev to_list (w:WB.t) : WS.t list = Pack.to_list (unpack'S w). - - op pack'R_t (ws:pack_t) = - WB.init (fun i => ws.[i %/ sizeS].[i %% sizeS]) - axiomatized by pack'RE. - - abbrev pack'R (ws:WS.t list) = pack'R_t (Pack.of_list ws). - - lemma pack'RwE (ws:pack_t) i : 0 <= i < sizeB => - (pack'R_t ws).[i] = ws.[i %/ sizeS].[i %% sizeS]. - proof. by move=> hi;rewrite pack'RE initiE //. qed. - - lemma get_unpack'S w i : 0 <= i < r => - (unpack'S w).[i] = w \bits'S i. - proof. apply initiE. qed. - - lemma bits'SiE w i j : 0 <= j < sizeS => - (w \bits'S i).[j] = w.[i * sizeS + j]. - proof. by move=> hj; rewrite bits'SE initiE. qed. - - lemma get_bits'S (w:WB.t) i : - 0 <= i < sizeB => - w.[i] = (w \bits'S (i%/ sizeS)).[i %% sizeS]. - proof. - by move=> hi; rewrite bits'SE WS.initiE /= -?divz_eq; 1:by apply modz_cmp. - qed. - - lemma get_out (w:WB.t) i : - !(0 <= i < r) => - w \bits'S i = WS.of_int 0. - proof. - move=> hi;apply WS.wordP => k hk. - rewrite bits'SiE 1:// WS.of_intwE /WS.int_bit /= get_to_uint. - smt(gt0_r WS.gt0_size sizeBrS). - qed. - - lemma get_zero i : WB.of_int 0 \bits'S i = WS.of_int 0. - proof. - apply WS.wordP => k hk. - by rewrite bits'SiE 1:// WS.of_intwE /WS.int_bit /= get_to_uint /= WB.of_uintK. - qed. - - lemma unpack'SK w : pack'R_t (unpack'S w) = w. - proof. - apply wordP => i hi; rewrite pack'RE initiE //= get_bits'S //. - by rewrite get_unpack'S //;apply divz_cmp => //;rewrite -sizeBrS. - qed. - - lemma pack'RbE ws i : 0 <= i < r => pack'R_t ws \bits'S i = ws.[i]. - proof. - move=> hr;apply WS.wordP => j hj. - rewrite bits'SiE // pack'RE initiE /= ?in_bound //. - by rewrite modzMDl divzMDl 1:/# divz_small ?modz_small; solve. - qed. - - lemma pack'RK ws : unpack'S (pack'R_t ws) = ws. - proof. by apply packP => i hi; rewrite get_unpack'S // pack'RbE. qed. - - lemma wordP (w1 w2 :WB.t) : (forall i, 0 <= i < r => w1 \bits'S i = w2 \bits'S i) => w1 = w2. - proof. - move=> h; rewrite -(unpack'SK w1) -(unpack'SK w2); congr. - by apply Pack.packP => i hi; rewrite !get_unpack'S 1,2://; apply h. - qed. - - lemma allP (w1 w2 :WB.t) : all (fun i => w1 \bits'S i = w2 \bits'S i) (iota_ 0 r) => w1 = w2. - proof. rewrite allP => h; apply wordP => i; rewrite -(mema_iota 0 r); apply h. qed. - - abbrev map (f:WS.t -> WS.t) (w:WB.t) = - pack'R_t (map f (unpack'S w)). - - abbrev map2 (f:WS.t -> WS.t -> WS.t) (w1 w2:WB.t) = - pack'R_t (map2 f (unpack'S w1) (unpack'S w2)). - - lemma mapbE f w i : 0 <= i < r => - (map f w) \bits'S i = f (w \bits'S i). - proof. - by move=> hi;rewrite pack'RbE // mapiE // initiE. - qed. - - lemma map2bE f w1 w2 i : 0 <= i < r => - (map2 f w1 w2) \bits'S i = f (w1 \bits'S i) (w2 \bits'S i). - proof. - by move=> hi;rewrite pack'RbE // map2iE // !initiE. - qed. - - lemma andb'SE (w1 w2:WB.t) i : - (WB.andw w1 w2) \bits'S i = WS.andw (w1 \bits'S i) (w2 \bits'S i). - proof. - apply WS.wordP => j hj. - by rewrite bits'SiE // WB.andwE WS.andwE !bits'SiE. - qed. - - lemma orb'SE (w1 w2:WB.t) i : - (WB.orw w1 w2) \bits'S i = WS.orw (w1 \bits'S i) (w2 \bits'S i). - proof. - apply WS.wordP => j hj. - by rewrite bits'SiE // WB.orwE WS.orwE !bits'SiE. - qed. - - lemma xorb'SE (w1 w2:WB.t) i : - (WB.(+^) w1 w2) \bits'S i = WS.(+^) (w1 \bits'S i) (w2 \bits'S i). - proof. - apply WS.wordP => j hj. - by rewrite bits'SiE // WB.xorwE WS.xorwE !bits'SiE. - qed. - - lemma andb'Ru'SE ws1 ws2 : - WB.andw (pack'R_t ws1) (pack'R_t ws2) = pack'R_t (map2 WS.andw ws1 ws2). - proof. - apply (canRL _ _ _ _ unpack'SK); apply packP => i hi. - by rewrite get_unpack'S // map2iE // andb'SE // !pack'RbE. - qed. - - lemma orb'Ru'SE ws1 ws2 : - WB.orw (pack'R_t ws1) (pack'R_t ws2) = pack'R_t (map2 WS.orw ws1 ws2). - proof. - apply (canRL _ _ _ _ unpack'SK); apply packP => i hi. - by rewrite get_unpack'S // map2iE // orb'SE // !pack'RbE. - qed. - - lemma xorb'Ru'SE ws1 ws2 : - WB.(+^) (pack'R_t ws1) (pack'R_t ws2) = pack'R_t (map2 WS.(+^) ws1 ws2). - proof. - apply (canRL _ _ _ _ unpack'SK); apply packP => i hi. - by rewrite get_unpack'S // map2iE // xorb'SE // !pack'RbE. - qed. - - lemma bits'S_div (w:WB.t) i : 0 <= i => - w \bits'S i = WS.of_int (WB.to_uint w %/ (2^(sizeS*i))). - proof. - move=> hi;apply WS.to_uintRL;rewrite -bits_divmod. - + smt (WS.gt0_size). smt (WS.gt0_size). - rewrite to_uint_bits; congr; rewrite WS.bitsE WB.bitsE; apply eq_in_mkseq. - by move=> k hk /=;rewrite bits'SiE 1:// mulzC. - qed. - - lemma of_int_bits'S_div w i : 0 <= i < r => - (WB.of_int w) \bits'S i = WS.of_int (w %/ (2^(sizeS*i))). - proof. - move=> [h0i hir];rewrite bits'S_div //. - rewrite WB.of_uintK modz_pow2_div. - + by rewrite sizeBrS mulzC; apply cmpW; apply mulz_cmp_r. - rewrite -WS.of_int_mod modz_mod_pow2 /min. - have -> /= : !sizeB - sizeS * i < sizeS. - + rewrite sizeBrS. - have -> : r * sizeS - sizeS * i = sizeS * (r - i) by ring. - by rewrite -lezNgt;apply ler_pemulr;[ apply ltzW | smt ()]. - by rewrite WS.of_int_mod. - qed. - - lemma of_int_bits'S_div_red (w i:int) : 0 <= i < r => - 0 <= `|w| => (* Do not remove this condition, it is used to block reduction *) - (WB.of_int w) \bits'S i = WS.of_int (w %/ (2^(sizeS*i))). - proof. by move=> hi hw;apply of_int_bits'S_div. qed. - - hint simplify (pack'RwE, bits'SiE, pack'RbE, get_unpack'S, unpack'SK, pack'RK, - mapbE, map2bE, andb'SE, orb'SE, xorb'SE, - andb'Ru'SE, orb'Ru'SE, xorb'Ru'SE, of_int_bits'S_div_red). - - lemma to_uint_zeroextu'B (w:WS.t) : - WB.to_uint (zeroextu'B w) = WS.to_uint w. - proof. - rewrite /zeroextu'B WB.of_uintK modz_small //. - apply bound_abs;have [h1 h2] := WS.to_uint_cmp w;split => // ?. - apply: (ltr_le_trans (2^sizeS)) => //. - apply pow_Mle;smt (le_size WS.gt0_size). - qed. - - lemma zeroextu'B_bit (w:WS.t) i: (zeroextu'B w).[i] = ((0 <= i < sizeS) /\ w.[i]). - proof. - rewrite /zeroextu'B WB.of_intwE /WB.int_bit (modz_small (to_uint w)). - + smt(gt0_r WS.gt0_size sizeBrS pow_Mle WS.to_uint_cmp). - have -> := WS.get_to_uint w i. - case: (0 <= i < sizeS) => hi /=;1: smt(gt0_r WS.gt0_size sizeBrS). - have [ /#| h]: (i < 0 \/ sizeS <= i) by smt(). - rewrite divz_small 2://. - smt(gt0_r WS.gt0_size sizeBrS pow_Mle WS.to_uint_cmp). - qed. - - lemma to_uint_truncateu'S (w:WB.t) : - WS.to_uint (truncateu'S w) = WB.to_uint w %% 2 ^ sizeS. - proof. by rewrite /truncateu'S WS.of_uintK. qed. - - lemma zeroext_truncateu'S_and (w:WB.t) : - zeroextu'B (truncateu'S w) = andw w (WB.of_int (2^sizeS - 1)). - proof. - rewrite WB.and_mod; 1: smt (le_size WS.gt0_size). - rewrite -(WB.to_uintK (zeroextu'B (truncateu'S w))). - by rewrite to_uint_zeroextu'B to_uint_truncateu'S. - qed. - - lemma of_uint_pack'R i : - (WB.of_int i) = - pack'R (map (fun k => WS.of_int ((i %/ 2^(sizeS * k)) %% 2^sizeS)) (iota_ 0 r)). - proof. - rewrite -(unpack'SK (WB.of_int i)) /unpack'S Pack.init_of_list. - do 2! congr; apply (eq_from_nth (WS.of_int 0)) => [ | k]; rewrite !size_map //. - move=> hk;rewrite !(nth_map 0) //=. - move: hk;rewrite size_iota /max gt0_r /= => hk;rewrite !nth_iota //=. - case: hk => hk1 hk2;rewrite bits'S_div //. - rewrite WB.of_uintK -(WS.of_int_mod (i %% 2 ^ sizeB %/ 2 ^ (sizeS * k))). - congr;rewrite modz_pow2_div 1://. - + by rewrite sizeBrS; smt (WS.gt0_size). - rewrite modz_dvd 2://;apply dvdz_exp2l. - rewrite sizeBrS (_: r * sizeS - sizeS * k = sizeS * (r - k)); 1: by ring. - split; 1: smt (WS.gt0_size). - by move=> ?;apply ler_pemulr => // /#. - qed. - - op x86_VPADD_'Ru'S (w1 : WB.t) (w2:WB.t) = - map2 WS.(+) w1 w2. - -(* op x86_VPSUB_'Ru'S (w1 : WB.t) (w2:WB.t) = - map2 (fun (x y:WS.t) => x - y) w1 w2. - - op x86_VPMUL_'Ru'S (w1 : WB.t) (w2:WB.t) = - map2 WS.( * ) w1 w2. *) - - op x86_VPSLL_'Ru'S (w : WB.t) (cnt : W8.t) = - map (fun (w:WS.t) => w `<<` cnt) w. - - op x86_VPSRL_'Ru'S (w : WB.t) (cnt : W8.t) = - map (fun (w:WS.t) => w `>>` cnt) w. - - op x86_VPBROADCAST_'Ru'S (w: WS.t) = - pack'R (map (fun i => w) (iota_ 0 r)). - - lemma x86_'Ru'S_rol_xor i w : 0 < i < sizeS => - x86_VPSLL_'Ru'S w (W8.of_int i) +^ x86_VPSRL_'Ru'S w (W8.of_int (sizeS - i)) = - map (fun w0 => WS.rol w0 i) w. - proof. - move=> hr;rewrite /x86_VPSRL_'Ru'S /x86_VPSLL_'Ru'S. - rewrite /map;apply wordP => j hj. - by rewrite xorb'SE !pack'RbE 1..3:// !mapiE 1..3:// /= rol_xor_shft. - qed. - - lemma x86_'Ru'S_rol_xor_red w1 w2 i si: - w1 = w2 => W8.to_uint si = sizeS - W8.to_uint i => 0 < W8.to_uint i < sizeS => - x86_VPSLL_'Ru'S w1 i +^ x86_VPSRL_'Ru'S w2 si = - map (fun w0 => WS.rol w0 (W8.to_uint i)) w1. - proof. - by move=> -> hsi hi; rewrite -(W8.to_uintK i) -(W8.to_uintK si) hsi x86_'Ru'S_rol_xor. - qed. - - hint simplify x86_'Ru'S_rol_xor_red. - -end W_WS. - -abstract theory BitWordSH. - op size : int. - axiom size_le_256 : size <= 256. - clone include BitWord with op size <- size. - - op (`>>`) (w1 : t) (w2 : W8.t) = w1 `>>>` (to_uint w2 %% size). - op (`<<`) (w1 : t) (w2 : W8.t) = w1 `<<<` (to_uint w2 %% size). - - lemma shr_div w1 w2 : to_uint (w1 `>>` w2) = to_uint w1 %/ 2^ (to_uint w2 %% size). - proof. - rewrite -{1}(to_uintK w1) /(`>>`) shrDP; 1: smt (modz_cmp gt0_size). - rewrite of_uintK to_uint_mod modz_small 2://. - apply bound_abs; apply divz_cmp; 1: by apply gt0_pow2. - by have:= to_uint_cmp w1; smt (gt0_pow2). - qed. - - lemma shr_div_le w1 i : 0 <= i < size => - to_uint (w1 `>>` (W8.of_int i)) = to_uint w1 %/ 2^ i. - proof. - move=> hi;rewrite shr_div of_uintK. - rewrite (modz_small i) 1:pow2_8; 1: smt (size_le_256). - by rewrite modz_small //;apply bound_abs. - qed. - - lemma rol_xor_shft w i : 0 < i < size => - rol w i = (w `<<` W8.of_int i) +^ (w `>>` W8.of_int (size - i)). - proof. - move=> hi; rewrite /(`<<`) /(`>>`) !W8.of_uintK. - have h : 0 <= i < `|W8.modulus|. - + by rewrite /=; smt (size_le_256). - rewrite !(modz_small _ W8.modulus) 1:// 1:[smt (size_le_256)] !modz_small 1,2:/#. - by rewrite rol_xor 1:/#. - qed. - -end BitWordSH. - -theory W16. - abbrev [-printing] size = 16. - clone include BitWordSH with op size <- size - proof gt0_size by done, - size_le_256 by done. -end W16. export W16. - -clone export W_WS as W2u8 with - op sizeS <- W8.size, op sizeB <- W16.size, op r <- 2, - theory WS <- W8, theory WB <- W16 - proof gt0_r by done, sizeBrS by done - rename [op, lemma] "'Ru'S" as "2u8" "'R" as "2" "'S" as "8" "'B" as "16" . - -theory W32. - abbrev [-printing] size = 32. - clone include BitWordSH with op size <- size - proof gt0_size by done, - size_le_256 by done. -end W32. export W32. - -clone export W_WS as W4u8 with - op sizeS <- W8.size, op sizeB <- W32.size, op r <- 4, - theory WS <- W8, theory WB <- W32 - proof gt0_r by done, sizeBrS by done - rename [op, lemma] "'Ru'S" as "4u8" "'R" as "4" "'S" as "8" "'B" as "32". - -clone export W_WS as W2u16 with - op sizeS <- W16.size, op sizeB <- W32.size, op r <- 2, - theory WS <- W16, theory WB <- W32 - proof gt0_r by done, sizeBrS by done - rename [op, lemma] "'Ru'S" as "2u16" "'R" as "2" "'S" as "16" "'B" as "32". - -theory W64. - abbrev [-printing] size = 64. - clone include BitWordSH with op size <- size - proof gt0_size by done, - size_le_256 by done. -end W64. export W64. - -clone export W_WS as W8u8 with - op sizeS <- W8.size, op sizeB <- W64.size, op r <- 8, - theory WS <- W8, theory WB <- W64 - proof gt0_r by done, sizeBrS by done - rename [op, lemma] "'Ru'S" as "8u8" "'R" as "8" "'S" as "8" "'B" as "64". - -clone export W_WS as W4u16 with - op sizeS <- W16.size, op sizeB <- W64.size, op r <- 4, - theory WS <- W16, theory WB <- W64 - proof gt0_r by done, sizeBrS by done - rename [op, lemma] "'Ru'S" as "4u16" "'R" as "4" "'S" as "16" "'B" as "64". - -clone export W_WS as W2u32 with - op sizeS <- W32.size, op sizeB <- W64.size, op r <- 2, - theory WS <- W32, theory WB <- W64 - proof gt0_r by done, sizeBrS by done - rename [op, lemma] "'Ru'S" as "2u32" "'R" as "2" "'S" as "32" "'B" as "64". - -theory W128. - abbrev [-printing] size = 128. - clone include BitWordSH with op size <- size - proof gt0_size by done, - size_le_256 by done. -end W128. export W128. - -clone export W_WS as W16u8 with - op sizeS <- W8.size, op sizeB <- W128.size, op r <- 16, - theory WS <- W8, theory WB <- W128 - proof gt0_r by done, sizeBrS by done - rename [op, lemma] "'Ru'S" as "16u8" "'R" as "16" "'S" as "8" "'B" as "128". - -clone export W_WS as W8u16 with - op sizeS <- W16.size, op sizeB <- W128.size, op r <- 8, - theory WS <- W16, theory WB <- W128 - proof gt0_r by done, sizeBrS by done - rename [op, lemma] "'Ru'S" as "8u16" "'R" as "8" "'S" as "16" "'B" as "128". - -clone export W_WS as W4u32 with - op sizeS <- W32.size, op sizeB <- W128.size, op r <- 4, - theory WS <- W32, theory WB <- W128 - proof gt0_r by done, sizeBrS by done - rename [op, lemma] "'Ru'S" as "4u32" "'R" as "4" "'S" as "32" "'B" as "128". - -clone export W_WS as W2u64 with - op sizeS <- W64.size, op sizeB <- W128.size, op r <- 2, - theory WS <- W64, theory WB <- W128 - proof gt0_r by done, sizeBrS by done - rename [op, lemma] "'Ru'S" as "2u64" "'R" as "2" "'S" as "64" "'B" as "128". - -theory W256. - abbrev [-printing] size = 256. - clone include BitWordSH with op size <- size - proof gt0_size by done, - size_le_256 by done. -end W256. export W256. - -clone export W_WS as W32u8 with - op sizeS <- W8.size, op sizeB <- W256.size, op r <- 32, - theory WS <- W8, theory WB <- W256 - proof gt0_r by done, sizeBrS by done - rename [op, lemma] "'Ru'S" as "32u8" "'R" as "32" "'S" as "8" "'B" as "256". - -clone export W_WS as W16u16 with - op sizeS <- W16.size, op sizeB <- W256.size, op r <- 16, - theory WS <- W16, theory WB <- W256 - proof gt0_r by done, sizeBrS by done - rename [op, lemma] "'Ru'S" as "16u16" "'R" as "16" "'S" as "16" "'B" as "256". - -clone export W_WS as W8u32 with - op sizeS <- W32.size, op sizeB <- W256.size, op r <- 8, - theory WS <- W32, theory WB <- W256 - proof gt0_r by done, sizeBrS by done - rename [op, lemma] "'Ru'S" as "8u32" "'R" as "8" "'S" as "32" "'B" as "256". - -clone export W_WS as W4u64 with - op sizeS <- W64.size, op sizeB <- W256.size, op r <- 4, - theory WS <- W64, theory WB <- W256 - proof gt0_r by done, sizeBrS by done - rename [op, lemma] "'Ru'S" as "4u64" "'R" as "4" "'S" as "64" "'B" as "256". - -clone export W_WS as W2u128 with - op sizeS <- W128.size, op sizeB <- W256.size, op r <- 2, - theory WS <- W128, theory WB <- W256 - proof gt0_r by done, sizeBrS by done - rename [op, lemma] "'Ru'S" as "2u128" "'R" as "2" "'S" as "128" "'B" as "256". - - -(* -------------------------------------------------------------------- *) -(* Word size *) - -type wsize = [ - | W8 - | W16 - | W32 - | W64 - | W128 - | W256 -]. - -op wsize_i (w:wsize) = - with w = W8 => 1 - with w = W16 => 2 - with w = W32 => 4 - with w = W64 => 8 - with w = W128 => 16 - with w = W256 => 32. - -(* TODO move *) -lemma gt0_wsize_i ws: 0 < wsize_i ws. -proof. by case ws. qed. -hint exact : gt0_wsize_i. - -lemma div_le_wsize ws1 ws2 : wsize_i ws1 <= wsize_i ws2 => wsize_i ws1 %| wsize_i ws2. -proof. by case: ws1 ws2 => -[]. qed. - -lemma div_wsize_modulus ws : wsize_i ws %| W64.modulus. -proof. by case ws. qed. -hint exact : div_wsize_modulus. - -(* -lemma foo (x y:W128.t) (x1 x2 y1 y2:W64.t): - x = pack2 [x1; x2] => - y = pack2 [y1; y2] => - map2 W64.( + ) x y = pack2 [x1 + y1; x2 + y2]. -proof. by move=> -> -> /=. qed. - -op bits_eq (w:W128.t) xs = - all (fun (ix:int * W64.t) => w \bits64 ix.`1 = ix.`2) - (zip (iota_ 0 (size xs)) xs). - -lemma foo1 (x y:W128.t) (x0 x1 y0 y1:W64.t): - (bits_eq x [x0; x1]) => - (bits_eq y [y0; y1]) => - (bits_eq (map2 W64.( + ) x y) [x0 + y0; x1 + y1]). -proof. rewrite /bits_eq /= => />. qed. - -lemma foo (x y:W128.t) (x1 x2 y1 y2:W64.t): - x = pack2 [x1; x2] => - y = pack2 [y1; y2] => - x `|` y = pack2 [x1 `|` y1; x2 `|` y2]. -proof. move=> -> -> /=. -*) - -lemma divmod_mul n d i j : - 0 < n => - 0 <= j < d => - (i * d + j) %/ (n * d) = i%/ n /\ (i * d + j) %% (n * d) = i %% n * d + j. -proof. - move=> hn hj. - have -> : i * d + j = (i %/ n) * (n * d) + (d * (i %% n) + j). - + have [h1 h2]:= edivzP i n. - by rewrite {1 2} h1 divzMDl 1:/# (divz_small (i%%n) n) 1:/# /=; ring. - rewrite divzMDl 1:/# modzMDl. - have hb: 0 <= d * (i %% n) + j < `|n * d|. - + have := modz_cmp i n hn. - have -> : `|n * d| = n * d by smt(). - have -> h : n * d = (n-1) * d + d by ring. - split;1: smt(); move=> ?. - apply ler_lt_add; 2:smt(). - by rewrite mulzC ler_pmul2r /#. - by rewrite (divz_small _ (n*d)) 1:// (modz_small _ (n*d)) 1:// /=; ring. -qed. - -(* --------------------------------------------------------------------------------- *) -(* Lemmas on \bits8 *) -(* --------------------------------------------------------------------------------- *) - -lemma bits8_W2u16 ws i : - W2u16.pack2_t ws \bits8 i = if 0 <= i < 4 then ws.[i%/2] \bits8 (i%%2) else W8.zero. -proof. - apply W8.wordP => j hj; rewrite !bits8iE 1,2://. - case: (0 <= i < 4) => /= hi; last by rewrite W32.get_out 1:/#. - rewrite pack2wE 1:/#; have /= [-> ->] := divmod_mul 2 8 i j _ hj; 1 :done; rewrite W2u8.bits8iE 1:// /#. -qed. - -lemma bits8_W2u16_red ws i : - 0 <= i < 4 => W2u16.pack2_t ws \bits8 i = ws.[i%/2] \bits8 (i%%2). -proof. by move=> h;rewrite bits8_W2u16 h. qed. - -lemma bits8_W4u16 ws i : - W4u16.pack4_t ws \bits8 i = if 0 <= i < 8 then ws.[i%/2] \bits8 (i%%2) else W8.zero. -proof. - apply W8.wordP => j hj; rewrite !bits8iE 1,2://. - case: (0 <= i < 8) => /= hi; last by rewrite W64.get_out 1:/#. - rewrite pack4wE 1:/#; have /= [-> ->] := divmod_mul 2 8 i j _ hj; 1:done; rewrite W2u8.bits8iE 1:// /#. -qed. - -lemma bits8_W4u16_red ws i : - 0 <= i < 8 => W4u16.pack4_t ws \bits8 i = ws.[i%/2] \bits8 (i%%2). -proof. by move=> h;rewrite bits8_W4u16 h. qed. - -lemma bits8_W8u16 ws i : - W8u16.pack8_t ws \bits8 i = if 0 <= i < 16 then ws.[i%/2] \bits8 (i%%2) else W8.zero. -proof. - apply W8.wordP => j hj; rewrite !bits8iE 1,2://. - case: (0 <= i < 16) => /= hi; last by rewrite W128.get_out 1:/#. - rewrite pack8wE 1:/#; have [-> ->] := divmod_mul 2 8 i j _ hj; 1: done; rewrite W2u8.bits8iE 1:// /#. -qed. - -lemma bits8_W8u16_red ws i : - 0 <= i < 16 => W8u16.pack8_t ws \bits8 i = ws.[i%/2] \bits8 (i%%2). -proof. by move=> h;rewrite bits8_W8u16 h. qed. - -lemma bits8_W16u16 ws i : - W16u16.pack16_t ws \bits8 i = if 0 <= i < 32 then ws.[i%/2] \bits8 (i%%2) else W8.zero. -proof. - apply W8.wordP => j hj; rewrite !bits8iE 1,2://. - case: (0 <= i < 32) => /= hi; last by rewrite W256.get_out 1:/#. - rewrite pack16wE 1:/#; have [-> ->] := divmod_mul 2 8 i j _ hj; 1: done; rewrite W2u8.bits8iE 1:// /#. -qed. - -lemma bits8_W16u16_red ws i : - 0 <= i < 32 => W16u16.pack16_t ws \bits8 i = ws.[i%/2] \bits8 (i%%2). -proof. by move=> h;rewrite bits8_W16u16 h. qed. - -hint simplify bits8_W2u16_red, bits8_W4u16_red, bits8_W8u16_red, bits8_W16u16_red. - -lemma bits8_W2u32 ws i : - W2u32.pack2_t ws \bits8 i = if 0 <= i < 8 then ws.[i%/4] \bits8 (i%%4) else W8.zero. -proof. - apply W8.wordP => j hj; rewrite !bits8iE 1,2://. - case: (0 <= i < 8) => /= hi; last by rewrite W64.get_out 1:/#. - rewrite pack2wE 1:/#; have /= [-> ->] := divmod_mul 4 8 i j _ hj; 1: done; rewrite W4u8.bits8iE 1:// /#. -qed. - -lemma bits8_W2u32_red ws i : - 0 <= i < 8 => W2u32.pack2_t ws \bits8 i = ws.[i%/4] \bits8 (i%%4). -proof. by move=> h;rewrite bits8_W2u32 h. qed. - -lemma bits8_W4u32 ws i : - W4u32.pack4_t ws \bits8 i = if 0 <= i < 16 then ws.[i%/4] \bits8 (i%%4) else W8.zero. -proof. - apply W8.wordP => j hj; rewrite !bits8iE 1,2://. - case: (0 <= i < 16) => /= hi; last by rewrite W128.get_out 1:/#. - rewrite pack4wE 1:/#; have /= [-> ->] := divmod_mul 4 8 i j _ hj; 1: done; rewrite W4u8.bits8iE 1:// /#. -qed. - -lemma bits8_W4u32_red ws i : - 0 <= i < 16 => W4u32.pack4_t ws \bits8 i = ws.[i%/4] \bits8 (i%%4). -proof. by move=> h;rewrite bits8_W4u32 h. qed. - -lemma bits8_W8u32 ws i : - W8u32.pack8_t ws \bits8 i = if 0 <= i < 32 then ws.[i%/4] \bits8 (i%%4) else W8.zero. -proof. - apply W8.wordP => j hj; rewrite !bits8iE 1,2://. - case: (0 <= i < 32) => /= hi; last by rewrite W256.get_out 1:/#. - rewrite pack8wE 1:/#; have /= [-> ->] := divmod_mul 4 8 i j _ hj; 1: done; rewrite W4u8.bits8iE 1:// /#. -qed. - -lemma bits8_W8u32_red ws i : - 0 <= i < 32 => W8u32.pack8_t ws \bits8 i = ws.[i%/4] \bits8 (i%%4). -proof. by move=> h;rewrite bits8_W8u32 h. qed. - -hint simplify bits8_W2u32_red, bits8_W4u32_red, bits8_W8u32_red. - -lemma bits8_W2u64 ws i : - W2u64.pack2_t ws \bits8 i = if 0 <= i < 16 then ws.[i%/8] \bits8 (i%%8) else W8.zero. -proof. - apply W8.wordP => j hj; rewrite !bits8iE 1,2://. - case: (0 <= i < 16) => /= hi; last by rewrite W128.get_out 1:/#. - rewrite pack2wE 1:/#; have /= [-> ->] := divmod_mul 8 8 i j _ hj; 1: done; rewrite W8u8.bits8iE 1:// /#. -qed. - -lemma bits8_W2u64_red ws i : - 0 <= i < 16 => W2u64.pack2_t ws \bits8 i = ws.[i%/8] \bits8 (i%%8). -proof. by move=> h;rewrite bits8_W2u64 h. qed. - -lemma bits8_W4u64 ws i : - W4u64.pack4_t ws \bits8 i = if 0 <= i < 32 then ws.[i%/8] \bits8 (i%%8) else W8.zero. -proof. - apply W8.wordP => j hj; rewrite !bits8iE 1,2://. - case: (0 <= i < 32) => /= hi; last by rewrite W256.get_out 1:/#. - rewrite pack4wE 1:/#; have /= [-> ->] := divmod_mul 8 8 i j _ hj; 1: done; rewrite W8u8.bits8iE 1:// /#. -qed. - -lemma bits8_W4u64_red ws i : - 0 <= i < 32 => W4u64.pack4_t ws \bits8 i = ws.[i%/8] \bits8 (i%%8). -proof. by move=> h;rewrite bits8_W4u64 h. qed. - -hint simplify bits8_W2u64_red, bits8_W4u64_red. - -lemma bits8_W2u128 ws i : - W2u128.pack2_t ws \bits8 i = if 0 <= i < 32 then ws.[i%/16] \bits8 (i%%16) else W8.zero. -proof. - apply W8.wordP => j hj; rewrite !bits8iE 1,2://. - case: (0 <= i < 32) => /= hi; last by rewrite W256.get_out 1:/#. - rewrite pack2wE 1:/#; have /= [-> ->] := divmod_mul 16 8 i j _ hj; 1: done; rewrite W16u8.bits8iE 1:// /#. -qed. - -lemma bits8_W2u128_red ws i : - 0 <= i < 32 => W2u128.pack2_t ws \bits8 i = ws.[i%/16] \bits8 (i%%16). -proof. by move=> h;rewrite bits8_W2u128 h. qed. - -hint simplify bits8_W2u128_red. - -lemma W32_bits16_bits8 (w:W32.t) i j: 0 <= j < 2 => w \bits16 i \bits8 j = w \bits8 (2 * i + j). -proof. - move=> hj; apply W8.wordP => k hk. - by rewrite !bits8iE 1,2:// bits16iE 1:/#; congr; ring. -qed. - -lemma W64_bits16_bits8 (w:W64.t) i j: 0 <= j < 2 => w \bits16 i \bits8 j = w \bits8 (2 * i + j). -proof. - move=> hj; apply W8.wordP => k hk. - by rewrite !bits8iE 1,2:// bits16iE 1:/#; congr; ring. -qed. - -lemma W128_bits16_bits8 (w:W128.t) i j: 0 <= j < 2 => w \bits16 i \bits8 j = w \bits8 (2 * i + j). -proof. - move=> hj; apply W8.wordP => k hk. - by rewrite !bits8iE 1,2:// bits16iE 1:/#; congr; ring. -qed. - -lemma W256_bits16_bits8 (w:W256.t) i j: 0 <= j < 2 => w \bits16 i \bits8 j = w \bits8 (2 * i + j). -proof. - move=> hj; apply W8.wordP => k hk. - by rewrite !bits8iE 1,2:// bits16iE 1:/#; congr; ring. -qed. - -hint simplify W32_bits16_bits8, W64_bits16_bits8, W128_bits16_bits8, W256_bits16_bits8. - -lemma W64_bits32_bits8 (w:W64.t) i j: 0 <= j < 4 => w \bits32 i \bits8 j = w \bits8 (4 * i + j). -proof. - move=> hj; apply W8.wordP => k hk. - by rewrite !bits8iE 1,2:// bits32iE 1:/#; congr; ring. -qed. - -lemma W128_bits32_bits8 (w:W128.t) i j: 0 <= j < 4 => w \bits32 i \bits8 j = w \bits8 (4 * i + j). -proof. - move=> hj; apply W8.wordP => k hk. - by rewrite !bits8iE 1,2:// bits32iE 1:/#; congr; ring. -qed. - -lemma W256_bits32_bits8 (w:W256.t) i j: 0 <= j < 4 => w \bits32 i \bits8 j = w \bits8 (4 * i + j). -proof. - move=> hj; apply W8.wordP => k hk. - by rewrite !bits8iE 1,2:// bits32iE 1:/#; congr; ring. -qed. - -hint simplify W64_bits32_bits8, W128_bits32_bits8, W256_bits32_bits8. - -lemma W128_bits64_bits8 (w:W128.t) i j: 0 <= j < 8 => w \bits64 i \bits8 j = w \bits8 (8 * i + j). -proof. - move=> hj; apply W8.wordP => k hk. - by rewrite !bits8iE 1,2:// bits64iE 1:/#; congr; ring. -qed. - -lemma W256_bits64_bits8 (w:W256.t) i j: 0 <= j < 8 => w \bits64 i \bits8 j = w \bits8 (8 * i + j). -proof. - move=> hj; apply W8.wordP => k hk. - by rewrite !bits8iE 1,2:// bits64iE 1:/#; congr; ring. -qed. - -hint simplify W128_bits64_bits8, W256_bits64_bits8. - -lemma W256_bits128_bits8 (w:W256.t) i j: 0 <= j < 16 => w \bits128 i \bits8 j = w \bits8 (16 * i + j). -proof. - move=> hj; apply W8.wordP => k hk. - by rewrite !bits8iE 1,2:// bits128iE 1:/#; congr; ring. -qed. - -hint simplify W256_bits128_bits8. - -(* --------------------------------------------------------------------------------- *) -(* Lemmas on \bits16 *) -(* --------------------------------------------------------------------------------- *) - -lemma bits16_W4u8 ws i : - W4u8.pack4_t ws \bits16 i = if 0 <= i < 2 then W2u8.pack2 [ws.[2 * i]; ws.[2 * i + 1]] else W16.zero. -proof. - apply W2u8.wordP => j hj. - rewrite W32_bits16_bits8 1://. - case: (0 <= i < 2) => hi; last by rewrite W2u8.get_zero W4u8.get_out 1:/#. - rewrite /= W2u8.pack2bE 1:// /= W4u8.pack4bE 1:/#. - by have []-> : j = 0 \/ j = 1 by smt(). -qed. - -lemma bits16_W4u8_red ws i : - 0 <= i < 2 => W4u8.pack4_t ws \bits16 i = W2u8.pack2 [ws.[2 * i]; ws.[2 * i + 1]]. -proof. by move=> h;rewrite bits16_W4u8 h. qed. - -lemma bits16_W8u8 ws i : - W8u8.pack8_t ws \bits16 i = if 0 <= i < 4 then W2u8.pack2 [ws.[2 * i]; ws.[2 * i + 1]] else W16.zero. -proof. - apply W2u8.wordP => j hj. - rewrite W64_bits16_bits8 1://. - case: (0 <= i < 4) => hi; last by rewrite W2u8.get_zero W8u8.get_out 1:/#. - rewrite /= W2u8.pack2bE 1:// /= W8u8.pack8bE 1:/#. - have []-> //: j = 0 \/ j = 1 by smt(). -qed. - -lemma bits16_W8u8_red ws i : - 0 <= i < 4 => W8u8.pack8_t ws \bits16 i = W2u8.pack2 [ws.[2 * i]; ws.[2 * i + 1]]. -proof. by move=> h;rewrite bits16_W8u8 h. qed. - -lemma bits16_W16u8 ws i : - W16u8.pack16_t ws \bits16 i = if 0 <= i < 8 then W2u8.pack2 [ws.[2 * i]; ws.[2 * i + 1]] else W16.zero. -proof. - apply W2u8.wordP => j hj. - rewrite W128_bits16_bits8 1://. - case: (0 <= i < 8) => hi; last by rewrite W2u8.get_zero W16u8.get_out 1:/#. - rewrite /= W2u8.pack2bE 1:// /= W16u8.pack16bE 1:/#. - have []-> //: j = 0 \/ j = 1 by smt(). -qed. - -lemma bits16_W16u8_red ws i : - 0 <= i < 8 => W16u8.pack16_t ws \bits16 i = W2u8.pack2 [ws.[2 * i]; ws.[2 * i + 1]]. -proof. by move=> h;rewrite bits16_W16u8 h. qed. - -lemma bits16_W32u8 ws i : - W32u8.pack32_t ws \bits16 i = if 0 <= i < 16 then W2u8.pack2 [ws.[2 * i]; ws.[2 * i + 1]] else W16.zero. -proof. - apply W2u8.wordP => j hj. - rewrite W256_bits16_bits8 1://. - case: (0 <= i < 16) => hi; last by rewrite W2u8.get_zero W32u8.get_out 1:/#. - rewrite /= W2u8.pack2bE 1:// /= W32u8.pack32bE 1:/#. - have []-> //: j = 0 \/ j = 1 by smt(). -qed. - -lemma bits16_W32u8_red ws i : - 0 <= i < 16 => W32u8.pack32_t ws \bits16 i = W2u8.pack2 [ws.[2 * i]; ws.[2 * i + 1]]. -proof. by move=> h;rewrite bits16_W32u8 h. qed. - -hint simplify bits16_W4u8_red, bits16_W8u8_red, bits16_W16u8_red, bits16_W32u8. - -lemma bits16_W2u32 ws i : - W2u32.pack2_t ws \bits16 i = if 0 <= i < 4 then ws.[i%/2] \bits16 (i%%2) else W16.zero. -proof. - apply W16.wordP => j hj; rewrite !bits16iE 1,2://. - case: (0 <= i < 4) => /= hi; last by rewrite W64.get_out 1:/#. - rewrite pack2wE 1:/#; have /= [-> ->] := divmod_mul 2 16 i j _ hj; 1: done; rewrite W2u16.bits16iE 1:// /#. -qed. - -lemma bits16_W2u32_red ws i : - 0 <= i < 4 => W2u32.pack2_t ws \bits16 i = ws.[i%/2] \bits16 (i%%2). -proof. by move=> h;rewrite bits16_W2u32 h. qed. - -lemma bits16_W4u32 ws i : - W4u32.pack4_t ws \bits16 i = if 0 <= i < 8 then ws.[i%/2] \bits16 (i%%2) else W16.zero. -proof. - apply W16.wordP => j hj; rewrite !bits16iE 1,2://. - case: (0 <= i < 8) => /= hi; last by rewrite W128.get_out 1:/#. - rewrite pack4wE 1:/#; have /= [-> ->] := divmod_mul 2 16 i j _ hj; 1: done; rewrite W2u16.bits16iE 1:// /#. -qed. - -lemma bits16_W4u32_red ws i : - 0 <= i < 8 => W4u32.pack4_t ws \bits16 i = ws.[i%/2] \bits16 (i%%2). -proof. by move=> h;rewrite bits16_W4u32 h. qed. - -lemma bits16_W8u32 ws i : - W8u32.pack8_t ws \bits16 i = if 0 <= i < 16 then ws.[i%/2] \bits16 (i%%2) else W16.zero. -proof. - apply W16.wordP => j hj; rewrite !bits16iE 1,2://. - case: (0 <= i < 16) => /= hi; last by rewrite W256.get_out 1:/#. - rewrite pack8wE 1:/#; have /= [-> ->] := divmod_mul 2 16 i j _ hj; 1: done; rewrite W2u16.bits16iE 1:// /#. -qed. - -lemma bits16_W8u32_red ws i : - 0 <= i < 16 => W8u32.pack8_t ws \bits16 i = ws.[i%/2] \bits16 (i%%2). -proof. by move=> h;rewrite bits16_W8u32 h. qed. - -hint simplify bits16_W2u32_red, bits16_W4u32_red, bits16_W8u32_red. - -lemma bits16_W2u64 ws i : - W2u64.pack2_t ws \bits16 i = if 0 <= i < 8 then ws.[i%/4] \bits16 (i%%4) else W16.zero. -proof. - apply W16.wordP => j hj; rewrite !bits16iE 1,2://. - case: (0 <= i < 8) => /= hi; last by rewrite W128.get_out 1:/#. - rewrite pack2wE 1:/#; have /= [-> ->] := divmod_mul 4 16 i j _ hj; 1: done; rewrite W4u16.bits16iE 1:// /#. -qed. - -lemma bits16_W2u64_red ws i : - 0 <= i < 8 => W2u64.pack2_t ws \bits16 i = ws.[i%/4] \bits16 (i%%4). -proof. by move=> h;rewrite bits16_W2u64 h. qed. - -lemma bits16_W4u64 ws i : - W4u64.pack4_t ws \bits16 i = if 0 <= i < 16 then ws.[i%/4] \bits16 (i%%4) else W16.zero. -proof. - apply W16.wordP => j hj; rewrite !bits16iE 1,2://. - case: (0 <= i < 16) => /= hi; last by rewrite W256.get_out 1:/#. - rewrite pack4wE 1:/#; have /= [-> ->] := divmod_mul 4 16 i j _ hj; 1: done; rewrite W4u16.bits16iE 1:// /#. -qed. - -lemma bits16_W4u64_red ws i : - 0 <= i < 16 => W4u64.pack4_t ws \bits16 i = ws.[i%/4] \bits16 (i%%4). -proof. by move=> h;rewrite bits16_W4u64 h. qed. - -hint simplify bits16_W2u64_red, bits16_W4u64_red. - -lemma bits16_W2u128 ws i : - W2u128.pack2_t ws \bits16 i = if 0 <= i < 16 then ws.[i%/8] \bits16 (i%%8) else W16.zero. -proof. - apply W16.wordP => j hj; rewrite !bits16iE 1,2://. - case: (0 <= i < 16) => /= hi; last by rewrite W256.get_out 1:/#. - rewrite pack2wE 1:/#; have /= [-> ->] := divmod_mul 8 16 i j _ hj; 1: done; rewrite W8u16.bits16iE 1:// /#. -qed. - -lemma bits16_W2u128_red ws i : - 0 <= i < 16 => W2u128.pack2_t ws \bits16 i = ws.[i%/8] \bits16 (i%%8). -proof. by move=> h;rewrite bits16_W2u128 h. qed. - -hint simplify bits16_W2u128_red. - -lemma W64_bits32_bits16 (w:W64.t) i j: 0 <= j < 2 => w \bits32 i \bits16 j = w \bits16 (2 * i + j). -proof. - move=> hj; apply W16.wordP => k hk. - by rewrite !bits16iE 1,2:// bits32iE 1:/#; congr; ring. -qed. - -lemma W128_bits32_bits16 (w:W128.t) i j: 0 <= j < 2 => w \bits32 i \bits16 j = w \bits16 (2 * i + j). -proof. - move=> hj; apply W16.wordP => k hk. - by rewrite !bits16iE 1,2:// bits32iE 1:/#; congr; ring. -qed. - -lemma W256_bits32_bits16 (w:W256.t) i j: 0 <= j < 2 => w \bits32 i \bits16 j = w \bits16 (2 * i + j). -proof. - move=> hj; apply W16.wordP => k hk. - by rewrite !bits16iE 1,2:// bits32iE 1:/#; congr; ring. -qed. - -hint simplify W64_bits32_bits16, W128_bits32_bits16, W256_bits32_bits16. - -lemma W128_bits64_bits16 (w:W128.t) i j: 0 <= j < 4 => w \bits64 i \bits16 j = w \bits16 (4 * i + j). -proof. - move=> hj; apply W16.wordP => k hk. - by rewrite !bits16iE 1,2:// bits64iE 1:/#; congr; ring. -qed. - -lemma W256_bits64_bits16 (w:W256.t) i j: 0 <= j < 4 => w \bits64 i \bits16 j = w \bits16 (4 * i + j). -proof. - move=> hj; apply W16.wordP => k hk. - by rewrite !bits16iE 1,2:// bits64iE 1:/#; congr; ring. -qed. - -lemma W256_bits128_bits16 (w:W256.t) i j: 0 <= j < 8 => w \bits128 i \bits16 j = w \bits16 (8 * i + j). -proof. - move=> hj; apply W16.wordP => k hk. - by rewrite !bits16iE 1,2:// bits128iE 1:/#; congr; ring. -qed. - -hint simplify W128_bits64_bits16, W256_bits64_bits16, W256_bits128_bits16. - -(* --------------------------------------------------------------------------------- *) -(* Lemmas on \bits32 *) -(* --------------------------------------------------------------------------------- *) - -lemma bits32_W8u8 ws i : - W8u8.pack8_t ws \bits32 i = - if 0 <= i < 2 then W4u8.pack4 [ws.[4 * i]; ws.[4 * i + 1]; ws.[4 * i + 2]; ws.[4 * i + 3] ] else W32.zero. -proof. - apply W4u8.wordP => j hj. - rewrite W64_bits32_bits8 1://. - case: (0 <= i < 2) => hi; last by rewrite W4u8.get_zero W8u8.get_out 1:/#. - rewrite /= W4u8.pack4bE 1:// /= W8u8.pack8bE 1:/#. - by have [|[|[|]]]-> : j = 0 \/ j = 1 \/ j = 2 \/ j = 3 by smt(). -qed. - -lemma bits32_W8u8_red ws i : - 0 <= i < 2 => - W8u8.pack8_t ws \bits32 i = - W4u8.pack4 [ws.[4 * i]; ws.[4 * i + 1]; ws.[4 * i + 2]; ws.[4 * i + 3] ]. -proof. by move=> h;rewrite bits32_W8u8 h. qed. - -lemma bits32_W16u8 ws i : - W16u8.pack16_t ws \bits32 i = - if 0 <= i < 4 then W4u8.pack4 [ws.[4 * i]; ws.[4 * i + 1]; ws.[4 * i + 2]; ws.[4 * i + 3] ] else W32.zero. -proof. - apply W4u8.wordP => j hj. - rewrite W128_bits32_bits8 1://. - case: (0 <= i < 4) => hi; last by rewrite W4u8.get_zero W16u8.get_out 1:/#. - rewrite /= W4u8.pack4bE 1:// /= W16u8.pack16bE 1:/#. - by have [|[|[|]]]-> : j = 0 \/ j = 1 \/ j = 2 \/ j = 3 by smt(). -qed. - -lemma bits32_W16u8_red ws i : - 0 <= i < 4 => - W16u8.pack16_t ws \bits32 i = - W4u8.pack4 [ws.[4 * i]; ws.[4 * i + 1]; ws.[4 * i + 2]; ws.[4 * i + 3] ]. -proof. by move=> h;rewrite bits32_W16u8 h. qed. - -lemma bits32_W32u8 ws i : - W32u8.pack32_t ws \bits32 i = - if 0 <= i < 8 then W4u8.pack4 [ws.[4 * i]; ws.[4 * i + 1]; ws.[4 * i + 2]; ws.[4 * i + 3] ] else W32.zero. -proof. - apply W4u8.wordP => j hj. - rewrite W256_bits32_bits8 1://. - case: (0 <= i < 8) => hi; last by rewrite W4u8.get_zero W32u8.get_out 1:/#. - rewrite /= W4u8.pack4bE 1:// /= W32u8.pack32bE 1:/#. - by have [|[|[|]]]-> : j = 0 \/ j = 1 \/ j = 2 \/ j = 3 by smt(). -qed. - -lemma bits32_W32u8_red ws i : - 0 <= i < 8 => - W32u8.pack32_t ws \bits32 i = - W4u8.pack4 [ws.[4 * i]; ws.[4 * i + 1]; ws.[4 * i + 2]; ws.[4 * i + 3] ]. -proof. by move=> h;rewrite bits32_W32u8 h. qed. - -hint simplify bits32_W8u8_red, bits32_W16u8_red, bits32_W32u8_red. - -lemma bits32_W4u16 ws i : - W4u16.pack4_t ws \bits32 i = - if 0 <= i < 2 then W2u16.pack2 [ws.[2 * i]; ws.[2 * i + 1]] else W32.zero. -proof. - apply W2u16.wordP => j hj. - rewrite W64_bits32_bits16 1://. - case: (0 <= i < 2) => hi; last by rewrite W2u16.get_zero W4u16.get_out 1:/#. - rewrite /= W2u16.pack2bE 1:// /= W4u16.pack4bE 1:/#. - by have []-> : j = 0 \/ j = 1 by smt(). -qed. - -lemma bits32_W4u16_red ws i : - 0 <= i < 2 => - W4u16.pack4_t ws \bits32 i = W2u16.pack2 [ws.[2 * i]; ws.[2 * i + 1]]. -proof. by move=> h;rewrite bits32_W4u16 h. qed. - -lemma bits32_W8u16 ws i : - W8u16.pack8_t ws \bits32 i = - if 0 <= i < 4 then W2u16.pack2 [ws.[2 * i]; ws.[2 * i + 1]] else W32.zero. -proof. - apply W2u16.wordP => j hj. - rewrite W128_bits32_bits16 1://. - case: (0 <= i < 4) => hi; last by rewrite W2u16.get_zero W8u16.get_out 1:/#. - rewrite /= W2u16.pack2bE 1:// /= W8u16.pack8bE 1:/#. - by have []-> : j = 0 \/ j = 1 by smt(). -qed. - -lemma bits32_W8u16_red ws i : - 0 <= i < 4 => - W8u16.pack8_t ws \bits32 i = W2u16.pack2 [ws.[2 * i]; ws.[2 * i + 1]]. -proof. by move=> h;rewrite bits32_W8u16 h. qed. - -lemma bits32_W16u16 ws i : - W16u16.pack16_t ws \bits32 i = - if 0 <= i < 8 then W2u16.pack2 [ws.[2 * i]; ws.[2 * i + 1]] else W32.zero. -proof. - apply W2u16.wordP => j hj. - rewrite W256_bits32_bits16 1://. - case: (0 <= i < 8) => hi; last by rewrite W2u16.get_zero W16u16.get_out 1:/#. - rewrite /= W2u16.pack2bE 1:// /= W16u16.pack16bE 1:/#. - by have []-> : j = 0 \/ j = 1 by smt(). -qed. - -lemma bits32_W16u16_red ws i : - 0 <= i < 8 => - W16u16.pack16_t ws \bits32 i = W2u16.pack2 [ws.[2 * i]; ws.[2 * i + 1]]. -proof. by move=> h;rewrite bits32_W16u16 h. qed. - -hint simplify bits32_W4u16_red, bits32_W8u16_red, bits32_W16u16_red. - -lemma bits32_W2u64 ws i : - W2u64.pack2_t ws \bits32 i = if 0 <= i < 4 then ws.[i%/2] \bits32 (i%%2) else W32.zero. -proof. - apply W32.wordP => j hj; rewrite !bits32iE 1,2://. - case: (0 <= i < 4) => /= hi; last by rewrite W128.get_out 1:/#. - rewrite pack2wE 1:/#; have /= [-> ->] := divmod_mul 2 32 i j _ hj; 1: done; rewrite W2u32.bits32iE 1:// /#. -qed. - -lemma bits32_W2u64_red ws i : - 0 <= i < 4 => W2u64.pack2_t ws \bits32 i = ws.[i%/2] \bits32 (i%%2). -proof. by move=> h;rewrite bits32_W2u64 h. qed. - -lemma bits32_W4u64 ws i : - W4u64.pack4_t ws \bits32 i = if 0 <= i < 8 then ws.[i%/2] \bits32 (i%%2) else W32.zero. -proof. - apply W32.wordP => j hj; rewrite !bits32iE 1,2://. - case: (0 <= i < 8) => /= hi; last by rewrite W256.get_out 1:/#. - rewrite pack4wE 1:/#; have /= [-> ->] := divmod_mul 2 32 i j _ hj; 1: done; rewrite W2u32.bits32iE 1:// /#. -qed. - -lemma bits32_W4u64_red ws i : - 0 <= i < 8 => W4u64.pack4_t ws \bits32 i = ws.[i%/2] \bits32 (i%%2). -proof. by move=> h;rewrite bits32_W4u64 h. qed. - -hint simplify bits32_W2u64_red, bits32_W4u64_red. - -lemma bits32_W2u128 ws i : - W2u128.pack2_t ws \bits32 i = if 0 <= i < 8 then ws.[i%/4] \bits32 (i%%4) else W32.zero. -proof. - apply W32.wordP => j hj; rewrite !bits32iE 1,2://. - case: (0 <= i < 8) => /= hi; last by rewrite W256.get_out 1:/#. - rewrite pack2wE 1:/#; have /= [-> ->] := divmod_mul 4 32 i j _ hj; 1: done; rewrite W4u32.bits32iE 1:// /#. -qed. - -lemma bits32_W2u128_red ws i : - 0 <= i < 8 => W2u128.pack2_t ws \bits32 i = ws.[i%/4] \bits32 (i%%4). -proof. by move=> h;rewrite bits32_W2u128 h. qed. - -hint simplify bits32_W2u128_red. - -lemma W128_bits64_bits32 (w:W128.t) i j: 0 <= j < 2 => w \bits64 i \bits32 j = w \bits32 (2 * i + j). -proof. - move=> hj; apply W32.wordP => k hk. - by rewrite !bits32iE 1,2:// bits64iE 1:/#; congr; ring. -qed. - -lemma W256_bits64_bits32 (w:W256.t) i j: 0 <= j < 2 => w \bits64 i \bits32 j = w \bits32 (2 * i + j). -proof. - move=> hj; apply W32.wordP => k hk. - by rewrite !bits32iE 1,2:// bits64iE 1:/#; congr; ring. -qed. - -lemma W256_bits128_bits32 (w:W256.t) i j: 0 <= j < 4 => w \bits128 i \bits32 j = w \bits32 (4 * i + j). -proof. - move=> hj; apply W32.wordP => k hk. - by rewrite !bits32iE 1,2:// bits128iE 1:/#; congr; ring. -qed. - -hint simplify W128_bits64_bits32, W256_bits64_bits32, W256_bits128_bits32. - -(* --------------------------------------------------------------------------------- *) -(* Lemmas on \bits64 *) -(* --------------------------------------------------------------------------------- *) - -lemma bits64_W16u8 ws i : - W16u8.pack16_t ws \bits64 i = - if 0 <= i < 2 then W8u8.pack8 [ws.[8 * i]; ws.[8 * i + 1]; ws.[8 * i + 2]; ws.[8 * i + 3]; - ws.[8 * i + 4]; ws.[8 * i + 5]; ws.[8 * i + 6]; ws.[8 * i + 7]] - else W64.zero. -proof. - apply W8u8.wordP => j hj. - rewrite W128_bits64_bits8 1://. - case: (0 <= i < 2) => hi; last by rewrite W8u8.get_zero W16u8.get_out 1:/#. - rewrite /= W8u8.pack8bE 1:// /= W16u8.pack16bE 1:/#. - by move: hj; rewrite -(mema_iota 0 8) /= => -[|[|[|[|[|[|[|]]]]]]] ->. -qed. - -lemma bits64_W16u8_red ws i : - 0 <= i < 2 => - W16u8.pack16_t ws \bits64 i = - W8u8.pack8 [ws.[8 * i]; ws.[8 * i + 1]; ws.[8 * i + 2]; ws.[8 * i + 3]; - ws.[8 * i + 4]; ws.[8 * i + 5]; ws.[8 * i + 6]; ws.[8 * i + 7]]. -proof. by move=> h;rewrite bits64_W16u8 h. qed. - -lemma bits64_W32u8 ws i : - W32u8.pack32_t ws \bits64 i = - if 0 <= i < 4 then W8u8.pack8 [ws.[8 * i]; ws.[8 * i + 1]; ws.[8 * i + 2]; ws.[8 * i + 3]; - ws.[8 * i + 4]; ws.[8 * i + 5]; ws.[8 * i + 6]; ws.[8 * i + 7]] - else W64.zero. -proof. - apply W8u8.wordP => j hj. - rewrite W256_bits64_bits8 1://. - case: (0 <= i < 4) => hi; last by rewrite W8u8.get_zero W32u8.get_out 1:/#. - rewrite /= W8u8.pack8bE 1:// /= W32u8.pack32bE 1:/#. - by move: hj; rewrite -(mema_iota 0 8) /= => -[|[|[|[|[|[|[|]]]]]]] ->. -qed. - -lemma bits64_W32u8_red ws i : - 0 <= i < 4 => - W32u8.pack32_t ws \bits64 i = - W8u8.pack8 [ws.[8 * i]; ws.[8 * i + 1]; ws.[8 * i + 2]; ws.[8 * i + 3]; - ws.[8 * i + 4]; ws.[8 * i + 5]; ws.[8 * i + 6]; ws.[8 * i + 7]]. -proof. by move=> h;rewrite bits64_W32u8 h. qed. - -hint simplify bits64_W16u8_red, bits64_W32u8_red. - -lemma bits64_W8u16 ws i : - W8u16.pack8_t ws \bits64 i = - if 0 <= i < 2 then W4u16.pack4 [ws.[4 * i]; ws.[4 * i + 1]; ws.[4 * i + 2]; ws.[4 * i + 3] ] else W64.zero. -proof. - apply W4u16.wordP => j hj. - rewrite W128_bits64_bits16 1://. - case: (0 <= i < 2) => hi; last by rewrite W4u16.get_zero W8u16.get_out 1:/#. - rewrite /= W4u16.pack4bE 1:// /= W8u16.pack8bE 1:/#. - by have [|[|[|]]]-> : j = 0 \/ j = 1 \/ j = 2 \/ j = 3 by smt(). -qed. - -lemma bits64_W8u16_red ws i : - 0 <= i < 2 => - W8u16.pack8_t ws \bits64 i = - W4u16.pack4 [ws.[4 * i]; ws.[4 * i + 1]; ws.[4 * i + 2]; ws.[4 * i + 3] ]. -proof. by move=> h;rewrite bits64_W8u16 h. qed. - -lemma bits64_W16u16 ws i : - W16u16.pack16_t ws \bits64 i = - if 0 <= i < 4 then W4u16.pack4 [ws.[4 * i]; ws.[4 * i + 1]; ws.[4 * i + 2]; ws.[4 * i + 3] ] else W64.zero. -proof. - apply W4u16.wordP => j hj. - rewrite W256_bits64_bits16 1://. - case: (0 <= i < 4) => hi; last by rewrite W4u16.get_zero W16u16.get_out 1:/#. - rewrite /= W4u16.pack4bE 1:// /= W16u16.pack16bE 1:/#. - by have [|[|[|]]]-> : j = 0 \/ j = 1 \/ j = 2 \/ j = 3 by smt(). -qed. - -lemma bits64_W16u16_red ws i : - 0 <= i < 4 => - W16u16.pack16_t ws \bits64 i = - W4u16.pack4 [ws.[4 * i]; ws.[4 * i + 1]; ws.[4 * i + 2]; ws.[4 * i + 3] ]. -proof. by move=> h;rewrite bits64_W16u16 h. qed. - -hint simplify bits64_W8u16_red, bits64_W16u16_red. - -lemma bits64_W4u32 ws i : - W4u32.pack4_t ws \bits64 i = - if 0 <= i < 2 then W2u32.pack2 [ws.[2 * i]; ws.[2 * i + 1]] else W64.zero. -proof. - apply W2u32.wordP => j hj. - rewrite W128_bits64_bits32 1://. - case: (0 <= i < 2) => hi; last by rewrite W2u32.get_zero W4u32.get_out 1:/#. - rewrite /= W2u32.pack2bE 1:// /= W4u32.pack4bE 1:/#. - by have [|]-> : j = 0 \/ j = 1 by smt(). -qed. - -lemma bits64_W4u32_red ws i : - 0 <= i < 2 => - W4u32.pack4_t ws \bits64 i = W2u32.pack2 [ws.[2 * i]; ws.[2 * i + 1]]. -proof. by move=> h;rewrite bits64_W4u32 h. qed. - -lemma bits64_W8u32 ws i : - W8u32.pack8_t ws \bits64 i = - if 0 <= i < 4 then W2u32.pack2 [ws.[2 * i]; ws.[2 * i + 1]] else W64.zero. -proof. - apply W2u32.wordP => j hj. - rewrite W256_bits64_bits32 1://. - case: (0 <= i < 4) => hi; last by rewrite W2u32.get_zero W8u32.get_out 1:/#. - rewrite /= W2u32.pack2bE 1:// /= W8u32.pack8bE 1:/#. - have [|]-> //= : j = 0 \/ j = 1 by smt(). -qed. - -lemma bits64_W8u32_red ws i : - 0 <= i < 4 => - W8u32.pack8_t ws \bits64 i = W2u32.pack2 [ws.[2 * i]; ws.[2 * i + 1]]. -proof. by move=> h;rewrite bits64_W8u32 h. qed. - -hint simplify bits64_W4u32_red, bits64_W8u32_red. - -lemma bits64_W2u128 ws i : - W2u128.pack2_t ws \bits64 i = if 0 <= i < 4 then ws.[i%/2] \bits64 (i%%2) else W64.zero. -proof. - apply W64.wordP => j hj; rewrite !bits64iE 1,2://. - case: (0 <= i < 4) => /= hi; last by rewrite W256.get_out 1:/#. - rewrite pack2wE 1:/#; have /= [-> ->] := divmod_mul 2 64 i j _ hj; 1: done; rewrite W2u64.bits64iE 1:// /#. -qed. - -lemma bits64_W2u128_red ws i : - 0 <= i < 4 => W2u128.pack2_t ws \bits64 i = ws.[i%/2] \bits64 (i%%2). -proof. by move=> h;rewrite bits64_W2u128 h. qed. - -hint simplify bits64_W2u128_red. - -lemma W256_bits128_bits64 (w:W256.t) i j: 0 <= j < 2 => w \bits128 i \bits64 j = w \bits64 (2 * i + j). -proof. - move=> hj; apply W64.wordP => k hk. - by rewrite !bits64iE 1,2:// bits128iE 1:/#; congr; ring. -qed. - -hint simplify W256_bits128_bits64. - -(* --------------------------------------------------------------------------------- *) -(* Lemmas on \bits128 *) -(* --------------------------------------------------------------------------------- *) - -lemma bits128_W32u8 ws i : - W32u8.pack32_t ws \bits128 i = - if 0 <= i < 2 then - W16u8.pack16 [ws.[16 * i]; ws.[16 * i + 1]; ws.[16 * i + 2]; ws.[16 * i + 3]; - ws.[16 * i + 4]; ws.[16 * i + 5]; ws.[16 * i + 6]; ws.[16 * i + 7]; - ws.[16 * i + 8]; ws.[16 * i + 9]; ws.[16 * i + 10]; ws.[16 * i + 11]; - ws.[16 * i + 12]; ws.[16 * i + 13]; ws.[16 * i + 14]; ws.[16 * i + 15]] - else W128.zero. -proof. - apply W16u8.wordP => j hj. - rewrite W256_bits128_bits8 1://. - case: (0 <= i < 2) => hi; last by rewrite W16u8.get_zero W32u8.get_out 1:/#. - rewrite /= W32u8.pack32bE 1:/# /= W16u8.pack16bE 1:/#. - by move: hj; rewrite -(mema_iota 0 16) /= => -[|[|[|[|[|[|[|[|[|[|[|[|[|[|[|]]]]]]]]]]]]]]] ->. -qed. - -lemma bits128_W32u8_red ws i : - 0 <= i < 2 => - W32u8.pack32_t ws \bits128 i = - W16u8.pack16 [ws.[16 * i]; ws.[16 * i + 1]; ws.[16 * i + 2]; ws.[16 * i + 3]; - ws.[16 * i + 4]; ws.[16 * i + 5]; ws.[16 * i + 6]; ws.[16 * i + 7]; - ws.[16 * i + 8]; ws.[16 * i + 9]; ws.[16 * i + 10]; ws.[16 * i + 11]; - ws.[16 * i + 12]; ws.[16 * i + 13]; ws.[16 * i + 14]; ws.[16 * i + 15]]. -proof. by move=> hi;rewrite bits128_W32u8 hi. qed. - -lemma bits128_W16u16 ws i : - W16u16.pack16_t ws \bits128 i = - if 0 <= i < 2 then - W8u16.pack8 [ws.[8 * i]; ws.[8 * i + 1]; ws.[8 * i + 2]; ws.[8 * i + 3]; - ws.[8 * i + 4]; ws.[8 * i + 5]; ws.[8 * i + 6]; ws.[8 * i + 7]] - else W128.zero. -proof. - apply W8u16.wordP => j hj. - rewrite W256_bits128_bits16 1://. - case: (0 <= i < 2) => hi; last by rewrite W8u16.get_zero W16u16.get_out 1:/#. - rewrite /= W16u16.pack16bE 1:/# /= W8u16.pack8bE 1:/#. - by move: hj; rewrite -(mema_iota 0 8) /= => -[|[|[|[|[|[|[|]]]]]]] ->. -qed. - -lemma bits128_W16u16_red ws i : - 0 <= i < 2 => - W16u16.pack16_t ws \bits128 i = - W8u16.pack8 [ws.[8 * i]; ws.[8 * i + 1]; ws.[8 * i + 2]; ws.[8 * i + 3]; - ws.[8 * i + 4]; ws.[8 * i + 5]; ws.[8 * i + 6]; ws.[8 * i + 7]]. -proof. by move=> hi;rewrite bits128_W16u16 hi. qed. - -lemma bits128_W8u32 ws i : - W8u32.pack8_t ws \bits128 i = - if 0 <= i < 2 then - W4u32.pack4 [ws.[4 * i]; ws.[4 * i + 1]; ws.[4 * i + 2]; ws.[4 * i + 3]] - else W128.zero. -proof. - apply W4u32.wordP => j hj. - rewrite W256_bits128_bits32 1://. - case: (0 <= i < 2) => hi; last by rewrite W4u32.get_zero W8u32.get_out 1:/#. - rewrite /= W8u32.pack8bE 1:/# /= W4u32.pack4bE 1:/#. - by move: hj; rewrite -(mema_iota 0 4) /= => -[|[|[|]]] ->. -qed. - -lemma bits128_W8u32_red ws i : - 0 <= i < 2 => - W8u32.pack8_t ws \bits128 i = - W4u32.pack4 [ws.[4 * i]; ws.[4 * i + 1]; ws.[4 * i + 2]; ws.[4 * i + 3]]. -proof. by move=> hi;rewrite bits128_W8u32 hi. qed. - -lemma bits128_W4u64 ws i : - W4u64.pack4_t ws \bits128 i = - if 0 <= i < 2 then - W2u64.pack2 [ws.[2 * i]; ws.[2* i + 1]] - else W128.zero. -proof. - apply W2u64.wordP => j hj. - rewrite W256_bits128_bits64 1://. - case: (0 <= i < 2) => hi; last by rewrite W2u64.get_zero W4u64.get_out 1:/#. - rewrite /= W4u64.pack4bE 1:/# /= W2u64.pack2bE 1:// get_of_list 1://. - by move: hj; rewrite -(mema_iota 0 2) /= => -[|] ->. -qed. - -lemma bits128_W4u64_red ws i : - 0 <= i < 2 => - W4u64.pack4_t ws \bits128 i = W2u64.pack2 [ws.[2 * i]; ws.[2* i + 1]]. -proof. by move=> hi;rewrite bits128_W4u64 hi. qed. - -hint simplify bits128_W32u8_red, bits128_W16u16_red, bits128_W8u32_red, bits128_W4u64_red. - -(* --------------------------------------------------------------------------------- *) -(* Lemmas on pack *) -(* --------------------------------------------------------------------------------- *) - -lemma W2u16_W4u8 ws1 ws2 : - pack2 [W2u8.pack2_t ws1; W2u8.pack2_t ws2] = pack4 [ws1.[0]; ws1.[1]; ws2.[0]; ws2.[1]]. -proof. by apply W4u8.allP => /=. qed. - -lemma W4u16_W8u8 ws1 ws2 ws3 ws4 : - pack4 [W2u8.pack2_t ws1; W2u8.pack2_t ws2; W2u8.pack2_t ws3; W2u8.pack2_t ws4] = - pack8 [ws1.[0]; ws1.[1]; ws2.[0]; ws2.[1]; ws3.[0]; ws3.[1]; ws4.[0]; ws4.[1]]. -proof. by apply W8u8.allP => /=. qed. - -lemma W8u16_W16u8 ws1 ws2 ws3 ws4 ws5 ws6 ws7 ws8: - pack8 [W2u8.pack2_t ws1; W2u8.pack2_t ws2; W2u8.pack2_t ws3; W2u8.pack2_t ws4; - W2u8.pack2_t ws5; W2u8.pack2_t ws6; W2u8.pack2_t ws7; W2u8.pack2_t ws8 ] = - pack16 [ws1.[0]; ws1.[1]; ws2.[0]; ws2.[1]; ws3.[0]; ws3.[1]; ws4.[0]; ws4.[1]; - ws5.[0]; ws5.[1]; ws6.[0]; ws6.[1]; ws7.[0]; ws7.[1]; ws8.[0]; ws8.[1]]. -proof. by apply W16u8.allP => /=. qed. - -lemma W16u16_W32u8 ws1 ws2 ws3 ws4 ws5 ws6 ws7 ws8 ws9 ws10 ws11 ws12 ws13 ws14 ws15 ws16: - pack16 [W2u8.pack2_t ws1; W2u8.pack2_t ws2; W2u8.pack2_t ws3; W2u8.pack2_t ws4; - W2u8.pack2_t ws5; W2u8.pack2_t ws6; W2u8.pack2_t ws7; W2u8.pack2_t ws8; - W2u8.pack2_t ws9; W2u8.pack2_t ws10; W2u8.pack2_t ws11; W2u8.pack2_t ws12; - W2u8.pack2_t ws13; W2u8.pack2_t ws14; W2u8.pack2_t ws15; W2u8.pack2_t ws16] = - pack32 [ws1.[0]; ws1.[1]; ws2.[0]; ws2.[1]; ws3.[0]; ws3.[1]; ws4.[0]; ws4.[1]; - ws5.[0]; ws5.[1]; ws6.[0]; ws6.[1]; ws7.[0]; ws7.[1]; ws8.[0]; ws8.[1]; - ws9.[0]; ws9.[1]; ws10.[0]; ws10.[1]; ws11.[0]; ws11.[1]; ws12.[0]; ws12.[1]; - ws13.[0]; ws13.[1]; ws14.[0]; ws14.[1]; ws15.[0]; ws15.[1]; ws16.[0]; ws16.[1]]. -proof. by apply W32u8.allP => /=. qed. - -hint simplify W2u16_W4u8, W4u16_W8u8, W8u16_W16u8, W16u16_W32u8. - -lemma W2u32_W8u8 ws1 ws2 : - pack2 [W4u8.pack4_t ws1; W4u8.pack4_t ws2] = - pack8 [ws1.[0]; ws1.[1]; ws1.[2]; ws1.[3]; ws2.[0]; ws2.[1]; ws2.[2]; ws2.[3]]. -proof. by apply W8u8.allP => /=. qed. - -lemma W4u32_W16u8 ws1 ws2 ws3 ws4 : - pack4 [W4u8.pack4_t ws1; W4u8.pack4_t ws2; W4u8.pack4_t ws3; W4u8.pack4_t ws4] = - pack16 [ws1.[0]; ws1.[1]; ws1.[2]; ws1.[3]; ws2.[0]; ws2.[1]; ws2.[2]; ws2.[3]; - ws3.[0]; ws3.[1]; ws3.[2]; ws3.[3]; ws4.[0]; ws4.[1]; ws4.[2]; ws4.[3]]. -proof. by apply W16u8.allP => /=. qed. - -lemma W8u32_W32u8 ws1 ws2 ws3 ws4 ws5 ws6 ws7 ws8: - pack8 [W4u8.pack4_t ws1; W4u8.pack4_t ws2; W4u8.pack4_t ws3; W4u8.pack4_t ws4; - W4u8.pack4_t ws5; W4u8.pack4_t ws6; W4u8.pack4_t ws7; W4u8.pack4_t ws8 ] = - pack32 [ws1.[0]; ws1.[1]; ws1.[2]; ws1.[3]; ws2.[0]; ws2.[1]; ws2.[2]; ws2.[3]; - ws3.[0]; ws3.[1]; ws3.[2]; ws3.[3]; ws4.[0]; ws4.[1]; ws4.[2]; ws4.[3]; - ws5.[0]; ws5.[1]; ws5.[2]; ws5.[3]; ws6.[0]; ws6.[1]; ws6.[2]; ws6.[3]; - ws7.[0]; ws7.[1]; ws7.[2]; ws7.[3]; ws8.[0]; ws8.[1]; ws8.[2]; ws8.[3]]. -proof. by apply W32u8.allP => /=. qed. - -hint simplify W2u32_W8u8, W4u32_W16u8, W8u32_W32u8. - -lemma W2u64_W16u8 ws1 ws2: - pack2 [W8u8.pack8_t ws1; W8u8.pack8_t ws2] = - pack16 [ws1.[0]; ws1.[1]; ws1.[2]; ws1.[3]; ws1.[4]; ws1.[5]; ws1.[6]; ws1.[7]; - ws2.[0]; ws2.[1]; ws2.[2]; ws2.[3]; ws2.[4]; ws2.[5]; ws2.[6]; ws2.[7]]. -proof. by apply W16u8.allP => /=. qed. - -lemma W4u64_W32u8 ws1 ws2 ws3 ws4: - pack4 [W8u8.pack8_t ws1; W8u8.pack8_t ws2; W8u8.pack8_t ws3; W8u8.pack8_t ws4] = - pack32 [ws1.[0]; ws1.[1]; ws1.[2]; ws1.[3]; ws1.[4]; ws1.[5]; ws1.[6]; ws1.[7]; - ws2.[0]; ws2.[1]; ws2.[2]; ws2.[3]; ws2.[4]; ws2.[5]; ws2.[6]; ws2.[7]; - ws3.[0]; ws3.[1]; ws3.[2]; ws3.[3]; ws3.[4]; ws3.[5]; ws3.[6]; ws3.[7]; - ws4.[0]; ws4.[1]; ws4.[2]; ws4.[3]; ws4.[4]; ws4.[5]; ws4.[6]; ws4.[7]]. -proof. by apply W32u8.allP => /=. qed. - -hint simplify W2u64_W16u8, W4u64_W32u8. - -lemma W2u128_W32u8 ws1 ws2: - pack2 [W16u8.pack16_t ws1; W16u8.pack16_t ws2] = - pack32 [ws1.[0]; ws1.[1]; ws1.[2]; ws1.[3]; ws1.[4]; ws1.[5]; ws1.[6]; ws1.[7]; - ws1.[8]; ws1.[9]; ws1.[10]; ws1.[11]; ws1.[12]; ws1.[13]; ws1.[14]; ws1.[15]; - ws2.[0]; ws2.[1]; ws2.[2]; ws2.[3]; ws2.[4]; ws2.[5]; ws2.[6]; ws2.[7]; - ws2.[8]; ws2.[9]; ws2.[10]; ws2.[11]; ws2.[12]; ws2.[13]; ws2.[14]; ws2.[15]]. -proof. by apply W32u8.allP => /=. qed. - -hint simplify W2u128_W32u8. - -lemma W2u32_W4u16 ws1 ws2 : - pack2 [W2u16.pack2_t ws1; W2u16.pack2_t ws2] = pack4 [ws1.[0]; ws1.[1]; ws2.[0]; ws2.[1]]. -proof. by apply W4u16.allP => /=. qed. - -lemma W4u32_W8u16 ws1 ws2 ws3 ws4 : - pack4 [W2u16.pack2_t ws1; W2u16.pack2_t ws2; W2u16.pack2_t ws3; W2u16.pack2_t ws4] = - pack8 [ws1.[0]; ws1.[1]; ws2.[0]; ws2.[1]; ws3.[0]; ws3.[1]; ws4.[0]; ws4.[1]]. -proof. by apply W8u16.allP => /=. qed. - -lemma W8u32_W16u16 ws1 ws2 ws3 ws4 ws5 ws6 ws7 ws8: - pack8 [W2u16.pack2_t ws1; W2u16.pack2_t ws2; W2u16.pack2_t ws3; W2u16.pack2_t ws4; - W2u16.pack2_t ws5; W2u16.pack2_t ws6; W2u16.pack2_t ws7; W2u16.pack2_t ws8 ] = - pack16 [ws1.[0]; ws1.[1]; ws2.[0]; ws2.[1]; ws3.[0]; ws3.[1]; ws4.[0]; ws4.[1]; - ws5.[0]; ws5.[1]; ws6.[0]; ws6.[1]; ws7.[0]; ws7.[1]; ws8.[0]; ws8.[1]]. -proof. by apply W16u16.allP => /=. qed. - -hint simplify W2u32_W4u16, W4u32_W8u16, W8u32_W16u16. - -lemma W2u64_W8u16 ws1 ws2: - pack2 [W4u16.pack4_t ws1; W4u16.pack4_t ws2] = - pack8 [ws1.[0]; ws1.[1]; ws1.[2]; ws1.[3]; - ws2.[0]; ws2.[1]; ws2.[2]; ws2.[3]]. -proof. by apply W8u16.allP => /=. qed. - -lemma W4u64_W16u16 ws1 ws2 ws3 ws4: - pack4 [W4u16.pack4_t ws1; W4u16.pack4_t ws2; W4u16.pack4_t ws3; W4u16.pack4_t ws4] = - pack16 [ws1.[0]; ws1.[1]; ws1.[2]; ws1.[3]; ws2.[0]; ws2.[1]; ws2.[2]; ws2.[3]; - ws3.[0]; ws3.[1]; ws3.[2]; ws3.[3]; ws4.[0]; ws4.[1]; ws4.[2]; ws4.[3]]. -proof. by apply W16u16.allP => /=. qed. - -hint simplify W2u64_W8u16, W4u64_W16u16. - -lemma W2u64_W4u32 ws1 ws2: - pack2 [W2u32.pack2_t ws1; W2u32.pack2_t ws2] = pack4 [ws1.[0]; ws1.[1]; ws2.[0]; ws2.[1]]. -proof. by apply W4u32.allP => /=. qed. - -lemma W4u64_W8u32 ws1 ws2 ws3 ws4 : - pack4 [W2u32.pack2_t ws1; W2u32.pack2_t ws2; W2u32.pack2_t ws3; W2u32.pack2_t ws4] = - pack8 [ws1.[0]; ws1.[1]; ws2.[0]; ws2.[1]; ws3.[0]; ws3.[1]; ws4.[0]; ws4.[1]]. -proof. by apply W8u32.allP => /=. qed. - -lemma W2u128_W8u32 ws1 ws2 : - pack2 [W4u32.pack4_t ws1; W4u32.pack4_t ws2] = - pack8 [ws1.[0]; ws1.[1]; ws1.[2]; ws1.[3]; ws2.[0]; ws2.[1]; ws2.[2]; ws2.[3]]. -proof. by apply W8u32.allP => /=. qed. - -hint simplify W2u64_W4u32, W4u64_W8u32, W2u128_W8u32. - -lemma W2u128_W4u64 ws1 ws2: - pack2 [W2u64.pack2_t ws1; W2u64.pack2_t ws2] = pack4 [ws1.[0]; ws1.[1]; ws2.[0]; ws2.[1]]. -proof. by apply W4u64.allP => /=. qed. - -hint simplify W2u128_W4u64. \ No newline at end of file diff --git a/proof/impl/JWord_array.ec b/proof/impl/JWord_array.ec deleted file mode 100644 index 0f5782f..0000000 --- a/proof/impl/JWord_array.ec +++ /dev/null @@ -1,263 +0,0 @@ -(* -------------------------------------------------------------------- *) -require import AllCore BitEncoding IntDiv SmtMap List StdOrder BitEncoding Bool. -(*---*) import Ring.IntID IntOrder BS2Int. -require import JUtils JArray JWord. - -abstract theory WArray. - - clone include MonoArray with - type elem <- W8.t, - op dfl <- W8.zero. - - op get8 (t:t) (i:int) : W8.t = t.[i]. - - op get16 (t:t) (i:int) : W16.t = - pack2_t (W2u8.Pack.init (fun j => t.[2*i + j])) - axiomatized by get16E. - - op get32 (t:t) (i:int) : W32.t = - pack4_t (W4u8.Pack.init (fun j => t.[4*i + j])) - axiomatized by get32E. - - op get64 (t:t) (i:int) : W64.t = - pack8_t (W8u8.Pack.init (fun j => t.[8*i + j])) - axiomatized by get64E. - - op get128 (t:t) (i:int) : W128.t = - pack16_t (W16u8.Pack.init (fun j => t.[16*i + j])) - axiomatized by get128E. - - op get256 (t:t) (i:int) : W256.t = - pack32_t (W32u8.Pack.init (fun j => t.[32*i + j])) - axiomatized by get256E. - - op set8 (t:t) (i:int) (w:W8.t) : t = t.[i <- w]. - - op set16 (t:t) (i:int) (w:W16.t) = - init (fun k => if 2*i <= k < 2*(i+1) then w \bits8 (k - 2*i) else t.[k]) - axiomatized by set16E. - - op set32 (t:t) (i:int) (w:W32.t) = - init (fun k => if 4*i <= k < 4*(i+1) then w \bits8 (k - 4*i) else t.[k]) - axiomatized by set32E. - - op set64 (t:t) (i:int) (w:W64.t) = - init (fun k => if 8*i <= k < 8*(i+1) then w \bits8 (k - 8*i) else t.[k]) - axiomatized by set64E. - - op set128 (t:t) (i:int) (w:W128.t) = - init (fun k => if 16*i <= k < 16*(i+1) then w \bits8 (k - 16*i) else t.[k]) - axiomatized by set128E. - - op set256 (t:t) (i:int) (w:W256.t) = - init (fun k => if 32*i <= k < 32*(i+1) then w \bits8 (k - 32*i) else t.[k]) - axiomatized by set256E. - - (* ----------------------------------------------------- *) - - lemma get_set8E t x y w: - 0 <= x < size => - get8 (set8 t x w) y = if y = x then w else get8 t y. - proof. apply get_setE. qed. - - lemma get8_set16E t x y w : - 0 <= x => 2*(x + 1) <= WArray.size => - get8 (set16 t x w) y = if 2*x <= y < 2*(x+1) then w \bits8 (y - 2*x) else get8 t y. - proof. - move=> hx hs; rewrite set16E /get8. - case: (2 * x <= y < 2 * (x + 1)) => hy. - + by rewrite initiE 1:/# /= hy. - case: (0 <= y < WArray.size) => hy1; last by rewrite !get_out. - rewrite initiE //= /#. - qed. - - lemma get_set16E t x y w: - 0 <= x => 2*(x + 1) <= WArray.size => - get16 (set16 t x w) y = if y = x then w else get16 t y. - proof. - move=> hx hs; rewrite set16E !get16E. - case: (y = x) => [-> | hne]. - + rewrite -(W2u8.unpack8K w);congr. - apply W2u8.Pack.ext_eq => k hk; rewrite W2u8.get_unpack8 1:// W2u8.Pack.initiE //= initiE //= /#. - congr; apply W2u8.Pack.init_ext => k hk /=; rewrite initE. - by case: (0 <= 2 * y + k < WArray.size) => [ /# | /get_out ->]. - qed. - - lemma get8_set32E t x y w : - 0 <= x => 4*(x + 1) <= WArray.size => - get8 (set32 t x w) y = if 4*x <= y < 4*(x+1) then w \bits8 (y - 4*x) else get8 t y. - proof. - move=> hx hs; rewrite set32E /get8. - case: (4 * x <= y < 4 * (x + 1)) => hy. - + by rewrite initiE 1:/# /= hy. - case: (0 <= y < WArray.size) => hy1; last by rewrite !get_out. - rewrite initiE //= /#. - qed. - - lemma get_set32E t x y w: - 0 <= x => 4*(x + 1) <= WArray.size => - get32 (set32 t x w) y = if y = x then w else get32 t y. - proof. - move=> hx hs; rewrite set32E !get32E. - case: (y = x) => [-> | hne]. - + rewrite -(W4u8.unpack8K w);congr. - apply W4u8.Pack.ext_eq => k hk; rewrite W4u8.get_unpack8 //= W4u8.Pack.initiE //= initiE /#. - congr; apply W4u8.Pack.init_ext => k hk /=; rewrite initE. - by case: (0 <= 4 * y + k < WArray.size) => [ /# | /get_out ->]. - qed. - - lemma get8_set64E t x y w : - 0 <= x => 8*(x + 1) <= WArray.size => - get8 (set64 t x w) y = if 8*x <= y < 8*(x+1) then w \bits8 (y - 8*x) else get8 t y. - proof. - move=> hx hs; rewrite set64E /get8. - case: (8 * x <= y < 8 * (x + 1)) => hy. - + by rewrite initiE 1:/# /= hy. - case: (0 <= y < WArray.size) => hy1; last by rewrite !get_out. - rewrite initiE //= /#. - qed. - - lemma get_set64E t x y w: - 0 <= x => 8*(x + 1) <= WArray.size => - get64 (set64 t x w) y = if y = x then w else get64 t y. - proof. - move=> hx hs; rewrite set64E !get64E. - case: (y = x) => [-> | hne]. - + rewrite -(W8u8.unpack8K w);congr. - apply W8u8.Pack.ext_eq => k hk; rewrite W8u8.get_unpack8 //= W8u8.Pack.initiE //= initiE /#. - congr; apply W8u8.Pack.init_ext => k hk /=; rewrite initE. - by case: (0 <= 8 * y + k < WArray.size) => [ /# | /get_out ->]. - qed. - - lemma get8_set128E t x y w : - 0 <= x => 16*(x + 1) <= WArray.size => - get8 (set128 t x w) y = if 16*x <= y < 16*(x+1) then w \bits8 (y - 16*x) else get8 t y. - proof. - move=> hx hs; rewrite set128E /get8. - case: (16 * x <= y < 16 * (x + 1)) => hy. - + by rewrite initiE 1:/# /= hy. - case: (0 <= y < WArray.size) => hy1; last by rewrite !get_out. - rewrite initiE //= /#. - qed. - - lemma get_set128E t x y w: - 0 <= x => 16*(x + 1) <= WArray.size => - get128 (set128 t x w) y = if y = x then w else get128 t y. - proof. - move=> hx hs; rewrite set128E !get128E. - case: (y = x) => [-> | hne]. - + rewrite -(W16u8.unpack8K w);congr. - apply W16u8.Pack.ext_eq => k hk; rewrite W16u8.get_unpack8 //= W16u8.Pack.initiE //= initiE /#. - congr; apply W16u8.Pack.init_ext => k hk /=; rewrite initE. - by case: (0 <= 16 * y + k < WArray.size) => [ /# | /get_out ->]. - qed. - - lemma get8_set256E t x y w : - 0 <= x => 32*(x + 1) <= WArray.size => - get8 (set256 t x w) y = if 32*x <= y < 32*(x+1) then w \bits8 (y - 32*x) else get8 t y. - proof. - move=> hx hs; rewrite set256E /get8. - case: (32 * x <= y < 32 * (x + 1)) => hy. - + by rewrite initiE 1:/# /= hy. - case: (0 <= y < WArray.size) => hy1; last by rewrite !get_out. - rewrite initiE //= /#. - qed. - - lemma get_set256E t x y w: - 0 <= x => 32*(x + 1) <= WArray.size => - get256 (set256 t x w) y = if y = x then w else get256 t y. - proof. - move=> hx hs; rewrite set256E !get256E. - case: (y = x) => [-> | hne]. - + rewrite -(W32u8.unpack8K w);congr. - apply W32u8.Pack.ext_eq => k hk; rewrite W32u8.get_unpack8 //= W32u8.Pack.initiE //= initiE /#. - congr; apply W32u8.Pack.init_ext => k hk /=; rewrite initE. - by case: (0 <= 32 * y + k < WArray.size) => [ /# | /get_out ->]. - qed. - - hint simplify get_set8E, get8_set16E, get_set16E, - get8_set32E, get_set32E, - get8_set64E, get_set64E, - get8_set128E, get_set128E, - get8_set256E, get_set256E. - - (* ------------------------------------------------- *) - - op init8 (f:int -> W8.t) = - init f. - - op init16 (f:int -> W16.t) = - init (fun i => f (i %/ 2) \bits8 (i%%2)). - - op init32 (f:int -> W32.t) = - init (fun i => f (i %/ 4) \bits8 (i%%4)). - - op init64 (f:int -> W64.t) = - init (fun i => f (i %/ 8) \bits8 (i%%8)). - - op init128 (f:int -> W128.t) = - init (fun i => f (i %/ 16) \bits8 (i%%16)). - - op init256 (f:int -> W256.t) = - init (fun i => f (i %/ 32) \bits8 (i%%32)). - -end WArray. - -(*clone export WArray as WArray0 with op size <- 0. -clone export WArray as WArray1 with op size <- 1. -clone export WArray as WArray2 with op size <- 2. -clone export WArray as WArray3 with op size <- 3. -clone export WArray as WArray4 with op size <- 4. -clone export WArray as WArray5 with op size <- 5. -clone export WArray as WArray6 with op size <- 6. -clone export WArray as WArray7 with op size <- 7. -clone export WArray as WArray8 with op size <- 8. -clone export WArray as WArray9 with op size <- 9. - -clone export WArray as WArray10 with op size <- 10. -clone export WArray as WArray11 with op size <- 11. -clone export WArray as WArray12 with op size <- 12. -clone export WArray as WArray13 with op size <- 13. -clone export WArray as WArray14 with op size <- 14. -clone export WArray as WArray15 with op size <- 15. -clone export WArray as WArray16 with op size <- 16. -clone export WArray as WArray17 with op size <- 17. -clone export WArray as WArray18 with op size <- 18. -clone export WArray as WArray19 with op size <- 19. - -clone export WArray as WArray20 with op size <- 20. -clone export WArray as WArray21 with op size <- 21. -clone export WArray as WArray22 with op size <- 22. -clone export WArray as WArray23 with op size <- 23. -clone export WArray as WArray24 with op size <- 24. -clone export WArray as WArray25 with op size <- 25. -clone export WArray as WArray26 with op size <- 26. -clone export WArray as WArray27 with op size <- 27. -clone export WArray as WArray28 with op size <- 28. -clone export WArray as WArray29 with op size <- 29. - -clone export WArray as WArray30 with op size <- 30. -clone export WArray as WArray31 with op size <- 31. -clone export WArray as WArray32 with op size <- 32. -clone export WArray as WArray33 with op size <- 33. -clone export WArray as WArray34 with op size <- 34. -clone export WArray as WArray35 with op size <- 35. -clone export WArray as WArray36 with op size <- 36. -clone export WArray as WArray37 with op size <- 37. -clone export WArray as WArray38 with op size <- 38. -clone export WArray as WArray39 with op size <- 39. - -clone export WArray as WArray40 with op size <- 40. -clone export WArray as WArray41 with op size <- 41. -clone export WArray as WArray42 with op size <- 42. -clone export WArray as WArray43 with op size <- 43. -clone export WArray as WArray44 with op size <- 44. -clone export WArray as WArray45 with op size <- 45. -clone export WArray as WArray46 with op size <- 46. -clone export WArray as WArray47 with op size <- 47. -clone export WArray as WArray48 with op size <- 48. -clone export WArray as WArray49 with op size <- 49. -*) - - - \ No newline at end of file diff --git a/proof/impl/Spec.ec b/proof/impl/Spec.ec index 003787c..ff51f66 100644 --- a/proof/impl/Spec.ec +++ b/proof/impl/Spec.ec @@ -1,5 +1,5 @@ require import AllCore List Int IntDiv. -require import JArray JMemory JModel JUtils JWord JWord_array. +from Jasmin require import JArray JMemory JModel JUtils JWord JWord_array. require import Sponge. import Common. import Block. From 2b6f1eb0f7de4715b949a4c5414c4430e9e15aa1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Thu, 11 Apr 2019 18:30:08 +0000 Subject: [PATCH 344/525] Update .gitlab-ci.yml --- .gitlab-ci.yml | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 1a69a6f..c5e30ee 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -6,14 +6,13 @@ services: before_script: - docker info - docker pull easycryptpa/ec-test-box:kms -- git clone -b array_cast https://github.com/jasmin-lang/jasmin sha3: only: - master script: - >- docker run -v $PWD:/home/ci/sha3 easycryptpa/ec-test-box:kms - sh -c 'cd sha3 && ECARGS="-I Jasmin:/home/ci/sha3/jasmin/eclib" opam config exec -- make check-xunit' + sh -c 'cd sha3 && git clone -b array_cast https://github.com/jasmin-lang/jasmin && ECARGS="-I Jasmin:/home/ci/sha3/jasmin/eclib" opam config exec -- make check-xunit' artifacts: when: on_failure paths: From d3f2496712a012b1820a017f95a89a56c8f8abcb Mon Sep 17 00:00:00 2001 From: Manuel Barbosa Date: Fri, 12 Apr 2019 10:55:52 +0300 Subject: [PATCH 345/525] Added suffix, removed libraries: --- proof/impl/JArray.ec | 569 --------- proof/impl/JMemory.ec | 411 ------- proof/impl/JModel.ec | 322 ----- proof/impl/JUtils.ec | 280 ----- proof/impl/JWord.ec | 2432 ------------------------------------- proof/impl/JWord_array.ec | 263 ---- proof/impl/Spec.ec | 18 +- 7 files changed, 12 insertions(+), 4283 deletions(-) delete mode 100644 proof/impl/JArray.ec delete mode 100644 proof/impl/JMemory.ec delete mode 100644 proof/impl/JModel.ec delete mode 100644 proof/impl/JUtils.ec delete mode 100644 proof/impl/JWord.ec delete mode 100644 proof/impl/JWord_array.ec diff --git a/proof/impl/JArray.ec b/proof/impl/JArray.ec deleted file mode 100644 index 27cfe5f..0000000 --- a/proof/impl/JArray.ec +++ /dev/null @@ -1,569 +0,0 @@ -require import AllCore SmtMap List. -(*---*) import CoreMap. -require import JUtils. - -(*-------------------------------------------------------------------- *) - -abstract theory MonoArray. - - type elem. - op dfl : elem. - - op size: int. - - axiom ge0_size : 0 <= size. - - type t. - - op "_.[_]" : t -> int -> elem. - - op init : (int -> elem) -> t. - - axiom get_out (t:t) i : !(0 <= i < size) => t.[i] = dfl. - - axiom initE (f:int -> elem) i : - (init f).[i] = if 0 <= i < size then f i else dfl. - - axiom ext_eq (t1 t2: t) : - (forall x, 0 <= x < size => t1.[x] = t2.[x]) => - t1 = t2. - - lemma tP (t1 t2: t) : - t1 = t2 <=> forall i, 0 <= i < size => t1.[i] = t2.[i]. - proof. by move=> />;apply ext_eq. qed. - - lemma init_ext (f1 f2: int -> elem): - (forall x, 0 <= x < size => f1 x = f2 x) => - init f1 = init f2. - proof. by move=> h;apply ext_eq => i hi;rewrite !initE hi h. qed. - - (* -------------------------------------------------------------------- *) - lemma initiE (f:int -> elem) i : 0 <= i < size => (init f).[i] = f i. - proof. by move=> hi;rewrite initE hi. qed. - - hint simplify initiE. - (* -------------------------------------------------------------------- *) - op "_.[_<-_]" (t:t) (i:int) (e:elem) = - init (fun j => if j = i then e else t.[j]) - axiomatized by setE. - - lemma get_set_if (t:t) (i j :int) (a:elem) : - t.[i <- a].[j] = if 0 <= i < size /\ j = i then a else t.[j]. - proof. - rewrite setE initE /=; smt (get_out). - qed. - - lemma get_setE (t:t) (x y:int) (a:elem) : - 0 <= x < size => t.[x<-a].[y] = if y = x then a else t.[y]. - proof. by move=> hx;rewrite get_set_if hx. qed. - - lemma nosmt set_eqiE (t : t) x y a : - 0 <= x < size => y = x => t.[x <- a].[y] = a. - proof. by move=> h1 ->;rewrite get_setE. qed. - - lemma nosmt set_neqiE (t : t) x y a : - 0 <= x < size => y <> x => t.[x <- a].[y] = t.[y]. - proof. by move=> h1; rewrite get_setE // => ->. qed. - - hint simplify (set_eqiE, set_neqiE). - - lemma set_out (i : int) (e : elem) (t : t): - ! (0 <= i < size) => t.[i <- e] = t. - proof. - by move=> hi; apply ext_eq => j hj; rewrite get_set_if hi. - qed. - - lemma set_neg (i : int) (e : elem) (t : t): - i < 0 => t.[i<- e] = t. - proof. move=> hi;apply set_out => /#. qed. - - lemma set_above (i : int) (e : elem) (t : t): - size <= i => t.[i <- e] = t. - proof. move=> hi;apply set_out => /#. qed. - - lemma set_set_if (t : t) (k k' : int) (x x' : elem): - t.[k <- x].[k' <- x'] - = if k = k' - then t.[k' <- x'] - else t.[k' <- x'].[k <- x]. - proof. - apply ext_eq => i hi;case (k = k') => [<<- | neqk];rewrite !get_set_if /#. - qed. - - lemma set_set_eq (t : t) (k : int) (x x' : elem): - t.[k <- x].[k <- x'] = t.[k <- x']. - proof. by rewrite set_set_if. qed. - - lemma set_set_eq_s (t : t) (k1 k2 : int) (x x' : elem): - k1 = k2 => t.[k1 <- x].[k2 <- x'] = t.[k2 <- x']. - proof. move=> ->; apply set_set_eq. qed. - - hint simplify (set_set_eq_s, set_out). - - lemma set_set_swap (t : t) (k k' : int) (x x' : elem): - k <> k' => t.[k <- x].[k' <- x'] = t.[k' <- x'].[k <- x]. - proof. by rewrite set_set_if => ->. qed. - - lemma set_notmod (t:t) i : t.[i <- t.[i]] = t. - proof. - by apply ext_eq => j hj; rewrite get_set_if; case: (0 <= i < size /\ j = i). - qed. - - (* -------------------------------------------------------------------- *) - op of_list (l:elem list) = - init (fun i => nth dfl l i) - axiomatized by of_listE. - - op to_list (t:t) = - mkseq (fun i => t.[i]) size. - - lemma to_listE (t:t) : to_list t = map (fun i => t.[i]) (iota_ 0 size). - proof. done. qed. - - lemma size_to_list (t:t): size (to_list t) = size. - proof. rewrite /to_listE size_mkseq /max; smt (ge0_size). qed. - - lemma get_of_list (l:elem list) i : 0 <= i < size => - (of_list l).[i] = nth dfl l i. - proof. by move=> hi;rewrite of_listE initiE. qed. - - lemma get_to_list (t : t) i : nth dfl (to_list t) i = t.[i]. - proof. - rewrite nth_mkseq_if; case:(0 <= i < size) => hi //. - rewrite get_out //. - qed. - - lemma of_listK (l : elem list) : size l = size => - to_list (of_list l) = l. - proof. - move=> h; apply (eq_from_nth dfl); 1:by rewrite size_to_list h. - move=> i; rewrite size_to_list => hi. - by rewrite get_to_list // get_of_list. - qed. - - lemma to_listK : cancel to_list of_list. - proof. - move=> t; apply ext_eq => i hi. - by rewrite get_of_list // get_to_list. - qed. - - lemma to_list_inj : injective to_list. - proof. by apply/(can_inj _ _ to_listK). qed. - - hint simplify (get_of_list, get_to_list)@0. - hint simplify to_listK@0. - hint simplify to_listE@1. - - lemma init_of_list f : init f = of_list (map f (iota_ 0 size)). - proof. - apply tP => i hi;rewrite get_of_list // (nth_map 0) 1:size_iota 1:/#. - by rewrite nth_iota // initiE. - qed. - - (* hint simplify init_of_list@1. *) - - (* -------------------------------------------------------------------- *) - op create (a:elem) = init (fun (i:int) => a). - - lemma createiE (a:elem) i : 0 <= i < size => (create a).[i] = a. - proof. by apply initiE. qed. - - lemma createL (a:elem) : create a = of_list (map (fun i => a) (iota_ 0 size)). - proof. by rewrite /create init_of_list. qed. - - hint simplify (createiE, createL). - - (* -------------------------------------------------------------------- *) - op map (f: elem -> elem) (t:t) : t = - init (fun i => f t.[i]) - axiomatized by mapE. - - lemma mapiE f t i : 0 <= i < size => (map f t).[i] = f t.[i]. - proof. by rewrite mapE;apply initiE. qed. - - lemma map_of_list f ws : - map f (of_list ws) = of_list (mapN f dfl ws size). - proof. - by apply tP => i hi; rewrite mapiE // !get_of_list // nth_mapN. - qed. - - lemma map_to_list f t : - map f t = of_list (map f (to_list t)). - proof. by rewrite to_listE mapE /= -map_comp // init_of_list. qed. - - hint simplify (mapiE, map_of_list)@0. -(* hint simplify map_to_list@1. *) - - (* -------------------------------------------------------------------- *) - op map2 (f: elem -> elem -> elem) (t1 t2:t) : t = - init (fun i => f t1.[i] t2.[i]) - axiomatized by map2E. - - lemma map2iE f t1 t2 i : 0 <= i < size => (map2 f t1 t2).[i] = f t1.[i] t2.[i]. - proof. by rewrite map2E;apply initiE. qed. - - lemma map2_of_list f ws1 ws2 : - map2 f (of_list ws1) (of_list ws2) = of_list (mapN2 f dfl dfl ws1 ws2 size). - proof. - by apply tP => i hi; rewrite map2iE // !get_of_list // nth_mapN2. - qed. - - lemma map2_to_list f t1 t2 : - map2 f t1 t2 = of_list (map2 f (to_list t1) (to_list t2)). - proof. - rewrite to_listE map2E map2_zip init_of_list /=;congr. - apply (eq_from_nth dfl). - + by rewrite !size_map size_zip !size_map min_ler. - move=> i; rewrite size_map => hi. - rewrite (nth_map 0) 1:// (nth_map (dfl,dfl)). - + by rewrite size_zip min_ler !size_map. - by rewrite /= nth_zip ?size_map // !(nth_map 0). - qed. - - hint simplify (map2iE, map2_of_list)@0. -(* hint simplify (map2_to_list)@1. *) - - (* -------------------------------------------------------------------- *) - op all_eq (t1 t2: t) = - all (fun x => t1.[x] = t2.[x]) (iota_ 0 size). - - lemma all_eq_eq (t1 t2: t) : all_eq t1 t2 => t1 = t2. - proof. - by move=> /allP h; apply ext_eq => x /mem_range; apply h. - qed. - - lemma all_eqP (t1 t2: t) : all_eq t1 t2 <=> t1 = t2. - proof. - split; 1:by apply all_eq_eq. - by move=> ->;apply /allP. - qed. - - (* -------------------------------------------------------------------- *) - op fill (f : int -> elem) (k len : int) (t : t) = - init (fun i => if k <= i < k + len then f i else t.[i]) - axiomatized by fillE. - - lemma filliE (f : int -> elem) (k len:int) (t : t) i : 0 <= i < size => - (fill f k len t).[i] = if k <= i < k + len then f i else t.[i]. - proof. by move=> hi;rewrite fillE initiE. qed. - - hint simplify filliE. - - (* -------------------------------------------------------------------- *) - op sub (t: t) k len = mkseq (fun (i:int) => t.[k+i]) len. - - lemma size_sub t k len : 0 <= len => size (sub t k len) = len. - proof. move=> hl; rewrite size_mkseq /max /#. qed. - - lemma nth_sub (t : t) k len i : 0 <= i < len => - nth dfl (sub t k len) i = t.[k + i]. - proof. by move=> h0i; rewrite nth_mkseq. qed. - -end MonoArray. - -abstract theory PolyArray. - - op size: int. - - axiom ge0_size : 0 <= size. - - type 'a t. - - op "_.[_]" : 'a t -> int -> 'a. - - op init : (int -> 'a) -> 'a t. - - axiom get_out (t:'a t) i : !(0 <= i < size) => t.[i] = witness. - - axiom initE (f:int -> 'a) i : - (init f).[i] = if 0 <= i < size then f i else witness. - - axiom ext_eq (t1 t2: 'a t) : - (forall x, 0 <= x < size => t1.[x] = t2.[x]) => - t1 = t2. - - lemma tP (t1 t2: 'a t) : - t1 = t2 <=> forall i, 0 <= i < size => t1.[i] = t2.[i]. - proof. by move=> />;apply ext_eq. qed. - - (* -------------------------------------------------------------------- *) - lemma initiE (f:int -> 'a) i : 0 <= i < size => (init f).[i] = f i. - proof. by move=> hi;rewrite initE hi. qed. - - hint simplify initiE. - - (* -------------------------------------------------------------------- *) - op "_.[_<-_]" (t:'a t) (i:int) (e:'a) = - init (fun j => if j = i then e else t.[j]) - axiomatized by setE. - - lemma get_set_if (t:'a t) (i j :int) (a:'a) : - t.[i <- a].[j] = if 0 <= i < size /\ j = i then a else t.[j]. - proof. - rewrite setE initE /=; smt (get_out). - qed. - - lemma get_setE (t:'a t) (x y:int) (a:'a) : - 0 <= x < size => t.[x<-a].[y] = if y = x then a else t.[y]. - proof. by move=> hx; rewrite get_set_if hx. qed. - - lemma nosmt set_eqiE (t : 'a t) x y a : - 0 <= x < size => y = x => t.[x <- a].[y] = a. - proof. by move=> h1 ->;rewrite get_setE. qed. - - lemma nosmt set_neqiE (t : 'a t) x y a : - 0 <= x < size => y <> x => t.[x <- a].[y] = t.[y]. - proof. by move=> h1; rewrite get_setE // => ->. qed. - - hint simplify (set_eqiE, set_neqiE). - - lemma set_out (i : int) (e : 'a) (t : 'a t): - ! (0 <= i < size) => t.[i <- e] = t. - proof. - by move=> hi; apply ext_eq => j hj; rewrite get_set_if hi. - qed. - - lemma set_neg (i : int) (e : 'a) (t : 'a t): - i < 0 => t.[i<- e] = t. - proof. move=> hi;apply set_out => /#. qed. - - lemma set_above (i : int) (e : 'a) (t : 'a t): - size <= i => t.[i <- e] = t. - proof. move=> hi;apply set_out => /#. qed. - - lemma set_set_if (t : 'a t) (k k' : int) (x x' : 'a): - t.[k <- x].[k' <- x'] - = if k = k' - then t.[k' <- x'] - else t.[k' <- x'].[k <- x]. - proof. - apply ext_eq => i hi;case (k = k') => [<<- | neqk];rewrite !get_set_if /#. - qed. - - lemma set_set_eq (t : 'a t) (k : int) (x x' : 'a): - t.[k <- x].[k <- x'] = t.[k <- x']. - proof. by rewrite set_set_if. qed. - - lemma set_set_eq_s (t : 'a t) (k1 k2 : int) (x x' : 'a): - k1 = k2 => t.[k1 <- x].[k2 <- x'] = t.[k2 <- x']. - proof. move=> ->; apply set_set_eq. qed. - - hint simplify (set_set_eq_s, set_out). - - lemma set_set_swap (t : 'a t) (k k' : int) (x x' : 'a): - k <> k' => t.[k <- x].[k' <- x'] = t.[k' <- x'].[k <- x]. - proof. by rewrite set_set_if => ->. qed. - - lemma set_notmod (t:'a t) i : t.[i <- t.[i]] = t. - proof. - by apply ext_eq => j hj; rewrite get_set_if; case: (0 <= i < size /\ j = i). - qed. - - (* -------------------------------------------------------------------- *) - op create (a:'a) = init (fun (i:int) => a) - axiomatized by createE. - - lemma createiE (a:'a) i : 0 <= i < size => (create a).[i] = a. - proof. by rewrite createE;apply initiE. qed. - - hint simplify createiE. - - (* -------------------------------------------------------------------- *) - op map ['a, 'b] (f: 'a -> 'b) (t:'a t) : 'b t = - init (fun i => f t.[i]) - axiomatized by mapE. - - lemma mapiE ['a, 'b] (f: 'a -> 'b) t i : 0 <= i < size => (map f t).[i] = f t.[i]. - proof. by rewrite mapE;apply initiE. qed. - - hint simplify mapiE. - - (* -------------------------------------------------------------------- *) - op map2 ['a, 'b, 'c] (f: 'a -> 'b -> 'c) t1 t2 = - init (fun i => f t1.[i] t2.[i]) - axiomatized by map2E. - - lemma map2iE ['a, 'b, 'c] (f: 'a -> 'b -> 'c) t1 t2 i : 0 <= i < size => - (map2 f t1 t2).[i] = f t1.[i] t2.[i]. - proof. by rewrite map2E;apply initiE. qed. - - hint simplify map2iE. - - (* -------------------------------------------------------------------- *) - op all_eq (t1 t2: 'a t) = - all (fun x => t1.[x] = t2.[x]) (iota_ 0 size). - - lemma ext_eq_all (t1 t2: 'a t) : - all_eq t1 t2 <=> t1 = t2. - proof. - split. - + by move=> /allP h; apply ext_eq => x /mem_range; apply h. - by move=> ->;apply /allP. - qed. - - lemma all_eq_eq (t1 t2: 'a t) : all_eq t1 t2 => t1 = t2. - proof. by move=> /ext_eq_all. qed. - - (* -------------------------------------------------------------------- *) - - op of_list (dfl:'a) (l:'a list) = - init (fun i => nth dfl l i). - - op to_list (t:'a t) = - mkseq (fun i => t.[i]) size. - - lemma size_to_list (t:'a t): size (to_list t) = size. - proof. rewrite size_mkseq /max; smt (ge0_size). qed. - - lemma get_of_list (dfl:'a) (l:'a list) i : 0 <= i < size => - (of_list dfl l).[i] = nth dfl l i. - proof. by move=> hi;rewrite /of_list initiE. qed. - - hint simplify get_of_list. - - lemma get_to_list (t : 'a t) i : - nth witness (to_list t) i = t.[i]. - proof. - rewrite nth_mkseq_if; case:(0 <= i < size) => hi //. - rewrite get_out //. - qed. - - hint simplify (get_of_list, get_to_list). - - lemma of_listK (dfl:'a) (l : 'a list) : size l = size => - to_list (of_list dfl l) = l. - proof. - move=> h; apply (eq_from_nth witness); 1:by rewrite size_to_list h. - move=> i; rewrite size_to_list => hi. - rewrite get_to_list // get_of_list //. - by rewrite nth_onth (onth_nth witness) // h. - qed. - - lemma to_listK (dfl:'a) : cancel to_list (of_list dfl). - proof. - move=> t; apply ext_eq => i hi. - by rewrite get_of_list // nth_onth (onth_nth witness) ?size_to_list //= - get_to_list. - qed. - - lemma to_list_inj ['a] : injective (to_list<:'a>). - proof. by apply/(can_inj _ _ (to_listK witness)). qed. - - (* The following rules are for reduction *) - lemma map_of_list ['a, 'b] (f:'a -> 'b) dfa ws : - map f (of_list dfa ws) = of_list (f dfa) (map f ws). - proof. - apply tP => i hi; rewrite mapiE // !get_of_list //. - case (i < size ws) => isws. - + by rewrite (nth_map dfa) // /#. - by rewrite nth_out 1:/# nth_out // size_map 1:/#. - qed. - - lemma map2_of_list (f:'a -> 'b -> 'c) df1 df2 ws1 ws2 : - map2 f (of_list df1 ws1) (of_list df2 ws2) = - of_list (f df1 df2) (mapN2 f df1 df2 ws1 ws2 size). - proof. - by apply tP => i hi; rewrite map2iE // !get_of_list // nth_mapN2. - qed. - - hint simplify (map_of_list, map2_of_list)@0. - - (* -------------------------------------------------------------------- *) - op fill (f : int -> 'a) (k len : int) (t : 'a t) = - init (fun i => if k <= i < k + len then f i else t.[i]) - axiomatized by fillE. - - lemma filliE (f : int -> 'a) (k len:int) (t : 'a t) i : 0 <= i < size => - (fill f k len t).[i] = if k <= i < k + len then f i else t.[i]. - proof. by move=> hi;rewrite fillE initiE. qed. - - hint simplify filliE. - - (* -------------------------------------------------------------------- *) - op sub (t: 'a t) k len = mkseq (fun (i:int) => t.[k+i]) len. - - lemma size_sub (t:'a t) k len : 0 <= len => size (sub t k len) = len. - proof. move=> hl; rewrite size_mkseq /max /#. qed. - - lemma nth_sub (dfl:'a) (t : 'a t) k len i : 0 <= i < len => - nth dfl (sub t k len) i = t.[k + i]. - proof. by move=> h0i; rewrite nth_mkseq. qed. - - - (* -------------------------------------------------------------------- *) - op all (f : 'a -> bool) (t : 'a t) = - all (fun i => f t.[i]) (iota_ 0 size). - - lemma allP (t: 'a t) f : all f t <=> (forall i, 0 <= i < size => f t.[i]). - proof. - rewrite /all (allP);split => h i /=. - + by move=> hi;apply h;rewrite mem_iota //; case: hi. - by rewrite mem_iota /= => h1; apply h;case h1. - qed. - - (* -------------------------------------------------------------------- *) - op is_init (t: 'a option t) = all is_init t. - - lemma is_init_Some (t:'a t) : is_init (map Some t). - proof. by rewrite allP => i hi; rewrite mapiE. qed. - - hint simplify is_init_Some. - -end PolyArray. - -(*clone export PolyArray as Array0 with op size <- 0. -clone export PolyArray as Array1 with op size <- 1. -clone export PolyArray as Array2 with op size <- 2. -clone export PolyArray as Array3 with op size <- 3. -clone export PolyArray as Array4 with op size <- 4. -clone export PolyArray as Array5 with op size <- 5. -clone export PolyArray as Array6 with op size <- 6. -clone export PolyArray as Array7 with op size <- 7. -clone export PolyArray as Array8 with op size <- 8. -clone export PolyArray as Array9 with op size <- 9. - -clone export PolyArray as Array10 with op size <- 10. -clone export PolyArray as Array11 with op size <- 11. -clone export PolyArray as Array12 with op size <- 12. -clone export PolyArray as Array13 with op size <- 13. -clone export PolyArray as Array14 with op size <- 14. -clone export PolyArray as Array15 with op size <- 15. -clone export PolyArray as Array16 with op size <- 16. -clone export PolyArray as Array17 with op size <- 17. -clone export PolyArray as Array18 with op size <- 18. -clone export PolyArray as Array19 with op size <- 19. - -clone export PolyArray as Array20 with op size <- 20. -clone export PolyArray as Array21 with op size <- 21. -clone export PolyArray as Array22 with op size <- 22. -clone export PolyArray as Array23 with op size <- 23. -clone export PolyArray as Array24 with op size <- 24. -clone export PolyArray as Array25 with op size <- 25. -clone export PolyArray as Array26 with op size <- 26. -clone export PolyArray as Array27 with op size <- 27. -clone export PolyArray as Array28 with op size <- 28. -clone export PolyArray as Array29 with op size <- 29. - -clone export PolyArray as Array30 with op size <- 30. -clone export PolyArray as Array31 with op size <- 31. -clone export PolyArray as Array32 with op size <- 32. -clone export PolyArray as Array33 with op size <- 33. -clone export PolyArray as Array34 with op size <- 34. -clone export PolyArray as Array35 with op size <- 35. -clone export PolyArray as Array36 with op size <- 36. -clone export PolyArray as Array37 with op size <- 37. -clone export PolyArray as Array38 with op size <- 38. -clone export PolyArray as Array39 with op size <- 39. - -clone export PolyArray as Array40 with op size <- 40. -clone export PolyArray as Array41 with op size <- 41. -clone export PolyArray as Array42 with op size <- 42. -clone export PolyArray as Array43 with op size <- 43. -clone export PolyArray as Array44 with op size <- 44. -clone export PolyArray as Array45 with op size <- 45. -clone export PolyArray as Array46 with op size <- 46. -clone export PolyArray as Array47 with op size <- 47. -clone export PolyArray as Array48 with op size <- 48. -clone export PolyArray as Array49 with op size <- 49. *) - - diff --git a/proof/impl/JMemory.ec b/proof/impl/JMemory.ec deleted file mode 100644 index 80c9f4b..0000000 --- a/proof/impl/JMemory.ec +++ /dev/null @@ -1,411 +0,0 @@ -(* -------------------------------------------------------------------- *) -require import AllCore SmtMap List IntDiv. -(*---*) import CoreMap StdOrder.IntOrder. -require import JUtils JWord. - -(* -------------------------------------------------------------------- *) -theory W8List. - abbrev "_.[_]" (w : W8.t list) (i : int) = nth (W8.of_int 0) w i. -end W8List. -export W8List. - -(* -------------------------------------------------------------------- *) -type address = int. - -type global_mem_t. - -op "_.[_]" : global_mem_t -> address -> W8.t. -op "_.[_<-_]" : global_mem_t -> address -> W8.t -> global_mem_t. - -axiom mem_eq_ext (m1 m2:global_mem_t) : (forall j, m1.[j] = m2.[j]) => m1 = m2. - -axiom get_setE m x y w : - m.[x <- w].[y] = if y = x then w else m.[y]. - -lemma get_set_eqE_s m x y w : - y = x => m.[x <- w].[y] = w. -proof. by rewrite get_setE => ->. qed. - -lemma get_set_neqE_s m x y w : - y <> x => m.[x <- w].[y] = m.[y]. -proof. by rewrite get_setE => ->. qed. - -hint simplify (get_set_eqE_s, get_set_neqE_s). - -op allocated8 : global_mem_t -> address -> bool. - -axiom allocated8_setE y w m x: allocated8 m.[y<-w] x = allocated8 m x. - -(* ------------------------------------------------------------------- *) - -op stores (m : global_mem_t) (a : address) (w : W8.t list) = - foldl (fun (m:global_mem_t) i => m.[a + i <- w.[i]]) m (iota_ 0 (size w)). - -lemma foldl_in_eq (f1 f2:'a -> 'b -> 'a) (s:'b list) a : - (forall a b, b \in s => f1 a b = f2 a b) => foldl f1 a s = foldl f2 a s. -proof. - elim: s a => [ | b s hrec] a //= hin. - by rewrite hin // hrec // => ?? h;apply hin;rewrite h. -qed. - -lemma stores_cons m a w ws : stores m a (w::ws) = stores (m.[a <- w]) (a + 1) ws. -proof. - rewrite /stores /= iota_add 1:// 1:List.size_ge0. - rewrite foldl_cat (addzC 0 1) iota_addl /=. - rewrite -(revK (iota_ 0 (size ws))) map_rev !foldl_rev foldr_map /=. - rewrite -!foldl_rev !revK;apply foldl_in_eq => m0 i /mem_iota /= h /#. -qed. - -lemma allocated8_stores ws a m x : allocated8 (stores m a ws) x = allocated8 m x. -proof. - elim: ws m a => //= w ws hrec m a. - by rewrite stores_cons hrec allocated8_setE. -qed. - -lemma get_storesE m p l j: (stores m p l).[j] = if p <= j < p + size l then nth W8.zero l (j - p) else m.[j]. -proof. - elim: l m p => [ | w l hrec] m p. - + by rewrite /stores /= /#. - rewrite stores_cons hrec /= get_setE. smt (size_ge0). -qed. - -(* ------------------------------------------------------------------- *) -op loadW8 (m : global_mem_t) (a : address) = m.[a]. - -op loadW16 (m : global_mem_t) (a : address) = - pack2_t (W2u8.Pack.init (fun i => m.[a + i])). - -op loadW32 (m : global_mem_t) (a : address) = - pack4_t (W4u8.Pack.init (fun i => m.[a + i])). - -op loadW64 (m : global_mem_t) (a : address) = - pack8_t (W8u8.Pack.init (fun i => m.[a + i])). - -op loadW128 (m : global_mem_t) (a : address) = - pack16_t (W16u8.Pack.init (fun i => m.[a + i])). - -op loadW256 (m : global_mem_t) (a : address) = - pack32_t (W32u8.Pack.init (fun i => m.[a + i])). - -lemma loadW32_bits8 m p i : 0 <= i < 4 => - loadW32 m p \bits8 i = loadW8 m (p + i). -proof. by move=> hi;rewrite /loadW32 pack4bE // initiE. qed. - -lemma loadW128_bits8 m p i : 0 <= i < 16 => - loadW128 m p \bits8 i = loadW8 m (p + i). -proof. by move=> hi;rewrite /loadW128 pack16bE // initiE. qed. - -lemma loadW128_bits32 m p i : 0 <= i < 4 => - loadW128 m p \bits32 i = loadW32 m (p + i * 4). -proof. - move=> hi; rewrite /loadW128 /loadW32. - apply W32.wordP => j hj. - rewrite bits32iE // pack4wE // initiE; 1:by apply divz_cmp. - rewrite pack16wE; 1:by apply W4u32.in_bound. - rewrite initiE /=; 1:by apply divz_cmp => //=;apply W4u32.in_bound. - have -> : i * 32 = (i * 4) * 8 by ring. - by rewrite modzMDl divzMDl // -addzA. -qed. - -lemma load4u8 mem p : - pack4 - [loadW8 mem p; - loadW8 mem (p + 1); - loadW8 mem (p + 2); - loadW8 mem (p + 3)] = - loadW32 mem p. -proof. - have -> : W4u8.Pack.of_list - [loadW8 mem p; loadW8 mem (p + 1); - loadW8 mem (p + 2); loadW8 mem (p + 3)] = - W4u8.Pack.init (fun i => loadW8 mem (p + i)). - + by apply W4u8.Pack.all_eqP; rewrite /all_eq. - apply (can_inj _ _ W4u8.unpack8K); apply W4u8.Pack.packP => i hi. - by rewrite pack4K initiE. -qed. - -lemma load4u32 mem p : - pack4 - [loadW32 mem p; - loadW32 mem (p + 4); - loadW32 mem (p + 8); - loadW32 mem (p + 12)] = - loadW128 mem p. -proof. - have -> : W4u32.Pack.of_list - [loadW32 mem p; loadW32 mem (p + 4); - loadW32 mem (p + 8); loadW32 mem (p + 12)] = - W4u32.Pack.init (fun i => loadW32 mem (p + i * 4)). - + by apply W4u32.Pack.all_eqP; rewrite /all_eq. - apply (can_inj _ _ W4u32.unpack32K); apply W4u32.Pack.packP => i hi. - by rewrite pack4K initiE //= get_unpack32 // loadW128_bits32. -qed. - -(* ------------------------------------------------------------------- *) -op storeW8 (m : global_mem_t) (a : address) (w : W8.t) = - m.[a <- w] -axiomatized by storeW8E. - -op storeW16 (m : global_mem_t) (a : address) (w : W16.t) = - stores m a (to_list (unpack8 w)) -axiomatized by storeW16E. - -op storeW32 (m : global_mem_t) (a : address) (w : W32.t) = - stores m a (to_list (unpack8 w)) -axiomatized by storeW32E. - -op storeW64 (m : global_mem_t) (a : address) (w : W64.t) = - stores m a (to_list (unpack8 w)) -axiomatized by storeW64E. - -op storeW128 (m : global_mem_t) (a : address) (w : W128.t) = - stores m a (to_list (unpack8 w)) -axiomatized by storeW128E. - -op storeW256 (m : global_mem_t) (a : address) (w : W256.t) = - stores m a (to_list (unpack8 w)) -axiomatized by storeW256E. - -lemma pack4u32_bits8_nth i (ws:W32.t list) : 0 <= i < 16 => - W4u32.pack4 ws \bits8 i = nth W32.zero ws (i %/ 4) \bits8 (i%%4). -proof. - move=> hi; rewrite -W4u32.Pack.get_of_list; first by apply divz_cmp. - move: (W4u32.Pack.of_list ws) => w. - apply W8.wordP => k hk. - rewrite -W4u32.pack4bE; 1: by apply divz_cmp. - rewrite bits8iE // bits8iE // bits32iE; 1: smt(modz_cmp). - congr; rewrite {1}(divz_eq i 4); ring. -qed. - -lemma store4u32 mem ptr w0 w1 w2 w3 : - storeW128 mem ptr (W4u32.pack4 [w0; w1; w2; w3]) = - storeW32 - (storeW32 - (storeW32 - (storeW32 mem ptr w0) - (ptr + 4) w1) - (ptr + 8) w2) - (ptr + 12) w3. -proof. - rewrite storeW128E !storeW32E. - by rewrite /W4u8.Pack.to_list /mkseq /= /stores /=. -qed. - -lemma store4u8 mem ptr w0 w1 w2 w3 : - storeW32 mem ptr (W4u8.pack4 [w0; w1; w2; w3]) = - storeW8 - (storeW8 - (storeW8 - (storeW8 mem ptr w0) - (ptr + 1) w1) - (ptr + 2) w2) - (ptr + 3) w3. -proof. by rewrite storeW32E !storeW8E. qed. - -lemma get_storeW32E m p (w:W32.t) j : - (storeW32 m p w).[j] = if p <= j < p + 4 then w \bits8 (j - p) else m.[j]. -proof. rewrite storeW32E /= get_storesE /= /#. qed. - -(* ------------------------------------------------------------------- *) -(* Global Memory *) - -module Glob = { - var mem : global_mem_t -}. - -(* ------------------------------------------------------------------- *) -(* Safety *) - -op is_align (ws:wsize) (a:address) = - wsize_i ws %| a. - -op allocated (m:global_mem_t) (p:address) (N:int) : bool = - forall i, 0 <= i < N => allocated8 m (p + i). - -op is_valid (m:global_mem_t) (a:address) (ws:wsize) = - allocated m a (wsize_i ws) /\ is_align ws a -axiomatized by is_validE. - -op valid_range (w:wsize) (mem:global_mem_t) (ptr:address) (len:int) = - forall i, 0 <= i < len => is_valid mem (ptr + wsize_i w * i) w. - -(* ------------------------------------------------------------------- *) - -lemma is_align_le w2 w1 ptr: - wsize_i w1 <= wsize_i w2 => is_align w2 ptr => is_align w1 ptr. -proof. - by rewrite /is_align => hw; apply dvdz_trans; apply div_le_wsize. -qed. - -lemma is_align_add w ptr ofs: - wsize_i w %| ofs => is_align w ptr => is_align w (ptr + ofs). -proof. - by rewrite /is_align => h1 h2; apply dvdzD. -qed. - -(* ------------------------------------------------------------------- *) - -lemma allocated_stores a1 s mem a2 N: allocated (stores mem a1 s) a2 N = allocated mem a2 N. -proof. - rewrite /allocated /= eq_iff;split => h i hi. - + by rewrite -(allocated8_stores s a1) h. - by rewrite allocated8_stores h. -qed. - -lemma allocate_le m p (N1 N2:int) : - N1 <= N2 => - allocated m p N2 => allocated m p N1. -proof. rewrite /allocated => hle h i hi;apply h => /#. qed. - -(* ------------------------------------------------------------------- *) - -lemma valid_range_le (len1 len2:int) w mem ptr : - len1 <= len2 => - valid_range w mem ptr len2 => - valid_range w mem ptr len1. -proof. by move=> hle hv i hlt; apply hv => /#. qed. - -lemma is_valid_valid_range w1 w2 mem ptr : - wsize_i w1 <= wsize_i w2 => - is_valid mem ptr w2 => - valid_range w1 mem ptr (wsize_i w2 %/ wsize_i w1). -proof. - rewrite /valid_range is_validE => hw [ha hia] i hi. - rewrite is_validE is_align_add /=. - + by apply modzMr. - + by apply: is_align_le hia. - move=> k hk /=;rewrite -addzA;apply ha;split;[smt (gt0_wsize_i)|move=> ?]. - apply: (ltr_le_trans ((i + 1) * wsize_i w1)); 1: smt (). - rewrite (divz_eq (wsize_i w2) (wsize_i w1)). - smt (modz_cmp gt0_wsize_i). -qed. - -lemma valid_range_size_le w1 w2 mem ptr len : - wsize_i w1 <= wsize_i w2 => - valid_range w2 mem ptr len => - valid_range w1 mem ptr (len * (wsize_i w2 %/ wsize_i w1)). -proof. - rewrite /valid_range => hw hv i hi. - pose dw := wsize_i w2 %/ wsize_i w1. - have gt0_dw : 0 < dw. - + by apply ltz_divRL => //; apply div_le_wsize. - have := hv (i %/ dw) _. - + apply divz_cmp => //. - move=> /(is_valid_valid_range _ _ _ _ hw) /(_ (i %% dw) _) /=. - + by apply modz_cmp. - have <- := divzK _ _ (div_le_wsize _ _ hw); rewrite -/dw. - have -> : ptr + dw * wsize_i w1 * (i %/ dw) + wsize_i w1 * (i %% dw) = - ptr + wsize_i w1 * ((i %/ dw) * dw + i %% dw) by ring. - by rewrite -divz_eq. -qed. - -lemma valid_range_is_valid w1 w2 mem ptr : - wsize_i w1 <= wsize_i w2 => - is_align w2 ptr => - valid_range w1 mem ptr (wsize_i w2 %/ wsize_i w1) => - is_valid mem ptr w2. -proof. - move=> hw hia hr; rewrite is_validE. - pose dw := wsize_i w2 %/ wsize_i w1. - have gt0_dw : 0 < dw. - + by apply ltz_divRL => //; apply div_le_wsize. - split;last by (have := hr 0 _). - move=> i hi. - have := hr (i %/ wsize_i w1) _. - + split; 1: by apply divz_ge0;[ apply gt0_wsize_i | case hi]. - move=> ?;apply ltz_divRL => //; 1: by apply div_le_wsize. - by have := divz_eq i (wsize_i w1); have := modz_cmp i (wsize_i w1) _ => // /#. - rewrite is_validE; move => [] /(_ (i%%wsize_i w1) _); 1: by apply modz_cmp. - by rewrite mulzC -addzA -divz_eq. -qed. - -lemma valid_range_size_ge w1 w2 mem ptr len1 len2 : - is_align w2 ptr => - wsize_i w1 <= wsize_i w2 => - (wsize_i w2 %/ wsize_i w1) * len2 <= len1 => - valid_range w1 mem ptr len1 => - valid_range w2 mem ptr len2. -proof. - move=> hia hw hl hv. - have {hv} hv:= valid_range_le _ _ _ _ _ hl hv. - move=> i hi; apply (valid_range_is_valid w1) => //. - + by apply is_align_add => //; apply modzMr. - move=> k hk /=. - have gt0_dw : 0 < wsize_i w2 %/ wsize_i w1. - + by apply ltz_divRL => //; apply div_le_wsize. - have := hv ((wsize_i w2 %/ wsize_i w1) * i + k) _. - + split. smt(). - move=> ?;apply (ltr_le_trans (wsize_i w2 %/ wsize_i w1 * (i + 1))). - + smt(). - by apply ler_wpmul2l;[apply ltzW | smt()]. - rewrite Ring.IntID.mulrDr -mulzA (mulzC(wsize_i w1)) divzK ?addzA //. - by apply div_le_wsize. -qed. - -lemma valid_range_add (k:int) w mem ptr len : - 0 <= k <= len => - valid_range w mem ptr len => - valid_range w mem (ptr + k * wsize_i w) (len - k). -proof. - move=> hk hv i hi /=. - have -> : ptr + k * wsize_i w + wsize_i w * i = ptr + wsize_i w * (k + i) by ring. - apply hv => /#. -qed. - -lemma valid_range_add_split p n w mem ptr : - 0 <= p <= n => - valid_range w mem ptr n => - valid_range w mem ptr p /\ - valid_range w mem (ptr + p * wsize_i w) (n - p). -proof. - move=> hp hv; split. - + by apply: valid_range_le hv;case hp. - by apply valid_range_add. -qed. - -(* ------------------------------------------------------------------- *) - -lemma is_valid_store8 mem sz ptr1 ptr2 w : - is_valid (storeW8 mem ptr2 w) ptr1 sz = is_valid mem ptr1 sz. -proof. - rewrite !is_validE storeW8E /allocated;congr. - rewrite eq_iff;split => h i hi. - + by rewrite -(allocated8_setE ptr2 w) h. - by rewrite allocated8_setE h. -qed. -hint simplify is_valid_store8. - -lemma is_valid_store16 mem sz ptr1 ptr2 w : - is_valid (storeW16 mem ptr2 w) ptr1 sz = is_valid mem ptr1 sz. -proof. - by rewrite !is_validE storeW16E allocated_stores. -qed. -hint simplify is_valid_store16. - -lemma is_valid_store32 mem sz ptr1 ptr2 w : - is_valid (storeW32 mem ptr2 w) ptr1 sz = is_valid mem ptr1 sz. -proof. - by rewrite !is_validE storeW32E allocated_stores. -qed. -hint simplify is_valid_store32. - -lemma is_valid_store64 mem sz ptr1 ptr2 w : - is_valid (storeW64 mem ptr2 w) ptr1 sz = is_valid mem ptr1 sz. -proof. - by rewrite !is_validE storeW64E allocated_stores. -qed. -hint simplify is_valid_store64. - -lemma is_valid_store128 mem sz ptr1 ptr2 w : - is_valid (storeW128 mem ptr2 w) ptr1 sz = is_valid mem ptr1 sz. -proof. - by rewrite !is_validE storeW128E allocated_stores. -qed. -hint simplify is_valid_store128. - -lemma is_valid_store256 mem sz ptr1 ptr2 w : - is_valid (storeW256 mem ptr2 w) ptr1 sz = is_valid mem ptr1 sz. -proof. - by rewrite !is_validE storeW256E allocated_stores. -qed. -hint simplify is_valid_store256. diff --git a/proof/impl/JModel.ec b/proof/impl/JModel.ec deleted file mode 100644 index 8d0d652..0000000 --- a/proof/impl/JModel.ec +++ /dev/null @@ -1,322 +0,0 @@ -(* -------------------------------------------------------------------- *) -require import AllCore BitEncoding IntDiv SmtMap Ring List StdOrder Bool. -(*---*) import CoreMap Map Ring.IntID IntOrder. -require export JUtils JArray JWord JWord_array JMemory. - -(* -------------------------------------------------------------------- *) -abbrev x86_MOVD_32 (x : W32.t) = pack4 [x; W32.zero; W32.zero; W32.zero]. - -op x86_ROL_32 (x : W32.t) (cnt : W8.t) = - let result = W32.rol x (to_uint cnt) in - let CF = result.[0] in - let OF = Logic.(^) CF result.[31] in - (CF, OF, result) - axiomatized by x86_ROL_32_E. - -(* -------------------------------------------------------------------- *) -op x86_SHLD_32 : - W32.t -> W32.t -> W8.t -> (bool * bool * bool * bool * bool * W32.t). - -op x86_SHRD_32 : - W32.t -> W32.t -> W8.t -> (bool * bool * bool * bool * bool * W32.t). - -op x86_SHLD_64 : - W64.t -> W64.t -> W8.t -> (bool * bool * bool * bool * bool * W64.t). - -op x86_SHRD_64 : - W64.t -> W64.t -> W8.t -> (bool * bool * bool * bool * bool * W64.t). - -(* -------------------------------------------------------------------- *) - -op x86_VPSHUFB_128_B (w:W128.t) (m : W8.t) = - let i = W8.to_uint m in - if 128 <= i then W8.zero - else w \bits8 (i %% 16). - -op x86_VPSHUFB_128 (w m : W128.t) : W128.t = - map (x86_VPSHUFB_128_B w) m. - -op x86_VPSHUFB_256 (w m : W256.t) : W256.t = - map2 x86_VPSHUFB_128 w m. - -hint simplify (W16u8.of_int_bits8_div). -hint simplify (W8.of_uintK)@1. -hint simplify W32.get_out@0. - -abbrev [-printing] const_rotate8_128 = (W128.of_int 18676936380593224926704134051422339075). -abbrev [-printing] const_rotate16_128 = (W128.of_int 17342576855639742879858139805557719810). -abbrev [-printing] const_rotate24_128 = (W128.of_int 16028905388486802350658220295983399425). - -lemma rotate8_128_E w : - x86_VPSHUFB_128 w const_rotate8_128 = W4u32.map (fun w => W32.rol w 8) w. -proof. - have h : W128.all_eq - (x86_VPSHUFB_128 w const_rotate8_128) (W4u32.map (fun w => W32.rol w 8) w). - + by cbv W128.all_eq x86_VPSHUFB_128 x86_VPSHUFB_128_B W16u8.unpack8 edivz. - by apply (W128.all_eq_eq _ _ h). -qed. - -lemma rotate16_128_E w : - x86_VPSHUFB_128 w const_rotate16_128 = W4u32.map (fun w => W32.rol w 16) w. -proof. - have h : W128.all_eq - (x86_VPSHUFB_128 w const_rotate16_128) (W4u32.map (fun w => W32.rol w 16) w). - + by cbv W128.all_eq x86_VPSHUFB_128 x86_VPSHUFB_128_B W16u8.unpack8. - by apply (W128.all_eq_eq _ _ h). -qed. - -lemma rotate24_128_E w : - (x86_VPSHUFB_128 w const_rotate24_128) = W4u32.map (fun w => W32.rol w 24) w. -proof. - have h : W128.all_eq - (x86_VPSHUFB_128 w const_rotate24_128) (W4u32.map (fun w => W32.rol w 24) w). - + by cbv W128.all_eq x86_VPSHUFB_128 x86_VPSHUFB_128_B W16u8.unpack8 edivz. - by apply (W128.all_eq_eq _ _ h). -qed. -hint simplify (rotate8_128_E, rotate16_128_E, rotate24_128_E). - -abbrev [-printing] const_rotate8_256 = - W256.of_int 6355432118420048154175784972596847518577147054203239762089463134348153782275. - -abbrev [-printing] const_rotate16_256 = - W256.of_int 5901373100945378232718128989223044758631764214521116316503579100742837863170. - -abbrev [-printing] const_rotate24_256 = - W256.of_int 5454353864746073763129182254217446065883741921538078285974850505695092212225. - -(*lemma pack8u32_bits128 ws i : 0 <= i < 2 => - W8u32.pack8_t ws \bits128 i = pack4 [ws.[4*i];ws.[4*i+1];ws.[4*i+2];ws.[4*i+3] ]. -proof. - move=> /(mema_iota 0 2 i); move: i; apply /List.allP => /=. - by split; apply W128.all_eq_eq;cbv delta. -qed. *) - -lemma pack2_4u32_8u32 (w0 w1 w2 w3 w4 w5 w6 w7 :W32.t) : - pack2 [pack4 [w0;w1;w2;w3]; pack4 [w4; w5; w6; w7]] = - pack8 [w0; w1; w2; w3; w4; w5; w6; w7]. -proof. by apply W256.all_eq_eq;cbv W256.all_eq edivz. qed. - -lemma rotate8_256_E w : - x86_VPSHUFB_256 w const_rotate8_256 = W8u32.map (fun w => W32.rol w 8) w. -proof. -admitted. -(* - rewrite -(W8u32.unpack32K w) /unpack32 /= /x86_VPSHUFB_256 -{1}pack2_4u32_8u32. - rewrite -(W2u128.unpack128K const_rotate8_256) /unpack128 /=. - rewrite !W2u128.of_int_bits128_div 1,2://. - rewrite -W128.of_int_mod; cbv edivz. - by rewrite pack2_4u32_8u32. -qed. -*) -lemma rotate16_256_E w : - x86_VPSHUFB_256 w const_rotate16_256 = W8u32.map (fun w => W32.rol w 16) w. -proof. -admitted. -(* - rewrite -(W8u32.unpack32K w) /unpack32 /= /x86_VPSHUFB_256 -{1}pack2_4u32_8u32. - rewrite -(W2u128.unpack128K const_rotate16_256) /unpack128 /=. - rewrite !W2u128.of_int_bits128_div 1,2://. - rewrite -W128.of_int_mod; cbv edivz. - by rewrite pack2_4u32_8u32. -qed. -*) -lemma rotate24_256_E w : - x86_VPSHUFB_256 w const_rotate24_256 = W8u32.map (fun w => W32.rol w 24) w. -proof. -admitted. -(* - rewrite -(W8u32.unpack32K w) /unpack32 /= /x86_VPSHUFB_256 -{1}pack2_4u32_8u32. - rewrite -(W2u128.unpack128K const_rotate24_256) /unpack128 /=. - rewrite !W2u128.of_int_bits128_div 1,2://. - rewrite -W128.of_int_mod; cbv edivz. - by rewrite pack2_4u32_8u32. -qed. -*) -hint simplify (rotate8_256_E, rotate16_256_E, rotate24_256_E). - -(* -------------------------------------------------------------------- *) -op x86_VPSHUFD_128_B (w : W128.t) (m : W8.t) (i : int) : W32.t = - let m = W8.to_uint m in - let p = (m %/ (2^(2*i)))%%4 in - w \bits32 p. - -op x86_VPSHUFD_128 (w : W128.t) (m : W8.t) : W128.t = - pack4 (map (x86_VPSHUFD_128_B w m) (iota_ 0 4)). - -op x86_VPSHUFD_256 (w : W256.t) (m : W8.t) : W256.t = - map (fun w => x86_VPSHUFD_128 w m) w. - -(* -------------------------------------------------------------------- *) -abbrev [-printing] x86_VPBROADCASTI_2u128 = x86_VPBROADCAST_2u128. - -(* -------------------------------------------------------------------- *) -abbrev [-printing] subc_8 = W8.subc. -abbrev [-printing] addc_8 = W8.addc. -abbrev [-printing] mulu_8 = W8.mulu. - -abbrev [-printing] subc_16 = W16.subc. -abbrev [-printing] addc_16 = W16.addc. -abbrev [-printing] mulu_16 = W16.mulu. - -abbrev [-printing] subc_32 = W32.subc. -abbrev [-printing] addc_32 = W32.addc. -abbrev [-printing] mulu_32 = W32.mulu. - -abbrev [-printing] subc_64 = W64.subc. -abbrev [-printing] addc_64 = W64.addc. -abbrev [-printing] mulu_64 = W64.mulu. - -op mulu64 (w1 w2 : W64.t) = - (W2u32.zeroextu64 (W2u32.truncateu32 w1)) * - (W2u32.zeroextu64 (W2u32.truncateu32 w2)). - -(* -------------------------------------------------------------------- *) - -(* FIXME it is really the semantics? In particular the last if *) -op x86_VPEXTR_64 (w:W128.t) (i:W8.t) = - if W8.to_uint i = 0 then (w \bits64 0) - else if W8.to_uint i = 1 then (w \bits64 1) - else W64.of_int 0. - -op x86_MOVD_64 (v:W64.t) = - pack2 [v; W64.zero]. - -op x86_VPINSR_2u64 (v1:W128.t) (v2:W64.t) (i:W8.t) = - let i = W8.to_uint i %% 2 in - pack2 (map (fun j => if j = i then v2 else v1 \bits64 j) [0;1]). - -op x86_VPINSR_4u32 (v1:W128.t) (v2:W32.t) (i:W8.t) = - let i = W8.to_uint i %% 4 in - pack4 (map (fun j => if j = i then v2 else v1 \bits32 j) [0;1;2;3]). - -abbrev [-printing] x86_VPAND_128 = W128.(`&`). -abbrev [-printing] x86_VPOR_128 = W128.(`|`). -abbrev [-printing] x86_VPXOR_128 = W128.(`^`). - -abbrev [-printing] x86_VPAND_256 = W256.(`&`). -abbrev [-printing] x86_VPOR_256 = W256.(`|`). -abbrev [-printing] x86_VPXOR_256 = W256.(`^`). - -op x86_VPMULU_128 (w1 w2: W128.t) = - map2 mulu64 w1 w2. - -op x86_VPMULU_256 (w1 w2: W256.t) = - map2 mulu64 w1 w2. - -(* FIXME: check this *) -op x86_VPERM2I128 (w1 w2: W256.t) (i:W8.t) : W256.t = - let choose = fun n => - if i.[n+3] then W128.zero - else - let w = if i.[n+1] then w2 else w1 in - w \bits128 b2i i.[n] in - pack2 [choose 0; choose 4]. - -op x86_VPERMQ (w:W256.t) (i:W8.t) : W256.t = - let choose = fun n => w \bits64 ((to_uint i %/ 2^n) %% 4) in - pack4 [choose 0; choose 1; choose 2; choose 4]. - -op x86_VEXTRACTI128 (w:W256.t) (i:W8.t) : W128.t = - w \bits128 b2i i.[0]. - -(* ------------------------------------------------------------------- *) -op interleave_gen ['elem] - (get:W128.t -> W64.t) (split_v : W64.t -> 'elem list) (pack_2v : 'elem list -> W128.t) - (src1 src2: W128.t) = - let l1 = split_v (get src1) in - let l2 = split_v (get src2) in - pack_2v (_interleave l1 l2). - -op get_lo_2u64 (w:W128.t) = w \bits64 0. -op get_hi_2u64 (w:W128.t) = w \bits64 1. - -op x86_VPUNPCKL_16u8 (w1 w2:W128.t) = - interleave_gen get_lo_2u64 W8u8.to_list W16u8.pack16 w1 w2. - -op x86_VPUNPCKL_8u16 (w1 w2:W128.t) = - interleave_gen get_lo_2u64 W4u16.to_list W8u16.pack8 w1 w2. - -op x86_VPUNPCKL_4u32 (w1 w2:W128.t) = - interleave_gen get_lo_2u64 W2u32.to_list W4u32.pack4 w1 w2. - -op x86_VPUNPCKL_2u64 (w1 w2:W128.t) = - interleave_gen get_lo_2u64 (fun x => [x]) W2u64.pack2 w1 w2. - -op x86_VPUNPCKL_32u8 (w1 w2: W256.t) = - map2 x86_VPUNPCKL_16u8 w1 w2. - -op x86_VPUNPCKL_16u16 (w1 w2: W256.t) = - map2 x86_VPUNPCKL_8u16 w1 w2. - -op x86_VPUNPCKL_8u32 (w1 w2: W256.t) = - map2 x86_VPUNPCKL_4u32 w1 w2. - -op x86_VPUNPCKL_4u64 (w1 w2: W256.t) = - map2 x86_VPUNPCKL_2u64 w1 w2. - -op x86_VPUNPCKH_16u8 (w1 w2:W128.t) = - interleave_gen get_hi_2u64 W8u8.to_list W16u8.pack16 w1 w2. - -op x86_VPUNPCKH_8u16 (w1 w2:W128.t) = - interleave_gen get_hi_2u64 W4u16.to_list W8u16.pack8 w1 w2. - -op x86_VPUNPCKH_4u32 (w1 w2:W128.t) = - interleave_gen get_hi_2u64 W2u32.to_list W4u32.pack4 w1 w2. - -op x86_VPUNPCKH_2u64 (w1 w2:W128.t) = - interleave_gen get_hi_2u64 (fun x => [x]) W2u64.pack2 w1 w2. - -op x86_VPUNPCKH_32u8 (w1 w2: W256.t) = - map2 x86_VPUNPCKH_16u8 w1 w2. - -op x86_VPUNPCKH_16u16 (w1 w2: W256.t) = - map2 x86_VPUNPCKH_8u16 w1 w2. - -op x86_VPUNPCKH_8u32 (w1 w2: W256.t) = - map2 x86_VPUNPCKH_4u32 w1 w2. - -op x86_VPUNPCKH_4u64 (w1 w2: W256.t) = - map2 x86_VPUNPCKH_2u64 w1 w2. - -(* ------------------------------------------------------------------- *) -op x86_VPSLLDQ_128 (w1:W128.t) (w2:W8.t) = - let n = to_uint w2 in - let i = min n 16 in - w1 `<<<` (8 * i). - -op x86_VPSLLDQ_256 (w1:W256.t) (w2:W8.t) = - map (fun w => x86_VPSLLDQ_128 w w2) w1. - -op x86_VPSRLDQ_128 (w1:W128.t) (w2:W8.t) = - let n = to_uint w2 in - let i = min n 16 in - w1 `>>>` (8 * i). - -op x86_VPSRLDQ_256 (w1:W256.t) (w2:W8.t) = - map (fun w => x86_VPSRLDQ_128 w w2) w1. -(* ------------------------------------------------------------------- *) -abbrev [-printing] (\vshr32u128) (w1:W128.t) (w2:W8.t) = x86_VPSRL_4u32 w1 w2. -abbrev [-printing] (\vshl32u128) (w1:W128.t) (w2:W8.t) = x86_VPSLL_4u32 w1 w2. -abbrev [-printing] (\vadd32u128) (w1 w2:W128.t) = x86_VPADD_4u32 w1 w2. - - -abbrev [-printing] (\vshr32u256) (w1:W256.t) (w2:W8.t) = x86_VPSRL_8u32 w1 w2. -abbrev [-printing] (\vshl32u256) (w1:W256.t) (w2:W8.t) = x86_VPSLL_8u32 w1 w2. - -abbrev [-printing] (\vshr64u256) (w1:W256.t) (w2:W8.t) = x86_VPSRL_4u64 w1 w2. -abbrev [-printing] (\vshl64u256) (w1:W256.t) (w2:W8.t) = x86_VPSLL_4u64 w1 w2. - -abbrev [-printing] (\vadd32u256) (w1 w2:W256.t) = x86_VPADD_8u32 w1 w2. -abbrev [-printing] (\vadd64u256) (w1 w2:W256.t) = x86_VPADD_4u64 w1 w2. -(*abbrev [-printing] (\vsub64u256) (w1:W256.t) (w2:W8.t) = x86_VPSUB_4u64 w1 w2.*) - -(* ------------------------------------------------------------------- *) -(* Leakages *) - -type leakage_t = [ - | LeakAddr of address list - | LeakCond of bool - | LeakFor of (int * int) -]. - -type leakages_t = leakage_t list. diff --git a/proof/impl/JUtils.ec b/proof/impl/JUtils.ec deleted file mode 100644 index 1c8e429..0000000 --- a/proof/impl/JUtils.ec +++ /dev/null @@ -1,280 +0,0 @@ -require import AllCore IntDiv List Bool StdOrder. - -hint simplify (oget_some, oget_none). - -(* -------------------------------------------------------------------- *) - -lemma modz_cmp m d : 0 < d => 0 <= m %% d < d. -proof. smt (edivzP). qed. - -lemma divz_cmp d i n : 0 < d => 0 <= i < n * d => 0 <= i %/ d < n. -proof. - by move=> hd [hi1 hi2]; rewrite divz_ge0 // hi1 /= ltz_divLR. -qed. - -lemma mulz_cmp_r i m r : 0 < m => 0 <= i < r => 0 <= i * m < r * m. -proof. - move=> h0m [h0i hir]; rewrite IntOrder.divr_ge0 //=; 1: by apply ltzW. - by rewrite IntOrder.ltr_pmul2r. -qed. - -lemma cmpW i d : 0 <= i < d => 0 <= i <= d. -proof. by move=> [h1 h2];split => // ?;apply ltzW. qed. - -lemma le_modz m d : 0 <= m => m %% d <= m. -proof. - move=> hm. - have [ ->| [] hd]: d = 0 \/ d < 0 \/ 0 < d by smt(). - + by rewrite modz0. - + by rewrite -modzN {2}(divz_eq m (-d)); smt (divz_ge0). - by rewrite {2}(divz_eq m d); smt (divz_ge0). -qed. - -lemma bound_abs (i j:int) : 0 <= i < j => 0 <= i < `|j| by smt(). -hint solve 0 : bound_abs. - -lemma gt0_pow2 (p:int) : 0 < 2^p. -proof. - case (p <= 0)=> [? | /ltzNge hp]; 1:by rewrite pow_le0. - apply (IntOrder.ltr_le_trans 1) => //. - by rewrite -(pow_le0 0 2) // pow_Mle /= ltzW. -qed. - -lemma dvdmodz d m p : d %| m => d %| p => d %| (p%%m). -proof. move=> h1 h2; rewrite /(%|);rewrite modz_dvd //. qed. - -lemma modz_add_carry k i d : 0 <= k < d => 0 <= i < d => d <= k + i => - (k + i)%% d = (k + i) - d. -proof. - move=> hk hi hd; have [_ <- //]:= euclideUl d 1 ((k + i) - d) (k+i) _ _;last by smt(). - by rewrite -divz_eq; ring. -qed. - -lemma modz_sub_carry k i d : 0 <= k < d => 0 <= i < d => k - i < 0 => - (k - i)%% d = d + (k - i). - move=> hk hi hd; have [_ <- //]:= euclideUl d (-1) (d + (k - i)) (k-i) _ _;last by smt(). - by rewrite -divz_eq; ring. -qed. - -lemma nosmt divz_mod_mul n p i: 0 <= p => 0 <= n => - (i %% (n*p)) %/ p = (i %/ p) %% n. -proof. - move=> [hp | <- //]; move=> [hn | <- //]. - rewrite {2}(divz_eq i (n*p)) {2} (divz_eq (i %% (n * p)) p). - pose i1 := i %% (n * p). - have -> : (i %/ (n * p) * (n * p) + (i1 %/ p * p + i1 %% p)) = - ((i %/ (n * p) * n + i1 %/ p) * p + i1 %% p) by ring. - have hp0 : p <> 0 by smt(). - rewrite divzMDl 1:// (divz_small (i1%%p) p) 2:/=; 1: smt (edivzP). - rewrite modzMDl modz_small 2://. - apply bound_abs;apply divz_cmp => //. - by apply modz_cmp => /#. -qed. - -lemma nosmt divz_mod_div n p i: p %| n => 0 <= p => 0 <= n => - (i %% n) %/ p = (i %/ p) %% (n%/p). -proof. - rewrite dvdz_eq => {2}<- hp hn;apply divz_mod_mul => //. - by case: hp => [hp | <-//]; apply divz_ge0. -qed. - -lemma modz_mod_pow2 i n k : i %% 2^n %% 2^k = i %% 2^(min n k). -proof. - case: (0 <= n) => hn. - + rewrite /min;case (n < k) => hnk. - + rewrite (modz_small (i %% 2^n)) 2://;smt (modz_cmp gt0_pow2 pow_Mle). - case (0 <= k) => hk. - + rewrite modz_dvd 2://;1: by apply dvdz_exp2l => /#. - have hk0 : k <= 0 by smt(). - by rewrite !(powNeg _ _ hk0) modz1. - rewrite /min;case (n < k) => hnk. - + by rewrite powNeg 1:/# (modz1 i). - have hk0 : (k <= 0) by smt(). - by rewrite (powNeg _ _ hk0) modz1. -qed. - -(* FIXME: this is defined in IntDiv but with 0 <= i *) -lemma nosmt modz_pow2_div n p i: 0 <= p <= n => - (i %% 2^n) %/ 2^p = (i %/ 2^p) %% 2^(n-p). -proof. - move=> [h1 h2];rewrite divz_mod_div. - + by apply dvdz_exp2l. - + by apply ltzW; apply gt0_pow2. - + by apply ltzW; apply gt0_pow2. - congr; have {1}->: n = (n - p) + p by ring. - by rewrite -pow_add 1:/# 1:// mulzK //; smt (gt0_pow2). -qed. - -(* -------------------------------------------------------------------- *) -lemma powS_minus (x p:int) : 0 < p => x ^ p = x * x ^ (p-1). -proof. smt (powS). qed. - -hint simplify pow_le0@1. -hint simplify powS_minus@1. - -lemma pow2_1 : 2^1 = 2 by []. -lemma pow2_2 : 2^2 = 4 by []. -lemma pow2_3 : 2^3 = 8 by []. -lemma pow2_4 : 2^4 = 16 by []. -lemma pow2_5 : 2^5 = 32 by []. -lemma pow2_6 : 2^6 = 64 by []. -lemma pow2_7 : 2^7 = 128 by []. -lemma pow2_8 : 2^8 = 256 by []. -lemma pow2_16 : 2^16 = 65536 by []. -lemma pow2_32 : 2 ^ 32 = 4294967296 by []. -lemma pow2_64 : 2 ^ 64 = 18446744073709551616 by []. -lemma pow2_128 : 2 ^ 128 = 340282366920938463463374607431768211456 by []. -lemma pow2_256 : 2 ^ 256 = 115792089237316195423570985008687907853269984665640564039457584007913129639936 by []. - -hint simplify - (pow2_1, pow2_2, pow2_3, pow2_4, pow2_5, pow2_6, pow2_7, pow2_8, - pow2_16, pow2_32, pow2_64, pow2_128, pow2_256)@0. - -(* -------------------------------------------------------------------- *) -lemma iotaS_minus : - forall (i n : int), 0 < n => iota_ i n = i :: iota_ (i + 1) (n - 1). -proof. smt (iotaS). qed. - -hint simplify (iota0, iotaS_minus)@0. - -lemma nseqS_minus n (e:'a) : 0 < n => nseq n e = e :: nseq (n-1) e. -proof. smt (nseqS). qed. - -hint simplify (nseq0, nseqS_minus)@0. - -(* -------------------------------------------------------------------- *) -(* Allow to extend reduction rule with xor *) - -lemma xor1b (b : bool) : true ^^ b = !b. -proof. by rewrite xorC xor_true. qed. - -lemma xor0b (b : bool) : false ^^ b = b. -proof. by rewrite xorC xor_false. qed. - -lemma nosmt xorK_simplify (b1 b2: bool) : b1 = b2 => b1 ^^ b2 = false. -proof. by move=> ->; apply xorK. qed. - -hint simplify (xor1b, xor_true, xor0b, xor_false)@0. -hint simplify xorK_simplify@1. - - - -(* -------------------------------------------------------------------- *) -(* extra stuff on list *) - -op map2 ['a, 'b, 'c] (f:'a -> 'b -> 'c) (s:'a list) (t:'b list) = - with s = "[]" , t = "[]" => [] - with s = _ :: _ , t = "[]" => [] - with s = "[]" , t = _ :: _ => [] - with s = x :: s', t = y :: t' => f x y :: map2 f s' t'. - -lemma map2_zip (f:'a -> 'b -> 'c) s t : - map2 f s t = map (fun (p:'a * 'b) => f p.`1 p.`2) (zip s t). -proof. - by elim: s t => [ | s1 s hrec] [ | t1 t] //=;rewrite hrec. -qed. - -op mapN ['a, 'b] (f:'a -> 'b) dfa (s:'a list) N = - with s = "[]" => - if N <= 0 then [] else nseq N (f dfa) - with s = x :: s' => - if N <= 0 then [] - else f x :: mapN f dfa s' (N-1). - -op mapN2 ['a, 'b, 'c] (f:'a -> 'b -> 'c) dfa dfb (s:'a list) (t:'b list) N = - with s = "[]" , t = "[]" => - if N <= 0 then [] else nseq N (f dfa dfb) - - with s = _ :: _ , t = "[]" => mapN (fun x => f x dfb) dfa s N - - with s = "[]" , t = _ :: _ => mapN (fun y => f dfa y) dfb t N - - with s = x :: s', t = y :: t' => - if N <= 0 then [] - else f x y :: mapN2 f dfa dfb s' t' (N-1). - -lemma nth_mapN ['a, 'b] dfb (f:'a -> 'b) dfa (s:'a list) N i : - 0 <= i < N => - nth dfb (mapN f dfa s N) i = f (nth dfa s i). -proof. - elim: s N i => /= [ | x s hrec] N i hiN; - have -> /= : !(N <= 0) - by apply ltzNge; case hiN; apply IntOrder.ler_lt_trans. - + by rewrite nth_nseq. - by case (i=0) => // ?; apply hrec => /#. -qed. - -lemma nth_mapN2 ['a, 'b, 'c] - (f:'a -> 'b -> 'c) dfa dfb dfc (s:'a list) (t:'b list) N i : - 0 <= i < N => - nth dfc (mapN2 f dfa dfb s t N) i = f (nth dfa s i) (nth dfb t i). -proof. - elim: s t N i => [ | x s hrec] [ | y t] N i hiN /=; - have -> /= : !(N <= 0) - by apply ltzNge; case hiN; apply IntOrder.ler_lt_trans. - + by rewrite nth_nseq. - + by case (i=0) => // neqi; apply nth_mapN => /#. - + by case (i=0) => // neqi; apply nth_mapN => /#. - by case (i=0) => // ?;apply hrec => /#. -qed. - -lemma map2_cat (f:'a -> 'b -> 'c) (l1 l2:'a list) (l1' l2':'b list): - size l1 = size l1' => - map2 f (l1 ++ l2) (l1' ++ l2') = map2 f l1 l1' ++ map2 f l2 l2'. -proof. by move=> hs;rewrite !map2_zip zip_cat // map_cat. qed. - -lemma map2C (f: 'a -> 'a -> 'b) (l1 l2:'a list) : - (forall a1 a2, f a1 a2 = f a2 a1) => - map2 f l1 l2 = map2 f l2 l1. -proof. - move=> hf; elim: l1 l2=> [ | a1 l1 hrec] [ | a2 l2] //=. - by rewrite hf hrec. -qed. - -lemma map2_take1 (f: 'a -> 'b -> 'c) (l1: 'a list) (l2: 'b list) : - map2 f l1 l2 = map2 f (take (size l2) l1) l2. -proof. - elim: l1 l2 => [ | a1 l1 hrec] [ | a2 l2] //=. - smt (size_ge0). -qed. - -lemma map2_take2 (f: 'a -> 'b -> 'c) (l1: 'a list) (l2: 'b list) : - map2 f l1 l2 = map2 f l1 (take (size l1) l2). -proof. - elim: l1 l2 => [ | a1 l1 hrec] [ | a2 l2] //=. - smt (size_ge0). -qed. - -lemma size_map2 (f:'a -> 'b -> 'c) (l1:'a list) l2 : size (map2 f l1 l2) = min (size l1) (size l2). -proof. by rewrite map2_zip size_map size_zip. qed. - -lemma nth_map2 dfla dflb dflc (f:'a -> 'b -> 'c) (l1:'a list) l2 i: - 0 <= i < min (size l1) (size l2) => - nth dflc (map2 f l1 l2) i = f (nth dfla l1 i) (nth dflb l2 i). -proof. - elim: l1 l2 i => [ | a l1 hrec] [ | b l2] i /=; 1..3:smt(size_ge0). - case: (i=0) => [->> // | hi ?]. - apply hrec;smt(). -qed. - -(* FIXME: we can not do l1 = "[]", l2= _ => l2 *) -op _interleave (l1 l2: 'a list) = - with l1 = "[]", l2= "[]" => [] - with l1 = "[]", l2= _::_ => l2 - with l1 = _::_, l2 = "[]" => l1 - with l1 = a1::l1', l2 = a2::l2' => a1::a2::_interleave l1' l2'. - -(* ------------------------------------------------------------------- *) -(* Safety *) - -op in_bound (x n:int) = 0 <= x /\ x < n. -op is_init (x : 'a option) = x <> None. - -lemma is_init_Some (a:'a) : is_init (Some a). -proof. done. qed. - -lemma in_bound_simplify x n : - 0 <= x < n => in_bound x n. -proof. done. qed. - -hint simplify (is_init_Some, in_bound_simplify). \ No newline at end of file diff --git a/proof/impl/JWord.ec b/proof/impl/JWord.ec deleted file mode 100644 index 6d11628..0000000 --- a/proof/impl/JWord.ec +++ /dev/null @@ -1,2432 +0,0 @@ -(* -------------------------------------------------------------------- *) -require import AllCore BitEncoding IntDiv SmtMap List StdOrder BitEncoding Bool. -(*---*) import Ring.IntID IntOrder BS2Int. -require import JUtils JArray. - -(* -------------------------------------------------------------------- *) -abstract theory BitWord. - -op size : {int | 0 < size} as gt0_size. - -clone FinType as Alphabet with - type t <- bool, - op enum <- [true; false], - op card <- 2. - -clone include MonoArray with - type elem <- bool, - op dfl <- false, - op size <- size - rename "of_list" as "bits2w" - "to_list" as "w2bits" - "^tP$" as "wordP" - "sub" as "bits" - proof ge0_size by (apply ltzW; apply gt0_size). - -(* -------------------------------------------------------------------- *) -abbrev modulus = 2 ^ size. - -lemma ge2_modulus : 2 <= modulus. -proof. - rewrite powS_minus ?gt0_size; smt (gt0_size powPos). -qed. - -lemma gt0_modulus : 0 < modulus. -proof. smt (ge2_modulus). qed. - -lemma ge0_modulus : 0 <= modulus. -proof. smt (ge2_modulus). qed. - -lemma max_size : max 0 size = size. -proof. by rewrite /max gt0_size. qed. - -hint exact : ge0_size gt0_size gt0_modulus ge2_modulus ge0_modulus max_size. - -(* --------------------------------------------------------------------- *) -(* Conversions with int *) - -op of_int (x:int) : t = - bits2w (int2bs size (x %% modulus)) -axiomatized by of_intE. - -op to_uint (w:t) = - bs2int (w2bits w) -axiomatized by to_uintE. - -op smod (i:int) = - if 2^(size - 1) <= i then i - modulus - else i. - -op to_sint (w:t) : int = smod (to_uint w) -axiomatized by to_sintE. - -abbrev zero = of_int 0. -abbrev one = of_int 1. - -lemma to_uint_cmp (x : t) : 0 <= to_uint x < modulus. -proof. - rewrite to_uintE bs2int_ge0 -(size_w2bits x) bs2int_le2Xs. -qed. - -lemma of_uintK (x : int) : to_uint (of_int x) = x %% modulus. -proof. - by rewrite to_uintE of_intE bits2wK 1:size_int2bs // int2bsK // modz_cmp. -qed. - -lemma to_uintK : cancel to_uint of_int. -proof. - move=> w; rewrite to_uintE of_intE. - rewrite modz_small. - + by rewrite bs2int_ge0 ger0_norm // -(size_w2bits w) bs2int_le2Xs. - by rewrite -(size_w2bits w) bs2intK w2bitsK. -qed. - -lemma to_uintK' (x: t) : of_int (to_uint x) = x. -proof. by apply to_uintK. qed. - -(*hint simplify of_uintK@1. *) -hint simplify to_uintK'@0. - -lemma of_sintK (x:int) : - to_sint (of_int x) = smod (x %% modulus). -proof. by rewrite to_sintE of_uintK. qed. - -lemma to_uint_mod (x : t) : to_uint x %% modulus = to_uint x. -proof. by rewrite modz_small // ger0_norm // to_uint_cmp. qed. - -lemma of_int_mod (x : int) : of_int (x %% modulus) = of_int x. -proof. by apply/(can_inj _ _ to_uintK); rewrite !of_uintK modz_mod. qed. - -lemma of_int_mod_red (x:int): !(0 <= x < modulus) => of_int x = of_int (x %% modulus). -proof. by rewrite of_int_mod. qed. - -hint simplify of_int_mod_red. - -lemma to_uint_small i : 0 <= i < modulus => to_uint (of_int i) = i. -proof. by move=> h; rewrite of_uintK modz_small;solve. qed. - -lemma to_uint0 : to_uint (of_int 0) = 0 by []. -lemma to_uint1 : to_uint (of_int 1) = 1 by []. - -hint simplify (to_uint0, to_uint1)@0. -hint simplify to_uint_small@1. - -lemma word_modeqP (x y : t) : - to_uint x %% modulus = to_uint y %% modulus => x = y. -proof. -move=> eq_mod; rewrite -(to_uintK x) -(to_uint_mod x). -by rewrite eq_mod to_uint_mod. -qed. - -lemma to_uint_eq (x y:t) : (x = y) <=> (to_uint x = to_uint y). -proof. by rewrite Core.inj_eq // (Core.can_inj _ _ to_uintK). qed. - -(* -------------------------------------------------------------------- *) -op int_bit x i = (x%%modulus) %/ 2 ^ i %% 2 <> 0. - -lemma of_intwE x i : - (of_int x).[i] = (0 <= i < size /\ int_bit x i). -proof. - rewrite of_intE; case (0 <= i < size) => /= hi; last by rewrite get_out. - by rewrite get_bits2w // nth_mkseq. -qed. - -lemma zerowE i: zero.[i] = false. -proof. by rewrite of_intwE /int_bit. qed. -hint simplify zerowE. - -lemma of_int_powm1 p i : - (of_int (2^p - 1)).[i] = (0 <= i < size /\ i < p). -proof. - case: (0 <= i < size) => [[h0i his] | hi]; last by rewrite get_out. - case (0 <= p) => hp; last by rewrite pow_le0 1:/# /= /#. - have aux : forall p, 0 <= p <= size => (of_int (2 ^ p - 1)).[i] = (true /\ i < p). - + move=> {p hp} p hp. - rewrite of_intwE 1:// /int_bit /= (modz_small (2 ^ p - 1)). - + smt (gt0_pow2 pow_Mle). - case (i < p) => hip /=. - + have -> : p = ((p - i - 1) + 1) + i by ring. - rewrite h0i his -pow_add // 1:/# divzMDl; 1: smt (gt0_pow2). - rewrite -pow_add 1:/# //= modzMDl divNz // gt0_pow2. - by rewrite divz_small //; smt (gt0_pow2 pow_Mle). - case : (p <= size) => hps; 1: by apply aux. - rewrite (_:i < p) 1:/# -of_int_mod. - have -> : p = (p-size) + size by ring. - rewrite -pow_add 1:/# 1://. - by rewrite modzMDl -(modzMDl 1 (-1) modulus) /= of_int_mod aux 1:// his. -qed. - -lemma get_to_uint w i : w.[i] = (0 <= i < size /\ to_uint w %/ 2 ^ i %% 2 <> 0). -proof. - case : (0 <= i < size) => hi;last by rewrite get_out. - rewrite -{1}(to_uintK w) of_intwE hi /int_bit (modz_small _ modulus) 2://. - by apply bound_abs; apply to_uint_cmp. -qed. - -lemma b2i_get w i : 0 <= i => b2i w.[i] = to_uint w %/ 2 ^ i %% 2. -proof. - move=> hi;rewrite get_to_uint hi. - case (i < size) => his //=; 1: smt (modz_cmp). - rewrite divz_small //; apply bound_abs. - smt (to_uint_cmp pow_Mle ge0_size). -qed. - -lemma bits_divmod w i j: 0 <= i => 0 <= j => bs2int (bits w i j) = ((to_uint w) %/ 2^i) %% 2^j. -proof. - move => hi; rewrite /bits. - elim /intind: j. - + by rewrite mkseq0 bs2int_nil /=. - move=> j hj hrec; rewrite mkseqS 1:// bs2int_rcons. - rewrite size_mkseq max_ler 1:// /= hrec. - have {2}->:= modz_pow_split (i+j+1) (i+j) (to_uint w) 2 _; 1: smt(). - have hij1 : 2 ^ (i + j + 1) = 2^(j+1) * 2^i. - + rewrite pow_add 1:/# 1://;congr;ring. - have hij : 2 ^ (i + j) = 2^j * 2^i. - + rewrite pow_add 1:/# 1://;congr;ring. - have h2i0 : 2 ^ i <> 0 by smt (gt0_pow2). - rewrite -addzA {2}hij1 -mulzA divzMDl 1://. - rewrite {2}hij -mulzA divzMDl 1://. - rewrite modzMDl !modz_pow2_div; 1,2:smt(). - have -> : i + j + 1 - (i + j) = 1 by ring. - have -> : i + j - i = j by ring. - rewrite -(pow_add 2 j 1) 1,2:// pow2_1 (modz_small _ (2^j * 2)). - + by apply bound_abs; smt (modz_cmp gt0_pow2). - by rewrite addzC mulzC b2i_get 1:/#. -qed. - -lemma bitsE w k len : bits w k len = mkseq (fun (i:int) => w.[k+i]) len. -proof. done. qed. - -lemma to_uintRL (w:t) (x:int) : to_uint w = x %% 2^size => w = of_int x. -proof. - by move=> h;rewrite -of_int_mod; apply: (canRL _ _ _ _ to_uintK). -qed. - -lemma to_uint_bits w : to_uint w = bs2int (bits w 0 size). -proof. by rewrite to_uintE /w2bits /bits. qed. - -(* -------------------------------------------------------------------- *) -op zerow = zero. - -op onew = of_int (modulus - 1) -axiomatized by oneE. - -op (+^) : t -> t -> t = map2 (^^) -axiomatized by xorE. - -op andw : t -> t -> t = map2 (/\) -axiomatized by andE. - -op oppw (w : t): t = w. - -op invw : t -> t = map ([!]) -axiomatized by invE. - -op orw : t -> t -> t = map2 (\/) -axiomatized by orE. - -(* -------------------------------------------------------------------- *) - -lemma zerowiE i: zerow.[i] = false. -proof. apply zerowE. qed. - -lemma onewE i: onew.[i] = (0 <= i < size). -proof. - rewrite oneE; case (0 <= i < size) => hi; 2:by rewrite get_out. - by rewrite of_int_powm1 //= 1:/# hi. -qed. - -lemma xorwE w1 w2 i: (w1 +^ w2).[i] = w1.[i] ^^ w2.[i]. -proof. - by rewrite xorE; case (0 <= i < size) => hi;[ rewrite map2iE | rewrite !get_out]. -qed. - -lemma andwE (w1 w2:t) i: (andw w1 w2).[i] = (w1.[i] /\ w2.[i]). -proof. - by rewrite andE; case (0 <= i < size) => hi;[ rewrite map2iE | rewrite !get_out]. -qed. - -lemma orwE (w1 w2:t) i: (orw w1 w2).[i] = (w1.[i] \/ w2.[i]). -proof. - by rewrite orE; case (0 <= i < size) => hi;[ rewrite map2iE | rewrite !get_out]. -qed. - -lemma invwE (w:t) i: - (invw w).[i] = (0 <= i < size /\ !w.[i]). -proof. by rewrite invE mapE initE;case (0 <= i < _). qed. - -lemma oppwE (w:t) i: (oppw w).[i] = w.[i]. -proof. by []. qed. - -hint rewrite bwordE : zerowE zerowiE onewE xorwE andwE invwE. -hint simplify (zerowE, zerowiE, onewE, xorwE, andwE, invwE, orwE). - -(* -------------------------------------------------------------------- *) -lemma onew_neq0: onew <> zerow. -proof. - apply/negP=> /wordP/(_ 0) /=. - by rewrite negb_imply neqF. -qed. - -lemma xorw0: right_id zero (+^). -proof. by move=> w; apply/wordP=> i _. qed. - -lemma xorwA: associative (+^). -proof. by move=> w1 w2 w3; apply/wordP=> i _; rewrite !bwordE xorA. qed. - -lemma xorwC: commutative (+^). -proof. by move=> w1 w2; apply/wordP=> i _; rewrite !bwordE xorC. qed. - -lemma xorwK: forall x, x +^ x = zero. -proof. by move=> w; apply/wordP=> i _; rewrite !bwordE. qed. - -lemma andw1: right_id onew andw. -proof. by move=> w; apply/wordP=> i h; rewrite !bwordE h. qed. - -lemma andwA: associative andw. -proof. by move=> w1 w2 w3; apply/wordP=> i h; rewrite !bwordE andbA. qed. - -lemma andwC: commutative andw. -proof. by move=> w1 w2; apply/wordP=> i h; rewrite !bwordE andbC. qed. - -lemma andwDl: left_distributive andw (+^). -proof. move=> w1 w2 w3; apply/wordP=> i h; rewrite !bwordE smt. qed. - -lemma andwK: idempotent andw. -proof. by move=> x; apply/wordP=> i h; rewrite !bwordE andbb. qed. - -(* -------------------------------------------------------------------- *) -instance bring with t - op rzero = zerow - op rone = onew - op add = (+^) - op mul = andw - op opp = oppw - - proof oner_neq0 by apply/onew_neq0 - proof addr0 by apply/xorw0 - proof addrA by (move=> w1 w2 w3; rewrite xorwA) - proof addrC by apply/xorwC - proof addrK by apply/xorwK - proof mulr1 by apply andw1 - proof mulrA by (move=> w1 w2 w3; rewrite andwA) - proof mulrC by apply/andwC - proof mulrDl by apply/andwDl - proof mulrK by apply/andwK - proof oppr_id by trivial. - -pred unitw (w:t) = w = onew. -op iandw (w:t) = if w = onew then onew else w. - -clone Ring.ComRing as WRing with - type t <- t, - op zeror <- zero, - op ( + ) <- (+^), - op [ - ] <- oppw, - op oner <- onew, - op ( * ) <- andw, - op invr <- iandw, - pred unit <- unitw -proof *. -realize addrA. proof. apply xorwA. qed. -realize addrC. proof. apply xorwC. qed. -realize add0r. proof. move=> ?;ring. qed. -realize addNr. proof. move=> ?;ring. qed. -realize oner_neq0. proof. apply onew_neq0. qed. -realize mulrA. proof. apply andwA. qed. -realize mulrC. proof. apply andwC. qed. -realize mul1r. proof. move=> ?;ring. qed. -realize mulrDl. proof. apply andwDl. qed. -realize mulVr. proof. move=> ?;rewrite /unitw /iandw => -> /=;ring. qed. -realize unitout. proof. by move=> x;rewrite /unitw /iandw => ->. qed. - -realize unitP. -proof. -move=> x y; rewrite /unitw !wordP => + i Hi -/(_ i Hi). -by rewrite andwE onewE Hi /#. -qed. - -lemma xor0w w : of_int 0 +^ w = w. -proof. by apply WRing.add0r. qed. - -lemma xorw0_s w : w +^ of_int 0 = w. -proof. by apply WRing.addr0. qed. - -lemma xorw1 w : w +^ onew = invw w. -proof. by apply wordP => i hi /=; case (0 <= i < size). qed. - -lemma xor1w w : onew +^ w = invw w. -proof. by apply wordP => i hi /=; case (0 <= i < size). qed. - -lemma and0w w : andw (of_int 0) w = of_int 0. -proof. by apply WRing.mul0r. qed. - -lemma andw0 w : andw w (of_int 0) = of_int 0. -proof. by apply WRing.mulr0. qed. - -lemma and1w w : andw onew w = w. -proof. by apply WRing.mul1r. qed. - -lemma andw1_s w : andw w onew = w. -proof. by apply WRing.mulr1. qed. - -lemma orw0 w : orw w zero = w. -proof. by apply wordP => i hi. qed. - -lemma or0w w : orw zero w = w. -proof. by apply wordP => i hi. qed. - -lemma orw1 w : orw w onew = onew. -proof. by apply wordP => i hi /=; case (0 <= i < size). qed. - -lemma or1w w : orw onew w = onew. -proof. by apply wordP => i hi /=; case (0 <= i < size). qed. - -lemma orwK w : orw w w = w. -proof. by apply wordP => i hi /=; case (w.[i]). qed. - -lemma xorwK_s w1 w2 : w1 = w2 => (w1 +^ w2) = zero. -proof. move=> ->;apply xorwK. qed. - -lemma andwK_s w1 w2 : w1 = w2 => andw w1 w2 = w1. -proof. move=> ->;apply andwK. qed. - -lemma orwK_s w1 w2 : w1 = w2 => orw w1 w2 = w1. -proof. move=> ->;apply orwK. qed. - -hint simplify (xor0w, xorw0_s, xorw1, xor1w, - and0w, andw0, and1w, andw1_s, - or0w, orw0, orw1, or1w, - xorwK_s, andwK_s, orwK_s). - -(* --------------------------------------------------------------------- *) -(* Arimethic operations *) - -op ulift1 (f : int -> int) (w : t) = - of_int (f (to_uint w)). - -op ulift2 (f : int -> int -> int) (w1 w2 : t) = - of_int (f (to_uint w1) (to_uint w2)). - -op slift2 (f : int -> int -> int) (w1 w2 : t) = - of_int (f (to_uint w1) (to_uint w2)). - -op ( + ) = ulift2 Int.( + ) axiomatized by addE. -op ([-]) = ulift1 Int.([-]) axiomatized by oppE. -op ( * ) = ulift2 Int.( * ) axiomatized by mulE. - -op (\udiv) = ulift2 IntDiv.( %/) axiomatized by udivE. -op (\umod) = ulift2 IntDiv.( %/) axiomatized by umodE. - -(* TODO check this *) -op (\sdiv) = slift2 IntDiv.( %/) axiomatized by sdivE. -op (\smod) = slift2 IntDiv.( %/) axiomatized by smodE. - -(* --------------------------------------------------------------------- *) -(* Comparisons *) - -op (\ule) (x y : t) = (to_uint x) <= (to_uint y) axiomatized by uleE. -op (\ult) (x y : t) = (to_uint x) < (to_uint y) axiomatized by ultE. - -op (\sle) (x y : t) = (to_sint x) <= (to_sint y) axiomatized by sleE. -op (\slt) (x y : t) = (to_sint x) < (to_sint y) axiomatized by sltE. - -lemma ult_of_int x y : - (of_int x \ult of_int y) = (x %% modulus < y %% modulus). -proof. by rewrite ultE /= !of_uintK. qed. - -lemma ule_of_int x y : - (of_int x \ule of_int y) = (x %% modulus <= y %% modulus). -proof. by rewrite uleE /= !of_uintK. qed. - -lemma uleNgt x y : x \ule y <=> ! y \ult x. -proof. by rewrite ultE uleE lerNgt. qed. - -lemma ultNge x y: x \ult y <=> ! y \ule x. -proof. by rewrite ultE uleE ltzNge. qed. - -lemma ult_of_int_true x y : - (x %% modulus < y %% modulus) => (of_int x \ult of_int y) = true. -proof. by rewrite ult_of_int => ->. qed. - -lemma ult_of_int_false x y : - !(x %% modulus < y %% modulus) => (of_int x \ult of_int y) = false. -proof. by rewrite ult_of_int => ->. qed. - -lemma ule_of_int_true x y : - (x %% modulus <= y %% modulus) => (of_int x \ule of_int y) = true. -proof. by rewrite ule_of_int => ->. qed. - -lemma ule_of_int_false x y : - !(x %% modulus <= y %% modulus) => (of_int x \ule of_int y) = false. -proof. by rewrite ule_of_int => ->. qed. - -hint simplify (ult_of_int_true, ult_of_int_false, ule_of_int_true, ule_of_int_false). - -(* --------------------------------------------------------------------- *) -(* ComRing *) - -op is_inverse (w wi: t) = wi * w = of_int 1. -op unit (w:t) = exists wi, is_inverse w wi. -op invr (w:t) = Logic.choiceb (is_inverse w) w. - -lemma of_intN (x : int) : of_int (-x) = - of_int x. -proof. -rewrite oppE /ulift1 /=; apply/word_modeqP=> /=. -by rewrite !of_uintK !modz_mod modzNm. -qed. - -lemma to_uintN (x : t) : to_uint (-x) = (- to_uint x) %% modulus. -proof. by rewrite oppE /ulift1 of_uintK. qed. - -lemma of_intD (x y : int) : of_int (x + y) = of_int x + of_int y. -proof. -rewrite addE /ulift2 /=; apply/word_modeqP=> /=. -by rewrite !of_uintK !modz_mod !(modzDml, modzDmr). -qed. - -lemma to_uintD (x y : t) : to_uint (x + y) = (to_uint x + to_uint y) %% modulus. -proof. by rewrite addE /ulift2 of_uintK. qed. - -lemma of_intM (x y : int) : of_int x * of_int y = of_int (x * y). -proof. -rewrite mulE /ulift2 /=; apply/word_modeqP=> /=. -by rewrite !of_uintK !modz_mod !(modzMml, modzMmr). -qed. - -lemma to_uintM (x y : t) : to_uint (x * y) = (to_uint x * to_uint y) %% modulus. -proof. by rewrite mulE /ulift2 !of_uintK. qed. - -lemma to_uintD_small (x y : t) : to_uint x + to_uint y < modulus => - to_uint (x + y) = to_uint x + to_uint y. -proof. - move=> h;rewrite to_uintD modz_small 2://; smt (to_uint_cmp). -qed. - -lemma to_uintM_small (x y : t) : to_uint x * to_uint y < modulus => - to_uint (x * y) = (to_uint x * to_uint y). -proof. - move=> h;rewrite to_uintM modz_small 2://; smt (to_uint_cmp). -qed. - -clone export Ring.ComRing as WRingA with - type t <- t, - op zeror <- of_int 0, - op ( + ) <- BitWord.( + ), - op [ - ] <- BitWord.([-]), - op oner <- of_int 1, - op ( * ) <- BitWord.( * ), - op invr <- invr, - pred unit <- BitWord.unit proof *. - -realize addrA. -proof. - move=> x y z; rewrite addE /ulift2 !to_uintD -of_int_mod modzDmr. - by rewrite -(of_int_mod (_ + to_uint z)) modzDml addrA. -qed. - -realize addrC. -proof. by move=> x y; rewrite !addE /ulift2 addzC. qed. - -realize add0r. -proof. by move=> x; rewrite addE /ulift2; cbv delta. qed. - -realize addNr. -proof. - move=> x; rewrite addE oppE /ulift2 /ulift1 of_uintK. - by rewrite -of_int_mod modzDml addNz. -qed. - -realize oner_neq0. -proof. - apply /negP => heq. - have := of_uintK 1; rewrite heq of_uintK mod0z. - rewrite modz_small //;smt (ge2_modulus). -qed. - -realize mulrA. - move=> x y z; rewrite mulE /ulift2 !to_uintM -of_int_mod modzMmr. - by rewrite -(of_int_mod (_ * to_uint z)) modzMml mulrA. -qed. - -realize mulrC. -proof. by move=> x y; rewrite !mulE /ulift2 mulzC. qed. - -realize mul1r. -proof. by move=> x; rewrite mulE /ulift2 to_uint1. qed. - -realize mulrDl. -proof. - move=> x y z; rewrite !addE !mulE /ulift2. - rewrite !of_uintK -of_int_mod modzMml eq_sym. - by rewrite -of_int_mod modzDml modzDmr mulrDl. -qed. - -realize mulVr. -proof. by move=> x /choicebP /= ->. qed. - -realize unitP. -proof. by move=> w wi hinv;exists wi. qed. - -realize unitout. -proof. by move=> x /negb_exists /=; apply choiceb_dfl. qed. - -abbrev (^) = WRingA.exp. - -lemma ofintS (n : int) : 0 <= n => of_int (n + 1) = of_int 1 + of_int n. -proof. by rewrite of_intD addrC. qed. - -lemma to_uintB (x y: t) : y \ule x => to_uint (x - y) = to_uint x - to_uint y. -proof. - rewrite uleE=> hle. - rewrite to_uintD to_uintN modzDmr modz_small //; smt (to_uint_cmp). -qed. - -(* Add simplification rule for rewriting *) -(* FIXME add direction for hint simplify *) -lemma of_intN' (x : int) : - of_int x = of_int (-x). -proof. by rewrite of_intN. qed. - -lemma of_intS (x y : int) : of_int (x - y) = of_int x - of_int y. -proof. by rewrite of_intD of_intN. qed. - -lemma of_intS' (x y : int) : of_int x - of_int y = of_int (x - y). -proof. by rewrite of_intS. qed. - -lemma of_intD' (x y : int) : of_int x + of_int y = of_int (x + y). -proof. by rewrite of_intD. qed. - -lemma of_intM' (x y : int) : of_int x * of_int y = of_int (x * y). -proof. by rewrite of_intM. qed. - -hint simplify (of_intS', of_intM')@0. -hint simplify (of_intD')@1. - -lemma addr0_s w : w + of_int 0 = w. -proof. by apply addr0. qed. - -lemma add0r_s w : of_int 0 + w = w. -proof. by apply add0r. qed. - -lemma mulr1_s w : w * of_int 1 = w. -proof. by apply mulr1. qed. - -lemma mul1r_s w : of_int 1 * w = w. -proof. by apply mul1r. qed. - -lemma mulr0_s w : w * of_int 0 = of_int 0. -proof. by apply mulr0. qed. - -lemma mul0r_s w : of_int 0 * w = of_int 0. -proof. by apply mul0r. qed. - -lemma addA_ofint w i j : w + of_int i + of_int j = w + of_int (i + j). -proof. by rewrite -addrA. qed. - -lemma addS_ofint w i j : w + of_int i - of_int j = w + of_int (i - j). -proof. by rewrite -addrA -of_intS. qed. - -hint simplify (addr0_s, add0r_s, mul1r_s, mulr1_s, mul0r_s, mulr0_s, addA_ofint). - - - -(* --------------------------------------------------------------------- *) -(* Ring tactic *) - -op zerow_ring = of_int 0. -op onew_ring = of_int 1. - -instance ring with t - op rzero = BitWord.zerow_ring - op rone = BitWord.onew_ring - op add = BitWord.( + ) - op opp = BitWord.([-]) - op mul = BitWord.( * ) - op expr = WRingA.exp - op ofint = BitWord.of_int - - proof oner_neq0 by apply oner_neq0 - proof addr0 by apply addr0 - proof addrA by apply addrA - proof addrC by apply addrC - proof addrN by apply addrN - proof mulr1 by apply mulr1 - proof mulrA by apply mulrA - proof mulrC by apply mulrC - proof mulrDl by apply mulrDl - proof expr0 by apply expr0 - proof exprS by apply exprS - proof ofint0 by done - proof ofint1 by done - proof ofintS by apply ofintS - proof ofintN by apply of_intN. - -(* --------------------------------------------------------------------- *) -(* Exact arithmetic operations *) -op subc : t -> t -> bool -> bool * t. -op addc : t -> t -> bool -> bool * t. -op mulu : t -> t -> t * t. - -(* --------------------------------------------------------------------- *) -(* Bitwize operations *) - -abbrev (`&`) = andw. -abbrev (`|`) = orw. -abbrev (`^`) = (+^). - -op (`>>>`) (x : t) (i : int) = - init (fun j => x.[j + i]) -axiomatized by wlsrE. - -op (`<<<`) (x : t) (i : int) = - init (fun j => x.[j - i]) -axiomatized by wlslE. - -lemma shlwE w k i : (w `<<<` k).[i] = (0 <= i < size && w.[i - k]). -proof. by rewrite wlslE initE. qed. - -lemma shrwE w k i : (w `>>>` k).[i] = (0 <= i < size && w.[i + k]). -proof. by rewrite wlsrE initE. qed. -hint simplify (shrwE, shlwE). - -lemma int_bitMP i j k : 0 <= k => 0 <= j < size => - int_bit (i * 2 ^ k) j = (0 <= j - k < size /\ int_bit i (j - k)). -proof. - move=> hk [h0j hjs];rewrite /int_bit modz_pow2_div 1:/# modz_dvd. - + by apply (dvdz_exp2l 2 1) => /#. - case: (0 <= j - k < size) => [ [hjk1 hjk2] | hjk] /=;last first. - + have hlt : (j < k) by smt(). - have ->: k = (k-j-1) + 1 + j by ring. - rewrite -pow_add 1:/# 1:// -mulzA mulzK; 1: smt (gt0_pow2). - by rewrite -pow_add 1:/# //= -mulzA modzMl. - rewrite (modz_pow2_div size) 1:/# modz_dvd. - + by apply (dvdz_exp2l 2 1) => /#. - have {1}-> : j = (j - k) + k by ring. - by rewrite -pow_add 1,2:// divzMpr 1:gt0_pow2. -qed. - -lemma int_bitDP i j k : 0 <= i < modulus => 0 <= k => 0 <= j < size => - int_bit (i %/ 2 ^ k) j = (0 <= j + k < size /\ int_bit i (j + k)). -proof. - move=> hi hk [h0j hjs];rewrite /int_bit. - rewrite !(modz_small _ modulus); 1,2: apply bound_abs; 2:done. - + by apply divz_cmp; [apply gt0_pow2 | smt (gt0_pow2)]. - case: (0 <= j + k < size) => hjk. - + have {1}->:= divz_eq i (2^(j+k)). - have {1}->:= divz_eq (i %% 2 ^ (j + k)) (2^k). - pose id := i %/ 2 ^ (j + k). pose im := i %% 2 ^ (j + k). - have -> : id * 2 ^ (j + k) + (im %/ 2 ^ k * 2 ^ k + im %% 2 ^ k) = - (id * 2^j + im %/ 2 ^ k) * 2^k + im %% 2 ^ k. - + by rewrite -pow_add 1,2://;ring. - rewrite divzMDl. smt (gt0_pow2). - rewrite (divz_small (im %% 2 ^ k) (2 ^ k)). - + apply bound_abs;apply modz_cmp;apply gt0_pow2. - rewrite /= divzMDl. smt (gt0_pow2). - rewrite (divz_small (im %/ 2 ^ k) (2 ^ j)) 2://. - apply bound_abs; apply divz_cmp; 1:by apply gt0_pow2. - by rewrite pow_add 1,2://;apply modz_cmp;apply gt0_pow2. - rewrite /= (divz_small (i %/ 2 ^ k) (2 ^ j)) 2://. - apply bound_abs;apply divz_cmp; 1: by apply gt0_pow2. - rewrite pow_add 1,2://;smt (pow_Mle). -qed. - -lemma shlMP i k : 0 <= k => (of_int i `<<<` k) = of_int (i * 2^k). -proof. - by move=> hk;apply wordP => j hj; rewrite shlwE !of_intwE hj /= -int_bitMP. -qed. - -lemma shrDP i k : 0 <= k => (of_int i `>>>` k) = of_int (i %% modulus %/ 2^k). -proof. - move=> hk;rewrite -(of_int_mod i). - apply wordP => j hj; rewrite shrwE !of_intwE hj /= -int_bitDP //. - by apply modz_cmp. -qed. - -lemma to_uint_shl (w:t) i : - 0 <= i => to_uint (w `<<<` i) = (to_uint w * 2^ i) %% modulus. -proof. - by move=> hi; rewrite -{1}(to_uintK w) shlMP 1:// of_uintK. -qed. - -lemma to_uint_shr (w:t) i : - 0 <= i => to_uint (w `>>>` i) = to_uint w %/ 2^ i. -proof. - move=> hi;rewrite -{1}(to_uintK w) shrDP 1:// of_uintK. - rewrite (modz_small (to_uint w)). - + by apply bound_abs; apply to_uint_cmp. - rewrite modz_small 2://. - apply bound_abs; apply divz_cmp; [apply gt0_pow2 | ]. - smt (to_uint_cmp gt0_pow2). -qed. - -lemma shrw_shlw w i : w `>>>` i = w `<<<` (-i). -proof. by apply wordP => k hk /=. qed. - -lemma shrw_add w i j : 0 <= i => 0 <= j => w `>>>` i `>>>` j = w `>>>` (i + j). -proof. - move=> hi hj; apply wordP => k hk /=;rewrite hk /=. - case : (0 <= k + j < size) => hkj /=; 1:congr;ring. - by rewrite get_out 1:/#. -qed. - -lemma shrw_out w i : size <= i => w `>>>` i = zero. -proof. - by move=> hi;apply wordP => k hk/=; rewrite get_out 1:/#. -qed. -hint simplify (shrw_add, shrw_out). - -lemma shlw_add w i j : 0 <= i => 0 <= j => w `<<<` i `<<<` j = w `<<<` (i + j). -proof. - move=> hi hj; apply wordP => k hk /=;rewrite hk /=. - case : (0 <= k - j < size) => hkj /=; 1:congr;ring. - by rewrite get_out 1:/#. -qed. - -lemma shlw_out w i : size <= i => w `<<<` i = zero. -proof. - by move=> hi;apply wordP => k hk/=; rewrite get_out 1:/#. -qed. -hint simplify (shlw_add, shlw_out). - -lemma shrw_map2 f w1 w2 i : f false false = false => - (map2 f) (w1 `>>>` i) (w2 `>>>` i) = (map2 f w1 w2) `>>>` i. -proof. - move=> hf;apply wordP => k hk. - rewrite map2iE // !shrwE hk. - case: (0 <= k + i < size) => hki; 1: by rewrite map2iE. - by rewrite !get_out. -qed. - -lemma shlw_map2 f w1 w2 i : f false false = false => - (map2 f) (w1 `<<<` i) (w2 `<<<` i) = (map2 f w1 w2) `<<<` i. -proof. - move=> hf;apply wordP => k hk. - rewrite map2iE // !shlwE hk. - case: (0 <= k - i < size) => hki; 1: by rewrite map2iE. - by rewrite !get_out. -qed. - -lemma shrw_and w1 w2 i : (w1 `>>>` i) `&` (w2 `>>>` i) = (w1 `&` w2) `>>>` i. -proof. by rewrite andE shrw_map2. qed. - -lemma shrw_xor w1 w2 i : (w1 `>>>` i) `^` (w2 `>>>` i) = (w1 `^` w2) `>>>` i. -proof. by rewrite xorE shrw_map2. qed. - -lemma shrw_or w1 w2 i : (w1 `>>>` i) `|` (w2 `>>>` i) = (w1 `|` w2) `>>>` i. -proof. by rewrite orE shrw_map2. qed. - -lemma shlw_and w1 w2 i : (w1 `<<<` i) `&` (w2 `<<<` i) = (w1 `&` w2) `<<<` i. -proof. by rewrite andE shlw_map2. qed. - -lemma shlw_xor w1 w2 i : (w1 `<<<` i) `^` (w2 `<<<` i) = (w1 `^` w2) `<<<` i. -proof. by rewrite xorE shlw_map2. qed. - -lemma shlw_or w1 w2 i : (w1 `<<<` i) `|` (w2 `<<<` i) = (w1 `|` w2) `<<<` i. -proof. by rewrite orE shlw_map2. qed. - -hint simplify (shrw_and, shrw_xor, shrw_or, shlw_and, shlw_xor, shlw_or). - -op ror (x : t) (i : int) = - init (fun j => x.[(j + i) %% size]) -axiomatized by rorE. - -op rol (x : t) (i : int) = - init (fun j => x.[(j - i) %% size]) -axiomatized by rolE. - -lemma rorwE w k i : - (ror w k).[i] = if (0 <= i < size) then w.[(i+k) %% size] else false. -proof. by rewrite rorE initE. qed. - -lemma rolwE w k i : - (rol w k).[i] = if (0 <= i < size) then w.[(i-k) %% size] else false. -proof. by rewrite rolE initE. qed. - -hint simplify (rorwE, rolwE). - -lemma rol_xor w i : 0 <= i < size => - rol w i = (w `<<<` i) `^` (w `>>>` (size - i)). -proof. - move=> hi; apply wordP => k hk /=. - rewrite hk /=. - case (0 <= k - i < size) => hki. - + rewrite modz_small; 1: by apply bound_abs. - by rewrite (get_out _ (k + (size - i))) 1:/#. - rewrite modz_sub_carry // 1:/# (get_out _ _ hki) /=. - by congr;ring. -qed. - -lemma rol_xor_simplify w1 w2 i si: - w1 = w2 => si = size - i => 0 <= i < size => - (w1 `<<<` i) `^` (w2 `>>>` si) = rol w1 i. -proof. by move=> 2!-> hi;rewrite rol_xor. qed. - -(* --------------------------------------------------------------------- *) -(* Like between bitwize operations and arithmetic operations *) - -lemma and_mod k w : - 0 <= k => - w `&` of_int (2^k - 1) = of_int (to_uint w %% 2^k). -proof. - move=> hk;apply wordP => i hi /=. - rewrite of_int_powm1 of_intwE hi /= /int_bit. - rewrite (modz_small _ modulus). - + apply bound_abs; smt (le_modz modz_cmp to_uint_cmp gt0_pow2). - case (i < k) => hik /=. - + rewrite modz_pow2_div 1:/# modz_dvd. - + by apply (dvdz_exp2l 2 1) => /#. - by rewrite get_to_uint hi. - rewrite divz_small 2://; smt (gt0_pow2 modz_cmp pow_Mle). -qed. - -lemma to_uint_and_mod k w : - 0 <= k => - to_uint (w `&` of_int (2^k - 1)) = to_uint w %% 2^k. -proof. - move=> hk ; rewrite and_mod 1:// of_uintK modz_small //. - apply bound_abs; smt (le_modz to_uint_cmp gt0_pow2 modz_cmp). -qed. - -end BitWord. - -theory W8. - abbrev [-printing] size = 8. - clone include BitWord with op size <- 8 - proof gt0_size by done. - - op (`>>`) (w1 w2 : W8.t) = w1 `>>>` (to_uint w2 %% size). - op (`<<`) (w1 w2 : W8.t) = w1 `<<<` (to_uint w2 %% size). - - lemma shr_div w1 w2 : to_uint (w1 `>>` w2) = to_uint w1 %/ 2^ (to_uint w2 %% size). - proof. - rewrite -{1}(to_uintK w1) /(`>>`) shrDP; 1: smt (modz_cmp). - rewrite of_uintK to_uint_mod modz_small 2://. - apply bound_abs; apply divz_cmp; 1: by apply gt0_pow2. - by have:= to_uint_cmp w1; smt (gt0_pow2). - qed. - - lemma shr_div_le w1 i : 0 <= i < size => - to_uint (w1 `>>` (of_int i)) = to_uint w1 %/ 2^i. - proof. - move=> hi;rewrite shr_div of_uintK. - rewrite (modz_small i);1: smt (pow2_8). - by rewrite modz_small. - qed. - - lemma rol_xor_shft w i : 0 < i < size => - rol w i = (w `<<` of_int i) +^ (w `>>` of_int (size - i)). - proof. - move=> hi; rewrite /(`<<`) /(`>>`) !of_uintK /=. - by rewrite !(modz_small _ 256) 1,2:/# !modz_small 1,2:/# rol_xor 1:/#. - qed. -end W8. export W8. - -abstract theory WT. - type t. - op size : int. - axiom gt0_size : 0 < size. - - op "_.[_]" : t -> int -> bool. - op init : (int -> bool) -> t. - - op andw : t -> t -> t. - op orw : t -> t -> t. - op (+^) : t -> t -> t. - - op (+) : t -> t -> t. - - op (`>>`) : t -> W8.t -> t. - op (`<<`) : t -> W8.t -> t. - op rol : t -> int -> t. - op of_int : int -> t. - op to_uint : t -> int. - op to_sint : t -> int. - - op bits : t -> int -> int -> bool list. - - axiom initiE (f : int -> bool) (i : int) : 0 <= i < size => (init f).[i] = f i. - - axiom andwE (w1 w2 : t) (i : int) : (andw w1 w2).[i] = (w1.[i] /\ w2.[i]). - axiom orwE (w1 w2 : t) (i : int) : (orw w1 w2).[i] = (w1.[i] \/ w2.[i]). - axiom xorwE (w1 w2 : t) (i : int) : (w1 +^ w2).[i] = (w1.[i] ^^ w2.[i]). - - axiom wordP (w1 w2 : t) : - w1 = w2 <=> forall (i : int), 0 <= i < size => w1.[i] = w2.[i]. - - axiom to_uint_cmp (x : t) : 0 <= to_uint x < 2^size. - - op int_bit x i = (x%%2^size) %/ 2 ^ i %% 2 <> 0. - - axiom of_intwE x i : - (of_int x).[i] = (0 <= i < size /\ int_bit x i). - - axiom get_to_uint w i : w.[i] = (0 <= i < size /\ to_uint w %/ 2 ^ i %% 2 <> 0). - - axiom bitsE w k len : bits w k len = mkseq (fun (i:int) => w.[k+i]) len. - - axiom bits_divmod w i j: 0 <= i => 0 <= j => - bs2int (bits w i j) = ((to_uint w) %/ 2^i) %% 2^j. - - axiom to_uintRL (w:t) (x:int) : to_uint w = x %% 2^size => w = of_int x. - - axiom to_uint_bits w : to_uint w = bs2int (bits w 0 size). - - axiom of_uintK (x : int) : to_uint (of_int x) = x %% 2^size. - - axiom to_uintK : cancel to_uint of_int. - - axiom of_int_mod (x : int) : of_int (x %% 2^size) = of_int x. - - axiom and_mod k w : - 0 <= k => - andw w (of_int (2^k - 1)) = of_int (to_uint w %% 2^k). - - axiom rol_xor_shft w i : 0 < i < size => - rol w i = (w `<<` W8.of_int i) +^ (w `>>` W8.of_int (size - i)). - -end WT. - -abstract theory W_WS. - - op sizeS : int. - op sizeB : int. - op r : int. - axiom gt0_r : 0 < r. - axiom sizeBrS : sizeB = r * sizeS. - - clone import WT as WS with op size <- sizeS. - clone import WT as WB with op size <- sizeB. - - clone export MonoArray as Pack with - type elem <- WS.t, - op dfl <- WS.of_int 0, - op size <- r - proof ge0_size by smt (gt0_r) - rename [type] "t" as "pack_t" - [lemma] "tP" as "packP". - - hint simplify Pack.map_to_list@1. - hint simplify Pack.map2_to_list@1. - - lemma le_size : sizeS <= sizeB. - proof. rewrite sizeBrS;smt (gt0_r WS.gt0_size WB.gt0_size). qed. - - lemma in_bound i j : 0 <= i < r => 0 <= j < sizeS => 0 <= i * sizeS + j < sizeB. - proof. - move=> hi hj;rewrite sizeBrS;have : i * sizeS + j < (i+1) * sizeS; smt (). - qed. - - (* ------------------------------------------------ *) - - op sigextu'B (w:WS.t) = WB.of_int (WS.to_sint w). - op zeroextu'B (w:WS.t) = WB.of_int (WS.to_uint w). - op truncateu'S (w:WB.t) = WS.of_int (WB.to_uint w). - - hint exact : WS.gt0_size WB.gt0_size. - - lemma size_div : sizeS %| sizeB. - proof. by rewrite dvdzP sizeBrS;exists r. qed. - - lemma div_size : sizeB %/ sizeS = r. - proof. rewrite sizeBrS mulzK; smt (WS.gt0_size). qed. - - op (\bits'S) (w:WB.t) i = WS.init (fun j => w.[ i * sizeS + j]) - axiomatized by bits'SE. - - op unpack'S (w:WB.t) : pack_t = - Pack.init (fun i => w \bits'S i). - - abbrev to_list (w:WB.t) : WS.t list = Pack.to_list (unpack'S w). - - op pack'R_t (ws:pack_t) = - WB.init (fun i => ws.[i %/ sizeS].[i %% sizeS]) - axiomatized by pack'RE. - - abbrev pack'R (ws:WS.t list) = pack'R_t (Pack.of_list ws). - - lemma pack'RwE (ws:pack_t) i : 0 <= i < sizeB => - (pack'R_t ws).[i] = ws.[i %/ sizeS].[i %% sizeS]. - proof. by move=> hi;rewrite pack'RE initiE //. qed. - - lemma get_unpack'S w i : 0 <= i < r => - (unpack'S w).[i] = w \bits'S i. - proof. apply initiE. qed. - - lemma bits'SiE w i j : 0 <= j < sizeS => - (w \bits'S i).[j] = w.[i * sizeS + j]. - proof. by move=> hj; rewrite bits'SE initiE. qed. - - lemma get_bits'S (w:WB.t) i : - 0 <= i < sizeB => - w.[i] = (w \bits'S (i%/ sizeS)).[i %% sizeS]. - proof. - by move=> hi; rewrite bits'SE WS.initiE /= -?divz_eq; 1:by apply modz_cmp. - qed. - - lemma get_out (w:WB.t) i : - !(0 <= i < r) => - w \bits'S i = WS.of_int 0. - proof. - move=> hi;apply WS.wordP => k hk. - rewrite bits'SiE 1:// WS.of_intwE /WS.int_bit /= get_to_uint. - smt(gt0_r WS.gt0_size sizeBrS). - qed. - - lemma get_zero i : WB.of_int 0 \bits'S i = WS.of_int 0. - proof. - apply WS.wordP => k hk. - by rewrite bits'SiE 1:// WS.of_intwE /WS.int_bit /= get_to_uint /= WB.of_uintK. - qed. - - lemma unpack'SK w : pack'R_t (unpack'S w) = w. - proof. - apply wordP => i hi; rewrite pack'RE initiE //= get_bits'S //. - by rewrite get_unpack'S //;apply divz_cmp => //;rewrite -sizeBrS. - qed. - - lemma pack'RbE ws i : 0 <= i < r => pack'R_t ws \bits'S i = ws.[i]. - proof. - move=> hr;apply WS.wordP => j hj. - rewrite bits'SiE // pack'RE initiE /= ?in_bound //. - by rewrite modzMDl divzMDl 1:/# divz_small ?modz_small; solve. - qed. - - lemma pack'RK ws : unpack'S (pack'R_t ws) = ws. - proof. by apply packP => i hi; rewrite get_unpack'S // pack'RbE. qed. - - lemma wordP (w1 w2 :WB.t) : (forall i, 0 <= i < r => w1 \bits'S i = w2 \bits'S i) => w1 = w2. - proof. - move=> h; rewrite -(unpack'SK w1) -(unpack'SK w2); congr. - by apply Pack.packP => i hi; rewrite !get_unpack'S 1,2://; apply h. - qed. - - lemma allP (w1 w2 :WB.t) : all (fun i => w1 \bits'S i = w2 \bits'S i) (iota_ 0 r) => w1 = w2. - proof. rewrite allP => h; apply wordP => i; rewrite -(mema_iota 0 r); apply h. qed. - - abbrev map (f:WS.t -> WS.t) (w:WB.t) = - pack'R_t (map f (unpack'S w)). - - abbrev map2 (f:WS.t -> WS.t -> WS.t) (w1 w2:WB.t) = - pack'R_t (map2 f (unpack'S w1) (unpack'S w2)). - - lemma mapbE f w i : 0 <= i < r => - (map f w) \bits'S i = f (w \bits'S i). - proof. - by move=> hi;rewrite pack'RbE // mapiE // initiE. - qed. - - lemma map2bE f w1 w2 i : 0 <= i < r => - (map2 f w1 w2) \bits'S i = f (w1 \bits'S i) (w2 \bits'S i). - proof. - by move=> hi;rewrite pack'RbE // map2iE // !initiE. - qed. - - lemma andb'SE (w1 w2:WB.t) i : - (WB.andw w1 w2) \bits'S i = WS.andw (w1 \bits'S i) (w2 \bits'S i). - proof. - apply WS.wordP => j hj. - by rewrite bits'SiE // WB.andwE WS.andwE !bits'SiE. - qed. - - lemma orb'SE (w1 w2:WB.t) i : - (WB.orw w1 w2) \bits'S i = WS.orw (w1 \bits'S i) (w2 \bits'S i). - proof. - apply WS.wordP => j hj. - by rewrite bits'SiE // WB.orwE WS.orwE !bits'SiE. - qed. - - lemma xorb'SE (w1 w2:WB.t) i : - (WB.(+^) w1 w2) \bits'S i = WS.(+^) (w1 \bits'S i) (w2 \bits'S i). - proof. - apply WS.wordP => j hj. - by rewrite bits'SiE // WB.xorwE WS.xorwE !bits'SiE. - qed. - - lemma andb'Ru'SE ws1 ws2 : - WB.andw (pack'R_t ws1) (pack'R_t ws2) = pack'R_t (map2 WS.andw ws1 ws2). - proof. - apply (canRL _ _ _ _ unpack'SK); apply packP => i hi. - by rewrite get_unpack'S // map2iE // andb'SE // !pack'RbE. - qed. - - lemma orb'Ru'SE ws1 ws2 : - WB.orw (pack'R_t ws1) (pack'R_t ws2) = pack'R_t (map2 WS.orw ws1 ws2). - proof. - apply (canRL _ _ _ _ unpack'SK); apply packP => i hi. - by rewrite get_unpack'S // map2iE // orb'SE // !pack'RbE. - qed. - - lemma xorb'Ru'SE ws1 ws2 : - WB.(+^) (pack'R_t ws1) (pack'R_t ws2) = pack'R_t (map2 WS.(+^) ws1 ws2). - proof. - apply (canRL _ _ _ _ unpack'SK); apply packP => i hi. - by rewrite get_unpack'S // map2iE // xorb'SE // !pack'RbE. - qed. - - lemma bits'S_div (w:WB.t) i : 0 <= i => - w \bits'S i = WS.of_int (WB.to_uint w %/ (2^(sizeS*i))). - proof. - move=> hi;apply WS.to_uintRL;rewrite -bits_divmod. - + smt (WS.gt0_size). smt (WS.gt0_size). - rewrite to_uint_bits; congr; rewrite WS.bitsE WB.bitsE; apply eq_in_mkseq. - by move=> k hk /=;rewrite bits'SiE 1:// mulzC. - qed. - - lemma of_int_bits'S_div w i : 0 <= i < r => - (WB.of_int w) \bits'S i = WS.of_int (w %/ (2^(sizeS*i))). - proof. - move=> [h0i hir];rewrite bits'S_div //. - rewrite WB.of_uintK modz_pow2_div. - + by rewrite sizeBrS mulzC; apply cmpW; apply mulz_cmp_r. - rewrite -WS.of_int_mod modz_mod_pow2 /min. - have -> /= : !sizeB - sizeS * i < sizeS. - + rewrite sizeBrS. - have -> : r * sizeS - sizeS * i = sizeS * (r - i) by ring. - by rewrite -lezNgt;apply ler_pemulr;[ apply ltzW | smt ()]. - by rewrite WS.of_int_mod. - qed. - - lemma of_int_bits'S_div_red (w i:int) : 0 <= i < r => - 0 <= `|w| => (* Do not remove this condition, it is used to block reduction *) - (WB.of_int w) \bits'S i = WS.of_int (w %/ (2^(sizeS*i))). - proof. by move=> hi hw;apply of_int_bits'S_div. qed. - - hint simplify (pack'RwE, bits'SiE, pack'RbE, get_unpack'S, unpack'SK, pack'RK, - mapbE, map2bE, andb'SE, orb'SE, xorb'SE, - andb'Ru'SE, orb'Ru'SE, xorb'Ru'SE, of_int_bits'S_div_red). - - lemma to_uint_zeroextu'B (w:WS.t) : - WB.to_uint (zeroextu'B w) = WS.to_uint w. - proof. - rewrite /zeroextu'B WB.of_uintK modz_small //. - apply bound_abs;have [h1 h2] := WS.to_uint_cmp w;split => // ?. - apply: (ltr_le_trans (2^sizeS)) => //. - apply pow_Mle;smt (le_size WS.gt0_size). - qed. - - lemma zeroextu'B_bit (w:WS.t) i: (zeroextu'B w).[i] = ((0 <= i < sizeS) /\ w.[i]). - proof. - rewrite /zeroextu'B WB.of_intwE /WB.int_bit (modz_small (to_uint w)). - + smt(gt0_r WS.gt0_size sizeBrS pow_Mle WS.to_uint_cmp). - have -> := WS.get_to_uint w i. - case: (0 <= i < sizeS) => hi /=;1: smt(gt0_r WS.gt0_size sizeBrS). - have [ /#| h]: (i < 0 \/ sizeS <= i) by smt(). - rewrite divz_small 2://. - smt(gt0_r WS.gt0_size sizeBrS pow_Mle WS.to_uint_cmp). - qed. - - lemma to_uint_truncateu'S (w:WB.t) : - WS.to_uint (truncateu'S w) = WB.to_uint w %% 2 ^ sizeS. - proof. by rewrite /truncateu'S WS.of_uintK. qed. - - lemma zeroext_truncateu'S_and (w:WB.t) : - zeroextu'B (truncateu'S w) = andw w (WB.of_int (2^sizeS - 1)). - proof. - rewrite WB.and_mod; 1: smt (le_size WS.gt0_size). - rewrite -(WB.to_uintK (zeroextu'B (truncateu'S w))). - by rewrite to_uint_zeroextu'B to_uint_truncateu'S. - qed. - - lemma of_uint_pack'R i : - (WB.of_int i) = - pack'R (map (fun k => WS.of_int ((i %/ 2^(sizeS * k)) %% 2^sizeS)) (iota_ 0 r)). - proof. - rewrite -(unpack'SK (WB.of_int i)) /unpack'S Pack.init_of_list. - do 2! congr; apply (eq_from_nth (WS.of_int 0)) => [ | k]; rewrite !size_map //. - move=> hk;rewrite !(nth_map 0) //=. - move: hk;rewrite size_iota /max gt0_r /= => hk;rewrite !nth_iota //=. - case: hk => hk1 hk2;rewrite bits'S_div //. - rewrite WB.of_uintK -(WS.of_int_mod (i %% 2 ^ sizeB %/ 2 ^ (sizeS * k))). - congr;rewrite modz_pow2_div 1://. - + by rewrite sizeBrS; smt (WS.gt0_size). - rewrite modz_dvd 2://;apply dvdz_exp2l. - rewrite sizeBrS (_: r * sizeS - sizeS * k = sizeS * (r - k)); 1: by ring. - split; 1: smt (WS.gt0_size). - by move=> ?;apply ler_pemulr => // /#. - qed. - - op x86_VPADD_'Ru'S (w1 : WB.t) (w2:WB.t) = - map2 WS.(+) w1 w2. - -(* op x86_VPSUB_'Ru'S (w1 : WB.t) (w2:WB.t) = - map2 (fun (x y:WS.t) => x - y) w1 w2. - - op x86_VPMUL_'Ru'S (w1 : WB.t) (w2:WB.t) = - map2 WS.( * ) w1 w2. *) - - op x86_VPSLL_'Ru'S (w : WB.t) (cnt : W8.t) = - map (fun (w:WS.t) => w `<<` cnt) w. - - op x86_VPSRL_'Ru'S (w : WB.t) (cnt : W8.t) = - map (fun (w:WS.t) => w `>>` cnt) w. - - op x86_VPBROADCAST_'Ru'S (w: WS.t) = - pack'R (map (fun i => w) (iota_ 0 r)). - - lemma x86_'Ru'S_rol_xor i w : 0 < i < sizeS => - x86_VPSLL_'Ru'S w (W8.of_int i) +^ x86_VPSRL_'Ru'S w (W8.of_int (sizeS - i)) = - map (fun w0 => WS.rol w0 i) w. - proof. - move=> hr;rewrite /x86_VPSRL_'Ru'S /x86_VPSLL_'Ru'S. - rewrite /map;apply wordP => j hj. - by rewrite xorb'SE !pack'RbE 1..3:// !mapiE 1..3:// /= rol_xor_shft. - qed. - - lemma x86_'Ru'S_rol_xor_red w1 w2 i si: - w1 = w2 => W8.to_uint si = sizeS - W8.to_uint i => 0 < W8.to_uint i < sizeS => - x86_VPSLL_'Ru'S w1 i +^ x86_VPSRL_'Ru'S w2 si = - map (fun w0 => WS.rol w0 (W8.to_uint i)) w1. - proof. - by move=> -> hsi hi; rewrite -(W8.to_uintK i) -(W8.to_uintK si) hsi x86_'Ru'S_rol_xor. - qed. - - hint simplify x86_'Ru'S_rol_xor_red. - -end W_WS. - -abstract theory BitWordSH. - op size : int. - axiom size_le_256 : size <= 256. - clone include BitWord with op size <- size. - - op (`>>`) (w1 : t) (w2 : W8.t) = w1 `>>>` (to_uint w2 %% size). - op (`<<`) (w1 : t) (w2 : W8.t) = w1 `<<<` (to_uint w2 %% size). - - lemma shr_div w1 w2 : to_uint (w1 `>>` w2) = to_uint w1 %/ 2^ (to_uint w2 %% size). - proof. - rewrite -{1}(to_uintK w1) /(`>>`) shrDP; 1: smt (modz_cmp gt0_size). - rewrite of_uintK to_uint_mod modz_small 2://. - apply bound_abs; apply divz_cmp; 1: by apply gt0_pow2. - by have:= to_uint_cmp w1; smt (gt0_pow2). - qed. - - lemma shr_div_le w1 i : 0 <= i < size => - to_uint (w1 `>>` (W8.of_int i)) = to_uint w1 %/ 2^ i. - proof. - move=> hi;rewrite shr_div of_uintK. - rewrite (modz_small i) 1:pow2_8; 1: smt (size_le_256). - by rewrite modz_small //;apply bound_abs. - qed. - - lemma rol_xor_shft w i : 0 < i < size => - rol w i = (w `<<` W8.of_int i) +^ (w `>>` W8.of_int (size - i)). - proof. - move=> hi; rewrite /(`<<`) /(`>>`) !W8.of_uintK. - have h : 0 <= i < `|W8.modulus|. - + by rewrite /=; smt (size_le_256). - rewrite !(modz_small _ W8.modulus) 1:// 1:[smt (size_le_256)] !modz_small 1,2:/#. - by rewrite rol_xor 1:/#. - qed. - -end BitWordSH. - -theory W16. - abbrev [-printing] size = 16. - clone include BitWordSH with op size <- size - proof gt0_size by done, - size_le_256 by done. -end W16. export W16. - -clone export W_WS as W2u8 with - op sizeS <- W8.size, op sizeB <- W16.size, op r <- 2, - theory WS <- W8, theory WB <- W16 - proof gt0_r by done, sizeBrS by done - rename [op, lemma] "'Ru'S" as "2u8" "'R" as "2" "'S" as "8" "'B" as "16" . - -theory W32. - abbrev [-printing] size = 32. - clone include BitWordSH with op size <- size - proof gt0_size by done, - size_le_256 by done. -end W32. export W32. - -clone export W_WS as W4u8 with - op sizeS <- W8.size, op sizeB <- W32.size, op r <- 4, - theory WS <- W8, theory WB <- W32 - proof gt0_r by done, sizeBrS by done - rename [op, lemma] "'Ru'S" as "4u8" "'R" as "4" "'S" as "8" "'B" as "32". - -clone export W_WS as W2u16 with - op sizeS <- W16.size, op sizeB <- W32.size, op r <- 2, - theory WS <- W16, theory WB <- W32 - proof gt0_r by done, sizeBrS by done - rename [op, lemma] "'Ru'S" as "2u16" "'R" as "2" "'S" as "16" "'B" as "32". - -theory W64. - abbrev [-printing] size = 64. - clone include BitWordSH with op size <- size - proof gt0_size by done, - size_le_256 by done. -end W64. export W64. - -clone export W_WS as W8u8 with - op sizeS <- W8.size, op sizeB <- W64.size, op r <- 8, - theory WS <- W8, theory WB <- W64 - proof gt0_r by done, sizeBrS by done - rename [op, lemma] "'Ru'S" as "8u8" "'R" as "8" "'S" as "8" "'B" as "64". - -clone export W_WS as W4u16 with - op sizeS <- W16.size, op sizeB <- W64.size, op r <- 4, - theory WS <- W16, theory WB <- W64 - proof gt0_r by done, sizeBrS by done - rename [op, lemma] "'Ru'S" as "4u16" "'R" as "4" "'S" as "16" "'B" as "64". - -clone export W_WS as W2u32 with - op sizeS <- W32.size, op sizeB <- W64.size, op r <- 2, - theory WS <- W32, theory WB <- W64 - proof gt0_r by done, sizeBrS by done - rename [op, lemma] "'Ru'S" as "2u32" "'R" as "2" "'S" as "32" "'B" as "64". - -theory W128. - abbrev [-printing] size = 128. - clone include BitWordSH with op size <- size - proof gt0_size by done, - size_le_256 by done. -end W128. export W128. - -clone export W_WS as W16u8 with - op sizeS <- W8.size, op sizeB <- W128.size, op r <- 16, - theory WS <- W8, theory WB <- W128 - proof gt0_r by done, sizeBrS by done - rename [op, lemma] "'Ru'S" as "16u8" "'R" as "16" "'S" as "8" "'B" as "128". - -clone export W_WS as W8u16 with - op sizeS <- W16.size, op sizeB <- W128.size, op r <- 8, - theory WS <- W16, theory WB <- W128 - proof gt0_r by done, sizeBrS by done - rename [op, lemma] "'Ru'S" as "8u16" "'R" as "8" "'S" as "16" "'B" as "128". - -clone export W_WS as W4u32 with - op sizeS <- W32.size, op sizeB <- W128.size, op r <- 4, - theory WS <- W32, theory WB <- W128 - proof gt0_r by done, sizeBrS by done - rename [op, lemma] "'Ru'S" as "4u32" "'R" as "4" "'S" as "32" "'B" as "128". - -clone export W_WS as W2u64 with - op sizeS <- W64.size, op sizeB <- W128.size, op r <- 2, - theory WS <- W64, theory WB <- W128 - proof gt0_r by done, sizeBrS by done - rename [op, lemma] "'Ru'S" as "2u64" "'R" as "2" "'S" as "64" "'B" as "128". - -theory W256. - abbrev [-printing] size = 256. - clone include BitWordSH with op size <- size - proof gt0_size by done, - size_le_256 by done. -end W256. export W256. - -clone export W_WS as W32u8 with - op sizeS <- W8.size, op sizeB <- W256.size, op r <- 32, - theory WS <- W8, theory WB <- W256 - proof gt0_r by done, sizeBrS by done - rename [op, lemma] "'Ru'S" as "32u8" "'R" as "32" "'S" as "8" "'B" as "256". - -clone export W_WS as W16u16 with - op sizeS <- W16.size, op sizeB <- W256.size, op r <- 16, - theory WS <- W16, theory WB <- W256 - proof gt0_r by done, sizeBrS by done - rename [op, lemma] "'Ru'S" as "16u16" "'R" as "16" "'S" as "16" "'B" as "256". - -clone export W_WS as W8u32 with - op sizeS <- W32.size, op sizeB <- W256.size, op r <- 8, - theory WS <- W32, theory WB <- W256 - proof gt0_r by done, sizeBrS by done - rename [op, lemma] "'Ru'S" as "8u32" "'R" as "8" "'S" as "32" "'B" as "256". - -clone export W_WS as W4u64 with - op sizeS <- W64.size, op sizeB <- W256.size, op r <- 4, - theory WS <- W64, theory WB <- W256 - proof gt0_r by done, sizeBrS by done - rename [op, lemma] "'Ru'S" as "4u64" "'R" as "4" "'S" as "64" "'B" as "256". - -clone export W_WS as W2u128 with - op sizeS <- W128.size, op sizeB <- W256.size, op r <- 2, - theory WS <- W128, theory WB <- W256 - proof gt0_r by done, sizeBrS by done - rename [op, lemma] "'Ru'S" as "2u128" "'R" as "2" "'S" as "128" "'B" as "256". - - -(* -------------------------------------------------------------------- *) -(* Word size *) - -type wsize = [ - | W8 - | W16 - | W32 - | W64 - | W128 - | W256 -]. - -op wsize_i (w:wsize) = - with w = W8 => 1 - with w = W16 => 2 - with w = W32 => 4 - with w = W64 => 8 - with w = W128 => 16 - with w = W256 => 32. - -(* TODO move *) -lemma gt0_wsize_i ws: 0 < wsize_i ws. -proof. by case ws. qed. -hint exact : gt0_wsize_i. - -lemma div_le_wsize ws1 ws2 : wsize_i ws1 <= wsize_i ws2 => wsize_i ws1 %| wsize_i ws2. -proof. by case: ws1 ws2 => -[]. qed. - -lemma div_wsize_modulus ws : wsize_i ws %| W64.modulus. -proof. by case ws. qed. -hint exact : div_wsize_modulus. - -(* -lemma foo (x y:W128.t) (x1 x2 y1 y2:W64.t): - x = pack2 [x1; x2] => - y = pack2 [y1; y2] => - map2 W64.( + ) x y = pack2 [x1 + y1; x2 + y2]. -proof. by move=> -> -> /=. qed. - -op bits_eq (w:W128.t) xs = - all (fun (ix:int * W64.t) => w \bits64 ix.`1 = ix.`2) - (zip (iota_ 0 (size xs)) xs). - -lemma foo1 (x y:W128.t) (x0 x1 y0 y1:W64.t): - (bits_eq x [x0; x1]) => - (bits_eq y [y0; y1]) => - (bits_eq (map2 W64.( + ) x y) [x0 + y0; x1 + y1]). -proof. rewrite /bits_eq /= => />. qed. - -lemma foo (x y:W128.t) (x1 x2 y1 y2:W64.t): - x = pack2 [x1; x2] => - y = pack2 [y1; y2] => - x `|` y = pack2 [x1 `|` y1; x2 `|` y2]. -proof. move=> -> -> /=. -*) - -lemma divmod_mul n d i j : - 0 < n => - 0 <= j < d => - (i * d + j) %/ (n * d) = i%/ n /\ (i * d + j) %% (n * d) = i %% n * d + j. -proof. - move=> hn hj. - have -> : i * d + j = (i %/ n) * (n * d) + (d * (i %% n) + j). - + have [h1 h2]:= edivzP i n. - by rewrite {1 2} h1 divzMDl 1:/# (divz_small (i%%n) n) 1:/# /=; ring. - rewrite divzMDl 1:/# modzMDl. - have hb: 0 <= d * (i %% n) + j < `|n * d|. - + have := modz_cmp i n hn. - have -> : `|n * d| = n * d by smt(). - have -> h : n * d = (n-1) * d + d by ring. - split;1: smt(); move=> ?. - apply ler_lt_add; 2:smt(). - by rewrite mulzC ler_pmul2r /#. - by rewrite (divz_small _ (n*d)) 1:// (modz_small _ (n*d)) 1:// /=; ring. -qed. - -(* --------------------------------------------------------------------------------- *) -(* Lemmas on \bits8 *) -(* --------------------------------------------------------------------------------- *) - -lemma bits8_W2u16 ws i : - W2u16.pack2_t ws \bits8 i = if 0 <= i < 4 then ws.[i%/2] \bits8 (i%%2) else W8.zero. -proof. - apply W8.wordP => j hj; rewrite !bits8iE 1,2://. - case: (0 <= i < 4) => /= hi; last by rewrite W32.get_out 1:/#. - rewrite pack2wE 1:/#; have /= [-> ->] := divmod_mul 2 8 i j _ hj; 1 :done; rewrite W2u8.bits8iE 1:// /#. -qed. - -lemma bits8_W2u16_red ws i : - 0 <= i < 4 => W2u16.pack2_t ws \bits8 i = ws.[i%/2] \bits8 (i%%2). -proof. by move=> h;rewrite bits8_W2u16 h. qed. - -lemma bits8_W4u16 ws i : - W4u16.pack4_t ws \bits8 i = if 0 <= i < 8 then ws.[i%/2] \bits8 (i%%2) else W8.zero. -proof. - apply W8.wordP => j hj; rewrite !bits8iE 1,2://. - case: (0 <= i < 8) => /= hi; last by rewrite W64.get_out 1:/#. - rewrite pack4wE 1:/#; have /= [-> ->] := divmod_mul 2 8 i j _ hj; 1:done; rewrite W2u8.bits8iE 1:// /#. -qed. - -lemma bits8_W4u16_red ws i : - 0 <= i < 8 => W4u16.pack4_t ws \bits8 i = ws.[i%/2] \bits8 (i%%2). -proof. by move=> h;rewrite bits8_W4u16 h. qed. - -lemma bits8_W8u16 ws i : - W8u16.pack8_t ws \bits8 i = if 0 <= i < 16 then ws.[i%/2] \bits8 (i%%2) else W8.zero. -proof. - apply W8.wordP => j hj; rewrite !bits8iE 1,2://. - case: (0 <= i < 16) => /= hi; last by rewrite W128.get_out 1:/#. - rewrite pack8wE 1:/#; have [-> ->] := divmod_mul 2 8 i j _ hj; 1: done; rewrite W2u8.bits8iE 1:// /#. -qed. - -lemma bits8_W8u16_red ws i : - 0 <= i < 16 => W8u16.pack8_t ws \bits8 i = ws.[i%/2] \bits8 (i%%2). -proof. by move=> h;rewrite bits8_W8u16 h. qed. - -lemma bits8_W16u16 ws i : - W16u16.pack16_t ws \bits8 i = if 0 <= i < 32 then ws.[i%/2] \bits8 (i%%2) else W8.zero. -proof. - apply W8.wordP => j hj; rewrite !bits8iE 1,2://. - case: (0 <= i < 32) => /= hi; last by rewrite W256.get_out 1:/#. - rewrite pack16wE 1:/#; have [-> ->] := divmod_mul 2 8 i j _ hj; 1: done; rewrite W2u8.bits8iE 1:// /#. -qed. - -lemma bits8_W16u16_red ws i : - 0 <= i < 32 => W16u16.pack16_t ws \bits8 i = ws.[i%/2] \bits8 (i%%2). -proof. by move=> h;rewrite bits8_W16u16 h. qed. - -hint simplify bits8_W2u16_red, bits8_W4u16_red, bits8_W8u16_red, bits8_W16u16_red. - -lemma bits8_W2u32 ws i : - W2u32.pack2_t ws \bits8 i = if 0 <= i < 8 then ws.[i%/4] \bits8 (i%%4) else W8.zero. -proof. - apply W8.wordP => j hj; rewrite !bits8iE 1,2://. - case: (0 <= i < 8) => /= hi; last by rewrite W64.get_out 1:/#. - rewrite pack2wE 1:/#; have /= [-> ->] := divmod_mul 4 8 i j _ hj; 1: done; rewrite W4u8.bits8iE 1:// /#. -qed. - -lemma bits8_W2u32_red ws i : - 0 <= i < 8 => W2u32.pack2_t ws \bits8 i = ws.[i%/4] \bits8 (i%%4). -proof. by move=> h;rewrite bits8_W2u32 h. qed. - -lemma bits8_W4u32 ws i : - W4u32.pack4_t ws \bits8 i = if 0 <= i < 16 then ws.[i%/4] \bits8 (i%%4) else W8.zero. -proof. - apply W8.wordP => j hj; rewrite !bits8iE 1,2://. - case: (0 <= i < 16) => /= hi; last by rewrite W128.get_out 1:/#. - rewrite pack4wE 1:/#; have /= [-> ->] := divmod_mul 4 8 i j _ hj; 1: done; rewrite W4u8.bits8iE 1:// /#. -qed. - -lemma bits8_W4u32_red ws i : - 0 <= i < 16 => W4u32.pack4_t ws \bits8 i = ws.[i%/4] \bits8 (i%%4). -proof. by move=> h;rewrite bits8_W4u32 h. qed. - -lemma bits8_W8u32 ws i : - W8u32.pack8_t ws \bits8 i = if 0 <= i < 32 then ws.[i%/4] \bits8 (i%%4) else W8.zero. -proof. - apply W8.wordP => j hj; rewrite !bits8iE 1,2://. - case: (0 <= i < 32) => /= hi; last by rewrite W256.get_out 1:/#. - rewrite pack8wE 1:/#; have /= [-> ->] := divmod_mul 4 8 i j _ hj; 1: done; rewrite W4u8.bits8iE 1:// /#. -qed. - -lemma bits8_W8u32_red ws i : - 0 <= i < 32 => W8u32.pack8_t ws \bits8 i = ws.[i%/4] \bits8 (i%%4). -proof. by move=> h;rewrite bits8_W8u32 h. qed. - -hint simplify bits8_W2u32_red, bits8_W4u32_red, bits8_W8u32_red. - -lemma bits8_W2u64 ws i : - W2u64.pack2_t ws \bits8 i = if 0 <= i < 16 then ws.[i%/8] \bits8 (i%%8) else W8.zero. -proof. - apply W8.wordP => j hj; rewrite !bits8iE 1,2://. - case: (0 <= i < 16) => /= hi; last by rewrite W128.get_out 1:/#. - rewrite pack2wE 1:/#; have /= [-> ->] := divmod_mul 8 8 i j _ hj; 1: done; rewrite W8u8.bits8iE 1:// /#. -qed. - -lemma bits8_W2u64_red ws i : - 0 <= i < 16 => W2u64.pack2_t ws \bits8 i = ws.[i%/8] \bits8 (i%%8). -proof. by move=> h;rewrite bits8_W2u64 h. qed. - -lemma bits8_W4u64 ws i : - W4u64.pack4_t ws \bits8 i = if 0 <= i < 32 then ws.[i%/8] \bits8 (i%%8) else W8.zero. -proof. - apply W8.wordP => j hj; rewrite !bits8iE 1,2://. - case: (0 <= i < 32) => /= hi; last by rewrite W256.get_out 1:/#. - rewrite pack4wE 1:/#; have /= [-> ->] := divmod_mul 8 8 i j _ hj; 1: done; rewrite W8u8.bits8iE 1:// /#. -qed. - -lemma bits8_W4u64_red ws i : - 0 <= i < 32 => W4u64.pack4_t ws \bits8 i = ws.[i%/8] \bits8 (i%%8). -proof. by move=> h;rewrite bits8_W4u64 h. qed. - -hint simplify bits8_W2u64_red, bits8_W4u64_red. - -lemma bits8_W2u128 ws i : - W2u128.pack2_t ws \bits8 i = if 0 <= i < 32 then ws.[i%/16] \bits8 (i%%16) else W8.zero. -proof. - apply W8.wordP => j hj; rewrite !bits8iE 1,2://. - case: (0 <= i < 32) => /= hi; last by rewrite W256.get_out 1:/#. - rewrite pack2wE 1:/#; have /= [-> ->] := divmod_mul 16 8 i j _ hj; 1: done; rewrite W16u8.bits8iE 1:// /#. -qed. - -lemma bits8_W2u128_red ws i : - 0 <= i < 32 => W2u128.pack2_t ws \bits8 i = ws.[i%/16] \bits8 (i%%16). -proof. by move=> h;rewrite bits8_W2u128 h. qed. - -hint simplify bits8_W2u128_red. - -lemma W32_bits16_bits8 (w:W32.t) i j: 0 <= j < 2 => w \bits16 i \bits8 j = w \bits8 (2 * i + j). -proof. - move=> hj; apply W8.wordP => k hk. - by rewrite !bits8iE 1,2:// bits16iE 1:/#; congr; ring. -qed. - -lemma W64_bits16_bits8 (w:W64.t) i j: 0 <= j < 2 => w \bits16 i \bits8 j = w \bits8 (2 * i + j). -proof. - move=> hj; apply W8.wordP => k hk. - by rewrite !bits8iE 1,2:// bits16iE 1:/#; congr; ring. -qed. - -lemma W128_bits16_bits8 (w:W128.t) i j: 0 <= j < 2 => w \bits16 i \bits8 j = w \bits8 (2 * i + j). -proof. - move=> hj; apply W8.wordP => k hk. - by rewrite !bits8iE 1,2:// bits16iE 1:/#; congr; ring. -qed. - -lemma W256_bits16_bits8 (w:W256.t) i j: 0 <= j < 2 => w \bits16 i \bits8 j = w \bits8 (2 * i + j). -proof. - move=> hj; apply W8.wordP => k hk. - by rewrite !bits8iE 1,2:// bits16iE 1:/#; congr; ring. -qed. - -hint simplify W32_bits16_bits8, W64_bits16_bits8, W128_bits16_bits8, W256_bits16_bits8. - -lemma W64_bits32_bits8 (w:W64.t) i j: 0 <= j < 4 => w \bits32 i \bits8 j = w \bits8 (4 * i + j). -proof. - move=> hj; apply W8.wordP => k hk. - by rewrite !bits8iE 1,2:// bits32iE 1:/#; congr; ring. -qed. - -lemma W128_bits32_bits8 (w:W128.t) i j: 0 <= j < 4 => w \bits32 i \bits8 j = w \bits8 (4 * i + j). -proof. - move=> hj; apply W8.wordP => k hk. - by rewrite !bits8iE 1,2:// bits32iE 1:/#; congr; ring. -qed. - -lemma W256_bits32_bits8 (w:W256.t) i j: 0 <= j < 4 => w \bits32 i \bits8 j = w \bits8 (4 * i + j). -proof. - move=> hj; apply W8.wordP => k hk. - by rewrite !bits8iE 1,2:// bits32iE 1:/#; congr; ring. -qed. - -hint simplify W64_bits32_bits8, W128_bits32_bits8, W256_bits32_bits8. - -lemma W128_bits64_bits8 (w:W128.t) i j: 0 <= j < 8 => w \bits64 i \bits8 j = w \bits8 (8 * i + j). -proof. - move=> hj; apply W8.wordP => k hk. - by rewrite !bits8iE 1,2:// bits64iE 1:/#; congr; ring. -qed. - -lemma W256_bits64_bits8 (w:W256.t) i j: 0 <= j < 8 => w \bits64 i \bits8 j = w \bits8 (8 * i + j). -proof. - move=> hj; apply W8.wordP => k hk. - by rewrite !bits8iE 1,2:// bits64iE 1:/#; congr; ring. -qed. - -hint simplify W128_bits64_bits8, W256_bits64_bits8. - -lemma W256_bits128_bits8 (w:W256.t) i j: 0 <= j < 16 => w \bits128 i \bits8 j = w \bits8 (16 * i + j). -proof. - move=> hj; apply W8.wordP => k hk. - by rewrite !bits8iE 1,2:// bits128iE 1:/#; congr; ring. -qed. - -hint simplify W256_bits128_bits8. - -(* --------------------------------------------------------------------------------- *) -(* Lemmas on \bits16 *) -(* --------------------------------------------------------------------------------- *) - -lemma bits16_W4u8 ws i : - W4u8.pack4_t ws \bits16 i = if 0 <= i < 2 then W2u8.pack2 [ws.[2 * i]; ws.[2 * i + 1]] else W16.zero. -proof. - apply W2u8.wordP => j hj. - rewrite W32_bits16_bits8 1://. - case: (0 <= i < 2) => hi; last by rewrite W2u8.get_zero W4u8.get_out 1:/#. - rewrite /= W2u8.pack2bE 1:// /= W4u8.pack4bE 1:/#. - by have []-> : j = 0 \/ j = 1 by smt(). -qed. - -lemma bits16_W4u8_red ws i : - 0 <= i < 2 => W4u8.pack4_t ws \bits16 i = W2u8.pack2 [ws.[2 * i]; ws.[2 * i + 1]]. -proof. by move=> h;rewrite bits16_W4u8 h. qed. - -lemma bits16_W8u8 ws i : - W8u8.pack8_t ws \bits16 i = if 0 <= i < 4 then W2u8.pack2 [ws.[2 * i]; ws.[2 * i + 1]] else W16.zero. -proof. - apply W2u8.wordP => j hj. - rewrite W64_bits16_bits8 1://. - case: (0 <= i < 4) => hi; last by rewrite W2u8.get_zero W8u8.get_out 1:/#. - rewrite /= W2u8.pack2bE 1:// /= W8u8.pack8bE 1:/#. - have []-> //: j = 0 \/ j = 1 by smt(). -qed. - -lemma bits16_W8u8_red ws i : - 0 <= i < 4 => W8u8.pack8_t ws \bits16 i = W2u8.pack2 [ws.[2 * i]; ws.[2 * i + 1]]. -proof. by move=> h;rewrite bits16_W8u8 h. qed. - -lemma bits16_W16u8 ws i : - W16u8.pack16_t ws \bits16 i = if 0 <= i < 8 then W2u8.pack2 [ws.[2 * i]; ws.[2 * i + 1]] else W16.zero. -proof. - apply W2u8.wordP => j hj. - rewrite W128_bits16_bits8 1://. - case: (0 <= i < 8) => hi; last by rewrite W2u8.get_zero W16u8.get_out 1:/#. - rewrite /= W2u8.pack2bE 1:// /= W16u8.pack16bE 1:/#. - have []-> //: j = 0 \/ j = 1 by smt(). -qed. - -lemma bits16_W16u8_red ws i : - 0 <= i < 8 => W16u8.pack16_t ws \bits16 i = W2u8.pack2 [ws.[2 * i]; ws.[2 * i + 1]]. -proof. by move=> h;rewrite bits16_W16u8 h. qed. - -lemma bits16_W32u8 ws i : - W32u8.pack32_t ws \bits16 i = if 0 <= i < 16 then W2u8.pack2 [ws.[2 * i]; ws.[2 * i + 1]] else W16.zero. -proof. - apply W2u8.wordP => j hj. - rewrite W256_bits16_bits8 1://. - case: (0 <= i < 16) => hi; last by rewrite W2u8.get_zero W32u8.get_out 1:/#. - rewrite /= W2u8.pack2bE 1:// /= W32u8.pack32bE 1:/#. - have []-> //: j = 0 \/ j = 1 by smt(). -qed. - -lemma bits16_W32u8_red ws i : - 0 <= i < 16 => W32u8.pack32_t ws \bits16 i = W2u8.pack2 [ws.[2 * i]; ws.[2 * i + 1]]. -proof. by move=> h;rewrite bits16_W32u8 h. qed. - -hint simplify bits16_W4u8_red, bits16_W8u8_red, bits16_W16u8_red, bits16_W32u8. - -lemma bits16_W2u32 ws i : - W2u32.pack2_t ws \bits16 i = if 0 <= i < 4 then ws.[i%/2] \bits16 (i%%2) else W16.zero. -proof. - apply W16.wordP => j hj; rewrite !bits16iE 1,2://. - case: (0 <= i < 4) => /= hi; last by rewrite W64.get_out 1:/#. - rewrite pack2wE 1:/#; have /= [-> ->] := divmod_mul 2 16 i j _ hj; 1: done; rewrite W2u16.bits16iE 1:// /#. -qed. - -lemma bits16_W2u32_red ws i : - 0 <= i < 4 => W2u32.pack2_t ws \bits16 i = ws.[i%/2] \bits16 (i%%2). -proof. by move=> h;rewrite bits16_W2u32 h. qed. - -lemma bits16_W4u32 ws i : - W4u32.pack4_t ws \bits16 i = if 0 <= i < 8 then ws.[i%/2] \bits16 (i%%2) else W16.zero. -proof. - apply W16.wordP => j hj; rewrite !bits16iE 1,2://. - case: (0 <= i < 8) => /= hi; last by rewrite W128.get_out 1:/#. - rewrite pack4wE 1:/#; have /= [-> ->] := divmod_mul 2 16 i j _ hj; 1: done; rewrite W2u16.bits16iE 1:// /#. -qed. - -lemma bits16_W4u32_red ws i : - 0 <= i < 8 => W4u32.pack4_t ws \bits16 i = ws.[i%/2] \bits16 (i%%2). -proof. by move=> h;rewrite bits16_W4u32 h. qed. - -lemma bits16_W8u32 ws i : - W8u32.pack8_t ws \bits16 i = if 0 <= i < 16 then ws.[i%/2] \bits16 (i%%2) else W16.zero. -proof. - apply W16.wordP => j hj; rewrite !bits16iE 1,2://. - case: (0 <= i < 16) => /= hi; last by rewrite W256.get_out 1:/#. - rewrite pack8wE 1:/#; have /= [-> ->] := divmod_mul 2 16 i j _ hj; 1: done; rewrite W2u16.bits16iE 1:// /#. -qed. - -lemma bits16_W8u32_red ws i : - 0 <= i < 16 => W8u32.pack8_t ws \bits16 i = ws.[i%/2] \bits16 (i%%2). -proof. by move=> h;rewrite bits16_W8u32 h. qed. - -hint simplify bits16_W2u32_red, bits16_W4u32_red, bits16_W8u32_red. - -lemma bits16_W2u64 ws i : - W2u64.pack2_t ws \bits16 i = if 0 <= i < 8 then ws.[i%/4] \bits16 (i%%4) else W16.zero. -proof. - apply W16.wordP => j hj; rewrite !bits16iE 1,2://. - case: (0 <= i < 8) => /= hi; last by rewrite W128.get_out 1:/#. - rewrite pack2wE 1:/#; have /= [-> ->] := divmod_mul 4 16 i j _ hj; 1: done; rewrite W4u16.bits16iE 1:// /#. -qed. - -lemma bits16_W2u64_red ws i : - 0 <= i < 8 => W2u64.pack2_t ws \bits16 i = ws.[i%/4] \bits16 (i%%4). -proof. by move=> h;rewrite bits16_W2u64 h. qed. - -lemma bits16_W4u64 ws i : - W4u64.pack4_t ws \bits16 i = if 0 <= i < 16 then ws.[i%/4] \bits16 (i%%4) else W16.zero. -proof. - apply W16.wordP => j hj; rewrite !bits16iE 1,2://. - case: (0 <= i < 16) => /= hi; last by rewrite W256.get_out 1:/#. - rewrite pack4wE 1:/#; have /= [-> ->] := divmod_mul 4 16 i j _ hj; 1: done; rewrite W4u16.bits16iE 1:// /#. -qed. - -lemma bits16_W4u64_red ws i : - 0 <= i < 16 => W4u64.pack4_t ws \bits16 i = ws.[i%/4] \bits16 (i%%4). -proof. by move=> h;rewrite bits16_W4u64 h. qed. - -hint simplify bits16_W2u64_red, bits16_W4u64_red. - -lemma bits16_W2u128 ws i : - W2u128.pack2_t ws \bits16 i = if 0 <= i < 16 then ws.[i%/8] \bits16 (i%%8) else W16.zero. -proof. - apply W16.wordP => j hj; rewrite !bits16iE 1,2://. - case: (0 <= i < 16) => /= hi; last by rewrite W256.get_out 1:/#. - rewrite pack2wE 1:/#; have /= [-> ->] := divmod_mul 8 16 i j _ hj; 1: done; rewrite W8u16.bits16iE 1:// /#. -qed. - -lemma bits16_W2u128_red ws i : - 0 <= i < 16 => W2u128.pack2_t ws \bits16 i = ws.[i%/8] \bits16 (i%%8). -proof. by move=> h;rewrite bits16_W2u128 h. qed. - -hint simplify bits16_W2u128_red. - -lemma W64_bits32_bits16 (w:W64.t) i j: 0 <= j < 2 => w \bits32 i \bits16 j = w \bits16 (2 * i + j). -proof. - move=> hj; apply W16.wordP => k hk. - by rewrite !bits16iE 1,2:// bits32iE 1:/#; congr; ring. -qed. - -lemma W128_bits32_bits16 (w:W128.t) i j: 0 <= j < 2 => w \bits32 i \bits16 j = w \bits16 (2 * i + j). -proof. - move=> hj; apply W16.wordP => k hk. - by rewrite !bits16iE 1,2:// bits32iE 1:/#; congr; ring. -qed. - -lemma W256_bits32_bits16 (w:W256.t) i j: 0 <= j < 2 => w \bits32 i \bits16 j = w \bits16 (2 * i + j). -proof. - move=> hj; apply W16.wordP => k hk. - by rewrite !bits16iE 1,2:// bits32iE 1:/#; congr; ring. -qed. - -hint simplify W64_bits32_bits16, W128_bits32_bits16, W256_bits32_bits16. - -lemma W128_bits64_bits16 (w:W128.t) i j: 0 <= j < 4 => w \bits64 i \bits16 j = w \bits16 (4 * i + j). -proof. - move=> hj; apply W16.wordP => k hk. - by rewrite !bits16iE 1,2:// bits64iE 1:/#; congr; ring. -qed. - -lemma W256_bits64_bits16 (w:W256.t) i j: 0 <= j < 4 => w \bits64 i \bits16 j = w \bits16 (4 * i + j). -proof. - move=> hj; apply W16.wordP => k hk. - by rewrite !bits16iE 1,2:// bits64iE 1:/#; congr; ring. -qed. - -lemma W256_bits128_bits16 (w:W256.t) i j: 0 <= j < 8 => w \bits128 i \bits16 j = w \bits16 (8 * i + j). -proof. - move=> hj; apply W16.wordP => k hk. - by rewrite !bits16iE 1,2:// bits128iE 1:/#; congr; ring. -qed. - -hint simplify W128_bits64_bits16, W256_bits64_bits16, W256_bits128_bits16. - -(* --------------------------------------------------------------------------------- *) -(* Lemmas on \bits32 *) -(* --------------------------------------------------------------------------------- *) - -lemma bits32_W8u8 ws i : - W8u8.pack8_t ws \bits32 i = - if 0 <= i < 2 then W4u8.pack4 [ws.[4 * i]; ws.[4 * i + 1]; ws.[4 * i + 2]; ws.[4 * i + 3] ] else W32.zero. -proof. - apply W4u8.wordP => j hj. - rewrite W64_bits32_bits8 1://. - case: (0 <= i < 2) => hi; last by rewrite W4u8.get_zero W8u8.get_out 1:/#. - rewrite /= W4u8.pack4bE 1:// /= W8u8.pack8bE 1:/#. - by have [|[|[|]]]-> : j = 0 \/ j = 1 \/ j = 2 \/ j = 3 by smt(). -qed. - -lemma bits32_W8u8_red ws i : - 0 <= i < 2 => - W8u8.pack8_t ws \bits32 i = - W4u8.pack4 [ws.[4 * i]; ws.[4 * i + 1]; ws.[4 * i + 2]; ws.[4 * i + 3] ]. -proof. by move=> h;rewrite bits32_W8u8 h. qed. - -lemma bits32_W16u8 ws i : - W16u8.pack16_t ws \bits32 i = - if 0 <= i < 4 then W4u8.pack4 [ws.[4 * i]; ws.[4 * i + 1]; ws.[4 * i + 2]; ws.[4 * i + 3] ] else W32.zero. -proof. - apply W4u8.wordP => j hj. - rewrite W128_bits32_bits8 1://. - case: (0 <= i < 4) => hi; last by rewrite W4u8.get_zero W16u8.get_out 1:/#. - rewrite /= W4u8.pack4bE 1:// /= W16u8.pack16bE 1:/#. - by have [|[|[|]]]-> : j = 0 \/ j = 1 \/ j = 2 \/ j = 3 by smt(). -qed. - -lemma bits32_W16u8_red ws i : - 0 <= i < 4 => - W16u8.pack16_t ws \bits32 i = - W4u8.pack4 [ws.[4 * i]; ws.[4 * i + 1]; ws.[4 * i + 2]; ws.[4 * i + 3] ]. -proof. by move=> h;rewrite bits32_W16u8 h. qed. - -lemma bits32_W32u8 ws i : - W32u8.pack32_t ws \bits32 i = - if 0 <= i < 8 then W4u8.pack4 [ws.[4 * i]; ws.[4 * i + 1]; ws.[4 * i + 2]; ws.[4 * i + 3] ] else W32.zero. -proof. - apply W4u8.wordP => j hj. - rewrite W256_bits32_bits8 1://. - case: (0 <= i < 8) => hi; last by rewrite W4u8.get_zero W32u8.get_out 1:/#. - rewrite /= W4u8.pack4bE 1:// /= W32u8.pack32bE 1:/#. - by have [|[|[|]]]-> : j = 0 \/ j = 1 \/ j = 2 \/ j = 3 by smt(). -qed. - -lemma bits32_W32u8_red ws i : - 0 <= i < 8 => - W32u8.pack32_t ws \bits32 i = - W4u8.pack4 [ws.[4 * i]; ws.[4 * i + 1]; ws.[4 * i + 2]; ws.[4 * i + 3] ]. -proof. by move=> h;rewrite bits32_W32u8 h. qed. - -hint simplify bits32_W8u8_red, bits32_W16u8_red, bits32_W32u8_red. - -lemma bits32_W4u16 ws i : - W4u16.pack4_t ws \bits32 i = - if 0 <= i < 2 then W2u16.pack2 [ws.[2 * i]; ws.[2 * i + 1]] else W32.zero. -proof. - apply W2u16.wordP => j hj. - rewrite W64_bits32_bits16 1://. - case: (0 <= i < 2) => hi; last by rewrite W2u16.get_zero W4u16.get_out 1:/#. - rewrite /= W2u16.pack2bE 1:// /= W4u16.pack4bE 1:/#. - by have []-> : j = 0 \/ j = 1 by smt(). -qed. - -lemma bits32_W4u16_red ws i : - 0 <= i < 2 => - W4u16.pack4_t ws \bits32 i = W2u16.pack2 [ws.[2 * i]; ws.[2 * i + 1]]. -proof. by move=> h;rewrite bits32_W4u16 h. qed. - -lemma bits32_W8u16 ws i : - W8u16.pack8_t ws \bits32 i = - if 0 <= i < 4 then W2u16.pack2 [ws.[2 * i]; ws.[2 * i + 1]] else W32.zero. -proof. - apply W2u16.wordP => j hj. - rewrite W128_bits32_bits16 1://. - case: (0 <= i < 4) => hi; last by rewrite W2u16.get_zero W8u16.get_out 1:/#. - rewrite /= W2u16.pack2bE 1:// /= W8u16.pack8bE 1:/#. - by have []-> : j = 0 \/ j = 1 by smt(). -qed. - -lemma bits32_W8u16_red ws i : - 0 <= i < 4 => - W8u16.pack8_t ws \bits32 i = W2u16.pack2 [ws.[2 * i]; ws.[2 * i + 1]]. -proof. by move=> h;rewrite bits32_W8u16 h. qed. - -lemma bits32_W16u16 ws i : - W16u16.pack16_t ws \bits32 i = - if 0 <= i < 8 then W2u16.pack2 [ws.[2 * i]; ws.[2 * i + 1]] else W32.zero. -proof. - apply W2u16.wordP => j hj. - rewrite W256_bits32_bits16 1://. - case: (0 <= i < 8) => hi; last by rewrite W2u16.get_zero W16u16.get_out 1:/#. - rewrite /= W2u16.pack2bE 1:// /= W16u16.pack16bE 1:/#. - by have []-> : j = 0 \/ j = 1 by smt(). -qed. - -lemma bits32_W16u16_red ws i : - 0 <= i < 8 => - W16u16.pack16_t ws \bits32 i = W2u16.pack2 [ws.[2 * i]; ws.[2 * i + 1]]. -proof. by move=> h;rewrite bits32_W16u16 h. qed. - -hint simplify bits32_W4u16_red, bits32_W8u16_red, bits32_W16u16_red. - -lemma bits32_W2u64 ws i : - W2u64.pack2_t ws \bits32 i = if 0 <= i < 4 then ws.[i%/2] \bits32 (i%%2) else W32.zero. -proof. - apply W32.wordP => j hj; rewrite !bits32iE 1,2://. - case: (0 <= i < 4) => /= hi; last by rewrite W128.get_out 1:/#. - rewrite pack2wE 1:/#; have /= [-> ->] := divmod_mul 2 32 i j _ hj; 1: done; rewrite W2u32.bits32iE 1:// /#. -qed. - -lemma bits32_W2u64_red ws i : - 0 <= i < 4 => W2u64.pack2_t ws \bits32 i = ws.[i%/2] \bits32 (i%%2). -proof. by move=> h;rewrite bits32_W2u64 h. qed. - -lemma bits32_W4u64 ws i : - W4u64.pack4_t ws \bits32 i = if 0 <= i < 8 then ws.[i%/2] \bits32 (i%%2) else W32.zero. -proof. - apply W32.wordP => j hj; rewrite !bits32iE 1,2://. - case: (0 <= i < 8) => /= hi; last by rewrite W256.get_out 1:/#. - rewrite pack4wE 1:/#; have /= [-> ->] := divmod_mul 2 32 i j _ hj; 1: done; rewrite W2u32.bits32iE 1:// /#. -qed. - -lemma bits32_W4u64_red ws i : - 0 <= i < 8 => W4u64.pack4_t ws \bits32 i = ws.[i%/2] \bits32 (i%%2). -proof. by move=> h;rewrite bits32_W4u64 h. qed. - -hint simplify bits32_W2u64_red, bits32_W4u64_red. - -lemma bits32_W2u128 ws i : - W2u128.pack2_t ws \bits32 i = if 0 <= i < 8 then ws.[i%/4] \bits32 (i%%4) else W32.zero. -proof. - apply W32.wordP => j hj; rewrite !bits32iE 1,2://. - case: (0 <= i < 8) => /= hi; last by rewrite W256.get_out 1:/#. - rewrite pack2wE 1:/#; have /= [-> ->] := divmod_mul 4 32 i j _ hj; 1: done; rewrite W4u32.bits32iE 1:// /#. -qed. - -lemma bits32_W2u128_red ws i : - 0 <= i < 8 => W2u128.pack2_t ws \bits32 i = ws.[i%/4] \bits32 (i%%4). -proof. by move=> h;rewrite bits32_W2u128 h. qed. - -hint simplify bits32_W2u128_red. - -lemma W128_bits64_bits32 (w:W128.t) i j: 0 <= j < 2 => w \bits64 i \bits32 j = w \bits32 (2 * i + j). -proof. - move=> hj; apply W32.wordP => k hk. - by rewrite !bits32iE 1,2:// bits64iE 1:/#; congr; ring. -qed. - -lemma W256_bits64_bits32 (w:W256.t) i j: 0 <= j < 2 => w \bits64 i \bits32 j = w \bits32 (2 * i + j). -proof. - move=> hj; apply W32.wordP => k hk. - by rewrite !bits32iE 1,2:// bits64iE 1:/#; congr; ring. -qed. - -lemma W256_bits128_bits32 (w:W256.t) i j: 0 <= j < 4 => w \bits128 i \bits32 j = w \bits32 (4 * i + j). -proof. - move=> hj; apply W32.wordP => k hk. - by rewrite !bits32iE 1,2:// bits128iE 1:/#; congr; ring. -qed. - -hint simplify W128_bits64_bits32, W256_bits64_bits32, W256_bits128_bits32. - -(* --------------------------------------------------------------------------------- *) -(* Lemmas on \bits64 *) -(* --------------------------------------------------------------------------------- *) - -lemma bits64_W16u8 ws i : - W16u8.pack16_t ws \bits64 i = - if 0 <= i < 2 then W8u8.pack8 [ws.[8 * i]; ws.[8 * i + 1]; ws.[8 * i + 2]; ws.[8 * i + 3]; - ws.[8 * i + 4]; ws.[8 * i + 5]; ws.[8 * i + 6]; ws.[8 * i + 7]] - else W64.zero. -proof. - apply W8u8.wordP => j hj. - rewrite W128_bits64_bits8 1://. - case: (0 <= i < 2) => hi; last by rewrite W8u8.get_zero W16u8.get_out 1:/#. - rewrite /= W8u8.pack8bE 1:// /= W16u8.pack16bE 1:/#. - by move: hj; rewrite -(mema_iota 0 8) /= => -[|[|[|[|[|[|[|]]]]]]] ->. -qed. - -lemma bits64_W16u8_red ws i : - 0 <= i < 2 => - W16u8.pack16_t ws \bits64 i = - W8u8.pack8 [ws.[8 * i]; ws.[8 * i + 1]; ws.[8 * i + 2]; ws.[8 * i + 3]; - ws.[8 * i + 4]; ws.[8 * i + 5]; ws.[8 * i + 6]; ws.[8 * i + 7]]. -proof. by move=> h;rewrite bits64_W16u8 h. qed. - -lemma bits64_W32u8 ws i : - W32u8.pack32_t ws \bits64 i = - if 0 <= i < 4 then W8u8.pack8 [ws.[8 * i]; ws.[8 * i + 1]; ws.[8 * i + 2]; ws.[8 * i + 3]; - ws.[8 * i + 4]; ws.[8 * i + 5]; ws.[8 * i + 6]; ws.[8 * i + 7]] - else W64.zero. -proof. - apply W8u8.wordP => j hj. - rewrite W256_bits64_bits8 1://. - case: (0 <= i < 4) => hi; last by rewrite W8u8.get_zero W32u8.get_out 1:/#. - rewrite /= W8u8.pack8bE 1:// /= W32u8.pack32bE 1:/#. - by move: hj; rewrite -(mema_iota 0 8) /= => -[|[|[|[|[|[|[|]]]]]]] ->. -qed. - -lemma bits64_W32u8_red ws i : - 0 <= i < 4 => - W32u8.pack32_t ws \bits64 i = - W8u8.pack8 [ws.[8 * i]; ws.[8 * i + 1]; ws.[8 * i + 2]; ws.[8 * i + 3]; - ws.[8 * i + 4]; ws.[8 * i + 5]; ws.[8 * i + 6]; ws.[8 * i + 7]]. -proof. by move=> h;rewrite bits64_W32u8 h. qed. - -hint simplify bits64_W16u8_red, bits64_W32u8_red. - -lemma bits64_W8u16 ws i : - W8u16.pack8_t ws \bits64 i = - if 0 <= i < 2 then W4u16.pack4 [ws.[4 * i]; ws.[4 * i + 1]; ws.[4 * i + 2]; ws.[4 * i + 3] ] else W64.zero. -proof. - apply W4u16.wordP => j hj. - rewrite W128_bits64_bits16 1://. - case: (0 <= i < 2) => hi; last by rewrite W4u16.get_zero W8u16.get_out 1:/#. - rewrite /= W4u16.pack4bE 1:// /= W8u16.pack8bE 1:/#. - by have [|[|[|]]]-> : j = 0 \/ j = 1 \/ j = 2 \/ j = 3 by smt(). -qed. - -lemma bits64_W8u16_red ws i : - 0 <= i < 2 => - W8u16.pack8_t ws \bits64 i = - W4u16.pack4 [ws.[4 * i]; ws.[4 * i + 1]; ws.[4 * i + 2]; ws.[4 * i + 3] ]. -proof. by move=> h;rewrite bits64_W8u16 h. qed. - -lemma bits64_W16u16 ws i : - W16u16.pack16_t ws \bits64 i = - if 0 <= i < 4 then W4u16.pack4 [ws.[4 * i]; ws.[4 * i + 1]; ws.[4 * i + 2]; ws.[4 * i + 3] ] else W64.zero. -proof. - apply W4u16.wordP => j hj. - rewrite W256_bits64_bits16 1://. - case: (0 <= i < 4) => hi; last by rewrite W4u16.get_zero W16u16.get_out 1:/#. - rewrite /= W4u16.pack4bE 1:// /= W16u16.pack16bE 1:/#. - by have [|[|[|]]]-> : j = 0 \/ j = 1 \/ j = 2 \/ j = 3 by smt(). -qed. - -lemma bits64_W16u16_red ws i : - 0 <= i < 4 => - W16u16.pack16_t ws \bits64 i = - W4u16.pack4 [ws.[4 * i]; ws.[4 * i + 1]; ws.[4 * i + 2]; ws.[4 * i + 3] ]. -proof. by move=> h;rewrite bits64_W16u16 h. qed. - -hint simplify bits64_W8u16_red, bits64_W16u16_red. - -lemma bits64_W4u32 ws i : - W4u32.pack4_t ws \bits64 i = - if 0 <= i < 2 then W2u32.pack2 [ws.[2 * i]; ws.[2 * i + 1]] else W64.zero. -proof. - apply W2u32.wordP => j hj. - rewrite W128_bits64_bits32 1://. - case: (0 <= i < 2) => hi; last by rewrite W2u32.get_zero W4u32.get_out 1:/#. - rewrite /= W2u32.pack2bE 1:// /= W4u32.pack4bE 1:/#. - by have [|]-> : j = 0 \/ j = 1 by smt(). -qed. - -lemma bits64_W4u32_red ws i : - 0 <= i < 2 => - W4u32.pack4_t ws \bits64 i = W2u32.pack2 [ws.[2 * i]; ws.[2 * i + 1]]. -proof. by move=> h;rewrite bits64_W4u32 h. qed. - -lemma bits64_W8u32 ws i : - W8u32.pack8_t ws \bits64 i = - if 0 <= i < 4 then W2u32.pack2 [ws.[2 * i]; ws.[2 * i + 1]] else W64.zero. -proof. - apply W2u32.wordP => j hj. - rewrite W256_bits64_bits32 1://. - case: (0 <= i < 4) => hi; last by rewrite W2u32.get_zero W8u32.get_out 1:/#. - rewrite /= W2u32.pack2bE 1:// /= W8u32.pack8bE 1:/#. - have [|]-> //= : j = 0 \/ j = 1 by smt(). -qed. - -lemma bits64_W8u32_red ws i : - 0 <= i < 4 => - W8u32.pack8_t ws \bits64 i = W2u32.pack2 [ws.[2 * i]; ws.[2 * i + 1]]. -proof. by move=> h;rewrite bits64_W8u32 h. qed. - -hint simplify bits64_W4u32_red, bits64_W8u32_red. - -lemma bits64_W2u128 ws i : - W2u128.pack2_t ws \bits64 i = if 0 <= i < 4 then ws.[i%/2] \bits64 (i%%2) else W64.zero. -proof. - apply W64.wordP => j hj; rewrite !bits64iE 1,2://. - case: (0 <= i < 4) => /= hi; last by rewrite W256.get_out 1:/#. - rewrite pack2wE 1:/#; have /= [-> ->] := divmod_mul 2 64 i j _ hj; 1: done; rewrite W2u64.bits64iE 1:// /#. -qed. - -lemma bits64_W2u128_red ws i : - 0 <= i < 4 => W2u128.pack2_t ws \bits64 i = ws.[i%/2] \bits64 (i%%2). -proof. by move=> h;rewrite bits64_W2u128 h. qed. - -hint simplify bits64_W2u128_red. - -lemma W256_bits128_bits64 (w:W256.t) i j: 0 <= j < 2 => w \bits128 i \bits64 j = w \bits64 (2 * i + j). -proof. - move=> hj; apply W64.wordP => k hk. - by rewrite !bits64iE 1,2:// bits128iE 1:/#; congr; ring. -qed. - -hint simplify W256_bits128_bits64. - -(* --------------------------------------------------------------------------------- *) -(* Lemmas on \bits128 *) -(* --------------------------------------------------------------------------------- *) - -lemma bits128_W32u8 ws i : - W32u8.pack32_t ws \bits128 i = - if 0 <= i < 2 then - W16u8.pack16 [ws.[16 * i]; ws.[16 * i + 1]; ws.[16 * i + 2]; ws.[16 * i + 3]; - ws.[16 * i + 4]; ws.[16 * i + 5]; ws.[16 * i + 6]; ws.[16 * i + 7]; - ws.[16 * i + 8]; ws.[16 * i + 9]; ws.[16 * i + 10]; ws.[16 * i + 11]; - ws.[16 * i + 12]; ws.[16 * i + 13]; ws.[16 * i + 14]; ws.[16 * i + 15]] - else W128.zero. -proof. - apply W16u8.wordP => j hj. - rewrite W256_bits128_bits8 1://. - case: (0 <= i < 2) => hi; last by rewrite W16u8.get_zero W32u8.get_out 1:/#. - rewrite /= W32u8.pack32bE 1:/# /= W16u8.pack16bE 1:/#. - by move: hj; rewrite -(mema_iota 0 16) /= => -[|[|[|[|[|[|[|[|[|[|[|[|[|[|[|]]]]]]]]]]]]]]] ->. -qed. - -lemma bits128_W32u8_red ws i : - 0 <= i < 2 => - W32u8.pack32_t ws \bits128 i = - W16u8.pack16 [ws.[16 * i]; ws.[16 * i + 1]; ws.[16 * i + 2]; ws.[16 * i + 3]; - ws.[16 * i + 4]; ws.[16 * i + 5]; ws.[16 * i + 6]; ws.[16 * i + 7]; - ws.[16 * i + 8]; ws.[16 * i + 9]; ws.[16 * i + 10]; ws.[16 * i + 11]; - ws.[16 * i + 12]; ws.[16 * i + 13]; ws.[16 * i + 14]; ws.[16 * i + 15]]. -proof. by move=> hi;rewrite bits128_W32u8 hi. qed. - -lemma bits128_W16u16 ws i : - W16u16.pack16_t ws \bits128 i = - if 0 <= i < 2 then - W8u16.pack8 [ws.[8 * i]; ws.[8 * i + 1]; ws.[8 * i + 2]; ws.[8 * i + 3]; - ws.[8 * i + 4]; ws.[8 * i + 5]; ws.[8 * i + 6]; ws.[8 * i + 7]] - else W128.zero. -proof. - apply W8u16.wordP => j hj. - rewrite W256_bits128_bits16 1://. - case: (0 <= i < 2) => hi; last by rewrite W8u16.get_zero W16u16.get_out 1:/#. - rewrite /= W16u16.pack16bE 1:/# /= W8u16.pack8bE 1:/#. - by move: hj; rewrite -(mema_iota 0 8) /= => -[|[|[|[|[|[|[|]]]]]]] ->. -qed. - -lemma bits128_W16u16_red ws i : - 0 <= i < 2 => - W16u16.pack16_t ws \bits128 i = - W8u16.pack8 [ws.[8 * i]; ws.[8 * i + 1]; ws.[8 * i + 2]; ws.[8 * i + 3]; - ws.[8 * i + 4]; ws.[8 * i + 5]; ws.[8 * i + 6]; ws.[8 * i + 7]]. -proof. by move=> hi;rewrite bits128_W16u16 hi. qed. - -lemma bits128_W8u32 ws i : - W8u32.pack8_t ws \bits128 i = - if 0 <= i < 2 then - W4u32.pack4 [ws.[4 * i]; ws.[4 * i + 1]; ws.[4 * i + 2]; ws.[4 * i + 3]] - else W128.zero. -proof. - apply W4u32.wordP => j hj. - rewrite W256_bits128_bits32 1://. - case: (0 <= i < 2) => hi; last by rewrite W4u32.get_zero W8u32.get_out 1:/#. - rewrite /= W8u32.pack8bE 1:/# /= W4u32.pack4bE 1:/#. - by move: hj; rewrite -(mema_iota 0 4) /= => -[|[|[|]]] ->. -qed. - -lemma bits128_W8u32_red ws i : - 0 <= i < 2 => - W8u32.pack8_t ws \bits128 i = - W4u32.pack4 [ws.[4 * i]; ws.[4 * i + 1]; ws.[4 * i + 2]; ws.[4 * i + 3]]. -proof. by move=> hi;rewrite bits128_W8u32 hi. qed. - -lemma bits128_W4u64 ws i : - W4u64.pack4_t ws \bits128 i = - if 0 <= i < 2 then - W2u64.pack2 [ws.[2 * i]; ws.[2* i + 1]] - else W128.zero. -proof. - apply W2u64.wordP => j hj. - rewrite W256_bits128_bits64 1://. - case: (0 <= i < 2) => hi; last by rewrite W2u64.get_zero W4u64.get_out 1:/#. - rewrite /= W4u64.pack4bE 1:/# /= W2u64.pack2bE 1:// get_of_list 1://. - by move: hj; rewrite -(mema_iota 0 2) /= => -[|] ->. -qed. - -lemma bits128_W4u64_red ws i : - 0 <= i < 2 => - W4u64.pack4_t ws \bits128 i = W2u64.pack2 [ws.[2 * i]; ws.[2* i + 1]]. -proof. by move=> hi;rewrite bits128_W4u64 hi. qed. - -hint simplify bits128_W32u8_red, bits128_W16u16_red, bits128_W8u32_red, bits128_W4u64_red. - -(* --------------------------------------------------------------------------------- *) -(* Lemmas on pack *) -(* --------------------------------------------------------------------------------- *) - -lemma W2u16_W4u8 ws1 ws2 : - pack2 [W2u8.pack2_t ws1; W2u8.pack2_t ws2] = pack4 [ws1.[0]; ws1.[1]; ws2.[0]; ws2.[1]]. -proof. by apply W4u8.allP => /=. qed. - -lemma W4u16_W8u8 ws1 ws2 ws3 ws4 : - pack4 [W2u8.pack2_t ws1; W2u8.pack2_t ws2; W2u8.pack2_t ws3; W2u8.pack2_t ws4] = - pack8 [ws1.[0]; ws1.[1]; ws2.[0]; ws2.[1]; ws3.[0]; ws3.[1]; ws4.[0]; ws4.[1]]. -proof. by apply W8u8.allP => /=. qed. - -lemma W8u16_W16u8 ws1 ws2 ws3 ws4 ws5 ws6 ws7 ws8: - pack8 [W2u8.pack2_t ws1; W2u8.pack2_t ws2; W2u8.pack2_t ws3; W2u8.pack2_t ws4; - W2u8.pack2_t ws5; W2u8.pack2_t ws6; W2u8.pack2_t ws7; W2u8.pack2_t ws8 ] = - pack16 [ws1.[0]; ws1.[1]; ws2.[0]; ws2.[1]; ws3.[0]; ws3.[1]; ws4.[0]; ws4.[1]; - ws5.[0]; ws5.[1]; ws6.[0]; ws6.[1]; ws7.[0]; ws7.[1]; ws8.[0]; ws8.[1]]. -proof. by apply W16u8.allP => /=. qed. - -lemma W16u16_W32u8 ws1 ws2 ws3 ws4 ws5 ws6 ws7 ws8 ws9 ws10 ws11 ws12 ws13 ws14 ws15 ws16: - pack16 [W2u8.pack2_t ws1; W2u8.pack2_t ws2; W2u8.pack2_t ws3; W2u8.pack2_t ws4; - W2u8.pack2_t ws5; W2u8.pack2_t ws6; W2u8.pack2_t ws7; W2u8.pack2_t ws8; - W2u8.pack2_t ws9; W2u8.pack2_t ws10; W2u8.pack2_t ws11; W2u8.pack2_t ws12; - W2u8.pack2_t ws13; W2u8.pack2_t ws14; W2u8.pack2_t ws15; W2u8.pack2_t ws16] = - pack32 [ws1.[0]; ws1.[1]; ws2.[0]; ws2.[1]; ws3.[0]; ws3.[1]; ws4.[0]; ws4.[1]; - ws5.[0]; ws5.[1]; ws6.[0]; ws6.[1]; ws7.[0]; ws7.[1]; ws8.[0]; ws8.[1]; - ws9.[0]; ws9.[1]; ws10.[0]; ws10.[1]; ws11.[0]; ws11.[1]; ws12.[0]; ws12.[1]; - ws13.[0]; ws13.[1]; ws14.[0]; ws14.[1]; ws15.[0]; ws15.[1]; ws16.[0]; ws16.[1]]. -proof. by apply W32u8.allP => /=. qed. - -hint simplify W2u16_W4u8, W4u16_W8u8, W8u16_W16u8, W16u16_W32u8. - -lemma W2u32_W8u8 ws1 ws2 : - pack2 [W4u8.pack4_t ws1; W4u8.pack4_t ws2] = - pack8 [ws1.[0]; ws1.[1]; ws1.[2]; ws1.[3]; ws2.[0]; ws2.[1]; ws2.[2]; ws2.[3]]. -proof. by apply W8u8.allP => /=. qed. - -lemma W4u32_W16u8 ws1 ws2 ws3 ws4 : - pack4 [W4u8.pack4_t ws1; W4u8.pack4_t ws2; W4u8.pack4_t ws3; W4u8.pack4_t ws4] = - pack16 [ws1.[0]; ws1.[1]; ws1.[2]; ws1.[3]; ws2.[0]; ws2.[1]; ws2.[2]; ws2.[3]; - ws3.[0]; ws3.[1]; ws3.[2]; ws3.[3]; ws4.[0]; ws4.[1]; ws4.[2]; ws4.[3]]. -proof. by apply W16u8.allP => /=. qed. - -lemma W8u32_W32u8 ws1 ws2 ws3 ws4 ws5 ws6 ws7 ws8: - pack8 [W4u8.pack4_t ws1; W4u8.pack4_t ws2; W4u8.pack4_t ws3; W4u8.pack4_t ws4; - W4u8.pack4_t ws5; W4u8.pack4_t ws6; W4u8.pack4_t ws7; W4u8.pack4_t ws8 ] = - pack32 [ws1.[0]; ws1.[1]; ws1.[2]; ws1.[3]; ws2.[0]; ws2.[1]; ws2.[2]; ws2.[3]; - ws3.[0]; ws3.[1]; ws3.[2]; ws3.[3]; ws4.[0]; ws4.[1]; ws4.[2]; ws4.[3]; - ws5.[0]; ws5.[1]; ws5.[2]; ws5.[3]; ws6.[0]; ws6.[1]; ws6.[2]; ws6.[3]; - ws7.[0]; ws7.[1]; ws7.[2]; ws7.[3]; ws8.[0]; ws8.[1]; ws8.[2]; ws8.[3]]. -proof. by apply W32u8.allP => /=. qed. - -hint simplify W2u32_W8u8, W4u32_W16u8, W8u32_W32u8. - -lemma W2u64_W16u8 ws1 ws2: - pack2 [W8u8.pack8_t ws1; W8u8.pack8_t ws2] = - pack16 [ws1.[0]; ws1.[1]; ws1.[2]; ws1.[3]; ws1.[4]; ws1.[5]; ws1.[6]; ws1.[7]; - ws2.[0]; ws2.[1]; ws2.[2]; ws2.[3]; ws2.[4]; ws2.[5]; ws2.[6]; ws2.[7]]. -proof. by apply W16u8.allP => /=. qed. - -lemma W4u64_W32u8 ws1 ws2 ws3 ws4: - pack4 [W8u8.pack8_t ws1; W8u8.pack8_t ws2; W8u8.pack8_t ws3; W8u8.pack8_t ws4] = - pack32 [ws1.[0]; ws1.[1]; ws1.[2]; ws1.[3]; ws1.[4]; ws1.[5]; ws1.[6]; ws1.[7]; - ws2.[0]; ws2.[1]; ws2.[2]; ws2.[3]; ws2.[4]; ws2.[5]; ws2.[6]; ws2.[7]; - ws3.[0]; ws3.[1]; ws3.[2]; ws3.[3]; ws3.[4]; ws3.[5]; ws3.[6]; ws3.[7]; - ws4.[0]; ws4.[1]; ws4.[2]; ws4.[3]; ws4.[4]; ws4.[5]; ws4.[6]; ws4.[7]]. -proof. by apply W32u8.allP => /=. qed. - -hint simplify W2u64_W16u8, W4u64_W32u8. - -lemma W2u128_W32u8 ws1 ws2: - pack2 [W16u8.pack16_t ws1; W16u8.pack16_t ws2] = - pack32 [ws1.[0]; ws1.[1]; ws1.[2]; ws1.[3]; ws1.[4]; ws1.[5]; ws1.[6]; ws1.[7]; - ws1.[8]; ws1.[9]; ws1.[10]; ws1.[11]; ws1.[12]; ws1.[13]; ws1.[14]; ws1.[15]; - ws2.[0]; ws2.[1]; ws2.[2]; ws2.[3]; ws2.[4]; ws2.[5]; ws2.[6]; ws2.[7]; - ws2.[8]; ws2.[9]; ws2.[10]; ws2.[11]; ws2.[12]; ws2.[13]; ws2.[14]; ws2.[15]]. -proof. by apply W32u8.allP => /=. qed. - -hint simplify W2u128_W32u8. - -lemma W2u32_W4u16 ws1 ws2 : - pack2 [W2u16.pack2_t ws1; W2u16.pack2_t ws2] = pack4 [ws1.[0]; ws1.[1]; ws2.[0]; ws2.[1]]. -proof. by apply W4u16.allP => /=. qed. - -lemma W4u32_W8u16 ws1 ws2 ws3 ws4 : - pack4 [W2u16.pack2_t ws1; W2u16.pack2_t ws2; W2u16.pack2_t ws3; W2u16.pack2_t ws4] = - pack8 [ws1.[0]; ws1.[1]; ws2.[0]; ws2.[1]; ws3.[0]; ws3.[1]; ws4.[0]; ws4.[1]]. -proof. by apply W8u16.allP => /=. qed. - -lemma W8u32_W16u16 ws1 ws2 ws3 ws4 ws5 ws6 ws7 ws8: - pack8 [W2u16.pack2_t ws1; W2u16.pack2_t ws2; W2u16.pack2_t ws3; W2u16.pack2_t ws4; - W2u16.pack2_t ws5; W2u16.pack2_t ws6; W2u16.pack2_t ws7; W2u16.pack2_t ws8 ] = - pack16 [ws1.[0]; ws1.[1]; ws2.[0]; ws2.[1]; ws3.[0]; ws3.[1]; ws4.[0]; ws4.[1]; - ws5.[0]; ws5.[1]; ws6.[0]; ws6.[1]; ws7.[0]; ws7.[1]; ws8.[0]; ws8.[1]]. -proof. by apply W16u16.allP => /=. qed. - -hint simplify W2u32_W4u16, W4u32_W8u16, W8u32_W16u16. - -lemma W2u64_W8u16 ws1 ws2: - pack2 [W4u16.pack4_t ws1; W4u16.pack4_t ws2] = - pack8 [ws1.[0]; ws1.[1]; ws1.[2]; ws1.[3]; - ws2.[0]; ws2.[1]; ws2.[2]; ws2.[3]]. -proof. by apply W8u16.allP => /=. qed. - -lemma W4u64_W16u16 ws1 ws2 ws3 ws4: - pack4 [W4u16.pack4_t ws1; W4u16.pack4_t ws2; W4u16.pack4_t ws3; W4u16.pack4_t ws4] = - pack16 [ws1.[0]; ws1.[1]; ws1.[2]; ws1.[3]; ws2.[0]; ws2.[1]; ws2.[2]; ws2.[3]; - ws3.[0]; ws3.[1]; ws3.[2]; ws3.[3]; ws4.[0]; ws4.[1]; ws4.[2]; ws4.[3]]. -proof. by apply W16u16.allP => /=. qed. - -hint simplify W2u64_W8u16, W4u64_W16u16. - -lemma W2u64_W4u32 ws1 ws2: - pack2 [W2u32.pack2_t ws1; W2u32.pack2_t ws2] = pack4 [ws1.[0]; ws1.[1]; ws2.[0]; ws2.[1]]. -proof. by apply W4u32.allP => /=. qed. - -lemma W4u64_W8u32 ws1 ws2 ws3 ws4 : - pack4 [W2u32.pack2_t ws1; W2u32.pack2_t ws2; W2u32.pack2_t ws3; W2u32.pack2_t ws4] = - pack8 [ws1.[0]; ws1.[1]; ws2.[0]; ws2.[1]; ws3.[0]; ws3.[1]; ws4.[0]; ws4.[1]]. -proof. by apply W8u32.allP => /=. qed. - -lemma W2u128_W8u32 ws1 ws2 : - pack2 [W4u32.pack4_t ws1; W4u32.pack4_t ws2] = - pack8 [ws1.[0]; ws1.[1]; ws1.[2]; ws1.[3]; ws2.[0]; ws2.[1]; ws2.[2]; ws2.[3]]. -proof. by apply W8u32.allP => /=. qed. - -hint simplify W2u64_W4u32, W4u64_W8u32, W2u128_W8u32. - -lemma W2u128_W4u64 ws1 ws2: - pack2 [W2u64.pack2_t ws1; W2u64.pack2_t ws2] = pack4 [ws1.[0]; ws1.[1]; ws2.[0]; ws2.[1]]. -proof. by apply W4u64.allP => /=. qed. - -hint simplify W2u128_W4u64. \ No newline at end of file diff --git a/proof/impl/JWord_array.ec b/proof/impl/JWord_array.ec deleted file mode 100644 index 0f5782f..0000000 --- a/proof/impl/JWord_array.ec +++ /dev/null @@ -1,263 +0,0 @@ -(* -------------------------------------------------------------------- *) -require import AllCore BitEncoding IntDiv SmtMap List StdOrder BitEncoding Bool. -(*---*) import Ring.IntID IntOrder BS2Int. -require import JUtils JArray JWord. - -abstract theory WArray. - - clone include MonoArray with - type elem <- W8.t, - op dfl <- W8.zero. - - op get8 (t:t) (i:int) : W8.t = t.[i]. - - op get16 (t:t) (i:int) : W16.t = - pack2_t (W2u8.Pack.init (fun j => t.[2*i + j])) - axiomatized by get16E. - - op get32 (t:t) (i:int) : W32.t = - pack4_t (W4u8.Pack.init (fun j => t.[4*i + j])) - axiomatized by get32E. - - op get64 (t:t) (i:int) : W64.t = - pack8_t (W8u8.Pack.init (fun j => t.[8*i + j])) - axiomatized by get64E. - - op get128 (t:t) (i:int) : W128.t = - pack16_t (W16u8.Pack.init (fun j => t.[16*i + j])) - axiomatized by get128E. - - op get256 (t:t) (i:int) : W256.t = - pack32_t (W32u8.Pack.init (fun j => t.[32*i + j])) - axiomatized by get256E. - - op set8 (t:t) (i:int) (w:W8.t) : t = t.[i <- w]. - - op set16 (t:t) (i:int) (w:W16.t) = - init (fun k => if 2*i <= k < 2*(i+1) then w \bits8 (k - 2*i) else t.[k]) - axiomatized by set16E. - - op set32 (t:t) (i:int) (w:W32.t) = - init (fun k => if 4*i <= k < 4*(i+1) then w \bits8 (k - 4*i) else t.[k]) - axiomatized by set32E. - - op set64 (t:t) (i:int) (w:W64.t) = - init (fun k => if 8*i <= k < 8*(i+1) then w \bits8 (k - 8*i) else t.[k]) - axiomatized by set64E. - - op set128 (t:t) (i:int) (w:W128.t) = - init (fun k => if 16*i <= k < 16*(i+1) then w \bits8 (k - 16*i) else t.[k]) - axiomatized by set128E. - - op set256 (t:t) (i:int) (w:W256.t) = - init (fun k => if 32*i <= k < 32*(i+1) then w \bits8 (k - 32*i) else t.[k]) - axiomatized by set256E. - - (* ----------------------------------------------------- *) - - lemma get_set8E t x y w: - 0 <= x < size => - get8 (set8 t x w) y = if y = x then w else get8 t y. - proof. apply get_setE. qed. - - lemma get8_set16E t x y w : - 0 <= x => 2*(x + 1) <= WArray.size => - get8 (set16 t x w) y = if 2*x <= y < 2*(x+1) then w \bits8 (y - 2*x) else get8 t y. - proof. - move=> hx hs; rewrite set16E /get8. - case: (2 * x <= y < 2 * (x + 1)) => hy. - + by rewrite initiE 1:/# /= hy. - case: (0 <= y < WArray.size) => hy1; last by rewrite !get_out. - rewrite initiE //= /#. - qed. - - lemma get_set16E t x y w: - 0 <= x => 2*(x + 1) <= WArray.size => - get16 (set16 t x w) y = if y = x then w else get16 t y. - proof. - move=> hx hs; rewrite set16E !get16E. - case: (y = x) => [-> | hne]. - + rewrite -(W2u8.unpack8K w);congr. - apply W2u8.Pack.ext_eq => k hk; rewrite W2u8.get_unpack8 1:// W2u8.Pack.initiE //= initiE //= /#. - congr; apply W2u8.Pack.init_ext => k hk /=; rewrite initE. - by case: (0 <= 2 * y + k < WArray.size) => [ /# | /get_out ->]. - qed. - - lemma get8_set32E t x y w : - 0 <= x => 4*(x + 1) <= WArray.size => - get8 (set32 t x w) y = if 4*x <= y < 4*(x+1) then w \bits8 (y - 4*x) else get8 t y. - proof. - move=> hx hs; rewrite set32E /get8. - case: (4 * x <= y < 4 * (x + 1)) => hy. - + by rewrite initiE 1:/# /= hy. - case: (0 <= y < WArray.size) => hy1; last by rewrite !get_out. - rewrite initiE //= /#. - qed. - - lemma get_set32E t x y w: - 0 <= x => 4*(x + 1) <= WArray.size => - get32 (set32 t x w) y = if y = x then w else get32 t y. - proof. - move=> hx hs; rewrite set32E !get32E. - case: (y = x) => [-> | hne]. - + rewrite -(W4u8.unpack8K w);congr. - apply W4u8.Pack.ext_eq => k hk; rewrite W4u8.get_unpack8 //= W4u8.Pack.initiE //= initiE /#. - congr; apply W4u8.Pack.init_ext => k hk /=; rewrite initE. - by case: (0 <= 4 * y + k < WArray.size) => [ /# | /get_out ->]. - qed. - - lemma get8_set64E t x y w : - 0 <= x => 8*(x + 1) <= WArray.size => - get8 (set64 t x w) y = if 8*x <= y < 8*(x+1) then w \bits8 (y - 8*x) else get8 t y. - proof. - move=> hx hs; rewrite set64E /get8. - case: (8 * x <= y < 8 * (x + 1)) => hy. - + by rewrite initiE 1:/# /= hy. - case: (0 <= y < WArray.size) => hy1; last by rewrite !get_out. - rewrite initiE //= /#. - qed. - - lemma get_set64E t x y w: - 0 <= x => 8*(x + 1) <= WArray.size => - get64 (set64 t x w) y = if y = x then w else get64 t y. - proof. - move=> hx hs; rewrite set64E !get64E. - case: (y = x) => [-> | hne]. - + rewrite -(W8u8.unpack8K w);congr. - apply W8u8.Pack.ext_eq => k hk; rewrite W8u8.get_unpack8 //= W8u8.Pack.initiE //= initiE /#. - congr; apply W8u8.Pack.init_ext => k hk /=; rewrite initE. - by case: (0 <= 8 * y + k < WArray.size) => [ /# | /get_out ->]. - qed. - - lemma get8_set128E t x y w : - 0 <= x => 16*(x + 1) <= WArray.size => - get8 (set128 t x w) y = if 16*x <= y < 16*(x+1) then w \bits8 (y - 16*x) else get8 t y. - proof. - move=> hx hs; rewrite set128E /get8. - case: (16 * x <= y < 16 * (x + 1)) => hy. - + by rewrite initiE 1:/# /= hy. - case: (0 <= y < WArray.size) => hy1; last by rewrite !get_out. - rewrite initiE //= /#. - qed. - - lemma get_set128E t x y w: - 0 <= x => 16*(x + 1) <= WArray.size => - get128 (set128 t x w) y = if y = x then w else get128 t y. - proof. - move=> hx hs; rewrite set128E !get128E. - case: (y = x) => [-> | hne]. - + rewrite -(W16u8.unpack8K w);congr. - apply W16u8.Pack.ext_eq => k hk; rewrite W16u8.get_unpack8 //= W16u8.Pack.initiE //= initiE /#. - congr; apply W16u8.Pack.init_ext => k hk /=; rewrite initE. - by case: (0 <= 16 * y + k < WArray.size) => [ /# | /get_out ->]. - qed. - - lemma get8_set256E t x y w : - 0 <= x => 32*(x + 1) <= WArray.size => - get8 (set256 t x w) y = if 32*x <= y < 32*(x+1) then w \bits8 (y - 32*x) else get8 t y. - proof. - move=> hx hs; rewrite set256E /get8. - case: (32 * x <= y < 32 * (x + 1)) => hy. - + by rewrite initiE 1:/# /= hy. - case: (0 <= y < WArray.size) => hy1; last by rewrite !get_out. - rewrite initiE //= /#. - qed. - - lemma get_set256E t x y w: - 0 <= x => 32*(x + 1) <= WArray.size => - get256 (set256 t x w) y = if y = x then w else get256 t y. - proof. - move=> hx hs; rewrite set256E !get256E. - case: (y = x) => [-> | hne]. - + rewrite -(W32u8.unpack8K w);congr. - apply W32u8.Pack.ext_eq => k hk; rewrite W32u8.get_unpack8 //= W32u8.Pack.initiE //= initiE /#. - congr; apply W32u8.Pack.init_ext => k hk /=; rewrite initE. - by case: (0 <= 32 * y + k < WArray.size) => [ /# | /get_out ->]. - qed. - - hint simplify get_set8E, get8_set16E, get_set16E, - get8_set32E, get_set32E, - get8_set64E, get_set64E, - get8_set128E, get_set128E, - get8_set256E, get_set256E. - - (* ------------------------------------------------- *) - - op init8 (f:int -> W8.t) = - init f. - - op init16 (f:int -> W16.t) = - init (fun i => f (i %/ 2) \bits8 (i%%2)). - - op init32 (f:int -> W32.t) = - init (fun i => f (i %/ 4) \bits8 (i%%4)). - - op init64 (f:int -> W64.t) = - init (fun i => f (i %/ 8) \bits8 (i%%8)). - - op init128 (f:int -> W128.t) = - init (fun i => f (i %/ 16) \bits8 (i%%16)). - - op init256 (f:int -> W256.t) = - init (fun i => f (i %/ 32) \bits8 (i%%32)). - -end WArray. - -(*clone export WArray as WArray0 with op size <- 0. -clone export WArray as WArray1 with op size <- 1. -clone export WArray as WArray2 with op size <- 2. -clone export WArray as WArray3 with op size <- 3. -clone export WArray as WArray4 with op size <- 4. -clone export WArray as WArray5 with op size <- 5. -clone export WArray as WArray6 with op size <- 6. -clone export WArray as WArray7 with op size <- 7. -clone export WArray as WArray8 with op size <- 8. -clone export WArray as WArray9 with op size <- 9. - -clone export WArray as WArray10 with op size <- 10. -clone export WArray as WArray11 with op size <- 11. -clone export WArray as WArray12 with op size <- 12. -clone export WArray as WArray13 with op size <- 13. -clone export WArray as WArray14 with op size <- 14. -clone export WArray as WArray15 with op size <- 15. -clone export WArray as WArray16 with op size <- 16. -clone export WArray as WArray17 with op size <- 17. -clone export WArray as WArray18 with op size <- 18. -clone export WArray as WArray19 with op size <- 19. - -clone export WArray as WArray20 with op size <- 20. -clone export WArray as WArray21 with op size <- 21. -clone export WArray as WArray22 with op size <- 22. -clone export WArray as WArray23 with op size <- 23. -clone export WArray as WArray24 with op size <- 24. -clone export WArray as WArray25 with op size <- 25. -clone export WArray as WArray26 with op size <- 26. -clone export WArray as WArray27 with op size <- 27. -clone export WArray as WArray28 with op size <- 28. -clone export WArray as WArray29 with op size <- 29. - -clone export WArray as WArray30 with op size <- 30. -clone export WArray as WArray31 with op size <- 31. -clone export WArray as WArray32 with op size <- 32. -clone export WArray as WArray33 with op size <- 33. -clone export WArray as WArray34 with op size <- 34. -clone export WArray as WArray35 with op size <- 35. -clone export WArray as WArray36 with op size <- 36. -clone export WArray as WArray37 with op size <- 37. -clone export WArray as WArray38 with op size <- 38. -clone export WArray as WArray39 with op size <- 39. - -clone export WArray as WArray40 with op size <- 40. -clone export WArray as WArray41 with op size <- 41. -clone export WArray as WArray42 with op size <- 42. -clone export WArray as WArray43 with op size <- 43. -clone export WArray as WArray44 with op size <- 44. -clone export WArray as WArray45 with op size <- 45. -clone export WArray as WArray46 with op size <- 46. -clone export WArray as WArray47 with op size <- 47. -clone export WArray as WArray48 with op size <- 48. -clone export WArray as WArray49 with op size <- 49. -*) - - - \ No newline at end of file diff --git a/proof/impl/Spec.ec b/proof/impl/Spec.ec index 003787c..dfa94d5 100644 --- a/proof/impl/Spec.ec +++ b/proof/impl/Spec.ec @@ -10,7 +10,12 @@ clone export PolyArray as Array25 with op size <- 25. op domain_bits : bool list. (* we will fix domain bits without the 1 that signals padding start *) -axiom domain_bits_len : size domain_bits < 8. +axiom domain_bits_len : size domain_bits = 2. + +op suffix_bits : bool list. + +(* we will fix domain bits without the 1 that signals padding start *) +axiom suffix_bits_len : size suffix_bits < 3. type state = W64.t Array25.t. @@ -107,11 +112,11 @@ qed. (* will need to be proved once loadpad2wblocks is defined *) lemma paddings_same mem inp inl: - pad (memr2bits mem inp inl ++ domain_bits) = + pad (memr2bits mem inp inl ++ domain_bits ++ suffix_bits) = wblocks2bits (loadpad2wblocks mem inp inl) by admit. lemma liftpadding mem inp inl : - pad2blocks (memr2bits mem inp inl ++ domain_bits) = + pad2blocks (memr2bits mem inp inl ++ domain_bits ++ suffix_bits) = wblock2bits_list (loadpad2wblocks mem inp inl). rewrite /pad2blocks /(\o) /wblock2bits_list paddings_same /wblocks2bits. elim (loadpad2wblocks mem inp inl). @@ -187,9 +192,10 @@ lemma storeblocks_correct mem out outlen n z : lemma spec_correct mem outp outl: equiv [ Sponge(Pideal).f ~ Spec(Preal).f : - Glob.mem{2} = mem /\ bs{1} = memr2bits mem inp{2} inlen{2} ++ domain_bits /\ - outlen{2} = outl /\ validins n{1} outlen{2} /\ out{2} = outp - ==> eqmem_except mem Glob.mem{2} outp outl /\ + Glob.mem{2} = mem /\ + bs{1} = memr2bits mem inp{2} inlen{2} ++ domain_bits ++ suffix_bits /\ + outlen{2} = outl /\ validins n{1} outlen{2} /\ out{2} = outp + ==> eqmem_except mem Glob.mem{2} outp outl /\ res{1} = memr2bits Glob.mem{2} outp outl]. proc. seq 4 4 : ( From 0abc482c3d8d8ede70af9586697168d484544025 Mon Sep 17 00:00:00 2001 From: Manuel Barbosa Date: Fri, 12 Apr 2019 11:04:27 +0300 Subject: [PATCH 346/525] documenting --- proof/impl/Spec.ec | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/proof/impl/Spec.ec b/proof/impl/Spec.ec index 16f85e2..160a503 100644 --- a/proof/impl/Spec.ec +++ b/proof/impl/Spec.ec @@ -1,5 +1,6 @@ require import AllCore List Int IntDiv. from Jasmin require import JArray JMemory JModel JUtils JWord JWord_array. +require import JArray JMemory JModel JUtils JWord JWord_array. require import Sponge. import Common. import Block. @@ -9,12 +10,12 @@ clone export PolyArray as Array25 with op size <- 25. op domain_bits : bool list. -(* we will fix domain bits without the 1 that signals padding start *) +(* domain bits are used to distinguish usages of the Sponge in standard *) axiom domain_bits_len : size domain_bits = 2. op suffix_bits : bool list. -(* we will fix domain bits without the 1 that signals padding start *) +(* additional suffix bits are allowed for construction usage *) axiom suffix_bits_len : size suffix_bits < 3. type state = W64.t Array25.t. From 69808d8621b0da7a434ecb0712f3c79de48f86d9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Mon, 15 Apr 2019 10:21:58 +0100 Subject: [PATCH 347/525] Fixing Spec import --- proof/impl/Spec.ec | 1 - 1 file changed, 1 deletion(-) diff --git a/proof/impl/Spec.ec b/proof/impl/Spec.ec index 160a503..b7cf9e1 100644 --- a/proof/impl/Spec.ec +++ b/proof/impl/Spec.ec @@ -1,6 +1,5 @@ require import AllCore List Int IntDiv. from Jasmin require import JArray JMemory JModel JUtils JWord JWord_array. -require import JArray JMemory JModel JUtils JWord JWord_array. require import Sponge. import Common. import Block. From 03d75561c4a05b585db78d86351ee5ff7a3d0c46 Mon Sep 17 00:00:00 2001 From: Manuel Barbosa Date: Mon, 15 Apr 2019 19:47:12 +0300 Subject: [PATCH 348/525] Progressing in Spec --- proof/impl/Spec.ec | 422 +++++++++++++++++++++++++++++++++++++++++---- 1 file changed, 387 insertions(+), 35 deletions(-) diff --git a/proof/impl/Spec.ec b/proof/impl/Spec.ec index 160a503..a89df3b 100644 --- a/proof/impl/Spec.ec +++ b/proof/impl/Spec.ec @@ -1,6 +1,5 @@ require import AllCore List Int IntDiv. from Jasmin require import JArray JMemory JModel JUtils JWord JWord_array. -require import JArray JMemory JModel JUtils JWord JWord_array. require import Sponge. import Common. import Block. @@ -20,15 +19,47 @@ axiom suffix_bits_len : size suffix_bits < 3. type state = W64.t Array25.t. +(* True for all state sizes we will consider *) +axiom wstate_size (x : state) : + size (flatten (map W64.w2bits (Array25.to_list x))) = (r + c). +axiom rsize : r %% 64 = 0. + +lemma wstate_size_val: r+c = 1600. +move : (wstate_size (Array25.of_list witness (mkseq (fun (i : int) => (of_list W64.zero []).[i]) 25))). +rewrite of_listK. apply size_mkseq. +rewrite /flatten. +rewrite (_: (mkseq (fun (i0 : int) => (of_list W64.zero []).[i0]) 25) = + (W64.zero :: W64.zero :: W64.zero :: W64.zero :: W64.zero :: + W64.zero :: W64.zero :: W64.zero :: W64.zero :: W64.zero :: + W64.zero :: W64.zero :: W64.zero :: W64.zero :: W64.zero :: + W64.zero :: W64.zero :: W64.zero :: W64.zero :: W64.zero :: + W64.zero :: W64.zero :: W64.zero :: W64.zero :: W64.zero :: [])). +by auto => />. +rewrite (_: + (foldr (++) [] + (map W64.w2bits + [W64.zero; W64.zero; W64.zero; W64.zero; W64.zero; W64.zero; + W64.zero; W64.zero; W64.zero; W64.zero; W64.zero; W64.zero; + W64.zero; W64.zero; W64.zero; W64.zero; W64.zero; W64.zero; + W64.zero; W64.zero; W64.zero; W64.zero; W64.zero; W64.zero; + W64.zero])) = + (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ + (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ + (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ + (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ + (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero)). +by auto => />. +simplify. smt(). +qed. + op memr2bits( mem : global_mem_t, ptr : int, len : int) = - foldr (fun w bs => bs ++ (W8.w2bits w)) [] - (map (fun o => mem.[ptr + o]) (iota_ 0 len)). + flatten (map (fun o => W8.w2bits (mem.[ptr + o])) (iota_ 0 len)). op eqmem_except(mem1 : global_mem_t, mem2 : global_mem_t, ptr : int, o : int) = forall ad, ptr <= ad < ptr + o => mem1.[ad] = mem2.[ad]. op state2bc(st : state) : block * capacity = - let stbits = (foldr (fun bl bs => (W64.w2bits bl) ++ bs) [] (to_list st)) + let stbits = flatten (map W64.w2bits (to_list st)) in (mkblock (take r stbits), mkcapacity (drop r stbits)). module type PermT = { @@ -37,14 +68,139 @@ module type PermT = { type wblock = W64.t list. -(* True for all block sizes we will consider *) -axiom wblock_size x : - size (foldr (fun (bl : W64.t) (bs : bool list) => w2bits bl ++ bs) [] x) = r. +op pad1byte = domain_bits ++ suffix_bits ++ [true] ++ nseq (8 - (size domain_bits) - (size suffix_bits) - 2) false ++ [true]. +op padqstart = domain_bits ++ suffix_bits ++ [true] ++ nseq (8 - (size domain_bits) - (size suffix_bits - 1 )) false. +op padq0 = nseq 8 false. +op padqend = nseq 7 false ++ [true]. +op padbytes(q : int) = + if q = 1 + then [ pad1byte ] + else [ padqstart ] ++ nseq (q-2) padq0 ++ [padqend ]. + +op bytewisepad(s) = + let q = (r %/ 8) - (((size s) %/ 8) %% (r %/ 8)) + in s ++ flatten (padbytes q). + +op loadpad2wblocks(mem : global_mem_t, ptr : int, len : int) = + let msgbits = bytewisepad (memr2bits mem ptr len) + in map (fun b => map W64.bits2w (BitEncoding.BitChunking.chunk 64 (ofblock b))) + (bits2blocks (msgbits)). + +lemma bound_conv (s : bool list) q : size s %% 8 = 0 => r %/ 8 - size s %/ 8 %% (r %/ 8) = q => (size s + q) %% r = 0. +admitted. + +lemma samepad s : + size s %% 8 = 0 => + bytewisepad s = pad (s ++ domain_bits ++ suffix_bits). +move => *. +rewrite /bytewisepad /padbytes /pad /mkpad /num0. +progress. +case (r %/ 8 - size s %/ 8 %% (r %/ 8) = 1). +move => *. +rewrite /pad1byte. +rewrite (_: 8 - size domain_bits - size suffix_bits - 2 = (- (size (s ++ domain_bits ++ suffix_bits) + 2)) %% r). +rewrite !size_cat. +rewrite domain_bits_len. +case (size suffix_bits = 0). +move => suffix_bits_len. +rewrite suffix_bits_len. +simplify. +move : (bound_conv s 1 H). smt. +move => *. +case (size suffix_bits = 1). +move => suffix_bits_len. +rewrite suffix_bits_len. +simplify. +move : (bound_conv s 1 H). smt. +move => *. +rewrite (_ : size suffix_bits = 2). smt. +simplify. +move : (bound_conv s 1 H). smt. +rewrite flatten_seq1. +rewrite -catA -catA -catA -catA -catA. +apply eqseq_cat. by trivial. simplify. +rewrite -catA. +apply eqseq_cat. by trivial. simplify. +apply eqseq_cat. by trivial. simplify. +by smt. +move => *. +rewrite /padqstart /padqend. +pose q := r %/ 8 - size s %/ 8 %% (r %/ 8). +rewrite flatten_cons. +rewrite -catA -catA -catA -catA -catA. +rewrite (eqseq_cat). by trivial. simplify. +rewrite (eqseq_cat). by trivial. simplify. +rewrite (eqseq_cat). by trivial. simplify. +rewrite (_: flatten (nseq (q - 2) padq0 ++ + [[false; false; false; false; false; false; false; true]]) = + rcons (nseq (8*(q-2) + 7) false) true). +admit. +rewrite (_ : nseq (8 - size domain_bits - (size suffix_bits - 1)) false ++ +rcons (nseq (8 * (q - 2) + 7) false) true = + rcons (nseq (8 - size domain_bits - size suffix_bits - 1 + 8 * (q - 2) + 7) false) true). rewrite -rcons_cat. +admit. +rewrite (_: 8 - size domain_bits - size suffix_bits - 1 + 8 * (q - 2) + 7= (- (size (s ++ domain_bits ++ suffix_bits) + 2)) %% r). +rewrite !size_cat. +rewrite domain_bits_len. +have bb : (size s + q) %% r = 0. smt. +case (size suffix_bits = 0). +move => suffix_bits_len. +rewrite suffix_bits_len. +simplify. +ring. +admit. +move => *. +case (size suffix_bits = 1). +move => suffix_bits_len. +rewrite suffix_bits_len. +simplify. +ring. +admit. +move => *. +rewrite (_ : size suffix_bits = 2). smt. +simplify. +ring. +admit. +by trivial. +qed. + +lemma sizepload mem inp inl: (size (memr2bits mem inp inl) = 8 * (max 0 inl)). +rewrite /memr2bits. +simplify. +rewrite size_flatten. +auto => />. +rewrite /sumz. +rewrite -map_comp /(\o) => //=. +rewrite foldr_map. +rewrite (_ : 8*(max 0 inl) = 8* (size (iota_ 0 inl))). rewrite size_iota. by trivial. +elim (iota_ 0 inl). smt. smt. +qed. -(* This will load all bytes to packed W64, then pack those into blocks. - Domain byte is added as well, which will be domain_bits followed by a 1. - Everything is extended with 0s up to full block. *) -op loadpad2wblocks : global_mem_t -> int -> int -> wblock list. +lemma blocksizes mem inp inl b: + b \in (loadpad2wblocks mem inp inl) => size b = r %/ 64. +rewrite /loadpad2wblocks samepad. smt. +simplify. +rewrite /bits2blocks. +have sizebs : forall b0, + b0 \in (map mkblock + (chunk (pad (memr2bits mem inp inl ++ domain_bits ++ suffix_bits)))) => + size (ofblock b0) = r. +move => b0 H. +apply (size_block b0). +have sizecs : forall b0, + b0 \in (map mkblock + (chunk (pad (memr2bits mem inp inl ++ domain_bits ++ suffix_bits)))) => + size ((BitEncoding.BitChunking.chunk 64 (ofblock b0))) = r %/ 64. +smt. +move => H. +move : (mapP + (fun (b0 : block) => + map W64.bits2w (BitEncoding.BitChunking.chunk 64 (ofblock b0))) + ((map mkblock + (chunk + (pad (memr2bits mem inp inl ++ domain_bits ++ suffix_bits))))) b). +smt. +qed. (* Stores up to len bytes in memory from list of blocks *) op storeblocks : global_mem_t -> int -> int -> wblock list -> global_mem_t. @@ -96,44 +252,234 @@ axiom perm_correct : res{1} = state2bc res{2}]. op wblock2block(wb : wblock) : block = - mkblock (foldr (fun bl bs => (W64.w2bits bl) ++ bs) [] wb). + mkblock (flatten (map W64.w2bits wb)). op wblocks2bits(wbs : wblock list) : bool list = - foldr (fun bl bs => ofblock (wblock2block bl) ++ bs) [] wbs. + flatten (List.map (fun bl => ofblock (wblock2block bl)) wbs). op wblock2bits_list(wbs : wblock list) : block list = - foldr (fun bl bs => (wblock2block bl) :: bs) [] wbs. + map wblock2block wbs. lemma wblocks2bits_empty : [] = wblocks2bits [] by auto => />. lemma state0conv : (b0, c0) = state2bc state0. -rewrite /state2bc. rewrite /b0 /c0 /state0. -admit. (* provable *) +rewrite /state2bc /b0 /c0 /offun. +rewrite (_: flatten (map W64.w2bits (to_list state0)) = (mkseq (fun _ => false) (r+c))). +rewrite /state0 /to_list wstate_size_val. +apply (eq_from_nth witness). +rewrite size_mkseq. +move : (wstate_size (Array25.of_list witness (mkseq (fun (i : int) => (of_list W64.zero []).[i]) 25))). +rewrite of_listK. apply size_mkseq. +move => *. rewrite H. +rewrite wstate_size_val. smt(). +rewrite (_ : size + (flatten + (map W64.w2bits + (mkseq (fun (i0 : int) => (of_list W64.zero []).[i0]) 25))) = 1600). +move : (wstate_size (Array25.of_list witness (mkseq (fun (i : int) => (of_list W64.zero []).[i]) 25))). +rewrite of_listK. apply size_mkseq. +rewrite wstate_size_val. smt(). +move => *. +rewrite (_: nth witness (mkseq (fun _ => false) (1600)) i = false). +rewrite nth_mkseq. smt(). smt(). +rewrite (_: (mkseq (fun (i0 : int) => (of_list W64.zero []).[i0]) 25) = + (W64.zero :: W64.zero :: W64.zero :: W64.zero :: W64.zero :: + W64.zero :: W64.zero :: W64.zero :: W64.zero :: W64.zero :: + W64.zero :: W64.zero :: W64.zero :: W64.zero :: W64.zero :: + W64.zero :: W64.zero :: W64.zero :: W64.zero :: W64.zero :: + W64.zero :: W64.zero :: W64.zero :: W64.zero :: W64.zero :: [])). +by auto => />. +rewrite (_: + (foldr (fun (bl : W64.t) (bs : bool list) => w2bits bl ++ bs) [] + [W64.zero; W64.zero; W64.zero; W64.zero; W64.zero; W64.zero; W64.zero; + W64.zero; W64.zero; W64.zero; W64.zero; W64.zero; W64.zero; W64.zero; + W64.zero; W64.zero; W64.zero; W64.zero; W64.zero; W64.zero; W64.zero; + W64.zero; W64.zero; W64.zero; W64.zero]) = + (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ + (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ + (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ + (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ + (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero)). +by auto => />. +rewrite /w2bits. +rewrite -mkseq_add. smt(). smt(). +rewrite -mkseq_add. smt(). smt(). +rewrite -mkseq_add. smt(). smt(). +rewrite -mkseq_add. smt(). smt(). +rewrite -mkseq_add. smt(). smt(). +rewrite -mkseq_add. smt(). smt(). +rewrite -mkseq_add. smt(). smt(). +rewrite -mkseq_add. smt(). smt(). +rewrite -mkseq_add. smt(). smt(). +rewrite -mkseq_add. smt(). smt(). +rewrite -mkseq_add. smt(). smt(). +rewrite -mkseq_add. smt(). smt(). +rewrite -mkseq_add. smt(). smt(). +rewrite -mkseq_add. smt(). smt(). +rewrite -mkseq_add. smt(). smt(). +rewrite -mkseq_add. smt(). smt(). +rewrite -mkseq_add. smt(). smt(). +rewrite -mkseq_add. smt(). smt(). +rewrite -mkseq_add. smt(). smt(). +rewrite -mkseq_add. smt(). smt(). +rewrite -mkseq_add. smt(). smt(). +rewrite -mkseq_add. smt(). smt(). +rewrite -mkseq_add. smt(). smt(). +rewrite -mkseq_add. smt(). smt(). +simplify. +rewrite nth_mkseq. +smt(). smt(). +rewrite mkseq_add. smt. smt. +pose stbits := mkseq (fun _ => false) r ++ + mkseq (fun (i : int) => (fun _ => false) (r + i)) c. +simplify. +split. +rewrite (_:take r stbits = mkseq (fun _ => false) r). +rewrite take_cat. +rewrite size_mkseq. +rewrite (_ : r < max 0 r = false); first by smt. +simplify. +rewrite (_ : r - max 0 r = 0); first by smt. +rewrite take0 cats0. +by trivial. +by trivial. +rewrite drop_cat. +rewrite size_mkseq. +rewrite (_ : r < max 0 r = false); first by smt. +simplify. +rewrite (_ : r - max 0 r = 0); first by smt. +rewrite drop0. +by trivial. qed. -(* will need to be proved once loadpad2wblocks is defined *) lemma paddings_same mem inp inl: pad (memr2bits mem inp inl ++ domain_bits ++ suffix_bits) = - wblocks2bits (loadpad2wblocks mem inp inl) by admit. + wblocks2bits (loadpad2wblocks mem inp inl). +rewrite /loadpad2wblocks samepad. smt. +rewrite /wblocks2bits. +pose ll := pad (memr2bits mem inp inl ++ domain_bits ++ suffix_bits). +simplify. +rewrite /wblock2block -map_comp -map_comp /(\o) => //=. +have sizell : size ll %% 64 = 0. smt. +have sizebs : forall x, x \in chunk ll => size x = r. smt. +have sizebs1 : forall x, x \in chunk ll => forall y, y \in (BitEncoding.BitChunking.chunk 64 x) => size y = 64. smt. +have xx : (forall x, x \in chunk ll => (flatten + (map W64.w2bits + (map W64.bits2w + ((BitEncoding.BitChunking.chunk 64 (ofblock (mkblock x))))))) = x). +move => *. rewrite ofblockK. smt. +rewrite -map_comp. +rewrite (_: map (W64.w2bits \o W64.bits2w) (BitEncoding.BitChunking.chunk 64 x) = BitEncoding.BitChunking.chunk 64 x). rewrite /(\o). +have xxx : forall x0, x0 \in ((BitEncoding.BitChunking.chunk 64 x)) => w2bits ((bits2w x0))%W64 = x0. +move : (sizebs1 x H) => *. +move => *. +move : (sizebs1 x H x0 H1). move => *. +apply (W64.bits2wK) => //=. +rewrite {2} (_ : (BitEncoding.BitChunking.chunk 64 x) = map (fun x => x) (BitEncoding.BitChunking.chunk 64 x)). rewrite (id_map). smt(). by trivial. +move : (eq_in_map ((fun (x0 : bool list) => w2bits ((bits2w x0))%W64)) (fun x => x) (BitEncoding.BitChunking.chunk 64 x)) => [/ # [ ]] *. +move : (H0 xxx). smt(). +apply (BitEncoding.BitChunking.chunkK 64 _ _ _). smt(). smt. +have : (forall (x : bool list), + x \in chunk ll => + (fun (x0 : bool list) => + ofblock + (mkblock + (flatten + (map W64.w2bits + (map W64.bits2w + ((BitEncoding.BitChunking.chunk 64 (ofblock (mkblock x0))))))))) x = x). +progress. +move : (xx x H) => *. +rewrite H0. apply ofblockK. smt. +move => *. +rewrite (_ : (map + (fun (x : bool list) => + ofblock + (mkblock + (flatten + (map W64.w2bits + (map W64.bits2w + ((BitEncoding.BitChunking.chunk 64 (ofblock (mkblock x))))))))) + (chunk ll)) = chunk ll). +rewrite {2} (_: chunk ll = map (fun x => x) (chunk ll)). rewrite (id_map). smt(). by trivial. +move : (eq_in_map ((fun (x0 : bool list) => + ofblock + (mkblock + (flatten + (map W64.w2bits + (map W64.bits2w + ((BitEncoding.BitChunking.chunk 64 (ofblock (mkblock x0)))))))))) + (fun x0 => x0) (chunk ll)) => [/ # [ ]] *. +move : (H0 H). smt(). +rewrite chunkK. smt. +by trivial. +qed. lemma liftpadding mem inp inl : pad2blocks (memr2bits mem inp inl ++ domain_bits ++ suffix_bits) = - wblock2bits_list (loadpad2wblocks mem inp inl). -rewrite /pad2blocks /(\o) /wblock2bits_list paddings_same /wblocks2bits. -elim (loadpad2wblocks mem inp inl). -smt. -progress. -move : H. -rewrite /wblock2block. -rewrite ofblockK;first by apply wblock_size. + wblock2bits_list (loadpad2wblocks mem inp inl). +rewrite /pad2blocks /(\o) paddings_same /wblocks2bits => //=. +rewrite /bits2blocks. +rewrite flattenK. +move => b. +rewrite /loadpad2wblocks samepad. smt. +simplify. +pose ll := pad (memr2bits mem inp inl ++ domain_bits ++ suffix_bits). +rewrite /wblock2block -map_comp -map_comp /(\o) => //=. +have sizell : size ll %% 64 = 0. smt. +have sizebs : forall x, x \in chunk ll => size x = r. smt. + +have sizebs1 : forall x, x \in chunk ll => forall y, y \in (BitEncoding.BitChunking.chunk 64 x) => size y = 64. smt. +have xx : (forall x, x \in chunk ll => (flatten + (map W64.w2bits + (map W64.bits2w + ((BitEncoding.BitChunking.chunk 64 (ofblock (mkblock x))))))) = x). +move => *. rewrite ofblockK. smt. +rewrite -map_comp. +rewrite (_: map (W64.w2bits \o W64.bits2w) (BitEncoding.BitChunking.chunk 64 x) = BitEncoding.BitChunking.chunk 64 x). rewrite /(\o). +have xxx : forall x0, x0 \in ((BitEncoding.BitChunking.chunk 64 x)) => w2bits ((bits2w x0))%W64 = x0. +move : (sizebs1 x H) => *. move => *. -rewrite -H. -rewrite /bits2blocks. -rewrite -map_cons. -rewrite chunk_cat. rewrite wblock_size. by apply dvdzz. -rewrite chunk_sing. rewrite wblock_size. by trivial. -rewrite cat1s. -by trivial. +move : (sizebs1 x H x0 H1). move => *. +apply (W64.bits2wK) => //=. +rewrite {2} (_ : (BitEncoding.BitChunking.chunk 64 x) = map (fun x => x) (BitEncoding.BitChunking.chunk 64 x)). rewrite (id_map). smt(). by trivial. +move : (eq_in_map ((fun (x0 : bool list) => w2bits ((bits2w x0))%W64)) (fun x => x) (BitEncoding.BitChunking.chunk 64 x)) => [/ # [ ]] *. +move : (H0 xxx). smt(). +apply (BitEncoding.BitChunking.chunkK 64 _ _ _). smt(). smt. +have : (forall (x : bool list), + x \in chunk ll => + (fun (x0 : bool list) => + ofblock + (mkblock + (flatten + (map W64.w2bits + (map W64.bits2w + ((BitEncoding.BitChunking.chunk 64 (ofblock (mkblock x0))))))))) x = x). +progress. +move : (xx x H) => *. +rewrite H0. apply ofblockK. smt. +move => H. +rewrite (_ : (map + (fun (x : bool list) => + ofblock + (mkblock + (flatten + (map W64.w2bits + (map W64.bits2w + ((BitEncoding.BitChunking.chunk 64 (ofblock (mkblock x))))))))) + (chunk ll)) = chunk ll). +rewrite {2} (_: chunk ll = map (fun x => x) (chunk ll)). rewrite (id_map). smt(). by trivial. +move : (eq_in_map ((fun (x0 : bool list) => + ofblock + (mkblock + (flatten + (map W64.w2bits + (map W64.bits2w + ((BitEncoding.BitChunking.chunk 64 (ofblock (mkblock x0)))))))))) + (fun x0 => x0) (chunk ll)) => [/ # [ ]] *. +move : (H0 H). smt(). smt. +rewrite -map_comp /(\o) /wblock2bits_list /wblock2block. +apply eq_map. progress. rewrite mkblockK. by trivial. qed. lemma lift_combine sa sc st xs : @@ -167,8 +513,13 @@ qed. lemma commuteappend z sa st sc : (sa, sc) = state2bc st => - wblocks2bits z ++ ofblock sa = wblocks2bits (z ++ [squeezeb st]) - by admit. (* provable *) + wblocks2bits z ++ ofblock sa = wblocks2bits (z ++ [squeezeb st]). +rewrite /state2bc => //=. move => [/ # ] *. +rewrite /wblocks2bits /wblock2block. +rewrite H. rewrite ofblockK. smt. +rewrite /squeezeb. + admit. (* provable *) +qed. op validins(n : int, outl : int) = n = outl * 8. @@ -225,3 +576,4 @@ apply(sizes1 i{2} n{1} outlen{2} H) => //=. apply(sizes2 i{2} n{1} outlen{2} H) => //=. wp;skip;progress;smt(store_blocks_safe storeblocks_correct). qed. + From 484c2cef96f5cb68f109c461cbaef4a69c12fafd Mon Sep 17 00:00:00 2001 From: Manuel Barbosa Date: Tue, 16 Apr 2019 00:02:49 +0300 Subject: [PATCH 349/525] progressing in spec --- proof/impl/Spec.ec | 73 +++++++++++++++++++++++++++++++++++++--------- 1 file changed, 59 insertions(+), 14 deletions(-) diff --git a/proof/impl/Spec.ec b/proof/impl/Spec.ec index a89df3b..e6df5c4 100644 --- a/proof/impl/Spec.ec +++ b/proof/impl/Spec.ec @@ -1,5 +1,5 @@ require import AllCore List Int IntDiv. -from Jasmin require import JArray JMemory JModel JUtils JWord JWord_array. +(*from Jasmin*) require import JArray JMemory JModel JUtils JWord JWord_array. require import Sponge. import Common. import Block. @@ -86,8 +86,21 @@ op loadpad2wblocks(mem : global_mem_t, ptr : int, len : int) = in map (fun b => map W64.bits2w (BitEncoding.BitChunking.chunk 64 (ofblock b))) (bits2blocks (msgbits)). -lemma bound_conv (s : bool list) q : size s %% 8 = 0 => r %/ 8 - size s %/ 8 %% (r %/ 8) = q => (size s + q) %% r = 0. -admitted. +lemma bound_conv (s : bool list) q : + size s %% 8 = 0 => + r %/ 8 - size s %/ 8 %% (r %/ 8) = q => + (size s + q*8) %% r = 0. +move => *. +have rr : r - 8*(size s %/ 8 %% (r %/ 8)) = 8*q. smt. +move : rr. +rewrite (mulz_modr 8). smt(). +rewrite (_: 8 * (size s %/ 8) %% (8 * (r %/ 8)) = size s %% r). smt. +rewrite (_: size s + q * 8 = q * 8 + size s). smt(). +rewrite -modzDmr. +move => *. +rewrite (_: size s %% r = r - 8 * q ). smt(). +smt. +qed. lemma samepad s : size s %% 8 = 0 => @@ -98,6 +111,13 @@ progress. case (r %/ 8 - size s %/ 8 %% (r %/ 8) = 1). move => *. rewrite /pad1byte. +rewrite flatten_seq1. +rewrite -catA -catA -catA -catA -catA. +apply eqseq_cat. by trivial. simplify. +rewrite -catA. +apply eqseq_cat. by trivial. simplify. +apply eqseq_cat. by trivial. simplify. +move : (bound_conv s 1 H H0) => *. rewrite (_: 8 - size domain_bits - size suffix_bits - 2 = (- (size (s ++ domain_bits ++ suffix_bits) + 2)) %% r). rewrite !size_cat. rewrite domain_bits_len. @@ -105,23 +125,32 @@ case (size suffix_bits = 0). move => suffix_bits_len. rewrite suffix_bits_len. simplify. -move : (bound_conv s 1 H). smt. +rewrite modNz. smt. smt. +simplify. ring. +rewrite (_: size s + 3 = (size s + 1*8) - 5 ). smt(). +rewrite -modzDm. rewrite H1. simplify. +rewrite modz_mod modNz. smt. smt. +rewrite modz_small. smt. by ring. move => *. case (size suffix_bits = 1). move => suffix_bits_len. rewrite suffix_bits_len. simplify. -move : (bound_conv s 1 H). smt. +rewrite modNz. smt. smt. +simplify. ring. +rewrite (_: size s + 4 = (size s + 1*8) - 4 ). smt(). +rewrite -modzDm. rewrite H1. simplify. +rewrite modz_mod modNz. smt. smt. +rewrite modz_small. smt. by ring. move => *. -rewrite (_ : size suffix_bits = 2). smt. +rewrite (_: size suffix_bits = 2). smt. simplify. -move : (bound_conv s 1 H). smt. -rewrite flatten_seq1. -rewrite -catA -catA -catA -catA -catA. -apply eqseq_cat. by trivial. simplify. -rewrite -catA. -apply eqseq_cat. by trivial. simplify. -apply eqseq_cat. by trivial. simplify. +rewrite modNz. smt. smt. +simplify. ring. +rewrite (_: size s + 5 = (size s + 1*8) - 3 ). smt(). +rewrite -modzDm. rewrite H1. simplify. +rewrite modz_mod modNz. smt. smt. +rewrite modz_small. smt. by ring. by smt. move => *. rewrite /padqstart /padqend. @@ -142,12 +171,18 @@ admit. rewrite (_: 8 - size domain_bits - size suffix_bits - 1 + 8 * (q - 2) + 7= (- (size (s ++ domain_bits ++ suffix_bits) + 2)) %% r). rewrite !size_cat. rewrite domain_bits_len. -have bb : (size s + q) %% r = 0. smt. +have qval : (r %/ 8 - size s %/ 8 %% (r %/ 8) = q). smt(). +move : (bound_conv s q H qval) => *. case (size suffix_bits = 0). move => suffix_bits_len. rewrite suffix_bits_len. simplify. ring. +rewrite modNz. smt. smt. +simplify. ring. +move : (dvdzP (r)(size s + q * 8)) => [ ] *. +move : (H2 H1). +progress. admit. move => *. case (size suffix_bits = 1). @@ -155,11 +190,21 @@ move => suffix_bits_len. rewrite suffix_bits_len. simplify. ring. +rewrite modNz. smt. smt. +simplify. ring. +move : (dvdzP (r)(size s + q * 8)) => [ ] *. +move : (H3 H1). +progress. admit. move => *. rewrite (_ : size suffix_bits = 2). smt. simplify. ring. +rewrite modNz. smt. smt. +simplify. ring. +move : (dvdzP (r)(size s + q * 8)) => [ ] *. +move : (H4 H1). +progress. admit. by trivial. qed. From 1edd278eb9a82204c5bfc5f447120a777bbc796c Mon Sep 17 00:00:00 2001 From: Manuel Barbosa Date: Tue, 16 Apr 2019 09:36:11 +0300 Subject: [PATCH 350/525] Progressing in Spec --- proof/impl/Spec.ec | 43 ++++++++++++++++++++++++++++++++++++++----- 1 file changed, 38 insertions(+), 5 deletions(-) diff --git a/proof/impl/Spec.ec b/proof/impl/Spec.ec index e6df5c4..5530283 100644 --- a/proof/impl/Spec.ec +++ b/proof/impl/Spec.ec @@ -1,5 +1,5 @@ require import AllCore List Int IntDiv. -(*from Jasmin*) require import JArray JMemory JModel JUtils JWord JWord_array. +from Jasmin require import JArray JMemory JModel JUtils JWord JWord_array. require import Sponge. import Common. import Block. @@ -69,7 +69,7 @@ module type PermT = { type wblock = W64.t list. op pad1byte = domain_bits ++ suffix_bits ++ [true] ++ nseq (8 - (size domain_bits) - (size suffix_bits) - 2) false ++ [true]. -op padqstart = domain_bits ++ suffix_bits ++ [true] ++ nseq (8 - (size domain_bits) - (size suffix_bits - 1 )) false. +op padqstart = domain_bits ++ suffix_bits ++ [true] ++ nseq (8 - (size domain_bits) - (size suffix_bits) - 1) false. op padq0 = nseq 8 false. op padqend = nseq 7 false ++ [true]. op padbytes(q : int) = @@ -102,6 +102,14 @@ rewrite (_: size s %% r = r - 8 * q ). smt(). smt. qed. +lemma nseq_cat n1 n2 : + nseq n1 false ++ nseq n2 false = nseq (n1+n2) false. +admitted. + +lemma nseq_comp n1 n2 : + flatten (nseq n1 (nseq n2 false)) = nseq (n1 * n2) false. +admitted. + lemma samepad s : size s %% 8 = 0 => bytewisepad s = pad (s ++ domain_bits ++ suffix_bits). @@ -163,11 +171,36 @@ rewrite (eqseq_cat). by trivial. simplify. rewrite (_: flatten (nseq (q - 2) padq0 ++ [[false; false; false; false; false; false; false; true]]) = rcons (nseq (8*(q-2) + 7) false) true). -admit. -rewrite (_ : nseq (8 - size domain_bits - (size suffix_bits - 1)) false ++ +rewrite flatten_cat flatten_seq1. search rcons. +rewrite (_: rcons (nseq (8 * (q - 2) + 7) false) true = nseq (8 * (q - 2) + 7) false ++ (true :: [])). smt. +rewrite (_ : 8 * (q - 2) + 7 = 8 * (q - 2) + 6 + 1); first by smt(). +rewrite nseqSr. smt. +rewrite cat_rcons. +rewrite (_ : 8 * (q - 2) + 6 = 8 * (q - 2) + 5 + 1); first by smt(). +rewrite nseqSr. smt. +rewrite cat_rcons. +rewrite (_ : 8 * (q - 2) + 5 = 8 * (q - 2) + 4 + 1); first by smt(). +rewrite nseqSr. smt. +rewrite cat_rcons. +rewrite (_ : 8 * (q - 2) + 4 = 8 * (q - 2) + 3 + 1); first by smt(). +rewrite nseqSr. smt. +rewrite cat_rcons. +rewrite (_ : 8 * (q - 2) + 3 = 8 * (q - 2) + 2 + 1); first by smt(). +rewrite nseqSr. smt. +rewrite cat_rcons. +rewrite (_ : 8 * (q - 2) + 2 = 8 * (q - 2) + 1 + 1); first by smt(). +rewrite nseqSr. smt. +rewrite cat_rcons. +rewrite nseqSr. smt. +rewrite cat_rcons. +rewrite /padq0. +rewrite nseq_comp. smt(). +rewrite (_ : nseq (8 - size domain_bits - size suffix_bits - 1) false ++ rcons (nseq (8 * (q - 2) + 7) false) true = rcons (nseq (8 - size domain_bits - size suffix_bits - 1 + 8 * (q - 2) + 7) false) true). rewrite -rcons_cat. -admit. +rewrite nseq_cat. +rewrite (_ : 8 - size domain_bits - size suffix_bits - 1 + (8 * (q - 2) + 7) = 8 - size domain_bits - size suffix_bits - 1 + 8 * (q - 2) + 7). by ring. +by trivial. rewrite (_: 8 - size domain_bits - size suffix_bits - 1 + 8 * (q - 2) + 7= (- (size (s ++ domain_bits ++ suffix_bits) + 2)) %% r). rewrite !size_cat. rewrite domain_bits_len. From 8792d902de60e85940e4c6c0ed9ca234d2bde1b7 Mon Sep 17 00:00:00 2001 From: Manuel Barbosa Date: Tue, 16 Apr 2019 11:01:25 +0300 Subject: [PATCH 351/525] Spec stable --- proof/impl/Spec.ec | 37 +++++++++++++++++++++++++++++++++---- 1 file changed, 33 insertions(+), 4 deletions(-) diff --git a/proof/impl/Spec.ec b/proof/impl/Spec.ec index 5530283..6fce825 100644 --- a/proof/impl/Spec.ec +++ b/proof/impl/Spec.ec @@ -206,6 +206,8 @@ rewrite !size_cat. rewrite domain_bits_len. have qval : (r %/ 8 - size s %/ 8 %% (r %/ 8) = q). smt(). move : (bound_conv s q H qval) => *. +have qlbound : 1 <= q. smt. +have qubound : q * 8 <= r. smt. case (size suffix_bits = 0). move => suffix_bits_len. rewrite suffix_bits_len. @@ -216,7 +218,16 @@ simplify. ring. move : (dvdzP (r)(size s + q * 8)) => [ ] *. move : (H2 H1). progress. -admit. +rewrite (_: size s = q0*r - q*8). smt(). +rewrite (_ : (q0 * r - q * 8 + 3) %% r = (-(q*8 - 3)) %% r). +rewrite (_ : (q0 * r - q * 8 + 3) %% r = (q0 * r + (- q * 8 + 3)) %% r). +smt(). +rewrite (modzMDl). smt(). +have same : (- ( q * 8 - 3)) %% r = r - (q*8 - 3). +rewrite (modNz (q * 8 - 3) r). smt. smt. +ring. +rewrite modz_small. smt(). smt. +smt. move => *. case (size suffix_bits = 1). move => suffix_bits_len. @@ -228,7 +239,16 @@ simplify. ring. move : (dvdzP (r)(size s + q * 8)) => [ ] *. move : (H3 H1). progress. -admit. +rewrite (_: size s = q0*r - q*8). smt(). +rewrite (_ : (q0 * r - q * 8 + 4) %% r = (-(q*8 - 4)) %% r). +rewrite (_ : (q0 * r - q * 8 + 4) %% r = (q0 * r + (- q * 8 + 4)) %% r). +smt(). +rewrite (modzMDl). smt(). +have same : (- ( q * 8 - 4)) %% r = r - (q*8 - 4). +rewrite (modNz (q * 8 - 4) r). smt. smt. +ring. +rewrite modz_small. smt(). smt. +smt. move => *. rewrite (_ : size suffix_bits = 2). smt. simplify. @@ -238,7 +258,16 @@ simplify. ring. move : (dvdzP (r)(size s + q * 8)) => [ ] *. move : (H4 H1). progress. -admit. +rewrite (_: size s = q0*r - q*8). smt(). +rewrite (_ : (q0 * r - q * 8 + 5) %% r = (-(q*8 - 5)) %% r). +rewrite (_ : (q0 * r - q * 8 + 5) %% r = (q0 * r + (- q * 8 + 5)) %% r). +smt(). +rewrite (modzMDl). smt(). +have same : (- ( q * 8 - 5)) %% r = r - (q*8 - 5). +rewrite (modNz (q * 8 - 5) r). smt. smt. +ring. +rewrite modz_small. smt(). smt. +smt. by trivial. qed. @@ -610,7 +639,7 @@ lemma sizes2 i n1 n2 : validins n1 n2 => i < convb n2 => i < (n1 + r - 1) %/ r by smt. -(* Will need to be proved once storeblocks is defined *) +(* Will need to be proved once storeblocks is defined. *) lemma store_blocks_safe mem out outlen z : eqmem_except mem (storeblocks mem out outlen z) out outlen by admit. From f1e9122ee46d32e5fc6cbf5b007cba7dc9ab7c1c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Tue, 16 Apr 2019 16:23:42 +0100 Subject: [PATCH 352/525] towards stabilizing Spec's smt calls --- proof/impl/Spec.ec | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) diff --git a/proof/impl/Spec.ec b/proof/impl/Spec.ec index 6fce825..98165e2 100644 --- a/proof/impl/Spec.ec +++ b/proof/impl/Spec.ec @@ -90,16 +90,18 @@ lemma bound_conv (s : bool list) q : size s %% 8 = 0 => r %/ 8 - size s %/ 8 %% (r %/ 8) = q => (size s + q*8) %% r = 0. -move => *. -have rr : r - 8*(size s %/ 8 %% (r %/ 8)) = 8*q. smt. +move=> *. +have rr : r - 8*(size s %/ 8 %% (r %/ 8)) = 8*q. ++ by rewrite {1}(andWl _ _ (edivzP r 8)) (:r %% 8 = 0) 1:[smt(rsize)] /#. move : rr. -rewrite (mulz_modr 8). smt(). -rewrite (_: 8 * (size s %/ 8) %% (8 * (r %/ 8)) = size s %% r). smt. -rewrite (_: size s + q * 8 = q * 8 + size s). smt(). +rewrite (mulz_modr 8) 1:/#. +rewrite (: 8 * (size s %/ 8) %% (8 * (r %/ 8)) = size s %% r). ++ by rewrite 2!(mulzC 8) 2!divzE H /= (: r %% 8 = 0) 1:[smt(rsize)]. +rewrite (: size s + q * 8 = q * 8 + size s) 1:/#. rewrite -modzDmr. move => *. -rewrite (_: size s %% r = r - 8 * q ). smt(). -smt. +rewrite (_: size s %% r = r - 8 * q ) 1:/#. +by rewrite (: q * 8 + (r - 8 * q) = r) 1:/# modzz. qed. lemma nseq_cat n1 n2 : From 010e211c57c085b3a06c41a18930988cde3a534e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Tue, 16 Apr 2019 18:25:51 +0100 Subject: [PATCH 353/525] a bit more smt stability --- proof/impl/Spec.ec | 42 ++++++++++++++++++++++-------------------- 1 file changed, 22 insertions(+), 20 deletions(-) diff --git a/proof/impl/Spec.ec b/proof/impl/Spec.ec index 98165e2..80984ee 100644 --- a/proof/impl/Spec.ec +++ b/proof/impl/Spec.ec @@ -135,33 +135,33 @@ case (size suffix_bits = 0). move => suffix_bits_len. rewrite suffix_bits_len. simplify. -rewrite modNz. smt. smt. +rewrite modNz. smt(size_ge0). exact/Block.gt0_n. simplify. ring. rewrite (_: size s + 3 = (size s + 1*8) - 5 ). smt(). rewrite -modzDm. rewrite H1. simplify. -rewrite modz_mod modNz. smt. smt. -rewrite modz_small. smt. by ring. +rewrite modz_mod modNz. smt(). exact/Block.gt0_n. +rewrite modz_small. smt(Block.gt0_n rsize). by ring. move => *. case (size suffix_bits = 1). move => suffix_bits_len. rewrite suffix_bits_len. simplify. -rewrite modNz. smt. smt. +rewrite modNz. smt(size_ge0). smt(Block.gt0_n). simplify. ring. rewrite (_: size s + 4 = (size s + 1*8) - 4 ). smt(). rewrite -modzDm. rewrite H1. simplify. -rewrite modz_mod modNz. smt. smt. -rewrite modz_small. smt. by ring. +rewrite modz_mod modNz. smt(). smt(Block.gt0_n). +rewrite modz_small. smt(Block.gt0_n rsize). by ring. move => *. -rewrite (_: size suffix_bits = 2). smt. +rewrite (_: size suffix_bits = 2). smt(size_ge0 suffix_bits_len). simplify. -rewrite modNz. smt. smt. +rewrite modNz. smt(size_ge0). smt(Block.gt0_n). simplify. ring. rewrite (_: size s + 5 = (size s + 1*8) - 3 ). smt(). rewrite -modzDm. rewrite H1. simplify. -rewrite modz_mod modNz. smt. smt. -rewrite modz_small. smt. by ring. -by smt. +rewrite modz_mod modNz. smt(). smt(Block.gt0_n). +rewrite modz_small. smt(Block.gt0_n rsize). by ring. +by rewrite cats1 catA. move => *. rewrite /padqstart /padqend. pose q := r %/ 8 - size s %/ 8 %% (r %/ 8). @@ -173,27 +173,29 @@ rewrite (eqseq_cat). by trivial. simplify. rewrite (_: flatten (nseq (q - 2) padq0 ++ [[false; false; false; false; false; false; false; true]]) = rcons (nseq (8*(q-2) + 7) false) true). -rewrite flatten_cat flatten_seq1. search rcons. -rewrite (_: rcons (nseq (8 * (q - 2) + 7) false) true = nseq (8 * (q - 2) + 7) false ++ (true :: [])). smt. +rewrite flatten_cat flatten_seq1. +rewrite -cats1. +have padlength_ge0: 0 <= 8 * (q - 2). ++ smt. rewrite (_ : 8 * (q - 2) + 7 = 8 * (q - 2) + 6 + 1); first by smt(). -rewrite nseqSr. smt. +rewrite nseqSr. smt(). rewrite cat_rcons. rewrite (_ : 8 * (q - 2) + 6 = 8 * (q - 2) + 5 + 1); first by smt(). -rewrite nseqSr. smt. +rewrite nseqSr. smt(). rewrite cat_rcons. rewrite (_ : 8 * (q - 2) + 5 = 8 * (q - 2) + 4 + 1); first by smt(). -rewrite nseqSr. smt. +rewrite nseqSr. smt(). rewrite cat_rcons. rewrite (_ : 8 * (q - 2) + 4 = 8 * (q - 2) + 3 + 1); first by smt(). -rewrite nseqSr. smt. +rewrite nseqSr. smt(). rewrite cat_rcons. rewrite (_ : 8 * (q - 2) + 3 = 8 * (q - 2) + 2 + 1); first by smt(). -rewrite nseqSr. smt. +rewrite nseqSr. smt(). rewrite cat_rcons. rewrite (_ : 8 * (q - 2) + 2 = 8 * (q - 2) + 1 + 1); first by smt(). -rewrite nseqSr. smt. +rewrite nseqSr. smt(). rewrite cat_rcons. -rewrite nseqSr. smt. +rewrite nseqSr. smt(). rewrite cat_rcons. rewrite /padq0. rewrite nseq_comp. smt(). From 85e0605ad4af41a0de998607e3abbf7b59ae8094 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Wed, 17 Apr 2019 09:41:30 +0100 Subject: [PATCH 354/525] remove doc remnants --- .gitmodules | 3 --- 1 file changed, 3 deletions(-) delete mode 100644 .gitmodules diff --git a/.gitmodules b/.gitmodules deleted file mode 100644 index 2eced4c..0000000 --- a/.gitmodules +++ /dev/null @@ -1,3 +0,0 @@ -[submodule "doc/bib"] - path = doc/bib - url = https://github.com/cryptobib/export From 9c0a02684c72f44483062e4eacb92a73962eb98f Mon Sep 17 00:00:00 2001 From: Manuel Barbosa Date: Thu, 18 Apr 2019 18:27:05 +0300 Subject: [PATCH 355/525] Implementation proof sketch --- proof/impl/Spec.ec | 5 +- proof/impl/shake256.ec | 585 +++++++++++++++++++++++++++++++++++++++++ 2 files changed, 589 insertions(+), 1 deletion(-) create mode 100644 proof/impl/shake256.ec diff --git a/proof/impl/Spec.ec b/proof/impl/Spec.ec index 80984ee..0d7973b 100644 --- a/proof/impl/Spec.ec +++ b/proof/impl/Spec.ec @@ -1,6 +1,8 @@ require import AllCore List Int IntDiv. from Jasmin require import JArray JMemory JModel JUtils JWord JWord_array. -require import Sponge. +require Sponge. + +clone import Sponge as Spnge. import Common. import Block. import Capacity. @@ -688,3 +690,4 @@ apply(sizes2 i{2} n{1} outlen{2} H) => //=. wp;skip;progress;smt(store_blocks_safe storeblocks_correct). qed. +end section. \ No newline at end of file diff --git a/proof/impl/shake256.ec b/proof/impl/shake256.ec new file mode 100644 index 0000000..d431b37 --- /dev/null +++ b/proof/impl/shake256.ec @@ -0,0 +1,585 @@ +require import List Int IntExtra IntDiv CoreMap. +from Jasmin require import JModel. + +(* require import Array5 Array25. +require import WArray40 WArray200. *) + +require Spec. +clone import Spec as Spc. +import Spc.Spnge. +import Common. + +clone export PolyArray as Array5 with op size <- 5. + +clone export WArray as WArray200 with op size <- 200. +clone export WArray as WArray40 with op size <- 40. + +op x86_ROL_64 : W64.t -> W8.t -> bool * bool * W64.t. +op set0_64 : bool * bool * bool * bool * bool * W64.t. +op x86_TEST_8 : W8.t -> W8.t -> bool * bool * bool * bool * bool. + +module M = { + proc spill_2 (a:W64.t, b:W64.t) : W64.t * W64.t = { + + var sa:W64.t; + var sb:W64.t; + + sa <- a; + sb <- b; + return (sa, sb); + } + + proc load_2 (sa:W64.t, sb:W64.t) : W64.t * W64.t = { + + var a:W64.t; + var b:W64.t; + + a <- sa; + b <- sb; + return (a, b); + } +(* + proc rOL64 (x:W64.t, c:int) : W64.t = { + + var y:W64.t; + var _0:bool; + var _1:bool; + + if ((c = 0)) { + y <- x; + } else { + ( _0, _1, y) <- x86_ROL_64 x (W8.of_int c); + } + return (y); + } + *) + proc keccak_init (m:W64.t) : W64.t Array25.t = { + + var state:W64.t Array25.t; + var t:W64.t; + var i:W64.t; + var _0:bool; + var _1:bool; + var _2:bool; + var _3:bool; + var _4:bool; + state <- witness; + ( _0, _1, _2, _3, _4, t) <- set0_64 ; + i <- (W64.of_int 0); + + while ((i \ult (W64.of_int 50))) { + state.[(W64.to_uint i)] <- t; + i <- (i + (W64.of_int 1)); + } + return (state); + } + (* + proc index (x:int, y:int) : int = { + + var r:int; + + r <- ((5 * (x %% 5)) + (y %% 5)); + return (r); + } + + proc keccak_rho_offsets (i:int) : int = { + var aux: int; + + var r:int; + var x:int; + var y:int; + var t:int; + var z:int; + + r <- 0; + x <- 1; + y <- 0; + t <- 0; + while (t < 24) { + if ((i = (x + (5 * y)))) { + r <- ((((t + 1) * (t + 2)) %/ 2) %% 64); + } else { + + } + z <- (((2 * x) + (3 * y)) %% 5); + x <- y; + y <- z; + t <- t + 1; + } + return (r); + } + + proc rhotates (x:int, y:int) : int = { + + var r:int; + var i:int; + + i <@ index (x, y); + r <@ keccak_rho_offsets (i); + return (r); + } + + proc theta_sum (A:W64.t Array25.t) : W64.t Array5.t = { + var aux: int; + + var _c:W64.t Array5.t; + var i:int; + var j:int; + _c <- witness; + i <- 0; + while (i < 5) { + _c.[i] <- A.[((5 * (0 %% 5)) + (i %% 5))]; + j <- 1; + while (j < 5) { + _c.[i] <- (_c.[i] `^` A.[((5 * (j %% 5)) + (i %% 5))]); + j <- j + 1; + } + i <- i + 1; + } + return (_c); + } + + proc theta_rol (_c:W64.t Array5.t) : W64.t Array5.t = { + var aux: int; + + var _d:W64.t Array5.t; + var i:int; + var r:W64.t; + _d <- witness; + i <- 0; + while (i < 5) { + r <@ rOL64 (_c.[((i + 1) %% 5)], 1); + _d.[i] <- r; + _d.[i] <- (_d.[i] `^` _c.[((i + 4) %% 5)]); + i <- i + 1; + } + return (_d); + } + + proc rol_sum (_d:W64.t Array5.t, A:W64.t Array25.t, offset:int) : W64.t Array5.t = { + var aux: int; + + var _c:W64.t Array5.t; + var j:int; + var j1:int; + var k:int; + var t:W64.t; + _c <- witness; + j <- 0; + while (j < 5) { + j1 <- ((j + offset) %% 5); + k <@ rhotates (j, j1); + t <- A.[((5 * (j %% 5)) + (j1 %% 5))]; + t <- (t `^` _d.[j1]); + t <@ rOL64 (t, k); + _c.[j] <- t; + j <- j + 1; + } + return (_c); + } + + proc set_row (_r:W64.t Array25.t, row:int, _c:W64.t Array5.t, iota_0:W64.t) : + W64.t Array25.t = { + var aux: int; + + var j:int; + var j1:int; + var j2:int; + var t:W64.t; + + j <- 0; + while (j < 5) { + j1 <- ((j + 1) %% 5); + j2 <- ((j + 2) %% 5); + t <- ((invw _c.[j1]) `&` _c.[j2]); + if (((row = 0) /\ (j = 0))) { + t <- (t `^` iota_0); + } else { + + } + t <- (t `^` _c.[j]); + _r.[((5 * (row %% 5)) + (j %% 5))] <- t; + j <- j + 1; + } + return (_r); + } + + proc round2x (A:W64.t Array25.t, _r:W64.t Array25.t, iotas:W64.t, o:int) : + W64.t Array25.t * W64.t Array25.t = { + + var iota_0:W64.t; + var _c:W64.t Array5.t; + var _d:W64.t Array5.t; + _c <- witness; + _d <- witness; + iota_0 <- (loadW64 Glob.mem (W64.to_uint (iotas + (W64.of_int o)))); + _c <@ theta_sum (A); + _d <@ theta_rol (_c); + _c <@ rol_sum (_d, A, 0); + _r <@ set_row (_r, 0, _c, iota_0); + _c <@ rol_sum (_d, A, 3); + _r <@ set_row (_r, 1, _c, iota_0); + _c <@ rol_sum (_d, A, 1); + _r <@ set_row (_r, 2, _c, iota_0); + _c <@ rol_sum (_d, A, 4); + _r <@ set_row (_r, 3, _c, iota_0); + _c <@ rol_sum (_d, A, 2); + _r <@ set_row (_r, 4, _c, iota_0); + return (A, _r); + } + *) + proc keccak_f (A:W64.t Array25.t, iotas:W64.t) : W64.t Array25.t * W64.t = { + (* + var zf:bool; + var _r:W64.t Array25.t; + var _0:bool; + var _1:bool; + var _2:bool; + var _3:bool; + _r <- witness; + (A, _r) <@ round2x (A, _r, iotas, 0); + (_r, A) <@ round2x (_r, A, iotas, 8); + iotas <- (iotas + (W64.of_int 16)); + ( _0, _1, _2, _3, zf) <- x86_TEST_8 (truncateu8 iotas) + (W8.of_int 255); + while ((! zf)) { + (A, _r) <@ round2x (A, _r, iotas, 0); + (_r, A) <@ round2x (_r, A, iotas, 8); + iotas <- (iotas + (W64.of_int 16)); + ( _0, _1, _2, _3, zf) <- x86_TEST_8 (truncateu8 iotas) + (W8.of_int 255); + } + iotas <- (iotas - (W64.of_int 192)); + return (A, iotas); *) + return witness; + } + + proc keccak_1600_add_full_block (state:W64.t Array25.t, in_0:W64.t, + inlen:W64.t, rate_in_bytes:int) : + W64.t Array25.t * W64.t * W64.t = { + var aux: int; + + var i:int; + var t:W64.t; + + aux <- (rate_in_bytes %/ 8); + i <- 0; + while (i < aux) { + t <- (loadW64 Glob.mem (W64.to_uint (in_0 + (W64.of_int (8 * i))))); + state.[i] <- (state.[i] `^` t); + i <- i + 1; + } + in_0 <- (in_0 + (W64.of_int rate_in_bytes)); + inlen <- (inlen - (W64.of_int rate_in_bytes)); + return (state, in_0, inlen); + } + + proc keccak_1600_add_final_block (state:W64.t Array25.t, in_0:W64.t, + inlen:W64.t, suffix:int, + rate_in_bytes:int) : W64.t Array25.t = { + + var inlen8:W64.t; + var i:W64.t; + var t:W64.t; + var c:W8.t; + + inlen8 <- inlen; + inlen8 <- (inlen8 `>>` (W8.of_int 3)); + i <- (W64.of_int 0); + + while ((i \ult inlen8)) { + t <- (loadW64 Glob.mem (W64.to_uint (in_0 + ((W64.of_int 8) * i)))); + state.[(W64.to_uint i)] <- (state.[(W64.to_uint i)] `^` t); + i <- (i + (W64.of_int 1)); + } + i <- (i `<<` (W8.of_int 3)); + + while ((i \ult inlen)) { + c <- (loadW8 Glob.mem (W64.to_uint (in_0 + i))); + state = + Array25.init + (WArray200.get64 (WArray200.set8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i) ( + (get8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i)) `^` c))); + i <- (i + (W64.of_int 1)); + } + state = + Array25.init + (WArray200.get64 (WArray200.set8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i) ( + (get8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i)) `^` (W8.of_int suffix)))); + state = + Array25.init + (WArray200.get64 (WArray200.set8 (WArray200.init64 (fun i => state.[i])) (rate_in_bytes - 1) ( + (get8 (WArray200.init64 (fun i => state.[i])) (rate_in_bytes - 1)) `^` (W8.of_int 128)))); + return (state); + } + + proc keccak_1600_absorb (state:W64.t Array25.t, iotas:W64.t, in_0:W64.t, + inlen:W64.t, suffix:int, rate_in_bytes:int) : + W64.t Array25.t * W64.t = { + + var s_in:W64.t; + var s_inlen:W64.t; + + + while (((W64.of_int rate_in_bytes) \ule inlen)) { + (state, in_0, inlen) <@ keccak_1600_add_full_block (state, in_0, inlen, + rate_in_bytes); + (s_in, s_inlen) <@ spill_2 (in_0, inlen); + (state, iotas) <@ keccak_f (state, iotas); + (in_0, inlen) <@ load_2 (s_in, s_inlen); + } + state <@ keccak_1600_add_final_block (state, in_0, inlen, suffix, + rate_in_bytes); + (state, iotas) <@ keccak_f (state, iotas); + return (state, iotas); + } + + proc keccak_1600_xtr_block (state:W64.t Array25.t, out:W64.t, len:W64.t) : + W64.t = { + + var len8:W64.t; + var i:W64.t; + var t:W64.t; + var c:W8.t; + + len8 <- len; + len8 <- (len8 `>>` (W8.of_int 3)); + i <- (W64.of_int 0); + + while ((i \ult len8)) { + t <- state.[(W64.to_uint i)]; + Glob.mem <- + storeW64 Glob.mem (W64.to_uint (out + ((W64.of_int 8) * i))) t; + i <- (i + (W64.of_int 1)); + } + i <- (i `<<` (W8.of_int 3)); + + while ((i \ult len)) { + c <- (get8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i)); + Glob.mem <- storeW8 Glob.mem (W64.to_uint (out + i)) c; + i <- (i + (W64.of_int 1)); + } + out <- (out + len); + return (out); + } + + proc keccak_1600_squeeze (state:W64.t Array25.t, iotas:W64.t, out:W64.t, + rate_in_bytes:int, i_hash_bytes:int) : unit = { + + var s_hash_bytes:W64.t; + var s_out:W64.t; + var hash_bytes:W64.t; + + s_hash_bytes <- (W64.of_int i_hash_bytes); + + while (((W64.of_int rate_in_bytes) \ule s_hash_bytes)) { + out <@ keccak_1600_xtr_block (state, out, (W64.of_int rate_in_bytes)); + s_out <- out; + if (((W64.of_int rate_in_bytes) \ult s_hash_bytes)) { (* ADDED!!! *) + (state, iotas) <@ keccak_f (state, iotas); + } + s_hash_bytes <- (s_hash_bytes - (W64.of_int rate_in_bytes)); + out <- s_out; + } + hash_bytes <- s_hash_bytes; + out <@ keccak_1600_xtr_block (state, out, hash_bytes); + return (); + } + + proc keccak_1600 (out:W64.t, in_0:W64.t, inlen:W64.t, iotas:W64.t, m:W64.t, + suffix:int, rate:int, capacity:int, hash_bytes:int) : unit = { + + var out_s:W64.t; + var state:W64.t Array25.t; + state <- witness; + out_s <- out; + state <@ keccak_init (m); + (state, iotas) <@ keccak_1600_absorb (state, iotas, in_0, inlen, suffix, + (rate %/ 8)); + out <- out_s; + keccak_1600_squeeze (state, iotas, out, (rate %/ 8), hash_bytes); + return (); + } + + proc shake256_ref2x_jazz (out:W64.t, in_0:W64.t, inlen:W64.t, iotas:W64.t, + m:W64.t) : unit = { + + + + keccak_1600 (out, in_0, inlen, iotas, m, 31, 1088, 512, 136); + return (); + } +}. + +section. + +op good_iotas : W64.t. +op rate_in_bytes : int. + +declare module Preal : PermT {Glob}. + +axiom perm_imp_correct good_iotas : + equiv [ Preal.perm ~ M.keccak_f : + st{1} = A{2} /\ iotas{2} = good_iotas /\ rate_in_bytes{2} = rate_in_bytes ==> + res{1} = res{2}.`1 /\ res{2}.`2 = good_iotas]. (* this second one is weird *) + +print Spc.r. + +phoare keccak_init_spec mem : + [ M.keccak_init : Glob.mem = mem ==> Glob.mem = mem /\ res = state0 ] = 1%r. +admitted. + +phoare keccak_1600_xtr_block_spec mem outp outl st : + [ M.keccak_1600_xtr_block : + Glob.mem = mem /\ state = st /\ + to_uint out = outp /\ to_uint len = outl ==> + res = W64.of_int (outp + outl) /\ + eqmem_except mem Glob.mem outp outl /\ + memr2bits Glob.mem outp outl = + take (outl * 8) (ofblock (wblock2block (take (r %/ 64) (Array25.to_list st)))) ] = 1%r. +admitted. + +phoare keccak_1600_add_full_block_spec mem st inp inl rate wb : + [ M.keccak_1600_add_full_block : + wb = map W64.bits2w + (BitEncoding.BitChunking.chunk 64 (bytewisepad (memr2bits mem inp inl))) /\ + Glob.mem = mem /\ state = st /\ to_uint in_0 = inp /\ to_uint inlen = inl /\ + rate_in_bytes = rate ==> + Glob.mem = mem /\ res.`1 = combine st wb /\ to_uint res.`2 = inp + rate /\ + to_uint res.`3 = inl - rate] = 1%r. +admitted. + +phoare keccak_1600_add_final_block_spec mem st inp inl rate wb : + [ M.keccak_1600_add_final_block : + wb = map W64.bits2w + (BitEncoding.BitChunking.chunk 64 (bytewisepad (memr2bits mem inp inl))) /\ + Glob.mem = mem /\ state = st /\ to_uint in_0 = inp /\ to_uint inlen = inl /\ + rate_in_bytes = rate ==> + Glob.mem = mem /\ res = combine st wb ] = 1%r. +admitted. + +lemma impl_correct outp : +equiv [ Spec(Preal).f ~ M.shake256_ref2x_jazz : + outp = out{1} /\ outp = W64.to_uint out{2} /\ outlen{1} = 136 /\ + (* domain_bits = [(* 31 *)] /\ suffix_bits = [(* 31 *)] /\ *) r = 512 /\ c = 1088 /\ + ={Glob.mem} /\ inp{1} = W64.to_uint in_0{2} /\ inlen{1} = to_uint inlen{2} /\ + iotas{2} = good_iotas + ==> ={Glob.mem} ]. +proc. +inline M.keccak_1600. +sp. +seq 0 1 : (#{~state{2}}pre /\ state{2} = st{1}). +exists *Glob.mem{2}. +elim* => mem. +call {2} (keccak_init_spec (mem)); first by auto => />. +inline M.keccak_1600_absorb. +sp. +splitwhile {1} 1 : (1 < size xs). +seq 1 1 : (#{/~state0{2}}{~in_01{2}}{~inlen1{2}}{~xs{1}}{~st{1}}pre /\ st{1} = state0{2} /\ + xs{1} = loadpad2wblocks Glob.mem{1} (W64.to_uint in_01{2}) (W64.to_uint inlen1{2}) /\ size xs{1} <= 1). +while (#{~ size xs{1} <= 1}post). +seq 0 1 : (#{/~state0{2}}{~in_01{2}}{~inlen1{2}}{~xs{1}}{~st{1}}pre + /\ combine st{1} (head wblock0 xs{1}) = state0{2} /\ + xs{1} = loadpad2wblocks Glob.mem{1} (W64.to_uint in_01{2} - rate_in_bytes{2}) (W64.to_uint inlen1{2} + rate_in_bytes{2})). +exists * Glob.mem{2}, state0{2}, (to_uint in_01{2}), (to_uint inlen1{2}), rate_in_bytes{2}, (head wblock0 xs{1}). +elim* => mem st inp inl rate wb. +call {2} (keccak_1600_add_full_block_spec mem st inp inl rate wb). +auto => />. +progress. +rewrite /loadpad2wblocks //=. +rewrite -(head_behead (bits2blocks + (bytewisepad + (memr2bits Glob.mem{2} (to_uint in_01{2}) (to_uint inlen1{2})))) b0). +smt. +rewrite map_cons. simplify. +admit. (* provable *) +rewrite H5. +smt(). +smt(). +inline M.load_2. +wp. +call (perm_imp_correct good_iotas). +inline *. +wp;auto => />. +progress. +admit. +admit. +admit. +admit. +auto => />. +progress. +admit. +admit. +admit. +admit. +seq 1 2 : (st{1} = state0{2} /\ iotas1{2} = good_iotas /\ + outp = out{1} /\ outp = W64.to_uint out{2} /\ outlen{1} = 136 /\ + ={Glob.mem} /\ hash_bytes{2} = 136). +unroll {1} 1. +rcondt {1} 1. move => *. auto => />. +have always : (1 <= size (loadpad2wblocks Glob.mem{m} (to_uint in_01{m}) (to_uint inlen1{m}))). +admit. smt(). +seq 2 2 : (#{~xs{1}}pre /\ xs{1} = []). +seq 0 1 : (#{/~state0{2}}{~in_01{2}}{~inlen1{2}}{~xs{1}}{~st{1}}pre + /\ combine st{1} (head wblock0 xs{1}) = state0{2} /\ size xs{1} <= 1). +exists * Glob.mem{2}, state0{2}, (to_uint in_01{2}), (to_uint inlen1{2}), rate_in_bytes{2}, (head wblock0 xs{1}). +elim* => mem st inp inl rate wb. +call {2} (keccak_1600_add_final_block_spec mem st inp inl rate wb). +auto => />. +progress. +rewrite /loadpad2wblocks //=. +rewrite -(head_behead (bits2blocks + (bytewisepad + (memr2bits Glob.mem{2} (to_uint in_01{2}) (to_uint inlen1{2})))) b0). +admit. +rewrite map_cons. simplify. +admit. (* provable *) +wp. +call (perm_imp_correct good_iotas). +auto => />. +progress. +move : H1. +elim (xs{1}). smt. +progress. smt. +while {1} (#pre) 1. move => *. exfalso. smt. auto => />. +inline M.keccak_1600_squeeze. +sp. +seq 1 1 : (#{~ ={Glob.mem}}{~out{2}}{~s_hash_bytes{2}}{~state1{2}}{~st{1}}pre /\ st{1} = state1{2} /\ + eqmem_except Glob.mem{1} Glob.mem{2} outp (136- to_uint s_hash_bytes{2}) /\ + memr2bits Glob.mem{2} outp (136- to_uint s_hash_bytes{2}) = + take (((136- to_uint s_hash_bytes{2})) * 8) ((wblocks2bits z{1}))). +while #post. +wp. +seq 0 1 : #pre. +exists * Glob.mem{2}, out1{2}, state1{2}, (W64.of_int rate_in_bytes0{2}). +elim* => mem outpp st hbytes. +call {2} (keccak_1600_xtr_block_spec mem (to_uint outpp) (to_uint hbytes) st). +auto => />. +progress. +admit. +admit. +admit. +case (i{1} + 1 < convb outlen{1}). +rcondt {1} 3. move => *. auto => />. +rcondt {2} 2. move => *. auto => />. progress. admit. +call (perm_imp_correct good_iotas). +auto => />. +progress. +admit. +admit. +admit. +rcondf {1} 3. move => *. auto => />. +rcondf {2} 2. move => *. auto => />. progress. admit. +auto => />. +progress. +admit. +admit. +admit. +auto => />. progress. admit. admit. admit. +exists * Glob.mem{2}, out1{2}, state1{2}, s_hash_bytes{2}. +elim* => mem outpp st hbytes. +call {2} (keccak_1600_xtr_block_spec mem (to_uint outpp) (to_uint hbytes) st). +auto => />. +progress. +admit. +qed. From be3183c8ee53be642166ad7b8fe0fb786c0db5ae Mon Sep 17 00:00:00 2001 From: Manuel Barbosa Date: Fri, 19 Apr 2019 17:29:46 +0100 Subject: [PATCH 356/525] Implementation proof sketch --- proof/impl/shake256.ec | 171 ++++++++++++++++++++++++++++++----------- 1 file changed, 126 insertions(+), 45 deletions(-) diff --git a/proof/impl/shake256.ec b/proof/impl/shake256.ec index d431b37..3deb0c7 100644 --- a/proof/impl/shake256.ec +++ b/proof/impl/shake256.ec @@ -375,7 +375,7 @@ module M = { while (((W64.of_int rate_in_bytes) \ule s_hash_bytes)) { out <@ keccak_1600_xtr_block (state, out, (W64.of_int rate_in_bytes)); s_out <- out; - if (((W64.of_int rate_in_bytes) \ult s_hash_bytes)) { (* ADDED!!! *) + if (((W64.of_int rate_in_bytes) \ult s_hash_bytes - (W64.of_int rate_in_bytes))) { (* ADDED!!! *) (state, iotas) <@ keccak_f (state, iotas); } s_hash_bytes <- (s_hash_bytes - (W64.of_int rate_in_bytes)); @@ -441,8 +441,8 @@ admitted. phoare keccak_1600_add_full_block_spec mem st inp inl rate wb : [ M.keccak_1600_add_full_block : - wb = map W64.bits2w - (BitEncoding.BitChunking.chunk 64 (bytewisepad (memr2bits mem inp inl))) /\ + wb = take (r %/ 64) (map W64.bits2w + (BitEncoding.BitChunking.chunk 64 (bytewisepad (memr2bits mem inp inl)))) /\ Glob.mem = mem /\ state = st /\ to_uint in_0 = inp /\ to_uint inlen = inl /\ rate_in_bytes = rate ==> Glob.mem = mem /\ res.`1 = combine st wb /\ to_uint res.`2 = inp + rate /\ @@ -451,8 +451,8 @@ admitted. phoare keccak_1600_add_final_block_spec mem st inp inl rate wb : [ M.keccak_1600_add_final_block : - wb = map W64.bits2w - (BitEncoding.BitChunking.chunk 64 (bytewisepad (memr2bits mem inp inl))) /\ + wb = take (r %/ 64) (map W64.bits2w + (BitEncoding.BitChunking.chunk 64 (bytewisepad (memr2bits mem inp inl)))) /\ Glob.mem = mem /\ state = st /\ to_uint in_0 = inp /\ to_uint inlen = inl /\ rate_in_bytes = rate ==> Glob.mem = mem /\ res = combine st wb ] = 1%r. @@ -461,7 +461,7 @@ admitted. lemma impl_correct outp : equiv [ Spec(Preal).f ~ M.shake256_ref2x_jazz : outp = out{1} /\ outp = W64.to_uint out{2} /\ outlen{1} = 136 /\ - (* domain_bits = [(* 31 *)] /\ suffix_bits = [(* 31 *)] /\ *) r = 512 /\ c = 1088 /\ + domain_bits = [ true; true; true;true ] /\ suffix_bits = [] /\ r = 512 /\ c = 1088 /\ ={Glob.mem} /\ inp{1} = W64.to_uint in_0{2} /\ inlen{1} = to_uint inlen{2} /\ iotas{2} = good_iotas ==> ={Glob.mem} ]. @@ -472,15 +472,25 @@ seq 0 1 : (#{~state{2}}pre /\ state{2} = st{1}). exists *Glob.mem{2}. elim* => mem. call {2} (keccak_init_spec (mem)); first by auto => />. + +(* Absorb phase *) inline M.keccak_1600_absorb. sp. splitwhile {1} 1 : (1 < size xs). -seq 1 1 : (#{/~state0{2}}{~in_01{2}}{~inlen1{2}}{~xs{1}}{~st{1}}pre /\ st{1} = state0{2} /\ - xs{1} = loadpad2wblocks Glob.mem{1} (W64.to_uint in_01{2}) (W64.to_uint inlen1{2}) /\ size xs{1} <= 1). +seq 1 1 : (#{/~state0{2}} + {~in_01{2}} + {~inlen1{2}} + {~xs{1}} + {~st{1}}pre /\ + st{1} = state0{2} /\ + xs{1} = loadpad2wblocks Glob.mem{1} (W64.to_uint in_01{2}) (W64.to_uint inlen1{2}) + /\ size xs{1} <= 1). while (#{~ size xs{1} <= 1}post). -seq 0 1 : (#{/~state0{2}}{~in_01{2}}{~inlen1{2}}{~xs{1}}{~st{1}}pre - /\ combine st{1} (head wblock0 xs{1}) = state0{2} /\ - xs{1} = loadpad2wblocks Glob.mem{1} (W64.to_uint in_01{2} - rate_in_bytes{2}) (W64.to_uint inlen1{2} + rate_in_bytes{2})). +seq 0 1 : (#{/~state0{2}} + {~in_01{2}} + {~inlen1{2}}pre /\ + combine st{1} (head wblock0 xs{1}) = state0{2} /\ + xs{1} = loadpad2wblocks Glob.mem{1} (W64.to_uint in_01{2} - rate_in_bytes{2}) (W64.to_uint inlen1{2} + rate_in_bytes{2})). exists * Glob.mem{2}, state0{2}, (to_uint in_01{2}), (to_uint inlen1{2}), rate_in_bytes{2}, (head wblock0 xs{1}). elim* => mem st inp inl rate wb. call {2} (keccak_1600_add_full_block_spec mem st inp inl rate wb). @@ -491,9 +501,9 @@ rewrite -(head_behead (bits2blocks (bytewisepad (memr2bits Glob.mem{2} (to_uint in_01{2}) (to_uint inlen1{2})))) b0). smt. -rewrite map_cons. simplify. +rewrite map_cons. simplify. admit. (* provable *) -rewrite H5. +rewrite H6. smt(). smt(). inline M.load_2. @@ -502,7 +512,44 @@ call (perm_imp_correct good_iotas). inline *. wp;auto => />. progress. -admit. +rewrite /loadpad2wblocks. simplify. +rewrite (_: (memr2bits Glob.mem{2} (to_uint in_01{2} -136) + (to_uint inlen1{2} + 136) = + (memr2bits Glob.mem{2} (to_uint in_01{2} -136) + 136) ++ + (memr2bits Glob.mem{2} (to_uint in_01{2}) + (to_uint inlen1{2} - 136)))). +rewrite /memr2bits. +rewrite -flatten_cat. +rewrite (_ : map (fun (o : int) => w2bits Glob.mem{2}.[to_uint in_01{2} + o]) + (iota_ 0 (to_uint inlen1{2} - 136)) = + map (fun (o : int) => w2bits Glob.mem{2}.[to_uint in_01{2} - 136 + o]) + (iota_ 136 (to_uint inlen1{2}))). +rewrite ( _ : (fun (o : int) => w2bits Glob.mem{2}.[to_uint in_01{2} - 136 + o]) + = (fun o => (fun (x : int) => w2bits Glob.mem{2}.[to_uint in_01{2} + x]) (o-136))). +auto => />. admit. (* easy? *) +rewrite (map_comp (fun (x : int) => w2bits Glob.mem{2}.[to_uint in_01{2} + x]) (fun o => o - 136)). +rewrite ( _ : (map (transpose Int.(+) (-136)) (iota_ 136 (to_uint inlen1{2}))) + = iota_ 0 (to_uint inlen1{2} - 136)). +admit. (* easy? *) +by trivial. +rewrite -map_cat. rewrite -iota_add. smt(). smt. smt(). +rewrite (_ : + (bits2blocks + (bytewisepad + (memr2bits Glob.mem{2} (to_uint in_01{2} - 136) 136 ++ + memr2bits Glob.mem{2} (to_uint in_01{2}) + (to_uint inlen1{2} - 136)))) = + head witness (bits2blocks + (bytewisepad + (memr2bits Glob.mem{2} (to_uint in_01{2} - 136) 136 ++ + memr2bits Glob.mem{2} (to_uint in_01{2}) + (to_uint inlen1{2} - 136)))) :: + (bits2blocks + (bytewisepad + (memr2bits Glob.mem{2} (to_uint in_01{2}) (to_uint inlen1{2}))))). +admit. (* doable *) +by rewrite map_cons. admit. admit. admit. @@ -512,16 +559,35 @@ admit. admit. admit. admit. -seq 1 2 : (st{1} = state0{2} /\ iotas1{2} = good_iotas /\ - outp = out{1} /\ outp = W64.to_uint out{2} /\ outlen{1} = 136 /\ - ={Glob.mem} /\ hash_bytes{2} = 136). + +(* setting minimum precondition to squeeze *) +seq 1 4 : (st{1} = state{2} /\ + iotas0{2} = good_iotas /\ + i{1} = 0 /\ + rate{2} = 1088 /\ + rate_in_bytes{2} = rate{2} %/ 8 /\ + to_uint out_s{2} = outp /\ + z{1} = [] /\ + outp = out{1} /\ + outp = W64.to_uint out0{2} /\ + outlen{1} = 136 /\ + ={Glob.mem} /\ + hash_bytes{2} = 136). + +(* we know there's exactly one iteration left to go on the left *) unroll {1} 1. +(* The final iteration matches the block for which padding was added *) rcondt {1} 1. move => *. auto => />. have always : (1 <= size (loadpad2wblocks Glob.mem{m} (to_uint in_01{m}) (to_uint inlen1{m}))). -admit. smt(). +admit. (* prove once and for all *) smt(). seq 2 2 : (#{~xs{1}}pre /\ xs{1} = []). -seq 0 1 : (#{/~state0{2}}{~in_01{2}}{~inlen1{2}}{~xs{1}}{~st{1}}pre - /\ combine st{1} (head wblock0 xs{1}) = state0{2} /\ size xs{1} <= 1). +seq 0 1 : (#{/~state0{2}} + {~in_01{2}} + {~inlen1{2}} + {~xs{1}} + {~st{1}}pre /\ + combine st{1} (head wblock0 xs{1}) = state0{2} /\ + size xs{1} <= 1). exists * Glob.mem{2}, state0{2}, (to_uint in_01{2}), (to_uint inlen1{2}), rate_in_bytes{2}, (head wblock0 xs{1}). elim* => mem st inp inl rate wb. call {2} (keccak_1600_add_final_block_spec mem st inp inl rate wb). @@ -533,6 +599,7 @@ rewrite -(head_behead (bits2blocks (memr2bits Glob.mem{2} (to_uint in_01{2}) (to_uint inlen1{2})))) b0). admit. rewrite map_cons. simplify. +rewrite /bits2blocks. admit. (* provable *) wp. call (perm_imp_correct good_iotas). @@ -541,41 +608,55 @@ progress. move : H1. elim (xs{1}). smt. progress. smt. -while {1} (#pre) 1. move => *. exfalso. smt. auto => />. + +(* The while on the left is never executed. *) +while {1} (#post /\ xs{1} = []) 1. move => *. exfalso. smt. auto => />. +(* Squeeze phase *) inline M.keccak_1600_squeeze. -sp. -seq 1 1 : (#{~ ={Glob.mem}}{~out{2}}{~s_hash_bytes{2}}{~state1{2}}{~st{1}}pre /\ st{1} = state1{2} /\ - eqmem_except Glob.mem{1} Glob.mem{2} outp (136- to_uint s_hash_bytes{2}) /\ - memr2bits Glob.mem{2} outp (136- to_uint s_hash_bytes{2}) = - take (((136- to_uint s_hash_bytes{2})) * 8) ((wblocks2bits z{1}))). -while #post. -wp. -seq 0 1 : #pre. +seq 0 6 : (st{1} = state1{2} /\ + iotas2{2} = good_iotas /\ + rate{2} = 1088 /\ + rate_in_bytes0{2} = rate{2} %/ 8 /\ + to_uint out_s{2} = outp /\ + outp = out{1} /\ + outp = W64.to_uint out0{2} /\ + outlen{1} = 136 /\ + s_hash_bytes{2} = W64.of_int (136 - (i{1} * 136)) /\ + to_uint out1{2} = 136 * i{1} + outp /\ + eqmem_except Glob.mem{1} Glob.mem{2} outp (i{1} * 136) /\ + memr2bits Glob.mem{2} outp (i{1} * 136) = + take (i{1} * 136 * 8) ((wblocks2bits z{1}))). +auto => />. +progress. +smt(). +rewrite /memr2bits /flatten take0 iota0. smt(). smt. + +seq 1 1 : (#pre). +while #pre. +seq 2 1 : (#{/~i{1} < convb outlen{1}}pre /\ + i{1} - 1 < convb outlen{1}). exists * Glob.mem{2}, out1{2}, state1{2}, (W64.of_int rate_in_bytes0{2}). elim* => mem outpp st hbytes. call {2} (keccak_1600_xtr_block_spec mem (to_uint outpp) (to_uint hbytes) st). auto => />. progress. -admit. -admit. -admit. -case (i{1} + 1 < convb outlen{1}). -rcondt {1} 3. move => *. auto => />. +admit. (* safety *) +admit. (* safety *) +admit. (* doable? *) +admit. (* doable? *) +case (i{1} < convb outlen{1}). +rcondt {1} 1. move => *. auto => />. rcondt {2} 2. move => *. auto => />. progress. admit. +sp. +seq 1 1 : #pre. call (perm_imp_correct good_iotas). -auto => />. -progress. -admit. -admit. -admit. -rcondf {1} 3. move => *. auto => />. +by auto => />. +auto => />. progress. admit. admit. +rcondf {1} 1. move => *. auto => />. rcondf {2} 2. move => *. auto => />. progress. admit. auto => />. -progress. -admit. -admit. -admit. -auto => />. progress. admit. admit. admit. +progress. admit. admit. +auto => />. progress. admit. admit. exists * Glob.mem{2}, out1{2}, state1{2}, s_hash_bytes{2}. elim* => mem outpp st hbytes. call {2} (keccak_1600_xtr_block_spec mem (to_uint outpp) (to_uint hbytes) st). From cf4bde2bf4a26addbd9ea2f0fbd02f7582e95473 Mon Sep 17 00:00:00 2001 From: Manuel Barbosa Date: Sun, 21 Apr 2019 12:43:32 +0100 Subject: [PATCH 357/525] Implementation proof draft --- proof/impl/Spec.ec | 2 +- proof/impl/shake256.ec | 251 +++++++++++++++++++++++++++++++++-------- 2 files changed, 203 insertions(+), 50 deletions(-) diff --git a/proof/impl/Spec.ec b/proof/impl/Spec.ec index 0d7973b..ac7b50b 100644 --- a/proof/impl/Spec.ec +++ b/proof/impl/Spec.ec @@ -58,7 +58,7 @@ op memr2bits( mem : global_mem_t, ptr : int, len : int) = flatten (map (fun o => W8.w2bits (mem.[ptr + o])) (iota_ 0 len)). op eqmem_except(mem1 : global_mem_t, mem2 : global_mem_t, ptr : int, o : int) = - forall ad, ptr <= ad < ptr + o => mem1.[ad] = mem2.[ad]. + forall ad, !(ptr <= ad < ptr + o) => mem1.[ad] = mem2.[ad]. op state2bc(st : state) : block * capacity = let stbits = flatten (map W64.w2bits (to_list st)) diff --git a/proof/impl/shake256.ec b/proof/impl/shake256.ec index 3deb0c7..f182c23 100644 --- a/proof/impl/shake256.ec +++ b/proof/impl/shake256.ec @@ -375,7 +375,7 @@ module M = { while (((W64.of_int rate_in_bytes) \ule s_hash_bytes)) { out <@ keccak_1600_xtr_block (state, out, (W64.of_int rate_in_bytes)); s_out <- out; - if (((W64.of_int rate_in_bytes) \ult s_hash_bytes - (W64.of_int rate_in_bytes))) { (* ADDED!!! *) + if (( W64.of_int 0 <> s_hash_bytes - (W64.of_int rate_in_bytes))) { (* ADDED!!! *) (state, iotas) <@ keccak_f (state, iotas); } s_hash_bytes <- (s_hash_bytes - (W64.of_int rate_in_bytes)); @@ -402,11 +402,11 @@ module M = { } proc shake256_ref2x_jazz (out:W64.t, in_0:W64.t, inlen:W64.t, iotas:W64.t, - m:W64.t) : unit = { + m:W64.t, outlen : int) : unit = { - keccak_1600 (out, in_0, inlen, iotas, m, 31, 1088, 512, 136); + keccak_1600 (out, in_0, inlen, iotas, m, 31, 1088, 512, (* 136 *) outlen); return (); } }. @@ -460,8 +460,8 @@ admitted. lemma impl_correct outp : equiv [ Spec(Preal).f ~ M.shake256_ref2x_jazz : - outp = out{1} /\ outp = W64.to_uint out{2} /\ outlen{1} = 136 /\ - domain_bits = [ true; true; true;true ] /\ suffix_bits = [] /\ r = 512 /\ c = 1088 /\ + outp = out{1} /\ outp = W64.to_uint out{2} /\ outlen{1} = outlen{2} /\ + domain_bits = [ true; true; true;true ] /\ suffix_bits = [] /\ r = 1088 /\ c = 512 /\ ={Glob.mem} /\ inp{1} = W64.to_uint in_0{2} /\ inlen{1} = to_uint inlen{2} /\ iotas{2} = good_iotas ==> ={Glob.mem} ]. @@ -502,7 +502,7 @@ rewrite -(head_behead (bits2blocks (memr2bits Glob.mem{2} (to_uint in_01{2}) (to_uint inlen1{2})))) b0). smt. rewrite map_cons. simplify. -admit. (* provable *) +admit. (* breaking blocks + head + chunking = take + chunking *) rewrite H6. smt(). smt(). @@ -518,44 +518,32 @@ rewrite (_: (memr2bits Glob.mem{2} (to_uint in_01{2} -136) (memr2bits Glob.mem{2} (to_uint in_01{2} -136) 136) ++ (memr2bits Glob.mem{2} (to_uint in_01{2}) - (to_uint inlen1{2} - 136)))). + (to_uint inlen1{2})))). rewrite /memr2bits. rewrite -flatten_cat. -rewrite (_ : map (fun (o : int) => w2bits Glob.mem{2}.[to_uint in_01{2} + o]) - (iota_ 0 (to_uint inlen1{2} - 136)) = - map (fun (o : int) => w2bits Glob.mem{2}.[to_uint in_01{2} - 136 + o]) - (iota_ 136 (to_uint inlen1{2}))). -rewrite ( _ : (fun (o : int) => w2bits Glob.mem{2}.[to_uint in_01{2} - 136 + o]) - = (fun o => (fun (x : int) => w2bits Glob.mem{2}.[to_uint in_01{2} + x]) (o-136))). -auto => />. admit. (* easy? *) -rewrite (map_comp (fun (x : int) => w2bits Glob.mem{2}.[to_uint in_01{2} + x]) (fun o => o - 136)). -rewrite ( _ : (map (transpose Int.(+) (-136)) (iota_ 136 (to_uint inlen1{2}))) - = iota_ 0 (to_uint inlen1{2} - 136)). -admit. (* easy? *) -by trivial. -rewrite -map_cat. rewrite -iota_add. smt(). smt. smt(). +admit. (* iota_ rearrangements *) rewrite (_ : (bits2blocks (bytewisepad (memr2bits Glob.mem{2} (to_uint in_01{2} - 136) 136 ++ memr2bits Glob.mem{2} (to_uint in_01{2}) - (to_uint inlen1{2} - 136)))) = + (to_uint inlen1{2})))) = head witness (bits2blocks (bytewisepad (memr2bits Glob.mem{2} (to_uint in_01{2} - 136) 136 ++ memr2bits Glob.mem{2} (to_uint in_01{2}) - (to_uint inlen1{2} - 136)))) :: + (to_uint inlen1{2})))) :: (bits2blocks (bytewisepad (memr2bits Glob.mem{2} (to_uint in_01{2}) (to_uint inlen1{2}))))). -admit. (* doable *) +admit. (* breaking in blocks as reading from memory *) by rewrite map_cons. -admit. +admit. (* better keep some relation between size xs and inlen1 *) admit. admit. auto => />. progress. -admit. +admit. (* better keep some relation between size xs and inlen1 *) admit. admit. admit. @@ -563,16 +551,17 @@ admit. (* setting minimum precondition to squeeze *) seq 1 4 : (st{1} = state{2} /\ iotas0{2} = good_iotas /\ - i{1} = 0 /\ + i{1} = 0 /\ + r = 1088 /\ rate{2} = 1088 /\ rate_in_bytes{2} = rate{2} %/ 8 /\ to_uint out_s{2} = outp /\ z{1} = [] /\ outp = out{1} /\ outp = W64.to_uint out0{2} /\ - outlen{1} = 136 /\ + outlen{1} = outlen{2} /\ ={Glob.mem} /\ - hash_bytes{2} = 136). + hash_bytes{2} = outlen{2}). (* we know there's exactly one iteration left to go on the left *) unroll {1} 1. @@ -597,10 +586,10 @@ rewrite /loadpad2wblocks //=. rewrite -(head_behead (bits2blocks (bytewisepad (memr2bits Glob.mem{2} (to_uint in_01{2}) (to_uint inlen1{2})))) b0). -admit. +move : H3; rewrite /loadpad2wblocks => //=. rewrite size_map. smt. rewrite map_cons. simplify. rewrite /bits2blocks. -admit. (* provable *) +admit. (* breaking blocks + head + chunking = take + chunking *) wp. call (perm_imp_correct good_iotas). auto => />. @@ -610,57 +599,221 @@ elim (xs{1}). smt. progress. smt. (* The while on the left is never executed. *) -while {1} (#post /\ xs{1} = []) 1. move => *. exfalso. smt. auto => />. +while {1} (#post /\ xs{1} = []) 1. move => *. exfalso. smt. by auto => />. + (* Squeeze phase *) + +case (outlen{2} <= 0). +admit. (* to do *) + inline M.keccak_1600_squeeze. seq 0 6 : (st{1} = state1{2} /\ iotas2{2} = good_iotas /\ + r = 1088 /\ rate{2} = 1088 /\ rate_in_bytes0{2} = rate{2} %/ 8 /\ to_uint out_s{2} = outp /\ outp = out{1} /\ outp = W64.to_uint out0{2} /\ - outlen{1} = 136 /\ - s_hash_bytes{2} = W64.of_int (136 - (i{1} * 136)) /\ + outlen{1} = outlen{2} /\ + 0 <= i{1} /\ i{1} <= convb outlen{2} - 1 /\ + s_hash_bytes{2} = W64.of_int (outlen{2} - (i{1} * 136)) /\ to_uint out1{2} = 136 * i{1} + outp /\ eqmem_except Glob.mem{1} Glob.mem{2} outp (i{1} * 136) /\ memr2bits Glob.mem{2} outp (i{1} * 136) = take (i{1} * 136 * 8) ((wblocks2bits z{1}))). auto => />. progress. +rewrite /convb. smt. smt(). rewrite /memr2bits /flatten take0 iota0. smt(). smt. -seq 1 1 : (#pre). -while #pre. -seq 2 1 : (#{/~i{1} < convb outlen{1}}pre /\ - i{1} - 1 < convb outlen{1}). +(* All but last iterations exactly match in how permutation is computed *) +splitwhile {1} 1 : (i < convb outlen -1). +splitwhile {2} 1 : (W64.of_int rate_in_bytes0 \ult s_hash_bytes). +seq 1 1 : (#pre /\ + convb outlen{1} - 1 <= i{1} /\ + i{1} <= convb outlen{1} - 1 /\ + s_hash_bytes{2} \ule W64.of_int rate_in_bytes0{2}). +while (#pre /\ + i{1} <= convb outlen{1} - 1). +seq 2 1 : (#{/~i{1} < convb outlen{1}} + {~i{1} < convb outlen{1} - 1} + {~s_hash_bytes{2} = W64.of_int (outlen{2} - (i{1} * 136))}pre /\ + s_hash_bytes{2} = W64.of_int (outlen{2} - ((i{1}-1) * 136)) /\ + i{1} - 1 < convb outlen{1} - 1 /\ + i{1} <= convb outlen{1} - 1 ). exists * Glob.mem{2}, out1{2}, state1{2}, (W64.of_int rate_in_bytes0{2}). elim* => mem outpp st hbytes. call {2} (keccak_1600_xtr_block_spec mem (to_uint outpp) (to_uint hbytes) st). auto => />. progress. -admit. (* safety *) -admit. (* safety *) -admit. (* doable? *) -admit. (* doable? *) -case (i{1} < convb outlen{1}). -rcondt {1} 1. move => *. auto => />. -rcondt {2} 2. move => *. auto => />. progress. admit. +smt(). +smt(). +rewrite of_uintK. +rewrite (_ : to_uint out_s{2} = to_uint out1{2} - 136* i{1}). +smt(). +have ? : (to_uint out1{2} + 136 < W64.modulus). admit. (* safety *) smt. +move : H4 H10; rewrite /eqmem_except H3. +move => *. +case (ad <= to_uint out_s{2}). smt. +move => *. +case (ad < to_uint out_s{2} + (i{1} + 1) * 136). smt. +move => *. +smt. +admit. (* eqmem strengthening *) +smt. +smt. +rcondt {1} 1. move => *. auto => />. smt(). +rcondt {2} 2. move => *. auto => />. +progress. +move : H6 H7 H8; rewrite !ultE uleE /convb => *. +have ? : (0 < outlen{hr} - i{m} * 136). smt. +rewrite (_: outlen{hr} - (i{m} - 1) * 136 - 136 = outlen{hr} - i{m} * 136). by ring. +auto => />. +have ? : (outlen{hr} < W64.modulus). admit. (* safety *) smt. sp. seq 1 1 : #pre. call (perm_imp_correct good_iotas). by auto => />. -auto => />. progress. admit. admit. -rcondf {1} 1. move => *. auto => />. -rcondf {2} 2. move => *. auto => />. progress. admit. +auto => />. progress. smt. +move : H6 H7 H8 H9 H10; rewrite !ultE !uleE /convb => *. +have ? : (0 < outlen{2} - i{1} * 136 -136). smt. +rewrite (_: outlen{2} - (i{1} - 1) * 136 - 136 = outlen{2} - i{1} * 136). by ring. +auto => />. rewrite of_uintK. +have ? : (outlen{2} < W64.modulus). admit. (* safety *) smt. +move : H6 H7 H8 H9 H10; rewrite !ultE !uleE /convb => *. +have ? : (0 < outlen{2} - i{1} * 136 -136). smt. +rewrite (_: outlen{2} - (i{1} - 1) * 136 - 136 = outlen{2} - i{1} * 136). by ring. +auto => />. rewrite of_uintK. +auto => />. +have ? : (outlen{2} < W64.modulus). admit. (* safety *) smt. +smt. +move : H6 H7 H8 H9 H10; rewrite !ultE !uleE /convb => *. +move : H6. +simplify. +have ? : (0 <= outlen{2} - (i{1} - 1) * 136 < W64.modulus). admit. (* safety *) +smt. + auto => />. -progress. admit. admit. -auto => />. progress. admit. admit. +progress. +move : H6 H7 ; rewrite !uleE /convb => *. +have ? : (0 < outlen{2} - i{1} * 136 -136). smt. +auto => />. rewrite of_uintK. +have ? : (outlen{2} < W64.modulus). admit. (* safety *) smt. +move : H6 H7 ; rewrite !ultE /convb => *. +have ? : (0 < outlen{2} - i{1} * 136 -136). smt. +auto => />. rewrite of_uintK. +have ? : (outlen{2} < W64.modulus). admit. (* safety *) smt. +move : H6 H7; rewrite !ultE !uleE /convb => *. +move : H6. +simplify. +have ? : (0 <= outlen{2} - i{1} * 136 < W64.modulus). admit. (* safety *) +smt. +move : H6 H7; rewrite !ultE !uleE /convb => *. +move : H6. +simplify. +have ? : (0 <= outlen{2} - i{1} * 136 < W64.modulus). admit. (* safety *) +smt. +smt. +move : H6 H7 H8 H9; rewrite !ultE !uleE /convb => *. +smt. + +(* Different behaviour for non-block-aligned outputs *) +case (s_hash_bytes{2} = W64.of_int rate_in_bytes0{2}); last first. +seq 0 1 : #pre. +while {2} (#pre) 1. move => *. exfalso. +move => &hr [ # *]. +have ? : (s_hash_bytes{hr} \ult (of_int rate_in_bytes0{hr})%W64). +move : H16; rewrite uleE ultE. smt. +have ? : ((of_int rate_in_bytes0{hr})%W64 \ult s_hash_bytes{hr}). +move : H18; rewrite uleE ultE. smt. +smt. +by progress. + +unroll {1} 1. +rcondt{1} 1. move => *. auto => />. +progress. +smt. +rcondf {1} 3. move => *. auto => />. smt. +sp. +seq 1 0 : #pre. +while {1} (#pre) 1. move => *. exfalso. +move => *. auto => />. smt. +by auto => />. +wp. exists * Glob.mem{2}, out1{2}, state1{2}, s_hash_bytes{2}. elim* => mem outpp st hbytes. +move => *. call {2} (keccak_1600_xtr_block_spec mem (to_uint outpp) (to_uint hbytes) st). auto => />. progress. +admit. (* store properties *) + +(* Same behaviour for block aligned outputs *) +unroll {1} 1. +unroll {2} 1. +rcondt{1} 1. move => *. auto => />. +progress. +smt. +rcondt{2} 1. move => *. auto => />. +progress. +smt. +rcondf{1} 3. move => *. auto => />. +progress. +smt. +rcondf{2} 3. move => *. auto => />. +progress. +call (_: true). by auto => />. +auto => />. +progress. +move : H2 H6 H7 H8; rewrite uleE /convb => *. +have ? : (outlen{hr} - i{m} * 136 <= W64.modulus). smt. +have ? : (i{m} = (outlen{hr} * 8 + r - 1) %/ r - 1). smt(). +have ? : (outlen{hr} * 8 %% r = 0). smt. +move : H10; rewrite divzDl. rewrite /(%|). smt. smt. +seq 2 3 : (#{/~i{1} <= convb outlen{1} -1} + {~i{1} <= convb outlen{2} - 1} + {~convb outlen{1} - 1 <= i{1}} + {~s_hash_bytes{2}}pre /\ + i{1} = convb outlen{1} /\ + (! (of_int rate_in_bytes0{2})%W64 \ule s_hash_bytes{2})). +wp. +exists * Glob.mem{2}, out1{2}, state1{2}, s_hash_bytes{2}. +elim* => mem outpp st hbytes. +move => *. +call {2} (keccak_1600_xtr_block_spec mem (to_uint outpp) (to_uint hbytes) st). +auto => />. +progress. +move : H8 => //=. +have ? : (outlen{2} - i{1} * 136 <= W64.modulus). admit. (* safety *) +smt. +smt (). +rewrite H3. rewrite (W64.of_uintK ( (outlen{2} - i{1} * 136))). rewrite W64.of_uintK. +auto => />. +have ? : 0 <= outlen{2} - i{1} * 136 < W64.modulus. admit. (* safety *) +rewrite (_ : + (outlen{2} - i{1} * 136) %% 18446744073709551616 = outlen{2} - i{1} * 136). smt. +have ? : (i{1} + 1 = outlen{2}). admit. +smt. +move : H4 H10; rewrite /eqmem_except. +smt. +admit. +smt. admit. + +sp. +seq 1 1 : #pre. +while (#pre). exfalso. smt. +by auto => />. + +wp. +exists * Glob.mem{2}, out1{2}, state1{2}, s_hash_bytes{2}. +elim* => mem outpp st hbytes. +move => *. +call {2} (keccak_1600_xtr_block_spec mem (to_uint outpp) (to_uint hbytes) st). +auto => />. +progress. +admit. (* store properties *) + qed. From b0a9f43dd14f8c43920bbba4ba9600ac18346835 Mon Sep 17 00:00:00 2001 From: Manuel Barbosa Date: Sun, 21 Apr 2019 14:12:09 +0100 Subject: [PATCH 358/525] Implementation proof sketch --- proof/impl/shake256.ec | 14 +++++++++++--- 1 file changed, 11 insertions(+), 3 deletions(-) diff --git a/proof/impl/shake256.ec b/proof/impl/shake256.ec index f182c23..1a7e692 100644 --- a/proof/impl/shake256.ec +++ b/proof/impl/shake256.ec @@ -794,13 +794,21 @@ auto => />. have ? : 0 <= outlen{2} - i{1} * 136 < W64.modulus. admit. (* safety *) rewrite (_ : (outlen{2} - i{1} * 136) %% 18446744073709551616 = outlen{2} - i{1} * 136). smt. -have ? : (i{1} + 1 = outlen{2}). admit. +have ? : (i{1} = convb outlen{2} -1). smt (). +have ? : (136*i{1} + 136 = outlen{2}). smt. +rewrite -H14 => //=. +rewrite (_: 136 * i{1} + to_uint out_s{2} + (136 * i{1} + 136 - i{1} * 136) = 136 * (i{1} + 1) + to_uint out_s{2}). by ring. +have ? : (0 <= 136 * (i{1} + 1) + to_uint out_s{2} < W64.modulus). admit. (* safety *) smt. move : H4 H10; rewrite /eqmem_except. +progress. +case ( ! to_uint out_s{2} <= ad < to_uint out_s{2} + i{1} * 136). smt. -admit. smt. -admit. + +admit. (* eqmem strengthening *) +smt. +move : H6 H7 H8 H9; rewrite !uleE /convb. smt. sp. seq 1 1 : #pre. From 8e3d7836c38836342f2a69b1c0d7fbe7cd5aa8d0 Mon Sep 17 00:00:00 2001 From: Manuel Barbosa Date: Mon, 22 Apr 2019 15:38:18 +0100 Subject: [PATCH 359/525] Generalised implementation proof sketch to generic sponge routine --- proof/impl/{shake256.ec => keccak.ec} | 414 ++++++++++---------------- 1 file changed, 165 insertions(+), 249 deletions(-) rename proof/impl/{shake256.ec => keccak.ec} (61%) diff --git a/proof/impl/shake256.ec b/proof/impl/keccak.ec similarity index 61% rename from proof/impl/shake256.ec rename to proof/impl/keccak.ec index 1a7e692..08742f2 100644 --- a/proof/impl/shake256.ec +++ b/proof/impl/keccak.ec @@ -1,9 +1,6 @@ require import List Int IntExtra IntDiv CoreMap. from Jasmin require import JModel. -(* require import Array5 Array25. -require import WArray40 WArray200. *) - require Spec. clone import Spec as Spc. import Spc.Spnge. @@ -14,10 +11,19 @@ clone export PolyArray as Array5 with op size <- 5. clone export WArray as WArray200 with op size <- 200. clone export WArray as WArray40 with op size <- 40. + op x86_ROL_64 : W64.t -> W8.t -> bool * bool * W64.t. op set0_64 : bool * bool * bool * bool * bool * W64.t. op x86_TEST_8 : W8.t -> W8.t -> bool * bool * bool * bool * bool. +(* +require import List Int IntExtra Int_Div CoreMap. +from Jasmin require import JModel. + +require import Array5 Array25. +require import WArray40 WArray200. +*) + module M = { proc spill_2 (a:W64.t, b:W64.t) : W64.t * W64.t = { @@ -28,7 +34,7 @@ module M = { sb <- b; return (sa, sb); } - + proc load_2 (sa:W64.t, sb:W64.t) : W64.t * W64.t = { var a:W64.t; @@ -38,7 +44,7 @@ module M = { b <- sb; return (a, b); } -(* + (* proc rOL64 (x:W64.t, c:int) : W64.t = { var y:W64.t; @@ -122,63 +128,63 @@ module M = { proc theta_sum (A:W64.t Array25.t) : W64.t Array5.t = { var aux: int; - var _c:W64.t Array5.t; + var _C:W64.t Array5.t; var i:int; var j:int; - _c <- witness; + _C <- witness; i <- 0; while (i < 5) { - _c.[i] <- A.[((5 * (0 %% 5)) + (i %% 5))]; + _C.[i] <- A.[((5 * (0 %% 5)) + (i %% 5))]; j <- 1; while (j < 5) { - _c.[i] <- (_c.[i] `^` A.[((5 * (j %% 5)) + (i %% 5))]); + _C.[i] <- (_C.[i] `^` A.[((5 * (j %% 5)) + (i %% 5))]); j <- j + 1; } i <- i + 1; } - return (_c); + return (_C); } - proc theta_rol (_c:W64.t Array5.t) : W64.t Array5.t = { + proc theta_rol (_C:W64.t Array5.t) : W64.t Array5.t = { var aux: int; - var _d:W64.t Array5.t; + var _D:W64.t Array5.t; var i:int; var r:W64.t; - _d <- witness; + _D <- witness; i <- 0; while (i < 5) { - r <@ rOL64 (_c.[((i + 1) %% 5)], 1); - _d.[i] <- r; - _d.[i] <- (_d.[i] `^` _c.[((i + 4) %% 5)]); + r <@ rOL64 (_C.[((i + 1) %% 5)], 1); + _D.[i] <- r; + _D.[i] <- (_D.[i] `^` _C.[((i + 4) %% 5)]); i <- i + 1; } - return (_d); + return (_D); } - proc rol_sum (_d:W64.t Array5.t, A:W64.t Array25.t, offset:int) : W64.t Array5.t = { + proc rol_sum (_D:W64.t Array5.t, A:W64.t Array25.t, offset:int) : W64.t Array5.t = { var aux: int; - var _c:W64.t Array5.t; + var _C:W64.t Array5.t; var j:int; var j1:int; var k:int; var t:W64.t; - _c <- witness; + _C <- witness; j <- 0; while (j < 5) { j1 <- ((j + offset) %% 5); k <@ rhotates (j, j1); t <- A.[((5 * (j %% 5)) + (j1 %% 5))]; - t <- (t `^` _d.[j1]); + t <- (t `^` _D.[j1]); t <@ rOL64 (t, k); - _c.[j] <- t; + _C.[j] <- t; j <- j + 1; } - return (_c); + return (_C); } - proc set_row (_r:W64.t Array25.t, row:int, _c:W64.t Array5.t, iota_0:W64.t) : + proc set_row (_R:W64.t Array25.t, row:int, _C:W64.t Array5.t, iota_0:W64.t) : W64.t Array25.t = { var aux: int; @@ -191,67 +197,66 @@ module M = { while (j < 5) { j1 <- ((j + 1) %% 5); j2 <- ((j + 2) %% 5); - t <- ((invw _c.[j1]) `&` _c.[j2]); + t <- ((invw _C.[j1]) `&` _C.[j2]); if (((row = 0) /\ (j = 0))) { t <- (t `^` iota_0); } else { } - t <- (t `^` _c.[j]); - _r.[((5 * (row %% 5)) + (j %% 5))] <- t; + t <- (t `^` _C.[j]); + _R.[((5 * (row %% 5)) + (j %% 5))] <- t; j <- j + 1; } - return (_r); + return (_R); } - proc round2x (A:W64.t Array25.t, _r:W64.t Array25.t, iotas:W64.t, o:int) : + proc round2x (A:W64.t Array25.t, _R:W64.t Array25.t, iotas:W64.t, o:int) : W64.t Array25.t * W64.t Array25.t = { var iota_0:W64.t; - var _c:W64.t Array5.t; - var _d:W64.t Array5.t; - _c <- witness; - _d <- witness; + var _C:W64.t Array5.t; + var _D:W64.t Array5.t; + _C <- witness; + _D <- witness; iota_0 <- (loadW64 Glob.mem (W64.to_uint (iotas + (W64.of_int o)))); - _c <@ theta_sum (A); - _d <@ theta_rol (_c); - _c <@ rol_sum (_d, A, 0); - _r <@ set_row (_r, 0, _c, iota_0); - _c <@ rol_sum (_d, A, 3); - _r <@ set_row (_r, 1, _c, iota_0); - _c <@ rol_sum (_d, A, 1); - _r <@ set_row (_r, 2, _c, iota_0); - _c <@ rol_sum (_d, A, 4); - _r <@ set_row (_r, 3, _c, iota_0); - _c <@ rol_sum (_d, A, 2); - _r <@ set_row (_r, 4, _c, iota_0); - return (A, _r); + _C <@ theta_sum (A); + _D <@ theta_rol (_C); + _C <@ rol_sum (_D, A, 0); + _R <@ set_row (_R, 0, _C, iota_0); + _C <@ rol_sum (_D, A, 3); + _R <@ set_row (_R, 1, _C, iota_0); + _C <@ rol_sum (_D, A, 1); + _R <@ set_row (_R, 2, _C, iota_0); + _C <@ rol_sum (_D, A, 4); + _R <@ set_row (_R, 3, _C, iota_0); + _C <@ rol_sum (_D, A, 2); + _R <@ set_row (_R, 4, _C, iota_0); + return (A, _R); } *) proc keccak_f (A:W64.t Array25.t, iotas:W64.t) : W64.t Array25.t * W64.t = { - (* + (* var zf:bool; - var _r:W64.t Array25.t; + var _R:W64.t Array25.t; var _0:bool; var _1:bool; var _2:bool; var _3:bool; - _r <- witness; - (A, _r) <@ round2x (A, _r, iotas, 0); - (_r, A) <@ round2x (_r, A, iotas, 8); + _R <- witness; + (A, _R) <@ round2x (A, _R, iotas, 0); + (_R, A) <@ round2x (_R, A, iotas, 8); iotas <- (iotas + (W64.of_int 16)); ( _0, _1, _2, _3, zf) <- x86_TEST_8 (truncateu8 iotas) (W8.of_int 255); while ((! zf)) { - (A, _r) <@ round2x (A, _r, iotas, 0); - (_r, A) <@ round2x (_r, A, iotas, 8); + (A, _R) <@ round2x (A, _R, iotas, 0); + (_R, A) <@ round2x (_R, A, iotas, 8); iotas <- (iotas + (W64.of_int 16)); ( _0, _1, _2, _3, zf) <- x86_TEST_8 (truncateu8 iotas) (W8.of_int 255); } - iotas <- (iotas - (W64.of_int 192)); - return (A, iotas); *) - return witness; + iotas <- (iotas - (W64.of_int 192));*) + return (A, iotas); } proc keccak_1600_add_full_block (state:W64.t Array25.t, in_0:W64.t, @@ -372,12 +377,10 @@ module M = { s_hash_bytes <- (W64.of_int i_hash_bytes); - while (((W64.of_int rate_in_bytes) \ule s_hash_bytes)) { + while (((W64.of_int rate_in_bytes) \ult s_hash_bytes)) { out <@ keccak_1600_xtr_block (state, out, (W64.of_int rate_in_bytes)); s_out <- out; - if (( W64.of_int 0 <> s_hash_bytes - (W64.of_int rate_in_bytes))) { (* ADDED!!! *) - (state, iotas) <@ keccak_f (state, iotas); - } + (state, iotas) <@ keccak_f (state, iotas); s_hash_bytes <- (s_hash_bytes - (W64.of_int rate_in_bytes)); out <- s_out; } @@ -400,15 +403,6 @@ module M = { keccak_1600_squeeze (state, iotas, out, (rate %/ 8), hash_bytes); return (); } - - proc shake256_ref2x_jazz (out:W64.t, in_0:W64.t, inlen:W64.t, iotas:W64.t, - m:W64.t, outlen : int) : unit = { - - - - keccak_1600 (out, in_0, inlen, iotas, m, 31, 1088, 512, (* 136 *) outlen); - return (); - } }. section. @@ -459,14 +453,13 @@ phoare keccak_1600_add_final_block_spec mem st inp inl rate wb : admitted. lemma impl_correct outp : -equiv [ Spec(Preal).f ~ M.shake256_ref2x_jazz : - outp = out{1} /\ outp = W64.to_uint out{2} /\ outlen{1} = outlen{2} /\ - domain_bits = [ true; true; true;true ] /\ suffix_bits = [] /\ r = 1088 /\ c = 512 /\ +equiv [ Spec(Preal).f ~ M.keccak_1600 : + outp = out{1} /\ outp = W64.to_uint out{2} /\ outlen{1} = hash_bytes{2} /\ + domain_bits{1} ++ suffix_bits{1} = suffix_bits{2} /\ r = rate{2} /\ c = capacity{2} /\ ={Glob.mem} /\ inp{1} = W64.to_uint in_0{2} /\ inlen{1} = to_uint inlen{2} /\ iotas{2} = good_iotas ==> ={Glob.mem} ]. proc. -inline M.keccak_1600. sp. seq 0 1 : (#{~state{2}}pre /\ state{2} = st{1}). exists *Glob.mem{2}. @@ -478,20 +471,20 @@ inline M.keccak_1600_absorb. sp. splitwhile {1} 1 : (1 < size xs). seq 1 1 : (#{/~state0{2}} - {~in_01{2}} - {~inlen1{2}} + {~in_00{2}} + {~inlen0{2}} {~xs{1}} {~st{1}}pre /\ st{1} = state0{2} /\ - xs{1} = loadpad2wblocks Glob.mem{1} (W64.to_uint in_01{2}) (W64.to_uint inlen1{2}) + xs{1} = loadpad2wblocks Glob.mem{1} (W64.to_uint in_00{2}) (W64.to_uint inlen0{2}) /\ size xs{1} <= 1). while (#{~ size xs{1} <= 1}post). seq 0 1 : (#{/~state0{2}} - {~in_01{2}} - {~inlen1{2}}pre /\ + {~in_00{2}} + {~inlen0{2}}pre /\ combine st{1} (head wblock0 xs{1}) = state0{2} /\ - xs{1} = loadpad2wblocks Glob.mem{1} (W64.to_uint in_01{2} - rate_in_bytes{2}) (W64.to_uint inlen1{2} + rate_in_bytes{2})). -exists * Glob.mem{2}, state0{2}, (to_uint in_01{2}), (to_uint inlen1{2}), rate_in_bytes{2}, (head wblock0 xs{1}). + xs{1} = loadpad2wblocks Glob.mem{1} (W64.to_uint in_00{2} - rate_in_bytes{2}) (W64.to_uint inlen0{2} + rate_in_bytes{2})). +exists * Glob.mem{2}, state0{2}, (to_uint in_00{2}), (to_uint inlen0{2}), rate_in_bytes{2}, (head wblock0 xs{1}). elim* => mem st inp inl rate wb. call {2} (keccak_1600_add_full_block_spec mem st inp inl rate wb). auto => />. @@ -499,11 +492,11 @@ progress. rewrite /loadpad2wblocks //=. rewrite -(head_behead (bits2blocks (bytewisepad - (memr2bits Glob.mem{2} (to_uint in_01{2}) (to_uint inlen1{2})))) b0). + (memr2bits Glob.mem{2} (to_uint in_00{2}) (to_uint inlen0{2})))) b0). smt. rewrite map_cons. simplify. admit. (* breaking blocks + head + chunking = take + chunking *) -rewrite H6. +rewrite H4. smt(). smt(). inline M.load_2. @@ -513,71 +506,70 @@ inline *. wp;auto => />. progress. rewrite /loadpad2wblocks. simplify. -rewrite (_: (memr2bits Glob.mem{2} (to_uint in_01{2} -136) - (to_uint inlen1{2} + 136) = - (memr2bits Glob.mem{2} (to_uint in_01{2} -136) - 136) ++ - (memr2bits Glob.mem{2} (to_uint in_01{2}) - (to_uint inlen1{2})))). +rewrite (_: (memr2bits Glob.mem{2} (to_uint in_00{2} - r %/ 8) + (to_uint inlen0{2} + r %/ 8) = + (memr2bits Glob.mem{2} (to_uint in_00{2} - r %/ 8) + (r %/ 8)) ++ + (memr2bits Glob.mem{2} (to_uint in_00{2}) + (to_uint inlen0{2})))). rewrite /memr2bits. rewrite -flatten_cat. admit. (* iota_ rearrangements *) rewrite (_ : (bits2blocks (bytewisepad - (memr2bits Glob.mem{2} (to_uint in_01{2} - 136) 136 ++ - memr2bits Glob.mem{2} (to_uint in_01{2}) - (to_uint inlen1{2})))) = + (memr2bits Glob.mem{2} (to_uint in_00{2} - r %/ 8) (r %/ 8) ++ + memr2bits Glob.mem{2} (to_uint in_00{2}) + (to_uint inlen0{2})))) = head witness (bits2blocks (bytewisepad - (memr2bits Glob.mem{2} (to_uint in_01{2} - 136) 136 ++ - memr2bits Glob.mem{2} (to_uint in_01{2}) - (to_uint inlen1{2})))) :: + (memr2bits Glob.mem{2} (to_uint in_00{2} - r %/ 8) (r %/ 8) ++ + memr2bits Glob.mem{2} (to_uint in_00{2}) + (to_uint inlen0{2})))) :: (bits2blocks (bytewisepad - (memr2bits Glob.mem{2} (to_uint in_01{2}) (to_uint inlen1{2}))))). + (memr2bits Glob.mem{2} (to_uint in_00{2}) (to_uint inlen0{2}))))). admit. (* breaking in blocks as reading from memory *) by rewrite map_cons. -admit. (* better keep some relation between size xs and inlen1 *) +admit. (* better keep some relation between size xs and inlen0 *) admit. admit. auto => />. progress. -admit. (* better keep some relation between size xs and inlen1 *) +admit. (* better keep some relation between size xs and inlen0 *) admit. admit. admit. (* setting minimum precondition to squeeze *) seq 1 4 : (st{1} = state{2} /\ - iotas0{2} = good_iotas /\ + iotas{2} = good_iotas /\ i{1} = 0 /\ - r = 1088 /\ - rate{2} = 1088 /\ + rate{2} = r /\ rate_in_bytes{2} = rate{2} %/ 8 /\ to_uint out_s{2} = outp /\ z{1} = [] /\ outp = out{1} /\ - outp = W64.to_uint out0{2} /\ - outlen{1} = outlen{2} /\ + outp = W64.to_uint out{2} /\ + outlen{1} = hash_bytes{2} /\ ={Glob.mem} /\ - hash_bytes{2} = outlen{2}). + hash_bytes{2} = hash_bytes{2}). (* we know there's exactly one iteration left to go on the left *) unroll {1} 1. (* The final iteration matches the block for which padding was added *) rcondt {1} 1. move => *. auto => />. -have always : (1 <= size (loadpad2wblocks Glob.mem{m} (to_uint in_01{m}) (to_uint inlen1{m}))). +have always : (1 <= size (loadpad2wblocks Glob.mem{m} (to_uint in_00{m}) (to_uint inlen0{m}))). admit. (* prove once and for all *) smt(). seq 2 2 : (#{~xs{1}}pre /\ xs{1} = []). seq 0 1 : (#{/~state0{2}} - {~in_01{2}} - {~inlen1{2}} + {~in_00{2}} + {~inlen0{2}} {~xs{1}} {~st{1}}pre /\ combine st{1} (head wblock0 xs{1}) = state0{2} /\ size xs{1} <= 1). -exists * Glob.mem{2}, state0{2}, (to_uint in_01{2}), (to_uint inlen1{2}), rate_in_bytes{2}, (head wblock0 xs{1}). +exists * Glob.mem{2}, state0{2}, (to_uint in_00{2}), (to_uint inlen0{2}), rate_in_bytes{2}, (head wblock0 xs{1}). elim* => mem st inp inl rate wb. call {2} (keccak_1600_add_final_block_spec mem st inp inl rate wb). auto => />. @@ -585,8 +577,8 @@ progress. rewrite /loadpad2wblocks //=. rewrite -(head_behead (bits2blocks (bytewisepad - (memr2bits Glob.mem{2} (to_uint in_01{2}) (to_uint inlen1{2})))) b0). -move : H3; rewrite /loadpad2wblocks => //=. rewrite size_map. smt. + (memr2bits Glob.mem{2} (to_uint in_00{2}) (to_uint inlen0{2})))) b0). +move : H0; rewrite /loadpad2wblocks => //=. rewrite size_map. smt. rewrite map_cons. simplify. rewrite /bits2blocks. admit. (* breaking blocks + head + chunking = take + chunking *) @@ -603,25 +595,24 @@ while {1} (#post /\ xs{1} = []) 1. move => *. exfalso. smt. by auto => />. (* Squeeze phase *) -case (outlen{2} <= 0). +case (hash_bytes{2} <= 0). admit. (* to do *) inline M.keccak_1600_squeeze. seq 0 6 : (st{1} = state1{2} /\ - iotas2{2} = good_iotas /\ - r = 1088 /\ - rate{2} = 1088 /\ + iotas1{2} = good_iotas /\ + rate{2} = r /\ rate_in_bytes0{2} = rate{2} %/ 8 /\ to_uint out_s{2} = outp /\ outp = out{1} /\ - outp = W64.to_uint out0{2} /\ - outlen{1} = outlen{2} /\ - 0 <= i{1} /\ i{1} <= convb outlen{2} - 1 /\ - s_hash_bytes{2} = W64.of_int (outlen{2} - (i{1} * 136)) /\ - to_uint out1{2} = 136 * i{1} + outp /\ - eqmem_except Glob.mem{1} Glob.mem{2} outp (i{1} * 136) /\ - memr2bits Glob.mem{2} outp (i{1} * 136) = - take (i{1} * 136 * 8) ((wblocks2bits z{1}))). + outp = W64.to_uint out{2} /\ + outlen{1} = hash_bytes{2} /\ + 0 <= i{1} /\ i{1} <= convb hash_bytes{2} - 1 /\ + s_hash_bytes{2} = W64.of_int (hash_bytes{2} - (i{1} * r %/ 8)) /\ + to_uint out0{2} = r %/ 8 * i{1} + outp /\ + eqmem_except Glob.mem{1} Glob.mem{2} outp (i{1} * r %/ 8) /\ + memr2bits Glob.mem{2} outp (i{1} * r %/ 8) = + take (i{1} * r %/ 8 * 8) ((wblocks2bits z{1}))). auto => />. progress. rewrite /convb. smt. @@ -639,11 +630,11 @@ while (#pre /\ i{1} <= convb outlen{1} - 1). seq 2 1 : (#{/~i{1} < convb outlen{1}} {~i{1} < convb outlen{1} - 1} - {~s_hash_bytes{2} = W64.of_int (outlen{2} - (i{1} * 136))}pre /\ - s_hash_bytes{2} = W64.of_int (outlen{2} - ((i{1}-1) * 136)) /\ + {~s_hash_bytes{2} = W64.of_int (hash_bytes{2} - (i{1} * r %/ 8))}pre /\ + s_hash_bytes{2} = W64.of_int (hash_bytes{2} - ((i{1}-1) * r %/ 8)) /\ i{1} - 1 < convb outlen{1} - 1 /\ i{1} <= convb outlen{1} - 1 ). -exists * Glob.mem{2}, out1{2}, state1{2}, (W64.of_int rate_in_bytes0{2}). +exists * Glob.mem{2}, out0{2}, state1{2}, (W64.of_int rate_in_bytes0{2}). elim* => mem outpp st hbytes. call {2} (keccak_1600_xtr_block_spec mem (to_uint outpp) (to_uint hbytes) st). auto => />. @@ -651,172 +642,97 @@ progress. smt(). smt(). rewrite of_uintK. -rewrite (_ : to_uint out_s{2} = to_uint out1{2} - 136* i{1}). +rewrite (_ : to_uint out_s{2} = to_uint out0{2} - r %/ 8* i{1}). smt(). -have ? : (to_uint out1{2} + 136 < W64.modulus). admit. (* safety *) smt. -move : H4 H10; rewrite /eqmem_except H3. +ring. +rewrite -to_uintD. + admit. (* safety *) +move : H3 H8; rewrite /eqmem_except H2. move => *. -case (ad <= to_uint out_s{2}). smt. +case (ad <= to_uint out_s{2}). +admit. (* interval matching *) move => *. -case (ad < to_uint out_s{2} + (i{1} + 1) * 136). smt. +case (ad < to_uint out_s{2} + (i{1} + 1) * r %/ 8). +admit. (* interval matching *) move => *. -smt. +admit. (* interval matching *) admit. (* eqmem strengthening *) smt. smt. rcondt {1} 1. move => *. auto => />. smt(). -rcondt {2} 2. move => *. auto => />. progress. -move : H6 H7 H8; rewrite !ultE uleE /convb => *. -have ? : (0 < outlen{hr} - i{m} * 136). smt. -rewrite (_: outlen{hr} - (i{m} - 1) * 136 - 136 = outlen{hr} - i{m} * 136). by ring. -auto => />. -have ? : (outlen{hr} < W64.modulus). admit. (* safety *) smt. sp. seq 1 1 : #pre. call (perm_imp_correct good_iotas). by auto => />. -auto => />. progress. smt. -move : H6 H7 H8 H9 H10; rewrite !ultE !uleE /convb => *. -have ? : (0 < outlen{2} - i{1} * 136 -136). smt. -rewrite (_: outlen{2} - (i{1} - 1) * 136 - 136 = outlen{2} - i{1} * 136). by ring. -auto => />. rewrite of_uintK. -have ? : (outlen{2} < W64.modulus). admit. (* safety *) smt. -move : H6 H7 H8 H9 H10; rewrite !ultE !uleE /convb => *. -have ? : (0 < outlen{2} - i{1} * 136 -136). smt. -rewrite (_: outlen{2} - (i{1} - 1) * 136 - 136 = outlen{2} - i{1} * 136). by ring. -auto => />. rewrite of_uintK. -auto => />. -have ? : (outlen{2} < W64.modulus). admit. (* safety *) smt. -smt. -move : H6 H7 H8 H9 H10; rewrite !ultE !uleE /convb => *. -move : H6. -simplify. -have ? : (0 <= outlen{2} - (i{1} - 1) * 136 < W64.modulus). admit. (* safety *) +auto => />. progress. ring. admit. (* safety *) +admit. (* bound matching *) +admit. (* bound matching *) smt. +admit. (* bound matching *) auto => />. progress. -move : H6 H7 ; rewrite !uleE /convb => *. -have ? : (0 < outlen{2} - i{1} * 136 -136). smt. -auto => />. rewrite of_uintK. -have ? : (outlen{2} < W64.modulus). admit. (* safety *) smt. -move : H6 H7 ; rewrite !ultE /convb => *. -have ? : (0 < outlen{2} - i{1} * 136 -136). smt. -auto => />. rewrite of_uintK. -have ? : (outlen{2} < W64.modulus). admit. (* safety *) smt. -move : H6 H7; rewrite !ultE !uleE /convb => *. -move : H6. -simplify. -have ? : (0 <= outlen{2} - i{1} * 136 < W64.modulus). admit. (* safety *) +admit. (* bound matching *) +admit. (* bound matching *) smt. -move : H6 H7; rewrite !ultE !uleE /convb => *. -move : H6. -simplify. -have ? : (0 <= outlen{2} - i{1} * 136 < W64.modulus). admit. (* safety *) +admit. (* bound matching *) smt. -smt. -move : H6 H7 H8 H9; rewrite !ultE !uleE /convb => *. -smt. - -(* Different behaviour for non-block-aligned outputs *) -case (s_hash_bytes{2} = W64.of_int rate_in_bytes0{2}); last first. -seq 0 1 : #pre. -while {2} (#pre) 1. move => *. exfalso. -move => &hr [ # *]. -have ? : (s_hash_bytes{hr} \ult (of_int rate_in_bytes0{hr})%W64). -move : H16; rewrite uleE ultE. smt. -have ? : ((of_int rate_in_bytes0{hr})%W64 \ult s_hash_bytes{hr}). -move : H18; rewrite uleE ultE. smt. -smt. -by progress. +admit. (* bound matching *) -unroll {1} 1. -rcondt{1} 1. move => *. auto => />. -progress. -smt. -rcondf {1} 3. move => *. auto => />. smt. -sp. -seq 1 0 : #pre. -while {1} (#pre) 1. move => *. exfalso. -move => *. auto => />. smt. -by auto => />. -wp. -exists * Glob.mem{2}, out1{2}, state1{2}, s_hash_bytes{2}. -elim* => mem outpp st hbytes. -move => *. -call {2} (keccak_1600_xtr_block_spec mem (to_uint outpp) (to_uint hbytes) st). -auto => />. -progress. -admit. (* store properties *) +(* Same behaviour for non-block-aligned outputs *) +case (s_hash_bytes{2} = W64.of_int rate_in_bytes0{2}). -(* Same behaviour for block aligned outputs *) unroll {1} 1. unroll {2} 1. rcondt{1} 1. move => *. auto => />. progress. smt. -rcondt{2} 1. move => *. auto => />. -progress. -smt. rcondf{1} 3. move => *. auto => />. progress. smt. -rcondf{2} 3. move => *. auto => />. +rcondf{2} 1. move => *. auto => />. progress. -call (_: true). by auto => />. -auto => />. -progress. -move : H2 H6 H7 H8; rewrite uleE /convb => *. -have ? : (outlen{hr} - i{m} * 136 <= W64.modulus). smt. -have ? : (i{m} = (outlen{hr} * 8 + r - 1) %/ r - 1). smt(). -have ? : (outlen{hr} * 8 %% r = 0). smt. -move : H10; rewrite divzDl. rewrite /(%|). smt. smt. -seq 2 3 : (#{/~i{1} <= convb outlen{1} -1} - {~i{1} <= convb outlen{2} - 1} - {~convb outlen{1} - 1 <= i{1}} - {~s_hash_bytes{2}}pre /\ - i{1} = convb outlen{1} /\ - (! (of_int rate_in_bytes0{2})%W64 \ule s_hash_bytes{2})). +rewrite ultE. smt. + +seq 0 1 : #pre. +while {2} (#pre) 1. +move => *. exfalso. smt (@W64). + +by auto => />. + wp. -exists * Glob.mem{2}, out1{2}, state1{2}, s_hash_bytes{2}. +while {1} (#post /\ convb outlen{1} <= i{1}) 1. +move => *. exfalso. smt (). + +exists * Glob.mem{2}, out0{2}, state1{2}, s_hash_bytes{2}. elim* => mem outpp st hbytes. move => *. call {2} (keccak_1600_xtr_block_spec mem (to_uint outpp) (to_uint hbytes) st). auto => />. progress. -move : H8 => //=. -have ? : (outlen{2} - i{1} * 136 <= W64.modulus). admit. (* safety *) -smt. -smt (). -rewrite H3. rewrite (W64.of_uintK ( (outlen{2} - i{1} * 136))). rewrite W64.of_uintK. -auto => />. -have ? : 0 <= outlen{2} - i{1} * 136 < W64.modulus. admit. (* safety *) -rewrite (_ : - (outlen{2} - i{1} * 136) %% 18446744073709551616 = outlen{2} - i{1} * 136). smt. -have ? : (i{1} = convb outlen{2} -1). smt (). -have ? : (136*i{1} + 136 = outlen{2}). smt. -rewrite -H14 => //=. -rewrite (_: 136 * i{1} + to_uint out_s{2} + (136 * i{1} + 136 - i{1} * 136) = 136 * (i{1} + 1) + to_uint out_s{2}). by ring. -have ? : (0 <= 136 * (i{1} + 1) + to_uint out_s{2} < W64.modulus). admit. (* safety *) -smt. -move : H4 H10; rewrite /eqmem_except. -progress. -case ( ! to_uint out_s{2} <= ad < to_uint out_s{2} + i{1} * 136). -smt. -smt. +admit. (* store properties *) +smt(). -admit. (* eqmem strengthening *) -smt. -move : H6 H7 H8 H9; rewrite !uleE /convb. smt. +(* Different behaviour for non-block aligned outputs *) + +seq 0 1 : #pre. +while {2} (#pre) 1. move => *. exfalso. +move => &hr [ # *]. smt(@W64). +by progress. +unroll {1} 1. +rcondt{1} 1. move => *. auto => />. +progress. +smt. +rcondf {1} 3. move => *. auto => />. smt(). sp. -seq 1 1 : #pre. -while (#pre). exfalso. smt. +seq 1 0 : #pre. +while {1} (#pre) 1. move => *. exfalso. +move => *. auto => />. smt. by auto => />. - wp. -exists * Glob.mem{2}, out1{2}, state1{2}, s_hash_bytes{2}. +exists * Glob.mem{2}, out0{2}, state1{2}, s_hash_bytes{2}. elim* => mem outpp st hbytes. move => *. call {2} (keccak_1600_xtr_block_spec mem (to_uint outpp) (to_uint hbytes) st). From 4184eb50a17c598a221288489a116a86d8d9f8f8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jos=C3=A9=20Bacelar=20Almeida?= Date: Tue, 23 Apr 2019 11:29:05 +0100 Subject: [PATCH 360/525] 1600 bit state --- proof/impl/Spec1600.ec | 958 +++++++++++++++++++++++++++++++++++++++ proof/impl/Sponge1600.ec | 68 +++ 2 files changed, 1026 insertions(+) create mode 100644 proof/impl/Spec1600.ec create mode 100644 proof/impl/Sponge1600.ec diff --git a/proof/impl/Spec1600.ec b/proof/impl/Spec1600.ec new file mode 100644 index 0000000..0ef65fc --- /dev/null +++ b/proof/impl/Spec1600.ec @@ -0,0 +1,958 @@ +require import AllCore List Int IntDiv. +(*from Jasmin*) require import JArray JMemory JModel JUtils JWord JWord_array. + +op ratio :int. +axiom ratio_bnds: 0 < ratio < 1600. +axiom ratio_w64: 64 %| ratio. + +require Sponge1600. + + +clone import Sponge1600 as Spnge1600 + with op ratio = ratio + proof ratio_bnds by apply ratio_bnds + proof ratio_w64 by apply ratio_w64. + +import Common1600 Block Capacity. + +op w8L2bits (l: W8.t list) : bool list = + flatten (map W8.w2bits l). +op w64L2bits (l: W64.t list) : bool list = + flatten (map W64.w2bits l). + +lemma w8L2bits_cat x1 x2: + w8L2bits (x1++x2) = w8L2bits x1 ++ w8L2bits x2. +admitted. + +lemma size_w8L2bits x: + size (w8L2bits x) = 8 * size x. +admitted. + +op w64L2bytes (l: W64.t list) : W8.t list = + flatten (map W8u8.to_list l). + +search flatten. + +(* 1600bit state *) +clone export PolyArray as Array25 with op size <- 25. +type state = W64.t Array25.t. + +op st0 : state = Array25.create W64.zero. + +(* +clone export PolyArray as Array200 with op size <- 200. +type state_u8 = W8.t Array200.t. +*) + + +(* +print W8u8. +*) + +op state2bits (st: state) : bool list = w64L2bits (to_list st). + +lemma size_state2bits (st: state): + size (state2bits st) = 1600. +admitted. + +op bits2state (bs: bool list) : state = + of_list W64.zero + (map W64.bits2w (BitEncoding.BitChunking.chunk 64 bs)). + +(* +op state2bytes (st: state) : W8.t list = w64L2bytes (to_list st). + +lemma size_state2bytes st: + size (state2bytes st) = 200. +admitted. + +op bytes2state (bs: W8.t list) : state = + of_list W64.zero + (map W64.bits2w (BitEncoding.BitChunking.chunk 64 bs)). +*) + + +(* ratio expressed in 8 and 64bit words *) +op ratio64 = ratio %/ 64. +op ratio8 = ratio64 * 8. + +lemma ratio64P: ratio64 * 64 = ratio. +proof. by move: ratio_w64; rewrite /ratio64 dvdz_eq. qed. + +lemma ratio8P: ratio8 * 8 = ratio. +proof. by rewrite /ratio8 mulzA /= ratio64P. qed. + +op capacity64 = 25-ratio64. +lemma capacity64P: capacity64 * 64 = c. +proof. by rewrite /capacity64 Ring.IntID.mulrBl /= ratio64P. qed. + + + +(* project state into block+capacity *) + +op state_r (st: state) : block = + mkblock (take r (state2bits st)). + (*mkblock (w64L2bits (mkseq (fun (i : int) => st.[i]) ratio64)).*) + +op state_c (st: state) : capacity = + mkcapacity (drop r (state2bits st)). +(*w64list_bits (mkseq (fun (i : int) => st.[i+ratio64]) capacity64).*) + +lemma state2bits0: state2bits st0 = nseq 1600 false. +proof. +admit. +qed. + +lemma st0_r: state_r st0 = b0. +proof. +rewrite /state_r state2bits0. +admit. +qed. + +lemma st0_c: state_c st0 = c0. +proof. +rewrite /state_c state2bits0. +admit. +qed. + + + + +(* Message and payload + obs: we consider byte-sized messages + *) +type mess_t = W8.t list. + +(* [mess_split] splits the message bytes in "intermediate blocks" + (with size multiple of [ratio8]) and a "last block" (remaining + bytes). *) +op mess_split (m: mess_t) : mess_t * mess_t = + (take (size m %/ ratio8) m, drop (size m %/ ratio8) m). + +lemma mess_splitP m: + m = (mess_split m).`1 ++ (mess_split m).`2. +proof. by rewrite -{1}(cat_take_drop (size m %/ ratio8)). qed. + +op lastblock_bits mbits lastbytes : bool list = + w8L2bits lastbytes ++ mbits + ++ mkpad (8*size lastbytes + size mbits). + +op mess2blocks mbits m = + bits2blocks (w8L2bits (mess_split m).`1 + ++ lastblock_bits mbits (mess_split m).`2). + +lemma mess2blocksP mbits mess: + size mbits < 5 => + mess2blocks mbits mess = pad2blocks (w8L2bits mess ++ mbits). +proof. +move => Hsz. +rewrite {2}mess_splitP. +rewrite /mess2blocks /pad2blocks /(\o) /=; congr. +rewrite /pad w8L2bits_cat -!catA; congr; congr; congr. +rewrite !size_cat !size_w8L2bits. +rewrite /mkpad; congr; congr; congr. +rewrite /num0. +admit. +qed. + + + +op or_head (h: W8.t) (l: W8.t list) = + match l with + | [] => [] + | x::xs => (W8.orw h x) :: xs + end. + +(* [mbits] include both the "domain-separation" bits as well as + additional suffix bits (e.g. "01" for SHA; "11" for RawSHAKE; + "1111" for SHAKE) + Remark: [size mbits] are expected to be at most 4. +*) +op trail_byte (mbits: bool list) : W8.t = + W8.bits2w (mbits++[true]). + +op num8_0s sz = (-(sz+1)) %% ratio8. + +op mkpad8 mbits size8 : W8.t list = + or_head (trail_byte mbits) + (rcons (nseq (num8_0s size8) W8.zero) (W8.of_int 128)). + +lemma mkpad8P mbits sz: + size mbits < 5 => + w8L2bits (mkpad8 mbits sz) + = mbits ++ mkpad (8*sz + size mbits). +proof. +move => Hsz. +rewrite /mkpad8 /trail_byte. +admit (* +w8list_bits + (or_head ((bits2w (mbits ++ [true])))%W8 + (rcons (nseq (num8_0s sz) W8.zero) ((of_int 128))%W8)) = +mbits ++ mkpad (8 * sz + size mbits) +*). +qed. + +op lastblock_bytes mbits lastbytes : W8.t list = + lastbytes ++ mkpad8 mbits (size lastbytes). + +lemma lastblock_bytesP mbits lastbytes: + size mbits < 5 => + w8L2bits (lastblock_bytes mbits lastbytes) + = lastblock_bits mbits lastbytes. +proof. +move=> Hsz. +rewrite /lastblock_bits /lastblock_bytes. +by rewrite !w8L2bits_cat mkpad8P // !catA. +qed. + + +(* ESTOU AQUI!!! *) + +op lastbytes +lemma last + + + + +module type PermT = { + proc perm(st : state) : state +}. + +print FUNCTIONALITY. + +module Spec(P : PermT) = { + proc f(out : int, outlen : int, inp : int, inlen : int) = { + var z,st,i,xs; + z <- []; + st <- state0; + i <- 0; + xs <- loadpad2wblocks Glob.mem inp inlen; + while (xs <> []){ + st <@ P.perm(combine st (head wblock0 xs)); + xs <- behead xs; + } + while (i < convb outlen){ + z <- z ++ [squeezeb st]; + i <- i + 1; + if (i < convb outlen) + st <@ P.perm(st); + } + + Glob.mem <- storeblocks Glob.mem out outlen z; + } +}. + + + + + + + + + + + + + + + + + +op mess2blocks mbits mess : block list = + bits2blocks (w8list_bits (mess ++ mkpad8 mbits (size mess))). + + +lemma mess2blocksP mbits mess: + size mbits < 5 => + mess2blocks mbits mess = pad2blocks (w8list_bits mess ++ mbits). +proof. +move => Hsz. +rewrite /mess2blocks /pad2blocks /(\o) /=; congr. +rewrite /pad w8list_bits_cat -catA; congr. +rewrite mkpad8P; congr; congr. +by rewrite size_cat size_w8list_bits. +qed. + + + +op domain_bits : bool list. + +(* domain bits are used to distinguish usages of the Sponge in standard *) +axiom domain_bits_len : size domain_bits = 2. + +op suffix_bits : bool list. + +(* additional suffix bits are allowed for construction usage *) +axiom suffix_bits_len : size suffix_bits < 3. + + +(* True for all state sizes we will consider *) +axiom wstate_size (x : state) : + size (flatten (map W64.w2bits (Array25.to_list x))) = (r + c). +axiom rsize : r %% 64 = 0. + +lemma wstate_size_val: r+c = 1600. +move : (wstate_size (Array25.of_list witness (mkseq (fun (i : int) => (of_list W64.zero []).[i]) 25))). +rewrite of_listK. apply size_mkseq. +rewrite /flatten. +rewrite (_: (mkseq (fun (i0 : int) => (of_list W64.zero []).[i0]) 25) = + (W64.zero :: W64.zero :: W64.zero :: W64.zero :: W64.zero :: + W64.zero :: W64.zero :: W64.zero :: W64.zero :: W64.zero :: + W64.zero :: W64.zero :: W64.zero :: W64.zero :: W64.zero :: + W64.zero :: W64.zero :: W64.zero :: W64.zero :: W64.zero :: + W64.zero :: W64.zero :: W64.zero :: W64.zero :: W64.zero :: [])). +by auto => />. +rewrite (_: + (foldr (++) [] + (map W64.w2bits + [W64.zero; W64.zero; W64.zero; W64.zero; W64.zero; W64.zero; + W64.zero; W64.zero; W64.zero; W64.zero; W64.zero; W64.zero; + W64.zero; W64.zero; W64.zero; W64.zero; W64.zero; W64.zero; + W64.zero; W64.zero; W64.zero; W64.zero; W64.zero; W64.zero; + W64.zero])) = + (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ + (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ + (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ + (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ + (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero)). +by auto => />. +simplify. smt(). +qed. + +op memr2bits( mem : global_mem_t, ptr : int, len : int) = + flatten (map (fun o => W8.w2bits (mem.[ptr + o])) (iota_ 0 len)). + +op eqmem_except(mem1 : global_mem_t, mem2 : global_mem_t, ptr : int, o : int) = + forall ad, !(ptr <= ad < ptr + o) => mem1.[ad] = mem2.[ad]. + +op state2bc(st : state) : block * capacity = + let stbits = flatten (map W64.w2bits (to_list st)) + in (mkblock (take r stbits), mkcapacity (drop r stbits)). + +module type PermT = { + proc perm(st : state) : state +}. + +type wblock = W64.t list. + +op pad1byte = domain_bits ++ suffix_bits ++ [true] ++ nseq (8 - (size domain_bits) - (size suffix_bits) - 2) false ++ [true]. +op padqstart = domain_bits ++ suffix_bits ++ [true] ++ nseq (8 - (size domain_bits) - (size suffix_bits) - 1) false. +op padq0 = nseq 8 false. +op padqend = nseq 7 false ++ [true]. +op padbytes(q : int) = + if q = 1 + then [ pad1byte ] + else [ padqstart ] ++ nseq (q-2) padq0 ++ [padqend ]. + +op bytewisepad(s) = + let q = (r %/ 8) - (((size s) %/ 8) %% (r %/ 8)) + in s ++ flatten (padbytes q). + +op loadpad2wblocks(mem : global_mem_t, ptr : int, len : int) = + let msgbits = bytewisepad (memr2bits mem ptr len) + in map (fun b => map W64.bits2w (BitEncoding.BitChunking.chunk 64 (ofblock b))) + (bits2blocks (msgbits)). + +lemma bound_conv (s : bool list) q : + size s %% 8 = 0 => + r %/ 8 - size s %/ 8 %% (r %/ 8) = q => + (size s + q*8) %% r = 0. +move=> *. +have rr : r - 8*(size s %/ 8 %% (r %/ 8)) = 8*q. ++ by rewrite {1}(andWl _ _ (edivzP r 8)) (:r %% 8 = 0) 1:[smt(rsize)] /#. +move : rr. +rewrite (mulz_modr 8) 1:/#. +rewrite (: 8 * (size s %/ 8) %% (8 * (r %/ 8)) = size s %% r). ++ by rewrite 2!(mulzC 8) 2!divzE H /= (: r %% 8 = 0) 1:[smt(rsize)]. +rewrite (: size s + q * 8 = q * 8 + size s) 1:/#. +rewrite -modzDmr. +move => *. +rewrite (_: size s %% r = r - 8 * q ) 1:/#. +by rewrite (: q * 8 + (r - 8 * q) = r) 1:/# modzz. +qed. + +lemma nseq_cat n1 n2 : + nseq n1 false ++ nseq n2 false = nseq (n1+n2) false. +admitted. + +lemma nseq_comp n1 n2 : + flatten (nseq n1 (nseq n2 false)) = nseq (n1 * n2) false. +admitted. + +lemma samepad s : + size s %% 8 = 0 => + bytewisepad s = pad (s ++ domain_bits ++ suffix_bits). +move => *. +rewrite /bytewisepad /padbytes /pad /mkpad /num0. +progress. +case (r %/ 8 - size s %/ 8 %% (r %/ 8) = 1). +move => *. +rewrite /pad1byte. +rewrite flatten_seq1. +rewrite -catA -catA -catA -catA -catA. +apply eqseq_cat. by trivial. simplify. +rewrite -catA. +apply eqseq_cat. by trivial. simplify. +apply eqseq_cat. by trivial. simplify. +move : (bound_conv s 1 H H0) => *. +rewrite (_: 8 - size domain_bits - size suffix_bits - 2 = (- (size (s ++ domain_bits ++ suffix_bits) + 2)) %% r). +rewrite !size_cat. +rewrite domain_bits_len. +case (size suffix_bits = 0). +move => suffix_bits_len. +rewrite suffix_bits_len. +simplify. +rewrite modNz. smt(size_ge0). exact/Block.gt0_n. +simplify. ring. +rewrite (_: size s + 3 = (size s + 1*8) - 5 ). smt(). +rewrite -modzDm. rewrite H1. simplify. +rewrite modz_mod modNz. smt(). exact/Block.gt0_n. +rewrite modz_small. smt(Block.gt0_n rsize). by ring. +move => *. +case (size suffix_bits = 1). +move => suffix_bits_len. +rewrite suffix_bits_len. +simplify. +rewrite modNz. smt(size_ge0). smt(Block.gt0_n). +simplify. ring. +rewrite (_: size s + 4 = (size s + 1*8) - 4 ). smt(). +rewrite -modzDm. rewrite H1. simplify. +rewrite modz_mod modNz. smt(). smt(Block.gt0_n). +rewrite modz_small. smt(Block.gt0_n rsize). by ring. +move => *. +rewrite (_: size suffix_bits = 2). smt(size_ge0 suffix_bits_len). +simplify. +rewrite modNz. smt(size_ge0). smt(Block.gt0_n). +simplify. ring. +rewrite (_: size s + 5 = (size s + 1*8) - 3 ). smt(). +rewrite -modzDm. rewrite H1. simplify. +rewrite modz_mod modNz. smt(). smt(Block.gt0_n). +rewrite modz_small. smt(Block.gt0_n rsize). by ring. +by rewrite cats1 catA. +move => *. +rewrite /padqstart /padqend. +pose q := r %/ 8 - size s %/ 8 %% (r %/ 8). +rewrite flatten_cons. +rewrite -catA -catA -catA -catA -catA. +rewrite (eqseq_cat). by trivial. simplify. +rewrite (eqseq_cat). by trivial. simplify. +rewrite (eqseq_cat). by trivial. simplify. +rewrite (_: flatten (nseq (q - 2) padq0 ++ + [[false; false; false; false; false; false; false; true]]) = + rcons (nseq (8*(q-2) + 7) false) true). +rewrite flatten_cat flatten_seq1. +rewrite -cats1. +have padlength_ge0: 0 <= 8 * (q - 2). ++ smt. +rewrite (_ : 8 * (q - 2) + 7 = 8 * (q - 2) + 6 + 1); first by smt(). +rewrite nseqSr. smt(). +rewrite cat_rcons. +rewrite (_ : 8 * (q - 2) + 6 = 8 * (q - 2) + 5 + 1); first by smt(). +rewrite nseqSr. smt(). +rewrite cat_rcons. +rewrite (_ : 8 * (q - 2) + 5 = 8 * (q - 2) + 4 + 1); first by smt(). +rewrite nseqSr. smt(). +rewrite cat_rcons. +rewrite (_ : 8 * (q - 2) + 4 = 8 * (q - 2) + 3 + 1); first by smt(). +rewrite nseqSr. smt(). +rewrite cat_rcons. +rewrite (_ : 8 * (q - 2) + 3 = 8 * (q - 2) + 2 + 1); first by smt(). +rewrite nseqSr. smt(). +rewrite cat_rcons. +rewrite (_ : 8 * (q - 2) + 2 = 8 * (q - 2) + 1 + 1); first by smt(). +rewrite nseqSr. smt(). +rewrite cat_rcons. +rewrite nseqSr. smt(). +rewrite cat_rcons. +rewrite /padq0. +rewrite nseq_comp. smt(). +rewrite (_ : nseq (8 - size domain_bits - size suffix_bits - 1) false ++ +rcons (nseq (8 * (q - 2) + 7) false) true = + rcons (nseq (8 - size domain_bits - size suffix_bits - 1 + 8 * (q - 2) + 7) false) true). rewrite -rcons_cat. +rewrite nseq_cat. +rewrite (_ : 8 - size domain_bits - size suffix_bits - 1 + (8 * (q - 2) + 7) = 8 - size domain_bits - size suffix_bits - 1 + 8 * (q - 2) + 7). by ring. +by trivial. +rewrite (_: 8 - size domain_bits - size suffix_bits - 1 + 8 * (q - 2) + 7= (- (size (s ++ domain_bits ++ suffix_bits) + 2)) %% r). +rewrite !size_cat. +rewrite domain_bits_len. +have qval : (r %/ 8 - size s %/ 8 %% (r %/ 8) = q). smt(). +move : (bound_conv s q H qval) => *. +have qlbound : 1 <= q. smt. +have qubound : q * 8 <= r. smt. +case (size suffix_bits = 0). +move => suffix_bits_len. +rewrite suffix_bits_len. +simplify. +ring. +rewrite modNz. smt. smt. +simplify. ring. +move : (dvdzP (r)(size s + q * 8)) => [ ] *. +move : (H2 H1). +progress. +rewrite (_: size s = q0*r - q*8). smt(). +rewrite (_ : (q0 * r - q * 8 + 3) %% r = (-(q*8 - 3)) %% r). +rewrite (_ : (q0 * r - q * 8 + 3) %% r = (q0 * r + (- q * 8 + 3)) %% r). +smt(). +rewrite (modzMDl). smt(). +have same : (- ( q * 8 - 3)) %% r = r - (q*8 - 3). +rewrite (modNz (q * 8 - 3) r). smt. smt. +ring. +rewrite modz_small. smt(). smt. +smt. +move => *. +case (size suffix_bits = 1). +move => suffix_bits_len. +rewrite suffix_bits_len. +simplify. +ring. +rewrite modNz. smt. smt. +simplify. ring. +move : (dvdzP (r)(size s + q * 8)) => [ ] *. +move : (H3 H1). +progress. +rewrite (_: size s = q0*r - q*8). smt(). +rewrite (_ : (q0 * r - q * 8 + 4) %% r = (-(q*8 - 4)) %% r). +rewrite (_ : (q0 * r - q * 8 + 4) %% r = (q0 * r + (- q * 8 + 4)) %% r). +smt(). +rewrite (modzMDl). smt(). +have same : (- ( q * 8 - 4)) %% r = r - (q*8 - 4). +rewrite (modNz (q * 8 - 4) r). smt. smt. +ring. +rewrite modz_small. smt(). smt. +smt. +move => *. +rewrite (_ : size suffix_bits = 2). smt. +simplify. +ring. +rewrite modNz. smt. smt. +simplify. ring. +move : (dvdzP (r)(size s + q * 8)) => [ ] *. +move : (H4 H1). +progress. +rewrite (_: size s = q0*r - q*8). smt(). +rewrite (_ : (q0 * r - q * 8 + 5) %% r = (-(q*8 - 5)) %% r). +rewrite (_ : (q0 * r - q * 8 + 5) %% r = (q0 * r + (- q * 8 + 5)) %% r). +smt(). +rewrite (modzMDl). smt(). +have same : (- ( q * 8 - 5)) %% r = r - (q*8 - 5). +rewrite (modNz (q * 8 - 5) r). smt. smt. +ring. +rewrite modz_small. smt(). smt. +smt. +by trivial. +qed. + +lemma sizepload mem inp inl: (size (memr2bits mem inp inl) = 8 * (max 0 inl)). +rewrite /memr2bits. +simplify. +rewrite size_flatten. +auto => />. +rewrite /sumz. +rewrite -map_comp /(\o) => //=. +rewrite foldr_map. +rewrite (_ : 8*(max 0 inl) = 8* (size (iota_ 0 inl))). rewrite size_iota. by trivial. +elim (iota_ 0 inl). smt. smt. +qed. + +lemma blocksizes mem inp inl b: + b \in (loadpad2wblocks mem inp inl) => size b = r %/ 64. +rewrite /loadpad2wblocks samepad. smt. +simplify. +rewrite /bits2blocks. +have sizebs : forall b0, + b0 \in (map mkblock + (chunk (pad (memr2bits mem inp inl ++ domain_bits ++ suffix_bits)))) => + size (ofblock b0) = r. +move => b0 H. +apply (size_block b0). +have sizecs : forall b0, + b0 \in (map mkblock + (chunk (pad (memr2bits mem inp inl ++ domain_bits ++ suffix_bits)))) => + size ((BitEncoding.BitChunking.chunk 64 (ofblock b0))) = r %/ 64. +smt. +move => H. +move : (mapP + (fun (b0 : block) => + map W64.bits2w (BitEncoding.BitChunking.chunk 64 (ofblock b0))) + ((map mkblock + (chunk + (pad (memr2bits mem inp inl ++ domain_bits ++ suffix_bits))))) b). +smt. +qed. + +(* Stores up to len bytes in memory from list of blocks *) +op storeblocks : global_mem_t -> int -> int -> wblock list -> global_mem_t. + +op state0 : state = Array25.of_list (W64.of_int 0) []. + +op squeezeb(st : state) = take (r %/ 64) (to_list st). + +op wblock0 : wblock = take (r %/ 64) (to_list state0). + +op combine(st : state, wb : wblock) : state = + let stl = to_list st in + let wbst = take (r %/ 64) stl in + let wbstc = map (fun x : W64.t * W64.t => x.`1 `^` x.`2) (zip wbst wb) in + Array25.of_list (W64.of_int 0) (wbstc ++ (drop (r %/ 64) stl)). + +op convb(outl : int) = (outl*8 + r - 1) %/ r. + +module Spec(P : PermT) = { + proc f(out : int, outlen : int, inp : int, inlen : int) = { + var z,st,i,xs; + z <- []; + st <- state0; + i <- 0; + xs <- loadpad2wblocks Glob.mem inp inlen; + while (xs <> []){ + st <@ P.perm(combine st (head wblock0 xs)); + xs <- behead xs; + } + while (i < convb outlen){ + z <- z ++ [squeezeb st]; + i <- i + 1; + if (i < convb outlen) + st <@ P.perm(st); + } + + Glob.mem <- storeblocks Glob.mem out outlen z; + } +}. + +section. + +declare module Pideal : DPRIMITIVE. +declare module Preal : PermT {Glob}. (* Note it cannot touch memory *) + +axiom perm_correct : + equiv [Pideal.f ~ Preal.perm : + x{1} = state2bc st{2} ==> + res{1} = state2bc res{2}]. + +op wblock2block(wb : wblock) : block = + mkblock (flatten (map W64.w2bits wb)). + +op wblocks2bits(wbs : wblock list) : bool list = + flatten (List.map (fun bl => ofblock (wblock2block bl)) wbs). + +op wblock2bits_list(wbs : wblock list) : block list = + map wblock2block wbs. + +lemma wblocks2bits_empty : [] = wblocks2bits [] by auto => />. + +lemma state0conv : (b0, c0) = state2bc state0. +rewrite /state2bc /b0 /c0 /offun. +rewrite (_: flatten (map W64.w2bits (to_list state0)) = (mkseq (fun _ => false) (r+c))). +rewrite /state0 /to_list wstate_size_val. +apply (eq_from_nth witness). +rewrite size_mkseq. +move : (wstate_size (Array25.of_list witness (mkseq (fun (i : int) => (of_list W64.zero []).[i]) 25))). +rewrite of_listK. apply size_mkseq. +move => *. rewrite H. +rewrite wstate_size_val. smt(). +rewrite (_ : size + (flatten + (map W64.w2bits + (mkseq (fun (i0 : int) => (of_list W64.zero []).[i0]) 25))) = 1600). +move : (wstate_size (Array25.of_list witness (mkseq (fun (i : int) => (of_list W64.zero []).[i]) 25))). +rewrite of_listK. apply size_mkseq. +rewrite wstate_size_val. smt(). +move => *. +rewrite (_: nth witness (mkseq (fun _ => false) (1600)) i = false). +rewrite nth_mkseq. smt(). smt(). +rewrite (_: (mkseq (fun (i0 : int) => (of_list W64.zero []).[i0]) 25) = + (W64.zero :: W64.zero :: W64.zero :: W64.zero :: W64.zero :: + W64.zero :: W64.zero :: W64.zero :: W64.zero :: W64.zero :: + W64.zero :: W64.zero :: W64.zero :: W64.zero :: W64.zero :: + W64.zero :: W64.zero :: W64.zero :: W64.zero :: W64.zero :: + W64.zero :: W64.zero :: W64.zero :: W64.zero :: W64.zero :: [])). +by auto => />. +rewrite (_: + (foldr (fun (bl : W64.t) (bs : bool list) => w2bits bl ++ bs) [] + [W64.zero; W64.zero; W64.zero; W64.zero; W64.zero; W64.zero; W64.zero; + W64.zero; W64.zero; W64.zero; W64.zero; W64.zero; W64.zero; W64.zero; + W64.zero; W64.zero; W64.zero; W64.zero; W64.zero; W64.zero; W64.zero; + W64.zero; W64.zero; W64.zero; W64.zero]) = + (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ + (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ + (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ + (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ + (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero)). +by auto => />. +rewrite /w2bits. +rewrite -mkseq_add. smt(). smt(). +rewrite -mkseq_add. smt(). smt(). +rewrite -mkseq_add. smt(). smt(). +rewrite -mkseq_add. smt(). smt(). +rewrite -mkseq_add. smt(). smt(). +rewrite -mkseq_add. smt(). smt(). +rewrite -mkseq_add. smt(). smt(). +rewrite -mkseq_add. smt(). smt(). +rewrite -mkseq_add. smt(). smt(). +rewrite -mkseq_add. smt(). smt(). +rewrite -mkseq_add. smt(). smt(). +rewrite -mkseq_add. smt(). smt(). +rewrite -mkseq_add. smt(). smt(). +rewrite -mkseq_add. smt(). smt(). +rewrite -mkseq_add. smt(). smt(). +rewrite -mkseq_add. smt(). smt(). +rewrite -mkseq_add. smt(). smt(). +rewrite -mkseq_add. smt(). smt(). +rewrite -mkseq_add. smt(). smt(). +rewrite -mkseq_add. smt(). smt(). +rewrite -mkseq_add. smt(). smt(). +rewrite -mkseq_add. smt(). smt(). +rewrite -mkseq_add. smt(). smt(). +rewrite -mkseq_add. smt(). smt(). +simplify. +rewrite nth_mkseq. +smt(). smt(). +rewrite mkseq_add. smt. smt. +pose stbits := mkseq (fun _ => false) r ++ + mkseq (fun (i : int) => (fun _ => false) (r + i)) c. +simplify. +split. +rewrite (_:take r stbits = mkseq (fun _ => false) r). +rewrite take_cat. +rewrite size_mkseq. +rewrite (_ : r < max 0 r = false); first by smt. +simplify. +rewrite (_ : r - max 0 r = 0); first by smt. +rewrite take0 cats0. +by trivial. +by trivial. +rewrite drop_cat. +rewrite size_mkseq. +rewrite (_ : r < max 0 r = false); first by smt. +simplify. +rewrite (_ : r - max 0 r = 0); first by smt. +rewrite drop0. +by trivial. +qed. + +lemma paddings_same mem inp inl: + pad (memr2bits mem inp inl ++ domain_bits ++ suffix_bits) = + wblocks2bits (loadpad2wblocks mem inp inl). +rewrite /loadpad2wblocks samepad. smt. +rewrite /wblocks2bits. +pose ll := pad (memr2bits mem inp inl ++ domain_bits ++ suffix_bits). +simplify. +rewrite /wblock2block -map_comp -map_comp /(\o) => //=. +have sizell : size ll %% 64 = 0. smt. +have sizebs : forall x, x \in chunk ll => size x = r. smt. +have sizebs1 : forall x, x \in chunk ll => forall y, y \in (BitEncoding.BitChunking.chunk 64 x) => size y = 64. smt. +have xx : (forall x, x \in chunk ll => (flatten + (map W64.w2bits + (map W64.bits2w + ((BitEncoding.BitChunking.chunk 64 (ofblock (mkblock x))))))) = x). +move => *. rewrite ofblockK. smt. +rewrite -map_comp. +rewrite (_: map (W64.w2bits \o W64.bits2w) (BitEncoding.BitChunking.chunk 64 x) = BitEncoding.BitChunking.chunk 64 x). rewrite /(\o). +have xxx : forall x0, x0 \in ((BitEncoding.BitChunking.chunk 64 x)) => w2bits ((bits2w x0))%W64 = x0. +move : (sizebs1 x H) => *. +move => *. +move : (sizebs1 x H x0 H1). move => *. +apply (W64.bits2wK) => //=. +rewrite {2} (_ : (BitEncoding.BitChunking.chunk 64 x) = map (fun x => x) (BitEncoding.BitChunking.chunk 64 x)). rewrite (id_map). smt(). by trivial. +move : (eq_in_map ((fun (x0 : bool list) => w2bits ((bits2w x0))%W64)) (fun x => x) (BitEncoding.BitChunking.chunk 64 x)) => [/ # [ ]] *. +move : (H0 xxx). smt(). +apply (BitEncoding.BitChunking.chunkK 64 _ _ _). smt(). smt. +have : (forall (x : bool list), + x \in chunk ll => + (fun (x0 : bool list) => + ofblock + (mkblock + (flatten + (map W64.w2bits + (map W64.bits2w + ((BitEncoding.BitChunking.chunk 64 (ofblock (mkblock x0))))))))) x = x). +progress. +move : (xx x H) => *. +rewrite H0. apply ofblockK. smt. +move => *. +rewrite (_ : (map + (fun (x : bool list) => + ofblock + (mkblock + (flatten + (map W64.w2bits + (map W64.bits2w + ((BitEncoding.BitChunking.chunk 64 (ofblock (mkblock x))))))))) + (chunk ll)) = chunk ll). +rewrite {2} (_: chunk ll = map (fun x => x) (chunk ll)). rewrite (id_map). smt(). by trivial. +move : (eq_in_map ((fun (x0 : bool list) => + ofblock + (mkblock + (flatten + (map W64.w2bits + (map W64.bits2w + ((BitEncoding.BitChunking.chunk 64 (ofblock (mkblock x0)))))))))) + (fun x0 => x0) (chunk ll)) => [/ # [ ]] *. +move : (H0 H). smt(). +rewrite chunkK. smt. +by trivial. +qed. + +lemma liftpadding mem inp inl : + pad2blocks (memr2bits mem inp inl ++ domain_bits ++ suffix_bits) = + wblock2bits_list (loadpad2wblocks mem inp inl). +rewrite /pad2blocks /(\o) paddings_same /wblocks2bits => //=. +rewrite /bits2blocks. +rewrite flattenK. +move => b. +rewrite /loadpad2wblocks samepad. smt. +simplify. +pose ll := pad (memr2bits mem inp inl ++ domain_bits ++ suffix_bits). +rewrite /wblock2block -map_comp -map_comp /(\o) => //=. +have sizell : size ll %% 64 = 0. smt. +have sizebs : forall x, x \in chunk ll => size x = r. smt. + +have sizebs1 : forall x, x \in chunk ll => forall y, y \in (BitEncoding.BitChunking.chunk 64 x) => size y = 64. smt. +have xx : (forall x, x \in chunk ll => (flatten + (map W64.w2bits + (map W64.bits2w + ((BitEncoding.BitChunking.chunk 64 (ofblock (mkblock x))))))) = x). +move => *. rewrite ofblockK. smt. +rewrite -map_comp. +rewrite (_: map (W64.w2bits \o W64.bits2w) (BitEncoding.BitChunking.chunk 64 x) = BitEncoding.BitChunking.chunk 64 x). rewrite /(\o). +have xxx : forall x0, x0 \in ((BitEncoding.BitChunking.chunk 64 x)) => w2bits ((bits2w x0))%W64 = x0. +move : (sizebs1 x H) => *. +move => *. +move : (sizebs1 x H x0 H1). move => *. +apply (W64.bits2wK) => //=. +rewrite {2} (_ : (BitEncoding.BitChunking.chunk 64 x) = map (fun x => x) (BitEncoding.BitChunking.chunk 64 x)). rewrite (id_map). smt(). by trivial. +move : (eq_in_map ((fun (x0 : bool list) => w2bits ((bits2w x0))%W64)) (fun x => x) (BitEncoding.BitChunking.chunk 64 x)) => [/ # [ ]] *. +move : (H0 xxx). smt(). +apply (BitEncoding.BitChunking.chunkK 64 _ _ _). smt(). smt. +have : (forall (x : bool list), + x \in chunk ll => + (fun (x0 : bool list) => + ofblock + (mkblock + (flatten + (map W64.w2bits + (map W64.bits2w + ((BitEncoding.BitChunking.chunk 64 (ofblock (mkblock x0))))))))) x = x). +progress. +move : (xx x H) => *. +rewrite H0. apply ofblockK. smt. +move => H. +rewrite (_ : (map + (fun (x : bool list) => + ofblock + (mkblock + (flatten + (map W64.w2bits + (map W64.bits2w + ((BitEncoding.BitChunking.chunk 64 (ofblock (mkblock x))))))))) + (chunk ll)) = chunk ll). +rewrite {2} (_: chunk ll = map (fun x => x) (chunk ll)). rewrite (id_map). smt(). by trivial. +move : (eq_in_map ((fun (x0 : bool list) => + ofblock + (mkblock + (flatten + (map W64.w2bits + (map W64.bits2w + ((BitEncoding.BitChunking.chunk 64 (ofblock (mkblock x0)))))))))) + (fun x0 => x0) (chunk ll)) => [/ # [ ]] *. +move : (H0 H). smt(). smt. +rewrite -map_comp /(\o) /wblock2bits_list /wblock2block. +apply eq_map. progress. rewrite mkblockK. by trivial. +qed. + +lemma lift_combine sa sc st xs : + (sa, sc) = state2bc st => + (sa +^ head b0 (wblock2bits_list xs), sc) = + state2bc (combine st (head wblock0 xs)) + by admit. (* provable *) + +lemma behead_wblockl xs : + behead (wblock2bits_list xs) = wblock2bits_list (behead xs). +rewrite /wblock2bits_list . +elim xs;smt(). +qed. + +lemma behead_wblocke xs : + behead (wblock2bits_list xs) = [] <=> behead xs = []. +rewrite /wblock2bits_list . +elim xs;smt(). +qed. + +lemma wbblockle xs : + wblock2bits_list xs = [] => xs = []. +rewrite /wblock2bits_list . +elim xs;smt(). +qed. + +lemma wbblockle_ : [] = wblock2bits_list []. +rewrite /wblock2bits_list . +smt(). +qed. + +lemma commuteappend z sa st sc : + (sa, sc) = state2bc st => + wblocks2bits z ++ ofblock sa = wblocks2bits (z ++ [squeezeb st]). +rewrite /state2bc => //=. move => [/ # ] *. +rewrite /wblocks2bits /wblock2block. +rewrite H. rewrite ofblockK. smt. +rewrite /squeezeb. + admit. (* provable *) +qed. + +op validins(n : int, outl : int) = + n = outl * 8. + +lemma sizes1 i n1 n2 : validins n1 n2 => + i < (n1 + r - 1) %/ r => + i < convb n2 by smt. + +lemma sizes2 i n1 n2 : validins n1 n2 => + i < convb n2 => + i < (n1 + r - 1) %/ r by smt. + +(* Will need to be proved once storeblocks is defined. *) +lemma store_blocks_safe mem out outlen z : + eqmem_except mem (storeblocks mem out outlen z) out outlen by admit. + +(* Will need to be proved once storeblocks is defined *) +lemma storeblocks_correct mem out outlen n z : + validins n outlen => + take n (wblocks2bits z) = + memr2bits (storeblocks mem out outlen z) out outlen by admit. + +lemma spec_correct mem outp outl: +equiv [ Sponge(Pideal).f ~ Spec(Preal).f : + Glob.mem{2} = mem /\ + bs{1} = memr2bits mem inp{2} inlen{2} ++ domain_bits ++ suffix_bits /\ + outlen{2} = outl /\ validins n{1} outlen{2} /\ out{2} = outp + ==> eqmem_except mem Glob.mem{2} outp outl /\ + res{1} = memr2bits Glob.mem{2} outp outl]. +proc. +seq 4 4 : ( +#pre /\ +z{1} = wblocks2bits z{2} /\ +(sa{1},sc{1}) = state2bc st{2} /\ +={i} /\ xs{1} = wblock2bits_list xs{2} +); first by wp;skip;smt(wblocks2bits_empty state0conv liftpadding). +seq 1 1 : #pre. +while #pre. +by wp;call (perm_correct); wp;skip; smt(lift_combine behead_wblockl behead_wblocke). +by skip; smt(behead_wblockl behead_wblocke). +seq 1 1 : #pre. +while #pre. +seq 2 2 : #[/:-2]pre; first by wp;skip; smt(commuteappend). +if => //=. +progress. +apply(sizes1 i{2} n{1} outlen{2} H) => //=. +apply(sizes2 i{2} n{1} outlen{2} H) => //=. +call perm_correct;skip;progress => //=. +apply(sizes1 i{2} n{1} outlen{2} H) => //=. +skip;progress => //=. +apply(sizes2 i{2} n{1} outlen{2} H) => //=. +skip;progress => //=. +apply(sizes1 i{2} n{1} outlen{2} H) => //=. +apply(sizes2 i{2} n{1} outlen{2} H) => //=. +wp;skip;progress;smt(store_blocks_safe storeblocks_correct). +qed. + +end section. \ No newline at end of file diff --git a/proof/impl/Sponge1600.ec b/proof/impl/Sponge1600.ec new file mode 100644 index 0000000..a64f405 --- /dev/null +++ b/proof/impl/Sponge1600.ec @@ -0,0 +1,68 @@ +(*------------------------- Sponge Construction ------------------------*) + +(* Specialization of the Sponge Construction for a 1600bit state *) + + +require import Core Int IntDiv Real List FSet SmtMap. +(*---*) import IntExtra. +require import Distr DBool DList. +require import StdBigop StdOrder. import IntOrder. + + +op ratio :int. +axiom ratio_bnds: 0 < ratio < 1600. +axiom ratio_w64: 64 %| ratio. + +lemma ratio_ge2: 2 <= ratio. +proof. +case: (ratio = 1) => E. + by rewrite E; smt(ratio_w64). +by smt (ratio_bnds). +qed. + +require Common. +clone export Common as Common1600 + with op r = ratio, + op c = 1600-r + proof ge2_r by apply ratio_ge2 + proof gt0_c by smt (ratio_bnds). + +require Indifferentiability. +clone include Indifferentiability with + type p <- block * capacity, + type f_in <- bool list * int, + type f_out <- bool list + + rename + [module] "Indif" as "Experiment" + [module] "GReal" as "RealIndif" + [module] "GIdeal" as "IdealIndif". + +(*------------------------- Sponge Construction ------------------------*) +module (Sponge : CONSTRUCTION) (P : DPRIMITIVE) : FUNCTIONALITY = { + proc init() : unit = {} + + proc f(bs : bool list, n : int) : bool list = { + var z <- []; + var (sa, sc) <- (b0, Capacity.c0); + var i <- 0; + var xs <- pad2blocks bs; + + (* absorption *) + while (xs <> []) { + (sa, sc) <@ P.f(sa +^ head b0 xs, sc); + xs <- behead xs; + } + (* squeezing *) + while (i < (n + r - 1) %/ r) { + z <- z ++ ofblock sa; + i <- i + 1; + if (i < (n + r - 1) %/ r) { + (sa, sc) <@ P.f(sa, sc); + } + } + + return take n z; + } +}. + From 48a735be6fd7d9112de0f9284f106621406053c4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Wed, 24 Apr 2019 11:53:57 +0100 Subject: [PATCH 361/525] Fix admitted lemmas and try to stabilize the proof in Spec --- proof/impl/Spec.ec | 44 ++++++++++++++++++++++---------------------- 1 file changed, 22 insertions(+), 22 deletions(-) diff --git a/proof/impl/Spec.ec b/proof/impl/Spec.ec index ac7b50b..de9db79 100644 --- a/proof/impl/Spec.ec +++ b/proof/impl/Spec.ec @@ -107,11 +107,11 @@ by rewrite (: q * 8 + (r - 8 * q) = r) 1:/# modzz. qed. lemma nseq_cat n1 n2 : - nseq n1 false ++ nseq n2 false = nseq (n1+n2) false. + nseq n1 false ++ nseq n2 false = nseq (max 0 n1 + max 0 n2) false. admitted. lemma nseq_comp n1 n2 : - flatten (nseq n1 (nseq n2 false)) = nseq (n1 * n2) false. + flatten (nseq n1 (nseq n2 false)) = nseq (max 0 n1 * max 0 n2) false. admitted. lemma samepad s : @@ -178,7 +178,7 @@ rewrite (_: flatten (nseq (q - 2) padq0 ++ rewrite flatten_cat flatten_seq1. rewrite -cats1. have padlength_ge0: 0 <= 8 * (q - 2). -+ smt. ++ smt(gt0_r rsize). rewrite (_ : 8 * (q - 2) + 7 = 8 * (q - 2) + 6 + 1); first by smt(). rewrite nseqSr. smt(). rewrite cat_rcons. @@ -203,8 +203,8 @@ rewrite /padq0. rewrite nseq_comp. smt(). rewrite (_ : nseq (8 - size domain_bits - size suffix_bits - 1) false ++ rcons (nseq (8 * (q - 2) + 7) false) true = - rcons (nseq (8 - size domain_bits - size suffix_bits - 1 + 8 * (q - 2) + 7) false) true). rewrite -rcons_cat. -rewrite nseq_cat. + rcons (nseq (8 - size domain_bits - size suffix_bits - 1 + 8 * (q - 2) + 7) false) true). rewrite -rcons_cat. +rewrite nseq_cat max_ler 1:[smt(domain_bits_len suffix_bits_len)] max_ler 1:[smt(gt0_r rsize)]. rewrite (_ : 8 - size domain_bits - size suffix_bits - 1 + (8 * (q - 2) + 7) = 8 - size domain_bits - size suffix_bits - 1 + 8 * (q - 2) + 7). by ring. by trivial. rewrite (_: 8 - size domain_bits - size suffix_bits - 1 + 8 * (q - 2) + 7= (- (size (s ++ domain_bits ++ suffix_bits) + 2)) %% r). @@ -212,14 +212,14 @@ rewrite !size_cat. rewrite domain_bits_len. have qval : (r %/ 8 - size s %/ 8 %% (r %/ 8) = q). smt(). move : (bound_conv s q H qval) => *. -have qlbound : 1 <= q. smt. -have qubound : q * 8 <= r. smt. +have qlbound : 1 <= q. smt(gt0_r rsize). +have qubound : q * 8 <= r. smt(gt0_r rsize). case (size suffix_bits = 0). move => suffix_bits_len. rewrite suffix_bits_len. simplify. ring. -rewrite modNz. smt. smt. +rewrite modNz. smt(size_ge0). smt(gt0_r). simplify. ring. move : (dvdzP (r)(size s + q * 8)) => [ ] *. move : (H2 H1). @@ -229,18 +229,18 @@ rewrite (_ : (q0 * r - q * 8 + 3) %% r = (-(q*8 - 3)) %% r). rewrite (_ : (q0 * r - q * 8 + 3) %% r = (q0 * r + (- q * 8 + 3)) %% r). smt(). rewrite (modzMDl). smt(). -have same : (- ( q * 8 - 3)) %% r = r - (q*8 - 3). -rewrite (modNz (q * 8 - 3) r). smt. smt. +have same : (- ( q * 8 - 3)) %% r = r - (q*8 - 3). +rewrite (modNz (q * 8 - 3) r). smt(gt0_r rsize). smt(gt0_r). ring. -rewrite modz_small. smt(). smt. -smt. +rewrite modz_small. smt(). smt(gt0_r rsize). +smt(gt0_r rsize). move => *. case (size suffix_bits = 1). move => suffix_bits_len. rewrite suffix_bits_len. simplify. ring. -rewrite modNz. smt. smt. +rewrite modNz. smt(size_ge0). smt(gt0_r). simplify. ring. move : (dvdzP (r)(size s + q * 8)) => [ ] *. move : (H3 H1). @@ -251,15 +251,15 @@ rewrite (_ : (q0 * r - q * 8 + 4) %% r = (q0 * r + (- q * 8 + 4)) %% r). smt(). rewrite (modzMDl). smt(). have same : (- ( q * 8 - 4)) %% r = r - (q*8 - 4). -rewrite (modNz (q * 8 - 4) r). smt. smt. +rewrite (modNz (q * 8 - 4) r). smt(gt0_r rsize). smt(gt0_r). ring. -rewrite modz_small. smt(). smt. -smt. +rewrite modz_small. smt(). smt(gt0_r rsize). +smt(gt0_r rsize). move => *. -rewrite (_ : size suffix_bits = 2). smt. +rewrite (_ : size suffix_bits = 2). smt(size_ge0 suffix_bits_len). simplify. ring. -rewrite modNz. smt. smt. +rewrite modNz. smt(size_ge0). smt(gt0_r). simplify. ring. move : (dvdzP (r)(size s + q * 8)) => [ ] *. move : (H4 H1). @@ -270,10 +270,10 @@ rewrite (_ : (q0 * r - q * 8 + 5) %% r = (q0 * r + (- q * 8 + 5)) %% r). smt(). rewrite (modzMDl). smt(). have same : (- ( q * 8 - 5)) %% r = r - (q*8 - 5). -rewrite (modNz (q * 8 - 5) r). smt. smt. +rewrite (modNz (q * 8 - 5) r). smt(gt0_r rsize). smt(gt0_r). ring. -rewrite modz_small. smt(). smt. -smt. +rewrite modz_small. smt(). smt(gt0_r rsize). +smt(gt0_r rsize). by trivial. qed. @@ -690,4 +690,4 @@ apply(sizes2 i{2} n{1} outlen{2} H) => //=. wp;skip;progress;smt(store_blocks_safe storeblocks_correct). qed. -end section. \ No newline at end of file +end section. From 954c76ebcdea64eb448b5bb80b637a2899e6c105 Mon Sep 17 00:00:00 2001 From: Manuel Barbosa Date: Thu, 25 Apr 2019 15:27:57 +0100 Subject: [PATCH 362/525] Proof of permutation correctness: avx2 versus ref implementation --- proof/impl/perm/Ops.ec | 639 ++++++++++ proof/impl/perm/keccak_f1600_avx2.ec | 359 ++++++ proof/impl/perm/keccak_f1600_avx2_prevec.ec | 1168 +++++++++++++++++++ proof/impl/perm/keccak_f1600_ref.ec | 281 +++++ 4 files changed, 2447 insertions(+) create mode 100644 proof/impl/perm/Ops.ec create mode 100644 proof/impl/perm/keccak_f1600_avx2.ec create mode 100644 proof/impl/perm/keccak_f1600_avx2_prevec.ec create mode 100644 proof/impl/perm/keccak_f1600_ref.ec diff --git a/proof/impl/perm/Ops.ec b/proof/impl/perm/Ops.ec new file mode 100644 index 0000000..a5f2837 --- /dev/null +++ b/proof/impl/perm/Ops.ec @@ -0,0 +1,639 @@ +require import List Int IntDiv CoreMap. + +from Jasmin require import JModel. + +clone export PolyArray as Array2 with op size <- 2. +clone export PolyArray as Array4 with op size <- 4. +clone export PolyArray as Array5 with op size <- 5. +clone export WArray as WArray128 with op size <- 128. +clone export WArray as WArray160 with op size <- 160. + +type t2u64 = W64.t Array2.t. +type t4u64 = W64.t Array4.t. + +print W64. +module Ops = { + proc itruncate_4u64_2u64(t : t4u64) : t2u64 = { + return Array2.of_list witness [ t.[0]; t.[1] ]; + } + proc set_160(vv : t4u64 Array5.t, i : int, o : int, v : W64.t) : t4u64 Array5.t = { + return vv.[i <- vv.[i].[o <- v]]; + } + proc get_160(vv : t4u64 Array5.t, i : int, o : int) : W64.t = { + return vv.[i].[o]; + } + proc get_128(vv : t4u64 Array4.t, i : int, o : int) : W64.t = { + return vv.[i].[o]; + } + + proc iVPBROADCAST_4u64(v : W64.t) : t4u64 = { + var r : t4u64; + r.[0] <-v; + r.[1] <-v; + r.[2] <-v; + r.[3] <-v; + return r; + } + + proc iVPMULU_256 (x y:t4u64) : t4u64 = { + var r : t4u64; + r.[0] <- x.[0] * y.[0]; + r.[1] <- x.[1] * y.[1]; + r.[2] <- x.[2] * y.[2]; + r.[3] <- x.[3] * y.[3]; + return r; + } + + proc ivadd64u256(x y:t4u64) : t4u64 = { + var r : t4u64; + r.[0] <- x.[0] + y.[0]; + r.[1] <- x.[1] + y.[1]; + r.[2] <- x.[2] + y.[2]; + r.[3] <- x.[3] + y.[3]; + return r; + } + + proc iload4u64 (mem:global_mem_t, p:W64.t) : t4u64 = { + var r : t4u64; + r.[0] <- loadW64 mem (to_uint p); + r.[1] <- loadW64 mem (to_uint (p + W64.of_int 8)); + r.[2] <- loadW64 mem (to_uint (p + W64.of_int 16)); + r.[3] <- loadW64 mem (to_uint (p + W64.of_int 24)); + return r; + } + + proc iVPERM2I128(x y:t4u64, p : W8.t) : t4u64 = { + var r : t4u64; + r <- witness; + if (to_uint p = 32) { (* 0x20 *) + r.[0] <- x.[0]; + r.[1] <- x.[1]; + r.[2] <- y.[0]; + r.[3] <- y.[1]; + } + else { + if (to_uint p = 49) { (* 0x31 *) + r.[0] <- x.[2]; + r.[1] <- x.[3]; + r.[2] <- y.[2]; + r.[3] <- y.[3]; + } + } + return r; + } + + proc iVPERMQ(x :t4u64, p : W8.t) : t4u64 = { + var r : t4u64; + r <- witness; + if (to_uint p = 128) { (* 10 00 00 00 *) + r.[0] <- x.[0]; + r.[1] <- x.[0]; + r.[2] <- x.[0]; + r.[3] <- x.[2]; + } else { + if (to_uint p = 147) { (* 10 01 00 11 *) + r.[0] <- x.[3]; + r.[1] <- x.[0]; + r.[2] <- x.[1]; + r.[3] <- x.[2]; + } else { + if (to_uint p = 78) { (* 01 00 11 10 *) + r.[0] <- x.[2]; + r.[1] <- x.[3]; + r.[2] <- x.[0]; + r.[3] <- x.[1]; + } else { + if (to_uint p = 57) { (* 00 11 10 01 *) + r.[0] <- x.[1]; + r.[1] <- x.[2]; + r.[2] <- x.[3]; + r.[3] <- x.[0]; + } else { + if (to_uint p = 141) { (* 10 00 11 01 *) + r.[0] <- x.[1]; + r.[1] <- x.[3]; + r.[2] <- x.[0]; + r.[3] <- x.[2]; + } else { + if (to_uint p = 27) { (* 00 01 10 11 *) + r.[0] <- x.[3]; + r.[1] <- x.[2]; + r.[2] <- x.[1]; + r.[3] <- x.[0]; + } else { + if (to_uint p = 114) { (* 01 11 00 10 *) + r.[0] <- x.[2]; + r.[1] <- x.[0]; + r.[2] <- x.[3]; + r.[3] <- x.[1]; + } else { + if (to_uint p = 0) { (* 00 00 00 00 *) + r.[0] <- x.[0]; + r.[1] <- x.[0]; + r.[2] <- x.[0]; + r.[3] <- x.[0]; + } else { + if (to_uint p = 30) { (* 00 01 11 10 *) + r.[0] <- x.[2]; + r.[1] <- x.[3]; + r.[2] <- x.[1]; + r.[3] <- x.[0]; + } + } + } + } + } + } + } + } + } + return r; + } + + proc iVPSRLDQ_256(x:t4u64, p : W8.t) : t4u64 = { + var r : t4u64; + r <- witness; + if (to_uint p = 6) { + r.[0] <- (x.[0] `>>` W8.of_int 48) `|` (x.[1] `<<` W8.of_int 16); + r.[1] <- x.[1] `>>` W8.of_int 48; + r.[2] <- (x.[2] `>>` W8.of_int 48) `|` (x.[3] `<<` W8.of_int 16); + r.[3] <- x.[3] `>>` W8.of_int 48; + } + else { + if (to_uint p = 8) { + r.[0] <- x.[1]; + r.[1] <- W64.zero; + r.[2] <- x.[3]; + r.[3] <- W64.zero; + } + } + return r; + } + + proc iVPUNPCKH_4u64(x y:t4u64) : t4u64 = { + var r : t4u64; + r.[0] <- x.[1]; + r.[1] <- y.[1]; + r.[2] <- x.[3]; + r.[3] <- y.[3]; + return r; + } + + proc iVPUNPCKL_4u64 (x y:t4u64) : t4u64 = { + var r : t4u64; + r.[0] <- x.[0]; + r.[1] <- y.[0]; + r.[2] <- x.[2]; + r.[3] <- y.[2]; + return r; + } + + proc iVEXTRACTI128(x:t4u64, p : W8.t) : t2u64 = { + var r : t2u64; + r <- witness; + if (to_uint p = 0) { + r.[0] <- x.[0]; + r.[1] <- x.[1]; + } + else { + if (to_uint p = 1) { + r.[0] <- x.[2]; + r.[1] <- x.[3]; + } + } + return r; + + } + + proc iVPEXTR_64(x:t2u64, p : W8.t) : W64.t = { + return x.[to_uint p]; + } + + proc ivshr64u256 (x: t4u64, y: W8.t) : t4u64 = { + var r : t4u64; + r.[0] <- x.[0] `>>` y; + r.[1] <- x.[1] `>>` y; + r.[2] <- x.[2] `>>` y; + r.[3] <- x.[3] `>>` y; + return r; + } + + proc ivshl64u256 (x: t4u64, y: W8.t) : t4u64 = { + var r : t4u64; + r.[0] <- x.[0] `<<` y; + r.[1] <- x.[1] `<<` y; + r.[2] <- x.[2] `<<` y; + r.[3] <- x.[3] `<<` y; + return r; + } + + + proc iVPSRLV_4u64 (x: t4u64, y: t4u64) : t4u64 = { + var r : t4u64; + r.[0] <- x.[0] `>>` W8.of_int (W64.to_uint y.[0]); + r.[1] <- x.[1] `>>` W8.of_int (W64.to_uint y.[1]); + r.[2] <- x.[2] `>>` W8.of_int (W64.to_uint y.[2]); + r.[3] <- x.[3] `>>` W8.of_int (W64.to_uint y.[3]); + return r; + } + + proc iVPSLLV_4u64 (x: t4u64, y: t4u64) : t4u64 = { + var r : t4u64; + r.[0] <- x.[0] `<<` W8.of_int (W64.to_uint y.[0]); + r.[1] <- x.[1] `<<` W8.of_int (W64.to_uint y.[1]); + r.[2] <- x.[2] `<<` W8.of_int (W64.to_uint y.[2]); + r.[3] <- x.[3] `<<` W8.of_int (W64.to_uint y.[3]); + return r; + } + + proc iland4u64 (x y:t4u64) : t4u64 = { + var r : t4u64; + r.[0] <- x.[0] `&` y.[0]; + r.[1] <- x.[1] `&` y.[1]; + r.[2] <- x.[2] `&` y.[2]; + r.[3] <- x.[3] `&` y.[3]; + return r; + } + + proc ilor4u64 (x y:t4u64) : t4u64 = { + var r : t4u64; + r.[0] <- x.[0] `|` y.[0]; + r.[1] <- x.[1] `|` y.[1]; + r.[2] <- x.[2] `|` y.[2]; + r.[3] <- x.[3] `|` y.[3]; + return r; + } + + proc ilandn4u64(x y:t4u64) : t4u64 = { + var r : t4u64; + r.[0] <- invw x.[0] `&` y.[0]; + r.[1] <- invw x.[1] `&` y.[1]; + r.[2] <- invw x.[2] `&` y.[2]; + r.[3] <- invw x.[3] `&` y.[3]; + return r; + } + + proc ilxor4u64(x y:t4u64) : t4u64 = { + var r : t4u64; + r.[0] <- x.[0] `^` y.[0]; + r.[1] <- x.[1] `^` y.[1]; + r.[2] <- x.[2] `^` y.[2]; + r.[3] <- x.[3] `^` y.[3]; + return r; + } + + proc iVPBLEN_D_D_256(x y:t4u64, p : W8.t) : W64.t Array4.t = { + var r : t4u64; + r <- witness; + if (to_uint p = 192) { + r.[0] <- x.[0]; + r.[1] <- x.[1]; + r.[2] <- x.[2]; + r.[3] <- y.[3]; + } else { + if (to_uint p = 3) { + r.[0] <- y.[0]; + r.[1] <- x.[1]; + r.[2] <- x.[2]; + r.[3] <- x.[3]; + } else { + if (to_uint p = 12) { + r.[0] <- x.[0]; + r.[1] <- y.[1]; + r.[2] <- x.[2]; + r.[3] <- x.[3]; + } else { + if (to_uint p = 48) { + r.[0] <- x.[0]; + r.[1] <- x.[1]; + r.[2] <- y.[2]; + r.[3] <- x.[3]; + } + } + } + } + return r; + } + + + proc iVPSHUF_D_256 (x :t4u64, p : W8.t) : t4u64 = { + var r : t4u64; + r <- witness; + if (to_uint p = 78) { (* 01 00 11 10 *) + r.[0] <- x.[1]; + r.[1] <- x.[0]; + r.[2] <- x.[3]; + r.[3] <- x.[2]; + } + return r; + } +}. + +type vt2u64 = W128.t. +type vt4u64 = W256.t. + + +module OpsV = { + proc itruncate_4u64_2u64(t : vt4u64) : vt2u64 = { + return truncateu128 t; + } + proc set_160(vv : vt4u64 Array5.t, i : int, o : int, v : W64.t) : vt4u64 Array5.t = { + return Array5.init + (WArray160.get256 (WArray160.set64 (WArray160.init256 (fun i2 => vv.[i2])) (o+4*i) v)); + } + proc get_160(vv : vt4u64 Array5.t, i : int, o : int) : W64.t = { + return (get64 (WArray160.init256 (fun i2 => vv.[i2])) (o+4*i)); + } + proc get_128(vv : vt4u64 Array4.t, i : int, o : int) : W64.t = { + return (get64 (WArray128.init256 (fun i2 => vv.[i2])) (o+4*i)); + } + + proc iVPBROADCAST_4u64(v : W64.t) : vt4u64 = { + return x86_VPBROADCAST_4u64 v; + } + + proc iVPMULU_256 (x y:vt4u64) : vt4u64 = { + return x86_VPMULU_256 x y; + } + + proc ivadd64u256(x y:vt4u64) : vt4u64 = { + return x86_VPADD_4u64 x y; + } + + proc iload4u64 (mem:global_mem_t, p:W64.t) : vt4u64 = { + return loadW256 mem (to_uint p); + } + + proc iVPERM2I128(x y:vt4u64, p : W8.t) : vt4u64 = { + return x86_VPERM2I128 x y p; + } + + proc iVPERMQ(x :vt4u64, p : W8.t) : vt4u64 = { + return x86_VPERMQ x p; + } + + proc iVPSRLDQ_256(x:vt4u64, p : W8.t) : vt4u64 = { + return x86_VPSRLDQ_256 x p; + } + + proc iVPUNPCKH_4u64(x y:vt4u64) : vt4u64 = { + return x86_VPUNPCKH_4u64 x y; + } + + proc iVPUNPCKL_4u64 (x y:vt4u64) : vt4u64 = { + return x86_VPUNPCKL_4u64 x y; + } + + proc iVEXTRACTI128(x:vt4u64, p : W8.t) : vt2u64 = { + return x86_VEXTRACTI128 x p; + } + + proc iVPEXTR_64(x:vt2u64, p : W8.t) : W64.t = { + return x86_VPEXTR_64 x p; + } + + + proc ivshr64u256 (x: vt4u64, y: W8.t) : vt4u64 = { + return x86_VPSRL_4u64 x y; + } + + proc ivshl64u256 (x: vt4u64, y: W8.t) : vt4u64 = { + return x86_VPSLL_4u64 x y; + } + + proc iland4u64 (x y:vt4u64) : vt4u64 = { + return x `&` y; + } + + proc ilor4u64 (x y:vt4u64) : vt4u64 = { + return x `|` y; + } +}. + +op is2u64 (x : t2u64) (xv: vt2u64) = xv = W2u64.pack2 [x.[0]; x.[1]]. +op is4u64 (x : t4u64) (xv: vt4u64) = xv = W4u64.pack4 [x.[0]; x.[1]; x.[2]; x.[3]]. + +equiv eq_itruncate_4u64_2u64 : Ops.itruncate_4u64_2u64 ~ OpsV.itruncate_4u64_2u64 : is4u64 t{1} t{2} ==> is2u64 res{1} res{2}. +proof. + proc; skip => &1 &2; rewrite /is2u64 /is4u64 => -> /=. + apply (Core.can_inj _ _ W128.to_uintK). + rewrite to_uint_truncateu128. + rewrite - (W128.to_uint_small (to_uint (pack4 [t{1}.[0]; t{1}.[1]; t{1}.[2]; t{1}.[3]]) %% W128.modulus)). + + by apply modz_cmp. + congr; apply W128.wordP => i hi. + rewrite W128.of_intwE hi W2u64.pack2wE 1:// /=. + rewrite /int_bit /= modz_mod. + have /= -> := modz_pow2_div 128 i; 1,2: admit. (* smt(W256.to_uint_cmp) + rewrite (modz_dvd_pow 1 (128 - i) _ 2) 1:/# /=. + have -> : (to_uint (pack4 [t{1}.[0]; t{1}.[1]; t{1}.[2]; t{1}.[3]]) %/ (IntExtra.(^) 2 i) %% 2 <> 0) = + (pack4 [t{1}.[0]; t{1}.[1]; t{1}.[2]; t{1}.[3]]).[i]. + + rewrite -{2}(W256.to_uintK (pack4 [t{1}.[0]; t{1}.[1]; t{1}.[2]; t{1}.[3]])) W256.of_intwE /int_bit (modz_small _ W256.modulus) 2:/#. + by have /= := W256.to_uint_cmp (pack4 [t{1}.[0]; t{1}.[1]; t{1}.[2]; t{1}.[3]]);rewrite /(`|_|). + rewrite W4u64.pack4wE 1:/#. + case: (i < 64) => hi'. + + by rewrite divz_small 1:/#. + have -> // : i %/ 64 = 1. + have -> : i = (i -64) + 1 * 64 by done. + rewrite divzMDr 1://; smt(divz_small).*) +qed. + +op is4u64_5 (x:t4u64 Array5.t) (xv:vt4u64 Array5.t) = + xv = Array5.init (fun i => W4u64.pack4 [x.[i].[0]; x.[i].[1]; x.[i].[2]; x.[i].[3]]). + +op is4u64_4 (x:t4u64 Array4.t) (xv:vt4u64 Array4.t) = + xv = Array4.init (fun i => W4u64.pack4 [x.[i].[0]; x.[i].[1]; x.[i].[2]; x.[i].[3]]). + +lemma get8_pack4u64 ws j: + W4u64.pack4_t ws \bits8 j = + if 0 <= j < 32 then ws.[j %/ 8] \bits8 (j %% 8) else W8.zero. +proof. + rewrite pack4E W8.wordP => i hi. + rewrite bits8E /= initE hi /= initE. + have -> /= : (0 <= j * 8 + i < 256) <=> (0 <= j < 32) by smt(). + case : (0 <= j < 32) => hj //=. + rewrite bits8E /= initE. + have -> : (j * 8 + i) %/ 64 = j %/ 8. + + rewrite {1}(divz_eq j 8) mulzDl mulzA /= -addzA divzMDl //. + by rewrite (divz_small _ 64) //; smt (modz_cmp). + rewrite hi /=;congr. + rewrite {1}(divz_eq j 8) mulzDl mulzA /= -addzA modzMDl modz_small //; smt (modz_cmp). +qed. + +lemma Array5_get_set_eq (t:'a Array5.t) i a: 0 <= i < 5 => t.[i <- a].[i] = a. +proof. by move=> hi;rewrite Array5.get_setE. qed. + +equiv eq_set_160 : Ops.set_160 ~ OpsV.set_160 : is4u64_5 vv{1} vv{2} /\ ={i,o,v} /\ 0 <= i{1} < 5 /\ 0 <= o{1} < 4 ==> is4u64_5 res{1} res{2}. +proof. + proc; skip; rewrite /is4u64_5 => /> &1 &2 h1 h2 h3 h4. + apply Array5.tP => k hk. + rewrite !Array5.initiE 1,2:// /=. + rewrite /init256 set64E get256E -(W32u8.unpack8K (W4u64.pack4 _)); congr. + apply W32u8.Pack.packP => j hj. + rewrite W32u8.Pack.initiE 1:// get_unpack8 1:// /= WArray160.initiE 1:/# /=. + rewrite WArray160.initiE 1:/# /=. + rewrite (mulzC 32) modzMDl divzMDl 1:// divz_small 1:// modz_small 1:// /= Array5.initiE 1:// /=. + rewrite !get8_pack4u64 hj /=. + have /= <- := W4u64.Pack.init_of_list (fun i => vv{1}.[k].[i]). + have /= <- := W4u64.Pack.init_of_list (fun j => vv{1}.[i{2} <- vv{1}.[i{2}].[o{2} <- v{2}]].[k].[j]). + have ? : 0 <= j %/ 8 < 4 by rewrite ltz_divLR // lez_divRL. + rewrite !W4u64.Pack.initiE 1,2:// /=. + rewrite Array5.get_setE 1://. + case: (k = i{2}) => [->> | /#]. + rewrite Array4.get_setE 1://;smt(edivzP). +qed. + +equiv eq_get_160 : Ops.get_160 ~ OpsV.get_160 : is4u64_5 vv{1} vv{2} /\ ={i,o} /\ 0 <= i{1} < 5 /\ 0 <= o{1} < 4 ==> ={res}. +proof. + proc;skip;rewrite /is4u64_5 => /> &1 &2 h1 h2 h3 h4. + rewrite /init256 get64E -(W8u8.unpack8K vv{1}.[i{2}].[o{2}]);congr. + apply W8u8.Pack.packP => j hj. + rewrite W8u8.Pack.initiE 1:// initiE 1:// /= initiE 1:/# /=. + have -> : (8 * (o{2} + 4 * i{2}) + j) = (o{2} * 8 + j) + i{2} * 32 by ring. + have ? : 0 <= o{2} * 8 + j < `|32| by smt(). + rewrite modzMDr divzMDr 1:// divz_small 1:// modz_small 1:// /=. + rewrite Array5.initiE 1:// /= get8_pack4u64. + have /= <- := W4u64.Pack.init_of_list (fun j => vv{1}.[i{2}].[j]). + rewrite divzMDl 1:// divz_small 1:// modzMDl /= initiE 1:// modz_small 1:// /#. +qed. + +equiv eq_get_128 : Ops.get_128 ~ OpsV.get_128 : is4u64_4 vv{1} vv{2} /\ ={i,o} /\ 0 <= i{1} < 4 /\ 0 <= o{1} < 4 ==> ={res}. +proof. + proc;skip;rewrite /is4u64_4 => /> &1 &2 h1 h2 h3 h4. + rewrite /init256 get64E -(W8u8.unpack8K vv{1}.[i{2}].[o{2}]);congr. + apply W8u8.Pack.packP => j hj. + rewrite W8u8.Pack.initiE 1:// initiE 1:// /= initiE 1:/# /=. + have -> : (8 * (o{2} + 4 * i{2}) + j) = (o{2} * 8 + j) + i{2} * 32 by ring. + have ? : 0 <= o{2} * 8 + j < `|32| by smt(). + rewrite modzMDr divzMDr 1:// divz_small 1:// modz_small 1:// /=. + rewrite Array4.initiE 1:// /= get8_pack4u64. + have /= <- := W4u64.Pack.init_of_list (fun j => vv{1}.[i{2}].[j]). + rewrite divzMDl 1:// divz_small 1:// modzMDl /= initiE 1:// modz_small 1:// /#. +qed. + +equiv eq_iVPBROADCAST_4u64 : Ops.iVPBROADCAST_4u64 ~ OpsV.iVPBROADCAST_4u64 : ={v} ==> is4u64 res{1} res{2}. +proof. by proc => /=;wp;skip;rewrite /is4u64. qed. + +equiv eq_iVPMULU_256 : Ops.iVPMULU_256 ~ OpsV.iVPMULU_256 : is4u64 x{1} x{2} /\ is4u64 y{1} y{2} ==> is4u64 res{1} res{2}. +proof. by admit. qed. (* proc;wp;skip;rewrite /is4u64 => /> &1; rewrite /x86_VPMULU_256. qed.*) + +equiv eq_ivadd64u256: Ops.ivadd64u256 ~ OpsV.ivadd64u256 : is4u64 x{1} x{2} /\ is4u64 y{1} y{2} ==> is4u64 res{1} res{2}. +proof. by proc;wp;skip;rewrite /is4u64 /x86_VPADD_4u64. qed. + +equiv eq_iload4u64: Ops.iload4u64 ~ OpsV.iload4u64 : ={mem, p} /\ to_uint p{1} + 32 <= W64.modulus ==> is4u64 res{1} res{2}. +proof. + proc; wp; skip; rewrite /is4u64 => /> &2 hp. + rewrite /loadW256 -(W32u8.unpack8K (W4u64.pack4 _));congr. + apply W32u8.Pack.packP => j hj. + rewrite initiE 1:// W32u8.get_unpack8 1:// /= get8_pack4u64 hj /=. + have /= <- := W4u64.Pack.init_of_list (fun j => loadW64 mem{2} (to_uint (p{2} + W64.of_int (8 * j)))). + have ? : 0 <= j %/ 8 < 4 by rewrite ltz_divLR // lez_divRL. + have ? := modz_cmp j 8. + rewrite initiE 1:// /loadW64 /= pack8bE 1:// initiE 1:// /=. + have heq : to_uint (W64.of_int (8 * (j %/ 8))) = 8 * (j %/ 8). + + by rewrite of_uintK modz_small 2:// /= /#. + rewrite to_uintD_small heq 1:/#; smt (edivzP). +qed. + +lemma pack2_2u64_4u64 (w0 w1 w2 w3 :W64.t) : + pack2 [pack2 [w0; w1]; pack2 [w2; w3]] = + pack4 [w0; w1; w2; w3]. +proof. by apply W256.all_eq_eq;cbv W256.all_eq (%/) (%%). qed. + +lemma W4u64_bits128_0 (w:W4u64.Pack.pack_t) : + pack4_t w \bits128 0 = pack2 [w.[0]; w.[1]]. +proof. by admit. (*rewrite -{1}(W4u64.Pack.to_listK w) /= -pack2_2u64_4u64.*) qed. + +lemma W4u64_bits128_1 (w:W4u64.Pack.pack_t) : + pack4_t w \bits128 1 = pack2 [w.[2]; w.[3]]. +proof. by admit. (* rewrite -{1}(W4u64.Pack.to_listK w) /= -pack2_2u64_4u64.*) qed. + +hint simplify (W4u64_bits128_0, W4u64_bits128_1). + +lemma x86_VPERM2I128_4u64_spec_32 (v0 v1 v2 v3 : W64.t) (w0 w1 w2 w3: W64.t): + x86_VPERM2I128 (W4u64.pack4 [v0; v1; v2; v3]) (W4u64.pack4 [w0; w1; w2; w3]) (W8.of_int 32) = + W4u64.pack4 [v0; v1; w0; w1]. +proof. + by admit. (* cbv delta; rewrite !of_intwE; cbv delta; rewrite pack2_2u64_4u64. *) +qed. + +lemma x86_VPERM2I128_4u64_spec_49 (v0 v1 v2 v3 : W64.t) (w0 w1 w2 w3 : W64.t): + x86_VPERM2I128 (W4u64.pack4 [v0; v1; v2; v3]) (W4u64.pack4 [w0; w1; w2; w3]) (W8.of_int 49) = + W4u64.pack4 [v2; v3; w2; w3]. +proof. + (* by cbv delta; rewrite !of_intwE; cbv delta; rewrite pack2_2u64_4u64. *) admit. +qed. + +hint simplify (x86_VPERM2I128_4u64_spec_32, x86_VPERM2I128_4u64_spec_49). + +equiv eq_iVPERM2I128 : Ops.iVPERM2I128 ~ OpsV.iVPERM2I128 : + is4u64 x{1} x{2} /\ is4u64 y{1} y{2} /\ ={p} /\ (p{1} = W8.of_int 32 \/ p{1} = W8.of_int 49) ==> is4u64 res{1} res{2}. +proof. by proc; wp; skip; rewrite /is4u64 => /> &1 &2 [] ->. qed. + +equiv eq_iVPERMQ : Ops.iVPERMQ ~ OpsV.iVPERMQ : is4u64 x{1} x{2} /\ ={p} /\ p{1} = W8.of_int 128 ==> is4u64 res{1} res{2}. +proof. admit. (* by proc; wp; skip; rewrite /is4u64. *) qed. + +lemma lsr_2u64 (w1 w2:W64.t) (x:int) : 0 <= x <= 64 => + pack2 [w1; w2] `>>>` x = pack2 [(w1 `>>>` x) `|` (w2 `<<<` 64 - x); w2 `>>>` x]. +proof. + move=> hx;apply W128.wordP => i hi. + rewrite pack2wE 1://. + rewrite W128.shrwE hi /=. + case: (i < 64) => hi1. + + have [-> ->] /=: i %/ 64 = 0 /\ i %% 64 = i by smt(edivzP). + rewrite pack2wE 1:/#. + have -> : 0 <= i < 64 by smt(). + case: (i + x < 64) => hix. + + have [-> ->] /= : (i + x) %/ 64 = 0 /\ (i + x) %% 64 = i + x by smt(edivzP). + by rewrite (W64.get_out w2) 1:/#. + have [-> ->] /= : (i + x) %/ 64 = 1 /\ (i + x) %% 64 = i - (64 - x) by smt(edivzP). + by rewrite (W64.get_out w1) 1:/#. + have [-> ->] /= : i %/ 64 = 1 /\ i %% 64 = i - 64 by smt(edivzP). + case (i + x < 128) => hix;last by rewrite W128.get_out 1:/# W64.get_out 1:/#. + rewrite pack2wE 1:/#. + have -> /= : 0 <= i - 64 < 64 by smt(). + by have [-> ->] : (i + x) %/ 64 = 1 /\ (i + x) %% 64 = i - 64 + x by smt(edivzP). +qed. + +lemma lsr_0 (w:W64.t) : w `<<<` 0 = w. +proof. by apply W64.wordP => i hi; rewrite W64.shlwE hi. qed. + +equiv eq_iVPSRLDQ_256: Ops.iVPSRLDQ_256 ~ OpsV.iVPSRLDQ_256 : is4u64 x{1} x{2} /\ ={p} /\ (p{1} = W8.of_int 6 \/ p{1} = W8.of_int 8) ==> is4u64 res{1} res{2}. +proof. + proc; wp; skip; rewrite /is4u64 => /> &1 &2 h. + rewrite -pack2_2u64_4u64 /x86_VPSRLDQ_256 /x86_VPSRLDQ_128 /=. + by case h => -> /=; cbv delta; rewrite !lsr_2u64 // pack2_2u64_4u64 //= !lsr_0. +qed. + +equiv eq_iVPUNPCKH_4u64: Ops.iVPUNPCKH_4u64 ~ OpsV.iVPUNPCKH_4u64 : is4u64 x{1} x{2} /\ is4u64 y{1} y{2} ==> is4u64 res{1} res{2}. +proof. + proc; wp; skip; rewrite /is4u64 => /> &1. + admit. (* by rewrite /x86_VPUNPCKH_4u64 /x86_VPUNPCKH_2u64 -!pack2_2u64_4u64 /=.*) +qed. + +equiv eq_iVPUNPCKL_4u64: Ops.iVPUNPCKL_4u64 ~ OpsV.iVPUNPCKL_4u64 : is4u64 x{1} x{2} /\ is4u64 y{1} y{2} ==> is4u64 res{1} res{2}. +proof. + proc; wp; skip; rewrite /is4u64 => /> &1. + admit. (* by rewrite /x86_VPUNPCKL_4u64 /x86_VPUNPCKL_2u64 -!pack2_2u64_4u64 /=. *) +qed. + +equiv eq_iVEXTRACTI128: Ops.iVEXTRACTI128 ~ OpsV.iVEXTRACTI128 : is4u64 x{1} x{2} /\ ={p} /\ (p{1} = W8.of_int 0 \/ p{2} = W8.of_int 1) ==> is2u64 res{1} res{2}. +proof. + proc; wp; skip;rewrite /is4u64 /is2u64 /x86_VEXTRACTI128 => /> &1 &2 h /=. + rewrite -pack2_2u64_4u64 /b2i;case h => -> /= //. + by rewrite W8.of_intwE;cbv delta. +qed. + +equiv eq_iVPEXTR_64: Ops.iVPEXTR_64 ~ OpsV.iVPEXTR_64 : is2u64 x{1} x{2} /\ ={p} /\ (p{1} = W8.of_int 0 \/ p{2} = W8.of_int 1)==> res{1} = res{2}. +proof. by proc; skip; rewrite /is2u64 /x86_VPEXTR_64 => /> &1 &2 [] -> /=. qed. + +equiv eq_ivshr64u256: Ops.ivshr64u256 ~ OpsV.ivshr64u256 : is4u64 x{1} x{2} /\ ={y} ==> is4u64 res{1} res{2}. +proof. by proc; wp; skip; rewrite /is4u64 /x86_VPSRL_4u64. qed. + +equiv eq_ivshl64u256: Ops.ivshl64u256 ~ OpsV.ivshl64u256 : is4u64 x{1} x{2} /\ ={y} ==> is4u64 res{1} res{2}. +proof. by proc; wp; skip; rewrite /is4u64 /x86_VPSLL_4u64. qed. + +equiv eq_iland4u64: Ops.iland4u64 ~ OpsV.iland4u64 : is4u64 x{1} x{2} /\ is4u64 y{1} y{2} ==> is4u64 res{1} res{2}. +proof. by proc; wp; skip; rewrite /is4u64. qed. + +equiv eq_ilor4u64: Ops.ilor4u64 ~ OpsV.ilor4u64 : is4u64 x{1} x{2} /\ is4u64 y{1} y{2} ==> is4u64 res{1} res{2}. +proof. by proc; wp; skip; rewrite /is4u64. qed. diff --git a/proof/impl/perm/keccak_f1600_avx2.ec b/proof/impl/perm/keccak_f1600_avx2.ec new file mode 100644 index 0000000..b2b821b --- /dev/null +++ b/proof/impl/perm/keccak_f1600_avx2.ec @@ -0,0 +1,359 @@ +require import List Int IntExtra IntDiv CoreMap. +from Jasmin require import JModel. + +(* +require import Array9. +require import WArray288. +*) + +clone export PolyArray as Array9 with op size <- 9. + +op x86_VPSHUF_D_256 : W256.t -> W8.t -> W256.t. +op x86_VPBLEN_D_D_256 : W256.t -> W256.t -> W8.t -> W256.t. +op x86_VPSLLV_4u64 : W256.t -> W256.t -> W256.t. +op x86_VPSRLV_4u64 : W256.t -> W256.t -> W256.t. +op x86_VPSRL_DQ_256 : W256.t -> W8.t -> W256.t. +op x86_VPANDN_256 : W256.t -> W256.t -> W256.t. +op x86_DEC_32 : W32.t -> (bool * bool * bool * bool * W32.t). +op x86_VPBLENDD_256 : W256.t -> W256.t -> W8.t -> W256.t. + +module Mavx2 = { + proc __KeccakF1600 (_A00:W256.t, _A01:W256.t, _A20:W256.t, _A31:W256.t, + _A21:W256.t, _A41:W256.t, _A11:W256.t, + _rhotates_left:W64.t, _rhotates_right:W64.t, + _iotas:W64.t) : W256.t * W256.t * W256.t * W256.t * + W256.t * W256.t * W256.t = { + + var rhotates_left:W64.t; + var rhotates_right:W64.t; + var iotas:W64.t; + var i:W32.t; + var zf:bool; + var _C00:W256.t; + var _C14:W256.t; + var _T:W256.t Array9.t; + var _D14:W256.t; + var _D00:W256.t; + var _0:bool; + var _1:bool; + var _2:bool; + _T <- witness; + rhotates_left <- (_rhotates_left + (W64.of_int 96)); + rhotates_right <- (_rhotates_right + (W64.of_int 96)); + iotas <- _iotas; + i <- (W32.of_int 24); + _C00 <- x86_VPSHUF_D_256 _A20 (W8.of_int 78); + _C14 <- (_A41 `^` _A31); + _T.[2] <- (_A21 `^` _A11); + _C14 <- (_C14 `^` _A01); + _C14 <- (_C14 `^` _T.[2]); + _T.[4] <- x86_VPERMQ _C14 (W8.of_int 147); + _C00 <- (_C00 `^` _A20); + _T.[0] <- x86_VPERMQ _C00 (W8.of_int 78); + _T.[1] <- (_C14 \vshr64u256 (W8.of_int 63)); + _T.[2] <- (_C14 \vadd64u256 _C14); + _T.[1] <- (_T.[1] `|` _T.[2]); + _D14 <- x86_VPERMQ _T.[1] (W8.of_int 57); + _D00 <- (_T.[1] `^` _T.[4]); + _D00 <- x86_VPERMQ _D00 (W8.of_int 0); + _C00 <- (_C00 `^` _A00); + _C00 <- (_C00 `^` _T.[0]); + _T.[0] <- (_C00 \vshr64u256 (W8.of_int 63)); + _T.[1] <- (_C00 \vadd64u256 _C00); + _T.[1] <- (_T.[1] `|` _T.[0]); + _A20 <- (_A20 `^` _D00); + _A00 <- (_A00 `^` _D00); + _D14 <- x86_VPBLEN_D_D_256 _D14 _T.[1] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + _T.[4] <- x86_VPBLEN_D_D_256 _T.[4] _C00 + (W8.of_int (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + _D14 <- (_D14 `^` _T.[4]); + _T.[3] <- x86_VPSLLV_4u64 _A20 + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((0 * 32) - 96))))); + _A20 <- x86_VPSRLV_4u64 _A20 + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((0 * 32) - 96))))); + _A20 <- (_A20 `|` _T.[3]); + _A31 <- (_A31 `^` _D14); + _T.[4] <- x86_VPSLLV_4u64 _A31 + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((2 * 32) - 96))))); + _A31 <- x86_VPSRLV_4u64 _A31 + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((2 * 32) - 96))))); + _A31 <- (_A31 `|` _T.[4]); + _A21 <- (_A21 `^` _D14); + _T.[5] <- x86_VPSLLV_4u64 _A21 + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((3 * 32) - 96))))); + _A21 <- x86_VPSRLV_4u64 _A21 + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((3 * 32) - 96))))); + _A21 <- (_A21 `|` _T.[5]); + _A41 <- (_A41 `^` _D14); + _T.[6] <- x86_VPSLLV_4u64 _A41 + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((4 * 32) - 96))))); + _A41 <- x86_VPSRLV_4u64 _A41 + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((4 * 32) - 96))))); + _A41 <- (_A41 `|` _T.[6]); + _A11 <- (_A11 `^` _D14); + _T.[3] <- x86_VPERMQ _A20 (W8.of_int 141); + _T.[4] <- x86_VPERMQ _A31 (W8.of_int 141); + _T.[7] <- x86_VPSLLV_4u64 _A11 + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((5 * 32) - 96))))); + _T.[1] <- x86_VPSRLV_4u64 _A11 + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((5 * 32) - 96))))); + _T.[1] <- (_T.[1] `|` _T.[7]); + _A01 <- (_A01 `^` _D14); + _T.[5] <- x86_VPERMQ _A21 (W8.of_int 27); + _T.[6] <- x86_VPERMQ _A41 (W8.of_int 114); + _T.[8] <- x86_VPSLLV_4u64 _A01 + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((1 * 32) - 96))))); + _T.[2] <- x86_VPSRLV_4u64 _A01 + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((1 * 32) - 96))))); + _T.[2] <- (_T.[2] `|` _T.[8]); + _T.[7] <- x86_VPSRL_DQ_256 _T.[1] (W8.of_int 8); + _T.[0] <- ((invw _T.[1]) `&` _T.[7]); + _A31 <- x86_VPBLEN_D_D_256 _T.[2] _T.[6] + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + _T.[8] <- x86_VPBLEN_D_D_256 _T.[4] _T.[2] + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + _A41 <- x86_VPBLEN_D_D_256 _T.[3] _T.[4] + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + _T.[7] <- x86_VPBLEN_D_D_256 _T.[2] _T.[3] + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + _A31 <- x86_VPBLEN_D_D_256 _A31 _T.[4] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + _T.[8] <- x86_VPBLEN_D_D_256 _T.[8] _T.[5] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + _A41 <- x86_VPBLEN_D_D_256 _A41 _T.[2] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + _T.[7] <- x86_VPBLEN_D_D_256 _T.[7] _T.[6] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + _A31 <- x86_VPBLEN_D_D_256 _A31 _T.[5] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + _T.[8] <- x86_VPBLEN_D_D_256 _T.[8] _T.[6] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + _A41 <- x86_VPBLEN_D_D_256 _A41 _T.[6] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + _T.[7] <- x86_VPBLEN_D_D_256 _T.[7] _T.[4] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + _A31 <- x86_VPANDN_256 _A31 _T.[8]; + _A41 <- x86_VPANDN_256 _A41 _T.[7]; + _A11 <- x86_VPBLEN_D_D_256 _T.[5] _T.[2] + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + _T.[8] <- x86_VPBLEN_D_D_256 _T.[3] _T.[5] + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + _A31 <- (_A31 `^` _T.[3]); + _A11 <- x86_VPBLEN_D_D_256 _A11 _T.[3] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + _T.[8] <- x86_VPBLEN_D_D_256 _T.[8] _T.[4] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + _A41 <- (_A41 `^` _T.[5]); + _A11 <- x86_VPBLEN_D_D_256 _A11 _T.[4] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + _T.[8] <- x86_VPBLEN_D_D_256 _T.[8] _T.[2] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + _A11 <- x86_VPANDN_256 _A11 _T.[8]; + _A11 <- (_A11 `^` _T.[6]); + _A21 <- x86_VPERMQ _T.[1] (W8.of_int 30); + _T.[8] <- x86_VPBLEN_D_D_256 _A21 _A00 + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + _A01 <- x86_VPERMQ _T.[1] (W8.of_int 57); + _A01 <- x86_VPBLEN_D_D_256 _A01 _A00 + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + _A01 <- x86_VPANDN_256 _A01 _T.[8]; + _A20 <- x86_VPBLEN_D_D_256 _T.[4] _T.[5] + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + _T.[7] <- x86_VPBLEN_D_D_256 _T.[6] _T.[4] + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + _A20 <- x86_VPBLEN_D_D_256 _A20 _T.[6] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + _T.[7] <- x86_VPBLEN_D_D_256 _T.[7] _T.[3] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + _A20 <- x86_VPBLEN_D_D_256 _A20 _T.[3] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + _T.[7] <- x86_VPBLEN_D_D_256 _T.[7] _T.[5] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + _A20 <- x86_VPANDN_256 _A20 _T.[7]; + _A20 <- (_A20 `^` _T.[2]); + _T.[0] <- x86_VPERMQ _T.[0] (W8.of_int 0); + _A31 <- x86_VPERMQ _A31 (W8.of_int 27); + _A41 <- x86_VPERMQ _A41 (W8.of_int 141); + _A11 <- x86_VPERMQ _A11 (W8.of_int 114); + _A21 <- x86_VPBLEN_D_D_256 _T.[6] _T.[3] + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + _T.[7] <- x86_VPBLEN_D_D_256 _T.[5] _T.[6] + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + _A21 <- x86_VPBLEN_D_D_256 _A21 _T.[5] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + _T.[7] <- x86_VPBLEN_D_D_256 _T.[7] _T.[2] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + _A21 <- x86_VPBLEN_D_D_256 _A21 _T.[2] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + _T.[7] <- x86_VPBLEN_D_D_256 _T.[7] _T.[3] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + _A21 <- x86_VPANDN_256 _A21 _T.[7]; + _A00 <- (_A00 `^` _T.[0]); + _A01 <- (_A01 `^` _T.[1]); + _A21 <- (_A21 `^` _T.[4]); + _A00 <- + (_A00 `^` (loadW256 Glob.mem (W64.to_uint (iotas + (W64.of_int 0))))); + iotas <- (iotas + (W64.of_int 32)); + ( _0, _1, _2, zf, i) <- x86_DEC_32 i; + while ((! zf)) { + _C00 <- x86_VPSHUF_D_256 _A20 (W8.of_int 78); + _C14 <- (_A41 `^` _A31); + _T.[2] <- (_A21 `^` _A11); + _C14 <- (_C14 `^` _A01); + _C14 <- (_C14 `^` _T.[2]); + _T.[4] <- x86_VPERMQ _C14 (W8.of_int 147); + _C00 <- (_C00 `^` _A20); + _T.[0] <- x86_VPERMQ _C00 (W8.of_int 78); + _T.[1] <- (_C14 \vshr64u256 (W8.of_int 63)); + _T.[2] <- (_C14 \vadd64u256 _C14); + _T.[1] <- (_T.[1] `|` _T.[2]); + _D14 <- x86_VPERMQ _T.[1] (W8.of_int 57); + _D00 <- (_T.[1] `^` _T.[4]); + _D00 <- x86_VPERMQ _D00 (W8.of_int 0); + _C00 <- (_C00 `^` _A00); + _C00 <- (_C00 `^` _T.[0]); + _T.[0] <- (_C00 \vshr64u256 (W8.of_int 63)); + _T.[1] <- (_C00 \vadd64u256 _C00); + _T.[1] <- (_T.[1] `|` _T.[0]); + _A20 <- (_A20 `^` _D00); + _A00 <- (_A00 `^` _D00); + _D14 <- x86_VPBLEN_D_D_256 _D14 _T.[1] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + _T.[4] <- x86_VPBLEN_D_D_256 _T.[4] _C00 + (W8.of_int (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + _D14 <- (_D14 `^` _T.[4]); + _T.[3] <- x86_VPSLLV_4u64 _A20 + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((0 * 32) - 96))))); + _A20 <- x86_VPSRLV_4u64 _A20 + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((0 * 32) - 96))))); + _A20 <- (_A20 `|` _T.[3]); + _A31 <- (_A31 `^` _D14); + _T.[4] <- x86_VPSLLV_4u64 _A31 + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((2 * 32) - 96))))); + _A31 <- x86_VPSRLV_4u64 _A31 + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((2 * 32) - 96))))); + _A31 <- (_A31 `|` _T.[4]); + _A21 <- (_A21 `^` _D14); + _T.[5] <- x86_VPSLLV_4u64 _A21 + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((3 * 32) - 96))))); + _A21 <- x86_VPSRLV_4u64 _A21 + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((3 * 32) - 96))))); + _A21 <- (_A21 `|` _T.[5]); + _A41 <- (_A41 `^` _D14); + _T.[6] <- x86_VPSLLV_4u64 _A41 + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((4 * 32) - 96))))); + _A41 <- x86_VPSRLV_4u64 _A41 + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((4 * 32) - 96))))); + _A41 <- (_A41 `|` _T.[6]); + _A11 <- (_A11 `^` _D14); + _T.[3] <- x86_VPERMQ _A20 (W8.of_int 141); + _T.[4] <- x86_VPERMQ _A31 (W8.of_int 141); + _T.[7] <- x86_VPSLLV_4u64 _A11 + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((5 * 32) - 96))))); + _T.[1] <- x86_VPSRLV_4u64 _A11 + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((5 * 32) - 96))))); + _T.[1] <- (_T.[1] `|` _T.[7]); + _A01 <- (_A01 `^` _D14); + _T.[5] <- x86_VPERMQ _A21 (W8.of_int 27); + _T.[6] <- x86_VPERMQ _A41 (W8.of_int 114); + _T.[8] <- x86_VPSLLV_4u64 _A01 + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((1 * 32) - 96))))); + _T.[2] <- x86_VPSRLV_4u64 _A01 + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((1 * 32) - 96))))); + _T.[2] <- (_T.[2] `|` _T.[8]); + _T.[7] <- x86_VPSRL_DQ_256 _T.[1] (W8.of_int 8); + _T.[0] <- ((invw _T.[1]) `&` _T.[7]); + _A31 <- x86_VPBLEN_D_D_256 _T.[2] _T.[6] + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + _T.[8] <- x86_VPBLEN_D_D_256 _T.[4] _T.[2] + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + _A41 <- x86_VPBLEN_D_D_256 _T.[3] _T.[4] + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + _T.[7] <- x86_VPBLEN_D_D_256 _T.[2] _T.[3] + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + _A31 <- x86_VPBLEN_D_D_256 _A31 _T.[4] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + _T.[8] <- x86_VPBLEN_D_D_256 _T.[8] _T.[5] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + _A41 <- x86_VPBLEN_D_D_256 _A41 _T.[2] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + _T.[7] <- x86_VPBLEN_D_D_256 _T.[7] _T.[6] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + _A31 <- x86_VPBLEN_D_D_256 _A31 _T.[5] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + _T.[8] <- x86_VPBLEN_D_D_256 _T.[8] _T.[6] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + _A41 <- x86_VPBLEN_D_D_256 _A41 _T.[6] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + _T.[7] <- x86_VPBLEN_D_D_256 _T.[7] _T.[4] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + _A31 <- x86_VPANDN_256 _A31 _T.[8]; + _A41 <- x86_VPANDN_256 _A41 _T.[7]; + _A11 <- x86_VPBLENDD_256 _T.[5] _T.[2] + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + _T.[8] <- x86_VPBLEN_D_D_256 _T.[3] _T.[5] + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + _A31 <- (_A31 `^` _T.[3]); + _A11 <- x86_VPBLEN_D_D_256 _A11 _T.[3] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + _T.[8] <- x86_VPBLEN_D_D_256 _T.[8] _T.[4] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + _A41 <- (_A41 `^` _T.[5]); + _A11 <- x86_VPBLEN_D_D_256 _A11 _T.[4] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + _T.[8] <- x86_VPBLEN_D_D_256 _T.[8] _T.[2] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + _A11 <- x86_VPANDN_256 _A11 _T.[8]; + _A11 <- (_A11 `^` _T.[6]); + _A21 <- x86_VPERMQ _T.[1] (W8.of_int 30); + _T.[8] <- x86_VPBLEN_D_D_256 _A21 _A00 + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + _A01 <- x86_VPERMQ _T.[1] (W8.of_int 57); + _A01 <- x86_VPBLEN_D_D_256 _A01 _A00 + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + _A01 <- x86_VPANDN_256 _A01 _T.[8]; + _A20 <- x86_VPBLEN_D_D_256 _T.[4] _T.[5] + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + _T.[7] <- x86_VPBLEN_D_D_256 _T.[6] _T.[4] + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + _A20 <- x86_VPBLEN_D_D_256 _A20 _T.[6] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + _T.[7] <- x86_VPBLEN_D_D_256 _T.[7] _T.[3] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + _A20 <- x86_VPBLEN_D_D_256 _A20 _T.[3] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + _T.[7] <- x86_VPBLEN_D_D_256 _T.[7] _T.[5] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + _A20 <- x86_VPANDN_256 _A20 _T.[7]; + _A20 <- (_A20 `^` _T.[2]); + _T.[0] <- x86_VPERMQ _T.[0] (W8.of_int 0); + _A31 <- x86_VPERMQ _A31 (W8.of_int 27); + _A41 <- x86_VPERMQ _A41 (W8.of_int 141); + _A11 <- x86_VPERMQ _A11 (W8.of_int 114); + _A21 <- x86_VPBLEN_D_D_256 _T.[6] _T.[3] + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + _T.[7] <- x86_VPBLEN_D_D_256 _T.[5] _T.[6] + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + _A21 <- x86_VPBLEN_D_D_256 _A21 _T.[5] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + _T.[7] <- x86_VPBLEN_D_D_256 _T.[7] _T.[2] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + _A21 <- x86_VPBLEN_D_D_256 _A21 _T.[2] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + _T.[7] <- x86_VPBLEN_D_D_256 _T.[7] _T.[3] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + _A21 <- x86_VPANDN_256 _A21 _T.[7]; + _A00 <- (_A00 `^` _T.[0]); + _A01 <- (_A01 `^` _T.[1]); + _A21 <- (_A21 `^` _T.[4]); + _A00 <- + (_A00 `^` (loadW256 Glob.mem (W64.to_uint (iotas + (W64.of_int 0))))); + iotas <- (iotas + (W64.of_int 32)); + ( _0, _1, _2, zf, i) <- x86_DEC_32 i; + } + return (_A00, _A01, _A20, _A31, _A21, _A41, _A11); + } +}. + +require import keccak_f1600_ref. \ No newline at end of file diff --git a/proof/impl/perm/keccak_f1600_avx2_prevec.ec b/proof/impl/perm/keccak_f1600_avx2_prevec.ec new file mode 100644 index 0000000..2785003 --- /dev/null +++ b/proof/impl/perm/keccak_f1600_avx2_prevec.ec @@ -0,0 +1,1168 @@ +require import List Int IntExtra IntDiv CoreMap. +from Jasmin require import JModel. + +(* +require import Array9. +require import WArray288. +*) + +clone export PolyArray as Array9 with op size <- 9. +clone export PolyArray as Array4 with op size <- 4. +clone export PolyArray as Array24 with op size <- 24. +clone export PolyArray as Array96 with op size <- 96. + +require import Ops. + +op x86_DEC_32 : W32.t -> (bool * bool * bool * bool * W32.t). + +op lift2array : W256.t -> W64.t Array4.t. + +module Mavx2_prevec = { + + proc rhotates_right(off : int) : W64.t Array4.t = { + var table : int Array24.t; + var r : W64.t Array4.t; + table.[4*0+0] = 64-3 ; table.[4*0+1] = 64-18; table.[4*0+2] = 64-36; table.[4*0+3] = 64-41; + table.[4*1+0] = 64-1 ; table.[4*1+1] = 64-62; table.[4*1+2] = 64-28; table.[4*1+3] = 64-27; + table.[4*2+0] = 64-45; table.[4*2+1] = 64-6 ; table.[4*2+2] = 64-56; table.[4*2+3] = 64-39; + table.[4*3+0] = 64-10; table.[4*3+1] = 64-61; table.[4*3+2] = 64-55; table.[4*3+3] = 64-8 ; + table.[4*4+0] = 64-2 ; table.[4*4+1] = 64-15; table.[4*4+2] = 64-25; table.[4*4+3] = 64-20; + table.[4*5+0] = 64-44; table.[4*5+1] = 64-43; table.[4*5+2] = 64-21; table.[4*5+3] = 64-14; + r.[0] = W64.of_int table.[4*off + 0]; + r.[1] = W64.of_int table.[4*off + 1]; + r.[2] = W64.of_int table.[4*off + 2]; + r.[3] = W64.of_int table.[4*off + 3]; + return r; + } + + proc rhotates_left(off : int) : W64.t Array4.t = { + var table : int Array24.t; + var r : W64.t Array4.t; + table.[4*0+0]=3 ; table.[4*0+1]=18; table.[4*0+2]=36; table.[4*0+3]=41; + table.[4*1+0]=1 ; table.[4*1+1]=62; table.[4*1+2]=28; table.[4*1+3]=27; + table.[4*2+0]=45; table.[4*2+1]=6 ; table.[4*2+2]=56; table.[4*2+3]=39; + table.[4*3+0]=10; table.[4*3+1]=61; table.[4*3+2]=55; table.[4*3+3]=8 ; + table.[4*4+0]=2 ; table.[4*4+1]=15; table.[4*4+2]=25; table.[4*4+3]=20; + table.[4*5+0]=44; table.[4*5+1]=43; table.[4*5+2]=21; table.[4*5+3]=14; + r.[0] = W64.of_int table.[4*off + 0]; + r.[1] = W64.of_int table.[4*off + 1]; + r.[2] = W64.of_int table.[4*off + 2]; + r.[3] = W64.of_int table.[4*off + 3]; + return r; + } + + proc iotas(off : int) : W64.t Array4.t = { + var table : int Array96.t; + var r : W64.t Array4.t; + table.[4* 0+3] = 1; table.[4* 0+2] = 1; table.[4* 0+1] = 1; table.[4* 0+0] = 1; + table.[4* 1+3] = 32898; table.[4* 1+2] = 32898; table.[4* 1+1] = 32898; table.[4* 1+0] = 32898; + table.[4* 2+3] = 9223372036854808714; table.[4* 2+2] = 9223372036854808714; table.[4* 2+1] = 9223372036854808714; table.[4* 2+0] = 9223372036854808714; + table.[4* 3+3] = 9223372039002292224; table.[4* 3+2] = 9223372039002292224; table.[4* 3+1] = 9223372039002292224; table.[4* 3+0] = 9223372039002292224; + table.[4* 4+3] = 32907; table.[4* 4+2] = 32907; table.[4* 4+1] = 32907; table.[4* 4+0] = 32907; + table.[4* 5+3] = 2147483649; table.[4* 5+2] = 2147483649; table.[4* 5+1] = 2147483649; table.[4* 5+0] = 2147483649; + table.[4* 6+3] = 9223372039002292353; table.[4* 6+2] = 9223372039002292353; table.[4* 6+1] = 9223372039002292353; table.[4* 6+0] = 9223372039002292353; + table.[4* 7+3] = 9223372036854808585; table.[4* 7+2] = 9223372036854808585; table.[4* 7+1] = 9223372036854808585; table.[4* 7+0] = 9223372036854808585; + table.[4* 8+3] = 138; table.[4* 8+2] = 138; table.[4* 8+1] = 138; table.[4* 8+0] = 138; + table.[4* 9+3] = 136; table.[4* 9+2] = 136; table.[4* 9+1] = 136; table.[4* 9+0] = 136; + table.[4*10+3] = 2147516425; table.[4*10+2] = 2147516425; table.[4*10+1] = 2147516425; table.[4*10+0] = 2147516425; + table.[4*11+3] = 2147483658; table.[4*11+2] = 2147483658; table.[4*11+1] = 2147483658; table.[4*11+0] = 2147483658; + table.[4*12+3] = 2147516555; table.[4*12+2] = 2147516555; table.[4*12+1] = 2147516555; table.[4*12+0] = 2147516555; + table.[4*13+3] = 9223372036854775947; table.[4*13+2] = 9223372036854775947; table.[4*13+1] = 9223372036854775947; table.[4*13+0] = 9223372036854775947; + table.[4*14+3] = 9223372036854808713; table.[4*14+2] = 9223372036854808713; table.[4*14+1] = 9223372036854808713; table.[4*14+0] = 9223372036854808713; + table.[4*15+3] = 9223372036854808579; table.[4*15+2] = 9223372036854808579; table.[4*15+1] = 9223372036854808579; table.[4*15+0] = 9223372036854808579; + table.[4*16+3] = 9223372036854808578; table.[4*16+2] = 9223372036854808578; table.[4*16+1] = 9223372036854808578; table.[4*16+0] = 9223372036854808578; + table.[4*17+3] = 9223372036854775936; table.[4*17+2] = 9223372036854775936; table.[4*17+1] = 9223372036854775936; table.[4*17+0] = 9223372036854775936; + table.[4*18+3] = 32778; table.[4*18+2] = 32778; table.[4*18+1] = 32778; table.[4*18+0] = 32778; + table.[4*19+3] = 9223372039002259466; table.[4*19+2] = 9223372039002259466; table.[4*19+1] = 9223372039002259466; table.[4*19+0] = 9223372039002259466; + table.[4*20+3] = 9223372039002292353; table.[4*20+2] = 9223372039002292353; table.[4*20+1] = 9223372039002292353; table.[4*20+0] = 9223372039002292353; + table.[4*21+3] = 9223372036854808704; table.[4*21+2] = 9223372036854808704; table.[4*21+1] = 9223372036854808704; table.[4*21+0] = 9223372036854808704; + table.[4*22+3] = 2147483649; table.[4*22+2] = 2147483649; table.[4*22+1] = 2147483649; table.[4*22+0] = 2147483649; + table.[4*23+3] = 9223372039002292232; table.[4*23+2] = 9223372039002292232; table.[4*23+1] = 9223372039002292232; table.[4*23+0] = 9223372039002292232; + r.[0] = W64.of_int table.[4*off + 0]; + r.[1] = W64.of_int table.[4*off + 1]; + r.[2] = W64.of_int table.[4*off + 2]; + r.[3] = W64.of_int table.[4*off + 3]; + return r; + } + + proc __KeccakF1600 (_A00:W64.t Array4.t, _A01:W64.t Array4.t, _A20:W64.t Array4.t, _A31:W64.t Array4.t, + _A21:W64.t Array4.t, _A41:W64.t Array4.t, _A11:W64.t Array4.t + ) : W64.t Array4.t * W64.t Array4.t * W64.t Array4.t * W64.t Array4.t * + W64.t Array4.t * W64.t Array4.t * W64.t Array4.t = { + + var rhotates_left:W64.t; + var rhotates_right:W64.t; + var iotas:int; + var i:W32.t; + var zf:bool; + var _C00:W64.t Array4.t; + var _C14:W64.t Array4.t; + var _T:W64.t Array4.t Array9.t; + var _D14:W64.t Array4.t; + var _D00:W64.t Array4.t; + var _0:bool; + var _1:bool; + var _2:bool; + var aux : W64.t Array4.t; + var aux2 : W64.t Array4.t; + _T <- witness; + iotas <- 0; + i <- (W32.of_int 24); + _C00 <@ Ops.iVPSHUF_D_256(_A20,(W8.of_int 78)); + _C14 <@ Ops.ilxor4u64(_A41,_A31); + _T.[2] <@ Ops.ilxor4u64(_A21,_A11); + _C14 <@ Ops.ilxor4u64(_C14,_A01); + _C14 <@ Ops.ilxor4u64(_C14,_T.[2]); + _T.[4] <- Ops.iVPERMQ(_C14,(W8.of_int 147)); + _C00 <@ Ops.ilxor4u64(_C00,_A20); + _T.[0] <- Ops.iVPERMQ(_C00,(W8.of_int 78)); + _T.[1] <- Ops.ivshr64u256(_C14, (W8.of_int 63)); + _T.[2] <- Ops.ivadd64u256(_C14, _C14); + _T.[1] <@ Ops.ilor4u64(_T.[1],_T.[2]); + _D14 <- Ops.iVPERMQ(_T.[1],(W8.of_int 57)); + _D00 <@ Ops.ilxor4u64(_T.[1],_T.[4]); + _D00 <- Ops.iVPERMQ(_D00,(W8.of_int 0)); + _C00 <@ Ops.ilxor4u64(_C00,_A00); + _C00 <@ Ops.ilxor4u64(_C00,_T.[0]); + _T.[0] <- Ops.ivshr64u256(_C00, (W8.of_int 63)); + _T.[1] <- Ops.ivadd64u256(_C00, _C00); + _T.[1] <@ Ops.ilor4u64(_T.[1],_T.[0]); + _A20 <@ Ops.ilxor4u64(_A20,_D00); + _A00 <@ Ops.ilxor4u64(_A00,_D00); + _D14 <- Ops.iVPBLEN_D_D_256(_D14,_T.[1], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + _T.[4] <- Ops.iVPBLEN_D_D_256(_T.[4],_C00, + (W8.of_int (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + _D14 <@ Ops.ilxor4u64(_D14,_T.[4]); + aux <@ rhotates_left(0); _T.[3] <@ Ops.iVPSLLV_4u64(_A20,aux); + aux <@ rhotates_right(0); _A20 <@ Ops.iVPSRLV_4u64(_A20,aux); + _A20 <@ Ops.ilor4u64(_A20,_T.[3]); + _A31 <@ Ops.ilxor4u64(_A31,_D14); + aux <@ rhotates_left(2); _T.[4] <@ Ops.iVPSLLV_4u64(_A31,aux); + aux <@ rhotates_right(2); _A31 <@ Ops.iVPSRLV_4u64(_A31,aux); + _A31 <@ Ops.ilor4u64(_A31,_T.[4]); + _A21 <@ Ops.ilxor4u64(_A21,_D14); + aux <@ rhotates_left(3); _T.[5] <@ Ops.iVPSLLV_4u64(_A21,aux); + aux <@ rhotates_right(3); _A21 <@ Ops.iVPSRLV_4u64(_A21,aux); + _A21 <@ Ops.ilor4u64(_A21,_T.[5]); + _A41 <@ Ops.ilxor4u64(_A41,_D14); + aux <@ rhotates_left(4); _T.[6] <@ Ops.iVPSLLV_4u64(_A41,aux); + aux <@ rhotates_right(4); _A41 <@ Ops.iVPSRLV_4u64(_A41,aux); + _A41 <@ Ops.ilor4u64(_A41,_T.[6]); + _A11 <@ Ops.ilxor4u64(_A11,_D14); + _T.[3] <- Ops.iVPERMQ(_A20,(W8.of_int 141)); + _T.[4] <- Ops.iVPERMQ(_A31,(W8.of_int 141)); + aux <@ rhotates_left(5); _T.[7] <@ Ops.iVPSLLV_4u64(_A11,aux); + aux <@ rhotates_right(5); _T.[1] <@ Ops.iVPSRLV_4u64(_A11,aux); + _T.[1] <@ Ops.ilor4u64(_T.[1],_T.[7]); + _A01 <@ Ops.ilxor4u64(_A01,_D14); + _T.[5] <- Ops.iVPERMQ(_A21,(W8.of_int 27)); + _T.[6] <- Ops.iVPERMQ(_A41,(W8.of_int 114)); + aux <@ rhotates_left(1); _T.[8] <@ Ops.iVPSLLV_4u64(_A01 ,aux); + aux <@ rhotates_right(1); _T.[2] <@ Ops.iVPSRLV_4u64(_A01 ,aux); + _T.[2] <@ Ops.ilor4u64(_T.[2],_T.[8]); + _T.[7] <@ Ops.iVPSRLDQ_256(_T.[1],(W8.of_int 8)); + _T.[0] <@ Ops.ilandn4u64(_T.[1],_T.[7]); + _A31 <@ Ops.iVPBLEN_D_D_256(_T.[2],_T.[6], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + _T.[8] <@ Ops.iVPBLEN_D_D_256(_T.[4],_T.[2], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + _A41 <@ Ops.iVPBLEN_D_D_256(_T.[3], _T.[4], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + _T.[7] <@ Ops.iVPBLEN_D_D_256(_T.[2], _T.[3], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + _A31 <@ Ops.iVPBLEN_D_D_256(_A31 ,_T.[4], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + _T.[8] <@ Ops.iVPBLEN_D_D_256(_T.[8], _T.[5], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + _A41 <@ Ops.iVPBLEN_D_D_256(_A41, _T.[2], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + _T.[7] <@ Ops.iVPBLEN_D_D_256(_T.[7], _T.[6], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + _A31 <@ Ops.iVPBLEN_D_D_256(_A31, _T.[5], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + _T.[8] <@ Ops.iVPBLEN_D_D_256(_T.[8], _T.[6], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + _A41 <@ Ops.iVPBLEN_D_D_256(_A41, _T.[6], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + _T.[7] <@ Ops.iVPBLEN_D_D_256(_T.[7], _T.[4], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + _A31 <@ Ops.ilandn4u64(_A31,_T.[8]); + _A41 <@ Ops.ilandn4u64(_A41,_T.[7]); + _A11 <@ Ops.iVPBLEN_D_D_256(_T.[5],_T.[2], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + _T.[8] <@ Ops.iVPBLEN_D_D_256(_T.[3], _T.[5], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + _A31 <@ Ops.ilxor4u64(_A31,_T.[3]); + _A11 <@ Ops.iVPBLEN_D_D_256(_A11,_T.[3], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + _T.[8] <@ Ops.iVPBLEN_D_D_256(_T.[8],_T.[4], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + _A41 <@ Ops.ilxor4u64(_A41,_T.[5]); + _A11 <@ Ops.iVPBLEN_D_D_256(_A11, _T.[4], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + _T.[8] <@ Ops.iVPBLEN_D_D_256(_T.[8], _T.[2], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + _A11 <@ Ops.ilandn4u64(_A11,_T.[8]); + _A11 <@ Ops.ilxor4u64(_A11,_T.[6]); + _A21 <@ Ops.iVPERMQ(_T.[1],(W8.of_int 30)); + _T.[8] <@ Ops.iVPBLEN_D_D_256(_A21, _A00, + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + _A01 <@ Ops.iVPERMQ(_T.[1],(W8.of_int 57)); + _A01 <@ Ops.iVPBLEN_D_D_256(_A01, _A00, + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + _A01 <@ Ops.ilandn4u64(_A01,_T.[8]); + _A20 <@ Ops.iVPBLEN_D_D_256(_T.[4], _T.[5], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + _T.[7] <@ Ops.iVPBLEN_D_D_256(_T.[6], _T.[4], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + _A20 <@ Ops.iVPBLEN_D_D_256(_A20, _T.[6], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + _T.[7] <@ Ops.iVPBLEN_D_D_256(_T.[7], _T.[3], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + _A20 <@ Ops.iVPBLEN_D_D_256(_A20, _T.[3], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + _T.[7] <@ Ops.iVPBLEN_D_D_256(_T.[7], _T.[5], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + _A20 <@ Ops.ilandn4u64(_A20,_T.[7]); + _A20 <@ Ops.ilxor4u64(_A20,_T.[2]); + _T.[0] <@ Ops.iVPERMQ(_T.[0],(W8.of_int 0)); + _A31 <@ Ops.iVPERMQ(_A31,(W8.of_int 27)); + _A41 <@ Ops.iVPERMQ(_A41,(W8.of_int 141)); + _A11 <@ Ops.iVPERMQ(_A11,(W8.of_int 114)); + _A21 <@ Ops.iVPBLEN_D_D_256(_T.[6], _T.[3], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + _T.[7] <@ Ops.iVPBLEN_D_D_256(_T.[5], _T.[6], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + _A21 <@ Ops.iVPBLEN_D_D_256(_A21, _T.[5], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + _T.[7] <@ Ops.iVPBLEN_D_D_256(_T.[7], _T.[2], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + _A21 <@ Ops.iVPBLEN_D_D_256(_A21, _T.[2], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + _T.[7] <@ Ops.iVPBLEN_D_D_256(_T.[7], _T.[3], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + _A21 <@ Ops.ilandn4u64(_A21,_T.[7]); + _A00 <@ Ops.ilxor4u64(_A00,_T.[0]); + _A01 <@ Ops.ilxor4u64(_A01,_T.[1]); + _A21 <@ Ops.ilxor4u64(_A21,_T.[4]); + aux <@ iotas(iotas); _A00 <@ Ops.ilxor4u64(_A00,aux); + iotas <- (iotas + 1); + ( _0, _1, _2, zf, i) <- x86_DEC_32 i; + while ((! zf)) { + _C00 <@ Ops.iVPSHUF_D_256(_A20,(W8.of_int 78)); + _C14 <@ Ops.ilxor4u64(_A41,_A31); + _T.[2] <@ Ops.ilxor4u64(_A21,_A11); + _C14 <@ Ops.ilxor4u64(_C14,_A01); + _C14 <@ Ops.ilxor4u64(_C14,_T.[2]); + _T.[4] <@ Ops.iVPERMQ(_C14,(W8.of_int 147)); + _C00 <@ Ops.ilxor4u64(_C00,_A20); + _T.[0] <@ Ops.iVPERMQ(_C00,(W8.of_int 78)); + _T.[1] <@ Ops.ivshr64u256(_C14, (W8.of_int 63)); + _T.[2] <@ Ops.ivadd64u256(_C14, _C14); + _T.[1] <@ Ops.ilor4u64(_T.[1],_T.[2]); + _D14 <@ Ops.iVPERMQ(_T.[1],(W8.of_int 57)); + _D00 <@ Ops.ilxor4u64(_T.[1],_T.[4]); + _D00 <@ Ops.iVPERMQ(_D00,(W8.of_int 0)); + _C00 <@ Ops.ilxor4u64(_C00,_A00); + _C00 <@ Ops.ilxor4u64(_C00,_T.[0]); + _T.[0] <@ Ops.ivshr64u256(_C00, (W8.of_int 63)); + _T.[1] <@ Ops.ivadd64u256(_C00, _C00); + _T.[1] <@ Ops.ilor4u64(_T.[1],_T.[0]); + _A20 <@ Ops.ilxor4u64(_A20,_D00); + _A00 <@ Ops.ilxor4u64(_A00,_D00); + _D14 <@ Ops.iVPBLEN_D_D_256(_D14,_T.[1], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + _T.[4] <@ Ops.iVPBLEN_D_D_256(_T.[4],_C00, + (W8.of_int (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + _D14 <@ Ops.ilxor4u64(_D14,_T.[4]); + aux <@ rhotates_left(0); _T.[3] <@ Ops.iVPSLLV_4u64(_A20,aux); + aux <@ rhotates_right(0); _A20 <@ Ops.iVPSRLV_4u64(_A20,aux); + _A20 <@ Ops.ilor4u64(_A20,_T.[3]); + _A31 <@ Ops.ilxor4u64(_A31,_D14); + aux <@ rhotates_left(2); _T.[4] <@ Ops.iVPSLLV_4u64(_A31,aux); + aux <@ rhotates_right(2); _A31 <@ Ops.iVPSRLV_4u64(_A31,aux); + _A31 <@ Ops.ilor4u64(_A31,_T.[4]); + _A21 <@ Ops.ilxor4u64(_A21,_D14); + aux <@ rhotates_left(3); _T.[5] <@ Ops.iVPSLLV_4u64(_A21,aux); + aux <@ rhotates_right(3); _A21 <@ Ops.iVPSRLV_4u64(_A21,aux); + _A21 <@ Ops.ilor4u64(_A21,_T.[5]); + _A41 <@ Ops.ilxor4u64(_A41,_D14); + aux <@ rhotates_left(4); _T.[6] <@ Ops.iVPSLLV_4u64(_A41,aux); + aux <@ rhotates_right(4); _A41 <@ Ops.iVPSRLV_4u64(_A41,aux); + _A41 <@ Ops.ilor4u64(_A41,_T.[6]); + _A11 <@ Ops.ilxor4u64(_A11,_D14); + _T.[3] <@ Ops.iVPERMQ(_A20,(W8.of_int 141)); + _T.[4] <@ Ops.iVPERMQ(_A31,(W8.of_int 141)); + aux <@ rhotates_left(5); _T.[7] <@ Ops.iVPSLLV_4u64(_A11,aux); + aux <@ rhotates_right(5); _T.[1] <@ Ops.iVPSRLV_4u64(_A11,aux); + _T.[1] <@ Ops.ilor4u64(_T.[1],_T.[7]); + _A01 <@ Ops.ilxor4u64(_A01,_D14); + _T.[5] <@ Ops.iVPERMQ(_A21,(W8.of_int 27)); + _T.[6] <@ Ops.iVPERMQ(_A41,(W8.of_int 114)); + aux <@ rhotates_left(1); _T.[8] <@ Ops.iVPSLLV_4u64(_A01 ,aux); + aux <@ rhotates_right(1); _T.[2] <@ Ops.iVPSRLV_4u64(_A01 ,aux); + _T.[2] <@ Ops.ilor4u64(_T.[2],_T.[8]); + _T.[7] <@ Ops.iVPSRLDQ_256(_T.[1],(W8.of_int 8)); + _T.[0] <@ Ops.ilandn4u64(_T.[1],_T.[7]); + _A31 <@ Ops.iVPBLEN_D_D_256(_T.[2], _T.[6], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + _T.[8] <@ Ops.iVPBLEN_D_D_256(_T.[4], _T.[2], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + _A41 <@ Ops.iVPBLEN_D_D_256(_T.[3], _T.[4], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + _T.[7] <@ Ops.iVPBLEN_D_D_256(_T.[2], _T.[3], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + _A31 <@ Ops.iVPBLEN_D_D_256(_A31, _T.[4], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + _T.[8] <@ Ops.iVPBLEN_D_D_256(_T.[8], _T.[5], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + _A41 <@ Ops.iVPBLEN_D_D_256(_A41, _T.[2], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + _T.[7] <@ Ops.iVPBLEN_D_D_256(_T.[7], _T.[6], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + _A31 <@ Ops.iVPBLEN_D_D_256(_A31, _T.[5], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + _T.[8] <@ Ops.iVPBLEN_D_D_256(_T.[8], _T.[6], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + _A41 <@ Ops.iVPBLEN_D_D_256(_A41, _T.[6], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + _T.[7] <@ Ops.iVPBLEN_D_D_256(_T.[7], _T.[4], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + _A31 <@ Ops.ilandn4u64(_A31,_T.[8]); + _A41 <@ Ops.ilandn4u64(_A41,_T.[7]); + _A11 <@ Ops.iVPBLEN_D_D_256(_T.[5], _T.[2], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + _T.[8] <@ Ops.iVPBLEN_D_D_256(_T.[3], _T.[5], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + _A31 <@ Ops.ilxor4u64(_A31,_T.[3]); + _A11 <@ Ops.iVPBLEN_D_D_256(_A11, _T.[3], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + _T.[8] <@ Ops.iVPBLEN_D_D_256(_T.[8], _T.[4], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + _A41 <@ Ops.ilxor4u64(_A41,_T.[5]); + _A11 <@ Ops.iVPBLEN_D_D_256(_A11, _T.[4], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + _T.[8] <@ Ops.iVPBLEN_D_D_256(_T.[8], _T.[2], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + _A11 <@ Ops.ilandn4u64(_A11,_T.[8]); + _A11 <@ Ops.ilxor4u64(_A11,_T.[6]); + _A21 <@ Ops.iVPERMQ(_T.[1],(W8.of_int 30)); + _T.[8] <@ Ops.iVPBLEN_D_D_256(_A21, _A00, + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + _A01 <@ Ops.iVPERMQ(_T.[1],(W8.of_int 57)); + _A01 <@ Ops.iVPBLEN_D_D_256(_A01 ,_A00, + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + _A01 <@ Ops.ilandn4u64(_A01,_T.[8]); + _A20 <@ Ops.iVPBLEN_D_D_256(_T.[4], _T.[5], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + _T.[7] <@ Ops.iVPBLEN_D_D_256(_T.[6], _T.[4], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + _A20 <@ Ops.iVPBLEN_D_D_256(_A20, _T.[6], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + _T.[7] <@ Ops.iVPBLEN_D_D_256(_T.[7], _T.[3], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + _A20 <@ Ops.iVPBLEN_D_D_256(_A20, _T.[3], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + _T.[7] <@ Ops.iVPBLEN_D_D_256(_T.[7], _T.[5], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + _A20 <@ Ops.ilandn4u64(_A20,_T.[7]); + _A20 <@ Ops.ilxor4u64(_A20,_T.[2]); + _T.[0] <@ Ops.iVPERMQ(_T.[0],(W8.of_int 0)); + _A31 <@ Ops.iVPERMQ(_A31,(W8.of_int 27)); + _A41 <@ Ops.iVPERMQ(_A41,(W8.of_int 141)); + _A11 <@ Ops.iVPERMQ(_A11,(W8.of_int 114)); + _A21 <@ Ops.iVPBLEN_D_D_256(_T.[6], _T.[3], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + _T.[7] <@ Ops.iVPBLEN_D_D_256(_T.[5], _T.[6], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + _A21 <@ Ops.iVPBLEN_D_D_256(_A21, _T.[5], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + _T.[7] <@ Ops.iVPBLEN_D_D_256(_T.[7] ,_T.[2], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + _A21 <@ Ops.iVPBLEN_D_D_256(_A21, _T.[2], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + _T.[7] <@ Ops.iVPBLEN_D_D_256(_T.[7], _T.[3], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + _A21 <@ Ops.ilandn4u64(_A21,_T.[7]); + _A00 <@ Ops.ilxor4u64(_A00,_T.[0]); + _A01 <@ Ops.ilxor4u64(_A01,_T.[1]); + _A21 <@ Ops.ilxor4u64(_A21,_T.[4]); + aux2 <@ iotas(iotas); _A00 <@ Ops.ilxor4u64(_A00,aux2); + iotas <- (iotas + 1); + ( _0, _1, _2, zf, i) <- x86_DEC_32 i; + } + return (_A00, _A01, _A20, _A31, _A21, _A41, _A11); + } +}. + +require import Keccak_f1600_ref. +import Array25. + +(* + ($A00, # [0][0] [0][0] [0][0] [0][0] + $A01, # [0][4] [0][3] [0][2] [0][1] + $A20, # [3][0] [1][0] [4][0] [2][0] + $A31, # [2][4] [4][3] [1][2] [3][1] + $A21, # [3][4] [1][3] [4][2] [2][1] + $A41, # [1][4] [2][3] [3][2] [4][1] + $A11) = # [4][4] [3][3] [2][2] [1][1] +*) + +op index x y = 5*x+y. + +op equiv_states (A00 A01 A20 A31 A21 A41 A11 : W64.t Array4.t, st : W64.t Array25.t) : bool = + A00.[3] = st.[index 0 0] /\ A00.[2] = st.[index 0 0] /\ A00.[1] = st.[index 0 0] /\ A00.[0] = st.[index 0 0] /\ + A01.[3] = st.[index 0 4] /\ A01.[2] = st.[index 0 3] /\ A01.[1] = st.[index 0 2] /\ A01.[0] = st.[index 0 1] /\ + A20.[3] = st.[index 3 0] /\ A20.[2] = st.[index 1 0] /\ A20.[1] = st.[index 4 0] /\ A20.[0] = st.[index 2 0] /\ + A31.[3] = st.[index 2 4] /\ A31.[2] = st.[index 4 3] /\ A31.[1] = st.[index 1 2] /\ A31.[0] = st.[index 3 1] /\ + A21.[3] = st.[index 3 4] /\ A21.[2] = st.[index 1 3] /\ A21.[1] = st.[index 4 2] /\ A21.[0] = st.[index 2 1] /\ + A41.[3] = st.[index 1 4] /\ A41.[2] = st.[index 2 3] /\ A41.[1] = st.[index 3 2] /\ A41.[0] = st.[index 4 1] /\ + A11.[3] = st.[index 4 4] /\ A11.[2] = st.[index 3 3] /\ A11.[1] = st.[index 2 2] /\ A11.[0] = st.[index 1 1]. + +op equiv_states_chi (A00 A01 A20 A31 A21 A41 A11 : W64.t Array4.t, st : W64.t Array25.t) : bool = + A00.[3] = st.[index 0 0] /\ A00.[2] = st.[index 0 0] /\ A00.[1] = st.[index 0 0] /\ A00.[0] = st.[index 0 0] /\ + A01.[3] = st.[index 0 4] /\ A01.[2] = st.[index 0 3] /\ A01.[1] = st.[index 0 2] /\ A01.[0] = st.[index 0 1] /\ + A20.[3] = st.[index 3 0] /\ A20.[2] = st.[index 1 0] /\ A20.[1] = st.[index 4 0] /\ A20.[0] = st.[index 2 0] /\ + A31.[3] = st.[index 3 1] /\ A31.[2] = st.[index 1 2] /\ A31.[1] = st.[index 4 3] /\ A31.[0] = st.[index 2 4] /\ + A21.[3] = st.[index 3 4] /\ A21.[2] = st.[index 1 3] /\ A21.[1] = st.[index 4 2] /\ A21.[0] = st.[index 2 1] /\ + A41.[3] = st.[index 3 2] /\ A41.[2] = st.[index 1 4] /\ A41.[1] = st.[index 4 1] /\ A41.[0] = st.[index 2 3] /\ + A11.[3] = st.[index 3 3] /\ A11.[2] = st.[index 1 1] /\ A11.[1] = st.[index 4 4] /\ A11.[0] = st.[index 2 2]. + +lemma dec : forall (x : W32.t), + 0 < to_uint x <= 24 => + to_uint (x86_DEC_32 x).`5 = to_uint x - 1 by admit. + +lemma decK : forall (x : W32.t), + (x86_DEC_32 x).`5 + W32.one = x by admit. + +lemma dec0 : forall (x : W32.t), + 0 < to_uint x <= 24 => + (x86_DEC_32 x).`4 <=> to_uint (x86_DEC_32 x).`5 = 0 by + admit. + +lemma rolcomp : (forall (x : W64.t), (x86_ROL_64 x W8.one).`3 = + (x `>>` W8.of_int 63) `|` (x + x)) by admit. + +lemma commor : forall (x y : W64.t), x `|` y = y `|` x by admit. + +lemma rol0 : forall x, (x86_ROL_64 x W8.zero).`3 = x by admit. + +lemma roln : forall x n, (x86_ROL_64 x (W8.of_int n)).`3 = + (x `>>` W8.of_int (64 - n)) `|` (x `<<` W8.of_int n) by admit. + +lemma correct_perm A00 A01 A20 A31 A21 A41 A11 st : + equiv [ M.permute ~ Mavx2_prevec.__KeccakF1600 : + equiv_states A00 A01 A20 A31 A21 A41 A11 st /\ + _A00{2} = A00 /\ _A01{2} = A01 /\ _A20{2} = A20 /\ _A31{2} = A31 /\ + _A21{2} = A21 /\ _A41{2} = A41 /\ _A11{2} = A11 /\ state{1} = st ==> + equiv_states res{2}.`1 res{2}.`2 res{2}.`3 res{2}.`4 res{2}.`5 res{2}.`6 res{2}.`7 res{1}]. +proc. +unroll {1} 2. +rcondt {1} 2. move => *. by auto => />. +seq 0 1 : #pre; first by auto => />. +sp 1 2. + +seq 2 118 : (#{~ _A00{2}}{~ _A01{2}}{~ _A20{2}}{~ _A31{2}}{~ _A21{2}}{~ _A41{2}}{~ _A11{2}}{~state{1}}pre /\ + equiv_states _A00{2} _A01{2} _A20{2} _A31{2} _A21{2} _A41{2} _A11{2} state{1}). + +seq 1 0 : (#pre /\ c{1} = W64.of_int 1). +inline *. +by auto => />. + +inline M.keccakP1600_round. + +sp 2 0. +inline M.theta. +sp 1 0. + + +swap {2} [20..21] 3. +swap {2} 30 -5. +swap {2} 36 -13. +swap {2} 42 -17. +swap {2} 48 -21. +swap {2} 56 -31. + +seq 9 29 : (#{/~state{1}}post /\ c0{1} = W64.of_int 1 /\ + equiv_states _A00{2} _A01{2} _A20{2} _A31{2} _A21{2} _A41{2} _A11{2} state0{1}). + +unroll for {1} 4. +unroll for {1} 6. +unroll for {1} 23. +unroll for {1} 19. +unroll for {1} 45. +unroll for {1} 58. +unroll for {1} 70. +unroll for {1} 101. +unroll for {1} 102. +unroll for {1} 114. +unroll for {1} 126. +unroll for {1} 138. +unroll for {1} 150. +inline *. +rcondt {2} 4; first by move => *; auto => />. +rcondf {2} 40; first by move => *; auto => />. +rcondt {2} 40; first by move => *; auto => />. +rcondf {2} 55; first by move => *; auto => />. +rcondf {2} 55; first by move => *; auto => />. +rcondt {2} 55; first by move => *; auto => />. +rcondf {2} 84; first by move => *; auto => />. +rcondf {2} 84; first by move => *; auto => />. +rcondf {2} 84; first by move => *; auto => />. +rcondt {2} 84; first by move => *; auto => />. +rcondf {2} 99; first by move => *; auto => />. +rcondf {2} 99; first by move => *; auto => />. +rcondf {2} 99; first by move => *; auto => />. +rcondf {2} 99; first by move => *; auto => />. +rcondf {2} 99; first by move => *; auto => />. +rcondf {2} 99; first by move => *; auto => />. +rcondf {2} 99; first by move => *; auto => />. +rcondt {2} 99; first by move => *; auto => />. +rcondt {2} 143; first by move => *; auto => />. +rcondf {2} 152; first by move => *; auto => />. +rcondt {2} 152; first by move => *; auto => />. + +wp;skip. +move => &1 &2. +rewrite /equiv_states /index. +simplify. + +by smt(W64.xorwA W64.xorwC W64.xorw0 W64.xorwK rolcomp commor). + +(* Rho PI *) +inline M.rho M.pi. + +seq 11 34 : (#{/~ state{1}}post /\ c0{1} = W64.of_int 1 /\ + equiv_states_chi _A00{2} _T{2}.[1] _T{2}.[2] _T{2}.[3] _T{2}.[4] _T{2}.[5] _T{2}.[6] state0{1}). + +unroll for {1} 3. +unroll for {1} 4. +unroll for {1} 41. +unroll for {1} 78. +unroll for {1} 115. +unroll for {1} 152. +unroll for {1} 192. +unroll for {1} 268. +unroll for {1} 269. +unroll for {1} 291. +unroll for {1} 313. +unroll for {1} 335. +unroll for {1} 357. + +inline *. + +rcondf {2} 328; first by auto => />. +rcondf {2} 328; first by auto => />. +rcondf {2} 328; first by auto => />. +rcondf {2} 328; first by auto => />. +rcondt {2} 328; first by auto => />. +rcondf {2} 336; first by auto => />. +rcondf {2} 336; first by auto => />. +rcondf {2} 336; first by auto => />. +rcondf {2} 336; first by auto => />. +rcondt {2} 336; first by auto => />. +rcondf {2} 425; first by auto => />. +rcondf {2} 425; first by auto => />. +rcondf {2} 425; first by auto => />. +rcondf {2} 425; first by auto => />. +rcondf {2} 425; first by auto => />. +rcondt {2} 425; first by auto => />. +rcondf {2} 433; first by auto => />. +rcondf {2} 433; first by auto => />. +rcondf {2} 433; first by auto => />. +rcondf {2} 433; first by auto => />. +rcondf {2} 433; first by auto => />. +rcondf {2} 433; first by auto => />. +rcondt {2} 433; first by auto => />. + +wp;skip. +move => &1 &2. +rewrite /equiv_states /equiv_states_chi /index. +simplify. + +by smt(roln rol0). + +(* Chi *) +inline M.chi. + +seq 5 53 : (#{~state0{1}}pre /\ + equiv_states _A00{2} _A01{2} _A20{2} _A31{2} _A21{2} _A41{2} _A11{2} state0{1}). + +unroll for {1} 4. +unroll for {1} 5. +unroll for {1} 46. +unroll for {1} 58. +unroll for {1} 99. +unroll for {1} 111. +unroll for {1} 152. +unroll for {1} 164. +unroll for {1} 205. +unroll for {1} 217. +unroll for {1} 258. + +inline *. +rcondf {2} 4; first by auto => />. +rcondt {2} 4; first by auto => />. +rcondf {2} 20; first by auto => />. +rcondf {2} 20; first by auto => />. +rcondt {2} 20; first by auto => />. +rcondf {2} 29; first by auto => />. +rcondf {2} 29; first by auto => />. +rcondt {2} 29; first by auto => />. +rcondf {2} 38; first by auto => />. +rcondf {2} 38; first by auto => />. +rcondt {2} 38; first by auto => />. +rcondf {2} 47; first by auto => />. +rcondf {2} 47; first by auto => />. +rcondt {2} 47; first by auto => />. +rcondf {2} 56; first by auto => />. +rcondf {2} 56; first by auto => />. +rcondf {2} 56; first by auto => />. +rcondt {2} 56; first by auto => />. +rcondf {2} 65; first by auto => />. +rcondf {2} 65; first by auto => />. +rcondf {2} 65; first by auto => />. +rcondt {2} 65; first by auto => />. +rcondf {2} 74; first by auto => />. +rcondf {2} 74; first by auto => />. +rcondf {2} 74; first by auto => />. +rcondt {2} 74; first by auto => />. +rcondf {2} 83; first by auto => />. +rcondf {2} 83; first by auto => />. +rcondf {2} 83; first by auto => />. +rcondt {2} 83; first by auto => />. +rcondt {2} 92; first by auto => />. +rcondt {2} 101; first by auto => />. +rcondt {2} 110; first by auto => />. +rcondt {2} 119; first by auto => />. +rcondf {2} 142; first by auto => />. +rcondf {2} 142; first by auto => />. +rcondt {2} 142; first by auto => />. +rcondf {2} 151; first by auto => />. +rcondf {2} 151; first by auto => />. +rcondt {2} 151; first by auto => />. +rcondf {2} 167; first by auto => />. +rcondf {2} 167; first by auto => />. +rcondf {2} 167; first by auto => />. +rcondt {2} 167; first by auto => />. +rcondf {2} 176; first by auto => />. +rcondf {2} 176; first by auto => />. +rcondf {2} 176; first by auto => />. +rcondt {2} 176; first by auto => />. +rcondt {2} 192; first by auto => />. +rcondt {2} 201; first by auto => />. +rcondf {2} 223; first by auto => />. +rcondf {2} 223; first by auto => />. +rcondf {2} 223; first by auto => />. +rcondf {2} 223; first by auto => />. +rcondf {2} 223; first by auto => />. +rcondf {2} 223; first by auto => />. +rcondf {2} 223; first by auto => />. +rcondf {2} 223; first by auto => />. +rcondt {2} 223; first by auto => />. +rcondf {2} 232; first by auto => />. +rcondf {2} 232; first by auto => />. +rcondf {2} 232; first by auto => />. +rcondt {2} 232; first by auto => />. +rcondf {2} 240; first by auto => />. +rcondf {2} 240; first by auto => />. +rcondf {2} 240; first by auto => />. +rcondt {2} 240; first by auto => />. +rcondt {2} 249; first by auto => />. +rcondf {2} 265; first by auto => />. +rcondf {2} 265; first by auto => />. +rcondt {2} 265; first by auto => />. +rcondf {2} 274; first by auto => />. +rcondf {2} 274; first by auto => />. +rcondt {2} 274; first by auto => />. +rcondf {2} 283; first by auto => />. +rcondf {2} 283; first by auto => />. +rcondf {2} 283; first by auto => />. +rcondt {2} 283; first by auto => />. +rcondf {2} 292; first by auto => />. +rcondf {2} 292; first by auto => />. +rcondf {2} 292; first by auto => />. +rcondt {2} 292; first by auto => />. +rcondt {2} 301; first by auto => />. +rcondt {2} 310; first by auto => />. +rcondf {2} 332; first by auto => />. +rcondf {2} 332; first by auto => />. +rcondf {2} 332; first by auto => />. +rcondf {2} 332; first by auto => />. +rcondf {2} 332; first by auto => />. +rcondf {2} 332; first by auto => />. +rcondf {2} 332; first by auto => />. +rcondt {2} 332; first by auto => />. +rcondf {2} 340; first by auto => />. +rcondf {2} 340; first by auto => />. +rcondf {2} 340; first by auto => />. +rcondf {2} 340; first by auto => />. +rcondf {2} 340; first by auto => />. +rcondt {2} 340; first by auto => />. +rcondf {2} 348; first by auto => />. +rcondf {2} 348; first by auto => />. +rcondf {2} 348; first by auto => />. +rcondf {2} 348; first by auto => />. +rcondt {2} 348; first by auto => />. +rcondf {2} 356; first by auto => />. +rcondf {2} 356; first by auto => />. +rcondf {2} 356; first by auto => />. +rcondf {2} 356; first by auto => />. +rcondf {2} 356; first by auto => />. +rcondf {2} 356; first by auto => />. +rcondt {2} 356; first by auto => />. +rcondf {2} 365; first by auto => />. +rcondf {2} 365; first by auto => />. +rcondt {2} 365; first by auto => />. +rcondf {2} 374; first by auto => />. +rcondf {2} 374; first by auto => />. +rcondt {2} 374; first by auto => />. +rcondf {2} 383; first by auto => />. +rcondf {2} 383; first by auto => />. +rcondf {2} 383; first by auto => />. +rcondt {2} 383; first by auto => />. +rcondf {2} 392; first by auto => />. +rcondf {2} 392; first by auto => />. +rcondf {2} 392; first by auto => />. +rcondt {2} 392; first by auto => />. +rcondt {2} 401; first by auto => />. +rcondt {2} 410; first by auto => />. + +wp. skip. +move => &1 &2. +rewrite /equiv_states /equiv_states_chi /index. +simplify. + +smt(@W64). + +inline *. + +wp;skip. +move => &1 &2. +rewrite /equiv_states /index. +simplify. +by progress => /#. + +seq 1 2 : (#{/~iotas{2}}{~round{1}}{~i{2}}{~st}pre /\ + iotas{2} = round{1} /\ + to_uint i{2} = 24 - round{1} /\ + ((to_uint i{2} = 0) <> round{1} < 24) /\ + (x86_DEC_32 (i{2} + W32.of_int 1)).`4 = zf{2} /\ + 0 < round{1} /\ + to_uint i{2} <= 24). + + auto => />. progress. + + +apply dec. smt(). +rewrite (dec). smt(@W32). smt(@W32). +rewrite (decK). smt(@W32). +smt(@W32 dec decK). + + +while (#pre). + +swap {2} 117 -116. + +seq 1 1 : (#pre /\ + aux2{2}.[0] = c{1} /\ + aux2{2}.[1] = c{1} /\ + aux2{2}.[2] = c{1} /\ + aux2{2}.[3] = c{1}). +inline *. +wp. skip. +move => &1 &2. +simplify. +progress. +case (round{1} = 0). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 1). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 2). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 3). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 4). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 5). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 6). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 7). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 8). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 9). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 10). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 11). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 12). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 13). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 14). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 15). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 16). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 17). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 18). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 19). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 20). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 21). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 22). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 23). move => r1. rewrite r1. simplify. by auto => />. +smt(). + +case (round{1} = 0). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 1). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 2). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 3). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 4). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 5). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 6). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 7). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 8). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 9). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 10). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 11). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 12). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 13). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 14). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 15). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 16). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 17). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 18). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 19). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 20). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 21). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 22). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 23). move => r1. rewrite r1. simplify. by auto => />. +smt(). + +case (round{1} = 0). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 1). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 2). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 3). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 4). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 5). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 6). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 7). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 8). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 9). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 10). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 11). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 12). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 13). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 14). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 15). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 16). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 17). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 18). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 19). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 20). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 21). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 22). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 23). move => r1. rewrite r1. simplify. by auto => />. +smt(). + +case (round{1} = 0). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 1). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 2). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 3). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 4). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 5). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 6). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 7). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 8). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 9). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 10). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 11). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 12). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 13). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 14). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 15). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 16). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 17). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 18). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 19). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 20). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 21). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 22). move => r1. rewrite r1. simplify. by auto => />. +case (round{1} = 23). move => r1. rewrite r1. simplify. by auto => />. +smt(). + +inline M.keccakP1600_round. + +sp 2 0. +inline M.theta. +sp 1 0. + +swap {2} [20..21] 3. +swap {2} 30 -5. +swap {2} 36 -13. +swap {2} 42 -17. +swap {2} 48 -21. +swap {2} 56 -31. + +seq 9 29 : (#{/~state{1}}{~a{1}}pre /\ + aux2{2}.[0] = c0{1} /\ + aux2{2}.[1] = c0{1} /\ + aux2{2}.[2] = c0{1} /\ + aux2{2}.[3] = c0{1} /\ + equiv_states _A00{2} _A01{2} _A20{2} _A31{2} _A21{2} _A41{2} _A11{2} state0{1}). + +unroll for {1} 4. +unroll for {1} 6. +unroll for {1} 23. +unroll for {1} 19. +unroll for {1} 45. +unroll for {1} 58. +unroll for {1} 70. +unroll for {1} 101. +unroll for {1} 102. +unroll for {1} 114. +unroll for {1} 126. +unroll for {1} 138. +unroll for {1} 150. +inline *. +rcondt {2} 4; first by move => *; auto => />. +rcondf {2} 40; first by move => *; auto => />. +rcondt {2} 40; first by move => *; auto => />. +rcondf {2} 55; first by move => *; auto => />. +rcondf {2} 55; first by move => *; auto => />. +rcondt {2} 55; first by move => *; auto => />. +rcondf {2} 84; first by move => *; auto => />. +rcondf {2} 84; first by move => *; auto => />. +rcondf {2} 84; first by move => *; auto => />. +rcondt {2} 84; first by move => *; auto => />. +rcondf {2} 99; first by move => *; auto => />. +rcondf {2} 99; first by move => *; auto => />. +rcondf {2} 99; first by move => *; auto => />. +rcondf {2} 99; first by move => *; auto => />. +rcondf {2} 99; first by move => *; auto => />. +rcondf {2} 99; first by move => *; auto => />. +rcondf {2} 99; first by move => *; auto => />. +rcondt {2} 99; first by move => *; auto => />. +rcondt {2} 143; first by move => *; auto => />. +rcondf {2} 152; first by move => *; auto => />. +rcondt {2} 152; first by move => *; auto => />. + +wp;skip. +move => &1 &2. +rewrite /equiv_states /index. +simplify. + +by smt(W64.xorwA W64.xorwC W64.xorw0 W64.xorwK rolcomp commor). + +(* Rho PI *) +inline M.rho M.pi. + +seq 11 34 : (#{/~ state0{1}}pre /\ + equiv_states_chi _A00{2} _T{2}.[1] _T{2}.[2] _T{2}.[3] _T{2}.[4] _T{2}.[5] _T{2}.[6] state0{1}). + +unroll for {1} 3. +unroll for {1} 4. +unroll for {1} 41. +unroll for {1} 78. +unroll for {1} 115. +unroll for {1} 152. +unroll for {1} 192. +unroll for {1} 268. +unroll for {1} 269. +unroll for {1} 291. +unroll for {1} 313. +unroll for {1} 335. +unroll for {1} 357. + +inline *. + +rcondf {2} 328; first by auto => />. +rcondf {2} 328; first by auto => />. +rcondf {2} 328; first by auto => />. +rcondf {2} 328; first by auto => />. +rcondt {2} 328; first by auto => />. +rcondf {2} 336; first by auto => />. +rcondf {2} 336; first by auto => />. +rcondf {2} 336; first by auto => />. +rcondf {2} 336; first by auto => />. +rcondt {2} 336; first by auto => />. +rcondf {2} 425; first by auto => />. +rcondf {2} 425; first by auto => />. +rcondf {2} 425; first by auto => />. +rcondf {2} 425; first by auto => />. +rcondf {2} 425; first by auto => />. +rcondt {2} 425; first by auto => />. +rcondf {2} 433; first by auto => />. +rcondf {2} 433; first by auto => />. +rcondf {2} 433; first by auto => />. +rcondf {2} 433; first by auto => />. +rcondf {2} 433; first by auto => />. +rcondf {2} 433; first by auto => />. +rcondt {2} 433; first by auto => />. + +wp;skip. +move => &1 &2. +rewrite /equiv_states /equiv_states_chi /index. +simplify. + +by smt(roln rol0). + +(* Chi *) +inline M.chi. + +seq 5 53 : (#{~state0{1}}pre /\ + equiv_states _A00{2} _A01{2} _A20{2} _A31{2} _A21{2} _A41{2} _A11{2} state0{1}). + +unroll for {1} 4. +unroll for {1} 5. +unroll for {1} 46. +unroll for {1} 58. +unroll for {1} 99. +unroll for {1} 111. +unroll for {1} 152. +unroll for {1} 164. +unroll for {1} 205. +unroll for {1} 217. +unroll for {1} 258. + +inline *. +rcondf {2} 4; first by auto => />. +rcondt {2} 4; first by auto => />. +rcondf {2} 20; first by auto => />. +rcondf {2} 20; first by auto => />. +rcondt {2} 20; first by auto => />. +rcondf {2} 29; first by auto => />. +rcondf {2} 29; first by auto => />. +rcondt {2} 29; first by auto => />. +rcondf {2} 38; first by auto => />. +rcondf {2} 38; first by auto => />. +rcondt {2} 38; first by auto => />. +rcondf {2} 47; first by auto => />. +rcondf {2} 47; first by auto => />. +rcondt {2} 47; first by auto => />. +rcondf {2} 56; first by auto => />. +rcondf {2} 56; first by auto => />. +rcondf {2} 56; first by auto => />. +rcondt {2} 56; first by auto => />. +rcondf {2} 65; first by auto => />. +rcondf {2} 65; first by auto => />. +rcondf {2} 65; first by auto => />. +rcondt {2} 65; first by auto => />. +rcondf {2} 74; first by auto => />. +rcondf {2} 74; first by auto => />. +rcondf {2} 74; first by auto => />. +rcondt {2} 74; first by auto => />. +rcondf {2} 83; first by auto => />. +rcondf {2} 83; first by auto => />. +rcondf {2} 83; first by auto => />. +rcondt {2} 83; first by auto => />. +rcondt {2} 92; first by auto => />. +rcondt {2} 101; first by auto => />. +rcondt {2} 110; first by auto => />. +rcondt {2} 119; first by auto => />. +rcondf {2} 142; first by auto => />. +rcondf {2} 142; first by auto => />. +rcondt {2} 142; first by auto => />. +rcondf {2} 151; first by auto => />. +rcondf {2} 151; first by auto => />. +rcondt {2} 151; first by auto => />. +rcondf {2} 167; first by auto => />. +rcondf {2} 167; first by auto => />. +rcondf {2} 167; first by auto => />. +rcondt {2} 167; first by auto => />. +rcondf {2} 176; first by auto => />. +rcondf {2} 176; first by auto => />. +rcondf {2} 176; first by auto => />. +rcondt {2} 176; first by auto => />. +rcondt {2} 192; first by auto => />. +rcondt {2} 201; first by auto => />. +rcondf {2} 223; first by auto => />. +rcondf {2} 223; first by auto => />. +rcondf {2} 223; first by auto => />. +rcondf {2} 223; first by auto => />. +rcondf {2} 223; first by auto => />. +rcondf {2} 223; first by auto => />. +rcondf {2} 223; first by auto => />. +rcondf {2} 223; first by auto => />. +rcondt {2} 223; first by auto => />. +rcondf {2} 232; first by auto => />. +rcondf {2} 232; first by auto => />. +rcondf {2} 232; first by auto => />. +rcondt {2} 232; first by auto => />. +rcondf {2} 240; first by auto => />. +rcondf {2} 240; first by auto => />. +rcondf {2} 240; first by auto => />. +rcondt {2} 240; first by auto => />. +rcondt {2} 249; first by auto => />. +rcondf {2} 265; first by auto => />. +rcondf {2} 265; first by auto => />. +rcondt {2} 265; first by auto => />. +rcondf {2} 274; first by auto => />. +rcondf {2} 274; first by auto => />. +rcondt {2} 274; first by auto => />. +rcondf {2} 283; first by auto => />. +rcondf {2} 283; first by auto => />. +rcondf {2} 283; first by auto => />. +rcondt {2} 283; first by auto => />. +rcondf {2} 292; first by auto => />. +rcondf {2} 292; first by auto => />. +rcondf {2} 292; first by auto => />. +rcondt {2} 292; first by auto => />. +rcondt {2} 301; first by auto => />. +rcondt {2} 310; first by auto => />. +rcondf {2} 332; first by auto => />. +rcondf {2} 332; first by auto => />. +rcondf {2} 332; first by auto => />. +rcondf {2} 332; first by auto => />. +rcondf {2} 332; first by auto => />. +rcondf {2} 332; first by auto => />. +rcondf {2} 332; first by auto => />. +rcondt {2} 332; first by auto => />. +rcondf {2} 340; first by auto => />. +rcondf {2} 340; first by auto => />. +rcondf {2} 340; first by auto => />. +rcondf {2} 340; first by auto => />. +rcondf {2} 340; first by auto => />. +rcondt {2} 340; first by auto => />. +rcondf {2} 348; first by auto => />. +rcondf {2} 348; first by auto => />. +rcondf {2} 348; first by auto => />. +rcondf {2} 348; first by auto => />. +rcondt {2} 348; first by auto => />. +rcondf {2} 356; first by auto => />. +rcondf {2} 356; first by auto => />. +rcondf {2} 356; first by auto => />. +rcondf {2} 356; first by auto => />. +rcondf {2} 356; first by auto => />. +rcondf {2} 356; first by auto => />. +rcondt {2} 356; first by auto => />. +rcondf {2} 365; first by auto => />. +rcondf {2} 365; first by auto => />. +rcondt {2} 365; first by auto => />. +rcondf {2} 374; first by auto => />. +rcondf {2} 374; first by auto => />. +rcondt {2} 374; first by auto => />. +rcondf {2} 383; first by auto => />. +rcondf {2} 383; first by auto => />. +rcondf {2} 383; first by auto => />. +rcondt {2} 383; first by auto => />. +rcondf {2} 392; first by auto => />. +rcondf {2} 392; first by auto => />. +rcondf {2} 392; first by auto => />. +rcondt {2} 392; first by auto => />. +rcondt {2} 401; first by auto => />. +rcondt {2} 410; first by auto => />. + +wp. skip. +move => &1 &2. +rewrite /equiv_states /equiv_states_chi /index. +simplify. + +smt(@W64). + +(* iota *) + +seq 2 1 : (#{/~ state0{1}}{~aux2{2}}{~c{1}}pre /\ + equiv_states _A00{2} _A01{2} _A20{2} _A31{2} _A21{2} _A41{2} _A11{2} + state{1}); first by inline *; wp; skip; rewrite /equiv_states /index; progress; smt(@W64). + +wp;skip;progress;smt(dec dec0 decK @W32). + +skip;progress. + +rewrite dec0. +split. rewrite to_uintD. smt(@W32). smt(@W32). +rewrite dec. rewrite to_uintD. smt(@W32). smt(@W32). +move : H4. rewrite dec0. +rewrite to_uintD. smt(@W32). +rewrite dec. rewrite to_uintD. smt(@W32). +rewrite to_uintD. smt(@W32). +qed. diff --git a/proof/impl/perm/keccak_f1600_ref.ec b/proof/impl/perm/keccak_f1600_ref.ec new file mode 100644 index 0000000..e7d4541 --- /dev/null +++ b/proof/impl/perm/keccak_f1600_ref.ec @@ -0,0 +1,281 @@ +require import List Int IntExtra IntDiv CoreMap. +from Jasmin require import JModel. + +(* require import Array5 Array24 Array25. +require import WArray40 WArray192 WArray200. *) + +require import Ops. + +clone import PolyArray as Array25 with op size <- 25. +clone import PolyArray as Array24 with op size <- 24. + + +op x86_ROL_64 : W64.t -> W8.t -> bool * bool * W64.t. + +module M = { + proc constants(r : int) : W64.t = { + var table : W64.t Array24.t; + table.[ 0] = W64.of_int 1; + table.[ 1] = W64.of_int 32898; + table.[ 2] = W64.of_int 9223372036854808714; + table.[ 3] = W64.of_int 9223372039002292224; + table.[ 4] = W64.of_int 32907; + table.[ 5] = W64.of_int 2147483649; + table.[ 6] = W64.of_int 9223372039002292353; + table.[ 7] = W64.of_int 9223372036854808585; + table.[ 8] = W64.of_int 138; + table.[ 9] = W64.of_int 136; + table.[10] = W64.of_int 2147516425; + table.[11] = W64.of_int 2147483658; + table.[12] = W64.of_int 2147516555; + table.[13] = W64.of_int 9223372036854775947; + table.[14] = W64.of_int 9223372036854808713; + table.[15] = W64.of_int 9223372036854808579; + table.[16] = W64.of_int 9223372036854808578; + table.[17] = W64.of_int 9223372036854775936; + table.[18] = W64.of_int 32778; + table.[19] = W64.of_int 9223372039002259466; + table.[20] = W64.of_int 9223372039002292353; + table.[21] = W64.of_int 9223372036854808704; + table.[22] = W64.of_int 2147483649; + table.[23] = W64.of_int 9223372039002292232; + return table.[r]; + } + + proc index (x:int, y:int) : int = { + + var r:int; + + r <- ((x %% 5) + (5 * (y %% 5))); + return (r); + } + + proc theta (a:W64.t Array25.t) : W64.t Array25.t = { + var aux_1: bool; + var aux_0: bool; + var aux: int; + var aux_2: W64.t; + + var x:int; + var c:W64.t Array5.t; + var y:int; + var d:W64.t Array5.t; + var _0:bool; + var _1:bool; + c <- witness; + d <- witness; + x <- 0; + while (x < 5) { + c.[x] <- (W64.of_int 0); + y <- 0; + while (y < 5) { + c.[x] <- (c.[x] `^` a.[(x + (5 * y))]); + y <- y + 1; + } + x <- x + 1; + } + x <- 0; + while (x < 5) { + (aux_1, aux_0, aux_2) <- x86_ROL_64 c.[((x + 1) %% 5)] (W8.of_int 1); + _0 <- aux_1; + _1 <- aux_0; + d.[x] <- aux_2; + d.[x] <- (d.[x] `^` c.[((x + 4) %% 5)]); + x <- x + 1; + } + x <- 0; + while (x < 5) { + y <- 0; + while (y < 5) { + a.[(x + (5 * y))] <- (a.[(x + (5 * y))] `^` d.[x]); + y <- y + 1; + } + x <- x + 1; + } + return (a); + } + + proc keccakRhoOffsets (i:int) : int = { + var table : int Array25.t; + table.[0]=0 ; + table.[1]=1 ; + table.[2]=62; + table.[3]=28; + table.[4]=27; + table.[5]=36; + table.[6]=44; + table.[7]=6 ; + table.[8]=55; + table.[9]=20; + table.[10]=3 ; + table.[11]=10; + table.[12]=43; + table.[13]=25; + table.[14]=39; + table.[15]=41; + table.[16]=45; + table.[17]=15; + table.[18]=21; + table.[19]=8 ; + table.[20]=18; + table.[21]=2 ; + table.[22]=61; + table.[23]=56; + table.[24]=14; + return table.[i]; +(* + var aux: int; + + var r:int; + var x:int; + var y:int; + var t:int; + var z:int; + + r <- 0; + x <- 1; + y <- 0; + t <- 0; + while (t < 24) { + if ((i = (x + (5 * y)))) { + r <- ((((t + 1) * (t + 2)) %/ 2) %% 64); + } else { + + } + z <- (((2 * x) + (3 * y)) %% 5); + x <- y; + y <- z; + t <- t + 1; + } + return (r); +*) + + } + + proc rho (a:W64.t Array25.t) : W64.t Array25.t = { + var aux_1: bool; + var aux_0: bool; + var aux: int; + var aux_2: W64.t; + + var x:int; + var y:int; + var i:int; + var z:int; + var _0:bool; + var _1:bool; + + x <- 0; + while (x < 5) { + y <- 0; + while (y < 5) { + i <@ index (x, y); + z <@ keccakRhoOffsets (i); + (aux_1, aux_0, aux_2) <- x86_ROL_64 a.[i] (W8.of_int z); + _0 <- aux_1; + _1 <- aux_0; + a.[i] <- aux_2; + y <- y + 1; + } + x <- x + 1; + } + return (a); + } + + proc pi (a:W64.t Array25.t) : W64.t Array25.t = { + var aux: int; + + var i:int; + var t:W64.t; + var b:W64.t Array25.t; + var y:int; + var x:int; + b <- witness; + i <- 0; + while (i < 25) { + t <- a.[i]; + b.[i] <- t; + i <- i + 1; + } + x <- 0; + while (x < 5) { + y <- 0; + while (y < 5) { + t <- b.[(x + (5 * y))]; + i <@ index (y, ((2 * x) + (3 * y))); + a.[i] <- t; + y <- y + 1; + } + x <- x + 1; + } + return (a); + } + + proc chi (a:W64.t Array25.t) : W64.t Array25.t = { + var aux: int; + + var x:int; + var y:int; + var i:int; + var c:W64.t Array5.t; + c <- witness; + y <- 0; + while (y < 5) { + x <- 0; + while (x < 5) { + i <@ index ((x + 1), y); + c.[x] <- a.[i]; + c.[x] <- (invw c.[x]); + i <@ index ((x + 2), y); + c.[x] <- (c.[x] `&` a.[i]); + i <@ index (x, y); + c.[x] <- (c.[x] `^` a.[i]); + x <- x + 1; + } + x <- 0; + while (x < 5) { + a.[(x + (5 * y))] <- c.[x]; + x <- x + 1; + } + y <- y + 1; + } + return (a); + } + + proc iota_0 (a:W64.t Array25.t, c:W64.t) : W64.t Array25.t = { + + + + a.[0] <- (a.[0] `^` c); + return (a); + } + + proc keccakP1600_round (state:W64.t Array25.t, c:W64.t) : W64.t Array25.t = { + + + + state <@ theta (state); + state <@ rho (state); + state <@ pi (state); + state <@ chi (state); + state <@ iota_0 (state, c); + return (state); + } + + + proc permute (state:W64.t Array25.t) : W64.t Array25.t = { + var aux: int; + + var round:int; + var c : W64.t; + + round <- 0; + while (round < 24) { + c <@ constants(round); + state <@ keccakP1600_round (state, c); + round <- round + 1; + } + return (state); + } +}. + From 9437e58743aaf769348581c5412274864e75d592 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Thu, 25 Apr 2019 17:15:22 -0400 Subject: [PATCH 363/525] Improvement of documentation. Removal of redundant tactic application. --- proof/Sponge.ec | 17 ++++++++++------- 1 file changed, 10 insertions(+), 7 deletions(-) diff --git a/proof/Sponge.ec b/proof/Sponge.ec index c72b857..7d5f35d 100644 --- a/proof/Sponge.ec +++ b/proof/Sponge.ec @@ -131,11 +131,15 @@ module RaiseSim (S : BlockSponge.SIMULATOR, F : DFUNCTIONALITY) = We have lazy (HybridIROLazy) and eager (HybridIROEager) Hybrid IROs, both of which work with a finite map from block list * int to - bool. In both versions, f is defined in terms of g. In the lazy - version, g consults/randomly updates just those elements of the - map's domain needed to produce the needed bits. But the eager - version goes further, consulting/randomly updating enough extra - domain elements so that a multiple of r domain elements were + bool. In both versions, f is defined in terms of g, and, as in + BlockSponge.BIRO.IRO, g returns [] if x isn't a valid block. In + both versions, the input/output behavior of f is identical to that + of BlockSponge.BIRO.IRO.f. + + In the lazy version, g consults/randomly updates just those + elements of the map's domain needed to produce the needed bits. But + the eager version goes further, consulting/randomly updating enough + extra domain elements so that a multiple of r domain elements were consulted/randomly updated (those extra bits are discarded) We have a parameterized module RaiseHybridIRO for turning a Hybrid @@ -268,7 +272,7 @@ module HybridIROEager : HYBRID_IRO, BlockSponge.BIRO.IRO = { proc g(xs, n) = { var b, bs; - var m <- ((n + r - 1) %/ r) * r; + var m <- ((n + r - 1) %/ r) * r; (* eager part *) var i <- 0; bs <- []; @@ -2063,7 +2067,6 @@ proc (HIRO.eager_invar BlockSponge.BIRO.IRO.mp{2} proc (HIRO.eager_invar BlockSponge.BIRO.IRO.mp{2} HIRO.HybridIROEager.mp{1})=> //; conseq HIRO.HybridIROEager_BlockIRO_f=> //. -exists* n{1}; elim *=> n'. conseq RaiseHybridIRO_HybridIROEager_RaiseFun_BlockIRO_f=> //. auto. qed. From bfc4f28ac48f61a30f941a08e875ea5b1b5b1e25 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jos=C3=A9=20Bacelar=20Almeida?= Date: Sat, 27 Apr 2019 00:22:25 +0100 Subject: [PATCH 364/525] upd --- proof/impl/Spec1600.ec | 808 +++++++++++++++++++++++++++++++++++++++-- 1 file changed, 782 insertions(+), 26 deletions(-) diff --git a/proof/impl/Spec1600.ec b/proof/impl/Spec1600.ec index 0ef65fc..d0fc8f8 100644 --- a/proof/impl/Spec1600.ec +++ b/proof/impl/Spec1600.ec @@ -15,23 +15,166 @@ clone import Sponge1600 as Spnge1600 import Common1600 Block Capacity. + + +(* MISC *) +lemma take_nseq ['a] n1 n2 (x: 'a): take n1 (nseq n2 x) = nseq (min n1 n2) x. +proof. +elim/natind: n2 n1. + move=> n Hn n1; rewrite !nseq0_le //. + by have [? ?]:= min_is_lb n1 n; apply (lez_trans n). +move=> n Hn IH n1; case: (n1 <= 0) => /=. + move=> ?; rewrite take_le0 // nseq0_le //. + by have [? ?]:= min_is_lb n1 (n+1); apply (lez_trans n1). +rewrite -ltzNge=> ?; rewrite nseqS // take_cons H /=. +have ->: min n1 (n + 1) = (min (n1-1) n)+1. + rewrite /min; case: (n1 < n+1) => ?. + by have ->/=: n1 - 1 < n by smt(). + by have ->/=: !(n1 - 1 < n) by smt(). +by rewrite nseqS /min /#. +qed. + +lemma drop_nseq ['a] n1 n2 (x: 'a): 0 <= n1 => drop n1 (nseq n2 x) = nseq (n2-n1) x. +proof. +elim/natind: n1 n2. + move=> n Hn n2 Hn'; have ->: n=0 by smt(). + by rewrite drop0. +move=> n Hn IH n2 Hn'. +case: (n2 <= 0) => /= ?. + by rewrite !nseq0_le // /#. +have ->: n2 = n2 - 1 + 1 by smt(). +by rewrite nseqS 1:/# drop_cons ltzS Hn /= IH //; congr; smt(). +qed. + +(* *) + + +(* Word Lists *) + + op w8L2bits (l: W8.t list) : bool list = flatten (map W8.w2bits l). -op w64L2bits (l: W64.t list) : bool list = - flatten (map W64.w2bits l). -lemma w8L2bits_cat x1 x2: - w8L2bits (x1++x2) = w8L2bits x1 ++ w8L2bits x2. -admitted. +lemma w8L2bits_nil: w8L2bits [] = [] by done. + +lemma w8L2bits_cons x xs: w8L2bits (x::xs) = W8.w2bits x ++ w8L2bits xs. +proof. by rewrite /w8L2bits map_cons flatten_cons. qed. + +lemma w8L2bits_cat l1 l2: + w8L2bits (l1++l2) = w8L2bits l1 ++ w8L2bits l2. +proof. +elim: l1 => //=. + by rewrite w8L2bits_nil. +by move=> x xs IH; rewrite !w8L2bits_cons IH. +qed. lemma size_w8L2bits x: size (w8L2bits x) = 8 * size x. -admitted. +proof. +by rewrite /w8L2bits size_flatten -map_comp /(\o) /= StdBigop.Bigint.sumzE + StdBigop.Bigint.BIA.big_mapT /(\o) /= StdBigop.Bigint.big_constz count_predT_eq. +qed. + +op w64L2bits (l: W64.t list) : bool list = + flatten (map W64.w2bits l). + +lemma size_w64L2bits l: + size (w64L2bits l) = 64 * size l. +proof. +by rewrite /w64L2bits size_flatten -map_comp /(\o) /= StdBigop.Bigint.sumzE + StdBigop.Bigint.BIA.big_mapT /(\o) /= StdBigop.Bigint.big_constz count_predT_eq. +qed. + +op bits2w64L (bs: bool list) : W64.t list = + map W64.bits2w (BitEncoding.BitChunking.chunk 64 bs). +lemma bits2w64LK bs: + 64 %| size bs => w64L2bits (bits2w64L bs) = bs. +proof. +move=> Hsz. +rewrite /w64L2bits -map_comp. +have : forall (x : bool list), + x \in BitEncoding.BitChunking.chunk 64 bs => + idfun x = (fun x => w2bits ((bits2w x))%W64) x. + move=> x Hx; beta. + rewrite W64.bits2wK //. + by apply (BitEncoding.BitChunking.in_chunk_size _ _ _ _ Hx). +rewrite List.eq_in_map => <-. +by rewrite map_id BitEncoding.BitChunking.chunkK // Hsz. +qed. + +lemma w64L2bits_inj: injective w64L2bits. +proof. +rewrite /w64L2bits; elim. + by move=> [|y ys]. +move=> x xs IH; elim => //. +move=> y ys IH2. +rewrite !map_cons !flatten_cons. +rewrite eqseq_cat. + by rewrite !size_w2bits. +move=> [/W64.w2bits_inj <- ?]; congr. +by apply IH. +qed. + +lemma w64L2bitsK: cancel w64L2bits bits2w64L. +proof. +move=> k; apply w64L2bits_inj. +by rewrite bits2w64LK // size_w64L2bits dvdz_mulr. +qed. + +lemma w64L2bits_nil: w64L2bits [] = [] by done. + +lemma w64L2bits_cons x xs: w64L2bits (x::xs) = W64.w2bits x ++ w64L2bits xs. +proof. by rewrite /w64L2bits map_cons flatten_cons. qed. + +lemma w64L2bits_cat l1 l2: + w64L2bits (l1++l2) = w64L2bits l1 ++ w64L2bits l2. +proof. +elim: l1 => //=. + by rewrite w64L2bits_nil. +by move=> x xs IH; rewrite !w64L2bits_cons IH. +qed. + +lemma take_w64L2bits n l: + take (64*n) (w64L2bits l) = w64L2bits (take n l). +proof. +elim/natind: n l => //=. + move=> n Hn l; rewrite !take_le0 //. + by apply StdOrder.IntOrder.mulr_ge0_le0. +move=> n Hn IH [|x xs] /=. + by rewrite w64L2bits_nil. +have ->/=: ! (n+1 <= 0) by rewrite -ltzNge ltzS. +rewrite !w64L2bits_cons take_cat. +have ->/=: ! (64 * (n + 1) < size (w2bits x)) by rewrite W64.size_w2bits /#. +by rewrite mulzDr /= IH. +qed. + +lemma drop_w64L2bits n l: + drop (64*n) (w64L2bits l) = w64L2bits (drop n l). +proof. +elim/natind: n l => //=. + move=> n Hn l; rewrite !drop_le0 //. + by apply StdOrder.IntOrder.mulr_ge0_le0. +move=> n Hn IH [|x xs] /=. + by rewrite w64L2bits_nil. +have ->/=: ! (n+1 <= 0) by rewrite -ltzNge ltzS. +rewrite !w64L2bits_cons drop_cat. +have ->/=: ! (64 * (n + 1) < size (w2bits x)) by rewrite W64.size_w2bits /#. +by rewrite mulzDr /= IH. +qed. + +(* op w64L2bytes (l: W64.t list) : W8.t list = flatten (map W8u8.to_list l). +*) + + +(* Word Lists *) + + + + -search flatten. (* 1600bit state *) clone export PolyArray as Array25 with op size <- 25. @@ -39,25 +182,44 @@ type state = W64.t Array25.t. op st0 : state = Array25.create W64.zero. + (* clone export PolyArray as Array200 with op size <- 200. type state_u8 = W8.t Array200.t. -*) - - -(* print W8u8. *) + op state2bits (st: state) : bool list = w64L2bits (to_list st). lemma size_state2bits (st: state): size (state2bits st) = 1600. -admitted. +proof. by rewrite /state2bits size_w64L2bits size_to_list. qed. op bits2state (bs: bool list) : state = - of_list W64.zero - (map W64.bits2w (BitEncoding.BitChunking.chunk 64 bs)). + of_list W64.zero (bits2w64L bs). + +lemma bits2stateK bs: + size bs = 1600 => state2bits (bits2state bs) = bs. +proof. +move=> Hsz. +rewrite /state2bits /bits2state Array25.of_listK. + by rewrite size_map BitEncoding.BitChunking.size_chunk // Hsz. +by rewrite bits2w64LK ?Hsz. +qed. + +lemma state2bits_inj: injective state2bits. +proof. +rewrite /state2bits => st1 st2. +by move/w64L2bits_inj => /Array25.to_list_inj E. +qed. + +lemma state2bitsK: cancel state2bits bits2state. +proof. +move=> st; apply state2bits_inj. +by rewrite bits2stateK // size_state2bits. +qed. + (* op state2bytes (st: state) : W8.t list = w64L2bytes (to_list st). @@ -79,9 +241,15 @@ op ratio8 = ratio64 * 8. lemma ratio64P: ratio64 * 64 = ratio. proof. by move: ratio_w64; rewrite /ratio64 dvdz_eq. qed. +lemma ratio64_bnds: 0 < ratio64 < 25. +proof. move: ratio_bnds; rewrite -ratio64P /#. qed. + lemma ratio8P: ratio8 * 8 = ratio. proof. by rewrite /ratio8 mulzA /= ratio64P. qed. +lemma ratio8_bnds: 0 < ratio8 < 200. +proof. move: ratio_bnds; rewrite -ratio8P /#. qed. + op capacity64 = 25-ratio64. lemma capacity64P: capacity64 * 64 = c. proof. by rewrite /capacity64 Ring.IntID.mulrBl /= ratio64P. qed. @@ -92,31 +260,611 @@ proof. by rewrite /capacity64 Ring.IntID.mulrBl /= ratio64P. qed. op state_r (st: state) : block = mkblock (take r (state2bits st)). - (*mkblock (w64L2bits (mkseq (fun (i : int) => st.[i]) ratio64)).*) + +op w64L2block (l: W64.t list) : block = + mkblock (w64L2bits (take ratio64 l + ++ nseq (ratio64-size l) W64.zero)). + +op block2w64L (b: block) : W64.t list = bits2w64L (ofblock b). + +lemma block2w64LP st: + block2w64L (state_r st) = take ratio64 (to_list st). +proof. +rewrite /block2w64L /state_r ofblockK. + rewrite size_take ?ge0_r size_state2bits; smt(ratio_bnds). +by rewrite /state2bits -ratio64P mulzC take_w64L2bits w64L2bitsK. +qed. op state_c (st: state) : capacity = mkcapacity (drop r (state2bits st)). -(*w64list_bits (mkseq (fun (i : int) => st.[i+ratio64]) capacity64).*) + +op capacity2w64L (c: capacity) : W64.t list = bits2w64L (ofcapacity c). + +lemma capacity2w64LP st: + capacity2w64L (state_c st) = drop ratio64 (to_list st). +proof. +rewrite /capacity2w64L /state_c ofcapacityK. + rewrite size_drop ?ge0_r size_state2bits; smt(ratio_bnds). +by rewrite /state2bits -ratio64P mulzC drop_w64L2bits w64L2bitsK. +qed. + +op state_rel x st = x = (state_r st, state_c st). + +lemma state_splitP st: + st = Array25.of_list W64.zero + (block2w64L (state_r st) ++ capacity2w64L (state_c st)). +proof. +by rewrite block2w64LP capacity2w64LP cat_take_drop to_listK. +qed. lemma state2bits0: state2bits st0 = nseq 1600 false. proof. -admit. +by rewrite /st0 /state2bits /w64L2bits /Array25.to_list /mkseq. qed. lemma st0_r: state_r st0 = b0. proof. -rewrite /state_r state2bits0. -admit. +rewrite /state_r state2bits0 b0P take_nseq min_lel //. +apply ltzW; smt(ratio_bnds). +qed. + +lemma c0P: c0 = mkcapacity (nseq c false). +proof. +rewrite capacityP=> i Hi. +by rewrite offunifE Hi /= getE Hi /= ofcapacityK 1:size_nseq 1:/# nth_nseq. qed. lemma st0_c: state_c st0 = c0. +proof. rewrite /state_c c0P state2bits0 drop_nseq; smt(ratio_bnds). qed. + + + + +op addstateAt (n:int) (st:state) (l: W64.t list) : state = + with l = "[]" => st + with l = (::) x xs => addstateAt (n+1) (st.[n <- st.[n] `^` x]) xs. + +op addfullblock st l = addstateAt 0 st l. + +lemma addfullblockP st ws: + size ws = ratio64 => + state_r (addfullblock st ws) = state_r st +^ w64L2block ws + /\ state_c (addfullblock st ws) = state_c st. +admitted. + +lemma addfullblockP' st b: + state_r (addfullblock st (block2w64L b)) = state_r st +^ b + /\ state_c (addfullblock st (block2w64L b)) = state_c st. +admitted. + +op addfinalblock st l = + (addstateAt 0 st l).[ratio64-1 <- st.[ratio64-1] `^` W64.of_int (2^63)]. + +lemma addfinalblockP st ws: + size ws <= ratio64 => + state_r (addfinalblock st ws) = state_r st +^ w64L2block ws + /\ state_c (addfullblock st ws) = state_c st. +admitted. + +print pad2blocks. +print bits2blocks. + +op messbreak (suf: W8.t) (m:W8.t list) : (W64.t list list) * W64.t list. +(*op squeezestate' : state -> W8.t list.*) + +(* [squeezestate] extracts a [ratio64] 64bit words from the state *) +op squeezestate : state -> W64.t list. + +(* [xtrbytes outl w64L] converts at most [outl] bytes from the + list of 64bit words [w64L] *) +op xtrbytes : int -> W64.t list -> W8.t list. + +(* [take_block64] reads a full block into a list of 64bit words *) +op take_block64 : W8.t list -> W64.t list * W8.t list. + +(* [final_block64] reads the final block and adds the padding *) +op final_block64 : W8.t -> W8.t list -> W64.t list. + +(* [mbits] include both the "domain-separation" bits as well as + additional suffix bits (e.g. "01" for SHA; "11" for RawSHAKE; + "1111" for SHAKE). + Remark: the standard FIPS-202 specifies two domain bits, possibly + prefixed by up to two additional suffix bits. Nonetheless, we + only assume a weaker requirenment: that those bits together with + the two mandatory bits of the padding fit in a single byte + (i.e. [size mbits < 6]). *) +op trail_byte (mbits: bool list) : W8.t = + W8.bits2w (mbits++[true]). + +(* [pad2blocks8] is a byte-oriented version of [pad2blocks] *) +op pad2blocks8 : W8.t -> W8.t list -> block list. + + + +module type PermT = { + proc perm(st : state) : state +}. + + +module Spec0(P : PermT) = { + proc f(trailbyte: W8.t, m: W8.t list, outl: int) : W8.t list = { + var result,b,st; + result <- []; + st <- st0; + (* ABSORB *) + while (ratio8 <= size m){ + (b, m) <- take_block64 m; + st <- addfullblock st b; + st <@ P.perm(st); + } + st <- addfinalblock st (final_block64 trailbyte m); + (* SQUEEZE *) + while (0 < outl){ + st <@ P.perm(st); + b <- squeezestate st; + result <- result ++ xtrbytes outl b; + outl = outl - ratio8; + } + + return result; + } +}. + +(* PENDING: + +sa{1} +^ head b0 (pad2blocks (w8L2bits m{2} ++ mbits)) = +state_r (addfullblock st{2} (take_block64 m{2}).`1) + +sa{1} +^ head b0 (pad2blocks8 (trail_byte mbits) m{2}) = +state_r (addfinalblock st{2} (final_block64 (trail_byte mbits) m{2})) + +sc{1} = state_c (addfullblock st{2} (take_block64 m{2}).`1 + +sc{1} = state_c (addfinalblock st{2} (final_block64 (trail_byte mbits) m{2})) + +behead (pad2blocks (w8L2bits m{2} ++ mbits)) = +pad2blocks (w8L2bits (take_block64 m{2}).`2 ++ mbits) + +pad2blocks (w8L2bits m_R ++ mbits) = pad2blocks8 (trail_byte mbits) m_R + + +w8L2bits (xtrbytes outl{2} (squeezestate result_R)) = +take (8 * outl{2}) (ofblock (state_r result_R)) +*) + + +lemma needed_blocks8P n x: + x < (8*n + r - 1) %/ r <=> 0 < n - x*ratio8. proof. -rewrite /state_c state2bits0. -admit. +rewrite ltzE lez_divRL; first smt(ratio_bnds). +rewrite mulzDl /= !(addzC _ r) -addzA lez_add2l. +rewrite -ratio8P -mulzA mulzC -(lez_add2l 1) !(addzC 1) /= -ltzE. +by rewrite StdOrder.IntOrder.ltr_pmul2l /#. qed. +section. + +declare module IdealizedPerm: DPRIMITIVE. +declare module ConcretePerm: PermT. + +axiom perm_correct : + equiv [IdealizedPerm.f ~ ConcretePerm.perm : + state_rel x{1} st{2} ==> state_rel res{1} res{2}]. + +axiom perm_lossless: islossless IdealizedPerm.f. + +lemma spec_correct mbits: +equiv [ Sponge(IdealizedPerm).f ~ Spec0(ConcretePerm).f : + bs{1} = w8L2bits m{2} ++ mbits /\ + n{1} = 8*outl{2} /\ + trailbyte{2} = trail_byte mbits /\ size mbits < 5 + ==> res{1} = w8L2bits res{2}]. +proof. +proc; simplify; exists* outl{2}; elim* => outl2. +swap {1} 1 1; swap {1} [2..3] 2. +swap {2} 1 3. +splitwhile {1} 3: (1 < size xs). +unroll {2} 5. +(* ABSORB intermediate blocks *) +seq 3 2: (#[/1,3:]pre /\ state_rel (sa,sc){1} st{2} /\ + xs{1} = (pad2blocks8 trailbyte m){2} /\ + size xs{1} = 1). + sp. + while (#[/5,7:]pre /\ state_rel (sa,sc){1} st{2} /\ + xs{1} = pad2blocks (w8L2bits m{2} ++ mbits) /\ + outl2 = outl{2} /\ 1<=size xs{1}). + wp; call perm_correct; wp; skip; progress. + + admit (* +sa{1} +^ head b0 (pad2blocks (w8L2bits m{2} ++ mbits)) = +state_r (addfullblock st{2} (xtrblock m{2}).`1) +*). + + admit (* +sc{1} = state_c (addfullblock st{2} (xtrblock m{2}).`1 +*). + + by rewrite H6. + + by rewrite H6. + + admit(* +behead (pad2blocks (w8L2bits m{2} ++ mbits)) = +pad2blocks (w8L2bits (xtrblock m{2}).`2 ++ mbits) +*). + + admit (* sizes *). + + admit (* sizes *). + + admit (* sizes *). + + admit (* sizes *). + skip => |> *; progress. + + by rewrite st0_r. + + by rewrite st0_c. + + admit (* sizes *). + + admit (* sizes *). + + admit (* sizes *). + + admit (* sizes *). + + admit (* +pad2blocks (w8L2bits m_R ++ mbits) = pad2blocks8 (trail_byte mbits) m_R +*). + + admit (* sizes *). +(* ABSORB final block *) +unroll {1} 1; rcondt {1} 1. + move=> *; skip => |> *. + move: H1; case: (xs{hr}=[]); smt(). +rcondf {1} 3. + move=> *; wp; call (_:true); skip => |> ???. + move: (pad2blocks8 _ _) => [|??] //= ?. + by rewrite -size_eq0 /#. +(* SQUEEZE *) +case: (0 < outl2); last first. + (* corner case: no output *) + rcondf {2} 3; first by move=> *; wp; skip => |> *. + rcondf {2} 3; first by move=> *; wp; skip => |> *. + rcondf {1} 5. + move=> *; wp; call (_:true); skip => |> *. + case: (8 * outl{m} + r - 1 < 0) => ?. + rewrite -lezNgt; apply ltzW. + rewrite ltzNge divz_ge0; first smt(ratio_bnds). + smt(). + rewrite divz_small //. + by apply bound_abs; smt(ratio_bnds). + by wp; call {1} perm_lossless; skip => |> *; progress. +(* normal case: positive length output *) +rcondt {2} 3; first by move=> *; wp; skip => |>. +seq 4 6: (#[/5]pre /\ 0 < outl2 /\ n{1} = 8*outl2 /\ + outl{2} + (i{1}+1)*ratio8 = outl2 /\ + take n{1} (z{1} ++ ofblock sa{1}) = w8L2bits result{2} /\ + (z=[] /\ i=0){1}). + wp; call perm_correct; wp; skip => [??]. + progress. + + admit (* +sa{1} +^ head b0 (pad2blocks8 (trail_byte mbits) m{2}) = +state_r (addfinalblock st{2} (finalblock (trail_byte mbits) m{2})) +*). + + admit (* +sc{1} = state_c (addfinalblock st{2} (finalblock (trail_byte mbits) m{2})) +*). + + by rewrite H4. + + by rewrite H4. + + smt(). + + admit (* +take (8 * outl{2}) (ofblock (state_r result_R)) = +w8L2bits (xtrbytes outl{2} (squeezestate result_R)) +*). +splitwhile {1} 1: (i+1 < (n + r - 1) %/ r). +seq 1 1: (#[:-2]pre /\ (i+1=(n + r - 1) %/ r){1}). + while (#[:-2]pre /\ 0 <= i{1}+1 <= (n{1} + r - 1) %/ r /\ + size z{1} = i{1}*r). + rcondt {1} 3; first by move=> *; wp; skip => |> * /#. + wp; call perm_correct; wp; skip => [??] [[[[->->]]]] [?[->]]. + rewrite needed_blocks8P; progress. + + by rewrite H8. + + by rewrite H8. + + smt(). + + rewrite take_cat. + rewrite size_cat H3 size_block -ratio8P !(mulzC ratio8). + have ->/=: !(8 * (outl{2} + (i{1} + 1) * ratio8) + < i{1} * (8*ratio8) + 8*ratio8). + rewrite -lezNgt mulzDl !mulzDr /=. + rewrite addzA lez_add2r (mulzC 8) -mulzA mulzC. + rewrite -{1}(add0z (8 * (i{1} * ratio8))) lez_add2r. + apply ltzW; smt(). + rewrite w8L2bits_cat -H0. + rewrite H8 /= eq_sym take_oversize. + rewrite size_cat H3 size_block -ratio8P. + rewrite mulzDl !mulzDr /= (mulzC 8 ratio8). + rewrite (mulzC _ (i{1} * ratio8)) -!mulzA. + rewrite -{1}(add0z (_ + _)%Int) lez_add2r. + apply ltzW; smt(). + congr. + have ->:(8 * (outl{2} + (i{1} + 1) * ratio8) + - (i{1} * (8 * ratio8) + 8 * ratio8)) + = 8 * outl{2} by ring. +admit (* +w8L2bits (xtrbytes outl{2} (squeezestate result_R)) = +take (8 * outl{2}) (ofblock (state_r result_R)) +*). + + smt(). + + have ->: 2 = 1 + 1 by ring. + by rewrite addzA -ltzE needed_blocks8P /#. + + by rewrite size_cat H3 size_block; ring. + + by move: H10; rewrite needed_blocks8P /#. + + by rewrite needed_blocks8P /#. + skip => |> *; progress. + + have ->: 1 = 0+1 by done. + by rewrite -ltzE needed_blocks8P /#. + + move: H3; rewrite needed_blocks8P /#. + + by rewrite needed_blocks8P /#. + + rewrite needed_blocks8P /#. + + smt(). +unroll {1} 1; rcondt {1} 1; first by move=> *; skip => |> * /#. +rcondf {1} 3; first by move=> *; wp; skip => |> * /#. +rcondf {1} 3; first by move=> *; wp; skip => |> * /#. +by wp; skip => |> *. +qed. + + + + +(* Message and payload + obs: we consider byte-sized messages + *) +type mess_t = W8.t list. + +(* [block_split] splits the message bytes in "intermediate blocks" + (with size multiple of [ratio8]) and a "last block" (remaining + bytes). *) +op block_split (m: mess_t) : mess_t * mess_t = + (take (size m %/ ratio8 * ratio8) m, drop (size m %/ ratio8 * ratio8) m). + +lemma block_splitP m: + m = (block_split m).`1 ++ (block_split m).`2. +proof. by rewrite -{1}(cat_take_drop (size m %/ ratio8 * ratio8)). qed. + +lemma num0_block_suffix n k: + num0 (k * ratio + n) = num0 n. +proof. by rewrite /num0 -modzNm -addzA modzMDl modzNm. qed. + +lemma size_block_split1 m: + size (block_split m).`1 = size m %/ ratio8 * ratio8. +proof. +have ?: 0 <= size m - size m %% ratio8 by smt(size_ge0 ratio8_bnds). +rewrite /block_split /= size_take divzE //. +case: (size m - size m %% ratio8 < size m) => //. +rewrite -lezNgt => ?. +have ->/#: size m %% ratio8 = 0. +smt(ratio8_bnds modz_cmp). +qed. + +lemma size_block_split2 m: + size (block_split m).`2 = size m %% ratio8. +proof. +rewrite modzE. +have ->: size (block_split m).`2 = size m - size (block_split m).`1. + by rewrite eq_sym {1}block_splitP size_cat /#. +by rewrite size_block_split1. +qed. + +op lastblock_bits mbits lastbytes : bool list = + w8L2bits lastbytes ++ mbits + ++ mkpad (8*size lastbytes + size mbits). + +op mess2blocks mbits m = + bits2blocks (w8L2bits (block_split m).`1 + ++ lastblock_bits mbits (block_split m).`2). + +lemma mess2blocksP mbits mess: + size mbits < 5 => + mess2blocks mbits mess = pad2blocks (w8L2bits mess ++ mbits). +proof. +move => Hsz. +rewrite {2}block_splitP. +rewrite /mess2blocks /pad2blocks /(\o) /=; congr. +rewrite /pad w8L2bits_cat -!catA; congr; congr; congr. +rewrite !size_cat !size_w8L2bits /mkpad /=; congr; congr. +rewrite size_block_split1. +have ->: 8 * (size mess %/ ratio8 * ratio8) + = (size mess %/ ratio8) * ratio + by rewrite -ratio8P /#. +by rewrite num0_block_suffix. +qed. + + + + + + + + +(* [mbits] include both the "domain-separation" bits as well as + additional suffix bits (e.g. "01" for SHA; "11" for RawSHAKE; + "1111" for SHAKE) + Remark: [size mbits] are expected to be at most 4. +*) +op trail_byte (mbits: bool list) : W8.t = + W8.bits2w (mbits++[true]). + +(* [lastbytes_split] splits the last message bytes in + 64bit words and remaining bytes. + remark: "size lastbytes < ratio8" *) +op lastbytes_split (m: mess_t) : mess_t * mess_t = + (take (size m %/ 8 * 8) m, drop (size m %/ 8 * 8) m). + +lemma lastbytes_splitP m: + m = (lastbytes_split m).`1 ++ (lastbytes_split m).`2. +proof. by rewrite -{1}(cat_take_drop (size m %/ 8 * 8)). qed. + +lemma size_lastbytes_split1 m: + size (lastbytes_split m).`1 = size m %/ 8 * 8. +proof. +have ?: 0 <= size m - size m %% 8 by smt(size_ge0). +rewrite /lastbytes_split /= size_take divzE //. +case: (size m - size m %% 8 < size m) => //. +rewrite -lezNgt => ?. +have ->/#: size m %% 8 = 0. +smt(modz_cmp). +qed. + +lemma size_lastbytes_split2 m: + size (lastbytes_split m).`2 = size m %% 8. +proof. +rewrite modzE. +have ->: size (lastbytes_split m).`2 + = size m - size (lastbytes_split m).`1. + by rewrite eq_sym {1}lastbytes_splitP size_cat /#. +by rewrite size_lastbytes_split1. +qed. + + + + + +op num8_0s sz = (-(sz+1)) %% ratio8. + +op mkpad8 mbits size8 : W8.t list = + or_head (trail_byte mbits) + (rcons (nseq (num8_0s size8) W8.zero) (W8.of_int 128)). + +lemma mkpad8P mbits sz: + size mbits < 5 => + w8L2bits (mkpad8 mbits sz) + = mbits ++ mkpad (8*sz + size mbits). +proof. +move => Hsz. +rewrite /mkpad8 /trail_byte. +admit (* +w8list_bits + (or_head ((bits2w (mbits ++ [true])))%W8 + (rcons (nseq (num8_0s sz) W8.zero) ((of_int 128))%W8)) = +mbits ++ mkpad (8 * sz + size mbits) +*). +qed. + +op lastblock_bytes mbits lastbytes : W8.t list = + lastbytes ++ mkpad8 mbits (size lastbytes). + +lemma lastblock_bytesP mbits lastbytes: + size mbits < 5 => + w8L2bits (lastblock_bytes mbits lastbytes) + = lastblock_bits mbits lastbytes. +proof. +move=> Hsz. +rewrite /lastblock_bits /lastblock_bytes. +by rewrite !w8L2bits_cat mkpad8P // !catA. +qed. + + + + + + + + + +op addstate (st: state) (ws: W64.t list) : state = + Array25.map2 W64.(+^) st (Array25.of_list W64.zero ws). + +lemma mkblock_xor l1 l2: + mkblock l1 +^ mkblock l2 = mkblock (map2 Bool.(^^) l1 l2). +admitted. + +lemma w64L2bits_xor l1 l2: + map2 Bool.(^^) (w64L2bits l1) (w64L2bits l2) = w64L2bits (map2 W64.(`^`) l1 l2). +admitted. + +lemma to_list_map2 x1 x2: + Array25.to_list (Array25.map2 W64.(`^`) x1 x2) = map2 W64.(`^`) (to_list x1) (to_list x2). +admitted. + +lemma take_map2 n l1 l2: + take n (JUtils.map2 W64.(`^`) l1 l2) = map2 W64.(`^`) (take n l1) (take n l2). +admitted. + +lemma drop_map2 n l1 l2: + drop n (JUtils.map2 W64.(`^`) l1 l2) + = map2 W64.(`^`) (drop n l1) (drop n l2). +admitted. + +(* +print take. +op take_dfl ['a] dfl (n : int) (xs : 'a list) : 'a list = + with xs = "[]" => nseq n dfl + with xs = (::) y ys => if n <= 0 then [] else y :: take (n - 1) ys. + +lemma of_listK'' ['a]: + forall (dfl : 'a) (l : 'a list), + to_list (Array25.of_list dfl l) = take_dfl dfl 25 l. +admitted. +*) + +lemma of_list_take ['a] (dfl : 'a) (l : 'a list): +Array25.of_list dfl l = Array25.of_list dfl (take 25 l). +proof. +apply Array25.ext_eq => *. +rewrite !Array25.get_of_list //. +by rewrite nth_take // /#. +qed. + +lemma of_list_cat_nseq ['a] n (dfl : 'a) (l : 'a list): +Array25.of_list dfl l = Array25.of_list dfl (l++nseq n dfl). +proof. +apply Array25.ext_eq => *. +rewrite !Array25.get_of_list //. +rewrite nth_cat. +case: (x < size l) => ? //. +rewrite nth_out 1:/#. +case: (x - size l < n) => ?. + by rewrite nth_nseq /#. +rewrite nth_out //. +by rewrite size_nseq /max; case: (0 < n) => ? /#. +qed. + +lemma of_listK' ['a]: + forall (dfl : 'a) (l : 'a list), + to_list (Array25.of_list dfl l) + = take 25 l++nseq (25-size l) dfl. +proof. +move=> *. +rewrite of_list_take (of_list_cat_nseq (25-size l)) of_listK //. +rewrite size_cat size_take // size_nseq. +case: (25 < size l) => ?. + by rewrite max_lel /#. +by rewrite max_ler /#. +qed. + +lemma drop_addstate st ws: + size ws <= ratio64 => + drop r (state2bits (addstate st ws)) = drop r (state2bits st). +proof. +admitted(* +move => Hsz. +rewrite /state2bits -ratio64P {1 2}mulzC !drop_w64L2bits /addstate. +rewrite to_list_map2 drop_map2 of_listK' drop_cat; congr. +rewrite size_take // -!Hsz. +have ->/=: !25 < size ws by smt(ratio_bnds). +rewrite drop0. +apply (eq_from_nth W64.zero). + rewrite size_map2 min_lel //. admit. +move=> i Hi. +rewrite (nth_map2 W64.zero W64.zero). + admit. + rewrite nth_nseq. admit. +by rewrite xorw0. +qed*). + +lemma addstateP st ws: + size ws <= ratio64 => + state_r (addstate st ws) = state_r st +^ mkblock (w64L2bits ws) + /\ state_c (addstate st ws) = state_c st. +proof. +move=> Hsz; split; last first. + by rewrite /state_c drop_addstate //. +rewrite /addstate /state_r /state2bits -ratio64P + {1 2}mulzC !take_w64L2bits mkblock_xor w64L2bits_xor + to_list_map2; congr; congr. +rewrite of_listK' take_map2 take_cat size_take //. +have H1: !(25 < size ws) by smt(ratio_bnds). +rewrite H1 /= ltzNge Hsz /= (take_oversize 25) 1:/# take_nseq. +search (<=) (<) (<=>). + !Hsz /= take0 cats0 (take_oversize 25) ?Hsz /#. +qed. (* Message and payload obs: we consider byte-sized messages @@ -152,7 +900,11 @@ rewrite /pad w8L2bits_cat -!catA; congr; congr; congr. rewrite !size_cat !size_w8L2bits. rewrite /mkpad; congr; congr; congr. rewrite /num0. -admit. +admit (* +(- (8 * size (mess_split mess).`2 + size mbits + 2)) %% r = +(- (8 * size (mess_split mess).`1 + + (8 * size (mess_split mess).`2 + size mbits) + 2)) %% r +*). qed. @@ -206,12 +958,16 @@ by rewrite !w8L2bits_cat mkpad8P // !catA. qed. -(* ESTOU AQUI!!! *) - -op lastbytes -lemma last +(* [lastbytes_split] splits full u64 words from the remaining bytes *) +op lastbytes_split (m: mess_t) : mess_t * mess_t = + (take (size m %/ 8) m, drop (size m %/ 8) m). +lemma lastbytes_splitP m: + m = (lastbytes_split m).`1 ++ (lastbytes_split m).`2. +proof. by rewrite -{1}(cat_take_drop (size m %/ 8)). qed. +op lastu64 mbits (m: mess_t) : W64.t = + W8u8.pack8 (rcons m (trail_byte mbits)). module type PermT = { From 71cdda0c9add0968bf50d76b8a2ec3466049769a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jos=C3=A9=20Bacelar=20Almeida?= Date: Sat, 27 Apr 2019 01:42:28 +0100 Subject: [PATCH 365/525] upd --- proof/impl/Spec1600.ec | 284 +++++++++++++++++++++-------------------- 1 file changed, 148 insertions(+), 136 deletions(-) diff --git a/proof/impl/Spec1600.ec b/proof/impl/Spec1600.ec index d0fc8f8..ce54f45 100644 --- a/proof/impl/Spec1600.ec +++ b/proof/impl/Spec1600.ec @@ -18,7 +18,8 @@ import Common1600 Block Capacity. (* MISC *) -lemma take_nseq ['a] n1 n2 (x: 'a): take n1 (nseq n2 x) = nseq (min n1 n2) x. +lemma take_nseq ['a] n1 n2 (x: 'a): + take n1 (nseq n2 x) = nseq (min n1 n2) x. proof. elim/natind: n2 n1. move=> n Hn n1; rewrite !nseq0_le //. @@ -34,7 +35,8 @@ have ->: min n1 (n + 1) = (min (n1-1) n)+1. by rewrite nseqS /min /#. qed. -lemma drop_nseq ['a] n1 n2 (x: 'a): 0 <= n1 => drop n1 (nseq n2 x) = nseq (n2-n1) x. +lemma drop_nseq ['a] n1 n2 (x: 'a): + 0 <= n1 => drop n1 (nseq n2 x) = nseq (n2-n1) x. proof. elim/natind: n1 n2. move=> n Hn n2 Hn'; have ->: n=0 by smt(). @@ -72,7 +74,7 @@ lemma size_w8L2bits x: size (w8L2bits x) = 8 * size x. proof. by rewrite /w8L2bits size_flatten -map_comp /(\o) /= StdBigop.Bigint.sumzE - StdBigop.Bigint.BIA.big_mapT /(\o) /= StdBigop.Bigint.big_constz count_predT_eq. +StdBigop.Bigint.BIA.big_mapT /(\o) /= StdBigop.Bigint.big_constz count_predT_eq. qed. op w64L2bits (l: W64.t list) : bool list = @@ -82,7 +84,7 @@ lemma size_w64L2bits l: size (w64L2bits l) = 64 * size l. proof. by rewrite /w64L2bits size_flatten -map_comp /(\o) /= StdBigop.Bigint.sumzE - StdBigop.Bigint.BIA.big_mapT /(\o) /= StdBigop.Bigint.big_constz count_predT_eq. +StdBigop.Bigint.BIA.big_mapT /(\o) /= StdBigop.Bigint.big_constz count_predT_eq. qed. op bits2w64L (bs: bool list) : W64.t list = @@ -169,7 +171,7 @@ op w64L2bytes (l: W64.t list) : W8.t list = *) -(* Word Lists *) +(* END Word Lists *) @@ -182,14 +184,6 @@ type state = W64.t Array25.t. op st0 : state = Array25.create W64.zero. - -(* -clone export PolyArray as Array200 with op size <- 200. -type state_u8 = W8.t Array200.t. -print W8u8. -*) - - op state2bits (st: state) : bool list = w64L2bits (to_list st). lemma size_state2bits (st: state): @@ -288,8 +282,6 @@ rewrite /capacity2w64L /state_c ofcapacityK. by rewrite /state2bits -ratio64P mulzC drop_w64L2bits w64L2bitsK. qed. -op state_rel x st = x = (state_r st, state_c st). - lemma state_splitP st: st = Array25.of_list W64.zero (block2w64L (state_r st) ++ capacity2w64L (state_c st)). @@ -317,7 +309,40 @@ qed. lemma st0_c: state_c st0 = c0. proof. rewrite /state_c c0P state2bits0 drop_nseq; smt(ratio_bnds). qed. +(* [match_state] relates both state representations *) +op match_state x st = x = (state_r st, state_c st). + + + +(* + MESSAGES and PAYLOADS +*) + +type mess_t = W8.t list. + +print W8u8.pack8. +print w8L2block. +print block2w64L. +(* [take_block64] reads a the contents of a full block into a list + of 64bit words (return also the remaining bytes) *) +op take_block64 (m: W8.t list): W64.t list * W8.t list = + (bits2w64L (w8L2bits (take ratio8 m)), drop ratio8 m). + +(* [trail_byte] adds the first padding 1-bit to [mbits], which include + both the "domain-separation" bits as well as additional suffix bits + (e.g. "01" for SHA; "11" for RawSHAKE; "1111" for SHAKE). The last + 1-bit of the padding (the "ratio" bit), is only added when adding to + the state. + Remark: the standard FIPS-202 specifies two domain bits, possibly + prefixed by up to two additional suffix bits. Nonetheless, we + only assume a weaker requirenment: that those bits together with + the two mandatory bits of the padding fit in a single byte + (i.e. [size mbits < 6]). *) +op trail_byte (mbits: bool list) : W8.t = W8.bits2w (mbits++[true]). +(* [final_block64] reads the final block and adds the first padding bit *) +op final_block64 (lbyte: W8.t) (m: W8.t list): W64.t list = + bits2w64L (w8L2bits (m++[lbyte])). op addstateAt (n:int) (st:state) (l: W64.t list) : state = @@ -332,6 +357,89 @@ lemma addfullblockP st ws: /\ state_c (addfullblock st ws) = state_c st. admitted. +op addfinalblock st l = + (addstateAt 0 st l).[ratio64-1 <- st.[ratio64-1] `^` W64.of_int (2^63)]. + +op block0star1 = mkblock (nseq (ratio-1) false ++ [true]). + +lemma addfinalblockP st ws: + size ws <= ratio64 => + state_r (addfinalblock st ws) = state_r st +^ w64L2block ws +^ block0star1 + /\ state_c (addfullblock st ws) = state_c st. +admitted. + + + + + + +(* + +(* [block_split] splits the message bytes in "intermediate blocks" + (with size multiple of [ratio8]) and a "last block" (remaining + bytes). *) +op block_split (m: mess_t) : mess_t * mess_t = + (take (size m %/ ratio8 * ratio8) m, drop (size m %/ ratio8 * ratio8) m). + +lemma block_splitP m: + m = (block_split m).`1 ++ (block_split m).`2. +proof. by rewrite -{1}(cat_take_drop (size m %/ ratio8 * ratio8)). qed. + +lemma num0_block_suffix n k: + num0 (k * ratio + n) = num0 n. +proof. by rewrite /num0 -modzNm -addzA modzMDl modzNm. qed. + +lemma size_block_split1 m: + size (block_split m).`1 = size m %/ ratio8 * ratio8. +proof. +have ?: 0 <= size m - size m %% ratio8 by smt(size_ge0 ratio8_bnds). +rewrite /block_split /= size_take divzE //. +case: (size m - size m %% ratio8 < size m) => //. +rewrite -lezNgt => ?. +have ->/#: size m %% ratio8 = 0. +smt(ratio8_bnds modz_cmp). +qed. + +lemma size_block_split2 m: + size (block_split m).`2 = size m %% ratio8. +proof. +rewrite modzE. +have ->: size (block_split m).`2 = size m - size (block_split m).`1. + by rewrite eq_sym {1}block_splitP size_cat /#. +by rewrite size_block_split1. +qed. + +op lastblock_bits mbits lastbytes : bool list = + w8L2bits lastbytes ++ mbits + ++ mkpad (8*size lastbytes + size mbits). + +op mess2blocks mbits m = + bits2blocks (w8L2bits (block_split m).`1 + ++ lastblock_bits mbits (block_split m).`2). + +lemma mess2blocksP mbits mess: + size mbits < 5 => + mess2blocks mbits mess = pad2blocks (w8L2bits mess ++ mbits). +proof. +move => Hsz. +rewrite {2}block_splitP. +rewrite /mess2blocks /pad2blocks /(\o) /=; congr. +rewrite /pad w8L2bits_cat -!catA; congr; congr; congr. +rewrite !size_cat !size_w8L2bits /mkpad /=; congr; congr. +rewrite size_block_split1. +have ->: 8 * (size mess %/ ratio8 * ratio8) + = (size mess %/ ratio8) * ratio + by rewrite -ratio8P /#. +by rewrite num0_block_suffix. +qed. + + + + + + + + lemma addfullblockP' st b: state_r (addfullblock st (block2w64L b)) = state_r st +^ b /\ state_c (addfullblock st (block2w64L b)) = state_c st. @@ -345,13 +453,7 @@ lemma addfinalblockP st ws: state_r (addfinalblock st ws) = state_r st +^ w64L2block ws /\ state_c (addfullblock st ws) = state_c st. admitted. - -print pad2blocks. -print bits2blocks. - -op messbreak (suf: W8.t) (m:W8.t list) : (W64.t list list) * W64.t list. -(*op squeezestate' : state -> W8.t list.*) - +*) (* [squeezestate] extracts a [ratio64] 64bit words from the state *) op squeezestate : state -> W64.t list. @@ -359,26 +461,29 @@ op squeezestate : state -> W64.t list. list of 64bit words [w64L] *) op xtrbytes : int -> W64.t list -> W8.t list. -(* [take_block64] reads a full block into a list of 64bit words *) -op take_block64 : W8.t list -> W64.t list * W8.t list. -(* [final_block64] reads the final block and adds the padding *) -op final_block64 : W8.t -> W8.t list -> W64.t list. -(* [mbits] include both the "domain-separation" bits as well as - additional suffix bits (e.g. "01" for SHA; "11" for RawSHAKE; - "1111" for SHAKE). - Remark: the standard FIPS-202 specifies two domain bits, possibly - prefixed by up to two additional suffix bits. Nonetheless, we - only assume a weaker requirenment: that those bits together with - the two mandatory bits of the padding fit in a single byte - (i.e. [size mbits < 6]). *) -op trail_byte (mbits: bool list) : W8.t = - W8.bits2w (mbits++[true]). +(* PENDING: + +sa{1} +^ head b0 (pad2blocks (w8L2bits m{2} ++ mbits)) = +state_r (addfullblock st{2} (take_block64 m{2}).`1) + +sa{1} +^ head b0 (pad2blocks8 (trail_byte mbits) m{2}) = +state_r (addfinalblock st{2} (final_block64 (trail_byte mbits) m{2})) + +sc{1} = state_c (addfullblock st{2} (take_block64 m{2}).`1 + +sc{1} = state_c (addfinalblock st{2} (final_block64 (trail_byte mbits) m{2})) + +behead (pad2blocks (w8L2bits m{2} ++ mbits)) = +pad2blocks (w8L2bits (take_block64 m{2}).`2 ++ mbits) + +pad2blocks (w8L2bits m_R ++ mbits) = pad2blocks8 (trail_byte mbits) m_R -(* [pad2blocks8] is a byte-oriented version of [pad2blocks] *) -op pad2blocks8 : W8.t -> W8.t list -> block list. +w8L2bits (xtrbytes outl{2} (squeezestate result_R)) = +take (8 * outl{2}) (ofblock (state_r result_R)) +*) module type PermT = { @@ -410,27 +515,6 @@ module Spec0(P : PermT) = { } }. -(* PENDING: - -sa{1} +^ head b0 (pad2blocks (w8L2bits m{2} ++ mbits)) = -state_r (addfullblock st{2} (take_block64 m{2}).`1) - -sa{1} +^ head b0 (pad2blocks8 (trail_byte mbits) m{2}) = -state_r (addfinalblock st{2} (final_block64 (trail_byte mbits) m{2})) - -sc{1} = state_c (addfullblock st{2} (take_block64 m{2}).`1 - -sc{1} = state_c (addfinalblock st{2} (final_block64 (trail_byte mbits) m{2})) - -behead (pad2blocks (w8L2bits m{2} ++ mbits)) = -pad2blocks (w8L2bits (take_block64 m{2}).`2 ++ mbits) - -pad2blocks (w8L2bits m_R ++ mbits) = pad2blocks8 (trail_byte mbits) m_R - - -w8L2bits (xtrbytes outl{2} (squeezestate result_R)) = -take (8 * outl{2}) (ofblock (state_r result_R)) -*) lemma needed_blocks8P n x: @@ -451,7 +535,7 @@ declare module ConcretePerm: PermT. axiom perm_correct : equiv [IdealizedPerm.f ~ ConcretePerm.perm : - state_rel x{1} st{2} ==> state_rel res{1} res{2}]. + match_state x{1} st{2} ==> match_state res{1} res{2}]. axiom perm_lossless: islossless IdealizedPerm.f. @@ -468,11 +552,11 @@ swap {2} 1 3. splitwhile {1} 3: (1 < size xs). unroll {2} 5. (* ABSORB intermediate blocks *) -seq 3 2: (#[/1,3:]pre /\ state_rel (sa,sc){1} st{2} /\ - xs{1} = (pad2blocks8 trailbyte m){2} /\ +seq 3 2: (#[/1,3:]pre /\ match_state (sa,sc){1} st{2} /\ + xs{1} = (pad2blocks (w8L2bits m ++ mbits)){2} /\ size xs{1} = 1). sp. - while (#[/5,7:]pre /\ state_rel (sa,sc){1} st{2} /\ + while (#[/5,7:]pre /\ match_state (sa,sc){1} st{2} /\ xs{1} = pad2blocks (w8L2bits m{2} ++ mbits) /\ outl2 = outl{2} /\ 1<=size xs{1}). wp; call perm_correct; wp; skip; progress. @@ -500,9 +584,6 @@ pad2blocks (w8L2bits (xtrblock m{2}).`2 ++ mbits) + admit (* sizes *). + admit (* sizes *). + admit (* sizes *). - + admit (* -pad2blocks (w8L2bits m_R ++ mbits) = pad2blocks8 (trail_byte mbits) m_R -*). + admit (* sizes *). (* ABSORB final block *) unroll {1} 1; rcondt {1} 1. @@ -510,7 +591,7 @@ unroll {1} 1; rcondt {1} 1. move: H1; case: (xs{hr}=[]); smt(). rcondf {1} 3. move=> *; wp; call (_:true); skip => |> ???. - move: (pad2blocks8 _ _) => [|??] //= ?. + move: (pad2blocks _) => [|??] //= ?. by rewrite -size_eq0 /#. (* SQUEEZE *) case: (0 < outl2); last first. @@ -603,75 +684,6 @@ qed. -(* Message and payload - obs: we consider byte-sized messages - *) -type mess_t = W8.t list. - -(* [block_split] splits the message bytes in "intermediate blocks" - (with size multiple of [ratio8]) and a "last block" (remaining - bytes). *) -op block_split (m: mess_t) : mess_t * mess_t = - (take (size m %/ ratio8 * ratio8) m, drop (size m %/ ratio8 * ratio8) m). - -lemma block_splitP m: - m = (block_split m).`1 ++ (block_split m).`2. -proof. by rewrite -{1}(cat_take_drop (size m %/ ratio8 * ratio8)). qed. - -lemma num0_block_suffix n k: - num0 (k * ratio + n) = num0 n. -proof. by rewrite /num0 -modzNm -addzA modzMDl modzNm. qed. - -lemma size_block_split1 m: - size (block_split m).`1 = size m %/ ratio8 * ratio8. -proof. -have ?: 0 <= size m - size m %% ratio8 by smt(size_ge0 ratio8_bnds). -rewrite /block_split /= size_take divzE //. -case: (size m - size m %% ratio8 < size m) => //. -rewrite -lezNgt => ?. -have ->/#: size m %% ratio8 = 0. -smt(ratio8_bnds modz_cmp). -qed. - -lemma size_block_split2 m: - size (block_split m).`2 = size m %% ratio8. -proof. -rewrite modzE. -have ->: size (block_split m).`2 = size m - size (block_split m).`1. - by rewrite eq_sym {1}block_splitP size_cat /#. -by rewrite size_block_split1. -qed. - -op lastblock_bits mbits lastbytes : bool list = - w8L2bits lastbytes ++ mbits - ++ mkpad (8*size lastbytes + size mbits). - -op mess2blocks mbits m = - bits2blocks (w8L2bits (block_split m).`1 - ++ lastblock_bits mbits (block_split m).`2). - -lemma mess2blocksP mbits mess: - size mbits < 5 => - mess2blocks mbits mess = pad2blocks (w8L2bits mess ++ mbits). -proof. -move => Hsz. -rewrite {2}block_splitP. -rewrite /mess2blocks /pad2blocks /(\o) /=; congr. -rewrite /pad w8L2bits_cat -!catA; congr; congr; congr. -rewrite !size_cat !size_w8L2bits /mkpad /=; congr; congr. -rewrite size_block_split1. -have ->: 8 * (size mess %/ ratio8 * ratio8) - = (size mess %/ ratio8) * ratio - by rewrite -ratio8P /#. -by rewrite num0_block_suffix. -qed. - - - - - - - (* [mbits] include both the "domain-separation" bits as well as additional suffix bits (e.g. "01" for SHA; "11" for RawSHAKE; From fa1855e4a5ee273faebbbb9e6e71e6cbbc11596f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jos=C3=A9=20Bacelar=20Almeida?= Date: Sun, 28 Apr 2019 01:31:47 +0100 Subject: [PATCH 366/525] upd --- proof/impl/Spec1600.ec | 265 ++++++++++++++++++++++++++++++++--------- 1 file changed, 207 insertions(+), 58 deletions(-) diff --git a/proof/impl/Spec1600.ec b/proof/impl/Spec1600.ec index ce54f45..ced1f15 100644 --- a/proof/impl/Spec1600.ec +++ b/proof/impl/Spec1600.ec @@ -48,6 +48,78 @@ have ->: n2 = n2 - 1 + 1 by smt(). by rewrite nseqS 1:/# drop_cons ltzS Hn /= IH //; congr; smt(). qed. +lemma dropS ['a] (l: 'a list) n: + 0 <= n => + drop (n + 1) l = behead (drop n l). +proof. +elim: l n => [|x xs] //= IH n Hn. +have ->/=: !(n+1 <= 0) by smt(). +case: (n=0). + by move=> -> /=; rewrite drop0. +move=> ?; have ->/=: !(n<=0) by smt(). +by rewrite -IH /#. +qed. + +lemma drop_drop ['a] (l: 'a list) n1 n2: + 0 <= n1 => 0 <= n2 => + drop n1 (drop n2 l) = drop (n1+n2) l. +proof. +elim/natind: n1. + by move=> n Hn; rewrite drop_le0 /#. +move=> n Hn IH H1 H2. +by rewrite dropS // IH // -dropS /#. +qed. + +lemma eq_mkseq' ['a] (f g : int -> 'a) n: + (forall (x : int), 0 <= x < n => f x = g x) => mkseq f n = mkseq g n. +proof. +elim/natind: n f g => /=. + by move=> n Hn f g H; rewrite !mkseq0_le. +move=> n Hn IH f g H. +rewrite !(addzC n) !mkseq_add //; congr. + by rewrite !mkseq1 H /#. +apply IH => x Hx /=. +by rewrite H /#. +qed. + +lemma behead_map ['a 'b] (f:'a->'b) (l:'a list): + behead (map f l) = map f (behead l) +by elim: l. + +lemma behead_mkseq ['a] (f : int -> 'a) n: + behead (mkseq f n) = mkseq (fun i=> f (1+i)) (n-1). +proof. +elim/natind: n => /=. + by move=> n Hn; rewrite !mkseq0_le /#. +by move=> n Hn IH; rewrite addzC mkseq_add // mkseq1. +qed. + +lemma behead_chunk ['a] n (l:'a list): + behead (BitEncoding.BitChunking.chunk n l) + = BitEncoding.BitChunking.chunk n (drop n l). +proof. +case: (size l < n). + move=> ?; rewrite drop_oversize 1:/#. + rewrite /BitEncoding.BitChunking.chunk behead_mkseq. + rewrite divz_small /=. + by apply bound_abs; smt(size_ge0). + by rewrite mkseq0_le. +case: (0 < n); last first. +rewrite -!lezNgt => ??. + by rewrite drop_le0 // !BitEncoding.BitChunking.chunk_le0. +rewrite -lezNgt => ??. +rewrite /BitEncoding.BitChunking.chunk behead_mkseq /=. +rewrite size_drop // 1:/# max_ler 1:/#. +have ->: (size l - n) %/ n = size l %/ n - 1. + have ->: size l = (size l - n) + 1*n by ring. + by rewrite divzMDr /#. +by apply eq_mkseq' => x Hx /=; rewrite drop_drop /#. +qed. + +lemma num0_block_suffix n k: + num0 (k * ratio + n) = num0 n. +proof. by rewrite /num0 -modzNm -addzA modzMDl modzNm. qed. + (* *) @@ -77,6 +149,34 @@ by rewrite /w8L2bits size_flatten -map_comp /(\o) /= StdBigop.Bigint.sumzE StdBigop.Bigint.BIA.big_mapT /(\o) /= StdBigop.Bigint.big_constz count_predT_eq. qed. +lemma take_w8L2bits n l: + take (8*n) (w8L2bits l) = w8L2bits (take n l). +proof. +elim/natind: n l => //=. + move=> n Hn l; rewrite !take_le0 //. + by apply StdOrder.IntOrder.mulr_ge0_le0. +move=> n Hn IH [|x xs] /=. + by rewrite w8L2bits_nil. +have ->/=: ! (n+1 <= 0) by rewrite -ltzNge ltzS. +rewrite !w8L2bits_cons take_cat. +have ->/=: ! (8 * (n + 1) < size (w2bits x)) by rewrite W8.size_w2bits /#. +by rewrite mulzDr /= IH. +qed. + +lemma drop_w8L2bits n l: + drop (8*n) (w8L2bits l) = w8L2bits (drop n l). +proof. +elim/natind: n l => //=. + move=> n Hn l; rewrite !drop_le0 //. + by apply StdOrder.IntOrder.mulr_ge0_le0. +move=> n Hn IH [|x xs] /=. + by rewrite w8L2bits_nil. +have ->/=: ! (n+1 <= 0) by rewrite -ltzNge ltzS. +rewrite !w8L2bits_cons drop_cat. +have ->/=: ! (8 * (n + 1) < size (w2bits x)) by rewrite W8.size_w2bits /#. +by rewrite mulzDr /= IH. +qed. + op w64L2bits (l: W64.t list) : bool list = flatten (map W64.w2bits l). @@ -165,11 +265,21 @@ have ->/=: ! (64 * (n + 1) < size (w2bits x)) by rewrite W64.size_w2bits /#. by rewrite mulzDr /= IH. qed. -(* -op w64L2bytes (l: W64.t list) : W8.t list = +op w64L2w8L (l: W64.t list) : W8.t list = flatten (map W8u8.to_list l). -*) +lemma w64L2w8L2bits l: + w8L2bits (w64L2w8L l) = w64L2bits l. +proof. +elim: l; first by rewrite /w64L2w8L /flatten. +move=> x xs IH. +rewrite /w64L2w8L map_cons flatten_cons w64L2bits_cons w8L2bits_cat; congr. +by rewrite /w8L2bits /flatten. +qed. + + +(* +*) (* END Word Lists *) @@ -215,19 +325,6 @@ by rewrite bits2stateK // size_state2bits. qed. -(* -op state2bytes (st: state) : W8.t list = w64L2bytes (to_list st). - -lemma size_state2bytes st: - size (state2bytes st) = 200. -admitted. - -op bytes2state (bs: W8.t list) : state = - of_list W64.zero - (map W64.bits2w (BitEncoding.BitChunking.chunk 64 bs)). -*) - - (* ratio expressed in 8 and 64bit words *) op ratio64 = ratio %/ 64. op ratio8 = ratio64 * 8. @@ -351,10 +448,21 @@ op addstateAt (n:int) (st:state) (l: W64.t list) : state = op addfullblock st l = addstateAt 0 st l. -lemma addfullblockP st ws: +(* PENDING: +sa{1} +^ head b0 (pad2blocks (w8L2bits m{2} ++ mbits)) = +state_r (addfullblock st{2} (take_block64 m{2}).`1) +*) +lemma addfullblock_r st ws: size ws = ratio64 => - state_r (addfullblock st ws) = state_r st +^ w64L2block ws - /\ state_c (addfullblock st ws) = state_c st. + state_r (addfullblock st ws) = state_r st +^ w64L2block ws. +admitted. + +(* PENDING: +sc{1} = state_c (addfullblock st{2} (take_block64 m{2}).`1 +*) +lemma addfullblock_c st ws: + size ws = ratio64 => + state_c (addfullblock st ws) = state_c st. admitted. op addfinalblock st l = @@ -362,12 +470,88 @@ op addfinalblock st l = op block0star1 = mkblock (nseq (ratio-1) false ++ [true]). -lemma addfinalblockP st ws: - size ws <= ratio64 => - state_r (addfinalblock st ws) = state_r st +^ w64L2block ws +^ block0star1 - /\ state_c (addfullblock st ws) = state_c st. +(* PENDING: +sa{1} +^ head b0 (pad2blocks8 (trail_byte mbits) m{2}) = +state_r (addfinalblock st{2} (final_block64 (trail_byte mbits) m{2})) +*) +lemma addfinalblock_r mbits st m: + size m < ratio8 => + state_r (addfinalblock st (final_block64 (trail_byte mbits) m)) + = state_r st +^ (head b0 (pad2blocks (w8L2bits m ++ mbits))) +^ block0star1. admitted. +(* PENDING: +sc{1} = state_c (addfinalblock st{2} (final_block64 (trail_byte mbits) m{2})) +*) +lemma addfinalblock_c lbyte st m: + size m < ratio8 => + state_c (addfullblock st (final_block64 lbyte m)) = state_c st. +admitted. + + +(* [squeezestate] extracts a [ratio64] 64bit words from the state *) +op squeezestate (st: state): W64.t list = + take ratio64 (to_list st). + +(* [xtrbytes outl w64L] converts at most [outl] bytes from the + list of 64bit words [w64L] *) +op xtrbytes (n: int) (b64: W64.t list): W8.t list = + take n (w64L2w8L b64). + +lemma xtrbytes_squeezestate n st: + w8L2bits (xtrbytes n (squeezestate st)) = + take (8*n) (ofblock (state_r st)). +proof. +rewrite /xtrbytes -take_w8L2bits /squeezestate; congr. +rewrite /state_r /state2bits -ratio64P mulzC take_w64L2bits. +rewrite w64L2w8L2bits ofblockK // size_w64L2bits size_take. + smt(ratio64_bnds). +rewrite Array25.size_to_list -ratio64P mulzC. +by have ->/=: ratio64 < 25 by smt(ratio64_bnds). +qed. + +lemma size_pad2blocks8 mbits m: + size mbits < 6 => + size (pad2blocks (w8L2bits m ++ mbits)) = size m %/ ratio8 + 1. +proof. +rewrite size_pad2blocks size_cat size_w8L2bits -ratio8P => ?; congr. +rewrite mulzC -addzA. +have [-> _]//:= (divmod_mul ratio8 8 (size m) (size mbits + 1) _ _); +by smt(size_ge0 ratio8_bnds). +qed. + +lemma behead_pad2blocks m: + r <= size m => + behead (pad2blocks m) = pad2blocks (drop r m). +proof. +rewrite /pad2blocks /bits2blocks /pad /(\o) behead_map => ?. +rewrite behead_chunk; congr. +rewrite drop_cat. +case: (r = size m) => E. + rewrite !E drop0 drop_size /= /mkpad. + have ->: size m = 1*r + 0 by smt(). + by rewrite num0_block_suffix. +have ->/=: r < size m by smt(). +rewrite size_drop; first smt(ratio_bnds). +rewrite max_ler; first smt(size_ge0). +have {1}->: size m = 1*r + (size m - r) by ring. +by rewrite /mkpad num0_block_suffix. +qed. + +lemma behead_pad2blocks8 mbits m: + ratio8 <= size m => + behead (pad2blocks (w8L2bits m ++ mbits)) = + pad2blocks (w8L2bits (take_block64 m).`2 ++ mbits). +proof. +move=> ?; rewrite behead_pad2blocks. + by rewrite size_cat size_w8L2bits -ratio8P; smt(size_ge0). +rewrite /take_block64 /= drop_cat size_w8L2bits -ratio8P mulzC. +rewrite StdOrder.IntOrder.ltr_pmul2l //. +case: (ratio8 = size m) => E. + by rewrite E /= drop0 drop_size w8L2bits_nil. +have ->/=: ratio8 < size m by smt(). +by rewrite -drop_w8L2bits mulzC. +qed. @@ -385,10 +569,6 @@ lemma block_splitP m: m = (block_split m).`1 ++ (block_split m).`2. proof. by rewrite -{1}(cat_take_drop (size m %/ ratio8 * ratio8)). qed. -lemma num0_block_suffix n k: - num0 (k * ratio + n) = num0 n. -proof. by rewrite /num0 -modzNm -addzA modzMDl modzNm. qed. - lemma size_block_split1 m: size (block_split m).`1 = size m %/ ratio8 * ratio8. proof. @@ -454,37 +634,6 @@ lemma addfinalblockP st ws: /\ state_c (addfullblock st ws) = state_c st. admitted. *) -(* [squeezestate] extracts a [ratio64] 64bit words from the state *) -op squeezestate : state -> W64.t list. - -(* [xtrbytes outl w64L] converts at most [outl] bytes from the - list of 64bit words [w64L] *) -op xtrbytes : int -> W64.t list -> W8.t list. - - - -(* PENDING: - -sa{1} +^ head b0 (pad2blocks (w8L2bits m{2} ++ mbits)) = -state_r (addfullblock st{2} (take_block64 m{2}).`1) - -sa{1} +^ head b0 (pad2blocks8 (trail_byte mbits) m{2}) = -state_r (addfinalblock st{2} (final_block64 (trail_byte mbits) m{2})) - -sc{1} = state_c (addfullblock st{2} (take_block64 m{2}).`1 - -sc{1} = state_c (addfinalblock st{2} (final_block64 (trail_byte mbits) m{2})) - -behead (pad2blocks (w8L2bits m{2} ++ mbits)) = -pad2blocks (w8L2bits (take_block64 m{2}).`2 ++ mbits) - -pad2blocks (w8L2bits m_R ++ mbits) = pad2blocks8 (trail_byte mbits) m_R - - -w8L2bits (xtrbytes outl{2} (squeezestate result_R)) = -take (8 * outl{2}) (ofblock (state_r result_R)) -*) - module type PermT = { proc perm(st : state) : state From d23acb16810868995e9401bcdca0665bb383bea4 Mon Sep 17 00:00:00 2001 From: Manuel Barbosa Date: Mon, 29 Apr 2019 23:12:47 +0100 Subject: [PATCH 367/525] Permutation proofs --- proof/impl/perm/LoopTransform.ec | 249 +++ proof/impl/perm/Ops.ec | 4 +- proof/impl/perm/keccak_f1600_avx2.ec | 1133 ++++++++--- proof/impl/perm/keccak_f1600_avx2_openssl.ec | 355 ++++ .../perm/keccak_f1600_avx2_openssl_prevec.ec | 1752 +++++++++++++++++ proof/impl/perm/keccak_f1600_avx2_prevec.ec | 1168 ----------- proof/impl/perm/keccak_f1600_ref.ec | 103 +- proof/impl/perm/keccak_f1600_ref_loop2.ec | 172 ++ proof/impl/perm/keccak_f1600_ref_table.ec | 254 +++ proof/impl/perm/keccak_f1600_scalar.ec | 206 ++ proof/impl/perm/keccak_f1600_scalar_table.ec | 1209 ++++++++++++ 11 files changed, 5061 insertions(+), 1544 deletions(-) create mode 100644 proof/impl/perm/LoopTransform.ec create mode 100644 proof/impl/perm/keccak_f1600_avx2_openssl.ec create mode 100644 proof/impl/perm/keccak_f1600_avx2_openssl_prevec.ec delete mode 100644 proof/impl/perm/keccak_f1600_avx2_prevec.ec create mode 100644 proof/impl/perm/keccak_f1600_ref_loop2.ec create mode 100644 proof/impl/perm/keccak_f1600_ref_table.ec create mode 100644 proof/impl/perm/keccak_f1600_scalar.ec create mode 100644 proof/impl/perm/keccak_f1600_scalar_table.ec diff --git a/proof/impl/perm/LoopTransform.ec b/proof/impl/perm/LoopTransform.ec new file mode 100644 index 0000000..af09f3c --- /dev/null +++ b/proof/impl/perm/LoopTransform.ec @@ -0,0 +1,249 @@ +require import AllCore StdOrder IntDiv IntExtra. +from Jasmin require import JUtils. + +abbrev [-printing] floor (n k:int) = (n %/ k) * k. + +lemma lt_floorE (k i n:int) : 0 < k => k %| i => i < floor n k <=> i + k <= floor n k. +proof. + move => hk /dvdzP [q] ->. + rewrite (IntOrder.ltr_pmul2r k hk) ltzE -(IntOrder.ler_pmul2r k hk) /#. +qed. + +lemma floor_le n k : 0 < k => floor n k <= n. +proof. rewrite {2}(divz_eq n k); smt (modz_cmp). qed. + +lemma le_floor (k i n:int) : 0 < k => k %| i => i <= n => i <= floor n k. +proof. + rewrite {1}(divz_eq n k)=> hk /dvdzP [q] ->. + case (q * k <= floor n k) => // /ltzNge; rewrite IntOrder.ltr_pmul2r // => /ltzE. + rewrite -(IntOrder.ler_pmul2r k hk); smt (modz_cmp). +qed. + +lemma le_floorE (k i n:int) : 0 < k => k %| i => i <= n <=> i <= floor n k. +proof. move => hk kd; smt (divz_eq modz_cmp le_floor). qed. + +abstract theory ExactIter. +type t. + +op c : int. +axiom c_gt0 : 0 < c. +op step : int. +axiom step_gt0 : 0 < step. + +module type AdvLoop = { + proc body(t:t, i:int) : t +}. + +module Loop(B:AdvLoop) = { + proc loop1 (t:t, n:int) = { + var i; + i = 0; + while (i < n) { + t <@ B.body(t,i); + i <- i + 1; + } + return t; + } + + proc loopk (t:t, n:int, k:int) = { + var i, j; + i = 0; + while (i < n) { + j = 0; + while (j < k) { + t <@ B.body(t, k * i + j); + j <- j + 1; + } + i <- i + 1; + } + return t; + } + + proc loopc (t:t, n:int) = { + var i, j; + i = 0; + while (i < n) { + j = 0; + while (j < c) { + t <@ B.body(t, c * i + j); + j <- j + 1; + } + i <- i + 1; + } + return t; + } + +}. + +module ILoop(B:AdvLoop) = { + proc loop1 (t:t, n:int) = { + var i; + i = 0; + while (i < n) { + t <@ B.body(t,i); + i <- i + step; + } + return t; + } + + proc loopk (t:t, n:int, k:int) = { + var i, j; + i = 0; + while (i + step * k <= n) { + j = 0; + while (j < k) { + t <@ B.body(t, i); + i <- i + step; + j <- j + 1; + } + } + while (i < n) { + t <@ B.body(t,i); + i <- i + step; + } + return t; + } + + proc loopc (t:t, n:int) = { + var i, j; + i = 0; + while (i + step * c <= n) { + j = 0; + while (j < c) { + t <@ B.body(t, i); + i <- i + step; + j <- j + 1; + } + } + while (i < n) { + t <@ B.body(t,i); + i <- i + step; + } + return t; + } + +}. + +section. + +declare module B:AdvLoop. + +equiv loop1_loopk : Loop(B).loop1 ~ Loop(B).loopk : + ={t, glob B} /\ n{1} = (k * n){2} /\ 0 < k{2} ==> ={res, glob B}. +proof. + proc. + async while [ (fun r => i%r < r), (i{1}+k{2})%r ] + [ (fun r => i%r < r), (i{2} + 1)%r ] + ( (i < n){1}) + (true) : + (={t, glob B} /\ (0 <= i <= n){2} /\ 0 < k{2} /\ n{1} = (k * n){2} /\ i{1} = k{2} * i{2}). + + smt(). + smt (). + done. + + move=> &m2; exfalso; smt(). + + move=> &m1; exfalso; smt(). + + move=> v1 v2. + rcondt{2} 1; 1: by auto => /> /#. + rcondf{2} 4; 1: by auto; conseq (_: true);auto. + exlim i{2} => i2. + wp;while (={t,glob B} /\ i{1} = k{2}*i{2} + j{2} /\ 0 <= i{2} < n{2} /\ + 0 <= j{2} <= k{2} /\ v1 = (k{2} * i2 + k{2})%r /\ i{2} = i2 /\ n{1} = (k * n){2}). + + wp;call (_: true);skip => /> &2 h0i hin h0j hjk. + rewrite !RealExtra.lt_fromint => h1 h2 h3. + have := IntOrder.ler_wpmul2l k{2} _ i{2} (n{2} - 1); smt(). + by wp;skip => /> /#. + + rcondf 1; skip => /#. + + rcondf 1; skip => /#. + by auto. +qed. + +equiv loopk_loopc : Loop(B).loopk ~ Loop(B).loopc : ={n,t, glob B} /\ k{1} = c ==> ={res, glob B}. +proof. + proc => /=. + while (={glob B, i, t, n} /\ k{1} = c);2: by auto. + wp;while (={glob B, i, j, t, n} /\ k{1} = c);2: by auto. + by wp;call (_:true);skip. +qed. + +equiv loop1_loopc : + Loop(B).loop1 ~ Loop(B).loopc : + ={t, glob B} /\ n{1} = (c * n){2} ==> ={res, glob B}. +proof. + transitivity Loop(B).loopk + (={t, glob B} /\ n{1} = c * n{2} /\ k{2} = c ==> ={res, glob B}) + (={n,t, glob B} /\ k{1} = c ==> ={res, glob B}). + + by move=> &1 &2 /> 2!->; exists (glob B){2} (t{2}, n{2}, c). + + done. + + conseq loop1_loopk; smt (c_gt0). + apply loopk_loopc. +qed. + +equiv Iloop1_loopk : ILoop(B).loop1 ~ ILoop(B).loopk : ={t, glob B, n} /\ 0 < k{2}==> ={res, glob B}. +proof. + proc => /=; exlim k{2} => k0. + case: (n{2} < 0). + + rcondf{2} 2; 1: by move=> &m1; wp; skip => &m2 />; smt (step_gt0). + by sim; wp; skip. + splitwhile{1} 2 : (i < floor n (step * k0)). + seq 2 2: (={glob B, t, n, i}); last by sim;wp;skip. + async while [ (fun r => i%r < r), (i{1} + step * k{2})%r ] + [ (fun r => i%r < r), (i{2} + step * k{2})%r ] + ( (i < floor n (step * k0)){1}) + (true) : + (={t, glob B, i, n} /\ k{2} = k0 /\ 0 < k{2} /\ (step * k0) %| i{1}). + + move=> />;smt (lt_floorE floor_le step_gt0). + + move=> /> &2 h1 h2 [[]// | h3]. + have h4 := le_floorE (step * k{2}) (i{2} + step * k{2}) n{2} _ _. + + smt (step_gt0). + by apply dvdzD => //; apply dvdzz. + smt (step_gt0). + + done. + + by move=> &m2; exfalso => /#. + + by move=> &m1; exfalso => /#. + + move=> v1 v2. + rcondt{2} 1. + + move=> &1;skip => /> *; smt (step_gt0 lt_floorE floor_le). + rcondf{2} 3. + + move=> &1. + while (j <= k /\ i = i{1} + step * j). + + by wp; call (_:true); skip => /#. + by wp; skip => />; smt (step_gt0). + exlim i{1} => i0. + while (={t, i, glob B, n} /\ i{1} = i0 + step * j{2} /\ v1 = (i0 + step * k{2})%r /\ + k{2} = k0 /\ (step * k0) %| i0 /\ 0 < k{2} /\ 0 <= j{2} <= k{2} /\ + v1 <= (floor n{1} (step * k{2}))%r). + + wp; call (_: true); skip => &1 &2 [#] 7!->> h2 h3 h4 h1. + rewrite le_fromint /= !lt_fromint=> h5 h6 h7 h8 h9 ???? [#] 2!->> /=. + split. smt(). + have <- := IntOrder.ltr_pmul2l step step_gt0 (j{2} + 1) k0. + smt (floor_le step_gt0). + wp; skip => &1 &2 [#] 6!->> h1 h2 h3 h4 2!->> /=. + rewrite le_fromint lt_fromint h2 h1 -lt_floorE /= 2://; 1:smt (step_gt0). + (do! (split => *)); 1..-2: smt(step_gt0). + by case: H1 => [?] [-> ?]; rewrite dvdzD 1:/# (_ : j_R = k0) 1:/# dvdzz. + + rcondf 1; skip => /#. + + rcondf 1; skip => /#. + by auto. +qed. + +equiv Iloopk_loopc : ILoop(B).loopk ~ ILoop(B).loopc : ={n,t, glob B} /\ k{1} = c ==> ={res, glob B}. +proof. + proc => /=; sim. + while (={glob B, i, t, n} /\ k{1} = c);2: by auto. + wp;while (={glob B, i, j, t, n} /\ k{1} = c);2: by auto. + by wp;call (_:true);skip. +qed. + +equiv Iloop1_loopc : + ILoop(B).loop1 ~ ILoop(B).loopc : + ={t, glob B, n} ==> ={res, glob B}. +proof. + transitivity ILoop(B).loopk + (={t, glob B} /\ n{1} = n{2} /\ k{2} = c ==> ={res, glob B}) + (={n,t, glob B} /\ k{1} = c ==> ={res, glob B}). + + by move=> &1 &2 /> 2!->; exists (glob B){2} (t{2}, n{2}, c). + + done. + + conseq Iloop1_loopk; smt (c_gt0). + apply Iloopk_loopc. +qed. + +end section. + +end ExactIter. diff --git a/proof/impl/perm/Ops.ec b/proof/impl/perm/Ops.ec index a5f2837..2e5535a 100644 --- a/proof/impl/perm/Ops.ec +++ b/proof/impl/perm/Ops.ec @@ -282,7 +282,7 @@ module Ops = { return r; } - proc iVPBLEN_D_D_256(x y:t4u64, p : W8.t) : W64.t Array4.t = { + proc iVPBLENDD_256(x y:t4u64, p : W8.t) : W64.t Array4.t = { var r : t4u64; r <- witness; if (to_uint p = 192) { @@ -316,7 +316,7 @@ module Ops = { } - proc iVPSHUF_D_256 (x :t4u64, p : W8.t) : t4u64 = { + proc iVPSHUFD_256 (x :t4u64, p : W8.t) : t4u64 = { var r : t4u64; r <- witness; if (to_uint p = 78) { (* 01 00 11 10 *) diff --git a/proof/impl/perm/keccak_f1600_avx2.ec b/proof/impl/perm/keccak_f1600_avx2.ec index b2b821b..17ce758 100644 --- a/proof/impl/perm/keccak_f1600_avx2.ec +++ b/proof/impl/perm/keccak_f1600_avx2.ec @@ -2,358 +2,875 @@ require import List Int IntExtra IntDiv CoreMap. from Jasmin require import JModel. (* -require import Array9. -require import WArray288. +require import Array7 Array9. +require import WArray224 WArray288. *) -clone export PolyArray as Array9 with op size <- 9. +require import Keccak_f1600_avx2_openssl. -op x86_VPSHUF_D_256 : W256.t -> W8.t -> W256.t. -op x86_VPBLEN_D_D_256 : W256.t -> W256.t -> W8.t -> W256.t. -op x86_VPSLLV_4u64 : W256.t -> W256.t -> W256.t. -op x86_VPSRLV_4u64 : W256.t -> W256.t -> W256.t. -op x86_VPSRL_DQ_256 : W256.t -> W8.t -> W256.t. -op x86_VPANDN_256 : W256.t -> W256.t -> W256.t. -op x86_DEC_32 : W32.t -> (bool * bool * bool * bool * W32.t). -op x86_VPBLENDD_256 : W256.t -> W256.t -> W8.t -> W256.t. +clone export PolyArray as Array7 with op size <- 9. module Mavx2 = { - proc __KeccakF1600 (_A00:W256.t, _A01:W256.t, _A20:W256.t, _A31:W256.t, - _A21:W256.t, _A41:W256.t, _A11:W256.t, - _rhotates_left:W64.t, _rhotates_right:W64.t, - _iotas:W64.t) : W256.t * W256.t * W256.t * W256.t * - W256.t * W256.t * W256.t = { + proc keccak_f (state:W256.t Array7.t, _rhotates_left:W64.t, + _rhotates_right:W64.t, _iotas:W64.t) : W256.t Array7.t = { var rhotates_left:W64.t; var rhotates_right:W64.t; var iotas:W64.t; - var i:W32.t; + var r:W32.t; var zf:bool; - var _C00:W256.t; - var _C14:W256.t; - var _T:W256.t Array9.t; - var _D14:W256.t; - var _D00:W256.t; + var c00:W256.t; + var c14:W256.t; + var t:W256.t Array9.t; + var d14:W256.t; + var d00:W256.t; var _0:bool; var _1:bool; var _2:bool; - _T <- witness; + t <- witness; rhotates_left <- (_rhotates_left + (W64.of_int 96)); rhotates_right <- (_rhotates_right + (W64.of_int 96)); iotas <- _iotas; - i <- (W32.of_int 24); - _C00 <- x86_VPSHUF_D_256 _A20 (W8.of_int 78); - _C14 <- (_A41 `^` _A31); - _T.[2] <- (_A21 `^` _A11); - _C14 <- (_C14 `^` _A01); - _C14 <- (_C14 `^` _T.[2]); - _T.[4] <- x86_VPERMQ _C14 (W8.of_int 147); - _C00 <- (_C00 `^` _A20); - _T.[0] <- x86_VPERMQ _C00 (W8.of_int 78); - _T.[1] <- (_C14 \vshr64u256 (W8.of_int 63)); - _T.[2] <- (_C14 \vadd64u256 _C14); - _T.[1] <- (_T.[1] `|` _T.[2]); - _D14 <- x86_VPERMQ _T.[1] (W8.of_int 57); - _D00 <- (_T.[1] `^` _T.[4]); - _D00 <- x86_VPERMQ _D00 (W8.of_int 0); - _C00 <- (_C00 `^` _A00); - _C00 <- (_C00 `^` _T.[0]); - _T.[0] <- (_C00 \vshr64u256 (W8.of_int 63)); - _T.[1] <- (_C00 \vadd64u256 _C00); - _T.[1] <- (_T.[1] `|` _T.[0]); - _A20 <- (_A20 `^` _D00); - _A00 <- (_A00 `^` _D00); - _D14 <- x86_VPBLEN_D_D_256 _D14 _T.[1] - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); - _T.[4] <- x86_VPBLEN_D_D_256 _T.[4] _C00 - (W8.of_int (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); - _D14 <- (_D14 `^` _T.[4]); - _T.[3] <- x86_VPSLLV_4u64 _A20 + r <- (W32.of_int 24); + c00 <- x86_VPSHUFD_256 state.[2] + (W8.of_int (2 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 1)))); + c14 <- (state.[5] `^` state.[3]); + t.[2] <- (state.[4] `^` state.[6]); + c14 <- (c14 `^` state.[1]); + c14 <- (c14 `^` t.[2]); + t.[4] <- x86_VPERMQ c14 + (W8.of_int (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (1 %% 2^2 + 2^2 * 2)))); + c00 <- (c00 `^` state.[2]); + t.[0] <- x86_VPERMQ c00 + (W8.of_int (2 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 1)))); + t.[1] <- (c14 \vshr64u256 (W8.of_int 63)); + t.[2] <- (c14 \vadd64u256 c14); + t.[1] <- (t.[1] `|` t.[2]); + d14 <- x86_VPERMQ t.[1] + (W8.of_int (1 %% 2^2 + 2^2 * (2 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + d00 <- (t.[1] `^` t.[4]); + d00 <- x86_VPERMQ d00 + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + c00 <- (c00 `^` state.[0]); + c00 <- (c00 `^` t.[0]); + t.[0] <- (c00 \vshr64u256 (W8.of_int 63)); + t.[1] <- (c00 \vadd64u256 c00); + t.[1] <- (t.[1] `|` t.[0]); + state.[2] <- (state.[2] `^` d00); + state.[0] <- (state.[0] `^` d00); + d14 <- x86_VPBLENDD_256 d14 t.[1] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + t.[4] <- x86_VPBLENDD_256 t.[4] c00 + (W8.of_int (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + d14 <- (d14 `^` t.[4]); + t.[3] <- x86_VPSLLV_4u64 state.[2] (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((0 * 32) - 96))))); - _A20 <- x86_VPSRLV_4u64 _A20 + state.[2] <- x86_VPSRLV_4u64 state.[2] (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((0 * 32) - 96))))); - _A20 <- (_A20 `|` _T.[3]); - _A31 <- (_A31 `^` _D14); - _T.[4] <- x86_VPSLLV_4u64 _A31 + state.[2] <- (state.[2] `|` t.[3]); + state.[3] <- (state.[3] `^` d14); + t.[4] <- x86_VPSLLV_4u64 state.[3] (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((2 * 32) - 96))))); - _A31 <- x86_VPSRLV_4u64 _A31 + state.[3] <- x86_VPSRLV_4u64 state.[3] (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((2 * 32) - 96))))); - _A31 <- (_A31 `|` _T.[4]); - _A21 <- (_A21 `^` _D14); - _T.[5] <- x86_VPSLLV_4u64 _A21 + state.[3] <- (state.[3] `|` t.[4]); + state.[4] <- (state.[4] `^` d14); + t.[5] <- x86_VPSLLV_4u64 state.[4] (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((3 * 32) - 96))))); - _A21 <- x86_VPSRLV_4u64 _A21 + state.[4] <- x86_VPSRLV_4u64 state.[4] (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((3 * 32) - 96))))); - _A21 <- (_A21 `|` _T.[5]); - _A41 <- (_A41 `^` _D14); - _T.[6] <- x86_VPSLLV_4u64 _A41 + state.[4] <- (state.[4] `|` t.[5]); + state.[5] <- (state.[5] `^` d14); + t.[6] <- x86_VPSLLV_4u64 state.[5] (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((4 * 32) - 96))))); - _A41 <- x86_VPSRLV_4u64 _A41 + state.[5] <- x86_VPSRLV_4u64 state.[5] (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((4 * 32) - 96))))); - _A41 <- (_A41 `|` _T.[6]); - _A11 <- (_A11 `^` _D14); - _T.[3] <- x86_VPERMQ _A20 (W8.of_int 141); - _T.[4] <- x86_VPERMQ _A31 (W8.of_int 141); - _T.[7] <- x86_VPSLLV_4u64 _A11 + state.[5] <- (state.[5] `|` t.[6]); + state.[6] <- (state.[6] `^` d14); + t.[3] <- x86_VPERMQ state.[2] + (W8.of_int (1 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 2)))); + t.[4] <- x86_VPERMQ state.[3] + (W8.of_int (1 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 2)))); + t.[7] <- x86_VPSLLV_4u64 state.[6] (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((5 * 32) - 96))))); - _T.[1] <- x86_VPSRLV_4u64 _A11 + t.[1] <- x86_VPSRLV_4u64 state.[6] (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((5 * 32) - 96))))); - _T.[1] <- (_T.[1] `|` _T.[7]); - _A01 <- (_A01 `^` _D14); - _T.[5] <- x86_VPERMQ _A21 (W8.of_int 27); - _T.[6] <- x86_VPERMQ _A41 (W8.of_int 114); - _T.[8] <- x86_VPSLLV_4u64 _A01 + t.[1] <- (t.[1] `|` t.[7]); + state.[1] <- (state.[1] `^` d14); + t.[5] <- x86_VPERMQ state.[4] + (W8.of_int (3 %% 2^2 + 2^2 * (2 %% 2^2 + 2^2 * (1 %% 2^2 + 2^2 * 0)))); + t.[6] <- x86_VPERMQ state.[5] + (W8.of_int (2 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 1)))); + t.[8] <- x86_VPSLLV_4u64 state.[1] (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((1 * 32) - 96))))); - _T.[2] <- x86_VPSRLV_4u64 _A01 + t.[2] <- x86_VPSRLV_4u64 state.[1] (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((1 * 32) - 96))))); - _T.[2] <- (_T.[2] `|` _T.[8]); - _T.[7] <- x86_VPSRL_DQ_256 _T.[1] (W8.of_int 8); - _T.[0] <- ((invw _T.[1]) `&` _T.[7]); - _A31 <- x86_VPBLEN_D_D_256 _T.[2] _T.[6] - (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); - _T.[8] <- x86_VPBLEN_D_D_256 _T.[4] _T.[2] - (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); - _A41 <- x86_VPBLEN_D_D_256 _T.[3] _T.[4] - (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); - _T.[7] <- x86_VPBLEN_D_D_256 _T.[2] _T.[3] - (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); - _A31 <- x86_VPBLEN_D_D_256 _A31 _T.[4] - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); - _T.[8] <- x86_VPBLEN_D_D_256 _T.[8] _T.[5] - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); - _A41 <- x86_VPBLEN_D_D_256 _A41 _T.[2] - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); - _T.[7] <- x86_VPBLEN_D_D_256 _T.[7] _T.[6] - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); - _A31 <- x86_VPBLEN_D_D_256 _A31 _T.[5] - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); - _T.[8] <- x86_VPBLEN_D_D_256 _T.[8] _T.[6] - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); - _A41 <- x86_VPBLEN_D_D_256 _A41 _T.[6] - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); - _T.[7] <- x86_VPBLEN_D_D_256 _T.[7] _T.[4] - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); - _A31 <- x86_VPANDN_256 _A31 _T.[8]; - _A41 <- x86_VPANDN_256 _A41 _T.[7]; - _A11 <- x86_VPBLEN_D_D_256 _T.[5] _T.[2] - (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); - _T.[8] <- x86_VPBLEN_D_D_256 _T.[3] _T.[5] - (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); - _A31 <- (_A31 `^` _T.[3]); - _A11 <- x86_VPBLEN_D_D_256 _A11 _T.[3] - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); - _T.[8] <- x86_VPBLEN_D_D_256 _T.[8] _T.[4] - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); - _A41 <- (_A41 `^` _T.[5]); - _A11 <- x86_VPBLEN_D_D_256 _A11 _T.[4] - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); - _T.[8] <- x86_VPBLEN_D_D_256 _T.[8] _T.[2] - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); - _A11 <- x86_VPANDN_256 _A11 _T.[8]; - _A11 <- (_A11 `^` _T.[6]); - _A21 <- x86_VPERMQ _T.[1] (W8.of_int 30); - _T.[8] <- x86_VPBLEN_D_D_256 _A21 _A00 - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); - _A01 <- x86_VPERMQ _T.[1] (W8.of_int 57); - _A01 <- x86_VPBLEN_D_D_256 _A01 _A00 - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); - _A01 <- x86_VPANDN_256 _A01 _T.[8]; - _A20 <- x86_VPBLEN_D_D_256 _T.[4] _T.[5] - (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); - _T.[7] <- x86_VPBLEN_D_D_256 _T.[6] _T.[4] - (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); - _A20 <- x86_VPBLEN_D_D_256 _A20 _T.[6] - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); - _T.[7] <- x86_VPBLEN_D_D_256 _T.[7] _T.[3] - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); - _A20 <- x86_VPBLEN_D_D_256 _A20 _T.[3] - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); - _T.[7] <- x86_VPBLEN_D_D_256 _T.[7] _T.[5] - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); - _A20 <- x86_VPANDN_256 _A20 _T.[7]; - _A20 <- (_A20 `^` _T.[2]); - _T.[0] <- x86_VPERMQ _T.[0] (W8.of_int 0); - _A31 <- x86_VPERMQ _A31 (W8.of_int 27); - _A41 <- x86_VPERMQ _A41 (W8.of_int 141); - _A11 <- x86_VPERMQ _A11 (W8.of_int 114); - _A21 <- x86_VPBLEN_D_D_256 _T.[6] _T.[3] - (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); - _T.[7] <- x86_VPBLEN_D_D_256 _T.[5] _T.[6] - (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); - _A21 <- x86_VPBLEN_D_D_256 _A21 _T.[5] - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); - _T.[7] <- x86_VPBLEN_D_D_256 _T.[7] _T.[2] - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); - _A21 <- x86_VPBLEN_D_D_256 _A21 _T.[2] - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); - _T.[7] <- x86_VPBLEN_D_D_256 _T.[7] _T.[3] - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); - _A21 <- x86_VPANDN_256 _A21 _T.[7]; - _A00 <- (_A00 `^` _T.[0]); - _A01 <- (_A01 `^` _T.[1]); - _A21 <- (_A21 `^` _T.[4]); - _A00 <- - (_A00 `^` (loadW256 Glob.mem (W64.to_uint (iotas + (W64.of_int 0))))); + t.[2] <- (t.[2] `|` t.[8]); + t.[7] <- x86_VPSRLDQ_256 t.[1] (W8.of_int 8); + t.[0] <- ((invw t.[1]) `&` t.[7]); + state.[3] <- x86_VPBLENDD_256 t.[2] t.[6] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[8] <- x86_VPBLENDD_256 t.[4] t.[2] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[5] <- x86_VPBLENDD_256 t.[3] t.[4] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[7] <- x86_VPBLENDD_256 t.[2] t.[3] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[3] <- x86_VPBLENDD_256 state.[3] t.[4] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[8] <- x86_VPBLENDD_256 t.[8] t.[5] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[5] <- x86_VPBLENDD_256 state.[5] t.[2] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[7] <- x86_VPBLENDD_256 t.[7] t.[6] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[3] <- x86_VPBLENDD_256 state.[3] t.[5] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + t.[8] <- x86_VPBLENDD_256 t.[8] t.[6] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + state.[5] <- x86_VPBLENDD_256 state.[5] t.[6] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + t.[7] <- x86_VPBLENDD_256 t.[7] t.[4] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + state.[3] <- ((invw state.[3]) `&` t.[8]); + state.[5] <- ((invw state.[5]) `&` t.[7]); + state.[6] <- x86_VPBLENDD_256 t.[5] t.[2] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[8] <- x86_VPBLENDD_256 t.[3] t.[5] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[3] <- (state.[3] `^` t.[3]); + state.[6] <- x86_VPBLENDD_256 state.[6] t.[3] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[8] <- x86_VPBLENDD_256 t.[8] t.[4] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[5] <- (state.[5] `^` t.[5]); + state.[6] <- x86_VPBLENDD_256 state.[6] t.[4] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + t.[8] <- x86_VPBLENDD_256 t.[8] t.[2] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + state.[6] <- ((invw state.[6]) `&` t.[8]); + state.[6] <- (state.[6] `^` t.[6]); + state.[4] <- x86_VPERMQ t.[1] + (W8.of_int (2 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (1 %% 2^2 + 2^2 * 0)))); + t.[8] <- x86_VPBLENDD_256 state.[4] state.[0] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[1] <- x86_VPERMQ t.[1] + (W8.of_int (1 %% 2^2 + 2^2 * (2 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + state.[1] <- x86_VPBLENDD_256 state.[1] state.[0] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + state.[1] <- ((invw state.[1]) `&` t.[8]); + state.[2] <- x86_VPBLENDD_256 t.[4] t.[5] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[7] <- x86_VPBLENDD_256 t.[6] t.[4] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[2] <- x86_VPBLENDD_256 state.[2] t.[6] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[7] <- x86_VPBLENDD_256 t.[7] t.[3] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[2] <- x86_VPBLENDD_256 state.[2] t.[3] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + t.[7] <- x86_VPBLENDD_256 t.[7] t.[5] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + state.[2] <- ((invw state.[2]) `&` t.[7]); + state.[2] <- (state.[2] `^` t.[2]); + t.[0] <- x86_VPERMQ t.[0] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + state.[3] <- x86_VPERMQ state.[3] + (W8.of_int (3 %% 2^2 + 2^2 * (2 %% 2^2 + 2^2 * (1 %% 2^2 + 2^2 * 0)))); + state.[5] <- x86_VPERMQ state.[5] + (W8.of_int (1 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 2)))); + state.[6] <- x86_VPERMQ state.[6] + (W8.of_int (2 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 1)))); + state.[4] <- x86_VPBLENDD_256 t.[6] t.[3] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[7] <- x86_VPBLENDD_256 t.[5] t.[6] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[4] <- x86_VPBLENDD_256 state.[4] t.[5] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[7] <- x86_VPBLENDD_256 t.[7] t.[2] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[4] <- x86_VPBLENDD_256 state.[4] t.[2] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + t.[7] <- x86_VPBLENDD_256 t.[7] t.[3] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + state.[4] <- ((invw state.[4]) `&` t.[7]); + state.[0] <- (state.[0] `^` t.[0]); + state.[1] <- (state.[1] `^` t.[1]); + state.[4] <- (state.[4] `^` t.[4]); + state.[0] <- + (state.[0] `^` (loadW256 Glob.mem (W64.to_uint (iotas + (W64.of_int ((0 * 32) - 0)))))); iotas <- (iotas + (W64.of_int 32)); - ( _0, _1, _2, zf, i) <- x86_DEC_32 i; + ( _0, _1, _2, zf, r) <- x86_DEC_32 r; while ((! zf)) { - _C00 <- x86_VPSHUF_D_256 _A20 (W8.of_int 78); - _C14 <- (_A41 `^` _A31); - _T.[2] <- (_A21 `^` _A11); - _C14 <- (_C14 `^` _A01); - _C14 <- (_C14 `^` _T.[2]); - _T.[4] <- x86_VPERMQ _C14 (W8.of_int 147); - _C00 <- (_C00 `^` _A20); - _T.[0] <- x86_VPERMQ _C00 (W8.of_int 78); - _T.[1] <- (_C14 \vshr64u256 (W8.of_int 63)); - _T.[2] <- (_C14 \vadd64u256 _C14); - _T.[1] <- (_T.[1] `|` _T.[2]); - _D14 <- x86_VPERMQ _T.[1] (W8.of_int 57); - _D00 <- (_T.[1] `^` _T.[4]); - _D00 <- x86_VPERMQ _D00 (W8.of_int 0); - _C00 <- (_C00 `^` _A00); - _C00 <- (_C00 `^` _T.[0]); - _T.[0] <- (_C00 \vshr64u256 (W8.of_int 63)); - _T.[1] <- (_C00 \vadd64u256 _C00); - _T.[1] <- (_T.[1] `|` _T.[0]); - _A20 <- (_A20 `^` _D00); - _A00 <- (_A00 `^` _D00); - _D14 <- x86_VPBLEN_D_D_256 _D14 _T.[1] - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); - _T.[4] <- x86_VPBLEN_D_D_256 _T.[4] _C00 - (W8.of_int (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); - _D14 <- (_D14 `^` _T.[4]); - _T.[3] <- x86_VPSLLV_4u64 _A20 + c00 <- x86_VPSHUFD_256 state.[2] + (W8.of_int (2 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 1)))); + c14 <- (state.[5] `^` state.[3]); + t.[2] <- (state.[4] `^` state.[6]); + c14 <- (c14 `^` state.[1]); + c14 <- (c14 `^` t.[2]); + t.[4] <- x86_VPERMQ c14 + (W8.of_int (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (1 %% 2^2 + 2^2 * 2)))); + c00 <- (c00 `^` state.[2]); + t.[0] <- x86_VPERMQ c00 + (W8.of_int (2 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 1)))); + t.[1] <- (c14 \vshr64u256 (W8.of_int 63)); + t.[2] <- (c14 \vadd64u256 c14); + t.[1] <- (t.[1] `|` t.[2]); + d14 <- x86_VPERMQ t.[1] + (W8.of_int (1 %% 2^2 + 2^2 * (2 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + d00 <- (t.[1] `^` t.[4]); + d00 <- x86_VPERMQ d00 + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + c00 <- (c00 `^` state.[0]); + c00 <- (c00 `^` t.[0]); + t.[0] <- (c00 \vshr64u256 (W8.of_int 63)); + t.[1] <- (c00 \vadd64u256 c00); + t.[1] <- (t.[1] `|` t.[0]); + state.[2] <- (state.[2] `^` d00); + state.[0] <- (state.[0] `^` d00); + d14 <- x86_VPBLENDD_256 d14 t.[1] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + t.[4] <- x86_VPBLENDD_256 t.[4] c00 + (W8.of_int (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + d14 <- (d14 `^` t.[4]); + t.[3] <- x86_VPSLLV_4u64 state.[2] (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((0 * 32) - 96))))); - _A20 <- x86_VPSRLV_4u64 _A20 + state.[2] <- x86_VPSRLV_4u64 state.[2] (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((0 * 32) - 96))))); - _A20 <- (_A20 `|` _T.[3]); - _A31 <- (_A31 `^` _D14); - _T.[4] <- x86_VPSLLV_4u64 _A31 + state.[2] <- (state.[2] `|` t.[3]); + state.[3] <- (state.[3] `^` d14); + t.[4] <- x86_VPSLLV_4u64 state.[3] (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((2 * 32) - 96))))); - _A31 <- x86_VPSRLV_4u64 _A31 + state.[3] <- x86_VPSRLV_4u64 state.[3] (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((2 * 32) - 96))))); - _A31 <- (_A31 `|` _T.[4]); - _A21 <- (_A21 `^` _D14); - _T.[5] <- x86_VPSLLV_4u64 _A21 + state.[3] <- (state.[3] `|` t.[4]); + state.[4] <- (state.[4] `^` d14); + t.[5] <- x86_VPSLLV_4u64 state.[4] (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((3 * 32) - 96))))); - _A21 <- x86_VPSRLV_4u64 _A21 + state.[4] <- x86_VPSRLV_4u64 state.[4] (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((3 * 32) - 96))))); - _A21 <- (_A21 `|` _T.[5]); - _A41 <- (_A41 `^` _D14); - _T.[6] <- x86_VPSLLV_4u64 _A41 + state.[4] <- (state.[4] `|` t.[5]); + state.[5] <- (state.[5] `^` d14); + t.[6] <- x86_VPSLLV_4u64 state.[5] (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((4 * 32) - 96))))); - _A41 <- x86_VPSRLV_4u64 _A41 + state.[5] <- x86_VPSRLV_4u64 state.[5] (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((4 * 32) - 96))))); - _A41 <- (_A41 `|` _T.[6]); - _A11 <- (_A11 `^` _D14); - _T.[3] <- x86_VPERMQ _A20 (W8.of_int 141); - _T.[4] <- x86_VPERMQ _A31 (W8.of_int 141); - _T.[7] <- x86_VPSLLV_4u64 _A11 + state.[5] <- (state.[5] `|` t.[6]); + state.[6] <- (state.[6] `^` d14); + t.[3] <- x86_VPERMQ state.[2] + (W8.of_int (1 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 2)))); + t.[4] <- x86_VPERMQ state.[3] + (W8.of_int (1 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 2)))); + t.[7] <- x86_VPSLLV_4u64 state.[6] (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((5 * 32) - 96))))); - _T.[1] <- x86_VPSRLV_4u64 _A11 + t.[1] <- x86_VPSRLV_4u64 state.[6] (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((5 * 32) - 96))))); - _T.[1] <- (_T.[1] `|` _T.[7]); - _A01 <- (_A01 `^` _D14); - _T.[5] <- x86_VPERMQ _A21 (W8.of_int 27); - _T.[6] <- x86_VPERMQ _A41 (W8.of_int 114); - _T.[8] <- x86_VPSLLV_4u64 _A01 + t.[1] <- (t.[1] `|` t.[7]); + state.[1] <- (state.[1] `^` d14); + t.[5] <- x86_VPERMQ state.[4] + (W8.of_int (3 %% 2^2 + 2^2 * (2 %% 2^2 + 2^2 * (1 %% 2^2 + 2^2 * 0)))); + t.[6] <- x86_VPERMQ state.[5] + (W8.of_int (2 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 1)))); + t.[8] <- x86_VPSLLV_4u64 state.[1] (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((1 * 32) - 96))))); - _T.[2] <- x86_VPSRLV_4u64 _A01 + t.[2] <- x86_VPSRLV_4u64 state.[1] (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((1 * 32) - 96))))); - _T.[2] <- (_T.[2] `|` _T.[8]); - _T.[7] <- x86_VPSRL_DQ_256 _T.[1] (W8.of_int 8); - _T.[0] <- ((invw _T.[1]) `&` _T.[7]); - _A31 <- x86_VPBLEN_D_D_256 _T.[2] _T.[6] - (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); - _T.[8] <- x86_VPBLEN_D_D_256 _T.[4] _T.[2] - (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); - _A41 <- x86_VPBLEN_D_D_256 _T.[3] _T.[4] - (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); - _T.[7] <- x86_VPBLEN_D_D_256 _T.[2] _T.[3] - (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); - _A31 <- x86_VPBLEN_D_D_256 _A31 _T.[4] - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); - _T.[8] <- x86_VPBLEN_D_D_256 _T.[8] _T.[5] - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); - _A41 <- x86_VPBLEN_D_D_256 _A41 _T.[2] - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); - _T.[7] <- x86_VPBLEN_D_D_256 _T.[7] _T.[6] - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); - _A31 <- x86_VPBLEN_D_D_256 _A31 _T.[5] - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); - _T.[8] <- x86_VPBLEN_D_D_256 _T.[8] _T.[6] - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); - _A41 <- x86_VPBLEN_D_D_256 _A41 _T.[6] - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); - _T.[7] <- x86_VPBLEN_D_D_256 _T.[7] _T.[4] - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); - _A31 <- x86_VPANDN_256 _A31 _T.[8]; - _A41 <- x86_VPANDN_256 _A41 _T.[7]; - _A11 <- x86_VPBLENDD_256 _T.[5] _T.[2] - (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); - _T.[8] <- x86_VPBLEN_D_D_256 _T.[3] _T.[5] - (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); - _A31 <- (_A31 `^` _T.[3]); - _A11 <- x86_VPBLEN_D_D_256 _A11 _T.[3] - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); - _T.[8] <- x86_VPBLEN_D_D_256 _T.[8] _T.[4] - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); - _A41 <- (_A41 `^` _T.[5]); - _A11 <- x86_VPBLEN_D_D_256 _A11 _T.[4] - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); - _T.[8] <- x86_VPBLEN_D_D_256 _T.[8] _T.[2] - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); - _A11 <- x86_VPANDN_256 _A11 _T.[8]; - _A11 <- (_A11 `^` _T.[6]); - _A21 <- x86_VPERMQ _T.[1] (W8.of_int 30); - _T.[8] <- x86_VPBLEN_D_D_256 _A21 _A00 - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); - _A01 <- x86_VPERMQ _T.[1] (W8.of_int 57); - _A01 <- x86_VPBLEN_D_D_256 _A01 _A00 - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); - _A01 <- x86_VPANDN_256 _A01 _T.[8]; - _A20 <- x86_VPBLEN_D_D_256 _T.[4] _T.[5] - (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); - _T.[7] <- x86_VPBLEN_D_D_256 _T.[6] _T.[4] - (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); - _A20 <- x86_VPBLEN_D_D_256 _A20 _T.[6] - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); - _T.[7] <- x86_VPBLEN_D_D_256 _T.[7] _T.[3] - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); - _A20 <- x86_VPBLEN_D_D_256 _A20 _T.[3] - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); - _T.[7] <- x86_VPBLEN_D_D_256 _T.[7] _T.[5] - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); - _A20 <- x86_VPANDN_256 _A20 _T.[7]; - _A20 <- (_A20 `^` _T.[2]); - _T.[0] <- x86_VPERMQ _T.[0] (W8.of_int 0); - _A31 <- x86_VPERMQ _A31 (W8.of_int 27); - _A41 <- x86_VPERMQ _A41 (W8.of_int 141); - _A11 <- x86_VPERMQ _A11 (W8.of_int 114); - _A21 <- x86_VPBLEN_D_D_256 _T.[6] _T.[3] - (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); - _T.[7] <- x86_VPBLEN_D_D_256 _T.[5] _T.[6] - (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); - _A21 <- x86_VPBLEN_D_D_256 _A21 _T.[5] - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); - _T.[7] <- x86_VPBLEN_D_D_256 _T.[7] _T.[2] - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); - _A21 <- x86_VPBLEN_D_D_256 _A21 _T.[2] - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); - _T.[7] <- x86_VPBLEN_D_D_256 _T.[7] _T.[3] - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); - _A21 <- x86_VPANDN_256 _A21 _T.[7]; - _A00 <- (_A00 `^` _T.[0]); - _A01 <- (_A01 `^` _T.[1]); - _A21 <- (_A21 `^` _T.[4]); - _A00 <- - (_A00 `^` (loadW256 Glob.mem (W64.to_uint (iotas + (W64.of_int 0))))); + t.[2] <- (t.[2] `|` t.[8]); + t.[7] <- x86_VPSRLDQ_256 t.[1] (W8.of_int 8); + t.[0] <- ((invw t.[1]) `&` t.[7]); + state.[3] <- x86_VPBLENDD_256 t.[2] t.[6] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[8] <- x86_VPBLENDD_256 t.[4] t.[2] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[5] <- x86_VPBLENDD_256 t.[3] t.[4] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[7] <- x86_VPBLENDD_256 t.[2] t.[3] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[3] <- x86_VPBLENDD_256 state.[3] t.[4] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[8] <- x86_VPBLENDD_256 t.[8] t.[5] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[5] <- x86_VPBLENDD_256 state.[5] t.[2] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[7] <- x86_VPBLENDD_256 t.[7] t.[6] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[3] <- x86_VPBLENDD_256 state.[3] t.[5] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + t.[8] <- x86_VPBLENDD_256 t.[8] t.[6] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + state.[5] <- x86_VPBLENDD_256 state.[5] t.[6] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + t.[7] <- x86_VPBLENDD_256 t.[7] t.[4] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + state.[3] <- ((invw state.[3]) `&` t.[8]); + state.[5] <- ((invw state.[5]) `&` t.[7]); + state.[6] <- x86_VPBLENDD_256 t.[5] t.[2] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[8] <- x86_VPBLENDD_256 t.[3] t.[5] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[3] <- (state.[3] `^` t.[3]); + state.[6] <- x86_VPBLENDD_256 state.[6] t.[3] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[8] <- x86_VPBLENDD_256 t.[8] t.[4] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[5] <- (state.[5] `^` t.[5]); + state.[6] <- x86_VPBLENDD_256 state.[6] t.[4] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + t.[8] <- x86_VPBLENDD_256 t.[8] t.[2] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + state.[6] <- ((invw state.[6]) `&` t.[8]); + state.[6] <- (state.[6] `^` t.[6]); + state.[4] <- x86_VPERMQ t.[1] + (W8.of_int (2 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (1 %% 2^2 + 2^2 * 0)))); + t.[8] <- x86_VPBLENDD_256 state.[4] state.[0] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[1] <- x86_VPERMQ t.[1] + (W8.of_int (1 %% 2^2 + 2^2 * (2 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + state.[1] <- x86_VPBLENDD_256 state.[1] state.[0] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + state.[1] <- ((invw state.[1]) `&` t.[8]); + state.[2] <- x86_VPBLENDD_256 t.[4] t.[5] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[7] <- x86_VPBLENDD_256 t.[6] t.[4] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[2] <- x86_VPBLENDD_256 state.[2] t.[6] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[7] <- x86_VPBLENDD_256 t.[7] t.[3] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[2] <- x86_VPBLENDD_256 state.[2] t.[3] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + t.[7] <- x86_VPBLENDD_256 t.[7] t.[5] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + state.[2] <- ((invw state.[2]) `&` t.[7]); + state.[2] <- (state.[2] `^` t.[2]); + t.[0] <- x86_VPERMQ t.[0] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + state.[3] <- x86_VPERMQ state.[3] + (W8.of_int (3 %% 2^2 + 2^2 * (2 %% 2^2 + 2^2 * (1 %% 2^2 + 2^2 * 0)))); + state.[5] <- x86_VPERMQ state.[5] + (W8.of_int (1 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 2)))); + state.[6] <- x86_VPERMQ state.[6] + (W8.of_int (2 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 1)))); + state.[4] <- x86_VPBLENDD_256 t.[6] t.[3] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[7] <- x86_VPBLENDD_256 t.[5] t.[6] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[4] <- x86_VPBLENDD_256 state.[4] t.[5] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[7] <- x86_VPBLENDD_256 t.[7] t.[2] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[4] <- x86_VPBLENDD_256 state.[4] t.[2] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + t.[7] <- x86_VPBLENDD_256 t.[7] t.[3] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + state.[4] <- ((invw state.[4]) `&` t.[7]); + state.[0] <- (state.[0] `^` t.[0]); + state.[1] <- (state.[1] `^` t.[1]); + state.[4] <- (state.[4] `^` t.[4]); + state.[0] <- + (state.[0] `^` (loadW256 Glob.mem (W64.to_uint (iotas + (W64.of_int ((0 * 32) - 0)))))); iotas <- (iotas + (W64.of_int 32)); - ( _0, _1, _2, zf, i) <- x86_DEC_32 i; + ( _0, _1, _2, zf, r) <- x86_DEC_32 r; } - return (_A00, _A01, _A20, _A31, _A21, _A41, _A11); + return (state); } }. -require import keccak_f1600_ref. \ No newline at end of file +op states_match (state : W256.t Array7.t) + (_A00 _A01 _A20 _A31 _A21 _A41 _A11:W256.t) = + state.[0] = _A00 /\ + state.[1] = _A01 /\ + state.[2] = _A20 /\ + state.[3] = _A31 /\ + state.[4] = _A21 /\ + state.[5] = _A41 /\ + state.[6] = _A11. + +lemma andn (w1 w2 : W256.t) : + invw w1 `&` w2 = + x86_VPANDN_256 w1 w2 by admit. + +lemma avx2_avx2openssl : + equiv [ Mavx2openssl.__KeccakF1600 ~ Mavx2.keccak_f : + states_match state{2} _A00{1} _A01{1} _A20{1} _A31{1} _A21{1} _A41{1} _A11{1} /\ + ={_rhotates_left, _rhotates_right, _iotas, Glob.mem} ==> + states_match res{2} res{1}.`1 res{1}.`2 res{1}.`3 res{1}.`4 res{1}.`5 res{1}.`6 res{1}.`7 ]. +proc. +seq 112 112 : (#pre /\ ={rhotates_left,rhotates_right,iotas} /\ i{1} = r{2} /\ _T{1} = t{2} /\ ={zf}) . + +seq 10 10 : (#pre /\ ={rhotates_left,rhotates_right,iotas} /\ i{1} = r{2} /\ _T{1} = t{2} /\ _C00{1} = c00{2} /\ _C14{1} = c14{2} ) . +by auto => />. +seq 10 10 : (#pre /\_D14{1} = d14{2} /\ _D00{1} = d00{2}) . +by auto => />. +seq 10 10 : #pre. +by auto => />. +seq 10 10 : #pre. +by auto => />. +seq 10 10 : #pre. +by auto => />. +seq 10 10 : #pre. +by auto => />. +seq 10 10 : #pre. +by auto => />. +seq 10 10 : #pre. +auto => />. +smt(andn). + +seq 10 10 : #pre. +auto => />. +smt(andn). + +seq 10 10 : #pre. +auto => />. +smt(andn). + + +seq 10 10 : #pre. +auto => />. +smt(andn). + +by auto => />. + +while(#pre). + +seq 10 10 : (#pre /\ _T{1} = t{2} /\ _C00{1} = c00{2} /\ _C14{1} = c14{2} ) . +by auto => />. +seq 10 10 : (#pre /\_D14{1} = d14{2} /\ _D00{1} = d00{2}) . +by auto => />. +seq 10 10 : #pre. +by auto => />. +seq 10 10 : #pre. +by auto => />. +seq 10 10 : #pre. +by auto => />. +seq 10 10 : #pre. +by auto => />. +seq 10 10 : #pre. +auto => />. +smt(andn). + +seq 10 10 : #pre. +auto => />. +smt(andn). + +seq 10 10 : #pre. +auto => />. +smt(andn). + +seq 10 10 : #pre. +by auto => />. + +auto => />. +smt(andn). + +by auto => />. + +qed. diff --git a/proof/impl/perm/keccak_f1600_avx2_openssl.ec b/proof/impl/perm/keccak_f1600_avx2_openssl.ec new file mode 100644 index 0000000..e428f84 --- /dev/null +++ b/proof/impl/perm/keccak_f1600_avx2_openssl.ec @@ -0,0 +1,355 @@ +require import List Int IntExtra IntDiv CoreMap. +from Jasmin require import JModel. + +(* +require import Array9. +require import WArray288. +*) + +clone export PolyArray as Array9 with op size <- 9. +clone export WArray as WArray288 with op size <- 288. + +op x86_VPBLENDD_256 : W256.t -> W256.t -> W8.t -> W256.t. +op x86_VPANDN_256 : W256.t -> W256.t -> W256.t. +op x86_VPSLLV_4u64 : W256.t -> W256.t -> W256.t. +op x86_VPSRLV_4u64 : W256.t -> W256.t -> W256.t. +op x86_DEC_32 : W32.t -> bool * bool * bool * bool * W32.t. + +module Mavx2openssl = { + proc __KeccakF1600 (_A00:W256.t, _A01:W256.t, _A20:W256.t, _A31:W256.t, + _A21:W256.t, _A41:W256.t, _A11:W256.t, + _rhotates_left:W64.t, _rhotates_right:W64.t, + _iotas:W64.t) : W256.t * W256.t * W256.t * W256.t * + W256.t * W256.t * W256.t = { + + var rhotates_left:W64.t; + var rhotates_right:W64.t; + var iotas:W64.t; + var i:W32.t; + var zf:bool; + var _C00:W256.t; + var _C14:W256.t; + var _T:W256.t Array9.t; + var _D14:W256.t; + var _D00:W256.t; + var _0:bool; + var _1:bool; + var _2:bool; + _T <- witness; + rhotates_left <- (_rhotates_left + (W64.of_int 96)); + rhotates_right <- (_rhotates_right + (W64.of_int 96)); + iotas <- _iotas; + i <- (W32.of_int 24); + _C00 <- x86_VPSHUFD_256 _A20 (W8.of_int 78); + _C14 <- (_A41 `^` _A31); + _T.[2] <- (_A21 `^` _A11); + _C14 <- (_C14 `^` _A01); + _C14 <- (_C14 `^` _T.[2]); + _T.[4] <- x86_VPERMQ _C14 (W8.of_int 147); + _C00 <- (_C00 `^` _A20); + _T.[0] <- x86_VPERMQ _C00 (W8.of_int 78); + _T.[1] <- (_C14 \vshr64u256 (W8.of_int 63)); + _T.[2] <- (_C14 \vadd64u256 _C14); + _T.[1] <- (_T.[1] `|` _T.[2]); + _D14 <- x86_VPERMQ _T.[1] (W8.of_int 57); + _D00 <- (_T.[1] `^` _T.[4]); + _D00 <- x86_VPERMQ _D00 (W8.of_int 0); + _C00 <- (_C00 `^` _A00); + _C00 <- (_C00 `^` _T.[0]); + _T.[0] <- (_C00 \vshr64u256 (W8.of_int 63)); + _T.[1] <- (_C00 \vadd64u256 _C00); + _T.[1] <- (_T.[1] `|` _T.[0]); + _A20 <- (_A20 `^` _D00); + _A00 <- (_A00 `^` _D00); + _D14 <- x86_VPBLENDD_256 _D14 _T.[1] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + _T.[4] <- x86_VPBLENDD_256 _T.[4] _C00 + (W8.of_int (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + _D14 <- (_D14 `^` _T.[4]); + _T.[3] <- x86_VPSLLV_4u64 _A20 + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((0 * 32) - 96))))); + _A20 <- x86_VPSRLV_4u64 _A20 + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((0 * 32) - 96))))); + _A20 <- (_A20 `|` _T.[3]); + _A31 <- (_A31 `^` _D14); + _T.[4] <- x86_VPSLLV_4u64 _A31 + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((2 * 32) - 96))))); + _A31 <- x86_VPSRLV_4u64 _A31 + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((2 * 32) - 96))))); + _A31 <- (_A31 `|` _T.[4]); + _A21 <- (_A21 `^` _D14); + _T.[5] <- x86_VPSLLV_4u64 _A21 + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((3 * 32) - 96))))); + _A21 <- x86_VPSRLV_4u64 _A21 + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((3 * 32) - 96))))); + _A21 <- (_A21 `|` _T.[5]); + _A41 <- (_A41 `^` _D14); + _T.[6] <- x86_VPSLLV_4u64 _A41 + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((4 * 32) - 96))))); + _A41 <- x86_VPSRLV_4u64 _A41 + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((4 * 32) - 96))))); + _A41 <- (_A41 `|` _T.[6]); + _A11 <- (_A11 `^` _D14); + _T.[3] <- x86_VPERMQ _A20 (W8.of_int 141); + _T.[4] <- x86_VPERMQ _A31 (W8.of_int 141); + _T.[7] <- x86_VPSLLV_4u64 _A11 + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((5 * 32) - 96))))); + _T.[1] <- x86_VPSRLV_4u64 _A11 + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((5 * 32) - 96))))); + _T.[1] <- (_T.[1] `|` _T.[7]); + _A01 <- (_A01 `^` _D14); + _T.[5] <- x86_VPERMQ _A21 (W8.of_int 27); + _T.[6] <- x86_VPERMQ _A41 (W8.of_int 114); + _T.[8] <- x86_VPSLLV_4u64 _A01 + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((1 * 32) - 96))))); + _T.[2] <- x86_VPSRLV_4u64 _A01 + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((1 * 32) - 96))))); + _T.[2] <- (_T.[2] `|` _T.[8]); + _T.[7] <- x86_VPSRLDQ_256 _T.[1] (W8.of_int 8); + _T.[0] <- ((invw _T.[1]) `&` _T.[7]); + _A31 <- x86_VPBLENDD_256 _T.[2] _T.[6] + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + _T.[8] <- x86_VPBLENDD_256 _T.[4] _T.[2] + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + _A41 <- x86_VPBLENDD_256 _T.[3] _T.[4] + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + _T.[7] <- x86_VPBLENDD_256 _T.[2] _T.[3] + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + _A31 <- x86_VPBLENDD_256 _A31 _T.[4] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + _T.[8] <- x86_VPBLENDD_256 _T.[8] _T.[5] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + _A41 <- x86_VPBLENDD_256 _A41 _T.[2] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + _T.[7] <- x86_VPBLENDD_256 _T.[7] _T.[6] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + _A31 <- x86_VPBLENDD_256 _A31 _T.[5] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + _T.[8] <- x86_VPBLENDD_256 _T.[8] _T.[6] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + _A41 <- x86_VPBLENDD_256 _A41 _T.[6] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + _T.[7] <- x86_VPBLENDD_256 _T.[7] _T.[4] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + _A31 <- x86_VPANDN_256 _A31 _T.[8]; + _A41 <- x86_VPANDN_256 _A41 _T.[7]; + _A11 <- x86_VPBLENDD_256 _T.[5] _T.[2] + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + _T.[8] <- x86_VPBLENDD_256 _T.[3] _T.[5] + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + _A31 <- (_A31 `^` _T.[3]); + _A11 <- x86_VPBLENDD_256 _A11 _T.[3] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + _T.[8] <- x86_VPBLENDD_256 _T.[8] _T.[4] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + _A41 <- (_A41 `^` _T.[5]); + _A11 <- x86_VPBLENDD_256 _A11 _T.[4] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + _T.[8] <- x86_VPBLENDD_256 _T.[8] _T.[2] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + _A11 <- x86_VPANDN_256 _A11 _T.[8]; + _A11 <- (_A11 `^` _T.[6]); + _A21 <- x86_VPERMQ _T.[1] (W8.of_int 30); + _T.[8] <- x86_VPBLENDD_256 _A21 _A00 + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + _A01 <- x86_VPERMQ _T.[1] (W8.of_int 57); + _A01 <- x86_VPBLENDD_256 _A01 _A00 + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + _A01 <- x86_VPANDN_256 _A01 _T.[8]; + _A20 <- x86_VPBLENDD_256 _T.[4] _T.[5] + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + _T.[7] <- x86_VPBLENDD_256 _T.[6] _T.[4] + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + _A20 <- x86_VPBLENDD_256 _A20 _T.[6] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + _T.[7] <- x86_VPBLENDD_256 _T.[7] _T.[3] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + _A20 <- x86_VPBLENDD_256 _A20 _T.[3] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + _T.[7] <- x86_VPBLENDD_256 _T.[7] _T.[5] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + _A20 <- x86_VPANDN_256 _A20 _T.[7]; + _A20 <- (_A20 `^` _T.[2]); + _T.[0] <- x86_VPERMQ _T.[0] (W8.of_int 0); + _A31 <- x86_VPERMQ _A31 (W8.of_int 27); + _A41 <- x86_VPERMQ _A41 (W8.of_int 141); + _A11 <- x86_VPERMQ _A11 (W8.of_int 114); + _A21 <- x86_VPBLENDD_256 _T.[6] _T.[3] + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + _T.[7] <- x86_VPBLENDD_256 _T.[5] _T.[6] + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + _A21 <- x86_VPBLENDD_256 _A21 _T.[5] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + _T.[7] <- x86_VPBLENDD_256 _T.[7] _T.[2] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + _A21 <- x86_VPBLENDD_256 _A21 _T.[2] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + _T.[7] <- x86_VPBLENDD_256 _T.[7] _T.[3] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + _A21 <- x86_VPANDN_256 _A21 _T.[7]; + _A00 <- (_A00 `^` _T.[0]); + _A01 <- (_A01 `^` _T.[1]); + _A21 <- (_A21 `^` _T.[4]); + _A00 <- + (_A00 `^` (loadW256 Glob.mem (W64.to_uint (iotas + (W64.of_int 0))))); + iotas <- (iotas + (W64.of_int 32)); + ( _0, _1, _2, zf, i) <- x86_DEC_32 i; + while ((! zf)) { + _C00 <- x86_VPSHUFD_256 _A20 (W8.of_int 78); + _C14 <- (_A41 `^` _A31); + _T.[2] <- (_A21 `^` _A11); + _C14 <- (_C14 `^` _A01); + _C14 <- (_C14 `^` _T.[2]); + _T.[4] <- x86_VPERMQ _C14 (W8.of_int 147); + _C00 <- (_C00 `^` _A20); + _T.[0] <- x86_VPERMQ _C00 (W8.of_int 78); + _T.[1] <- (_C14 \vshr64u256 (W8.of_int 63)); + _T.[2] <- (_C14 \vadd64u256 _C14); + _T.[1] <- (_T.[1] `|` _T.[2]); + _D14 <- x86_VPERMQ _T.[1] (W8.of_int 57); + _D00 <- (_T.[1] `^` _T.[4]); + _D00 <- x86_VPERMQ _D00 (W8.of_int 0); + _C00 <- (_C00 `^` _A00); + _C00 <- (_C00 `^` _T.[0]); + _T.[0] <- (_C00 \vshr64u256 (W8.of_int 63)); + _T.[1] <- (_C00 \vadd64u256 _C00); + _T.[1] <- (_T.[1] `|` _T.[0]); + _A20 <- (_A20 `^` _D00); + _A00 <- (_A00 `^` _D00); + _D14 <- x86_VPBLENDD_256 _D14 _T.[1] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + _T.[4] <- x86_VPBLENDD_256 _T.[4] _C00 + (W8.of_int (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + _D14 <- (_D14 `^` _T.[4]); + _T.[3] <- x86_VPSLLV_4u64 _A20 + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((0 * 32) - 96))))); + _A20 <- x86_VPSRLV_4u64 _A20 + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((0 * 32) - 96))))); + _A20 <- (_A20 `|` _T.[3]); + _A31 <- (_A31 `^` _D14); + _T.[4] <- x86_VPSLLV_4u64 _A31 + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((2 * 32) - 96))))); + _A31 <- x86_VPSRLV_4u64 _A31 + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((2 * 32) - 96))))); + _A31 <- (_A31 `|` _T.[4]); + _A21 <- (_A21 `^` _D14); + _T.[5] <- x86_VPSLLV_4u64 _A21 + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((3 * 32) - 96))))); + _A21 <- x86_VPSRLV_4u64 _A21 + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((3 * 32) - 96))))); + _A21 <- (_A21 `|` _T.[5]); + _A41 <- (_A41 `^` _D14); + _T.[6] <- x86_VPSLLV_4u64 _A41 + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((4 * 32) - 96))))); + _A41 <- x86_VPSRLV_4u64 _A41 + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((4 * 32) - 96))))); + _A41 <- (_A41 `|` _T.[6]); + _A11 <- (_A11 `^` _D14); + _T.[3] <- x86_VPERMQ _A20 (W8.of_int 141); + _T.[4] <- x86_VPERMQ _A31 (W8.of_int 141); + _T.[7] <- x86_VPSLLV_4u64 _A11 + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((5 * 32) - 96))))); + _T.[1] <- x86_VPSRLV_4u64 _A11 + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((5 * 32) - 96))))); + _T.[1] <- (_T.[1] `|` _T.[7]); + _A01 <- (_A01 `^` _D14); + _T.[5] <- x86_VPERMQ _A21 (W8.of_int 27); + _T.[6] <- x86_VPERMQ _A41 (W8.of_int 114); + _T.[8] <- x86_VPSLLV_4u64 _A01 + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((1 * 32) - 96))))); + _T.[2] <- x86_VPSRLV_4u64 _A01 + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((1 * 32) - 96))))); + _T.[2] <- (_T.[2] `|` _T.[8]); + _T.[7] <- x86_VPSRLDQ_256 _T.[1] (W8.of_int 8); + _T.[0] <- ((invw _T.[1]) `&` _T.[7]); + _A31 <- x86_VPBLENDD_256 _T.[2] _T.[6] + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + _T.[8] <- x86_VPBLENDD_256 _T.[4] _T.[2] + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + _A41 <- x86_VPBLENDD_256 _T.[3] _T.[4] + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + _T.[7] <- x86_VPBLENDD_256 _T.[2] _T.[3] + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + _A31 <- x86_VPBLENDD_256 _A31 _T.[4] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + _T.[8] <- x86_VPBLENDD_256 _T.[8] _T.[5] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + _A41 <- x86_VPBLENDD_256 _A41 _T.[2] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + _T.[7] <- x86_VPBLENDD_256 _T.[7] _T.[6] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + _A31 <- x86_VPBLENDD_256 _A31 _T.[5] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + _T.[8] <- x86_VPBLENDD_256 _T.[8] _T.[6] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + _A41 <- x86_VPBLENDD_256 _A41 _T.[6] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + _T.[7] <- x86_VPBLENDD_256 _T.[7] _T.[4] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + _A31 <- x86_VPANDN_256 _A31 _T.[8]; + _A41 <- x86_VPANDN_256 _A41 _T.[7]; + _A11 <- x86_VPBLENDD_256 _T.[5] _T.[2] + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + _T.[8] <- x86_VPBLENDD_256 _T.[3] _T.[5] + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + _A31 <- (_A31 `^` _T.[3]); + _A11 <- x86_VPBLENDD_256 _A11 _T.[3] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + _T.[8] <- x86_VPBLENDD_256 _T.[8] _T.[4] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + _A41 <- (_A41 `^` _T.[5]); + _A11 <- x86_VPBLENDD_256 _A11 _T.[4] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + _T.[8] <- x86_VPBLENDD_256 _T.[8] _T.[2] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + _A11 <- x86_VPANDN_256 _A11 _T.[8]; + _A11 <- (_A11 `^` _T.[6]); + _A21 <- x86_VPERMQ _T.[1] (W8.of_int 30); + _T.[8] <- x86_VPBLENDD_256 _A21 _A00 + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + _A01 <- x86_VPERMQ _T.[1] (W8.of_int 57); + _A01 <- x86_VPBLENDD_256 _A01 _A00 + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + _A01 <- x86_VPANDN_256 _A01 _T.[8]; + _A20 <- x86_VPBLENDD_256 _T.[4] _T.[5] + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + _T.[7] <- x86_VPBLENDD_256 _T.[6] _T.[4] + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + _A20 <- x86_VPBLENDD_256 _A20 _T.[6] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + _T.[7] <- x86_VPBLENDD_256 _T.[7] _T.[3] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + _A20 <- x86_VPBLENDD_256 _A20 _T.[3] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + _T.[7] <- x86_VPBLENDD_256 _T.[7] _T.[5] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + _A20 <- x86_VPANDN_256 _A20 _T.[7]; + _A20 <- (_A20 `^` _T.[2]); + _T.[0] <- x86_VPERMQ _T.[0] (W8.of_int 0); + _A31 <- x86_VPERMQ _A31 (W8.of_int 27); + _A41 <- x86_VPERMQ _A41 (W8.of_int 141); + _A11 <- x86_VPERMQ _A11 (W8.of_int 114); + _A21 <- x86_VPBLENDD_256 _T.[6] _T.[3] + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + _T.[7] <- x86_VPBLENDD_256 _T.[5] _T.[6] + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + _A21 <- x86_VPBLENDD_256 _A21 _T.[5] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + _T.[7] <- x86_VPBLENDD_256 _T.[7] _T.[2] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + _A21 <- x86_VPBLENDD_256 _A21 _T.[2] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + _T.[7] <- x86_VPBLENDD_256 _T.[7] _T.[3] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + _A21 <- x86_VPANDN_256 _A21 _T.[7]; + _A00 <- (_A00 `^` _T.[0]); + _A01 <- (_A01 `^` _T.[1]); + _A21 <- (_A21 `^` _T.[4]); + _A00 <- + (_A00 `^` (loadW256 Glob.mem (W64.to_uint (iotas + (W64.of_int 0))))); + iotas <- (iotas + (W64.of_int 32)); + ( _0, _1, _2, zf, i) <- x86_DEC_32 i; + } + return (_A00, _A01, _A20, _A31, _A21, _A41, _A11); + } +}. diff --git a/proof/impl/perm/keccak_f1600_avx2_openssl_prevec.ec b/proof/impl/perm/keccak_f1600_avx2_openssl_prevec.ec new file mode 100644 index 0000000..8bdc614 --- /dev/null +++ b/proof/impl/perm/keccak_f1600_avx2_openssl_prevec.ec @@ -0,0 +1,1752 @@ +require import List Int IntExtra IntDiv CoreMap. +from Jasmin require import JModel. + +(* +require import Array9. +require import WArray288. +*) + +require import Keccak_f1600_ref_table. +require import Keccak_f1600_ref. +import Ops. +import Array24. +import Array25. + +clone export PolyArray as Array9 with op size <- 9. +clone export PolyArray as Array96 with op size <- 96. + +op x86_DEC_32 : W32.t -> (bool * bool * bool * bool * W32.t). + +op lift2array : W256.t -> W64.t Array4.t. + + +op good_rhotates_right : int Array24.t = ( + witness + .[4* 0+0 <- 64 - 3].[4* 0+1 <- 64 - 18].[4* 0+2 <- 64 - 36].[4* 0+3 <- 64 - 41] + .[4* 1+0 <- 64 - 1].[4* 1+1 <- 64 - 62].[4* 1+2 <- 64 - 28].[4* 1+3 <- 64 - 27] + .[4* 2+0 <- 64 - 45].[4* 2+1 <- 64 - 6].[4* 2+2 <- 64 - 56].[4* 2+3 <- 64 - 39] + .[4* 3+0 <- 64 - 10].[4* 3+1 <- 64 - 61].[4* 3+2 <- 64 - 55].[4* 3+3 <- 64 - 8] + .[4* 4+0 <- 64 - 2].[4* 4+1 <- 64 - 15].[4* 4+2 <- 64 - 25].[4* 4+3 <- 64 - 20] + .[4* 5+0 <- 64 - 44].[4* 5+1 <- 64 - 43].[4* 5+2 <- 64 - 21].[4* 5+3 <- 64 - 14])%Array24. + + +op good_rhotates_left : int Array24.t = ( + witness + .[4* 0+0 <- 3].[4* 0+1 <- 18].[4* 0+2 <- 36].[4* 0+3 <- 41] + .[4* 1+0 <- 1].[4* 1+1 <- 62].[4* 1+2 <- 28].[4* 1+3 <- 27] + .[4* 2+0 <- 45].[4* 2+1 <- 6].[4* 2+2 <- 56].[4* 2+3 <- 39] + .[4* 3+0 <- 10].[4* 3+1 <- 61].[4* 3+2 <- 55].[4* 3+3 <- 8] + .[4* 4+0 <- 2].[4* 4+1 <- 15].[4* 4+2 <- 25].[4* 4+3 <- 20] + .[4* 5+0 <- 44].[4* 5+1 <- 43].[4* 5+2 <- 21].[4* 5+3 <- 14])%Array24. + + +op good_iotas4x : W64.t Array96.t = ( + witness + .[4* 0+0 <- W64.one ].[4* 0+1 <- W64.one ].[4* 0+2 <- W64.one ].[4* 0+3 <- W64.one ] + .[4* 1+0 <- W64.of_int 32898 ].[4* 1+1 <- W64.of_int 32898 ].[4* 1+2 <- W64.of_int 32898 ].[4* 1+3 <- W64.of_int 32898 ] + .[4* 2+0 <- W64.of_int 9223372036854808714].[4* 2+1 <- W64.of_int 9223372036854808714].[4* 2+2 <- W64.of_int 9223372036854808714].[4* 2+3 <- W64.of_int 9223372036854808714] + .[4* 3+0 <- W64.of_int 9223372039002292224].[4* 3+1 <- W64.of_int 9223372039002292224].[4* 3+2 <- W64.of_int 9223372039002292224].[4* 3+3 <- W64.of_int 9223372039002292224] + .[4* 4+0 <- W64.of_int 32907 ].[4* 4+1 <- W64.of_int 32907 ].[4* 4+2 <- W64.of_int 32907 ].[4* 4+3 <- W64.of_int 32907 ] + .[4* 5+0 <- W64.of_int 2147483649 ].[4* 5+1 <- W64.of_int 2147483649 ].[4* 5+2 <- W64.of_int 2147483649 ].[4* 5+3 <- W64.of_int 2147483649 ] + .[4* 6+0 <- W64.of_int 9223372039002292353].[4* 6+1 <- W64.of_int 9223372039002292353].[4* 6+2 <- W64.of_int 9223372039002292353].[4* 6+3 <- W64.of_int 9223372039002292353] + .[4* 7+0 <- W64.of_int 9223372036854808585].[4* 7+1 <- W64.of_int 9223372036854808585].[4* 7+2 <- W64.of_int 9223372036854808585].[4* 7+3 <- W64.of_int 9223372036854808585] + .[4* 8+0 <- W64.of_int 138 ].[4* 8+1 <- W64.of_int 138 ].[4* 8+2 <- W64.of_int 138 ].[4* 8+3 <- W64.of_int 138 ] + .[4* 9+0 <- W64.of_int 136 ].[4* 9+1 <- W64.of_int 136 ].[4* 9+2 <- W64.of_int 136 ].[4* 9+3 <- W64.of_int 136 ] + .[4*10+0 <- W64.of_int 2147516425 ].[4*10+1 <- W64.of_int 2147516425 ].[4*10+2 <- W64.of_int 2147516425 ].[4*10+3 <- W64.of_int 2147516425 ] + .[4*11+0 <- W64.of_int 2147483658 ].[4*11+1 <- W64.of_int 2147483658 ].[4*11+2 <- W64.of_int 2147483658 ].[4*11+3 <- W64.of_int 2147483658 ] + .[4*12+0 <- W64.of_int 2147516555 ].[4*12+1 <- W64.of_int 2147516555 ].[4*12+2 <- W64.of_int 2147516555 ].[4*12+3 <- W64.of_int 2147516555 ] + .[4*13+0 <- W64.of_int 9223372036854775947].[4*13+1 <- W64.of_int 9223372036854775947].[4*13+2 <- W64.of_int 9223372036854775947].[4*13+3 <- W64.of_int 9223372036854775947] + .[4*14+0 <- W64.of_int 9223372036854808713].[4*14+1 <- W64.of_int 9223372036854808713].[4*14+2 <- W64.of_int 9223372036854808713].[4*14+3 <- W64.of_int 9223372036854808713] + .[4*15+0 <- W64.of_int 9223372036854808579].[4*15+1 <- W64.of_int 9223372036854808579].[4*15+2 <- W64.of_int 9223372036854808579].[4*15+3 <- W64.of_int 9223372036854808579] + .[4*16+0 <- W64.of_int 9223372036854808578].[4*16+1 <- W64.of_int 9223372036854808578].[4*16+2 <- W64.of_int 9223372036854808578].[4*16+3 <- W64.of_int 9223372036854808578] + .[4*17+0 <- W64.of_int 9223372036854775936].[4*17+1 <- W64.of_int 9223372036854775936].[4*17+2 <- W64.of_int 9223372036854775936].[4*17+3 <- W64.of_int 9223372036854775936] + .[4*18+0 <- W64.of_int 32778 ].[4*18+1 <- W64.of_int 32778 ].[4*18+2 <- W64.of_int 32778 ].[4*18+3 <- W64.of_int 32778 ] + .[4*19+0 <- W64.of_int 9223372039002259466].[4*19+1 <- W64.of_int 9223372039002259466].[4*19+2 <- W64.of_int 9223372039002259466].[4*19+3 <- W64.of_int 9223372039002259466] + .[4*20+0 <- W64.of_int 9223372039002292353].[4*20+1 <- W64.of_int 9223372039002292353].[4*20+2 <- W64.of_int 9223372039002292353].[4*20+3 <- W64.of_int 9223372039002292353] + .[4*21+0 <- W64.of_int 9223372036854808704].[4*21+1 <- W64.of_int 9223372036854808704].[4*21+2 <- W64.of_int 9223372036854808704].[4*21+3 <- W64.of_int 9223372036854808704] + .[4*22+0 <- W64.of_int 2147483649 ].[4*22+1 <- W64.of_int 2147483649 ].[4*22+2 <- W64.of_int 2147483649 ].[4*22+3 <- W64.of_int 2147483649 ] + .[4*23+0 <- W64.of_int 9223372039002292232].[4*23+1 <- W64.of_int 9223372039002292232].[4*23+2 <- W64.of_int 9223372039002292232].[4*23+3 <- W64.of_int 9223372039002292232])%Array96. + +module Mavx2_prevec = { + + proc __KeccakF1600 (_A00:W64.t Array4.t, _A01:W64.t Array4.t, _A20:W64.t Array4.t, _A31:W64.t Array4.t, + _A21:W64.t Array4.t, _A41:W64.t Array4.t, _A11:W64.t Array4.t, + _rhotates_left:W64.t, _rhotates_right:W64.t, + _iotas:W64.t) : W64.t Array4.t * W64.t Array4.t * W64.t Array4.t * W64.t Array4.t * + W64.t Array4.t * W64.t Array4.t * W64.t Array4.t = { + + var rhotates_left:W64.t; + var rhotates_right:W64.t; + var iotas:W64.t; + var i:W32.t; + var zf:bool; + var _C00:W64.t Array4.t; + var _C14:W64.t Array4.t; + var _T:W64.t Array4.t Array9.t; + var _D14:W64.t Array4.t; + var _D00:W64.t Array4.t; + var _0:bool; + var _1:bool; + var _2:bool; + _T <- witness; + rhotates_left <- (_rhotates_left + (W64.of_int 96)); + rhotates_right <- (_rhotates_right + (W64.of_int 96)); + iotas <- _iotas; + i <- (W32.of_int 24); + _C00 <@ Ops.iVPSHUFD_256(_A20,(W8.of_int 78)); + _C14 <@ Ops.ilxor4u64(_A41,_A31); + _T.[2] <@ Ops.ilxor4u64(_A21,_A11); + _C14 <@ Ops.ilxor4u64(_C14,_A01); + _C14 <@ Ops.ilxor4u64(_C14,_T.[2]); + _T.[4] <- Ops.iVPERMQ(_C14,(W8.of_int 147)); + _C00 <@ Ops.ilxor4u64(_C00,_A20); + _T.[0] <- Ops.iVPERMQ(_C00,(W8.of_int 78)); + _T.[1] <- Ops.ivshr64u256(_C14, (W8.of_int 63)); + _T.[2] <- Ops.ivadd64u256(_C14, _C14); + _T.[1] <@ Ops.ilor4u64(_T.[1],_T.[2]); + _D14 <- Ops.iVPERMQ(_T.[1],(W8.of_int 57)); + _D00 <@ Ops.ilxor4u64(_T.[1],_T.[4]); + _D00 <- Ops.iVPERMQ(_D00,(W8.of_int 0)); + _C00 <@ Ops.ilxor4u64(_C00,_A00); + _C00 <@ Ops.ilxor4u64(_C00,_T.[0]); + _T.[0] <- Ops.ivshr64u256(_C00, (W8.of_int 63)); + _T.[1] <- Ops.ivadd64u256(_C00, _C00); + _T.[1] <@ Ops.ilor4u64(_T.[1],_T.[0]); + _A20 <@ Ops.ilxor4u64(_A20,_D00); + _A00 <@ Ops.ilxor4u64(_A00,_D00); + _D14 <- Ops.iVPBLENDD_256(_D14,_T.[1], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + _T.[4] <- Ops.iVPBLENDD_256(_T.[4],_C00, + (W8.of_int (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + _D14 <@ Ops.ilxor4u64(_D14,_T.[4]); + _T.[3] <@ Ops.iVPSLLV_4u64(_A20, lift2array + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((0 * 32) - 96)))))); + _A20 <@ Ops.iVPSRLV_4u64(_A20, lift2array + (loadW256 Glob.mem (W64.to_uint (rhotates_right+ (W64.of_int ((0 * 32) - 96)))))); + _A20 <@ Ops.ilor4u64(_A20,_T.[3]); + _A31 <@ Ops.ilxor4u64(_A31,_D14); + _T.[4] <@ Ops.iVPSLLV_4u64(_A31, lift2array + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((2 * 32) - 96)))))); + _A31 <@ Ops.iVPSRLV_4u64(_A31, lift2array + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((2 * 32) - 96)))))); + _A31 <@ Ops.ilor4u64(_A31,_T.[4]); + _A21 <@ Ops.ilxor4u64(_A21,_D14); + _T.[5] <@ Ops.iVPSLLV_4u64(_A21, lift2array + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((3 * 32) - 96)))))); + _A21 <@ Ops.iVPSRLV_4u64(_A21, lift2array + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((3 * 32) - 96)))))); + _A21 <@ Ops.ilor4u64(_A21,_T.[5]); + _A41 <@ Ops.ilxor4u64(_A41,_D14); + _T.[6] <@ Ops.iVPSLLV_4u64(_A41, lift2array + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((4 * 32) - 96)))))); + _A41 <@ Ops.iVPSRLV_4u64(_A41, lift2array + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((4 * 32) - 96)))))); + _A41 <@ Ops.ilor4u64(_A41,_T.[6]); + _A11 <@ Ops.ilxor4u64(_A11,_D14); + _T.[3] <- Ops.iVPERMQ(_A20,(W8.of_int 141)); + _T.[4] <- Ops.iVPERMQ(_A31,(W8.of_int 141)); + _T.[7] <@ Ops.iVPSLLV_4u64(_A11, lift2array + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((5 * 32) - 96)))))); + _T.[1] <@ Ops.iVPSRLV_4u64(_A11, lift2array + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((5 * 32) - 96)))))); + _T.[1] <@ Ops.ilor4u64(_T.[1],_T.[7]); + _A01 <@ Ops.ilxor4u64(_A01,_D14); + _T.[5] <- Ops.iVPERMQ(_A21,(W8.of_int 27)); + _T.[6] <- Ops.iVPERMQ(_A41,(W8.of_int 114)); + _T.[8] <@ Ops.iVPSLLV_4u64(_A01, lift2array + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((1 * 32) - 96)))))); + _T.[2] <@ Ops.iVPSRLV_4u64(_A01, lift2array + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((1 * 32) - 96)))))); + _T.[2] <@ Ops.ilor4u64(_T.[2],_T.[8]); + _T.[7] <@ Ops.iVPSRLDQ_256(_T.[1],(W8.of_int 8)); + _T.[0] <@ Ops.ilandn4u64(_T.[1],_T.[7]); + _A31 <@ Ops.iVPBLENDD_256(_T.[2],_T.[6], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + _T.[8] <@ Ops.iVPBLENDD_256(_T.[4],_T.[2], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + _A41 <@ Ops.iVPBLENDD_256(_T.[3], _T.[4], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + _T.[7] <@ Ops.iVPBLENDD_256(_T.[2], _T.[3], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + _A31 <@ Ops.iVPBLENDD_256(_A31 ,_T.[4], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + _T.[8] <@ Ops.iVPBLENDD_256(_T.[8], _T.[5], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + _A41 <@ Ops.iVPBLENDD_256(_A41, _T.[2], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + _T.[7] <@ Ops.iVPBLENDD_256(_T.[7], _T.[6], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + _A31 <@ Ops.iVPBLENDD_256(_A31, _T.[5], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + _T.[8] <@ Ops.iVPBLENDD_256(_T.[8], _T.[6], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + _A41 <@ Ops.iVPBLENDD_256(_A41, _T.[6], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + _T.[7] <@ Ops.iVPBLENDD_256(_T.[7], _T.[4], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + _A31 <@ Ops.ilandn4u64(_A31,_T.[8]); + _A41 <@ Ops.ilandn4u64(_A41,_T.[7]); + _A11 <@ Ops.iVPBLENDD_256(_T.[5],_T.[2], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + _T.[8] <@ Ops.iVPBLENDD_256(_T.[3], _T.[5], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + _A31 <@ Ops.ilxor4u64(_A31,_T.[3]); + _A11 <@ Ops.iVPBLENDD_256(_A11,_T.[3], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + _T.[8] <@ Ops.iVPBLENDD_256(_T.[8],_T.[4], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + _A41 <@ Ops.ilxor4u64(_A41,_T.[5]); + _A11 <@ Ops.iVPBLENDD_256(_A11, _T.[4], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + _T.[8] <@ Ops.iVPBLENDD_256(_T.[8], _T.[2], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + _A11 <@ Ops.ilandn4u64(_A11,_T.[8]); + _A11 <@ Ops.ilxor4u64(_A11,_T.[6]); + _A21 <@ Ops.iVPERMQ(_T.[1],(W8.of_int 30)); + _T.[8] <@ Ops.iVPBLENDD_256(_A21, _A00, + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + _A01 <@ Ops.iVPERMQ(_T.[1],(W8.of_int 57)); + _A01 <@ Ops.iVPBLENDD_256(_A01, _A00, + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + _A01 <@ Ops.ilandn4u64(_A01,_T.[8]); + _A20 <@ Ops.iVPBLENDD_256(_T.[4], _T.[5], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + _T.[7] <@ Ops.iVPBLENDD_256(_T.[6], _T.[4], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + _A20 <@ Ops.iVPBLENDD_256(_A20, _T.[6], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + _T.[7] <@ Ops.iVPBLENDD_256(_T.[7], _T.[3], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + _A20 <@ Ops.iVPBLENDD_256(_A20, _T.[3], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + _T.[7] <@ Ops.iVPBLENDD_256(_T.[7], _T.[5], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + _A20 <@ Ops.ilandn4u64(_A20,_T.[7]); + _A20 <@ Ops.ilxor4u64(_A20,_T.[2]); + _T.[0] <@ Ops.iVPERMQ(_T.[0],(W8.of_int 0)); + _A31 <@ Ops.iVPERMQ(_A31,(W8.of_int 27)); + _A41 <@ Ops.iVPERMQ(_A41,(W8.of_int 141)); + _A11 <@ Ops.iVPERMQ(_A11,(W8.of_int 114)); + _A21 <@ Ops.iVPBLENDD_256(_T.[6], _T.[3], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + _T.[7] <@ Ops.iVPBLENDD_256(_T.[5], _T.[6], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + _A21 <@ Ops.iVPBLENDD_256(_A21, _T.[5], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + _T.[7] <@ Ops.iVPBLENDD_256(_T.[7], _T.[2], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + _A21 <@ Ops.iVPBLENDD_256(_A21, _T.[2], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + _T.[7] <@ Ops.iVPBLENDD_256(_T.[7], _T.[3], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + _A21 <@ Ops.ilandn4u64(_A21,_T.[7]); + _A00 <@ Ops.ilxor4u64(_A00,_T.[0]); + _A01 <@ Ops.ilxor4u64(_A01,_T.[1]); + _A21 <@ Ops.ilxor4u64(_A21,_T.[4]); + _A00 <@ Ops.ilxor4u64(_A00, lift2array + (loadW256 Glob.mem (W64.to_uint (iotas + (W64.of_int 0))))); + iotas <- (iotas + (W64.of_int 32)); + ( _0, _1, _2, zf, i) <- x86_DEC_32 i; + while ((! zf)) { + _C00 <@ Ops.iVPSHUFD_256(_A20,(W8.of_int 78)); + _C14 <@ Ops.ilxor4u64(_A41,_A31); + _T.[2] <@ Ops.ilxor4u64(_A21,_A11); + _C14 <@ Ops.ilxor4u64(_C14,_A01); + _C14 <@ Ops.ilxor4u64(_C14,_T.[2]); + _T.[4] <@ Ops.iVPERMQ(_C14,(W8.of_int 147)); + _C00 <@ Ops.ilxor4u64(_C00,_A20); + _T.[0] <@ Ops.iVPERMQ(_C00,(W8.of_int 78)); + _T.[1] <@ Ops.ivshr64u256(_C14, (W8.of_int 63)); + _T.[2] <@ Ops.ivadd64u256(_C14, _C14); + _T.[1] <@ Ops.ilor4u64(_T.[1],_T.[2]); + _D14 <@ Ops.iVPERMQ(_T.[1],(W8.of_int 57)); + _D00 <@ Ops.ilxor4u64(_T.[1],_T.[4]); + _D00 <@ Ops.iVPERMQ(_D00,(W8.of_int 0)); + _C00 <@ Ops.ilxor4u64(_C00,_A00); + _C00 <@ Ops.ilxor4u64(_C00,_T.[0]); + _T.[0] <@ Ops.ivshr64u256(_C00, (W8.of_int 63)); + _T.[1] <@ Ops.ivadd64u256(_C00, _C00); + _T.[1] <@ Ops.ilor4u64(_T.[1],_T.[0]); + _A20 <@ Ops.ilxor4u64(_A20,_D00); + _A00 <@ Ops.ilxor4u64(_A00,_D00); + _D14 <@ Ops.iVPBLENDD_256(_D14,_T.[1], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + _T.[4] <@ Ops.iVPBLENDD_256(_T.[4],_C00, + (W8.of_int (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + _D14 <@ Ops.ilxor4u64(_D14,_T.[4]); + _T.[3] <@ Ops.iVPSLLV_4u64(_A20, lift2array + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((0 * 32) - 96)))))); + _A20 <@ Ops.iVPSRLV_4u64(_A20, lift2array + (loadW256 Glob.mem (W64.to_uint (rhotates_right+ (W64.of_int ((0 * 32) - 96)))))); + _A20 <@ Ops.ilor4u64(_A20,_T.[3]); + _A31 <@ Ops.ilxor4u64(_A31,_D14); + _T.[4] <@ Ops.iVPSLLV_4u64(_A31, lift2array + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((2 * 32) - 96)))))); + _A31 <@ Ops.iVPSRLV_4u64(_A31, lift2array + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((2 * 32) - 96)))))); + _A31 <@ Ops.ilor4u64(_A31,_T.[4]); + _A21 <@ Ops.ilxor4u64(_A21,_D14); + _T.[5] <@ Ops.iVPSLLV_4u64(_A21, lift2array + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((3 * 32) - 96)))))); + _A21 <@ Ops.iVPSRLV_4u64(_A21, lift2array + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((3 * 32) - 96)))))); + _A21 <@ Ops.ilor4u64(_A21,_T.[5]); + _A41 <@ Ops.ilxor4u64(_A41,_D14); + _T.[6] <@ Ops.iVPSLLV_4u64(_A41, lift2array + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((4 * 32) - 96)))))); + _A41 <@ Ops.iVPSRLV_4u64(_A41, lift2array + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((4 * 32) - 96)))))); + _A41 <@ Ops.ilor4u64(_A41,_T.[6]); + _A11 <@ Ops.ilxor4u64(_A11,_D14); + _T.[3] <- Ops.iVPERMQ(_A20,(W8.of_int 141)); + _T.[4] <- Ops.iVPERMQ(_A31,(W8.of_int 141)); + _T.[7] <@ Ops.iVPSLLV_4u64(_A11, lift2array + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((5 * 32) - 96)))))); + _T.[1] <@ Ops.iVPSRLV_4u64(_A11, lift2array + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((5 * 32) - 96)))))); + _T.[1] <@ Ops.ilor4u64(_T.[1],_T.[7]); + _A01 <@ Ops.ilxor4u64(_A01,_D14); + _T.[5] <- Ops.iVPERMQ(_A21,(W8.of_int 27)); + _T.[6] <- Ops.iVPERMQ(_A41,(W8.of_int 114)); + _T.[8] <@ Ops.iVPSLLV_4u64(_A01, lift2array + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((1 * 32) - 96)))))); + _T.[2] <@ Ops.iVPSRLV_4u64(_A01, lift2array + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((1 * 32) - 96)))))); + _T.[2] <@ Ops.ilor4u64(_T.[2],_T.[8]); + _T.[7] <@ Ops.iVPSRLDQ_256(_T.[1],(W8.of_int 8)); + _T.[0] <@ Ops.ilandn4u64(_T.[1],_T.[7]); + _A31 <@ Ops.iVPBLENDD_256(_T.[2], _T.[6], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + _T.[8] <@ Ops.iVPBLENDD_256(_T.[4], _T.[2], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + _A41 <@ Ops.iVPBLENDD_256(_T.[3], _T.[4], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + _T.[7] <@ Ops.iVPBLENDD_256(_T.[2], _T.[3], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + _A31 <@ Ops.iVPBLENDD_256(_A31, _T.[4], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + _T.[8] <@ Ops.iVPBLENDD_256(_T.[8], _T.[5], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + _A41 <@ Ops.iVPBLENDD_256(_A41, _T.[2], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + _T.[7] <@ Ops.iVPBLENDD_256(_T.[7], _T.[6], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + _A31 <@ Ops.iVPBLENDD_256(_A31, _T.[5], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + _T.[8] <@ Ops.iVPBLENDD_256(_T.[8], _T.[6], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + _A41 <@ Ops.iVPBLENDD_256(_A41, _T.[6], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + _T.[7] <@ Ops.iVPBLENDD_256(_T.[7], _T.[4], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + _A31 <@ Ops.ilandn4u64(_A31,_T.[8]); + _A41 <@ Ops.ilandn4u64(_A41,_T.[7]); + _A11 <@ Ops.iVPBLENDD_256(_T.[5], _T.[2], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + _T.[8] <@ Ops.iVPBLENDD_256(_T.[3], _T.[5], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + _A31 <@ Ops.ilxor4u64(_A31,_T.[3]); + _A11 <@ Ops.iVPBLENDD_256(_A11, _T.[3], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + _T.[8] <@ Ops.iVPBLENDD_256(_T.[8], _T.[4], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + _A41 <@ Ops.ilxor4u64(_A41,_T.[5]); + _A11 <@ Ops.iVPBLENDD_256(_A11, _T.[4], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + _T.[8] <@ Ops.iVPBLENDD_256(_T.[8], _T.[2], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + _A11 <@ Ops.ilandn4u64(_A11,_T.[8]); + _A11 <@ Ops.ilxor4u64(_A11,_T.[6]); + _A21 <@ Ops.iVPERMQ(_T.[1],(W8.of_int 30)); + _T.[8] <@ Ops.iVPBLENDD_256(_A21, _A00, + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + _A01 <@ Ops.iVPERMQ(_T.[1],(W8.of_int 57)); + _A01 <@ Ops.iVPBLENDD_256(_A01 ,_A00, + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + _A01 <@ Ops.ilandn4u64(_A01,_T.[8]); + _A20 <@ Ops.iVPBLENDD_256(_T.[4], _T.[5], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + _T.[7] <@ Ops.iVPBLENDD_256(_T.[6], _T.[4], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + _A20 <@ Ops.iVPBLENDD_256(_A20, _T.[6], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + _T.[7] <@ Ops.iVPBLENDD_256(_T.[7], _T.[3], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + _A20 <@ Ops.iVPBLENDD_256(_A20, _T.[3], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + _T.[7] <@ Ops.iVPBLENDD_256(_T.[7], _T.[5], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + _A20 <@ Ops.ilandn4u64(_A20,_T.[7]); + _A20 <@ Ops.ilxor4u64(_A20,_T.[2]); + _T.[0] <@ Ops.iVPERMQ(_T.[0],(W8.of_int 0)); + _A31 <@ Ops.iVPERMQ(_A31,(W8.of_int 27)); + _A41 <@ Ops.iVPERMQ(_A41,(W8.of_int 141)); + _A11 <@ Ops.iVPERMQ(_A11,(W8.of_int 114)); + _A21 <@ Ops.iVPBLENDD_256(_T.[6], _T.[3], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + _T.[7] <@ Ops.iVPBLENDD_256(_T.[5], _T.[6], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + _A21 <@ Ops.iVPBLENDD_256(_A21, _T.[5], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + _T.[7] <@ Ops.iVPBLENDD_256(_T.[7] ,_T.[2], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + _A21 <@ Ops.iVPBLENDD_256(_A21, _T.[2], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + _T.[7] <@ Ops.iVPBLENDD_256(_T.[7], _T.[3], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + _A21 <@ Ops.ilandn4u64(_A21,_T.[7]); + _A00 <@ Ops.ilxor4u64(_A00,_T.[0]); + _A01 <@ Ops.ilxor4u64(_A01,_T.[1]); + _A21 <@ Ops.ilxor4u64(_A21,_T.[4]); + _A00 <@ Ops.ilxor4u64(_A00, lift2array + (loadW256 Glob.mem (W64.to_uint (iotas + (W64.of_int 0))))); + iotas <- (iotas + (W64.of_int 32)); + ( _0, _1, _2, zf, i) <- x86_DEC_32 i; + } + return (_A00, _A01, _A20, _A31, _A21, _A41, _A11); + } +}. + +(* + ($A00, # [0][0] [0][0] [0][0] [0][0] + $A01, # [0][4] [0][3] [0][2] [0][1] + $A20, # [3][0] [1][0] [4][0] [2][0] + $A31, # [2][4] [4][3] [1][2] [3][1] + $A21, # [3][4] [1][3] [4][2] [2][1] + $A41, # [1][4] [2][3] [3][2] [4][1] + $A11) = # [4][4] [3][3] [2][2] [1][1] +*) + +op index x y = 5*x+y. + +op equiv_states (A00 A01 A20 A31 A21 A41 A11 : W64.t Array4.t, st : W64.t Array25.t) : bool = + A00.[3] = st.[index 0 0] /\ A00.[2] = st.[index 0 0] /\ A00.[1] = st.[index 0 0] /\ A00.[0] = st.[index 0 0] /\ + A01.[3] = st.[index 0 4] /\ A01.[2] = st.[index 0 3] /\ A01.[1] = st.[index 0 2] /\ A01.[0] = st.[index 0 1] /\ + A20.[3] = st.[index 3 0] /\ A20.[2] = st.[index 1 0] /\ A20.[1] = st.[index 4 0] /\ A20.[0] = st.[index 2 0] /\ + A31.[3] = st.[index 2 4] /\ A31.[2] = st.[index 4 3] /\ A31.[1] = st.[index 1 2] /\ A31.[0] = st.[index 3 1] /\ + A21.[3] = st.[index 3 4] /\ A21.[2] = st.[index 1 3] /\ A21.[1] = st.[index 4 2] /\ A21.[0] = st.[index 2 1] /\ + A41.[3] = st.[index 1 4] /\ A41.[2] = st.[index 2 3] /\ A41.[1] = st.[index 3 2] /\ A41.[0] = st.[index 4 1] /\ + A11.[3] = st.[index 4 4] /\ A11.[2] = st.[index 3 3] /\ A11.[1] = st.[index 2 2] /\ A11.[0] = st.[index 1 1]. + +op equiv_states_chi (A00 A01 A20 A31 A21 A41 A11 : W64.t Array4.t, st : W64.t Array25.t) : bool = + A00.[3] = st.[index 0 0] /\ A00.[2] = st.[index 0 0] /\ A00.[1] = st.[index 0 0] /\ A00.[0] = st.[index 0 0] /\ + A01.[3] = st.[index 0 4] /\ A01.[2] = st.[index 0 3] /\ A01.[1] = st.[index 0 2] /\ A01.[0] = st.[index 0 1] /\ + A20.[3] = st.[index 3 0] /\ A20.[2] = st.[index 1 0] /\ A20.[1] = st.[index 4 0] /\ A20.[0] = st.[index 2 0] /\ + A31.[3] = st.[index 3 1] /\ A31.[2] = st.[index 1 2] /\ A31.[1] = st.[index 4 3] /\ A31.[0] = st.[index 2 4] /\ + A21.[3] = st.[index 3 4] /\ A21.[2] = st.[index 1 3] /\ A21.[1] = st.[index 4 2] /\ A21.[0] = st.[index 2 1] /\ + A41.[3] = st.[index 3 2] /\ A41.[2] = st.[index 1 4] /\ A41.[1] = st.[index 4 1] /\ A41.[0] = st.[index 2 3] /\ + A11.[3] = st.[index 3 3] /\ A11.[2] = st.[index 1 1] /\ A11.[1] = st.[index 4 4] /\ A11.[0] = st.[index 2 2]. + +lemma dec : forall (x : W32.t), + 0 < to_uint x <= 24 => + to_uint (x86_DEC_32 x).`5 = to_uint x - 1 by admit. + +lemma decK : forall (x : W32.t), + (x86_DEC_32 x).`5 + W32.one = x by admit. + +lemma dec0 : forall (x : W32.t), + 0 < to_uint x <= 24 => + (x86_DEC_32 x).`4 <=> to_uint (x86_DEC_32 x).`5 = 0 by + admit. + +lemma rolcomp : (forall (x : W64.t), (x86_ROL_64 x W8.one).`3 = + (x `>>` W8.of_int 63) `|` (x + x)) by admit. + +lemma commor : forall (x y : W64.t), x `|` y = y `|` x by admit. + +lemma rol0 : forall x, (x86_ROL_64 x W8.zero).`3 = x by admit. + +lemma roln : forall x n, (x86_ROL_64 x (W8.of_int n)).`3 = + (x `>>` W8.of_int (64 - n)) `|` (x `<<` W8.of_int n) by admit. + +op good_iotas (mem : global_mem_t, _iotas : int) = + forall off, 0 <= off < 24 => + loadW64 mem (_iotas + (off * 8)) = iotas.[off]. + +op good_rhol (mem : global_mem_t, _rhotates_left : int) = + forall off, 0 <= off < 24 => + loadW64 mem (_rhotates_left + (off * 8)) = W64.of_int good_rhotates_left.[off]. + +op good_rhor (mem : global_mem_t, _rhotates_right : int) = + forall off, 0 <= off < 24 => + loadW64 mem ( _rhotates_right + (off * 8)) = W64.of_int good_rhotates_right.[off]. + +lemma loadlift_rhor : forall (mem : global_mem_t) (x : W64.t) (off : int), + good_rhor mem (to_uint x) => 0 <= off < 6 => + lift2array + (loadW256 mem (to_uint (x + W64.of_int (8 * 4 * off)))) = + (witness + .[0 <- W64.of_int good_rhotates_right.[4*off + 0]] + .[1 <- W64.of_int good_rhotates_right.[4*off + 1]] + .[2 <- W64.of_int good_rhotates_right.[4*off + 2]] + .[3 <- W64.of_int good_rhotates_right.[4*off + 3]])%Array4 by admit. + +lemma loadlift_rhol : forall (mem : global_mem_t) (x : W64.t) (off : int), + good_rhol mem (to_uint x) => 0 <= off < 6 => + lift2array + (loadW256 mem (to_uint (x + W64.of_int (8 * 4 * off)))) = + (witness + .[0 <- W64.of_int good_rhotates_left.[4*off + 0]] + .[1 <- W64.of_int good_rhotates_left.[4*off + 1]] + .[2 <- W64.of_int good_rhotates_left.[4*off + 2]] + .[3 <- W64.of_int good_rhotates_left.[4*off + 3]])%Array4 by admit. + +lemma loadlift_iotas : forall (mem : global_mem_t) (x : W64.t) (off : int), + good_iotas mem (to_uint x) => 0 <= off < 24 => + lift2array + (loadW256 mem (to_uint (x + W64.of_int (8 * 4 * off)))) = + (witness + .[0 <- good_iotas4x.[4*off + 0]] + .[1 <- good_iotas4x.[4*off + 1]] + .[2 <- good_iotas4x.[4*off + 2]] + .[3 <- good_iotas4x.[4*off + 3]])%Array4 by admit. + +op conversion(o1 o2 : int) : int = + let (x,y) = + ((witness + .[0 <- (2,0)] + .[1 <- (4,0)] + .[2 <- (1,0)] + .[3 <- (3,0)] + .[4 <- (0,1)] + .[5 <- (0,2)] + .[6 <- (0,3)] + .[7 <- (0,4)] + .[8 <- (3,1)] + .[9 <- (1,2)] + .[10 <- (4,3)] + .[11 <- (2,4)] + .[12 <- (2,1)] + .[13 <- (4,2)] + .[14 <- (1,3)] + .[15 <- (3,4)] + .[16 <- (4,1)] + .[17 <- (3,2)] + .[18 <- (2,3)] + .[19 <- (1,4)] + .[20 <- (1,1)] + .[21 <- (2,2)] + .[22 <- (3,3)] + .[23 <- (4,4)])%Array24).[o1*4 + o2] in (5*x + y). + +lemma lift_roln mem rl rr o1 o2 x: + 0 <= o1 < 6 => 0 <= o2 < 4 => + good_rhol mem (W64.to_uint rl) => + good_rhor mem (W64.to_uint rr) => + (x `>>` + (W8.of_int + (to_uint + (lift2array + (loadW256 mem + (to_uint (rr + W64.of_int 96 + W64.of_int (8 * 4 * o1 - 96))))).[o2])))%W64 `|` + (x `<<` + (W8.of_int + (to_uint + (lift2array + (loadW256 mem + (to_uint (rl + W64.of_int 96 + W64.of_int (8 * 4 * o1 - 96))))).[o2])))%W64 + = (x86_ROL_64 x ((of_int (rhotates (conversion o1 o2))))%W8).`3. +proof. +move => *. +rewrite (loadlift_rhol mem (rl) o1). smt(). smt(). +rewrite (loadlift_rhor mem (rr) o1). smt(). smt(). +rewrite /good_rhotates_right /good_rhotates_left /rhotates /conversion. +simplify. +case(o1 = 0). auto => />. +case (o2 = 0). auto => />. smt(roln). +case (o2 = 1). auto => />. smt(roln). +case (o2 = 2). auto => />. smt(roln). +case (o2 = 3). auto => />. smt(roln). +smt(). +move => *. +case(o1 = 1). auto => />. +case (o2 = 0). auto => />. smt(roln). +case (o2 = 1). auto => />. smt(roln). +case (o2 = 2). auto => />. smt(roln). +case (o2 = 3). auto => />. smt(roln). +smt(). +move => *. +case(o1 = 2). auto => />. +case (o2 = 0). auto => />. smt(roln). +case (o2 = 1). auto => />. smt(roln). +case (o2 = 2). auto => />. smt(roln). +case (o2 = 3). auto => />. smt(roln). +smt(). +move => *. +case(o1 = 3). auto => />. +case (o2 = 0). auto => />. smt(roln). +case (o2 = 1). auto => />. smt(roln). +case (o2 = 2). auto => />. smt(roln). +case (o2 = 3). auto => />. smt(roln). +smt(). +move => *. +case(o1 = 4). auto => />. +case (o2 = 0). auto => />. smt(roln). +case (o2 = 1). auto => />. smt(roln). +case (o2 = 2). auto => />. smt(roln). +case (o2 = 3). auto => />. smt(roln). +smt(). +move => *. +case(o1 = 5). auto => />. +case (o2 = 0). auto => />. smt(roln). +case (o2 = 1). auto => />. smt(roln). +case (o2 = 2). auto => />. smt(roln). +case (o2 = 3). auto => />. smt(roln). +smt(). +smt(). +qed. + +lemma correct_perm A00 A01 A20 A31 A21 A41 A11 st mem: + equiv [ Mreftable.permute ~ Mavx2_prevec.__KeccakF1600 : + Glob.mem{2} = mem /\ good_iotas mem (to_uint _iotas{2}) /\ + good_rhol mem (to_uint _rhotates_left{2}) /\ good_rhor mem (to_uint _rhotates_right{2}) /\ + equiv_states A00 A01 A20 A31 A21 A41 A11 st /\ + _A00{2} = A00 /\ _A01{2} = A01 /\ _A20{2} = A20 /\ _A31{2} = A31 /\ + _A21{2} = A21 /\ _A41{2} = A41 /\ _A11{2} = A11 /\ state{1} = st ==> + equiv_states res{2}.`1 res{2}.`2 res{2}.`3 res{2}.`4 res{2}.`5 res{2}.`6 res{2}.`7 res{1}]. +proc. +unroll {1} 3. +rcondt {1} 3; first by move => *; inline *; auto => />. + +seq 0 1 : #pre; first by auto => />. +inline Mreftable.keccakRoundConstants. +sp 2 4. + +seq 1 105 : (#{/~_A00{2}}{~_A01{2}}{~_A20{2}}{~_A31{2}}{~_A21{2}}{~_A41{2}}{~_A11{2}}{~state{1}}pre /\ Glob.mem{2} = mem /\ + good_iotas mem (to_uint _iotas{2}) /\ + good_rhol mem (to_uint _rhotates_left{2}) /\ + good_rhor mem (to_uint _rhotates_right{2}) /\ + equiv_states _A00{2} _A01{2} _A20{2} _A31{2} _A21{2} _A41{2} _A11{2} state{1}). + +seq 0 0 : (#pre /\ (constants{1}.[round{1}])%Array24 = W64.of_int 1). +by auto => />; rewrite /iotas;smt(). + +inline Mreftable.keccakP1600_round. + +sp 2 0. +inline Mreftable.theta. +sp 1 0. + +swap {2} [20..21] 3. +swap {2} 28 -3. +swap {2} 32 -6. +swap {2} 36 -9. +swap {2} 40 -12. +swap {2} 46 -17. + +seq 9 29 : (#{/~state{1}}post /\ c{1} = W64.of_int 1 /\ + equiv_states _A00{2} _A01{2} _A20{2} _A31{2} _A21{2} _A41{2} _A11{2} state0{1}). + +unroll for {1} 4. +unroll for {1} 6. +unroll for {1} 23. +unroll for {1} 19. +unroll for {1} 45. +unroll for {1} 58. +unroll for {1} 70. +unroll for {1} 101. +unroll for {1} 102. +unroll for {1} 114. +unroll for {1} 126. +unroll for {1} 138. +unroll for {1} 150. +inline *. +rcondt {2} 4; first by move => *; auto => />. +rcondf {2} 40; first by move => *; auto => />. +rcondt {2} 40; first by move => *; auto => />. +rcondf {2} 55; first by move => *; auto => />. +rcondf {2} 55; first by move => *; auto => />. +rcondt {2} 55; first by move => *; auto => />. +rcondf {2} 84; first by move => *; auto => />. +rcondf {2} 84; first by move => *; auto => />. +rcondf {2} 84; first by move => *; auto => />. +rcondt {2} 84; first by move => *; auto => />. +rcondf {2} 99; first by move => *; auto => />. +rcondf {2} 99; first by move => *; auto => />. +rcondf {2} 99; first by move => *; auto => />. +rcondf {2} 99; first by move => *; auto => />. +rcondf {2} 99; first by move => *; auto => />. +rcondf {2} 99; first by move => *; auto => />. +rcondf {2} 99; first by move => *; auto => />. +rcondt {2} 99; first by move => *; auto => />. +rcondt {2} 143; first by move => *; auto => />. +rcondf {2} 152; first by move => *; auto => />. +rcondt {2} 152; first by move => *; auto => />. + +wp;skip. +move => &1 &2. +rewrite /equiv_states /index. + simplify. +by smt(W64.xorwA W64.xorwC W64.xorw0 W64.xorwK rolcomp commor). + +(* Rho PI *) +inline Mreftable.rho Mreftable.pi. + +seq 11 22 : (#{/~ state{1}}post /\ c{1} = W64.of_int 1 /\ + equiv_states_chi _A00{2} _T{2}.[1] _T{2}.[2] _T{2}.[3] _T{2}.[4] _T{2}.[5] _T{2}.[6] state0{1}). + +unroll for {1} 3. +unroll for {1} 4. +unroll for {1} 41. +unroll for {1} 78. +unroll for {1} 115. +unroll for {1} 152. +unroll for {1} 192. +unroll for {1} 268. +unroll for {1} 269. +unroll for {1} 291. +unroll for {1} 313. +unroll for {1} 335. +unroll for {1} 357. + +inline *. + +rcondf {2} 88; first by auto => />. +rcondf {2} 88; first by auto => />. +rcondf {2} 88; first by auto => />. +rcondf {2} 88; first by auto => />. +rcondt {2} 88; first by auto => />. +rcondf {2} 96; first by auto => />. +rcondf {2} 96; first by auto => />. +rcondf {2} 96; first by auto => />. +rcondf {2} 96; first by auto => />. +rcondt {2} 96; first by auto => />. +rcondf {2} 125; first by auto => />. +rcondf {2} 125; first by auto => />. +rcondf {2} 125; first by auto => />. +rcondf {2} 125; first by auto => />. +rcondf {2} 125; first by auto => />. +rcondt {2} 125; first by auto => />. +rcondf {2} 133; first by auto => />. +rcondf {2} 133; first by auto => />. +rcondf {2} 133; first by auto => />. +rcondf {2} 133; first by auto => />. +rcondf {2} 133; first by auto => />. +rcondf {2} 133; first by auto => />. +rcondt {2} 133; first by auto => />. + +wp;skip. +move => &1 &2. +rewrite /equiv_states /equiv_states_chi /index. +simplify. + +move => [/ # *]. + +split; first by smt(). +split; first by smt(). + +split; first by rewrite /rhotates; smt(roln rol0). +split; first by rewrite /rhotates; smt(roln rol0). +split; first by rewrite /rhotates; smt(roln rol0). +split; first by rewrite /rhotates; smt(roln rol0). + +split. +rewrite H H0. +move : H36 H37; rewrite -H5 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 5 3 _A11{2}.[3] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +split. +rewrite H H0. +move : H36 H37; rewrite -H5 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 5 2 _A11{2}.[2] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +split. +rewrite H H0. +move : H36 H37; rewrite -H5 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 5 1 _A11{2}.[1] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +split. +rewrite H H0. +move : H36 H37; rewrite -H5 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 5 0 _A11{2}.[0] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +split. +rewrite H H0. +move : H36 H37; rewrite -H5 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 1 3 _A01{2}.[3] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +split. +rewrite H H0. +move : H36 H37; rewrite -H5 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 1 2 _A01{2}.[2] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +split. +rewrite H H0. +move : H36 H37; rewrite -H5 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 1 1 _A01{2}.[1] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +split. +rewrite H H0. +move : H36 H37; rewrite -H5 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 1 0 _A01{2}.[0] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + + +split. +rewrite H H0. +move : H36 H37; rewrite -H5 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 0 2 _A20{2}.[2] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +split. +rewrite H H0. +move : H36 H37; rewrite -H5 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 0 0 _A20{2}.[0] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +split. +rewrite H H0. +move : H36 H37; rewrite -H5 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 0 3 _A20{2}.[3] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +split. +rewrite H H0. +move : H36 H37; rewrite -H5 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 0 1 _A20{2}.[1] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +split. +rewrite H H0. +move : H36 H37; rewrite -H5 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 2 2 _A31{2}.[2] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +split. +rewrite H H0. +move : H36 H37; rewrite -H5 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 2 0 _A31{2}.[0] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +split. +rewrite H H0. +move : H36 H37; rewrite -H5 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 2 3 _A31{2}.[3] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +split. +rewrite H H0. +move : H36 H37; rewrite -H5 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 2 1 _A31{2}.[1] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +split. +rewrite H H0. +move : H36 H37; rewrite -H5 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 3 0 _A21{2}.[0] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +split. +rewrite H H0. +move : H36 H37; rewrite -H5 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 3 1 _A21{2}.[1] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +split. +rewrite H H0. +move : H36 H37; rewrite -H5 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 3 2 _A21{2}.[2] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +split. +rewrite H H0. +move : H36 H37; rewrite -H5 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 3 3 _A21{2}.[3] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +split. +rewrite H H0. +move : H36 H37; rewrite -H5 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 4 1 _A41{2}.[1] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +split. +rewrite H H0. +move : H36 H37; rewrite -H5 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 4 3 _A41{2}.[3] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +split. +rewrite H H0. +move : H36 H37; rewrite -H5 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 4 0 _A41{2}.[0] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +rewrite H H0. +move : H36 H37; rewrite -H5 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 4 2 _A41{2}.[2] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + + +(* Chi *) +inline Mreftable.chi. + +seq 5 53 : (#{~state0{1}}pre /\ + equiv_states _A00{2} _A01{2} _A20{2} _A31{2} _A21{2} _A41{2} _A11{2} state0{1}). + +unroll for {1} 4. +unroll for {1} 5. +unroll for {1} 46. +unroll for {1} 58. +unroll for {1} 99. +unroll for {1} 111. +unroll for {1} 152. +unroll for {1} 164. +unroll for {1} 205. +unroll for {1} 217. +unroll for {1} 258. + +inline *. +rcondf {2} 4; first by auto => />. +rcondt {2} 4; first by auto => />. +rcondf {2} 20; first by auto => />. +rcondf {2} 20; first by auto => />. +rcondt {2} 20; first by auto => />. +rcondf {2} 29; first by auto => />. +rcondf {2} 29; first by auto => />. +rcondt {2} 29; first by auto => />. +rcondf {2} 38; first by auto => />. +rcondf {2} 38; first by auto => />. +rcondt {2} 38; first by auto => />. +rcondf {2} 47; first by auto => />. +rcondf {2} 47; first by auto => />. +rcondt {2} 47; first by auto => />. +rcondf {2} 56; first by auto => />. +rcondf {2} 56; first by auto => />. +rcondf {2} 56; first by auto => />. +rcondt {2} 56; first by auto => />. +rcondf {2} 65; first by auto => />. +rcondf {2} 65; first by auto => />. +rcondf {2} 65; first by auto => />. +rcondt {2} 65; first by auto => />. +rcondf {2} 74; first by auto => />. +rcondf {2} 74; first by auto => />. +rcondf {2} 74; first by auto => />. +rcondt {2} 74; first by auto => />. +rcondf {2} 83; first by auto => />. +rcondf {2} 83; first by auto => />. +rcondf {2} 83; first by auto => />. +rcondt {2} 83; first by auto => />. +rcondt {2} 92; first by auto => />. +rcondt {2} 101; first by auto => />. +rcondt {2} 110; first by auto => />. +rcondt {2} 119; first by auto => />. +rcondf {2} 142; first by auto => />. +rcondf {2} 142; first by auto => />. +rcondt {2} 142; first by auto => />. +rcondf {2} 151; first by auto => />. +rcondf {2} 151; first by auto => />. +rcondt {2} 151; first by auto => />. +rcondf {2} 167; first by auto => />. +rcondf {2} 167; first by auto => />. +rcondf {2} 167; first by auto => />. +rcondt {2} 167; first by auto => />. +rcondf {2} 176; first by auto => />. +rcondf {2} 176; first by auto => />. +rcondf {2} 176; first by auto => />. +rcondt {2} 176; first by auto => />. +rcondt {2} 192; first by auto => />. +rcondt {2} 201; first by auto => />. +rcondf {2} 223; first by auto => />. +rcondf {2} 223; first by auto => />. +rcondf {2} 223; first by auto => />. +rcondf {2} 223; first by auto => />. +rcondf {2} 223; first by auto => />. +rcondf {2} 223; first by auto => />. +rcondf {2} 223; first by auto => />. +rcondf {2} 223; first by auto => />. +rcondt {2} 223; first by auto => />. +rcondf {2} 232; first by auto => />. +rcondf {2} 232; first by auto => />. +rcondf {2} 232; first by auto => />. +rcondt {2} 232; first by auto => />. +rcondf {2} 240; first by auto => />. +rcondf {2} 240; first by auto => />. +rcondf {2} 240; first by auto => />. +rcondt {2} 240; first by auto => />. +rcondt {2} 249; first by auto => />. +rcondf {2} 265; first by auto => />. +rcondf {2} 265; first by auto => />. +rcondt {2} 265; first by auto => />. +rcondf {2} 274; first by auto => />. +rcondf {2} 274; first by auto => />. +rcondt {2} 274; first by auto => />. +rcondf {2} 283; first by auto => />. +rcondf {2} 283; first by auto => />. +rcondf {2} 283; first by auto => />. +rcondt {2} 283; first by auto => />. +rcondf {2} 292; first by auto => />. +rcondf {2} 292; first by auto => />. +rcondf {2} 292; first by auto => />. +rcondt {2} 292; first by auto => />. +rcondt {2} 301; first by auto => />. +rcondt {2} 310; first by auto => />. +rcondf {2} 332; first by auto => />. +rcondf {2} 332; first by auto => />. +rcondf {2} 332; first by auto => />. +rcondf {2} 332; first by auto => />. +rcondf {2} 332; first by auto => />. +rcondf {2} 332; first by auto => />. +rcondf {2} 332; first by auto => />. +rcondt {2} 332; first by auto => />. +rcondf {2} 340; first by auto => />. +rcondf {2} 340; first by auto => />. +rcondf {2} 340; first by auto => />. +rcondf {2} 340; first by auto => />. +rcondf {2} 340; first by auto => />. +rcondt {2} 340; first by auto => />. +rcondf {2} 348; first by auto => />. +rcondf {2} 348; first by auto => />. +rcondf {2} 348; first by auto => />. +rcondf {2} 348; first by auto => />. +rcondt {2} 348; first by auto => />. +rcondf {2} 356; first by auto => />. +rcondf {2} 356; first by auto => />. +rcondf {2} 356; first by auto => />. +rcondf {2} 356; first by auto => />. +rcondf {2} 356; first by auto => />. +rcondf {2} 356; first by auto => />. +rcondt {2} 356; first by auto => />. +rcondf {2} 365; first by auto => />. +rcondf {2} 365; first by auto => />. +rcondt {2} 365; first by auto => />. +rcondf {2} 374; first by auto => />. +rcondf {2} 374; first by auto => />. +rcondt {2} 374; first by auto => />. +rcondf {2} 383; first by auto => />. +rcondf {2} 383; first by auto => />. +rcondf {2} 383; first by auto => />. +rcondt {2} 383; first by auto => />. +rcondf {2} 392; first by auto => />. +rcondf {2} 392; first by auto => />. +rcondf {2} 392; first by auto => />. +rcondt {2} 392; first by auto => />. +rcondt {2} 401; first by auto => />. +rcondt {2} 410; first by auto => />. + +wp. skip. +move => &1 &2. +rewrite /equiv_states /equiv_states_chi /index. +simplify. + +move => [/ # *]. + +split; first by smt(). + +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +smt(@W64). + +inline *. wp;skip. +move => &1 &2 [/ # *]. +split; first by smt(). +split; first by smt(). +split; first by smt(). +split; first by smt(). +split; first by smt(). +rewrite /equiv_states /index /y_R. +simplify. + +move : (loadlift_iotas Glob.mem{2} (iotas{2}) 0) => //= ii. +rewrite ii. simplify. +smt(@W64). +rewrite /good_iotas4x. +simplify. +smt(@W64). + +seq 1 2 : (#{/~iotas{2}}{~round{1}}{~i{2}}{~st}pre /\ + iotas{2} = _iotas{2} + W64.of_int (round{1} * 32) /\ + to_uint i{2} = 24 - round{1} /\ + ((to_uint i{2} = 0) <> round{1} < 24) /\ + (x86_DEC_32 (i{2} + W32.of_int 1)).`4 = zf{2} /\ + 0 < round{1} /\ + to_uint i{2} <= 24 /\ + constants{1} = Keccak_f1600_ref.iotas). + +auto => />. +progress. +apply dec. smt(). +rewrite (dec). smt(@W32). smt(@W32). +rewrite (decK). smt(@W32). +smt(@W32 dec decK). + +while (#pre). + +inline Mreftable.keccakP1600_round. + + +sp 2 0. +inline Mreftable.theta. +sp 1 0. + +swap {2} [20..21] 3. +swap {2} 28 -3. +swap {2} 32 -6. +swap {2} 36 -9. +swap {2} 40 -12. +swap {2} 46 -17. + +seq 9 29 : (#{/~state{1}}post /\ c{1} = constants{1}.[round{1}] /\ round{1} < 24 /\ + equiv_states _A00{2} _A01{2} _A20{2} _A31{2} _A21{2} _A41{2} _A11{2} state0{1}). + +unroll for {1} 4. +unroll for {1} 6. +unroll for {1} 23. +unroll for {1} 19. +unroll for {1} 45. +unroll for {1} 58. +unroll for {1} 70. +unroll for {1} 101. +unroll for {1} 102. +unroll for {1} 114. +unroll for {1} 126. +unroll for {1} 138. +unroll for {1} 150. +inline *. +rcondt {2} 4; first by move => *; auto => />. +rcondf {2} 40; first by move => *; auto => />. +rcondt {2} 40; first by move => *; auto => />. +rcondf {2} 55; first by move => *; auto => />. +rcondf {2} 55; first by move => *; auto => />. +rcondt {2} 55; first by move => *; auto => />. +rcondf {2} 84; first by move => *; auto => />. +rcondf {2} 84; first by move => *; auto => />. +rcondf {2} 84; first by move => *; auto => />. +rcondt {2} 84; first by move => *; auto => />. +rcondf {2} 99; first by move => *; auto => />. +rcondf {2} 99; first by move => *; auto => />. +rcondf {2} 99; first by move => *; auto => />. +rcondf {2} 99; first by move => *; auto => />. +rcondf {2} 99; first by move => *; auto => />. +rcondf {2} 99; first by move => *; auto => />. +rcondf {2} 99; first by move => *; auto => />. +rcondt {2} 99; first by move => *; auto => />. +rcondt {2} 143; first by move => *; auto => />. +rcondf {2} 152; first by move => *; auto => />. +rcondt {2} 152; first by move => *; auto => />. + +wp;skip. +move => &1 &2. +rewrite /equiv_states /index. +simplify. +by smt(W64.xorwA W64.xorwC W64.xorw0 W64.xorwK rolcomp commor). + +(* Rho PI *) +inline Mreftable.rho Mreftable.pi. + +seq 11 22 : (#{/~ state{1}}post /\ c{1} = constants{1}.[round{1}] /\ round{1} < 24 /\ + equiv_states_chi _A00{2} _T{2}.[1] _T{2}.[2] _T{2}.[3] _T{2}.[4] _T{2}.[5] _T{2}.[6] state0{1}). + +unroll for {1} 3. +unroll for {1} 4. +unroll for {1} 41. +unroll for {1} 78. +unroll for {1} 115. +unroll for {1} 152. +unroll for {1} 192. +unroll for {1} 268. +unroll for {1} 269. +unroll for {1} 291. +unroll for {1} 313. +unroll for {1} 335. +unroll for {1} 357. + +inline *. + +rcondf {2} 88; first by auto => />. +rcondf {2} 88; first by auto => />. +rcondf {2} 88; first by auto => />. +rcondf {2} 88; first by auto => />. +rcondt {2} 88; first by auto => />. +rcondf {2} 96; first by auto => />. +rcondf {2} 96; first by auto => />. +rcondf {2} 96; first by auto => />. +rcondf {2} 96; first by auto => />. +rcondt {2} 96; first by auto => />. +rcondf {2} 125; first by auto => />. +rcondf {2} 125; first by auto => />. +rcondf {2} 125; first by auto => />. +rcondf {2} 125; first by auto => />. +rcondf {2} 125; first by auto => />. +rcondt {2} 125; first by auto => />. +rcondf {2} 133; first by auto => />. +rcondf {2} 133; first by auto => />. +rcondf {2} 133; first by auto => />. +rcondf {2} 133; first by auto => />. +rcondf {2} 133; first by auto => />. +rcondf {2} 133; first by auto => />. +rcondt {2} 133; first by auto => />. + +wp;skip. +move => &1 &2. +rewrite /equiv_states /equiv_states_chi /index. +simplify. + +move => [/ #] *. + +split; first by smt(). +split; first by smt(). +split; first by smt(). + +split; first by rewrite /rhotates; smt(roln rol0). +split; first by rewrite /rhotates; smt(roln rol0). +split; first by rewrite /rhotates; smt(roln rol0). +split; first by rewrite /rhotates; smt(roln rol0). + + +split. +rewrite H H0. +move : H5 H6; rewrite -H2 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 5 3 _A11{2}.[3] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +split. +rewrite H H0. +move : H5 H6; rewrite -H2 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 5 2 _A11{2}.[2] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +split. +rewrite H H0. +move : H5 H6; rewrite -H2 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 5 1 _A11{2}.[1] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +split. +rewrite H H0. +move : H5 H6; rewrite -H2 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 5 0 _A11{2}.[0] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +split. +rewrite H H0. +move : H5 H6; rewrite -H2 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 1 3 _A01{2}.[3] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +split. +rewrite H H0. +move : H5 H6; rewrite -H2 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 1 2 _A01{2}.[2] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +split. +rewrite H H0. +move : H5 H6; rewrite -H2 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 1 1 _A01{2}.[1] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +split. +rewrite H H0. +move : H5 H6; rewrite -H2 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 1 0 _A01{2}.[0] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + + +split. +rewrite H H0. +move : H5 H6; rewrite -H2 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 0 2 _A20{2}.[2] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +split. +rewrite H H0. +move : H5 H6; rewrite -H2 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 0 0 _A20{2}.[0] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +split. +rewrite H H0. +move : H5 H6; rewrite -H2 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 0 3 _A20{2}.[3] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +split. +rewrite H H0. +move : H5 H6; rewrite -H2 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 0 1 _A20{2}.[1] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +split. +rewrite H H0. +move : H5 H6; rewrite -H2 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 2 2 _A31{2}.[2] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +split. +rewrite H H0. +move : H5 H6; rewrite -H2 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 2 0 _A31{2}.[0] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +split. +rewrite H H0. +move : H5 H6; rewrite -H2 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 2 3 _A31{2}.[3] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +split. +rewrite H H0. +move : H5 H6; rewrite -H2 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 2 1 _A31{2}.[1] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +split. +rewrite H H0. +move : H5 H6; rewrite -H2 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 3 0 _A21{2}.[0] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +split. +rewrite H H0. +move : H5 H6; rewrite -H2 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 3 1 _A21{2}.[1] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +split. +rewrite H H0. +move : H5 H6; rewrite -H2 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 3 2 _A21{2}.[2] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +split. +rewrite H H0. +move : H5 H6; rewrite -H2 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 3 3 _A21{2}.[3] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +split. +rewrite H H0. +move : H5 H6; rewrite -H2 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 4 1 _A41{2}.[1] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +split. +rewrite H H0. +move : H5 H6; rewrite -H2 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 4 3 _A41{2}.[3] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +split. +rewrite H H0. +move : H5 H6; rewrite -H2 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 4 0 _A41{2}.[0] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +rewrite H H0. +move : H5 H6; rewrite -H2 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 4 2 _A41{2}.[2] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +smt(). + +(* Chi *) +inline Mreftable.chi. + +seq 5 53 : (#{~state0{1}}pre /\ + equiv_states _A00{2} _A01{2} _A20{2} _A31{2} _A21{2} _A41{2} _A11{2} state0{1}). + +unroll for {1} 4. +unroll for {1} 5. +unroll for {1} 46. +unroll for {1} 58. +unroll for {1} 99. +unroll for {1} 111. +unroll for {1} 152. +unroll for {1} 164. +unroll for {1} 205. +unroll for {1} 217. +unroll for {1} 258. + +inline *. +rcondf {2} 4; first by auto => />. +rcondt {2} 4; first by auto => />. +rcondf {2} 20; first by auto => />. +rcondf {2} 20; first by auto => />. +rcondt {2} 20; first by auto => />. +rcondf {2} 29; first by auto => />. +rcondf {2} 29; first by auto => />. +rcondt {2} 29; first by auto => />. +rcondf {2} 38; first by auto => />. +rcondf {2} 38; first by auto => />. +rcondt {2} 38; first by auto => />. +rcondf {2} 47; first by auto => />. +rcondf {2} 47; first by auto => />. +rcondt {2} 47; first by auto => />. +rcondf {2} 56; first by auto => />. +rcondf {2} 56; first by auto => />. +rcondf {2} 56; first by auto => />. +rcondt {2} 56; first by auto => />. +rcondf {2} 65; first by auto => />. +rcondf {2} 65; first by auto => />. +rcondf {2} 65; first by auto => />. +rcondt {2} 65; first by auto => />. +rcondf {2} 74; first by auto => />. +rcondf {2} 74; first by auto => />. +rcondf {2} 74; first by auto => />. +rcondt {2} 74; first by auto => />. +rcondf {2} 83; first by auto => />. +rcondf {2} 83; first by auto => />. +rcondf {2} 83; first by auto => />. +rcondt {2} 83; first by auto => />. +rcondt {2} 92; first by auto => />. +rcondt {2} 101; first by auto => />. +rcondt {2} 110; first by auto => />. +rcondt {2} 119; first by auto => />. +rcondf {2} 142; first by auto => />. +rcondf {2} 142; first by auto => />. +rcondt {2} 142; first by auto => />. +rcondf {2} 151; first by auto => />. +rcondf {2} 151; first by auto => />. +rcondt {2} 151; first by auto => />. +rcondf {2} 167; first by auto => />. +rcondf {2} 167; first by auto => />. +rcondf {2} 167; first by auto => />. +rcondt {2} 167; first by auto => />. +rcondf {2} 176; first by auto => />. +rcondf {2} 176; first by auto => />. +rcondf {2} 176; first by auto => />. +rcondt {2} 176; first by auto => />. +rcondt {2} 192; first by auto => />. +rcondt {2} 201; first by auto => />. +rcondf {2} 223; first by auto => />. +rcondf {2} 223; first by auto => />. +rcondf {2} 223; first by auto => />. +rcondf {2} 223; first by auto => />. +rcondf {2} 223; first by auto => />. +rcondf {2} 223; first by auto => />. +rcondf {2} 223; first by auto => />. +rcondf {2} 223; first by auto => />. +rcondt {2} 223; first by auto => />. +rcondf {2} 232; first by auto => />. +rcondf {2} 232; first by auto => />. +rcondf {2} 232; first by auto => />. +rcondt {2} 232; first by auto => />. +rcondf {2} 240; first by auto => />. +rcondf {2} 240; first by auto => />. +rcondf {2} 240; first by auto => />. +rcondt {2} 240; first by auto => />. +rcondt {2} 249; first by auto => />. +rcondf {2} 265; first by auto => />. +rcondf {2} 265; first by auto => />. +rcondt {2} 265; first by auto => />. +rcondf {2} 274; first by auto => />. +rcondf {2} 274; first by auto => />. +rcondt {2} 274; first by auto => />. +rcondf {2} 283; first by auto => />. +rcondf {2} 283; first by auto => />. +rcondf {2} 283; first by auto => />. +rcondt {2} 283; first by auto => />. +rcondf {2} 292; first by auto => />. +rcondf {2} 292; first by auto => />. +rcondf {2} 292; first by auto => />. +rcondt {2} 292; first by auto => />. +rcondt {2} 301; first by auto => />. +rcondt {2} 310; first by auto => />. +rcondf {2} 332; first by auto => />. +rcondf {2} 332; first by auto => />. +rcondf {2} 332; first by auto => />. +rcondf {2} 332; first by auto => />. +rcondf {2} 332; first by auto => />. +rcondf {2} 332; first by auto => />. +rcondf {2} 332; first by auto => />. +rcondt {2} 332; first by auto => />. +rcondf {2} 340; first by auto => />. +rcondf {2} 340; first by auto => />. +rcondf {2} 340; first by auto => />. +rcondf {2} 340; first by auto => />. +rcondf {2} 340; first by auto => />. +rcondt {2} 340; first by auto => />. +rcondf {2} 348; first by auto => />. +rcondf {2} 348; first by auto => />. +rcondf {2} 348; first by auto => />. +rcondf {2} 348; first by auto => />. +rcondt {2} 348; first by auto => />. +rcondf {2} 356; first by auto => />. +rcondf {2} 356; first by auto => />. +rcondf {2} 356; first by auto => />. +rcondf {2} 356; first by auto => />. +rcondf {2} 356; first by auto => />. +rcondf {2} 356; first by auto => />. +rcondt {2} 356; first by auto => />. +rcondf {2} 365; first by auto => />. +rcondf {2} 365; first by auto => />. +rcondt {2} 365; first by auto => />. +rcondf {2} 374; first by auto => />. +rcondf {2} 374; first by auto => />. +rcondt {2} 374; first by auto => />. +rcondf {2} 383; first by auto => />. +rcondf {2} 383; first by auto => />. +rcondf {2} 383; first by auto => />. +rcondt {2} 383; first by auto => />. +rcondf {2} 392; first by auto => />. +rcondf {2} 392; first by auto => />. +rcondf {2} 392; first by auto => />. +rcondt {2} 392; first by auto => />. +rcondt {2} 401; first by auto => />. +rcondt {2} 410; first by auto => />. + +wp. skip. +move => &1 &2. +rewrite /equiv_states /equiv_states_chi /index. +simplify. + +move => [/ #] *. + +split; first by smt(). + +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +smt(@W64). + +smt(). + + +(* iota *) + +seq 2 1 : (#{/~ state0{1}}pre /\ + equiv_states _A00{2} _A01{2} _A20{2} _A31{2} _A21{2} _A41{2} _A11{2} + state{1}). + +inline *; wp; skip; rewrite /equiv_states /index; progress. + +move : (loadlift_iotas Glob.mem{2} _iotas{2}(round{1})) => ii. +rewrite (_:round{1} * 32 = 8*4*round{1}); first by smt(). +rewrite ii. simplify. smt(). smt(). +rewrite /good_iotas4x /iotas. +case (round{1} = 0); first by auto => />. +case (round{1} = 1). auto => />. smt(@W64). +case (round{1} = 2). auto => />. smt(@W64). +case (round{1} = 3). auto => />. smt(@W64). +case (round{1} = 4). auto => />. smt(@W64). +case (round{1} = 5). auto => />. smt(@W64). +case (round{1} = 6). auto => />. smt(@W64). +case (round{1} = 7). auto => />. smt(@W64). +case (round{1} = 8). auto => />. smt(@W64). +case (round{1} = 9). auto => />. smt(@W64). +case (round{1} = 10). auto => />. smt(@W64). +case (round{1} = 11). auto => />. smt(@W64). +case (round{1} = 12). auto => />. smt(@W64). +case (round{1} = 13). auto => />. smt(@W64). +case (round{1} = 14). auto => />. smt(@W64). +case (round{1} = 15). auto => />. smt(@W64). +case (round{1} = 16). auto => />. smt(@W64). +case (round{1} = 17). auto => />. smt(@W64). +case (round{1} = 18). auto => />. smt(@W64). +case (round{1} = 19). auto => />. smt(@W64). +case (round{1} = 20). auto => />. smt(@W64). +case (round{1} = 21). auto => />. smt(@W64). +case (round{1} = 22). auto => />. smt(@W64). +case (round{1} = 23). auto => />. smt(@W64). +smt(). + +move : (loadlift_iotas Glob.mem{2} _iotas{2}(round{1})) => ii. +rewrite (_:round{1} * 32 = 8*4*round{1}); first by smt(). +rewrite ii. simplify. smt(). smt(). +rewrite /good_iotas4x /iotas. +case (round{1} = 0); first by auto => />. +case (round{1} = 1). auto => />. smt(@W64). +case (round{1} = 2). auto => />. smt(@W64). +case (round{1} = 3). auto => />. smt(@W64). +case (round{1} = 4). auto => />. smt(@W64). +case (round{1} = 5). auto => />. smt(@W64). +case (round{1} = 6). auto => />. smt(@W64). +case (round{1} = 7). auto => />. smt(@W64). +case (round{1} = 8). auto => />. smt(@W64). +case (round{1} = 9). auto => />. smt(@W64). +case (round{1} = 10). auto => />. smt(@W64). +case (round{1} = 11). auto => />. smt(@W64). +case (round{1} = 12). auto => />. smt(@W64). +case (round{1} = 13). auto => />. smt(@W64). +case (round{1} = 14). auto => />. smt(@W64). +case (round{1} = 15). auto => />. smt(@W64). +case (round{1} = 16). auto => />. smt(@W64). +case (round{1} = 17). auto => />. smt(@W64). +case (round{1} = 18). auto => />. smt(@W64). +case (round{1} = 19). auto => />. smt(@W64). +case (round{1} = 20). auto => />. smt(@W64). +case (round{1} = 21). auto => />. smt(@W64). +case (round{1} = 22). auto => />. smt(@W64). +case (round{1} = 23). auto => />. smt(@W64). +smt(). + +move : (loadlift_iotas Glob.mem{2} _iotas{2}(round{1})) => ii. +rewrite (_:round{1} * 32 = 8*4*round{1}); first by smt(). +rewrite ii. simplify. smt(). smt(). +rewrite /good_iotas4x /iotas. +case (round{1} = 0); first by auto => />. +case (round{1} = 1). auto => />. smt(@W64). +case (round{1} = 2). auto => />. smt(@W64). +case (round{1} = 3). auto => />. smt(@W64). +case (round{1} = 4). auto => />. smt(@W64). +case (round{1} = 5). auto => />. smt(@W64). +case (round{1} = 6). auto => />. smt(@W64). +case (round{1} = 7). auto => />. smt(@W64). +case (round{1} = 8). auto => />. smt(@W64). +case (round{1} = 9). auto => />. smt(@W64). +case (round{1} = 10). auto => />. smt(@W64). +case (round{1} = 11). auto => />. smt(@W64). +case (round{1} = 12). auto => />. smt(@W64). +case (round{1} = 13). auto => />. smt(@W64). +case (round{1} = 14). auto => />. smt(@W64). +case (round{1} = 15). auto => />. smt(@W64). +case (round{1} = 16). auto => />. smt(@W64). +case (round{1} = 17). auto => />. smt(@W64). +case (round{1} = 18). auto => />. smt(@W64). +case (round{1} = 19). auto => />. smt(@W64). +case (round{1} = 20). auto => />. smt(@W64). +case (round{1} = 21). auto => />. smt(@W64). +case (round{1} = 22). auto => />. smt(@W64). +case (round{1} = 23). auto => />. smt(@W64). +smt(). + +move : (loadlift_iotas Glob.mem{2} _iotas{2}(round{1})) => ii. +rewrite (_:round{1} * 32 = 8*4*round{1}); first by smt(). +rewrite ii. simplify. smt(). +smt(). +rewrite /good_iotas4x /iotas. +case (round{1} = 0); first by auto => />. +case (round{1} = 1). auto => />. smt(@W64). +case (round{1} = 2). auto => />. smt(@W64). +case (round{1} = 3). auto => />. smt(@W64). +case (round{1} = 4). auto => />. smt(@W64). +case (round{1} = 5). auto => />. smt(@W64). +case (round{1} = 6). auto => />. smt(@W64). +case (round{1} = 7). auto => />. smt(@W64). +case (round{1} = 8). auto => />. smt(@W64). +case (round{1} = 9). auto => />. smt(@W64). +case (round{1} = 10). auto => />. smt(@W64). +case (round{1} = 11). auto => />. smt(@W64). +case (round{1} = 12). auto => />. smt(@W64). +case (round{1} = 13). auto => />. smt(@W64). +case (round{1} = 14). auto => />. smt(@W64). +case (round{1} = 15). auto => />. smt(@W64). +case (round{1} = 16). auto => />. smt(@W64). +case (round{1} = 17). auto => />. smt(@W64). +case (round{1} = 18). auto => />. smt(@W64). +case (round{1} = 19). auto => />. smt(@W64). +case (round{1} = 20). auto => />. smt(@W64). +case (round{1} = 21). auto => />. smt(@W64). +case (round{1} = 22). auto => />. smt(@W64). +case (round{1} = 23). auto => />. smt(@W64). +smt(). + +wp;skip;progress;smt(dec dec0 decK @W32). + +skip;progress. + +rewrite dec0. +split. rewrite to_uintD. smt(@W32). smt(@W32). +rewrite dec. rewrite to_uintD. smt(@W32). smt(@W32). + +move : H7. rewrite dec0. +rewrite to_uintD. smt(@W32). +rewrite dec. rewrite to_uintD. smt(@W32). +rewrite to_uintD. smt(@W32). +qed. + diff --git a/proof/impl/perm/keccak_f1600_avx2_prevec.ec b/proof/impl/perm/keccak_f1600_avx2_prevec.ec deleted file mode 100644 index 2785003..0000000 --- a/proof/impl/perm/keccak_f1600_avx2_prevec.ec +++ /dev/null @@ -1,1168 +0,0 @@ -require import List Int IntExtra IntDiv CoreMap. -from Jasmin require import JModel. - -(* -require import Array9. -require import WArray288. -*) - -clone export PolyArray as Array9 with op size <- 9. -clone export PolyArray as Array4 with op size <- 4. -clone export PolyArray as Array24 with op size <- 24. -clone export PolyArray as Array96 with op size <- 96. - -require import Ops. - -op x86_DEC_32 : W32.t -> (bool * bool * bool * bool * W32.t). - -op lift2array : W256.t -> W64.t Array4.t. - -module Mavx2_prevec = { - - proc rhotates_right(off : int) : W64.t Array4.t = { - var table : int Array24.t; - var r : W64.t Array4.t; - table.[4*0+0] = 64-3 ; table.[4*0+1] = 64-18; table.[4*0+2] = 64-36; table.[4*0+3] = 64-41; - table.[4*1+0] = 64-1 ; table.[4*1+1] = 64-62; table.[4*1+2] = 64-28; table.[4*1+3] = 64-27; - table.[4*2+0] = 64-45; table.[4*2+1] = 64-6 ; table.[4*2+2] = 64-56; table.[4*2+3] = 64-39; - table.[4*3+0] = 64-10; table.[4*3+1] = 64-61; table.[4*3+2] = 64-55; table.[4*3+3] = 64-8 ; - table.[4*4+0] = 64-2 ; table.[4*4+1] = 64-15; table.[4*4+2] = 64-25; table.[4*4+3] = 64-20; - table.[4*5+0] = 64-44; table.[4*5+1] = 64-43; table.[4*5+2] = 64-21; table.[4*5+3] = 64-14; - r.[0] = W64.of_int table.[4*off + 0]; - r.[1] = W64.of_int table.[4*off + 1]; - r.[2] = W64.of_int table.[4*off + 2]; - r.[3] = W64.of_int table.[4*off + 3]; - return r; - } - - proc rhotates_left(off : int) : W64.t Array4.t = { - var table : int Array24.t; - var r : W64.t Array4.t; - table.[4*0+0]=3 ; table.[4*0+1]=18; table.[4*0+2]=36; table.[4*0+3]=41; - table.[4*1+0]=1 ; table.[4*1+1]=62; table.[4*1+2]=28; table.[4*1+3]=27; - table.[4*2+0]=45; table.[4*2+1]=6 ; table.[4*2+2]=56; table.[4*2+3]=39; - table.[4*3+0]=10; table.[4*3+1]=61; table.[4*3+2]=55; table.[4*3+3]=8 ; - table.[4*4+0]=2 ; table.[4*4+1]=15; table.[4*4+2]=25; table.[4*4+3]=20; - table.[4*5+0]=44; table.[4*5+1]=43; table.[4*5+2]=21; table.[4*5+3]=14; - r.[0] = W64.of_int table.[4*off + 0]; - r.[1] = W64.of_int table.[4*off + 1]; - r.[2] = W64.of_int table.[4*off + 2]; - r.[3] = W64.of_int table.[4*off + 3]; - return r; - } - - proc iotas(off : int) : W64.t Array4.t = { - var table : int Array96.t; - var r : W64.t Array4.t; - table.[4* 0+3] = 1; table.[4* 0+2] = 1; table.[4* 0+1] = 1; table.[4* 0+0] = 1; - table.[4* 1+3] = 32898; table.[4* 1+2] = 32898; table.[4* 1+1] = 32898; table.[4* 1+0] = 32898; - table.[4* 2+3] = 9223372036854808714; table.[4* 2+2] = 9223372036854808714; table.[4* 2+1] = 9223372036854808714; table.[4* 2+0] = 9223372036854808714; - table.[4* 3+3] = 9223372039002292224; table.[4* 3+2] = 9223372039002292224; table.[4* 3+1] = 9223372039002292224; table.[4* 3+0] = 9223372039002292224; - table.[4* 4+3] = 32907; table.[4* 4+2] = 32907; table.[4* 4+1] = 32907; table.[4* 4+0] = 32907; - table.[4* 5+3] = 2147483649; table.[4* 5+2] = 2147483649; table.[4* 5+1] = 2147483649; table.[4* 5+0] = 2147483649; - table.[4* 6+3] = 9223372039002292353; table.[4* 6+2] = 9223372039002292353; table.[4* 6+1] = 9223372039002292353; table.[4* 6+0] = 9223372039002292353; - table.[4* 7+3] = 9223372036854808585; table.[4* 7+2] = 9223372036854808585; table.[4* 7+1] = 9223372036854808585; table.[4* 7+0] = 9223372036854808585; - table.[4* 8+3] = 138; table.[4* 8+2] = 138; table.[4* 8+1] = 138; table.[4* 8+0] = 138; - table.[4* 9+3] = 136; table.[4* 9+2] = 136; table.[4* 9+1] = 136; table.[4* 9+0] = 136; - table.[4*10+3] = 2147516425; table.[4*10+2] = 2147516425; table.[4*10+1] = 2147516425; table.[4*10+0] = 2147516425; - table.[4*11+3] = 2147483658; table.[4*11+2] = 2147483658; table.[4*11+1] = 2147483658; table.[4*11+0] = 2147483658; - table.[4*12+3] = 2147516555; table.[4*12+2] = 2147516555; table.[4*12+1] = 2147516555; table.[4*12+0] = 2147516555; - table.[4*13+3] = 9223372036854775947; table.[4*13+2] = 9223372036854775947; table.[4*13+1] = 9223372036854775947; table.[4*13+0] = 9223372036854775947; - table.[4*14+3] = 9223372036854808713; table.[4*14+2] = 9223372036854808713; table.[4*14+1] = 9223372036854808713; table.[4*14+0] = 9223372036854808713; - table.[4*15+3] = 9223372036854808579; table.[4*15+2] = 9223372036854808579; table.[4*15+1] = 9223372036854808579; table.[4*15+0] = 9223372036854808579; - table.[4*16+3] = 9223372036854808578; table.[4*16+2] = 9223372036854808578; table.[4*16+1] = 9223372036854808578; table.[4*16+0] = 9223372036854808578; - table.[4*17+3] = 9223372036854775936; table.[4*17+2] = 9223372036854775936; table.[4*17+1] = 9223372036854775936; table.[4*17+0] = 9223372036854775936; - table.[4*18+3] = 32778; table.[4*18+2] = 32778; table.[4*18+1] = 32778; table.[4*18+0] = 32778; - table.[4*19+3] = 9223372039002259466; table.[4*19+2] = 9223372039002259466; table.[4*19+1] = 9223372039002259466; table.[4*19+0] = 9223372039002259466; - table.[4*20+3] = 9223372039002292353; table.[4*20+2] = 9223372039002292353; table.[4*20+1] = 9223372039002292353; table.[4*20+0] = 9223372039002292353; - table.[4*21+3] = 9223372036854808704; table.[4*21+2] = 9223372036854808704; table.[4*21+1] = 9223372036854808704; table.[4*21+0] = 9223372036854808704; - table.[4*22+3] = 2147483649; table.[4*22+2] = 2147483649; table.[4*22+1] = 2147483649; table.[4*22+0] = 2147483649; - table.[4*23+3] = 9223372039002292232; table.[4*23+2] = 9223372039002292232; table.[4*23+1] = 9223372039002292232; table.[4*23+0] = 9223372039002292232; - r.[0] = W64.of_int table.[4*off + 0]; - r.[1] = W64.of_int table.[4*off + 1]; - r.[2] = W64.of_int table.[4*off + 2]; - r.[3] = W64.of_int table.[4*off + 3]; - return r; - } - - proc __KeccakF1600 (_A00:W64.t Array4.t, _A01:W64.t Array4.t, _A20:W64.t Array4.t, _A31:W64.t Array4.t, - _A21:W64.t Array4.t, _A41:W64.t Array4.t, _A11:W64.t Array4.t - ) : W64.t Array4.t * W64.t Array4.t * W64.t Array4.t * W64.t Array4.t * - W64.t Array4.t * W64.t Array4.t * W64.t Array4.t = { - - var rhotates_left:W64.t; - var rhotates_right:W64.t; - var iotas:int; - var i:W32.t; - var zf:bool; - var _C00:W64.t Array4.t; - var _C14:W64.t Array4.t; - var _T:W64.t Array4.t Array9.t; - var _D14:W64.t Array4.t; - var _D00:W64.t Array4.t; - var _0:bool; - var _1:bool; - var _2:bool; - var aux : W64.t Array4.t; - var aux2 : W64.t Array4.t; - _T <- witness; - iotas <- 0; - i <- (W32.of_int 24); - _C00 <@ Ops.iVPSHUF_D_256(_A20,(W8.of_int 78)); - _C14 <@ Ops.ilxor4u64(_A41,_A31); - _T.[2] <@ Ops.ilxor4u64(_A21,_A11); - _C14 <@ Ops.ilxor4u64(_C14,_A01); - _C14 <@ Ops.ilxor4u64(_C14,_T.[2]); - _T.[4] <- Ops.iVPERMQ(_C14,(W8.of_int 147)); - _C00 <@ Ops.ilxor4u64(_C00,_A20); - _T.[0] <- Ops.iVPERMQ(_C00,(W8.of_int 78)); - _T.[1] <- Ops.ivshr64u256(_C14, (W8.of_int 63)); - _T.[2] <- Ops.ivadd64u256(_C14, _C14); - _T.[1] <@ Ops.ilor4u64(_T.[1],_T.[2]); - _D14 <- Ops.iVPERMQ(_T.[1],(W8.of_int 57)); - _D00 <@ Ops.ilxor4u64(_T.[1],_T.[4]); - _D00 <- Ops.iVPERMQ(_D00,(W8.of_int 0)); - _C00 <@ Ops.ilxor4u64(_C00,_A00); - _C00 <@ Ops.ilxor4u64(_C00,_T.[0]); - _T.[0] <- Ops.ivshr64u256(_C00, (W8.of_int 63)); - _T.[1] <- Ops.ivadd64u256(_C00, _C00); - _T.[1] <@ Ops.ilor4u64(_T.[1],_T.[0]); - _A20 <@ Ops.ilxor4u64(_A20,_D00); - _A00 <@ Ops.ilxor4u64(_A00,_D00); - _D14 <- Ops.iVPBLEN_D_D_256(_D14,_T.[1], - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); - _T.[4] <- Ops.iVPBLEN_D_D_256(_T.[4],_C00, - (W8.of_int (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); - _D14 <@ Ops.ilxor4u64(_D14,_T.[4]); - aux <@ rhotates_left(0); _T.[3] <@ Ops.iVPSLLV_4u64(_A20,aux); - aux <@ rhotates_right(0); _A20 <@ Ops.iVPSRLV_4u64(_A20,aux); - _A20 <@ Ops.ilor4u64(_A20,_T.[3]); - _A31 <@ Ops.ilxor4u64(_A31,_D14); - aux <@ rhotates_left(2); _T.[4] <@ Ops.iVPSLLV_4u64(_A31,aux); - aux <@ rhotates_right(2); _A31 <@ Ops.iVPSRLV_4u64(_A31,aux); - _A31 <@ Ops.ilor4u64(_A31,_T.[4]); - _A21 <@ Ops.ilxor4u64(_A21,_D14); - aux <@ rhotates_left(3); _T.[5] <@ Ops.iVPSLLV_4u64(_A21,aux); - aux <@ rhotates_right(3); _A21 <@ Ops.iVPSRLV_4u64(_A21,aux); - _A21 <@ Ops.ilor4u64(_A21,_T.[5]); - _A41 <@ Ops.ilxor4u64(_A41,_D14); - aux <@ rhotates_left(4); _T.[6] <@ Ops.iVPSLLV_4u64(_A41,aux); - aux <@ rhotates_right(4); _A41 <@ Ops.iVPSRLV_4u64(_A41,aux); - _A41 <@ Ops.ilor4u64(_A41,_T.[6]); - _A11 <@ Ops.ilxor4u64(_A11,_D14); - _T.[3] <- Ops.iVPERMQ(_A20,(W8.of_int 141)); - _T.[4] <- Ops.iVPERMQ(_A31,(W8.of_int 141)); - aux <@ rhotates_left(5); _T.[7] <@ Ops.iVPSLLV_4u64(_A11,aux); - aux <@ rhotates_right(5); _T.[1] <@ Ops.iVPSRLV_4u64(_A11,aux); - _T.[1] <@ Ops.ilor4u64(_T.[1],_T.[7]); - _A01 <@ Ops.ilxor4u64(_A01,_D14); - _T.[5] <- Ops.iVPERMQ(_A21,(W8.of_int 27)); - _T.[6] <- Ops.iVPERMQ(_A41,(W8.of_int 114)); - aux <@ rhotates_left(1); _T.[8] <@ Ops.iVPSLLV_4u64(_A01 ,aux); - aux <@ rhotates_right(1); _T.[2] <@ Ops.iVPSRLV_4u64(_A01 ,aux); - _T.[2] <@ Ops.ilor4u64(_T.[2],_T.[8]); - _T.[7] <@ Ops.iVPSRLDQ_256(_T.[1],(W8.of_int 8)); - _T.[0] <@ Ops.ilandn4u64(_T.[1],_T.[7]); - _A31 <@ Ops.iVPBLEN_D_D_256(_T.[2],_T.[6], - (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); - _T.[8] <@ Ops.iVPBLEN_D_D_256(_T.[4],_T.[2], - (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); - _A41 <@ Ops.iVPBLEN_D_D_256(_T.[3], _T.[4], - (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); - _T.[7] <@ Ops.iVPBLEN_D_D_256(_T.[2], _T.[3], - (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); - _A31 <@ Ops.iVPBLEN_D_D_256(_A31 ,_T.[4], - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); - _T.[8] <@ Ops.iVPBLEN_D_D_256(_T.[8], _T.[5], - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); - _A41 <@ Ops.iVPBLEN_D_D_256(_A41, _T.[2], - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); - _T.[7] <@ Ops.iVPBLEN_D_D_256(_T.[7], _T.[6], - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); - _A31 <@ Ops.iVPBLEN_D_D_256(_A31, _T.[5], - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); - _T.[8] <@ Ops.iVPBLEN_D_D_256(_T.[8], _T.[6], - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); - _A41 <@ Ops.iVPBLEN_D_D_256(_A41, _T.[6], - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); - _T.[7] <@ Ops.iVPBLEN_D_D_256(_T.[7], _T.[4], - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); - _A31 <@ Ops.ilandn4u64(_A31,_T.[8]); - _A41 <@ Ops.ilandn4u64(_A41,_T.[7]); - _A11 <@ Ops.iVPBLEN_D_D_256(_T.[5],_T.[2], - (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); - _T.[8] <@ Ops.iVPBLEN_D_D_256(_T.[3], _T.[5], - (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); - _A31 <@ Ops.ilxor4u64(_A31,_T.[3]); - _A11 <@ Ops.iVPBLEN_D_D_256(_A11,_T.[3], - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); - _T.[8] <@ Ops.iVPBLEN_D_D_256(_T.[8],_T.[4], - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); - _A41 <@ Ops.ilxor4u64(_A41,_T.[5]); - _A11 <@ Ops.iVPBLEN_D_D_256(_A11, _T.[4], - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); - _T.[8] <@ Ops.iVPBLEN_D_D_256(_T.[8], _T.[2], - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); - _A11 <@ Ops.ilandn4u64(_A11,_T.[8]); - _A11 <@ Ops.ilxor4u64(_A11,_T.[6]); - _A21 <@ Ops.iVPERMQ(_T.[1],(W8.of_int 30)); - _T.[8] <@ Ops.iVPBLEN_D_D_256(_A21, _A00, - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); - _A01 <@ Ops.iVPERMQ(_T.[1],(W8.of_int 57)); - _A01 <@ Ops.iVPBLEN_D_D_256(_A01, _A00, - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); - _A01 <@ Ops.ilandn4u64(_A01,_T.[8]); - _A20 <@ Ops.iVPBLEN_D_D_256(_T.[4], _T.[5], - (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); - _T.[7] <@ Ops.iVPBLEN_D_D_256(_T.[6], _T.[4], - (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); - _A20 <@ Ops.iVPBLEN_D_D_256(_A20, _T.[6], - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); - _T.[7] <@ Ops.iVPBLEN_D_D_256(_T.[7], _T.[3], - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); - _A20 <@ Ops.iVPBLEN_D_D_256(_A20, _T.[3], - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); - _T.[7] <@ Ops.iVPBLEN_D_D_256(_T.[7], _T.[5], - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); - _A20 <@ Ops.ilandn4u64(_A20,_T.[7]); - _A20 <@ Ops.ilxor4u64(_A20,_T.[2]); - _T.[0] <@ Ops.iVPERMQ(_T.[0],(W8.of_int 0)); - _A31 <@ Ops.iVPERMQ(_A31,(W8.of_int 27)); - _A41 <@ Ops.iVPERMQ(_A41,(W8.of_int 141)); - _A11 <@ Ops.iVPERMQ(_A11,(W8.of_int 114)); - _A21 <@ Ops.iVPBLEN_D_D_256(_T.[6], _T.[3], - (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); - _T.[7] <@ Ops.iVPBLEN_D_D_256(_T.[5], _T.[6], - (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); - _A21 <@ Ops.iVPBLEN_D_D_256(_A21, _T.[5], - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); - _T.[7] <@ Ops.iVPBLEN_D_D_256(_T.[7], _T.[2], - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); - _A21 <@ Ops.iVPBLEN_D_D_256(_A21, _T.[2], - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); - _T.[7] <@ Ops.iVPBLEN_D_D_256(_T.[7], _T.[3], - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); - _A21 <@ Ops.ilandn4u64(_A21,_T.[7]); - _A00 <@ Ops.ilxor4u64(_A00,_T.[0]); - _A01 <@ Ops.ilxor4u64(_A01,_T.[1]); - _A21 <@ Ops.ilxor4u64(_A21,_T.[4]); - aux <@ iotas(iotas); _A00 <@ Ops.ilxor4u64(_A00,aux); - iotas <- (iotas + 1); - ( _0, _1, _2, zf, i) <- x86_DEC_32 i; - while ((! zf)) { - _C00 <@ Ops.iVPSHUF_D_256(_A20,(W8.of_int 78)); - _C14 <@ Ops.ilxor4u64(_A41,_A31); - _T.[2] <@ Ops.ilxor4u64(_A21,_A11); - _C14 <@ Ops.ilxor4u64(_C14,_A01); - _C14 <@ Ops.ilxor4u64(_C14,_T.[2]); - _T.[4] <@ Ops.iVPERMQ(_C14,(W8.of_int 147)); - _C00 <@ Ops.ilxor4u64(_C00,_A20); - _T.[0] <@ Ops.iVPERMQ(_C00,(W8.of_int 78)); - _T.[1] <@ Ops.ivshr64u256(_C14, (W8.of_int 63)); - _T.[2] <@ Ops.ivadd64u256(_C14, _C14); - _T.[1] <@ Ops.ilor4u64(_T.[1],_T.[2]); - _D14 <@ Ops.iVPERMQ(_T.[1],(W8.of_int 57)); - _D00 <@ Ops.ilxor4u64(_T.[1],_T.[4]); - _D00 <@ Ops.iVPERMQ(_D00,(W8.of_int 0)); - _C00 <@ Ops.ilxor4u64(_C00,_A00); - _C00 <@ Ops.ilxor4u64(_C00,_T.[0]); - _T.[0] <@ Ops.ivshr64u256(_C00, (W8.of_int 63)); - _T.[1] <@ Ops.ivadd64u256(_C00, _C00); - _T.[1] <@ Ops.ilor4u64(_T.[1],_T.[0]); - _A20 <@ Ops.ilxor4u64(_A20,_D00); - _A00 <@ Ops.ilxor4u64(_A00,_D00); - _D14 <@ Ops.iVPBLEN_D_D_256(_D14,_T.[1], - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); - _T.[4] <@ Ops.iVPBLEN_D_D_256(_T.[4],_C00, - (W8.of_int (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); - _D14 <@ Ops.ilxor4u64(_D14,_T.[4]); - aux <@ rhotates_left(0); _T.[3] <@ Ops.iVPSLLV_4u64(_A20,aux); - aux <@ rhotates_right(0); _A20 <@ Ops.iVPSRLV_4u64(_A20,aux); - _A20 <@ Ops.ilor4u64(_A20,_T.[3]); - _A31 <@ Ops.ilxor4u64(_A31,_D14); - aux <@ rhotates_left(2); _T.[4] <@ Ops.iVPSLLV_4u64(_A31,aux); - aux <@ rhotates_right(2); _A31 <@ Ops.iVPSRLV_4u64(_A31,aux); - _A31 <@ Ops.ilor4u64(_A31,_T.[4]); - _A21 <@ Ops.ilxor4u64(_A21,_D14); - aux <@ rhotates_left(3); _T.[5] <@ Ops.iVPSLLV_4u64(_A21,aux); - aux <@ rhotates_right(3); _A21 <@ Ops.iVPSRLV_4u64(_A21,aux); - _A21 <@ Ops.ilor4u64(_A21,_T.[5]); - _A41 <@ Ops.ilxor4u64(_A41,_D14); - aux <@ rhotates_left(4); _T.[6] <@ Ops.iVPSLLV_4u64(_A41,aux); - aux <@ rhotates_right(4); _A41 <@ Ops.iVPSRLV_4u64(_A41,aux); - _A41 <@ Ops.ilor4u64(_A41,_T.[6]); - _A11 <@ Ops.ilxor4u64(_A11,_D14); - _T.[3] <@ Ops.iVPERMQ(_A20,(W8.of_int 141)); - _T.[4] <@ Ops.iVPERMQ(_A31,(W8.of_int 141)); - aux <@ rhotates_left(5); _T.[7] <@ Ops.iVPSLLV_4u64(_A11,aux); - aux <@ rhotates_right(5); _T.[1] <@ Ops.iVPSRLV_4u64(_A11,aux); - _T.[1] <@ Ops.ilor4u64(_T.[1],_T.[7]); - _A01 <@ Ops.ilxor4u64(_A01,_D14); - _T.[5] <@ Ops.iVPERMQ(_A21,(W8.of_int 27)); - _T.[6] <@ Ops.iVPERMQ(_A41,(W8.of_int 114)); - aux <@ rhotates_left(1); _T.[8] <@ Ops.iVPSLLV_4u64(_A01 ,aux); - aux <@ rhotates_right(1); _T.[2] <@ Ops.iVPSRLV_4u64(_A01 ,aux); - _T.[2] <@ Ops.ilor4u64(_T.[2],_T.[8]); - _T.[7] <@ Ops.iVPSRLDQ_256(_T.[1],(W8.of_int 8)); - _T.[0] <@ Ops.ilandn4u64(_T.[1],_T.[7]); - _A31 <@ Ops.iVPBLEN_D_D_256(_T.[2], _T.[6], - (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); - _T.[8] <@ Ops.iVPBLEN_D_D_256(_T.[4], _T.[2], - (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); - _A41 <@ Ops.iVPBLEN_D_D_256(_T.[3], _T.[4], - (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); - _T.[7] <@ Ops.iVPBLEN_D_D_256(_T.[2], _T.[3], - (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); - _A31 <@ Ops.iVPBLEN_D_D_256(_A31, _T.[4], - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); - _T.[8] <@ Ops.iVPBLEN_D_D_256(_T.[8], _T.[5], - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); - _A41 <@ Ops.iVPBLEN_D_D_256(_A41, _T.[2], - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); - _T.[7] <@ Ops.iVPBLEN_D_D_256(_T.[7], _T.[6], - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); - _A31 <@ Ops.iVPBLEN_D_D_256(_A31, _T.[5], - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); - _T.[8] <@ Ops.iVPBLEN_D_D_256(_T.[8], _T.[6], - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); - _A41 <@ Ops.iVPBLEN_D_D_256(_A41, _T.[6], - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); - _T.[7] <@ Ops.iVPBLEN_D_D_256(_T.[7], _T.[4], - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); - _A31 <@ Ops.ilandn4u64(_A31,_T.[8]); - _A41 <@ Ops.ilandn4u64(_A41,_T.[7]); - _A11 <@ Ops.iVPBLEN_D_D_256(_T.[5], _T.[2], - (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); - _T.[8] <@ Ops.iVPBLEN_D_D_256(_T.[3], _T.[5], - (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); - _A31 <@ Ops.ilxor4u64(_A31,_T.[3]); - _A11 <@ Ops.iVPBLEN_D_D_256(_A11, _T.[3], - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); - _T.[8] <@ Ops.iVPBLEN_D_D_256(_T.[8], _T.[4], - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); - _A41 <@ Ops.ilxor4u64(_A41,_T.[5]); - _A11 <@ Ops.iVPBLEN_D_D_256(_A11, _T.[4], - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); - _T.[8] <@ Ops.iVPBLEN_D_D_256(_T.[8], _T.[2], - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); - _A11 <@ Ops.ilandn4u64(_A11,_T.[8]); - _A11 <@ Ops.ilxor4u64(_A11,_T.[6]); - _A21 <@ Ops.iVPERMQ(_T.[1],(W8.of_int 30)); - _T.[8] <@ Ops.iVPBLEN_D_D_256(_A21, _A00, - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); - _A01 <@ Ops.iVPERMQ(_T.[1],(W8.of_int 57)); - _A01 <@ Ops.iVPBLEN_D_D_256(_A01 ,_A00, - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); - _A01 <@ Ops.ilandn4u64(_A01,_T.[8]); - _A20 <@ Ops.iVPBLEN_D_D_256(_T.[4], _T.[5], - (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); - _T.[7] <@ Ops.iVPBLEN_D_D_256(_T.[6], _T.[4], - (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); - _A20 <@ Ops.iVPBLEN_D_D_256(_A20, _T.[6], - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); - _T.[7] <@ Ops.iVPBLEN_D_D_256(_T.[7], _T.[3], - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); - _A20 <@ Ops.iVPBLEN_D_D_256(_A20, _T.[3], - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); - _T.[7] <@ Ops.iVPBLEN_D_D_256(_T.[7], _T.[5], - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); - _A20 <@ Ops.ilandn4u64(_A20,_T.[7]); - _A20 <@ Ops.ilxor4u64(_A20,_T.[2]); - _T.[0] <@ Ops.iVPERMQ(_T.[0],(W8.of_int 0)); - _A31 <@ Ops.iVPERMQ(_A31,(W8.of_int 27)); - _A41 <@ Ops.iVPERMQ(_A41,(W8.of_int 141)); - _A11 <@ Ops.iVPERMQ(_A11,(W8.of_int 114)); - _A21 <@ Ops.iVPBLEN_D_D_256(_T.[6], _T.[3], - (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); - _T.[7] <@ Ops.iVPBLEN_D_D_256(_T.[5], _T.[6], - (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); - _A21 <@ Ops.iVPBLEN_D_D_256(_A21, _T.[5], - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); - _T.[7] <@ Ops.iVPBLEN_D_D_256(_T.[7] ,_T.[2], - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); - _A21 <@ Ops.iVPBLEN_D_D_256(_A21, _T.[2], - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); - _T.[7] <@ Ops.iVPBLEN_D_D_256(_T.[7], _T.[3], - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); - _A21 <@ Ops.ilandn4u64(_A21,_T.[7]); - _A00 <@ Ops.ilxor4u64(_A00,_T.[0]); - _A01 <@ Ops.ilxor4u64(_A01,_T.[1]); - _A21 <@ Ops.ilxor4u64(_A21,_T.[4]); - aux2 <@ iotas(iotas); _A00 <@ Ops.ilxor4u64(_A00,aux2); - iotas <- (iotas + 1); - ( _0, _1, _2, zf, i) <- x86_DEC_32 i; - } - return (_A00, _A01, _A20, _A31, _A21, _A41, _A11); - } -}. - -require import Keccak_f1600_ref. -import Array25. - -(* - ($A00, # [0][0] [0][0] [0][0] [0][0] - $A01, # [0][4] [0][3] [0][2] [0][1] - $A20, # [3][0] [1][0] [4][0] [2][0] - $A31, # [2][4] [4][3] [1][2] [3][1] - $A21, # [3][4] [1][3] [4][2] [2][1] - $A41, # [1][4] [2][3] [3][2] [4][1] - $A11) = # [4][4] [3][3] [2][2] [1][1] -*) - -op index x y = 5*x+y. - -op equiv_states (A00 A01 A20 A31 A21 A41 A11 : W64.t Array4.t, st : W64.t Array25.t) : bool = - A00.[3] = st.[index 0 0] /\ A00.[2] = st.[index 0 0] /\ A00.[1] = st.[index 0 0] /\ A00.[0] = st.[index 0 0] /\ - A01.[3] = st.[index 0 4] /\ A01.[2] = st.[index 0 3] /\ A01.[1] = st.[index 0 2] /\ A01.[0] = st.[index 0 1] /\ - A20.[3] = st.[index 3 0] /\ A20.[2] = st.[index 1 0] /\ A20.[1] = st.[index 4 0] /\ A20.[0] = st.[index 2 0] /\ - A31.[3] = st.[index 2 4] /\ A31.[2] = st.[index 4 3] /\ A31.[1] = st.[index 1 2] /\ A31.[0] = st.[index 3 1] /\ - A21.[3] = st.[index 3 4] /\ A21.[2] = st.[index 1 3] /\ A21.[1] = st.[index 4 2] /\ A21.[0] = st.[index 2 1] /\ - A41.[3] = st.[index 1 4] /\ A41.[2] = st.[index 2 3] /\ A41.[1] = st.[index 3 2] /\ A41.[0] = st.[index 4 1] /\ - A11.[3] = st.[index 4 4] /\ A11.[2] = st.[index 3 3] /\ A11.[1] = st.[index 2 2] /\ A11.[0] = st.[index 1 1]. - -op equiv_states_chi (A00 A01 A20 A31 A21 A41 A11 : W64.t Array4.t, st : W64.t Array25.t) : bool = - A00.[3] = st.[index 0 0] /\ A00.[2] = st.[index 0 0] /\ A00.[1] = st.[index 0 0] /\ A00.[0] = st.[index 0 0] /\ - A01.[3] = st.[index 0 4] /\ A01.[2] = st.[index 0 3] /\ A01.[1] = st.[index 0 2] /\ A01.[0] = st.[index 0 1] /\ - A20.[3] = st.[index 3 0] /\ A20.[2] = st.[index 1 0] /\ A20.[1] = st.[index 4 0] /\ A20.[0] = st.[index 2 0] /\ - A31.[3] = st.[index 3 1] /\ A31.[2] = st.[index 1 2] /\ A31.[1] = st.[index 4 3] /\ A31.[0] = st.[index 2 4] /\ - A21.[3] = st.[index 3 4] /\ A21.[2] = st.[index 1 3] /\ A21.[1] = st.[index 4 2] /\ A21.[0] = st.[index 2 1] /\ - A41.[3] = st.[index 3 2] /\ A41.[2] = st.[index 1 4] /\ A41.[1] = st.[index 4 1] /\ A41.[0] = st.[index 2 3] /\ - A11.[3] = st.[index 3 3] /\ A11.[2] = st.[index 1 1] /\ A11.[1] = st.[index 4 4] /\ A11.[0] = st.[index 2 2]. - -lemma dec : forall (x : W32.t), - 0 < to_uint x <= 24 => - to_uint (x86_DEC_32 x).`5 = to_uint x - 1 by admit. - -lemma decK : forall (x : W32.t), - (x86_DEC_32 x).`5 + W32.one = x by admit. - -lemma dec0 : forall (x : W32.t), - 0 < to_uint x <= 24 => - (x86_DEC_32 x).`4 <=> to_uint (x86_DEC_32 x).`5 = 0 by - admit. - -lemma rolcomp : (forall (x : W64.t), (x86_ROL_64 x W8.one).`3 = - (x `>>` W8.of_int 63) `|` (x + x)) by admit. - -lemma commor : forall (x y : W64.t), x `|` y = y `|` x by admit. - -lemma rol0 : forall x, (x86_ROL_64 x W8.zero).`3 = x by admit. - -lemma roln : forall x n, (x86_ROL_64 x (W8.of_int n)).`3 = - (x `>>` W8.of_int (64 - n)) `|` (x `<<` W8.of_int n) by admit. - -lemma correct_perm A00 A01 A20 A31 A21 A41 A11 st : - equiv [ M.permute ~ Mavx2_prevec.__KeccakF1600 : - equiv_states A00 A01 A20 A31 A21 A41 A11 st /\ - _A00{2} = A00 /\ _A01{2} = A01 /\ _A20{2} = A20 /\ _A31{2} = A31 /\ - _A21{2} = A21 /\ _A41{2} = A41 /\ _A11{2} = A11 /\ state{1} = st ==> - equiv_states res{2}.`1 res{2}.`2 res{2}.`3 res{2}.`4 res{2}.`5 res{2}.`6 res{2}.`7 res{1}]. -proc. -unroll {1} 2. -rcondt {1} 2. move => *. by auto => />. -seq 0 1 : #pre; first by auto => />. -sp 1 2. - -seq 2 118 : (#{~ _A00{2}}{~ _A01{2}}{~ _A20{2}}{~ _A31{2}}{~ _A21{2}}{~ _A41{2}}{~ _A11{2}}{~state{1}}pre /\ - equiv_states _A00{2} _A01{2} _A20{2} _A31{2} _A21{2} _A41{2} _A11{2} state{1}). - -seq 1 0 : (#pre /\ c{1} = W64.of_int 1). -inline *. -by auto => />. - -inline M.keccakP1600_round. - -sp 2 0. -inline M.theta. -sp 1 0. - - -swap {2} [20..21] 3. -swap {2} 30 -5. -swap {2} 36 -13. -swap {2} 42 -17. -swap {2} 48 -21. -swap {2} 56 -31. - -seq 9 29 : (#{/~state{1}}post /\ c0{1} = W64.of_int 1 /\ - equiv_states _A00{2} _A01{2} _A20{2} _A31{2} _A21{2} _A41{2} _A11{2} state0{1}). - -unroll for {1} 4. -unroll for {1} 6. -unroll for {1} 23. -unroll for {1} 19. -unroll for {1} 45. -unroll for {1} 58. -unroll for {1} 70. -unroll for {1} 101. -unroll for {1} 102. -unroll for {1} 114. -unroll for {1} 126. -unroll for {1} 138. -unroll for {1} 150. -inline *. -rcondt {2} 4; first by move => *; auto => />. -rcondf {2} 40; first by move => *; auto => />. -rcondt {2} 40; first by move => *; auto => />. -rcondf {2} 55; first by move => *; auto => />. -rcondf {2} 55; first by move => *; auto => />. -rcondt {2} 55; first by move => *; auto => />. -rcondf {2} 84; first by move => *; auto => />. -rcondf {2} 84; first by move => *; auto => />. -rcondf {2} 84; first by move => *; auto => />. -rcondt {2} 84; first by move => *; auto => />. -rcondf {2} 99; first by move => *; auto => />. -rcondf {2} 99; first by move => *; auto => />. -rcondf {2} 99; first by move => *; auto => />. -rcondf {2} 99; first by move => *; auto => />. -rcondf {2} 99; first by move => *; auto => />. -rcondf {2} 99; first by move => *; auto => />. -rcondf {2} 99; first by move => *; auto => />. -rcondt {2} 99; first by move => *; auto => />. -rcondt {2} 143; first by move => *; auto => />. -rcondf {2} 152; first by move => *; auto => />. -rcondt {2} 152; first by move => *; auto => />. - -wp;skip. -move => &1 &2. -rewrite /equiv_states /index. -simplify. - -by smt(W64.xorwA W64.xorwC W64.xorw0 W64.xorwK rolcomp commor). - -(* Rho PI *) -inline M.rho M.pi. - -seq 11 34 : (#{/~ state{1}}post /\ c0{1} = W64.of_int 1 /\ - equiv_states_chi _A00{2} _T{2}.[1] _T{2}.[2] _T{2}.[3] _T{2}.[4] _T{2}.[5] _T{2}.[6] state0{1}). - -unroll for {1} 3. -unroll for {1} 4. -unroll for {1} 41. -unroll for {1} 78. -unroll for {1} 115. -unroll for {1} 152. -unroll for {1} 192. -unroll for {1} 268. -unroll for {1} 269. -unroll for {1} 291. -unroll for {1} 313. -unroll for {1} 335. -unroll for {1} 357. - -inline *. - -rcondf {2} 328; first by auto => />. -rcondf {2} 328; first by auto => />. -rcondf {2} 328; first by auto => />. -rcondf {2} 328; first by auto => />. -rcondt {2} 328; first by auto => />. -rcondf {2} 336; first by auto => />. -rcondf {2} 336; first by auto => />. -rcondf {2} 336; first by auto => />. -rcondf {2} 336; first by auto => />. -rcondt {2} 336; first by auto => />. -rcondf {2} 425; first by auto => />. -rcondf {2} 425; first by auto => />. -rcondf {2} 425; first by auto => />. -rcondf {2} 425; first by auto => />. -rcondf {2} 425; first by auto => />. -rcondt {2} 425; first by auto => />. -rcondf {2} 433; first by auto => />. -rcondf {2} 433; first by auto => />. -rcondf {2} 433; first by auto => />. -rcondf {2} 433; first by auto => />. -rcondf {2} 433; first by auto => />. -rcondf {2} 433; first by auto => />. -rcondt {2} 433; first by auto => />. - -wp;skip. -move => &1 &2. -rewrite /equiv_states /equiv_states_chi /index. -simplify. - -by smt(roln rol0). - -(* Chi *) -inline M.chi. - -seq 5 53 : (#{~state0{1}}pre /\ - equiv_states _A00{2} _A01{2} _A20{2} _A31{2} _A21{2} _A41{2} _A11{2} state0{1}). - -unroll for {1} 4. -unroll for {1} 5. -unroll for {1} 46. -unroll for {1} 58. -unroll for {1} 99. -unroll for {1} 111. -unroll for {1} 152. -unroll for {1} 164. -unroll for {1} 205. -unroll for {1} 217. -unroll for {1} 258. - -inline *. -rcondf {2} 4; first by auto => />. -rcondt {2} 4; first by auto => />. -rcondf {2} 20; first by auto => />. -rcondf {2} 20; first by auto => />. -rcondt {2} 20; first by auto => />. -rcondf {2} 29; first by auto => />. -rcondf {2} 29; first by auto => />. -rcondt {2} 29; first by auto => />. -rcondf {2} 38; first by auto => />. -rcondf {2} 38; first by auto => />. -rcondt {2} 38; first by auto => />. -rcondf {2} 47; first by auto => />. -rcondf {2} 47; first by auto => />. -rcondt {2} 47; first by auto => />. -rcondf {2} 56; first by auto => />. -rcondf {2} 56; first by auto => />. -rcondf {2} 56; first by auto => />. -rcondt {2} 56; first by auto => />. -rcondf {2} 65; first by auto => />. -rcondf {2} 65; first by auto => />. -rcondf {2} 65; first by auto => />. -rcondt {2} 65; first by auto => />. -rcondf {2} 74; first by auto => />. -rcondf {2} 74; first by auto => />. -rcondf {2} 74; first by auto => />. -rcondt {2} 74; first by auto => />. -rcondf {2} 83; first by auto => />. -rcondf {2} 83; first by auto => />. -rcondf {2} 83; first by auto => />. -rcondt {2} 83; first by auto => />. -rcondt {2} 92; first by auto => />. -rcondt {2} 101; first by auto => />. -rcondt {2} 110; first by auto => />. -rcondt {2} 119; first by auto => />. -rcondf {2} 142; first by auto => />. -rcondf {2} 142; first by auto => />. -rcondt {2} 142; first by auto => />. -rcondf {2} 151; first by auto => />. -rcondf {2} 151; first by auto => />. -rcondt {2} 151; first by auto => />. -rcondf {2} 167; first by auto => />. -rcondf {2} 167; first by auto => />. -rcondf {2} 167; first by auto => />. -rcondt {2} 167; first by auto => />. -rcondf {2} 176; first by auto => />. -rcondf {2} 176; first by auto => />. -rcondf {2} 176; first by auto => />. -rcondt {2} 176; first by auto => />. -rcondt {2} 192; first by auto => />. -rcondt {2} 201; first by auto => />. -rcondf {2} 223; first by auto => />. -rcondf {2} 223; first by auto => />. -rcondf {2} 223; first by auto => />. -rcondf {2} 223; first by auto => />. -rcondf {2} 223; first by auto => />. -rcondf {2} 223; first by auto => />. -rcondf {2} 223; first by auto => />. -rcondf {2} 223; first by auto => />. -rcondt {2} 223; first by auto => />. -rcondf {2} 232; first by auto => />. -rcondf {2} 232; first by auto => />. -rcondf {2} 232; first by auto => />. -rcondt {2} 232; first by auto => />. -rcondf {2} 240; first by auto => />. -rcondf {2} 240; first by auto => />. -rcondf {2} 240; first by auto => />. -rcondt {2} 240; first by auto => />. -rcondt {2} 249; first by auto => />. -rcondf {2} 265; first by auto => />. -rcondf {2} 265; first by auto => />. -rcondt {2} 265; first by auto => />. -rcondf {2} 274; first by auto => />. -rcondf {2} 274; first by auto => />. -rcondt {2} 274; first by auto => />. -rcondf {2} 283; first by auto => />. -rcondf {2} 283; first by auto => />. -rcondf {2} 283; first by auto => />. -rcondt {2} 283; first by auto => />. -rcondf {2} 292; first by auto => />. -rcondf {2} 292; first by auto => />. -rcondf {2} 292; first by auto => />. -rcondt {2} 292; first by auto => />. -rcondt {2} 301; first by auto => />. -rcondt {2} 310; first by auto => />. -rcondf {2} 332; first by auto => />. -rcondf {2} 332; first by auto => />. -rcondf {2} 332; first by auto => />. -rcondf {2} 332; first by auto => />. -rcondf {2} 332; first by auto => />. -rcondf {2} 332; first by auto => />. -rcondf {2} 332; first by auto => />. -rcondt {2} 332; first by auto => />. -rcondf {2} 340; first by auto => />. -rcondf {2} 340; first by auto => />. -rcondf {2} 340; first by auto => />. -rcondf {2} 340; first by auto => />. -rcondf {2} 340; first by auto => />. -rcondt {2} 340; first by auto => />. -rcondf {2} 348; first by auto => />. -rcondf {2} 348; first by auto => />. -rcondf {2} 348; first by auto => />. -rcondf {2} 348; first by auto => />. -rcondt {2} 348; first by auto => />. -rcondf {2} 356; first by auto => />. -rcondf {2} 356; first by auto => />. -rcondf {2} 356; first by auto => />. -rcondf {2} 356; first by auto => />. -rcondf {2} 356; first by auto => />. -rcondf {2} 356; first by auto => />. -rcondt {2} 356; first by auto => />. -rcondf {2} 365; first by auto => />. -rcondf {2} 365; first by auto => />. -rcondt {2} 365; first by auto => />. -rcondf {2} 374; first by auto => />. -rcondf {2} 374; first by auto => />. -rcondt {2} 374; first by auto => />. -rcondf {2} 383; first by auto => />. -rcondf {2} 383; first by auto => />. -rcondf {2} 383; first by auto => />. -rcondt {2} 383; first by auto => />. -rcondf {2} 392; first by auto => />. -rcondf {2} 392; first by auto => />. -rcondf {2} 392; first by auto => />. -rcondt {2} 392; first by auto => />. -rcondt {2} 401; first by auto => />. -rcondt {2} 410; first by auto => />. - -wp. skip. -move => &1 &2. -rewrite /equiv_states /equiv_states_chi /index. -simplify. - -smt(@W64). - -inline *. - -wp;skip. -move => &1 &2. -rewrite /equiv_states /index. -simplify. -by progress => /#. - -seq 1 2 : (#{/~iotas{2}}{~round{1}}{~i{2}}{~st}pre /\ - iotas{2} = round{1} /\ - to_uint i{2} = 24 - round{1} /\ - ((to_uint i{2} = 0) <> round{1} < 24) /\ - (x86_DEC_32 (i{2} + W32.of_int 1)).`4 = zf{2} /\ - 0 < round{1} /\ - to_uint i{2} <= 24). - - auto => />. progress. - - -apply dec. smt(). -rewrite (dec). smt(@W32). smt(@W32). -rewrite (decK). smt(@W32). -smt(@W32 dec decK). - - -while (#pre). - -swap {2} 117 -116. - -seq 1 1 : (#pre /\ - aux2{2}.[0] = c{1} /\ - aux2{2}.[1] = c{1} /\ - aux2{2}.[2] = c{1} /\ - aux2{2}.[3] = c{1}). -inline *. -wp. skip. -move => &1 &2. -simplify. -progress. -case (round{1} = 0). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 1). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 2). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 3). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 4). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 5). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 6). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 7). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 8). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 9). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 10). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 11). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 12). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 13). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 14). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 15). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 16). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 17). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 18). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 19). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 20). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 21). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 22). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 23). move => r1. rewrite r1. simplify. by auto => />. -smt(). - -case (round{1} = 0). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 1). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 2). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 3). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 4). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 5). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 6). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 7). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 8). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 9). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 10). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 11). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 12). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 13). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 14). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 15). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 16). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 17). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 18). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 19). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 20). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 21). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 22). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 23). move => r1. rewrite r1. simplify. by auto => />. -smt(). - -case (round{1} = 0). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 1). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 2). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 3). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 4). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 5). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 6). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 7). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 8). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 9). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 10). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 11). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 12). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 13). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 14). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 15). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 16). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 17). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 18). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 19). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 20). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 21). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 22). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 23). move => r1. rewrite r1. simplify. by auto => />. -smt(). - -case (round{1} = 0). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 1). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 2). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 3). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 4). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 5). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 6). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 7). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 8). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 9). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 10). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 11). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 12). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 13). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 14). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 15). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 16). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 17). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 18). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 19). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 20). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 21). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 22). move => r1. rewrite r1. simplify. by auto => />. -case (round{1} = 23). move => r1. rewrite r1. simplify. by auto => />. -smt(). - -inline M.keccakP1600_round. - -sp 2 0. -inline M.theta. -sp 1 0. - -swap {2} [20..21] 3. -swap {2} 30 -5. -swap {2} 36 -13. -swap {2} 42 -17. -swap {2} 48 -21. -swap {2} 56 -31. - -seq 9 29 : (#{/~state{1}}{~a{1}}pre /\ - aux2{2}.[0] = c0{1} /\ - aux2{2}.[1] = c0{1} /\ - aux2{2}.[2] = c0{1} /\ - aux2{2}.[3] = c0{1} /\ - equiv_states _A00{2} _A01{2} _A20{2} _A31{2} _A21{2} _A41{2} _A11{2} state0{1}). - -unroll for {1} 4. -unroll for {1} 6. -unroll for {1} 23. -unroll for {1} 19. -unroll for {1} 45. -unroll for {1} 58. -unroll for {1} 70. -unroll for {1} 101. -unroll for {1} 102. -unroll for {1} 114. -unroll for {1} 126. -unroll for {1} 138. -unroll for {1} 150. -inline *. -rcondt {2} 4; first by move => *; auto => />. -rcondf {2} 40; first by move => *; auto => />. -rcondt {2} 40; first by move => *; auto => />. -rcondf {2} 55; first by move => *; auto => />. -rcondf {2} 55; first by move => *; auto => />. -rcondt {2} 55; first by move => *; auto => />. -rcondf {2} 84; first by move => *; auto => />. -rcondf {2} 84; first by move => *; auto => />. -rcondf {2} 84; first by move => *; auto => />. -rcondt {2} 84; first by move => *; auto => />. -rcondf {2} 99; first by move => *; auto => />. -rcondf {2} 99; first by move => *; auto => />. -rcondf {2} 99; first by move => *; auto => />. -rcondf {2} 99; first by move => *; auto => />. -rcondf {2} 99; first by move => *; auto => />. -rcondf {2} 99; first by move => *; auto => />. -rcondf {2} 99; first by move => *; auto => />. -rcondt {2} 99; first by move => *; auto => />. -rcondt {2} 143; first by move => *; auto => />. -rcondf {2} 152; first by move => *; auto => />. -rcondt {2} 152; first by move => *; auto => />. - -wp;skip. -move => &1 &2. -rewrite /equiv_states /index. -simplify. - -by smt(W64.xorwA W64.xorwC W64.xorw0 W64.xorwK rolcomp commor). - -(* Rho PI *) -inline M.rho M.pi. - -seq 11 34 : (#{/~ state0{1}}pre /\ - equiv_states_chi _A00{2} _T{2}.[1] _T{2}.[2] _T{2}.[3] _T{2}.[4] _T{2}.[5] _T{2}.[6] state0{1}). - -unroll for {1} 3. -unroll for {1} 4. -unroll for {1} 41. -unroll for {1} 78. -unroll for {1} 115. -unroll for {1} 152. -unroll for {1} 192. -unroll for {1} 268. -unroll for {1} 269. -unroll for {1} 291. -unroll for {1} 313. -unroll for {1} 335. -unroll for {1} 357. - -inline *. - -rcondf {2} 328; first by auto => />. -rcondf {2} 328; first by auto => />. -rcondf {2} 328; first by auto => />. -rcondf {2} 328; first by auto => />. -rcondt {2} 328; first by auto => />. -rcondf {2} 336; first by auto => />. -rcondf {2} 336; first by auto => />. -rcondf {2} 336; first by auto => />. -rcondf {2} 336; first by auto => />. -rcondt {2} 336; first by auto => />. -rcondf {2} 425; first by auto => />. -rcondf {2} 425; first by auto => />. -rcondf {2} 425; first by auto => />. -rcondf {2} 425; first by auto => />. -rcondf {2} 425; first by auto => />. -rcondt {2} 425; first by auto => />. -rcondf {2} 433; first by auto => />. -rcondf {2} 433; first by auto => />. -rcondf {2} 433; first by auto => />. -rcondf {2} 433; first by auto => />. -rcondf {2} 433; first by auto => />. -rcondf {2} 433; first by auto => />. -rcondt {2} 433; first by auto => />. - -wp;skip. -move => &1 &2. -rewrite /equiv_states /equiv_states_chi /index. -simplify. - -by smt(roln rol0). - -(* Chi *) -inline M.chi. - -seq 5 53 : (#{~state0{1}}pre /\ - equiv_states _A00{2} _A01{2} _A20{2} _A31{2} _A21{2} _A41{2} _A11{2} state0{1}). - -unroll for {1} 4. -unroll for {1} 5. -unroll for {1} 46. -unroll for {1} 58. -unroll for {1} 99. -unroll for {1} 111. -unroll for {1} 152. -unroll for {1} 164. -unroll for {1} 205. -unroll for {1} 217. -unroll for {1} 258. - -inline *. -rcondf {2} 4; first by auto => />. -rcondt {2} 4; first by auto => />. -rcondf {2} 20; first by auto => />. -rcondf {2} 20; first by auto => />. -rcondt {2} 20; first by auto => />. -rcondf {2} 29; first by auto => />. -rcondf {2} 29; first by auto => />. -rcondt {2} 29; first by auto => />. -rcondf {2} 38; first by auto => />. -rcondf {2} 38; first by auto => />. -rcondt {2} 38; first by auto => />. -rcondf {2} 47; first by auto => />. -rcondf {2} 47; first by auto => />. -rcondt {2} 47; first by auto => />. -rcondf {2} 56; first by auto => />. -rcondf {2} 56; first by auto => />. -rcondf {2} 56; first by auto => />. -rcondt {2} 56; first by auto => />. -rcondf {2} 65; first by auto => />. -rcondf {2} 65; first by auto => />. -rcondf {2} 65; first by auto => />. -rcondt {2} 65; first by auto => />. -rcondf {2} 74; first by auto => />. -rcondf {2} 74; first by auto => />. -rcondf {2} 74; first by auto => />. -rcondt {2} 74; first by auto => />. -rcondf {2} 83; first by auto => />. -rcondf {2} 83; first by auto => />. -rcondf {2} 83; first by auto => />. -rcondt {2} 83; first by auto => />. -rcondt {2} 92; first by auto => />. -rcondt {2} 101; first by auto => />. -rcondt {2} 110; first by auto => />. -rcondt {2} 119; first by auto => />. -rcondf {2} 142; first by auto => />. -rcondf {2} 142; first by auto => />. -rcondt {2} 142; first by auto => />. -rcondf {2} 151; first by auto => />. -rcondf {2} 151; first by auto => />. -rcondt {2} 151; first by auto => />. -rcondf {2} 167; first by auto => />. -rcondf {2} 167; first by auto => />. -rcondf {2} 167; first by auto => />. -rcondt {2} 167; first by auto => />. -rcondf {2} 176; first by auto => />. -rcondf {2} 176; first by auto => />. -rcondf {2} 176; first by auto => />. -rcondt {2} 176; first by auto => />. -rcondt {2} 192; first by auto => />. -rcondt {2} 201; first by auto => />. -rcondf {2} 223; first by auto => />. -rcondf {2} 223; first by auto => />. -rcondf {2} 223; first by auto => />. -rcondf {2} 223; first by auto => />. -rcondf {2} 223; first by auto => />. -rcondf {2} 223; first by auto => />. -rcondf {2} 223; first by auto => />. -rcondf {2} 223; first by auto => />. -rcondt {2} 223; first by auto => />. -rcondf {2} 232; first by auto => />. -rcondf {2} 232; first by auto => />. -rcondf {2} 232; first by auto => />. -rcondt {2} 232; first by auto => />. -rcondf {2} 240; first by auto => />. -rcondf {2} 240; first by auto => />. -rcondf {2} 240; first by auto => />. -rcondt {2} 240; first by auto => />. -rcondt {2} 249; first by auto => />. -rcondf {2} 265; first by auto => />. -rcondf {2} 265; first by auto => />. -rcondt {2} 265; first by auto => />. -rcondf {2} 274; first by auto => />. -rcondf {2} 274; first by auto => />. -rcondt {2} 274; first by auto => />. -rcondf {2} 283; first by auto => />. -rcondf {2} 283; first by auto => />. -rcondf {2} 283; first by auto => />. -rcondt {2} 283; first by auto => />. -rcondf {2} 292; first by auto => />. -rcondf {2} 292; first by auto => />. -rcondf {2} 292; first by auto => />. -rcondt {2} 292; first by auto => />. -rcondt {2} 301; first by auto => />. -rcondt {2} 310; first by auto => />. -rcondf {2} 332; first by auto => />. -rcondf {2} 332; first by auto => />. -rcondf {2} 332; first by auto => />. -rcondf {2} 332; first by auto => />. -rcondf {2} 332; first by auto => />. -rcondf {2} 332; first by auto => />. -rcondf {2} 332; first by auto => />. -rcondt {2} 332; first by auto => />. -rcondf {2} 340; first by auto => />. -rcondf {2} 340; first by auto => />. -rcondf {2} 340; first by auto => />. -rcondf {2} 340; first by auto => />. -rcondf {2} 340; first by auto => />. -rcondt {2} 340; first by auto => />. -rcondf {2} 348; first by auto => />. -rcondf {2} 348; first by auto => />. -rcondf {2} 348; first by auto => />. -rcondf {2} 348; first by auto => />. -rcondt {2} 348; first by auto => />. -rcondf {2} 356; first by auto => />. -rcondf {2} 356; first by auto => />. -rcondf {2} 356; first by auto => />. -rcondf {2} 356; first by auto => />. -rcondf {2} 356; first by auto => />. -rcondf {2} 356; first by auto => />. -rcondt {2} 356; first by auto => />. -rcondf {2} 365; first by auto => />. -rcondf {2} 365; first by auto => />. -rcondt {2} 365; first by auto => />. -rcondf {2} 374; first by auto => />. -rcondf {2} 374; first by auto => />. -rcondt {2} 374; first by auto => />. -rcondf {2} 383; first by auto => />. -rcondf {2} 383; first by auto => />. -rcondf {2} 383; first by auto => />. -rcondt {2} 383; first by auto => />. -rcondf {2} 392; first by auto => />. -rcondf {2} 392; first by auto => />. -rcondf {2} 392; first by auto => />. -rcondt {2} 392; first by auto => />. -rcondt {2} 401; first by auto => />. -rcondt {2} 410; first by auto => />. - -wp. skip. -move => &1 &2. -rewrite /equiv_states /equiv_states_chi /index. -simplify. - -smt(@W64). - -(* iota *) - -seq 2 1 : (#{/~ state0{1}}{~aux2{2}}{~c{1}}pre /\ - equiv_states _A00{2} _A01{2} _A20{2} _A31{2} _A21{2} _A41{2} _A11{2} - state{1}); first by inline *; wp; skip; rewrite /equiv_states /index; progress; smt(@W64). - -wp;skip;progress;smt(dec dec0 decK @W32). - -skip;progress. - -rewrite dec0. -split. rewrite to_uintD. smt(@W32). smt(@W32). -rewrite dec. rewrite to_uintD. smt(@W32). smt(@W32). -move : H4. rewrite dec0. -rewrite to_uintD. smt(@W32). -rewrite dec. rewrite to_uintD. smt(@W32). -rewrite to_uintD. smt(@W32). -qed. diff --git a/proof/impl/perm/keccak_f1600_ref.ec b/proof/impl/perm/keccak_f1600_ref.ec index e7d4541..fc81185 100644 --- a/proof/impl/perm/keccak_f1600_ref.ec +++ b/proof/impl/perm/keccak_f1600_ref.ec @@ -6,42 +6,40 @@ require import WArray40 WArray192 WArray200. *) require import Ops. -clone import PolyArray as Array25 with op size <- 25. +clone import PolyArray as Array25 with op size <- 25. clone import PolyArray as Array24 with op size <- 24. - op x86_ROL_64 : W64.t -> W8.t -> bool * bool * W64.t. -module M = { - proc constants(r : int) : W64.t = { - var table : W64.t Array24.t; - table.[ 0] = W64.of_int 1; - table.[ 1] = W64.of_int 32898; - table.[ 2] = W64.of_int 9223372036854808714; - table.[ 3] = W64.of_int 9223372039002292224; - table.[ 4] = W64.of_int 32907; - table.[ 5] = W64.of_int 2147483649; - table.[ 6] = W64.of_int 9223372039002292353; - table.[ 7] = W64.of_int 9223372036854808585; - table.[ 8] = W64.of_int 138; - table.[ 9] = W64.of_int 136; - table.[10] = W64.of_int 2147516425; - table.[11] = W64.of_int 2147483658; - table.[12] = W64.of_int 2147516555; - table.[13] = W64.of_int 9223372036854775947; - table.[14] = W64.of_int 9223372036854808713; - table.[15] = W64.of_int 9223372036854808579; - table.[16] = W64.of_int 9223372036854808578; - table.[17] = W64.of_int 9223372036854775936; - table.[18] = W64.of_int 32778; - table.[19] = W64.of_int 9223372039002259466; - table.[20] = W64.of_int 9223372039002292353; - table.[21] = W64.of_int 9223372036854808704; - table.[22] = W64.of_int 2147483649; - table.[23] = W64.of_int 9223372039002292232; - return table.[r]; - } +op iotas : W64.t Array24.t = (( + witness + .[0 <- W64.one] + .[1 <- W64.of_int 32898] + .[2 <- W64.of_int 9223372036854808714] + .[3 <- W64.of_int 9223372039002292224] + .[4 <- W64.of_int 32907] + .[5 <- W64.of_int 2147483649] + .[6 <- W64.of_int 9223372039002292353] + .[7 <- W64.of_int 9223372036854808585] + .[8 <- W64.of_int 138] + .[9 <- W64.of_int 136] + .[10 <- W64.of_int 2147516425] + .[11 <- W64.of_int 2147483658] + .[12 <- W64.of_int 2147516555] + .[13 <- W64.of_int 9223372036854775947] + .[14 <- W64.of_int 9223372036854808713] + .[15 <- W64.of_int 9223372036854808579] + .[16 <- W64.of_int 9223372036854808578] + .[17 <- W64.of_int 9223372036854775936] + .[18 <- W64.of_int 32778] + .[19 <- W64.of_int 9223372039002259466] + .[20 <- W64.of_int 9223372039002292353] + .[21 <- W64.of_int 9223372036854808704] + .[22 <- W64.of_int 2147483649] + .[23 <- W64.of_int 9223372039002292232])%Array24). + +module Mref = { proc index (x:int, y:int) : int = { var r:int; @@ -96,34 +94,6 @@ module M = { } proc keccakRhoOffsets (i:int) : int = { - var table : int Array25.t; - table.[0]=0 ; - table.[1]=1 ; - table.[2]=62; - table.[3]=28; - table.[4]=27; - table.[5]=36; - table.[6]=44; - table.[7]=6 ; - table.[8]=55; - table.[9]=20; - table.[10]=3 ; - table.[11]=10; - table.[12]=43; - table.[13]=25; - table.[14]=39; - table.[15]=41; - table.[16]=45; - table.[17]=15; - table.[18]=21; - table.[19]=8 ; - table.[20]=18; - table.[21]=2 ; - table.[22]=61; - table.[23]=56; - table.[24]=14; - return table.[i]; -(* var aux: int; var r:int; @@ -148,8 +118,6 @@ module M = { t <- t + 1; } return (r); -*) - } proc rho (a:W64.t Array25.t) : W64.t Array25.t = { @@ -261,18 +229,21 @@ module M = { state <@ iota_0 (state, c); return (state); } - + + proc keccakRoundConstants () : W64.t Array24.t = { + return iotas; + } proc permute (state:W64.t Array25.t) : W64.t Array25.t = { var aux: int; + var constants:W64.t Array24.t; var round:int; - var c : W64.t; - + constants <- witness; + constants <@ keccakRoundConstants (); round <- 0; while (round < 24) { - c <@ constants(round); - state <@ keccakP1600_round (state, c); + state <@ keccakP1600_round (state, constants.[round]); round <- round + 1; } return (state); diff --git a/proof/impl/perm/keccak_f1600_ref_loop2.ec b/proof/impl/perm/keccak_f1600_ref_loop2.ec new file mode 100644 index 0000000..30cf979 --- /dev/null +++ b/proof/impl/perm/keccak_f1600_ref_loop2.ec @@ -0,0 +1,172 @@ +require import List Int IntExtra IntDiv CoreMap. +from Jasmin require import JModel. + +(* require import Array5 Array24 Array25. +require import WArray40 WArray192 WArray200. *) + +require import Keccak_f1600_ref_table. +import Keccak_f1600_ref. +import Ops. +import Array24. +import Array25. +import Array5. + +module Mrefloop2 = { + include Mreftable [-permute] + + proc permute (state:W64.t Array25.t) : W64.t Array25.t = { + var aux: int; + + var constants:W64.t Array24.t; + var round:int; + constants <- witness; + constants <@ keccakRoundConstants (); + round <- 0; + state <@ keccakP1600_round (state, constants.[round]); + round <- round + 1; + state <@ keccakP1600_round (state, constants.[round]); + round <- round + 1; + while (round < 24) { + state <@ keccakP1600_round (state, constants.[round]); + state <@ keccakP1600_round (state, constants.[round + 1]); + round <- round + 2; + } + return (state); + } +}. + +require import LoopTransform. +clone import ExactIter with + type t = (W64.t Array25.t * W64.t Array24.t). + +module ExplBody : AdvLoop = { + include Mreftable [-permute] + proc body(st : t,i : int) = { + var rst; + rst <@ keccakP1600_round(st.`1,st.`2.[i]); + return (rst,st.`2); + } +}. + +module Mrefloop = { + include ExplBody + include Loop(ExplBody) [loop1] + + proc permute (state:W64.t Array25.t) : W64.t Array25.t = { + var aux: int; + + var constants:W64.t Array24.t; + var round:int; + constants <- witness; + constants <@ keccakRoundConstants (); + (state,constants) <@ loop1((state,constants),24); + return (state); + } + +}. + +module Mrefloopk = { + include ExplBody + include Loop(ExplBody) [loopk] + + proc permute (state:W64.t Array25.t) : W64.t Array25.t = { + var aux: int; + + var constants:W64.t Array24.t; + var round:int; + constants <- witness; + constants <@ keccakRoundConstants (); + (state,constants) <@ loopk((state,constants),12,2); + return (state); + } + +}. + +lemma reftable_refloop : + equiv [ Mreftable.permute ~ Mrefloop.permute : + ={arg,Glob.mem} ==> ={res,Glob.mem} ]. +proc. +inline Mrefloop.loop1. +inline ExplBody.body. +wp. +while (={Glob.mem} /\ (state{1},constants{1}) = t{2} /\ round{1} = i{2} /\ n{2} = 24). +wp; call(_:true); first by sim. +by auto => />. +wp; call(_:true); first by sim. +by auto => />. +qed. + +lemma refloop_refloopk : + equiv [ Mrefloop.permute ~ Mrefloopk.permute : + ={arg,Glob.mem} ==> ={res,Glob.mem} ]. +proc. +call (loop1_loopk ExplBody). + call(_:true); first by sim. +by auto => />. +qed. + + +lemma refloopk_refloop2 : + equiv [ Mrefloopk.permute ~ Mrefloop2.permute : + ={arg,Glob.mem} ==> ={res,Glob.mem} ]. + +proc. +seq 2 2 : (#pre /\ ={constants}); first by sim. +inline Mrefloopk.loopk. + +unroll {1} 5. +rcondt {1} 5; first by move => *; auto => />. + +unroll {1} 6. +rcondt {1} 6; first by move => *; auto => />. + +seq 7 3 : (#{/~state{1}}pre /\ (state{2},constants{2}) = t{1} /\ k{1} = 2 /\ n{1} = 12 /\ j{1} = 1 /\ i{1} = 0 /\ round{2} = 1). +inline ExplBody.body. +wp; call(_:true); first by sim. +by auto => />. + + +unroll {1} 1. +rcondt {1} 1; first by move => *; auto => />. + +seq 2 2 : (#{/~j{1} = 1}{~round{2}=1}pre /\ j{1} = 2 /\ round{2} = 2). +inline ExplBody.body. +wp; call(_:true); first by sim. +by auto => />. + +seq 1 0 : #pre. while {1} (j{1} = 2 /\ k{1} = 2 /\ (state{2},constants{2}) = t{1} ) 1. move => *. exfalso. smt(). +by auto => />. + +seq 1 0 : (#{/~j{1}}{~i{1}}pre /\ i{1} = 1); first by auto => />. +wp. +while (={Glob.mem} /\ + ={constants} /\ + (state{2}, constants{2}) = t{1} /\ + k{1} = 2 /\ n{1} = 12 /\ + round{2} = 2*i{1}). + +unroll {1} 2. +rcondt {1} 2; first by move => *; auto => />. + +seq 3 1 : (#pre /\ j{1} = 1). +inline ExplBody.body. +wp; call(_:true); first by sim. +by auto => />. + +unroll {1} 1. +rcondt {1} 1; first by move => *; auto => />. + +seq 2 1 : (#{/~ j{1} = 1}pre /\ j{1} = 2). +inline ExplBody.body. +wp; call(_:true); first by sim. +by auto => />. + +seq 1 0 : #pre. while {1} (j{1} = 2 /\ k{1} = 2 /\ (state{2},constants{2}) = t{1} ) 1. move => *. exfalso. smt(). +by auto => />. + +by auto => />; smt(). + +by auto => />. + +qed. + diff --git a/proof/impl/perm/keccak_f1600_ref_table.ec b/proof/impl/perm/keccak_f1600_ref_table.ec new file mode 100644 index 0000000..ad14bb9 --- /dev/null +++ b/proof/impl/perm/keccak_f1600_ref_table.ec @@ -0,0 +1,254 @@ +require import List Int IntExtra IntDiv CoreMap. +from Jasmin require import JModel. + +require import Keccak_f1600_ref. +import Ops. +import Array24. +import Array25. + +op rhotates(i : int) : int = (( + witness + .[0 <- 0 ] + .[1 <- 1 ] + .[2 <- 62] + .[3 <- 28] + .[4 <- 27] + .[5 <- 36] + .[6 <- 44] + .[7 <- 6 ] + .[8 <- 55] + .[9 <- 20] + .[10 <- 3 ] + .[11 <- 10] + .[12 <- 43] + .[13 <- 25] + .[14 <- 39] + .[15 <- 41] + .[16 <- 45] + .[17 <- 15] + .[18 <- 21] + .[19 <- 8 ] + .[20 <- 18] + .[21 <- 2 ] + .[22 <- 61] + .[23 <- 56] + .[24 <- 14])%Array25).[i]. + +module RhotatesAlgo = { + include Mref [keccakRhoOffsets] +}. + +module RhotatesTable = { + proc keccakRhoOffsets (i:int) : int = { + return rhotates(i); + } +}. + +equiv rhotates_table_corr : + RhotatesAlgo.keccakRhoOffsets ~ RhotatesTable.keccakRhoOffsets : + ={arg} ==> ={res} . +proc. +unroll for {1} 5. + +case (i{1} = 0). +rcondf {1} 5; first by move => *; auto => />. +rcondf {1} 9; first by move => *; auto => />. +rcondf {1} 13; first by move => *; auto => />. +rcondf {1} 17; first by move => *; auto => />. +rcondf {1} 21; first by move => *; auto => />. +rcondf {1} 25; first by move => *; auto => />. +rcondf {1} 29; first by move => *; auto => />. +rcondf {1} 33; first by move => *; auto => />. +rcondf {1} 37; first by move => *; auto => />. +rcondf {1} 41; first by move => *; auto => />. +rcondf {1} 45; first by move => *; auto => />. +rcondf {1} 49; first by move => *; auto => />. +rcondf {1} 53; first by move => *; auto => />. +rcondf {1} 57; first by move => *; auto => />. +rcondf {1} 61; first by move => *; auto => />. +rcondf {1} 65; first by move => *; auto => />. +rcondf {1} 69; first by move => *; auto => />. +rcondf {1} 73; first by move => *; auto => />. +rcondf {1} 77; first by move => *; auto => />. +rcondf {1} 81; first by move => *; auto => />. +rcondf {1} 85; first by move => *; auto => />. +rcondf {1} 89; first by move => *; auto => />. +rcondf {1} 93; first by move => *; auto => />. +rcondf {1} 97; first by move => *; auto => />. +by auto => />. + +case (i{1} = 2). +rcondf {1} 5; first by move => *; auto => />. +rcondf {1} 9; first by move => *; auto => />. +rcondf {1} 13; first by move => *; auto => />. +rcondf {1} 17; first by move => *; auto => />. +rcondf {1} 21; first by move => *; auto => />. +rcondf {1} 25; first by move => *; auto => />. +rcondf {1} 29; first by move => *; auto => />. +rcondf {1} 33; first by move => *; auto => />. +rcondf {1} 37; first by move => *; auto => />. +rcondf {1} 41; first by move => *; auto => />. +rcondf {1} 45; first by move => *; auto => />. +rcondf {1} 49; first by move => *; auto => />. +rcondf {1} 53; first by move => *; auto => />. +rcondf {1} 57; first by move => *; auto => />. +rcondf {1} 61; first by move => *; auto => />. +rcondf {1} 65; first by move => *; auto => />. +rcondf {1} 69; first by move => *; auto => />. +rcondf {1} 73; first by move => *; auto => />. +rcondt {1} 77; first by move => *; auto => />. +rcondf {1} 82; first by move => *; auto => />. +rcondf {1} 86; first by move => *; auto => />. +rcondf {1} 90; first by move => *; auto => />. +rcondf {1} 94; first by move => *; auto => />. +rcondf {1} 98; first by move => *; auto => />. +by auto => />. + +case (i{1} = 3). +rcondf {1} 5; first by move => *; auto => />. +rcondf {1} 9; first by move => *; auto => />. +rcondf {1} 13; first by move => *; auto => />. +rcondf {1} 17; first by move => *; auto => />. +rcondf {1} 21; first by move => *; auto => />. +rcondf {1} 25; first by move => *; auto => />. +rcondt {1} 29; first by move => *; auto => />. +rcondf {1} 34; first by move => *; auto => />. +rcondf {1} 38; first by move => *; auto => />. +rcondf {1} 42; first by move => *; auto => />. +rcondf {1} 46; first by move => *; auto => />. +rcondf {1} 50; first by move => *; auto => />. +rcondf {1} 54; first by move => *; auto => />. +rcondf {1} 58; first by move => *; auto => />. +rcondf {1} 62; first by move => *; auto => />. +rcondf {1} 66; first by move => *; auto => />. +rcondf {1} 70; first by move => *; auto => />. +rcondf {1} 74; first by move => *; auto => />. +rcondf {1} 78; first by move => *; auto => />. +rcondf {1} 82; first by move => *; auto => />. +rcondf {1} 86; first by move => *; auto => />. +rcondf {1} 90; first by move => *; auto => />. +rcondf {1} 94; first by move => *; auto => />. +rcondf {1} 98; first by move => *; auto => />. +by auto => />. + +case (i{1} = 4). +rcondf {1} 5; first by move => *; auto => />. +rcondf {1} 9; first by move => *; auto => />. +rcondf {1} 13; first by move => *; auto => />. +rcondf {1} 17; first by move => *; auto => />. +rcondf {1} 21; first by move => *; auto => />. +rcondf {1} 25; first by move => *; auto => />. +rcondf {1} 29; first by move => *; auto => />. +rcondf {1} 33; first by move => *; auto => />. +rcondf {1} 37; first by move => *; auto => />. +rcondf {1} 41; first by move => *; auto => />. +rcondf {1} 45; first by move => *; auto => />. +rcondf {1} 49; first by move => *; auto => />. +rcondt {1} 53; first by move => *; auto => />. +rcondf {1} 58; first by move => *; auto => />. +rcondf {1} 62; first by move => *; auto => />. +rcondf {1} 66; first by move => *; auto => />. +rcondf {1} 70; first by move => *; auto => />. +rcondf {1} 74; first by move => *; auto => />. +rcondf {1} 78; first by move => *; auto => />. +rcondf {1} 82; first by move => *; auto => />. +rcondf {1} 86; first by move => *; auto => />. +rcondf {1} 90; first by move => *; auto => />. +rcondf {1} 94; first by move => *; auto => />. +rcondf {1} 98; first by move => *; auto => />. +by auto => />. + +admit. +qed. + +module Mreftable = { + include Mref [-keccakRhoOffsets,rho,keccakP1600_round,permute] + include RhotatesTable + + proc rho (a:W64.t Array25.t) : W64.t Array25.t = { + var aux_1: bool; + var aux_0: bool; + var aux: int; + var aux_2: W64.t; + + var x:int; + var y:int; + var i:int; + var z:int; + var _0:bool; + var _1:bool; + + x <- 0; + while (x < 5) { + y <- 0; + while (y < 5) { + i <@ index (x, y); + z <@ keccakRhoOffsets (i); + (aux_1, aux_0, aux_2) <- x86_ROL_64 a.[i] (W8.of_int z); + _0 <- aux_1; + _1 <- aux_0; + a.[i] <- aux_2; + y <- y + 1; + } + x <- x + 1; + } + return (a); + } + + proc keccakP1600_round (state:W64.t Array25.t, c:W64.t) : W64.t Array25.t = { + state <@ theta (state); + state <@ rho (state); + state <@ pi (state); + state <@ chi (state); + state <@ iota_0 (state, c); + return (state); + } + + proc permute (state:W64.t Array25.t) : W64.t Array25.t = { + var aux: int; + + var constants:W64.t Array24.t; + var round:int; + round <- 0; + constants <@ keccakRoundConstants (); + while (round < 24) { + state <@ keccakP1600_round (state, constants.[round]); + round <- round + 1; + } + return (state); + } + +}. + +lemma ref_reftable : + equiv [ Mref.permute ~ Mreftable.permute : + ={arg,Glob.mem} ==> ={res,Glob.mem} ]. +proc. + +seq 3 2 : (#pre /\ ={constants} /\ ={round}); first by inline*; auto => />. + +while (#post /\ ={round,constants}); last by inline *; auto => />. + +wp. +call (_: true). +call (_: true); first by sim. +call (_: true); first by sim. +call (_: true); first by sim. +call (_: true). +while (#post /\ ={a,x}). +wp. +while (#post /\ ={a,x,y}). +wp. +call (rhotates_table_corr). + +call(_:true); first by sim. + +by auto => />. +by auto => />. +by auto => />. + +call(_:true); first by sim. +by auto => />. +by auto => />. + +qed. diff --git a/proof/impl/perm/keccak_f1600_scalar.ec b/proof/impl/perm/keccak_f1600_scalar.ec new file mode 100644 index 0000000..f71425d --- /dev/null +++ b/proof/impl/perm/keccak_f1600_scalar.ec @@ -0,0 +1,206 @@ +require import List Int IntExtra IntDiv CoreMap. +from Jasmin require import JModel. + +(* +require import Array5 Array25. +require import WArray40 WArray200. +*) + +require import Keccak_f1600_ref. +import Ops. +import Array25. +import Array5. +import Array24. + +op x86_TEST_8 : W8.t -> W8.t -> bool * bool * bool * bool * bool. + +module Mscalar = { + proc rOL64 (x:W64.t, c:int) : W64.t = { + + var y:W64.t; + var _0:bool; + var _1:bool; + + ( _0, _1, y) <- x86_ROL_64 x (W8.of_int c); + return (y); + } + + proc index (x:int, y:int) : int = { + + var r:int; + + r <- ((5 * (x %% 5)) + (y %% 5)); + return (r); + } + + proc keccak_rho_offsets (i:int) : int = { + var aux: int; + + var r:int; + var x:int; + var y:int; + var t:int; + var z:int; + + r <- 0; + x <- 1; + y <- 0; + t <- 0; + while (t < 24) { + if ((i = (x + (5 * y)))) { + r <- ((((t + 1) * (t + 2)) %/ 2) %% 64); + } else { + + } + z <- (((2 * x) + (3 * y)) %% 5); + x <- y; + y <- z; + t <- t + 1; + } + return (r); + } + + proc rhotates (x:int, y:int) : int = { + + var r:int; + var i:int; + + i <@ index (x, y); + r <@ keccak_rho_offsets (i); + return (r); + } + + proc theta_sum (_A:W64.t Array25.t) : W64.t Array5.t = { + var aux: int; + + var _C:W64.t Array5.t; + var i:int; + var j:int; + _C <- witness; + i <- 0; + while (i < 5) { + _C.[i] <- _A.[((5 * (0 %% 5)) + (i %% 5))]; + j <- 1; + while (j < 5) { + _C.[i] <- (_C.[i] `^` _A.[((5 * (j %% 5)) + (i %% 5))]); + j <- j + 1; + } + i <- i + 1; + } + return (_C); + } + + proc theta_rol (_C:W64.t Array5.t) : W64.t Array5.t = { + var aux: int; + + var _D:W64.t Array5.t; + var i:int; + var r:W64.t; + _D <- witness; + i <- 0; + while (i < 5) { + r <@ rOL64 (_C.[((i + 1) %% 5)], 1); + _D.[i] <- r; + _D.[i] <- (_D.[i] `^` _C.[((i + 4) %% 5)]); + i <- i + 1; + } + return (_D); + } + + proc rol_sum (_D:W64.t Array5.t, _A:W64.t Array25.t, offset:int) : W64.t Array5.t = { + var aux: int; + + var _C:W64.t Array5.t; + var j:int; + var j1:int; + var k:int; + var t:W64.t; + _C <- witness; + j <- 0; + while (j < 5) { + j1 <- ((j + offset) %% 5); + k <@ rhotates (j, j1); + t <- _A.[((5 * (j %% 5)) + (j1 %% 5))]; + t <- (t `^` _D.[j1]); + t <@ rOL64 (t, k); + _C.[j] <- t; + j <- j + 1; + } + return (_C); + } + + proc set_row (_R:W64.t Array25.t, row:int, _C:W64.t Array5.t, iota_0:W64.t) : + W64.t Array25.t = { + var aux: int; + + var j:int; + var j1:int; + var j2:int; + var t:W64.t; + + j <- 0; + while (j < 5) { + j1 <- ((j + 1) %% 5); + j2 <- ((j + 2) %% 5); + t <- ((invw _C.[j1]) `&` _C.[j2]); + if (((row = 0) /\ (j = 0))) { + t <- (t `^` iota_0); + } else { + + } + t <- (t `^` _C.[j]); + _R.[((5 * (row %% 5)) + (j %% 5))] <- t; + j <- j + 1; + } + return (_R); + } + + proc round2x (_A:W64.t Array25.t, _R:W64.t Array25.t, iotas:W64.t, o:int) : + W64.t Array25.t * W64.t Array25.t = { + + var iota_0:W64.t; + var _C:W64.t Array5.t; + var _D:W64.t Array5.t; + _C <- witness; + _D <- witness; + iota_0 <- (loadW64 Glob.mem (W64.to_uint (iotas + (W64.of_int o)))); + _C <@ theta_sum (_A); + _D <@ theta_rol (_C); + _C <@ rol_sum (_D, _A, 0); + _R <@ set_row (_R, 0, _C, iota_0); + _C <@ rol_sum (_D, _A, 3); + _R <@ set_row (_R, 1, _C, iota_0); + _C <@ rol_sum (_D, _A, 1); + _R <@ set_row (_R, 2, _C, iota_0); + _C <@ rol_sum (_D, _A, 4); + _R <@ set_row (_R, 3, _C, iota_0); + _C <@ rol_sum (_D, _A, 2); + _R <@ set_row (_R, 4, _C, iota_0); + return (_A, _R); + } + + proc keccak_f (_A:W64.t Array25.t, iotas:W64.t) : W64.t Array25.t * W64.t = { + + var zf:bool; + var _R:W64.t Array25.t; + var _0:bool; + var _1:bool; + var _2:bool; + var _3:bool; + _R <- witness; + (_A, _R) <@ round2x (_A, _R, iotas, 0); + (_R, _A) <@ round2x (_R, _A, iotas, 8); + iotas <- (iotas + (W64.of_int 16)); + ( _0, _1, _2, _3, zf) <- x86_TEST_8 (truncateu8 iotas) + (W8.of_int 255); + while ((! zf)) { + (_A, _R) <@ round2x (_A, _R, iotas, 0); + (_R, _A) <@ round2x (_R, _A, iotas, 8); + iotas <- (iotas + (W64.of_int 16)); + ( _0, _1, _2, _3, zf) <- x86_TEST_8 (truncateu8 iotas) + (W8.of_int 255); + } + iotas <- (iotas - (W64.of_int 192)); + return (_A, iotas); + } +}. diff --git a/proof/impl/perm/keccak_f1600_scalar_table.ec b/proof/impl/perm/keccak_f1600_scalar_table.ec new file mode 100644 index 0000000..c63b415 --- /dev/null +++ b/proof/impl/perm/keccak_f1600_scalar_table.ec @@ -0,0 +1,1209 @@ +require import List Int IntExtra IntDiv CoreMap. +from Jasmin require import JModel. + +(* +require import Array5 Array25. +require import WArray40 WArray200. +*) + +require import Keccak_f1600_scalar. +require import Keccak_f1600_ref. +require import Keccak_f1600_ref_table. +require import Keccak_f1600_ref_loop2. +import Ops. +import Array25. +import Array5. +import Array24. + +module Mscalarrho = { + include Mscalar [-keccak_rho_offsets,rhotates,rol_sum,round2x,keccak_f] + include RhotatesAlgo + + proc rhotates (x:int, y:int) : int = { + + var r:int; + var i:int; + + i <@ index (x, y); + r <@ keccakRhoOffsets (i); + return (r); + } + + proc rol_sum (_D:W64.t Array5.t, _A:W64.t Array25.t, offset:int) : W64.t Array5.t = { + var aux: int; + + var _C:W64.t Array5.t; + var j:int; + var j1:int; + var k:int; + var t:W64.t; + _C <- witness; + j <- 0; + while (j < 5) { + j1 <- ((j + offset) %% 5); + k <@ rhotates (j, j1); + t <- _A.[((5 * (j %% 5)) + (j1 %% 5))]; + t <- (t `^` _D.[j1]); + t <@ rOL64 (t, k); + _C.[j] <- t; + j <- j + 1; + } + return (_C); + } + + + proc round2x (_A:W64.t Array25.t, _R:W64.t Array25.t, iotas:W64.t, o:int) : + W64.t Array25.t * W64.t Array25.t = { + + var iota_0:W64.t; + var _C:W64.t Array5.t; + var _D:W64.t Array5.t; + _C <- witness; + _D <- witness; + iota_0 <- (loadW64 Glob.mem (W64.to_uint (iotas + (W64.of_int o)))); + _C <@ theta_sum (_A); + _D <@ theta_rol (_C); + _C <@ rol_sum (_D, _A, 0); + _R <@ set_row (_R, 0, _C, iota_0); + _C <@ rol_sum (_D, _A, 3); + _R <@ set_row (_R, 1, _C, iota_0); + _C <@ rol_sum (_D, _A, 1); + _R <@ set_row (_R, 2, _C, iota_0); + _C <@ rol_sum (_D, _A, 4); + _R <@ set_row (_R, 3, _C, iota_0); + _C <@ rol_sum (_D, _A, 2); + _R <@ set_row (_R, 4, _C, iota_0); + return (_A, _R); + } + + proc keccak_f (_A:W64.t Array25.t, iotas:W64.t) : W64.t Array25.t * W64.t = { + + var zf:bool; + var _R:W64.t Array25.t; + var _0:bool; + var _1:bool; + var _2:bool; + var _3:bool; + _R <- witness; + (_A, _R) <@ round2x (_A, _R, iotas, 0); + (_R, _A) <@ round2x (_R, _A, iotas, 8); + iotas <- (iotas + (W64.of_int 16)); + ( _0, _1, _2, _3, zf) <- x86_TEST_8 (truncateu8 iotas) + (W8.of_int 255); + while ((! zf)) { + (_A, _R) <@ round2x (_A, _R, iotas, 0); + (_R, _A) <@ round2x (_R, _A, iotas, 8); + iotas <- (iotas + (W64.of_int 16)); + ( _0, _1, _2, _3, zf) <- x86_TEST_8 (truncateu8 iotas) + (W8.of_int 255); + } + iotas <- (iotas - (W64.of_int 192)); + return (_A, iotas); + } +}. + +equiv scalarrhom : + Mscalar.keccak_f ~ Mscalarrho.keccak_f : + ={Glob.mem,arg} ==> ={res} by sim. + +module Mscalartable = { + include Mscalar [-keccak_rho_offsets,rhotates,rol_sum,round2x,keccak_f] + include RhotatesTable + + proc rhotates (x:int, y:int) : int = { + + var r:int; + var i:int; + + i <@ index (x, y); + r <@ keccakRhoOffsets (i); + return (r); + } + + proc rol_sum (_D:W64.t Array5.t, _A:W64.t Array25.t, offset:int) : W64.t Array5.t = { + var aux: int; + + var _C:W64.t Array5.t; + var j:int; + var j1:int; + var k:int; + var t:W64.t; + _C <- witness; + j <- 0; + while (j < 5) { + j1 <- ((j + offset) %% 5); + k <@ rhotates (j, j1); + t <- _A.[((5 * (j %% 5)) + (j1 %% 5))]; + t <- (t `^` _D.[j1]); + t <@ rOL64 (t, k); + _C.[j] <- t; + j <- j + 1; + } + return (_C); + } + + + proc round2x (_A:W64.t Array25.t, _R:W64.t Array25.t, iotas:W64.t, o:int) : + W64.t Array25.t * W64.t Array25.t = { + + var iota_0:W64.t; + var _C:W64.t Array5.t; + var _D:W64.t Array5.t; + _C <- witness; + _D <- witness; + iota_0 <- (loadW64 Glob.mem (W64.to_uint (iotas + (W64.of_int o)))); + _C <@ theta_sum (_A); + _D <@ theta_rol (_C); + _C <@ rol_sum (_D, _A, 0); + _R <@ set_row (_R, 0, _C, iota_0); + _C <@ rol_sum (_D, _A, 3); + _R <@ set_row (_R, 1, _C, iota_0); + _C <@ rol_sum (_D, _A, 1); + _R <@ set_row (_R, 2, _C, iota_0); + _C <@ rol_sum (_D, _A, 4); + _R <@ set_row (_R, 3, _C, iota_0); + _C <@ rol_sum (_D, _A, 2); + _R <@ set_row (_R, 4, _C, iota_0); + return (_A, _R); + } + + proc keccak_f (_A:W64.t Array25.t, iotas:W64.t) : W64.t Array25.t * W64.t = { + + var zf:bool; + var _R:W64.t Array25.t; + var _0:bool; + var _1:bool; + var _2:bool; + var _3:bool; + _R <- witness; + (_A, _R) <@ round2x (_A, _R, iotas, 0); + (_R, _A) <@ round2x (_R, _A, iotas, 8); + iotas <- (iotas + (W64.of_int 16)); + ( _0, _1, _2, _3, zf) <- x86_TEST_8 (truncateu8 iotas) + (W8.of_int 255); + while ((! zf)) { + (_A, _R) <@ round2x (_A, _R, iotas, 0); + (_R, _A) <@ round2x (_R, _A, iotas, 8); + iotas <- (iotas + (W64.of_int 16)); + ( _0, _1, _2, _3, zf) <- x86_TEST_8 (truncateu8 iotas) + (W8.of_int 255); + } + iotas <- (iotas - (W64.of_int 192)); + return (_A, iotas); + } +}. + +equiv scalartable : + Mscalarrho.keccak_f ~ Mscalartable.keccak_f : + ={Glob.mem,arg} ==> ={res}. +proc. +wp. +while (={Glob.mem,zf,_A,_R,iotas}). +wp. +call (_: ={Glob.mem}). +call (_:true); first by sim. +call (_:true). +while (={j,_C,_A,_D,offset}). +wp. +call (_:true); first by sim. +inline Mscalartable.rhotates Mscalarrho.rhotates. +wp. +call(rhotates_table_corr). +call (_:true); first by sim. +by auto => />. +by auto => />. + +call (_:true); first by sim. +call (_:true). +while (={j,_C,_A,_D,offset}). +wp. +call (_:true); first by sim. +inline Mscalartable.rhotates Mscalarrho.rhotates. +wp. +call(rhotates_table_corr). +call (_:true); first by sim. +by auto => />. +by auto => />. + +call (_:true); first by sim. +call (_:true). +while (={j,_C,_A,_D,offset}). +wp. +call (_:true); first by sim. +inline Mscalartable.rhotates Mscalarrho.rhotates. +wp. +call(rhotates_table_corr). +call (_:true); first by sim. +by auto => />. +by auto => />. + +call (_:true); first by sim. +call (_:true). +while (={j,_C,_A,_D,offset}). +wp. +call (_:true); first by sim. +inline Mscalartable.rhotates Mscalarrho.rhotates. +wp. +call(rhotates_table_corr). +call (_:true); first by sim. +by auto => />. +by auto => />. + +call (_:true); first by sim. +call (_:true). +while (={j,_C,_A,_D,offset}). +wp. +call (_:true); first by sim. +inline Mscalartable.rhotates Mscalarrho.rhotates. +wp. +call(rhotates_table_corr). +call (_:true); first by sim. +by auto => />. +by auto => />. + +call (_:true); first by sim. +call (_:true); first by sim. +by auto => />. + +call (_: ={Glob.mem}). +call (_:true); first by sim. +call (_:true). +while (={j,_C,_A,_D,offset}). +wp. +call (_:true); first by sim. +inline Mscalartable.rhotates Mscalarrho.rhotates. +wp. +call(rhotates_table_corr). +call (_:true); first by sim. +by auto => />. +by auto => />. + +call (_:true); first by sim. +call (_:true). +while (={j,_C,_A,_D,offset}). +wp. +call (_:true); first by sim. +inline Mscalartable.rhotates Mscalarrho.rhotates. +wp. +call(rhotates_table_corr). +call (_:true); first by sim. +by auto => />. +by auto => />. + +call (_:true); first by sim. +call (_:true). +while (={j,_C,_A,_D,offset}). +wp. +call (_:true); first by sim. +inline Mscalartable.rhotates Mscalarrho.rhotates. +wp. +call(rhotates_table_corr). +call (_:true); first by sim. +by auto => />. +by auto => />. + +call (_:true); first by sim. +call (_:true). +while (={j,_C,_A,_D,offset}). +wp. +call (_:true); first by sim. +inline Mscalartable.rhotates Mscalarrho.rhotates. +wp. +call(rhotates_table_corr). +call (_:true); first by sim. +by auto => />. +by auto => />. + +call (_:true); first by sim. +call (_:true). +while (={j,_C,_A,_D,offset}). +wp. +call (_:true); first by sim. +inline Mscalartable.rhotates Mscalarrho.rhotates. +wp. +call(rhotates_table_corr). +call (_:true); first by sim. +by auto => />. +by auto => />. + +call (_:true); first by sim. +call (_:true); first by sim. +by auto => />. + +by auto => />. + +wp. + +call (_: ={Glob.mem}). +call (_:true); first by sim. +call (_:true). +while (={j,_C,_A,_D,offset}). +wp. +call (_:true); first by sim. +inline Mscalartable.rhotates Mscalarrho.rhotates. +wp. +call(rhotates_table_corr). +call (_:true); first by sim. +by auto => />. +by auto => />. + +call (_:true); first by sim. +call (_:true). +while (={j,_C,_A,_D,offset}). +wp. +call (_:true); first by sim. +inline Mscalartable.rhotates Mscalarrho.rhotates. +wp. +call(rhotates_table_corr). +call (_:true); first by sim. +by auto => />. +by auto => />. + +call (_:true); first by sim. +call (_:true). +while (={j,_C,_A,_D,offset}). +wp. +call (_:true); first by sim. +inline Mscalartable.rhotates Mscalarrho.rhotates. +wp. +call(rhotates_table_corr). +call (_:true); first by sim. +by auto => />. +by auto => />. + +call (_:true); first by sim. +call (_:true). +while (={j,_C,_A,_D,offset}). +wp. +call (_:true); first by sim. +inline Mscalartable.rhotates Mscalarrho.rhotates. +wp. +call(rhotates_table_corr). +call (_:true); first by sim. +by auto => />. +by auto => />. + +call (_:true); first by sim. +call (_:true). +while (={j,_C,_A,_D,offset}). +wp. +call (_:true); first by sim. +inline Mscalartable.rhotates Mscalarrho.rhotates. +wp. +call(rhotates_table_corr). +call (_:true); first by sim. +by auto => />. +by auto => />. + +call (_:true); first by sim. +call (_:true); first by sim. +by auto => />. + +call (_: ={Glob.mem}). +call (_:true); first by sim. +call (_:true). +while (={j,_C,_A,_D,offset}). +wp. +call (_:true); first by sim. +inline Mscalartable.rhotates Mscalarrho.rhotates. +wp. +call(rhotates_table_corr). +call (_:true); first by sim. +by auto => />. +by auto => />. + +call (_:true); first by sim. +call (_:true). +while (={j,_C,_A,_D,offset}). +wp. +call (_:true); first by sim. +inline Mscalartable.rhotates Mscalarrho.rhotates. +wp. +call(rhotates_table_corr). +call (_:true); first by sim. +by auto => />. +by auto => />. + +call (_:true); first by sim. +call (_:true). +while (={j,_C,_A,_D,offset}). +wp. +call (_:true); first by sim. +inline Mscalartable.rhotates Mscalarrho.rhotates. +wp. +call(rhotates_table_corr). +call (_:true); first by sim. +by auto => />. +by auto => />. + +call (_:true); first by sim. +call (_:true). +while (={j,_C,_A,_D,offset}). +wp. +call (_:true); first by sim. +inline Mscalartable.rhotates Mscalarrho.rhotates. +wp. +call(rhotates_table_corr). +call (_:true); first by sim. +by auto => />. +by auto => />. + +call (_:true); first by sim. +call (_:true). +while (={j,_C,_A,_D,offset}). +wp. +call (_:true); first by sim. +inline Mscalartable.rhotates Mscalarrho.rhotates. +wp. +call(rhotates_table_corr). +call (_:true); first by sim. +by auto => />. +by auto => />. + +call (_:true); first by sim. +call (_:true); first by sim. +by auto => />. + +by auto => />. +qed. + + +op good_iotas (mem : global_mem_t, _iotas : int) = + forall off, 0 <= off < 24 => + loadW64 mem (_iotas + (off * 8)) = iotas.[off]. + +lemma testsem : (forall (x : W64.t), (x86_TEST_8 (truncateu8 x) (W8.of_int 255)).`5 <=> (W64.to_uint x %% 256 = 0)) by admit. + + +lemma scalarcorr _iotas mem : + equiv [ Mrefloop2.permute ~ Mscalartable.keccak_f : + 0 <= _iotas < W64.modulus - 24 * 8 /\ + good_iotas mem _iotas /\ (_iotas - 8*8) %% 256 = 0 /\ + mem = Glob.mem{2} /\ to_uint iotas{2} = _iotas /\ + state{1} = _A{2} ==> mem = Glob.mem{2} /\ to_uint res{2}.`2 = _iotas /\ + res{1} = res{2}.`1 ]. +proc. +seq 2 1 : (#pre /\ constants{1} = iotas); first by inline *;auto => />. + +seq 1 0 : (#{/~iotas{2}}pre /\ + _iotas = to_uint iotas{2} - round{1} * 8 /\ + round{1} = 0 /\ + state{1} = _A{2}); first by auto => />. + +seq 4 3: (#{/~round{1} = 0}pre /\ round{1} = 2). + +inline Mreftable.keccakP1600_round Mscalartable.round2x. + +swap {2}[5..6] -4. seq 0 2 : #pre; first by auto => />. + +swap {1} 2 -1. +swap {2} [3..5] -2. + +seq 1 3 : (#pre /\ iota_0{2} = c{1}). +inline *;wp;skip; rewrite /good_iotas /iotas; auto => />. +move => &2 bound1 bound2 Tass. +progress. +by move : (Tass 0) => //=. + +sp. + +inline Mreftable.theta. +seq 7 2 : (#pre /\ a{1}=state0{1} /\ d{1} = _D{2}). + +inline *. + +sp 3 2. +seq 2 2 : (#{/~c1{1}}{~_C1{2}}pre /\ + c1{1} = _C1{2}). +unroll for {1} 2. +unroll for {1} 4. +unroll for {1} 17. +unroll for {1} 30. +unroll for {1} 43. +unroll for {1} 56. +unroll for {2} 2. +unroll for {2} 4. +unroll for {2} 15. +unroll for {2} 26. +unroll for {2} 37. +unroll for {2} 48. + +by auto => />. + +seq 0 0 : #{/~_C{2}}pre; first by auto => />. + +sp 0 3. + +wp. + +unroll for {1} 2. +unroll for {2} 2. + +by auto => />. + +seq 8 11 : (#{/~state{1}}{~state0{1}}{~_A0{2}}{~_R0{2}}pre /\ state{1} = _R{2}). + +inline *. + +unroll for {1} 2. +unroll for {1} 3. +unroll for {1} 15. +unroll for {1} 27. +unroll for {1} 39. +unroll for {1} 51. +unroll for {1} 65. +unroll for {1} 66. +unroll for {1} 123. +unroll for {1} 180. +unroll for {1} 237. +unroll for {1} 294. +unroll for {1} 354. +unroll for {1} 430. +unroll for {1} 431. +unroll for {1} 468. +unroll for {1} 505. +unroll for {1} 542. +unroll for {1} 579. +unroll for {1} 619. +unroll for {1} 620. +unroll for {1} 706. +unroll for {1} 718. +unroll for {1} 804. +unroll for {1} 816. +unroll for {1} 902. +unroll for {1} 914. +unroll for {1} 1000. +unroll for {1} 1012. +unroll for {1} 1098. + + +unroll for {2} 6. +unroll for {2} 102. +unroll for {2} 143. +unroll for {2} 239. +unroll for {2} 280. +unroll for {2} 376. +unroll for {2} 417. +unroll for {2} 513. +unroll for {2} 554. +unroll for {2} 650. + + +rcondt {2} 105; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 112; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 118; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 124; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 130; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 238; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 244; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 250; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 256; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 262; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 370; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 376; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 382; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 388; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 394; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 502; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 508; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 514; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 520; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 526; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 634; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 640; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 646; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 652; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 658; first by move => *; wp;skip;auto => />;smt(). + +wp;skip. + +move => &1 &2. + +move => H. + +simplify. + +split; last first. + +apply Array25.ext_eq. + +move => x Hx. + +case (x = 0); first by auto => />;smt( @W64). +case (x = 1); first by auto => />;smt( @W64). +case (x = 2); first by auto => />;smt( @W64). +case (x = 3); first by auto => />;smt( @W64). +case (x = 4); first by auto => />;smt( @W64). +case (x = 5); first by auto => />;smt( @W64). +case (x = 6); first by auto => />;smt( @W64). +case (x = 7); first by auto => />;smt( @W64). +case (x = 8); first by auto => />;smt( @W64). +case (x = 9); first by auto => />;smt( @W64). +case (x = 10); first by auto => />;smt( @W64). +case (x = 11); first by auto => />;smt( @W64). +case (x = 12); first by auto => />;smt( @W64). +case (x = 13); first by auto => />;smt( @W64). +case (x = 14); first by auto => />;smt( @W64). +case (x = 15); first by auto => />;smt( @W64). +case (x = 16); first by auto => />;smt( @W64). +case (x = 17); first by auto => />;smt( @W64). +case (x = 18); first by auto => />;smt( @W64). +case (x = 19); first by auto => />;smt( @W64). +case (x = 20); first by auto => />;smt( @W64). +case (x = 21); first by auto => />;smt( @W64). +case (x = 22); first by auto => />;smt( @W64). +case (x = 23); first by auto => />;smt( @W64). +case (x = 24); first by auto => />;smt( @W64). +by smt(). + +progress. smt(). smt. smt(). smt(). smt(). smt(). smt(). smt(). smt(). smt(). + +(* Second round *) + +swap {2}[5..6] -4. seq 0 2 : #pre; first by auto => />. + +swap {1} 3 -1. +swap {2} [3..5] -2. + +seq 2 3 : (#{/~round{1}}pre /\ + round{1} = 1 /\ + (round{1} - 1) * 8 + _iotas = to_uint iotas{2} + /\ iota_00{2} = c0{1}). + +inline *;wp;skip; rewrite /good_iotas /iotas; auto => />. +move => &2 bound1 bound2 Tass. +move : (Tass 1) => //=. +rewrite (_ : to_uint (iotas{2} + (of_int 8)%W64) = to_uint iotas{2} + 8). rewrite to_uintD. smt(@W64). by trivial. + +seq 8 4 : (#pre /\ a0{1}=state{1} /\ d0{1} = _D0{2} /\ _A1{2} = a0{1}). +inline *. + +sp 4 4. + +seq 2 2 : (#{/~c2{1}}{~_C1{2}}pre /\ + c2{1} = _C1{2}). +unroll for {1} 2. +unroll for {1} 4. +unroll for {1} 17. +unroll for {1} 30. +unroll for {1} 43. +unroll for {1} 56. +unroll for {2} 2. +unroll for {2} 4. +unroll for {2} 15. +unroll for {2} 26. +unroll for {2} 37. +unroll for {2} 48. + +by auto => />. + +sp 0 3. + +wp. + +unroll for {1} 2. +unroll for {2} 2. + +by auto => />. + +seq 8 11 : (#{/~state{1}}{~_A1{2}}pre /\ state{1} = _A{2}). + +inline *. + +unroll for {1} 2. +unroll for {1} 3. +unroll for {1} 15. +unroll for {1} 27. +unroll for {1} 39. +unroll for {1} 51. +unroll for {1} 65. +unroll for {1} 66. +unroll for {1} 123. +unroll for {1} 180. +unroll for {1} 237. +unroll for {1} 294. +unroll for {1} 354. +unroll for {1} 430. +unroll for {1} 431. +unroll for {1} 468. +unroll for {1} 505. +unroll for {1} 542. +unroll for {1} 579. +unroll for {1} 619. +unroll for {1} 620. +unroll for {1} 706. +unroll for {1} 718. +unroll for {1} 804. +unroll for {1} 816. +unroll for {1} 902. +unroll for {1} 914. +unroll for {1} 1000. +unroll for {1} 1012. +unroll for {1} 1098. + + +unroll for {2} 6. +unroll for {2} 102. +unroll for {2} 143. +unroll for {2} 239. +unroll for {2} 280. +unroll for {2} 376. +unroll for {2} 417. +unroll for {2} 513. +unroll for {2} 554. +unroll for {2} 650. + +rcondt {2} 105; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 112; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 118; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 124; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 130; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 238; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 244; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 250; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 256; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 262; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 370; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 376; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 382; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 388; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 394; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 502; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 508; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 514; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 520; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 526; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 634; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 640; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 646; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 652; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 658; first by move => *; wp;skip;auto => />;smt(). + +wp;skip. + +move => &1 &2. + +move => H. + +simplify. + +split; last first. + +apply Array25.ext_eq. + +move => x Hx. + +case (x = 0); first by auto => />;smt( @W64). +case (x = 1); first by auto => />;smt( @W64). +case (x = 2); first by auto => />;smt( @W64). +case (x = 3); first by auto => />;smt( @W64). +case (x = 4); first by auto => />;smt( @W64). +case (x = 5); first by auto => />;smt( @W64). +case (x = 6); first by auto => />;smt( @W64). +case (x = 7); first by auto => />;smt( @W64). +case (x = 8); first by auto => />;smt( @W64). +case (x = 9); first by auto => />;smt( @W64). +case (x = 10); first by auto => />;smt( @W64). +case (x = 11); first by auto => />;smt( @W64). +case (x = 12); first by auto => />;smt( @W64). +case (x = 13); first by auto => />;smt( @W64). +case (x = 14); first by auto => />;smt( @W64). +case (x = 15); first by auto => />;smt( @W64). +case (x = 16); first by auto => />;smt( @W64). +case (x = 17); first by auto => />;smt( @W64). +case (x = 18); first by auto => />;smt( @W64). +case (x = 19); first by auto => />;smt( @W64). +case (x = 20); first by auto => />;smt( @W64). +case (x = 21); first by auto => />;smt( @W64). +case (x = 22); first by auto => />;smt( @W64). +case (x = 23); first by auto => />;smt( @W64). +case (x = 24); first by auto => />;smt( @W64). +by smt(). + +progress. smt(). smt. smt(). smt(). smt(). smt(). smt(). smt(). smt(). +smt(). smt(). smt(). + +auto => />. +progress. +rewrite to_uintD. +by smt(@W64). + +(* Main loop *) + +seq 0 1 : (#{/~round{1} = 2}pre /\ 0 < round{1} <= 24 /\ round{1} %% 2 = 0 /\ + zf{2} = (x86_TEST_8 (truncateu8 iotas{2}) ((of_int 255))%W8).`5); first by auto => />. +wp. +while (#pre). +wp. + +inline Mreftable.keccakP1600_round Mscalartable.round2x. + +swap {2}[5..6] -4. seq 0 2 : #pre; first by auto => />. + +swap {1} 2 -1. +swap {2} [3..5] -2. + +seq 1 3 : (#pre /\ iota_0{2} = c{1}). +inline *;wp;skip; rewrite /good_iotas /iotas; auto => />. +move => &1 &2 bound1 bound2 Tass. +progress. +move : (Tass round{1}) => //=. +rewrite (_: to_uint iotas{2} - round{1} * 8 + round{1} * 8 = to_uint iotas{2}); first by ring. +smt(). + +inline Mreftable.theta. +seq 8 4 : (#pre /\ a{1}=state{1} /\ d{1} = _D{2} /\ _A0{2} = _A{2}). + +inline *. + +sp 4 4. +seq 2 2 : (#{/~c1{1}}{~_C1{2}}pre /\ + c1{1} = _C1{2}). +unroll for {1} 2. +unroll for {1} 4. +unroll for {1} 17. +unroll for {1} 30. +unroll for {1} 43. +unroll for {1} 56. +unroll for {2} 2. +unroll for {2} 4. +unroll for {2} 15. +unroll for {2} 26. +unroll for {2} 37. +unroll for {2} 48. + +by auto => />. + +seq 0 0 : #{/~_C{2}}pre; first by auto => />. + +sp 0 3. + +wp. + +unroll for {1} 2. +unroll for {2} 2. + +by auto => />. + +seq 8 11 : (#{/~state{1}}{~state0{1}}{~_A0{2}}{~_R0{2}}pre /\ state{1} = _R{2}). + +inline *. + +unroll for {1} 2. +unroll for {1} 3. +unroll for {1} 15. +unroll for {1} 27. +unroll for {1} 39. +unroll for {1} 51. +unroll for {1} 65. +unroll for {1} 66. +unroll for {1} 123. +unroll for {1} 180. +unroll for {1} 237. +unroll for {1} 294. +unroll for {1} 354. +unroll for {1} 430. +unroll for {1} 431. +unroll for {1} 468. +unroll for {1} 505. +unroll for {1} 542. +unroll for {1} 579. +unroll for {1} 619. +unroll for {1} 620. +unroll for {1} 706. +unroll for {1} 718. +unroll for {1} 804. +unroll for {1} 816. +unroll for {1} 902. +unroll for {1} 914. +unroll for {1} 1000. +unroll for {1} 1012. +unroll for {1} 1098. + + +unroll for {2} 6. +unroll for {2} 102. +unroll for {2} 143. +unroll for {2} 239. +unroll for {2} 280. +unroll for {2} 376. +unroll for {2} 417. +unroll for {2} 513. +unroll for {2} 554. +unroll for {2} 650. + +rcondt {2} 105; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 112; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 118; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 124; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 130; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 238; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 244; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 250; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 256; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 262; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 370; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 376; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 382; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 388; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 394; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 502; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 508; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 514; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 520; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 526; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 634; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 640; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 646; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 652; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 658; first by move => *; wp;skip;auto => />;smt(). + +wp;skip. + +move => &1 &2. + +move => H. + +simplify. + +split; last first. + +apply Array25.ext_eq. + +move => x Hx. + +case (x = 0); first by auto => />;smt( @W64). +case (x = 1); first by auto => />;smt( @W64). +case (x = 2); first by auto => />;smt( @W64). +case (x = 3); first by auto => />;smt( @W64). +case (x = 4); first by auto => />;smt( @W64). +case (x = 5); first by auto => />;smt( @W64). +case (x = 6); first by auto => />;smt( @W64). +case (x = 7); first by auto => />;smt( @W64). +case (x = 8); first by auto => />;smt( @W64). +case (x = 9); first by auto => />;smt( @W64). +case (x = 10); first by auto => />;smt( @W64). +case (x = 11); first by auto => />;smt( @W64). +case (x = 12); first by auto => />;smt( @W64). +case (x = 13); first by auto => />;smt( @W64). +case (x = 14); first by auto => />;smt( @W64). +case (x = 15); first by auto => />;smt( @W64). +case (x = 16); first by auto => />;smt( @W64). +case (x = 17); first by auto => />;smt( @W64). +case (x = 18); first by auto => />;smt( @W64). +case (x = 19); first by auto => />;smt( @W64). +case (x = 20); first by auto => />;smt( @W64). +case (x = 21); first by auto => />;smt( @W64). +case (x = 22); first by auto => />;smt( @W64). +case (x = 23); first by auto => />;smt( @W64). +case (x = 24); first by auto => />;smt( @W64). +by smt(). + +progress. smt(). smt. smt(). smt(). smt(). smt(). smt(). smt(). smt(). smt(). smt(). smt(). smt(). smt(). smt(). + +(* Second round *) + +swap {2}[5..6] -4. seq 0 2 : #pre; first by auto => />. + +swap {1} 2 -1. +swap {2} [3..5] -2. + +seq 1 3 : (#pre /\ + iota_00{2} = c0{1}). + +inline *;wp;skip; rewrite /good_iotas /iotas; auto => />. +move => &1 &2 bound1 bound2 Tass. +progress. +move : (Tass (round{1} + 1)) => //=. +rewrite (_: to_uint iotas{2} - round{1} * 8 + (round{1} + 1) * 8 = to_uint (iotas{2} + (of_int 8)%W64)). +rewrite to_uintD. +have bb : (to_uint iotas{2} + to_uint ((of_int 8))%W64 < W64.modulus). +smt(). +smt(@W64). +smt(). + +seq 8 4 : (#pre /\ a0{1}=state{1} /\ d0{1} = _D0{2} /\ _A1{2} = a0{1}). + +inline *. + +sp 4 4. + +seq 2 2 : (#{/~c2{1}}{~_C1{2}}pre /\ + c2{1} = _C1{2}). +unroll for {1} 2. +unroll for {1} 4. +unroll for {1} 17. +unroll for {1} 30. +unroll for {1} 43. +unroll for {1} 56. +unroll for {2} 2. +unroll for {2} 4. +unroll for {2} 15. +unroll for {2} 26. +unroll for {2} 37. +unroll for {2} 48. + +by auto => />. + +sp 0 3. + +wp. + +unroll for {1} 2. +unroll for {2} 2. + +by auto => />. + +seq 8 11 : (#{/~state{1}}{~_A1{2}}pre /\ state{1} = _A{2}). + +inline *. + +unroll for {1} 2. +unroll for {1} 3. +unroll for {1} 15. +unroll for {1} 27. +unroll for {1} 39. +unroll for {1} 51. +unroll for {1} 65. +unroll for {1} 66. +unroll for {1} 123. +unroll for {1} 180. +unroll for {1} 237. +unroll for {1} 294. +unroll for {1} 354. +unroll for {1} 430. +unroll for {1} 431. +unroll for {1} 468. +unroll for {1} 505. +unroll for {1} 542. +unroll for {1} 579. +unroll for {1} 619. +unroll for {1} 620. +unroll for {1} 706. +unroll for {1} 718. +unroll for {1} 804. +unroll for {1} 816. +unroll for {1} 902. +unroll for {1} 914. +unroll for {1} 1000. +unroll for {1} 1012. +unroll for {1} 1098. + + +unroll for {2} 6. +unroll for {2} 102. +unroll for {2} 143. +unroll for {2} 239. +unroll for {2} 280. +unroll for {2} 376. +unroll for {2} 417. +unroll for {2} 513. +unroll for {2} 554. +unroll for {2} 650. + +rcondt {2} 105; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 112; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 118; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 124; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 130; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 238; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 244; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 250; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 256; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 262; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 370; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 376; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 382; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 388; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 394; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 502; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 508; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 514; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 520; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 526; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 634; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 640; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 646; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 652; first by move => *; wp;skip;auto => />;smt(). +rcondf {2} 658; first by move => *; wp;skip;auto => />;smt(). + +wp;skip. + +move => &1 &2. + +move => H. + +simplify. + +split; last first. + +apply Array25.ext_eq. + +move => x Hx. + +case (x = 0); first by auto => />;smt( @W64). +case (x = 1); first by auto => />;smt( @W64). +case (x = 2); first by auto => />;smt( @W64). +case (x = 3); first by auto => />;smt( @W64). +case (x = 4); first by auto => />;smt( @W64). +case (x = 5); first by auto => />;smt( @W64). +case (x = 6); first by auto => />;smt( @W64). +case (x = 7); first by auto => />;smt( @W64). +case (x = 8); first by auto => />;smt( @W64). +case (x = 9); first by auto => />;smt( @W64). +case (x = 10); first by auto => />;smt( @W64). +case (x = 11); first by auto => />;smt( @W64). +case (x = 12); first by auto => />;smt( @W64). +case (x = 13); first by auto => />;smt( @W64). +case (x = 14); first by auto => />;smt( @W64). +case (x = 15); first by auto => />;smt( @W64). +case (x = 16); first by auto => />;smt( @W64). +case (x = 17); first by auto => />;smt( @W64). +case (x = 18); first by auto => />;smt( @W64). +case (x = 19); first by auto => />;smt( @W64). +case (x = 20); first by auto => />;smt( @W64). +case (x = 21); first by auto => />;smt( @W64). +case (x = 22); first by auto => />;smt( @W64). +case (x = 23); first by auto => />;smt( @W64). +case (x = 24); first by auto => />;smt( @W64). +by smt(). + +progress. smt(). smt. smt(). smt(). smt(). smt(). smt(). smt(). smt(). +smt(). smt(). smt(). smt(). smt(). smt(). smt(). smt(). + + +auto => />. + +progress. +rewrite to_uintD. smt(). smt(). smt(). smt(). + +rewrite (testsem (iotas{2} + (of_int 16)%W64)). +rewrite to_uintD. +rewrite (_ : (to_uint iotas{2} + to_uint ((of_int 16))%W64) %% W64.modulus %% 256 = (to_uint iotas{2} + to_uint ((of_int 16))%W64) %% 256). smt. +smt(). + +move : H8. +rewrite testsem. +rewrite to_uintD. +rewrite (_ : (to_uint iotas{2} + to_uint ((of_int 16))%W64) %% W64.modulus %% 256 = (to_uint iotas{2} + to_uint ((of_int 16))%W64) %% 256). smt. +smt(). + +auto => />. +progress. + +rewrite (testsem (iotas{2})). +smt(). + +move : H6. +rewrite testsem. +smt(). + +move : H12. +rewrite testsem => //= *. +move : H8; rewrite (_ : round_L = 24); first by smt(). +move => *. +have ir : (to_uint iotas{2} - round{1} * 8 + 24*8) %% 256 = 0. smt(). +rewrite (_ : iotas_R = W64.of_int (to_uint iotas{2} - round{1} * 8 + 24*8)). +smt(@W64). +smt(@W64 @W8). +qed. From 4649b906e77d8216cf0cee1f9f64784455cd29be Mon Sep 17 00:00:00 2001 From: Manuel Barbosa Date: Tue, 30 Apr 2019 13:30:46 +0100 Subject: [PATCH 368/525] Cleaning up --- proof/impl/perm/Array2.ec | 3 + proof/impl/perm/Array24.ec | 3 + proof/impl/perm/Array25.ec | 3 + proof/impl/perm/Array4.ec | 3 + proof/impl/perm/Array5.ec | 3 + proof/impl/perm/Array7.ec | 3 + proof/impl/perm/Array9.ec | 3 + proof/impl/perm/Array96.ec | 3 + proof/impl/perm/Ops.ec | 8 +- proof/impl/perm/WArray128.ec | 3 + proof/impl/perm/WArray160.ec | 3 + proof/impl/perm/WArray192.ec | 3 + proof/impl/perm/WArray200.ec | 3 + proof/impl/perm/WArray224.ec | 3 + proof/impl/perm/WArray288.ec | 3 + proof/impl/perm/WArray40.ec | 3 + proof/impl/perm/keccak_f1600_avx2.ec | 4 - proof/impl/perm/keccak_f1600_avx2_openssl.ec | 5 - .../perm/keccak_f1600_avx2_openssl_prevec.ec | 449 +---------- proof/impl/perm/keccak_f1600_ref.ec | 7 +- proof/impl/perm/keccak_f1600_ref_loop2.ec | 7 +- proof/impl/perm/keccak_f1600_ref_table.ec | 209 +++-- proof/impl/perm/keccak_f1600_scalar.ec | 5 - proof/impl/perm/keccak_f1600_scalar_table.ec | 762 ++---------------- 24 files changed, 249 insertions(+), 1252 deletions(-) create mode 100644 proof/impl/perm/Array2.ec create mode 100644 proof/impl/perm/Array24.ec create mode 100644 proof/impl/perm/Array25.ec create mode 100644 proof/impl/perm/Array4.ec create mode 100644 proof/impl/perm/Array5.ec create mode 100644 proof/impl/perm/Array7.ec create mode 100644 proof/impl/perm/Array9.ec create mode 100644 proof/impl/perm/Array96.ec create mode 100644 proof/impl/perm/WArray128.ec create mode 100644 proof/impl/perm/WArray160.ec create mode 100644 proof/impl/perm/WArray192.ec create mode 100644 proof/impl/perm/WArray200.ec create mode 100644 proof/impl/perm/WArray224.ec create mode 100644 proof/impl/perm/WArray288.ec create mode 100644 proof/impl/perm/WArray40.ec diff --git a/proof/impl/perm/Array2.ec b/proof/impl/perm/Array2.ec new file mode 100644 index 0000000..3a89b1c --- /dev/null +++ b/proof/impl/perm/Array2.ec @@ -0,0 +1,3 @@ +from Jasmin require import JArray. + +clone export PolyArray as Array2 with op size <- 2. diff --git a/proof/impl/perm/Array24.ec b/proof/impl/perm/Array24.ec new file mode 100644 index 0000000..8982b77 --- /dev/null +++ b/proof/impl/perm/Array24.ec @@ -0,0 +1,3 @@ +from Jasmin require import JArray. + +clone export PolyArray as Array24 with op size <- 24. diff --git a/proof/impl/perm/Array25.ec b/proof/impl/perm/Array25.ec new file mode 100644 index 0000000..30bcb17 --- /dev/null +++ b/proof/impl/perm/Array25.ec @@ -0,0 +1,3 @@ +from Jasmin require import JArray. + +clone export PolyArray as Array25 with op size <- 25. diff --git a/proof/impl/perm/Array4.ec b/proof/impl/perm/Array4.ec new file mode 100644 index 0000000..bc0e12e --- /dev/null +++ b/proof/impl/perm/Array4.ec @@ -0,0 +1,3 @@ +from Jasmin require import JArray. + +clone export PolyArray as Array4 with op size <- 4. diff --git a/proof/impl/perm/Array5.ec b/proof/impl/perm/Array5.ec new file mode 100644 index 0000000..8dc7b36 --- /dev/null +++ b/proof/impl/perm/Array5.ec @@ -0,0 +1,3 @@ +from Jasmin require import JArray. + +clone export PolyArray as Array5 with op size <- 5. diff --git a/proof/impl/perm/Array7.ec b/proof/impl/perm/Array7.ec new file mode 100644 index 0000000..33f6cc6 --- /dev/null +++ b/proof/impl/perm/Array7.ec @@ -0,0 +1,3 @@ +from Jasmin require import JArray. + +clone export PolyArray as Array7 with op size <- 7. diff --git a/proof/impl/perm/Array9.ec b/proof/impl/perm/Array9.ec new file mode 100644 index 0000000..8759457 --- /dev/null +++ b/proof/impl/perm/Array9.ec @@ -0,0 +1,3 @@ +from Jasmin require import JArray. + +clone export PolyArray as Array9 with op size <- 9. diff --git a/proof/impl/perm/Array96.ec b/proof/impl/perm/Array96.ec new file mode 100644 index 0000000..619dabe --- /dev/null +++ b/proof/impl/perm/Array96.ec @@ -0,0 +1,3 @@ +from Jasmin require import JArray. + +clone export PolyArray as Array96 with op size <- 96. diff --git a/proof/impl/perm/Ops.ec b/proof/impl/perm/Ops.ec index 2e5535a..8a77e34 100644 --- a/proof/impl/perm/Ops.ec +++ b/proof/impl/perm/Ops.ec @@ -1,12 +1,8 @@ require import List Int IntDiv CoreMap. from Jasmin require import JModel. - -clone export PolyArray as Array2 with op size <- 2. -clone export PolyArray as Array4 with op size <- 4. -clone export PolyArray as Array5 with op size <- 5. -clone export WArray as WArray128 with op size <- 128. -clone export WArray as WArray160 with op size <- 160. +require import Array2 Array4 Array5. +require import WArray128 WArray160. type t2u64 = W64.t Array2.t. type t4u64 = W64.t Array4.t. diff --git a/proof/impl/perm/WArray128.ec b/proof/impl/perm/WArray128.ec new file mode 100644 index 0000000..3c9d689 --- /dev/null +++ b/proof/impl/perm/WArray128.ec @@ -0,0 +1,3 @@ +from Jasmin require import JWord_array. + +clone export WArray as WArray128 with op size <- 128. diff --git a/proof/impl/perm/WArray160.ec b/proof/impl/perm/WArray160.ec new file mode 100644 index 0000000..05cce71 --- /dev/null +++ b/proof/impl/perm/WArray160.ec @@ -0,0 +1,3 @@ +from Jasmin require import JWord_array. + +clone export WArray as WArray160 with op size <- 160. diff --git a/proof/impl/perm/WArray192.ec b/proof/impl/perm/WArray192.ec new file mode 100644 index 0000000..c8564c5 --- /dev/null +++ b/proof/impl/perm/WArray192.ec @@ -0,0 +1,3 @@ +from Jasmin require import JWord_array. + +clone export WArray as WArray192 with op size <- 192. diff --git a/proof/impl/perm/WArray200.ec b/proof/impl/perm/WArray200.ec new file mode 100644 index 0000000..99b887c --- /dev/null +++ b/proof/impl/perm/WArray200.ec @@ -0,0 +1,3 @@ +from Jasmin require import JWord_array. + +clone export WArray as WArray200 with op size <- 200. diff --git a/proof/impl/perm/WArray224.ec b/proof/impl/perm/WArray224.ec new file mode 100644 index 0000000..f9d6745 --- /dev/null +++ b/proof/impl/perm/WArray224.ec @@ -0,0 +1,3 @@ +from Jasmin require import JWord_array. + +clone export WArray as WArray224 with op size <- 224. diff --git a/proof/impl/perm/WArray288.ec b/proof/impl/perm/WArray288.ec new file mode 100644 index 0000000..86ac7cc --- /dev/null +++ b/proof/impl/perm/WArray288.ec @@ -0,0 +1,3 @@ +from Jasmin require import JWord_array. + +clone export WArray as WArray288 with op size <- 288. diff --git a/proof/impl/perm/WArray40.ec b/proof/impl/perm/WArray40.ec new file mode 100644 index 0000000..003b6e2 --- /dev/null +++ b/proof/impl/perm/WArray40.ec @@ -0,0 +1,3 @@ +from Jasmin require import JWord_array. + +clone export WArray as WArray40 with op size <- 40. diff --git a/proof/impl/perm/keccak_f1600_avx2.ec b/proof/impl/perm/keccak_f1600_avx2.ec index 17ce758..2ae987b 100644 --- a/proof/impl/perm/keccak_f1600_avx2.ec +++ b/proof/impl/perm/keccak_f1600_avx2.ec @@ -1,15 +1,11 @@ require import List Int IntExtra IntDiv CoreMap. from Jasmin require import JModel. -(* require import Array7 Array9. require import WArray224 WArray288. -*) require import Keccak_f1600_avx2_openssl. -clone export PolyArray as Array7 with op size <- 9. - module Mavx2 = { proc keccak_f (state:W256.t Array7.t, _rhotates_left:W64.t, _rhotates_right:W64.t, _iotas:W64.t) : W256.t Array7.t = { diff --git a/proof/impl/perm/keccak_f1600_avx2_openssl.ec b/proof/impl/perm/keccak_f1600_avx2_openssl.ec index e428f84..da3a963 100644 --- a/proof/impl/perm/keccak_f1600_avx2_openssl.ec +++ b/proof/impl/perm/keccak_f1600_avx2_openssl.ec @@ -1,13 +1,8 @@ require import List Int IntExtra IntDiv CoreMap. from Jasmin require import JModel. -(* require import Array9. require import WArray288. -*) - -clone export PolyArray as Array9 with op size <- 9. -clone export WArray as WArray288 with op size <- 288. op x86_VPBLENDD_256 : W256.t -> W256.t -> W8.t -> W256.t. op x86_VPANDN_256 : W256.t -> W256.t -> W256.t. diff --git a/proof/impl/perm/keccak_f1600_avx2_openssl_prevec.ec b/proof/impl/perm/keccak_f1600_avx2_openssl_prevec.ec index 8bdc614..0b32a25 100644 --- a/proof/impl/perm/keccak_f1600_avx2_openssl_prevec.ec +++ b/proof/impl/perm/keccak_f1600_avx2_openssl_prevec.ec @@ -1,19 +1,12 @@ require import List Int IntExtra IntDiv CoreMap. from Jasmin require import JModel. -(* -require import Array9. +require import Array4 Array9 Array24 Array25 Array96. require import WArray288. -*) require import Keccak_f1600_ref_table. require import Keccak_f1600_ref. import Ops. -import Array24. -import Array25. - -clone export PolyArray as Array9 with op size <- 9. -clone export PolyArray as Array96 with op size <- 96. op x86_DEC_32 : W32.t -> (bool * bool * bool * bool * W32.t). @@ -636,42 +629,12 @@ swap {2} 46 -17. seq 9 29 : (#{/~state{1}}post /\ c{1} = W64.of_int 1 /\ equiv_states _A00{2} _A01{2} _A20{2} _A31{2} _A21{2} _A41{2} _A11{2} state0{1}). +do 13!(unroll for {1} ^while). + -unroll for {1} 4. -unroll for {1} 6. -unroll for {1} 23. -unroll for {1} 19. -unroll for {1} 45. -unroll for {1} 58. -unroll for {1} 70. -unroll for {1} 101. -unroll for {1} 102. -unroll for {1} 114. -unroll for {1} 126. -unroll for {1} 138. -unroll for {1} 150. inline *. -rcondt {2} 4; first by move => *; auto => />. -rcondf {2} 40; first by move => *; auto => />. -rcondt {2} 40; first by move => *; auto => />. -rcondf {2} 55; first by move => *; auto => />. -rcondf {2} 55; first by move => *; auto => />. -rcondt {2} 55; first by move => *; auto => />. -rcondf {2} 84; first by move => *; auto => />. -rcondf {2} 84; first by move => *; auto => />. -rcondf {2} 84; first by move => *; auto => />. -rcondt {2} 84; first by move => *; auto => />. -rcondf {2} 99; first by move => *; auto => />. -rcondf {2} 99; first by move => *; auto => />. -rcondf {2} 99; first by move => *; auto => />. -rcondf {2} 99; first by move => *; auto => />. -rcondf {2} 99; first by move => *; auto => />. -rcondf {2} 99; first by move => *; auto => />. -rcondf {2} 99; first by move => *; auto => />. -rcondt {2} 99; first by move => *; auto => />. -rcondt {2} 143; first by move => *; auto => />. -rcondf {2} 152; first by move => *; auto => />. -rcondt {2} 152; first by move => *; auto => />. +do !((rcondf {2} ^if; first by move => *; wp;skip;auto => />) || + (rcondt {2} ^if; first by move => *; wp;skip;auto => />)). wp;skip. move => &1 &2. @@ -685,45 +648,10 @@ inline Mreftable.rho Mreftable.pi. seq 11 22 : (#{/~ state{1}}post /\ c{1} = W64.of_int 1 /\ equiv_states_chi _A00{2} _T{2}.[1] _T{2}.[2] _T{2}.[3] _T{2}.[4] _T{2}.[5] _T{2}.[6] state0{1}). -unroll for {1} 3. -unroll for {1} 4. -unroll for {1} 41. -unroll for {1} 78. -unroll for {1} 115. -unroll for {1} 152. -unroll for {1} 192. -unroll for {1} 268. -unroll for {1} 269. -unroll for {1} 291. -unroll for {1} 313. -unroll for {1} 335. -unroll for {1} 357. - +do 13!(unroll for {1} ^while). inline *. - -rcondf {2} 88; first by auto => />. -rcondf {2} 88; first by auto => />. -rcondf {2} 88; first by auto => />. -rcondf {2} 88; first by auto => />. -rcondt {2} 88; first by auto => />. -rcondf {2} 96; first by auto => />. -rcondf {2} 96; first by auto => />. -rcondf {2} 96; first by auto => />. -rcondf {2} 96; first by auto => />. -rcondt {2} 96; first by auto => />. -rcondf {2} 125; first by auto => />. -rcondf {2} 125; first by auto => />. -rcondf {2} 125; first by auto => />. -rcondf {2} 125; first by auto => />. -rcondf {2} 125; first by auto => />. -rcondt {2} 125; first by auto => />. -rcondf {2} 133; first by auto => />. -rcondf {2} 133; first by auto => />. -rcondf {2} 133; first by auto => />. -rcondf {2} 133; first by auto => />. -rcondf {2} 133; first by auto => />. -rcondf {2} 133; first by auto => />. -rcondt {2} 133; first by auto => />. +do !((rcondf {2} ^if; first by move => *; wp;skip;auto => />) || + (rcondt {2} ^if; first by move => *; wp;skip;auto => />)). wp;skip. move => &1 &2. @@ -915,145 +843,10 @@ inline Mreftable.chi. seq 5 53 : (#{~state0{1}}pre /\ equiv_states _A00{2} _A01{2} _A20{2} _A31{2} _A21{2} _A41{2} _A11{2} state0{1}). -unroll for {1} 4. -unroll for {1} 5. -unroll for {1} 46. -unroll for {1} 58. -unroll for {1} 99. -unroll for {1} 111. -unroll for {1} 152. -unroll for {1} 164. -unroll for {1} 205. -unroll for {1} 217. -unroll for {1} 258. - +do 11!(unroll for {1} ^while). inline *. -rcondf {2} 4; first by auto => />. -rcondt {2} 4; first by auto => />. -rcondf {2} 20; first by auto => />. -rcondf {2} 20; first by auto => />. -rcondt {2} 20; first by auto => />. -rcondf {2} 29; first by auto => />. -rcondf {2} 29; first by auto => />. -rcondt {2} 29; first by auto => />. -rcondf {2} 38; first by auto => />. -rcondf {2} 38; first by auto => />. -rcondt {2} 38; first by auto => />. -rcondf {2} 47; first by auto => />. -rcondf {2} 47; first by auto => />. -rcondt {2} 47; first by auto => />. -rcondf {2} 56; first by auto => />. -rcondf {2} 56; first by auto => />. -rcondf {2} 56; first by auto => />. -rcondt {2} 56; first by auto => />. -rcondf {2} 65; first by auto => />. -rcondf {2} 65; first by auto => />. -rcondf {2} 65; first by auto => />. -rcondt {2} 65; first by auto => />. -rcondf {2} 74; first by auto => />. -rcondf {2} 74; first by auto => />. -rcondf {2} 74; first by auto => />. -rcondt {2} 74; first by auto => />. -rcondf {2} 83; first by auto => />. -rcondf {2} 83; first by auto => />. -rcondf {2} 83; first by auto => />. -rcondt {2} 83; first by auto => />. -rcondt {2} 92; first by auto => />. -rcondt {2} 101; first by auto => />. -rcondt {2} 110; first by auto => />. -rcondt {2} 119; first by auto => />. -rcondf {2} 142; first by auto => />. -rcondf {2} 142; first by auto => />. -rcondt {2} 142; first by auto => />. -rcondf {2} 151; first by auto => />. -rcondf {2} 151; first by auto => />. -rcondt {2} 151; first by auto => />. -rcondf {2} 167; first by auto => />. -rcondf {2} 167; first by auto => />. -rcondf {2} 167; first by auto => />. -rcondt {2} 167; first by auto => />. -rcondf {2} 176; first by auto => />. -rcondf {2} 176; first by auto => />. -rcondf {2} 176; first by auto => />. -rcondt {2} 176; first by auto => />. -rcondt {2} 192; first by auto => />. -rcondt {2} 201; first by auto => />. -rcondf {2} 223; first by auto => />. -rcondf {2} 223; first by auto => />. -rcondf {2} 223; first by auto => />. -rcondf {2} 223; first by auto => />. -rcondf {2} 223; first by auto => />. -rcondf {2} 223; first by auto => />. -rcondf {2} 223; first by auto => />. -rcondf {2} 223; first by auto => />. -rcondt {2} 223; first by auto => />. -rcondf {2} 232; first by auto => />. -rcondf {2} 232; first by auto => />. -rcondf {2} 232; first by auto => />. -rcondt {2} 232; first by auto => />. -rcondf {2} 240; first by auto => />. -rcondf {2} 240; first by auto => />. -rcondf {2} 240; first by auto => />. -rcondt {2} 240; first by auto => />. -rcondt {2} 249; first by auto => />. -rcondf {2} 265; first by auto => />. -rcondf {2} 265; first by auto => />. -rcondt {2} 265; first by auto => />. -rcondf {2} 274; first by auto => />. -rcondf {2} 274; first by auto => />. -rcondt {2} 274; first by auto => />. -rcondf {2} 283; first by auto => />. -rcondf {2} 283; first by auto => />. -rcondf {2} 283; first by auto => />. -rcondt {2} 283; first by auto => />. -rcondf {2} 292; first by auto => />. -rcondf {2} 292; first by auto => />. -rcondf {2} 292; first by auto => />. -rcondt {2} 292; first by auto => />. -rcondt {2} 301; first by auto => />. -rcondt {2} 310; first by auto => />. -rcondf {2} 332; first by auto => />. -rcondf {2} 332; first by auto => />. -rcondf {2} 332; first by auto => />. -rcondf {2} 332; first by auto => />. -rcondf {2} 332; first by auto => />. -rcondf {2} 332; first by auto => />. -rcondf {2} 332; first by auto => />. -rcondt {2} 332; first by auto => />. -rcondf {2} 340; first by auto => />. -rcondf {2} 340; first by auto => />. -rcondf {2} 340; first by auto => />. -rcondf {2} 340; first by auto => />. -rcondf {2} 340; first by auto => />. -rcondt {2} 340; first by auto => />. -rcondf {2} 348; first by auto => />. -rcondf {2} 348; first by auto => />. -rcondf {2} 348; first by auto => />. -rcondf {2} 348; first by auto => />. -rcondt {2} 348; first by auto => />. -rcondf {2} 356; first by auto => />. -rcondf {2} 356; first by auto => />. -rcondf {2} 356; first by auto => />. -rcondf {2} 356; first by auto => />. -rcondf {2} 356; first by auto => />. -rcondf {2} 356; first by auto => />. -rcondt {2} 356; first by auto => />. -rcondf {2} 365; first by auto => />. -rcondf {2} 365; first by auto => />. -rcondt {2} 365; first by auto => />. -rcondf {2} 374; first by auto => />. -rcondf {2} 374; first by auto => />. -rcondt {2} 374; first by auto => />. -rcondf {2} 383; first by auto => />. -rcondf {2} 383; first by auto => />. -rcondf {2} 383; first by auto => />. -rcondt {2} 383; first by auto => />. -rcondf {2} 392; first by auto => />. -rcondf {2} 392; first by auto => />. -rcondf {2} 392; first by auto => />. -rcondt {2} 392; first by auto => />. -rcondt {2} 401; first by auto => />. -rcondt {2} 410; first by auto => />. +do !((rcondf {2} ^if; first by move => *; wp;skip;auto => />) || + (rcondt {2} ^if; first by move => *; wp;skip;auto => />)). wp. skip. move => &1 &2. @@ -1145,41 +938,10 @@ swap {2} 46 -17. seq 9 29 : (#{/~state{1}}post /\ c{1} = constants{1}.[round{1}] /\ round{1} < 24 /\ equiv_states _A00{2} _A01{2} _A20{2} _A31{2} _A21{2} _A41{2} _A11{2} state0{1}). -unroll for {1} 4. -unroll for {1} 6. -unroll for {1} 23. -unroll for {1} 19. -unroll for {1} 45. -unroll for {1} 58. -unroll for {1} 70. -unroll for {1} 101. -unroll for {1} 102. -unroll for {1} 114. -unroll for {1} 126. -unroll for {1} 138. -unroll for {1} 150. +do 13!(unroll for {1} ^while). inline *. -rcondt {2} 4; first by move => *; auto => />. -rcondf {2} 40; first by move => *; auto => />. -rcondt {2} 40; first by move => *; auto => />. -rcondf {2} 55; first by move => *; auto => />. -rcondf {2} 55; first by move => *; auto => />. -rcondt {2} 55; first by move => *; auto => />. -rcondf {2} 84; first by move => *; auto => />. -rcondf {2} 84; first by move => *; auto => />. -rcondf {2} 84; first by move => *; auto => />. -rcondt {2} 84; first by move => *; auto => />. -rcondf {2} 99; first by move => *; auto => />. -rcondf {2} 99; first by move => *; auto => />. -rcondf {2} 99; first by move => *; auto => />. -rcondf {2} 99; first by move => *; auto => />. -rcondf {2} 99; first by move => *; auto => />. -rcondf {2} 99; first by move => *; auto => />. -rcondf {2} 99; first by move => *; auto => />. -rcondt {2} 99; first by move => *; auto => />. -rcondt {2} 143; first by move => *; auto => />. -rcondf {2} 152; first by move => *; auto => />. -rcondt {2} 152; first by move => *; auto => />. +do !((rcondf {2} ^if; first by move => *; wp;skip;auto => />) || + (rcondt {2} ^if; first by move => *; wp;skip;auto => />)). wp;skip. move => &1 &2. @@ -1193,45 +955,12 @@ inline Mreftable.rho Mreftable.pi. seq 11 22 : (#{/~ state{1}}post /\ c{1} = constants{1}.[round{1}] /\ round{1} < 24 /\ equiv_states_chi _A00{2} _T{2}.[1] _T{2}.[2] _T{2}.[3] _T{2}.[4] _T{2}.[5] _T{2}.[6] state0{1}). -unroll for {1} 3. -unroll for {1} 4. -unroll for {1} 41. -unroll for {1} 78. -unroll for {1} 115. -unroll for {1} 152. -unroll for {1} 192. -unroll for {1} 268. -unroll for {1} 269. -unroll for {1} 291. -unroll for {1} 313. -unroll for {1} 335. -unroll for {1} 357. +do 13!(unroll for {1} ^while). -inline *. -rcondf {2} 88; first by auto => />. -rcondf {2} 88; first by auto => />. -rcondf {2} 88; first by auto => />. -rcondf {2} 88; first by auto => />. -rcondt {2} 88; first by auto => />. -rcondf {2} 96; first by auto => />. -rcondf {2} 96; first by auto => />. -rcondf {2} 96; first by auto => />. -rcondf {2} 96; first by auto => />. -rcondt {2} 96; first by auto => />. -rcondf {2} 125; first by auto => />. -rcondf {2} 125; first by auto => />. -rcondf {2} 125; first by auto => />. -rcondf {2} 125; first by auto => />. -rcondf {2} 125; first by auto => />. -rcondt {2} 125; first by auto => />. -rcondf {2} 133; first by auto => />. -rcondf {2} 133; first by auto => />. -rcondf {2} 133; first by auto => />. -rcondf {2} 133; first by auto => />. -rcondf {2} 133; first by auto => />. -rcondf {2} 133; first by auto => />. -rcondt {2} 133; first by auto => />. +inline *. +do !((rcondf {2} ^if; first by move => *; wp;skip;auto => />) || + (rcondt {2} ^if; first by move => *; wp;skip;auto => />)). wp;skip. move => &1 &2. @@ -1249,7 +978,6 @@ split; first by rewrite /rhotates; smt(roln rol0). split; first by rewrite /rhotates; smt(roln rol0). split; first by rewrite /rhotates; smt(roln rol0). - split. rewrite H H0. move : H5 H6; rewrite -H2 => rl rr. @@ -1426,145 +1154,10 @@ inline Mreftable.chi. seq 5 53 : (#{~state0{1}}pre /\ equiv_states _A00{2} _A01{2} _A20{2} _A31{2} _A21{2} _A41{2} _A11{2} state0{1}). -unroll for {1} 4. -unroll for {1} 5. -unroll for {1} 46. -unroll for {1} 58. -unroll for {1} 99. -unroll for {1} 111. -unroll for {1} 152. -unroll for {1} 164. -unroll for {1} 205. -unroll for {1} 217. -unroll for {1} 258. - +do 11!(unroll for {1} ^while). inline *. -rcondf {2} 4; first by auto => />. -rcondt {2} 4; first by auto => />. -rcondf {2} 20; first by auto => />. -rcondf {2} 20; first by auto => />. -rcondt {2} 20; first by auto => />. -rcondf {2} 29; first by auto => />. -rcondf {2} 29; first by auto => />. -rcondt {2} 29; first by auto => />. -rcondf {2} 38; first by auto => />. -rcondf {2} 38; first by auto => />. -rcondt {2} 38; first by auto => />. -rcondf {2} 47; first by auto => />. -rcondf {2} 47; first by auto => />. -rcondt {2} 47; first by auto => />. -rcondf {2} 56; first by auto => />. -rcondf {2} 56; first by auto => />. -rcondf {2} 56; first by auto => />. -rcondt {2} 56; first by auto => />. -rcondf {2} 65; first by auto => />. -rcondf {2} 65; first by auto => />. -rcondf {2} 65; first by auto => />. -rcondt {2} 65; first by auto => />. -rcondf {2} 74; first by auto => />. -rcondf {2} 74; first by auto => />. -rcondf {2} 74; first by auto => />. -rcondt {2} 74; first by auto => />. -rcondf {2} 83; first by auto => />. -rcondf {2} 83; first by auto => />. -rcondf {2} 83; first by auto => />. -rcondt {2} 83; first by auto => />. -rcondt {2} 92; first by auto => />. -rcondt {2} 101; first by auto => />. -rcondt {2} 110; first by auto => />. -rcondt {2} 119; first by auto => />. -rcondf {2} 142; first by auto => />. -rcondf {2} 142; first by auto => />. -rcondt {2} 142; first by auto => />. -rcondf {2} 151; first by auto => />. -rcondf {2} 151; first by auto => />. -rcondt {2} 151; first by auto => />. -rcondf {2} 167; first by auto => />. -rcondf {2} 167; first by auto => />. -rcondf {2} 167; first by auto => />. -rcondt {2} 167; first by auto => />. -rcondf {2} 176; first by auto => />. -rcondf {2} 176; first by auto => />. -rcondf {2} 176; first by auto => />. -rcondt {2} 176; first by auto => />. -rcondt {2} 192; first by auto => />. -rcondt {2} 201; first by auto => />. -rcondf {2} 223; first by auto => />. -rcondf {2} 223; first by auto => />. -rcondf {2} 223; first by auto => />. -rcondf {2} 223; first by auto => />. -rcondf {2} 223; first by auto => />. -rcondf {2} 223; first by auto => />. -rcondf {2} 223; first by auto => />. -rcondf {2} 223; first by auto => />. -rcondt {2} 223; first by auto => />. -rcondf {2} 232; first by auto => />. -rcondf {2} 232; first by auto => />. -rcondf {2} 232; first by auto => />. -rcondt {2} 232; first by auto => />. -rcondf {2} 240; first by auto => />. -rcondf {2} 240; first by auto => />. -rcondf {2} 240; first by auto => />. -rcondt {2} 240; first by auto => />. -rcondt {2} 249; first by auto => />. -rcondf {2} 265; first by auto => />. -rcondf {2} 265; first by auto => />. -rcondt {2} 265; first by auto => />. -rcondf {2} 274; first by auto => />. -rcondf {2} 274; first by auto => />. -rcondt {2} 274; first by auto => />. -rcondf {2} 283; first by auto => />. -rcondf {2} 283; first by auto => />. -rcondf {2} 283; first by auto => />. -rcondt {2} 283; first by auto => />. -rcondf {2} 292; first by auto => />. -rcondf {2} 292; first by auto => />. -rcondf {2} 292; first by auto => />. -rcondt {2} 292; first by auto => />. -rcondt {2} 301; first by auto => />. -rcondt {2} 310; first by auto => />. -rcondf {2} 332; first by auto => />. -rcondf {2} 332; first by auto => />. -rcondf {2} 332; first by auto => />. -rcondf {2} 332; first by auto => />. -rcondf {2} 332; first by auto => />. -rcondf {2} 332; first by auto => />. -rcondf {2} 332; first by auto => />. -rcondt {2} 332; first by auto => />. -rcondf {2} 340; first by auto => />. -rcondf {2} 340; first by auto => />. -rcondf {2} 340; first by auto => />. -rcondf {2} 340; first by auto => />. -rcondf {2} 340; first by auto => />. -rcondt {2} 340; first by auto => />. -rcondf {2} 348; first by auto => />. -rcondf {2} 348; first by auto => />. -rcondf {2} 348; first by auto => />. -rcondf {2} 348; first by auto => />. -rcondt {2} 348; first by auto => />. -rcondf {2} 356; first by auto => />. -rcondf {2} 356; first by auto => />. -rcondf {2} 356; first by auto => />. -rcondf {2} 356; first by auto => />. -rcondf {2} 356; first by auto => />. -rcondf {2} 356; first by auto => />. -rcondt {2} 356; first by auto => />. -rcondf {2} 365; first by auto => />. -rcondf {2} 365; first by auto => />. -rcondt {2} 365; first by auto => />. -rcondf {2} 374; first by auto => />. -rcondf {2} 374; first by auto => />. -rcondt {2} 374; first by auto => />. -rcondf {2} 383; first by auto => />. -rcondf {2} 383; first by auto => />. -rcondf {2} 383; first by auto => />. -rcondt {2} 383; first by auto => />. -rcondf {2} 392; first by auto => />. -rcondf {2} 392; first by auto => />. -rcondf {2} 392; first by auto => />. -rcondt {2} 392; first by auto => />. -rcondt {2} 401; first by auto => />. -rcondt {2} 410; first by auto => />. +do !((rcondf {2} ^if; first by move => *; wp;skip;auto => />) || + (rcondt {2} ^if; first by move => *; wp;skip;auto => />)). wp. skip. move => &1 &2. diff --git a/proof/impl/perm/keccak_f1600_ref.ec b/proof/impl/perm/keccak_f1600_ref.ec index fc81185..1fba08c 100644 --- a/proof/impl/perm/keccak_f1600_ref.ec +++ b/proof/impl/perm/keccak_f1600_ref.ec @@ -1,14 +1,11 @@ require import List Int IntExtra IntDiv CoreMap. from Jasmin require import JModel. -(* require import Array5 Array24 Array25. -require import WArray40 WArray192 WArray200. *) +require import Array5 Array24 Array25. +require import WArray40 WArray192 WArray200. require import Ops. -clone import PolyArray as Array25 with op size <- 25. -clone import PolyArray as Array24 with op size <- 24. - op x86_ROL_64 : W64.t -> W8.t -> bool * bool * W64.t. diff --git a/proof/impl/perm/keccak_f1600_ref_loop2.ec b/proof/impl/perm/keccak_f1600_ref_loop2.ec index 30cf979..e7873d0 100644 --- a/proof/impl/perm/keccak_f1600_ref_loop2.ec +++ b/proof/impl/perm/keccak_f1600_ref_loop2.ec @@ -1,15 +1,12 @@ require import List Int IntExtra IntDiv CoreMap. from Jasmin require import JModel. -(* require import Array5 Array24 Array25. -require import WArray40 WArray192 WArray200. *) + require import Array5 Array24 Array25. +require import WArray40 WArray192 WArray200. require import Keccak_f1600_ref_table. import Keccak_f1600_ref. import Ops. -import Array24. -import Array25. -import Array5. module Mrefloop2 = { include Mreftable [-permute] diff --git a/proof/impl/perm/keccak_f1600_ref_table.ec b/proof/impl/perm/keccak_f1600_ref_table.ec index ad14bb9..11aa491 100644 --- a/proof/impl/perm/keccak_f1600_ref_table.ec +++ b/proof/impl/perm/keccak_f1600_ref_table.ec @@ -46,119 +46,111 @@ module RhotatesTable = { equiv rhotates_table_corr : RhotatesAlgo.keccakRhoOffsets ~ RhotatesTable.keccakRhoOffsets : - ={arg} ==> ={res} . + ={arg} /\ 0 <= i{1} < 25 ==> ={res} . proc. unroll for {1} 5. case (i{1} = 0). -rcondf {1} 5; first by move => *; auto => />. -rcondf {1} 9; first by move => *; auto => />. -rcondf {1} 13; first by move => *; auto => />. -rcondf {1} 17; first by move => *; auto => />. -rcondf {1} 21; first by move => *; auto => />. -rcondf {1} 25; first by move => *; auto => />. -rcondf {1} 29; first by move => *; auto => />. -rcondf {1} 33; first by move => *; auto => />. -rcondf {1} 37; first by move => *; auto => />. -rcondf {1} 41; first by move => *; auto => />. -rcondf {1} 45; first by move => *; auto => />. -rcondf {1} 49; first by move => *; auto => />. -rcondf {1} 53; first by move => *; auto => />. -rcondf {1} 57; first by move => *; auto => />. -rcondf {1} 61; first by move => *; auto => />. -rcondf {1} 65; first by move => *; auto => />. -rcondf {1} 69; first by move => *; auto => />. -rcondf {1} 73; first by move => *; auto => />. -rcondf {1} 77; first by move => *; auto => />. -rcondf {1} 81; first by move => *; auto => />. -rcondf {1} 85; first by move => *; auto => />. -rcondf {1} 89; first by move => *; auto => />. -rcondf {1} 93; first by move => *; auto => />. -rcondf {1} 97; first by move => *; auto => />. -by auto => />. +do !((rcondt {1} ^if; first by move => *; auto => />) || + (rcondf {1} ^if; first by move => *; auto => />)); auto => />. + +case (i{1} = 1). +do !((rcondt {1} ^if; first by move => *; auto => />) || + (rcondf {1} ^if; first by move => *; auto => />)); auto => />. case (i{1} = 2). -rcondf {1} 5; first by move => *; auto => />. -rcondf {1} 9; first by move => *; auto => />. -rcondf {1} 13; first by move => *; auto => />. -rcondf {1} 17; first by move => *; auto => />. -rcondf {1} 21; first by move => *; auto => />. -rcondf {1} 25; first by move => *; auto => />. -rcondf {1} 29; first by move => *; auto => />. -rcondf {1} 33; first by move => *; auto => />. -rcondf {1} 37; first by move => *; auto => />. -rcondf {1} 41; first by move => *; auto => />. -rcondf {1} 45; first by move => *; auto => />. -rcondf {1} 49; first by move => *; auto => />. -rcondf {1} 53; first by move => *; auto => />. -rcondf {1} 57; first by move => *; auto => />. -rcondf {1} 61; first by move => *; auto => />. -rcondf {1} 65; first by move => *; auto => />. -rcondf {1} 69; first by move => *; auto => />. -rcondf {1} 73; first by move => *; auto => />. -rcondt {1} 77; first by move => *; auto => />. -rcondf {1} 82; first by move => *; auto => />. -rcondf {1} 86; first by move => *; auto => />. -rcondf {1} 90; first by move => *; auto => />. -rcondf {1} 94; first by move => *; auto => />. -rcondf {1} 98; first by move => *; auto => />. -by auto => />. +do !((rcondt {1} ^if; first by move => *; auto => />) || + (rcondf {1} ^if; first by move => *; auto => />)); auto => />. case (i{1} = 3). -rcondf {1} 5; first by move => *; auto => />. -rcondf {1} 9; first by move => *; auto => />. -rcondf {1} 13; first by move => *; auto => />. -rcondf {1} 17; first by move => *; auto => />. -rcondf {1} 21; first by move => *; auto => />. -rcondf {1} 25; first by move => *; auto => />. -rcondt {1} 29; first by move => *; auto => />. -rcondf {1} 34; first by move => *; auto => />. -rcondf {1} 38; first by move => *; auto => />. -rcondf {1} 42; first by move => *; auto => />. -rcondf {1} 46; first by move => *; auto => />. -rcondf {1} 50; first by move => *; auto => />. -rcondf {1} 54; first by move => *; auto => />. -rcondf {1} 58; first by move => *; auto => />. -rcondf {1} 62; first by move => *; auto => />. -rcondf {1} 66; first by move => *; auto => />. -rcondf {1} 70; first by move => *; auto => />. -rcondf {1} 74; first by move => *; auto => />. -rcondf {1} 78; first by move => *; auto => />. -rcondf {1} 82; first by move => *; auto => />. -rcondf {1} 86; first by move => *; auto => />. -rcondf {1} 90; first by move => *; auto => />. -rcondf {1} 94; first by move => *; auto => />. -rcondf {1} 98; first by move => *; auto => />. -by auto => />. +do !((rcondt {1} ^if; first by move => *; auto => />) || + (rcondf {1} ^if; first by move => *; auto => />)); auto => />. case (i{1} = 4). -rcondf {1} 5; first by move => *; auto => />. -rcondf {1} 9; first by move => *; auto => />. -rcondf {1} 13; first by move => *; auto => />. -rcondf {1} 17; first by move => *; auto => />. -rcondf {1} 21; first by move => *; auto => />. -rcondf {1} 25; first by move => *; auto => />. -rcondf {1} 29; first by move => *; auto => />. -rcondf {1} 33; first by move => *; auto => />. -rcondf {1} 37; first by move => *; auto => />. -rcondf {1} 41; first by move => *; auto => />. -rcondf {1} 45; first by move => *; auto => />. -rcondf {1} 49; first by move => *; auto => />. -rcondt {1} 53; first by move => *; auto => />. -rcondf {1} 58; first by move => *; auto => />. -rcondf {1} 62; first by move => *; auto => />. -rcondf {1} 66; first by move => *; auto => />. -rcondf {1} 70; first by move => *; auto => />. -rcondf {1} 74; first by move => *; auto => />. -rcondf {1} 78; first by move => *; auto => />. -rcondf {1} 82; first by move => *; auto => />. -rcondf {1} 86; first by move => *; auto => />. -rcondf {1} 90; first by move => *; auto => />. -rcondf {1} 94; first by move => *; auto => />. -rcondf {1} 98; first by move => *; auto => />. -by auto => />. +do !((rcondt {1} ^if; first by move => *; auto => />) || + (rcondf {1} ^if; first by move => *; auto => />)); auto => />. + +case (i{1} = 5). +do !((rcondt {1} ^if; first by move => *; auto => />) || + (rcondf {1} ^if; first by move => *; auto => />)); auto => />. + +case (i{1} = 6). +do !((rcondt {1} ^if; first by move => *; auto => />) || + (rcondf {1} ^if; first by move => *; auto => />)); auto => />. + +case (i{1} = 7). +do !((rcondt {1} ^if; first by move => *; auto => />) || + (rcondf {1} ^if; first by move => *; auto => />)); auto => />. + +case (i{1} = 8). +do !((rcondt {1} ^if; first by move => *; auto => />) || + (rcondf {1} ^if; first by move => *; auto => />)); auto => />. + +case (i{1} = 9). +do !((rcondt {1} ^if; first by move => *; auto => />) || + (rcondf {1} ^if; first by move => *; auto => />)); auto => />. + +case (i{1} = 10). +do !((rcondt {1} ^if; first by move => *; auto => />) || + (rcondf {1} ^if; first by move => *; auto => />)); auto => />. + +case (i{1} = 11). +do !((rcondt {1} ^if; first by move => *; auto => />) || + (rcondf {1} ^if; first by move => *; auto => />)); auto => />. + +case (i{1} = 12). +do !((rcondt {1} ^if; first by move => *; auto => />) || + (rcondf {1} ^if; first by move => *; auto => />)); auto => />. + +case (i{1} = 13). +do !((rcondt {1} ^if; first by move => *; auto => />) || + (rcondf {1} ^if; first by move => *; auto => />)); auto => />. + +case (i{1} = 14). +do !((rcondt {1} ^if; first by move => *; auto => />) || + (rcondf {1} ^if; first by move => *; auto => />)); auto => />. -admit. +case (i{1} = 15). +do !((rcondt {1} ^if; first by move => *; auto => />) || + (rcondf {1} ^if; first by move => *; auto => />)); auto => />. + +case (i{1} = 16). +do !((rcondt {1} ^if; first by move => *; auto => />) || + (rcondf {1} ^if; first by move => *; auto => />)); auto => />. + +case (i{1} = 17). +do !((rcondt {1} ^if; first by move => *; auto => />) || + (rcondf {1} ^if; first by move => *; auto => />)); auto => />. + +case (i{1} = 18). +do !((rcondt {1} ^if; first by move => *; auto => />) || + (rcondf {1} ^if; first by move => *; auto => />)); auto => />. + +case (i{1} = 19). +do !((rcondt {1} ^if; first by move => *; auto => />) || + (rcondf {1} ^if; first by move => *; auto => />)); auto => />. + +case (i{1} = 20). +do !((rcondt {1} ^if; first by move => *; auto => />) || + (rcondf {1} ^if; first by move => *; auto => />)); auto => />. + +case (i{1} = 21). +do !((rcondt {1} ^if; first by move => *; auto => />) || + (rcondf {1} ^if; first by move => *; auto => />)); auto => />. + +case (i{1} = 22). +do !((rcondt {1} ^if; first by move => *; auto => />) || + (rcondf {1} ^if; first by move => *; auto => />)); auto => />. + +case (i{1} = 23). +do !((rcondt {1} ^if; first by move => *; auto => />) || + (rcondf {1} ^if; first by move => *; auto => />)); auto => />. + +case (i{1} = 24). +do !((rcondt {1} ^if; first by move => *; auto => />) || + (rcondf {1} ^if; first by move => *; auto => />)); auto => />. + +by exfalso; smt(). qed. module Mreftable = { @@ -235,17 +227,18 @@ call (_: true); first by sim. call (_: true); first by sim. call (_: true); first by sim. call (_: true). -while (#post /\ ={a,x}). +while (#post /\ ={a,x} /\ 0 <= x{1} <= 5). wp. -while (#post /\ ={a,x,y}). +while (#post /\ ={a,x,y} /\ 0 <= x{1} <5 /\ 0 <=y{1} <= 5). wp. call (rhotates_table_corr). -call(_:true); first by sim. +call(_: ={arg} /\ 0<=x{1} <5 /\ 0<=y{1} <5 ==> ={res} /\ 0 <= res{1} < 25). +by proc; inline *; auto => />;smt(). -by auto => />. -by auto => />. -by auto => />. +by auto => />;smt(). +by auto => />;smt(). +by auto => />;smt(). call(_:true); first by sim. by auto => />. diff --git a/proof/impl/perm/keccak_f1600_scalar.ec b/proof/impl/perm/keccak_f1600_scalar.ec index f71425d..6a690b3 100644 --- a/proof/impl/perm/keccak_f1600_scalar.ec +++ b/proof/impl/perm/keccak_f1600_scalar.ec @@ -1,16 +1,11 @@ require import List Int IntExtra IntDiv CoreMap. from Jasmin require import JModel. -(* require import Array5 Array25. require import WArray40 WArray200. -*) require import Keccak_f1600_ref. import Ops. -import Array25. -import Array5. -import Array24. op x86_TEST_8 : W8.t -> W8.t -> bool * bool * bool * bool * bool. diff --git a/proof/impl/perm/keccak_f1600_scalar_table.ec b/proof/impl/perm/keccak_f1600_scalar_table.ec index c63b415..02d0595 100644 --- a/proof/impl/perm/keccak_f1600_scalar_table.ec +++ b/proof/impl/perm/keccak_f1600_scalar_table.ec @@ -1,18 +1,14 @@ require import List Int IntExtra IntDiv CoreMap. from Jasmin require import JModel. -(* require import Array5 Array25. require import WArray40 WArray200. -*) require import Keccak_f1600_scalar. require import Keccak_f1600_ref. require import Keccak_f1600_ref_table. require import Keccak_f1600_ref_loop2. import Ops. -import Array25. -import Array5. import Array24. module Mscalarrho = { @@ -193,281 +189,58 @@ module Mscalartable = { } }. -equiv scalartable : - Mscalarrho.keccak_f ~ Mscalartable.keccak_f : - ={Glob.mem,arg} ==> ={res}. +equiv rol_sum : + Mscalarrho.rol_sum ~ Mscalartable.rol_sum : + ={arg} /\ 0 <= offset{1} < 5 ==> ={res}. proc. -wp. -while (={Glob.mem,zf,_A,_R,iotas}). -wp. -call (_: ={Glob.mem}). -call (_:true); first by sim. -call (_:true). -while (={j,_C,_A,_D,offset}). -wp. -call (_:true); first by sim. -inline Mscalartable.rhotates Mscalarrho.rhotates. -wp. -call(rhotates_table_corr). -call (_:true); first by sim. -by auto => />. -by auto => />. - -call (_:true); first by sim. -call (_:true). -while (={j,_C,_A,_D,offset}). -wp. -call (_:true); first by sim. -inline Mscalartable.rhotates Mscalarrho.rhotates. -wp. -call(rhotates_table_corr). -call (_:true); first by sim. -by auto => />. -by auto => />. - -call (_:true); first by sim. -call (_:true). -while (={j,_C,_A,_D,offset}). -wp. -call (_:true); first by sim. -inline Mscalartable.rhotates Mscalarrho.rhotates. -wp. -call(rhotates_table_corr). -call (_:true); first by sim. -by auto => />. -by auto => />. - -call (_:true); first by sim. -call (_:true). -while (={j,_C,_A,_D,offset}). -wp. -call (_:true); first by sim. -inline Mscalartable.rhotates Mscalarrho.rhotates. -wp. -call(rhotates_table_corr). -call (_:true); first by sim. -by auto => />. -by auto => />. - -call (_:true); first by sim. -call (_:true). -while (={j,_C,_A,_D,offset}). -wp. -call (_:true); first by sim. -inline Mscalartable.rhotates Mscalarrho.rhotates. -wp. -call(rhotates_table_corr). -call (_:true); first by sim. -by auto => />. -by auto => />. - -call (_:true); first by sim. -call (_:true); first by sim. -by auto => />. - -call (_: ={Glob.mem}). -call (_:true); first by sim. -call (_:true). -while (={j,_C,_A,_D,offset}). -wp. -call (_:true); first by sim. -inline Mscalartable.rhotates Mscalarrho.rhotates. -wp. -call(rhotates_table_corr). -call (_:true); first by sim. -by auto => />. -by auto => />. - -call (_:true); first by sim. -call (_:true). -while (={j,_C,_A,_D,offset}). -wp. -call (_:true); first by sim. -inline Mscalartable.rhotates Mscalarrho.rhotates. -wp. -call(rhotates_table_corr). -call (_:true); first by sim. -by auto => />. -by auto => />. - -call (_:true); first by sim. -call (_:true). -while (={j,_C,_A,_D,offset}). +while (={j,_C,_A,_D,offset} /\ 0 <= j{1} <= 5 /\ 0 <= offset{1} < 5). wp. call (_:true); first by sim. inline Mscalartable.rhotates Mscalarrho.rhotates. wp. call(rhotates_table_corr). -call (_:true); first by sim. -by auto => />. -by auto => />. - -call (_:true); first by sim. -call (_:true). -while (={j,_C,_A,_D,offset}). -wp. -call (_:true); first by sim. -inline Mscalartable.rhotates Mscalarrho.rhotates. -wp. -call(rhotates_table_corr). -call (_:true); first by sim. -by auto => />. -by auto => />. - -call (_:true); first by sim. -call (_:true). -while (={j,_C,_A,_D,offset}). -wp. -call (_:true); first by sim. -inline Mscalartable.rhotates Mscalarrho.rhotates. -wp. -call(rhotates_table_corr). -call (_:true); first by sim. -by auto => />. -by auto => />. - -call (_:true); first by sim. -call (_:true); first by sim. -by auto => />. - -by auto => />. - -wp. - -call (_: ={Glob.mem}). -call (_:true); first by sim. -call (_:true). -while (={j,_C,_A,_D,offset}). -wp. -call (_:true); first by sim. -inline Mscalartable.rhotates Mscalarrho.rhotates. -wp. -call(rhotates_table_corr). -call (_:true); first by sim. -by auto => />. -by auto => />. - -call (_:true); first by sim. -call (_:true). -while (={j,_C,_A,_D,offset}). -wp. -call (_:true); first by sim. -inline Mscalartable.rhotates Mscalarrho.rhotates. -wp. -call(rhotates_table_corr). -call (_:true); first by sim. -by auto => />. -by auto => />. - -call (_:true); first by sim. -call (_:true). -while (={j,_C,_A,_D,offset}). -wp. -call (_:true); first by sim. -inline Mscalartable.rhotates Mscalarrho.rhotates. -wp. -call(rhotates_table_corr). -call (_:true); first by sim. -by auto => />. -by auto => />. - -call (_:true); first by sim. -call (_:true). -while (={j,_C,_A,_D,offset}). -wp. -call (_:true); first by sim. -inline Mscalartable.rhotates Mscalarrho.rhotates. -wp. -call(rhotates_table_corr). -call (_:true); first by sim. -by auto => />. -by auto => />. - -call (_:true); first by sim. -call (_:true). -while (={j,_C,_A,_D,offset}). -wp. -call (_:true); first by sim. -inline Mscalartable.rhotates Mscalarrho.rhotates. -wp. -call(rhotates_table_corr). -call (_:true); first by sim. -by auto => />. -by auto => />. +call (_: ={arg} /\ 0 <= x{1} < 5 /\ 0<=y{1} <5 ==> ={res} /\ 0<= res{1} <25). +proc. by auto => />;smt(). +by auto => />; smt(). +by auto => />; smt(). +qed. -call (_:true); first by sim. -call (_:true); first by sim. -by auto => />. -call (_: ={Glob.mem}). -call (_:true); first by sim. -call (_:true). -while (={j,_C,_A,_D,offset}). -wp. -call (_:true); first by sim. -inline Mscalartable.rhotates Mscalarrho.rhotates. -wp. -call(rhotates_table_corr). +equiv round2x : + Mscalarrho.round2x ~ Mscalartable.round2x : + ={Glob.mem,arg} ==> ={res}. +proc. call (_:true); first by sim. -by auto => />. -by auto => />. - +call (rol_sum). call (_:true); first by sim. -call (_:true). -while (={j,_C,_A,_D,offset}). -wp. +call (rol_sum). call (_:true); first by sim. -inline Mscalartable.rhotates Mscalarrho.rhotates. -wp. -call(rhotates_table_corr). +call (rol_sum). call (_:true); first by sim. -by auto => />. -by auto => />. - +call (rol_sum). call (_:true); first by sim. -call (_:true). -while (={j,_C,_A,_D,offset}). -wp. +call (rol_sum). call (_:true); first by sim. -inline Mscalartable.rhotates Mscalarrho.rhotates. -wp. -call(rhotates_table_corr). call (_:true); first by sim. by auto => />. -by auto => />. +qed. -call (_:true); first by sim. -call (_:true). -while (={j,_C,_A,_D,offset}). +equiv scalartable : + Mscalarrho.keccak_f ~ Mscalartable.keccak_f : + ={Glob.mem,arg} ==> ={res}. +proc. wp. -call (_:true); first by sim. -inline Mscalartable.rhotates Mscalarrho.rhotates. +while (={Glob.mem,zf,_A,_R,iotas}). wp. -call(rhotates_table_corr). -call (_:true); first by sim. -by auto => />. +call (round2x). +call (round2x). by auto => />. - -call (_:true); first by sim. -call (_:true). -while (={j,_C,_A,_D,offset}). -wp. -call (_:true); first by sim. -inline Mscalartable.rhotates Mscalarrho.rhotates. wp. -call(rhotates_table_corr). -call (_:true); first by sim. -by auto => />. -by auto => />. - -call (_:true); first by sim. -call (_:true); first by sim. -by auto => />. - +call (round2x). +call (round2x). by auto => />. qed. - op good_iotas (mem : global_mem_t, _iotas : int) = forall off, 0 <= off < 24 => loadW64 mem (_iotas + (off * 8)) = iotas.[off]. @@ -506,129 +279,36 @@ progress. by move : (Tass 0) => //=. sp. - inline Mreftable.theta. seq 7 2 : (#pre /\ a{1}=state0{1} /\ d{1} = _D{2}). - -inline *. - -sp 3 2. -seq 2 2 : (#{/~c1{1}}{~_C1{2}}pre /\ - c1{1} = _C1{2}). -unroll for {1} 2. -unroll for {1} 4. -unroll for {1} 17. -unroll for {1} 30. -unroll for {1} 43. -unroll for {1} 56. -unroll for {2} 2. -unroll for {2} 4. -unroll for {2} 15. -unroll for {2} 26. -unroll for {2} 37. -unroll for {2} 48. - +inline *;sp 3 2. +seq 2 2 : (#{/~c1{1}}{~_C1{2}}pre /\ c1{1} = _C1{2}). +do 6!(unroll for {1} ^while). +do 6!(unroll for {2} ^while). by auto => />. seq 0 0 : #{/~_C{2}}pre; first by auto => />. - -sp 0 3. - -wp. +sp 0 3;wp. unroll for {1} 2. unroll for {2} 2. - by auto => />. seq 8 11 : (#{/~state{1}}{~state0{1}}{~_A0{2}}{~_R0{2}}pre /\ state{1} = _R{2}). - inline *. +do 30!(unroll for {1} ^while). +do 10!(unroll for {2} ^while). -unroll for {1} 2. -unroll for {1} 3. -unroll for {1} 15. -unroll for {1} 27. -unroll for {1} 39. -unroll for {1} 51. -unroll for {1} 65. -unroll for {1} 66. -unroll for {1} 123. -unroll for {1} 180. -unroll for {1} 237. -unroll for {1} 294. -unroll for {1} 354. -unroll for {1} 430. -unroll for {1} 431. -unroll for {1} 468. -unroll for {1} 505. -unroll for {1} 542. -unroll for {1} 579. -unroll for {1} 619. -unroll for {1} 620. -unroll for {1} 706. -unroll for {1} 718. -unroll for {1} 804. -unroll for {1} 816. -unroll for {1} 902. -unroll for {1} 914. -unroll for {1} 1000. -unroll for {1} 1012. -unroll for {1} 1098. - - -unroll for {2} 6. -unroll for {2} 102. -unroll for {2} 143. -unroll for {2} 239. -unroll for {2} 280. -unroll for {2} 376. -unroll for {2} 417. -unroll for {2} 513. -unroll for {2} 554. -unroll for {2} 650. - - -rcondt {2} 105; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 112; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 118; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 124; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 130; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 238; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 244; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 250; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 256; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 262; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 370; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 376; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 382; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 388; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 394; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 502; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 508; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 514; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 520; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 526; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 634; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 640; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 646; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 652; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 658; first by move => *; wp;skip;auto => />;smt(). +do !((rcondt {2} ^if; first by move => *; wp;skip;auto => />) || + (rcondf {2} ^if; first by move => *; wp;skip;auto => />)). wp;skip. - move => &1 &2. - move => H. - simplify. - split; last first. - apply Array25.ext_eq. - move => x Hx. - case (x = 0); first by auto => />;smt( @W64). case (x = 1); first by auto => />;smt( @W64). case (x = 2); first by auto => />;smt( @W64). @@ -656,7 +336,7 @@ case (x = 23); first by auto => />;smt( @W64). case (x = 24); first by auto => />;smt( @W64). by smt(). -progress. smt(). smt. smt(). smt(). smt(). smt(). smt(). smt(). smt(). smt(). +progress; [ 1 : by smt() | 2: by move : H => [/ #] | 3..: by smt() ]. (* Second round *) @@ -676,123 +356,32 @@ move : (Tass 1) => //=. rewrite (_ : to_uint (iotas{2} + (of_int 8)%W64) = to_uint iotas{2} + 8). rewrite to_uintD. smt(@W64). by trivial. seq 8 4 : (#pre /\ a0{1}=state{1} /\ d0{1} = _D0{2} /\ _A1{2} = a0{1}). -inline *. - -sp 4 4. - -seq 2 2 : (#{/~c2{1}}{~_C1{2}}pre /\ - c2{1} = _C1{2}). -unroll for {1} 2. -unroll for {1} 4. -unroll for {1} 17. -unroll for {1} 30. -unroll for {1} 43. -unroll for {1} 56. -unroll for {2} 2. -unroll for {2} 4. -unroll for {2} 15. -unroll for {2} 26. -unroll for {2} 37. -unroll for {2} 48. - +inline *; sp 4 4. +seq 2 2 : (#{/~c2{1}}{~_C1{2}}pre /\ c2{1} = _C1{2}). +do 6!(unroll for {1} ^while). +do 6!(unroll for {2} ^while). by auto => />. -sp 0 3. - -wp. - +sp 0 3;wp. unroll for {1} 2. unroll for {2} 2. - by auto => />. seq 8 11 : (#{/~state{1}}{~_A1{2}}pre /\ state{1} = _A{2}). - inline *. +do 30!(unroll for {1} ^while). +do 10!(unroll for {2} ^while). -unroll for {1} 2. -unroll for {1} 3. -unroll for {1} 15. -unroll for {1} 27. -unroll for {1} 39. -unroll for {1} 51. -unroll for {1} 65. -unroll for {1} 66. -unroll for {1} 123. -unroll for {1} 180. -unroll for {1} 237. -unroll for {1} 294. -unroll for {1} 354. -unroll for {1} 430. -unroll for {1} 431. -unroll for {1} 468. -unroll for {1} 505. -unroll for {1} 542. -unroll for {1} 579. -unroll for {1} 619. -unroll for {1} 620. -unroll for {1} 706. -unroll for {1} 718. -unroll for {1} 804. -unroll for {1} 816. -unroll for {1} 902. -unroll for {1} 914. -unroll for {1} 1000. -unroll for {1} 1012. -unroll for {1} 1098. - - -unroll for {2} 6. -unroll for {2} 102. -unroll for {2} 143. -unroll for {2} 239. -unroll for {2} 280. -unroll for {2} 376. -unroll for {2} 417. -unroll for {2} 513. -unroll for {2} 554. -unroll for {2} 650. - -rcondt {2} 105; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 112; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 118; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 124; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 130; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 238; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 244; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 250; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 256; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 262; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 370; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 376; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 382; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 388; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 394; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 502; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 508; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 514; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 520; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 526; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 634; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 640; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 646; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 652; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 658; first by move => *; wp;skip;auto => />;smt(). +do !((rcondt {2} ^if; first by move => *; wp;skip;auto => />) || + (rcondf {2} ^if; first by move => *; wp;skip;auto => />)). wp;skip. - move => &1 &2. - move => H. - simplify. - split; last first. - apply Array25.ext_eq. - move => x Hx. - case (x = 0); first by auto => />;smt( @W64). case (x = 1); first by auto => />;smt( @W64). case (x = 2); first by auto => />;smt( @W64). @@ -820,9 +409,8 @@ case (x = 23); first by auto => />;smt( @W64). case (x = 24); first by auto => />;smt( @W64). by smt(). -progress. smt(). smt. smt(). smt(). smt(). smt(). smt(). smt(). smt(). -smt(). smt(). smt(). - +progress; [ 1 : by smt() | 2: by move : H => [/ #] | 3..: by smt() ]. + auto => />. progress. rewrite to_uintD. @@ -853,125 +441,31 @@ smt(). inline Mreftable.theta. seq 8 4 : (#pre /\ a{1}=state{1} /\ d{1} = _D{2} /\ _A0{2} = _A{2}). - -inline *. - -sp 4 4. -seq 2 2 : (#{/~c1{1}}{~_C1{2}}pre /\ - c1{1} = _C1{2}). -unroll for {1} 2. -unroll for {1} 4. -unroll for {1} 17. -unroll for {1} 30. -unroll for {1} 43. -unroll for {1} 56. -unroll for {2} 2. -unroll for {2} 4. -unroll for {2} 15. -unroll for {2} 26. -unroll for {2} 37. -unroll for {2} 48. - +inline *; sp 4 4. +seq 2 2 : (#{/~c1{1}}{~_C1{2}}pre /\ c1{1} = _C1{2}). +do 6!(unroll for {1} ^while). +do 6!(unroll for {2} ^while). by auto => />. seq 0 0 : #{/~_C{2}}pre; first by auto => />. - -sp 0 3. - -wp. - +sp 0 3;wp. unroll for {1} 2. unroll for {2} 2. - by auto => />. - seq 8 11 : (#{/~state{1}}{~state0{1}}{~_A0{2}}{~_R0{2}}pre /\ state{1} = _R{2}). - inline *. +do 30!(unroll for {1} ^while). +do 10!(unroll for {2} ^while). -unroll for {1} 2. -unroll for {1} 3. -unroll for {1} 15. -unroll for {1} 27. -unroll for {1} 39. -unroll for {1} 51. -unroll for {1} 65. -unroll for {1} 66. -unroll for {1} 123. -unroll for {1} 180. -unroll for {1} 237. -unroll for {1} 294. -unroll for {1} 354. -unroll for {1} 430. -unroll for {1} 431. -unroll for {1} 468. -unroll for {1} 505. -unroll for {1} 542. -unroll for {1} 579. -unroll for {1} 619. -unroll for {1} 620. -unroll for {1} 706. -unroll for {1} 718. -unroll for {1} 804. -unroll for {1} 816. -unroll for {1} 902. -unroll for {1} 914. -unroll for {1} 1000. -unroll for {1} 1012. -unroll for {1} 1098. - - -unroll for {2} 6. -unroll for {2} 102. -unroll for {2} 143. -unroll for {2} 239. -unroll for {2} 280. -unroll for {2} 376. -unroll for {2} 417. -unroll for {2} 513. -unroll for {2} 554. -unroll for {2} 650. - -rcondt {2} 105; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 112; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 118; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 124; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 130; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 238; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 244; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 250; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 256; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 262; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 370; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 376; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 382; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 388; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 394; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 502; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 508; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 514; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 520; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 526; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 634; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 640; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 646; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 652; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 658; first by move => *; wp;skip;auto => />;smt(). - +do !((rcondt {2} ^if; first by move => *; wp;skip;auto => />) || + (rcondf {2} ^if; first by move => *; wp;skip;auto => />)). wp;skip. - move => &1 &2. - move => H. - simplify. - split; last first. - apply Array25.ext_eq. - move => x Hx. - case (x = 0); first by auto => />;smt( @W64). case (x = 1); first by auto => />;smt( @W64). case (x = 2); first by auto => />;smt( @W64). @@ -999,18 +493,15 @@ case (x = 23); first by auto => />;smt( @W64). case (x = 24); first by auto => />;smt( @W64). by smt(). -progress. smt(). smt. smt(). smt(). smt(). smt(). smt(). smt(). smt(). smt(). smt(). smt(). smt(). smt(). smt(). +progress; [ 1 : by smt() | 2: by move : H => [/ #] | 3..: by smt() ]. (* Second round *) swap {2}[5..6] -4. seq 0 2 : #pre; first by auto => />. - swap {1} 2 -1. swap {2} [3..5] -2. -seq 1 3 : (#pre /\ - iota_00{2} = c0{1}). - +seq 1 3 : (#pre /\ iota_00{2} = c0{1}). inline *;wp;skip; rewrite /good_iotas /iotas; auto => />. move => &1 &2 bound1 bound2 Tass. progress. @@ -1023,124 +514,31 @@ smt(@W64). smt(). seq 8 4 : (#pre /\ a0{1}=state{1} /\ d0{1} = _D0{2} /\ _A1{2} = a0{1}). - -inline *. - -sp 4 4. - -seq 2 2 : (#{/~c2{1}}{~_C1{2}}pre /\ - c2{1} = _C1{2}). -unroll for {1} 2. -unroll for {1} 4. -unroll for {1} 17. -unroll for {1} 30. -unroll for {1} 43. -unroll for {1} 56. -unroll for {2} 2. -unroll for {2} 4. -unroll for {2} 15. -unroll for {2} 26. -unroll for {2} 37. -unroll for {2} 48. - +inline *;sp 4 4. +seq 2 2 : (#{/~c2{1}}{~_C1{2}}pre /\ c2{1} = _C1{2}). +do 6!(unroll for {1} ^while). +do 6!(unroll for {2} ^while). by auto => />. -sp 0 3. - -wp. - +sp 0 3;wp. unroll for {1} 2. unroll for {2} 2. - by auto => />. seq 8 11 : (#{/~state{1}}{~_A1{2}}pre /\ state{1} = _A{2}). - inline *. +do 30!(unroll for {1} ^while). +do 10!(unroll for {2} ^while). -unroll for {1} 2. -unroll for {1} 3. -unroll for {1} 15. -unroll for {1} 27. -unroll for {1} 39. -unroll for {1} 51. -unroll for {1} 65. -unroll for {1} 66. -unroll for {1} 123. -unroll for {1} 180. -unroll for {1} 237. -unroll for {1} 294. -unroll for {1} 354. -unroll for {1} 430. -unroll for {1} 431. -unroll for {1} 468. -unroll for {1} 505. -unroll for {1} 542. -unroll for {1} 579. -unroll for {1} 619. -unroll for {1} 620. -unroll for {1} 706. -unroll for {1} 718. -unroll for {1} 804. -unroll for {1} 816. -unroll for {1} 902. -unroll for {1} 914. -unroll for {1} 1000. -unroll for {1} 1012. -unroll for {1} 1098. - - -unroll for {2} 6. -unroll for {2} 102. -unroll for {2} 143. -unroll for {2} 239. -unroll for {2} 280. -unroll for {2} 376. -unroll for {2} 417. -unroll for {2} 513. -unroll for {2} 554. -unroll for {2} 650. - -rcondt {2} 105; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 112; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 118; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 124; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 130; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 238; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 244; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 250; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 256; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 262; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 370; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 376; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 382; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 388; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 394; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 502; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 508; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 514; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 520; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 526; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 634; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 640; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 646; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 652; first by move => *; wp;skip;auto => />;smt(). -rcondf {2} 658; first by move => *; wp;skip;auto => />;smt(). - +do !((rcondt {2} ^if; first by move => *; wp;skip;auto => />) || + (rcondf {2} ^if; first by move => *; wp;skip;auto => />)). wp;skip. - move => &1 &2. - move => H. - simplify. - split; last first. - apply Array25.ext_eq. - move => x Hx. - case (x = 0); first by auto => />;smt( @W64). case (x = 1); first by auto => />;smt( @W64). case (x = 2); first by auto => />;smt( @W64). @@ -1168,35 +566,27 @@ case (x = 23); first by auto => />;smt( @W64). case (x = 24); first by auto => />;smt( @W64). by smt(). -progress. smt(). smt. smt(). smt(). smt(). smt(). smt(). smt(). smt(). -smt(). smt(). smt(). smt(). smt(). smt(). smt(). smt(). - +progress; [ 1 : by smt() | 2: by move : H => [/ #] | 3..: by smt() ]. auto => />. progress. -rewrite to_uintD. smt(). smt(). smt(). smt(). - +rewrite to_uintD;smt(). +smt(). smt(). smt(). rewrite (testsem (iotas{2} + (of_int 16)%W64)). rewrite to_uintD. -rewrite (_ : (to_uint iotas{2} + to_uint ((of_int 16))%W64) %% W64.modulus %% 256 = (to_uint iotas{2} + to_uint ((of_int 16))%W64) %% 256). smt. -smt(). +rewrite (_ : (to_uint iotas{2} + to_uint ((of_int 16))%W64) %% W64.modulus %% 256 = (to_uint iotas{2} + to_uint ((of_int 16))%W64) %% 256). smt. smt(). move : H8. rewrite testsem. rewrite to_uintD. -rewrite (_ : (to_uint iotas{2} + to_uint ((of_int 16))%W64) %% W64.modulus %% 256 = (to_uint iotas{2} + to_uint ((of_int 16))%W64) %% 256). smt. -smt(). +rewrite (_ : (to_uint iotas{2} + to_uint ((of_int 16))%W64) %% W64.modulus %% 256 = (to_uint iotas{2} + to_uint ((of_int 16))%W64) %% 256). smt. smt(). auto => />. progress. - -rewrite (testsem (iotas{2})). -smt(). - +rewrite (testsem (iotas{2}));smt(). move : H6. -rewrite testsem. -smt(). +rewrite testsem;smt(). move : H12. rewrite testsem => //= *. From f653c2e8d515bc493286a4b28248356d7243cd94 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Thu, 2 May 2019 11:21:47 +0200 Subject: [PATCH 369/525] Fix theories Ops. --- proof/impl/perm/Ops.ec | 145 ++++++++++++++++++++++------------------- 1 file changed, 79 insertions(+), 66 deletions(-) diff --git a/proof/impl/perm/Ops.ec b/proof/impl/perm/Ops.ec index 8a77e34..e89e7c8 100644 --- a/proof/impl/perm/Ops.ec +++ b/proof/impl/perm/Ops.ec @@ -7,7 +7,6 @@ require import WArray128 WArray160. type t2u64 = W64.t Array2.t. type t4u64 = W64.t Array4.t. -print W64. module Ops = { proc itruncate_4u64_2u64(t : t4u64) : t2u64 = { return Array2.of_list witness [ t.[0]; t.[1] ]; @@ -33,10 +32,10 @@ module Ops = { proc iVPMULU_256 (x y:t4u64) : t4u64 = { var r : t4u64; - r.[0] <- x.[0] * y.[0]; - r.[1] <- x.[1] * y.[1]; - r.[2] <- x.[2] * y.[2]; - r.[3] <- x.[3] * y.[3]; + r.[0] <- mulu64 x.[0] y.[0]; + r.[1] <- mulu64 x.[1] y.[1]; + r.[2] <- mulu64 x.[2] y.[2]; + r.[3] <- mulu64 x.[3] y.[3]; return r; } @@ -226,19 +225,19 @@ module Ops = { proc iVPSRLV_4u64 (x: t4u64, y: t4u64) : t4u64 = { var r : t4u64; - r.[0] <- x.[0] `>>` W8.of_int (W64.to_uint y.[0]); - r.[1] <- x.[1] `>>` W8.of_int (W64.to_uint y.[1]); - r.[2] <- x.[2] `>>` W8.of_int (W64.to_uint y.[2]); - r.[3] <- x.[3] `>>` W8.of_int (W64.to_uint y.[3]); + r.[0] <- x.[0] `>>>` W64.to_uint y.[0]; + r.[1] <- x.[1] `>>>` W64.to_uint y.[1]; + r.[2] <- x.[2] `>>>` W64.to_uint y.[2]; + r.[3] <- x.[3] `>>>` W64.to_uint y.[3]; return r; } proc iVPSLLV_4u64 (x: t4u64, y: t4u64) : t4u64 = { var r : t4u64; - r.[0] <- x.[0] `<<` W8.of_int (W64.to_uint y.[0]); - r.[1] <- x.[1] `<<` W8.of_int (W64.to_uint y.[1]); - r.[2] <- x.[2] `<<` W8.of_int (W64.to_uint y.[2]); - r.[3] <- x.[3] `<<` W8.of_int (W64.to_uint y.[3]); + r.[0] <- x.[0] `<<<` W64.to_uint y.[0]; + r.[1] <- x.[1] `<<<` W64.to_uint y.[1]; + r.[2] <- x.[2] `<<<` W64.to_uint y.[2]; + r.[3] <- x.[3] `<<<` W64.to_uint y.[3]; return r; } @@ -397,13 +396,38 @@ module OpsV = { return x86_VPSLL_4u64 x y; } - proc iland4u64 (x y:vt4u64) : vt4u64 = { + proc iVPSRLV_4u64 (x: vt4u64, y: vt4u64) : vt4u64 = { + return x86_VPSRLV_4u64 x y; + } + + proc iVPSLLV_4u64 (x: vt4u64, y: vt4u64) : vt4u64 = { + return x86_VPSLLV_4u64 x y; + } + + proc iland4u64 (x y: vt4u64) : vt4u64 = { return x `&` y; } - proc ilor4u64 (x y:vt4u64) : vt4u64 = { + proc ilor4u64 (x y: vt4u64) : vt4u64 = { return x `|` y; } + + proc ilandn4u64(x y: vt4u64) : vt4u64 = { + return x86_VPANDN_256 x y; + } + + proc ilxor4u64(x y: vt4u64) : vt4u64 = { + return x `^` y; + } + + proc iVPBLENDD_256(x y:vt4u64, p : W8.t) : vt4u64 = { + return x86_VPBLENDD_256 x y p; + } + + proc iVPSHUFD_256 (x :vt4u64, p : W8.t) : vt4u64 = { + return x86_VPSHUFD_256 x p; + } + }. op is2u64 (x : t2u64) (xv: vt2u64) = xv = W2u64.pack2 [x.[0]; x.[1]]. @@ -419,7 +443,7 @@ proof. congr; apply W128.wordP => i hi. rewrite W128.of_intwE hi W2u64.pack2wE 1:// /=. rewrite /int_bit /= modz_mod. - have /= -> := modz_pow2_div 128 i; 1,2: admit. (* smt(W256.to_uint_cmp) + have /= -> := modz_pow2_div 128 i; 1:smt(). rewrite (modz_dvd_pow 1 (128 - i) _ 2) 1:/# /=. have -> : (to_uint (pack4 [t{1}.[0]; t{1}.[1]; t{1}.[2]; t{1}.[3]]) %/ (IntExtra.(^) 2 i) %% 2 <> 0) = (pack4 [t{1}.[0]; t{1}.[1]; t{1}.[2]; t{1}.[3]]).[i]. @@ -430,7 +454,7 @@ proof. + by rewrite divz_small 1:/#. have -> // : i %/ 64 = 1. have -> : i = (i -64) + 1 * 64 by done. - rewrite divzMDr 1://; smt(divz_small).*) + rewrite divzMDr 1://; smt(divz_small). qed. op is4u64_5 (x:t4u64 Array5.t) (xv:vt4u64 Array5.t) = @@ -510,7 +534,7 @@ equiv eq_iVPBROADCAST_4u64 : Ops.iVPBROADCAST_4u64 ~ OpsV.iVPBROADCAST_4u64 : ={ proof. by proc => /=;wp;skip;rewrite /is4u64. qed. equiv eq_iVPMULU_256 : Ops.iVPMULU_256 ~ OpsV.iVPMULU_256 : is4u64 x{1} x{2} /\ is4u64 y{1} y{2} ==> is4u64 res{1} res{2}. -proof. by admit. qed. (* proc;wp;skip;rewrite /is4u64 => /> &1; rewrite /x86_VPMULU_256. qed.*) +proof. by proc;wp;skip;rewrite /is4u64 => /> &1; rewrite /x86_VPMULU_256. qed. equiv eq_ivadd64u256: Ops.ivadd64u256 ~ OpsV.ivadd64u256 : is4u64 x{1} x{2} /\ is4u64 y{1} y{2} ==> is4u64 res{1} res{2}. proof. by proc;wp;skip;rewrite /is4u64 /x86_VPADD_4u64. qed. @@ -530,43 +554,15 @@ proof. rewrite to_uintD_small heq 1:/#; smt (edivzP). qed. -lemma pack2_2u64_4u64 (w0 w1 w2 w3 :W64.t) : - pack2 [pack2 [w0; w1]; pack2 [w2; w3]] = - pack4 [w0; w1; w2; w3]. -proof. by apply W256.all_eq_eq;cbv W256.all_eq (%/) (%%). qed. - -lemma W4u64_bits128_0 (w:W4u64.Pack.pack_t) : - pack4_t w \bits128 0 = pack2 [w.[0]; w.[1]]. -proof. by admit. (*rewrite -{1}(W4u64.Pack.to_listK w) /= -pack2_2u64_4u64.*) qed. - -lemma W4u64_bits128_1 (w:W4u64.Pack.pack_t) : - pack4_t w \bits128 1 = pack2 [w.[2]; w.[3]]. -proof. by admit. (* rewrite -{1}(W4u64.Pack.to_listK w) /= -pack2_2u64_4u64.*) qed. - -hint simplify (W4u64_bits128_0, W4u64_bits128_1). - -lemma x86_VPERM2I128_4u64_spec_32 (v0 v1 v2 v3 : W64.t) (w0 w1 w2 w3: W64.t): - x86_VPERM2I128 (W4u64.pack4 [v0; v1; v2; v3]) (W4u64.pack4 [w0; w1; w2; w3]) (W8.of_int 32) = - W4u64.pack4 [v0; v1; w0; w1]. -proof. - by admit. (* cbv delta; rewrite !of_intwE; cbv delta; rewrite pack2_2u64_4u64. *) -qed. - -lemma x86_VPERM2I128_4u64_spec_49 (v0 v1 v2 v3 : W64.t) (w0 w1 w2 w3 : W64.t): - x86_VPERM2I128 (W4u64.pack4 [v0; v1; v2; v3]) (W4u64.pack4 [w0; w1; w2; w3]) (W8.of_int 49) = - W4u64.pack4 [v2; v3; w2; w3]. -proof. - (* by cbv delta; rewrite !of_intwE; cbv delta; rewrite pack2_2u64_4u64. *) admit. -qed. - -hint simplify (x86_VPERM2I128_4u64_spec_32, x86_VPERM2I128_4u64_spec_49). - equiv eq_iVPERM2I128 : Ops.iVPERM2I128 ~ OpsV.iVPERM2I128 : is4u64 x{1} x{2} /\ is4u64 y{1} y{2} /\ ={p} /\ (p{1} = W8.of_int 32 \/ p{1} = W8.of_int 49) ==> is4u64 res{1} res{2}. -proof. by proc; wp; skip; rewrite /is4u64 => /> &1 &2 [] ->. qed. +proof. + by proc; wp; skip; rewrite /is4u64 => /> &1 &2 [] ->; cbv delta; rewrite !of_intwE; cbv delta. +qed. -equiv eq_iVPERMQ : Ops.iVPERMQ ~ OpsV.iVPERMQ : is4u64 x{1} x{2} /\ ={p} /\ p{1} = W8.of_int 128 ==> is4u64 res{1} res{2}. -proof. admit. (* by proc; wp; skip; rewrite /is4u64. *) qed. +equiv eq_iVPERMQ : Ops.iVPERMQ ~ OpsV.iVPERMQ : is4u64 x{1} x{2} /\ ={p} /\ + (p{1} \in (map W8.of_int [128; 147; 78; 57; 141; 27; 114; 0; 30])) ==> is4u64 res{1} res{2}. +proof. proc; wp; skip; rewrite /is4u64 => /> &1 &2 [#] />. qed. lemma lsr_2u64 (w1 w2:W64.t) (x:int) : 0 <= x <= 64 => pack2 [w1; w2] `>>>` x = pack2 [(w1 `>>>` x) `|` (w2 `<<<` 64 - x); w2 `>>>` x]. @@ -595,28 +591,20 @@ proof. by apply W64.wordP => i hi; rewrite W64.shlwE hi. qed. equiv eq_iVPSRLDQ_256: Ops.iVPSRLDQ_256 ~ OpsV.iVPSRLDQ_256 : is4u64 x{1} x{2} /\ ={p} /\ (p{1} = W8.of_int 6 \/ p{1} = W8.of_int 8) ==> is4u64 res{1} res{2}. proof. - proc; wp; skip; rewrite /is4u64 => /> &1 &2 h. - rewrite -pack2_2u64_4u64 /x86_VPSRLDQ_256 /x86_VPSRLDQ_128 /=. - by case h => -> /=; cbv delta; rewrite !lsr_2u64 // pack2_2u64_4u64 //= !lsr_0. + proc; wp; skip; rewrite /is4u64 => /> &1 &2 h; cbv delta. + by case h => -> /=; rewrite !lsr_2u64 //= !lsr_0. qed. equiv eq_iVPUNPCKH_4u64: Ops.iVPUNPCKH_4u64 ~ OpsV.iVPUNPCKH_4u64 : is4u64 x{1} x{2} /\ is4u64 y{1} y{2} ==> is4u64 res{1} res{2}. -proof. - proc; wp; skip; rewrite /is4u64 => /> &1. - admit. (* by rewrite /x86_VPUNPCKH_4u64 /x86_VPUNPCKH_2u64 -!pack2_2u64_4u64 /=.*) -qed. +proof. by proc; wp; skip; rewrite /is4u64 => />; cbv delta. qed. equiv eq_iVPUNPCKL_4u64: Ops.iVPUNPCKL_4u64 ~ OpsV.iVPUNPCKL_4u64 : is4u64 x{1} x{2} /\ is4u64 y{1} y{2} ==> is4u64 res{1} res{2}. -proof. - proc; wp; skip; rewrite /is4u64 => /> &1. - admit. (* by rewrite /x86_VPUNPCKL_4u64 /x86_VPUNPCKL_2u64 -!pack2_2u64_4u64 /=. *) -qed. +proof. by proc; wp; skip; rewrite /is4u64 => />; cbv delta. qed. equiv eq_iVEXTRACTI128: Ops.iVEXTRACTI128 ~ OpsV.iVEXTRACTI128 : is4u64 x{1} x{2} /\ ={p} /\ (p{1} = W8.of_int 0 \/ p{2} = W8.of_int 1) ==> is2u64 res{1} res{2}. proof. - proc; wp; skip;rewrite /is4u64 /is2u64 /x86_VEXTRACTI128 => /> &1 &2 h /=. - rewrite -pack2_2u64_4u64 /b2i;case h => -> /= //. - by rewrite W8.of_intwE;cbv delta. + proc; wp; skip;rewrite /is4u64 /is2u64 /x86_VEXTRACTI128 => /> &1 &2 [] ->; cbv delta => //. + by rewrite W8.of_intwE. qed. equiv eq_iVPEXTR_64: Ops.iVPEXTR_64 ~ OpsV.iVPEXTR_64 : is2u64 x{1} x{2} /\ ={p} /\ (p{1} = W8.of_int 0 \/ p{2} = W8.of_int 1)==> res{1} = res{2}. @@ -633,3 +621,28 @@ proof. by proc; wp; skip; rewrite /is4u64. qed. equiv eq_ilor4u64: Ops.ilor4u64 ~ OpsV.ilor4u64 : is4u64 x{1} x{2} /\ is4u64 y{1} y{2} ==> is4u64 res{1} res{2}. proof. by proc; wp; skip; rewrite /is4u64. qed. + +equiv eq_ilandn4u64 : Ops.ilandn4u64 ~ OpsV.ilandn4u64 : is4u64 x{1} x{2} /\ is4u64 y{1} y{2} ==> is4u64 res{1} res{2}. +proof. by proc; wp; skip; rewrite /is4u64 => />; cbv delta. qed. + +equiv eq_ilxor4u64: Ops.ilxor4u64 ~ OpsV.ilxor4u64 : is4u64 x{1} x{2} /\ is4u64 y{1} y{2} ==> is4u64 res{1} res{2}. +proof. by proc; wp; skip; rewrite /is4u64. qed. + +equiv eq_iVPSRLV_4u64 : Ops.iVPSRLV_4u64 ~ OpsV.iVPSRLV_4u64 : is4u64 x{1} x{2} /\ is4u64 y{1} y{2} ==> is4u64 res{1} res{2}. +proof. by proc;wp; skip; rewrite /is4u64 => />; cbv delta. qed. + +equiv eq_iVPSLLV_4u64 : Ops.iVPSLLV_4u64 ~ OpsV.iVPSLLV_4u64 : is4u64 x{1} x{2} /\ is4u64 y{1} y{2} ==> is4u64 res{1} res{2}. +proof. by proc;wp; skip; rewrite /is4u64 => />; cbv delta. qed. + +equiv eq_iVPBLENDD_256 : Ops.iVPBLENDD_256 ~ OpsV.iVPBLENDD_256 : + is4u64 x{1} x{2} /\ is4u64 y{1} y{2} /\ ={p} /\ p{1} \in map W8.of_int [192; 3; 12; 48] + ==> + is4u64 res{1} res{2}. +proof. + by proc; wp; skip; rewrite /is4u64 => /> &1 &2 [#] />; + cbv delta; rewrite !W8.of_intwE /=; apply W8u32.allP;cbv delta. +qed. + +equiv eq_iVPSHUFD_256 : Ops.iVPSHUFD_256 ~ OpsV.iVPSHUFD_256 : + is4u64 x{1} x{2} /\ ={p} /\ p{1} = W8.of_int 78 ==> is4u64 res{1} res{2}. +proof. by proc; wp; skip; rewrite /is4u64 => /> &1; apply W8u32.allP;cbv delta. qed. From 784f717471cfdce0ea24eeb8a2326ca17424c7f9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jos=C3=A9=20Bacelar=20Almeida?= Date: Thu, 2 May 2019 12:01:12 +0100 Subject: [PATCH 370/525] upd --- proof/impl/Spec1600.ec | 792 ++++++++++++++++++++++++++++++++++------- 1 file changed, 664 insertions(+), 128 deletions(-) diff --git a/proof/impl/Spec1600.ec b/proof/impl/Spec1600.ec index ced1f15..b34a159 100644 --- a/proof/impl/Spec1600.ec +++ b/proof/impl/Spec1600.ec @@ -1,5 +1,5 @@ require import AllCore List Int IntDiv. -(*from Jasmin*) require import JArray JMemory JModel JUtils JWord JWord_array. +(*from Jasmin*) require import JArray JMemory JModel JWord JWord_array JUtils. op ratio :int. axiom ratio_bnds: 0 < ratio < 1600. @@ -116,10 +116,130 @@ have ->: (size l - n) %/ n = size l %/ n - 1. by apply eq_mkseq' => x Hx /=; rewrite drop_drop /#. qed. +(* a variant of [size_take] that is more convenient in some cases *) +lemma size_take' ['a] n (s: 'a list): + 0 <= n => size (take n s) = if n <= size s then n else size s. +admitted. + +print take_cat. +lemma take_cat' ['a] n (s1 s2: 'a list): + take n (s1++s2) = if n <= size s1 then take n s1 else take (n-size s1) s2. +admitted. + +lemma chunk_take_eq ['a] n (l:'a list): + 0 < n => + BitEncoding.BitChunking.chunk n l + = BitEncoding.BitChunking.chunk n (take (size l %/ n * n) l). +proof. +move=> Hn; rewrite /BitEncoding.BitChunking.chunk. +have ->: (size (take (size l %/ n * n) l) %/ n) = (size l %/ n). + rewrite size_take'; first smt(size_ge0). + by rewrite lez_floor 1:/# /= mulzK 1:/#. +apply eq_mkseq' => x Hx /=. +rewrite -{1}(cat_take_drop (size l %/ n * n)). +rewrite drop_cat size_take'; first smt(size_ge0). +rewrite lez_floor 1:/# /= mulzC StdOrder.IntOrder.ltr_pmul2r 1:/#. +move: (Hx); move=> [? ->] /=. +have E: n <= size (drop (x * n) (take (size l %/ n * n) l)). + rewrite size_drop 1:/# max_ler; last first. + rewrite size_take' 1:/# lez_floor 1:/# /= -Ring.IntID.mulrBl. + by rewrite -{1}mulz1 {1}mulzC StdOrder.IntOrder.ler_pmul2r // -ltzS /#. + rewrite size_take' 1:/# lez_floor 1:/# /=. + smt(size_ge0). +by rewrite take_cat' E. +qed. + lemma num0_block_suffix n k: num0 (k * ratio + n) = num0 n. proof. by rewrite /num0 -modzNm -addzA modzMDl modzNm. qed. +op chunkfillsize (n sz:int) = (-sz)%%n. + +lemma chunkfillsize_cmp n sz: + 0 < n => 0 <= chunkfillsize n sz < n. +proof. move=> Hn; rewrite /chunkfillsize; smt(modz_cmp). qed. +(* +lemma chunkfillsize_ge0 n sz: + 0 < n => + 0 <= chunkfillsize n sz. +proof. move=> Hn; rewrite /chunkfillsize; smt(modz_cmp). qed. +*) + +lemma chunkfillsizeP n sz k: + 0 < n => chunkfillsize n (n*k+sz) = chunkfillsize n sz. +proof. +move=> Hn; rewrite /chunkfillsize. +by rewrite -modzNm mulzC modzMDl modzNm. +qed. + +lemma chunkfillsizeE' n sz: + 0 < n => 0 < sz => chunkfillsize n sz = n - 1 - (sz-1) %% n +by move=> ??; rewrite /chunkfillsize modNz. + +lemma divz_minus1 m d: + 0 < d => 0 <= m => ! d %| m => (m-1) %/ d = m %/ d. +proof. +move=> Hd Hm Hdvd. +rewrite {1}(divz_eq m d) -addzA divzMDl 1:/#; ring. +rewrite divz_small //; apply bound_abs; split. + by move: Hdvd; rewrite dvdzE; smt(modz_cmp). +by move=> ?; smt(modz_cmp). +qed. + +lemma chunkfillsizeE n sz: + 0 < n => 0 <= sz => chunkfillsize n sz = if n %| sz then 0 else n - sz%%n. +proof. +move=> Hn Hsz'. +case: (n %| sz) . + rewrite /chunkfillsize dvdzE -modzNm => ->; smt(). +move=> ?. +have Hsz : 0 < sz by smt(dvdz0). +rewrite chunkfillsizeE' //. +have ->: n - 1 - (sz - 1) %% n = n - (1 + (sz - 1) %% n) by ring. +congr; congr. +by rewrite !modzE divz_minus1 //; ring. +qed. + +op chunkfill ['a] (d:'a) n l = l ++ nseq (chunkfillsize n (size l)) d. + +lemma dvd_chunkfill ['a] (d:'a) n l: + 0 < n => n %| size l => chunkfill d n l = l. +proof. +by move=> Hn Hsz; rewrite /chunkfill chunkfillsizeE // ?size_ge0 !Hsz /= cats0. +qed. + +lemma size_chunkfill ['a] (d:'a) n l: + 0 < n => + size (chunkfill d n l) = size l + chunkfillsize n (size l). +proof. +move=> Hn; rewrite /chunkfill size_cat size_nseq max_ler //. +smt(chunkfillsize_cmp). +qed. + +lemma chunkfillP ['a] (d:'a) n l: + 0 < n => + n %| size (chunkfill d n l). +proof. +move=> Hn; rewrite /chunkfill size_cat size_nseq max_ler; first smt(modz_cmp). +rewrite {1}(divz_eq (size l) n). +rewrite chunkfillsizeE // ?size_ge0. +case: (n %| size l) => ?. + by rewrite /= -divz_eq. +have ->: size l %/ n * n + size l %% n + (n - size l %% n) + = (size l %/ n + 1) * n by ring. +rewrite -{1}(mulz1 n) {1}mulzC; apply dvdz_mul. + by apply dvdz1. +by apply dvdzz. +qed. + +lemma chunkfillK ['a] (d:'a) n l: + 0 < n => + chunkfill d n (chunkfill d n l) = chunkfill d n l. +proof. +move=> Hn; rewrite {1}/chunkfill chunkfillsizeE // ?size_ge0. +by rewrite !chunkfillP //= cats0. +qed. + (* *) @@ -188,13 +308,20 @@ StdBigop.Bigint.BIA.big_mapT /(\o) /= StdBigop.Bigint.big_constz count_predT_eq. qed. op bits2w64L (bs: bool list) : W64.t list = - map W64.bits2w (BitEncoding.BitChunking.chunk 64 bs). + map W64.bits2w (BitEncoding.BitChunking.chunk 64 (chunkfill false 64 bs)). + +lemma size_bits2w64L bs: + size (bits2w64L bs) = (size bs + chunkfillsize 64 (size bs)) %/ 64. +proof. +rewrite /bits2w64L size_map BitEncoding.BitChunking.size_chunk //. +by rewrite size_chunkfill. +qed. lemma bits2w64LK bs: 64 %| size bs => w64L2bits (bits2w64L bs) = bs. proof. move=> Hsz. -rewrite /w64L2bits -map_comp. +rewrite /w64L2bits -map_comp dvd_chunkfill //. have : forall (x : bool list), x \in BitEncoding.BitChunking.chunk 64 bs => idfun x = (fun x => w2bits ((bits2w x))%W64) x. @@ -205,6 +332,13 @@ rewrite List.eq_in_map => <-. by rewrite map_id BitEncoding.BitChunking.chunkK // Hsz. qed. +lemma bits2w64LK' bs: + w64L2bits (bits2w64L bs) = chunkfill false 64 bs. +proof. +rewrite /bits2w64L -chunkfillK //. +by rewrite bits2w64LK ?chunkfillP // chunkfillK. +qed. + lemma w64L2bits_inj: injective w64L2bits. proof. rewrite /w64L2bits; elim. @@ -308,7 +442,8 @@ lemma bits2stateK bs: proof. move=> Hsz. rewrite /state2bits /bits2state Array25.of_listK. - by rewrite size_map BitEncoding.BitChunking.size_chunk // Hsz. + by rewrite size_bits2w64L Hsz chunkfillsizeE. +(* by rewrite size_map BitEncoding.BitChunking.size_chunk // Hsz.*) by rewrite bits2w64LK ?Hsz. qed. @@ -324,26 +459,25 @@ move=> st; apply state2bits_inj. by rewrite bits2stateK // size_state2bits. qed. - (* ratio expressed in 8 and 64bit words *) op ratio64 = ratio %/ 64. -op ratio8 = ratio64 * 8. +op ratio8 = 8*ratio64. -lemma ratio64P: ratio64 * 64 = ratio. -proof. by move: ratio_w64; rewrite /ratio64 dvdz_eq. qed. +lemma ratio64P: 64 * ratio64 = ratio. +proof. by move: ratio_w64; rewrite /ratio64 mulzC dvdz_eq. qed. lemma ratio64_bnds: 0 < ratio64 < 25. proof. move: ratio_bnds; rewrite -ratio64P /#. qed. -lemma ratio8P: ratio8 * 8 = ratio. -proof. by rewrite /ratio8 mulzA /= ratio64P. qed. +lemma ratio8P: 8 * ratio8 = ratio. +proof. by rewrite /ratio8 /= -mulzA ratio64P. qed. lemma ratio8_bnds: 0 < ratio8 < 200. proof. move: ratio_bnds; rewrite -ratio8P /#. qed. op capacity64 = 25-ratio64. -lemma capacity64P: capacity64 * 64 = c. -proof. by rewrite /capacity64 Ring.IntID.mulrBl /= ratio64P. qed. +lemma capacity64P: 64*capacity64 = c. +proof. by rewrite /capacity64 mulzC Ring.IntID.mulrBl /= mulzC ratio64P. qed. @@ -363,7 +497,7 @@ lemma block2w64LP st: proof. rewrite /block2w64L /state_r ofblockK. rewrite size_take ?ge0_r size_state2bits; smt(ratio_bnds). -by rewrite /state2bits -ratio64P mulzC take_w64L2bits w64L2bitsK. +by rewrite /state2bits -ratio64P take_w64L2bits w64L2bitsK. qed. op state_c (st: state) : capacity = @@ -376,7 +510,7 @@ lemma capacity2w64LP st: proof. rewrite /capacity2w64L /state_c ofcapacityK. rewrite size_drop ?ge0_r size_state2bits; smt(ratio_bnds). -by rewrite /state2bits -ratio64P mulzC drop_w64L2bits w64L2bitsK. +by rewrite /state2bits -ratio64P drop_w64L2bits w64L2bitsK. qed. lemma state_splitP st: @@ -425,9 +559,68 @@ print block2w64L. op take_block64 (m: W8.t list): W64.t list * W8.t list = (bits2w64L (w8L2bits (take ratio8 m)), drop ratio8 m). +lemma mkpad_ratio n: + 0 <= n => mkpad (r + n) = mkpad n. +proof. +move=> Hn; rewrite /mkpad /=; congr; congr. +by rewrite (num0_block_suffix n 1). +qed. + +lemma chunk_r (m: bool list): + size m = r => chunk m = [m]. +proof. +have Hr: r <> 0 by smt(ratio_bnds). +move=> Hsz; rewrite /chunk Hsz divzz /= Hr /b2i mkseq1 /= drop0. +by rewrite -Hsz take_size. +qed. + +lemma pad2blocksE m: + r <= size m => + pad2blocks m = mkblock (take r m) :: pad2blocks (drop r m). +proof. +move=> Hm. +have Hsz: size (take r m) = r by rewrite size_take; smt(ratio_bnds). +rewrite -{1}(cat_take_drop r) /pad2blocks /(\o) /bits2blocks /pad. +rewrite -catA chunk_cat ?Hsz ?dvdzz map_cat chunk_r //. +by rewrite /= size_cat Hsz mkpad_ratio; smt(size_ge0). +qed. + +lemma take_block64P mbits m: + ratio8 <= size m => + w64L2block (take_block64 m).`1 = head b0 (pad2blocks (w8L2bits m ++ mbits)). +proof. +move=> Hm. +have Hsz8: size (take ratio8 m) = ratio8. + rewrite size_take; first smt(ratio8_bnds). + case: (size m = ratio8) => E. + by rewrite -E ltzz. + by have ->: ratio8 < size m by smt(). +have Hsz64: size (take_block64 m).`1 = ratio64. + rewrite /take_block64 /= size_bits2w64L chunkfillsizeE // ?size_ge0. + have ?: 64 %| size (w8L2bits (take ratio8 m)). + by rewrite size_w8L2bits size_take'; smt(ratio8_bnds). + rewrite !H /= size_w8L2bits size_take; smt(ratio8_bnds). +rewrite pad2blocksE /=. + by move: Hm; rewrite size_cat size_w8L2bits -ratio8P; smt(size_ge0). +rewrite /w64L2block Hsz64 /= cats0; congr. +rewrite take_cat size_w8L2bits. +case: (size m = ratio8) => E. + rewrite !E !ratio8P ltzz /r /Spnge1600.ratio take0 cats0. + rewrite -Hsz64 take_size /take_block64 /=. + rewrite bits2w64LK. + by rewrite size_w8L2bits Hsz8 ratio8P ratio_w64. + by rewrite -E take_size. +have ->/=: r < 8 * size m. + by apply (StdOrder.IntOrder.ler_lt_trans (8*ratio8)); smt(ratio8P). +rewrite -Hsz64 take_size /take_block64 /= bits2w64LK. + by rewrite size_w8L2bits Hsz8 ratio8P ratio_w64. +by rewrite -take_w8L2bits ratio8P. +qed. + + (* [trail_byte] adds the first padding 1-bit to [mbits], which include both the "domain-separation" bits as well as additional suffix bits - (e.g. "01" for SHA; "11" for RawSHAKE; "1111" for SHAKE). The last + (e.g. "01" for SHA-3; "11" for RawSHAKE; "1111" for SHAKE). The last 1-bit of the padding (the "ratio" bit), is only added when adding to the state. Remark: the standard FIPS-202 specifies two domain bits, possibly @@ -437,16 +630,461 @@ op take_block64 (m: W8.t list): W64.t list * W8.t list = (i.e. [size mbits < 6]). *) op trail_byte (mbits: bool list) : W8.t = W8.bits2w (mbits++[true]). +(* + +op bits_fill_k k (bs: bool list) : bool list = + bs ++ nseq ((size bs + k - 1) %/ k) false. + +lemma size_bits_fill_k k bs: + 0 < k => size (bits_fill_k k bs) = (size bs + k - 1) %/ k * k. +admitted. + +lemma size_dvd_bits_fill_k k bs: + k %| size (bits_fill_k k bs). +admitted. +*) (* [final_block64] reads the final block and adds the first padding bit *) op final_block64 (lbyte: W8.t) (m: W8.t list): W64.t list = - bits2w64L (w8L2bits (m++[lbyte])). + bits2w64L (w8L2bits (m++[lbyte])). (*++nseq 63 false).*) + +lemma size_final_block64 b m: + size (final_block64 b m) = size m %/ 8 + 1. +proof. +rewrite /final_block64 size_bits2w64L size_w8L2bits size_cat /=. +rewrite chunkfillsizeE //; first smt(size_ge0). +case: (64 %| 8 * (size m + 1)) => H /=. + have ?: 8 %| (size m + 1) by smt(dvdz_mul). + have ->: 64 = 8*8 by done. + rewrite (divzMpl 8) //. + admit(* +search (_ %/ _) (%|). +(size m + 1) %/ 8 * 8 = size m %/ 8 * 8 + 8 +size m + 1 = size m %/ 8 * 8 + 8 +size m %% 8 = 8 - 1 + + +d %| m => (d-1) %% d = d - 1. +*). + +rewrite -(mulz_modr 8 (size m + 1) 8) //. +have ->: (64 - 8 * ((size m + 1) %% 8)) = 8*(8 - (size m + 1) %% 8) by ring. +rewrite -mulzDr. +rewrite (divzMpl 8 (size m + 1 + (8 - (size m + 1) %% 8)) 8) //. +admit(* +(size m + 1 + (8 - (size m + 1) %% 8)) %/ 8 = size m %/ 8 + 1 +*). +(* +| lemma nosmt mulz_modr: +| forall (p m d : int), 0 < p => p * (m %% d) = p * m %% (p * d). +| lemma nosmt mulz_modl: +| forall (p m d : int), 0 < p => m %% d * p = m * p %% (d * p). +| lemma nosmt divzMpr: +| forall (p m d : int), 0 < p => m * p %/ (d * p) = m %/ d. +| lemma nosmt divzMpl: +| forall (p m d : int), 0 < p => p * m %/ (p * d) = m %/ d. +*) +qed. + + +op block0star1 = mkblock (nseq (ratio-1) false ++ [true]). + +op addstate (st:state) (l: W64.t list) : state = + Array25.init (fun i => st.[i] `^` (nth W64.zero l i)). + +lemma nth_inside ['a] d1 d2 (l: 'a list) i: + 0 <= i < size l => + nth d1 l i = nth d2 l i. +proof. +elim: l i => /=; first smt(). +move=> x xs IH i Hi; case: (i=0) => E //. +by rewrite IH /#. +qed. + +lemma mkblock_xor l1 l2: + size l1 = r => size l2 = r => + mkblock l1 +^ mkblock l2 = mkblock (map2 Bool.(^^) l1 l2). +proof. +move=> *; rewrite /(+^) /offun; congr. +rewrite -(eq_mkseq (fun i => Bool.(^^) (nth false l1 i) (nth false l2 i))). + move=> i /=; rewrite !Block.getE. + case: (0 <= i < r) => E. + rewrite eq_sym. rewrite !ofblockK //. + rewrite (nth_inside witness false). smt(). + rewrite (nth_inside witness false). smt(). + done. + rewrite nth_out. smt(). + rewrite nth_out. smt(). + done. +apply (eq_from_nth false). + rewrite size_mkseq size_map2 H H0 max_ler. + smt(ratio_bnds). + by rewrite min_ler. +rewrite size_mkseq max_ler. smt(ratio_bnds). +move=> i Hi. +rewrite nth_mkseq //=. +by rewrite (nth_map2 false false) /#. +qed. + +lemma block0star1P m: + size m <= r-2 => + mkblock (m++mkpad (size m)) + = mkblock (m++[true]++nseq (r-size m-1) false) +^ block0star1. +proof. +move=> Hm. +rewrite /mkpad mkblock_xor. + admit. + admit. +congr. +admit. +qed. + +lemma nseq_add ['a] (x:'a) n1 n2: + 0 <= n1 => 0 <= n2 => nseq (n1+n2) x = nseq n1 x ++ nseq n2 x. +admitted. + +lemma w64L2bits_nseq0 n: + 0 <= n => + w64L2bits (nseq n W64.zero) = nseq (64*n) false. +proof. +elim/natind: n => /=. + by move=> n Hn1 Hn2; rewrite !nseq0_le 1,2:/# w64L2bits_nil. +move=> n Hn IH H; rewrite nseqS // w64L2bits_cons IH //. +by rewrite addzC mulzDr mulz1 nseq_add /#. +qed. + +lemma finalblockP mbits m: + size mbits < 6 => + size m < ratio8 => + w64L2block (final_block64 (trail_byte mbits) m) +^ block0star1 = + head b0 (pad2blocks (w8L2bits m ++ mbits)). +proof. +move=> Hmbits Hm. +rewrite /pad2blocks /(\o) /pad /bits2blocks /= chunk_r /= /w64L2block. + rewrite !size_cat size_mkpad size_w8L2bits !addzA. + rewrite (size_pad_equiv (8 * size m + size mbits)); first smt(size_ge0). + by rewrite divz_small; first apply bound_abs; smt(size_ge0). +rewrite block0star1P; first rewrite size_cat size_w8L2bits /#. +congr; congr. +rewrite w64L2bits_cat. +have ->: nseq (r - size (w8L2bits m ++ mbits) - 1) false + = nseq (chunkfillsize 64 (8*size m)) false + ++ nseq (r - 64*size (final_block64 (trail_byte mbits) m)) false. + admit. +rewrite !catA; congr; last first. + rewrite w64L2bits_nseq0. + rewrite /final_block64 size_final_block64. + smt(size_ge0). + by rewrite mulzDr ratio64P; congr; ring. +rewrite /final_block64 take_oversize. + admit. + rewrite bits2w64LK' /chunkfill w8L2bits_cat -!catA; congr. +have ->: w8L2bits [trail_byte mbits] + = chunkfill false 8 (mbits ++ [true]). + admit. +rewrite /chunkfill -!catA -nseq_add. + admit. + admit. +congr; congr; congr => //. +rewrite !chunkfillsizeE' //. admit. admit. admit. admit. +qed. + + +lemma nth_addstate d st l i: + 0 <= i < 25 => + nth d (to_list (addstate st l)) i = st.[i] `^` nth W64.zero l i. +proof. +move=> Hi; rewrite /addstate -(nth_inside witness). + by rewrite size_to_list. +by rewrite get_to_list initE Hi. +qed. + +lemma to_list_addstate st l: + to_list (addstate st l) + = map2 W64.(`^`) (to_list st) (l++nseq (25-size l) W64.zero). +proof. +apply (eq_from_nth W64.zero). + rewrite size_map2 !size_to_list min_lel //. + rewrite size_cat size_nseq. + case: (25 < size l) => ?; smt(). +rewrite size_to_list => i Hi. +rewrite nth_addstate // (nth_map2 W64.zero W64.zero). + rewrite size_to_list size_cat size_nseq min_lel //. + case: (25 < size l) => ?; smt(). +congr. + by rewrite -get_to_list -(nth_inside W64.zero) // size_to_list. +rewrite nth_cat; case: (i < size l) => ? //. +by rewrite nth_out 1:/# nth_nseq /#. +qed. + +lemma nth_w64L2bits l i: + 0 <= i < 64 * size l => + nth false (w64L2bits l) i + = nth false (W64.w2bits (nth W64.zero l (i %/ 64))) (i%%64). +proof. +move=> Hi; rewrite /w64L2bits (BitEncoding.BitChunking.nth_flatten _ 64). + by rewrite allP; move=> x /mapP [y [Hy ->]]. +rewrite (nth_map W64.zero) //. +apply divz_cmp => //. +by rewrite mulzC. +qed. + + +(* +lemma nth_to_list (st: state) i: + nth witness (Array25.to_list st) i = st.[i]. +admitted. +*) + +(* +lemma nth_addstate st l i: + 0 <= i < 25 => + nth witness (to_list (addstate st l)) i = st.[i] `^` nth W64.zero l i. +proof. by move=> Hi; rewrite /addstate get_to_list initE Hi. qed. + +lemma XXX st l i: + 0 <= i < 1600 => + nth false (w64L2bits (to_list (addstate st l))) i = + Bool.(^^) (nth false (w64L2bits (to_list st)) i) (nth false (w64L2bits l) i). +proof. +(*rewrite /addstate /to_list /mkseq /=.*) +move=> Hi; rewrite !nth_w64L2bits. + rewrite size_to_list //=. + rewrite size_to_list //=. + admit. +rewrite (nth_inside _ witness (Array25.to_list _)). + admit. +rewrite nth_addstate. admit. +rewrite xorE W64.map2_w2bits bits2wK. + by rewrite size_map2 !size_w2bits. +rewrite (nth_map2 false false false). + rewrite !size_w2bits min_ler //; smt(modz_cmp). +rewrite -Array25.get_to_list. +rewrite (nth_inside _ W64.zero (Array25.to_list _)). + admit. +done. +qed. +*) + + +lemma w64L2bits_xor l1 l2: + w64L2bits (JUtils.map2 W64.(`^`) l1 l2) + = map2 Bool.(^^) (w64L2bits l1) (w64L2bits l2). +proof. +elim: l1 l2 => //=. + by move=> [|y ys]; rewrite w64L2bits_nil // w64L2bits_cons. +move=> x xs IH1; elim => //=. + rewrite w64L2bits_nil map2C; first by move=> b1 b2; ring. + by rewrite w64L2bits_cons. +move=> y ys IH2. +rewrite !w64L2bits_cons map2_cat. + by rewrite !size_w2bits. +by rewrite IH1. +qed. + +lemma take_map2 ['a 'b 'c] (f:'a -> 'b -> 'c) n l1 l2: + take n (JUtils.map2 f l1 l2) = map2 f (take n l1) (take n l2). +proof. +elim: l1 l2 n => [|x xs IH] [|y ys] n //=; case:(n<=0) => // E. +by rewrite IH. +qed. + +lemma drop_map2 ['a 'b 'c] (f:'a -> 'b -> 'c) n l1 l2: + drop n (JUtils.map2 f l1 l2) = map2 f (drop n l1) (drop n l2). +proof. +elim: l1 l2 n => [|x xs IH] [|y ys] n //=; case:(n<=0) => // E. + by case: (drop (n - 1) ys) => [|_ _]. + by case: (drop (n - 1) xs) => [|_ _]. +by rewrite IH. +qed. + +lemma map2_nseq0r ['a 'b] (f:'a -> 'b -> 'a) x0 n l: + size l = n => + (forall y, f y x0 = y) => + map2 f l (nseq n x0) = l. +proof. +elim/natind: n l. + move=> n Hn l Hl H. + have E: n=0 by smt(size_ge0). + by move: Hl; rewrite E size_eq0 nseq0 => ->. +move=> n Hn IH [|x xs] //=; first smt(). +by move=> Hsz H; rewrite nseqS //= H IH /#. +qed. + +lemma addstate_r st l: + state_r (addstate st l) = state_r st +^ w64L2block l. +proof. +rewrite /state_r /state2bits /w64L2block. +rewrite mkblock_xor. + admit. admit. +congr. +rewrite to_list_addstate. +have ->: (w64L2bits (take ratio64 l ++ nseq (ratio64 - size l) W64.zero)) + = take r (w64L2bits (l ++ nseq (ratio64 - size l) W64.zero)). + admit. +rewrite w64L2bits_xor take_map2; congr. +rewrite -ratio64P !take_w64L2bits; congr. +rewrite !take_cat; case: (ratio64 < size l) => //= E; congr. +by rewrite !take_nseq; smt(ratio64_bnds). +qed. + +lemma addstate_c st l: + size l < ratio64 => + state_c (addstate st l) = state_c st. +proof. +move=> Hsz; rewrite /state_c /state2bits /w64L2block; congr. +rewrite -ratio64P !drop_w64L2bits; congr. +rewrite to_list_addstate !drop_map2 drop_cat. +have ->/=: !(ratio64 < size l) by smt(). +rewrite drop_nseq; first smt(ratio64_bnds). +rewrite map2_nseq0r //. +rewrite size_drop; first smt(ratio64_bnds). +by rewrite max_ler size_to_list; smt(ratio64_bnds). +qed. + +lemma addfullblockP mbits blk st m: + ratio8 <= size m => + blk = state_r st => + state_r (addstate st (take_block64 m).`1) + = blk +^ head b0 (pad2blocks (w8L2bits m ++ mbits)). +proof. +move=> Hm Hst; rewrite addstate_r -Hst; congr. +by apply take_block64P. +qed. + +op addfinalbit (st: state) = + st.[ratio64-1 <- st.[ratio64-1] `^` W64.of_int (2^63)]. + +op addfinalblock st l = addfinalbit (addstate st l). + +op block0star1_64 = nseq (ratio64-1) W64.zero ++ [W64.of_int (2 ^ 63)]. + +lemma block0star1E: + w64L2block block0star1_64 = block0star1. +proof. +rewrite /w64L2block /block0star1 /block0star1_64; congr. +rewrite size_cat size_nseq /= max_ler; first smt(ratio64_bnds). +have ->: ratio64 - (ratio64 - 1 + 1) = 0 by ring. +rewrite nseq0 cats0. +pose l := nseq _ _. +rewrite take_cat. +have ->/=: ! ratio64 < size l. + by rewrite /l size_nseq max_ler; smt(ratio64_bnds). +rewrite w64L2bits_cat /l size_nseq max_ler; first smt(ratio64_bnds). +have ->/=: ! ratio64 - (ratio64 - 1) <= 0 by smt(). +have ->: nseq (r-1) false = nseq (64 * (ratio64-1)) false ++ nseq 63 false. + admit. +rewrite -catA; congr. + admit. +rewrite -(W64.shlMP 1 63) //. +rewrite /w64L2bits /=. +have P: forall i, W64.one.[i] = (i=0). + move=> i; rewrite of_intE /= /int2bs /= /mkseq /= bits2wE /=. + case: (0 <= i < 64) => E. + by rewrite initiE //. + by rewrite W64.get_out // /#. +by rewrite /flatten /= !P /#. +qed. + +lemma addfinalbit_r (st: state): + state_r (addfinalbit st) = state_r st +^ block0star1. +proof. +rewrite -block0star1E -addstate_r /addstate; congr. +apply Array25.ext_eq => i Hi. +rewrite initE Hi get_setE; first smt(ratio64_bnds). +case: (i = ratio64 - 1) => E. + rewrite !E /block0star1_64; congr. + by rewrite nth_cat size_nseq max_ler 1:/# ltzz. +have ->: nth W64.zero block0star1_64 i = W64.zero. + rewrite /block0star1_64 nth_cat size_nseq max_ler; first smt(ratio64_bnds). + case: (i < ratio64 - 1) => H. + by rewrite nth_nseq /#. + by rewrite Ring.IntID.subr_eq0 E. +by rewrite W64.xorw0. +qed. + +lemma addfinalblock_r mbits blk st m: + size mbits < 6 => + size m < ratio8 => + blk = state_r st => + state_r (addfinalblock st (final_block64 (trail_byte mbits) m)) + = blk +^ head b0 (pad2blocks (w8L2bits m ++ mbits)). +proof. +move=> Hmbits Hm Hst. +rewrite /addfinalblock addfinalbit_r addstate_r -Hst -Block.xorwA; congr. +by apply finalblockP. +qed. +lemma of_list_take ['a] (dfl : 'a) (l : 'a list): +Array25.of_list dfl l = Array25.of_list dfl (take 25 l). +proof. +apply Array25.ext_eq => *. +rewrite !Array25.get_of_list //. +by rewrite nth_take // /#. +qed. -op addstateAt (n:int) (st:state) (l: W64.t list) : state = - with l = "[]" => st - with l = (::) x xs => addstateAt (n+1) (st.[n <- st.[n] `^` x]) xs. +lemma of_list_cat_nseq ['a] n (dfl : 'a) (l : 'a list): +Array25.of_list dfl l = Array25.of_list dfl (l++nseq n dfl). +proof. +apply Array25.ext_eq => *. +rewrite !Array25.get_of_list //. +rewrite nth_cat. +case: (x < size l) => ? //. +rewrite nth_out 1:/#. +case: (x - size l < n) => ?. + by rewrite nth_nseq /#. +rewrite nth_out //. +by rewrite size_nseq /max; case: (0 < n) => ? /#. +qed. -op addfullblock st l = addstateAt 0 st l. +lemma of_listK' ['a]: + forall (dfl : 'a) (l : 'a list), + to_list (Array25.of_list dfl l) + = take 25 l++nseq (25-size l) dfl. +proof. +move=> *. +rewrite of_list_take (of_list_cat_nseq (25-size l)) of_listK //. +rewrite size_cat size_take // size_nseq. +case: (25 < size l) => ?. + by rewrite max_lel /#. +by rewrite max_ler /#. +qed. + +lemma drop_addstate st ws: + size ws <= ratio64 => + drop r (state2bits (addstate st ws)) = drop r (state2bits st). +proof. +admitted(* +move => Hsz. +rewrite /state2bits -ratio64P {1 2}mulzC !drop_w64L2bits /addstate. +rewrite to_list_map2 drop_map2 of_listK' drop_cat; congr. +rewrite size_take // -!Hsz. +have ->/=: !25 < size ws by smt(ratio_bnds). +rewrite drop0. +apply (eq_from_nth W64.zero). + rewrite size_map2 min_lel //. admit. +move=> i Hi. +rewrite (nth_map2 W64.zero W64.zero). + admit. + rewrite nth_nseq. admit. +by rewrite xorw0. +qed*). + +lemma addstateP st ws: + size ws <= ratio64 => + state_r (addstate st ws) = state_r st +^ mkblock (w64L2bits ws) + /\ state_c (addstate st ws) = state_c st. +proof. +move=> Hsz; split; last first. + by rewrite /state_c drop_addstate //. +rewrite /addstate /state_r /state2bits -ratio64P + !take_w64L2bits mkblock_xor w64L2bits_xor + to_list_map2; congr; congr. +rewrite of_listK' take_map2 take_cat size_take //. +have H1: !(25 < size ws) by smt(ratio_bnds). +rewrite H1 /= ltzNge Hsz /= (take_oversize 25) 1:/# take_nseq. +search (<=) (<) (<=>). + !Hsz /= take0 cats0 (take_oversize 25) ?Hsz /#. +qed. (* PENDING: sa{1} +^ head b0 (pad2blocks (w8L2bits m{2} ++ mbits)) = @@ -455,7 +1093,12 @@ state_r (addfullblock st{2} (take_block64 m{2}).`1) lemma addfullblock_r st ws: size ws = ratio64 => state_r (addfullblock st ws) = state_r st +^ w64L2block ws. -admitted. +proof. +move=> ?. +rewrite /state_r /addfullblock /state2bits. +rewrite -!ratio64P mulzC !take_w64L2bits /w64L2block. +admit. +qed. (* PENDING: sc{1} = state_c (addfullblock st{2} (take_block64 m{2}).`1 @@ -919,113 +1562,6 @@ qed. -op addstate (st: state) (ws: W64.t list) : state = - Array25.map2 W64.(+^) st (Array25.of_list W64.zero ws). - -lemma mkblock_xor l1 l2: - mkblock l1 +^ mkblock l2 = mkblock (map2 Bool.(^^) l1 l2). -admitted. - -lemma w64L2bits_xor l1 l2: - map2 Bool.(^^) (w64L2bits l1) (w64L2bits l2) = w64L2bits (map2 W64.(`^`) l1 l2). -admitted. - -lemma to_list_map2 x1 x2: - Array25.to_list (Array25.map2 W64.(`^`) x1 x2) = map2 W64.(`^`) (to_list x1) (to_list x2). -admitted. - -lemma take_map2 n l1 l2: - take n (JUtils.map2 W64.(`^`) l1 l2) = map2 W64.(`^`) (take n l1) (take n l2). -admitted. - -lemma drop_map2 n l1 l2: - drop n (JUtils.map2 W64.(`^`) l1 l2) - = map2 W64.(`^`) (drop n l1) (drop n l2). -admitted. - -(* -print take. -op take_dfl ['a] dfl (n : int) (xs : 'a list) : 'a list = - with xs = "[]" => nseq n dfl - with xs = (::) y ys => if n <= 0 then [] else y :: take (n - 1) ys. - -lemma of_listK'' ['a]: - forall (dfl : 'a) (l : 'a list), - to_list (Array25.of_list dfl l) = take_dfl dfl 25 l. -admitted. -*) - -lemma of_list_take ['a] (dfl : 'a) (l : 'a list): -Array25.of_list dfl l = Array25.of_list dfl (take 25 l). -proof. -apply Array25.ext_eq => *. -rewrite !Array25.get_of_list //. -by rewrite nth_take // /#. -qed. - -lemma of_list_cat_nseq ['a] n (dfl : 'a) (l : 'a list): -Array25.of_list dfl l = Array25.of_list dfl (l++nseq n dfl). -proof. -apply Array25.ext_eq => *. -rewrite !Array25.get_of_list //. -rewrite nth_cat. -case: (x < size l) => ? //. -rewrite nth_out 1:/#. -case: (x - size l < n) => ?. - by rewrite nth_nseq /#. -rewrite nth_out //. -by rewrite size_nseq /max; case: (0 < n) => ? /#. -qed. - -lemma of_listK' ['a]: - forall (dfl : 'a) (l : 'a list), - to_list (Array25.of_list dfl l) - = take 25 l++nseq (25-size l) dfl. -proof. -move=> *. -rewrite of_list_take (of_list_cat_nseq (25-size l)) of_listK //. -rewrite size_cat size_take // size_nseq. -case: (25 < size l) => ?. - by rewrite max_lel /#. -by rewrite max_ler /#. -qed. - -lemma drop_addstate st ws: - size ws <= ratio64 => - drop r (state2bits (addstate st ws)) = drop r (state2bits st). -proof. -admitted(* -move => Hsz. -rewrite /state2bits -ratio64P {1 2}mulzC !drop_w64L2bits /addstate. -rewrite to_list_map2 drop_map2 of_listK' drop_cat; congr. -rewrite size_take // -!Hsz. -have ->/=: !25 < size ws by smt(ratio_bnds). -rewrite drop0. -apply (eq_from_nth W64.zero). - rewrite size_map2 min_lel //. admit. -move=> i Hi. -rewrite (nth_map2 W64.zero W64.zero). - admit. - rewrite nth_nseq. admit. -by rewrite xorw0. -qed*). - -lemma addstateP st ws: - size ws <= ratio64 => - state_r (addstate st ws) = state_r st +^ mkblock (w64L2bits ws) - /\ state_c (addstate st ws) = state_c st. -proof. -move=> Hsz; split; last first. - by rewrite /state_c drop_addstate //. -rewrite /addstate /state_r /state2bits -ratio64P - {1 2}mulzC !take_w64L2bits mkblock_xor w64L2bits_xor - to_list_map2; congr; congr. -rewrite of_listK' take_map2 take_cat size_take //. -have H1: !(25 < size ws) by smt(ratio_bnds). -rewrite H1 /= ltzNge Hsz /= (take_oversize 25) 1:/# take_nseq. -search (<=) (<) (<=>). - !Hsz /= take0 cats0 (take_oversize 25) ?Hsz /#. -qed. (* Message and payload obs: we consider byte-sized messages From 9d5f0d6615c1a6a9933834e78b4a20e859721cab Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jos=C3=A9=20Bacelar=20Almeida?= Date: Thu, 2 May 2019 12:23:34 +0100 Subject: [PATCH 371/525] upd --- proof/impl/Spec1600.ec | 1060 +--------------------------------------- 1 file changed, 12 insertions(+), 1048 deletions(-) diff --git a/proof/impl/Spec1600.ec b/proof/impl/Spec1600.ec index b34a159..3ce1931 100644 --- a/proof/impl/Spec1600.ec +++ b/proof/impl/Spec1600.ec @@ -1049,11 +1049,11 @@ case: (25 < size l) => ?. by rewrite max_ler /#. qed. +(* lemma drop_addstate st ws: size ws <= ratio64 => drop r (state2bits (addstate st ws)) = drop r (state2bits st). proof. -admitted(* move => Hsz. rewrite /state2bits -ratio64P {1 2}mulzC !drop_w64L2bits /addstate. rewrite to_list_map2 drop_map2 of_listK' drop_cat; congr. @@ -1067,7 +1067,7 @@ rewrite (nth_map2 W64.zero W64.zero). admit. rewrite nth_nseq. admit. by rewrite xorw0. -qed*). +qed. lemma addstateP st ws: size ws <= ratio64 => @@ -1085,51 +1085,7 @@ rewrite H1 /= ltzNge Hsz /= (take_oversize 25) 1:/# take_nseq. search (<=) (<) (<=>). !Hsz /= take0 cats0 (take_oversize 25) ?Hsz /#. qed. - -(* PENDING: -sa{1} +^ head b0 (pad2blocks (w8L2bits m{2} ++ mbits)) = -state_r (addfullblock st{2} (take_block64 m{2}).`1) -*) -lemma addfullblock_r st ws: - size ws = ratio64 => - state_r (addfullblock st ws) = state_r st +^ w64L2block ws. -proof. -move=> ?. -rewrite /state_r /addfullblock /state2bits. -rewrite -!ratio64P mulzC !take_w64L2bits /w64L2block. -admit. -qed. - -(* PENDING: -sc{1} = state_c (addfullblock st{2} (take_block64 m{2}).`1 -*) -lemma addfullblock_c st ws: - size ws = ratio64 => - state_c (addfullblock st ws) = state_c st. -admitted. - -op addfinalblock st l = - (addstateAt 0 st l).[ratio64-1 <- st.[ratio64-1] `^` W64.of_int (2^63)]. - -op block0star1 = mkblock (nseq (ratio-1) false ++ [true]). - -(* PENDING: -sa{1} +^ head b0 (pad2blocks8 (trail_byte mbits) m{2}) = -state_r (addfinalblock st{2} (final_block64 (trail_byte mbits) m{2})) *) -lemma addfinalblock_r mbits st m: - size m < ratio8 => - state_r (addfinalblock st (final_block64 (trail_byte mbits) m)) - = state_r st +^ (head b0 (pad2blocks (w8L2bits m ++ mbits))) +^ block0star1. -admitted. - -(* PENDING: -sc{1} = state_c (addfinalblock st{2} (final_block64 (trail_byte mbits) m{2})) -*) -lemma addfinalblock_c lbyte st m: - size m < ratio8 => - state_c (addfullblock st (final_block64 lbyte m)) = state_c st. -admitted. (* [squeezestate] extracts a [ratio64] 64bit words from the state *) @@ -1146,10 +1102,10 @@ lemma xtrbytes_squeezestate n st: take (8*n) (ofblock (state_r st)). proof. rewrite /xtrbytes -take_w8L2bits /squeezestate; congr. -rewrite /state_r /state2bits -ratio64P mulzC take_w64L2bits. +rewrite /state_r /state2bits -ratio64P take_w64L2bits. rewrite w64L2w8L2bits ofblockK // size_w64L2bits size_take. smt(ratio64_bnds). -rewrite Array25.size_to_list -ratio64P mulzC. +rewrite Array25.size_to_list -ratio64P. by have ->/=: ratio64 < 25 by smt(ratio64_bnds). qed. @@ -1158,8 +1114,8 @@ lemma size_pad2blocks8 mbits m: size (pad2blocks (w8L2bits m ++ mbits)) = size m %/ ratio8 + 1. proof. rewrite size_pad2blocks size_cat size_w8L2bits -ratio8P => ?; congr. -rewrite mulzC -addzA. -have [-> _]//:= (divmod_mul ratio8 8 (size m) (size mbits + 1) _ _); +rewrite -addzA. +have := (divmod_mul ratio8 8 (size m) (size mbits + 1) _ _); by smt(size_ge0 ratio8_bnds). qed. @@ -1188,7 +1144,7 @@ lemma behead_pad2blocks8 mbits m: proof. move=> ?; rewrite behead_pad2blocks. by rewrite size_cat size_w8L2bits -ratio8P; smt(size_ge0). -rewrite /take_block64 /= drop_cat size_w8L2bits -ratio8P mulzC. +rewrite /take_block64 /= drop_cat size_w8L2bits -ratio8P. rewrite StdOrder.IntOrder.ltr_pmul2l //. case: (ratio8 = size m) => E. by rewrite E /= drop0 drop_size w8L2bits_nil. @@ -1198,86 +1154,6 @@ qed. - - -(* - -(* [block_split] splits the message bytes in "intermediate blocks" - (with size multiple of [ratio8]) and a "last block" (remaining - bytes). *) -op block_split (m: mess_t) : mess_t * mess_t = - (take (size m %/ ratio8 * ratio8) m, drop (size m %/ ratio8 * ratio8) m). - -lemma block_splitP m: - m = (block_split m).`1 ++ (block_split m).`2. -proof. by rewrite -{1}(cat_take_drop (size m %/ ratio8 * ratio8)). qed. - -lemma size_block_split1 m: - size (block_split m).`1 = size m %/ ratio8 * ratio8. -proof. -have ?: 0 <= size m - size m %% ratio8 by smt(size_ge0 ratio8_bnds). -rewrite /block_split /= size_take divzE //. -case: (size m - size m %% ratio8 < size m) => //. -rewrite -lezNgt => ?. -have ->/#: size m %% ratio8 = 0. -smt(ratio8_bnds modz_cmp). -qed. - -lemma size_block_split2 m: - size (block_split m).`2 = size m %% ratio8. -proof. -rewrite modzE. -have ->: size (block_split m).`2 = size m - size (block_split m).`1. - by rewrite eq_sym {1}block_splitP size_cat /#. -by rewrite size_block_split1. -qed. - -op lastblock_bits mbits lastbytes : bool list = - w8L2bits lastbytes ++ mbits - ++ mkpad (8*size lastbytes + size mbits). - -op mess2blocks mbits m = - bits2blocks (w8L2bits (block_split m).`1 - ++ lastblock_bits mbits (block_split m).`2). - -lemma mess2blocksP mbits mess: - size mbits < 5 => - mess2blocks mbits mess = pad2blocks (w8L2bits mess ++ mbits). -proof. -move => Hsz. -rewrite {2}block_splitP. -rewrite /mess2blocks /pad2blocks /(\o) /=; congr. -rewrite /pad w8L2bits_cat -!catA; congr; congr; congr. -rewrite !size_cat !size_w8L2bits /mkpad /=; congr; congr. -rewrite size_block_split1. -have ->: 8 * (size mess %/ ratio8 * ratio8) - = (size mess %/ ratio8) * ratio - by rewrite -ratio8P /#. -by rewrite num0_block_suffix. -qed. - - - - - - - - -lemma addfullblockP' st b: - state_r (addfullblock st (block2w64L b)) = state_r st +^ b - /\ state_c (addfullblock st (block2w64L b)) = state_c st. -admitted. - -op addfinalblock st l = - (addstateAt 0 st l).[ratio64-1 <- st.[ratio64-1] `^` W64.of_int (2^63)]. - -lemma addfinalblockP st ws: - size ws <= ratio64 => - state_r (addfinalblock st ws) = state_r st +^ w64L2block ws - /\ state_c (addfullblock st ws) = state_c st. -admitted. -*) - module type PermT = { proc perm(st : state) : state }. @@ -1291,7 +1167,7 @@ module Spec0(P : PermT) = { (* ABSORB *) while (ratio8 <= size m){ (b, m) <- take_block64 m; - st <- addfullblock st b; + st <- addstate st b; st <@ P.perm(st); } st <- addfinalblock st (final_block64 trailbyte m); @@ -1314,7 +1190,7 @@ lemma needed_blocks8P n x: proof. rewrite ltzE lez_divRL; first smt(ratio_bnds). rewrite mulzDl /= !(addzC _ r) -addzA lez_add2l. -rewrite -ratio8P -mulzA mulzC -(lez_add2l 1) !(addzC 1) /= -ltzE. +rewrite -ratio8P (mulzC 8) -mulzA mulzC -(lez_add2l 1) !(addzC 1) /= -ltzE. by rewrite StdOrder.IntOrder.ltr_pmul2l /#. qed. @@ -1432,7 +1308,7 @@ seq 1 1: (#[:-2]pre /\ (i+1=(n + r - 1) %/ r){1}). + by rewrite H8. + smt(). + rewrite take_cat. - rewrite size_cat H3 size_block -ratio8P !(mulzC ratio8). + rewrite size_cat H3 size_block -ratio8P. have ->/=: !(8 * (outl{2} + (i{1} + 1) * ratio8) < i{1} * (8*ratio8) + 8*ratio8). rewrite -lezNgt mulzDl !mulzDr /=. @@ -1476,336 +1352,7 @@ qed. - -(* [mbits] include both the "domain-separation" bits as well as - additional suffix bits (e.g. "01" for SHA; "11" for RawSHAKE; - "1111" for SHAKE) - Remark: [size mbits] are expected to be at most 4. -*) -op trail_byte (mbits: bool list) : W8.t = - W8.bits2w (mbits++[true]). - -(* [lastbytes_split] splits the last message bytes in - 64bit words and remaining bytes. - remark: "size lastbytes < ratio8" *) -op lastbytes_split (m: mess_t) : mess_t * mess_t = - (take (size m %/ 8 * 8) m, drop (size m %/ 8 * 8) m). - -lemma lastbytes_splitP m: - m = (lastbytes_split m).`1 ++ (lastbytes_split m).`2. -proof. by rewrite -{1}(cat_take_drop (size m %/ 8 * 8)). qed. - -lemma size_lastbytes_split1 m: - size (lastbytes_split m).`1 = size m %/ 8 * 8. -proof. -have ?: 0 <= size m - size m %% 8 by smt(size_ge0). -rewrite /lastbytes_split /= size_take divzE //. -case: (size m - size m %% 8 < size m) => //. -rewrite -lezNgt => ?. -have ->/#: size m %% 8 = 0. -smt(modz_cmp). -qed. - -lemma size_lastbytes_split2 m: - size (lastbytes_split m).`2 = size m %% 8. -proof. -rewrite modzE. -have ->: size (lastbytes_split m).`2 - = size m - size (lastbytes_split m).`1. - by rewrite eq_sym {1}lastbytes_splitP size_cat /#. -by rewrite size_lastbytes_split1. -qed. - - - - - -op num8_0s sz = (-(sz+1)) %% ratio8. - -op mkpad8 mbits size8 : W8.t list = - or_head (trail_byte mbits) - (rcons (nseq (num8_0s size8) W8.zero) (W8.of_int 128)). - -lemma mkpad8P mbits sz: - size mbits < 5 => - w8L2bits (mkpad8 mbits sz) - = mbits ++ mkpad (8*sz + size mbits). -proof. -move => Hsz. -rewrite /mkpad8 /trail_byte. -admit (* -w8list_bits - (or_head ((bits2w (mbits ++ [true])))%W8 - (rcons (nseq (num8_0s sz) W8.zero) ((of_int 128))%W8)) = -mbits ++ mkpad (8 * sz + size mbits) -*). -qed. - -op lastblock_bytes mbits lastbytes : W8.t list = - lastbytes ++ mkpad8 mbits (size lastbytes). - -lemma lastblock_bytesP mbits lastbytes: - size mbits < 5 => - w8L2bits (lastblock_bytes mbits lastbytes) - = lastblock_bits mbits lastbytes. -proof. -move=> Hsz. -rewrite /lastblock_bits /lastblock_bytes. -by rewrite !w8L2bits_cat mkpad8P // !catA. -qed. - - - - - - - - - - -(* Message and payload - obs: we consider byte-sized messages - *) -type mess_t = W8.t list. - -(* [mess_split] splits the message bytes in "intermediate blocks" - (with size multiple of [ratio8]) and a "last block" (remaining - bytes). *) -op mess_split (m: mess_t) : mess_t * mess_t = - (take (size m %/ ratio8) m, drop (size m %/ ratio8) m). - -lemma mess_splitP m: - m = (mess_split m).`1 ++ (mess_split m).`2. -proof. by rewrite -{1}(cat_take_drop (size m %/ ratio8)). qed. - -op lastblock_bits mbits lastbytes : bool list = - w8L2bits lastbytes ++ mbits - ++ mkpad (8*size lastbytes + size mbits). - -op mess2blocks mbits m = - bits2blocks (w8L2bits (mess_split m).`1 - ++ lastblock_bits mbits (mess_split m).`2). - -lemma mess2blocksP mbits mess: - size mbits < 5 => - mess2blocks mbits mess = pad2blocks (w8L2bits mess ++ mbits). -proof. -move => Hsz. -rewrite {2}mess_splitP. -rewrite /mess2blocks /pad2blocks /(\o) /=; congr. -rewrite /pad w8L2bits_cat -!catA; congr; congr; congr. -rewrite !size_cat !size_w8L2bits. -rewrite /mkpad; congr; congr; congr. -rewrite /num0. -admit (* -(- (8 * size (mess_split mess).`2 + size mbits + 2)) %% r = -(- (8 * size (mess_split mess).`1 + - (8 * size (mess_split mess).`2 + size mbits) + 2)) %% r -*). -qed. - - - -op or_head (h: W8.t) (l: W8.t list) = - match l with - | [] => [] - | x::xs => (W8.orw h x) :: xs - end. - -(* [mbits] include both the "domain-separation" bits as well as - additional suffix bits (e.g. "01" for SHA; "11" for RawSHAKE; - "1111" for SHAKE) - Remark: [size mbits] are expected to be at most 4. -*) -op trail_byte (mbits: bool list) : W8.t = - W8.bits2w (mbits++[true]). - -op num8_0s sz = (-(sz+1)) %% ratio8. - -op mkpad8 mbits size8 : W8.t list = - or_head (trail_byte mbits) - (rcons (nseq (num8_0s size8) W8.zero) (W8.of_int 128)). - -lemma mkpad8P mbits sz: - size mbits < 5 => - w8L2bits (mkpad8 mbits sz) - = mbits ++ mkpad (8*sz + size mbits). -proof. -move => Hsz. -rewrite /mkpad8 /trail_byte. -admit (* -w8list_bits - (or_head ((bits2w (mbits ++ [true])))%W8 - (rcons (nseq (num8_0s sz) W8.zero) ((of_int 128))%W8)) = -mbits ++ mkpad (8 * sz + size mbits) -*). -qed. - -op lastblock_bytes mbits lastbytes : W8.t list = - lastbytes ++ mkpad8 mbits (size lastbytes). - -lemma lastblock_bytesP mbits lastbytes: - size mbits < 5 => - w8L2bits (lastblock_bytes mbits lastbytes) - = lastblock_bits mbits lastbytes. -proof. -move=> Hsz. -rewrite /lastblock_bits /lastblock_bytes. -by rewrite !w8L2bits_cat mkpad8P // !catA. -qed. - - -(* [lastbytes_split] splits full u64 words from the remaining bytes *) -op lastbytes_split (m: mess_t) : mess_t * mess_t = - (take (size m %/ 8) m, drop (size m %/ 8) m). - -lemma lastbytes_splitP m: - m = (lastbytes_split m).`1 ++ (lastbytes_split m).`2. -proof. by rewrite -{1}(cat_take_drop (size m %/ 8)). qed. - -op lastu64 mbits (m: mess_t) : W64.t = - W8u8.pack8 (rcons m (trail_byte mbits)). - - -module type PermT = { - proc perm(st : state) : state -}. - -print FUNCTIONALITY. - -module Spec(P : PermT) = { - proc f(out : int, outlen : int, inp : int, inlen : int) = { - var z,st,i,xs; - z <- []; - st <- state0; - i <- 0; - xs <- loadpad2wblocks Glob.mem inp inlen; - while (xs <> []){ - st <@ P.perm(combine st (head wblock0 xs)); - xs <- behead xs; - } - while (i < convb outlen){ - z <- z ++ [squeezeb st]; - i <- i + 1; - if (i < convb outlen) - st <@ P.perm(st); - } - - Glob.mem <- storeblocks Glob.mem out outlen z; - } -}. - - - - - - - - - - - - - - - - - -op mess2blocks mbits mess : block list = - bits2blocks (w8list_bits (mess ++ mkpad8 mbits (size mess))). - - -lemma mess2blocksP mbits mess: - size mbits < 5 => - mess2blocks mbits mess = pad2blocks (w8list_bits mess ++ mbits). -proof. -move => Hsz. -rewrite /mess2blocks /pad2blocks /(\o) /=; congr. -rewrite /pad w8list_bits_cat -catA; congr. -rewrite mkpad8P; congr; congr. -by rewrite size_cat size_w8list_bits. -qed. - - - -op domain_bits : bool list. - -(* domain bits are used to distinguish usages of the Sponge in standard *) -axiom domain_bits_len : size domain_bits = 2. - -op suffix_bits : bool list. - -(* additional suffix bits are allowed for construction usage *) -axiom suffix_bits_len : size suffix_bits < 3. - - -(* True for all state sizes we will consider *) -axiom wstate_size (x : state) : - size (flatten (map W64.w2bits (Array25.to_list x))) = (r + c). -axiom rsize : r %% 64 = 0. - -lemma wstate_size_val: r+c = 1600. -move : (wstate_size (Array25.of_list witness (mkseq (fun (i : int) => (of_list W64.zero []).[i]) 25))). -rewrite of_listK. apply size_mkseq. -rewrite /flatten. -rewrite (_: (mkseq (fun (i0 : int) => (of_list W64.zero []).[i0]) 25) = - (W64.zero :: W64.zero :: W64.zero :: W64.zero :: W64.zero :: - W64.zero :: W64.zero :: W64.zero :: W64.zero :: W64.zero :: - W64.zero :: W64.zero :: W64.zero :: W64.zero :: W64.zero :: - W64.zero :: W64.zero :: W64.zero :: W64.zero :: W64.zero :: - W64.zero :: W64.zero :: W64.zero :: W64.zero :: W64.zero :: [])). -by auto => />. -rewrite (_: - (foldr (++) [] - (map W64.w2bits - [W64.zero; W64.zero; W64.zero; W64.zero; W64.zero; W64.zero; - W64.zero; W64.zero; W64.zero; W64.zero; W64.zero; W64.zero; - W64.zero; W64.zero; W64.zero; W64.zero; W64.zero; W64.zero; - W64.zero; W64.zero; W64.zero; W64.zero; W64.zero; W64.zero; - W64.zero])) = - (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ - (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ - (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ - (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ - (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero)). -by auto => />. -simplify. smt(). -qed. - -op memr2bits( mem : global_mem_t, ptr : int, len : int) = - flatten (map (fun o => W8.w2bits (mem.[ptr + o])) (iota_ 0 len)). - -op eqmem_except(mem1 : global_mem_t, mem2 : global_mem_t, ptr : int, o : int) = - forall ad, !(ptr <= ad < ptr + o) => mem1.[ad] = mem2.[ad]. - -op state2bc(st : state) : block * capacity = - let stbits = flatten (map W64.w2bits (to_list st)) - in (mkblock (take r stbits), mkcapacity (drop r stbits)). - -module type PermT = { - proc perm(st : state) : state -}. - -type wblock = W64.t list. - -op pad1byte = domain_bits ++ suffix_bits ++ [true] ++ nseq (8 - (size domain_bits) - (size suffix_bits) - 2) false ++ [true]. -op padqstart = domain_bits ++ suffix_bits ++ [true] ++ nseq (8 - (size domain_bits) - (size suffix_bits) - 1) false. -op padq0 = nseq 8 false. -op padqend = nseq 7 false ++ [true]. -op padbytes(q : int) = - if q = 1 - then [ pad1byte ] - else [ padqstart ] ++ nseq (q-2) padq0 ++ [padqend ]. - -op bytewisepad(s) = - let q = (r %/ 8) - (((size s) %/ 8) %% (r %/ 8)) - in s ++ flatten (padbytes q). - -op loadpad2wblocks(mem : global_mem_t, ptr : int, len : int) = - let msgbits = bytewisepad (memr2bits mem ptr len) - in map (fun b => map W64.bits2w (BitEncoding.BitChunking.chunk 64 (ofblock b))) - (bits2blocks (msgbits)). - +(* lemma bound_conv (s : bool list) q : size s %% 8 = 0 => r %/ 8 - size s %/ 8 %% (r %/ 8) = q => @@ -1823,589 +1370,6 @@ move => *. rewrite (_: size s %% r = r - 8 * q ) 1:/#. by rewrite (: q * 8 + (r - 8 * q) = r) 1:/# modzz. qed. +*) -lemma nseq_cat n1 n2 : - nseq n1 false ++ nseq n2 false = nseq (n1+n2) false. -admitted. - -lemma nseq_comp n1 n2 : - flatten (nseq n1 (nseq n2 false)) = nseq (n1 * n2) false. -admitted. - -lemma samepad s : - size s %% 8 = 0 => - bytewisepad s = pad (s ++ domain_bits ++ suffix_bits). -move => *. -rewrite /bytewisepad /padbytes /pad /mkpad /num0. -progress. -case (r %/ 8 - size s %/ 8 %% (r %/ 8) = 1). -move => *. -rewrite /pad1byte. -rewrite flatten_seq1. -rewrite -catA -catA -catA -catA -catA. -apply eqseq_cat. by trivial. simplify. -rewrite -catA. -apply eqseq_cat. by trivial. simplify. -apply eqseq_cat. by trivial. simplify. -move : (bound_conv s 1 H H0) => *. -rewrite (_: 8 - size domain_bits - size suffix_bits - 2 = (- (size (s ++ domain_bits ++ suffix_bits) + 2)) %% r). -rewrite !size_cat. -rewrite domain_bits_len. -case (size suffix_bits = 0). -move => suffix_bits_len. -rewrite suffix_bits_len. -simplify. -rewrite modNz. smt(size_ge0). exact/Block.gt0_n. -simplify. ring. -rewrite (_: size s + 3 = (size s + 1*8) - 5 ). smt(). -rewrite -modzDm. rewrite H1. simplify. -rewrite modz_mod modNz. smt(). exact/Block.gt0_n. -rewrite modz_small. smt(Block.gt0_n rsize). by ring. -move => *. -case (size suffix_bits = 1). -move => suffix_bits_len. -rewrite suffix_bits_len. -simplify. -rewrite modNz. smt(size_ge0). smt(Block.gt0_n). -simplify. ring. -rewrite (_: size s + 4 = (size s + 1*8) - 4 ). smt(). -rewrite -modzDm. rewrite H1. simplify. -rewrite modz_mod modNz. smt(). smt(Block.gt0_n). -rewrite modz_small. smt(Block.gt0_n rsize). by ring. -move => *. -rewrite (_: size suffix_bits = 2). smt(size_ge0 suffix_bits_len). -simplify. -rewrite modNz. smt(size_ge0). smt(Block.gt0_n). -simplify. ring. -rewrite (_: size s + 5 = (size s + 1*8) - 3 ). smt(). -rewrite -modzDm. rewrite H1. simplify. -rewrite modz_mod modNz. smt(). smt(Block.gt0_n). -rewrite modz_small. smt(Block.gt0_n rsize). by ring. -by rewrite cats1 catA. -move => *. -rewrite /padqstart /padqend. -pose q := r %/ 8 - size s %/ 8 %% (r %/ 8). -rewrite flatten_cons. -rewrite -catA -catA -catA -catA -catA. -rewrite (eqseq_cat). by trivial. simplify. -rewrite (eqseq_cat). by trivial. simplify. -rewrite (eqseq_cat). by trivial. simplify. -rewrite (_: flatten (nseq (q - 2) padq0 ++ - [[false; false; false; false; false; false; false; true]]) = - rcons (nseq (8*(q-2) + 7) false) true). -rewrite flatten_cat flatten_seq1. -rewrite -cats1. -have padlength_ge0: 0 <= 8 * (q - 2). -+ smt. -rewrite (_ : 8 * (q - 2) + 7 = 8 * (q - 2) + 6 + 1); first by smt(). -rewrite nseqSr. smt(). -rewrite cat_rcons. -rewrite (_ : 8 * (q - 2) + 6 = 8 * (q - 2) + 5 + 1); first by smt(). -rewrite nseqSr. smt(). -rewrite cat_rcons. -rewrite (_ : 8 * (q - 2) + 5 = 8 * (q - 2) + 4 + 1); first by smt(). -rewrite nseqSr. smt(). -rewrite cat_rcons. -rewrite (_ : 8 * (q - 2) + 4 = 8 * (q - 2) + 3 + 1); first by smt(). -rewrite nseqSr. smt(). -rewrite cat_rcons. -rewrite (_ : 8 * (q - 2) + 3 = 8 * (q - 2) + 2 + 1); first by smt(). -rewrite nseqSr. smt(). -rewrite cat_rcons. -rewrite (_ : 8 * (q - 2) + 2 = 8 * (q - 2) + 1 + 1); first by smt(). -rewrite nseqSr. smt(). -rewrite cat_rcons. -rewrite nseqSr. smt(). -rewrite cat_rcons. -rewrite /padq0. -rewrite nseq_comp. smt(). -rewrite (_ : nseq (8 - size domain_bits - size suffix_bits - 1) false ++ -rcons (nseq (8 * (q - 2) + 7) false) true = - rcons (nseq (8 - size domain_bits - size suffix_bits - 1 + 8 * (q - 2) + 7) false) true). rewrite -rcons_cat. -rewrite nseq_cat. -rewrite (_ : 8 - size domain_bits - size suffix_bits - 1 + (8 * (q - 2) + 7) = 8 - size domain_bits - size suffix_bits - 1 + 8 * (q - 2) + 7). by ring. -by trivial. -rewrite (_: 8 - size domain_bits - size suffix_bits - 1 + 8 * (q - 2) + 7= (- (size (s ++ domain_bits ++ suffix_bits) + 2)) %% r). -rewrite !size_cat. -rewrite domain_bits_len. -have qval : (r %/ 8 - size s %/ 8 %% (r %/ 8) = q). smt(). -move : (bound_conv s q H qval) => *. -have qlbound : 1 <= q. smt. -have qubound : q * 8 <= r. smt. -case (size suffix_bits = 0). -move => suffix_bits_len. -rewrite suffix_bits_len. -simplify. -ring. -rewrite modNz. smt. smt. -simplify. ring. -move : (dvdzP (r)(size s + q * 8)) => [ ] *. -move : (H2 H1). -progress. -rewrite (_: size s = q0*r - q*8). smt(). -rewrite (_ : (q0 * r - q * 8 + 3) %% r = (-(q*8 - 3)) %% r). -rewrite (_ : (q0 * r - q * 8 + 3) %% r = (q0 * r + (- q * 8 + 3)) %% r). -smt(). -rewrite (modzMDl). smt(). -have same : (- ( q * 8 - 3)) %% r = r - (q*8 - 3). -rewrite (modNz (q * 8 - 3) r). smt. smt. -ring. -rewrite modz_small. smt(). smt. -smt. -move => *. -case (size suffix_bits = 1). -move => suffix_bits_len. -rewrite suffix_bits_len. -simplify. -ring. -rewrite modNz. smt. smt. -simplify. ring. -move : (dvdzP (r)(size s + q * 8)) => [ ] *. -move : (H3 H1). -progress. -rewrite (_: size s = q0*r - q*8). smt(). -rewrite (_ : (q0 * r - q * 8 + 4) %% r = (-(q*8 - 4)) %% r). -rewrite (_ : (q0 * r - q * 8 + 4) %% r = (q0 * r + (- q * 8 + 4)) %% r). -smt(). -rewrite (modzMDl). smt(). -have same : (- ( q * 8 - 4)) %% r = r - (q*8 - 4). -rewrite (modNz (q * 8 - 4) r). smt. smt. -ring. -rewrite modz_small. smt(). smt. -smt. -move => *. -rewrite (_ : size suffix_bits = 2). smt. -simplify. -ring. -rewrite modNz. smt. smt. -simplify. ring. -move : (dvdzP (r)(size s + q * 8)) => [ ] *. -move : (H4 H1). -progress. -rewrite (_: size s = q0*r - q*8). smt(). -rewrite (_ : (q0 * r - q * 8 + 5) %% r = (-(q*8 - 5)) %% r). -rewrite (_ : (q0 * r - q * 8 + 5) %% r = (q0 * r + (- q * 8 + 5)) %% r). -smt(). -rewrite (modzMDl). smt(). -have same : (- ( q * 8 - 5)) %% r = r - (q*8 - 5). -rewrite (modNz (q * 8 - 5) r). smt. smt. -ring. -rewrite modz_small. smt(). smt. -smt. -by trivial. -qed. - -lemma sizepload mem inp inl: (size (memr2bits mem inp inl) = 8 * (max 0 inl)). -rewrite /memr2bits. -simplify. -rewrite size_flatten. -auto => />. -rewrite /sumz. -rewrite -map_comp /(\o) => //=. -rewrite foldr_map. -rewrite (_ : 8*(max 0 inl) = 8* (size (iota_ 0 inl))). rewrite size_iota. by trivial. -elim (iota_ 0 inl). smt. smt. -qed. - -lemma blocksizes mem inp inl b: - b \in (loadpad2wblocks mem inp inl) => size b = r %/ 64. -rewrite /loadpad2wblocks samepad. smt. -simplify. -rewrite /bits2blocks. -have sizebs : forall b0, - b0 \in (map mkblock - (chunk (pad (memr2bits mem inp inl ++ domain_bits ++ suffix_bits)))) => - size (ofblock b0) = r. -move => b0 H. -apply (size_block b0). -have sizecs : forall b0, - b0 \in (map mkblock - (chunk (pad (memr2bits mem inp inl ++ domain_bits ++ suffix_bits)))) => - size ((BitEncoding.BitChunking.chunk 64 (ofblock b0))) = r %/ 64. -smt. -move => H. -move : (mapP - (fun (b0 : block) => - map W64.bits2w (BitEncoding.BitChunking.chunk 64 (ofblock b0))) - ((map mkblock - (chunk - (pad (memr2bits mem inp inl ++ domain_bits ++ suffix_bits))))) b). -smt. -qed. - -(* Stores up to len bytes in memory from list of blocks *) -op storeblocks : global_mem_t -> int -> int -> wblock list -> global_mem_t. - -op state0 : state = Array25.of_list (W64.of_int 0) []. - -op squeezeb(st : state) = take (r %/ 64) (to_list st). - -op wblock0 : wblock = take (r %/ 64) (to_list state0). - -op combine(st : state, wb : wblock) : state = - let stl = to_list st in - let wbst = take (r %/ 64) stl in - let wbstc = map (fun x : W64.t * W64.t => x.`1 `^` x.`2) (zip wbst wb) in - Array25.of_list (W64.of_int 0) (wbstc ++ (drop (r %/ 64) stl)). - -op convb(outl : int) = (outl*8 + r - 1) %/ r. - -module Spec(P : PermT) = { - proc f(out : int, outlen : int, inp : int, inlen : int) = { - var z,st,i,xs; - z <- []; - st <- state0; - i <- 0; - xs <- loadpad2wblocks Glob.mem inp inlen; - while (xs <> []){ - st <@ P.perm(combine st (head wblock0 xs)); - xs <- behead xs; - } - while (i < convb outlen){ - z <- z ++ [squeezeb st]; - i <- i + 1; - if (i < convb outlen) - st <@ P.perm(st); - } - Glob.mem <- storeblocks Glob.mem out outlen z; - } -}. - -section. - -declare module Pideal : DPRIMITIVE. -declare module Preal : PermT {Glob}. (* Note it cannot touch memory *) - -axiom perm_correct : - equiv [Pideal.f ~ Preal.perm : - x{1} = state2bc st{2} ==> - res{1} = state2bc res{2}]. - -op wblock2block(wb : wblock) : block = - mkblock (flatten (map W64.w2bits wb)). - -op wblocks2bits(wbs : wblock list) : bool list = - flatten (List.map (fun bl => ofblock (wblock2block bl)) wbs). - -op wblock2bits_list(wbs : wblock list) : block list = - map wblock2block wbs. - -lemma wblocks2bits_empty : [] = wblocks2bits [] by auto => />. - -lemma state0conv : (b0, c0) = state2bc state0. -rewrite /state2bc /b0 /c0 /offun. -rewrite (_: flatten (map W64.w2bits (to_list state0)) = (mkseq (fun _ => false) (r+c))). -rewrite /state0 /to_list wstate_size_val. -apply (eq_from_nth witness). -rewrite size_mkseq. -move : (wstate_size (Array25.of_list witness (mkseq (fun (i : int) => (of_list W64.zero []).[i]) 25))). -rewrite of_listK. apply size_mkseq. -move => *. rewrite H. -rewrite wstate_size_val. smt(). -rewrite (_ : size - (flatten - (map W64.w2bits - (mkseq (fun (i0 : int) => (of_list W64.zero []).[i0]) 25))) = 1600). -move : (wstate_size (Array25.of_list witness (mkseq (fun (i : int) => (of_list W64.zero []).[i]) 25))). -rewrite of_listK. apply size_mkseq. -rewrite wstate_size_val. smt(). -move => *. -rewrite (_: nth witness (mkseq (fun _ => false) (1600)) i = false). -rewrite nth_mkseq. smt(). smt(). -rewrite (_: (mkseq (fun (i0 : int) => (of_list W64.zero []).[i0]) 25) = - (W64.zero :: W64.zero :: W64.zero :: W64.zero :: W64.zero :: - W64.zero :: W64.zero :: W64.zero :: W64.zero :: W64.zero :: - W64.zero :: W64.zero :: W64.zero :: W64.zero :: W64.zero :: - W64.zero :: W64.zero :: W64.zero :: W64.zero :: W64.zero :: - W64.zero :: W64.zero :: W64.zero :: W64.zero :: W64.zero :: [])). -by auto => />. -rewrite (_: - (foldr (fun (bl : W64.t) (bs : bool list) => w2bits bl ++ bs) [] - [W64.zero; W64.zero; W64.zero; W64.zero; W64.zero; W64.zero; W64.zero; - W64.zero; W64.zero; W64.zero; W64.zero; W64.zero; W64.zero; W64.zero; - W64.zero; W64.zero; W64.zero; W64.zero; W64.zero; W64.zero; W64.zero; - W64.zero; W64.zero; W64.zero; W64.zero]) = - (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ - (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ - (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ - (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ - (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero)). -by auto => />. -rewrite /w2bits. -rewrite -mkseq_add. smt(). smt(). -rewrite -mkseq_add. smt(). smt(). -rewrite -mkseq_add. smt(). smt(). -rewrite -mkseq_add. smt(). smt(). -rewrite -mkseq_add. smt(). smt(). -rewrite -mkseq_add. smt(). smt(). -rewrite -mkseq_add. smt(). smt(). -rewrite -mkseq_add. smt(). smt(). -rewrite -mkseq_add. smt(). smt(). -rewrite -mkseq_add. smt(). smt(). -rewrite -mkseq_add. smt(). smt(). -rewrite -mkseq_add. smt(). smt(). -rewrite -mkseq_add. smt(). smt(). -rewrite -mkseq_add. smt(). smt(). -rewrite -mkseq_add. smt(). smt(). -rewrite -mkseq_add. smt(). smt(). -rewrite -mkseq_add. smt(). smt(). -rewrite -mkseq_add. smt(). smt(). -rewrite -mkseq_add. smt(). smt(). -rewrite -mkseq_add. smt(). smt(). -rewrite -mkseq_add. smt(). smt(). -rewrite -mkseq_add. smt(). smt(). -rewrite -mkseq_add. smt(). smt(). -rewrite -mkseq_add. smt(). smt(). -simplify. -rewrite nth_mkseq. -smt(). smt(). -rewrite mkseq_add. smt. smt. -pose stbits := mkseq (fun _ => false) r ++ - mkseq (fun (i : int) => (fun _ => false) (r + i)) c. -simplify. -split. -rewrite (_:take r stbits = mkseq (fun _ => false) r). -rewrite take_cat. -rewrite size_mkseq. -rewrite (_ : r < max 0 r = false); first by smt. -simplify. -rewrite (_ : r - max 0 r = 0); first by smt. -rewrite take0 cats0. -by trivial. -by trivial. -rewrite drop_cat. -rewrite size_mkseq. -rewrite (_ : r < max 0 r = false); first by smt. -simplify. -rewrite (_ : r - max 0 r = 0); first by smt. -rewrite drop0. -by trivial. -qed. - -lemma paddings_same mem inp inl: - pad (memr2bits mem inp inl ++ domain_bits ++ suffix_bits) = - wblocks2bits (loadpad2wblocks mem inp inl). -rewrite /loadpad2wblocks samepad. smt. -rewrite /wblocks2bits. -pose ll := pad (memr2bits mem inp inl ++ domain_bits ++ suffix_bits). -simplify. -rewrite /wblock2block -map_comp -map_comp /(\o) => //=. -have sizell : size ll %% 64 = 0. smt. -have sizebs : forall x, x \in chunk ll => size x = r. smt. -have sizebs1 : forall x, x \in chunk ll => forall y, y \in (BitEncoding.BitChunking.chunk 64 x) => size y = 64. smt. -have xx : (forall x, x \in chunk ll => (flatten - (map W64.w2bits - (map W64.bits2w - ((BitEncoding.BitChunking.chunk 64 (ofblock (mkblock x))))))) = x). -move => *. rewrite ofblockK. smt. -rewrite -map_comp. -rewrite (_: map (W64.w2bits \o W64.bits2w) (BitEncoding.BitChunking.chunk 64 x) = BitEncoding.BitChunking.chunk 64 x). rewrite /(\o). -have xxx : forall x0, x0 \in ((BitEncoding.BitChunking.chunk 64 x)) => w2bits ((bits2w x0))%W64 = x0. -move : (sizebs1 x H) => *. -move => *. -move : (sizebs1 x H x0 H1). move => *. -apply (W64.bits2wK) => //=. -rewrite {2} (_ : (BitEncoding.BitChunking.chunk 64 x) = map (fun x => x) (BitEncoding.BitChunking.chunk 64 x)). rewrite (id_map). smt(). by trivial. -move : (eq_in_map ((fun (x0 : bool list) => w2bits ((bits2w x0))%W64)) (fun x => x) (BitEncoding.BitChunking.chunk 64 x)) => [/ # [ ]] *. -move : (H0 xxx). smt(). -apply (BitEncoding.BitChunking.chunkK 64 _ _ _). smt(). smt. -have : (forall (x : bool list), - x \in chunk ll => - (fun (x0 : bool list) => - ofblock - (mkblock - (flatten - (map W64.w2bits - (map W64.bits2w - ((BitEncoding.BitChunking.chunk 64 (ofblock (mkblock x0))))))))) x = x). -progress. -move : (xx x H) => *. -rewrite H0. apply ofblockK. smt. -move => *. -rewrite (_ : (map - (fun (x : bool list) => - ofblock - (mkblock - (flatten - (map W64.w2bits - (map W64.bits2w - ((BitEncoding.BitChunking.chunk 64 (ofblock (mkblock x))))))))) - (chunk ll)) = chunk ll). -rewrite {2} (_: chunk ll = map (fun x => x) (chunk ll)). rewrite (id_map). smt(). by trivial. -move : (eq_in_map ((fun (x0 : bool list) => - ofblock - (mkblock - (flatten - (map W64.w2bits - (map W64.bits2w - ((BitEncoding.BitChunking.chunk 64 (ofblock (mkblock x0)))))))))) - (fun x0 => x0) (chunk ll)) => [/ # [ ]] *. -move : (H0 H). smt(). -rewrite chunkK. smt. -by trivial. -qed. - -lemma liftpadding mem inp inl : - pad2blocks (memr2bits mem inp inl ++ domain_bits ++ suffix_bits) = - wblock2bits_list (loadpad2wblocks mem inp inl). -rewrite /pad2blocks /(\o) paddings_same /wblocks2bits => //=. -rewrite /bits2blocks. -rewrite flattenK. -move => b. -rewrite /loadpad2wblocks samepad. smt. -simplify. -pose ll := pad (memr2bits mem inp inl ++ domain_bits ++ suffix_bits). -rewrite /wblock2block -map_comp -map_comp /(\o) => //=. -have sizell : size ll %% 64 = 0. smt. -have sizebs : forall x, x \in chunk ll => size x = r. smt. - -have sizebs1 : forall x, x \in chunk ll => forall y, y \in (BitEncoding.BitChunking.chunk 64 x) => size y = 64. smt. -have xx : (forall x, x \in chunk ll => (flatten - (map W64.w2bits - (map W64.bits2w - ((BitEncoding.BitChunking.chunk 64 (ofblock (mkblock x))))))) = x). -move => *. rewrite ofblockK. smt. -rewrite -map_comp. -rewrite (_: map (W64.w2bits \o W64.bits2w) (BitEncoding.BitChunking.chunk 64 x) = BitEncoding.BitChunking.chunk 64 x). rewrite /(\o). -have xxx : forall x0, x0 \in ((BitEncoding.BitChunking.chunk 64 x)) => w2bits ((bits2w x0))%W64 = x0. -move : (sizebs1 x H) => *. -move => *. -move : (sizebs1 x H x0 H1). move => *. -apply (W64.bits2wK) => //=. -rewrite {2} (_ : (BitEncoding.BitChunking.chunk 64 x) = map (fun x => x) (BitEncoding.BitChunking.chunk 64 x)). rewrite (id_map). smt(). by trivial. -move : (eq_in_map ((fun (x0 : bool list) => w2bits ((bits2w x0))%W64)) (fun x => x) (BitEncoding.BitChunking.chunk 64 x)) => [/ # [ ]] *. -move : (H0 xxx). smt(). -apply (BitEncoding.BitChunking.chunkK 64 _ _ _). smt(). smt. -have : (forall (x : bool list), - x \in chunk ll => - (fun (x0 : bool list) => - ofblock - (mkblock - (flatten - (map W64.w2bits - (map W64.bits2w - ((BitEncoding.BitChunking.chunk 64 (ofblock (mkblock x0))))))))) x = x). -progress. -move : (xx x H) => *. -rewrite H0. apply ofblockK. smt. -move => H. -rewrite (_ : (map - (fun (x : bool list) => - ofblock - (mkblock - (flatten - (map W64.w2bits - (map W64.bits2w - ((BitEncoding.BitChunking.chunk 64 (ofblock (mkblock x))))))))) - (chunk ll)) = chunk ll). -rewrite {2} (_: chunk ll = map (fun x => x) (chunk ll)). rewrite (id_map). smt(). by trivial. -move : (eq_in_map ((fun (x0 : bool list) => - ofblock - (mkblock - (flatten - (map W64.w2bits - (map W64.bits2w - ((BitEncoding.BitChunking.chunk 64 (ofblock (mkblock x0)))))))))) - (fun x0 => x0) (chunk ll)) => [/ # [ ]] *. -move : (H0 H). smt(). smt. -rewrite -map_comp /(\o) /wblock2bits_list /wblock2block. -apply eq_map. progress. rewrite mkblockK. by trivial. -qed. - -lemma lift_combine sa sc st xs : - (sa, sc) = state2bc st => - (sa +^ head b0 (wblock2bits_list xs), sc) = - state2bc (combine st (head wblock0 xs)) - by admit. (* provable *) - -lemma behead_wblockl xs : - behead (wblock2bits_list xs) = wblock2bits_list (behead xs). -rewrite /wblock2bits_list . -elim xs;smt(). -qed. - -lemma behead_wblocke xs : - behead (wblock2bits_list xs) = [] <=> behead xs = []. -rewrite /wblock2bits_list . -elim xs;smt(). -qed. - -lemma wbblockle xs : - wblock2bits_list xs = [] => xs = []. -rewrite /wblock2bits_list . -elim xs;smt(). -qed. - -lemma wbblockle_ : [] = wblock2bits_list []. -rewrite /wblock2bits_list . -smt(). -qed. - -lemma commuteappend z sa st sc : - (sa, sc) = state2bc st => - wblocks2bits z ++ ofblock sa = wblocks2bits (z ++ [squeezeb st]). -rewrite /state2bc => //=. move => [/ # ] *. -rewrite /wblocks2bits /wblock2block. -rewrite H. rewrite ofblockK. smt. -rewrite /squeezeb. - admit. (* provable *) -qed. - -op validins(n : int, outl : int) = - n = outl * 8. - -lemma sizes1 i n1 n2 : validins n1 n2 => - i < (n1 + r - 1) %/ r => - i < convb n2 by smt. - -lemma sizes2 i n1 n2 : validins n1 n2 => - i < convb n2 => - i < (n1 + r - 1) %/ r by smt. - -(* Will need to be proved once storeblocks is defined. *) -lemma store_blocks_safe mem out outlen z : - eqmem_except mem (storeblocks mem out outlen z) out outlen by admit. - -(* Will need to be proved once storeblocks is defined *) -lemma storeblocks_correct mem out outlen n z : - validins n outlen => - take n (wblocks2bits z) = - memr2bits (storeblocks mem out outlen z) out outlen by admit. - -lemma spec_correct mem outp outl: -equiv [ Sponge(Pideal).f ~ Spec(Preal).f : - Glob.mem{2} = mem /\ - bs{1} = memr2bits mem inp{2} inlen{2} ++ domain_bits ++ suffix_bits /\ - outlen{2} = outl /\ validins n{1} outlen{2} /\ out{2} = outp - ==> eqmem_except mem Glob.mem{2} outp outl /\ - res{1} = memr2bits Glob.mem{2} outp outl]. -proc. -seq 4 4 : ( -#pre /\ -z{1} = wblocks2bits z{2} /\ -(sa{1},sc{1}) = state2bc st{2} /\ -={i} /\ xs{1} = wblock2bits_list xs{2} -); first by wp;skip;smt(wblocks2bits_empty state0conv liftpadding). -seq 1 1 : #pre. -while #pre. -by wp;call (perm_correct); wp;skip; smt(lift_combine behead_wblockl behead_wblocke). -by skip; smt(behead_wblockl behead_wblocke). -seq 1 1 : #pre. -while #pre. -seq 2 2 : #[/:-2]pre; first by wp;skip; smt(commuteappend). -if => //=. -progress. -apply(sizes1 i{2} n{1} outlen{2} H) => //=. -apply(sizes2 i{2} n{1} outlen{2} H) => //=. -call perm_correct;skip;progress => //=. -apply(sizes1 i{2} n{1} outlen{2} H) => //=. -skip;progress => //=. -apply(sizes2 i{2} n{1} outlen{2} H) => //=. -skip;progress => //=. -apply(sizes1 i{2} n{1} outlen{2} H) => //=. -apply(sizes2 i{2} n{1} outlen{2} H) => //=. -wp;skip;progress;smt(store_blocks_safe storeblocks_correct). -qed. - -end section. \ No newline at end of file From 8d16331e7ca17a3bcdde4f29fc7af9b6f54d03d6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jos=C3=A9=20Bacelar=20Almeida?= Date: Thu, 2 May 2019 12:55:12 +0100 Subject: [PATCH 372/525] upd --- proof/impl/Spec1600.ec | 431 +++++++++++++++++++---------------------- 1 file changed, 195 insertions(+), 236 deletions(-) diff --git a/proof/impl/Spec1600.ec b/proof/impl/Spec1600.ec index 3ce1931..ad54408 100644 --- a/proof/impl/Spec1600.ec +++ b/proof/impl/Spec1600.ec @@ -16,8 +16,26 @@ clone import Sponge1600 as Spnge1600 import Common1600 Block Capacity. - (* MISC *) + +lemma nth_inside ['a] d1 d2 (l: 'a list) i: + 0 <= i < size l => + nth d1 l i = nth d2 l i. +proof. +elim: l i => /=; first smt(). +move=> x xs IH i Hi; case: (i=0) => E //. +by rewrite IH /#. +qed. + + +lemma nseq_add ['a] (x:'a) n1 n2: + 0 <= n1 => 0 <= n2 => nseq (n1+n2) x = nseq n1 x ++ nseq n2 x. +proof. +move=> Hn1 Hn2; elim/natind: n1 Hn1. + by move=> n ??; rewrite (: n=0) 1:/#. +by move=> n Hn IH H; rewrite nseqS // (addzC n) -addzA addzC nseqS 1:/# IH //. +qed. + lemma take_nseq ['a] n1 n2 (x: 'a): take n1 (nseq n2 x) = nseq (min n1 n2) x. proof. @@ -70,6 +88,7 @@ move=> n Hn IH H1 H2. by rewrite dropS // IH // -dropS /#. qed. +(* [eq_mkseq'] is a more refined version of [eq_mkseq] *) lemma eq_mkseq' ['a] (f g : int -> 'a) n: (forall (x : int), 0 <= x < n => f x = g x) => mkseq f n = mkseq g n. proof. @@ -116,15 +135,62 @@ have ->: (size l - n) %/ n = size l %/ n - 1. by apply eq_mkseq' => x Hx /=; rewrite drop_drop /#. qed. + (* a variant of [size_take] that is more convenient in some cases *) lemma size_take' ['a] n (s: 'a list): 0 <= n => size (take n s) = if n <= size s then n else size s. -admitted. +proof. +move=> Hn; rewrite size_take //. +case: (n = size s) => E; first by rewrite E. +case: (n <= size s) => H. + by rewrite (: n < size s) /#. +by rewrite (: ! n < size s) /#. +qed. -print take_cat. +(* likewise for [take_cat] *) lemma take_cat' ['a] n (s1 s2: 'a list): - take n (s1++s2) = if n <= size s1 then take n s1 else take (n-size s1) s2. -admitted. + take n (s1++s2) = if n <= size s1 then take n s1 else s1 ++ take (n-size s1) s2. +proof. +rewrite take_cat //. +case: (n = size s1) => E. + by rewrite !E /= take0 cats0 take_size. +case: (n <= size s1) => H. + by rewrite (: n < size s1) /#. +by rewrite (: ! n < size s1) /#. +qed. + +lemma take_map2 ['a 'b 'c] (f:'a -> 'b -> 'c) n l1 l2: + take n (JUtils.map2 f l1 l2) = map2 f (take n l1) (take n l2). +proof. +elim: l1 l2 n => [|x xs IH] [|y ys] n //=; case:(n<=0) => // E. +by rewrite IH. +qed. + +lemma drop_map2 ['a 'b 'c] (f:'a -> 'b -> 'c) n l1 l2: + drop n (JUtils.map2 f l1 l2) = map2 f (drop n l1) (drop n l2). +proof. +elim: l1 l2 n => [|x xs IH] [|y ys] n //=; case:(n<=0) => // E. + by case: (drop (n - 1) ys) => [|_ _]. + by case: (drop (n - 1) xs) => [|_ _]. +by rewrite IH. +qed. + +lemma map2_nseq0r ['a 'b] (f:'a -> 'b -> 'a) x0 n l: + size l = n => + (forall y, f y x0 = y) => + map2 f l (nseq n x0) = l. +proof. +elim/natind: n l. + move=> n Hn l Hl H. + have E: n=0 by smt(size_ge0). + by move: Hl; rewrite E size_eq0 nseq0 => ->. +move=> n Hn IH [|x xs] //=; first smt(). +by move=> Hsz H; rewrite nseqS //= H IH /#. +qed. + + + + lemma chunk_take_eq ['a] n (l:'a list): 0 < n => @@ -297,6 +363,11 @@ have ->/=: ! (8 * (n + 1) < size (w2bits x)) by rewrite W8.size_w2bits /#. by rewrite mulzDr /= IH. qed. + + + + + op w64L2bits (l: W64.t list) : bool list = flatten (map W64.w2bits l). @@ -399,6 +470,46 @@ have ->/=: ! (64 * (n + 1) < size (w2bits x)) by rewrite W64.size_w2bits /#. by rewrite mulzDr /= IH. qed. +lemma nth_w64L2bits l i: + 0 <= i < 64 * size l => + nth false (w64L2bits l) i + = nth false (W64.w2bits (nth W64.zero l (i %/ 64))) (i%%64). +proof. +move=> Hi; rewrite /w64L2bits (BitEncoding.BitChunking.nth_flatten _ 64). + by rewrite allP; move=> x /mapP [y [Hy ->]]. +rewrite (nth_map W64.zero) //. +apply divz_cmp => //. +by rewrite mulzC. +qed. + + +lemma w64L2bits_xor l1 l2: + w64L2bits (JUtils.map2 W64.(`^`) l1 l2) + = map2 Bool.(^^) (w64L2bits l1) (w64L2bits l2). +proof. +elim: l1 l2 => //=. + by move=> [|y ys]; rewrite w64L2bits_nil // w64L2bits_cons. +move=> x xs IH1; elim => //=. + rewrite w64L2bits_nil map2C; first by move=> b1 b2; ring. + by rewrite w64L2bits_cons. +move=> y ys IH2. +rewrite !w64L2bits_cons map2_cat. + by rewrite !size_w2bits. +by rewrite IH1. +qed. + +lemma w64L2bits_nseq0 n: + 0 <= n => + w64L2bits (nseq n W64.zero) = nseq (64*n) false. +proof. +elim/natind: n => /=. + by move=> n Hn1 Hn2; rewrite !nseq0_le 1,2:/# w64L2bits_nil. +move=> n Hn IH H; rewrite nseqS // w64L2bits_cons IH //. +by rewrite addzC mulzDr mulz1 nseq_add /#. +qed. + + + op w64L2w8L (l: W64.t list) : W8.t list = flatten (map W8u8.to_list l). @@ -543,6 +654,31 @@ proof. rewrite /state_c c0P state2bits0 drop_nseq; smt(ratio_bnds). qed. (* [match_state] relates both state representations *) op match_state x st = x = (state_r st, state_c st). +lemma mkblock_xor l1 l2: + size l1 = r => size l2 = r => + mkblock l1 +^ mkblock l2 = mkblock (map2 Bool.(^^) l1 l2). +proof. +move=> *; rewrite /(+^) /offun; congr. +rewrite -(eq_mkseq (fun i => Bool.(^^) (nth false l1 i) (nth false l2 i))). + move=> i /=; rewrite !Block.getE. + case: (0 <= i < r) => E. + rewrite eq_sym. rewrite !ofblockK //. + rewrite (nth_inside witness false). smt(). + rewrite (nth_inside witness false). smt(). + done. + rewrite nth_out. smt(). + rewrite nth_out. smt(). + done. +apply (eq_from_nth false). + rewrite size_mkseq size_map2 H H0 max_ler. + smt(ratio_bnds). + by rewrite min_ler. +rewrite size_mkseq max_ler. smt(ratio_bnds). +move=> i Hi. +rewrite nth_mkseq //=. +by rewrite (nth_map2 false false) /#. +qed. + (* @@ -686,109 +822,9 @@ admit(* qed. -op block0star1 = mkblock (nseq (ratio-1) false ++ [true]). - op addstate (st:state) (l: W64.t list) : state = Array25.init (fun i => st.[i] `^` (nth W64.zero l i)). -lemma nth_inside ['a] d1 d2 (l: 'a list) i: - 0 <= i < size l => - nth d1 l i = nth d2 l i. -proof. -elim: l i => /=; first smt(). -move=> x xs IH i Hi; case: (i=0) => E //. -by rewrite IH /#. -qed. - -lemma mkblock_xor l1 l2: - size l1 = r => size l2 = r => - mkblock l1 +^ mkblock l2 = mkblock (map2 Bool.(^^) l1 l2). -proof. -move=> *; rewrite /(+^) /offun; congr. -rewrite -(eq_mkseq (fun i => Bool.(^^) (nth false l1 i) (nth false l2 i))). - move=> i /=; rewrite !Block.getE. - case: (0 <= i < r) => E. - rewrite eq_sym. rewrite !ofblockK //. - rewrite (nth_inside witness false). smt(). - rewrite (nth_inside witness false). smt(). - done. - rewrite nth_out. smt(). - rewrite nth_out. smt(). - done. -apply (eq_from_nth false). - rewrite size_mkseq size_map2 H H0 max_ler. - smt(ratio_bnds). - by rewrite min_ler. -rewrite size_mkseq max_ler. smt(ratio_bnds). -move=> i Hi. -rewrite nth_mkseq //=. -by rewrite (nth_map2 false false) /#. -qed. - -lemma block0star1P m: - size m <= r-2 => - mkblock (m++mkpad (size m)) - = mkblock (m++[true]++nseq (r-size m-1) false) +^ block0star1. -proof. -move=> Hm. -rewrite /mkpad mkblock_xor. - admit. - admit. -congr. -admit. -qed. - -lemma nseq_add ['a] (x:'a) n1 n2: - 0 <= n1 => 0 <= n2 => nseq (n1+n2) x = nseq n1 x ++ nseq n2 x. -admitted. - -lemma w64L2bits_nseq0 n: - 0 <= n => - w64L2bits (nseq n W64.zero) = nseq (64*n) false. -proof. -elim/natind: n => /=. - by move=> n Hn1 Hn2; rewrite !nseq0_le 1,2:/# w64L2bits_nil. -move=> n Hn IH H; rewrite nseqS // w64L2bits_cons IH //. -by rewrite addzC mulzDr mulz1 nseq_add /#. -qed. - -lemma finalblockP mbits m: - size mbits < 6 => - size m < ratio8 => - w64L2block (final_block64 (trail_byte mbits) m) +^ block0star1 = - head b0 (pad2blocks (w8L2bits m ++ mbits)). -proof. -move=> Hmbits Hm. -rewrite /pad2blocks /(\o) /pad /bits2blocks /= chunk_r /= /w64L2block. - rewrite !size_cat size_mkpad size_w8L2bits !addzA. - rewrite (size_pad_equiv (8 * size m + size mbits)); first smt(size_ge0). - by rewrite divz_small; first apply bound_abs; smt(size_ge0). -rewrite block0star1P; first rewrite size_cat size_w8L2bits /#. -congr; congr. -rewrite w64L2bits_cat. -have ->: nseq (r - size (w8L2bits m ++ mbits) - 1) false - = nseq (chunkfillsize 64 (8*size m)) false - ++ nseq (r - 64*size (final_block64 (trail_byte mbits) m)) false. - admit. -rewrite !catA; congr; last first. - rewrite w64L2bits_nseq0. - rewrite /final_block64 size_final_block64. - smt(size_ge0). - by rewrite mulzDr ratio64P; congr; ring. -rewrite /final_block64 take_oversize. - admit. - rewrite bits2w64LK' /chunkfill w8L2bits_cat -!catA; congr. -have ->: w8L2bits [trail_byte mbits] - = chunkfill false 8 (mbits ++ [true]). - admit. -rewrite /chunkfill -!catA -nseq_add. - admit. - admit. -congr; congr; congr => //. -rewrite !chunkfillsizeE' //. admit. admit. admit. admit. -qed. - - lemma nth_addstate d st l i: 0 <= i < 25 => nth d (to_list (addstate st l)) i = st.[i] `^` nth W64.zero l i. @@ -816,99 +852,6 @@ rewrite nth_cat; case: (i < size l) => ? //. by rewrite nth_out 1:/# nth_nseq /#. qed. -lemma nth_w64L2bits l i: - 0 <= i < 64 * size l => - nth false (w64L2bits l) i - = nth false (W64.w2bits (nth W64.zero l (i %/ 64))) (i%%64). -proof. -move=> Hi; rewrite /w64L2bits (BitEncoding.BitChunking.nth_flatten _ 64). - by rewrite allP; move=> x /mapP [y [Hy ->]]. -rewrite (nth_map W64.zero) //. -apply divz_cmp => //. -by rewrite mulzC. -qed. - - -(* -lemma nth_to_list (st: state) i: - nth witness (Array25.to_list st) i = st.[i]. -admitted. -*) - -(* -lemma nth_addstate st l i: - 0 <= i < 25 => - nth witness (to_list (addstate st l)) i = st.[i] `^` nth W64.zero l i. -proof. by move=> Hi; rewrite /addstate get_to_list initE Hi. qed. - -lemma XXX st l i: - 0 <= i < 1600 => - nth false (w64L2bits (to_list (addstate st l))) i = - Bool.(^^) (nth false (w64L2bits (to_list st)) i) (nth false (w64L2bits l) i). -proof. -(*rewrite /addstate /to_list /mkseq /=.*) -move=> Hi; rewrite !nth_w64L2bits. - rewrite size_to_list //=. - rewrite size_to_list //=. - admit. -rewrite (nth_inside _ witness (Array25.to_list _)). - admit. -rewrite nth_addstate. admit. -rewrite xorE W64.map2_w2bits bits2wK. - by rewrite size_map2 !size_w2bits. -rewrite (nth_map2 false false false). - rewrite !size_w2bits min_ler //; smt(modz_cmp). -rewrite -Array25.get_to_list. -rewrite (nth_inside _ W64.zero (Array25.to_list _)). - admit. -done. -qed. -*) - - -lemma w64L2bits_xor l1 l2: - w64L2bits (JUtils.map2 W64.(`^`) l1 l2) - = map2 Bool.(^^) (w64L2bits l1) (w64L2bits l2). -proof. -elim: l1 l2 => //=. - by move=> [|y ys]; rewrite w64L2bits_nil // w64L2bits_cons. -move=> x xs IH1; elim => //=. - rewrite w64L2bits_nil map2C; first by move=> b1 b2; ring. - by rewrite w64L2bits_cons. -move=> y ys IH2. -rewrite !w64L2bits_cons map2_cat. - by rewrite !size_w2bits. -by rewrite IH1. -qed. - -lemma take_map2 ['a 'b 'c] (f:'a -> 'b -> 'c) n l1 l2: - take n (JUtils.map2 f l1 l2) = map2 f (take n l1) (take n l2). -proof. -elim: l1 l2 n => [|x xs IH] [|y ys] n //=; case:(n<=0) => // E. -by rewrite IH. -qed. - -lemma drop_map2 ['a 'b 'c] (f:'a -> 'b -> 'c) n l1 l2: - drop n (JUtils.map2 f l1 l2) = map2 f (drop n l1) (drop n l2). -proof. -elim: l1 l2 n => [|x xs IH] [|y ys] n //=; case:(n<=0) => // E. - by case: (drop (n - 1) ys) => [|_ _]. - by case: (drop (n - 1) xs) => [|_ _]. -by rewrite IH. -qed. - -lemma map2_nseq0r ['a 'b] (f:'a -> 'b -> 'a) x0 n l: - size l = n => - (forall y, f y x0 = y) => - map2 f l (nseq n x0) = l. -proof. -elim/natind: n l. - move=> n Hn l Hl H. - have E: n=0 by smt(size_ge0). - by move: Hl; rewrite E size_eq0 nseq0 => ->. -move=> n Hn IH [|x xs] //=; first smt(). -by move=> Hsz H; rewrite nseqS //= H IH /#. -qed. lemma addstate_r st l: state_r (addstate st l) = state_r st +^ w64L2block l. @@ -951,6 +894,59 @@ move=> Hm Hst; rewrite addstate_r -Hst; congr. by apply take_block64P. qed. + +op block0star1 = mkblock (nseq (ratio-1) false ++ [true]). + +lemma block0star1P m: + size m <= r-2 => + mkblock (m++mkpad (size m)) + = mkblock (m++[true]++nseq (r-size m-1) false) +^ block0star1. +proof. +move=> Hm. +rewrite /mkpad mkblock_xor. + admit. + admit. +congr. +admit. +qed. + +lemma finalblockP mbits m: + size mbits < 6 => + size m < ratio8 => + w64L2block (final_block64 (trail_byte mbits) m) +^ block0star1 = + head b0 (pad2blocks (w8L2bits m ++ mbits)). +proof. +move=> Hmbits Hm. +rewrite /pad2blocks /(\o) /pad /bits2blocks /= chunk_r /= /w64L2block. + rewrite !size_cat size_mkpad size_w8L2bits !addzA. + rewrite (size_pad_equiv (8 * size m + size mbits)); first smt(size_ge0). + by rewrite divz_small; first apply bound_abs; smt(size_ge0). +rewrite block0star1P; first rewrite size_cat size_w8L2bits /#. +congr; congr. +rewrite w64L2bits_cat. +have ->: nseq (r - size (w8L2bits m ++ mbits) - 1) false + = nseq (chunkfillsize 64 (8*size m)) false + ++ nseq (r - 64*size (final_block64 (trail_byte mbits) m)) false. + admit. +rewrite !catA; congr; last first. + rewrite w64L2bits_nseq0. + rewrite /final_block64 size_final_block64. + smt(size_ge0). + by rewrite mulzDr ratio64P; congr; ring. +rewrite /final_block64 take_oversize. + admit. + rewrite bits2w64LK' /chunkfill w8L2bits_cat -!catA; congr. +have ->: w8L2bits [trail_byte mbits] + = chunkfill false 8 (mbits ++ [true]). + admit. +rewrite /chunkfill -!catA -nseq_add. + admit. + admit. +congr; congr; congr => //. +rewrite !chunkfillsizeE' //. admit. admit. admit. admit. +qed. + + op addfinalbit (st: state) = st.[ratio64-1 <- st.[ratio64-1] `^` W64.of_int (2^63)]. @@ -1014,6 +1010,7 @@ rewrite /addfinalblock addfinalbit_r addstate_r -Hst -Block.xorwA; congr. by apply finalblockP. qed. +(* lemma of_list_take ['a] (dfl : 'a) (l : 'a list): Array25.of_list dfl l = Array25.of_list dfl (take 25 l). proof. @@ -1048,46 +1045,8 @@ case: (25 < size l) => ?. by rewrite max_lel /#. by rewrite max_ler /#. qed. - -(* -lemma drop_addstate st ws: - size ws <= ratio64 => - drop r (state2bits (addstate st ws)) = drop r (state2bits st). -proof. -move => Hsz. -rewrite /state2bits -ratio64P {1 2}mulzC !drop_w64L2bits /addstate. -rewrite to_list_map2 drop_map2 of_listK' drop_cat; congr. -rewrite size_take // -!Hsz. -have ->/=: !25 < size ws by smt(ratio_bnds). -rewrite drop0. -apply (eq_from_nth W64.zero). - rewrite size_map2 min_lel //. admit. -move=> i Hi. -rewrite (nth_map2 W64.zero W64.zero). - admit. - rewrite nth_nseq. admit. -by rewrite xorw0. -qed. - -lemma addstateP st ws: - size ws <= ratio64 => - state_r (addstate st ws) = state_r st +^ mkblock (w64L2bits ws) - /\ state_c (addstate st ws) = state_c st. -proof. -move=> Hsz; split; last first. - by rewrite /state_c drop_addstate //. -rewrite /addstate /state_r /state2bits -ratio64P - !take_w64L2bits mkblock_xor w64L2bits_xor - to_list_map2; congr; congr. -rewrite of_listK' take_map2 take_cat size_take //. -have H1: !(25 < size ws) by smt(ratio_bnds). -rewrite H1 /= ltzNge Hsz /= (take_oversize 25) 1:/# take_nseq. -search (<=) (<) (<=>). - !Hsz /= take0 cats0 (take_oversize 25) ?Hsz /#. -qed. *) - (* [squeezestate] extracts a [ratio64] 64bit words from the state *) op squeezestate (st: state): W64.t list = take ratio64 (to_list st). From aa15622b3a597cffdccea7cb28b728f9de0c9c80 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Thu, 2 May 2019 11:32:30 +0100 Subject: [PATCH 373/525] Split CI tasks to make failure reports more granular, tasks more timely --- .gitlab-ci.yml | 26 ++++++++++++++++++++++++-- config/tests.config | 9 +++++++++ 2 files changed, 33 insertions(+), 2 deletions(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index c5e30ee..6e7167e 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -6,13 +6,35 @@ services: before_script: - docker info - docker pull easycryptpa/ec-test-box:kms -sha3: +sponge: only: - master script: - >- docker run -v $PWD:/home/ci/sha3 easycryptpa/ec-test-box:kms - sh -c 'cd sha3 && git clone -b array_cast https://github.com/jasmin-lang/jasmin && ECARGS="-I Jasmin:/home/ci/sha3/jasmin/eclib" opam config exec -- make check-xunit' + sh -c 'cd sha3 && CHECKS=sponge opam config exec -- make check-xunit' + artifacts: + when: on_failure + paths: + - xunit.xml +jasmin sponge: + only: + - master + script: + - >- + docker run -v $PWD:/home/ci/sha3 easycryptpa/ec-test-box:kms + sh -c 'cd sha3 && git clone -b array_cast https://github.com/jasmin-lang/jasmin && CHECKS=jsponge ECARGS="-I Jasmin:/home/ci/sha3/jasmin/eclib" opam config exec -- make check-xunit' + artifacts: + when: on_failure + paths: + - xunit.xml +jasmin permutation: + only: + - master + script: + - >- + docker run -v $PWD:/home/ci/sha3 easycryptpa/ec-test-box:kms + sh -c 'cd sha3 && git clone -b array_cast https://github.com/jasmin-lang/jasmin && CHECKS=jperm ECARGS="-I Jasmin:/home/ci/sha3/jasmin/eclib" opam config exec -- make check-xunit' artifacts: when: on_failure paths: diff --git a/config/tests.config b/config/tests.config index 1c6b73e..fc72c0d 100644 --- a/config/tests.config +++ b/config/tests.config @@ -4,3 +4,12 @@ args = -I proof -I proof/smart_counter -timeout 10 [test-sha3] okdirs = !proof + +[test-sponge] +okdirs = proof proof/smart_counter + +[test-jsponge] +okdirs = proof/impl + +[test-jperm] +okdirs = proof/impl/perm From 7aa6f2d74e2a08b5e856c857bab60f90238e53ef Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Thu, 2 May 2019 16:09:59 +0100 Subject: [PATCH 374/525] Fix Sponge proof pHL conseq has changed --- proof/smart_counter/Handle.eca | 20 +++++++++++++------- 1 file changed, 13 insertions(+), 7 deletions(-) diff --git a/proof/smart_counter/Handle.eca b/proof/smart_counter/Handle.eca index 0989005..281958b 100644 --- a/proof/smart_counter/Handle.eca +++ b/proof/smart_counter/Handle.eca @@ -2420,7 +2420,7 @@ proof. cut->/=:=ch_neq0 _ _ H_hs_spec. cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec H_h. rewrite h_g1/=. - by cut[]:=H_mh_spec;smt(dom_hs_neq_ch). + by cut[]:=H_mh_spec; smt(dom_hs_neq_ch). cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness bs{1} i{2}) y1L p0 v hx. cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness bs{1} i{2}) y1L p' v' hx. move:H13 H14;rewrite!get_setE/=!oget_some/==>H13 H14;rewrite H13 H14/=. @@ -2574,12 +2574,18 @@ section AUX. smt (size_ge0). (* lossless and do not reset bad G1.C.f *) + move=> _; proc; inline *; wp;sp;if;auto;sp;if;auto;sp. - conseq(:_==> (G1.bcol \/ G1.bext));1:smt(@DBlock @DCapacity mem_set). - while (G1.bcol \/ G1.bext) (size p - i)=> [z|]. + conseq(:_==> true) (: _ ==> G1.bcol \/ G1.bext)=> //=. + + by move=> />. + + smt(@DBlock @DCapacity mem_set). + + while (G1.bcol \/ G1.bext)=> //=. + if; 1:by auto. + if;2:by auto. + by auto=> /> &hr [->|->]. + while (true) (size p - i)=> [z|]. + if; 1:by auto=> /#. - if;2:auto=>/#;wp; rnd predT; wp; rnd predT; auto. - smt (@Block.DBlock @Capacity.DCapacity). - by auto; smt (@Block.DBlock @Capacity.DCapacity). + if; 2:by auto=> /#. + by wp; rnd predT; wp; rnd predT; auto=> />; smt(@DBlock @DCapacity). + by auto=> /#. (* Init ok *) inline *; auto=> />; split=> [|/#]. do !split. @@ -2632,4 +2638,4 @@ section. rewrite Pr[mu_or];smt(Distr.mu_bounded). qed. -end section. \ No newline at end of file +end section. From cfdbda1531321178a8b5417eb70d1630c1c5a9f3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Thu, 2 May 2019 16:10:31 +0100 Subject: [PATCH 375/525] print out easycrypt config at the top of CI reports --- .gitlab-ci.yml | 1 + 1 file changed, 1 insertion(+) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 6e7167e..45fe099 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -6,6 +6,7 @@ services: before_script: - docker info - docker pull easycryptpa/ec-test-box:kms +- docker run --rm easycryptca/ec-test-box:kms opam config exec -- easycrypt config sponge: only: - master From beb62b6d1179804c536ebadb025d11cafff321fb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Thu, 2 May 2019 16:42:38 +0100 Subject: [PATCH 376/525] ... --- .gitlab-ci.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 45fe099..f2d2577 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -6,7 +6,7 @@ services: before_script: - docker info - docker pull easycryptpa/ec-test-box:kms -- docker run --rm easycryptca/ec-test-box:kms opam config exec -- easycrypt config +- docker run --rm easycryptpa/ec-test-box:kms opam config exec -- easycrypt config sponge: only: - master From 513d3cee41b249c8dc03c72ff089db8e5e216bed Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jos=C3=A9=20Bacelar=20Almeida?= Date: Fri, 3 May 2019 02:51:01 +0100 Subject: [PATCH 377/525] upd --- proof/impl/Spec1600.ec | 224 ++++++++++++++++++++++++----------------- 1 file changed, 133 insertions(+), 91 deletions(-) diff --git a/proof/impl/Spec1600.ec b/proof/impl/Spec1600.ec index ad54408..ade3539 100644 --- a/proof/impl/Spec1600.ec +++ b/proof/impl/Spec1600.ec @@ -274,28 +274,37 @@ proof. by move=> Hn Hsz; rewrite /chunkfill chunkfillsizeE // ?size_ge0 !Hsz /= cats0. qed. -lemma size_chunkfill ['a] (d:'a) n l: +(* +lemma size_chunkfill' ['a] (d:'a) n l: 0 < n => size (chunkfill d n l) = size l + chunkfillsize n (size l). proof. move=> Hn; rewrite /chunkfill size_cat size_nseq max_ler //. smt(chunkfillsize_cmp). qed. +*) + +lemma size_chunkfill ['a] (d:'a) n l: + 0 < n => + size (chunkfill d n l) = (size l - 1) %/ n * n + n. +proof. +move=> Hn; rewrite /chunkfill size_cat size_nseq max_ler //. + smt(chunkfillsize_cmp). +case: (size l = 0) => E. + by rewrite !E /= /chunkfillsize /= divNz //=; ring. +rewrite chunkfillsizeE' //; first smt(size_ge0). +have ->: size l + (n - 1 - (size l - 1) %% n) = (size l-1) + n - (size l-1) %% n + by ring. +rewrite {1}(divz_eq (size l - 1) n); ring. +qed. lemma chunkfillP ['a] (d:'a) n l: 0 < n => n %| size (chunkfill d n l). proof. -move=> Hn; rewrite /chunkfill size_cat size_nseq max_ler; first smt(modz_cmp). -rewrite {1}(divz_eq (size l) n). -rewrite chunkfillsizeE // ?size_ge0. -case: (n %| size l) => ?. - by rewrite /= -divz_eq. -have ->: size l %/ n * n + size l %% n + (n - size l %% n) - = (size l %/ n + 1) * n by ring. -rewrite -{1}(mulz1 n) {1}mulzC; apply dvdz_mul. - by apply dvdz1. -by apply dvdzz. +move=> Hn; rewrite size_chunkfill //. +rewrite (: (size l - 1) %/ n * n + n = ((size l - 1) %/ n + 1) * n) 1:/#. +by rewrite dvdzE modzMl. qed. lemma chunkfillK ['a] (d:'a) n l: @@ -335,6 +344,8 @@ by rewrite /w8L2bits size_flatten -map_comp /(\o) /= StdBigop.Bigint.sumzE StdBigop.Bigint.BIA.big_mapT /(\o) /= StdBigop.Bigint.big_constz count_predT_eq. qed. +hint simplify size_w8L2bits. + lemma take_w8L2bits n l: take (8*n) (w8L2bits l) = w8L2bits (take n l). proof. @@ -381,12 +392,25 @@ qed. op bits2w64L (bs: bool list) : W64.t list = map W64.bits2w (BitEncoding.BitChunking.chunk 64 (chunkfill false 64 bs)). +(* lemma size_bits2w64L bs: size (bits2w64L bs) = (size bs + chunkfillsize 64 (size bs)) %/ 64. proof. rewrite /bits2w64L size_map BitEncoding.BitChunking.size_chunk //. by rewrite size_chunkfill. qed. +*) + +lemma size_bits2w64L bs: + size (bits2w64L bs) = (size bs - 1) %/ 64 + 1. +proof. +rewrite /bits2w64L size_map BitEncoding.BitChunking.size_chunk //. +rewrite size_chunkfill //. +rewrite {3}(:64 = 1*64) 1:/# -mulzDl. +by rewrite -(addz0 (((size bs - 1) %/ 64 + 1) * 64)) divzMDl. +qed. + +hint simplify size_w64L2bits. lemma bits2w64LK bs: 64 %| size bs => w64L2bits (bits2w64L bs) = bs. @@ -553,8 +577,7 @@ lemma bits2stateK bs: proof. move=> Hsz. rewrite /state2bits /bits2state Array25.of_listK. - by rewrite size_bits2w64L Hsz chunkfillsizeE. -(* by rewrite size_map BitEncoding.BitChunking.size_chunk // Hsz.*) + by rewrite size_bits2w64L Hsz. by rewrite bits2w64LK ?Hsz. qed. @@ -687,9 +710,6 @@ qed. type mess_t = W8.t list. -print W8u8.pack8. -print w8L2block. -print block2w64L. (* [take_block64] reads a the contents of a full block into a list of 64bit words (return also the remaining bytes) *) op take_block64 (m: W8.t list): W64.t list * W8.t list = @@ -732,10 +752,7 @@ have Hsz8: size (take ratio8 m) = ratio8. by rewrite -E ltzz. by have ->: ratio8 < size m by smt(). have Hsz64: size (take_block64 m).`1 = ratio64. - rewrite /take_block64 /= size_bits2w64L chunkfillsizeE // ?size_ge0. - have ?: 64 %| size (w8L2bits (take ratio8 m)). - by rewrite size_w8L2bits size_take'; smt(ratio8_bnds). - rewrite !H /= size_w8L2bits size_take; smt(ratio8_bnds). + rewrite /take_block64 /= size_bits2w64L /= Hsz8 /#. rewrite pad2blocksE /=. by move: Hm; rewrite size_cat size_w8L2bits -ratio8P; smt(size_ge0). rewrite /w64L2block Hsz64 /= cats0; congr. @@ -766,59 +783,16 @@ qed. (i.e. [size mbits < 6]). *) op trail_byte (mbits: bool list) : W8.t = W8.bits2w (mbits++[true]). -(* - -op bits_fill_k k (bs: bool list) : bool list = - bs ++ nseq ((size bs + k - 1) %/ k) false. - -lemma size_bits_fill_k k bs: - 0 < k => size (bits_fill_k k bs) = (size bs + k - 1) %/ k * k. -admitted. -lemma size_dvd_bits_fill_k k bs: - k %| size (bits_fill_k k bs). -admitted. -*) (* [final_block64] reads the final block and adds the first padding bit *) op final_block64 (lbyte: W8.t) (m: W8.t list): W64.t list = bits2w64L (w8L2bits (m++[lbyte])). (*++nseq 63 false).*) lemma size_final_block64 b m: - size (final_block64 b m) = size m %/ 8 + 1. -proof. -rewrite /final_block64 size_bits2w64L size_w8L2bits size_cat /=. -rewrite chunkfillsizeE //; first smt(size_ge0). -case: (64 %| 8 * (size m + 1)) => H /=. - have ?: 8 %| (size m + 1) by smt(dvdz_mul). - have ->: 64 = 8*8 by done. - rewrite (divzMpl 8) //. - admit(* -search (_ %/ _) (%|). -(size m + 1) %/ 8 * 8 = size m %/ 8 * 8 + 8 -size m + 1 = size m %/ 8 * 8 + 8 -size m %% 8 = 8 - 1 - - -d %| m => (d-1) %% d = d - 1. -*). - -rewrite -(mulz_modr 8 (size m + 1) 8) //. -have ->: (64 - 8 * ((size m + 1) %% 8)) = 8*(8 - (size m + 1) %% 8) by ring. -rewrite -mulzDr. -rewrite (divzMpl 8 (size m + 1 + (8 - (size m + 1) %% 8)) 8) //. -admit(* -(size m + 1 + (8 - (size m + 1) %% 8)) %/ 8 = size m %/ 8 + 1 -*). -(* -| lemma nosmt mulz_modr: -| forall (p m d : int), 0 < p => p * (m %% d) = p * m %% (p * d). -| lemma nosmt mulz_modl: -| forall (p m d : int), 0 < p => m %% d * p = m * p %% (d * p). -| lemma nosmt divzMpr: -| forall (p m d : int), 0 < p => m * p %/ (d * p) = m %/ d. -| lemma nosmt divzMpl: -| forall (p m d : int), 0 < p => p * m %/ (p * d) = m %/ d. -*) + size (final_block64 b m) = (8 * size m + 7) %/ 64 + 1. (*(size m) %/ 8 + 1.*) +proof. +rewrite /final_block64 size_bits2w64L size_w8L2bits size_cat /=; congr. +by rewrite mulzDr /=. qed. @@ -857,13 +831,20 @@ lemma addstate_r st l: state_r (addstate st l) = state_r st +^ w64L2block l. proof. rewrite /state_r /state2bits /w64L2block. -rewrite mkblock_xor. - admit. admit. -congr. -rewrite to_list_addstate. +rewrite mkblock_xor /=. + rewrite size_take; first smt(ratio_bnds). + by rewrite size_w64L2bits Array25.size_to_list /= (: r < 1600); smt(ratio_bnds). + rewrite size_cat size_nseq size_take; first smt(ratio64_bnds). + case: (ratio64 < size l) => E. + by rewrite max_lel; smt(size_ge0 ratio64P). + by rewrite max_ler 1:/#; smt(ratio64P). +congr; rewrite to_list_addstate. have ->: (w64L2bits (take ratio64 l ++ nseq (ratio64 - size l) W64.zero)) = take r (w64L2bits (l ++ nseq (ratio64 - size l) W64.zero)). - admit. + rewrite -ratio64P take_w64L2bits take_cat'. + case: (ratio64 <= size l) => E. + by rewrite nseq0_le 1:/# cats0. + by rewrite take_oversize 1:/# take_nseq min_ler. rewrite w64L2bits_xor take_map2; congr. rewrite -ratio64P !take_w64L2bits; congr. rewrite !take_cat; case: (ratio64 < size l) => //= E; congr. @@ -871,7 +852,7 @@ by rewrite !take_nseq; smt(ratio64_bnds). qed. lemma addstate_c st l: - size l < ratio64 => + size l <= ratio64 => state_c (addstate st l) = state_c st. proof. move=> Hsz; rewrite /state_c /state2bits /w64L2block; congr. @@ -894,7 +875,6 @@ move=> Hm Hst; rewrite addstate_r -Hst; congr. by apply take_block64P. qed. - op block0star1 = mkblock (nseq (ratio-1) false ++ [true]). lemma block0star1P m: @@ -904,10 +884,49 @@ lemma block0star1P m: proof. move=> Hm. rewrite /mkpad mkblock_xor. - admit. - admit. -congr. -admit. + by rewrite !size_cat size_nseq max_ler //= 1:/#; ring. + by rewrite size_cat size_nseq max_ler; smt(ratio_bnds). +have E: num0 (size m) = r - size m - 2. + rewrite /num0 -(modzMDl 1) modz_small. + by apply bound_abs; smt(ratio_bnds size_ge0). + by ring. +congr; apply (eq_from_nth false). + rewrite !size_cat /= size_rcons size_nseq max_ler E; first smt(size_ge0). + rewrite size_map2 min_ler. + by rewrite !size_cat !size_nseq !max_ler; smt(ratio_bnds size_ge0). + by rewrite size_cat size_nseq max_ler /=; smt(ratio_bnds). +move=> i; rewrite !size_cat /= size_rcons size_nseq max_ler ?num0_ge0 E. +rewrite -!cats1 (: size m + (1 + (r - size m - 2 + 1)) = r) 1:/# => Hi. +case: (i=r-1) => [->|?]. + rewrite nth_cat /= nth_cat. + rewrite (:! r - 1 < size m) 1:/# /=. + rewrite (:! r - 1 - size m - 1 < size (nseq (r - size m - 2) false)) /=. + by rewrite size_nseq max_ler /#. + rewrite (:r - 1 - size m <> 0) 1:/# /=. + rewrite (:r - 1 - size m - 1 - size (nseq (r - size m - 2) false) = 0) /=. + by rewrite size_nseq max_ler /#. + rewrite (nth_map2 false false). + rewrite min_ler. + by rewrite size_cat size_nseq max_ler 1:/# !size_cat /= size_nseq max_ler /#. + by rewrite size_cat size_nseq max_ler /#. + rewrite !nth_cat size_cat /=. + rewrite (:! r - 1 < size m + 1) 1:/# /=. + rewrite nth_nseq 1:/# /= size_nseq max_ler 1:/# ltzz /=. + by ring. +rewrite (nth_map2 false false). + rewrite min_ler. + by rewrite size_cat size_nseq max_ler 1:/# !size_cat /= size_nseq max_ler /#. + by rewrite size_cat size_nseq max_ler /#. +have ->: nth false (nseq (Top.ratio - 1) false ++ [true]) i = false. + rewrite nth_cat size_nseq max_ler 1:/# (: i < r-1) 1:/# /=. + by rewrite nth_nseq /#. +rewrite Bool.xor_false nth_cat. +case: (i < size m) => I1. + by rewrite -catA nth_cat I1. +rewrite eq_sym -catA nth_cat I1 /=; case: (i-size m <> 0) => I2 //=. +rewrite nth_cat size_nseq max_ler 1:/#. +rewrite (:i - size m - 1 < r - size m - 2) 1:/# /=. +by rewrite !nth_nseq /#. qed. lemma finalblockP mbits m: @@ -925,25 +944,47 @@ rewrite block0star1P; first rewrite size_cat size_w8L2bits /#. congr; congr. rewrite w64L2bits_cat. have ->: nseq (r - size (w8L2bits m ++ mbits) - 1) false - = nseq (chunkfillsize 64 (8*size m)) false + = (nseq (chunkfillsize 8 (size (mbits ++ [true]))) false + ++ nseq (chunkfillsize 64 (8*(size m+1))) false) ++ nseq (r - 64*size (final_block64 (trail_byte mbits) m)) false. - admit. + rewrite -!nseq_add; first 2 smt(chunkfillsize_cmp size_ge0). + smt(chunkfillsize_cmp size_cat size_ge0). + smt(size_final_block64 ratio_bnds). + congr; rewrite size_final_block64 !size_cat size_w8L2bits /=. + rewrite chunkfillsizeE' //; first smt(size_ge0). + rewrite chunkfillsizeE' //=; first smt(size_ge0). + rewrite mulzDr /= modz_small; first smt(size_ge0). + by rewrite mulzDr !addzA /= (mulzC 64) divzE; ring. rewrite !catA; congr; last first. rewrite w64L2bits_nseq0. rewrite /final_block64 size_final_block64. smt(size_ge0). by rewrite mulzDr ratio64P; congr; ring. rewrite /final_block64 take_oversize. - admit. - rewrite bits2w64LK' /chunkfill w8L2bits_cat -!catA; congr. -have ->: w8L2bits [trail_byte mbits] - = chunkfill false 8 (mbits ++ [true]). - admit. -rewrite /chunkfill -!catA -nseq_add. - admit. + rewrite size_bits2w64L size_w8L2bits size_cat /=. + move: Hm; rewrite /ratio8 /ratio64. admit. -congr; congr; congr => //. -rewrite !chunkfillsizeE' //. admit. admit. admit. admit. +rewrite bits2w64LK' /chunkfill w8L2bits_cat -!catA; congr. +have ->: w8L2bits [trail_byte mbits] = chunkfill false 8 (mbits ++ [true]). + rewrite /trail_byte /w8L2bits /chunkfill /= /flatten /=. + pose L:= (nth false _ 0 :: _). + apply (eq_from_nth false). + rewrite !size_cat /= size_nseq max_ler 1:/# chunkfillsizeE' //; first smt(size_ge0). + rewrite modz_small; first apply bound_abs; smt(size_ge0). + by ring. + rewrite (:size L=8) //. + move=> i Hi; have: i \in iota_ 0 8 by smt(). + move=> {Hi} Hi. + rewrite -catA !nth_cat /= nth_nseq_if. + move: i Hi; rewrite /L -List.allP /= => {L}. + move: mbits Hmbits => [|x0 [|x1 [|x2 [|x3 [|x4 [|x5 xs]]]]]] //=. + smt(size_ge0). +rewrite {1}/chunkfill -!catA; congr; congr; congr; congr. +rewrite !size_cat /= !chunkfillsizeE' //; first 4 smt(size_ge0). +rewrite size_nseq max_ler 1:/# (modz_small _ 8); first apply bound_abs; smt(size_ge0). +rewrite /= (:size mbits + 1 + (7 - size mbits)=8) 1:/#. +rewrite (:8 * size m + 8 - 1 = 8*(size m + 1) - 1) 1:/#. +by ring. qed. @@ -968,9 +1009,10 @@ have ->/=: ! ratio64 < size l. rewrite w64L2bits_cat /l size_nseq max_ler; first smt(ratio64_bnds). have ->/=: ! ratio64 - (ratio64 - 1) <= 0 by smt(). have ->: nseq (r-1) false = nseq (64 * (ratio64-1)) false ++ nseq 63 false. - admit. + rewrite -nseq_add //; first smt(ratio64_bnds). + by congr; rewrite mulzDr -ratio64P; ring. rewrite -catA; congr. - admit. + rewrite w64L2bits_nseq0; smt(ratio64_bnds). rewrite -(W64.shlMP 1 63) //. rewrite /w64L2bits /=. have P: forall i, W64.one.[i] = (i=0). From b87da8a07738b8604fe0b2de1717c6e9f2045199 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jos=C3=A9=20Bacelar=20Almeida?= Date: Fri, 3 May 2019 02:54:50 +0100 Subject: [PATCH 378/525] upd --- proof/impl/Spec1600.ec | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/proof/impl/Spec1600.ec b/proof/impl/Spec1600.ec index ade3539..09f3f07 100644 --- a/proof/impl/Spec1600.ec +++ b/proof/impl/Spec1600.ec @@ -962,8 +962,7 @@ rewrite !catA; congr; last first. by rewrite mulzDr ratio64P; congr; ring. rewrite /final_block64 take_oversize. rewrite size_bits2w64L size_w8L2bits size_cat /=. - move: Hm; rewrite /ratio8 /ratio64. - admit. + by rewrite -ltzE; smt(divz_cmp). rewrite bits2w64LK' /chunkfill w8L2bits_cat -!catA; congr. have ->: w8L2bits [trail_byte mbits] = chunkfill false 8 (mbits ++ [true]). rewrite /trail_byte /w8L2bits /chunkfill /= /flatten /=. From e8b8ae413aece580a8c9372f50bdff28e98a3778 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jos=C3=A9=20Bacelar=20Almeida?= Date: Fri, 3 May 2019 11:31:57 +0100 Subject: [PATCH 379/525] upd --- proof/impl/Spec1600.ec | 87 +++++++++--------------------------------- 1 file changed, 17 insertions(+), 70 deletions(-) diff --git a/proof/impl/Spec1600.ec b/proof/impl/Spec1600.ec index 09f3f07..49b86b3 100644 --- a/proof/impl/Spec1600.ec +++ b/proof/impl/Spec1600.ec @@ -1051,42 +1051,6 @@ rewrite /addfinalblock addfinalbit_r addstate_r -Hst -Block.xorwA; congr. by apply finalblockP. qed. -(* -lemma of_list_take ['a] (dfl : 'a) (l : 'a list): -Array25.of_list dfl l = Array25.of_list dfl (take 25 l). -proof. -apply Array25.ext_eq => *. -rewrite !Array25.get_of_list //. -by rewrite nth_take // /#. -qed. - -lemma of_list_cat_nseq ['a] n (dfl : 'a) (l : 'a list): -Array25.of_list dfl l = Array25.of_list dfl (l++nseq n dfl). -proof. -apply Array25.ext_eq => *. -rewrite !Array25.get_of_list //. -rewrite nth_cat. -case: (x < size l) => ? //. -rewrite nth_out 1:/#. -case: (x - size l < n) => ?. - by rewrite nth_nseq /#. -rewrite nth_out //. -by rewrite size_nseq /max; case: (0 < n) => ? /#. -qed. - -lemma of_listK' ['a]: - forall (dfl : 'a) (l : 'a list), - to_list (Array25.of_list dfl l) - = take 25 l++nseq (25-size l) dfl. -proof. -move=> *. -rewrite of_list_take (of_list_cat_nseq (25-size l)) of_listK //. -rewrite size_cat size_take // size_nseq. -case: (25 < size l) => ?. - by rewrite max_lel /#. -by rewrite max_ler /#. -qed. -*) (* [squeezestate] extracts a [ratio64] 64bit words from the state *) op squeezestate (st: state): W64.t list = @@ -1211,7 +1175,7 @@ lemma spec_correct mbits: equiv [ Sponge(IdealizedPerm).f ~ Spec0(ConcretePerm).f : bs{1} = w8L2bits m{2} ++ mbits /\ n{1} = 8*outl{2} /\ - trailbyte{2} = trail_byte mbits /\ size mbits < 5 + trailbyte{2} = trail_byte mbits /\ size mbits < 6 ==> res{1} = w8L2bits res{2}]. proof. proc; simplify; exists* outl{2}; elim* => outl2. @@ -1228,27 +1192,21 @@ seq 3 2: (#[/1,3:]pre /\ match_state (sa,sc){1} st{2} /\ xs{1} = pad2blocks (w8L2bits m{2} ++ mbits) /\ outl2 = outl{2} /\ 1<=size xs{1}). wp; call perm_correct; wp; skip; progress. - + admit (* -sa{1} +^ head b0 (pad2blocks (w8L2bits m{2} ++ mbits)) = -state_r (addfullblock st{2} (xtrblock m{2}).`1) -*). - + admit (* -sc{1} = state_c (addfullblock st{2} (xtrblock m{2}).`1 -*). + + rewrite eq_sym; apply addfullblockP => //. + by move: H0; rewrite /match_state /=. + + move: H0; rewrite addstate_c /match_state //=. + admit (* size_take_block64 *). + by rewrite H6. + by rewrite H6. - + admit(* -behead (pad2blocks (w8L2bits m{2} ++ mbits)) = -pad2blocks (w8L2bits (xtrblock m{2}).`2 ++ mbits) -*). - + admit (* sizes *). - + admit (* sizes *). + + by rewrite behead_pad2blocks8. + + admit (* size_behead: 1 <= size... *). + + admit (* size_take_block64: r8 <= size ... *). + admit (* sizes *). + admit (* sizes *). skip => |> *; progress. + by rewrite st0_r. + by rewrite st0_c. - + admit (* sizes *). + + admit (* 1 <= size (pad2blocks ...*). + admit (* sizes *). + admit (* sizes *). + admit (* sizes *). @@ -1283,20 +1241,16 @@ seq 4 6: (#[/5]pre /\ 0 < outl2 /\ n{1} = 8*outl2 /\ (z=[] /\ i=0){1}). wp; call perm_correct; wp; skip => [??]. progress. - + admit (* -sa{1} +^ head b0 (pad2blocks8 (trail_byte mbits) m{2}) = -state_r (addfinalblock st{2} (finalblock (trail_byte mbits) m{2})) -*). - + admit (* -sc{1} = state_c (addfinalblock st{2} (finalblock (trail_byte mbits) m{2})) -*). + + rewrite eq_sym; apply addfinalblock_r => //. + admit (* sizes *). + by move: H0; rewrite /match_state /=. + + move: H0; rewrite /addfinalblock. + admit (* addfinalbit_c +addstate_c /match_state /=.*). + by rewrite H4. + by rewrite H4. + smt(). - + admit (* -take (8 * outl{2}) (ofblock (state_r result_R)) = -w8L2bits (xtrbytes outl{2} (squeezestate result_R)) -*). + + by rewrite xtrbytes_squeezestate H4. splitwhile {1} 1: (i+1 < (n + r - 1) %/ r). seq 1 1: (#[:-2]pre /\ (i+1=(n + r - 1) %/ r){1}). while (#[:-2]pre /\ 0 <= i{1}+1 <= (n{1} + r - 1) %/ r /\ @@ -1322,14 +1276,7 @@ seq 1 1: (#[:-2]pre /\ (i+1=(n + r - 1) %/ r){1}). rewrite (mulzC _ (i{1} * ratio8)) -!mulzA. rewrite -{1}(add0z (_ + _)%Int) lez_add2r. apply ltzW; smt(). - congr. - have ->:(8 * (outl{2} + (i{1} + 1) * ratio8) - - (i{1} * (8 * ratio8) + 8 * ratio8)) - = 8 * outl{2} by ring. -admit (* -w8L2bits (xtrbytes outl{2} (squeezestate result_R)) = -take (8 * outl{2}) (ofblock (state_r result_R)) -*). + by congr; rewrite xtrbytes_squeezestate; congr; ring. + smt(). + have ->: 2 = 1 + 1 by ring. by rewrite addzA -ltzE needed_blocks8P /#. From ddb5e9aa4ee4ba79c2ea2a876415e14be6433245 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jos=C3=A9=20Bacelar=20Almeida?= Date: Fri, 3 May 2019 12:07:07 +0100 Subject: [PATCH 380/525] upd --- proof/impl/Spec1600.ec | 54 +++++++++++++++++++----------------------- 1 file changed, 24 insertions(+), 30 deletions(-) diff --git a/proof/impl/Spec1600.ec b/proof/impl/Spec1600.ec index 49b86b3..02dbe85 100644 --- a/proof/impl/Spec1600.ec +++ b/proof/impl/Spec1600.ec @@ -224,12 +224,6 @@ op chunkfillsize (n sz:int) = (-sz)%%n. lemma chunkfillsize_cmp n sz: 0 < n => 0 <= chunkfillsize n sz < n. proof. move=> Hn; rewrite /chunkfillsize; smt(modz_cmp). qed. -(* -lemma chunkfillsize_ge0 n sz: - 0 < n => - 0 <= chunkfillsize n sz. -proof. move=> Hn; rewrite /chunkfillsize; smt(modz_cmp). qed. -*) lemma chunkfillsizeP n sz k: 0 < n => chunkfillsize n (n*k+sz) = chunkfillsize n sz. @@ -274,16 +268,6 @@ proof. by move=> Hn Hsz; rewrite /chunkfill chunkfillsizeE // ?size_ge0 !Hsz /= cats0. qed. -(* -lemma size_chunkfill' ['a] (d:'a) n l: - 0 < n => - size (chunkfill d n l) = size l + chunkfillsize n (size l). -proof. -move=> Hn; rewrite /chunkfill size_cat size_nseq max_ler //. -smt(chunkfillsize_cmp). -qed. -*) - lemma size_chunkfill ['a] (d:'a) n l: 0 < n => size (chunkfill d n l) = (size l - 1) %/ n * n + n. @@ -392,15 +376,6 @@ qed. op bits2w64L (bs: bool list) : W64.t list = map W64.bits2w (BitEncoding.BitChunking.chunk 64 (chunkfill false 64 bs)). -(* -lemma size_bits2w64L bs: - size (bits2w64L bs) = (size bs + chunkfillsize 64 (size bs)) %/ 64. -proof. -rewrite /bits2w64L size_map BitEncoding.BitChunking.size_chunk //. -by rewrite size_chunkfill. -qed. -*) - lemma size_bits2w64L bs: size (bits2w64L bs) = (size bs - 1) %/ 64 + 1. proof. @@ -677,6 +652,11 @@ proof. rewrite /state_c c0P state2bits0 drop_nseq; smt(ratio_bnds). qed. (* [match_state] relates both state representations *) op match_state x st = x = (state_r st, state_c st). +lemma match_state_r (x:block*capacity) st: + match_state x st => x.`1 = state_r st +by move=> ->. + + lemma mkblock_xor l1 l2: size l1 = r => size l2 = r => mkblock l1 +^ mkblock l2 = mkblock (map2 Bool.(^^) l1 l2). @@ -715,6 +695,21 @@ type mess_t = W8.t list. op take_block64 (m: W8.t list): W64.t list * W8.t list = (bits2w64L (w8L2bits (take ratio8 m)), drop ratio8 m). +lemma size_take_block64l m: + ratio8 <= size m => size (take_block64 m).`1 = ratio64. +proof. +move=> Hm; rewrite /take_block64 /= size_bits2w64L size_w8L2bits. +rewrite size_take'; first smt(ratio_bnds). +by rewrite Hm /= /ratio8 -mulzA /= mulzC divzMDl. +qed. + +lemma size_take_block64r m: + ratio8 <= size m => size (take_block64 m).`2 = size m - ratio8. +proof. +move=> Hm; rewrite /take_block64 /= size_drop; first smt(ratio_bnds). +by rewrite max_ler /#. +qed. + lemma mkpad_ratio n: 0 <= n => mkpad (r + n) = mkpad n. proof. @@ -1192,15 +1187,14 @@ seq 3 2: (#[/1,3:]pre /\ match_state (sa,sc){1} st{2} /\ xs{1} = pad2blocks (w8L2bits m{2} ++ mbits) /\ outl2 = outl{2} /\ 1<=size xs{1}). wp; call perm_correct; wp; skip; progress. - + rewrite eq_sym; apply addfullblockP => //. - by move: H0; rewrite /match_state /=. - + move: H0; rewrite addstate_c /match_state //=. - admit (* size_take_block64 *). + + by rewrite (match_state_r _ _ H0) eq_sym; apply addfullblockP. + + by move: H0; rewrite addstate_c /match_state //= size_take_block64l. + by rewrite H6. + by rewrite H6. + by rewrite behead_pad2blocks8. + admit (* size_behead: 1 <= size... *). - + admit (* size_take_block64: r8 <= size ... *). + + rewrite size_take_block64r //. + admit (* sizes *). + admit (* sizes *). + admit (* sizes *). skip => |> *; progress. From 94cf560b02cded20ce5836f0d6f619ffd8ef5d15 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jos=C3=A9=20Bacelar=20Almeida?= Date: Fri, 3 May 2019 18:18:04 +0100 Subject: [PATCH 381/525] finished spec proof --- proof/impl/Spec1600.ec | 80 +++++++++++++++++++++++++++++++++++------- 1 file changed, 67 insertions(+), 13 deletions(-) diff --git a/proof/impl/Spec1600.ec b/proof/impl/Spec1600.ec index 02dbe85..f38a49a 100644 --- a/proof/impl/Spec1600.ec +++ b/proof/impl/Spec1600.ec @@ -656,6 +656,9 @@ lemma match_state_r (x:block*capacity) st: match_state x st => x.`1 = state_r st by move=> ->. +lemma match_state_c (x:block*capacity) st: + match_state x st => x.`2 = state_c st +by move=> ->. lemma mkblock_xor l1 l2: size l1 = r => size l2 = r => @@ -1046,6 +1049,24 @@ rewrite /addfinalblock addfinalbit_r addstate_r -Hst -Block.xorwA; congr. by apply finalblockP. qed. +lemma addfinalbit_c st: + state_c (addfinalbit st) = state_c st. +proof. +rewrite /addfinalbit /state_c /state2bits; congr. +rewrite -ratio64P !drop_w64L2bits; congr. +pose newst := Array25.to_list _. +have E1: (size (drop ratio64 newst) = 25 - ratio64). + rewrite size_drop; first smt(ratio64_bnds). + rewrite size_to_list max_ler; smt(ratio64_bnds). +have E2: (size (drop ratio64 (to_list st)) = 25 - ratio64). + rewrite size_drop; first smt(ratio64_bnds). + rewrite size_to_list max_ler; smt(ratio64_bnds). +apply (eq_from_nth witness). + by rewrite E1 E2. +move=> i Hi; rewrite !nth_drop 1..4:[smt(ratio64_bnds)]. +rewrite 2!get_to_list set_neqiE; smt(ratio64_bnds). +qed. + (* [squeezestate] extracts a [ratio64] 64bit words from the state *) op squeezestate (st: state): W64.t list = @@ -1166,6 +1187,19 @@ axiom perm_correct : axiom perm_lossless: islossless IdealizedPerm.f. +lemma size_behead ['a] (l:'a list): + size (behead l) = max 0 (size l - 1). +proof. by case: l => [|x xs] /=; rewrite /max //=; smt(size_ge0). qed. + +lemma size_pad2blocks8_ge x m mbits: + size mbits < 6 => + x <= size (pad2blocks (w8L2bits m ++ mbits)) <=> x*ratio8 - ratio8 <= size m. +proof. +move=> Hmbits; rewrite size_pad2blocks8 //. +rewrite (: x <= size m %/ ratio8 + 1 = x-1 <= size m %/ ratio8) 1:/#. +by rewrite lez_divRL; smt(ratio8_bnds). +qed. + lemma spec_correct mbits: equiv [ Sponge(IdealizedPerm).f ~ Spec0(ConcretePerm).f : bs{1} = w8L2bits m{2} ++ mbits /\ @@ -1192,19 +1226,34 @@ seq 3 2: (#[/1,3:]pre /\ match_state (sa,sc){1} st{2} /\ + by rewrite H6. + by rewrite H6. + by rewrite behead_pad2blocks8. - + admit (* size_behead: 1 <= size... *). + + rewrite size_behead size_pad2blocks8 // max_ler /= lez_divRL; smt(ratio8_bnds). + rewrite size_take_block64r //. - admit (* sizes *). - + admit (* sizes *). - + admit (* sizes *). + have: 3 <= size (pad2blocks (w8L2bits m{2} ++ mbits)). + move: H8; rewrite size_behead max_ler. + rewrite size_pad2blocks8 //= lez_divRL; smt(ratio8_bnds). + smt(). + by rewrite size_pad2blocks8_ge /#. + + have : 2 <= size (pad2blocks (w8L2bits m{2} ++ mbits)). + by rewrite size_pad2blocks8_ge // /#. + by pose L:= pad2blocks _; move: L => [|x1 [|x2 xs]]. + + have : 2 < size (pad2blocks (w8L2bits m{2} ++ mbits)). + rewrite size_pad2blocks8 //. + apply (StdOrder.IntOrder.ltr_le_trans (2+1)) => //. + apply lez_add2r; rewrite lez_divRL /= 1:[smt(ratio8_bnds)]. + move: H7; rewrite /take_block64 /= size_drop 1:[smt(ratio8_bnds)]. + by rewrite max_ler /#. + by pose L:= pad2blocks _; move: L => [|x1 [|x2 [|x3 xs]]] => //=; smt(). skip => |> *; progress. + by rewrite st0_r. + by rewrite st0_c. - + admit (* 1 <= size (pad2blocks ...*). - + admit (* sizes *). - + admit (* sizes *). - + admit (* sizes *). - + admit (* sizes *). + + rewrite size_pad2blocks8 //; smt(size_ge0 divz_ge0 ratio8_bnds). + + by move: H1; rewrite ltzE /= size_pad2blocks8_ge /#. + + have: 2 <= size (pad2blocks (w8L2bits m{2} ++ mbits)). + by rewrite size_pad2blocks8_ge /#. + smt(). + + by rewrite ltzE /= size_pad2blocks8_ge /#. + + rewrite size_pad2blocks8 // divz_small //. + apply bound_abs; smt(size_ge0). (* ABSORB final block *) unroll {1} 1; rcondt {1} 1. move=> *; skip => |> *. @@ -1236,11 +1285,16 @@ seq 4 6: (#[/5]pre /\ 0 < outl2 /\ n{1} = 8*outl2 /\ wp; call perm_correct; wp; skip => [??]. progress. + rewrite eq_sym; apply addfinalblock_r => //. - admit (* sizes *). + move: H1; rewrite size_pad2blocks8 //. + rewrite -{2}(addz0 1) addzC=> /addzI. + rewrite -divz_eq0; smt(ratio8_bnds). by move: H0; rewrite /match_state /=. - + move: H0; rewrite /addfinalblock. - admit (* addfinalbit_c -addstate_c /match_state /=.*). + + rewrite /addfinalblock addfinalbit_c addstate_c. + rewrite size_final_block64. + move: H1; rewrite size_pad2blocks8 //. + rewrite -{2}(addz0 1) addzC=> /addzI. + by rewrite -divz_eq0; smt(ratio8_bnds). + by rewrite (match_state_c _ _ H0). + by rewrite H4. + by rewrite H4. + smt(). From 7aa736a2263bce0466435b133416761b28e489bb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Sat, 4 May 2019 09:22:11 +0000 Subject: [PATCH 382/525] Use Jasmin namespace --- proof/impl/Spec1600.ec | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/proof/impl/Spec1600.ec b/proof/impl/Spec1600.ec index f38a49a..f9ffe73 100644 --- a/proof/impl/Spec1600.ec +++ b/proof/impl/Spec1600.ec @@ -1,5 +1,5 @@ require import AllCore List Int IntDiv. -(*from Jasmin*) require import JArray JMemory JModel JWord JWord_array JUtils. +from Jasmin require import JArray JMemory JModel JWord JWord_array JUtils. op ratio :int. axiom ratio_bnds: 0 < ratio < 1600. From 3a73792be36c2a2abda4b197d0463d03c09bf500 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Sat, 4 May 2019 13:44:45 +0100 Subject: [PATCH 383/525] Fix Ops --- proof/impl/perm/Ops.ec | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/proof/impl/perm/Ops.ec b/proof/impl/perm/Ops.ec index e89e7c8..7cd4a0e 100644 --- a/proof/impl/perm/Ops.ec +++ b/proof/impl/perm/Ops.ec @@ -562,7 +562,7 @@ qed. equiv eq_iVPERMQ : Ops.iVPERMQ ~ OpsV.iVPERMQ : is4u64 x{1} x{2} /\ ={p} /\ (p{1} \in (map W8.of_int [128; 147; 78; 57; 141; 27; 114; 0; 30])) ==> is4u64 res{1} res{2}. -proof. proc; wp; skip; rewrite /is4u64 => /> &1 &2 [#] />. qed. +proof. proc; wp; skip; rewrite /is4u64 => /> &1 &2 [#|] />. qed. lemma lsr_2u64 (w1 w2:W64.t) (x:int) : 0 <= x <= 64 => pack2 [w1; w2] `>>>` x = pack2 [(w1 `>>>` x) `|` (w2 `<<<` 64 - x); w2 `>>>` x]. @@ -639,8 +639,8 @@ equiv eq_iVPBLENDD_256 : Ops.iVPBLENDD_256 ~ OpsV.iVPBLENDD_256 : ==> is4u64 res{1} res{2}. proof. - by proc; wp; skip; rewrite /is4u64 => /> &1 &2 [#] />; - cbv delta; rewrite !W8.of_intwE /=; apply W8u32.allP;cbv delta. + proc; wp; skip; rewrite /is4u64 => /> &1 &2. + by move=> [#|] />; cbv delta; rewrite !W8.of_intwE /=; apply W8u32.allP;cbv delta. qed. equiv eq_iVPSHUFD_256 : Ops.iVPSHUFD_256 ~ OpsV.iVPSHUFD_256 : From 01ae38ab7d8a905870ea425a454ec85d07b0d7a1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jos=C3=A9=20Bacelar=20Almeida?= Date: Tue, 7 May 2019 11:38:14 +0100 Subject: [PATCH 384/525] upd --- proof/impl/Spec1600.ec | 24 ------------------------ 1 file changed, 24 deletions(-) diff --git a/proof/impl/Spec1600.ec b/proof/impl/Spec1600.ec index f38a49a..894b499 100644 --- a/proof/impl/Spec1600.ec +++ b/proof/impl/Spec1600.ec @@ -1344,27 +1344,3 @@ rcondf {1} 3; first by move=> *; wp; skip => |> * /#. by wp; skip => |> *. qed. - - - -(* -lemma bound_conv (s : bool list) q : - size s %% 8 = 0 => - r %/ 8 - size s %/ 8 %% (r %/ 8) = q => - (size s + q*8) %% r = 0. -move=> *. -have rr : r - 8*(size s %/ 8 %% (r %/ 8)) = 8*q. -+ by rewrite {1}(andWl _ _ (edivzP r 8)) (:r %% 8 = 0) 1:[smt(rsize)] /#. -move : rr. -rewrite (mulz_modr 8) 1:/#. -rewrite (: 8 * (size s %/ 8) %% (8 * (r %/ 8)) = size s %% r). -+ by rewrite 2!(mulzC 8) 2!divzE H /= (: r %% 8 = 0) 1:[smt(rsize)]. -rewrite (: size s + q * 8 = q * 8 + size s) 1:/#. -rewrite -modzDmr. -move => *. -rewrite (_: size s %% r = r - 8 * q ) 1:/#. -by rewrite (: q * 8 + (r - 8 * q) = r) 1:/# modzz. -qed. -*) - - From 5692e660639eb4ce599c85292cbff9b5b1a769f6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jos=C3=A9=20Bacelar=20Almeida?= Date: Thu, 9 May 2019 11:26:32 +0100 Subject: [PATCH 385/525] upd --- proof/impl/Spec1600.ec | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/proof/impl/Spec1600.ec b/proof/impl/Spec1600.ec index 7848766..8bd73b4 100644 --- a/proof/impl/Spec1600.ec +++ b/proof/impl/Spec1600.ec @@ -1,5 +1,5 @@ require import AllCore List Int IntDiv. -from Jasmin require import JArray JMemory JModel JWord JWord_array JUtils. +(*from Jasmin*) require import JArray JMemory JModel JWord JWord_array JUtils. op ratio :int. axiom ratio_bnds: 0 < ratio < 1600. @@ -533,7 +533,8 @@ qed. (* 1600bit state *) -clone export PolyArray as Array25 with op size <- 25. +(*clone export PolyArray as Array25 with op size <- 25.*) +require import Array25. type state = W64.t Array25.t. op st0 : state = Array25.create W64.zero. @@ -1344,3 +1345,6 @@ rcondf {1} 3; first by move=> *; wp; skip => |> * /#. by wp; skip => |> *. qed. +end section. + + From 02041d9e74f6dd9bd8449c061de27e419c8fb4af Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jos=C3=A9=20Bacelar=20Almeida?= Date: Thu, 9 May 2019 12:37:02 +0100 Subject: [PATCH 386/525] split in several files --- proof/impl/EclibExtra.ec | 283 +++++++++++ proof/impl/JWordList.ec | 225 +++++++++ proof/impl/Spec1600.ec | 1007 ++++++++++---------------------------- proof/impl/Sponge1600.ec | 20 +- 4 files changed, 766 insertions(+), 769 deletions(-) create mode 100644 proof/impl/EclibExtra.ec create mode 100644 proof/impl/JWordList.ec diff --git a/proof/impl/EclibExtra.ec b/proof/impl/EclibExtra.ec new file mode 100644 index 0000000..83112f0 --- /dev/null +++ b/proof/impl/EclibExtra.ec @@ -0,0 +1,283 @@ +(* Miscellaneous results on EC standard library and JUtils constructions *) +require import Core Int IntDiv List. +require BitEncoding. +(*---*) import IntExtra. + +(*from Jasmin*) require JUtils. + +lemma nth_inside ['a] d1 d2 (l: 'a list) i: + 0 <= i < size l => + nth d1 l i = nth d2 l i. +proof. +elim: l i => /=; first smt(). +move=> x xs IH i Hi; case: (i=0) => E //. +by rewrite IH /#. +qed. + +lemma nseq_add ['a] (x:'a) n1 n2: + 0 <= n1 => 0 <= n2 => nseq (n1+n2) x = nseq n1 x ++ nseq n2 x. +proof. +move=> Hn1 Hn2; elim/natind: n1 Hn1. + by move=> n ??; rewrite (: n=0) 1:/# nseq0. +by move=> n Hn IH H; rewrite nseqS // (addzC n) -addzA addzC nseqS 1:/# IH //. +qed. + +lemma take_nseq ['a] n1 n2 (x: 'a): + take n1 (nseq n2 x) = nseq (min n1 n2) x. +proof. +elim/natind: n2 n1. + move=> n Hn n1; rewrite !nseq0_le //. + by have [? ?]:= min_is_lb n1 n; apply (lez_trans n). +move=> n Hn IH n1; case: (n1 <= 0) => /=. + move=> ?; rewrite take_le0 // nseq0_le //. + by have [? ?]:= min_is_lb n1 (n+1); apply (lez_trans n1). +rewrite -ltzNge=> ?; rewrite nseqS // take_cons H /=. +have ->: min n1 (n + 1) = (min (n1-1) n)+1. + rewrite /min; case: (n1 < n+1) => ?. + by have ->/=: n1 - 1 < n by smt(). + by have ->/=: !(n1 - 1 < n) by smt(). +by rewrite nseqS /min /#. +qed. + +lemma drop_nseq ['a] n1 n2 (x: 'a): + 0 <= n1 => drop n1 (nseq n2 x) = nseq (n2-n1) x. +proof. +elim/natind: n1 n2. + move=> n Hn n2 Hn'; have ->: n=0 by smt(). + by rewrite drop0. +move=> n Hn IH n2 Hn'. +case: (n2 <= 0) => /= ?. + by rewrite !nseq0_le // /#. +have ->: n2 = n2 - 1 + 1 by smt(). +by rewrite nseqS 1:/# drop_cons ltzS Hn /= IH //; congr; smt(). +qed. + +lemma dropS ['a] (l: 'a list) n: + 0 <= n => + drop (n + 1) l = behead (drop n l). +proof. +elim: l n => [|x xs] //= IH n Hn. +have ->/=: !(n+1 <= 0) by smt(). +case: (n=0). + by move=> -> /=; rewrite drop0. +move=> ?; have ->/=: !(n<=0) by smt(). +by rewrite -IH /#. +qed. + +lemma drop_drop ['a] (l: 'a list) n1 n2: + 0 <= n1 => 0 <= n2 => + drop n1 (drop n2 l) = drop (n1+n2) l. +proof. +elim/natind: n1. + by move=> n Hn; rewrite drop_le0 /#. +move=> n Hn IH H1 H2. +by rewrite dropS // IH // -dropS /#. +qed. + +(* [eq_mkseq'] is a more refined version of [eq_mkseq] *) +lemma eq_mkseq' ['a] (f g : int -> 'a) n: + (forall (x : int), 0 <= x < n => f x = g x) => mkseq f n = mkseq g n. +proof. +elim/natind: n f g => /=. + by move=> n Hn f g H; rewrite !mkseq0_le. +move=> n Hn IH f g H. +rewrite !(addzC n) !mkseq_add //; congr. + by rewrite !mkseq1 H /#. +apply IH => x Hx /=. +by rewrite H /#. +qed. + +lemma size_behead ['a] (l:'a list): + size (behead l) = max 0 (size l - 1). +proof. by case: l => [|x xs] /=; rewrite /max //=; smt(size_ge0). qed. + +lemma behead_map ['a 'b] (f:'a->'b) (l:'a list): + behead (map f l) = map f (behead l) +by elim: l. + +lemma behead_mkseq ['a] (f : int -> 'a) n: + behead (mkseq f n) = mkseq (fun i=> f (1+i)) (n-1). +proof. +elim/natind: n => /=. + by move=> n Hn; rewrite !mkseq0_le /#. +by move=> n Hn IH; rewrite addzC mkseq_add // mkseq1. +qed. + +print BitEncoding.BitChunking.chunk. +lemma behead_chunk ['a] n (l:'a list): + behead (BitEncoding.BitChunking.chunk n l) + = BitEncoding.BitChunking.chunk n (drop n l). +proof. +case: (size l < n). + move=> ?; rewrite drop_oversize 1:/#. + rewrite /BitEncoding.BitChunking.chunk behead_mkseq. + rewrite divz_small /=; first smt(size_ge0). + by rewrite mkseq0_le //= mkseq0. +case: (0 < n); last first. +rewrite -!lezNgt => ??. + by rewrite drop_le0 // !BitEncoding.BitChunking.chunk_le0. +rewrite -lezNgt => ??. +rewrite /BitEncoding.BitChunking.chunk behead_mkseq /=. +rewrite size_drop // 1:/# max_ler 1:/#. +have ->: (size l - n) %/ n = size l %/ n - 1. + have ->: size l = (size l - n) + 1*n by ring. + by rewrite divzMDr /#. +by apply eq_mkseq' => x Hx /=; rewrite drop_drop /#. +qed. + + +(* a variant of [size_take] that is more convenient in some cases *) +lemma size_take' ['a] n (s: 'a list): + 0 <= n => size (take n s) = if n <= size s then n else size s. +proof. +move=> Hn; rewrite size_take //. +case: (n = size s) => E; first by rewrite E. +case: (n <= size s) => H. + by rewrite (: n < size s) /#. +by rewrite (: ! n < size s) /#. +qed. + +(* likewise for [take_cat] *) +lemma take_cat' ['a] n (s1 s2: 'a list): + take n (s1++s2) = if n <= size s1 then take n s1 else s1 ++ take (n-size s1) s2. +proof. +rewrite take_cat //. +case: (n = size s1) => E. + by rewrite !E /= take0 cats0 take_size. +case: (n <= size s1) => H. + by rewrite (: n < size s1) /#. +by rewrite (: ! n < size s1) /#. +qed. + +lemma chunk_take_eq ['a] n (l:'a list): + 0 < n => + BitEncoding.BitChunking.chunk n l + = BitEncoding.BitChunking.chunk n (take (size l %/ n * n) l). +proof. +move=> Hn; rewrite /BitEncoding.BitChunking.chunk. +have ->: (size (take (size l %/ n * n) l) %/ n) = (size l %/ n). + rewrite size_take'; first smt(size_ge0). + by rewrite lez_floor 1:/# /= mulzK 1:/#. +apply eq_mkseq' => x Hx /=. +rewrite -{1}(cat_take_drop (size l %/ n * n)). +rewrite drop_cat size_take'; first smt(size_ge0). +rewrite lez_floor 1:/# /= mulzC StdOrder.IntOrder.ltr_pmul2r 1:/#. +move: (Hx); move=> [? ->] /=. +have E: n <= size (drop (x * n) (take (size l %/ n * n) l)). + rewrite size_drop 1:/# max_ler; last first. + rewrite size_take' 1:/# lez_floor 1:/# /= -Ring.IntID.mulrBl. + by rewrite -{1}mulz1 {1}mulzC StdOrder.IntOrder.ler_pmul2r // -ltzS /#. + rewrite size_take' 1:/# lez_floor 1:/# /=. + smt(size_ge0). +by rewrite take_cat' E. +qed. + +op chunkfillsize (n sz:int) = (-sz)%%n. + +lemma chunkfillsize_cmp n sz: + 0 < n => 0 <= chunkfillsize n sz < n. +proof. move=> Hn; rewrite /chunkfillsize; smt(JUtils.modz_cmp). qed. + +lemma chunkfillsizeP n sz k: + 0 < n => chunkfillsize n (n*k+sz) = chunkfillsize n sz. +proof. +move=> Hn; rewrite /chunkfillsize. +by rewrite -modzNm mulzC modzMDl modzNm. +qed. + +lemma chunkfillsizeE' n sz: + 0 < n => 0 < sz => chunkfillsize n sz = n - 1 - (sz-1) %% n +by move=> ??; rewrite /chunkfillsize modNz. + +lemma divz_minus1 m d: + 0 < d => 0 <= m => ! d %| m => (m-1) %/ d = m %/ d. +proof. +move=> Hd Hm Hdvd. +rewrite {1}(divz_eq m d) -addzA divzMDl 1:/#; ring. +rewrite divz_small //; apply JUtils.bound_abs; split. + by move: Hdvd; rewrite dvdzE; smt(JUtils.modz_cmp). +by move=> ?; smt(JUtils.modz_cmp). +qed. + +lemma chunkfillsizeE n sz: + 0 < n => 0 <= sz => chunkfillsize n sz = if n %| sz then 0 else n - sz%%n. +proof. +move=> Hn Hsz'. +case: (n %| sz) . + rewrite /chunkfillsize dvdzE -modzNm => ->; smt(). +move=> ?. +have Hsz : 0 < sz by smt(dvdz0). +rewrite chunkfillsizeE' //. +have ->: n - 1 - (sz - 1) %% n = n - (1 + (sz - 1) %% n) by ring. +congr; congr. +by rewrite !modzE divz_minus1 //; ring. +qed. + +op chunkfill ['a] (d:'a) n l = l ++ nseq (chunkfillsize n (size l)) d. + +lemma dvd_chunkfill ['a] (d:'a) n l: + 0 < n => n %| size l => chunkfill d n l = l. +proof. +by move=> Hn Hsz; rewrite /chunkfill chunkfillsizeE // ?size_ge0 !Hsz /= cats0. +qed. + +lemma size_chunkfill ['a] (d:'a) n l: + 0 < n => + size (chunkfill d n l) = (size l - 1) %/ n * n + n. +proof. +move=> Hn; rewrite /chunkfill size_cat size_nseq max_ler //. + smt(chunkfillsize_cmp). +case: (size l = 0) => E. + by rewrite !E /= /chunkfillsize /= divNz //=; ring. +rewrite chunkfillsizeE' //; first smt(size_ge0). +have ->: size l + (n - 1 - (size l - 1) %% n) = (size l-1) + n - (size l-1) %% n + by ring. +rewrite {1}(divz_eq (size l - 1) n); ring. +qed. + +lemma chunkfillP ['a] (d:'a) n l: + 0 < n => + n %| size (chunkfill d n l). +proof. +move=> Hn; rewrite size_chunkfill //. +rewrite (: (size l - 1) %/ n * n + n = ((size l - 1) %/ n + 1) * n) 1:/#. +by rewrite dvdzE modzMl. +qed. + +lemma chunkfillK ['a] (d:'a) n l: + 0 < n => + chunkfill d n (chunkfill d n l) = chunkfill d n l. +proof. +move=> Hn; rewrite {1}/chunkfill chunkfillsizeE // ?size_ge0. +by rewrite !chunkfillP //= cats0. +qed. + +lemma take_map2 ['a 'b 'c] (f:'a -> 'b -> 'c) n l1 l2: + take n (JUtils.map2 f l1 l2) = JUtils.map2 f (take n l1) (take n l2). +proof. +elim: l1 l2 n => [|x xs IH] [|y ys] n //=; case:(n<=0) => // E. +by rewrite IH. +qed. + +lemma drop_map2 ['a 'b 'c] (f:'a -> 'b -> 'c) n l1 l2: + drop n (JUtils.map2 f l1 l2) = JUtils.map2 f (drop n l1) (drop n l2). +proof. +elim: l1 l2 n => [|x xs IH] [|y ys] n //=; case:(n<=0) => // E. + by case: (drop (n - 1) ys) => [|_ _]. + by case: (drop (n - 1) xs) => [|_ _]. +by rewrite IH. +qed. + +lemma map2_nseq0r ['a 'b] (f:'a -> 'b -> 'a) x0 n l: + size l = n => + (forall y, f y x0 = y) => + JUtils.map2 f l (nseq n x0) = l. +proof. +elim/natind: n l. + move=> n Hn l Hl H. + have E: n=0 by smt(size_ge0). + by move: Hl; rewrite E size_eq0 nseq0 => ->. +move=> n Hn IH [|x xs] //=; first smt(). +by move=> Hsz H; rewrite nseqS //= H IH /#. +qed. + diff --git a/proof/impl/JWordList.ec b/proof/impl/JWordList.ec new file mode 100644 index 0000000..3facb4e --- /dev/null +++ b/proof/impl/JWordList.ec @@ -0,0 +1,225 @@ +require import AllCore List Int IntDiv. +(*from Jasmin*) require import JWord JUtils. + + +require import EclibExtra. + +(* W8.t lists *) + +op w8L2bits (l: W8.t list) : bool list = + flatten (map W8.w2bits l). + +lemma w8L2bits_nil: w8L2bits [] = [] by done. + +lemma w8L2bits_cons x xs: w8L2bits (x::xs) = W8.w2bits x ++ w8L2bits xs. +proof. by rewrite /w8L2bits map_cons flatten_cons. qed. + +lemma w8L2bits_cat l1 l2: + w8L2bits (l1++l2) = w8L2bits l1 ++ w8L2bits l2. +proof. +elim: l1 => //=. + by rewrite w8L2bits_nil. +by move=> x xs IH; rewrite !w8L2bits_cons IH. +qed. + +lemma size_w8L2bits x: + size (w8L2bits x) = 8 * size x. +proof. +by rewrite /w8L2bits size_flatten -map_comp /(\o) /= StdBigop.Bigint.sumzE +StdBigop.Bigint.BIA.big_mapT /(\o) /= StdBigop.Bigint.big_constz count_predT_eq. +qed. + +hint simplify size_w8L2bits. + +lemma take_w8L2bits n l: + take (8*n) (w8L2bits l) = w8L2bits (take n l). +proof. +elim/natind: n l => //=. + move=> n Hn l; rewrite !take_le0 //. + by apply StdOrder.IntOrder.mulr_ge0_le0. +move=> n Hn IH [|x xs] /=. + by rewrite w8L2bits_nil. +have ->/=: ! (n+1 <= 0) by rewrite -ltzNge ltzS. +rewrite !w8L2bits_cons take_cat. +have ->/=: ! (8 * (n + 1) < size (w2bits x)) by rewrite W8.size_w2bits /#. +by rewrite mulzDr /= IH. +qed. + +lemma drop_w8L2bits n l: + drop (8*n) (w8L2bits l) = w8L2bits (drop n l). +proof. +elim/natind: n l => //=. + move=> n Hn l; rewrite !drop_le0 //. + by apply StdOrder.IntOrder.mulr_ge0_le0. +move=> n Hn IH [|x xs] /=. + by rewrite w8L2bits_nil. +have ->/=: ! (n+1 <= 0) by rewrite -ltzNge ltzS. +rewrite !w8L2bits_cons drop_cat. +have ->/=: ! (8 * (n + 1) < size (w2bits x)) by rewrite W8.size_w2bits /#. +by rewrite mulzDr /= IH. +qed. + + + +(* W64.t lists *) + + + +op w64L2bits (l: W64.t list) : bool list = + flatten (map W64.w2bits l). + +lemma size_w64L2bits l: + size (w64L2bits l) = 64 * size l. +proof. +by rewrite /w64L2bits size_flatten -map_comp /(\o) /= StdBigop.Bigint.sumzE +StdBigop.Bigint.BIA.big_mapT /(\o) /= StdBigop.Bigint.big_constz count_predT_eq. +qed. + +op bits2w64L (bs: bool list) : W64.t list = + map W64.bits2w (BitEncoding.BitChunking.chunk 64 (chunkfill false 64 bs)). + +lemma size_bits2w64L bs: + size (bits2w64L bs) = (size bs - 1) %/ 64 + 1. +proof. +rewrite /bits2w64L size_map BitEncoding.BitChunking.size_chunk //. +rewrite size_chunkfill //. +rewrite {3}(:64 = 1*64) 1:/# -mulzDl. +by rewrite -(addz0 (((size bs - 1) %/ 64 + 1) * 64)) divzMDl. +qed. + +hint simplify size_w64L2bits. + +lemma bits2w64LK bs: + 64 %| size bs => w64L2bits (bits2w64L bs) = bs. +proof. +move=> Hsz. +rewrite /w64L2bits -map_comp dvd_chunkfill //. +have : forall (x : bool list), + x \in BitEncoding.BitChunking.chunk 64 bs => + idfun x = (fun x => w2bits ((bits2w x))%W64) x. + move=> x Hx; beta. + rewrite W64.bits2wK //. + by apply (BitEncoding.BitChunking.in_chunk_size _ _ _ _ Hx). +rewrite List.eq_in_map => <-. +by rewrite map_id BitEncoding.BitChunking.chunkK // Hsz. +qed. + +lemma bits2w64LK' bs: + w64L2bits (bits2w64L bs) = chunkfill false 64 bs. +proof. +rewrite /bits2w64L -chunkfillK //. +by rewrite bits2w64LK ?chunkfillP // chunkfillK. +qed. + +lemma w64L2bits_inj: injective w64L2bits. +proof. +rewrite /w64L2bits; elim. + by move=> [|y ys]. +move=> x xs IH; elim => //. +move=> y ys IH2. +rewrite !map_cons !flatten_cons. +rewrite eqseq_cat. + by rewrite !size_w2bits. +move=> [/W64.w2bits_inj <- ?]; congr. +by apply IH. +qed. + +lemma w64L2bitsK: cancel w64L2bits bits2w64L. +proof. +move=> k; apply w64L2bits_inj. +by rewrite bits2w64LK // size_w64L2bits dvdz_mulr. +qed. + +lemma w64L2bits_nil: w64L2bits [] = [] by done. + +lemma w64L2bits_cons x xs: w64L2bits (x::xs) = W64.w2bits x ++ w64L2bits xs. +proof. by rewrite /w64L2bits map_cons flatten_cons. qed. + +lemma w64L2bits_cat l1 l2: + w64L2bits (l1++l2) = w64L2bits l1 ++ w64L2bits l2. +proof. +elim: l1 => //=. + by rewrite w64L2bits_nil. +by move=> x xs IH; rewrite !w64L2bits_cons IH. +qed. + +lemma take_w64L2bits n l: + take (64*n) (w64L2bits l) = w64L2bits (take n l). +proof. +elim/natind: n l => //=. + move=> n Hn l; rewrite !take_le0 //. + by apply StdOrder.IntOrder.mulr_ge0_le0. +move=> n Hn IH [|x xs] /=. + by rewrite w64L2bits_nil. +have ->/=: ! (n+1 <= 0) by rewrite -ltzNge ltzS. +rewrite !w64L2bits_cons take_cat. +have ->/=: ! (64 * (n + 1) < size (w2bits x)) by rewrite W64.size_w2bits /#. +by rewrite mulzDr /= IH. +qed. + +lemma drop_w64L2bits n l: + drop (64*n) (w64L2bits l) = w64L2bits (drop n l). +proof. +elim/natind: n l => //=. + move=> n Hn l; rewrite !drop_le0 //. + by apply StdOrder.IntOrder.mulr_ge0_le0. +move=> n Hn IH [|x xs] /=. + by rewrite w64L2bits_nil. +have ->/=: ! (n+1 <= 0) by rewrite -ltzNge ltzS. +rewrite !w64L2bits_cons drop_cat. +have ->/=: ! (64 * (n + 1) < size (w2bits x)) by rewrite W64.size_w2bits /#. +by rewrite mulzDr /= IH. +qed. + +lemma nth_w64L2bits l i: + 0 <= i < 64 * size l => + nth false (w64L2bits l) i + = nth false (W64.w2bits (nth W64.zero l (i %/ 64))) (i%%64). +proof. +move=> Hi; rewrite /w64L2bits (BitEncoding.BitChunking.nth_flatten _ 64). + by rewrite allP; move=> x /mapP [y [Hy ->]]. +rewrite (nth_map W64.zero) //. +apply divz_cmp => //. +by rewrite mulzC. +qed. + + +lemma w64L2bits_xor l1 l2: + w64L2bits (JUtils.map2 W64.(`^`) l1 l2) + = map2 Bool.(^^) (w64L2bits l1) (w64L2bits l2). +proof. +elim: l1 l2 => //=. + by move=> [|y ys]; rewrite w64L2bits_nil // w64L2bits_cons. +move=> x xs IH1; elim => //=. + rewrite w64L2bits_nil map2C; first by move=> b1 b2; ring. + by rewrite w64L2bits_cons. +move=> y ys IH2. +rewrite !w64L2bits_cons map2_cat. + by rewrite !size_w2bits. +by rewrite IH1. +qed. + +lemma w64L2bits_nseq0 n: + 0 <= n => + w64L2bits (nseq n W64.zero) = nseq (64*n) false. +proof. +elim/natind: n => /=. + by move=> n Hn1 Hn2; rewrite !nseq0_le 1,2:/# w64L2bits_nil. +move=> n Hn IH H; rewrite nseqS // w64L2bits_cons IH //. +by rewrite addzC mulzDr mulz1 nseq_add /#. +qed. + + + +op w64L2w8L (l: W64.t list) : W8.t list = + flatten (map W8u8.to_list l). + +lemma w64L2w8L2bits l: + w8L2bits (w64L2w8L l) = w64L2bits l. +proof. +elim: l; first by rewrite /w64L2w8L /flatten. +move=> x xs IH. +rewrite /w64L2w8L map_cons flatten_cons w64L2bits_cons w8L2bits_cat; congr. +by rewrite /w8L2bits /flatten. +qed. + diff --git a/proof/impl/Spec1600.ec b/proof/impl/Spec1600.ec index 8bd73b4..45fefd5 100644 --- a/proof/impl/Spec1600.ec +++ b/proof/impl/Spec1600.ec @@ -1,539 +1,138 @@ require import AllCore List Int IntDiv. (*from Jasmin*) require import JArray JMemory JModel JWord JWord_array JUtils. -op ratio :int. -axiom ratio_bnds: 0 < ratio < 1600. -axiom ratio_w64: 64 %| ratio. +require import EclibExtra JWordList. + +op rate :int. +axiom rate_bnds: 0 < rate < 1600. +axiom rate_w64: 64 %| rate. require Sponge1600. clone import Sponge1600 as Spnge1600 - with op ratio = ratio - proof ratio_bnds by apply ratio_bnds - proof ratio_w64 by apply ratio_w64. + with op rate = rate + proof rate_bnds by apply rate_bnds + proof rate_w64 by apply rate_w64. import Common1600 Block Capacity. -(* MISC *) - -lemma nth_inside ['a] d1 d2 (l: 'a list) i: - 0 <= i < size l => - nth d1 l i = nth d2 l i. -proof. -elim: l i => /=; first smt(). -move=> x xs IH i Hi; case: (i=0) => E //. -by rewrite IH /#. -qed. - - -lemma nseq_add ['a] (x:'a) n1 n2: - 0 <= n1 => 0 <= n2 => nseq (n1+n2) x = nseq n1 x ++ nseq n2 x. -proof. -move=> Hn1 Hn2; elim/natind: n1 Hn1. - by move=> n ??; rewrite (: n=0) 1:/#. -by move=> n Hn IH H; rewrite nseqS // (addzC n) -addzA addzC nseqS 1:/# IH //. -qed. - -lemma take_nseq ['a] n1 n2 (x: 'a): - take n1 (nseq n2 x) = nseq (min n1 n2) x. -proof. -elim/natind: n2 n1. - move=> n Hn n1; rewrite !nseq0_le //. - by have [? ?]:= min_is_lb n1 n; apply (lez_trans n). -move=> n Hn IH n1; case: (n1 <= 0) => /=. - move=> ?; rewrite take_le0 // nseq0_le //. - by have [? ?]:= min_is_lb n1 (n+1); apply (lez_trans n1). -rewrite -ltzNge=> ?; rewrite nseqS // take_cons H /=. -have ->: min n1 (n + 1) = (min (n1-1) n)+1. - rewrite /min; case: (n1 < n+1) => ?. - by have ->/=: n1 - 1 < n by smt(). - by have ->/=: !(n1 - 1 < n) by smt(). -by rewrite nseqS /min /#. -qed. - -lemma drop_nseq ['a] n1 n2 (x: 'a): - 0 <= n1 => drop n1 (nseq n2 x) = nseq (n2-n1) x. -proof. -elim/natind: n1 n2. - move=> n Hn n2 Hn'; have ->: n=0 by smt(). - by rewrite drop0. -move=> n Hn IH n2 Hn'. -case: (n2 <= 0) => /= ?. - by rewrite !nseq0_le // /#. -have ->: n2 = n2 - 1 + 1 by smt(). -by rewrite nseqS 1:/# drop_cons ltzS Hn /= IH //; congr; smt(). -qed. - -lemma dropS ['a] (l: 'a list) n: - 0 <= n => - drop (n + 1) l = behead (drop n l). -proof. -elim: l n => [|x xs] //= IH n Hn. -have ->/=: !(n+1 <= 0) by smt(). -case: (n=0). - by move=> -> /=; rewrite drop0. -move=> ?; have ->/=: !(n<=0) by smt(). -by rewrite -IH /#. -qed. - -lemma drop_drop ['a] (l: 'a list) n1 n2: - 0 <= n1 => 0 <= n2 => - drop n1 (drop n2 l) = drop (n1+n2) l. -proof. -elim/natind: n1. - by move=> n Hn; rewrite drop_le0 /#. -move=> n Hn IH H1 H2. -by rewrite dropS // IH // -dropS /#. -qed. - -(* [eq_mkseq'] is a more refined version of [eq_mkseq] *) -lemma eq_mkseq' ['a] (f g : int -> 'a) n: - (forall (x : int), 0 <= x < n => f x = g x) => mkseq f n = mkseq g n. -proof. -elim/natind: n f g => /=. - by move=> n Hn f g H; rewrite !mkseq0_le. -move=> n Hn IH f g H. -rewrite !(addzC n) !mkseq_add //; congr. - by rewrite !mkseq1 H /#. -apply IH => x Hx /=. -by rewrite H /#. -qed. - -lemma behead_map ['a 'b] (f:'a->'b) (l:'a list): - behead (map f l) = map f (behead l) -by elim: l. - -lemma behead_mkseq ['a] (f : int -> 'a) n: - behead (mkseq f n) = mkseq (fun i=> f (1+i)) (n-1). -proof. -elim/natind: n => /=. - by move=> n Hn; rewrite !mkseq0_le /#. -by move=> n Hn IH; rewrite addzC mkseq_add // mkseq1. -qed. - -lemma behead_chunk ['a] n (l:'a list): - behead (BitEncoding.BitChunking.chunk n l) - = BitEncoding.BitChunking.chunk n (drop n l). -proof. -case: (size l < n). - move=> ?; rewrite drop_oversize 1:/#. - rewrite /BitEncoding.BitChunking.chunk behead_mkseq. - rewrite divz_small /=. - by apply bound_abs; smt(size_ge0). - by rewrite mkseq0_le. -case: (0 < n); last first. -rewrite -!lezNgt => ??. - by rewrite drop_le0 // !BitEncoding.BitChunking.chunk_le0. -rewrite -lezNgt => ??. -rewrite /BitEncoding.BitChunking.chunk behead_mkseq /=. -rewrite size_drop // 1:/# max_ler 1:/#. -have ->: (size l - n) %/ n = size l %/ n - 1. - have ->: size l = (size l - n) + 1*n by ring. - by rewrite divzMDr /#. -by apply eq_mkseq' => x Hx /=; rewrite drop_drop /#. -qed. - - -(* a variant of [size_take] that is more convenient in some cases *) -lemma size_take' ['a] n (s: 'a list): - 0 <= n => size (take n s) = if n <= size s then n else size s. -proof. -move=> Hn; rewrite size_take //. -case: (n = size s) => E; first by rewrite E. -case: (n <= size s) => H. - by rewrite (: n < size s) /#. -by rewrite (: ! n < size s) /#. -qed. - -(* likewise for [take_cat] *) -lemma take_cat' ['a] n (s1 s2: 'a list): - take n (s1++s2) = if n <= size s1 then take n s1 else s1 ++ take (n-size s1) s2. -proof. -rewrite take_cat //. -case: (n = size s1) => E. - by rewrite !E /= take0 cats0 take_size. -case: (n <= size s1) => H. - by rewrite (: n < size s1) /#. -by rewrite (: ! n < size s1) /#. -qed. - -lemma take_map2 ['a 'b 'c] (f:'a -> 'b -> 'c) n l1 l2: - take n (JUtils.map2 f l1 l2) = map2 f (take n l1) (take n l2). -proof. -elim: l1 l2 n => [|x xs IH] [|y ys] n //=; case:(n<=0) => // E. -by rewrite IH. -qed. - -lemma drop_map2 ['a 'b 'c] (f:'a -> 'b -> 'c) n l1 l2: - drop n (JUtils.map2 f l1 l2) = map2 f (drop n l1) (drop n l2). -proof. -elim: l1 l2 n => [|x xs IH] [|y ys] n //=; case:(n<=0) => // E. - by case: (drop (n - 1) ys) => [|_ _]. - by case: (drop (n - 1) xs) => [|_ _]. -by rewrite IH. -qed. - -lemma map2_nseq0r ['a 'b] (f:'a -> 'b -> 'a) x0 n l: - size l = n => - (forall y, f y x0 = y) => - map2 f l (nseq n x0) = l. -proof. -elim/natind: n l. - move=> n Hn l Hl H. - have E: n=0 by smt(size_ge0). - by move: Hl; rewrite E size_eq0 nseq0 => ->. -move=> n Hn IH [|x xs] //=; first smt(). -by move=> Hsz H; rewrite nseqS //= H IH /#. -qed. - - - - - -lemma chunk_take_eq ['a] n (l:'a list): - 0 < n => - BitEncoding.BitChunking.chunk n l - = BitEncoding.BitChunking.chunk n (take (size l %/ n * n) l). -proof. -move=> Hn; rewrite /BitEncoding.BitChunking.chunk. -have ->: (size (take (size l %/ n * n) l) %/ n) = (size l %/ n). - rewrite size_take'; first smt(size_ge0). - by rewrite lez_floor 1:/# /= mulzK 1:/#. -apply eq_mkseq' => x Hx /=. -rewrite -{1}(cat_take_drop (size l %/ n * n)). -rewrite drop_cat size_take'; first smt(size_ge0). -rewrite lez_floor 1:/# /= mulzC StdOrder.IntOrder.ltr_pmul2r 1:/#. -move: (Hx); move=> [? ->] /=. -have E: n <= size (drop (x * n) (take (size l %/ n * n) l)). - rewrite size_drop 1:/# max_ler; last first. - rewrite size_take' 1:/# lez_floor 1:/# /= -Ring.IntID.mulrBl. - by rewrite -{1}mulz1 {1}mulzC StdOrder.IntOrder.ler_pmul2r // -ltzS /#. - rewrite size_take' 1:/# lez_floor 1:/# /=. - smt(size_ge0). -by rewrite take_cat' E. -qed. +(* Additional results on bit-level constructions *) lemma num0_block_suffix n k: - num0 (k * ratio + n) = num0 n. + num0 (k * rate + n) = num0 n. proof. by rewrite /num0 -modzNm -addzA modzMDl modzNm. qed. -op chunkfillsize (n sz:int) = (-sz)%%n. - -lemma chunkfillsize_cmp n sz: - 0 < n => 0 <= chunkfillsize n sz < n. -proof. move=> Hn; rewrite /chunkfillsize; smt(modz_cmp). qed. - -lemma chunkfillsizeP n sz k: - 0 < n => chunkfillsize n (n*k+sz) = chunkfillsize n sz. -proof. -move=> Hn; rewrite /chunkfillsize. -by rewrite -modzNm mulzC modzMDl modzNm. -qed. - -lemma chunkfillsizeE' n sz: - 0 < n => 0 < sz => chunkfillsize n sz = n - 1 - (sz-1) %% n -by move=> ??; rewrite /chunkfillsize modNz. - -lemma divz_minus1 m d: - 0 < d => 0 <= m => ! d %| m => (m-1) %/ d = m %/ d. -proof. -move=> Hd Hm Hdvd. -rewrite {1}(divz_eq m d) -addzA divzMDl 1:/#; ring. -rewrite divz_small //; apply bound_abs; split. - by move: Hdvd; rewrite dvdzE; smt(modz_cmp). -by move=> ?; smt(modz_cmp). -qed. - -lemma chunkfillsizeE n sz: - 0 < n => 0 <= sz => chunkfillsize n sz = if n %| sz then 0 else n - sz%%n. -proof. -move=> Hn Hsz'. -case: (n %| sz) . - rewrite /chunkfillsize dvdzE -modzNm => ->; smt(). -move=> ?. -have Hsz : 0 < sz by smt(dvdz0). -rewrite chunkfillsizeE' //. -have ->: n - 1 - (sz - 1) %% n = n - (1 + (sz - 1) %% n) by ring. -congr; congr. -by rewrite !modzE divz_minus1 //; ring. -qed. - -op chunkfill ['a] (d:'a) n l = l ++ nseq (chunkfillsize n (size l)) d. - -lemma dvd_chunkfill ['a] (d:'a) n l: - 0 < n => n %| size l => chunkfill d n l = l. -proof. -by move=> Hn Hsz; rewrite /chunkfill chunkfillsizeE // ?size_ge0 !Hsz /= cats0. -qed. - -lemma size_chunkfill ['a] (d:'a) n l: - 0 < n => - size (chunkfill d n l) = (size l - 1) %/ n * n + n. -proof. -move=> Hn; rewrite /chunkfill size_cat size_nseq max_ler //. - smt(chunkfillsize_cmp). -case: (size l = 0) => E. - by rewrite !E /= /chunkfillsize /= divNz //=; ring. -rewrite chunkfillsizeE' //; first smt(size_ge0). -have ->: size l + (n - 1 - (size l - 1) %% n) = (size l-1) + n - (size l-1) %% n - by ring. -rewrite {1}(divz_eq (size l - 1) n); ring. -qed. - -lemma chunkfillP ['a] (d:'a) n l: - 0 < n => - n %| size (chunkfill d n l). -proof. -move=> Hn; rewrite size_chunkfill //. -rewrite (: (size l - 1) %/ n * n + n = ((size l - 1) %/ n + 1) * n) 1:/#. -by rewrite dvdzE modzMl. -qed. - -lemma chunkfillK ['a] (d:'a) n l: - 0 < n => - chunkfill d n (chunkfill d n l) = chunkfill d n l. -proof. -move=> Hn; rewrite {1}/chunkfill chunkfillsizeE // ?size_ge0. -by rewrite !chunkfillP //= cats0. -qed. - -(* *) - - -(* Word Lists *) - - -op w8L2bits (l: W8.t list) : bool list = - flatten (map W8.w2bits l). - -lemma w8L2bits_nil: w8L2bits [] = [] by done. - -lemma w8L2bits_cons x xs: w8L2bits (x::xs) = W8.w2bits x ++ w8L2bits xs. -proof. by rewrite /w8L2bits map_cons flatten_cons. qed. - -lemma w8L2bits_cat l1 l2: - w8L2bits (l1++l2) = w8L2bits l1 ++ w8L2bits l2. -proof. -elim: l1 => //=. - by rewrite w8L2bits_nil. -by move=> x xs IH; rewrite !w8L2bits_cons IH. -qed. - -lemma size_w8L2bits x: - size (w8L2bits x) = 8 * size x. -proof. -by rewrite /w8L2bits size_flatten -map_comp /(\o) /= StdBigop.Bigint.sumzE -StdBigop.Bigint.BIA.big_mapT /(\o) /= StdBigop.Bigint.big_constz count_predT_eq. -qed. - -hint simplify size_w8L2bits. - -lemma take_w8L2bits n l: - take (8*n) (w8L2bits l) = w8L2bits (take n l). -proof. -elim/natind: n l => //=. - move=> n Hn l; rewrite !take_le0 //. - by apply StdOrder.IntOrder.mulr_ge0_le0. -move=> n Hn IH [|x xs] /=. - by rewrite w8L2bits_nil. -have ->/=: ! (n+1 <= 0) by rewrite -ltzNge ltzS. -rewrite !w8L2bits_cons take_cat. -have ->/=: ! (8 * (n + 1) < size (w2bits x)) by rewrite W8.size_w2bits /#. -by rewrite mulzDr /= IH. -qed. - -lemma drop_w8L2bits n l: - drop (8*n) (w8L2bits l) = w8L2bits (drop n l). -proof. -elim/natind: n l => //=. - move=> n Hn l; rewrite !drop_le0 //. - by apply StdOrder.IntOrder.mulr_ge0_le0. -move=> n Hn IH [|x xs] /=. - by rewrite w8L2bits_nil. -have ->/=: ! (n+1 <= 0) by rewrite -ltzNge ltzS. -rewrite !w8L2bits_cons drop_cat. -have ->/=: ! (8 * (n + 1) < size (w2bits x)) by rewrite W8.size_w2bits /#. -by rewrite mulzDr /= IH. -qed. - - - - - - -op w64L2bits (l: W64.t list) : bool list = - flatten (map W64.w2bits l). - -lemma size_w64L2bits l: - size (w64L2bits l) = 64 * size l. -proof. -by rewrite /w64L2bits size_flatten -map_comp /(\o) /= StdBigop.Bigint.sumzE -StdBigop.Bigint.BIA.big_mapT /(\o) /= StdBigop.Bigint.big_constz count_predT_eq. -qed. - -op bits2w64L (bs: bool list) : W64.t list = - map W64.bits2w (BitEncoding.BitChunking.chunk 64 (chunkfill false 64 bs)). - -lemma size_bits2w64L bs: - size (bits2w64L bs) = (size bs - 1) %/ 64 + 1. -proof. -rewrite /bits2w64L size_map BitEncoding.BitChunking.size_chunk //. -rewrite size_chunkfill //. -rewrite {3}(:64 = 1*64) 1:/# -mulzDl. -by rewrite -(addz0 (((size bs - 1) %/ 64 + 1) * 64)) divzMDl. -qed. - -hint simplify size_w64L2bits. - -lemma bits2w64LK bs: - 64 %| size bs => w64L2bits (bits2w64L bs) = bs. -proof. -move=> Hsz. -rewrite /w64L2bits -map_comp dvd_chunkfill //. -have : forall (x : bool list), - x \in BitEncoding.BitChunking.chunk 64 bs => - idfun x = (fun x => w2bits ((bits2w x))%W64) x. - move=> x Hx; beta. - rewrite W64.bits2wK //. - by apply (BitEncoding.BitChunking.in_chunk_size _ _ _ _ Hx). -rewrite List.eq_in_map => <-. -by rewrite map_id BitEncoding.BitChunking.chunkK // Hsz. -qed. - -lemma bits2w64LK' bs: - w64L2bits (bits2w64L bs) = chunkfill false 64 bs. -proof. -rewrite /bits2w64L -chunkfillK //. -by rewrite bits2w64LK ?chunkfillP // chunkfillK. -qed. - -lemma w64L2bits_inj: injective w64L2bits. -proof. -rewrite /w64L2bits; elim. - by move=> [|y ys]. -move=> x xs IH; elim => //. -move=> y ys IH2. -rewrite !map_cons !flatten_cons. -rewrite eqseq_cat. - by rewrite !size_w2bits. -move=> [/W64.w2bits_inj <- ?]; congr. -by apply IH. -qed. - -lemma w64L2bitsK: cancel w64L2bits bits2w64L. -proof. -move=> k; apply w64L2bits_inj. -by rewrite bits2w64LK // size_w64L2bits dvdz_mulr. -qed. - -lemma w64L2bits_nil: w64L2bits [] = [] by done. - -lemma w64L2bits_cons x xs: w64L2bits (x::xs) = W64.w2bits x ++ w64L2bits xs. -proof. by rewrite /w64L2bits map_cons flatten_cons. qed. - -lemma w64L2bits_cat l1 l2: - w64L2bits (l1++l2) = w64L2bits l1 ++ w64L2bits l2. -proof. -elim: l1 => //=. - by rewrite w64L2bits_nil. -by move=> x xs IH; rewrite !w64L2bits_cons IH. -qed. - -lemma take_w64L2bits n l: - take (64*n) (w64L2bits l) = w64L2bits (take n l). -proof. -elim/natind: n l => //=. - move=> n Hn l; rewrite !take_le0 //. - by apply StdOrder.IntOrder.mulr_ge0_le0. -move=> n Hn IH [|x xs] /=. - by rewrite w64L2bits_nil. -have ->/=: ! (n+1 <= 0) by rewrite -ltzNge ltzS. -rewrite !w64L2bits_cons take_cat. -have ->/=: ! (64 * (n + 1) < size (w2bits x)) by rewrite W64.size_w2bits /#. -by rewrite mulzDr /= IH. -qed. - -lemma drop_w64L2bits n l: - drop (64*n) (w64L2bits l) = w64L2bits (drop n l). +lemma mkpad_rate n: + 0 <= n => mkpad (r + n) = mkpad n. proof. -elim/natind: n l => //=. - move=> n Hn l; rewrite !drop_le0 //. - by apply StdOrder.IntOrder.mulr_ge0_le0. -move=> n Hn IH [|x xs] /=. - by rewrite w64L2bits_nil. -have ->/=: ! (n+1 <= 0) by rewrite -ltzNge ltzS. -rewrite !w64L2bits_cons drop_cat. -have ->/=: ! (64 * (n + 1) < size (w2bits x)) by rewrite W64.size_w2bits /#. -by rewrite mulzDr /= IH. +move=> Hn; rewrite /mkpad /=; congr; congr. +by rewrite (num0_block_suffix n 1). qed. -lemma nth_w64L2bits l i: - 0 <= i < 64 * size l => - nth false (w64L2bits l) i - = nth false (W64.w2bits (nth W64.zero l (i %/ 64))) (i%%64). +lemma chunk_r (m: bool list): + size m = r => chunk m = [m]. proof. -move=> Hi; rewrite /w64L2bits (BitEncoding.BitChunking.nth_flatten _ 64). - by rewrite allP; move=> x /mapP [y [Hy ->]]. -rewrite (nth_map W64.zero) //. -apply divz_cmp => //. -by rewrite mulzC. +have Hr: r <> 0 by smt(rate_bnds). +move=> Hsz; rewrite /chunk Hsz divzz /= Hr /b2i mkseq1 /= drop0. +by rewrite -Hsz take_size. qed. - - -lemma w64L2bits_xor l1 l2: - w64L2bits (JUtils.map2 W64.(`^`) l1 l2) - = map2 Bool.(^^) (w64L2bits l1) (w64L2bits l2). + +lemma pad2blocksE m: + r <= size m => + pad2blocks m = mkblock (take r m) :: pad2blocks (drop r m). proof. -elim: l1 l2 => //=. - by move=> [|y ys]; rewrite w64L2bits_nil // w64L2bits_cons. -move=> x xs IH1; elim => //=. - rewrite w64L2bits_nil map2C; first by move=> b1 b2; ring. - by rewrite w64L2bits_cons. -move=> y ys IH2. -rewrite !w64L2bits_cons map2_cat. - by rewrite !size_w2bits. -by rewrite IH1. +move=> Hm. +have Hsz: size (take r m) = r by rewrite size_take; smt(rate_bnds). +rewrite -{1}(cat_take_drop r) /pad2blocks /(\o) /bits2blocks /pad. +rewrite -catA chunk_cat ?Hsz ?dvdzz map_cat chunk_r //. +by rewrite /= size_cat Hsz mkpad_rate; smt(size_ge0). qed. -lemma w64L2bits_nseq0 n: - 0 <= n => - w64L2bits (nseq n W64.zero) = nseq (64*n) false. +lemma mkblock_xor l1 l2: + size l1 = r => size l2 = r => + mkblock l1 +^ mkblock l2 = mkblock (map2 Bool.(^^) l1 l2). proof. -elim/natind: n => /=. - by move=> n Hn1 Hn2; rewrite !nseq0_le 1,2:/# w64L2bits_nil. -move=> n Hn IH H; rewrite nseqS // w64L2bits_cons IH //. -by rewrite addzC mulzDr mulz1 nseq_add /#. +move=> *; rewrite /(+^) /offun; congr. +rewrite -(eq_mkseq (fun i => Bool.(^^) (nth false l1 i) (nth false l2 i))). + move=> i /=; rewrite !Block.getE. + case: (0 <= i < r) => E. + rewrite eq_sym. rewrite !ofblockK //. + rewrite (nth_inside witness false). smt(). + rewrite (nth_inside witness false). smt(). + done. + rewrite nth_out. smt(). + rewrite nth_out. smt(). + done. +apply (eq_from_nth false). + rewrite size_mkseq size_map2 H H0 max_ler. + smt(rate_bnds). + by rewrite min_ler. +rewrite size_mkseq max_ler. smt(rate_bnds). +move=> i Hi. +rewrite nth_mkseq //=. +by rewrite (nth_map2 false false) /#. qed. +op block0star1 = mkblock (nseq (rate-1) false ++ [true]). - -op w64L2w8L (l: W64.t list) : W8.t list = - flatten (map W8u8.to_list l). - -lemma w64L2w8L2bits l: - w8L2bits (w64L2w8L l) = w64L2bits l. +lemma block0star1P m: + size m <= r-2 => + mkblock (m++mkpad (size m)) + = mkblock (m++[true]++nseq (r-size m-1) false) +^ block0star1. proof. -elim: l; first by rewrite /w64L2w8L /flatten. -move=> x xs IH. -rewrite /w64L2w8L map_cons flatten_cons w64L2bits_cons w8L2bits_cat; congr. -by rewrite /w8L2bits /flatten. +move=> Hm. +rewrite /mkpad mkblock_xor. + by rewrite !size_cat size_nseq max_ler //= 1:/#; ring. + by rewrite size_cat size_nseq max_ler; smt(rate_bnds). +have E: num0 (size m) = r - size m - 2. + rewrite /num0 -(modzMDl 1) modz_small. + by apply bound_abs; smt(rate_bnds size_ge0). + by ring. +congr; apply (eq_from_nth false). + rewrite !size_cat /= size_rcons size_nseq max_ler E; first smt(size_ge0). + rewrite size_map2 min_ler. + by rewrite !size_cat !size_nseq !max_ler; smt(rate_bnds size_ge0). + by rewrite size_cat size_nseq max_ler /=; smt(rate_bnds). +move=> i; rewrite !size_cat /= size_rcons size_nseq max_ler ?num0_ge0 E. +rewrite -!cats1 (: size m + (1 + (r - size m - 2 + 1)) = r) 1:/# => Hi. +case: (i=r-1) => [->|?]. + rewrite nth_cat /= nth_cat. + rewrite (:! r - 1 < size m) 1:/# /=. + rewrite (:! r - 1 - size m - 1 < size (nseq (r - size m - 2) false)) /=. + by rewrite size_nseq max_ler /#. + rewrite (:r - 1 - size m <> 0) 1:/# /=. + rewrite (:r - 1 - size m - 1 - size (nseq (r - size m - 2) false) = 0) /=. + by rewrite size_nseq max_ler /#. + rewrite (nth_map2 false false). + rewrite min_ler. + by rewrite size_cat size_nseq max_ler 1:/# !size_cat /= size_nseq max_ler /#. + by rewrite size_cat size_nseq max_ler /#. + rewrite !nth_cat size_cat /=. + rewrite (:! r - 1 < size m + 1) 1:/# /=. + rewrite nth_nseq 1:/# /= size_nseq max_ler 1:/# ltzz /=. + by ring. +rewrite (nth_map2 false false). + rewrite min_ler. + by rewrite size_cat size_nseq max_ler 1:/# !size_cat /= size_nseq max_ler /#. + by rewrite size_cat size_nseq max_ler /#. +have ->: nth false (nseq (Top.rate - 1) false ++ [true]) i = false. + rewrite nth_cat size_nseq max_ler 1:/# (: i < r-1) 1:/# /=. + by rewrite nth_nseq /#. +rewrite Bool.xor_false nth_cat. +case: (i < size m) => I1. + by rewrite -catA nth_cat I1. +rewrite eq_sym -catA nth_cat I1 /=; case: (i-size m <> 0) => I2 //=. +rewrite nth_cat size_nseq max_ler 1:/#. +rewrite (:i - size m - 1 < r - size m - 2) 1:/# /=. +by rewrite !nth_nseq /#. qed. -(* -*) - -(* END Word Lists *) - - - - (* 1600bit state *) -(*clone export PolyArray as Array25 with op size <- 25.*) require import Array25. type state = W64.t Array25.t. @@ -569,25 +168,25 @@ move=> st; apply state2bits_inj. by rewrite bits2stateK // size_state2bits. qed. -(* ratio expressed in 8 and 64bit words *) -op ratio64 = ratio %/ 64. -op ratio8 = 8*ratio64. +(* rate expressed in 8 and 64bit words *) +op rate64 = rate %/ 64. +op rate8 = 8*rate64. -lemma ratio64P: 64 * ratio64 = ratio. -proof. by move: ratio_w64; rewrite /ratio64 mulzC dvdz_eq. qed. +lemma rate64P: 64 * rate64 = rate. +proof. by move: rate_w64; rewrite /rate64 mulzC dvdz_eq. qed. -lemma ratio64_bnds: 0 < ratio64 < 25. -proof. move: ratio_bnds; rewrite -ratio64P /#. qed. +lemma rate64_bnds: 0 < rate64 < 25. +proof. move: rate_bnds; rewrite -rate64P /#. qed. -lemma ratio8P: 8 * ratio8 = ratio. -proof. by rewrite /ratio8 /= -mulzA ratio64P. qed. +lemma rate8P: 8 * rate8 = rate. +proof. by rewrite /rate8 /= -mulzA rate64P. qed. -lemma ratio8_bnds: 0 < ratio8 < 200. -proof. move: ratio_bnds; rewrite -ratio8P /#. qed. +lemma rate8_bnds: 0 < rate8 < 200. +proof. move: rate_bnds; rewrite -rate8P /#. qed. -op capacity64 = 25-ratio64. +op capacity64 = 25-rate64. lemma capacity64P: 64*capacity64 = c. -proof. by rewrite /capacity64 mulzC Ring.IntID.mulrBl /= mulzC ratio64P. qed. +proof. by rewrite /capacity64 mulzC Ring.IntID.mulrBl /= mulzC rate64P. qed. @@ -597,17 +196,17 @@ op state_r (st: state) : block = mkblock (take r (state2bits st)). op w64L2block (l: W64.t list) : block = - mkblock (w64L2bits (take ratio64 l - ++ nseq (ratio64-size l) W64.zero)). + mkblock (w64L2bits (take rate64 l + ++ nseq (rate64-size l) W64.zero)). op block2w64L (b: block) : W64.t list = bits2w64L (ofblock b). lemma block2w64LP st: - block2w64L (state_r st) = take ratio64 (to_list st). + block2w64L (state_r st) = take rate64 (to_list st). proof. rewrite /block2w64L /state_r ofblockK. - rewrite size_take ?ge0_r size_state2bits; smt(ratio_bnds). -by rewrite /state2bits -ratio64P take_w64L2bits w64L2bitsK. + rewrite size_take ?ge0_r size_state2bits; smt(rate_bnds). +by rewrite /state2bits -rate64P take_w64L2bits w64L2bitsK. qed. op state_c (st: state) : capacity = @@ -616,11 +215,11 @@ op state_c (st: state) : capacity = op capacity2w64L (c: capacity) : W64.t list = bits2w64L (ofcapacity c). lemma capacity2w64LP st: - capacity2w64L (state_c st) = drop ratio64 (to_list st). + capacity2w64L (state_c st) = drop rate64 (to_list st). proof. rewrite /capacity2w64L /state_c ofcapacityK. - rewrite size_drop ?ge0_r size_state2bits; smt(ratio_bnds). -by rewrite /state2bits -ratio64P drop_w64L2bits w64L2bitsK. + rewrite size_drop ?ge0_r size_state2bits; smt(rate_bnds). +by rewrite /state2bits -rate64P drop_w64L2bits w64L2bitsK. qed. lemma state_splitP st: @@ -638,7 +237,7 @@ qed. lemma st0_r: state_r st0 = b0. proof. rewrite /state_r state2bits0 b0P take_nseq min_lel //. -apply ltzW; smt(ratio_bnds). +apply ltzW; smt(rate_bnds). qed. lemma c0P: c0 = mkcapacity (nseq c false). @@ -648,9 +247,9 @@ by rewrite offunifE Hi /= getE Hi /= ofcapacityK 1:size_nseq 1:/# nth_nseq. qed. lemma st0_c: state_c st0 = c0. -proof. rewrite /state_c c0P state2bits0 drop_nseq; smt(ratio_bnds). qed. +proof. rewrite /state_c c0P state2bits0 drop_nseq; smt(rate_bnds). qed. -(* [match_state] relates both state representations *) +(* [match_state] relates the bit-level and word-level state representations *) op match_state x st = x = (state_r st, state_c st). lemma match_state_r (x:block*capacity) st: @@ -661,32 +260,6 @@ lemma match_state_c (x:block*capacity) st: match_state x st => x.`2 = state_c st by move=> ->. -lemma mkblock_xor l1 l2: - size l1 = r => size l2 = r => - mkblock l1 +^ mkblock l2 = mkblock (map2 Bool.(^^) l1 l2). -proof. -move=> *; rewrite /(+^) /offun; congr. -rewrite -(eq_mkseq (fun i => Bool.(^^) (nth false l1 i) (nth false l2 i))). - move=> i /=; rewrite !Block.getE. - case: (0 <= i < r) => E. - rewrite eq_sym. rewrite !ofblockK //. - rewrite (nth_inside witness false). smt(). - rewrite (nth_inside witness false). smt(). - done. - rewrite nth_out. smt(). - rewrite nth_out. smt(). - done. -apply (eq_from_nth false). - rewrite size_mkseq size_map2 H H0 max_ler. - smt(ratio_bnds). - by rewrite min_ler. -rewrite size_mkseq max_ler. smt(ratio_bnds). -move=> i Hi. -rewrite nth_mkseq //=. -by rewrite (nth_map2 false false) /#. -qed. - - (* MESSAGES and PAYLOADS @@ -697,83 +270,57 @@ type mess_t = W8.t list. (* [take_block64] reads a the contents of a full block into a list of 64bit words (return also the remaining bytes) *) op take_block64 (m: W8.t list): W64.t list * W8.t list = - (bits2w64L (w8L2bits (take ratio8 m)), drop ratio8 m). + (bits2w64L (w8L2bits (take rate8 m)), drop rate8 m). lemma size_take_block64l m: - ratio8 <= size m => size (take_block64 m).`1 = ratio64. + rate8 <= size m => size (take_block64 m).`1 = rate64. proof. move=> Hm; rewrite /take_block64 /= size_bits2w64L size_w8L2bits. -rewrite size_take'; first smt(ratio_bnds). -by rewrite Hm /= /ratio8 -mulzA /= mulzC divzMDl. +rewrite size_take'; first smt(rate_bnds). +by rewrite Hm /= /rate8 -mulzA /= mulzC divzMDl. qed. lemma size_take_block64r m: - ratio8 <= size m => size (take_block64 m).`2 = size m - ratio8. + rate8 <= size m => size (take_block64 m).`2 = size m - rate8. proof. -move=> Hm; rewrite /take_block64 /= size_drop; first smt(ratio_bnds). +move=> Hm; rewrite /take_block64 /= size_drop; first smt(rate_bnds). by rewrite max_ler /#. qed. -lemma mkpad_ratio n: - 0 <= n => mkpad (r + n) = mkpad n. -proof. -move=> Hn; rewrite /mkpad /=; congr; congr. -by rewrite (num0_block_suffix n 1). -qed. - -lemma chunk_r (m: bool list): - size m = r => chunk m = [m]. -proof. -have Hr: r <> 0 by smt(ratio_bnds). -move=> Hsz; rewrite /chunk Hsz divzz /= Hr /b2i mkseq1 /= drop0. -by rewrite -Hsz take_size. -qed. - -lemma pad2blocksE m: - r <= size m => - pad2blocks m = mkblock (take r m) :: pad2blocks (drop r m). -proof. -move=> Hm. -have Hsz: size (take r m) = r by rewrite size_take; smt(ratio_bnds). -rewrite -{1}(cat_take_drop r) /pad2blocks /(\o) /bits2blocks /pad. -rewrite -catA chunk_cat ?Hsz ?dvdzz map_cat chunk_r //. -by rewrite /= size_cat Hsz mkpad_ratio; smt(size_ge0). -qed. - lemma take_block64P mbits m: - ratio8 <= size m => + rate8 <= size m => w64L2block (take_block64 m).`1 = head b0 (pad2blocks (w8L2bits m ++ mbits)). proof. move=> Hm. -have Hsz8: size (take ratio8 m) = ratio8. - rewrite size_take; first smt(ratio8_bnds). - case: (size m = ratio8) => E. +have Hsz8: size (take rate8 m) = rate8. + rewrite size_take; first smt(rate8_bnds). + case: (size m = rate8) => E. by rewrite -E ltzz. - by have ->: ratio8 < size m by smt(). -have Hsz64: size (take_block64 m).`1 = ratio64. + by have ->: rate8 < size m by smt(). +have Hsz64: size (take_block64 m).`1 = rate64. rewrite /take_block64 /= size_bits2w64L /= Hsz8 /#. rewrite pad2blocksE /=. - by move: Hm; rewrite size_cat size_w8L2bits -ratio8P; smt(size_ge0). + by move: Hm; rewrite size_cat size_w8L2bits -rate8P; smt(size_ge0). rewrite /w64L2block Hsz64 /= cats0; congr. rewrite take_cat size_w8L2bits. -case: (size m = ratio8) => E. - rewrite !E !ratio8P ltzz /r /Spnge1600.ratio take0 cats0. +case: (size m = rate8) => E. + rewrite !E !rate8P ltzz /r /Spnge1600.rate take0 cats0. rewrite -Hsz64 take_size /take_block64 /=. rewrite bits2w64LK. - by rewrite size_w8L2bits Hsz8 ratio8P ratio_w64. + by rewrite size_w8L2bits Hsz8 rate8P rate_w64. by rewrite -E take_size. have ->/=: r < 8 * size m. - by apply (StdOrder.IntOrder.ler_lt_trans (8*ratio8)); smt(ratio8P). + by apply (StdOrder.IntOrder.ler_lt_trans (8*rate8)); smt(rate8P). rewrite -Hsz64 take_size /take_block64 /= bits2w64LK. - by rewrite size_w8L2bits Hsz8 ratio8P ratio_w64. -by rewrite -take_w8L2bits ratio8P. + by rewrite size_w8L2bits Hsz8 rate8P rate_w64. +by rewrite -take_w8L2bits rate8P. qed. (* [trail_byte] adds the first padding 1-bit to [mbits], which include - both the "domain-separation" bits as well as additional suffix bits + both the "domain-separatioen" bits as well as additional suffix bits (e.g. "01" for SHA-3; "11" for RawSHAKE; "1111" for SHAKE). The last - 1-bit of the padding (the "ratio" bit), is only added when adding to + 1-bit of the padding (the "rate" bit), is only added when adding to the state. Remark: the standard FIPS-202 specifies two domain bits, possibly prefixed by up to two additional suffix bits. Nonetheless, we @@ -831,41 +378,41 @@ lemma addstate_r st l: proof. rewrite /state_r /state2bits /w64L2block. rewrite mkblock_xor /=. - rewrite size_take; first smt(ratio_bnds). - by rewrite size_w64L2bits Array25.size_to_list /= (: r < 1600); smt(ratio_bnds). - rewrite size_cat size_nseq size_take; first smt(ratio64_bnds). - case: (ratio64 < size l) => E. - by rewrite max_lel; smt(size_ge0 ratio64P). - by rewrite max_ler 1:/#; smt(ratio64P). + rewrite size_take; first smt(rate_bnds). + by rewrite size_w64L2bits Array25.size_to_list /= (: r < 1600); smt(rate_bnds). + rewrite size_cat size_nseq size_take; first smt(rate64_bnds). + case: (rate64 < size l) => E. + by rewrite max_lel; smt(size_ge0 rate64P). + by rewrite max_ler 1:/#; smt(rate64P). congr; rewrite to_list_addstate. -have ->: (w64L2bits (take ratio64 l ++ nseq (ratio64 - size l) W64.zero)) - = take r (w64L2bits (l ++ nseq (ratio64 - size l) W64.zero)). - rewrite -ratio64P take_w64L2bits take_cat'. - case: (ratio64 <= size l) => E. +have ->: (w64L2bits (take rate64 l ++ nseq (rate64 - size l) W64.zero)) + = take r (w64L2bits (l ++ nseq (rate64 - size l) W64.zero)). + rewrite -rate64P take_w64L2bits take_cat'. + case: (rate64 <= size l) => E. by rewrite nseq0_le 1:/# cats0. by rewrite take_oversize 1:/# take_nseq min_ler. rewrite w64L2bits_xor take_map2; congr. -rewrite -ratio64P !take_w64L2bits; congr. -rewrite !take_cat; case: (ratio64 < size l) => //= E; congr. -by rewrite !take_nseq; smt(ratio64_bnds). +rewrite -rate64P !take_w64L2bits; congr. +rewrite !take_cat; case: (rate64 < size l) => //= E; congr. +by rewrite !take_nseq; smt(rate64_bnds). qed. lemma addstate_c st l: - size l <= ratio64 => + size l <= rate64 => state_c (addstate st l) = state_c st. proof. move=> Hsz; rewrite /state_c /state2bits /w64L2block; congr. -rewrite -ratio64P !drop_w64L2bits; congr. +rewrite -rate64P !drop_w64L2bits; congr. rewrite to_list_addstate !drop_map2 drop_cat. -have ->/=: !(ratio64 < size l) by smt(). -rewrite drop_nseq; first smt(ratio64_bnds). +have ->/=: !(rate64 < size l) by smt(). +rewrite drop_nseq; first smt(rate64_bnds). rewrite map2_nseq0r //. -rewrite size_drop; first smt(ratio64_bnds). -by rewrite max_ler size_to_list; smt(ratio64_bnds). +rewrite size_drop; first smt(rate64_bnds). +by rewrite max_ler size_to_list; smt(rate64_bnds). qed. lemma addfullblockP mbits blk st m: - ratio8 <= size m => + rate8 <= size m => blk = state_r st => state_r (addstate st (take_block64 m).`1) = blk +^ head b0 (pad2blocks (w8L2bits m ++ mbits)). @@ -874,63 +421,10 @@ move=> Hm Hst; rewrite addstate_r -Hst; congr. by apply take_block64P. qed. -op block0star1 = mkblock (nseq (ratio-1) false ++ [true]). - -lemma block0star1P m: - size m <= r-2 => - mkblock (m++mkpad (size m)) - = mkblock (m++[true]++nseq (r-size m-1) false) +^ block0star1. -proof. -move=> Hm. -rewrite /mkpad mkblock_xor. - by rewrite !size_cat size_nseq max_ler //= 1:/#; ring. - by rewrite size_cat size_nseq max_ler; smt(ratio_bnds). -have E: num0 (size m) = r - size m - 2. - rewrite /num0 -(modzMDl 1) modz_small. - by apply bound_abs; smt(ratio_bnds size_ge0). - by ring. -congr; apply (eq_from_nth false). - rewrite !size_cat /= size_rcons size_nseq max_ler E; first smt(size_ge0). - rewrite size_map2 min_ler. - by rewrite !size_cat !size_nseq !max_ler; smt(ratio_bnds size_ge0). - by rewrite size_cat size_nseq max_ler /=; smt(ratio_bnds). -move=> i; rewrite !size_cat /= size_rcons size_nseq max_ler ?num0_ge0 E. -rewrite -!cats1 (: size m + (1 + (r - size m - 2 + 1)) = r) 1:/# => Hi. -case: (i=r-1) => [->|?]. - rewrite nth_cat /= nth_cat. - rewrite (:! r - 1 < size m) 1:/# /=. - rewrite (:! r - 1 - size m - 1 < size (nseq (r - size m - 2) false)) /=. - by rewrite size_nseq max_ler /#. - rewrite (:r - 1 - size m <> 0) 1:/# /=. - rewrite (:r - 1 - size m - 1 - size (nseq (r - size m - 2) false) = 0) /=. - by rewrite size_nseq max_ler /#. - rewrite (nth_map2 false false). - rewrite min_ler. - by rewrite size_cat size_nseq max_ler 1:/# !size_cat /= size_nseq max_ler /#. - by rewrite size_cat size_nseq max_ler /#. - rewrite !nth_cat size_cat /=. - rewrite (:! r - 1 < size m + 1) 1:/# /=. - rewrite nth_nseq 1:/# /= size_nseq max_ler 1:/# ltzz /=. - by ring. -rewrite (nth_map2 false false). - rewrite min_ler. - by rewrite size_cat size_nseq max_ler 1:/# !size_cat /= size_nseq max_ler /#. - by rewrite size_cat size_nseq max_ler /#. -have ->: nth false (nseq (Top.ratio - 1) false ++ [true]) i = false. - rewrite nth_cat size_nseq max_ler 1:/# (: i < r-1) 1:/# /=. - by rewrite nth_nseq /#. -rewrite Bool.xor_false nth_cat. -case: (i < size m) => I1. - by rewrite -catA nth_cat I1. -rewrite eq_sym -catA nth_cat I1 /=; case: (i-size m <> 0) => I2 //=. -rewrite nth_cat size_nseq max_ler 1:/#. -rewrite (:i - size m - 1 < r - size m - 2) 1:/# /=. -by rewrite !nth_nseq /#. -qed. lemma finalblockP mbits m: size mbits < 6 => - size m < ratio8 => + size m < rate8 => w64L2block (final_block64 (trail_byte mbits) m) +^ block0star1 = head b0 (pad2blocks (w8L2bits m ++ mbits)). proof. @@ -948,7 +442,7 @@ have ->: nseq (r - size (w8L2bits m ++ mbits) - 1) false ++ nseq (r - 64*size (final_block64 (trail_byte mbits) m)) false. rewrite -!nseq_add; first 2 smt(chunkfillsize_cmp size_ge0). smt(chunkfillsize_cmp size_cat size_ge0). - smt(size_final_block64 ratio_bnds). + smt(size_final_block64 rate_bnds). congr; rewrite size_final_block64 !size_cat size_w8L2bits /=. rewrite chunkfillsizeE' //; first smt(size_ge0). rewrite chunkfillsizeE' //=; first smt(size_ge0). @@ -958,7 +452,7 @@ rewrite !catA; congr; last first. rewrite w64L2bits_nseq0. rewrite /final_block64 size_final_block64. smt(size_ge0). - by rewrite mulzDr ratio64P; congr; ring. + by rewrite mulzDr rate64P; congr; ring. rewrite /final_block64 take_oversize. rewrite size_bits2w64L size_w8L2bits size_cat /=. by rewrite -ltzE; smt(divz_cmp). @@ -987,30 +481,30 @@ qed. op addfinalbit (st: state) = - st.[ratio64-1 <- st.[ratio64-1] `^` W64.of_int (2^63)]. + st.[rate64-1 <- st.[rate64-1] `^` W64.of_int (2^63)]. op addfinalblock st l = addfinalbit (addstate st l). -op block0star1_64 = nseq (ratio64-1) W64.zero ++ [W64.of_int (2 ^ 63)]. +op block0star1_64 = nseq (rate64-1) W64.zero ++ [W64.of_int (2 ^ 63)]. lemma block0star1E: w64L2block block0star1_64 = block0star1. proof. rewrite /w64L2block /block0star1 /block0star1_64; congr. -rewrite size_cat size_nseq /= max_ler; first smt(ratio64_bnds). -have ->: ratio64 - (ratio64 - 1 + 1) = 0 by ring. +rewrite size_cat size_nseq /= max_ler; first smt(rate64_bnds). +have ->: rate64 - (rate64 - 1 + 1) = 0 by ring. rewrite nseq0 cats0. pose l := nseq _ _. rewrite take_cat. -have ->/=: ! ratio64 < size l. - by rewrite /l size_nseq max_ler; smt(ratio64_bnds). -rewrite w64L2bits_cat /l size_nseq max_ler; first smt(ratio64_bnds). -have ->/=: ! ratio64 - (ratio64 - 1) <= 0 by smt(). -have ->: nseq (r-1) false = nseq (64 * (ratio64-1)) false ++ nseq 63 false. - rewrite -nseq_add //; first smt(ratio64_bnds). - by congr; rewrite mulzDr -ratio64P; ring. +have ->/=: ! rate64 < size l. + by rewrite /l size_nseq max_ler; smt(rate64_bnds). +rewrite w64L2bits_cat /l size_nseq max_ler; first smt(rate64_bnds). +have ->/=: ! rate64 - (rate64 - 1) <= 0 by smt(). +have ->: nseq (r-1) false = nseq (64 * (rate64-1)) false ++ nseq 63 false. + rewrite -nseq_add //; first smt(rate64_bnds). + by congr; rewrite mulzDr -rate64P; ring. rewrite -catA; congr. - rewrite w64L2bits_nseq0; smt(ratio64_bnds). + rewrite w64L2bits_nseq0; smt(rate64_bnds). rewrite -(W64.shlMP 1 63) //. rewrite /w64L2bits /=. have P: forall i, W64.one.[i] = (i=0). @@ -1026,13 +520,13 @@ lemma addfinalbit_r (st: state): proof. rewrite -block0star1E -addstate_r /addstate; congr. apply Array25.ext_eq => i Hi. -rewrite initE Hi get_setE; first smt(ratio64_bnds). -case: (i = ratio64 - 1) => E. +rewrite initE Hi get_setE; first smt(rate64_bnds). +case: (i = rate64 - 1) => E. rewrite !E /block0star1_64; congr. by rewrite nth_cat size_nseq max_ler 1:/# ltzz. have ->: nth W64.zero block0star1_64 i = W64.zero. - rewrite /block0star1_64 nth_cat size_nseq max_ler; first smt(ratio64_bnds). - case: (i < ratio64 - 1) => H. + rewrite /block0star1_64 nth_cat size_nseq max_ler; first smt(rate64_bnds). + case: (i < rate64 - 1) => H. by rewrite nth_nseq /#. by rewrite Ring.IntID.subr_eq0 E. by rewrite W64.xorw0. @@ -1040,7 +534,7 @@ qed. lemma addfinalblock_r mbits blk st m: size mbits < 6 => - size m < ratio8 => + size m < rate8 => blk = state_r st => state_r (addfinalblock st (final_block64 (trail_byte mbits) m)) = blk +^ head b0 (pad2blocks (w8L2bits m ++ mbits)). @@ -1054,24 +548,24 @@ lemma addfinalbit_c st: state_c (addfinalbit st) = state_c st. proof. rewrite /addfinalbit /state_c /state2bits; congr. -rewrite -ratio64P !drop_w64L2bits; congr. +rewrite -rate64P !drop_w64L2bits; congr. pose newst := Array25.to_list _. -have E1: (size (drop ratio64 newst) = 25 - ratio64). - rewrite size_drop; first smt(ratio64_bnds). - rewrite size_to_list max_ler; smt(ratio64_bnds). -have E2: (size (drop ratio64 (to_list st)) = 25 - ratio64). - rewrite size_drop; first smt(ratio64_bnds). - rewrite size_to_list max_ler; smt(ratio64_bnds). +have E1: (size (drop rate64 newst) = 25 - rate64). + rewrite size_drop; first smt(rate64_bnds). + rewrite size_to_list max_ler; smt(rate64_bnds). +have E2: (size (drop rate64 (to_list st)) = 25 - rate64). + rewrite size_drop; first smt(rate64_bnds). + rewrite size_to_list max_ler; smt(rate64_bnds). apply (eq_from_nth witness). by rewrite E1 E2. -move=> i Hi; rewrite !nth_drop 1..4:[smt(ratio64_bnds)]. -rewrite 2!get_to_list set_neqiE; smt(ratio64_bnds). +move=> i Hi; rewrite !nth_drop 1..4:[smt(rate64_bnds)]. +rewrite 2!get_to_list set_neqiE; smt(rate64_bnds). qed. -(* [squeezestate] extracts a [ratio64] 64bit words from the state *) +(* [squeezestate] extracts a [rate64] 64bit words from the state *) op squeezestate (st: state): W64.t list = - take ratio64 (to_list st). + take rate64 (to_list st). (* [xtrbytes outl w64L] converts at most [outl] bytes from the list of 64bit words [w64L] *) @@ -1083,21 +577,21 @@ lemma xtrbytes_squeezestate n st: take (8*n) (ofblock (state_r st)). proof. rewrite /xtrbytes -take_w8L2bits /squeezestate; congr. -rewrite /state_r /state2bits -ratio64P take_w64L2bits. +rewrite /state_r /state2bits -rate64P take_w64L2bits. rewrite w64L2w8L2bits ofblockK // size_w64L2bits size_take. - smt(ratio64_bnds). -rewrite Array25.size_to_list -ratio64P. -by have ->/=: ratio64 < 25 by smt(ratio64_bnds). + smt(rate64_bnds). +rewrite Array25.size_to_list -rate64P. +by have ->/=: rate64 < 25 by smt(rate64_bnds). qed. lemma size_pad2blocks8 mbits m: size mbits < 6 => - size (pad2blocks (w8L2bits m ++ mbits)) = size m %/ ratio8 + 1. + size (pad2blocks (w8L2bits m ++ mbits)) = size m %/ rate8 + 1. proof. -rewrite size_pad2blocks size_cat size_w8L2bits -ratio8P => ?; congr. +rewrite size_pad2blocks size_cat size_w8L2bits -rate8P => ?; congr. rewrite -addzA. -have := (divmod_mul ratio8 8 (size m) (size mbits + 1) _ _); -by smt(size_ge0 ratio8_bnds). +have := (divmod_mul rate8 8 (size m) (size mbits + 1) _ _); +by smt(size_ge0 rate8_bnds). qed. lemma behead_pad2blocks m: @@ -1112,27 +606,46 @@ case: (r = size m) => E. have ->: size m = 1*r + 0 by smt(). by rewrite num0_block_suffix. have ->/=: r < size m by smt(). -rewrite size_drop; first smt(ratio_bnds). +rewrite size_drop; first smt(rate_bnds). rewrite max_ler; first smt(size_ge0). have {1}->: size m = 1*r + (size m - r) by ring. by rewrite /mkpad num0_block_suffix. qed. lemma behead_pad2blocks8 mbits m: - ratio8 <= size m => + rate8 <= size m => behead (pad2blocks (w8L2bits m ++ mbits)) = pad2blocks (w8L2bits (take_block64 m).`2 ++ mbits). proof. move=> ?; rewrite behead_pad2blocks. - by rewrite size_cat size_w8L2bits -ratio8P; smt(size_ge0). -rewrite /take_block64 /= drop_cat size_w8L2bits -ratio8P. + by rewrite size_cat size_w8L2bits -rate8P; smt(size_ge0). +rewrite /take_block64 /= drop_cat size_w8L2bits -rate8P. rewrite StdOrder.IntOrder.ltr_pmul2l //. -case: (ratio8 = size m) => E. +case: (rate8 = size m) => E. by rewrite E /= drop0 drop_size w8L2bits_nil. -have ->/=: ratio8 < size m by smt(). +have ->/=: rate8 < size m by smt(). by rewrite -drop_w8L2bits mulzC. qed. +lemma size_pad2blocks8_ge x m mbits: + size mbits < 6 => + x <= size (pad2blocks (w8L2bits m ++ mbits)) <=> x*rate8 - rate8 <= size m. +proof. +move=> Hmbits; rewrite size_pad2blocks8 //. +rewrite (: x <= size m %/ rate8 + 1 = x-1 <= size m %/ rate8) 1:/#. +by rewrite lez_divRL; smt(rate8_bnds). +qed. + +lemma needed_blocks8P n x: + x < (8*n + r - 1) %/ r <=> 0 < n - x*rate8. +proof. +rewrite ltzE lez_divRL; first smt(rate_bnds). +rewrite mulzDl /= !(addzC _ r) -addzA lez_add2l. +rewrite -rate8P (mulzC 8) -mulzA mulzC -(lez_add2l 1) !(addzC 1) /= -ltzE. +by rewrite StdOrder.IntOrder.ltr_pmul2l /#. +qed. + + module type PermT = { @@ -1146,7 +659,7 @@ module Spec0(P : PermT) = { result <- []; st <- st0; (* ABSORB *) - while (ratio8 <= size m){ + while (rate8 <= size m){ (b, m) <- take_block64 m; st <- addstate st b; st <@ P.perm(st); @@ -1157,7 +670,7 @@ module Spec0(P : PermT) = { st <@ P.perm(st); b <- squeezestate st; result <- result ++ xtrbytes outl b; - outl = outl - ratio8; + outl = outl - rate8; } return result; @@ -1166,17 +679,6 @@ module Spec0(P : PermT) = { -lemma needed_blocks8P n x: - x < (8*n + r - 1) %/ r <=> 0 < n - x*ratio8. -proof. -rewrite ltzE lez_divRL; first smt(ratio_bnds). -rewrite mulzDl /= !(addzC _ r) -addzA lez_add2l. -rewrite -ratio8P (mulzC 8) -mulzA mulzC -(lez_add2l 1) !(addzC 1) /= -ltzE. -by rewrite StdOrder.IntOrder.ltr_pmul2l /#. -qed. - - - section. declare module IdealizedPerm: DPRIMITIVE. @@ -1188,19 +690,6 @@ axiom perm_correct : axiom perm_lossless: islossless IdealizedPerm.f. -lemma size_behead ['a] (l:'a list): - size (behead l) = max 0 (size l - 1). -proof. by case: l => [|x xs] /=; rewrite /max //=; smt(size_ge0). qed. - -lemma size_pad2blocks8_ge x m mbits: - size mbits < 6 => - x <= size (pad2blocks (w8L2bits m ++ mbits)) <=> x*ratio8 - ratio8 <= size m. -proof. -move=> Hmbits; rewrite size_pad2blocks8 //. -rewrite (: x <= size m %/ ratio8 + 1 = x-1 <= size m %/ ratio8) 1:/#. -by rewrite lez_divRL; smt(ratio8_bnds). -qed. - lemma spec_correct mbits: equiv [ Sponge(IdealizedPerm).f ~ Spec0(ConcretePerm).f : bs{1} = w8L2bits m{2} ++ mbits /\ @@ -1227,11 +716,11 @@ seq 3 2: (#[/1,3:]pre /\ match_state (sa,sc){1} st{2} /\ + by rewrite H6. + by rewrite H6. + by rewrite behead_pad2blocks8. - + rewrite size_behead size_pad2blocks8 // max_ler /= lez_divRL; smt(ratio8_bnds). + + rewrite size_behead size_pad2blocks8 // max_ler /= lez_divRL; smt(rate8_bnds). + rewrite size_take_block64r //. have: 3 <= size (pad2blocks (w8L2bits m{2} ++ mbits)). move: H8; rewrite size_behead max_ler. - rewrite size_pad2blocks8 //= lez_divRL; smt(ratio8_bnds). + rewrite size_pad2blocks8 //= lez_divRL; smt(rate8_bnds). smt(). by rewrite size_pad2blocks8_ge /#. + have : 2 <= size (pad2blocks (w8L2bits m{2} ++ mbits)). @@ -1240,14 +729,14 @@ seq 3 2: (#[/1,3:]pre /\ match_state (sa,sc){1} st{2} /\ + have : 2 < size (pad2blocks (w8L2bits m{2} ++ mbits)). rewrite size_pad2blocks8 //. apply (StdOrder.IntOrder.ltr_le_trans (2+1)) => //. - apply lez_add2r; rewrite lez_divRL /= 1:[smt(ratio8_bnds)]. - move: H7; rewrite /take_block64 /= size_drop 1:[smt(ratio8_bnds)]. + apply lez_add2r; rewrite lez_divRL /= 1:[smt(rate8_bnds)]. + move: H7; rewrite /take_block64 /= size_drop 1:[smt(rate8_bnds)]. by rewrite max_ler /#. by pose L:= pad2blocks _; move: L => [|x1 [|x2 [|x3 xs]]] => //=; smt(). skip => |> *; progress. + by rewrite st0_r. + by rewrite st0_c. - + rewrite size_pad2blocks8 //; smt(size_ge0 divz_ge0 ratio8_bnds). + + rewrite size_pad2blocks8 //; smt(size_ge0 divz_ge0 rate8_bnds). + by move: H1; rewrite ltzE /= size_pad2blocks8_ge /#. + have: 2 <= size (pad2blocks (w8L2bits m{2} ++ mbits)). by rewrite size_pad2blocks8_ge /#. @@ -1272,15 +761,15 @@ case: (0 < outl2); last first. move=> *; wp; call (_:true); skip => |> *. case: (8 * outl{m} + r - 1 < 0) => ?. rewrite -lezNgt; apply ltzW. - rewrite ltzNge divz_ge0; first smt(ratio_bnds). + rewrite ltzNge divz_ge0; first smt(rate_bnds). smt(). rewrite divz_small //. - by apply bound_abs; smt(ratio_bnds). + by apply bound_abs; smt(rate_bnds). by wp; call {1} perm_lossless; skip => |> *; progress. (* normal case: positive length output *) rcondt {2} 3; first by move=> *; wp; skip => |>. seq 4 6: (#[/5]pre /\ 0 < outl2 /\ n{1} = 8*outl2 /\ - outl{2} + (i{1}+1)*ratio8 = outl2 /\ + outl{2} + (i{1}+1)*rate8 = outl2 /\ take n{1} (z{1} ++ ofblock sa{1}) = w8L2bits result{2} /\ (z=[] /\ i=0){1}). wp; call perm_correct; wp; skip => [??]. @@ -1288,13 +777,13 @@ seq 4 6: (#[/5]pre /\ 0 < outl2 /\ n{1} = 8*outl2 /\ + rewrite eq_sym; apply addfinalblock_r => //. move: H1; rewrite size_pad2blocks8 //. rewrite -{2}(addz0 1) addzC=> /addzI. - rewrite -divz_eq0; smt(ratio8_bnds). + rewrite -divz_eq0; smt(rate8_bnds). by move: H0; rewrite /match_state /=. + rewrite /addfinalblock addfinalbit_c addstate_c. rewrite size_final_block64. move: H1; rewrite size_pad2blocks8 //. rewrite -{2}(addz0 1) addzC=> /addzI. - by rewrite -divz_eq0; smt(ratio8_bnds). + by rewrite -divz_eq0; smt(rate8_bnds). by rewrite (match_state_c _ _ H0). + by rewrite H4. + by rewrite H4. @@ -1311,18 +800,18 @@ seq 1 1: (#[:-2]pre /\ (i+1=(n + r - 1) %/ r){1}). + by rewrite H8. + smt(). + rewrite take_cat. - rewrite size_cat H3 size_block -ratio8P. - have ->/=: !(8 * (outl{2} + (i{1} + 1) * ratio8) - < i{1} * (8*ratio8) + 8*ratio8). + rewrite size_cat H3 size_block -rate8P. + have ->/=: !(8 * (outl{2} + (i{1} + 1) * rate8) + < i{1} * (8*rate8) + 8*rate8). rewrite -lezNgt mulzDl !mulzDr /=. rewrite addzA lez_add2r (mulzC 8) -mulzA mulzC. - rewrite -{1}(add0z (8 * (i{1} * ratio8))) lez_add2r. + rewrite -{1}(add0z (8 * (i{1} * rate8))) lez_add2r. apply ltzW; smt(). rewrite w8L2bits_cat -H0. rewrite H8 /= eq_sym take_oversize. - rewrite size_cat H3 size_block -ratio8P. - rewrite mulzDl !mulzDr /= (mulzC 8 ratio8). - rewrite (mulzC _ (i{1} * ratio8)) -!mulzA. + rewrite size_cat H3 size_block -rate8P. + rewrite mulzDl !mulzDr /= (mulzC 8 rate8). + rewrite (mulzC _ (i{1} * rate8)) -!mulzA. rewrite -{1}(add0z (_ + _)%Int) lez_add2r. apply ltzW; smt(). by congr; rewrite xtrbytes_squeezestate; congr; ring. diff --git a/proof/impl/Sponge1600.ec b/proof/impl/Sponge1600.ec index a64f405..99bd7d3 100644 --- a/proof/impl/Sponge1600.ec +++ b/proof/impl/Sponge1600.ec @@ -9,23 +9,23 @@ require import Distr DBool DList. require import StdBigop StdOrder. import IntOrder. -op ratio :int. -axiom ratio_bnds: 0 < ratio < 1600. -axiom ratio_w64: 64 %| ratio. +op rate :int. +axiom rate_bnds: 0 < rate < 1600. +axiom rate_w64: 64 %| rate. -lemma ratio_ge2: 2 <= ratio. +lemma rate_ge2: 2 <= rate. proof. -case: (ratio = 1) => E. - by rewrite E; smt(ratio_w64). -by smt (ratio_bnds). +case: (rate = 1) => E. + by rewrite E; smt(rate_w64). +by smt (rate_bnds). qed. require Common. clone export Common as Common1600 - with op r = ratio, + with op r = rate, op c = 1600-r - proof ge2_r by apply ratio_ge2 - proof gt0_c by smt (ratio_bnds). + proof ge2_r by apply rate_ge2 + proof gt0_c by smt (rate_bnds). require Indifferentiability. clone include Indifferentiability with From 64c30d987cd5347ccad153930e7a39519b7ed6e4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jos=C3=A9=20Bacelar=20Almeida?= Date: Thu, 9 May 2019 23:40:41 +0100 Subject: [PATCH 387/525] added reference implementation --- proof/impl/Array24.ec | 3 + proof/impl/Array25.ec | 3 + proof/impl/EclibExtra.ec | 2 +- proof/impl/Spec1600.ec | 120 +++++++---- proof/impl/WArray192.ec | 3 + proof/impl/WArray200.ec | 3 + proof/impl/keccak_1600.ec | 383 +++++++++++++++++++++++++++++++++ proof/impl/keccak_1600_corr.ec | 257 ++++++++++++++++++++++ 8 files changed, 734 insertions(+), 40 deletions(-) create mode 100644 proof/impl/Array24.ec create mode 100644 proof/impl/Array25.ec create mode 100644 proof/impl/WArray192.ec create mode 100644 proof/impl/WArray200.ec create mode 100644 proof/impl/keccak_1600.ec create mode 100644 proof/impl/keccak_1600_corr.ec diff --git a/proof/impl/Array24.ec b/proof/impl/Array24.ec new file mode 100644 index 0000000..0e33098 --- /dev/null +++ b/proof/impl/Array24.ec @@ -0,0 +1,3 @@ +(*from Jasmin*) require import JArray. + +clone export PolyArray as Array24 with op size <- 24. diff --git a/proof/impl/Array25.ec b/proof/impl/Array25.ec new file mode 100644 index 0000000..244da44 --- /dev/null +++ b/proof/impl/Array25.ec @@ -0,0 +1,3 @@ +(*from Jasmin*) require import JArray. + +clone export PolyArray as Array25 with op size <- 25. diff --git a/proof/impl/EclibExtra.ec b/proof/impl/EclibExtra.ec index 83112f0..b7158fa 100644 --- a/proof/impl/EclibExtra.ec +++ b/proof/impl/EclibExtra.ec @@ -3,7 +3,7 @@ require import Core Int IntDiv List. require BitEncoding. (*---*) import IntExtra. -(*from Jasmin*) require JUtils. +from Jasmin require JUtils. lemma nth_inside ['a] d1 d2 (l: 'a list) i: 0 <= i < size l => diff --git a/proof/impl/Spec1600.ec b/proof/impl/Spec1600.ec index 45fefd5..e47b74d 100644 --- a/proof/impl/Spec1600.ec +++ b/proof/impl/Spec1600.ec @@ -1,5 +1,5 @@ require import AllCore List Int IntDiv. -(*from Jasmin*) require import JArray JMemory JModel JWord JWord_array JUtils. +from Jasmin require import JArray JMemory JModel JWord JWord_array JUtils. require import EclibExtra JWordList. @@ -9,7 +9,6 @@ axiom rate_w64: 64 %| rate. require Sponge1600. - clone import Sponge1600 as Spnge1600 with op rate = rate proof rate_bnds by apply rate_bnds @@ -136,6 +135,14 @@ qed. require import Array25. type state = W64.t Array25.t. +(* We treat the sponge permutation as an abstract function. It acts as + a bridge between the idealized permutation used in the security proof + (RO), and the concrete Keccak-F[1600] instantiation adopted in the + implementation. *) +op sponge_permutation : state -> state. + + + op st0 : state = Array25.create W64.zero. op state2bits (st: state) : bool list = w64L2bits (to_list st). @@ -646,15 +653,8 @@ by rewrite StdOrder.IntOrder.ltr_pmul2l /#. qed. - - -module type PermT = { - proc perm(st : state) : state -}. - - -module Spec0(P : PermT) = { - proc f(trailbyte: W8.t, m: W8.t list, outl: int) : W8.t list = { +module Spec = { + proc f(trail_byte: W8.t, m: W8.t list, outlen: int) : W8.t list = { var result,b,st; result <- []; st <- st0; @@ -662,17 +662,19 @@ module Spec0(P : PermT) = { while (rate8 <= size m){ (b, m) <- take_block64 m; st <- addstate st b; - st <@ P.perm(st); + st <- sponge_permutation st; } - st <- addfinalblock st (final_block64 trailbyte m); + st <- addfinalblock st (final_block64 trail_byte m); (* SQUEEZE *) - while (0 < outl){ - st <@ P.perm(st); + while (rate8 < outlen){ + st <- sponge_permutation st; b <- squeezestate st; - result <- result ++ xtrbytes outl b; - outl = outl - rate8; + result <- result ++ xtrbytes rate8 b; + outlen = outlen - rate8; } - + st <- sponge_permutation st; + b <- squeezestate st; + result <- result ++ xtrbytes outlen b; return result; } }. @@ -682,35 +684,31 @@ module Spec0(P : PermT) = { section. declare module IdealizedPerm: DPRIMITIVE. -declare module ConcretePerm: PermT. - -axiom perm_correct : - equiv [IdealizedPerm.f ~ ConcretePerm.perm : - match_state x{1} st{2} ==> match_state res{1} res{2}]. - -axiom perm_lossless: islossless IdealizedPerm.f. +axiom perm_correct st: + phoare [ IdealizedPerm.f: + match_state x st + ==> + match_state res (sponge_permutation st) ] = 1%r. lemma spec_correct mbits: -equiv [ Sponge(IdealizedPerm).f ~ Spec0(ConcretePerm).f : +equiv [ Sponge(IdealizedPerm).f ~ Spec.f : bs{1} = w8L2bits m{2} ++ mbits /\ - n{1} = 8*outl{2} /\ - trailbyte{2} = trail_byte mbits /\ size mbits < 6 + n{1} = 8*outlen{2} /\ + trail_byte{2} = trail_byte bs{1} /\ size mbits < 6 ==> res{1} = w8L2bits res{2}]. proof. -proc; simplify; exists* outl{2}; elim* => outl2. +proc; simplify; exists* outlen{2}; elim* => outlen2. swap {1} 1 1; swap {1} [2..3] 2. swap {2} 1 3. splitwhile {1} 3: (1 < size xs). -unroll {2} 5. (* ABSORB intermediate blocks *) seq 3 2: (#[/1,3:]pre /\ match_state (sa,sc){1} st{2} /\ xs{1} = (pad2blocks (w8L2bits m ++ mbits)){2} /\ size xs{1} = 1). - sp. - while (#[/5,7:]pre /\ match_state (sa,sc){1} st{2} /\ - xs{1} = pad2blocks (w8L2bits m{2} ++ mbits) /\ - outl2 = outl{2} /\ 1<=size xs{1}). - wp; call perm_correct; wp; skip; progress. + sp; while (#[/5,7:]pre /\ match_state (sa,sc){1} st{2} /\ + xs{1} = pad2blocks (w8L2bits m{2} ++ mbits) /\ + outlen2 = outlen{2} /\ 1<=size xs{1}). + wp 1 2; ecall {1} (perm_correct st{2}); wp; skip; progress. + by rewrite (match_state_r _ _ H0) eq_sym; apply addfullblockP. + by move: H0; rewrite addstate_c /match_state //= size_take_block64l. + by rewrite H6. @@ -743,7 +741,7 @@ seq 3 2: (#[/1,3:]pre /\ match_state (sa,sc){1} st{2} /\ smt(). + by rewrite ltzE /= size_pad2blocks8_ge /#. + rewrite size_pad2blocks8 // divz_small //. - apply bound_abs; smt(size_ge0). + by apply bound_abs; smt(size_ge0). (* ABSORB final block *) unroll {1} 1; rcondt {1} 1. move=> *; skip => |> *. @@ -753,10 +751,51 @@ rcondf {1} 3. move: (pad2blocks _) => [|??] //= ?. by rewrite -size_eq0 /#. (* SQUEEZE *) +splitwhile {1} 5: (i+1 < (n + r - 1) %/ r). +admit (* +(* +pre = + (outl2 = outl{2} /\ + n{1} = 8 * outl{2} /\ trailbyte{2} = trail_byte mbits /\ size mbits < 6) /\ + match_state (sa{1}, sc{1}) st{2} /\ + xs{1} = pad2blocks (w8L2bits m{2} ++ mbits) /\ size xs{1} = 1 + +(sa, sc) <@ (1----) st <- + IdealizedPerm.f(sa +^ head b0 xs, sc) ( ---) addfinalblock st + ( ---) (final_block64 trailbyte m) +xs <- behead xs (2----) result <- [] +z <- [] (3----) while (rate8 < outl) { + (3.1--) st <- sponge_permutation st + (3.2--) b <- squeezestate st + (3.3--) result <- result ++ xtrbytes rate8 b + (3.4--) outl <- outl - rate8 + (3----) } +i <- 0 (4----) st <- sponge_permutation st +while (i < (n + r - 1) %/ r /\ (5----) b <- squeezestate st + i + 1 < (n + r - 1) %/ r) { ( ---) + z <- z ++ ofblock sa (5.1--) + i <- i + 1 (5.2--) + if (i < (n + r - 1) %/ r) { TRUE! (5.3--) + (sa, sc) <@ IdealizedPerm.f(sa, sc) (5.3.1) + } (5.3--) +} (5----) + + + +while (i < (n + r - 1) %/ r) { (6----) result <- result ++ xtrbytes outl b + z <- z ++ ofblock sa (6.1--) + i <- i + 1 (6.2--) + if (i < (n + r - 1) %/ r) { FALSE! (6.3--) + (sa, sc) <@ IdealizedPerm.f(sa, sc) (6.3.1) + } (6.3--) +} (6----) + +post = take n{1} z{1} = w8L2bits result{2} + +*) case: (0 < outl2); last first. (* corner case: no output *) - rcondf {2} 3; first by move=> *; wp; skip => |> *. - rcondf {2} 3; first by move=> *; wp; skip => |> *. + rcondf {2} 3; first by move=> *; wp; skip => |> *; smt(rate8_bnds). rcondf {1} 5. move=> *; wp; call (_:true); skip => |> *. case: (8 * outl{m} + r - 1 < 0) => ?. @@ -765,7 +804,9 @@ case: (0 < outl2); last first. smt(). rewrite divz_small //. by apply bound_abs; smt(rate_bnds). - by wp; call {1} perm_lossless; skip => |> *; progress. +wp 1 2; ecall {1} (perm_correct st{2}); wp; skip => |> *; progress. +admit. admit. admit. + (* by wp; call {1} perm_correct; skip => |> *; progress.*) (* normal case: positive length output *) rcondt {2} 3; first by move=> *; wp; skip => |>. seq 4 6: (#[/5]pre /\ 0 < outl2 /\ n{1} = 8*outl2 /\ @@ -832,6 +873,7 @@ unroll {1} 1; rcondt {1} 1; first by move=> *; skip => |> * /#. rcondf {1} 3; first by move=> *; wp; skip => |> * /#. rcondf {1} 3; first by move=> *; wp; skip => |> * /#. by wp; skip => |> *. +*). qed. end section. diff --git a/proof/impl/WArray192.ec b/proof/impl/WArray192.ec new file mode 100644 index 0000000..f403683 --- /dev/null +++ b/proof/impl/WArray192.ec @@ -0,0 +1,3 @@ +(*from Jasmin*) require import JWord_array. + +clone export WArray as WArray192 with op size <- 192. diff --git a/proof/impl/WArray200.ec b/proof/impl/WArray200.ec new file mode 100644 index 0000000..1874270 --- /dev/null +++ b/proof/impl/WArray200.ec @@ -0,0 +1,3 @@ +(*from Jasmin*) require import JWord_array. + +clone export WArray as WArray200 with op size <- 200. diff --git a/proof/impl/keccak_1600.ec b/proof/impl/keccak_1600.ec new file mode 100644 index 0000000..10ed747 --- /dev/null +++ b/proof/impl/keccak_1600.ec @@ -0,0 +1,383 @@ +require import List Int IntExtra IntDiv CoreMap. +from Jasmin require import JModel. + +require import Array5 Array24 Array25. +require import WArray40 WArray192 WArray200. + + + +module M = { + proc index (x:int, y:int) : int = { + + var r:int; + + r <- ((x %% 5) + (5 * (y %% 5))); + return (r); + } + + proc theta (a:W64.t Array25.t) : W64.t Array25.t = { + var aux_1: bool; + var aux_0: bool; + var aux: int; + var aux_2: W64.t; + + var x:int; + var c:W64.t Array5.t; + var y:int; + var d:W64.t Array5.t; + var _0:bool; + var _1:bool; + c <- witness; + d <- witness; + x <- 0; + while (x < 5) { + c.[x] <- (W64.of_int 0); + y <- 0; + while (y < 5) { + c.[x] <- (c.[x] `^` a.[(x + (5 * y))]); + y <- y + 1; + } + x <- x + 1; + } + x <- 0; + while (x < 5) { + (aux_1, aux_0, aux_2) <- x86_ROL_64 c.[((x + 1) %% 5)] (W8.of_int 1); + _0 <- aux_1; + _1 <- aux_0; + d.[x] <- aux_2; + d.[x] <- (d.[x] `^` c.[((x + 4) %% 5)]); + x <- x + 1; + } + x <- 0; + while (x < 5) { + y <- 0; + while (y < 5) { + a.[(x + (5 * y))] <- (a.[(x + (5 * y))] `^` d.[x]); + y <- y + 1; + } + x <- x + 1; + } + return (a); + } + + proc keccakRhoOffsets (i:int) : int = { + var aux: int; + + var r:int; + var x:int; + var y:int; + var t:int; + var z:int; + + r <- 0; + x <- 1; + y <- 0; + t <- 0; + while (t < 24) { + if ((i = (x + (5 * y)))) { + r <- ((((t + 1) * (t + 2)) %/ 2) %% 64); + } else { + + } + z <- (((2 * x) + (3 * y)) %% 5); + x <- y; + y <- z; + t <- t + 1; + } + return (r); + } + + proc rho (a:W64.t Array25.t) : W64.t Array25.t = { + var aux_1: bool; + var aux_0: bool; + var aux: int; + var aux_2: W64.t; + + var x:int; + var y:int; + var i:int; + var z:int; + var _0:bool; + var _1:bool; + + x <- 0; + while (x < 5) { + y <- 0; + while (y < 5) { + i <@ index (x, y); + z <@ keccakRhoOffsets (i); + (aux_1, aux_0, aux_2) <- x86_ROL_64 a.[i] (W8.of_int z); + _0 <- aux_1; + _1 <- aux_0; + a.[i] <- aux_2; + y <- y + 1; + } + x <- x + 1; + } + return (a); + } + + proc pi (a:W64.t Array25.t) : W64.t Array25.t = { + var aux: int; + + var i:int; + var t:W64.t; + var b:W64.t Array25.t; + var y:int; + var x:int; + b <- witness; + i <- 0; + while (i < 25) { + t <- a.[i]; + b.[i] <- t; + i <- i + 1; + } + x <- 0; + while (x < 5) { + y <- 0; + while (y < 5) { + t <- b.[(x + (5 * y))]; + i <@ index (y, ((2 * x) + (3 * y))); + a.[i] <- t; + y <- y + 1; + } + x <- x + 1; + } + return (a); + } + + proc chi (a:W64.t Array25.t) : W64.t Array25.t = { + var aux: int; + + var x:int; + var y:int; + var i:int; + var c:W64.t Array5.t; + c <- witness; + y <- 0; + while (y < 5) { + x <- 0; + while (x < 5) { + i <@ index ((x + 1), y); + c.[x] <- a.[i]; + c.[x] <- (invw c.[x]); + i <@ index ((x + 2), y); + c.[x] <- (c.[x] `&` a.[i]); + i <@ index (x, y); + c.[x] <- (c.[x] `^` a.[i]); + x <- x + 1; + } + x <- 0; + while (x < 5) { + a.[(x + (5 * y))] <- c.[x]; + x <- x + 1; + } + y <- y + 1; + } + return (a); + } + + proc iota_0 (a:W64.t Array25.t, c:W64.t) : W64.t Array25.t = { + + + + a.[0] <- (a.[0] `^` c); + return (a); + } + + proc keccakP1600_round (state:W64.t Array25.t, c:W64.t) : W64.t Array25.t = { + + + + state <@ theta (state); + state <@ rho (state); + state <@ pi (state); + state <@ chi (state); + state <@ iota_0 (state, c); + return (state); + } + + proc keccakRoundConstants () : W64.t Array24.t = { + + var constants:W64.t Array24.t; + constants <- witness; + constants.[0] <- (W64.of_int 1); + constants.[1] <- (W64.of_int 32898); + constants.[2] <- (W64.of_int 9223372036854808714); + constants.[3] <- (W64.of_int 9223372039002292224); + constants.[4] <- (W64.of_int 32907); + constants.[5] <- (W64.of_int 2147483649); + constants.[6] <- (W64.of_int 9223372039002292353); + constants.[7] <- (W64.of_int 9223372036854808585); + constants.[8] <- (W64.of_int 138); + constants.[9] <- (W64.of_int 136); + constants.[10] <- (W64.of_int 2147516425); + constants.[11] <- (W64.of_int 2147483658); + constants.[12] <- (W64.of_int 2147516555); + constants.[13] <- (W64.of_int 9223372036854775947); + constants.[14] <- (W64.of_int 9223372036854808713); + constants.[15] <- (W64.of_int 9223372036854808579); + constants.[16] <- (W64.of_int 9223372036854808578); + constants.[17] <- (W64.of_int 9223372036854775936); + constants.[18] <- (W64.of_int 32778); + constants.[19] <- (W64.of_int 9223372039002259466); + constants.[20] <- (W64.of_int 9223372039002292353); + constants.[21] <- (W64.of_int 9223372036854808704); + constants.[22] <- (W64.of_int 2147483649); + constants.[23] <- (W64.of_int 9223372039002292232); + return (constants); + } + + proc keccak_f1600 (state:W64.t Array25.t) : W64.t Array25.t = { + var aux: int; + + var constants:W64.t Array24.t; + var round:int; + constants <- witness; + constants <@ keccakRoundConstants (); + round <- 0; + while (round < 24) { + state <@ keccakP1600_round (state, constants.[round]); + round <- round + 1; + } + return (state); + } + + proc st0 () : W64.t Array25.t = { + var aux: int; + + var state:W64.t Array25.t; + var i:int; + state <- witness; + i <- 0; + while (i < 25) { + state.[i] <- (W64.of_int 0); + i <- i + 1; + } + return (state); + } + + proc add_full_block (state:W64.t Array25.t, in_0:W64.t, rate:W64.t) : + W64.t Array25.t = { + + var i:W64.t; + var t:W64.t; + + i <- (W64.of_int 0); + + while ((i \ult rate)) { + t <- (loadW64 Glob.mem (W64.to_uint (in_0 + ((W64.of_int 8) * i)))); + state.[(W64.to_uint i)] <- (state.[(W64.to_uint i)] `^` t); + i <- (i + (W64.of_int 1)); + } + return (state); + } + + proc add_final_block (state:W64.t Array25.t, in_0:W64.t, inlen:W64.t, + trail_byte:W8.t, rate:W64.t) : W64.t Array25.t = { + + var i:W64.t; + var t:W64.t; + var j:W64.t; + var c:W8.t; + + i <- (W64.of_int 0); + + while (((W64.of_int 8) \ule inlen)) { + t <- (loadW64 Glob.mem (W64.to_uint (in_0 + ((W64.of_int 8) * i)))); + state.[(W64.to_uint i)] <- (state.[(W64.to_uint i)] `^` t); + i <- (i + (W64.of_int 1)); + inlen <- (inlen - (W64.of_int 8)); + } + j <- ((W64.of_int 8) * i); + + while (((W64.of_int 0) \ult inlen)) { + c <- (loadW8 Glob.mem (W64.to_uint (in_0 + j))); + state = + Array25.init + (WArray200.get64 (WArray200.set8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint j) ( + (get8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint j)) `^` c))); + inlen <- (inlen - (W64.of_int 1)); + j <- (j + (W64.of_int 1)); + } + state = + Array25.init + (WArray200.get64 (WArray200.set8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint j) ( + (get8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint j)) `^` trail_byte))); + state = + Array25.init + (WArray200.get64 (WArray200.set8 (WArray200.init64 (fun i => state.[i])) ((W64.to_uint rate) - 1) ( + (get8 (WArray200.init64 (fun i => state.[i])) ((W64.to_uint rate) - 1)) `^` (W8.of_int 128)))); + return (state); + } + + proc xtr_full_block (state:W64.t Array25.t, out:W64.t, rate:W64.t) : unit = { + + var i:W64.t; + var t:W64.t; + + i <- (W64.of_int 0); + + while ((i \ult rate)) { + t <- state.[(W64.to_uint i)]; + Glob.mem <- + storeW64 Glob.mem (W64.to_uint (out + ((W64.of_int 8) * i))) t; + i <- (i + (W64.of_int 1)); + } + return (); + } + + proc xtr_bytes (state:W64.t Array25.t, out:W64.t, outlen:W64.t) : unit = { + + var i:W64.t; + var t:W64.t; + var j:W64.t; + var c:W8.t; + + i <- (W64.of_int 0); + + while (((W64.of_int 8) \ule outlen)) { + t <- state.[(W64.to_uint i)]; + Glob.mem <- + storeW64 Glob.mem (W64.to_uint (out + ((W64.of_int 8) * i))) t; + i <- (i + (W64.of_int 1)); + outlen <- (outlen - (W64.of_int 8)); + } + j <- ((W64.of_int 8) * i); + + while (((W64.of_int 0) \ult outlen)) { + c <- (get8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint j)); + Glob.mem <- storeW8 Glob.mem (W64.to_uint (out + j)) c; + outlen <- (outlen - (W64.of_int 1)); + j <- (j + (W64.of_int 1)); + } + return (); + } + + proc keccak_1600 (out:W64.t, outlen:W64.t, in_0:W64.t, inlen:W64.t, + trail_byte:W8.t, rate:W64.t) : unit = { + + var state:W64.t Array25.t; + state <- witness; + state <@ st0 (); + + while ((rate \ule inlen)) { + state <@ add_full_block (state, in_0, rate); + state <@ keccak_f1600 (state); + inlen <- (inlen - rate); + in_0 <- (in_0 + rate); + } + state <@ add_final_block (state, in_0, inlen, trail_byte, rate); + + while ((rate \ult outlen)) { + state <@ keccak_f1600 (state); + xtr_full_block (state, out, rate); + outlen <- (outlen - rate); + out <- (out + rate); + } + state <@ keccak_f1600 (state); + xtr_bytes (state, out, outlen); + return (); + } +}. + diff --git a/proof/impl/keccak_1600_corr.ec b/proof/impl/keccak_1600_corr.ec new file mode 100644 index 0000000..08d39c2 --- /dev/null +++ b/proof/impl/keccak_1600_corr.ec @@ -0,0 +1,257 @@ +require import List Int IntExtra IntDiv CoreMap. +from Jasmin require import JModel. + + +require import Spec1600 Keccak_1600. + +op x86_TEST_8 : W8.t -> W8.t -> bool*bool*bool*bool*bool. + + +op memread (m : global_mem_t) (a : address) (sz : int): W8.t list = + mkseq (fun i => m.[a + i]) sz. + +lemma size_memread mem a sz: + 0 <= sz => size (memread mem a sz) = sz. +proof. by rewrite /memread size_map size_iota /#. qed. + +lemma size_memread' mem a sz: + size (memread mem a sz) = max 0 sz. +proof. by rewrite /memread size_map size_iota /#. qed. + + + + +section. + +axiom permutation_instantiation st: + phoare [ M.keccak_f1600: + state = st + ==> + res = sponge_permutation st ] = 1%r. + +lemma spec_correct out_ outlen_: +equiv [ Spec.f ~ M.keccak_1600 : + m{1} = (memread Glob.mem (to_uint in_0) (to_uint inlen)){2} /\ + out{2} = out_ /\ + outlen{1} = W64.to_uint outlen{2} /\ + outlen{2} = outlen_ /\ + ={trail_byte} /\ + to_uint rate{2} = rate + ==> + res{1} = memread Glob.mem{2} (W64.to_uint out_) (W64.to_uint outlen_) + ]. +proof. +proc. +admit. +qed. + +end section. + + + + +equiv [ Spec0(ConcretePerm).f~M.keccak_1600 : + suffix{2} < 64 /\ rate{2} = ratio /\ + (iotas_correct Glob.mem iotas_){2} /\ + m{1} = (memread Glob.mem (to_uint in_0) (to_uint inlen)){2} /\ + out{2} = out_ptr /\ hash_bytes{2} = hlen + ==> res{1} = memread Glob.mem{2} (to_uint out_ptr) (to_uint hlen) ]. + + + + +lemma keccak_init_spec_h: + hoare [ M.keccak_init : true ==> res = st0 ] . +proof. +proc; sp. +while (#[2]pre /\ 0 <= to_uint i <= 25 /\ forall k, 0 <= k < to_uint i => state.[k]=t). + wp; skip; progress. + + by move: H2; rewrite ultE to_uintD_small /#. + + by move: H2 H3; rewrite ultE to_uintD_small /#. + + move: H2 H4; rewrite ultE to_uintD_small 1:/# !of_uintK !modz_small // => ??. + case: (k < to_uint i{hr}) => E. + by rewrite set_neqiE 1,2:/# H1 /#. + by rewrite set_eqiE /#. +skip; progress; first smt(). +move: H2; have ->: to_uint i0 = 25. + by move: H; rewrite ultE; smt(). +by move=> {H H0 H1} H; apply Array25.ext_eq => ??; rewrite (H x) // /st0 createiE. +qed. + +lemma keccak_init_spec_ll: islossless M.keccak_init. +proof. +islossless; while true (25 - to_uint i). + move=> ?; wp; skip => ?; rewrite ultE of_uintK !modz_small // => [[??]]. + by rewrite to_uintD_small !of_uintK modz_small // /#. +by skip => ???; rewrite ultE of_uintK !modz_small // /#. +qed. + +lemma keccak_init_spec: + phoare [ M.keccak_init : true ==> res = st0 ] = 1%r. +proof. by conseq keccak_init_spec_ll keccak_init_spec_h. qed. + +lemma addfullblock_spec_h st m (in_00 inlen0: W64.t): + hoare [ M.keccak_1600_add_full_block: + m = memread Glob.mem (to_uint in_00) (to_uint inlen0) + /\ ratio8 <= to_uint inlen0 + /\ state = st + /\ in_0 = in_00 + /\ inlen = inlen0 + /\ rate_in_bytes = ratio8 + ==> + res.`1 = addstate st (take_block64 m).`1 + /\ res.`2 = in_00 + W64.of_int Top.ratio8 + /\ res.`3 = inlen0 - W64.of_int Top.ratio8]. +proof. +proc; simplify; wp; sp. +while (#[3:5,6:]pre /\ aux = ratio64 /\ i <= ratio64 + /\ state = addstate st (take i (take_block64 m).`1)). + wp; skip; progress. + + smt(). + + rewrite (take_nth W64.zero). + admit. + admit. +skip; progress. ++ by rewrite /Top.ratio8 mulKz. ++ by smt(Top.ratio64_bnds). ++ rewrite take0 /addstate. + admit. ++ have ->: i0 = ratio64. + admit. + rewrite take_oversize. + admit. + done. +qed. + +lemma addfullblock_spec_ll: islossless M.keccak_1600_add_full_block. +proof. +proc; wp; sp; while true (aux-i). + move=> ?; wp; skip; progress; smt(). +skip; progress; smt(). +qed. + +lemma addfullblock_spec st m (in_00 inlen0: W64.t): + phoare [ M.keccak_1600_add_full_block: + m = memread Glob.mem (to_uint in_00) (to_uint inlen0) + /\ ratio8 <= to_uint inlen0 + /\ state = st + /\ in_0 = in_00 + /\ inlen = inlen0 + /\ rate_in_bytes = ratio8 + ==> + res.`1 = addstate st (take_block64 m).`1 + /\ res.`2 = in_00 + W64.of_int Top.ratio8 + /\ res.`3 = inlen0 - W64.of_int Top.ratio8] = 1%r. +proof. by conseq addfullblock_spec_ll (addfullblock_spec_h st m in_00 inlen0). qed. + +lemma lastu64_spec_h m trailbyte: + hoare [ M.lastu64: + m = memread Glob.mem (to_uint in_0) (to_uint inlen) + /\ to_uint inlen < 8 + /\ W8.to_uint trailbyte = suffix + /\ suffix < 64 + ==> + [res] = final_block64 trailbyte m ]. +proof. +proc; wp; skip; progress. ++ admit. ++ admit. ++ admit. ++ admit. ++ admit. ++ admit. ++ admit. ++ admit. +qed. + +lemma lastu64_spec_ll: islossless M.lastu64. +proof. by islossless. qed. + +lemma lastu64_spec m trailbyte: + phoare [ M.lastu64: + m = memread Glob.mem (to_uint in_0) (to_uint inlen) + /\ to_uint inlen < 8 + /\ W8.to_uint trailbyte = suffix + /\ suffix < 64 + ==> + [res] = final_block64 trailbyte m ] = 1%r. +proof. by conseq lastu64_spec_ll (lastu64_spec_h m trailbyte). qed. + + +lemma addfinalblock_spec_h st m trailbyte: + hoare [ M.keccak_1600_add_final_block: + m = memread Glob.mem (to_uint in_0) (to_uint inlen) + /\ to_uint inlen < ratio8 + /\ state = st + /\ rate_in_bytes = ratio8 + /\ W8.to_uint trailbyte = suffix + /\ suffix < 64 + ==> + res = addfinalbit (addstate st (final_block64 trailbyte m)) ]. +proof. +proc; simplify. +admit. +qed. + +lemma addfinalblock_spec_ll: islossless M.keccak_1600_add_final_block. +proof. +proc; wp; call lastu64_spec_ll; islossless. +while true (to_uint inlen8 - to_uint i). + move=> ?; wp; skip => ?. + rewrite ultE; move => [? <-]. + rewrite to_uintD_small of_uintK 2:/# modz_small //. + by move: (W64.to_uint_cmp inlen8{hr}); smt(). +skip; progress. +by rewrite ultE /#. +qed. + +lemma addfinalblock_spec st m trailbyte: + phoare [ M.keccak_1600_add_final_block: + m = memread Glob.mem (to_uint in_0) (to_uint inlen) + /\ to_uint inlen < ratio8 + /\ state = st + /\ rate_in_bytes = ratio8 + /\ W8.to_uint trailbyte = suffix + /\ suffix < 64 + ==> + res = addfinalbit (addstate st (final_block64 trailbyte m)) ] = 1%r. +proof. +by conseq addfinalblock_spec_ll (addfinalblock_spec_h st m trailbyte). +qed. + + +print M. +lemma keccak_correct out_ptr hlen: +equiv [ Spec0(ConcretePerm).f~M.keccak_1600 : + suffix{2} < 64 /\ rate{2} = ratio /\ + (iotas_correct Glob.mem iotas_){2} /\ + m{1} = (memread Glob.mem (to_uint in_0) (to_uint inlen)){2} /\ + out{2} = out_ptr /\ hash_bytes{2} = hlen + ==> res{1} = memread Glob.mem{2} (to_uint out_ptr) (to_uint hlen) ]. +proof. +proc; simplify. +inline M.keccak_1600_absorb M.spill_2 M.load_2. +seq 3 12: (#[/1:4,5:]pre /\ + m{1} = memread Glob.mem{2} (to_uint in_00{2}) (to_uint inlen0{2}) /\ + st{1} = state0{2} /\ + to_uint inlen0{2} < ratio8). + (* absorb intermediate blocks *) + while (#[/:-1]post). + wp. + admit (* PERM + addfullblock_spec *). + wp; call {2} keccak_init_spec; wp; skip; progress. + rewrite uleE of_uintK modz_small. admit. + admit (* size_memread *). + admit (* size_memread *). + smt. +seq 1 1: (#[/:6]pre /\ st{1} = state0{2}). + ecall {2} (addfinalblock_spec state0{2} m{1} (W8.of_int suffix0{2})). + wp; skip; auto => |> *; progress. + + admit (* rate_in_bytes{2} = Top.ratio8 *). + + admit (* arith *). + + admit (* pre... *). + + admit (* trailbyte vs suffix *). +(* squeeze *) +inline M.keccak_1600_squeeze. +admit. +qed. From 5f799fe425b02b67474e96a383edfa34b24c5f9d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jos=C3=A9=20Bacelar=20Almeida?= Date: Fri, 10 May 2019 15:51:01 +0100 Subject: [PATCH 388/525] fix namespace --- proof/impl/Array24.ec | 2 +- proof/impl/Array25.ec | 2 +- proof/impl/Array5.ec | 3 + proof/impl/EclibExtra.ec | 1 - proof/impl/JWordList.ec | 2 +- proof/impl/WArray192.ec | 2 +- proof/impl/WArray200.ec | 2 +- proof/impl/WArray40.ec | 3 + proof/impl/keccak_1600_corr.ec | 205 +++++++++++++-------------------- 9 files changed, 90 insertions(+), 132 deletions(-) create mode 100644 proof/impl/Array5.ec create mode 100644 proof/impl/WArray40.ec diff --git a/proof/impl/Array24.ec b/proof/impl/Array24.ec index 0e33098..8982b77 100644 --- a/proof/impl/Array24.ec +++ b/proof/impl/Array24.ec @@ -1,3 +1,3 @@ -(*from Jasmin*) require import JArray. +from Jasmin require import JArray. clone export PolyArray as Array24 with op size <- 24. diff --git a/proof/impl/Array25.ec b/proof/impl/Array25.ec index 244da44..30bcb17 100644 --- a/proof/impl/Array25.ec +++ b/proof/impl/Array25.ec @@ -1,3 +1,3 @@ -(*from Jasmin*) require import JArray. +from Jasmin require import JArray. clone export PolyArray as Array25 with op size <- 25. diff --git a/proof/impl/Array5.ec b/proof/impl/Array5.ec new file mode 100644 index 0000000..8dc7b36 --- /dev/null +++ b/proof/impl/Array5.ec @@ -0,0 +1,3 @@ +from Jasmin require import JArray. + +clone export PolyArray as Array5 with op size <- 5. diff --git a/proof/impl/EclibExtra.ec b/proof/impl/EclibExtra.ec index b7158fa..1607e9b 100644 --- a/proof/impl/EclibExtra.ec +++ b/proof/impl/EclibExtra.ec @@ -103,7 +103,6 @@ elim/natind: n => /=. by move=> n Hn IH; rewrite addzC mkseq_add // mkseq1. qed. -print BitEncoding.BitChunking.chunk. lemma behead_chunk ['a] n (l:'a list): behead (BitEncoding.BitChunking.chunk n l) = BitEncoding.BitChunking.chunk n (drop n l). diff --git a/proof/impl/JWordList.ec b/proof/impl/JWordList.ec index 3facb4e..9753679 100644 --- a/proof/impl/JWordList.ec +++ b/proof/impl/JWordList.ec @@ -1,5 +1,5 @@ require import AllCore List Int IntDiv. -(*from Jasmin*) require import JWord JUtils. +from Jasmin require import JWord JUtils. require import EclibExtra. diff --git a/proof/impl/WArray192.ec b/proof/impl/WArray192.ec index f403683..c8564c5 100644 --- a/proof/impl/WArray192.ec +++ b/proof/impl/WArray192.ec @@ -1,3 +1,3 @@ -(*from Jasmin*) require import JWord_array. +from Jasmin require import JWord_array. clone export WArray as WArray192 with op size <- 192. diff --git a/proof/impl/WArray200.ec b/proof/impl/WArray200.ec index 1874270..99b887c 100644 --- a/proof/impl/WArray200.ec +++ b/proof/impl/WArray200.ec @@ -1,3 +1,3 @@ -(*from Jasmin*) require import JWord_array. +from Jasmin require import JWord_array. clone export WArray as WArray200 with op size <- 200. diff --git a/proof/impl/WArray40.ec b/proof/impl/WArray40.ec new file mode 100644 index 0000000..003b6e2 --- /dev/null +++ b/proof/impl/WArray40.ec @@ -0,0 +1,3 @@ +from Jasmin require import JWord_array. + +clone export WArray as WArray40 with op size <- 40. diff --git a/proof/impl/keccak_1600_corr.ec b/proof/impl/keccak_1600_corr.ec index 08d39c2..dbfe83c 100644 --- a/proof/impl/keccak_1600_corr.ec +++ b/proof/impl/keccak_1600_corr.ec @@ -1,6 +1,7 @@ require import List Int IntExtra IntDiv CoreMap. from Jasmin require import JModel. +require import Array25. require import Spec1600 Keccak_1600. @@ -18,132 +19,89 @@ lemma size_memread' mem a sz: size (memread mem a sz) = max 0 sz. proof. by rewrite /memread size_map size_iota /#. qed. +(* SPECIFICATION OF LEAF-FUNCTIONS *) - - -section. - -axiom permutation_instantiation st: - phoare [ M.keccak_f1600: - state = st - ==> - res = sponge_permutation st ] = 1%r. - -lemma spec_correct out_ outlen_: -equiv [ Spec.f ~ M.keccak_1600 : - m{1} = (memread Glob.mem (to_uint in_0) (to_uint inlen)){2} /\ - out{2} = out_ /\ - outlen{1} = W64.to_uint outlen{2} /\ - outlen{2} = outlen_ /\ - ={trail_byte} /\ - to_uint rate{2} = rate - ==> - res{1} = memread Glob.mem{2} (W64.to_uint out_) (W64.to_uint outlen_) - ]. -proof. -proc. -admit. -qed. - -end section. - - - - -equiv [ Spec0(ConcretePerm).f~M.keccak_1600 : - suffix{2} < 64 /\ rate{2} = ratio /\ - (iotas_correct Glob.mem iotas_){2} /\ - m{1} = (memread Glob.mem (to_uint in_0) (to_uint inlen)){2} /\ - out{2} = out_ptr /\ hash_bytes{2} = hlen - ==> res{1} = memread Glob.mem{2} (to_uint out_ptr) (to_uint hlen) ]. - - - - -lemma keccak_init_spec_h: - hoare [ M.keccak_init : true ==> res = st0 ] . +lemma st0_spec_h: + hoare [ M.st0 : true ==> res = st0 ] . proof. proc; sp. -while (#[2]pre /\ 0 <= to_uint i <= 25 /\ forall k, 0 <= k < to_uint i => state.[k]=t). - wp; skip; progress. - + by move: H2; rewrite ultE to_uintD_small /#. - + by move: H2 H3; rewrite ultE to_uintD_small /#. - + move: H2 H4; rewrite ultE to_uintD_small 1:/# !of_uintK !modz_small // => ??. - case: (k < to_uint i{hr}) => E. - by rewrite set_neqiE 1,2:/# H1 /#. - by rewrite set_eqiE /#. +while (0 <= i <= 25 /\ forall k, 0 <= k < i => state.[k]=W64.zero). + wp; skip; progress; first 2 smt(). + case: (k < i{hr}) => E. + by rewrite set_neqiE 1,2:/# H1 /#. + by rewrite set_eqiE /#. skip; progress; first smt(). -move: H2; have ->: to_uint i0 = 25. - by move: H; rewrite ultE; smt(). +move: H2; have ->: i0 = 25 by smt(). by move=> {H H0 H1} H; apply Array25.ext_eq => ??; rewrite (H x) // /st0 createiE. qed. -lemma keccak_init_spec_ll: islossless M.keccak_init. +lemma st0_spec_ll: islossless M.st0. proof. -islossless; while true (25 - to_uint i). - move=> ?; wp; skip => ?; rewrite ultE of_uintK !modz_small // => [[??]]. - by rewrite to_uintD_small !of_uintK modz_small // /#. -by skip => ???; rewrite ultE of_uintK !modz_small // /#. +islossless; while true (25 - i). + by move=> ?; wp; skip => ? [??] /#. +by skip => ??? /#. qed. -lemma keccak_init_spec: - phoare [ M.keccak_init : true ==> res = st0 ] = 1%r. -proof. by conseq keccak_init_spec_ll keccak_init_spec_h. qed. +lemma st0_spec: + phoare [ M.st0 : true ==> res = st0 ] = 1%r. +proof. by conseq st0_spec_ll st0_spec_h. qed. -lemma addfullblock_spec_h st m (in_00 inlen0: W64.t): - hoare [ M.keccak_1600_add_full_block: - m = memread Glob.mem (to_uint in_00) (to_uint inlen0) - /\ ratio8 <= to_uint inlen0 +lemma add_full_block_spec_h st m (in_00: W64.t): + hoare [ M.add_full_block: + m = memread Glob.mem (to_uint in_00) rate8 /\ state = st /\ in_0 = in_00 - /\ inlen = inlen0 - /\ rate_in_bytes = ratio8 + /\ to_uint rate = rate64 ==> - res.`1 = addstate st (take_block64 m).`1 - /\ res.`2 = in_00 + W64.of_int Top.ratio8 - /\ res.`3 = inlen0 - W64.of_int Top.ratio8]. + res = addstate st (take_block64 m).`1 ]. proof. proc; simplify; wp; sp. -while (#[3:5,6:]pre /\ aux = ratio64 /\ i <= ratio64 - /\ state = addstate st (take i (take_block64 m).`1)). +while (#[2:]pre /\ to_uint i <= rate64 + /\ state = addstate st (take (to_uint i) (take_block64 m).`1)). wp; skip; progress. - + smt(). - + rewrite (take_nth W64.zero). - admit. - admit. + + admit. + + move: H2; rewrite ultE => ?. + rewrite to_uintD_small of_uintK modz_small; smt(rate64_bnds). + + rewrite to_uintD_small to_uintM_small of_uintK modz_small //. + - smt(rate64_bnds). + - admit (* in_0 mem_region *). + - smt(rate64_bnds). + admit . skip; progress. -+ by rewrite /Top.ratio8 mulKz. -+ by smt(Top.ratio64_bnds). ++ smt(rate64_bnds). + rewrite take0 /addstate. admit. -+ have ->: i0 = ratio64. ++ have E: to_uint i0 = rate64. admit. - rewrite take_oversize. + move: H3; rewrite take_oversize. admit. done. qed. -lemma addfullblock_spec_ll: islossless M.keccak_1600_add_full_block. +lemma add_full_block_spec_ll: islossless M.add_full_block. proof. -proc; wp; sp; while true (aux-i). - move=> ?; wp; skip; progress; smt(). -skip; progress; smt(). +proc; wp; sp; while true (rate64-to_uint i). + move=> ?; wp; skip; progress. + move: H; rewrite ultE => ?. + rewrite to_uintD_small of_uintK modz_small //. + admit. + smt(). +skip; progress. +rewrite ultE. +admit. qed. -lemma addfullblock_spec st m (in_00 inlen0: W64.t): - phoare [ M.keccak_1600_add_full_block: - m = memread Glob.mem (to_uint in_00) (to_uint inlen0) - /\ ratio8 <= to_uint inlen0 +lemma addfullblock_spec st m in_00: + phoare [ M.add_full_block: + m = memread Glob.mem (W64.to_uint in_00) rate8 /\ state = st /\ in_0 = in_00 - /\ inlen = inlen0 - /\ rate_in_bytes = ratio8 + /\ to_uint rate = rate64 ==> - res.`1 = addstate st (take_block64 m).`1 - /\ res.`2 = in_00 + W64.of_int Top.ratio8 - /\ res.`3 = inlen0 - W64.of_int Top.ratio8] = 1%r. -proof. by conseq addfullblock_spec_ll (addfullblock_spec_h st m in_00 inlen0). qed. + res = addstate st (take_block64 m).`1 ] = 1%r. +proof. by conseq add_full_block_spec_ll (add_full_block_spec_h st m in_00). qed. +(* lemma lastu64_spec_h m trailbyte: hoare [ M.lastu64: m = memread Glob.mem (to_uint in_0) (to_uint inlen) @@ -220,38 +178,33 @@ by conseq addfinalblock_spec_ll (addfinalblock_spec_h st m trailbyte). qed. -print M. -lemma keccak_correct out_ptr hlen: -equiv [ Spec0(ConcretePerm).f~M.keccak_1600 : - suffix{2} < 64 /\ rate{2} = ratio /\ - (iotas_correct Glob.mem iotas_){2} /\ - m{1} = (memread Glob.mem (to_uint in_0) (to_uint inlen)){2} /\ - out{2} = out_ptr /\ hash_bytes{2} = hlen - ==> res{1} = memread Glob.mem{2} (to_uint out_ptr) (to_uint hlen) ]. +*) + +(* MAIN RESULT *) + +section. + +axiom permutation_instantiation st: + phoare [ M.keccak_f1600: + state = st + ==> + res = sponge_permutation st ] = 1%r. + +lemma spec_correct out_ outlen_: +equiv [ Spec.f ~ M.keccak_1600 : + m{1} = (memread Glob.mem (to_uint in_0) (to_uint inlen)){2} /\ + out{2} = out_ /\ + outlen{1} = W64.to_uint outlen{2} /\ + outlen{2} = outlen_ /\ + ={trail_byte} /\ + to_uint rate{2} = rate + ==> + res{1} = memread Glob.mem{2} (W64.to_uint out_) (W64.to_uint outlen_) + ]. proof. -proc; simplify. -inline M.keccak_1600_absorb M.spill_2 M.load_2. -seq 3 12: (#[/1:4,5:]pre /\ - m{1} = memread Glob.mem{2} (to_uint in_00{2}) (to_uint inlen0{2}) /\ - st{1} = state0{2} /\ - to_uint inlen0{2} < ratio8). - (* absorb intermediate blocks *) - while (#[/:-1]post). - wp. - admit (* PERM + addfullblock_spec *). - wp; call {2} keccak_init_spec; wp; skip; progress. - rewrite uleE of_uintK modz_small. admit. - admit (* size_memread *). - admit (* size_memread *). - smt. -seq 1 1: (#[/:6]pre /\ st{1} = state0{2}). - ecall {2} (addfinalblock_spec state0{2} m{1} (W8.of_int suffix0{2})). - wp; skip; auto => |> *; progress. - + admit (* rate_in_bytes{2} = Top.ratio8 *). - + admit (* arith *). - + admit (* pre... *). - + admit (* trailbyte vs suffix *). -(* squeeze *) -inline M.keccak_1600_squeeze. +proc. admit. qed. + +end section. + From f2250ab57222cff09ea6e684a2c15ff3c5e79469 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jos=C3=A9=20Bacelar=20Almeida?= Date: Sat, 11 May 2019 02:09:28 +0100 Subject: [PATCH 389/525] upd --- proof/impl/keccak_1600_corr.ec | 152 ++++++++++++++++++++------------- 1 file changed, 94 insertions(+), 58 deletions(-) diff --git a/proof/impl/keccak_1600_corr.ec b/proof/impl/keccak_1600_corr.ec index dbfe83c..d49f426 100644 --- a/proof/impl/keccak_1600_corr.ec +++ b/proof/impl/keccak_1600_corr.ec @@ -101,84 +101,118 @@ lemma addfullblock_spec st m in_00: res = addstate st (take_block64 m).`1 ] = 1%r. proof. by conseq add_full_block_spec_ll (add_full_block_spec_h st m in_00). qed. -(* -lemma lastu64_spec_h m trailbyte: - hoare [ M.lastu64: - m = memread Glob.mem (to_uint in_0) (to_uint inlen) - /\ to_uint inlen < 8 - /\ W8.to_uint trailbyte = suffix - /\ suffix < 64 +lemma add_final_block_spec_h st m (in_00 inlen0: W64.t) trail_byte0: + hoare [ M.add_final_block: + m = memread Glob.mem (to_uint in_00) (to_uint inlen0) + /\ state = st + /\ in_0 = in_00 + /\ inlen = inlen0 + /\ trail_byte = trail_byte0 + /\ to_uint rate = rate64 ==> - [res] = final_block64 trailbyte m ]. + res = addfinalblock st (final_block64 trail_byte0 m) ]. proof. -proc; wp; skip; progress. -+ admit. -+ admit. -+ admit. -+ admit. -+ admit. -+ admit. -+ admit. -+ admit. +proc; simplify. +admit. qed. -lemma lastu64_spec_ll: islossless M.lastu64. -proof. by islossless. qed. +lemma add_final_block_spec_ll: islossless M.add_final_block. +proof. +islossless. + while true (to_uint inlen). + move=> ?; wp; skip; progress; rewrite to_uintB 2:/#. + by move: H; rewrite ultE uleE /#. + by skip; progress; rewrite ultE /#. +while true (to_uint inlen). + move=> ?; wp; skip; progress; rewrite to_uintB 2:/#. + by move: H; rewrite uleE /#. +by skip; progress; rewrite uleE /#. +qed. -lemma lastu64_spec m trailbyte: - phoare [ M.lastu64: - m = memread Glob.mem (to_uint in_0) (to_uint inlen) - /\ to_uint inlen < 8 - /\ W8.to_uint trailbyte = suffix - /\ suffix < 64 +lemma add_final_block_spec st m (in_00 inlen0: W64.t) trailb: + phoare [ M.add_final_block: + m = memread Glob.mem (to_uint in_00) (to_uint inlen0) + /\ state = st + /\ in_0 = in_00 + /\ inlen = inlen0 + /\ trail_byte = trailb + /\ to_uint rate = rate64 ==> - [res] = final_block64 trailbyte m ] = 1%r. -proof. by conseq lastu64_spec_ll (lastu64_spec_h m trailbyte). qed. - + res = addfinalblock st (final_block64 trailb m) ] = 1%r. +proof. +by conseq add_final_block_spec_ll (add_final_block_spec_h st m in_00 inlen0 trailb). +qed. -lemma addfinalblock_spec_h st m trailbyte: - hoare [ M.keccak_1600_add_final_block: - m = memread Glob.mem (to_uint in_0) (to_uint inlen) - /\ to_uint inlen < ratio8 - /\ state = st - /\ rate_in_bytes = ratio8 - /\ W8.to_uint trailbyte = suffix - /\ suffix < 64 +lemma xtr_full_block_spec_h st out0: + hoare [ M.xtr_full_block: + state = st + /\ out = out0 + /\ to_uint rate = rate64 ==> - res = addfinalbit (addstate st (final_block64 trailbyte m)) ]. + memread Glob.mem (to_uint out0) rate8 + = xtrbytes rate8 (squeezestate st) ]. proof. proc; simplify. admit. qed. -lemma addfinalblock_spec_ll: islossless M.keccak_1600_add_final_block. +lemma xtr_full_block_spec_ll: islossless M.xtr_full_block. proof. -proc; wp; call lastu64_spec_ll; islossless. -while true (to_uint inlen8 - to_uint i). - move=> ?; wp; skip => ?. - rewrite ultE; move => [? <-]. - rewrite to_uintD_small of_uintK 2:/# modz_small //. - by move: (W64.to_uint_cmp inlen8{hr}); smt(). -skip; progress. -by rewrite ultE /#. +islossless. while true (to_uint rate-to_uint i). + move=> ?; wp; skip; progress. + move: H; rewrite ultE => ?. + rewrite to_uintD_small of_uintK modz_small // 2:/#. + by have /# := W64.to_uint_cmp rate{hr}. +by skip; progress; rewrite ultE /#. qed. -lemma addfinalblock_spec st m trailbyte: - phoare [ M.keccak_1600_add_final_block: - m = memread Glob.mem (to_uint in_0) (to_uint inlen) - /\ to_uint inlen < ratio8 - /\ state = st - /\ rate_in_bytes = ratio8 - /\ W8.to_uint trailbyte = suffix - /\ suffix < 64 +lemma xtr_full_block_spec st out0: + phoare [ M.xtr_full_block: + state = st + /\ out = out0 + /\ to_uint rate = rate64 ==> - res = addfinalbit (addstate st (final_block64 trailbyte m)) ] = 1%r. + memread Glob.mem (to_uint out0) rate8 + = xtrbytes rate8 (squeezestate st) ] = 1%r. +proof. by conseq xtr_full_block_spec_ll (xtr_full_block_spec_h st out0). qed. + +lemma xtr_bytes_spec_h st out0 outlen0: + hoare [ M.xtr_bytes: + state = st + /\ out = out0 + /\ outlen = outlen0 + ==> + memread Glob.mem (to_uint out0) (to_uint outlen0) + = xtrbytes rate8 (squeezestate st) ]. proof. -by conseq addfinalblock_spec_ll (addfinalblock_spec_h st m trailbyte). +proc; simplify. +admit. qed. +lemma xtr_bytes_spec_ll: islossless M.xtr_bytes. +proof. +islossless. + while true (to_uint outlen). + move=> ?; wp; skip => ?; rewrite ultE; progress. + rewrite to_uintB 2:/#. + by rewrite uleE /#. + by skip; progress; rewrite ultE /#. +while true (to_uint outlen). + move=> ?; wp; skip => ?; rewrite uleE; progress. + rewrite to_uintB 2:/#. + by rewrite uleE /#. +by skip; progress; rewrite uleE /#. +qed. -*) +lemma xtr_bytes_spec st out0 outlen0: + phoare [ M.xtr_bytes: + state = st + /\ out = out0 + /\ outlen = outlen0 + ==> + memread Glob.mem (to_uint out0) (to_uint outlen0) + = xtrbytes rate8 (squeezestate st) ] = 1%r. +proof. by conseq xtr_bytes_spec_ll (xtr_bytes_spec_h st out0 outlen0). qed. (* MAIN RESULT *) @@ -202,7 +236,9 @@ equiv [ Spec.f ~ M.keccak_1600 : res{1} = memread Glob.mem{2} (W64.to_uint out_) (W64.to_uint outlen_) ]. proof. -proc. +proc; simplify; wp. +ecall {2} (xtr_bytes_spec state{2} out{2} outlen{2}); simplify. +ecall {2} (permutation_instantiation state{2}); simplify. admit. qed. From 886ad07410388a6b0f1ed7360bcffa3d5a88e8ad Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jos=C3=A9=20Bacelar=20Almeida?= Date: Sat, 11 May 2019 16:29:25 +0100 Subject: [PATCH 390/525] upd --- proof/impl/keccak_1600_corr.ec | 26 +- proof/impl/keccak_1600_ref.ec | 418 +++++++++++++++++++++++++++++++++ 2 files changed, 431 insertions(+), 13 deletions(-) create mode 100644 proof/impl/keccak_1600_ref.ec diff --git a/proof/impl/keccak_1600_corr.ec b/proof/impl/keccak_1600_corr.ec index d49f426..c5598e6 100644 --- a/proof/impl/keccak_1600_corr.ec +++ b/proof/impl/keccak_1600_corr.ec @@ -3,7 +3,7 @@ from Jasmin require import JModel. require import Array25. -require import Spec1600 Keccak_1600. +require import Spec1600 Keccak_1600_ref. op x86_TEST_8 : W8.t -> W8.t -> bool*bool*bool*bool*bool. @@ -51,7 +51,7 @@ lemma add_full_block_spec_h st m (in_00: W64.t): m = memread Glob.mem (to_uint in_00) rate8 /\ state = st /\ in_0 = in_00 - /\ to_uint rate = rate64 + /\ to_uint r64 = rate64 ==> res = addstate st (take_block64 m).`1 ]. proof. @@ -96,7 +96,7 @@ lemma addfullblock_spec st m in_00: m = memread Glob.mem (W64.to_uint in_00) rate8 /\ state = st /\ in_0 = in_00 - /\ to_uint rate = rate64 + /\ to_uint r64 = rate64 ==> res = addstate st (take_block64 m).`1 ] = 1%r. proof. by conseq add_full_block_spec_ll (add_full_block_spec_h st m in_00). qed. @@ -108,7 +108,7 @@ lemma add_final_block_spec_h st m (in_00 inlen0: W64.t) trail_byte0: /\ in_0 = in_00 /\ inlen = inlen0 /\ trail_byte = trail_byte0 - /\ to_uint rate = rate64 + /\ to_uint r8 = rate8 ==> res = addfinalblock st (final_block64 trail_byte0 m) ]. proof. @@ -136,7 +136,7 @@ lemma add_final_block_spec st m (in_00 inlen0: W64.t) trailb: /\ in_0 = in_00 /\ inlen = inlen0 /\ trail_byte = trailb - /\ to_uint rate = rate64 + /\ to_uint r8 = rate8 ==> res = addfinalblock st (final_block64 trailb m) ] = 1%r. proof. @@ -147,7 +147,7 @@ lemma xtr_full_block_spec_h st out0: hoare [ M.xtr_full_block: state = st /\ out = out0 - /\ to_uint rate = rate64 + /\ to_uint r64 = rate64 ==> memread Glob.mem (to_uint out0) rate8 = xtrbytes rate8 (squeezestate st) ]. @@ -158,11 +158,11 @@ qed. lemma xtr_full_block_spec_ll: islossless M.xtr_full_block. proof. -islossless. while true (to_uint rate-to_uint i). +islossless. while true (to_uint r64-to_uint i). move=> ?; wp; skip; progress. move: H; rewrite ultE => ?. rewrite to_uintD_small of_uintK modz_small // 2:/#. - by have /# := W64.to_uint_cmp rate{hr}. + by have /# := W64.to_uint_cmp r64{hr}. by skip; progress; rewrite ultE /#. qed. @@ -170,7 +170,7 @@ lemma xtr_full_block_spec st out0: phoare [ M.xtr_full_block: state = st /\ out = out0 - /\ to_uint rate = rate64 + /\ to_uint r64 = rate64 ==> memread Glob.mem (to_uint out0) rate8 = xtrbytes rate8 (squeezestate st) ] = 1%r. @@ -219,19 +219,19 @@ proof. by conseq xtr_bytes_spec_ll (xtr_bytes_spec_h st out0 outlen0). qed. section. axiom permutation_instantiation st: - phoare [ M.keccak_f1600: + phoare [ M.__keccak_f1600_ref: state = st ==> res = sponge_permutation st ] = 1%r. lemma spec_correct out_ outlen_: -equiv [ Spec.f ~ M.keccak_1600 : +equiv [ Spec.f ~ M.__keccak_1600 : m{1} = (memread Glob.mem (to_uint in_0) (to_uint inlen)){2} /\ out{2} = out_ /\ outlen{1} = W64.to_uint outlen{2} /\ outlen{2} = outlen_ /\ - ={trail_byte} /\ - to_uint rate{2} = rate + to_uint trail_byte{1} = to_uint trail_byte{2} /\ + to_uint r64{2} = rate ==> res{1} = memread Glob.mem{2} (W64.to_uint out_) (W64.to_uint outlen_) ]. diff --git a/proof/impl/keccak_1600_ref.ec b/proof/impl/keccak_1600_ref.ec new file mode 100644 index 0000000..25c79fd --- /dev/null +++ b/proof/impl/keccak_1600_ref.ec @@ -0,0 +1,418 @@ +require import List Int IntExtra IntDiv CoreMap. +from Jasmin require import JModel. + +require import Array5 Array24 Array25. +require import WArray40 WArray192 WArray200. + + + +module M = { + proc index (x:int, y:int) : int = { + + var r:int; + + r <- ((x %% 5) + (5 * (y %% 5))); + return (r); + } + + proc theta (a:W64.t Array25.t) : W64.t Array25.t = { + var aux_1: bool; + var aux_0: bool; + var aux: int; + var aux_2: W64.t; + + var x:int; + var c:W64.t Array5.t; + var y:int; + var d:W64.t Array5.t; + var _0:bool; + var _1:bool; + c <- witness; + d <- witness; + x <- 0; + while (x < 5) { + c.[x] <- (W64.of_int 0); + y <- 0; + while (y < 5) { + c.[x] <- (c.[x] `^` a.[(x + (5 * y))]); + y <- y + 1; + } + x <- x + 1; + } + x <- 0; + while (x < 5) { + d.[x] <- c.[((x + 1) %% 5)]; + (aux_1, aux_0, aux_2) <- x86_ROL_64 d.[x] (W8.of_int 1); + _0 <- aux_1; + _1 <- aux_0; + d.[x] <- aux_2; + d.[x] <- (d.[x] `^` c.[((x + 4) %% 5)]); + x <- x + 1; + } + x <- 0; + while (x < 5) { + y <- 0; + while (y < 5) { + a.[(x + (5 * y))] <- (a.[(x + (5 * y))] `^` d.[x]); + y <- y + 1; + } + x <- x + 1; + } + return (a); + } + + proc keccakRhoOffsets (i:int) : int = { + var aux: int; + + var r:int; + var x:int; + var y:int; + var t:int; + var z:int; + + r <- 0; + x <- 1; + y <- 0; + t <- 0; + while (t < 24) { + if ((i = (x + (5 * y)))) { + r <- ((((t + 1) * (t + 2)) %/ 2) %% 64); + } else { + + } + z <- (((2 * x) + (3 * y)) %% 5); + x <- y; + y <- z; + t <- t + 1; + } + return (r); + } + + proc rho (a:W64.t Array25.t) : W64.t Array25.t = { + var aux_1: bool; + var aux_0: bool; + var aux: int; + var aux_2: W64.t; + + var x:int; + var y:int; + var i:int; + var z:int; + var _0:bool; + var _1:bool; + + x <- 0; + while (x < 5) { + y <- 0; + while (y < 5) { + i <@ index (x, y); + z <@ keccakRhoOffsets (i); + (aux_1, aux_0, aux_2) <- x86_ROL_64 a.[i] (W8.of_int z); + _0 <- aux_1; + _1 <- aux_0; + a.[i] <- aux_2; + y <- y + 1; + } + x <- x + 1; + } + return (a); + } + + proc pi (a:W64.t Array25.t) : W64.t Array25.t = { + var aux: int; + + var i:int; + var t:W64.t; + var b:W64.t Array25.t; + var y:int; + var x:int; + b <- witness; + i <- 0; + while (i < 25) { + t <- a.[i]; + b.[i] <- t; + i <- i + 1; + } + x <- 0; + while (x < 5) { + y <- 0; + while (y < 5) { + t <- b.[(x + (5 * y))]; + i <@ index (y, ((2 * x) + (3 * y))); + a.[i] <- t; + y <- y + 1; + } + x <- x + 1; + } + return (a); + } + + proc chi (a:W64.t Array25.t) : W64.t Array25.t = { + var aux: int; + + var x:int; + var y:int; + var i:int; + var c:W64.t Array5.t; + c <- witness; + y <- 0; + while (y < 5) { + x <- 0; + while (x < 5) { + i <@ index ((x + 1), y); + c.[x] <- a.[i]; + c.[x] <- (invw c.[x]); + i <@ index ((x + 2), y); + c.[x] <- (c.[x] `&` a.[i]); + i <@ index (x, y); + c.[x] <- (c.[x] `^` a.[i]); + x <- x + 1; + } + x <- 0; + while (x < 5) { + a.[(x + (5 * y))] <- c.[x]; + x <- x + 1; + } + y <- y + 1; + } + return (a); + } + + proc iota_0 (a:W64.t Array25.t, c:W64.t) : W64.t Array25.t = { + + + + a.[0] <- (a.[0] `^` c); + return (a); + } + + proc keccakP1600_round (state:W64.t Array25.t, c:W64.t) : W64.t Array25.t = { + + + + state <@ theta (state); + state <@ rho (state); + state <@ pi (state); + state <@ chi (state); + state <@ iota_0 (state, c); + return (state); + } + + proc keccakRoundConstants () : W64.t Array24.t = { + + var constants:W64.t Array24.t; + var t:W64.t; + constants <- witness; + t <- (W64.of_int 1); + constants.[0] <- t; + t <- (W64.of_int 32898); + constants.[1] <- t; + t <- (W64.of_int 9223372036854808714); + constants.[2] <- t; + t <- (W64.of_int 9223372039002292224); + constants.[3] <- t; + t <- (W64.of_int 32907); + constants.[4] <- t; + t <- (W64.of_int 2147483649); + constants.[5] <- t; + t <- (W64.of_int 9223372039002292353); + constants.[6] <- t; + t <- (W64.of_int 9223372036854808585); + constants.[7] <- t; + t <- (W64.of_int 138); + constants.[8] <- t; + t <- (W64.of_int 136); + constants.[9] <- t; + t <- (W64.of_int 2147516425); + constants.[10] <- t; + t <- (W64.of_int 2147483658); + constants.[11] <- t; + t <- (W64.of_int 2147516555); + constants.[12] <- t; + t <- (W64.of_int 9223372036854775947); + constants.[13] <- t; + t <- (W64.of_int 9223372036854808713); + constants.[14] <- t; + t <- (W64.of_int 9223372036854808579); + constants.[15] <- t; + t <- (W64.of_int 9223372036854808578); + constants.[16] <- t; + t <- (W64.of_int 9223372036854775936); + constants.[17] <- t; + t <- (W64.of_int 32778); + constants.[18] <- t; + t <- (W64.of_int 9223372039002259466); + constants.[19] <- t; + t <- (W64.of_int 9223372039002292353); + constants.[20] <- t; + t <- (W64.of_int 9223372036854808704); + constants.[21] <- t; + t <- (W64.of_int 2147483649); + constants.[22] <- t; + t <- (W64.of_int 9223372039002292232); + constants.[23] <- t; + return (constants); + } + + proc __keccak_f1600_ref (state:W64.t Array25.t) : W64.t Array25.t = { + var aux: int; + + var constants:W64.t Array24.t; + var round:int; + constants <- witness; + constants <@ keccakRoundConstants (); + round <- 0; + while (round < 24) { + state <@ keccakP1600_round (state, constants.[round]); + round <- round + 1; + } + return (state); + } + + proc st0 () : W64.t Array25.t = { + var aux: int; + + var state:W64.t Array25.t; + var i:int; + state <- witness; + i <- 0; + while (i < 25) { + state.[i] <- (W64.of_int 0); + i <- i + 1; + } + return (state); + } + + proc add_full_block (state:W64.t Array25.t, in_0:W64.t, r64:W64.t) : + W64.t Array25.t = { + + var i:W64.t; + var t:W64.t; + + i <- (W64.of_int 0); + + while ((i \ult r64)) { + t <- (loadW64 Glob.mem (W64.to_uint (in_0 + ((W64.of_int 8) * i)))); + state.[(W64.to_uint i)] <- (state.[(W64.to_uint i)] `^` t); + i <- (i + (W64.of_int 1)); + } + return (state); + } + + proc add_final_block (state:W64.t Array25.t, in_0:W64.t, inlen:W64.t, + trail_byte:W8.t, r8:W64.t) : W64.t Array25.t = { + + var i:W64.t; + var t:W64.t; + var j:W64.t; + var c:W8.t; + + i <- (W64.of_int 0); + + while (((W64.of_int 8) \ule inlen)) { + t <- (loadW64 Glob.mem (W64.to_uint (in_0 + ((W64.of_int 8) * i)))); + state.[(W64.to_uint i)] <- (state.[(W64.to_uint i)] `^` t); + i <- (i + (W64.of_int 1)); + inlen <- (inlen - (W64.of_int 8)); + } + j <- ((W64.of_int 8) * i); + + while (((W64.of_int 0) \ult inlen)) { + c <- (loadW8 Glob.mem (W64.to_uint (in_0 + j))); + state = + Array25.init + (WArray200.get64 (WArray200.set8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint j) ( + (get8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint j)) `^` c))); + inlen <- (inlen - (W64.of_int 1)); + j <- (j + (W64.of_int 1)); + } + c <- trail_byte; + state = + Array25.init + (WArray200.get64 (WArray200.set8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint j) ( + (get8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint j)) `^` c))); + state = + Array25.init + (WArray200.get64 (WArray200.set8 (WArray200.init64 (fun i => state.[i])) ((W64.to_uint r8) - 1) ( + (get8 (WArray200.init64 (fun i => state.[i])) ((W64.to_uint r8) - 1)) `^` (W8.of_int 128)))); + return (state); + } + + proc xtr_full_block (state:W64.t Array25.t, out:W64.t, r64:W64.t) : unit = { + + var i:W64.t; + var t:W64.t; + + i <- (W64.of_int 0); + + while ((i \ult r64)) { + t <- state.[(W64.to_uint i)]; + Glob.mem <- + storeW64 Glob.mem (W64.to_uint (out + ((W64.of_int 8) * i))) t; + i <- (i + (W64.of_int 1)); + } + return (); + } + + proc xtr_bytes (state:W64.t Array25.t, out:W64.t, outlen:W64.t) : unit = { + + var i:W64.t; + var t:W64.t; + var j:W64.t; + var c:W8.t; + + i <- (W64.of_int 0); + + while (((W64.of_int 8) \ule outlen)) { + t <- state.[(W64.to_uint i)]; + Glob.mem <- + storeW64 Glob.mem (W64.to_uint (out + ((W64.of_int 8) * i))) t; + i <- (i + (W64.of_int 1)); + outlen <- (outlen - (W64.of_int 8)); + } + j <- ((W64.of_int 8) * i); + + while (((W64.of_int 0) \ult outlen)) { + c <- (get8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint j)); + Glob.mem <- storeW8 Glob.mem (W64.to_uint (out + j)) c; + outlen <- (outlen - (W64.of_int 1)); + j <- (j + (W64.of_int 1)); + } + return (); + } + + proc __keccak_1600 (out:W64.t, outlen:W64.t, in_0:W64.t, inlen:W64.t, + trail_byte:W64.t, r64:W64.t) : unit = { + + var state:W64.t Array25.t; + var rate:W64.t; + var trailbyte:W8.t; + state <- witness; + state <@ st0 (); + rate <- r64; + + while ((rate \ule inlen)) { + state <@ add_full_block (state, in_0, rate); + state <@ __keccak_f1600_ref (state); + inlen <- (inlen - rate); + in_0 <- (in_0 + rate); + rate <- r64; + } + trailbyte <- (truncateu8 trail_byte); + rate <- (rate `>>` (W8.of_int 3)); + state <@ add_final_block (state, in_0, inlen, trailbyte, rate); + + while ((rate \ult outlen)) { + state <@ __keccak_f1600_ref (state); + rate <- r64; + xtr_full_block (state, out, rate); + rate <- (rate `>>` (W8.of_int 3)); + outlen <- (outlen - rate); + out <- (out + rate); + } + state <@ __keccak_f1600_ref (state); + xtr_bytes (state, out, outlen); + return (); + } +}. + From e762c6f97ee819242dbdaf3c2c6df9b993583ff3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jos=C3=A9=20Bacelar=20Almeida?= Date: Sun, 12 May 2019 03:38:25 +0100 Subject: [PATCH 391/525] proof of main result --- proof/impl/EclibExtra.ec | 26 ++++ proof/impl/JWordList.ec | 15 +++ proof/impl/Spec1600.ec | 15 +++ proof/impl/keccak_1600_corr.ec | 223 +++++++++++++++++++++++++-------- proof/impl/keccak_1600_ref.ec | 13 +- 5 files changed, 235 insertions(+), 57 deletions(-) diff --git a/proof/impl/EclibExtra.ec b/proof/impl/EclibExtra.ec index 1607e9b..da490d0 100644 --- a/proof/impl/EclibExtra.ec +++ b/proof/impl/EclibExtra.ec @@ -103,6 +103,32 @@ elim/natind: n => /=. by move=> n Hn IH; rewrite addzC mkseq_add // mkseq1. qed. +lemma take_mkseq ['a] n (f: int -> 'a) k: + 0 <= n => take n (mkseq f k) = mkseq f (min n k). +proof. +elim/natind: n => //=. + move=> n Hn1 Hn2; have ->: n=0 by smt(). + by rewrite take0 mkseq0_le /#. +move => n Hn IH H. +case: (n < k) => E. + rewrite min_lel 1:/#. + rewrite (take_nth (f n)); first by rewrite size_mkseq /#. + rewrite IH // mkseqS // min_lel 1:/#; congr. + by rewrite nth_mkseq. +by rewrite min_ler 1:/# take_oversize // size_mkseq /#. +qed. + +lemma drop_mkseq ['a] n (f: int -> 'a) k: + 0 <= n <= k => drop n (mkseq f k) = mkseq (fun i => f (i+n)) (k-n). +proof. +elim/natind: n => //=. + move=> n Hn1 Hn2; have ->: n=0 by smt(). + by rewrite drop0. +move => n Hn IH H. +rewrite dropS // IH 1:/# behead_mkseq /= Ring.IntID.opprD addzA. +by apply eq_mkseq => x /=; congr; ring. +qed. + lemma behead_chunk ['a] n (l:'a list): behead (BitEncoding.BitChunking.chunk n l) = BitEncoding.BitChunking.chunk n (drop n l). diff --git a/proof/impl/JWordList.ec b/proof/impl/JWordList.ec index 9753679..9f20d1d 100644 --- a/proof/impl/JWordList.ec +++ b/proof/impl/JWordList.ec @@ -214,6 +214,21 @@ qed. op w64L2w8L (l: W64.t list) : W8.t list = flatten (map W8u8.to_list l). +lemma w64L2w8L_nil: + w64L2w8L [] = []. +proof. by rewrite /w64L2w8L. qed. + +lemma w64L2w8L_cons x xs: + w64L2w8L (x::xs) = W8u8.to_list x ++ w64L2w8L xs. +proof. by rewrite /w64L2w8L map_cons flatten_cons. qed. + +lemma size_w64L2w8L (l: W64.t list): + size (w64L2w8L l) = 8 * size l. +proof. +elim: l => //=; first by rewrite w64L2w8L_nil. +by move=> x xs IH; rewrite w64L2w8L_cons size_cat IH W8u8.Pack.size_to_list; ring. +qed. + lemma w64L2w8L2bits l: w8L2bits (w64L2w8L l) = w64L2bits l. proof. diff --git a/proof/impl/Spec1600.ec b/proof/impl/Spec1600.ec index e47b74d..24197bd 100644 --- a/proof/impl/Spec1600.ec +++ b/proof/impl/Spec1600.ec @@ -574,11 +574,25 @@ qed. op squeezestate (st: state): W64.t list = take rate64 (to_list st). +lemma size_squeezestate st: + size (squeezestate st) = rate64. +proof. +rewrite /squeezestate size_take'; first smt(rate64_bnds). +by rewrite Array25.size_to_list; smt(rate64_bnds). +qed. + (* [xtrbytes outl w64L] converts at most [outl] bytes from the list of 64bit words [w64L] *) op xtrbytes (n: int) (b64: W64.t list): W8.t list = take n (w64L2w8L b64). +lemma size_xtrbytes n st: + 0 <= n => + size (xtrbytes n (squeezestate st)) = min n rate8. +proof. +by move=> Hn; rewrite /xtrbytes size_take // !size_w64L2w8L size_squeezestate /#. +qed. + lemma xtrbytes_squeezestate n st: w8L2bits (xtrbytes n (squeezestate st)) = take (8*n) (ofblock (state_r st)). @@ -591,6 +605,7 @@ rewrite Array25.size_to_list -rate64P. by have ->/=: rate64 < 25 by smt(rate64_bnds). qed. + lemma size_pad2blocks8 mbits m: size mbits < 6 => size (pad2blocks (w8L2bits m ++ mbits)) = size m %/ rate8 + 1. diff --git a/proof/impl/keccak_1600_corr.ec b/proof/impl/keccak_1600_corr.ec index c5598e6..f0eafa8 100644 --- a/proof/impl/keccak_1600_corr.ec +++ b/proof/impl/keccak_1600_corr.ec @@ -1,7 +1,7 @@ require import List Int IntExtra IntDiv CoreMap. from Jasmin require import JModel. -require import Array25. +require import Array25 EclibExtra JWordList. require import Spec1600 Keccak_1600_ref. @@ -19,6 +19,38 @@ lemma size_memread' mem a sz: size (memread mem a sz) = max 0 sz. proof. by rewrite /memread size_map size_iota /#. qed. +lemma memread0 mem a: + memread mem a 0 = []. +proof. by rewrite /memread mkseq0. qed. + +lemma take_memread n mem ptr k: + 0 <= n => + take n (memread mem ptr k) = memread mem ptr (min n k). +proof. by move=> Hn; rewrite /memread take_mkseq. qed. + +lemma drop_memread n mem ptr k: + 0 <= n <= k => + drop n (memread mem ptr k) = memread mem (ptr+n) (k-n). +proof. +move=> Hn; rewrite /memread drop_mkseq //=. +by apply eq_mkseq => x; smt(). +qed. + +(* Bounded memory assumption (established by the safety analysis) *) +abbrev good_ptr (ptr: W64.t) len = + to_uint ptr + len < W64.modulus. +op inv_ptr (in_0 inlen out outlen: W64.t) = + good_ptr in_0 (to_uint inlen) /\ good_ptr out (to_uint outlen). + +lemma stores_cat mem out l1 l2: + stores mem out (l1++l2) = stores (stores mem out l1) (out + size l1) l2. +proof. +elim: l1 mem out => //= x xs IH mem out. +by rewrite !stores_cons IH addzA. +qed. + + + (* SPECIFICATION OF LEAF-FUNCTIONS *) lemma st0_spec_h: @@ -46,18 +78,19 @@ lemma st0_spec: phoare [ M.st0 : true ==> res = st0 ] = 1%r. proof. by conseq st0_spec_ll st0_spec_h. qed. -lemma add_full_block_spec_h st m (in_00: W64.t): +lemma add_full_block_spec_h st in_00: hoare [ M.add_full_block: - m = memread Glob.mem (to_uint in_00) rate8 - /\ state = st + state = st /\ in_0 = in_00 /\ to_uint r64 = rate64 ==> - res = addstate st (take_block64 m).`1 ]. + res = addstate st + (take_block64 (memread Glob.mem (to_uint in_00) rate8)).`1 + ]. proof. proc; simplify; wp; sp. while (#[2:]pre /\ to_uint i <= rate64 - /\ state = addstate st (take (to_uint i) (take_block64 m).`1)). + /\ state = addstate st (take (to_uint i) (take_block64 (memread Glob.mem (to_uint in_00) rate8)).`1)). wp; skip; progress. + admit. + move: H2; rewrite ultE => ?. @@ -91,26 +124,29 @@ rewrite ultE. admit. qed. -lemma addfullblock_spec st m in_00: +lemma add_full_block_spec st in_00: phoare [ M.add_full_block: - m = memread Glob.mem (W64.to_uint in_00) rate8 - /\ state = st + state = st /\ in_0 = in_00 /\ to_uint r64 = rate64 ==> - res = addstate st (take_block64 m).`1 ] = 1%r. -proof. by conseq add_full_block_spec_ll (add_full_block_spec_h st m in_00). qed. + res = addstate st + (take_block64 (memread Glob.mem (to_uint in_00) rate8)).`1 + ] = 1%r. +proof. by conseq add_full_block_spec_ll (add_full_block_spec_h st in_00). qed. -lemma add_final_block_spec_h st m (in_00 inlen0: W64.t) trail_byte0: +lemma add_final_block_spec_h st (in_00 inlen0: W64.t) trail_byte0: hoare [ M.add_final_block: - m = memread Glob.mem (to_uint in_00) (to_uint inlen0) - /\ state = st + state = st /\ in_0 = in_00 /\ inlen = inlen0 /\ trail_byte = trail_byte0 /\ to_uint r8 = rate8 ==> - res = addfinalblock st (final_block64 trail_byte0 m) ]. + res = addfinalblock st + (final_block64 trail_byte0 + (memread Glob.mem (to_uint in_00) (to_uint inlen0))) + ]. proof. proc; simplify. admit. @@ -129,28 +165,31 @@ while true (to_uint inlen). by skip; progress; rewrite uleE /#. qed. -lemma add_final_block_spec st m (in_00 inlen0: W64.t) trailb: +lemma add_final_block_spec st (in_00 inlen0: W64.t) trailb: phoare [ M.add_final_block: - m = memread Glob.mem (to_uint in_00) (to_uint inlen0) - /\ state = st + state = st /\ in_0 = in_00 /\ inlen = inlen0 /\ trail_byte = trailb /\ to_uint r8 = rate8 ==> - res = addfinalblock st (final_block64 trailb m) ] = 1%r. + res = addfinalblock st + (final_block64 trailb + (memread Glob.mem (to_uint in_00) (to_uint inlen0))) + ] = 1%r. proof. -by conseq add_final_block_spec_ll (add_final_block_spec_h st m in_00 inlen0 trailb). +by conseq add_final_block_spec_ll (add_final_block_spec_h st in_00 inlen0 trailb). qed. -lemma xtr_full_block_spec_h st out0: +lemma xtr_full_block_spec_h mem st out0: hoare [ M.xtr_full_block: - state = st + Glob.mem = mem + /\ state = st /\ out = out0 /\ to_uint r64 = rate64 ==> - memread Glob.mem (to_uint out0) rate8 - = xtrbytes rate8 (squeezestate st) ]. + Glob.mem = stores mem (to_uint out0) (xtrbytes rate8 (squeezestate st)) + ]. proof. proc; simplify. admit. @@ -166,24 +205,25 @@ islossless. while true (to_uint r64-to_uint i). by skip; progress; rewrite ultE /#. qed. -lemma xtr_full_block_spec st out0: - phoare [ M.xtr_full_block: - state = st +lemma xtr_full_block_spec mem st out0: + phoare [ M.xtr_full_block: + Glob.mem = mem + /\ state = st /\ out = out0 /\ to_uint r64 = rate64 ==> - memread Glob.mem (to_uint out0) rate8 - = xtrbytes rate8 (squeezestate st) ] = 1%r. -proof. by conseq xtr_full_block_spec_ll (xtr_full_block_spec_h st out0). qed. + Glob.mem = stores mem (to_uint out0) (xtrbytes rate8 (squeezestate st)) + ] = 1%r. +proof. by conseq xtr_full_block_spec_ll (xtr_full_block_spec_h mem st out0). qed. -lemma xtr_bytes_spec_h st out0 outlen0: +lemma xtr_bytes_spec_h mem st out0 outlen0: hoare [ M.xtr_bytes: - state = st + Glob.mem = mem + /\ state = st /\ out = out0 /\ outlen = outlen0 ==> - memread Glob.mem (to_uint out0) (to_uint outlen0) - = xtrbytes rate8 (squeezestate st) ]. + Glob.mem = stores mem (to_uint out0) (xtrbytes (to_uint outlen0) (squeezestate st)) ]. proof. proc; simplify. admit. @@ -204,42 +244,123 @@ while true (to_uint outlen). by skip; progress; rewrite uleE /#. qed. -lemma xtr_bytes_spec st out0 outlen0: - phoare [ M.xtr_bytes: - state = st +lemma xtr_bytes_spec mem st out0 outlen0: + phoare [ M.xtr_bytes: + Glob.mem = mem + /\ state = st /\ out = out0 /\ outlen = outlen0 ==> - memread Glob.mem (to_uint out0) (to_uint outlen0) - = xtrbytes rate8 (squeezestate st) ] = 1%r. -proof. by conseq xtr_bytes_spec_ll (xtr_bytes_spec_h st out0 outlen0). qed. + Glob.mem = stores mem (to_uint out0) (xtrbytes (to_uint outlen0) (squeezestate st)) + ] = 1%r. +proof. by conseq xtr_bytes_spec_ll (xtr_bytes_spec_h mem st out0 outlen0). qed. + + (* MAIN RESULT *) + section. -axiom permutation_instantiation st: +axiom permutation_instantiation mem st: phoare [ M.__keccak_f1600_ref: - state = st + state = st /\ Glob.mem = mem ==> - res = sponge_permutation st ] = 1%r. + Glob.mem = mem /\ res = sponge_permutation st ] = 1%r. -lemma spec_correct out_ outlen_: +lemma spec_correct mem out_: equiv [ Spec.f ~ M.__keccak_1600 : - m{1} = (memread Glob.mem (to_uint in_0) (to_uint inlen)){2} /\ + Glob.mem{2} = mem /\ inv_ptr in_0{2} inlen{2} out{2} outlen{2} /\ + m{1} = (memread mem (to_uint in_0) (to_uint inlen)){2} /\ out{2} = out_ /\ outlen{1} = W64.to_uint outlen{2} /\ - outlen{2} = outlen_ /\ + to_uint trail_byte{2} < 64 (* at most 6 bits... *) /\ to_uint trail_byte{1} = to_uint trail_byte{2} /\ - to_uint r64{2} = rate + to_uint r8{2} = rate8 ==> - res{1} = memread Glob.mem{2} (W64.to_uint out_) (W64.to_uint outlen_) + Glob.mem{2} = stores mem (W64.to_uint out_) res{1} ]. proof. +have r8_to_r64: forall (w:W64.t), + to_uint w = rate8 => to_uint(w `>>` W8.of_int 3) = rate64. + by move=> w E; rewrite shr_div_le //= E /rate8 mulKz. +have r64_to_r8: forall (w:W64.t), + to_uint w = rate64 => to_uint(w `<<` W8.of_int 3) = rate8. + move=> w E; rewrite /(`<<`)%W64 W8.of_uintK modz_small // to_uint_shl //=. + by rewrite modz_small E; smt(rate8_bnds). proc; simplify; wp. -ecall {2} (xtr_bytes_spec state{2} out{2} outlen{2}); simplify. -ecall {2} (permutation_instantiation state{2}); simplify. -admit. +ecall {2} (xtr_bytes_spec Glob.mem{2} state{2} out{2} outlen{2}); simplify. +ecall {2} (permutation_instantiation Glob.mem{2} state{2}); simplify. +while (st{1}=state{2} /\ to_uint r8{2}=rate8 /\ to_uint rate{2}=rate8 /\ + to_uint out{2} = to_uint out_ + size result{1} /\ + outlen{1} = to_uint outlen{2} /\ good_ptr out{2} (to_uint outlen{2}) /\ + Glob.mem{2} = stores mem (to_uint out_) result{1}). + wp; ecall {2} (xtr_full_block_spec Glob.mem{2} state{2} out{2}); simplify. + wp; ecall {2} (permutation_instantiation Glob.mem{2} state{2}); simplify. + skip; progress. + + by rewrite r8_to_r64. + + by rewrite r64_to_r8. + + rewrite to_uintD_small. + by move: H4; rewrite ultE r64_to_r8 /#. + rewrite r64_to_r8 // H1 size_cat addzA; congr. + rewrite size_xtrbytes; first smt(rate8_bnds). + by rewrite min_lel ?size_squeezestate. + + rewrite to_uintB. + by rewrite uleE r64_to_r8 // /#. + by congr; congr; rewrite r64_to_r8 //. + + rewrite to_uintD_small. + by move: H4; rewrite ultE r64_to_r8 /#. + rewrite r64_to_r8 // to_uintB. + rewrite uleE r64_to_r8 //. + by move: H4; rewrite ultE /#. + by rewrite r64_to_r8 /#. + + by rewrite H1 -stores_cat. + + rewrite ultE r64_to_r8 // to_uintB. + by rewrite uleE r64_to_r8 // /#. + by rewrite r64_to_r8 // /#. + + move: H6; rewrite ultE r64_to_r8 // to_uintB. + by rewrite uleE r64_to_r8 // /#. + by rewrite r64_to_r8 // /#. +ecall {2} (add_final_block_spec state{2} in_0{2} inlen{2} trailbyte{2}); simplify. +wp; while (st{1}=state{2} /\ to_uint r8{2} = rate8 /\ to_uint rate{2} = rate8 /\ + m{1} = memread Glob.mem{2} (to_uint in_0{2}) (to_uint inlen{2}) /\ + good_ptr in_0{2} (to_uint inlen{2}) /\ + out{2} = out_ /\ outlen{1}=to_uint outlen{2} ). + wp; ecall {2} (permutation_instantiation Glob.mem{2} state{2}); simplify. + wp; ecall {2} (add_full_block_spec state{2} in_0{2}); simplify. + wp; skip; progress. + + by rewrite r8_to_r64. + + congr; congr. + rewrite /take_block64 /=; congr; congr. + rewrite take_memread; first smt(rate8_bnds). + rewrite take_memread; first smt(rate8_bnds). + congr; move: H3; rewrite uleE H0 => ?. + by rewrite min_lel 1:/#. + + rewrite /take_block64 /= to_uintD_small ?H. + by move: H3; rewrite uleE /#. + move: H3; rewrite uleE H0 => ?; rewrite to_uintB ?uleE ?H //. + by rewrite drop_memread; smt(rate8_bnds). + + move: H3; rewrite uleE H0 => ?. + by rewrite to_uintB ?uleE ?H // to_uintD_small ?H /#. + + move: H3; rewrite !uleE => ?. + move: H5; rewrite /take_block64 /= size_drop; first smt(rate8_bnds). + rewrite size_memread; first smt(rate8_bnds). + by rewrite max_ler 1:/# to_uintB ?uleE /#. + + move: H3; rewrite uleE => ?. + rewrite /take_block64 /= size_drop; first smt(rate8_bnds). + rewrite size_memread; first smt(rate8_bnds). + move: H5; rewrite uleE !H to_uintB ?uleE 1:/#. + smt(). +wp; call {2} st0_spec; wp; skip; rewrite /inv_ptr; auto => |> *; progress. ++ move: H4; rewrite size_memread' uleE /max. + by case: (0 < to_uint inlen{2}); smt(rate8_bnds). ++ move: H4; rewrite uleE H3 => ?. + by rewrite size_memread; smt(rate8_bnds). ++ congr; congr. + by apply W8.word_modeqP; rewrite to_uint_truncateu8 modz_mod H2. ++ by rewrite ultE H6. ++ by move: H8; rewrite ultE H6. ++ by rewrite H11 -stores_cat. qed. end section. diff --git a/proof/impl/keccak_1600_ref.ec b/proof/impl/keccak_1600_ref.ec index 25c79fd..c48617d 100644 --- a/proof/impl/keccak_1600_ref.ec +++ b/proof/impl/keccak_1600_ref.ec @@ -382,31 +382,32 @@ module M = { } proc __keccak_1600 (out:W64.t, outlen:W64.t, in_0:W64.t, inlen:W64.t, - trail_byte:W64.t, r64:W64.t) : unit = { + trail_byte:W64.t, r8:W64.t) : unit = { var state:W64.t Array25.t; var rate:W64.t; var trailbyte:W8.t; state <- witness; state <@ st0 (); - rate <- r64; + rate <- r8; while ((rate \ule inlen)) { + rate <- (rate `>>` (W8.of_int 3)); state <@ add_full_block (state, in_0, rate); state <@ __keccak_f1600_ref (state); + rate <- r8; inlen <- (inlen - rate); in_0 <- (in_0 + rate); - rate <- r64; } trailbyte <- (truncateu8 trail_byte); - rate <- (rate `>>` (W8.of_int 3)); state <@ add_final_block (state, in_0, inlen, trailbyte, rate); while ((rate \ult outlen)) { state <@ __keccak_f1600_ref (state); - rate <- r64; - xtr_full_block (state, out, rate); + rate <- r8; rate <- (rate `>>` (W8.of_int 3)); + xtr_full_block (state, out, rate); + rate <- (rate `<<` (W8.of_int 3)); outlen <- (outlen - rate); out <- (out + rate); } From cf70d952b7f8abe67456dd6d3760e120f7a8cfab Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jos=C3=A9=20Bacelar=20Almeida?= Date: Sun, 12 May 2019 03:39:58 +0100 Subject: [PATCH 392/525] remove renamed file --- proof/impl/keccak_1600.ec | 383 -------------------------------------- 1 file changed, 383 deletions(-) delete mode 100644 proof/impl/keccak_1600.ec diff --git a/proof/impl/keccak_1600.ec b/proof/impl/keccak_1600.ec deleted file mode 100644 index 10ed747..0000000 --- a/proof/impl/keccak_1600.ec +++ /dev/null @@ -1,383 +0,0 @@ -require import List Int IntExtra IntDiv CoreMap. -from Jasmin require import JModel. - -require import Array5 Array24 Array25. -require import WArray40 WArray192 WArray200. - - - -module M = { - proc index (x:int, y:int) : int = { - - var r:int; - - r <- ((x %% 5) + (5 * (y %% 5))); - return (r); - } - - proc theta (a:W64.t Array25.t) : W64.t Array25.t = { - var aux_1: bool; - var aux_0: bool; - var aux: int; - var aux_2: W64.t; - - var x:int; - var c:W64.t Array5.t; - var y:int; - var d:W64.t Array5.t; - var _0:bool; - var _1:bool; - c <- witness; - d <- witness; - x <- 0; - while (x < 5) { - c.[x] <- (W64.of_int 0); - y <- 0; - while (y < 5) { - c.[x] <- (c.[x] `^` a.[(x + (5 * y))]); - y <- y + 1; - } - x <- x + 1; - } - x <- 0; - while (x < 5) { - (aux_1, aux_0, aux_2) <- x86_ROL_64 c.[((x + 1) %% 5)] (W8.of_int 1); - _0 <- aux_1; - _1 <- aux_0; - d.[x] <- aux_2; - d.[x] <- (d.[x] `^` c.[((x + 4) %% 5)]); - x <- x + 1; - } - x <- 0; - while (x < 5) { - y <- 0; - while (y < 5) { - a.[(x + (5 * y))] <- (a.[(x + (5 * y))] `^` d.[x]); - y <- y + 1; - } - x <- x + 1; - } - return (a); - } - - proc keccakRhoOffsets (i:int) : int = { - var aux: int; - - var r:int; - var x:int; - var y:int; - var t:int; - var z:int; - - r <- 0; - x <- 1; - y <- 0; - t <- 0; - while (t < 24) { - if ((i = (x + (5 * y)))) { - r <- ((((t + 1) * (t + 2)) %/ 2) %% 64); - } else { - - } - z <- (((2 * x) + (3 * y)) %% 5); - x <- y; - y <- z; - t <- t + 1; - } - return (r); - } - - proc rho (a:W64.t Array25.t) : W64.t Array25.t = { - var aux_1: bool; - var aux_0: bool; - var aux: int; - var aux_2: W64.t; - - var x:int; - var y:int; - var i:int; - var z:int; - var _0:bool; - var _1:bool; - - x <- 0; - while (x < 5) { - y <- 0; - while (y < 5) { - i <@ index (x, y); - z <@ keccakRhoOffsets (i); - (aux_1, aux_0, aux_2) <- x86_ROL_64 a.[i] (W8.of_int z); - _0 <- aux_1; - _1 <- aux_0; - a.[i] <- aux_2; - y <- y + 1; - } - x <- x + 1; - } - return (a); - } - - proc pi (a:W64.t Array25.t) : W64.t Array25.t = { - var aux: int; - - var i:int; - var t:W64.t; - var b:W64.t Array25.t; - var y:int; - var x:int; - b <- witness; - i <- 0; - while (i < 25) { - t <- a.[i]; - b.[i] <- t; - i <- i + 1; - } - x <- 0; - while (x < 5) { - y <- 0; - while (y < 5) { - t <- b.[(x + (5 * y))]; - i <@ index (y, ((2 * x) + (3 * y))); - a.[i] <- t; - y <- y + 1; - } - x <- x + 1; - } - return (a); - } - - proc chi (a:W64.t Array25.t) : W64.t Array25.t = { - var aux: int; - - var x:int; - var y:int; - var i:int; - var c:W64.t Array5.t; - c <- witness; - y <- 0; - while (y < 5) { - x <- 0; - while (x < 5) { - i <@ index ((x + 1), y); - c.[x] <- a.[i]; - c.[x] <- (invw c.[x]); - i <@ index ((x + 2), y); - c.[x] <- (c.[x] `&` a.[i]); - i <@ index (x, y); - c.[x] <- (c.[x] `^` a.[i]); - x <- x + 1; - } - x <- 0; - while (x < 5) { - a.[(x + (5 * y))] <- c.[x]; - x <- x + 1; - } - y <- y + 1; - } - return (a); - } - - proc iota_0 (a:W64.t Array25.t, c:W64.t) : W64.t Array25.t = { - - - - a.[0] <- (a.[0] `^` c); - return (a); - } - - proc keccakP1600_round (state:W64.t Array25.t, c:W64.t) : W64.t Array25.t = { - - - - state <@ theta (state); - state <@ rho (state); - state <@ pi (state); - state <@ chi (state); - state <@ iota_0 (state, c); - return (state); - } - - proc keccakRoundConstants () : W64.t Array24.t = { - - var constants:W64.t Array24.t; - constants <- witness; - constants.[0] <- (W64.of_int 1); - constants.[1] <- (W64.of_int 32898); - constants.[2] <- (W64.of_int 9223372036854808714); - constants.[3] <- (W64.of_int 9223372039002292224); - constants.[4] <- (W64.of_int 32907); - constants.[5] <- (W64.of_int 2147483649); - constants.[6] <- (W64.of_int 9223372039002292353); - constants.[7] <- (W64.of_int 9223372036854808585); - constants.[8] <- (W64.of_int 138); - constants.[9] <- (W64.of_int 136); - constants.[10] <- (W64.of_int 2147516425); - constants.[11] <- (W64.of_int 2147483658); - constants.[12] <- (W64.of_int 2147516555); - constants.[13] <- (W64.of_int 9223372036854775947); - constants.[14] <- (W64.of_int 9223372036854808713); - constants.[15] <- (W64.of_int 9223372036854808579); - constants.[16] <- (W64.of_int 9223372036854808578); - constants.[17] <- (W64.of_int 9223372036854775936); - constants.[18] <- (W64.of_int 32778); - constants.[19] <- (W64.of_int 9223372039002259466); - constants.[20] <- (W64.of_int 9223372039002292353); - constants.[21] <- (W64.of_int 9223372036854808704); - constants.[22] <- (W64.of_int 2147483649); - constants.[23] <- (W64.of_int 9223372039002292232); - return (constants); - } - - proc keccak_f1600 (state:W64.t Array25.t) : W64.t Array25.t = { - var aux: int; - - var constants:W64.t Array24.t; - var round:int; - constants <- witness; - constants <@ keccakRoundConstants (); - round <- 0; - while (round < 24) { - state <@ keccakP1600_round (state, constants.[round]); - round <- round + 1; - } - return (state); - } - - proc st0 () : W64.t Array25.t = { - var aux: int; - - var state:W64.t Array25.t; - var i:int; - state <- witness; - i <- 0; - while (i < 25) { - state.[i] <- (W64.of_int 0); - i <- i + 1; - } - return (state); - } - - proc add_full_block (state:W64.t Array25.t, in_0:W64.t, rate:W64.t) : - W64.t Array25.t = { - - var i:W64.t; - var t:W64.t; - - i <- (W64.of_int 0); - - while ((i \ult rate)) { - t <- (loadW64 Glob.mem (W64.to_uint (in_0 + ((W64.of_int 8) * i)))); - state.[(W64.to_uint i)] <- (state.[(W64.to_uint i)] `^` t); - i <- (i + (W64.of_int 1)); - } - return (state); - } - - proc add_final_block (state:W64.t Array25.t, in_0:W64.t, inlen:W64.t, - trail_byte:W8.t, rate:W64.t) : W64.t Array25.t = { - - var i:W64.t; - var t:W64.t; - var j:W64.t; - var c:W8.t; - - i <- (W64.of_int 0); - - while (((W64.of_int 8) \ule inlen)) { - t <- (loadW64 Glob.mem (W64.to_uint (in_0 + ((W64.of_int 8) * i)))); - state.[(W64.to_uint i)] <- (state.[(W64.to_uint i)] `^` t); - i <- (i + (W64.of_int 1)); - inlen <- (inlen - (W64.of_int 8)); - } - j <- ((W64.of_int 8) * i); - - while (((W64.of_int 0) \ult inlen)) { - c <- (loadW8 Glob.mem (W64.to_uint (in_0 + j))); - state = - Array25.init - (WArray200.get64 (WArray200.set8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint j) ( - (get8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint j)) `^` c))); - inlen <- (inlen - (W64.of_int 1)); - j <- (j + (W64.of_int 1)); - } - state = - Array25.init - (WArray200.get64 (WArray200.set8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint j) ( - (get8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint j)) `^` trail_byte))); - state = - Array25.init - (WArray200.get64 (WArray200.set8 (WArray200.init64 (fun i => state.[i])) ((W64.to_uint rate) - 1) ( - (get8 (WArray200.init64 (fun i => state.[i])) ((W64.to_uint rate) - 1)) `^` (W8.of_int 128)))); - return (state); - } - - proc xtr_full_block (state:W64.t Array25.t, out:W64.t, rate:W64.t) : unit = { - - var i:W64.t; - var t:W64.t; - - i <- (W64.of_int 0); - - while ((i \ult rate)) { - t <- state.[(W64.to_uint i)]; - Glob.mem <- - storeW64 Glob.mem (W64.to_uint (out + ((W64.of_int 8) * i))) t; - i <- (i + (W64.of_int 1)); - } - return (); - } - - proc xtr_bytes (state:W64.t Array25.t, out:W64.t, outlen:W64.t) : unit = { - - var i:W64.t; - var t:W64.t; - var j:W64.t; - var c:W8.t; - - i <- (W64.of_int 0); - - while (((W64.of_int 8) \ule outlen)) { - t <- state.[(W64.to_uint i)]; - Glob.mem <- - storeW64 Glob.mem (W64.to_uint (out + ((W64.of_int 8) * i))) t; - i <- (i + (W64.of_int 1)); - outlen <- (outlen - (W64.of_int 8)); - } - j <- ((W64.of_int 8) * i); - - while (((W64.of_int 0) \ult outlen)) { - c <- (get8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint j)); - Glob.mem <- storeW8 Glob.mem (W64.to_uint (out + j)) c; - outlen <- (outlen - (W64.of_int 1)); - j <- (j + (W64.of_int 1)); - } - return (); - } - - proc keccak_1600 (out:W64.t, outlen:W64.t, in_0:W64.t, inlen:W64.t, - trail_byte:W8.t, rate:W64.t) : unit = { - - var state:W64.t Array25.t; - state <- witness; - state <@ st0 (); - - while ((rate \ule inlen)) { - state <@ add_full_block (state, in_0, rate); - state <@ keccak_f1600 (state); - inlen <- (inlen - rate); - in_0 <- (in_0 + rate); - } - state <@ add_final_block (state, in_0, inlen, trail_byte, rate); - - while ((rate \ult outlen)) { - state <@ keccak_f1600 (state); - xtr_full_block (state, out, rate); - outlen <- (outlen - rate); - out <- (out + rate); - } - state <@ keccak_f1600 (state); - xtr_bytes (state, out, outlen); - return (); - } -}. - From cf38abffd00530d0f6469d6a307ca33018ae3478 Mon Sep 17 00:00:00 2001 From: Manuel Barbosa Date: Mon, 13 May 2019 10:02:46 +0100 Subject: [PATCH 393/525] pending --- proof/impl/perm/keccak_f1600_avx2.ec | 98 +------- ...2_openssl.ec => keccak_f1600_avx2_glue.ec} | 9 +- ..._prevec.ec => keccak_f1600_avx2_prevec.ec} | 225 ++++++++++++++++-- proof/impl/perm/keccak_f1600_ref.ec | 3 - 4 files changed, 208 insertions(+), 127 deletions(-) rename proof/impl/perm/{keccak_f1600_avx2_openssl.ec => keccak_f1600_avx2_glue.ec} (98%) rename proof/impl/perm/{keccak_f1600_avx2_openssl_prevec.ec => keccak_f1600_avx2_prevec.ec} (92%) diff --git a/proof/impl/perm/keccak_f1600_avx2.ec b/proof/impl/perm/keccak_f1600_avx2.ec index 2ae987b..84e0a08 100644 --- a/proof/impl/perm/keccak_f1600_avx2.ec +++ b/proof/impl/perm/keccak_f1600_avx2.ec @@ -4,11 +4,11 @@ from Jasmin require import JModel. require import Array7 Array9. require import WArray224 WArray288. -require import Keccak_f1600_avx2_openssl. -module Mavx2 = { - proc keccak_f (state:W256.t Array7.t, _rhotates_left:W64.t, - _rhotates_right:W64.t, _iotas:W64.t) : W256.t Array7.t = { + +module M = { + proc keccak_f1600 (state:W256.t Array7.t, _rhotates_left:W64.t, + _rhotates_right:W64.t, _iotas:W64.t) : W256.t Array7.t = { var rhotates_left:W64.t; var rhotates_right:W64.t; @@ -780,93 +780,3 @@ module Mavx2 = { } }. -op states_match (state : W256.t Array7.t) - (_A00 _A01 _A20 _A31 _A21 _A41 _A11:W256.t) = - state.[0] = _A00 /\ - state.[1] = _A01 /\ - state.[2] = _A20 /\ - state.[3] = _A31 /\ - state.[4] = _A21 /\ - state.[5] = _A41 /\ - state.[6] = _A11. - -lemma andn (w1 w2 : W256.t) : - invw w1 `&` w2 = - x86_VPANDN_256 w1 w2 by admit. - -lemma avx2_avx2openssl : - equiv [ Mavx2openssl.__KeccakF1600 ~ Mavx2.keccak_f : - states_match state{2} _A00{1} _A01{1} _A20{1} _A31{1} _A21{1} _A41{1} _A11{1} /\ - ={_rhotates_left, _rhotates_right, _iotas, Glob.mem} ==> - states_match res{2} res{1}.`1 res{1}.`2 res{1}.`3 res{1}.`4 res{1}.`5 res{1}.`6 res{1}.`7 ]. -proc. -seq 112 112 : (#pre /\ ={rhotates_left,rhotates_right,iotas} /\ i{1} = r{2} /\ _T{1} = t{2} /\ ={zf}) . - -seq 10 10 : (#pre /\ ={rhotates_left,rhotates_right,iotas} /\ i{1} = r{2} /\ _T{1} = t{2} /\ _C00{1} = c00{2} /\ _C14{1} = c14{2} ) . -by auto => />. -seq 10 10 : (#pre /\_D14{1} = d14{2} /\ _D00{1} = d00{2}) . -by auto => />. -seq 10 10 : #pre. -by auto => />. -seq 10 10 : #pre. -by auto => />. -seq 10 10 : #pre. -by auto => />. -seq 10 10 : #pre. -by auto => />. -seq 10 10 : #pre. -by auto => />. -seq 10 10 : #pre. -auto => />. -smt(andn). - -seq 10 10 : #pre. -auto => />. -smt(andn). - -seq 10 10 : #pre. -auto => />. -smt(andn). - - -seq 10 10 : #pre. -auto => />. -smt(andn). - -by auto => />. - -while(#pre). - -seq 10 10 : (#pre /\ _T{1} = t{2} /\ _C00{1} = c00{2} /\ _C14{1} = c14{2} ) . -by auto => />. -seq 10 10 : (#pre /\_D14{1} = d14{2} /\ _D00{1} = d00{2}) . -by auto => />. -seq 10 10 : #pre. -by auto => />. -seq 10 10 : #pre. -by auto => />. -seq 10 10 : #pre. -by auto => />. -seq 10 10 : #pre. -by auto => />. -seq 10 10 : #pre. -auto => />. -smt(andn). - -seq 10 10 : #pre. -auto => />. -smt(andn). - -seq 10 10 : #pre. -auto => />. -smt(andn). - -seq 10 10 : #pre. -by auto => />. - -auto => />. -smt(andn). - -by auto => />. - -qed. diff --git a/proof/impl/perm/keccak_f1600_avx2_openssl.ec b/proof/impl/perm/keccak_f1600_avx2_glue.ec similarity index 98% rename from proof/impl/perm/keccak_f1600_avx2_openssl.ec rename to proof/impl/perm/keccak_f1600_avx2_glue.ec index da3a963..4a03ed6 100644 --- a/proof/impl/perm/keccak_f1600_avx2_openssl.ec +++ b/proof/impl/perm/keccak_f1600_avx2_glue.ec @@ -4,13 +4,9 @@ from Jasmin require import JModel. require import Array9. require import WArray288. -op x86_VPBLENDD_256 : W256.t -> W256.t -> W8.t -> W256.t. -op x86_VPANDN_256 : W256.t -> W256.t -> W256.t. -op x86_VPSLLV_4u64 : W256.t -> W256.t -> W256.t. -op x86_VPSRLV_4u64 : W256.t -> W256.t -> W256.t. -op x86_DEC_32 : W32.t -> bool * bool * bool * bool * W32.t. -module Mavx2openssl = { + +module M = { proc __KeccakF1600 (_A00:W256.t, _A01:W256.t, _A20:W256.t, _A31:W256.t, _A21:W256.t, _A41:W256.t, _A11:W256.t, _rhotates_left:W64.t, _rhotates_right:W64.t, @@ -348,3 +344,4 @@ module Mavx2openssl = { return (_A00, _A01, _A20, _A31, _A21, _A41, _A11); } }. + diff --git a/proof/impl/perm/keccak_f1600_avx2_openssl_prevec.ec b/proof/impl/perm/keccak_f1600_avx2_prevec.ec similarity index 92% rename from proof/impl/perm/keccak_f1600_avx2_openssl_prevec.ec rename to proof/impl/perm/keccak_f1600_avx2_prevec.ec index 0b32a25..e2d8605 100644 --- a/proof/impl/perm/keccak_f1600_avx2_openssl_prevec.ec +++ b/proof/impl/perm/keccak_f1600_avx2_prevec.ec @@ -8,10 +8,8 @@ require import Keccak_f1600_ref_table. require import Keccak_f1600_ref. import Ops. -op x86_DEC_32 : W32.t -> (bool * bool * bool * bool * W32.t). - -op lift2array : W256.t -> W64.t Array4.t. - +op lift2array(x : W256.t) : W64.t Array4.t = + Array4.init (fun (n : int) => x \bits64 n). op good_rhotates_right : int Array24.t = ( witness @@ -432,25 +430,63 @@ op equiv_states_chi (A00 A01 A20 A31 A21 A41 A11 : W64.t Array4.t, st : W64.t Ar lemma dec : forall (x : W32.t), 0 < to_uint x <= 24 => - to_uint (x86_DEC_32 x).`5 = to_uint x - 1 by admit. + to_uint (x86_DEC_32 x).`5 = to_uint x - 1 by smt(@W32). lemma decK : forall (x : W32.t), - (x86_DEC_32 x).`5 + W32.one = x by admit. + (x86_DEC_32 x).`5 + W32.one = x by smt(@W32). lemma dec0 : forall (x : W32.t), 0 < to_uint x <= 24 => - (x86_DEC_32 x).`4 <=> to_uint (x86_DEC_32 x).`5 = 0 by - admit. - -lemma rolcomp : (forall (x : W64.t), (x86_ROL_64 x W8.one).`3 = - (x `>>` W8.of_int 63) `|` (x + x)) by admit. - -lemma commor : forall (x y : W64.t), x `|` y = y `|` x by admit. + (x86_DEC_32 x).`4 <=> to_uint (x86_DEC_32 x).`5 = 0 by smt(@W32). + +lemma rolcomp : (forall (x : W64.t), + (x86_ROL_64 x W8.one).`3 = + (x `>>` W8.of_int 63) `|` (x + x)). +move => x. +rewrite x86_ROL_64_E => />. +rewrite rol_xor_shft => />. +rewrite (_: x + x = x `<<` W8.one). rewrite /(`<<`) => />. + have HH : ( to_uint (x+x) = to_uint (x `<<<` 1)); first by rewrite to_uint_shl => />; rewrite to_uintD => />; smt(@W64). + by smt(@W64). +rewrite /(`<<`) /(`>>`) => />. +rewrite xorE orE !map2E => />. +apply W64.init_ext. +progress. smt. +qed. + +lemma commor : forall (x y : W64.t), x `|` y = y `|` x. +move => *. + rewrite orE !map2E. +apply W64.init_ext. +by smt(). +qed. -lemma rol0 : forall x, (x86_ROL_64 x W8.zero).`3 = x by admit. +lemma rol0 : forall x, (x86_ROL_64 x W8.zero).`3 = x. +move => *. +rewrite x86_ROL_64_E rol_xor =>/>. +smt. +qed. -lemma roln : forall x n, (x86_ROL_64 x (W8.of_int n)).`3 = - (x `>>` W8.of_int (64 - n)) `|` (x `<<` W8.of_int n) by admit. +lemma roln : forall x n, 0 <= n < 64 => + (x86_ROL_64 x (W8.of_int n)).`3 = + (x `>>>` (64 - n)) `|` (x `<<<` n). +move => x n H. +case (n = 0). +move => HH. rewrite HH rol0 => />. by smt(lsr_0). +move => HH. +rewrite x86_ROL_64_E => />. +rewrite rol_xor_shft => />. +split; first 2 by smt(). +rewrite /(`<<`) /(`>>`) => />. +rewrite (_: n %% 256 = n); first by smt(). +rewrite (_: n %% 256 = n); first by smt(). +rewrite (_: (64 - n) %% 256 = 64 - n); first by smt(). +rewrite (_: n %% 64 = n); first by smt(). +rewrite (_: (64 - n) %% 64 = 64 - n); first by smt(). +rewrite xorE orE !map2E => />. +apply W64.init_ext. +progress. smt. +qed. op good_iotas (mem : global_mem_t, _iotas : int) = forall off, 0 <= off < 24 => @@ -472,8 +508,151 @@ lemma loadlift_rhor : forall (mem : global_mem_t) (x : W64.t) (off : int), .[0 <- W64.of_int good_rhotates_right.[4*off + 0]] .[1 <- W64.of_int good_rhotates_right.[4*off + 1]] .[2 <- W64.of_int good_rhotates_right.[4*off + 2]] - .[3 <- W64.of_int good_rhotates_right.[4*off + 3]])%Array4 by admit. + .[3 <- W64.of_int good_rhotates_right.[4*off + 3]])%Array4. + +move => mem x off. +rewrite /good_rhor /loadW256 /lift2array /good_rhotates_right => />. +move => *. +apply Array4.ext_eq. +move => *. + +case (off = 0). +auto => />. +case (x0 = 0). +move => x00. +rewrite x00 => />. +move : (H 0); rewrite /loadW64 => /> *. +rewrite -H3. +rewrite !pack8E W8u8.Pack.of_listE. +apply W64.init_ext. +move => *. +beta. +apply W8.wordP. +apply W8u8.Pack.packP. +apply W8u8.Pack.init_ext. +move => />. +smt(). smt(). smt(). +move => *. +case (x0 = 1). +move => x00. +rewrite x00 => />. +move : (H 1); rewrite /loadW64 => /> *. +rewrite -H4. +rewrite !pack8E W8u8.Pack.of_listE. +apply W64.init_ext. +move => *. +beta. +apply W8.wordP. +apply W8u8.Pack.packP. +apply W8u8.Pack.init_ext. +move => />. +smt(). smt(). smt(). +move => *. +case (x0 = 2). +move => x00. +rewrite x00 => />. +move : (H 2); rewrite /loadW64 => /> *. +rewrite -H5. +rewrite !pack8E W8u8.Pack.of_listE. +apply W64.init_ext. +move => *. +beta. +apply W8.wordP. +apply W8u8.Pack.packP. +apply W8u8.Pack.init_ext. +move => />. +smt(). smt(). smt(). +move => *. +case (x0 = 3). +move => x00. +rewrite x00 => />. +move : (H 3); rewrite /loadW64 => /> *. +rewrite -H6. +rewrite !pack8E W8u8.Pack.of_listE. +apply W64.init_ext. +move => *. +beta. +apply W8.wordP. +apply W8u8.Pack.packP. +apply W8u8.Pack.init_ext. +move => />. +smt(). smt(). smt(). +smt(). + +move => *. + +case (off = 1). +auto => />. +case (x0 = 0). +move => x00. +rewrite x00. +auto => /> //=. +move : (H 4); rewrite /loadW64 => /> *. +rewrite -H4. +rewrite !pack8E W8u8.Pack.of_listE. +apply W64.init_ext. +move => *. +beta. +apply W8.wordP. +apply W8u8.Pack.packP. +apply W8u8.Pack.init_ext. +move => />. +move => *. +have HHH : (to_uint x + 32 < W64.modulus). admit. (* safety *) +smt(@W64). smt(). smt(). +move => *. +case (x0 = 1). +move => x00. +rewrite x00 => />. +move : (H 5); rewrite /loadW64 => /> *. +rewrite -H5. +rewrite !pack8E W8u8.Pack.of_listE. +apply W64.init_ext. +move => *. +beta. +apply W8.wordP. +apply W8u8.Pack.packP. +apply W8u8.Pack.init_ext. +move => />. +have HHH : (to_uint x + 32 < W64.modulus). admit. (* safety *) +smt(@W64). smt(). smt(). +move => *. +case (x0 = 2). +move => x00. +rewrite x00 => />. +move : (H 6); rewrite /loadW64 => /> *. +rewrite -H6. +rewrite !pack8E W8u8.Pack.of_listE. +apply W64.init_ext. +move => *. +beta. +apply W8.wordP. +apply W8u8.Pack.packP. +apply W8u8.Pack.init_ext. +move => />. +have HHH : (to_uint x + 32 < W64.modulus). admit. (* safety *) +smt(@W64). smt(). smt(). +move => *. +case (x0 = 3). +move => x00. +rewrite x00 => />. +move : (H 7); rewrite /loadW64 => /> *. +rewrite -H7. +rewrite !pack8E W8u8.Pack.of_listE. +apply W64.init_ext. +move => *. +beta. +apply W8.wordP. +apply W8u8.Pack.packP. +apply W8u8.Pack.init_ext. +move => />. +have HHH : (to_uint x + 32 < W64.modulus). admit. (* safety *) +smt(@W64). smt(). smt(). +smt(). +admit. (* need to keep going *) +qed. +(* these are the same as above *) lemma loadlift_rhol : forall (mem : global_mem_t) (x : W64.t) (off : int), good_rhol mem (to_uint x) => 0 <= off < 6 => lift2array @@ -526,18 +705,16 @@ lemma lift_roln mem rl rr o1 o2 x: 0 <= o1 < 6 => 0 <= o2 < 4 => good_rhol mem (W64.to_uint rl) => good_rhor mem (W64.to_uint rr) => - (x `>>` - (W8.of_int - (to_uint + (x `>>>` + (to_uint (lift2array (loadW256 mem - (to_uint (rr + W64.of_int 96 + W64.of_int (8 * 4 * o1 - 96))))).[o2])))%W64 `|` - (x `<<` - (W8.of_int + (to_uint (rr + W64.of_int 96 + W64.of_int (8 * 4 * o1 - 96))))).[o2]))%W64 `|` + (x `<<<` (to_uint (lift2array (loadW256 mem - (to_uint (rl + W64.of_int 96 + W64.of_int (8 * 4 * o1 - 96))))).[o2])))%W64 + (to_uint (rl + W64.of_int 96 + W64.of_int (8 * 4 * o1 - 96))))).[o2]))%W64 = (x86_ROL_64 x ((of_int (rhotates (conversion o1 o2))))%W8).`3. proof. move => *. diff --git a/proof/impl/perm/keccak_f1600_ref.ec b/proof/impl/perm/keccak_f1600_ref.ec index 1fba08c..fdfb1d3 100644 --- a/proof/impl/perm/keccak_f1600_ref.ec +++ b/proof/impl/perm/keccak_f1600_ref.ec @@ -6,9 +6,6 @@ require import WArray40 WArray192 WArray200. require import Ops. -op x86_ROL_64 : W64.t -> W8.t -> bool * bool * W64.t. - - op iotas : W64.t Array24.t = (( witness .[0 <- W64.one] From 9df1ab1b68e12cd773512459dd2d22a0a5d6a823 Mon Sep 17 00:00:00 2001 From: Manuel Barbosa Date: Mon, 13 May 2019 13:03:26 +0100 Subject: [PATCH 394/525] Cleaning all perms --- proof/impl/old_perm/Array2.ec | 3 + proof/impl/old_perm/Array24.ec | 3 + proof/impl/old_perm/Array25.ec | 3 + proof/impl/old_perm/Array4.ec | 3 + proof/impl/old_perm/Array5.ec | 3 + proof/impl/old_perm/Array7.ec | 3 + proof/impl/old_perm/Array9.ec | 3 + proof/impl/old_perm/Array96.ec | 3 + .../impl/{perm => old_perm}/LoopTransform.ec | 0 proof/impl/old_perm/Ops.ec | 648 +++++++ proof/impl/old_perm/WArray128.ec | 3 + proof/impl/old_perm/WArray160.ec | 3 + proof/impl/old_perm/WArray192.ec | 3 + proof/impl/old_perm/WArray200.ec | 3 + proof/impl/old_perm/WArray224.ec | 3 + proof/impl/old_perm/WArray288.ec | 3 + proof/impl/old_perm/WArray40.ec | 3 + proof/impl/old_perm/keccak_f1600_avx2.ec | 782 +++++++++ .../keccak_f1600_avx2_glue.ec | 0 .../impl/old_perm/keccak_f1600_avx2_prevec.ec | 1522 +++++++++++++++++ proof/impl/old_perm/keccak_f1600_ref.ec | 246 +++ .../keccak_f1600_ref_loop2.ec | 0 proof/impl/old_perm/keccak_f1600_ref_table.ec | 247 +++ .../{perm => old_perm}/keccak_f1600_scalar.ec | 0 .../keccak_f1600_scalar_table.ec | 0 proof/impl/perm/Array6.ec | 3 + proof/impl/perm/keccak_f1600_avx2.ec | 36 + proof/impl/perm/keccak_f1600_avx2_openssl.ec | 347 ++++ proof/impl/perm/keccak_f1600_avx2_prevec.ec | 621 +++---- .../perm/keccak_f1600_avx2_prevec_vops.ec | 479 ++++++ proof/impl/perm/keccak_f1600_ref.ec | 58 +- proof/impl/perm/keccak_f1600_ref_op.ec | 71 + proof/impl/perm/keccak_f1600_ref_table.ec | 17 +- 33 files changed, 4777 insertions(+), 345 deletions(-) create mode 100644 proof/impl/old_perm/Array2.ec create mode 100644 proof/impl/old_perm/Array24.ec create mode 100644 proof/impl/old_perm/Array25.ec create mode 100644 proof/impl/old_perm/Array4.ec create mode 100644 proof/impl/old_perm/Array5.ec create mode 100644 proof/impl/old_perm/Array7.ec create mode 100644 proof/impl/old_perm/Array9.ec create mode 100644 proof/impl/old_perm/Array96.ec rename proof/impl/{perm => old_perm}/LoopTransform.ec (100%) create mode 100644 proof/impl/old_perm/Ops.ec create mode 100644 proof/impl/old_perm/WArray128.ec create mode 100644 proof/impl/old_perm/WArray160.ec create mode 100644 proof/impl/old_perm/WArray192.ec create mode 100644 proof/impl/old_perm/WArray200.ec create mode 100644 proof/impl/old_perm/WArray224.ec create mode 100644 proof/impl/old_perm/WArray288.ec create mode 100644 proof/impl/old_perm/WArray40.ec create mode 100644 proof/impl/old_perm/keccak_f1600_avx2.ec rename proof/impl/{perm => old_perm}/keccak_f1600_avx2_glue.ec (100%) create mode 100644 proof/impl/old_perm/keccak_f1600_avx2_prevec.ec create mode 100644 proof/impl/old_perm/keccak_f1600_ref.ec rename proof/impl/{perm => old_perm}/keccak_f1600_ref_loop2.ec (100%) create mode 100644 proof/impl/old_perm/keccak_f1600_ref_table.ec rename proof/impl/{perm => old_perm}/keccak_f1600_scalar.ec (100%) rename proof/impl/{perm => old_perm}/keccak_f1600_scalar_table.ec (100%) create mode 100644 proof/impl/perm/Array6.ec create mode 100644 proof/impl/perm/keccak_f1600_avx2_openssl.ec create mode 100644 proof/impl/perm/keccak_f1600_avx2_prevec_vops.ec create mode 100644 proof/impl/perm/keccak_f1600_ref_op.ec diff --git a/proof/impl/old_perm/Array2.ec b/proof/impl/old_perm/Array2.ec new file mode 100644 index 0000000..3a89b1c --- /dev/null +++ b/proof/impl/old_perm/Array2.ec @@ -0,0 +1,3 @@ +from Jasmin require import JArray. + +clone export PolyArray as Array2 with op size <- 2. diff --git a/proof/impl/old_perm/Array24.ec b/proof/impl/old_perm/Array24.ec new file mode 100644 index 0000000..8982b77 --- /dev/null +++ b/proof/impl/old_perm/Array24.ec @@ -0,0 +1,3 @@ +from Jasmin require import JArray. + +clone export PolyArray as Array24 with op size <- 24. diff --git a/proof/impl/old_perm/Array25.ec b/proof/impl/old_perm/Array25.ec new file mode 100644 index 0000000..30bcb17 --- /dev/null +++ b/proof/impl/old_perm/Array25.ec @@ -0,0 +1,3 @@ +from Jasmin require import JArray. + +clone export PolyArray as Array25 with op size <- 25. diff --git a/proof/impl/old_perm/Array4.ec b/proof/impl/old_perm/Array4.ec new file mode 100644 index 0000000..bc0e12e --- /dev/null +++ b/proof/impl/old_perm/Array4.ec @@ -0,0 +1,3 @@ +from Jasmin require import JArray. + +clone export PolyArray as Array4 with op size <- 4. diff --git a/proof/impl/old_perm/Array5.ec b/proof/impl/old_perm/Array5.ec new file mode 100644 index 0000000..8dc7b36 --- /dev/null +++ b/proof/impl/old_perm/Array5.ec @@ -0,0 +1,3 @@ +from Jasmin require import JArray. + +clone export PolyArray as Array5 with op size <- 5. diff --git a/proof/impl/old_perm/Array7.ec b/proof/impl/old_perm/Array7.ec new file mode 100644 index 0000000..33f6cc6 --- /dev/null +++ b/proof/impl/old_perm/Array7.ec @@ -0,0 +1,3 @@ +from Jasmin require import JArray. + +clone export PolyArray as Array7 with op size <- 7. diff --git a/proof/impl/old_perm/Array9.ec b/proof/impl/old_perm/Array9.ec new file mode 100644 index 0000000..8759457 --- /dev/null +++ b/proof/impl/old_perm/Array9.ec @@ -0,0 +1,3 @@ +from Jasmin require import JArray. + +clone export PolyArray as Array9 with op size <- 9. diff --git a/proof/impl/old_perm/Array96.ec b/proof/impl/old_perm/Array96.ec new file mode 100644 index 0000000..619dabe --- /dev/null +++ b/proof/impl/old_perm/Array96.ec @@ -0,0 +1,3 @@ +from Jasmin require import JArray. + +clone export PolyArray as Array96 with op size <- 96. diff --git a/proof/impl/perm/LoopTransform.ec b/proof/impl/old_perm/LoopTransform.ec similarity index 100% rename from proof/impl/perm/LoopTransform.ec rename to proof/impl/old_perm/LoopTransform.ec diff --git a/proof/impl/old_perm/Ops.ec b/proof/impl/old_perm/Ops.ec new file mode 100644 index 0000000..7cd4a0e --- /dev/null +++ b/proof/impl/old_perm/Ops.ec @@ -0,0 +1,648 @@ +require import List Int IntDiv CoreMap. + +from Jasmin require import JModel. +require import Array2 Array4 Array5. +require import WArray128 WArray160. + +type t2u64 = W64.t Array2.t. +type t4u64 = W64.t Array4.t. + +module Ops = { + proc itruncate_4u64_2u64(t : t4u64) : t2u64 = { + return Array2.of_list witness [ t.[0]; t.[1] ]; + } + proc set_160(vv : t4u64 Array5.t, i : int, o : int, v : W64.t) : t4u64 Array5.t = { + return vv.[i <- vv.[i].[o <- v]]; + } + proc get_160(vv : t4u64 Array5.t, i : int, o : int) : W64.t = { + return vv.[i].[o]; + } + proc get_128(vv : t4u64 Array4.t, i : int, o : int) : W64.t = { + return vv.[i].[o]; + } + + proc iVPBROADCAST_4u64(v : W64.t) : t4u64 = { + var r : t4u64; + r.[0] <-v; + r.[1] <-v; + r.[2] <-v; + r.[3] <-v; + return r; + } + + proc iVPMULU_256 (x y:t4u64) : t4u64 = { + var r : t4u64; + r.[0] <- mulu64 x.[0] y.[0]; + r.[1] <- mulu64 x.[1] y.[1]; + r.[2] <- mulu64 x.[2] y.[2]; + r.[3] <- mulu64 x.[3] y.[3]; + return r; + } + + proc ivadd64u256(x y:t4u64) : t4u64 = { + var r : t4u64; + r.[0] <- x.[0] + y.[0]; + r.[1] <- x.[1] + y.[1]; + r.[2] <- x.[2] + y.[2]; + r.[3] <- x.[3] + y.[3]; + return r; + } + + proc iload4u64 (mem:global_mem_t, p:W64.t) : t4u64 = { + var r : t4u64; + r.[0] <- loadW64 mem (to_uint p); + r.[1] <- loadW64 mem (to_uint (p + W64.of_int 8)); + r.[2] <- loadW64 mem (to_uint (p + W64.of_int 16)); + r.[3] <- loadW64 mem (to_uint (p + W64.of_int 24)); + return r; + } + + proc iVPERM2I128(x y:t4u64, p : W8.t) : t4u64 = { + var r : t4u64; + r <- witness; + if (to_uint p = 32) { (* 0x20 *) + r.[0] <- x.[0]; + r.[1] <- x.[1]; + r.[2] <- y.[0]; + r.[3] <- y.[1]; + } + else { + if (to_uint p = 49) { (* 0x31 *) + r.[0] <- x.[2]; + r.[1] <- x.[3]; + r.[2] <- y.[2]; + r.[3] <- y.[3]; + } + } + return r; + } + + proc iVPERMQ(x :t4u64, p : W8.t) : t4u64 = { + var r : t4u64; + r <- witness; + if (to_uint p = 128) { (* 10 00 00 00 *) + r.[0] <- x.[0]; + r.[1] <- x.[0]; + r.[2] <- x.[0]; + r.[3] <- x.[2]; + } else { + if (to_uint p = 147) { (* 10 01 00 11 *) + r.[0] <- x.[3]; + r.[1] <- x.[0]; + r.[2] <- x.[1]; + r.[3] <- x.[2]; + } else { + if (to_uint p = 78) { (* 01 00 11 10 *) + r.[0] <- x.[2]; + r.[1] <- x.[3]; + r.[2] <- x.[0]; + r.[3] <- x.[1]; + } else { + if (to_uint p = 57) { (* 00 11 10 01 *) + r.[0] <- x.[1]; + r.[1] <- x.[2]; + r.[2] <- x.[3]; + r.[3] <- x.[0]; + } else { + if (to_uint p = 141) { (* 10 00 11 01 *) + r.[0] <- x.[1]; + r.[1] <- x.[3]; + r.[2] <- x.[0]; + r.[3] <- x.[2]; + } else { + if (to_uint p = 27) { (* 00 01 10 11 *) + r.[0] <- x.[3]; + r.[1] <- x.[2]; + r.[2] <- x.[1]; + r.[3] <- x.[0]; + } else { + if (to_uint p = 114) { (* 01 11 00 10 *) + r.[0] <- x.[2]; + r.[1] <- x.[0]; + r.[2] <- x.[3]; + r.[3] <- x.[1]; + } else { + if (to_uint p = 0) { (* 00 00 00 00 *) + r.[0] <- x.[0]; + r.[1] <- x.[0]; + r.[2] <- x.[0]; + r.[3] <- x.[0]; + } else { + if (to_uint p = 30) { (* 00 01 11 10 *) + r.[0] <- x.[2]; + r.[1] <- x.[3]; + r.[2] <- x.[1]; + r.[3] <- x.[0]; + } + } + } + } + } + } + } + } + } + return r; + } + + proc iVPSRLDQ_256(x:t4u64, p : W8.t) : t4u64 = { + var r : t4u64; + r <- witness; + if (to_uint p = 6) { + r.[0] <- (x.[0] `>>` W8.of_int 48) `|` (x.[1] `<<` W8.of_int 16); + r.[1] <- x.[1] `>>` W8.of_int 48; + r.[2] <- (x.[2] `>>` W8.of_int 48) `|` (x.[3] `<<` W8.of_int 16); + r.[3] <- x.[3] `>>` W8.of_int 48; + } + else { + if (to_uint p = 8) { + r.[0] <- x.[1]; + r.[1] <- W64.zero; + r.[2] <- x.[3]; + r.[3] <- W64.zero; + } + } + return r; + } + + proc iVPUNPCKH_4u64(x y:t4u64) : t4u64 = { + var r : t4u64; + r.[0] <- x.[1]; + r.[1] <- y.[1]; + r.[2] <- x.[3]; + r.[3] <- y.[3]; + return r; + } + + proc iVPUNPCKL_4u64 (x y:t4u64) : t4u64 = { + var r : t4u64; + r.[0] <- x.[0]; + r.[1] <- y.[0]; + r.[2] <- x.[2]; + r.[3] <- y.[2]; + return r; + } + + proc iVEXTRACTI128(x:t4u64, p : W8.t) : t2u64 = { + var r : t2u64; + r <- witness; + if (to_uint p = 0) { + r.[0] <- x.[0]; + r.[1] <- x.[1]; + } + else { + if (to_uint p = 1) { + r.[0] <- x.[2]; + r.[1] <- x.[3]; + } + } + return r; + + } + + proc iVPEXTR_64(x:t2u64, p : W8.t) : W64.t = { + return x.[to_uint p]; + } + + proc ivshr64u256 (x: t4u64, y: W8.t) : t4u64 = { + var r : t4u64; + r.[0] <- x.[0] `>>` y; + r.[1] <- x.[1] `>>` y; + r.[2] <- x.[2] `>>` y; + r.[3] <- x.[3] `>>` y; + return r; + } + + proc ivshl64u256 (x: t4u64, y: W8.t) : t4u64 = { + var r : t4u64; + r.[0] <- x.[0] `<<` y; + r.[1] <- x.[1] `<<` y; + r.[2] <- x.[2] `<<` y; + r.[3] <- x.[3] `<<` y; + return r; + } + + + proc iVPSRLV_4u64 (x: t4u64, y: t4u64) : t4u64 = { + var r : t4u64; + r.[0] <- x.[0] `>>>` W64.to_uint y.[0]; + r.[1] <- x.[1] `>>>` W64.to_uint y.[1]; + r.[2] <- x.[2] `>>>` W64.to_uint y.[2]; + r.[3] <- x.[3] `>>>` W64.to_uint y.[3]; + return r; + } + + proc iVPSLLV_4u64 (x: t4u64, y: t4u64) : t4u64 = { + var r : t4u64; + r.[0] <- x.[0] `<<<` W64.to_uint y.[0]; + r.[1] <- x.[1] `<<<` W64.to_uint y.[1]; + r.[2] <- x.[2] `<<<` W64.to_uint y.[2]; + r.[3] <- x.[3] `<<<` W64.to_uint y.[3]; + return r; + } + + proc iland4u64 (x y:t4u64) : t4u64 = { + var r : t4u64; + r.[0] <- x.[0] `&` y.[0]; + r.[1] <- x.[1] `&` y.[1]; + r.[2] <- x.[2] `&` y.[2]; + r.[3] <- x.[3] `&` y.[3]; + return r; + } + + proc ilor4u64 (x y:t4u64) : t4u64 = { + var r : t4u64; + r.[0] <- x.[0] `|` y.[0]; + r.[1] <- x.[1] `|` y.[1]; + r.[2] <- x.[2] `|` y.[2]; + r.[3] <- x.[3] `|` y.[3]; + return r; + } + + proc ilandn4u64(x y:t4u64) : t4u64 = { + var r : t4u64; + r.[0] <- invw x.[0] `&` y.[0]; + r.[1] <- invw x.[1] `&` y.[1]; + r.[2] <- invw x.[2] `&` y.[2]; + r.[3] <- invw x.[3] `&` y.[3]; + return r; + } + + proc ilxor4u64(x y:t4u64) : t4u64 = { + var r : t4u64; + r.[0] <- x.[0] `^` y.[0]; + r.[1] <- x.[1] `^` y.[1]; + r.[2] <- x.[2] `^` y.[2]; + r.[3] <- x.[3] `^` y.[3]; + return r; + } + + proc iVPBLENDD_256(x y:t4u64, p : W8.t) : W64.t Array4.t = { + var r : t4u64; + r <- witness; + if (to_uint p = 192) { + r.[0] <- x.[0]; + r.[1] <- x.[1]; + r.[2] <- x.[2]; + r.[3] <- y.[3]; + } else { + if (to_uint p = 3) { + r.[0] <- y.[0]; + r.[1] <- x.[1]; + r.[2] <- x.[2]; + r.[3] <- x.[3]; + } else { + if (to_uint p = 12) { + r.[0] <- x.[0]; + r.[1] <- y.[1]; + r.[2] <- x.[2]; + r.[3] <- x.[3]; + } else { + if (to_uint p = 48) { + r.[0] <- x.[0]; + r.[1] <- x.[1]; + r.[2] <- y.[2]; + r.[3] <- x.[3]; + } + } + } + } + return r; + } + + + proc iVPSHUFD_256 (x :t4u64, p : W8.t) : t4u64 = { + var r : t4u64; + r <- witness; + if (to_uint p = 78) { (* 01 00 11 10 *) + r.[0] <- x.[1]; + r.[1] <- x.[0]; + r.[2] <- x.[3]; + r.[3] <- x.[2]; + } + return r; + } +}. + +type vt2u64 = W128.t. +type vt4u64 = W256.t. + + +module OpsV = { + proc itruncate_4u64_2u64(t : vt4u64) : vt2u64 = { + return truncateu128 t; + } + proc set_160(vv : vt4u64 Array5.t, i : int, o : int, v : W64.t) : vt4u64 Array5.t = { + return Array5.init + (WArray160.get256 (WArray160.set64 (WArray160.init256 (fun i2 => vv.[i2])) (o+4*i) v)); + } + proc get_160(vv : vt4u64 Array5.t, i : int, o : int) : W64.t = { + return (get64 (WArray160.init256 (fun i2 => vv.[i2])) (o+4*i)); + } + proc get_128(vv : vt4u64 Array4.t, i : int, o : int) : W64.t = { + return (get64 (WArray128.init256 (fun i2 => vv.[i2])) (o+4*i)); + } + + proc iVPBROADCAST_4u64(v : W64.t) : vt4u64 = { + return x86_VPBROADCAST_4u64 v; + } + + proc iVPMULU_256 (x y:vt4u64) : vt4u64 = { + return x86_VPMULU_256 x y; + } + + proc ivadd64u256(x y:vt4u64) : vt4u64 = { + return x86_VPADD_4u64 x y; + } + + proc iload4u64 (mem:global_mem_t, p:W64.t) : vt4u64 = { + return loadW256 mem (to_uint p); + } + + proc iVPERM2I128(x y:vt4u64, p : W8.t) : vt4u64 = { + return x86_VPERM2I128 x y p; + } + + proc iVPERMQ(x :vt4u64, p : W8.t) : vt4u64 = { + return x86_VPERMQ x p; + } + + proc iVPSRLDQ_256(x:vt4u64, p : W8.t) : vt4u64 = { + return x86_VPSRLDQ_256 x p; + } + + proc iVPUNPCKH_4u64(x y:vt4u64) : vt4u64 = { + return x86_VPUNPCKH_4u64 x y; + } + + proc iVPUNPCKL_4u64 (x y:vt4u64) : vt4u64 = { + return x86_VPUNPCKL_4u64 x y; + } + + proc iVEXTRACTI128(x:vt4u64, p : W8.t) : vt2u64 = { + return x86_VEXTRACTI128 x p; + } + + proc iVPEXTR_64(x:vt2u64, p : W8.t) : W64.t = { + return x86_VPEXTR_64 x p; + } + + + proc ivshr64u256 (x: vt4u64, y: W8.t) : vt4u64 = { + return x86_VPSRL_4u64 x y; + } + + proc ivshl64u256 (x: vt4u64, y: W8.t) : vt4u64 = { + return x86_VPSLL_4u64 x y; + } + + proc iVPSRLV_4u64 (x: vt4u64, y: vt4u64) : vt4u64 = { + return x86_VPSRLV_4u64 x y; + } + + proc iVPSLLV_4u64 (x: vt4u64, y: vt4u64) : vt4u64 = { + return x86_VPSLLV_4u64 x y; + } + + proc iland4u64 (x y: vt4u64) : vt4u64 = { + return x `&` y; + } + + proc ilor4u64 (x y: vt4u64) : vt4u64 = { + return x `|` y; + } + + proc ilandn4u64(x y: vt4u64) : vt4u64 = { + return x86_VPANDN_256 x y; + } + + proc ilxor4u64(x y: vt4u64) : vt4u64 = { + return x `^` y; + } + + proc iVPBLENDD_256(x y:vt4u64, p : W8.t) : vt4u64 = { + return x86_VPBLENDD_256 x y p; + } + + proc iVPSHUFD_256 (x :vt4u64, p : W8.t) : vt4u64 = { + return x86_VPSHUFD_256 x p; + } + +}. + +op is2u64 (x : t2u64) (xv: vt2u64) = xv = W2u64.pack2 [x.[0]; x.[1]]. +op is4u64 (x : t4u64) (xv: vt4u64) = xv = W4u64.pack4 [x.[0]; x.[1]; x.[2]; x.[3]]. + +equiv eq_itruncate_4u64_2u64 : Ops.itruncate_4u64_2u64 ~ OpsV.itruncate_4u64_2u64 : is4u64 t{1} t{2} ==> is2u64 res{1} res{2}. +proof. + proc; skip => &1 &2; rewrite /is2u64 /is4u64 => -> /=. + apply (Core.can_inj _ _ W128.to_uintK). + rewrite to_uint_truncateu128. + rewrite - (W128.to_uint_small (to_uint (pack4 [t{1}.[0]; t{1}.[1]; t{1}.[2]; t{1}.[3]]) %% W128.modulus)). + + by apply modz_cmp. + congr; apply W128.wordP => i hi. + rewrite W128.of_intwE hi W2u64.pack2wE 1:// /=. + rewrite /int_bit /= modz_mod. + have /= -> := modz_pow2_div 128 i; 1:smt(). + rewrite (modz_dvd_pow 1 (128 - i) _ 2) 1:/# /=. + have -> : (to_uint (pack4 [t{1}.[0]; t{1}.[1]; t{1}.[2]; t{1}.[3]]) %/ (IntExtra.(^) 2 i) %% 2 <> 0) = + (pack4 [t{1}.[0]; t{1}.[1]; t{1}.[2]; t{1}.[3]]).[i]. + + rewrite -{2}(W256.to_uintK (pack4 [t{1}.[0]; t{1}.[1]; t{1}.[2]; t{1}.[3]])) W256.of_intwE /int_bit (modz_small _ W256.modulus) 2:/#. + by have /= := W256.to_uint_cmp (pack4 [t{1}.[0]; t{1}.[1]; t{1}.[2]; t{1}.[3]]);rewrite /(`|_|). + rewrite W4u64.pack4wE 1:/#. + case: (i < 64) => hi'. + + by rewrite divz_small 1:/#. + have -> // : i %/ 64 = 1. + have -> : i = (i -64) + 1 * 64 by done. + rewrite divzMDr 1://; smt(divz_small). +qed. + +op is4u64_5 (x:t4u64 Array5.t) (xv:vt4u64 Array5.t) = + xv = Array5.init (fun i => W4u64.pack4 [x.[i].[0]; x.[i].[1]; x.[i].[2]; x.[i].[3]]). + +op is4u64_4 (x:t4u64 Array4.t) (xv:vt4u64 Array4.t) = + xv = Array4.init (fun i => W4u64.pack4 [x.[i].[0]; x.[i].[1]; x.[i].[2]; x.[i].[3]]). + +lemma get8_pack4u64 ws j: + W4u64.pack4_t ws \bits8 j = + if 0 <= j < 32 then ws.[j %/ 8] \bits8 (j %% 8) else W8.zero. +proof. + rewrite pack4E W8.wordP => i hi. + rewrite bits8E /= initE hi /= initE. + have -> /= : (0 <= j * 8 + i < 256) <=> (0 <= j < 32) by smt(). + case : (0 <= j < 32) => hj //=. + rewrite bits8E /= initE. + have -> : (j * 8 + i) %/ 64 = j %/ 8. + + rewrite {1}(divz_eq j 8) mulzDl mulzA /= -addzA divzMDl //. + by rewrite (divz_small _ 64) //; smt (modz_cmp). + rewrite hi /=;congr. + rewrite {1}(divz_eq j 8) mulzDl mulzA /= -addzA modzMDl modz_small //; smt (modz_cmp). +qed. + +lemma Array5_get_set_eq (t:'a Array5.t) i a: 0 <= i < 5 => t.[i <- a].[i] = a. +proof. by move=> hi;rewrite Array5.get_setE. qed. + +equiv eq_set_160 : Ops.set_160 ~ OpsV.set_160 : is4u64_5 vv{1} vv{2} /\ ={i,o,v} /\ 0 <= i{1} < 5 /\ 0 <= o{1} < 4 ==> is4u64_5 res{1} res{2}. +proof. + proc; skip; rewrite /is4u64_5 => /> &1 &2 h1 h2 h3 h4. + apply Array5.tP => k hk. + rewrite !Array5.initiE 1,2:// /=. + rewrite /init256 set64E get256E -(W32u8.unpack8K (W4u64.pack4 _)); congr. + apply W32u8.Pack.packP => j hj. + rewrite W32u8.Pack.initiE 1:// get_unpack8 1:// /= WArray160.initiE 1:/# /=. + rewrite WArray160.initiE 1:/# /=. + rewrite (mulzC 32) modzMDl divzMDl 1:// divz_small 1:// modz_small 1:// /= Array5.initiE 1:// /=. + rewrite !get8_pack4u64 hj /=. + have /= <- := W4u64.Pack.init_of_list (fun i => vv{1}.[k].[i]). + have /= <- := W4u64.Pack.init_of_list (fun j => vv{1}.[i{2} <- vv{1}.[i{2}].[o{2} <- v{2}]].[k].[j]). + have ? : 0 <= j %/ 8 < 4 by rewrite ltz_divLR // lez_divRL. + rewrite !W4u64.Pack.initiE 1,2:// /=. + rewrite Array5.get_setE 1://. + case: (k = i{2}) => [->> | /#]. + rewrite Array4.get_setE 1://;smt(edivzP). +qed. + +equiv eq_get_160 : Ops.get_160 ~ OpsV.get_160 : is4u64_5 vv{1} vv{2} /\ ={i,o} /\ 0 <= i{1} < 5 /\ 0 <= o{1} < 4 ==> ={res}. +proof. + proc;skip;rewrite /is4u64_5 => /> &1 &2 h1 h2 h3 h4. + rewrite /init256 get64E -(W8u8.unpack8K vv{1}.[i{2}].[o{2}]);congr. + apply W8u8.Pack.packP => j hj. + rewrite W8u8.Pack.initiE 1:// initiE 1:// /= initiE 1:/# /=. + have -> : (8 * (o{2} + 4 * i{2}) + j) = (o{2} * 8 + j) + i{2} * 32 by ring. + have ? : 0 <= o{2} * 8 + j < `|32| by smt(). + rewrite modzMDr divzMDr 1:// divz_small 1:// modz_small 1:// /=. + rewrite Array5.initiE 1:// /= get8_pack4u64. + have /= <- := W4u64.Pack.init_of_list (fun j => vv{1}.[i{2}].[j]). + rewrite divzMDl 1:// divz_small 1:// modzMDl /= initiE 1:// modz_small 1:// /#. +qed. + +equiv eq_get_128 : Ops.get_128 ~ OpsV.get_128 : is4u64_4 vv{1} vv{2} /\ ={i,o} /\ 0 <= i{1} < 4 /\ 0 <= o{1} < 4 ==> ={res}. +proof. + proc;skip;rewrite /is4u64_4 => /> &1 &2 h1 h2 h3 h4. + rewrite /init256 get64E -(W8u8.unpack8K vv{1}.[i{2}].[o{2}]);congr. + apply W8u8.Pack.packP => j hj. + rewrite W8u8.Pack.initiE 1:// initiE 1:// /= initiE 1:/# /=. + have -> : (8 * (o{2} + 4 * i{2}) + j) = (o{2} * 8 + j) + i{2} * 32 by ring. + have ? : 0 <= o{2} * 8 + j < `|32| by smt(). + rewrite modzMDr divzMDr 1:// divz_small 1:// modz_small 1:// /=. + rewrite Array4.initiE 1:// /= get8_pack4u64. + have /= <- := W4u64.Pack.init_of_list (fun j => vv{1}.[i{2}].[j]). + rewrite divzMDl 1:// divz_small 1:// modzMDl /= initiE 1:// modz_small 1:// /#. +qed. + +equiv eq_iVPBROADCAST_4u64 : Ops.iVPBROADCAST_4u64 ~ OpsV.iVPBROADCAST_4u64 : ={v} ==> is4u64 res{1} res{2}. +proof. by proc => /=;wp;skip;rewrite /is4u64. qed. + +equiv eq_iVPMULU_256 : Ops.iVPMULU_256 ~ OpsV.iVPMULU_256 : is4u64 x{1} x{2} /\ is4u64 y{1} y{2} ==> is4u64 res{1} res{2}. +proof. by proc;wp;skip;rewrite /is4u64 => /> &1; rewrite /x86_VPMULU_256. qed. + +equiv eq_ivadd64u256: Ops.ivadd64u256 ~ OpsV.ivadd64u256 : is4u64 x{1} x{2} /\ is4u64 y{1} y{2} ==> is4u64 res{1} res{2}. +proof. by proc;wp;skip;rewrite /is4u64 /x86_VPADD_4u64. qed. + +equiv eq_iload4u64: Ops.iload4u64 ~ OpsV.iload4u64 : ={mem, p} /\ to_uint p{1} + 32 <= W64.modulus ==> is4u64 res{1} res{2}. +proof. + proc; wp; skip; rewrite /is4u64 => /> &2 hp. + rewrite /loadW256 -(W32u8.unpack8K (W4u64.pack4 _));congr. + apply W32u8.Pack.packP => j hj. + rewrite initiE 1:// W32u8.get_unpack8 1:// /= get8_pack4u64 hj /=. + have /= <- := W4u64.Pack.init_of_list (fun j => loadW64 mem{2} (to_uint (p{2} + W64.of_int (8 * j)))). + have ? : 0 <= j %/ 8 < 4 by rewrite ltz_divLR // lez_divRL. + have ? := modz_cmp j 8. + rewrite initiE 1:// /loadW64 /= pack8bE 1:// initiE 1:// /=. + have heq : to_uint (W64.of_int (8 * (j %/ 8))) = 8 * (j %/ 8). + + by rewrite of_uintK modz_small 2:// /= /#. + rewrite to_uintD_small heq 1:/#; smt (edivzP). +qed. + +equiv eq_iVPERM2I128 : Ops.iVPERM2I128 ~ OpsV.iVPERM2I128 : + is4u64 x{1} x{2} /\ is4u64 y{1} y{2} /\ ={p} /\ (p{1} = W8.of_int 32 \/ p{1} = W8.of_int 49) ==> is4u64 res{1} res{2}. +proof. + by proc; wp; skip; rewrite /is4u64 => /> &1 &2 [] ->; cbv delta; rewrite !of_intwE; cbv delta. +qed. + +equiv eq_iVPERMQ : Ops.iVPERMQ ~ OpsV.iVPERMQ : is4u64 x{1} x{2} /\ ={p} /\ + (p{1} \in (map W8.of_int [128; 147; 78; 57; 141; 27; 114; 0; 30])) ==> is4u64 res{1} res{2}. +proof. proc; wp; skip; rewrite /is4u64 => /> &1 &2 [#|] />. qed. + +lemma lsr_2u64 (w1 w2:W64.t) (x:int) : 0 <= x <= 64 => + pack2 [w1; w2] `>>>` x = pack2 [(w1 `>>>` x) `|` (w2 `<<<` 64 - x); w2 `>>>` x]. +proof. + move=> hx;apply W128.wordP => i hi. + rewrite pack2wE 1://. + rewrite W128.shrwE hi /=. + case: (i < 64) => hi1. + + have [-> ->] /=: i %/ 64 = 0 /\ i %% 64 = i by smt(edivzP). + rewrite pack2wE 1:/#. + have -> : 0 <= i < 64 by smt(). + case: (i + x < 64) => hix. + + have [-> ->] /= : (i + x) %/ 64 = 0 /\ (i + x) %% 64 = i + x by smt(edivzP). + by rewrite (W64.get_out w2) 1:/#. + have [-> ->] /= : (i + x) %/ 64 = 1 /\ (i + x) %% 64 = i - (64 - x) by smt(edivzP). + by rewrite (W64.get_out w1) 1:/#. + have [-> ->] /= : i %/ 64 = 1 /\ i %% 64 = i - 64 by smt(edivzP). + case (i + x < 128) => hix;last by rewrite W128.get_out 1:/# W64.get_out 1:/#. + rewrite pack2wE 1:/#. + have -> /= : 0 <= i - 64 < 64 by smt(). + by have [-> ->] : (i + x) %/ 64 = 1 /\ (i + x) %% 64 = i - 64 + x by smt(edivzP). +qed. + +lemma lsr_0 (w:W64.t) : w `<<<` 0 = w. +proof. by apply W64.wordP => i hi; rewrite W64.shlwE hi. qed. + +equiv eq_iVPSRLDQ_256: Ops.iVPSRLDQ_256 ~ OpsV.iVPSRLDQ_256 : is4u64 x{1} x{2} /\ ={p} /\ (p{1} = W8.of_int 6 \/ p{1} = W8.of_int 8) ==> is4u64 res{1} res{2}. +proof. + proc; wp; skip; rewrite /is4u64 => /> &1 &2 h; cbv delta. + by case h => -> /=; rewrite !lsr_2u64 //= !lsr_0. +qed. + +equiv eq_iVPUNPCKH_4u64: Ops.iVPUNPCKH_4u64 ~ OpsV.iVPUNPCKH_4u64 : is4u64 x{1} x{2} /\ is4u64 y{1} y{2} ==> is4u64 res{1} res{2}. +proof. by proc; wp; skip; rewrite /is4u64 => />; cbv delta. qed. + +equiv eq_iVPUNPCKL_4u64: Ops.iVPUNPCKL_4u64 ~ OpsV.iVPUNPCKL_4u64 : is4u64 x{1} x{2} /\ is4u64 y{1} y{2} ==> is4u64 res{1} res{2}. +proof. by proc; wp; skip; rewrite /is4u64 => />; cbv delta. qed. + +equiv eq_iVEXTRACTI128: Ops.iVEXTRACTI128 ~ OpsV.iVEXTRACTI128 : is4u64 x{1} x{2} /\ ={p} /\ (p{1} = W8.of_int 0 \/ p{2} = W8.of_int 1) ==> is2u64 res{1} res{2}. +proof. + proc; wp; skip;rewrite /is4u64 /is2u64 /x86_VEXTRACTI128 => /> &1 &2 [] ->; cbv delta => //. + by rewrite W8.of_intwE. +qed. + +equiv eq_iVPEXTR_64: Ops.iVPEXTR_64 ~ OpsV.iVPEXTR_64 : is2u64 x{1} x{2} /\ ={p} /\ (p{1} = W8.of_int 0 \/ p{2} = W8.of_int 1)==> res{1} = res{2}. +proof. by proc; skip; rewrite /is2u64 /x86_VPEXTR_64 => /> &1 &2 [] -> /=. qed. + +equiv eq_ivshr64u256: Ops.ivshr64u256 ~ OpsV.ivshr64u256 : is4u64 x{1} x{2} /\ ={y} ==> is4u64 res{1} res{2}. +proof. by proc; wp; skip; rewrite /is4u64 /x86_VPSRL_4u64. qed. + +equiv eq_ivshl64u256: Ops.ivshl64u256 ~ OpsV.ivshl64u256 : is4u64 x{1} x{2} /\ ={y} ==> is4u64 res{1} res{2}. +proof. by proc; wp; skip; rewrite /is4u64 /x86_VPSLL_4u64. qed. + +equiv eq_iland4u64: Ops.iland4u64 ~ OpsV.iland4u64 : is4u64 x{1} x{2} /\ is4u64 y{1} y{2} ==> is4u64 res{1} res{2}. +proof. by proc; wp; skip; rewrite /is4u64. qed. + +equiv eq_ilor4u64: Ops.ilor4u64 ~ OpsV.ilor4u64 : is4u64 x{1} x{2} /\ is4u64 y{1} y{2} ==> is4u64 res{1} res{2}. +proof. by proc; wp; skip; rewrite /is4u64. qed. + +equiv eq_ilandn4u64 : Ops.ilandn4u64 ~ OpsV.ilandn4u64 : is4u64 x{1} x{2} /\ is4u64 y{1} y{2} ==> is4u64 res{1} res{2}. +proof. by proc; wp; skip; rewrite /is4u64 => />; cbv delta. qed. + +equiv eq_ilxor4u64: Ops.ilxor4u64 ~ OpsV.ilxor4u64 : is4u64 x{1} x{2} /\ is4u64 y{1} y{2} ==> is4u64 res{1} res{2}. +proof. by proc; wp; skip; rewrite /is4u64. qed. + +equiv eq_iVPSRLV_4u64 : Ops.iVPSRLV_4u64 ~ OpsV.iVPSRLV_4u64 : is4u64 x{1} x{2} /\ is4u64 y{1} y{2} ==> is4u64 res{1} res{2}. +proof. by proc;wp; skip; rewrite /is4u64 => />; cbv delta. qed. + +equiv eq_iVPSLLV_4u64 : Ops.iVPSLLV_4u64 ~ OpsV.iVPSLLV_4u64 : is4u64 x{1} x{2} /\ is4u64 y{1} y{2} ==> is4u64 res{1} res{2}. +proof. by proc;wp; skip; rewrite /is4u64 => />; cbv delta. qed. + +equiv eq_iVPBLENDD_256 : Ops.iVPBLENDD_256 ~ OpsV.iVPBLENDD_256 : + is4u64 x{1} x{2} /\ is4u64 y{1} y{2} /\ ={p} /\ p{1} \in map W8.of_int [192; 3; 12; 48] + ==> + is4u64 res{1} res{2}. +proof. + proc; wp; skip; rewrite /is4u64 => /> &1 &2. + by move=> [#|] />; cbv delta; rewrite !W8.of_intwE /=; apply W8u32.allP;cbv delta. +qed. + +equiv eq_iVPSHUFD_256 : Ops.iVPSHUFD_256 ~ OpsV.iVPSHUFD_256 : + is4u64 x{1} x{2} /\ ={p} /\ p{1} = W8.of_int 78 ==> is4u64 res{1} res{2}. +proof. by proc; wp; skip; rewrite /is4u64 => /> &1; apply W8u32.allP;cbv delta. qed. diff --git a/proof/impl/old_perm/WArray128.ec b/proof/impl/old_perm/WArray128.ec new file mode 100644 index 0000000..3c9d689 --- /dev/null +++ b/proof/impl/old_perm/WArray128.ec @@ -0,0 +1,3 @@ +from Jasmin require import JWord_array. + +clone export WArray as WArray128 with op size <- 128. diff --git a/proof/impl/old_perm/WArray160.ec b/proof/impl/old_perm/WArray160.ec new file mode 100644 index 0000000..05cce71 --- /dev/null +++ b/proof/impl/old_perm/WArray160.ec @@ -0,0 +1,3 @@ +from Jasmin require import JWord_array. + +clone export WArray as WArray160 with op size <- 160. diff --git a/proof/impl/old_perm/WArray192.ec b/proof/impl/old_perm/WArray192.ec new file mode 100644 index 0000000..c8564c5 --- /dev/null +++ b/proof/impl/old_perm/WArray192.ec @@ -0,0 +1,3 @@ +from Jasmin require import JWord_array. + +clone export WArray as WArray192 with op size <- 192. diff --git a/proof/impl/old_perm/WArray200.ec b/proof/impl/old_perm/WArray200.ec new file mode 100644 index 0000000..99b887c --- /dev/null +++ b/proof/impl/old_perm/WArray200.ec @@ -0,0 +1,3 @@ +from Jasmin require import JWord_array. + +clone export WArray as WArray200 with op size <- 200. diff --git a/proof/impl/old_perm/WArray224.ec b/proof/impl/old_perm/WArray224.ec new file mode 100644 index 0000000..f9d6745 --- /dev/null +++ b/proof/impl/old_perm/WArray224.ec @@ -0,0 +1,3 @@ +from Jasmin require import JWord_array. + +clone export WArray as WArray224 with op size <- 224. diff --git a/proof/impl/old_perm/WArray288.ec b/proof/impl/old_perm/WArray288.ec new file mode 100644 index 0000000..86ac7cc --- /dev/null +++ b/proof/impl/old_perm/WArray288.ec @@ -0,0 +1,3 @@ +from Jasmin require import JWord_array. + +clone export WArray as WArray288 with op size <- 288. diff --git a/proof/impl/old_perm/WArray40.ec b/proof/impl/old_perm/WArray40.ec new file mode 100644 index 0000000..003b6e2 --- /dev/null +++ b/proof/impl/old_perm/WArray40.ec @@ -0,0 +1,3 @@ +from Jasmin require import JWord_array. + +clone export WArray as WArray40 with op size <- 40. diff --git a/proof/impl/old_perm/keccak_f1600_avx2.ec b/proof/impl/old_perm/keccak_f1600_avx2.ec new file mode 100644 index 0000000..84e0a08 --- /dev/null +++ b/proof/impl/old_perm/keccak_f1600_avx2.ec @@ -0,0 +1,782 @@ +require import List Int IntExtra IntDiv CoreMap. +from Jasmin require import JModel. + +require import Array7 Array9. +require import WArray224 WArray288. + + + +module M = { + proc keccak_f1600 (state:W256.t Array7.t, _rhotates_left:W64.t, + _rhotates_right:W64.t, _iotas:W64.t) : W256.t Array7.t = { + + var rhotates_left:W64.t; + var rhotates_right:W64.t; + var iotas:W64.t; + var r:W32.t; + var zf:bool; + var c00:W256.t; + var c14:W256.t; + var t:W256.t Array9.t; + var d14:W256.t; + var d00:W256.t; + var _0:bool; + var _1:bool; + var _2:bool; + t <- witness; + rhotates_left <- (_rhotates_left + (W64.of_int 96)); + rhotates_right <- (_rhotates_right + (W64.of_int 96)); + iotas <- _iotas; + r <- (W32.of_int 24); + c00 <- x86_VPSHUFD_256 state.[2] + (W8.of_int (2 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 1)))); + c14 <- (state.[5] `^` state.[3]); + t.[2] <- (state.[4] `^` state.[6]); + c14 <- (c14 `^` state.[1]); + c14 <- (c14 `^` t.[2]); + t.[4] <- x86_VPERMQ c14 + (W8.of_int (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (1 %% 2^2 + 2^2 * 2)))); + c00 <- (c00 `^` state.[2]); + t.[0] <- x86_VPERMQ c00 + (W8.of_int (2 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 1)))); + t.[1] <- (c14 \vshr64u256 (W8.of_int 63)); + t.[2] <- (c14 \vadd64u256 c14); + t.[1] <- (t.[1] `|` t.[2]); + d14 <- x86_VPERMQ t.[1] + (W8.of_int (1 %% 2^2 + 2^2 * (2 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + d00 <- (t.[1] `^` t.[4]); + d00 <- x86_VPERMQ d00 + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + c00 <- (c00 `^` state.[0]); + c00 <- (c00 `^` t.[0]); + t.[0] <- (c00 \vshr64u256 (W8.of_int 63)); + t.[1] <- (c00 \vadd64u256 c00); + t.[1] <- (t.[1] `|` t.[0]); + state.[2] <- (state.[2] `^` d00); + state.[0] <- (state.[0] `^` d00); + d14 <- x86_VPBLENDD_256 d14 t.[1] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + t.[4] <- x86_VPBLENDD_256 t.[4] c00 + (W8.of_int (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + d14 <- (d14 `^` t.[4]); + t.[3] <- x86_VPSLLV_4u64 state.[2] + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((0 * 32) - 96))))); + state.[2] <- x86_VPSRLV_4u64 state.[2] + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((0 * 32) - 96))))); + state.[2] <- (state.[2] `|` t.[3]); + state.[3] <- (state.[3] `^` d14); + t.[4] <- x86_VPSLLV_4u64 state.[3] + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((2 * 32) - 96))))); + state.[3] <- x86_VPSRLV_4u64 state.[3] + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((2 * 32) - 96))))); + state.[3] <- (state.[3] `|` t.[4]); + state.[4] <- (state.[4] `^` d14); + t.[5] <- x86_VPSLLV_4u64 state.[4] + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((3 * 32) - 96))))); + state.[4] <- x86_VPSRLV_4u64 state.[4] + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((3 * 32) - 96))))); + state.[4] <- (state.[4] `|` t.[5]); + state.[5] <- (state.[5] `^` d14); + t.[6] <- x86_VPSLLV_4u64 state.[5] + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((4 * 32) - 96))))); + state.[5] <- x86_VPSRLV_4u64 state.[5] + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((4 * 32) - 96))))); + state.[5] <- (state.[5] `|` t.[6]); + state.[6] <- (state.[6] `^` d14); + t.[3] <- x86_VPERMQ state.[2] + (W8.of_int (1 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 2)))); + t.[4] <- x86_VPERMQ state.[3] + (W8.of_int (1 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 2)))); + t.[7] <- x86_VPSLLV_4u64 state.[6] + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((5 * 32) - 96))))); + t.[1] <- x86_VPSRLV_4u64 state.[6] + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((5 * 32) - 96))))); + t.[1] <- (t.[1] `|` t.[7]); + state.[1] <- (state.[1] `^` d14); + t.[5] <- x86_VPERMQ state.[4] + (W8.of_int (3 %% 2^2 + 2^2 * (2 %% 2^2 + 2^2 * (1 %% 2^2 + 2^2 * 0)))); + t.[6] <- x86_VPERMQ state.[5] + (W8.of_int (2 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 1)))); + t.[8] <- x86_VPSLLV_4u64 state.[1] + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((1 * 32) - 96))))); + t.[2] <- x86_VPSRLV_4u64 state.[1] + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((1 * 32) - 96))))); + t.[2] <- (t.[2] `|` t.[8]); + t.[7] <- x86_VPSRLDQ_256 t.[1] (W8.of_int 8); + t.[0] <- ((invw t.[1]) `&` t.[7]); + state.[3] <- x86_VPBLENDD_256 t.[2] t.[6] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[8] <- x86_VPBLENDD_256 t.[4] t.[2] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[5] <- x86_VPBLENDD_256 t.[3] t.[4] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[7] <- x86_VPBLENDD_256 t.[2] t.[3] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[3] <- x86_VPBLENDD_256 state.[3] t.[4] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[8] <- x86_VPBLENDD_256 t.[8] t.[5] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[5] <- x86_VPBLENDD_256 state.[5] t.[2] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[7] <- x86_VPBLENDD_256 t.[7] t.[6] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[3] <- x86_VPBLENDD_256 state.[3] t.[5] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + t.[8] <- x86_VPBLENDD_256 t.[8] t.[6] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + state.[5] <- x86_VPBLENDD_256 state.[5] t.[6] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + t.[7] <- x86_VPBLENDD_256 t.[7] t.[4] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + state.[3] <- ((invw state.[3]) `&` t.[8]); + state.[5] <- ((invw state.[5]) `&` t.[7]); + state.[6] <- x86_VPBLENDD_256 t.[5] t.[2] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[8] <- x86_VPBLENDD_256 t.[3] t.[5] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[3] <- (state.[3] `^` t.[3]); + state.[6] <- x86_VPBLENDD_256 state.[6] t.[3] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[8] <- x86_VPBLENDD_256 t.[8] t.[4] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[5] <- (state.[5] `^` t.[5]); + state.[6] <- x86_VPBLENDD_256 state.[6] t.[4] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + t.[8] <- x86_VPBLENDD_256 t.[8] t.[2] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + state.[6] <- ((invw state.[6]) `&` t.[8]); + state.[6] <- (state.[6] `^` t.[6]); + state.[4] <- x86_VPERMQ t.[1] + (W8.of_int (2 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (1 %% 2^2 + 2^2 * 0)))); + t.[8] <- x86_VPBLENDD_256 state.[4] state.[0] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[1] <- x86_VPERMQ t.[1] + (W8.of_int (1 %% 2^2 + 2^2 * (2 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + state.[1] <- x86_VPBLENDD_256 state.[1] state.[0] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + state.[1] <- ((invw state.[1]) `&` t.[8]); + state.[2] <- x86_VPBLENDD_256 t.[4] t.[5] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[7] <- x86_VPBLENDD_256 t.[6] t.[4] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[2] <- x86_VPBLENDD_256 state.[2] t.[6] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[7] <- x86_VPBLENDD_256 t.[7] t.[3] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[2] <- x86_VPBLENDD_256 state.[2] t.[3] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + t.[7] <- x86_VPBLENDD_256 t.[7] t.[5] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + state.[2] <- ((invw state.[2]) `&` t.[7]); + state.[2] <- (state.[2] `^` t.[2]); + t.[0] <- x86_VPERMQ t.[0] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + state.[3] <- x86_VPERMQ state.[3] + (W8.of_int (3 %% 2^2 + 2^2 * (2 %% 2^2 + 2^2 * (1 %% 2^2 + 2^2 * 0)))); + state.[5] <- x86_VPERMQ state.[5] + (W8.of_int (1 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 2)))); + state.[6] <- x86_VPERMQ state.[6] + (W8.of_int (2 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 1)))); + state.[4] <- x86_VPBLENDD_256 t.[6] t.[3] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[7] <- x86_VPBLENDD_256 t.[5] t.[6] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[4] <- x86_VPBLENDD_256 state.[4] t.[5] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[7] <- x86_VPBLENDD_256 t.[7] t.[2] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[4] <- x86_VPBLENDD_256 state.[4] t.[2] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + t.[7] <- x86_VPBLENDD_256 t.[7] t.[3] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + state.[4] <- ((invw state.[4]) `&` t.[7]); + state.[0] <- (state.[0] `^` t.[0]); + state.[1] <- (state.[1] `^` t.[1]); + state.[4] <- (state.[4] `^` t.[4]); + state.[0] <- + (state.[0] `^` (loadW256 Glob.mem (W64.to_uint (iotas + (W64.of_int ((0 * 32) - 0)))))); + iotas <- (iotas + (W64.of_int 32)); + ( _0, _1, _2, zf, r) <- x86_DEC_32 r; + while ((! zf)) { + c00 <- x86_VPSHUFD_256 state.[2] + (W8.of_int (2 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 1)))); + c14 <- (state.[5] `^` state.[3]); + t.[2] <- (state.[4] `^` state.[6]); + c14 <- (c14 `^` state.[1]); + c14 <- (c14 `^` t.[2]); + t.[4] <- x86_VPERMQ c14 + (W8.of_int (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (1 %% 2^2 + 2^2 * 2)))); + c00 <- (c00 `^` state.[2]); + t.[0] <- x86_VPERMQ c00 + (W8.of_int (2 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 1)))); + t.[1] <- (c14 \vshr64u256 (W8.of_int 63)); + t.[2] <- (c14 \vadd64u256 c14); + t.[1] <- (t.[1] `|` t.[2]); + d14 <- x86_VPERMQ t.[1] + (W8.of_int (1 %% 2^2 + 2^2 * (2 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + d00 <- (t.[1] `^` t.[4]); + d00 <- x86_VPERMQ d00 + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + c00 <- (c00 `^` state.[0]); + c00 <- (c00 `^` t.[0]); + t.[0] <- (c00 \vshr64u256 (W8.of_int 63)); + t.[1] <- (c00 \vadd64u256 c00); + t.[1] <- (t.[1] `|` t.[0]); + state.[2] <- (state.[2] `^` d00); + state.[0] <- (state.[0] `^` d00); + d14 <- x86_VPBLENDD_256 d14 t.[1] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + t.[4] <- x86_VPBLENDD_256 t.[4] c00 + (W8.of_int (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + d14 <- (d14 `^` t.[4]); + t.[3] <- x86_VPSLLV_4u64 state.[2] + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((0 * 32) - 96))))); + state.[2] <- x86_VPSRLV_4u64 state.[2] + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((0 * 32) - 96))))); + state.[2] <- (state.[2] `|` t.[3]); + state.[3] <- (state.[3] `^` d14); + t.[4] <- x86_VPSLLV_4u64 state.[3] + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((2 * 32) - 96))))); + state.[3] <- x86_VPSRLV_4u64 state.[3] + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((2 * 32) - 96))))); + state.[3] <- (state.[3] `|` t.[4]); + state.[4] <- (state.[4] `^` d14); + t.[5] <- x86_VPSLLV_4u64 state.[4] + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((3 * 32) - 96))))); + state.[4] <- x86_VPSRLV_4u64 state.[4] + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((3 * 32) - 96))))); + state.[4] <- (state.[4] `|` t.[5]); + state.[5] <- (state.[5] `^` d14); + t.[6] <- x86_VPSLLV_4u64 state.[5] + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((4 * 32) - 96))))); + state.[5] <- x86_VPSRLV_4u64 state.[5] + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((4 * 32) - 96))))); + state.[5] <- (state.[5] `|` t.[6]); + state.[6] <- (state.[6] `^` d14); + t.[3] <- x86_VPERMQ state.[2] + (W8.of_int (1 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 2)))); + t.[4] <- x86_VPERMQ state.[3] + (W8.of_int (1 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 2)))); + t.[7] <- x86_VPSLLV_4u64 state.[6] + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((5 * 32) - 96))))); + t.[1] <- x86_VPSRLV_4u64 state.[6] + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((5 * 32) - 96))))); + t.[1] <- (t.[1] `|` t.[7]); + state.[1] <- (state.[1] `^` d14); + t.[5] <- x86_VPERMQ state.[4] + (W8.of_int (3 %% 2^2 + 2^2 * (2 %% 2^2 + 2^2 * (1 %% 2^2 + 2^2 * 0)))); + t.[6] <- x86_VPERMQ state.[5] + (W8.of_int (2 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 1)))); + t.[8] <- x86_VPSLLV_4u64 state.[1] + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((1 * 32) - 96))))); + t.[2] <- x86_VPSRLV_4u64 state.[1] + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((1 * 32) - 96))))); + t.[2] <- (t.[2] `|` t.[8]); + t.[7] <- x86_VPSRLDQ_256 t.[1] (W8.of_int 8); + t.[0] <- ((invw t.[1]) `&` t.[7]); + state.[3] <- x86_VPBLENDD_256 t.[2] t.[6] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[8] <- x86_VPBLENDD_256 t.[4] t.[2] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[5] <- x86_VPBLENDD_256 t.[3] t.[4] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[7] <- x86_VPBLENDD_256 t.[2] t.[3] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[3] <- x86_VPBLENDD_256 state.[3] t.[4] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[8] <- x86_VPBLENDD_256 t.[8] t.[5] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[5] <- x86_VPBLENDD_256 state.[5] t.[2] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[7] <- x86_VPBLENDD_256 t.[7] t.[6] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[3] <- x86_VPBLENDD_256 state.[3] t.[5] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + t.[8] <- x86_VPBLENDD_256 t.[8] t.[6] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + state.[5] <- x86_VPBLENDD_256 state.[5] t.[6] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + t.[7] <- x86_VPBLENDD_256 t.[7] t.[4] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + state.[3] <- ((invw state.[3]) `&` t.[8]); + state.[5] <- ((invw state.[5]) `&` t.[7]); + state.[6] <- x86_VPBLENDD_256 t.[5] t.[2] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[8] <- x86_VPBLENDD_256 t.[3] t.[5] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[3] <- (state.[3] `^` t.[3]); + state.[6] <- x86_VPBLENDD_256 state.[6] t.[3] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[8] <- x86_VPBLENDD_256 t.[8] t.[4] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[5] <- (state.[5] `^` t.[5]); + state.[6] <- x86_VPBLENDD_256 state.[6] t.[4] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + t.[8] <- x86_VPBLENDD_256 t.[8] t.[2] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + state.[6] <- ((invw state.[6]) `&` t.[8]); + state.[6] <- (state.[6] `^` t.[6]); + state.[4] <- x86_VPERMQ t.[1] + (W8.of_int (2 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (1 %% 2^2 + 2^2 * 0)))); + t.[8] <- x86_VPBLENDD_256 state.[4] state.[0] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[1] <- x86_VPERMQ t.[1] + (W8.of_int (1 %% 2^2 + 2^2 * (2 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + state.[1] <- x86_VPBLENDD_256 state.[1] state.[0] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + state.[1] <- ((invw state.[1]) `&` t.[8]); + state.[2] <- x86_VPBLENDD_256 t.[4] t.[5] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[7] <- x86_VPBLENDD_256 t.[6] t.[4] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[2] <- x86_VPBLENDD_256 state.[2] t.[6] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[7] <- x86_VPBLENDD_256 t.[7] t.[3] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[2] <- x86_VPBLENDD_256 state.[2] t.[3] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + t.[7] <- x86_VPBLENDD_256 t.[7] t.[5] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + state.[2] <- ((invw state.[2]) `&` t.[7]); + state.[2] <- (state.[2] `^` t.[2]); + t.[0] <- x86_VPERMQ t.[0] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + state.[3] <- x86_VPERMQ state.[3] + (W8.of_int (3 %% 2^2 + 2^2 * (2 %% 2^2 + 2^2 * (1 %% 2^2 + 2^2 * 0)))); + state.[5] <- x86_VPERMQ state.[5] + (W8.of_int (1 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 2)))); + state.[6] <- x86_VPERMQ state.[6] + (W8.of_int (2 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 1)))); + state.[4] <- x86_VPBLENDD_256 t.[6] t.[3] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[7] <- x86_VPBLENDD_256 t.[5] t.[6] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[4] <- x86_VPBLENDD_256 state.[4] t.[5] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[7] <- x86_VPBLENDD_256 t.[7] t.[2] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[4] <- x86_VPBLENDD_256 state.[4] t.[2] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + t.[7] <- x86_VPBLENDD_256 t.[7] t.[3] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + state.[4] <- ((invw state.[4]) `&` t.[7]); + state.[0] <- (state.[0] `^` t.[0]); + state.[1] <- (state.[1] `^` t.[1]); + state.[4] <- (state.[4] `^` t.[4]); + state.[0] <- + (state.[0] `^` (loadW256 Glob.mem (W64.to_uint (iotas + (W64.of_int ((0 * 32) - 0)))))); + iotas <- (iotas + (W64.of_int 32)); + ( _0, _1, _2, zf, r) <- x86_DEC_32 r; + } + return (state); + } +}. + diff --git a/proof/impl/perm/keccak_f1600_avx2_glue.ec b/proof/impl/old_perm/keccak_f1600_avx2_glue.ec similarity index 100% rename from proof/impl/perm/keccak_f1600_avx2_glue.ec rename to proof/impl/old_perm/keccak_f1600_avx2_glue.ec diff --git a/proof/impl/old_perm/keccak_f1600_avx2_prevec.ec b/proof/impl/old_perm/keccak_f1600_avx2_prevec.ec new file mode 100644 index 0000000..e2d8605 --- /dev/null +++ b/proof/impl/old_perm/keccak_f1600_avx2_prevec.ec @@ -0,0 +1,1522 @@ +require import List Int IntExtra IntDiv CoreMap. +from Jasmin require import JModel. + +require import Array4 Array9 Array24 Array25 Array96. +require import WArray288. + +require import Keccak_f1600_ref_table. +require import Keccak_f1600_ref. +import Ops. + +op lift2array(x : W256.t) : W64.t Array4.t = + Array4.init (fun (n : int) => x \bits64 n). + +op good_rhotates_right : int Array24.t = ( + witness + .[4* 0+0 <- 64 - 3].[4* 0+1 <- 64 - 18].[4* 0+2 <- 64 - 36].[4* 0+3 <- 64 - 41] + .[4* 1+0 <- 64 - 1].[4* 1+1 <- 64 - 62].[4* 1+2 <- 64 - 28].[4* 1+3 <- 64 - 27] + .[4* 2+0 <- 64 - 45].[4* 2+1 <- 64 - 6].[4* 2+2 <- 64 - 56].[4* 2+3 <- 64 - 39] + .[4* 3+0 <- 64 - 10].[4* 3+1 <- 64 - 61].[4* 3+2 <- 64 - 55].[4* 3+3 <- 64 - 8] + .[4* 4+0 <- 64 - 2].[4* 4+1 <- 64 - 15].[4* 4+2 <- 64 - 25].[4* 4+3 <- 64 - 20] + .[4* 5+0 <- 64 - 44].[4* 5+1 <- 64 - 43].[4* 5+2 <- 64 - 21].[4* 5+3 <- 64 - 14])%Array24. + + +op good_rhotates_left : int Array24.t = ( + witness + .[4* 0+0 <- 3].[4* 0+1 <- 18].[4* 0+2 <- 36].[4* 0+3 <- 41] + .[4* 1+0 <- 1].[4* 1+1 <- 62].[4* 1+2 <- 28].[4* 1+3 <- 27] + .[4* 2+0 <- 45].[4* 2+1 <- 6].[4* 2+2 <- 56].[4* 2+3 <- 39] + .[4* 3+0 <- 10].[4* 3+1 <- 61].[4* 3+2 <- 55].[4* 3+3 <- 8] + .[4* 4+0 <- 2].[4* 4+1 <- 15].[4* 4+2 <- 25].[4* 4+3 <- 20] + .[4* 5+0 <- 44].[4* 5+1 <- 43].[4* 5+2 <- 21].[4* 5+3 <- 14])%Array24. + + +op good_iotas4x : W64.t Array96.t = ( + witness + .[4* 0+0 <- W64.one ].[4* 0+1 <- W64.one ].[4* 0+2 <- W64.one ].[4* 0+3 <- W64.one ] + .[4* 1+0 <- W64.of_int 32898 ].[4* 1+1 <- W64.of_int 32898 ].[4* 1+2 <- W64.of_int 32898 ].[4* 1+3 <- W64.of_int 32898 ] + .[4* 2+0 <- W64.of_int 9223372036854808714].[4* 2+1 <- W64.of_int 9223372036854808714].[4* 2+2 <- W64.of_int 9223372036854808714].[4* 2+3 <- W64.of_int 9223372036854808714] + .[4* 3+0 <- W64.of_int 9223372039002292224].[4* 3+1 <- W64.of_int 9223372039002292224].[4* 3+2 <- W64.of_int 9223372039002292224].[4* 3+3 <- W64.of_int 9223372039002292224] + .[4* 4+0 <- W64.of_int 32907 ].[4* 4+1 <- W64.of_int 32907 ].[4* 4+2 <- W64.of_int 32907 ].[4* 4+3 <- W64.of_int 32907 ] + .[4* 5+0 <- W64.of_int 2147483649 ].[4* 5+1 <- W64.of_int 2147483649 ].[4* 5+2 <- W64.of_int 2147483649 ].[4* 5+3 <- W64.of_int 2147483649 ] + .[4* 6+0 <- W64.of_int 9223372039002292353].[4* 6+1 <- W64.of_int 9223372039002292353].[4* 6+2 <- W64.of_int 9223372039002292353].[4* 6+3 <- W64.of_int 9223372039002292353] + .[4* 7+0 <- W64.of_int 9223372036854808585].[4* 7+1 <- W64.of_int 9223372036854808585].[4* 7+2 <- W64.of_int 9223372036854808585].[4* 7+3 <- W64.of_int 9223372036854808585] + .[4* 8+0 <- W64.of_int 138 ].[4* 8+1 <- W64.of_int 138 ].[4* 8+2 <- W64.of_int 138 ].[4* 8+3 <- W64.of_int 138 ] + .[4* 9+0 <- W64.of_int 136 ].[4* 9+1 <- W64.of_int 136 ].[4* 9+2 <- W64.of_int 136 ].[4* 9+3 <- W64.of_int 136 ] + .[4*10+0 <- W64.of_int 2147516425 ].[4*10+1 <- W64.of_int 2147516425 ].[4*10+2 <- W64.of_int 2147516425 ].[4*10+3 <- W64.of_int 2147516425 ] + .[4*11+0 <- W64.of_int 2147483658 ].[4*11+1 <- W64.of_int 2147483658 ].[4*11+2 <- W64.of_int 2147483658 ].[4*11+3 <- W64.of_int 2147483658 ] + .[4*12+0 <- W64.of_int 2147516555 ].[4*12+1 <- W64.of_int 2147516555 ].[4*12+2 <- W64.of_int 2147516555 ].[4*12+3 <- W64.of_int 2147516555 ] + .[4*13+0 <- W64.of_int 9223372036854775947].[4*13+1 <- W64.of_int 9223372036854775947].[4*13+2 <- W64.of_int 9223372036854775947].[4*13+3 <- W64.of_int 9223372036854775947] + .[4*14+0 <- W64.of_int 9223372036854808713].[4*14+1 <- W64.of_int 9223372036854808713].[4*14+2 <- W64.of_int 9223372036854808713].[4*14+3 <- W64.of_int 9223372036854808713] + .[4*15+0 <- W64.of_int 9223372036854808579].[4*15+1 <- W64.of_int 9223372036854808579].[4*15+2 <- W64.of_int 9223372036854808579].[4*15+3 <- W64.of_int 9223372036854808579] + .[4*16+0 <- W64.of_int 9223372036854808578].[4*16+1 <- W64.of_int 9223372036854808578].[4*16+2 <- W64.of_int 9223372036854808578].[4*16+3 <- W64.of_int 9223372036854808578] + .[4*17+0 <- W64.of_int 9223372036854775936].[4*17+1 <- W64.of_int 9223372036854775936].[4*17+2 <- W64.of_int 9223372036854775936].[4*17+3 <- W64.of_int 9223372036854775936] + .[4*18+0 <- W64.of_int 32778 ].[4*18+1 <- W64.of_int 32778 ].[4*18+2 <- W64.of_int 32778 ].[4*18+3 <- W64.of_int 32778 ] + .[4*19+0 <- W64.of_int 9223372039002259466].[4*19+1 <- W64.of_int 9223372039002259466].[4*19+2 <- W64.of_int 9223372039002259466].[4*19+3 <- W64.of_int 9223372039002259466] + .[4*20+0 <- W64.of_int 9223372039002292353].[4*20+1 <- W64.of_int 9223372039002292353].[4*20+2 <- W64.of_int 9223372039002292353].[4*20+3 <- W64.of_int 9223372039002292353] + .[4*21+0 <- W64.of_int 9223372036854808704].[4*21+1 <- W64.of_int 9223372036854808704].[4*21+2 <- W64.of_int 9223372036854808704].[4*21+3 <- W64.of_int 9223372036854808704] + .[4*22+0 <- W64.of_int 2147483649 ].[4*22+1 <- W64.of_int 2147483649 ].[4*22+2 <- W64.of_int 2147483649 ].[4*22+3 <- W64.of_int 2147483649 ] + .[4*23+0 <- W64.of_int 9223372039002292232].[4*23+1 <- W64.of_int 9223372039002292232].[4*23+2 <- W64.of_int 9223372039002292232].[4*23+3 <- W64.of_int 9223372039002292232])%Array96. + +module Mavx2_prevec = { + + proc __KeccakF1600 (_A00:W64.t Array4.t, _A01:W64.t Array4.t, _A20:W64.t Array4.t, _A31:W64.t Array4.t, + _A21:W64.t Array4.t, _A41:W64.t Array4.t, _A11:W64.t Array4.t, + _rhotates_left:W64.t, _rhotates_right:W64.t, + _iotas:W64.t) : W64.t Array4.t * W64.t Array4.t * W64.t Array4.t * W64.t Array4.t * + W64.t Array4.t * W64.t Array4.t * W64.t Array4.t = { + + var rhotates_left:W64.t; + var rhotates_right:W64.t; + var iotas:W64.t; + var i:W32.t; + var zf:bool; + var _C00:W64.t Array4.t; + var _C14:W64.t Array4.t; + var _T:W64.t Array4.t Array9.t; + var _D14:W64.t Array4.t; + var _D00:W64.t Array4.t; + var _0:bool; + var _1:bool; + var _2:bool; + _T <- witness; + rhotates_left <- (_rhotates_left + (W64.of_int 96)); + rhotates_right <- (_rhotates_right + (W64.of_int 96)); + iotas <- _iotas; + i <- (W32.of_int 24); + _C00 <@ Ops.iVPSHUFD_256(_A20,(W8.of_int 78)); + _C14 <@ Ops.ilxor4u64(_A41,_A31); + _T.[2] <@ Ops.ilxor4u64(_A21,_A11); + _C14 <@ Ops.ilxor4u64(_C14,_A01); + _C14 <@ Ops.ilxor4u64(_C14,_T.[2]); + _T.[4] <- Ops.iVPERMQ(_C14,(W8.of_int 147)); + _C00 <@ Ops.ilxor4u64(_C00,_A20); + _T.[0] <- Ops.iVPERMQ(_C00,(W8.of_int 78)); + _T.[1] <- Ops.ivshr64u256(_C14, (W8.of_int 63)); + _T.[2] <- Ops.ivadd64u256(_C14, _C14); + _T.[1] <@ Ops.ilor4u64(_T.[1],_T.[2]); + _D14 <- Ops.iVPERMQ(_T.[1],(W8.of_int 57)); + _D00 <@ Ops.ilxor4u64(_T.[1],_T.[4]); + _D00 <- Ops.iVPERMQ(_D00,(W8.of_int 0)); + _C00 <@ Ops.ilxor4u64(_C00,_A00); + _C00 <@ Ops.ilxor4u64(_C00,_T.[0]); + _T.[0] <- Ops.ivshr64u256(_C00, (W8.of_int 63)); + _T.[1] <- Ops.ivadd64u256(_C00, _C00); + _T.[1] <@ Ops.ilor4u64(_T.[1],_T.[0]); + _A20 <@ Ops.ilxor4u64(_A20,_D00); + _A00 <@ Ops.ilxor4u64(_A00,_D00); + _D14 <- Ops.iVPBLENDD_256(_D14,_T.[1], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + _T.[4] <- Ops.iVPBLENDD_256(_T.[4],_C00, + (W8.of_int (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + _D14 <@ Ops.ilxor4u64(_D14,_T.[4]); + _T.[3] <@ Ops.iVPSLLV_4u64(_A20, lift2array + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((0 * 32) - 96)))))); + _A20 <@ Ops.iVPSRLV_4u64(_A20, lift2array + (loadW256 Glob.mem (W64.to_uint (rhotates_right+ (W64.of_int ((0 * 32) - 96)))))); + _A20 <@ Ops.ilor4u64(_A20,_T.[3]); + _A31 <@ Ops.ilxor4u64(_A31,_D14); + _T.[4] <@ Ops.iVPSLLV_4u64(_A31, lift2array + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((2 * 32) - 96)))))); + _A31 <@ Ops.iVPSRLV_4u64(_A31, lift2array + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((2 * 32) - 96)))))); + _A31 <@ Ops.ilor4u64(_A31,_T.[4]); + _A21 <@ Ops.ilxor4u64(_A21,_D14); + _T.[5] <@ Ops.iVPSLLV_4u64(_A21, lift2array + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((3 * 32) - 96)))))); + _A21 <@ Ops.iVPSRLV_4u64(_A21, lift2array + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((3 * 32) - 96)))))); + _A21 <@ Ops.ilor4u64(_A21,_T.[5]); + _A41 <@ Ops.ilxor4u64(_A41,_D14); + _T.[6] <@ Ops.iVPSLLV_4u64(_A41, lift2array + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((4 * 32) - 96)))))); + _A41 <@ Ops.iVPSRLV_4u64(_A41, lift2array + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((4 * 32) - 96)))))); + _A41 <@ Ops.ilor4u64(_A41,_T.[6]); + _A11 <@ Ops.ilxor4u64(_A11,_D14); + _T.[3] <- Ops.iVPERMQ(_A20,(W8.of_int 141)); + _T.[4] <- Ops.iVPERMQ(_A31,(W8.of_int 141)); + _T.[7] <@ Ops.iVPSLLV_4u64(_A11, lift2array + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((5 * 32) - 96)))))); + _T.[1] <@ Ops.iVPSRLV_4u64(_A11, lift2array + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((5 * 32) - 96)))))); + _T.[1] <@ Ops.ilor4u64(_T.[1],_T.[7]); + _A01 <@ Ops.ilxor4u64(_A01,_D14); + _T.[5] <- Ops.iVPERMQ(_A21,(W8.of_int 27)); + _T.[6] <- Ops.iVPERMQ(_A41,(W8.of_int 114)); + _T.[8] <@ Ops.iVPSLLV_4u64(_A01, lift2array + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((1 * 32) - 96)))))); + _T.[2] <@ Ops.iVPSRLV_4u64(_A01, lift2array + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((1 * 32) - 96)))))); + _T.[2] <@ Ops.ilor4u64(_T.[2],_T.[8]); + _T.[7] <@ Ops.iVPSRLDQ_256(_T.[1],(W8.of_int 8)); + _T.[0] <@ Ops.ilandn4u64(_T.[1],_T.[7]); + _A31 <@ Ops.iVPBLENDD_256(_T.[2],_T.[6], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + _T.[8] <@ Ops.iVPBLENDD_256(_T.[4],_T.[2], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + _A41 <@ Ops.iVPBLENDD_256(_T.[3], _T.[4], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + _T.[7] <@ Ops.iVPBLENDD_256(_T.[2], _T.[3], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + _A31 <@ Ops.iVPBLENDD_256(_A31 ,_T.[4], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + _T.[8] <@ Ops.iVPBLENDD_256(_T.[8], _T.[5], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + _A41 <@ Ops.iVPBLENDD_256(_A41, _T.[2], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + _T.[7] <@ Ops.iVPBLENDD_256(_T.[7], _T.[6], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + _A31 <@ Ops.iVPBLENDD_256(_A31, _T.[5], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + _T.[8] <@ Ops.iVPBLENDD_256(_T.[8], _T.[6], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + _A41 <@ Ops.iVPBLENDD_256(_A41, _T.[6], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + _T.[7] <@ Ops.iVPBLENDD_256(_T.[7], _T.[4], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + _A31 <@ Ops.ilandn4u64(_A31,_T.[8]); + _A41 <@ Ops.ilandn4u64(_A41,_T.[7]); + _A11 <@ Ops.iVPBLENDD_256(_T.[5],_T.[2], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + _T.[8] <@ Ops.iVPBLENDD_256(_T.[3], _T.[5], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + _A31 <@ Ops.ilxor4u64(_A31,_T.[3]); + _A11 <@ Ops.iVPBLENDD_256(_A11,_T.[3], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + _T.[8] <@ Ops.iVPBLENDD_256(_T.[8],_T.[4], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + _A41 <@ Ops.ilxor4u64(_A41,_T.[5]); + _A11 <@ Ops.iVPBLENDD_256(_A11, _T.[4], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + _T.[8] <@ Ops.iVPBLENDD_256(_T.[8], _T.[2], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + _A11 <@ Ops.ilandn4u64(_A11,_T.[8]); + _A11 <@ Ops.ilxor4u64(_A11,_T.[6]); + _A21 <@ Ops.iVPERMQ(_T.[1],(W8.of_int 30)); + _T.[8] <@ Ops.iVPBLENDD_256(_A21, _A00, + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + _A01 <@ Ops.iVPERMQ(_T.[1],(W8.of_int 57)); + _A01 <@ Ops.iVPBLENDD_256(_A01, _A00, + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + _A01 <@ Ops.ilandn4u64(_A01,_T.[8]); + _A20 <@ Ops.iVPBLENDD_256(_T.[4], _T.[5], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + _T.[7] <@ Ops.iVPBLENDD_256(_T.[6], _T.[4], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + _A20 <@ Ops.iVPBLENDD_256(_A20, _T.[6], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + _T.[7] <@ Ops.iVPBLENDD_256(_T.[7], _T.[3], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + _A20 <@ Ops.iVPBLENDD_256(_A20, _T.[3], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + _T.[7] <@ Ops.iVPBLENDD_256(_T.[7], _T.[5], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + _A20 <@ Ops.ilandn4u64(_A20,_T.[7]); + _A20 <@ Ops.ilxor4u64(_A20,_T.[2]); + _T.[0] <@ Ops.iVPERMQ(_T.[0],(W8.of_int 0)); + _A31 <@ Ops.iVPERMQ(_A31,(W8.of_int 27)); + _A41 <@ Ops.iVPERMQ(_A41,(W8.of_int 141)); + _A11 <@ Ops.iVPERMQ(_A11,(W8.of_int 114)); + _A21 <@ Ops.iVPBLENDD_256(_T.[6], _T.[3], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + _T.[7] <@ Ops.iVPBLENDD_256(_T.[5], _T.[6], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + _A21 <@ Ops.iVPBLENDD_256(_A21, _T.[5], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + _T.[7] <@ Ops.iVPBLENDD_256(_T.[7], _T.[2], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + _A21 <@ Ops.iVPBLENDD_256(_A21, _T.[2], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + _T.[7] <@ Ops.iVPBLENDD_256(_T.[7], _T.[3], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + _A21 <@ Ops.ilandn4u64(_A21,_T.[7]); + _A00 <@ Ops.ilxor4u64(_A00,_T.[0]); + _A01 <@ Ops.ilxor4u64(_A01,_T.[1]); + _A21 <@ Ops.ilxor4u64(_A21,_T.[4]); + _A00 <@ Ops.ilxor4u64(_A00, lift2array + (loadW256 Glob.mem (W64.to_uint (iotas + (W64.of_int 0))))); + iotas <- (iotas + (W64.of_int 32)); + ( _0, _1, _2, zf, i) <- x86_DEC_32 i; + while ((! zf)) { + _C00 <@ Ops.iVPSHUFD_256(_A20,(W8.of_int 78)); + _C14 <@ Ops.ilxor4u64(_A41,_A31); + _T.[2] <@ Ops.ilxor4u64(_A21,_A11); + _C14 <@ Ops.ilxor4u64(_C14,_A01); + _C14 <@ Ops.ilxor4u64(_C14,_T.[2]); + _T.[4] <@ Ops.iVPERMQ(_C14,(W8.of_int 147)); + _C00 <@ Ops.ilxor4u64(_C00,_A20); + _T.[0] <@ Ops.iVPERMQ(_C00,(W8.of_int 78)); + _T.[1] <@ Ops.ivshr64u256(_C14, (W8.of_int 63)); + _T.[2] <@ Ops.ivadd64u256(_C14, _C14); + _T.[1] <@ Ops.ilor4u64(_T.[1],_T.[2]); + _D14 <@ Ops.iVPERMQ(_T.[1],(W8.of_int 57)); + _D00 <@ Ops.ilxor4u64(_T.[1],_T.[4]); + _D00 <@ Ops.iVPERMQ(_D00,(W8.of_int 0)); + _C00 <@ Ops.ilxor4u64(_C00,_A00); + _C00 <@ Ops.ilxor4u64(_C00,_T.[0]); + _T.[0] <@ Ops.ivshr64u256(_C00, (W8.of_int 63)); + _T.[1] <@ Ops.ivadd64u256(_C00, _C00); + _T.[1] <@ Ops.ilor4u64(_T.[1],_T.[0]); + _A20 <@ Ops.ilxor4u64(_A20,_D00); + _A00 <@ Ops.ilxor4u64(_A00,_D00); + _D14 <@ Ops.iVPBLENDD_256(_D14,_T.[1], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + _T.[4] <@ Ops.iVPBLENDD_256(_T.[4],_C00, + (W8.of_int (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + _D14 <@ Ops.ilxor4u64(_D14,_T.[4]); + _T.[3] <@ Ops.iVPSLLV_4u64(_A20, lift2array + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((0 * 32) - 96)))))); + _A20 <@ Ops.iVPSRLV_4u64(_A20, lift2array + (loadW256 Glob.mem (W64.to_uint (rhotates_right+ (W64.of_int ((0 * 32) - 96)))))); + _A20 <@ Ops.ilor4u64(_A20,_T.[3]); + _A31 <@ Ops.ilxor4u64(_A31,_D14); + _T.[4] <@ Ops.iVPSLLV_4u64(_A31, lift2array + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((2 * 32) - 96)))))); + _A31 <@ Ops.iVPSRLV_4u64(_A31, lift2array + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((2 * 32) - 96)))))); + _A31 <@ Ops.ilor4u64(_A31,_T.[4]); + _A21 <@ Ops.ilxor4u64(_A21,_D14); + _T.[5] <@ Ops.iVPSLLV_4u64(_A21, lift2array + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((3 * 32) - 96)))))); + _A21 <@ Ops.iVPSRLV_4u64(_A21, lift2array + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((3 * 32) - 96)))))); + _A21 <@ Ops.ilor4u64(_A21,_T.[5]); + _A41 <@ Ops.ilxor4u64(_A41,_D14); + _T.[6] <@ Ops.iVPSLLV_4u64(_A41, lift2array + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((4 * 32) - 96)))))); + _A41 <@ Ops.iVPSRLV_4u64(_A41, lift2array + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((4 * 32) - 96)))))); + _A41 <@ Ops.ilor4u64(_A41,_T.[6]); + _A11 <@ Ops.ilxor4u64(_A11,_D14); + _T.[3] <- Ops.iVPERMQ(_A20,(W8.of_int 141)); + _T.[4] <- Ops.iVPERMQ(_A31,(W8.of_int 141)); + _T.[7] <@ Ops.iVPSLLV_4u64(_A11, lift2array + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((5 * 32) - 96)))))); + _T.[1] <@ Ops.iVPSRLV_4u64(_A11, lift2array + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((5 * 32) - 96)))))); + _T.[1] <@ Ops.ilor4u64(_T.[1],_T.[7]); + _A01 <@ Ops.ilxor4u64(_A01,_D14); + _T.[5] <- Ops.iVPERMQ(_A21,(W8.of_int 27)); + _T.[6] <- Ops.iVPERMQ(_A41,(W8.of_int 114)); + _T.[8] <@ Ops.iVPSLLV_4u64(_A01, lift2array + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((1 * 32) - 96)))))); + _T.[2] <@ Ops.iVPSRLV_4u64(_A01, lift2array + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((1 * 32) - 96)))))); + _T.[2] <@ Ops.ilor4u64(_T.[2],_T.[8]); + _T.[7] <@ Ops.iVPSRLDQ_256(_T.[1],(W8.of_int 8)); + _T.[0] <@ Ops.ilandn4u64(_T.[1],_T.[7]); + _A31 <@ Ops.iVPBLENDD_256(_T.[2], _T.[6], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + _T.[8] <@ Ops.iVPBLENDD_256(_T.[4], _T.[2], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + _A41 <@ Ops.iVPBLENDD_256(_T.[3], _T.[4], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + _T.[7] <@ Ops.iVPBLENDD_256(_T.[2], _T.[3], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + _A31 <@ Ops.iVPBLENDD_256(_A31, _T.[4], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + _T.[8] <@ Ops.iVPBLENDD_256(_T.[8], _T.[5], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + _A41 <@ Ops.iVPBLENDD_256(_A41, _T.[2], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + _T.[7] <@ Ops.iVPBLENDD_256(_T.[7], _T.[6], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + _A31 <@ Ops.iVPBLENDD_256(_A31, _T.[5], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + _T.[8] <@ Ops.iVPBLENDD_256(_T.[8], _T.[6], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + _A41 <@ Ops.iVPBLENDD_256(_A41, _T.[6], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + _T.[7] <@ Ops.iVPBLENDD_256(_T.[7], _T.[4], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + _A31 <@ Ops.ilandn4u64(_A31,_T.[8]); + _A41 <@ Ops.ilandn4u64(_A41,_T.[7]); + _A11 <@ Ops.iVPBLENDD_256(_T.[5], _T.[2], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + _T.[8] <@ Ops.iVPBLENDD_256(_T.[3], _T.[5], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + _A31 <@ Ops.ilxor4u64(_A31,_T.[3]); + _A11 <@ Ops.iVPBLENDD_256(_A11, _T.[3], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + _T.[8] <@ Ops.iVPBLENDD_256(_T.[8], _T.[4], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + _A41 <@ Ops.ilxor4u64(_A41,_T.[5]); + _A11 <@ Ops.iVPBLENDD_256(_A11, _T.[4], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + _T.[8] <@ Ops.iVPBLENDD_256(_T.[8], _T.[2], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + _A11 <@ Ops.ilandn4u64(_A11,_T.[8]); + _A11 <@ Ops.ilxor4u64(_A11,_T.[6]); + _A21 <@ Ops.iVPERMQ(_T.[1],(W8.of_int 30)); + _T.[8] <@ Ops.iVPBLENDD_256(_A21, _A00, + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + _A01 <@ Ops.iVPERMQ(_T.[1],(W8.of_int 57)); + _A01 <@ Ops.iVPBLENDD_256(_A01 ,_A00, + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + _A01 <@ Ops.ilandn4u64(_A01,_T.[8]); + _A20 <@ Ops.iVPBLENDD_256(_T.[4], _T.[5], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + _T.[7] <@ Ops.iVPBLENDD_256(_T.[6], _T.[4], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + _A20 <@ Ops.iVPBLENDD_256(_A20, _T.[6], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + _T.[7] <@ Ops.iVPBLENDD_256(_T.[7], _T.[3], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + _A20 <@ Ops.iVPBLENDD_256(_A20, _T.[3], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + _T.[7] <@ Ops.iVPBLENDD_256(_T.[7], _T.[5], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + _A20 <@ Ops.ilandn4u64(_A20,_T.[7]); + _A20 <@ Ops.ilxor4u64(_A20,_T.[2]); + _T.[0] <@ Ops.iVPERMQ(_T.[0],(W8.of_int 0)); + _A31 <@ Ops.iVPERMQ(_A31,(W8.of_int 27)); + _A41 <@ Ops.iVPERMQ(_A41,(W8.of_int 141)); + _A11 <@ Ops.iVPERMQ(_A11,(W8.of_int 114)); + _A21 <@ Ops.iVPBLENDD_256(_T.[6], _T.[3], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + _T.[7] <@ Ops.iVPBLENDD_256(_T.[5], _T.[6], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + _A21 <@ Ops.iVPBLENDD_256(_A21, _T.[5], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + _T.[7] <@ Ops.iVPBLENDD_256(_T.[7] ,_T.[2], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + _A21 <@ Ops.iVPBLENDD_256(_A21, _T.[2], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + _T.[7] <@ Ops.iVPBLENDD_256(_T.[7], _T.[3], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + _A21 <@ Ops.ilandn4u64(_A21,_T.[7]); + _A00 <@ Ops.ilxor4u64(_A00,_T.[0]); + _A01 <@ Ops.ilxor4u64(_A01,_T.[1]); + _A21 <@ Ops.ilxor4u64(_A21,_T.[4]); + _A00 <@ Ops.ilxor4u64(_A00, lift2array + (loadW256 Glob.mem (W64.to_uint (iotas + (W64.of_int 0))))); + iotas <- (iotas + (W64.of_int 32)); + ( _0, _1, _2, zf, i) <- x86_DEC_32 i; + } + return (_A00, _A01, _A20, _A31, _A21, _A41, _A11); + } +}. + +(* + ($A00, # [0][0] [0][0] [0][0] [0][0] + $A01, # [0][4] [0][3] [0][2] [0][1] + $A20, # [3][0] [1][0] [4][0] [2][0] + $A31, # [2][4] [4][3] [1][2] [3][1] + $A21, # [3][4] [1][3] [4][2] [2][1] + $A41, # [1][4] [2][3] [3][2] [4][1] + $A11) = # [4][4] [3][3] [2][2] [1][1] +*) + +op index x y = 5*x+y. + +op equiv_states (A00 A01 A20 A31 A21 A41 A11 : W64.t Array4.t, st : W64.t Array25.t) : bool = + A00.[3] = st.[index 0 0] /\ A00.[2] = st.[index 0 0] /\ A00.[1] = st.[index 0 0] /\ A00.[0] = st.[index 0 0] /\ + A01.[3] = st.[index 0 4] /\ A01.[2] = st.[index 0 3] /\ A01.[1] = st.[index 0 2] /\ A01.[0] = st.[index 0 1] /\ + A20.[3] = st.[index 3 0] /\ A20.[2] = st.[index 1 0] /\ A20.[1] = st.[index 4 0] /\ A20.[0] = st.[index 2 0] /\ + A31.[3] = st.[index 2 4] /\ A31.[2] = st.[index 4 3] /\ A31.[1] = st.[index 1 2] /\ A31.[0] = st.[index 3 1] /\ + A21.[3] = st.[index 3 4] /\ A21.[2] = st.[index 1 3] /\ A21.[1] = st.[index 4 2] /\ A21.[0] = st.[index 2 1] /\ + A41.[3] = st.[index 1 4] /\ A41.[2] = st.[index 2 3] /\ A41.[1] = st.[index 3 2] /\ A41.[0] = st.[index 4 1] /\ + A11.[3] = st.[index 4 4] /\ A11.[2] = st.[index 3 3] /\ A11.[1] = st.[index 2 2] /\ A11.[0] = st.[index 1 1]. + +op equiv_states_chi (A00 A01 A20 A31 A21 A41 A11 : W64.t Array4.t, st : W64.t Array25.t) : bool = + A00.[3] = st.[index 0 0] /\ A00.[2] = st.[index 0 0] /\ A00.[1] = st.[index 0 0] /\ A00.[0] = st.[index 0 0] /\ + A01.[3] = st.[index 0 4] /\ A01.[2] = st.[index 0 3] /\ A01.[1] = st.[index 0 2] /\ A01.[0] = st.[index 0 1] /\ + A20.[3] = st.[index 3 0] /\ A20.[2] = st.[index 1 0] /\ A20.[1] = st.[index 4 0] /\ A20.[0] = st.[index 2 0] /\ + A31.[3] = st.[index 3 1] /\ A31.[2] = st.[index 1 2] /\ A31.[1] = st.[index 4 3] /\ A31.[0] = st.[index 2 4] /\ + A21.[3] = st.[index 3 4] /\ A21.[2] = st.[index 1 3] /\ A21.[1] = st.[index 4 2] /\ A21.[0] = st.[index 2 1] /\ + A41.[3] = st.[index 3 2] /\ A41.[2] = st.[index 1 4] /\ A41.[1] = st.[index 4 1] /\ A41.[0] = st.[index 2 3] /\ + A11.[3] = st.[index 3 3] /\ A11.[2] = st.[index 1 1] /\ A11.[1] = st.[index 4 4] /\ A11.[0] = st.[index 2 2]. + +lemma dec : forall (x : W32.t), + 0 < to_uint x <= 24 => + to_uint (x86_DEC_32 x).`5 = to_uint x - 1 by smt(@W32). + +lemma decK : forall (x : W32.t), + (x86_DEC_32 x).`5 + W32.one = x by smt(@W32). + +lemma dec0 : forall (x : W32.t), + 0 < to_uint x <= 24 => + (x86_DEC_32 x).`4 <=> to_uint (x86_DEC_32 x).`5 = 0 by smt(@W32). + +lemma rolcomp : (forall (x : W64.t), + (x86_ROL_64 x W8.one).`3 = + (x `>>` W8.of_int 63) `|` (x + x)). +move => x. +rewrite x86_ROL_64_E => />. +rewrite rol_xor_shft => />. +rewrite (_: x + x = x `<<` W8.one). rewrite /(`<<`) => />. + have HH : ( to_uint (x+x) = to_uint (x `<<<` 1)); first by rewrite to_uint_shl => />; rewrite to_uintD => />; smt(@W64). + by smt(@W64). +rewrite /(`<<`) /(`>>`) => />. +rewrite xorE orE !map2E => />. +apply W64.init_ext. +progress. smt. +qed. + +lemma commor : forall (x y : W64.t), x `|` y = y `|` x. +move => *. + rewrite orE !map2E. +apply W64.init_ext. +by smt(). +qed. + +lemma rol0 : forall x, (x86_ROL_64 x W8.zero).`3 = x. +move => *. +rewrite x86_ROL_64_E rol_xor =>/>. +smt. +qed. + +lemma roln : forall x n, 0 <= n < 64 => + (x86_ROL_64 x (W8.of_int n)).`3 = + (x `>>>` (64 - n)) `|` (x `<<<` n). +move => x n H. +case (n = 0). +move => HH. rewrite HH rol0 => />. by smt(lsr_0). +move => HH. +rewrite x86_ROL_64_E => />. +rewrite rol_xor_shft => />. +split; first 2 by smt(). +rewrite /(`<<`) /(`>>`) => />. +rewrite (_: n %% 256 = n); first by smt(). +rewrite (_: n %% 256 = n); first by smt(). +rewrite (_: (64 - n) %% 256 = 64 - n); first by smt(). +rewrite (_: n %% 64 = n); first by smt(). +rewrite (_: (64 - n) %% 64 = 64 - n); first by smt(). +rewrite xorE orE !map2E => />. +apply W64.init_ext. +progress. smt. +qed. + +op good_iotas (mem : global_mem_t, _iotas : int) = + forall off, 0 <= off < 24 => + loadW64 mem (_iotas + (off * 8)) = iotas.[off]. + +op good_rhol (mem : global_mem_t, _rhotates_left : int) = + forall off, 0 <= off < 24 => + loadW64 mem (_rhotates_left + (off * 8)) = W64.of_int good_rhotates_left.[off]. + +op good_rhor (mem : global_mem_t, _rhotates_right : int) = + forall off, 0 <= off < 24 => + loadW64 mem ( _rhotates_right + (off * 8)) = W64.of_int good_rhotates_right.[off]. + +lemma loadlift_rhor : forall (mem : global_mem_t) (x : W64.t) (off : int), + good_rhor mem (to_uint x) => 0 <= off < 6 => + lift2array + (loadW256 mem (to_uint (x + W64.of_int (8 * 4 * off)))) = + (witness + .[0 <- W64.of_int good_rhotates_right.[4*off + 0]] + .[1 <- W64.of_int good_rhotates_right.[4*off + 1]] + .[2 <- W64.of_int good_rhotates_right.[4*off + 2]] + .[3 <- W64.of_int good_rhotates_right.[4*off + 3]])%Array4. + +move => mem x off. +rewrite /good_rhor /loadW256 /lift2array /good_rhotates_right => />. +move => *. +apply Array4.ext_eq. +move => *. + +case (off = 0). +auto => />. +case (x0 = 0). +move => x00. +rewrite x00 => />. +move : (H 0); rewrite /loadW64 => /> *. +rewrite -H3. +rewrite !pack8E W8u8.Pack.of_listE. +apply W64.init_ext. +move => *. +beta. +apply W8.wordP. +apply W8u8.Pack.packP. +apply W8u8.Pack.init_ext. +move => />. +smt(). smt(). smt(). +move => *. +case (x0 = 1). +move => x00. +rewrite x00 => />. +move : (H 1); rewrite /loadW64 => /> *. +rewrite -H4. +rewrite !pack8E W8u8.Pack.of_listE. +apply W64.init_ext. +move => *. +beta. +apply W8.wordP. +apply W8u8.Pack.packP. +apply W8u8.Pack.init_ext. +move => />. +smt(). smt(). smt(). +move => *. +case (x0 = 2). +move => x00. +rewrite x00 => />. +move : (H 2); rewrite /loadW64 => /> *. +rewrite -H5. +rewrite !pack8E W8u8.Pack.of_listE. +apply W64.init_ext. +move => *. +beta. +apply W8.wordP. +apply W8u8.Pack.packP. +apply W8u8.Pack.init_ext. +move => />. +smt(). smt(). smt(). +move => *. +case (x0 = 3). +move => x00. +rewrite x00 => />. +move : (H 3); rewrite /loadW64 => /> *. +rewrite -H6. +rewrite !pack8E W8u8.Pack.of_listE. +apply W64.init_ext. +move => *. +beta. +apply W8.wordP. +apply W8u8.Pack.packP. +apply W8u8.Pack.init_ext. +move => />. +smt(). smt(). smt(). +smt(). + +move => *. + +case (off = 1). +auto => />. +case (x0 = 0). +move => x00. +rewrite x00. +auto => /> //=. +move : (H 4); rewrite /loadW64 => /> *. +rewrite -H4. +rewrite !pack8E W8u8.Pack.of_listE. +apply W64.init_ext. +move => *. +beta. +apply W8.wordP. +apply W8u8.Pack.packP. +apply W8u8.Pack.init_ext. +move => />. +move => *. +have HHH : (to_uint x + 32 < W64.modulus). admit. (* safety *) +smt(@W64). smt(). smt(). +move => *. +case (x0 = 1). +move => x00. +rewrite x00 => />. +move : (H 5); rewrite /loadW64 => /> *. +rewrite -H5. +rewrite !pack8E W8u8.Pack.of_listE. +apply W64.init_ext. +move => *. +beta. +apply W8.wordP. +apply W8u8.Pack.packP. +apply W8u8.Pack.init_ext. +move => />. +have HHH : (to_uint x + 32 < W64.modulus). admit. (* safety *) +smt(@W64). smt(). smt(). +move => *. +case (x0 = 2). +move => x00. +rewrite x00 => />. +move : (H 6); rewrite /loadW64 => /> *. +rewrite -H6. +rewrite !pack8E W8u8.Pack.of_listE. +apply W64.init_ext. +move => *. +beta. +apply W8.wordP. +apply W8u8.Pack.packP. +apply W8u8.Pack.init_ext. +move => />. +have HHH : (to_uint x + 32 < W64.modulus). admit. (* safety *) +smt(@W64). smt(). smt(). +move => *. +case (x0 = 3). +move => x00. +rewrite x00 => />. +move : (H 7); rewrite /loadW64 => /> *. +rewrite -H7. +rewrite !pack8E W8u8.Pack.of_listE. +apply W64.init_ext. +move => *. +beta. +apply W8.wordP. +apply W8u8.Pack.packP. +apply W8u8.Pack.init_ext. +move => />. +have HHH : (to_uint x + 32 < W64.modulus). admit. (* safety *) +smt(@W64). smt(). smt(). +smt(). +admit. (* need to keep going *) +qed. + +(* these are the same as above *) +lemma loadlift_rhol : forall (mem : global_mem_t) (x : W64.t) (off : int), + good_rhol mem (to_uint x) => 0 <= off < 6 => + lift2array + (loadW256 mem (to_uint (x + W64.of_int (8 * 4 * off)))) = + (witness + .[0 <- W64.of_int good_rhotates_left.[4*off + 0]] + .[1 <- W64.of_int good_rhotates_left.[4*off + 1]] + .[2 <- W64.of_int good_rhotates_left.[4*off + 2]] + .[3 <- W64.of_int good_rhotates_left.[4*off + 3]])%Array4 by admit. + +lemma loadlift_iotas : forall (mem : global_mem_t) (x : W64.t) (off : int), + good_iotas mem (to_uint x) => 0 <= off < 24 => + lift2array + (loadW256 mem (to_uint (x + W64.of_int (8 * 4 * off)))) = + (witness + .[0 <- good_iotas4x.[4*off + 0]] + .[1 <- good_iotas4x.[4*off + 1]] + .[2 <- good_iotas4x.[4*off + 2]] + .[3 <- good_iotas4x.[4*off + 3]])%Array4 by admit. + +op conversion(o1 o2 : int) : int = + let (x,y) = + ((witness + .[0 <- (2,0)] + .[1 <- (4,0)] + .[2 <- (1,0)] + .[3 <- (3,0)] + .[4 <- (0,1)] + .[5 <- (0,2)] + .[6 <- (0,3)] + .[7 <- (0,4)] + .[8 <- (3,1)] + .[9 <- (1,2)] + .[10 <- (4,3)] + .[11 <- (2,4)] + .[12 <- (2,1)] + .[13 <- (4,2)] + .[14 <- (1,3)] + .[15 <- (3,4)] + .[16 <- (4,1)] + .[17 <- (3,2)] + .[18 <- (2,3)] + .[19 <- (1,4)] + .[20 <- (1,1)] + .[21 <- (2,2)] + .[22 <- (3,3)] + .[23 <- (4,4)])%Array24).[o1*4 + o2] in (5*x + y). + +lemma lift_roln mem rl rr o1 o2 x: + 0 <= o1 < 6 => 0 <= o2 < 4 => + good_rhol mem (W64.to_uint rl) => + good_rhor mem (W64.to_uint rr) => + (x `>>>` + (to_uint + (lift2array + (loadW256 mem + (to_uint (rr + W64.of_int 96 + W64.of_int (8 * 4 * o1 - 96))))).[o2]))%W64 `|` + (x `<<<` + (to_uint + (lift2array + (loadW256 mem + (to_uint (rl + W64.of_int 96 + W64.of_int (8 * 4 * o1 - 96))))).[o2]))%W64 + = (x86_ROL_64 x ((of_int (rhotates (conversion o1 o2))))%W8).`3. +proof. +move => *. +rewrite (loadlift_rhol mem (rl) o1). smt(). smt(). +rewrite (loadlift_rhor mem (rr) o1). smt(). smt(). +rewrite /good_rhotates_right /good_rhotates_left /rhotates /conversion. +simplify. +case(o1 = 0). auto => />. +case (o2 = 0). auto => />. smt(roln). +case (o2 = 1). auto => />. smt(roln). +case (o2 = 2). auto => />. smt(roln). +case (o2 = 3). auto => />. smt(roln). +smt(). +move => *. +case(o1 = 1). auto => />. +case (o2 = 0). auto => />. smt(roln). +case (o2 = 1). auto => />. smt(roln). +case (o2 = 2). auto => />. smt(roln). +case (o2 = 3). auto => />. smt(roln). +smt(). +move => *. +case(o1 = 2). auto => />. +case (o2 = 0). auto => />. smt(roln). +case (o2 = 1). auto => />. smt(roln). +case (o2 = 2). auto => />. smt(roln). +case (o2 = 3). auto => />. smt(roln). +smt(). +move => *. +case(o1 = 3). auto => />. +case (o2 = 0). auto => />. smt(roln). +case (o2 = 1). auto => />. smt(roln). +case (o2 = 2). auto => />. smt(roln). +case (o2 = 3). auto => />. smt(roln). +smt(). +move => *. +case(o1 = 4). auto => />. +case (o2 = 0). auto => />. smt(roln). +case (o2 = 1). auto => />. smt(roln). +case (o2 = 2). auto => />. smt(roln). +case (o2 = 3). auto => />. smt(roln). +smt(). +move => *. +case(o1 = 5). auto => />. +case (o2 = 0). auto => />. smt(roln). +case (o2 = 1). auto => />. smt(roln). +case (o2 = 2). auto => />. smt(roln). +case (o2 = 3). auto => />. smt(roln). +smt(). +smt(). +qed. + +lemma correct_perm A00 A01 A20 A31 A21 A41 A11 st mem: + equiv [ Mreftable.permute ~ Mavx2_prevec.__KeccakF1600 : + Glob.mem{2} = mem /\ good_iotas mem (to_uint _iotas{2}) /\ + good_rhol mem (to_uint _rhotates_left{2}) /\ good_rhor mem (to_uint _rhotates_right{2}) /\ + equiv_states A00 A01 A20 A31 A21 A41 A11 st /\ + _A00{2} = A00 /\ _A01{2} = A01 /\ _A20{2} = A20 /\ _A31{2} = A31 /\ + _A21{2} = A21 /\ _A41{2} = A41 /\ _A11{2} = A11 /\ state{1} = st ==> + equiv_states res{2}.`1 res{2}.`2 res{2}.`3 res{2}.`4 res{2}.`5 res{2}.`6 res{2}.`7 res{1}]. +proc. +unroll {1} 3. +rcondt {1} 3; first by move => *; inline *; auto => />. + +seq 0 1 : #pre; first by auto => />. +inline Mreftable.keccakRoundConstants. +sp 2 4. + +seq 1 105 : (#{/~_A00{2}}{~_A01{2}}{~_A20{2}}{~_A31{2}}{~_A21{2}}{~_A41{2}}{~_A11{2}}{~state{1}}pre /\ Glob.mem{2} = mem /\ + good_iotas mem (to_uint _iotas{2}) /\ + good_rhol mem (to_uint _rhotates_left{2}) /\ + good_rhor mem (to_uint _rhotates_right{2}) /\ + equiv_states _A00{2} _A01{2} _A20{2} _A31{2} _A21{2} _A41{2} _A11{2} state{1}). + +seq 0 0 : (#pre /\ (constants{1}.[round{1}])%Array24 = W64.of_int 1). +by auto => />; rewrite /iotas;smt(). + +inline Mreftable.keccakP1600_round. + +sp 2 0. +inline Mreftable.theta. +sp 1 0. + +swap {2} [20..21] 3. +swap {2} 28 -3. +swap {2} 32 -6. +swap {2} 36 -9. +swap {2} 40 -12. +swap {2} 46 -17. + +seq 9 29 : (#{/~state{1}}post /\ c{1} = W64.of_int 1 /\ + equiv_states _A00{2} _A01{2} _A20{2} _A31{2} _A21{2} _A41{2} _A11{2} state0{1}). +do 13!(unroll for {1} ^while). + + +inline *. +do !((rcondf {2} ^if; first by move => *; wp;skip;auto => />) || + (rcondt {2} ^if; first by move => *; wp;skip;auto => />)). + +wp;skip. +move => &1 &2. +rewrite /equiv_states /index. + simplify. +by smt(W64.xorwA W64.xorwC W64.xorw0 W64.xorwK rolcomp commor). + +(* Rho PI *) +inline Mreftable.rho Mreftable.pi. + +seq 11 22 : (#{/~ state{1}}post /\ c{1} = W64.of_int 1 /\ + equiv_states_chi _A00{2} _T{2}.[1] _T{2}.[2] _T{2}.[3] _T{2}.[4] _T{2}.[5] _T{2}.[6] state0{1}). + +do 13!(unroll for {1} ^while). +inline *. +do !((rcondf {2} ^if; first by move => *; wp;skip;auto => />) || + (rcondt {2} ^if; first by move => *; wp;skip;auto => />)). + +wp;skip. +move => &1 &2. +rewrite /equiv_states /equiv_states_chi /index. +simplify. + +move => [/ # *]. + +split; first by smt(). +split; first by smt(). + +split; first by rewrite /rhotates; smt(roln rol0). +split; first by rewrite /rhotates; smt(roln rol0). +split; first by rewrite /rhotates; smt(roln rol0). +split; first by rewrite /rhotates; smt(roln rol0). + +split. +rewrite H H0. +move : H36 H37; rewrite -H5 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 5 3 _A11{2}.[3] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +split. +rewrite H H0. +move : H36 H37; rewrite -H5 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 5 2 _A11{2}.[2] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +split. +rewrite H H0. +move : H36 H37; rewrite -H5 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 5 1 _A11{2}.[1] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +split. +rewrite H H0. +move : H36 H37; rewrite -H5 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 5 0 _A11{2}.[0] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +split. +rewrite H H0. +move : H36 H37; rewrite -H5 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 1 3 _A01{2}.[3] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +split. +rewrite H H0. +move : H36 H37; rewrite -H5 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 1 2 _A01{2}.[2] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +split. +rewrite H H0. +move : H36 H37; rewrite -H5 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 1 1 _A01{2}.[1] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +split. +rewrite H H0. +move : H36 H37; rewrite -H5 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 1 0 _A01{2}.[0] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + + +split. +rewrite H H0. +move : H36 H37; rewrite -H5 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 0 2 _A20{2}.[2] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +split. +rewrite H H0. +move : H36 H37; rewrite -H5 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 0 0 _A20{2}.[0] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +split. +rewrite H H0. +move : H36 H37; rewrite -H5 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 0 3 _A20{2}.[3] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +split. +rewrite H H0. +move : H36 H37; rewrite -H5 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 0 1 _A20{2}.[1] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +split. +rewrite H H0. +move : H36 H37; rewrite -H5 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 2 2 _A31{2}.[2] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +split. +rewrite H H0. +move : H36 H37; rewrite -H5 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 2 0 _A31{2}.[0] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +split. +rewrite H H0. +move : H36 H37; rewrite -H5 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 2 3 _A31{2}.[3] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +split. +rewrite H H0. +move : H36 H37; rewrite -H5 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 2 1 _A31{2}.[1] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +split. +rewrite H H0. +move : H36 H37; rewrite -H5 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 3 0 _A21{2}.[0] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +split. +rewrite H H0. +move : H36 H37; rewrite -H5 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 3 1 _A21{2}.[1] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +split. +rewrite H H0. +move : H36 H37; rewrite -H5 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 3 2 _A21{2}.[2] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +split. +rewrite H H0. +move : H36 H37; rewrite -H5 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 3 3 _A21{2}.[3] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +split. +rewrite H H0. +move : H36 H37; rewrite -H5 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 4 1 _A41{2}.[1] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +split. +rewrite H H0. +move : H36 H37; rewrite -H5 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 4 3 _A41{2}.[3] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +split. +rewrite H H0. +move : H36 H37; rewrite -H5 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 4 0 _A41{2}.[0] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +rewrite H H0. +move : H36 H37; rewrite -H5 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 4 2 _A41{2}.[2] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + + +(* Chi *) +inline Mreftable.chi. + +seq 5 53 : (#{~state0{1}}pre /\ + equiv_states _A00{2} _A01{2} _A20{2} _A31{2} _A21{2} _A41{2} _A11{2} state0{1}). + +do 11!(unroll for {1} ^while). +inline *. +do !((rcondf {2} ^if; first by move => *; wp;skip;auto => />) || + (rcondt {2} ^if; first by move => *; wp;skip;auto => />)). + +wp. skip. +move => &1 &2. +rewrite /equiv_states /equiv_states_chi /index. +simplify. + +move => [/ # *]. + +split; first by smt(). + +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +smt(@W64). + +inline *. wp;skip. +move => &1 &2 [/ # *]. +split; first by smt(). +split; first by smt(). +split; first by smt(). +split; first by smt(). +split; first by smt(). +rewrite /equiv_states /index /y_R. +simplify. + +move : (loadlift_iotas Glob.mem{2} (iotas{2}) 0) => //= ii. +rewrite ii. simplify. +smt(@W64). +rewrite /good_iotas4x. +simplify. +smt(@W64). + +seq 1 2 : (#{/~iotas{2}}{~round{1}}{~i{2}}{~st}pre /\ + iotas{2} = _iotas{2} + W64.of_int (round{1} * 32) /\ + to_uint i{2} = 24 - round{1} /\ + ((to_uint i{2} = 0) <> round{1} < 24) /\ + (x86_DEC_32 (i{2} + W32.of_int 1)).`4 = zf{2} /\ + 0 < round{1} /\ + to_uint i{2} <= 24 /\ + constants{1} = Keccak_f1600_ref.iotas). + +auto => />. +progress. +apply dec. smt(). +rewrite (dec). smt(@W32). smt(@W32). +rewrite (decK). smt(@W32). +smt(@W32 dec decK). + +while (#pre). + +inline Mreftable.keccakP1600_round. + + +sp 2 0. +inline Mreftable.theta. +sp 1 0. + +swap {2} [20..21] 3. +swap {2} 28 -3. +swap {2} 32 -6. +swap {2} 36 -9. +swap {2} 40 -12. +swap {2} 46 -17. + +seq 9 29 : (#{/~state{1}}post /\ c{1} = constants{1}.[round{1}] /\ round{1} < 24 /\ + equiv_states _A00{2} _A01{2} _A20{2} _A31{2} _A21{2} _A41{2} _A11{2} state0{1}). + +do 13!(unroll for {1} ^while). +inline *. +do !((rcondf {2} ^if; first by move => *; wp;skip;auto => />) || + (rcondt {2} ^if; first by move => *; wp;skip;auto => />)). + +wp;skip. +move => &1 &2. +rewrite /equiv_states /index. +simplify. +by smt(W64.xorwA W64.xorwC W64.xorw0 W64.xorwK rolcomp commor). + +(* Rho PI *) +inline Mreftable.rho Mreftable.pi. + +seq 11 22 : (#{/~ state{1}}post /\ c{1} = constants{1}.[round{1}] /\ round{1} < 24 /\ + equiv_states_chi _A00{2} _T{2}.[1] _T{2}.[2] _T{2}.[3] _T{2}.[4] _T{2}.[5] _T{2}.[6] state0{1}). + +do 13!(unroll for {1} ^while). + + +inline *. +do !((rcondf {2} ^if; first by move => *; wp;skip;auto => />) || + (rcondt {2} ^if; first by move => *; wp;skip;auto => />)). + +wp;skip. +move => &1 &2. +rewrite /equiv_states /equiv_states_chi /index. +simplify. + +move => [/ #] *. + +split; first by smt(). +split; first by smt(). +split; first by smt(). + +split; first by rewrite /rhotates; smt(roln rol0). +split; first by rewrite /rhotates; smt(roln rol0). +split; first by rewrite /rhotates; smt(roln rol0). +split; first by rewrite /rhotates; smt(roln rol0). + +split. +rewrite H H0. +move : H5 H6; rewrite -H2 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 5 3 _A11{2}.[3] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +split. +rewrite H H0. +move : H5 H6; rewrite -H2 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 5 2 _A11{2}.[2] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +split. +rewrite H H0. +move : H5 H6; rewrite -H2 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 5 1 _A11{2}.[1] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +split. +rewrite H H0. +move : H5 H6; rewrite -H2 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 5 0 _A11{2}.[0] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +split. +rewrite H H0. +move : H5 H6; rewrite -H2 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 1 3 _A01{2}.[3] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +split. +rewrite H H0. +move : H5 H6; rewrite -H2 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 1 2 _A01{2}.[2] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +split. +rewrite H H0. +move : H5 H6; rewrite -H2 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 1 1 _A01{2}.[1] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +split. +rewrite H H0. +move : H5 H6; rewrite -H2 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 1 0 _A01{2}.[0] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + + +split. +rewrite H H0. +move : H5 H6; rewrite -H2 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 0 2 _A20{2}.[2] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +split. +rewrite H H0. +move : H5 H6; rewrite -H2 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 0 0 _A20{2}.[0] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +split. +rewrite H H0. +move : H5 H6; rewrite -H2 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 0 3 _A20{2}.[3] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +split. +rewrite H H0. +move : H5 H6; rewrite -H2 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 0 1 _A20{2}.[1] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +split. +rewrite H H0. +move : H5 H6; rewrite -H2 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 2 2 _A31{2}.[2] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +split. +rewrite H H0. +move : H5 H6; rewrite -H2 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 2 0 _A31{2}.[0] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +split. +rewrite H H0. +move : H5 H6; rewrite -H2 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 2 3 _A31{2}.[3] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +split. +rewrite H H0. +move : H5 H6; rewrite -H2 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 2 1 _A31{2}.[1] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +split. +rewrite H H0. +move : H5 H6; rewrite -H2 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 3 0 _A21{2}.[0] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +split. +rewrite H H0. +move : H5 H6; rewrite -H2 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 3 1 _A21{2}.[1] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +split. +rewrite H H0. +move : H5 H6; rewrite -H2 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 3 2 _A21{2}.[2] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +split. +rewrite H H0. +move : H5 H6; rewrite -H2 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 3 3 _A21{2}.[3] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +split. +rewrite H H0. +move : H5 H6; rewrite -H2 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 4 1 _A41{2}.[1] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +split. +rewrite H H0. +move : H5 H6; rewrite -H2 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 4 3 _A41{2}.[3] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +split. +rewrite H H0. +move : H5 H6; rewrite -H2 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 4 0 _A41{2}.[0] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +rewrite H H0. +move : H5 H6; rewrite -H2 => rl rr. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 4 2 _A41{2}.[2] _ _ rl rr); +rewrite /conversion. +smt(). smt(). smt(). + +smt(). + +(* Chi *) +inline Mreftable.chi. + +seq 5 53 : (#{~state0{1}}pre /\ + equiv_states _A00{2} _A01{2} _A20{2} _A31{2} _A21{2} _A41{2} _A11{2} state0{1}). + +do 11!(unroll for {1} ^while). +inline *. +do !((rcondf {2} ^if; first by move => *; wp;skip;auto => />) || + (rcondt {2} ^if; first by move => *; wp;skip;auto => />)). + +wp. skip. +move => &1 &2. +rewrite /equiv_states /equiv_states_chi /index. +simplify. + +move => [/ #] *. + +split; first by smt(). + +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +split; first by smt(@W64). +smt(@W64). + +smt(). + + +(* iota *) + +seq 2 1 : (#{/~ state0{1}}pre /\ + equiv_states _A00{2} _A01{2} _A20{2} _A31{2} _A21{2} _A41{2} _A11{2} + state{1}). + +inline *; wp; skip; rewrite /equiv_states /index; progress. + +move : (loadlift_iotas Glob.mem{2} _iotas{2}(round{1})) => ii. +rewrite (_:round{1} * 32 = 8*4*round{1}); first by smt(). +rewrite ii. simplify. smt(). smt(). +rewrite /good_iotas4x /iotas. +case (round{1} = 0); first by auto => />. +case (round{1} = 1). auto => />. smt(@W64). +case (round{1} = 2). auto => />. smt(@W64). +case (round{1} = 3). auto => />. smt(@W64). +case (round{1} = 4). auto => />. smt(@W64). +case (round{1} = 5). auto => />. smt(@W64). +case (round{1} = 6). auto => />. smt(@W64). +case (round{1} = 7). auto => />. smt(@W64). +case (round{1} = 8). auto => />. smt(@W64). +case (round{1} = 9). auto => />. smt(@W64). +case (round{1} = 10). auto => />. smt(@W64). +case (round{1} = 11). auto => />. smt(@W64). +case (round{1} = 12). auto => />. smt(@W64). +case (round{1} = 13). auto => />. smt(@W64). +case (round{1} = 14). auto => />. smt(@W64). +case (round{1} = 15). auto => />. smt(@W64). +case (round{1} = 16). auto => />. smt(@W64). +case (round{1} = 17). auto => />. smt(@W64). +case (round{1} = 18). auto => />. smt(@W64). +case (round{1} = 19). auto => />. smt(@W64). +case (round{1} = 20). auto => />. smt(@W64). +case (round{1} = 21). auto => />. smt(@W64). +case (round{1} = 22). auto => />. smt(@W64). +case (round{1} = 23). auto => />. smt(@W64). +smt(). + +move : (loadlift_iotas Glob.mem{2} _iotas{2}(round{1})) => ii. +rewrite (_:round{1} * 32 = 8*4*round{1}); first by smt(). +rewrite ii. simplify. smt(). smt(). +rewrite /good_iotas4x /iotas. +case (round{1} = 0); first by auto => />. +case (round{1} = 1). auto => />. smt(@W64). +case (round{1} = 2). auto => />. smt(@W64). +case (round{1} = 3). auto => />. smt(@W64). +case (round{1} = 4). auto => />. smt(@W64). +case (round{1} = 5). auto => />. smt(@W64). +case (round{1} = 6). auto => />. smt(@W64). +case (round{1} = 7). auto => />. smt(@W64). +case (round{1} = 8). auto => />. smt(@W64). +case (round{1} = 9). auto => />. smt(@W64). +case (round{1} = 10). auto => />. smt(@W64). +case (round{1} = 11). auto => />. smt(@W64). +case (round{1} = 12). auto => />. smt(@W64). +case (round{1} = 13). auto => />. smt(@W64). +case (round{1} = 14). auto => />. smt(@W64). +case (round{1} = 15). auto => />. smt(@W64). +case (round{1} = 16). auto => />. smt(@W64). +case (round{1} = 17). auto => />. smt(@W64). +case (round{1} = 18). auto => />. smt(@W64). +case (round{1} = 19). auto => />. smt(@W64). +case (round{1} = 20). auto => />. smt(@W64). +case (round{1} = 21). auto => />. smt(@W64). +case (round{1} = 22). auto => />. smt(@W64). +case (round{1} = 23). auto => />. smt(@W64). +smt(). + +move : (loadlift_iotas Glob.mem{2} _iotas{2}(round{1})) => ii. +rewrite (_:round{1} * 32 = 8*4*round{1}); first by smt(). +rewrite ii. simplify. smt(). smt(). +rewrite /good_iotas4x /iotas. +case (round{1} = 0); first by auto => />. +case (round{1} = 1). auto => />. smt(@W64). +case (round{1} = 2). auto => />. smt(@W64). +case (round{1} = 3). auto => />. smt(@W64). +case (round{1} = 4). auto => />. smt(@W64). +case (round{1} = 5). auto => />. smt(@W64). +case (round{1} = 6). auto => />. smt(@W64). +case (round{1} = 7). auto => />. smt(@W64). +case (round{1} = 8). auto => />. smt(@W64). +case (round{1} = 9). auto => />. smt(@W64). +case (round{1} = 10). auto => />. smt(@W64). +case (round{1} = 11). auto => />. smt(@W64). +case (round{1} = 12). auto => />. smt(@W64). +case (round{1} = 13). auto => />. smt(@W64). +case (round{1} = 14). auto => />. smt(@W64). +case (round{1} = 15). auto => />. smt(@W64). +case (round{1} = 16). auto => />. smt(@W64). +case (round{1} = 17). auto => />. smt(@W64). +case (round{1} = 18). auto => />. smt(@W64). +case (round{1} = 19). auto => />. smt(@W64). +case (round{1} = 20). auto => />. smt(@W64). +case (round{1} = 21). auto => />. smt(@W64). +case (round{1} = 22). auto => />. smt(@W64). +case (round{1} = 23). auto => />. smt(@W64). +smt(). + +move : (loadlift_iotas Glob.mem{2} _iotas{2}(round{1})) => ii. +rewrite (_:round{1} * 32 = 8*4*round{1}); first by smt(). +rewrite ii. simplify. smt(). +smt(). +rewrite /good_iotas4x /iotas. +case (round{1} = 0); first by auto => />. +case (round{1} = 1). auto => />. smt(@W64). +case (round{1} = 2). auto => />. smt(@W64). +case (round{1} = 3). auto => />. smt(@W64). +case (round{1} = 4). auto => />. smt(@W64). +case (round{1} = 5). auto => />. smt(@W64). +case (round{1} = 6). auto => />. smt(@W64). +case (round{1} = 7). auto => />. smt(@W64). +case (round{1} = 8). auto => />. smt(@W64). +case (round{1} = 9). auto => />. smt(@W64). +case (round{1} = 10). auto => />. smt(@W64). +case (round{1} = 11). auto => />. smt(@W64). +case (round{1} = 12). auto => />. smt(@W64). +case (round{1} = 13). auto => />. smt(@W64). +case (round{1} = 14). auto => />. smt(@W64). +case (round{1} = 15). auto => />. smt(@W64). +case (round{1} = 16). auto => />. smt(@W64). +case (round{1} = 17). auto => />. smt(@W64). +case (round{1} = 18). auto => />. smt(@W64). +case (round{1} = 19). auto => />. smt(@W64). +case (round{1} = 20). auto => />. smt(@W64). +case (round{1} = 21). auto => />. smt(@W64). +case (round{1} = 22). auto => />. smt(@W64). +case (round{1} = 23). auto => />. smt(@W64). +smt(). + +wp;skip;progress;smt(dec dec0 decK @W32). + +skip;progress. + +rewrite dec0. +split. rewrite to_uintD. smt(@W32). smt(@W32). +rewrite dec. rewrite to_uintD. smt(@W32). smt(@W32). + +move : H7. rewrite dec0. +rewrite to_uintD. smt(@W32). +rewrite dec. rewrite to_uintD. smt(@W32). +rewrite to_uintD. smt(@W32). +qed. + diff --git a/proof/impl/old_perm/keccak_f1600_ref.ec b/proof/impl/old_perm/keccak_f1600_ref.ec new file mode 100644 index 0000000..fdfb1d3 --- /dev/null +++ b/proof/impl/old_perm/keccak_f1600_ref.ec @@ -0,0 +1,246 @@ +require import List Int IntExtra IntDiv CoreMap. +from Jasmin require import JModel. + +require import Array5 Array24 Array25. +require import WArray40 WArray192 WArray200. + +require import Ops. + +op iotas : W64.t Array24.t = (( + witness + .[0 <- W64.one] + .[1 <- W64.of_int 32898] + .[2 <- W64.of_int 9223372036854808714] + .[3 <- W64.of_int 9223372039002292224] + .[4 <- W64.of_int 32907] + .[5 <- W64.of_int 2147483649] + .[6 <- W64.of_int 9223372039002292353] + .[7 <- W64.of_int 9223372036854808585] + .[8 <- W64.of_int 138] + .[9 <- W64.of_int 136] + .[10 <- W64.of_int 2147516425] + .[11 <- W64.of_int 2147483658] + .[12 <- W64.of_int 2147516555] + .[13 <- W64.of_int 9223372036854775947] + .[14 <- W64.of_int 9223372036854808713] + .[15 <- W64.of_int 9223372036854808579] + .[16 <- W64.of_int 9223372036854808578] + .[17 <- W64.of_int 9223372036854775936] + .[18 <- W64.of_int 32778] + .[19 <- W64.of_int 9223372039002259466] + .[20 <- W64.of_int 9223372039002292353] + .[21 <- W64.of_int 9223372036854808704] + .[22 <- W64.of_int 2147483649] + .[23 <- W64.of_int 9223372039002292232])%Array24). + +module Mref = { + proc index (x:int, y:int) : int = { + + var r:int; + + r <- ((x %% 5) + (5 * (y %% 5))); + return (r); + } + + proc theta (a:W64.t Array25.t) : W64.t Array25.t = { + var aux_1: bool; + var aux_0: bool; + var aux: int; + var aux_2: W64.t; + + var x:int; + var c:W64.t Array5.t; + var y:int; + var d:W64.t Array5.t; + var _0:bool; + var _1:bool; + c <- witness; + d <- witness; + x <- 0; + while (x < 5) { + c.[x] <- (W64.of_int 0); + y <- 0; + while (y < 5) { + c.[x] <- (c.[x] `^` a.[(x + (5 * y))]); + y <- y + 1; + } + x <- x + 1; + } + x <- 0; + while (x < 5) { + (aux_1, aux_0, aux_2) <- x86_ROL_64 c.[((x + 1) %% 5)] (W8.of_int 1); + _0 <- aux_1; + _1 <- aux_0; + d.[x] <- aux_2; + d.[x] <- (d.[x] `^` c.[((x + 4) %% 5)]); + x <- x + 1; + } + x <- 0; + while (x < 5) { + y <- 0; + while (y < 5) { + a.[(x + (5 * y))] <- (a.[(x + (5 * y))] `^` d.[x]); + y <- y + 1; + } + x <- x + 1; + } + return (a); + } + + proc keccakRhoOffsets (i:int) : int = { + var aux: int; + + var r:int; + var x:int; + var y:int; + var t:int; + var z:int; + + r <- 0; + x <- 1; + y <- 0; + t <- 0; + while (t < 24) { + if ((i = (x + (5 * y)))) { + r <- ((((t + 1) * (t + 2)) %/ 2) %% 64); + } else { + + } + z <- (((2 * x) + (3 * y)) %% 5); + x <- y; + y <- z; + t <- t + 1; + } + return (r); + } + + proc rho (a:W64.t Array25.t) : W64.t Array25.t = { + var aux_1: bool; + var aux_0: bool; + var aux: int; + var aux_2: W64.t; + + var x:int; + var y:int; + var i:int; + var z:int; + var _0:bool; + var _1:bool; + + x <- 0; + while (x < 5) { + y <- 0; + while (y < 5) { + i <@ index (x, y); + z <@ keccakRhoOffsets (i); + (aux_1, aux_0, aux_2) <- x86_ROL_64 a.[i] (W8.of_int z); + _0 <- aux_1; + _1 <- aux_0; + a.[i] <- aux_2; + y <- y + 1; + } + x <- x + 1; + } + return (a); + } + + proc pi (a:W64.t Array25.t) : W64.t Array25.t = { + var aux: int; + + var i:int; + var t:W64.t; + var b:W64.t Array25.t; + var y:int; + var x:int; + b <- witness; + i <- 0; + while (i < 25) { + t <- a.[i]; + b.[i] <- t; + i <- i + 1; + } + x <- 0; + while (x < 5) { + y <- 0; + while (y < 5) { + t <- b.[(x + (5 * y))]; + i <@ index (y, ((2 * x) + (3 * y))); + a.[i] <- t; + y <- y + 1; + } + x <- x + 1; + } + return (a); + } + + proc chi (a:W64.t Array25.t) : W64.t Array25.t = { + var aux: int; + + var x:int; + var y:int; + var i:int; + var c:W64.t Array5.t; + c <- witness; + y <- 0; + while (y < 5) { + x <- 0; + while (x < 5) { + i <@ index ((x + 1), y); + c.[x] <- a.[i]; + c.[x] <- (invw c.[x]); + i <@ index ((x + 2), y); + c.[x] <- (c.[x] `&` a.[i]); + i <@ index (x, y); + c.[x] <- (c.[x] `^` a.[i]); + x <- x + 1; + } + x <- 0; + while (x < 5) { + a.[(x + (5 * y))] <- c.[x]; + x <- x + 1; + } + y <- y + 1; + } + return (a); + } + + proc iota_0 (a:W64.t Array25.t, c:W64.t) : W64.t Array25.t = { + + + + a.[0] <- (a.[0] `^` c); + return (a); + } + + proc keccakP1600_round (state:W64.t Array25.t, c:W64.t) : W64.t Array25.t = { + + + + state <@ theta (state); + state <@ rho (state); + state <@ pi (state); + state <@ chi (state); + state <@ iota_0 (state, c); + return (state); + } + + proc keccakRoundConstants () : W64.t Array24.t = { + return iotas; + } + + proc permute (state:W64.t Array25.t) : W64.t Array25.t = { + var aux: int; + + var constants:W64.t Array24.t; + var round:int; + constants <- witness; + constants <@ keccakRoundConstants (); + round <- 0; + while (round < 24) { + state <@ keccakP1600_round (state, constants.[round]); + round <- round + 1; + } + return (state); + } +}. + diff --git a/proof/impl/perm/keccak_f1600_ref_loop2.ec b/proof/impl/old_perm/keccak_f1600_ref_loop2.ec similarity index 100% rename from proof/impl/perm/keccak_f1600_ref_loop2.ec rename to proof/impl/old_perm/keccak_f1600_ref_loop2.ec diff --git a/proof/impl/old_perm/keccak_f1600_ref_table.ec b/proof/impl/old_perm/keccak_f1600_ref_table.ec new file mode 100644 index 0000000..11aa491 --- /dev/null +++ b/proof/impl/old_perm/keccak_f1600_ref_table.ec @@ -0,0 +1,247 @@ +require import List Int IntExtra IntDiv CoreMap. +from Jasmin require import JModel. + +require import Keccak_f1600_ref. +import Ops. +import Array24. +import Array25. + +op rhotates(i : int) : int = (( + witness + .[0 <- 0 ] + .[1 <- 1 ] + .[2 <- 62] + .[3 <- 28] + .[4 <- 27] + .[5 <- 36] + .[6 <- 44] + .[7 <- 6 ] + .[8 <- 55] + .[9 <- 20] + .[10 <- 3 ] + .[11 <- 10] + .[12 <- 43] + .[13 <- 25] + .[14 <- 39] + .[15 <- 41] + .[16 <- 45] + .[17 <- 15] + .[18 <- 21] + .[19 <- 8 ] + .[20 <- 18] + .[21 <- 2 ] + .[22 <- 61] + .[23 <- 56] + .[24 <- 14])%Array25).[i]. + +module RhotatesAlgo = { + include Mref [keccakRhoOffsets] +}. + +module RhotatesTable = { + proc keccakRhoOffsets (i:int) : int = { + return rhotates(i); + } +}. + +equiv rhotates_table_corr : + RhotatesAlgo.keccakRhoOffsets ~ RhotatesTable.keccakRhoOffsets : + ={arg} /\ 0 <= i{1} < 25 ==> ={res} . +proc. +unroll for {1} 5. + +case (i{1} = 0). +do !((rcondt {1} ^if; first by move => *; auto => />) || + (rcondf {1} ^if; first by move => *; auto => />)); auto => />. + +case (i{1} = 1). +do !((rcondt {1} ^if; first by move => *; auto => />) || + (rcondf {1} ^if; first by move => *; auto => />)); auto => />. + +case (i{1} = 2). +do !((rcondt {1} ^if; first by move => *; auto => />) || + (rcondf {1} ^if; first by move => *; auto => />)); auto => />. + +case (i{1} = 3). +do !((rcondt {1} ^if; first by move => *; auto => />) || + (rcondf {1} ^if; first by move => *; auto => />)); auto => />. + +case (i{1} = 4). +do !((rcondt {1} ^if; first by move => *; auto => />) || + (rcondf {1} ^if; first by move => *; auto => />)); auto => />. + +case (i{1} = 5). +do !((rcondt {1} ^if; first by move => *; auto => />) || + (rcondf {1} ^if; first by move => *; auto => />)); auto => />. + +case (i{1} = 6). +do !((rcondt {1} ^if; first by move => *; auto => />) || + (rcondf {1} ^if; first by move => *; auto => />)); auto => />. + +case (i{1} = 7). +do !((rcondt {1} ^if; first by move => *; auto => />) || + (rcondf {1} ^if; first by move => *; auto => />)); auto => />. + +case (i{1} = 8). +do !((rcondt {1} ^if; first by move => *; auto => />) || + (rcondf {1} ^if; first by move => *; auto => />)); auto => />. + +case (i{1} = 9). +do !((rcondt {1} ^if; first by move => *; auto => />) || + (rcondf {1} ^if; first by move => *; auto => />)); auto => />. + +case (i{1} = 10). +do !((rcondt {1} ^if; first by move => *; auto => />) || + (rcondf {1} ^if; first by move => *; auto => />)); auto => />. + +case (i{1} = 11). +do !((rcondt {1} ^if; first by move => *; auto => />) || + (rcondf {1} ^if; first by move => *; auto => />)); auto => />. + +case (i{1} = 12). +do !((rcondt {1} ^if; first by move => *; auto => />) || + (rcondf {1} ^if; first by move => *; auto => />)); auto => />. + +case (i{1} = 13). +do !((rcondt {1} ^if; first by move => *; auto => />) || + (rcondf {1} ^if; first by move => *; auto => />)); auto => />. + +case (i{1} = 14). +do !((rcondt {1} ^if; first by move => *; auto => />) || + (rcondf {1} ^if; first by move => *; auto => />)); auto => />. + +case (i{1} = 15). +do !((rcondt {1} ^if; first by move => *; auto => />) || + (rcondf {1} ^if; first by move => *; auto => />)); auto => />. + +case (i{1} = 16). +do !((rcondt {1} ^if; first by move => *; auto => />) || + (rcondf {1} ^if; first by move => *; auto => />)); auto => />. + +case (i{1} = 17). +do !((rcondt {1} ^if; first by move => *; auto => />) || + (rcondf {1} ^if; first by move => *; auto => />)); auto => />. + +case (i{1} = 18). +do !((rcondt {1} ^if; first by move => *; auto => />) || + (rcondf {1} ^if; first by move => *; auto => />)); auto => />. + +case (i{1} = 19). +do !((rcondt {1} ^if; first by move => *; auto => />) || + (rcondf {1} ^if; first by move => *; auto => />)); auto => />. + +case (i{1} = 20). +do !((rcondt {1} ^if; first by move => *; auto => />) || + (rcondf {1} ^if; first by move => *; auto => />)); auto => />. + +case (i{1} = 21). +do !((rcondt {1} ^if; first by move => *; auto => />) || + (rcondf {1} ^if; first by move => *; auto => />)); auto => />. + +case (i{1} = 22). +do !((rcondt {1} ^if; first by move => *; auto => />) || + (rcondf {1} ^if; first by move => *; auto => />)); auto => />. + +case (i{1} = 23). +do !((rcondt {1} ^if; first by move => *; auto => />) || + (rcondf {1} ^if; first by move => *; auto => />)); auto => />. + +case (i{1} = 24). +do !((rcondt {1} ^if; first by move => *; auto => />) || + (rcondf {1} ^if; first by move => *; auto => />)); auto => />. + +by exfalso; smt(). +qed. + +module Mreftable = { + include Mref [-keccakRhoOffsets,rho,keccakP1600_round,permute] + include RhotatesTable + + proc rho (a:W64.t Array25.t) : W64.t Array25.t = { + var aux_1: bool; + var aux_0: bool; + var aux: int; + var aux_2: W64.t; + + var x:int; + var y:int; + var i:int; + var z:int; + var _0:bool; + var _1:bool; + + x <- 0; + while (x < 5) { + y <- 0; + while (y < 5) { + i <@ index (x, y); + z <@ keccakRhoOffsets (i); + (aux_1, aux_0, aux_2) <- x86_ROL_64 a.[i] (W8.of_int z); + _0 <- aux_1; + _1 <- aux_0; + a.[i] <- aux_2; + y <- y + 1; + } + x <- x + 1; + } + return (a); + } + + proc keccakP1600_round (state:W64.t Array25.t, c:W64.t) : W64.t Array25.t = { + state <@ theta (state); + state <@ rho (state); + state <@ pi (state); + state <@ chi (state); + state <@ iota_0 (state, c); + return (state); + } + + proc permute (state:W64.t Array25.t) : W64.t Array25.t = { + var aux: int; + + var constants:W64.t Array24.t; + var round:int; + round <- 0; + constants <@ keccakRoundConstants (); + while (round < 24) { + state <@ keccakP1600_round (state, constants.[round]); + round <- round + 1; + } + return (state); + } + +}. + +lemma ref_reftable : + equiv [ Mref.permute ~ Mreftable.permute : + ={arg,Glob.mem} ==> ={res,Glob.mem} ]. +proc. + +seq 3 2 : (#pre /\ ={constants} /\ ={round}); first by inline*; auto => />. + +while (#post /\ ={round,constants}); last by inline *; auto => />. + +wp. +call (_: true). +call (_: true); first by sim. +call (_: true); first by sim. +call (_: true); first by sim. +call (_: true). +while (#post /\ ={a,x} /\ 0 <= x{1} <= 5). +wp. +while (#post /\ ={a,x,y} /\ 0 <= x{1} <5 /\ 0 <=y{1} <= 5). +wp. +call (rhotates_table_corr). + +call(_: ={arg} /\ 0<=x{1} <5 /\ 0<=y{1} <5 ==> ={res} /\ 0 <= res{1} < 25). +by proc; inline *; auto => />;smt(). + +by auto => />;smt(). +by auto => />;smt(). +by auto => />;smt(). + +call(_:true); first by sim. +by auto => />. +by auto => />. + +qed. diff --git a/proof/impl/perm/keccak_f1600_scalar.ec b/proof/impl/old_perm/keccak_f1600_scalar.ec similarity index 100% rename from proof/impl/perm/keccak_f1600_scalar.ec rename to proof/impl/old_perm/keccak_f1600_scalar.ec diff --git a/proof/impl/perm/keccak_f1600_scalar_table.ec b/proof/impl/old_perm/keccak_f1600_scalar_table.ec similarity index 100% rename from proof/impl/perm/keccak_f1600_scalar_table.ec rename to proof/impl/old_perm/keccak_f1600_scalar_table.ec diff --git a/proof/impl/perm/Array6.ec b/proof/impl/perm/Array6.ec new file mode 100644 index 0000000..d010a15 --- /dev/null +++ b/proof/impl/perm/Array6.ec @@ -0,0 +1,3 @@ +from Jasmin require import JArray. + +clone export PolyArray as Array6 with op size <- 6. diff --git a/proof/impl/perm/keccak_f1600_avx2.ec b/proof/impl/perm/keccak_f1600_avx2.ec index 84e0a08..1a90b52 100644 --- a/proof/impl/perm/keccak_f1600_avx2.ec +++ b/proof/impl/perm/keccak_f1600_avx2.ec @@ -780,3 +780,39 @@ module M = { } }. +require Keccak_f1600_avx2_openssl. + +op flat_state (st : W256.t Array7.t) + (axx : W256.t * W256.t * W256.t * W256.t * W256.t * W256.t * W256.t ) = + st.[0] = axx.`1 /\ + st.[1] = axx.`2 /\ + st.[2] = axx.`3 /\ + st.[3] = axx.`4 /\ + st.[4] = axx.`5 /\ + st.[5] = axx.`6 /\ + st.[6] = axx.`7. + +equiv avx2_avx2_openssl : + Keccak_f1600_avx2_openssl.M.__keccak_f1600_avx2_openssl ~ M.keccak_f1600 : + ={Glob.mem,_rhotates_left,_rhotates_right, _iotas} /\ + flat_state state{2} (arg{1}.`1,arg{1}.`2,arg{1}.`3,arg{1}.`4,arg{1}.`5,arg{1}.`6,arg{1}.`7) ==> + ={Glob.mem} /\ flat_state res{2} res{1}. + proc. + seq 112 112 : (#pre /\ ={zf,iotas,rhotates_left,rhotates_right,t} /\ i{1} = r{2}). + seq 30 30 : (#pre /\ ={d14,t,iotas,rhotates_left,rhotates_right} /\ i{1} = r{2}). + by wp;skip; rewrite /flat_state; auto => />. + seq 30 30 : #pre. + by wp;skip; rewrite /flat_state; auto => />. + seq 30 30 : #pre. + by wp;skip; rewrite /flat_state; auto => />. + by wp;skip; rewrite /flat_state; auto => />. + while (#pre). + seq 30 30 : (#pre /\ ={d14}). + by wp;skip; rewrite /flat_state; auto => />. + seq 30 30 : #pre. + by wp;skip; rewrite /flat_state; auto => />. + seq 30 30 : #pre. + by wp;skip; rewrite /flat_state; auto => />. + by wp;skip; rewrite /flat_state; auto => />. + by auto => />. +qed. diff --git a/proof/impl/perm/keccak_f1600_avx2_openssl.ec b/proof/impl/perm/keccak_f1600_avx2_openssl.ec new file mode 100644 index 0000000..49ff1cb --- /dev/null +++ b/proof/impl/perm/keccak_f1600_avx2_openssl.ec @@ -0,0 +1,347 @@ +require import List Int IntExtra IntDiv CoreMap. +from Jasmin require import JModel. + +require import Array9. +require import WArray288. + + + +module M = { + proc __keccak_f1600_avx2_openssl (a00:W256.t, a01:W256.t, a20:W256.t, + a31:W256.t, a21:W256.t, a41:W256.t, + a11:W256.t, _rhotates_left:W64.t, + _rhotates_right:W64.t, _iotas:W64.t) : + W256.t * W256.t * W256.t * W256.t * W256.t * W256.t * W256.t = { + + var rhotates_left:W64.t; + var rhotates_right:W64.t; + var iotas:W64.t; + var i:W32.t; + var zf:bool; + var c00:W256.t; + var c14:W256.t; + var t:W256.t Array9.t; + var d14:W256.t; + var d00:W256.t; + var _0:bool; + var _1:bool; + var _2:bool; + t <- witness; + rhotates_left <- (_rhotates_left + (W64.of_int 96)); + rhotates_right <- (_rhotates_right + (W64.of_int 96)); + iotas <- _iotas; + i <- (W32.of_int 24); + c00 <- x86_VPSHUFD_256 a20 (W8.of_int 78); + c14 <- (a41 `^` a31); + t.[2] <- (a21 `^` a11); + c14 <- (c14 `^` a01); + c14 <- (c14 `^` t.[2]); + t.[4] <- x86_VPERMQ c14 (W8.of_int 147); + c00 <- (c00 `^` a20); + t.[0] <- x86_VPERMQ c00 (W8.of_int 78); + t.[1] <- (c14 \vshr64u256 (W8.of_int 63)); + t.[2] <- (c14 \vadd64u256 c14); + t.[1] <- (t.[1] `|` t.[2]); + d14 <- x86_VPERMQ t.[1] (W8.of_int 57); + d00 <- (t.[1] `^` t.[4]); + d00 <- x86_VPERMQ d00 (W8.of_int 0); + c00 <- (c00 `^` a00); + c00 <- (c00 `^` t.[0]); + t.[0] <- (c00 \vshr64u256 (W8.of_int 63)); + t.[1] <- (c00 \vadd64u256 c00); + t.[1] <- (t.[1] `|` t.[0]); + a20 <- (a20 `^` d00); + a00 <- (a00 `^` d00); + d14 <- x86_VPBLENDD_256 d14 t.[1] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + t.[4] <- x86_VPBLENDD_256 t.[4] c00 + (W8.of_int (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + d14 <- (d14 `^` t.[4]); + t.[3] <- x86_VPSLLV_4u64 a20 + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((0 * 32) - 96))))); + a20 <- x86_VPSRLV_4u64 a20 + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((0 * 32) - 96))))); + a20 <- (a20 `|` t.[3]); + a31 <- (a31 `^` d14); + t.[4] <- x86_VPSLLV_4u64 a31 + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((2 * 32) - 96))))); + a31 <- x86_VPSRLV_4u64 a31 + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((2 * 32) - 96))))); + a31 <- (a31 `|` t.[4]); + a21 <- (a21 `^` d14); + t.[5] <- x86_VPSLLV_4u64 a21 + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((3 * 32) - 96))))); + a21 <- x86_VPSRLV_4u64 a21 + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((3 * 32) - 96))))); + a21 <- (a21 `|` t.[5]); + a41 <- (a41 `^` d14); + t.[6] <- x86_VPSLLV_4u64 a41 + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((4 * 32) - 96))))); + a41 <- x86_VPSRLV_4u64 a41 + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((4 * 32) - 96))))); + a41 <- (a41 `|` t.[6]); + a11 <- (a11 `^` d14); + t.[3] <- x86_VPERMQ a20 (W8.of_int 141); + t.[4] <- x86_VPERMQ a31 (W8.of_int 141); + t.[7] <- x86_VPSLLV_4u64 a11 + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((5 * 32) - 96))))); + t.[1] <- x86_VPSRLV_4u64 a11 + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((5 * 32) - 96))))); + t.[1] <- (t.[1] `|` t.[7]); + a01 <- (a01 `^` d14); + t.[5] <- x86_VPERMQ a21 (W8.of_int 27); + t.[6] <- x86_VPERMQ a41 (W8.of_int 114); + t.[8] <- x86_VPSLLV_4u64 a01 + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((1 * 32) - 96))))); + t.[2] <- x86_VPSRLV_4u64 a01 + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((1 * 32) - 96))))); + t.[2] <- (t.[2] `|` t.[8]); + t.[7] <- x86_VPSRLDQ_256 t.[1] (W8.of_int 8); + t.[0] <- ((invw t.[1]) `&` t.[7]); + a31 <- x86_VPBLENDD_256 t.[2] t.[6] + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + t.[8] <- x86_VPBLENDD_256 t.[4] t.[2] + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + a41 <- x86_VPBLENDD_256 t.[3] t.[4] + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + t.[7] <- x86_VPBLENDD_256 t.[2] t.[3] + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + a31 <- x86_VPBLENDD_256 a31 t.[4] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + t.[8] <- x86_VPBLENDD_256 t.[8] t.[5] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + a41 <- x86_VPBLENDD_256 a41 t.[2] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + t.[7] <- x86_VPBLENDD_256 t.[7] t.[6] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + a31 <- x86_VPBLENDD_256 a31 t.[5] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + t.[8] <- x86_VPBLENDD_256 t.[8] t.[6] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + a41 <- x86_VPBLENDD_256 a41 t.[6] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + t.[7] <- x86_VPBLENDD_256 t.[7] t.[4] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + a31 <- x86_VPANDN_256 a31 t.[8]; + a41 <- x86_VPANDN_256 a41 t.[7]; + a11 <- x86_VPBLENDD_256 t.[5] t.[2] + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + t.[8] <- x86_VPBLENDD_256 t.[3] t.[5] + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + a31 <- (a31 `^` t.[3]); + a11 <- x86_VPBLENDD_256 a11 t.[3] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + t.[8] <- x86_VPBLENDD_256 t.[8] t.[4] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + a41 <- (a41 `^` t.[5]); + a11 <- x86_VPBLENDD_256 a11 t.[4] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + t.[8] <- x86_VPBLENDD_256 t.[8] t.[2] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + a11 <- x86_VPANDN_256 a11 t.[8]; + a11 <- (a11 `^` t.[6]); + a21 <- x86_VPERMQ t.[1] (W8.of_int 30); + t.[8] <- x86_VPBLENDD_256 a21 a00 + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + a01 <- x86_VPERMQ t.[1] (W8.of_int 57); + a01 <- x86_VPBLENDD_256 a01 a00 + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + a01 <- x86_VPANDN_256 a01 t.[8]; + a20 <- x86_VPBLENDD_256 t.[4] t.[5] + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + t.[7] <- x86_VPBLENDD_256 t.[6] t.[4] + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + a20 <- x86_VPBLENDD_256 a20 t.[6] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + t.[7] <- x86_VPBLENDD_256 t.[7] t.[3] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + a20 <- x86_VPBLENDD_256 a20 t.[3] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + t.[7] <- x86_VPBLENDD_256 t.[7] t.[5] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + a20 <- x86_VPANDN_256 a20 t.[7]; + a20 <- (a20 `^` t.[2]); + t.[0] <- x86_VPERMQ t.[0] (W8.of_int 0); + a31 <- x86_VPERMQ a31 (W8.of_int 27); + a41 <- x86_VPERMQ a41 (W8.of_int 141); + a11 <- x86_VPERMQ a11 (W8.of_int 114); + a21 <- x86_VPBLENDD_256 t.[6] t.[3] + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + t.[7] <- x86_VPBLENDD_256 t.[5] t.[6] + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + a21 <- x86_VPBLENDD_256 a21 t.[5] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + t.[7] <- x86_VPBLENDD_256 t.[7] t.[2] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + a21 <- x86_VPBLENDD_256 a21 t.[2] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + t.[7] <- x86_VPBLENDD_256 t.[7] t.[3] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + a21 <- x86_VPANDN_256 a21 t.[7]; + a00 <- (a00 `^` t.[0]); + a01 <- (a01 `^` t.[1]); + a21 <- (a21 `^` t.[4]); + a00 <- + (a00 `^` (loadW256 Glob.mem (W64.to_uint (iotas + (W64.of_int 0))))); + iotas <- (iotas + (W64.of_int 32)); + ( _0, _1, _2, zf, i) <- x86_DEC_32 i; + while ((! zf)) { + c00 <- x86_VPSHUFD_256 a20 (W8.of_int 78); + c14 <- (a41 `^` a31); + t.[2] <- (a21 `^` a11); + c14 <- (c14 `^` a01); + c14 <- (c14 `^` t.[2]); + t.[4] <- x86_VPERMQ c14 (W8.of_int 147); + c00 <- (c00 `^` a20); + t.[0] <- x86_VPERMQ c00 (W8.of_int 78); + t.[1] <- (c14 \vshr64u256 (W8.of_int 63)); + t.[2] <- (c14 \vadd64u256 c14); + t.[1] <- (t.[1] `|` t.[2]); + d14 <- x86_VPERMQ t.[1] (W8.of_int 57); + d00 <- (t.[1] `^` t.[4]); + d00 <- x86_VPERMQ d00 (W8.of_int 0); + c00 <- (c00 `^` a00); + c00 <- (c00 `^` t.[0]); + t.[0] <- (c00 \vshr64u256 (W8.of_int 63)); + t.[1] <- (c00 \vadd64u256 c00); + t.[1] <- (t.[1] `|` t.[0]); + a20 <- (a20 `^` d00); + a00 <- (a00 `^` d00); + d14 <- x86_VPBLENDD_256 d14 t.[1] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + t.[4] <- x86_VPBLENDD_256 t.[4] c00 + (W8.of_int (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + d14 <- (d14 `^` t.[4]); + t.[3] <- x86_VPSLLV_4u64 a20 + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((0 * 32) - 96))))); + a20 <- x86_VPSRLV_4u64 a20 + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((0 * 32) - 96))))); + a20 <- (a20 `|` t.[3]); + a31 <- (a31 `^` d14); + t.[4] <- x86_VPSLLV_4u64 a31 + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((2 * 32) - 96))))); + a31 <- x86_VPSRLV_4u64 a31 + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((2 * 32) - 96))))); + a31 <- (a31 `|` t.[4]); + a21 <- (a21 `^` d14); + t.[5] <- x86_VPSLLV_4u64 a21 + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((3 * 32) - 96))))); + a21 <- x86_VPSRLV_4u64 a21 + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((3 * 32) - 96))))); + a21 <- (a21 `|` t.[5]); + a41 <- (a41 `^` d14); + t.[6] <- x86_VPSLLV_4u64 a41 + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((4 * 32) - 96))))); + a41 <- x86_VPSRLV_4u64 a41 + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((4 * 32) - 96))))); + a41 <- (a41 `|` t.[6]); + a11 <- (a11 `^` d14); + t.[3] <- x86_VPERMQ a20 (W8.of_int 141); + t.[4] <- x86_VPERMQ a31 (W8.of_int 141); + t.[7] <- x86_VPSLLV_4u64 a11 + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((5 * 32) - 96))))); + t.[1] <- x86_VPSRLV_4u64 a11 + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((5 * 32) - 96))))); + t.[1] <- (t.[1] `|` t.[7]); + a01 <- (a01 `^` d14); + t.[5] <- x86_VPERMQ a21 (W8.of_int 27); + t.[6] <- x86_VPERMQ a41 (W8.of_int 114); + t.[8] <- x86_VPSLLV_4u64 a01 + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((1 * 32) - 96))))); + t.[2] <- x86_VPSRLV_4u64 a01 + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((1 * 32) - 96))))); + t.[2] <- (t.[2] `|` t.[8]); + t.[7] <- x86_VPSRLDQ_256 t.[1] (W8.of_int 8); + t.[0] <- ((invw t.[1]) `&` t.[7]); + a31 <- x86_VPBLENDD_256 t.[2] t.[6] + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + t.[8] <- x86_VPBLENDD_256 t.[4] t.[2] + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + a41 <- x86_VPBLENDD_256 t.[3] t.[4] + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + t.[7] <- x86_VPBLENDD_256 t.[2] t.[3] + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + a31 <- x86_VPBLENDD_256 a31 t.[4] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + t.[8] <- x86_VPBLENDD_256 t.[8] t.[5] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + a41 <- x86_VPBLENDD_256 a41 t.[2] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + t.[7] <- x86_VPBLENDD_256 t.[7] t.[6] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + a31 <- x86_VPBLENDD_256 a31 t.[5] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + t.[8] <- x86_VPBLENDD_256 t.[8] t.[6] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + a41 <- x86_VPBLENDD_256 a41 t.[6] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + t.[7] <- x86_VPBLENDD_256 t.[7] t.[4] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + a31 <- x86_VPANDN_256 a31 t.[8]; + a41 <- x86_VPANDN_256 a41 t.[7]; + a11 <- x86_VPBLENDD_256 t.[5] t.[2] + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + t.[8] <- x86_VPBLENDD_256 t.[3] t.[5] + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + a31 <- (a31 `^` t.[3]); + a11 <- x86_VPBLENDD_256 a11 t.[3] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + t.[8] <- x86_VPBLENDD_256 t.[8] t.[4] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + a41 <- (a41 `^` t.[5]); + a11 <- x86_VPBLENDD_256 a11 t.[4] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + t.[8] <- x86_VPBLENDD_256 t.[8] t.[2] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + a11 <- x86_VPANDN_256 a11 t.[8]; + a11 <- (a11 `^` t.[6]); + a21 <- x86_VPERMQ t.[1] (W8.of_int 30); + t.[8] <- x86_VPBLENDD_256 a21 a00 + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + a01 <- x86_VPERMQ t.[1] (W8.of_int 57); + a01 <- x86_VPBLENDD_256 a01 a00 + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + a01 <- x86_VPANDN_256 a01 t.[8]; + a20 <- x86_VPBLENDD_256 t.[4] t.[5] + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + t.[7] <- x86_VPBLENDD_256 t.[6] t.[4] + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + a20 <- x86_VPBLENDD_256 a20 t.[6] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + t.[7] <- x86_VPBLENDD_256 t.[7] t.[3] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + a20 <- x86_VPBLENDD_256 a20 t.[3] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + t.[7] <- x86_VPBLENDD_256 t.[7] t.[5] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + a20 <- x86_VPANDN_256 a20 t.[7]; + a20 <- (a20 `^` t.[2]); + t.[0] <- x86_VPERMQ t.[0] (W8.of_int 0); + a31 <- x86_VPERMQ a31 (W8.of_int 27); + a41 <- x86_VPERMQ a41 (W8.of_int 141); + a11 <- x86_VPERMQ a11 (W8.of_int 114); + a21 <- x86_VPBLENDD_256 t.[6] t.[3] + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + t.[7] <- x86_VPBLENDD_256 t.[5] t.[6] + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + a21 <- x86_VPBLENDD_256 a21 t.[5] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + t.[7] <- x86_VPBLENDD_256 t.[7] t.[2] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + a21 <- x86_VPBLENDD_256 a21 t.[2] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + t.[7] <- x86_VPBLENDD_256 t.[7] t.[3] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); + a21 <- x86_VPANDN_256 a21 t.[7]; + a00 <- (a00 `^` t.[0]); + a01 <- (a01 `^` t.[1]); + a21 <- (a21 `^` t.[4]); + a00 <- + (a00 `^` (loadW256 Glob.mem (W64.to_uint (iotas + (W64.of_int 0))))); + iotas <- (iotas + (W64.of_int 32)); + ( _0, _1, _2, zf, i) <- x86_DEC_32 i; + } + return (a00, a01, a20, a31, a21, a41, a11); + } +}. + diff --git a/proof/impl/perm/keccak_f1600_avx2_prevec.ec b/proof/impl/perm/keccak_f1600_avx2_prevec.ec index e2d8605..fe8e56b 100644 --- a/proof/impl/perm/keccak_f1600_avx2_prevec.ec +++ b/proof/impl/perm/keccak_f1600_avx2_prevec.ec @@ -5,7 +5,7 @@ require import Array4 Array9 Array24 Array25 Array96. require import WArray288. require import Keccak_f1600_ref_table. -require import Keccak_f1600_ref. +require import Keccak_f1600_ref_op. import Ops. op lift2array(x : W256.t) : W64.t Array4.t = @@ -60,8 +60,8 @@ op good_iotas4x : W64.t Array96.t = ( module Mavx2_prevec = { - proc __KeccakF1600 (_A00:W64.t Array4.t, _A01:W64.t Array4.t, _A20:W64.t Array4.t, _A31:W64.t Array4.t, - _A21:W64.t Array4.t, _A41:W64.t Array4.t, _A11:W64.t Array4.t, + proc __KeccakF1600 (a00:W64.t Array4.t, a01:W64.t Array4.t, a20:W64.t Array4.t, a31:W64.t Array4.t, + a21:W64.t Array4.t, a41:W64.t Array4.t, a11:W64.t Array4.t, _rhotates_left:W64.t, _rhotates_right:W64.t, _iotas:W64.t) : W64.t Array4.t * W64.t Array4.t * W64.t Array4.t * W64.t Array4.t * W64.t Array4.t * W64.t Array4.t * W64.t Array4.t = { @@ -71,362 +71,362 @@ module Mavx2_prevec = { var iotas:W64.t; var i:W32.t; var zf:bool; - var _C00:W64.t Array4.t; - var _C14:W64.t Array4.t; - var _T:W64.t Array4.t Array9.t; - var _D14:W64.t Array4.t; - var _D00:W64.t Array4.t; + var c00:W64.t Array4.t; + var c14:W64.t Array4.t; + var t:W64.t Array4.t Array9.t; + var d14:W64.t Array4.t; + var d00:W64.t Array4.t; var _0:bool; var _1:bool; var _2:bool; - _T <- witness; + t <- witness; rhotates_left <- (_rhotates_left + (W64.of_int 96)); rhotates_right <- (_rhotates_right + (W64.of_int 96)); iotas <- _iotas; i <- (W32.of_int 24); - _C00 <@ Ops.iVPSHUFD_256(_A20,(W8.of_int 78)); - _C14 <@ Ops.ilxor4u64(_A41,_A31); - _T.[2] <@ Ops.ilxor4u64(_A21,_A11); - _C14 <@ Ops.ilxor4u64(_C14,_A01); - _C14 <@ Ops.ilxor4u64(_C14,_T.[2]); - _T.[4] <- Ops.iVPERMQ(_C14,(W8.of_int 147)); - _C00 <@ Ops.ilxor4u64(_C00,_A20); - _T.[0] <- Ops.iVPERMQ(_C00,(W8.of_int 78)); - _T.[1] <- Ops.ivshr64u256(_C14, (W8.of_int 63)); - _T.[2] <- Ops.ivadd64u256(_C14, _C14); - _T.[1] <@ Ops.ilor4u64(_T.[1],_T.[2]); - _D14 <- Ops.iVPERMQ(_T.[1],(W8.of_int 57)); - _D00 <@ Ops.ilxor4u64(_T.[1],_T.[4]); - _D00 <- Ops.iVPERMQ(_D00,(W8.of_int 0)); - _C00 <@ Ops.ilxor4u64(_C00,_A00); - _C00 <@ Ops.ilxor4u64(_C00,_T.[0]); - _T.[0] <- Ops.ivshr64u256(_C00, (W8.of_int 63)); - _T.[1] <- Ops.ivadd64u256(_C00, _C00); - _T.[1] <@ Ops.ilor4u64(_T.[1],_T.[0]); - _A20 <@ Ops.ilxor4u64(_A20,_D00); - _A00 <@ Ops.ilxor4u64(_A00,_D00); - _D14 <- Ops.iVPBLENDD_256(_D14,_T.[1], + c00 <@ Ops.iVPSHUFD_256(a20,(W8.of_int 78)); + c14 <@ Ops.ilxor4u64(a41,a31); + t.[2] <@ Ops.ilxor4u64(a21,a11); + c14 <@ Ops.ilxor4u64(c14,a01); + c14 <@ Ops.ilxor4u64(c14,t.[2]); + t.[4] <- Ops.iVPERMQ(c14,(W8.of_int 147)); + c00 <@ Ops.ilxor4u64(c00,a20); + t.[0] <- Ops.iVPERMQ(c00,(W8.of_int 78)); + t.[1] <- Ops.ivshr64u256(c14, (W8.of_int 63)); + t.[2] <- Ops.ivadd64u256(c14, c14); + t.[1] <@ Ops.ilor4u64(t.[1],t.[2]); + d14 <- Ops.iVPERMQ(t.[1],(W8.of_int 57)); + d00 <@ Ops.ilxor4u64(t.[1],t.[4]); + d00 <- Ops.iVPERMQ(d00,(W8.of_int 0)); + c00 <@ Ops.ilxor4u64(c00,a00); + c00 <@ Ops.ilxor4u64(c00,t.[0]); + t.[0] <- Ops.ivshr64u256(c00, (W8.of_int 63)); + t.[1] <- Ops.ivadd64u256(c00, c00); + t.[1] <@ Ops.ilor4u64(t.[1],t.[0]); + a20 <@ Ops.ilxor4u64(a20,d00); + a00 <@ Ops.ilxor4u64(a00,d00); + d14 <- Ops.iVPBLENDD_256(d14,t.[1], (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); - _T.[4] <- Ops.iVPBLENDD_256(_T.[4],_C00, + t.[4] <- Ops.iVPBLENDD_256(t.[4],c00, (W8.of_int (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); - _D14 <@ Ops.ilxor4u64(_D14,_T.[4]); - _T.[3] <@ Ops.iVPSLLV_4u64(_A20, lift2array + d14 <@ Ops.ilxor4u64(d14,t.[4]); + t.[3] <@ Ops.iVPSLLV_4u64(a20, lift2array (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((0 * 32) - 96)))))); - _A20 <@ Ops.iVPSRLV_4u64(_A20, lift2array + a20 <@ Ops.iVPSRLV_4u64(a20, lift2array (loadW256 Glob.mem (W64.to_uint (rhotates_right+ (W64.of_int ((0 * 32) - 96)))))); - _A20 <@ Ops.ilor4u64(_A20,_T.[3]); - _A31 <@ Ops.ilxor4u64(_A31,_D14); - _T.[4] <@ Ops.iVPSLLV_4u64(_A31, lift2array + a20 <@ Ops.ilor4u64(a20,t.[3]); + a31 <@ Ops.ilxor4u64(a31,d14); + t.[4] <@ Ops.iVPSLLV_4u64(a31, lift2array (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((2 * 32) - 96)))))); - _A31 <@ Ops.iVPSRLV_4u64(_A31, lift2array + a31 <@ Ops.iVPSRLV_4u64(a31, lift2array (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((2 * 32) - 96)))))); - _A31 <@ Ops.ilor4u64(_A31,_T.[4]); - _A21 <@ Ops.ilxor4u64(_A21,_D14); - _T.[5] <@ Ops.iVPSLLV_4u64(_A21, lift2array + a31 <@ Ops.ilor4u64(a31,t.[4]); + a21 <@ Ops.ilxor4u64(a21,d14); + t.[5] <@ Ops.iVPSLLV_4u64(a21, lift2array (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((3 * 32) - 96)))))); - _A21 <@ Ops.iVPSRLV_4u64(_A21, lift2array + a21 <@ Ops.iVPSRLV_4u64(a21, lift2array (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((3 * 32) - 96)))))); - _A21 <@ Ops.ilor4u64(_A21,_T.[5]); - _A41 <@ Ops.ilxor4u64(_A41,_D14); - _T.[6] <@ Ops.iVPSLLV_4u64(_A41, lift2array + a21 <@ Ops.ilor4u64(a21,t.[5]); + a41 <@ Ops.ilxor4u64(a41,d14); + t.[6] <@ Ops.iVPSLLV_4u64(a41, lift2array (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((4 * 32) - 96)))))); - _A41 <@ Ops.iVPSRLV_4u64(_A41, lift2array + a41 <@ Ops.iVPSRLV_4u64(a41, lift2array (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((4 * 32) - 96)))))); - _A41 <@ Ops.ilor4u64(_A41,_T.[6]); - _A11 <@ Ops.ilxor4u64(_A11,_D14); - _T.[3] <- Ops.iVPERMQ(_A20,(W8.of_int 141)); - _T.[4] <- Ops.iVPERMQ(_A31,(W8.of_int 141)); - _T.[7] <@ Ops.iVPSLLV_4u64(_A11, lift2array + a41 <@ Ops.ilor4u64(a41,t.[6]); + a11 <@ Ops.ilxor4u64(a11,d14); + t.[3] <- Ops.iVPERMQ(a20,(W8.of_int 141)); + t.[4] <- Ops.iVPERMQ(a31,(W8.of_int 141)); + t.[7] <@ Ops.iVPSLLV_4u64(a11, lift2array (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((5 * 32) - 96)))))); - _T.[1] <@ Ops.iVPSRLV_4u64(_A11, lift2array + t.[1] <@ Ops.iVPSRLV_4u64(a11, lift2array (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((5 * 32) - 96)))))); - _T.[1] <@ Ops.ilor4u64(_T.[1],_T.[7]); - _A01 <@ Ops.ilxor4u64(_A01,_D14); - _T.[5] <- Ops.iVPERMQ(_A21,(W8.of_int 27)); - _T.[6] <- Ops.iVPERMQ(_A41,(W8.of_int 114)); - _T.[8] <@ Ops.iVPSLLV_4u64(_A01, lift2array + t.[1] <@ Ops.ilor4u64(t.[1],t.[7]); + a01 <@ Ops.ilxor4u64(a01,d14); + t.[5] <- Ops.iVPERMQ(a21,(W8.of_int 27)); + t.[6] <- Ops.iVPERMQ(a41,(W8.of_int 114)); + t.[8] <@ Ops.iVPSLLV_4u64(a01, lift2array (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((1 * 32) - 96)))))); - _T.[2] <@ Ops.iVPSRLV_4u64(_A01, lift2array + t.[2] <@ Ops.iVPSRLV_4u64(a01, lift2array (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((1 * 32) - 96)))))); - _T.[2] <@ Ops.ilor4u64(_T.[2],_T.[8]); - _T.[7] <@ Ops.iVPSRLDQ_256(_T.[1],(W8.of_int 8)); - _T.[0] <@ Ops.ilandn4u64(_T.[1],_T.[7]); - _A31 <@ Ops.iVPBLENDD_256(_T.[2],_T.[6], + t.[2] <@ Ops.ilor4u64(t.[2],t.[8]); + t.[7] <@ Ops.iVPSRLDQ_256(t.[1],(W8.of_int 8)); + t.[0] <@ Ops.ilandn4u64(t.[1],t.[7]); + a31 <@ Ops.iVPBLENDD_256(t.[2],t.[6], (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); - _T.[8] <@ Ops.iVPBLENDD_256(_T.[4],_T.[2], + t.[8] <@ Ops.iVPBLENDD_256(t.[4],t.[2], (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); - _A41 <@ Ops.iVPBLENDD_256(_T.[3], _T.[4], + a41 <@ Ops.iVPBLENDD_256(t.[3], t.[4], (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); - _T.[7] <@ Ops.iVPBLENDD_256(_T.[2], _T.[3], + t.[7] <@ Ops.iVPBLENDD_256(t.[2], t.[3], (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); - _A31 <@ Ops.iVPBLENDD_256(_A31 ,_T.[4], + a31 <@ Ops.iVPBLENDD_256(a31 ,t.[4], (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); - _T.[8] <@ Ops.iVPBLENDD_256(_T.[8], _T.[5], + t.[8] <@ Ops.iVPBLENDD_256(t.[8], t.[5], (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); - _A41 <@ Ops.iVPBLENDD_256(_A41, _T.[2], + a41 <@ Ops.iVPBLENDD_256(a41, t.[2], (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); - _T.[7] <@ Ops.iVPBLENDD_256(_T.[7], _T.[6], + t.[7] <@ Ops.iVPBLENDD_256(t.[7], t.[6], (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); - _A31 <@ Ops.iVPBLENDD_256(_A31, _T.[5], + a31 <@ Ops.iVPBLENDD_256(a31, t.[5], (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); - _T.[8] <@ Ops.iVPBLENDD_256(_T.[8], _T.[6], + t.[8] <@ Ops.iVPBLENDD_256(t.[8], t.[6], (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); - _A41 <@ Ops.iVPBLENDD_256(_A41, _T.[6], + a41 <@ Ops.iVPBLENDD_256(a41, t.[6], (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); - _T.[7] <@ Ops.iVPBLENDD_256(_T.[7], _T.[4], + t.[7] <@ Ops.iVPBLENDD_256(t.[7], t.[4], (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); - _A31 <@ Ops.ilandn4u64(_A31,_T.[8]); - _A41 <@ Ops.ilandn4u64(_A41,_T.[7]); - _A11 <@ Ops.iVPBLENDD_256(_T.[5],_T.[2], + a31 <@ Ops.ilandn4u64(a31,t.[8]); + a41 <@ Ops.ilandn4u64(a41,t.[7]); + a11 <@ Ops.iVPBLENDD_256(t.[5],t.[2], (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); - _T.[8] <@ Ops.iVPBLENDD_256(_T.[3], _T.[5], + t.[8] <@ Ops.iVPBLENDD_256(t.[3], t.[5], (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); - _A31 <@ Ops.ilxor4u64(_A31,_T.[3]); - _A11 <@ Ops.iVPBLENDD_256(_A11,_T.[3], + a31 <@ Ops.ilxor4u64(a31,t.[3]); + a11 <@ Ops.iVPBLENDD_256(a11,t.[3], (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); - _T.[8] <@ Ops.iVPBLENDD_256(_T.[8],_T.[4], + t.[8] <@ Ops.iVPBLENDD_256(t.[8],t.[4], (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); - _A41 <@ Ops.ilxor4u64(_A41,_T.[5]); - _A11 <@ Ops.iVPBLENDD_256(_A11, _T.[4], + a41 <@ Ops.ilxor4u64(a41,t.[5]); + a11 <@ Ops.iVPBLENDD_256(a11, t.[4], (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); - _T.[8] <@ Ops.iVPBLENDD_256(_T.[8], _T.[2], + t.[8] <@ Ops.iVPBLENDD_256(t.[8], t.[2], (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); - _A11 <@ Ops.ilandn4u64(_A11,_T.[8]); - _A11 <@ Ops.ilxor4u64(_A11,_T.[6]); - _A21 <@ Ops.iVPERMQ(_T.[1],(W8.of_int 30)); - _T.[8] <@ Ops.iVPBLENDD_256(_A21, _A00, + a11 <@ Ops.ilandn4u64(a11,t.[8]); + a11 <@ Ops.ilxor4u64(a11,t.[6]); + a21 <@ Ops.iVPERMQ(t.[1],(W8.of_int 30)); + t.[8] <@ Ops.iVPBLENDD_256(a21, a00, (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); - _A01 <@ Ops.iVPERMQ(_T.[1],(W8.of_int 57)); - _A01 <@ Ops.iVPBLENDD_256(_A01, _A00, + a01 <@ Ops.iVPERMQ(t.[1],(W8.of_int 57)); + a01 <@ Ops.iVPBLENDD_256(a01, a00, (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); - _A01 <@ Ops.ilandn4u64(_A01,_T.[8]); - _A20 <@ Ops.iVPBLENDD_256(_T.[4], _T.[5], + a01 <@ Ops.ilandn4u64(a01,t.[8]); + a20 <@ Ops.iVPBLENDD_256(t.[4], t.[5], (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); - _T.[7] <@ Ops.iVPBLENDD_256(_T.[6], _T.[4], + t.[7] <@ Ops.iVPBLENDD_256(t.[6], t.[4], (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); - _A20 <@ Ops.iVPBLENDD_256(_A20, _T.[6], + a20 <@ Ops.iVPBLENDD_256(a20, t.[6], (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); - _T.[7] <@ Ops.iVPBLENDD_256(_T.[7], _T.[3], + t.[7] <@ Ops.iVPBLENDD_256(t.[7], t.[3], (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); - _A20 <@ Ops.iVPBLENDD_256(_A20, _T.[3], + a20 <@ Ops.iVPBLENDD_256(a20, t.[3], (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); - _T.[7] <@ Ops.iVPBLENDD_256(_T.[7], _T.[5], + t.[7] <@ Ops.iVPBLENDD_256(t.[7], t.[5], (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); - _A20 <@ Ops.ilandn4u64(_A20,_T.[7]); - _A20 <@ Ops.ilxor4u64(_A20,_T.[2]); - _T.[0] <@ Ops.iVPERMQ(_T.[0],(W8.of_int 0)); - _A31 <@ Ops.iVPERMQ(_A31,(W8.of_int 27)); - _A41 <@ Ops.iVPERMQ(_A41,(W8.of_int 141)); - _A11 <@ Ops.iVPERMQ(_A11,(W8.of_int 114)); - _A21 <@ Ops.iVPBLENDD_256(_T.[6], _T.[3], + a20 <@ Ops.ilandn4u64(a20,t.[7]); + a20 <@ Ops.ilxor4u64(a20,t.[2]); + t.[0] <@ Ops.iVPERMQ(t.[0],(W8.of_int 0)); + a31 <@ Ops.iVPERMQ(a31,(W8.of_int 27)); + a41 <@ Ops.iVPERMQ(a41,(W8.of_int 141)); + a11 <@ Ops.iVPERMQ(a11,(W8.of_int 114)); + a21 <@ Ops.iVPBLENDD_256(t.[6], t.[3], (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); - _T.[7] <@ Ops.iVPBLENDD_256(_T.[5], _T.[6], + t.[7] <@ Ops.iVPBLENDD_256(t.[5], t.[6], (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); - _A21 <@ Ops.iVPBLENDD_256(_A21, _T.[5], + a21 <@ Ops.iVPBLENDD_256(a21, t.[5], (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); - _T.[7] <@ Ops.iVPBLENDD_256(_T.[7], _T.[2], + t.[7] <@ Ops.iVPBLENDD_256(t.[7], t.[2], (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); - _A21 <@ Ops.iVPBLENDD_256(_A21, _T.[2], + a21 <@ Ops.iVPBLENDD_256(a21, t.[2], (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); - _T.[7] <@ Ops.iVPBLENDD_256(_T.[7], _T.[3], + t.[7] <@ Ops.iVPBLENDD_256(t.[7], t.[3], (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); - _A21 <@ Ops.ilandn4u64(_A21,_T.[7]); - _A00 <@ Ops.ilxor4u64(_A00,_T.[0]); - _A01 <@ Ops.ilxor4u64(_A01,_T.[1]); - _A21 <@ Ops.ilxor4u64(_A21,_T.[4]); - _A00 <@ Ops.ilxor4u64(_A00, lift2array + a21 <@ Ops.ilandn4u64(a21,t.[7]); + a00 <@ Ops.ilxor4u64(a00,t.[0]); + a01 <@ Ops.ilxor4u64(a01,t.[1]); + a21 <@ Ops.ilxor4u64(a21,t.[4]); + a00 <@ Ops.ilxor4u64(a00, lift2array (loadW256 Glob.mem (W64.to_uint (iotas + (W64.of_int 0))))); iotas <- (iotas + (W64.of_int 32)); ( _0, _1, _2, zf, i) <- x86_DEC_32 i; while ((! zf)) { - _C00 <@ Ops.iVPSHUFD_256(_A20,(W8.of_int 78)); - _C14 <@ Ops.ilxor4u64(_A41,_A31); - _T.[2] <@ Ops.ilxor4u64(_A21,_A11); - _C14 <@ Ops.ilxor4u64(_C14,_A01); - _C14 <@ Ops.ilxor4u64(_C14,_T.[2]); - _T.[4] <@ Ops.iVPERMQ(_C14,(W8.of_int 147)); - _C00 <@ Ops.ilxor4u64(_C00,_A20); - _T.[0] <@ Ops.iVPERMQ(_C00,(W8.of_int 78)); - _T.[1] <@ Ops.ivshr64u256(_C14, (W8.of_int 63)); - _T.[2] <@ Ops.ivadd64u256(_C14, _C14); - _T.[1] <@ Ops.ilor4u64(_T.[1],_T.[2]); - _D14 <@ Ops.iVPERMQ(_T.[1],(W8.of_int 57)); - _D00 <@ Ops.ilxor4u64(_T.[1],_T.[4]); - _D00 <@ Ops.iVPERMQ(_D00,(W8.of_int 0)); - _C00 <@ Ops.ilxor4u64(_C00,_A00); - _C00 <@ Ops.ilxor4u64(_C00,_T.[0]); - _T.[0] <@ Ops.ivshr64u256(_C00, (W8.of_int 63)); - _T.[1] <@ Ops.ivadd64u256(_C00, _C00); - _T.[1] <@ Ops.ilor4u64(_T.[1],_T.[0]); - _A20 <@ Ops.ilxor4u64(_A20,_D00); - _A00 <@ Ops.ilxor4u64(_A00,_D00); - _D14 <@ Ops.iVPBLENDD_256(_D14,_T.[1], + c00 <@ Ops.iVPSHUFD_256(a20,(W8.of_int 78)); + c14 <@ Ops.ilxor4u64(a41,a31); + t.[2] <@ Ops.ilxor4u64(a21,a11); + c14 <@ Ops.ilxor4u64(c14,a01); + c14 <@ Ops.ilxor4u64(c14,t.[2]); + t.[4] <@ Ops.iVPERMQ(c14,(W8.of_int 147)); + c00 <@ Ops.ilxor4u64(c00,a20); + t.[0] <@ Ops.iVPERMQ(c00,(W8.of_int 78)); + t.[1] <@ Ops.ivshr64u256(c14, (W8.of_int 63)); + t.[2] <@ Ops.ivadd64u256(c14, c14); + t.[1] <@ Ops.ilor4u64(t.[1],t.[2]); + d14 <@ Ops.iVPERMQ(t.[1],(W8.of_int 57)); + d00 <@ Ops.ilxor4u64(t.[1],t.[4]); + d00 <@ Ops.iVPERMQ(d00,(W8.of_int 0)); + c00 <@ Ops.ilxor4u64(c00,a00); + c00 <@ Ops.ilxor4u64(c00,t.[0]); + t.[0] <@ Ops.ivshr64u256(c00, (W8.of_int 63)); + t.[1] <@ Ops.ivadd64u256(c00, c00); + t.[1] <@ Ops.ilor4u64(t.[1],t.[0]); + a20 <@ Ops.ilxor4u64(a20,d00); + a00 <@ Ops.ilxor4u64(a00,d00); + d14 <@ Ops.iVPBLENDD_256(d14,t.[1], (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); - _T.[4] <@ Ops.iVPBLENDD_256(_T.[4],_C00, + t.[4] <@ Ops.iVPBLENDD_256(t.[4],c00, (W8.of_int (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); - _D14 <@ Ops.ilxor4u64(_D14,_T.[4]); - _T.[3] <@ Ops.iVPSLLV_4u64(_A20, lift2array + d14 <@ Ops.ilxor4u64(d14,t.[4]); + t.[3] <@ Ops.iVPSLLV_4u64(a20, lift2array (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((0 * 32) - 96)))))); - _A20 <@ Ops.iVPSRLV_4u64(_A20, lift2array + a20 <@ Ops.iVPSRLV_4u64(a20, lift2array (loadW256 Glob.mem (W64.to_uint (rhotates_right+ (W64.of_int ((0 * 32) - 96)))))); - _A20 <@ Ops.ilor4u64(_A20,_T.[3]); - _A31 <@ Ops.ilxor4u64(_A31,_D14); - _T.[4] <@ Ops.iVPSLLV_4u64(_A31, lift2array + a20 <@ Ops.ilor4u64(a20,t.[3]); + a31 <@ Ops.ilxor4u64(a31,d14); + t.[4] <@ Ops.iVPSLLV_4u64(a31, lift2array (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((2 * 32) - 96)))))); - _A31 <@ Ops.iVPSRLV_4u64(_A31, lift2array + a31 <@ Ops.iVPSRLV_4u64(a31, lift2array (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((2 * 32) - 96)))))); - _A31 <@ Ops.ilor4u64(_A31,_T.[4]); - _A21 <@ Ops.ilxor4u64(_A21,_D14); - _T.[5] <@ Ops.iVPSLLV_4u64(_A21, lift2array + a31 <@ Ops.ilor4u64(a31,t.[4]); + a21 <@ Ops.ilxor4u64(a21,d14); + t.[5] <@ Ops.iVPSLLV_4u64(a21, lift2array (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((3 * 32) - 96)))))); - _A21 <@ Ops.iVPSRLV_4u64(_A21, lift2array + a21 <@ Ops.iVPSRLV_4u64(a21, lift2array (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((3 * 32) - 96)))))); - _A21 <@ Ops.ilor4u64(_A21,_T.[5]); - _A41 <@ Ops.ilxor4u64(_A41,_D14); - _T.[6] <@ Ops.iVPSLLV_4u64(_A41, lift2array + a21 <@ Ops.ilor4u64(a21,t.[5]); + a41 <@ Ops.ilxor4u64(a41,d14); + t.[6] <@ Ops.iVPSLLV_4u64(a41, lift2array (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((4 * 32) - 96)))))); - _A41 <@ Ops.iVPSRLV_4u64(_A41, lift2array + a41 <@ Ops.iVPSRLV_4u64(a41, lift2array (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((4 * 32) - 96)))))); - _A41 <@ Ops.ilor4u64(_A41,_T.[6]); - _A11 <@ Ops.ilxor4u64(_A11,_D14); - _T.[3] <- Ops.iVPERMQ(_A20,(W8.of_int 141)); - _T.[4] <- Ops.iVPERMQ(_A31,(W8.of_int 141)); - _T.[7] <@ Ops.iVPSLLV_4u64(_A11, lift2array + a41 <@ Ops.ilor4u64(a41,t.[6]); + a11 <@ Ops.ilxor4u64(a11,d14); + t.[3] <- Ops.iVPERMQ(a20,(W8.of_int 141)); + t.[4] <- Ops.iVPERMQ(a31,(W8.of_int 141)); + t.[7] <@ Ops.iVPSLLV_4u64(a11, lift2array (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((5 * 32) - 96)))))); - _T.[1] <@ Ops.iVPSRLV_4u64(_A11, lift2array + t.[1] <@ Ops.iVPSRLV_4u64(a11, lift2array (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((5 * 32) - 96)))))); - _T.[1] <@ Ops.ilor4u64(_T.[1],_T.[7]); - _A01 <@ Ops.ilxor4u64(_A01,_D14); - _T.[5] <- Ops.iVPERMQ(_A21,(W8.of_int 27)); - _T.[6] <- Ops.iVPERMQ(_A41,(W8.of_int 114)); - _T.[8] <@ Ops.iVPSLLV_4u64(_A01, lift2array + t.[1] <@ Ops.ilor4u64(t.[1],t.[7]); + a01 <@ Ops.ilxor4u64(a01,d14); + t.[5] <- Ops.iVPERMQ(a21,(W8.of_int 27)); + t.[6] <- Ops.iVPERMQ(a41,(W8.of_int 114)); + t.[8] <@ Ops.iVPSLLV_4u64(a01, lift2array (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((1 * 32) - 96)))))); - _T.[2] <@ Ops.iVPSRLV_4u64(_A01, lift2array + t.[2] <@ Ops.iVPSRLV_4u64(a01, lift2array (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((1 * 32) - 96)))))); - _T.[2] <@ Ops.ilor4u64(_T.[2],_T.[8]); - _T.[7] <@ Ops.iVPSRLDQ_256(_T.[1],(W8.of_int 8)); - _T.[0] <@ Ops.ilandn4u64(_T.[1],_T.[7]); - _A31 <@ Ops.iVPBLENDD_256(_T.[2], _T.[6], + t.[2] <@ Ops.ilor4u64(t.[2],t.[8]); + t.[7] <@ Ops.iVPSRLDQ_256(t.[1],(W8.of_int 8)); + t.[0] <@ Ops.ilandn4u64(t.[1],t.[7]); + a31 <@ Ops.iVPBLENDD_256(t.[2], t.[6], (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); - _T.[8] <@ Ops.iVPBLENDD_256(_T.[4], _T.[2], + t.[8] <@ Ops.iVPBLENDD_256(t.[4], t.[2], (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); - _A41 <@ Ops.iVPBLENDD_256(_T.[3], _T.[4], + a41 <@ Ops.iVPBLENDD_256(t.[3], t.[4], (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); - _T.[7] <@ Ops.iVPBLENDD_256(_T.[2], _T.[3], + t.[7] <@ Ops.iVPBLENDD_256(t.[2], t.[3], (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); - _A31 <@ Ops.iVPBLENDD_256(_A31, _T.[4], + a31 <@ Ops.iVPBLENDD_256(a31, t.[4], (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); - _T.[8] <@ Ops.iVPBLENDD_256(_T.[8], _T.[5], + t.[8] <@ Ops.iVPBLENDD_256(t.[8], t.[5], (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); - _A41 <@ Ops.iVPBLENDD_256(_A41, _T.[2], + a41 <@ Ops.iVPBLENDD_256(a41, t.[2], (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); - _T.[7] <@ Ops.iVPBLENDD_256(_T.[7], _T.[6], + t.[7] <@ Ops.iVPBLENDD_256(t.[7], t.[6], (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); - _A31 <@ Ops.iVPBLENDD_256(_A31, _T.[5], + a31 <@ Ops.iVPBLENDD_256(a31, t.[5], (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); - _T.[8] <@ Ops.iVPBLENDD_256(_T.[8], _T.[6], + t.[8] <@ Ops.iVPBLENDD_256(t.[8], t.[6], (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); - _A41 <@ Ops.iVPBLENDD_256(_A41, _T.[6], + a41 <@ Ops.iVPBLENDD_256(a41, t.[6], (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); - _T.[7] <@ Ops.iVPBLENDD_256(_T.[7], _T.[4], + t.[7] <@ Ops.iVPBLENDD_256(t.[7], t.[4], (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); - _A31 <@ Ops.ilandn4u64(_A31,_T.[8]); - _A41 <@ Ops.ilandn4u64(_A41,_T.[7]); - _A11 <@ Ops.iVPBLENDD_256(_T.[5], _T.[2], + a31 <@ Ops.ilandn4u64(a31,t.[8]); + a41 <@ Ops.ilandn4u64(a41,t.[7]); + a11 <@ Ops.iVPBLENDD_256(t.[5], t.[2], (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); - _T.[8] <@ Ops.iVPBLENDD_256(_T.[3], _T.[5], + t.[8] <@ Ops.iVPBLENDD_256(t.[3], t.[5], (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); - _A31 <@ Ops.ilxor4u64(_A31,_T.[3]); - _A11 <@ Ops.iVPBLENDD_256(_A11, _T.[3], + a31 <@ Ops.ilxor4u64(a31,t.[3]); + a11 <@ Ops.iVPBLENDD_256(a11, t.[3], (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); - _T.[8] <@ Ops.iVPBLENDD_256(_T.[8], _T.[4], + t.[8] <@ Ops.iVPBLENDD_256(t.[8], t.[4], (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); - _A41 <@ Ops.ilxor4u64(_A41,_T.[5]); - _A11 <@ Ops.iVPBLENDD_256(_A11, _T.[4], + a41 <@ Ops.ilxor4u64(a41,t.[5]); + a11 <@ Ops.iVPBLENDD_256(a11, t.[4], (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); - _T.[8] <@ Ops.iVPBLENDD_256(_T.[8], _T.[2], + t.[8] <@ Ops.iVPBLENDD_256(t.[8], t.[2], (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); - _A11 <@ Ops.ilandn4u64(_A11,_T.[8]); - _A11 <@ Ops.ilxor4u64(_A11,_T.[6]); - _A21 <@ Ops.iVPERMQ(_T.[1],(W8.of_int 30)); - _T.[8] <@ Ops.iVPBLENDD_256(_A21, _A00, + a11 <@ Ops.ilandn4u64(a11,t.[8]); + a11 <@ Ops.ilxor4u64(a11,t.[6]); + a21 <@ Ops.iVPERMQ(t.[1],(W8.of_int 30)); + t.[8] <@ Ops.iVPBLENDD_256(a21, a00, (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); - _A01 <@ Ops.iVPERMQ(_T.[1],(W8.of_int 57)); - _A01 <@ Ops.iVPBLENDD_256(_A01 ,_A00, + a01 <@ Ops.iVPERMQ(t.[1],(W8.of_int 57)); + a01 <@ Ops.iVPBLENDD_256(a01 ,a00, (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); - _A01 <@ Ops.ilandn4u64(_A01,_T.[8]); - _A20 <@ Ops.iVPBLENDD_256(_T.[4], _T.[5], + a01 <@ Ops.ilandn4u64(a01,t.[8]); + a20 <@ Ops.iVPBLENDD_256(t.[4], t.[5], (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); - _T.[7] <@ Ops.iVPBLENDD_256(_T.[6], _T.[4], + t.[7] <@ Ops.iVPBLENDD_256(t.[6], t.[4], (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); - _A20 <@ Ops.iVPBLENDD_256(_A20, _T.[6], + a20 <@ Ops.iVPBLENDD_256(a20, t.[6], (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); - _T.[7] <@ Ops.iVPBLENDD_256(_T.[7], _T.[3], + t.[7] <@ Ops.iVPBLENDD_256(t.[7], t.[3], (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); - _A20 <@ Ops.iVPBLENDD_256(_A20, _T.[3], + a20 <@ Ops.iVPBLENDD_256(a20, t.[3], (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); - _T.[7] <@ Ops.iVPBLENDD_256(_T.[7], _T.[5], + t.[7] <@ Ops.iVPBLENDD_256(t.[7], t.[5], (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); - _A20 <@ Ops.ilandn4u64(_A20,_T.[7]); - _A20 <@ Ops.ilxor4u64(_A20,_T.[2]); - _T.[0] <@ Ops.iVPERMQ(_T.[0],(W8.of_int 0)); - _A31 <@ Ops.iVPERMQ(_A31,(W8.of_int 27)); - _A41 <@ Ops.iVPERMQ(_A41,(W8.of_int 141)); - _A11 <@ Ops.iVPERMQ(_A11,(W8.of_int 114)); - _A21 <@ Ops.iVPBLENDD_256(_T.[6], _T.[3], + a20 <@ Ops.ilandn4u64(a20,t.[7]); + a20 <@ Ops.ilxor4u64(a20,t.[2]); + t.[0] <@ Ops.iVPERMQ(t.[0],(W8.of_int 0)); + a31 <@ Ops.iVPERMQ(a31,(W8.of_int 27)); + a41 <@ Ops.iVPERMQ(a41,(W8.of_int 141)); + a11 <@ Ops.iVPERMQ(a11,(W8.of_int 114)); + a21 <@ Ops.iVPBLENDD_256(t.[6], t.[3], (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); - _T.[7] <@ Ops.iVPBLENDD_256(_T.[5], _T.[6], + t.[7] <@ Ops.iVPBLENDD_256(t.[5], t.[6], (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); - _A21 <@ Ops.iVPBLENDD_256(_A21, _T.[5], + a21 <@ Ops.iVPBLENDD_256(a21, t.[5], (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); - _T.[7] <@ Ops.iVPBLENDD_256(_T.[7] ,_T.[2], + t.[7] <@ Ops.iVPBLENDD_256(t.[7] ,t.[2], (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); - _A21 <@ Ops.iVPBLENDD_256(_A21, _T.[2], + a21 <@ Ops.iVPBLENDD_256(a21, t.[2], (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); - _T.[7] <@ Ops.iVPBLENDD_256(_T.[7], _T.[3], + t.[7] <@ Ops.iVPBLENDD_256(t.[7], t.[3], (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); - _A21 <@ Ops.ilandn4u64(_A21,_T.[7]); - _A00 <@ Ops.ilxor4u64(_A00,_T.[0]); - _A01 <@ Ops.ilxor4u64(_A01,_T.[1]); - _A21 <@ Ops.ilxor4u64(_A21,_T.[4]); - _A00 <@ Ops.ilxor4u64(_A00, lift2array + a21 <@ Ops.ilandn4u64(a21,t.[7]); + a00 <@ Ops.ilxor4u64(a00,t.[0]); + a01 <@ Ops.ilxor4u64(a01,t.[1]); + a21 <@ Ops.ilxor4u64(a21,t.[4]); + a00 <@ Ops.ilxor4u64(a00, lift2array (loadW256 Glob.mem (W64.to_uint (iotas + (W64.of_int 0))))); iotas <- (iotas + (W64.of_int 32)); ( _0, _1, _2, zf, i) <- x86_DEC_32 i; } - return (_A00, _A01, _A20, _A31, _A21, _A41, _A11); + return (a00, a01, a20, a31, a21, a41, a11); } }. (* - ($A00, # [0][0] [0][0] [0][0] [0][0] - $A01, # [0][4] [0][3] [0][2] [0][1] - $A20, # [3][0] [1][0] [4][0] [2][0] - $A31, # [2][4] [4][3] [1][2] [3][1] - $A21, # [3][4] [1][3] [4][2] [2][1] - $A41, # [1][4] [2][3] [3][2] [4][1] - $A11) = # [4][4] [3][3] [2][2] [1][1] + ($a00, # [0][0] [0][0] [0][0] [0][0] + $a01, # [0][4] [0][3] [0][2] [0][1] + $a20, # [3][0] [1][0] [4][0] [2][0] + $a31, # [2][4] [4][3] [1][2] [3][1] + $a21, # [3][4] [1][3] [4][2] [2][1] + $a41, # [1][4] [2][3] [3][2] [4][1] + $a11) = # [4][4] [3][3] [2][2] [1][1] *) op index x y = 5*x+y. -op equiv_states (A00 A01 A20 A31 A21 A41 A11 : W64.t Array4.t, st : W64.t Array25.t) : bool = - A00.[3] = st.[index 0 0] /\ A00.[2] = st.[index 0 0] /\ A00.[1] = st.[index 0 0] /\ A00.[0] = st.[index 0 0] /\ - A01.[3] = st.[index 0 4] /\ A01.[2] = st.[index 0 3] /\ A01.[1] = st.[index 0 2] /\ A01.[0] = st.[index 0 1] /\ - A20.[3] = st.[index 3 0] /\ A20.[2] = st.[index 1 0] /\ A20.[1] = st.[index 4 0] /\ A20.[0] = st.[index 2 0] /\ - A31.[3] = st.[index 2 4] /\ A31.[2] = st.[index 4 3] /\ A31.[1] = st.[index 1 2] /\ A31.[0] = st.[index 3 1] /\ - A21.[3] = st.[index 3 4] /\ A21.[2] = st.[index 1 3] /\ A21.[1] = st.[index 4 2] /\ A21.[0] = st.[index 2 1] /\ - A41.[3] = st.[index 1 4] /\ A41.[2] = st.[index 2 3] /\ A41.[1] = st.[index 3 2] /\ A41.[0] = st.[index 4 1] /\ - A11.[3] = st.[index 4 4] /\ A11.[2] = st.[index 3 3] /\ A11.[1] = st.[index 2 2] /\ A11.[0] = st.[index 1 1]. - -op equiv_states_chi (A00 A01 A20 A31 A21 A41 A11 : W64.t Array4.t, st : W64.t Array25.t) : bool = - A00.[3] = st.[index 0 0] /\ A00.[2] = st.[index 0 0] /\ A00.[1] = st.[index 0 0] /\ A00.[0] = st.[index 0 0] /\ - A01.[3] = st.[index 0 4] /\ A01.[2] = st.[index 0 3] /\ A01.[1] = st.[index 0 2] /\ A01.[0] = st.[index 0 1] /\ - A20.[3] = st.[index 3 0] /\ A20.[2] = st.[index 1 0] /\ A20.[1] = st.[index 4 0] /\ A20.[0] = st.[index 2 0] /\ - A31.[3] = st.[index 3 1] /\ A31.[2] = st.[index 1 2] /\ A31.[1] = st.[index 4 3] /\ A31.[0] = st.[index 2 4] /\ - A21.[3] = st.[index 3 4] /\ A21.[2] = st.[index 1 3] /\ A21.[1] = st.[index 4 2] /\ A21.[0] = st.[index 2 1] /\ - A41.[3] = st.[index 3 2] /\ A41.[2] = st.[index 1 4] /\ A41.[1] = st.[index 4 1] /\ A41.[0] = st.[index 2 3] /\ - A11.[3] = st.[index 3 3] /\ A11.[2] = st.[index 1 1] /\ A11.[1] = st.[index 4 4] /\ A11.[0] = st.[index 2 2]. +op equiv_states (a00 a01 a20 a31 a21 a41 a11 : W64.t Array4.t, st : W64.t Array25.t) : bool = + a00.[3] = st.[index 0 0] /\ a00.[2] = st.[index 0 0] /\ a00.[1] = st.[index 0 0] /\ a00.[0] = st.[index 0 0] /\ + a01.[3] = st.[index 0 4] /\ a01.[2] = st.[index 0 3] /\ a01.[1] = st.[index 0 2] /\ a01.[0] = st.[index 0 1] /\ + a20.[3] = st.[index 3 0] /\ a20.[2] = st.[index 1 0] /\ a20.[1] = st.[index 4 0] /\ a20.[0] = st.[index 2 0] /\ + a31.[3] = st.[index 2 4] /\ a31.[2] = st.[index 4 3] /\ a31.[1] = st.[index 1 2] /\ a31.[0] = st.[index 3 1] /\ + a21.[3] = st.[index 3 4] /\ a21.[2] = st.[index 1 3] /\ a21.[1] = st.[index 4 2] /\ a21.[0] = st.[index 2 1] /\ + a41.[3] = st.[index 1 4] /\ a41.[2] = st.[index 2 3] /\ a41.[1] = st.[index 3 2] /\ a41.[0] = st.[index 4 1] /\ + a11.[3] = st.[index 4 4] /\ a11.[2] = st.[index 3 3] /\ a11.[1] = st.[index 2 2] /\ a11.[0] = st.[index 1 1]. + +op equiv_states_chi (a00 a01 a20 a31 a21 a41 a11 : W64.t Array4.t, st : W64.t Array25.t) : bool = + a00.[3] = st.[index 0 0] /\ a00.[2] = st.[index 0 0] /\ a00.[1] = st.[index 0 0] /\ a00.[0] = st.[index 0 0] /\ + a01.[3] = st.[index 0 4] /\ a01.[2] = st.[index 0 3] /\ a01.[1] = st.[index 0 2] /\ a01.[0] = st.[index 0 1] /\ + a20.[3] = st.[index 3 0] /\ a20.[2] = st.[index 1 0] /\ a20.[1] = st.[index 4 0] /\ a20.[0] = st.[index 2 0] /\ + a31.[3] = st.[index 3 1] /\ a31.[2] = st.[index 1 2] /\ a31.[1] = st.[index 4 3] /\ a31.[0] = st.[index 2 4] /\ + a21.[3] = st.[index 3 4] /\ a21.[2] = st.[index 1 3] /\ a21.[1] = st.[index 4 2] /\ a21.[0] = st.[index 2 1] /\ + a41.[3] = st.[index 3 2] /\ a41.[2] = st.[index 1 4] /\ a41.[1] = st.[index 4 1] /\ a41.[0] = st.[index 2 3] /\ + a11.[3] = st.[index 3 3] /\ a11.[2] = st.[index 1 1] /\ a11.[1] = st.[index 4 4] /\ a11.[0] = st.[index 2 2]. lemma dec : forall (x : W32.t), 0 < to_uint x <= 24 => @@ -509,7 +509,12 @@ lemma loadlift_rhor : forall (mem : global_mem_t) (x : W64.t) (off : int), .[1 <- W64.of_int good_rhotates_right.[4*off + 1]] .[2 <- W64.of_int good_rhotates_right.[4*off + 2]] .[3 <- W64.of_int good_rhotates_right.[4*off + 3]])%Array4. +(* This proof sketch is just to make sure things make sense *) +(* Help needed to prove this in a concise way *) +admit. +qed. +(* move => mem x off. rewrite /good_rhor /loadW256 /lift2array /good_rhotates_right => />. move => *. @@ -650,7 +655,7 @@ have HHH : (to_uint x + 32 < W64.modulus). admit. (* safety *) smt(@W64). smt(). smt(). smt(). admit. (* need to keep going *) -qed. +qed. *) (* these are the same as above *) lemma loadlift_rhol : forall (mem : global_mem_t) (x : W64.t) (off : int), @@ -766,13 +771,13 @@ smt(). smt(). qed. -lemma correct_perm A00 A01 A20 A31 A21 A41 A11 st mem: - equiv [ Mreftable.permute ~ Mavx2_prevec.__KeccakF1600 : +lemma correct_perm _a00 _a01 _a20 _a31 _a21 _a41 _a11 st mem: + equiv [ Mreftable.__keccak_f1600_ref ~ Mavx2_prevec.__KeccakF1600 : Glob.mem{2} = mem /\ good_iotas mem (to_uint _iotas{2}) /\ good_rhol mem (to_uint _rhotates_left{2}) /\ good_rhor mem (to_uint _rhotates_right{2}) /\ - equiv_states A00 A01 A20 A31 A21 A41 A11 st /\ - _A00{2} = A00 /\ _A01{2} = A01 /\ _A20{2} = A20 /\ _A31{2} = A31 /\ - _A21{2} = A21 /\ _A41{2} = A41 /\ _A11{2} = A11 /\ state{1} = st ==> + equiv_states _a00 _a01 _a20 _a31 _a21 _a41 _a11 st /\ + a00{2} = _a00 /\ a01{2} = _a01 /\ a20{2} = _a20 /\ a31{2} = _a31 /\ + a21{2} = _a21 /\ a41{2} = _a41 /\ a11{2} = _a11 /\ state{1} = st ==> equiv_states res{2}.`1 res{2}.`2 res{2}.`3 res{2}.`4 res{2}.`5 res{2}.`6 res{2}.`7 res{1}]. proc. unroll {1} 3. @@ -782,11 +787,11 @@ seq 0 1 : #pre; first by auto => />. inline Mreftable.keccakRoundConstants. sp 2 4. -seq 1 105 : (#{/~_A00{2}}{~_A01{2}}{~_A20{2}}{~_A31{2}}{~_A21{2}}{~_A41{2}}{~_A11{2}}{~state{1}}pre /\ Glob.mem{2} = mem /\ +seq 1 105 : (#{/~a00{2}}{~a01{2}}{~a20{2}}{~a31{2}}{~a21{2}}{~a41{2}}{~a11{2}}{~state{1}}pre /\ Glob.mem{2} = mem /\ good_iotas mem (to_uint _iotas{2}) /\ good_rhol mem (to_uint _rhotates_left{2}) /\ good_rhor mem (to_uint _rhotates_right{2}) /\ - equiv_states _A00{2} _A01{2} _A20{2} _A31{2} _A21{2} _A41{2} _A11{2} state{1}). + equiv_states a00{2} a01{2} a20{2} a31{2} a21{2} a41{2} a11{2} state{1}). seq 0 0 : (#pre /\ (constants{1}.[round{1}])%Array24 = W64.of_int 1). by auto => />; rewrite /iotas;smt(). @@ -805,7 +810,7 @@ swap {2} 40 -12. swap {2} 46 -17. seq 9 29 : (#{/~state{1}}post /\ c{1} = W64.of_int 1 /\ - equiv_states _A00{2} _A01{2} _A20{2} _A31{2} _A21{2} _A41{2} _A11{2} state0{1}). + equiv_states a00{2} a01{2} a20{2} a31{2} a21{2} a41{2} a11{2} state0{1}). do 13!(unroll for {1} ^while). @@ -823,7 +828,7 @@ by smt(W64.xorwA W64.xorwC W64.xorw0 W64.xorwK rolcomp commor). inline Mreftable.rho Mreftable.pi. seq 11 22 : (#{/~ state{1}}post /\ c{1} = W64.of_int 1 /\ - equiv_states_chi _A00{2} _T{2}.[1] _T{2}.[2] _T{2}.[3] _T{2}.[4] _T{2}.[5] _T{2}.[6] state0{1}). + equiv_states_chi a00{2} t{2}.[1] t{2}.[2] t{2}.[3] t{2}.[4] t{2}.[5] t{2}.[6] state0{1}). do 13!(unroll for {1} ^while). inline *. @@ -848,56 +853,56 @@ split; first by rewrite /rhotates; smt(roln rol0). split. rewrite H H0. move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 5 3 _A11{2}.[3] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 5 3 a11{2}.[3] _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 5 2 _A11{2}.[2] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 5 2 a11{2}.[2] _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 5 1 _A11{2}.[1] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 5 1 a11{2}.[1] _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 5 0 _A11{2}.[0] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 5 0 a11{2}.[0] _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 1 3 _A01{2}.[3] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 1 3 a01{2}.[3] _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 1 2 _A01{2}.[2] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 1 2 a01{2}.[2] _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 1 1 _A01{2}.[1] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 1 1 a01{2}.[1] _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 1 0 _A01{2}.[0] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 1 0 a01{2}.[0] _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). @@ -905,111 +910,111 @@ smt(). smt(). smt(). split. rewrite H H0. move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 0 2 _A20{2}.[2] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 0 2 a20{2}.[2] _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 0 0 _A20{2}.[0] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 0 0 a20{2}.[0] _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 0 3 _A20{2}.[3] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 0 3 a20{2}.[3] _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 0 1 _A20{2}.[1] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 0 1 a20{2}.[1] _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 2 2 _A31{2}.[2] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 2 2 a31{2}.[2] _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 2 0 _A31{2}.[0] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 2 0 a31{2}.[0] _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 2 3 _A31{2}.[3] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 2 3 a31{2}.[3] _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 2 1 _A31{2}.[1] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 2 1 a31{2}.[1] _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 3 0 _A21{2}.[0] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 3 0 a21{2}.[0] _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 3 1 _A21{2}.[1] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 3 1 a21{2}.[1] _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 3 2 _A21{2}.[2] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 3 2 a21{2}.[2] _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 3 3 _A21{2}.[3] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 3 3 a21{2}.[3] _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 4 1 _A41{2}.[1] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 4 1 a41{2}.[1] _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 4 3 _A41{2}.[3] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 4 3 a41{2}.[3] _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 4 0 _A41{2}.[0] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 4 0 a41{2}.[0] _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). rewrite H H0. move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 4 2 _A41{2}.[2] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 4 2 a41{2}.[2] _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). @@ -1018,7 +1023,7 @@ smt(). smt(). smt(). inline Mreftable.chi. seq 5 53 : (#{~state0{1}}pre /\ - equiv_states _A00{2} _A01{2} _A20{2} _A31{2} _A21{2} _A41{2} _A11{2} state0{1}). + equiv_states a00{2} a01{2} a20{2} a31{2} a21{2} a41{2} a11{2} state0{1}). do 11!(unroll for {1} ^while). inline *. @@ -1087,7 +1092,7 @@ seq 1 2 : (#{/~iotas{2}}{~round{1}}{~i{2}}{~st}pre /\ (x86_DEC_32 (i{2} + W32.of_int 1)).`4 = zf{2} /\ 0 < round{1} /\ to_uint i{2} <= 24 /\ - constants{1} = Keccak_f1600_ref.iotas). + constants{1} = Keccak_f1600_ref_op.iotas). auto => />. progress. @@ -1113,7 +1118,7 @@ swap {2} 40 -12. swap {2} 46 -17. seq 9 29 : (#{/~state{1}}post /\ c{1} = constants{1}.[round{1}] /\ round{1} < 24 /\ - equiv_states _A00{2} _A01{2} _A20{2} _A31{2} _A21{2} _A41{2} _A11{2} state0{1}). + equiv_states a00{2} a01{2} a20{2} a31{2} a21{2} a41{2} a11{2} state0{1}). do 13!(unroll for {1} ^while). inline *. @@ -1130,7 +1135,7 @@ by smt(W64.xorwA W64.xorwC W64.xorw0 W64.xorwK rolcomp commor). inline Mreftable.rho Mreftable.pi. seq 11 22 : (#{/~ state{1}}post /\ c{1} = constants{1}.[round{1}] /\ round{1} < 24 /\ - equiv_states_chi _A00{2} _T{2}.[1] _T{2}.[2] _T{2}.[3] _T{2}.[4] _T{2}.[5] _T{2}.[6] state0{1}). + equiv_states_chi a00{2} t{2}.[1] t{2}.[2] t{2}.[3] t{2}.[4] t{2}.[5] t{2}.[6] state0{1}). do 13!(unroll for {1} ^while). @@ -1158,56 +1163,56 @@ split; first by rewrite /rhotates; smt(roln rol0). split. rewrite H H0. move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 5 3 _A11{2}.[3] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 5 3 a11{2}.[3] _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 5 2 _A11{2}.[2] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 5 2 a11{2}.[2] _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 5 1 _A11{2}.[1] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 5 1 a11{2}.[1] _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 5 0 _A11{2}.[0] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 5 0 a11{2}.[0] _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 1 3 _A01{2}.[3] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 1 3 a01{2}.[3] _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 1 2 _A01{2}.[2] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 1 2 a01{2}.[2] _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 1 1 _A01{2}.[1] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 1 1 a01{2}.[1] _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 1 0 _A01{2}.[0] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 1 0 a01{2}.[0] _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). @@ -1215,111 +1220,111 @@ smt(). smt(). smt(). split. rewrite H H0. move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 0 2 _A20{2}.[2] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 0 2 a20{2}.[2] _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 0 0 _A20{2}.[0] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 0 0 a20{2}.[0] _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 0 3 _A20{2}.[3] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 0 3 a20{2}.[3] _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 0 1 _A20{2}.[1] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 0 1 a20{2}.[1] _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 2 2 _A31{2}.[2] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 2 2 a31{2}.[2] _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 2 0 _A31{2}.[0] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 2 0 a31{2}.[0] _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 2 3 _A31{2}.[3] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 2 3 a31{2}.[3] _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 2 1 _A31{2}.[1] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 2 1 a31{2}.[1] _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 3 0 _A21{2}.[0] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 3 0 a21{2}.[0] _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 3 1 _A21{2}.[1] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 3 1 a21{2}.[1] _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 3 2 _A21{2}.[2] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 3 2 a21{2}.[2] _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 3 3 _A21{2}.[3] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 3 3 a21{2}.[3] _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 4 1 _A41{2}.[1] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 4 1 a41{2}.[1] _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 4 3 _A41{2}.[3] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 4 3 a41{2}.[3] _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 4 0 _A41{2}.[0] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 4 0 a41{2}.[0] _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). rewrite H H0. move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 4 2 _A41{2}.[2] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 4 2 a41{2}.[2] _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). @@ -1329,7 +1334,7 @@ smt(). inline Mreftable.chi. seq 5 53 : (#{~state0{1}}pre /\ - equiv_states _A00{2} _A01{2} _A20{2} _A31{2} _A21{2} _A41{2} _A11{2} state0{1}). + equiv_states a00{2} a01{2} a20{2} a31{2} a21{2} a41{2} a11{2} state0{1}). do 11!(unroll for {1} ^while). inline *. @@ -1380,7 +1385,7 @@ smt(). (* iota *) seq 2 1 : (#{/~ state0{1}}pre /\ - equiv_states _A00{2} _A01{2} _A20{2} _A31{2} _A21{2} _A41{2} _A11{2} + equiv_states a00{2} a01{2} a20{2} a31{2} a21{2} a41{2} a11{2} state{1}). inline *; wp; skip; rewrite /equiv_states /index; progress. diff --git a/proof/impl/perm/keccak_f1600_avx2_prevec_vops.ec b/proof/impl/perm/keccak_f1600_avx2_prevec_vops.ec new file mode 100644 index 0000000..36169d3 --- /dev/null +++ b/proof/impl/perm/keccak_f1600_avx2_prevec_vops.ec @@ -0,0 +1,479 @@ +require import List Int IntExtra IntDiv CoreMap. +from Jasmin require import JModel. + +require import Array4 Array9 Array24 Array25 Array96. +require import WArray288. + +require import Keccak_f1600_ref_op. +import Ops. + +module Mavx2_prevec_vops = { + + proc __KeccakF1600 (a00:W256.t, a01:W256.t, a20:W256.t, a31:W256.t, + a21:W256.t, a41:W256.t, a11:W256.t, + _rhotates_left:W64.t, _rhotates_right:W64.t, + _iotas:W64.t) : W256.t * W256.t * W256.t * W256.t * + W256.t * W256.t * W256.t = { + + var rhotates_left:W64.t; + var rhotates_right:W64.t; + var iotas:W64.t; + var i:W32.t; + var zf:bool; + var c00:W256.t; + var c14:W256.t; + var t:W256.t Array9.t; + var d14:W256.t; + var d00:W256.t; + var _0:bool; + var _1:bool; + var _2:bool; + t <- witness; + rhotates_left <- (_rhotates_left + (W64.of_int 96)); + rhotates_right <- (_rhotates_right + (W64.of_int 96)); + iotas <- _iotas; + i <- (W32.of_int 24); + c00 <@ OpsV.iVPSHUFD_256(a20,(W8.of_int 78)); + c14 <@ OpsV.ilxor4u64(a41,a31); + t.[2] <@ OpsV.ilxor4u64(a21,a11); + c14 <@ OpsV.ilxor4u64(c14,a01); + c14 <@ OpsV.ilxor4u64(c14,t.[2]); + t.[4] <- OpsV.iVPERMQ(c14,(W8.of_int 147)); + c00 <@ OpsV.ilxor4u64(c00,a20); + t.[0] <- OpsV.iVPERMQ(c00,(W8.of_int 78)); + t.[1] <- OpsV.ivshr64u256(c14, (W8.of_int 63)); + t.[2] <- OpsV.ivadd64u256(c14, c14); + t.[1] <@ OpsV.ilor4u64(t.[1],t.[2]); + d14 <- OpsV.iVPERMQ(t.[1],(W8.of_int 57)); + d00 <@ OpsV.ilxor4u64(t.[1],t.[4]); + d00 <- OpsV.iVPERMQ(d00,(W8.of_int 0)); + c00 <@ OpsV.ilxor4u64(c00,a00); + c00 <@ OpsV.ilxor4u64(c00,t.[0]); + t.[0] <- OpsV.ivshr64u256(c00, (W8.of_int 63)); + t.[1] <- OpsV.ivadd64u256(c00, c00); + t.[1] <@ OpsV.ilor4u64(t.[1],t.[0]); + a20 <@ OpsV.ilxor4u64(a20,d00); + a00 <@ OpsV.ilxor4u64(a00,d00); + d14 <- OpsV.iVPBLENDD_256(d14,t.[1], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + t.[4] <- OpsV.iVPBLENDD_256(t.[4],c00, + (W8.of_int (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + d14 <@ OpsV.ilxor4u64(d14,t.[4]); + t.[3] <@ OpsV.iVPSLLV_4u64(a20, + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((0 * 32) - 96)))))); + a20 <@ OpsV.iVPSRLV_4u64(a20, + (loadW256 Glob.mem (W64.to_uint (rhotates_right+ (W64.of_int ((0 * 32) - 96)))))); + a20 <@ OpsV.ilor4u64(a20,t.[3]); + a31 <@ OpsV.ilxor4u64(a31,d14); + t.[4] <@ OpsV.iVPSLLV_4u64(a31, + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((2 * 32) - 96)))))); + a31 <@ OpsV.iVPSRLV_4u64(a31, + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((2 * 32) - 96)))))); + a31 <@ OpsV.ilor4u64(a31,t.[4]); + a21 <@ OpsV.ilxor4u64(a21,d14); + t.[5] <@ OpsV.iVPSLLV_4u64(a21, + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((3 * 32) - 96)))))); + a21 <@ OpsV.iVPSRLV_4u64(a21, + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((3 * 32) - 96)))))); + a21 <@ OpsV.ilor4u64(a21,t.[5]); + a41 <@ OpsV.ilxor4u64(a41,d14); + t.[6] <@ OpsV.iVPSLLV_4u64(a41, + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((4 * 32) - 96)))))); + a41 <@ OpsV.iVPSRLV_4u64(a41, + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((4 * 32) - 96)))))); + a41 <@ OpsV.ilor4u64(a41,t.[6]); + a11 <@ OpsV.ilxor4u64(a11,d14); + t.[3] <- OpsV.iVPERMQ(a20,(W8.of_int 141)); + t.[4] <- OpsV.iVPERMQ(a31,(W8.of_int 141)); + t.[7] <@ OpsV.iVPSLLV_4u64(a11, + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((5 * 32) - 96)))))); + t.[1] <@ OpsV.iVPSRLV_4u64(a11, + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((5 * 32) - 96)))))); + t.[1] <@ OpsV.ilor4u64(t.[1],t.[7]); + a01 <@ OpsV.ilxor4u64(a01,d14); + t.[5] <- OpsV.iVPERMQ(a21,(W8.of_int 27)); + t.[6] <- OpsV.iVPERMQ(a41,(W8.of_int 114)); + t.[8] <@ OpsV.iVPSLLV_4u64(a01, + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((1 * 32) - 96)))))); + t.[2] <@ OpsV.iVPSRLV_4u64(a01, + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((1 * 32) - 96)))))); + t.[2] <@ OpsV.ilor4u64(t.[2],t.[8]); + t.[7] <@ OpsV.iVPSRLDQ_256(t.[1],(W8.of_int 8)); + t.[0] <@ OpsV.ilandn4u64(t.[1],t.[7]); + a31 <@ OpsV.iVPBLENDD_256(t.[2],t.[6], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + t.[8] <@ OpsV.iVPBLENDD_256(t.[4],t.[2], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + a41 <@ OpsV.iVPBLENDD_256(t.[3], t.[4], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + t.[7] <@ OpsV.iVPBLENDD_256(t.[2], t.[3], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + a31 <@ OpsV.iVPBLENDD_256(a31 ,t.[4], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + t.[8] <@ OpsV.iVPBLENDD_256(t.[8], t.[5], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + a41 <@ OpsV.iVPBLENDD_256(a41, t.[2], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + t.[7] <@ OpsV.iVPBLENDD_256(t.[7], t.[6], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + a31 <@ OpsV.iVPBLENDD_256(a31, t.[5], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + t.[8] <@ OpsV.iVPBLENDD_256(t.[8], t.[6], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + a41 <@ OpsV.iVPBLENDD_256(a41, t.[6], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + t.[7] <@ OpsV.iVPBLENDD_256(t.[7], t.[4], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + a31 <@ OpsV.ilandn4u64(a31,t.[8]); + a41 <@ OpsV.ilandn4u64(a41,t.[7]); + a11 <@ OpsV.iVPBLENDD_256(t.[5],t.[2], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + t.[8] <@ OpsV.iVPBLENDD_256(t.[3], t.[5], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + a31 <@ OpsV.ilxor4u64(a31,t.[3]); + a11 <@ OpsV.iVPBLENDD_256(a11,t.[3], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + t.[8] <@ OpsV.iVPBLENDD_256(t.[8],t.[4], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + a41 <@ OpsV.ilxor4u64(a41,t.[5]); + a11 <@ OpsV.iVPBLENDD_256(a11, t.[4], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + t.[8] <@ OpsV.iVPBLENDD_256(t.[8], t.[2], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + a11 <@ OpsV.ilandn4u64(a11,t.[8]); + a11 <@ OpsV.ilxor4u64(a11,t.[6]); + a21 <@ OpsV.iVPERMQ(t.[1],(W8.of_int 30)); + t.[8] <@ OpsV.iVPBLENDD_256(a21, a00, + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + a01 <@ OpsV.iVPERMQ(t.[1],(W8.of_int 57)); + a01 <@ OpsV.iVPBLENDD_256(a01, a00, + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + a01 <@ OpsV.ilandn4u64(a01,t.[8]); + a20 <@ OpsV.iVPBLENDD_256(t.[4], t.[5], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + t.[7] <@ OpsV.iVPBLENDD_256(t.[6], t.[4], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + a20 <@ OpsV.iVPBLENDD_256(a20, t.[6], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + t.[7] <@ OpsV.iVPBLENDD_256(t.[7], t.[3], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + a20 <@ OpsV.iVPBLENDD_256(a20, t.[3], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + t.[7] <@ OpsV.iVPBLENDD_256(t.[7], t.[5], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + a20 <@ OpsV.ilandn4u64(a20,t.[7]); + a20 <@ OpsV.ilxor4u64(a20,t.[2]); + t.[0] <@ OpsV.iVPERMQ(t.[0],(W8.of_int 0)); + a31 <@ OpsV.iVPERMQ(a31,(W8.of_int 27)); + a41 <@ OpsV.iVPERMQ(a41,(W8.of_int 141)); + a11 <@ OpsV.iVPERMQ(a11,(W8.of_int 114)); + a21 <@ OpsV.iVPBLENDD_256(t.[6], t.[3], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + t.[7] <@ OpsV.iVPBLENDD_256(t.[5], t.[6], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + a21 <@ OpsV.iVPBLENDD_256(a21, t.[5], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + t.[7] <@ OpsV.iVPBLENDD_256(t.[7], t.[2], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + a21 <@ OpsV.iVPBLENDD_256(a21, t.[2], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + t.[7] <@ OpsV.iVPBLENDD_256(t.[7], t.[3], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + a21 <@ OpsV.ilandn4u64(a21,t.[7]); + a00 <@ OpsV.ilxor4u64(a00,t.[0]); + a01 <@ OpsV.ilxor4u64(a01,t.[1]); + a21 <@ OpsV.ilxor4u64(a21,t.[4]); + a00 <@ OpsV.ilxor4u64(a00, + (loadW256 Glob.mem (W64.to_uint (iotas + (W64.of_int 0))))); + iotas <- (iotas + (W64.of_int 32)); + ( _0, _1, _2, zf, i) <- x86_DEC_32 i; + while ((! zf)) { + c00 <@ OpsV.iVPSHUFD_256(a20,(W8.of_int 78)); + c14 <@ OpsV.ilxor4u64(a41,a31); + t.[2] <@ OpsV.ilxor4u64(a21,a11); + c14 <@ OpsV.ilxor4u64(c14,a01); + c14 <@ OpsV.ilxor4u64(c14,t.[2]); + t.[4] <@ OpsV.iVPERMQ(c14,(W8.of_int 147)); + c00 <@ OpsV.ilxor4u64(c00,a20); + t.[0] <@ OpsV.iVPERMQ(c00,(W8.of_int 78)); + t.[1] <@ OpsV.ivshr64u256(c14, (W8.of_int 63)); + t.[2] <@ OpsV.ivadd64u256(c14, c14); + t.[1] <@ OpsV.ilor4u64(t.[1],t.[2]); + d14 <@ OpsV.iVPERMQ(t.[1],(W8.of_int 57)); + d00 <@ OpsV.ilxor4u64(t.[1],t.[4]); + d00 <@ OpsV.iVPERMQ(d00,(W8.of_int 0)); + c00 <@ OpsV.ilxor4u64(c00,a00); + c00 <@ OpsV.ilxor4u64(c00,t.[0]); + t.[0] <@ OpsV.ivshr64u256(c00, (W8.of_int 63)); + t.[1] <@ OpsV.ivadd64u256(c00, c00); + t.[1] <@ OpsV.ilor4u64(t.[1],t.[0]); + a20 <@ OpsV.ilxor4u64(a20,d00); + a00 <@ OpsV.ilxor4u64(a00,d00); + d14 <@ OpsV.iVPBLENDD_256(d14,t.[1], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + t.[4] <@ OpsV.iVPBLENDD_256(t.[4],c00, + (W8.of_int (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + d14 <@ OpsV.ilxor4u64(d14,t.[4]); + t.[3] <@ OpsV.iVPSLLV_4u64(a20, + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((0 * 32) - 96)))))); + a20 <@ OpsV.iVPSRLV_4u64(a20, + (loadW256 Glob.mem (W64.to_uint (rhotates_right+ (W64.of_int ((0 * 32) - 96)))))); + a20 <@ OpsV.ilor4u64(a20,t.[3]); + a31 <@ OpsV.ilxor4u64(a31,d14); + t.[4] <@ OpsV.iVPSLLV_4u64(a31, + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((2 * 32) - 96)))))); + a31 <@ OpsV.iVPSRLV_4u64(a31, + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((2 * 32) - 96)))))); + a31 <@ OpsV.ilor4u64(a31,t.[4]); + a21 <@ OpsV.ilxor4u64(a21,d14); + t.[5] <@ OpsV.iVPSLLV_4u64(a21, + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((3 * 32) - 96)))))); + a21 <@ OpsV.iVPSRLV_4u64(a21, + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((3 * 32) - 96)))))); + a21 <@ OpsV.ilor4u64(a21,t.[5]); + a41 <@ OpsV.ilxor4u64(a41,d14); + t.[6] <@ OpsV.iVPSLLV_4u64(a41, + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((4 * 32) - 96)))))); + a41 <@ OpsV.iVPSRLV_4u64(a41, + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((4 * 32) - 96)))))); + a41 <@ OpsV.ilor4u64(a41,t.[6]); + a11 <@ OpsV.ilxor4u64(a11,d14); + t.[3] <- OpsV.iVPERMQ(a20,(W8.of_int 141)); + t.[4] <- OpsV.iVPERMQ(a31,(W8.of_int 141)); + t.[7] <@ OpsV.iVPSLLV_4u64(a11, + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((5 * 32) - 96)))))); + t.[1] <@ OpsV.iVPSRLV_4u64(a11, + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((5 * 32) - 96)))))); + t.[1] <@ OpsV.ilor4u64(t.[1],t.[7]); + a01 <@ OpsV.ilxor4u64(a01,d14); + t.[5] <- OpsV.iVPERMQ(a21,(W8.of_int 27)); + t.[6] <- OpsV.iVPERMQ(a41,(W8.of_int 114)); + t.[8] <@ OpsV.iVPSLLV_4u64(a01, + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((1 * 32) - 96)))))); + t.[2] <@ OpsV.iVPSRLV_4u64(a01, + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((1 * 32) - 96)))))); + t.[2] <@ OpsV.ilor4u64(t.[2],t.[8]); + t.[7] <@ OpsV.iVPSRLDQ_256(t.[1],(W8.of_int 8)); + t.[0] <@ OpsV.ilandn4u64(t.[1],t.[7]); + a31 <@ OpsV.iVPBLENDD_256(t.[2], t.[6], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + t.[8] <@ OpsV.iVPBLENDD_256(t.[4], t.[2], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + a41 <@ OpsV.iVPBLENDD_256(t.[3], t.[4], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + t.[7] <@ OpsV.iVPBLENDD_256(t.[2], t.[3], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + a31 <@ OpsV.iVPBLENDD_256(a31, t.[4], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + t.[8] <@ OpsV.iVPBLENDD_256(t.[8], t.[5], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + a41 <@ OpsV.iVPBLENDD_256(a41, t.[2], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + t.[7] <@ OpsV.iVPBLENDD_256(t.[7], t.[6], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + a31 <@ OpsV.iVPBLENDD_256(a31, t.[5], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + t.[8] <@ OpsV.iVPBLENDD_256(t.[8], t.[6], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + a41 <@ OpsV.iVPBLENDD_256(a41, t.[6], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + t.[7] <@ OpsV.iVPBLENDD_256(t.[7], t.[4], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + a31 <@ OpsV.ilandn4u64(a31,t.[8]); + a41 <@ OpsV.ilandn4u64(a41,t.[7]); + a11 <@ OpsV.iVPBLENDD_256(t.[5], t.[2], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + t.[8] <@ OpsV.iVPBLENDD_256(t.[3], t.[5], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + a31 <@ OpsV.ilxor4u64(a31,t.[3]); + a11 <@ OpsV.iVPBLENDD_256(a11, t.[3], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + t.[8] <@ OpsV.iVPBLENDD_256(t.[8], t.[4], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + a41 <@ OpsV.ilxor4u64(a41,t.[5]); + a11 <@ OpsV.iVPBLENDD_256(a11, t.[4], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + t.[8] <@ OpsV.iVPBLENDD_256(t.[8], t.[2], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + a11 <@ OpsV.ilandn4u64(a11,t.[8]); + a11 <@ OpsV.ilxor4u64(a11,t.[6]); + a21 <@ OpsV.iVPERMQ(t.[1],(W8.of_int 30)); + t.[8] <@ OpsV.iVPBLENDD_256(a21, a00, + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + a01 <@ OpsV.iVPERMQ(t.[1],(W8.of_int 57)); + a01 <@ OpsV.iVPBLENDD_256(a01 ,a00, + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + a01 <@ OpsV.ilandn4u64(a01,t.[8]); + a20 <@ OpsV.iVPBLENDD_256(t.[4], t.[5], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + t.[7] <@ OpsV.iVPBLENDD_256(t.[6], t.[4], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + a20 <@ OpsV.iVPBLENDD_256(a20, t.[6], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + t.[7] <@ OpsV.iVPBLENDD_256(t.[7], t.[3], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + a20 <@ OpsV.iVPBLENDD_256(a20, t.[3], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + t.[7] <@ OpsV.iVPBLENDD_256(t.[7], t.[5], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + a20 <@ OpsV.ilandn4u64(a20,t.[7]); + a20 <@ OpsV.ilxor4u64(a20,t.[2]); + t.[0] <@ OpsV.iVPERMQ(t.[0],(W8.of_int 0)); + a31 <@ OpsV.iVPERMQ(a31,(W8.of_int 27)); + a41 <@ OpsV.iVPERMQ(a41,(W8.of_int 141)); + a11 <@ OpsV.iVPERMQ(a11,(W8.of_int 114)); + a21 <@ OpsV.iVPBLENDD_256(t.[6], t.[3], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + t.[7] <@ OpsV.iVPBLENDD_256(t.[5], t.[6], + (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); + a21 <@ OpsV.iVPBLENDD_256(a21, t.[5], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + t.[7] <@ OpsV.iVPBLENDD_256(t.[7] ,t.[2], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); + a21 <@ OpsV.iVPBLENDD_256(a21, t.[2], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + t.[7] <@ OpsV.iVPBLENDD_256(t.[7], t.[3], + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); + a21 <@ OpsV.ilandn4u64(a21,t.[7]); + a00 <@ OpsV.ilxor4u64(a00,t.[0]); + a01 <@ OpsV.ilxor4u64(a01,t.[1]); + a21 <@ OpsV.ilxor4u64(a21,t.[4]); + a00 <@ OpsV.ilxor4u64(a00, + (loadW256 Glob.mem (W64.to_uint (iotas + (W64.of_int 0))))); + iotas <- (iotas + (W64.of_int 32)); + ( _0, _1, _2, zf, i) <- x86_DEC_32 i; + } + return (a00, a01, a20, a31, a21, a41, a11); + } +}. + +require import Keccak_f1600_avx2_openssl. + +equiv prevec_vops_openssl : + Mavx2_prevec_vops.__KeccakF1600 ~ M.__keccak_f1600_avx2_openssl : + ={Glob.mem,arg} ==> ={Glob.mem,res}. +proc. + seq 112 112 : (#pre /\ ={zf,iotas,rhotates_left,rhotates_right,t,i}). + seq 30 30 : (#pre /\ ={d14,t,iotas,rhotates_left,rhotates_right,i}). + by inline*;wp;skip; rewrite /flat_state; auto => />. + seq 30 30 : #pre. + by inline*;wp;skip; rewrite /flat_state; auto => />. + seq 30 30 : #pre. + by inline*;wp;skip; rewrite /flat_state; auto => />. + by inline*;wp;skip; rewrite /flat_state; auto => />. + while (#pre). + seq 30 30 : (#pre /\ ={d14}). + by inline*;wp;skip; rewrite /flat_state; auto => />. + seq 30 30 : #pre. + by inline*;wp;skip; rewrite /flat_state; auto => />. + seq 30 30 : #pre. + by inline*;wp;skip; rewrite /flat_state; auto => />. + by inline*;wp;skip; rewrite /flat_state; auto => />. + by auto => />. +qed. + +require import Keccak_f1600_avx2_prevec. + +op match_ins(st1 : W64.t Array4.t * W64.t Array4.t * W64.t Array4.t * W64.t Array4.t * + W64.t Array4.t * W64.t Array4.t * W64.t Array4.t * W64.t * W64.t * W64.t, + st2 : W256.t * W256.t * W256.t * W256.t * W256.t * W256.t * W256.t * W64.t * + W64.t * W64.t) = + is4u64 st1.`1 st2.`1 /\ + is4u64 st1.`2 st2.`2 /\ + is4u64 st1.`3 st2.`3 /\ + is4u64 st1.`4 st2.`4 /\ + is4u64 st1.`5 st2.`5 /\ + is4u64 st1.`6 st2.`6 /\ + is4u64 st1.`7 st2.`7 /\ + st1.`8 = st2.`8 /\ + st1.`9 = st2.`9 /\ + st1.`10 = st2.`10. + +op match_states( st1 : W64.t Array4.t * W64.t Array4.t * W64.t Array4.t * W64.t Array4.t * + W64.t Array4.t * W64.t Array4.t * W64.t Array4.t, + st2 : W256.t * W256.t * W256.t * W256.t * W256.t * W256.t * W256.t) = + is4u64 st1.`1 st2.`1 /\ + is4u64 st1.`2 st2.`2 /\ + is4u64 st1.`3 st2.`3 /\ + is4u64 st1.`4 st2.`4 /\ + is4u64 st1.`5 st2.`5 /\ + is4u64 st1.`6 st2.`6 /\ + is4u64 st1.`7 st2.`7. + +equiv prevec_vops_prevec : + Mavx2_prevec.__KeccakF1600 ~ Mavx2_prevec_vops.__KeccakF1600 : + ={Glob.mem} /\ match_ins arg{1} arg{2} ==> ={Glob.mem} /\ match_states res{1} res{2}. +proc. + seq 112 112 : (#pre /\ ={zf,iotas,rhotates_left,rhotates_right,i} /\ + forall i, 0 <= i < 9 => is4u64 t{1}.[i] t{2}.[i]). + seq 30 30 : (#pre /\ ={iotas,rhotates_left,rhotates_right,i} /\ + forall i, 0 <= i < 9 => is4u64 t{1}.[i] t{2}.[i] /\ + is4u64 d14{1} d14{2}). +call (eq_iVPSLLV_4u64). +call (eq_ilxor4u64). +call (eq_iVPBLENDD_256). +call (eq_iVPBLENDD_256). +call (eq_ilxor4u64). +call (eq_ilxor4u64). +call (eq_ilor4u64). +call (eq_ivadd64u256). +call (eq_ivshr64u256). +call (eq_ilxor4u64). +call (eq_ilxor4u64). +call (eq_iVPERMQ). +call (eq_ilxor4u64). +call (eq_iVPERMQ). +call (eq_ilor4u64). +call (eq_ivadd64u256). +call (eq_ivshr64u256). +call (eq_iVPERMQ). +call (eq_ilxor4u64). +call (eq_iVPERMQ). +call (eq_ilxor4u64). +call (eq_ilxor4u64). +call (eq_ilxor4u64). +call (eq_ilxor4u64). +call (eq_iVPSHUFD_256). +wp;skip;rewrite /match_ins /is4u64;auto => />. +progress. +admit. admit. +(* and so on *) +admit. + while (#pre). + seq 30 30 : (#pre /\ is4u64 d14{1} d14{2}). +call (eq_iVPSRLV_4u64). +call (eq_iVPSLLV_4u64). +call (eq_ilxor4u64). +call (eq_ilor4u64). +call (eq_iVPSRLV_4u64). +call (eq_iVPSLLV_4u64). +call (eq_ilxor4u64). +call (eq_iVPBLENDD_256). +call (eq_iVPBLENDD_256). +call (eq_ilxor4u64). +call (eq_ilxor4u64). +call (eq_ilor4u64). +call (eq_ivadd64u256). +call (eq_ivshr64u256). +call (eq_ilxor4u64). +call (eq_ilxor4u64). +call (eq_iVPERMQ). +call (eq_ilxor4u64). +call (eq_iVPERMQ). +call (eq_ilor4u64). +call (eq_ivadd64u256). +call (eq_ivshr64u256). +call (eq_iVPERMQ). +call (eq_ilxor4u64). +call (eq_iVPERMQ). +call (eq_ilxor4u64). +call (eq_ilxor4u64). +call (eq_ilxor4u64). +call (eq_ilxor4u64). +call (eq_iVPSHUFD_256). +wp;skip;rewrite /match_ins /is4u64;auto => />. +progress. +admit. admit. admit. admit. admit. +admit. +by auto => />. +qed. diff --git a/proof/impl/perm/keccak_f1600_ref.ec b/proof/impl/perm/keccak_f1600_ref.ec index fdfb1d3..7c28a26 100644 --- a/proof/impl/perm/keccak_f1600_ref.ec +++ b/proof/impl/perm/keccak_f1600_ref.ec @@ -4,34 +4,7 @@ from Jasmin require import JModel. require import Array5 Array24 Array25. require import WArray40 WArray192 WArray200. -require import Ops. -op iotas : W64.t Array24.t = (( - witness - .[0 <- W64.one] - .[1 <- W64.of_int 32898] - .[2 <- W64.of_int 9223372036854808714] - .[3 <- W64.of_int 9223372039002292224] - .[4 <- W64.of_int 32907] - .[5 <- W64.of_int 2147483649] - .[6 <- W64.of_int 9223372039002292353] - .[7 <- W64.of_int 9223372036854808585] - .[8 <- W64.of_int 138] - .[9 <- W64.of_int 136] - .[10 <- W64.of_int 2147516425] - .[11 <- W64.of_int 2147483658] - .[12 <- W64.of_int 2147516555] - .[13 <- W64.of_int 9223372036854775947] - .[14 <- W64.of_int 9223372036854808713] - .[15 <- W64.of_int 9223372036854808579] - .[16 <- W64.of_int 9223372036854808578] - .[17 <- W64.of_int 9223372036854775936] - .[18 <- W64.of_int 32778] - .[19 <- W64.of_int 9223372039002259466] - .[20 <- W64.of_int 9223372039002292353] - .[21 <- W64.of_int 9223372036854808704] - .[22 <- W64.of_int 2147483649] - .[23 <- W64.of_int 9223372039002292232])%Array24). module Mref = { proc index (x:int, y:int) : int = { @@ -225,10 +198,37 @@ module Mref = { } proc keccakRoundConstants () : W64.t Array24.t = { - return iotas; + + var constants:W64.t Array24.t; + constants <- witness; + constants.[0] <- (W64.of_int 1); + constants.[1] <- (W64.of_int 32898); + constants.[2] <- (W64.of_int 9223372036854808714); + constants.[3] <- (W64.of_int 9223372039002292224); + constants.[4] <- (W64.of_int 32907); + constants.[5] <- (W64.of_int 2147483649); + constants.[6] <- (W64.of_int 9223372039002292353); + constants.[7] <- (W64.of_int 9223372036854808585); + constants.[8] <- (W64.of_int 138); + constants.[9] <- (W64.of_int 136); + constants.[10] <- (W64.of_int 2147516425); + constants.[11] <- (W64.of_int 2147483658); + constants.[12] <- (W64.of_int 2147516555); + constants.[13] <- (W64.of_int 9223372036854775947); + constants.[14] <- (W64.of_int 9223372036854808713); + constants.[15] <- (W64.of_int 9223372036854808579); + constants.[16] <- (W64.of_int 9223372036854808578); + constants.[17] <- (W64.of_int 9223372036854775936); + constants.[18] <- (W64.of_int 32778); + constants.[19] <- (W64.of_int 9223372039002259466); + constants.[20] <- (W64.of_int 9223372039002292353); + constants.[21] <- (W64.of_int 9223372036854808704); + constants.[22] <- (W64.of_int 2147483649); + constants.[23] <- (W64.of_int 9223372039002292232); + return (constants); } - proc permute (state:W64.t Array25.t) : W64.t Array25.t = { + proc __keccak_f1600_ref (state:W64.t Array25.t) : W64.t Array25.t = { var aux: int; var constants:W64.t Array24.t; diff --git a/proof/impl/perm/keccak_f1600_ref_op.ec b/proof/impl/perm/keccak_f1600_ref_op.ec new file mode 100644 index 0000000..bb0e5fc --- /dev/null +++ b/proof/impl/perm/keccak_f1600_ref_op.ec @@ -0,0 +1,71 @@ +require import List Int IntExtra IntDiv CoreMap. +from Jasmin require import JModel. + +require import Array5 Array24 Array25. +require import WArray40 WArray192 WArray200. + +require import Ops. + +op iotas : W64.t Array24.t = (( + witness + .[0 <- W64.one] + .[1 <- W64.of_int 32898] + .[2 <- W64.of_int 9223372036854808714] + .[3 <- W64.of_int 9223372039002292224] + .[4 <- W64.of_int 32907] + .[5 <- W64.of_int 2147483649] + .[6 <- W64.of_int 9223372039002292353] + .[7 <- W64.of_int 9223372036854808585] + .[8 <- W64.of_int 138] + .[9 <- W64.of_int 136] + .[10 <- W64.of_int 2147516425] + .[11 <- W64.of_int 2147483658] + .[12 <- W64.of_int 2147516555] + .[13 <- W64.of_int 9223372036854775947] + .[14 <- W64.of_int 9223372036854808713] + .[15 <- W64.of_int 9223372036854808579] + .[16 <- W64.of_int 9223372036854808578] + .[17 <- W64.of_int 9223372036854775936] + .[18 <- W64.of_int 32778] + .[19 <- W64.of_int 9223372039002259466] + .[20 <- W64.of_int 9223372039002292353] + .[21 <- W64.of_int 9223372036854808704] + .[22 <- W64.of_int 2147483649] + .[23 <- W64.of_int 9223372039002292232])%Array24). + +require import Keccak_f1600_ref. + +module Mrefop = { + include Mref [-keccakRoundConstants,__keccak_f1600_ref] + + proc keccakRoundConstants () : W64.t Array24.t = { + return iotas; + } + + + proc __keccak_f1600_ref (state:W64.t Array25.t) : W64.t Array25.t = { + var aux: int; + + var constants:W64.t Array24.t; + var round:int; + constants <- witness; + constants <@ keccakRoundConstants (); + round <- 0; + while (round < 24) { + state <@ keccakP1600_round (state, constants.[round]); + round <- round + 1; + } + return (state); + } +}. + +require import Keccak_f1600_ref. + +equiv ref_refop : + Mref.__keccak_f1600_ref ~ Mrefop.__keccak_f1600_ref : + ={Glob.mem,arg} ==> ={Glob.mem,res}. +proc. +seq 3 3 : (#pre /\ ={round, constants}). +by inline *;auto => />. +by sim. +qed. diff --git a/proof/impl/perm/keccak_f1600_ref_table.ec b/proof/impl/perm/keccak_f1600_ref_table.ec index 11aa491..5907a35 100644 --- a/proof/impl/perm/keccak_f1600_ref_table.ec +++ b/proof/impl/perm/keccak_f1600_ref_table.ec @@ -1,10 +1,7 @@ require import List Int IntExtra IntDiv CoreMap. from Jasmin require import JModel. -require import Keccak_f1600_ref. -import Ops. -import Array24. -import Array25. +require import Array24 Array25. op rhotates(i : int) : int = (( witness @@ -34,8 +31,12 @@ op rhotates(i : int) : int = (( .[23 <- 56] .[24 <- 14])%Array25).[i]. +require import Keccak_f1600_ref_op. +import Ops. + + module RhotatesAlgo = { - include Mref [keccakRhoOffsets] + include Mrefop [keccakRhoOffsets] }. module RhotatesTable = { @@ -154,7 +155,7 @@ by exfalso; smt(). qed. module Mreftable = { - include Mref [-keccakRhoOffsets,rho,keccakP1600_round,permute] + include Mrefop [-keccakRhoOffsets,rho,keccakP1600_round,__keccak_f1600_ref] include RhotatesTable proc rho (a:W64.t Array25.t) : W64.t Array25.t = { @@ -196,7 +197,7 @@ module Mreftable = { return (state); } - proc permute (state:W64.t Array25.t) : W64.t Array25.t = { + proc __keccak_f1600_ref (state:W64.t Array25.t) : W64.t Array25.t = { var aux: int; var constants:W64.t Array24.t; @@ -213,7 +214,7 @@ module Mreftable = { }. lemma ref_reftable : - equiv [ Mref.permute ~ Mreftable.permute : + equiv [ Mrefop.__keccak_f1600_ref ~ Mreftable.__keccak_f1600_ref : ={arg,Glob.mem} ==> ={res,Glob.mem} ]. proc. From d6839371a26df614fbbbbffe6ebf7e1ad94bb5b5 Mon Sep 17 00:00:00 2001 From: Manuel Barbosa Date: Mon, 13 May 2019 13:38:26 +0100 Subject: [PATCH 395/525] Perm proofs cleaned up and up to date with latest implementations --- proof/impl/perm/LoopTransform.ec | 249 ++++++++ proof/impl/perm/keccak_f1600_ref_loop2.ec | 169 ++++++ proof/impl/perm/keccak_f1600_scalar.ec | 197 ++++++ proof/impl/perm/keccak_f1600_scalar_table.ec | 598 +++++++++++++++++++ 4 files changed, 1213 insertions(+) create mode 100644 proof/impl/perm/LoopTransform.ec create mode 100644 proof/impl/perm/keccak_f1600_ref_loop2.ec create mode 100644 proof/impl/perm/keccak_f1600_scalar.ec create mode 100644 proof/impl/perm/keccak_f1600_scalar_table.ec diff --git a/proof/impl/perm/LoopTransform.ec b/proof/impl/perm/LoopTransform.ec new file mode 100644 index 0000000..af09f3c --- /dev/null +++ b/proof/impl/perm/LoopTransform.ec @@ -0,0 +1,249 @@ +require import AllCore StdOrder IntDiv IntExtra. +from Jasmin require import JUtils. + +abbrev [-printing] floor (n k:int) = (n %/ k) * k. + +lemma lt_floorE (k i n:int) : 0 < k => k %| i => i < floor n k <=> i + k <= floor n k. +proof. + move => hk /dvdzP [q] ->. + rewrite (IntOrder.ltr_pmul2r k hk) ltzE -(IntOrder.ler_pmul2r k hk) /#. +qed. + +lemma floor_le n k : 0 < k => floor n k <= n. +proof. rewrite {2}(divz_eq n k); smt (modz_cmp). qed. + +lemma le_floor (k i n:int) : 0 < k => k %| i => i <= n => i <= floor n k. +proof. + rewrite {1}(divz_eq n k)=> hk /dvdzP [q] ->. + case (q * k <= floor n k) => // /ltzNge; rewrite IntOrder.ltr_pmul2r // => /ltzE. + rewrite -(IntOrder.ler_pmul2r k hk); smt (modz_cmp). +qed. + +lemma le_floorE (k i n:int) : 0 < k => k %| i => i <= n <=> i <= floor n k. +proof. move => hk kd; smt (divz_eq modz_cmp le_floor). qed. + +abstract theory ExactIter. +type t. + +op c : int. +axiom c_gt0 : 0 < c. +op step : int. +axiom step_gt0 : 0 < step. + +module type AdvLoop = { + proc body(t:t, i:int) : t +}. + +module Loop(B:AdvLoop) = { + proc loop1 (t:t, n:int) = { + var i; + i = 0; + while (i < n) { + t <@ B.body(t,i); + i <- i + 1; + } + return t; + } + + proc loopk (t:t, n:int, k:int) = { + var i, j; + i = 0; + while (i < n) { + j = 0; + while (j < k) { + t <@ B.body(t, k * i + j); + j <- j + 1; + } + i <- i + 1; + } + return t; + } + + proc loopc (t:t, n:int) = { + var i, j; + i = 0; + while (i < n) { + j = 0; + while (j < c) { + t <@ B.body(t, c * i + j); + j <- j + 1; + } + i <- i + 1; + } + return t; + } + +}. + +module ILoop(B:AdvLoop) = { + proc loop1 (t:t, n:int) = { + var i; + i = 0; + while (i < n) { + t <@ B.body(t,i); + i <- i + step; + } + return t; + } + + proc loopk (t:t, n:int, k:int) = { + var i, j; + i = 0; + while (i + step * k <= n) { + j = 0; + while (j < k) { + t <@ B.body(t, i); + i <- i + step; + j <- j + 1; + } + } + while (i < n) { + t <@ B.body(t,i); + i <- i + step; + } + return t; + } + + proc loopc (t:t, n:int) = { + var i, j; + i = 0; + while (i + step * c <= n) { + j = 0; + while (j < c) { + t <@ B.body(t, i); + i <- i + step; + j <- j + 1; + } + } + while (i < n) { + t <@ B.body(t,i); + i <- i + step; + } + return t; + } + +}. + +section. + +declare module B:AdvLoop. + +equiv loop1_loopk : Loop(B).loop1 ~ Loop(B).loopk : + ={t, glob B} /\ n{1} = (k * n){2} /\ 0 < k{2} ==> ={res, glob B}. +proof. + proc. + async while [ (fun r => i%r < r), (i{1}+k{2})%r ] + [ (fun r => i%r < r), (i{2} + 1)%r ] + ( (i < n){1}) + (true) : + (={t, glob B} /\ (0 <= i <= n){2} /\ 0 < k{2} /\ n{1} = (k * n){2} /\ i{1} = k{2} * i{2}). + + smt(). + smt (). + done. + + move=> &m2; exfalso; smt(). + + move=> &m1; exfalso; smt(). + + move=> v1 v2. + rcondt{2} 1; 1: by auto => /> /#. + rcondf{2} 4; 1: by auto; conseq (_: true);auto. + exlim i{2} => i2. + wp;while (={t,glob B} /\ i{1} = k{2}*i{2} + j{2} /\ 0 <= i{2} < n{2} /\ + 0 <= j{2} <= k{2} /\ v1 = (k{2} * i2 + k{2})%r /\ i{2} = i2 /\ n{1} = (k * n){2}). + + wp;call (_: true);skip => /> &2 h0i hin h0j hjk. + rewrite !RealExtra.lt_fromint => h1 h2 h3. + have := IntOrder.ler_wpmul2l k{2} _ i{2} (n{2} - 1); smt(). + by wp;skip => /> /#. + + rcondf 1; skip => /#. + + rcondf 1; skip => /#. + by auto. +qed. + +equiv loopk_loopc : Loop(B).loopk ~ Loop(B).loopc : ={n,t, glob B} /\ k{1} = c ==> ={res, glob B}. +proof. + proc => /=. + while (={glob B, i, t, n} /\ k{1} = c);2: by auto. + wp;while (={glob B, i, j, t, n} /\ k{1} = c);2: by auto. + by wp;call (_:true);skip. +qed. + +equiv loop1_loopc : + Loop(B).loop1 ~ Loop(B).loopc : + ={t, glob B} /\ n{1} = (c * n){2} ==> ={res, glob B}. +proof. + transitivity Loop(B).loopk + (={t, glob B} /\ n{1} = c * n{2} /\ k{2} = c ==> ={res, glob B}) + (={n,t, glob B} /\ k{1} = c ==> ={res, glob B}). + + by move=> &1 &2 /> 2!->; exists (glob B){2} (t{2}, n{2}, c). + + done. + + conseq loop1_loopk; smt (c_gt0). + apply loopk_loopc. +qed. + +equiv Iloop1_loopk : ILoop(B).loop1 ~ ILoop(B).loopk : ={t, glob B, n} /\ 0 < k{2}==> ={res, glob B}. +proof. + proc => /=; exlim k{2} => k0. + case: (n{2} < 0). + + rcondf{2} 2; 1: by move=> &m1; wp; skip => &m2 />; smt (step_gt0). + by sim; wp; skip. + splitwhile{1} 2 : (i < floor n (step * k0)). + seq 2 2: (={glob B, t, n, i}); last by sim;wp;skip. + async while [ (fun r => i%r < r), (i{1} + step * k{2})%r ] + [ (fun r => i%r < r), (i{2} + step * k{2})%r ] + ( (i < floor n (step * k0)){1}) + (true) : + (={t, glob B, i, n} /\ k{2} = k0 /\ 0 < k{2} /\ (step * k0) %| i{1}). + + move=> />;smt (lt_floorE floor_le step_gt0). + + move=> /> &2 h1 h2 [[]// | h3]. + have h4 := le_floorE (step * k{2}) (i{2} + step * k{2}) n{2} _ _. + + smt (step_gt0). + by apply dvdzD => //; apply dvdzz. + smt (step_gt0). + + done. + + by move=> &m2; exfalso => /#. + + by move=> &m1; exfalso => /#. + + move=> v1 v2. + rcondt{2} 1. + + move=> &1;skip => /> *; smt (step_gt0 lt_floorE floor_le). + rcondf{2} 3. + + move=> &1. + while (j <= k /\ i = i{1} + step * j). + + by wp; call (_:true); skip => /#. + by wp; skip => />; smt (step_gt0). + exlim i{1} => i0. + while (={t, i, glob B, n} /\ i{1} = i0 + step * j{2} /\ v1 = (i0 + step * k{2})%r /\ + k{2} = k0 /\ (step * k0) %| i0 /\ 0 < k{2} /\ 0 <= j{2} <= k{2} /\ + v1 <= (floor n{1} (step * k{2}))%r). + + wp; call (_: true); skip => &1 &2 [#] 7!->> h2 h3 h4 h1. + rewrite le_fromint /= !lt_fromint=> h5 h6 h7 h8 h9 ???? [#] 2!->> /=. + split. smt(). + have <- := IntOrder.ltr_pmul2l step step_gt0 (j{2} + 1) k0. + smt (floor_le step_gt0). + wp; skip => &1 &2 [#] 6!->> h1 h2 h3 h4 2!->> /=. + rewrite le_fromint lt_fromint h2 h1 -lt_floorE /= 2://; 1:smt (step_gt0). + (do! (split => *)); 1..-2: smt(step_gt0). + by case: H1 => [?] [-> ?]; rewrite dvdzD 1:/# (_ : j_R = k0) 1:/# dvdzz. + + rcondf 1; skip => /#. + + rcondf 1; skip => /#. + by auto. +qed. + +equiv Iloopk_loopc : ILoop(B).loopk ~ ILoop(B).loopc : ={n,t, glob B} /\ k{1} = c ==> ={res, glob B}. +proof. + proc => /=; sim. + while (={glob B, i, t, n} /\ k{1} = c);2: by auto. + wp;while (={glob B, i, j, t, n} /\ k{1} = c);2: by auto. + by wp;call (_:true);skip. +qed. + +equiv Iloop1_loopc : + ILoop(B).loop1 ~ ILoop(B).loopc : + ={t, glob B, n} ==> ={res, glob B}. +proof. + transitivity ILoop(B).loopk + (={t, glob B} /\ n{1} = n{2} /\ k{2} = c ==> ={res, glob B}) + (={n,t, glob B} /\ k{1} = c ==> ={res, glob B}). + + by move=> &1 &2 /> 2!->; exists (glob B){2} (t{2}, n{2}, c). + + done. + + conseq Iloop1_loopk; smt (c_gt0). + apply Iloopk_loopc. +qed. + +end section. + +end ExactIter. diff --git a/proof/impl/perm/keccak_f1600_ref_loop2.ec b/proof/impl/perm/keccak_f1600_ref_loop2.ec new file mode 100644 index 0000000..2bfd889 --- /dev/null +++ b/proof/impl/perm/keccak_f1600_ref_loop2.ec @@ -0,0 +1,169 @@ +require import List Int IntExtra IntDiv CoreMap. +from Jasmin require import JModel. + + require import Array5 Array24 Array25. +require import WArray40 WArray192 WArray200. + +require import Keccak_f1600_ref_table. +import Keccak_f1600_ref_op. +import Ops. + +module Mrefloop2 = { + include Mreftable [-__keccak_f1600_ref] + + proc __keccak_f1600_ref (state:W64.t Array25.t) : W64.t Array25.t = { + var aux: int; + + var constants:W64.t Array24.t; + var round:int; + constants <- witness; + constants <@ keccakRoundConstants (); + round <- 0; + state <@ keccakP1600_round (state, constants.[round]); + round <- round + 1; + state <@ keccakP1600_round (state, constants.[round]); + round <- round + 1; + while (round < 24) { + state <@ keccakP1600_round (state, constants.[round]); + state <@ keccakP1600_round (state, constants.[round + 1]); + round <- round + 2; + } + return (state); + } +}. + +require import LoopTransform. +clone import ExactIter with + type t = (W64.t Array25.t * W64.t Array24.t). + +module ExplBody : AdvLoop = { + include Mreftable [-__keccak_f1600_ref] + proc body(st : t,i : int) = { + var rst; + rst <@ keccakP1600_round(st.`1,st.`2.[i]); + return (rst,st.`2); + } +}. + +module Mrefloop = { + include ExplBody + include Loop(ExplBody) [loop1] + + proc __keccak_f1600_ref (state:W64.t Array25.t) : W64.t Array25.t = { + var aux: int; + + var constants:W64.t Array24.t; + var round:int; + constants <- witness; + constants <@ keccakRoundConstants (); + (state,constants) <@ loop1((state,constants),24); + return (state); + } + +}. + +module Mrefloopk = { + include ExplBody + include Loop(ExplBody) [loopk] + + proc __keccak_f1600_ref (state:W64.t Array25.t) : W64.t Array25.t = { + var aux: int; + + var constants:W64.t Array24.t; + var round:int; + constants <- witness; + constants <@ keccakRoundConstants (); + (state,constants) <@ loopk((state,constants),12,2); + return (state); + } + +}. + +lemma reftable_refloop : + equiv [ Mreftable.__keccak_f1600_ref ~ Mrefloop.__keccak_f1600_ref : + ={arg,Glob.mem} ==> ={res,Glob.mem} ]. +proc. +inline Mrefloop.loop1. +inline ExplBody.body. +wp. +while (={Glob.mem} /\ (state{1},constants{1}) = t{2} /\ round{1} = i{2} /\ n{2} = 24). +wp; call(_:true); first by sim. +by auto => />. +wp; call(_:true); first by sim. +by auto => />. +qed. + +lemma refloop_refloopk : + equiv [ Mrefloop.__keccak_f1600_ref ~ Mrefloopk.__keccak_f1600_ref : + ={arg,Glob.mem} ==> ={res,Glob.mem} ]. +proc. +call (loop1_loopk ExplBody). + call(_:true); first by sim. +by auto => />. +qed. + + +lemma refloopk_refloop2 : + equiv [ Mrefloopk.__keccak_f1600_ref ~ Mrefloop2.__keccak_f1600_ref : + ={arg,Glob.mem} ==> ={res,Glob.mem} ]. + +proc. +seq 2 2 : (#pre /\ ={constants}); first by sim. +inline Mrefloopk.loopk. + +unroll {1} 5. +rcondt {1} 5; first by move => *; auto => />. + +unroll {1} 6. +rcondt {1} 6; first by move => *; auto => />. + +seq 7 3 : (#{/~state{1}}pre /\ (state{2},constants{2}) = t{1} /\ k{1} = 2 /\ n{1} = 12 /\ j{1} = 1 /\ i{1} = 0 /\ round{2} = 1). +inline ExplBody.body. +wp; call(_:true); first by sim. +by auto => />. + + +unroll {1} 1. +rcondt {1} 1; first by move => *; auto => />. + +seq 2 2 : (#{/~j{1} = 1}{~round{2}=1}pre /\ j{1} = 2 /\ round{2} = 2). +inline ExplBody.body. +wp; call(_:true); first by sim. +by auto => />. + +seq 1 0 : #pre. while {1} (j{1} = 2 /\ k{1} = 2 /\ (state{2},constants{2}) = t{1} ) 1. move => *. exfalso. smt(). +by auto => />. + +seq 1 0 : (#{/~j{1}}{~i{1}}pre /\ i{1} = 1); first by auto => />. +wp. +while (={Glob.mem} /\ + ={constants} /\ + (state{2}, constants{2}) = t{1} /\ + k{1} = 2 /\ n{1} = 12 /\ + round{2} = 2*i{1}). + +unroll {1} 2. +rcondt {1} 2; first by move => *; auto => />. + +seq 3 1 : (#pre /\ j{1} = 1). +inline ExplBody.body. +wp; call(_:true); first by sim. +by auto => />. + +unroll {1} 1. +rcondt {1} 1; first by move => *; auto => />. + +seq 2 1 : (#{/~ j{1} = 1}pre /\ j{1} = 2). +inline ExplBody.body. +wp; call(_:true); first by sim. +by auto => />. + +seq 1 0 : #pre. while {1} (j{1} = 2 /\ k{1} = 2 /\ (state{2},constants{2}) = t{1} ) 1. move => *. exfalso. smt(). +by auto => />. + +by auto => />; smt(). + +by auto => />. + +qed. + diff --git a/proof/impl/perm/keccak_f1600_scalar.ec b/proof/impl/perm/keccak_f1600_scalar.ec new file mode 100644 index 0000000..590bb2c --- /dev/null +++ b/proof/impl/perm/keccak_f1600_scalar.ec @@ -0,0 +1,197 @@ +require import List Int IntExtra IntDiv CoreMap. +from Jasmin require import JModel. + +require import Array5 Array25. +require import WArray40 WArray200. + + +module Mscalar = { + proc rOL64 (x:W64.t, c:int) : W64.t = { + + var y:W64.t; + var _0:bool; + var _1:bool; + + ( _0, _1, y) <- x86_ROL_64 x (W8.of_int c); + return (y); + } + + proc index (x:int, y:int) : int = { + + var r:int; + + r <- ((5 * (x %% 5)) + (y %% 5)); + return (r); + } + + proc keccak_rho_offsets (i:int) : int = { + var aux: int; + + var r:int; + var x:int; + var y:int; + var t:int; + var z:int; + + r <- 0; + x <- 1; + y <- 0; + t <- 0; + while (t < 24) { + if ((i = (x + (5 * y)))) { + r <- ((((t + 1) * (t + 2)) %/ 2) %% 64); + } else { + + } + z <- (((2 * x) + (3 * y)) %% 5); + x <- y; + y <- z; + t <- t + 1; + } + return (r); + } + + proc rhotates (x:int, y:int) : int = { + + var r:int; + var i:int; + + i <@ index (x, y); + r <@ keccak_rho_offsets (i); + return (r); + } + + proc theta_sum (_A:W64.t Array25.t) : W64.t Array5.t = { + var aux: int; + + var _C:W64.t Array5.t; + var i:int; + var j:int; + _C <- witness; + i <- 0; + while (i < 5) { + _C.[i] <- _A.[((5 * (0 %% 5)) + (i %% 5))]; + j <- 1; + while (j < 5) { + _C.[i] <- (_C.[i] `^` _A.[((5 * (j %% 5)) + (i %% 5))]); + j <- j + 1; + } + i <- i + 1; + } + return (_C); + } + + proc theta_rol (_C:W64.t Array5.t) : W64.t Array5.t = { + var aux: int; + + var _D:W64.t Array5.t; + var i:int; + var r:W64.t; + _D <- witness; + i <- 0; + while (i < 5) { + r <@ rOL64 (_C.[((i + 1) %% 5)], 1); + _D.[i] <- r; + _D.[i] <- (_D.[i] `^` _C.[((i + 4) %% 5)]); + i <- i + 1; + } + return (_D); + } + + proc rol_sum (_D:W64.t Array5.t, _A:W64.t Array25.t, offset:int) : W64.t Array5.t = { + var aux: int; + + var _C:W64.t Array5.t; + var j:int; + var j1:int; + var k:int; + var t:W64.t; + _C <- witness; + j <- 0; + while (j < 5) { + j1 <- ((j + offset) %% 5); + k <@ rhotates (j, j1); + t <- _A.[((5 * (j %% 5)) + (j1 %% 5))]; + t <- (t `^` _D.[j1]); + t <@ rOL64 (t, k); + _C.[j] <- t; + j <- j + 1; + } + return (_C); + } + + proc set_row (_R:W64.t Array25.t, row:int, _C:W64.t Array5.t, iota_0:W64.t) : + W64.t Array25.t = { + var aux: int; + + var j:int; + var j1:int; + var j2:int; + var t:W64.t; + + j <- 0; + while (j < 5) { + j1 <- ((j + 1) %% 5); + j2 <- ((j + 2) %% 5); + t <- ((invw _C.[j1]) `&` _C.[j2]); + if (((row = 0) /\ (j = 0))) { + t <- (t `^` iota_0); + } else { + + } + t <- (t `^` _C.[j]); + _R.[((5 * (row %% 5)) + (j %% 5))] <- t; + j <- j + 1; + } + return (_R); + } + + proc round2x (_A:W64.t Array25.t, _R:W64.t Array25.t, iotas:W64.t, o:int) : + W64.t Array25.t * W64.t Array25.t = { + + var iota_0:W64.t; + var _C:W64.t Array5.t; + var _D:W64.t Array5.t; + _C <- witness; + _D <- witness; + iota_0 <- (loadW64 Glob.mem (W64.to_uint (iotas + (W64.of_int o)))); + _C <@ theta_sum (_A); + _D <@ theta_rol (_C); + _C <@ rol_sum (_D, _A, 0); + _R <@ set_row (_R, 0, _C, iota_0); + _C <@ rol_sum (_D, _A, 3); + _R <@ set_row (_R, 1, _C, iota_0); + _C <@ rol_sum (_D, _A, 1); + _R <@ set_row (_R, 2, _C, iota_0); + _C <@ rol_sum (_D, _A, 4); + _R <@ set_row (_R, 3, _C, iota_0); + _C <@ rol_sum (_D, _A, 2); + _R <@ set_row (_R, 4, _C, iota_0); + return (_A, _R); + } + + proc keccak_f (_A:W64.t Array25.t, iotas:W64.t) : W64.t Array25.t * W64.t = { + + var zf:bool; + var _R:W64.t Array25.t; + var _0:bool; + var _1:bool; + var _2:bool; + var _3:bool; + _R <- witness; + (_A, _R) <@ round2x (_A, _R, iotas, 0); + (_R, _A) <@ round2x (_R, _A, iotas, 8); + iotas <- (iotas + (W64.of_int 16)); + ( _0, _1, _2, _3, zf) <- x86_TEST_8 (truncateu8 iotas) + (W8.of_int 255); + while ((! zf)) { + (_A, _R) <@ round2x (_A, _R, iotas, 0); + (_R, _A) <@ round2x (_R, _A, iotas, 8); + iotas <- (iotas + (W64.of_int 16)); + ( _0, _1, _2, _3, zf) <- x86_TEST_8 (truncateu8 iotas) + (W8.of_int 255); + } + iotas <- (iotas - (W64.of_int 192)); + return (_A, iotas); + } +}. diff --git a/proof/impl/perm/keccak_f1600_scalar_table.ec b/proof/impl/perm/keccak_f1600_scalar_table.ec new file mode 100644 index 0000000..0b843bc --- /dev/null +++ b/proof/impl/perm/keccak_f1600_scalar_table.ec @@ -0,0 +1,598 @@ +require import List Int IntExtra IntDiv CoreMap. +from Jasmin require import JModel. + +require import Array5 Array24 Array25. +require import WArray40 WArray200. + +require import Keccak_f1600_ref_table. +require import Keccak_f1600_ref_loop2. +require import Keccak_f1600_scalar. +require import Keccak_f1600_ref_op. + + +module Mscalarrho = { + include Mscalar [-keccak_rho_offsets,rhotates,rol_sum,round2x,keccak_f] + include RhotatesAlgo + + proc rhotates (x:int, y:int) : int = { + + var r:int; + var i:int; + + i <@ index (x, y); + r <@ keccakRhoOffsets (i); + return (r); + } + + proc rol_sum (_D:W64.t Array5.t, _A:W64.t Array25.t, offset:int) : W64.t Array5.t = { + var aux: int; + + var _C:W64.t Array5.t; + var j:int; + var j1:int; + var k:int; + var t:W64.t; + _C <- witness; + j <- 0; + while (j < 5) { + j1 <- ((j + offset) %% 5); + k <@ rhotates (j, j1); + t <- _A.[((5 * (j %% 5)) + (j1 %% 5))]; + t <- (t `^` _D.[j1]); + t <@ rOL64 (t, k); + _C.[j] <- t; + j <- j + 1; + } + return (_C); + } + + + proc round2x (_A:W64.t Array25.t, _R:W64.t Array25.t, iotas:W64.t, o:int) : + W64.t Array25.t * W64.t Array25.t = { + + var iota_0:W64.t; + var _C:W64.t Array5.t; + var _D:W64.t Array5.t; + _C <- witness; + _D <- witness; + iota_0 <- (loadW64 Glob.mem (W64.to_uint (iotas + (W64.of_int o)))); + _C <@ theta_sum (_A); + _D <@ theta_rol (_C); + _C <@ rol_sum (_D, _A, 0); + _R <@ set_row (_R, 0, _C, iota_0); + _C <@ rol_sum (_D, _A, 3); + _R <@ set_row (_R, 1, _C, iota_0); + _C <@ rol_sum (_D, _A, 1); + _R <@ set_row (_R, 2, _C, iota_0); + _C <@ rol_sum (_D, _A, 4); + _R <@ set_row (_R, 3, _C, iota_0); + _C <@ rol_sum (_D, _A, 2); + _R <@ set_row (_R, 4, _C, iota_0); + return (_A, _R); + } + + proc keccak_f (_A:W64.t Array25.t, iotas:W64.t) : W64.t Array25.t * W64.t = { + + var zf:bool; + var _R:W64.t Array25.t; + var _0:bool; + var _1:bool; + var _2:bool; + var _3:bool; + _R <- witness; + (_A, _R) <@ round2x (_A, _R, iotas, 0); + (_R, _A) <@ round2x (_R, _A, iotas, 8); + iotas <- (iotas + (W64.of_int 16)); + ( _0, _1, _2, _3, zf) <- x86_TEST_8 (truncateu8 iotas) + (W8.of_int 255); + while ((! zf)) { + (_A, _R) <@ round2x (_A, _R, iotas, 0); + (_R, _A) <@ round2x (_R, _A, iotas, 8); + iotas <- (iotas + (W64.of_int 16)); + ( _0, _1, _2, _3, zf) <- x86_TEST_8 (truncateu8 iotas) + (W8.of_int 255); + } + iotas <- (iotas - (W64.of_int 192)); + return (_A, iotas); + } +}. + +equiv scalarrhom : + Mscalar.keccak_f ~ Mscalarrho.keccak_f : + ={Glob.mem,arg} ==> ={res} by sim. + +module Mscalartable = { + include Mscalar [-keccak_rho_offsets,rhotates,rol_sum,round2x,keccak_f] + include RhotatesTable + + proc rhotates (x:int, y:int) : int = { + + var r:int; + var i:int; + + i <@ index (x, y); + r <@ keccakRhoOffsets (i); + return (r); + } + + proc rol_sum (_D:W64.t Array5.t, _A:W64.t Array25.t, offset:int) : W64.t Array5.t = { + var aux: int; + + var _C:W64.t Array5.t; + var j:int; + var j1:int; + var k:int; + var t:W64.t; + _C <- witness; + j <- 0; + while (j < 5) { + j1 <- ((j + offset) %% 5); + k <@ rhotates (j, j1); + t <- _A.[((5 * (j %% 5)) + (j1 %% 5))]; + t <- (t `^` _D.[j1]); + t <@ rOL64 (t, k); + _C.[j] <- t; + j <- j + 1; + } + return (_C); + } + + + proc round2x (_A:W64.t Array25.t, _R:W64.t Array25.t, iotas:W64.t, o:int) : + W64.t Array25.t * W64.t Array25.t = { + + var iota_0:W64.t; + var _C:W64.t Array5.t; + var _D:W64.t Array5.t; + _C <- witness; + _D <- witness; + iota_0 <- (loadW64 Glob.mem (W64.to_uint (iotas + (W64.of_int o)))); + _C <@ theta_sum (_A); + _D <@ theta_rol (_C); + _C <@ rol_sum (_D, _A, 0); + _R <@ set_row (_R, 0, _C, iota_0); + _C <@ rol_sum (_D, _A, 3); + _R <@ set_row (_R, 1, _C, iota_0); + _C <@ rol_sum (_D, _A, 1); + _R <@ set_row (_R, 2, _C, iota_0); + _C <@ rol_sum (_D, _A, 4); + _R <@ set_row (_R, 3, _C, iota_0); + _C <@ rol_sum (_D, _A, 2); + _R <@ set_row (_R, 4, _C, iota_0); + return (_A, _R); + } + + proc keccak_f (_A:W64.t Array25.t, iotas:W64.t) : W64.t Array25.t * W64.t = { + + var zf:bool; + var _R:W64.t Array25.t; + var _0:bool; + var _1:bool; + var _2:bool; + var _3:bool; + _R <- witness; + (_A, _R) <@ round2x (_A, _R, iotas, 0); + (_R, _A) <@ round2x (_R, _A, iotas, 8); + iotas <- (iotas + (W64.of_int 16)); + ( _0, _1, _2, _3, zf) <- x86_TEST_8 (truncateu8 iotas) + (W8.of_int 255); + while ((! zf)) { + (_A, _R) <@ round2x (_A, _R, iotas, 0); + (_R, _A) <@ round2x (_R, _A, iotas, 8); + iotas <- (iotas + (W64.of_int 16)); + ( _0, _1, _2, _3, zf) <- x86_TEST_8 (truncateu8 iotas) + (W8.of_int 255); + } + iotas <- (iotas - (W64.of_int 192)); + return (_A, iotas); + } +}. + +equiv rol_sum : + Mscalarrho.rol_sum ~ Mscalartable.rol_sum : + ={arg} /\ 0 <= offset{1} < 5 ==> ={res}. +proc. +while (={j,_C,_A,_D,offset} /\ 0 <= j{1} <= 5 /\ 0 <= offset{1} < 5). +wp. +call (_:true); first by sim. +inline Mscalartable.rhotates Mscalarrho.rhotates. +wp. +call(rhotates_table_corr). +call (_: ={arg} /\ 0 <= x{1} < 5 /\ 0<=y{1} <5 ==> ={res} /\ 0<= res{1} <25). +proc. by auto => />;smt(). +by auto => />; smt(). +by auto => />; smt(). +qed. + + +equiv round2x : + Mscalarrho.round2x ~ Mscalartable.round2x : + ={Glob.mem,arg} ==> ={res}. +proc. +call (_:true); first by sim. +call (rol_sum). +call (_:true); first by sim. +call (rol_sum). +call (_:true); first by sim. +call (rol_sum). +call (_:true); first by sim. +call (rol_sum). +call (_:true); first by sim. +call (rol_sum). +call (_:true); first by sim. +call (_:true); first by sim. +by auto => />. +qed. + +equiv scalartable : + Mscalarrho.keccak_f ~ Mscalartable.keccak_f : + ={Glob.mem,arg} ==> ={res}. +proc. +wp. +while (={Glob.mem,zf,_A,_R,iotas}). +wp. +call (round2x). +call (round2x). +by auto => />. +wp. +call (round2x). +call (round2x). +by auto => />. +qed. + +op good_iotas (mem : global_mem_t, _iotas : int) = + forall off, 0 <= off < 24 => + loadW64 mem (_iotas + (off * 8)) = iotas.[off]. + +lemma testsem : (forall (x : W64.t), (x86_TEST_8 (truncateu8 x) (W8.of_int 255)).`5 <=> (W64.to_uint x %% 256 = 0)) by admit. + + +lemma scalarcorr _iotas mem : + equiv [ Mrefloop2.__keccak_f1600_ref ~ Mscalartable.keccak_f : + 0 <= _iotas < W64.modulus - 24 * 8 /\ + good_iotas mem _iotas /\ (_iotas - 8*8) %% 256 = 0 /\ + mem = Glob.mem{2} /\ to_uint iotas{2} = _iotas /\ + state{1} = _A{2} ==> mem = Glob.mem{2} /\ to_uint res{2}.`2 = _iotas /\ + res{1} = res{2}.`1 ]. +proc. +seq 2 1 : (#pre /\ constants{1} = iotas); first by inline *;auto => />. + +seq 1 0 : (#{/~iotas{2}}pre /\ + _iotas = to_uint iotas{2} - round{1} * 8 /\ + round{1} = 0 /\ + state{1} = _A{2}); first by auto => />. + +seq 4 3: (#{/~round{1} = 0}pre /\ round{1} = 2). + +inline Mreftable.keccakP1600_round Mscalartable.round2x. + +swap {2}[5..6] -4. seq 0 2 : #pre; first by auto => />. + +swap {1} 2 -1. +swap {2} [3..5] -2. + +seq 1 3 : (#pre /\ iota_0{2} = c{1}). +inline *;wp;skip; rewrite /good_iotas /iotas; auto => />. +move => &2 bound1 bound2 Tass. +progress. +by move : (Tass 0) => //=. + +sp. +inline Mreftable.theta. +seq 7 2 : (#pre /\ a{1}=state0{1} /\ d{1} = _D{2}). +inline *;sp 3 2. +seq 2 2 : (#{/~c1{1}}{~_C1{2}}pre /\ c1{1} = _C1{2}). +do 6!(unroll for {1} ^while). +do 6!(unroll for {2} ^while). +by auto => />. + +seq 0 0 : #{/~_C{2}}pre; first by auto => />. +sp 0 3;wp. + +unroll for {1} 2. +unroll for {2} 2. +by auto => />. + +seq 8 11 : (#{/~state{1}}{~state0{1}}{~_A0{2}}{~_R0{2}}pre /\ state{1} = _R{2}). +inline *. +do 30!(unroll for {1} ^while). +do 10!(unroll for {2} ^while). + +do !((rcondt {2} ^if; first by move => *; wp;skip;auto => />) || + (rcondf {2} ^if; first by move => *; wp;skip;auto => />)). + +wp;skip. +move => &1 &2. +move => H. +simplify. +split; last first. +apply Array25.ext_eq. +move => x Hx. +case (x = 0); first by auto => />;smt( @W64). +case (x = 1); first by auto => />;smt( @W64). +case (x = 2); first by auto => />;smt( @W64). +case (x = 3); first by auto => />;smt( @W64). +case (x = 4); first by auto => />;smt( @W64). +case (x = 5); first by auto => />;smt( @W64). +case (x = 6); first by auto => />;smt( @W64). +case (x = 7); first by auto => />;smt( @W64). +case (x = 8); first by auto => />;smt( @W64). +case (x = 9); first by auto => />;smt( @W64). +case (x = 10); first by auto => />;smt( @W64). +case (x = 11); first by auto => />;smt( @W64). +case (x = 12); first by auto => />;smt( @W64). +case (x = 13); first by auto => />;smt( @W64). +case (x = 14); first by auto => />;smt( @W64). +case (x = 15); first by auto => />;smt( @W64). +case (x = 16); first by auto => />;smt( @W64). +case (x = 17); first by auto => />;smt( @W64). +case (x = 18); first by auto => />;smt( @W64). +case (x = 19); first by auto => />;smt( @W64). +case (x = 20); first by auto => />;smt( @W64). +case (x = 21); first by auto => />;smt( @W64). +case (x = 22); first by auto => />;smt( @W64). +case (x = 23); first by auto => />;smt( @W64). +case (x = 24); first by auto => />;smt( @W64). +by smt(). + +progress; [ 1 : by smt() | 2: by move : H => [/ #] | 3..: by smt() ]. + +(* Second round *) + +swap {2}[5..6] -4. seq 0 2 : #pre; first by auto => />. + +swap {1} 3 -1. +swap {2} [3..5] -2. + +seq 2 3 : (#{/~round{1}}pre /\ + round{1} = 1 /\ + (round{1} - 1) * 8 + _iotas = to_uint iotas{2} + /\ iota_00{2} = c0{1}). + +inline *;wp;skip; rewrite /good_iotas /iotas; auto => />. +move => &2 bound1 bound2 Tass. +move : (Tass 1) => //=. +rewrite (_ : to_uint (iotas{2} + (of_int 8)%W64) = to_uint iotas{2} + 8). rewrite to_uintD. smt(@W64). by trivial. + +seq 8 4 : (#pre /\ a0{1}=state{1} /\ d0{1} = _D0{2} /\ _A1{2} = a0{1}). +inline *; sp 4 4. +seq 2 2 : (#{/~c2{1}}{~_C1{2}}pre /\ c2{1} = _C1{2}). +do 6!(unroll for {1} ^while). +do 6!(unroll for {2} ^while). +by auto => />. + +sp 0 3;wp. +unroll for {1} 2. +unroll for {2} 2. +by auto => />. + +seq 8 11 : (#{/~state{1}}{~_A1{2}}pre /\ state{1} = _A{2}). +inline *. +do 30!(unroll for {1} ^while). +do 10!(unroll for {2} ^while). + +do !((rcondt {2} ^if; first by move => *; wp;skip;auto => />) || + (rcondf {2} ^if; first by move => *; wp;skip;auto => />)). + +wp;skip. +move => &1 &2. +move => H. +simplify. +split; last first. +apply Array25.ext_eq. +move => x Hx. +case (x = 0); first by auto => />;smt( @W64). +case (x = 1); first by auto => />;smt( @W64). +case (x = 2); first by auto => />;smt( @W64). +case (x = 3); first by auto => />;smt( @W64). +case (x = 4); first by auto => />;smt( @W64). +case (x = 5); first by auto => />;smt( @W64). +case (x = 6); first by auto => />;smt( @W64). +case (x = 7); first by auto => />;smt( @W64). +case (x = 8); first by auto => />;smt( @W64). +case (x = 9); first by auto => />;smt( @W64). +case (x = 10); first by auto => />;smt( @W64). +case (x = 11); first by auto => />;smt( @W64). +case (x = 12); first by auto => />;smt( @W64). +case (x = 13); first by auto => />;smt( @W64). +case (x = 14); first by auto => />;smt( @W64). +case (x = 15); first by auto => />;smt( @W64). +case (x = 16); first by auto => />;smt( @W64). +case (x = 17); first by auto => />;smt( @W64). +case (x = 18); first by auto => />;smt( @W64). +case (x = 19); first by auto => />;smt( @W64). +case (x = 20); first by auto => />;smt( @W64). +case (x = 21); first by auto => />;smt( @W64). +case (x = 22); first by auto => />;smt( @W64). +case (x = 23); first by auto => />;smt( @W64). +case (x = 24); first by auto => />;smt( @W64). +by smt(). + +progress; [ 1 : by smt() | 2: by move : H => [/ #] | 3..: by smt() ]. + +auto => />. +progress. +rewrite to_uintD. +by smt(@W64). + +(* Main loop *) + +seq 0 1 : (#{/~round{1} = 2}pre /\ 0 < round{1} <= 24 /\ round{1} %% 2 = 0 /\ + zf{2} = (x86_TEST_8 (truncateu8 iotas{2}) ((of_int 255))%W8).`5); first by auto => />. +wp. +while (#pre). +wp. + +inline Mreftable.keccakP1600_round Mscalartable.round2x. + +swap {2}[5..6] -4. seq 0 2 : #pre; first by auto => />. + +swap {1} 2 -1. +swap {2} [3..5] -2. + +seq 1 3 : (#pre /\ iota_0{2} = c{1}). +inline *;wp;skip; rewrite /good_iotas /iotas; auto => />. +move => &1 &2 bound1 bound2 Tass. +progress. +move : (Tass round{1}) => //=. +rewrite (_: to_uint iotas{2} - round{1} * 8 + round{1} * 8 = to_uint iotas{2}); first by ring. +smt(). + +inline Mreftable.theta. +seq 8 4 : (#pre /\ a{1}=state{1} /\ d{1} = _D{2} /\ _A0{2} = _A{2}). +inline *; sp 4 4. +seq 2 2 : (#{/~c1{1}}{~_C1{2}}pre /\ c1{1} = _C1{2}). +do 6!(unroll for {1} ^while). +do 6!(unroll for {2} ^while). +by auto => />. + +seq 0 0 : #{/~_C{2}}pre; first by auto => />. +sp 0 3;wp. +unroll for {1} 2. +unroll for {2} 2. +by auto => />. +seq 8 11 : (#{/~state{1}}{~state0{1}}{~_A0{2}}{~_R0{2}}pre /\ state{1} = _R{2}). +inline *. +do 30!(unroll for {1} ^while). +do 10!(unroll for {2} ^while). + +do !((rcondt {2} ^if; first by move => *; wp;skip;auto => />) || + (rcondf {2} ^if; first by move => *; wp;skip;auto => />)). +wp;skip. +move => &1 &2. +move => H. +simplify. +split; last first. +apply Array25.ext_eq. +move => x Hx. +case (x = 0); first by auto => />;smt( @W64). +case (x = 1); first by auto => />;smt( @W64). +case (x = 2); first by auto => />;smt( @W64). +case (x = 3); first by auto => />;smt( @W64). +case (x = 4); first by auto => />;smt( @W64). +case (x = 5); first by auto => />;smt( @W64). +case (x = 6); first by auto => />;smt( @W64). +case (x = 7); first by auto => />;smt( @W64). +case (x = 8); first by auto => />;smt( @W64). +case (x = 9); first by auto => />;smt( @W64). +case (x = 10); first by auto => />;smt( @W64). +case (x = 11); first by auto => />;smt( @W64). +case (x = 12); first by auto => />;smt( @W64). +case (x = 13); first by auto => />;smt( @W64). +case (x = 14); first by auto => />;smt( @W64). +case (x = 15); first by auto => />;smt( @W64). +case (x = 16); first by auto => />;smt( @W64). +case (x = 17); first by auto => />;smt( @W64). +case (x = 18); first by auto => />;smt( @W64). +case (x = 19); first by auto => />;smt( @W64). +case (x = 20); first by auto => />;smt( @W64). +case (x = 21); first by auto => />;smt( @W64). +case (x = 22); first by auto => />;smt( @W64). +case (x = 23); first by auto => />;smt( @W64). +case (x = 24); first by auto => />;smt( @W64). +by smt(). + +progress; [ 1 : by smt() | 2: by move : H => [/ #] | 3..: by smt() ]. + +(* Second round *) + +swap {2}[5..6] -4. seq 0 2 : #pre; first by auto => />. +swap {1} 2 -1. +swap {2} [3..5] -2. + +seq 1 3 : (#pre /\ iota_00{2} = c0{1}). +inline *;wp;skip; rewrite /good_iotas /iotas; auto => />. +move => &1 &2 bound1 bound2 Tass. +progress. +move : (Tass (round{1} + 1)) => //=. +rewrite (_: to_uint iotas{2} - round{1} * 8 + (round{1} + 1) * 8 = to_uint (iotas{2} + (of_int 8)%W64)). +rewrite to_uintD. +have bb : (to_uint iotas{2} + to_uint ((of_int 8))%W64 < W64.modulus). +smt(). +smt(@W64). +smt(). + +seq 8 4 : (#pre /\ a0{1}=state{1} /\ d0{1} = _D0{2} /\ _A1{2} = a0{1}). +inline *;sp 4 4. +seq 2 2 : (#{/~c2{1}}{~_C1{2}}pre /\ c2{1} = _C1{2}). +do 6!(unroll for {1} ^while). +do 6!(unroll for {2} ^while). +by auto => />. + +sp 0 3;wp. +unroll for {1} 2. +unroll for {2} 2. +by auto => />. + +seq 8 11 : (#{/~state{1}}{~_A1{2}}pre /\ state{1} = _A{2}). +inline *. +do 30!(unroll for {1} ^while). +do 10!(unroll for {2} ^while). + +do !((rcondt {2} ^if; first by move => *; wp;skip;auto => />) || + (rcondf {2} ^if; first by move => *; wp;skip;auto => />)). +wp;skip. +move => &1 &2. +move => H. +simplify. +split; last first. +apply Array25.ext_eq. +move => x Hx. +case (x = 0); first by auto => />;smt( @W64). +case (x = 1); first by auto => />;smt( @W64). +case (x = 2); first by auto => />;smt( @W64). +case (x = 3); first by auto => />;smt( @W64). +case (x = 4); first by auto => />;smt( @W64). +case (x = 5); first by auto => />;smt( @W64). +case (x = 6); first by auto => />;smt( @W64). +case (x = 7); first by auto => />;smt( @W64). +case (x = 8); first by auto => />;smt( @W64). +case (x = 9); first by auto => />;smt( @W64). +case (x = 10); first by auto => />;smt( @W64). +case (x = 11); first by auto => />;smt( @W64). +case (x = 12); first by auto => />;smt( @W64). +case (x = 13); first by auto => />;smt( @W64). +case (x = 14); first by auto => />;smt( @W64). +case (x = 15); first by auto => />;smt( @W64). +case (x = 16); first by auto => />;smt( @W64). +case (x = 17); first by auto => />;smt( @W64). +case (x = 18); first by auto => />;smt( @W64). +case (x = 19); first by auto => />;smt( @W64). +case (x = 20); first by auto => />;smt( @W64). +case (x = 21); first by auto => />;smt( @W64). +case (x = 22); first by auto => />;smt( @W64). +case (x = 23); first by auto => />;smt( @W64). +case (x = 24); first by auto => />;smt( @W64). +by smt(). + +progress; [ 1 : by smt() | 2: by move : H => [/ #] | 3..: by smt() ]. + +auto => />. + +progress. +rewrite to_uintD;smt(). +smt(). smt(). smt(). +rewrite (testsem (iotas{2} + (of_int 16)%W64)). +rewrite to_uintD. +rewrite (_ : (to_uint iotas{2} + to_uint ((of_int 16))%W64) %% W64.modulus %% 256 = (to_uint iotas{2} + to_uint ((of_int 16))%W64) %% 256). smt. smt(). + +move : H8. +rewrite testsem. +rewrite to_uintD. +rewrite (_ : (to_uint iotas{2} + to_uint ((of_int 16))%W64) %% W64.modulus %% 256 = (to_uint iotas{2} + to_uint ((of_int 16))%W64) %% 256). smt. smt(). + +auto => />. +progress. +rewrite (testsem (iotas{2}));smt(). +move : H6. +rewrite testsem;smt(). + +move : H12. +rewrite testsem => //= *. +move : H8; rewrite (_ : round_L = 24); first by smt(). +move => *. +have ir : (to_uint iotas{2} - round{1} * 8 + 24*8) %% 256 = 0. smt(). +rewrite (_ : iotas_R = W64.of_int (to_uint iotas{2} - round{1} * 8 + 24*8)). +smt(@W64). +smt(@W64 @W8). +qed. From be90ff38207b2854e5447a6a8f6fe769b74c5cc2 Mon Sep 17 00:00:00 2001 From: Manuel Barbosa Date: Mon, 13 May 2019 19:17:09 +0100 Subject: [PATCH 396/525] Equivalence of full implementations --- proof/impl/libc/Array24.ec | 3 + proof/impl/libc/Array25.ec | 3 + proof/impl/libc/Array28.ec | 3 + proof/impl/libc/Array5.ec | 3 + proof/impl/libc/Array7.ec | 3 + proof/impl/libc/Array9.ec | 3 + proof/impl/libc/WArray192.ec | 3 + proof/impl/libc/WArray200.ec | 3 + proof/impl/libc/WArray224.ec | 3 + proof/impl/libc/WArray288.ec | 3 + proof/impl/libc/WArray40.ec | 3 + proof/impl/libc/keccak_1600_avx2.ec | 1051 +++++++++++++++++++ proof/impl/libc/keccak_1600_avx2_modular.ec | 428 ++++++++ proof/impl/libc/keccak_1600_ref.ec | 419 ++++++++ proof/impl/libc/keccak_1600_ref_modular.ec | 205 ++++ 15 files changed, 2136 insertions(+) create mode 100644 proof/impl/libc/Array24.ec create mode 100644 proof/impl/libc/Array25.ec create mode 100644 proof/impl/libc/Array28.ec create mode 100644 proof/impl/libc/Array5.ec create mode 100644 proof/impl/libc/Array7.ec create mode 100644 proof/impl/libc/Array9.ec create mode 100644 proof/impl/libc/WArray192.ec create mode 100644 proof/impl/libc/WArray200.ec create mode 100644 proof/impl/libc/WArray224.ec create mode 100644 proof/impl/libc/WArray288.ec create mode 100644 proof/impl/libc/WArray40.ec create mode 100644 proof/impl/libc/keccak_1600_avx2.ec create mode 100644 proof/impl/libc/keccak_1600_avx2_modular.ec create mode 100644 proof/impl/libc/keccak_1600_ref.ec create mode 100644 proof/impl/libc/keccak_1600_ref_modular.ec diff --git a/proof/impl/libc/Array24.ec b/proof/impl/libc/Array24.ec new file mode 100644 index 0000000..8982b77 --- /dev/null +++ b/proof/impl/libc/Array24.ec @@ -0,0 +1,3 @@ +from Jasmin require import JArray. + +clone export PolyArray as Array24 with op size <- 24. diff --git a/proof/impl/libc/Array25.ec b/proof/impl/libc/Array25.ec new file mode 100644 index 0000000..30bcb17 --- /dev/null +++ b/proof/impl/libc/Array25.ec @@ -0,0 +1,3 @@ +from Jasmin require import JArray. + +clone export PolyArray as Array25 with op size <- 25. diff --git a/proof/impl/libc/Array28.ec b/proof/impl/libc/Array28.ec new file mode 100644 index 0000000..24bf4f6 --- /dev/null +++ b/proof/impl/libc/Array28.ec @@ -0,0 +1,3 @@ +from Jasmin require import JArray. + +clone export PolyArray as Array28 with op size <- 28. diff --git a/proof/impl/libc/Array5.ec b/proof/impl/libc/Array5.ec new file mode 100644 index 0000000..8dc7b36 --- /dev/null +++ b/proof/impl/libc/Array5.ec @@ -0,0 +1,3 @@ +from Jasmin require import JArray. + +clone export PolyArray as Array5 with op size <- 5. diff --git a/proof/impl/libc/Array7.ec b/proof/impl/libc/Array7.ec new file mode 100644 index 0000000..33f6cc6 --- /dev/null +++ b/proof/impl/libc/Array7.ec @@ -0,0 +1,3 @@ +from Jasmin require import JArray. + +clone export PolyArray as Array7 with op size <- 7. diff --git a/proof/impl/libc/Array9.ec b/proof/impl/libc/Array9.ec new file mode 100644 index 0000000..8759457 --- /dev/null +++ b/proof/impl/libc/Array9.ec @@ -0,0 +1,3 @@ +from Jasmin require import JArray. + +clone export PolyArray as Array9 with op size <- 9. diff --git a/proof/impl/libc/WArray192.ec b/proof/impl/libc/WArray192.ec new file mode 100644 index 0000000..c8564c5 --- /dev/null +++ b/proof/impl/libc/WArray192.ec @@ -0,0 +1,3 @@ +from Jasmin require import JWord_array. + +clone export WArray as WArray192 with op size <- 192. diff --git a/proof/impl/libc/WArray200.ec b/proof/impl/libc/WArray200.ec new file mode 100644 index 0000000..99b887c --- /dev/null +++ b/proof/impl/libc/WArray200.ec @@ -0,0 +1,3 @@ +from Jasmin require import JWord_array. + +clone export WArray as WArray200 with op size <- 200. diff --git a/proof/impl/libc/WArray224.ec b/proof/impl/libc/WArray224.ec new file mode 100644 index 0000000..f9d6745 --- /dev/null +++ b/proof/impl/libc/WArray224.ec @@ -0,0 +1,3 @@ +from Jasmin require import JWord_array. + +clone export WArray as WArray224 with op size <- 224. diff --git a/proof/impl/libc/WArray288.ec b/proof/impl/libc/WArray288.ec new file mode 100644 index 0000000..86ac7cc --- /dev/null +++ b/proof/impl/libc/WArray288.ec @@ -0,0 +1,3 @@ +from Jasmin require import JWord_array. + +clone export WArray as WArray288 with op size <- 288. diff --git a/proof/impl/libc/WArray40.ec b/proof/impl/libc/WArray40.ec new file mode 100644 index 0000000..003b6e2 --- /dev/null +++ b/proof/impl/libc/WArray40.ec @@ -0,0 +1,3 @@ +from Jasmin require import JWord_array. + +clone export WArray as WArray40 with op size <- 40. diff --git a/proof/impl/libc/keccak_1600_avx2.ec b/proof/impl/libc/keccak_1600_avx2.ec new file mode 100644 index 0000000..ba53ceb --- /dev/null +++ b/proof/impl/libc/keccak_1600_avx2.ec @@ -0,0 +1,1051 @@ +require import List Int IntExtra IntDiv CoreMap. +from Jasmin require import JModel. + +require import Array7 Array9 Array28. +require import WArray224 WArray288. + +abbrev g_zero = W64.of_int 0. + + +module M = { + proc __keccak_f1600_avx2 (state:W256.t Array7.t, _rhotates_left:W64.t, + _rhotates_right:W64.t, _iotas:W64.t) : W256.t Array7.t = { + + var rhotates_left:W64.t; + var rhotates_right:W64.t; + var iotas:W64.t; + var r:W32.t; + var zf:bool; + var c00:W256.t; + var c14:W256.t; + var t:W256.t Array9.t; + var d14:W256.t; + var d00:W256.t; + var _0:bool; + var _1:bool; + var _2:bool; + t <- witness; + rhotates_left <- (_rhotates_left + (W64.of_int 96)); + rhotates_right <- (_rhotates_right + (W64.of_int 96)); + iotas <- _iotas; + r <- (W32.of_int 24); + c00 <- x86_VPSHUFD_256 state.[2] + (W8.of_int (2 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 1)))); + c14 <- (state.[5] `^` state.[3]); + t.[2] <- (state.[4] `^` state.[6]); + c14 <- (c14 `^` state.[1]); + c14 <- (c14 `^` t.[2]); + t.[4] <- x86_VPERMQ c14 + (W8.of_int (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (1 %% 2^2 + 2^2 * 2)))); + c00 <- (c00 `^` state.[2]); + t.[0] <- x86_VPERMQ c00 + (W8.of_int (2 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 1)))); + t.[1] <- (c14 \vshr64u256 (W8.of_int 63)); + t.[2] <- (c14 \vadd64u256 c14); + t.[1] <- (t.[1] `|` t.[2]); + d14 <- x86_VPERMQ t.[1] + (W8.of_int (1 %% 2^2 + 2^2 * (2 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + d00 <- (t.[1] `^` t.[4]); + d00 <- x86_VPERMQ d00 + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + c00 <- (c00 `^` state.[0]); + c00 <- (c00 `^` t.[0]); + t.[0] <- (c00 \vshr64u256 (W8.of_int 63)); + t.[1] <- (c00 \vadd64u256 c00); + t.[1] <- (t.[1] `|` t.[0]); + state.[2] <- (state.[2] `^` d00); + state.[0] <- (state.[0] `^` d00); + d14 <- x86_VPBLENDD_256 d14 t.[1] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + t.[4] <- x86_VPBLENDD_256 t.[4] c00 + (W8.of_int (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + d14 <- (d14 `^` t.[4]); + t.[3] <- x86_VPSLLV_4u64 state.[2] + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((32 * 0) - 96))))); + state.[2] <- x86_VPSRLV_4u64 state.[2] + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((32 * 0) - 96))))); + state.[2] <- (state.[2] `|` t.[3]); + state.[3] <- (state.[3] `^` d14); + t.[4] <- x86_VPSLLV_4u64 state.[3] + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((32 * 2) - 96))))); + state.[3] <- x86_VPSRLV_4u64 state.[3] + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((32 * 2) - 96))))); + state.[3] <- (state.[3] `|` t.[4]); + state.[4] <- (state.[4] `^` d14); + t.[5] <- x86_VPSLLV_4u64 state.[4] + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((32 * 3) - 96))))); + state.[4] <- x86_VPSRLV_4u64 state.[4] + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((32 * 3) - 96))))); + state.[4] <- (state.[4] `|` t.[5]); + state.[5] <- (state.[5] `^` d14); + t.[6] <- x86_VPSLLV_4u64 state.[5] + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((32 * 4) - 96))))); + state.[5] <- x86_VPSRLV_4u64 state.[5] + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((32 * 4) - 96))))); + state.[5] <- (state.[5] `|` t.[6]); + state.[6] <- (state.[6] `^` d14); + t.[3] <- x86_VPERMQ state.[2] + (W8.of_int (1 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 2)))); + t.[4] <- x86_VPERMQ state.[3] + (W8.of_int (1 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 2)))); + t.[7] <- x86_VPSLLV_4u64 state.[6] + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((32 * 5) - 96))))); + t.[1] <- x86_VPSRLV_4u64 state.[6] + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((32 * 5) - 96))))); + t.[1] <- (t.[1] `|` t.[7]); + state.[1] <- (state.[1] `^` d14); + t.[5] <- x86_VPERMQ state.[4] + (W8.of_int (3 %% 2^2 + 2^2 * (2 %% 2^2 + 2^2 * (1 %% 2^2 + 2^2 * 0)))); + t.[6] <- x86_VPERMQ state.[5] + (W8.of_int (2 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 1)))); + t.[8] <- x86_VPSLLV_4u64 state.[1] + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((32 * 1) - 96))))); + t.[2] <- x86_VPSRLV_4u64 state.[1] + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((32 * 1) - 96))))); + t.[2] <- (t.[2] `|` t.[8]); + t.[7] <- x86_VPSRLDQ_256 t.[1] (W8.of_int 8); + t.[0] <- ((invw t.[1]) `&` t.[7]); + state.[3] <- x86_VPBLENDD_256 t.[2] t.[6] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[8] <- x86_VPBLENDD_256 t.[4] t.[2] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[5] <- x86_VPBLENDD_256 t.[3] t.[4] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[7] <- x86_VPBLENDD_256 t.[2] t.[3] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[3] <- x86_VPBLENDD_256 state.[3] t.[4] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[8] <- x86_VPBLENDD_256 t.[8] t.[5] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[5] <- x86_VPBLENDD_256 state.[5] t.[2] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[7] <- x86_VPBLENDD_256 t.[7] t.[6] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[3] <- x86_VPBLENDD_256 state.[3] t.[5] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + t.[8] <- x86_VPBLENDD_256 t.[8] t.[6] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + state.[5] <- x86_VPBLENDD_256 state.[5] t.[6] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + t.[7] <- x86_VPBLENDD_256 t.[7] t.[4] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + state.[3] <- ((invw state.[3]) `&` t.[8]); + state.[5] <- ((invw state.[5]) `&` t.[7]); + state.[6] <- x86_VPBLENDD_256 t.[5] t.[2] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[8] <- x86_VPBLENDD_256 t.[3] t.[5] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[3] <- (state.[3] `^` t.[3]); + state.[6] <- x86_VPBLENDD_256 state.[6] t.[3] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[8] <- x86_VPBLENDD_256 t.[8] t.[4] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[5] <- (state.[5] `^` t.[5]); + state.[6] <- x86_VPBLENDD_256 state.[6] t.[4] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + t.[8] <- x86_VPBLENDD_256 t.[8] t.[2] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + state.[6] <- ((invw state.[6]) `&` t.[8]); + state.[6] <- (state.[6] `^` t.[6]); + state.[4] <- x86_VPERMQ t.[1] + (W8.of_int (2 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (1 %% 2^2 + 2^2 * 0)))); + t.[8] <- x86_VPBLENDD_256 state.[4] state.[0] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[1] <- x86_VPERMQ t.[1] + (W8.of_int (1 %% 2^2 + 2^2 * (2 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + state.[1] <- x86_VPBLENDD_256 state.[1] state.[0] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + state.[1] <- ((invw state.[1]) `&` t.[8]); + state.[2] <- x86_VPBLENDD_256 t.[4] t.[5] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[7] <- x86_VPBLENDD_256 t.[6] t.[4] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[2] <- x86_VPBLENDD_256 state.[2] t.[6] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[7] <- x86_VPBLENDD_256 t.[7] t.[3] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[2] <- x86_VPBLENDD_256 state.[2] t.[3] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + t.[7] <- x86_VPBLENDD_256 t.[7] t.[5] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + state.[2] <- ((invw state.[2]) `&` t.[7]); + state.[2] <- (state.[2] `^` t.[2]); + t.[0] <- x86_VPERMQ t.[0] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + state.[3] <- x86_VPERMQ state.[3] + (W8.of_int (3 %% 2^2 + 2^2 * (2 %% 2^2 + 2^2 * (1 %% 2^2 + 2^2 * 0)))); + state.[5] <- x86_VPERMQ state.[5] + (W8.of_int (1 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 2)))); + state.[6] <- x86_VPERMQ state.[6] + (W8.of_int (2 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 1)))); + state.[4] <- x86_VPBLENDD_256 t.[6] t.[3] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[7] <- x86_VPBLENDD_256 t.[5] t.[6] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[4] <- x86_VPBLENDD_256 state.[4] t.[5] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[7] <- x86_VPBLENDD_256 t.[7] t.[2] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[4] <- x86_VPBLENDD_256 state.[4] t.[2] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + t.[7] <- x86_VPBLENDD_256 t.[7] t.[3] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + state.[4] <- ((invw state.[4]) `&` t.[7]); + state.[0] <- (state.[0] `^` t.[0]); + state.[1] <- (state.[1] `^` t.[1]); + state.[4] <- (state.[4] `^` t.[4]); + state.[0] <- + (state.[0] `^` (loadW256 Glob.mem (W64.to_uint (iotas + (W64.of_int ((32 * 0) - 0)))))); + iotas <- (iotas + (W64.of_int 32)); + ( _0, _1, _2, zf, r) <- x86_DEC_32 r; + while ((! zf)) { + c00 <- x86_VPSHUFD_256 state.[2] + (W8.of_int (2 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 1)))); + c14 <- (state.[5] `^` state.[3]); + t.[2] <- (state.[4] `^` state.[6]); + c14 <- (c14 `^` state.[1]); + c14 <- (c14 `^` t.[2]); + t.[4] <- x86_VPERMQ c14 + (W8.of_int (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (1 %% 2^2 + 2^2 * 2)))); + c00 <- (c00 `^` state.[2]); + t.[0] <- x86_VPERMQ c00 + (W8.of_int (2 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 1)))); + t.[1] <- (c14 \vshr64u256 (W8.of_int 63)); + t.[2] <- (c14 \vadd64u256 c14); + t.[1] <- (t.[1] `|` t.[2]); + d14 <- x86_VPERMQ t.[1] + (W8.of_int (1 %% 2^2 + 2^2 * (2 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + d00 <- (t.[1] `^` t.[4]); + d00 <- x86_VPERMQ d00 + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + c00 <- (c00 `^` state.[0]); + c00 <- (c00 `^` t.[0]); + t.[0] <- (c00 \vshr64u256 (W8.of_int 63)); + t.[1] <- (c00 \vadd64u256 c00); + t.[1] <- (t.[1] `|` t.[0]); + state.[2] <- (state.[2] `^` d00); + state.[0] <- (state.[0] `^` d00); + d14 <- x86_VPBLENDD_256 d14 t.[1] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + t.[4] <- x86_VPBLENDD_256 t.[4] c00 + (W8.of_int (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + d14 <- (d14 `^` t.[4]); + t.[3] <- x86_VPSLLV_4u64 state.[2] + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((32 * 0) - 96))))); + state.[2] <- x86_VPSRLV_4u64 state.[2] + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((32 * 0) - 96))))); + state.[2] <- (state.[2] `|` t.[3]); + state.[3] <- (state.[3] `^` d14); + t.[4] <- x86_VPSLLV_4u64 state.[3] + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((32 * 2) - 96))))); + state.[3] <- x86_VPSRLV_4u64 state.[3] + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((32 * 2) - 96))))); + state.[3] <- (state.[3] `|` t.[4]); + state.[4] <- (state.[4] `^` d14); + t.[5] <- x86_VPSLLV_4u64 state.[4] + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((32 * 3) - 96))))); + state.[4] <- x86_VPSRLV_4u64 state.[4] + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((32 * 3) - 96))))); + state.[4] <- (state.[4] `|` t.[5]); + state.[5] <- (state.[5] `^` d14); + t.[6] <- x86_VPSLLV_4u64 state.[5] + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((32 * 4) - 96))))); + state.[5] <- x86_VPSRLV_4u64 state.[5] + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((32 * 4) - 96))))); + state.[5] <- (state.[5] `|` t.[6]); + state.[6] <- (state.[6] `^` d14); + t.[3] <- x86_VPERMQ state.[2] + (W8.of_int (1 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 2)))); + t.[4] <- x86_VPERMQ state.[3] + (W8.of_int (1 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 2)))); + t.[7] <- x86_VPSLLV_4u64 state.[6] + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((32 * 5) - 96))))); + t.[1] <- x86_VPSRLV_4u64 state.[6] + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((32 * 5) - 96))))); + t.[1] <- (t.[1] `|` t.[7]); + state.[1] <- (state.[1] `^` d14); + t.[5] <- x86_VPERMQ state.[4] + (W8.of_int (3 %% 2^2 + 2^2 * (2 %% 2^2 + 2^2 * (1 %% 2^2 + 2^2 * 0)))); + t.[6] <- x86_VPERMQ state.[5] + (W8.of_int (2 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 1)))); + t.[8] <- x86_VPSLLV_4u64 state.[1] + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((32 * 1) - 96))))); + t.[2] <- x86_VPSRLV_4u64 state.[1] + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((32 * 1) - 96))))); + t.[2] <- (t.[2] `|` t.[8]); + t.[7] <- x86_VPSRLDQ_256 t.[1] (W8.of_int 8); + t.[0] <- ((invw t.[1]) `&` t.[7]); + state.[3] <- x86_VPBLENDD_256 t.[2] t.[6] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[8] <- x86_VPBLENDD_256 t.[4] t.[2] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[5] <- x86_VPBLENDD_256 t.[3] t.[4] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[7] <- x86_VPBLENDD_256 t.[2] t.[3] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[3] <- x86_VPBLENDD_256 state.[3] t.[4] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[8] <- x86_VPBLENDD_256 t.[8] t.[5] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[5] <- x86_VPBLENDD_256 state.[5] t.[2] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[7] <- x86_VPBLENDD_256 t.[7] t.[6] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[3] <- x86_VPBLENDD_256 state.[3] t.[5] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + t.[8] <- x86_VPBLENDD_256 t.[8] t.[6] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + state.[5] <- x86_VPBLENDD_256 state.[5] t.[6] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + t.[7] <- x86_VPBLENDD_256 t.[7] t.[4] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + state.[3] <- ((invw state.[3]) `&` t.[8]); + state.[5] <- ((invw state.[5]) `&` t.[7]); + state.[6] <- x86_VPBLENDD_256 t.[5] t.[2] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[8] <- x86_VPBLENDD_256 t.[3] t.[5] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[3] <- (state.[3] `^` t.[3]); + state.[6] <- x86_VPBLENDD_256 state.[6] t.[3] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[8] <- x86_VPBLENDD_256 t.[8] t.[4] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[5] <- (state.[5] `^` t.[5]); + state.[6] <- x86_VPBLENDD_256 state.[6] t.[4] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + t.[8] <- x86_VPBLENDD_256 t.[8] t.[2] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + state.[6] <- ((invw state.[6]) `&` t.[8]); + state.[6] <- (state.[6] `^` t.[6]); + state.[4] <- x86_VPERMQ t.[1] + (W8.of_int (2 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (1 %% 2^2 + 2^2 * 0)))); + t.[8] <- x86_VPBLENDD_256 state.[4] state.[0] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[1] <- x86_VPERMQ t.[1] + (W8.of_int (1 %% 2^2 + 2^2 * (2 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + state.[1] <- x86_VPBLENDD_256 state.[1] state.[0] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + state.[1] <- ((invw state.[1]) `&` t.[8]); + state.[2] <- x86_VPBLENDD_256 t.[4] t.[5] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[7] <- x86_VPBLENDD_256 t.[6] t.[4] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[2] <- x86_VPBLENDD_256 state.[2] t.[6] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[7] <- x86_VPBLENDD_256 t.[7] t.[3] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[2] <- x86_VPBLENDD_256 state.[2] t.[3] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + t.[7] <- x86_VPBLENDD_256 t.[7] t.[5] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + state.[2] <- ((invw state.[2]) `&` t.[7]); + state.[2] <- (state.[2] `^` t.[2]); + t.[0] <- x86_VPERMQ t.[0] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + state.[3] <- x86_VPERMQ state.[3] + (W8.of_int (3 %% 2^2 + 2^2 * (2 %% 2^2 + 2^2 * (1 %% 2^2 + 2^2 * 0)))); + state.[5] <- x86_VPERMQ state.[5] + (W8.of_int (1 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 2)))); + state.[6] <- x86_VPERMQ state.[6] + (W8.of_int (2 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 1)))); + state.[4] <- x86_VPBLENDD_256 t.[6] t.[3] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[7] <- x86_VPBLENDD_256 t.[5] t.[6] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[4] <- x86_VPBLENDD_256 state.[4] t.[5] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + t.[7] <- x86_VPBLENDD_256 t.[7] t.[2] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + state.[4] <- x86_VPBLENDD_256 state.[4] t.[2] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + t.[7] <- x86_VPBLENDD_256 t.[7] t.[3] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + state.[4] <- ((invw state.[4]) `&` t.[7]); + state.[0] <- (state.[0] `^` t.[0]); + state.[1] <- (state.[1] `^` t.[1]); + state.[4] <- (state.[4] `^` t.[4]); + state.[0] <- + (state.[0] `^` (loadW256 Glob.mem (W64.to_uint (iotas + (W64.of_int ((32 * 0) - 0)))))); + iotas <- (iotas + (W64.of_int 32)); + ( _0, _1, _2, zf, r) <- x86_DEC_32 r; + } + return (state); + } + + proc keccak_init () : W256.t Array7.t = { + var aux: int; + + var state:W256.t Array7.t; + var i:int; + state <- witness; + state.[0] <- x86_VPBROADCAST_4u64 g_zero; + i <- 1; + while (i < 7) { + state.[i] <- state.[0]; + i <- i + 1; + } + return (state); + } + + proc init_s_state () : W64.t Array28.t = { + var aux: int; + + var s_state:W64.t Array28.t; + var zero:W256.t; + var i:int; + s_state <- witness; + zero <- x86_VPBROADCAST_4u64 g_zero; + i <- 0; + while (i < 7) { + s_state = + Array28.init + (WArray224.get64 (WArray224.set256 (WArray224.init64 (fun i => s_state.[i])) i zero)); + i <- i + 1; + } + return (s_state); + } + + proc add_full_block (state:W256.t Array7.t, s_state:W64.t Array28.t, + a_jagged:W64.t, in_0:W64.t, inlen:W64.t, rate:W64.t) : + W256.t Array7.t * W64.t Array28.t * W64.t * W64.t = { + var aux: int; + + var rate8:W64.t; + var j:W64.t; + var t:W64.t; + var l:W64.t; + var i:int; + + rate8 <- rate; + rate8 <- (rate8 `>>` (W8.of_int 3)); + j <- (W64.of_int 0); + + while ((j \ult rate8)) { + t <- (loadW64 Glob.mem (W64.to_uint (in_0 + ((W64.of_int 8) * j)))); + l <- + (loadW64 Glob.mem (W64.to_uint (a_jagged + ((W64.of_int 8) * j)))); + s_state.[(W64.to_uint l)] <- t; + j <- (j + (W64.of_int 1)); + } + t <- s_state.[0]; + s_state.[1] <- t; + s_state.[2] <- t; + s_state.[3] <- t; + i <- 0; + while (i < 7) { + state.[i] <- + (state.[i] `^` (get256 (WArray224.init64 (fun i => s_state.[i])) i)); + i <- i + 1; + } + in_0 <- (in_0 + rate); + inlen <- (inlen - rate); + return (state, s_state, in_0, inlen); + } + + proc add_final_block (state:W256.t Array7.t, s_state:W64.t Array28.t, + a_jagged:W64.t, in_0:W64.t, inlen:W64.t, suffix:W8.t, + rate:W64.t) : W256.t Array7.t = { + var aux: int; + + var inlen8:W64.t; + var j:W64.t; + var t:W64.t; + var l:W64.t; + var c:W8.t; + var i:int; + + s_state <@ init_s_state (); + inlen8 <- inlen; + inlen8 <- (inlen8 `>>` (W8.of_int 3)); + j <- (W64.of_int 0); + + while ((j \ult inlen8)) { + t <- (loadW64 Glob.mem (W64.to_uint (in_0 + ((W64.of_int 8) * j)))); + l <- + (loadW64 Glob.mem (W64.to_uint (a_jagged + ((W64.of_int 8) * j)))); + s_state.[(W64.to_uint l)] <- t; + j <- (j + (W64.of_int 1)); + } + l <- (loadW64 Glob.mem (W64.to_uint (a_jagged + ((W64.of_int 8) * j)))); + j <- (j `<<` (W8.of_int 3)); + l <- (l `<<` (W8.of_int 3)); + + while ((j \ult inlen)) { + c <- (loadW8 Glob.mem (W64.to_uint (in_0 + j))); + s_state = + Array28.init + (WArray224.get64 (WArray224.set8 (WArray224.init64 (fun i => s_state.[i])) (W64.to_uint l) c)); + j <- (j + (W64.of_int 1)); + l <- (l + (W64.of_int 1)); + } + s_state = + Array28.init + (WArray224.get64 (WArray224.set8 (WArray224.init64 (fun i => s_state.[i])) (W64.to_uint l) suffix)); + j <- rate; + j <- (j - (W64.of_int 1)); + j <- (j `>>` (W8.of_int 3)); + l <- (loadW64 Glob.mem (W64.to_uint (a_jagged + ((W64.of_int 8) * j)))); + l <- (l `<<` (W8.of_int 3)); + j <- rate; + j <- (j - (W64.of_int 1)); + j <- (j `&` (W64.of_int 7)); + l <- (l + j); + s_state = + Array28.init + (WArray224.get64 (WArray224.set8 (WArray224.init64 (fun i => s_state.[i])) (W64.to_uint l) ( + (get8 (WArray224.init64 (fun i => s_state.[i])) (W64.to_uint l)) `^` (W8.of_int 128)))); + t <- s_state.[0]; + s_state.[1] <- t; + s_state.[2] <- t; + s_state.[3] <- t; + i <- 0; + while (i < 7) { + state.[i] <- + (state.[i] `^` (get256 (WArray224.init64 (fun i => s_state.[i])) i)); + i <- i + 1; + } + return (state); + } + + proc xtr_full_block (state:W256.t Array7.t, a_jagged:W64.t, out:W64.t, + len:W64.t) : W64.t = { + var aux: int; + + var i:int; + var s_state:W64.t Array28.t; + var len8:W64.t; + var j:W64.t; + var l:W64.t; + var t:W64.t; + s_state <- witness; + i <- 0; + while (i < 7) { + s_state = + Array28.init + (WArray224.get64 (WArray224.set256 (WArray224.init64 (fun i => s_state.[i])) i + state.[i])); + i <- i + 1; + } + len8 <- len; + len8 <- (len8 `>>` (W8.of_int 3)); + j <- (W64.of_int 0); + + while ((j \ult len8)) { + l <- + (loadW64 Glob.mem (W64.to_uint (a_jagged + ((W64.of_int 8) * j)))); + t <- s_state.[(W64.to_uint l)]; + Glob.mem <- + storeW64 Glob.mem (W64.to_uint (out + ((W64.of_int 8) * j))) t; + j <- (j + (W64.of_int 1)); + } + out <- (out + len); + return (out); + } + + proc xtr_bytes (state:W256.t Array7.t, a_jagged:W64.t, out:W64.t, len:W64.t) : + W64.t = { + var aux: int; + + var i:int; + var s_state:W64.t Array28.t; + var len8:W64.t; + var j:W64.t; + var l:W64.t; + var t:W64.t; + var c:W8.t; + s_state <- witness; + i <- 0; + while (i < 7) { + s_state = + Array28.init + (WArray224.get64 (WArray224.set256 (WArray224.init64 (fun i => s_state.[i])) i + state.[i])); + i <- i + 1; + } + len8 <- len; + len8 <- (len8 `>>` (W8.of_int 3)); + j <- (W64.of_int 0); + + while ((j \ult len8)) { + l <- + (loadW64 Glob.mem (W64.to_uint (a_jagged + ((W64.of_int 8) * j)))); + t <- s_state.[(W64.to_uint l)]; + Glob.mem <- + storeW64 Glob.mem (W64.to_uint (out + ((W64.of_int 8) * j))) t; + j <- (j + (W64.of_int 1)); + } + l <- (loadW64 Glob.mem (W64.to_uint (a_jagged + ((W64.of_int 8) * j)))); + j <- (j `<<` (W8.of_int 3)); + l <- (l `<<` (W8.of_int 3)); + + while ((j \ult len)) { + c <- (get8 (WArray224.init64 (fun i => s_state.[i])) (W64.to_uint l)); + Glob.mem <- storeW8 Glob.mem (W64.to_uint (out + j)) c; + j <- (j + (W64.of_int 1)); + l <- (l + (W64.of_int 1)); + } + out <- (out + len); + return (out); + } + + proc absorb (state:W256.t Array7.t, rhotates_left:W64.t, + rhotates_right:W64.t, iotas:W64.t, a_jagged:W64.t, in_0:W64.t, + inlen:W64.t, suffix:W8.t, rate:W64.t) : W256.t Array7.t = { + + var s_state:W64.t Array28.t; + s_state <- witness; + s_state <@ init_s_state (); + + while ((rate \ule inlen)) { + (state, s_state, in_0, inlen) <@ add_full_block (state, s_state, + a_jagged, in_0, inlen, rate); + state <@ __keccak_f1600_avx2 (state, rhotates_left, rhotates_right, + iotas); + } + state <@ add_final_block (state, s_state, a_jagged, in_0, inlen, suffix, + rate); + return (state); + } + + proc squeeze (state:W256.t Array7.t, rhotates_left:W64.t, + rhotates_right:W64.t, iotas:W64.t, a_jagged:W64.t, out:W64.t, + outlen:W64.t, rate:W64.t) : unit = { + + + + + while ((rate \ult outlen)) { + state <@ __keccak_f1600_avx2 (state, rhotates_left, rhotates_right, + iotas); + out <@ xtr_full_block (state, a_jagged, out, rate); + outlen <- (outlen - rate); + } + state <@ __keccak_f1600_avx2 (state, rhotates_left, rhotates_right, + iotas); + out <@ xtr_bytes (state, a_jagged, out, outlen); + return (); + } + + proc __keccak_1600 (out:W64.t, outlen:W64.t, rhotates_left:W64.t, + rhotates_right:W64.t, iotas:W64.t, a_jagged:W64.t, + in_0:W64.t, inlen:W64.t, suffix:W8.t, rate:W64.t) : unit = { + + var state:W256.t Array7.t; + state <- witness; + state <@ keccak_init (); + state <@ absorb (state, rhotates_left, rhotates_right, iotas, a_jagged, + in_0, inlen, suffix, rate); + squeeze (state, rhotates_left, rhotates_right, iotas, a_jagged, out, + outlen, rate); + return (); + } +}. + diff --git a/proof/impl/libc/keccak_1600_avx2_modular.ec b/proof/impl/libc/keccak_1600_avx2_modular.ec new file mode 100644 index 0000000..38c5058 --- /dev/null +++ b/proof/impl/libc/keccak_1600_avx2_modular.ec @@ -0,0 +1,428 @@ +require import List Int IntExtra IntDiv CoreMap. +from Jasmin require import JModel. + +require import Array4 Array7 Array9 Array25 Array28. +require import WArray224 WArray288. + +abbrev g_zero = W64.of_int 0. + +require import Keccak_f1600_avx2_prevec. + +require import Keccak_f1600_avx2. + +module Mmod = { + include Keccak_f1600_avx2.M + + proc keccak_init () : W256.t Array7.t = { + var aux: int; + + var state:W256.t Array7.t; + var i:int; + state <- witness; + state.[0] <- x86_VPBROADCAST_4u64 g_zero; + i <- 1; + while (i < 7) { + state.[i] <- state.[0]; + i <- i + 1; + } + return (state); + } + + proc init_s_state () : W64.t Array28.t = { + var aux: int; + + var s_state:W64.t Array28.t; + var zero:W256.t; + var i:int; + s_state <- witness; + zero <- x86_VPBROADCAST_4u64 g_zero; + i <- 0; + while (i < 7) { + s_state = + Array28.init + (WArray224.get64 (WArray224.set256 (WArray224.init64 (fun i => s_state.[i])) i zero)); + i <- i + 1; + } + return (s_state); + } + + proc add_full_block (state:W256.t Array7.t, s_state:W64.t Array28.t, + a_jagged:W64.t, in_0:W64.t, inlen:W64.t, rate:W64.t) : + W256.t Array7.t * W64.t Array28.t * W64.t * W64.t = { + var aux: int; + + var rate8:W64.t; + var j:W64.t; + var t:W64.t; + var l:W64.t; + var i:int; + + rate8 <- rate; + rate8 <- (rate8 `>>` (W8.of_int 3)); + j <- (W64.of_int 0); + + while ((j \ult rate8)) { + t <- (loadW64 Glob.mem (W64.to_uint (in_0 + ((W64.of_int 8) * j)))); + l <- + (loadW64 Glob.mem (W64.to_uint (a_jagged + ((W64.of_int 8) * j)))); + s_state.[(W64.to_uint l)] <- t; + j <- (j + (W64.of_int 1)); + } + t <- s_state.[0]; + s_state.[1] <- t; + s_state.[2] <- t; + s_state.[3] <- t; + i <- 0; + while (i < 7) { + state.[i] <- + (state.[i] `^` (get256 (WArray224.init64 (fun i => s_state.[i])) i)); + i <- i + 1; + } + in_0 <- (in_0 + rate); + inlen <- (inlen - rate); + return (state, s_state, in_0, inlen); + } + + proc add_final_block (state:W256.t Array7.t, s_state:W64.t Array28.t, + a_jagged:W64.t, in_0:W64.t, inlen:W64.t, suffix:W8.t, + rate:W64.t) : W256.t Array7.t = { + var aux: int; + + var inlen8:W64.t; + var j:W64.t; + var t:W64.t; + var l:W64.t; + var c:W8.t; + var i:int; + + s_state <@ init_s_state (); + inlen8 <- inlen; + inlen8 <- (inlen8 `>>` (W8.of_int 3)); + j <- (W64.of_int 0); + + while ((j \ult inlen8)) { + t <- (loadW64 Glob.mem (W64.to_uint (in_0 + ((W64.of_int 8) * j)))); + l <- + (loadW64 Glob.mem (W64.to_uint (a_jagged + ((W64.of_int 8) * j)))); + s_state.[(W64.to_uint l)] <- t; + j <- (j + (W64.of_int 1)); + } + l <- (loadW64 Glob.mem (W64.to_uint (a_jagged + ((W64.of_int 8) * j)))); + j <- (j `<<` (W8.of_int 3)); + l <- (l `<<` (W8.of_int 3)); + + while ((j \ult inlen)) { + c <- (loadW8 Glob.mem (W64.to_uint (in_0 + j))); + s_state = + Array28.init + (WArray224.get64 (WArray224.set8 (WArray224.init64 (fun i => s_state.[i])) (W64.to_uint l) c)); + j <- (j + (W64.of_int 1)); + l <- (l + (W64.of_int 1)); + } + s_state = + Array28.init + (WArray224.get64 (WArray224.set8 (WArray224.init64 (fun i => s_state.[i])) (W64.to_uint l) suffix)); + j <- rate; + j <- (j - (W64.of_int 1)); + j <- (j `>>` (W8.of_int 3)); + l <- (loadW64 Glob.mem (W64.to_uint (a_jagged + ((W64.of_int 8) * j)))); + l <- (l `<<` (W8.of_int 3)); + j <- rate; + j <- (j - (W64.of_int 1)); + j <- (j `&` (W64.of_int 7)); + l <- (l + j); + s_state = + Array28.init + (WArray224.get64 (WArray224.set8 (WArray224.init64 (fun i => s_state.[i])) (W64.to_uint l) ( + (get8 (WArray224.init64 (fun i => s_state.[i])) (W64.to_uint l)) `^` (W8.of_int 128)))); + t <- s_state.[0]; + s_state.[1] <- t; + s_state.[2] <- t; + s_state.[3] <- t; + i <- 0; + while (i < 7) { + state.[i] <- + (state.[i] `^` (get256 (WArray224.init64 (fun i => s_state.[i])) i)); + i <- i + 1; + } + return (state); + } + + proc xtr_full_block (state:W256.t Array7.t, a_jagged:W64.t, out:W64.t, + len:W64.t) : W64.t = { + var aux: int; + + var i:int; + var s_state:W64.t Array28.t; + var len8:W64.t; + var j:W64.t; + var l:W64.t; + var t:W64.t; + s_state <- witness; + i <- 0; + while (i < 7) { + s_state = + Array28.init + (WArray224.get64 (WArray224.set256 (WArray224.init64 (fun i => s_state.[i])) i + state.[i])); + i <- i + 1; + } + len8 <- len; + len8 <- (len8 `>>` (W8.of_int 3)); + j <- (W64.of_int 0); + + while ((j \ult len8)) { + l <- + (loadW64 Glob.mem (W64.to_uint (a_jagged + ((W64.of_int 8) * j)))); + t <- s_state.[(W64.to_uint l)]; + Glob.mem <- + storeW64 Glob.mem (W64.to_uint (out + ((W64.of_int 8) * j))) t; + j <- (j + (W64.of_int 1)); + } + out <- (out + len); + return (out); + } + + proc xtr_bytes (state:W256.t Array7.t, a_jagged:W64.t, out:W64.t, len:W64.t) : + W64.t = { + var aux: int; + + var i:int; + var s_state:W64.t Array28.t; + var len8:W64.t; + var j:W64.t; + var l:W64.t; + var t:W64.t; + var c:W8.t; + s_state <- witness; + i <- 0; + while (i < 7) { + s_state = + Array28.init + (WArray224.get64 (WArray224.set256 (WArray224.init64 (fun i => s_state.[i])) i + state.[i])); + i <- i + 1; + } + len8 <- len; + len8 <- (len8 `>>` (W8.of_int 3)); + j <- (W64.of_int 0); + + while ((j \ult len8)) { + l <- + (loadW64 Glob.mem (W64.to_uint (a_jagged + ((W64.of_int 8) * j)))); + t <- s_state.[(W64.to_uint l)]; + Glob.mem <- + storeW64 Glob.mem (W64.to_uint (out + ((W64.of_int 8) * j))) t; + j <- (j + (W64.of_int 1)); + } + l <- (loadW64 Glob.mem (W64.to_uint (a_jagged + ((W64.of_int 8) * j)))); + j <- (j `<<` (W8.of_int 3)); + l <- (l `<<` (W8.of_int 3)); + + while ((j \ult len)) { + c <- (get8 (WArray224.init64 (fun i => s_state.[i])) (W64.to_uint l)); + Glob.mem <- storeW8 Glob.mem (W64.to_uint (out + j)) c; + j <- (j + (W64.of_int 1)); + l <- (l + (W64.of_int 1)); + } + out <- (out + len); + return (out); + } + + proc absorb (state:W256.t Array7.t, rhotates_left:W64.t, + rhotates_right:W64.t, iotas:W64.t, a_jagged:W64.t, in_0:W64.t, + inlen:W64.t, suffix:W8.t, rate:W64.t) : W256.t Array7.t = { + + var s_state:W64.t Array28.t; + s_state <- witness; + s_state <@ init_s_state (); + + while ((rate \ule inlen)) { + (state, s_state, in_0, inlen) <@ add_full_block (state, s_state, + a_jagged, in_0, inlen, rate); + state <@ keccak_f1600 (state, rhotates_left, rhotates_right, + iotas); + } + state <@ add_final_block (state, s_state, a_jagged, in_0, inlen, suffix, + rate); + return (state); + } + + proc squeeze (state:W256.t Array7.t, rhotates_left:W64.t, + rhotates_right:W64.t, iotas:W64.t, a_jagged:W64.t, out:W64.t, + outlen:W64.t, rate:W64.t) : unit = { + + + + + while ((rate \ult outlen)) { + state <@ keccak_f1600 (state, rhotates_left, rhotates_right, + iotas); + out <@ xtr_full_block (state, a_jagged, out, rate); + outlen <- (outlen - rate); + } + state <@ keccak_f1600 (state, rhotates_left, rhotates_right, + iotas); + out <@ xtr_bytes (state, a_jagged, out, outlen); + return (); + } + + proc __keccak_1600 (out:W64.t, outlen:W64.t, rhotates_left:W64.t, + rhotates_right:W64.t, iotas:W64.t, a_jagged:W64.t, + in_0:W64.t, inlen:W64.t, suffix:W8.t, rate:W64.t) : unit = { + + var state:W256.t Array7.t; + state <- witness; + state <@ keccak_init (); + state <@ absorb (state, rhotates_left, rhotates_right, iotas, a_jagged, + in_0, inlen, suffix, rate); + squeeze (state, rhotates_left, rhotates_right, iotas, a_jagged, out, + outlen, rate); + return (); + } +}. + +require import Keccak_1600_avx2. + +equiv modfgood : + Mmod.keccak_f1600 ~ M.__keccak_f1600_avx2: + ={Glob.mem,arg} ==> ={Glob.mem,res}. +proc. + seq 112 112 : (#pre /\ ={zf,iotas,rhotates_left,rhotates_right,t,r}). + seq 30 30 : (#pre /\ ={d14,t,iotas,rhotates_left,rhotates_right,r}). + by wp;skip; rewrite /flat_state; auto => />. + seq 30 30 : #pre. + by wp;skip; rewrite /flat_state; auto => />. + seq 30 30 : #pre. + by wp;skip; rewrite /flat_state; auto => />. + by wp;skip; rewrite /flat_state; auto => />. + while (#pre). + seq 30 30 : (#pre /\ ={d14}). + by wp;skip; rewrite /flat_state; auto => />. + seq 30 30 : #pre. + by wp;skip; rewrite /flat_state; auto => />. + seq 30 30 : #pre. + by wp;skip; rewrite /flat_state; auto => />. + by wp;skip; rewrite /flat_state; auto => />. + by auto => />. +qed. + +equiv modgood : + Mmod.__keccak_1600 ~ M.__keccak_1600 : + ={Glob.mem,arg} ==> ={Glob.mem,res}. +proc. +call(_: ={Glob.mem}). +call(_: ={Glob.mem}); first by sim. +call(modfgood). +while(#post /\ ={rate,a_jagged,out,outlen}). +wp. +call(_: ={Glob.mem}); first by sim. +call(modfgood). +by auto => />. +by auto => />. +call(_: ={Glob.mem}). +call(_: ={Glob.mem}); first by sim. +while(#post /\ ={rate,a_jagged,in_0,inlen,rhotates_left,rhotates_right,iotas}). +call(modfgood). +call(_: ={Glob.mem}); first by sim. +by auto => />. +by inline *;auto => />; sim. +by inline *;auto => />; sim. +qed. + +require Keccak_1600_ref_modular. + +op equiv_statesp (state: W256.t Array7.t, st : W64.t Array25.t) : bool = + state.[0] \bits64 3 = st.[index 0 0] /\ state.[0] \bits64 2 = st.[index 0 0] /\ state.[0] \bits64 1 = st.[index 0 0] /\ state.[0] \bits64 0 = st.[index 0 0] /\ + state.[1] \bits64 3 = st.[index 0 4] /\ state.[1] \bits64 2 = st.[index 0 3] /\ state.[1] \bits64 1 = st.[index 0 2] /\ state.[1] \bits64 0 = st.[index 0 1] /\ + state.[2] \bits64 3 = st.[index 3 0] /\ state.[2] \bits64 2 = st.[index 1 0] /\ state.[2] \bits64 1 = st.[index 4 0] /\ state.[2] \bits64 0 = st.[index 2 0] /\ + state.[3] \bits64 3 = st.[index 2 4] /\ state.[3] \bits64 2 = st.[index 4 3] /\ state.[3] \bits64 1 = st.[index 1 2] /\ state.[3] \bits64 0 = st.[index 3 1] /\ + state.[4] \bits64 3 = st.[index 3 4] /\ state.[4] \bits64 2 = st.[index 1 3] /\ state.[4] \bits64 1 = st.[index 4 2] /\ state.[4] \bits64 0 = st.[index 2 1] /\ + state.[5] \bits64 3 = st.[index 1 4] /\ state.[5] \bits64 2 = st.[index 2 3] /\ state.[5] \bits64 1 = st.[index 3 2] /\ state.[5] \bits64 0 = st.[index 4 1] /\ + state.[6] \bits64 3 = st.[index 4 4] /\ state.[6] \bits64 2 = st.[index 3 3] /\ state.[6] \bits64 1 = st.[index 2 2] /\ state.[6] \bits64 0 = st.[index 1 1]. + +lemma set_get_eq (v : W64.t Array28.t) (w : W256.t) i j : + 0 <= i < 7 => + WArray224.get64 + (WArray224.set256 (WArray224.init64 ("_.[_]" v)) i w) i = w \bits64 (j %% 4) by admit. + +lemma set_get_diff (v : W64.t Array28.t) (w : W256.t) i j : + 0 <= i < 7 => 0 <= j < 7 => i <> j => + WArray224.get64 + (WArray224.set256 (WArray224.init64 ("_.[_]" v)) i w) j = v.[j] by admit. + +equiv modcorrect mem : + Keccak_1600_ref_modular.Mmod.__keccak_1600 ~ Mmod.__keccak_1600 : + Glob.mem{2} = mem /\ good_iotas mem (to_uint iotas{2}) /\ + in_0{1} = in_0{2} /\ inlen{1} = inlen{2} /\ out{1} = out{2} /\ outlen{1} = outlen{2} /\ r8{1} = rate{2} /\ + good_rhol mem (to_uint rhotates_left{2}) /\ good_rhor mem (to_uint rhotates_right{2}) /\ + ={Glob.mem} ==> true. +proc. +seq 2 2 : (#pre /\ equiv_statesp state{2} state{1}). +inline *. unroll for {1} 4. unroll for {2} 5. +wp;skip;auto => />. +by move => *; rewrite /x86_VPBROADCAST_4u64 bits64E => //=. +inline Mmod.absorb. +swap {2} [6..7] -5. +seq 0 3 : (#pre /\ in_00{2} = in_0{1} /\ inlen0{2} = inlen{1} /\ equiv_statesp state0{2} state{1}); first by auto => />. + +sp 1 6 . +seq 0 2 : (#pre /\ forall i, 0 <= i < 7 => s_state{2}.[i] = W64.zero). +inline *. +unroll for {2} 5. +seq 0 2 : (#pre); first by auto. +sp 0 1. +seq 0 2 : (#pre /\ s_state0{2}.[0] = W64.zero /\ i{2} = 0). +wp;skip;progress. +rewrite (set_get_eq s_state0{2} (x86_VPBROADCAST_4u64 Keccak_1600_avx2.g_zero) 0 0) => //=. +by rewrite /x86_VPBROADCAST_4u64 bits64E => //=. +seq 0 2 : (#{~i{2}}pre /\ s_state0{2}.[1] = W64.zero /\ i{2} = 1). +wp;skip;progress. +by rewrite (set_get_diff s_state0{2} (x86_VPBROADCAST_4u64 Keccak_1600_avx2.g_zero) 1 0) => //=. +rewrite (set_get_eq s_state0{2} (x86_VPBROADCAST_4u64 Keccak_1600_avx2.g_zero) 1 1) => //=. +by rewrite /x86_VPBROADCAST_4u64 bits64E => //=. +seq 0 2 : (#{~i{2}}pre /\ s_state0{2}.[2] = W64.zero /\ i{2} = 2). +wp;skip;progress. +by rewrite (set_get_diff s_state0{2} (x86_VPBROADCAST_4u64 Keccak_1600_avx2.g_zero) 2 0) => //=. +by rewrite (set_get_diff s_state0{2} (x86_VPBROADCAST_4u64 Keccak_1600_avx2.g_zero) 2 1) => //=. +rewrite (set_get_eq s_state0{2} (x86_VPBROADCAST_4u64 Keccak_1600_avx2.g_zero) 2 2) => //=. +by rewrite /x86_VPBROADCAST_4u64 bits64E => //=. +seq 0 2 : (#{~i{2}}pre /\ s_state0{2}.[3] = W64.zero /\ i{2} = 3). +wp;skip;progress. +by rewrite (set_get_diff s_state0{2} (x86_VPBROADCAST_4u64 Keccak_1600_avx2.g_zero) 3 0) => //=. +by rewrite (set_get_diff s_state0{2} (x86_VPBROADCAST_4u64 Keccak_1600_avx2.g_zero) 3 1) => //=. +by rewrite (set_get_diff s_state0{2} (x86_VPBROADCAST_4u64 Keccak_1600_avx2.g_zero) 3 2) => //=. +rewrite (set_get_eq s_state0{2} (x86_VPBROADCAST_4u64 Keccak_1600_avx2.g_zero) 3 3) => //=. +by rewrite /x86_VPBROADCAST_4u64 bits64E => //=. +seq 0 2 : (#{~i{2}}pre /\ s_state0{2}.[4] = W64.zero /\ i{2} = 4). +wp;skip;progress. +by rewrite (set_get_diff s_state0{2} (x86_VPBROADCAST_4u64 Keccak_1600_avx2.g_zero) 4 0) => //=. +by rewrite (set_get_diff s_state0{2} (x86_VPBROADCAST_4u64 Keccak_1600_avx2.g_zero) 4 1) => //=. +by rewrite (set_get_diff s_state0{2} (x86_VPBROADCAST_4u64 Keccak_1600_avx2.g_zero) 4 2) => //=. +by rewrite (set_get_diff s_state0{2} (x86_VPBROADCAST_4u64 Keccak_1600_avx2.g_zero) 4 3) => //=. +rewrite (set_get_eq s_state0{2} (x86_VPBROADCAST_4u64 Keccak_1600_avx2.g_zero) 4 4) => //=. +by rewrite /x86_VPBROADCAST_4u64 bits64E => //=. +seq 0 2 : (#{~i{2}}pre /\ s_state0{2}.[5] = W64.zero /\ i{2} = 5). +wp;skip;progress. +by rewrite (set_get_diff s_state0{2} (x86_VPBROADCAST_4u64 Keccak_1600_avx2.g_zero) 5 0) => //=. +by rewrite (set_get_diff s_state0{2} (x86_VPBROADCAST_4u64 Keccak_1600_avx2.g_zero) 5 1) => //=. +by rewrite (set_get_diff s_state0{2} (x86_VPBROADCAST_4u64 Keccak_1600_avx2.g_zero) 5 2) => //=. +by rewrite (set_get_diff s_state0{2} (x86_VPBROADCAST_4u64 Keccak_1600_avx2.g_zero) 5 3) => //=. +by rewrite (set_get_diff s_state0{2} (x86_VPBROADCAST_4u64 Keccak_1600_avx2.g_zero) 5 4) => //=. +rewrite (set_get_eq s_state0{2} (x86_VPBROADCAST_4u64 Keccak_1600_avx2.g_zero) 5 5) => //=. +by rewrite /x86_VPBROADCAST_4u64 bits64E => //=. +seq 0 2 : (#{~i{2}}pre /\ s_state0{2}.[6] = W64.zero /\ i{2} = 6). +wp;skip;progress. +by rewrite (set_get_diff s_state0{2} (x86_VPBROADCAST_4u64 Keccak_1600_avx2.g_zero) 6 0) => //=. +by rewrite (set_get_diff s_state0{2} (x86_VPBROADCAST_4u64 Keccak_1600_avx2.g_zero) 6 1) => //=. +by rewrite (set_get_diff s_state0{2} (x86_VPBROADCAST_4u64 Keccak_1600_avx2.g_zero) 6 2) => //=. +by rewrite (set_get_diff s_state0{2} (x86_VPBROADCAST_4u64 Keccak_1600_avx2.g_zero) 6 3) => //=. +by rewrite (set_get_diff s_state0{2} (x86_VPBROADCAST_4u64 Keccak_1600_avx2.g_zero) 6 4) => //=. +by rewrite (set_get_diff s_state0{2} (x86_VPBROADCAST_4u64 Keccak_1600_avx2.g_zero) 6 5) => //=. +rewrite (set_get_eq s_state0{2} (x86_VPBROADCAST_4u64 Keccak_1600_avx2.g_zero) 6 6) => //=. +by rewrite /x86_VPBROADCAST_4u64 bits64E => //=. +by auto => />; smt(). +seq 1 1 : #pre. +while #pre. +wp. +THIS IS IT!!! \ No newline at end of file diff --git a/proof/impl/libc/keccak_1600_ref.ec b/proof/impl/libc/keccak_1600_ref.ec new file mode 100644 index 0000000..c48617d --- /dev/null +++ b/proof/impl/libc/keccak_1600_ref.ec @@ -0,0 +1,419 @@ +require import List Int IntExtra IntDiv CoreMap. +from Jasmin require import JModel. + +require import Array5 Array24 Array25. +require import WArray40 WArray192 WArray200. + + + +module M = { + proc index (x:int, y:int) : int = { + + var r:int; + + r <- ((x %% 5) + (5 * (y %% 5))); + return (r); + } + + proc theta (a:W64.t Array25.t) : W64.t Array25.t = { + var aux_1: bool; + var aux_0: bool; + var aux: int; + var aux_2: W64.t; + + var x:int; + var c:W64.t Array5.t; + var y:int; + var d:W64.t Array5.t; + var _0:bool; + var _1:bool; + c <- witness; + d <- witness; + x <- 0; + while (x < 5) { + c.[x] <- (W64.of_int 0); + y <- 0; + while (y < 5) { + c.[x] <- (c.[x] `^` a.[(x + (5 * y))]); + y <- y + 1; + } + x <- x + 1; + } + x <- 0; + while (x < 5) { + d.[x] <- c.[((x + 1) %% 5)]; + (aux_1, aux_0, aux_2) <- x86_ROL_64 d.[x] (W8.of_int 1); + _0 <- aux_1; + _1 <- aux_0; + d.[x] <- aux_2; + d.[x] <- (d.[x] `^` c.[((x + 4) %% 5)]); + x <- x + 1; + } + x <- 0; + while (x < 5) { + y <- 0; + while (y < 5) { + a.[(x + (5 * y))] <- (a.[(x + (5 * y))] `^` d.[x]); + y <- y + 1; + } + x <- x + 1; + } + return (a); + } + + proc keccakRhoOffsets (i:int) : int = { + var aux: int; + + var r:int; + var x:int; + var y:int; + var t:int; + var z:int; + + r <- 0; + x <- 1; + y <- 0; + t <- 0; + while (t < 24) { + if ((i = (x + (5 * y)))) { + r <- ((((t + 1) * (t + 2)) %/ 2) %% 64); + } else { + + } + z <- (((2 * x) + (3 * y)) %% 5); + x <- y; + y <- z; + t <- t + 1; + } + return (r); + } + + proc rho (a:W64.t Array25.t) : W64.t Array25.t = { + var aux_1: bool; + var aux_0: bool; + var aux: int; + var aux_2: W64.t; + + var x:int; + var y:int; + var i:int; + var z:int; + var _0:bool; + var _1:bool; + + x <- 0; + while (x < 5) { + y <- 0; + while (y < 5) { + i <@ index (x, y); + z <@ keccakRhoOffsets (i); + (aux_1, aux_0, aux_2) <- x86_ROL_64 a.[i] (W8.of_int z); + _0 <- aux_1; + _1 <- aux_0; + a.[i] <- aux_2; + y <- y + 1; + } + x <- x + 1; + } + return (a); + } + + proc pi (a:W64.t Array25.t) : W64.t Array25.t = { + var aux: int; + + var i:int; + var t:W64.t; + var b:W64.t Array25.t; + var y:int; + var x:int; + b <- witness; + i <- 0; + while (i < 25) { + t <- a.[i]; + b.[i] <- t; + i <- i + 1; + } + x <- 0; + while (x < 5) { + y <- 0; + while (y < 5) { + t <- b.[(x + (5 * y))]; + i <@ index (y, ((2 * x) + (3 * y))); + a.[i] <- t; + y <- y + 1; + } + x <- x + 1; + } + return (a); + } + + proc chi (a:W64.t Array25.t) : W64.t Array25.t = { + var aux: int; + + var x:int; + var y:int; + var i:int; + var c:W64.t Array5.t; + c <- witness; + y <- 0; + while (y < 5) { + x <- 0; + while (x < 5) { + i <@ index ((x + 1), y); + c.[x] <- a.[i]; + c.[x] <- (invw c.[x]); + i <@ index ((x + 2), y); + c.[x] <- (c.[x] `&` a.[i]); + i <@ index (x, y); + c.[x] <- (c.[x] `^` a.[i]); + x <- x + 1; + } + x <- 0; + while (x < 5) { + a.[(x + (5 * y))] <- c.[x]; + x <- x + 1; + } + y <- y + 1; + } + return (a); + } + + proc iota_0 (a:W64.t Array25.t, c:W64.t) : W64.t Array25.t = { + + + + a.[0] <- (a.[0] `^` c); + return (a); + } + + proc keccakP1600_round (state:W64.t Array25.t, c:W64.t) : W64.t Array25.t = { + + + + state <@ theta (state); + state <@ rho (state); + state <@ pi (state); + state <@ chi (state); + state <@ iota_0 (state, c); + return (state); + } + + proc keccakRoundConstants () : W64.t Array24.t = { + + var constants:W64.t Array24.t; + var t:W64.t; + constants <- witness; + t <- (W64.of_int 1); + constants.[0] <- t; + t <- (W64.of_int 32898); + constants.[1] <- t; + t <- (W64.of_int 9223372036854808714); + constants.[2] <- t; + t <- (W64.of_int 9223372039002292224); + constants.[3] <- t; + t <- (W64.of_int 32907); + constants.[4] <- t; + t <- (W64.of_int 2147483649); + constants.[5] <- t; + t <- (W64.of_int 9223372039002292353); + constants.[6] <- t; + t <- (W64.of_int 9223372036854808585); + constants.[7] <- t; + t <- (W64.of_int 138); + constants.[8] <- t; + t <- (W64.of_int 136); + constants.[9] <- t; + t <- (W64.of_int 2147516425); + constants.[10] <- t; + t <- (W64.of_int 2147483658); + constants.[11] <- t; + t <- (W64.of_int 2147516555); + constants.[12] <- t; + t <- (W64.of_int 9223372036854775947); + constants.[13] <- t; + t <- (W64.of_int 9223372036854808713); + constants.[14] <- t; + t <- (W64.of_int 9223372036854808579); + constants.[15] <- t; + t <- (W64.of_int 9223372036854808578); + constants.[16] <- t; + t <- (W64.of_int 9223372036854775936); + constants.[17] <- t; + t <- (W64.of_int 32778); + constants.[18] <- t; + t <- (W64.of_int 9223372039002259466); + constants.[19] <- t; + t <- (W64.of_int 9223372039002292353); + constants.[20] <- t; + t <- (W64.of_int 9223372036854808704); + constants.[21] <- t; + t <- (W64.of_int 2147483649); + constants.[22] <- t; + t <- (W64.of_int 9223372039002292232); + constants.[23] <- t; + return (constants); + } + + proc __keccak_f1600_ref (state:W64.t Array25.t) : W64.t Array25.t = { + var aux: int; + + var constants:W64.t Array24.t; + var round:int; + constants <- witness; + constants <@ keccakRoundConstants (); + round <- 0; + while (round < 24) { + state <@ keccakP1600_round (state, constants.[round]); + round <- round + 1; + } + return (state); + } + + proc st0 () : W64.t Array25.t = { + var aux: int; + + var state:W64.t Array25.t; + var i:int; + state <- witness; + i <- 0; + while (i < 25) { + state.[i] <- (W64.of_int 0); + i <- i + 1; + } + return (state); + } + + proc add_full_block (state:W64.t Array25.t, in_0:W64.t, r64:W64.t) : + W64.t Array25.t = { + + var i:W64.t; + var t:W64.t; + + i <- (W64.of_int 0); + + while ((i \ult r64)) { + t <- (loadW64 Glob.mem (W64.to_uint (in_0 + ((W64.of_int 8) * i)))); + state.[(W64.to_uint i)] <- (state.[(W64.to_uint i)] `^` t); + i <- (i + (W64.of_int 1)); + } + return (state); + } + + proc add_final_block (state:W64.t Array25.t, in_0:W64.t, inlen:W64.t, + trail_byte:W8.t, r8:W64.t) : W64.t Array25.t = { + + var i:W64.t; + var t:W64.t; + var j:W64.t; + var c:W8.t; + + i <- (W64.of_int 0); + + while (((W64.of_int 8) \ule inlen)) { + t <- (loadW64 Glob.mem (W64.to_uint (in_0 + ((W64.of_int 8) * i)))); + state.[(W64.to_uint i)] <- (state.[(W64.to_uint i)] `^` t); + i <- (i + (W64.of_int 1)); + inlen <- (inlen - (W64.of_int 8)); + } + j <- ((W64.of_int 8) * i); + + while (((W64.of_int 0) \ult inlen)) { + c <- (loadW8 Glob.mem (W64.to_uint (in_0 + j))); + state = + Array25.init + (WArray200.get64 (WArray200.set8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint j) ( + (get8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint j)) `^` c))); + inlen <- (inlen - (W64.of_int 1)); + j <- (j + (W64.of_int 1)); + } + c <- trail_byte; + state = + Array25.init + (WArray200.get64 (WArray200.set8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint j) ( + (get8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint j)) `^` c))); + state = + Array25.init + (WArray200.get64 (WArray200.set8 (WArray200.init64 (fun i => state.[i])) ((W64.to_uint r8) - 1) ( + (get8 (WArray200.init64 (fun i => state.[i])) ((W64.to_uint r8) - 1)) `^` (W8.of_int 128)))); + return (state); + } + + proc xtr_full_block (state:W64.t Array25.t, out:W64.t, r64:W64.t) : unit = { + + var i:W64.t; + var t:W64.t; + + i <- (W64.of_int 0); + + while ((i \ult r64)) { + t <- state.[(W64.to_uint i)]; + Glob.mem <- + storeW64 Glob.mem (W64.to_uint (out + ((W64.of_int 8) * i))) t; + i <- (i + (W64.of_int 1)); + } + return (); + } + + proc xtr_bytes (state:W64.t Array25.t, out:W64.t, outlen:W64.t) : unit = { + + var i:W64.t; + var t:W64.t; + var j:W64.t; + var c:W8.t; + + i <- (W64.of_int 0); + + while (((W64.of_int 8) \ule outlen)) { + t <- state.[(W64.to_uint i)]; + Glob.mem <- + storeW64 Glob.mem (W64.to_uint (out + ((W64.of_int 8) * i))) t; + i <- (i + (W64.of_int 1)); + outlen <- (outlen - (W64.of_int 8)); + } + j <- ((W64.of_int 8) * i); + + while (((W64.of_int 0) \ult outlen)) { + c <- (get8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint j)); + Glob.mem <- storeW8 Glob.mem (W64.to_uint (out + j)) c; + outlen <- (outlen - (W64.of_int 1)); + j <- (j + (W64.of_int 1)); + } + return (); + } + + proc __keccak_1600 (out:W64.t, outlen:W64.t, in_0:W64.t, inlen:W64.t, + trail_byte:W64.t, r8:W64.t) : unit = { + + var state:W64.t Array25.t; + var rate:W64.t; + var trailbyte:W8.t; + state <- witness; + state <@ st0 (); + rate <- r8; + + while ((rate \ule inlen)) { + rate <- (rate `>>` (W8.of_int 3)); + state <@ add_full_block (state, in_0, rate); + state <@ __keccak_f1600_ref (state); + rate <- r8; + inlen <- (inlen - rate); + in_0 <- (in_0 + rate); + } + trailbyte <- (truncateu8 trail_byte); + state <@ add_final_block (state, in_0, inlen, trailbyte, rate); + + while ((rate \ult outlen)) { + state <@ __keccak_f1600_ref (state); + rate <- r8; + rate <- (rate `>>` (W8.of_int 3)); + xtr_full_block (state, out, rate); + rate <- (rate `<<` (W8.of_int 3)); + outlen <- (outlen - rate); + out <- (out + rate); + } + state <@ __keccak_f1600_ref (state); + xtr_bytes (state, out, outlen); + return (); + } +}. + diff --git a/proof/impl/libc/keccak_1600_ref_modular.ec b/proof/impl/libc/keccak_1600_ref_modular.ec new file mode 100644 index 0000000..e857d1d --- /dev/null +++ b/proof/impl/libc/keccak_1600_ref_modular.ec @@ -0,0 +1,205 @@ +require import List Int IntExtra IntDiv CoreMap. +from Jasmin require import JModel. + +require import Array5 Array24 Array25. +require import WArray40 WArray192 WArray200. + +require import Keccak_f1600_ref. + +module Mmod = { + include Keccak_f1600_ref.Mref + + proc st0 () : W64.t Array25.t = { + var aux: int; + + var state:W64.t Array25.t; + var i:int; + state <- witness; + i <- 0; + while (i < 25) { + state.[i] <- (W64.of_int 0); + i <- i + 1; + } + return (state); + } + + proc add_full_block (state:W64.t Array25.t, in_0:W64.t, r64:W64.t) : + W64.t Array25.t = { + + var i:W64.t; + var t:W64.t; + + i <- (W64.of_int 0); + + while ((i \ult r64)) { + t <- (loadW64 Glob.mem (W64.to_uint (in_0 + ((W64.of_int 8) * i)))); + state.[(W64.to_uint i)] <- (state.[(W64.to_uint i)] `^` t); + i <- (i + (W64.of_int 1)); + } + return (state); + } + + proc add_final_block (state:W64.t Array25.t, in_0:W64.t, inlen:W64.t, + trail_byte:W8.t, r8:W64.t) : W64.t Array25.t = { + + var i:W64.t; + var t:W64.t; + var j:W64.t; + var c:W8.t; + + i <- (W64.of_int 0); + + while (((W64.of_int 8) \ule inlen)) { + t <- (loadW64 Glob.mem (W64.to_uint (in_0 + ((W64.of_int 8) * i)))); + state.[(W64.to_uint i)] <- (state.[(W64.to_uint i)] `^` t); + i <- (i + (W64.of_int 1)); + inlen <- (inlen - (W64.of_int 8)); + } + j <- ((W64.of_int 8) * i); + + while (((W64.of_int 0) \ult inlen)) { + c <- (loadW8 Glob.mem (W64.to_uint (in_0 + j))); + state = + Array25.init + (WArray200.get64 (WArray200.set8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint j) ( + (get8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint j)) `^` c))); + inlen <- (inlen - (W64.of_int 1)); + j <- (j + (W64.of_int 1)); + } + c <- trail_byte; + state = + Array25.init + (WArray200.get64 (WArray200.set8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint j) ( + (get8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint j)) `^` c))); + state = + Array25.init + (WArray200.get64 (WArray200.set8 (WArray200.init64 (fun i => state.[i])) ((W64.to_uint r8) - 1) ( + (get8 (WArray200.init64 (fun i => state.[i])) ((W64.to_uint r8) - 1)) `^` (W8.of_int 128)))); + return (state); + } + + proc xtr_full_block (state:W64.t Array25.t, out:W64.t, r64:W64.t) : unit = { + + var i:W64.t; + var t:W64.t; + + i <- (W64.of_int 0); + + while ((i \ult r64)) { + t <- state.[(W64.to_uint i)]; + Glob.mem <- + storeW64 Glob.mem (W64.to_uint (out + ((W64.of_int 8) * i))) t; + i <- (i + (W64.of_int 1)); + } + return (); + } + + proc xtr_bytes (state:W64.t Array25.t, out:W64.t, outlen:W64.t) : unit = { + + var i:W64.t; + var t:W64.t; + var j:W64.t; + var c:W8.t; + + i <- (W64.of_int 0); + + while (((W64.of_int 8) \ule outlen)) { + t <- state.[(W64.to_uint i)]; + Glob.mem <- + storeW64 Glob.mem (W64.to_uint (out + ((W64.of_int 8) * i))) t; + i <- (i + (W64.of_int 1)); + outlen <- (outlen - (W64.of_int 8)); + } + j <- ((W64.of_int 8) * i); + + while (((W64.of_int 0) \ult outlen)) { + c <- (get8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint j)); + Glob.mem <- storeW8 Glob.mem (W64.to_uint (out + j)) c; + outlen <- (outlen - (W64.of_int 1)); + j <- (j + (W64.of_int 1)); + } + return (); + } + + proc __keccak_1600 (out:W64.t, outlen:W64.t, in_0:W64.t, inlen:W64.t, + trail_byte:W64.t, r8:W64.t) : unit = { + + var state:W64.t Array25.t; + var rate:W64.t; + var trailbyte:W8.t; + state <- witness; + state <@ st0 (); + rate <- r8; + + while ((rate \ule inlen)) { + rate <- (rate `>>` (W8.of_int 3)); + state <@ add_full_block (state, in_0, rate); + state <@ __keccak_f1600_ref (state); + rate <- r8; + inlen <- (inlen - rate); + in_0 <- (in_0 + rate); + } + trailbyte <- (truncateu8 trail_byte); + state <@ add_final_block (state, in_0, inlen, trailbyte, rate); + + while ((rate \ult outlen)) { + state <@ __keccak_f1600_ref (state); + rate <- r8; + rate <- (rate `>>` (W8.of_int 3)); + xtr_full_block (state, out, rate); + rate <- (rate `<<` (W8.of_int 3)); + outlen <- (outlen - rate); + out <- (out + rate); + } + state <@ __keccak_f1600_ref (state); + xtr_bytes (state, out, outlen); + return (); + } +}. + + +require import Keccak_1600_ref. + +equiv modfgood : + Mmod.__keccak_f1600_ref ~ M.__keccak_f1600_ref: + ={Glob.mem,arg} ==> ={Glob.mem,res}. +proc. +while (#post /\ ={constants,round}). +wp. +call(_: ={Glob.mem}). +call(_: ={Glob.mem}); first by sim. +call(_: ={Glob.mem}); first by sim. +call(_: ={Glob.mem}); first by sim. +call(_: ={Glob.mem}); first by sim. +call(_: ={Glob.mem}). +seq 4 4 : (#pre /\ ={c}); first by sim. +seq 2 2 : (#pre /\ ={d}). +unroll for {1} 2. +unroll for {2} 2. +auto => />. move => &1 &2. apply Array5.ext_eq. smt(@Array5). +by sim. +by auto => />. +by auto => />. +by inline *; auto => />. +qed. + +equiv modgood : + Mmod.__keccak_1600 ~ M.__keccak_1600 : + ={Glob.mem,arg} ==> ={Glob.mem,res}. +proc. +call(_: ={Glob.mem}); first by sim. +call(modfgood). +while(#post /\ ={rate,out,outlen,r8}). +wp. +call(_: ={Glob.mem}); first by sim. +wp;call(modfgood). +by auto => />. +call(_: ={Glob.mem}); first by sim. +wp. +while(#post /\ ={rate,in_0,inlen,outlen,out,r8}). +wp. +call(modfgood). +call(_: ={Glob.mem}); first by sim. +by wp;skip;auto => />. +by inline *; auto => />;sim. +qed. From a3802991b1e723aaa2179932a8ebb943d2b7bb62 Mon Sep 17 00:00:00 2001 From: Manuel Barbosa Date: Mon, 13 May 2019 20:48:05 +0100 Subject: [PATCH 397/525] Yet another extraction: --- proof/impl/perm/keccak_f1600_avx2.ec | 60 ++++++++++---------- proof/impl/perm/keccak_f1600_ref.ec | 78 +++++++++++++++++--------- proof/impl/perm/keccak_f1600_ref_op.ec | 4 +- 3 files changed, 85 insertions(+), 57 deletions(-) diff --git a/proof/impl/perm/keccak_f1600_avx2.ec b/proof/impl/perm/keccak_f1600_avx2.ec index 1a90b52..d872dc5 100644 --- a/proof/impl/perm/keccak_f1600_avx2.ec +++ b/proof/impl/perm/keccak_f1600_avx2.ec @@ -7,8 +7,8 @@ require import WArray224 WArray288. module M = { - proc keccak_f1600 (state:W256.t Array7.t, _rhotates_left:W64.t, - _rhotates_right:W64.t, _iotas:W64.t) : W256.t Array7.t = { + proc __keccak_f1600_avx2 (state:W256.t Array7.t, _rhotates_left:W64.t, + _rhotates_right:W64.t, _iotas:W64.t) : W256.t Array7.t = { var rhotates_left:W64.t; var rhotates_right:W64.t; @@ -72,27 +72,27 @@ module M = { 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); d14 <- (d14 `^` t.[4]); t.[3] <- x86_VPSLLV_4u64 state.[2] - (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((0 * 32) - 96))))); + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((32 * 0) - 96))))); state.[2] <- x86_VPSRLV_4u64 state.[2] - (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((0 * 32) - 96))))); + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((32 * 0) - 96))))); state.[2] <- (state.[2] `|` t.[3]); state.[3] <- (state.[3] `^` d14); t.[4] <- x86_VPSLLV_4u64 state.[3] - (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((2 * 32) - 96))))); + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((32 * 2) - 96))))); state.[3] <- x86_VPSRLV_4u64 state.[3] - (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((2 * 32) - 96))))); + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((32 * 2) - 96))))); state.[3] <- (state.[3] `|` t.[4]); state.[4] <- (state.[4] `^` d14); t.[5] <- x86_VPSLLV_4u64 state.[4] - (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((3 * 32) - 96))))); + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((32 * 3) - 96))))); state.[4] <- x86_VPSRLV_4u64 state.[4] - (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((3 * 32) - 96))))); + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((32 * 3) - 96))))); state.[4] <- (state.[4] `|` t.[5]); state.[5] <- (state.[5] `^` d14); t.[6] <- x86_VPSLLV_4u64 state.[5] - (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((4 * 32) - 96))))); + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((32 * 4) - 96))))); state.[5] <- x86_VPSRLV_4u64 state.[5] - (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((4 * 32) - 96))))); + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((32 * 4) - 96))))); state.[5] <- (state.[5] `|` t.[6]); state.[6] <- (state.[6] `^` d14); t.[3] <- x86_VPERMQ state.[2] @@ -100,9 +100,9 @@ module M = { t.[4] <- x86_VPERMQ state.[3] (W8.of_int (1 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 2)))); t.[7] <- x86_VPSLLV_4u64 state.[6] - (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((5 * 32) - 96))))); + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((32 * 5) - 96))))); t.[1] <- x86_VPSRLV_4u64 state.[6] - (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((5 * 32) - 96))))); + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((32 * 5) - 96))))); t.[1] <- (t.[1] `|` t.[7]); state.[1] <- (state.[1] `^` d14); t.[5] <- x86_VPERMQ state.[4] @@ -110,9 +110,9 @@ module M = { t.[6] <- x86_VPERMQ state.[5] (W8.of_int (2 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 1)))); t.[8] <- x86_VPSLLV_4u64 state.[1] - (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((1 * 32) - 96))))); + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((32 * 1) - 96))))); t.[2] <- x86_VPSRLV_4u64 state.[1] - (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((1 * 32) - 96))))); + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((32 * 1) - 96))))); t.[2] <- (t.[2] `|` t.[8]); t.[7] <- x86_VPSRLDQ_256 t.[1] (W8.of_int 8); t.[0] <- ((invw t.[1]) `&` t.[7]); @@ -398,7 +398,7 @@ module M = { state.[1] <- (state.[1] `^` t.[1]); state.[4] <- (state.[4] `^` t.[4]); state.[0] <- - (state.[0] `^` (loadW256 Glob.mem (W64.to_uint (iotas + (W64.of_int ((0 * 32) - 0)))))); + (state.[0] `^` (loadW256 Glob.mem (W64.to_uint (iotas + (W64.of_int ((32 * 0) - 0)))))); iotas <- (iotas + (W64.of_int 32)); ( _0, _1, _2, zf, r) <- x86_DEC_32 r; while ((! zf)) { @@ -446,27 +446,27 @@ module M = { 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); d14 <- (d14 `^` t.[4]); t.[3] <- x86_VPSLLV_4u64 state.[2] - (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((0 * 32) - 96))))); + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((32 * 0) - 96))))); state.[2] <- x86_VPSRLV_4u64 state.[2] - (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((0 * 32) - 96))))); + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((32 * 0) - 96))))); state.[2] <- (state.[2] `|` t.[3]); state.[3] <- (state.[3] `^` d14); t.[4] <- x86_VPSLLV_4u64 state.[3] - (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((2 * 32) - 96))))); + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((32 * 2) - 96))))); state.[3] <- x86_VPSRLV_4u64 state.[3] - (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((2 * 32) - 96))))); + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((32 * 2) - 96))))); state.[3] <- (state.[3] `|` t.[4]); state.[4] <- (state.[4] `^` d14); t.[5] <- x86_VPSLLV_4u64 state.[4] - (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((3 * 32) - 96))))); + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((32 * 3) - 96))))); state.[4] <- x86_VPSRLV_4u64 state.[4] - (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((3 * 32) - 96))))); + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((32 * 3) - 96))))); state.[4] <- (state.[4] `|` t.[5]); state.[5] <- (state.[5] `^` d14); t.[6] <- x86_VPSLLV_4u64 state.[5] - (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((4 * 32) - 96))))); + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((32 * 4) - 96))))); state.[5] <- x86_VPSRLV_4u64 state.[5] - (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((4 * 32) - 96))))); + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((32 * 4) - 96))))); state.[5] <- (state.[5] `|` t.[6]); state.[6] <- (state.[6] `^` d14); t.[3] <- x86_VPERMQ state.[2] @@ -474,9 +474,9 @@ module M = { t.[4] <- x86_VPERMQ state.[3] (W8.of_int (1 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 2)))); t.[7] <- x86_VPSLLV_4u64 state.[6] - (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((5 * 32) - 96))))); + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((32 * 5) - 96))))); t.[1] <- x86_VPSRLV_4u64 state.[6] - (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((5 * 32) - 96))))); + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((32 * 5) - 96))))); t.[1] <- (t.[1] `|` t.[7]); state.[1] <- (state.[1] `^` d14); t.[5] <- x86_VPERMQ state.[4] @@ -484,9 +484,9 @@ module M = { t.[6] <- x86_VPERMQ state.[5] (W8.of_int (2 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 1)))); t.[8] <- x86_VPSLLV_4u64 state.[1] - (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((1 * 32) - 96))))); + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((32 * 1) - 96))))); t.[2] <- x86_VPSRLV_4u64 state.[1] - (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((1 * 32) - 96))))); + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((32 * 1) - 96))))); t.[2] <- (t.[2] `|` t.[8]); t.[7] <- x86_VPSRLDQ_256 t.[1] (W8.of_int 8); t.[0] <- ((invw t.[1]) `&` t.[7]); @@ -772,7 +772,7 @@ module M = { state.[1] <- (state.[1] `^` t.[1]); state.[4] <- (state.[4] `^` t.[4]); state.[0] <- - (state.[0] `^` (loadW256 Glob.mem (W64.to_uint (iotas + (W64.of_int ((0 * 32) - 0)))))); + (state.[0] `^` (loadW256 Glob.mem (W64.to_uint (iotas + (W64.of_int ((32 * 0) - 0)))))); iotas <- (iotas + (W64.of_int 32)); ( _0, _1, _2, zf, r) <- x86_DEC_32 r; } @@ -780,6 +780,7 @@ module M = { } }. + require Keccak_f1600_avx2_openssl. op flat_state (st : W256.t Array7.t) @@ -793,7 +794,7 @@ op flat_state (st : W256.t Array7.t) st.[6] = axx.`7. equiv avx2_avx2_openssl : - Keccak_f1600_avx2_openssl.M.__keccak_f1600_avx2_openssl ~ M.keccak_f1600 : + Keccak_f1600_avx2_openssl.M.__keccak_f1600_avx2_openssl ~ M.__keccak_f1600_avx2 : ={Glob.mem,_rhotates_left,_rhotates_right, _iotas} /\ flat_state state{2} (arg{1}.`1,arg{1}.`2,arg{1}.`3,arg{1}.`4,arg{1}.`5,arg{1}.`6,arg{1}.`7) ==> ={Glob.mem} /\ flat_state res{2} res{1}. @@ -816,3 +817,4 @@ equiv avx2_avx2_openssl : by wp;skip; rewrite /flat_state; auto => />. by auto => />. qed. + diff --git a/proof/impl/perm/keccak_f1600_ref.ec b/proof/impl/perm/keccak_f1600_ref.ec index 7c28a26..c611460 100644 --- a/proof/impl/perm/keccak_f1600_ref.ec +++ b/proof/impl/perm/keccak_f1600_ref.ec @@ -6,7 +6,7 @@ require import WArray40 WArray192 WArray200. -module Mref = { +module M = { proc index (x:int, y:int) : int = { var r:int; @@ -41,7 +41,8 @@ module Mref = { } x <- 0; while (x < 5) { - (aux_1, aux_0, aux_2) <- x86_ROL_64 c.[((x + 1) %% 5)] (W8.of_int 1); + d.[x] <- c.[((x + 1) %% 5)]; + (aux_1, aux_0, aux_2) <- x86_ROL_64 d.[x] (W8.of_int 1); _0 <- aux_1; _1 <- aux_0; d.[x] <- aux_2; @@ -200,31 +201,56 @@ module Mref = { proc keccakRoundConstants () : W64.t Array24.t = { var constants:W64.t Array24.t; + var t:W64.t; constants <- witness; - constants.[0] <- (W64.of_int 1); - constants.[1] <- (W64.of_int 32898); - constants.[2] <- (W64.of_int 9223372036854808714); - constants.[3] <- (W64.of_int 9223372039002292224); - constants.[4] <- (W64.of_int 32907); - constants.[5] <- (W64.of_int 2147483649); - constants.[6] <- (W64.of_int 9223372039002292353); - constants.[7] <- (W64.of_int 9223372036854808585); - constants.[8] <- (W64.of_int 138); - constants.[9] <- (W64.of_int 136); - constants.[10] <- (W64.of_int 2147516425); - constants.[11] <- (W64.of_int 2147483658); - constants.[12] <- (W64.of_int 2147516555); - constants.[13] <- (W64.of_int 9223372036854775947); - constants.[14] <- (W64.of_int 9223372036854808713); - constants.[15] <- (W64.of_int 9223372036854808579); - constants.[16] <- (W64.of_int 9223372036854808578); - constants.[17] <- (W64.of_int 9223372036854775936); - constants.[18] <- (W64.of_int 32778); - constants.[19] <- (W64.of_int 9223372039002259466); - constants.[20] <- (W64.of_int 9223372039002292353); - constants.[21] <- (W64.of_int 9223372036854808704); - constants.[22] <- (W64.of_int 2147483649); - constants.[23] <- (W64.of_int 9223372039002292232); + t <- (W64.of_int 1); + constants.[0] <- t; + t <- (W64.of_int 32898); + constants.[1] <- t; + t <- (W64.of_int 9223372036854808714); + constants.[2] <- t; + t <- (W64.of_int 9223372039002292224); + constants.[3] <- t; + t <- (W64.of_int 32907); + constants.[4] <- t; + t <- (W64.of_int 2147483649); + constants.[5] <- t; + t <- (W64.of_int 9223372039002292353); + constants.[6] <- t; + t <- (W64.of_int 9223372036854808585); + constants.[7] <- t; + t <- (W64.of_int 138); + constants.[8] <- t; + t <- (W64.of_int 136); + constants.[9] <- t; + t <- (W64.of_int 2147516425); + constants.[10] <- t; + t <- (W64.of_int 2147483658); + constants.[11] <- t; + t <- (W64.of_int 2147516555); + constants.[12] <- t; + t <- (W64.of_int 9223372036854775947); + constants.[13] <- t; + t <- (W64.of_int 9223372036854808713); + constants.[14] <- t; + t <- (W64.of_int 9223372036854808579); + constants.[15] <- t; + t <- (W64.of_int 9223372036854808578); + constants.[16] <- t; + t <- (W64.of_int 9223372036854775936); + constants.[17] <- t; + t <- (W64.of_int 32778); + constants.[18] <- t; + t <- (W64.of_int 9223372039002259466); + constants.[19] <- t; + t <- (W64.of_int 9223372039002292353); + constants.[20] <- t; + t <- (W64.of_int 9223372036854808704); + constants.[21] <- t; + t <- (W64.of_int 2147483649); + constants.[22] <- t; + t <- (W64.of_int 9223372039002292232); + constants.[23] <- t; return (constants); } diff --git a/proof/impl/perm/keccak_f1600_ref_op.ec b/proof/impl/perm/keccak_f1600_ref_op.ec index bb0e5fc..99a3fe1 100644 --- a/proof/impl/perm/keccak_f1600_ref_op.ec +++ b/proof/impl/perm/keccak_f1600_ref_op.ec @@ -36,7 +36,7 @@ op iotas : W64.t Array24.t = (( require import Keccak_f1600_ref. module Mrefop = { - include Mref [-keccakRoundConstants,__keccak_f1600_ref] + include M [-keccakRoundConstants,__keccak_f1600_ref] proc keccakRoundConstants () : W64.t Array24.t = { return iotas; @@ -62,7 +62,7 @@ module Mrefop = { require import Keccak_f1600_ref. equiv ref_refop : - Mref.__keccak_f1600_ref ~ Mrefop.__keccak_f1600_ref : + M.__keccak_f1600_ref ~ Mrefop.__keccak_f1600_ref : ={Glob.mem,arg} ==> ={Glob.mem,res}. proc. seq 3 3 : (#pre /\ ={round, constants}). From 4a7ea3a1a2072521534c99bffc189b34316da445 Mon Sep 17 00:00:00 2001 From: Manuel Barbosa Date: Tue, 14 May 2019 02:26:06 +0100 Subject: [PATCH 398/525] propagating changes from fresh extraction --- proof/impl/libc/keccak_1600_avx2.ec | 18 +- proof/impl/libc/keccak_1600_avx2_modular.ec | 67 ++-- proof/impl/libc/keccak_1600_ref.ec | 122 +++++--- proof/impl/libc/keccak_1600_ref_modular.ec | 143 +++++---- proof/impl/perm/keccak_f1600_scalar.ec | 152 +++++---- proof/impl/perm/keccak_f1600_scalar_table.ec | 306 +++++++++++-------- 6 files changed, 484 insertions(+), 324 deletions(-) diff --git a/proof/impl/libc/keccak_1600_avx2.ec b/proof/impl/libc/keccak_1600_avx2.ec index ba53ceb..2ca5070 100644 --- a/proof/impl/libc/keccak_1600_avx2.ec +++ b/proof/impl/libc/keccak_1600_avx2.ec @@ -851,8 +851,8 @@ module M = { } proc add_final_block (state:W256.t Array7.t, s_state:W64.t Array28.t, - a_jagged:W64.t, in_0:W64.t, inlen:W64.t, suffix:W8.t, - rate:W64.t) : W256.t Array7.t = { + a_jagged:W64.t, in_0:W64.t, inlen:W64.t, + trail_byte:W8.t, rate:W64.t) : W256.t Array7.t = { var aux: int; var inlen8:W64.t; @@ -875,8 +875,8 @@ module M = { j <- (j + (W64.of_int 1)); } l <- (loadW64 Glob.mem (W64.to_uint (a_jagged + ((W64.of_int 8) * j)))); - j <- (j `<<` (W8.of_int 3)); l <- (l `<<` (W8.of_int 3)); + j <- (j `<<` (W8.of_int 3)); while ((j \ult inlen)) { c <- (loadW8 Glob.mem (W64.to_uint (in_0 + j))); @@ -888,7 +888,7 @@ module M = { } s_state = Array28.init - (WArray224.get64 (WArray224.set8 (WArray224.init64 (fun i => s_state.[i])) (W64.to_uint l) suffix)); + (WArray224.get64 (WArray224.set8 (WArray224.init64 (fun i => s_state.[i])) (W64.to_uint l) trail_byte)); j <- rate; j <- (j - (W64.of_int 1)); j <- (j `>>` (W8.of_int 3)); @@ -998,7 +998,7 @@ module M = { proc absorb (state:W256.t Array7.t, rhotates_left:W64.t, rhotates_right:W64.t, iotas:W64.t, a_jagged:W64.t, in_0:W64.t, - inlen:W64.t, suffix:W8.t, rate:W64.t) : W256.t Array7.t = { + inlen:W64.t, trail_byte:W8.t, rate:W64.t) : W256.t Array7.t = { var s_state:W64.t Array28.t; s_state <- witness; @@ -1010,8 +1010,8 @@ module M = { state <@ __keccak_f1600_avx2 (state, rhotates_left, rhotates_right, iotas); } - state <@ add_final_block (state, s_state, a_jagged, in_0, inlen, suffix, - rate); + state <@ add_final_block (state, s_state, a_jagged, in_0, inlen, + trail_byte, rate); return (state); } @@ -1036,13 +1036,13 @@ module M = { proc __keccak_1600 (out:W64.t, outlen:W64.t, rhotates_left:W64.t, rhotates_right:W64.t, iotas:W64.t, a_jagged:W64.t, - in_0:W64.t, inlen:W64.t, suffix:W8.t, rate:W64.t) : unit = { + in_0:W64.t, inlen:W64.t, trail_byte:W8.t, rate:W64.t) : unit = { var state:W256.t Array7.t; state <- witness; state <@ keccak_init (); state <@ absorb (state, rhotates_left, rhotates_right, iotas, a_jagged, - in_0, inlen, suffix, rate); + in_0, inlen, trail_byte, rate); squeeze (state, rhotates_left, rhotates_right, iotas, a_jagged, out, outlen, rate); return (); diff --git a/proof/impl/libc/keccak_1600_avx2_modular.ec b/proof/impl/libc/keccak_1600_avx2_modular.ec index 38c5058..1dcced7 100644 --- a/proof/impl/libc/keccak_1600_avx2_modular.ec +++ b/proof/impl/libc/keccak_1600_avx2_modular.ec @@ -84,8 +84,8 @@ module Mmod = { } proc add_final_block (state:W256.t Array7.t, s_state:W64.t Array28.t, - a_jagged:W64.t, in_0:W64.t, inlen:W64.t, suffix:W8.t, - rate:W64.t) : W256.t Array7.t = { + a_jagged:W64.t, in_0:W64.t, inlen:W64.t, + trail_byte:W8.t, rate:W64.t) : W256.t Array7.t = { var aux: int; var inlen8:W64.t; @@ -108,8 +108,8 @@ module Mmod = { j <- (j + (W64.of_int 1)); } l <- (loadW64 Glob.mem (W64.to_uint (a_jagged + ((W64.of_int 8) * j)))); - j <- (j `<<` (W8.of_int 3)); l <- (l `<<` (W8.of_int 3)); + j <- (j `<<` (W8.of_int 3)); while ((j \ult inlen)) { c <- (loadW8 Glob.mem (W64.to_uint (in_0 + j))); @@ -121,7 +121,7 @@ module Mmod = { } s_state = Array28.init - (WArray224.get64 (WArray224.set8 (WArray224.init64 (fun i => s_state.[i])) (W64.to_uint l) suffix)); + (WArray224.get64 (WArray224.set8 (WArray224.init64 (fun i => s_state.[i])) (W64.to_uint l) trail_byte)); j <- rate; j <- (j - (W64.of_int 1)); j <- (j `>>` (W8.of_int 3)); @@ -231,7 +231,7 @@ module Mmod = { proc absorb (state:W256.t Array7.t, rhotates_left:W64.t, rhotates_right:W64.t, iotas:W64.t, a_jagged:W64.t, in_0:W64.t, - inlen:W64.t, suffix:W8.t, rate:W64.t) : W256.t Array7.t = { + inlen:W64.t, trail_byte:W8.t, rate:W64.t) : W256.t Array7.t = { var s_state:W64.t Array28.t; s_state <- witness; @@ -240,11 +240,11 @@ module Mmod = { while ((rate \ule inlen)) { (state, s_state, in_0, inlen) <@ add_full_block (state, s_state, a_jagged, in_0, inlen, rate); - state <@ keccak_f1600 (state, rhotates_left, rhotates_right, + state <@ __keccak_f1600_avx2 (state, rhotates_left, rhotates_right, iotas); } - state <@ add_final_block (state, s_state, a_jagged, in_0, inlen, suffix, - rate); + state <@ add_final_block (state, s_state, a_jagged, in_0, inlen, + trail_byte, rate); return (state); } @@ -256,12 +256,12 @@ module Mmod = { while ((rate \ult outlen)) { - state <@ keccak_f1600 (state, rhotates_left, rhotates_right, + state <@ __keccak_f1600_avx2 (state, rhotates_left, rhotates_right, iotas); out <@ xtr_full_block (state, a_jagged, out, rate); outlen <- (outlen - rate); } - state <@ keccak_f1600 (state, rhotates_left, rhotates_right, + state <@ __keccak_f1600_avx2 (state, rhotates_left, rhotates_right, iotas); out <@ xtr_bytes (state, a_jagged, out, outlen); return (); @@ -269,13 +269,13 @@ module Mmod = { proc __keccak_1600 (out:W64.t, outlen:W64.t, rhotates_left:W64.t, rhotates_right:W64.t, iotas:W64.t, a_jagged:W64.t, - in_0:W64.t, inlen:W64.t, suffix:W8.t, rate:W64.t) : unit = { + in_0:W64.t, inlen:W64.t, trail_byte:W8.t, rate:W64.t) : unit = { var state:W256.t Array7.t; state <- witness; state <@ keccak_init (); state <@ absorb (state, rhotates_left, rhotates_right, iotas, a_jagged, - in_0, inlen, suffix, rate); + in_0, inlen, trail_byte, rate); squeeze (state, rhotates_left, rhotates_right, iotas, a_jagged, out, outlen, rate); return (); @@ -285,7 +285,7 @@ module Mmod = { require import Keccak_1600_avx2. equiv modfgood : - Mmod.keccak_f1600 ~ M.__keccak_f1600_avx2: + Mmod.__keccak_f1600_avx2 ~ M.__keccak_f1600_avx2: ={Glob.mem,arg} ==> ={Glob.mem,res}. proc. seq 112 112 : (#pre /\ ={zf,iotas,rhotates_left,rhotates_right,t,r}). @@ -351,10 +351,18 @@ lemma set_get_diff (v : W64.t Array28.t) (w : W256.t) i j : WArray224.get64 (WArray224.set256 (WArray224.init64 ("_.[_]" v)) i w) j = v.[j] by admit. + +equiv plugin : + Keccak_1600_ref_modular.Mmod.__keccak_f1600_ref ~ Mmod.__keccak_f1600_avx2 : + ={Glob.mem} /\ equiv_statesp arg{2}.`1 arg{1} ==> equiv_statesp res{2} res{1}. +(* there in perm *) +admit. +qed. + equiv modcorrect mem : Keccak_1600_ref_modular.Mmod.__keccak_1600 ~ Mmod.__keccak_1600 : Glob.mem{2} = mem /\ good_iotas mem (to_uint iotas{2}) /\ - in_0{1} = in_0{2} /\ inlen{1} = inlen{2} /\ out{1} = out{2} /\ outlen{1} = outlen{2} /\ r8{1} = rate{2} /\ + in_0{1} = in_0{2} /\ inlen{1} = inlen{2} /\ s_out{1} = out{2} /\ s_outlen{1} = outlen{2} /\ rate{1} = rate{2} /\ good_rhol mem (to_uint rhotates_left{2}) /\ good_rhor mem (to_uint rhotates_right{2}) /\ ={Glob.mem} ==> true. proc. @@ -362,31 +370,37 @@ seq 2 2 : (#pre /\ equiv_statesp state{2} state{1}). inline *. unroll for {1} 4. unroll for {2} 5. wp;skip;auto => />. by move => *; rewrite /x86_VPBROADCAST_4u64 bits64E => //=. + inline Mmod.absorb. swap {2} [6..7] -5. + seq 0 3 : (#pre /\ in_00{2} = in_0{1} /\ inlen0{2} = inlen{1} /\ equiv_statesp state0{2} state{1}); first by auto => />. -sp 1 6 . +sp 0 6 . seq 0 2 : (#pre /\ forall i, 0 <= i < 7 => s_state{2}.[i] = W64.zero). inline *. unroll for {2} 5. seq 0 2 : (#pre); first by auto. sp 0 1. + seq 0 2 : (#pre /\ s_state0{2}.[0] = W64.zero /\ i{2} = 0). wp;skip;progress. rewrite (set_get_eq s_state0{2} (x86_VPBROADCAST_4u64 Keccak_1600_avx2.g_zero) 0 0) => //=. by rewrite /x86_VPBROADCAST_4u64 bits64E => //=. + seq 0 2 : (#{~i{2}}pre /\ s_state0{2}.[1] = W64.zero /\ i{2} = 1). wp;skip;progress. by rewrite (set_get_diff s_state0{2} (x86_VPBROADCAST_4u64 Keccak_1600_avx2.g_zero) 1 0) => //=. rewrite (set_get_eq s_state0{2} (x86_VPBROADCAST_4u64 Keccak_1600_avx2.g_zero) 1 1) => //=. by rewrite /x86_VPBROADCAST_4u64 bits64E => //=. + seq 0 2 : (#{~i{2}}pre /\ s_state0{2}.[2] = W64.zero /\ i{2} = 2). wp;skip;progress. by rewrite (set_get_diff s_state0{2} (x86_VPBROADCAST_4u64 Keccak_1600_avx2.g_zero) 2 0) => //=. by rewrite (set_get_diff s_state0{2} (x86_VPBROADCAST_4u64 Keccak_1600_avx2.g_zero) 2 1) => //=. rewrite (set_get_eq s_state0{2} (x86_VPBROADCAST_4u64 Keccak_1600_avx2.g_zero) 2 2) => //=. by rewrite /x86_VPBROADCAST_4u64 bits64E => //=. + seq 0 2 : (#{~i{2}}pre /\ s_state0{2}.[3] = W64.zero /\ i{2} = 3). wp;skip;progress. by rewrite (set_get_diff s_state0{2} (x86_VPBROADCAST_4u64 Keccak_1600_avx2.g_zero) 3 0) => //=. @@ -394,6 +408,7 @@ by rewrite (set_get_diff s_state0{2} (x86_VPBROADCAST_4u64 Keccak_1600_avx2.g_ze by rewrite (set_get_diff s_state0{2} (x86_VPBROADCAST_4u64 Keccak_1600_avx2.g_zero) 3 2) => //=. rewrite (set_get_eq s_state0{2} (x86_VPBROADCAST_4u64 Keccak_1600_avx2.g_zero) 3 3) => //=. by rewrite /x86_VPBROADCAST_4u64 bits64E => //=. + seq 0 2 : (#{~i{2}}pre /\ s_state0{2}.[4] = W64.zero /\ i{2} = 4). wp;skip;progress. by rewrite (set_get_diff s_state0{2} (x86_VPBROADCAST_4u64 Keccak_1600_avx2.g_zero) 4 0) => //=. @@ -402,6 +417,7 @@ by rewrite (set_get_diff s_state0{2} (x86_VPBROADCAST_4u64 Keccak_1600_avx2.g_ze by rewrite (set_get_diff s_state0{2} (x86_VPBROADCAST_4u64 Keccak_1600_avx2.g_zero) 4 3) => //=. rewrite (set_get_eq s_state0{2} (x86_VPBROADCAST_4u64 Keccak_1600_avx2.g_zero) 4 4) => //=. by rewrite /x86_VPBROADCAST_4u64 bits64E => //=. + seq 0 2 : (#{~i{2}}pre /\ s_state0{2}.[5] = W64.zero /\ i{2} = 5). wp;skip;progress. by rewrite (set_get_diff s_state0{2} (x86_VPBROADCAST_4u64 Keccak_1600_avx2.g_zero) 5 0) => //=. @@ -411,6 +427,7 @@ by rewrite (set_get_diff s_state0{2} (x86_VPBROADCAST_4u64 Keccak_1600_avx2.g_ze by rewrite (set_get_diff s_state0{2} (x86_VPBROADCAST_4u64 Keccak_1600_avx2.g_zero) 5 4) => //=. rewrite (set_get_eq s_state0{2} (x86_VPBROADCAST_4u64 Keccak_1600_avx2.g_zero) 5 5) => //=. by rewrite /x86_VPBROADCAST_4u64 bits64E => //=. + seq 0 2 : (#{~i{2}}pre /\ s_state0{2}.[6] = W64.zero /\ i{2} = 6). wp;skip;progress. by rewrite (set_get_diff s_state0{2} (x86_VPBROADCAST_4u64 Keccak_1600_avx2.g_zero) 6 0) => //=. @@ -421,8 +438,22 @@ by rewrite (set_get_diff s_state0{2} (x86_VPBROADCAST_4u64 Keccak_1600_avx2.g_ze by rewrite (set_get_diff s_state0{2} (x86_VPBROADCAST_4u64 Keccak_1600_avx2.g_zero) 6 5) => //=. rewrite (set_get_eq s_state0{2} (x86_VPBROADCAST_4u64 Keccak_1600_avx2.g_zero) 6 6) => //=. by rewrite /x86_VPBROADCAST_4u64 bits64E => //=. + by auto => />; smt(). -seq 1 1 : #pre. -while #pre. + +seq 1 1 : #{/~state{2}}pre. + +while (#{/~rate0{2}}{~state{2}}pre /\ rate0{2} = rate{1}). +wp. +call (plugin). wp. -THIS IS IT!!! \ No newline at end of file +inline *. +wp. +admit. (* ouch! *) +by auto => />. +seq 3 2 : (#{/~state0{2}}pre /\ equiv_statesp state0{2} state{1}). +inline *. +admit. (* ouch! *) +inline Mmod.squeeze. +admit. +qed. diff --git a/proof/impl/libc/keccak_1600_ref.ec b/proof/impl/libc/keccak_1600_ref.ec index c48617d..969484a 100644 --- a/proof/impl/libc/keccak_1600_ref.ec +++ b/proof/impl/libc/keccak_1600_ref.ec @@ -283,135 +283,159 @@ module M = { return (state); } - proc add_full_block (state:W64.t Array25.t, in_0:W64.t, r64:W64.t) : - W64.t Array25.t = { + proc add_full_block (state:W64.t Array25.t, in_0:W64.t, inlen:W64.t, + rate:W64.t) : W64.t Array25.t * W64.t * W64.t = { + var rate64:W64.t; var i:W64.t; var t:W64.t; + rate64 <- rate; + rate64 <- (rate64 `>>` (W8.of_int 3)); i <- (W64.of_int 0); - while ((i \ult r64)) { + while ((i \ult rate64)) { t <- (loadW64 Glob.mem (W64.to_uint (in_0 + ((W64.of_int 8) * i)))); state.[(W64.to_uint i)] <- (state.[(W64.to_uint i)] `^` t); i <- (i + (W64.of_int 1)); } - return (state); + in_0 <- (in_0 + rate); + inlen <- (inlen - rate); + return (state, in_0, inlen); } proc add_final_block (state:W64.t Array25.t, in_0:W64.t, inlen:W64.t, trail_byte:W8.t, r8:W64.t) : W64.t Array25.t = { + var inlen8:W64.t; var i:W64.t; var t:W64.t; - var j:W64.t; var c:W8.t; + inlen8 <- inlen; + inlen8 <- (inlen8 `>>` (W8.of_int 3)); i <- (W64.of_int 0); - while (((W64.of_int 8) \ule inlen)) { + while ((i \ult inlen8)) { t <- (loadW64 Glob.mem (W64.to_uint (in_0 + ((W64.of_int 8) * i)))); state.[(W64.to_uint i)] <- (state.[(W64.to_uint i)] `^` t); i <- (i + (W64.of_int 1)); - inlen <- (inlen - (W64.of_int 8)); } - j <- ((W64.of_int 8) * i); + i <- (i `<<` (W8.of_int 3)); - while (((W64.of_int 0) \ult inlen)) { - c <- (loadW8 Glob.mem (W64.to_uint (in_0 + j))); + while ((i \ult inlen)) { + c <- (loadW8 Glob.mem (W64.to_uint (in_0 + i))); state = Array25.init - (WArray200.get64 (WArray200.set8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint j) ( - (get8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint j)) `^` c))); - inlen <- (inlen - (W64.of_int 1)); - j <- (j + (W64.of_int 1)); + (WArray200.get64 (WArray200.set8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i) ( + (get8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i)) `^` c))); + i <- (i + (W64.of_int 1)); } - c <- trail_byte; state = Array25.init - (WArray200.get64 (WArray200.set8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint j) ( - (get8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint j)) `^` c))); + (WArray200.get64 (WArray200.set8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i) ( + (get8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i)) `^` trail_byte))); + i <- r8; + i <- (i - (W64.of_int 1)); state = Array25.init - (WArray200.get64 (WArray200.set8 (WArray200.init64 (fun i => state.[i])) ((W64.to_uint r8) - 1) ( - (get8 (WArray200.init64 (fun i => state.[i])) ((W64.to_uint r8) - 1)) `^` (W8.of_int 128)))); + (WArray200.get64 (WArray200.set8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i) ( + (get8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i)) `^` (W8.of_int 128)))); return (state); } - proc xtr_full_block (state:W64.t Array25.t, out:W64.t, r64:W64.t) : unit = { + proc xtr_full_block (state:W64.t Array25.t, out:W64.t, outlen:W64.t, + rate:W64.t) : W64.t * W64.t = { + var rate64:W64.t; var i:W64.t; var t:W64.t; + rate64 <- rate; + rate64 <- (rate64 `>>` (W8.of_int 3)); i <- (W64.of_int 0); - while ((i \ult r64)) { + while ((i \ult rate64)) { t <- state.[(W64.to_uint i)]; Glob.mem <- storeW64 Glob.mem (W64.to_uint (out + ((W64.of_int 8) * i))) t; i <- (i + (W64.of_int 1)); } - return (); + out <- (out + rate); + outlen <- (outlen - rate); + return (out, outlen); } proc xtr_bytes (state:W64.t Array25.t, out:W64.t, outlen:W64.t) : unit = { + var outlen8:W64.t; var i:W64.t; var t:W64.t; - var j:W64.t; var c:W8.t; + outlen8 <- outlen; + outlen8 <- (outlen8 `>>` (W8.of_int 3)); i <- (W64.of_int 0); - while (((W64.of_int 8) \ule outlen)) { + while ((i \ult outlen8)) { t <- state.[(W64.to_uint i)]; Glob.mem <- storeW64 Glob.mem (W64.to_uint (out + ((W64.of_int 8) * i))) t; i <- (i + (W64.of_int 1)); - outlen <- (outlen - (W64.of_int 8)); } - j <- ((W64.of_int 8) * i); + i <- (i `<<` (W8.of_int 3)); - while (((W64.of_int 0) \ult outlen)) { - c <- (get8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint j)); - Glob.mem <- storeW8 Glob.mem (W64.to_uint (out + j)) c; - outlen <- (outlen - (W64.of_int 1)); - j <- (j + (W64.of_int 1)); + while ((i \ult outlen)) { + c <- (get8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i)); + Glob.mem <- storeW8 Glob.mem (W64.to_uint (out + i)) c; + i <- (i + (W64.of_int 1)); } return (); } - proc __keccak_1600 (out:W64.t, outlen:W64.t, in_0:W64.t, inlen:W64.t, - trail_byte:W64.t, r8:W64.t) : unit = { + proc __keccak_1600 (s_out:W64.t, s_outlen:W64.t, in_0:W64.t, inlen:W64.t, + s_trail_byte:W64.t, rate:W64.t) : unit = { var state:W64.t Array25.t; - var rate:W64.t; - var trailbyte:W8.t; + var s_in:W64.t; + var s_inlen:W64.t; + var s_rate:W64.t; + var t:W64.t; + var trail_byte:W8.t; + var outlen:W64.t; + var out:W64.t; state <- witness; state <@ st0 (); - rate <- r8; while ((rate \ule inlen)) { - rate <- (rate `>>` (W8.of_int 3)); - state <@ add_full_block (state, in_0, rate); + (state, in_0, inlen) <@ add_full_block (state, in_0, inlen, rate); + s_in <- in_0; + s_inlen <- inlen; + s_rate <- rate; state <@ __keccak_f1600_ref (state); - rate <- r8; - inlen <- (inlen - rate); - in_0 <- (in_0 + rate); + inlen <- s_inlen; + in_0 <- s_in; + rate <- s_rate; } - trailbyte <- (truncateu8 trail_byte); - state <@ add_final_block (state, in_0, inlen, trailbyte, rate); + t <- s_trail_byte; + trail_byte <- (truncateu8 t); + state <@ add_final_block (state, in_0, inlen, trail_byte, rate); + outlen <- s_outlen; while ((rate \ult outlen)) { + s_outlen <- outlen; + s_rate <- rate; state <@ __keccak_f1600_ref (state); - rate <- r8; - rate <- (rate `>>` (W8.of_int 3)); - xtr_full_block (state, out, rate); - rate <- (rate `<<` (W8.of_int 3)); - outlen <- (outlen - rate); - out <- (out + rate); + out <- s_out; + outlen <- s_outlen; + rate <- s_rate; + (out, outlen) <@ xtr_full_block (state, out, outlen, rate); + s_out <- out; } + s_outlen <- outlen; state <@ __keccak_f1600_ref (state); + out <- s_out; + outlen <- s_outlen; xtr_bytes (state, out, outlen); return (); } diff --git a/proof/impl/libc/keccak_1600_ref_modular.ec b/proof/impl/libc/keccak_1600_ref_modular.ec index e857d1d..0c7edac 100644 --- a/proof/impl/libc/keccak_1600_ref_modular.ec +++ b/proof/impl/libc/keccak_1600_ref_modular.ec @@ -6,8 +6,9 @@ require import WArray40 WArray192 WArray200. require import Keccak_f1600_ref. + module Mmod = { - include Keccak_f1600_ref.Mref + include Keccak_f1600_ref.M proc st0 () : W64.t Array25.t = { var aux: int; @@ -23,138 +24,163 @@ module Mmod = { return (state); } - proc add_full_block (state:W64.t Array25.t, in_0:W64.t, r64:W64.t) : - W64.t Array25.t = { + proc add_full_block (state:W64.t Array25.t, in_0:W64.t, inlen:W64.t, + rate:W64.t) : W64.t Array25.t * W64.t * W64.t = { + var rate64:W64.t; var i:W64.t; var t:W64.t; + rate64 <- rate; + rate64 <- (rate64 `>>` (W8.of_int 3)); i <- (W64.of_int 0); - while ((i \ult r64)) { + while ((i \ult rate64)) { t <- (loadW64 Glob.mem (W64.to_uint (in_0 + ((W64.of_int 8) * i)))); state.[(W64.to_uint i)] <- (state.[(W64.to_uint i)] `^` t); i <- (i + (W64.of_int 1)); } - return (state); + in_0 <- (in_0 + rate); + inlen <- (inlen - rate); + return (state, in_0, inlen); } proc add_final_block (state:W64.t Array25.t, in_0:W64.t, inlen:W64.t, trail_byte:W8.t, r8:W64.t) : W64.t Array25.t = { + var inlen8:W64.t; var i:W64.t; var t:W64.t; - var j:W64.t; var c:W8.t; + inlen8 <- inlen; + inlen8 <- (inlen8 `>>` (W8.of_int 3)); i <- (W64.of_int 0); - while (((W64.of_int 8) \ule inlen)) { + while ((i \ult inlen8)) { t <- (loadW64 Glob.mem (W64.to_uint (in_0 + ((W64.of_int 8) * i)))); state.[(W64.to_uint i)] <- (state.[(W64.to_uint i)] `^` t); i <- (i + (W64.of_int 1)); - inlen <- (inlen - (W64.of_int 8)); } - j <- ((W64.of_int 8) * i); + i <- (i `<<` (W8.of_int 3)); - while (((W64.of_int 0) \ult inlen)) { - c <- (loadW8 Glob.mem (W64.to_uint (in_0 + j))); + while ((i \ult inlen)) { + c <- (loadW8 Glob.mem (W64.to_uint (in_0 + i))); state = Array25.init - (WArray200.get64 (WArray200.set8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint j) ( - (get8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint j)) `^` c))); - inlen <- (inlen - (W64.of_int 1)); - j <- (j + (W64.of_int 1)); + (WArray200.get64 (WArray200.set8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i) ( + (get8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i)) `^` c))); + i <- (i + (W64.of_int 1)); } - c <- trail_byte; state = Array25.init - (WArray200.get64 (WArray200.set8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint j) ( - (get8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint j)) `^` c))); + (WArray200.get64 (WArray200.set8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i) ( + (get8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i)) `^` trail_byte))); + i <- r8; + i <- (i - (W64.of_int 1)); state = Array25.init - (WArray200.get64 (WArray200.set8 (WArray200.init64 (fun i => state.[i])) ((W64.to_uint r8) - 1) ( - (get8 (WArray200.init64 (fun i => state.[i])) ((W64.to_uint r8) - 1)) `^` (W8.of_int 128)))); + (WArray200.get64 (WArray200.set8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i) ( + (get8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i)) `^` (W8.of_int 128)))); return (state); } - proc xtr_full_block (state:W64.t Array25.t, out:W64.t, r64:W64.t) : unit = { + proc xtr_full_block (state:W64.t Array25.t, out:W64.t, outlen:W64.t, + rate:W64.t) : W64.t * W64.t = { + var rate64:W64.t; var i:W64.t; var t:W64.t; + rate64 <- rate; + rate64 <- (rate64 `>>` (W8.of_int 3)); i <- (W64.of_int 0); - while ((i \ult r64)) { + while ((i \ult rate64)) { t <- state.[(W64.to_uint i)]; Glob.mem <- storeW64 Glob.mem (W64.to_uint (out + ((W64.of_int 8) * i))) t; i <- (i + (W64.of_int 1)); } - return (); + out <- (out + rate); + outlen <- (outlen - rate); + return (out, outlen); } proc xtr_bytes (state:W64.t Array25.t, out:W64.t, outlen:W64.t) : unit = { + var outlen8:W64.t; var i:W64.t; var t:W64.t; - var j:W64.t; var c:W8.t; + outlen8 <- outlen; + outlen8 <- (outlen8 `>>` (W8.of_int 3)); i <- (W64.of_int 0); - while (((W64.of_int 8) \ule outlen)) { + while ((i \ult outlen8)) { t <- state.[(W64.to_uint i)]; Glob.mem <- storeW64 Glob.mem (W64.to_uint (out + ((W64.of_int 8) * i))) t; i <- (i + (W64.of_int 1)); - outlen <- (outlen - (W64.of_int 8)); } - j <- ((W64.of_int 8) * i); + i <- (i `<<` (W8.of_int 3)); - while (((W64.of_int 0) \ult outlen)) { - c <- (get8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint j)); - Glob.mem <- storeW8 Glob.mem (W64.to_uint (out + j)) c; - outlen <- (outlen - (W64.of_int 1)); - j <- (j + (W64.of_int 1)); + while ((i \ult outlen)) { + c <- (get8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i)); + Glob.mem <- storeW8 Glob.mem (W64.to_uint (out + i)) c; + i <- (i + (W64.of_int 1)); } return (); } - proc __keccak_1600 (out:W64.t, outlen:W64.t, in_0:W64.t, inlen:W64.t, - trail_byte:W64.t, r8:W64.t) : unit = { + proc __keccak_1600 (s_out:W64.t, s_outlen:W64.t, in_0:W64.t, inlen:W64.t, + s_trail_byte:W64.t, rate:W64.t) : unit = { var state:W64.t Array25.t; - var rate:W64.t; - var trailbyte:W8.t; + var s_in:W64.t; + var s_inlen:W64.t; + var s_rate:W64.t; + var t:W64.t; + var trail_byte:W8.t; + var outlen:W64.t; + var out:W64.t; state <- witness; state <@ st0 (); - rate <- r8; while ((rate \ule inlen)) { - rate <- (rate `>>` (W8.of_int 3)); - state <@ add_full_block (state, in_0, rate); + (state, in_0, inlen) <@ add_full_block (state, in_0, inlen, rate); + s_in <- in_0; + s_inlen <- inlen; + s_rate <- rate; state <@ __keccak_f1600_ref (state); - rate <- r8; - inlen <- (inlen - rate); - in_0 <- (in_0 + rate); + inlen <- s_inlen; + in_0 <- s_in; + rate <- s_rate; } - trailbyte <- (truncateu8 trail_byte); - state <@ add_final_block (state, in_0, inlen, trailbyte, rate); + t <- s_trail_byte; + trail_byte <- (truncateu8 t); + state <@ add_final_block (state, in_0, inlen, trail_byte, rate); + outlen <- s_outlen; while ((rate \ult outlen)) { + s_outlen <- outlen; + s_rate <- rate; state <@ __keccak_f1600_ref (state); - rate <- r8; - rate <- (rate `>>` (W8.of_int 3)); - xtr_full_block (state, out, rate); - rate <- (rate `<<` (W8.of_int 3)); - outlen <- (outlen - rate); - out <- (out + rate); + out <- s_out; + outlen <- s_outlen; + rate <- s_rate; + (out, outlen) <@ xtr_full_block (state, out, outlen, rate); + s_out <- out; } + s_outlen <- outlen; state <@ __keccak_f1600_ref (state); + out <- s_out; + outlen <- s_outlen; xtr_bytes (state, out, outlen); return (); } + }. @@ -188,18 +214,19 @@ equiv modgood : ={Glob.mem,arg} ==> ={Glob.mem,res}. proc. call(_: ={Glob.mem}); first by sim. -call(modfgood). -while(#post /\ ={rate,out,outlen,r8}). +wp;call(modfgood). wp. -call(_: ={Glob.mem}); first by sim. +while(#post /\ ={rate,s_out,outlen,rate}). +wp;call(_: ={Glob.mem}); first by sim. wp;call(modfgood). -by auto => />. -call(_: ={Glob.mem}); first by sim. +by wp;skip;auto => />. +wp;call(_: ={Glob.mem}); first by sim. wp. -while(#post /\ ={rate,in_0,inlen,outlen,out,r8}). +while(#post /\ ={rate,in_0,inlen,s_outlen,s_out,rate}). wp. call(modfgood). -call(_: ={Glob.mem}); first by sim. +wp;call(_: ={Glob.mem}); first by sim. by wp;skip;auto => />. -by inline *; auto => />;sim. +by inline *;auto => />;sim. qed. + diff --git a/proof/impl/perm/keccak_f1600_scalar.ec b/proof/impl/perm/keccak_f1600_scalar.ec index 590bb2c..c0f0580 100644 --- a/proof/impl/perm/keccak_f1600_scalar.ec +++ b/proof/impl/perm/keccak_f1600_scalar.ec @@ -5,17 +5,8 @@ require import Array5 Array25. require import WArray40 WArray200. -module Mscalar = { - proc rOL64 (x:W64.t, c:int) : W64.t = { - - var y:W64.t; - var _0:bool; - var _1:bool; - - ( _0, _1, y) <- x86_ROL_64 x (W8.of_int c); - return (y); - } - + +module M = { proc index (x:int, y:int) : int = { var r:int; @@ -61,66 +52,91 @@ module Mscalar = { return (r); } - proc theta_sum (_A:W64.t Array25.t) : W64.t Array5.t = { + proc rOL64 (x:W64.t, c:int) : W64.t = { + + var y:W64.t; + var _0:bool; + var _1:bool; + + if ((c = 0)) { + y <- x; + } else { + ( _0, _1, y) <- x86_ROL_64 x (W8.of_int c); + } + return (y); + } + + proc theta_sum (a:W64.t Array25.t) : W64.t Array5.t = { var aux: int; - var _C:W64.t Array5.t; + var c:W64.t Array5.t; var i:int; var j:int; - _C <- witness; + c <- witness; i <- 0; while (i < 5) { - _C.[i] <- _A.[((5 * (0 %% 5)) + (i %% 5))]; - j <- 1; - while (j < 5) { - _C.[i] <- (_C.[i] `^` _A.[((5 * (j %% 5)) + (i %% 5))]); - j <- j + 1; - } + c.[i] <- a.[((5 * (0 %% 5)) + (i %% 5))]; i <- i + 1; } - return (_C); + j <- 1; + while (j < 5) { + i <- 0; + while (i < 5) { + c.[i] <- (c.[i] `^` a.[((5 * (j %% 5)) + (i %% 5))]); + i <- i + 1; + } + j <- j + 1; + } + return (c); } - proc theta_rol (_C:W64.t Array5.t) : W64.t Array5.t = { + proc theta_rol (c:W64.t Array5.t) : W64.t Array5.t = { + var aux_1: bool; + var aux_0: bool; var aux: int; + var aux_2: W64.t; - var _D:W64.t Array5.t; + var d:W64.t Array5.t; var i:int; - var r:W64.t; - _D <- witness; + var _0:bool; + var _1:bool; + d <- witness; i <- 0; while (i < 5) { - r <@ rOL64 (_C.[((i + 1) %% 5)], 1); - _D.[i] <- r; - _D.[i] <- (_D.[i] `^` _C.[((i + 4) %% 5)]); + d.[i] <- c.[((i + 1) %% 5)]; + (aux_1, aux_0, aux_2) <- x86_ROL_64 d.[i] (W8.of_int 1); + _0 <- aux_1; + _1 <- aux_0; + d.[i] <- aux_2; + d.[i] <- (d.[i] `^` c.[((i + 4) %% 5)]); i <- i + 1; } - return (_D); + return (d); } - proc rol_sum (_D:W64.t Array5.t, _A:W64.t Array25.t, offset:int) : W64.t Array5.t = { + proc rol_sum (d:W64.t Array5.t, a:W64.t Array25.t, offset:int) : W64.t Array5.t = { var aux: int; - var _C:W64.t Array5.t; + var c:W64.t Array5.t; var j:int; var j1:int; var k:int; var t:W64.t; - _C <- witness; + c <- witness; j <- 0; while (j < 5) { j1 <- ((j + offset) %% 5); k <@ rhotates (j, j1); - t <- _A.[((5 * (j %% 5)) + (j1 %% 5))]; - t <- (t `^` _D.[j1]); + t <- a.[((5 * (j %% 5)) + (j1 %% 5))]; + t <- (t `^` d.[j1]); t <@ rOL64 (t, k); - _C.[j] <- t; + c.[j] <- t; j <- j + 1; } - return (_C); + return (c); } - proc set_row (_R:W64.t Array25.t, row:int, _C:W64.t Array5.t, iota_0:W64.t) : + proc set_row (r:W64.t Array25.t, row:int, c:W64.t Array5.t, iota_0:W64.t) : W64.t Array25.t = { var aux: int; @@ -133,65 +149,67 @@ module Mscalar = { while (j < 5) { j1 <- ((j + 1) %% 5); j2 <- ((j + 2) %% 5); - t <- ((invw _C.[j1]) `&` _C.[j2]); + t <- ((invw c.[j1]) `&` c.[j2]); if (((row = 0) /\ (j = 0))) { t <- (t `^` iota_0); } else { } - t <- (t `^` _C.[j]); - _R.[((5 * (row %% 5)) + (j %% 5))] <- t; + t <- (t `^` c.[j]); + r.[((5 * (row %% 5)) + (j %% 5))] <- t; j <- j + 1; } - return (_R); + return (r); } - proc round2x (_A:W64.t Array25.t, _R:W64.t Array25.t, iotas:W64.t, o:int) : + proc round2x (a:W64.t Array25.t, r:W64.t Array25.t, iotas:W64.t, o:int) : W64.t Array25.t * W64.t Array25.t = { var iota_0:W64.t; - var _C:W64.t Array5.t; - var _D:W64.t Array5.t; - _C <- witness; - _D <- witness; + var c:W64.t Array5.t; + var d:W64.t Array5.t; + c <- witness; + d <- witness; iota_0 <- (loadW64 Glob.mem (W64.to_uint (iotas + (W64.of_int o)))); - _C <@ theta_sum (_A); - _D <@ theta_rol (_C); - _C <@ rol_sum (_D, _A, 0); - _R <@ set_row (_R, 0, _C, iota_0); - _C <@ rol_sum (_D, _A, 3); - _R <@ set_row (_R, 1, _C, iota_0); - _C <@ rol_sum (_D, _A, 1); - _R <@ set_row (_R, 2, _C, iota_0); - _C <@ rol_sum (_D, _A, 4); - _R <@ set_row (_R, 3, _C, iota_0); - _C <@ rol_sum (_D, _A, 2); - _R <@ set_row (_R, 4, _C, iota_0); - return (_A, _R); + c <@ theta_sum (a); + d <@ theta_rol (c); + c <@ rol_sum (d, a, 0); + r <@ set_row (r, 0, c, iota_0); + c <@ rol_sum (d, a, 3); + r <@ set_row (r, 1, c, iota_0); + c <@ rol_sum (d, a, 1); + r <@ set_row (r, 2, c, iota_0); + c <@ rol_sum (d, a, 4); + r <@ set_row (r, 3, c, iota_0); + c <@ rol_sum (d, a, 2); + r <@ set_row (r, 4, c, iota_0); + return (a, r); } - proc keccak_f (_A:W64.t Array25.t, iotas:W64.t) : W64.t Array25.t * W64.t = { + proc __keccak_f1600_scalar (a:W64.t Array25.t, iotas:W64.t) : W64.t Array25.t * + W64.t = { var zf:bool; - var _R:W64.t Array25.t; + var r:W64.t Array25.t; var _0:bool; var _1:bool; var _2:bool; var _3:bool; - _R <- witness; - (_A, _R) <@ round2x (_A, _R, iotas, 0); - (_R, _A) <@ round2x (_R, _A, iotas, 8); + r <- witness; + (a, r) <@ round2x (a, r, iotas, 0); + (r, a) <@ round2x (r, a, iotas, 8); iotas <- (iotas + (W64.of_int 16)); ( _0, _1, _2, _3, zf) <- x86_TEST_8 (truncateu8 iotas) (W8.of_int 255); while ((! zf)) { - (_A, _R) <@ round2x (_A, _R, iotas, 0); - (_R, _A) <@ round2x (_R, _A, iotas, 8); + (a, r) <@ round2x (a, r, iotas, 0); + (r, a) <@ round2x (r, a, iotas, 8); iotas <- (iotas + (W64.of_int 16)); ( _0, _1, _2, _3, zf) <- x86_TEST_8 (truncateu8 iotas) (W8.of_int 255); } iotas <- (iotas - (W64.of_int 192)); - return (_A, iotas); + return (a, iotas); } }. + diff --git a/proof/impl/perm/keccak_f1600_scalar_table.ec b/proof/impl/perm/keccak_f1600_scalar_table.ec index 0b843bc..4a13911 100644 --- a/proof/impl/perm/keccak_f1600_scalar_table.ec +++ b/proof/impl/perm/keccak_f1600_scalar_table.ec @@ -11,7 +11,7 @@ require import Keccak_f1600_ref_op. module Mscalarrho = { - include Mscalar [-keccak_rho_offsets,rhotates,rol_sum,round2x,keccak_f] + include M [-keccak_rho_offsets,rhotates,rol_sum,round2x,__keccak_f1600_scalar] include RhotatesAlgo proc rhotates (x:int, y:int) : int = { @@ -98,11 +98,11 @@ module Mscalarrho = { }. equiv scalarrhom : - Mscalar.keccak_f ~ Mscalarrho.keccak_f : + M.__keccak_f1600_scalar ~ Mscalarrho.keccak_f : ={Glob.mem,arg} ==> ={res} by sim. module Mscalartable = { - include Mscalar [-keccak_rho_offsets,rhotates,rol_sum,round2x,keccak_f] + include M [-keccak_rho_offsets,rhotates,rol_sum,round2x,__keccak_f1600_scalar] include RhotatesTable proc rhotates (x:int, y:int) : int = { @@ -244,8 +244,16 @@ op good_iotas (mem : global_mem_t, _iotas : int) = forall off, 0 <= off < 24 => loadW64 mem (_iotas + (off * 8)) = iotas.[off]. -lemma testsem : (forall (x : W64.t), (x86_TEST_8 (truncateu8 x) (W8.of_int 255)).`5 <=> (W64.to_uint x %% 256 = 0)) by admit. +lemma testsem : (forall (x : W64.t), (x86_TEST_8 (truncateu8 x) (W8.of_int 255)).`5 <=> (W64.to_uint x %% 256 = 0)). +move => *. +rewrite /x86_TEST_8. +rewrite /rflags_of_bwop8. +rewrite /truncateu8 => //=. +rewrite /ZF_of_w8. +admit. +qed. +lemma rol0 : (forall x , (x86_ROL_64 x (W8.of_int (rhotates 0))).`3 = x) by admit. lemma scalarcorr _iotas mem : equiv [ Mrefloop2.__keccak_f1600_ref ~ Mscalartable.keccak_f : @@ -280,14 +288,23 @@ by move : (Tass 0) => //=. sp. inline Mreftable.theta. seq 7 2 : (#pre /\ a{1}=state0{1} /\ d{1} = _D{2}). -inline *;sp 3 2. -seq 2 2 : (#{/~c1{1}}{~_C1{2}}pre /\ c1{1} = _C1{2}). +inline *. +sp 3 2. +seq 2 6 : (#{/~c1{1}}{~c{2}}pre /\ c1{1} = c0{2}). do 6!(unroll for {1} ^while). do 6!(unroll for {2} ^while). -by auto => />. +auto => />. +progress. +apply (Array5.ext_eq). +move => *. +case (x = 0); first by auto => />;smt( @W64). +case (x = 1); first by auto => />;smt( @W64). +case (x = 2); first by auto => />;smt( @W64). +case (x = 3); first by auto => />;smt( @W64). +case (x = 4); first by auto => />;smt( @W64). +smt(). -seq 0 0 : #{/~_C{2}}pre; first by auto => />. -sp 0 3;wp. +sp 0 1;wp. unroll for {1} 2. unroll for {2} 2. @@ -308,31 +325,32 @@ simplify. split; last first. apply Array25.ext_eq. move => x Hx. -case (x = 0); first by auto => />;smt( @W64). -case (x = 1); first by auto => />;smt( @W64). -case (x = 2); first by auto => />;smt( @W64). -case (x = 3); first by auto => />;smt( @W64). -case (x = 4); first by auto => />;smt( @W64). -case (x = 5); first by auto => />;smt( @W64). -case (x = 6); first by auto => />;smt( @W64). -case (x = 7); first by auto => />;smt( @W64). -case (x = 8); first by auto => />;smt( @W64). -case (x = 9); first by auto => />;smt( @W64). -case (x = 10); first by auto => />;smt( @W64). -case (x = 11); first by auto => />;smt( @W64). -case (x = 12); first by auto => />;smt( @W64). -case (x = 13); first by auto => />;smt( @W64). -case (x = 14); first by auto => />;smt( @W64). -case (x = 15); first by auto => />;smt( @W64). -case (x = 16); first by auto => />;smt( @W64). -case (x = 17); first by auto => />;smt( @W64). -case (x = 18); first by auto => />;smt( @W64). -case (x = 19); first by auto => />;smt( @W64). -case (x = 20); first by auto => />;smt( @W64). -case (x = 21); first by auto => />;smt( @W64). -case (x = 22); first by auto => />;smt( @W64). -case (x = 23); first by auto => />;smt( @W64). -case (x = 24); first by auto => />;smt( @W64). + +case (x = 0); first by auto => />;smt(rol0 @W64). +case (x = 1); first by auto => />;smt(rol0 @W64). +case (x = 2); first by auto => />;smt(rol0 @W64). +case (x = 3); first by auto => />;smt(rol0 @W64). +case (x = 4); first by auto => />;smt(rol0 @W64). +case (x = 5); first by auto => />;smt(rol0 @W64). +case (x = 6); first by auto => />;smt(rol0 @W64). +case (x = 7); first by auto => />;smt(rol0 @W64). +case (x = 8); first by auto => />;smt(rol0 @W64). +case (x = 9); first by auto => />;smt(rol0 @W64). +case (x = 10); first by auto => />;smt(rol0 @W64). +case (x = 11); first by auto => />;smt(rol0 @W64). +case (x = 12); first by auto => />;smt(rol0 @W64). +case (x = 13); first by auto => />;smt(rol0 @W64). +case (x = 14); first by auto => />;smt(rol0 @W64). +case (x = 15); first by auto => />;smt(rol0 @W64). +case (x = 16); first by auto => />;smt(rol0 @W64). +case (x = 17); first by auto => />;smt(rol0 @W64). +case (x = 18); first by auto => />;smt(rol0 @W64). +case (x = 19); first by auto => />;smt(rol0 @W64). +case (x = 20); first by auto => />;smt(rol0 @W64). +case (x = 21); first by auto => />;smt(rol0 @W64). +case (x = 22); first by auto => />;smt(rol0 @W64). +case (x = 23); first by auto => />;smt(rol0 @W64). +case (x = 24); first by auto => />;smt(rol0 @W64). by smt(). progress; [ 1 : by smt() | 2: by move : H => [/ #] | 3..: by smt() ]. @@ -356,12 +374,22 @@ rewrite (_ : to_uint (iotas{2} + (of_int 8)%W64) = to_uint iotas{2} + 8). rewrit seq 8 4 : (#pre /\ a0{1}=state{1} /\ d0{1} = _D0{2} /\ _A1{2} = a0{1}). inline *; sp 4 4. -seq 2 2 : (#{/~c2{1}}{~_C1{2}}pre /\ c2{1} = _C1{2}). +seq 2 6 : (#{/~c2{1}}{~c{2}}pre /\ c2{1} = c0{2}). do 6!(unroll for {1} ^while). do 6!(unroll for {2} ^while). -by auto => />. +auto => />. +progress. +apply (Array5.ext_eq). +move => *. +case (x = 0); first by auto => />;smt( @W64). +case (x = 1); first by auto => />;smt( @W64). +case (x = 2); first by auto => />;smt( @W64). +case (x = 3); first by auto => />;smt( @W64). +case (x = 4); first by auto => />;smt( @W64). +smt(). + +sp 0 1;wp. -sp 0 3;wp. unroll for {1} 2. unroll for {2} 2. by auto => />. @@ -381,31 +409,31 @@ simplify. split; last first. apply Array25.ext_eq. move => x Hx. -case (x = 0); first by auto => />;smt( @W64). -case (x = 1); first by auto => />;smt( @W64). -case (x = 2); first by auto => />;smt( @W64). -case (x = 3); first by auto => />;smt( @W64). -case (x = 4); first by auto => />;smt( @W64). -case (x = 5); first by auto => />;smt( @W64). -case (x = 6); first by auto => />;smt( @W64). -case (x = 7); first by auto => />;smt( @W64). -case (x = 8); first by auto => />;smt( @W64). -case (x = 9); first by auto => />;smt( @W64). -case (x = 10); first by auto => />;smt( @W64). -case (x = 11); first by auto => />;smt( @W64). -case (x = 12); first by auto => />;smt( @W64). -case (x = 13); first by auto => />;smt( @W64). -case (x = 14); first by auto => />;smt( @W64). -case (x = 15); first by auto => />;smt( @W64). -case (x = 16); first by auto => />;smt( @W64). -case (x = 17); first by auto => />;smt( @W64). -case (x = 18); first by auto => />;smt( @W64). -case (x = 19); first by auto => />;smt( @W64). -case (x = 20); first by auto => />;smt( @W64). -case (x = 21); first by auto => />;smt( @W64). -case (x = 22); first by auto => />;smt( @W64). -case (x = 23); first by auto => />;smt( @W64). -case (x = 24); first by auto => />;smt( @W64). +case (x = 0); first by auto => />;smt(rol0 @W64). +case (x = 1); first by auto => />;smt(rol0 @W64). +case (x = 2); first by auto => />;smt(rol0 @W64). +case (x = 3); first by auto => />;smt(rol0 @W64). +case (x = 4); first by auto => />;smt(rol0 @W64). +case (x = 5); first by auto => />;smt(rol0 @W64). +case (x = 6); first by auto => />;smt(rol0 @W64). +case (x = 7); first by auto => />;smt(rol0 @W64). +case (x = 8); first by auto => />;smt(rol0 @W64). +case (x = 9); first by auto => />;smt(rol0 @W64). +case (x = 10); first by auto => />;smt(rol0 @W64). +case (x = 11); first by auto => />;smt(rol0 @W64). +case (x = 12); first by auto => />;smt(rol0 @W64). +case (x = 13); first by auto => />;smt(rol0 @W64). +case (x = 14); first by auto => />;smt(rol0 @W64). +case (x = 15); first by auto => />;smt(rol0 @W64). +case (x = 16); first by auto => />;smt(rol0 @W64). +case (x = 17); first by auto => />;smt(rol0 @W64). +case (x = 18); first by auto => />;smt(rol0 @W64). +case (x = 19); first by auto => />;smt(rol0 @W64). +case (x = 20); first by auto => />;smt(rol0 @W64). +case (x = 21); first by auto => />;smt(rol0 @W64). +case (x = 22); first by auto => />;smt(rol0 @W64). +case (x = 23); first by auto => />;smt(rol0 @W64). +case (x = 24); first by auto => />;smt(rol0 @W64). by smt(). progress; [ 1 : by smt() | 2: by move : H => [/ #] | 3..: by smt() ]. @@ -439,18 +467,38 @@ rewrite (_: to_uint iotas{2} - round{1} * 8 + round{1} * 8 = to_uint iotas{2}); smt(). inline Mreftable.theta. -seq 8 4 : (#pre /\ a{1}=state{1} /\ d{1} = _D{2} /\ _A0{2} = _A{2}). -inline *; sp 4 4. -seq 2 2 : (#{/~c1{1}}{~_C1{2}}pre /\ c1{1} = _C1{2}). +seq 8 4 : (#pre /\ a{1}=state0{1} /\ state0{1} = state{1} /\ d{1} = _D{2} /\ _A0{2} = _A{2}). +inline *. +sp 3 2. +seq 3 8 : (#{/~c1{1}}{~c{2}}pre /\ c1{1} = c0{2}). do 6!(unroll for {1} ^while). do 6!(unroll for {2} ^while). -by auto => />. +auto => />. +progress. +apply (Array5.ext_eq). +move => *. +case (x1 = 0); first by auto => />;smt( @W64). +case (x1 = 1); first by auto => />;smt( @W64). +case (x1 = 2); first by auto => />;smt( @W64). +case (x1 = 3); first by auto => />;smt( @W64). +case (x1 = 4); first by auto => />;smt( @W64). +smt(). + +sp 0 1;wp. -seq 0 0 : #{/~_C{2}}pre; first by auto => />. -sp 0 3;wp. unroll for {1} 2. unroll for {2} 2. -by auto => />. +auto => />. +move => *. +apply Array5.ext_eq. +move => *. +case (x1 = 0); first by auto => />;smt( @W64). +case (x1 = 1); first by auto => />;smt( @W64). +case (x1 = 2); first by auto => />;smt( @W64). +case (x1 = 3); first by auto => />;smt( @W64). +case (x1 = 4); first by auto => />;smt( @W64). +smt(). + seq 8 11 : (#{/~state{1}}{~state0{1}}{~_A0{2}}{~_R0{2}}pre /\ state{1} = _R{2}). inline *. do 30!(unroll for {1} ^while). @@ -465,31 +513,31 @@ simplify. split; last first. apply Array25.ext_eq. move => x Hx. -case (x = 0); first by auto => />;smt( @W64). -case (x = 1); first by auto => />;smt( @W64). -case (x = 2); first by auto => />;smt( @W64). -case (x = 3); first by auto => />;smt( @W64). -case (x = 4); first by auto => />;smt( @W64). -case (x = 5); first by auto => />;smt( @W64). -case (x = 6); first by auto => />;smt( @W64). -case (x = 7); first by auto => />;smt( @W64). -case (x = 8); first by auto => />;smt( @W64). -case (x = 9); first by auto => />;smt( @W64). -case (x = 10); first by auto => />;smt( @W64). -case (x = 11); first by auto => />;smt( @W64). -case (x = 12); first by auto => />;smt( @W64). -case (x = 13); first by auto => />;smt( @W64). -case (x = 14); first by auto => />;smt( @W64). -case (x = 15); first by auto => />;smt( @W64). -case (x = 16); first by auto => />;smt( @W64). -case (x = 17); first by auto => />;smt( @W64). -case (x = 18); first by auto => />;smt( @W64). -case (x = 19); first by auto => />;smt( @W64). -case (x = 20); first by auto => />;smt( @W64). -case (x = 21); first by auto => />;smt( @W64). -case (x = 22); first by auto => />;smt( @W64). -case (x = 23); first by auto => />;smt( @W64). -case (x = 24); first by auto => />;smt( @W64). +case (x = 0); first by auto => />;smt(rol0 @W64). +case (x = 1); first by auto => />;smt(rol0 @W64). +case (x = 2); first by auto => />;smt(rol0 @W64). +case (x = 3); first by auto => />;smt(rol0 @W64). +case (x = 4); first by auto => />;smt(rol0 @W64). +case (x = 5); first by auto => />;smt(rol0 @W64). +case (x = 6); first by auto => />;smt(rol0 @W64). +case (x = 7); first by auto => />;smt(rol0 @W64). +case (x = 8); first by auto => />;smt(rol0 @W64). +case (x = 9); first by auto => />;smt(rol0 @W64). +case (x = 10); first by auto => />;smt(rol0 @W64). +case (x = 11); first by auto => />;smt(rol0 @W64). +case (x = 12); first by auto => />;smt(rol0 @W64). +case (x = 13); first by auto => />;smt(rol0 @W64). +case (x = 14); first by auto => />;smt(rol0 @W64). +case (x = 15); first by auto => />;smt(rol0 @W64). +case (x = 16); first by auto => />;smt(rol0 @W64). +case (x = 17); first by auto => />;smt(rol0 @W64). +case (x = 18); first by auto => />;smt(rol0 @W64). +case (x = 19); first by auto => />;smt(rol0 @W64). +case (x = 20); first by auto => />;smt(rol0 @W64). +case (x = 21); first by auto => />;smt(rol0 @W64). +case (x = 22); first by auto => />;smt(rol0 @W64). +case (x = 23); first by auto => />;smt(rol0 @W64). +case (x = 24); first by auto => />;smt(rol0 @W64). by smt(). progress; [ 1 : by smt() | 2: by move : H => [/ #] | 3..: by smt() ]. @@ -513,13 +561,23 @@ smt(@W64). smt(). seq 8 4 : (#pre /\ a0{1}=state{1} /\ d0{1} = _D0{2} /\ _A1{2} = a0{1}). -inline *;sp 4 4. -seq 2 2 : (#{/~c2{1}}{~_C1{2}}pre /\ c2{1} = _C1{2}). +inline *; sp 4 4. +seq 2 6 : (#{/~c2{1}}{~c{2}}pre /\ c2{1} = c0{2}). do 6!(unroll for {1} ^while). do 6!(unroll for {2} ^while). -by auto => />. +auto => />. +progress. +apply (Array5.ext_eq). +move => *. +case (x1 = 0); first by auto => />;smt( @W64). +case (x1 = 1); first by auto => />;smt( @W64). +case (x1 = 2); first by auto => />;smt( @W64). +case (x1 = 3); first by auto => />;smt( @W64). +case (x1 = 4); first by auto => />;smt( @W64). +smt(). + +sp 0 1;wp. -sp 0 3;wp. unroll for {1} 2. unroll for {2} 2. by auto => />. @@ -531,6 +589,7 @@ do 10!(unroll for {2} ^while). do !((rcondt {2} ^if; first by move => *; wp;skip;auto => />) || (rcondf {2} ^if; first by move => *; wp;skip;auto => />)). + wp;skip. move => &1 &2. move => H. @@ -538,33 +597,34 @@ simplify. split; last first. apply Array25.ext_eq. move => x Hx. -case (x = 0); first by auto => />;smt( @W64). -case (x = 1); first by auto => />;smt( @W64). -case (x = 2); first by auto => />;smt( @W64). -case (x = 3); first by auto => />;smt( @W64). -case (x = 4); first by auto => />;smt( @W64). -case (x = 5); first by auto => />;smt( @W64). -case (x = 6); first by auto => />;smt( @W64). -case (x = 7); first by auto => />;smt( @W64). -case (x = 8); first by auto => />;smt( @W64). -case (x = 9); first by auto => />;smt( @W64). -case (x = 10); first by auto => />;smt( @W64). -case (x = 11); first by auto => />;smt( @W64). -case (x = 12); first by auto => />;smt( @W64). -case (x = 13); first by auto => />;smt( @W64). -case (x = 14); first by auto => />;smt( @W64). -case (x = 15); first by auto => />;smt( @W64). -case (x = 16); first by auto => />;smt( @W64). -case (x = 17); first by auto => />;smt( @W64). -case (x = 18); first by auto => />;smt( @W64). -case (x = 19); first by auto => />;smt( @W64). -case (x = 20); first by auto => />;smt( @W64). -case (x = 21); first by auto => />;smt( @W64). -case (x = 22); first by auto => />;smt( @W64). -case (x = 23); first by auto => />;smt( @W64). -case (x = 24); first by auto => />;smt( @W64). +case (x = 0); first by auto => />;smt(rol0 @W64). +case (x = 1); first by auto => />;smt(rol0 @W64). +case (x = 2); first by auto => />;smt(rol0 @W64). +case (x = 3); first by auto => />;smt(rol0 @W64). +case (x = 4); first by auto => />;smt(rol0 @W64). +case (x = 5); first by auto => />;smt(rol0 @W64). +case (x = 6); first by auto => />;smt(rol0 @W64). +case (x = 7); first by auto => />;smt(rol0 @W64). +case (x = 8); first by auto => />;smt(rol0 @W64). +case (x = 9); first by auto => />;smt(rol0 @W64). +case (x = 10); first by auto => />;smt(rol0 @W64). +case (x = 11); first by auto => />;smt(rol0 @W64). +case (x = 12); first by auto => />;smt(rol0 @W64). +case (x = 13); first by auto => />;smt(rol0 @W64). +case (x = 14); first by auto => />;smt(rol0 @W64). +case (x = 15); first by auto => />;smt(rol0 @W64). +case (x = 16); first by auto => />;smt(rol0 @W64). +case (x = 17); first by auto => />;smt(rol0 @W64). +case (x = 18); first by auto => />;smt(rol0 @W64). +case (x = 19); first by auto => />;smt(rol0 @W64). +case (x = 20); first by auto => />;smt(rol0 @W64). +case (x = 21); first by auto => />;smt(rol0 @W64). +case (x = 22); first by auto => />;smt(rol0 @W64). +case (x = 23); first by auto => />;smt(rol0 @W64). +case (x = 24); first by auto => />;smt(rol0 @W64). by smt(). + progress; [ 1 : by smt() | 2: by move : H => [/ #] | 3..: by smt() ]. auto => />. From 87e6d6e209b3470f92215cd51e84ef0a41d866ce Mon Sep 17 00:00:00 2001 From: Manuel Barbosa Date: Tue, 14 May 2019 12:27:05 +0100 Subject: [PATCH 399/525] Scalar full equivalence --- proof/impl/libc/keccak_1600_scalar.ec | 454 ++++++++++++++++++ proof/impl/libc/keccak_1600_scalar_modular.ec | 324 +++++++++++++ 2 files changed, 778 insertions(+) create mode 100644 proof/impl/libc/keccak_1600_scalar.ec create mode 100644 proof/impl/libc/keccak_1600_scalar_modular.ec diff --git a/proof/impl/libc/keccak_1600_scalar.ec b/proof/impl/libc/keccak_1600_scalar.ec new file mode 100644 index 0000000..998c26a --- /dev/null +++ b/proof/impl/libc/keccak_1600_scalar.ec @@ -0,0 +1,454 @@ +require import List Int IntExtra IntDiv CoreMap. +from Jasmin require import JModel. + +require import Array5 Array25. +require import WArray40 WArray200. + +(* NEEDS ADDING *) +op set0_64 : bool * bool * bool * bool * bool * W64.t. + +axiom set0_64E : set0_64.`6 = W64.zero. + + +module M = { + proc index (x:int, y:int) : int = { + + var r:int; + + r <- ((5 * (x %% 5)) + (y %% 5)); + return (r); + } + + proc keccak_rho_offsets (i:int) : int = { + var aux: int; + + var r:int; + var x:int; + var y:int; + var t:int; + var z:int; + + r <- 0; + x <- 1; + y <- 0; + t <- 0; + while (t < 24) { + if ((i = (x + (5 * y)))) { + r <- ((((t + 1) * (t + 2)) %/ 2) %% 64); + } else { + + } + z <- (((2 * x) + (3 * y)) %% 5); + x <- y; + y <- z; + t <- t + 1; + } + return (r); + } + + proc rhotates (x:int, y:int) : int = { + + var r:int; + var i:int; + + i <@ index (x, y); + r <@ keccak_rho_offsets (i); + return (r); + } + + proc rOL64 (x:W64.t, c:int) : W64.t = { + + var y:W64.t; + var _0:bool; + var _1:bool; + + if ((c = 0)) { + y <- x; + } else { + ( _0, _1, y) <- x86_ROL_64 x (W8.of_int c); + } + return (y); + } + + proc theta_sum (a:W64.t Array25.t) : W64.t Array5.t = { + var aux: int; + + var c:W64.t Array5.t; + var i:int; + var j:int; + c <- witness; + i <- 0; + while (i < 5) { + c.[i] <- a.[((5 * (0 %% 5)) + (i %% 5))]; + i <- i + 1; + } + j <- 1; + while (j < 5) { + i <- 0; + while (i < 5) { + c.[i] <- (c.[i] `^` a.[((5 * (j %% 5)) + (i %% 5))]); + i <- i + 1; + } + j <- j + 1; + } + return (c); + } + + proc theta_rol (c:W64.t Array5.t) : W64.t Array5.t = { + var aux_1: bool; + var aux_0: bool; + var aux: int; + var aux_2: W64.t; + + var d:W64.t Array5.t; + var i:int; + var _0:bool; + var _1:bool; + d <- witness; + i <- 0; + while (i < 5) { + d.[i] <- c.[((i + 1) %% 5)]; + (aux_1, aux_0, aux_2) <- x86_ROL_64 d.[i] (W8.of_int 1); + _0 <- aux_1; + _1 <- aux_0; + d.[i] <- aux_2; + d.[i] <- (d.[i] `^` c.[((i + 4) %% 5)]); + i <- i + 1; + } + return (d); + } + + proc rol_sum (d:W64.t Array5.t, a:W64.t Array25.t, offset:int) : W64.t Array5.t = { + var aux: int; + + var c:W64.t Array5.t; + var j:int; + var j1:int; + var k:int; + var t:W64.t; + c <- witness; + j <- 0; + while (j < 5) { + j1 <- ((j + offset) %% 5); + k <@ rhotates (j, j1); + t <- a.[((5 * (j %% 5)) + (j1 %% 5))]; + t <- (t `^` d.[j1]); + t <@ rOL64 (t, k); + c.[j] <- t; + j <- j + 1; + } + return (c); + } + + proc set_row (r:W64.t Array25.t, row:int, c:W64.t Array5.t, iota_0:W64.t) : + W64.t Array25.t = { + var aux: int; + + var j:int; + var j1:int; + var j2:int; + var t:W64.t; + + j <- 0; + while (j < 5) { + j1 <- ((j + 1) %% 5); + j2 <- ((j + 2) %% 5); + t <- ((invw c.[j1]) `&` c.[j2]); + if (((row = 0) /\ (j = 0))) { + t <- (t `^` iota_0); + } else { + + } + t <- (t `^` c.[j]); + r.[((5 * (row %% 5)) + (j %% 5))] <- t; + j <- j + 1; + } + return (r); + } + + proc round2x (a:W64.t Array25.t, r:W64.t Array25.t, iotas:W64.t, o:int) : + W64.t Array25.t * W64.t Array25.t = { + + var iota_0:W64.t; + var c:W64.t Array5.t; + var d:W64.t Array5.t; + c <- witness; + d <- witness; + iota_0 <- (loadW64 Glob.mem (W64.to_uint (iotas + (W64.of_int o)))); + c <@ theta_sum (a); + d <@ theta_rol (c); + c <@ rol_sum (d, a, 0); + r <@ set_row (r, 0, c, iota_0); + c <@ rol_sum (d, a, 3); + r <@ set_row (r, 1, c, iota_0); + c <@ rol_sum (d, a, 1); + r <@ set_row (r, 2, c, iota_0); + c <@ rol_sum (d, a, 4); + r <@ set_row (r, 3, c, iota_0); + c <@ rol_sum (d, a, 2); + r <@ set_row (r, 4, c, iota_0); + return (a, r); + } + + proc __keccak_f1600_scalar (a:W64.t Array25.t, iotas:W64.t) : W64.t Array25.t * + W64.t = { + + var zf:bool; + var r:W64.t Array25.t; + var _0:bool; + var _1:bool; + var _2:bool; + var _3:bool; + r <- witness; + (a, r) <@ round2x (a, r, iotas, 0); + (r, a) <@ round2x (r, a, iotas, 8); + iotas <- (iotas + (W64.of_int 16)); + ( _0, _1, _2, _3, zf) <- x86_TEST_8 (truncateu8 iotas) + (W8.of_int 255); + while ((! zf)) { + (a, r) <@ round2x (a, r, iotas, 0); + (r, a) <@ round2x (r, a, iotas, 8); + iotas <- (iotas + (W64.of_int 16)); + ( _0, _1, _2, _3, zf) <- x86_TEST_8 (truncateu8 iotas) + (W8.of_int 255); + } + iotas <- (iotas - (W64.of_int 192)); + return (a, iotas); + } + + proc spill_2 (a:W64.t, b:W64.t) : W64.t * W64.t = { + + var sa:W64.t; + var sb:W64.t; + + sa <- a; + sb <- b; + return (sa, sb); + } + + proc spill_3 (a:W64.t, b:W64.t, c:W64.t) : W64.t * W64.t * W64.t = { + + var sa:W64.t; + var sb:W64.t; + var sc:W64.t; + + sa <- a; + sb <- b; + sc <- c; + return (sa, sb, sc); + } + + proc load_2 (sa:W64.t, sb:W64.t) : W64.t * W64.t = { + + var a:W64.t; + var b:W64.t; + + a <- sa; + b <- sb; + return (a, b); + } + + proc load_3 (sa:W64.t, sb:W64.t, sc:W64.t) : W64.t * W64.t * W64.t = { + + var a:W64.t; + var b:W64.t; + var c:W64.t; + + a <- sa; + b <- sb; + c <- sc; + return (a, b, c); + } + + proc keccak_init () : W64.t Array25.t = { + + var state:W64.t Array25.t; + var t:W64.t; + var i:W64.t; + var _0:bool; + var _1:bool; + var _2:bool; + var _3:bool; + var _4:bool; + state <- witness; + ( _0, _1, _2, _3, _4, t) <- set0_64 ; + i <- (W64.of_int 0); + + while ((i \ult (W64.of_int 25))) { + state.[(W64.to_uint i)] <- t; + i <- (i + (W64.of_int 1)); + } + return (state); + } + + proc add_full_block (state:W64.t Array25.t, in_0:W64.t, inlen:W64.t, + rate:W64.t) : W64.t Array25.t * W64.t * W64.t = { + + var rate64:W64.t; + var i:W64.t; + var t:W64.t; + + rate64 <- rate; + rate64 <- (rate64 `>>` (W8.of_int 3)); + i <- (W64.of_int 0); + + while ((i \ult rate64)) { + t <- (loadW64 Glob.mem (W64.to_uint (in_0 + ((W64.of_int 8) * i)))); + state.[(W64.to_uint i)] <- (state.[(W64.to_uint i)] `^` t); + i <- (i + (W64.of_int 1)); + } + in_0 <- (in_0 + rate); + inlen <- (inlen - rate); + return (state, in_0, inlen); + } + + proc add_final_block (state:W64.t Array25.t, in_0:W64.t, inlen:W64.t, + trail_byte:W8.t, rate:W64.t) : W64.t Array25.t = { + + var inlen8:W64.t; + var i:W64.t; + var t:W64.t; + var c:W8.t; + + inlen8 <- inlen; + inlen8 <- (inlen8 `>>` (W8.of_int 3)); + i <- (W64.of_int 0); + + while ((i \ult inlen8)) { + t <- (loadW64 Glob.mem (W64.to_uint (in_0 + ((W64.of_int 8) * i)))); + state.[(W64.to_uint i)] <- (state.[(W64.to_uint i)] `^` t); + i <- (i + (W64.of_int 1)); + } + i <- (i `<<` (W8.of_int 3)); + + while ((i \ult inlen)) { + c <- (loadW8 Glob.mem (W64.to_uint (in_0 + i))); + state = + Array25.init + (WArray200.get64 (WArray200.set8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i) ( + (get8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i)) `^` c))); + i <- (i + (W64.of_int 1)); + } + state = + Array25.init + (WArray200.get64 (WArray200.set8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i) ( + (get8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i)) `^` trail_byte))); + i <- rate; + i <- (i - (W64.of_int 1)); + state = + Array25.init + (WArray200.get64 (WArray200.set8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i) ( + (get8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i)) `^` (W8.of_int 128)))); + return (state); + } + + proc absorb (state:W64.t Array25.t, iotas:W64.t, in_0:W64.t, inlen:W64.t, + s_trail_byte:W64.t, rate:W64.t) : W64.t Array25.t * W64.t * + W64.t = { + + var s_in:W64.t; + var s_inlen:W64.t; + var s_rate:W64.t; + var t:W64.t; + var trail_byte:W8.t; + + + while ((rate \ule inlen)) { + (state, in_0, inlen) <@ add_full_block (state, in_0, inlen, rate); + (s_in, s_inlen, s_rate) <@ spill_3 (in_0, inlen, rate); + (state, iotas) <@ __keccak_f1600_scalar (state, iotas); + (in_0, inlen, rate) <@ load_3 (s_in, s_inlen, s_rate); + } + t <- s_trail_byte; + trail_byte <- (truncateu8 t); + state <@ add_final_block (state, in_0, inlen, trail_byte, rate); + return (state, iotas, rate); + } + + proc xtr_full_block (state:W64.t Array25.t, out:W64.t, outlen:W64.t, + rate:W64.t) : W64.t * W64.t = { + + var rate64:W64.t; + var i:W64.t; + var t:W64.t; + + rate64 <- rate; + rate64 <- (rate64 `>>` (W8.of_int 3)); + i <- (W64.of_int 0); + + while ((i \ult rate64)) { + t <- state.[(W64.to_uint i)]; + Glob.mem <- + storeW64 Glob.mem (W64.to_uint (out + ((W64.of_int 8) * i))) t; + i <- (i + (W64.of_int 1)); + } + out <- (out + rate); + outlen <- (outlen - rate); + return (out, outlen); + } + + proc xtr_bytes (state:W64.t Array25.t, out:W64.t, outlen:W64.t) : W64.t = { + + var outlen8:W64.t; + var i:W64.t; + var t:W64.t; + var c:W8.t; + + outlen8 <- outlen; + outlen8 <- (outlen8 `>>` (W8.of_int 3)); + i <- (W64.of_int 0); + + while ((i \ult outlen8)) { + t <- state.[(W64.to_uint i)]; + Glob.mem <- + storeW64 Glob.mem (W64.to_uint (out + ((W64.of_int 8) * i))) t; + i <- (i + (W64.of_int 1)); + } + i <- (i `<<` (W8.of_int 3)); + + while ((i \ult outlen)) { + c <- (get8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i)); + Glob.mem <- storeW8 Glob.mem (W64.to_uint (out + i)) c; + i <- (i + (W64.of_int 1)); + } + out <- (out + outlen); + return (out); + } + + proc squeeze (state:W64.t Array25.t, iotas:W64.t, s_out:W64.t, + outlen:W64.t, rate:W64.t) : unit = { + + var s_outlen:W64.t; + var s_rate:W64.t; + var out:W64.t; + + + while ((rate \ult outlen)) { + (s_outlen, s_rate) <@ spill_2 (outlen, rate); + (state, iotas) <@ __keccak_f1600_scalar (state, iotas); + (out, outlen, rate) <@ load_3 (s_out, s_outlen, s_rate); + (out, outlen) <@ xtr_full_block (state, out, outlen, rate); + s_out <- out; + } + s_outlen <- outlen; + (state, iotas) <@ __keccak_f1600_scalar (state, iotas); + (out, outlen) <@ load_2 (s_out, s_outlen); + out <@ xtr_bytes (state, out, outlen); + return (); + } + + proc __keccak_1600 (s_out:W64.t, s_outlen:W64.t, iotas:W64.t, in_0:W64.t, + inlen:W64.t, s_trail_byte:W64.t, rate:W64.t) : unit = { + + var state:W64.t Array25.t; + var outlen:W64.t; + state <- witness; + state <@ keccak_init (); + (state, iotas, rate) <@ absorb (state, iotas, in_0, inlen, s_trail_byte, + rate); + outlen <- s_outlen; + squeeze (state, iotas, s_out, outlen, rate); + return (); + } +}. + diff --git a/proof/impl/libc/keccak_1600_scalar_modular.ec b/proof/impl/libc/keccak_1600_scalar_modular.ec new file mode 100644 index 0000000..33d2562 --- /dev/null +++ b/proof/impl/libc/keccak_1600_scalar_modular.ec @@ -0,0 +1,324 @@ +require import List Int IntExtra IntDiv CoreMap. +from Jasmin require import JModel. + +require import Array5 Array24 Array25. +require import WArray40 WArray200. + +require import Keccak_1600_scalar. +require Keccak_f1600_scalar. +require Keccak_1600_ref_modular. +require Keccak_f1600_ref_op. + +module Mmod = { + include Keccak_f1600_scalar.M + + proc spill_2 (a:W64.t, b:W64.t) : W64.t * W64.t = { + + var sa:W64.t; + var sb:W64.t; + + sa <- a; + sb <- b; + return (sa, sb); + } + + proc spill_3 (a:W64.t, b:W64.t, c:W64.t) : W64.t * W64.t * W64.t = { + + var sa:W64.t; + var sb:W64.t; + var sc:W64.t; + + sa <- a; + sb <- b; + sc <- c; + return (sa, sb, sc); + } + + proc load_2 (sa:W64.t, sb:W64.t) : W64.t * W64.t = { + + var a:W64.t; + var b:W64.t; + + a <- sa; + b <- sb; + return (a, b); + } + + proc load_3 (sa:W64.t, sb:W64.t, sc:W64.t) : W64.t * W64.t * W64.t = { + + var a:W64.t; + var b:W64.t; + var c:W64.t; + + a <- sa; + b <- sb; + c <- sc; + return (a, b, c); + } + + proc keccak_init () : W64.t Array25.t = { + + var state:W64.t Array25.t; + var t:W64.t; + var i:W64.t; + var _0:bool; + var _1:bool; + var _2:bool; + var _3:bool; + var _4:bool; + state <- witness; + ( _0, _1, _2, _3, _4, t) <- set0_64 ; + i <- (W64.of_int 0); + + while ((i \ult (W64.of_int 25))) { + state.[(W64.to_uint i)] <- t; + i <- (i + (W64.of_int 1)); + } + return (state); + } + + proc add_full_block (state:W64.t Array25.t, in_0:W64.t, inlen:W64.t, + rate:W64.t) : W64.t Array25.t * W64.t * W64.t = { + + var rate64:W64.t; + var i:W64.t; + var t:W64.t; + + rate64 <- rate; + rate64 <- (rate64 `>>` (W8.of_int 3)); + i <- (W64.of_int 0); + + while ((i \ult rate64)) { + t <- (loadW64 Glob.mem (W64.to_uint (in_0 + ((W64.of_int 8) * i)))); + state.[(W64.to_uint i)] <- (state.[(W64.to_uint i)] `^` t); + i <- (i + (W64.of_int 1)); + } + in_0 <- (in_0 + rate); + inlen <- (inlen - rate); + return (state, in_0, inlen); + } + + proc add_final_block (state:W64.t Array25.t, in_0:W64.t, inlen:W64.t, + trail_byte:W8.t, rate:W64.t) : W64.t Array25.t = { + + var inlen8:W64.t; + var i:W64.t; + var t:W64.t; + var c:W8.t; + + inlen8 <- inlen; + inlen8 <- (inlen8 `>>` (W8.of_int 3)); + i <- (W64.of_int 0); + + while ((i \ult inlen8)) { + t <- (loadW64 Glob.mem (W64.to_uint (in_0 + ((W64.of_int 8) * i)))); + state.[(W64.to_uint i)] <- (state.[(W64.to_uint i)] `^` t); + i <- (i + (W64.of_int 1)); + } + i <- (i `<<` (W8.of_int 3)); + + while ((i \ult inlen)) { + c <- (loadW8 Glob.mem (W64.to_uint (in_0 + i))); + state = + Array25.init + (WArray200.get64 (WArray200.set8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i) ( + (get8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i)) `^` c))); + i <- (i + (W64.of_int 1)); + } + state = + Array25.init + (WArray200.get64 (WArray200.set8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i) ( + (get8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i)) `^` trail_byte))); + i <- rate; + i <- (i - (W64.of_int 1)); + state = + Array25.init + (WArray200.get64 (WArray200.set8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i) ( + (get8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i)) `^` (W8.of_int 128)))); + return (state); + } + + proc absorb (state:W64.t Array25.t, iotas:W64.t, in_0:W64.t, inlen:W64.t, + s_trail_byte:W64.t, rate:W64.t) : W64.t Array25.t * W64.t * + W64.t = { + + var s_in:W64.t; + var s_inlen:W64.t; + var s_rate:W64.t; + var t:W64.t; + var trail_byte:W8.t; + + + while ((rate \ule inlen)) { + (state, in_0, inlen) <@ add_full_block (state, in_0, inlen, rate); + (s_in, s_inlen, s_rate) <@ spill_3 (in_0, inlen, rate); + (state, iotas) <@ __keccak_f1600_scalar (state, iotas); + (in_0, inlen, rate) <@ load_3 (s_in, s_inlen, s_rate); + } + t <- s_trail_byte; + trail_byte <- (truncateu8 t); + state <@ add_final_block (state, in_0, inlen, trail_byte, rate); + return (state, iotas, rate); + } + + proc xtr_full_block (state:W64.t Array25.t, out:W64.t, outlen:W64.t, + rate:W64.t) : W64.t * W64.t = { + + var rate64:W64.t; + var i:W64.t; + var t:W64.t; + + rate64 <- rate; + rate64 <- (rate64 `>>` (W8.of_int 3)); + i <- (W64.of_int 0); + + while ((i \ult rate64)) { + t <- state.[(W64.to_uint i)]; + Glob.mem <- + storeW64 Glob.mem (W64.to_uint (out + ((W64.of_int 8) * i))) t; + i <- (i + (W64.of_int 1)); + } + out <- (out + rate); + outlen <- (outlen - rate); + return (out, outlen); + } + + proc xtr_bytes (state:W64.t Array25.t, out:W64.t, outlen:W64.t) : W64.t = { + + var outlen8:W64.t; + var i:W64.t; + var t:W64.t; + var c:W8.t; + + outlen8 <- outlen; + outlen8 <- (outlen8 `>>` (W8.of_int 3)); + i <- (W64.of_int 0); + + while ((i \ult outlen8)) { + t <- state.[(W64.to_uint i)]; + Glob.mem <- + storeW64 Glob.mem (W64.to_uint (out + ((W64.of_int 8) * i))) t; + i <- (i + (W64.of_int 1)); + } + i <- (i `<<` (W8.of_int 3)); + + while ((i \ult outlen)) { + c <- (get8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i)); + Glob.mem <- storeW8 Glob.mem (W64.to_uint (out + i)) c; + i <- (i + (W64.of_int 1)); + } + out <- (out + outlen); + return (out); + } + + proc squeeze (state:W64.t Array25.t, iotas:W64.t, s_out:W64.t, + outlen:W64.t, rate:W64.t) : unit = { + + var s_outlen:W64.t; + var s_rate:W64.t; + var out:W64.t; + + + while ((rate \ult outlen)) { + (s_outlen, s_rate) <@ spill_2 (outlen, rate); + (state, iotas) <@ __keccak_f1600_scalar (state, iotas); + (out, outlen, rate) <@ load_3 (s_out, s_outlen, s_rate); + (out, outlen) <@ xtr_full_block (state, out, outlen, rate); + s_out <- out; + } + s_outlen <- outlen; + (state, iotas) <@ __keccak_f1600_scalar (state, iotas); + (out, outlen) <@ load_2 (s_out, s_outlen); + out <@ xtr_bytes (state, out, outlen); + return (); + } + + proc __keccak_1600 (s_out:W64.t, s_outlen:W64.t, iotas:W64.t, in_0:W64.t, + inlen:W64.t, s_trail_byte:W64.t, rate:W64.t) : unit = { + + var state:W64.t Array25.t; + var outlen:W64.t; + state <- witness; + state <@ keccak_init (); + (state, iotas, rate) <@ absorb (state, iotas, in_0, inlen, s_trail_byte, + rate); + outlen <- s_outlen; + squeeze (state, iotas, s_out, outlen, rate); + return (); + } + +}. + +equiv modgood : + Mmod.__keccak_1600 ~ M.__keccak_1600 : + ={Glob.mem,arg} ==> ={Glob.mem,res}. +proc. +by sim. +qed. + +op good_iotas (mem : global_mem_t, _iotas : int) = + forall off, 0 <= off < 24 => + loadW64 mem (_iotas + (off * 8)) = Keccak_f1600_ref_op.iotas.[off]. + + +equiv plugin mem _iotas : + Keccak_1600_ref_modular.Mmod.__keccak_f1600_ref ~ Mmod.__keccak_f1600_scalar : + Glob.mem{2} = mem /\ good_iotas mem (to_uint iotas{2}) /\ ={Glob.mem} /\ arg{1} = arg{2}.`1 /\ _iotas = arg{2}.`2 ==> + Glob.mem{2} = mem /\ ={Glob.mem} /\ res{1} = res{2}.`1 /\ _iotas = res{2}.`2. +(* there in perm *) +admit. +qed. + +equiv modcorrect mem : + Keccak_1600_ref_modular.Mmod.__keccak_1600 ~ Mmod.__keccak_1600 : + Glob.mem{2} = mem /\ good_iotas mem (to_uint iotas{2}) /\ + in_0{1} = in_0{2} /\ inlen{1} = inlen{2} /\ s_out{1} = s_out{2} /\ s_outlen{1} = s_outlen{2} /\ rate{1} = rate{2} /\ + s_trail_byte{1} = s_trail_byte{2} /\ ={Glob.mem} ==> ={Glob.mem}. +proc. +seq 2 2 : (#pre /\ ={state}). +call(_:true). +while (#post /\ to_uint i{2} = i{1} /\ i{2} \ule W64.of_int 25 /\ t{2} = W64.zero). +auto => />; progress; [ by smt(@W64) | by smt(@W64) | by rewrite ultE; smt(@W64)| by smt(@W64)]. +auto => />; rewrite set0_64E => />. +by auto => />. + +seq 4 1 : #{/~in_0{1} = in_0{2}}{~inlen{1} = inlen{2}}pre. +inline Mmod.absorb. +swap {2} [5..6] -2; swap {2} [2..4] -1; sp 0 3. +seq 0 3 : (#{/~state{1} = state{2}}{/~in_0{1} = in_0{2}}{~inlen{1} = inlen{2}}pre /\ state0{2} = state{1} /\ inlen0{2} = inlen{1} /\ in_00{2} = in_0{1}); first by auto => />. +seq 1 1 : #pre. +while (#post). +inline Mmod.load_3 Mmod.spill_3. +wp. +exists* Glob.mem{2}, iotas0{2}. +elim* => memm _iotas. +call (plugin memm _iotas). +wp. +call (_: ={Glob.mem}); first by sim. +by auto => />; progress. +by auto => />. +wp. +call (_: ={Glob.mem}); first by sim. +by auto => />. +inline Mmod.squeeze. +swap {2} 6 -2; swap {2} [3..4] -2; sp 0 2. +seq 1 4 : (#{/~state{1} = state{2}}{~Glob.mem{2}=mem}{~s_out{1} = s_out{2}}{~s_outlen{1} = s_outlen{2}}pre /\ state0{2} = state{1} /\ outlen0{2} = outlen{1} /\ s_out0{2} = s_out{1} /\ good_iotas Glob.mem{2} (to_uint iotas{2})); first by auto => />. +seq 1 1 : #pre. +while (#post). +inline Mmod.load_3 Mmod.spill_2. +wp. +call (_: ={Glob.mem}); first by sim. +wp. +exists* Glob.mem{2}, iotas0{2}. +elim* => memm _iotas. +call (plugin memm _iotas). +wp;skip;progress. admit. (* need to show iotas are not tampered *) +by auto => />. +seq 2 2 : (#pre /\ s_outlen{1} = s_outlen0{2}). +exists* Glob.mem{2}, iotas0{2}. +elim* => memm _iotas. +call (plugin memm _iotas). +by auto => />. +inline *. +by sim. +qed. From 62c8451d7d036010d3ed6cbfd17fdd4363760bc8 Mon Sep 17 00:00:00 2001 From: Manuel Barbosa Date: Tue, 14 May 2019 15:50:07 +0100 Subject: [PATCH 400/525] scalar correctness done modulo transitivity --- proof/impl/libc/keccak_1600_scalar_modular.ec | 26 ++++++---- proof/impl/perm/keccak_f1600_scalar_table.ec | 49 +++++++++++++++++-- 2 files changed, 60 insertions(+), 15 deletions(-) diff --git a/proof/impl/libc/keccak_1600_scalar_modular.ec b/proof/impl/libc/keccak_1600_scalar_modular.ec index 33d2562..c1d59a6 100644 --- a/proof/impl/libc/keccak_1600_scalar_modular.ec +++ b/proof/impl/libc/keccak_1600_scalar_modular.ec @@ -256,6 +256,7 @@ proc. by sim. qed. +(* op good_iotas (mem : global_mem_t, _iotas : int) = forall off, 0 <= off < 24 => loadW64 mem (_iotas + (off * 8)) = Keccak_f1600_ref_op.iotas.[off]. @@ -268,10 +269,14 @@ equiv plugin mem _iotas : (* there in perm *) admit. qed. - +*) +require Keccak_f1600_scalar_table. +print Keccak_f1600_scalar_table.scalarcorr_op. equiv modcorrect mem : Keccak_1600_ref_modular.Mmod.__keccak_1600 ~ Mmod.__keccak_1600 : - Glob.mem{2} = mem /\ good_iotas mem (to_uint iotas{2}) /\ + Glob.mem{2} = mem /\ Keccak_f1600_scalar_table.good_iotas mem (to_uint iotas{2}) /\ + 0 <= to_uint iotas{2} < W64.modulus - 24 * 8 /\ + (to_uint iotas{2} - 8 * 8) %% 256 = 0 /\ in_0{1} = in_0{2} /\ inlen{1} = inlen{2} /\ s_out{1} = s_out{2} /\ s_outlen{1} = s_outlen{2} /\ rate{1} = rate{2} /\ s_trail_byte{1} = s_trail_byte{2} /\ ={Glob.mem} ==> ={Glob.mem}. proc. @@ -292,17 +297,17 @@ inline Mmod.load_3 Mmod.spill_3. wp. exists* Glob.mem{2}, iotas0{2}. elim* => memm _iotas. -call (plugin memm _iotas). +call (Keccak_f1600_scalar_table.scalarcorr_op (to_uint _iotas) memm). wp. call (_: ={Glob.mem}); first by sim. -by auto => />; progress. +auto => />; progress. smt(@W64). by auto => />. wp. call (_: ={Glob.mem}); first by sim. by auto => />. inline Mmod.squeeze. swap {2} 6 -2; swap {2} [3..4] -2; sp 0 2. -seq 1 4 : (#{/~state{1} = state{2}}{~Glob.mem{2}=mem}{~s_out{1} = s_out{2}}{~s_outlen{1} = s_outlen{2}}pre /\ state0{2} = state{1} /\ outlen0{2} = outlen{1} /\ s_out0{2} = s_out{1} /\ good_iotas Glob.mem{2} (to_uint iotas{2})); first by auto => />. +seq 1 4 : (#{/~state{1} = state{2}}{~Glob.mem{2}=mem}{~s_out{1} = s_out{2}}{~s_outlen{1} = s_outlen{2}}pre /\ state0{2} = state{1} /\ outlen0{2} = outlen{1} /\ s_out0{2} = s_out{1} /\ Keccak_f1600_scalar_table.good_iotas Glob.mem{2} (to_uint iotas{2})); first by auto => />. seq 1 1 : #pre. while (#post). inline Mmod.load_3 Mmod.spill_2. @@ -311,14 +316,15 @@ call (_: ={Glob.mem}); first by sim. wp. exists* Glob.mem{2}, iotas0{2}. elim* => memm _iotas. -call (plugin memm _iotas). -wp;skip;progress. admit. (* need to show iotas are not tampered *) +call (Keccak_f1600_scalar_table.scalarcorr_op (to_uint _iotas) memm). +print Keccak_f1600_scalar_table.scalarcorr_op. +wp;skip;progress. smt(@W64). admit. (* what am I missing? The post condition in the call seems to ensure mem_R = memm bit this is not in the context *) by auto => />. seq 2 2 : (#pre /\ s_outlen{1} = s_outlen0{2}). exists* Glob.mem{2}, iotas0{2}. elim* => memm _iotas. -call (plugin memm _iotas). -by auto => />. -inline *. +call (Keccak_f1600_scalar_table.scalarcorr_op (to_uint _iotas) memm). +wp;skip;progress. smt(@W64). + inline *. by sim. qed. diff --git a/proof/impl/perm/keccak_f1600_scalar_table.ec b/proof/impl/perm/keccak_f1600_scalar_table.ec index 4a13911..3653aef 100644 --- a/proof/impl/perm/keccak_f1600_scalar_table.ec +++ b/proof/impl/perm/keccak_f1600_scalar_table.ec @@ -99,7 +99,7 @@ module Mscalarrho = { equiv scalarrhom : M.__keccak_f1600_scalar ~ Mscalarrho.keccak_f : - ={Glob.mem,arg} ==> ={res} by sim. + ={Glob.mem,arg} ==> ={Glob.mem,res} by sim. module Mscalartable = { include M [-keccak_rho_offsets,rhotates,rol_sum,round2x,__keccak_f1600_scalar] @@ -207,7 +207,7 @@ qed. equiv round2x : Mscalarrho.round2x ~ Mscalartable.round2x : - ={Glob.mem,arg} ==> ={res}. + ={Glob.mem,arg} ==> ={Glob.mem,res}. proc. call (_:true); first by sim. call (rol_sum). @@ -226,7 +226,7 @@ qed. equiv scalartable : Mscalarrho.keccak_f ~ Mscalartable.keccak_f : - ={Glob.mem,arg} ==> ={res}. + ={Glob.mem,arg} ==> ={Glob.mem,res}. proc. wp. while (={Glob.mem,zf,_A,_R,iotas}). @@ -249,11 +249,26 @@ move => *. rewrite /x86_TEST_8. rewrite /rflags_of_bwop8. rewrite /truncateu8 => //=. -rewrite /ZF_of_w8. +rewrite /ZF_of_w8 => //=. +pose i := to_uint x. +have inneg : (0 <= i); first by smt(@W64). +auto => />. +split. +rewrite (W8.and_mod 8) => />. +rewrite W8.of_int_mod => />. +rewrite W8.of_int_mod => />. +admit. +rewrite (W8.and_mod 8) => />. +rewrite W8.of_int_mod => />. +rewrite W8.of_int_mod => />. admit. qed. -lemma rol0 : (forall x , (x86_ROL_64 x (W8.of_int (rhotates 0))).`3 = x) by admit. +lemma rol0 : (forall x , (x86_ROL_64 x (W8.of_int (rhotates 0))).`3 = x). +move => *. +rewrite x86_ROL_64_E /rhotates rol_xor =>/>. +smt. +qed. lemma scalarcorr _iotas mem : equiv [ Mrefloop2.__keccak_f1600_ref ~ Mscalartable.keccak_f : @@ -262,6 +277,8 @@ lemma scalarcorr _iotas mem : mem = Glob.mem{2} /\ to_uint iotas{2} = _iotas /\ state{1} = _A{2} ==> mem = Glob.mem{2} /\ to_uint res{2}.`2 = _iotas /\ res{1} = res{2}.`1 ]. +admitted. +(* proc. seq 2 1 : (#pre /\ constants{1} = iotas); first by inline *;auto => />. @@ -656,3 +673,25 @@ rewrite (_ : iotas_R = W64.of_int (to_uint iotas{2} - round{1} * 8 + 24*8)). smt(@W64). smt(@W64 @W8). qed. +*) + +require Keccak_f1600_ref_op. +require Keccak_f1600_ref. + +lemma scalarcorr_op _iotas mem : + equiv [ Keccak_f1600_ref.M.__keccak_f1600_ref ~ Keccak_f1600_scalar.M.__keccak_f1600_scalar : + 0 <= _iotas < W64.modulus - 24 * 8 /\ + good_iotas mem _iotas /\ (_iotas - 8*8) %% 256 = 0 /\ ={Glob.mem} /\ + mem = Glob.mem{2} /\ to_uint iotas{2} = _iotas /\ + state{1} = a{2} ==> mem = Glob.mem{2} /\ to_uint res{2}.`2 = _iotas /\ + res{1} = res{2}.`1 ]. +print Keccak_f1600_ref_loop2. +move : Keccak_f1600_ref_op.ref_refop => *. +move : reftable_refloop => *. +move : refloop_refloopk => *. +move : refloopk_refloop2 => *. +move : (scalarcorr _iotas mem) => *. +move : scalartable => *. +move : scalarrhom => *. +admit. +qed. From e814c8b48ea255be4a936b272edb7677ddc33cf0 Mon Sep 17 00:00:00 2001 From: Manuel Barbosa Date: Tue, 14 May 2019 16:00:21 +0100 Subject: [PATCH 401/525] comments --- proof/impl/perm/keccak_f1600_scalar_table.ec | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/proof/impl/perm/keccak_f1600_scalar_table.ec b/proof/impl/perm/keccak_f1600_scalar_table.ec index 3653aef..f6a4601 100644 --- a/proof/impl/perm/keccak_f1600_scalar_table.ec +++ b/proof/impl/perm/keccak_f1600_scalar_table.ec @@ -277,7 +277,7 @@ lemma scalarcorr _iotas mem : mem = Glob.mem{2} /\ to_uint iotas{2} = _iotas /\ state{1} = _A{2} ==> mem = Glob.mem{2} /\ to_uint res{2}.`2 = _iotas /\ res{1} = res{2}.`1 ]. -admitted. +admitted. (* just to compile fast, it is OK and admit-free *) (* proc. seq 2 1 : (#pre /\ constants{1} = iotas); first by inline *;auto => />. @@ -693,5 +693,5 @@ move : refloopk_refloop2 => *. move : (scalarcorr _iotas mem) => *. move : scalartable => *. move : scalarrhom => *. -admit. +admit. (* how to join them all? *) qed. From 64baa2860c0c303c882584dcbe1da332c23ca4fc Mon Sep 17 00:00:00 2001 From: Manuel Barbosa Date: Tue, 14 May 2019 17:18:39 +0100 Subject: [PATCH 402/525] dir locals for equivalence --- proof/impl/libc/.dir-locals.el | 4 ++++ 1 file changed, 4 insertions(+) create mode 100644 proof/impl/libc/.dir-locals.el diff --git a/proof/impl/libc/.dir-locals.el b/proof/impl/libc/.dir-locals.el new file mode 100644 index 0000000..4161845 --- /dev/null +++ b/proof/impl/libc/.dir-locals.el @@ -0,0 +1,4 @@ +((easycrypt-mode . + ((eval . + (cl-flet ((pre (s) (concat (locate-dominating-file buffer-file-name ".dir-locals.el") s))) + (setq easycrypt-load-path `(,(pre "../perm"))))))))) From b8dca9b4c22495e19ab97848fa7fc0d69480c969 Mon Sep 17 00:00:00 2001 From: Manuel Barbosa Date: Tue, 14 May 2019 18:23:11 +0100 Subject: [PATCH 403/525] Preparing for avx2 equivalence proof --- proof/impl/perm/keccak_f1600_avx2.ec | 30 +++++++++++++++++++ proof/impl/perm/keccak_f1600_avx2_prevec.ec | 8 +++++ .../perm/keccak_f1600_avx2_prevec_vops.ec | 1 + proof/impl/perm/keccak_f1600_scalar_table.ec | 1 + 4 files changed, 40 insertions(+) diff --git a/proof/impl/perm/keccak_f1600_avx2.ec b/proof/impl/perm/keccak_f1600_avx2.ec index d872dc5..a1b2d5e 100644 --- a/proof/impl/perm/keccak_f1600_avx2.ec +++ b/proof/impl/perm/keccak_f1600_avx2.ec @@ -818,3 +818,33 @@ equiv avx2_avx2_openssl : by auto => />. qed. +require import Array4 Array25. +require Keccak_f1600_ref_op. +require Keccak_f1600_ref. +require Keccak_f1600_ref_table. +require Keccak_f1600_avx2_prevec. +require Keccak_f1600_avx2_prevec_vops. + +lemma avx2corr (_a00 _a01 _a20 _a31 _a21 _a41 _a11 : W64.t Array4.t) + (st : W64.t Array25.t) _iotas mem : + equiv [ Keccak_f1600_ref.M.__keccak_f1600_ref ~ M.__keccak_f1600_avx2 : + Glob.mem{2} = mem /\ Keccak_f1600_avx2_prevec.good_iotas mem (W64.to_uint _iotas{2}) /\ + Keccak_f1600_avx2_prevec.good_rhol mem (to_uint _rhotates_left{2}) /\ + Keccak_f1600_avx2_prevec.good_rhor mem (to_uint _rhotates_right{2}) /\ + Keccak_f1600_avx2_prevec.equiv_states _a00 _a01 _a20 _a31 _a21 _a41 _a11 st /\ + Keccak_f1600_avx2_prevec_vops.match_states (_a00,_a01,_a20,_a31,_a21,_a41,_a11) + (state{2}.[0],state{2}.[1],state{2}.[2],state{2}.[3],state{2}.[4],state{2}.[5],state{2}.[6]) + /\ state{1} = st ==> Glob.mem{2} = mem /\ + exists (__a00 __a01 __a20 __a31 __a21 __a41 __a11 : W64.t Array4.t) , + Keccak_f1600_avx2_prevec.equiv_states __a00 __a01 __a20 __a31 __a21 __a41 __a11 st /\ + Keccak_f1600_avx2_prevec_vops.match_states (_a00,_a01,_a20,_a31,_a21,_a41,_a11) + (res{2}.[0],res{2}.[1],res{2}.[2],res{2}.[3],res{2}.[4],res{2}.[5],res{2}.[6])]. +move : Keccak_f1600_ref_op.ref_refop => *. +move : Keccak_f1600_ref_table.ref_reftable => *. +move : (Keccak_f1600_avx2_prevec.correct_perm + _a00 _a01 _a20 _a31 _a21 _a41 _a11 st mem) => *. +move : Keccak_f1600_avx2_prevec_vops.prevec_vops_prevec => *. +move : Keccak_f1600_avx2_prevec_vops.prevec_vops_openssl => *. +move : avx2_avx2_openssl => *. +admit. (* how to join them all? *) +qed. diff --git a/proof/impl/perm/keccak_f1600_avx2_prevec.ec b/proof/impl/perm/keccak_f1600_avx2_prevec.ec index fe8e56b..eb20455 100644 --- a/proof/impl/perm/keccak_f1600_avx2_prevec.ec +++ b/proof/impl/perm/keccak_f1600_avx2_prevec.ec @@ -722,6 +722,8 @@ lemma lift_roln mem rl rr o1 o2 x: (to_uint (rl + W64.of_int 96 + W64.of_int (8 * 4 * o1 - 96))))).[o2]))%W64 = (x86_ROL_64 x ((of_int (rhotates (conversion o1 o2))))%W8).`3. proof. +admit. (* admit free slow proof below *) +(* move => *. rewrite (loadlift_rhol mem (rl) o1). smt(). smt(). rewrite (loadlift_rhor mem (rr) o1). smt(). smt(). @@ -769,6 +771,7 @@ case (o2 = 2). auto => />. smt(roln). case (o2 = 3). auto => />. smt(roln). smt(). smt(). +*) qed. lemma correct_perm _a00 _a01 _a20 _a31 _a21 _a41 _a11 st mem: @@ -778,7 +781,10 @@ lemma correct_perm _a00 _a01 _a20 _a31 _a21 _a41 _a11 st mem: equiv_states _a00 _a01 _a20 _a31 _a21 _a41 _a11 st /\ a00{2} = _a00 /\ a01{2} = _a01 /\ a20{2} = _a20 /\ a31{2} = _a31 /\ a21{2} = _a21 /\ a41{2} = _a41 /\ a11{2} = _a11 /\ state{1} = st ==> + Glob.mem{2} = mem /\ equiv_states res{2}.`1 res{2}.`2 res{2}.`3 res{2}.`4 res{2}.`5 res{2}.`6 res{2}.`7 res{1}]. +admit. (* slow admit free proof below *) +(* proc. unroll {1} 3. rcondt {1} 3; first by move => *; inline *; auto => />. @@ -1523,5 +1529,7 @@ move : H7. rewrite dec0. rewrite to_uintD. smt(@W32). rewrite dec. rewrite to_uintD. smt(@W32). rewrite to_uintD. smt(@W32). +*) qed. + diff --git a/proof/impl/perm/keccak_f1600_avx2_prevec_vops.ec b/proof/impl/perm/keccak_f1600_avx2_prevec_vops.ec index 36169d3..bfef0db 100644 --- a/proof/impl/perm/keccak_f1600_avx2_prevec_vops.ec +++ b/proof/impl/perm/keccak_f1600_avx2_prevec_vops.ec @@ -477,3 +477,4 @@ admit. admit. admit. admit. admit. admit. by auto => />. qed. + diff --git a/proof/impl/perm/keccak_f1600_scalar_table.ec b/proof/impl/perm/keccak_f1600_scalar_table.ec index f6a4601..8fd0928 100644 --- a/proof/impl/perm/keccak_f1600_scalar_table.ec +++ b/proof/impl/perm/keccak_f1600_scalar_table.ec @@ -687,6 +687,7 @@ lemma scalarcorr_op _iotas mem : res{1} = res{2}.`1 ]. print Keccak_f1600_ref_loop2. move : Keccak_f1600_ref_op.ref_refop => *. +move : Keccak_f1600_ref_table.ref_reftable => *. move : reftable_refloop => *. move : refloop_refloopk => *. move : refloopk_refloop2 => *. From 6dbf1c4784edf2fd5acdc81d9d1fb9a84fdc0ad9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jos=C3=A9=20Bacelar=20Almeida?= Date: Tue, 14 May 2019 22:19:02 +0100 Subject: [PATCH 404/525] progress --- proof/impl/keccak_1600_corr.ec | 469 +++++++++++++++++++++++++++++---- proof/impl/keccak_1600_ref.ec | 120 +++++---- 2 files changed, 490 insertions(+), 99 deletions(-) diff --git a/proof/impl/keccak_1600_corr.ec b/proof/impl/keccak_1600_corr.ec index f0eafa8..d36bd79 100644 --- a/proof/impl/keccak_1600_corr.ec +++ b/proof/impl/keccak_1600_corr.ec @@ -5,8 +5,9 @@ require import Array25 EclibExtra JWordList. require import Spec1600 Keccak_1600_ref. +(* op x86_TEST_8 : W8.t -> W8.t -> bool*bool*bool*bool*bool. - +*) op memread (m : global_mem_t) (a : address) (sz : int): W8.t list = mkseq (fun i => m.[a + i]) sz. @@ -49,6 +50,173 @@ elim: l1 mem out => //= x xs IH mem out. by rewrite !stores_cons IH addzA. qed. +lemma addstate_nil st: + addstate st [] = st. +proof. by apply Array25.ext_eq => i Hi; rewrite /addstate initiE. qed. + +lemma addstate_get st l i: + 0 <= i < 25 => + (addstate st l).[i] = st.[i] `^` nth W64.zero l i. +proof. by move=> Hi; rewrite /addstate initiE. qed. + +lemma addstate_get' st l i: + size l <= i => + (addstate st l).[i] = st.[i]. +proof. +move=> Hsz. +case: (0 <= i < 25) => E. + by rewrite addstate_get // nth_out 1:/# W64.xorw0. +by rewrite !Array25.get_out. +qed. + +lemma addstate_rcons st xs x: + addstate st (rcons xs x) + = (addstate st xs).[size xs <- st.[size xs] `^` x]. +proof. +apply Array25.ext_eq => i Hi. +rewrite Array25.get_set_if !addstate_get //. +case: (i = size xs) => E /=. + by rewrite -!E Hi /= nth_rcons -E ltzz. +rewrite nth_rcons E /=. +case: (i < size xs) => //?. +by rewrite nth_out /#. +qed. + + +abbrev w8L2w64L xs = bits2w64L (w8L2bits xs). + +op u64xoru8 (w: W64.t) i (b: W8.t) = + W8u8.pack8_t + (W8u8.Pack.init + (fun (j:int) => if j=i then (w \bits8 j) `^` b else w \bits8 j)). + +op state_xor_u8 (st: state) i (b: W8.t): state = + Array25.init + (WArray200.WArray200.get64 + (WArray200.WArray200.set8 + (WArray200.WArray200.init64 (Array25."_.[_]" st)) + i + (WArray200.WArray200.get8 + (WArray200.WArray200.init64 ("_.[_]" st)) i `^` b))). + +lemma state_xor_u8P st i b: + 0 <= i < 200 => + state_xor_u8 st i b + = st.[(i %/ 8) <- u64xoru8 st.[i %/ 8] (i %% 8) b]. +proof. +move=> Hi. +rewrite /state_xor_u8; apply Array25.ext_eq => k Hk. +rewrite Array25.initiE // WArray200.WArray200.get64E /=. +rewrite Array25.get_set_if; case: (k = i %/ 8) => /= E; last first. + apply (eq_trans _ (pack8_t (unpack8 st.[k]))); last by apply unpack8K. + congr; apply W8u8.Pack.init_ext => x Hx /=. + rewrite WArray200.WArray200.get_set8E //. + rewrite (: ! 8 * k + x = i) /=. smt. + rewrite /WArray200.WArray200.get8. + rewrite /WArray200.WArray200.init64 WArray200.WArray200.initiE 1:/# /=. + have ->: (8 * k + x) %/ 8 = k. smt. + have ->: (8 * k + x) %% 8 = x. smt. + done. +rewrite (: 0 <= i %/ 8 < 25) 1:/# /= /u64xoru8; congr. +apply W8u8.Pack.init_ext => x Hx /=. +rewrite WArray200.WArray200.get_set8E 1:/#. +case: (8*k+x = i) => E2. + have ->/=: x = i%%8 . smt. + rewrite /WArray200.WArray200.get8; congr. + by rewrite /WArray200.WArray200.init64 WArray200.WArray200.initiE 1:/#. +have ->/=: !x = i%%8. smt. +rewrite /WArray200.WArray200.get8. +rewrite /WArray200.WArray200.init64 WArray200.WArray200.initiE 1:/# /=. +have ->: (8 * k + x) %/ 8 = i %/ 8. smt. +have ->: (8 * k + x) %% 8 = x. smt. +done. +qed. + +lemma state_xor_u8E st j b: + Array25.init + (WArray200.WArray200.get64 + (WArray200.WArray200.set8 + (WArray200.WArray200.init64 (Array25."_.[_]" st)) + j + (WArray200.WArray200.get8 (WArray200.WArray200.init64 ("_.[_]" st)) j `^` b))) + = state_xor_u8 st j b. +proof. by rewrite /state_xor_u8. qed. + + +lemma final_block64_lastu64 trailb m: + final_block64 trailb m = + rcons (w8L2w64L (take (size m %/ 8 * 8) m)) + (W8u8.pack8 (rcons (drop (size m %/ 8 * 8) m) trailb)). +proof. +rewrite /final_block64 -{1}(cat_take_drop (size m %/ 8 * 8) m). +admit. +qed. + +lemma addstate_rcons_byte (st:state) i b m: + size m < 8 => + 0 <= i < 25 => + st.[i <- st.[i] `^` W8u8.pack8 (rcons m b)] + = state_xor_u8 st.[i <- st.[i] `^` W8u8.pack8 m] + (8*i + size m) b. +proof. +move=> Hsz Hi; apply Array25.ext_eq => k Hk. +rewrite state_xor_u8P. smt. +rewrite !Array25.get_setE //. smt. +case: (k=i) => E /=. + rewrite !E. clear k Hk E. + have ->/=: (8 * i + size m) %/ 8 = i. smt. + rewrite /u64xoru8 -{1}(W8u8.unpack8K st.[i]) xorb8u8E; congr. + rewrite W8u8.Pack.map2E; apply W8u8.Pack.init_ext => j Hj /=. + case: (j = size m) => E; last first. + have ->/=: ! j = (8 * i + size m) %% 8. smt. + have ->: ((of_list (rcons m b)))%W8u8.Pack.[j] = pack8 m \bits8 j. + rewrite W8u8.Pack.of_listE W8u8.Pack.initiE //= W8u8.pack8bE //=. + rewrite W8u8.Pack.get_of_list //. + smt. + congr. smt. + have ->/=: j = (8 * i + size m) %% 8. smt. + have ->: (8 * i + size m) %% 8 = size m. smt. + have ->: (pack8 m \bits8 size m) = W8.zero. + rewrite W8u8.Pack.of_listE W8u8.pack8bE //= 1:/#. + rewrite W8u8.Pack.initiE 1:/#. smt. + have ->: ((of_list (rcons m b)))%W8u8.Pack.[size m] = b. + rewrite W8u8.Pack.of_listE W8u8.Pack.initiE 1:/#. + smt. + by rewrite /unpack8 initiE 1:/#. +have ->/=: ! k = (8 * i + size m) %/ 8. smt. +done. +qed. + +lemma addfinalbitE st: + addfinalbit st = state_xor_u8 st (rate8-1) (W8.of_int 128). +proof. +rewrite /addfinalbit; apply Array25.ext_eq => i Hi. +rewrite Array25.get_setE; first smt(rate64_bnds). +rewrite state_xor_u8P; first smt. +rewrite (: (rate8 - 1) %/ 8 = rate64-1). smt. +rewrite (: (rate8 - 1) %% 8 = 7). smt. +rewrite Array25.get_setE; first smt(rate64_bnds). +case: (i = rate64-1) => // E. +rewrite -(W8u8.unpack8K (st.[rate64 - 1]`^` (of_int (2 ^ 63))%W64)) /u64xoru8. congr. +apply W8u8.Pack.init_ext => x Hx. +rewrite (: 2^63 = 1*2^63) 1:// -W64.shlMP //=. +rewrite (: 128 = 1*2^7) 1:// -W8.shlMP //=. +have ->: (W64.one `<<<` 63 \bits8 x) + = if x=7 then (W8.one `<<<` 7) else W8.zero. + case: (x=7) => E2. + rewrite W8u8.bits8E /=. + apply W8.all_eqP. rewrite !E2 /all_eq /=. + do 7! rewrite W64.get_out // W8.get_out //=. + smt. +rewrite W8u8.bits8E /=. + apply W8.all_eqP. + + +have : x \in iota_ 0 7 by smt(). +move: {Hx E2} x; rewrite -List.allP /all_eq /= !W64.get_out //=. + +by case: (x=7) => //. +qed. (* SPECIFICATION OF LEAF-FUNCTIONS *) @@ -78,109 +246,308 @@ lemma st0_spec: phoare [ M.st0 : true ==> res = st0 ] = 1%r. proof. by conseq st0_spec_ll st0_spec_h. qed. -lemma add_full_block_spec_h st in_00: +lemma loadW64_w8L2w64L mem in_ inlen i: + 0 <= i < inlen %/ 8 => + loadW64 mem (in_+8*i) + = nth W64.zero (w8L2w64L (memread mem in_ inlen)) i. +admitted. + +lemma loadW64_take_block64 mem in_ i: + 0 <= i < rate64 => + loadW64 mem (in_ + 8 * i) = + nth W64.zero (take_block64 (memread mem in_ rate8)).`1 i. +proof. +rewrite /loadW64 /take_block64 /= => Hi. +rewrite take_oversize ?size_memread 1..2:/#. +admit. +qed. + +lemma size_w8L2w64L l: + 8 %| size l => size (w8L2w64L l) = size l %/ 8. +proof. +admit. +qed. + +lemma size_w64L2w8L l: + size (w64L2w8L l) = 8 * size l. +proof. +admit. +qed. + +lemma take_w8L2w64L n l: + take n (w8L2w64L l) = w8L2w64L (take (8*n) l). +proof. +elim/natind: n l => //=. + admit. +move=> n Hn IH l. +case: (n < size (w8L2w64L l)) => E. + rewrite (take_nth W64.zero) 1:/# IH -cats1 mulzDr /=. + have ->: take (8*n + 8) l = take (8*n) l ++ take 8 (drop (8*n) l). + admit. + have ->: w8L2w64L (take (8 * n) l ++ take 8 (drop (8 * n) l)) + = w8L2w64L (take (8 * n) l) ++ w8L2w64L (take 8 (drop (8 * n) l)). + admit. + congr. + admit. +rewrite take_oversize 1:/#. +move: E; rewrite size_w8L2w64L. admit (*???*). smt. +qed. + +lemma add_full_block_spec_h st in_ inlen_ r8_: hoare [ M.add_full_block: state = st - /\ in_0 = in_00 - /\ to_uint r64 = rate64 + /\ in_0 = in_ + /\ inlen = inlen_ + /\ r8 = r8_ + /\ good_ptr in_0 rate8 + /\ to_uint r8 = rate8 ==> - res = addstate st - (take_block64 (memread Glob.mem (to_uint in_00) rate8)).`1 + res.`1 = addstate st + (take_block64 (memread Glob.mem (to_uint in_) rate8)).`1 + /\ res.`2 = (in_ + r8_)%W64 + /\ res.`3 = inlen_ - r8_ ]. proof. proc; simplify; wp; sp. -while (#[2:]pre /\ to_uint i <= rate64 - /\ state = addstate st (take (to_uint i) (take_block64 (memread Glob.mem (to_uint in_00) rate8)).`1)). +while (#[4:]pre /\ to_uint r64 = rate64 /\ to_uint i <= rate64 /\ + state = addstate st (take (to_uint i) + (take_block64 (memread Glob.mem (to_uint in_) rate8)).`1)). wp; skip; progress. - + admit. - + move: H2; rewrite ultE => ?. - rewrite to_uintD_small of_uintK modz_small; smt(rate64_bnds). - + rewrite to_uintD_small to_uintM_small of_uintK modz_small //. + + move: H3; rewrite ultE => ?. + by rewrite to_uintD_small of_uintK modz_small; smt(rate64_bnds). + + pose s := take (to_uint i{hr}) _. + rewrite (addstate_get' st s); first smt. + rewrite to_uintD_small to_uintM_small of_uintK modz_small //. - smt(rate64_bnds). - - admit (* in_0 mem_region *). + - smt. - smt(rate64_bnds). - admit . + rewrite to_uintD_small of_uintK modz_small //. + smt. + rewrite (take_nth W64.zero). + smt. + rewrite addstate_rcons -/s (: size s = to_uint i{hr}) 1:[smt]. + congr; congr. + rewrite loadW64_take_block64 //. + smt. skip; progress. ++ by rewrite to_uint_shr /#. + smt(rate64_bnds). -+ rewrite take0 /addstate. - admit. ++ by rewrite take0 addstate_nil. + have E: to_uint i0 = rate64. - admit. - move: H3; rewrite take_oversize. - admit. + smt. + move: H5; rewrite take_oversize. + smt. done. qed. lemma add_full_block_spec_ll: islossless M.add_full_block. proof. -proc; wp; sp; while true (rate64-to_uint i). +proc; wp; sp; while true (to_uint r64-to_uint i). move=> ?; wp; skip; progress. move: H; rewrite ultE => ?. rewrite to_uintD_small of_uintK modz_small //. - admit. + by move: (W64.to_uint_cmp r64{hr}) => /#. smt(). skip; progress. -rewrite ultE. -admit. +by rewrite ultE /#. qed. -lemma add_full_block_spec st in_00: +lemma add_full_block_spec st in_ inlen_ r8_: phoare [ M.add_full_block: state = st - /\ in_0 = in_00 - /\ to_uint r64 = rate64 + /\ in_0 = in_ + /\ inlen = inlen_ + /\ r8 = r8_ + /\ good_ptr in_0 rate8 + /\ to_uint r8 = rate8 ==> - res = addstate st - (take_block64 (memread Glob.mem (to_uint in_00) rate8)).`1 + res.`1 = addstate st + (take_block64 (memread Glob.mem (to_uint in_) rate8)).`1 + /\ res.`2 = (in_ + r8_)%W64 + /\ res.`3 = inlen_ - r8_ ] = 1%r. -proof. by conseq add_full_block_spec_ll (add_full_block_spec_h st in_00). qed. +proof. by conseq add_full_block_spec_ll (add_full_block_spec_h st in_ inlen_ r8_). qed. + -lemma add_final_block_spec_h st (in_00 inlen0: W64.t) trail_byte0: +lemma add_final_block_spec_h st (in_ inlen_: W64.t) trail_byte_: hoare [ M.add_final_block: state = st - /\ in_0 = in_00 - /\ inlen = inlen0 - /\ trail_byte = trail_byte0 + /\ in_0 = in_ + /\ inlen = inlen_ + /\ trail_byte = trail_byte_ /\ to_uint r8 = rate8 + /\ to_uint inlen_ < rate8 + /\ good_ptr in_0 (to_uint inlen_) ==> res = addfinalblock st - (final_block64 trail_byte0 - (memread Glob.mem (to_uint in_00) (to_uint inlen0))) + (final_block64 (W8.of_int (to_uint trail_byte_)) + (memread Glob.mem (to_uint in_) (to_uint inlen_))) ]. proof. proc; simplify. -admit. +seq 4: (to_uint i = to_uint inlen_ %/ 8 /\ + state = addstate st (w8L2w64L (take (to_uint inlen_ %/ 8 * 8) + (memread Glob.mem (to_uint in_) (to_uint inlen_)))) /\ + #[2:]pre /\ to_uint inlen8 = to_uint inlen_ %/ 8 ). + while (#[/3:]post /\ to_uint i <= to_uint inlen8 /\ + state = addstate st (take (to_uint i) (w8L2w64L (memread Glob.mem (to_uint in_) (to_uint inlen_ %/ 8 * 8))))). + wp; skip; progress. + rewrite to_uintD_small; smt. + rewrite (W64.to_uintD_small _ W64.one). smt. + have Esz : size (w8L2w64L (memread Glob.mem{hr} (to_uint in_0{hr}) (to_uint inlen{hr} %/ 8 * 8))) = to_uint inlen{hr} %/ 8. + rewrite size_w8L2w64L ?size_memread. smt. smt(). smt. smt. + rewrite of_uintK modz_small // (take_nth W64.zero) ?size_memread. + rewrite Esz. smt. + rewrite addstate_rcons; congr. + rewrite size_take. smt. + rewrite Esz. smt. + rewrite addstate_get. smt. + pose Z:= nth W64.zero (take _ _) _. + have ->/=: Z = W64.zero. + rewrite /Z nth_out // size_take'. smt. + rewrite size_w8L2w64L ?size_memread. smt. smt(). smt. + have ->/=: to_uint i{hr} <= to_uint inlen{hr} %/ 8 * 8 %/ 8. smt. + done. + congr. + rewrite size_take'. smt. + rewrite size_w8L2w64L ?size_memread. smt. smt(). smt. + have ->/=: to_uint i{hr} <= to_uint inlen{hr} %/ 8 * 8 %/ 8. smt. + done. + rewrite -loadW64_w8L2w64L. smt. + congr. + rewrite to_uintD_small. smt. smt. + wp; skip; progress. + + rewrite to_uint_shr; smt. + + rewrite to_uint_shr; smt. + + by rewrite take0 addstate_nil. + + smt. + + rewrite (: to_uint i0 = to_uint inlen{hr} %/ 8). smt. + rewrite take_w8L2w64L. + congr; congr; congr. + rewrite !take_memread. smt. smt. + congr. smt. + +exists* (addstate st + (w8L2w64L (take (to_uint inlen_ %/ 8 * 8) + (memread Glob.mem (to_uint in_) (to_uint inlen_))))); elim* => st'. +seq 2: (#[/1,4:-1]pre /\ + to_uint i = to_uint inlen_ /\ + state = st'.[to_uint inlen_ %/ 8 <- st'.[to_uint inlen_ %/ 8] `^` W8u8.pack8 (memread Glob.mem (to_uint in_ + to_uint inlen_ %/ 8 * 8) (to_uint inlen_ %% 8))]). + while (#[/:-2]post /\ to_uint inlen_ %/ 8 * 8 <= to_uint i <= to_uint inlen_ /\ + state = st'.[to_uint inlen_ %/ 8 <- st'.[to_uint inlen_ %/ 8] `^` + pack8 (take (to_uint i %% 8) (memread Glob.mem (to_uint in_ + to_uint inlen_ %/ 8 * 8) (to_uint inlen_ %% 8)))]). + wp; skip => ?[[[?]]]; progress. + rewrite to_uintD_small of_uintK modz_small //; smt. + rewrite to_uintD_small of_uintK modz_small //; smt. + rewrite state_xor_u8E (W64.to_uintD_small _ W64.one). smt. + + rewrite of_uintK (modz_small 1) //. + have ->: ((to_uint i{hr} + 1) %% 8) = to_uint i{hr} %% 8 + 1. smt. + rewrite (take_nth W8.zero). + rewrite size_memread. smt. smt. + rewrite addstate_rcons_byte. + rewrite size_take 1:/# size_memread 1:/#. + rewrite (: to_uint i{hr} %% 8 < to_uint inlen{hr} %% 8) /=. smt. + smt. smt. + congr. + rewrite size_take 1:/# size_memread 1:/#. + rewrite (: to_uint i{hr} %% 8 < to_uint inlen{hr} %% 8) /=. smt. + smt. + admit (* +loadW8 Glob.mem{hr} (to_uint (in_0{hr} + i{hr})) = +(memread Glob.mem{hr} (to_uint in_0{hr} + to_uint inlen{hr} %/ 8 * 8) + (to_uint inlen{hr} %% 8)).[to_uint i{hr} %% 8] +*). + wp; skip => ?[?]; progress. + + rewrite to_uint_shl of_uintK (modz_small 3) //= modz_small. smt. + smt. + + rewrite to_uint_shl //=. smt. + rewrite to_uint_shl //=. + rewrite (modz_small (_*_)%Int). smt. + rewrite (: to_uint i{hr} * 8 %% 8 = 0). smt. + rewrite take0 H addstate_get. smt. + have ->/=: W8u8.pack8 [] = W64.zero. admit. + pose X:= nth _ _ _. + have ->/=: X = W64.zero. + rewrite /X nth_out // size_w8L2w64L. admit. smt. + have <-:= addstate_get' st (w8L2w64L + (take (to_uint inlen{hr} %/ 8 * 8) + (memread Glob.mem{hr} (to_uint in_0{hr}) (to_uint inlen{hr})))). + rewrite size_w8L2w64L. admit. admit. + by rewrite Array25.set_notmod. + + smt. + + have E: to_uint i0 = to_uint inlen{hr}. smt. + smt. + +exists* (st'.[to_uint inlen_ %/ 8 <- st'.[to_uint inlen_ %/ 8] `^` W8u8.pack8 (memread Glob.mem (to_uint in_ + to_uint inlen_ %/ 8 * 8) (to_uint inlen_ %% 8))]); elim*=> st''. +seq 1: (#[/:-1]pre /\ + state = state_xor_u8 st'' (to_uint inlen_) trail_byte_). + wp; skip => ?[?[[?]]]; progress. + rewrite state_xor_u8E H; smt. + +(* summing up everything *) +wp; skip => ?[[?[?]]] |> *. +rewrite state_xor_u8E /addfinalblock addfinalbitE; congr; last first. + by rewrite to_uintB 2:/# uleE of_uintK modz_small //; smt(rate8_bnds). +rewrite final_block64_lastu64 addstate_rcons. +have inlen_bnds := W64.to_uint_cmp inlen{hr}. +pose L := w8L2w64L _. +have Lsz: size L = to_uint inlen{hr} %/ 8. + rewrite /L size_bits2w64L size_w8L2bits size_take' size_memread 1..3:/#. + rewrite (: to_uint inlen{hr} %/ 8 * 8 <= to_uint inlen{hr}) /=. + smt. + rewrite {2}(divz_eq (to_uint inlen{hr}) 8) (mulzC 8) mulzA /= !divzMDl //. + rewrite divNz //= (divz_small (to_uint inlen{hr} %% 8)) //. + by apply modz_cmp. +have E: (addstate st L).[size L] = st.[size L] by rewrite addstate_get' //. +rewrite -{1}E addstate_rcons_byte. + rewrite size_drop; first smt(size_ge0). + rewrite !size_memread 1:/#. + smt. + smt. +rewrite size_memread 1:/# drop_memread 1:/# -modzE size_memread; first smt(size_ge0). +pose Lsz' := 8 * size L + _. +have ->: Lsz' = to_uint inlen{hr} by smt(). +rewrite H H0 !Lsz /L size_memread; first smt(size_ge0). +by congr; congr. qed. + lemma add_final_block_spec_ll: islossless M.add_final_block. proof. islossless. - while true (to_uint inlen). - move=> ?; wp; skip; progress; rewrite to_uintB 2:/#. - by move: H; rewrite ultE uleE /#. + while true (to_uint inlen - to_uint i). + move=> ?; wp; skip; progress. + move: H; rewrite ultE ltzE=> ?; rewrite to_uintD_small of_uintK modz_small //. + by move: (W64.to_uint_cmp inlen{hr}); smt(). + smt(). by skip; progress; rewrite ultE /#. -while true (to_uint inlen). - move=> ?; wp; skip; progress; rewrite to_uintB 2:/#. - by move: H; rewrite uleE /#. -by skip; progress; rewrite uleE /#. +while true (to_uint inlen8 - to_uint i). + move=> ?; wp; skip; progress; rewrite to_uintD_small. + by move: H (W64.to_uint_cmp inlen8{hr}); rewrite ultE ltzE; smt(). + by move: H; rewrite ultE /#. +by skip; progress; rewrite ultE /#. qed. -lemma add_final_block_spec st (in_00 inlen0: W64.t) trailb: - phoare [ M.add_final_block: +lemma add_final_block_spec st (in_ inlen_: W64.t) trail_byte_: + phoare [ M.add_final_block: state = st - /\ in_0 = in_00 - /\ inlen = inlen0 - /\ trail_byte = trailb + /\ in_0 = in_ + /\ inlen = inlen_ + /\ trail_byte = trail_byte_ /\ to_uint r8 = rate8 + /\ to_uint inlen_ < rate8 + /\ good_ptr in_0 (to_uint inlen_) ==> res = addfinalblock st - (final_block64 trailb - (memread Glob.mem (to_uint in_00) (to_uint inlen0))) + (final_block64 (W8.of_int (to_uint trail_byte_)) + (memread Glob.mem (to_uint in_) (to_uint inlen_))) ] = 1%r. proof. -by conseq add_final_block_spec_ll (add_final_block_spec_h st in_00 inlen0 trailb). +by conseq add_final_block_spec_ll (add_final_block_spec_h st in_ inlen_ trail_byte_). qed. + lemma xtr_full_block_spec_h mem st out0: hoare [ M.xtr_full_block: Glob.mem = mem diff --git a/proof/impl/keccak_1600_ref.ec b/proof/impl/keccak_1600_ref.ec index c48617d..d11683c 100644 --- a/proof/impl/keccak_1600_ref.ec +++ b/proof/impl/keccak_1600_ref.ec @@ -283,12 +283,15 @@ module M = { return (state); } - proc add_full_block (state:W64.t Array25.t, in_0:W64.t, r64:W64.t) : - W64.t Array25.t = { + proc add_full_block (state:W64.t Array25.t, in_0:W64.t, inlen:W64.t, + r8:W64.t) : W64.t Array25.t * W64.t * W64.t = { + var r64:W64.t; var i:W64.t; var t:W64.t; + r64 <- r8; + r64 <- (r64 `>>` (W8.of_int 3)); i <- (W64.of_int 0); while ((i \ult r64)) { @@ -296,122 +299,143 @@ module M = { state.[(W64.to_uint i)] <- (state.[(W64.to_uint i)] `^` t); i <- (i + (W64.of_int 1)); } - return (state); + in_0 <- (in_0 + r8); + inlen <- (inlen - r8); + return (state, in_0, inlen); } proc add_final_block (state:W64.t Array25.t, in_0:W64.t, inlen:W64.t, trail_byte:W8.t, r8:W64.t) : W64.t Array25.t = { + var inlen8:W64.t; var i:W64.t; var t:W64.t; - var j:W64.t; var c:W8.t; + inlen8 <- inlen; + inlen8 <- (inlen8 `>>` (W8.of_int 3)); i <- (W64.of_int 0); - while (((W64.of_int 8) \ule inlen)) { + while ((i \ult inlen8)) { t <- (loadW64 Glob.mem (W64.to_uint (in_0 + ((W64.of_int 8) * i)))); state.[(W64.to_uint i)] <- (state.[(W64.to_uint i)] `^` t); i <- (i + (W64.of_int 1)); - inlen <- (inlen - (W64.of_int 8)); } - j <- ((W64.of_int 8) * i); + i <- (i `<<` (W8.of_int 3)); - while (((W64.of_int 0) \ult inlen)) { - c <- (loadW8 Glob.mem (W64.to_uint (in_0 + j))); + while ((i \ult inlen)) { + c <- (loadW8 Glob.mem (W64.to_uint (in_0 + i))); state = Array25.init - (WArray200.get64 (WArray200.set8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint j) ( - (get8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint j)) `^` c))); - inlen <- (inlen - (W64.of_int 1)); - j <- (j + (W64.of_int 1)); + (WArray200.get64 (WArray200.set8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i) ( + (get8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i)) `^` c))); + i <- (i + (W64.of_int 1)); } - c <- trail_byte; state = Array25.init - (WArray200.get64 (WArray200.set8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint j) ( - (get8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint j)) `^` c))); + (WArray200.get64 (WArray200.set8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i) ( + (get8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i)) `^` trail_byte))); + i <- r8; + i <- (i - (W64.of_int 1)); state = Array25.init - (WArray200.get64 (WArray200.set8 (WArray200.init64 (fun i => state.[i])) ((W64.to_uint r8) - 1) ( - (get8 (WArray200.init64 (fun i => state.[i])) ((W64.to_uint r8) - 1)) `^` (W8.of_int 128)))); + (WArray200.get64 (WArray200.set8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i) ( + (get8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i)) `^` (W8.of_int 128)))); return (state); } - proc xtr_full_block (state:W64.t Array25.t, out:W64.t, r64:W64.t) : unit = { + proc xtr_full_block (state:W64.t Array25.t, out:W64.t, outlen:W64.t, + rate:W64.t) : W64.t * W64.t = { + var rate64:W64.t; var i:W64.t; var t:W64.t; + rate64 <- rate; + rate64 <- (rate64 `>>` (W8.of_int 3)); i <- (W64.of_int 0); - while ((i \ult r64)) { + while ((i \ult rate64)) { t <- state.[(W64.to_uint i)]; Glob.mem <- storeW64 Glob.mem (W64.to_uint (out + ((W64.of_int 8) * i))) t; i <- (i + (W64.of_int 1)); } - return (); + out <- (out + rate); + outlen <- (outlen - rate); + return (out, outlen); } proc xtr_bytes (state:W64.t Array25.t, out:W64.t, outlen:W64.t) : unit = { + var outlen8:W64.t; var i:W64.t; var t:W64.t; - var j:W64.t; var c:W8.t; + outlen8 <- outlen; + outlen8 <- (outlen8 `>>` (W8.of_int 3)); i <- (W64.of_int 0); - while (((W64.of_int 8) \ule outlen)) { + while ((i \ult outlen8)) { t <- state.[(W64.to_uint i)]; Glob.mem <- storeW64 Glob.mem (W64.to_uint (out + ((W64.of_int 8) * i))) t; i <- (i + (W64.of_int 1)); - outlen <- (outlen - (W64.of_int 8)); } - j <- ((W64.of_int 8) * i); + i <- (i `<<` (W8.of_int 3)); - while (((W64.of_int 0) \ult outlen)) { - c <- (get8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint j)); - Glob.mem <- storeW8 Glob.mem (W64.to_uint (out + j)) c; - outlen <- (outlen - (W64.of_int 1)); - j <- (j + (W64.of_int 1)); + while ((i \ult outlen)) { + c <- (get8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i)); + Glob.mem <- storeW8 Glob.mem (W64.to_uint (out + i)) c; + i <- (i + (W64.of_int 1)); } return (); } - proc __keccak_1600 (out:W64.t, outlen:W64.t, in_0:W64.t, inlen:W64.t, - trail_byte:W64.t, r8:W64.t) : unit = { + proc __keccak_1600 (s_out:W64.t, s_outlen:W64.t, in_0:W64.t, inlen:W64.t, + s_trail_byte:W64.t, rate:W64.t) : unit = { var state:W64.t Array25.t; - var rate:W64.t; - var trailbyte:W8.t; + var s_in:W64.t; + var s_inlen:W64.t; + var s_rate:W64.t; + var t:W64.t; + var trail_byte:W8.t; + var outlen:W64.t; + var out:W64.t; state <- witness; state <@ st0 (); - rate <- r8; while ((rate \ule inlen)) { - rate <- (rate `>>` (W8.of_int 3)); - state <@ add_full_block (state, in_0, rate); + (state, in_0, inlen) <@ add_full_block (state, in_0, inlen, rate); + s_in <- in_0; + s_inlen <- inlen; + s_rate <- rate; state <@ __keccak_f1600_ref (state); - rate <- r8; - inlen <- (inlen - rate); - in_0 <- (in_0 + rate); + inlen <- s_inlen; + in_0 <- s_in; + rate <- s_rate; } - trailbyte <- (truncateu8 trail_byte); - state <@ add_final_block (state, in_0, inlen, trailbyte, rate); + t <- s_trail_byte; + trail_byte <- (truncateu8 t); + state <@ add_final_block (state, in_0, inlen, trail_byte, rate); + outlen <- s_outlen; while ((rate \ult outlen)) { + s_outlen <- outlen; + s_rate <- rate; state <@ __keccak_f1600_ref (state); - rate <- r8; - rate <- (rate `>>` (W8.of_int 3)); - xtr_full_block (state, out, rate); - rate <- (rate `<<` (W8.of_int 3)); - outlen <- (outlen - rate); - out <- (out + rate); + out <- s_out; + outlen <- s_outlen; + rate <- s_rate; + (out, outlen) <@ xtr_full_block (state, out, outlen, rate); + s_out <- out; } + s_outlen <- outlen; state <@ __keccak_f1600_ref (state); + out <- s_out; + outlen <- s_outlen; xtr_bytes (state, out, outlen); return (); } From 9e13756ad883a9d6b7403f4a9a527faaac0735d9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jos=C3=A9=20Bacelar=20Almeida?= Date: Wed, 15 May 2019 00:39:58 +0100 Subject: [PATCH 405/525] progress --- proof/impl/keccak_1600_corr.ec | 178 ++++++++++++++------------------- proof/impl/keccak_1600_ref.ec | 2 +- 2 files changed, 78 insertions(+), 102 deletions(-) diff --git a/proof/impl/keccak_1600_corr.ec b/proof/impl/keccak_1600_corr.ec index d36bd79..7f3e875 100644 --- a/proof/impl/keccak_1600_corr.ec +++ b/proof/impl/keccak_1600_corr.ec @@ -5,10 +5,6 @@ require import Array25 EclibExtra JWordList. require import Spec1600 Keccak_1600_ref. -(* -op x86_TEST_8 : W8.t -> W8.t -> bool*bool*bool*bool*bool. -*) - op memread (m : global_mem_t) (a : address) (sz : int): W8.t list = mkseq (fun i => m.[a + i]) sz. @@ -547,15 +543,17 @@ proof. by conseq add_final_block_spec_ll (add_final_block_spec_h st in_ inlen_ trail_byte_). qed. - -lemma xtr_full_block_spec_h mem st out0: +lemma xtr_full_block_spec_h mem st out_ outlen_: hoare [ M.xtr_full_block: Glob.mem = mem /\ state = st - /\ out = out0 - /\ to_uint r64 = rate64 + /\ out = out_ + /\ outlen = outlen_ + /\ to_uint rate = rate8 ==> - Glob.mem = stores mem (to_uint out0) (xtrbytes rate8 (squeezestate st)) + Glob.mem = stores mem (to_uint out_) (xtrbytes rate8 (squeezestate st)) + /\ to_uint res.`1 = to_uint out_ + rate8 + /\ to_uint res.`2 = to_uint outlen_ - rate8 ]. proof. proc; simplify. @@ -564,33 +562,39 @@ qed. lemma xtr_full_block_spec_ll: islossless M.xtr_full_block. proof. -islossless. while true (to_uint r64-to_uint i). +islossless. while true (to_uint rate64 - to_uint i). move=> ?; wp; skip; progress. move: H; rewrite ultE => ?. rewrite to_uintD_small of_uintK modz_small // 2:/#. - by have /# := W64.to_uint_cmp r64{hr}. + by have /# := W64.to_uint_cmp rate64{hr}. by skip; progress; rewrite ultE /#. qed. -lemma xtr_full_block_spec mem st out0: +lemma xtr_full_block_spec mem st out_ outlen_: phoare [ M.xtr_full_block: Glob.mem = mem /\ state = st - /\ out = out0 - /\ to_uint r64 = rate64 + /\ out = out_ + /\ outlen = outlen_ + /\ to_uint rate = rate8 ==> - Glob.mem = stores mem (to_uint out0) (xtrbytes rate8 (squeezestate st)) + Glob.mem = stores mem (to_uint out_) (xtrbytes rate8 (squeezestate st)) + /\ to_uint res.`1 = to_uint out_ + rate8 + /\ to_uint res.`2 = to_uint outlen_ - rate8 ] = 1%r. -proof. by conseq xtr_full_block_spec_ll (xtr_full_block_spec_h mem st out0). qed. +proof. +by conseq xtr_full_block_spec_ll (xtr_full_block_spec_h mem st out_ outlen_). +qed. -lemma xtr_bytes_spec_h mem st out0 outlen0: +print M. +lemma xtr_bytes_spec_h mem st out_ outlen_: hoare [ M.xtr_bytes: Glob.mem = mem /\ state = st - /\ out = out0 - /\ outlen = outlen0 + /\ out = out_ + /\ outlen = outlen_ ==> - Glob.mem = stores mem (to_uint out0) (xtrbytes (to_uint outlen0) (squeezestate st)) ]. + Glob.mem = stores mem (to_uint out_) (xtrbytes (to_uint outlen_) (squeezestate st)) ]. proof. proc; simplify. admit. @@ -599,28 +603,28 @@ qed. lemma xtr_bytes_spec_ll: islossless M.xtr_bytes. proof. islossless. - while true (to_uint outlen). + while true (to_uint outlen - to_uint i). move=> ?; wp; skip => ?; rewrite ultE; progress. - rewrite to_uintB 2:/#. - by rewrite uleE /#. + rewrite to_uintD_small 2:/#. + move: (W64.to_uint_cmp outlen{hr}); smt(). by skip; progress; rewrite ultE /#. -while true (to_uint outlen). - move=> ?; wp; skip => ?; rewrite uleE; progress. - rewrite to_uintB 2:/#. - by rewrite uleE /#. -by skip; progress; rewrite uleE /#. +while true (to_uint outlen8 - to_uint i). + move=> ?; wp; skip => ?; rewrite ultE; progress. + rewrite to_uintD_small 2:/#. + move: (W64.to_uint_cmp outlen8{hr}); smt(). +by skip; progress; rewrite ultE /#. qed. -lemma xtr_bytes_spec mem st out0 outlen0: +lemma xtr_bytes_spec mem st out_ outlen_: phoare [ M.xtr_bytes: Glob.mem = mem /\ state = st - /\ out = out0 - /\ outlen = outlen0 + /\ out = out_ + /\ outlen = outlen_ ==> - Glob.mem = stores mem (to_uint out0) (xtrbytes (to_uint outlen0) (squeezestate st)) + Glob.mem = stores mem (to_uint out_) (xtrbytes (to_uint outlen_) (squeezestate st)) ] = 1%r. -proof. by conseq xtr_bytes_spec_ll (xtr_bytes_spec_h mem st out0 outlen0). qed. +proof. by conseq xtr_bytes_spec_ll (xtr_bytes_spec_h mem st out_ outlen_). qed. @@ -635,99 +639,71 @@ axiom permutation_instantiation mem st: ==> Glob.mem = mem /\ res = sponge_permutation st ] = 1%r. +print M. lemma spec_correct mem out_: equiv [ Spec.f ~ M.__keccak_1600 : - Glob.mem{2} = mem /\ inv_ptr in_0{2} inlen{2} out{2} outlen{2} /\ + Glob.mem{2} = mem /\ inv_ptr in_0{2} inlen{2} s_out{2} s_outlen{2} /\ m{1} = (memread mem (to_uint in_0) (to_uint inlen)){2} /\ - out{2} = out_ /\ - outlen{1} = W64.to_uint outlen{2} /\ - to_uint trail_byte{2} < 64 (* at most 6 bits... *) /\ - to_uint trail_byte{1} = to_uint trail_byte{2} /\ - to_uint r8{2} = rate8 + s_out{2} = out_ /\ + outlen{1} = W64.to_uint s_outlen{2} /\ + to_uint s_trail_byte{2} < 64 (* at most 6 bits... *) /\ + to_uint trail_byte{1} = to_uint s_trail_byte{2} /\ + to_uint rate{2} = rate8 ==> Glob.mem{2} = stores mem (W64.to_uint out_) res{1} ]. proof. -have r8_to_r64: forall (w:W64.t), - to_uint w = rate8 => to_uint(w `>>` W8.of_int 3) = rate64. - by move=> w E; rewrite shr_div_le //= E /rate8 mulKz. -have r64_to_r8: forall (w:W64.t), - to_uint w = rate64 => to_uint(w `<<` W8.of_int 3) = rate8. - move=> w E; rewrite /(`<<`)%W64 W8.of_uintK modz_small // to_uint_shl //=. - by rewrite modz_small E; smt(rate8_bnds). proc; simplify; wp. ecall {2} (xtr_bytes_spec Glob.mem{2} state{2} out{2} outlen{2}); simplify. -ecall {2} (permutation_instantiation Glob.mem{2} state{2}); simplify. -while (st{1}=state{2} /\ to_uint r8{2}=rate8 /\ to_uint rate{2}=rate8 /\ - to_uint out{2} = to_uint out_ + size result{1} /\ - outlen{1} = to_uint outlen{2} /\ good_ptr out{2} (to_uint outlen{2}) /\ +wp; ecall {2} (permutation_instantiation Glob.mem{2} state{2}); simplify. +wp; while (st{1}=state{2} /\ to_uint rate{2}=rate8 /\ + to_uint s_out{2} = to_uint out_ + size result{1} /\ + to_uint outlen{2} = to_uint s_outlen{2} /\ + outlen{1} = to_uint s_outlen{2} /\ good_ptr s_out{2} (to_uint s_outlen{2}) /\ Glob.mem{2} = stores mem (to_uint out_) result{1}). - wp; ecall {2} (xtr_full_block_spec Glob.mem{2} state{2} out{2}); simplify. + wp; ecall {2} (xtr_full_block_spec Glob.mem{2} state{2} out{2} outlen{2}); simplify. wp; ecall {2} (permutation_instantiation Glob.mem{2} state{2}); simplify. - skip; progress. - + by rewrite r8_to_r64. - + by rewrite r64_to_r8. - + rewrite to_uintD_small. - by move: H4; rewrite ultE r64_to_r8 /#. - rewrite r64_to_r8 // H1 size_cat addzA; congr. - rewrite size_xtrbytes; first smt(rate8_bnds). - by rewrite min_lel ?size_squeezestate. - + rewrite to_uintB. - by rewrite uleE r64_to_r8 // /#. - by congr; congr; rewrite r64_to_r8 //. - + rewrite to_uintD_small. - by move: H4; rewrite ultE r64_to_r8 /#. - rewrite r64_to_r8 // to_uintB. - rewrite uleE r64_to_r8 //. - by move: H4; rewrite ultE /#. - by rewrite r64_to_r8 /#. - + by rewrite H1 -stores_cat. - + rewrite ultE r64_to_r8 // to_uintB. - by rewrite uleE r64_to_r8 // /#. - by rewrite r64_to_r8 // /#. - + move: H6; rewrite ultE r64_to_r8 // to_uintB. - by rewrite uleE r64_to_r8 // /#. - by rewrite r64_to_r8 // /#. -ecall {2} (add_final_block_spec state{2} in_0{2} inlen{2} trailbyte{2}); simplify. -wp; while (st{1}=state{2} /\ to_uint r8{2} = rate8 /\ to_uint rate{2} = rate8 /\ + wp; skip; rewrite !ultE; progress. + + rewrite size_cat H6 H0 size_xtrbytes; smt(rate8_bnds). + + smt(). + + smt(). + + by rewrite H0 stores_cat. + + by rewrite !ultE /#. + + by move: H8; rewrite ultE /#. +wp; ecall {2} (add_final_block_spec state{2} in_0{2} inlen{2} trail_byte{2}); simplify. +wp; while (st{1}=state{2} /\ to_uint rate{2} = rate8 /\ m{1} = memread Glob.mem{2} (to_uint in_0{2}) (to_uint inlen{2}) /\ good_ptr in_0{2} (to_uint inlen{2}) /\ - out{2} = out_ /\ outlen{1}=to_uint outlen{2} ). + s_out{2} = out_ /\ outlen{1}=to_uint s_outlen{2} ). wp; ecall {2} (permutation_instantiation Glob.mem{2} state{2}); simplify. - wp; ecall {2} (add_full_block_spec state{2} in_0{2}); simplify. - wp; skip; progress. - + by rewrite r8_to_r64. - + congr; congr. + wp; ecall {2} (add_full_block_spec state{2} in_0{2} inlen{2} rate{2}); simplify. + wp; skip; rewrite uleE; progress. + + smt(). + + rewrite H5; congr; congr. rewrite /take_block64 /=; congr; congr. rewrite take_memread; first smt(rate8_bnds). rewrite take_memread; first smt(rate8_bnds). - congr; move: H3; rewrite uleE H0 => ?. by rewrite min_lel 1:/#. - + rewrite /take_block64 /= to_uintD_small ?H. - by move: H3; rewrite uleE /#. - move: H3; rewrite uleE H0 => ?; rewrite to_uintB ?uleE ?H //. - by rewrite drop_memread; smt(rate8_bnds). - + move: H3; rewrite uleE H0 => ?. - by rewrite to_uintB ?uleE ?H // to_uintD_small ?H /#. - + move: H3; rewrite !uleE => ?. - move: H5; rewrite /take_block64 /= size_drop; first smt(rate8_bnds). - rewrite size_memread; first smt(rate8_bnds). - by rewrite max_ler 1:/# to_uintB ?uleE /#. - + move: H3; rewrite uleE => ?. - rewrite /take_block64 /= size_drop; first smt(rate8_bnds). - rewrite size_memread; first smt(rate8_bnds). - move: H5; rewrite uleE !H to_uintB ?uleE 1:/#. - smt(). -wp; call {2} st0_spec; wp; skip; rewrite /inv_ptr; auto => |> *; progress. + + rewrite /take_block64 /= drop_memread; first smt(rate8_bnds). + rewrite H6 to_uintD_small ?H 1:/#. + by rewrite H7 to_uintB ?uleE /#. + + by rewrite H6 H7 to_uintD_small 1:/# to_uintB ?uleE /#. + + rewrite uleE H7 to_uintB ?uleE 1:/#. + move: H8; rewrite size_take_block64r size_memread'; smt(). + + move: H8; rewrite H7 uleE to_uintB ?uleE 1:/# => *. + rewrite size_take_block64r 1:/# size_memread 2:/#. + move: (W64.to_uint_cmp inlen{2}); smt(). +wp; call {2} st0_spec; wp; skip; rewrite /inv_ptr => |> *; progress. + move: H4; rewrite size_memread' uleE /max. by case: (0 < to_uint inlen{2}); smt(rate8_bnds). + move: H4; rewrite uleE H3 => ?. by rewrite size_memread; smt(rate8_bnds). ++ by move: H5; rewrite uleE /#. + congr; congr. by apply W8.word_modeqP; rewrite to_uint_truncateu8 modz_mod H2. + by rewrite ultE H6. -+ by move: H8; rewrite ultE H6. -+ by rewrite H11 -stores_cat. ++ by move: H9; rewrite ultE H6. ++ by rewrite H12 -stores_cat. qed. end section. diff --git a/proof/impl/keccak_1600_ref.ec b/proof/impl/keccak_1600_ref.ec index d11683c..a5884e8 100644 --- a/proof/impl/keccak_1600_ref.ec +++ b/proof/impl/keccak_1600_ref.ec @@ -430,9 +430,9 @@ module M = { outlen <- s_outlen; rate <- s_rate; (out, outlen) <@ xtr_full_block (state, out, outlen, rate); + s_outlen <- outlen; s_out <- out; } - s_outlen <- outlen; state <@ __keccak_f1600_ref (state); out <- s_out; outlen <- s_outlen; From c3bf5d8f95e607bd9d1e372cb9a7f2ed688d4039 Mon Sep 17 00:00:00 2001 From: Manuel Barbosa Date: Wed, 15 May 2019 02:39:15 +0100 Subject: [PATCH 406/525] avx2 equivalence --- proof/impl/libc/keccak_1600_avx2_modular.ec | 159 +++++++++++++++---- proof/impl/perm/keccak_f1600_avx2.ec | 49 ++++-- proof/impl/perm/keccak_f1600_avx2_prevec.ec | 16 +- proof/impl/perm/keccak_f1600_scalar_table.ec | 3 - 4 files changed, 166 insertions(+), 61 deletions(-) diff --git a/proof/impl/libc/keccak_1600_avx2_modular.ec b/proof/impl/libc/keccak_1600_avx2_modular.ec index 1dcced7..370bd63 100644 --- a/proof/impl/libc/keccak_1600_avx2_modular.ec +++ b/proof/impl/libc/keccak_1600_avx2_modular.ec @@ -332,15 +332,6 @@ qed. require Keccak_1600_ref_modular. -op equiv_statesp (state: W256.t Array7.t, st : W64.t Array25.t) : bool = - state.[0] \bits64 3 = st.[index 0 0] /\ state.[0] \bits64 2 = st.[index 0 0] /\ state.[0] \bits64 1 = st.[index 0 0] /\ state.[0] \bits64 0 = st.[index 0 0] /\ - state.[1] \bits64 3 = st.[index 0 4] /\ state.[1] \bits64 2 = st.[index 0 3] /\ state.[1] \bits64 1 = st.[index 0 2] /\ state.[1] \bits64 0 = st.[index 0 1] /\ - state.[2] \bits64 3 = st.[index 3 0] /\ state.[2] \bits64 2 = st.[index 1 0] /\ state.[2] \bits64 1 = st.[index 4 0] /\ state.[2] \bits64 0 = st.[index 2 0] /\ - state.[3] \bits64 3 = st.[index 2 4] /\ state.[3] \bits64 2 = st.[index 4 3] /\ state.[3] \bits64 1 = st.[index 1 2] /\ state.[3] \bits64 0 = st.[index 3 1] /\ - state.[4] \bits64 3 = st.[index 3 4] /\ state.[4] \bits64 2 = st.[index 1 3] /\ state.[4] \bits64 1 = st.[index 4 2] /\ state.[4] \bits64 0 = st.[index 2 1] /\ - state.[5] \bits64 3 = st.[index 1 4] /\ state.[5] \bits64 2 = st.[index 2 3] /\ state.[5] \bits64 1 = st.[index 3 2] /\ state.[5] \bits64 0 = st.[index 4 1] /\ - state.[6] \bits64 3 = st.[index 4 4] /\ state.[6] \bits64 2 = st.[index 3 3] /\ state.[6] \bits64 1 = st.[index 2 2] /\ state.[6] \bits64 0 = st.[index 1 1]. - lemma set_get_eq (v : W64.t Array28.t) (w : W256.t) i j : 0 <= i < 7 => WArray224.get64 @@ -351,30 +342,65 @@ lemma set_get_diff (v : W64.t Array28.t) (w : W256.t) i j : WArray224.get64 (WArray224.set256 (WArray224.init64 ("_.[_]" v)) i w) j = v.[j] by admit. +(* some precondition on st holding 0 is needed and must be preserved; also something on jagged *) +equiv add_full_block_corr st : + Keccak_1600_ref_modular.Mmod.add_full_block ~ Mmod.add_full_block : + ={Glob.mem} /\ em_states state{2} state{1} /\ ={in_0,inlen,rate} /\ s_state{2} = st + ==> + ={Glob.mem} /\ em_states res{2}.`1 res{1}.`1 /\ + res{1}.`2 = res{2}.`3 /\ res{1}.`3 = res{2}.`4. +admitted. -equiv plugin : - Keccak_1600_ref_modular.Mmod.__keccak_f1600_ref ~ Mmod.__keccak_f1600_avx2 : - ={Glob.mem} /\ equiv_statesp arg{2}.`1 arg{1} ==> equiv_statesp res{2} res{1}. -(* there in perm *) -admit. -qed. +(* some precondition on st holding 0 is needed and must be preserved; also something on jagged *) +equiv add_final_block_corr st : + Keccak_1600_ref_modular.Mmod.add_final_block ~ Mmod.add_final_block : + ={Glob.mem} /\ em_states state{2} state{1} /\ ={in_0,inlen} /\ s_state{2} = st + ==> + ={Glob.mem} /\ em_states res{2} res{1}. +admitted. + +(* some precondition on jagged needed *) +equiv extr_full_block_corr _outlen _rate _out _iotas rl rr : + Keccak_1600_ref_modular.Mmod.xtr_full_block ~ Mmod.xtr_full_block : + good_iotas Glob.mem{2} _iotas /\ + good_rhol Glob.mem{2} rl /\ good_rhor Glob.mem{2} rr /\ + rate{1} = _rate /\ outlen{1} = _outlen /\ out{1} = _out /\ + em_states state{2} state{1} /\ ={Glob.mem,out} /\ rate{1} = len{2} ==> + good_iotas Glob.mem{2} _iotas /\ + good_rhol Glob.mem{2} rl /\ good_rhor Glob.mem{2} rr /\ + res{1}.`1 = _out + _rate /\ res{1}.`2 = _outlen - _rate /\ ={Glob.mem} /\ res{1}.`1 = res{2}. +admitted. + +(* some precondition on jagged needed *) +equiv extr_bytes_corr : + Keccak_1600_ref_modular.Mmod.xtr_bytes ~ Mmod.xtr_bytes : + em_states state{2} state{1} /\ ={Glob.mem,out} /\ outlen{1} = len{2} ==> + ={Glob.mem}. +admitted. equiv modcorrect mem : Keccak_1600_ref_modular.Mmod.__keccak_1600 ~ Mmod.__keccak_1600 : Glob.mem{2} = mem /\ good_iotas mem (to_uint iotas{2}) /\ in_0{1} = in_0{2} /\ inlen{1} = inlen{2} /\ s_out{1} = out{2} /\ s_outlen{1} = outlen{2} /\ rate{1} = rate{2} /\ good_rhol mem (to_uint rhotates_left{2}) /\ good_rhor mem (to_uint rhotates_right{2}) /\ - ={Glob.mem} ==> true. + ={Glob.mem} ==> ={Glob.mem}. proc. -seq 2 2 : (#pre /\ equiv_statesp state{2} state{1}). +seq 2 2 : (#pre /\ em_states state{2} state{1}). inline *. unroll for {1} 4. unroll for {2} 5. wp;skip;auto => />. -by move => *; rewrite /x86_VPBROADCAST_4u64 bits64E => //=. +move => *; rewrite /x86_VPBROADCAST_4u64 /is4u6 /is4u64; progress. +by rewrite /a00 /array_build; auto => />. +by rewrite /a01 /array_build; auto => />. +by rewrite /a20 /array_build; auto => />. +by rewrite /a31 /array_build; auto => />. +by rewrite /a21 /array_build; auto => />. +by rewrite /a41 /array_build; auto => />. +by rewrite /a11 /array_build; auto => />. inline Mmod.absorb. swap {2} [6..7] -5. -seq 0 3 : (#pre /\ in_00{2} = in_0{1} /\ inlen0{2} = inlen{1} /\ equiv_statesp state0{2} state{1}); first by auto => />. +seq 0 3 : (#pre /\ in_00{2} = in_0{1} /\ inlen0{2} = inlen{1} /\ em_states state0{2} state{1}); first by auto => />. sp 0 6 . seq 0 2 : (#pre /\ forall i, 0 <= i < 7 => s_state{2}.[i] = W64.zero). @@ -441,19 +467,94 @@ by rewrite /x86_VPBROADCAST_4u64 bits64E => //=. by auto => />; smt(). -seq 1 1 : #{/~state{2}}pre. +seq 1 1 : #{/~em_states state{2} state{1}}{~in_0{1} = in_0{2}}{~inlen{1} = inlen{2}}{~s_state{2}}pre. -while (#{/~rate0{2}}{~state{2}}pre /\ rate0{2} = rate{1}). +while (#post). wp. -call (plugin). +seq 1 1 : #{/~rate{1} \ule inlen{1}}{~rate0{2} \ule inlen0{2}}pre. +exists* s_state{2}. +elim* => sst. +call (add_full_block_corr sst). +skip;progress. smt(). smt(). +exists* state{1}. +elim* => st. +exists* iotas0{2}. +elim * => _iotas. +exists* Glob.mem{2}. +elim * => memm. +call (avx2corr st _iotas memm). +by auto => />. +by auto => />. +seq 3 2 : (#{/~em_states state0{2} state{1}}pre /\ + em_states state{2} state{1}). +exists* s_state{2}. +elim* => sst. +wp;call (add_final_block_corr sst). +by auto => />. +inline Mmod.squeeze. +swap {2} [2..5] -1. +swap {2} 8 -7. +sp 0 5. + +seq 1 3 : (#{/~em_states state{2} state{1}}{~Glob.mem{2} = mem} + {~s_out{1}=out{2}}{~s_outlen{1} = outlen{2}}pre /\ + out0{2} = s_out{1} /\ outlen0{2} = outlen{1} /\ + em_states state1{2} state{1}/\ + good_iotas Glob.mem{2} (to_uint iotas{2}) /\ + good_rhol Glob.mem{2} (to_uint rhotates_left{2}) /\ + good_rhor Glob.mem{2} (to_uint rhotates_right{2})); + first by auto => />. + +seq 1 1 : #pre. + +while #pre. + +swap {1} 4 2. +seq 5 1 : #pre. wp. -inline *. +exists* state{1}. +elim* => st. +exists* iotas1{2}. +elim * => _iotas. +exists* Glob.mem{2}. +elim * => memm. +call (avx2corr st _iotas memm). +by auto => />. + wp. -admit. (* ouch! *) +exists* outlen{1}. +elim* => _outlen. +exists* s_out{1}. +elim* => _out. +exists* rate1{2}. +elim* => _rate. +exists* (to_uint rhotates_left{2}). +elim* => _rl. +exists* (to_uint rhotates_right{2}). +elim* => _rr. +exists* (to_uint iotas1{2}). +elim* => _iotas. +call (extr_full_block_corr _outlen _rate _out _iotas _rl _rr). +auto => />. +progress. +smt(). +smt(). +smt(). +by auto => />. + +swap {1} 3 1. +seq 3 1 : #pre. + wp. +exists* state{1}. +elim* => st. +exists* iotas{2}. +elim * => _iotas. +exists* Glob.mem{2}. +elim * => memm. +call (avx2corr st _iotas memm). +by auto => />. + +call (extr_bytes_corr). by auto => />. -seq 3 2 : (#{/~state0{2}}pre /\ equiv_statesp state0{2} state{1}). -inline *. -admit. (* ouch! *) -inline Mmod.squeeze. -admit. qed. + diff --git a/proof/impl/perm/keccak_f1600_avx2.ec b/proof/impl/perm/keccak_f1600_avx2.ec index a1b2d5e..2adc259 100644 --- a/proof/impl/perm/keccak_f1600_avx2.ec +++ b/proof/impl/perm/keccak_f1600_avx2.ec @@ -822,27 +822,48 @@ require import Array4 Array25. require Keccak_f1600_ref_op. require Keccak_f1600_ref. require Keccak_f1600_ref_table. -require Keccak_f1600_avx2_prevec. +require import Keccak_f1600_avx2_prevec. require Keccak_f1600_avx2_prevec_vops. -lemma avx2corr (_a00 _a01 _a20 _a31 _a21 _a41 _a11 : W64.t Array4.t) - (st : W64.t Array25.t) _iotas mem : +print Keccak_f1600_avx2_prevec_vops.match_states. +require import Ops. +print is4u64. + +op array_build (a b c d : W64.t) = + (witness + .[0 <- a] + .[1 <- b] + .[2 <- c] + .[3 <- d])%Array4. + +op a00(st : W64.t Array25.t) = array_build st.[index 0 0] st.[index 0 0] st.[index 0 0] st.[index 0 0]. +op a01(st : W64.t Array25.t) = array_build st.[index 0 4] st.[index 0 3] st.[index 0 2] st.[index 0 1]. +op a20(st : W64.t Array25.t) = array_build st.[index 3 0] st.[index 1 0] st.[index 4 0] st.[index 2 0]. +op a31(st : W64.t Array25.t) = array_build st.[index 2 4] st.[index 4 3] st.[index 1 2] st.[index 3 1]. +op a21(st : W64.t Array25.t) = array_build st.[index 3 4] st.[index 1 3] st.[index 4 2] st.[index 2 1]. +op a41(st : W64.t Array25.t) = array_build st.[index 1 4] st.[index 2 3] st.[index 3 2] st.[index 4 1]. +op a11(st : W64.t Array25.t) = array_build st.[index 4 4] st.[index 3 3] st.[index 2 2] st.[index 1 1]. + +op em_states (state : W256.t Array7.t, st : W64.t Array25.t) : bool = + is4u64 (a00 st) state.[0] /\ + is4u64 (a01 st) state.[1] /\ + is4u64 (a20 st) state.[2] /\ + is4u64 (a31 st) state.[3] /\ + is4u64 (a21 st) state.[4] /\ + is4u64 (a41 st) state.[5] /\ + is4u64 (a11 st) state.[6]. + +lemma avx2corr st _iotas mem : equiv [ Keccak_f1600_ref.M.__keccak_f1600_ref ~ M.__keccak_f1600_avx2 : Glob.mem{2} = mem /\ Keccak_f1600_avx2_prevec.good_iotas mem (W64.to_uint _iotas{2}) /\ - Keccak_f1600_avx2_prevec.good_rhol mem (to_uint _rhotates_left{2}) /\ - Keccak_f1600_avx2_prevec.good_rhor mem (to_uint _rhotates_right{2}) /\ - Keccak_f1600_avx2_prevec.equiv_states _a00 _a01 _a20 _a31 _a21 _a41 _a11 st /\ - Keccak_f1600_avx2_prevec_vops.match_states (_a00,_a01,_a20,_a31,_a21,_a41,_a11) - (state{2}.[0],state{2}.[1],state{2}.[2],state{2}.[3],state{2}.[4],state{2}.[5],state{2}.[6]) - /\ state{1} = st ==> Glob.mem{2} = mem /\ - exists (__a00 __a01 __a20 __a31 __a21 __a41 __a11 : W64.t Array4.t) , - Keccak_f1600_avx2_prevec.equiv_states __a00 __a01 __a20 __a31 __a21 __a41 __a11 st /\ - Keccak_f1600_avx2_prevec_vops.match_states (_a00,_a01,_a20,_a31,_a21,_a41,_a11) - (res{2}.[0],res{2}.[1],res{2}.[2],res{2}.[3],res{2}.[4],res{2}.[5],res{2}.[6])]. + good_rhol mem (to_uint _rhotates_left{2}) /\ + good_rhor mem (to_uint _rhotates_right{2}) /\ + em_states state{2} state{1} /\ st = state{1} ==> + Glob.mem{2} = mem /\ em_states res{2} res{1} ]. move : Keccak_f1600_ref_op.ref_refop => *. move : Keccak_f1600_ref_table.ref_reftable => *. move : (Keccak_f1600_avx2_prevec.correct_perm - _a00 _a01 _a20 _a31 _a21 _a41 _a11 st mem) => *. + (a00 st) (a01 st) (a20 st) (a31 st) (a21 st) (a41 st) (a11 st) st mem) => *. move : Keccak_f1600_avx2_prevec_vops.prevec_vops_prevec => *. move : Keccak_f1600_avx2_prevec_vops.prevec_vops_openssl => *. move : avx2_avx2_openssl => *. diff --git a/proof/impl/perm/keccak_f1600_avx2_prevec.ec b/proof/impl/perm/keccak_f1600_avx2_prevec.ec index eb20455..e413040 100644 --- a/proof/impl/perm/keccak_f1600_avx2_prevec.ec +++ b/proof/impl/perm/keccak_f1600_avx2_prevec.ec @@ -511,10 +511,6 @@ lemma loadlift_rhor : forall (mem : global_mem_t) (x : W64.t) (off : int), .[3 <- W64.of_int good_rhotates_right.[4*off + 3]])%Array4. (* This proof sketch is just to make sure things make sense *) (* Help needed to prove this in a concise way *) -admit. -qed. - -(* move => mem x off. rewrite /good_rhor /loadW256 /lift2array /good_rhotates_right => />. move => *. @@ -655,7 +651,7 @@ have HHH : (to_uint x + 32 < W64.modulus). admit. (* safety *) smt(@W64). smt(). smt(). smt(). admit. (* need to keep going *) -qed. *) +qed. (* these are the same as above *) lemma loadlift_rhol : forall (mem : global_mem_t) (x : W64.t) (off : int), @@ -722,8 +718,6 @@ lemma lift_roln mem rl rr o1 o2 x: (to_uint (rl + W64.of_int 96 + W64.of_int (8 * 4 * o1 - 96))))).[o2]))%W64 = (x86_ROL_64 x ((of_int (rhotates (conversion o1 o2))))%W8).`3. proof. -admit. (* admit free slow proof below *) -(* move => *. rewrite (loadlift_rhol mem (rl) o1). smt(). smt(). rewrite (loadlift_rhor mem (rr) o1). smt(). smt(). @@ -771,7 +765,6 @@ case (o2 = 2). auto => />. smt(roln). case (o2 = 3). auto => />. smt(roln). smt(). smt(). -*) qed. lemma correct_perm _a00 _a01 _a20 _a31 _a21 _a41 _a11 st mem: @@ -783,8 +776,6 @@ lemma correct_perm _a00 _a01 _a20 _a31 _a21 _a41 _a11 st mem: a21{2} = _a21 /\ a41{2} = _a41 /\ a11{2} = _a11 /\ state{1} = st ==> Glob.mem{2} = mem /\ equiv_states res{2}.`1 res{2}.`2 res{2}.`3 res{2}.`4 res{2}.`5 res{2}.`6 res{2}.`7 res{1}]. -admit. (* slow admit free proof below *) -(* proc. unroll {1} 3. rcondt {1} 3; first by move => *; inline *; auto => />. @@ -1334,8 +1325,6 @@ move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 4 2 a41{2}.[ rewrite /conversion. smt(). smt(). smt(). -smt(). - (* Chi *) inline Mreftable.chi. @@ -1385,8 +1374,6 @@ split; first by smt(@W64). split; first by smt(@W64). smt(@W64). -smt(). - (* iota *) @@ -1529,7 +1516,6 @@ move : H7. rewrite dec0. rewrite to_uintD. smt(@W32). rewrite dec. rewrite to_uintD. smt(@W32). rewrite to_uintD. smt(@W32). -*) qed. diff --git a/proof/impl/perm/keccak_f1600_scalar_table.ec b/proof/impl/perm/keccak_f1600_scalar_table.ec index 8fd0928..1552aef 100644 --- a/proof/impl/perm/keccak_f1600_scalar_table.ec +++ b/proof/impl/perm/keccak_f1600_scalar_table.ec @@ -277,8 +277,6 @@ lemma scalarcorr _iotas mem : mem = Glob.mem{2} /\ to_uint iotas{2} = _iotas /\ state{1} = _A{2} ==> mem = Glob.mem{2} /\ to_uint res{2}.`2 = _iotas /\ res{1} = res{2}.`1 ]. -admitted. (* just to compile fast, it is OK and admit-free *) -(* proc. seq 2 1 : (#pre /\ constants{1} = iotas); first by inline *;auto => />. @@ -673,7 +671,6 @@ rewrite (_ : iotas_R = W64.of_int (to_uint iotas{2} - round{1} * 8 + 24*8)). smt(@W64). smt(@W64 @W8). qed. -*) require Keccak_f1600_ref_op. require Keccak_f1600_ref. From 23960f314a9cdda94d2568d09852584d740a302e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jos=C3=A9=20Bacelar=20Almeida?= Date: Wed, 15 May 2019 02:39:54 +0100 Subject: [PATCH 407/525] progress --- proof/impl/keccak_1600_corr.ec | 93 +++++++++++++++++++++++++--------- 1 file changed, 68 insertions(+), 25 deletions(-) diff --git a/proof/impl/keccak_1600_corr.ec b/proof/impl/keccak_1600_corr.ec index 7f3e875..d7c3320 100644 --- a/proof/impl/keccak_1600_corr.ec +++ b/proof/impl/keccak_1600_corr.ec @@ -248,47 +248,89 @@ lemma loadW64_w8L2w64L mem in_ inlen i: = nth W64.zero (w8L2w64L (memread mem in_ inlen)) i. admitted. -lemma loadW64_take_block64 mem in_ i: - 0 <= i < rate64 => - loadW64 mem (in_ + 8 * i) = - nth W64.zero (take_block64 (memread mem in_ rate8)).`1 i. +lemma loadW8_memread mem in_ inlen i: + 0 <= i < inlen => + loadW8 mem (in_ + i)%Int + = nth W8.zero (memread mem in_ inlen) i. proof. -rewrite /loadW64 /take_block64 /= => Hi. -rewrite take_oversize ?size_memread 1..2:/#. -admit. +rewrite /loadW8 /memread => Hi. +by rewrite nth_mkseq. +qed. + +lemma loadW8_memread' mem in_ off inlen i: + off <= i < off + inlen => + loadW8 mem (in_ + i)%Int + = nth W8.zero (memread mem (in_ + off) inlen) (i-off). +proof. +rewrite /loadW8 /memread => Hi. +by rewrite nth_mkseq /#. +qed. + +lemma size_w8L2w64L' l: + size (w8L2w64L l) = (8 * size l - 1) %/ 64 + 1. (*? (size l - 1) %/ 8 + 1 ?*) +proof. +by rewrite size_bits2w64L size_w8L2bits. qed. lemma size_w8L2w64L l: 8 %| size l => size (w8L2w64L l) = size l %/ 8. proof. -admit. +rewrite size_w8L2w64L' dvdz_eq => E. +by rewrite -{1}E mulzC mulzA /= divzMDl. qed. -lemma size_w64L2w8L l: - size (w64L2w8L l) = 8 * size l. +lemma chunkfill_nil ['a] (d:'a) n: + chunkfill d n [] = []. +proof. by rewrite /chunkfill /chunkfillsize. qed. + +lemma bits2w64L_nil: bits2w64L [] = []. proof. -admit. +rewrite /bits2w64L chunkfill_nil. +by rewrite /BitEncoding.BitChunking.chunk /= mkseq0. qed. +lemma w8L2w64L_nil: w8L2w64L [] = []. +proof. by rewrite w8L2bits_nil bits2w64L_nil. qed. + lemma take_w8L2w64L n l: take n (w8L2w64L l) = w8L2w64L (take (8*n) l). proof. elim/natind: n l => //=. - admit. + by move=> n Hn l; rewrite !take_le0 // 1:/# w8L2w64L_nil. move=> n Hn IH l. -case: (n < size (w8L2w64L l)) => E. +case: (8*n < size l) => E. + have Hsz: n < size (w8L2w64L l). + rewrite size_w8L2w64L'; smt. rewrite (take_nth W64.zero) 1:/# IH -cats1 mulzDr /=. have ->: take (8*n + 8) l = take (8*n) l ++ take 8 (drop (8*n) l). - admit. + rewrite -{1}(cat_take_drop (8*n) l) take_cat. + rewrite size_take 1:/# E /=. + rewrite (: ! 8 * n + 8 < 8 * n) 1:/# /=; congr. + rewrite (: 8 * n + 8 - 8 * n = 8); first by ring. + done. have ->: w8L2w64L (take (8 * n) l ++ take 8 (drop (8 * n) l)) = w8L2w64L (take (8 * n) l) ++ w8L2w64L (take 8 (drop (8 * n) l)). + search bits2w64L. admit. congr. admit. -rewrite take_oversize 1:/#. -move: E; rewrite size_w8L2w64L. admit (*???*). smt. +rewrite take_oversize. + rewrite size_w8L2w64L'; smt. +rewrite take_oversize; smt. +qed. + + +lemma loadW64_take_block64 mem in_ i: + 0 <= i < rate64 => + loadW64 mem (in_ + 8 * i) = + nth W64.zero (take_block64 (memread mem in_ rate8)).`1 i. +proof. +rewrite /loadW64 /take_block64 /= => Hi. +rewrite take_oversize ?size_memread 1..2:/#. +admit. qed. + lemma add_full_block_spec_h st in_ inlen_ r8_: hoare [ M.add_full_block: state = st @@ -448,12 +490,12 @@ seq 2: (#[/1,4:-1]pre /\ congr. rewrite size_take 1:/# size_memread 1:/#. rewrite (: to_uint i{hr} %% 8 < to_uint inlen{hr} %% 8) /=. smt. - smt. - admit (* -loadW8 Glob.mem{hr} (to_uint (in_0{hr} + i{hr})) = -(memread Glob.mem{hr} (to_uint in_0{hr} + to_uint inlen{hr} %/ 8 * 8) - (to_uint inlen{hr} %% 8)).[to_uint i{hr} %% 8] -*). + smt. + rewrite (modzE (to_uint i{hr}) 8). + rewrite (: to_uint i{hr} %/ 8 * 8 = to_uint inlen{hr} %/ 8 * 8). smt. + rewrite -loadW8_memread'. smt. + congr; rewrite to_uintD_small. smt. + done. wp; skip => ?[?]; progress. + rewrite to_uint_shl of_uintK (modz_small 3) //= modz_small. smt. smt. @@ -462,14 +504,15 @@ loadW8 Glob.mem{hr} (to_uint (in_0{hr} + i{hr})) = rewrite (modz_small (_*_)%Int). smt. rewrite (: to_uint i{hr} * 8 %% 8 = 0). smt. rewrite take0 H addstate_get. smt. - have ->/=: W8u8.pack8 [] = W64.zero. admit. + have ->/=: W8u8.pack8 [] = W64.zero. + by apply W64.all_eq_eq; rewrite /all_eq. pose X:= nth _ _ _. have ->/=: X = W64.zero. - rewrite /X nth_out // size_w8L2w64L. admit. smt. + rewrite /X nth_out // size_w8L2w64L'. smt. have <-:= addstate_get' st (w8L2w64L (take (to_uint inlen{hr} %/ 8 * 8) (memread Glob.mem{hr} (to_uint in_0{hr}) (to_uint inlen{hr})))). - rewrite size_w8L2w64L. admit. admit. + rewrite size_w8L2w64L'. smt. by rewrite Array25.set_notmod. + smt. + have E: to_uint i0 = to_uint inlen{hr}. smt. From 34ea1d0f3e47bf97a9dbcbbc7cbf0a53db85630e Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Wed, 15 May 2019 06:13:36 +0200 Subject: [PATCH 408/525] complete some proofs --- proof/impl/perm/keccak_f1600_avx2_prevec.ec | 238 ++++++++------------ 1 file changed, 92 insertions(+), 146 deletions(-) diff --git a/proof/impl/perm/keccak_f1600_avx2_prevec.ec b/proof/impl/perm/keccak_f1600_avx2_prevec.ec index e413040..8c173cf 100644 --- a/proof/impl/perm/keccak_f1600_avx2_prevec.ec +++ b/proof/impl/perm/keccak_f1600_avx2_prevec.ec @@ -1,4 +1,4 @@ -require import List Int IntExtra IntDiv CoreMap. +require import AllCore List Int IntExtra IntDiv CoreMap. from Jasmin require import JModel. require import Array4 Array9 Array24 Array25 Array96. @@ -500,7 +500,38 @@ op good_rhor (mem : global_mem_t, _rhotates_right : int) = forall off, 0 <= off < 24 => loadW64 mem ( _rhotates_right + (off * 8)) = W64.of_int good_rhotates_right.[off]. +(* TODO: move this in JMemory *) +lemma loadW256_bits64 m p i : 0 <= i < 4 => + loadW256 m p \bits64 i = loadW64 m (p + i * 8). +proof. + move=> hi; rewrite /loadW256 /loadW64. + apply W64.wordP => j hj. + rewrite bits64iE // pack8wE // initiE; 1:by apply divz_cmp. + rewrite pack32wE; 1:by apply W4u64.in_bound. + rewrite initiE /=; 1:by apply divz_cmp => //=;apply W4u64.in_bound. + have -> : i * 64 = (i * 8) * 8 by ring. + by rewrite modzMDl divzMDl // -addzA. +qed. + +lemma load4u64 mem p : + pack4 + [loadW64 mem p; + loadW64 mem (p + 8); + loadW64 mem (p + 16); + loadW64 mem (p + 24)] = + loadW256 mem p. +proof. + have -> : W4u64.Pack.of_list + [loadW64 mem p; loadW64 mem (p + 8); + loadW64 mem (p + 16); loadW64 mem (p + 24)] = + W4u64.Pack.init (fun i => loadW64 mem (p + i * 8)). + + by apply W4u64.Pack.all_eqP; rewrite /all_eq. + apply (can_inj _ _ W4u64.unpack64K); apply W4u64.Pack.packP => i hi. + by rewrite pack4K initiE //= get_unpack64 // loadW256_bits64. +qed. + lemma loadlift_rhor : forall (mem : global_mem_t) (x : W64.t) (off : int), + to_uint x + 192 < W64.modulus => good_rhor mem (to_uint x) => 0 <= off < 6 => lift2array (loadW256 mem (to_uint (x + W64.of_int (8 * 4 * off)))) = @@ -509,152 +540,21 @@ lemma loadlift_rhor : forall (mem : global_mem_t) (x : W64.t) (off : int), .[1 <- W64.of_int good_rhotates_right.[4*off + 1]] .[2 <- W64.of_int good_rhotates_right.[4*off + 2]] .[3 <- W64.of_int good_rhotates_right.[4*off + 3]])%Array4. -(* This proof sketch is just to make sure things make sense *) -(* Help needed to prove this in a concise way *) -move => mem x off. -rewrite /good_rhor /loadW256 /lift2array /good_rhotates_right => />. -move => *. -apply Array4.ext_eq. -move => *. - -case (off = 0). -auto => />. -case (x0 = 0). -move => x00. -rewrite x00 => />. -move : (H 0); rewrite /loadW64 => /> *. -rewrite -H3. -rewrite !pack8E W8u8.Pack.of_listE. -apply W64.init_ext. -move => *. -beta. -apply W8.wordP. -apply W8u8.Pack.packP. -apply W8u8.Pack.init_ext. -move => />. -smt(). smt(). smt(). -move => *. -case (x0 = 1). -move => x00. -rewrite x00 => />. -move : (H 1); rewrite /loadW64 => /> *. -rewrite -H4. -rewrite !pack8E W8u8.Pack.of_listE. -apply W64.init_ext. -move => *. -beta. -apply W8.wordP. -apply W8u8.Pack.packP. -apply W8u8.Pack.init_ext. -move => />. -smt(). smt(). smt(). -move => *. -case (x0 = 2). -move => x00. -rewrite x00 => />. -move : (H 2); rewrite /loadW64 => /> *. -rewrite -H5. -rewrite !pack8E W8u8.Pack.of_listE. -apply W64.init_ext. -move => *. -beta. -apply W8.wordP. -apply W8u8.Pack.packP. -apply W8u8.Pack.init_ext. -move => />. -smt(). smt(). smt(). -move => *. -case (x0 = 3). -move => x00. -rewrite x00 => />. -move : (H 3); rewrite /loadW64 => /> *. -rewrite -H6. -rewrite !pack8E W8u8.Pack.of_listE. -apply W64.init_ext. -move => *. -beta. -apply W8.wordP. -apply W8u8.Pack.packP. -apply W8u8.Pack.init_ext. -move => />. -smt(). smt(). smt(). -smt(). - -move => *. +proof. + move=> mem x off /= hx hgood hoff. + rewrite -load4u64 /lift2array; apply Array4.tP => i hi. + rewrite Array4.initiE 1:// /= W4u64.pack4bE 1:// W4u64.Pack.get_of_list 1://. + have h32: to_uint (W64.of_int (32 * off)) = 32 * off. + + by rewrite W64.to_uint_small /= /#. + have -> : to_uint (x + W64.of_int (32 * off)) = to_uint x + 32 * off. + + by rewrite W64.to_uintD_small h32 // /#. + smt (Array4.get_setE). +qed. -case (off = 1). -auto => />. -case (x0 = 0). -move => x00. -rewrite x00. -auto => /> //=. -move : (H 4); rewrite /loadW64 => /> *. -rewrite -H4. -rewrite !pack8E W8u8.Pack.of_listE. -apply W64.init_ext. -move => *. -beta. -apply W8.wordP. -apply W8u8.Pack.packP. -apply W8u8.Pack.init_ext. -move => />. -move => *. -have HHH : (to_uint x + 32 < W64.modulus). admit. (* safety *) -smt(@W64). smt(). smt(). -move => *. -case (x0 = 1). -move => x00. -rewrite x00 => />. -move : (H 5); rewrite /loadW64 => /> *. -rewrite -H5. -rewrite !pack8E W8u8.Pack.of_listE. -apply W64.init_ext. -move => *. -beta. -apply W8.wordP. -apply W8u8.Pack.packP. -apply W8u8.Pack.init_ext. -move => />. -have HHH : (to_uint x + 32 < W64.modulus). admit. (* safety *) -smt(@W64). smt(). smt(). -move => *. -case (x0 = 2). -move => x00. -rewrite x00 => />. -move : (H 6); rewrite /loadW64 => /> *. -rewrite -H6. -rewrite !pack8E W8u8.Pack.of_listE. -apply W64.init_ext. -move => *. -beta. -apply W8.wordP. -apply W8u8.Pack.packP. -apply W8u8.Pack.init_ext. -move => />. -have HHH : (to_uint x + 32 < W64.modulus). admit. (* safety *) -smt(@W64). smt(). smt(). -move => *. -case (x0 = 3). -move => x00. -rewrite x00 => />. -move : (H 7); rewrite /loadW64 => /> *. -rewrite -H7. -rewrite !pack8E W8u8.Pack.of_listE. -apply W64.init_ext. -move => *. -beta. -apply W8.wordP. -apply W8u8.Pack.packP. -apply W8u8.Pack.init_ext. -move => />. -have HHH : (to_uint x + 32 < W64.modulus). admit. (* safety *) -smt(@W64). smt(). smt(). -smt(). -admit. (* need to keep going *) -qed. (* these are the same as above *) lemma loadlift_rhol : forall (mem : global_mem_t) (x : W64.t) (off : int), + to_uint x + 192 < W64.modulus => good_rhol mem (to_uint x) => 0 <= off < 6 => lift2array (loadW256 mem (to_uint (x + W64.of_int (8 * 4 * off)))) = @@ -662,17 +562,63 @@ lemma loadlift_rhol : forall (mem : global_mem_t) (x : W64.t) (off : int), .[0 <- W64.of_int good_rhotates_left.[4*off + 0]] .[1 <- W64.of_int good_rhotates_left.[4*off + 1]] .[2 <- W64.of_int good_rhotates_left.[4*off + 2]] - .[3 <- W64.of_int good_rhotates_left.[4*off + 3]])%Array4 by admit. + .[3 <- W64.of_int good_rhotates_left.[4*off + 3]])%Array4. +proof. + move=> mem x off /= hx hgood hoff. + rewrite -load4u64 /lift2array; apply Array4.tP => i hi. + rewrite Array4.initiE 1:// /= W4u64.pack4bE 1:// W4u64.Pack.get_of_list 1://. + have h32: to_uint (W64.of_int (32 * off)) = 32 * off. + + by rewrite W64.to_uint_small /= /#. + have -> : to_uint (x + W64.of_int (32 * off)) = to_uint x + 32 * off. + + by rewrite W64.to_uintD_small h32 // /#. + smt (Array4.get_setE). +qed. +(* +lemma good_iotas4x_iotas off i : + 0 <= off < 6 => + 0 <= i < 4 => + good_iotas4x.[4 * off + i] = iotas.[4 * off + i]. +proof. + rewrite /good_iotas4x /iotas. +*) +(* This lemma if false: + it should be eather + iotas.[4 * off + 0] + iotas.[4 * off + 1] + iotas.[4 * off + 2] + iotas.[4 * off + 3] + of + good_iotas4x.[16*off + 0] + good_iotas4x.[16*off + 4] + good_iotas4x.[16*off + 8] + good_iotas4x.[16*off + 12] + *) lemma loadlift_iotas : forall (mem : global_mem_t) (x : W64.t) (off : int), - good_iotas mem (to_uint x) => 0 <= off < 24 => + to_uint x + 768 < W64.modulus => + good_iotas mem (to_uint x) => 0 <= off < 6 => lift2array (loadW256 mem (to_uint (x + W64.of_int (8 * 4 * off)))) = (witness .[0 <- good_iotas4x.[4*off + 0]] .[1 <- good_iotas4x.[4*off + 1]] .[2 <- good_iotas4x.[4*off + 2]] - .[3 <- good_iotas4x.[4*off + 3]])%Array4 by admit. + .[3 <- good_iotas4x.[4*off + 3]])%Array4. +proof. + move=> mem x off /= hx hgood hoff. + rewrite -load4u64 /lift2array; apply Array4.tP => i hi. + rewrite Array4.initiE 1:// /= W4u64.pack4bE 1:// W4u64.Pack.get_of_list 1://. + have h32: to_uint (W64.of_int (32 * off)) = 32 * off. + + by rewrite W64.to_uint_small /= /#. + have -> : to_uint (x + W64.of_int (32 * off)) = to_uint x + 32 * off. + + by rewrite W64.to_uintD_small h32 // /#. + have -> : to_uint x + 32 * off + 24 = to_uint x + (4 * off + 3) * 8 by ring. + have -> : to_uint x + 32 * off + 16 = to_uint x + (4 * off + 2) * 8 by ring. + have -> : to_uint x + 32 * off + 8 = to_uint x + (4 * off + 1) * 8 by ring. + have -> : 32 * off = (4 * off) * 8 by ring. + rewrite !hgood 1..4:/#. + by admit. +qed. op conversion(o1 o2 : int) : int = let (x,y) = From 487d81ebe13bf126606a08cbc710afc4b7095474 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Wed, 15 May 2019 08:15:19 +0200 Subject: [PATCH 409/525] fill the proof. --- .../perm/keccak_f1600_avx2_prevec_vops.ec | 92 ++++--------------- 1 file changed, 19 insertions(+), 73 deletions(-) diff --git a/proof/impl/perm/keccak_f1600_avx2_prevec_vops.ec b/proof/impl/perm/keccak_f1600_avx2_prevec_vops.ec index bfef0db..757a16d 100644 --- a/proof/impl/perm/keccak_f1600_avx2_prevec_vops.ec +++ b/proof/impl/perm/keccak_f1600_avx2_prevec_vops.ec @@ -400,81 +400,27 @@ op match_states( st1 : W64.t Array4.t * W64.t Array4.t * W64.t Array4.t * W64.t is4u64 st1.`6 st2.`6 /\ is4u64 st1.`7 st2.`7. +lemma lift2arrayP (w:W256.t) : w = pack4 [(lift2array w).[0]; (lift2array w).[1]; (lift2array w).[2]; (lift2array w).[3]]. +proof. + apply W4u64.wordP => i hi. + rewrite /lift2array /= pack4bE 1:// get_of_list 1:// /#. +qed. + equiv prevec_vops_prevec : Mavx2_prevec.__KeccakF1600 ~ Mavx2_prevec_vops.__KeccakF1600 : ={Glob.mem} /\ match_ins arg{1} arg{2} ==> ={Glob.mem} /\ match_states res{1} res{2}. -proc. - seq 112 112 : (#pre /\ ={zf,iotas,rhotates_left,rhotates_right,i} /\ - forall i, 0 <= i < 9 => is4u64 t{1}.[i] t{2}.[i]). - seq 30 30 : (#pre /\ ={iotas,rhotates_left,rhotates_right,i} /\ - forall i, 0 <= i < 9 => is4u64 t{1}.[i] t{2}.[i] /\ - is4u64 d14{1} d14{2}). -call (eq_iVPSLLV_4u64). -call (eq_ilxor4u64). -call (eq_iVPBLENDD_256). -call (eq_iVPBLENDD_256). -call (eq_ilxor4u64). -call (eq_ilxor4u64). -call (eq_ilor4u64). -call (eq_ivadd64u256). -call (eq_ivshr64u256). -call (eq_ilxor4u64). -call (eq_ilxor4u64). -call (eq_iVPERMQ). -call (eq_ilxor4u64). -call (eq_iVPERMQ). -call (eq_ilor4u64). -call (eq_ivadd64u256). -call (eq_ivshr64u256). -call (eq_iVPERMQ). -call (eq_ilxor4u64). -call (eq_iVPERMQ). -call (eq_ilxor4u64). -call (eq_ilxor4u64). -call (eq_ilxor4u64). -call (eq_ilxor4u64). -call (eq_iVPSHUFD_256). -wp;skip;rewrite /match_ins /is4u64;auto => />. -progress. -admit. admit. -(* and so on *) -admit. - while (#pre). - seq 30 30 : (#pre /\ is4u64 d14{1} d14{2}). -call (eq_iVPSRLV_4u64). -call (eq_iVPSLLV_4u64). -call (eq_ilxor4u64). -call (eq_ilor4u64). -call (eq_iVPSRLV_4u64). -call (eq_iVPSLLV_4u64). -call (eq_ilxor4u64). -call (eq_iVPBLENDD_256). -call (eq_iVPBLENDD_256). -call (eq_ilxor4u64). -call (eq_ilxor4u64). -call (eq_ilor4u64). -call (eq_ivadd64u256). -call (eq_ivshr64u256). -call (eq_ilxor4u64). -call (eq_ilxor4u64). -call (eq_iVPERMQ). -call (eq_ilxor4u64). -call (eq_iVPERMQ). -call (eq_ilor4u64). -call (eq_ivadd64u256). -call (eq_ivshr64u256). -call (eq_iVPERMQ). -call (eq_ilxor4u64). -call (eq_iVPERMQ). -call (eq_ilxor4u64). -call (eq_ilxor4u64). -call (eq_ilxor4u64). -call (eq_ilxor4u64). -call (eq_iVPSHUFD_256). -wp;skip;rewrite /match_ins /is4u64;auto => />. -progress. -admit. admit. admit. admit. admit. -admit. -by auto => />. +proof. + proc. + while (#pre /\ ={zf,iotas,rhotates_left,rhotates_right,i}). + + wp; + do !(call eq_ilxor4u64 || call eq_ilandn4u64 || call eq_iVPBLENDD_256 || call eq_iVPERMQ || call eq_ilandn4u64 || + call eq_iVPSRLDQ_256 || call eq_iVPSLLV_4u64 || call eq_ilor4u64 || call eq_iVPSRLV_4u64 || + call eq_ivadd64u256 || call eq_ivshr64u256 || call eq_iVPSHUFD_256); wp; skip => />; rewrite /is4u64 => />. + smt (lift2arrayP). + wp; + do !(call eq_ilxor4u64 || call eq_ilandn4u64 || call eq_iVPBLENDD_256 || call eq_iVPERMQ || call eq_ilandn4u64 || + call eq_iVPSRLDQ_256 || call eq_iVPSLLV_4u64 || call eq_ilor4u64 || call eq_iVPSRLV_4u64 || + call eq_ivadd64u256 || call eq_ivshr64u256 || call eq_iVPSHUFD_256); wp; skip => />; rewrite /is4u64 => />. + smt (lift2arrayP). qed. From 261c720e832e1013debc921577c2beb9a87c3431 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Wed, 15 May 2019 09:26:52 +0200 Subject: [PATCH 410/525] perform transitivity check --- proof/impl/perm/keccak_f1600_scalar_table.ec | 263 +++++-------------- 1 file changed, 64 insertions(+), 199 deletions(-) diff --git a/proof/impl/perm/keccak_f1600_scalar_table.ec b/proof/impl/perm/keccak_f1600_scalar_table.ec index 1552aef..60a652b 100644 --- a/proof/impl/perm/keccak_f1600_scalar_table.ec +++ b/proof/impl/perm/keccak_f1600_scalar_table.ec @@ -209,18 +209,8 @@ equiv round2x : Mscalarrho.round2x ~ Mscalartable.round2x : ={Glob.mem,arg} ==> ={Glob.mem,res}. proc. -call (_:true); first by sim. -call (rol_sum). -call (_:true); first by sim. -call (rol_sum). -call (_:true); first by sim. -call (rol_sum). -call (_:true); first by sim. -call (rol_sum). -call (_:true); first by sim. -call (rol_sum). -call (_:true); first by sim. -call (_:true); first by sim. +do 5! (call (_:true); [by sim | call rol_sum]). +do 2! (call (_:true); first by sim). by auto => />. qed. @@ -230,14 +220,8 @@ equiv scalartable : proc. wp. while (={Glob.mem,zf,_A,_R,iotas}). -wp. -call (round2x). -call (round2x). -by auto => />. -wp. -call (round2x). -call (round2x). -by auto => />. ++ by wp; do 2! call round2x; auto. +by wp; do 2! call round2x; auto. qed. op good_iotas (mem : global_mem_t, _iotas : int) = @@ -246,22 +230,11 @@ op good_iotas (mem : global_mem_t, _iotas : int) = lemma testsem : (forall (x : W64.t), (x86_TEST_8 (truncateu8 x) (W8.of_int 255)).`5 <=> (W64.to_uint x %% 256 = 0)). move => *. -rewrite /x86_TEST_8. -rewrite /rflags_of_bwop8. -rewrite /truncateu8 => //=. -rewrite /ZF_of_w8 => //=. -pose i := to_uint x. -have inneg : (0 <= i); first by smt(@W64). -auto => />. -split. -rewrite (W8.and_mod 8) => />. -rewrite W8.of_int_mod => />. -rewrite W8.of_int_mod => />. -admit. -rewrite (W8.and_mod 8) => />. -rewrite W8.of_int_mod => />. -rewrite W8.of_int_mod => />. -admit. +rewrite /x86_TEST_8 /rflags_of_bwop8 /truncateu8 /ZF_of_w8 /=. +have -> : W8.of_int 255 = W8.onew by rewrite oneE. +rewrite W8.andw1; split => h. ++ by rewrite (_ : 0 = to_uint W8.zero) 1:// -h W8.of_uintK. +by apply W8.to_uintRL; rewrite -h W8.of_uintK. qed. lemma rol0 : (forall x , (x86_ROL_64 x (W8.of_int (rhotates 0))).`3 = x). @@ -334,41 +307,9 @@ do !((rcondt {2} ^if; first by move => *; wp;skip;auto => />) || (rcondf {2} ^if; first by move => *; wp;skip;auto => />)). wp;skip. -move => &1 &2. -move => H. -simplify. -split; last first. -apply Array25.ext_eq. -move => x Hx. - -case (x = 0); first by auto => />;smt(rol0 @W64). -case (x = 1); first by auto => />;smt(rol0 @W64). -case (x = 2); first by auto => />;smt(rol0 @W64). -case (x = 3); first by auto => />;smt(rol0 @W64). -case (x = 4); first by auto => />;smt(rol0 @W64). -case (x = 5); first by auto => />;smt(rol0 @W64). -case (x = 6); first by auto => />;smt(rol0 @W64). -case (x = 7); first by auto => />;smt(rol0 @W64). -case (x = 8); first by auto => />;smt(rol0 @W64). -case (x = 9); first by auto => />;smt(rol0 @W64). -case (x = 10); first by auto => />;smt(rol0 @W64). -case (x = 11); first by auto => />;smt(rol0 @W64). -case (x = 12); first by auto => />;smt(rol0 @W64). -case (x = 13); first by auto => />;smt(rol0 @W64). -case (x = 14); first by auto => />;smt(rol0 @W64). -case (x = 15); first by auto => />;smt(rol0 @W64). -case (x = 16); first by auto => />;smt(rol0 @W64). -case (x = 17); first by auto => />;smt(rol0 @W64). -case (x = 18); first by auto => />;smt(rol0 @W64). -case (x = 19); first by auto => />;smt(rol0 @W64). -case (x = 20); first by auto => />;smt(rol0 @W64). -case (x = 21); first by auto => />;smt(rol0 @W64). -case (x = 22); first by auto => />;smt(rol0 @W64). -case (x = 23); first by auto => />;smt(rol0 @W64). -case (x = 24); first by auto => />;smt(rol0 @W64). -by smt(). - -progress; [ 1 : by smt() | 2: by move : H => [/ #] | 3..: by smt() ]. +move => &1 &2 /> h1 h2 h3 h4. +apply Array25.all_eq_eq; cbv delta. +smt(rol0 @W64). (* Second round *) @@ -392,16 +333,8 @@ inline *; sp 4 4. seq 2 6 : (#{/~c2{1}}{~c{2}}pre /\ c2{1} = c0{2}). do 6!(unroll for {1} ^while). do 6!(unroll for {2} ^while). -auto => />. -progress. -apply (Array5.ext_eq). -move => *. -case (x = 0); first by auto => />;smt( @W64). -case (x = 1); first by auto => />;smt( @W64). -case (x = 2); first by auto => />;smt( @W64). -case (x = 3); first by auto => />;smt( @W64). -case (x = 4); first by auto => />;smt( @W64). -smt(). +auto => /> &2 ????. +by apply Array5.all_eq_eq; cbv delta. sp 0 1;wp. @@ -417,44 +350,12 @@ do 10!(unroll for {2} ^while). do !((rcondt {2} ^if; first by move => *; wp;skip;auto => />) || (rcondf {2} ^if; first by move => *; wp;skip;auto => />)). -wp;skip. -move => &1 &2. -move => H. -simplify. -split; last first. -apply Array25.ext_eq. -move => x Hx. -case (x = 0); first by auto => />;smt(rol0 @W64). -case (x = 1); first by auto => />;smt(rol0 @W64). -case (x = 2); first by auto => />;smt(rol0 @W64). -case (x = 3); first by auto => />;smt(rol0 @W64). -case (x = 4); first by auto => />;smt(rol0 @W64). -case (x = 5); first by auto => />;smt(rol0 @W64). -case (x = 6); first by auto => />;smt(rol0 @W64). -case (x = 7); first by auto => />;smt(rol0 @W64). -case (x = 8); first by auto => />;smt(rol0 @W64). -case (x = 9); first by auto => />;smt(rol0 @W64). -case (x = 10); first by auto => />;smt(rol0 @W64). -case (x = 11); first by auto => />;smt(rol0 @W64). -case (x = 12); first by auto => />;smt(rol0 @W64). -case (x = 13); first by auto => />;smt(rol0 @W64). -case (x = 14); first by auto => />;smt(rol0 @W64). -case (x = 15); first by auto => />;smt(rol0 @W64). -case (x = 16); first by auto => />;smt(rol0 @W64). -case (x = 17); first by auto => />;smt(rol0 @W64). -case (x = 18); first by auto => />;smt(rol0 @W64). -case (x = 19); first by auto => />;smt(rol0 @W64). -case (x = 20); first by auto => />;smt(rol0 @W64). -case (x = 21); first by auto => />;smt(rol0 @W64). -case (x = 22); first by auto => />;smt(rol0 @W64). -case (x = 23); first by auto => />;smt(rol0 @W64). -case (x = 24); first by auto => />;smt(rol0 @W64). -by smt(). - -progress; [ 1 : by smt() | 2: by move : H => [/ #] | 3..: by smt() ]. +wp;skip => />. +move => &1 &2 /> h1 h2 h3 h4. +apply Array25.all_eq_eq; cbv delta. +smt(rol0 @W64). auto => />. -progress. rewrite to_uintD. by smt(@W64). @@ -521,41 +422,9 @@ do 10!(unroll for {2} ^while). do !((rcondt {2} ^if; first by move => *; wp;skip;auto => />) || (rcondf {2} ^if; first by move => *; wp;skip;auto => />)). -wp;skip. -move => &1 &2. -move => H. -simplify. -split; last first. -apply Array25.ext_eq. -move => x Hx. -case (x = 0); first by auto => />;smt(rol0 @W64). -case (x = 1); first by auto => />;smt(rol0 @W64). -case (x = 2); first by auto => />;smt(rol0 @W64). -case (x = 3); first by auto => />;smt(rol0 @W64). -case (x = 4); first by auto => />;smt(rol0 @W64). -case (x = 5); first by auto => />;smt(rol0 @W64). -case (x = 6); first by auto => />;smt(rol0 @W64). -case (x = 7); first by auto => />;smt(rol0 @W64). -case (x = 8); first by auto => />;smt(rol0 @W64). -case (x = 9); first by auto => />;smt(rol0 @W64). -case (x = 10); first by auto => />;smt(rol0 @W64). -case (x = 11); first by auto => />;smt(rol0 @W64). -case (x = 12); first by auto => />;smt(rol0 @W64). -case (x = 13); first by auto => />;smt(rol0 @W64). -case (x = 14); first by auto => />;smt(rol0 @W64). -case (x = 15); first by auto => />;smt(rol0 @W64). -case (x = 16); first by auto => />;smt(rol0 @W64). -case (x = 17); first by auto => />;smt(rol0 @W64). -case (x = 18); first by auto => />;smt(rol0 @W64). -case (x = 19); first by auto => />;smt(rol0 @W64). -case (x = 20); first by auto => />;smt(rol0 @W64). -case (x = 21); first by auto => />;smt(rol0 @W64). -case (x = 22); first by auto => />;smt(rol0 @W64). -case (x = 23); first by auto => />;smt(rol0 @W64). -case (x = 24); first by auto => />;smt(rol0 @W64). -by smt(). - -progress; [ 1 : by smt() | 2: by move : H => [/ #] | 3..: by smt() ]. +wp;skip; move => &1 &2 /> h1 h2 h3 h4 ?????; +apply Array25.all_eq_eq; cbv delta. +smt(rol0 @W64). (* Second round *) @@ -604,43 +473,9 @@ do 10!(unroll for {2} ^while). do !((rcondt {2} ^if; first by move => *; wp;skip;auto => />) || (rcondf {2} ^if; first by move => *; wp;skip;auto => />)). - -wp;skip. -move => &1 &2. -move => H. -simplify. -split; last first. -apply Array25.ext_eq. -move => x Hx. -case (x = 0); first by auto => />;smt(rol0 @W64). -case (x = 1); first by auto => />;smt(rol0 @W64). -case (x = 2); first by auto => />;smt(rol0 @W64). -case (x = 3); first by auto => />;smt(rol0 @W64). -case (x = 4); first by auto => />;smt(rol0 @W64). -case (x = 5); first by auto => />;smt(rol0 @W64). -case (x = 6); first by auto => />;smt(rol0 @W64). -case (x = 7); first by auto => />;smt(rol0 @W64). -case (x = 8); first by auto => />;smt(rol0 @W64). -case (x = 9); first by auto => />;smt(rol0 @W64). -case (x = 10); first by auto => />;smt(rol0 @W64). -case (x = 11); first by auto => />;smt(rol0 @W64). -case (x = 12); first by auto => />;smt(rol0 @W64). -case (x = 13); first by auto => />;smt(rol0 @W64). -case (x = 14); first by auto => />;smt(rol0 @W64). -case (x = 15); first by auto => />;smt(rol0 @W64). -case (x = 16); first by auto => />;smt(rol0 @W64). -case (x = 17); first by auto => />;smt(rol0 @W64). -case (x = 18); first by auto => />;smt(rol0 @W64). -case (x = 19); first by auto => />;smt(rol0 @W64). -case (x = 20); first by auto => />;smt(rol0 @W64). -case (x = 21); first by auto => />;smt(rol0 @W64). -case (x = 22); first by auto => />;smt(rol0 @W64). -case (x = 23); first by auto => />;smt(rol0 @W64). -case (x = 24); first by auto => />;smt(rol0 @W64). -by smt(). - - -progress; [ 1 : by smt() | 2: by move : H => [/ #] | 3..: by smt() ]. +wp;skip; move => &1 &2 /> h1 h2 h3 h4 ?????; +apply Array25.all_eq_eq; cbv delta. +smt(rol0 @W64). auto => />. @@ -682,14 +517,44 @@ lemma scalarcorr_op _iotas mem : mem = Glob.mem{2} /\ to_uint iotas{2} = _iotas /\ state{1} = a{2} ==> mem = Glob.mem{2} /\ to_uint res{2}.`2 = _iotas /\ res{1} = res{2}.`1 ]. -print Keccak_f1600_ref_loop2. -move : Keccak_f1600_ref_op.ref_refop => *. -move : Keccak_f1600_ref_table.ref_reftable => *. -move : reftable_refloop => *. -move : refloop_refloopk => *. -move : refloopk_refloop2 => *. -move : (scalarcorr _iotas mem) => *. -move : scalartable => *. -move : scalarrhom => *. -admit. (* how to join them all? *) +proof. +transitivity Mrefloop2.__keccak_f1600_ref + (={state, Glob.mem} ==> ={res, Glob.mem}) + ( 0 <= _iotas < W64.modulus - 24 * 8 /\ + good_iotas mem _iotas /\ + (_iotas - 8 * 8) %% 256 = 0 /\ ={Glob.mem} /\ mem = Glob.mem{2} /\ to_uint iotas{2} = _iotas /\ state{1} = a{2} + ==> + mem = Glob.mem{2} /\ to_uint res{2}.`2 = _iotas /\ res{1} = res{2}.`1) => //. ++ smt(). ++ transitivity Mrefop.__keccak_f1600_ref + ( ={Glob.mem, state} ==> ={Glob.mem, res}) + (={state, Glob.mem} ==> ={res, Glob.mem}) => //. + + smt(). + by apply Keccak_f1600_ref_op.ref_refop. + transitivity Mreftable.__keccak_f1600_ref + ( ={state, Glob.mem} ==> ={res, Glob.mem}) + ( ={state, Glob.mem} ==> ={res, Glob.mem}) => //. + + smt(). + by apply Keccak_f1600_ref_table.ref_reftable. + transitivity Mrefloop.__keccak_f1600_ref + ( ={state, Glob.mem} ==> ={res, Glob.mem}) + ( ={state, Glob.mem} ==> ={res, Glob.mem}) => //. + + smt(). + by apply reftable_refloop. + transitivity Mrefloopk.__keccak_f1600_ref + ( ={state, Glob.mem} ==> ={res, Glob.mem}) + ( ={state, Glob.mem} ==> ={res, Glob.mem}) => //. + + smt(). + by apply refloop_refloopk. + by apply refloopk_refloop2 => *. +transitivity Mscalartable.keccak_f + ( 0 <= _iotas < W64.modulus - 24 * 8 /\ + good_iotas mem _iotas /\ + (_iotas - 8 * 8) %% 256 = 0 /\ mem = Glob.mem{2} /\ to_uint iotas{2} = _iotas /\ state{1} = _A{2} + ==> + mem = Glob.mem{2} /\ to_uint res{2}.`2 = _iotas /\ res{1} = res{2}.`1) + ( ={Glob.mem, arg} ==> ={Glob.mem, res}) => //. ++ smt (). + by apply (scalarcorr _iotas mem). +symmetry. +transitivity Mscalarrho.keccak_f + ( ={Glob.mem, arg} ==> ={Glob.mem, res}) + ( ={Glob.mem, arg} ==> ={Glob.mem, res}) => //. ++ smt(). + by apply scalarrhom. +by apply scalartable. qed. From 6e92fd66bf89a3d9f4fc2b132e6dfa86a850e4c7 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Wed, 15 May 2019 09:50:50 +0200 Subject: [PATCH 411/525] add some notes --- proof/impl/libc/keccak_1600_scalar_modular.ec | 78 +++++++++---------- 1 file changed, 36 insertions(+), 42 deletions(-) diff --git a/proof/impl/libc/keccak_1600_scalar_modular.ec b/proof/impl/libc/keccak_1600_scalar_modular.ec index c1d59a6..83ce6ad 100644 --- a/proof/impl/libc/keccak_1600_scalar_modular.ec +++ b/proof/impl/libc/keccak_1600_scalar_modular.ec @@ -279,52 +279,46 @@ equiv modcorrect mem : (to_uint iotas{2} - 8 * 8) %% 256 = 0 /\ in_0{1} = in_0{2} /\ inlen{1} = inlen{2} /\ s_out{1} = s_out{2} /\ s_outlen{1} = s_outlen{2} /\ rate{1} = rate{2} /\ s_trail_byte{1} = s_trail_byte{2} /\ ={Glob.mem} ==> ={Glob.mem}. -proc. -seq 2 2 : (#pre /\ ={state}). -call(_:true). -while (#post /\ to_uint i{2} = i{1} /\ i{2} \ule W64.of_int 25 /\ t{2} = W64.zero). -auto => />; progress; [ by smt(@W64) | by smt(@W64) | by rewrite ultE; smt(@W64)| by smt(@W64)]. -auto => />; rewrite set0_64E => />. -by auto => />. - +proof. +proc => /=. ++ seq 2 2 : (#pre /\ ={state}). + call(_:true); last by auto. + while (#post /\ to_uint i{2} = i{1} /\ i{2} \ule W64.of_int 25 /\ t{2} = W64.zero). + + by auto => /> &2; rewrite ultE; smt(@W64). + auto => />; rewrite set0_64E => />. seq 4 1 : #{/~in_0{1} = in_0{2}}{~inlen{1} = inlen{2}}pre. -inline Mmod.absorb. -swap {2} [5..6] -2; swap {2} [2..4] -1; sp 0 3. -seq 0 3 : (#{/~state{1} = state{2}}{/~in_0{1} = in_0{2}}{~inlen{1} = inlen{2}}pre /\ state0{2} = state{1} /\ inlen0{2} = inlen{1} /\ in_00{2} = in_0{1}); first by auto => />. -seq 1 1 : #pre. -while (#post). -inline Mmod.load_3 Mmod.spill_3. -wp. -exists* Glob.mem{2}, iotas0{2}. -elim* => memm _iotas. -call (Keccak_f1600_scalar_table.scalarcorr_op (to_uint _iotas) memm). -wp. -call (_: ={Glob.mem}); first by sim. -auto => />; progress. smt(@W64). -by auto => />. -wp. -call (_: ={Glob.mem}); first by sim. -by auto => />. ++ inline Mmod.absorb. + swap {2} [5..6] -2; swap {2} [2..4] -1; sp 0 3. + seq 0 3 : (#{/~state{1} = state{2}}{/~in_0{1} = in_0{2}}{~inlen{1} = inlen{2}}pre /\ state0{2} = state{1} /\ inlen0{2} = inlen{1} /\ in_00{2} = in_0{1}); first by auto => />. + seq 1 1 : #pre. + + while (#post); last by auto. + inline Mmod.load_3 Mmod.spill_3; wp. + exlim Glob.mem{2}, iotas0{2} => memm _iotas. + call (Keccak_f1600_scalar_table.scalarcorr_op (to_uint _iotas) memm). + wp; call (_: ={Glob.mem}); first by sim. + auto => />; smt(@W64). + wp; call (_: ={Glob.mem}); first by sim. + by auto => />. inline Mmod.squeeze. swap {2} 6 -2; swap {2} [3..4] -2; sp 0 2. -seq 1 4 : (#{/~state{1} = state{2}}{~Glob.mem{2}=mem}{~s_out{1} = s_out{2}}{~s_outlen{1} = s_outlen{2}}pre /\ state0{2} = state{1} /\ outlen0{2} = outlen{1} /\ s_out0{2} = s_out{1} /\ Keccak_f1600_scalar_table.good_iotas Glob.mem{2} (to_uint iotas{2})); first by auto => />. +seq 1 4 : (#{/~state{1} = state{2}}{~Glob.mem{2}=mem}{~s_out{1} = s_out{2}}{~s_outlen{1} = s_outlen{2}}pre /\ + state0{2} = state{1} /\ outlen0{2} = outlen{1} /\ s_out0{2} = s_out{1} /\ + Keccak_f1600_scalar_table.good_iotas Glob.mem{2} (to_uint iotas{2})); first by auto => />. seq 1 1 : #pre. -while (#post). -inline Mmod.load_3 Mmod.spill_2. -wp. -call (_: ={Glob.mem}); first by sim. -wp. -exists* Glob.mem{2}, iotas0{2}. -elim* => memm _iotas. -call (Keccak_f1600_scalar_table.scalarcorr_op (to_uint _iotas) memm). -print Keccak_f1600_scalar_table.scalarcorr_op. -wp;skip;progress. smt(@W64). admit. (* what am I missing? The post condition in the call seems to ensure mem_R = memm bit this is not in the context *) -by auto => />. ++ while (#post); last by auto. + inline Mmod.load_3 Mmod.spill_2. + wp. + (* This one is invalid we need to show that Mmod.xtr_full_block does not touch iotas *) + call (_: ={Glob.mem}); first by sim. + wp. + exlim Glob.mem{2}, iotas0{2} => memm _iotas. + call (Keccak_f1600_scalar_table.scalarcorr_op (to_uint _iotas) memm). + wp;skip => />. + progress. smt(@W64). admit. (* what am I missing? The post condition in the call seems to ensure mem_R = memm bit this is not in the context *) seq 2 2 : (#pre /\ s_outlen{1} = s_outlen0{2}). -exists* Glob.mem{2}, iotas0{2}. -elim* => memm _iotas. -call (Keccak_f1600_scalar_table.scalarcorr_op (to_uint _iotas) memm). -wp;skip;progress. smt(@W64). - inline *. ++ exlim Glob.mem{2}, iotas0{2} => memm _iotas. + call (Keccak_f1600_scalar_table.scalarcorr_op (to_uint _iotas) memm). + by wp;skip=> />; smt(@W64). +inline *. by sim. qed. From ad9ce46a7b3ebbc092e1ac826f342f791c3ce34d Mon Sep 17 00:00:00 2001 From: Manuel Barbosa Date: Wed, 15 May 2019 15:15:17 +0100 Subject: [PATCH 412/525] FIxing admits --- proof/impl/libc/keccak_1600_avx2_modular.ec | 68 +++++++++- proof/impl/perm/keccak_f1600_avx2.ec | 2 +- proof/impl/perm/keccak_f1600_avx2_prevec.ec | 139 +++++++++----------- 3 files changed, 128 insertions(+), 81 deletions(-) diff --git a/proof/impl/libc/keccak_1600_avx2_modular.ec b/proof/impl/libc/keccak_1600_avx2_modular.ec index 370bd63..87229a0 100644 --- a/proof/impl/libc/keccak_1600_avx2_modular.ec +++ b/proof/impl/libc/keccak_1600_avx2_modular.ec @@ -342,13 +342,74 @@ lemma set_get_diff (v : W64.t Array28.t) (w : W256.t) i j : WArray224.get64 (WArray224.set256 (WArray224.init64 ("_.[_]" v)) i w) j = v.[j] by admit. -(* some precondition on st holding 0 is needed and must be preserved; also something on jagged *) -equiv add_full_block_corr st : +(* my @A_jagged = ([0,0], [1,0], [1,1], [1,2], [1,3], # [0][0..4] + [2,2], [6,0], [3,1], [4,2], [5,3], # [1][0..4] + [2,0], [4,0], [6,1], [5,2], [3,3], # [2][0..4] + [2,3], [3,0], [5,1], [6,2], [4,3], # [3][0..4] + [2,1], [5,0], [4,1], [3,2], [6,3]); # [4][0..4] + @A_jagged = map(8*($$_[0]*4+$$_[1]), @A_jagged); # ... and now linear *) + + +op A_jagged = (witness + .[0 <- 0 ] + .[1 <- 32 ] + .[2 <- 40 ] + .[3 <- 48 ] + .[4 <- 56 ] + .[5 <- 80 ] + .[6 <- 192] + .[7 <- 104] + .[8 <- 144] + .[9 <- 184] + .[10 <- 64 ] + .[11 <- 128] + .[12 <- 200] + .[13 <- 176] + .[14 <- 120] + .[15 <- 88 ] + .[16 <- 96 ] + .[17 <- 168] + .[18 <- 208] + .[19 <- 152] + .[20 <- 72 ] + .[21 <- 160] + .[22 <- 136] + .[23 <- 112] + .[24 <- 216])%Array25. + +op good_jag (mem : global_mem_t, _jag : int) = + forall off, 0 <= off < 25 => + loadW64 mem (_jag + (off * 8)) = W64.of_int A_jagged.[off]. + +op jagged_zeros_W64 (sts : W64.t Array28.t, rate8 : int) = + forall off, + rate8 %/ 8 <= off => sts.[A_jagged.[off]] = W64.zero. + +op jagged_load_W64 (mem : global_mem_t, _jag : int, sts : W64.t Array28.t, rate8 : int) = + forall off, + sts.[A_jagged.[off]] = if 0 <= off < rate8 %/ 8 + then loadW64 mem (_jag + (off * 8)) + else W64.zero. + +op jagged_load (mem : global_mem_t, _jag : int, sts : W64.t Array28.t, inl8 : int) = + if inl8 %% 8 = 0 then jagged_load_W64 mem _jag sts inl8 + else forall off, + sts.[A_jagged.[off]] = if 0 <= off < inl8 %/ 8 + then loadW64 mem (_jag + (off * 8)) + else if off = inl8 %/ 8 + then W64.zero (* FIX ME: just read the remaining bytes *) + else W64.zero. + +equiv add_full_block_corr st rr : Keccak_1600_ref_modular.Mmod.add_full_block ~ Mmod.add_full_block : + jagged_zeros_W64 s_state{2} (to_uint rate{2}) /\ to_uint rate{2} = rr /\ + good_jag Glob.mem{2} (to_uint a_jagged{2}) /\ ={Glob.mem} /\ em_states state{2} state{1} /\ ={in_0,inlen,rate} /\ s_state{2} = st ==> - ={Glob.mem} /\ em_states res{2}.`1 res{1}.`1 /\ + ={Glob.mem} /\ jagged_zeros_W64 res{2}.`2 rr /\ + em_states res{2}.`1 res{1}.`1 /\ res{1}.`2 = res{2}.`3 /\ res{1}.`3 = res{2}.`4. +proc. admitted. (* some precondition on st holding 0 is needed and must be preserved; also something on jagged *) @@ -357,6 +418,7 @@ equiv add_final_block_corr st : ={Glob.mem} /\ em_states state{2} state{1} /\ ={in_0,inlen} /\ s_state{2} = st ==> ={Glob.mem} /\ em_states res{2} res{1}. +proc. admitted. (* some precondition on jagged needed *) diff --git a/proof/impl/perm/keccak_f1600_avx2.ec b/proof/impl/perm/keccak_f1600_avx2.ec index 2adc259..5282e84 100644 --- a/proof/impl/perm/keccak_f1600_avx2.ec +++ b/proof/impl/perm/keccak_f1600_avx2.ec @@ -855,7 +855,7 @@ op em_states (state : W256.t Array7.t, st : W64.t Array25.t) : bool = lemma avx2corr st _iotas mem : equiv [ Keccak_f1600_ref.M.__keccak_f1600_ref ~ M.__keccak_f1600_avx2 : - Glob.mem{2} = mem /\ Keccak_f1600_avx2_prevec.good_iotas mem (W64.to_uint _iotas{2}) /\ + Glob.mem{2} = mem /\ Keccak_f1600_avx2_prevec.good_io4x mem (W64.to_uint _iotas{2}) /\ good_rhol mem (to_uint _rhotates_left{2}) /\ good_rhor mem (to_uint _rhotates_right{2}) /\ em_states state{2} state{1} /\ st = state{1} ==> diff --git a/proof/impl/perm/keccak_f1600_avx2_prevec.ec b/proof/impl/perm/keccak_f1600_avx2_prevec.ec index 8c173cf..be9ef8c 100644 --- a/proof/impl/perm/keccak_f1600_avx2_prevec.ec +++ b/proof/impl/perm/keccak_f1600_avx2_prevec.ec @@ -488,9 +488,9 @@ apply W64.init_ext. progress. smt. qed. -op good_iotas (mem : global_mem_t, _iotas : int) = +op good_io4x (mem : global_mem_t, _iotas : int) = forall off, 0 <= off < 24 => - loadW64 mem (_iotas + (off * 8)) = iotas.[off]. + loadW64 mem (_iotas + (off * 8)) = good_iotas4x.[off]. op good_rhol (mem : global_mem_t, _rhotates_left : int) = forall off, 0 <= off < 24 => @@ -574,29 +574,10 @@ proof. smt (Array4.get_setE). qed. -(* -lemma good_iotas4x_iotas off i : - 0 <= off < 6 => - 0 <= i < 4 => - good_iotas4x.[4 * off + i] = iotas.[4 * off + i]. -proof. - rewrite /good_iotas4x /iotas. -*) -(* This lemma if false: - it should be eather - iotas.[4 * off + 0] - iotas.[4 * off + 1] - iotas.[4 * off + 2] - iotas.[4 * off + 3] - of - good_iotas4x.[16*off + 0] - good_iotas4x.[16*off + 4] - good_iotas4x.[16*off + 8] - good_iotas4x.[16*off + 12] - *) +print good_iotas. lemma loadlift_iotas : forall (mem : global_mem_t) (x : W64.t) (off : int), to_uint x + 768 < W64.modulus => - good_iotas mem (to_uint x) => 0 <= off < 6 => + good_io4x mem (to_uint x) => 0 <= off < 6 => lift2array (loadW256 mem (to_uint (x + W64.of_int (8 * 4 * off)))) = (witness @@ -616,8 +597,7 @@ proof. have -> : to_uint x + 32 * off + 16 = to_uint x + (4 * off + 2) * 8 by ring. have -> : to_uint x + 32 * off + 8 = to_uint x + (4 * off + 1) * 8 by ring. have -> : 32 * off = (4 * off) * 8 by ring. - rewrite !hgood 1..4:/#. - by admit. + rewrite !hgood 1..4:/#. smt (Array4.get_setE). qed. op conversion(o1 o2 : int) : int = @@ -649,6 +629,8 @@ op conversion(o1 o2 : int) : int = .[23 <- (4,4)])%Array24).[o1*4 + o2] in (5*x + y). lemma lift_roln mem rl rr o1 o2 x: + W64.to_uint rl + 192 < W64.modulus => + W64.to_uint rr + 192 < W64.modulus => 0 <= o1 < 6 => 0 <= o2 < 4 => good_rhol mem (W64.to_uint rl) => good_rhor mem (W64.to_uint rr) => @@ -665,8 +647,8 @@ lemma lift_roln mem rl rr o1 o2 x: = (x86_ROL_64 x ((of_int (rhotates (conversion o1 o2))))%W8).`3. proof. move => *. -rewrite (loadlift_rhol mem (rl) o1). smt(). smt(). -rewrite (loadlift_rhor mem (rr) o1). smt(). smt(). +rewrite (loadlift_rhol mem (rl) o1 H). smt(). smt(). +rewrite (loadlift_rhor mem (rr) o1 H0). smt(). smt(). rewrite /good_rhotates_right /good_rhotates_left /rhotates /conversion. simplify. case(o1 = 0). auto => />. @@ -715,7 +697,10 @@ qed. lemma correct_perm _a00 _a01 _a20 _a31 _a21 _a41 _a11 st mem: equiv [ Mreftable.__keccak_f1600_ref ~ Mavx2_prevec.__KeccakF1600 : - Glob.mem{2} = mem /\ good_iotas mem (to_uint _iotas{2}) /\ + to_uint _rhotates_left{2} + 192 < W64.modulus => + to_uint _rhotates_right{2} + 192 < W64.modulus => + to_uint _iotas{2} + 768 < W64.modulus => + Glob.mem{2} = mem /\ good_io4x mem (to_uint _iotas{2}) /\ good_rhol mem (to_uint _rhotates_left{2}) /\ good_rhor mem (to_uint _rhotates_right{2}) /\ equiv_states _a00 _a01 _a20 _a31 _a21 _a41 _a11 st /\ a00{2} = _a00 /\ a01{2} = _a01 /\ a20{2} = _a20 /\ a31{2} = _a31 /\ @@ -731,7 +716,7 @@ inline Mreftable.keccakRoundConstants. sp 2 4. seq 1 105 : (#{/~a00{2}}{~a01{2}}{~a20{2}}{~a31{2}}{~a21{2}}{~a41{2}}{~a11{2}}{~state{1}}pre /\ Glob.mem{2} = mem /\ - good_iotas mem (to_uint _iotas{2}) /\ + good_io4x mem (to_uint _iotas{2}) /\ good_rhol mem (to_uint _rhotates_left{2}) /\ good_rhor mem (to_uint _rhotates_right{2}) /\ equiv_states a00{2} a01{2} a20{2} a31{2} a21{2} a41{2} a11{2} state{1}). @@ -796,56 +781,56 @@ split; first by rewrite /rhotates; smt(roln rol0). split. rewrite H H0. move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 5 3 a11{2}.[3] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 5 3 a11{2}.[3] _ _ rls rrs rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 5 2 a11{2}.[2] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 5 2 a11{2}.[2] _ _ _ rls rrs rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 5 1 a11{2}.[1] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 5 1 a11{2}.[1] _ _ _ rls rrs rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 5 0 a11{2}.[0] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 5 0 a11{2}.[0] _ _ _ rls rrs rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 1 3 a01{2}.[3] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 1 3 a01{2}.[3] _ _ rls rrs rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 1 2 a01{2}.[2] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 1 2 a01{2}.[2] _ _ rls rrs rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 1 1 a01{2}.[1] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 1 1 a01{2}.[1] _ _ rls rrs rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 1 0 a01{2}.[0] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 1 0 a01{2}.[0] _ _ rls rrs rl rr); rewrite /conversion. smt(). smt(). smt(). @@ -853,111 +838,111 @@ smt(). smt(). smt(). split. rewrite H H0. move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 0 2 a20{2}.[2] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 0 2 a20{2}.[2] _ _ rls rrs rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 0 0 a20{2}.[0] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 0 0 a20{2}.[0] _ _ rls rrs rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 0 3 a20{2}.[3] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 0 3 a20{2}.[3] _ _ rls rrs rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 0 1 a20{2}.[1] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 0 1 a20{2}.[1] _ _ rls rrs rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 2 2 a31{2}.[2] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 2 2 a31{2}.[2] _ _ rls rrs rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 2 0 a31{2}.[0] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 2 0 a31{2}.[0] _ _ rls rrs rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 2 3 a31{2}.[3] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 2 3 a31{2}.[3] _ _ rls rrs rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 2 1 a31{2}.[1] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 2 1 a31{2}.[1] _ _ rls rrs rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 3 0 a21{2}.[0] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 3 0 a21{2}.[0] _ _ rls rrs rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 3 1 a21{2}.[1] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 3 1 a21{2}.[1] _ _ rls rrs rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 3 2 a21{2}.[2] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 3 2 a21{2}.[2] _ _ rls rrs rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 3 3 a21{2}.[3] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 3 3 a21{2}.[3] _ _ rls rrs rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 4 1 a41{2}.[1] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 4 1 a41{2}.[1] _ _ rls rrs rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 4 3 a41{2}.[3] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 4 3 a41{2}.[3] _ _ rls rrs rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 4 0 a41{2}.[0] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 4 0 a41{2}.[0] _ _ rls rrs rl rr); rewrite /conversion. smt(). smt(). smt(). rewrite H H0. move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 4 2 a41{2}.[2] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 4 2 a41{2}.[2] _ _ rls rrs rl rr); rewrite /conversion. smt(). smt(). smt(). @@ -1106,56 +1091,56 @@ split; first by rewrite /rhotates; smt(roln rol0). split. rewrite H H0. move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 5 3 a11{2}.[3] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 5 3 a11{2}.[3] _ _ rls rrs rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 5 2 a11{2}.[2] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 5 2 a11{2}.[2] _ _ rls rrs rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 5 1 a11{2}.[1] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 5 1 a11{2}.[1] _ _ rls rrs rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 5 0 a11{2}.[0] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 5 0 a11{2}.[0] _ _ rls rrs rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 1 3 a01{2}.[3] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 1 3 a01{2}.[3] _ _ rls rrs rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 1 2 a01{2}.[2] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 1 2 a01{2}.[2] _ _ rls rrs rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 1 1 a01{2}.[1] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 1 1 a01{2}.[1] _ _ rls rrs rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 1 0 a01{2}.[0] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 1 0 a01{2}.[0] _ _ rls rrs rl rr); rewrite /conversion. smt(). smt(). smt(). @@ -1163,111 +1148,111 @@ smt(). smt(). smt(). split. rewrite H H0. move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 0 2 a20{2}.[2] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 0 2 a20{2}.[2] _ _ rls rrs rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 0 0 a20{2}.[0] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 0 0 a20{2}.[0] _ _ rls rrs rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 0 3 a20{2}.[3] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 0 3 a20{2}.[3] _ _ rls rrs rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 0 1 a20{2}.[1] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 0 1 a20{2}.[1] _ _ rls rrs rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 2 2 a31{2}.[2] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 2 2 a31{2}.[2] _ _ rls rrs rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 2 0 a31{2}.[0] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 2 0 a31{2}.[0] _ _ rls rrs rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 2 3 a31{2}.[3] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 2 3 a31{2}.[3] _ _ rls rrs rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 2 1 a31{2}.[1] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 2 1 a31{2}.[1] _ _ rls rrs rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 3 0 a21{2}.[0] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 3 0 a21{2}.[0] _ _ rls rrs rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 3 1 a21{2}.[1] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 3 1 a21{2}.[1] _ _ rls rrs rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 3 2 a21{2}.[2] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 3 2 a21{2}.[2] _ _ rls rrs rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 3 3 a21{2}.[3] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 3 3 a21{2}.[3] _ _ rls rrs rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 4 1 a41{2}.[1] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 4 1 a41{2}.[1] _ _ rls rrs rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 4 3 a41{2}.[3] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 4 3 a41{2}.[3] _ _ rls rrs rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 4 0 a41{2}.[0] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 4 0 a41{2}.[0] _ _ rls rrs rl rr); rewrite /conversion. smt(). smt(). smt(). rewrite H H0. move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 4 2 a41{2}.[2] _ _ rl rr); +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 4 2 a41{2}.[2] _ _ rls rrs rl rr); rewrite /conversion. smt(). smt(). smt(). From 85f0da971d963aed23262386be2417078e1cfed8 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Wed, 15 May 2019 16:58:16 +0200 Subject: [PATCH 413/525] fix some proofs --- proof/impl/libc/keccak_1600_scalar_modular.ec | 86 +++++++++++++------ 1 file changed, 62 insertions(+), 24 deletions(-) diff --git a/proof/impl/libc/keccak_1600_scalar_modular.ec b/proof/impl/libc/keccak_1600_scalar_modular.ec index 83ce6ad..2713945 100644 --- a/proof/impl/libc/keccak_1600_scalar_modular.ec +++ b/proof/impl/libc/keccak_1600_scalar_modular.ec @@ -271,21 +271,63 @@ admit. qed. *) require Keccak_f1600_scalar_table. -print Keccak_f1600_scalar_table.scalarcorr_op. -equiv modcorrect mem : + +op disj_ptr (p1 : address) (len1:int) (p2: address) ( len2:int) = + p1 + len1 <= p2 \/ p2 + len2 <= p1. + +op good_ptr (p : address) (len:int) = p + len < W64.modulus. + +lemma loadW64_storeW64_diff mem i j w: + j + 8 <= i \/ i + 8 <= j => + loadW64 (storeW64 mem i w) j = loadW64 mem j. +proof. + move=> hij; apply W8u8.wordP => k hk. + rewrite /loadW64 !W8u8.pack8bE 1,2:// !initiE 1,2:// /= storeW64E get_storesE /= /#. +qed. + +equiv eq_xtr_full_block iotas0: + Keccak_1600_ref_modular.Mmod.xtr_full_block ~ Mmod.xtr_full_block : + ={Glob.mem, state, out, outlen, rate} /\ + disj_ptr (to_uint out{1}) (to_uint outlen{1}) iotas0 224 /\ + good_ptr (to_uint out{1}) (to_uint outlen{1}) /\ rate{1} \ult outlen{1} /\ + Keccak_f1600_scalar_table.good_iotas Glob.mem{1} iotas0 + ==> + ={Glob.mem, res} /\ + disj_ptr (to_uint res{1}.`1) (to_uint res{2}.`2) iotas0 224 /\ + good_ptr (to_uint res{1}.`1) (to_uint res{2}.`2) /\ + Keccak_f1600_scalar_table.good_iotas Glob.mem{1} iotas0. +proof. + proc; wp => /=. + while (#pre /\ ={i,rate64} /\ 0 <= to_uint i{1} /\ 0 <= 8 * to_uint rate64{1} <= to_uint rate{1}). + + wp; skip => /> &2. + rewrite !ultE /good_ptr /disj_ptr /= => h1 h2 h3 h4 h5 h6 h7 h8; split. + + move=> x hx; rewrite loadW64_storeW64_diff; last by rewrite h4. + have h : to_uint (W64.of_int 8 * i{2}) = 8 * to_uint i{2}. + + rewrite W64.to_uintM_small /=; smt (W64.to_uint_cmp). + rewrite W64.to_uintD_small h /=; smt(). + rewrite W64.to_uintD_small /=; smt (W64.to_uint_cmp). + wp; skip => /> &2. + rewrite /W64.(`>>`) /= W64.to_uint_shr 1:// /good_ptr /disj_ptr /= !ultE => h1 h2 h3 h4. + split; 1: smt(W64.to_uint_cmp). + by move=> mem *; rewrite W64.to_uintD_small /= 1:/# W64.to_uintB 1:uleE /#. +qed. + +equiv modcorrect : Keccak_1600_ref_modular.Mmod.__keccak_1600 ~ Mmod.__keccak_1600 : - Glob.mem{2} = mem /\ Keccak_f1600_scalar_table.good_iotas mem (to_uint iotas{2}) /\ - 0 <= to_uint iotas{2} < W64.modulus - 24 * 8 /\ - (to_uint iotas{2} - 8 * 8) %% 256 = 0 /\ - in_0{1} = in_0{2} /\ inlen{1} = inlen{2} /\ s_out{1} = s_out{2} /\ s_outlen{1} = s_outlen{2} /\ rate{1} = rate{2} /\ - s_trail_byte{1} = s_trail_byte{2} /\ ={Glob.mem} ==> ={Glob.mem}. + Keccak_f1600_scalar_table.good_iotas Glob.mem{1} (to_uint iotas{2}) /\ + 0 <= to_uint iotas{2} < W64.modulus - 24 * 8 /\ + (to_uint iotas{2} - 8 * 8) %% 256 = 0 /\ + disj_ptr (to_uint s_out{1}) (to_uint s_outlen{1}) (to_uint iotas{2}) 224 /\ + good_ptr (to_uint s_out{1}) (to_uint s_outlen{1}) /\ + in_0{1} = in_0{2} /\ inlen{1} = inlen{2} /\ s_out{1} = s_out{2} /\ s_outlen{1} = s_outlen{2} /\ rate{1} = rate{2} /\ + s_trail_byte{1} = s_trail_byte{2} /\ ={Glob.mem} ==> ={Glob.mem}. proof. proc => /=. -+ seq 2 2 : (#pre /\ ={state}). +seq 2 2 : (#pre /\ ={state}). call(_:true); last by auto. - while (#post /\ to_uint i{2} = i{1} /\ i{2} \ule W64.of_int 25 /\ t{2} = W64.zero). ++ while (#post /\ to_uint i{2} = i{1} /\ i{2} \ule W64.of_int 25 /\ t{2} = W64.zero). + by auto => /> &2; rewrite ultE; smt(@W64). - auto => />; rewrite set0_64E => />. + by auto => />; rewrite set0_64E => />. seq 4 1 : #{/~in_0{1} = in_0{2}}{~inlen{1} = inlen{2}}pre. + inline Mmod.absorb. swap {2} [5..6] -2; swap {2} [2..4] -1; sp 0 3. @@ -296,29 +338,25 @@ seq 4 1 : #{/~in_0{1} = in_0{2}}{~inlen{1} = inlen{2}}pre. exlim Glob.mem{2}, iotas0{2} => memm _iotas. call (Keccak_f1600_scalar_table.scalarcorr_op (to_uint _iotas) memm). wp; call (_: ={Glob.mem}); first by sim. - auto => />; smt(@W64). + by auto => />; smt(@W64). wp; call (_: ={Glob.mem}); first by sim. by auto => />. inline Mmod.squeeze. swap {2} 6 -2; swap {2} [3..4] -2; sp 0 2. -seq 1 4 : (#{/~state{1} = state{2}}{~Glob.mem{2}=mem}{~s_out{1} = s_out{2}}{~s_outlen{1} = s_outlen{2}}pre /\ +seq 1 4 : (#{/~state{1} = state{2}}{~s_out{1} = s_out{2}}{~s_outlen{1} = s_outlen{2}}{~disj_ptr _ _ _ _}{~good_ptr _ _} pre /\ state0{2} = state{1} /\ outlen0{2} = outlen{1} /\ s_out0{2} = s_out{1} /\ - Keccak_f1600_scalar_table.good_iotas Glob.mem{2} (to_uint iotas{2})); first by auto => />. + disj_ptr (to_uint s_out{1}) (to_uint outlen{1}) (to_uint iotas{2}) 224 /\ + good_ptr (to_uint s_out{1}) (to_uint outlen{1}) /\ + Keccak_f1600_scalar_table.good_iotas Glob.mem{1} (to_uint iotas{2})); first by auto => />. seq 1 1 : #pre. + while (#post); last by auto. inline Mmod.load_3 Mmod.spill_2. - wp. - (* This one is invalid we need to show that Mmod.xtr_full_block does not touch iotas *) - call (_: ={Glob.mem}); first by sim. - wp. - exlim Glob.mem{2}, iotas0{2} => memm _iotas. - call (Keccak_f1600_scalar_table.scalarcorr_op (to_uint _iotas) memm). - wp;skip => />. - progress. smt(@W64). admit. (* what am I missing? The post condition in the call seems to ensure mem_R = memm bit this is not in the context *) + wp; ecall (eq_xtr_full_block (to_uint iotas{2})). + wp; ecall (Keccak_f1600_scalar_table.scalarcorr_op (to_uint iotas{2}) Glob.mem{1}). + by wp;skip => /> *; rewrite W64.to_uint_eq. seq 2 2 : (#pre /\ s_outlen{1} = s_outlen0{2}). -+ exlim Glob.mem{2}, iotas0{2} => memm _iotas. - call (Keccak_f1600_scalar_table.scalarcorr_op (to_uint _iotas) memm). ++ ecall (Keccak_f1600_scalar_table.scalarcorr_op (to_uint iotas0{2}) Glob.mem{2}). by wp;skip=> />; smt(@W64). inline *. -by sim. +sim. qed. From 93efffde690703e198db8b06859c66f1c2b4fdc1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jos=C3=A9=20Bacelar=20Almeida?= Date: Wed, 15 May 2019 16:58:29 +0100 Subject: [PATCH 414/525] progress --- proof/impl/keccak_1600_corr.ec | 199 +++++++++++++++++++++++++++++++-- proof/impl/keccak_1600_ref.ec | 8 +- 2 files changed, 191 insertions(+), 16 deletions(-) diff --git a/proof/impl/keccak_1600_corr.ec b/proof/impl/keccak_1600_corr.ec index d7c3320..76b7df4 100644 --- a/proof/impl/keccak_1600_corr.ec +++ b/proof/impl/keccak_1600_corr.ec @@ -586,30 +586,108 @@ proof. by conseq add_final_block_spec_ll (add_final_block_spec_h st in_ inlen_ trail_byte_). qed. +op stores64 (m: global_mem_t) (a:address) (w: W64.t list): global_mem_t = + foldl (fun (m0 : global_mem_t) (i : int) => storeW64 m0 (a + 8*i) (nth W64.zero w i)) + m (iota_ 0 (size w)). + +lemma stores64_nil mem a: stores64 mem a [] = mem by done. + +lemma stores64_singl mem a x: stores64 mem a [x] = storeW64 mem a x by done. + +hint simplify stores64_nil, stores64_singl. + +lemma foldl_map ['a 'b 'c] (h:'a->'b) (f:'c ->'b->'c) (z:'c) l: + foldl f z (List.map h l) = foldl (fun b a => f b (h a)) z l. +proof. +elim: l f z => //= x xs IH f z. +by rewrite IH. +qed. + +lemma stores64_cat mem out l1 l2: + stores64 mem out (l1 ++ l2) + = stores64 (stores64 mem out l1) (out + 8*size l1) l2. +proof. +rewrite /stores64 size_cat iota_add; first 2 smt(size_ge0). +rewrite (addzC 0) iota_addl foldl_cat foldl_map /=. +have ->: foldl (fun (m0 : global_mem_t) (i : int) => + storeW64 m0 (out + 8 * i) (nth W64.zero (l1 ++ l2) i)) mem + (iota_ 0 (size l1)) + = foldl (fun (m0 : global_mem_t) (i : int) => + storeW64 m0 (out + 8 * i) (nth W64.zero l1 i)) mem + (iota_ 0 (size l1)). + apply foldl_in_eq => mem' x; rewrite mem_iota => |> *. + by rewrite nth_cat H0. +apply foldl_in_eq => mem' x; rewrite mem_iota => |> *. +case: (x=0) => E. + by rewrite E /= nth_cat ltzz. +rewrite nth_cat (:! size l1 + x < size l1) 1:/# /=; congr; first smt(). +congr; smt(). +qed. + +lemma stores64_cons mem a x xs: + stores64 mem a (x::xs) = stores64 (storeW64 mem a x) (a+8) xs. +proof. by rewrite -cat1s stores64_cat. qed. + +lemma stores64_rcons mem out xs x: + stores64 mem out (rcons xs x) + = storeW64 (stores64 mem out xs) (out + 8*size xs) x. +proof. by rewrite -cats1 stores64_cat. qed. + +lemma nth_squeezestate st i: + 0 <= i < rate64 => + nth W64.zero (squeezestate st) i = st.[i]. +proof. +move=> Hi; rewrite /squeezestate nth_take; first 2 smt(rate64_bnds). +rewrite -(nth_inside witness). + rewrite Array25.size_to_list; first smt(rate64_bnds). +by apply Array25.get_to_list. +qed. + lemma xtr_full_block_spec_h mem st out_ outlen_: hoare [ M.xtr_full_block: Glob.mem = mem /\ state = st /\ out = out_ /\ outlen = outlen_ + /\ rate8 <= to_uint outlen /\ to_uint rate = rate8 + /\ good_ptr out_ rate8 ==> - Glob.mem = stores mem (to_uint out_) (xtrbytes rate8 (squeezestate st)) + Glob.mem = stores64 mem (to_uint out_) (squeezestate st) /\ to_uint res.`1 = to_uint out_ + rate8 /\ to_uint res.`2 = to_uint outlen_ - rate8 ]. proof. proc; simplify. -admit. +wp; while (state = st /\ out = out_ /\ outlen = outlen_ /\ good_ptr out_ rate8 /\ + to_uint r64 = rate64 /\ 0 <= to_uint i <= to_uint r64 /\ + Glob.mem = stores64 mem (to_uint out_) (take (to_uint i) (squeezestate st))). + wp; skip; rewrite ultE => |> *. + rewrite (: to_uint (i{hr} + W64.one) = to_uint i{hr} + 1). + rewrite to_uintD_small of_uintK modz_small //. + move: H3; rewrite ltzE; smt(rate64_bnds). + progress; first 2 smt(). + rewrite (take_nth W64.zero); first by rewrite size_squeezestate /#. + rewrite stores64_rcons; congr. + rewrite to_uintD_small to_uintM_small of_uintK modz_small //; smt. + rewrite nth_squeezestate; smt(rate64_bnds). +wp; skip => |> *; progress. ++ by rewrite to_uint_shr of_uintK modz_small // /#. ++ by rewrite to_uint_shr of_uintK modz_small //; smt(rate64_bnds). ++ by rewrite take0. ++ have ->: to_uint i0 = rate64 by smt. + by rewrite take_oversize // size_squeezestate. ++ by rewrite to_uintD_small H0. ++ by rewrite to_uintB ?uleE /#. qed. lemma xtr_full_block_spec_ll: islossless M.xtr_full_block. proof. -islossless. while true (to_uint rate64 - to_uint i). +islossless. while true (to_uint r64 - to_uint i). move=> ?; wp; skip; progress. move: H; rewrite ultE => ?. rewrite to_uintD_small of_uintK modz_small // 2:/#. - by have /# := W64.to_uint_cmp rate64{hr}. + by have /# := W64.to_uint_cmp r64{hr}. by skip; progress; rewrite ultE /#. qed. @@ -619,9 +697,12 @@ lemma xtr_full_block_spec mem st out_ outlen_: /\ state = st /\ out = out_ /\ outlen = outlen_ + /\ rate8 <= to_uint outlen /\ to_uint rate = rate8 + /\ good_ptr out_ rate8 ==> - Glob.mem = stores mem (to_uint out_) (xtrbytes rate8 (squeezestate st)) +(* Glob.mem = stores mem (to_uint out_) (xtrbytes rate8 (squeezestate st))*) + Glob.mem = stores64 mem (to_uint out_) (squeezestate st) /\ to_uint res.`1 = to_uint out_ + rate8 /\ to_uint res.`2 = to_uint outlen_ - rate8 ] = 1%r. @@ -629,18 +710,106 @@ proof. by conseq xtr_full_block_spec_ll (xtr_full_block_spec_h mem st out_ outlen_). qed. -print M. +print xtrbytes. +lemma stores64_stores mem out l: + stores64 mem out l = stores mem out (xtrbytes (8*size l) l). +proof. +admit. +qed. + +lemma stores_nil mem out: stores mem out [] = mem by done. + +lemma stores_singl mem out x: stores mem out [x] = storeW8 mem out x. +proof. by rewrite storeW8E /stores. qed. + +hint simplify stores_nil, stores_singl. + +lemma stores_cons' mem out x xs: + stores mem out (x::xs) = stores (storeW8 mem out x) (out+1) xs. +proof. by rewrite -cat1s stores_cat. qed. + +lemma stores_rcons mem out x xs: + stores mem out (rcons xs x) = storeW8 (stores mem out xs) (out + size xs) x. +proof. by rewrite -cats1 stores_cat. qed. + lemma xtr_bytes_spec_h mem st out_ outlen_: hoare [ M.xtr_bytes: Glob.mem = mem /\ state = st /\ out = out_ /\ outlen = outlen_ + /\ to_uint outlen_ <= rate8 + /\ good_ptr out_ (to_uint outlen_) ==> - Glob.mem = stores mem (to_uint out_) (xtrbytes (to_uint outlen_) (squeezestate st)) ]. + Glob.mem = stores mem (to_uint out_) (xtrbytes (to_uint outlen_) + (squeezestate st)) ]. proof. proc; simplify. -admit. +while (#[2,-2:]pre /\ outlen_ = outlen /\ out_ = out /\ + to_uint outlen_ %/ 8 * 8 <= to_uint i <= to_uint outlen_ /\ + Glob.mem = stores mem (to_uint out_) (xtrbytes (to_uint i) + (squeezestate st))). + wp; skip; rewrite !ultE => |> *. + have ->: to_uint (i{hr} + W64.one) = to_uint i{hr} + 1. + rewrite to_uintD_small of_uintK modz_small //. + by move: H2 (W64.to_uint_cmp outlen{hr}); rewrite ltzE /#. + progress. + + smt(). + + smt(). + + rewrite /xtrbytes (take_nth W8.zero). + rewrite size_w64L2w8L size_squeezestate; smt. + rewrite stores_rcons; congr. + rewrite to_uintD_small 1:/# size_take; first smt(W64.to_uint_cmp). + rewrite size_w64L2w8L size_squeezestate. + by rewrite (:to_uint i{hr} < 8 * rate64) 1:/#. + admit (* +(get8 ((init64 ("_.[_]" state{hr})))%WArray200.WArray200 (to_uint i{hr}))%WArray200.WArray200 = +(w64L2w8L (squeezestate state{hr})).[to_uint i{hr}] +*). +wp; while (#[2:]pre /\ 0 <= to_uint i <= to_uint outlen_ %/ 8 /\ out = out_ /\ + to_uint outlen8 = to_uint outlen %/ 8 /\ + Glob.mem = stores64 mem (to_uint out_) (take (to_uint i) (squeezestate st))). + wp; skip; rewrite !ultE => |> *. + have ->: to_uint (i{hr} + W64.one) = to_uint i{hr} + 1. + rewrite to_uintD_small of_uintK modz_small //. + by move: H2 (W64.to_uint_cmp outlen{hr}); rewrite ltzE /#. + have ->: to_uint (out{hr} + W64.of_int 8 * i{hr}) + = to_uint out{hr} + 8 * to_uint i{hr}. + rewrite to_uintD_small to_uintM_small of_uintK modz_small //. + smt. smt. smt. + progress. + + smt(). + + smt(). + + rewrite (take_nth W64.zero). + rewrite size_squeezestate. smt(rate64_bnds). + admit (* +storeW64 (stores64 mem (to_uint out{hr}) (squeezestate state{hr})) + (to_uint out{hr} + 8 * to_uint i{hr}) state{hr}.[to_uint i{hr}] = +stores64 mem (to_uint out{hr}) (squeezestate state{hr}) +*). +wp; skip => |> *; progress. ++ smt. ++ by rewrite to_uint_shr of_uintK modz_small //. ++ by rewrite take0. ++ move: {H4} H1; rewrite ultE. + have ->: to_uint (outlen{hr} `>>` (of_int 3)%W8) = to_uint outlen{hr} %/ 8. + by rewrite to_uint_shr of_uintK modz_small. + move=> ?; have ->: to_uint (i0 `<<` (of_int 3)%W8) = to_uint i0 * 8. + rewrite to_uint_shl of_uintK modz_small //=. + apply bound_abs; split; first smt(). + move=> ?; smt. + smt(). ++ rewrite to_uint_shl of_uintK modz_small //=; first smt. + smt(). ++ rewrite to_uint_shl of_uintK modz_small //=; first smt. + rewrite stores64_stores; congr. + admit (* +xtrbytes (8 * size (take (to_uint i0) (squeezestate state{hr}))) + (take (to_uint i0) (squeezestate state{hr})) = +xtrbytes (to_uint i0 * 8) (squeezestate state{hr}) +*). ++ have ->: to_uint i1 = to_uint outlen{hr} by smt. + done. qed. lemma xtr_bytes_spec_ll: islossless M.xtr_bytes. @@ -664,8 +833,11 @@ lemma xtr_bytes_spec mem st out_ outlen_: /\ state = st /\ out = out_ /\ outlen = outlen_ + /\ to_uint outlen_ <= rate8 + /\ good_ptr out_ (to_uint outlen_) ==> - Glob.mem = stores mem (to_uint out_) (xtrbytes (to_uint outlen_) (squeezestate st)) + Glob.mem = stores mem (to_uint out_) (xtrbytes (to_uint outlen_) + (squeezestate st)) ] = 1%r. proof. by conseq xtr_bytes_spec_ll (xtr_bytes_spec_h mem st out_ outlen_). qed. @@ -707,12 +879,14 @@ wp; while (st{1}=state{2} /\ to_uint rate{2}=rate8 /\ wp; ecall {2} (xtr_full_block_spec Glob.mem{2} state{2} out{2} outlen{2}); simplify. wp; ecall {2} (permutation_instantiation Glob.mem{2} state{2}); simplify. wp; skip; rewrite !ultE; progress. - + rewrite size_cat H6 H0 size_xtrbytes; smt(rate8_bnds). + smt(). + smt(). - + by rewrite H0 stores_cat. + + rewrite size_cat H8 H0 size_xtrbytes; smt(rate8_bnds). + + smt(). + + smt(). + + by rewrite H0 stores_cat stores64_stores size_squeezestate. + by rewrite !ultE /#. - + by move: H8; rewrite ultE /#. + + by move: H10; rewrite ultE /#. wp; ecall {2} (add_final_block_spec state{2} in_0{2} inlen{2} trail_byte{2}); simplify. wp; while (st{1}=state{2} /\ to_uint rate{2} = rate8 /\ m{1} = memread Glob.mem{2} (to_uint in_0{2}) (to_uint inlen{2}) /\ @@ -746,6 +920,7 @@ wp; call {2} st0_spec; wp; skip; rewrite /inv_ptr => |> *; progress. by apply W8.word_modeqP; rewrite to_uint_truncateu8 modz_mod H2. + by rewrite ultE H6. + by move: H9; rewrite ultE H6. ++ by move: H10; rewrite ultE H11; smt(). + by rewrite H12 -stores_cat. qed. diff --git a/proof/impl/keccak_1600_ref.ec b/proof/impl/keccak_1600_ref.ec index a5884e8..d7392c6 100644 --- a/proof/impl/keccak_1600_ref.ec +++ b/proof/impl/keccak_1600_ref.ec @@ -347,15 +347,15 @@ module M = { proc xtr_full_block (state:W64.t Array25.t, out:W64.t, outlen:W64.t, rate:W64.t) : W64.t * W64.t = { - var rate64:W64.t; + var r64:W64.t; var i:W64.t; var t:W64.t; - rate64 <- rate; - rate64 <- (rate64 `>>` (W8.of_int 3)); + r64 <- rate; + r64 <- (r64 `>>` (W8.of_int 3)); i <- (W64.of_int 0); - while ((i \ult rate64)) { + while ((i \ult r64)) { t <- state.[(W64.to_uint i)]; Glob.mem <- storeW64 Glob.mem (W64.to_uint (out + ((W64.of_int 8) * i))) t; From 91eca68e266d521bcdc71da032cad80238d49e18 Mon Sep 17 00:00:00 2001 From: Manuel Barbosa Date: Wed, 15 May 2019 20:06:10 +0100 Subject: [PATCH 415/525] Cleaning admits --- proof/impl/perm/keccak_f1600_avx2.ec | 5 +- proof/impl/perm/keccak_f1600_avx2_prevec.ec | 257 ++++++++++---------- 2 files changed, 138 insertions(+), 124 deletions(-) diff --git a/proof/impl/perm/keccak_f1600_avx2.ec b/proof/impl/perm/keccak_f1600_avx2.ec index 5282e84..2130b47 100644 --- a/proof/impl/perm/keccak_f1600_avx2.ec +++ b/proof/impl/perm/keccak_f1600_avx2.ec @@ -855,7 +855,10 @@ op em_states (state : W256.t Array7.t, st : W64.t Array25.t) : bool = lemma avx2corr st _iotas mem : equiv [ Keccak_f1600_ref.M.__keccak_f1600_ref ~ M.__keccak_f1600_avx2 : - Glob.mem{2} = mem /\ Keccak_f1600_avx2_prevec.good_io4x mem (W64.to_uint _iotas{2}) /\ + W64.to_uint _rhotates_left{2} + 192 < W64.modulus /\ + W64.to_uint _rhotates_right{2} + 192 < W64.modulus /\ + W64.to_uint _iotas{2} + 768 < W64.modulus /\ Glob.mem{2} = mem /\ + Keccak_f1600_avx2_prevec.good_io4x mem (W64.to_uint _iotas{2}) /\ good_rhol mem (to_uint _rhotates_left{2}) /\ good_rhor mem (to_uint _rhotates_right{2}) /\ em_states state{2} state{1} /\ st = state{1} ==> diff --git a/proof/impl/perm/keccak_f1600_avx2_prevec.ec b/proof/impl/perm/keccak_f1600_avx2_prevec.ec index be9ef8c..c2da8c8 100644 --- a/proof/impl/perm/keccak_f1600_avx2_prevec.ec +++ b/proof/impl/perm/keccak_f1600_avx2_prevec.ec @@ -489,7 +489,7 @@ progress. smt. qed. op good_io4x (mem : global_mem_t, _iotas : int) = - forall off, 0 <= off < 24 => + forall off, 0 <= off < 4 * 24 => loadW64 mem (_iotas + (off * 8)) = good_iotas4x.[off]. op good_rhol (mem : global_mem_t, _rhotates_left : int) = @@ -574,17 +574,16 @@ proof. smt (Array4.get_setE). qed. -print good_iotas. lemma loadlift_iotas : forall (mem : global_mem_t) (x : W64.t) (off : int), to_uint x + 768 < W64.modulus => - good_io4x mem (to_uint x) => 0 <= off < 6 => + good_io4x mem (to_uint x) => 0 <= off < 24 => lift2array (loadW256 mem (to_uint (x + W64.of_int (8 * 4 * off)))) = (witness - .[0 <- good_iotas4x.[4*off + 0]] - .[1 <- good_iotas4x.[4*off + 1]] - .[2 <- good_iotas4x.[4*off + 2]] - .[3 <- good_iotas4x.[4*off + 3]])%Array4. + .[0 <- good_iotas4x.[off * 4 + 0]] + .[1 <- good_iotas4x.[off * 4 + 1]] + .[2 <- good_iotas4x.[off * 4 + 2]] + .[3 <- good_iotas4x.[off * 4 + 3]])%Array4. proof. move=> mem x off /= hx hgood hoff. rewrite -load4u64 /lift2array; apply Array4.tP => i hi. @@ -596,8 +595,8 @@ proof. have -> : to_uint x + 32 * off + 24 = to_uint x + (4 * off + 3) * 8 by ring. have -> : to_uint x + 32 * off + 16 = to_uint x + (4 * off + 2) * 8 by ring. have -> : to_uint x + 32 * off + 8 = to_uint x + (4 * off + 1) * 8 by ring. - have -> : 32 * off = (4 * off) * 8 by ring. - rewrite !hgood 1..4:/#. smt (Array4.get_setE). + have -> : 32 * off = (4 * off) * 8 by ring. + move : (hgood (off * 4 + i) _) => />. smt. smt (Array4.get_setE). qed. op conversion(o1 o2 : int) : int = @@ -697,9 +696,9 @@ qed. lemma correct_perm _a00 _a01 _a20 _a31 _a21 _a41 _a11 st mem: equiv [ Mreftable.__keccak_f1600_ref ~ Mavx2_prevec.__KeccakF1600 : - to_uint _rhotates_left{2} + 192 < W64.modulus => - to_uint _rhotates_right{2} + 192 < W64.modulus => - to_uint _iotas{2} + 768 < W64.modulus => + to_uint _rhotates_left{2} + 192 < W64.modulus /\ + to_uint _rhotates_right{2} + 192 < W64.modulus /\ + to_uint _iotas{2} + 768 < W64.modulus /\ Glob.mem{2} = mem /\ good_io4x mem (to_uint _iotas{2}) /\ good_rhol mem (to_uint _rhotates_left{2}) /\ good_rhor mem (to_uint _rhotates_right{2}) /\ equiv_states _a00 _a01 _a20 _a31 _a21 _a41 _a11 st /\ @@ -719,6 +718,9 @@ seq 1 105 : (#{/~a00{2}}{~a01{2}}{~a20{2}}{~a31{2}}{~a21{2}}{~a41{2}}{~a11{2}}{~ good_io4x mem (to_uint _iotas{2}) /\ good_rhol mem (to_uint _rhotates_left{2}) /\ good_rhor mem (to_uint _rhotates_right{2}) /\ + to_uint _rhotates_left{2} + 192 < W64.modulus /\ + to_uint _rhotates_right{2} + 192 < W64.modulus /\ + to_uint _iotas{2} + 768 < W64.modulus /\ equiv_states a00{2} a01{2} a20{2} a31{2} a21{2} a41{2} a11{2} state{1}). seq 0 0 : (#pre /\ (constants{1}.[round{1}])%Array24 = W64.of_int 1). @@ -739,6 +741,8 @@ swap {2} 46 -17. seq 9 29 : (#{/~state{1}}post /\ c{1} = W64.of_int 1 /\ equiv_states a00{2} a01{2} a20{2} a31{2} a21{2} a41{2} a11{2} state0{1}). + + do 13!(unroll for {1} ^while). @@ -780,173 +784,172 @@ split; first by rewrite /rhotates; smt(roln rol0). split. rewrite H H0. -move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 5 3 a11{2}.[3] _ _ rls rrs rl rr); +move : H36 H37 H38 H39; rewrite -H5 => rl rr rls rrs. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 5 3 a11{2}.[3] rls rrs _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. -move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 5 2 a11{2}.[2] _ _ _ rls rrs rl rr); +move : H36 H37 H38 H39; rewrite -H5 => rl rr rls rrs. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 5 2 a11{2}.[2] rls rrs _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. -move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 5 1 a11{2}.[1] _ _ _ rls rrs rl rr); +move : H36 H37 H38 H39; rewrite -H5 => rl rr rls rrs. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 5 1 a11{2}.[1] rls rrs _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. -move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 5 0 a11{2}.[0] _ _ _ rls rrs rl rr); +move : H36 H37 H38 H39; rewrite -H5 => rl rr rls rrs. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 5 0 a11{2}.[0] rls rrs _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. -move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 1 3 a01{2}.[3] _ _ rls rrs rl rr); +move : H36 H37 H38 H39; rewrite -H5 => rl rr rls rrs. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 1 3 a01{2}.[3] rls rrs _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. -move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 1 2 a01{2}.[2] _ _ rls rrs rl rr); +move : H36 H37 H38 H39; rewrite -H5 => rl rr rls rrs. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 1 2 a01{2}.[2] rls rrs _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. -move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 1 1 a01{2}.[1] _ _ rls rrs rl rr); +move : H36 H37 H38 H39; rewrite -H5 => rl rr rls rrs. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 1 1 a01{2}.[1] rls rrs _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. -move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 1 0 a01{2}.[0] _ _ rls rrs rl rr); +move : H36 H37 H38 H39; rewrite -H5 => rl rr rls rrs. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 1 0 a01{2}.[0] rls rrs _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. -move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 0 2 a20{2}.[2] _ _ rls rrs rl rr); +move : H36 H37 H38 H39; rewrite -H5 => rl rr rls rrs. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 0 2 a20{2}.[2] rls rrs _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. -move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 0 0 a20{2}.[0] _ _ rls rrs rl rr); +move : H36 H37 H38 H39; rewrite -H5 => rl rr rls rrs. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 0 0 a20{2}.[0] rls rrs _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. -move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 0 3 a20{2}.[3] _ _ rls rrs rl rr); +move : H36 H37 H38 H39; rewrite -H5 => rl rr rls rrs. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 0 3 a20{2}.[3] rls rrs _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. -move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 0 1 a20{2}.[1] _ _ rls rrs rl rr); +move : H36 H37 H38 H39; rewrite -H5 => rl rr rls rrs. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 0 1 a20{2}.[1] rls rrs _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. -move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 2 2 a31{2}.[2] _ _ rls rrs rl rr); +move : H36 H37 H38 H39; rewrite -H5 => rl rr rls rrs. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 2 2 a31{2}.[2] rls rrs _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. -move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 2 0 a31{2}.[0] _ _ rls rrs rl rr); +move : H36 H37 H38 H39; rewrite -H5 => rl rr rls rrs. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 2 0 a31{2}.[0] rls rrs _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. -move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 2 3 a31{2}.[3] _ _ rls rrs rl rr); +move : H36 H37 H38 H39; rewrite -H5 => rl rr rls rrs. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 2 3 a31{2}.[3] rls rrs _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. -move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 2 1 a31{2}.[1] _ _ rls rrs rl rr); +move : H36 H37 H38 H39; rewrite -H5 => rl rr rls rrs. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 2 1 a31{2}.[1] rls rrs _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. -move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 3 0 a21{2}.[0] _ _ rls rrs rl rr); +move : H36 H37 H38 H39; rewrite -H5 => rl rr rls rrs. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 3 0 a21{2}.[0] rls rrs _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. -move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 3 1 a21{2}.[1] _ _ rls rrs rl rr); +move : H36 H37 H38 H39; rewrite -H5 => rl rr rls rrs. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 3 1 a21{2}.[1] rls rrs _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. -move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 3 2 a21{2}.[2] _ _ rls rrs rl rr); +move : H36 H37 H38 H39; rewrite -H5 => rl rr rls rrs. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 3 2 a21{2}.[2] rls rrs _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. -move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 3 3 a21{2}.[3] _ _ rls rrs rl rr); +move : H36 H37 H38 H39; rewrite -H5 => rl rr rls rrs. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 3 3 a21{2}.[3] rls rrs _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. -move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 4 1 a41{2}.[1] _ _ rls rrs rl rr); +move : H36 H37 H38 H39; rewrite -H5 => rl rr rls rrs. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 4 1 a41{2}.[1] rls rrs _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. -move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 4 3 a41{2}.[3] _ _ rls rrs rl rr); +move : H36 H37 H38 H39; rewrite -H5 => rl rr rls rrs. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 4 3 a41{2}.[3] rls rrs _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. -move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 4 0 a41{2}.[0] _ _ rls rrs rl rr); +move : H36 H37 H38 H39; rewrite -H5 => rl rr rls rrs. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 4 0 a41{2}.[0] rls rrs _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). rewrite H H0. -move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 4 2 a41{2}.[2] _ _ rls rrs rl rr); +move : H36 H37 H38 H39; rewrite -H5 => rl rr rls rrs. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 4 2 a41{2}.[2] rls rrs _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). - (* Chi *) inline Mreftable.chi. @@ -1006,10 +1009,12 @@ split; first by smt(). rewrite /equiv_states /index /y_R. simplify. -move : (loadlift_iotas Glob.mem{2} (iotas{2}) 0) => //= ii. -rewrite ii. simplify. -smt(@W64). -rewrite /good_iotas4x. +split; first by auto => />. +split; first by auto => />. +split; first by auto => />. +move : H40 H35; rewrite -H1 -H5 => iii iv. +move : (loadlift_iotas Glob.mem{2} (iotas{2}) 0 iii iv); rewrite /good_iotas4x => //= ii. +rewrite ii. simplify. smt(@W64). @@ -1090,169 +1095,169 @@ split; first by rewrite /rhotates; smt(roln rol0). split. rewrite H H0. -move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 5 3 a11{2}.[3] _ _ rls rrs rl rr); +move : H5 H6 H7 H8; rewrite -H2 => rl rr rls rrs. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 5 3 a11{2}.[3] rls rrs _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. -move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 5 2 a11{2}.[2] _ _ rls rrs rl rr); +move : H5 H6 H7 H8; rewrite -H2 => rl rr rls rrs. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 5 2 a11{2}.[2] rls rrs _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. -move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 5 1 a11{2}.[1] _ _ rls rrs rl rr); +move : H5 H6 H7 H8; rewrite -H2 => rl rr rls rrs. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 5 1 a11{2}.[1] rls rrs _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. -move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 5 0 a11{2}.[0] _ _ rls rrs rl rr); +move : H5 H6 H7 H8; rewrite -H2 => rl rr rls rrs. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 5 0 a11{2}.[0] rls rrs _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. -move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 1 3 a01{2}.[3] _ _ rls rrs rl rr); +move : H5 H6 H7 H8; rewrite -H2 => rl rr rls rrs. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 1 3 a01{2}.[3] rls rrs _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. -move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 1 2 a01{2}.[2] _ _ rls rrs rl rr); +move : H5 H6 H7 H8; rewrite -H2 => rl rr rls rrs. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 1 2 a01{2}.[2] rls rrs _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. -move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 1 1 a01{2}.[1] _ _ rls rrs rl rr); +move : H5 H6 H7 H8; rewrite -H2 => rl rr rls rrs. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 1 1 a01{2}.[1] rls rrs _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. -move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 1 0 a01{2}.[0] _ _ rls rrs rl rr); +move : H5 H6 H7 H8; rewrite -H2 => rl rr rls rrs. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 1 0 a01{2}.[0] rls rrs _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. -move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 0 2 a20{2}.[2] _ _ rls rrs rl rr); +move : H5 H6 H7 H8; rewrite -H2 => rl rr rls rrs. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 0 2 a20{2}.[2] rls rrs _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. -move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 0 0 a20{2}.[0] _ _ rls rrs rl rr); +move : H5 H6 H7 H8; rewrite -H2 => rl rr rls rrs. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 0 0 a20{2}.[0] rls rrs _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. -move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 0 3 a20{2}.[3] _ _ rls rrs rl rr); +move : H5 H6 H7 H8; rewrite -H2 => rl rr rls rrs. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 0 3 a20{2}.[3] rls rrs _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. -move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 0 1 a20{2}.[1] _ _ rls rrs rl rr); +move : H5 H6 H7 H8; rewrite -H2 => rl rr rls rrs. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 0 1 a20{2}.[1] rls rrs _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. -move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 2 2 a31{2}.[2] _ _ rls rrs rl rr); +move : H5 H6 H7 H8; rewrite -H2 => rl rr rls rrs. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 2 2 a31{2}.[2] rls rrs _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. -move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 2 0 a31{2}.[0] _ _ rls rrs rl rr); +move : H5 H6 H7 H8; rewrite -H2 => rl rr rls rrs. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 2 0 a31{2}.[0] rls rrs _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. -move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 2 3 a31{2}.[3] _ _ rls rrs rl rr); +move : H5 H6 H7 H8; rewrite -H2 => rl rr rls rrs. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 2 3 a31{2}.[3] rls rrs _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. -move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 2 1 a31{2}.[1] _ _ rls rrs rl rr); +move : H5 H6 H7 H8; rewrite -H2 => rl rr rls rrs. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 2 1 a31{2}.[1] rls rrs _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. -move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 3 0 a21{2}.[0] _ _ rls rrs rl rr); +move : H5 H6 H7 H8; rewrite -H2 => rl rr rls rrs. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 3 0 a21{2}.[0] rls rrs _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. -move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 3 1 a21{2}.[1] _ _ rls rrs rl rr); +move : H5 H6 H7 H8; rewrite -H2 => rl rr rls rrs. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 3 1 a21{2}.[1] rls rrs _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. -move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 3 2 a21{2}.[2] _ _ rls rrs rl rr); +move : H5 H6 H7 H8; rewrite -H2 => rl rr rls rrs. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 3 2 a21{2}.[2] rls rrs _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. -move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 3 3 a21{2}.[3] _ _ rls rrs rl rr); +move : H5 H6 H7 H8; rewrite -H2 => rl rr rls rrs. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 3 3 a21{2}.[3] rls rrs _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. -move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 4 1 a41{2}.[1] _ _ rls rrs rl rr); +move : H5 H6 H7 H8; rewrite -H2 => rl rr rls rrs. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 4 1 a41{2}.[1] rls rrs _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. -move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 4 3 a41{2}.[3] _ _ rls rrs rl rr); +move : H5 H6 H7 H8; rewrite -H2 => rl rr rls rrs. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 4 3 a41{2}.[3] rls rrs _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). split. rewrite H H0. -move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 4 0 a41{2}.[0] _ _ rls rrs rl rr); +move : H5 H6 H7 H8; rewrite -H2 => rl rr rls rrs. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 4 0 a41{2}.[0] rls rrs _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). rewrite H H0. -move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 4 2 a41{2}.[2] _ _ rls rrs rl rr); +move : H5 H6 H7 H8; rewrite -H2 => rl rr rls rrs. +move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 4 2 a41{2}.[2] rls rrs _ _ rl rr); rewrite /conversion. smt(). smt(). smt(). @@ -1305,7 +1310,6 @@ split; first by smt(@W64). split; first by smt(@W64). smt(@W64). - (* iota *) seq 2 1 : (#{/~ state0{1}}pre /\ @@ -1314,9 +1318,11 @@ seq 2 1 : (#{/~ state0{1}}pre /\ inline *; wp; skip; rewrite /equiv_states /index; progress. -move : (loadlift_iotas Glob.mem{2} _iotas{2}(round{1})) => ii. +have iii : (to_uint _iotas{2} + 768 < W64.modulus); first by smt. +have iv : (good_io4x Glob.mem{2} (to_uint _iotas{2})); first by smt. +move : (loadlift_iotas Glob.mem{2} _iotas{2} (round{1}) iii iv) => ii. rewrite (_:round{1} * 32 = 8*4*round{1}); first by smt(). -rewrite ii. simplify. smt(). smt(). +rewrite ii. simplify. smt(). rewrite /good_iotas4x /iotas. case (round{1} = 0); first by auto => />. case (round{1} = 1). auto => />. smt(@W64). @@ -1344,9 +1350,11 @@ case (round{1} = 22). auto => />. smt(@W64). case (round{1} = 23). auto => />. smt(@W64). smt(). -move : (loadlift_iotas Glob.mem{2} _iotas{2}(round{1})) => ii. +have iii : (to_uint _iotas{2} + 768 < W64.modulus); first by smt. +have iv : (good_io4x Glob.mem{2} (to_uint _iotas{2})); first by smt. +move : (loadlift_iotas Glob.mem{2} _iotas{2} (round{1}) iii iv) => ii. rewrite (_:round{1} * 32 = 8*4*round{1}); first by smt(). -rewrite ii. simplify. smt(). smt(). +rewrite ii. simplify. smt(). rewrite /good_iotas4x /iotas. case (round{1} = 0); first by auto => />. case (round{1} = 1). auto => />. smt(@W64). @@ -1374,9 +1382,11 @@ case (round{1} = 22). auto => />. smt(@W64). case (round{1} = 23). auto => />. smt(@W64). smt(). -move : (loadlift_iotas Glob.mem{2} _iotas{2}(round{1})) => ii. +have iii : (to_uint _iotas{2} + 768 < W64.modulus); first by smt. +have iv : (good_io4x Glob.mem{2} (to_uint _iotas{2})); first by smt. +move : (loadlift_iotas Glob.mem{2} _iotas{2} (round{1}) iii iv) => ii. rewrite (_:round{1} * 32 = 8*4*round{1}); first by smt(). -rewrite ii. simplify. smt(). smt(). +rewrite ii. simplify. smt(). rewrite /good_iotas4x /iotas. case (round{1} = 0); first by auto => />. case (round{1} = 1). auto => />. smt(@W64). @@ -1404,10 +1414,11 @@ case (round{1} = 22). auto => />. smt(@W64). case (round{1} = 23). auto => />. smt(@W64). smt(). -move : (loadlift_iotas Glob.mem{2} _iotas{2}(round{1})) => ii. +have iii : (to_uint _iotas{2} + 768 < W64.modulus); first by smt. +have iv : (good_io4x Glob.mem{2} (to_uint _iotas{2})); first by smt. +move : (loadlift_iotas Glob.mem{2} _iotas{2} (round{1}) iii iv) => ii. rewrite (_:round{1} * 32 = 8*4*round{1}); first by smt(). rewrite ii. simplify. smt(). -smt(). rewrite /good_iotas4x /iotas. case (round{1} = 0); first by auto => />. case (round{1} = 1). auto => />. smt(@W64). @@ -1443,7 +1454,7 @@ rewrite dec0. split. rewrite to_uintD. smt(@W32). smt(@W32). rewrite dec. rewrite to_uintD. smt(@W32). smt(@W32). -move : H7. rewrite dec0. +move : H10. rewrite dec0. rewrite to_uintD. smt(@W32). rewrite dec. rewrite to_uintD. smt(@W32). rewrite to_uintD. smt(@W32). From 3caaee7b27b410d5c26a6ad9197340701fb8e3bd Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jos=C3=A9=20Bacelar=20Almeida?= Date: Wed, 15 May 2019 22:33:44 +0100 Subject: [PATCH 416/525] finished squeeze part --- proof/impl/keccak_1600_corr.ec | 296 +++++++++++++++++++-------------- 1 file changed, 173 insertions(+), 123 deletions(-) diff --git a/proof/impl/keccak_1600_corr.ec b/proof/impl/keccak_1600_corr.ec index 76b7df4..1165954 100644 --- a/proof/impl/keccak_1600_corr.ec +++ b/proof/impl/keccak_1600_corr.ec @@ -215,33 +215,6 @@ by case: (x=7) => //. qed. -(* SPECIFICATION OF LEAF-FUNCTIONS *) - -lemma st0_spec_h: - hoare [ M.st0 : true ==> res = st0 ] . -proof. -proc; sp. -while (0 <= i <= 25 /\ forall k, 0 <= k < i => state.[k]=W64.zero). - wp; skip; progress; first 2 smt(). - case: (k < i{hr}) => E. - by rewrite set_neqiE 1,2:/# H1 /#. - by rewrite set_eqiE /#. -skip; progress; first smt(). -move: H2; have ->: i0 = 25 by smt(). -by move=> {H H0 H1} H; apply Array25.ext_eq => ??; rewrite (H x) // /st0 createiE. -qed. - -lemma st0_spec_ll: islossless M.st0. -proof. -islossless; while true (25 - i). - by move=> ?; wp; skip => ? [??] /#. -by skip => ??? /#. -qed. - -lemma st0_spec: - phoare [ M.st0 : true ==> res = st0 ] = 1%r. -proof. by conseq st0_spec_ll st0_spec_h. qed. - lemma loadW64_w8L2w64L mem in_ inlen i: 0 <= i < inlen %/ 8 => loadW64 mem (in_+8*i) @@ -330,6 +303,169 @@ rewrite take_oversize ?size_memread 1..2:/#. admit. qed. +op stores64 (m: global_mem_t) (a:address) (w: W64.t list): global_mem_t = + foldl (fun (m0 : global_mem_t) (i : int) => storeW64 m0 (a + 8*i) (nth W64.zero w i)) + m (iota_ 0 (size w)). + +lemma stores64_nil mem a: stores64 mem a [] = mem by done. + +lemma stores64_singl mem a x: stores64 mem a [x] = storeW64 mem a x by done. + +hint simplify stores64_nil, stores64_singl. + +lemma foldl_map ['a 'b 'c] (h:'a->'b) (f:'c ->'b->'c) (z:'c) l: + foldl f z (List.map h l) = foldl (fun b a => f b (h a)) z l. +proof. +elim: l f z => //= x xs IH f z. +by rewrite IH. +qed. + +lemma stores64_cat mem out l1 l2: + stores64 mem out (l1 ++ l2) + = stores64 (stores64 mem out l1) (out + 8*size l1) l2. +proof. +rewrite /stores64 size_cat iota_add; first 2 smt(size_ge0). +rewrite (addzC 0) iota_addl foldl_cat foldl_map /=. +have ->: foldl (fun (m0 : global_mem_t) (i : int) => + storeW64 m0 (out + 8 * i) (nth W64.zero (l1 ++ l2) i)) mem + (iota_ 0 (size l1)) + = foldl (fun (m0 : global_mem_t) (i : int) => + storeW64 m0 (out + 8 * i) (nth W64.zero l1 i)) mem + (iota_ 0 (size l1)). + apply foldl_in_eq => mem' x; rewrite mem_iota => |> *. + by rewrite nth_cat H0. +apply foldl_in_eq => mem' x; rewrite mem_iota => |> *. +case: (x=0) => E. + by rewrite E /= nth_cat ltzz. +rewrite nth_cat (:! size l1 + x < size l1) 1:/# /=; congr; first smt(). +congr; smt(). +qed. + +lemma stores64_cons mem a x xs: + stores64 mem a (x::xs) = stores64 (storeW64 mem a x) (a+8) xs. +proof. by rewrite -cat1s stores64_cat. qed. + +lemma stores64_rcons mem out xs x: + stores64 mem out (rcons xs x) + = storeW64 (stores64 mem out xs) (out + 8*size xs) x. +proof. by rewrite -cats1 stores64_cat. qed. + +lemma nth_squeezestate st i: + 0 <= i < rate64 => + nth W64.zero (squeezestate st) i = st.[i]. +proof. +move=> Hi; rewrite /squeezestate nth_take; first 2 smt(rate64_bnds). +rewrite -(nth_inside witness). + rewrite Array25.size_to_list; first smt(rate64_bnds). +by apply Array25.get_to_list. +qed. + +lemma stores_nil mem out: stores mem out [] = mem by done. + +lemma stores_singl mem out x: stores mem out [x] = storeW8 mem out x. +proof. by rewrite storeW8E /stores. qed. + +hint simplify stores_nil, stores_singl. + +lemma stores_cons' mem out x xs: + stores mem out (x::xs) = stores (storeW8 mem out x) (out+1) xs. +proof. by rewrite -cat1s stores_cat. qed. + +lemma stores_rcons mem out x xs: + stores mem out (rcons xs x) = storeW8 (stores mem out xs) (out + size xs) x. +proof. by rewrite -cats1 stores_cat. qed. + +hint simplify w64L2w8L_nil. + +lemma w64L2w8L_singl x: w64L2w8L [x] = W8u8.to_list x by rewrite /w64L2w8L. + +lemma w64L2w8L_cat l1 l2: + w64L2w8L (l1++l2) = w64L2w8L l1 ++ w64L2w8L l2. +proof. +elim: l1 => //= x xs IH. +by rewrite !w64L2w8L_cons IH catA. +qed. + +lemma stores_u64 mem out x: + stores mem out (W8u8.to_list x) = storeW64 mem out x by rewrite storeW64E. + +lemma stores64_stores mem out l: + stores64 mem out l = stores mem out (w64L2w8L l). +proof. +elim/last_ind: l mem out => //= xs x IH mem out. +rewrite stores64_rcons IH -cats1 w64L2w8L_cat stores_cat w64L2w8L_singl. +by rewrite stores_u64 size_w64L2w8L. +qed. + +lemma w64L2w8L_take n l: + w64L2w8L (take n l) = take (8*n) (w64L2w8L l). +admitted. + +lemma nth_w64L2w8L l i: + 0 <= i < 8*size l => + nth W8.zero (w64L2w8L l) i = nth W8.zero (W8u8.to_list (nth W64.zero l (i %/ 8))) (i %% 8). +proof. +move=> Hi; rewrite /w64L2w8L (BitEncoding.BitChunking.nth_flatten W8.zero 8). + by rewrite allP => x /mapP [y [Hy ->]]. +by rewrite (nth_map W64.zero) 1:/#. +qed. + +lemma w64L2w8L_squeezestate st: + w64L2w8L (squeezestate st) + = take rate8 (WArray200.WArray200.to_list (WArray200.WArray200.init64 (("_.[_]" st)))). +proof. +have Hsz1:= Array25.size_to_list st. +have Hsz2:= WArray200.WArray200.size_to_list (WArray200.WArray200.init64 (("_.[_]" st))). +rewrite /squeezestate w64L2w8L_take; congr. +apply (eq_from_nth W8.zero). + by rewrite size_w64L2w8L /#. +move=> i; rewrite size_w64L2w8L Hsz1 => ?. +rewrite WArray200.WArray200.get_to_list. +have ->: (w64L2w8L (to_list st)).[i] = nth W8.zero (W8u8.to_list st.[i %/ 8]) (i %% 8). + rewrite nth_w64L2w8L ?Hsz1 //; congr. + by rewrite -Array25.get_to_list (nth_inside witness W64.zero) 1:/#. +rewrite /WArray200.WArray200.init64 WArray200.WArray200.initiE //; beta. +smt. +qed. + +lemma state_get8E (st:state) i: + 0 <= i < rate8 => + WArray200.WArray200.get8 (WArray200.WArray200.init64 ("_.[_]" st)) i + = nth W8.zero (w64L2w8L (squeezestate st)) i. +proof. +move=> Hi; rewrite w64L2w8L_squeezestate /WArray200.WArray200.get8. +by rewrite nth_take 1,2:/# WArray200.WArray200.get_to_list. +qed. + + + + +(* SPECIFICATION OF LEAF-FUNCTIONS *) + +lemma st0_spec_h: + hoare [ M.st0 : true ==> res = st0 ] . +proof. +proc; sp. +while (0 <= i <= 25 /\ forall k, 0 <= k < i => state.[k]=W64.zero). + wp; skip; progress; first 2 smt(). + case: (k < i{hr}) => E. + by rewrite set_neqiE 1,2:/# H1 /#. + by rewrite set_eqiE /#. +skip; progress; first smt(). +move: H2; have ->: i0 = 25 by smt(). +by move=> {H H0 H1} H; apply Array25.ext_eq => ??; rewrite (H x) // /st0 createiE. +qed. + +lemma st0_spec_ll: islossless M.st0. +proof. +islossless; while true (25 - i). + by move=> ?; wp; skip => ? [??] /#. +by skip => ??? /#. +qed. + +lemma st0_spec: + phoare [ M.st0 : true ==> res = st0 ] = 1%r. +proof. by conseq st0_spec_ll st0_spec_h. qed. lemma add_full_block_spec_h st in_ inlen_ r8_: hoare [ M.add_full_block: @@ -586,63 +722,6 @@ proof. by conseq add_final_block_spec_ll (add_final_block_spec_h st in_ inlen_ trail_byte_). qed. -op stores64 (m: global_mem_t) (a:address) (w: W64.t list): global_mem_t = - foldl (fun (m0 : global_mem_t) (i : int) => storeW64 m0 (a + 8*i) (nth W64.zero w i)) - m (iota_ 0 (size w)). - -lemma stores64_nil mem a: stores64 mem a [] = mem by done. - -lemma stores64_singl mem a x: stores64 mem a [x] = storeW64 mem a x by done. - -hint simplify stores64_nil, stores64_singl. - -lemma foldl_map ['a 'b 'c] (h:'a->'b) (f:'c ->'b->'c) (z:'c) l: - foldl f z (List.map h l) = foldl (fun b a => f b (h a)) z l. -proof. -elim: l f z => //= x xs IH f z. -by rewrite IH. -qed. - -lemma stores64_cat mem out l1 l2: - stores64 mem out (l1 ++ l2) - = stores64 (stores64 mem out l1) (out + 8*size l1) l2. -proof. -rewrite /stores64 size_cat iota_add; first 2 smt(size_ge0). -rewrite (addzC 0) iota_addl foldl_cat foldl_map /=. -have ->: foldl (fun (m0 : global_mem_t) (i : int) => - storeW64 m0 (out + 8 * i) (nth W64.zero (l1 ++ l2) i)) mem - (iota_ 0 (size l1)) - = foldl (fun (m0 : global_mem_t) (i : int) => - storeW64 m0 (out + 8 * i) (nth W64.zero l1 i)) mem - (iota_ 0 (size l1)). - apply foldl_in_eq => mem' x; rewrite mem_iota => |> *. - by rewrite nth_cat H0. -apply foldl_in_eq => mem' x; rewrite mem_iota => |> *. -case: (x=0) => E. - by rewrite E /= nth_cat ltzz. -rewrite nth_cat (:! size l1 + x < size l1) 1:/# /=; congr; first smt(). -congr; smt(). -qed. - -lemma stores64_cons mem a x xs: - stores64 mem a (x::xs) = stores64 (storeW64 mem a x) (a+8) xs. -proof. by rewrite -cat1s stores64_cat. qed. - -lemma stores64_rcons mem out xs x: - stores64 mem out (rcons xs x) - = storeW64 (stores64 mem out xs) (out + 8*size xs) x. -proof. by rewrite -cats1 stores64_cat. qed. - -lemma nth_squeezestate st i: - 0 <= i < rate64 => - nth W64.zero (squeezestate st) i = st.[i]. -proof. -move=> Hi; rewrite /squeezestate nth_take; first 2 smt(rate64_bnds). -rewrite -(nth_inside witness). - rewrite Array25.size_to_list; first smt(rate64_bnds). -by apply Array25.get_to_list. -qed. - lemma xtr_full_block_spec_h mem st out_ outlen_: hoare [ M.xtr_full_block: Glob.mem = mem @@ -701,7 +780,6 @@ lemma xtr_full_block_spec mem st out_ outlen_: /\ to_uint rate = rate8 /\ good_ptr out_ rate8 ==> -(* Glob.mem = stores mem (to_uint out_) (xtrbytes rate8 (squeezestate st))*) Glob.mem = stores64 mem (to_uint out_) (squeezestate st) /\ to_uint res.`1 = to_uint out_ + rate8 /\ to_uint res.`2 = to_uint outlen_ - rate8 @@ -710,28 +788,6 @@ proof. by conseq xtr_full_block_spec_ll (xtr_full_block_spec_h mem st out_ outlen_). qed. -print xtrbytes. -lemma stores64_stores mem out l: - stores64 mem out l = stores mem out (xtrbytes (8*size l) l). -proof. -admit. -qed. - -lemma stores_nil mem out: stores mem out [] = mem by done. - -lemma stores_singl mem out x: stores mem out [x] = storeW8 mem out x. -proof. by rewrite storeW8E /stores. qed. - -hint simplify stores_nil, stores_singl. - -lemma stores_cons' mem out x xs: - stores mem out (x::xs) = stores (storeW8 mem out x) (out+1) xs. -proof. by rewrite -cat1s stores_cat. qed. - -lemma stores_rcons mem out x xs: - stores mem out (rcons xs x) = storeW8 (stores mem out xs) (out + size xs) x. -proof. by rewrite -cats1 stores_cat. qed. - lemma xtr_bytes_spec_h mem st out_ outlen_: hoare [ M.xtr_bytes: Glob.mem = mem @@ -762,10 +818,7 @@ while (#[2,-2:]pre /\ outlen_ = outlen /\ out_ = out /\ rewrite to_uintD_small 1:/# size_take; first smt(W64.to_uint_cmp). rewrite size_w64L2w8L size_squeezestate. by rewrite (:to_uint i{hr} < 8 * rate64) 1:/#. - admit (* -(get8 ((init64 ("_.[_]" state{hr})))%WArray200.WArray200 (to_uint i{hr}))%WArray200.WArray200 = -(w64L2w8L (squeezestate state{hr})).[to_uint i{hr}] -*). + rewrite state_get8E; smt(W64.to_uint_cmp). wp; while (#[2:]pre /\ 0 <= to_uint i <= to_uint outlen_ %/ 8 /\ out = out_ /\ to_uint outlen8 = to_uint outlen %/ 8 /\ Glob.mem = stores64 mem (to_uint out_) (take (to_uint i) (squeezestate st))). @@ -781,12 +834,12 @@ wp; while (#[2:]pre /\ 0 <= to_uint i <= to_uint outlen_ %/ 8 /\ out = out_ /\ + smt(). + smt(). + rewrite (take_nth W64.zero). - rewrite size_squeezestate. smt(rate64_bnds). - admit (* -storeW64 (stores64 mem (to_uint out{hr}) (squeezestate state{hr})) - (to_uint out{hr} + 8 * to_uint i{hr}) state{hr}.[to_uint i{hr}] = -stores64 mem (to_uint out{hr}) (squeezestate state{hr}) -*). + rewrite size_squeezestate; smt(rate64_bnds). + rewrite stores64_rcons; congr. + rewrite size_take 1:/# size_squeezestate. + by rewrite (: to_uint i{hr} < rate64) 1:[smt(rate64_bnds)]. + rewrite /squeezestate nth_take 1,2:/# -Array25.get_to_list. + by apply nth_inside; rewrite Array25.size_to_list; smt(rate64_bnds). wp; skip => |> *; progress. + smt. + by rewrite to_uint_shr of_uintK modz_small //. @@ -803,11 +856,7 @@ wp; skip => |> *; progress. smt(). + rewrite to_uint_shl of_uintK modz_small //=; first smt. rewrite stores64_stores; congr. - admit (* -xtrbytes (8 * size (take (to_uint i0) (squeezestate state{hr}))) - (take (to_uint i0) (squeezestate state{hr})) = -xtrbytes (to_uint i0 * 8) (squeezestate state{hr}) -*). + by rewrite /xtrbytes /squeezestate w64L2w8L_take mulzC. + have ->: to_uint i1 = to_uint outlen{hr} by smt. done. qed. @@ -884,7 +933,8 @@ wp; while (st{1}=state{2} /\ to_uint rate{2}=rate8 /\ + rewrite size_cat H8 H0 size_xtrbytes; smt(rate8_bnds). + smt(). + smt(). - + by rewrite H0 stores_cat stores64_stores size_squeezestate. + + rewrite H0 stores_cat stores64_stores /xtrbytes -w64L2w8L_take. + by rewrite take_oversize ?size_squeezestate. + by rewrite !ultE /#. + by move: H10; rewrite ultE /#. wp; ecall {2} (add_final_block_spec state{2} in_0{2} inlen{2} trail_byte{2}); simplify. From 9b23d6ae6f8f4742387857e9181b78b9899924c0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jos=C3=A9=20Bacelar=20Almeida?= Date: Thu, 16 May 2019 07:02:16 +0100 Subject: [PATCH 417/525] progress --- proof/impl/EclibExtra.ec | 6 + proof/impl/JWordList.ec | 413 +++++++++++++++++++++++++++++++-- proof/impl/keccak_1600_corr.ec | 213 +---------------- 3 files changed, 401 insertions(+), 231 deletions(-) diff --git a/proof/impl/EclibExtra.ec b/proof/impl/EclibExtra.ec index da490d0..33896bd 100644 --- a/proof/impl/EclibExtra.ec +++ b/proof/impl/EclibExtra.ec @@ -240,6 +240,12 @@ qed. op chunkfill ['a] (d:'a) n l = l ++ nseq (chunkfillsize n (size l)) d. +lemma chunkfill_nil ['a] (d:'a) n: + chunkfill d n [] = []. +proof. by rewrite /chunkfill /chunkfillsize. qed. + +hint simplify chunkfill_nil. + lemma dvd_chunkfill ['a] (d:'a) n l: 0 < n => n %| size l => chunkfill d n l = l. proof. diff --git a/proof/impl/JWordList.ec b/proof/impl/JWordList.ec index 9f20d1d..133fab8 100644 --- a/proof/impl/JWordList.ec +++ b/proof/impl/JWordList.ec @@ -1,26 +1,120 @@ require import AllCore List Int IntDiv. -from Jasmin require import JWord JUtils. +from Jasmin require import JMemory JWord JUtils. require import EclibExtra. -(* W8.t lists *) +lemma foldl_map ['a 'b 'c] (h:'a->'b) (f:'c ->'b->'c) (z:'c) l: + foldl f z (List.map h l) = foldl (fun b a => f b (h a)) z l. +proof. +elim: l f z => //= x xs IH f z. +by rewrite IH. +qed. + +lemma chunkfill_cat (d:'a) n l1 l2: + 0 < n => n %| size l1 => chunkfill d n (l1++l2) = l1 ++ chunkfill d n l2. +proof. +move=> H0 Hsz; rewrite /chunkfill -!catA; congr; congr; congr. +move: Hsz; rewrite size_cat dvdzP => [[k]]. +rewrite mulzC => ->. +by rewrite chunkfillsizeP. +qed. + +lemma chunkfillK' l (d:'a) n: + 0 < n => n %| size l => chunkfill d n l = l. +proof. +rewrite /chunkfill => Hn Hsz. +move: (Hsz); rewrite dvdzP => [[k E]]. +rewrite chunkfillsizeE //; first smt(size_ge0). +by rewrite !Hsz /= cats0. +qed. + +lemma chunkfillsize_ge0 k n: 0 < k => 0 <= chunkfillsize k n. +proof. by rewrite /chunkfillsize /#. qed. + +lemma drop_chunkfill n (d:'a) k l: + 0 < k => 0 <= n => + drop (k*n) (chunkfill d k l) = chunkfill d k (drop (k*n) (chunkfill d k l)). +proof. +move=> Hk Hn; have := chunkfillP d k l Hk. +rewrite /chunkfill size_cat size_nseq max_ler; first smt(chunkfillsize_ge0). +move=> Hdvd; pose S:= chunkfillsize _ (size (drop _ _)). +have ->: S = 0; last by rewrite nseq0 cats0. +rewrite /S -(chunkfillsizeP _ _ n) // size_drop 1:/# addzC /max size_cat size_nseq. +rewrite max_ler; first by apply chunkfillsize_ge0. +case: (0 < size l + chunkfillsize k (size l) - k * n) => E. + rewrite Ring.IntID.subrK chunkfillsizeE; first 2 smt(size_ge0 chunkfillsize_ge0). + by rewrite !Hdvd. +by rewrite addzC chunkfillsizeP. +qed. + +lemma nth_chunkfill k (d:'a) n l: + 0 < n => nth d (chunkfill d n l) k = nth d l k. +proof. +move=> Hn; rewrite /chunkfill nth_cat. +case: (k < size l) => E //. +case: (0 <= k - size l < chunkfillsize n (size l)) => ?. + by rewrite nth_nseq // nth_out /#. +rewrite nth_out. + by rewrite size_nseq max_ler // chunkfillsize_ge0. +by rewrite nth_out /#. +qed. + +lemma drop_chunk n k (l: 'a list): + 0 < k => + drop n (BitEncoding.BitChunking.chunk k l) + = BitEncoding.BitChunking.chunk k (drop (k*n) l). +proof. +move=> Hk; elim/natind: n l. + by move=> n Hn l; rewrite !drop_le0 /#. +move=> n Hn IH l; rewrite dropS // IH behead_chunk drop_drop 1,2:/#. +by congr; congr; ring. +qed. + +lemma nth0 (d:'a) l: nth d l 0 = head d l by case: l. + +lemma head_chunkfilled (d:'a) k l: + head [] (BitEncoding.BitChunking.chunk k (chunkfill d k l)) + = take k (chunkfill d k l). +proof. +case: (0 < k) => Hk; last first. + by rewrite take_le0 1:/# BitEncoding.BitChunking.chunk_le0 1:/#. +case: (0 < size l) => Hsz; last first. + have ->: l=[] by smt(size_ge0). + by rewrite chunkfill_nil /= /BitEncoding.BitChunking.chunk /= mkseq0. +rewrite -nth0 /BitEncoding.BitChunking.chunk nth_mkseq /=. + by rewrite size_chunkfill // /#. +by rewrite drop0. +qed. + +lemma nth_chunkfilled (d:'a) k l (i:int): + 0 < k => + 0 <= i < (size l - 1) %/ k => + nth [] (BitEncoding.BitChunking.chunk k (chunkfill d k l)) i + = take k (drop (k*i) (chunkfill d k l)). +proof. +move=> Hk Hi. +rewrite {1}(:i = i+0) // -nth_drop 1,2:/# drop_chunk // nth0. +by rewrite drop_chunkfill // 1:/# head_chunkfilled. +qed. + +(*******************************************************************************) +(* W8 lists *) +(*******************************************************************************) op w8L2bits (l: W8.t list) : bool list = flatten (map W8.w2bits l). lemma w8L2bits_nil: w8L2bits [] = [] by done. +hint simplify w8L2bits_nil. + lemma w8L2bits_cons x xs: w8L2bits (x::xs) = W8.w2bits x ++ w8L2bits xs. proof. by rewrite /w8L2bits map_cons flatten_cons. qed. lemma w8L2bits_cat l1 l2: w8L2bits (l1++l2) = w8L2bits l1 ++ w8L2bits l2. -proof. -elim: l1 => //=. - by rewrite w8L2bits_nil. -by move=> x xs IH; rewrite !w8L2bits_cons IH. -qed. +proof. by elim: l1 => //= x xs IH; rewrite !w8L2bits_cons IH. qed. lemma size_w8L2bits x: size (w8L2bits x) = 8 * size x. @@ -37,8 +131,7 @@ proof. elim/natind: n l => //=. move=> n Hn l; rewrite !take_le0 //. by apply StdOrder.IntOrder.mulr_ge0_le0. -move=> n Hn IH [|x xs] /=. - by rewrite w8L2bits_nil. +move=> n Hn IH [|x xs] //=. have ->/=: ! (n+1 <= 0) by rewrite -ltzNge ltzS. rewrite !w8L2bits_cons take_cat. have ->/=: ! (8 * (n + 1) < size (w2bits x)) by rewrite W8.size_w2bits /#. @@ -51,19 +144,19 @@ proof. elim/natind: n l => //=. move=> n Hn l; rewrite !drop_le0 //. by apply StdOrder.IntOrder.mulr_ge0_le0. -move=> n Hn IH [|x xs] /=. - by rewrite w8L2bits_nil. +move=> n Hn IH [|x xs] //=. have ->/=: ! (n+1 <= 0) by rewrite -ltzNge ltzS. rewrite !w8L2bits_cons drop_cat. have ->/=: ! (8 * (n + 1) < size (w2bits x)) by rewrite W8.size_w2bits /#. by rewrite mulzDr /= IH. qed. +lemma w8L2bits_u64 w: w8L2bits (W8u8.to_list w) = W64.w2bits w. +proof. by rewrite /w8L2bits. qed. - -(* W64.t lists *) - - +(*******************************************************************************) +(* W64 lists *) +(*******************************************************************************) op w64L2bits (l: W64.t list) : bool list = flatten (map W64.w2bits l). @@ -75,9 +168,17 @@ by rewrite /w64L2bits size_flatten -map_comp /(\o) /= StdBigop.Bigint.sumzE StdBigop.Bigint.BIA.big_mapT /(\o) /= StdBigop.Bigint.big_constz count_predT_eq. qed. +hint simplify size_w64L2bits. + op bits2w64L (bs: bool list) : W64.t list = map W64.bits2w (BitEncoding.BitChunking.chunk 64 (chunkfill false 64 bs)). +lemma bits2w64L_nil: bits2w64L [] = []. +proof. +rewrite /bits2w64L chunkfill_nil. +by rewrite /BitEncoding.BitChunking.chunk /= mkseq0. +qed. + lemma size_bits2w64L bs: size (bits2w64L bs) = (size bs - 1) %/ 64 + 1. proof. @@ -87,7 +188,7 @@ rewrite {3}(:64 = 1*64) 1:/# -mulzDl. by rewrite -(addz0 (((size bs - 1) %/ 64 + 1) * 64)) divzMDl. qed. -hint simplify size_w64L2bits. +hint simplify bits2w64L_nil. lemma bits2w64LK bs: 64 %| size bs => w64L2bits (bits2w64L bs) = bs. @@ -183,7 +284,6 @@ apply divz_cmp => //. by rewrite mulzC. qed. - lemma w64L2bits_xor l1 l2: w64L2bits (JUtils.map2 W64.(`^`) l1 l2) = map2 Bool.(^^) (w64L2bits l1) (w64L2bits l2). @@ -209,6 +309,107 @@ move=> n Hn IH H; rewrite nseqS // w64L2bits_cons IH //. by rewrite addzC mulzDr mulz1 nseq_add /#. qed. +(*******************************************************************************) +(* W8 lists => W64 lists *) +(*******************************************************************************) + +op w8L2w64L (l: W8.t list) : W64.t list = + map W8u8.pack8 (BitEncoding.BitChunking.chunk 8 (chunkfill W8.zero 8 l)). + +lemma w8L2w64L_nil: w8L2w64L [] = []. +proof. by rewrite /w8L2w64L chunkfill_nil /BitEncoding.BitChunking.chunk mkseq0. qed. + +hint simplify w8L2w64L_nil. + +lemma w8L2w64L_cat l1 l2: + 8 %| size l1 => w8L2w64L (l1++l2) = w8L2w64L l1 ++ w8L2w64L l2. +proof. +move=> Hsz; rewrite /w8L2w64L chunkfill_cat //. +rewrite BitEncoding.BitChunking.chunk_cat // map_cat. +by rewrite (chunkfillK' l1) //. +qed. + +lemma w8L2w64L_singl xs: + 0 < size xs <= 8 => w8L2w64L xs = [pack8 xs]. +proof. +move=> Hsz; rewrite /w8L2w64L /BitEncoding.BitChunking.chunk. +have ->: size (chunkfill W8.zero 8 xs) %/ 8 = 1. + rewrite size_chunkfill // /#. +rewrite mkseq1 /= drop0 take_oversize. + rewrite size_chunkfill //; smt(size_ge0). +rewrite !pack8E; apply W64.init_ext => x Hx /=. +by congr; rewrite !W8u8.Pack.get_of_list 1,2:/# nth_chunkfill. +qed. + +lemma w8L2w64L_cons l: + 0 < size l => + w8L2w64L l = W8u8.pack8 (take 8 l) :: w8L2w64L (drop 8 l). +proof. +move=> Hsz0; rewrite -{1}(cat_take_drop 8 l). +case: (size l <= 8) => Hsz. + by rewrite !drop_oversize //= cats0 take_oversize // w8L2w64L_singl // E /=. +rewrite w8L2w64L_cat. + by rewrite size_take // (: 8 < size l) 1:/# /= dvdzz. +by rewrite w8L2w64L_singl // size_take // /#. +qed. + +lemma drop_w8L2w64L n l: + drop n (w8L2w64L l) = w8L2w64L (drop (8*n) l). +proof. +elim/natind: n l => //=. + by move=> n Hn l; rewrite !drop_le0 // /#. +move=> n Hn IH l. +rewrite -drop_drop //. +move: l => [|x xs] //. +rewrite {1}(w8L2w64L_cons (x::xs) _) /= 1:[smt(size_ge0)] drop0. +rewrite (:! 8 * (n + 1) <= 0) 1:/# /= IH drop_drop 1:/# //. +by congr; congr; ring. +qed. + +lemma size_w8L2w64L l: + size (w8L2w64L l) = (size l - 1) %/ 8 + 1. +proof. +rewrite /w8L2w64L size_map BitEncoding.BitChunking.size_chunk //. +rewrite size_chunkfill //. +by rewrite -{3}(mul1z 8) -mulzDl mulzK. +qed. + +lemma size_w8L2w64L' l: + 8 %| size l => size (w8L2w64L l) = size l %/ 8. +proof. by rewrite size_w8L2w64L dvdz_eq => E; smt(). qed. + +lemma take_w8L2w64L n l: + take n (w8L2w64L l) = w8L2w64L (take (8*n) l). +proof. +rewrite -{1}(cat_take_drop (8*n) l). +case: (0 <= 8*n) => Hsz0; last by rewrite !take_le0 /#. +case: (8*n <= size l) => E. + rewrite w8L2w64L_cat. + rewrite size_take' 1:/# E /= /#. + rewrite take_cat' !size_w8L2w64L size_take' // !E /=. + rewrite (:n <= (8 * n - 1) %/ 8 + 1) 1:/# /= take_oversize //. + by rewrite size_w8L2w64L size_take' // E /= /#. +rewrite drop_oversize 1:/# cats0 take_oversize //. +by rewrite size_w8L2w64L size_take' /#. +qed. + +lemma nth_w8L2w64L (l : W8.t list) (i : int): + 0 <= 8*i < size l => + nth W64.zero (w8L2w64L l) i = pack8 (take 8 (drop (8*i) l)). +proof. +move=> [Hsz0 Hsz]; rewrite /w8L2w64L. +rewrite (nth_map []) /=. + admit. +rewrite nth_chunkfilled //. + admit. +congr. +admit. +qed. + + +(*******************************************************************************) +(* W64 lists => W8 lists *) +(*******************************************************************************) op w64L2w8L (l: W64.t list) : W8.t list = @@ -218,6 +419,8 @@ lemma w64L2w8L_nil: w64L2w8L [] = []. proof. by rewrite /w64L2w8L. qed. +hint simplify w64L2w8L_nil. + lemma w64L2w8L_cons x xs: w64L2w8L (x::xs) = W8u8.to_list x ++ w64L2w8L xs. proof. by rewrite /w64L2w8L map_cons flatten_cons. qed. @@ -225,10 +428,12 @@ proof. by rewrite /w64L2w8L map_cons flatten_cons. qed. lemma size_w64L2w8L (l: W64.t list): size (w64L2w8L l) = 8 * size l. proof. -elim: l => //=; first by rewrite w64L2w8L_nil. -by move=> x xs IH; rewrite w64L2w8L_cons size_cat IH W8u8.Pack.size_to_list; ring. +elim: l => //= x xs IH. +by rewrite w64L2w8L_cons size_cat IH W8u8.Pack.size_to_list; ring. qed. +hint simplify size_w64L2w8L. + lemma w64L2w8L2bits l: w8L2bits (w64L2w8L l) = w64L2bits l. proof. @@ -238,3 +443,173 @@ rewrite /w64L2w8L map_cons flatten_cons w64L2bits_cons w8L2bits_cat; congr. by rewrite /w8L2bits /flatten. qed. +lemma w64L2w8L_singl x: w64L2w8L [x] = W8u8.to_list x by rewrite /w64L2w8L. + +lemma w64L2w8L_cat l1 l2: + w64L2w8L (l1++l2) = w64L2w8L l1 ++ w64L2w8L l2. +proof. +elim: l1 => //= x xs IH. +by rewrite !w64L2w8L_cons IH catA. +qed. + +lemma w64L2w8L_take n l: + w64L2w8L (take n l) = take (8*n) (w64L2w8L l). +proof. +elim: l n => //= x xs IH n. +case: (n <= 0) => E /=; first by rewrite take_le0 /#. +rewrite !w64L2w8L_cons IH take_cat W8u8.Pack.size_to_list. +by rewrite (:!8*n<8) /#. +qed. + +lemma nth_w64L2w8L l i: + 0 <= i < 8*size l => + nth W8.zero (w64L2w8L l) i + = nth W8.zero (W8u8.to_list (nth W64.zero l (i %/ 8))) (i %% 8). +proof. +move=> Hi; rewrite /w64L2w8L (BitEncoding.BitChunking.nth_flatten W8.zero 8). + by rewrite allP => x /mapP [y [Hy ->]]. +by rewrite (nth_map W64.zero) 1:/#. +qed. + + +(*******************************************************************************) +(* MEMORY OPERATIONS *) +(*******************************************************************************) + +lemma stores_nil mem out: stores mem out [] = mem by done. + +lemma stores_singl mem out x: stores mem out [x] = storeW8 mem out x. +proof. by rewrite storeW8E /stores. qed. + +hint simplify stores_nil, stores_singl. + +lemma stores_cat mem out l1 l2: + stores mem out (l1++l2) = stores (stores mem out l1) (out + size l1) l2. +proof. +elim: l1 mem out => //= x xs IH mem out. +by rewrite !stores_cons IH addzA. +qed. + +lemma stores_cons' mem out x xs: + stores mem out (x::xs) = stores (storeW8 mem out x) (out+1) xs. +proof. by rewrite -cat1s stores_cat. qed. + +lemma stores_rcons mem out x xs: + stores mem out (rcons xs x) = storeW8 (stores mem out xs) (out + size xs) x. +proof. by rewrite -cats1 stores_cat. qed. + +lemma stores_u64 mem out x: + stores mem out (W8u8.to_list x) = storeW64 mem out x by rewrite storeW64E. + + + +op stores64 (m: global_mem_t) (a:address) (w: W64.t list): global_mem_t = + foldl (fun (m0 : global_mem_t) (i : int) => storeW64 m0 (a + 8*i) (nth W64.zero w i)) + m (iota_ 0 (size w)). + +lemma stores64_nil mem a: stores64 mem a [] = mem by done. + +lemma stores64_singl mem a x: stores64 mem a [x] = storeW64 mem a x by done. + +hint simplify stores64_nil, stores64_singl. + +lemma stores64_cat mem out l1 l2: + stores64 mem out (l1 ++ l2) + = stores64 (stores64 mem out l1) (out + 8*size l1) l2. +proof. +rewrite /stores64 size_cat iota_add; first 2 smt(size_ge0). +rewrite (addzC 0) iota_addl foldl_cat foldl_map /=. +have ->: foldl (fun (m0 : global_mem_t) (i : int) => + storeW64 m0 (out + 8 * i) (nth W64.zero (l1 ++ l2) i)) mem + (iota_ 0 (size l1)) + = foldl (fun (m0 : global_mem_t) (i : int) => + storeW64 m0 (out + 8 * i) (nth W64.zero l1 i)) mem + (iota_ 0 (size l1)). + apply foldl_in_eq => mem' x; rewrite mem_iota => |> *. + by rewrite nth_cat H0. +apply foldl_in_eq => mem' x; rewrite mem_iota => |> *. +case: (x=0) => E. + by rewrite E /= nth_cat ltzz. +rewrite nth_cat (:! size l1 + x < size l1) 1:/# /=; congr; first smt(). +congr; smt(). +qed. + +lemma stores64_cons mem a x xs: + stores64 mem a (x::xs) = stores64 (storeW64 mem a x) (a+8) xs. +proof. by rewrite -cat1s stores64_cat. qed. + +lemma stores64_rcons mem out xs x: + stores64 mem out (rcons xs x) + = storeW64 (stores64 mem out xs) (out + 8*size xs) x. +proof. by rewrite -cats1 stores64_cat. qed. + +lemma stores64_stores mem out l: + stores64 mem out l = stores mem out (w64L2w8L l). +proof. +elim/last_ind: l mem out => //= xs x IH mem out. +rewrite stores64_rcons IH -cats1 w64L2w8L_cat stores_cat w64L2w8L_singl. +by rewrite stores_u64 size_w64L2w8L. +qed. + + +(** [memread] reads a list of bytes from memory *) +op memread (m : global_mem_t) (a : address) (sz : int): W8.t list = + mkseq (fun i => m.[a + i]) sz. + +lemma size_memread mem a sz: + 0 <= sz => size (memread mem a sz) = sz. +proof. by rewrite /memread size_map size_iota /#. qed. + +lemma size_memread' mem a sz: + size (memread mem a sz) = max 0 sz. +proof. by rewrite /memread size_map size_iota /#. qed. + +lemma memread0 mem a: + memread mem a 0 = []. +proof. by rewrite /memread mkseq0. qed. + +hint simplify memread0. + +lemma take_memread n mem ptr k: + 0 <= n => + take n (memread mem ptr k) = memread mem ptr (min n k). +proof. by move=> Hn; rewrite /memread take_mkseq. qed. + +lemma drop_memread n mem ptr k: + 0 <= n <= k => + drop n (memread mem ptr k) = memread mem (ptr+n) (k-n). +proof. +move=> Hn; rewrite /memread drop_mkseq //=. +by apply eq_mkseq => x; smt(). +qed. + +lemma loadW8_memread mem in_ inlen i: + 0 <= i < inlen => + loadW8 mem (in_ + i)%Int + = nth W8.zero (memread mem in_ inlen) i. +proof. +rewrite /loadW8 /memread => Hi. +by rewrite nth_mkseq. +qed. + +lemma loadW8_memread' mem in_ off inlen i: + (off <= i < off + inlen)%Int => + loadW8 mem (in_ + i)%Int + = nth W8.zero (memread mem (in_ + off) inlen) (i-off). +proof. +rewrite /loadW8 /memread => Hi. +by rewrite nth_mkseq /#. +qed. + +lemma nth_memread_u64 mem in_ inlen i: + 0 <= i => 8*i+8 <= inlen => + loadW64 mem (in_+8*i) = nth W64.zero (w8L2w64L (memread mem in_ inlen)) i. +proof. +move=> ??; rewrite nth_w8L2w64L. + by rewrite size_memread /#. +rewrite drop_memread 1:/# take_memread // min_lel 1:/#. +rewrite /loadW64 W8u8.pack8E pack8E; apply W64.init_ext => x Hx /=. +congr; rewrite W8u8.Pack.initiE 1:/# W8u8.Pack.get_of_list 1:/# /=. +by rewrite /memread nth_mkseq 1:/#. +qed. + diff --git a/proof/impl/keccak_1600_corr.ec b/proof/impl/keccak_1600_corr.ec index 1165954..ddbbcd3 100644 --- a/proof/impl/keccak_1600_corr.ec +++ b/proof/impl/keccak_1600_corr.ec @@ -5,46 +5,13 @@ require import Array25 EclibExtra JWordList. require import Spec1600 Keccak_1600_ref. -op memread (m : global_mem_t) (a : address) (sz : int): W8.t list = - mkseq (fun i => m.[a + i]) sz. - -lemma size_memread mem a sz: - 0 <= sz => size (memread mem a sz) = sz. -proof. by rewrite /memread size_map size_iota /#. qed. - -lemma size_memread' mem a sz: - size (memread mem a sz) = max 0 sz. -proof. by rewrite /memread size_map size_iota /#. qed. - -lemma memread0 mem a: - memread mem a 0 = []. -proof. by rewrite /memread mkseq0. qed. - -lemma take_memread n mem ptr k: - 0 <= n => - take n (memread mem ptr k) = memread mem ptr (min n k). -proof. by move=> Hn; rewrite /memread take_mkseq. qed. - -lemma drop_memread n mem ptr k: - 0 <= n <= k => - drop n (memread mem ptr k) = memread mem (ptr+n) (k-n). -proof. -move=> Hn; rewrite /memread drop_mkseq //=. -by apply eq_mkseq => x; smt(). -qed. - (* Bounded memory assumption (established by the safety analysis) *) abbrev good_ptr (ptr: W64.t) len = to_uint ptr + len < W64.modulus. op inv_ptr (in_0 inlen out outlen: W64.t) = good_ptr in_0 (to_uint inlen) /\ good_ptr out (to_uint outlen). -lemma stores_cat mem out l1 l2: - stores mem out (l1++l2) = stores (stores mem out l1) (out + size l1) l2. -proof. -elim: l1 mem out => //= x xs IH mem out. -by rewrite !stores_cons IH addzA. -qed. + lemma addstate_nil st: addstate st [] = st. @@ -78,9 +45,6 @@ case: (i < size xs) => //?. by rewrite nth_out /#. qed. - -abbrev w8L2w64L xs = bits2w64L (w8L2bits xs). - op u64xoru8 (w: W64.t) i (b: W8.t) = W8u8.pack8_t (W8u8.Pack.init @@ -215,84 +179,6 @@ by case: (x=7) => //. qed. -lemma loadW64_w8L2w64L mem in_ inlen i: - 0 <= i < inlen %/ 8 => - loadW64 mem (in_+8*i) - = nth W64.zero (w8L2w64L (memread mem in_ inlen)) i. -admitted. - -lemma loadW8_memread mem in_ inlen i: - 0 <= i < inlen => - loadW8 mem (in_ + i)%Int - = nth W8.zero (memread mem in_ inlen) i. -proof. -rewrite /loadW8 /memread => Hi. -by rewrite nth_mkseq. -qed. - -lemma loadW8_memread' mem in_ off inlen i: - off <= i < off + inlen => - loadW8 mem (in_ + i)%Int - = nth W8.zero (memread mem (in_ + off) inlen) (i-off). -proof. -rewrite /loadW8 /memread => Hi. -by rewrite nth_mkseq /#. -qed. - -lemma size_w8L2w64L' l: - size (w8L2w64L l) = (8 * size l - 1) %/ 64 + 1. (*? (size l - 1) %/ 8 + 1 ?*) -proof. -by rewrite size_bits2w64L size_w8L2bits. -qed. - -lemma size_w8L2w64L l: - 8 %| size l => size (w8L2w64L l) = size l %/ 8. -proof. -rewrite size_w8L2w64L' dvdz_eq => E. -by rewrite -{1}E mulzC mulzA /= divzMDl. -qed. - -lemma chunkfill_nil ['a] (d:'a) n: - chunkfill d n [] = []. -proof. by rewrite /chunkfill /chunkfillsize. qed. - -lemma bits2w64L_nil: bits2w64L [] = []. -proof. -rewrite /bits2w64L chunkfill_nil. -by rewrite /BitEncoding.BitChunking.chunk /= mkseq0. -qed. - -lemma w8L2w64L_nil: w8L2w64L [] = []. -proof. by rewrite w8L2bits_nil bits2w64L_nil. qed. - -lemma take_w8L2w64L n l: - take n (w8L2w64L l) = w8L2w64L (take (8*n) l). -proof. -elim/natind: n l => //=. - by move=> n Hn l; rewrite !take_le0 // 1:/# w8L2w64L_nil. -move=> n Hn IH l. -case: (8*n < size l) => E. - have Hsz: n < size (w8L2w64L l). - rewrite size_w8L2w64L'; smt. - rewrite (take_nth W64.zero) 1:/# IH -cats1 mulzDr /=. - have ->: take (8*n + 8) l = take (8*n) l ++ take 8 (drop (8*n) l). - rewrite -{1}(cat_take_drop (8*n) l) take_cat. - rewrite size_take 1:/# E /=. - rewrite (: ! 8 * n + 8 < 8 * n) 1:/# /=; congr. - rewrite (: 8 * n + 8 - 8 * n = 8); first by ring. - done. - have ->: w8L2w64L (take (8 * n) l ++ take 8 (drop (8 * n) l)) - = w8L2w64L (take (8 * n) l) ++ w8L2w64L (take 8 (drop (8 * n) l)). - search bits2w64L. - admit. - congr. - admit. -rewrite take_oversize. - rewrite size_w8L2w64L'; smt. -rewrite take_oversize; smt. -qed. - - lemma loadW64_take_block64 mem in_ i: 0 <= i < rate64 => loadW64 mem (in_ + 8 * i) = @@ -303,53 +189,6 @@ rewrite take_oversize ?size_memread 1..2:/#. admit. qed. -op stores64 (m: global_mem_t) (a:address) (w: W64.t list): global_mem_t = - foldl (fun (m0 : global_mem_t) (i : int) => storeW64 m0 (a + 8*i) (nth W64.zero w i)) - m (iota_ 0 (size w)). - -lemma stores64_nil mem a: stores64 mem a [] = mem by done. - -lemma stores64_singl mem a x: stores64 mem a [x] = storeW64 mem a x by done. - -hint simplify stores64_nil, stores64_singl. - -lemma foldl_map ['a 'b 'c] (h:'a->'b) (f:'c ->'b->'c) (z:'c) l: - foldl f z (List.map h l) = foldl (fun b a => f b (h a)) z l. -proof. -elim: l f z => //= x xs IH f z. -by rewrite IH. -qed. - -lemma stores64_cat mem out l1 l2: - stores64 mem out (l1 ++ l2) - = stores64 (stores64 mem out l1) (out + 8*size l1) l2. -proof. -rewrite /stores64 size_cat iota_add; first 2 smt(size_ge0). -rewrite (addzC 0) iota_addl foldl_cat foldl_map /=. -have ->: foldl (fun (m0 : global_mem_t) (i : int) => - storeW64 m0 (out + 8 * i) (nth W64.zero (l1 ++ l2) i)) mem - (iota_ 0 (size l1)) - = foldl (fun (m0 : global_mem_t) (i : int) => - storeW64 m0 (out + 8 * i) (nth W64.zero l1 i)) mem - (iota_ 0 (size l1)). - apply foldl_in_eq => mem' x; rewrite mem_iota => |> *. - by rewrite nth_cat H0. -apply foldl_in_eq => mem' x; rewrite mem_iota => |> *. -case: (x=0) => E. - by rewrite E /= nth_cat ltzz. -rewrite nth_cat (:! size l1 + x < size l1) 1:/# /=; congr; first smt(). -congr; smt(). -qed. - -lemma stores64_cons mem a x xs: - stores64 mem a (x::xs) = stores64 (storeW64 mem a x) (a+8) xs. -proof. by rewrite -cat1s stores64_cat. qed. - -lemma stores64_rcons mem out xs x: - stores64 mem out (rcons xs x) - = storeW64 (stores64 mem out xs) (out + 8*size xs) x. -proof. by rewrite -cats1 stores64_cat. qed. - lemma nth_squeezestate st i: 0 <= i < rate64 => nth W64.zero (squeezestate st) i = st.[i]. @@ -360,56 +199,6 @@ rewrite -(nth_inside witness). by apply Array25.get_to_list. qed. -lemma stores_nil mem out: stores mem out [] = mem by done. - -lemma stores_singl mem out x: stores mem out [x] = storeW8 mem out x. -proof. by rewrite storeW8E /stores. qed. - -hint simplify stores_nil, stores_singl. - -lemma stores_cons' mem out x xs: - stores mem out (x::xs) = stores (storeW8 mem out x) (out+1) xs. -proof. by rewrite -cat1s stores_cat. qed. - -lemma stores_rcons mem out x xs: - stores mem out (rcons xs x) = storeW8 (stores mem out xs) (out + size xs) x. -proof. by rewrite -cats1 stores_cat. qed. - -hint simplify w64L2w8L_nil. - -lemma w64L2w8L_singl x: w64L2w8L [x] = W8u8.to_list x by rewrite /w64L2w8L. - -lemma w64L2w8L_cat l1 l2: - w64L2w8L (l1++l2) = w64L2w8L l1 ++ w64L2w8L l2. -proof. -elim: l1 => //= x xs IH. -by rewrite !w64L2w8L_cons IH catA. -qed. - -lemma stores_u64 mem out x: - stores mem out (W8u8.to_list x) = storeW64 mem out x by rewrite storeW64E. - -lemma stores64_stores mem out l: - stores64 mem out l = stores mem out (w64L2w8L l). -proof. -elim/last_ind: l mem out => //= xs x IH mem out. -rewrite stores64_rcons IH -cats1 w64L2w8L_cat stores_cat w64L2w8L_singl. -by rewrite stores_u64 size_w64L2w8L. -qed. - -lemma w64L2w8L_take n l: - w64L2w8L (take n l) = take (8*n) (w64L2w8L l). -admitted. - -lemma nth_w64L2w8L l i: - 0 <= i < 8*size l => - nth W8.zero (w64L2w8L l) i = nth W8.zero (W8u8.to_list (nth W64.zero l (i %/ 8))) (i %% 8). -proof. -move=> Hi; rewrite /w64L2w8L (BitEncoding.BitChunking.nth_flatten W8.zero 8). - by rewrite allP => x /mapP [y [Hy ->]]. -by rewrite (nth_map W64.zero) 1:/#. -qed. - lemma w64L2w8L_squeezestate st: w64L2w8L (squeezestate st) = take rate8 (WArray200.WArray200.to_list (WArray200.WArray200.init64 (("_.[_]" st)))). From d6fc29703dbe64c6edcbdf48621e705aa8d6203c Mon Sep 17 00:00:00 2001 From: Manuel Barbosa Date: Thu, 16 May 2019 11:09:50 +0100 Subject: [PATCH 418/525] Fixing smt fail --- proof/impl/perm/keccak_f1600_scalar_table.ec | 15 +++++++++++---- 1 file changed, 11 insertions(+), 4 deletions(-) diff --git a/proof/impl/perm/keccak_f1600_scalar_table.ec b/proof/impl/perm/keccak_f1600_scalar_table.ec index 60a652b..cf15608 100644 --- a/proof/impl/perm/keccak_f1600_scalar_table.ec +++ b/proof/impl/perm/keccak_f1600_scalar_table.ec @@ -243,6 +243,12 @@ rewrite x86_ROL_64_E /rhotates rol_xor =>/>. smt. qed. +lemma rol00 : (forall x , (x86_ROL_64 x (W8.zero)).`3 = x). +move => *. +rewrite x86_ROL_64_E /rhotates rol_xor =>/>. +smt. +qed. + lemma scalarcorr _iotas mem : equiv [ Mrefloop2.__keccak_f1600_ref ~ Mscalartable.keccak_f : 0 <= _iotas < W64.modulus - 24 * 8 /\ @@ -309,7 +315,8 @@ do !((rcondt {2} ^if; first by move => *; wp;skip;auto => />) || wp;skip. move => &1 &2 /> h1 h2 h3 h4. apply Array25.all_eq_eq; cbv delta. -smt(rol0 @W64). +split. +smt(rol0 rol00 @W64). (* Second round *) @@ -353,7 +360,7 @@ do !((rcondt {2} ^if; first by move => *; wp;skip;auto => />) || wp;skip => />. move => &1 &2 /> h1 h2 h3 h4. apply Array25.all_eq_eq; cbv delta. -smt(rol0 @W64). +smt(rol0 rol00 @W64). auto => />. rewrite to_uintD. @@ -424,7 +431,7 @@ do !((rcondt {2} ^if; first by move => *; wp;skip;auto => />) || (rcondf {2} ^if; first by move => *; wp;skip;auto => />)). wp;skip; move => &1 &2 /> h1 h2 h3 h4 ?????; apply Array25.all_eq_eq; cbv delta. -smt(rol0 @W64). +smt(rol0 rol00 @W64). (* Second round *) @@ -475,7 +482,7 @@ do !((rcondt {2} ^if; first by move => *; wp;skip;auto => />) || (rcondf {2} ^if; first by move => *; wp;skip;auto => />)). wp;skip; move => &1 &2 /> h1 h2 h3 h4 ?????; apply Array25.all_eq_eq; cbv delta. -smt(rol0 @W64). +smt(rol0 rol00 @W64). auto => />. From f1457c78450251fa44d25098a37087e9754ff428 Mon Sep 17 00:00:00 2001 From: Manuel Barbosa Date: Thu, 16 May 2019 12:17:38 +0100 Subject: [PATCH 419/525] Pending --- proof/impl/perm/keccak_f1600_scalar_table.ec | 1 - 1 file changed, 1 deletion(-) diff --git a/proof/impl/perm/keccak_f1600_scalar_table.ec b/proof/impl/perm/keccak_f1600_scalar_table.ec index cf15608..d9ffb06 100644 --- a/proof/impl/perm/keccak_f1600_scalar_table.ec +++ b/proof/impl/perm/keccak_f1600_scalar_table.ec @@ -315,7 +315,6 @@ do !((rcondt {2} ^if; first by move => *; wp;skip;auto => />) || wp;skip. move => &1 &2 /> h1 h2 h3 h4. apply Array25.all_eq_eq; cbv delta. -split. smt(rol0 rol00 @W64). (* Second round *) From 55db81f9edae30ec0172760e2ca6e4aed618edfa Mon Sep 17 00:00:00 2001 From: Manuel Barbosa Date: Thu, 16 May 2019 12:18:22 +0100 Subject: [PATCH 420/525] Cleaning up --- proof/impl/old_perm/Array2.ec | 3 - proof/impl/old_perm/Array24.ec | 3 - proof/impl/old_perm/Array25.ec | 3 - proof/impl/old_perm/Array4.ec | 3 - proof/impl/old_perm/Array5.ec | 3 - proof/impl/old_perm/Array7.ec | 3 - proof/impl/old_perm/Array9.ec | 3 - proof/impl/old_perm/Array96.ec | 3 - proof/impl/old_perm/LoopTransform.ec | 249 --- proof/impl/old_perm/Ops.ec | 648 ------- proof/impl/old_perm/WArray128.ec | 3 - proof/impl/old_perm/WArray160.ec | 3 - proof/impl/old_perm/WArray192.ec | 3 - proof/impl/old_perm/WArray200.ec | 3 - proof/impl/old_perm/WArray224.ec | 3 - proof/impl/old_perm/WArray288.ec | 3 - proof/impl/old_perm/WArray40.ec | 3 - proof/impl/old_perm/keccak_f1600_avx2.ec | 782 --------- proof/impl/old_perm/keccak_f1600_avx2_glue.ec | 347 ---- .../impl/old_perm/keccak_f1600_avx2_prevec.ec | 1522 ----------------- proof/impl/old_perm/keccak_f1600_ref.ec | 246 --- proof/impl/old_perm/keccak_f1600_ref_loop2.ec | 169 -- proof/impl/old_perm/keccak_f1600_ref_table.ec | 247 --- proof/impl/old_perm/keccak_f1600_scalar.ec | 201 --- .../old_perm/keccak_f1600_scalar_table.ec | 599 ------- 25 files changed, 5055 deletions(-) delete mode 100644 proof/impl/old_perm/Array2.ec delete mode 100644 proof/impl/old_perm/Array24.ec delete mode 100644 proof/impl/old_perm/Array25.ec delete mode 100644 proof/impl/old_perm/Array4.ec delete mode 100644 proof/impl/old_perm/Array5.ec delete mode 100644 proof/impl/old_perm/Array7.ec delete mode 100644 proof/impl/old_perm/Array9.ec delete mode 100644 proof/impl/old_perm/Array96.ec delete mode 100644 proof/impl/old_perm/LoopTransform.ec delete mode 100644 proof/impl/old_perm/Ops.ec delete mode 100644 proof/impl/old_perm/WArray128.ec delete mode 100644 proof/impl/old_perm/WArray160.ec delete mode 100644 proof/impl/old_perm/WArray192.ec delete mode 100644 proof/impl/old_perm/WArray200.ec delete mode 100644 proof/impl/old_perm/WArray224.ec delete mode 100644 proof/impl/old_perm/WArray288.ec delete mode 100644 proof/impl/old_perm/WArray40.ec delete mode 100644 proof/impl/old_perm/keccak_f1600_avx2.ec delete mode 100644 proof/impl/old_perm/keccak_f1600_avx2_glue.ec delete mode 100644 proof/impl/old_perm/keccak_f1600_avx2_prevec.ec delete mode 100644 proof/impl/old_perm/keccak_f1600_ref.ec delete mode 100644 proof/impl/old_perm/keccak_f1600_ref_loop2.ec delete mode 100644 proof/impl/old_perm/keccak_f1600_ref_table.ec delete mode 100644 proof/impl/old_perm/keccak_f1600_scalar.ec delete mode 100644 proof/impl/old_perm/keccak_f1600_scalar_table.ec diff --git a/proof/impl/old_perm/Array2.ec b/proof/impl/old_perm/Array2.ec deleted file mode 100644 index 3a89b1c..0000000 --- a/proof/impl/old_perm/Array2.ec +++ /dev/null @@ -1,3 +0,0 @@ -from Jasmin require import JArray. - -clone export PolyArray as Array2 with op size <- 2. diff --git a/proof/impl/old_perm/Array24.ec b/proof/impl/old_perm/Array24.ec deleted file mode 100644 index 8982b77..0000000 --- a/proof/impl/old_perm/Array24.ec +++ /dev/null @@ -1,3 +0,0 @@ -from Jasmin require import JArray. - -clone export PolyArray as Array24 with op size <- 24. diff --git a/proof/impl/old_perm/Array25.ec b/proof/impl/old_perm/Array25.ec deleted file mode 100644 index 30bcb17..0000000 --- a/proof/impl/old_perm/Array25.ec +++ /dev/null @@ -1,3 +0,0 @@ -from Jasmin require import JArray. - -clone export PolyArray as Array25 with op size <- 25. diff --git a/proof/impl/old_perm/Array4.ec b/proof/impl/old_perm/Array4.ec deleted file mode 100644 index bc0e12e..0000000 --- a/proof/impl/old_perm/Array4.ec +++ /dev/null @@ -1,3 +0,0 @@ -from Jasmin require import JArray. - -clone export PolyArray as Array4 with op size <- 4. diff --git a/proof/impl/old_perm/Array5.ec b/proof/impl/old_perm/Array5.ec deleted file mode 100644 index 8dc7b36..0000000 --- a/proof/impl/old_perm/Array5.ec +++ /dev/null @@ -1,3 +0,0 @@ -from Jasmin require import JArray. - -clone export PolyArray as Array5 with op size <- 5. diff --git a/proof/impl/old_perm/Array7.ec b/proof/impl/old_perm/Array7.ec deleted file mode 100644 index 33f6cc6..0000000 --- a/proof/impl/old_perm/Array7.ec +++ /dev/null @@ -1,3 +0,0 @@ -from Jasmin require import JArray. - -clone export PolyArray as Array7 with op size <- 7. diff --git a/proof/impl/old_perm/Array9.ec b/proof/impl/old_perm/Array9.ec deleted file mode 100644 index 8759457..0000000 --- a/proof/impl/old_perm/Array9.ec +++ /dev/null @@ -1,3 +0,0 @@ -from Jasmin require import JArray. - -clone export PolyArray as Array9 with op size <- 9. diff --git a/proof/impl/old_perm/Array96.ec b/proof/impl/old_perm/Array96.ec deleted file mode 100644 index 619dabe..0000000 --- a/proof/impl/old_perm/Array96.ec +++ /dev/null @@ -1,3 +0,0 @@ -from Jasmin require import JArray. - -clone export PolyArray as Array96 with op size <- 96. diff --git a/proof/impl/old_perm/LoopTransform.ec b/proof/impl/old_perm/LoopTransform.ec deleted file mode 100644 index af09f3c..0000000 --- a/proof/impl/old_perm/LoopTransform.ec +++ /dev/null @@ -1,249 +0,0 @@ -require import AllCore StdOrder IntDiv IntExtra. -from Jasmin require import JUtils. - -abbrev [-printing] floor (n k:int) = (n %/ k) * k. - -lemma lt_floorE (k i n:int) : 0 < k => k %| i => i < floor n k <=> i + k <= floor n k. -proof. - move => hk /dvdzP [q] ->. - rewrite (IntOrder.ltr_pmul2r k hk) ltzE -(IntOrder.ler_pmul2r k hk) /#. -qed. - -lemma floor_le n k : 0 < k => floor n k <= n. -proof. rewrite {2}(divz_eq n k); smt (modz_cmp). qed. - -lemma le_floor (k i n:int) : 0 < k => k %| i => i <= n => i <= floor n k. -proof. - rewrite {1}(divz_eq n k)=> hk /dvdzP [q] ->. - case (q * k <= floor n k) => // /ltzNge; rewrite IntOrder.ltr_pmul2r // => /ltzE. - rewrite -(IntOrder.ler_pmul2r k hk); smt (modz_cmp). -qed. - -lemma le_floorE (k i n:int) : 0 < k => k %| i => i <= n <=> i <= floor n k. -proof. move => hk kd; smt (divz_eq modz_cmp le_floor). qed. - -abstract theory ExactIter. -type t. - -op c : int. -axiom c_gt0 : 0 < c. -op step : int. -axiom step_gt0 : 0 < step. - -module type AdvLoop = { - proc body(t:t, i:int) : t -}. - -module Loop(B:AdvLoop) = { - proc loop1 (t:t, n:int) = { - var i; - i = 0; - while (i < n) { - t <@ B.body(t,i); - i <- i + 1; - } - return t; - } - - proc loopk (t:t, n:int, k:int) = { - var i, j; - i = 0; - while (i < n) { - j = 0; - while (j < k) { - t <@ B.body(t, k * i + j); - j <- j + 1; - } - i <- i + 1; - } - return t; - } - - proc loopc (t:t, n:int) = { - var i, j; - i = 0; - while (i < n) { - j = 0; - while (j < c) { - t <@ B.body(t, c * i + j); - j <- j + 1; - } - i <- i + 1; - } - return t; - } - -}. - -module ILoop(B:AdvLoop) = { - proc loop1 (t:t, n:int) = { - var i; - i = 0; - while (i < n) { - t <@ B.body(t,i); - i <- i + step; - } - return t; - } - - proc loopk (t:t, n:int, k:int) = { - var i, j; - i = 0; - while (i + step * k <= n) { - j = 0; - while (j < k) { - t <@ B.body(t, i); - i <- i + step; - j <- j + 1; - } - } - while (i < n) { - t <@ B.body(t,i); - i <- i + step; - } - return t; - } - - proc loopc (t:t, n:int) = { - var i, j; - i = 0; - while (i + step * c <= n) { - j = 0; - while (j < c) { - t <@ B.body(t, i); - i <- i + step; - j <- j + 1; - } - } - while (i < n) { - t <@ B.body(t,i); - i <- i + step; - } - return t; - } - -}. - -section. - -declare module B:AdvLoop. - -equiv loop1_loopk : Loop(B).loop1 ~ Loop(B).loopk : - ={t, glob B} /\ n{1} = (k * n){2} /\ 0 < k{2} ==> ={res, glob B}. -proof. - proc. - async while [ (fun r => i%r < r), (i{1}+k{2})%r ] - [ (fun r => i%r < r), (i{2} + 1)%r ] - ( (i < n){1}) - (true) : - (={t, glob B} /\ (0 <= i <= n){2} /\ 0 < k{2} /\ n{1} = (k * n){2} /\ i{1} = k{2} * i{2}). - + smt(). + smt (). + done. - + move=> &m2; exfalso; smt(). - + move=> &m1; exfalso; smt(). - + move=> v1 v2. - rcondt{2} 1; 1: by auto => /> /#. - rcondf{2} 4; 1: by auto; conseq (_: true);auto. - exlim i{2} => i2. - wp;while (={t,glob B} /\ i{1} = k{2}*i{2} + j{2} /\ 0 <= i{2} < n{2} /\ - 0 <= j{2} <= k{2} /\ v1 = (k{2} * i2 + k{2})%r /\ i{2} = i2 /\ n{1} = (k * n){2}). - + wp;call (_: true);skip => /> &2 h0i hin h0j hjk. - rewrite !RealExtra.lt_fromint => h1 h2 h3. - have := IntOrder.ler_wpmul2l k{2} _ i{2} (n{2} - 1); smt(). - by wp;skip => /> /#. - + rcondf 1; skip => /#. - + rcondf 1; skip => /#. - by auto. -qed. - -equiv loopk_loopc : Loop(B).loopk ~ Loop(B).loopc : ={n,t, glob B} /\ k{1} = c ==> ={res, glob B}. -proof. - proc => /=. - while (={glob B, i, t, n} /\ k{1} = c);2: by auto. - wp;while (={glob B, i, j, t, n} /\ k{1} = c);2: by auto. - by wp;call (_:true);skip. -qed. - -equiv loop1_loopc : - Loop(B).loop1 ~ Loop(B).loopc : - ={t, glob B} /\ n{1} = (c * n){2} ==> ={res, glob B}. -proof. - transitivity Loop(B).loopk - (={t, glob B} /\ n{1} = c * n{2} /\ k{2} = c ==> ={res, glob B}) - (={n,t, glob B} /\ k{1} = c ==> ={res, glob B}). - + by move=> &1 &2 /> 2!->; exists (glob B){2} (t{2}, n{2}, c). - + done. - + conseq loop1_loopk; smt (c_gt0). - apply loopk_loopc. -qed. - -equiv Iloop1_loopk : ILoop(B).loop1 ~ ILoop(B).loopk : ={t, glob B, n} /\ 0 < k{2}==> ={res, glob B}. -proof. - proc => /=; exlim k{2} => k0. - case: (n{2} < 0). - + rcondf{2} 2; 1: by move=> &m1; wp; skip => &m2 />; smt (step_gt0). - by sim; wp; skip. - splitwhile{1} 2 : (i < floor n (step * k0)). - seq 2 2: (={glob B, t, n, i}); last by sim;wp;skip. - async while [ (fun r => i%r < r), (i{1} + step * k{2})%r ] - [ (fun r => i%r < r), (i{2} + step * k{2})%r ] - ( (i < floor n (step * k0)){1}) - (true) : - (={t, glob B, i, n} /\ k{2} = k0 /\ 0 < k{2} /\ (step * k0) %| i{1}). - + move=> />;smt (lt_floorE floor_le step_gt0). - + move=> /> &2 h1 h2 [[]// | h3]. - have h4 := le_floorE (step * k{2}) (i{2} + step * k{2}) n{2} _ _. - + smt (step_gt0). + by apply dvdzD => //; apply dvdzz. - smt (step_gt0). - + done. - + by move=> &m2; exfalso => /#. - + by move=> &m1; exfalso => /#. - + move=> v1 v2. - rcondt{2} 1. - + move=> &1;skip => /> *; smt (step_gt0 lt_floorE floor_le). - rcondf{2} 3. - + move=> &1. - while (j <= k /\ i = i{1} + step * j). - + by wp; call (_:true); skip => /#. - by wp; skip => />; smt (step_gt0). - exlim i{1} => i0. - while (={t, i, glob B, n} /\ i{1} = i0 + step * j{2} /\ v1 = (i0 + step * k{2})%r /\ - k{2} = k0 /\ (step * k0) %| i0 /\ 0 < k{2} /\ 0 <= j{2} <= k{2} /\ - v1 <= (floor n{1} (step * k{2}))%r). - + wp; call (_: true); skip => &1 &2 [#] 7!->> h2 h3 h4 h1. - rewrite le_fromint /= !lt_fromint=> h5 h6 h7 h8 h9 ???? [#] 2!->> /=. - split. smt(). - have <- := IntOrder.ltr_pmul2l step step_gt0 (j{2} + 1) k0. - smt (floor_le step_gt0). - wp; skip => &1 &2 [#] 6!->> h1 h2 h3 h4 2!->> /=. - rewrite le_fromint lt_fromint h2 h1 -lt_floorE /= 2://; 1:smt (step_gt0). - (do! (split => *)); 1..-2: smt(step_gt0). - by case: H1 => [?] [-> ?]; rewrite dvdzD 1:/# (_ : j_R = k0) 1:/# dvdzz. - + rcondf 1; skip => /#. - + rcondf 1; skip => /#. - by auto. -qed. - -equiv Iloopk_loopc : ILoop(B).loopk ~ ILoop(B).loopc : ={n,t, glob B} /\ k{1} = c ==> ={res, glob B}. -proof. - proc => /=; sim. - while (={glob B, i, t, n} /\ k{1} = c);2: by auto. - wp;while (={glob B, i, j, t, n} /\ k{1} = c);2: by auto. - by wp;call (_:true);skip. -qed. - -equiv Iloop1_loopc : - ILoop(B).loop1 ~ ILoop(B).loopc : - ={t, glob B, n} ==> ={res, glob B}. -proof. - transitivity ILoop(B).loopk - (={t, glob B} /\ n{1} = n{2} /\ k{2} = c ==> ={res, glob B}) - (={n,t, glob B} /\ k{1} = c ==> ={res, glob B}). - + by move=> &1 &2 /> 2!->; exists (glob B){2} (t{2}, n{2}, c). - + done. - + conseq Iloop1_loopk; smt (c_gt0). - apply Iloopk_loopc. -qed. - -end section. - -end ExactIter. diff --git a/proof/impl/old_perm/Ops.ec b/proof/impl/old_perm/Ops.ec deleted file mode 100644 index 7cd4a0e..0000000 --- a/proof/impl/old_perm/Ops.ec +++ /dev/null @@ -1,648 +0,0 @@ -require import List Int IntDiv CoreMap. - -from Jasmin require import JModel. -require import Array2 Array4 Array5. -require import WArray128 WArray160. - -type t2u64 = W64.t Array2.t. -type t4u64 = W64.t Array4.t. - -module Ops = { - proc itruncate_4u64_2u64(t : t4u64) : t2u64 = { - return Array2.of_list witness [ t.[0]; t.[1] ]; - } - proc set_160(vv : t4u64 Array5.t, i : int, o : int, v : W64.t) : t4u64 Array5.t = { - return vv.[i <- vv.[i].[o <- v]]; - } - proc get_160(vv : t4u64 Array5.t, i : int, o : int) : W64.t = { - return vv.[i].[o]; - } - proc get_128(vv : t4u64 Array4.t, i : int, o : int) : W64.t = { - return vv.[i].[o]; - } - - proc iVPBROADCAST_4u64(v : W64.t) : t4u64 = { - var r : t4u64; - r.[0] <-v; - r.[1] <-v; - r.[2] <-v; - r.[3] <-v; - return r; - } - - proc iVPMULU_256 (x y:t4u64) : t4u64 = { - var r : t4u64; - r.[0] <- mulu64 x.[0] y.[0]; - r.[1] <- mulu64 x.[1] y.[1]; - r.[2] <- mulu64 x.[2] y.[2]; - r.[3] <- mulu64 x.[3] y.[3]; - return r; - } - - proc ivadd64u256(x y:t4u64) : t4u64 = { - var r : t4u64; - r.[0] <- x.[0] + y.[0]; - r.[1] <- x.[1] + y.[1]; - r.[2] <- x.[2] + y.[2]; - r.[3] <- x.[3] + y.[3]; - return r; - } - - proc iload4u64 (mem:global_mem_t, p:W64.t) : t4u64 = { - var r : t4u64; - r.[0] <- loadW64 mem (to_uint p); - r.[1] <- loadW64 mem (to_uint (p + W64.of_int 8)); - r.[2] <- loadW64 mem (to_uint (p + W64.of_int 16)); - r.[3] <- loadW64 mem (to_uint (p + W64.of_int 24)); - return r; - } - - proc iVPERM2I128(x y:t4u64, p : W8.t) : t4u64 = { - var r : t4u64; - r <- witness; - if (to_uint p = 32) { (* 0x20 *) - r.[0] <- x.[0]; - r.[1] <- x.[1]; - r.[2] <- y.[0]; - r.[3] <- y.[1]; - } - else { - if (to_uint p = 49) { (* 0x31 *) - r.[0] <- x.[2]; - r.[1] <- x.[3]; - r.[2] <- y.[2]; - r.[3] <- y.[3]; - } - } - return r; - } - - proc iVPERMQ(x :t4u64, p : W8.t) : t4u64 = { - var r : t4u64; - r <- witness; - if (to_uint p = 128) { (* 10 00 00 00 *) - r.[0] <- x.[0]; - r.[1] <- x.[0]; - r.[2] <- x.[0]; - r.[3] <- x.[2]; - } else { - if (to_uint p = 147) { (* 10 01 00 11 *) - r.[0] <- x.[3]; - r.[1] <- x.[0]; - r.[2] <- x.[1]; - r.[3] <- x.[2]; - } else { - if (to_uint p = 78) { (* 01 00 11 10 *) - r.[0] <- x.[2]; - r.[1] <- x.[3]; - r.[2] <- x.[0]; - r.[3] <- x.[1]; - } else { - if (to_uint p = 57) { (* 00 11 10 01 *) - r.[0] <- x.[1]; - r.[1] <- x.[2]; - r.[2] <- x.[3]; - r.[3] <- x.[0]; - } else { - if (to_uint p = 141) { (* 10 00 11 01 *) - r.[0] <- x.[1]; - r.[1] <- x.[3]; - r.[2] <- x.[0]; - r.[3] <- x.[2]; - } else { - if (to_uint p = 27) { (* 00 01 10 11 *) - r.[0] <- x.[3]; - r.[1] <- x.[2]; - r.[2] <- x.[1]; - r.[3] <- x.[0]; - } else { - if (to_uint p = 114) { (* 01 11 00 10 *) - r.[0] <- x.[2]; - r.[1] <- x.[0]; - r.[2] <- x.[3]; - r.[3] <- x.[1]; - } else { - if (to_uint p = 0) { (* 00 00 00 00 *) - r.[0] <- x.[0]; - r.[1] <- x.[0]; - r.[2] <- x.[0]; - r.[3] <- x.[0]; - } else { - if (to_uint p = 30) { (* 00 01 11 10 *) - r.[0] <- x.[2]; - r.[1] <- x.[3]; - r.[2] <- x.[1]; - r.[3] <- x.[0]; - } - } - } - } - } - } - } - } - } - return r; - } - - proc iVPSRLDQ_256(x:t4u64, p : W8.t) : t4u64 = { - var r : t4u64; - r <- witness; - if (to_uint p = 6) { - r.[0] <- (x.[0] `>>` W8.of_int 48) `|` (x.[1] `<<` W8.of_int 16); - r.[1] <- x.[1] `>>` W8.of_int 48; - r.[2] <- (x.[2] `>>` W8.of_int 48) `|` (x.[3] `<<` W8.of_int 16); - r.[3] <- x.[3] `>>` W8.of_int 48; - } - else { - if (to_uint p = 8) { - r.[0] <- x.[1]; - r.[1] <- W64.zero; - r.[2] <- x.[3]; - r.[3] <- W64.zero; - } - } - return r; - } - - proc iVPUNPCKH_4u64(x y:t4u64) : t4u64 = { - var r : t4u64; - r.[0] <- x.[1]; - r.[1] <- y.[1]; - r.[2] <- x.[3]; - r.[3] <- y.[3]; - return r; - } - - proc iVPUNPCKL_4u64 (x y:t4u64) : t4u64 = { - var r : t4u64; - r.[0] <- x.[0]; - r.[1] <- y.[0]; - r.[2] <- x.[2]; - r.[3] <- y.[2]; - return r; - } - - proc iVEXTRACTI128(x:t4u64, p : W8.t) : t2u64 = { - var r : t2u64; - r <- witness; - if (to_uint p = 0) { - r.[0] <- x.[0]; - r.[1] <- x.[1]; - } - else { - if (to_uint p = 1) { - r.[0] <- x.[2]; - r.[1] <- x.[3]; - } - } - return r; - - } - - proc iVPEXTR_64(x:t2u64, p : W8.t) : W64.t = { - return x.[to_uint p]; - } - - proc ivshr64u256 (x: t4u64, y: W8.t) : t4u64 = { - var r : t4u64; - r.[0] <- x.[0] `>>` y; - r.[1] <- x.[1] `>>` y; - r.[2] <- x.[2] `>>` y; - r.[3] <- x.[3] `>>` y; - return r; - } - - proc ivshl64u256 (x: t4u64, y: W8.t) : t4u64 = { - var r : t4u64; - r.[0] <- x.[0] `<<` y; - r.[1] <- x.[1] `<<` y; - r.[2] <- x.[2] `<<` y; - r.[3] <- x.[3] `<<` y; - return r; - } - - - proc iVPSRLV_4u64 (x: t4u64, y: t4u64) : t4u64 = { - var r : t4u64; - r.[0] <- x.[0] `>>>` W64.to_uint y.[0]; - r.[1] <- x.[1] `>>>` W64.to_uint y.[1]; - r.[2] <- x.[2] `>>>` W64.to_uint y.[2]; - r.[3] <- x.[3] `>>>` W64.to_uint y.[3]; - return r; - } - - proc iVPSLLV_4u64 (x: t4u64, y: t4u64) : t4u64 = { - var r : t4u64; - r.[0] <- x.[0] `<<<` W64.to_uint y.[0]; - r.[1] <- x.[1] `<<<` W64.to_uint y.[1]; - r.[2] <- x.[2] `<<<` W64.to_uint y.[2]; - r.[3] <- x.[3] `<<<` W64.to_uint y.[3]; - return r; - } - - proc iland4u64 (x y:t4u64) : t4u64 = { - var r : t4u64; - r.[0] <- x.[0] `&` y.[0]; - r.[1] <- x.[1] `&` y.[1]; - r.[2] <- x.[2] `&` y.[2]; - r.[3] <- x.[3] `&` y.[3]; - return r; - } - - proc ilor4u64 (x y:t4u64) : t4u64 = { - var r : t4u64; - r.[0] <- x.[0] `|` y.[0]; - r.[1] <- x.[1] `|` y.[1]; - r.[2] <- x.[2] `|` y.[2]; - r.[3] <- x.[3] `|` y.[3]; - return r; - } - - proc ilandn4u64(x y:t4u64) : t4u64 = { - var r : t4u64; - r.[0] <- invw x.[0] `&` y.[0]; - r.[1] <- invw x.[1] `&` y.[1]; - r.[2] <- invw x.[2] `&` y.[2]; - r.[3] <- invw x.[3] `&` y.[3]; - return r; - } - - proc ilxor4u64(x y:t4u64) : t4u64 = { - var r : t4u64; - r.[0] <- x.[0] `^` y.[0]; - r.[1] <- x.[1] `^` y.[1]; - r.[2] <- x.[2] `^` y.[2]; - r.[3] <- x.[3] `^` y.[3]; - return r; - } - - proc iVPBLENDD_256(x y:t4u64, p : W8.t) : W64.t Array4.t = { - var r : t4u64; - r <- witness; - if (to_uint p = 192) { - r.[0] <- x.[0]; - r.[1] <- x.[1]; - r.[2] <- x.[2]; - r.[3] <- y.[3]; - } else { - if (to_uint p = 3) { - r.[0] <- y.[0]; - r.[1] <- x.[1]; - r.[2] <- x.[2]; - r.[3] <- x.[3]; - } else { - if (to_uint p = 12) { - r.[0] <- x.[0]; - r.[1] <- y.[1]; - r.[2] <- x.[2]; - r.[3] <- x.[3]; - } else { - if (to_uint p = 48) { - r.[0] <- x.[0]; - r.[1] <- x.[1]; - r.[2] <- y.[2]; - r.[3] <- x.[3]; - } - } - } - } - return r; - } - - - proc iVPSHUFD_256 (x :t4u64, p : W8.t) : t4u64 = { - var r : t4u64; - r <- witness; - if (to_uint p = 78) { (* 01 00 11 10 *) - r.[0] <- x.[1]; - r.[1] <- x.[0]; - r.[2] <- x.[3]; - r.[3] <- x.[2]; - } - return r; - } -}. - -type vt2u64 = W128.t. -type vt4u64 = W256.t. - - -module OpsV = { - proc itruncate_4u64_2u64(t : vt4u64) : vt2u64 = { - return truncateu128 t; - } - proc set_160(vv : vt4u64 Array5.t, i : int, o : int, v : W64.t) : vt4u64 Array5.t = { - return Array5.init - (WArray160.get256 (WArray160.set64 (WArray160.init256 (fun i2 => vv.[i2])) (o+4*i) v)); - } - proc get_160(vv : vt4u64 Array5.t, i : int, o : int) : W64.t = { - return (get64 (WArray160.init256 (fun i2 => vv.[i2])) (o+4*i)); - } - proc get_128(vv : vt4u64 Array4.t, i : int, o : int) : W64.t = { - return (get64 (WArray128.init256 (fun i2 => vv.[i2])) (o+4*i)); - } - - proc iVPBROADCAST_4u64(v : W64.t) : vt4u64 = { - return x86_VPBROADCAST_4u64 v; - } - - proc iVPMULU_256 (x y:vt4u64) : vt4u64 = { - return x86_VPMULU_256 x y; - } - - proc ivadd64u256(x y:vt4u64) : vt4u64 = { - return x86_VPADD_4u64 x y; - } - - proc iload4u64 (mem:global_mem_t, p:W64.t) : vt4u64 = { - return loadW256 mem (to_uint p); - } - - proc iVPERM2I128(x y:vt4u64, p : W8.t) : vt4u64 = { - return x86_VPERM2I128 x y p; - } - - proc iVPERMQ(x :vt4u64, p : W8.t) : vt4u64 = { - return x86_VPERMQ x p; - } - - proc iVPSRLDQ_256(x:vt4u64, p : W8.t) : vt4u64 = { - return x86_VPSRLDQ_256 x p; - } - - proc iVPUNPCKH_4u64(x y:vt4u64) : vt4u64 = { - return x86_VPUNPCKH_4u64 x y; - } - - proc iVPUNPCKL_4u64 (x y:vt4u64) : vt4u64 = { - return x86_VPUNPCKL_4u64 x y; - } - - proc iVEXTRACTI128(x:vt4u64, p : W8.t) : vt2u64 = { - return x86_VEXTRACTI128 x p; - } - - proc iVPEXTR_64(x:vt2u64, p : W8.t) : W64.t = { - return x86_VPEXTR_64 x p; - } - - - proc ivshr64u256 (x: vt4u64, y: W8.t) : vt4u64 = { - return x86_VPSRL_4u64 x y; - } - - proc ivshl64u256 (x: vt4u64, y: W8.t) : vt4u64 = { - return x86_VPSLL_4u64 x y; - } - - proc iVPSRLV_4u64 (x: vt4u64, y: vt4u64) : vt4u64 = { - return x86_VPSRLV_4u64 x y; - } - - proc iVPSLLV_4u64 (x: vt4u64, y: vt4u64) : vt4u64 = { - return x86_VPSLLV_4u64 x y; - } - - proc iland4u64 (x y: vt4u64) : vt4u64 = { - return x `&` y; - } - - proc ilor4u64 (x y: vt4u64) : vt4u64 = { - return x `|` y; - } - - proc ilandn4u64(x y: vt4u64) : vt4u64 = { - return x86_VPANDN_256 x y; - } - - proc ilxor4u64(x y: vt4u64) : vt4u64 = { - return x `^` y; - } - - proc iVPBLENDD_256(x y:vt4u64, p : W8.t) : vt4u64 = { - return x86_VPBLENDD_256 x y p; - } - - proc iVPSHUFD_256 (x :vt4u64, p : W8.t) : vt4u64 = { - return x86_VPSHUFD_256 x p; - } - -}. - -op is2u64 (x : t2u64) (xv: vt2u64) = xv = W2u64.pack2 [x.[0]; x.[1]]. -op is4u64 (x : t4u64) (xv: vt4u64) = xv = W4u64.pack4 [x.[0]; x.[1]; x.[2]; x.[3]]. - -equiv eq_itruncate_4u64_2u64 : Ops.itruncate_4u64_2u64 ~ OpsV.itruncate_4u64_2u64 : is4u64 t{1} t{2} ==> is2u64 res{1} res{2}. -proof. - proc; skip => &1 &2; rewrite /is2u64 /is4u64 => -> /=. - apply (Core.can_inj _ _ W128.to_uintK). - rewrite to_uint_truncateu128. - rewrite - (W128.to_uint_small (to_uint (pack4 [t{1}.[0]; t{1}.[1]; t{1}.[2]; t{1}.[3]]) %% W128.modulus)). - + by apply modz_cmp. - congr; apply W128.wordP => i hi. - rewrite W128.of_intwE hi W2u64.pack2wE 1:// /=. - rewrite /int_bit /= modz_mod. - have /= -> := modz_pow2_div 128 i; 1:smt(). - rewrite (modz_dvd_pow 1 (128 - i) _ 2) 1:/# /=. - have -> : (to_uint (pack4 [t{1}.[0]; t{1}.[1]; t{1}.[2]; t{1}.[3]]) %/ (IntExtra.(^) 2 i) %% 2 <> 0) = - (pack4 [t{1}.[0]; t{1}.[1]; t{1}.[2]; t{1}.[3]]).[i]. - + rewrite -{2}(W256.to_uintK (pack4 [t{1}.[0]; t{1}.[1]; t{1}.[2]; t{1}.[3]])) W256.of_intwE /int_bit (modz_small _ W256.modulus) 2:/#. - by have /= := W256.to_uint_cmp (pack4 [t{1}.[0]; t{1}.[1]; t{1}.[2]; t{1}.[3]]);rewrite /(`|_|). - rewrite W4u64.pack4wE 1:/#. - case: (i < 64) => hi'. - + by rewrite divz_small 1:/#. - have -> // : i %/ 64 = 1. - have -> : i = (i -64) + 1 * 64 by done. - rewrite divzMDr 1://; smt(divz_small). -qed. - -op is4u64_5 (x:t4u64 Array5.t) (xv:vt4u64 Array5.t) = - xv = Array5.init (fun i => W4u64.pack4 [x.[i].[0]; x.[i].[1]; x.[i].[2]; x.[i].[3]]). - -op is4u64_4 (x:t4u64 Array4.t) (xv:vt4u64 Array4.t) = - xv = Array4.init (fun i => W4u64.pack4 [x.[i].[0]; x.[i].[1]; x.[i].[2]; x.[i].[3]]). - -lemma get8_pack4u64 ws j: - W4u64.pack4_t ws \bits8 j = - if 0 <= j < 32 then ws.[j %/ 8] \bits8 (j %% 8) else W8.zero. -proof. - rewrite pack4E W8.wordP => i hi. - rewrite bits8E /= initE hi /= initE. - have -> /= : (0 <= j * 8 + i < 256) <=> (0 <= j < 32) by smt(). - case : (0 <= j < 32) => hj //=. - rewrite bits8E /= initE. - have -> : (j * 8 + i) %/ 64 = j %/ 8. - + rewrite {1}(divz_eq j 8) mulzDl mulzA /= -addzA divzMDl //. - by rewrite (divz_small _ 64) //; smt (modz_cmp). - rewrite hi /=;congr. - rewrite {1}(divz_eq j 8) mulzDl mulzA /= -addzA modzMDl modz_small //; smt (modz_cmp). -qed. - -lemma Array5_get_set_eq (t:'a Array5.t) i a: 0 <= i < 5 => t.[i <- a].[i] = a. -proof. by move=> hi;rewrite Array5.get_setE. qed. - -equiv eq_set_160 : Ops.set_160 ~ OpsV.set_160 : is4u64_5 vv{1} vv{2} /\ ={i,o,v} /\ 0 <= i{1} < 5 /\ 0 <= o{1} < 4 ==> is4u64_5 res{1} res{2}. -proof. - proc; skip; rewrite /is4u64_5 => /> &1 &2 h1 h2 h3 h4. - apply Array5.tP => k hk. - rewrite !Array5.initiE 1,2:// /=. - rewrite /init256 set64E get256E -(W32u8.unpack8K (W4u64.pack4 _)); congr. - apply W32u8.Pack.packP => j hj. - rewrite W32u8.Pack.initiE 1:// get_unpack8 1:// /= WArray160.initiE 1:/# /=. - rewrite WArray160.initiE 1:/# /=. - rewrite (mulzC 32) modzMDl divzMDl 1:// divz_small 1:// modz_small 1:// /= Array5.initiE 1:// /=. - rewrite !get8_pack4u64 hj /=. - have /= <- := W4u64.Pack.init_of_list (fun i => vv{1}.[k].[i]). - have /= <- := W4u64.Pack.init_of_list (fun j => vv{1}.[i{2} <- vv{1}.[i{2}].[o{2} <- v{2}]].[k].[j]). - have ? : 0 <= j %/ 8 < 4 by rewrite ltz_divLR // lez_divRL. - rewrite !W4u64.Pack.initiE 1,2:// /=. - rewrite Array5.get_setE 1://. - case: (k = i{2}) => [->> | /#]. - rewrite Array4.get_setE 1://;smt(edivzP). -qed. - -equiv eq_get_160 : Ops.get_160 ~ OpsV.get_160 : is4u64_5 vv{1} vv{2} /\ ={i,o} /\ 0 <= i{1} < 5 /\ 0 <= o{1} < 4 ==> ={res}. -proof. - proc;skip;rewrite /is4u64_5 => /> &1 &2 h1 h2 h3 h4. - rewrite /init256 get64E -(W8u8.unpack8K vv{1}.[i{2}].[o{2}]);congr. - apply W8u8.Pack.packP => j hj. - rewrite W8u8.Pack.initiE 1:// initiE 1:// /= initiE 1:/# /=. - have -> : (8 * (o{2} + 4 * i{2}) + j) = (o{2} * 8 + j) + i{2} * 32 by ring. - have ? : 0 <= o{2} * 8 + j < `|32| by smt(). - rewrite modzMDr divzMDr 1:// divz_small 1:// modz_small 1:// /=. - rewrite Array5.initiE 1:// /= get8_pack4u64. - have /= <- := W4u64.Pack.init_of_list (fun j => vv{1}.[i{2}].[j]). - rewrite divzMDl 1:// divz_small 1:// modzMDl /= initiE 1:// modz_small 1:// /#. -qed. - -equiv eq_get_128 : Ops.get_128 ~ OpsV.get_128 : is4u64_4 vv{1} vv{2} /\ ={i,o} /\ 0 <= i{1} < 4 /\ 0 <= o{1} < 4 ==> ={res}. -proof. - proc;skip;rewrite /is4u64_4 => /> &1 &2 h1 h2 h3 h4. - rewrite /init256 get64E -(W8u8.unpack8K vv{1}.[i{2}].[o{2}]);congr. - apply W8u8.Pack.packP => j hj. - rewrite W8u8.Pack.initiE 1:// initiE 1:// /= initiE 1:/# /=. - have -> : (8 * (o{2} + 4 * i{2}) + j) = (o{2} * 8 + j) + i{2} * 32 by ring. - have ? : 0 <= o{2} * 8 + j < `|32| by smt(). - rewrite modzMDr divzMDr 1:// divz_small 1:// modz_small 1:// /=. - rewrite Array4.initiE 1:// /= get8_pack4u64. - have /= <- := W4u64.Pack.init_of_list (fun j => vv{1}.[i{2}].[j]). - rewrite divzMDl 1:// divz_small 1:// modzMDl /= initiE 1:// modz_small 1:// /#. -qed. - -equiv eq_iVPBROADCAST_4u64 : Ops.iVPBROADCAST_4u64 ~ OpsV.iVPBROADCAST_4u64 : ={v} ==> is4u64 res{1} res{2}. -proof. by proc => /=;wp;skip;rewrite /is4u64. qed. - -equiv eq_iVPMULU_256 : Ops.iVPMULU_256 ~ OpsV.iVPMULU_256 : is4u64 x{1} x{2} /\ is4u64 y{1} y{2} ==> is4u64 res{1} res{2}. -proof. by proc;wp;skip;rewrite /is4u64 => /> &1; rewrite /x86_VPMULU_256. qed. - -equiv eq_ivadd64u256: Ops.ivadd64u256 ~ OpsV.ivadd64u256 : is4u64 x{1} x{2} /\ is4u64 y{1} y{2} ==> is4u64 res{1} res{2}. -proof. by proc;wp;skip;rewrite /is4u64 /x86_VPADD_4u64. qed. - -equiv eq_iload4u64: Ops.iload4u64 ~ OpsV.iload4u64 : ={mem, p} /\ to_uint p{1} + 32 <= W64.modulus ==> is4u64 res{1} res{2}. -proof. - proc; wp; skip; rewrite /is4u64 => /> &2 hp. - rewrite /loadW256 -(W32u8.unpack8K (W4u64.pack4 _));congr. - apply W32u8.Pack.packP => j hj. - rewrite initiE 1:// W32u8.get_unpack8 1:// /= get8_pack4u64 hj /=. - have /= <- := W4u64.Pack.init_of_list (fun j => loadW64 mem{2} (to_uint (p{2} + W64.of_int (8 * j)))). - have ? : 0 <= j %/ 8 < 4 by rewrite ltz_divLR // lez_divRL. - have ? := modz_cmp j 8. - rewrite initiE 1:// /loadW64 /= pack8bE 1:// initiE 1:// /=. - have heq : to_uint (W64.of_int (8 * (j %/ 8))) = 8 * (j %/ 8). - + by rewrite of_uintK modz_small 2:// /= /#. - rewrite to_uintD_small heq 1:/#; smt (edivzP). -qed. - -equiv eq_iVPERM2I128 : Ops.iVPERM2I128 ~ OpsV.iVPERM2I128 : - is4u64 x{1} x{2} /\ is4u64 y{1} y{2} /\ ={p} /\ (p{1} = W8.of_int 32 \/ p{1} = W8.of_int 49) ==> is4u64 res{1} res{2}. -proof. - by proc; wp; skip; rewrite /is4u64 => /> &1 &2 [] ->; cbv delta; rewrite !of_intwE; cbv delta. -qed. - -equiv eq_iVPERMQ : Ops.iVPERMQ ~ OpsV.iVPERMQ : is4u64 x{1} x{2} /\ ={p} /\ - (p{1} \in (map W8.of_int [128; 147; 78; 57; 141; 27; 114; 0; 30])) ==> is4u64 res{1} res{2}. -proof. proc; wp; skip; rewrite /is4u64 => /> &1 &2 [#|] />. qed. - -lemma lsr_2u64 (w1 w2:W64.t) (x:int) : 0 <= x <= 64 => - pack2 [w1; w2] `>>>` x = pack2 [(w1 `>>>` x) `|` (w2 `<<<` 64 - x); w2 `>>>` x]. -proof. - move=> hx;apply W128.wordP => i hi. - rewrite pack2wE 1://. - rewrite W128.shrwE hi /=. - case: (i < 64) => hi1. - + have [-> ->] /=: i %/ 64 = 0 /\ i %% 64 = i by smt(edivzP). - rewrite pack2wE 1:/#. - have -> : 0 <= i < 64 by smt(). - case: (i + x < 64) => hix. - + have [-> ->] /= : (i + x) %/ 64 = 0 /\ (i + x) %% 64 = i + x by smt(edivzP). - by rewrite (W64.get_out w2) 1:/#. - have [-> ->] /= : (i + x) %/ 64 = 1 /\ (i + x) %% 64 = i - (64 - x) by smt(edivzP). - by rewrite (W64.get_out w1) 1:/#. - have [-> ->] /= : i %/ 64 = 1 /\ i %% 64 = i - 64 by smt(edivzP). - case (i + x < 128) => hix;last by rewrite W128.get_out 1:/# W64.get_out 1:/#. - rewrite pack2wE 1:/#. - have -> /= : 0 <= i - 64 < 64 by smt(). - by have [-> ->] : (i + x) %/ 64 = 1 /\ (i + x) %% 64 = i - 64 + x by smt(edivzP). -qed. - -lemma lsr_0 (w:W64.t) : w `<<<` 0 = w. -proof. by apply W64.wordP => i hi; rewrite W64.shlwE hi. qed. - -equiv eq_iVPSRLDQ_256: Ops.iVPSRLDQ_256 ~ OpsV.iVPSRLDQ_256 : is4u64 x{1} x{2} /\ ={p} /\ (p{1} = W8.of_int 6 \/ p{1} = W8.of_int 8) ==> is4u64 res{1} res{2}. -proof. - proc; wp; skip; rewrite /is4u64 => /> &1 &2 h; cbv delta. - by case h => -> /=; rewrite !lsr_2u64 //= !lsr_0. -qed. - -equiv eq_iVPUNPCKH_4u64: Ops.iVPUNPCKH_4u64 ~ OpsV.iVPUNPCKH_4u64 : is4u64 x{1} x{2} /\ is4u64 y{1} y{2} ==> is4u64 res{1} res{2}. -proof. by proc; wp; skip; rewrite /is4u64 => />; cbv delta. qed. - -equiv eq_iVPUNPCKL_4u64: Ops.iVPUNPCKL_4u64 ~ OpsV.iVPUNPCKL_4u64 : is4u64 x{1} x{2} /\ is4u64 y{1} y{2} ==> is4u64 res{1} res{2}. -proof. by proc; wp; skip; rewrite /is4u64 => />; cbv delta. qed. - -equiv eq_iVEXTRACTI128: Ops.iVEXTRACTI128 ~ OpsV.iVEXTRACTI128 : is4u64 x{1} x{2} /\ ={p} /\ (p{1} = W8.of_int 0 \/ p{2} = W8.of_int 1) ==> is2u64 res{1} res{2}. -proof. - proc; wp; skip;rewrite /is4u64 /is2u64 /x86_VEXTRACTI128 => /> &1 &2 [] ->; cbv delta => //. - by rewrite W8.of_intwE. -qed. - -equiv eq_iVPEXTR_64: Ops.iVPEXTR_64 ~ OpsV.iVPEXTR_64 : is2u64 x{1} x{2} /\ ={p} /\ (p{1} = W8.of_int 0 \/ p{2} = W8.of_int 1)==> res{1} = res{2}. -proof. by proc; skip; rewrite /is2u64 /x86_VPEXTR_64 => /> &1 &2 [] -> /=. qed. - -equiv eq_ivshr64u256: Ops.ivshr64u256 ~ OpsV.ivshr64u256 : is4u64 x{1} x{2} /\ ={y} ==> is4u64 res{1} res{2}. -proof. by proc; wp; skip; rewrite /is4u64 /x86_VPSRL_4u64. qed. - -equiv eq_ivshl64u256: Ops.ivshl64u256 ~ OpsV.ivshl64u256 : is4u64 x{1} x{2} /\ ={y} ==> is4u64 res{1} res{2}. -proof. by proc; wp; skip; rewrite /is4u64 /x86_VPSLL_4u64. qed. - -equiv eq_iland4u64: Ops.iland4u64 ~ OpsV.iland4u64 : is4u64 x{1} x{2} /\ is4u64 y{1} y{2} ==> is4u64 res{1} res{2}. -proof. by proc; wp; skip; rewrite /is4u64. qed. - -equiv eq_ilor4u64: Ops.ilor4u64 ~ OpsV.ilor4u64 : is4u64 x{1} x{2} /\ is4u64 y{1} y{2} ==> is4u64 res{1} res{2}. -proof. by proc; wp; skip; rewrite /is4u64. qed. - -equiv eq_ilandn4u64 : Ops.ilandn4u64 ~ OpsV.ilandn4u64 : is4u64 x{1} x{2} /\ is4u64 y{1} y{2} ==> is4u64 res{1} res{2}. -proof. by proc; wp; skip; rewrite /is4u64 => />; cbv delta. qed. - -equiv eq_ilxor4u64: Ops.ilxor4u64 ~ OpsV.ilxor4u64 : is4u64 x{1} x{2} /\ is4u64 y{1} y{2} ==> is4u64 res{1} res{2}. -proof. by proc; wp; skip; rewrite /is4u64. qed. - -equiv eq_iVPSRLV_4u64 : Ops.iVPSRLV_4u64 ~ OpsV.iVPSRLV_4u64 : is4u64 x{1} x{2} /\ is4u64 y{1} y{2} ==> is4u64 res{1} res{2}. -proof. by proc;wp; skip; rewrite /is4u64 => />; cbv delta. qed. - -equiv eq_iVPSLLV_4u64 : Ops.iVPSLLV_4u64 ~ OpsV.iVPSLLV_4u64 : is4u64 x{1} x{2} /\ is4u64 y{1} y{2} ==> is4u64 res{1} res{2}. -proof. by proc;wp; skip; rewrite /is4u64 => />; cbv delta. qed. - -equiv eq_iVPBLENDD_256 : Ops.iVPBLENDD_256 ~ OpsV.iVPBLENDD_256 : - is4u64 x{1} x{2} /\ is4u64 y{1} y{2} /\ ={p} /\ p{1} \in map W8.of_int [192; 3; 12; 48] - ==> - is4u64 res{1} res{2}. -proof. - proc; wp; skip; rewrite /is4u64 => /> &1 &2. - by move=> [#|] />; cbv delta; rewrite !W8.of_intwE /=; apply W8u32.allP;cbv delta. -qed. - -equiv eq_iVPSHUFD_256 : Ops.iVPSHUFD_256 ~ OpsV.iVPSHUFD_256 : - is4u64 x{1} x{2} /\ ={p} /\ p{1} = W8.of_int 78 ==> is4u64 res{1} res{2}. -proof. by proc; wp; skip; rewrite /is4u64 => /> &1; apply W8u32.allP;cbv delta. qed. diff --git a/proof/impl/old_perm/WArray128.ec b/proof/impl/old_perm/WArray128.ec deleted file mode 100644 index 3c9d689..0000000 --- a/proof/impl/old_perm/WArray128.ec +++ /dev/null @@ -1,3 +0,0 @@ -from Jasmin require import JWord_array. - -clone export WArray as WArray128 with op size <- 128. diff --git a/proof/impl/old_perm/WArray160.ec b/proof/impl/old_perm/WArray160.ec deleted file mode 100644 index 05cce71..0000000 --- a/proof/impl/old_perm/WArray160.ec +++ /dev/null @@ -1,3 +0,0 @@ -from Jasmin require import JWord_array. - -clone export WArray as WArray160 with op size <- 160. diff --git a/proof/impl/old_perm/WArray192.ec b/proof/impl/old_perm/WArray192.ec deleted file mode 100644 index c8564c5..0000000 --- a/proof/impl/old_perm/WArray192.ec +++ /dev/null @@ -1,3 +0,0 @@ -from Jasmin require import JWord_array. - -clone export WArray as WArray192 with op size <- 192. diff --git a/proof/impl/old_perm/WArray200.ec b/proof/impl/old_perm/WArray200.ec deleted file mode 100644 index 99b887c..0000000 --- a/proof/impl/old_perm/WArray200.ec +++ /dev/null @@ -1,3 +0,0 @@ -from Jasmin require import JWord_array. - -clone export WArray as WArray200 with op size <- 200. diff --git a/proof/impl/old_perm/WArray224.ec b/proof/impl/old_perm/WArray224.ec deleted file mode 100644 index f9d6745..0000000 --- a/proof/impl/old_perm/WArray224.ec +++ /dev/null @@ -1,3 +0,0 @@ -from Jasmin require import JWord_array. - -clone export WArray as WArray224 with op size <- 224. diff --git a/proof/impl/old_perm/WArray288.ec b/proof/impl/old_perm/WArray288.ec deleted file mode 100644 index 86ac7cc..0000000 --- a/proof/impl/old_perm/WArray288.ec +++ /dev/null @@ -1,3 +0,0 @@ -from Jasmin require import JWord_array. - -clone export WArray as WArray288 with op size <- 288. diff --git a/proof/impl/old_perm/WArray40.ec b/proof/impl/old_perm/WArray40.ec deleted file mode 100644 index 003b6e2..0000000 --- a/proof/impl/old_perm/WArray40.ec +++ /dev/null @@ -1,3 +0,0 @@ -from Jasmin require import JWord_array. - -clone export WArray as WArray40 with op size <- 40. diff --git a/proof/impl/old_perm/keccak_f1600_avx2.ec b/proof/impl/old_perm/keccak_f1600_avx2.ec deleted file mode 100644 index 84e0a08..0000000 --- a/proof/impl/old_perm/keccak_f1600_avx2.ec +++ /dev/null @@ -1,782 +0,0 @@ -require import List Int IntExtra IntDiv CoreMap. -from Jasmin require import JModel. - -require import Array7 Array9. -require import WArray224 WArray288. - - - -module M = { - proc keccak_f1600 (state:W256.t Array7.t, _rhotates_left:W64.t, - _rhotates_right:W64.t, _iotas:W64.t) : W256.t Array7.t = { - - var rhotates_left:W64.t; - var rhotates_right:W64.t; - var iotas:W64.t; - var r:W32.t; - var zf:bool; - var c00:W256.t; - var c14:W256.t; - var t:W256.t Array9.t; - var d14:W256.t; - var d00:W256.t; - var _0:bool; - var _1:bool; - var _2:bool; - t <- witness; - rhotates_left <- (_rhotates_left + (W64.of_int 96)); - rhotates_right <- (_rhotates_right + (W64.of_int 96)); - iotas <- _iotas; - r <- (W32.of_int 24); - c00 <- x86_VPSHUFD_256 state.[2] - (W8.of_int (2 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 1)))); - c14 <- (state.[5] `^` state.[3]); - t.[2] <- (state.[4] `^` state.[6]); - c14 <- (c14 `^` state.[1]); - c14 <- (c14 `^` t.[2]); - t.[4] <- x86_VPERMQ c14 - (W8.of_int (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (1 %% 2^2 + 2^2 * 2)))); - c00 <- (c00 `^` state.[2]); - t.[0] <- x86_VPERMQ c00 - (W8.of_int (2 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 1)))); - t.[1] <- (c14 \vshr64u256 (W8.of_int 63)); - t.[2] <- (c14 \vadd64u256 c14); - t.[1] <- (t.[1] `|` t.[2]); - d14 <- x86_VPERMQ t.[1] - (W8.of_int (1 %% 2^2 + 2^2 * (2 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); - d00 <- (t.[1] `^` t.[4]); - d00 <- x86_VPERMQ d00 - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); - c00 <- (c00 `^` state.[0]); - c00 <- (c00 `^` t.[0]); - t.[0] <- (c00 \vshr64u256 (W8.of_int 63)); - t.[1] <- (c00 \vadd64u256 c00); - t.[1] <- (t.[1] `|` t.[0]); - state.[2] <- (state.[2] `^` d00); - state.[0] <- (state.[0] `^` d00); - d14 <- x86_VPBLENDD_256 d14 t.[1] - (W8.of_int (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); - t.[4] <- x86_VPBLENDD_256 t.[4] c00 - (W8.of_int (1 %% 2^1 + - 2^1 * (1 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); - d14 <- (d14 `^` t.[4]); - t.[3] <- x86_VPSLLV_4u64 state.[2] - (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((0 * 32) - 96))))); - state.[2] <- x86_VPSRLV_4u64 state.[2] - (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((0 * 32) - 96))))); - state.[2] <- (state.[2] `|` t.[3]); - state.[3] <- (state.[3] `^` d14); - t.[4] <- x86_VPSLLV_4u64 state.[3] - (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((2 * 32) - 96))))); - state.[3] <- x86_VPSRLV_4u64 state.[3] - (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((2 * 32) - 96))))); - state.[3] <- (state.[3] `|` t.[4]); - state.[4] <- (state.[4] `^` d14); - t.[5] <- x86_VPSLLV_4u64 state.[4] - (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((3 * 32) - 96))))); - state.[4] <- x86_VPSRLV_4u64 state.[4] - (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((3 * 32) - 96))))); - state.[4] <- (state.[4] `|` t.[5]); - state.[5] <- (state.[5] `^` d14); - t.[6] <- x86_VPSLLV_4u64 state.[5] - (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((4 * 32) - 96))))); - state.[5] <- x86_VPSRLV_4u64 state.[5] - (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((4 * 32) - 96))))); - state.[5] <- (state.[5] `|` t.[6]); - state.[6] <- (state.[6] `^` d14); - t.[3] <- x86_VPERMQ state.[2] - (W8.of_int (1 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 2)))); - t.[4] <- x86_VPERMQ state.[3] - (W8.of_int (1 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 2)))); - t.[7] <- x86_VPSLLV_4u64 state.[6] - (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((5 * 32) - 96))))); - t.[1] <- x86_VPSRLV_4u64 state.[6] - (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((5 * 32) - 96))))); - t.[1] <- (t.[1] `|` t.[7]); - state.[1] <- (state.[1] `^` d14); - t.[5] <- x86_VPERMQ state.[4] - (W8.of_int (3 %% 2^2 + 2^2 * (2 %% 2^2 + 2^2 * (1 %% 2^2 + 2^2 * 0)))); - t.[6] <- x86_VPERMQ state.[5] - (W8.of_int (2 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 1)))); - t.[8] <- x86_VPSLLV_4u64 state.[1] - (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((1 * 32) - 96))))); - t.[2] <- x86_VPSRLV_4u64 state.[1] - (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((1 * 32) - 96))))); - t.[2] <- (t.[2] `|` t.[8]); - t.[7] <- x86_VPSRLDQ_256 t.[1] (W8.of_int 8); - t.[0] <- ((invw t.[1]) `&` t.[7]); - state.[3] <- x86_VPBLENDD_256 t.[2] t.[6] - (W8.of_int (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (1 %% 2^1 + - 2^1 * (1 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); - t.[8] <- x86_VPBLENDD_256 t.[4] t.[2] - (W8.of_int (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (1 %% 2^1 + - 2^1 * (1 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); - state.[5] <- x86_VPBLENDD_256 t.[3] t.[4] - (W8.of_int (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (1 %% 2^1 + - 2^1 * (1 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); - t.[7] <- x86_VPBLENDD_256 t.[2] t.[3] - (W8.of_int (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (1 %% 2^1 + - 2^1 * (1 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); - state.[3] <- x86_VPBLENDD_256 state.[3] t.[4] - (W8.of_int (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (1 %% 2^1 + - 2^1 * (1 %% 2^1 + - 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); - t.[8] <- x86_VPBLENDD_256 t.[8] t.[5] - (W8.of_int (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (1 %% 2^1 + - 2^1 * (1 %% 2^1 + - 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); - state.[5] <- x86_VPBLENDD_256 state.[5] t.[2] - (W8.of_int (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (1 %% 2^1 + - 2^1 * (1 %% 2^1 + - 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); - t.[7] <- x86_VPBLENDD_256 t.[7] t.[6] - (W8.of_int (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (1 %% 2^1 + - 2^1 * (1 %% 2^1 + - 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); - state.[3] <- x86_VPBLENDD_256 state.[3] t.[5] - (W8.of_int (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); - t.[8] <- x86_VPBLENDD_256 t.[8] t.[6] - (W8.of_int (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); - state.[5] <- x86_VPBLENDD_256 state.[5] t.[6] - (W8.of_int (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); - t.[7] <- x86_VPBLENDD_256 t.[7] t.[4] - (W8.of_int (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); - state.[3] <- ((invw state.[3]) `&` t.[8]); - state.[5] <- ((invw state.[5]) `&` t.[7]); - state.[6] <- x86_VPBLENDD_256 t.[5] t.[2] - (W8.of_int (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (1 %% 2^1 + - 2^1 * (1 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); - t.[8] <- x86_VPBLENDD_256 t.[3] t.[5] - (W8.of_int (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (1 %% 2^1 + - 2^1 * (1 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); - state.[3] <- (state.[3] `^` t.[3]); - state.[6] <- x86_VPBLENDD_256 state.[6] t.[3] - (W8.of_int (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (1 %% 2^1 + - 2^1 * (1 %% 2^1 + - 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); - t.[8] <- x86_VPBLENDD_256 t.[8] t.[4] - (W8.of_int (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (1 %% 2^1 + - 2^1 * (1 %% 2^1 + - 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); - state.[5] <- (state.[5] `^` t.[5]); - state.[6] <- x86_VPBLENDD_256 state.[6] t.[4] - (W8.of_int (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); - t.[8] <- x86_VPBLENDD_256 t.[8] t.[2] - (W8.of_int (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); - state.[6] <- ((invw state.[6]) `&` t.[8]); - state.[6] <- (state.[6] `^` t.[6]); - state.[4] <- x86_VPERMQ t.[1] - (W8.of_int (2 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (1 %% 2^2 + 2^2 * 0)))); - t.[8] <- x86_VPBLENDD_256 state.[4] state.[0] - (W8.of_int (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (1 %% 2^1 + - 2^1 * (1 %% 2^1 + - 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); - state.[1] <- x86_VPERMQ t.[1] - (W8.of_int (1 %% 2^2 + 2^2 * (2 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); - state.[1] <- x86_VPBLENDD_256 state.[1] state.[0] - (W8.of_int (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); - state.[1] <- ((invw state.[1]) `&` t.[8]); - state.[2] <- x86_VPBLENDD_256 t.[4] t.[5] - (W8.of_int (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (1 %% 2^1 + - 2^1 * (1 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); - t.[7] <- x86_VPBLENDD_256 t.[6] t.[4] - (W8.of_int (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (1 %% 2^1 + - 2^1 * (1 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); - state.[2] <- x86_VPBLENDD_256 state.[2] t.[6] - (W8.of_int (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (1 %% 2^1 + - 2^1 * (1 %% 2^1 + - 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); - t.[7] <- x86_VPBLENDD_256 t.[7] t.[3] - (W8.of_int (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (1 %% 2^1 + - 2^1 * (1 %% 2^1 + - 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); - state.[2] <- x86_VPBLENDD_256 state.[2] t.[3] - (W8.of_int (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); - t.[7] <- x86_VPBLENDD_256 t.[7] t.[5] - (W8.of_int (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); - state.[2] <- ((invw state.[2]) `&` t.[7]); - state.[2] <- (state.[2] `^` t.[2]); - t.[0] <- x86_VPERMQ t.[0] - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); - state.[3] <- x86_VPERMQ state.[3] - (W8.of_int (3 %% 2^2 + 2^2 * (2 %% 2^2 + 2^2 * (1 %% 2^2 + 2^2 * 0)))); - state.[5] <- x86_VPERMQ state.[5] - (W8.of_int (1 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 2)))); - state.[6] <- x86_VPERMQ state.[6] - (W8.of_int (2 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 1)))); - state.[4] <- x86_VPBLENDD_256 t.[6] t.[3] - (W8.of_int (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (1 %% 2^1 + - 2^1 * (1 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); - t.[7] <- x86_VPBLENDD_256 t.[5] t.[6] - (W8.of_int (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (1 %% 2^1 + - 2^1 * (1 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); - state.[4] <- x86_VPBLENDD_256 state.[4] t.[5] - (W8.of_int (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (1 %% 2^1 + - 2^1 * (1 %% 2^1 + - 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); - t.[7] <- x86_VPBLENDD_256 t.[7] t.[2] - (W8.of_int (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (1 %% 2^1 + - 2^1 * (1 %% 2^1 + - 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); - state.[4] <- x86_VPBLENDD_256 state.[4] t.[2] - (W8.of_int (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); - t.[7] <- x86_VPBLENDD_256 t.[7] t.[3] - (W8.of_int (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); - state.[4] <- ((invw state.[4]) `&` t.[7]); - state.[0] <- (state.[0] `^` t.[0]); - state.[1] <- (state.[1] `^` t.[1]); - state.[4] <- (state.[4] `^` t.[4]); - state.[0] <- - (state.[0] `^` (loadW256 Glob.mem (W64.to_uint (iotas + (W64.of_int ((0 * 32) - 0)))))); - iotas <- (iotas + (W64.of_int 32)); - ( _0, _1, _2, zf, r) <- x86_DEC_32 r; - while ((! zf)) { - c00 <- x86_VPSHUFD_256 state.[2] - (W8.of_int (2 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 1)))); - c14 <- (state.[5] `^` state.[3]); - t.[2] <- (state.[4] `^` state.[6]); - c14 <- (c14 `^` state.[1]); - c14 <- (c14 `^` t.[2]); - t.[4] <- x86_VPERMQ c14 - (W8.of_int (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (1 %% 2^2 + 2^2 * 2)))); - c00 <- (c00 `^` state.[2]); - t.[0] <- x86_VPERMQ c00 - (W8.of_int (2 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 1)))); - t.[1] <- (c14 \vshr64u256 (W8.of_int 63)); - t.[2] <- (c14 \vadd64u256 c14); - t.[1] <- (t.[1] `|` t.[2]); - d14 <- x86_VPERMQ t.[1] - (W8.of_int (1 %% 2^2 + 2^2 * (2 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); - d00 <- (t.[1] `^` t.[4]); - d00 <- x86_VPERMQ d00 - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); - c00 <- (c00 `^` state.[0]); - c00 <- (c00 `^` t.[0]); - t.[0] <- (c00 \vshr64u256 (W8.of_int 63)); - t.[1] <- (c00 \vadd64u256 c00); - t.[1] <- (t.[1] `|` t.[0]); - state.[2] <- (state.[2] `^` d00); - state.[0] <- (state.[0] `^` d00); - d14 <- x86_VPBLENDD_256 d14 t.[1] - (W8.of_int (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); - t.[4] <- x86_VPBLENDD_256 t.[4] c00 - (W8.of_int (1 %% 2^1 + - 2^1 * (1 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); - d14 <- (d14 `^` t.[4]); - t.[3] <- x86_VPSLLV_4u64 state.[2] - (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((0 * 32) - 96))))); - state.[2] <- x86_VPSRLV_4u64 state.[2] - (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((0 * 32) - 96))))); - state.[2] <- (state.[2] `|` t.[3]); - state.[3] <- (state.[3] `^` d14); - t.[4] <- x86_VPSLLV_4u64 state.[3] - (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((2 * 32) - 96))))); - state.[3] <- x86_VPSRLV_4u64 state.[3] - (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((2 * 32) - 96))))); - state.[3] <- (state.[3] `|` t.[4]); - state.[4] <- (state.[4] `^` d14); - t.[5] <- x86_VPSLLV_4u64 state.[4] - (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((3 * 32) - 96))))); - state.[4] <- x86_VPSRLV_4u64 state.[4] - (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((3 * 32) - 96))))); - state.[4] <- (state.[4] `|` t.[5]); - state.[5] <- (state.[5] `^` d14); - t.[6] <- x86_VPSLLV_4u64 state.[5] - (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((4 * 32) - 96))))); - state.[5] <- x86_VPSRLV_4u64 state.[5] - (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((4 * 32) - 96))))); - state.[5] <- (state.[5] `|` t.[6]); - state.[6] <- (state.[6] `^` d14); - t.[3] <- x86_VPERMQ state.[2] - (W8.of_int (1 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 2)))); - t.[4] <- x86_VPERMQ state.[3] - (W8.of_int (1 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 2)))); - t.[7] <- x86_VPSLLV_4u64 state.[6] - (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((5 * 32) - 96))))); - t.[1] <- x86_VPSRLV_4u64 state.[6] - (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((5 * 32) - 96))))); - t.[1] <- (t.[1] `|` t.[7]); - state.[1] <- (state.[1] `^` d14); - t.[5] <- x86_VPERMQ state.[4] - (W8.of_int (3 %% 2^2 + 2^2 * (2 %% 2^2 + 2^2 * (1 %% 2^2 + 2^2 * 0)))); - t.[6] <- x86_VPERMQ state.[5] - (W8.of_int (2 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 1)))); - t.[8] <- x86_VPSLLV_4u64 state.[1] - (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((1 * 32) - 96))))); - t.[2] <- x86_VPSRLV_4u64 state.[1] - (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((1 * 32) - 96))))); - t.[2] <- (t.[2] `|` t.[8]); - t.[7] <- x86_VPSRLDQ_256 t.[1] (W8.of_int 8); - t.[0] <- ((invw t.[1]) `&` t.[7]); - state.[3] <- x86_VPBLENDD_256 t.[2] t.[6] - (W8.of_int (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (1 %% 2^1 + - 2^1 * (1 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); - t.[8] <- x86_VPBLENDD_256 t.[4] t.[2] - (W8.of_int (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (1 %% 2^1 + - 2^1 * (1 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); - state.[5] <- x86_VPBLENDD_256 t.[3] t.[4] - (W8.of_int (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (1 %% 2^1 + - 2^1 * (1 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); - t.[7] <- x86_VPBLENDD_256 t.[2] t.[3] - (W8.of_int (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (1 %% 2^1 + - 2^1 * (1 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); - state.[3] <- x86_VPBLENDD_256 state.[3] t.[4] - (W8.of_int (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (1 %% 2^1 + - 2^1 * (1 %% 2^1 + - 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); - t.[8] <- x86_VPBLENDD_256 t.[8] t.[5] - (W8.of_int (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (1 %% 2^1 + - 2^1 * (1 %% 2^1 + - 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); - state.[5] <- x86_VPBLENDD_256 state.[5] t.[2] - (W8.of_int (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (1 %% 2^1 + - 2^1 * (1 %% 2^1 + - 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); - t.[7] <- x86_VPBLENDD_256 t.[7] t.[6] - (W8.of_int (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (1 %% 2^1 + - 2^1 * (1 %% 2^1 + - 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); - state.[3] <- x86_VPBLENDD_256 state.[3] t.[5] - (W8.of_int (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); - t.[8] <- x86_VPBLENDD_256 t.[8] t.[6] - (W8.of_int (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); - state.[5] <- x86_VPBLENDD_256 state.[5] t.[6] - (W8.of_int (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); - t.[7] <- x86_VPBLENDD_256 t.[7] t.[4] - (W8.of_int (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); - state.[3] <- ((invw state.[3]) `&` t.[8]); - state.[5] <- ((invw state.[5]) `&` t.[7]); - state.[6] <- x86_VPBLENDD_256 t.[5] t.[2] - (W8.of_int (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (1 %% 2^1 + - 2^1 * (1 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); - t.[8] <- x86_VPBLENDD_256 t.[3] t.[5] - (W8.of_int (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (1 %% 2^1 + - 2^1 * (1 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); - state.[3] <- (state.[3] `^` t.[3]); - state.[6] <- x86_VPBLENDD_256 state.[6] t.[3] - (W8.of_int (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (1 %% 2^1 + - 2^1 * (1 %% 2^1 + - 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); - t.[8] <- x86_VPBLENDD_256 t.[8] t.[4] - (W8.of_int (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (1 %% 2^1 + - 2^1 * (1 %% 2^1 + - 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); - state.[5] <- (state.[5] `^` t.[5]); - state.[6] <- x86_VPBLENDD_256 state.[6] t.[4] - (W8.of_int (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); - t.[8] <- x86_VPBLENDD_256 t.[8] t.[2] - (W8.of_int (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); - state.[6] <- ((invw state.[6]) `&` t.[8]); - state.[6] <- (state.[6] `^` t.[6]); - state.[4] <- x86_VPERMQ t.[1] - (W8.of_int (2 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (1 %% 2^2 + 2^2 * 0)))); - t.[8] <- x86_VPBLENDD_256 state.[4] state.[0] - (W8.of_int (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (1 %% 2^1 + - 2^1 * (1 %% 2^1 + - 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); - state.[1] <- x86_VPERMQ t.[1] - (W8.of_int (1 %% 2^2 + 2^2 * (2 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); - state.[1] <- x86_VPBLENDD_256 state.[1] state.[0] - (W8.of_int (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); - state.[1] <- ((invw state.[1]) `&` t.[8]); - state.[2] <- x86_VPBLENDD_256 t.[4] t.[5] - (W8.of_int (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (1 %% 2^1 + - 2^1 * (1 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); - t.[7] <- x86_VPBLENDD_256 t.[6] t.[4] - (W8.of_int (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (1 %% 2^1 + - 2^1 * (1 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); - state.[2] <- x86_VPBLENDD_256 state.[2] t.[6] - (W8.of_int (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (1 %% 2^1 + - 2^1 * (1 %% 2^1 + - 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); - t.[7] <- x86_VPBLENDD_256 t.[7] t.[3] - (W8.of_int (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (1 %% 2^1 + - 2^1 * (1 %% 2^1 + - 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); - state.[2] <- x86_VPBLENDD_256 state.[2] t.[3] - (W8.of_int (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); - t.[7] <- x86_VPBLENDD_256 t.[7] t.[5] - (W8.of_int (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); - state.[2] <- ((invw state.[2]) `&` t.[7]); - state.[2] <- (state.[2] `^` t.[2]); - t.[0] <- x86_VPERMQ t.[0] - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); - state.[3] <- x86_VPERMQ state.[3] - (W8.of_int (3 %% 2^2 + 2^2 * (2 %% 2^2 + 2^2 * (1 %% 2^2 + 2^2 * 0)))); - state.[5] <- x86_VPERMQ state.[5] - (W8.of_int (1 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 2)))); - state.[6] <- x86_VPERMQ state.[6] - (W8.of_int (2 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 1)))); - state.[4] <- x86_VPBLENDD_256 t.[6] t.[3] - (W8.of_int (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (1 %% 2^1 + - 2^1 * (1 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); - t.[7] <- x86_VPBLENDD_256 t.[5] t.[6] - (W8.of_int (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (1 %% 2^1 + - 2^1 * (1 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); - state.[4] <- x86_VPBLENDD_256 state.[4] t.[5] - (W8.of_int (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (1 %% 2^1 + - 2^1 * (1 %% 2^1 + - 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); - t.[7] <- x86_VPBLENDD_256 t.[7] t.[2] - (W8.of_int (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (1 %% 2^1 + - 2^1 * (1 %% 2^1 + - 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); - state.[4] <- x86_VPBLENDD_256 state.[4] t.[2] - (W8.of_int (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); - t.[7] <- x86_VPBLENDD_256 t.[7] t.[3] - (W8.of_int (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (0 %% 2^1 + - 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); - state.[4] <- ((invw state.[4]) `&` t.[7]); - state.[0] <- (state.[0] `^` t.[0]); - state.[1] <- (state.[1] `^` t.[1]); - state.[4] <- (state.[4] `^` t.[4]); - state.[0] <- - (state.[0] `^` (loadW256 Glob.mem (W64.to_uint (iotas + (W64.of_int ((0 * 32) - 0)))))); - iotas <- (iotas + (W64.of_int 32)); - ( _0, _1, _2, zf, r) <- x86_DEC_32 r; - } - return (state); - } -}. - diff --git a/proof/impl/old_perm/keccak_f1600_avx2_glue.ec b/proof/impl/old_perm/keccak_f1600_avx2_glue.ec deleted file mode 100644 index 4a03ed6..0000000 --- a/proof/impl/old_perm/keccak_f1600_avx2_glue.ec +++ /dev/null @@ -1,347 +0,0 @@ -require import List Int IntExtra IntDiv CoreMap. -from Jasmin require import JModel. - -require import Array9. -require import WArray288. - - - -module M = { - proc __KeccakF1600 (_A00:W256.t, _A01:W256.t, _A20:W256.t, _A31:W256.t, - _A21:W256.t, _A41:W256.t, _A11:W256.t, - _rhotates_left:W64.t, _rhotates_right:W64.t, - _iotas:W64.t) : W256.t * W256.t * W256.t * W256.t * - W256.t * W256.t * W256.t = { - - var rhotates_left:W64.t; - var rhotates_right:W64.t; - var iotas:W64.t; - var i:W32.t; - var zf:bool; - var _C00:W256.t; - var _C14:W256.t; - var _T:W256.t Array9.t; - var _D14:W256.t; - var _D00:W256.t; - var _0:bool; - var _1:bool; - var _2:bool; - _T <- witness; - rhotates_left <- (_rhotates_left + (W64.of_int 96)); - rhotates_right <- (_rhotates_right + (W64.of_int 96)); - iotas <- _iotas; - i <- (W32.of_int 24); - _C00 <- x86_VPSHUFD_256 _A20 (W8.of_int 78); - _C14 <- (_A41 `^` _A31); - _T.[2] <- (_A21 `^` _A11); - _C14 <- (_C14 `^` _A01); - _C14 <- (_C14 `^` _T.[2]); - _T.[4] <- x86_VPERMQ _C14 (W8.of_int 147); - _C00 <- (_C00 `^` _A20); - _T.[0] <- x86_VPERMQ _C00 (W8.of_int 78); - _T.[1] <- (_C14 \vshr64u256 (W8.of_int 63)); - _T.[2] <- (_C14 \vadd64u256 _C14); - _T.[1] <- (_T.[1] `|` _T.[2]); - _D14 <- x86_VPERMQ _T.[1] (W8.of_int 57); - _D00 <- (_T.[1] `^` _T.[4]); - _D00 <- x86_VPERMQ _D00 (W8.of_int 0); - _C00 <- (_C00 `^` _A00); - _C00 <- (_C00 `^` _T.[0]); - _T.[0] <- (_C00 \vshr64u256 (W8.of_int 63)); - _T.[1] <- (_C00 \vadd64u256 _C00); - _T.[1] <- (_T.[1] `|` _T.[0]); - _A20 <- (_A20 `^` _D00); - _A00 <- (_A00 `^` _D00); - _D14 <- x86_VPBLENDD_256 _D14 _T.[1] - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); - _T.[4] <- x86_VPBLENDD_256 _T.[4] _C00 - (W8.of_int (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); - _D14 <- (_D14 `^` _T.[4]); - _T.[3] <- x86_VPSLLV_4u64 _A20 - (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((0 * 32) - 96))))); - _A20 <- x86_VPSRLV_4u64 _A20 - (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((0 * 32) - 96))))); - _A20 <- (_A20 `|` _T.[3]); - _A31 <- (_A31 `^` _D14); - _T.[4] <- x86_VPSLLV_4u64 _A31 - (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((2 * 32) - 96))))); - _A31 <- x86_VPSRLV_4u64 _A31 - (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((2 * 32) - 96))))); - _A31 <- (_A31 `|` _T.[4]); - _A21 <- (_A21 `^` _D14); - _T.[5] <- x86_VPSLLV_4u64 _A21 - (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((3 * 32) - 96))))); - _A21 <- x86_VPSRLV_4u64 _A21 - (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((3 * 32) - 96))))); - _A21 <- (_A21 `|` _T.[5]); - _A41 <- (_A41 `^` _D14); - _T.[6] <- x86_VPSLLV_4u64 _A41 - (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((4 * 32) - 96))))); - _A41 <- x86_VPSRLV_4u64 _A41 - (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((4 * 32) - 96))))); - _A41 <- (_A41 `|` _T.[6]); - _A11 <- (_A11 `^` _D14); - _T.[3] <- x86_VPERMQ _A20 (W8.of_int 141); - _T.[4] <- x86_VPERMQ _A31 (W8.of_int 141); - _T.[7] <- x86_VPSLLV_4u64 _A11 - (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((5 * 32) - 96))))); - _T.[1] <- x86_VPSRLV_4u64 _A11 - (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((5 * 32) - 96))))); - _T.[1] <- (_T.[1] `|` _T.[7]); - _A01 <- (_A01 `^` _D14); - _T.[5] <- x86_VPERMQ _A21 (W8.of_int 27); - _T.[6] <- x86_VPERMQ _A41 (W8.of_int 114); - _T.[8] <- x86_VPSLLV_4u64 _A01 - (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((1 * 32) - 96))))); - _T.[2] <- x86_VPSRLV_4u64 _A01 - (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((1 * 32) - 96))))); - _T.[2] <- (_T.[2] `|` _T.[8]); - _T.[7] <- x86_VPSRLDQ_256 _T.[1] (W8.of_int 8); - _T.[0] <- ((invw _T.[1]) `&` _T.[7]); - _A31 <- x86_VPBLENDD_256 _T.[2] _T.[6] - (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); - _T.[8] <- x86_VPBLENDD_256 _T.[4] _T.[2] - (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); - _A41 <- x86_VPBLENDD_256 _T.[3] _T.[4] - (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); - _T.[7] <- x86_VPBLENDD_256 _T.[2] _T.[3] - (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); - _A31 <- x86_VPBLENDD_256 _A31 _T.[4] - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); - _T.[8] <- x86_VPBLENDD_256 _T.[8] _T.[5] - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); - _A41 <- x86_VPBLENDD_256 _A41 _T.[2] - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); - _T.[7] <- x86_VPBLENDD_256 _T.[7] _T.[6] - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); - _A31 <- x86_VPBLENDD_256 _A31 _T.[5] - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); - _T.[8] <- x86_VPBLENDD_256 _T.[8] _T.[6] - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); - _A41 <- x86_VPBLENDD_256 _A41 _T.[6] - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); - _T.[7] <- x86_VPBLENDD_256 _T.[7] _T.[4] - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); - _A31 <- x86_VPANDN_256 _A31 _T.[8]; - _A41 <- x86_VPANDN_256 _A41 _T.[7]; - _A11 <- x86_VPBLENDD_256 _T.[5] _T.[2] - (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); - _T.[8] <- x86_VPBLENDD_256 _T.[3] _T.[5] - (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); - _A31 <- (_A31 `^` _T.[3]); - _A11 <- x86_VPBLENDD_256 _A11 _T.[3] - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); - _T.[8] <- x86_VPBLENDD_256 _T.[8] _T.[4] - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); - _A41 <- (_A41 `^` _T.[5]); - _A11 <- x86_VPBLENDD_256 _A11 _T.[4] - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); - _T.[8] <- x86_VPBLENDD_256 _T.[8] _T.[2] - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); - _A11 <- x86_VPANDN_256 _A11 _T.[8]; - _A11 <- (_A11 `^` _T.[6]); - _A21 <- x86_VPERMQ _T.[1] (W8.of_int 30); - _T.[8] <- x86_VPBLENDD_256 _A21 _A00 - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); - _A01 <- x86_VPERMQ _T.[1] (W8.of_int 57); - _A01 <- x86_VPBLENDD_256 _A01 _A00 - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); - _A01 <- x86_VPANDN_256 _A01 _T.[8]; - _A20 <- x86_VPBLENDD_256 _T.[4] _T.[5] - (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); - _T.[7] <- x86_VPBLENDD_256 _T.[6] _T.[4] - (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); - _A20 <- x86_VPBLENDD_256 _A20 _T.[6] - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); - _T.[7] <- x86_VPBLENDD_256 _T.[7] _T.[3] - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); - _A20 <- x86_VPBLENDD_256 _A20 _T.[3] - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); - _T.[7] <- x86_VPBLENDD_256 _T.[7] _T.[5] - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); - _A20 <- x86_VPANDN_256 _A20 _T.[7]; - _A20 <- (_A20 `^` _T.[2]); - _T.[0] <- x86_VPERMQ _T.[0] (W8.of_int 0); - _A31 <- x86_VPERMQ _A31 (W8.of_int 27); - _A41 <- x86_VPERMQ _A41 (W8.of_int 141); - _A11 <- x86_VPERMQ _A11 (W8.of_int 114); - _A21 <- x86_VPBLENDD_256 _T.[6] _T.[3] - (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); - _T.[7] <- x86_VPBLENDD_256 _T.[5] _T.[6] - (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); - _A21 <- x86_VPBLENDD_256 _A21 _T.[5] - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); - _T.[7] <- x86_VPBLENDD_256 _T.[7] _T.[2] - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); - _A21 <- x86_VPBLENDD_256 _A21 _T.[2] - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); - _T.[7] <- x86_VPBLENDD_256 _T.[7] _T.[3] - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); - _A21 <- x86_VPANDN_256 _A21 _T.[7]; - _A00 <- (_A00 `^` _T.[0]); - _A01 <- (_A01 `^` _T.[1]); - _A21 <- (_A21 `^` _T.[4]); - _A00 <- - (_A00 `^` (loadW256 Glob.mem (W64.to_uint (iotas + (W64.of_int 0))))); - iotas <- (iotas + (W64.of_int 32)); - ( _0, _1, _2, zf, i) <- x86_DEC_32 i; - while ((! zf)) { - _C00 <- x86_VPSHUFD_256 _A20 (W8.of_int 78); - _C14 <- (_A41 `^` _A31); - _T.[2] <- (_A21 `^` _A11); - _C14 <- (_C14 `^` _A01); - _C14 <- (_C14 `^` _T.[2]); - _T.[4] <- x86_VPERMQ _C14 (W8.of_int 147); - _C00 <- (_C00 `^` _A20); - _T.[0] <- x86_VPERMQ _C00 (W8.of_int 78); - _T.[1] <- (_C14 \vshr64u256 (W8.of_int 63)); - _T.[2] <- (_C14 \vadd64u256 _C14); - _T.[1] <- (_T.[1] `|` _T.[2]); - _D14 <- x86_VPERMQ _T.[1] (W8.of_int 57); - _D00 <- (_T.[1] `^` _T.[4]); - _D00 <- x86_VPERMQ _D00 (W8.of_int 0); - _C00 <- (_C00 `^` _A00); - _C00 <- (_C00 `^` _T.[0]); - _T.[0] <- (_C00 \vshr64u256 (W8.of_int 63)); - _T.[1] <- (_C00 \vadd64u256 _C00); - _T.[1] <- (_T.[1] `|` _T.[0]); - _A20 <- (_A20 `^` _D00); - _A00 <- (_A00 `^` _D00); - _D14 <- x86_VPBLENDD_256 _D14 _T.[1] - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); - _T.[4] <- x86_VPBLENDD_256 _T.[4] _C00 - (W8.of_int (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); - _D14 <- (_D14 `^` _T.[4]); - _T.[3] <- x86_VPSLLV_4u64 _A20 - (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((0 * 32) - 96))))); - _A20 <- x86_VPSRLV_4u64 _A20 - (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((0 * 32) - 96))))); - _A20 <- (_A20 `|` _T.[3]); - _A31 <- (_A31 `^` _D14); - _T.[4] <- x86_VPSLLV_4u64 _A31 - (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((2 * 32) - 96))))); - _A31 <- x86_VPSRLV_4u64 _A31 - (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((2 * 32) - 96))))); - _A31 <- (_A31 `|` _T.[4]); - _A21 <- (_A21 `^` _D14); - _T.[5] <- x86_VPSLLV_4u64 _A21 - (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((3 * 32) - 96))))); - _A21 <- x86_VPSRLV_4u64 _A21 - (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((3 * 32) - 96))))); - _A21 <- (_A21 `|` _T.[5]); - _A41 <- (_A41 `^` _D14); - _T.[6] <- x86_VPSLLV_4u64 _A41 - (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((4 * 32) - 96))))); - _A41 <- x86_VPSRLV_4u64 _A41 - (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((4 * 32) - 96))))); - _A41 <- (_A41 `|` _T.[6]); - _A11 <- (_A11 `^` _D14); - _T.[3] <- x86_VPERMQ _A20 (W8.of_int 141); - _T.[4] <- x86_VPERMQ _A31 (W8.of_int 141); - _T.[7] <- x86_VPSLLV_4u64 _A11 - (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((5 * 32) - 96))))); - _T.[1] <- x86_VPSRLV_4u64 _A11 - (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((5 * 32) - 96))))); - _T.[1] <- (_T.[1] `|` _T.[7]); - _A01 <- (_A01 `^` _D14); - _T.[5] <- x86_VPERMQ _A21 (W8.of_int 27); - _T.[6] <- x86_VPERMQ _A41 (W8.of_int 114); - _T.[8] <- x86_VPSLLV_4u64 _A01 - (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((1 * 32) - 96))))); - _T.[2] <- x86_VPSRLV_4u64 _A01 - (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((1 * 32) - 96))))); - _T.[2] <- (_T.[2] `|` _T.[8]); - _T.[7] <- x86_VPSRLDQ_256 _T.[1] (W8.of_int 8); - _T.[0] <- ((invw _T.[1]) `&` _T.[7]); - _A31 <- x86_VPBLENDD_256 _T.[2] _T.[6] - (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); - _T.[8] <- x86_VPBLENDD_256 _T.[4] _T.[2] - (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); - _A41 <- x86_VPBLENDD_256 _T.[3] _T.[4] - (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); - _T.[7] <- x86_VPBLENDD_256 _T.[2] _T.[3] - (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); - _A31 <- x86_VPBLENDD_256 _A31 _T.[4] - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); - _T.[8] <- x86_VPBLENDD_256 _T.[8] _T.[5] - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); - _A41 <- x86_VPBLENDD_256 _A41 _T.[2] - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); - _T.[7] <- x86_VPBLENDD_256 _T.[7] _T.[6] - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); - _A31 <- x86_VPBLENDD_256 _A31 _T.[5] - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); - _T.[8] <- x86_VPBLENDD_256 _T.[8] _T.[6] - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); - _A41 <- x86_VPBLENDD_256 _A41 _T.[6] - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); - _T.[7] <- x86_VPBLENDD_256 _T.[7] _T.[4] - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); - _A31 <- x86_VPANDN_256 _A31 _T.[8]; - _A41 <- x86_VPANDN_256 _A41 _T.[7]; - _A11 <- x86_VPBLENDD_256 _T.[5] _T.[2] - (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); - _T.[8] <- x86_VPBLENDD_256 _T.[3] _T.[5] - (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); - _A31 <- (_A31 `^` _T.[3]); - _A11 <- x86_VPBLENDD_256 _A11 _T.[3] - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); - _T.[8] <- x86_VPBLENDD_256 _T.[8] _T.[4] - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); - _A41 <- (_A41 `^` _T.[5]); - _A11 <- x86_VPBLENDD_256 _A11 _T.[4] - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); - _T.[8] <- x86_VPBLENDD_256 _T.[8] _T.[2] - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); - _A11 <- x86_VPANDN_256 _A11 _T.[8]; - _A11 <- (_A11 `^` _T.[6]); - _A21 <- x86_VPERMQ _T.[1] (W8.of_int 30); - _T.[8] <- x86_VPBLENDD_256 _A21 _A00 - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); - _A01 <- x86_VPERMQ _T.[1] (W8.of_int 57); - _A01 <- x86_VPBLENDD_256 _A01 _A00 - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); - _A01 <- x86_VPANDN_256 _A01 _T.[8]; - _A20 <- x86_VPBLENDD_256 _T.[4] _T.[5] - (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); - _T.[7] <- x86_VPBLENDD_256 _T.[6] _T.[4] - (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); - _A20 <- x86_VPBLENDD_256 _A20 _T.[6] - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); - _T.[7] <- x86_VPBLENDD_256 _T.[7] _T.[3] - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); - _A20 <- x86_VPBLENDD_256 _A20 _T.[3] - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); - _T.[7] <- x86_VPBLENDD_256 _T.[7] _T.[5] - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); - _A20 <- x86_VPANDN_256 _A20 _T.[7]; - _A20 <- (_A20 `^` _T.[2]); - _T.[0] <- x86_VPERMQ _T.[0] (W8.of_int 0); - _A31 <- x86_VPERMQ _A31 (W8.of_int 27); - _A41 <- x86_VPERMQ _A41 (W8.of_int 141); - _A11 <- x86_VPERMQ _A11 (W8.of_int 114); - _A21 <- x86_VPBLENDD_256 _T.[6] _T.[3] - (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); - _T.[7] <- x86_VPBLENDD_256 _T.[5] _T.[6] - (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); - _A21 <- x86_VPBLENDD_256 _A21 _T.[5] - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); - _T.[7] <- x86_VPBLENDD_256 _T.[7] _T.[2] - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); - _A21 <- x86_VPBLENDD_256 _A21 _T.[2] - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); - _T.[7] <- x86_VPBLENDD_256 _T.[7] _T.[3] - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3)))); - _A21 <- x86_VPANDN_256 _A21 _T.[7]; - _A00 <- (_A00 `^` _T.[0]); - _A01 <- (_A01 `^` _T.[1]); - _A21 <- (_A21 `^` _T.[4]); - _A00 <- - (_A00 `^` (loadW256 Glob.mem (W64.to_uint (iotas + (W64.of_int 0))))); - iotas <- (iotas + (W64.of_int 32)); - ( _0, _1, _2, zf, i) <- x86_DEC_32 i; - } - return (_A00, _A01, _A20, _A31, _A21, _A41, _A11); - } -}. - diff --git a/proof/impl/old_perm/keccak_f1600_avx2_prevec.ec b/proof/impl/old_perm/keccak_f1600_avx2_prevec.ec deleted file mode 100644 index e2d8605..0000000 --- a/proof/impl/old_perm/keccak_f1600_avx2_prevec.ec +++ /dev/null @@ -1,1522 +0,0 @@ -require import List Int IntExtra IntDiv CoreMap. -from Jasmin require import JModel. - -require import Array4 Array9 Array24 Array25 Array96. -require import WArray288. - -require import Keccak_f1600_ref_table. -require import Keccak_f1600_ref. -import Ops. - -op lift2array(x : W256.t) : W64.t Array4.t = - Array4.init (fun (n : int) => x \bits64 n). - -op good_rhotates_right : int Array24.t = ( - witness - .[4* 0+0 <- 64 - 3].[4* 0+1 <- 64 - 18].[4* 0+2 <- 64 - 36].[4* 0+3 <- 64 - 41] - .[4* 1+0 <- 64 - 1].[4* 1+1 <- 64 - 62].[4* 1+2 <- 64 - 28].[4* 1+3 <- 64 - 27] - .[4* 2+0 <- 64 - 45].[4* 2+1 <- 64 - 6].[4* 2+2 <- 64 - 56].[4* 2+3 <- 64 - 39] - .[4* 3+0 <- 64 - 10].[4* 3+1 <- 64 - 61].[4* 3+2 <- 64 - 55].[4* 3+3 <- 64 - 8] - .[4* 4+0 <- 64 - 2].[4* 4+1 <- 64 - 15].[4* 4+2 <- 64 - 25].[4* 4+3 <- 64 - 20] - .[4* 5+0 <- 64 - 44].[4* 5+1 <- 64 - 43].[4* 5+2 <- 64 - 21].[4* 5+3 <- 64 - 14])%Array24. - - -op good_rhotates_left : int Array24.t = ( - witness - .[4* 0+0 <- 3].[4* 0+1 <- 18].[4* 0+2 <- 36].[4* 0+3 <- 41] - .[4* 1+0 <- 1].[4* 1+1 <- 62].[4* 1+2 <- 28].[4* 1+3 <- 27] - .[4* 2+0 <- 45].[4* 2+1 <- 6].[4* 2+2 <- 56].[4* 2+3 <- 39] - .[4* 3+0 <- 10].[4* 3+1 <- 61].[4* 3+2 <- 55].[4* 3+3 <- 8] - .[4* 4+0 <- 2].[4* 4+1 <- 15].[4* 4+2 <- 25].[4* 4+3 <- 20] - .[4* 5+0 <- 44].[4* 5+1 <- 43].[4* 5+2 <- 21].[4* 5+3 <- 14])%Array24. - - -op good_iotas4x : W64.t Array96.t = ( - witness - .[4* 0+0 <- W64.one ].[4* 0+1 <- W64.one ].[4* 0+2 <- W64.one ].[4* 0+3 <- W64.one ] - .[4* 1+0 <- W64.of_int 32898 ].[4* 1+1 <- W64.of_int 32898 ].[4* 1+2 <- W64.of_int 32898 ].[4* 1+3 <- W64.of_int 32898 ] - .[4* 2+0 <- W64.of_int 9223372036854808714].[4* 2+1 <- W64.of_int 9223372036854808714].[4* 2+2 <- W64.of_int 9223372036854808714].[4* 2+3 <- W64.of_int 9223372036854808714] - .[4* 3+0 <- W64.of_int 9223372039002292224].[4* 3+1 <- W64.of_int 9223372039002292224].[4* 3+2 <- W64.of_int 9223372039002292224].[4* 3+3 <- W64.of_int 9223372039002292224] - .[4* 4+0 <- W64.of_int 32907 ].[4* 4+1 <- W64.of_int 32907 ].[4* 4+2 <- W64.of_int 32907 ].[4* 4+3 <- W64.of_int 32907 ] - .[4* 5+0 <- W64.of_int 2147483649 ].[4* 5+1 <- W64.of_int 2147483649 ].[4* 5+2 <- W64.of_int 2147483649 ].[4* 5+3 <- W64.of_int 2147483649 ] - .[4* 6+0 <- W64.of_int 9223372039002292353].[4* 6+1 <- W64.of_int 9223372039002292353].[4* 6+2 <- W64.of_int 9223372039002292353].[4* 6+3 <- W64.of_int 9223372039002292353] - .[4* 7+0 <- W64.of_int 9223372036854808585].[4* 7+1 <- W64.of_int 9223372036854808585].[4* 7+2 <- W64.of_int 9223372036854808585].[4* 7+3 <- W64.of_int 9223372036854808585] - .[4* 8+0 <- W64.of_int 138 ].[4* 8+1 <- W64.of_int 138 ].[4* 8+2 <- W64.of_int 138 ].[4* 8+3 <- W64.of_int 138 ] - .[4* 9+0 <- W64.of_int 136 ].[4* 9+1 <- W64.of_int 136 ].[4* 9+2 <- W64.of_int 136 ].[4* 9+3 <- W64.of_int 136 ] - .[4*10+0 <- W64.of_int 2147516425 ].[4*10+1 <- W64.of_int 2147516425 ].[4*10+2 <- W64.of_int 2147516425 ].[4*10+3 <- W64.of_int 2147516425 ] - .[4*11+0 <- W64.of_int 2147483658 ].[4*11+1 <- W64.of_int 2147483658 ].[4*11+2 <- W64.of_int 2147483658 ].[4*11+3 <- W64.of_int 2147483658 ] - .[4*12+0 <- W64.of_int 2147516555 ].[4*12+1 <- W64.of_int 2147516555 ].[4*12+2 <- W64.of_int 2147516555 ].[4*12+3 <- W64.of_int 2147516555 ] - .[4*13+0 <- W64.of_int 9223372036854775947].[4*13+1 <- W64.of_int 9223372036854775947].[4*13+2 <- W64.of_int 9223372036854775947].[4*13+3 <- W64.of_int 9223372036854775947] - .[4*14+0 <- W64.of_int 9223372036854808713].[4*14+1 <- W64.of_int 9223372036854808713].[4*14+2 <- W64.of_int 9223372036854808713].[4*14+3 <- W64.of_int 9223372036854808713] - .[4*15+0 <- W64.of_int 9223372036854808579].[4*15+1 <- W64.of_int 9223372036854808579].[4*15+2 <- W64.of_int 9223372036854808579].[4*15+3 <- W64.of_int 9223372036854808579] - .[4*16+0 <- W64.of_int 9223372036854808578].[4*16+1 <- W64.of_int 9223372036854808578].[4*16+2 <- W64.of_int 9223372036854808578].[4*16+3 <- W64.of_int 9223372036854808578] - .[4*17+0 <- W64.of_int 9223372036854775936].[4*17+1 <- W64.of_int 9223372036854775936].[4*17+2 <- W64.of_int 9223372036854775936].[4*17+3 <- W64.of_int 9223372036854775936] - .[4*18+0 <- W64.of_int 32778 ].[4*18+1 <- W64.of_int 32778 ].[4*18+2 <- W64.of_int 32778 ].[4*18+3 <- W64.of_int 32778 ] - .[4*19+0 <- W64.of_int 9223372039002259466].[4*19+1 <- W64.of_int 9223372039002259466].[4*19+2 <- W64.of_int 9223372039002259466].[4*19+3 <- W64.of_int 9223372039002259466] - .[4*20+0 <- W64.of_int 9223372039002292353].[4*20+1 <- W64.of_int 9223372039002292353].[4*20+2 <- W64.of_int 9223372039002292353].[4*20+3 <- W64.of_int 9223372039002292353] - .[4*21+0 <- W64.of_int 9223372036854808704].[4*21+1 <- W64.of_int 9223372036854808704].[4*21+2 <- W64.of_int 9223372036854808704].[4*21+3 <- W64.of_int 9223372036854808704] - .[4*22+0 <- W64.of_int 2147483649 ].[4*22+1 <- W64.of_int 2147483649 ].[4*22+2 <- W64.of_int 2147483649 ].[4*22+3 <- W64.of_int 2147483649 ] - .[4*23+0 <- W64.of_int 9223372039002292232].[4*23+1 <- W64.of_int 9223372039002292232].[4*23+2 <- W64.of_int 9223372039002292232].[4*23+3 <- W64.of_int 9223372039002292232])%Array96. - -module Mavx2_prevec = { - - proc __KeccakF1600 (_A00:W64.t Array4.t, _A01:W64.t Array4.t, _A20:W64.t Array4.t, _A31:W64.t Array4.t, - _A21:W64.t Array4.t, _A41:W64.t Array4.t, _A11:W64.t Array4.t, - _rhotates_left:W64.t, _rhotates_right:W64.t, - _iotas:W64.t) : W64.t Array4.t * W64.t Array4.t * W64.t Array4.t * W64.t Array4.t * - W64.t Array4.t * W64.t Array4.t * W64.t Array4.t = { - - var rhotates_left:W64.t; - var rhotates_right:W64.t; - var iotas:W64.t; - var i:W32.t; - var zf:bool; - var _C00:W64.t Array4.t; - var _C14:W64.t Array4.t; - var _T:W64.t Array4.t Array9.t; - var _D14:W64.t Array4.t; - var _D00:W64.t Array4.t; - var _0:bool; - var _1:bool; - var _2:bool; - _T <- witness; - rhotates_left <- (_rhotates_left + (W64.of_int 96)); - rhotates_right <- (_rhotates_right + (W64.of_int 96)); - iotas <- _iotas; - i <- (W32.of_int 24); - _C00 <@ Ops.iVPSHUFD_256(_A20,(W8.of_int 78)); - _C14 <@ Ops.ilxor4u64(_A41,_A31); - _T.[2] <@ Ops.ilxor4u64(_A21,_A11); - _C14 <@ Ops.ilxor4u64(_C14,_A01); - _C14 <@ Ops.ilxor4u64(_C14,_T.[2]); - _T.[4] <- Ops.iVPERMQ(_C14,(W8.of_int 147)); - _C00 <@ Ops.ilxor4u64(_C00,_A20); - _T.[0] <- Ops.iVPERMQ(_C00,(W8.of_int 78)); - _T.[1] <- Ops.ivshr64u256(_C14, (W8.of_int 63)); - _T.[2] <- Ops.ivadd64u256(_C14, _C14); - _T.[1] <@ Ops.ilor4u64(_T.[1],_T.[2]); - _D14 <- Ops.iVPERMQ(_T.[1],(W8.of_int 57)); - _D00 <@ Ops.ilxor4u64(_T.[1],_T.[4]); - _D00 <- Ops.iVPERMQ(_D00,(W8.of_int 0)); - _C00 <@ Ops.ilxor4u64(_C00,_A00); - _C00 <@ Ops.ilxor4u64(_C00,_T.[0]); - _T.[0] <- Ops.ivshr64u256(_C00, (W8.of_int 63)); - _T.[1] <- Ops.ivadd64u256(_C00, _C00); - _T.[1] <@ Ops.ilor4u64(_T.[1],_T.[0]); - _A20 <@ Ops.ilxor4u64(_A20,_D00); - _A00 <@ Ops.ilxor4u64(_A00,_D00); - _D14 <- Ops.iVPBLENDD_256(_D14,_T.[1], - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); - _T.[4] <- Ops.iVPBLENDD_256(_T.[4],_C00, - (W8.of_int (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); - _D14 <@ Ops.ilxor4u64(_D14,_T.[4]); - _T.[3] <@ Ops.iVPSLLV_4u64(_A20, lift2array - (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((0 * 32) - 96)))))); - _A20 <@ Ops.iVPSRLV_4u64(_A20, lift2array - (loadW256 Glob.mem (W64.to_uint (rhotates_right+ (W64.of_int ((0 * 32) - 96)))))); - _A20 <@ Ops.ilor4u64(_A20,_T.[3]); - _A31 <@ Ops.ilxor4u64(_A31,_D14); - _T.[4] <@ Ops.iVPSLLV_4u64(_A31, lift2array - (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((2 * 32) - 96)))))); - _A31 <@ Ops.iVPSRLV_4u64(_A31, lift2array - (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((2 * 32) - 96)))))); - _A31 <@ Ops.ilor4u64(_A31,_T.[4]); - _A21 <@ Ops.ilxor4u64(_A21,_D14); - _T.[5] <@ Ops.iVPSLLV_4u64(_A21, lift2array - (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((3 * 32) - 96)))))); - _A21 <@ Ops.iVPSRLV_4u64(_A21, lift2array - (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((3 * 32) - 96)))))); - _A21 <@ Ops.ilor4u64(_A21,_T.[5]); - _A41 <@ Ops.ilxor4u64(_A41,_D14); - _T.[6] <@ Ops.iVPSLLV_4u64(_A41, lift2array - (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((4 * 32) - 96)))))); - _A41 <@ Ops.iVPSRLV_4u64(_A41, lift2array - (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((4 * 32) - 96)))))); - _A41 <@ Ops.ilor4u64(_A41,_T.[6]); - _A11 <@ Ops.ilxor4u64(_A11,_D14); - _T.[3] <- Ops.iVPERMQ(_A20,(W8.of_int 141)); - _T.[4] <- Ops.iVPERMQ(_A31,(W8.of_int 141)); - _T.[7] <@ Ops.iVPSLLV_4u64(_A11, lift2array - (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((5 * 32) - 96)))))); - _T.[1] <@ Ops.iVPSRLV_4u64(_A11, lift2array - (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((5 * 32) - 96)))))); - _T.[1] <@ Ops.ilor4u64(_T.[1],_T.[7]); - _A01 <@ Ops.ilxor4u64(_A01,_D14); - _T.[5] <- Ops.iVPERMQ(_A21,(W8.of_int 27)); - _T.[6] <- Ops.iVPERMQ(_A41,(W8.of_int 114)); - _T.[8] <@ Ops.iVPSLLV_4u64(_A01, lift2array - (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((1 * 32) - 96)))))); - _T.[2] <@ Ops.iVPSRLV_4u64(_A01, lift2array - (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((1 * 32) - 96)))))); - _T.[2] <@ Ops.ilor4u64(_T.[2],_T.[8]); - _T.[7] <@ Ops.iVPSRLDQ_256(_T.[1],(W8.of_int 8)); - _T.[0] <@ Ops.ilandn4u64(_T.[1],_T.[7]); - _A31 <@ Ops.iVPBLENDD_256(_T.[2],_T.[6], - (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); - _T.[8] <@ Ops.iVPBLENDD_256(_T.[4],_T.[2], - (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); - _A41 <@ Ops.iVPBLENDD_256(_T.[3], _T.[4], - (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); - _T.[7] <@ Ops.iVPBLENDD_256(_T.[2], _T.[3], - (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); - _A31 <@ Ops.iVPBLENDD_256(_A31 ,_T.[4], - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); - _T.[8] <@ Ops.iVPBLENDD_256(_T.[8], _T.[5], - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); - _A41 <@ Ops.iVPBLENDD_256(_A41, _T.[2], - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); - _T.[7] <@ Ops.iVPBLENDD_256(_T.[7], _T.[6], - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); - _A31 <@ Ops.iVPBLENDD_256(_A31, _T.[5], - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); - _T.[8] <@ Ops.iVPBLENDD_256(_T.[8], _T.[6], - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); - _A41 <@ Ops.iVPBLENDD_256(_A41, _T.[6], - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); - _T.[7] <@ Ops.iVPBLENDD_256(_T.[7], _T.[4], - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); - _A31 <@ Ops.ilandn4u64(_A31,_T.[8]); - _A41 <@ Ops.ilandn4u64(_A41,_T.[7]); - _A11 <@ Ops.iVPBLENDD_256(_T.[5],_T.[2], - (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); - _T.[8] <@ Ops.iVPBLENDD_256(_T.[3], _T.[5], - (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); - _A31 <@ Ops.ilxor4u64(_A31,_T.[3]); - _A11 <@ Ops.iVPBLENDD_256(_A11,_T.[3], - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); - _T.[8] <@ Ops.iVPBLENDD_256(_T.[8],_T.[4], - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); - _A41 <@ Ops.ilxor4u64(_A41,_T.[5]); - _A11 <@ Ops.iVPBLENDD_256(_A11, _T.[4], - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); - _T.[8] <@ Ops.iVPBLENDD_256(_T.[8], _T.[2], - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); - _A11 <@ Ops.ilandn4u64(_A11,_T.[8]); - _A11 <@ Ops.ilxor4u64(_A11,_T.[6]); - _A21 <@ Ops.iVPERMQ(_T.[1],(W8.of_int 30)); - _T.[8] <@ Ops.iVPBLENDD_256(_A21, _A00, - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); - _A01 <@ Ops.iVPERMQ(_T.[1],(W8.of_int 57)); - _A01 <@ Ops.iVPBLENDD_256(_A01, _A00, - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); - _A01 <@ Ops.ilandn4u64(_A01,_T.[8]); - _A20 <@ Ops.iVPBLENDD_256(_T.[4], _T.[5], - (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); - _T.[7] <@ Ops.iVPBLENDD_256(_T.[6], _T.[4], - (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); - _A20 <@ Ops.iVPBLENDD_256(_A20, _T.[6], - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); - _T.[7] <@ Ops.iVPBLENDD_256(_T.[7], _T.[3], - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); - _A20 <@ Ops.iVPBLENDD_256(_A20, _T.[3], - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); - _T.[7] <@ Ops.iVPBLENDD_256(_T.[7], _T.[5], - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); - _A20 <@ Ops.ilandn4u64(_A20,_T.[7]); - _A20 <@ Ops.ilxor4u64(_A20,_T.[2]); - _T.[0] <@ Ops.iVPERMQ(_T.[0],(W8.of_int 0)); - _A31 <@ Ops.iVPERMQ(_A31,(W8.of_int 27)); - _A41 <@ Ops.iVPERMQ(_A41,(W8.of_int 141)); - _A11 <@ Ops.iVPERMQ(_A11,(W8.of_int 114)); - _A21 <@ Ops.iVPBLENDD_256(_T.[6], _T.[3], - (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); - _T.[7] <@ Ops.iVPBLENDD_256(_T.[5], _T.[6], - (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); - _A21 <@ Ops.iVPBLENDD_256(_A21, _T.[5], - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); - _T.[7] <@ Ops.iVPBLENDD_256(_T.[7], _T.[2], - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); - _A21 <@ Ops.iVPBLENDD_256(_A21, _T.[2], - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); - _T.[7] <@ Ops.iVPBLENDD_256(_T.[7], _T.[3], - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); - _A21 <@ Ops.ilandn4u64(_A21,_T.[7]); - _A00 <@ Ops.ilxor4u64(_A00,_T.[0]); - _A01 <@ Ops.ilxor4u64(_A01,_T.[1]); - _A21 <@ Ops.ilxor4u64(_A21,_T.[4]); - _A00 <@ Ops.ilxor4u64(_A00, lift2array - (loadW256 Glob.mem (W64.to_uint (iotas + (W64.of_int 0))))); - iotas <- (iotas + (W64.of_int 32)); - ( _0, _1, _2, zf, i) <- x86_DEC_32 i; - while ((! zf)) { - _C00 <@ Ops.iVPSHUFD_256(_A20,(W8.of_int 78)); - _C14 <@ Ops.ilxor4u64(_A41,_A31); - _T.[2] <@ Ops.ilxor4u64(_A21,_A11); - _C14 <@ Ops.ilxor4u64(_C14,_A01); - _C14 <@ Ops.ilxor4u64(_C14,_T.[2]); - _T.[4] <@ Ops.iVPERMQ(_C14,(W8.of_int 147)); - _C00 <@ Ops.ilxor4u64(_C00,_A20); - _T.[0] <@ Ops.iVPERMQ(_C00,(W8.of_int 78)); - _T.[1] <@ Ops.ivshr64u256(_C14, (W8.of_int 63)); - _T.[2] <@ Ops.ivadd64u256(_C14, _C14); - _T.[1] <@ Ops.ilor4u64(_T.[1],_T.[2]); - _D14 <@ Ops.iVPERMQ(_T.[1],(W8.of_int 57)); - _D00 <@ Ops.ilxor4u64(_T.[1],_T.[4]); - _D00 <@ Ops.iVPERMQ(_D00,(W8.of_int 0)); - _C00 <@ Ops.ilxor4u64(_C00,_A00); - _C00 <@ Ops.ilxor4u64(_C00,_T.[0]); - _T.[0] <@ Ops.ivshr64u256(_C00, (W8.of_int 63)); - _T.[1] <@ Ops.ivadd64u256(_C00, _C00); - _T.[1] <@ Ops.ilor4u64(_T.[1],_T.[0]); - _A20 <@ Ops.ilxor4u64(_A20,_D00); - _A00 <@ Ops.ilxor4u64(_A00,_D00); - _D14 <@ Ops.iVPBLENDD_256(_D14,_T.[1], - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); - _T.[4] <@ Ops.iVPBLENDD_256(_T.[4],_C00, - (W8.of_int (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); - _D14 <@ Ops.ilxor4u64(_D14,_T.[4]); - _T.[3] <@ Ops.iVPSLLV_4u64(_A20, lift2array - (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((0 * 32) - 96)))))); - _A20 <@ Ops.iVPSRLV_4u64(_A20, lift2array - (loadW256 Glob.mem (W64.to_uint (rhotates_right+ (W64.of_int ((0 * 32) - 96)))))); - _A20 <@ Ops.ilor4u64(_A20,_T.[3]); - _A31 <@ Ops.ilxor4u64(_A31,_D14); - _T.[4] <@ Ops.iVPSLLV_4u64(_A31, lift2array - (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((2 * 32) - 96)))))); - _A31 <@ Ops.iVPSRLV_4u64(_A31, lift2array - (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((2 * 32) - 96)))))); - _A31 <@ Ops.ilor4u64(_A31,_T.[4]); - _A21 <@ Ops.ilxor4u64(_A21,_D14); - _T.[5] <@ Ops.iVPSLLV_4u64(_A21, lift2array - (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((3 * 32) - 96)))))); - _A21 <@ Ops.iVPSRLV_4u64(_A21, lift2array - (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((3 * 32) - 96)))))); - _A21 <@ Ops.ilor4u64(_A21,_T.[5]); - _A41 <@ Ops.ilxor4u64(_A41,_D14); - _T.[6] <@ Ops.iVPSLLV_4u64(_A41, lift2array - (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((4 * 32) - 96)))))); - _A41 <@ Ops.iVPSRLV_4u64(_A41, lift2array - (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((4 * 32) - 96)))))); - _A41 <@ Ops.ilor4u64(_A41,_T.[6]); - _A11 <@ Ops.ilxor4u64(_A11,_D14); - _T.[3] <- Ops.iVPERMQ(_A20,(W8.of_int 141)); - _T.[4] <- Ops.iVPERMQ(_A31,(W8.of_int 141)); - _T.[7] <@ Ops.iVPSLLV_4u64(_A11, lift2array - (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((5 * 32) - 96)))))); - _T.[1] <@ Ops.iVPSRLV_4u64(_A11, lift2array - (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((5 * 32) - 96)))))); - _T.[1] <@ Ops.ilor4u64(_T.[1],_T.[7]); - _A01 <@ Ops.ilxor4u64(_A01,_D14); - _T.[5] <- Ops.iVPERMQ(_A21,(W8.of_int 27)); - _T.[6] <- Ops.iVPERMQ(_A41,(W8.of_int 114)); - _T.[8] <@ Ops.iVPSLLV_4u64(_A01, lift2array - (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((1 * 32) - 96)))))); - _T.[2] <@ Ops.iVPSRLV_4u64(_A01, lift2array - (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((1 * 32) - 96)))))); - _T.[2] <@ Ops.ilor4u64(_T.[2],_T.[8]); - _T.[7] <@ Ops.iVPSRLDQ_256(_T.[1],(W8.of_int 8)); - _T.[0] <@ Ops.ilandn4u64(_T.[1],_T.[7]); - _A31 <@ Ops.iVPBLENDD_256(_T.[2], _T.[6], - (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); - _T.[8] <@ Ops.iVPBLENDD_256(_T.[4], _T.[2], - (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); - _A41 <@ Ops.iVPBLENDD_256(_T.[3], _T.[4], - (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); - _T.[7] <@ Ops.iVPBLENDD_256(_T.[2], _T.[3], - (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); - _A31 <@ Ops.iVPBLENDD_256(_A31, _T.[4], - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); - _T.[8] <@ Ops.iVPBLENDD_256(_T.[8], _T.[5], - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); - _A41 <@ Ops.iVPBLENDD_256(_A41, _T.[2], - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); - _T.[7] <@ Ops.iVPBLENDD_256(_T.[7], _T.[6], - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); - _A31 <@ Ops.iVPBLENDD_256(_A31, _T.[5], - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); - _T.[8] <@ Ops.iVPBLENDD_256(_T.[8], _T.[6], - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); - _A41 <@ Ops.iVPBLENDD_256(_A41, _T.[6], - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); - _T.[7] <@ Ops.iVPBLENDD_256(_T.[7], _T.[4], - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); - _A31 <@ Ops.ilandn4u64(_A31,_T.[8]); - _A41 <@ Ops.ilandn4u64(_A41,_T.[7]); - _A11 <@ Ops.iVPBLENDD_256(_T.[5], _T.[2], - (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); - _T.[8] <@ Ops.iVPBLENDD_256(_T.[3], _T.[5], - (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); - _A31 <@ Ops.ilxor4u64(_A31,_T.[3]); - _A11 <@ Ops.iVPBLENDD_256(_A11, _T.[3], - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); - _T.[8] <@ Ops.iVPBLENDD_256(_T.[8], _T.[4], - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); - _A41 <@ Ops.ilxor4u64(_A41,_T.[5]); - _A11 <@ Ops.iVPBLENDD_256(_A11, _T.[4], - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); - _T.[8] <@ Ops.iVPBLENDD_256(_T.[8], _T.[2], - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); - _A11 <@ Ops.ilandn4u64(_A11,_T.[8]); - _A11 <@ Ops.ilxor4u64(_A11,_T.[6]); - _A21 <@ Ops.iVPERMQ(_T.[1],(W8.of_int 30)); - _T.[8] <@ Ops.iVPBLENDD_256(_A21, _A00, - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); - _A01 <@ Ops.iVPERMQ(_T.[1],(W8.of_int 57)); - _A01 <@ Ops.iVPBLENDD_256(_A01 ,_A00, - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); - _A01 <@ Ops.ilandn4u64(_A01,_T.[8]); - _A20 <@ Ops.iVPBLENDD_256(_T.[4], _T.[5], - (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); - _T.[7] <@ Ops.iVPBLENDD_256(_T.[6], _T.[4], - (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); - _A20 <@ Ops.iVPBLENDD_256(_A20, _T.[6], - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); - _T.[7] <@ Ops.iVPBLENDD_256(_T.[7], _T.[3], - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); - _A20 <@ Ops.iVPBLENDD_256(_A20, _T.[3], - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); - _T.[7] <@ Ops.iVPBLENDD_256(_T.[7], _T.[5], - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); - _A20 <@ Ops.ilandn4u64(_A20,_T.[7]); - _A20 <@ Ops.ilxor4u64(_A20,_T.[2]); - _T.[0] <@ Ops.iVPERMQ(_T.[0],(W8.of_int 0)); - _A31 <@ Ops.iVPERMQ(_A31,(W8.of_int 27)); - _A41 <@ Ops.iVPERMQ(_A41,(W8.of_int 141)); - _A11 <@ Ops.iVPERMQ(_A11,(W8.of_int 114)); - _A21 <@ Ops.iVPBLENDD_256(_T.[6], _T.[3], - (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); - _T.[7] <@ Ops.iVPBLENDD_256(_T.[5], _T.[6], - (W8.of_int (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0))))); - _A21 <@ Ops.iVPBLENDD_256(_A21, _T.[5], - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); - _T.[7] <@ Ops.iVPBLENDD_256(_T.[7] ,_T.[2], - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0))))); - _A21 <@ Ops.iVPBLENDD_256(_A21, _T.[2], - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); - _T.[7] <@ Ops.iVPBLENDD_256(_T.[7], _T.[3], - (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 3))))); - _A21 <@ Ops.ilandn4u64(_A21,_T.[7]); - _A00 <@ Ops.ilxor4u64(_A00,_T.[0]); - _A01 <@ Ops.ilxor4u64(_A01,_T.[1]); - _A21 <@ Ops.ilxor4u64(_A21,_T.[4]); - _A00 <@ Ops.ilxor4u64(_A00, lift2array - (loadW256 Glob.mem (W64.to_uint (iotas + (W64.of_int 0))))); - iotas <- (iotas + (W64.of_int 32)); - ( _0, _1, _2, zf, i) <- x86_DEC_32 i; - } - return (_A00, _A01, _A20, _A31, _A21, _A41, _A11); - } -}. - -(* - ($A00, # [0][0] [0][0] [0][0] [0][0] - $A01, # [0][4] [0][3] [0][2] [0][1] - $A20, # [3][0] [1][0] [4][0] [2][0] - $A31, # [2][4] [4][3] [1][2] [3][1] - $A21, # [3][4] [1][3] [4][2] [2][1] - $A41, # [1][4] [2][3] [3][2] [4][1] - $A11) = # [4][4] [3][3] [2][2] [1][1] -*) - -op index x y = 5*x+y. - -op equiv_states (A00 A01 A20 A31 A21 A41 A11 : W64.t Array4.t, st : W64.t Array25.t) : bool = - A00.[3] = st.[index 0 0] /\ A00.[2] = st.[index 0 0] /\ A00.[1] = st.[index 0 0] /\ A00.[0] = st.[index 0 0] /\ - A01.[3] = st.[index 0 4] /\ A01.[2] = st.[index 0 3] /\ A01.[1] = st.[index 0 2] /\ A01.[0] = st.[index 0 1] /\ - A20.[3] = st.[index 3 0] /\ A20.[2] = st.[index 1 0] /\ A20.[1] = st.[index 4 0] /\ A20.[0] = st.[index 2 0] /\ - A31.[3] = st.[index 2 4] /\ A31.[2] = st.[index 4 3] /\ A31.[1] = st.[index 1 2] /\ A31.[0] = st.[index 3 1] /\ - A21.[3] = st.[index 3 4] /\ A21.[2] = st.[index 1 3] /\ A21.[1] = st.[index 4 2] /\ A21.[0] = st.[index 2 1] /\ - A41.[3] = st.[index 1 4] /\ A41.[2] = st.[index 2 3] /\ A41.[1] = st.[index 3 2] /\ A41.[0] = st.[index 4 1] /\ - A11.[3] = st.[index 4 4] /\ A11.[2] = st.[index 3 3] /\ A11.[1] = st.[index 2 2] /\ A11.[0] = st.[index 1 1]. - -op equiv_states_chi (A00 A01 A20 A31 A21 A41 A11 : W64.t Array4.t, st : W64.t Array25.t) : bool = - A00.[3] = st.[index 0 0] /\ A00.[2] = st.[index 0 0] /\ A00.[1] = st.[index 0 0] /\ A00.[0] = st.[index 0 0] /\ - A01.[3] = st.[index 0 4] /\ A01.[2] = st.[index 0 3] /\ A01.[1] = st.[index 0 2] /\ A01.[0] = st.[index 0 1] /\ - A20.[3] = st.[index 3 0] /\ A20.[2] = st.[index 1 0] /\ A20.[1] = st.[index 4 0] /\ A20.[0] = st.[index 2 0] /\ - A31.[3] = st.[index 3 1] /\ A31.[2] = st.[index 1 2] /\ A31.[1] = st.[index 4 3] /\ A31.[0] = st.[index 2 4] /\ - A21.[3] = st.[index 3 4] /\ A21.[2] = st.[index 1 3] /\ A21.[1] = st.[index 4 2] /\ A21.[0] = st.[index 2 1] /\ - A41.[3] = st.[index 3 2] /\ A41.[2] = st.[index 1 4] /\ A41.[1] = st.[index 4 1] /\ A41.[0] = st.[index 2 3] /\ - A11.[3] = st.[index 3 3] /\ A11.[2] = st.[index 1 1] /\ A11.[1] = st.[index 4 4] /\ A11.[0] = st.[index 2 2]. - -lemma dec : forall (x : W32.t), - 0 < to_uint x <= 24 => - to_uint (x86_DEC_32 x).`5 = to_uint x - 1 by smt(@W32). - -lemma decK : forall (x : W32.t), - (x86_DEC_32 x).`5 + W32.one = x by smt(@W32). - -lemma dec0 : forall (x : W32.t), - 0 < to_uint x <= 24 => - (x86_DEC_32 x).`4 <=> to_uint (x86_DEC_32 x).`5 = 0 by smt(@W32). - -lemma rolcomp : (forall (x : W64.t), - (x86_ROL_64 x W8.one).`3 = - (x `>>` W8.of_int 63) `|` (x + x)). -move => x. -rewrite x86_ROL_64_E => />. -rewrite rol_xor_shft => />. -rewrite (_: x + x = x `<<` W8.one). rewrite /(`<<`) => />. - have HH : ( to_uint (x+x) = to_uint (x `<<<` 1)); first by rewrite to_uint_shl => />; rewrite to_uintD => />; smt(@W64). - by smt(@W64). -rewrite /(`<<`) /(`>>`) => />. -rewrite xorE orE !map2E => />. -apply W64.init_ext. -progress. smt. -qed. - -lemma commor : forall (x y : W64.t), x `|` y = y `|` x. -move => *. - rewrite orE !map2E. -apply W64.init_ext. -by smt(). -qed. - -lemma rol0 : forall x, (x86_ROL_64 x W8.zero).`3 = x. -move => *. -rewrite x86_ROL_64_E rol_xor =>/>. -smt. -qed. - -lemma roln : forall x n, 0 <= n < 64 => - (x86_ROL_64 x (W8.of_int n)).`3 = - (x `>>>` (64 - n)) `|` (x `<<<` n). -move => x n H. -case (n = 0). -move => HH. rewrite HH rol0 => />. by smt(lsr_0). -move => HH. -rewrite x86_ROL_64_E => />. -rewrite rol_xor_shft => />. -split; first 2 by smt(). -rewrite /(`<<`) /(`>>`) => />. -rewrite (_: n %% 256 = n); first by smt(). -rewrite (_: n %% 256 = n); first by smt(). -rewrite (_: (64 - n) %% 256 = 64 - n); first by smt(). -rewrite (_: n %% 64 = n); first by smt(). -rewrite (_: (64 - n) %% 64 = 64 - n); first by smt(). -rewrite xorE orE !map2E => />. -apply W64.init_ext. -progress. smt. -qed. - -op good_iotas (mem : global_mem_t, _iotas : int) = - forall off, 0 <= off < 24 => - loadW64 mem (_iotas + (off * 8)) = iotas.[off]. - -op good_rhol (mem : global_mem_t, _rhotates_left : int) = - forall off, 0 <= off < 24 => - loadW64 mem (_rhotates_left + (off * 8)) = W64.of_int good_rhotates_left.[off]. - -op good_rhor (mem : global_mem_t, _rhotates_right : int) = - forall off, 0 <= off < 24 => - loadW64 mem ( _rhotates_right + (off * 8)) = W64.of_int good_rhotates_right.[off]. - -lemma loadlift_rhor : forall (mem : global_mem_t) (x : W64.t) (off : int), - good_rhor mem (to_uint x) => 0 <= off < 6 => - lift2array - (loadW256 mem (to_uint (x + W64.of_int (8 * 4 * off)))) = - (witness - .[0 <- W64.of_int good_rhotates_right.[4*off + 0]] - .[1 <- W64.of_int good_rhotates_right.[4*off + 1]] - .[2 <- W64.of_int good_rhotates_right.[4*off + 2]] - .[3 <- W64.of_int good_rhotates_right.[4*off + 3]])%Array4. - -move => mem x off. -rewrite /good_rhor /loadW256 /lift2array /good_rhotates_right => />. -move => *. -apply Array4.ext_eq. -move => *. - -case (off = 0). -auto => />. -case (x0 = 0). -move => x00. -rewrite x00 => />. -move : (H 0); rewrite /loadW64 => /> *. -rewrite -H3. -rewrite !pack8E W8u8.Pack.of_listE. -apply W64.init_ext. -move => *. -beta. -apply W8.wordP. -apply W8u8.Pack.packP. -apply W8u8.Pack.init_ext. -move => />. -smt(). smt(). smt(). -move => *. -case (x0 = 1). -move => x00. -rewrite x00 => />. -move : (H 1); rewrite /loadW64 => /> *. -rewrite -H4. -rewrite !pack8E W8u8.Pack.of_listE. -apply W64.init_ext. -move => *. -beta. -apply W8.wordP. -apply W8u8.Pack.packP. -apply W8u8.Pack.init_ext. -move => />. -smt(). smt(). smt(). -move => *. -case (x0 = 2). -move => x00. -rewrite x00 => />. -move : (H 2); rewrite /loadW64 => /> *. -rewrite -H5. -rewrite !pack8E W8u8.Pack.of_listE. -apply W64.init_ext. -move => *. -beta. -apply W8.wordP. -apply W8u8.Pack.packP. -apply W8u8.Pack.init_ext. -move => />. -smt(). smt(). smt(). -move => *. -case (x0 = 3). -move => x00. -rewrite x00 => />. -move : (H 3); rewrite /loadW64 => /> *. -rewrite -H6. -rewrite !pack8E W8u8.Pack.of_listE. -apply W64.init_ext. -move => *. -beta. -apply W8.wordP. -apply W8u8.Pack.packP. -apply W8u8.Pack.init_ext. -move => />. -smt(). smt(). smt(). -smt(). - -move => *. - -case (off = 1). -auto => />. -case (x0 = 0). -move => x00. -rewrite x00. -auto => /> //=. -move : (H 4); rewrite /loadW64 => /> *. -rewrite -H4. -rewrite !pack8E W8u8.Pack.of_listE. -apply W64.init_ext. -move => *. -beta. -apply W8.wordP. -apply W8u8.Pack.packP. -apply W8u8.Pack.init_ext. -move => />. -move => *. -have HHH : (to_uint x + 32 < W64.modulus). admit. (* safety *) -smt(@W64). smt(). smt(). -move => *. -case (x0 = 1). -move => x00. -rewrite x00 => />. -move : (H 5); rewrite /loadW64 => /> *. -rewrite -H5. -rewrite !pack8E W8u8.Pack.of_listE. -apply W64.init_ext. -move => *. -beta. -apply W8.wordP. -apply W8u8.Pack.packP. -apply W8u8.Pack.init_ext. -move => />. -have HHH : (to_uint x + 32 < W64.modulus). admit. (* safety *) -smt(@W64). smt(). smt(). -move => *. -case (x0 = 2). -move => x00. -rewrite x00 => />. -move : (H 6); rewrite /loadW64 => /> *. -rewrite -H6. -rewrite !pack8E W8u8.Pack.of_listE. -apply W64.init_ext. -move => *. -beta. -apply W8.wordP. -apply W8u8.Pack.packP. -apply W8u8.Pack.init_ext. -move => />. -have HHH : (to_uint x + 32 < W64.modulus). admit. (* safety *) -smt(@W64). smt(). smt(). -move => *. -case (x0 = 3). -move => x00. -rewrite x00 => />. -move : (H 7); rewrite /loadW64 => /> *. -rewrite -H7. -rewrite !pack8E W8u8.Pack.of_listE. -apply W64.init_ext. -move => *. -beta. -apply W8.wordP. -apply W8u8.Pack.packP. -apply W8u8.Pack.init_ext. -move => />. -have HHH : (to_uint x + 32 < W64.modulus). admit. (* safety *) -smt(@W64). smt(). smt(). -smt(). -admit. (* need to keep going *) -qed. - -(* these are the same as above *) -lemma loadlift_rhol : forall (mem : global_mem_t) (x : W64.t) (off : int), - good_rhol mem (to_uint x) => 0 <= off < 6 => - lift2array - (loadW256 mem (to_uint (x + W64.of_int (8 * 4 * off)))) = - (witness - .[0 <- W64.of_int good_rhotates_left.[4*off + 0]] - .[1 <- W64.of_int good_rhotates_left.[4*off + 1]] - .[2 <- W64.of_int good_rhotates_left.[4*off + 2]] - .[3 <- W64.of_int good_rhotates_left.[4*off + 3]])%Array4 by admit. - -lemma loadlift_iotas : forall (mem : global_mem_t) (x : W64.t) (off : int), - good_iotas mem (to_uint x) => 0 <= off < 24 => - lift2array - (loadW256 mem (to_uint (x + W64.of_int (8 * 4 * off)))) = - (witness - .[0 <- good_iotas4x.[4*off + 0]] - .[1 <- good_iotas4x.[4*off + 1]] - .[2 <- good_iotas4x.[4*off + 2]] - .[3 <- good_iotas4x.[4*off + 3]])%Array4 by admit. - -op conversion(o1 o2 : int) : int = - let (x,y) = - ((witness - .[0 <- (2,0)] - .[1 <- (4,0)] - .[2 <- (1,0)] - .[3 <- (3,0)] - .[4 <- (0,1)] - .[5 <- (0,2)] - .[6 <- (0,3)] - .[7 <- (0,4)] - .[8 <- (3,1)] - .[9 <- (1,2)] - .[10 <- (4,3)] - .[11 <- (2,4)] - .[12 <- (2,1)] - .[13 <- (4,2)] - .[14 <- (1,3)] - .[15 <- (3,4)] - .[16 <- (4,1)] - .[17 <- (3,2)] - .[18 <- (2,3)] - .[19 <- (1,4)] - .[20 <- (1,1)] - .[21 <- (2,2)] - .[22 <- (3,3)] - .[23 <- (4,4)])%Array24).[o1*4 + o2] in (5*x + y). - -lemma lift_roln mem rl rr o1 o2 x: - 0 <= o1 < 6 => 0 <= o2 < 4 => - good_rhol mem (W64.to_uint rl) => - good_rhor mem (W64.to_uint rr) => - (x `>>>` - (to_uint - (lift2array - (loadW256 mem - (to_uint (rr + W64.of_int 96 + W64.of_int (8 * 4 * o1 - 96))))).[o2]))%W64 `|` - (x `<<<` - (to_uint - (lift2array - (loadW256 mem - (to_uint (rl + W64.of_int 96 + W64.of_int (8 * 4 * o1 - 96))))).[o2]))%W64 - = (x86_ROL_64 x ((of_int (rhotates (conversion o1 o2))))%W8).`3. -proof. -move => *. -rewrite (loadlift_rhol mem (rl) o1). smt(). smt(). -rewrite (loadlift_rhor mem (rr) o1). smt(). smt(). -rewrite /good_rhotates_right /good_rhotates_left /rhotates /conversion. -simplify. -case(o1 = 0). auto => />. -case (o2 = 0). auto => />. smt(roln). -case (o2 = 1). auto => />. smt(roln). -case (o2 = 2). auto => />. smt(roln). -case (o2 = 3). auto => />. smt(roln). -smt(). -move => *. -case(o1 = 1). auto => />. -case (o2 = 0). auto => />. smt(roln). -case (o2 = 1). auto => />. smt(roln). -case (o2 = 2). auto => />. smt(roln). -case (o2 = 3). auto => />. smt(roln). -smt(). -move => *. -case(o1 = 2). auto => />. -case (o2 = 0). auto => />. smt(roln). -case (o2 = 1). auto => />. smt(roln). -case (o2 = 2). auto => />. smt(roln). -case (o2 = 3). auto => />. smt(roln). -smt(). -move => *. -case(o1 = 3). auto => />. -case (o2 = 0). auto => />. smt(roln). -case (o2 = 1). auto => />. smt(roln). -case (o2 = 2). auto => />. smt(roln). -case (o2 = 3). auto => />. smt(roln). -smt(). -move => *. -case(o1 = 4). auto => />. -case (o2 = 0). auto => />. smt(roln). -case (o2 = 1). auto => />. smt(roln). -case (o2 = 2). auto => />. smt(roln). -case (o2 = 3). auto => />. smt(roln). -smt(). -move => *. -case(o1 = 5). auto => />. -case (o2 = 0). auto => />. smt(roln). -case (o2 = 1). auto => />. smt(roln). -case (o2 = 2). auto => />. smt(roln). -case (o2 = 3). auto => />. smt(roln). -smt(). -smt(). -qed. - -lemma correct_perm A00 A01 A20 A31 A21 A41 A11 st mem: - equiv [ Mreftable.permute ~ Mavx2_prevec.__KeccakF1600 : - Glob.mem{2} = mem /\ good_iotas mem (to_uint _iotas{2}) /\ - good_rhol mem (to_uint _rhotates_left{2}) /\ good_rhor mem (to_uint _rhotates_right{2}) /\ - equiv_states A00 A01 A20 A31 A21 A41 A11 st /\ - _A00{2} = A00 /\ _A01{2} = A01 /\ _A20{2} = A20 /\ _A31{2} = A31 /\ - _A21{2} = A21 /\ _A41{2} = A41 /\ _A11{2} = A11 /\ state{1} = st ==> - equiv_states res{2}.`1 res{2}.`2 res{2}.`3 res{2}.`4 res{2}.`5 res{2}.`6 res{2}.`7 res{1}]. -proc. -unroll {1} 3. -rcondt {1} 3; first by move => *; inline *; auto => />. - -seq 0 1 : #pre; first by auto => />. -inline Mreftable.keccakRoundConstants. -sp 2 4. - -seq 1 105 : (#{/~_A00{2}}{~_A01{2}}{~_A20{2}}{~_A31{2}}{~_A21{2}}{~_A41{2}}{~_A11{2}}{~state{1}}pre /\ Glob.mem{2} = mem /\ - good_iotas mem (to_uint _iotas{2}) /\ - good_rhol mem (to_uint _rhotates_left{2}) /\ - good_rhor mem (to_uint _rhotates_right{2}) /\ - equiv_states _A00{2} _A01{2} _A20{2} _A31{2} _A21{2} _A41{2} _A11{2} state{1}). - -seq 0 0 : (#pre /\ (constants{1}.[round{1}])%Array24 = W64.of_int 1). -by auto => />; rewrite /iotas;smt(). - -inline Mreftable.keccakP1600_round. - -sp 2 0. -inline Mreftable.theta. -sp 1 0. - -swap {2} [20..21] 3. -swap {2} 28 -3. -swap {2} 32 -6. -swap {2} 36 -9. -swap {2} 40 -12. -swap {2} 46 -17. - -seq 9 29 : (#{/~state{1}}post /\ c{1} = W64.of_int 1 /\ - equiv_states _A00{2} _A01{2} _A20{2} _A31{2} _A21{2} _A41{2} _A11{2} state0{1}). -do 13!(unroll for {1} ^while). - - -inline *. -do !((rcondf {2} ^if; first by move => *; wp;skip;auto => />) || - (rcondt {2} ^if; first by move => *; wp;skip;auto => />)). - -wp;skip. -move => &1 &2. -rewrite /equiv_states /index. - simplify. -by smt(W64.xorwA W64.xorwC W64.xorw0 W64.xorwK rolcomp commor). - -(* Rho PI *) -inline Mreftable.rho Mreftable.pi. - -seq 11 22 : (#{/~ state{1}}post /\ c{1} = W64.of_int 1 /\ - equiv_states_chi _A00{2} _T{2}.[1] _T{2}.[2] _T{2}.[3] _T{2}.[4] _T{2}.[5] _T{2}.[6] state0{1}). - -do 13!(unroll for {1} ^while). -inline *. -do !((rcondf {2} ^if; first by move => *; wp;skip;auto => />) || - (rcondt {2} ^if; first by move => *; wp;skip;auto => />)). - -wp;skip. -move => &1 &2. -rewrite /equiv_states /equiv_states_chi /index. -simplify. - -move => [/ # *]. - -split; first by smt(). -split; first by smt(). - -split; first by rewrite /rhotates; smt(roln rol0). -split; first by rewrite /rhotates; smt(roln rol0). -split; first by rewrite /rhotates; smt(roln rol0). -split; first by rewrite /rhotates; smt(roln rol0). - -split. -rewrite H H0. -move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 5 3 _A11{2}.[3] _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - -split. -rewrite H H0. -move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 5 2 _A11{2}.[2] _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - -split. -rewrite H H0. -move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 5 1 _A11{2}.[1] _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - -split. -rewrite H H0. -move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 5 0 _A11{2}.[0] _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - -split. -rewrite H H0. -move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 1 3 _A01{2}.[3] _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - -split. -rewrite H H0. -move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 1 2 _A01{2}.[2] _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - -split. -rewrite H H0. -move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 1 1 _A01{2}.[1] _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - -split. -rewrite H H0. -move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 1 0 _A01{2}.[0] _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - - -split. -rewrite H H0. -move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 0 2 _A20{2}.[2] _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - -split. -rewrite H H0. -move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 0 0 _A20{2}.[0] _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - -split. -rewrite H H0. -move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 0 3 _A20{2}.[3] _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - -split. -rewrite H H0. -move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 0 1 _A20{2}.[1] _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - -split. -rewrite H H0. -move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 2 2 _A31{2}.[2] _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - -split. -rewrite H H0. -move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 2 0 _A31{2}.[0] _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - -split. -rewrite H H0. -move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 2 3 _A31{2}.[3] _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - -split. -rewrite H H0. -move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 2 1 _A31{2}.[1] _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - -split. -rewrite H H0. -move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 3 0 _A21{2}.[0] _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - -split. -rewrite H H0. -move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 3 1 _A21{2}.[1] _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - -split. -rewrite H H0. -move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 3 2 _A21{2}.[2] _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - -split. -rewrite H H0. -move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 3 3 _A21{2}.[3] _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - -split. -rewrite H H0. -move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 4 1 _A41{2}.[1] _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - -split. -rewrite H H0. -move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 4 3 _A41{2}.[3] _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - -split. -rewrite H H0. -move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 4 0 _A41{2}.[0] _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - -rewrite H H0. -move : H36 H37; rewrite -H5 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 4 2 _A41{2}.[2] _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - - -(* Chi *) -inline Mreftable.chi. - -seq 5 53 : (#{~state0{1}}pre /\ - equiv_states _A00{2} _A01{2} _A20{2} _A31{2} _A21{2} _A41{2} _A11{2} state0{1}). - -do 11!(unroll for {1} ^while). -inline *. -do !((rcondf {2} ^if; first by move => *; wp;skip;auto => />) || - (rcondt {2} ^if; first by move => *; wp;skip;auto => />)). - -wp. skip. -move => &1 &2. -rewrite /equiv_states /equiv_states_chi /index. -simplify. - -move => [/ # *]. - -split; first by smt(). - -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -smt(@W64). - -inline *. wp;skip. -move => &1 &2 [/ # *]. -split; first by smt(). -split; first by smt(). -split; first by smt(). -split; first by smt(). -split; first by smt(). -rewrite /equiv_states /index /y_R. -simplify. - -move : (loadlift_iotas Glob.mem{2} (iotas{2}) 0) => //= ii. -rewrite ii. simplify. -smt(@W64). -rewrite /good_iotas4x. -simplify. -smt(@W64). - -seq 1 2 : (#{/~iotas{2}}{~round{1}}{~i{2}}{~st}pre /\ - iotas{2} = _iotas{2} + W64.of_int (round{1} * 32) /\ - to_uint i{2} = 24 - round{1} /\ - ((to_uint i{2} = 0) <> round{1} < 24) /\ - (x86_DEC_32 (i{2} + W32.of_int 1)).`4 = zf{2} /\ - 0 < round{1} /\ - to_uint i{2} <= 24 /\ - constants{1} = Keccak_f1600_ref.iotas). - -auto => />. -progress. -apply dec. smt(). -rewrite (dec). smt(@W32). smt(@W32). -rewrite (decK). smt(@W32). -smt(@W32 dec decK). - -while (#pre). - -inline Mreftable.keccakP1600_round. - - -sp 2 0. -inline Mreftable.theta. -sp 1 0. - -swap {2} [20..21] 3. -swap {2} 28 -3. -swap {2} 32 -6. -swap {2} 36 -9. -swap {2} 40 -12. -swap {2} 46 -17. - -seq 9 29 : (#{/~state{1}}post /\ c{1} = constants{1}.[round{1}] /\ round{1} < 24 /\ - equiv_states _A00{2} _A01{2} _A20{2} _A31{2} _A21{2} _A41{2} _A11{2} state0{1}). - -do 13!(unroll for {1} ^while). -inline *. -do !((rcondf {2} ^if; first by move => *; wp;skip;auto => />) || - (rcondt {2} ^if; first by move => *; wp;skip;auto => />)). - -wp;skip. -move => &1 &2. -rewrite /equiv_states /index. -simplify. -by smt(W64.xorwA W64.xorwC W64.xorw0 W64.xorwK rolcomp commor). - -(* Rho PI *) -inline Mreftable.rho Mreftable.pi. - -seq 11 22 : (#{/~ state{1}}post /\ c{1} = constants{1}.[round{1}] /\ round{1} < 24 /\ - equiv_states_chi _A00{2} _T{2}.[1] _T{2}.[2] _T{2}.[3] _T{2}.[4] _T{2}.[5] _T{2}.[6] state0{1}). - -do 13!(unroll for {1} ^while). - - -inline *. -do !((rcondf {2} ^if; first by move => *; wp;skip;auto => />) || - (rcondt {2} ^if; first by move => *; wp;skip;auto => />)). - -wp;skip. -move => &1 &2. -rewrite /equiv_states /equiv_states_chi /index. -simplify. - -move => [/ #] *. - -split; first by smt(). -split; first by smt(). -split; first by smt(). - -split; first by rewrite /rhotates; smt(roln rol0). -split; first by rewrite /rhotates; smt(roln rol0). -split; first by rewrite /rhotates; smt(roln rol0). -split; first by rewrite /rhotates; smt(roln rol0). - -split. -rewrite H H0. -move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 5 3 _A11{2}.[3] _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - -split. -rewrite H H0. -move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 5 2 _A11{2}.[2] _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - -split. -rewrite H H0. -move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 5 1 _A11{2}.[1] _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - -split. -rewrite H H0. -move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 5 0 _A11{2}.[0] _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - -split. -rewrite H H0. -move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 1 3 _A01{2}.[3] _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - -split. -rewrite H H0. -move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 1 2 _A01{2}.[2] _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - -split. -rewrite H H0. -move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 1 1 _A01{2}.[1] _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - -split. -rewrite H H0. -move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 1 0 _A01{2}.[0] _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - - -split. -rewrite H H0. -move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 0 2 _A20{2}.[2] _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - -split. -rewrite H H0. -move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 0 0 _A20{2}.[0] _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - -split. -rewrite H H0. -move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 0 3 _A20{2}.[3] _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - -split. -rewrite H H0. -move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 0 1 _A20{2}.[1] _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - -split. -rewrite H H0. -move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 2 2 _A31{2}.[2] _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - -split. -rewrite H H0. -move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 2 0 _A31{2}.[0] _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - -split. -rewrite H H0. -move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 2 3 _A31{2}.[3] _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - -split. -rewrite H H0. -move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 2 1 _A31{2}.[1] _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - -split. -rewrite H H0. -move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 3 0 _A21{2}.[0] _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - -split. -rewrite H H0. -move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 3 1 _A21{2}.[1] _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - -split. -rewrite H H0. -move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 3 2 _A21{2}.[2] _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - -split. -rewrite H H0. -move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 3 3 _A21{2}.[3] _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - -split. -rewrite H H0. -move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 4 1 _A41{2}.[1] _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - -split. -rewrite H H0. -move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 4 3 _A41{2}.[3] _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - -split. -rewrite H H0. -move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 4 0 _A41{2}.[0] _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - -rewrite H H0. -move : H5 H6; rewrite -H2 => rl rr. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 4 2 _A41{2}.[2] _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - -smt(). - -(* Chi *) -inline Mreftable.chi. - -seq 5 53 : (#{~state0{1}}pre /\ - equiv_states _A00{2} _A01{2} _A20{2} _A31{2} _A21{2} _A41{2} _A11{2} state0{1}). - -do 11!(unroll for {1} ^while). -inline *. -do !((rcondf {2} ^if; first by move => *; wp;skip;auto => />) || - (rcondt {2} ^if; first by move => *; wp;skip;auto => />)). - -wp. skip. -move => &1 &2. -rewrite /equiv_states /equiv_states_chi /index. -simplify. - -move => [/ #] *. - -split; first by smt(). - -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -smt(@W64). - -smt(). - - -(* iota *) - -seq 2 1 : (#{/~ state0{1}}pre /\ - equiv_states _A00{2} _A01{2} _A20{2} _A31{2} _A21{2} _A41{2} _A11{2} - state{1}). - -inline *; wp; skip; rewrite /equiv_states /index; progress. - -move : (loadlift_iotas Glob.mem{2} _iotas{2}(round{1})) => ii. -rewrite (_:round{1} * 32 = 8*4*round{1}); first by smt(). -rewrite ii. simplify. smt(). smt(). -rewrite /good_iotas4x /iotas. -case (round{1} = 0); first by auto => />. -case (round{1} = 1). auto => />. smt(@W64). -case (round{1} = 2). auto => />. smt(@W64). -case (round{1} = 3). auto => />. smt(@W64). -case (round{1} = 4). auto => />. smt(@W64). -case (round{1} = 5). auto => />. smt(@W64). -case (round{1} = 6). auto => />. smt(@W64). -case (round{1} = 7). auto => />. smt(@W64). -case (round{1} = 8). auto => />. smt(@W64). -case (round{1} = 9). auto => />. smt(@W64). -case (round{1} = 10). auto => />. smt(@W64). -case (round{1} = 11). auto => />. smt(@W64). -case (round{1} = 12). auto => />. smt(@W64). -case (round{1} = 13). auto => />. smt(@W64). -case (round{1} = 14). auto => />. smt(@W64). -case (round{1} = 15). auto => />. smt(@W64). -case (round{1} = 16). auto => />. smt(@W64). -case (round{1} = 17). auto => />. smt(@W64). -case (round{1} = 18). auto => />. smt(@W64). -case (round{1} = 19). auto => />. smt(@W64). -case (round{1} = 20). auto => />. smt(@W64). -case (round{1} = 21). auto => />. smt(@W64). -case (round{1} = 22). auto => />. smt(@W64). -case (round{1} = 23). auto => />. smt(@W64). -smt(). - -move : (loadlift_iotas Glob.mem{2} _iotas{2}(round{1})) => ii. -rewrite (_:round{1} * 32 = 8*4*round{1}); first by smt(). -rewrite ii. simplify. smt(). smt(). -rewrite /good_iotas4x /iotas. -case (round{1} = 0); first by auto => />. -case (round{1} = 1). auto => />. smt(@W64). -case (round{1} = 2). auto => />. smt(@W64). -case (round{1} = 3). auto => />. smt(@W64). -case (round{1} = 4). auto => />. smt(@W64). -case (round{1} = 5). auto => />. smt(@W64). -case (round{1} = 6). auto => />. smt(@W64). -case (round{1} = 7). auto => />. smt(@W64). -case (round{1} = 8). auto => />. smt(@W64). -case (round{1} = 9). auto => />. smt(@W64). -case (round{1} = 10). auto => />. smt(@W64). -case (round{1} = 11). auto => />. smt(@W64). -case (round{1} = 12). auto => />. smt(@W64). -case (round{1} = 13). auto => />. smt(@W64). -case (round{1} = 14). auto => />. smt(@W64). -case (round{1} = 15). auto => />. smt(@W64). -case (round{1} = 16). auto => />. smt(@W64). -case (round{1} = 17). auto => />. smt(@W64). -case (round{1} = 18). auto => />. smt(@W64). -case (round{1} = 19). auto => />. smt(@W64). -case (round{1} = 20). auto => />. smt(@W64). -case (round{1} = 21). auto => />. smt(@W64). -case (round{1} = 22). auto => />. smt(@W64). -case (round{1} = 23). auto => />. smt(@W64). -smt(). - -move : (loadlift_iotas Glob.mem{2} _iotas{2}(round{1})) => ii. -rewrite (_:round{1} * 32 = 8*4*round{1}); first by smt(). -rewrite ii. simplify. smt(). smt(). -rewrite /good_iotas4x /iotas. -case (round{1} = 0); first by auto => />. -case (round{1} = 1). auto => />. smt(@W64). -case (round{1} = 2). auto => />. smt(@W64). -case (round{1} = 3). auto => />. smt(@W64). -case (round{1} = 4). auto => />. smt(@W64). -case (round{1} = 5). auto => />. smt(@W64). -case (round{1} = 6). auto => />. smt(@W64). -case (round{1} = 7). auto => />. smt(@W64). -case (round{1} = 8). auto => />. smt(@W64). -case (round{1} = 9). auto => />. smt(@W64). -case (round{1} = 10). auto => />. smt(@W64). -case (round{1} = 11). auto => />. smt(@W64). -case (round{1} = 12). auto => />. smt(@W64). -case (round{1} = 13). auto => />. smt(@W64). -case (round{1} = 14). auto => />. smt(@W64). -case (round{1} = 15). auto => />. smt(@W64). -case (round{1} = 16). auto => />. smt(@W64). -case (round{1} = 17). auto => />. smt(@W64). -case (round{1} = 18). auto => />. smt(@W64). -case (round{1} = 19). auto => />. smt(@W64). -case (round{1} = 20). auto => />. smt(@W64). -case (round{1} = 21). auto => />. smt(@W64). -case (round{1} = 22). auto => />. smt(@W64). -case (round{1} = 23). auto => />. smt(@W64). -smt(). - -move : (loadlift_iotas Glob.mem{2} _iotas{2}(round{1})) => ii. -rewrite (_:round{1} * 32 = 8*4*round{1}); first by smt(). -rewrite ii. simplify. smt(). -smt(). -rewrite /good_iotas4x /iotas. -case (round{1} = 0); first by auto => />. -case (round{1} = 1). auto => />. smt(@W64). -case (round{1} = 2). auto => />. smt(@W64). -case (round{1} = 3). auto => />. smt(@W64). -case (round{1} = 4). auto => />. smt(@W64). -case (round{1} = 5). auto => />. smt(@W64). -case (round{1} = 6). auto => />. smt(@W64). -case (round{1} = 7). auto => />. smt(@W64). -case (round{1} = 8). auto => />. smt(@W64). -case (round{1} = 9). auto => />. smt(@W64). -case (round{1} = 10). auto => />. smt(@W64). -case (round{1} = 11). auto => />. smt(@W64). -case (round{1} = 12). auto => />. smt(@W64). -case (round{1} = 13). auto => />. smt(@W64). -case (round{1} = 14). auto => />. smt(@W64). -case (round{1} = 15). auto => />. smt(@W64). -case (round{1} = 16). auto => />. smt(@W64). -case (round{1} = 17). auto => />. smt(@W64). -case (round{1} = 18). auto => />. smt(@W64). -case (round{1} = 19). auto => />. smt(@W64). -case (round{1} = 20). auto => />. smt(@W64). -case (round{1} = 21). auto => />. smt(@W64). -case (round{1} = 22). auto => />. smt(@W64). -case (round{1} = 23). auto => />. smt(@W64). -smt(). - -wp;skip;progress;smt(dec dec0 decK @W32). - -skip;progress. - -rewrite dec0. -split. rewrite to_uintD. smt(@W32). smt(@W32). -rewrite dec. rewrite to_uintD. smt(@W32). smt(@W32). - -move : H7. rewrite dec0. -rewrite to_uintD. smt(@W32). -rewrite dec. rewrite to_uintD. smt(@W32). -rewrite to_uintD. smt(@W32). -qed. - diff --git a/proof/impl/old_perm/keccak_f1600_ref.ec b/proof/impl/old_perm/keccak_f1600_ref.ec deleted file mode 100644 index fdfb1d3..0000000 --- a/proof/impl/old_perm/keccak_f1600_ref.ec +++ /dev/null @@ -1,246 +0,0 @@ -require import List Int IntExtra IntDiv CoreMap. -from Jasmin require import JModel. - -require import Array5 Array24 Array25. -require import WArray40 WArray192 WArray200. - -require import Ops. - -op iotas : W64.t Array24.t = (( - witness - .[0 <- W64.one] - .[1 <- W64.of_int 32898] - .[2 <- W64.of_int 9223372036854808714] - .[3 <- W64.of_int 9223372039002292224] - .[4 <- W64.of_int 32907] - .[5 <- W64.of_int 2147483649] - .[6 <- W64.of_int 9223372039002292353] - .[7 <- W64.of_int 9223372036854808585] - .[8 <- W64.of_int 138] - .[9 <- W64.of_int 136] - .[10 <- W64.of_int 2147516425] - .[11 <- W64.of_int 2147483658] - .[12 <- W64.of_int 2147516555] - .[13 <- W64.of_int 9223372036854775947] - .[14 <- W64.of_int 9223372036854808713] - .[15 <- W64.of_int 9223372036854808579] - .[16 <- W64.of_int 9223372036854808578] - .[17 <- W64.of_int 9223372036854775936] - .[18 <- W64.of_int 32778] - .[19 <- W64.of_int 9223372039002259466] - .[20 <- W64.of_int 9223372039002292353] - .[21 <- W64.of_int 9223372036854808704] - .[22 <- W64.of_int 2147483649] - .[23 <- W64.of_int 9223372039002292232])%Array24). - -module Mref = { - proc index (x:int, y:int) : int = { - - var r:int; - - r <- ((x %% 5) + (5 * (y %% 5))); - return (r); - } - - proc theta (a:W64.t Array25.t) : W64.t Array25.t = { - var aux_1: bool; - var aux_0: bool; - var aux: int; - var aux_2: W64.t; - - var x:int; - var c:W64.t Array5.t; - var y:int; - var d:W64.t Array5.t; - var _0:bool; - var _1:bool; - c <- witness; - d <- witness; - x <- 0; - while (x < 5) { - c.[x] <- (W64.of_int 0); - y <- 0; - while (y < 5) { - c.[x] <- (c.[x] `^` a.[(x + (5 * y))]); - y <- y + 1; - } - x <- x + 1; - } - x <- 0; - while (x < 5) { - (aux_1, aux_0, aux_2) <- x86_ROL_64 c.[((x + 1) %% 5)] (W8.of_int 1); - _0 <- aux_1; - _1 <- aux_0; - d.[x] <- aux_2; - d.[x] <- (d.[x] `^` c.[((x + 4) %% 5)]); - x <- x + 1; - } - x <- 0; - while (x < 5) { - y <- 0; - while (y < 5) { - a.[(x + (5 * y))] <- (a.[(x + (5 * y))] `^` d.[x]); - y <- y + 1; - } - x <- x + 1; - } - return (a); - } - - proc keccakRhoOffsets (i:int) : int = { - var aux: int; - - var r:int; - var x:int; - var y:int; - var t:int; - var z:int; - - r <- 0; - x <- 1; - y <- 0; - t <- 0; - while (t < 24) { - if ((i = (x + (5 * y)))) { - r <- ((((t + 1) * (t + 2)) %/ 2) %% 64); - } else { - - } - z <- (((2 * x) + (3 * y)) %% 5); - x <- y; - y <- z; - t <- t + 1; - } - return (r); - } - - proc rho (a:W64.t Array25.t) : W64.t Array25.t = { - var aux_1: bool; - var aux_0: bool; - var aux: int; - var aux_2: W64.t; - - var x:int; - var y:int; - var i:int; - var z:int; - var _0:bool; - var _1:bool; - - x <- 0; - while (x < 5) { - y <- 0; - while (y < 5) { - i <@ index (x, y); - z <@ keccakRhoOffsets (i); - (aux_1, aux_0, aux_2) <- x86_ROL_64 a.[i] (W8.of_int z); - _0 <- aux_1; - _1 <- aux_0; - a.[i] <- aux_2; - y <- y + 1; - } - x <- x + 1; - } - return (a); - } - - proc pi (a:W64.t Array25.t) : W64.t Array25.t = { - var aux: int; - - var i:int; - var t:W64.t; - var b:W64.t Array25.t; - var y:int; - var x:int; - b <- witness; - i <- 0; - while (i < 25) { - t <- a.[i]; - b.[i] <- t; - i <- i + 1; - } - x <- 0; - while (x < 5) { - y <- 0; - while (y < 5) { - t <- b.[(x + (5 * y))]; - i <@ index (y, ((2 * x) + (3 * y))); - a.[i] <- t; - y <- y + 1; - } - x <- x + 1; - } - return (a); - } - - proc chi (a:W64.t Array25.t) : W64.t Array25.t = { - var aux: int; - - var x:int; - var y:int; - var i:int; - var c:W64.t Array5.t; - c <- witness; - y <- 0; - while (y < 5) { - x <- 0; - while (x < 5) { - i <@ index ((x + 1), y); - c.[x] <- a.[i]; - c.[x] <- (invw c.[x]); - i <@ index ((x + 2), y); - c.[x] <- (c.[x] `&` a.[i]); - i <@ index (x, y); - c.[x] <- (c.[x] `^` a.[i]); - x <- x + 1; - } - x <- 0; - while (x < 5) { - a.[(x + (5 * y))] <- c.[x]; - x <- x + 1; - } - y <- y + 1; - } - return (a); - } - - proc iota_0 (a:W64.t Array25.t, c:W64.t) : W64.t Array25.t = { - - - - a.[0] <- (a.[0] `^` c); - return (a); - } - - proc keccakP1600_round (state:W64.t Array25.t, c:W64.t) : W64.t Array25.t = { - - - - state <@ theta (state); - state <@ rho (state); - state <@ pi (state); - state <@ chi (state); - state <@ iota_0 (state, c); - return (state); - } - - proc keccakRoundConstants () : W64.t Array24.t = { - return iotas; - } - - proc permute (state:W64.t Array25.t) : W64.t Array25.t = { - var aux: int; - - var constants:W64.t Array24.t; - var round:int; - constants <- witness; - constants <@ keccakRoundConstants (); - round <- 0; - while (round < 24) { - state <@ keccakP1600_round (state, constants.[round]); - round <- round + 1; - } - return (state); - } -}. - diff --git a/proof/impl/old_perm/keccak_f1600_ref_loop2.ec b/proof/impl/old_perm/keccak_f1600_ref_loop2.ec deleted file mode 100644 index e7873d0..0000000 --- a/proof/impl/old_perm/keccak_f1600_ref_loop2.ec +++ /dev/null @@ -1,169 +0,0 @@ -require import List Int IntExtra IntDiv CoreMap. -from Jasmin require import JModel. - - require import Array5 Array24 Array25. -require import WArray40 WArray192 WArray200. - -require import Keccak_f1600_ref_table. -import Keccak_f1600_ref. -import Ops. - -module Mrefloop2 = { - include Mreftable [-permute] - - proc permute (state:W64.t Array25.t) : W64.t Array25.t = { - var aux: int; - - var constants:W64.t Array24.t; - var round:int; - constants <- witness; - constants <@ keccakRoundConstants (); - round <- 0; - state <@ keccakP1600_round (state, constants.[round]); - round <- round + 1; - state <@ keccakP1600_round (state, constants.[round]); - round <- round + 1; - while (round < 24) { - state <@ keccakP1600_round (state, constants.[round]); - state <@ keccakP1600_round (state, constants.[round + 1]); - round <- round + 2; - } - return (state); - } -}. - -require import LoopTransform. -clone import ExactIter with - type t = (W64.t Array25.t * W64.t Array24.t). - -module ExplBody : AdvLoop = { - include Mreftable [-permute] - proc body(st : t,i : int) = { - var rst; - rst <@ keccakP1600_round(st.`1,st.`2.[i]); - return (rst,st.`2); - } -}. - -module Mrefloop = { - include ExplBody - include Loop(ExplBody) [loop1] - - proc permute (state:W64.t Array25.t) : W64.t Array25.t = { - var aux: int; - - var constants:W64.t Array24.t; - var round:int; - constants <- witness; - constants <@ keccakRoundConstants (); - (state,constants) <@ loop1((state,constants),24); - return (state); - } - -}. - -module Mrefloopk = { - include ExplBody - include Loop(ExplBody) [loopk] - - proc permute (state:W64.t Array25.t) : W64.t Array25.t = { - var aux: int; - - var constants:W64.t Array24.t; - var round:int; - constants <- witness; - constants <@ keccakRoundConstants (); - (state,constants) <@ loopk((state,constants),12,2); - return (state); - } - -}. - -lemma reftable_refloop : - equiv [ Mreftable.permute ~ Mrefloop.permute : - ={arg,Glob.mem} ==> ={res,Glob.mem} ]. -proc. -inline Mrefloop.loop1. -inline ExplBody.body. -wp. -while (={Glob.mem} /\ (state{1},constants{1}) = t{2} /\ round{1} = i{2} /\ n{2} = 24). -wp; call(_:true); first by sim. -by auto => />. -wp; call(_:true); first by sim. -by auto => />. -qed. - -lemma refloop_refloopk : - equiv [ Mrefloop.permute ~ Mrefloopk.permute : - ={arg,Glob.mem} ==> ={res,Glob.mem} ]. -proc. -call (loop1_loopk ExplBody). - call(_:true); first by sim. -by auto => />. -qed. - - -lemma refloopk_refloop2 : - equiv [ Mrefloopk.permute ~ Mrefloop2.permute : - ={arg,Glob.mem} ==> ={res,Glob.mem} ]. - -proc. -seq 2 2 : (#pre /\ ={constants}); first by sim. -inline Mrefloopk.loopk. - -unroll {1} 5. -rcondt {1} 5; first by move => *; auto => />. - -unroll {1} 6. -rcondt {1} 6; first by move => *; auto => />. - -seq 7 3 : (#{/~state{1}}pre /\ (state{2},constants{2}) = t{1} /\ k{1} = 2 /\ n{1} = 12 /\ j{1} = 1 /\ i{1} = 0 /\ round{2} = 1). -inline ExplBody.body. -wp; call(_:true); first by sim. -by auto => />. - - -unroll {1} 1. -rcondt {1} 1; first by move => *; auto => />. - -seq 2 2 : (#{/~j{1} = 1}{~round{2}=1}pre /\ j{1} = 2 /\ round{2} = 2). -inline ExplBody.body. -wp; call(_:true); first by sim. -by auto => />. - -seq 1 0 : #pre. while {1} (j{1} = 2 /\ k{1} = 2 /\ (state{2},constants{2}) = t{1} ) 1. move => *. exfalso. smt(). -by auto => />. - -seq 1 0 : (#{/~j{1}}{~i{1}}pre /\ i{1} = 1); first by auto => />. -wp. -while (={Glob.mem} /\ - ={constants} /\ - (state{2}, constants{2}) = t{1} /\ - k{1} = 2 /\ n{1} = 12 /\ - round{2} = 2*i{1}). - -unroll {1} 2. -rcondt {1} 2; first by move => *; auto => />. - -seq 3 1 : (#pre /\ j{1} = 1). -inline ExplBody.body. -wp; call(_:true); first by sim. -by auto => />. - -unroll {1} 1. -rcondt {1} 1; first by move => *; auto => />. - -seq 2 1 : (#{/~ j{1} = 1}pre /\ j{1} = 2). -inline ExplBody.body. -wp; call(_:true); first by sim. -by auto => />. - -seq 1 0 : #pre. while {1} (j{1} = 2 /\ k{1} = 2 /\ (state{2},constants{2}) = t{1} ) 1. move => *. exfalso. smt(). -by auto => />. - -by auto => />; smt(). - -by auto => />. - -qed. - diff --git a/proof/impl/old_perm/keccak_f1600_ref_table.ec b/proof/impl/old_perm/keccak_f1600_ref_table.ec deleted file mode 100644 index 11aa491..0000000 --- a/proof/impl/old_perm/keccak_f1600_ref_table.ec +++ /dev/null @@ -1,247 +0,0 @@ -require import List Int IntExtra IntDiv CoreMap. -from Jasmin require import JModel. - -require import Keccak_f1600_ref. -import Ops. -import Array24. -import Array25. - -op rhotates(i : int) : int = (( - witness - .[0 <- 0 ] - .[1 <- 1 ] - .[2 <- 62] - .[3 <- 28] - .[4 <- 27] - .[5 <- 36] - .[6 <- 44] - .[7 <- 6 ] - .[8 <- 55] - .[9 <- 20] - .[10 <- 3 ] - .[11 <- 10] - .[12 <- 43] - .[13 <- 25] - .[14 <- 39] - .[15 <- 41] - .[16 <- 45] - .[17 <- 15] - .[18 <- 21] - .[19 <- 8 ] - .[20 <- 18] - .[21 <- 2 ] - .[22 <- 61] - .[23 <- 56] - .[24 <- 14])%Array25).[i]. - -module RhotatesAlgo = { - include Mref [keccakRhoOffsets] -}. - -module RhotatesTable = { - proc keccakRhoOffsets (i:int) : int = { - return rhotates(i); - } -}. - -equiv rhotates_table_corr : - RhotatesAlgo.keccakRhoOffsets ~ RhotatesTable.keccakRhoOffsets : - ={arg} /\ 0 <= i{1} < 25 ==> ={res} . -proc. -unroll for {1} 5. - -case (i{1} = 0). -do !((rcondt {1} ^if; first by move => *; auto => />) || - (rcondf {1} ^if; first by move => *; auto => />)); auto => />. - -case (i{1} = 1). -do !((rcondt {1} ^if; first by move => *; auto => />) || - (rcondf {1} ^if; first by move => *; auto => />)); auto => />. - -case (i{1} = 2). -do !((rcondt {1} ^if; first by move => *; auto => />) || - (rcondf {1} ^if; first by move => *; auto => />)); auto => />. - -case (i{1} = 3). -do !((rcondt {1} ^if; first by move => *; auto => />) || - (rcondf {1} ^if; first by move => *; auto => />)); auto => />. - -case (i{1} = 4). -do !((rcondt {1} ^if; first by move => *; auto => />) || - (rcondf {1} ^if; first by move => *; auto => />)); auto => />. - -case (i{1} = 5). -do !((rcondt {1} ^if; first by move => *; auto => />) || - (rcondf {1} ^if; first by move => *; auto => />)); auto => />. - -case (i{1} = 6). -do !((rcondt {1} ^if; first by move => *; auto => />) || - (rcondf {1} ^if; first by move => *; auto => />)); auto => />. - -case (i{1} = 7). -do !((rcondt {1} ^if; first by move => *; auto => />) || - (rcondf {1} ^if; first by move => *; auto => />)); auto => />. - -case (i{1} = 8). -do !((rcondt {1} ^if; first by move => *; auto => />) || - (rcondf {1} ^if; first by move => *; auto => />)); auto => />. - -case (i{1} = 9). -do !((rcondt {1} ^if; first by move => *; auto => />) || - (rcondf {1} ^if; first by move => *; auto => />)); auto => />. - -case (i{1} = 10). -do !((rcondt {1} ^if; first by move => *; auto => />) || - (rcondf {1} ^if; first by move => *; auto => />)); auto => />. - -case (i{1} = 11). -do !((rcondt {1} ^if; first by move => *; auto => />) || - (rcondf {1} ^if; first by move => *; auto => />)); auto => />. - -case (i{1} = 12). -do !((rcondt {1} ^if; first by move => *; auto => />) || - (rcondf {1} ^if; first by move => *; auto => />)); auto => />. - -case (i{1} = 13). -do !((rcondt {1} ^if; first by move => *; auto => />) || - (rcondf {1} ^if; first by move => *; auto => />)); auto => />. - -case (i{1} = 14). -do !((rcondt {1} ^if; first by move => *; auto => />) || - (rcondf {1} ^if; first by move => *; auto => />)); auto => />. - -case (i{1} = 15). -do !((rcondt {1} ^if; first by move => *; auto => />) || - (rcondf {1} ^if; first by move => *; auto => />)); auto => />. - -case (i{1} = 16). -do !((rcondt {1} ^if; first by move => *; auto => />) || - (rcondf {1} ^if; first by move => *; auto => />)); auto => />. - -case (i{1} = 17). -do !((rcondt {1} ^if; first by move => *; auto => />) || - (rcondf {1} ^if; first by move => *; auto => />)); auto => />. - -case (i{1} = 18). -do !((rcondt {1} ^if; first by move => *; auto => />) || - (rcondf {1} ^if; first by move => *; auto => />)); auto => />. - -case (i{1} = 19). -do !((rcondt {1} ^if; first by move => *; auto => />) || - (rcondf {1} ^if; first by move => *; auto => />)); auto => />. - -case (i{1} = 20). -do !((rcondt {1} ^if; first by move => *; auto => />) || - (rcondf {1} ^if; first by move => *; auto => />)); auto => />. - -case (i{1} = 21). -do !((rcondt {1} ^if; first by move => *; auto => />) || - (rcondf {1} ^if; first by move => *; auto => />)); auto => />. - -case (i{1} = 22). -do !((rcondt {1} ^if; first by move => *; auto => />) || - (rcondf {1} ^if; first by move => *; auto => />)); auto => />. - -case (i{1} = 23). -do !((rcondt {1} ^if; first by move => *; auto => />) || - (rcondf {1} ^if; first by move => *; auto => />)); auto => />. - -case (i{1} = 24). -do !((rcondt {1} ^if; first by move => *; auto => />) || - (rcondf {1} ^if; first by move => *; auto => />)); auto => />. - -by exfalso; smt(). -qed. - -module Mreftable = { - include Mref [-keccakRhoOffsets,rho,keccakP1600_round,permute] - include RhotatesTable - - proc rho (a:W64.t Array25.t) : W64.t Array25.t = { - var aux_1: bool; - var aux_0: bool; - var aux: int; - var aux_2: W64.t; - - var x:int; - var y:int; - var i:int; - var z:int; - var _0:bool; - var _1:bool; - - x <- 0; - while (x < 5) { - y <- 0; - while (y < 5) { - i <@ index (x, y); - z <@ keccakRhoOffsets (i); - (aux_1, aux_0, aux_2) <- x86_ROL_64 a.[i] (W8.of_int z); - _0 <- aux_1; - _1 <- aux_0; - a.[i] <- aux_2; - y <- y + 1; - } - x <- x + 1; - } - return (a); - } - - proc keccakP1600_round (state:W64.t Array25.t, c:W64.t) : W64.t Array25.t = { - state <@ theta (state); - state <@ rho (state); - state <@ pi (state); - state <@ chi (state); - state <@ iota_0 (state, c); - return (state); - } - - proc permute (state:W64.t Array25.t) : W64.t Array25.t = { - var aux: int; - - var constants:W64.t Array24.t; - var round:int; - round <- 0; - constants <@ keccakRoundConstants (); - while (round < 24) { - state <@ keccakP1600_round (state, constants.[round]); - round <- round + 1; - } - return (state); - } - -}. - -lemma ref_reftable : - equiv [ Mref.permute ~ Mreftable.permute : - ={arg,Glob.mem} ==> ={res,Glob.mem} ]. -proc. - -seq 3 2 : (#pre /\ ={constants} /\ ={round}); first by inline*; auto => />. - -while (#post /\ ={round,constants}); last by inline *; auto => />. - -wp. -call (_: true). -call (_: true); first by sim. -call (_: true); first by sim. -call (_: true); first by sim. -call (_: true). -while (#post /\ ={a,x} /\ 0 <= x{1} <= 5). -wp. -while (#post /\ ={a,x,y} /\ 0 <= x{1} <5 /\ 0 <=y{1} <= 5). -wp. -call (rhotates_table_corr). - -call(_: ={arg} /\ 0<=x{1} <5 /\ 0<=y{1} <5 ==> ={res} /\ 0 <= res{1} < 25). -by proc; inline *; auto => />;smt(). - -by auto => />;smt(). -by auto => />;smt(). -by auto => />;smt(). - -call(_:true); first by sim. -by auto => />. -by auto => />. - -qed. diff --git a/proof/impl/old_perm/keccak_f1600_scalar.ec b/proof/impl/old_perm/keccak_f1600_scalar.ec deleted file mode 100644 index 6a690b3..0000000 --- a/proof/impl/old_perm/keccak_f1600_scalar.ec +++ /dev/null @@ -1,201 +0,0 @@ -require import List Int IntExtra IntDiv CoreMap. -from Jasmin require import JModel. - -require import Array5 Array25. -require import WArray40 WArray200. - -require import Keccak_f1600_ref. -import Ops. - -op x86_TEST_8 : W8.t -> W8.t -> bool * bool * bool * bool * bool. - -module Mscalar = { - proc rOL64 (x:W64.t, c:int) : W64.t = { - - var y:W64.t; - var _0:bool; - var _1:bool; - - ( _0, _1, y) <- x86_ROL_64 x (W8.of_int c); - return (y); - } - - proc index (x:int, y:int) : int = { - - var r:int; - - r <- ((5 * (x %% 5)) + (y %% 5)); - return (r); - } - - proc keccak_rho_offsets (i:int) : int = { - var aux: int; - - var r:int; - var x:int; - var y:int; - var t:int; - var z:int; - - r <- 0; - x <- 1; - y <- 0; - t <- 0; - while (t < 24) { - if ((i = (x + (5 * y)))) { - r <- ((((t + 1) * (t + 2)) %/ 2) %% 64); - } else { - - } - z <- (((2 * x) + (3 * y)) %% 5); - x <- y; - y <- z; - t <- t + 1; - } - return (r); - } - - proc rhotates (x:int, y:int) : int = { - - var r:int; - var i:int; - - i <@ index (x, y); - r <@ keccak_rho_offsets (i); - return (r); - } - - proc theta_sum (_A:W64.t Array25.t) : W64.t Array5.t = { - var aux: int; - - var _C:W64.t Array5.t; - var i:int; - var j:int; - _C <- witness; - i <- 0; - while (i < 5) { - _C.[i] <- _A.[((5 * (0 %% 5)) + (i %% 5))]; - j <- 1; - while (j < 5) { - _C.[i] <- (_C.[i] `^` _A.[((5 * (j %% 5)) + (i %% 5))]); - j <- j + 1; - } - i <- i + 1; - } - return (_C); - } - - proc theta_rol (_C:W64.t Array5.t) : W64.t Array5.t = { - var aux: int; - - var _D:W64.t Array5.t; - var i:int; - var r:W64.t; - _D <- witness; - i <- 0; - while (i < 5) { - r <@ rOL64 (_C.[((i + 1) %% 5)], 1); - _D.[i] <- r; - _D.[i] <- (_D.[i] `^` _C.[((i + 4) %% 5)]); - i <- i + 1; - } - return (_D); - } - - proc rol_sum (_D:W64.t Array5.t, _A:W64.t Array25.t, offset:int) : W64.t Array5.t = { - var aux: int; - - var _C:W64.t Array5.t; - var j:int; - var j1:int; - var k:int; - var t:W64.t; - _C <- witness; - j <- 0; - while (j < 5) { - j1 <- ((j + offset) %% 5); - k <@ rhotates (j, j1); - t <- _A.[((5 * (j %% 5)) + (j1 %% 5))]; - t <- (t `^` _D.[j1]); - t <@ rOL64 (t, k); - _C.[j] <- t; - j <- j + 1; - } - return (_C); - } - - proc set_row (_R:W64.t Array25.t, row:int, _C:W64.t Array5.t, iota_0:W64.t) : - W64.t Array25.t = { - var aux: int; - - var j:int; - var j1:int; - var j2:int; - var t:W64.t; - - j <- 0; - while (j < 5) { - j1 <- ((j + 1) %% 5); - j2 <- ((j + 2) %% 5); - t <- ((invw _C.[j1]) `&` _C.[j2]); - if (((row = 0) /\ (j = 0))) { - t <- (t `^` iota_0); - } else { - - } - t <- (t `^` _C.[j]); - _R.[((5 * (row %% 5)) + (j %% 5))] <- t; - j <- j + 1; - } - return (_R); - } - - proc round2x (_A:W64.t Array25.t, _R:W64.t Array25.t, iotas:W64.t, o:int) : - W64.t Array25.t * W64.t Array25.t = { - - var iota_0:W64.t; - var _C:W64.t Array5.t; - var _D:W64.t Array5.t; - _C <- witness; - _D <- witness; - iota_0 <- (loadW64 Glob.mem (W64.to_uint (iotas + (W64.of_int o)))); - _C <@ theta_sum (_A); - _D <@ theta_rol (_C); - _C <@ rol_sum (_D, _A, 0); - _R <@ set_row (_R, 0, _C, iota_0); - _C <@ rol_sum (_D, _A, 3); - _R <@ set_row (_R, 1, _C, iota_0); - _C <@ rol_sum (_D, _A, 1); - _R <@ set_row (_R, 2, _C, iota_0); - _C <@ rol_sum (_D, _A, 4); - _R <@ set_row (_R, 3, _C, iota_0); - _C <@ rol_sum (_D, _A, 2); - _R <@ set_row (_R, 4, _C, iota_0); - return (_A, _R); - } - - proc keccak_f (_A:W64.t Array25.t, iotas:W64.t) : W64.t Array25.t * W64.t = { - - var zf:bool; - var _R:W64.t Array25.t; - var _0:bool; - var _1:bool; - var _2:bool; - var _3:bool; - _R <- witness; - (_A, _R) <@ round2x (_A, _R, iotas, 0); - (_R, _A) <@ round2x (_R, _A, iotas, 8); - iotas <- (iotas + (W64.of_int 16)); - ( _0, _1, _2, _3, zf) <- x86_TEST_8 (truncateu8 iotas) - (W8.of_int 255); - while ((! zf)) { - (_A, _R) <@ round2x (_A, _R, iotas, 0); - (_R, _A) <@ round2x (_R, _A, iotas, 8); - iotas <- (iotas + (W64.of_int 16)); - ( _0, _1, _2, _3, zf) <- x86_TEST_8 (truncateu8 iotas) - (W8.of_int 255); - } - iotas <- (iotas - (W64.of_int 192)); - return (_A, iotas); - } -}. diff --git a/proof/impl/old_perm/keccak_f1600_scalar_table.ec b/proof/impl/old_perm/keccak_f1600_scalar_table.ec deleted file mode 100644 index 02d0595..0000000 --- a/proof/impl/old_perm/keccak_f1600_scalar_table.ec +++ /dev/null @@ -1,599 +0,0 @@ -require import List Int IntExtra IntDiv CoreMap. -from Jasmin require import JModel. - -require import Array5 Array25. -require import WArray40 WArray200. - -require import Keccak_f1600_scalar. -require import Keccak_f1600_ref. -require import Keccak_f1600_ref_table. -require import Keccak_f1600_ref_loop2. -import Ops. -import Array24. - -module Mscalarrho = { - include Mscalar [-keccak_rho_offsets,rhotates,rol_sum,round2x,keccak_f] - include RhotatesAlgo - - proc rhotates (x:int, y:int) : int = { - - var r:int; - var i:int; - - i <@ index (x, y); - r <@ keccakRhoOffsets (i); - return (r); - } - - proc rol_sum (_D:W64.t Array5.t, _A:W64.t Array25.t, offset:int) : W64.t Array5.t = { - var aux: int; - - var _C:W64.t Array5.t; - var j:int; - var j1:int; - var k:int; - var t:W64.t; - _C <- witness; - j <- 0; - while (j < 5) { - j1 <- ((j + offset) %% 5); - k <@ rhotates (j, j1); - t <- _A.[((5 * (j %% 5)) + (j1 %% 5))]; - t <- (t `^` _D.[j1]); - t <@ rOL64 (t, k); - _C.[j] <- t; - j <- j + 1; - } - return (_C); - } - - - proc round2x (_A:W64.t Array25.t, _R:W64.t Array25.t, iotas:W64.t, o:int) : - W64.t Array25.t * W64.t Array25.t = { - - var iota_0:W64.t; - var _C:W64.t Array5.t; - var _D:W64.t Array5.t; - _C <- witness; - _D <- witness; - iota_0 <- (loadW64 Glob.mem (W64.to_uint (iotas + (W64.of_int o)))); - _C <@ theta_sum (_A); - _D <@ theta_rol (_C); - _C <@ rol_sum (_D, _A, 0); - _R <@ set_row (_R, 0, _C, iota_0); - _C <@ rol_sum (_D, _A, 3); - _R <@ set_row (_R, 1, _C, iota_0); - _C <@ rol_sum (_D, _A, 1); - _R <@ set_row (_R, 2, _C, iota_0); - _C <@ rol_sum (_D, _A, 4); - _R <@ set_row (_R, 3, _C, iota_0); - _C <@ rol_sum (_D, _A, 2); - _R <@ set_row (_R, 4, _C, iota_0); - return (_A, _R); - } - - proc keccak_f (_A:W64.t Array25.t, iotas:W64.t) : W64.t Array25.t * W64.t = { - - var zf:bool; - var _R:W64.t Array25.t; - var _0:bool; - var _1:bool; - var _2:bool; - var _3:bool; - _R <- witness; - (_A, _R) <@ round2x (_A, _R, iotas, 0); - (_R, _A) <@ round2x (_R, _A, iotas, 8); - iotas <- (iotas + (W64.of_int 16)); - ( _0, _1, _2, _3, zf) <- x86_TEST_8 (truncateu8 iotas) - (W8.of_int 255); - while ((! zf)) { - (_A, _R) <@ round2x (_A, _R, iotas, 0); - (_R, _A) <@ round2x (_R, _A, iotas, 8); - iotas <- (iotas + (W64.of_int 16)); - ( _0, _1, _2, _3, zf) <- x86_TEST_8 (truncateu8 iotas) - (W8.of_int 255); - } - iotas <- (iotas - (W64.of_int 192)); - return (_A, iotas); - } -}. - -equiv scalarrhom : - Mscalar.keccak_f ~ Mscalarrho.keccak_f : - ={Glob.mem,arg} ==> ={res} by sim. - -module Mscalartable = { - include Mscalar [-keccak_rho_offsets,rhotates,rol_sum,round2x,keccak_f] - include RhotatesTable - - proc rhotates (x:int, y:int) : int = { - - var r:int; - var i:int; - - i <@ index (x, y); - r <@ keccakRhoOffsets (i); - return (r); - } - - proc rol_sum (_D:W64.t Array5.t, _A:W64.t Array25.t, offset:int) : W64.t Array5.t = { - var aux: int; - - var _C:W64.t Array5.t; - var j:int; - var j1:int; - var k:int; - var t:W64.t; - _C <- witness; - j <- 0; - while (j < 5) { - j1 <- ((j + offset) %% 5); - k <@ rhotates (j, j1); - t <- _A.[((5 * (j %% 5)) + (j1 %% 5))]; - t <- (t `^` _D.[j1]); - t <@ rOL64 (t, k); - _C.[j] <- t; - j <- j + 1; - } - return (_C); - } - - - proc round2x (_A:W64.t Array25.t, _R:W64.t Array25.t, iotas:W64.t, o:int) : - W64.t Array25.t * W64.t Array25.t = { - - var iota_0:W64.t; - var _C:W64.t Array5.t; - var _D:W64.t Array5.t; - _C <- witness; - _D <- witness; - iota_0 <- (loadW64 Glob.mem (W64.to_uint (iotas + (W64.of_int o)))); - _C <@ theta_sum (_A); - _D <@ theta_rol (_C); - _C <@ rol_sum (_D, _A, 0); - _R <@ set_row (_R, 0, _C, iota_0); - _C <@ rol_sum (_D, _A, 3); - _R <@ set_row (_R, 1, _C, iota_0); - _C <@ rol_sum (_D, _A, 1); - _R <@ set_row (_R, 2, _C, iota_0); - _C <@ rol_sum (_D, _A, 4); - _R <@ set_row (_R, 3, _C, iota_0); - _C <@ rol_sum (_D, _A, 2); - _R <@ set_row (_R, 4, _C, iota_0); - return (_A, _R); - } - - proc keccak_f (_A:W64.t Array25.t, iotas:W64.t) : W64.t Array25.t * W64.t = { - - var zf:bool; - var _R:W64.t Array25.t; - var _0:bool; - var _1:bool; - var _2:bool; - var _3:bool; - _R <- witness; - (_A, _R) <@ round2x (_A, _R, iotas, 0); - (_R, _A) <@ round2x (_R, _A, iotas, 8); - iotas <- (iotas + (W64.of_int 16)); - ( _0, _1, _2, _3, zf) <- x86_TEST_8 (truncateu8 iotas) - (W8.of_int 255); - while ((! zf)) { - (_A, _R) <@ round2x (_A, _R, iotas, 0); - (_R, _A) <@ round2x (_R, _A, iotas, 8); - iotas <- (iotas + (W64.of_int 16)); - ( _0, _1, _2, _3, zf) <- x86_TEST_8 (truncateu8 iotas) - (W8.of_int 255); - } - iotas <- (iotas - (W64.of_int 192)); - return (_A, iotas); - } -}. - -equiv rol_sum : - Mscalarrho.rol_sum ~ Mscalartable.rol_sum : - ={arg} /\ 0 <= offset{1} < 5 ==> ={res}. -proc. -while (={j,_C,_A,_D,offset} /\ 0 <= j{1} <= 5 /\ 0 <= offset{1} < 5). -wp. -call (_:true); first by sim. -inline Mscalartable.rhotates Mscalarrho.rhotates. -wp. -call(rhotates_table_corr). -call (_: ={arg} /\ 0 <= x{1} < 5 /\ 0<=y{1} <5 ==> ={res} /\ 0<= res{1} <25). -proc. by auto => />;smt(). -by auto => />; smt(). -by auto => />; smt(). -qed. - - -equiv round2x : - Mscalarrho.round2x ~ Mscalartable.round2x : - ={Glob.mem,arg} ==> ={res}. -proc. -call (_:true); first by sim. -call (rol_sum). -call (_:true); first by sim. -call (rol_sum). -call (_:true); first by sim. -call (rol_sum). -call (_:true); first by sim. -call (rol_sum). -call (_:true); first by sim. -call (rol_sum). -call (_:true); first by sim. -call (_:true); first by sim. -by auto => />. -qed. - -equiv scalartable : - Mscalarrho.keccak_f ~ Mscalartable.keccak_f : - ={Glob.mem,arg} ==> ={res}. -proc. -wp. -while (={Glob.mem,zf,_A,_R,iotas}). -wp. -call (round2x). -call (round2x). -by auto => />. -wp. -call (round2x). -call (round2x). -by auto => />. -qed. - -op good_iotas (mem : global_mem_t, _iotas : int) = - forall off, 0 <= off < 24 => - loadW64 mem (_iotas + (off * 8)) = iotas.[off]. - -lemma testsem : (forall (x : W64.t), (x86_TEST_8 (truncateu8 x) (W8.of_int 255)).`5 <=> (W64.to_uint x %% 256 = 0)) by admit. - - -lemma scalarcorr _iotas mem : - equiv [ Mrefloop2.permute ~ Mscalartable.keccak_f : - 0 <= _iotas < W64.modulus - 24 * 8 /\ - good_iotas mem _iotas /\ (_iotas - 8*8) %% 256 = 0 /\ - mem = Glob.mem{2} /\ to_uint iotas{2} = _iotas /\ - state{1} = _A{2} ==> mem = Glob.mem{2} /\ to_uint res{2}.`2 = _iotas /\ - res{1} = res{2}.`1 ]. -proc. -seq 2 1 : (#pre /\ constants{1} = iotas); first by inline *;auto => />. - -seq 1 0 : (#{/~iotas{2}}pre /\ - _iotas = to_uint iotas{2} - round{1} * 8 /\ - round{1} = 0 /\ - state{1} = _A{2}); first by auto => />. - -seq 4 3: (#{/~round{1} = 0}pre /\ round{1} = 2). - -inline Mreftable.keccakP1600_round Mscalartable.round2x. - -swap {2}[5..6] -4. seq 0 2 : #pre; first by auto => />. - -swap {1} 2 -1. -swap {2} [3..5] -2. - -seq 1 3 : (#pre /\ iota_0{2} = c{1}). -inline *;wp;skip; rewrite /good_iotas /iotas; auto => />. -move => &2 bound1 bound2 Tass. -progress. -by move : (Tass 0) => //=. - -sp. -inline Mreftable.theta. -seq 7 2 : (#pre /\ a{1}=state0{1} /\ d{1} = _D{2}). -inline *;sp 3 2. -seq 2 2 : (#{/~c1{1}}{~_C1{2}}pre /\ c1{1} = _C1{2}). -do 6!(unroll for {1} ^while). -do 6!(unroll for {2} ^while). -by auto => />. - -seq 0 0 : #{/~_C{2}}pre; first by auto => />. -sp 0 3;wp. - -unroll for {1} 2. -unroll for {2} 2. -by auto => />. - -seq 8 11 : (#{/~state{1}}{~state0{1}}{~_A0{2}}{~_R0{2}}pre /\ state{1} = _R{2}). -inline *. -do 30!(unroll for {1} ^while). -do 10!(unroll for {2} ^while). - -do !((rcondt {2} ^if; first by move => *; wp;skip;auto => />) || - (rcondf {2} ^if; first by move => *; wp;skip;auto => />)). - -wp;skip. -move => &1 &2. -move => H. -simplify. -split; last first. -apply Array25.ext_eq. -move => x Hx. -case (x = 0); first by auto => />;smt( @W64). -case (x = 1); first by auto => />;smt( @W64). -case (x = 2); first by auto => />;smt( @W64). -case (x = 3); first by auto => />;smt( @W64). -case (x = 4); first by auto => />;smt( @W64). -case (x = 5); first by auto => />;smt( @W64). -case (x = 6); first by auto => />;smt( @W64). -case (x = 7); first by auto => />;smt( @W64). -case (x = 8); first by auto => />;smt( @W64). -case (x = 9); first by auto => />;smt( @W64). -case (x = 10); first by auto => />;smt( @W64). -case (x = 11); first by auto => />;smt( @W64). -case (x = 12); first by auto => />;smt( @W64). -case (x = 13); first by auto => />;smt( @W64). -case (x = 14); first by auto => />;smt( @W64). -case (x = 15); first by auto => />;smt( @W64). -case (x = 16); first by auto => />;smt( @W64). -case (x = 17); first by auto => />;smt( @W64). -case (x = 18); first by auto => />;smt( @W64). -case (x = 19); first by auto => />;smt( @W64). -case (x = 20); first by auto => />;smt( @W64). -case (x = 21); first by auto => />;smt( @W64). -case (x = 22); first by auto => />;smt( @W64). -case (x = 23); first by auto => />;smt( @W64). -case (x = 24); first by auto => />;smt( @W64). -by smt(). - -progress; [ 1 : by smt() | 2: by move : H => [/ #] | 3..: by smt() ]. - -(* Second round *) - -swap {2}[5..6] -4. seq 0 2 : #pre; first by auto => />. - -swap {1} 3 -1. -swap {2} [3..5] -2. - -seq 2 3 : (#{/~round{1}}pre /\ - round{1} = 1 /\ - (round{1} - 1) * 8 + _iotas = to_uint iotas{2} - /\ iota_00{2} = c0{1}). - -inline *;wp;skip; rewrite /good_iotas /iotas; auto => />. -move => &2 bound1 bound2 Tass. -move : (Tass 1) => //=. -rewrite (_ : to_uint (iotas{2} + (of_int 8)%W64) = to_uint iotas{2} + 8). rewrite to_uintD. smt(@W64). by trivial. - -seq 8 4 : (#pre /\ a0{1}=state{1} /\ d0{1} = _D0{2} /\ _A1{2} = a0{1}). -inline *; sp 4 4. -seq 2 2 : (#{/~c2{1}}{~_C1{2}}pre /\ c2{1} = _C1{2}). -do 6!(unroll for {1} ^while). -do 6!(unroll for {2} ^while). -by auto => />. - -sp 0 3;wp. -unroll for {1} 2. -unroll for {2} 2. -by auto => />. - -seq 8 11 : (#{/~state{1}}{~_A1{2}}pre /\ state{1} = _A{2}). -inline *. -do 30!(unroll for {1} ^while). -do 10!(unroll for {2} ^while). - -do !((rcondt {2} ^if; first by move => *; wp;skip;auto => />) || - (rcondf {2} ^if; first by move => *; wp;skip;auto => />)). - -wp;skip. -move => &1 &2. -move => H. -simplify. -split; last first. -apply Array25.ext_eq. -move => x Hx. -case (x = 0); first by auto => />;smt( @W64). -case (x = 1); first by auto => />;smt( @W64). -case (x = 2); first by auto => />;smt( @W64). -case (x = 3); first by auto => />;smt( @W64). -case (x = 4); first by auto => />;smt( @W64). -case (x = 5); first by auto => />;smt( @W64). -case (x = 6); first by auto => />;smt( @W64). -case (x = 7); first by auto => />;smt( @W64). -case (x = 8); first by auto => />;smt( @W64). -case (x = 9); first by auto => />;smt( @W64). -case (x = 10); first by auto => />;smt( @W64). -case (x = 11); first by auto => />;smt( @W64). -case (x = 12); first by auto => />;smt( @W64). -case (x = 13); first by auto => />;smt( @W64). -case (x = 14); first by auto => />;smt( @W64). -case (x = 15); first by auto => />;smt( @W64). -case (x = 16); first by auto => />;smt( @W64). -case (x = 17); first by auto => />;smt( @W64). -case (x = 18); first by auto => />;smt( @W64). -case (x = 19); first by auto => />;smt( @W64). -case (x = 20); first by auto => />;smt( @W64). -case (x = 21); first by auto => />;smt( @W64). -case (x = 22); first by auto => />;smt( @W64). -case (x = 23); first by auto => />;smt( @W64). -case (x = 24); first by auto => />;smt( @W64). -by smt(). - -progress; [ 1 : by smt() | 2: by move : H => [/ #] | 3..: by smt() ]. - -auto => />. -progress. -rewrite to_uintD. -by smt(@W64). - -(* Main loop *) - -seq 0 1 : (#{/~round{1} = 2}pre /\ 0 < round{1} <= 24 /\ round{1} %% 2 = 0 /\ - zf{2} = (x86_TEST_8 (truncateu8 iotas{2}) ((of_int 255))%W8).`5); first by auto => />. -wp. -while (#pre). -wp. - -inline Mreftable.keccakP1600_round Mscalartable.round2x. - -swap {2}[5..6] -4. seq 0 2 : #pre; first by auto => />. - -swap {1} 2 -1. -swap {2} [3..5] -2. - -seq 1 3 : (#pre /\ iota_0{2} = c{1}). -inline *;wp;skip; rewrite /good_iotas /iotas; auto => />. -move => &1 &2 bound1 bound2 Tass. -progress. -move : (Tass round{1}) => //=. -rewrite (_: to_uint iotas{2} - round{1} * 8 + round{1} * 8 = to_uint iotas{2}); first by ring. -smt(). - -inline Mreftable.theta. -seq 8 4 : (#pre /\ a{1}=state{1} /\ d{1} = _D{2} /\ _A0{2} = _A{2}). -inline *; sp 4 4. -seq 2 2 : (#{/~c1{1}}{~_C1{2}}pre /\ c1{1} = _C1{2}). -do 6!(unroll for {1} ^while). -do 6!(unroll for {2} ^while). -by auto => />. - -seq 0 0 : #{/~_C{2}}pre; first by auto => />. -sp 0 3;wp. -unroll for {1} 2. -unroll for {2} 2. -by auto => />. -seq 8 11 : (#{/~state{1}}{~state0{1}}{~_A0{2}}{~_R0{2}}pre /\ state{1} = _R{2}). -inline *. -do 30!(unroll for {1} ^while). -do 10!(unroll for {2} ^while). - -do !((rcondt {2} ^if; first by move => *; wp;skip;auto => />) || - (rcondf {2} ^if; first by move => *; wp;skip;auto => />)). -wp;skip. -move => &1 &2. -move => H. -simplify. -split; last first. -apply Array25.ext_eq. -move => x Hx. -case (x = 0); first by auto => />;smt( @W64). -case (x = 1); first by auto => />;smt( @W64). -case (x = 2); first by auto => />;smt( @W64). -case (x = 3); first by auto => />;smt( @W64). -case (x = 4); first by auto => />;smt( @W64). -case (x = 5); first by auto => />;smt( @W64). -case (x = 6); first by auto => />;smt( @W64). -case (x = 7); first by auto => />;smt( @W64). -case (x = 8); first by auto => />;smt( @W64). -case (x = 9); first by auto => />;smt( @W64). -case (x = 10); first by auto => />;smt( @W64). -case (x = 11); first by auto => />;smt( @W64). -case (x = 12); first by auto => />;smt( @W64). -case (x = 13); first by auto => />;smt( @W64). -case (x = 14); first by auto => />;smt( @W64). -case (x = 15); first by auto => />;smt( @W64). -case (x = 16); first by auto => />;smt( @W64). -case (x = 17); first by auto => />;smt( @W64). -case (x = 18); first by auto => />;smt( @W64). -case (x = 19); first by auto => />;smt( @W64). -case (x = 20); first by auto => />;smt( @W64). -case (x = 21); first by auto => />;smt( @W64). -case (x = 22); first by auto => />;smt( @W64). -case (x = 23); first by auto => />;smt( @W64). -case (x = 24); first by auto => />;smt( @W64). -by smt(). - -progress; [ 1 : by smt() | 2: by move : H => [/ #] | 3..: by smt() ]. - -(* Second round *) - -swap {2}[5..6] -4. seq 0 2 : #pre; first by auto => />. -swap {1} 2 -1. -swap {2} [3..5] -2. - -seq 1 3 : (#pre /\ iota_00{2} = c0{1}). -inline *;wp;skip; rewrite /good_iotas /iotas; auto => />. -move => &1 &2 bound1 bound2 Tass. -progress. -move : (Tass (round{1} + 1)) => //=. -rewrite (_: to_uint iotas{2} - round{1} * 8 + (round{1} + 1) * 8 = to_uint (iotas{2} + (of_int 8)%W64)). -rewrite to_uintD. -have bb : (to_uint iotas{2} + to_uint ((of_int 8))%W64 < W64.modulus). -smt(). -smt(@W64). -smt(). - -seq 8 4 : (#pre /\ a0{1}=state{1} /\ d0{1} = _D0{2} /\ _A1{2} = a0{1}). -inline *;sp 4 4. -seq 2 2 : (#{/~c2{1}}{~_C1{2}}pre /\ c2{1} = _C1{2}). -do 6!(unroll for {1} ^while). -do 6!(unroll for {2} ^while). -by auto => />. - -sp 0 3;wp. -unroll for {1} 2. -unroll for {2} 2. -by auto => />. - -seq 8 11 : (#{/~state{1}}{~_A1{2}}pre /\ state{1} = _A{2}). -inline *. -do 30!(unroll for {1} ^while). -do 10!(unroll for {2} ^while). - -do !((rcondt {2} ^if; first by move => *; wp;skip;auto => />) || - (rcondf {2} ^if; first by move => *; wp;skip;auto => />)). -wp;skip. -move => &1 &2. -move => H. -simplify. -split; last first. -apply Array25.ext_eq. -move => x Hx. -case (x = 0); first by auto => />;smt( @W64). -case (x = 1); first by auto => />;smt( @W64). -case (x = 2); first by auto => />;smt( @W64). -case (x = 3); first by auto => />;smt( @W64). -case (x = 4); first by auto => />;smt( @W64). -case (x = 5); first by auto => />;smt( @W64). -case (x = 6); first by auto => />;smt( @W64). -case (x = 7); first by auto => />;smt( @W64). -case (x = 8); first by auto => />;smt( @W64). -case (x = 9); first by auto => />;smt( @W64). -case (x = 10); first by auto => />;smt( @W64). -case (x = 11); first by auto => />;smt( @W64). -case (x = 12); first by auto => />;smt( @W64). -case (x = 13); first by auto => />;smt( @W64). -case (x = 14); first by auto => />;smt( @W64). -case (x = 15); first by auto => />;smt( @W64). -case (x = 16); first by auto => />;smt( @W64). -case (x = 17); first by auto => />;smt( @W64). -case (x = 18); first by auto => />;smt( @W64). -case (x = 19); first by auto => />;smt( @W64). -case (x = 20); first by auto => />;smt( @W64). -case (x = 21); first by auto => />;smt( @W64). -case (x = 22); first by auto => />;smt( @W64). -case (x = 23); first by auto => />;smt( @W64). -case (x = 24); first by auto => />;smt( @W64). -by smt(). - -progress; [ 1 : by smt() | 2: by move : H => [/ #] | 3..: by smt() ]. - -auto => />. - -progress. -rewrite to_uintD;smt(). -smt(). smt(). smt(). -rewrite (testsem (iotas{2} + (of_int 16)%W64)). -rewrite to_uintD. -rewrite (_ : (to_uint iotas{2} + to_uint ((of_int 16))%W64) %% W64.modulus %% 256 = (to_uint iotas{2} + to_uint ((of_int 16))%W64) %% 256). smt. smt(). - -move : H8. -rewrite testsem. -rewrite to_uintD. -rewrite (_ : (to_uint iotas{2} + to_uint ((of_int 16))%W64) %% W64.modulus %% 256 = (to_uint iotas{2} + to_uint ((of_int 16))%W64) %% 256). smt. smt(). - -auto => />. -progress. -rewrite (testsem (iotas{2}));smt(). -move : H6. -rewrite testsem;smt(). - -move : H12. -rewrite testsem => //= *. -move : H8; rewrite (_ : round_L = 24); first by smt(). -move => *. -have ir : (to_uint iotas{2} - round{1} * 8 + 24*8) %% 256 = 0. smt(). -rewrite (_ : iotas_R = W64.of_int (to_uint iotas{2} - round{1} * 8 + 24*8)). -smt(@W64). -smt(@W64 @W8). -qed. From 247a0c352785d2cf03f2f48f1e63b41e096694cb Mon Sep 17 00:00:00 2001 From: Manuel Barbosa Date: Thu, 16 May 2019 12:22:11 +0100 Subject: [PATCH 421/525] Cleaning up --- proof/impl/Spec.ec | 693 ---------------------------------------- proof/impl/keccak.ec | 743 ------------------------------------------- 2 files changed, 1436 deletions(-) delete mode 100644 proof/impl/Spec.ec delete mode 100644 proof/impl/keccak.ec diff --git a/proof/impl/Spec.ec b/proof/impl/Spec.ec deleted file mode 100644 index de9db79..0000000 --- a/proof/impl/Spec.ec +++ /dev/null @@ -1,693 +0,0 @@ -require import AllCore List Int IntDiv. -from Jasmin require import JArray JMemory JModel JUtils JWord JWord_array. -require Sponge. - -clone import Sponge as Spnge. -import Common. -import Block. -import Capacity. - -clone export PolyArray as Array25 with op size <- 25. - -op domain_bits : bool list. - -(* domain bits are used to distinguish usages of the Sponge in standard *) -axiom domain_bits_len : size domain_bits = 2. - -op suffix_bits : bool list. - -(* additional suffix bits are allowed for construction usage *) -axiom suffix_bits_len : size suffix_bits < 3. - -type state = W64.t Array25.t. - -(* True for all state sizes we will consider *) -axiom wstate_size (x : state) : - size (flatten (map W64.w2bits (Array25.to_list x))) = (r + c). -axiom rsize : r %% 64 = 0. - -lemma wstate_size_val: r+c = 1600. -move : (wstate_size (Array25.of_list witness (mkseq (fun (i : int) => (of_list W64.zero []).[i]) 25))). -rewrite of_listK. apply size_mkseq. -rewrite /flatten. -rewrite (_: (mkseq (fun (i0 : int) => (of_list W64.zero []).[i0]) 25) = - (W64.zero :: W64.zero :: W64.zero :: W64.zero :: W64.zero :: - W64.zero :: W64.zero :: W64.zero :: W64.zero :: W64.zero :: - W64.zero :: W64.zero :: W64.zero :: W64.zero :: W64.zero :: - W64.zero :: W64.zero :: W64.zero :: W64.zero :: W64.zero :: - W64.zero :: W64.zero :: W64.zero :: W64.zero :: W64.zero :: [])). -by auto => />. -rewrite (_: - (foldr (++) [] - (map W64.w2bits - [W64.zero; W64.zero; W64.zero; W64.zero; W64.zero; W64.zero; - W64.zero; W64.zero; W64.zero; W64.zero; W64.zero; W64.zero; - W64.zero; W64.zero; W64.zero; W64.zero; W64.zero; W64.zero; - W64.zero; W64.zero; W64.zero; W64.zero; W64.zero; W64.zero; - W64.zero])) = - (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ - (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ - (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ - (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ - (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero)). -by auto => />. -simplify. smt(). -qed. - -op memr2bits( mem : global_mem_t, ptr : int, len : int) = - flatten (map (fun o => W8.w2bits (mem.[ptr + o])) (iota_ 0 len)). - -op eqmem_except(mem1 : global_mem_t, mem2 : global_mem_t, ptr : int, o : int) = - forall ad, !(ptr <= ad < ptr + o) => mem1.[ad] = mem2.[ad]. - -op state2bc(st : state) : block * capacity = - let stbits = flatten (map W64.w2bits (to_list st)) - in (mkblock (take r stbits), mkcapacity (drop r stbits)). - -module type PermT = { - proc perm(st : state) : state -}. - -type wblock = W64.t list. - -op pad1byte = domain_bits ++ suffix_bits ++ [true] ++ nseq (8 - (size domain_bits) - (size suffix_bits) - 2) false ++ [true]. -op padqstart = domain_bits ++ suffix_bits ++ [true] ++ nseq (8 - (size domain_bits) - (size suffix_bits) - 1) false. -op padq0 = nseq 8 false. -op padqend = nseq 7 false ++ [true]. -op padbytes(q : int) = - if q = 1 - then [ pad1byte ] - else [ padqstart ] ++ nseq (q-2) padq0 ++ [padqend ]. - -op bytewisepad(s) = - let q = (r %/ 8) - (((size s) %/ 8) %% (r %/ 8)) - in s ++ flatten (padbytes q). - -op loadpad2wblocks(mem : global_mem_t, ptr : int, len : int) = - let msgbits = bytewisepad (memr2bits mem ptr len) - in map (fun b => map W64.bits2w (BitEncoding.BitChunking.chunk 64 (ofblock b))) - (bits2blocks (msgbits)). - -lemma bound_conv (s : bool list) q : - size s %% 8 = 0 => - r %/ 8 - size s %/ 8 %% (r %/ 8) = q => - (size s + q*8) %% r = 0. -move=> *. -have rr : r - 8*(size s %/ 8 %% (r %/ 8)) = 8*q. -+ by rewrite {1}(andWl _ _ (edivzP r 8)) (:r %% 8 = 0) 1:[smt(rsize)] /#. -move : rr. -rewrite (mulz_modr 8) 1:/#. -rewrite (: 8 * (size s %/ 8) %% (8 * (r %/ 8)) = size s %% r). -+ by rewrite 2!(mulzC 8) 2!divzE H /= (: r %% 8 = 0) 1:[smt(rsize)]. -rewrite (: size s + q * 8 = q * 8 + size s) 1:/#. -rewrite -modzDmr. -move => *. -rewrite (_: size s %% r = r - 8 * q ) 1:/#. -by rewrite (: q * 8 + (r - 8 * q) = r) 1:/# modzz. -qed. - -lemma nseq_cat n1 n2 : - nseq n1 false ++ nseq n2 false = nseq (max 0 n1 + max 0 n2) false. -admitted. - -lemma nseq_comp n1 n2 : - flatten (nseq n1 (nseq n2 false)) = nseq (max 0 n1 * max 0 n2) false. -admitted. - -lemma samepad s : - size s %% 8 = 0 => - bytewisepad s = pad (s ++ domain_bits ++ suffix_bits). -move => *. -rewrite /bytewisepad /padbytes /pad /mkpad /num0. -progress. -case (r %/ 8 - size s %/ 8 %% (r %/ 8) = 1). -move => *. -rewrite /pad1byte. -rewrite flatten_seq1. -rewrite -catA -catA -catA -catA -catA. -apply eqseq_cat. by trivial. simplify. -rewrite -catA. -apply eqseq_cat. by trivial. simplify. -apply eqseq_cat. by trivial. simplify. -move : (bound_conv s 1 H H0) => *. -rewrite (_: 8 - size domain_bits - size suffix_bits - 2 = (- (size (s ++ domain_bits ++ suffix_bits) + 2)) %% r). -rewrite !size_cat. -rewrite domain_bits_len. -case (size suffix_bits = 0). -move => suffix_bits_len. -rewrite suffix_bits_len. -simplify. -rewrite modNz. smt(size_ge0). exact/Block.gt0_n. -simplify. ring. -rewrite (_: size s + 3 = (size s + 1*8) - 5 ). smt(). -rewrite -modzDm. rewrite H1. simplify. -rewrite modz_mod modNz. smt(). exact/Block.gt0_n. -rewrite modz_small. smt(Block.gt0_n rsize). by ring. -move => *. -case (size suffix_bits = 1). -move => suffix_bits_len. -rewrite suffix_bits_len. -simplify. -rewrite modNz. smt(size_ge0). smt(Block.gt0_n). -simplify. ring. -rewrite (_: size s + 4 = (size s + 1*8) - 4 ). smt(). -rewrite -modzDm. rewrite H1. simplify. -rewrite modz_mod modNz. smt(). smt(Block.gt0_n). -rewrite modz_small. smt(Block.gt0_n rsize). by ring. -move => *. -rewrite (_: size suffix_bits = 2). smt(size_ge0 suffix_bits_len). -simplify. -rewrite modNz. smt(size_ge0). smt(Block.gt0_n). -simplify. ring. -rewrite (_: size s + 5 = (size s + 1*8) - 3 ). smt(). -rewrite -modzDm. rewrite H1. simplify. -rewrite modz_mod modNz. smt(). smt(Block.gt0_n). -rewrite modz_small. smt(Block.gt0_n rsize). by ring. -by rewrite cats1 catA. -move => *. -rewrite /padqstart /padqend. -pose q := r %/ 8 - size s %/ 8 %% (r %/ 8). -rewrite flatten_cons. -rewrite -catA -catA -catA -catA -catA. -rewrite (eqseq_cat). by trivial. simplify. -rewrite (eqseq_cat). by trivial. simplify. -rewrite (eqseq_cat). by trivial. simplify. -rewrite (_: flatten (nseq (q - 2) padq0 ++ - [[false; false; false; false; false; false; false; true]]) = - rcons (nseq (8*(q-2) + 7) false) true). -rewrite flatten_cat flatten_seq1. -rewrite -cats1. -have padlength_ge0: 0 <= 8 * (q - 2). -+ smt(gt0_r rsize). -rewrite (_ : 8 * (q - 2) + 7 = 8 * (q - 2) + 6 + 1); first by smt(). -rewrite nseqSr. smt(). -rewrite cat_rcons. -rewrite (_ : 8 * (q - 2) + 6 = 8 * (q - 2) + 5 + 1); first by smt(). -rewrite nseqSr. smt(). -rewrite cat_rcons. -rewrite (_ : 8 * (q - 2) + 5 = 8 * (q - 2) + 4 + 1); first by smt(). -rewrite nseqSr. smt(). -rewrite cat_rcons. -rewrite (_ : 8 * (q - 2) + 4 = 8 * (q - 2) + 3 + 1); first by smt(). -rewrite nseqSr. smt(). -rewrite cat_rcons. -rewrite (_ : 8 * (q - 2) + 3 = 8 * (q - 2) + 2 + 1); first by smt(). -rewrite nseqSr. smt(). -rewrite cat_rcons. -rewrite (_ : 8 * (q - 2) + 2 = 8 * (q - 2) + 1 + 1); first by smt(). -rewrite nseqSr. smt(). -rewrite cat_rcons. -rewrite nseqSr. smt(). -rewrite cat_rcons. -rewrite /padq0. -rewrite nseq_comp. smt(). -rewrite (_ : nseq (8 - size domain_bits - size suffix_bits - 1) false ++ -rcons (nseq (8 * (q - 2) + 7) false) true = - rcons (nseq (8 - size domain_bits - size suffix_bits - 1 + 8 * (q - 2) + 7) false) true). rewrite -rcons_cat. -rewrite nseq_cat max_ler 1:[smt(domain_bits_len suffix_bits_len)] max_ler 1:[smt(gt0_r rsize)]. -rewrite (_ : 8 - size domain_bits - size suffix_bits - 1 + (8 * (q - 2) + 7) = 8 - size domain_bits - size suffix_bits - 1 + 8 * (q - 2) + 7). by ring. -by trivial. -rewrite (_: 8 - size domain_bits - size suffix_bits - 1 + 8 * (q - 2) + 7= (- (size (s ++ domain_bits ++ suffix_bits) + 2)) %% r). -rewrite !size_cat. -rewrite domain_bits_len. -have qval : (r %/ 8 - size s %/ 8 %% (r %/ 8) = q). smt(). -move : (bound_conv s q H qval) => *. -have qlbound : 1 <= q. smt(gt0_r rsize). -have qubound : q * 8 <= r. smt(gt0_r rsize). -case (size suffix_bits = 0). -move => suffix_bits_len. -rewrite suffix_bits_len. -simplify. -ring. -rewrite modNz. smt(size_ge0). smt(gt0_r). -simplify. ring. -move : (dvdzP (r)(size s + q * 8)) => [ ] *. -move : (H2 H1). -progress. -rewrite (_: size s = q0*r - q*8). smt(). -rewrite (_ : (q0 * r - q * 8 + 3) %% r = (-(q*8 - 3)) %% r). -rewrite (_ : (q0 * r - q * 8 + 3) %% r = (q0 * r + (- q * 8 + 3)) %% r). -smt(). -rewrite (modzMDl). smt(). -have same : (- ( q * 8 - 3)) %% r = r - (q*8 - 3). -rewrite (modNz (q * 8 - 3) r). smt(gt0_r rsize). smt(gt0_r). -ring. -rewrite modz_small. smt(). smt(gt0_r rsize). -smt(gt0_r rsize). -move => *. -case (size suffix_bits = 1). -move => suffix_bits_len. -rewrite suffix_bits_len. -simplify. -ring. -rewrite modNz. smt(size_ge0). smt(gt0_r). -simplify. ring. -move : (dvdzP (r)(size s + q * 8)) => [ ] *. -move : (H3 H1). -progress. -rewrite (_: size s = q0*r - q*8). smt(). -rewrite (_ : (q0 * r - q * 8 + 4) %% r = (-(q*8 - 4)) %% r). -rewrite (_ : (q0 * r - q * 8 + 4) %% r = (q0 * r + (- q * 8 + 4)) %% r). -smt(). -rewrite (modzMDl). smt(). -have same : (- ( q * 8 - 4)) %% r = r - (q*8 - 4). -rewrite (modNz (q * 8 - 4) r). smt(gt0_r rsize). smt(gt0_r). -ring. -rewrite modz_small. smt(). smt(gt0_r rsize). -smt(gt0_r rsize). -move => *. -rewrite (_ : size suffix_bits = 2). smt(size_ge0 suffix_bits_len). -simplify. -ring. -rewrite modNz. smt(size_ge0). smt(gt0_r). -simplify. ring. -move : (dvdzP (r)(size s + q * 8)) => [ ] *. -move : (H4 H1). -progress. -rewrite (_: size s = q0*r - q*8). smt(). -rewrite (_ : (q0 * r - q * 8 + 5) %% r = (-(q*8 - 5)) %% r). -rewrite (_ : (q0 * r - q * 8 + 5) %% r = (q0 * r + (- q * 8 + 5)) %% r). -smt(). -rewrite (modzMDl). smt(). -have same : (- ( q * 8 - 5)) %% r = r - (q*8 - 5). -rewrite (modNz (q * 8 - 5) r). smt(gt0_r rsize). smt(gt0_r). -ring. -rewrite modz_small. smt(). smt(gt0_r rsize). -smt(gt0_r rsize). -by trivial. -qed. - -lemma sizepload mem inp inl: (size (memr2bits mem inp inl) = 8 * (max 0 inl)). -rewrite /memr2bits. -simplify. -rewrite size_flatten. -auto => />. -rewrite /sumz. -rewrite -map_comp /(\o) => //=. -rewrite foldr_map. -rewrite (_ : 8*(max 0 inl) = 8* (size (iota_ 0 inl))). rewrite size_iota. by trivial. -elim (iota_ 0 inl). smt. smt. -qed. - -lemma blocksizes mem inp inl b: - b \in (loadpad2wblocks mem inp inl) => size b = r %/ 64. -rewrite /loadpad2wblocks samepad. smt. -simplify. -rewrite /bits2blocks. -have sizebs : forall b0, - b0 \in (map mkblock - (chunk (pad (memr2bits mem inp inl ++ domain_bits ++ suffix_bits)))) => - size (ofblock b0) = r. -move => b0 H. -apply (size_block b0). -have sizecs : forall b0, - b0 \in (map mkblock - (chunk (pad (memr2bits mem inp inl ++ domain_bits ++ suffix_bits)))) => - size ((BitEncoding.BitChunking.chunk 64 (ofblock b0))) = r %/ 64. -smt. -move => H. -move : (mapP - (fun (b0 : block) => - map W64.bits2w (BitEncoding.BitChunking.chunk 64 (ofblock b0))) - ((map mkblock - (chunk - (pad (memr2bits mem inp inl ++ domain_bits ++ suffix_bits))))) b). -smt. -qed. - -(* Stores up to len bytes in memory from list of blocks *) -op storeblocks : global_mem_t -> int -> int -> wblock list -> global_mem_t. - -op state0 : state = Array25.of_list (W64.of_int 0) []. - -op squeezeb(st : state) = take (r %/ 64) (to_list st). - -op wblock0 : wblock = take (r %/ 64) (to_list state0). - -op combine(st : state, wb : wblock) : state = - let stl = to_list st in - let wbst = take (r %/ 64) stl in - let wbstc = map (fun x : W64.t * W64.t => x.`1 `^` x.`2) (zip wbst wb) in - Array25.of_list (W64.of_int 0) (wbstc ++ (drop (r %/ 64) stl)). - -op convb(outl : int) = (outl*8 + r - 1) %/ r. - -module Spec(P : PermT) = { - proc f(out : int, outlen : int, inp : int, inlen : int) = { - var z,st,i,xs; - z <- []; - st <- state0; - i <- 0; - xs <- loadpad2wblocks Glob.mem inp inlen; - while (xs <> []){ - st <@ P.perm(combine st (head wblock0 xs)); - xs <- behead xs; - } - while (i < convb outlen){ - z <- z ++ [squeezeb st]; - i <- i + 1; - if (i < convb outlen) - st <@ P.perm(st); - } - - Glob.mem <- storeblocks Glob.mem out outlen z; - } -}. - -section. - -declare module Pideal : DPRIMITIVE. -declare module Preal : PermT {Glob}. (* Note it cannot touch memory *) - -axiom perm_correct : - equiv [Pideal.f ~ Preal.perm : - x{1} = state2bc st{2} ==> - res{1} = state2bc res{2}]. - -op wblock2block(wb : wblock) : block = - mkblock (flatten (map W64.w2bits wb)). - -op wblocks2bits(wbs : wblock list) : bool list = - flatten (List.map (fun bl => ofblock (wblock2block bl)) wbs). - -op wblock2bits_list(wbs : wblock list) : block list = - map wblock2block wbs. - -lemma wblocks2bits_empty : [] = wblocks2bits [] by auto => />. - -lemma state0conv : (b0, c0) = state2bc state0. -rewrite /state2bc /b0 /c0 /offun. -rewrite (_: flatten (map W64.w2bits (to_list state0)) = (mkseq (fun _ => false) (r+c))). -rewrite /state0 /to_list wstate_size_val. -apply (eq_from_nth witness). -rewrite size_mkseq. -move : (wstate_size (Array25.of_list witness (mkseq (fun (i : int) => (of_list W64.zero []).[i]) 25))). -rewrite of_listK. apply size_mkseq. -move => *. rewrite H. -rewrite wstate_size_val. smt(). -rewrite (_ : size - (flatten - (map W64.w2bits - (mkseq (fun (i0 : int) => (of_list W64.zero []).[i0]) 25))) = 1600). -move : (wstate_size (Array25.of_list witness (mkseq (fun (i : int) => (of_list W64.zero []).[i]) 25))). -rewrite of_listK. apply size_mkseq. -rewrite wstate_size_val. smt(). -move => *. -rewrite (_: nth witness (mkseq (fun _ => false) (1600)) i = false). -rewrite nth_mkseq. smt(). smt(). -rewrite (_: (mkseq (fun (i0 : int) => (of_list W64.zero []).[i0]) 25) = - (W64.zero :: W64.zero :: W64.zero :: W64.zero :: W64.zero :: - W64.zero :: W64.zero :: W64.zero :: W64.zero :: W64.zero :: - W64.zero :: W64.zero :: W64.zero :: W64.zero :: W64.zero :: - W64.zero :: W64.zero :: W64.zero :: W64.zero :: W64.zero :: - W64.zero :: W64.zero :: W64.zero :: W64.zero :: W64.zero :: [])). -by auto => />. -rewrite (_: - (foldr (fun (bl : W64.t) (bs : bool list) => w2bits bl ++ bs) [] - [W64.zero; W64.zero; W64.zero; W64.zero; W64.zero; W64.zero; W64.zero; - W64.zero; W64.zero; W64.zero; W64.zero; W64.zero; W64.zero; W64.zero; - W64.zero; W64.zero; W64.zero; W64.zero; W64.zero; W64.zero; W64.zero; - W64.zero; W64.zero; W64.zero; W64.zero]) = - (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ - (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ - (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ - (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ - (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero)). -by auto => />. -rewrite /w2bits. -rewrite -mkseq_add. smt(). smt(). -rewrite -mkseq_add. smt(). smt(). -rewrite -mkseq_add. smt(). smt(). -rewrite -mkseq_add. smt(). smt(). -rewrite -mkseq_add. smt(). smt(). -rewrite -mkseq_add. smt(). smt(). -rewrite -mkseq_add. smt(). smt(). -rewrite -mkseq_add. smt(). smt(). -rewrite -mkseq_add. smt(). smt(). -rewrite -mkseq_add. smt(). smt(). -rewrite -mkseq_add. smt(). smt(). -rewrite -mkseq_add. smt(). smt(). -rewrite -mkseq_add. smt(). smt(). -rewrite -mkseq_add. smt(). smt(). -rewrite -mkseq_add. smt(). smt(). -rewrite -mkseq_add. smt(). smt(). -rewrite -mkseq_add. smt(). smt(). -rewrite -mkseq_add. smt(). smt(). -rewrite -mkseq_add. smt(). smt(). -rewrite -mkseq_add. smt(). smt(). -rewrite -mkseq_add. smt(). smt(). -rewrite -mkseq_add. smt(). smt(). -rewrite -mkseq_add. smt(). smt(). -rewrite -mkseq_add. smt(). smt(). -simplify. -rewrite nth_mkseq. -smt(). smt(). -rewrite mkseq_add. smt. smt. -pose stbits := mkseq (fun _ => false) r ++ - mkseq (fun (i : int) => (fun _ => false) (r + i)) c. -simplify. -split. -rewrite (_:take r stbits = mkseq (fun _ => false) r). -rewrite take_cat. -rewrite size_mkseq. -rewrite (_ : r < max 0 r = false); first by smt. -simplify. -rewrite (_ : r - max 0 r = 0); first by smt. -rewrite take0 cats0. -by trivial. -by trivial. -rewrite drop_cat. -rewrite size_mkseq. -rewrite (_ : r < max 0 r = false); first by smt. -simplify. -rewrite (_ : r - max 0 r = 0); first by smt. -rewrite drop0. -by trivial. -qed. - -lemma paddings_same mem inp inl: - pad (memr2bits mem inp inl ++ domain_bits ++ suffix_bits) = - wblocks2bits (loadpad2wblocks mem inp inl). -rewrite /loadpad2wblocks samepad. smt. -rewrite /wblocks2bits. -pose ll := pad (memr2bits mem inp inl ++ domain_bits ++ suffix_bits). -simplify. -rewrite /wblock2block -map_comp -map_comp /(\o) => //=. -have sizell : size ll %% 64 = 0. smt. -have sizebs : forall x, x \in chunk ll => size x = r. smt. -have sizebs1 : forall x, x \in chunk ll => forall y, y \in (BitEncoding.BitChunking.chunk 64 x) => size y = 64. smt. -have xx : (forall x, x \in chunk ll => (flatten - (map W64.w2bits - (map W64.bits2w - ((BitEncoding.BitChunking.chunk 64 (ofblock (mkblock x))))))) = x). -move => *. rewrite ofblockK. smt. -rewrite -map_comp. -rewrite (_: map (W64.w2bits \o W64.bits2w) (BitEncoding.BitChunking.chunk 64 x) = BitEncoding.BitChunking.chunk 64 x). rewrite /(\o). -have xxx : forall x0, x0 \in ((BitEncoding.BitChunking.chunk 64 x)) => w2bits ((bits2w x0))%W64 = x0. -move : (sizebs1 x H) => *. -move => *. -move : (sizebs1 x H x0 H1). move => *. -apply (W64.bits2wK) => //=. -rewrite {2} (_ : (BitEncoding.BitChunking.chunk 64 x) = map (fun x => x) (BitEncoding.BitChunking.chunk 64 x)). rewrite (id_map). smt(). by trivial. -move : (eq_in_map ((fun (x0 : bool list) => w2bits ((bits2w x0))%W64)) (fun x => x) (BitEncoding.BitChunking.chunk 64 x)) => [/ # [ ]] *. -move : (H0 xxx). smt(). -apply (BitEncoding.BitChunking.chunkK 64 _ _ _). smt(). smt. -have : (forall (x : bool list), - x \in chunk ll => - (fun (x0 : bool list) => - ofblock - (mkblock - (flatten - (map W64.w2bits - (map W64.bits2w - ((BitEncoding.BitChunking.chunk 64 (ofblock (mkblock x0))))))))) x = x). -progress. -move : (xx x H) => *. -rewrite H0. apply ofblockK. smt. -move => *. -rewrite (_ : (map - (fun (x : bool list) => - ofblock - (mkblock - (flatten - (map W64.w2bits - (map W64.bits2w - ((BitEncoding.BitChunking.chunk 64 (ofblock (mkblock x))))))))) - (chunk ll)) = chunk ll). -rewrite {2} (_: chunk ll = map (fun x => x) (chunk ll)). rewrite (id_map). smt(). by trivial. -move : (eq_in_map ((fun (x0 : bool list) => - ofblock - (mkblock - (flatten - (map W64.w2bits - (map W64.bits2w - ((BitEncoding.BitChunking.chunk 64 (ofblock (mkblock x0)))))))))) - (fun x0 => x0) (chunk ll)) => [/ # [ ]] *. -move : (H0 H). smt(). -rewrite chunkK. smt. -by trivial. -qed. - -lemma liftpadding mem inp inl : - pad2blocks (memr2bits mem inp inl ++ domain_bits ++ suffix_bits) = - wblock2bits_list (loadpad2wblocks mem inp inl). -rewrite /pad2blocks /(\o) paddings_same /wblocks2bits => //=. -rewrite /bits2blocks. -rewrite flattenK. -move => b. -rewrite /loadpad2wblocks samepad. smt. -simplify. -pose ll := pad (memr2bits mem inp inl ++ domain_bits ++ suffix_bits). -rewrite /wblock2block -map_comp -map_comp /(\o) => //=. -have sizell : size ll %% 64 = 0. smt. -have sizebs : forall x, x \in chunk ll => size x = r. smt. - -have sizebs1 : forall x, x \in chunk ll => forall y, y \in (BitEncoding.BitChunking.chunk 64 x) => size y = 64. smt. -have xx : (forall x, x \in chunk ll => (flatten - (map W64.w2bits - (map W64.bits2w - ((BitEncoding.BitChunking.chunk 64 (ofblock (mkblock x))))))) = x). -move => *. rewrite ofblockK. smt. -rewrite -map_comp. -rewrite (_: map (W64.w2bits \o W64.bits2w) (BitEncoding.BitChunking.chunk 64 x) = BitEncoding.BitChunking.chunk 64 x). rewrite /(\o). -have xxx : forall x0, x0 \in ((BitEncoding.BitChunking.chunk 64 x)) => w2bits ((bits2w x0))%W64 = x0. -move : (sizebs1 x H) => *. -move => *. -move : (sizebs1 x H x0 H1). move => *. -apply (W64.bits2wK) => //=. -rewrite {2} (_ : (BitEncoding.BitChunking.chunk 64 x) = map (fun x => x) (BitEncoding.BitChunking.chunk 64 x)). rewrite (id_map). smt(). by trivial. -move : (eq_in_map ((fun (x0 : bool list) => w2bits ((bits2w x0))%W64)) (fun x => x) (BitEncoding.BitChunking.chunk 64 x)) => [/ # [ ]] *. -move : (H0 xxx). smt(). -apply (BitEncoding.BitChunking.chunkK 64 _ _ _). smt(). smt. -have : (forall (x : bool list), - x \in chunk ll => - (fun (x0 : bool list) => - ofblock - (mkblock - (flatten - (map W64.w2bits - (map W64.bits2w - ((BitEncoding.BitChunking.chunk 64 (ofblock (mkblock x0))))))))) x = x). -progress. -move : (xx x H) => *. -rewrite H0. apply ofblockK. smt. -move => H. -rewrite (_ : (map - (fun (x : bool list) => - ofblock - (mkblock - (flatten - (map W64.w2bits - (map W64.bits2w - ((BitEncoding.BitChunking.chunk 64 (ofblock (mkblock x))))))))) - (chunk ll)) = chunk ll). -rewrite {2} (_: chunk ll = map (fun x => x) (chunk ll)). rewrite (id_map). smt(). by trivial. -move : (eq_in_map ((fun (x0 : bool list) => - ofblock - (mkblock - (flatten - (map W64.w2bits - (map W64.bits2w - ((BitEncoding.BitChunking.chunk 64 (ofblock (mkblock x0)))))))))) - (fun x0 => x0) (chunk ll)) => [/ # [ ]] *. -move : (H0 H). smt(). smt. -rewrite -map_comp /(\o) /wblock2bits_list /wblock2block. -apply eq_map. progress. rewrite mkblockK. by trivial. -qed. - -lemma lift_combine sa sc st xs : - (sa, sc) = state2bc st => - (sa +^ head b0 (wblock2bits_list xs), sc) = - state2bc (combine st (head wblock0 xs)) - by admit. (* provable *) - -lemma behead_wblockl xs : - behead (wblock2bits_list xs) = wblock2bits_list (behead xs). -rewrite /wblock2bits_list . -elim xs;smt(). -qed. - -lemma behead_wblocke xs : - behead (wblock2bits_list xs) = [] <=> behead xs = []. -rewrite /wblock2bits_list . -elim xs;smt(). -qed. - -lemma wbblockle xs : - wblock2bits_list xs = [] => xs = []. -rewrite /wblock2bits_list . -elim xs;smt(). -qed. - -lemma wbblockle_ : [] = wblock2bits_list []. -rewrite /wblock2bits_list . -smt(). -qed. - -lemma commuteappend z sa st sc : - (sa, sc) = state2bc st => - wblocks2bits z ++ ofblock sa = wblocks2bits (z ++ [squeezeb st]). -rewrite /state2bc => //=. move => [/ # ] *. -rewrite /wblocks2bits /wblock2block. -rewrite H. rewrite ofblockK. smt. -rewrite /squeezeb. - admit. (* provable *) -qed. - -op validins(n : int, outl : int) = - n = outl * 8. - -lemma sizes1 i n1 n2 : validins n1 n2 => - i < (n1 + r - 1) %/ r => - i < convb n2 by smt. - -lemma sizes2 i n1 n2 : validins n1 n2 => - i < convb n2 => - i < (n1 + r - 1) %/ r by smt. - -(* Will need to be proved once storeblocks is defined. *) -lemma store_blocks_safe mem out outlen z : - eqmem_except mem (storeblocks mem out outlen z) out outlen by admit. - -(* Will need to be proved once storeblocks is defined *) -lemma storeblocks_correct mem out outlen n z : - validins n outlen => - take n (wblocks2bits z) = - memr2bits (storeblocks mem out outlen z) out outlen by admit. - -lemma spec_correct mem outp outl: -equiv [ Sponge(Pideal).f ~ Spec(Preal).f : - Glob.mem{2} = mem /\ - bs{1} = memr2bits mem inp{2} inlen{2} ++ domain_bits ++ suffix_bits /\ - outlen{2} = outl /\ validins n{1} outlen{2} /\ out{2} = outp - ==> eqmem_except mem Glob.mem{2} outp outl /\ - res{1} = memr2bits Glob.mem{2} outp outl]. -proc. -seq 4 4 : ( -#pre /\ -z{1} = wblocks2bits z{2} /\ -(sa{1},sc{1}) = state2bc st{2} /\ -={i} /\ xs{1} = wblock2bits_list xs{2} -); first by wp;skip;smt(wblocks2bits_empty state0conv liftpadding). -seq 1 1 : #pre. -while #pre. -by wp;call (perm_correct); wp;skip; smt(lift_combine behead_wblockl behead_wblocke). -by skip; smt(behead_wblockl behead_wblocke). -seq 1 1 : #pre. -while #pre. -seq 2 2 : #[/:-2]pre; first by wp;skip; smt(commuteappend). -if => //=. -progress. -apply(sizes1 i{2} n{1} outlen{2} H) => //=. -apply(sizes2 i{2} n{1} outlen{2} H) => //=. -call perm_correct;skip;progress => //=. -apply(sizes1 i{2} n{1} outlen{2} H) => //=. -skip;progress => //=. -apply(sizes2 i{2} n{1} outlen{2} H) => //=. -skip;progress => //=. -apply(sizes1 i{2} n{1} outlen{2} H) => //=. -apply(sizes2 i{2} n{1} outlen{2} H) => //=. -wp;skip;progress;smt(store_blocks_safe storeblocks_correct). -qed. - -end section. diff --git a/proof/impl/keccak.ec b/proof/impl/keccak.ec deleted file mode 100644 index 08742f2..0000000 --- a/proof/impl/keccak.ec +++ /dev/null @@ -1,743 +0,0 @@ -require import List Int IntExtra IntDiv CoreMap. -from Jasmin require import JModel. - -require Spec. -clone import Spec as Spc. -import Spc.Spnge. -import Common. - -clone export PolyArray as Array5 with op size <- 5. - -clone export WArray as WArray200 with op size <- 200. -clone export WArray as WArray40 with op size <- 40. - - -op x86_ROL_64 : W64.t -> W8.t -> bool * bool * W64.t. -op set0_64 : bool * bool * bool * bool * bool * W64.t. -op x86_TEST_8 : W8.t -> W8.t -> bool * bool * bool * bool * bool. - -(* -require import List Int IntExtra Int_Div CoreMap. -from Jasmin require import JModel. - -require import Array5 Array25. -require import WArray40 WArray200. -*) - -module M = { - proc spill_2 (a:W64.t, b:W64.t) : W64.t * W64.t = { - - var sa:W64.t; - var sb:W64.t; - - sa <- a; - sb <- b; - return (sa, sb); - } - - proc load_2 (sa:W64.t, sb:W64.t) : W64.t * W64.t = { - - var a:W64.t; - var b:W64.t; - - a <- sa; - b <- sb; - return (a, b); - } - (* - proc rOL64 (x:W64.t, c:int) : W64.t = { - - var y:W64.t; - var _0:bool; - var _1:bool; - - if ((c = 0)) { - y <- x; - } else { - ( _0, _1, y) <- x86_ROL_64 x (W8.of_int c); - } - return (y); - } - *) - proc keccak_init (m:W64.t) : W64.t Array25.t = { - - var state:W64.t Array25.t; - var t:W64.t; - var i:W64.t; - var _0:bool; - var _1:bool; - var _2:bool; - var _3:bool; - var _4:bool; - state <- witness; - ( _0, _1, _2, _3, _4, t) <- set0_64 ; - i <- (W64.of_int 0); - - while ((i \ult (W64.of_int 50))) { - state.[(W64.to_uint i)] <- t; - i <- (i + (W64.of_int 1)); - } - return (state); - } - (* - proc index (x:int, y:int) : int = { - - var r:int; - - r <- ((5 * (x %% 5)) + (y %% 5)); - return (r); - } - - proc keccak_rho_offsets (i:int) : int = { - var aux: int; - - var r:int; - var x:int; - var y:int; - var t:int; - var z:int; - - r <- 0; - x <- 1; - y <- 0; - t <- 0; - while (t < 24) { - if ((i = (x + (5 * y)))) { - r <- ((((t + 1) * (t + 2)) %/ 2) %% 64); - } else { - - } - z <- (((2 * x) + (3 * y)) %% 5); - x <- y; - y <- z; - t <- t + 1; - } - return (r); - } - - proc rhotates (x:int, y:int) : int = { - - var r:int; - var i:int; - - i <@ index (x, y); - r <@ keccak_rho_offsets (i); - return (r); - } - - proc theta_sum (A:W64.t Array25.t) : W64.t Array5.t = { - var aux: int; - - var _C:W64.t Array5.t; - var i:int; - var j:int; - _C <- witness; - i <- 0; - while (i < 5) { - _C.[i] <- A.[((5 * (0 %% 5)) + (i %% 5))]; - j <- 1; - while (j < 5) { - _C.[i] <- (_C.[i] `^` A.[((5 * (j %% 5)) + (i %% 5))]); - j <- j + 1; - } - i <- i + 1; - } - return (_C); - } - - proc theta_rol (_C:W64.t Array5.t) : W64.t Array5.t = { - var aux: int; - - var _D:W64.t Array5.t; - var i:int; - var r:W64.t; - _D <- witness; - i <- 0; - while (i < 5) { - r <@ rOL64 (_C.[((i + 1) %% 5)], 1); - _D.[i] <- r; - _D.[i] <- (_D.[i] `^` _C.[((i + 4) %% 5)]); - i <- i + 1; - } - return (_D); - } - - proc rol_sum (_D:W64.t Array5.t, A:W64.t Array25.t, offset:int) : W64.t Array5.t = { - var aux: int; - - var _C:W64.t Array5.t; - var j:int; - var j1:int; - var k:int; - var t:W64.t; - _C <- witness; - j <- 0; - while (j < 5) { - j1 <- ((j + offset) %% 5); - k <@ rhotates (j, j1); - t <- A.[((5 * (j %% 5)) + (j1 %% 5))]; - t <- (t `^` _D.[j1]); - t <@ rOL64 (t, k); - _C.[j] <- t; - j <- j + 1; - } - return (_C); - } - - proc set_row (_R:W64.t Array25.t, row:int, _C:W64.t Array5.t, iota_0:W64.t) : - W64.t Array25.t = { - var aux: int; - - var j:int; - var j1:int; - var j2:int; - var t:W64.t; - - j <- 0; - while (j < 5) { - j1 <- ((j + 1) %% 5); - j2 <- ((j + 2) %% 5); - t <- ((invw _C.[j1]) `&` _C.[j2]); - if (((row = 0) /\ (j = 0))) { - t <- (t `^` iota_0); - } else { - - } - t <- (t `^` _C.[j]); - _R.[((5 * (row %% 5)) + (j %% 5))] <- t; - j <- j + 1; - } - return (_R); - } - - proc round2x (A:W64.t Array25.t, _R:W64.t Array25.t, iotas:W64.t, o:int) : - W64.t Array25.t * W64.t Array25.t = { - - var iota_0:W64.t; - var _C:W64.t Array5.t; - var _D:W64.t Array5.t; - _C <- witness; - _D <- witness; - iota_0 <- (loadW64 Glob.mem (W64.to_uint (iotas + (W64.of_int o)))); - _C <@ theta_sum (A); - _D <@ theta_rol (_C); - _C <@ rol_sum (_D, A, 0); - _R <@ set_row (_R, 0, _C, iota_0); - _C <@ rol_sum (_D, A, 3); - _R <@ set_row (_R, 1, _C, iota_0); - _C <@ rol_sum (_D, A, 1); - _R <@ set_row (_R, 2, _C, iota_0); - _C <@ rol_sum (_D, A, 4); - _R <@ set_row (_R, 3, _C, iota_0); - _C <@ rol_sum (_D, A, 2); - _R <@ set_row (_R, 4, _C, iota_0); - return (A, _R); - } - *) - proc keccak_f (A:W64.t Array25.t, iotas:W64.t) : W64.t Array25.t * W64.t = { - (* - var zf:bool; - var _R:W64.t Array25.t; - var _0:bool; - var _1:bool; - var _2:bool; - var _3:bool; - _R <- witness; - (A, _R) <@ round2x (A, _R, iotas, 0); - (_R, A) <@ round2x (_R, A, iotas, 8); - iotas <- (iotas + (W64.of_int 16)); - ( _0, _1, _2, _3, zf) <- x86_TEST_8 (truncateu8 iotas) - (W8.of_int 255); - while ((! zf)) { - (A, _R) <@ round2x (A, _R, iotas, 0); - (_R, A) <@ round2x (_R, A, iotas, 8); - iotas <- (iotas + (W64.of_int 16)); - ( _0, _1, _2, _3, zf) <- x86_TEST_8 (truncateu8 iotas) - (W8.of_int 255); - } - iotas <- (iotas - (W64.of_int 192));*) - return (A, iotas); - } - - proc keccak_1600_add_full_block (state:W64.t Array25.t, in_0:W64.t, - inlen:W64.t, rate_in_bytes:int) : - W64.t Array25.t * W64.t * W64.t = { - var aux: int; - - var i:int; - var t:W64.t; - - aux <- (rate_in_bytes %/ 8); - i <- 0; - while (i < aux) { - t <- (loadW64 Glob.mem (W64.to_uint (in_0 + (W64.of_int (8 * i))))); - state.[i] <- (state.[i] `^` t); - i <- i + 1; - } - in_0 <- (in_0 + (W64.of_int rate_in_bytes)); - inlen <- (inlen - (W64.of_int rate_in_bytes)); - return (state, in_0, inlen); - } - - proc keccak_1600_add_final_block (state:W64.t Array25.t, in_0:W64.t, - inlen:W64.t, suffix:int, - rate_in_bytes:int) : W64.t Array25.t = { - - var inlen8:W64.t; - var i:W64.t; - var t:W64.t; - var c:W8.t; - - inlen8 <- inlen; - inlen8 <- (inlen8 `>>` (W8.of_int 3)); - i <- (W64.of_int 0); - - while ((i \ult inlen8)) { - t <- (loadW64 Glob.mem (W64.to_uint (in_0 + ((W64.of_int 8) * i)))); - state.[(W64.to_uint i)] <- (state.[(W64.to_uint i)] `^` t); - i <- (i + (W64.of_int 1)); - } - i <- (i `<<` (W8.of_int 3)); - - while ((i \ult inlen)) { - c <- (loadW8 Glob.mem (W64.to_uint (in_0 + i))); - state = - Array25.init - (WArray200.get64 (WArray200.set8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i) ( - (get8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i)) `^` c))); - i <- (i + (W64.of_int 1)); - } - state = - Array25.init - (WArray200.get64 (WArray200.set8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i) ( - (get8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i)) `^` (W8.of_int suffix)))); - state = - Array25.init - (WArray200.get64 (WArray200.set8 (WArray200.init64 (fun i => state.[i])) (rate_in_bytes - 1) ( - (get8 (WArray200.init64 (fun i => state.[i])) (rate_in_bytes - 1)) `^` (W8.of_int 128)))); - return (state); - } - - proc keccak_1600_absorb (state:W64.t Array25.t, iotas:W64.t, in_0:W64.t, - inlen:W64.t, suffix:int, rate_in_bytes:int) : - W64.t Array25.t * W64.t = { - - var s_in:W64.t; - var s_inlen:W64.t; - - - while (((W64.of_int rate_in_bytes) \ule inlen)) { - (state, in_0, inlen) <@ keccak_1600_add_full_block (state, in_0, inlen, - rate_in_bytes); - (s_in, s_inlen) <@ spill_2 (in_0, inlen); - (state, iotas) <@ keccak_f (state, iotas); - (in_0, inlen) <@ load_2 (s_in, s_inlen); - } - state <@ keccak_1600_add_final_block (state, in_0, inlen, suffix, - rate_in_bytes); - (state, iotas) <@ keccak_f (state, iotas); - return (state, iotas); - } - - proc keccak_1600_xtr_block (state:W64.t Array25.t, out:W64.t, len:W64.t) : - W64.t = { - - var len8:W64.t; - var i:W64.t; - var t:W64.t; - var c:W8.t; - - len8 <- len; - len8 <- (len8 `>>` (W8.of_int 3)); - i <- (W64.of_int 0); - - while ((i \ult len8)) { - t <- state.[(W64.to_uint i)]; - Glob.mem <- - storeW64 Glob.mem (W64.to_uint (out + ((W64.of_int 8) * i))) t; - i <- (i + (W64.of_int 1)); - } - i <- (i `<<` (W8.of_int 3)); - - while ((i \ult len)) { - c <- (get8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i)); - Glob.mem <- storeW8 Glob.mem (W64.to_uint (out + i)) c; - i <- (i + (W64.of_int 1)); - } - out <- (out + len); - return (out); - } - - proc keccak_1600_squeeze (state:W64.t Array25.t, iotas:W64.t, out:W64.t, - rate_in_bytes:int, i_hash_bytes:int) : unit = { - - var s_hash_bytes:W64.t; - var s_out:W64.t; - var hash_bytes:W64.t; - - s_hash_bytes <- (W64.of_int i_hash_bytes); - - while (((W64.of_int rate_in_bytes) \ult s_hash_bytes)) { - out <@ keccak_1600_xtr_block (state, out, (W64.of_int rate_in_bytes)); - s_out <- out; - (state, iotas) <@ keccak_f (state, iotas); - s_hash_bytes <- (s_hash_bytes - (W64.of_int rate_in_bytes)); - out <- s_out; - } - hash_bytes <- s_hash_bytes; - out <@ keccak_1600_xtr_block (state, out, hash_bytes); - return (); - } - - proc keccak_1600 (out:W64.t, in_0:W64.t, inlen:W64.t, iotas:W64.t, m:W64.t, - suffix:int, rate:int, capacity:int, hash_bytes:int) : unit = { - - var out_s:W64.t; - var state:W64.t Array25.t; - state <- witness; - out_s <- out; - state <@ keccak_init (m); - (state, iotas) <@ keccak_1600_absorb (state, iotas, in_0, inlen, suffix, - (rate %/ 8)); - out <- out_s; - keccak_1600_squeeze (state, iotas, out, (rate %/ 8), hash_bytes); - return (); - } -}. - -section. - -op good_iotas : W64.t. -op rate_in_bytes : int. - -declare module Preal : PermT {Glob}. - -axiom perm_imp_correct good_iotas : - equiv [ Preal.perm ~ M.keccak_f : - st{1} = A{2} /\ iotas{2} = good_iotas /\ rate_in_bytes{2} = rate_in_bytes ==> - res{1} = res{2}.`1 /\ res{2}.`2 = good_iotas]. (* this second one is weird *) - -print Spc.r. - -phoare keccak_init_spec mem : - [ M.keccak_init : Glob.mem = mem ==> Glob.mem = mem /\ res = state0 ] = 1%r. -admitted. - -phoare keccak_1600_xtr_block_spec mem outp outl st : - [ M.keccak_1600_xtr_block : - Glob.mem = mem /\ state = st /\ - to_uint out = outp /\ to_uint len = outl ==> - res = W64.of_int (outp + outl) /\ - eqmem_except mem Glob.mem outp outl /\ - memr2bits Glob.mem outp outl = - take (outl * 8) (ofblock (wblock2block (take (r %/ 64) (Array25.to_list st)))) ] = 1%r. -admitted. - -phoare keccak_1600_add_full_block_spec mem st inp inl rate wb : - [ M.keccak_1600_add_full_block : - wb = take (r %/ 64) (map W64.bits2w - (BitEncoding.BitChunking.chunk 64 (bytewisepad (memr2bits mem inp inl)))) /\ - Glob.mem = mem /\ state = st /\ to_uint in_0 = inp /\ to_uint inlen = inl /\ - rate_in_bytes = rate ==> - Glob.mem = mem /\ res.`1 = combine st wb /\ to_uint res.`2 = inp + rate /\ - to_uint res.`3 = inl - rate] = 1%r. -admitted. - -phoare keccak_1600_add_final_block_spec mem st inp inl rate wb : - [ M.keccak_1600_add_final_block : - wb = take (r %/ 64) (map W64.bits2w - (BitEncoding.BitChunking.chunk 64 (bytewisepad (memr2bits mem inp inl)))) /\ - Glob.mem = mem /\ state = st /\ to_uint in_0 = inp /\ to_uint inlen = inl /\ - rate_in_bytes = rate ==> - Glob.mem = mem /\ res = combine st wb ] = 1%r. -admitted. - -lemma impl_correct outp : -equiv [ Spec(Preal).f ~ M.keccak_1600 : - outp = out{1} /\ outp = W64.to_uint out{2} /\ outlen{1} = hash_bytes{2} /\ - domain_bits{1} ++ suffix_bits{1} = suffix_bits{2} /\ r = rate{2} /\ c = capacity{2} /\ - ={Glob.mem} /\ inp{1} = W64.to_uint in_0{2} /\ inlen{1} = to_uint inlen{2} /\ - iotas{2} = good_iotas - ==> ={Glob.mem} ]. -proc. -sp. -seq 0 1 : (#{~state{2}}pre /\ state{2} = st{1}). -exists *Glob.mem{2}. -elim* => mem. -call {2} (keccak_init_spec (mem)); first by auto => />. - -(* Absorb phase *) -inline M.keccak_1600_absorb. -sp. -splitwhile {1} 1 : (1 < size xs). -seq 1 1 : (#{/~state0{2}} - {~in_00{2}} - {~inlen0{2}} - {~xs{1}} - {~st{1}}pre /\ - st{1} = state0{2} /\ - xs{1} = loadpad2wblocks Glob.mem{1} (W64.to_uint in_00{2}) (W64.to_uint inlen0{2}) - /\ size xs{1} <= 1). -while (#{~ size xs{1} <= 1}post). -seq 0 1 : (#{/~state0{2}} - {~in_00{2}} - {~inlen0{2}}pre /\ - combine st{1} (head wblock0 xs{1}) = state0{2} /\ - xs{1} = loadpad2wblocks Glob.mem{1} (W64.to_uint in_00{2} - rate_in_bytes{2}) (W64.to_uint inlen0{2} + rate_in_bytes{2})). -exists * Glob.mem{2}, state0{2}, (to_uint in_00{2}), (to_uint inlen0{2}), rate_in_bytes{2}, (head wblock0 xs{1}). -elim* => mem st inp inl rate wb. -call {2} (keccak_1600_add_full_block_spec mem st inp inl rate wb). -auto => />. -progress. -rewrite /loadpad2wblocks //=. -rewrite -(head_behead (bits2blocks - (bytewisepad - (memr2bits Glob.mem{2} (to_uint in_00{2}) (to_uint inlen0{2})))) b0). -smt. -rewrite map_cons. simplify. -admit. (* breaking blocks + head + chunking = take + chunking *) -rewrite H4. -smt(). -smt(). -inline M.load_2. -wp. -call (perm_imp_correct good_iotas). -inline *. -wp;auto => />. -progress. -rewrite /loadpad2wblocks. simplify. -rewrite (_: (memr2bits Glob.mem{2} (to_uint in_00{2} - r %/ 8) - (to_uint inlen0{2} + r %/ 8) = - (memr2bits Glob.mem{2} (to_uint in_00{2} - r %/ 8) - (r %/ 8)) ++ - (memr2bits Glob.mem{2} (to_uint in_00{2}) - (to_uint inlen0{2})))). -rewrite /memr2bits. -rewrite -flatten_cat. -admit. (* iota_ rearrangements *) -rewrite (_ : - (bits2blocks - (bytewisepad - (memr2bits Glob.mem{2} (to_uint in_00{2} - r %/ 8) (r %/ 8) ++ - memr2bits Glob.mem{2} (to_uint in_00{2}) - (to_uint inlen0{2})))) = - head witness (bits2blocks - (bytewisepad - (memr2bits Glob.mem{2} (to_uint in_00{2} - r %/ 8) (r %/ 8) ++ - memr2bits Glob.mem{2} (to_uint in_00{2}) - (to_uint inlen0{2})))) :: - (bits2blocks - (bytewisepad - (memr2bits Glob.mem{2} (to_uint in_00{2}) (to_uint inlen0{2}))))). -admit. (* breaking in blocks as reading from memory *) -by rewrite map_cons. -admit. (* better keep some relation between size xs and inlen0 *) -admit. -admit. -auto => />. -progress. -admit. (* better keep some relation between size xs and inlen0 *) -admit. -admit. -admit. - -(* setting minimum precondition to squeeze *) -seq 1 4 : (st{1} = state{2} /\ - iotas{2} = good_iotas /\ - i{1} = 0 /\ - rate{2} = r /\ - rate_in_bytes{2} = rate{2} %/ 8 /\ - to_uint out_s{2} = outp /\ - z{1} = [] /\ - outp = out{1} /\ - outp = W64.to_uint out{2} /\ - outlen{1} = hash_bytes{2} /\ - ={Glob.mem} /\ - hash_bytes{2} = hash_bytes{2}). - -(* we know there's exactly one iteration left to go on the left *) -unroll {1} 1. -(* The final iteration matches the block for which padding was added *) -rcondt {1} 1. move => *. auto => />. -have always : (1 <= size (loadpad2wblocks Glob.mem{m} (to_uint in_00{m}) (to_uint inlen0{m}))). -admit. (* prove once and for all *) smt(). -seq 2 2 : (#{~xs{1}}pre /\ xs{1} = []). -seq 0 1 : (#{/~state0{2}} - {~in_00{2}} - {~inlen0{2}} - {~xs{1}} - {~st{1}}pre /\ - combine st{1} (head wblock0 xs{1}) = state0{2} /\ - size xs{1} <= 1). -exists * Glob.mem{2}, state0{2}, (to_uint in_00{2}), (to_uint inlen0{2}), rate_in_bytes{2}, (head wblock0 xs{1}). -elim* => mem st inp inl rate wb. -call {2} (keccak_1600_add_final_block_spec mem st inp inl rate wb). -auto => />. -progress. -rewrite /loadpad2wblocks //=. -rewrite -(head_behead (bits2blocks - (bytewisepad - (memr2bits Glob.mem{2} (to_uint in_00{2}) (to_uint inlen0{2})))) b0). -move : H0; rewrite /loadpad2wblocks => //=. rewrite size_map. smt. -rewrite map_cons. simplify. -rewrite /bits2blocks. -admit. (* breaking blocks + head + chunking = take + chunking *) -wp. -call (perm_imp_correct good_iotas). -auto => />. -progress. -move : H1. -elim (xs{1}). smt. -progress. smt. - -(* The while on the left is never executed. *) -while {1} (#post /\ xs{1} = []) 1. move => *. exfalso. smt. by auto => />. - -(* Squeeze phase *) - -case (hash_bytes{2} <= 0). -admit. (* to do *) - -inline M.keccak_1600_squeeze. -seq 0 6 : (st{1} = state1{2} /\ - iotas1{2} = good_iotas /\ - rate{2} = r /\ - rate_in_bytes0{2} = rate{2} %/ 8 /\ - to_uint out_s{2} = outp /\ - outp = out{1} /\ - outp = W64.to_uint out{2} /\ - outlen{1} = hash_bytes{2} /\ - 0 <= i{1} /\ i{1} <= convb hash_bytes{2} - 1 /\ - s_hash_bytes{2} = W64.of_int (hash_bytes{2} - (i{1} * r %/ 8)) /\ - to_uint out0{2} = r %/ 8 * i{1} + outp /\ - eqmem_except Glob.mem{1} Glob.mem{2} outp (i{1} * r %/ 8) /\ - memr2bits Glob.mem{2} outp (i{1} * r %/ 8) = - take (i{1} * r %/ 8 * 8) ((wblocks2bits z{1}))). -auto => />. -progress. -rewrite /convb. smt. -smt(). -rewrite /memr2bits /flatten take0 iota0. smt(). smt. - -(* All but last iterations exactly match in how permutation is computed *) -splitwhile {1} 1 : (i < convb outlen -1). -splitwhile {2} 1 : (W64.of_int rate_in_bytes0 \ult s_hash_bytes). -seq 1 1 : (#pre /\ - convb outlen{1} - 1 <= i{1} /\ - i{1} <= convb outlen{1} - 1 /\ - s_hash_bytes{2} \ule W64.of_int rate_in_bytes0{2}). -while (#pre /\ - i{1} <= convb outlen{1} - 1). -seq 2 1 : (#{/~i{1} < convb outlen{1}} - {~i{1} < convb outlen{1} - 1} - {~s_hash_bytes{2} = W64.of_int (hash_bytes{2} - (i{1} * r %/ 8))}pre /\ - s_hash_bytes{2} = W64.of_int (hash_bytes{2} - ((i{1}-1) * r %/ 8)) /\ - i{1} - 1 < convb outlen{1} - 1 /\ - i{1} <= convb outlen{1} - 1 ). -exists * Glob.mem{2}, out0{2}, state1{2}, (W64.of_int rate_in_bytes0{2}). -elim* => mem outpp st hbytes. -call {2} (keccak_1600_xtr_block_spec mem (to_uint outpp) (to_uint hbytes) st). -auto => />. -progress. -smt(). -smt(). -rewrite of_uintK. -rewrite (_ : to_uint out_s{2} = to_uint out0{2} - r %/ 8* i{1}). -smt(). -ring. -rewrite -to_uintD. - admit. (* safety *) -move : H3 H8; rewrite /eqmem_except H2. -move => *. -case (ad <= to_uint out_s{2}). -admit. (* interval matching *) -move => *. -case (ad < to_uint out_s{2} + (i{1} + 1) * r %/ 8). -admit. (* interval matching *) -move => *. -admit. (* interval matching *) -admit. (* eqmem strengthening *) -smt. -smt. -rcondt {1} 1. move => *. auto => />. smt(). -progress. -sp. -seq 1 1 : #pre. -call (perm_imp_correct good_iotas). -by auto => />. -auto => />. progress. ring. admit. (* safety *) -admit. (* bound matching *) -admit. (* bound matching *) -smt. -admit. (* bound matching *) - -auto => />. -progress. -admit. (* bound matching *) -admit. (* bound matching *) -smt. -admit. (* bound matching *) -smt. -admit. (* bound matching *) - -(* Same behaviour for non-block-aligned outputs *) -case (s_hash_bytes{2} = W64.of_int rate_in_bytes0{2}). - -unroll {1} 1. -unroll {2} 1. -rcondt{1} 1. move => *. auto => />. -progress. -smt. -rcondf{1} 3. move => *. auto => />. -progress. -smt. -rcondf{2} 1. move => *. auto => />. -progress. -rewrite ultE. smt. - -seq 0 1 : #pre. -while {2} (#pre) 1. -move => *. exfalso. smt (@W64). - -by auto => />. - -wp. -while {1} (#post /\ convb outlen{1} <= i{1}) 1. -move => *. exfalso. smt (). - -exists * Glob.mem{2}, out0{2}, state1{2}, s_hash_bytes{2}. -elim* => mem outpp st hbytes. -move => *. -call {2} (keccak_1600_xtr_block_spec mem (to_uint outpp) (to_uint hbytes) st). -auto => />. -progress. -admit. (* store properties *) -smt(). - -(* Different behaviour for non-block aligned outputs *) - -seq 0 1 : #pre. -while {2} (#pre) 1. move => *. exfalso. -move => &hr [ # *]. smt(@W64). -by progress. - -unroll {1} 1. -rcondt{1} 1. move => *. auto => />. -progress. -smt. -rcondf {1} 3. move => *. auto => />. smt(). -sp. -seq 1 0 : #pre. -while {1} (#pre) 1. move => *. exfalso. -move => *. auto => />. smt. -by auto => />. -wp. -exists * Glob.mem{2}, out0{2}, state1{2}, s_hash_bytes{2}. -elim* => mem outpp st hbytes. -move => *. -call {2} (keccak_1600_xtr_block_spec mem (to_uint outpp) (to_uint hbytes) st). -auto => />. -progress. -admit. (* store properties *) - -qed. From 2da43a40e29f828f437e5e62401c5a451c729b09 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jos=C3=A9=20Bacelar=20Almeida?= Date: Thu, 16 May 2019 13:48:33 +0100 Subject: [PATCH 422/525] progress --- proof/impl/EclibExtra.ec | 135 ++++++++++++++++++++++++++++----- proof/impl/JWordList.ec | 93 ----------------------- proof/impl/Spec1600.ec | 42 +--------- proof/impl/keccak_1600_corr.ec | 26 +++---- 4 files changed, 128 insertions(+), 168 deletions(-) diff --git a/proof/impl/EclibExtra.ec b/proof/impl/EclibExtra.ec index 33896bd..dd8234f 100644 --- a/proof/impl/EclibExtra.ec +++ b/proof/impl/EclibExtra.ec @@ -5,6 +5,13 @@ require BitEncoding. from Jasmin require JUtils. +lemma foldl_map ['a 'b 'c] (h:'a->'b) (f:'c ->'b->'c) (z:'c) l: + foldl f z (List.map h l) = foldl (fun b a => f b (h a)) z l. +proof. +elim: l f z => //= x xs IH f z. +by rewrite IH. +qed. + lemma nth_inside ['a] d1 d2 (l: 'a list) i: 0 <= i < size l => nth d1 l i = nth d2 l i. @@ -14,6 +21,8 @@ move=> x xs IH i Hi; case: (i=0) => E //. by rewrite IH /#. qed. +lemma nth0 (d:'a) l: nth d l 0 = head d l by case: l. + lemma nseq_add ['a] (x:'a) n1 n2: 0 <= n1 => 0 <= n2 => nseq (n1+n2) x = nseq n1 x ++ nseq n2 x. proof. @@ -74,6 +83,29 @@ move=> n Hn IH H1 H2. by rewrite dropS // IH // -dropS /#. qed. +(* a variant of [size_take] that is more convenient in some cases *) +lemma size_take' ['a] n (s: 'a list): + 0 <= n => size (take n s) = if n <= size s then n else size s. +proof. +move=> Hn; rewrite size_take //. +case: (n = size s) => E; first by rewrite E. +case: (n <= size s) => H. + by rewrite (: n < size s) /#. +by rewrite (: ! n < size s) /#. +qed. + +(* likewise for [take_cat] *) +lemma take_cat' ['a] n (s1 s2: 'a list): + take n (s1++s2) = if n <= size s1 then take n s1 else s1 ++ take (n-size s1) s2. +proof. +rewrite take_cat //. +case: (n = size s1) => E. + by rewrite !E /= take0 cats0 take_size. +case: (n <= size s1) => H. + by rewrite (: n < size s1) /#. +by rewrite (: ! n < size s1) /#. +qed. + (* [eq_mkseq'] is a more refined version of [eq_mkseq] *) lemma eq_mkseq' ['a] (f g : int -> 'a) n: (forall (x : int), 0 <= x < n => f x = g x) => mkseq f n = mkseq g n. @@ -150,28 +182,15 @@ have ->: (size l - n) %/ n = size l %/ n - 1. by apply eq_mkseq' => x Hx /=; rewrite drop_drop /#. qed. - -(* a variant of [size_take] that is more convenient in some cases *) -lemma size_take' ['a] n (s: 'a list): - 0 <= n => size (take n s) = if n <= size s then n else size s. +lemma drop_chunk n k (l: 'a list): + 0 < k => + drop n (BitEncoding.BitChunking.chunk k l) + = BitEncoding.BitChunking.chunk k (drop (k*n) l). proof. -move=> Hn; rewrite size_take //. -case: (n = size s) => E; first by rewrite E. -case: (n <= size s) => H. - by rewrite (: n < size s) /#. -by rewrite (: ! n < size s) /#. -qed. - -(* likewise for [take_cat] *) -lemma take_cat' ['a] n (s1 s2: 'a list): - take n (s1++s2) = if n <= size s1 then take n s1 else s1 ++ take (n-size s1) s2. -proof. -rewrite take_cat //. -case: (n = size s1) => E. - by rewrite !E /= take0 cats0 take_size. -case: (n <= size s1) => H. - by rewrite (: n < size s1) /#. -by rewrite (: ! n < size s1) /#. +move=> Hk; elim/natind: n l. + by move=> n Hn l; rewrite !drop_le0 /#. +move=> n Hn IH l; rewrite dropS // IH behead_chunk drop_drop 1,2:/#. +by congr; congr; ring. qed. lemma chunk_take_eq ['a] n (l:'a list): @@ -283,6 +302,80 @@ move=> Hn; rewrite {1}/chunkfill chunkfillsizeE // ?size_ge0. by rewrite !chunkfillP //= cats0. qed. +lemma chunkfill_cat (d:'a) n l1 l2: + 0 < n => n %| size l1 => chunkfill d n (l1++l2) = l1 ++ chunkfill d n l2. +proof. +move=> H0 Hsz; rewrite /chunkfill -!catA; congr; congr; congr. +move: Hsz; rewrite size_cat dvdzP => [[k]]. +rewrite mulzC => ->. +by rewrite chunkfillsizeP. +qed. + +lemma chunkfillK' l (d:'a) n: + 0 < n => n %| size l => chunkfill d n l = l. +proof. +rewrite /chunkfill => Hn Hsz. +move: (Hsz); rewrite dvdzP => [[k E]]. +rewrite chunkfillsizeE //; first smt(size_ge0). +by rewrite !Hsz /= cats0. +qed. + +lemma chunkfillsize_ge0 k n: 0 < k => 0 <= chunkfillsize k n. +proof. by rewrite /chunkfillsize /#. qed. + +lemma drop_chunkfill n (d:'a) k l: + 0 < k => 0 <= n => + drop (k*n) (chunkfill d k l) = chunkfill d k (drop (k*n) (chunkfill d k l)). +proof. +move=> Hk Hn; have := chunkfillP d k l Hk. +rewrite /chunkfill size_cat size_nseq max_ler; first smt(chunkfillsize_ge0). +move=> Hdvd; pose S:= chunkfillsize _ (size (drop _ _)). +have ->: S = 0; last by rewrite nseq0 cats0. +rewrite /S -(chunkfillsizeP _ _ n) // size_drop 1:/# addzC /max size_cat size_nseq. +rewrite max_ler; first by apply chunkfillsize_ge0. +case: (0 < size l + chunkfillsize k (size l) - k * n) => E. + rewrite Ring.IntID.subrK chunkfillsizeE; first 2 smt(size_ge0 chunkfillsize_ge0). + by rewrite !Hdvd. +by rewrite addzC chunkfillsizeP. +qed. + +lemma nth_chunkfill k (d:'a) n l: + 0 < n => nth d (chunkfill d n l) k = nth d l k. +proof. +move=> Hn; rewrite /chunkfill nth_cat. +case: (k < size l) => E //. +case: (0 <= k - size l < chunkfillsize n (size l)) => ?. + by rewrite nth_nseq // nth_out /#. +rewrite nth_out. + by rewrite size_nseq max_ler // chunkfillsize_ge0. +by rewrite nth_out /#. +qed. + +lemma head_chunkfilled (d:'a) k l: + head [] (BitEncoding.BitChunking.chunk k (chunkfill d k l)) + = take k (chunkfill d k l). +proof. +case: (0 < k) => Hk; last first. + by rewrite take_le0 1:/# BitEncoding.BitChunking.chunk_le0 1:/#. +case: (0 < size l) => Hsz; last first. + have ->: l=[] by smt(size_ge0). + by rewrite chunkfill_nil /= /BitEncoding.BitChunking.chunk /= mkseq0. +rewrite -nth0 /BitEncoding.BitChunking.chunk nth_mkseq /=. + by rewrite size_chunkfill // /#. +by rewrite drop0. +qed. + +lemma nth_chunkfilled (d:'a) k l (i:int): + 0 < k => + 0 <= i < (size l - 1) %/ k => + nth [] (BitEncoding.BitChunking.chunk k (chunkfill d k l)) i + = take k (drop (k*i) (chunkfill d k l)). +proof. +move=> Hk Hi. +rewrite {1}(:i = i+0) // -nth_drop 1,2:/# drop_chunk // nth0. +by rewrite drop_chunkfill // 1:/# head_chunkfilled. +qed. + lemma take_map2 ['a 'b 'c] (f:'a -> 'b -> 'c) n l1 l2: take n (JUtils.map2 f l1 l2) = JUtils.map2 f (take n l1) (take n l2). proof. diff --git a/proof/impl/JWordList.ec b/proof/impl/JWordList.ec index 133fab8..7f35c85 100644 --- a/proof/impl/JWordList.ec +++ b/proof/impl/JWordList.ec @@ -4,99 +4,6 @@ from Jasmin require import JMemory JWord JUtils. require import EclibExtra. -lemma foldl_map ['a 'b 'c] (h:'a->'b) (f:'c ->'b->'c) (z:'c) l: - foldl f z (List.map h l) = foldl (fun b a => f b (h a)) z l. -proof. -elim: l f z => //= x xs IH f z. -by rewrite IH. -qed. - -lemma chunkfill_cat (d:'a) n l1 l2: - 0 < n => n %| size l1 => chunkfill d n (l1++l2) = l1 ++ chunkfill d n l2. -proof. -move=> H0 Hsz; rewrite /chunkfill -!catA; congr; congr; congr. -move: Hsz; rewrite size_cat dvdzP => [[k]]. -rewrite mulzC => ->. -by rewrite chunkfillsizeP. -qed. - -lemma chunkfillK' l (d:'a) n: - 0 < n => n %| size l => chunkfill d n l = l. -proof. -rewrite /chunkfill => Hn Hsz. -move: (Hsz); rewrite dvdzP => [[k E]]. -rewrite chunkfillsizeE //; first smt(size_ge0). -by rewrite !Hsz /= cats0. -qed. - -lemma chunkfillsize_ge0 k n: 0 < k => 0 <= chunkfillsize k n. -proof. by rewrite /chunkfillsize /#. qed. - -lemma drop_chunkfill n (d:'a) k l: - 0 < k => 0 <= n => - drop (k*n) (chunkfill d k l) = chunkfill d k (drop (k*n) (chunkfill d k l)). -proof. -move=> Hk Hn; have := chunkfillP d k l Hk. -rewrite /chunkfill size_cat size_nseq max_ler; first smt(chunkfillsize_ge0). -move=> Hdvd; pose S:= chunkfillsize _ (size (drop _ _)). -have ->: S = 0; last by rewrite nseq0 cats0. -rewrite /S -(chunkfillsizeP _ _ n) // size_drop 1:/# addzC /max size_cat size_nseq. -rewrite max_ler; first by apply chunkfillsize_ge0. -case: (0 < size l + chunkfillsize k (size l) - k * n) => E. - rewrite Ring.IntID.subrK chunkfillsizeE; first 2 smt(size_ge0 chunkfillsize_ge0). - by rewrite !Hdvd. -by rewrite addzC chunkfillsizeP. -qed. - -lemma nth_chunkfill k (d:'a) n l: - 0 < n => nth d (chunkfill d n l) k = nth d l k. -proof. -move=> Hn; rewrite /chunkfill nth_cat. -case: (k < size l) => E //. -case: (0 <= k - size l < chunkfillsize n (size l)) => ?. - by rewrite nth_nseq // nth_out /#. -rewrite nth_out. - by rewrite size_nseq max_ler // chunkfillsize_ge0. -by rewrite nth_out /#. -qed. - -lemma drop_chunk n k (l: 'a list): - 0 < k => - drop n (BitEncoding.BitChunking.chunk k l) - = BitEncoding.BitChunking.chunk k (drop (k*n) l). -proof. -move=> Hk; elim/natind: n l. - by move=> n Hn l; rewrite !drop_le0 /#. -move=> n Hn IH l; rewrite dropS // IH behead_chunk drop_drop 1,2:/#. -by congr; congr; ring. -qed. - -lemma nth0 (d:'a) l: nth d l 0 = head d l by case: l. - -lemma head_chunkfilled (d:'a) k l: - head [] (BitEncoding.BitChunking.chunk k (chunkfill d k l)) - = take k (chunkfill d k l). -proof. -case: (0 < k) => Hk; last first. - by rewrite take_le0 1:/# BitEncoding.BitChunking.chunk_le0 1:/#. -case: (0 < size l) => Hsz; last first. - have ->: l=[] by smt(size_ge0). - by rewrite chunkfill_nil /= /BitEncoding.BitChunking.chunk /= mkseq0. -rewrite -nth0 /BitEncoding.BitChunking.chunk nth_mkseq /=. - by rewrite size_chunkfill // /#. -by rewrite drop0. -qed. - -lemma nth_chunkfilled (d:'a) k l (i:int): - 0 < k => - 0 <= i < (size l - 1) %/ k => - nth [] (BitEncoding.BitChunking.chunk k (chunkfill d k l)) i - = take k (drop (k*i) (chunkfill d k l)). -proof. -move=> Hk Hi. -rewrite {1}(:i = i+0) // -nth_drop 1,2:/# drop_chunk // nth0. -by rewrite drop_chunkfill // 1:/# head_chunkfilled. -qed. (*******************************************************************************) (* W8 lists *) diff --git a/proof/impl/Spec1600.ec b/proof/impl/Spec1600.ec index 24197bd..e6ccb61 100644 --- a/proof/impl/Spec1600.ec +++ b/proof/impl/Spec1600.ec @@ -767,47 +767,7 @@ rcondf {1} 3. by rewrite -size_eq0 /#. (* SQUEEZE *) splitwhile {1} 5: (i+1 < (n + r - 1) %/ r). -admit (* -(* -pre = - (outl2 = outl{2} /\ - n{1} = 8 * outl{2} /\ trailbyte{2} = trail_byte mbits /\ size mbits < 6) /\ - match_state (sa{1}, sc{1}) st{2} /\ - xs{1} = pad2blocks (w8L2bits m{2} ++ mbits) /\ size xs{1} = 1 - -(sa, sc) <@ (1----) st <- - IdealizedPerm.f(sa +^ head b0 xs, sc) ( ---) addfinalblock st - ( ---) (final_block64 trailbyte m) -xs <- behead xs (2----) result <- [] -z <- [] (3----) while (rate8 < outl) { - (3.1--) st <- sponge_permutation st - (3.2--) b <- squeezestate st - (3.3--) result <- result ++ xtrbytes rate8 b - (3.4--) outl <- outl - rate8 - (3----) } -i <- 0 (4----) st <- sponge_permutation st -while (i < (n + r - 1) %/ r /\ (5----) b <- squeezestate st - i + 1 < (n + r - 1) %/ r) { ( ---) - z <- z ++ ofblock sa (5.1--) - i <- i + 1 (5.2--) - if (i < (n + r - 1) %/ r) { TRUE! (5.3--) - (sa, sc) <@ IdealizedPerm.f(sa, sc) (5.3.1) - } (5.3--) -} (5----) - - - -while (i < (n + r - 1) %/ r) { (6----) result <- result ++ xtrbytes outl b - z <- z ++ ofblock sa (6.1--) - i <- i + 1 (6.2--) - if (i < (n + r - 1) %/ r) { FALSE! (6.3--) - (sa, sc) <@ IdealizedPerm.f(sa, sc) (6.3.1) - } (6.3--) -} (6----) - -post = take n{1} z{1} = w8L2bits result{2} - -*) +admit (* TODO: adjust proof script to a last-minute change in the control-flow case: (0 < outl2); last first. (* corner case: no output *) rcondf {2} 3; first by move=> *; wp; skip => |> *; smt(rate8_bnds). diff --git a/proof/impl/keccak_1600_corr.ec b/proof/impl/keccak_1600_corr.ec index ddbbcd3..47459c2 100644 --- a/proof/impl/keccak_1600_corr.ec +++ b/proof/impl/keccak_1600_corr.ec @@ -358,7 +358,7 @@ seq 4: (to_uint i = to_uint inlen_ %/ 8 /\ rewrite to_uintD_small; smt. rewrite (W64.to_uintD_small _ W64.one). smt. have Esz : size (w8L2w64L (memread Glob.mem{hr} (to_uint in_0{hr}) (to_uint inlen{hr} %/ 8 * 8))) = to_uint inlen{hr} %/ 8. - rewrite size_w8L2w64L ?size_memread. smt. smt(). smt. smt. + rewrite size_w8L2w64L ?size_memread. smt. smt(). rewrite of_uintK modz_small // (take_nth W64.zero) ?size_memread. rewrite Esz. smt. rewrite addstate_rcons; congr. @@ -368,15 +368,13 @@ seq 4: (to_uint i = to_uint inlen_ %/ 8 /\ pose Z:= nth W64.zero (take _ _) _. have ->/=: Z = W64.zero. rewrite /Z nth_out // size_take'. smt. - rewrite size_w8L2w64L ?size_memread. smt. smt(). smt. - have ->/=: to_uint i{hr} <= to_uint inlen{hr} %/ 8 * 8 %/ 8. smt. - done. + rewrite size_w8L2w64L ?size_memread. smt. + smt(). congr. rewrite size_take'. smt. - rewrite size_w8L2w64L ?size_memread. smt. smt(). smt. - have ->/=: to_uint i{hr} <= to_uint inlen{hr} %/ 8 * 8 %/ 8. smt. - done. - rewrite -loadW64_w8L2w64L. smt. + rewrite size_w8L2w64L ?size_memread. smt. + smt(). + rewrite -nth_memread_u64. smt. smt. congr. rewrite to_uintD_small. smt. smt. wp; skip; progress. @@ -386,7 +384,7 @@ seq 4: (to_uint i = to_uint inlen_ %/ 8 /\ + smt. + rewrite (: to_uint i0 = to_uint inlen{hr} %/ 8). smt. rewrite take_w8L2w64L. - congr; congr; congr. + congr; congr. rewrite !take_memread. smt. smt. congr. smt. @@ -433,11 +431,13 @@ seq 2: (#[/1,4:-1]pre /\ by apply W64.all_eq_eq; rewrite /all_eq. pose X:= nth _ _ _. have ->/=: X = W64.zero. - rewrite /X nth_out // size_w8L2w64L'. smt. + rewrite /X nth_out // size_w8L2w64L'. + rewrite size_take. smt. rewrite size_memread. smt. admit. + smt. have <-:= addstate_get' st (w8L2w64L (take (to_uint inlen{hr} %/ 8 * 8) (memread Glob.mem{hr} (to_uint in_0{hr}) (to_uint inlen{hr})))). - rewrite size_w8L2w64L'. smt. + rewrite size_w8L2w64L size_take'. smt. rewrite size_memread. smt. admit. by rewrite Array25.set_notmod. + smt. + have E: to_uint i0 = to_uint inlen{hr}. smt. @@ -457,10 +457,10 @@ rewrite final_block64_lastu64 addstate_rcons. have inlen_bnds := W64.to_uint_cmp inlen{hr}. pose L := w8L2w64L _. have Lsz: size L = to_uint inlen{hr} %/ 8. - rewrite /L size_bits2w64L size_w8L2bits size_take' size_memread 1..3:/#. + rewrite /L size_w8L2w64L size_take' size_memread 1..3:/#. rewrite (: to_uint inlen{hr} %/ 8 * 8 <= to_uint inlen{hr}) /=. smt. - rewrite {2}(divz_eq (to_uint inlen{hr}) 8) (mulzC 8) mulzA /= !divzMDl //. + rewrite {2}(divz_eq (to_uint inlen{hr}) 8) !divzMDl //. rewrite divNz //= (divz_small (to_uint inlen{hr} %% 8)) //. by apply modz_cmp. have E: (addstate st L).[size L] = st.[size L] by rewrite addstate_get' //. From 71b24e84ac66a9ee5a10c07a0fc07872add0a2ed Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jos=C3=A9=20Bacelar=20Almeida?= Date: Thu, 16 May 2019 13:49:38 +0100 Subject: [PATCH 423/525] remove olf file --- proof/impl/Spec.ec | 693 --------------------------------------------- 1 file changed, 693 deletions(-) delete mode 100644 proof/impl/Spec.ec diff --git a/proof/impl/Spec.ec b/proof/impl/Spec.ec deleted file mode 100644 index de9db79..0000000 --- a/proof/impl/Spec.ec +++ /dev/null @@ -1,693 +0,0 @@ -require import AllCore List Int IntDiv. -from Jasmin require import JArray JMemory JModel JUtils JWord JWord_array. -require Sponge. - -clone import Sponge as Spnge. -import Common. -import Block. -import Capacity. - -clone export PolyArray as Array25 with op size <- 25. - -op domain_bits : bool list. - -(* domain bits are used to distinguish usages of the Sponge in standard *) -axiom domain_bits_len : size domain_bits = 2. - -op suffix_bits : bool list. - -(* additional suffix bits are allowed for construction usage *) -axiom suffix_bits_len : size suffix_bits < 3. - -type state = W64.t Array25.t. - -(* True for all state sizes we will consider *) -axiom wstate_size (x : state) : - size (flatten (map W64.w2bits (Array25.to_list x))) = (r + c). -axiom rsize : r %% 64 = 0. - -lemma wstate_size_val: r+c = 1600. -move : (wstate_size (Array25.of_list witness (mkseq (fun (i : int) => (of_list W64.zero []).[i]) 25))). -rewrite of_listK. apply size_mkseq. -rewrite /flatten. -rewrite (_: (mkseq (fun (i0 : int) => (of_list W64.zero []).[i0]) 25) = - (W64.zero :: W64.zero :: W64.zero :: W64.zero :: W64.zero :: - W64.zero :: W64.zero :: W64.zero :: W64.zero :: W64.zero :: - W64.zero :: W64.zero :: W64.zero :: W64.zero :: W64.zero :: - W64.zero :: W64.zero :: W64.zero :: W64.zero :: W64.zero :: - W64.zero :: W64.zero :: W64.zero :: W64.zero :: W64.zero :: [])). -by auto => />. -rewrite (_: - (foldr (++) [] - (map W64.w2bits - [W64.zero; W64.zero; W64.zero; W64.zero; W64.zero; W64.zero; - W64.zero; W64.zero; W64.zero; W64.zero; W64.zero; W64.zero; - W64.zero; W64.zero; W64.zero; W64.zero; W64.zero; W64.zero; - W64.zero; W64.zero; W64.zero; W64.zero; W64.zero; W64.zero; - W64.zero])) = - (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ - (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ - (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ - (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ - (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero)). -by auto => />. -simplify. smt(). -qed. - -op memr2bits( mem : global_mem_t, ptr : int, len : int) = - flatten (map (fun o => W8.w2bits (mem.[ptr + o])) (iota_ 0 len)). - -op eqmem_except(mem1 : global_mem_t, mem2 : global_mem_t, ptr : int, o : int) = - forall ad, !(ptr <= ad < ptr + o) => mem1.[ad] = mem2.[ad]. - -op state2bc(st : state) : block * capacity = - let stbits = flatten (map W64.w2bits (to_list st)) - in (mkblock (take r stbits), mkcapacity (drop r stbits)). - -module type PermT = { - proc perm(st : state) : state -}. - -type wblock = W64.t list. - -op pad1byte = domain_bits ++ suffix_bits ++ [true] ++ nseq (8 - (size domain_bits) - (size suffix_bits) - 2) false ++ [true]. -op padqstart = domain_bits ++ suffix_bits ++ [true] ++ nseq (8 - (size domain_bits) - (size suffix_bits) - 1) false. -op padq0 = nseq 8 false. -op padqend = nseq 7 false ++ [true]. -op padbytes(q : int) = - if q = 1 - then [ pad1byte ] - else [ padqstart ] ++ nseq (q-2) padq0 ++ [padqend ]. - -op bytewisepad(s) = - let q = (r %/ 8) - (((size s) %/ 8) %% (r %/ 8)) - in s ++ flatten (padbytes q). - -op loadpad2wblocks(mem : global_mem_t, ptr : int, len : int) = - let msgbits = bytewisepad (memr2bits mem ptr len) - in map (fun b => map W64.bits2w (BitEncoding.BitChunking.chunk 64 (ofblock b))) - (bits2blocks (msgbits)). - -lemma bound_conv (s : bool list) q : - size s %% 8 = 0 => - r %/ 8 - size s %/ 8 %% (r %/ 8) = q => - (size s + q*8) %% r = 0. -move=> *. -have rr : r - 8*(size s %/ 8 %% (r %/ 8)) = 8*q. -+ by rewrite {1}(andWl _ _ (edivzP r 8)) (:r %% 8 = 0) 1:[smt(rsize)] /#. -move : rr. -rewrite (mulz_modr 8) 1:/#. -rewrite (: 8 * (size s %/ 8) %% (8 * (r %/ 8)) = size s %% r). -+ by rewrite 2!(mulzC 8) 2!divzE H /= (: r %% 8 = 0) 1:[smt(rsize)]. -rewrite (: size s + q * 8 = q * 8 + size s) 1:/#. -rewrite -modzDmr. -move => *. -rewrite (_: size s %% r = r - 8 * q ) 1:/#. -by rewrite (: q * 8 + (r - 8 * q) = r) 1:/# modzz. -qed. - -lemma nseq_cat n1 n2 : - nseq n1 false ++ nseq n2 false = nseq (max 0 n1 + max 0 n2) false. -admitted. - -lemma nseq_comp n1 n2 : - flatten (nseq n1 (nseq n2 false)) = nseq (max 0 n1 * max 0 n2) false. -admitted. - -lemma samepad s : - size s %% 8 = 0 => - bytewisepad s = pad (s ++ domain_bits ++ suffix_bits). -move => *. -rewrite /bytewisepad /padbytes /pad /mkpad /num0. -progress. -case (r %/ 8 - size s %/ 8 %% (r %/ 8) = 1). -move => *. -rewrite /pad1byte. -rewrite flatten_seq1. -rewrite -catA -catA -catA -catA -catA. -apply eqseq_cat. by trivial. simplify. -rewrite -catA. -apply eqseq_cat. by trivial. simplify. -apply eqseq_cat. by trivial. simplify. -move : (bound_conv s 1 H H0) => *. -rewrite (_: 8 - size domain_bits - size suffix_bits - 2 = (- (size (s ++ domain_bits ++ suffix_bits) + 2)) %% r). -rewrite !size_cat. -rewrite domain_bits_len. -case (size suffix_bits = 0). -move => suffix_bits_len. -rewrite suffix_bits_len. -simplify. -rewrite modNz. smt(size_ge0). exact/Block.gt0_n. -simplify. ring. -rewrite (_: size s + 3 = (size s + 1*8) - 5 ). smt(). -rewrite -modzDm. rewrite H1. simplify. -rewrite modz_mod modNz. smt(). exact/Block.gt0_n. -rewrite modz_small. smt(Block.gt0_n rsize). by ring. -move => *. -case (size suffix_bits = 1). -move => suffix_bits_len. -rewrite suffix_bits_len. -simplify. -rewrite modNz. smt(size_ge0). smt(Block.gt0_n). -simplify. ring. -rewrite (_: size s + 4 = (size s + 1*8) - 4 ). smt(). -rewrite -modzDm. rewrite H1. simplify. -rewrite modz_mod modNz. smt(). smt(Block.gt0_n). -rewrite modz_small. smt(Block.gt0_n rsize). by ring. -move => *. -rewrite (_: size suffix_bits = 2). smt(size_ge0 suffix_bits_len). -simplify. -rewrite modNz. smt(size_ge0). smt(Block.gt0_n). -simplify. ring. -rewrite (_: size s + 5 = (size s + 1*8) - 3 ). smt(). -rewrite -modzDm. rewrite H1. simplify. -rewrite modz_mod modNz. smt(). smt(Block.gt0_n). -rewrite modz_small. smt(Block.gt0_n rsize). by ring. -by rewrite cats1 catA. -move => *. -rewrite /padqstart /padqend. -pose q := r %/ 8 - size s %/ 8 %% (r %/ 8). -rewrite flatten_cons. -rewrite -catA -catA -catA -catA -catA. -rewrite (eqseq_cat). by trivial. simplify. -rewrite (eqseq_cat). by trivial. simplify. -rewrite (eqseq_cat). by trivial. simplify. -rewrite (_: flatten (nseq (q - 2) padq0 ++ - [[false; false; false; false; false; false; false; true]]) = - rcons (nseq (8*(q-2) + 7) false) true). -rewrite flatten_cat flatten_seq1. -rewrite -cats1. -have padlength_ge0: 0 <= 8 * (q - 2). -+ smt(gt0_r rsize). -rewrite (_ : 8 * (q - 2) + 7 = 8 * (q - 2) + 6 + 1); first by smt(). -rewrite nseqSr. smt(). -rewrite cat_rcons. -rewrite (_ : 8 * (q - 2) + 6 = 8 * (q - 2) + 5 + 1); first by smt(). -rewrite nseqSr. smt(). -rewrite cat_rcons. -rewrite (_ : 8 * (q - 2) + 5 = 8 * (q - 2) + 4 + 1); first by smt(). -rewrite nseqSr. smt(). -rewrite cat_rcons. -rewrite (_ : 8 * (q - 2) + 4 = 8 * (q - 2) + 3 + 1); first by smt(). -rewrite nseqSr. smt(). -rewrite cat_rcons. -rewrite (_ : 8 * (q - 2) + 3 = 8 * (q - 2) + 2 + 1); first by smt(). -rewrite nseqSr. smt(). -rewrite cat_rcons. -rewrite (_ : 8 * (q - 2) + 2 = 8 * (q - 2) + 1 + 1); first by smt(). -rewrite nseqSr. smt(). -rewrite cat_rcons. -rewrite nseqSr. smt(). -rewrite cat_rcons. -rewrite /padq0. -rewrite nseq_comp. smt(). -rewrite (_ : nseq (8 - size domain_bits - size suffix_bits - 1) false ++ -rcons (nseq (8 * (q - 2) + 7) false) true = - rcons (nseq (8 - size domain_bits - size suffix_bits - 1 + 8 * (q - 2) + 7) false) true). rewrite -rcons_cat. -rewrite nseq_cat max_ler 1:[smt(domain_bits_len suffix_bits_len)] max_ler 1:[smt(gt0_r rsize)]. -rewrite (_ : 8 - size domain_bits - size suffix_bits - 1 + (8 * (q - 2) + 7) = 8 - size domain_bits - size suffix_bits - 1 + 8 * (q - 2) + 7). by ring. -by trivial. -rewrite (_: 8 - size domain_bits - size suffix_bits - 1 + 8 * (q - 2) + 7= (- (size (s ++ domain_bits ++ suffix_bits) + 2)) %% r). -rewrite !size_cat. -rewrite domain_bits_len. -have qval : (r %/ 8 - size s %/ 8 %% (r %/ 8) = q). smt(). -move : (bound_conv s q H qval) => *. -have qlbound : 1 <= q. smt(gt0_r rsize). -have qubound : q * 8 <= r. smt(gt0_r rsize). -case (size suffix_bits = 0). -move => suffix_bits_len. -rewrite suffix_bits_len. -simplify. -ring. -rewrite modNz. smt(size_ge0). smt(gt0_r). -simplify. ring. -move : (dvdzP (r)(size s + q * 8)) => [ ] *. -move : (H2 H1). -progress. -rewrite (_: size s = q0*r - q*8). smt(). -rewrite (_ : (q0 * r - q * 8 + 3) %% r = (-(q*8 - 3)) %% r). -rewrite (_ : (q0 * r - q * 8 + 3) %% r = (q0 * r + (- q * 8 + 3)) %% r). -smt(). -rewrite (modzMDl). smt(). -have same : (- ( q * 8 - 3)) %% r = r - (q*8 - 3). -rewrite (modNz (q * 8 - 3) r). smt(gt0_r rsize). smt(gt0_r). -ring. -rewrite modz_small. smt(). smt(gt0_r rsize). -smt(gt0_r rsize). -move => *. -case (size suffix_bits = 1). -move => suffix_bits_len. -rewrite suffix_bits_len. -simplify. -ring. -rewrite modNz. smt(size_ge0). smt(gt0_r). -simplify. ring. -move : (dvdzP (r)(size s + q * 8)) => [ ] *. -move : (H3 H1). -progress. -rewrite (_: size s = q0*r - q*8). smt(). -rewrite (_ : (q0 * r - q * 8 + 4) %% r = (-(q*8 - 4)) %% r). -rewrite (_ : (q0 * r - q * 8 + 4) %% r = (q0 * r + (- q * 8 + 4)) %% r). -smt(). -rewrite (modzMDl). smt(). -have same : (- ( q * 8 - 4)) %% r = r - (q*8 - 4). -rewrite (modNz (q * 8 - 4) r). smt(gt0_r rsize). smt(gt0_r). -ring. -rewrite modz_small. smt(). smt(gt0_r rsize). -smt(gt0_r rsize). -move => *. -rewrite (_ : size suffix_bits = 2). smt(size_ge0 suffix_bits_len). -simplify. -ring. -rewrite modNz. smt(size_ge0). smt(gt0_r). -simplify. ring. -move : (dvdzP (r)(size s + q * 8)) => [ ] *. -move : (H4 H1). -progress. -rewrite (_: size s = q0*r - q*8). smt(). -rewrite (_ : (q0 * r - q * 8 + 5) %% r = (-(q*8 - 5)) %% r). -rewrite (_ : (q0 * r - q * 8 + 5) %% r = (q0 * r + (- q * 8 + 5)) %% r). -smt(). -rewrite (modzMDl). smt(). -have same : (- ( q * 8 - 5)) %% r = r - (q*8 - 5). -rewrite (modNz (q * 8 - 5) r). smt(gt0_r rsize). smt(gt0_r). -ring. -rewrite modz_small. smt(). smt(gt0_r rsize). -smt(gt0_r rsize). -by trivial. -qed. - -lemma sizepload mem inp inl: (size (memr2bits mem inp inl) = 8 * (max 0 inl)). -rewrite /memr2bits. -simplify. -rewrite size_flatten. -auto => />. -rewrite /sumz. -rewrite -map_comp /(\o) => //=. -rewrite foldr_map. -rewrite (_ : 8*(max 0 inl) = 8* (size (iota_ 0 inl))). rewrite size_iota. by trivial. -elim (iota_ 0 inl). smt. smt. -qed. - -lemma blocksizes mem inp inl b: - b \in (loadpad2wblocks mem inp inl) => size b = r %/ 64. -rewrite /loadpad2wblocks samepad. smt. -simplify. -rewrite /bits2blocks. -have sizebs : forall b0, - b0 \in (map mkblock - (chunk (pad (memr2bits mem inp inl ++ domain_bits ++ suffix_bits)))) => - size (ofblock b0) = r. -move => b0 H. -apply (size_block b0). -have sizecs : forall b0, - b0 \in (map mkblock - (chunk (pad (memr2bits mem inp inl ++ domain_bits ++ suffix_bits)))) => - size ((BitEncoding.BitChunking.chunk 64 (ofblock b0))) = r %/ 64. -smt. -move => H. -move : (mapP - (fun (b0 : block) => - map W64.bits2w (BitEncoding.BitChunking.chunk 64 (ofblock b0))) - ((map mkblock - (chunk - (pad (memr2bits mem inp inl ++ domain_bits ++ suffix_bits))))) b). -smt. -qed. - -(* Stores up to len bytes in memory from list of blocks *) -op storeblocks : global_mem_t -> int -> int -> wblock list -> global_mem_t. - -op state0 : state = Array25.of_list (W64.of_int 0) []. - -op squeezeb(st : state) = take (r %/ 64) (to_list st). - -op wblock0 : wblock = take (r %/ 64) (to_list state0). - -op combine(st : state, wb : wblock) : state = - let stl = to_list st in - let wbst = take (r %/ 64) stl in - let wbstc = map (fun x : W64.t * W64.t => x.`1 `^` x.`2) (zip wbst wb) in - Array25.of_list (W64.of_int 0) (wbstc ++ (drop (r %/ 64) stl)). - -op convb(outl : int) = (outl*8 + r - 1) %/ r. - -module Spec(P : PermT) = { - proc f(out : int, outlen : int, inp : int, inlen : int) = { - var z,st,i,xs; - z <- []; - st <- state0; - i <- 0; - xs <- loadpad2wblocks Glob.mem inp inlen; - while (xs <> []){ - st <@ P.perm(combine st (head wblock0 xs)); - xs <- behead xs; - } - while (i < convb outlen){ - z <- z ++ [squeezeb st]; - i <- i + 1; - if (i < convb outlen) - st <@ P.perm(st); - } - - Glob.mem <- storeblocks Glob.mem out outlen z; - } -}. - -section. - -declare module Pideal : DPRIMITIVE. -declare module Preal : PermT {Glob}. (* Note it cannot touch memory *) - -axiom perm_correct : - equiv [Pideal.f ~ Preal.perm : - x{1} = state2bc st{2} ==> - res{1} = state2bc res{2}]. - -op wblock2block(wb : wblock) : block = - mkblock (flatten (map W64.w2bits wb)). - -op wblocks2bits(wbs : wblock list) : bool list = - flatten (List.map (fun bl => ofblock (wblock2block bl)) wbs). - -op wblock2bits_list(wbs : wblock list) : block list = - map wblock2block wbs. - -lemma wblocks2bits_empty : [] = wblocks2bits [] by auto => />. - -lemma state0conv : (b0, c0) = state2bc state0. -rewrite /state2bc /b0 /c0 /offun. -rewrite (_: flatten (map W64.w2bits (to_list state0)) = (mkseq (fun _ => false) (r+c))). -rewrite /state0 /to_list wstate_size_val. -apply (eq_from_nth witness). -rewrite size_mkseq. -move : (wstate_size (Array25.of_list witness (mkseq (fun (i : int) => (of_list W64.zero []).[i]) 25))). -rewrite of_listK. apply size_mkseq. -move => *. rewrite H. -rewrite wstate_size_val. smt(). -rewrite (_ : size - (flatten - (map W64.w2bits - (mkseq (fun (i0 : int) => (of_list W64.zero []).[i0]) 25))) = 1600). -move : (wstate_size (Array25.of_list witness (mkseq (fun (i : int) => (of_list W64.zero []).[i]) 25))). -rewrite of_listK. apply size_mkseq. -rewrite wstate_size_val. smt(). -move => *. -rewrite (_: nth witness (mkseq (fun _ => false) (1600)) i = false). -rewrite nth_mkseq. smt(). smt(). -rewrite (_: (mkseq (fun (i0 : int) => (of_list W64.zero []).[i0]) 25) = - (W64.zero :: W64.zero :: W64.zero :: W64.zero :: W64.zero :: - W64.zero :: W64.zero :: W64.zero :: W64.zero :: W64.zero :: - W64.zero :: W64.zero :: W64.zero :: W64.zero :: W64.zero :: - W64.zero :: W64.zero :: W64.zero :: W64.zero :: W64.zero :: - W64.zero :: W64.zero :: W64.zero :: W64.zero :: W64.zero :: [])). -by auto => />. -rewrite (_: - (foldr (fun (bl : W64.t) (bs : bool list) => w2bits bl ++ bs) [] - [W64.zero; W64.zero; W64.zero; W64.zero; W64.zero; W64.zero; W64.zero; - W64.zero; W64.zero; W64.zero; W64.zero; W64.zero; W64.zero; W64.zero; - W64.zero; W64.zero; W64.zero; W64.zero; W64.zero; W64.zero; W64.zero; - W64.zero; W64.zero; W64.zero; W64.zero]) = - (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ - (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ - (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ - (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ - (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero) ++ (w2bits W64.zero)). -by auto => />. -rewrite /w2bits. -rewrite -mkseq_add. smt(). smt(). -rewrite -mkseq_add. smt(). smt(). -rewrite -mkseq_add. smt(). smt(). -rewrite -mkseq_add. smt(). smt(). -rewrite -mkseq_add. smt(). smt(). -rewrite -mkseq_add. smt(). smt(). -rewrite -mkseq_add. smt(). smt(). -rewrite -mkseq_add. smt(). smt(). -rewrite -mkseq_add. smt(). smt(). -rewrite -mkseq_add. smt(). smt(). -rewrite -mkseq_add. smt(). smt(). -rewrite -mkseq_add. smt(). smt(). -rewrite -mkseq_add. smt(). smt(). -rewrite -mkseq_add. smt(). smt(). -rewrite -mkseq_add. smt(). smt(). -rewrite -mkseq_add. smt(). smt(). -rewrite -mkseq_add. smt(). smt(). -rewrite -mkseq_add. smt(). smt(). -rewrite -mkseq_add. smt(). smt(). -rewrite -mkseq_add. smt(). smt(). -rewrite -mkseq_add. smt(). smt(). -rewrite -mkseq_add. smt(). smt(). -rewrite -mkseq_add. smt(). smt(). -rewrite -mkseq_add. smt(). smt(). -simplify. -rewrite nth_mkseq. -smt(). smt(). -rewrite mkseq_add. smt. smt. -pose stbits := mkseq (fun _ => false) r ++ - mkseq (fun (i : int) => (fun _ => false) (r + i)) c. -simplify. -split. -rewrite (_:take r stbits = mkseq (fun _ => false) r). -rewrite take_cat. -rewrite size_mkseq. -rewrite (_ : r < max 0 r = false); first by smt. -simplify. -rewrite (_ : r - max 0 r = 0); first by smt. -rewrite take0 cats0. -by trivial. -by trivial. -rewrite drop_cat. -rewrite size_mkseq. -rewrite (_ : r < max 0 r = false); first by smt. -simplify. -rewrite (_ : r - max 0 r = 0); first by smt. -rewrite drop0. -by trivial. -qed. - -lemma paddings_same mem inp inl: - pad (memr2bits mem inp inl ++ domain_bits ++ suffix_bits) = - wblocks2bits (loadpad2wblocks mem inp inl). -rewrite /loadpad2wblocks samepad. smt. -rewrite /wblocks2bits. -pose ll := pad (memr2bits mem inp inl ++ domain_bits ++ suffix_bits). -simplify. -rewrite /wblock2block -map_comp -map_comp /(\o) => //=. -have sizell : size ll %% 64 = 0. smt. -have sizebs : forall x, x \in chunk ll => size x = r. smt. -have sizebs1 : forall x, x \in chunk ll => forall y, y \in (BitEncoding.BitChunking.chunk 64 x) => size y = 64. smt. -have xx : (forall x, x \in chunk ll => (flatten - (map W64.w2bits - (map W64.bits2w - ((BitEncoding.BitChunking.chunk 64 (ofblock (mkblock x))))))) = x). -move => *. rewrite ofblockK. smt. -rewrite -map_comp. -rewrite (_: map (W64.w2bits \o W64.bits2w) (BitEncoding.BitChunking.chunk 64 x) = BitEncoding.BitChunking.chunk 64 x). rewrite /(\o). -have xxx : forall x0, x0 \in ((BitEncoding.BitChunking.chunk 64 x)) => w2bits ((bits2w x0))%W64 = x0. -move : (sizebs1 x H) => *. -move => *. -move : (sizebs1 x H x0 H1). move => *. -apply (W64.bits2wK) => //=. -rewrite {2} (_ : (BitEncoding.BitChunking.chunk 64 x) = map (fun x => x) (BitEncoding.BitChunking.chunk 64 x)). rewrite (id_map). smt(). by trivial. -move : (eq_in_map ((fun (x0 : bool list) => w2bits ((bits2w x0))%W64)) (fun x => x) (BitEncoding.BitChunking.chunk 64 x)) => [/ # [ ]] *. -move : (H0 xxx). smt(). -apply (BitEncoding.BitChunking.chunkK 64 _ _ _). smt(). smt. -have : (forall (x : bool list), - x \in chunk ll => - (fun (x0 : bool list) => - ofblock - (mkblock - (flatten - (map W64.w2bits - (map W64.bits2w - ((BitEncoding.BitChunking.chunk 64 (ofblock (mkblock x0))))))))) x = x). -progress. -move : (xx x H) => *. -rewrite H0. apply ofblockK. smt. -move => *. -rewrite (_ : (map - (fun (x : bool list) => - ofblock - (mkblock - (flatten - (map W64.w2bits - (map W64.bits2w - ((BitEncoding.BitChunking.chunk 64 (ofblock (mkblock x))))))))) - (chunk ll)) = chunk ll). -rewrite {2} (_: chunk ll = map (fun x => x) (chunk ll)). rewrite (id_map). smt(). by trivial. -move : (eq_in_map ((fun (x0 : bool list) => - ofblock - (mkblock - (flatten - (map W64.w2bits - (map W64.bits2w - ((BitEncoding.BitChunking.chunk 64 (ofblock (mkblock x0)))))))))) - (fun x0 => x0) (chunk ll)) => [/ # [ ]] *. -move : (H0 H). smt(). -rewrite chunkK. smt. -by trivial. -qed. - -lemma liftpadding mem inp inl : - pad2blocks (memr2bits mem inp inl ++ domain_bits ++ suffix_bits) = - wblock2bits_list (loadpad2wblocks mem inp inl). -rewrite /pad2blocks /(\o) paddings_same /wblocks2bits => //=. -rewrite /bits2blocks. -rewrite flattenK. -move => b. -rewrite /loadpad2wblocks samepad. smt. -simplify. -pose ll := pad (memr2bits mem inp inl ++ domain_bits ++ suffix_bits). -rewrite /wblock2block -map_comp -map_comp /(\o) => //=. -have sizell : size ll %% 64 = 0. smt. -have sizebs : forall x, x \in chunk ll => size x = r. smt. - -have sizebs1 : forall x, x \in chunk ll => forall y, y \in (BitEncoding.BitChunking.chunk 64 x) => size y = 64. smt. -have xx : (forall x, x \in chunk ll => (flatten - (map W64.w2bits - (map W64.bits2w - ((BitEncoding.BitChunking.chunk 64 (ofblock (mkblock x))))))) = x). -move => *. rewrite ofblockK. smt. -rewrite -map_comp. -rewrite (_: map (W64.w2bits \o W64.bits2w) (BitEncoding.BitChunking.chunk 64 x) = BitEncoding.BitChunking.chunk 64 x). rewrite /(\o). -have xxx : forall x0, x0 \in ((BitEncoding.BitChunking.chunk 64 x)) => w2bits ((bits2w x0))%W64 = x0. -move : (sizebs1 x H) => *. -move => *. -move : (sizebs1 x H x0 H1). move => *. -apply (W64.bits2wK) => //=. -rewrite {2} (_ : (BitEncoding.BitChunking.chunk 64 x) = map (fun x => x) (BitEncoding.BitChunking.chunk 64 x)). rewrite (id_map). smt(). by trivial. -move : (eq_in_map ((fun (x0 : bool list) => w2bits ((bits2w x0))%W64)) (fun x => x) (BitEncoding.BitChunking.chunk 64 x)) => [/ # [ ]] *. -move : (H0 xxx). smt(). -apply (BitEncoding.BitChunking.chunkK 64 _ _ _). smt(). smt. -have : (forall (x : bool list), - x \in chunk ll => - (fun (x0 : bool list) => - ofblock - (mkblock - (flatten - (map W64.w2bits - (map W64.bits2w - ((BitEncoding.BitChunking.chunk 64 (ofblock (mkblock x0))))))))) x = x). -progress. -move : (xx x H) => *. -rewrite H0. apply ofblockK. smt. -move => H. -rewrite (_ : (map - (fun (x : bool list) => - ofblock - (mkblock - (flatten - (map W64.w2bits - (map W64.bits2w - ((BitEncoding.BitChunking.chunk 64 (ofblock (mkblock x))))))))) - (chunk ll)) = chunk ll). -rewrite {2} (_: chunk ll = map (fun x => x) (chunk ll)). rewrite (id_map). smt(). by trivial. -move : (eq_in_map ((fun (x0 : bool list) => - ofblock - (mkblock - (flatten - (map W64.w2bits - (map W64.bits2w - ((BitEncoding.BitChunking.chunk 64 (ofblock (mkblock x0)))))))))) - (fun x0 => x0) (chunk ll)) => [/ # [ ]] *. -move : (H0 H). smt(). smt. -rewrite -map_comp /(\o) /wblock2bits_list /wblock2block. -apply eq_map. progress. rewrite mkblockK. by trivial. -qed. - -lemma lift_combine sa sc st xs : - (sa, sc) = state2bc st => - (sa +^ head b0 (wblock2bits_list xs), sc) = - state2bc (combine st (head wblock0 xs)) - by admit. (* provable *) - -lemma behead_wblockl xs : - behead (wblock2bits_list xs) = wblock2bits_list (behead xs). -rewrite /wblock2bits_list . -elim xs;smt(). -qed. - -lemma behead_wblocke xs : - behead (wblock2bits_list xs) = [] <=> behead xs = []. -rewrite /wblock2bits_list . -elim xs;smt(). -qed. - -lemma wbblockle xs : - wblock2bits_list xs = [] => xs = []. -rewrite /wblock2bits_list . -elim xs;smt(). -qed. - -lemma wbblockle_ : [] = wblock2bits_list []. -rewrite /wblock2bits_list . -smt(). -qed. - -lemma commuteappend z sa st sc : - (sa, sc) = state2bc st => - wblocks2bits z ++ ofblock sa = wblocks2bits (z ++ [squeezeb st]). -rewrite /state2bc => //=. move => [/ # ] *. -rewrite /wblocks2bits /wblock2block. -rewrite H. rewrite ofblockK. smt. -rewrite /squeezeb. - admit. (* provable *) -qed. - -op validins(n : int, outl : int) = - n = outl * 8. - -lemma sizes1 i n1 n2 : validins n1 n2 => - i < (n1 + r - 1) %/ r => - i < convb n2 by smt. - -lemma sizes2 i n1 n2 : validins n1 n2 => - i < convb n2 => - i < (n1 + r - 1) %/ r by smt. - -(* Will need to be proved once storeblocks is defined. *) -lemma store_blocks_safe mem out outlen z : - eqmem_except mem (storeblocks mem out outlen z) out outlen by admit. - -(* Will need to be proved once storeblocks is defined *) -lemma storeblocks_correct mem out outlen n z : - validins n outlen => - take n (wblocks2bits z) = - memr2bits (storeblocks mem out outlen z) out outlen by admit. - -lemma spec_correct mem outp outl: -equiv [ Sponge(Pideal).f ~ Spec(Preal).f : - Glob.mem{2} = mem /\ - bs{1} = memr2bits mem inp{2} inlen{2} ++ domain_bits ++ suffix_bits /\ - outlen{2} = outl /\ validins n{1} outlen{2} /\ out{2} = outp - ==> eqmem_except mem Glob.mem{2} outp outl /\ - res{1} = memr2bits Glob.mem{2} outp outl]. -proc. -seq 4 4 : ( -#pre /\ -z{1} = wblocks2bits z{2} /\ -(sa{1},sc{1}) = state2bc st{2} /\ -={i} /\ xs{1} = wblock2bits_list xs{2} -); first by wp;skip;smt(wblocks2bits_empty state0conv liftpadding). -seq 1 1 : #pre. -while #pre. -by wp;call (perm_correct); wp;skip; smt(lift_combine behead_wblockl behead_wblocke). -by skip; smt(behead_wblockl behead_wblocke). -seq 1 1 : #pre. -while #pre. -seq 2 2 : #[/:-2]pre; first by wp;skip; smt(commuteappend). -if => //=. -progress. -apply(sizes1 i{2} n{1} outlen{2} H) => //=. -apply(sizes2 i{2} n{1} outlen{2} H) => //=. -call perm_correct;skip;progress => //=. -apply(sizes1 i{2} n{1} outlen{2} H) => //=. -skip;progress => //=. -apply(sizes2 i{2} n{1} outlen{2} H) => //=. -skip;progress => //=. -apply(sizes1 i{2} n{1} outlen{2} H) => //=. -apply(sizes2 i{2} n{1} outlen{2} H) => //=. -wp;skip;progress;smt(store_blocks_safe storeblocks_correct). -qed. - -end section. From dc3b268c4855f4a6c637a2fbb07d0ea7dec6f57d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jos=C3=A9=20Bacelar=20Almeida?= Date: Thu, 16 May 2019 13:50:41 +0100 Subject: [PATCH 424/525] remove old file --- proof/impl/keccak.ec | 743 ------------------------------------------- 1 file changed, 743 deletions(-) delete mode 100644 proof/impl/keccak.ec diff --git a/proof/impl/keccak.ec b/proof/impl/keccak.ec deleted file mode 100644 index 08742f2..0000000 --- a/proof/impl/keccak.ec +++ /dev/null @@ -1,743 +0,0 @@ -require import List Int IntExtra IntDiv CoreMap. -from Jasmin require import JModel. - -require Spec. -clone import Spec as Spc. -import Spc.Spnge. -import Common. - -clone export PolyArray as Array5 with op size <- 5. - -clone export WArray as WArray200 with op size <- 200. -clone export WArray as WArray40 with op size <- 40. - - -op x86_ROL_64 : W64.t -> W8.t -> bool * bool * W64.t. -op set0_64 : bool * bool * bool * bool * bool * W64.t. -op x86_TEST_8 : W8.t -> W8.t -> bool * bool * bool * bool * bool. - -(* -require import List Int IntExtra Int_Div CoreMap. -from Jasmin require import JModel. - -require import Array5 Array25. -require import WArray40 WArray200. -*) - -module M = { - proc spill_2 (a:W64.t, b:W64.t) : W64.t * W64.t = { - - var sa:W64.t; - var sb:W64.t; - - sa <- a; - sb <- b; - return (sa, sb); - } - - proc load_2 (sa:W64.t, sb:W64.t) : W64.t * W64.t = { - - var a:W64.t; - var b:W64.t; - - a <- sa; - b <- sb; - return (a, b); - } - (* - proc rOL64 (x:W64.t, c:int) : W64.t = { - - var y:W64.t; - var _0:bool; - var _1:bool; - - if ((c = 0)) { - y <- x; - } else { - ( _0, _1, y) <- x86_ROL_64 x (W8.of_int c); - } - return (y); - } - *) - proc keccak_init (m:W64.t) : W64.t Array25.t = { - - var state:W64.t Array25.t; - var t:W64.t; - var i:W64.t; - var _0:bool; - var _1:bool; - var _2:bool; - var _3:bool; - var _4:bool; - state <- witness; - ( _0, _1, _2, _3, _4, t) <- set0_64 ; - i <- (W64.of_int 0); - - while ((i \ult (W64.of_int 50))) { - state.[(W64.to_uint i)] <- t; - i <- (i + (W64.of_int 1)); - } - return (state); - } - (* - proc index (x:int, y:int) : int = { - - var r:int; - - r <- ((5 * (x %% 5)) + (y %% 5)); - return (r); - } - - proc keccak_rho_offsets (i:int) : int = { - var aux: int; - - var r:int; - var x:int; - var y:int; - var t:int; - var z:int; - - r <- 0; - x <- 1; - y <- 0; - t <- 0; - while (t < 24) { - if ((i = (x + (5 * y)))) { - r <- ((((t + 1) * (t + 2)) %/ 2) %% 64); - } else { - - } - z <- (((2 * x) + (3 * y)) %% 5); - x <- y; - y <- z; - t <- t + 1; - } - return (r); - } - - proc rhotates (x:int, y:int) : int = { - - var r:int; - var i:int; - - i <@ index (x, y); - r <@ keccak_rho_offsets (i); - return (r); - } - - proc theta_sum (A:W64.t Array25.t) : W64.t Array5.t = { - var aux: int; - - var _C:W64.t Array5.t; - var i:int; - var j:int; - _C <- witness; - i <- 0; - while (i < 5) { - _C.[i] <- A.[((5 * (0 %% 5)) + (i %% 5))]; - j <- 1; - while (j < 5) { - _C.[i] <- (_C.[i] `^` A.[((5 * (j %% 5)) + (i %% 5))]); - j <- j + 1; - } - i <- i + 1; - } - return (_C); - } - - proc theta_rol (_C:W64.t Array5.t) : W64.t Array5.t = { - var aux: int; - - var _D:W64.t Array5.t; - var i:int; - var r:W64.t; - _D <- witness; - i <- 0; - while (i < 5) { - r <@ rOL64 (_C.[((i + 1) %% 5)], 1); - _D.[i] <- r; - _D.[i] <- (_D.[i] `^` _C.[((i + 4) %% 5)]); - i <- i + 1; - } - return (_D); - } - - proc rol_sum (_D:W64.t Array5.t, A:W64.t Array25.t, offset:int) : W64.t Array5.t = { - var aux: int; - - var _C:W64.t Array5.t; - var j:int; - var j1:int; - var k:int; - var t:W64.t; - _C <- witness; - j <- 0; - while (j < 5) { - j1 <- ((j + offset) %% 5); - k <@ rhotates (j, j1); - t <- A.[((5 * (j %% 5)) + (j1 %% 5))]; - t <- (t `^` _D.[j1]); - t <@ rOL64 (t, k); - _C.[j] <- t; - j <- j + 1; - } - return (_C); - } - - proc set_row (_R:W64.t Array25.t, row:int, _C:W64.t Array5.t, iota_0:W64.t) : - W64.t Array25.t = { - var aux: int; - - var j:int; - var j1:int; - var j2:int; - var t:W64.t; - - j <- 0; - while (j < 5) { - j1 <- ((j + 1) %% 5); - j2 <- ((j + 2) %% 5); - t <- ((invw _C.[j1]) `&` _C.[j2]); - if (((row = 0) /\ (j = 0))) { - t <- (t `^` iota_0); - } else { - - } - t <- (t `^` _C.[j]); - _R.[((5 * (row %% 5)) + (j %% 5))] <- t; - j <- j + 1; - } - return (_R); - } - - proc round2x (A:W64.t Array25.t, _R:W64.t Array25.t, iotas:W64.t, o:int) : - W64.t Array25.t * W64.t Array25.t = { - - var iota_0:W64.t; - var _C:W64.t Array5.t; - var _D:W64.t Array5.t; - _C <- witness; - _D <- witness; - iota_0 <- (loadW64 Glob.mem (W64.to_uint (iotas + (W64.of_int o)))); - _C <@ theta_sum (A); - _D <@ theta_rol (_C); - _C <@ rol_sum (_D, A, 0); - _R <@ set_row (_R, 0, _C, iota_0); - _C <@ rol_sum (_D, A, 3); - _R <@ set_row (_R, 1, _C, iota_0); - _C <@ rol_sum (_D, A, 1); - _R <@ set_row (_R, 2, _C, iota_0); - _C <@ rol_sum (_D, A, 4); - _R <@ set_row (_R, 3, _C, iota_0); - _C <@ rol_sum (_D, A, 2); - _R <@ set_row (_R, 4, _C, iota_0); - return (A, _R); - } - *) - proc keccak_f (A:W64.t Array25.t, iotas:W64.t) : W64.t Array25.t * W64.t = { - (* - var zf:bool; - var _R:W64.t Array25.t; - var _0:bool; - var _1:bool; - var _2:bool; - var _3:bool; - _R <- witness; - (A, _R) <@ round2x (A, _R, iotas, 0); - (_R, A) <@ round2x (_R, A, iotas, 8); - iotas <- (iotas + (W64.of_int 16)); - ( _0, _1, _2, _3, zf) <- x86_TEST_8 (truncateu8 iotas) - (W8.of_int 255); - while ((! zf)) { - (A, _R) <@ round2x (A, _R, iotas, 0); - (_R, A) <@ round2x (_R, A, iotas, 8); - iotas <- (iotas + (W64.of_int 16)); - ( _0, _1, _2, _3, zf) <- x86_TEST_8 (truncateu8 iotas) - (W8.of_int 255); - } - iotas <- (iotas - (W64.of_int 192));*) - return (A, iotas); - } - - proc keccak_1600_add_full_block (state:W64.t Array25.t, in_0:W64.t, - inlen:W64.t, rate_in_bytes:int) : - W64.t Array25.t * W64.t * W64.t = { - var aux: int; - - var i:int; - var t:W64.t; - - aux <- (rate_in_bytes %/ 8); - i <- 0; - while (i < aux) { - t <- (loadW64 Glob.mem (W64.to_uint (in_0 + (W64.of_int (8 * i))))); - state.[i] <- (state.[i] `^` t); - i <- i + 1; - } - in_0 <- (in_0 + (W64.of_int rate_in_bytes)); - inlen <- (inlen - (W64.of_int rate_in_bytes)); - return (state, in_0, inlen); - } - - proc keccak_1600_add_final_block (state:W64.t Array25.t, in_0:W64.t, - inlen:W64.t, suffix:int, - rate_in_bytes:int) : W64.t Array25.t = { - - var inlen8:W64.t; - var i:W64.t; - var t:W64.t; - var c:W8.t; - - inlen8 <- inlen; - inlen8 <- (inlen8 `>>` (W8.of_int 3)); - i <- (W64.of_int 0); - - while ((i \ult inlen8)) { - t <- (loadW64 Glob.mem (W64.to_uint (in_0 + ((W64.of_int 8) * i)))); - state.[(W64.to_uint i)] <- (state.[(W64.to_uint i)] `^` t); - i <- (i + (W64.of_int 1)); - } - i <- (i `<<` (W8.of_int 3)); - - while ((i \ult inlen)) { - c <- (loadW8 Glob.mem (W64.to_uint (in_0 + i))); - state = - Array25.init - (WArray200.get64 (WArray200.set8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i) ( - (get8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i)) `^` c))); - i <- (i + (W64.of_int 1)); - } - state = - Array25.init - (WArray200.get64 (WArray200.set8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i) ( - (get8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i)) `^` (W8.of_int suffix)))); - state = - Array25.init - (WArray200.get64 (WArray200.set8 (WArray200.init64 (fun i => state.[i])) (rate_in_bytes - 1) ( - (get8 (WArray200.init64 (fun i => state.[i])) (rate_in_bytes - 1)) `^` (W8.of_int 128)))); - return (state); - } - - proc keccak_1600_absorb (state:W64.t Array25.t, iotas:W64.t, in_0:W64.t, - inlen:W64.t, suffix:int, rate_in_bytes:int) : - W64.t Array25.t * W64.t = { - - var s_in:W64.t; - var s_inlen:W64.t; - - - while (((W64.of_int rate_in_bytes) \ule inlen)) { - (state, in_0, inlen) <@ keccak_1600_add_full_block (state, in_0, inlen, - rate_in_bytes); - (s_in, s_inlen) <@ spill_2 (in_0, inlen); - (state, iotas) <@ keccak_f (state, iotas); - (in_0, inlen) <@ load_2 (s_in, s_inlen); - } - state <@ keccak_1600_add_final_block (state, in_0, inlen, suffix, - rate_in_bytes); - (state, iotas) <@ keccak_f (state, iotas); - return (state, iotas); - } - - proc keccak_1600_xtr_block (state:W64.t Array25.t, out:W64.t, len:W64.t) : - W64.t = { - - var len8:W64.t; - var i:W64.t; - var t:W64.t; - var c:W8.t; - - len8 <- len; - len8 <- (len8 `>>` (W8.of_int 3)); - i <- (W64.of_int 0); - - while ((i \ult len8)) { - t <- state.[(W64.to_uint i)]; - Glob.mem <- - storeW64 Glob.mem (W64.to_uint (out + ((W64.of_int 8) * i))) t; - i <- (i + (W64.of_int 1)); - } - i <- (i `<<` (W8.of_int 3)); - - while ((i \ult len)) { - c <- (get8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i)); - Glob.mem <- storeW8 Glob.mem (W64.to_uint (out + i)) c; - i <- (i + (W64.of_int 1)); - } - out <- (out + len); - return (out); - } - - proc keccak_1600_squeeze (state:W64.t Array25.t, iotas:W64.t, out:W64.t, - rate_in_bytes:int, i_hash_bytes:int) : unit = { - - var s_hash_bytes:W64.t; - var s_out:W64.t; - var hash_bytes:W64.t; - - s_hash_bytes <- (W64.of_int i_hash_bytes); - - while (((W64.of_int rate_in_bytes) \ult s_hash_bytes)) { - out <@ keccak_1600_xtr_block (state, out, (W64.of_int rate_in_bytes)); - s_out <- out; - (state, iotas) <@ keccak_f (state, iotas); - s_hash_bytes <- (s_hash_bytes - (W64.of_int rate_in_bytes)); - out <- s_out; - } - hash_bytes <- s_hash_bytes; - out <@ keccak_1600_xtr_block (state, out, hash_bytes); - return (); - } - - proc keccak_1600 (out:W64.t, in_0:W64.t, inlen:W64.t, iotas:W64.t, m:W64.t, - suffix:int, rate:int, capacity:int, hash_bytes:int) : unit = { - - var out_s:W64.t; - var state:W64.t Array25.t; - state <- witness; - out_s <- out; - state <@ keccak_init (m); - (state, iotas) <@ keccak_1600_absorb (state, iotas, in_0, inlen, suffix, - (rate %/ 8)); - out <- out_s; - keccak_1600_squeeze (state, iotas, out, (rate %/ 8), hash_bytes); - return (); - } -}. - -section. - -op good_iotas : W64.t. -op rate_in_bytes : int. - -declare module Preal : PermT {Glob}. - -axiom perm_imp_correct good_iotas : - equiv [ Preal.perm ~ M.keccak_f : - st{1} = A{2} /\ iotas{2} = good_iotas /\ rate_in_bytes{2} = rate_in_bytes ==> - res{1} = res{2}.`1 /\ res{2}.`2 = good_iotas]. (* this second one is weird *) - -print Spc.r. - -phoare keccak_init_spec mem : - [ M.keccak_init : Glob.mem = mem ==> Glob.mem = mem /\ res = state0 ] = 1%r. -admitted. - -phoare keccak_1600_xtr_block_spec mem outp outl st : - [ M.keccak_1600_xtr_block : - Glob.mem = mem /\ state = st /\ - to_uint out = outp /\ to_uint len = outl ==> - res = W64.of_int (outp + outl) /\ - eqmem_except mem Glob.mem outp outl /\ - memr2bits Glob.mem outp outl = - take (outl * 8) (ofblock (wblock2block (take (r %/ 64) (Array25.to_list st)))) ] = 1%r. -admitted. - -phoare keccak_1600_add_full_block_spec mem st inp inl rate wb : - [ M.keccak_1600_add_full_block : - wb = take (r %/ 64) (map W64.bits2w - (BitEncoding.BitChunking.chunk 64 (bytewisepad (memr2bits mem inp inl)))) /\ - Glob.mem = mem /\ state = st /\ to_uint in_0 = inp /\ to_uint inlen = inl /\ - rate_in_bytes = rate ==> - Glob.mem = mem /\ res.`1 = combine st wb /\ to_uint res.`2 = inp + rate /\ - to_uint res.`3 = inl - rate] = 1%r. -admitted. - -phoare keccak_1600_add_final_block_spec mem st inp inl rate wb : - [ M.keccak_1600_add_final_block : - wb = take (r %/ 64) (map W64.bits2w - (BitEncoding.BitChunking.chunk 64 (bytewisepad (memr2bits mem inp inl)))) /\ - Glob.mem = mem /\ state = st /\ to_uint in_0 = inp /\ to_uint inlen = inl /\ - rate_in_bytes = rate ==> - Glob.mem = mem /\ res = combine st wb ] = 1%r. -admitted. - -lemma impl_correct outp : -equiv [ Spec(Preal).f ~ M.keccak_1600 : - outp = out{1} /\ outp = W64.to_uint out{2} /\ outlen{1} = hash_bytes{2} /\ - domain_bits{1} ++ suffix_bits{1} = suffix_bits{2} /\ r = rate{2} /\ c = capacity{2} /\ - ={Glob.mem} /\ inp{1} = W64.to_uint in_0{2} /\ inlen{1} = to_uint inlen{2} /\ - iotas{2} = good_iotas - ==> ={Glob.mem} ]. -proc. -sp. -seq 0 1 : (#{~state{2}}pre /\ state{2} = st{1}). -exists *Glob.mem{2}. -elim* => mem. -call {2} (keccak_init_spec (mem)); first by auto => />. - -(* Absorb phase *) -inline M.keccak_1600_absorb. -sp. -splitwhile {1} 1 : (1 < size xs). -seq 1 1 : (#{/~state0{2}} - {~in_00{2}} - {~inlen0{2}} - {~xs{1}} - {~st{1}}pre /\ - st{1} = state0{2} /\ - xs{1} = loadpad2wblocks Glob.mem{1} (W64.to_uint in_00{2}) (W64.to_uint inlen0{2}) - /\ size xs{1} <= 1). -while (#{~ size xs{1} <= 1}post). -seq 0 1 : (#{/~state0{2}} - {~in_00{2}} - {~inlen0{2}}pre /\ - combine st{1} (head wblock0 xs{1}) = state0{2} /\ - xs{1} = loadpad2wblocks Glob.mem{1} (W64.to_uint in_00{2} - rate_in_bytes{2}) (W64.to_uint inlen0{2} + rate_in_bytes{2})). -exists * Glob.mem{2}, state0{2}, (to_uint in_00{2}), (to_uint inlen0{2}), rate_in_bytes{2}, (head wblock0 xs{1}). -elim* => mem st inp inl rate wb. -call {2} (keccak_1600_add_full_block_spec mem st inp inl rate wb). -auto => />. -progress. -rewrite /loadpad2wblocks //=. -rewrite -(head_behead (bits2blocks - (bytewisepad - (memr2bits Glob.mem{2} (to_uint in_00{2}) (to_uint inlen0{2})))) b0). -smt. -rewrite map_cons. simplify. -admit. (* breaking blocks + head + chunking = take + chunking *) -rewrite H4. -smt(). -smt(). -inline M.load_2. -wp. -call (perm_imp_correct good_iotas). -inline *. -wp;auto => />. -progress. -rewrite /loadpad2wblocks. simplify. -rewrite (_: (memr2bits Glob.mem{2} (to_uint in_00{2} - r %/ 8) - (to_uint inlen0{2} + r %/ 8) = - (memr2bits Glob.mem{2} (to_uint in_00{2} - r %/ 8) - (r %/ 8)) ++ - (memr2bits Glob.mem{2} (to_uint in_00{2}) - (to_uint inlen0{2})))). -rewrite /memr2bits. -rewrite -flatten_cat. -admit. (* iota_ rearrangements *) -rewrite (_ : - (bits2blocks - (bytewisepad - (memr2bits Glob.mem{2} (to_uint in_00{2} - r %/ 8) (r %/ 8) ++ - memr2bits Glob.mem{2} (to_uint in_00{2}) - (to_uint inlen0{2})))) = - head witness (bits2blocks - (bytewisepad - (memr2bits Glob.mem{2} (to_uint in_00{2} - r %/ 8) (r %/ 8) ++ - memr2bits Glob.mem{2} (to_uint in_00{2}) - (to_uint inlen0{2})))) :: - (bits2blocks - (bytewisepad - (memr2bits Glob.mem{2} (to_uint in_00{2}) (to_uint inlen0{2}))))). -admit. (* breaking in blocks as reading from memory *) -by rewrite map_cons. -admit. (* better keep some relation between size xs and inlen0 *) -admit. -admit. -auto => />. -progress. -admit. (* better keep some relation between size xs and inlen0 *) -admit. -admit. -admit. - -(* setting minimum precondition to squeeze *) -seq 1 4 : (st{1} = state{2} /\ - iotas{2} = good_iotas /\ - i{1} = 0 /\ - rate{2} = r /\ - rate_in_bytes{2} = rate{2} %/ 8 /\ - to_uint out_s{2} = outp /\ - z{1} = [] /\ - outp = out{1} /\ - outp = W64.to_uint out{2} /\ - outlen{1} = hash_bytes{2} /\ - ={Glob.mem} /\ - hash_bytes{2} = hash_bytes{2}). - -(* we know there's exactly one iteration left to go on the left *) -unroll {1} 1. -(* The final iteration matches the block for which padding was added *) -rcondt {1} 1. move => *. auto => />. -have always : (1 <= size (loadpad2wblocks Glob.mem{m} (to_uint in_00{m}) (to_uint inlen0{m}))). -admit. (* prove once and for all *) smt(). -seq 2 2 : (#{~xs{1}}pre /\ xs{1} = []). -seq 0 1 : (#{/~state0{2}} - {~in_00{2}} - {~inlen0{2}} - {~xs{1}} - {~st{1}}pre /\ - combine st{1} (head wblock0 xs{1}) = state0{2} /\ - size xs{1} <= 1). -exists * Glob.mem{2}, state0{2}, (to_uint in_00{2}), (to_uint inlen0{2}), rate_in_bytes{2}, (head wblock0 xs{1}). -elim* => mem st inp inl rate wb. -call {2} (keccak_1600_add_final_block_spec mem st inp inl rate wb). -auto => />. -progress. -rewrite /loadpad2wblocks //=. -rewrite -(head_behead (bits2blocks - (bytewisepad - (memr2bits Glob.mem{2} (to_uint in_00{2}) (to_uint inlen0{2})))) b0). -move : H0; rewrite /loadpad2wblocks => //=. rewrite size_map. smt. -rewrite map_cons. simplify. -rewrite /bits2blocks. -admit. (* breaking blocks + head + chunking = take + chunking *) -wp. -call (perm_imp_correct good_iotas). -auto => />. -progress. -move : H1. -elim (xs{1}). smt. -progress. smt. - -(* The while on the left is never executed. *) -while {1} (#post /\ xs{1} = []) 1. move => *. exfalso. smt. by auto => />. - -(* Squeeze phase *) - -case (hash_bytes{2} <= 0). -admit. (* to do *) - -inline M.keccak_1600_squeeze. -seq 0 6 : (st{1} = state1{2} /\ - iotas1{2} = good_iotas /\ - rate{2} = r /\ - rate_in_bytes0{2} = rate{2} %/ 8 /\ - to_uint out_s{2} = outp /\ - outp = out{1} /\ - outp = W64.to_uint out{2} /\ - outlen{1} = hash_bytes{2} /\ - 0 <= i{1} /\ i{1} <= convb hash_bytes{2} - 1 /\ - s_hash_bytes{2} = W64.of_int (hash_bytes{2} - (i{1} * r %/ 8)) /\ - to_uint out0{2} = r %/ 8 * i{1} + outp /\ - eqmem_except Glob.mem{1} Glob.mem{2} outp (i{1} * r %/ 8) /\ - memr2bits Glob.mem{2} outp (i{1} * r %/ 8) = - take (i{1} * r %/ 8 * 8) ((wblocks2bits z{1}))). -auto => />. -progress. -rewrite /convb. smt. -smt(). -rewrite /memr2bits /flatten take0 iota0. smt(). smt. - -(* All but last iterations exactly match in how permutation is computed *) -splitwhile {1} 1 : (i < convb outlen -1). -splitwhile {2} 1 : (W64.of_int rate_in_bytes0 \ult s_hash_bytes). -seq 1 1 : (#pre /\ - convb outlen{1} - 1 <= i{1} /\ - i{1} <= convb outlen{1} - 1 /\ - s_hash_bytes{2} \ule W64.of_int rate_in_bytes0{2}). -while (#pre /\ - i{1} <= convb outlen{1} - 1). -seq 2 1 : (#{/~i{1} < convb outlen{1}} - {~i{1} < convb outlen{1} - 1} - {~s_hash_bytes{2} = W64.of_int (hash_bytes{2} - (i{1} * r %/ 8))}pre /\ - s_hash_bytes{2} = W64.of_int (hash_bytes{2} - ((i{1}-1) * r %/ 8)) /\ - i{1} - 1 < convb outlen{1} - 1 /\ - i{1} <= convb outlen{1} - 1 ). -exists * Glob.mem{2}, out0{2}, state1{2}, (W64.of_int rate_in_bytes0{2}). -elim* => mem outpp st hbytes. -call {2} (keccak_1600_xtr_block_spec mem (to_uint outpp) (to_uint hbytes) st). -auto => />. -progress. -smt(). -smt(). -rewrite of_uintK. -rewrite (_ : to_uint out_s{2} = to_uint out0{2} - r %/ 8* i{1}). -smt(). -ring. -rewrite -to_uintD. - admit. (* safety *) -move : H3 H8; rewrite /eqmem_except H2. -move => *. -case (ad <= to_uint out_s{2}). -admit. (* interval matching *) -move => *. -case (ad < to_uint out_s{2} + (i{1} + 1) * r %/ 8). -admit. (* interval matching *) -move => *. -admit. (* interval matching *) -admit. (* eqmem strengthening *) -smt. -smt. -rcondt {1} 1. move => *. auto => />. smt(). -progress. -sp. -seq 1 1 : #pre. -call (perm_imp_correct good_iotas). -by auto => />. -auto => />. progress. ring. admit. (* safety *) -admit. (* bound matching *) -admit. (* bound matching *) -smt. -admit. (* bound matching *) - -auto => />. -progress. -admit. (* bound matching *) -admit. (* bound matching *) -smt. -admit. (* bound matching *) -smt. -admit. (* bound matching *) - -(* Same behaviour for non-block-aligned outputs *) -case (s_hash_bytes{2} = W64.of_int rate_in_bytes0{2}). - -unroll {1} 1. -unroll {2} 1. -rcondt{1} 1. move => *. auto => />. -progress. -smt. -rcondf{1} 3. move => *. auto => />. -progress. -smt. -rcondf{2} 1. move => *. auto => />. -progress. -rewrite ultE. smt. - -seq 0 1 : #pre. -while {2} (#pre) 1. -move => *. exfalso. smt (@W64). - -by auto => />. - -wp. -while {1} (#post /\ convb outlen{1} <= i{1}) 1. -move => *. exfalso. smt (). - -exists * Glob.mem{2}, out0{2}, state1{2}, s_hash_bytes{2}. -elim* => mem outpp st hbytes. -move => *. -call {2} (keccak_1600_xtr_block_spec mem (to_uint outpp) (to_uint hbytes) st). -auto => />. -progress. -admit. (* store properties *) -smt(). - -(* Different behaviour for non-block aligned outputs *) - -seq 0 1 : #pre. -while {2} (#pre) 1. move => *. exfalso. -move => &hr [ # *]. smt(@W64). -by progress. - -unroll {1} 1. -rcondt{1} 1. move => *. auto => />. -progress. -smt. -rcondf {1} 3. move => *. auto => />. smt(). -sp. -seq 1 0 : #pre. -while {1} (#pre) 1. move => *. exfalso. -move => *. auto => />. smt. -by auto => />. -wp. -exists * Glob.mem{2}, out0{2}, state1{2}, s_hash_bytes{2}. -elim* => mem outpp st hbytes. -move => *. -call {2} (keccak_1600_xtr_block_spec mem (to_uint outpp) (to_uint hbytes) st). -auto => />. -progress. -admit. (* store properties *) - -qed. From 206936018291f208a0f6b3e386233aa4d6d21adc Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Thu, 16 May 2019 00:13:54 +0200 Subject: [PATCH 425/525] some progress --- proof/impl/libc/keccak_1600_avx2_modular.ec | 281 ++++++++++++++++---- 1 file changed, 233 insertions(+), 48 deletions(-) diff --git a/proof/impl/libc/keccak_1600_avx2_modular.ec b/proof/impl/libc/keccak_1600_avx2_modular.ec index 87229a0..723e503 100644 --- a/proof/impl/libc/keccak_1600_avx2_modular.ec +++ b/proof/impl/libc/keccak_1600_avx2_modular.ec @@ -332,15 +332,34 @@ qed. require Keccak_1600_ref_modular. +lemma set_get_def (v : W64.t Array28.t) (w : W256.t) i j : + 0 <= i < 7 => 0 <= j < 28 => + WArray224.get64 + (WArray224.set256 (WArray224.init64 ("_.[_]" v)) i w) j = + if 4 * i <= j < 4 * i + 4 then w \bits64 (j %% 4) + else v.[j]. +proof. + move=> hx hs; rewrite set256E !get64E. + rewrite -(W8u8.unpack8K (if 4 * i <= j < 4 * i + 4 then w \bits64 j %% 4 else v.[j]));congr. + apply W8u8.Pack.ext_eq => k hk. + rewrite W8u8.get_unpack8 //= W8u8.Pack.initiE //= initiE 1:/# /=. + have -> : (32 * i <= 8 * j + k < 32 * (i + 1)) = (4 * i <= j < 4 * i + 4) by smt(). + case : (4 * i <= j < 4 * i + 4) => h. + + by rewrite W256_bits64_bits8 1:// /#. + by rewrite /init64 initiE /#. +qed. + lemma set_get_eq (v : W64.t Array28.t) (w : W256.t) i j : - 0 <= i < 7 => + 0 <= i < 7 => 0 <= j < 28 => 4 * i <= j < 4 * i + 4 => WArray224.get64 - (WArray224.set256 (WArray224.init64 ("_.[_]" v)) i w) i = w \bits64 (j %% 4) by admit. + (WArray224.set256 (WArray224.init64 ("_.[_]" v)) i w) j = w \bits64 (j %% 4). +proof. by move=> h1 h2 h3; rewrite set_get_def // h3. qed. lemma set_get_diff (v : W64.t Array28.t) (w : W256.t) i j : - 0 <= i < 7 => 0 <= j < 7 => i <> j => + 0 <= i < 7 => 0 <= j < 28 => !(4 * i <= j < 4 * i + 4 ) => WArray224.get64 - (WArray224.set256 (WArray224.init64 ("_.[_]" v)) i w) j = v.[j] by admit. + (WArray224.set256 (WArray224.init64 ("_.[_]" v)) i w) j = v.[j]. +proof. by move=> h1 h2 h3; rewrite set_get_def // h3. qed. (* my @A_jagged = ([0,0], [1,0], [1,1], [1,2], [1,3], # [0][0..4] [2,2], [6,0], [3,1], [4,2], [5,3], # [1][0..4] @@ -349,68 +368,230 @@ lemma set_get_diff (v : W64.t Array28.t) (w : W256.t) i j : [2,1], [5,0], [4,1], [3,2], [6,3]); # [4][0..4] @A_jagged = map(8*($$_[0]*4+$$_[1]), @A_jagged); # ... and now linear *) - op A_jagged = (witness - .[0 <- 0 ] - .[1 <- 32 ] - .[2 <- 40 ] - .[3 <- 48 ] - .[4 <- 56 ] - .[5 <- 80 ] - .[6 <- 192] - .[7 <- 104] - .[8 <- 144] - .[9 <- 184] - .[10 <- 64 ] - .[11 <- 128] - .[12 <- 200] - .[13 <- 176] - .[14 <- 120] - .[15 <- 88 ] - .[16 <- 96 ] - .[17 <- 168] - .[18 <- 208] - .[19 <- 152] - .[20 <- 72 ] - .[21 <- 160] - .[22 <- 136] - .[23 <- 112] - .[24 <- 216])%Array25. + .[0 <- 0 %/ 8] + .[1 <- 32 %/ 8] + .[2 <- 40 %/ 8] + .[3 <- 48 %/ 8] + .[4 <- 56 %/ 8] + .[5 <- 80 %/ 8] + .[6 <- 192 %/ 8] + .[7 <- 104 %/ 8] + .[8 <- 144 %/ 8] + .[9 <- 184 %/ 8] + .[10 <- 64 %/ 8] + .[11 <- 128 %/ 8] + .[12 <- 200 %/ 8] + .[13 <- 176 %/ 8] + .[14 <- 120 %/ 8] + .[15 <- 88 %/ 8] + .[16 <- 96 %/ 8] + .[17 <- 168 %/ 8] + .[18 <- 208 %/ 8] + .[19 <- 152 %/ 8] + .[20 <- 72 %/ 8] + .[21 <- 160 %/ 8] + .[22 <- 136 %/ 8] + .[23 <- 112 %/ 8] + .[24 <- 216 %/ 8] + )%Array25. op good_jag (mem : global_mem_t, _jag : int) = forall off, 0 <= off < 25 => - loadW64 mem (_jag + (off * 8)) = W64.of_int A_jagged.[off]. + loadW64 mem (_jag + (8 * off)) = W64.of_int A_jagged.[off]. -op jagged_zeros_W64 (sts : W64.t Array28.t, rate8 : int) = - forall off, - rate8 %/ 8 <= off => sts.[A_jagged.[off]] = W64.zero. +op jagged_zeros_W64 (sts : W64.t Array28.t, rate : int) = + forall off, 0 <= off < 25 => + rate %/ 8 <= off < 25 => sts.[A_jagged.[off]] = W64.zero. -op jagged_load_W64 (mem : global_mem_t, _jag : int, sts : W64.t Array28.t, rate8 : int) = +(*op jagged_load_W64 (mem : global_mem_t, _jag : int, sts : W64.t Array28.t, rate8 : int) = forall off, sts.[A_jagged.[off]] = if 0 <= off < rate8 %/ 8 then loadW64 mem (_jag + (off * 8)) - else W64.zero. + else W64.zero. *) -op jagged_load (mem : global_mem_t, _jag : int, sts : W64.t Array28.t, inl8 : int) = +(*op jagged_load (mem : global_mem_t, _jag : int, sts : W64.t Array28.t, inl8 : int) = if inl8 %% 8 = 0 then jagged_load_W64 mem _jag sts inl8 else forall off, sts.[A_jagged.[off]] = if 0 <= off < inl8 %/ 8 then loadW64 mem (_jag + (off * 8)) else if off = inl8 %/ 8 then W64.zero (* FIX ME: just read the remaining bytes *) - else W64.zero. + else W64.zero. *) + +op em_states (state : W256.t Array7.t) (st : W64.t Array25.t) = + state = + Array7.of_list witness [pack4 [st.[index 0 0]; st.[index 0 0]; st.[index 0 0]; st.[index 0 0]]; + pack4 [st.[index 0 1]; st.[index 0 2]; st.[index 0 3]; st.[index 0 4]]; + pack4 [st.[index 2 0]; st.[index 4 0]; st.[index 1 0]; st.[index 3 0]]; + pack4 [st.[index 3 1]; st.[index 1 2]; st.[index 4 3]; st.[index 2 4]]; + pack4 [st.[index 2 1]; st.[index 4 2]; st.[index 1 3]; st.[index 3 4]]; + pack4 [st.[index 4 1]; st.[index 3 2]; st.[index 2 3]; st.[index 1 4]]; + pack4 [st.[index 1 1]; st.[index 2 2]; st.[index 3 3]; st.[index 4 4]]]. + +lemma jagged_bound k : 0 <= k < 25 => 0 <= A_jagged.[k] < 28. +proof. + by move: k; apply (Array25.allP A_jagged (fun i => 0 <= i < 28)); cbv delta. +qed. + +lemma to_uintK_jagged k : 0 <= k < 25 => to_uint (W64.of_int A_jagged.[k]) = A_jagged.[k]. +proof. + move=> hk; rewrite to_uint_small //; smt (jagged_bound). +qed. + +lemma jagged_inj i j : 0 <= i < 25 => 0 <= j < 25 => A_jagged.[i] = A_jagged.[j] => i = j. +proof. +admitted. + +lemma jagged_diff off: 0 <= off < 25 => ! A_jagged.[off] \in [1;2;3]. +proof. + by move: off; apply (Array25.allP A_jagged (fun i => ! i \in [1;2;3])); cbv delta. +qed. + +lemma get256_64 (t : WArray224.t) i : 0 <= i < 7 => get256 t i = + W4u64.pack4 [ get64 t (4*i); get64 t (4*i+1); get64 t (4*i+2); get64 t (4*i+3)]. +proof. + move=> hi. + apply W4u64.wordP => k hk. + have -> : pack4 [get64 t (4 * i); get64 t (4 * i + 1); get64 t (4 * i + 2); get64 t (4 * i + 3)] = + W4u64.pack4_t (W4u64.Pack.init (fun k => get64 t (4 * i + k))). + + apply W4u64.wordP => *; rewrite !pack4bE // of_listE !initiE //= /#. + rewrite WArray224.get256E bits64_W32u8 hk /= pack4bE // initiE //=. + do 8! rewrite initiE 1:/# /=. + rewrite WArray224.get64E; apply W8u8.wordP => j hj. + rewrite of_listE !W8u8.pack8bE // !initiE //= /#. +qed. -equiv add_full_block_corr st rr : +lemma get64_init64 (t:W64.t Array28.t) k : 0 <= k < 28 => get64 (WArray224.init64 ("_.[_]" t)) k = t.[k]. +proof. + move=> hk. + rewrite /init64 WArray224.get64E; apply W8u8.wordP => i hi. + rewrite W8u8.pack8bE // initiE //= initiE 1:/# /= /#. +qed. + +equiv add_full_block_corr rr : Keccak_1600_ref_modular.Mmod.add_full_block ~ Mmod.add_full_block : + to_uint rate{2} <= 200 /\ to_uint a_jagged{2} + 200 < W64.modulus /\ to_uint in_0{2} + to_uint rate{2} < W64.modulus /\ jagged_zeros_W64 s_state{2} (to_uint rate{2}) /\ to_uint rate{2} = rr /\ good_jag Glob.mem{2} (to_uint a_jagged{2}) /\ - ={Glob.mem} /\ em_states state{2} state{1} /\ ={in_0,inlen,rate} /\ s_state{2} = st - ==> - ={Glob.mem} /\ jagged_zeros_W64 res{2}.`2 rr /\ - em_states res{2}.`1 res{1}.`1 /\ - res{1}.`2 = res{2}.`3 /\ res{1}.`3 = res{2}.`4. -proc. -admitted. + ={Glob.mem} /\ em_states state{2} state{1} /\ ={in_0,inlen,rate} + ==> + ={Glob.mem} /\ jagged_zeros_W64 res{2}.`2 rr /\ + em_states res{2}.`1 res{1}.`1 /\ + res{1}.`2 = res{2}.`3 /\ res{1}.`3 = res{2}.`4. +proof. + proc => /=. + exlim state{1} => state0. + seq 4 4 : + ( to_uint rate{2} <= 200 /\ to_uint a_jagged{2} + 200 < W64.modulus /\ to_uint in_0{2} + to_uint rate{2} < W64.modulus /\ + jagged_zeros_W64 s_state{2} (to_uint rate{2}) /\ + to_uint rate{2} = rr /\ + good_jag Glob.mem{2} (to_uint a_jagged{2}) /\ + (em_states state{2} state0) /\ ={Glob.mem, in_0, inlen, rate} /\ + forall k, 0 <= k < 25 => + state{1}.[k] = if k < to_uint rate{2} %/ 8 then state0.[k] `^` s_state{2}.[A_jagged.[k]] + else state0.[k]). + + while ( + to_uint rate{2} <= 200 /\ to_uint a_jagged{2} + 200 < W64.modulus /\ to_uint in_0{2} + to_uint rate{2} < W64.modulus /\ + jagged_zeros_W64 s_state{2} (to_uint rate{2}) /\ + to_uint rate{2} = rr /\ + good_jag Glob.mem{2} (to_uint a_jagged{2}) /\ + (em_states state{2} state0) /\ ={Glob.mem, in_0, inlen, rate} /\ i{1} = j{2} /\ + rate64{1} = rate8{2} /\ to_uint rate8{2} = to_uint rate{2} %/ 8 /\ to_uint i{1} <= to_uint rate8{2} /\ + forall k, 0 <= k < 25 => + state{1}.[k] = if k < to_uint j{2} then state0.[k] `^` s_state{2}.[A_jagged.[k]] + else state0.[k]). + + wp; skip => /> &1 &2 hr200 hj200 hin0 hj0 hgj hem; rewrite !W64.ultE => hr8 hjr8 hs hjr. + have heq : to_uint (W64.of_int 8 * j{2}) = 8 * to_uint j{2}. + + by rewrite W64.to_uintM_small //= /#. + rewrite to_uintD_small heq /= 1:/#. + rewrite to_uintD_small heq /= 1:/#. + rewrite to_uintD_small /=; 1: smt(W64.to_uint_cmp). + have ? : 0 <= to_uint j{2} < 25 by smt (W64.to_uint_cmp). + split. + + move=> k hk1 hk2. + rewrite hgj 1:// to_uintK_jagged 1:// Array28.set_neqiE 1:jagged_bound 1://; smt (jagged_inj). + split; 1: smt(). + move=> k hk1 hk2; rewrite hgj 1:// to_uintK_jagged 1://. + rewrite hs 1:// /=. + case (k < to_uint j{2} + 1) => hh. + + case (k = to_uint j{2}) => [->> | hne]. + + by rewrite Array25.set_eqiE 1,2:// Array28.set_eqiE 1:jagged_bound. + rewrite Array25.set_neqiE 1,2:// Array28.set_neqiE 1:jagged_bound //; smt (jagged_inj). + rewrite Array25.set_neqiE 1:// 1:/# hs 1:// /#. + wp; skip => |> &1 &2 *; split. + + by rewrite /(`>>`) /= to_uint_shr //=; smt (W64.to_uint_cmp). + by move=> state_ j_ s_state_; rewrite !W64.ultE => /#. + unroll for{2} ^while; wp; skip => |> &1 &2. + rewrite /em_states => /> /= *; split. + + rewrite /jagged_zeros_W64 => off h1 h2. + by rewrite !Array28.set_neqiE //; 1..3: smt (jagged_diff); rewrite H2. + apply Array7.all_eq_eq; rewrite /Array7.all_eq /index /=. + rewrite !get256_64 // !get64_init64 //=. + have -> /= : state0.[0] `^` s_state{2}.[0] = state{1}.[0]. + + rewrite H4 //; case: (0 < to_uint rate{2} %/ 8) => h. + + by rewrite /A_jagged. + by have := H2 0; rewrite /A_jagged /= => ->; 1: smt(); rewrite W64.xorw0_s. + split. + + do !congr; rewrite H4 //. + + case: (1 < to_uint rate{2} %/ 8) => h; first by rewrite /A_jagged. + by have := H2 1; rewrite /A_jagged /= => ->; 1: smt(); rewrite W64.xorw0_s. + + case: (2 < to_uint rate{2} %/ 8) => h; first by rewrite /A_jagged. + by have := H2 2; rewrite /A_jagged /= => ->; 1: smt(); rewrite W64.xorw0_s. + + case: (3 < to_uint rate{2} %/ 8) => h; first by rewrite /A_jagged. + by have := H2 3; rewrite /A_jagged /= => ->; 1: smt(); rewrite W64.xorw0_s. + case: (4 < to_uint rate{2} %/ 8) => h; first by rewrite /A_jagged. + by have := H2 4; rewrite /A_jagged /= => ->; 1: smt(); rewrite W64.xorw0_s. + split. + + do !congr; rewrite H4 //. + + case: (10 < to_uint rate{2} %/ 8) => h; first by rewrite /A_jagged. + by have := H2 10; rewrite /A_jagged /= => ->; 1: smt(); rewrite W64.xorw0_s. + + case: (20 < to_uint rate{2} %/ 8) => h; first by rewrite /A_jagged. + by have := H2 20; rewrite /A_jagged /= => ->; 1: smt(); rewrite W64.xorw0_s. + + case: (5 < to_uint rate{2} %/ 8) => h; first by rewrite /A_jagged. + by have := H2 5; rewrite /A_jagged /= => ->; 1: smt(); rewrite W64.xorw0_s. + case: (15 < to_uint rate{2} %/ 8) => h; first by rewrite /A_jagged. + by have := H2 15; rewrite /A_jagged /= => ->; 1: smt(); rewrite W64.xorw0_s. + split. + + do !congr; rewrite H4 //. + + case: (16 < to_uint rate{2} %/ 8) => h; first by rewrite /A_jagged. + by have := H2 16; rewrite /A_jagged /= => ->; 1: smt(); rewrite W64.xorw0_s. + + case: (7 < to_uint rate{2} %/ 8) => h; first by rewrite /A_jagged. + by have := H2 7; rewrite /A_jagged /= => ->; 1: smt(); rewrite W64.xorw0_s. + + case: (23 < to_uint rate{2} %/ 8) => h; first by rewrite /A_jagged. + by have := H2 23; rewrite /A_jagged /= => ->; 1: smt(); rewrite W64.xorw0_s. + case: (14 < to_uint rate{2} %/ 8) => h; first by rewrite /A_jagged. + by have := H2 14; rewrite /A_jagged /= => ->; 1: smt(); rewrite W64.xorw0_s. + split. + + do !congr; rewrite H4 //. + + case: (11 < to_uint rate{2} %/ 8) => h; first by rewrite /A_jagged. + by have := H2 11; rewrite /A_jagged /= => ->; 1: smt(); rewrite W64.xorw0_s. + + case: (22 < to_uint rate{2} %/ 8) => h; first by rewrite /A_jagged. + by have := H2 22; rewrite /A_jagged /= => ->; 1: smt(); rewrite W64.xorw0_s. + + case: (8 < to_uint rate{2} %/ 8) => h; first by rewrite /A_jagged. + by have := H2 8; rewrite /A_jagged /= => ->; 1: smt(); rewrite W64.xorw0_s. + case: (19 < to_uint rate{2} %/ 8) => h; first by rewrite /A_jagged. + by have := H2 19; rewrite /A_jagged /= => ->; 1: smt(); rewrite W64.xorw0_s. + split. + + do !congr; rewrite H4 //. + + case: (21 < to_uint rate{2} %/ 8) => h; first by rewrite /A_jagged. + by have := H2 21; rewrite /A_jagged /= => ->; 1: smt(); rewrite W64.xorw0_s. + + case: (17 < to_uint rate{2} %/ 8) => h; first by rewrite /A_jagged. + by have := H2 17; rewrite /A_jagged /= => ->; 1: smt(); rewrite W64.xorw0_s. + + case: (13 < to_uint rate{2} %/ 8) => h; first by rewrite /A_jagged. + by have := H2 13; rewrite /A_jagged /= => ->; 1: smt(); rewrite W64.xorw0_s. + case: (9 < to_uint rate{2} %/ 8) => h; first by rewrite /A_jagged. + by have := H2 9; rewrite /A_jagged /= => ->; 1: smt(); rewrite W64.xorw0_s. + do !congr; rewrite H4 //. + + case: (6 < to_uint rate{2} %/ 8) => h; first by rewrite /A_jagged. + by have := H2 6; rewrite /A_jagged /= => ->; 1: smt(); rewrite W64.xorw0_s. + + case: (12 < to_uint rate{2} %/ 8) => h; first by rewrite /A_jagged. + by have := H2 12; rewrite /A_jagged /= => ->; 1: smt(); rewrite W64.xorw0_s. + + case: (18 < to_uint rate{2} %/ 8) => h; first by rewrite /A_jagged. + by have := H2 18; rewrite /A_jagged /= => ->; 1: smt(); rewrite W64.xorw0_s. + case: (24 < to_uint rate{2} %/ 8) => h; first by rewrite /A_jagged. + by have := H2 24; rewrite /A_jagged /= => ->; 1: smt(); rewrite W64.xorw0_s. +qed. (* some precondition on st holding 0 is needed and must be preserved; also something on jagged *) equiv add_final_block_corr st : @@ -418,17 +599,21 @@ equiv add_final_block_corr st : ={Glob.mem} /\ em_states state{2} state{1} /\ ={in_0,inlen} /\ s_state{2} = st ==> ={Glob.mem} /\ em_states res{2} res{1}. -proc. +proof. + proc => /=. admitted. (* some precondition on jagged needed *) + +require import Keccak_f1600_scalar_table. + equiv extr_full_block_corr _outlen _rate _out _iotas rl rr : Keccak_1600_ref_modular.Mmod.xtr_full_block ~ Mmod.xtr_full_block : good_iotas Glob.mem{2} _iotas /\ good_rhol Glob.mem{2} rl /\ good_rhor Glob.mem{2} rr /\ rate{1} = _rate /\ outlen{1} = _outlen /\ out{1} = _out /\ em_states state{2} state{1} /\ ={Glob.mem,out} /\ rate{1} = len{2} ==> - good_iotas Glob.mem{2} _iotas /\ + Keccak_f1600_scalar_table.good_iotas Glob.mem{2} _iotas /\ good_rhol Glob.mem{2} rl /\ good_rhor Glob.mem{2} rr /\ res{1}.`1 = _out + _rate /\ res{1}.`2 = _outlen - _rate /\ ={Glob.mem} /\ res{1}.`1 = res{2}. admitted. From 187fd15c0f8eeed78dcab3e7be74adaacc441fa8 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Thu, 16 May 2019 14:18:46 +0200 Subject: [PATCH 426/525] WIP --- proof/impl/libc/keccak_1600_avx2_modular.ec | 567 ++++++++++++++------ 1 file changed, 393 insertions(+), 174 deletions(-) diff --git a/proof/impl/libc/keccak_1600_avx2_modular.ec b/proof/impl/libc/keccak_1600_avx2_modular.ec index 723e503..49dd577 100644 --- a/proof/impl/libc/keccak_1600_avx2_modular.ec +++ b/proof/impl/libc/keccak_1600_avx2_modular.ec @@ -1,4 +1,4 @@ -require import List Int IntExtra IntDiv CoreMap. +require import AllCore List Int IntExtra IntDiv CoreMap. from Jasmin require import JModel. require import Array4 Array7 Array9 Array25 Array28. @@ -400,9 +400,6 @@ op good_jag (mem : global_mem_t, _jag : int) = forall off, 0 <= off < 25 => loadW64 mem (_jag + (8 * off)) = W64.of_int A_jagged.[off]. -op jagged_zeros_W64 (sts : W64.t Array28.t, rate : int) = - forall off, 0 <= off < 25 => - rate %/ 8 <= off < 25 => sts.[A_jagged.[off]] = W64.zero. (*op jagged_load_W64 (mem : global_mem_t, _jag : int, sts : W64.t Array28.t, rate8 : int) = forall off, @@ -439,9 +436,41 @@ proof. move=> hk; rewrite to_uint_small //; smt (jagged_bound). qed. +op A_jagged_inv = + (witness + .[A_jagged.[0 ] <- 0 ] + .[A_jagged.[1 ] <- 1 ] + .[A_jagged.[2 ] <- 2 ] + .[A_jagged.[3 ] <- 3 ] + .[A_jagged.[4 ] <- 4 ] + .[A_jagged.[5 ] <- 5 ] + .[A_jagged.[6 ] <- 6 ] + .[A_jagged.[7 ] <- 7 ] + .[A_jagged.[8 ] <- 8 ] + .[A_jagged.[9 ] <- 9 ] + .[A_jagged.[10] <- 10] + .[A_jagged.[11] <- 11] + .[A_jagged.[12] <- 12] + .[A_jagged.[13] <- 13] + .[A_jagged.[14] <- 14] + .[A_jagged.[15] <- 15] + .[A_jagged.[16] <- 16] + .[A_jagged.[17] <- 17] + .[A_jagged.[18] <- 18] + .[A_jagged.[19] <- 19] + .[A_jagged.[20] <- 20] + .[A_jagged.[21] <- 21] + .[A_jagged.[22] <- 22] + .[A_jagged.[23] <- 23] + .[A_jagged.[24] <- 24])%Array28. + lemma jagged_inj i j : 0 <= i < 25 => 0 <= j < 25 => A_jagged.[i] = A_jagged.[j] => i = j. proof. -admitted. + have : forall k, 0 <= k < 25 => k = A_jagged_inv.[A_jagged.[k]]. + + move=> k; have <- := mema_iota 0 25 k; move: k. + by rewrite -(List.allP (fun k => k = A_jagged_inv.[A_jagged.[k]])); cbv delta. + by move=> hk hi hj heq;rewrite (hk i) // (hk j) // heq. +qed. lemma jagged_diff off: 0 <= off < 25 => ! A_jagged.[off] \in [1;2;3]. proof. @@ -469,14 +498,114 @@ proof. rewrite W8u8.pack8bE // initiE //= initiE 1:/# /= /#. qed. +op jagged_zeros_W64_p (sts : W64.t Array28.t, P: int -> bool) = + forall off, 0 <= off < 25 => + P off => sts.[A_jagged.[off]] = W64.zero. + +op jagged_zeros_W64 (sts : W64.t Array28.t, rate : int) = jagged_zeros_W64_p sts (fun off => rate <= off < 25). + +lemma state_xor_jagged (state0 state1:W64.t Array25.t) s_state2 P : + jagged_zeros_W64_p s_state2 P => + (forall (k : int), + 0 <= k < 25 => + state1.[k] = if !P k then state0.[k] `^` s_state2.[A_jagged.[k]] else state0.[k]) => +pack4 [state0.[0]; state0.[0]; state0.[0]; state0.[0]] `^` +get256 ((init64 ("_.[_]" s_state2.[1 <- s_state2.[0]].[2 <- s_state2.[0]].[3 <- s_state2.[0]])))%WArray224 0 = +pack4 [state1.[0]; state1.[0]; state1.[0]; state1.[0]] /\ +pack4 [state0.[1]; state0.[2]; state0.[3]; state0.[4]] `^` +get256 ((init64 ("_.[_]" s_state2.[1 <- s_state2.[0]].[2 <- s_state2.[0]].[3 <- s_state2.[0]])))%WArray224 1 = +pack4 [state1.[1]; state1.[2]; state1.[3]; state1.[4]] /\ +pack4 [state0.[10]; state0.[20]; state0.[5]; state0.[15]] `^` +get256 ((init64 ("_.[_]" s_state2.[1 <- s_state2.[0]].[2 <- s_state2.[0]].[3 <- s_state2.[0]])))%WArray224 2 = +pack4 [state1.[10]; state1.[20]; state1.[5]; state1.[15]] /\ +pack4 [state0.[16]; state0.[7]; state0.[23]; state0.[14]] `^` +get256 ((init64 ("_.[_]" s_state2.[1 <- s_state2.[0]].[2 <- s_state2.[0]].[3 <- s_state2.[0]])))%WArray224 3 = +pack4 [state1.[16]; state1.[7]; state1.[23]; state1.[14]] /\ +pack4 [state0.[11]; state0.[22]; state0.[8]; state0.[19]] `^` +get256 ((init64 ("_.[_]" s_state2.[1 <- s_state2.[0]].[2 <- s_state2.[0]].[3 <- s_state2.[0]])))%WArray224 4 = +pack4 [state1.[11]; state1.[22]; state1.[8]; state1.[19]] /\ +pack4 [state0.[21]; state0.[17]; state0.[13]; state0.[9]] `^` +get256 ((init64 ("_.[_]" s_state2.[1 <- s_state2.[0]].[2 <- s_state2.[0]].[3 <- s_state2.[0]])))%WArray224 5 = +pack4 [state1.[21]; state1.[17]; state1.[13]; state1.[9]] /\ +pack4 [state0.[6]; state0.[12]; state0.[18]; state0.[24]] `^` +get256 ((init64 ("_.[_]" s_state2.[1 <- s_state2.[0]].[2 <- s_state2.[0]].[3 <- s_state2.[0]])))%WArray224 6 = +pack4 [state1.[6]; state1.[12]; state1.[18]; state1.[24]]. +proof. + move=> H2 H4. + rewrite !get256_64 // !get64_init64 //=. + have -> /= : state0.[0] `^` s_state2.[0] = state1.[0]. + + rewrite H4 //; case: (!P 0) => h /=. + + by rewrite /A_jagged. + by have := H2 0; rewrite /A_jagged /= => ->. + split. + + do !congr; rewrite H4 //. + + case: (!P 1) => h; first by rewrite /A_jagged. + by have := H2 1; rewrite /A_jagged /= => ->. + + case: (!P 2) => h; first by rewrite /A_jagged. + by have := H2 2; rewrite /A_jagged /= => ->. + + case: (!P 3) => h; first by rewrite /A_jagged. + by have := H2 3; rewrite /A_jagged /= => ->. + case: (!P 4) => h; first by rewrite /A_jagged. + by have := H2 4; rewrite /A_jagged /= => ->. + split. + + do !congr; rewrite H4 //. + + case: (!P 10) => h; first by rewrite /A_jagged. + by have := H2 10; rewrite /A_jagged /= => ->. + + case: (!P 20) => h; first by rewrite /A_jagged. + by have := H2 20; rewrite /A_jagged /= => ->. + + case: (!P 5) => h; first by rewrite /A_jagged. + by have := H2 5; rewrite /A_jagged /= => ->. + case: (!P 15) => h; first by rewrite /A_jagged. + by have := H2 15; rewrite /A_jagged /= => ->. + split. + + do !congr; rewrite H4 //. + + case: (!P 16) => h; first by rewrite /A_jagged. + by have := H2 16; rewrite /A_jagged /= => ->. + + case: (!P 7) => h; first by rewrite /A_jagged. + by have := H2 7; rewrite /A_jagged /= => ->. + + case: (!P 23) => h; first by rewrite /A_jagged. + by have := H2 23; rewrite /A_jagged /= => ->. + case: (!P 14) => h; first by rewrite /A_jagged. + by have := H2 14; rewrite /A_jagged /= => ->. + split. + + do !congr; rewrite H4 //. + + case: (!P 11) => h; first by rewrite /A_jagged. + by have := H2 11; rewrite /A_jagged /= => ->. + + case: (!P 22) => h; first by rewrite /A_jagged. + by have := H2 22; rewrite /A_jagged /= => ->. + + case: (!P 8) => h; first by rewrite /A_jagged. + by have := H2 8; rewrite /A_jagged /= => ->. + case: (!P 19) => h; first by rewrite /A_jagged. + by have := H2 19; rewrite /A_jagged /= => ->. + split. + + do !congr; rewrite H4 //. + + case: (!P 21) => h; first by rewrite /A_jagged. + by have := H2 21; rewrite /A_jagged /= => ->. + + case: (!P 17) => h; first by rewrite /A_jagged. + by have := H2 17; rewrite /A_jagged /= => ->. + + case: (!P 13) => h; first by rewrite /A_jagged. + by have := H2 13; rewrite /A_jagged /= => ->. + case: (!P 9) => h; first by rewrite /A_jagged. + by have := H2 9; rewrite /A_jagged /= => ->. + do !congr; rewrite H4 //. + + case: (!P 6) => h; first by rewrite /A_jagged. + by have := H2 6; rewrite /A_jagged /= => ->. + + case: (!P 12) => h; first by rewrite /A_jagged. + by have := H2 12; rewrite /A_jagged /= => ->. + + case: (!P 18) => h; first by rewrite /A_jagged. + by have := H2 18; rewrite /A_jagged /= => ->. + case: (!P 24) => h; first by rewrite /A_jagged. + by have := H2 24; rewrite /A_jagged /= => ->. +qed. + equiv add_full_block_corr rr : Keccak_1600_ref_modular.Mmod.add_full_block ~ Mmod.add_full_block : to_uint rate{2} <= 200 /\ to_uint a_jagged{2} + 200 < W64.modulus /\ to_uint in_0{2} + to_uint rate{2} < W64.modulus /\ - jagged_zeros_W64 s_state{2} (to_uint rate{2}) /\ to_uint rate{2} = rr /\ + jagged_zeros_W64 s_state{2} (to_uint rate{2} %/ 8) /\ to_uint rate{2} = rr /\ good_jag Glob.mem{2} (to_uint a_jagged{2}) /\ ={Glob.mem} /\ em_states state{2} state{1} /\ ={in_0,inlen,rate} ==> - ={Glob.mem} /\ jagged_zeros_W64 res{2}.`2 rr /\ + jagged_zeros_W64 res{2}.`2 (rr %/ 8) /\ em_states res{2}.`1 res{1}.`1 /\ res{1}.`2 = res{2}.`3 /\ res{1}.`3 = res{2}.`4. proof. @@ -484,7 +613,7 @@ proof. exlim state{1} => state0. seq 4 4 : ( to_uint rate{2} <= 200 /\ to_uint a_jagged{2} + 200 < W64.modulus /\ to_uint in_0{2} + to_uint rate{2} < W64.modulus /\ - jagged_zeros_W64 s_state{2} (to_uint rate{2}) /\ + jagged_zeros_W64 s_state{2} (to_uint rate{2} %/ 8) /\ to_uint rate{2} = rr /\ good_jag Glob.mem{2} (to_uint a_jagged{2}) /\ (em_states state{2} state0) /\ ={Glob.mem, in_0, inlen, rate} /\ @@ -493,7 +622,7 @@ proof. else state0.[k]). + while ( to_uint rate{2} <= 200 /\ to_uint a_jagged{2} + 200 < W64.modulus /\ to_uint in_0{2} + to_uint rate{2} < W64.modulus /\ - jagged_zeros_W64 s_state{2} (to_uint rate{2}) /\ + jagged_zeros_W64 s_state{2} (to_uint rate{2} %/ 8) /\ to_uint rate{2} = rr /\ good_jag Glob.mem{2} (to_uint a_jagged{2}) /\ (em_states state{2} state0) /\ ={Glob.mem, in_0, inlen, rate} /\ i{1} = j{2} /\ @@ -527,84 +656,219 @@ proof. + rewrite /jagged_zeros_W64 => off h1 h2. by rewrite !Array28.set_neqiE //; 1..3: smt (jagged_diff); rewrite H2. apply Array7.all_eq_eq; rewrite /Array7.all_eq /index /=. - rewrite !get256_64 // !get64_init64 //=. - have -> /= : state0.[0] `^` s_state{2}.[0] = state{1}.[0]. - + rewrite H4 //; case: (0 < to_uint rate{2} %/ 8) => h. - + by rewrite /A_jagged. - by have := H2 0; rewrite /A_jagged /= => ->; 1: smt(); rewrite W64.xorw0_s. - split. - + do !congr; rewrite H4 //. - + case: (1 < to_uint rate{2} %/ 8) => h; first by rewrite /A_jagged. - by have := H2 1; rewrite /A_jagged /= => ->; 1: smt(); rewrite W64.xorw0_s. - + case: (2 < to_uint rate{2} %/ 8) => h; first by rewrite /A_jagged. - by have := H2 2; rewrite /A_jagged /= => ->; 1: smt(); rewrite W64.xorw0_s. - + case: (3 < to_uint rate{2} %/ 8) => h; first by rewrite /A_jagged. - by have := H2 3; rewrite /A_jagged /= => ->; 1: smt(); rewrite W64.xorw0_s. - case: (4 < to_uint rate{2} %/ 8) => h; first by rewrite /A_jagged. - by have := H2 4; rewrite /A_jagged /= => ->; 1: smt(); rewrite W64.xorw0_s. - split. - + do !congr; rewrite H4 //. - + case: (10 < to_uint rate{2} %/ 8) => h; first by rewrite /A_jagged. - by have := H2 10; rewrite /A_jagged /= => ->; 1: smt(); rewrite W64.xorw0_s. - + case: (20 < to_uint rate{2} %/ 8) => h; first by rewrite /A_jagged. - by have := H2 20; rewrite /A_jagged /= => ->; 1: smt(); rewrite W64.xorw0_s. - + case: (5 < to_uint rate{2} %/ 8) => h; first by rewrite /A_jagged. - by have := H2 5; rewrite /A_jagged /= => ->; 1: smt(); rewrite W64.xorw0_s. - case: (15 < to_uint rate{2} %/ 8) => h; first by rewrite /A_jagged. - by have := H2 15; rewrite /A_jagged /= => ->; 1: smt(); rewrite W64.xorw0_s. - split. - + do !congr; rewrite H4 //. - + case: (16 < to_uint rate{2} %/ 8) => h; first by rewrite /A_jagged. - by have := H2 16; rewrite /A_jagged /= => ->; 1: smt(); rewrite W64.xorw0_s. - + case: (7 < to_uint rate{2} %/ 8) => h; first by rewrite /A_jagged. - by have := H2 7; rewrite /A_jagged /= => ->; 1: smt(); rewrite W64.xorw0_s. - + case: (23 < to_uint rate{2} %/ 8) => h; first by rewrite /A_jagged. - by have := H2 23; rewrite /A_jagged /= => ->; 1: smt(); rewrite W64.xorw0_s. - case: (14 < to_uint rate{2} %/ 8) => h; first by rewrite /A_jagged. - by have := H2 14; rewrite /A_jagged /= => ->; 1: smt(); rewrite W64.xorw0_s. - split. - + do !congr; rewrite H4 //. - + case: (11 < to_uint rate{2} %/ 8) => h; first by rewrite /A_jagged. - by have := H2 11; rewrite /A_jagged /= => ->; 1: smt(); rewrite W64.xorw0_s. - + case: (22 < to_uint rate{2} %/ 8) => h; first by rewrite /A_jagged. - by have := H2 22; rewrite /A_jagged /= => ->; 1: smt(); rewrite W64.xorw0_s. - + case: (8 < to_uint rate{2} %/ 8) => h; first by rewrite /A_jagged. - by have := H2 8; rewrite /A_jagged /= => ->; 1: smt(); rewrite W64.xorw0_s. - case: (19 < to_uint rate{2} %/ 8) => h; first by rewrite /A_jagged. - by have := H2 19; rewrite /A_jagged /= => ->; 1: smt(); rewrite W64.xorw0_s. - split. - + do !congr; rewrite H4 //. - + case: (21 < to_uint rate{2} %/ 8) => h; first by rewrite /A_jagged. - by have := H2 21; rewrite /A_jagged /= => ->; 1: smt(); rewrite W64.xorw0_s. - + case: (17 < to_uint rate{2} %/ 8) => h; first by rewrite /A_jagged. - by have := H2 17; rewrite /A_jagged /= => ->; 1: smt(); rewrite W64.xorw0_s. - + case: (13 < to_uint rate{2} %/ 8) => h; first by rewrite /A_jagged. - by have := H2 13; rewrite /A_jagged /= => ->; 1: smt(); rewrite W64.xorw0_s. - case: (9 < to_uint rate{2} %/ 8) => h; first by rewrite /A_jagged. - by have := H2 9; rewrite /A_jagged /= => ->; 1: smt(); rewrite W64.xorw0_s. - do !congr; rewrite H4 //. - + case: (6 < to_uint rate{2} %/ 8) => h; first by rewrite /A_jagged. - by have := H2 6; rewrite /A_jagged /= => ->; 1: smt(); rewrite W64.xorw0_s. - + case: (12 < to_uint rate{2} %/ 8) => h; first by rewrite /A_jagged. - by have := H2 12; rewrite /A_jagged /= => ->; 1: smt(); rewrite W64.xorw0_s. - + case: (18 < to_uint rate{2} %/ 8) => h; first by rewrite /A_jagged. - by have := H2 18; rewrite /A_jagged /= => ->; 1: smt(); rewrite W64.xorw0_s. - case: (24 < to_uint rate{2} %/ 8) => h; first by rewrite /A_jagged. - by have := H2 24; rewrite /A_jagged /= => ->; 1: smt(); rewrite W64.xorw0_s. + apply (state_xor_jagged _ _ _ (fun (off : int) => to_uint rate{2} %/ 8 <= off < 25)) => //= /#. qed. -(* some precondition on st holding 0 is needed and must be preserved; also something on jagged *) -equiv add_final_block_corr st : +phoare init_s_stateP : [Mmod.init_s_state : true ==> forall ofs, 0 <= ofs < 28 => res.[ofs] = W64.of_int 0] = 1%r. +proof. + proc => /=. + unroll for ^while; wp; skip => /> ofs h1 h2. + do 7!(rewrite Array28.initiE 1:// set_get_def 1,2://). + rewrite /x86_VPBROADCAST_4u64 /= pack4bE 1:/# /= W4u64.Pack.get_of_list 1:/# /= /#. +qed. + +lemma get64_set8 (t: W64.t Array28.t) i k w : + 0 <= i < 224 => 0 <= k < 28 => + get64 (set8 (init64 ("_.[_]" t))%WArray224 i w) k = + if 8 * k <= i < 8 * k + 8 then + W8u8.pack8_t (W8u8.Pack.init (fun j => if j = i%%8 then w else t.[k] \bits8 j)) + else t.[k]. +proof. + move=> hi hk; apply W8u8.wordP => j hj. + rewrite get64E W8u8.pack8bE 1:// initiE 1:// /= /set8. + case: (8 * k <= i < 8 * k + 8) => h. + + rewrite W8u8.pack8bE 1:// initiE 1:// /= /init64. + rewrite WArray224.get_setE 1://. + case: (8 * k + j = i) => [<<- /#| hne]. + rewrite initiE 1:/# /=; smt(). + rewrite set_neqiE 1:// 1:/# /init64 initiE /= /#. +qed. + +lemma get64_set8_200 (t: W64.t Array25.t) i k w : + 0 <= i < 200 => 0 <= k < 25 => + WArray200.WArray200.get64 (WArray200.WArray200.set8 (WArray200.WArray200.init64 ("_.[_]" t)) i w) k = + if 8 * k <= i < 8 * k + 8 then + W8u8.pack8_t (W8u8.Pack.init (fun j => if j = i%%8 then w else t.[k] \bits8 j)) + else t.[k]. +proof. + move=> hi hk; apply W8u8.wordP => j hj. + rewrite WArray200.WArray200.get64E W8u8.pack8bE 1:// initiE 1:// /= /set8. + case: (8 * k <= i < 8 * k + 8) => h. + + rewrite W8u8.pack8bE 1:// initiE 1:// /= /init64. + rewrite WArray200.WArray200.get_setE 1://. + case: (8 * k + j = i) => [<<- /#| hne]. + rewrite WArray200.WArray200.initiE 1:/# /=; smt(). + rewrite WArray200.WArray200.set_neqiE 1:// 1:/# /init64 WArray200.WArray200.initiE /= /#. +qed. + +equiv add_final_block_corr : Keccak_1600_ref_modular.Mmod.add_final_block ~ Mmod.add_final_block : - ={Glob.mem} /\ em_states state{2} state{1} /\ ={in_0,inlen} /\ s_state{2} = st - ==> - ={Glob.mem} /\ em_states res{2} res{1}. + to_uint rate{2} <= 200 /\ + to_uint a_jagged{2} + 200 < W64.modulus /\ + to_uint in_0{2} + to_uint inlen{2} < W64.modulus /\ + good_jag Glob.mem{2} (to_uint a_jagged{2}) /\ + ={Glob.mem} /\ em_states state{2} state{1} /\ ={in_0,inlen} /\ to_uint inlen{2} < to_uint rate{2} /\ r8{1} = rate{2} + ==> + em_states res{2} res{1}. proof. proc => /=. -admitted. + exlim state{1} => state0. + seq 4 5 : + ( to_uint rate{2} <= 200 /\ to_uint a_jagged{2} + 200 < W64.modulus /\ to_uint in_0{2} + to_uint inlen{2} < W64.modulus /\ + jagged_zeros_W64 s_state{2} (to_uint inlen{2} %/8) /\ + good_jag Glob.mem{2} (to_uint a_jagged{2}) /\ + (em_states state{2} state0) /\ ={Glob.mem, in_0, inlen} /\ to_uint inlen{2} < to_uint rate{2} /\ r8{1} = rate{2} /\ + i{1} = j{2} /\ to_uint j{2} = to_uint inlen{2} %/ 8 /\ + forall k, 0 <= k < 25 => + state{1}.[k] = if k < to_uint inlen{2} %/ 8 then state0.[k] `^` s_state{2}.[A_jagged.[k]] + else state0.[k]). + + while ( + to_uint rate{2} <= 200 /\ to_uint a_jagged{2} + 200 < W64.modulus /\ to_uint in_0{2} + to_uint inlen{2} < W64.modulus /\ + jagged_zeros_W64 s_state{2} (to_uint inlen{2} %/8) /\ + good_jag Glob.mem{2} (to_uint a_jagged{2}) /\ + (em_states state{2} state0) /\ ={Glob.mem, in_0, inlen, inlen8} /\ i{1} = j{2} /\ to_uint inlen{2} < to_uint rate{2} /\ r8{1} = rate{2} /\ + to_uint inlen8{2} = to_uint inlen{2} %/ 8 /\ to_uint i{1} <= to_uint inlen8{2} /\ + forall k, 0 <= k < 25 => + state{1}.[k] = if k < to_uint j{2} then state0.[k] `^` s_state{2}.[A_jagged.[k]] + else state0.[k]). + + wp; skip => /> &1 &2 hr200 hj200 hin0 hj0 hgj hem; rewrite !W64.ultE => hr8 hjr8 hjr hs _hh. + have heq : to_uint (W64.of_int 8 * j{2}) = 8 * to_uint j{2}. + + by rewrite W64.to_uintM_small //= /#. + rewrite to_uintD_small heq /= 1:/#. + rewrite to_uintD_small heq /= 1:/#. + rewrite to_uintD_small /=; 1: smt(W64.to_uint_cmp). + have ? : 0 <= to_uint j{2} < 25 by smt (W64.to_uint_cmp). + split. + + move=> k hk1 hk2. + rewrite hgj 1:// to_uintK_jagged 1:// Array28.set_neqiE 1:jagged_bound 1://; smt (jagged_inj). + split; 1: smt(). + rewrite hgj 1:// to_uintK_jagged 1:// => k hk1 hk2. + rewrite hs 1:// /=. + case (k < to_uint j{2} + 1) => hh. + + case (k = to_uint j{2}) => [->> | hne]. + + by rewrite Array25.set_eqiE 1,2:// Array28.set_eqiE 1:jagged_bound. + rewrite Array25.set_neqiE 1,2:// Array28.set_neqiE 1:jagged_bound //; smt (jagged_inj). + rewrite Array25.set_neqiE 1:// 1:/# hs 1:// /#. + wp; call{2} init_s_stateP; skip => |> &1 &2 *; split. + + split. + + by move=> off ??; rewrite H5 2://; apply jagged_bound. + rewrite /(`>>`) /= to_uint_shr //=. + split; 1: smt (W64.to_uint_cmp). + move=> k hk1 hk2; rewrite H5; 1: by apply jagged_bound. + by rewrite W64.xorw0. + by move=> state_ j_ s_state_; rewrite !W64.ultE => /#. + seq 6 15 : + (to_uint rate{2} <= 200 /\ + jagged_zeros_W64_p s_state{2} + (fun (off : int) => (to_uint inlen{2} %/8 + 1) <= off < 25 \/ off <> (to_uint rate{2} - 1) %/ 8) /\ + (em_states state{2} state0) /\ + forall k, 0 <= k < 25 => + state{1}.[k] = if k < to_uint inlen{2} %/ 8 + 1 /\ k = (to_uint rate{2} - 1) %/ 8 then state0.[k] `^` s_state{2}.[A_jagged.[k]] + else state0.[k]); last first. + + unroll for{2} ^while; wp; skip => |> &1 &2. + rewrite /em_states => /> /= *. + apply Array7.all_eq_eq; rewrite /Array7.all_eq /index /=. + apply (state_xor_jagged _ _ _ _ H0); smt(). + wp. + seq 0 2: (#pre /\ to_uint l{2} = 8 * A_jagged.[to_uint inlen{2} %/ 8]). + + wp; skip => /> &1 &2 *. + have heq : to_uint (W64.of_int 8 * j{2}) = 8 * to_uint j{2}. + + by rewrite W64.to_uintM_small //= /#. + have ?: 0 <= to_uint j{2} < 25 by smt(W64.to_uint_cmp). + rewrite to_uintD_small heq /= 1:/# H3 1://. + rewrite /(`<<`) /= W64.shlMP 1:// /= -W64.of_intM W64.to_uintM_small to_uintK_jagged //=; 1: smt(jagged_bound). + by rewrite H6; ring. + while ( + to_uint rate{2} <= 200 /\ + to_uint a_jagged{2} + 200 < W64.modulus /\ + to_uint in_0{2} + to_uint inlen{2} < W64.modulus /\ + jagged_zeros_W64 s_state{2} (to_uint inlen{2} %/8 + 1) /\ + (forall k, to_uint l{2} <= k < 8 * A_jagged.[to_uint inlen{2} %/ 8] + 8 => + s_state{2}.[k %/ 8] \bits8 (k %% 8) = W8.zero) /\ + ={Glob.mem, in_0, inlen} /\ + to_uint inlen{2} < to_uint rate{2} /\ + i{1} = j{2} /\ + to_uint l{2} = 8 * A_jagged.[to_uint inlen{2} %/ 8] + (to_uint j{2} - 8 * (to_uint inlen{2} %/ 8)) /\ + 8 * (to_uint inlen{2} %/ 8) <= to_uint j{2} <= to_uint inlen{2} /\ + forall (k : int), + 0 <= k < 25 => + state{1}.[k] = if k < to_uint inlen{2} %/ 8 + 1 then state0.[k] `^` s_state{2}.[A_jagged.[k]] else state0.[k]). + + wp; skip => /> &1 &2; rewrite W64.ultE => *. + rewrite !W64.to_uintD_small /=. + + smt(). + smt(W64.to_uint_cmp jagged_bound). + smt(). + split. + + move=> k hk1 hk2. + rewrite initiE; 1: by apply jagged_bound. + rewrite get64_set8; 1,2: smt(W64.to_uint_cmp jagged_bound). + smt(W64.to_uint_cmp jagged_inj). + split. + + move=> k hk1 hk2;rewrite initiE; 1: smt(W64.to_uint_cmp jagged_bound). + rewrite get64_set8; 1, 2: smt(W64.to_uint_cmp jagged_bound). + case: (8 * (k %/ 8) <= to_uint l{2} < 8 * (k %/ 8) + 8); last by smt(). + move=> ?; rewrite W8u8.pack8bE 1:/# initiE /= /#. + split; 1:ring H5. + split; 1: smt(). + move=> k hk1 hk2. + rewrite initiE; 1: by apply jagged_bound. + rewrite initiE 1:// get64_set8. + + smt(W64.to_uint_cmp jagged_bound). + by apply jagged_bound. + rewrite get64_set8_200 //. + + smt(W64.to_uint_cmp). + case: (8 * k <= to_uint j{2} < 8 * k + 8) => h; last by smt (@W64). + have -> /= : k < to_uint inlen{2} %/ 8 + 1 by smt(). + case: (8 * A_jagged.[k] <= to_uint l{2} < 8 * A_jagged.[k] + 8) => h1. + + apply W8u8.wordP => i hi. + rewrite /= !W8u8.pack8bE 1,2:// !initiE 1,2:// /=. + have -> : to_uint j{2} %% 8 = to_uint l{2} %% 8 by smt(). + case: (i = to_uint l{2} %% 8) => [->> | hne]; last by smt (@W64). + rewrite /WArray200.WArray200.get8 /WArray200.WArray200.init64 WArray200.WArray200.initiE /=; smt (@W64). + apply W8u8.wordP => i hi. + rewrite /= !W8u8.pack8bE 1,2:// !initiE 1,2:// /=. + case: (i = to_uint j{2} %% 8) => [->> | hne]; last by smt (@W64). + rewrite /WArray200.WArray200.get8 /WArray200.WArray200.init64 WArray200.WArray200.initiE /=; smt (@W64). + wp; skip => /> &1 &2 *. + split. + + rewrite /(`<<`) /= W64.to_uint_shl 1:// /=. + rewrite modz_small; 1: smt(W64.to_uint_cmp). + smt (@W64). + move=> ????; rewrite W64.ultE => *. + have heq: to_uint (rate{2} - W64.one `>>` W8.of_int 3) = (to_uint rate{2} - 1) %/ 8. + + rewrite /(`>>`) W64.to_uint_shr /= 1://. + rewrite W64.to_uintB 1:uleE //=; smt(W64.to_uint_cmp). + have heq1 : to_uint (W64.of_int 8 * (rate{2} - W64.one `>>` W8.of_int 3)) = + 8 * ((to_uint rate{2} - 1) %/ 8). + + rewrite to_uintM_small /= heq //; smt(W64.to_uint_cmp). + have -> : loadW64 Glob.mem{2} (to_uint (a_jagged{2} + (of_int 8)%W64 * (rate{2} - W64.one `>>` (of_int 3)%W8))) = + W64.of_int (A_jagged.[(to_uint rate{2} - 1) %/ 8]). + + rewrite W64.to_uintD_small /= heq1. smt(W64.to_uint_cmp). + rewrite H3 //; smt(W64.to_uint_cmp). + have heq2: to_uint ((rate{2} - W64.one) `&` W64.of_int 7) = (to_uint rate{2} - 1) %% 8. + + rewrite (W64.to_uint_and_mod 3) //=. + rewrite W64.to_uintB 1:uleE //=; smt(W64.to_uint_cmp). + have heq3 : to_uint ((W64.of_int A_jagged.[(to_uint rate{2} - 1) %/ 8]) `<<` W8.of_int 3) = + 8 * A_jagged.[(to_uint rate{2} - 1) %/ 8]. + + rewrite /(`<<`) /= W64.to_uint_shl 1:// /=. + smt (modz_small to_uintK_jagged W64.to_uint_cmp jagged_bound). + have heq4: to_uint (((W64.of_int A_jagged.[(to_uint rate{2} - 1) %/ 8]) `<<` W8.of_int 3) + (rate{2} - W64.one) `&` W64.of_int 7) = + 8 * A_jagged.[(to_uint rate{2} - 1) %/ 8] + (to_uint rate{2} - 1) %% 8. + + rewrite W64.to_uintD_small heq2 heq3 //; smt(W64.to_uint_cmp jagged_bound). + split. + + move=> k hk1 hk2. + rewrite Array28.initiE; 1: by apply jagged_bound. + rewrite heq4 get64_set8; 1,2: smt(W64.to_uint_cmp jagged_bound). + smt (@W64 jagged_bound jagged_inj). + move=> k hk1 hk2. + have -> : to_uint (rate{2} - W64.one) = to_uint rate{2} - 1. + + rewrite W64.to_uintB 1:uleE /=; smt(W64.to_uint_cmp). + rewrite Array28.initiE; 1: by apply jagged_bound. + rewrite heq4 get64_set8; 1,2: smt(W64.to_uint_cmp jagged_bound). + rewrite Array25.initiE 1:// get64_set8_200. + + smt(W64.to_uint_cmp). + + done. + smt (@W64 jagged_bound jagged_inj). +qed. (* some precondition on jagged needed *) - require import Keccak_f1600_scalar_table. equiv extr_full_block_corr _outlen _rate _out _iotas rl rr : @@ -625,103 +889,58 @@ equiv extr_bytes_corr : ={Glob.mem}. admitted. -equiv modcorrect mem : +equiv modcorrect : Keccak_1600_ref_modular.Mmod.__keccak_1600 ~ Mmod.__keccak_1600 : - Glob.mem{2} = mem /\ good_iotas mem (to_uint iotas{2}) /\ + to_uint rate{2} <= 200 /\ + to_uint a_jagged{2} + 200 < W64.modulus /\ + to_uint in_0{1} + to_uint inlen{1} < W64.modulus /\ + good_jag Glob.mem{2} (to_uint a_jagged{2}) /\ + good_iotas Glob.mem{2} (to_uint iotas{2}) /\ + good_rhol Glob.mem{2} (to_uint rhotates_left{2}) /\ + good_rhor Glob.mem{2} (to_uint rhotates_right{2}) /\ in_0{1} = in_0{2} /\ inlen{1} = inlen{2} /\ s_out{1} = out{2} /\ s_outlen{1} = outlen{2} /\ rate{1} = rate{2} /\ - good_rhol mem (to_uint rhotates_left{2}) /\ good_rhor mem (to_uint rhotates_right{2}) /\ - ={Glob.mem} ==> ={Glob.mem}. -proc. -seq 2 2 : (#pre /\ em_states state{2} state{1}). -inline *. unroll for {1} 4. unroll for {2} 5. -wp;skip;auto => />. -move => *; rewrite /x86_VPBROADCAST_4u64 /is4u6 /is4u64; progress. -by rewrite /a00 /array_build; auto => />. -by rewrite /a01 /array_build; auto => />. -by rewrite /a20 /array_build; auto => />. -by rewrite /a31 /array_build; auto => />. -by rewrite /a21 /array_build; auto => />. -by rewrite /a41 /array_build; auto => />. -by rewrite /a11 /array_build; auto => />. - -inline Mmod.absorb. -swap {2} [6..7] -5. - -seq 0 3 : (#pre /\ in_00{2} = in_0{1} /\ inlen0{2} = inlen{1} /\ em_states state0{2} state{1}); first by auto => />. - -sp 0 6 . -seq 0 2 : (#pre /\ forall i, 0 <= i < 7 => s_state{2}.[i] = W64.zero). -inline *. -unroll for {2} 5. -seq 0 2 : (#pre); first by auto. -sp 0 1. - -seq 0 2 : (#pre /\ s_state0{2}.[0] = W64.zero /\ i{2} = 0). -wp;skip;progress. -rewrite (set_get_eq s_state0{2} (x86_VPBROADCAST_4u64 Keccak_1600_avx2.g_zero) 0 0) => //=. -by rewrite /x86_VPBROADCAST_4u64 bits64E => //=. - -seq 0 2 : (#{~i{2}}pre /\ s_state0{2}.[1] = W64.zero /\ i{2} = 1). -wp;skip;progress. -by rewrite (set_get_diff s_state0{2} (x86_VPBROADCAST_4u64 Keccak_1600_avx2.g_zero) 1 0) => //=. -rewrite (set_get_eq s_state0{2} (x86_VPBROADCAST_4u64 Keccak_1600_avx2.g_zero) 1 1) => //=. -by rewrite /x86_VPBROADCAST_4u64 bits64E => //=. - -seq 0 2 : (#{~i{2}}pre /\ s_state0{2}.[2] = W64.zero /\ i{2} = 2). -wp;skip;progress. -by rewrite (set_get_diff s_state0{2} (x86_VPBROADCAST_4u64 Keccak_1600_avx2.g_zero) 2 0) => //=. -by rewrite (set_get_diff s_state0{2} (x86_VPBROADCAST_4u64 Keccak_1600_avx2.g_zero) 2 1) => //=. -rewrite (set_get_eq s_state0{2} (x86_VPBROADCAST_4u64 Keccak_1600_avx2.g_zero) 2 2) => //=. -by rewrite /x86_VPBROADCAST_4u64 bits64E => //=. - -seq 0 2 : (#{~i{2}}pre /\ s_state0{2}.[3] = W64.zero /\ i{2} = 3). -wp;skip;progress. -by rewrite (set_get_diff s_state0{2} (x86_VPBROADCAST_4u64 Keccak_1600_avx2.g_zero) 3 0) => //=. -by rewrite (set_get_diff s_state0{2} (x86_VPBROADCAST_4u64 Keccak_1600_avx2.g_zero) 3 1) => //=. -by rewrite (set_get_diff s_state0{2} (x86_VPBROADCAST_4u64 Keccak_1600_avx2.g_zero) 3 2) => //=. -rewrite (set_get_eq s_state0{2} (x86_VPBROADCAST_4u64 Keccak_1600_avx2.g_zero) 3 3) => //=. -by rewrite /x86_VPBROADCAST_4u64 bits64E => //=. - -seq 0 2 : (#{~i{2}}pre /\ s_state0{2}.[4] = W64.zero /\ i{2} = 4). -wp;skip;progress. -by rewrite (set_get_diff s_state0{2} (x86_VPBROADCAST_4u64 Keccak_1600_avx2.g_zero) 4 0) => //=. -by rewrite (set_get_diff s_state0{2} (x86_VPBROADCAST_4u64 Keccak_1600_avx2.g_zero) 4 1) => //=. -by rewrite (set_get_diff s_state0{2} (x86_VPBROADCAST_4u64 Keccak_1600_avx2.g_zero) 4 2) => //=. -by rewrite (set_get_diff s_state0{2} (x86_VPBROADCAST_4u64 Keccak_1600_avx2.g_zero) 4 3) => //=. -rewrite (set_get_eq s_state0{2} (x86_VPBROADCAST_4u64 Keccak_1600_avx2.g_zero) 4 4) => //=. -by rewrite /x86_VPBROADCAST_4u64 bits64E => //=. - -seq 0 2 : (#{~i{2}}pre /\ s_state0{2}.[5] = W64.zero /\ i{2} = 5). -wp;skip;progress. -by rewrite (set_get_diff s_state0{2} (x86_VPBROADCAST_4u64 Keccak_1600_avx2.g_zero) 5 0) => //=. -by rewrite (set_get_diff s_state0{2} (x86_VPBROADCAST_4u64 Keccak_1600_avx2.g_zero) 5 1) => //=. -by rewrite (set_get_diff s_state0{2} (x86_VPBROADCAST_4u64 Keccak_1600_avx2.g_zero) 5 2) => //=. -by rewrite (set_get_diff s_state0{2} (x86_VPBROADCAST_4u64 Keccak_1600_avx2.g_zero) 5 3) => //=. -by rewrite (set_get_diff s_state0{2} (x86_VPBROADCAST_4u64 Keccak_1600_avx2.g_zero) 5 4) => //=. -rewrite (set_get_eq s_state0{2} (x86_VPBROADCAST_4u64 Keccak_1600_avx2.g_zero) 5 5) => //=. -by rewrite /x86_VPBROADCAST_4u64 bits64E => //=. - -seq 0 2 : (#{~i{2}}pre /\ s_state0{2}.[6] = W64.zero /\ i{2} = 6). -wp;skip;progress. -by rewrite (set_get_diff s_state0{2} (x86_VPBROADCAST_4u64 Keccak_1600_avx2.g_zero) 6 0) => //=. -by rewrite (set_get_diff s_state0{2} (x86_VPBROADCAST_4u64 Keccak_1600_avx2.g_zero) 6 1) => //=. -by rewrite (set_get_diff s_state0{2} (x86_VPBROADCAST_4u64 Keccak_1600_avx2.g_zero) 6 2) => //=. -by rewrite (set_get_diff s_state0{2} (x86_VPBROADCAST_4u64 Keccak_1600_avx2.g_zero) 6 3) => //=. -by rewrite (set_get_diff s_state0{2} (x86_VPBROADCAST_4u64 Keccak_1600_avx2.g_zero) 6 4) => //=. -by rewrite (set_get_diff s_state0{2} (x86_VPBROADCAST_4u64 Keccak_1600_avx2.g_zero) 6 5) => //=. -rewrite (set_get_eq s_state0{2} (x86_VPBROADCAST_4u64 Keccak_1600_avx2.g_zero) 6 6) => //=. -by rewrite /x86_VPBROADCAST_4u64 bits64E => //=. - -by auto => />; smt(). - -seq 1 1 : #{/~em_states state{2} state{1}}{~in_0{1} = in_0{2}}{~inlen{1} = inlen{2}}{~s_state{2}}pre. - -while (#post). -wp. + ={Glob.mem} + ==> + ={Glob.mem}. +proof. + proc => /=. + seq 2 2 : (#pre /\ em_states state{2} state{1}). + + inline *. unroll for {1} 4. unroll for {2} 5. + wp;skip;auto => />. + move => *; rewrite /x86_VPBROADCAST_4u64 /is4u6 /is4u64 => />. + by rewrite /em_states; apply Array7.all_eq_eq. + inline Mmod.absorb. + swap {2} [6..7] -5. + seq 0 3 : (#pre /\ in_00{2} = in_0{1} /\ inlen0{2} = inlen{1} /\ em_states state0{2} state{1}); first by auto => />. + sp 0 6. + seq 0 2 : (#pre /\ forall i, 0 <= i < 28 => s_state{2}.[i] = W64.zero). + + inline *. + unroll for {2} 5. + wp; skip => /> *. + do 7! (rewrite initiE // set_get_def //). + rewrite /x86_VPBROADCAST_4u64 /= W4u64.pack4bE 1:/#. + by rewrite W4u64.Pack.get_of_list 1:/# /= /#. + seq 1 1 : #{/~em_states state{2} state{1}}{~in_0{1} = in_0{2}}{~inlen{1} = inlen{2}} + {~s_state{2}} + {~forall (i : int), 0 <= i < 28 => s_state{2}.[i] = Keccak_1600_avx2.g_zero} + {~to_uint in_0{2} + to_uint inlen{2} < 18446744073709551616}pre. + while (#post /\ jagged_zeros_W64 s_state{2} (to_uint rate0{2} %/ 8)). + + wp. + ecall (avx2corr state{1} iotas0{2} Glob.mem{2}). + wp. + ecall (add_full_block_corr (to_uint rate0{2})). + skip => |> &1 &2. + rewrite W64.uleE => *. + split; 1 : smt(). + move=> *. + split. + + + split. + move=> ?. +smt(). seq 1 1 : #{/~rate{1} \ule inlen{1}}{~rate0{2} \ule inlen0{2}}pre. -exists* s_state{2}. -elim* => sst. -call (add_full_block_corr sst). +exlim rate0{2} => rr. + skip;progress. smt(). smt(). exists* state{1}. elim* => st. From d6cde32a5455885b74deba6ee8a047e8f29c82b9 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Thu, 16 May 2019 19:55:01 +0200 Subject: [PATCH 427/525] almost done --- proof/impl/libc/keccak_1600_avx2_modular.ec | 156 ++++++---------- proof/impl/perm/keccak_f1600_avx2.ec | 197 ++++++++++++++++---- 2 files changed, 218 insertions(+), 135 deletions(-) diff --git a/proof/impl/libc/keccak_1600_avx2_modular.ec b/proof/impl/libc/keccak_1600_avx2_modular.ec index 49dd577..c7db442 100644 --- a/proof/impl/libc/keccak_1600_avx2_modular.ec +++ b/proof/impl/libc/keccak_1600_avx2_modular.ec @@ -416,16 +416,6 @@ op good_jag (mem : global_mem_t, _jag : int) = then W64.zero (* FIX ME: just read the remaining bytes *) else W64.zero. *) -op em_states (state : W256.t Array7.t) (st : W64.t Array25.t) = - state = - Array7.of_list witness [pack4 [st.[index 0 0]; st.[index 0 0]; st.[index 0 0]; st.[index 0 0]]; - pack4 [st.[index 0 1]; st.[index 0 2]; st.[index 0 3]; st.[index 0 4]]; - pack4 [st.[index 2 0]; st.[index 4 0]; st.[index 1 0]; st.[index 3 0]]; - pack4 [st.[index 3 1]; st.[index 1 2]; st.[index 4 3]; st.[index 2 4]]; - pack4 [st.[index 2 1]; st.[index 4 2]; st.[index 1 3]; st.[index 3 4]]; - pack4 [st.[index 4 1]; st.[index 3 2]; st.[index 2 3]; st.[index 1 4]]; - pack4 [st.[index 1 1]; st.[index 2 2]; st.[index 3 3]; st.[index 4 4]]]. - lemma jagged_bound k : 0 <= k < 25 => 0 <= A_jagged.[k] < 28. proof. by move: k; apply (Array25.allP A_jagged (fun i => 0 <= i < 28)); cbv delta. @@ -533,6 +523,7 @@ pack4 [state1.[6]; state1.[12]; state1.[18]; state1.[24]]. proof. move=> H2 H4. rewrite !get256_64 // !get64_init64 //=. + rewrite /rev /=. have -> /= : state0.[0] `^` s_state2.[0] = state1.[0]. + rewrite H4 //; case: (!P 0) => h /=. + by rewrite /A_jagged. @@ -600,37 +591,38 @@ qed. equiv add_full_block_corr rr : Keccak_1600_ref_modular.Mmod.add_full_block ~ Mmod.add_full_block : - to_uint rate{2} <= 200 /\ to_uint a_jagged{2} + 200 < W64.modulus /\ to_uint in_0{2} + to_uint rate{2} < W64.modulus /\ - jagged_zeros_W64 s_state{2} (to_uint rate{2} %/ 8) /\ to_uint rate{2} = rr /\ - good_jag Glob.mem{2} (to_uint a_jagged{2}) /\ + to_uint rate{2} <= 200 /\ to_uint a_jagged{2} + 200 < W64.modulus /\ to_uint in_0{2} + to_uint inlen{2} < W64.modulus /\ + jagged_zeros_W64 s_state{2} (to_uint rate{2} %/ 8) /\ to_uint rate{2} = rr /\ + good_jag Glob.mem{2} (to_uint a_jagged{2}) /\ to_uint rate{2} <= to_uint inlen{2} /\ ={Glob.mem} /\ em_states state{2} state{1} /\ ={in_0,inlen,rate} ==> jagged_zeros_W64 res{2}.`2 (rr %/ 8) /\ em_states res{2}.`1 res{1}.`1 /\ - res{1}.`2 = res{2}.`3 /\ res{1}.`3 = res{2}.`4. + res{1}.`2 = res{2}.`3 /\ res{1}.`3 = res{2}.`4 /\ + to_uint res{2}.`3 + to_uint res{2}.`4 < W64.modulus. proof. proc => /=. exlim state{1} => state0. seq 4 4 : - ( to_uint rate{2} <= 200 /\ to_uint a_jagged{2} + 200 < W64.modulus /\ to_uint in_0{2} + to_uint rate{2} < W64.modulus /\ + ( to_uint rate{2} <= 200 /\ to_uint a_jagged{2} + 200 < W64.modulus /\ to_uint in_0{2} + to_uint inlen{2} < W64.modulus /\ jagged_zeros_W64 s_state{2} (to_uint rate{2} %/ 8) /\ to_uint rate{2} = rr /\ - good_jag Glob.mem{2} (to_uint a_jagged{2}) /\ + good_jag Glob.mem{2} (to_uint a_jagged{2}) /\ to_uint rate{2} <= to_uint inlen{2} /\ (em_states state{2} state0) /\ ={Glob.mem, in_0, inlen, rate} /\ forall k, 0 <= k < 25 => state{1}.[k] = if k < to_uint rate{2} %/ 8 then state0.[k] `^` s_state{2}.[A_jagged.[k]] else state0.[k]). + while ( - to_uint rate{2} <= 200 /\ to_uint a_jagged{2} + 200 < W64.modulus /\ to_uint in_0{2} + to_uint rate{2} < W64.modulus /\ + to_uint rate{2} <= 200 /\ to_uint a_jagged{2} + 200 < W64.modulus /\ to_uint in_0{2} + to_uint inlen{2} < W64.modulus /\ jagged_zeros_W64 s_state{2} (to_uint rate{2} %/ 8) /\ to_uint rate{2} = rr /\ - good_jag Glob.mem{2} (to_uint a_jagged{2}) /\ + good_jag Glob.mem{2} (to_uint a_jagged{2}) /\ to_uint rate{2} <= to_uint inlen{2} /\ (em_states state{2} state0) /\ ={Glob.mem, in_0, inlen, rate} /\ i{1} = j{2} /\ rate64{1} = rate8{2} /\ to_uint rate8{2} = to_uint rate{2} %/ 8 /\ to_uint i{1} <= to_uint rate8{2} /\ forall k, 0 <= k < 25 => state{1}.[k] = if k < to_uint j{2} then state0.[k] `^` s_state{2}.[A_jagged.[k]] else state0.[k]). - + wp; skip => /> &1 &2 hr200 hj200 hin0 hj0 hgj hem; rewrite !W64.ultE => hr8 hjr8 hs hjr. + + wp; skip => /> &1 &2 hr200 hj200 hin0 hj0 hgj hle hem; rewrite !W64.ultE => hr8 hjr8 hs hjr. have heq : to_uint (W64.of_int 8 * j{2}) = 8 * to_uint j{2}. + by rewrite W64.to_uintM_small //= /#. rewrite to_uintD_small heq /= 1:/#. @@ -655,8 +647,11 @@ proof. rewrite /em_states => /> /= *; split. + rewrite /jagged_zeros_W64 => off h1 h2. by rewrite !Array28.set_neqiE //; 1..3: smt (jagged_diff); rewrite H2. - apply Array7.all_eq_eq; rewrite /Array7.all_eq /index /=. - apply (state_xor_jagged _ _ _ (fun (off : int) => to_uint rate{2} %/ 8 <= off < 25)) => //= /#. + split. + + apply Array7.all_eq_eq; rewrite /Array7.all_eq /index /=. + apply (state_xor_jagged _ _ _ (fun (off : int) => to_uint rate{2} %/ 8 <= off < 25)) => //= /#. + rewrite W64.to_uintD_small 1:/#. + rewrite W64.to_uintB 1:W64.uleE // /#. qed. phoare init_s_stateP : [Mmod.init_s_state : true ==> forall ofs, 0 <= ofs < 28 => res.[ofs] = W64.of_int 0] = 1%r. @@ -873,7 +868,7 @@ require import Keccak_f1600_scalar_table. equiv extr_full_block_corr _outlen _rate _out _iotas rl rr : Keccak_1600_ref_modular.Mmod.xtr_full_block ~ Mmod.xtr_full_block : - good_iotas Glob.mem{2} _iotas /\ + good_io4x Glob.mem{2} _iotas /\ good_rhol Glob.mem{2} rl /\ good_rhor Glob.mem{2} rr /\ rate{1} = _rate /\ outlen{1} = _outlen /\ out{1} = _out /\ em_states state{2} state{1} /\ ={Glob.mem,out} /\ rate{1} = len{2} ==> @@ -894,8 +889,11 @@ equiv modcorrect : to_uint rate{2} <= 200 /\ to_uint a_jagged{2} + 200 < W64.modulus /\ to_uint in_0{1} + to_uint inlen{1} < W64.modulus /\ + to_uint rhotates_left{2} + 192 < W64.modulus /\ + to_uint rhotates_right{2} + 192 < W64.modulus /\ + to_uint iotas{2} + 768 < W64.modulus /\ good_jag Glob.mem{2} (to_uint a_jagged{2}) /\ - good_iotas Glob.mem{2} (to_uint iotas{2}) /\ + good_io4x Glob.mem{2} (to_uint iotas{2}) /\ good_rhol Glob.mem{2} (to_uint rhotates_left{2}) /\ good_rhor Glob.mem{2} (to_uint rhotates_right{2}) /\ in_0{1} = in_0{2} /\ inlen{1} = inlen{2} /\ s_out{1} = out{2} /\ s_outlen{1} = outlen{2} /\ rate{1} = rate{2} /\ @@ -920,92 +918,50 @@ proof. do 7! (rewrite initiE // set_get_def //). rewrite /x86_VPBROADCAST_4u64 /= W4u64.pack4bE 1:/#. by rewrite W4u64.Pack.get_of_list 1:/# /= /#. - seq 1 1 : #{/~em_states state{2} state{1}}{~in_0{1} = in_0{2}}{~inlen{1} = inlen{2}} + seq 1 1 : (#{/~em_states state{2} state{1}}{~in_0{1} = in_0{2}}{~inlen{1} = inlen{2}} {~s_state{2}} {~forall (i : int), 0 <= i < 28 => s_state{2}.[i] = Keccak_1600_avx2.g_zero} - {~to_uint in_0{2} + to_uint inlen{2} < 18446744073709551616}pre. - while (#post /\ jagged_zeros_W64 s_state{2} (to_uint rate0{2} %/ 8)). - + wp. - ecall (avx2corr state{1} iotas0{2} Glob.mem{2}). + {~to_uint in_0{2} + to_uint inlen{2} < 18446744073709551616}pre /\ + to_uint inlen{1} < to_uint rate{1}). + + while (#{/~to_uint inlen{1} < to_uint rate{1}} post /\ + jagged_zeros_W64 s_state{2} (to_uint rate0{2} %/ 8)); last first. + + skip => />; smt(jagged_bound W64.uleE). + wp. + ecall (avx2corr state{1} Glob.mem{2}). wp. ecall (add_full_block_corr (to_uint rate0{2})). skip => |> &1 &2. - rewrite W64.uleE => *. - split; 1 : smt(). - move=> *. - split. - - + split. - move=> ?. -smt(). -seq 1 1 : #{/~rate{1} \ule inlen{1}}{~rate0{2} \ule inlen0{2}}pre. -exlim rate0{2} => rr. - -skip;progress. smt(). smt(). -exists* state{1}. -elim* => st. -exists* iotas0{2}. -elim * => _iotas. -exists* Glob.mem{2}. -elim * => memm. -call (avx2corr st _iotas memm). -by auto => />. -by auto => />. -seq 3 2 : (#{/~em_states state0{2} state{1}}pre /\ - em_states state{2} state{1}). -exists* s_state{2}. -elim* => sst. -wp;call (add_final_block_corr sst). -by auto => />. -inline Mmod.squeeze. -swap {2} [2..5] -1. -swap {2} 8 -7. -sp 0 5. - -seq 1 3 : (#{/~em_states state{2} state{1}}{~Glob.mem{2} = mem} + rewrite W64.uleE => * /#. + seq 3 2 : (#{/~em_states state0{2} state{1}}pre /\ + em_states state{2} state{1}). + + by wp; call add_final_block_corr; auto => />. + inline Mmod.squeeze. + swap {2} [2..5] -1; swap {2} 8 -7. + sp 0 5. +(* Stopped here *) + seq 1 3 : (#{/~em_states state{2} state{1}} {~s_out{1}=out{2}}{~s_outlen{1} = outlen{2}}pre /\ out0{2} = s_out{1} /\ outlen0{2} = outlen{1} /\ - em_states state1{2} state{1}/\ - good_iotas Glob.mem{2} (to_uint iotas{2}) /\ + em_states state1{2} state{1} /\ + good_io4x Glob.mem{2} (to_uint iotas{2}) /\ good_rhol Glob.mem{2} (to_uint rhotates_left{2}) /\ - good_rhor Glob.mem{2} (to_uint rhotates_right{2})); + good_rhor Glob.mem{2} (to_uint rhotates_right{2})); first by auto => />. + + seq 1 1 : #pre. + while #pre. + + swap {1} 4 2. + seq 5 1 : #pre. + + by wp; ecall (avx2corr state{1} Glob.mem{2}); auto => />. + wp. + ecall (extr_full_block_corr outlen{1} rate1{2} s_out{1} (to_uint iotas1{2}) + (to_uint rhotates_left{2}) (to_uint rhotates_right{2})). + wp; skip => &1 &2 [#] 11!->> 9? 4!->> ? 2!->> ????. + rewrite W64.ultE. + move => ??; split; 1:done. + move=> h {h} />. + move=> *. rewrite !W64.ultE. + admit. -seq 1 1 : #pre. - -while #pre. - -swap {1} 4 2. -seq 5 1 : #pre. -wp. -exists* state{1}. -elim* => st. -exists* iotas1{2}. -elim * => _iotas. -exists* Glob.mem{2}. -elim * => memm. -call (avx2corr st _iotas memm). -by auto => />. - -wp. -exists* outlen{1}. -elim* => _outlen. -exists* s_out{1}. -elim* => _out. -exists* rate1{2}. -elim* => _rate. -exists* (to_uint rhotates_left{2}). -elim* => _rl. -exists* (to_uint rhotates_right{2}). -elim* => _rr. -exists* (to_uint iotas1{2}). -elim* => _iotas. -call (extr_full_block_corr _outlen _rate _out _iotas _rl _rr). -auto => />. -progress. -smt(). -smt(). -smt(). by auto => />. swap {1} 3 1. @@ -1017,7 +973,7 @@ exists* iotas{2}. elim * => _iotas. exists* Glob.mem{2}. elim * => memm. -call (avx2corr st _iotas memm). +call (avx2corr st memm). by auto => />. call (extr_bytes_corr). diff --git a/proof/impl/perm/keccak_f1600_avx2.ec b/proof/impl/perm/keccak_f1600_avx2.ec index 2130b47..dcbfa9c 100644 --- a/proof/impl/perm/keccak_f1600_avx2.ec +++ b/proof/impl/perm/keccak_f1600_avx2.ec @@ -825,50 +825,177 @@ require Keccak_f1600_ref_table. require import Keccak_f1600_avx2_prevec. require Keccak_f1600_avx2_prevec_vops. -print Keccak_f1600_avx2_prevec_vops.match_states. require import Ops. -print is4u64. -op array_build (a b c d : W64.t) = - (witness - .[0 <- a] - .[1 <- b] - .[2 <- c] - .[3 <- d])%Array4. +op em_states (state : W256.t Array7.t) (st : W64.t Array25.t) = + state = + Array7.of_list witness [pack4 [st.[index 0 0]; st.[index 0 0]; st.[index 0 0]; st.[index 0 0]]; + pack4 [st.[index 0 1]; st.[index 0 2]; st.[index 0 3]; st.[index 0 4]]; + pack4 [st.[index 2 0]; st.[index 4 0]; st.[index 1 0]; st.[index 3 0]]; + pack4 [st.[index 3 1]; st.[index 1 2]; st.[index 4 3]; st.[index 2 4]]; + pack4 [st.[index 2 1]; st.[index 4 2]; st.[index 1 3]; st.[index 3 4]]; + pack4 [st.[index 4 1]; st.[index 3 2]; st.[index 2 3]; st.[index 1 4]]; + pack4 [st.[index 1 1]; st.[index 2 2]; st.[index 3 3]; st.[index 4 4]]]. -op a00(st : W64.t Array25.t) = array_build st.[index 0 0] st.[index 0 0] st.[index 0 0] st.[index 0 0]. -op a01(st : W64.t Array25.t) = array_build st.[index 0 4] st.[index 0 3] st.[index 0 2] st.[index 0 1]. -op a20(st : W64.t Array25.t) = array_build st.[index 3 0] st.[index 1 0] st.[index 4 0] st.[index 2 0]. -op a31(st : W64.t Array25.t) = array_build st.[index 2 4] st.[index 4 3] st.[index 1 2] st.[index 3 1]. -op a21(st : W64.t Array25.t) = array_build st.[index 3 4] st.[index 1 3] st.[index 4 2] st.[index 2 1]. -op a41(st : W64.t Array25.t) = array_build st.[index 1 4] st.[index 2 3] st.[index 3 2] st.[index 4 1]. -op a11(st : W64.t Array25.t) = array_build st.[index 4 4] st.[index 3 3] st.[index 2 2] st.[index 1 1]. - -op em_states (state : W256.t Array7.t, st : W64.t Array25.t) : bool = - is4u64 (a00 st) state.[0] /\ - is4u64 (a01 st) state.[1] /\ - is4u64 (a20 st) state.[2] /\ - is4u64 (a31 st) state.[3] /\ - is4u64 (a21 st) state.[4] /\ - is4u64 (a41 st) state.[5] /\ - is4u64 (a11 st) state.[6]. - -lemma avx2corr st _iotas mem : +lemma avx2corr st mem : equiv [ Keccak_f1600_ref.M.__keccak_f1600_ref ~ M.__keccak_f1600_avx2 : W64.to_uint _rhotates_left{2} + 192 < W64.modulus /\ + W64.to_uint _rhotates_right{2} + 192 < W64.modulus /\ + W64.to_uint _iotas{2} + 768 < W64.modulus /\ Glob.mem{2} = mem /\ + Keccak_f1600_avx2_prevec.good_io4x mem (W64.to_uint _iotas{2}) /\ + good_rhol mem (to_uint _rhotates_left{2}) /\ + good_rhor mem (to_uint _rhotates_right{2}) /\ + em_states state{2} state{1} /\ st = state{1} ==> + Glob.mem{2} = mem /\ em_states res{2} res{1} ]. +proof. + +transitivity Keccak_f1600_ref_table.Mreftable.__keccak_f1600_ref + (={Glob.mem, state} ==> ={Glob.mem, res}) + (W64.to_uint _rhotates_left{2} + 192 < W64.modulus /\ W64.to_uint _rhotates_right{2} + 192 < W64.modulus /\ W64.to_uint _iotas{2} + 768 < W64.modulus /\ Glob.mem{2} = mem /\ Keccak_f1600_avx2_prevec.good_io4x mem (W64.to_uint _iotas{2}) /\ good_rhol mem (to_uint _rhotates_left{2}) /\ good_rhor mem (to_uint _rhotates_right{2}) /\ em_states state{2} state{1} /\ st = state{1} ==> - Glob.mem{2} = mem /\ em_states res{2} res{1} ]. -move : Keccak_f1600_ref_op.ref_refop => *. -move : Keccak_f1600_ref_table.ref_reftable => *. -move : (Keccak_f1600_avx2_prevec.correct_perm - (a00 st) (a01 st) (a20 st) (a31 st) (a21 st) (a41 st) (a11 st) st mem) => *. -move : Keccak_f1600_avx2_prevec_vops.prevec_vops_prevec => *. -move : Keccak_f1600_avx2_prevec_vops.prevec_vops_openssl => *. -move : avx2_avx2_openssl => *. -admit. (* how to join them all? *) + Glob.mem{2} = mem /\ em_states res{2} res{1}). ++ smt(). + done. ++ transitivity Keccak_f1600_ref_op.Mrefop.__keccak_f1600_ref + (={Glob.mem, state} ==> ={Glob.mem, res}) + (={Glob.mem, state} ==> ={Glob.mem, res}) => //. + + smt(). + + by apply Keccak_f1600_ref_op.ref_refop. + by conseq Keccak_f1600_ref_table.ref_reftable. +transitivity Mavx2_prevec.__KeccakF1600 + (to_uint _rhotates_left{2} + 192 < W64.modulus /\ + to_uint _rhotates_right{2} + 192 < W64.modulus /\ + to_uint _iotas{2} + 768 < W64.modulus /\ + Glob.mem{2} = mem /\ + good_io4x mem (to_uint _iotas{2}) /\ + good_rhol mem (to_uint _rhotates_left{2}) /\ + good_rhor mem (to_uint _rhotates_right{2}) /\ + equiv_states ((of_list witness [st.[index 0 0]; st.[index 0 0]; st.[index 0 0]; st.[index 0 0]]))%Array4 + ((of_list witness [st.[index 0 1]; st.[index 0 2]; st.[index 0 3]; st.[index 0 4]]))%Array4 + ((of_list witness [st.[index 2 0]; st.[index 4 0]; st.[index 1 0]; st.[index 3 0]]))%Array4 + ((of_list witness [st.[index 3 1]; st.[index 1 2]; st.[index 4 3]; st.[index 2 4]]))%Array4 + ((of_list witness [st.[index 2 1]; st.[index 4 2]; st.[index 1 3]; st.[index 3 4]]))%Array4 + ((of_list witness [st.[index 4 1]; st.[index 3 2]; st.[index 2 3]; st.[index 1 4]]))%Array4 + ((of_list witness [st.[index 1 1]; st.[index 2 2]; st.[index 3 3]; st.[index 4 4]]))%Array4 st /\ + a00{2} = (of_list witness [st.[index 0 0]; st.[index 0 0]; st.[index 0 0]; st.[index 0 0]])%Array4 /\ + a01{2} = (of_list witness [st.[index 0 1]; st.[index 0 2]; st.[index 0 3]; st.[index 0 4]])%Array4 /\ + a20{2} = (of_list witness [st.[index 2 0]; st.[index 4 0]; st.[index 1 0]; st.[index 3 0]])%Array4 /\ + a31{2} = (of_list witness [st.[index 3 1]; st.[index 1 2]; st.[index 4 3]; st.[index 2 4]])%Array4 /\ + a21{2} = (of_list witness [st.[index 2 1]; st.[index 4 2]; st.[index 1 3]; st.[index 3 4]])%Array4 /\ + a41{2} = (of_list witness [st.[index 4 1]; st.[index 3 2]; st.[index 2 3]; st.[index 1 4]])%Array4 /\ + a11{2} = (of_list witness [st.[index 1 1]; st.[index 2 2]; st.[index 3 3]; st.[index 4 4]])%Array4 /\ + state{1} = st + ==> + Glob.mem{2} = mem /\ + equiv_states res{2}.`1 res{2}.`2 res{2}.`3 res{2}.`4 res{2}.`5 res{2}.`6 res{2}.`7 res{1}) + + (W64.to_uint _rhotates_left{2} + 192 < W64.modulus /\ + W64.to_uint _rhotates_right{2} + 192 < W64.modulus /\ + W64.to_uint _iotas{2} + 768 < W64.modulus /\ ={Glob.mem, _rhotates_left, _rhotates_right, _iotas} /\ + Keccak_f1600_avx2_prevec.good_io4x mem (W64.to_uint _iotas{2}) /\ + good_rhol mem (to_uint _rhotates_left{2}) /\ + good_rhor mem (to_uint _rhotates_right{2}) /\ + state{2} = Array7.of_list witness [pack4 (Array4.to_list a00{1}); + pack4 (Array4.to_list a01{1}); + pack4 (Array4.to_list a20{1}); + pack4 (Array4.to_list a31{1}); + pack4 (Array4.to_list a21{1}); + pack4 (Array4.to_list a41{1}); + pack4 (Array4.to_list a11{1})] /\ + a00{1} = (of_list witness [st.[index 0 0]; st.[index 0 0]; st.[index 0 0]; st.[index 0 0]])%Array4 /\ + a01{1} = (of_list witness [st.[index 0 1]; st.[index 0 2]; st.[index 0 3]; st.[index 0 4]])%Array4 /\ + a20{1} = (of_list witness [st.[index 2 0]; st.[index 4 0]; st.[index 1 0]; st.[index 3 0]])%Array4 /\ + a31{1} = (of_list witness [st.[index 3 1]; st.[index 1 2]; st.[index 4 3]; st.[index 2 4]])%Array4 /\ + a21{1} = (of_list witness [st.[index 2 1]; st.[index 4 2]; st.[index 1 3]; st.[index 3 4]])%Array4 /\ + a41{1} = (of_list witness [st.[index 4 1]; st.[index 3 2]; st.[index 2 3]; st.[index 1 4]])%Array4 /\ + a11{1} = (of_list witness [st.[index 1 1]; st.[index 2 2]; st.[index 3 3]; st.[index 4 4]])%Array4 + ==> + ={Glob.mem} /\ + let (a00, a01, a20, a31, a21, a41, a11) = res{1} in + res{2} = + Array7.of_list witness [pack4 (Array4.to_list a00); + pack4 (Array4.to_list a01); + pack4 (Array4.to_list a20); + pack4 (Array4.to_list a31); + pack4 (Array4.to_list a21); + pack4 (Array4.to_list a41); + pack4 (Array4.to_list a11)]). ++ move=> &1 &2 [#] ??? <<- ???. + rewrite /em_states => h1 <<-. + rewrite h1. + exists Glob.mem{2}. + by exists (Array4.of_list witness [st.[index 0 0]; st.[index 0 0]; st.[index 0 0]; st.[index 0 0]], + Array4.of_list witness [st.[index 0 1]; st.[index 0 2]; st.[index 0 3]; st.[index 0 4]], + Array4.of_list witness [st.[index 2 0]; st.[index 4 0]; st.[index 1 0]; st.[index 3 0]], + Array4.of_list witness [st.[index 3 1]; st.[index 1 2]; st.[index 4 3]; st.[index 2 4]], + Array4.of_list witness [st.[index 2 1]; st.[index 4 2]; st.[index 1 3]; st.[index 3 4]], + Array4.of_list witness [st.[index 4 1]; st.[index 3 2]; st.[index 2 3]; st.[index 1 4]], + Array4.of_list witness [st.[index 1 1]; st.[index 2 2]; st.[index 3 3]; st.[index 4 4]], + _rhotates_left{2}, _rhotates_right{2}, _iotas{2}) => />. ++ move=> &1 &m &2 />. + case: ( res{m} ) => a00 a01 a20 a31 a21 a41 a11 /=. + rewrite /to_list /em_states /= /mkseq /=. + by move=> 29! ->. ++ apply (Keccak_f1600_avx2_prevec.correct_perm + (Array4.of_list witness [st.[index 0 0]; st.[index 0 0]; st.[index 0 0]; st.[index 0 0]]) + (Array4.of_list witness [st.[index 0 1]; st.[index 0 2]; st.[index 0 3]; st.[index 0 4]]) + (Array4.of_list witness [st.[index 2 0]; st.[index 4 0]; st.[index 1 0]; st.[index 3 0]]) + (Array4.of_list witness [st.[index 3 1]; st.[index 1 2]; st.[index 4 3]; st.[index 2 4]]) + (Array4.of_list witness [st.[index 2 1]; st.[index 4 2]; st.[index 1 3]; st.[index 3 4]]) + (Array4.of_list witness [st.[index 4 1]; st.[index 3 2]; st.[index 2 3]; st.[index 1 4]]) + (Array4.of_list witness [st.[index 1 1]; st.[index 2 2]; st.[index 3 3]; st.[index 4 4]]) + st mem). + +transitivity Keccak_f1600_avx2_prevec_vops.Mavx2_prevec_vops.__KeccakF1600 + (={Glob.mem} /\ Keccak_f1600_avx2_prevec_vops.match_ins arg{1} arg{2}==> + ={Glob.mem} /\ Keccak_f1600_avx2_prevec_vops.match_states res{1} res{2}) + +( to_uint _rhotates_left{2} + 192 < W64.modulus /\ + to_uint _rhotates_right{2} + 192 < W64.modulus /\ + to_uint _iotas{2} + 768 < W64.modulus /\ + ={Glob.mem, _rhotates_left, _rhotates_right, _iotas} /\ + good_io4x mem (to_uint _iotas{2}) /\ + good_rhol mem (to_uint _rhotates_left{2}) /\ + good_rhor mem (to_uint _rhotates_right{2}) /\ + state{2} = + Array7.of_list witness [arg.`1; arg.`2; arg.`3; arg.`4; arg.`5; arg.`6; arg.`7]{1} ==> + ={Glob.mem} /\ + res{2} = Array7.of_list witness [res.`1; res.`2; res.`3; res.`4; res.`5; res.`6; res.`7]{1}). ++ move=> /> *. + exists Glob.mem{2}. + exists (pack4 [st.[index 0 0]; st.[index 0 0]; st.[index 0 0]; st.[index 0 0]], + pack4 [st.[index 0 1]; st.[index 0 2]; st.[index 0 3]; st.[index 0 4]], + pack4 [st.[index 2 0]; st.[index 4 0]; st.[index 1 0]; st.[index 3 0]], + pack4 [st.[index 3 1]; st.[index 1 2]; st.[index 4 3]; st.[index 2 4]], + pack4 [st.[index 2 1]; st.[index 4 2]; st.[index 1 3]; st.[index 3 4]], + pack4 [st.[index 4 1]; st.[index 3 2]; st.[index 2 3]; st.[index 1 4]], + pack4 [st.[index 1 1]; st.[index 2 2]; st.[index 3 3]; st.[index 4 4]], + _rhotates_left{2}, _rhotates_right{2}, _iotas{2}) => />. + by rewrite H8 H9 H10 H11 H12 H13 H14 H15 /is4u64=> />. ++ move=> &1 &m &2 /= [#] ->. + rewrite /Keccak_f1600_avx2_prevec_vops.match_states /is4u64 => [#]. + by case: (res{1}) => a00 a01 a20 a31 a21 a41 a11 /= 7!-> [#] -> ->. ++ by apply Keccak_f1600_avx2_prevec_vops.prevec_vops_prevec. +transitivity Keccak_f1600_avx2_openssl.M.__keccak_f1600_avx2_openssl + (={Glob.mem, arg} ==> ={Glob.mem, res}) + ( to_uint _rhotates_left{2} + 192 < W64.modulus /\ + to_uint _rhotates_right{2} + 192 < W64.modulus /\ + to_uint _iotas{2} + 768 < W64.modulus /\ + ={Glob.mem,_rhotates_left, _rhotates_right, _iotas} /\ + good_io4x mem (to_uint _iotas{2}) /\ + good_rhol mem (to_uint _rhotates_left{2}) /\ + good_rhor mem (to_uint _rhotates_right{2}) /\ + state{2} = (of_list witness [a00{1}; a01{1}; a20{1}; a31{1}; a21{1}; a41{1}; a11{1}])%Array7 ==> + ={Glob.mem} /\ + res{2} = (of_list witness [res{1}.`1; res{1}.`2; res{1}.`3; res{1}.`4; res{1}.`5; res{1}.`6; res{1}.`7])%Array7). ++ smt(). + done. ++ apply Keccak_f1600_avx2_prevec_vops.prevec_vops_openssl. +conseq avx2_avx2_openssl. ++ by move => /> *; rewrite H8 /=. +move=> /> &1 &2 ?????????? [/=] /> *. +by apply Array7.all_eq_eq;cbv delta. qed. From cbc1ee3fb77b8aa71e75516e3f8b0c23265cdba1 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Fri, 17 May 2019 07:00:10 +0200 Subject: [PATCH 428/525] no more admit --- proof/impl/libc/keccak_1600_avx2_modular.ec | 198 +++++++++++++++----- 1 file changed, 153 insertions(+), 45 deletions(-) diff --git a/proof/impl/libc/keccak_1600_avx2_modular.ec b/proof/impl/libc/keccak_1600_avx2_modular.ec index c7db442..588bd2f 100644 --- a/proof/impl/libc/keccak_1600_avx2_modular.ec +++ b/proof/impl/libc/keccak_1600_avx2_modular.ec @@ -866,32 +866,156 @@ qed. (* some precondition on jagged needed *) require import Keccak_f1600_scalar_table. -equiv extr_full_block_corr _outlen _rate _out _iotas rl rr : +op disj_ptr (p1 : address) (len1:int) (p2: address) ( len2:int) = + p1 + len1 <= p2 \/ p2 + len2 <= p1. + +op good_ptr (p : address) (len:int) = p + len < W64.modulus. + +lemma loadW64_storeW64_diff mem i j w: + j + 8 <= i \/ i + 8 <= j => + loadW64 (storeW64 mem i w) j = loadW64 mem j. +proof. + move=> hij; apply W8u8.wordP => k hk. + rewrite /loadW64 !W8u8.pack8bE 1,2:// !initiE 1,2:// /= storeW64E get_storesE /= /#. +qed. + + +lemma get_em_states state1 state2 j: + 0 <= j < 25 => + em_states state2 state1 => + state1.[j] = (state2.[A_jagged.[j] %/ 4] \bits64 A_jagged.[j] %% 4). +proof. + rewrite /em_states => hj ->. + rewrite get_of_list; 1:smt (jagged_bound). + rewrite /index /= /A_jagged /=. + rewrite -(mema_iota 0 25 j) in hj. + move: j hj. + by apply List.allP; cbv delta. +qed. + +equiv extr_full_block_corr _outlen _rate _out _iotas rl rr jag : Keccak_1600_ref_modular.Mmod.xtr_full_block ~ Mmod.xtr_full_block : + disj_ptr jag 200 _out _outlen /\ + disj_ptr _iotas 800 _out _outlen /\ + disj_ptr rl 200 _out _outlen /\ + disj_ptr rr 200 _out _outlen /\ + to_uint len{2} <= 200 /\ to_uint a_jagged{2} + 200 < W64.modulus /\ + _out + _outlen < W64.modulus /\ _rate <= _outlen /\ + good_jag Glob.mem{2} jag /\ good_io4x Glob.mem{2} _iotas /\ good_rhol Glob.mem{2} rl /\ good_rhor Glob.mem{2} rr /\ - rate{1} = _rate /\ outlen{1} = _outlen /\ out{1} = _out /\ + to_uint rate{1} = _rate /\ to_uint outlen{1} = _outlen /\ to_uint out{1} = _out /\ jag = to_uint a_jagged{2} /\ em_states state{2} state{1} /\ ={Glob.mem,out} /\ rate{1} = len{2} ==> - Keccak_f1600_scalar_table.good_iotas Glob.mem{2} _iotas /\ - good_rhol Glob.mem{2} rl /\ good_rhor Glob.mem{2} rr /\ - res{1}.`1 = _out + _rate /\ res{1}.`2 = _outlen - _rate /\ ={Glob.mem} /\ res{1}.`1 = res{2}. -admitted. + good_io4x Glob.mem{2} _iotas /\ + good_rhol Glob.mem{2} rl /\ good_rhor Glob.mem{2} rr /\ + good_jag Glob.mem{2} jag /\ + to_uint res{1}.`1 = _out + _rate /\ + to_uint res{1}.`2 = _outlen - _rate /\ ={Glob.mem} /\ res{1}.`1 = res{2}. +proof. + proc. + seq 0 3 : (#pre /\ + s_state{2} = Array28.init (fun i => state{2}.[i %/ 4] \bits64 i %%4)). + + unroll for{2} ^while; wp; skip => /> *. + apply Array28.tP => i hi /=. + rewrite !initiE //. + do 6! (rewrite set_get_def 1,2:// initiE 1://). + by rewrite set_get_def 1,2:// /= /#. + wp. + while (#pre /\ rate64{1} = len8{2} /\ i{1} = j{2} /\ to_uint rate64{1} = to_uint rate{1} %/8). + + wp; skip => /> *. + rewrite ultE in H13. + have heq1 : to_uint (W64.of_int 8 * j{2}) = 8 * to_uint j{2}. + + rewrite W64.to_uintM_small //= 1:/#. + have -> : to_uint (out{2} + (of_int 8)%W64 * j{2}) = to_uint out{2} + 8 * to_uint j{2}. + + rewrite W64.to_uintD_small heq1 /=; smt (W64.to_uint_cmp). + have -> : to_uint (a_jagged{2} + W64.of_int 8 * j{2}) = to_uint a_jagged{2} + 8 * to_uint j{2}. + + rewrite W64.to_uintD_small heq1 /=; smt (W64.to_uint_cmp). + split; 1: smt (loadW64_storeW64_diff W64.to_uint_cmp). + split; 1: smt (loadW64_storeW64_diff W64.to_uint_cmp). + split; 1: smt (loadW64_storeW64_diff W64.to_uint_cmp). + split; 1: smt (loadW64_storeW64_diff W64.to_uint_cmp). + congr. + have ? : 0 <= to_uint j{2} < 25 by smt(W64.to_uint_cmp). + rewrite H7 1:// to_uintK_jagged 1:// initiE /=; 1: by apply jagged_bound. + by apply get_em_states. + wp; skip => /> *. + rewrite /(`>>`) /= W64.to_uint_shr 1:// /= => *. + by rewrite W64.to_uintD_small 1:/# W64.to_uintB 1:W64.uleE. +qed. + +require import IntExtra. -(* some precondition on jagged needed *) equiv extr_bytes_corr : - Keccak_1600_ref_modular.Mmod.xtr_bytes ~ Mmod.xtr_bytes : - em_states state{2} state{1} /\ ={Glob.mem,out} /\ outlen{1} = len{2} ==> + Keccak_1600_ref_modular.Mmod.xtr_bytes ~ Mmod.xtr_bytes : + disj_ptr (to_uint a_jagged{2}) 200 (to_uint out{1}) (to_uint outlen{1}) /\ + to_uint a_jagged{2} + 200 < W64.modulus /\ to_uint outlen{1} <= 200 /\ + good_jag Glob.mem{2} (to_uint a_jagged{2}) /\ + to_uint out{1} + to_uint outlen{1} < W64.modulus /\ + em_states state{2} state{1} /\ ={Glob.mem,out} /\ outlen{1} = len{2} ==> ={Glob.mem}. -admitted. +proof. + proc => /=. + seq 0 3 : (#pre /\ + s_state{2} = Array28.init (fun i => state{2}.[i %/ 4] \bits64 i %%4)). + + unroll for{2} ^while; wp; skip => /> *. + apply Array28.tP => i hi /=. + rewrite !initiE //. + do 6! (rewrite set_get_def 1,2:// initiE 1://). + by rewrite set_get_def 1,2:// /= /#. + wp. + seq 4 4: (#pre /\ i{1} = j{2} /\ to_uint j{2} = to_uint len{2} %/ 8). + + while (#pre /\ i{1} = j{2} /\ to_uint outlen8{1} = to_uint outlen{1} %/ 8 /\ outlen8{1} = len8{2} /\ + to_uint j{2} <= to_uint len8{2}). + + wp; skip => |> &1 &2; rewrite !W64.ultE => *. + have heq1 : to_uint (W64.of_int 8 * j{2}) = 8 * to_uint j{2}. + + rewrite W64.to_uintM_small //= 1:/#. + have -> : to_uint (out{2} + (of_int 8)%W64 * j{2}) = to_uint out{2} + 8 * to_uint j{2}. + + rewrite W64.to_uintD_small heq1 /=; smt (W64.to_uint_cmp). + have -> : to_uint (a_jagged{2} + W64.of_int 8 * j{2}) = to_uint a_jagged{2} + 8 * to_uint j{2}. + + rewrite W64.to_uintD_small heq1 /=; smt (W64.to_uint_cmp). + split. + + split; 1: smt (loadW64_storeW64_diff W64.to_uint_cmp). + congr. + have ? : 0 <= to_uint j{2} < 25 by smt(W64.to_uint_cmp). + rewrite H2 1:// to_uintK_jagged 1:// initiE /=; 1: by apply jagged_bound. + by apply get_em_states. + by rewrite W64.to_uintD_small /= /#. + wp; skip => /> *. + rewrite /(`>>`) /= W64.to_uint_shr 1:// /=. + split; 1: smt(W64.to_uint_cmp). + by move => ??; rewrite ultE /(`>>`) /= W64.to_uint_shr 1:// /= /#. + while ( + to_uint outlen{1} < 200 /\ + em_states state{2} state{1} /\ ={Glob.mem, out} /\ outlen{1} = len{2} /\ + s_state{2} = Array28.init (fun (i0 : int) => state{2}.[i0 %/ 4] \bits64 i0 %% 4) /\ + i{1} = j{2} /\ 8 * (to_uint len{2} %/8) <= to_uint j{2} /\ + to_uint l{2} = 8 * A_jagged.[to_uint len{2} %/ 8] + (to_uint j{2} - 8 * (to_uint len{2} %/8))). + + wp; skip => /> &1 &2; rewrite W64.ultE => *. + split; last first. + + rewrite W64.to_uintD_small /=; 1: smt(jagged_bound W64.to_uint_cmp). + rewrite W64.to_uintD_small /=; smt(jagged_bound W64.to_uint_cmp). + congr. + have hj : 0 <= to_uint j{2} < 200 by smt(W64.to_uint_cmp). + rewrite /get8 /init64 WArray200.WArray200.initiE 1:// initiE /=; 1: smt(jagged_bound W64.to_uint_cmp). + rewrite initiE /=; 1: smt(jagged_bound W64.to_uint_cmp). + rewrite (get_em_states _ _ _ _ H0); 1: smt(W64.to_uint_cmp). + smt(W64.to_uint_cmp). + wp; skip => />; smt (@W64). +qed. equiv modcorrect : Keccak_1600_ref_modular.Mmod.__keccak_1600 ~ Mmod.__keccak_1600 : + disj_ptr (to_uint a_jagged{2}) 200 (to_uint out{2}) (to_uint outlen{2}) /\ + disj_ptr (to_uint iotas{2}) 800 (to_uint out{2}) (to_uint outlen{2}) /\ + disj_ptr (to_uint rhotates_left{2}) 200 (to_uint out{2}) (to_uint outlen{2}) /\ + disj_ptr (to_uint rhotates_right{2}) 200 (to_uint out{2}) (to_uint outlen{2}) /\ to_uint rate{2} <= 200 /\ to_uint a_jagged{2} + 200 < W64.modulus /\ to_uint in_0{1} + to_uint inlen{1} < W64.modulus /\ to_uint rhotates_left{2} + 192 < W64.modulus /\ to_uint rhotates_right{2} + 192 < W64.modulus /\ to_uint iotas{2} + 768 < W64.modulus /\ + to_uint out{2} + to_uint outlen{2} < W64.modulus /\ good_jag Glob.mem{2} (to_uint a_jagged{2}) /\ good_io4x Glob.mem{2} (to_uint iotas{2}) /\ good_rhol Glob.mem{2} (to_uint rhotates_left{2}) /\ @@ -938,45 +1062,29 @@ proof. inline Mmod.squeeze. swap {2} [2..5] -1; swap {2} 8 -7. sp 0 5. -(* Stopped here *) - seq 1 3 : (#{/~em_states state{2} state{1}} - {~s_out{1}=out{2}}{~s_outlen{1} = outlen{2}}pre /\ + seq 1 3 : (#{/~em_states state{2} state{1}}{~out{2}} + {~s_outlen{1} = outlen{2}}pre /\ + disj_ptr (to_uint a_jagged{2}) 200 (to_uint out0{2}) (to_uint outlen0{2}) /\ + disj_ptr (to_uint iotas{2}) 800 (to_uint out0{2}) (to_uint outlen0{2}) /\ + disj_ptr (to_uint rhotates_left{2}) 200 (to_uint out0{2}) (to_uint outlen0{2}) /\ + disj_ptr (to_uint rhotates_right{2}) 200 (to_uint out0{2}) (to_uint outlen0{2}) /\ + to_uint out0{2} + to_uint outlen0{2} < 18446744073709551616 /\ out0{2} = s_out{1} /\ outlen0{2} = outlen{1} /\ em_states state1{2} state{1} /\ good_io4x Glob.mem{2} (to_uint iotas{2}) /\ good_rhol Glob.mem{2} (to_uint rhotates_left{2}) /\ good_rhor Glob.mem{2} (to_uint rhotates_right{2})); first by auto => />. - + seq 1 1 : #pre. - while #pre. - + swap {1} 4 2. - seq 5 1 : #pre. - + by wp; ecall (avx2corr state{1} Glob.mem{2}); auto => />. - wp. - ecall (extr_full_block_corr outlen{1} rate1{2} s_out{1} (to_uint iotas1{2}) - (to_uint rhotates_left{2}) (to_uint rhotates_right{2})). - wp; skip => &1 &2 [#] 11!->> 9? 4!->> ? 2!->> ????. - rewrite W64.ultE. - move => ??; split; 1:done. - move=> h {h} />. - move=> *. rewrite !W64.ultE. - admit. - -by auto => />. - -swap {1} 3 1. -seq 3 1 : #pre. - wp. -exists* state{1}. -elim* => st. -exists* iotas{2}. -elim * => _iotas. -exists* Glob.mem{2}. -elim * => memm. -call (avx2corr st memm). -by auto => />. - -call (extr_bytes_corr). -by auto => />. + call extr_bytes_corr; wp. + ecall (avx2corr state{1} Glob.mem{2}); wp. + while #pre. + + swap {1} 4 2. + wp. + ecall (extr_full_block_corr (to_uint outlen0{2}) (to_uint rate{2}) (to_uint out0{2}) (to_uint iotas{2}) + (to_uint rhotates_left{2}) (to_uint rhotates_right{2}) (to_uint a_jagged{2})). + wp; ecall (avx2corr state{1} Glob.mem{2}); auto => /> &1 &2 *. + split; 1: smt (W64.ultE). + move=> ? [o l] /> ?;rewrite !W64.ultE => *. + rewrite W64.to_uint_eq W64.to_uintB 1:uleE 1://; smt(W64.to_uint_cmp). + skip => /> &1 &2 *; smt(W64.ultE). qed. - From f2fc7577610789ff840124b0361b13295f4f93f8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Sat, 18 May 2019 19:13:17 +0100 Subject: [PATCH 429/525] Standard Sponge is our Sponge --- proof/Sponge.ec | 72 +++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 72 insertions(+) diff --git a/proof/Sponge.ec b/proof/Sponge.ec index 7d5f35d..aa88203 100644 --- a/proof/Sponge.ec +++ b/proof/Sponge.ec @@ -31,6 +31,34 @@ clone import IRO as BIRO with (*------------------------- Sponge Construction ------------------------*) +module StdSponge (P : DPRIMITIVE) = { + proc init() : unit = {} + + proc f(bs : bool list, n : int) : bool list = { + var z <- []; + var (sa, sc) <- (b0, Capacity.c0); + var finished <- false; + var xs <- pad2blocks bs; + + (* absorption *) + while (xs <> []) { + (sa, sc) <@ P.f(sa +^ head b0 xs, sc); + xs <- behead xs; + } + (* squeezing *) + while (!finished) { + z <- z ++ ofblock sa; + if (size z < n) { + (sa, sc) <@ P.f(sa, sc); + } else { + finished <- true; + } + } + + return take n z; + } +}. + module (Sponge : CONSTRUCTION) (P : DPRIMITIVE) : FUNCTIONALITY = { proc init() : unit = {} @@ -58,6 +86,50 @@ module (Sponge : CONSTRUCTION) (P : DPRIMITIVE) : FUNCTIONALITY = { } }. +lemma loop_cond i n: 0 <= i => 0 <= n => r * i < n <=> i < (n + r - 1) %/ r. +proof. +move=> ge0_i; elim: i ge0_i n=> /= [|i ge0_i ih n ge0_n]. ++ smt(gt0_n). +case: (r %| n). ++ move=> ^/dvdzE n_mod_r /needed_blocks_eq_div_r <-. + by rewrite -(ltr_pmul2r r gt0_r (i + 1)) divzE n_mod_r /#. +move=> r_ndvd_n. rewrite -ltr_subr_addr -(addzC (-1)). +rewrite -divzMDr 1:[smt(gt0_r)] Ring.IntID.mulN1r. +have ->: n + r - 1 - r = (n - r) + r - 1 by smt(). +case: (0 <= n - r)=> [n_ge_r|/ltzNge n_lt_r /#]. +by rewrite -ih /#. +qed. + +equiv Sponge_is_StdSponge (P <: DPRIMITIVE): + StdSponge(P).f ~ Sponge(P).f: ={glob P, bs, n} ==> ={glob P, res}. +proof. +proc; seq 5 5: (={glob P, z, sa, sc, xs, n} /\ !finished{1} /\ i{2} = 0 /\ z{1} = []). ++ while (={glob P, xs, sa, sc}); 2:by auto. + by auto; call (: true). +case: (n{1} <= 0). ++ rcondt{1} 1=> //=; rcondf{1} 2. + + by auto; smt(size_ge0). + rcondf{1} 3; 1:by auto. + rcondf{2} 1. + + by auto=> /> &hr _ /needed_blocks_non_pos /#. + by auto=> /> &1 &2 _ n_le0; rewrite !take_le0. +while ( ={glob P, z, n, sa, sc} + /\ (finished{1} <=> n{1} <= size z{1}) + /\ size z{1} = r * i{2} + /\ 0 < n{1} + /\ 0 <= i{2}). ++ sp; if=> />. + + move=> &2 i z; rewrite size_cat size_block=> -> gt0_n ge0_i /ltzNge gt_ri_n gt_i_nbl. + by rewrite -(mulzDr r i 1) loop_cond /#. + + call (: true); auto=> /> &2 i z; rewrite size_cat size_block=> -> gt0_n ge0_i /ltzNge gt_ri_n gt_i_nbl. + move=> ^ + /ltzNge -> /=; rewrite mulzDr /=. + by rewrite -(mulzDr r i 1) loop_cond /#. + + auto=> /> &2 i z; rewrite size_cat size_block=> -> gt0_n ge0_i /ltzNge gt_ri_n gt_i_nbl. + move=> ^ + /lezNgt -> /=; rewrite mulzDr /=. + by rewrite -(mulzDr r i 1) loop_cond /#. +by auto=> /> &1 &2 _ /ltrNge gt0_n; smt(gt0_r). +qed. + (*------------- Simulator and Distinguisher Constructions --------------*) module LowerFun (F : DFUNCTIONALITY) : BlockSponge.DFUNCTIONALITY = { From 00f3d30ea7e37fabc9e4afe06f893e08509467bb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jos=C3=A9=20Bacelar=20Almeida?= Date: Sun, 19 May 2019 01:07:12 +0100 Subject: [PATCH 430/525] progress --- proof/impl/EclibExtra.ec | 32 ++- proof/impl/JWordList.ec | 210 ++++++++++---- proof/impl/Spec1600.ec | 446 +++++++++++++++++++++++++---- proof/impl/keccak_1600_corr.ec | 498 ++++++++++++++++----------------- 4 files changed, 826 insertions(+), 360 deletions(-) diff --git a/proof/impl/EclibExtra.ec b/proof/impl/EclibExtra.ec index dd8234f..164330f 100644 --- a/proof/impl/EclibExtra.ec +++ b/proof/impl/EclibExtra.ec @@ -351,6 +351,15 @@ rewrite nth_out. by rewrite nth_out /#. qed. +lemma size_chunkfilled (d:'a) k l: + 0 < k => + size (BitEncoding.BitChunking.chunk k (chunkfill d k l)) + = (size l - 1) %/ k + 1. +proof. +move=> Hk; rewrite BitEncoding.BitChunking.size_chunk //. +by rewrite size_chunkfill // divzMDl 1:/# divzz (:k<>0) 1:/#. +qed. + lemma head_chunkfilled (d:'a) k l: head [] (BitEncoding.BitChunking.chunk k (chunkfill d k l)) = take k (chunkfill d k l). @@ -367,7 +376,7 @@ qed. lemma nth_chunkfilled (d:'a) k l (i:int): 0 < k => - 0 <= i < (size l - 1) %/ k => + 0 <= i < (size l - 1) %/ k + 1 => nth [] (BitEncoding.BitChunking.chunk k (chunkfill d k l)) i = take k (drop (k*i) (chunkfill d k l)). proof. @@ -376,6 +385,27 @@ rewrite {1}(:i = i+0) // -nth_drop 1,2:/# drop_chunk // nth0. by rewrite drop_chunkfill // 1:/# head_chunkfilled. qed. +lemma nth_chunkfilled' dl (d:'a) k l (i:int): + 0 < k => + 0 <= i < (size l - 1) %/ k + 1 => + nth dl (BitEncoding.BitChunking.chunk k (chunkfill d k l)) i + = mkseq (fun j => nth d l (k*i+j)) k. +proof. +move=> Hk Hi. +rewrite -(nth_inside []); first by rewrite size_chunkfilled. +rewrite (nth_chunkfilled d k l i) //. +have Hsz: size (take k (drop (k * i) (chunkfill d k l))) = k. + rewrite size_take' 1:/# size_drop 1:/# size_chunkfill //. + rewrite max_ler; first smt(size_ge0). + have: k <= (size l - 1) %/ k * k + k - k * i. + by move: Hi => [?]; rewrite ltzE => [?] /#. + smt(). +apply (eq_from_nth d); first by rewrite Hsz size_mkseq /#. +rewrite Hsz => j Hj. +rewrite nth_take 1,2:/# nth_drop 1,2:/# nth_chunkfill 1:/#. +by rewrite nth_mkseq. +qed. + lemma take_map2 ['a 'b 'c] (f:'a -> 'b -> 'c) n l1 l2: take n (JUtils.map2 f l1 l2) = JUtils.map2 f (take n l1) (take n l2). proof. diff --git a/proof/impl/JWordList.ec b/proof/impl/JWordList.ec index 7f35c85..121ce3d 100644 --- a/proof/impl/JWordList.ec +++ b/proof/impl/JWordList.ec @@ -30,7 +30,7 @@ by rewrite /w8L2bits size_flatten -map_comp /(\o) /= StdBigop.Bigint.sumzE StdBigop.Bigint.BIA.big_mapT /(\o) /= StdBigop.Bigint.big_constz count_predT_eq. qed. -hint simplify size_w8L2bits. +(*hint simplify size_w8L2bits.*) lemma take_w8L2bits n l: take (8*n) (w8L2bits l) = w8L2bits (take n l). @@ -75,7 +75,7 @@ by rewrite /w64L2bits size_flatten -map_comp /(\o) /= StdBigop.Bigint.sumzE StdBigop.Bigint.BIA.big_mapT /(\o) /= StdBigop.Bigint.big_constz count_predT_eq. qed. -hint simplify size_w64L2bits. +(*hint simplify size_w64L2bits.*) op bits2w64L (bs: bool list) : W64.t list = map W64.bits2w (BitEncoding.BitChunking.chunk 64 (chunkfill false 64 bs)). @@ -301,16 +301,22 @@ by rewrite size_w8L2w64L size_take' /#. qed. lemma nth_w8L2w64L (l : W8.t list) (i : int): - 0 <= 8*i < size l => - nth W64.zero (w8L2w64L l) i = pack8 (take 8 (drop (8*i) l)). + nth W64.zero (w8L2w64L l) i + = pack8_t (W8u8.Pack.init (fun j => l.[8*i + j])). proof. -move=> [Hsz0 Hsz]; rewrite /w8L2w64L. -rewrite (nth_map []) /=. - admit. -rewrite nth_chunkfilled //. - admit. -congr. -admit. +rewrite /w8L2w64L. +case: (0 <= i /\ i < (size l-1) %/ 8 + 1) => E; last first. + rewrite nth_out; first by rewrite size_map size_chunkfilled /#. + rewrite -(W8u8.Pack.init_ext (fun j => W8.zero)). + move=> j Hj /=; rewrite nth_out// 1:/#. + rewrite -(W8u8.unpack8K W64.zero); congr. + apply W8u8.Pack.ext_eq => j Hj. + by rewrite !W8u8.Pack.initiE //= W8u8.get_zero. +rewrite (nth_map []) /=; first by rewrite size_chunkfilled /#. +rewrite nth_chunkfilled' // 1:/#. +congr; apply W8u8.Pack.ext_eq => j Hj. +rewrite W8u8.Pack.initiE //=. +by rewrite W8u8.Pack.get_of_list //= nth_mkseq //. qed. @@ -339,7 +345,7 @@ elim: l => //= x xs IH. by rewrite w64L2w8L_cons size_cat IH W8u8.Pack.size_to_list; ring. qed. -hint simplify size_w64L2w8L. +(*hint simplify size_w64L2w8L.*) lemma w64L2w8L2bits l: w8L2bits (w64L2w8L l) = w64L2bits l. @@ -368,28 +374,38 @@ rewrite !w64L2w8L_cons IH take_cat W8u8.Pack.size_to_list. by rewrite (:!8*n<8) /#. qed. -lemma nth_w64L2w8L l i: - 0 <= i < 8*size l => - nth W8.zero (w64L2w8L l) i - = nth W8.zero (W8u8.to_list (nth W64.zero l (i %/ 8))) (i %% 8). +lemma nth_w64L2w8L (l : W64.t list) (i : int): + nth W8.zero (w64L2w8L l) i + = nth W64.zero l (i %/ 8) \bits8 (i %% 8). proof. -move=> Hi; rewrite /w64L2w8L (BitEncoding.BitChunking.nth_flatten W8.zero 8). +rewrite /w64L2w8L. +have Hsz: all (fun (s : W8.t list) => size s = 8) + (map (fun (w : W64.t) => (to_list w)%W8u8) l). by rewrite allP => x /mapP [y [Hy ->]]. -by rewrite (nth_map W64.zero) 1:/#. +rewrite (BitEncoding.BitChunking.nth_flatten W8.zero 8) //. +move: Hsz; rewrite allP => Hsz. +case: (0 <= i %/ 8 < size l) => E; last first. + rewrite nth_out; first rewrite nth_out ?size_map /#. + by rewrite nth_out // W8u8.get_zero /#. +rewrite (nth_map W64.zero) //; beta. +by rewrite W8u8.Pack.get_to_list W8u8.get_unpack8 /#. qed. +lemma w8L2w64LK (l: W8.t list): + 8 %| size l => w64L2w8L (w8L2w64L l) = l. +admitted. + +lemma w64L2w8LK (l: W64.t list): + cancel w8L2w64L w64L2w8L. +admitted. (*******************************************************************************) (* MEMORY OPERATIONS *) (*******************************************************************************) -lemma stores_nil mem out: stores mem out [] = mem by done. - lemma stores_singl mem out x: stores mem out [x] = storeW8 mem out x. proof. by rewrite storeW8E /stores. qed. -hint simplify stores_nil, stores_singl. - lemma stores_cat mem out l1 l2: stores mem out (l1++l2) = stores (stores mem out l1) (out + size l1) l2. proof. @@ -399,24 +415,56 @@ qed. lemma stores_cons' mem out x xs: stores mem out (x::xs) = stores (storeW8 mem out x) (out+1) xs. -proof. by rewrite -cat1s stores_cat. qed. +proof. by rewrite -cat1s stores_cat stores_singl. qed. lemma stores_rcons mem out x xs: stores mem out (rcons xs x) = storeW8 (stores mem out xs) (out + size xs) x. -proof. by rewrite -cats1 stores_cat. qed. +proof. by rewrite -cats1 stores_cat stores_singl. qed. lemma stores_u64 mem out x: stores mem out (W8u8.to_list x) = storeW64 mem out x by rewrite storeW64E. +(* name alias to [stores] to avoid uncontrolled evaluation... *) +op stores8 mem out l = stores mem out l +axiomatized by stores8E. + +lemma stores8_nil mem out: stores8 mem out [] = mem. +proof. by rewrite stores8E. qed. + +lemma stores8_singl mem out x: stores8 mem out [x] = storeW8 mem out x. +proof. by rewrite stores8E storeW8E /stores. qed. + +hint simplify stores8_nil, stores8_singl. + +lemma stores8_cat mem out l1 l2: + stores8 mem out (l1++l2) = stores8 (stores8 mem out l1) (out + size l1) l2. +proof. by rewrite !stores8E stores_cat. qed. +lemma stores8_cons' mem out x xs: + stores8 mem out (x::xs) = stores8 (storeW8 mem out x) (out+1) xs. +proof. by rewrite !stores8E stores_cons'. qed. + +lemma stores8_rcons mem out x xs: + stores8 mem out (rcons xs x) = storeW8 (stores8 mem out xs) (out + size xs) x. +proof. by rewrite !stores8E stores_rcons. qed. + +lemma stores8_u64 mem out x: + stores8 mem out (W8u8.to_list x) = storeW64 mem out x. +proof. by rewrite stores8E storeW64E. qed. + + +(* as well for [store64]... *) op stores64 (m: global_mem_t) (a:address) (w: W64.t list): global_mem_t = foldl (fun (m0 : global_mem_t) (i : int) => storeW64 m0 (a + 8*i) (nth W64.zero w i)) - m (iota_ 0 (size w)). + m (iota_ 0 (size w)) +axiomatized by stores64E. -lemma stores64_nil mem a: stores64 mem a [] = mem by done. +lemma stores64_nil mem a: stores64 mem a [] = mem. +proof. by rewrite stores64E. qed. -lemma stores64_singl mem a x: stores64 mem a [x] = storeW64 mem a x by done. +lemma stores64_singl mem a x: stores64 mem a [x] = storeW64 mem a x. +proof. by rewrite stores64E. qed. hint simplify stores64_nil, stores64_singl. @@ -424,7 +472,7 @@ lemma stores64_cat mem out l1 l2: stores64 mem out (l1 ++ l2) = stores64 (stores64 mem out l1) (out + 8*size l1) l2. proof. -rewrite /stores64 size_cat iota_add; first 2 smt(size_ge0). +rewrite !stores64E size_cat iota_add; first 2 smt(size_ge0). rewrite (addzC 0) iota_addl foldl_cat foldl_map /=. have ->: foldl (fun (m0 : global_mem_t) (i : int) => storeW64 m0 (out + 8 * i) (nth W64.zero (l1 ++ l2) i)) mem @@ -450,26 +498,102 @@ lemma stores64_rcons mem out xs x: = storeW64 (stores64 mem out xs) (out + 8*size xs) x. proof. by rewrite -cats1 stores64_cat. qed. -lemma stores64_stores mem out l: - stores64 mem out l = stores mem out (w64L2w8L l). +lemma stores64_stores8 mem out l: + stores64 mem out l = stores8 mem out (w64L2w8L l). proof. -elim/last_ind: l mem out => //= xs x IH mem out. +rewrite stores8E; elim/last_ind: l mem out => //= xs x IH mem out. rewrite stores64_rcons IH -cats1 w64L2w8L_cat stores_cat w64L2w8L_singl. by rewrite stores_u64 size_w64L2w8L. qed. (** [memread] reads a list of bytes from memory *) -op memread (m : global_mem_t) (a : address) (sz : int): W8.t list = +op memread (m: global_mem_t) (a: address) (sz: int): W8.t list = mkseq (fun i => m.[a + i]) sz. lemma size_memread mem a sz: - 0 <= sz => size (memread mem a sz) = sz. -proof. by rewrite /memread size_map size_iota /#. qed. + 0 <= sz => size (memread mem a sz) = sz +by rewrite size_mkseq /#. + +lemma drop_memread n mem ptr k: + 0 <= n <= k => + drop n (memread mem ptr k) = memread mem (ptr+n) (k-n). +proof. +move=> Hn; rewrite drop_mkseq //=. +by apply eq_mkseq => x; smt(). +qed. + +lemma nth_memread mem in_ inlen i: + 0 <= i < inlen => + nth W8.zero (memread mem in_ inlen) i + = loadW8 mem (in_ + i)%Int. +proof. by move=> Hi; rewrite nth_mkseq. qed. + +(* +lemma nth_memread_offset off mem in_ inlen i: + (off <= i < off + inlen)%Int => + nth W8.zero (memread mem (in_ + off) inlen) (i-off) = + loadW8 mem (in_ + i)%Int. +proof. move=> Hi; rewrite nth_memread /#. qed. + +lemma nth_memread_u64 mem in_ inlen i: + 0 <= i => 8*i+8 <= inlen => + loadW64 mem (in_+8*i) + = nth W64.zero (w8L2w64L (memread mem in_ inlen)) i. +proof. +move=> ??; rewrite nth_w8L2w64L. +rewrite /loadW64 W8u8.pack8E pack8E; apply W64.init_ext => x Hx /=. +congr; congr; apply W8u8.Pack.init_ext => j Hj /=. +by rewrite nth_mkseq /#. +qed. +*) + + +(** [memread64] reads a list of [n] (full) 64-bit words from memory *) +op memread64 (m: global_mem_t) (a: address) (n: int): W64.t list = + mkseq (fun i => loadW64 m (a+8*i)) n. + +lemma size_memread64 mem a sz: + 0 <= sz => size (memread64 mem a sz) = sz +by rewrite size_mkseq /#. + +lemma nth_memread64 m a sz i: + 0 <= i < sz => + nth W64.zero (memread64 m a sz) i = loadW64 m (a+8*i). +proof. by move=> Hsz; rewrite nth_mkseq //. qed. + +lemma memread64E m a sz: + memread64 m a sz = w8L2w64L (memread m a (8*sz)). +proof. +apply (eq_from_nth W64.zero). + by rewrite size_mkseq size_w8L2w64L size_mkseq /#. +rewrite size_mkseq => i Hi. +rewrite nth_w8L2w64L nth_memread64 1:/# /loadW64; congr. +apply W8u8.Pack.init_ext => j Hj /=. +by rewrite nth_mkseq /#. +qed. + +lemma memread_split off mem a sz: + 0 <= off <= sz => + memread mem a sz = memread mem a off ++ memread mem (a+off) (sz-off). +proof. +move=> Hoff; have ->: sz = off + (sz-off) by ring. +rewrite /memread mkseq_add 1,2:/#; congr. +rewrite (:off + (sz - off) - off = sz-off) 1:/#. +by apply eq_mkseq => i /#. +qed. + +lemma memread_split64 mem a sz: + 0 <= sz => + memread mem a sz + = w64L2w8L (memread64 mem a (sz %/ 8)) + ++ memread mem (a + sz %/8 * 8) (sz %% 8). +proof. +move=> Hsz; rewrite (memread_split (sz %/ 8*8)) 1:/#; congr. + by rewrite memread64E w8L2w64LK ?size_memread /#. +by rewrite modzE. +qed. -lemma size_memread' mem a sz: - size (memread mem a sz) = max 0 sz. -proof. by rewrite /memread size_map size_iota /#. qed. lemma memread0 mem a: memread mem a 0 = []. @@ -482,14 +606,6 @@ lemma take_memread n mem ptr k: take n (memread mem ptr k) = memread mem ptr (min n k). proof. by move=> Hn; rewrite /memread take_mkseq. qed. -lemma drop_memread n mem ptr k: - 0 <= n <= k => - drop n (memread mem ptr k) = memread mem (ptr+n) (k-n). -proof. -move=> Hn; rewrite /memread drop_mkseq //=. -by apply eq_mkseq => x; smt(). -qed. - lemma loadW8_memread mem in_ inlen i: 0 <= i < inlen => loadW8 mem (in_ + i)%Int @@ -513,10 +629,10 @@ lemma nth_memread_u64 mem in_ inlen i: loadW64 mem (in_+8*i) = nth W64.zero (w8L2w64L (memread mem in_ inlen)) i. proof. move=> ??; rewrite nth_w8L2w64L. - by rewrite size_memread /#. -rewrite drop_memread 1:/# take_memread // min_lel 1:/#. rewrite /loadW64 W8u8.pack8E pack8E; apply W64.init_ext => x Hx /=. +(* congr; rewrite W8u8.Pack.initiE 1:/# W8u8.Pack.get_of_list 1:/# /=. by rewrite /memread nth_mkseq 1:/#. +*) admit. qed. diff --git a/proof/impl/Spec1600.ec b/proof/impl/Spec1600.ec index e6ccb61..2451c5d 100644 --- a/proof/impl/Spec1600.ec +++ b/proof/impl/Spec1600.ec @@ -132,25 +132,112 @@ qed. (* 1600bit state *) -require import Array25. +require import Array25 WArray200. + +(* State is defined as an array of 25 64-bit words. But it can also be + viewed as an array of 200 byes (which is the prefered view in this + specification). *) type state = W64.t Array25.t. +abbrev state200 (st: state) : WArray200.t = WArray200.init64 ("_.[_]" st). +abbrev state25 (st200: WArray200.t) : state = Array25.init (WArray200.get64 st200). + +(* conversion between different list representations for state *) +abbrev state2w8L (st: state): W8.t list = to_list (state200 st). +op w8L2state (l: W8.t list): state = state25 (WArray200.of_list l). +op state2bits (st: state): bool list = w8L2bits (state2w8L st). + +abbrev state2w64L (st: state): W64.t list = to_list st. +op w64L2state (l: W64.t list): state = Array25.of_list W64.zero l. + +(* we can go back and forward on the various representations *) +lemma w8L2w64L2state l: + w8L2state l = w64L2state (w8L2w64L l). +proof. +admit(* +apply Array25.ext_eq => i Hi. +rewrite initiE // state25E get64E Array25.get_of_list //. +rewrite nth_w8L2w64L; congr. +apply W8u8.Pack.init_ext=> /=; smt. +*). +qed. + +lemma w64L2w8L2state l: + w64L2state l = w8L2state (w64L2w8L l). +proof. +admit(* +apply Array25.ext_eq => i Hi. +rewrite Array25.get_of_list //. +rewrite Array25.initE Hi /= get64E /=. +rewrite -(W8u8.Pack.init_ext ((\bits8) (nth W64.zero l i))) /=. +move=> j Hj. +rewrite WArray200.get_of_list 1:/# nth_w64L2w8L. +smt. +by rewrite (W8u8.unpack8K (nth W64.zero l i)). +*). +qed. + +lemma state2w8L2w64L st: + state2w8L st = w64L2w8L (state2w64L st). +admitted. -(* We treat the sponge permutation as an abstract function. It acts as - a bridge between the idealized permutation used in the security proof - (RO), and the concrete Keccak-F[1600] instantiation adopted in the - implementation. *) -op sponge_permutation : state -> state. +(* set/get individual bytes *) +op u64_set8 (w: W64.t) i (b: W8.t) : W64.t = + W8u8.pack8_t (W8u8.unpack8 w).[i <- b]. +abbrev state_get8 (st: state) i = + (state200 st).[i]. +abbrev state_set8 (st: state) i x = + state25 (state200 st).[i <- x]. +lemma state_get8E st i: + 0 <= i < 200 => + state_get8 st i = st.[i %/ 8] \bits8 (i %% 8). +proof. admitted. (*by move=> Hi; rewrite initE Hi. qed.*) + +lemma state_get8P st i: + state_get8 st i = (state2w8L st).[i]. +proof. by rewrite /state2w8L get_to_list. qed. + + + +lemma state_set8E st i x: + 0 <= i < 200 => + state_set8 st i x + = st.[i %/ 8 <- u64_set8 st.[i %/ 8] (i %% 8) x]. +proof. +admit(* +move=> Hi; apply Array25.ext_eq => j Hj. +rewrite initiE // get64E get_set_if. +rewrite (: 0 <= i %/ 8 < 25 ) 1:/# /=. +rewrite -(W8u8.Pack.init_ext + (fun (k:int) => + if j=i%/8 then u64_set8 st.[i%/8] (i%%8) x \bits8 k + else st.[j] \bits8 k)). + move=> k Hk /=. + admit. +case: (j=i%/8) => E. + admit. +admit. +*). +qed. + + +(* We treat the sponge permutation as an abstract function. It acts + as a bridge between the idealized permutation used in the security + proof (RO), and the concrete Keccak-F[1600] instantiation adopted + in the implementation. *) +op sponge_permutation : state -> state. + +(* Initial state *) op st0 : state = Array25.create W64.zero. -op state2bits (st: state) : bool list = w64L2bits (to_list st). lemma size_state2bits (st: state): size (state2bits st) = 1600. -proof. by rewrite /state2bits size_w64L2bits size_to_list. qed. +proof. by rewrite /state2bits size_w8L2bits size_to_list. qed. +(* op bits2state (bs: bool list) : state = of_list W64.zero (bits2w64L bs). @@ -174,6 +261,95 @@ proof. move=> st; apply state2bits_inj. by rewrite bits2stateK // size_state2bits. qed. +*) + +op xorstate (st1 st2: state) : state = + Array25.map2 W64.(`^`) st1 st2. + +abbrev xorstate_w8L (st: state) (l: W8.t list) : state = + xorstate st (w8L2state l). +abbrev state_xor8 (st: state) i x = + state25 (state200 st).[i <- (state200 st).[i] `^` x]. +abbrev xorstate_w64L (st: state) (l: W64.t list) : state = xorstate st (w64L2state l). +(* +op u64_xor_u8 (w: W64.t) i (b: W8.t) = W8u8.pack8_t (W8u8.unpack8 w).[i <- b]. +*) + +op state_xor_u8 (st: state) i (b: W8.t) : state = state25 (state200 st).[i <- (state200 st).[i] `^` b]. + +lemma xorstate_getE st1 st2 i: + 0 <= i < 25 => + (xorstate st1 st2).[i] = st1.[i] `^` st2.[i]. +proof. by move=> Hi; rewrite map2iE. qed. + +lemma xorstate_w64L_getE st l i: + 0 <= i < 25 => + (xorstate_w64L st l).[i] = st.[i] `^` nth W64.zero l i. +admitted. + +lemma xorstate_w64L_get_out st l i: + size l < i => + (xorstate_w64L st l).[i] = st.[i]. +admitted. + +lemma xorstate_w8L_get8E st l i: + 0 <= i < 200 => + state_get8 (xorstate_w8L st l) i + = (st.[i %/ 8] \bits8 (i %% 8)) `^` nth W8.zero l i. +proof. +admit. +qed. +(* +lemma xorstate_w8L_getE st l i: + size l < i => + state_get8 (xorstate_w8L st l) i = (st.[i %/ 8] \bits8 (i %% 8)) `^` nth W8.zero l i. +admitted. +*) +(* +lemma xorstate_w64L_rcons st l x: + size l < 25 => + xorstate_w64L st (rcons l x) = st.[size l <- st.[size l] `^` x]. +admitted. +*) +(* +lemma xorstate_w8L_rcons st l x: + size l < 200 => + xorstate_w8L st (rcons l x) = st.[size l %/ 8 <- u64_xor_u8 st.[size l %/ 8] (size l %% 8) x]. +admitted. +*) +(* +lemma xorstate_w64L2w8L st l: + xorstate_w8L st (w64L2w8L l) = xorstate_w64L st l. +admitted. + +lemma xorstate_w8L2w64L st l: + xorstate_w64L st (w8L2w64L l) = xorstate_w8L st l. +admitted. +*) + +lemma nth_nseq_dflt (d:'s) n i: nth d (nseq n d) i = d. +admitted. + +lemma to_list_xorstate_w8L st l: + state2w8L (xorstate_w8L st l) + = map2 W8.(`^`) (state2w8L st) (l++nseq (200-size l) W8.zero). +proof. +admit(* +apply (eq_from_nth W8.zero). + rewrite size_map2 !size_to_list min_lel //. + rewrite size_cat size_nseq; smt(size_ge0). +rewrite size_to_list => i Hi. +rewrite WArray200.get_to_list (nth_map2 W8.zero W8.zero). + rewrite size_to_list size_cat size_nseq; smt(size_ge0). +rewrite xorstate_w8L_get8E 1://; congr. + rewrite -state_get8E //= initE Hi /=. admit. +case: (i < size l) => E; first by rewrite nth_cat E. +rewrite nth_out 1:/# nth_cat. +by rewrite (:! i < size l) 1:/# /= nth_nseq_dflt. +*). +qed. + + (* rate expressed in 8 and 64bit words *) op rate64 = rate %/ 64. @@ -198,15 +374,14 @@ proof. by rewrite /capacity64 mulzC Ring.IntID.mulrBl /= mulzC rate64P. qed. (* project state into block+capacity *) - op state_r (st: state) : block = mkblock (take r (state2bits st)). -op w64L2block (l: W64.t list) : block = - mkblock (w64L2bits (take rate64 l - ++ nseq (rate64-size l) W64.zero)). +op w8L2block (l: W8.t list) : block = + mkblock (w8L2bits (take rate8 l ++ nseq (rate8-size l) W8.zero)). -op block2w64L (b: block) : W64.t list = bits2w64L (ofblock b). +(* +op block2w8L (b: block) : W8.t list = bits2w8L (ofblock b). lemma block2w64LP st: block2w64L (state_r st) = take rate64 (to_list st). @@ -215,11 +390,12 @@ rewrite /block2w64L /state_r ofblockK. rewrite size_take ?ge0_r size_state2bits; smt(rate_bnds). by rewrite /state2bits -rate64P take_w64L2bits w64L2bitsK. qed. - +*) op state_c (st: state) : capacity = mkcapacity (drop r (state2bits st)). -op capacity2w64L (c: capacity) : W64.t list = bits2w64L (ofcapacity c). +(* +op capacity2w8L (c: capacity) : W64.t list = bits2w64L (ofcapacity c). lemma capacity2w64LP st: capacity2w64L (state_c st) = drop rate64 (to_list st). @@ -229,16 +405,37 @@ rewrite /capacity2w64L /state_c ofcapacityK. by rewrite /state2bits -rate64P drop_w64L2bits w64L2bitsK. qed. + lemma state_splitP st: st = Array25.of_list W64.zero (block2w64L (state_r st) ++ capacity2w64L (state_c st)). proof. by rewrite block2w64LP capacity2w64LP cat_take_drop to_listK. qed. +*) + +lemma st0E: + st0 = state25 (WArray200.create W8.zero). +proof. +admit(* +apply Array25.ext_eq => i Hi. +rewrite /st0 createE !initiE // get64E; beta. +rewrite -(W8u8.unpack8K W64.zero); congr. +apply W8u8.Pack.init_ext => k Hk; beta. +by rewrite WArray200.initiE 1:/# /= W8u8.get_zero. +*). +qed. + +lemma state200K: cancel state200 state25. +admitted. +lemma state25K: cancel state25 state200. +admitted. + lemma state2bits0: state2bits st0 = nseq 1600 false. proof. -by rewrite /st0 /state2bits /w64L2bits /Array25.to_list /mkseq. +rewrite st0E /state2bits /state2w8L state25K. +by rewrite /w8L2bits. qed. lemma st0_r: state_r st0 = b0. @@ -294,6 +491,31 @@ move=> Hm; rewrite /take_block64 /= size_drop; first smt(rate_bnds). by rewrite max_ler /#. qed. +op absorb_split (m: W8.t list): W8.t list * W8.t list = + (take rate8 m, drop rate8 m). + +lemma size_absorb_split1 m: + rate8 <= size m => size (absorb_split m).`1 = rate8. +proof. +admit(* +move=> Hm; rewrite /take_block64 /= size_bits2w64L size_w8L2bits. +rewrite size_take'; first smt(rate_bnds). +by rewrite Hm /= /rate8 -mulzA /= mulzC divzMDl. +*). +qed. + +lemma size_absorb_split2 m: + rate8 <= size m => size (absorb_split m).`2 + = size m - rate8. +proof. +admit(* +move=> Hm; rewrite /take_block64 /= size_drop; first smt(rate_bnds). +by rewrite max_ler /#. +*). +qed. + +(* + lemma take_block64P mbits m: rate8 <= size m => w64L2block (take_block64 m).`1 = head b0 (pad2blocks (w8L2bits m ++ mbits)). @@ -323,7 +545,7 @@ rewrite -Hsz64 take_size /take_block64 /= bits2w64LK. by rewrite -take_w8L2bits rate8P. qed. - +*) (* [trail_byte] adds the first padding 1-bit to [mbits], which include both the "domain-separatioen" bits as well as additional suffix bits (e.g. "01" for SHA-3; "11" for RawSHAKE; "1111" for SHAKE). The last @@ -338,17 +560,16 @@ op trail_byte (mbits: bool list) : W8.t = W8.bits2w (mbits++[true]). (* [final_block64] reads the final block and adds the first padding bit *) -op final_block64 (lbyte: W8.t) (m: W8.t list): W64.t list = - bits2w64L (w8L2bits (m++[lbyte])). (*++nseq 63 false).*) +op absorb_final (lbyte: W8.t) (m: W8.t list): W8.t list = + m++[lbyte]. +(* lemma size_final_block64 b m: - size (final_block64 b m) = (8 * size m + 7) %/ 64 + 1. (*(size m) %/ 8 + 1.*) -proof. -rewrite /final_block64 size_bits2w64L size_w8L2bits size_cat /=; congr. -by rewrite mulzDr /=. -qed. - + size (final_block64 b m) = (size m) %/ 8 + 1. +proof. by rewrite /final_block64 size_w8L2w64L size_cat. qed. +*) +(* op addstate (st:state) (l: W64.t list) : state = Array25.init (fun i => st.[i] `^` (nth W64.zero l i)). @@ -361,8 +582,8 @@ move=> Hi; rewrite /addstate -(nth_inside witness). by rewrite get_to_list initE Hi. qed. -lemma to_list_addstate st l: - to_list (addstate st l) +lemma to_list_xorstate_w64L st l: + to_list (xorstate_w64L st l) = map2 W64.(`^`) (to_list st) (l++nseq (25-size l) W64.zero). proof. apply (eq_from_nth W64.zero). @@ -378,12 +599,45 @@ congr. rewrite nth_cat; case: (i < size l) => ? //. by rewrite nth_out 1:/# nth_nseq /#. qed. +*) +(* +abbrev absorb_w64L (st: state) (l: W64.t list) : state + = xorstate_w64L st (take rate64 l). +abbrev absorb_w8L (st: state) (l: W8.t list) : state + = xorstate_w8L st (take rate8 l). +*) -lemma addstate_r st l: - state_r (addstate st l) = state_r st +^ w64L2block l. +(* +lemma absorb_w8L2w64L st l: + size l <= rate8 => + absorb_w64L st (w8L2w64L l) = absorb_w8L st l. proof. -rewrite /state_r /state2bits /w64L2block. +move=> Hsz; rewrite !take_oversize //. + rewrite size_w8L2w64L. + admit (* +Hsz: size l <= rate8 +------------------------------------------------------------------------ +(size l - 1) %/ 8 + 1 <= rate64 +*). +by rewrite xorstate_w8L2w64L. +qed. + +lemma absorb_w64L2w8L st l: + size l <= rate64 => + absorb_w8L st (w64L2w8L l) = absorb_w64L st l. +proof. +move=> Hsz; rewrite !take_oversize //. + rewrite size_w64L2w8L /#. +by rewrite xorstate_w64L2w8L. +qed. +*) + +lemma xorstate_r st l: + state_r (xorstate_w8L st l) = state_r st +^ w8L2block l. +proof. +admit(* +rewrite /state_r /state2bits /w8L2block. rewrite mkblock_xor /=. rewrite size_take; first smt(rate_bnds). by rewrite size_w64L2bits Array25.size_to_list /= (: r < 1600); smt(rate_bnds). @@ -391,7 +645,7 @@ rewrite mkblock_xor /=. case: (rate64 < size l) => E. by rewrite max_lel; smt(size_ge0 rate64P). by rewrite max_ler 1:/#; smt(rate64P). -congr; rewrite to_list_addstate. +congr; rewrite to_list_xorstate_w64L. have ->: (w64L2bits (take rate64 l ++ nseq (rate64 - size l) W64.zero)) = take r (w64L2bits (l ++ nseq (rate64 - size l) W64.zero)). rewrite -rate64P take_w64L2bits take_cat'. @@ -402,39 +656,45 @@ rewrite w64L2bits_xor take_map2; congr. rewrite -rate64P !take_w64L2bits; congr. rewrite !take_cat; case: (rate64 < size l) => //= E; congr. by rewrite !take_nseq; smt(rate64_bnds). +*). qed. lemma addstate_c st l: size l <= rate64 => - state_c (addstate st l) = state_c st. + state_c (xorstate_w64L st l) = state_c st. proof. +admit (* move=> Hsz; rewrite /state_c /state2bits /w64L2block; congr. rewrite -rate64P !drop_w64L2bits; congr. -rewrite to_list_addstate !drop_map2 drop_cat. +rewrite to_list_xorstate_w64L !drop_map2 drop_cat. have ->/=: !(rate64 < size l) by smt(). rewrite drop_nseq; first smt(rate64_bnds). rewrite map2_nseq0r //. rewrite size_drop; first smt(rate64_bnds). by rewrite max_ler size_to_list; smt(rate64_bnds). +*). qed. lemma addfullblockP mbits blk st m: rate8 <= size m => blk = state_r st => - state_r (addstate st (take_block64 m).`1) + state_r (xorstate_w8L st (absorb_split m).`1) = blk +^ head b0 (pad2blocks (w8L2bits m ++ mbits)). proof. -move=> Hm Hst; rewrite addstate_r -Hst; congr. +admit (* +move=> Hm Hst; rewrite xorstate_r -Hst; congr. by apply take_block64P. +*). qed. lemma finalblockP mbits m: size mbits < 6 => size m < rate8 => - w64L2block (final_block64 (trail_byte mbits) m) +^ block0star1 = + w8L2block (absorb_final (trail_byte mbits) m) +^ block0star1 = head b0 (pad2blocks (w8L2bits m ++ mbits)). proof. +admit (* move=> Hmbits Hm. rewrite /pad2blocks /(\o) /pad /bits2blocks /= chunk_r /= /w64L2block. rewrite !size_cat size_mkpad size_w8L2bits !addzA. @@ -454,14 +714,15 @@ have ->: nseq (r - size (w8L2bits m ++ mbits) - 1) false rewrite chunkfillsizeE' //; first smt(size_ge0). rewrite chunkfillsizeE' //=; first smt(size_ge0). rewrite mulzDr /= modz_small; first smt(size_ge0). - by rewrite mulzDr !addzA /= (mulzC 64) divzE; ring. + rewrite mulzDr !addzA /=. rewrite (mulzC 8). +(* FIXTHIS *)ring. smt. (*divzE; ring.*) rewrite !catA; congr; last first. rewrite w64L2bits_nseq0. rewrite /final_block64 size_final_block64. smt(size_ge0). by rewrite mulzDr rate64P; congr; ring. rewrite /final_block64 take_oversize. - rewrite size_bits2w64L size_w8L2bits size_cat /=. + rewrite size_w8L2w64L size_cat /=. by rewrite -ltzE; smt(divz_cmp). rewrite bits2w64LK' /chunkfill w8L2bits_cat -!catA; congr. have ->: w8L2bits [trail_byte mbits] = chunkfill false 8 (mbits ++ [true]). @@ -484,14 +745,16 @@ rewrite size_nseq max_ler 1:/# (modz_small _ 8); first apply bound_abs; smt(size rewrite /= (:size mbits + 1 + (7 - size mbits)=8) 1:/#. rewrite (:8 * size m + 8 - 1 = 8*(size m + 1) - 1) 1:/#. by ring. +*). qed. -op addfinalbit (st: state) = - st.[rate64-1 <- st.[rate64-1] `^` W64.of_int (2^63)]. +op addfinalbit (st: state): state = + state_xor8 st (rate8-1) (W8.of_int 128). -op addfinalblock st l = addfinalbit (addstate st l). +op addfinalblock st l = addfinalbit (xorstate_w8L st l). +(* op block0star1_64 = nseq (rate64-1) W64.zero ++ [W64.of_int (2 ^ 63)]. lemma block0star1E: @@ -568,21 +831,29 @@ apply (eq_from_nth witness). move=> i Hi; rewrite !nth_drop 1..4:[smt(rate64_bnds)]. rewrite 2!get_to_list set_neqiE; smt(rate64_bnds). qed. - +*) (* [squeezestate] extracts a [rate64] 64bit words from the state *) -op squeezestate (st: state): W64.t list = - take rate64 (to_list st). +op squeezestate (st: state): W8.t list = + take rate8 (state2w8L st). + +op squeezestate64 (st: state) = take rate64 (state2w64L st). + + +lemma squeezestateE st: + squeezestate st = w64L2w8L (squeezestate64 st). +admitted. lemma size_squeezestate st: - size (squeezestate st) = rate64. + size (squeezestate st) = rate8. proof. rewrite /squeezestate size_take'; first smt(rate64_bnds). -by rewrite Array25.size_to_list; smt(rate64_bnds). +admit (* +by rewrite Array25.size_to_list; smt(rate64_bnds).*). qed. (* [xtrbytes outl w64L] converts at most [outl] bytes from the - list of 64bit words [w64L] *) + list of 64bit words [w64L] op xtrbytes (n: int) (b64: W64.t list): W8.t list = take n (w64L2w8L b64). @@ -597,14 +868,16 @@ lemma xtrbytes_squeezestate n st: w8L2bits (xtrbytes n (squeezestate st)) = take (8*n) (ofblock (state_r st)). proof. +admit (* rewrite /xtrbytes -take_w8L2bits /squeezestate; congr. rewrite /state_r /state2bits -rate64P take_w64L2bits. rewrite w64L2w8L2bits ofblockK // size_w64L2bits size_take. smt(rate64_bnds). rewrite Array25.size_to_list -rate64P. by have ->/=: rate64 < 25 by smt(rate64_bnds). +*). qed. - +*) lemma size_pad2blocks8 mbits m: size mbits < 6 => @@ -670,31 +943,33 @@ qed. module Spec = { proc f(trail_byte: W8.t, m: W8.t list, outlen: int) : W8.t list = { - var result,b,st; + var result,l,st; result <- []; st <- st0; (* ABSORB *) while (rate8 <= size m){ - (b, m) <- take_block64 m; - st <- addstate st b; + (l, m) <- absorb_split m; + st <- xorstate_w8L st l; st <- sponge_permutation st; } - st <- addfinalblock st (final_block64 trail_byte m); + st <- addfinalblock st (absorb_final trail_byte m); (* SQUEEZE *) while (rate8 < outlen){ st <- sponge_permutation st; - b <- squeezestate st; - result <- result ++ xtrbytes rate8 b; + l <- squeezestate st; + result <- result ++ l; outlen = outlen - rate8; } st <- sponge_permutation st; - b <- squeezestate st; - result <- result ++ xtrbytes outlen b; + l <- squeezestate st; + result <- result ++ take outlen l; return result; } }. - +lemma take_take n1 n2 (l: 'a list): + take n1 (take n2 l) = take (min n1 n2) l. +proof. elim: l n1 n2 => //= x xs IH n1 n2; smt(). qed. section. @@ -725,20 +1000,23 @@ seq 3 2: (#[/1,3:]pre /\ match_state (sa,sc){1} st{2} /\ outlen2 = outlen{2} /\ 1<=size xs{1}). wp 1 2; ecall {1} (perm_correct st{2}); wp; skip; progress. + by rewrite (match_state_r _ _ H0) eq_sym; apply addfullblockP. - + by move: H0; rewrite addstate_c /match_state //= size_take_block64l. +admit(* + + by move: H0; rewrite addstate_c /match_state //= size_take_block64l.*). + by rewrite H6. + by rewrite H6. + by rewrite behead_pad2blocks8. + rewrite size_behead size_pad2blocks8 // max_ler /= lez_divRL; smt(rate8_bnds). +admit(* + rewrite size_take_block64r //. have: 3 <= size (pad2blocks (w8L2bits m{2} ++ mbits)). move: H8; rewrite size_behead max_ler. rewrite size_pad2blocks8 //= lez_divRL; smt(rate8_bnds). smt(). - by rewrite size_pad2blocks8_ge /#. + by rewrite size_pad2blocks8_ge /#.*). + have : 2 <= size (pad2blocks (w8L2bits m{2} ++ mbits)). by rewrite size_pad2blocks8_ge // /#. by pose L:= pad2blocks _; move: L => [|x1 [|x2 xs]]. +admit(* + have : 2 < size (pad2blocks (w8L2bits m{2} ++ mbits)). rewrite size_pad2blocks8 //. apply (StdOrder.IntOrder.ltr_le_trans (2+1)) => //. @@ -746,6 +1024,7 @@ seq 3 2: (#[/1,3:]pre /\ match_state (sa,sc){1} st{2} /\ move: H7; rewrite /take_block64 /= size_drop 1:[smt(rate8_bnds)]. by rewrite max_ler /#. by pose L:= pad2blocks _; move: L => [|x1 [|x2 [|x3 xs]]] => //=; smt(). +*). skip => |> *; progress. + by rewrite st0_r. + by rewrite st0_c. @@ -767,6 +1046,53 @@ rcondf {1} 3. by rewrite -size_eq0 /#. (* SQUEEZE *) splitwhile {1} 5: (i+1 < (n + r - 1) %/ r). +seq 5 3: (#[/3:5]pre /\ n{1} = 8*outlen2 /\ + outlen{2} = outlen2 - rate8*i{1} /\ + match_state (sa,sc){1} (sponge_permutation st{2}) /\ + z{1} = w8L2bits result{2} /\ + size result{2} = rate8 * i{1} /\ + i{1}+1 = (n{1} + r - 1) %/ r). + (* SQUEEZE intermediate blocks *) + while (#[:-1]post). + rcondt {1} 3. + by move=> ?; wp; skip; progress. + ecall {1} (perm_correct st{2}); wp; skip; progress. + + admit. + + by rewrite H6. + + by rewrite H6. + + admit. + + admit. + + admit. + + admit. + wp 1 1; ecall {1} (perm_correct st{2}); wp; skip; progress. + + admit. + + admit. + + by rewrite H3. + + by rewrite H3. + + admit (* rate8 < outlen{2} *). + + admit (* 0 < (8 * outlen{2} + r - 1) %/ r *). + + admit (* 1 < (8 * outlen{2} + r - 1) %/ r *). + + admit. +(* SQUEEZE final block *) +rcondt {1} 1; first by move=> ?; wp; skip; progress; smt(). +rcondf {1} 3; first by move=> ?; wp; skip; progress; smt(). +rcondf {1} 3; first by move=> ?; wp; skip; progress; smt(). +wp; skip; progress. +rewrite w8L2bits_cat take_cat'. +rewrite (:!8 * outlen2 <= size (w8L2bits result{2})) /=. + rewrite H1. smt. +congr; rewrite (match_state_r _ _ H0) /squeezestate ofblockK. + admit. +rewrite take_take min_lel /state2bits. + admit. +have ->: 8 * outlen2 - 8 * size result{2} = 8*(outlen2 -size result{2}) by ring. +rewrite take_w8L2bits; congr. +rewrite take_take min_lel. + rewrite -H1. smt. +congr; smt(). +qed. + +(* admit (* TODO: adjust proof script to a last-minute change in the control-flow case: (0 < outl2); last first. (* corner case: no output *) @@ -848,8 +1174,8 @@ unroll {1} 1; rcondt {1} 1; first by move=> *; skip => |> * /#. rcondf {1} 3; first by move=> *; wp; skip => |> * /#. rcondf {1} 3; first by move=> *; wp; skip => |> * /#. by wp; skip => |> *. -*). qed. +*)*) end section. diff --git a/proof/impl/keccak_1600_corr.ec b/proof/impl/keccak_1600_corr.ec index 47459c2..62c2b4b 100644 --- a/proof/impl/keccak_1600_corr.ec +++ b/proof/impl/keccak_1600_corr.ec @@ -1,7 +1,7 @@ require import List Int IntExtra IntDiv CoreMap. from Jasmin require import JModel. -require import Array25 EclibExtra JWordList. +require import Array25 WArray200 EclibExtra JWordList. require import Spec1600 Keccak_1600_ref. @@ -12,7 +12,7 @@ op inv_ptr (in_0 inlen out outlen: W64.t) = good_ptr in_0 (to_uint inlen) /\ good_ptr out (to_uint outlen). - +(* lemma addstate_nil st: addstate st [] = st. proof. by apply Array25.ext_eq => i Hi; rewrite /addstate initiE. qed. @@ -226,7 +226,7 @@ move=> Hi; rewrite w64L2w8L_squeezestate /WArray200.WArray200.get8. by rewrite nth_take 1,2:/# WArray200.WArray200.get_to_list. qed. - +*) (* SPECIFICATION OF LEAF-FUNCTIONS *) @@ -256,6 +256,81 @@ lemma st0_spec: phoare [ M.st0 : true ==> res = st0 ] = 1%r. proof. by conseq st0_spec_ll st0_spec_h. qed. + +lemma to_uintS_lt (x y:W64.t) : + to_uint x < to_uint y => + to_uint (x + W64.one) = to_uint x + 1. +admitted. + +lemma xorstate_w8L_getE st l i: + size l < i => + state_get8 (xorstate_w8L st l) i = (st.[i %/ 8] \bits8 (i %% 8)) `^` nth W8.zero l i. +admitted. +abbrev state_xor64 (st: state) i x = st.[i <- st.[i] `^` x]. +lemma xorstate_w64L_rcons st l x: + size l < 25 => + xorstate_w64L st (rcons l x) = state_xor64 (xorstate_w64L st l) (size l) x. +admitted. +lemma xorstate_w64L_rconsE i st l x: + i < 25 => + i = size l => + xorstate_w64L st (rcons l x) = state_xor64 (xorstate_w64L st l) i x. +admitted. + +lemma memread64S mem in_ i: + memread64 mem in_ (i+1) + = rcons (memread64 mem in_ i) (loadW64 mem (in_ + 8*i)). +admitted. + +lemma xorstate_w64L_step st mem in_ i: + xorstate_w64L st (memread64 mem in_ (i+1)) + = state_xor64 (xorstate_w64L st (memread64 mem in_ i)) + i (loadW64 mem (in_+8*i)). +admitted. + +abbrev upd8 (f: W8.t -> W8.t -> W8.t) (st:state) (i:int) (x:W8.t) = + state25 (set8 (state200 st) i (f (get8 (state200 st) i) x)). + +lemma xorstate_w8L_rcons st l x: + xorstate_w8L st (rcons l x) + = state_xor8 (xorstate_w8L st l) (size l) x. +admitted. + +lemma xorstate_w8L_rconsE i st l x: + i < 200 => + i = size l => + xorstate_w8L st (rcons l x) + = state_xor8 (xorstate_w8L st l) i x. +admitted. + +lemma memreadS mem in_ sz: + memread mem in_ (sz + 1) = rcons (memread mem in_ sz) (loadW8 mem (in_+sz)). +admitted. + +lemma upd8_state_xor8 st i l x: + upd8 W8.(`^`) (xorstate_w8L st l) i x + = state_xor8 (xorstate_w8L st l) (size l) x. +admitted. + +lemma xorstate_w8L0 st: xorstate_w8L st [] = st. +admitted. +lemma xorstate_w64L0 st: xorstate_w64L st [] = st. +admitted. + +print w8L2w64L. +print w64L2w8L. +lemma xorstate_w64L2w8L st l: + xorstate_w64L st l = xorstate_w8L st (w64L2w8L l). +admitted. + +lemma xorstate_w8L2w64L st l: + xorstate_w8L st l = xorstate_w64L st (w8L2w64L l). +admitted. + +lemma w8L2w64L2state l: + w8L2state l = w64L2state (w8L2w64L l). +admitted. + lemma add_full_block_spec_h st in_ inlen_ r8_: hoare [ M.add_full_block: state = st @@ -265,42 +340,33 @@ lemma add_full_block_spec_h st in_ inlen_ r8_: /\ good_ptr in_0 rate8 /\ to_uint r8 = rate8 ==> - res.`1 = addstate st - (take_block64 (memread Glob.mem (to_uint in_) rate8)).`1 - /\ res.`2 = (in_ + r8_)%W64 + res.`1 = xorstate_w64L st (memread64 Glob.mem (to_uint in_) rate64) + /\ res.`2 = in_ + r8_ /\ res.`3 = inlen_ - r8_ ]. proof. +have Rbnds:= rate64_bnds. +have Wbnds:= W64.to_uint_cmp. proc; simplify; wp; sp. while (#[4:]pre /\ to_uint r64 = rate64 /\ to_uint i <= rate64 /\ - state = addstate st (take (to_uint i) - (take_block64 (memread Glob.mem (to_uint in_) rate8)).`1)). - wp; skip; progress. - + move: H3; rewrite ultE => ?. - by rewrite to_uintD_small of_uintK modz_small; smt(rate64_bnds). - + pose s := take (to_uint i{hr}) _. - rewrite (addstate_get' st s); first smt. - rewrite to_uintD_small to_uintM_small of_uintK modz_small //. - - smt(rate64_bnds). - - smt. - - smt(rate64_bnds). - rewrite to_uintD_small of_uintK modz_small //. - smt. - rewrite (take_nth W64.zero). - smt. - rewrite addstate_rcons -/s (: size s = to_uint i{hr}) 1:[smt]. - congr; congr. - rewrite loadW64_take_block64 //. - smt. + state = xorstate_w8L st + (absorb_split (memread Glob.mem (to_uint in_) (8*to_uint i))).`1). + wp; skip; rewrite ultE; progress. + + by rewrite to_uintD_small of_uintK modz_small /#. + + rewrite (to_uintS_lt _ _ H3) 2!xorstate_w8L2w64L. + rewrite /absorb_split /= !take_memread 1,2:/# !min_ler 1,2:/#. + rewrite -xorstate_w64L_rconsE 1:/#; first rewrite size_w8L2w64L size_memread /#. + rewrite -!memread64E memread64S; congr; congr; congr; congr. + rewrite to_uintD_small to_uintM of_uintK !modz_small //; smt(). skip; progress. + by rewrite to_uint_shr /#. -+ smt(rate64_bnds). -+ by rewrite take0 addstate_nil. -+ have E: to_uint i0 = rate64. - smt. - move: H5; rewrite take_oversize. - smt. - done. ++ smt(). ++ by rewrite /absorb_split /= xorstate_w8L0. ++ have ->: to_uint i0 = rate64. + by move: H1; rewrite -W64.uleNgt uleE to_uint_shr of_uintK //= /#. + move: H5; rewrite /absorb_split /= take_oversize. + by rewrite size_mkseq; smt(). + by move=>?; rewrite memread64E -xorstate_w8L2w64L. qed. lemma add_full_block_spec_ll: islossless M.add_full_block. @@ -324,13 +390,13 @@ lemma add_full_block_spec st in_ inlen_ r8_: /\ good_ptr in_0 rate8 /\ to_uint r8 = rate8 ==> - res.`1 = addstate st - (take_block64 (memread Glob.mem (to_uint in_) rate8)).`1 + res.`1 = xorstate_w64L st (memread64 Glob.mem (to_uint in_) rate64) /\ res.`2 = (in_ + r8_)%W64 /\ res.`3 = inlen_ - r8_ ] = 1%r. -proof. by conseq add_full_block_spec_ll (add_full_block_spec_h st in_ inlen_ r8_). qed. - +proof. +by conseq add_full_block_spec_ll (add_full_block_spec_h st in_ inlen_ r8_). +qed. lemma add_final_block_spec_h st (in_ inlen_: W64.t) trail_byte_: hoare [ M.add_final_block: @@ -342,138 +408,76 @@ lemma add_final_block_spec_h st (in_ inlen_: W64.t) trail_byte_: /\ to_uint inlen_ < rate8 /\ good_ptr in_0 (to_uint inlen_) ==> - res = addfinalblock st - (final_block64 (W8.of_int (to_uint trail_byte_)) - (memread Glob.mem (to_uint in_) (to_uint inlen_))) + res = addfinalbit + (xorstate_w8L st + (absorb_final (W8.of_int (to_uint trail_byte_)) + (memread Glob.mem (to_uint in_) (to_uint inlen_)))) ]. proof. +have Rbnds:= rate64_bnds. +have Wbnds:= W64.to_uint_cmp. proc; simplify. seq 4: (to_uint i = to_uint inlen_ %/ 8 /\ - state = addstate st (w8L2w64L (take (to_uint inlen_ %/ 8 * 8) - (memread Glob.mem (to_uint in_) (to_uint inlen_)))) /\ + state = xorstate_w64L st + (memread64 Glob.mem (to_uint in_) (to_uint inlen_ %/ 8)) /\ #[2:]pre /\ to_uint inlen8 = to_uint inlen_ %/ 8 ). while (#[/3:]post /\ to_uint i <= to_uint inlen8 /\ - state = addstate st (take (to_uint i) (w8L2w64L (memread Glob.mem (to_uint in_) (to_uint inlen_ %/ 8 * 8))))). - wp; skip; progress. - rewrite to_uintD_small; smt. - rewrite (W64.to_uintD_small _ W64.one). smt. - have Esz : size (w8L2w64L (memread Glob.mem{hr} (to_uint in_0{hr}) (to_uint inlen{hr} %/ 8 * 8))) = to_uint inlen{hr} %/ 8. - rewrite size_w8L2w64L ?size_memread. smt. smt(). - rewrite of_uintK modz_small // (take_nth W64.zero) ?size_memread. - rewrite Esz. smt. - rewrite addstate_rcons; congr. - rewrite size_take. smt. - rewrite Esz. smt. - rewrite addstate_get. smt. - pose Z:= nth W64.zero (take _ _) _. - have ->/=: Z = W64.zero. - rewrite /Z nth_out // size_take'. smt. - rewrite size_w8L2w64L ?size_memread. smt. - smt(). - congr. - rewrite size_take'. smt. - rewrite size_w8L2w64L ?size_memread. smt. - smt(). - rewrite -nth_memread_u64. smt. smt. - congr. - rewrite to_uintD_small. smt. smt. - wp; skip; progress. - + rewrite to_uint_shr; smt. - + rewrite to_uint_shr; smt. - + by rewrite take0 addstate_nil. - + smt. - + rewrite (: to_uint i0 = to_uint inlen{hr} %/ 8). smt. - rewrite take_w8L2w64L. - congr; congr. - rewrite !take_memread. smt. smt. - congr. smt. - -exists* (addstate st - (w8L2w64L (take (to_uint inlen_ %/ 8 * 8) - (memread Glob.mem (to_uint in_) (to_uint inlen_))))); elim* => st'. + state = xorstate_w64L st (memread64 Glob.mem (to_uint in_) (to_uint i))). + wp; skip; rewrite !ultE; progress. + by rewrite (to_uintS_lt _ _ H4) /#. + rewrite (to_uintS_lt _ _ H4) xorstate_w64L_step. + congr; congr; congr. + by rewrite to_uintD to_uintM of_uintK !modz_small //= /#. + wp; skip; progress. + + by rewrite to_uint_shr /#. + + by rewrite to_uint_shr 1:/# /= divz_ge0 //= /#. + + by rewrite /memread64 mkseq0 xorstate_w64L0. + + move: H7; rewrite to_uint_shr 1:/# /= => ?. + by move: H2; rewrite ultE to_uint_shr /#. + + move: H7; rewrite to_uint_shr 1:/# /= => ?. + move: H2; rewrite ultE to_uint_shr 1:/# /= => ?. + by rewrite (: to_uint i0 = to_uint inlen{hr} %/ 8) /#. +exists* (xorstate_w64L st + (memread64 Glob.mem (to_uint in_) (to_uint inlen_ %/ 8))); elim* => st'. seq 2: (#[/1,4:-1]pre /\ to_uint i = to_uint inlen_ /\ - state = st'.[to_uint inlen_ %/ 8 <- st'.[to_uint inlen_ %/ 8] `^` W8u8.pack8 (memread Glob.mem (to_uint in_ + to_uint inlen_ %/ 8 * 8) (to_uint inlen_ %% 8))]). + state = xorstate_w8L st + (memread Glob.mem (to_uint in_) (to_uint inlen_))). while (#[/:-2]post /\ to_uint inlen_ %/ 8 * 8 <= to_uint i <= to_uint inlen_ /\ - state = st'.[to_uint inlen_ %/ 8 <- st'.[to_uint inlen_ %/ 8] `^` - pack8 (take (to_uint i %% 8) (memread Glob.mem (to_uint in_ + to_uint inlen_ %/ 8 * 8) (to_uint inlen_ %% 8)))]). - wp; skip => ?[[[?]]]; progress. - rewrite to_uintD_small of_uintK modz_small //; smt. - rewrite to_uintD_small of_uintK modz_small //; smt. - rewrite state_xor_u8E (W64.to_uintD_small _ W64.one). smt. - - rewrite of_uintK (modz_small 1) //. - have ->: ((to_uint i{hr} + 1) %% 8) = to_uint i{hr} %% 8 + 1. smt. - rewrite (take_nth W8.zero). - rewrite size_memread. smt. smt. - rewrite addstate_rcons_byte. - rewrite size_take 1:/# size_memread 1:/#. - rewrite (: to_uint i{hr} %% 8 < to_uint inlen{hr} %% 8) /=. smt. - smt. smt. - congr. - rewrite size_take 1:/# size_memread 1:/#. - rewrite (: to_uint i{hr} %% 8 < to_uint inlen{hr} %% 8) /=. smt. - smt. - rewrite (modzE (to_uint i{hr}) 8). - rewrite (: to_uint i{hr} %/ 8 * 8 = to_uint inlen{hr} %/ 8 * 8). smt. - rewrite -loadW8_memread'. smt. - congr; rewrite to_uintD_small. smt. - done. + to_uint inlen_ %/ 8 = to_uint i %/ 8 /\ + state = xorstate_w8L st (memread Glob.mem (to_uint in_) (to_uint i))). + wp; skip; rewrite ultE => ?[[[?]]]; progress. + + by rewrite (to_uintS_lt _ _ H6) /#. + + by rewrite (to_uintS_lt _ _ H6) /#. + + by rewrite (to_uintS_lt _ _ H6) /#. + + rewrite (to_uintS_lt _ _ H6). + rewrite memreadS xorstate_w8L_rcons size_memread 1:/#. + rewrite upd8_state_xor8 size_memread 1:/#. + by rewrite to_uintD_small 1:/#. wp; skip => ?[?]; progress. - + rewrite to_uint_shl of_uintK (modz_small 3) //= modz_small. smt. - smt. - + rewrite to_uint_shl //=. smt. - rewrite to_uint_shl //=. - rewrite (modz_small (_*_)%Int). smt. - rewrite (: to_uint i{hr} * 8 %% 8 = 0). smt. - rewrite take0 H addstate_get. smt. - have ->/=: W8u8.pack8 [] = W64.zero. - by apply W64.all_eq_eq; rewrite /all_eq. - pose X:= nth _ _ _. - have ->/=: X = W64.zero. - rewrite /X nth_out // size_w8L2w64L'. - rewrite size_take. smt. rewrite size_memread. smt. admit. - smt. - have <-:= addstate_get' st (w8L2w64L - (take (to_uint inlen{hr} %/ 8 * 8) - (memread Glob.mem{hr} (to_uint in_0{hr}) (to_uint inlen{hr})))). - rewrite size_w8L2w64L size_take'. smt. rewrite size_memread. smt. admit. - by rewrite Array25.set_notmod. - + smt. - + have E: to_uint i0 = to_uint inlen{hr}. smt. - smt. - -exists* (st'.[to_uint inlen_ %/ 8 <- st'.[to_uint inlen_ %/ 8] `^` W8u8.pack8 (memread Glob.mem (to_uint in_ + to_uint inlen_ %/ 8 * 8) (to_uint inlen_ %% 8))]); elim*=> st''. + + by rewrite to_uint_shl of_uintK (modz_small 3) //= modz_small /#. + + by rewrite to_uint_shl //= /#. + + by rewrite to_uint_shl //= /#. + + congr; rewrite memread64E to_uint_shl of_uintK modz_small //= 1:/#. + by rewrite -H0 (mulzC 8) w8L2w64L2state. + + by move: H5; rewrite -W64.uleNgt uleE /#. + + by move: H5; rewrite -W64.uleNgt uleE /#. +exists* (xorstate_w8L st (memread Glob.mem (to_uint in_) (to_uint inlen_))). +elim*=> st''. seq 1: (#[/:-1]pre /\ state = state_xor_u8 st'' (to_uint inlen_) trail_byte_). wp; skip => ?[?[[?]]]; progress. - rewrite state_xor_u8E H; smt. - -(* summing up everything *) + rewrite /state_xor_u8 upd8_state_xor8 size_memread 1:/#. + rewrite H -(xorstate_w8L_rconsE (to_uint inlen{hr})) 1:/#. + by rewrite size_memread /#. + done. wp; skip => ?[[?[?]]] |> *. -rewrite state_xor_u8E /addfinalblock addfinalbitE; congr; last first. - by rewrite to_uintB 2:/# uleE of_uintK modz_small //; smt(rate8_bnds). -rewrite final_block64_lastu64 addstate_rcons. -have inlen_bnds := W64.to_uint_cmp inlen{hr}. -pose L := w8L2w64L _. -have Lsz: size L = to_uint inlen{hr} %/ 8. - rewrite /L size_w8L2w64L size_take' size_memread 1..3:/#. - rewrite (: to_uint inlen{hr} %/ 8 * 8 <= to_uint inlen{hr}) /=. - smt. - rewrite {2}(divz_eq (to_uint inlen{hr}) 8) !divzMDl //. - rewrite divNz //= (divz_small (to_uint inlen{hr} %% 8)) //. - by apply modz_cmp. -have E: (addstate st L).[size L] = st.[size L] by rewrite addstate_get' //. -rewrite -{1}E addstate_rcons_byte. - rewrite size_drop; first smt(size_ge0). - rewrite !size_memread 1:/#. - smt. - smt. -rewrite size_memread 1:/# drop_memread 1:/# -modzE size_memread; first smt(size_ge0). -pose Lsz' := 8 * size L + _. -have ->: Lsz' = to_uint inlen{hr} by smt(). -rewrite H H0 !Lsz /L size_memread; first smt(size_ge0). -by congr; congr. +rewrite /addfinalbit /absorb_final H /state_xor_u8 /state_xor8. +have ->: (to_uint (r8{hr} - W64.one)) = rate8-1. + by rewrite to_uintB ?uleE /#. +rewrite cats1 -(xorstate_w8L_rconsE) 1:/#. + by rewrite size_memread /#. +smt(). qed. @@ -503,14 +507,20 @@ lemma add_final_block_spec st (in_ inlen_: W64.t) trail_byte_: /\ to_uint inlen_ < rate8 /\ good_ptr in_0 (to_uint inlen_) ==> - res = addfinalblock st - (final_block64 (W8.of_int (to_uint trail_byte_)) - (memread Glob.mem (to_uint in_) (to_uint inlen_))) + res = addfinalbit + (xorstate_w8L st + (absorb_final (W8.of_int (to_uint trail_byte_)) + (memread Glob.mem (to_uint in_) (to_uint inlen_)))) ] = 1%r. proof. by conseq add_final_block_spec_ll (add_final_block_spec_h st in_ inlen_ trail_byte_). qed. + +lemma size_squeezestate64 st: + size (squeezestate64 st) = 25. +admitted. + lemma xtr_full_block_spec_h mem st out_ outlen_: hoare [ M.xtr_full_block: Glob.mem = mem @@ -521,37 +531,42 @@ lemma xtr_full_block_spec_h mem st out_ outlen_: /\ to_uint rate = rate8 /\ good_ptr out_ rate8 ==> - Glob.mem = stores64 mem (to_uint out_) (squeezestate st) + Glob.mem = stores64 mem (to_uint out_) (squeezestate64 st) /\ to_uint res.`1 = to_uint out_ + rate8 /\ to_uint res.`2 = to_uint outlen_ - rate8 ]. proof. +have Rbnds:= rate64_bnds. +have Wbnds:= W64.to_uint_cmp. proc; simplify. -wp; while (state = st /\ out = out_ /\ outlen = outlen_ /\ good_ptr out_ rate8 /\ - to_uint r64 = rate64 /\ 0 <= to_uint i <= to_uint r64 /\ - Glob.mem = stores64 mem (to_uint out_) (take (to_uint i) (squeezestate st))). - wp; skip; rewrite ultE => |> *. - rewrite (: to_uint (i{hr} + W64.one) = to_uint i{hr} + 1). - rewrite to_uintD_small of_uintK modz_small //. - move: H3; rewrite ltzE; smt(rate64_bnds). - progress; first 2 smt(). - rewrite (take_nth W64.zero); first by rewrite size_squeezestate /#. +wp; while (state = st /\ out = out_ /\ outlen = outlen_ /\ + good_ptr out_ rate8 /\ to_uint r64 = rate64 /\ + 0 <= to_uint i <= to_uint r64 /\ + Glob.mem = stores64 mem (to_uint out_) (take (to_uint i) + (squeezestate64 st))). + wp; skip; rewrite ultE => |> *. + rewrite (to_uintS_lt _ _ H3); progress; first 2 smt(). + rewrite (take_nth W64.zero); first by rewrite size_squeezestate64 /#. rewrite stores64_rcons; congr. - rewrite to_uintD_small to_uintM_small of_uintK modz_small //; smt. - rewrite nth_squeezestate; smt(rate64_bnds). + rewrite to_uintD_small to_uintM_small of_uintK modz_small // 1..3:/#. + by rewrite size_take 1:/# size_squeezestate64 /#. + rewrite /squeezestate64 nth_take 1,2:/# -get_to_list. + by apply nth_inside; rewrite size_to_list /#. wp; skip => |> *; progress. + by rewrite to_uint_shr of_uintK modz_small // /#. -+ by rewrite to_uint_shr of_uintK modz_small //; smt(rate64_bnds). ++ by rewrite to_uint_shr of_uintK modz_small // /#. + by rewrite take0. -+ have ->: to_uint i0 = rate64 by smt. - by rewrite take_oversize // size_squeezestate. ++ have ->: to_uint i0 = rate64. + by move: H2; rewrite -W64.uleNgt uleE to_uint_shr /#. + by rewrite take_take min_ler //. + by rewrite to_uintD_small H0. + by rewrite to_uintB ?uleE /#. qed. lemma xtr_full_block_spec_ll: islossless M.xtr_full_block. proof. -islossless. while true (to_uint r64 - to_uint i). +islossless. +while true (to_uint r64 - to_uint i). move=> ?; wp; skip; progress. move: H; rewrite ultE => ?. rewrite to_uintD_small of_uintK modz_small // 2:/#. @@ -569,7 +584,7 @@ lemma xtr_full_block_spec mem st out_ outlen_: /\ to_uint rate = rate8 /\ good_ptr out_ rate8 ==> - Glob.mem = stores64 mem (to_uint out_) (squeezestate st) + Glob.mem = stores64 mem (to_uint out_) (squeezestate64 st) /\ to_uint res.`1 = to_uint out_ + rate8 /\ to_uint res.`2 = to_uint outlen_ - rate8 ] = 1%r. @@ -577,6 +592,11 @@ proof. by conseq xtr_full_block_spec_ll (xtr_full_block_spec_h mem st out_ outlen_). qed. +lemma take_w64L2w8L n l: + take (8*n) (w64L2w8L l) = w64L2w8L (take n l). +admitted. + + lemma xtr_bytes_spec_h mem st out_ outlen_: hoare [ M.xtr_bytes: Glob.mem = mem @@ -586,68 +606,50 @@ lemma xtr_bytes_spec_h mem st out_ outlen_: /\ to_uint outlen_ <= rate8 /\ good_ptr out_ (to_uint outlen_) ==> - Glob.mem = stores mem (to_uint out_) (xtrbytes (to_uint outlen_) - (squeezestate st)) ]. + Glob.mem = stores8 mem (to_uint out_) (take (to_uint outlen_) + (squeezestate st)) ]. proof. +have Rbnds:= rate64_bnds. +have Wbnds:= W64.to_uint_cmp. proc; simplify. while (#[2,-2:]pre /\ outlen_ = outlen /\ out_ = out /\ to_uint outlen_ %/ 8 * 8 <= to_uint i <= to_uint outlen_ /\ - Glob.mem = stores mem (to_uint out_) (xtrbytes (to_uint i) - (squeezestate st))). + Glob.mem = stores8 mem (to_uint out_) (take (to_uint i) + (squeezestate st))). wp; skip; rewrite !ultE => |> *. - have ->: to_uint (i{hr} + W64.one) = to_uint i{hr} + 1. - rewrite to_uintD_small of_uintK modz_small //. - by move: H2 (W64.to_uint_cmp outlen{hr}); rewrite ltzE /#. - progress. - + smt(). - + smt(). - + rewrite /xtrbytes (take_nth W8.zero). - rewrite size_w64L2w8L size_squeezestate; smt. - rewrite stores_rcons; congr. - rewrite to_uintD_small 1:/# size_take; first smt(W64.to_uint_cmp). - rewrite size_w64L2w8L size_squeezestate. - by rewrite (:to_uint i{hr} < 8 * rate64) 1:/#. - rewrite state_get8E; smt(W64.to_uint_cmp). + rewrite (to_uintS_lt _ _ H3); progress; first 2 smt(). + rewrite (take_nth W8.zero) ?size_squeezestate 1:/#. + rewrite stores8_rcons; congr. + by rewrite to_uintD_small 1:/# size_take ?size_squeezestate /#. + by rewrite state_get8P nth_take /#. wp; while (#[2:]pre /\ 0 <= to_uint i <= to_uint outlen_ %/ 8 /\ out = out_ /\ to_uint outlen8 = to_uint outlen %/ 8 /\ - Glob.mem = stores64 mem (to_uint out_) (take (to_uint i) (squeezestate st))). + Glob.mem = stores64 mem (to_uint out_) (take (to_uint i) + (squeezestate64 st))). wp; skip; rewrite !ultE => |> *. - have ->: to_uint (i{hr} + W64.one) = to_uint i{hr} + 1. - rewrite to_uintD_small of_uintK modz_small //. - by move: H2 (W64.to_uint_cmp outlen{hr}); rewrite ltzE /#. + rewrite (to_uintS_lt _ _ H4). have ->: to_uint (out{hr} + W64.of_int 8 * i{hr}) = to_uint out{hr} + 8 * to_uint i{hr}. - rewrite to_uintD_small to_uintM_small of_uintK modz_small //. - smt. smt. smt. - progress. - + smt(). - + smt(). - + rewrite (take_nth W64.zero). - rewrite size_squeezestate; smt(rate64_bnds). + by rewrite to_uintD_small to_uintM_small of_uintK modz_small //= /#. + progress; first 2 smt(). + + rewrite (take_nth W64.zero) ?size_squeezestate64 1:/#. rewrite stores64_rcons; congr. - rewrite size_take 1:/# size_squeezestate. - by rewrite (: to_uint i{hr} < rate64) 1:[smt(rate64_bnds)]. - rewrite /squeezestate nth_take 1,2:/# -Array25.get_to_list. - by apply nth_inside; rewrite Array25.size_to_list; smt(rate64_bnds). + by rewrite size_take ?size_squeezestate64 /#. + rewrite nth_take 1,2:/# -Array25.get_to_list. + by apply nth_inside; rewrite Array25.size_to_list /#. wp; skip => |> *; progress. -+ smt. ++ smt(). + by rewrite to_uint_shr of_uintK modz_small //. + by rewrite take0. -+ move: {H4} H1; rewrite ultE. - have ->: to_uint (outlen{hr} `>>` (of_int 3)%W8) = to_uint outlen{hr} %/ 8. - by rewrite to_uint_shr of_uintK modz_small. - move=> ?; have ->: to_uint (i0 `<<` (of_int 3)%W8) = to_uint i0 * 8. - rewrite to_uint_shl of_uintK modz_small //=. - apply bound_abs; split; first smt(). - move=> ?; smt. - smt(). -+ rewrite to_uint_shl of_uintK modz_small //=; first smt. - smt(). -+ rewrite to_uint_shl of_uintK modz_small //=; first smt. - rewrite stores64_stores; congr. - by rewrite /xtrbytes /squeezestate w64L2w8L_take mulzC. -+ have ->: to_uint i1 = to_uint outlen{hr} by smt. - done. ++ move: H1; rewrite ultE to_uint_shr of_uintK modz_small //= => ?. + by rewrite to_uint_shl of_uintK modz_small //= /#. ++ by rewrite to_uint_shl of_uintK modz_small //= /#. ++ rewrite to_uint_shl of_uintK modz_small //= 1:/#. + rewrite stores64_stores8; congr. + have ->: to_uint i0 = to_uint outlen{hr} %/ 8. + by move: H1; rewrite ultE to_uint_shr of_uintK //= /#. + by rewrite squeezestateE (mulzC _ 8) take_w64L2w8L. ++ by move: H5; rewrite ultE //= /#. qed. lemma xtr_bytes_spec_ll: islossless M.xtr_bytes. @@ -674,8 +676,8 @@ lemma xtr_bytes_spec mem st out_ outlen_: /\ to_uint outlen_ <= rate8 /\ good_ptr out_ (to_uint outlen_) ==> - Glob.mem = stores mem (to_uint out_) (xtrbytes (to_uint outlen_) - (squeezestate st)) + Glob.mem = stores8 mem (to_uint out_) (take (to_uint outlen_) + (squeezestate st)) ] = 1%r. proof. by conseq xtr_bytes_spec_ll (xtr_bytes_spec_h mem st out_ outlen_). qed. @@ -683,7 +685,6 @@ proof. by conseq xtr_bytes_spec_ll (xtr_bytes_spec_h mem st out_ outlen_). qed. (* MAIN RESULT *) - section. axiom permutation_instantiation mem st: @@ -692,7 +693,6 @@ axiom permutation_instantiation mem st: ==> Glob.mem = mem /\ res = sponge_permutation st ] = 1%r. -print M. lemma spec_correct mem out_: equiv [ Spec.f ~ M.__keccak_1600 : Glob.mem{2} = mem /\ inv_ptr in_0{2} inlen{2} s_out{2} s_outlen{2} /\ @@ -703,9 +703,11 @@ equiv [ Spec.f ~ M.__keccak_1600 : to_uint trail_byte{1} = to_uint s_trail_byte{2} /\ to_uint rate{2} = rate8 ==> - Glob.mem{2} = stores mem (W64.to_uint out_) res{1} + Glob.mem{2} = stores8 mem (W64.to_uint out_) res{1} ]. proof. +have Rbnds:= rate64_bnds. +have Wbnds:= W64.to_uint_cmp. proc; simplify; wp. ecall {2} (xtr_bytes_spec Glob.mem{2} state{2} out{2} outlen{2}); simplify. wp; ecall {2} (permutation_instantiation Glob.mem{2} state{2}); simplify. @@ -713,17 +715,14 @@ wp; while (st{1}=state{2} /\ to_uint rate{2}=rate8 /\ to_uint s_out{2} = to_uint out_ + size result{1} /\ to_uint outlen{2} = to_uint s_outlen{2} /\ outlen{1} = to_uint s_outlen{2} /\ good_ptr s_out{2} (to_uint s_outlen{2}) /\ - Glob.mem{2} = stores mem (to_uint out_) result{1}). + Glob.mem{2} = stores8 mem (to_uint out_) result{1}). wp; ecall {2} (xtr_full_block_spec Glob.mem{2} state{2} out{2} outlen{2}); simplify. wp; ecall {2} (permutation_instantiation Glob.mem{2} state{2}); simplify. - wp; skip; rewrite !ultE; progress. - + smt(). + wp; skip; rewrite !ultE; progress; first 2 smt(). + + by rewrite size_cat H8 H0 size_squeezestate /#. + smt(). - + rewrite size_cat H8 H0 size_xtrbytes; smt(rate8_bnds). + smt(). - + smt(). - + rewrite H0 stores_cat stores64_stores /xtrbytes -w64L2w8L_take. - by rewrite take_oversize ?size_squeezestate. + + by rewrite H0 stores8_cat stores64_stores8 -squeezestateE. + by rewrite !ultE /#. + by move: H10; rewrite ultE /#. wp; ecall {2} (add_final_block_spec state{2} in_0{2} inlen{2} trail_byte{2}); simplify. @@ -733,34 +732,29 @@ wp; while (st{1}=state{2} /\ to_uint rate{2} = rate8 /\ s_out{2} = out_ /\ outlen{1}=to_uint s_outlen{2} ). wp; ecall {2} (permutation_instantiation Glob.mem{2} state{2}); simplify. wp; ecall {2} (add_full_block_spec state{2} in_0{2} inlen{2} rate{2}); simplify. - wp; skip; rewrite uleE; progress. - + smt(). + wp; skip; rewrite uleE; progress; first smt(). + rewrite H5; congr; congr. - rewrite /take_block64 /=; congr; congr. - rewrite take_memread; first smt(rate8_bnds). - rewrite take_memread; first smt(rate8_bnds). - by rewrite min_lel 1:/#. - + rewrite /take_block64 /= drop_memread; first smt(rate8_bnds). - rewrite H6 to_uintD_small ?H 1:/#. - by rewrite H7 to_uintB ?uleE /#. + rewrite /absorb_split /= memread64E -w8L2w64L2state; congr. + by rewrite take_memread 1:/# min_lel /#. + + rewrite /absorb_split /= drop_memread 1:/# H6 to_uintD_small ?H 1:/#. + by rewrite H7 to_uintB ?uleE 1:/# H4. + by rewrite H6 H7 to_uintD_small 1:/# to_uintB ?uleE /#. + rewrite uleE H7 to_uintB ?uleE 1:/#. - move: H8; rewrite size_take_block64r size_memread'; smt(). + by move: H8; rewrite size_absorb_split2 size_mkseq /#. + move: H8; rewrite H7 uleE to_uintB ?uleE 1:/# => *. - rewrite size_take_block64r 1:/# size_memread 2:/#. - move: (W64.to_uint_cmp inlen{2}); smt(). + by rewrite size_absorb_split2 1:/# size_memread /#. wp; call {2} st0_spec; wp; skip; rewrite /inv_ptr => |> *; progress. -+ move: H4; rewrite size_memread' uleE /max. - by case: (0 < to_uint inlen{2}); smt(rate8_bnds). ++ move: H4; rewrite size_mkseq uleE /max. + by case: (0 < to_uint inlen{2}); smt(). + move: H4; rewrite uleE H3 => ?. - by rewrite size_memread; smt(rate8_bnds). + by rewrite size_memread /#. + by move: H5; rewrite uleE /#. -+ congr; congr. ++ rewrite /addfinalblock; congr; congr; congr; congr. by apply W8.word_modeqP; rewrite to_uint_truncateu8 modz_mod H2. + by rewrite ultE H6. + by move: H9; rewrite ultE H6. -+ by move: H10; rewrite ultE H11; smt(). -+ by rewrite H12 -stores_cat. ++ by move: H10; rewrite ultE H11 /#. ++ by rewrite H12 -stores8_cat. qed. end section. From 35a85388b6fac1446e2e87a23535334256a2c0bb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jos=C3=A9=20Bacelar=20Almeida?= Date: Sun, 19 May 2019 03:40:08 +0100 Subject: [PATCH 431/525] JWordList closed --- proof/impl/JWordList.ec | 248 ++++++++++++++++++------- proof/impl/Spec1600.ec | 80 ++++++++ proof/impl/keccak_1600_corr.ec | 328 +++------------------------------ 3 files changed, 288 insertions(+), 368 deletions(-) diff --git a/proof/impl/JWordList.ec b/proof/impl/JWordList.ec index 121ce3d..000c4c7 100644 --- a/proof/impl/JWordList.ec +++ b/proof/impl/JWordList.ec @@ -61,6 +61,72 @@ qed. lemma w8L2bits_u64 w: w8L2bits (W8u8.to_list w) = W64.w2bits w. proof. by rewrite /w8L2bits. qed. + +op bits2w8L (bs: bool list) : W8.t list = + map W8.bits2w (BitEncoding.BitChunking.chunk 8 (chunkfill false 8 bs)). + +lemma bits2w8L_nil: bits2w8L [] = []. +proof. +rewrite /bits2w8L chunkfill_nil. +by rewrite /BitEncoding.BitChunking.chunk /= mkseq0. +qed. + +hint simplify bits2w8L_nil. + +lemma size_bits2w8L' bs: + size (bits2w8L bs) = (size bs - 1) %/ 8 + 1. +proof. +rewrite /bits2w8L size_map BitEncoding.BitChunking.size_chunk //. +rewrite size_chunkfill //. +rewrite {3}(:8 = 1*8) 1:/# -mulzDl. +by rewrite -(addz0 (((size bs - 1) %/ 8 + 1) * 8)) divzMDl. +qed. + +lemma size_bits2w8L bs: + 8 %| size bs => size (bits2w8L bs) = size bs %/ 8. +proof. by rewrite dvdzP size_bits2w8L' => [[k ->]]; smt(). qed. + +lemma bits2w8LK bs: + 8 %| size bs => w8L2bits (bits2w8L bs) = bs. +proof. +move=> Hsz. +rewrite /w8L2bits -map_comp dvd_chunkfill //. +have : forall (x : bool list), + x \in BitEncoding.BitChunking.chunk 8 bs => + idfun x = W8.w2bits (W8.bits2w x). + move=> x Hx; beta. + rewrite W8.bits2wK //. + by apply (BitEncoding.BitChunking.in_chunk_size _ _ _ _ Hx). +rewrite List.eq_in_map => <-. +by rewrite map_id BitEncoding.BitChunking.chunkK // Hsz. +qed. + +lemma bits2w8LK' bs: + w8L2bits (bits2w8L bs) = chunkfill false 8 bs. +proof. +rewrite /bits2w8L -chunkfillK //. +by rewrite bits2w8LK ?chunkfillP // chunkfillK. +qed. + +lemma w8L2bits_inj: injective w8L2bits. +proof. +rewrite /w8L2bits; elim. + by move=> [|y ys]. +move=> x xs IH; elim => //. +move=> y ys IH2. +rewrite !map_cons !flatten_cons. +rewrite eqseq_cat. + by rewrite !size_w2bits. +move=> [/W8.w2bits_inj <- ?]; congr. +by apply IH. +qed. + +lemma w8L2bitsK: cancel w8L2bits bits2w8L. +proof. +move=> k; apply w8L2bits_inj. +by rewrite bits2w8LK // size_w8L2bits dvdz_mulr. +qed. + (*******************************************************************************) (* W64 lists *) (*******************************************************************************) @@ -86,7 +152,7 @@ rewrite /bits2w64L chunkfill_nil. by rewrite /BitEncoding.BitChunking.chunk /= mkseq0. qed. -lemma size_bits2w64L bs: +lemma size_bits2w64L' bs: size (bits2w64L bs) = (size bs - 1) %/ 64 + 1. proof. rewrite /bits2w64L size_map BitEncoding.BitChunking.size_chunk //. @@ -95,6 +161,10 @@ rewrite {3}(:64 = 1*64) 1:/# -mulzDl. by rewrite -(addz0 (((size bs - 1) %/ 64 + 1) * 64)) divzMDl. qed. +lemma size_bits2w64L bs: + 64 %| size bs => size (bits2w64L bs) = size bs %/ 64. +proof. by rewrite dvdzP size_bits2w64L' => [[k ->]]; smt(). qed. + hint simplify bits2w64L_nil. lemma bits2w64LK bs: @@ -365,12 +435,12 @@ elim: l1 => //= x xs IH. by rewrite !w64L2w8L_cons IH catA. qed. -lemma w64L2w8L_take n l: - w64L2w8L (take n l) = take (8*n) (w64L2w8L l). +lemma take_w64L2w8L n l: + take (8*n) (w64L2w8L l) = w64L2w8L (take n l). proof. elim: l n => //= x xs IH n. case: (n <= 0) => E /=; first by rewrite take_le0 /#. -rewrite !w64L2w8L_cons IH take_cat W8u8.Pack.size_to_list. +rewrite !w64L2w8L_cons -IH take_cat W8u8.Pack.size_to_list. by rewrite (:!8*n<8) /#. qed. @@ -393,11 +463,43 @@ qed. lemma w8L2w64LK (l: W8.t list): 8 %| size l => w64L2w8L (w8L2w64L l) = l. -admitted. +proof. +move=> Hsz. +rewrite /w64L2w8L /w8L2w64L -map_comp dvd_chunkfill //. +have : forall (x : W8.t list), + x \in BitEncoding.BitChunking.chunk 8 l => + idfun x = W8u8.to_list (pack8 x). + move=> x Hx; beta. + rewrite W8u8.pack8K // of_listK //. + by apply (BitEncoding.BitChunking.in_chunk_size _ _ _ _ Hx). +rewrite List.eq_in_map => <-. +by rewrite map_id BitEncoding.BitChunking.chunkK // Hsz. +qed. + +lemma w8Lw64LK' l: + w64L2w8L (w8L2w64L l) = chunkfill W8.zero 8 l. +proof. +rewrite /w8L2w64L -chunkfillK //. +by rewrite w8L2w64LK ?chunkfillP // chunkfillK. +qed. + +lemma w64L2w8L_inj: injective w64L2w8L. +proof. +rewrite /w64L2w8L; elim. + by move=> [|y ys]. +move=> x xs IH; elim => //. +move=> y ys IH2. +rewrite !map_cons !flatten_cons. +rewrite eqseq_cat //; beta. +move=> [/W8u8.Pack.to_list_inj E ?]; congr; last by apply IH. +by rewrite -unpack8K E. +qed. -lemma w64L2w8LK (l: W64.t list): - cancel w8L2w64L w64L2w8L. -admitted. +lemma w64L2w8LK: cancel w64L2w8L w8L2w64L. +proof. +move=> k; apply w64L2w8L_inj. +by rewrite w8L2w64LK // size_w64L2w8L dvdz_mulr. +qed. (*******************************************************************************) (* MEMORY OPERATIONS *) @@ -529,30 +631,82 @@ lemma nth_memread mem in_ inlen i: = loadW8 mem (in_ + i)%Int. proof. by move=> Hi; rewrite nth_mkseq. qed. -(* -lemma nth_memread_offset off mem in_ inlen i: +lemma memread0 mem in_: memread mem in_ 0 = [] by done. + +lemma memread1 mem in_: memread mem in_ 1 = [loadW8 mem in_] by done. + +hint simplify memread0, memread1. + +lemma memread_add mem in_ x y: + 0 <= x => 0 <= y => + memread mem in_ (x+y)%Int = memread mem in_ x ++ memread mem (in_ + x) y. +proof. +move=> Hx Hy; rewrite /memread mkseq_add //; congr. +by apply eq_mkseq => z /=; rewrite addzA. +qed. + +lemma memread_addS mem in_ x: + 0 <= x => + memread mem in_ (x+1)%Int = rcons (memread mem in_ x) (loadW8 mem (in_+x)). +proof. by move=> Hx; rewrite memread_add //= cats1. qed. + +lemma take_memread n mem ptr k: + 0 <= n => + take n (memread mem ptr k) = memread mem ptr (min n k). +proof. by move=> Hn; rewrite /memread take_mkseq. qed. + +lemma loadW8_memread mem in_ inlen i: + 0 <= i < inlen => + loadW8 mem (in_ + i)%Int + = nth W8.zero (memread mem in_ inlen) i. +proof. +rewrite /loadW8 /memread => Hi. +by rewrite nth_mkseq. +qed. + +lemma loadW8_memread' mem in_ off inlen i: (off <= i < off + inlen)%Int => - nth W8.zero (memread mem (in_ + off) inlen) (i-off) = - loadW8 mem (in_ + i)%Int. -proof. move=> Hi; rewrite nth_memread /#. qed. + loadW8 mem (in_ + i)%Int + = nth W8.zero (memread mem (in_ + off) inlen) (i-off). +proof. +rewrite /loadW8 /memread => Hi. +by rewrite nth_mkseq /#. +qed. + lemma nth_memread_u64 mem in_ inlen i: 0 <= i => 8*i+8 <= inlen => - loadW64 mem (in_+8*i) - = nth W64.zero (w8L2w64L (memread mem in_ inlen)) i. + loadW64 mem (in_+8*i) = nth W64.zero (w8L2w64L (memread mem in_ inlen)) i. proof. move=> ??; rewrite nth_w8L2w64L. rewrite /loadW64 W8u8.pack8E pack8E; apply W64.init_ext => x Hx /=. -congr; congr; apply W8u8.Pack.init_ext => j Hj /=. -by rewrite nth_mkseq /#. +congr; rewrite W8u8.Pack.initiE 1:/# /= /memread. +by rewrite W8u8.Pack.initiE 1:/# /= nth_mkseq /#. +qed. + + +lemma memread_split off mem a sz: + 0 <= off <= sz => + memread mem a sz = memread mem a off ++ memread mem (a+off) (sz-off). +proof. +move=> Hoff; have ->: sz = off + (sz-off) by ring. +rewrite /memread mkseq_add 1,2:/#; congr. +rewrite (:off + (sz - off) - off = sz-off) 1:/#. +by apply eq_mkseq => i /#. qed. -*) + (** [memread64] reads a list of [n] (full) 64-bit words from memory *) op memread64 (m: global_mem_t) (a: address) (n: int): W64.t list = mkseq (fun i => loadW64 m (a+8*i)) n. +lemma memread64_0 mem in_: memread64 mem in_ 0 = [] by done. + +lemma memread64_1 mem in_: memread64 mem in_ 1 = [loadW64 mem in_] by done. + +hint simplify memread64_0, memread64_1. + lemma size_memread64 mem a sz: 0 <= sz => size (memread64 mem a sz) = sz by rewrite size_mkseq /#. @@ -573,16 +727,6 @@ apply W8u8.Pack.init_ext => j Hj /=. by rewrite nth_mkseq /#. qed. -lemma memread_split off mem a sz: - 0 <= off <= sz => - memread mem a sz = memread mem a off ++ memread mem (a+off) (sz-off). -proof. -move=> Hoff; have ->: sz = off + (sz-off) by ring. -rewrite /memread mkseq_add 1,2:/#; congr. -rewrite (:off + (sz - off) - off = sz-off) 1:/#. -by apply eq_mkseq => i /#. -qed. - lemma memread_split64 mem a sz: 0 <= sz => memread mem a sz @@ -594,45 +738,17 @@ move=> Hsz; rewrite (memread_split (sz %/ 8*8)) 1:/#; congr. by rewrite modzE. qed. - -lemma memread0 mem a: - memread mem a 0 = []. -proof. by rewrite /memread mkseq0. qed. - -hint simplify memread0. - -lemma take_memread n mem ptr k: - 0 <= n => - take n (memread mem ptr k) = memread mem ptr (min n k). -proof. by move=> Hn; rewrite /memread take_mkseq. qed. - -lemma loadW8_memread mem in_ inlen i: - 0 <= i < inlen => - loadW8 mem (in_ + i)%Int - = nth W8.zero (memread mem in_ inlen) i. -proof. -rewrite /loadW8 /memread => Hi. -by rewrite nth_mkseq. -qed. - -lemma loadW8_memread' mem in_ off inlen i: - (off <= i < off + inlen)%Int => - loadW8 mem (in_ + i)%Int - = nth W8.zero (memread mem (in_ + off) inlen) (i-off). +lemma memread64_add mem in_ x y: + 0 <= x => 0 <= y => + memread64 mem in_ (x+y)%Int = memread64 mem in_ x ++ memread64 mem (in_ + 8*x) y. proof. -rewrite /loadW8 /memread => Hi. -by rewrite nth_mkseq /#. +move=> Hx Hy; rewrite /memread64 mkseq_add //; congr. +by apply eq_mkseq => z /=; congr; ring. qed. -lemma nth_memread_u64 mem in_ inlen i: - 0 <= i => 8*i+8 <= inlen => - loadW64 mem (in_+8*i) = nth W64.zero (w8L2w64L (memread mem in_ inlen)) i. -proof. -move=> ??; rewrite nth_w8L2w64L. -rewrite /loadW64 W8u8.pack8E pack8E; apply W64.init_ext => x Hx /=. -(* -congr; rewrite W8u8.Pack.initiE 1:/# W8u8.Pack.get_of_list 1:/# /=. -by rewrite /memread nth_mkseq 1:/#. -*) admit. -qed. +lemma memread64S mem in_ i: + 0 <= i => + memread64 mem in_ (i+1) + = rcons (memread64 mem in_ i) (loadW64 mem (in_ + 8*i)). +proof. by move=> Hi; rewrite memread64_add // memread64_1 cats1. qed. diff --git a/proof/impl/Spec1600.ec b/proof/impl/Spec1600.ec index 2451c5d..26d7517 100644 --- a/proof/impl/Spec1600.ec +++ b/proof/impl/Spec1600.ec @@ -465,6 +465,80 @@ lemma match_state_c (x:block*capacity) st: by move=> ->. + + + + +(* MOVE ELSEWHERE!!! *) + + + +lemma xorstate_w8L_getE st l i: + size l < i => + state_get8 (xorstate_w8L st l) i = (st.[i %/ 8] \bits8 (i %% 8)) `^` nth W8.zero l i. +admitted. + +abbrev state_xor64 (st: state) i x = st.[i <- st.[i] `^` x]. + +lemma xorstate_w64L_rcons st l x: + size l < 25 => + xorstate_w64L st (rcons l x) = state_xor64 (xorstate_w64L st l) (size l) x. +admitted. +lemma xorstate_w64L_rconsE i st l x: + i < 25 => + i = size l => + xorstate_w64L st (rcons l x) = state_xor64 (xorstate_w64L st l) i x. +admitted. + +lemma xorstate_w8L_rcons st l x: + xorstate_w8L st (rcons l x) + = state_xor8 (xorstate_w8L st l) (size l) x. +admitted. + +lemma xorstate_w8L_rconsE i st l x: + i < 200 => + i = size l => + xorstate_w8L st (rcons l x) + = state_xor8 (xorstate_w8L st l) i x. +admitted. + +lemma xorstate_w8L0 st: xorstate_w8L st [] = st. +admitted. +lemma xorstate_w64L0 st: xorstate_w64L st [] = st. +admitted. + +lemma xorstate_w64L2w8L st l: + xorstate_w64L st l = xorstate_w8L st (w64L2w8L l). +admitted. + +lemma xorstate_w8L2w64L st l: + xorstate_w8L st l = xorstate_w64L st (w8L2w64L l). +admitted. + + + +lemma xorstate_w8L_get8_out st l i: + 0 <= i < 200 => + size l <= i => + state_get8 (xorstate_w8L st l) i + = state_get8 st i. +proof. +move=> Hi Hsz. +admit. +qed. + + + + + + + + + + + + + (* MESSAGES and PAYLOADS *) @@ -852,6 +926,12 @@ admit (* by rewrite Array25.size_to_list; smt(rate64_bnds).*). qed. +lemma size_squeezestate64 st: + size (squeezestate64 st) = 25. +admitted. + + + (* [xtrbytes outl w64L] converts at most [outl] bytes from the list of 64bit words [w64L] op xtrbytes (n: int) (b64: W64.t list): W8.t list = diff --git a/proof/impl/keccak_1600_corr.ec b/proof/impl/keccak_1600_corr.ec index 62c2b4b..652d100 100644 --- a/proof/impl/keccak_1600_corr.ec +++ b/proof/impl/keccak_1600_corr.ec @@ -5,6 +5,8 @@ require import Array25 WArray200 EclibExtra JWordList. require import Spec1600 Keccak_1600_ref. + + (* Bounded memory assumption (established by the safety analysis) *) abbrev good_ptr (ptr: W64.t) len = to_uint ptr + len < W64.modulus. @@ -12,222 +14,28 @@ op inv_ptr (in_0 inlen out outlen: W64.t) = good_ptr in_0 (to_uint inlen) /\ good_ptr out (to_uint outlen). -(* -lemma addstate_nil st: - addstate st [] = st. -proof. by apply Array25.ext_eq => i Hi; rewrite /addstate initiE. qed. - -lemma addstate_get st l i: - 0 <= i < 25 => - (addstate st l).[i] = st.[i] `^` nth W64.zero l i. -proof. by move=> Hi; rewrite /addstate initiE. qed. -lemma addstate_get' st l i: - size l <= i => - (addstate st l).[i] = st.[i]. +(* lemmata... *) +lemma to_uintS_lt (x y:W64.t) : + to_uint x < to_uint y => + to_uint (x + W64.one) = to_uint x + 1. proof. -move=> Hsz. -case: (0 <= i < 25) => E. - by rewrite addstate_get // nth_out 1:/# W64.xorw0. -by rewrite !Array25.get_out. +move=> H; rewrite to_uintD_small of_uintK modz_small //. +move: (W64.to_uint_cmp y); smt(). qed. -lemma addstate_rcons st xs x: - addstate st (rcons xs x) - = (addstate st xs).[size xs <- st.[size xs] `^` x]. -proof. -apply Array25.ext_eq => i Hi. -rewrite Array25.get_set_if !addstate_get //. -case: (i = size xs) => E /=. - by rewrite -!E Hi /= nth_rcons -E ltzz. -rewrite nth_rcons E /=. -case: (i < size xs) => //?. -by rewrite nth_out /#. -qed. +(* ...for readability *) +abbrev upd8 (f: W8.t -> W8.t -> W8.t) (st:state) (i:int) (x:W8.t) = + state25 (set8 (state200 st) i (f (get8 (state200 st) i) x)). -op u64xoru8 (w: W64.t) i (b: W8.t) = - W8u8.pack8_t - (W8u8.Pack.init - (fun (j:int) => if j=i then (w \bits8 j) `^` b else w \bits8 j)). - -op state_xor_u8 (st: state) i (b: W8.t): state = - Array25.init - (WArray200.WArray200.get64 - (WArray200.WArray200.set8 - (WArray200.WArray200.init64 (Array25."_.[_]" st)) - i - (WArray200.WArray200.get8 - (WArray200.WArray200.init64 ("_.[_]" st)) i `^` b))). - -lemma state_xor_u8P st i b: +lemma upd8_state_xor8 i st l x: + i = size l => 0 <= i < 200 => - state_xor_u8 st i b - = st.[(i %/ 8) <- u64xoru8 st.[i %/ 8] (i %% 8) b]. -proof. -move=> Hi. -rewrite /state_xor_u8; apply Array25.ext_eq => k Hk. -rewrite Array25.initiE // WArray200.WArray200.get64E /=. -rewrite Array25.get_set_if; case: (k = i %/ 8) => /= E; last first. - apply (eq_trans _ (pack8_t (unpack8 st.[k]))); last by apply unpack8K. - congr; apply W8u8.Pack.init_ext => x Hx /=. - rewrite WArray200.WArray200.get_set8E //. - rewrite (: ! 8 * k + x = i) /=. smt. - rewrite /WArray200.WArray200.get8. - rewrite /WArray200.WArray200.init64 WArray200.WArray200.initiE 1:/# /=. - have ->: (8 * k + x) %/ 8 = k. smt. - have ->: (8 * k + x) %% 8 = x. smt. - done. -rewrite (: 0 <= i %/ 8 < 25) 1:/# /= /u64xoru8; congr. -apply W8u8.Pack.init_ext => x Hx /=. -rewrite WArray200.WArray200.get_set8E 1:/#. -case: (8*k+x = i) => E2. - have ->/=: x = i%%8 . smt. - rewrite /WArray200.WArray200.get8; congr. - by rewrite /WArray200.WArray200.init64 WArray200.WArray200.initiE 1:/#. -have ->/=: !x = i%%8. smt. -rewrite /WArray200.WArray200.get8. -rewrite /WArray200.WArray200.init64 WArray200.WArray200.initiE 1:/# /=. -have ->: (8 * k + x) %/ 8 = i %/ 8. smt. -have ->: (8 * k + x) %% 8 = x. smt. -done. -qed. - -lemma state_xor_u8E st j b: - Array25.init - (WArray200.WArray200.get64 - (WArray200.WArray200.set8 - (WArray200.WArray200.init64 (Array25."_.[_]" st)) - j - (WArray200.WArray200.get8 (WArray200.WArray200.init64 ("_.[_]" st)) j `^` b))) - = state_xor_u8 st j b. -proof. by rewrite /state_xor_u8. qed. - - -lemma final_block64_lastu64 trailb m: - final_block64 trailb m = - rcons (w8L2w64L (take (size m %/ 8 * 8) m)) - (W8u8.pack8 (rcons (drop (size m %/ 8 * 8) m) trailb)). -proof. -rewrite /final_block64 -{1}(cat_take_drop (size m %/ 8 * 8) m). -admit. -qed. - -lemma addstate_rcons_byte (st:state) i b m: - size m < 8 => - 0 <= i < 25 => - st.[i <- st.[i] `^` W8u8.pack8 (rcons m b)] - = state_xor_u8 st.[i <- st.[i] `^` W8u8.pack8 m] - (8*i + size m) b. -proof. -move=> Hsz Hi; apply Array25.ext_eq => k Hk. -rewrite state_xor_u8P. smt. -rewrite !Array25.get_setE //. smt. -case: (k=i) => E /=. - rewrite !E. clear k Hk E. - have ->/=: (8 * i + size m) %/ 8 = i. smt. - rewrite /u64xoru8 -{1}(W8u8.unpack8K st.[i]) xorb8u8E; congr. - rewrite W8u8.Pack.map2E; apply W8u8.Pack.init_ext => j Hj /=. - case: (j = size m) => E; last first. - have ->/=: ! j = (8 * i + size m) %% 8. smt. - have ->: ((of_list (rcons m b)))%W8u8.Pack.[j] = pack8 m \bits8 j. - rewrite W8u8.Pack.of_listE W8u8.Pack.initiE //= W8u8.pack8bE //=. - rewrite W8u8.Pack.get_of_list //. - smt. - congr. smt. - have ->/=: j = (8 * i + size m) %% 8. smt. - have ->: (8 * i + size m) %% 8 = size m. smt. - have ->: (pack8 m \bits8 size m) = W8.zero. - rewrite W8u8.Pack.of_listE W8u8.pack8bE //= 1:/#. - rewrite W8u8.Pack.initiE 1:/#. smt. - have ->: ((of_list (rcons m b)))%W8u8.Pack.[size m] = b. - rewrite W8u8.Pack.of_listE W8u8.Pack.initiE 1:/#. - smt. - by rewrite /unpack8 initiE 1:/#. -have ->/=: ! k = (8 * i + size m) %/ 8. smt. -done. -qed. - -lemma addfinalbitE st: - addfinalbit st = state_xor_u8 st (rate8-1) (W8.of_int 128). -proof. -rewrite /addfinalbit; apply Array25.ext_eq => i Hi. -rewrite Array25.get_setE; first smt(rate64_bnds). -rewrite state_xor_u8P; first smt. -rewrite (: (rate8 - 1) %/ 8 = rate64-1). smt. -rewrite (: (rate8 - 1) %% 8 = 7). smt. -rewrite Array25.get_setE; first smt(rate64_bnds). -case: (i = rate64-1) => // E. -rewrite -(W8u8.unpack8K (st.[rate64 - 1]`^` (of_int (2 ^ 63))%W64)) /u64xoru8. congr. -apply W8u8.Pack.init_ext => x Hx. -rewrite (: 2^63 = 1*2^63) 1:// -W64.shlMP //=. -rewrite (: 128 = 1*2^7) 1:// -W8.shlMP //=. -have ->: (W64.one `<<<` 63 \bits8 x) - = if x=7 then (W8.one `<<<` 7) else W8.zero. - case: (x=7) => E2. - rewrite W8u8.bits8E /=. - apply W8.all_eqP. rewrite !E2 /all_eq /=. - do 7! rewrite W64.get_out // W8.get_out //=. - smt. -rewrite W8u8.bits8E /=. - apply W8.all_eqP. - - -have : x \in iota_ 0 7 by smt(). -move: {Hx E2} x; rewrite -List.allP /all_eq /= !W64.get_out //=. - -by case: (x=7) => //. -qed. - - -lemma loadW64_take_block64 mem in_ i: - 0 <= i < rate64 => - loadW64 mem (in_ + 8 * i) = - nth W64.zero (take_block64 (memread mem in_ rate8)).`1 i. -proof. -rewrite /loadW64 /take_block64 /= => Hi. -rewrite take_oversize ?size_memread 1..2:/#. -admit. -qed. - -lemma nth_squeezestate st i: - 0 <= i < rate64 => - nth W64.zero (squeezestate st) i = st.[i]. -proof. -move=> Hi; rewrite /squeezestate nth_take; first 2 smt(rate64_bnds). -rewrite -(nth_inside witness). - rewrite Array25.size_to_list; first smt(rate64_bnds). -by apply Array25.get_to_list. -qed. - -lemma w64L2w8L_squeezestate st: - w64L2w8L (squeezestate st) - = take rate8 (WArray200.WArray200.to_list (WArray200.WArray200.init64 (("_.[_]" st)))). -proof. -have Hsz1:= Array25.size_to_list st. -have Hsz2:= WArray200.WArray200.size_to_list (WArray200.WArray200.init64 (("_.[_]" st))). -rewrite /squeezestate w64L2w8L_take; congr. -apply (eq_from_nth W8.zero). - by rewrite size_w64L2w8L /#. -move=> i; rewrite size_w64L2w8L Hsz1 => ?. -rewrite WArray200.WArray200.get_to_list. -have ->: (w64L2w8L (to_list st)).[i] = nth W8.zero (W8u8.to_list st.[i %/ 8]) (i %% 8). - rewrite nth_w64L2w8L ?Hsz1 //; congr. - by rewrite -Array25.get_to_list (nth_inside witness W64.zero) 1:/#. -rewrite /WArray200.WArray200.init64 WArray200.WArray200.initiE //; beta. -smt. -qed. - -lemma state_get8E (st:state) i: - 0 <= i < rate8 => - WArray200.WArray200.get8 (WArray200.WArray200.init64 ("_.[_]" st)) i - = nth W8.zero (w64L2w8L (squeezestate st)) i. -proof. -move=> Hi; rewrite w64L2w8L_squeezestate /WArray200.WArray200.get8. -by rewrite nth_take 1,2:/# WArray200.WArray200.get_to_list. -qed. - -*) - +(* state25 (set8 (state200 (xorstate_w8L st l)) i + (get8 (state200 (xorstate_w8L st l)) i `^` x)) *) + upd8 W8.(`^`) (xorstate_w8L st l) i x + = state_xor8 (xorstate_w8L st l) i x. +proof. by move=> Hsz Hi; rewrite /get8 xorstate_w8L_get8_out // /#. qed. (* SPECIFICATION OF LEAF-FUNCTIONS *) @@ -242,7 +50,7 @@ while (0 <= i <= 25 /\ forall k, 0 <= k < i => state.[k]=W64.zero). by rewrite set_eqiE /#. skip; progress; first smt(). move: H2; have ->: i0 = 25 by smt(). -by move=> {H H0 H1} H; apply Array25.ext_eq => ??; rewrite (H x) // /st0 createiE. +by move=> H2; apply Array25.ext_eq => ??; rewrite (H2 x) // /st0 createiE. qed. lemma st0_spec_ll: islossless M.st0. @@ -257,80 +65,6 @@ lemma st0_spec: proof. by conseq st0_spec_ll st0_spec_h. qed. -lemma to_uintS_lt (x y:W64.t) : - to_uint x < to_uint y => - to_uint (x + W64.one) = to_uint x + 1. -admitted. - -lemma xorstate_w8L_getE st l i: - size l < i => - state_get8 (xorstate_w8L st l) i = (st.[i %/ 8] \bits8 (i %% 8)) `^` nth W8.zero l i. -admitted. -abbrev state_xor64 (st: state) i x = st.[i <- st.[i] `^` x]. -lemma xorstate_w64L_rcons st l x: - size l < 25 => - xorstate_w64L st (rcons l x) = state_xor64 (xorstate_w64L st l) (size l) x. -admitted. -lemma xorstate_w64L_rconsE i st l x: - i < 25 => - i = size l => - xorstate_w64L st (rcons l x) = state_xor64 (xorstate_w64L st l) i x. -admitted. - -lemma memread64S mem in_ i: - memread64 mem in_ (i+1) - = rcons (memread64 mem in_ i) (loadW64 mem (in_ + 8*i)). -admitted. - -lemma xorstate_w64L_step st mem in_ i: - xorstate_w64L st (memread64 mem in_ (i+1)) - = state_xor64 (xorstate_w64L st (memread64 mem in_ i)) - i (loadW64 mem (in_+8*i)). -admitted. - -abbrev upd8 (f: W8.t -> W8.t -> W8.t) (st:state) (i:int) (x:W8.t) = - state25 (set8 (state200 st) i (f (get8 (state200 st) i) x)). - -lemma xorstate_w8L_rcons st l x: - xorstate_w8L st (rcons l x) - = state_xor8 (xorstate_w8L st l) (size l) x. -admitted. - -lemma xorstate_w8L_rconsE i st l x: - i < 200 => - i = size l => - xorstate_w8L st (rcons l x) - = state_xor8 (xorstate_w8L st l) i x. -admitted. - -lemma memreadS mem in_ sz: - memread mem in_ (sz + 1) = rcons (memread mem in_ sz) (loadW8 mem (in_+sz)). -admitted. - -lemma upd8_state_xor8 st i l x: - upd8 W8.(`^`) (xorstate_w8L st l) i x - = state_xor8 (xorstate_w8L st l) (size l) x. -admitted. - -lemma xorstate_w8L0 st: xorstate_w8L st [] = st. -admitted. -lemma xorstate_w64L0 st: xorstate_w64L st [] = st. -admitted. - -print w8L2w64L. -print w64L2w8L. -lemma xorstate_w64L2w8L st l: - xorstate_w64L st l = xorstate_w8L st (w64L2w8L l). -admitted. - -lemma xorstate_w8L2w64L st l: - xorstate_w8L st l = xorstate_w64L st (w8L2w64L l). -admitted. - -lemma w8L2w64L2state l: - w8L2state l = w64L2state (w8L2w64L l). -admitted. - lemma add_full_block_spec_h st in_ inlen_ r8_: hoare [ M.add_full_block: state = st @@ -398,6 +132,7 @@ proof. by conseq add_full_block_spec_ll (add_full_block_spec_h st in_ inlen_ r8_). qed. + lemma add_final_block_spec_h st (in_ inlen_: W64.t) trail_byte_: hoare [ M.add_final_block: state = st @@ -425,8 +160,9 @@ seq 4: (to_uint i = to_uint inlen_ %/ 8 /\ state = xorstate_w64L st (memread64 Glob.mem (to_uint in_) (to_uint i))). wp; skip; rewrite !ultE; progress. by rewrite (to_uintS_lt _ _ H4) /#. - rewrite (to_uintS_lt _ _ H4) xorstate_w64L_step. - congr; congr; congr. + rewrite (to_uintS_lt _ _ H4) memread64S xorstate_w64L_rcons. + by rewrite size_memread64 /#. + rewrite size_memread64 1:/#; congr; congr; congr. by rewrite to_uintD to_uintM of_uintK !modz_small //= /#. wp; skip; progress. + by rewrite to_uint_shr /#. @@ -452,7 +188,7 @@ seq 2: (#[/1,4:-1]pre /\ + by rewrite (to_uintS_lt _ _ H6) /#. + rewrite (to_uintS_lt _ _ H6). rewrite memreadS xorstate_w8L_rcons size_memread 1:/#. - rewrite upd8_state_xor8 size_memread 1:/#. + rewrite upd8_state_xor8 ?size_memread 1..3:/#. by rewrite to_uintD_small 1:/#. wp; skip => ?[?]; progress. + by rewrite to_uint_shl of_uintK (modz_small 3) //= modz_small /#. @@ -467,10 +203,8 @@ elim*=> st''. seq 1: (#[/:-1]pre /\ state = state_xor_u8 st'' (to_uint inlen_) trail_byte_). wp; skip => ?[?[[?]]]; progress. - rewrite /state_xor_u8 upd8_state_xor8 size_memread 1:/#. - rewrite H -(xorstate_w8L_rconsE (to_uint inlen{hr})) 1:/#. - by rewrite size_memread /#. - done. + rewrite /state_xor_u8 upd8_state_xor8 ?size_memread 1..3:/#. + by rewrite H H4. wp; skip => ?[[?[?]]] |> *. rewrite /addfinalbit /absorb_final H /state_xor_u8 /state_xor8. have ->: (to_uint (r8{hr} - W64.one)) = rate8-1. @@ -480,7 +214,6 @@ rewrite cats1 -(xorstate_w8L_rconsE) 1:/#. smt(). qed. - lemma add_final_block_spec_ll: islossless M.add_final_block. proof. islossless. @@ -517,10 +250,6 @@ by conseq add_final_block_spec_ll (add_final_block_spec_h st in_ inlen_ trail_by qed. -lemma size_squeezestate64 st: - size (squeezestate64 st) = 25. -admitted. - lemma xtr_full_block_spec_h mem st out_ outlen_: hoare [ M.xtr_full_block: Glob.mem = mem @@ -592,10 +321,6 @@ proof. by conseq xtr_full_block_spec_ll (xtr_full_block_spec_h mem st out_ outlen_). qed. -lemma take_w64L2w8L n l: - take (8*n) (w64L2w8L l) = w64L2w8L (take n l). -admitted. - lemma xtr_bytes_spec_h mem st out_ outlen_: hoare [ M.xtr_bytes: @@ -682,7 +407,6 @@ lemma xtr_bytes_spec mem st out_ outlen_: proof. by conseq xtr_bytes_spec_ll (xtr_bytes_spec_h mem st out_ outlen_). qed. - (* MAIN RESULT *) section. From 75f0956b33eeebdfea80abed4b32d6c7e5497ef9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jos=C3=A9=20Bacelar=20Almeida?= Date: Mon, 20 May 2019 02:44:27 +0100 Subject: [PATCH 432/525] (re)finished main proof --- proof/impl/JWordList.ec | 26 + proof/impl/Spec1600.ec | 1113 +++++++++++++++------------------------ 2 files changed, 446 insertions(+), 693 deletions(-) diff --git a/proof/impl/JWordList.ec b/proof/impl/JWordList.ec index 000c4c7..399c60a 100644 --- a/proof/impl/JWordList.ec +++ b/proof/impl/JWordList.ec @@ -127,6 +127,32 @@ move=> k; apply w8L2bits_inj. by rewrite bits2w8LK // size_w8L2bits dvdz_mulr. qed. +lemma w8L2bits_xor l1 l2: + w8L2bits (JUtils.map2 W8.(`^`) l1 l2) + = map2 Bool.(^^) (w8L2bits l1) (w8L2bits l2). +proof. +elim: l1 l2 => //=. + by move=> [|y ys]; rewrite w8L2bits_nil // w8L2bits_cons. +move=> x xs IH1; elim => //=. + rewrite map2C; first by move=> b1 b2; ring. + by rewrite w8L2bits_cons. +move=> y ys IH2. +rewrite !w8L2bits_cons map2_cat. + by rewrite !size_w2bits. +by rewrite IH1. +qed. + +lemma w8L2bits_nseq0 n: + 0 <= n => + w8L2bits (nseq n W8.zero) = nseq (8*n) false. +proof. +elim/natind: n => /=. + by move=> n Hn1 Hn2; rewrite !nseq0_le 1,2:/#. +move=> n Hn IH H; rewrite nseqS // w8L2bits_cons IH //. +by rewrite addzC mulzDr mulz1 nseq_add /#. +qed. + + (*******************************************************************************) (* W64 lists *) (*******************************************************************************) diff --git a/proof/impl/Spec1600.ec b/proof/impl/Spec1600.ec index 26d7517..cc27f2b 100644 --- a/proof/impl/Spec1600.ec +++ b/proof/impl/Spec1600.ec @@ -3,6 +3,28 @@ from Jasmin require import JArray JMemory JModel JWord JWord_array JUtils. require import EclibExtra JWordList. + + +(* MOVE TO EcLib *) + +lemma take_take n1 n2 (l: 'a list): + take n1 (take n2 l) = take (min n1 n2) l. +proof. elim: l n1 n2 => //= x xs IH n1 n2; smt(). qed. + +lemma nth_nseq_dflt (d:'s) n i: nth d (nseq n d) i = d. +proof. +case: (0 <= i < n) => E; first by rewrite nth_nseq. +rewrite nth_out // size_nseq /#. +qed. + +(* END EcLib *) + + + + + + + op rate :int. axiom rate_bnds: 0 < rate < 1600. axiom rate_w64: 64 %| rate. @@ -135,219 +157,111 @@ qed. require import Array25 WArray200. (* State is defined as an array of 25 64-bit words. But it can also be - viewed as an array of 200 byes (which is the prefered view in this + viewed as an array of 200 bytes (which is the prefered view in this specification). *) type state = W64.t Array25.t. abbrev state200 (st: state) : WArray200.t = WArray200.init64 ("_.[_]" st). abbrev state25 (st200: WArray200.t) : state = Array25.init (WArray200.get64 st200). -(* conversion between different list representations for state *) -abbrev state2w8L (st: state): W8.t list = to_list (state200 st). -op w8L2state (l: W8.t list): state = state25 (WArray200.of_list l). -op state2bits (st: state): bool list = w8L2bits (state2w8L st). - -abbrev state2w64L (st: state): W64.t list = to_list st. -op w64L2state (l: W64.t list): state = Array25.of_list W64.zero l. - -(* we can go back and forward on the various representations *) -lemma w8L2w64L2state l: - w8L2state l = w64L2state (w8L2w64L l). -proof. -admit(* -apply Array25.ext_eq => i Hi. -rewrite initiE // state25E get64E Array25.get_of_list //. -rewrite nth_w8L2w64L; congr. -apply W8u8.Pack.init_ext=> /=; smt. -*). -qed. - -lemma w64L2w8L2state l: - w64L2state l = w8L2state (w64L2w8L l). -proof. -admit(* -apply Array25.ext_eq => i Hi. -rewrite Array25.get_of_list //. -rewrite Array25.initE Hi /= get64E /=. -rewrite -(W8u8.Pack.init_ext ((\bits8) (nth W64.zero l i))) /=. -move=> j Hj. -rewrite WArray200.get_of_list 1:/# nth_w64L2w8L. -smt. -by rewrite (W8u8.unpack8K (nth W64.zero l i)). -*). -qed. - -lemma state2w8L2w64L st: - state2w8L st = w64L2w8L (state2w64L st). -admitted. - - (* set/get individual bytes *) -op u64_set8 (w: W64.t) i (b: W8.t) : W64.t = - W8u8.pack8_t (W8u8.unpack8 w).[i <- b]. -abbrev state_get8 (st: state) i = - (state200 st).[i]. -abbrev state_set8 (st: state) i x = - state25 (state200 st).[i <- x]. - +abbrev w64_set8 (w: W64.t) i (b: W8.t) = W8u8.pack8_t (W8u8.unpack8 w).[i <- b]. +abbrev state_get8 (st: state) i = (state200 st).[i]. +abbrev state_set8 (st: state) i x = state25 (state200 st).[i <- x]. lemma state_get8E st i: 0 <= i < 200 => state_get8 st i = st.[i %/ 8] \bits8 (i %% 8). -proof. admitted. (*by move=> Hi; rewrite initE Hi. qed.*) +proof. by move=> Hi; rewrite initE Hi. qed. -lemma state_get8P st i: - state_get8 st i = (state2w8L st).[i]. -proof. by rewrite /state2w8L get_to_list. qed. - - - lemma state_set8E st i x: 0 <= i < 200 => state_set8 st i x - = st.[i %/ 8 <- u64_set8 st.[i %/ 8] (i %% 8) x]. + = st.[i %/ 8 <- w64_set8 st.[i %/ 8] (i %% 8) x]. proof. -admit(* move=> Hi; apply Array25.ext_eq => j Hj. rewrite initiE // get64E get_set_if. rewrite (: 0 <= i %/ 8 < 25 ) 1:/# /=. rewrite -(W8u8.Pack.init_ext - (fun (k:int) => - if j=i%/8 then u64_set8 st.[i%/8] (i%%8) x \bits8 k - else st.[j] \bits8 k)). + (fun (k:int) => if j=i%/8 then w64_set8 st.[i%/8] (i%%8) x \bits8 k + else st.[j] \bits8 k)). move=> k Hk /=. - admit. + rewrite get_setE // state_get8E 1:/#. + case: (8 * j + k = i) => E /=. + rewrite (:j=i%/8) 1:/# /= pack8bE 1:/#. + by rewrite get_setE 1:/# (:i%%8=k) 1:/#. + case: (j=i%/8) => E2. + rewrite -!E2 /w64_set8 /=. + admit (* rewrite (W8u8.unpack8K st.[j]). W8u8.get_setE.*). + by congr; [congr|]; smt(). case: (j=i%/8) => E. - admit. + admit. admit. -*). qed. -(* We treat the sponge permutation as an abstract function. It acts - as a bridge between the idealized permutation used in the security - proof (RO), and the concrete Keccak-F[1600] instantiation adopted - in the implementation. *) -op sponge_permutation : state -> state. +lemma state200K: cancel state200 state25. +proof. +move=> x; apply Array25.ext_eq => i Hi. +rewrite initiE // get64E /= -(W8u8.unpack8K x.[i]); congr. +apply W8u8.Pack.init_ext => k Hk /=. +by rewrite state_get8E 1:/#; congr; [congr|]; smt(). +qed. -(* Initial state *) -op st0 : state = Array25.create W64.zero. +lemma state25K: cancel state25 state200. +proof. +move=> x; apply WArray200.ext_eq => i Hi. +rewrite state_get8E //. +rewrite initiE 1:/# get64E pack8bE 1:/#. +by rewrite initiE 1:/# /=; congr; smt(). +qed. +(* conversion between different list representations for state *) +abbrev state2w8L (st: state): W8.t list = to_list (state200 st). +op state2bits (st: state): bool list = w8L2bits (state2w8L st). +op w8L2state (l: W8.t list): state = state25 (WArray200.of_list l). lemma size_state2bits (st: state): size (state2bits st) = 1600. proof. by rewrite /state2bits size_w8L2bits size_to_list. qed. -(* -op bits2state (bs: bool list) : state = - of_list W64.zero (bits2w64L bs). - -lemma bits2stateK bs: - size bs = 1600 => state2bits (bits2state bs) = bs. -proof. -move=> Hsz. -rewrite /state2bits /bits2state Array25.of_listK. - by rewrite size_bits2w64L Hsz. -by rewrite bits2w64LK ?Hsz. -qed. - -lemma state2bits_inj: injective state2bits. -proof. -rewrite /state2bits => st1 st2. -by move/w64L2bits_inj => /Array25.to_list_inj E. -qed. +abbrev state2w64L (st: state): W64.t list = to_list st. +op w64L2state (l: W64.t list): state = Array25.of_list W64.zero l. -lemma state2bitsK: cancel state2bits bits2state. +(* we can go back and forward on the various representations *) +lemma w8L2w64L2state l: + w8L2state l = w64L2state (w8L2w64L l). proof. -move=> st; apply state2bits_inj. -by rewrite bits2stateK // size_state2bits. +apply Array25.ext_eq => i Hi. +rewrite initiE // get64E Array25.get_of_list //. +rewrite nth_w8L2w64L; congr. +apply W8u8.Pack.init_ext=> /= x Hx. +by rewrite get_of_list /#. qed. -*) -op xorstate (st1 st2: state) : state = - Array25.map2 W64.(`^`) st1 st2. - -abbrev xorstate_w8L (st: state) (l: W8.t list) : state = - xorstate st (w8L2state l). -abbrev state_xor8 (st: state) i x = - state25 (state200 st).[i <- (state200 st).[i] `^` x]. -abbrev xorstate_w64L (st: state) (l: W64.t list) : state = xorstate st (w64L2state l). -(* -op u64_xor_u8 (w: W64.t) i (b: W8.t) = W8u8.pack8_t (W8u8.unpack8 w).[i <- b]. -*) - -op state_xor_u8 (st: state) i (b: W8.t) : state = state25 (state200 st).[i <- (state200 st).[i] `^` b]. - -lemma xorstate_getE st1 st2 i: - 0 <= i < 25 => - (xorstate st1 st2).[i] = st1.[i] `^` st2.[i]. -proof. by move=> Hi; rewrite map2iE. qed. - -lemma xorstate_w64L_getE st l i: - 0 <= i < 25 => - (xorstate_w64L st l).[i] = st.[i] `^` nth W64.zero l i. -admitted. - -lemma xorstate_w64L_get_out st l i: - size l < i => - (xorstate_w64L st l).[i] = st.[i]. -admitted. - -lemma xorstate_w8L_get8E st l i: - 0 <= i < 200 => - state_get8 (xorstate_w8L st l) i - = (st.[i %/ 8] \bits8 (i %% 8)) `^` nth W8.zero l i. +lemma w64L2w8L2state l: + w64L2state l = w8L2state (w64L2w8L l). proof. -admit. +apply Array25.ext_eq => i Hi. +rewrite Array25.get_of_list //. +rewrite Array25.initE Hi /= get64E /=. +rewrite -(W8u8.Pack.init_ext ((\bits8) (nth W64.zero l i))) /=. +move=> j Hj; rewrite WArray200.get_of_list 1:/# nth_w64L2w8L; congr. ++ congr; smt(). ++ smt(). ++ by rewrite (W8u8.unpack8K (nth W64.zero l i)). qed. -(* -lemma xorstate_w8L_getE st l i: - size l < i => - state_get8 (xorstate_w8L st l) i = (st.[i %/ 8] \bits8 (i %% 8)) `^` nth W8.zero l i. -admitted. -*) -(* -lemma xorstate_w64L_rcons st l x: - size l < 25 => - xorstate_w64L st (rcons l x) = st.[size l <- st.[size l] `^` x]. -admitted. -*) -(* -lemma xorstate_w8L_rcons st l x: - size l < 200 => - xorstate_w8L st (rcons l x) = st.[size l %/ 8 <- u64_xor_u8 st.[size l %/ 8] (size l %% 8) x]. -admitted. -*) -(* -lemma xorstate_w64L2w8L st l: - xorstate_w8L st (w64L2w8L l) = xorstate_w64L st l. -admitted. -lemma xorstate_w8L2w64L st l: - xorstate_w64L st (w8L2w64L l) = xorstate_w8L st l. -admitted. -*) +lemma state2w8L2w64L st: + state2w8L st = w64L2w8L (state2w64L st). +proof. by rewrite /init64 /w64L2w8L /flatten /Array25.to_list /mkseq. qed. -lemma nth_nseq_dflt (d:'s) n i: nth d (nseq n d) i = d. -admitted. +lemma state2w64L2w8L st: + state2w64L st = w8L2w64L (state2w8L st). +proof. by rewrite state2w8L2w64L w64L2w8LK. qed. -lemma to_list_xorstate_w8L st l: - state2w8L (xorstate_w8L st l) - = map2 W8.(`^`) (state2w8L st) (l++nseq (200-size l) W8.zero). -proof. -admit(* -apply (eq_from_nth W8.zero). - rewrite size_map2 !size_to_list min_lel //. - rewrite size_cat size_nseq; smt(size_ge0). -rewrite size_to_list => i Hi. -rewrite WArray200.get_to_list (nth_map2 W8.zero W8.zero). - rewrite size_to_list size_cat size_nseq; smt(size_ge0). -rewrite xorstate_w8L_get8E 1://; congr. - rewrite -state_get8E //= initE Hi /=. admit. -case: (i < size l) => E; first by rewrite nth_cat E. -rewrite nth_out 1:/# nth_cat. -by rewrite (:! i < size l) 1:/# /= nth_nseq_dflt. -*). -qed. +lemma state_get8P st i: + state_get8 st i = (state2w8L st).[i]. +proof. by rewrite /state2w8L get_to_list. qed. @@ -367,11 +281,6 @@ proof. by rewrite /rate8 /= -mulzA rate64P. qed. lemma rate8_bnds: 0 < rate8 < 200. proof. move: rate_bnds; rewrite -rate8P /#. qed. -op capacity64 = 25-rate64. -lemma capacity64P: 64*capacity64 = c. -proof. by rewrite /capacity64 mulzC Ring.IntID.mulrBl /= mulzC rate64P. qed. - - (* project state into block+capacity *) op state_r (st: state) : block = @@ -380,58 +289,26 @@ op state_r (st: state) : block = op w8L2block (l: W8.t list) : block = mkblock (w8L2bits (take rate8 l ++ nseq (rate8-size l) W8.zero)). -(* -op block2w8L (b: block) : W8.t list = bits2w8L (ofblock b). - -lemma block2w64LP st: - block2w64L (state_r st) = take rate64 (to_list st). -proof. -rewrite /block2w64L /state_r ofblockK. - rewrite size_take ?ge0_r size_state2bits; smt(rate_bnds). -by rewrite /state2bits -rate64P take_w64L2bits w64L2bitsK. -qed. -*) op state_c (st: state) : capacity = mkcapacity (drop r (state2bits st)). -(* -op capacity2w8L (c: capacity) : W64.t list = bits2w64L (ofcapacity c). -lemma capacity2w64LP st: - capacity2w64L (state_c st) = drop rate64 (to_list st). -proof. -rewrite /capacity2w64L /state_c ofcapacityK. - rewrite size_drop ?ge0_r size_state2bits; smt(rate_bnds). -by rewrite /state2bits -rate64P drop_w64L2bits w64L2bitsK. -qed. -lemma state_splitP st: - st = Array25.of_list W64.zero - (block2w64L (state_r st) ++ capacity2w64L (state_c st)). -proof. -by rewrite block2w64LP capacity2w64LP cat_take_drop to_listK. -qed. -*) + +(* Initial state *) +op st0 : state = Array25.create W64.zero. lemma st0E: st0 = state25 (WArray200.create W8.zero). proof. -admit(* apply Array25.ext_eq => i Hi. rewrite /st0 createE !initiE // get64E; beta. rewrite -(W8u8.unpack8K W64.zero); congr. apply W8u8.Pack.init_ext => k Hk; beta. by rewrite WArray200.initiE 1:/# /= W8u8.get_zero. -*). qed. -lemma state200K: cancel state200 state25. -admitted. -lemma state25K: cancel state25 state200. -admitted. - - lemma state2bits0: state2bits st0 = nseq 1600 false. proof. rewrite st0E /state2bits /state2w8L state25K. @@ -453,80 +330,151 @@ qed. lemma st0_c: state_c st0 = c0. proof. rewrite /state_c c0P state2bits0 drop_nseq; smt(rate_bnds). qed. -(* [match_state] relates the bit-level and word-level state representations *) -op match_state x st = x = (state_r st, state_c st). -lemma match_state_r (x:block*capacity) st: - match_state x st => x.`1 = state_r st -by move=> ->. - -lemma match_state_c (x:block*capacity) st: - match_state x st => x.`2 = state_c st -by move=> ->. +(* state addition *) +op addstate (st1 st2: state) : state = + Array25.map2 W64.(`^`) st1 st2. +abbrev addstate8 (st: state) (l: W8.t list) : state = addstate st (w8L2state l). +abbrev state_xor8 (st: state) i x = state_set8 st i (state_get8 st i `^` x). +abbrev addstate64 (st: state) (l: W64.t list) : state = addstate st (w64L2state l). +lemma addstate_getE st1 st2 i: + 0 <= i < 25 => + (addstate st1 st2).[i] = st1.[i] `^` st2.[i]. +proof. by move=> Hi; rewrite map2iE. qed. -(* MOVE ELSEWHERE!!! *) +lemma addstate64_getE st l i: + 0 <= i < 25 => + (addstate64 st l).[i] = st.[i] `^` nth W64.zero l i. +proof. +by move=> Hi; rewrite /addstate map2iE // (Array25.get_of_list W64.zero). +qed. +lemma addstate64_getE_out st l i: + size l < i => + (addstate64 st l).[i] = st.[i]. +proof. +move=> Hsz; case: (0 <= i < 25) => E. + by rewrite addstate64_getE // nth_out /#. +by rewrite !get_out. +qed. +lemma addstate8_get8E st l i: + 0 <= i < 200 => + state_get8 (addstate8 st l) i + = (st.[i %/ 8] \bits8 (i %% 8)) `^` nth W8.zero l i. +proof. +admit. +qed. -lemma xorstate_w8L_getE st l i: +lemma addstate8_get8E_out st l i: size l < i => - state_get8 (xorstate_w8L st l) i = (st.[i %/ 8] \bits8 (i %% 8)) `^` nth W8.zero l i. -admitted. + state_get8 (addstate8 st l) i = state_get8 st i. +proof. +move=> Hsz; case: (0 <= i < 200) => E. + by rewrite addstate8_get8E // nth_out 1:/# state_get8E. +by rewrite !get_out. +qed. -abbrev state_xor64 (st: state) i x = st.[i <- st.[i] `^` x]. +lemma addstate8_rcons st l x: + size l < 200 => + addstate8 st (rcons l x) = state_set8 (addstate8 st l) (size l) x. +proof. +admit. +qed. -lemma xorstate_w64L_rcons st l x: - size l < 25 => - xorstate_w64L st (rcons l x) = state_xor64 (xorstate_w64L st l) (size l) x. -admitted. -lemma xorstate_w64L_rconsE i st l x: - i < 25 => +lemma addstate8_rconsE i st l x: i = size l => - xorstate_w64L st (rcons l x) = state_xor64 (xorstate_w64L st l) i x. -admitted. + i < 200 => + addstate8 st (rcons l x) = state_set8 (addstate8 st l) i x. +proof. by move=> ->; apply addstate8_rcons. qed. -lemma xorstate_w8L_rcons st l x: - xorstate_w8L st (rcons l x) - = state_xor8 (xorstate_w8L st l) (size l) x. -admitted. +lemma addstate64_rcons st l x: + size l < 25 => + addstate64 st (rcons l x) = (addstate64 st l).[size l <- x]. +proof. +admit. +qed. -lemma xorstate_w8L_rconsE i st l x: - i < 200 => +lemma addstate64_rconsE i st l x: i = size l => - xorstate_w8L st (rcons l x) - = state_xor8 (xorstate_w8L st l) i x. -admitted. - -lemma xorstate_w8L0 st: xorstate_w8L st [] = st. -admitted. -lemma xorstate_w64L0 st: xorstate_w64L st [] = st. -admitted. + i < 25 => + addstate64 st (rcons l x) = (addstate64 st l).[i <- x]. +proof. by move=> ->; apply addstate64_rcons. qed. -lemma xorstate_w64L2w8L st l: - xorstate_w64L st l = xorstate_w8L st (w64L2w8L l). -admitted. +lemma addstate_w64L2w8L st l: + addstate8 st (w64L2w8L l) = addstate64 st l. +proof. by rewrite -w64L2w8L2state. qed. lemma xorstate_w8L2w64L st l: - xorstate_w8L st l = xorstate_w64L st (w8L2w64L l). -admitted. + addstate64 st (w8L2w64L l) = addstate8 st l. +proof. by rewrite -w8L2w64L2state. qed. +lemma to_list_addstate8 st l: + state2w8L (addstate8 st l) + = map2 W8.(`^`) (state2w8L st) (l++nseq (200-size l) W8.zero). +proof. +apply (eq_from_nth W8.zero). + rewrite size_map2 !size_to_list min_lel //. + rewrite size_cat size_nseq; smt(size_ge0). +rewrite size_to_list => i Hi. +rewrite WArray200.get_to_list (nth_map2 W8.zero W8.zero). + rewrite size_to_list size_cat size_nseq; smt(size_ge0). +rewrite addstate8_get8E 1://; congr. + by rewrite get_to_list state_get8E. +case: (i < size l) => E; first by rewrite nth_cat E. +rewrite nth_out 1:/# nth_cat. +by rewrite (:! i < size l) 1:/# /= nth_nseq_dflt. +qed. +lemma addstate64_nil st: addstate64 st [] = st. +proof. +by apply Array25.ext_eq => i Hi; rewrite addstate_getE // get_of_list //. +qed. -lemma xorstate_w8L_get8_out st l i: - 0 <= i < 200 => - size l <= i => - state_get8 (xorstate_w8L st l) i - = state_get8 st i. +lemma addstate8_nil st: addstate8 st [] = st. +proof. by rewrite -w64L2w8L_nil addstate_w64L2w8L addstate64_nil. qed. + + +lemma addstate8_r st l: + state_r (addstate8 st l) = state_r st +^ w8L2block l. proof. -move=> Hi Hsz. -admit. +rewrite /state_r /state2bits /w8L2block mkblock_xor. + rewrite size_take; first smt(rate_bnds). + by rewrite size_w8L2bits WArray200.size_to_list /= (: r < 1600); smt(rate_bnds). + rewrite size_w8L2bits size_cat size_nseq size_take; first smt(rate64_bnds). + case: (rate8 < size l) => E. + by rewrite max_lel; smt(size_ge0 rate64P). + by rewrite max_ler 1:/#; smt(rate64P). +congr; rewrite to_list_addstate8. +have ->: (w8L2bits (take rate8 l ++ nseq (rate8 - size l) W8.zero)) + = take r (w8L2bits (l ++ nseq (rate8 - size l) W8.zero)). + rewrite -rate8P take_w8L2bits take_cat'. + case: (rate8 <= size l) => E. + by rewrite nseq0_le 1:/# cats0. + by rewrite take_oversize 1:/# take_nseq min_ler. +rewrite w8L2bits_xor take_map2; congr. +rewrite -rate8P !take_w8L2bits; congr. +rewrite !take_cat; case: (rate8 < size l) => //= E; congr. +by rewrite !take_nseq; smt(rate8_bnds). qed. +lemma addstate_c st l: + size l <= rate8 => + state_c (addstate8 st l) = state_c st. +proof. +move=> Hsz; rewrite /state_c /state2bits /w8L2block; congr. +rewrite -rate8P !drop_w8L2bits; congr. +rewrite to_list_addstate8 !drop_map2 drop_cat. +rewrite (:!rate8 < size l) 1:/#; iota. +rewrite drop_nseq; first smt(rate64_bnds). +rewrite map2_nseq0r //. +by rewrite size_drop; smt(rate64_bnds). +qed. @@ -534,65 +482,54 @@ qed. +(* We treat the sponge permutation as an abstract function. It acts + as a bridge between the idealized permutation used in the security + proof (RO), and the concrete Keccak-F[1600] instantiation adopted + in the implementation. *) +op sponge_permutation : state -> state. -(* - MESSAGES and PAYLOADS -*) -type mess_t = W8.t list. -(* [take_block64] reads a the contents of a full block into a list - of 64bit words (return also the remaining bytes) *) -op take_block64 (m: W8.t list): W64.t list * W8.t list = - (bits2w64L (w8L2bits (take rate8 m)), drop rate8 m). +(* [match_state] relates the bit-level and word-level state representations *) +op match_state x st = x = (state_r st, state_c st). -lemma size_take_block64l m: - rate8 <= size m => size (take_block64 m).`1 = rate64. -proof. -move=> Hm; rewrite /take_block64 /= size_bits2w64L size_w8L2bits. -rewrite size_take'; first smt(rate_bnds). -by rewrite Hm /= /rate8 -mulzA /= mulzC divzMDl. -qed. +lemma match_state_r (x:block*capacity) st: + match_state x st => x.`1 = state_r st +by move=> ->. -lemma size_take_block64r m: - rate8 <= size m => size (take_block64 m).`2 = size m - rate8. -proof. -move=> Hm; rewrite /take_block64 /= size_drop; first smt(rate_bnds). -by rewrite max_ler /#. -qed. +lemma match_state_c (x:block*capacity) st: + match_state x st => x.`2 = state_c st +by move=> ->. + + + + + + + +(* message, padding, etc. *) +type mess_t = W8.t list. +(* [aborb_split] reads a the contents of a full block into a list + of bytes (return also the remaining bytes). *) op absorb_split (m: W8.t list): W8.t list * W8.t list = (take rate8 m, drop rate8 m). lemma size_absorb_split1 m: rate8 <= size m => size (absorb_split m).`1 = rate8. -proof. -admit(* -move=> Hm; rewrite /take_block64 /= size_bits2w64L size_w8L2bits. -rewrite size_take'; first smt(rate_bnds). -by rewrite Hm /= /rate8 -mulzA /= mulzC divzMDl. -*). -qed. +proof. move=> Hm; rewrite /absorb_split /= size_take'; smt(rate_bnds). qed. lemma size_absorb_split2 m: - rate8 <= size m => size (absorb_split m).`2 - = size m - rate8. -proof. -admit(* -move=> Hm; rewrite /take_block64 /= size_drop; first smt(rate_bnds). -by rewrite max_ler /#. -*). -qed. + rate8 <= size m => size (absorb_split m).`2 = size m - rate8. +proof. move=> Hm; rewrite /absorb_split /= size_drop; smt(rate_bnds). qed. -(* - -lemma take_block64P mbits m: +lemma absorb_splitP mbits m: rate8 <= size m => - w64L2block (take_block64 m).`1 = head b0 (pad2blocks (w8L2bits m ++ mbits)). + w8L2block (absorb_split m).`1 = head b0 (pad2blocks (w8L2bits m ++ mbits)). proof. move=> Hm. have Hsz8: size (take rate8 m) = rate8. @@ -600,26 +537,29 @@ have Hsz8: size (take rate8 m) = rate8. case: (size m = rate8) => E. by rewrite -E ltzz. by have ->: rate8 < size m by smt(). -have Hsz64: size (take_block64 m).`1 = rate64. - rewrite /take_block64 /= size_bits2w64L /= Hsz8 /#. rewrite pad2blocksE /=. by move: Hm; rewrite size_cat size_w8L2bits -rate8P; smt(size_ge0). -rewrite /w64L2block Hsz64 /= cats0; congr. +rewrite /w8L2block Hsz8 /= cats0; congr. rewrite take_cat size_w8L2bits. case: (size m = rate8) => E. - rewrite !E !rate8P ltzz /r /Spnge1600.rate take0 cats0. - rewrite -Hsz64 take_size /take_block64 /=. - rewrite bits2w64LK. - by rewrite size_w8L2bits Hsz8 rate8P rate_w64. - by rewrite -E take_size. + rewrite !E !rate8P ltzz /r /Spnge1600.rate take0 cats0 -Hsz8 take_size. + by rewrite /absorb_split /= -E take_size. have ->/=: r < 8 * size m. by apply (StdOrder.IntOrder.ler_lt_trans (8*rate8)); smt(rate8P). -rewrite -Hsz64 take_size /take_block64 /= bits2w64LK. - by rewrite size_w8L2bits Hsz8 rate8P rate_w64. -by rewrite -take_w8L2bits rate8P. +by rewrite -Hsz8 take_size /absorb_split /= -rate8P take_w8L2bits. qed. -*) +lemma addfullblockP mbits blk st m: + rate8 <= size m => + blk = state_r st => + state_r (addstate8 st (absorb_split m).`1) + = blk +^ head b0 (pad2blocks (w8L2bits m ++ mbits)). +proof. +move=> Hm Hst; rewrite /absorb_split /= addstate8_r -Hst; congr. +by rewrite -absorb_splitP. +qed. + + (* [trail_byte] adds the first padding 1-bit to [mbits], which include both the "domain-separatioen" bits as well as additional suffix bits (e.g. "01" for SHA-3; "11" for RawSHAKE; "1111" for SHAKE). The last @@ -633,134 +573,11 @@ qed. op trail_byte (mbits: bool list) : W8.t = W8.bits2w (mbits++[true]). -(* [final_block64] reads the final block and adds the first padding bit *) + +(* [absorb_final] reads the final block and adds the first padding bit *) op absorb_final (lbyte: W8.t) (m: W8.t list): W8.t list = m++[lbyte]. -(* -lemma size_final_block64 b m: - size (final_block64 b m) = (size m) %/ 8 + 1. -proof. by rewrite /final_block64 size_w8L2w64L size_cat. qed. -*) - -(* -op addstate (st:state) (l: W64.t list) : state = - Array25.init (fun i => st.[i] `^` (nth W64.zero l i)). - -lemma nth_addstate d st l i: - 0 <= i < 25 => - nth d (to_list (addstate st l)) i = st.[i] `^` nth W64.zero l i. -proof. -move=> Hi; rewrite /addstate -(nth_inside witness). - by rewrite size_to_list. -by rewrite get_to_list initE Hi. -qed. - -lemma to_list_xorstate_w64L st l: - to_list (xorstate_w64L st l) - = map2 W64.(`^`) (to_list st) (l++nseq (25-size l) W64.zero). -proof. -apply (eq_from_nth W64.zero). - rewrite size_map2 !size_to_list min_lel //. - rewrite size_cat size_nseq. - case: (25 < size l) => ?; smt(). -rewrite size_to_list => i Hi. -rewrite nth_addstate // (nth_map2 W64.zero W64.zero). - rewrite size_to_list size_cat size_nseq min_lel //. - case: (25 < size l) => ?; smt(). -congr. - by rewrite -get_to_list -(nth_inside W64.zero) // size_to_list. -rewrite nth_cat; case: (i < size l) => ? //. -by rewrite nth_out 1:/# nth_nseq /#. -qed. -*) - -(* -abbrev absorb_w64L (st: state) (l: W64.t list) : state - = xorstate_w64L st (take rate64 l). -abbrev absorb_w8L (st: state) (l: W8.t list) : state - = xorstate_w8L st (take rate8 l). -*) - -(* -lemma absorb_w8L2w64L st l: - size l <= rate8 => - absorb_w64L st (w8L2w64L l) = absorb_w8L st l. -proof. -move=> Hsz; rewrite !take_oversize //. - rewrite size_w8L2w64L. - admit (* -Hsz: size l <= rate8 ------------------------------------------------------------------------- -(size l - 1) %/ 8 + 1 <= rate64 -*). -by rewrite xorstate_w8L2w64L. -qed. - -lemma absorb_w64L2w8L st l: - size l <= rate64 => - absorb_w8L st (w64L2w8L l) = absorb_w64L st l. -proof. -move=> Hsz; rewrite !take_oversize //. - rewrite size_w64L2w8L /#. -by rewrite xorstate_w64L2w8L. -qed. -*) - -lemma xorstate_r st l: - state_r (xorstate_w8L st l) = state_r st +^ w8L2block l. -proof. -admit(* -rewrite /state_r /state2bits /w8L2block. -rewrite mkblock_xor /=. - rewrite size_take; first smt(rate_bnds). - by rewrite size_w64L2bits Array25.size_to_list /= (: r < 1600); smt(rate_bnds). - rewrite size_cat size_nseq size_take; first smt(rate64_bnds). - case: (rate64 < size l) => E. - by rewrite max_lel; smt(size_ge0 rate64P). - by rewrite max_ler 1:/#; smt(rate64P). -congr; rewrite to_list_xorstate_w64L. -have ->: (w64L2bits (take rate64 l ++ nseq (rate64 - size l) W64.zero)) - = take r (w64L2bits (l ++ nseq (rate64 - size l) W64.zero)). - rewrite -rate64P take_w64L2bits take_cat'. - case: (rate64 <= size l) => E. - by rewrite nseq0_le 1:/# cats0. - by rewrite take_oversize 1:/# take_nseq min_ler. -rewrite w64L2bits_xor take_map2; congr. -rewrite -rate64P !take_w64L2bits; congr. -rewrite !take_cat; case: (rate64 < size l) => //= E; congr. -by rewrite !take_nseq; smt(rate64_bnds). -*). -qed. - -lemma addstate_c st l: - size l <= rate64 => - state_c (xorstate_w64L st l) = state_c st. -proof. -admit (* -move=> Hsz; rewrite /state_c /state2bits /w64L2block; congr. -rewrite -rate64P !drop_w64L2bits; congr. -rewrite to_list_xorstate_w64L !drop_map2 drop_cat. -have ->/=: !(rate64 < size l) by smt(). -rewrite drop_nseq; first smt(rate64_bnds). -rewrite map2_nseq0r //. -rewrite size_drop; first smt(rate64_bnds). -by rewrite max_ler size_to_list; smt(rate64_bnds). -*). -qed. - -lemma addfullblockP mbits blk st m: - rate8 <= size m => - blk = state_r st => - state_r (xorstate_w8L st (absorb_split m).`1) - = blk +^ head b0 (pad2blocks (w8L2bits m ++ mbits)). -proof. -admit (* -move=> Hm Hst; rewrite xorstate_r -Hst; congr. -by apply take_block64P. -*). -qed. - lemma finalblockP mbits m: size mbits < 6 => @@ -768,196 +585,166 @@ lemma finalblockP mbits m: w8L2block (absorb_final (trail_byte mbits) m) +^ block0star1 = head b0 (pad2blocks (w8L2bits m ++ mbits)). proof. -admit (* move=> Hmbits Hm. -rewrite /pad2blocks /(\o) /pad /bits2blocks /= chunk_r /= /w64L2block. +rewrite /pad2blocks /(\o) /pad /bits2blocks /= chunk_r /=. rewrite !size_cat size_mkpad size_w8L2bits !addzA. rewrite (size_pad_equiv (8 * size m + size mbits)); first smt(size_ge0). by rewrite divz_small; first apply bound_abs; smt(size_ge0). -rewrite block0star1P; first rewrite size_cat size_w8L2bits /#. +rewrite block0star1P /w8L2block; first rewrite size_cat size_w8L2bits /#. congr; congr. -rewrite w64L2bits_cat. +rewrite take_oversize /absorb_final /trail_byte; first by rewrite size_cat /#. have ->: nseq (r - size (w8L2bits m ++ mbits) - 1) false = (nseq (chunkfillsize 8 (size (mbits ++ [true]))) false - ++ nseq (chunkfillsize 64 (8*(size m+1))) false) - ++ nseq (r - 64*size (final_block64 (trail_byte mbits) m)) false. + ++ nseq (r - 8*size m - 8) false). rewrite -!nseq_add; first 2 smt(chunkfillsize_cmp size_ge0). - smt(chunkfillsize_cmp size_cat size_ge0). - smt(size_final_block64 rate_bnds). - congr; rewrite size_final_block64 !size_cat size_w8L2bits /=. - rewrite chunkfillsizeE' //; first smt(size_ge0). - rewrite chunkfillsizeE' //=; first smt(size_ge0). - rewrite mulzDr /= modz_small; first smt(size_ge0). - rewrite mulzDr !addzA /=. rewrite (mulzC 8). -(* FIXTHIS *)ring. smt. (*divzE; ring.*) -rewrite !catA; congr; last first. - rewrite w64L2bits_nseq0. - rewrite /final_block64 size_final_block64. - smt(size_ge0). - by rewrite mulzDr rate64P; congr; ring. -rewrite /final_block64 take_oversize. - rewrite size_w8L2w64L size_cat /=. - by rewrite -ltzE; smt(divz_cmp). -rewrite bits2w64LK' /chunkfill w8L2bits_cat -!catA; congr. -have ->: w8L2bits [trail_byte mbits] = chunkfill false 8 (mbits ++ [true]). - rewrite /trail_byte /w8L2bits /chunkfill /= /flatten /=. - pose L:= (nth false _ 0 :: _). - apply (eq_from_nth false). - rewrite !size_cat /= size_nseq max_ler 1:/# chunkfillsizeE' //; first smt(size_ge0). - rewrite modz_small; first apply bound_abs; smt(size_ge0). - by ring. - rewrite (:size L=8) //. - move=> i Hi; have: i \in iota_ 0 8 by smt(). - move=> {Hi} Hi. - rewrite -catA !nth_cat /= nth_nseq_if. - move: i Hi; rewrite /L -List.allP /= => {L}. - move: mbits Hmbits => [|x0 [|x1 [|x2 [|x3 [|x4 [|x5 xs]]]]]] //=. - smt(size_ge0). -rewrite {1}/chunkfill -!catA; congr; congr; congr; congr. -rewrite !size_cat /= !chunkfillsizeE' //; first 4 smt(size_ge0). -rewrite size_nseq max_ler 1:/# (modz_small _ 8); first apply bound_abs; smt(size_ge0). -rewrite /= (:size mbits + 1 + (7 - size mbits)=8) 1:/#. -rewrite (:8 * size m + 8 - 1 = 8*(size m + 1) - 1) 1:/#. -by ring. -*). + congr; rewrite !size_cat size_w8L2bits /= chunkfillsizeE' 1:/#; first smt(size_ge0). + ring; rewrite /= modz_small; smt(size_ge0). +rewrite catA w8L2bits_cat; congr; last first. + rewrite w8L2bits_nseq0. + rewrite size_cat /=; smt(size_ge0). + by rewrite mulzDr rate8P size_cat /=; congr; ring. +rewrite w8L2bits_cat -!catA; congr. +rewrite /w8L2bits /flatten /chunkfill chunkfillsizeE' 1:/# size_cat /=; first smt(size_ge0). +rewrite modz_small; first smt(size_ge0). +pose L:= (nth false _ 0 :: _). +apply (eq_from_nth false). + by rewrite !size_cat /= size_nseq max_ler /#. +rewrite (:size L=8) //. +move=> i Hi; have: i \in iota_ 0 8 by smt(). +move=> {Hi} Hi. +rewrite -cat1s !nth_cat /= nth_nseq_if. +move: i Hi; rewrite /L -List.allP /= => {L}. +move: mbits Hmbits => [|x0 [|x1 [|x2 [|x3 [|x4 [|x5 xs]]]]]] //=. +smt(size_ge0). qed. - op addfinalbit (st: state): state = state_xor8 st (rate8-1) (W8.of_int 128). -op addfinalblock st l = addfinalbit (xorstate_w8L st l). +op block0star1_st = addfinalbit st0. + +lemma addfinalbitE st: + addfinalbit st = addstate8 st (nseq (rate8-1) W8.zero ++ [W8.of_int 128]). +proof. +have Rbnds := rate8_bnds. +rewrite -(state200K (addstate8 _ _)) /addfinalbit; congr; congr. +apply ext_eq => i Hi; rewrite addstate8_get8E // get_set_if. +rewrite (:0 <= rate8 - 1 < 200) 1:/# nth_cat size_nseq max_ler 1:/# /=. +case: (i=rate8-1) => E; first by rewrite E /= state_get8E /#. +case: (i < rate8-1) => H. + by rewrite nth_nseq 1:/# W8.xorw0 state_get8E. +by rewrite Ring.IntID.subr_eq0 E /= state_get8E. +qed. + +lemma addfinalbitP st: + state_r (addfinalbit st) = state_r st +^ block0star1. +proof. +have Rbnds := rate8_bnds. +rewrite addfinalbitE addstate8_r /block0star1 /w8L2block; congr; congr. +rewrite w8L2bits_cat take_oversize. + by rewrite size_cat size_nseq /#. +rewrite size_cat size_nseq max_ler 1:/# /= cats0. +rewrite w8L2bits_cat w8L2bits_nseq0 1:/#. +rewrite (: r-1 = 8*(rate8-1) + 7) 1:-rate8P 1:/#. +rewrite nseq_add 1,2:/# -catA; congr. +rewrite -(W8.shlMP 1 7) // /w8L2bits /=. +have P: forall i, W8.one.[i] = (i=0). + move=> i; rewrite of_intE /= /int2bs /= /mkseq /= bits2wE /=. + case: (0 <= i < 8) => E. + by rewrite initiE //. + by rewrite W8.get_out // /#. +by rewrite /flatten /= !P /#. +qed. + +op addfinalblock st l = addfinalbit (addstate8 st l). (* -op block0star1_64 = nseq (rate64-1) W64.zero ++ [W64.of_int (2 ^ 63)]. +op block0star1w8L = nseq (rate8-1) W8.zero ++ [W8.of_int 128]. -lemma block0star1E: - w64L2block block0star1_64 = block0star1. +lemma block0star1w8LE: + w8L2block block0star1w8L = block0star1. proof. -rewrite /w64L2block /block0star1 /block0star1_64; congr. +rewrite /w8L2block /block0star1 /block0star1w8L; congr. rewrite size_cat size_nseq /= max_ler; first smt(rate64_bnds). -have ->: rate64 - (rate64 - 1 + 1) = 0 by ring. +have ->: rate8 - (rate8 - 1 + 1) = 0 by ring. rewrite nseq0 cats0. pose l := nseq _ _. rewrite take_cat. -have ->/=: ! rate64 < size l. +have ->/=: ! rate8 < size l. by rewrite /l size_nseq max_ler; smt(rate64_bnds). -rewrite w64L2bits_cat /l size_nseq max_ler; first smt(rate64_bnds). -have ->/=: ! rate64 - (rate64 - 1) <= 0 by smt(). -have ->: nseq (r-1) false = nseq (64 * (rate64-1)) false ++ nseq 63 false. +rewrite w8L2bits_cat /l size_nseq max_ler; first smt(rate64_bnds). +have ->/=: ! rate8 - (rate8 - 1) <= 0 by smt(). +have ->: nseq (r-1) false = nseq (8 * (rate8-1)) false ++ nseq 7 false. rewrite -nseq_add //; first smt(rate64_bnds). - by congr; rewrite mulzDr -rate64P; ring. + by congr; rewrite mulzDr -rate8P; ring. rewrite -catA; congr. - rewrite w64L2bits_nseq0; smt(rate64_bnds). -rewrite -(W64.shlMP 1 63) //. -rewrite /w64L2bits /=. -have P: forall i, W64.one.[i] = (i=0). + rewrite w8L2bits_nseq0; smt(rate64_bnds). +rewrite -(W8.shlMP 1 7) //. +rewrite /w8L2bits /=. +have P: forall i, W8.one.[i] = (i=0). move=> i; rewrite of_intE /= /int2bs /= /mkseq /= bits2wE /=. - case: (0 <= i < 64) => E. + case: (0 <= i < 8) => E. by rewrite initiE //. - by rewrite W64.get_out // /#. + by rewrite W8.get_out // /#. by rewrite /flatten /= !P /#. qed. lemma addfinalbit_r (st: state): state_r (addfinalbit st) = state_r st +^ block0star1. proof. -rewrite -block0star1E -addstate_r /addstate; congr. -apply Array25.ext_eq => i Hi. -rewrite initE Hi get_setE; first smt(rate64_bnds). -case: (i = rate64 - 1) => E. - rewrite !E /block0star1_64; congr. +have Rbnds := rate8_bnds. +rewrite -block0star1w8LE -addstate8_r /addfinalbit; congr. +rewrite -(state200K (addstate8 st block0star1w8L)); congr; congr. +apply WArray200.ext_eq => i Hi. +rewrite get_setE 1:/# addstate8_get8E //. +case: (i = rate8-1) => E. + rewrite /block0star1w8L state_get8E 1:/# !E; congr. by rewrite nth_cat size_nseq max_ler 1:/# ltzz. -have ->: nth W64.zero block0star1_64 i = W64.zero. - rewrite /block0star1_64 nth_cat size_nseq max_ler; first smt(rate64_bnds). - case: (i < rate64 - 1) => H. - by rewrite nth_nseq /#. - by rewrite Ring.IntID.subr_eq0 E. -by rewrite W64.xorw0. +rewrite nth_cat size_nseq max_ler 1:/#. +case: (i < rate8-1) => H. + by rewrite nth_nseq 1:/# W8.xorw0 state_get8E. +by rewrite Ring.IntID.subr_eq0 E /= state_get8E. qed. +*) -lemma addfinalblock_r mbits blk st m: +lemma addfinalblock_r mbits st m: size mbits < 6 => size m < rate8 => - blk = state_r st => - state_r (addfinalblock st (final_block64 (trail_byte mbits) m)) - = blk +^ head b0 (pad2blocks (w8L2bits m ++ mbits)). + state_r (addfinalblock st (absorb_final (trail_byte mbits) m)) + = state_r st +^ head b0 (pad2blocks (w8L2bits m ++ mbits)). proof. -move=> Hmbits Hm Hst. -rewrite /addfinalblock addfinalbit_r addstate_r -Hst -Block.xorwA; congr. +move=> Hmbits Hm. +rewrite /addfinalblock addfinalbitP !addstate8_r -Block.xorwA; congr. by apply finalblockP. qed. lemma addfinalbit_c st: state_c (addfinalbit st) = state_c st. proof. -rewrite /addfinalbit /state_c /state2bits; congr. -rewrite -rate64P !drop_w64L2bits; congr. -pose newst := Array25.to_list _. -have E1: (size (drop rate64 newst) = 25 - rate64). - rewrite size_drop; first smt(rate64_bnds). - rewrite size_to_list max_ler; smt(rate64_bnds). -have E2: (size (drop rate64 (to_list st)) = 25 - rate64). - rewrite size_drop; first smt(rate64_bnds). - rewrite size_to_list max_ler; smt(rate64_bnds). -apply (eq_from_nth witness). - by rewrite E1 E2. -move=> i Hi; rewrite !nth_drop 1..4:[smt(rate64_bnds)]. -rewrite 2!get_to_list set_neqiE; smt(rate64_bnds). +rewrite addfinalbitE addstate_c // size_cat size_nseq /=; smt(rate8_bnds). qed. -*) (* [squeezestate] extracts a [rate64] 64bit words from the state *) op squeezestate (st: state): W8.t list = take rate8 (state2w8L st). +lemma size_squeezestate st: + size (squeezestate st) = rate8. +proof. rewrite /squeezestate size_take'; smt(rate64_bnds). qed. + op squeezestate64 (st: state) = take rate64 (state2w64L st). +lemma size_squeezestate64 st: + size (squeezestate64 st) = rate64. +proof. rewrite /squeezestate64 size_take' ?size_to_list; smt(rate64_bnds). qed. lemma squeezestateE st: squeezestate st = w64L2w8L (squeezestate64 st). -admitted. - -lemma size_squeezestate st: - size (squeezestate st) = rate8. proof. -rewrite /squeezestate size_take'; first smt(rate64_bnds). -admit (* -by rewrite Array25.size_to_list; smt(rate64_bnds).*). +by rewrite /squeezestate /squeezestate64 /rate8 state2w8L2w64L take_w64L2w8L. qed. -lemma size_squeezestate64 st: - size (squeezestate64 st) = 25. -admitted. - - -(* [xtrbytes outl w64L] converts at most [outl] bytes from the - list of 64bit words [w64L] -op xtrbytes (n: int) (b64: W64.t list): W8.t list = - take n (w64L2w8L b64). - -lemma size_xtrbytes n st: - 0 <= n => - size (xtrbytes n (squeezestate st)) = min n rate8. -proof. -by move=> Hn; rewrite /xtrbytes size_take // !size_w64L2w8L size_squeezestate /#. -qed. - -lemma xtrbytes_squeezestate n st: - w8L2bits (xtrbytes n (squeezestate st)) = - take (8*n) (ofblock (state_r st)). -proof. -admit (* -rewrite /xtrbytes -take_w8L2bits /squeezestate; congr. -rewrite /state_r /state2bits -rate64P take_w64L2bits. -rewrite w64L2w8L2bits ofblockK // size_w64L2bits size_take. - smt(rate64_bnds). -rewrite Array25.size_to_list -rate64P. -by have ->/=: rate64 < 25 by smt(rate64_bnds). -*). -qed. -*) lemma size_pad2blocks8 mbits m: size mbits < 6 => @@ -990,11 +777,11 @@ qed. lemma behead_pad2blocks8 mbits m: rate8 <= size m => behead (pad2blocks (w8L2bits m ++ mbits)) = - pad2blocks (w8L2bits (take_block64 m).`2 ++ mbits). + pad2blocks (w8L2bits (absorb_split m).`2 ++ mbits). proof. move=> ?; rewrite behead_pad2blocks. by rewrite size_cat size_w8L2bits -rate8P; smt(size_ge0). -rewrite /take_block64 /= drop_cat size_w8L2bits -rate8P. +rewrite /absorb_split /= drop_cat size_w8L2bits -rate8P. rewrite StdOrder.IntOrder.ltr_pmul2l //. case: (rate8 = size m) => E. by rewrite E /= drop0 drop_size w8L2bits_nil. @@ -1029,7 +816,7 @@ module Spec = { (* ABSORB *) while (rate8 <= size m){ (l, m) <- absorb_split m; - st <- xorstate_w8L st l; + st <- addstate8 st l; st <- sponge_permutation st; } st <- addfinalblock st (absorb_final trail_byte m); @@ -1047,10 +834,6 @@ module Spec = { } }. -lemma take_take n1 n2 (l: 'a list): - take n1 (take n2 l) = take (min n1 n2) l. -proof. elim: l n1 n2 => //= x xs IH n1 n2; smt(). qed. - section. declare module IdealizedPerm: DPRIMITIVE. @@ -1064,9 +847,10 @@ lemma spec_correct mbits: equiv [ Sponge(IdealizedPerm).f ~ Spec.f : bs{1} = w8L2bits m{2} ++ mbits /\ n{1} = 8*outlen{2} /\ - trail_byte{2} = trail_byte bs{1} /\ size mbits < 6 + trail_byte{2} = trail_byte mbits /\ size mbits < 6 ==> res{1} = w8L2bits res{2}]. proof. +have Rbnds:= rate8_bnds. proc; simplify; exists* outlen{2}; elim* => outlen2. swap {1} 1 1; swap {1} [2..3] 2. swap {2} 1 3. @@ -1080,31 +864,27 @@ seq 3 2: (#[/1,3:]pre /\ match_state (sa,sc){1} st{2} /\ outlen2 = outlen{2} /\ 1<=size xs{1}). wp 1 2; ecall {1} (perm_correct st{2}); wp; skip; progress. + by rewrite (match_state_r _ _ H0) eq_sym; apply addfullblockP. -admit(* - + by move: H0; rewrite addstate_c /match_state //= size_take_block64l.*). + + by move: H0; rewrite addstate_c /match_state //= size_absorb_split1. + by rewrite H6. + by rewrite H6. + by rewrite behead_pad2blocks8. - + rewrite size_behead size_pad2blocks8 // max_ler /= lez_divRL; smt(rate8_bnds). -admit(* - + rewrite size_take_block64r //. + + by rewrite size_behead size_pad2blocks8 // max_ler /= lez_divRL /#. + + rewrite size_absorb_split2 //. have: 3 <= size (pad2blocks (w8L2bits m{2} ++ mbits)). move: H8; rewrite size_behead max_ler. - rewrite size_pad2blocks8 //= lez_divRL; smt(rate8_bnds). + by rewrite size_pad2blocks8 //= lez_divRL /#. smt(). - by rewrite size_pad2blocks8_ge /#.*). + by rewrite size_pad2blocks8_ge /#. + have : 2 <= size (pad2blocks (w8L2bits m{2} ++ mbits)). by rewrite size_pad2blocks8_ge // /#. by pose L:= pad2blocks _; move: L => [|x1 [|x2 xs]]. -admit(* + have : 2 < size (pad2blocks (w8L2bits m{2} ++ mbits)). rewrite size_pad2blocks8 //. apply (StdOrder.IntOrder.ltr_le_trans (2+1)) => //. - apply lez_add2r; rewrite lez_divRL /= 1:[smt(rate8_bnds)]. - move: H7; rewrite /take_block64 /= size_drop 1:[smt(rate8_bnds)]. + apply lez_add2r; rewrite lez_divRL /= 1:/#. + move: H7; rewrite /absorb_split /= size_drop 1:/#. by rewrite max_ler /#. - by pose L:= pad2blocks _; move: L => [|x1 [|x2 [|x3 xs]]] => //=; smt(). -*). + by pose L:= pad2blocks _; move: L => [|x1 [|x2 [|x3 xs]]] => //= /#. skip => |> *; progress. + by rewrite st0_r. + by rewrite st0_c. @@ -1125,6 +905,26 @@ rcondf {1} 3. move: (pad2blocks _) => [|??] //= ?. by rewrite -size_eq0 /#. (* SQUEEZE *) +case: (0 < outlen2); last first. + (* corner case: no output *) + rcondf {2} 3; first by move=> *; wp; skip => |> *; smt(rate8_bnds). + rcondf {1} 5. + move=> *; wp; call (_:true); skip => |> *. + case: (8 * outlen{m} + r - 1 < 0) => ?. + rewrite -lezNgt; apply ltzW. + rewrite ltzNge divz_ge0; first smt(rate_bnds). + smt(). + rewrite divz_small //. + by apply bound_abs; smt(rate_bnds). + wp 1 2; ecall {1} (perm_correct st{2}); wp; skip; progress. + + rewrite (match_state_r _ _ H0) addfinalblock_r //. + by move: H1; rewrite size_pad2blocks8 // /#. + + rewrite /addfinalblock addfinalbitE addstate_c. + by rewrite size_cat size_nseq /= /#. + rewrite addstate_c /absorb_final. + by move: H1; rewrite size_pad2blocks8 // size_cat /#. + by rewrite (match_state_c _ _ H0). + + by rewrite take_le0 /#. splitwhile {1} 5: (i+1 < (n + r - 1) %/ r). seq 5 3: (#[/3:5]pre /\ n{1} = 8*outlen2 /\ outlen{2} = outlen2 - rate8*i{1} /\ @@ -1133,26 +933,36 @@ seq 5 3: (#[/3:5]pre /\ n{1} = 8*outlen2 /\ size result{2} = rate8 * i{1} /\ i{1}+1 = (n{1} + r - 1) %/ r). (* SQUEEZE intermediate blocks *) - while (#[:-1]post). + while (#[:-1]post /\ i{1}+1 <= (n{1} + r - 1) %/ r). rcondt {1} 3. by move=> ?; wp; skip; progress. ecall {1} (perm_correct st{2}); wp; skip; progress. - + admit. - + by rewrite H6. - + by rewrite H6. - + admit. - + admit. - + admit. - + admit. - wp 1 1; ecall {1} (perm_correct st{2}); wp; skip; progress. - + admit. - + admit. - + by rewrite H3. - + by rewrite H3. - + admit (* rate8 < outlen{2} *). - + admit (* 0 < (8 * outlen{2} + r - 1) %/ r *). - + admit (* 1 < (8 * outlen{2} + r - 1) %/ r *). - + admit. + + smt(). + + by rewrite H7. + + by rewrite H7. + + rewrite w8L2bits_cat (match_state_r _ _ H6) /state_r ofblockK. + by rewrite size_take 1:/# size_state2bits /#. + by congr; rewrite -rate8P /squeezestate /state2bits -take_w8L2bits; congr. + + by rewrite size_cat size_squeezestate /#. + + smt(). + + by move: H9; rewrite needed_blocks8P /#. + + by rewrite needed_blocks8P /#. + wp 1 1; ecall {1} (perm_correct st{2}); wp; skip; auto => |> *; progress. + + rewrite (match_state_r _ _ H0) addfinalblock_r //. + by move: H1; rewrite size_pad2blocks8 // /#. + + rewrite /addfinalblock addfinalbitE addstate_c. + by rewrite size_cat size_nseq /= /#. + rewrite addstate_c /absorb_final. + by move: H1; rewrite size_pad2blocks8 // size_cat /#. + by rewrite (match_state_c _ _ H0). + + by rewrite H4. + + by rewrite H4. + + have ->: 1 = 0+1 by done. + by rewrite -ltzE needed_blocks8P /=. + + by move: H5; rewrite needed_blocks8P /#. + + by rewrite needed_blocks8P /#. + + by rewrite needed_blocks8P /#. + + smt(). (* SQUEEZE final block *) rcondt {1} 1; first by move=> ?; wp; skip; progress; smt(). rcondf {1} 3; first by move=> ?; wp; skip; progress; smt(). @@ -1160,102 +970,19 @@ rcondf {1} 3; first by move=> ?; wp; skip; progress; smt(). wp; skip; progress. rewrite w8L2bits_cat take_cat'. rewrite (:!8 * outlen2 <= size (w8L2bits result{2})) /=. - rewrite H1. smt. + by rewrite size_w8L2bits H1 -mulzA rate8P /#. congr; rewrite (match_state_r _ _ H0) /squeezestate ofblockK. - admit. + by rewrite size_take 1:/# size_state2bits /#. rewrite take_take min_lel /state2bits. - admit. + by rewrite size_w8L2bits H1 -mulzA rate8P /#. +rewrite size_w8L2bits. have ->: 8 * outlen2 - 8 * size result{2} = 8*(outlen2 -size result{2}) by ring. rewrite take_w8L2bits; congr. rewrite take_take min_lel. - rewrite -H1. smt. + by rewrite (: i{1}=i{1}+1-1) 1:/# mulzDr H2 -rate8P /#. congr; smt(). qed. -(* -admit (* TODO: adjust proof script to a last-minute change in the control-flow -case: (0 < outl2); last first. - (* corner case: no output *) - rcondf {2} 3; first by move=> *; wp; skip => |> *; smt(rate8_bnds). - rcondf {1} 5. - move=> *; wp; call (_:true); skip => |> *. - case: (8 * outl{m} + r - 1 < 0) => ?. - rewrite -lezNgt; apply ltzW. - rewrite ltzNge divz_ge0; first smt(rate_bnds). - smt(). - rewrite divz_small //. - by apply bound_abs; smt(rate_bnds). -wp 1 2; ecall {1} (perm_correct st{2}); wp; skip => |> *; progress. -admit. admit. admit. - (* by wp; call {1} perm_correct; skip => |> *; progress.*) -(* normal case: positive length output *) -rcondt {2} 3; first by move=> *; wp; skip => |>. -seq 4 6: (#[/5]pre /\ 0 < outl2 /\ n{1} = 8*outl2 /\ - outl{2} + (i{1}+1)*rate8 = outl2 /\ - take n{1} (z{1} ++ ofblock sa{1}) = w8L2bits result{2} /\ - (z=[] /\ i=0){1}). - wp; call perm_correct; wp; skip => [??]. - progress. - + rewrite eq_sym; apply addfinalblock_r => //. - move: H1; rewrite size_pad2blocks8 //. - rewrite -{2}(addz0 1) addzC=> /addzI. - rewrite -divz_eq0; smt(rate8_bnds). - by move: H0; rewrite /match_state /=. - + rewrite /addfinalblock addfinalbit_c addstate_c. - rewrite size_final_block64. - move: H1; rewrite size_pad2blocks8 //. - rewrite -{2}(addz0 1) addzC=> /addzI. - by rewrite -divz_eq0; smt(rate8_bnds). - by rewrite (match_state_c _ _ H0). - + by rewrite H4. - + by rewrite H4. - + smt(). - + by rewrite xtrbytes_squeezestate H4. -splitwhile {1} 1: (i+1 < (n + r - 1) %/ r). -seq 1 1: (#[:-2]pre /\ (i+1=(n + r - 1) %/ r){1}). - while (#[:-2]pre /\ 0 <= i{1}+1 <= (n{1} + r - 1) %/ r /\ - size z{1} = i{1}*r). - rcondt {1} 3; first by move=> *; wp; skip => |> * /#. - wp; call perm_correct; wp; skip => [??] [[[[->->]]]] [?[->]]. - rewrite needed_blocks8P; progress. - + by rewrite H8. - + by rewrite H8. - + smt(). - + rewrite take_cat. - rewrite size_cat H3 size_block -rate8P. - have ->/=: !(8 * (outl{2} + (i{1} + 1) * rate8) - < i{1} * (8*rate8) + 8*rate8). - rewrite -lezNgt mulzDl !mulzDr /=. - rewrite addzA lez_add2r (mulzC 8) -mulzA mulzC. - rewrite -{1}(add0z (8 * (i{1} * rate8))) lez_add2r. - apply ltzW; smt(). - rewrite w8L2bits_cat -H0. - rewrite H8 /= eq_sym take_oversize. - rewrite size_cat H3 size_block -rate8P. - rewrite mulzDl !mulzDr /= (mulzC 8 rate8). - rewrite (mulzC _ (i{1} * rate8)) -!mulzA. - rewrite -{1}(add0z (_ + _)%Int) lez_add2r. - apply ltzW; smt(). - by congr; rewrite xtrbytes_squeezestate; congr; ring. - + smt(). - + have ->: 2 = 1 + 1 by ring. - by rewrite addzA -ltzE needed_blocks8P /#. - + by rewrite size_cat H3 size_block; ring. - + by move: H10; rewrite needed_blocks8P /#. - + by rewrite needed_blocks8P /#. - skip => |> *; progress. - + have ->: 1 = 0+1 by done. - by rewrite -ltzE needed_blocks8P /#. - + move: H3; rewrite needed_blocks8P /#. - + by rewrite needed_blocks8P /#. - + rewrite needed_blocks8P /#. - + smt(). -unroll {1} 1; rcondt {1} 1; first by move=> *; skip => |> * /#. -rcondf {1} 3; first by move=> *; wp; skip => |> * /#. -rcondf {1} 3; first by move=> *; wp; skip => |> * /#. -by wp; skip => |> *. -qed. -*)*) end section. From 71f9b833c419a05a428afc95c11ad7f55c76c130 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jos=C3=A9=20Bacelar=20Almeida?= Date: Mon, 20 May 2019 06:07:40 +0100 Subject: [PATCH 433/525] finished. --- proof/impl/EclibExtra.ec | 12 ++- proof/impl/JWordList.ec | 3 +- proof/impl/Spec1600.ec | 178 ++++++++++++++------------------- proof/impl/keccak_1600_corr.ec | 64 ++++++------ 4 files changed, 118 insertions(+), 139 deletions(-) diff --git a/proof/impl/EclibExtra.ec b/proof/impl/EclibExtra.ec index 164330f..578ab37 100644 --- a/proof/impl/EclibExtra.ec +++ b/proof/impl/EclibExtra.ec @@ -1,4 +1,4 @@ -(* Miscellaneous results on EC standard library and JUtils constructions *) +(* Miscellaneous results on some constructions from the EC and Jasmin libraries *) require import Core Int IntDiv List. require BitEncoding. (*---*) import IntExtra. @@ -23,6 +23,16 @@ qed. lemma nth0 (d:'a) l: nth d l 0 = head d l by case: l. +lemma take_take n1 n2 (l: 'a list): + take n1 (take n2 l) = take (min n1 n2) l. +proof. elim: l n1 n2 => //= x xs IH n1 n2; smt(). qed. + +lemma nth_nseq_dflt (d:'s) n i: nth d (nseq n d) i = d. +proof. +case: (0 <= i < n) => E; first by rewrite nth_nseq. +rewrite nth_out // size_nseq /#. +qed. + lemma nseq_add ['a] (x:'a) n1 n2: 0 <= n1 => 0 <= n2 => nseq (n1+n2) x = nseq n1 x ++ nseq n2 x. proof. diff --git a/proof/impl/JWordList.ec b/proof/impl/JWordList.ec index 399c60a..056faec 100644 --- a/proof/impl/JWordList.ec +++ b/proof/impl/JWordList.ec @@ -1,3 +1,4 @@ +(* List of Jasmin Words *) require import AllCore List Int IntDiv. from Jasmin require import JMemory JWord JUtils. @@ -671,7 +672,7 @@ move=> Hx Hy; rewrite /memread mkseq_add //; congr. by apply eq_mkseq => z /=; rewrite addzA. qed. -lemma memread_addS mem in_ x: +lemma memreadS mem in_ x: 0 <= x => memread mem in_ (x+1)%Int = rcons (memread mem in_ x) (loadW8 mem (in_+x)). proof. by move=> Hx; rewrite memread_add //= cats1. qed. diff --git a/proof/impl/Spec1600.ec b/proof/impl/Spec1600.ec index cc27f2b..7724a00 100644 --- a/proof/impl/Spec1600.ec +++ b/proof/impl/Spec1600.ec @@ -1,30 +1,14 @@ +(****************************************************************************** + Spec1600.ec: + + Byte-oriented and statefull specification of the sponge construction. +******************************************************************************) require import AllCore List Int IntDiv. from Jasmin require import JArray JMemory JModel JWord JWord_array JUtils. require import EclibExtra JWordList. - -(* MOVE TO EcLib *) - -lemma take_take n1 n2 (l: 'a list): - take n1 (take n2 l) = take (min n1 n2) l. -proof. elim: l n1 n2 => //= x xs IH n1 n2; smt(). qed. - -lemma nth_nseq_dflt (d:'s) n i: nth d (nseq n d) i = d. -proof. -case: (0 <= i < n) => E; first by rewrite nth_nseq. -rewrite nth_out // size_nseq /#. -qed. - -(* END EcLib *) - - - - - - - op rate :int. axiom rate_bnds: 0 < rate < 1600. axiom rate_w64: 64 %| rate. @@ -157,7 +141,7 @@ qed. require import Array25 WArray200. (* State is defined as an array of 25 64-bit words. But it can also be - viewed as an array of 200 bytes (which is the prefered view in this + viewed as an array of 200 bytes (which is the preferred view in this specification). *) type state = W64.t Array25.t. abbrev state200 (st: state) : WArray200.t = WArray200.init64 ("_.[_]" st). @@ -191,11 +175,12 @@ rewrite -(W8u8.Pack.init_ext by rewrite get_setE 1:/# (:i%%8=k) 1:/#. case: (j=i%/8) => E2. rewrite -!E2 /w64_set8 /=. - admit (* rewrite (W8u8.unpack8K st.[j]). W8u8.get_setE.*). + rewrite pack8bE // get_set_if. + by rewrite (:!k = i %% 8) 1:/# /= W8u8.get_unpack8 //; congr; smt(). by congr; [congr|]; smt(). case: (j=i%/8) => E. - admit. -admit. + by rewrite -{2}(W8u8.unpack8K (w64_set8 _ _ _)) /unpack8; congr. +by rewrite -(W8u8.unpack8K st.[j]); congr. qed. @@ -342,6 +327,14 @@ abbrev addstate8 (st: state) (l: W8.t list) : state = addstate st (w8L2state l). abbrev state_xor8 (st: state) i x = state_set8 st i (state_get8 st i `^` x). abbrev addstate64 (st: state) (l: W64.t list) : state = addstate st (w64L2state l). +lemma addstate8_w64L st l: + addstate8 st (w64L2w8L l) = addstate64 st l. +proof. by rewrite -w64L2w8L2state. qed. + +lemma addstate64_w8L st l: + addstate64 st (w8L2w64L l) = addstate8 st l. +proof. by rewrite -w8L2w64L2state. qed. + lemma addstate_getE st1 st2 i: 0 <= i < 25 => (addstate st1 st2).[i] = st1.[i] `^` st2.[i]. @@ -355,7 +348,7 @@ by move=> Hi; rewrite /addstate map2iE // (Array25.get_of_list W64.zero). qed. lemma addstate64_getE_out st l i: - size l < i => + size l <= i => (addstate64 st l).[i] = st.[i]. proof. move=> Hsz; case: (0 <= i < 25) => E. @@ -368,11 +361,14 @@ lemma addstate8_get8E st l i: state_get8 (addstate8 st l) i = (st.[i %/ 8] \bits8 (i %% 8)) `^` nth W8.zero l i. proof. -admit. +move=> Hi. +rewrite state_get8E // -addstate64_w8L addstate64_getE 1:/#. +rewrite nth_w8L2w64L W8u8.xorb8E pack8bE 1:/#; congr. +by rewrite initiE 1:/# /= /#. qed. lemma addstate8_get8E_out st l i: - size l < i => + size l <= i => state_get8 (addstate8 st l) i = state_get8 st i. proof. move=> Hsz; case: (0 <= i < 200) => E. @@ -380,40 +376,24 @@ move=> Hsz; case: (0 <= i < 200) => E. by rewrite !get_out. qed. -lemma addstate8_rcons st l x: - size l < 200 => - addstate8 st (rcons l x) = state_set8 (addstate8 st l) (size l) x. -proof. -admit. -qed. - -lemma addstate8_rconsE i st l x: - i = size l => - i < 200 => - addstate8 st (rcons l x) = state_set8 (addstate8 st l) i x. -proof. by move=> ->; apply addstate8_rcons. qed. - lemma addstate64_rcons st l x: size l < 25 => - addstate64 st (rcons l x) = (addstate64 st l).[size l <- x]. + addstate64 st (rcons l x) = (addstate64 st l).[size l <- st.[size l] `^` x]. proof. -admit. +move=> Hsz; apply Array25.ext_eq => i Hi. +rewrite addstate64_getE // get_set_if (:0 <= size l < 25) /=; first smt(size_ge0). +case: (i=size l) => E; first by rewrite nth_rcons E. +rewrite addstate64_getE //; congr. +case: (i < size l) => H; first by rewrite nth_rcons H. +by rewrite !nth_out ?size_rcons /#. qed. lemma addstate64_rconsE i st l x: i = size l => i < 25 => - addstate64 st (rcons l x) = (addstate64 st l).[i <- x]. + addstate64 st (rcons l x) = (addstate64 st l).[i <- st.[i] `^` x]. proof. by move=> ->; apply addstate64_rcons. qed. -lemma addstate_w64L2w8L st l: - addstate8 st (w64L2w8L l) = addstate64 st l. -proof. by rewrite -w64L2w8L2state. qed. - -lemma xorstate_w8L2w64L st l: - addstate64 st (w8L2w64L l) = addstate8 st l. -proof. by rewrite -w8L2w64L2state. qed. - lemma to_list_addstate8 st l: state2w8L (addstate8 st l) = map2 W8.(`^`) (state2w8L st) (l++nseq (200-size l) W8.zero). @@ -431,13 +411,45 @@ rewrite nth_out 1:/# nth_cat. by rewrite (:! i < size l) 1:/# /= nth_nseq_dflt. qed. +lemma addstate8_rcons st l x: + size l < 200 => + addstate8 st (rcons l x) = state_xor8 (addstate8 st l) (size l) x. +proof. +move=> Hsz. +rewrite -(state200K (addstate8 _ _)); congr; congr. +apply WArray200.to_list_inj. +rewrite to_list_addstate8. +apply (eq_from_nth W8.zero). + by rewrite !size_to_list size_map2 size_cat size_rcons size_nseq /#. +rewrite size_map2 size_to_list size_cat size_rcons size_nseq min_lel 1:/#. +move=> i Hi. +rewrite get_to_list get_set_if (:0 <= size l < 200); first smt(size_ge0). +rewrite (nth_map2 W8.zero W8.zero). + rewrite size_to_list size_cat size_rcons size_nseq /#. +rewrite get_to_list nth_cat /= size_rcons. +case: (i=size l) => E. + rewrite (:i H. + by rewrite (: i < size l+1) 1:/# /= nth_rcons H. +by rewrite (:!i < size l+1) 1:/# /= nth_nseq_dflt nth_out 1:/#. +qed. + +lemma addstate8_rconsE i st l x: + i = size l => + i < 200 => + addstate8 st (rcons l x) = state_xor8 (addstate8 st l) i x. +proof. by move=> ->; apply addstate8_rcons. qed. + + lemma addstate64_nil st: addstate64 st [] = st. proof. by apply Array25.ext_eq => i Hi; rewrite addstate_getE // get_of_list //. qed. lemma addstate8_nil st: addstate8 st [] = st. -proof. by rewrite -w64L2w8L_nil addstate_w64L2w8L addstate64_nil. qed. +proof. by rewrite -w64L2w8L_nil addstate8_w64L addstate64_nil. qed. lemma addstate8_r st l: @@ -511,7 +523,7 @@ by move=> ->. -(* message, padding, etc. *) +(* messages, padding, etc. *) type mess_t = W8.t list. (* [aborb_split] reads a the contents of a full block into a list @@ -658,55 +670,6 @@ qed. op addfinalblock st l = addfinalbit (addstate8 st l). -(* -op block0star1w8L = nseq (rate8-1) W8.zero ++ [W8.of_int 128]. - -lemma block0star1w8LE: - w8L2block block0star1w8L = block0star1. -proof. -rewrite /w8L2block /block0star1 /block0star1w8L; congr. -rewrite size_cat size_nseq /= max_ler; first smt(rate64_bnds). -have ->: rate8 - (rate8 - 1 + 1) = 0 by ring. -rewrite nseq0 cats0. -pose l := nseq _ _. -rewrite take_cat. -have ->/=: ! rate8 < size l. - by rewrite /l size_nseq max_ler; smt(rate64_bnds). -rewrite w8L2bits_cat /l size_nseq max_ler; first smt(rate64_bnds). -have ->/=: ! rate8 - (rate8 - 1) <= 0 by smt(). -have ->: nseq (r-1) false = nseq (8 * (rate8-1)) false ++ nseq 7 false. - rewrite -nseq_add //; first smt(rate64_bnds). - by congr; rewrite mulzDr -rate8P; ring. -rewrite -catA; congr. - rewrite w8L2bits_nseq0; smt(rate64_bnds). -rewrite -(W8.shlMP 1 7) //. -rewrite /w8L2bits /=. -have P: forall i, W8.one.[i] = (i=0). - move=> i; rewrite of_intE /= /int2bs /= /mkseq /= bits2wE /=. - case: (0 <= i < 8) => E. - by rewrite initiE //. - by rewrite W8.get_out // /#. -by rewrite /flatten /= !P /#. -qed. - -lemma addfinalbit_r (st: state): - state_r (addfinalbit st) = state_r st +^ block0star1. -proof. -have Rbnds := rate8_bnds. -rewrite -block0star1w8LE -addstate8_r /addfinalbit; congr. -rewrite -(state200K (addstate8 st block0star1w8L)); congr; congr. -apply WArray200.ext_eq => i Hi. -rewrite get_setE 1:/# addstate8_get8E //. -case: (i = rate8-1) => E. - rewrite /block0star1w8L state_get8E 1:/# !E; congr. - by rewrite nth_cat size_nseq max_ler 1:/# ltzz. -rewrite nth_cat size_nseq max_ler 1:/#. -case: (i < rate8-1) => H. - by rewrite nth_nseq 1:/# W8.xorw0 state_get8E. -by rewrite Ring.IntID.subr_eq0 E /= state_get8E. -qed. -*) - lemma addfinalblock_r mbits st m: size mbits < 6 => size m < rate8 => @@ -745,7 +708,6 @@ by rewrite /squeezestate /squeezestate64 /rate8 state2w8L2w64L take_w64L2w8L. qed. - lemma size_pad2blocks8 mbits m: size mbits < 6 => size (pad2blocks (w8L2bits m ++ mbits)) = size m %/ rate8 + 1. @@ -808,6 +770,10 @@ by rewrite StdOrder.IntOrder.ltr_pmul2l /#. qed. + +(**************************************************************************** + Byte-oriented statefull specification of the sponge construction +****************************************************************************) module Spec = { proc f(trail_byte: W8.t, m: W8.t list, outlen: int) : W8.t list = { var result,l,st; @@ -834,6 +800,10 @@ module Spec = { } }. + +(**************************************************************************** + Equivalence between the bit-level and byte-level specs. +****************************************************************************) section. declare module IdealizedPerm: DPRIMITIVE. diff --git a/proof/impl/keccak_1600_corr.ec b/proof/impl/keccak_1600_corr.ec index 652d100..af2f020 100644 --- a/proof/impl/keccak_1600_corr.ec +++ b/proof/impl/keccak_1600_corr.ec @@ -31,11 +31,11 @@ abbrev upd8 (f: W8.t -> W8.t -> W8.t) (st:state) (i:int) (x:W8.t) = lemma upd8_state_xor8 i st l x: i = size l => 0 <= i < 200 => -(* state25 (set8 (state200 (xorstate_w8L st l)) i - (get8 (state200 (xorstate_w8L st l)) i `^` x)) *) - upd8 W8.(`^`) (xorstate_w8L st l) i x - = state_xor8 (xorstate_w8L st l) i x. -proof. by move=> Hsz Hi; rewrite /get8 xorstate_w8L_get8_out // /#. qed. +(* state25 (set8 (state200 (addstate8 st l)) i + (get8 (state200 (addstate8 st l)) i `^` x)) *) + upd8 W8.(`^`) (addstate8 st l) i x + = state_xor8 (addstate8 st l) i x. +proof. by move=> Hsz Hi; rewrite /get8 addstate8_get8E_out // /#. qed. (* SPECIFICATION OF LEAF-FUNCTIONS *) @@ -74,7 +74,7 @@ lemma add_full_block_spec_h st in_ inlen_ r8_: /\ good_ptr in_0 rate8 /\ to_uint r8 = rate8 ==> - res.`1 = xorstate_w64L st (memread64 Glob.mem (to_uint in_) rate64) + res.`1 = addstate64 st (memread64 Glob.mem (to_uint in_) rate64) /\ res.`2 = in_ + r8_ /\ res.`3 = inlen_ - r8_ ]. @@ -83,24 +83,25 @@ have Rbnds:= rate64_bnds. have Wbnds:= W64.to_uint_cmp. proc; simplify; wp; sp. while (#[4:]pre /\ to_uint r64 = rate64 /\ to_uint i <= rate64 /\ - state = xorstate_w8L st + state = addstate8 st (absorb_split (memread Glob.mem (to_uint in_) (8*to_uint i))).`1). wp; skip; rewrite ultE; progress. + by rewrite to_uintD_small of_uintK modz_small /#. - + rewrite (to_uintS_lt _ _ H3) 2!xorstate_w8L2w64L. + + rewrite (to_uintS_lt _ _ H3). rewrite /absorb_split /= !take_memread 1,2:/# !min_ler 1,2:/#. - rewrite -xorstate_w64L_rconsE 1:/#; first rewrite size_w8L2w64L size_memread /#. - rewrite -!memread64E memread64S; congr; congr; congr; congr. + rewrite -!addstate64_w8L -!memread64E memread64S 1:/#. + rewrite (addstate64_rconsE (to_uint i{hr})) ?size_memread64 1..3:/#. + rewrite addstate64_getE_out ?size_memread64 // 1:/#. rewrite to_uintD_small to_uintM of_uintK !modz_small //; smt(). skip; progress. + by rewrite to_uint_shr /#. + smt(). -+ by rewrite /absorb_split /= xorstate_w8L0. ++ by rewrite /absorb_split /= addstate8_nil. + have ->: to_uint i0 = rate64. by move: H1; rewrite -W64.uleNgt uleE to_uint_shr of_uintK //= /#. move: H5; rewrite /absorb_split /= take_oversize. by rewrite size_mkseq; smt(). - by move=>?; rewrite memread64E -xorstate_w8L2w64L. + by move=>?; rewrite memread64E -addstate64_w8L. qed. lemma add_full_block_spec_ll: islossless M.add_full_block. @@ -124,7 +125,7 @@ lemma add_full_block_spec st in_ inlen_ r8_: /\ good_ptr in_0 rate8 /\ to_uint r8 = rate8 ==> - res.`1 = xorstate_w64L st (memread64 Glob.mem (to_uint in_) rate64) + res.`1 = addstate64 st (memread64 Glob.mem (to_uint in_) rate64) /\ res.`2 = (in_ + r8_)%W64 /\ res.`3 = inlen_ - r8_ ] = 1%r. @@ -144,7 +145,7 @@ lemma add_final_block_spec_h st (in_ inlen_: W64.t) trail_byte_: /\ good_ptr in_0 (to_uint inlen_) ==> res = addfinalbit - (xorstate_w8L st + (addstate8 st (absorb_final (W8.of_int (to_uint trail_byte_)) (memread Glob.mem (to_uint in_) (to_uint inlen_)))) ]. @@ -153,43 +154,42 @@ have Rbnds:= rate64_bnds. have Wbnds:= W64.to_uint_cmp. proc; simplify. seq 4: (to_uint i = to_uint inlen_ %/ 8 /\ - state = xorstate_w64L st + state = addstate64 st (memread64 Glob.mem (to_uint in_) (to_uint inlen_ %/ 8)) /\ #[2:]pre /\ to_uint inlen8 = to_uint inlen_ %/ 8 ). while (#[/3:]post /\ to_uint i <= to_uint inlen8 /\ - state = xorstate_w64L st (memread64 Glob.mem (to_uint in_) (to_uint i))). + state = addstate64 st (memread64 Glob.mem (to_uint in_) (to_uint i))). wp; skip; rewrite !ultE; progress. by rewrite (to_uintS_lt _ _ H4) /#. - rewrite (to_uintS_lt _ _ H4) memread64S xorstate_w64L_rcons. - by rewrite size_memread64 /#. - rewrite size_memread64 1:/#; congr; congr; congr. - by rewrite to_uintD to_uintM of_uintK !modz_small //= /#. + rewrite (to_uintS_lt _ _ H4) memread64S 1:/# addstate64_rcons size_memread64 1..3:/#. + rewrite addstate64_getE_out ?size_memread64 // 1:/#. + by rewrite to_uintD_small to_uintM of_uintK !modz_small // /#. wp; skip; progress. + by rewrite to_uint_shr /#. + by rewrite to_uint_shr 1:/# /= divz_ge0 //= /#. - + by rewrite /memread64 mkseq0 xorstate_w64L0. + + by rewrite addstate64_nil. + move: H7; rewrite to_uint_shr 1:/# /= => ?. by move: H2; rewrite ultE to_uint_shr /#. + move: H7; rewrite to_uint_shr 1:/# /= => ?. move: H2; rewrite ultE to_uint_shr 1:/# /= => ?. by rewrite (: to_uint i0 = to_uint inlen{hr} %/ 8) /#. -exists* (xorstate_w64L st +exists* (addstate64 st (memread64 Glob.mem (to_uint in_) (to_uint inlen_ %/ 8))); elim* => st'. seq 2: (#[/1,4:-1]pre /\ to_uint i = to_uint inlen_ /\ - state = xorstate_w8L st + state = addstate8 st (memread Glob.mem (to_uint in_) (to_uint inlen_))). while (#[/:-2]post /\ to_uint inlen_ %/ 8 * 8 <= to_uint i <= to_uint inlen_ /\ to_uint inlen_ %/ 8 = to_uint i %/ 8 /\ - state = xorstate_w8L st (memread Glob.mem (to_uint in_) (to_uint i))). + state = addstate8 st (memread Glob.mem (to_uint in_) (to_uint i))). wp; skip; rewrite ultE => ?[[[?]]]; progress. + by rewrite (to_uintS_lt _ _ H6) /#. + by rewrite (to_uintS_lt _ _ H6) /#. + by rewrite (to_uintS_lt _ _ H6) /#. + rewrite (to_uintS_lt _ _ H6). - rewrite memreadS xorstate_w8L_rcons size_memread 1:/#. + rewrite memreadS 1:/# addstate8_rcons size_memread 1..3:/#. rewrite upd8_state_xor8 ?size_memread 1..3:/#. - by rewrite to_uintD_small 1:/#. + by rewrite to_uintD_small /#. wp; skip => ?[?]; progress. + by rewrite to_uint_shl of_uintK (modz_small 3) //= modz_small /#. + by rewrite to_uint_shl //= /#. @@ -198,20 +198,18 @@ seq 2: (#[/1,4:-1]pre /\ by rewrite -H0 (mulzC 8) w8L2w64L2state. + by move: H5; rewrite -W64.uleNgt uleE /#. + by move: H5; rewrite -W64.uleNgt uleE /#. -exists* (xorstate_w8L st (memread Glob.mem (to_uint in_) (to_uint inlen_))). +exists* (addstate8 st (memread Glob.mem (to_uint in_) (to_uint inlen_))). elim*=> st''. seq 1: (#[/:-1]pre /\ - state = state_xor_u8 st'' (to_uint inlen_) trail_byte_). + state = state_xor8 st'' (to_uint inlen_) trail_byte_). wp; skip => ?[?[[?]]]; progress. - rewrite /state_xor_u8 upd8_state_xor8 ?size_memread 1..3:/#. + rewrite upd8_state_xor8 ?size_memread 1..3:/#. by rewrite H H4. wp; skip => ?[[?[?]]] |> *. rewrite /addfinalbit /absorb_final H /state_xor_u8 /state_xor8. have ->: (to_uint (r8{hr} - W64.one)) = rate8-1. by rewrite to_uintB ?uleE /#. -rewrite cats1 -(xorstate_w8L_rconsE) 1:/#. - by rewrite size_memread /#. -smt(). +by rewrite cats1 -(addstate8_rconsE) 1:size_memread /#. qed. lemma add_final_block_spec_ll: islossless M.add_final_block. @@ -241,7 +239,7 @@ lemma add_final_block_spec st (in_ inlen_: W64.t) trail_byte_: /\ good_ptr in_0 (to_uint inlen_) ==> res = addfinalbit - (xorstate_w8L st + (addstate8 st (absorb_final (W8.of_int (to_uint trail_byte_)) (memread Glob.mem (to_uint in_) (to_uint inlen_)))) ] = 1%r. From 1badc202aace2df94f07c440d1d9e10bba2edb62 Mon Sep 17 00:00:00 2001 From: Manuel Barbosa Date: Tue, 21 May 2019 23:09:18 +0100 Subject: [PATCH 434/525] constant-time proofs --- proof/impl/libc/keccak_1600_avx2_CT.ec | 2544 ++++++++++++++++++++++ proof/impl/libc/keccak_1600_scalar_CT.ec | 1564 +++++++++++++ 2 files changed, 4108 insertions(+) create mode 100644 proof/impl/libc/keccak_1600_avx2_CT.ec create mode 100644 proof/impl/libc/keccak_1600_scalar_CT.ec diff --git a/proof/impl/libc/keccak_1600_avx2_CT.ec b/proof/impl/libc/keccak_1600_avx2_CT.ec new file mode 100644 index 0000000..13cc51f --- /dev/null +++ b/proof/impl/libc/keccak_1600_avx2_CT.ec @@ -0,0 +1,2544 @@ +require import List Int IntExtra IntDiv CoreMap. +from Jasmin require import JModel. + +require import Array7 Array9 Array28. +require import WArray224 WArray288. + +abbrev g_zero = W64.of_int 0. + + +module M = { + var leakages : leakages_t + + proc __keccak_f1600_avx2 (state:W256.t Array7.t, _rhotates_left:W64.t, + _rhotates_right:W64.t, _iotas:W64.t) : W256.t Array7.t = { + var aux_5: bool; + var aux_4: bool; + var aux_3: bool; + var aux_2: bool; + var aux_0: W32.t; + var aux: W64.t; + var aux_1: W256.t; + + var rhotates_left:W64.t; + var rhotates_right:W64.t; + var iotas:W64.t; + var r:W32.t; + var zf:bool; + var c00:W256.t; + var c14:W256.t; + var t:W256.t Array9.t; + var d14:W256.t; + var d00:W256.t; + var _0:bool; + var _1:bool; + var _2:bool; + t <- witness; + leakages <- LeakAddr([]) :: leakages; + aux <- (_rhotates_left + (W64.of_int 96)); + rhotates_left <- aux; + leakages <- LeakAddr([]) :: leakages; + aux <- (_rhotates_right + (W64.of_int 96)); + rhotates_right <- aux; + leakages <- LeakAddr([]) :: leakages; + aux <- _iotas; + iotas <- aux; + leakages <- LeakAddr([]) :: leakages; + aux_0 <- (W32.of_int 24); + r <- aux_0; + leakages <- LeakAddr([2]) :: leakages; + aux_1 <- x86_VPSHUFD_256 state.[2] + (W8.of_int (2 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 1)))); + c00 <- aux_1; + leakages <- LeakAddr([3; 5]) :: leakages; + aux_1 <- (state.[5] `^` state.[3]); + c14 <- aux_1; + leakages <- LeakAddr([6; 4]) :: leakages; + aux_1 <- (state.[4] `^` state.[6]); + leakages <- LeakAddr([2]) :: leakages; + t.[2] <- aux_1; + leakages <- LeakAddr([1]) :: leakages; + aux_1 <- (c14 `^` state.[1]); + c14 <- aux_1; + leakages <- LeakAddr([2]) :: leakages; + aux_1 <- (c14 `^` t.[2]); + c14 <- aux_1; + leakages <- LeakAddr([]) :: leakages; + aux_1 <- x86_VPERMQ c14 + (W8.of_int (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (1 %% 2^2 + 2^2 * 2)))); + leakages <- LeakAddr([4]) :: leakages; + t.[4] <- aux_1; + leakages <- LeakAddr([2]) :: leakages; + aux_1 <- (c00 `^` state.[2]); + c00 <- aux_1; + leakages <- LeakAddr([]) :: leakages; + aux_1 <- x86_VPERMQ c00 + (W8.of_int (2 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 1)))); + leakages <- LeakAddr([0]) :: leakages; + t.[0] <- aux_1; + leakages <- LeakAddr([]) :: leakages; + aux_1 <- (c14 \vshr64u256 (W8.of_int 63)); + leakages <- LeakAddr([1]) :: leakages; + t.[1] <- aux_1; + leakages <- LeakAddr([]) :: leakages; + aux_1 <- (c14 \vadd64u256 c14); + leakages <- LeakAddr([2]) :: leakages; + t.[2] <- aux_1; + leakages <- LeakAddr([2; 1]) :: leakages; + aux_1 <- (t.[1] `|` t.[2]); + leakages <- LeakAddr([1]) :: leakages; + t.[1] <- aux_1; + leakages <- LeakAddr([1]) :: leakages; + aux_1 <- x86_VPERMQ t.[1] + (W8.of_int (1 %% 2^2 + 2^2 * (2 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + d14 <- aux_1; + leakages <- LeakAddr([4; 1]) :: leakages; + aux_1 <- (t.[1] `^` t.[4]); + d00 <- aux_1; + leakages <- LeakAddr([]) :: leakages; + aux_1 <- x86_VPERMQ d00 + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + d00 <- aux_1; + leakages <- LeakAddr([0]) :: leakages; + aux_1 <- (c00 `^` state.[0]); + c00 <- aux_1; + leakages <- LeakAddr([0]) :: leakages; + aux_1 <- (c00 `^` t.[0]); + c00 <- aux_1; + leakages <- LeakAddr([]) :: leakages; + aux_1 <- (c00 \vshr64u256 (W8.of_int 63)); + leakages <- LeakAddr([0]) :: leakages; + t.[0] <- aux_1; + leakages <- LeakAddr([]) :: leakages; + aux_1 <- (c00 \vadd64u256 c00); + leakages <- LeakAddr([1]) :: leakages; + t.[1] <- aux_1; + leakages <- LeakAddr([0; 1]) :: leakages; + aux_1 <- (t.[1] `|` t.[0]); + leakages <- LeakAddr([1]) :: leakages; + t.[1] <- aux_1; + leakages <- LeakAddr([2]) :: leakages; + aux_1 <- (state.[2] `^` d00); + leakages <- LeakAddr([2]) :: leakages; + state.[2] <- aux_1; + leakages <- LeakAddr([0]) :: leakages; + aux_1 <- (state.[0] `^` d00); + leakages <- LeakAddr([0]) :: leakages; + state.[0] <- aux_1; + leakages <- LeakAddr([1]) :: leakages; + aux_1 <- x86_VPBLENDD_256 d14 t.[1] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + d14 <- aux_1; + leakages <- LeakAddr([4]) :: leakages; + aux_1 <- x86_VPBLENDD_256 t.[4] c00 + (W8.of_int (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + leakages <- LeakAddr([4]) :: leakages; + t.[4] <- aux_1; + leakages <- LeakAddr([4]) :: leakages; + aux_1 <- (d14 `^` t.[4]); + d14 <- aux_1; + leakages <- LeakAddr([(W64.to_uint (rhotates_left + (W64.of_int ((32 * 0) - 96)))); + 2]) :: leakages; + aux_1 <- x86_VPSLLV_4u64 state.[2] + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((32 * 0) - 96))))); + leakages <- LeakAddr([3]) :: leakages; + t.[3] <- aux_1; + leakages <- LeakAddr([(W64.to_uint (rhotates_right + (W64.of_int ((32 * 0) - 96)))); + 2]) :: leakages; + aux_1 <- x86_VPSRLV_4u64 state.[2] + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((32 * 0) - 96))))); + leakages <- LeakAddr([2]) :: leakages; + state.[2] <- aux_1; + leakages <- LeakAddr([3; 2]) :: leakages; + aux_1 <- (state.[2] `|` t.[3]); + leakages <- LeakAddr([2]) :: leakages; + state.[2] <- aux_1; + leakages <- LeakAddr([3]) :: leakages; + aux_1 <- (state.[3] `^` d14); + leakages <- LeakAddr([3]) :: leakages; + state.[3] <- aux_1; + leakages <- LeakAddr([(W64.to_uint (rhotates_left + (W64.of_int ((32 * 2) - 96)))); + 3]) :: leakages; + aux_1 <- x86_VPSLLV_4u64 state.[3] + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((32 * 2) - 96))))); + leakages <- LeakAddr([4]) :: leakages; + t.[4] <- aux_1; + leakages <- LeakAddr([(W64.to_uint (rhotates_right + (W64.of_int ((32 * 2) - 96)))); + 3]) :: leakages; + aux_1 <- x86_VPSRLV_4u64 state.[3] + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((32 * 2) - 96))))); + leakages <- LeakAddr([3]) :: leakages; + state.[3] <- aux_1; + leakages <- LeakAddr([4; 3]) :: leakages; + aux_1 <- (state.[3] `|` t.[4]); + leakages <- LeakAddr([3]) :: leakages; + state.[3] <- aux_1; + leakages <- LeakAddr([4]) :: leakages; + aux_1 <- (state.[4] `^` d14); + leakages <- LeakAddr([4]) :: leakages; + state.[4] <- aux_1; + leakages <- LeakAddr([(W64.to_uint (rhotates_left + (W64.of_int ((32 * 3) - 96)))); + 4]) :: leakages; + aux_1 <- x86_VPSLLV_4u64 state.[4] + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((32 * 3) - 96))))); + leakages <- LeakAddr([5]) :: leakages; + t.[5] <- aux_1; + leakages <- LeakAddr([(W64.to_uint (rhotates_right + (W64.of_int ((32 * 3) - 96)))); + 4]) :: leakages; + aux_1 <- x86_VPSRLV_4u64 state.[4] + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((32 * 3) - 96))))); + leakages <- LeakAddr([4]) :: leakages; + state.[4] <- aux_1; + leakages <- LeakAddr([5; 4]) :: leakages; + aux_1 <- (state.[4] `|` t.[5]); + leakages <- LeakAddr([4]) :: leakages; + state.[4] <- aux_1; + leakages <- LeakAddr([5]) :: leakages; + aux_1 <- (state.[5] `^` d14); + leakages <- LeakAddr([5]) :: leakages; + state.[5] <- aux_1; + leakages <- LeakAddr([(W64.to_uint (rhotates_left + (W64.of_int ((32 * 4) - 96)))); + 5]) :: leakages; + aux_1 <- x86_VPSLLV_4u64 state.[5] + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((32 * 4) - 96))))); + leakages <- LeakAddr([6]) :: leakages; + t.[6] <- aux_1; + leakages <- LeakAddr([(W64.to_uint (rhotates_right + (W64.of_int ((32 * 4) - 96)))); + 5]) :: leakages; + aux_1 <- x86_VPSRLV_4u64 state.[5] + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((32 * 4) - 96))))); + leakages <- LeakAddr([5]) :: leakages; + state.[5] <- aux_1; + leakages <- LeakAddr([6; 5]) :: leakages; + aux_1 <- (state.[5] `|` t.[6]); + leakages <- LeakAddr([5]) :: leakages; + state.[5] <- aux_1; + leakages <- LeakAddr([6]) :: leakages; + aux_1 <- (state.[6] `^` d14); + leakages <- LeakAddr([6]) :: leakages; + state.[6] <- aux_1; + leakages <- LeakAddr([2]) :: leakages; + aux_1 <- x86_VPERMQ state.[2] + (W8.of_int (1 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 2)))); + leakages <- LeakAddr([3]) :: leakages; + t.[3] <- aux_1; + leakages <- LeakAddr([3]) :: leakages; + aux_1 <- x86_VPERMQ state.[3] + (W8.of_int (1 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 2)))); + leakages <- LeakAddr([4]) :: leakages; + t.[4] <- aux_1; + leakages <- LeakAddr([(W64.to_uint (rhotates_left + (W64.of_int ((32 * 5) - 96)))); + 6]) :: leakages; + aux_1 <- x86_VPSLLV_4u64 state.[6] + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((32 * 5) - 96))))); + leakages <- LeakAddr([7]) :: leakages; + t.[7] <- aux_1; + leakages <- LeakAddr([(W64.to_uint (rhotates_right + (W64.of_int ((32 * 5) - 96)))); + 6]) :: leakages; + aux_1 <- x86_VPSRLV_4u64 state.[6] + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((32 * 5) - 96))))); + leakages <- LeakAddr([1]) :: leakages; + t.[1] <- aux_1; + leakages <- LeakAddr([7; 1]) :: leakages; + aux_1 <- (t.[1] `|` t.[7]); + leakages <- LeakAddr([1]) :: leakages; + t.[1] <- aux_1; + leakages <- LeakAddr([1]) :: leakages; + aux_1 <- (state.[1] `^` d14); + leakages <- LeakAddr([1]) :: leakages; + state.[1] <- aux_1; + leakages <- LeakAddr([4]) :: leakages; + aux_1 <- x86_VPERMQ state.[4] + (W8.of_int (3 %% 2^2 + 2^2 * (2 %% 2^2 + 2^2 * (1 %% 2^2 + 2^2 * 0)))); + leakages <- LeakAddr([5]) :: leakages; + t.[5] <- aux_1; + leakages <- LeakAddr([5]) :: leakages; + aux_1 <- x86_VPERMQ state.[5] + (W8.of_int (2 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 1)))); + leakages <- LeakAddr([6]) :: leakages; + t.[6] <- aux_1; + leakages <- LeakAddr([(W64.to_uint (rhotates_left + (W64.of_int ((32 * 1) - 96)))); + 1]) :: leakages; + aux_1 <- x86_VPSLLV_4u64 state.[1] + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((32 * 1) - 96))))); + leakages <- LeakAddr([8]) :: leakages; + t.[8] <- aux_1; + leakages <- LeakAddr([(W64.to_uint (rhotates_right + (W64.of_int ((32 * 1) - 96)))); + 1]) :: leakages; + aux_1 <- x86_VPSRLV_4u64 state.[1] + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((32 * 1) - 96))))); + leakages <- LeakAddr([2]) :: leakages; + t.[2] <- aux_1; + leakages <- LeakAddr([8; 2]) :: leakages; + aux_1 <- (t.[2] `|` t.[8]); + leakages <- LeakAddr([2]) :: leakages; + t.[2] <- aux_1; + leakages <- LeakAddr([1]) :: leakages; + aux_1 <- x86_VPSRLDQ_256 t.[1] (W8.of_int 8); + leakages <- LeakAddr([7]) :: leakages; + t.[7] <- aux_1; + leakages <- LeakAddr([7; 1]) :: leakages; + aux_1 <- ((invw t.[1]) `&` t.[7]); + leakages <- LeakAddr([0]) :: leakages; + t.[0] <- aux_1; + leakages <- LeakAddr([6; 2]) :: leakages; + aux_1 <- x86_VPBLENDD_256 t.[2] t.[6] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + leakages <- LeakAddr([3]) :: leakages; + state.[3] <- aux_1; + leakages <- LeakAddr([2; 4]) :: leakages; + aux_1 <- x86_VPBLENDD_256 t.[4] t.[2] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + leakages <- LeakAddr([8]) :: leakages; + t.[8] <- aux_1; + leakages <- LeakAddr([4; 3]) :: leakages; + aux_1 <- x86_VPBLENDD_256 t.[3] t.[4] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + leakages <- LeakAddr([5]) :: leakages; + state.[5] <- aux_1; + leakages <- LeakAddr([3; 2]) :: leakages; + aux_1 <- x86_VPBLENDD_256 t.[2] t.[3] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + leakages <- LeakAddr([7]) :: leakages; + t.[7] <- aux_1; + leakages <- LeakAddr([4; 3]) :: leakages; + aux_1 <- x86_VPBLENDD_256 state.[3] t.[4] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + leakages <- LeakAddr([3]) :: leakages; + state.[3] <- aux_1; + leakages <- LeakAddr([5; 8]) :: leakages; + aux_1 <- x86_VPBLENDD_256 t.[8] t.[5] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + leakages <- LeakAddr([8]) :: leakages; + t.[8] <- aux_1; + leakages <- LeakAddr([2; 5]) :: leakages; + aux_1 <- x86_VPBLENDD_256 state.[5] t.[2] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + leakages <- LeakAddr([5]) :: leakages; + state.[5] <- aux_1; + leakages <- LeakAddr([6; 7]) :: leakages; + aux_1 <- x86_VPBLENDD_256 t.[7] t.[6] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + leakages <- LeakAddr([7]) :: leakages; + t.[7] <- aux_1; + leakages <- LeakAddr([5; 3]) :: leakages; + aux_1 <- x86_VPBLENDD_256 state.[3] t.[5] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + leakages <- LeakAddr([3]) :: leakages; + state.[3] <- aux_1; + leakages <- LeakAddr([6; 8]) :: leakages; + aux_1 <- x86_VPBLENDD_256 t.[8] t.[6] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + leakages <- LeakAddr([8]) :: leakages; + t.[8] <- aux_1; + leakages <- LeakAddr([6; 5]) :: leakages; + aux_1 <- x86_VPBLENDD_256 state.[5] t.[6] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + leakages <- LeakAddr([5]) :: leakages; + state.[5] <- aux_1; + leakages <- LeakAddr([4; 7]) :: leakages; + aux_1 <- x86_VPBLENDD_256 t.[7] t.[4] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + leakages <- LeakAddr([7]) :: leakages; + t.[7] <- aux_1; + leakages <- LeakAddr([8; 3]) :: leakages; + aux_1 <- ((invw state.[3]) `&` t.[8]); + leakages <- LeakAddr([3]) :: leakages; + state.[3] <- aux_1; + leakages <- LeakAddr([7; 5]) :: leakages; + aux_1 <- ((invw state.[5]) `&` t.[7]); + leakages <- LeakAddr([5]) :: leakages; + state.[5] <- aux_1; + leakages <- LeakAddr([2; 5]) :: leakages; + aux_1 <- x86_VPBLENDD_256 t.[5] t.[2] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + leakages <- LeakAddr([6]) :: leakages; + state.[6] <- aux_1; + leakages <- LeakAddr([5; 3]) :: leakages; + aux_1 <- x86_VPBLENDD_256 t.[3] t.[5] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + leakages <- LeakAddr([8]) :: leakages; + t.[8] <- aux_1; + leakages <- LeakAddr([3; 3]) :: leakages; + aux_1 <- (state.[3] `^` t.[3]); + leakages <- LeakAddr([3]) :: leakages; + state.[3] <- aux_1; + leakages <- LeakAddr([3; 6]) :: leakages; + aux_1 <- x86_VPBLENDD_256 state.[6] t.[3] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + leakages <- LeakAddr([6]) :: leakages; + state.[6] <- aux_1; + leakages <- LeakAddr([4; 8]) :: leakages; + aux_1 <- x86_VPBLENDD_256 t.[8] t.[4] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + leakages <- LeakAddr([8]) :: leakages; + t.[8] <- aux_1; + leakages <- LeakAddr([5; 5]) :: leakages; + aux_1 <- (state.[5] `^` t.[5]); + leakages <- LeakAddr([5]) :: leakages; + state.[5] <- aux_1; + leakages <- LeakAddr([4; 6]) :: leakages; + aux_1 <- x86_VPBLENDD_256 state.[6] t.[4] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + leakages <- LeakAddr([6]) :: leakages; + state.[6] <- aux_1; + leakages <- LeakAddr([2; 8]) :: leakages; + aux_1 <- x86_VPBLENDD_256 t.[8] t.[2] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + leakages <- LeakAddr([8]) :: leakages; + t.[8] <- aux_1; + leakages <- LeakAddr([8; 6]) :: leakages; + aux_1 <- ((invw state.[6]) `&` t.[8]); + leakages <- LeakAddr([6]) :: leakages; + state.[6] <- aux_1; + leakages <- LeakAddr([6; 6]) :: leakages; + aux_1 <- (state.[6] `^` t.[6]); + leakages <- LeakAddr([6]) :: leakages; + state.[6] <- aux_1; + leakages <- LeakAddr([1]) :: leakages; + aux_1 <- x86_VPERMQ t.[1] + (W8.of_int (2 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (1 %% 2^2 + 2^2 * 0)))); + leakages <- LeakAddr([4]) :: leakages; + state.[4] <- aux_1; + leakages <- LeakAddr([0; 4]) :: leakages; + aux_1 <- x86_VPBLENDD_256 state.[4] state.[0] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + leakages <- LeakAddr([8]) :: leakages; + t.[8] <- aux_1; + leakages <- LeakAddr([1]) :: leakages; + aux_1 <- x86_VPERMQ t.[1] + (W8.of_int (1 %% 2^2 + 2^2 * (2 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + leakages <- LeakAddr([1]) :: leakages; + state.[1] <- aux_1; + leakages <- LeakAddr([0; 1]) :: leakages; + aux_1 <- x86_VPBLENDD_256 state.[1] state.[0] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + leakages <- LeakAddr([1]) :: leakages; + state.[1] <- aux_1; + leakages <- LeakAddr([8; 1]) :: leakages; + aux_1 <- ((invw state.[1]) `&` t.[8]); + leakages <- LeakAddr([1]) :: leakages; + state.[1] <- aux_1; + leakages <- LeakAddr([5; 4]) :: leakages; + aux_1 <- x86_VPBLENDD_256 t.[4] t.[5] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + leakages <- LeakAddr([2]) :: leakages; + state.[2] <- aux_1; + leakages <- LeakAddr([4; 6]) :: leakages; + aux_1 <- x86_VPBLENDD_256 t.[6] t.[4] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + leakages <- LeakAddr([7]) :: leakages; + t.[7] <- aux_1; + leakages <- LeakAddr([6; 2]) :: leakages; + aux_1 <- x86_VPBLENDD_256 state.[2] t.[6] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + leakages <- LeakAddr([2]) :: leakages; + state.[2] <- aux_1; + leakages <- LeakAddr([3; 7]) :: leakages; + aux_1 <- x86_VPBLENDD_256 t.[7] t.[3] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + leakages <- LeakAddr([7]) :: leakages; + t.[7] <- aux_1; + leakages <- LeakAddr([3; 2]) :: leakages; + aux_1 <- x86_VPBLENDD_256 state.[2] t.[3] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + leakages <- LeakAddr([2]) :: leakages; + state.[2] <- aux_1; + leakages <- LeakAddr([5; 7]) :: leakages; + aux_1 <- x86_VPBLENDD_256 t.[7] t.[5] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + leakages <- LeakAddr([7]) :: leakages; + t.[7] <- aux_1; + leakages <- LeakAddr([7; 2]) :: leakages; + aux_1 <- ((invw state.[2]) `&` t.[7]); + leakages <- LeakAddr([2]) :: leakages; + state.[2] <- aux_1; + leakages <- LeakAddr([2; 2]) :: leakages; + aux_1 <- (state.[2] `^` t.[2]); + leakages <- LeakAddr([2]) :: leakages; + state.[2] <- aux_1; + leakages <- LeakAddr([0]) :: leakages; + aux_1 <- x86_VPERMQ t.[0] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + leakages <- LeakAddr([0]) :: leakages; + t.[0] <- aux_1; + leakages <- LeakAddr([3]) :: leakages; + aux_1 <- x86_VPERMQ state.[3] + (W8.of_int (3 %% 2^2 + 2^2 * (2 %% 2^2 + 2^2 * (1 %% 2^2 + 2^2 * 0)))); + leakages <- LeakAddr([3]) :: leakages; + state.[3] <- aux_1; + leakages <- LeakAddr([5]) :: leakages; + aux_1 <- x86_VPERMQ state.[5] + (W8.of_int (1 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 2)))); + leakages <- LeakAddr([5]) :: leakages; + state.[5] <- aux_1; + leakages <- LeakAddr([6]) :: leakages; + aux_1 <- x86_VPERMQ state.[6] + (W8.of_int (2 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 1)))); + leakages <- LeakAddr([6]) :: leakages; + state.[6] <- aux_1; + leakages <- LeakAddr([3; 6]) :: leakages; + aux_1 <- x86_VPBLENDD_256 t.[6] t.[3] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + leakages <- LeakAddr([4]) :: leakages; + state.[4] <- aux_1; + leakages <- LeakAddr([6; 5]) :: leakages; + aux_1 <- x86_VPBLENDD_256 t.[5] t.[6] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + leakages <- LeakAddr([7]) :: leakages; + t.[7] <- aux_1; + leakages <- LeakAddr([5; 4]) :: leakages; + aux_1 <- x86_VPBLENDD_256 state.[4] t.[5] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + leakages <- LeakAddr([4]) :: leakages; + state.[4] <- aux_1; + leakages <- LeakAddr([2; 7]) :: leakages; + aux_1 <- x86_VPBLENDD_256 t.[7] t.[2] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + leakages <- LeakAddr([7]) :: leakages; + t.[7] <- aux_1; + leakages <- LeakAddr([2; 4]) :: leakages; + aux_1 <- x86_VPBLENDD_256 state.[4] t.[2] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + leakages <- LeakAddr([4]) :: leakages; + state.[4] <- aux_1; + leakages <- LeakAddr([3; 7]) :: leakages; + aux_1 <- x86_VPBLENDD_256 t.[7] t.[3] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + leakages <- LeakAddr([7]) :: leakages; + t.[7] <- aux_1; + leakages <- LeakAddr([7; 4]) :: leakages; + aux_1 <- ((invw state.[4]) `&` t.[7]); + leakages <- LeakAddr([4]) :: leakages; + state.[4] <- aux_1; + leakages <- LeakAddr([0; 0]) :: leakages; + aux_1 <- (state.[0] `^` t.[0]); + leakages <- LeakAddr([0]) :: leakages; + state.[0] <- aux_1; + leakages <- LeakAddr([1; 1]) :: leakages; + aux_1 <- (state.[1] `^` t.[1]); + leakages <- LeakAddr([1]) :: leakages; + state.[1] <- aux_1; + leakages <- LeakAddr([4; 4]) :: leakages; + aux_1 <- (state.[4] `^` t.[4]); + leakages <- LeakAddr([4]) :: leakages; + state.[4] <- aux_1; + leakages <- LeakAddr([(W64.to_uint (iotas + (W64.of_int ((32 * 0) - 0)))); + 0]) :: leakages; + aux_1 <- (state.[0] `^` (loadW256 Glob.mem (W64.to_uint (iotas + (W64.of_int ((32 * 0) - 0)))))); + leakages <- LeakAddr([0]) :: leakages; + state.[0] <- aux_1; + leakages <- LeakAddr([]) :: leakages; + aux <- (iotas + (W64.of_int 32)); + iotas <- aux; + leakages <- LeakAddr([]) :: leakages; + (aux_5, aux_4, aux_3, aux_2, aux_0) <- x86_DEC_32 r; + _0 <- aux_5; + _1 <- aux_4; + _2 <- aux_3; + zf <- aux_2; + r <- aux_0; + leakages <- LeakCond((! zf)) :: LeakAddr([]) :: leakages; + + while ((! zf)) { + leakages <- LeakAddr([2]) :: leakages; + aux_1 <- x86_VPSHUFD_256 state.[2] + (W8.of_int (2 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 1)))); + c00 <- aux_1; + leakages <- LeakAddr([3; 5]) :: leakages; + aux_1 <- (state.[5] `^` state.[3]); + c14 <- aux_1; + leakages <- LeakAddr([6; 4]) :: leakages; + aux_1 <- (state.[4] `^` state.[6]); + leakages <- LeakAddr([2]) :: leakages; + t.[2] <- aux_1; + leakages <- LeakAddr([1]) :: leakages; + aux_1 <- (c14 `^` state.[1]); + c14 <- aux_1; + leakages <- LeakAddr([2]) :: leakages; + aux_1 <- (c14 `^` t.[2]); + c14 <- aux_1; + leakages <- LeakAddr([]) :: leakages; + aux_1 <- x86_VPERMQ c14 + (W8.of_int (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (1 %% 2^2 + 2^2 * 2)))); + leakages <- LeakAddr([4]) :: leakages; + t.[4] <- aux_1; + leakages <- LeakAddr([2]) :: leakages; + aux_1 <- (c00 `^` state.[2]); + c00 <- aux_1; + leakages <- LeakAddr([]) :: leakages; + aux_1 <- x86_VPERMQ c00 + (W8.of_int (2 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 1)))); + leakages <- LeakAddr([0]) :: leakages; + t.[0] <- aux_1; + leakages <- LeakAddr([]) :: leakages; + aux_1 <- (c14 \vshr64u256 (W8.of_int 63)); + leakages <- LeakAddr([1]) :: leakages; + t.[1] <- aux_1; + leakages <- LeakAddr([]) :: leakages; + aux_1 <- (c14 \vadd64u256 c14); + leakages <- LeakAddr([2]) :: leakages; + t.[2] <- aux_1; + leakages <- LeakAddr([2; 1]) :: leakages; + aux_1 <- (t.[1] `|` t.[2]); + leakages <- LeakAddr([1]) :: leakages; + t.[1] <- aux_1; + leakages <- LeakAddr([1]) :: leakages; + aux_1 <- x86_VPERMQ t.[1] + (W8.of_int (1 %% 2^2 + 2^2 * (2 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + d14 <- aux_1; + leakages <- LeakAddr([4; 1]) :: leakages; + aux_1 <- (t.[1] `^` t.[4]); + d00 <- aux_1; + leakages <- LeakAddr([]) :: leakages; + aux_1 <- x86_VPERMQ d00 + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + d00 <- aux_1; + leakages <- LeakAddr([0]) :: leakages; + aux_1 <- (c00 `^` state.[0]); + c00 <- aux_1; + leakages <- LeakAddr([0]) :: leakages; + aux_1 <- (c00 `^` t.[0]); + c00 <- aux_1; + leakages <- LeakAddr([]) :: leakages; + aux_1 <- (c00 \vshr64u256 (W8.of_int 63)); + leakages <- LeakAddr([0]) :: leakages; + t.[0] <- aux_1; + leakages <- LeakAddr([]) :: leakages; + aux_1 <- (c00 \vadd64u256 c00); + leakages <- LeakAddr([1]) :: leakages; + t.[1] <- aux_1; + leakages <- LeakAddr([0; 1]) :: leakages; + aux_1 <- (t.[1] `|` t.[0]); + leakages <- LeakAddr([1]) :: leakages; + t.[1] <- aux_1; + leakages <- LeakAddr([2]) :: leakages; + aux_1 <- (state.[2] `^` d00); + leakages <- LeakAddr([2]) :: leakages; + state.[2] <- aux_1; + leakages <- LeakAddr([0]) :: leakages; + aux_1 <- (state.[0] `^` d00); + leakages <- LeakAddr([0]) :: leakages; + state.[0] <- aux_1; + leakages <- LeakAddr([1]) :: leakages; + aux_1 <- x86_VPBLENDD_256 d14 t.[1] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + d14 <- aux_1; + leakages <- LeakAddr([4]) :: leakages; + aux_1 <- x86_VPBLENDD_256 t.[4] c00 + (W8.of_int (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + leakages <- LeakAddr([4]) :: leakages; + t.[4] <- aux_1; + leakages <- LeakAddr([4]) :: leakages; + aux_1 <- (d14 `^` t.[4]); + d14 <- aux_1; + leakages <- LeakAddr([(W64.to_uint (rhotates_left + (W64.of_int ((32 * 0) - 96)))); + 2]) :: leakages; + aux_1 <- x86_VPSLLV_4u64 state.[2] + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((32 * 0) - 96))))); + leakages <- LeakAddr([3]) :: leakages; + t.[3] <- aux_1; + leakages <- LeakAddr([(W64.to_uint (rhotates_right + (W64.of_int ((32 * 0) - 96)))); + 2]) :: leakages; + aux_1 <- x86_VPSRLV_4u64 state.[2] + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((32 * 0) - 96))))); + leakages <- LeakAddr([2]) :: leakages; + state.[2] <- aux_1; + leakages <- LeakAddr([3; 2]) :: leakages; + aux_1 <- (state.[2] `|` t.[3]); + leakages <- LeakAddr([2]) :: leakages; + state.[2] <- aux_1; + leakages <- LeakAddr([3]) :: leakages; + aux_1 <- (state.[3] `^` d14); + leakages <- LeakAddr([3]) :: leakages; + state.[3] <- aux_1; + leakages <- LeakAddr([(W64.to_uint (rhotates_left + (W64.of_int ((32 * 2) - 96)))); + 3]) :: leakages; + aux_1 <- x86_VPSLLV_4u64 state.[3] + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((32 * 2) - 96))))); + leakages <- LeakAddr([4]) :: leakages; + t.[4] <- aux_1; + leakages <- LeakAddr([(W64.to_uint (rhotates_right + (W64.of_int ((32 * 2) - 96)))); + 3]) :: leakages; + aux_1 <- x86_VPSRLV_4u64 state.[3] + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((32 * 2) - 96))))); + leakages <- LeakAddr([3]) :: leakages; + state.[3] <- aux_1; + leakages <- LeakAddr([4; 3]) :: leakages; + aux_1 <- (state.[3] `|` t.[4]); + leakages <- LeakAddr([3]) :: leakages; + state.[3] <- aux_1; + leakages <- LeakAddr([4]) :: leakages; + aux_1 <- (state.[4] `^` d14); + leakages <- LeakAddr([4]) :: leakages; + state.[4] <- aux_1; + leakages <- LeakAddr([(W64.to_uint (rhotates_left + (W64.of_int ((32 * 3) - 96)))); + 4]) :: leakages; + aux_1 <- x86_VPSLLV_4u64 state.[4] + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((32 * 3) - 96))))); + leakages <- LeakAddr([5]) :: leakages; + t.[5] <- aux_1; + leakages <- LeakAddr([(W64.to_uint (rhotates_right + (W64.of_int ((32 * 3) - 96)))); + 4]) :: leakages; + aux_1 <- x86_VPSRLV_4u64 state.[4] + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((32 * 3) - 96))))); + leakages <- LeakAddr([4]) :: leakages; + state.[4] <- aux_1; + leakages <- LeakAddr([5; 4]) :: leakages; + aux_1 <- (state.[4] `|` t.[5]); + leakages <- LeakAddr([4]) :: leakages; + state.[4] <- aux_1; + leakages <- LeakAddr([5]) :: leakages; + aux_1 <- (state.[5] `^` d14); + leakages <- LeakAddr([5]) :: leakages; + state.[5] <- aux_1; + leakages <- LeakAddr([(W64.to_uint (rhotates_left + (W64.of_int ((32 * 4) - 96)))); + 5]) :: leakages; + aux_1 <- x86_VPSLLV_4u64 state.[5] + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((32 * 4) - 96))))); + leakages <- LeakAddr([6]) :: leakages; + t.[6] <- aux_1; + leakages <- LeakAddr([(W64.to_uint (rhotates_right + (W64.of_int ((32 * 4) - 96)))); + 5]) :: leakages; + aux_1 <- x86_VPSRLV_4u64 state.[5] + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((32 * 4) - 96))))); + leakages <- LeakAddr([5]) :: leakages; + state.[5] <- aux_1; + leakages <- LeakAddr([6; 5]) :: leakages; + aux_1 <- (state.[5] `|` t.[6]); + leakages <- LeakAddr([5]) :: leakages; + state.[5] <- aux_1; + leakages <- LeakAddr([6]) :: leakages; + aux_1 <- (state.[6] `^` d14); + leakages <- LeakAddr([6]) :: leakages; + state.[6] <- aux_1; + leakages <- LeakAddr([2]) :: leakages; + aux_1 <- x86_VPERMQ state.[2] + (W8.of_int (1 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 2)))); + leakages <- LeakAddr([3]) :: leakages; + t.[3] <- aux_1; + leakages <- LeakAddr([3]) :: leakages; + aux_1 <- x86_VPERMQ state.[3] + (W8.of_int (1 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 2)))); + leakages <- LeakAddr([4]) :: leakages; + t.[4] <- aux_1; + leakages <- LeakAddr([(W64.to_uint (rhotates_left + (W64.of_int ((32 * 5) - 96)))); + 6]) :: leakages; + aux_1 <- x86_VPSLLV_4u64 state.[6] + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((32 * 5) - 96))))); + leakages <- LeakAddr([7]) :: leakages; + t.[7] <- aux_1; + leakages <- LeakAddr([(W64.to_uint (rhotates_right + (W64.of_int ((32 * 5) - 96)))); + 6]) :: leakages; + aux_1 <- x86_VPSRLV_4u64 state.[6] + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((32 * 5) - 96))))); + leakages <- LeakAddr([1]) :: leakages; + t.[1] <- aux_1; + leakages <- LeakAddr([7; 1]) :: leakages; + aux_1 <- (t.[1] `|` t.[7]); + leakages <- LeakAddr([1]) :: leakages; + t.[1] <- aux_1; + leakages <- LeakAddr([1]) :: leakages; + aux_1 <- (state.[1] `^` d14); + leakages <- LeakAddr([1]) :: leakages; + state.[1] <- aux_1; + leakages <- LeakAddr([4]) :: leakages; + aux_1 <- x86_VPERMQ state.[4] + (W8.of_int (3 %% 2^2 + 2^2 * (2 %% 2^2 + 2^2 * (1 %% 2^2 + 2^2 * 0)))); + leakages <- LeakAddr([5]) :: leakages; + t.[5] <- aux_1; + leakages <- LeakAddr([5]) :: leakages; + aux_1 <- x86_VPERMQ state.[5] + (W8.of_int (2 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 1)))); + leakages <- LeakAddr([6]) :: leakages; + t.[6] <- aux_1; + leakages <- LeakAddr([(W64.to_uint (rhotates_left + (W64.of_int ((32 * 1) - 96)))); + 1]) :: leakages; + aux_1 <- x86_VPSLLV_4u64 state.[1] + (loadW256 Glob.mem (W64.to_uint (rhotates_left + (W64.of_int ((32 * 1) - 96))))); + leakages <- LeakAddr([8]) :: leakages; + t.[8] <- aux_1; + leakages <- LeakAddr([(W64.to_uint (rhotates_right + (W64.of_int ((32 * 1) - 96)))); + 1]) :: leakages; + aux_1 <- x86_VPSRLV_4u64 state.[1] + (loadW256 Glob.mem (W64.to_uint (rhotates_right + (W64.of_int ((32 * 1) - 96))))); + leakages <- LeakAddr([2]) :: leakages; + t.[2] <- aux_1; + leakages <- LeakAddr([8; 2]) :: leakages; + aux_1 <- (t.[2] `|` t.[8]); + leakages <- LeakAddr([2]) :: leakages; + t.[2] <- aux_1; + leakages <- LeakAddr([1]) :: leakages; + aux_1 <- x86_VPSRLDQ_256 t.[1] (W8.of_int 8); + leakages <- LeakAddr([7]) :: leakages; + t.[7] <- aux_1; + leakages <- LeakAddr([7; 1]) :: leakages; + aux_1 <- ((invw t.[1]) `&` t.[7]); + leakages <- LeakAddr([0]) :: leakages; + t.[0] <- aux_1; + leakages <- LeakAddr([6; 2]) :: leakages; + aux_1 <- x86_VPBLENDD_256 t.[2] t.[6] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + leakages <- LeakAddr([3]) :: leakages; + state.[3] <- aux_1; + leakages <- LeakAddr([2; 4]) :: leakages; + aux_1 <- x86_VPBLENDD_256 t.[4] t.[2] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + leakages <- LeakAddr([8]) :: leakages; + t.[8] <- aux_1; + leakages <- LeakAddr([4; 3]) :: leakages; + aux_1 <- x86_VPBLENDD_256 t.[3] t.[4] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + leakages <- LeakAddr([5]) :: leakages; + state.[5] <- aux_1; + leakages <- LeakAddr([3; 2]) :: leakages; + aux_1 <- x86_VPBLENDD_256 t.[2] t.[3] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + leakages <- LeakAddr([7]) :: leakages; + t.[7] <- aux_1; + leakages <- LeakAddr([4; 3]) :: leakages; + aux_1 <- x86_VPBLENDD_256 state.[3] t.[4] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + leakages <- LeakAddr([3]) :: leakages; + state.[3] <- aux_1; + leakages <- LeakAddr([5; 8]) :: leakages; + aux_1 <- x86_VPBLENDD_256 t.[8] t.[5] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + leakages <- LeakAddr([8]) :: leakages; + t.[8] <- aux_1; + leakages <- LeakAddr([2; 5]) :: leakages; + aux_1 <- x86_VPBLENDD_256 state.[5] t.[2] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + leakages <- LeakAddr([5]) :: leakages; + state.[5] <- aux_1; + leakages <- LeakAddr([6; 7]) :: leakages; + aux_1 <- x86_VPBLENDD_256 t.[7] t.[6] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + leakages <- LeakAddr([7]) :: leakages; + t.[7] <- aux_1; + leakages <- LeakAddr([5; 3]) :: leakages; + aux_1 <- x86_VPBLENDD_256 state.[3] t.[5] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + leakages <- LeakAddr([3]) :: leakages; + state.[3] <- aux_1; + leakages <- LeakAddr([6; 8]) :: leakages; + aux_1 <- x86_VPBLENDD_256 t.[8] t.[6] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + leakages <- LeakAddr([8]) :: leakages; + t.[8] <- aux_1; + leakages <- LeakAddr([6; 5]) :: leakages; + aux_1 <- x86_VPBLENDD_256 state.[5] t.[6] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + leakages <- LeakAddr([5]) :: leakages; + state.[5] <- aux_1; + leakages <- LeakAddr([4; 7]) :: leakages; + aux_1 <- x86_VPBLENDD_256 t.[7] t.[4] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + leakages <- LeakAddr([7]) :: leakages; + t.[7] <- aux_1; + leakages <- LeakAddr([8; 3]) :: leakages; + aux_1 <- ((invw state.[3]) `&` t.[8]); + leakages <- LeakAddr([3]) :: leakages; + state.[3] <- aux_1; + leakages <- LeakAddr([7; 5]) :: leakages; + aux_1 <- ((invw state.[5]) `&` t.[7]); + leakages <- LeakAddr([5]) :: leakages; + state.[5] <- aux_1; + leakages <- LeakAddr([2; 5]) :: leakages; + aux_1 <- x86_VPBLENDD_256 t.[5] t.[2] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + leakages <- LeakAddr([6]) :: leakages; + state.[6] <- aux_1; + leakages <- LeakAddr([5; 3]) :: leakages; + aux_1 <- x86_VPBLENDD_256 t.[3] t.[5] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + leakages <- LeakAddr([8]) :: leakages; + t.[8] <- aux_1; + leakages <- LeakAddr([3; 3]) :: leakages; + aux_1 <- (state.[3] `^` t.[3]); + leakages <- LeakAddr([3]) :: leakages; + state.[3] <- aux_1; + leakages <- LeakAddr([3; 6]) :: leakages; + aux_1 <- x86_VPBLENDD_256 state.[6] t.[3] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + leakages <- LeakAddr([6]) :: leakages; + state.[6] <- aux_1; + leakages <- LeakAddr([4; 8]) :: leakages; + aux_1 <- x86_VPBLENDD_256 t.[8] t.[4] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + leakages <- LeakAddr([8]) :: leakages; + t.[8] <- aux_1; + leakages <- LeakAddr([5; 5]) :: leakages; + aux_1 <- (state.[5] `^` t.[5]); + leakages <- LeakAddr([5]) :: leakages; + state.[5] <- aux_1; + leakages <- LeakAddr([4; 6]) :: leakages; + aux_1 <- x86_VPBLENDD_256 state.[6] t.[4] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + leakages <- LeakAddr([6]) :: leakages; + state.[6] <- aux_1; + leakages <- LeakAddr([2; 8]) :: leakages; + aux_1 <- x86_VPBLENDD_256 t.[8] t.[2] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + leakages <- LeakAddr([8]) :: leakages; + t.[8] <- aux_1; + leakages <- LeakAddr([8; 6]) :: leakages; + aux_1 <- ((invw state.[6]) `&` t.[8]); + leakages <- LeakAddr([6]) :: leakages; + state.[6] <- aux_1; + leakages <- LeakAddr([6; 6]) :: leakages; + aux_1 <- (state.[6] `^` t.[6]); + leakages <- LeakAddr([6]) :: leakages; + state.[6] <- aux_1; + leakages <- LeakAddr([1]) :: leakages; + aux_1 <- x86_VPERMQ t.[1] + (W8.of_int (2 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (1 %% 2^2 + 2^2 * 0)))); + leakages <- LeakAddr([4]) :: leakages; + state.[4] <- aux_1; + leakages <- LeakAddr([0; 4]) :: leakages; + aux_1 <- x86_VPBLENDD_256 state.[4] state.[0] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + leakages <- LeakAddr([8]) :: leakages; + t.[8] <- aux_1; + leakages <- LeakAddr([1]) :: leakages; + aux_1 <- x86_VPERMQ t.[1] + (W8.of_int (1 %% 2^2 + 2^2 * (2 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 0)))); + leakages <- LeakAddr([1]) :: leakages; + state.[1] <- aux_1; + leakages <- LeakAddr([0; 1]) :: leakages; + aux_1 <- x86_VPBLENDD_256 state.[1] state.[0] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + leakages <- LeakAddr([1]) :: leakages; + state.[1] <- aux_1; + leakages <- LeakAddr([8; 1]) :: leakages; + aux_1 <- ((invw state.[1]) `&` t.[8]); + leakages <- LeakAddr([1]) :: leakages; + state.[1] <- aux_1; + leakages <- LeakAddr([5; 4]) :: leakages; + aux_1 <- x86_VPBLENDD_256 t.[4] t.[5] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + leakages <- LeakAddr([2]) :: leakages; + state.[2] <- aux_1; + leakages <- LeakAddr([4; 6]) :: leakages; + aux_1 <- x86_VPBLENDD_256 t.[6] t.[4] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + leakages <- LeakAddr([7]) :: leakages; + t.[7] <- aux_1; + leakages <- LeakAddr([6; 2]) :: leakages; + aux_1 <- x86_VPBLENDD_256 state.[2] t.[6] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + leakages <- LeakAddr([2]) :: leakages; + state.[2] <- aux_1; + leakages <- LeakAddr([3; 7]) :: leakages; + aux_1 <- x86_VPBLENDD_256 t.[7] t.[3] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + leakages <- LeakAddr([7]) :: leakages; + t.[7] <- aux_1; + leakages <- LeakAddr([3; 2]) :: leakages; + aux_1 <- x86_VPBLENDD_256 state.[2] t.[3] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + leakages <- LeakAddr([2]) :: leakages; + state.[2] <- aux_1; + leakages <- LeakAddr([5; 7]) :: leakages; + aux_1 <- x86_VPBLENDD_256 t.[7] t.[5] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + leakages <- LeakAddr([7]) :: leakages; + t.[7] <- aux_1; + leakages <- LeakAddr([7; 2]) :: leakages; + aux_1 <- ((invw state.[2]) `&` t.[7]); + leakages <- LeakAddr([2]) :: leakages; + state.[2] <- aux_1; + leakages <- LeakAddr([2; 2]) :: leakages; + aux_1 <- (state.[2] `^` t.[2]); + leakages <- LeakAddr([2]) :: leakages; + state.[2] <- aux_1; + leakages <- LeakAddr([0]) :: leakages; + aux_1 <- x86_VPERMQ t.[0] + (W8.of_int (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 0)))); + leakages <- LeakAddr([0]) :: leakages; + t.[0] <- aux_1; + leakages <- LeakAddr([3]) :: leakages; + aux_1 <- x86_VPERMQ state.[3] + (W8.of_int (3 %% 2^2 + 2^2 * (2 %% 2^2 + 2^2 * (1 %% 2^2 + 2^2 * 0)))); + leakages <- LeakAddr([3]) :: leakages; + state.[3] <- aux_1; + leakages <- LeakAddr([5]) :: leakages; + aux_1 <- x86_VPERMQ state.[5] + (W8.of_int (1 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * 2)))); + leakages <- LeakAddr([5]) :: leakages; + state.[5] <- aux_1; + leakages <- LeakAddr([6]) :: leakages; + aux_1 <- x86_VPERMQ state.[6] + (W8.of_int (2 %% 2^2 + 2^2 * (0 %% 2^2 + 2^2 * (3 %% 2^2 + 2^2 * 1)))); + leakages <- LeakAddr([6]) :: leakages; + state.[6] <- aux_1; + leakages <- LeakAddr([3; 6]) :: leakages; + aux_1 <- x86_VPBLENDD_256 t.[6] t.[3] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + leakages <- LeakAddr([4]) :: leakages; + state.[4] <- aux_1; + leakages <- LeakAddr([6; 5]) :: leakages; + aux_1 <- x86_VPBLENDD_256 t.[5] t.[6] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + leakages <- LeakAddr([7]) :: leakages; + t.[7] <- aux_1; + leakages <- LeakAddr([5; 4]) :: leakages; + aux_1 <- x86_VPBLENDD_256 state.[4] t.[5] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + leakages <- LeakAddr([4]) :: leakages; + state.[4] <- aux_1; + leakages <- LeakAddr([2; 7]) :: leakages; + aux_1 <- x86_VPBLENDD_256 t.[7] t.[2] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (1 %% 2^1 + + 2^1 * (0 %% 2^1 + 2^1 * 0)))))))); + leakages <- LeakAddr([7]) :: leakages; + t.[7] <- aux_1; + leakages <- LeakAddr([2; 4]) :: leakages; + aux_1 <- x86_VPBLENDD_256 state.[4] t.[2] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + leakages <- LeakAddr([4]) :: leakages; + state.[4] <- aux_1; + leakages <- LeakAddr([3; 7]) :: leakages; + aux_1 <- x86_VPBLENDD_256 t.[7] t.[3] + (W8.of_int (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (0 %% 2^1 + + 2^1 * (1 %% 2^1 + 2^1 * 1)))))))); + leakages <- LeakAddr([7]) :: leakages; + t.[7] <- aux_1; + leakages <- LeakAddr([7; 4]) :: leakages; + aux_1 <- ((invw state.[4]) `&` t.[7]); + leakages <- LeakAddr([4]) :: leakages; + state.[4] <- aux_1; + leakages <- LeakAddr([0; 0]) :: leakages; + aux_1 <- (state.[0] `^` t.[0]); + leakages <- LeakAddr([0]) :: leakages; + state.[0] <- aux_1; + leakages <- LeakAddr([1; 1]) :: leakages; + aux_1 <- (state.[1] `^` t.[1]); + leakages <- LeakAddr([1]) :: leakages; + state.[1] <- aux_1; + leakages <- LeakAddr([4; 4]) :: leakages; + aux_1 <- (state.[4] `^` t.[4]); + leakages <- LeakAddr([4]) :: leakages; + state.[4] <- aux_1; + leakages <- LeakAddr([(W64.to_uint (iotas + (W64.of_int ((32 * 0) - 0)))); + 0]) :: leakages; + aux_1 <- (state.[0] `^` (loadW256 Glob.mem (W64.to_uint (iotas + (W64.of_int ((32 * 0) - 0)))))); + leakages <- LeakAddr([0]) :: leakages; + state.[0] <- aux_1; + leakages <- LeakAddr([]) :: leakages; + aux <- (iotas + (W64.of_int 32)); + iotas <- aux; + leakages <- LeakAddr([]) :: leakages; + (aux_5, aux_4, aux_3, aux_2, aux_0) <- x86_DEC_32 r; + _0 <- aux_5; + _1 <- aux_4; + _2 <- aux_3; + zf <- aux_2; + r <- aux_0; + leakages <- LeakCond((! zf)) :: LeakAddr([]) :: leakages; + + } + return (state); + } + + proc keccak_init () : W256.t Array7.t = { + var aux_0: int; + var aux: W256.t; + + var state:W256.t Array7.t; + var i:int; + state <- witness; + leakages <- LeakAddr([]) :: leakages; + aux <- x86_VPBROADCAST_4u64 g_zero; + leakages <- LeakAddr([0]) :: leakages; + state.[0] <- aux; + leakages <- LeakFor(1,7) :: LeakAddr([]) :: leakages; + i <- 1; + while (i < 7) { + leakages <- LeakAddr([0]) :: leakages; + aux <- state.[0]; + leakages <- LeakAddr([i]) :: leakages; + state.[i] <- aux; + i <- i + 1; + } + return (state); + } + + proc init_s_state () : W64.t Array28.t = { + var aux_0: int; + var aux: W256.t; + + var s_state:W64.t Array28.t; + var zero:W256.t; + var i:int; + s_state <- witness; + leakages <- LeakAddr([]) :: leakages; + aux <- x86_VPBROADCAST_4u64 g_zero; + zero <- aux; + leakages <- LeakFor(0,7) :: LeakAddr([]) :: leakages; + i <- 0; + while (i < 7) { + leakages <- LeakAddr([]) :: leakages; + aux <- zero; + leakages <- LeakAddr([i]) :: leakages; + s_state = + Array28.init + (WArray224.get64 (WArray224.set256 (WArray224.init64 (fun i => s_state.[i])) i aux)); + i <- i + 1; + } + return (s_state); + } + + proc add_full_block (state:W256.t Array7.t, s_state:W64.t Array28.t, + a_jagged:W64.t, in_0:W64.t, inlen:W64.t, rate:W64.t) : + W256.t Array7.t * W64.t Array28.t * W64.t * W64.t = { + var aux_0: int; + var aux: W64.t; + var aux_1: W256.t; + + var rate8:W64.t; + var j:W64.t; + var t:W64.t; + var l:W64.t; + var i:int; + + leakages <- LeakAddr([]) :: leakages; + aux <- rate; + rate8 <- aux; + leakages <- LeakAddr([]) :: leakages; + aux <- (rate8 `>>` (W8.of_int 3)); + rate8 <- aux; + leakages <- LeakAddr([]) :: leakages; + aux <- (W64.of_int 0); + j <- aux; + + leakages <- LeakCond((j \ult rate8)) :: LeakAddr([]) :: leakages; + + while ((j \ult rate8)) { + leakages <- LeakAddr([(W64.to_uint (in_0 + ((W64.of_int 8) * j)))]) :: leakages; + aux <- (loadW64 Glob.mem (W64.to_uint (in_0 + ((W64.of_int 8) * j)))); + t <- aux; + leakages <- LeakAddr([(W64.to_uint (a_jagged + ((W64.of_int 8) * j)))]) :: leakages; + aux <- (loadW64 Glob.mem (W64.to_uint (a_jagged + ((W64.of_int 8) * j)))); + l <- aux; + leakages <- LeakAddr([]) :: leakages; + aux <- t; + leakages <- LeakAddr([(W64.to_uint l)]) :: leakages; + s_state.[(W64.to_uint l)] <- aux; + leakages <- LeakAddr([]) :: leakages; + aux <- (j + (W64.of_int 1)); + j <- aux; + leakages <- LeakCond((j \ult rate8)) :: LeakAddr([]) :: leakages; + + } + leakages <- LeakAddr([0]) :: leakages; + aux <- s_state.[0]; + t <- aux; + leakages <- LeakAddr([]) :: leakages; + aux <- t; + leakages <- LeakAddr([1]) :: leakages; + s_state.[1] <- aux; + leakages <- LeakAddr([]) :: leakages; + aux <- t; + leakages <- LeakAddr([2]) :: leakages; + s_state.[2] <- aux; + leakages <- LeakAddr([]) :: leakages; + aux <- t; + leakages <- LeakAddr([3]) :: leakages; + s_state.[3] <- aux; + leakages <- LeakFor(0,7) :: LeakAddr([]) :: leakages; + i <- 0; + while (i < 7) { + leakages <- LeakAddr([i; i]) :: leakages; + aux_1 <- (state.[i] `^` (get256 + (WArray224.init64 (fun i => s_state.[i])) i)); + leakages <- LeakAddr([i]) :: leakages; + state.[i] <- aux_1; + i <- i + 1; + } + leakages <- LeakAddr([]) :: leakages; + aux <- (in_0 + rate); + in_0 <- aux; + leakages <- LeakAddr([]) :: leakages; + aux <- (inlen - rate); + inlen <- aux; + return (state, s_state, in_0, inlen); + } + + proc add_final_block (state:W256.t Array7.t, s_state:W64.t Array28.t, + a_jagged:W64.t, in_0:W64.t, inlen:W64.t, + trail_byte:W8.t, rate:W64.t) : W256.t Array7.t = { + var aux_2: int; + var aux_1: W8.t; + var aux_0: W64.t; + var aux_3: W256.t; + var aux: W64.t Array28.t; + + var inlen8:W64.t; + var j:W64.t; + var t:W64.t; + var l:W64.t; + var c:W8.t; + var i:int; + + leakages <- LeakAddr([]) :: leakages; + aux <@ init_s_state (); + s_state <- aux; + leakages <- LeakAddr([]) :: leakages; + aux_0 <- inlen; + inlen8 <- aux_0; + leakages <- LeakAddr([]) :: leakages; + aux_0 <- (inlen8 `>>` (W8.of_int 3)); + inlen8 <- aux_0; + leakages <- LeakAddr([]) :: leakages; + aux_0 <- (W64.of_int 0); + j <- aux_0; + + leakages <- LeakCond((j \ult inlen8)) :: LeakAddr([]) :: leakages; + + while ((j \ult inlen8)) { + leakages <- LeakAddr([(W64.to_uint (in_0 + ((W64.of_int 8) * j)))]) :: leakages; + aux_0 <- (loadW64 Glob.mem (W64.to_uint (in_0 + ((W64.of_int 8) * j)))); + t <- aux_0; + leakages <- LeakAddr([(W64.to_uint (a_jagged + ((W64.of_int 8) * j)))]) :: leakages; + aux_0 <- (loadW64 Glob.mem (W64.to_uint (a_jagged + ((W64.of_int 8) * j)))); + l <- aux_0; + leakages <- LeakAddr([]) :: leakages; + aux_0 <- t; + leakages <- LeakAddr([(W64.to_uint l)]) :: leakages; + s_state.[(W64.to_uint l)] <- aux_0; + leakages <- LeakAddr([]) :: leakages; + aux_0 <- (j + (W64.of_int 1)); + j <- aux_0; + leakages <- LeakCond((j \ult inlen8)) :: LeakAddr([]) :: leakages; + + } + leakages <- LeakAddr([(W64.to_uint (a_jagged + ((W64.of_int 8) * j)))]) :: leakages; + aux_0 <- (loadW64 Glob.mem (W64.to_uint (a_jagged + ((W64.of_int 8) * j)))); + l <- aux_0; + leakages <- LeakAddr([]) :: leakages; + aux_0 <- (l `<<` (W8.of_int 3)); + l <- aux_0; + leakages <- LeakAddr([]) :: leakages; + aux_0 <- (j `<<` (W8.of_int 3)); + j <- aux_0; + + leakages <- LeakCond((j \ult inlen)) :: LeakAddr([]) :: leakages; + + while ((j \ult inlen)) { + leakages <- LeakAddr([(W64.to_uint (in_0 + j))]) :: leakages; + aux_1 <- (loadW8 Glob.mem (W64.to_uint (in_0 + j))); + c <- aux_1; + leakages <- LeakAddr([]) :: leakages; + aux_1 <- c; + leakages <- LeakAddr([(W64.to_uint l)]) :: leakages; + s_state = + Array28.init + (WArray224.get64 (WArray224.set8 (WArray224.init64 (fun i => s_state.[i])) (W64.to_uint l) aux_1)); + leakages <- LeakAddr([]) :: leakages; + aux_0 <- (j + (W64.of_int 1)); + j <- aux_0; + leakages <- LeakAddr([]) :: leakages; + aux_0 <- (l + (W64.of_int 1)); + l <- aux_0; + leakages <- LeakCond((j \ult inlen)) :: LeakAddr([]) :: leakages; + + } + leakages <- LeakAddr([]) :: leakages; + aux_1 <- trail_byte; + leakages <- LeakAddr([(W64.to_uint l)]) :: leakages; + s_state = + Array28.init + (WArray224.get64 (WArray224.set8 (WArray224.init64 (fun i => s_state.[i])) (W64.to_uint l) aux_1)); + leakages <- LeakAddr([]) :: leakages; + aux_0 <- rate; + j <- aux_0; + leakages <- LeakAddr([]) :: leakages; + aux_0 <- (j - (W64.of_int 1)); + j <- aux_0; + leakages <- LeakAddr([]) :: leakages; + aux_0 <- (j `>>` (W8.of_int 3)); + j <- aux_0; + leakages <- LeakAddr([(W64.to_uint (a_jagged + ((W64.of_int 8) * j)))]) :: leakages; + aux_0 <- (loadW64 Glob.mem (W64.to_uint (a_jagged + ((W64.of_int 8) * j)))); + l <- aux_0; + leakages <- LeakAddr([]) :: leakages; + aux_0 <- (l `<<` (W8.of_int 3)); + l <- aux_0; + leakages <- LeakAddr([]) :: leakages; + aux_0 <- rate; + j <- aux_0; + leakages <- LeakAddr([]) :: leakages; + aux_0 <- (j - (W64.of_int 1)); + j <- aux_0; + leakages <- LeakAddr([]) :: leakages; + aux_0 <- (j `&` (W64.of_int 7)); + j <- aux_0; + leakages <- LeakAddr([]) :: leakages; + aux_0 <- (l + j); + l <- aux_0; + leakages <- LeakAddr([(W64.to_uint l)]) :: leakages; + aux_1 <- ((get8 (WArray224.init64 (fun i => s_state.[i])) + (W64.to_uint l)) `^` (W8.of_int 128)); + leakages <- LeakAddr([(W64.to_uint l)]) :: leakages; + s_state = + Array28.init + (WArray224.get64 (WArray224.set8 (WArray224.init64 (fun i => s_state.[i])) (W64.to_uint l) aux_1)); + leakages <- LeakAddr([0]) :: leakages; + aux_0 <- s_state.[0]; + t <- aux_0; + leakages <- LeakAddr([]) :: leakages; + aux_0 <- t; + leakages <- LeakAddr([1]) :: leakages; + s_state.[1] <- aux_0; + leakages <- LeakAddr([]) :: leakages; + aux_0 <- t; + leakages <- LeakAddr([2]) :: leakages; + s_state.[2] <- aux_0; + leakages <- LeakAddr([]) :: leakages; + aux_0 <- t; + leakages <- LeakAddr([3]) :: leakages; + s_state.[3] <- aux_0; + leakages <- LeakFor(0,7) :: LeakAddr([]) :: leakages; + i <- 0; + while (i < 7) { + leakages <- LeakAddr([i; i]) :: leakages; + aux_3 <- (state.[i] `^` (get256 + (WArray224.init64 (fun i => s_state.[i])) i)); + leakages <- LeakAddr([i]) :: leakages; + state.[i] <- aux_3; + i <- i + 1; + } + return (state); + } + + proc xtr_full_block (state:W256.t Array7.t, a_jagged:W64.t, out:W64.t, + len:W64.t) : W64.t = { + var aux: int; + var aux_1: W64.t; + var aux_0: W256.t; + + var i:int; + var s_state:W64.t Array28.t; + var len8:W64.t; + var j:W64.t; + var l:W64.t; + var t:W64.t; + s_state <- witness; + leakages <- LeakFor(0,7) :: LeakAddr([]) :: leakages; + i <- 0; + while (i < 7) { + leakages <- LeakAddr([i]) :: leakages; + aux_0 <- state.[i]; + leakages <- LeakAddr([i]) :: leakages; + s_state = + Array28.init + (WArray224.get64 (WArray224.set256 (WArray224.init64 (fun i => s_state.[i])) i aux_0)); + i <- i + 1; + } + leakages <- LeakAddr([]) :: leakages; + aux_1 <- len; + len8 <- aux_1; + leakages <- LeakAddr([]) :: leakages; + aux_1 <- (len8 `>>` (W8.of_int 3)); + len8 <- aux_1; + leakages <- LeakAddr([]) :: leakages; + aux_1 <- (W64.of_int 0); + j <- aux_1; + + leakages <- LeakCond((j \ult len8)) :: LeakAddr([]) :: leakages; + + while ((j \ult len8)) { + leakages <- LeakAddr([(W64.to_uint (a_jagged + ((W64.of_int 8) * j)))]) :: leakages; + aux_1 <- (loadW64 Glob.mem (W64.to_uint (a_jagged + ((W64.of_int 8) * j)))); + l <- aux_1; + leakages <- LeakAddr([(W64.to_uint l)]) :: leakages; + aux_1 <- s_state.[(W64.to_uint l)]; + t <- aux_1; + leakages <- LeakAddr([]) :: leakages; + aux_1 <- t; + leakages <- LeakAddr([(W64.to_uint (out + ((W64.of_int 8) * j)))]) :: leakages; + Glob.mem <- + storeW64 Glob.mem (W64.to_uint (out + ((W64.of_int 8) * j))) aux_1; + leakages <- LeakAddr([]) :: leakages; + aux_1 <- (j + (W64.of_int 1)); + j <- aux_1; + leakages <- LeakCond((j \ult len8)) :: LeakAddr([]) :: leakages; + + } + leakages <- LeakAddr([]) :: leakages; + aux_1 <- (out + len); + out <- aux_1; + return (out); + } + + proc xtr_bytes (state:W256.t Array7.t, a_jagged:W64.t, out:W64.t, len:W64.t) : + W64.t = { + var aux: int; + var aux_2: W8.t; + var aux_1: W64.t; + var aux_0: W256.t; + + var i:int; + var s_state:W64.t Array28.t; + var len8:W64.t; + var j:W64.t; + var l:W64.t; + var t:W64.t; + var c:W8.t; + s_state <- witness; + leakages <- LeakFor(0,7) :: LeakAddr([]) :: leakages; + i <- 0; + while (i < 7) { + leakages <- LeakAddr([i]) :: leakages; + aux_0 <- state.[i]; + leakages <- LeakAddr([i]) :: leakages; + s_state = + Array28.init + (WArray224.get64 (WArray224.set256 (WArray224.init64 (fun i => s_state.[i])) i aux_0)); + i <- i + 1; + } + leakages <- LeakAddr([]) :: leakages; + aux_1 <- len; + len8 <- aux_1; + leakages <- LeakAddr([]) :: leakages; + aux_1 <- (len8 `>>` (W8.of_int 3)); + len8 <- aux_1; + leakages <- LeakAddr([]) :: leakages; + aux_1 <- (W64.of_int 0); + j <- aux_1; + + leakages <- LeakCond((j \ult len8)) :: LeakAddr([]) :: leakages; + + while ((j \ult len8)) { + leakages <- LeakAddr([(W64.to_uint (a_jagged + ((W64.of_int 8) * j)))]) :: leakages; + aux_1 <- (loadW64 Glob.mem (W64.to_uint (a_jagged + ((W64.of_int 8) * j)))); + l <- aux_1; + leakages <- LeakAddr([(W64.to_uint l)]) :: leakages; + aux_1 <- s_state.[(W64.to_uint l)]; + t <- aux_1; + leakages <- LeakAddr([]) :: leakages; + aux_1 <- t; + leakages <- LeakAddr([(W64.to_uint (out + ((W64.of_int 8) * j)))]) :: leakages; + Glob.mem <- + storeW64 Glob.mem (W64.to_uint (out + ((W64.of_int 8) * j))) aux_1; + leakages <- LeakAddr([]) :: leakages; + aux_1 <- (j + (W64.of_int 1)); + j <- aux_1; + leakages <- LeakCond((j \ult len8)) :: LeakAddr([]) :: leakages; + + } + leakages <- LeakAddr([(W64.to_uint (a_jagged + ((W64.of_int 8) * j)))]) :: leakages; + aux_1 <- (loadW64 Glob.mem (W64.to_uint (a_jagged + ((W64.of_int 8) * j)))); + l <- aux_1; + leakages <- LeakAddr([]) :: leakages; + aux_1 <- (j `<<` (W8.of_int 3)); + j <- aux_1; + leakages <- LeakAddr([]) :: leakages; + aux_1 <- (l `<<` (W8.of_int 3)); + l <- aux_1; + + leakages <- LeakCond((j \ult len)) :: LeakAddr([]) :: leakages; + + while ((j \ult len)) { + leakages <- LeakAddr([(W64.to_uint l)]) :: leakages; + aux_2 <- (get8 (WArray224.init64 (fun i => s_state.[i])) + (W64.to_uint l)); + c <- aux_2; + leakages <- LeakAddr([]) :: leakages; + aux_2 <- c; + leakages <- LeakAddr([(W64.to_uint (out + j))]) :: leakages; + Glob.mem <- storeW8 Glob.mem (W64.to_uint (out + j)) aux_2; + leakages <- LeakAddr([]) :: leakages; + aux_1 <- (j + (W64.of_int 1)); + j <- aux_1; + leakages <- LeakAddr([]) :: leakages; + aux_1 <- (l + (W64.of_int 1)); + l <- aux_1; + leakages <- LeakCond((j \ult len)) :: LeakAddr([]) :: leakages; + + } + leakages <- LeakAddr([]) :: leakages; + aux_1 <- (out + len); + out <- aux_1; + return (out); + } + + proc absorb (state:W256.t Array7.t, rhotates_left:W64.t, + rhotates_right:W64.t, iotas:W64.t, a_jagged:W64.t, in_0:W64.t, + inlen:W64.t, trail_byte:W8.t, rate:W64.t) : W256.t Array7.t = { + var aux_2: W64.t; + var aux_1: W64.t; + var aux: W64.t Array28.t; + var aux_0: W256.t Array7.t; + + var s_state:W64.t Array28.t; + s_state <- witness; + leakages <- LeakAddr([]) :: leakages; + aux <@ init_s_state (); + s_state <- aux; + + leakages <- LeakCond((rate \ule inlen)) :: LeakAddr([]) :: leakages; + + while ((rate \ule inlen)) { + leakages <- LeakAddr([]) :: leakages; + (aux_0, aux, aux_2, aux_1) <@ add_full_block (state, s_state, a_jagged, + in_0, inlen, rate); + state <- aux_0; + s_state <- aux; + in_0 <- aux_2; + inlen <- aux_1; + leakages <- LeakAddr([]) :: leakages; + aux_0 <@ __keccak_f1600_avx2 (state, rhotates_left, rhotates_right, + iotas); + state <- aux_0; + leakages <- LeakCond((rate \ule inlen)) :: LeakAddr([]) :: leakages; + + } + leakages <- LeakAddr([]) :: leakages; + aux_0 <@ add_final_block (state, s_state, a_jagged, in_0, inlen, + trail_byte, rate); + state <- aux_0; + return (state); + } + + proc squeeze (state:W256.t Array7.t, rhotates_left:W64.t, + rhotates_right:W64.t, iotas:W64.t, a_jagged:W64.t, out:W64.t, + outlen:W64.t, rate:W64.t) : unit = { + var aux_0: W64.t; + var aux: W256.t Array7.t; + + + + + leakages <- LeakCond((rate \ult outlen)) :: LeakAddr([]) :: leakages; + + while ((rate \ult outlen)) { + leakages <- LeakAddr([]) :: leakages; + aux <@ __keccak_f1600_avx2 (state, rhotates_left, rhotates_right, + iotas); + state <- aux; + leakages <- LeakAddr([]) :: leakages; + aux_0 <@ xtr_full_block (state, a_jagged, out, rate); + out <- aux_0; + leakages <- LeakAddr([]) :: leakages; + aux_0 <- (outlen - rate); + outlen <- aux_0; + leakages <- LeakCond((rate \ult outlen)) :: LeakAddr([]) :: leakages; + + } + leakages <- LeakAddr([]) :: leakages; + aux <@ __keccak_f1600_avx2 (state, rhotates_left, rhotates_right, iotas); + state <- aux; + leakages <- LeakAddr([]) :: leakages; + aux_0 <@ xtr_bytes (state, a_jagged, out, outlen); + out <- aux_0; + return (); + } + + proc __keccak_1600 (out:W64.t, outlen:W64.t, rhotates_left:W64.t, + rhotates_right:W64.t, iotas:W64.t, a_jagged:W64.t, + in_0:W64.t, inlen:W64.t, trail_byte:W8.t, rate:W64.t) : unit = { + var aux: W256.t Array7.t; + + var state:W256.t Array7.t; + state <- witness; + leakages <- LeakAddr([]) :: leakages; + aux <@ keccak_init (); + state <- aux; + leakages <- LeakAddr([]) :: leakages; + aux <@ absorb (state, rhotates_left, rhotates_right, iotas, a_jagged, + in_0, inlen, trail_byte, rate); + state <- aux; + leakages <- LeakAddr([]) :: leakages; + squeeze (state, rhotates_left, rhotates_right, iotas, a_jagged, out, + outlen, rate); + return (); + } +}. + +op eq_reg (mem1 mem2 : global_mem_t, ptr len : int) = + forall i, ptr <= i <= ptr + len - 8 => + loadW64 mem1 i = loadW64 mem2 i. + +op disj_reg(ptr1 len1 ptr2 len2 : W64.t) = + (to_uint (ptr1 + len1) < to_uint ptr2 \/ to_uint (ptr2 + len2) < to_uint ptr1). + +lemma mem_sep (mem : global_mem_t) (ptr1 o1 x : W64.t) (ptr2 : int): + 0 <= ptr2 < W64.modulus - 8 /\ + to_uint ptr1 + to_uint o1 + 8 < W64.modulus /\ + disj_reg (ptr1 + o1) (W64.of_int 8) (W64.of_int ptr2) (W64.of_int 8) => + loadW64 (storeW64 mem (to_uint (ptr1 + o1)) x) ptr2 = + loadW64 mem ptr2. +progress. +rewrite storeW64E. +rewrite /loadW64. +congr. +apply W8u8.Pack.init_ext. +move => x0 hxc0. +beta. +rewrite (get_storesE mem (to_uint (ptr1 + o1)) (((to_list x))%W8u8) (ptr2 + x0)). +rewrite (_: to_uint (ptr1 + o1) <= ptr2 + x0 < + to_uint (ptr1 + o1) + size ((to_list x))%W8u8 = false) => //=. +have bound : ( ptr2 + x0 < to_uint (ptr1 + o1) \/ to_uint (ptr1 + o1) + 8 <=ptr2 + x0); last by smt(). +elim H2. +rewrite !to_uintD_small. smt(@W64). smt(@W64). smt(@W64). +rewrite !of_uintK => />. +smt(@W64). +rewrite !to_uintD_small. smt(@W64). smt(@W64). +progress. +move : H2. rewrite !of_uintK => />. +smt(@W64). +qed. + +equiv ct : + M.__keccak_1600 ~ M.__keccak_1600 : + ={M.leakages,out,outlen,rhotates_left,rhotates_right,iotas,a_jagged,in_0,inlen,rate} /\ + to_uint out{2} + to_uint (outlen{2} + W64.of_int 8) < W64.modulus /\ + to_uint a_jagged{2} + 224 < W64.modulus /\ 0 < to_uint rate{2} < 200 /\ + eq_reg Glob.mem{1} Glob.mem{2} (to_uint a_jagged{1}) 224 /\ + disj_reg out{1} (outlen{1} + W64.of_int 8) a_jagged{1} (W64.of_int 224) /\ + disj_reg out{2} (outlen{2} + W64.of_int 8) a_jagged{2} (W64.of_int 224) /\ + to_uint outlen{2} + 8 < W64.modulus ==> ={M.leakages}. +proc. +call (_: ={rhotates_left,rhotates_right,iotas,a_jagged,out,outlen,rate,M.leakages} /\ to_uint rate{2} < 200 /\ + to_uint out{2} + to_uint (outlen{2} + W64.of_int 8) < W64.modulus /\ + to_uint a_jagged{2} + 224 < W64.modulus /\ + eq_reg Glob.mem{1} Glob.mem{2} (to_uint a_jagged{1}) 224 /\ + disj_reg out{1} (outlen{1} + W64.of_int 8) a_jagged{1} (W64.of_int 224) /\ + disj_reg out{2} (outlen{2} + W64.of_int 8) a_jagged{2} (W64.of_int 224) /\ + to_uint outlen{2} + 8 < W64.modulus ==> ={M.leakages}). +proc. +wp; call(_: ={a_jagged,out,len,M.leakages} /\ + to_uint len{2} <= 200 /\ + to_uint out{2} + to_uint (len{2} + W64.of_int 8) < W64.modulus /\ + to_uint a_jagged{2} + 224 < W64.modulus /\ + eq_reg Glob.mem{1} Glob.mem{2} (to_uint a_jagged{1}) 224 /\ + disj_reg out{1} (len{1} + W64.of_int 8) a_jagged{1} (W64.of_int 224) /\ + disj_reg out{2} (len{2} + W64.of_int 8) a_jagged{2} (W64.of_int 224) ==> ={M.leakages}). +proc. +wp; while (={j,len,M.leakages,out,l}). +by auto => />. +wp; while (={j,M.leakages,out,a_jagged,len8,len} /\ + to_uint len8{2} <= 25 /\ to_uint j{2} <= to_uint len8{2} /\ + to_uint out{2} + to_uint (len{2} + W64.of_int 8) < W64.modulus /\ + to_uint a_jagged{2} + 224 < W64.modulus /\ + eq_reg Glob.mem{1} Glob.mem{2} (to_uint a_jagged{1}) 224 /\ + disj_reg out{1} (len{1} + W64.of_int 8) a_jagged{1} (W64.of_int 224) /\ + disj_reg out{2} (len{2} + W64.of_int 8) a_jagged{2} (W64.of_int 224) /\ + 0 <= to_uint len8{2} < 26 /\ to_uint len8{1} = to_uint len{1} %/ 8). +auto => />. +rewrite /eq_reg /disj_reg. +progress. +congr. +move : H8; rewrite ultE => *. +by apply H3;rewrite to_uintD_small;by smt(@W64). +by smt(@W64). +rewrite (mem_sep Glob.mem{1} out{2} + (((of_int 8)%W64 * j{2})) + (s_state{1}.[to_uint + (loadW64 Glob.mem{1} + (to_uint (a_jagged{2} + (of_int 8)%W64 * j{2})))])). +split. +smt(@W64). +split. +smt(@W64). +rewrite /disj_reg. +elim H4. +rewrite !to_uintD_small => />. smt(@W64). smt(@W64). smt(@W64). smt(@W64). smt(@W64). smt(@W64). smt(@W64). +move => H4. +left. +rewrite !to_uintM_small. smt(@W64). +rewrite of_uintK => />. +move : H8; rewrite ultE. +rewrite H7. +move => *. +have hh : (8 * to_uint j{2} < to_uint len{2}). +smt(@W64). +rewrite of_uintK => //=. +rewrite (_: i0 %% 18446744073709551616 = i0). +smt(@W64). +smt(@W64). + +rewrite !to_uintD_small. +smt(@W64). +smt(@W64). +smt(@W64). +smt(@W64). +smt(@W64). +smt(@W64). + +rewrite (mem_sep Glob.mem{2} out{2} + (((of_int 8)%W64 * j{2})) + (s_state{2}.[to_uint + (loadW64 Glob.mem{2} + (to_uint (a_jagged{2} + (of_int 8)%W64 * j{2})))])). +split. +smt(@W64). +split. +smt(@W64). +rewrite /disj_reg. +elim H4. +rewrite !to_uintD_small => />. smt(@W64). smt(@W64). smt(@W64). smt(@W64). smt(@W64). smt(@W64). smt(@W64). +move => H4. +left. +rewrite !to_uintM_small. smt(@W64). +rewrite of_uintK => />. +move : H8; rewrite ultE. +rewrite H7. +move => *. +have hh : (8 * to_uint j{2} < to_uint len{2}). +smt(@W64). +rewrite of_uintK => //=. +rewrite (_: i0 %% 18446744073709551616 = i0). +smt(@W64). +smt(@W64). + +rewrite !to_uintD_small. +smt(@W64). +smt(@W64). +smt(@W64). +smt(@W64). +smt(@W64). +smt(@W64). + +apply H3. smt(@W64). +unroll for {1} 4. +unroll for {2} 4. +auto => />. +progress. +rewrite shr_div => />. +by smt(). +rewrite shr_div => />. +by smt(@W64). +rewrite shr_div => />. +by smt(@W64). +rewrite shr_div => />. +by smt(@W64). +by rewrite shr_div => />. + +move : H8; rewrite /eq_reg => *. +rewrite H8 =>//=. +by rewrite to_uintD_small; by smt(@W64). +wp;call(_: ={M.leakages,_rhotates_left,_rhotates_right,_iotas} ==> ={M.leakages}). +proc. +by sim. + +wp;while(={M.leakages,rate,outlen,rhotates_left,rhotates_right,iotas,a_jagged,out} /\ + to_uint rate{2} < 200 /\ + to_uint out{2} + to_uint (outlen{2} + W64.of_int 8) < W64.modulus /\ + to_uint a_jagged{2} + 224 < W64.modulus /\ + eq_reg Glob.mem{1} Glob.mem{2} (to_uint a_jagged{1}) 224 /\ + disj_reg out{1} (outlen{1} + W64.of_int 8) a_jagged{1} (W64.of_int 224) /\ + disj_reg out{2} (outlen{2} + W64.of_int 8) a_jagged{2} (W64.of_int 224) /\ + to_uint outlen{2} + 8 < W64.modulus). + +(* bug report, cannot use a_jagged for elim symbol *) +exists* a_jagged{1}, outlen{1}, rate{1}, out{1}. +elim* => a_j ol rt ot. +wp; call(_: ={a_jagged,out,len,M.leakages} /\ + to_uint len{2} < 200 /\ a_jagged{1} = a_j /\ len{1} = rt /\ out{1} = ot /\ + to_uint out{2} + to_uint (len{2} + W64.of_int 8) < W64.modulus /\ + to_uint a_jagged{2} + 224 < W64.modulus /\ + eq_reg Glob.mem{1} Glob.mem{2} (to_uint a_jagged{1}) 224 /\ + disj_reg out{1} (ol{1} + W64.of_int 8) a_jagged{1} (W64.of_int 224) /\ + disj_reg out{2} (ol{2} + W64.of_int 8) a_jagged{2} (W64.of_int 224) /\ len{1} \ult ol /\ + to_uint out{2} + (to_uint ol + 8) < W64.modulus + ==> ={M.leakages,res} /\ + eq_reg Glob.mem{1} Glob.mem{2} (to_uint a_j) 224 /\ + res{1} = ot + rt). +proc. +wp; while (={j,M.leakages,out,a_jagged,len8,len} /\ out{1} = ot /\ + a_jagged{1} = a_j /\ to_uint len8{1} = to_uint rt %/ 8 /\ + to_uint len8{2} < 25 /\ to_uint j{2} <= to_uint len8{2} /\ + to_uint out{2} + to_uint (len{2} + W64.of_int 8)< W64.modulus /\ + to_uint a_jagged{2} + 224 < W64.modulus /\ + eq_reg Glob.mem{1} Glob.mem{2} (to_uint a_jagged{1}) 224 /\ + disj_reg out{1} (ol{1} + W64.of_int 8) a_jagged{1} (W64.of_int 224) /\ + disj_reg out{2} (ol{2} + W64.of_int 8) a_jagged{2} (W64.of_int 224) /\ + 0 <= to_uint len8{2} < 26 /\ to_uint len8{1} = to_uint len{1} %/ 8 + /\ len{1} \ult ol /\ to_uint out{2} + (to_uint ol + 8) < W64.modulus). +auto => />. +rewrite /eq_reg /disj_reg. +progress. +congr. +move : H9; rewrite ultE => *. +by apply H4;rewrite to_uintD_small; smt(@W64). +by smt(@W64). +rewrite (mem_sep Glob.mem{1} out{2} + (((of_int 8)%W64 * j{2})) + (s_state{1}.[to_uint + (loadW64 Glob.mem{1} + (to_uint (a_jagged{2} + (of_int 8)%W64 * j{2})))])). +split. +smt(@W64). +split. +smt(@W64). +rewrite /disj_reg. +elim H5. +rewrite !to_uintD_small => />. smt(@W64). smt(@W64). smt(@W64). smt(@W64). smt(@W64). smt(@W64). +move => H5. +left. +rewrite !to_uintM_small. smt(@W64). +rewrite of_uintK => />. +move : H11; rewrite ultE. +rewrite H8. +move => *. +have hh : (8 * to_uint j{2} < to_uint len{2}). +smt(@W64). +rewrite of_uintK => //=. +rewrite (_: i0 %% 18446744073709551616 = i0). +smt(@W64). +smt(@W64). + +rewrite !to_uintD_small. +smt(@W64). +smt(@W64). +smt(@W64). +smt(@W64). +smt(@W64). +smt(@W64). + + +rewrite (mem_sep Glob.mem{2} out{2} + (((of_int 8)%W64 * j{2})) + (s_state{2}.[to_uint + (loadW64 Glob.mem{2} + (to_uint (a_jagged{2} + (of_int 8)%W64 * j{2})))])). +split. +smt(@W64). +split. +smt(@W64). +rewrite /disj_reg. +elim H5. +rewrite !to_uintD_small => />. smt(@W64). smt(@W64). smt(@W64). smt(@W64). smt(@W64). smt(@W64). +move => H5. +left. +rewrite !to_uintM_small. smt(@W64). +rewrite of_uintK => />. +move : H11; rewrite ultE. +rewrite H8. +move => *. +have hh : (8 * to_uint j{2} < to_uint len{2}). +smt(@W64). +rewrite of_uintK => //=. +rewrite (_: i0 %% 18446744073709551616 = i0). +smt(@W64). +smt(@W64). + +rewrite !to_uintD_small. +smt(@W64). +smt(@W64). +smt(@W64). +smt(@W64). +smt(@W64). +smt(@W64). + +apply H4. smt(@W64). +unroll for {1} 4. +unroll for {2} 4. +auto => />. +progress. +by rewrite shr_div => />. +rewrite shr_div => />. +by smt(@W64). +rewrite shr_div => />. +by smt(@W64). +rewrite shr_div => />. +by smt(@W64). +rewrite shr_div => />. +by smt(@W64). +by rewrite shr_div => />. + +wp;call(_: ={M.leakages,_rhotates_left,_rhotates_right,_iotas} ==> ={M.leakages}). +proc. +by sim. + +auto => />. +progress. +move : H5; rewrite ultE => *. +move : H0. +rewrite !to_uintD_small => />. smt(@W64). smt(@W64). +move : H5; rewrite ultE => *. +move : H0. +rewrite !to_uintD_small => />. smt(@W64). + +move : H3; rewrite /disj_reg => *. +elim H3. +move => *. +left. +rewrite (_: (out{2} + rate{2} + (outlen{2} - rate{2} + (of_int 8)%W64)) = + (out{2} + outlen{2} + (of_int 8)%W64)). by ring. +smt(@W64). +move => *. +right. +rewrite (_: to_uint (out{2} + rate{2}) = to_uint out{2} + to_uint rate{2}). +rewrite to_uintD_small. smt(@W64). +smt(@W64). +smt(@W64). + +move : H3; rewrite /disj_reg => *. +elim H3. +move => *. +left. +rewrite (_: (out{2} + rate{2} + (outlen{2} - rate{2} + (of_int 8)%W64)) = + (out{2} + outlen{2} + (of_int 8)%W64)). by ring. +smt(@W64). +move => *. +right. +rewrite (_: to_uint (out{2} + rate{2}) = to_uint out{2} + to_uint rate{2}). +rewrite to_uintD_small. smt(@W64). +smt(@W64). +smt(@W64). +smt(@W64). + +auto => />. +progress. +smt(@W64). + +wp;call(_: ={rhotates_left, rhotates_right,iotas,a_jagged, in_0, inlen,rate,M.leakages} /\ + eq_reg Glob.mem{1} Glob.mem{2} (to_uint a_jagged{1}) 224 /\ + to_uint a_jagged{2} + 224 < W64.modulus /\ 0 < to_uint rate{2} < 200 + ==> + ={M.leakages}). +proc. +wp; call(_: ={a_jagged,in_0,inlen,rate,M.leakages} /\ + eq_reg Glob.mem{1} Glob.mem{2} (to_uint a_jagged{1}) 224 /\ + to_uint a_jagged{2} + 224 < W64.modulus /\ 0 < to_uint rate{2} < 200 /\ + to_uint inlen{2} < to_uint rate{2} + ==> ={M.leakages}). +proc. +while(={i,M.leakages}). +by auto => />. +wp;while(={j,in_0,inlen,M.leakages,l}). +by auto => />. + +wp;while(={j,in_0,inlen8,M.leakages,a_jagged} /\ + to_uint inlen8{2} <= 25 /\ to_uint j{2} <= to_uint inlen8{2} /\ + eq_reg Glob.mem{1} Glob.mem{2} (to_uint a_jagged{1}) 224 /\ + to_uint a_jagged{2} + 224 < W64.modulus /\ to_uint rate{2} < 200). + auto => />. +rewrite /eq_reg /disj_reg. +progress. +congr. +move : H4; rewrite ultE => *. +by apply H1;rewrite to_uintD_small;by smt(@W64). +by smt(@W64). + +auto => />. +progress. +congr. +move : (H11); rewrite /eq_reg => *. +rewrite H14 => //=. +rewrite to_uintD_small. smt(@W64). smt(@W64). +move : (H11); rewrite /eq_reg => * //=. +congr. +congr. +congr. +rewrite H16 => //=. + +split; last first. +have hh : (to_uint ((of_int 8)%W64 * (rate{2} - W64.one `>>` (of_int 3)%W8)) < 216). +rewrite to_uintM_small. + +have hh: (to_uint (rate{2} - W64.one `>>` (of_int 3)%W8) < 200). +rewrite shr_div => />. +by smt(@W64). +by smt(@W64). +rewrite shr_div => />. +by smt(@W64). +by smt(@W64). + +rewrite to_uintD_small. +have hh : (to_uint ((of_int 8)%W64 * (rate{2} - W64.one `>>` (of_int 3)%W8)) < 216). +rewrite to_uintM_small. + +have hh: (to_uint (rate{2} - W64.one `>>` (of_int 3)%W8) < 200). +rewrite shr_div => />. +by smt(@W64). +by smt(@W64). +rewrite shr_div => />. +by smt(@W64). +by smt(@W64). +by smt(@W64). + +move : (H11); rewrite /eq_reg => * //=. +congr. +congr. +congr. +rewrite H16 => //=. + +split; last first. +have hh : (to_uint ((of_int 8)%W64 * (rate{2} - W64.one `>>` (of_int 3)%W8)) < 216). +rewrite to_uintM_small. + +have hh: (to_uint (rate{2} - W64.one `>>` (of_int 3)%W8) < 200). +rewrite shr_div => />. +by smt(@W64). +by smt(@W64). + +rewrite shr_div => />. +by smt(@W64). +by smt(@W64). + +rewrite to_uintD_small. +have hh : (to_uint ((of_int 8)%W64 * (rate{2} - W64.one `>>` (of_int 3)%W8)) < 216). +rewrite to_uintM_small. + +have hh: (to_uint (rate{2} - W64.one `>>` (of_int 3)%W8) < 200). +rewrite shr_div => />. +by smt(@W64). +by smt(@W64). +rewrite shr_div => />. +by smt(@W64). +by smt(@W64). +by smt(@W64). + +inline *. +unroll for {1} 8. +unroll for {2} 8. + +auto => />. +progress. +rewrite shr_div => />. +smt(@W64). +rewrite shr_div => />. +smt(@W64). + +move : (H); rewrite /eq_reg => * //=. +congr. +rewrite H7 => //=. + +rewrite to_uintD_small. +by smt(@W64). +by smt(@W64). + +congr. +move : (H); rewrite /eq_reg => * //=. +congr. +rewrite H8 => //=. + +split. +rewrite to_uintD_small. +have hh : (to_uint ((of_int 8)%W64 * (rate{2} - W64.one `>>` (of_int 3)%W8)) < 224). +rewrite to_uintM_small. + +have hh: (to_uint (rate{2} - W64.one `>>` (of_int 3)%W8) < 200). +rewrite shr_div => />. +by smt(@W64). +by smt(@W64). +rewrite shr_div => />. +by smt(@W64). +by smt(@W64). +by smt(@W64). + + +progress. + +have hh : (to_uint ((of_int 8)%W64 * (rate{2} - W64.one `>>` (of_int 3)%W8)) < 216). +rewrite to_uintM_small. + +have hh: (to_uint (rate{2} - W64.one `>>` (of_int 3)%W8) < 200). +rewrite shr_div => />. +by smt(@W64). +by smt(@W64). +rewrite shr_div => />. +by smt(@W64). +by smt(@W64). + +congr. +move : (H); rewrite /eq_reg => * //=. +congr. +rewrite H8 => //=. + +split. +rewrite to_uintD_small. +have hh : (to_uint ((of_int 8)%W64 * (rate{2} - W64.one `>>` (of_int 3)%W8)) < 216). +rewrite to_uintM_small. + +have hh: (to_uint (rate{2} - W64.one `>>` (of_int 3)%W8) < 200). +rewrite shr_div => />. +by smt(@W64). +by smt(@W64). +rewrite shr_div => />. +by smt(@W64). +by smt(@W64). +by smt(@W64). + + +progress. + +have hh : (to_uint ((of_int 8)%W64 * (rate{2} - W64.one `>>` (of_int 3)%W8)) < 216). +rewrite to_uintM_small. + +have hh: (to_uint (rate{2} - W64.one `>>` (of_int 3)%W8) < 200). +rewrite shr_div => />. +by smt(@W64). +by smt(@W64). +rewrite shr_div => />. +by smt(@W64). +by smt(@W64). + +wp; while (={M.leakages,rate,inlen,a_jagged,in_0,rhotates_left,rhotates_right,iotas} /\ + to_uint a_jagged{2} + 224 < W64.modulus /\ 0 < to_uint rate{2} < 200 /\ + eq_reg Glob.mem{1} Glob.mem{2} (to_uint a_jagged{1}) 224). +wp;call(_: ={M.leakages,_rhotates_left,_rhotates_right,_iotas} ==> ={M.leakages}). +proc. +by sim. +exists* rate{2}, inlen{2}. +elim* => rt il. +wp;call(_: ={M.leakages,rate,inlen,a_jagged,in_0} /\ + rate{2} = rt /\ inlen{2} = il /\ + to_uint a_jagged{2} + 224 < W64.modulus /\ 0 < to_uint rate{2} < 200 /\ + eq_reg Glob.mem{1} Glob.mem{2} (to_uint a_jagged{1}) 224 ==> + res{1}.`3 = res{2}.`3 /\ res{1}.`4 = res{2}.`4 /\ ={M.leakages} /\ + res{1}.`4 = il - rt). +proc. +wp; while (={M.leakages,i}). +by auto => />. +wp; while (={j,rate8,M.leakages,a_jagged,in_0} /\ to_uint rate8{2} < 25 /\ + to_uint a_jagged{2} + 224 < W64.modulus /\ 0 < to_uint rate{2} < 200 /\ + eq_reg Glob.mem{1} Glob.mem{2} (to_uint a_jagged{1}) 224). +auto => />. +progress. +congr. +move : H3;rewrite /eq_reg => H3. +rewrite H3. +rewrite to_uintD_small => />. +smt(@W64). +smt(@W64). +rewrite to_uintD_small => />. +smt(@W64). + +auto => />. +progress. +rewrite shr_div => />. +smt(@W64). + +auto => />. +progress. +rewrite !uleE. +smt(@W64). +rewrite !uleE. +smt(@W64). +rewrite !uleE. +smt(@W64). + +inline *. +unroll for {1} 9. +unroll for {2} 9. +auto => />. +progress. +move : H3; rewrite uleE; smt(@W64). + +inline *. +unroll for {1} 10. +unroll for {2} 10. +by auto => />. +qed. diff --git a/proof/impl/libc/keccak_1600_scalar_CT.ec b/proof/impl/libc/keccak_1600_scalar_CT.ec new file mode 100644 index 0000000..08817aa --- /dev/null +++ b/proof/impl/libc/keccak_1600_scalar_CT.ec @@ -0,0 +1,1564 @@ +require import List Int IntExtra IntDiv CoreMap. +from Jasmin require import JModel. + +require import Array5 Array25. +require import WArray40 WArray200. + +require import Keccak_1600_scalar. + +module M = { + var leakages : leakages_t + + proc index (x:int, y:int) : int = { + var aux: int; + + var r:int; + + leakages <- LeakAddr([]) :: leakages; + aux <- ((5 * (x %% 5)) + (y %% 5)); + r <- aux; + return (r); + } + + proc keccak_rho_offsets (i:int) : int = { + var aux: int; + + var r:int; + var x:int; + var y:int; + var t:int; + var z:int; + + leakages <- LeakAddr([]) :: leakages; + aux <- 0; + r <- aux; + leakages <- LeakAddr([]) :: leakages; + aux <- 1; + x <- aux; + leakages <- LeakAddr([]) :: leakages; + aux <- 0; + y <- aux; + leakages <- LeakFor(0,24) :: LeakAddr([]) :: leakages; + t <- 0; + while (t < 24) { + leakages <- LeakCond((i = (x + (5 * y)))) :: LeakAddr([]) :: leakages; + if ((i = (x + (5 * y)))) { + leakages <- LeakAddr([]) :: leakages; + aux <- ((((t + 1) * (t + 2)) %/ 2) %% 64); + r <- aux; + } else { + + } + leakages <- LeakAddr([]) :: leakages; + aux <- (((2 * x) + (3 * y)) %% 5); + z <- aux; + leakages <- LeakAddr([]) :: leakages; + aux <- y; + x <- aux; + leakages <- LeakAddr([]) :: leakages; + aux <- z; + y <- aux; + t <- t + 1; + } + return (r); + } + + proc rhotates (x:int, y:int) : int = { + var aux: int; + + var r:int; + var i:int; + + leakages <- LeakAddr([]) :: leakages; + aux <@ index (x, y); + i <- aux; + leakages <- LeakAddr([]) :: leakages; + aux <@ keccak_rho_offsets (i); + r <- aux; + return (r); + } + + proc rOL64 (x:W64.t, c:int) : W64.t = { + var aux_1: bool; + var aux_0: bool; + var aux: W64.t; + + var y:W64.t; + var _0:bool; + var _1:bool; + + leakages <- LeakCond((c = 0)) :: LeakAddr([]) :: leakages; + if ((c = 0)) { + leakages <- LeakAddr([]) :: leakages; + aux <- x; + y <- aux; + } else { + leakages <- LeakAddr([]) :: leakages; + (aux_1, aux_0, aux) <- x86_ROL_64 x (W8.of_int c); + _0 <- aux_1; + _1 <- aux_0; + y <- aux; + } + return (y); + } + + proc theta_sum (a:W64.t Array25.t) : W64.t Array5.t = { + var aux: int; + var aux_0: W64.t; + + var c:W64.t Array5.t; + var i:int; + var j:int; + c <- witness; + leakages <- LeakFor(0,5) :: LeakAddr([]) :: leakages; + i <- 0; + while (i < 5) { + leakages <- LeakAddr([((5 * (0 %% 5)) + (i %% 5))]) :: leakages; + aux_0 <- a.[((5 * (0 %% 5)) + (i %% 5))]; + leakages <- LeakAddr([i]) :: leakages; + c.[i] <- aux_0; + i <- i + 1; + } + leakages <- LeakFor(1,5) :: LeakAddr([]) :: leakages; + j <- 1; + while (j < 5) { + leakages <- LeakFor(0,5) :: LeakAddr([]) :: leakages; + i <- 0; + while (i < 5) { + leakages <- LeakAddr([((5 * (j %% 5)) + (i %% 5)); i]) :: leakages; + aux_0 <- (c.[i] `^` a.[((5 * (j %% 5)) + (i %% 5))]); + leakages <- LeakAddr([i]) :: leakages; + c.[i] <- aux_0; + i <- i + 1; + } + j <- j + 1; + } + return (c); + } + + proc theta_rol (c:W64.t Array5.t) : W64.t Array5.t = { + var aux_2: bool; + var aux_1: bool; + var aux: int; + var aux_0: W64.t; + + var d:W64.t Array5.t; + var i:int; + var _0:bool; + var _1:bool; + d <- witness; + leakages <- LeakFor(0,5) :: LeakAddr([]) :: leakages; + i <- 0; + while (i < 5) { + leakages <- LeakAddr([((i + 1) %% 5)]) :: leakages; + aux_0 <- c.[((i + 1) %% 5)]; + leakages <- LeakAddr([i]) :: leakages; + d.[i] <- aux_0; + leakages <- LeakAddr([i]) :: leakages; + (aux_2, aux_1, aux_0) <- x86_ROL_64 d.[i] (W8.of_int 1); + _0 <- aux_2; + _1 <- aux_1; + leakages <- LeakAddr([i]) :: leakages; + d.[i] <- aux_0; + leakages <- LeakAddr([((i + 4) %% 5); i]) :: leakages; + aux_0 <- (d.[i] `^` c.[((i + 4) %% 5)]); + leakages <- LeakAddr([i]) :: leakages; + d.[i] <- aux_0; + i <- i + 1; + } + return (d); + } + + proc rol_sum (d:W64.t Array5.t, a:W64.t Array25.t, offset:int) : W64.t Array5.t = { + var aux: int; + var aux_0: W64.t; + + var c:W64.t Array5.t; + var j:int; + var j1:int; + var k:int; + var t:W64.t; + c <- witness; + leakages <- LeakFor(0,5) :: LeakAddr([]) :: leakages; + j <- 0; + while (j < 5) { + leakages <- LeakAddr([]) :: leakages; + aux <- ((j + offset) %% 5); + j1 <- aux; + leakages <- LeakAddr([]) :: leakages; + aux <@ rhotates (j, j1); + k <- aux; + leakages <- LeakAddr([((5 * (j %% 5)) + (j1 %% 5))]) :: leakages; + aux_0 <- a.[((5 * (j %% 5)) + (j1 %% 5))]; + t <- aux_0; + leakages <- LeakAddr([j1]) :: leakages; + aux_0 <- (t `^` d.[j1]); + t <- aux_0; + leakages <- LeakAddr([]) :: leakages; + aux_0 <@ rOL64 (t, k); + t <- aux_0; + leakages <- LeakAddr([]) :: leakages; + aux_0 <- t; + leakages <- LeakAddr([j]) :: leakages; + c.[j] <- aux_0; + j <- j + 1; + } + return (c); + } + + proc set_row (r:W64.t Array25.t, row:int, c:W64.t Array5.t, iota_0:W64.t) : + W64.t Array25.t = { + var aux: int; + var aux_0: W64.t; + + var j:int; + var j1:int; + var j2:int; + var t:W64.t; + + leakages <- LeakFor(0,5) :: LeakAddr([]) :: leakages; + j <- 0; + while (j < 5) { + leakages <- LeakAddr([]) :: leakages; + aux <- ((j + 1) %% 5); + j1 <- aux; + leakages <- LeakAddr([]) :: leakages; + aux <- ((j + 2) %% 5); + j2 <- aux; + leakages <- LeakAddr([j2; j1]) :: leakages; + aux_0 <- ((invw c.[j1]) `&` c.[j2]); + t <- aux_0; + leakages <- LeakCond(((row = 0) /\ (j = 0))) :: LeakAddr([]) :: leakages; + if (((row = 0) /\ (j = 0))) { + leakages <- LeakAddr([]) :: leakages; + aux_0 <- (t `^` iota_0); + t <- aux_0; + } else { + + } + leakages <- LeakAddr([j]) :: leakages; + aux_0 <- (t `^` c.[j]); + t <- aux_0; + leakages <- LeakAddr([]) :: leakages; + aux_0 <- t; + leakages <- LeakAddr([((5 * (row %% 5)) + (j %% 5))]) :: leakages; + r.[((5 * (row %% 5)) + (j %% 5))] <- aux_0; + j <- j + 1; + } + return (r); + } + + proc round2x (a:W64.t Array25.t, r:W64.t Array25.t, iotas:W64.t, o:int) : + W64.t Array25.t * W64.t Array25.t = { + var aux: W64.t; + var aux_0: W64.t Array5.t; + var aux_1: W64.t Array25.t; + + var iota_0:W64.t; + var c:W64.t Array5.t; + var d:W64.t Array5.t; + c <- witness; + d <- witness; + leakages <- LeakAddr([(W64.to_uint (iotas + (W64.of_int o)))]) :: leakages; + aux <- (loadW64 Glob.mem (W64.to_uint (iotas + (W64.of_int o)))); + iota_0 <- aux; + leakages <- LeakAddr([]) :: leakages; + aux_0 <@ theta_sum (a); + c <- aux_0; + leakages <- LeakAddr([]) :: leakages; + aux_0 <@ theta_rol (c); + d <- aux_0; + leakages <- LeakAddr([]) :: leakages; + aux_0 <@ rol_sum (d, a, 0); + c <- aux_0; + leakages <- LeakAddr([]) :: leakages; + aux_1 <@ set_row (r, 0, c, iota_0); + r <- aux_1; + leakages <- LeakAddr([]) :: leakages; + aux_0 <@ rol_sum (d, a, 3); + c <- aux_0; + leakages <- LeakAddr([]) :: leakages; + aux_1 <@ set_row (r, 1, c, iota_0); + r <- aux_1; + leakages <- LeakAddr([]) :: leakages; + aux_0 <@ rol_sum (d, a, 1); + c <- aux_0; + leakages <- LeakAddr([]) :: leakages; + aux_1 <@ set_row (r, 2, c, iota_0); + r <- aux_1; + leakages <- LeakAddr([]) :: leakages; + aux_0 <@ rol_sum (d, a, 4); + c <- aux_0; + leakages <- LeakAddr([]) :: leakages; + aux_1 <@ set_row (r, 3, c, iota_0); + r <- aux_1; + leakages <- LeakAddr([]) :: leakages; + aux_0 <@ rol_sum (d, a, 2); + c <- aux_0; + leakages <- LeakAddr([]) :: leakages; + aux_1 <@ set_row (r, 4, c, iota_0); + r <- aux_1; + return (a, r); + } + + proc __keccak_f1600_scalar (a:W64.t Array25.t, iotas:W64.t) : W64.t Array25.t * + W64.t = { + var aux_6: bool; + var aux_5: bool; + var aux_4: bool; + var aux_3: bool; + var aux_2: bool; + var aux_1: W64.t; + var aux_0: W64.t Array25.t; + var aux: W64.t Array25.t; + + var zf:bool; + var r:W64.t Array25.t; + var _0:bool; + var _1:bool; + var _2:bool; + var _3:bool; + r <- witness; + leakages <- LeakAddr([]) :: leakages; + (aux_0, aux) <@ round2x (a, r, iotas, 0); + a <- aux_0; + r <- aux; + leakages <- LeakAddr([]) :: leakages; + (aux_0, aux) <@ round2x (r, a, iotas, 8); + r <- aux_0; + a <- aux; + leakages <- LeakAddr([]) :: leakages; + aux_1 <- (iotas + (W64.of_int 16)); + iotas <- aux_1; + leakages <- LeakAddr([]) :: leakages; + (aux_6, aux_5, aux_4, aux_3, aux_2) <- x86_TEST_8 (truncateu8 iotas) + (W8.of_int 255); + _0 <- aux_6; + _1 <- aux_5; + _2 <- aux_4; + _3 <- aux_3; + zf <- aux_2; + leakages <- LeakCond((! zf)) :: LeakAddr([]) :: leakages; + + while ((! zf)) { + leakages <- LeakAddr([]) :: leakages; + (aux_0, aux) <@ round2x (a, r, iotas, 0); + a <- aux_0; + r <- aux; + leakages <- LeakAddr([]) :: leakages; + (aux_0, aux) <@ round2x (r, a, iotas, 8); + r <- aux_0; + a <- aux; + leakages <- LeakAddr([]) :: leakages; + aux_1 <- (iotas + (W64.of_int 16)); + iotas <- aux_1; + leakages <- LeakAddr([]) :: leakages; + (aux_6, aux_5, aux_4, aux_3, aux_2) <- x86_TEST_8 (truncateu8 iotas) + (W8.of_int 255); + _0 <- aux_6; + _1 <- aux_5; + _2 <- aux_4; + _3 <- aux_3; + zf <- aux_2; + leakages <- LeakCond((! zf)) :: LeakAddr([]) :: leakages; + + } + leakages <- LeakAddr([]) :: leakages; + aux_1 <- (iotas - (W64.of_int 192)); + iotas <- aux_1; + return (a, iotas); + } + + proc spill_2 (a:W64.t, b:W64.t) : W64.t * W64.t = { + var aux: W64.t; + + var sa:W64.t; + var sb:W64.t; + + leakages <- LeakAddr([]) :: leakages; + aux <- a; + sa <- aux; + leakages <- LeakAddr([]) :: leakages; + aux <- b; + sb <- aux; + return (sa, sb); + } + + proc spill_3 (a:W64.t, b:W64.t, c:W64.t) : W64.t * W64.t * W64.t = { + var aux: W64.t; + + var sa:W64.t; + var sb:W64.t; + var sc:W64.t; + + leakages <- LeakAddr([]) :: leakages; + aux <- a; + sa <- aux; + leakages <- LeakAddr([]) :: leakages; + aux <- b; + sb <- aux; + leakages <- LeakAddr([]) :: leakages; + aux <- c; + sc <- aux; + return (sa, sb, sc); + } + + proc load_2 (sa:W64.t, sb:W64.t) : W64.t * W64.t = { + var aux: W64.t; + + var a:W64.t; + var b:W64.t; + + leakages <- LeakAddr([]) :: leakages; + aux <- sa; + a <- aux; + leakages <- LeakAddr([]) :: leakages; + aux <- sb; + b <- aux; + return (a, b); + } + + proc load_3 (sa:W64.t, sb:W64.t, sc:W64.t) : W64.t * W64.t * W64.t = { + var aux: W64.t; + + var a:W64.t; + var b:W64.t; + var c:W64.t; + + leakages <- LeakAddr([]) :: leakages; + aux <- sa; + a <- aux; + leakages <- LeakAddr([]) :: leakages; + aux <- sb; + b <- aux; + leakages <- LeakAddr([]) :: leakages; + aux <- sc; + c <- aux; + return (a, b, c); + } + + proc keccak_init () : W64.t Array25.t = { + var aux_3: bool; + var aux_2: bool; + var aux_1: bool; + var aux_0: bool; + var aux: bool; + var aux_4: W64.t; + + var state:W64.t Array25.t; + var t:W64.t; + var i:W64.t; + var _0:bool; + var _1:bool; + var _2:bool; + var _3:bool; + var _4:bool; + state <- witness; + leakages <- LeakAddr([]) :: leakages; + (aux_3, aux_2, aux_1, aux_0, aux, aux_4) <- set0_64 ; + _0 <- aux_3; + _1 <- aux_2; + _2 <- aux_1; + _3 <- aux_0; + _4 <- aux; + t <- aux_4; + leakages <- LeakAddr([]) :: leakages; + aux_4 <- (W64.of_int 0); + i <- aux_4; + + leakages <- LeakCond((i \ult (W64.of_int 25))) :: LeakAddr([]) :: leakages; + + while ((i \ult (W64.of_int 25))) { + leakages <- LeakAddr([]) :: leakages; + aux_4 <- t; + leakages <- LeakAddr([(W64.to_uint i)]) :: leakages; + state.[(W64.to_uint i)] <- aux_4; + leakages <- LeakAddr([]) :: leakages; + aux_4 <- (i + (W64.of_int 1)); + i <- aux_4; + leakages <- LeakCond((i \ult (W64.of_int 25))) :: LeakAddr([]) :: leakages; + + } + return (state); + } + + proc add_full_block (state:W64.t Array25.t, in_0:W64.t, inlen:W64.t, + rate:W64.t) : W64.t Array25.t * W64.t * W64.t = { + var aux: W64.t; + + var rate64:W64.t; + var i:W64.t; + var t:W64.t; + + leakages <- LeakAddr([]) :: leakages; + aux <- rate; + rate64 <- aux; + leakages <- LeakAddr([]) :: leakages; + aux <- (rate64 `>>` (W8.of_int 3)); + rate64 <- aux; + leakages <- LeakAddr([]) :: leakages; + aux <- (W64.of_int 0); + i <- aux; + + leakages <- LeakCond((i \ult rate64)) :: LeakAddr([]) :: leakages; + + while ((i \ult rate64)) { + leakages <- LeakAddr([(W64.to_uint (in_0 + ((W64.of_int 8) * i)))]) :: leakages; + aux <- (loadW64 Glob.mem (W64.to_uint (in_0 + ((W64.of_int 8) * i)))); + t <- aux; + leakages <- LeakAddr([(W64.to_uint i)]) :: leakages; + aux <- (state.[(W64.to_uint i)] `^` t); + leakages <- LeakAddr([(W64.to_uint i)]) :: leakages; + state.[(W64.to_uint i)] <- aux; + leakages <- LeakAddr([]) :: leakages; + aux <- (i + (W64.of_int 1)); + i <- aux; + leakages <- LeakCond((i \ult rate64)) :: LeakAddr([]) :: leakages; + + } + leakages <- LeakAddr([]) :: leakages; + aux <- (in_0 + rate); + in_0 <- aux; + leakages <- LeakAddr([]) :: leakages; + aux <- (inlen - rate); + inlen <- aux; + return (state, in_0, inlen); + } + + proc add_final_block (state:W64.t Array25.t, in_0:W64.t, inlen:W64.t, + trail_byte:W8.t, rate:W64.t) : W64.t Array25.t = { + var aux_0: W8.t; + var aux: W64.t; + + var inlen8:W64.t; + var i:W64.t; + var t:W64.t; + var c:W8.t; + + leakages <- LeakAddr([]) :: leakages; + aux <- inlen; + inlen8 <- aux; + leakages <- LeakAddr([]) :: leakages; + aux <- (inlen8 `>>` (W8.of_int 3)); + inlen8 <- aux; + leakages <- LeakAddr([]) :: leakages; + aux <- (W64.of_int 0); + i <- aux; + + leakages <- LeakCond((i \ult inlen8)) :: LeakAddr([]) :: leakages; + + while ((i \ult inlen8)) { + leakages <- LeakAddr([(W64.to_uint (in_0 + ((W64.of_int 8) * i)))]) :: leakages; + aux <- (loadW64 Glob.mem (W64.to_uint (in_0 + ((W64.of_int 8) * i)))); + t <- aux; + leakages <- LeakAddr([(W64.to_uint i)]) :: leakages; + aux <- (state.[(W64.to_uint i)] `^` t); + leakages <- LeakAddr([(W64.to_uint i)]) :: leakages; + state.[(W64.to_uint i)] <- aux; + leakages <- LeakAddr([]) :: leakages; + aux <- (i + (W64.of_int 1)); + i <- aux; + leakages <- LeakCond((i \ult inlen8)) :: LeakAddr([]) :: leakages; + + } + leakages <- LeakAddr([]) :: leakages; + aux <- (i `<<` (W8.of_int 3)); + i <- aux; + + leakages <- LeakCond((i \ult inlen)) :: LeakAddr([]) :: leakages; + + while ((i \ult inlen)) { + leakages <- LeakAddr([(W64.to_uint (in_0 + i))]) :: leakages; + aux_0 <- (loadW8 Glob.mem (W64.to_uint (in_0 + i))); + c <- aux_0; + leakages <- LeakAddr([(W64.to_uint i)]) :: leakages; + aux_0 <- ((get8 (WArray200.init64 (fun i => state.[i])) + (W64.to_uint i)) `^` c); + leakages <- LeakAddr([(W64.to_uint i)]) :: leakages; + state = + Array25.init + (WArray200.get64 (WArray200.set8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i) aux_0)); + leakages <- LeakAddr([]) :: leakages; + aux <- (i + (W64.of_int 1)); + i <- aux; + leakages <- LeakCond((i \ult inlen)) :: LeakAddr([]) :: leakages; + + } + leakages <- LeakAddr([(W64.to_uint i)]) :: leakages; + aux_0 <- ((get8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i)) `^` trail_byte); + leakages <- LeakAddr([(W64.to_uint i)]) :: leakages; + state = + Array25.init + (WArray200.get64 (WArray200.set8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i) aux_0)); + leakages <- LeakAddr([]) :: leakages; + aux <- rate; + i <- aux; + leakages <- LeakAddr([]) :: leakages; + aux <- (i - (W64.of_int 1)); + i <- aux; + leakages <- LeakAddr([(W64.to_uint i)]) :: leakages; + aux_0 <- ((get8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i)) `^` (W8.of_int 128)); + leakages <- LeakAddr([(W64.to_uint i)]) :: leakages; + state = + Array25.init + (WArray200.get64 (WArray200.set8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i) aux_0)); + return (state); + } + + proc absorb (state:W64.t Array25.t, iotas:W64.t, in_0:W64.t, inlen:W64.t, + s_trail_byte:W64.t, rate:W64.t) : W64.t Array25.t * W64.t * + W64.t = { + var aux_3: W8.t; + var aux_2: W64.t; + var aux_1: W64.t; + var aux_0: W64.t; + var aux: W64.t Array25.t; + + var s_in:W64.t; + var s_inlen:W64.t; + var s_rate:W64.t; + var t:W64.t; + var trail_byte:W8.t; + + + leakages <- LeakCond((rate \ule inlen)) :: LeakAddr([]) :: leakages; + + while ((rate \ule inlen)) { + leakages <- LeakAddr([]) :: leakages; + (aux, aux_2, aux_1) <@ add_full_block (state, in_0, inlen, rate); + state <- aux; + in_0 <- aux_2; + inlen <- aux_1; + leakages <- LeakAddr([]) :: leakages; + (aux_2, aux_1, aux_0) <@ spill_3 (in_0, inlen, rate); + s_in <- aux_2; + s_inlen <- aux_1; + s_rate <- aux_0; + leakages <- LeakAddr([]) :: leakages; + (aux, aux_2) <@ __keccak_f1600_scalar (state, iotas); + state <- aux; + iotas <- aux_2; + leakages <- LeakAddr([]) :: leakages; + (aux_2, aux_1, aux_0) <@ load_3 (s_in, s_inlen, s_rate); + in_0 <- aux_2; + inlen <- aux_1; + rate <- aux_0; + leakages <- LeakCond((rate \ule inlen)) :: LeakAddr([]) :: leakages; + + } + leakages <- LeakAddr([]) :: leakages; + aux_2 <- s_trail_byte; + t <- aux_2; + leakages <- LeakAddr([]) :: leakages; + aux_2 <- t; + trail_byte <- (truncateu8 aux_2); + leakages <- LeakAddr([]) :: leakages; + aux <@ add_final_block (state, in_0, inlen, trail_byte, rate); + state <- aux; + return (state, iotas, rate); + } + + proc xtr_full_block (state:W64.t Array25.t, out:W64.t, outlen:W64.t, + rate:W64.t) : W64.t * W64.t = { + var aux: W64.t; + + var rate64:W64.t; + var i:W64.t; + var t:W64.t; + + leakages <- LeakAddr([]) :: leakages; + aux <- rate; + rate64 <- aux; + leakages <- LeakAddr([]) :: leakages; + aux <- (rate64 `>>` (W8.of_int 3)); + rate64 <- aux; + leakages <- LeakAddr([]) :: leakages; + aux <- (W64.of_int 0); + i <- aux; + + leakages <- LeakCond((i \ult rate64)) :: LeakAddr([]) :: leakages; + + while ((i \ult rate64)) { + leakages <- LeakAddr([(W64.to_uint i)]) :: leakages; + aux <- state.[(W64.to_uint i)]; + t <- aux; + leakages <- LeakAddr([]) :: leakages; + aux <- t; + leakages <- LeakAddr([(W64.to_uint (out + ((W64.of_int 8) * i)))]) :: leakages; + Glob.mem <- + storeW64 Glob.mem (W64.to_uint (out + ((W64.of_int 8) * i))) aux; + leakages <- LeakAddr([]) :: leakages; + aux <- (i + (W64.of_int 1)); + i <- aux; + leakages <- LeakCond((i \ult rate64)) :: LeakAddr([]) :: leakages; + + } + leakages <- LeakAddr([]) :: leakages; + aux <- (out + rate); + out <- aux; + leakages <- LeakAddr([]) :: leakages; + aux <- (outlen - rate); + outlen <- aux; + return (out, outlen); + } + + proc xtr_bytes (state:W64.t Array25.t, out:W64.t, outlen:W64.t) : W64.t = { + var aux_0: W8.t; + var aux: W64.t; + + var outlen8:W64.t; + var i:W64.t; + var t:W64.t; + var c:W8.t; + + leakages <- LeakAddr([]) :: leakages; + aux <- outlen; + outlen8 <- aux; + leakages <- LeakAddr([]) :: leakages; + aux <- (outlen8 `>>` (W8.of_int 3)); + outlen8 <- aux; + leakages <- LeakAddr([]) :: leakages; + aux <- (W64.of_int 0); + i <- aux; + + leakages <- LeakCond((i \ult outlen8)) :: LeakAddr([]) :: leakages; + + while ((i \ult outlen8)) { + leakages <- LeakAddr([(W64.to_uint i)]) :: leakages; + aux <- state.[(W64.to_uint i)]; + t <- aux; + leakages <- LeakAddr([]) :: leakages; + aux <- t; + leakages <- LeakAddr([(W64.to_uint (out + ((W64.of_int 8) * i)))]) :: leakages; + Glob.mem <- + storeW64 Glob.mem (W64.to_uint (out + ((W64.of_int 8) * i))) aux; + leakages <- LeakAddr([]) :: leakages; + aux <- (i + (W64.of_int 1)); + i <- aux; + leakages <- LeakCond((i \ult outlen8)) :: LeakAddr([]) :: leakages; + + } + leakages <- LeakAddr([]) :: leakages; + aux <- (i `<<` (W8.of_int 3)); + i <- aux; + + leakages <- LeakCond((i \ult outlen)) :: LeakAddr([]) :: leakages; + + while ((i \ult outlen)) { + leakages <- LeakAddr([(W64.to_uint i)]) :: leakages; + aux_0 <- (get8 (WArray200.init64 (fun i => state.[i])) (W64.to_uint i)); + c <- aux_0; + leakages <- LeakAddr([]) :: leakages; + aux_0 <- c; + leakages <- LeakAddr([(W64.to_uint (out + i))]) :: leakages; + Glob.mem <- storeW8 Glob.mem (W64.to_uint (out + i)) aux_0; + leakages <- LeakAddr([]) :: leakages; + aux <- (i + (W64.of_int 1)); + i <- aux; + leakages <- LeakCond((i \ult outlen)) :: LeakAddr([]) :: leakages; + + } + leakages <- LeakAddr([]) :: leakages; + aux <- (out + outlen); + out <- aux; + return (out); + } + + proc squeeze (state:W64.t Array25.t, iotas:W64.t, s_out:W64.t, + outlen:W64.t, rate:W64.t) : unit = { + var aux_2: W64.t; + var aux_0: W64.t; + var aux: W64.t; + var aux_1: W64.t Array25.t; + + var s_outlen:W64.t; + var s_rate:W64.t; + var out:W64.t; + + + leakages <- LeakCond((rate \ult outlen)) :: LeakAddr([]) :: leakages; + + while ((rate \ult outlen)) { + leakages <- LeakAddr([]) :: leakages; + (aux_2, aux_0) <@ spill_2 (outlen, rate); + s_outlen <- aux_2; + s_rate <- aux_0; + leakages <- LeakAddr([]) :: leakages; + (aux_1, aux_2) <@ __keccak_f1600_scalar (state, iotas); + state <- aux_1; + iotas <- aux_2; + leakages <- LeakAddr([]) :: leakages; + (aux_2, aux_0, aux) <@ load_3 (s_out, s_outlen, s_rate); + out <- aux_2; + outlen <- aux_0; + rate <- aux; + leakages <- LeakAddr([]) :: leakages; + (aux_2, aux_0) <@ xtr_full_block (state, out, outlen, rate); + out <- aux_2; + outlen <- aux_0; + leakages <- LeakAddr([]) :: leakages; + aux_2 <- out; + s_out <- aux_2; + leakages <- LeakCond((rate \ult outlen)) :: LeakAddr([]) :: leakages; + + } + leakages <- LeakAddr([]) :: leakages; + aux_2 <- outlen; + s_outlen <- aux_2; + leakages <- LeakAddr([]) :: leakages; + (aux_1, aux_2) <@ __keccak_f1600_scalar (state, iotas); + state <- aux_1; + iotas <- aux_2; + leakages <- LeakAddr([]) :: leakages; + (aux_2, aux_0) <@ load_2 (s_out, s_outlen); + out <- aux_2; + outlen <- aux_0; + leakages <- LeakAddr([]) :: leakages; + aux_2 <@ xtr_bytes (state, out, outlen); + out <- aux_2; + return (); + } + + proc __keccak_1600 (s_out:W64.t, s_outlen:W64.t, iotas:W64.t, in_0:W64.t, + inlen:W64.t, s_trail_byte:W64.t, rate:W64.t) : unit = { + var aux_1: W64.t; + var aux_0: W64.t; + var aux: W64.t Array25.t; + + var state:W64.t Array25.t; + var outlen:W64.t; + state <- witness; + leakages <- LeakAddr([]) :: leakages; + aux <@ keccak_init (); + state <- aux; + leakages <- LeakAddr([]) :: leakages; + (aux, aux_1, aux_0) <@ absorb (state, iotas, in_0, inlen, s_trail_byte, + rate); + state <- aux; + iotas <- aux_1; + rate <- aux_0; + leakages <- LeakAddr([]) :: leakages; + aux_1 <- s_outlen; + outlen <- aux_1; + leakages <- LeakAddr([]) :: leakages; + squeeze (state, iotas, s_out, outlen, rate); + return (); + } +}. + +equiv ct: + M.__keccak_1600 ~ M.__keccak_1600 : + ={inlen,s_outlen,M.leakages,rate,in_0,s_out,iotas} ==> ={M.leakages}. +proc. + +(* Squeeze *) +call(_: ={outlen, s_out, M.leakages,iotas,rate} ==> ={M.leakages}). + +proc. +wp;call(_: ={outlen, out,M.leakages} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,arg} ==> ={M.leakages,res}). +proc. +by sim. + +(* Squeeze last f *) +wp;call(_: ={M.leakages,iotas} ==> ={M.leakages} /\ res{1}.`2 = res{2}.`2). +proc. + +wp;while (={zf,iotas,M.leakages}). + +(* Squeeze last f loop round2x 2 *) +wp;call(_: ={M.leakages,iotas,o} ==> ={M.leakages}). +proc. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages} ==> ={M.leakages}). +proc. +by sim. +by auto => />. + +(* Squeeze last f last f loop round2x 1 *) +wp;call(_: ={M.leakages,iotas,o} ==> ={M.leakages}). +proc. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages} ==> ={M.leakages}). +proc. +by sim. +by auto => />. + +by auto => />. + + +(* Squeeze last f last f first round2x 2 *) +wp;call(_: ={M.leakages,iotas,o} ==> ={M.leakages}). +proc. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages} ==> ={M.leakages}). +proc. +by sim. +by auto => />. + +(* Squeeze last f first round2x 1 *) +wp;call(_: ={M.leakages,iotas,o} ==> ={M.leakages}). +proc. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. + +wp;call(_: ={M.leakages} ==> ={M.leakages}). +proc. +by sim. + +wp;call(_: ={M.leakages} ==> ={M.leakages}). +proc. +by sim. + +by auto => />. + +by auto => />. + +wp;while (={rate,s_out,outlen,iotas,M.leakages}); last by auto => />. + +wp;call(_: ={outlen, out,rate,M.leakages} ==> ={M.leakages,res}). +proc. +by sim. +wp;call(_: ={M.leakages,arg} ==> ={M.leakages,res}). +proc. +by sim. + +(* Squeeze first f *) +wp;call(_: ={M.leakages,iotas} ==> ={M.leakages} /\ res{1}.`2 = res{2}.`2). +proc. + +wp;while (={zf,iotas,M.leakages}). + +(* Squeeze first f loop round2x 2 *) +wp;call(_: ={M.leakages,iotas,o} ==> ={M.leakages}). +proc. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages} ==> ={M.leakages}). +proc. +by sim. +by auto => />. + +(* Squeeze first f last f loop round2x 1 *) +wp;call(_: ={M.leakages,iotas,o} ==> ={M.leakages}). +proc. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages} ==> ={M.leakages}). +proc. +by sim. +by auto => />. + +by auto => />. + + +(* Squeeze last f last f first round2x 2 *) +wp;call(_: ={M.leakages,iotas,o} ==> ={M.leakages}). +proc. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages} ==> ={M.leakages}). +proc. +by sim. +by auto => />. + +(* Squeeze last f first round2x 1 *) +wp;call(_: ={M.leakages,iotas,o} ==> ={M.leakages}). +proc. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. + +wp;call(_: ={M.leakages} ==> ={M.leakages}). +proc. +by sim. + +wp;call(_: ={M.leakages} ==> ={M.leakages}). +proc. +by sim. + +by auto => />. + +by auto => />. + +wp;call(_: ={M.leakages,arg} ==> ={M.leakages,res}). +proc. +by sim. + +by auto => />. + +(* Initialization *) + +wp;call(_: ={M.leakages,iotas,rate,in_0,inlen} ==> ={M.leakages} /\ res{1}.`2 = res{2}.`2 /\ res{1}.`3 = res{2}.`3); last by inline *;wp; while (={i,M.leakages}) => //=; auto => />. + +(* Absorb *) +proc. +wp;call(_: ={M.leakages,rate,in_0,inlen} ==> ={M.leakages}). +proc. +by sim. +wp;while (={rate,inlen,in_0,iotas,M.leakages}). +wp;call(_: ={M.leakages,arg} ==> ={M.leakages,res}). +proc. +by sim. + +(* Absorb f *) +wp;call(_: ={M.leakages,iotas} ==> ={M.leakages} /\ res{1}.`2 = res{2}.`2). +proc. + +auto => />. +progress. + +wp;while (={zf,iotas,M.leakages}). + +(* Absorb f loop round2x 2 *) +wp;call(_: ={M.leakages,iotas,o} ==> ={M.leakages}). +proc. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages} ==> ={M.leakages}). +proc. +by sim. +by auto => />. + +(* Absorb f loop round2x 1 *) +wp;call(_: ={M.leakages,iotas,o} ==> ={M.leakages}). +proc. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages} ==> ={M.leakages}). +proc. +by sim. +by auto => />. + +by auto => />. + + +(* Absorb f first round2x 2 *) +wp;call(_: ={M.leakages,iotas,o} ==> ={M.leakages}). +proc. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages} ==> ={M.leakages}). +proc. +by sim. +by auto => />. + +(* Absorb f first round2x 1 *) +wp;call(_: ={M.leakages,iotas,o} ==> ={M.leakages}). +proc. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages,row} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages,offset} ==> ={M.leakages}). +proc. +while (={j,M.leakages,offset}). +by inline *; sim. +by auto => />. +wp;call(_: ={M.leakages} ==> ={M.leakages}). +proc. +by sim. +wp;call(_: ={M.leakages} ==> ={M.leakages}). +proc. +by sim. +by auto => />. + +by auto => />. + + +wp;call(_: ={M.leakages,arg} ==> ={M.leakages,res}). +proc. +by sim. + + +wp;call(_: ={M.leakages,in_0,inlen,rate} ==> ={M.leakages} /\ res{1}.`2 = res{2}.`2 /\ res{1}.`3 = res{2}.`3). +proc. +wp;while(={i,rate64,M.leakages,in_0}). +by sim. +by auto => />. + +by auto => />. + +by auto => />. + +qed. From 59a51577aebf61fa78f3b195f8592de984cb8cbc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Fri, 2 Aug 2019 20:39:22 +0000 Subject: [PATCH 435/525] Disable TLS in CI (temporary fix for CI) --- .gitlab-ci.yml | 1 + 1 file changed, 1 insertion(+) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index f2d2577..d428abb 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -1,6 +1,7 @@ image: docker:latest variables: DOCKER_DRIVER: overlay + DOCKER_TLS_CERTDIR: "" services: - docker:dind before_script: From 8ee685bf936031d0e1f210bb3e4a483bb9074a3b Mon Sep 17 00:00:00 2001 From: Pierre-Yves Strub Date: Mon, 5 Aug 2019 09:22:13 +0200 Subject: [PATCH 436/525] max-provers --- config/tests.config | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/config/tests.config b/config/tests.config index fc72c0d..e52640a 100644 --- a/config/tests.config +++ b/config/tests.config @@ -1,6 +1,6 @@ [default] bin = easycrypt -args = -I proof -I proof/smart_counter -timeout 10 +args = -I proof -I proof/smart_counter -timeout 10 -max-provers 4 [test-sha3] okdirs = !proof From 89cc238b512ed90d3e2ed6d4ee9463b2cb71d2e9 Mon Sep 17 00:00:00 2001 From: Manuel Barbosa Date: Mon, 5 Aug 2019 14:45:23 +0100 Subject: [PATCH 437/525] Pending --- proof/impl/libc/keccak_1600_avx2_modular.ec | 1 - proof/impl/libc/keccak_1600_ref.ec | 16 ++++++++-------- proof/impl/libc/keccak_1600_scalar_modular.ec | 14 -------------- 3 files changed, 8 insertions(+), 23 deletions(-) diff --git a/proof/impl/libc/keccak_1600_avx2_modular.ec b/proof/impl/libc/keccak_1600_avx2_modular.ec index 588bd2f..b7c08a1 100644 --- a/proof/impl/libc/keccak_1600_avx2_modular.ec +++ b/proof/impl/libc/keccak_1600_avx2_modular.ec @@ -863,7 +863,6 @@ proof. smt (@W64 jagged_bound jagged_inj). qed. -(* some precondition on jagged needed *) require import Keccak_f1600_scalar_table. op disj_ptr (p1 : address) (len1:int) (p2: address) ( len2:int) = diff --git a/proof/impl/libc/keccak_1600_ref.ec b/proof/impl/libc/keccak_1600_ref.ec index 969484a..a5884e8 100644 --- a/proof/impl/libc/keccak_1600_ref.ec +++ b/proof/impl/libc/keccak_1600_ref.ec @@ -284,23 +284,23 @@ module M = { } proc add_full_block (state:W64.t Array25.t, in_0:W64.t, inlen:W64.t, - rate:W64.t) : W64.t Array25.t * W64.t * W64.t = { + r8:W64.t) : W64.t Array25.t * W64.t * W64.t = { - var rate64:W64.t; + var r64:W64.t; var i:W64.t; var t:W64.t; - rate64 <- rate; - rate64 <- (rate64 `>>` (W8.of_int 3)); + r64 <- r8; + r64 <- (r64 `>>` (W8.of_int 3)); i <- (W64.of_int 0); - while ((i \ult rate64)) { + while ((i \ult r64)) { t <- (loadW64 Glob.mem (W64.to_uint (in_0 + ((W64.of_int 8) * i)))); state.[(W64.to_uint i)] <- (state.[(W64.to_uint i)] `^` t); i <- (i + (W64.of_int 1)); } - in_0 <- (in_0 + rate); - inlen <- (inlen - rate); + in_0 <- (in_0 + r8); + inlen <- (inlen - r8); return (state, in_0, inlen); } @@ -430,9 +430,9 @@ module M = { outlen <- s_outlen; rate <- s_rate; (out, outlen) <@ xtr_full_block (state, out, outlen, rate); + s_outlen <- outlen; s_out <- out; } - s_outlen <- outlen; state <@ __keccak_f1600_ref (state); out <- s_out; outlen <- s_outlen; diff --git a/proof/impl/libc/keccak_1600_scalar_modular.ec b/proof/impl/libc/keccak_1600_scalar_modular.ec index 2713945..1043dbe 100644 --- a/proof/impl/libc/keccak_1600_scalar_modular.ec +++ b/proof/impl/libc/keccak_1600_scalar_modular.ec @@ -256,20 +256,6 @@ proc. by sim. qed. -(* -op good_iotas (mem : global_mem_t, _iotas : int) = - forall off, 0 <= off < 24 => - loadW64 mem (_iotas + (off * 8)) = Keccak_f1600_ref_op.iotas.[off]. - - -equiv plugin mem _iotas : - Keccak_1600_ref_modular.Mmod.__keccak_f1600_ref ~ Mmod.__keccak_f1600_scalar : - Glob.mem{2} = mem /\ good_iotas mem (to_uint iotas{2}) /\ ={Glob.mem} /\ arg{1} = arg{2}.`1 /\ _iotas = arg{2}.`2 ==> - Glob.mem{2} = mem /\ ={Glob.mem} /\ res{1} = res{2}.`1 /\ _iotas = res{2}.`2. -(* there in perm *) -admit. -qed. -*) require Keccak_f1600_scalar_table. op disj_ptr (p1 : address) (len1:int) (p2: address) ( len2:int) = From 50eccf7933ae8b55db093009382dccfe4adbff53 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Mon, 5 Aug 2019 14:57:18 +0100 Subject: [PATCH 438/525] Make the CI run over libc --- .gitlab-ci.yml | 11 +++++++++++ config/tests.config | 4 ++++ 2 files changed, 15 insertions(+) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index d428abb..9eb9b25 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -41,3 +41,14 @@ jasmin permutation: when: on_failure paths: - xunit.xml +jasmin libc: + only: + - master + script: + - >- + docker run -v $PWD:/home/ci/sha3 easycryptpa/ec-test-box:kms + sh -c 'cd sha3 && git clone -b array_cast https://github.com/jasmin-lang/jasmin && CHECKS=libc ECARGS="-I Jasmin:/home/ci/sha3/jasmin/eclib" opam config exec -- make check-xunit' + artifacts: + when: on_failure + paths: + - xunit.xml diff --git a/config/tests.config b/config/tests.config index e52640a..d2d1d5f 100644 --- a/config/tests.config +++ b/config/tests.config @@ -13,3 +13,7 @@ okdirs = proof/impl [test-jperm] okdirs = proof/impl/perm + +[test-libc] +args = -I proof/impl -I proof/impl/perm -timeout 10 +okdirs = proof/impl/libc From 1fce9a93ad6d6da2d03e0fbf6b93d35f4909e1c8 Mon Sep 17 00:00:00 2001 From: Pierre-Yves Strub Date: Tue, 6 Aug 2019 10:35:10 +0200 Subject: [PATCH 439/525] --- .gitlab-ci.yml | 66 ++++++++++++++++++++++++-------------------------- Makefile | 7 +++--- 2 files changed, 36 insertions(+), 37 deletions(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 9eb9b25..fbb2062 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -1,54 +1,52 @@ image: docker:latest + variables: DOCKER_DRIVER: overlay DOCKER_TLS_CERTDIR: "" + ECARGS: "-I Jasmin:/home/ci/jasmin/eclib" + ECJOBS: 3 + services: - docker:dind + before_script: - docker info - docker pull easycryptpa/ec-test-box:kms - docker run --rm easycryptpa/ec-test-box:kms opam config exec -- easycrypt config -sponge: +- >- + docker run --name testbox easycryptpa/ec-test-box:kms + git clone -b array_cast https://github.com/jasmin-lang/jasmin jasmin +- docker commit testbox testbox:latest + +.tests: only: - master script: - >- - docker run -v $PWD:/home/ci/sha3 easycryptpa/ec-test-box:kms - sh -c 'cd sha3 && CHECKS=sponge opam config exec -- make check-xunit' + docker run -v $PWD:/home/ci/sha3 + --env CHECKS --env ECARGS --env ECJOBS testbox + sh -c 'cd sha3 && opam config exec -- make check-xunit' artifacts: when: on_failure paths: - - xunit.xml + - xunit.yml + +sponge: + extends: .tests + variables: + CHECKS: sponge + jasmin sponge: - only: - - master - script: - - >- - docker run -v $PWD:/home/ci/sha3 easycryptpa/ec-test-box:kms - sh -c 'cd sha3 && git clone -b array_cast https://github.com/jasmin-lang/jasmin && CHECKS=jsponge ECARGS="-I Jasmin:/home/ci/sha3/jasmin/eclib" opam config exec -- make check-xunit' - artifacts: - when: on_failure - paths: - - xunit.xml + extends: .tests + variables: + CHECKS: jsponge + jasmin permutation: - only: - - master - script: - - >- - docker run -v $PWD:/home/ci/sha3 easycryptpa/ec-test-box:kms - sh -c 'cd sha3 && git clone -b array_cast https://github.com/jasmin-lang/jasmin && CHECKS=jperm ECARGS="-I Jasmin:/home/ci/sha3/jasmin/eclib" opam config exec -- make check-xunit' - artifacts: - when: on_failure - paths: - - xunit.xml + extends: .tests + variables: + CHECKS: jperm + jasmin libc: - only: - - master - script: - - >- - docker run -v $PWD:/home/ci/sha3 easycryptpa/ec-test-box:kms - sh -c 'cd sha3 && git clone -b array_cast https://github.com/jasmin-lang/jasmin && CHECKS=libc ECARGS="-I Jasmin:/home/ci/sha3/jasmin/eclib" opam config exec -- make check-xunit' - artifacts: - when: on_failure - paths: - - xunit.xml + extends: .tests + variables: + CHECKS: libc diff --git a/Makefile b/Makefile index 3687a13..cbbd5a4 100644 --- a/Makefile +++ b/Makefile @@ -4,8 +4,9 @@ ECROOT ?= ECCHECK ?= ECARGS ?= +ECJOBS ?= 1 ECCONF := config/tests.config -XUNITOUT ?= xunit.xml +XUNITOUT ?= xunit.yml CHECKS ?= sha3 ifeq ($(ECCHECK),) @@ -26,7 +27,7 @@ usage: @echo "Usage: make where in [check|check-xunit]" >&2 check: - $(ECCHECK) --bin-args="$(ECARGS)" $(ECCONF) $(CHECKS) + $(ECCHECK) --jobs=$(ECJOBS) --bin-args="$(ECARGS)" $(ECCONF) $(CHECKS) check-xunit: - $(ECCHECK) --bin-args="$(ECARGS)" --report=$(XUNITOUT) $(ECCONF) $(CHECKS) + $(ECCHECK) --jobs=$(ECJOBS) --bin-args="$(ECARGS)" --report=$(XUNITOUT) $(ECCONF) $(CHECKS) From 29f78d79dfa1b63e2e513c169bd98ac9d23fca00 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Tue, 6 Aug 2019 11:56:18 +0100 Subject: [PATCH 440/525] CI: reduce parallelism; simplify test suite config --- .gitlab-ci.yml | 2 +- config/tests.config | 3 +-- 2 files changed, 2 insertions(+), 3 deletions(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index fbb2062..ba75829 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -4,7 +4,7 @@ variables: DOCKER_DRIVER: overlay DOCKER_TLS_CERTDIR: "" ECARGS: "-I Jasmin:/home/ci/jasmin/eclib" - ECJOBS: 3 + ECJOBS: 2 services: - docker:dind diff --git a/config/tests.config b/config/tests.config index d2d1d5f..dc6bc6b 100644 --- a/config/tests.config +++ b/config/tests.config @@ -1,6 +1,6 @@ [default] bin = easycrypt -args = -I proof -I proof/smart_counter -timeout 10 -max-provers 4 +args = -timeout 10 -max-provers 3 -I proof -I proof/smart_counter -I proof/impl -I proof/impl/perm [test-sha3] okdirs = !proof @@ -15,5 +15,4 @@ okdirs = proof/impl okdirs = proof/impl/perm [test-libc] -args = -I proof/impl -I proof/impl/perm -timeout 10 okdirs = proof/impl/libc From 03421feb50947a837a3f0168d1d699a7ca14e579 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Sat, 3 Aug 2019 17:27:28 +0100 Subject: [PATCH 441/525] fix and refine smt calls --- proof/impl/perm/keccak_f1600_avx2_prevec.ec | 24 ++++++++++---------- proof/impl/perm/keccak_f1600_scalar_table.ec | 11 ++++----- 2 files changed, 17 insertions(+), 18 deletions(-) diff --git a/proof/impl/perm/keccak_f1600_avx2_prevec.ec b/proof/impl/perm/keccak_f1600_avx2_prevec.ec index c2da8c8..e7bf54b 100644 --- a/proof/impl/perm/keccak_f1600_avx2_prevec.ec +++ b/proof/impl/perm/keccak_f1600_avx2_prevec.ec @@ -451,7 +451,7 @@ rewrite (_: x + x = x `<<` W8.one). rewrite /(`<<`) => />. rewrite /(`<<`) /(`>>`) => />. rewrite xorE orE !map2E => />. apply W64.init_ext. -progress. smt. +progress. smt(@W64). qed. lemma commor : forall (x y : W64.t), x `|` y = y `|` x. @@ -464,7 +464,7 @@ qed. lemma rol0 : forall x, (x86_ROL_64 x W8.zero).`3 = x. move => *. rewrite x86_ROL_64_E rol_xor =>/>. -smt. +exact/lsr_0. qed. lemma roln : forall x n, 0 <= n < 64 => @@ -485,7 +485,7 @@ rewrite (_: n %% 64 = n); first by smt(). rewrite (_: (64 - n) %% 64 = 64 - n); first by smt(). rewrite xorE orE !map2E => />. apply W64.init_ext. -progress. smt. +progress. smt(@W64). qed. op good_io4x (mem : global_mem_t, _iotas : int) = @@ -596,7 +596,7 @@ proof. have -> : to_uint x + 32 * off + 16 = to_uint x + (4 * off + 2) * 8 by ring. have -> : to_uint x + 32 * off + 8 = to_uint x + (4 * off + 1) * 8 by ring. have -> : 32 * off = (4 * off) * 8 by ring. - move : (hgood (off * 4 + i) _) => />. smt. smt (Array4.get_setE). + move : (hgood (off * 4 + i) _) => />. smt(@W64). smt (Array4.get_setE). qed. op conversion(o1 o2 : int) : int = @@ -1318,8 +1318,8 @@ seq 2 1 : (#{/~ state0{1}}pre /\ inline *; wp; skip; rewrite /equiv_states /index; progress. -have iii : (to_uint _iotas{2} + 768 < W64.modulus); first by smt. -have iv : (good_io4x Glob.mem{2} (to_uint _iotas{2})); first by smt. +have iii : (to_uint _iotas{2} + 768 < W64.modulus); first by smt(@W64). +have iv : (good_io4x Glob.mem{2} (to_uint _iotas{2})); first by smt(@W64). move : (loadlift_iotas Glob.mem{2} _iotas{2} (round{1}) iii iv) => ii. rewrite (_:round{1} * 32 = 8*4*round{1}); first by smt(). rewrite ii. simplify. smt(). @@ -1350,8 +1350,8 @@ case (round{1} = 22). auto => />. smt(@W64). case (round{1} = 23). auto => />. smt(@W64). smt(). -have iii : (to_uint _iotas{2} + 768 < W64.modulus); first by smt. -have iv : (good_io4x Glob.mem{2} (to_uint _iotas{2})); first by smt. +have iii : (to_uint _iotas{2} + 768 < W64.modulus); first by smt(@W64). +have iv : (good_io4x Glob.mem{2} (to_uint _iotas{2})); first by smt(@W64). move : (loadlift_iotas Glob.mem{2} _iotas{2} (round{1}) iii iv) => ii. rewrite (_:round{1} * 32 = 8*4*round{1}); first by smt(). rewrite ii. simplify. smt(). @@ -1382,8 +1382,8 @@ case (round{1} = 22). auto => />. smt(@W64). case (round{1} = 23). auto => />. smt(@W64). smt(). -have iii : (to_uint _iotas{2} + 768 < W64.modulus); first by smt. -have iv : (good_io4x Glob.mem{2} (to_uint _iotas{2})); first by smt. +have iii : (to_uint _iotas{2} + 768 < W64.modulus); first by smt(@W64). +have iv : (good_io4x Glob.mem{2} (to_uint _iotas{2})); first by smt(@W64). move : (loadlift_iotas Glob.mem{2} _iotas{2} (round{1}) iii iv) => ii. rewrite (_:round{1} * 32 = 8*4*round{1}); first by smt(). rewrite ii. simplify. smt(). @@ -1414,8 +1414,8 @@ case (round{1} = 22). auto => />. smt(@W64). case (round{1} = 23). auto => />. smt(@W64). smt(). -have iii : (to_uint _iotas{2} + 768 < W64.modulus); first by smt. -have iv : (good_io4x Glob.mem{2} (to_uint _iotas{2})); first by smt. +have iii : (to_uint _iotas{2} + 768 < W64.modulus); first by smt(@W64). +have iv : (good_io4x Glob.mem{2} (to_uint _iotas{2})); first by smt(@W64). move : (loadlift_iotas Glob.mem{2} _iotas{2} (round{1}) iii iv) => ii. rewrite (_:round{1} * 32 = 8*4*round{1}); first by smt(). rewrite ii. simplify. smt(). diff --git a/proof/impl/perm/keccak_f1600_scalar_table.ec b/proof/impl/perm/keccak_f1600_scalar_table.ec index d9ffb06..a2a99aa 100644 --- a/proof/impl/perm/keccak_f1600_scalar_table.ec +++ b/proof/impl/perm/keccak_f1600_scalar_table.ec @@ -9,7 +9,6 @@ require import Keccak_f1600_ref_loop2. require import Keccak_f1600_scalar. require import Keccak_f1600_ref_op. - module Mscalarrho = { include M [-keccak_rho_offsets,rhotates,rol_sum,round2x,__keccak_f1600_scalar] include RhotatesAlgo @@ -239,14 +238,14 @@ qed. lemma rol0 : (forall x , (x86_ROL_64 x (W8.of_int (rhotates 0))).`3 = x). move => *. -rewrite x86_ROL_64_E /rhotates rol_xor =>/>. -smt. +rewrite x86_ROL_64_E /rhotates rol_xor =>/>. +exact/Ops.lsr_0. qed. lemma rol00 : (forall x , (x86_ROL_64 x (W8.zero)).`3 = x). move => *. rewrite x86_ROL_64_E /rhotates rol_xor =>/>. -smt. +exact/Ops.lsr_0. qed. lemma scalarcorr _iotas mem : @@ -490,12 +489,12 @@ rewrite to_uintD;smt(). smt(). smt(). smt(). rewrite (testsem (iotas{2} + (of_int 16)%W64)). rewrite to_uintD. -rewrite (_ : (to_uint iotas{2} + to_uint ((of_int 16))%W64) %% W64.modulus %% 256 = (to_uint iotas{2} + to_uint ((of_int 16))%W64) %% 256). smt. smt(). +rewrite (_ : (to_uint iotas{2} + to_uint ((of_int 16))%W64) %% W64.modulus %% 256 = (to_uint iotas{2} + to_uint ((of_int 16))%W64) %% 256). smt(@W64). smt(). move : H8. rewrite testsem. rewrite to_uintD. -rewrite (_ : (to_uint iotas{2} + to_uint ((of_int 16))%W64) %% W64.modulus %% 256 = (to_uint iotas{2} + to_uint ((of_int 16))%W64) %% 256). smt. smt(). +rewrite (_ : (to_uint iotas{2} + to_uint ((of_int 16))%W64) %% W64.modulus %% 256 = (to_uint iotas{2} + to_uint ((of_int 16))%W64) %% 256). smt(@W64). smt(). auto => />. progress. From 39bcf8f68fe347a0dd82a7bdc204bc459c23e749 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Tue, 6 Aug 2019 18:34:39 +0000 Subject: [PATCH 442/525] Reduce parallelism further --- config/tests.config | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/config/tests.config b/config/tests.config index dc6bc6b..e031c32 100644 --- a/config/tests.config +++ b/config/tests.config @@ -1,6 +1,6 @@ [default] bin = easycrypt -args = -timeout 10 -max-provers 3 -I proof -I proof/smart_counter -I proof/impl -I proof/impl/perm +args = -timeout 10 -max-provers 2 -I proof -I proof/smart_counter -I proof/impl -I proof/impl/perm [test-sha3] okdirs = !proof From 7266bb3e24caf4a4310b650944b7880a9babae9d Mon Sep 17 00:00:00 2001 From: Pierre-Yves Strub Date: Tue, 6 Aug 2019 21:06:35 +0200 Subject: [PATCH 443/525] --- .gitlab-ci.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index ba75829..33341bf 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -4,7 +4,7 @@ variables: DOCKER_DRIVER: overlay DOCKER_TLS_CERTDIR: "" ECARGS: "-I Jasmin:/home/ci/jasmin/eclib" - ECJOBS: 2 + ECJOBS: 1 services: - docker:dind From 413121221f7caa0c46ba1de01570b7494f3f7ec3 Mon Sep 17 00:00:00 2001 From: Pierre-Yves Strub Date: Tue, 6 Aug 2019 21:27:41 +0200 Subject: [PATCH 444/525] --- config/tests.config | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/config/tests.config b/config/tests.config index e031c32..6382a1d 100644 --- a/config/tests.config +++ b/config/tests.config @@ -1,6 +1,6 @@ [default] bin = easycrypt -args = -timeout 10 -max-provers 2 -I proof -I proof/smart_counter -I proof/impl -I proof/impl/perm +args = -timeout 30 -max-provers 2 -I proof -I proof/smart_counter -I proof/impl -I proof/impl/perm [test-sha3] okdirs = !proof From 3612ced0b35e2bcb869e6ad2716c1ff372950ae3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Thu, 8 Aug 2019 21:33:31 +0100 Subject: [PATCH 445/525] Domain Separation: abstract example Proof that domain separation *on random oracles* preserves indifferentiability. There is a missing bit on the concrete side, and the proof is not clean. --- utils/DomainSeparation.eca | 253 +++++++++++++++++++++++++++++++++++++ 1 file changed, 253 insertions(+) create mode 100644 utils/DomainSeparation.eca diff --git a/utils/DomainSeparation.eca b/utils/DomainSeparation.eca new file mode 100644 index 0000000..7d124a5 --- /dev/null +++ b/utils/DomainSeparation.eca @@ -0,0 +1,253 @@ +require import AllCore Distr SmtMap. + +abstract theory Indif. +type freq, frsp. +type preq, prsp. + +module type Functionality = { + proc f(_: freq): frsp +}. + +module type Primitive = { + proc p(_: preq): prsp +}. + +module type Construction (P : Primitive) = { + proc f(_: freq): frsp +}. + +module type Simulator (F : Functionality) = { + proc p(_: preq): prsp +}. + +module type Distinguisher (F : Functionality) (P : Primitive) = { + proc dist(): bool +}. +end Indif. + +type freq, frsp. +op df : frsp distr. + +type preq, prsp. +op dp : prsp distr. + +type qtype = [ D1 | D2 ]. + +op format : qtype -> freq -> freq. +op extract: freq -> (qtype option) * freq. + +axiom extractP r t r': + extract r = (Some t, r') <=> format t r' = r. + +axiom extractP_out r r': + extract r = (None, r') <=> r = r'. + +clone Indif as Single with + type freq <- freq, + type frsp <- frsp, + type preq <- preq, + type prsp <- prsp. + +clone Indif as Double with + type freq <- qtype * freq, + type frsp <- frsp, + type preq <- preq, + type prsp <- prsp. + +module P = { + var m : (preq, prsp) fmap + + proc p(x : preq) = { + var r; + + r <$ dp; + if (x \notin m) { + m.[x] <- r; + } + return oget m.[x]; + } +}. + +module I : Single.Functionality = { + var m : (freq, frsp) fmap + + proc f(x : freq) = { + var r; + + r <$ df; + if (x \notin m) { + m.[x] <- r; + } + return oget m.[x]; + } +}. + +module I2 : Double.Functionality = { + var m1 : (freq, frsp) fmap + var m2 : (freq, frsp) fmap + + proc f(t : qtype, x : freq) = { + var r, s; + + s <- witness; (* nop *) + r <$ df; + if (t = D1) { + if (x \notin m1) { + m1.[x] <- r; + } + s <- oget m1.[x]; + } + if (t = D2) { + if (x \notin m2) { + m2.[x] <- r; + } + s <- oget m2.[x]; + } + return s; + } +}. + +module F2 (F : Single.Functionality) = { + proc f(t : qtype, x : freq) = { + var r; + + r <@ F.f(format t x); + return r; + } +}. + +module F1 (F : Double.Functionality) : Single.Functionality = { + var m : (freq, frsp) fmap + + proc f(x : freq) = { + var ot, r, s; + + s <- witness; (* nop *) + (ot, r) <- extract x; + if (ot <> None) { + s <@ F.f(oget ot, r); + } else { + s <$ df; + if (r \notin m) { + m.[r] <- s; + } + s <- oget m.[r]; + } + return s; + } +}. + +inductive split_map (m1 m1' m2 : (freq, frsp) fmap) = + | SplitMap of (forall x r t, + m2.[x] = Some r => + (extract x).`1 = Some t => + m1.[x] = Some r /\ m1'.[x] = None) + & (forall x r, + m2.[x] = Some r => + (extract x).`1 = None => + m1.[x] = None /\ m1'.[x] = Some r) + & (forall x, m2.[x] = None <=> (m1.[x] = None /\ m1'.[x] = None)). + +module S2 (S : Single.Simulator) (F : Double.Functionality) = S(F1(F)). +module D1 (D : Double.Distinguisher) (F : Single.Functionality) (P : Single.Primitive) = D(F2(F), P). + +section DomainSeparation. +declare module C : Single.Construction { I, F1, P }. +declare module S : Single.Simulator { I, F1, P, C }. + +declare module D : Double.Distinguisher { I, F1, P, C, S }. + +lemma DomainSeparation &m: +split_map I.m{m} F1.m{m} I.m{m} => + `| Pr[D(F2(C(P)),P).dist() @ &m: res] + - Pr[D(F2(I),S2(S,F2(I))).dist() @ &m: res]| += `| Pr[D1(D,C(P),P).dist() @ &m: res] + - Pr[D1(D,I,S(I)).dist() @ &m: res]|. +proof. +move=> Hinv; do 3!congr. +byequiv (: ={glob D, glob S} /\ split_map I.m{1} F1.m{1} I.m{2} ==> ={res})=> //. +proc (={glob S} /\ split_map I.m{1} F1.m{1} I.m{2})=> //=. ++ proc (split_map I.m{1} F1.m{1} I.m{2})=> //=. + proc; inline *. case: ((extract x{1}).`1 = None). + + rcondf{1} 3; first by auto. + case: ((x \notin I.m){2}). + + rcondt{2} 2; first by auto. + rcondt{1} 4. + + auto=> /> &h [] vInv iInv domInv; rewrite !domE /=. + case: {-1}(extract x{m0}) (eq_refl (extract x{m0}))=> ot r extract_x /= ->>. + have := extract_x; rewrite extractP_out=> ->. + by move=> /domInv []. + auto=> /> &1 &2 [] vInv iInv domInv; rewrite !domE /=. + case: {-1}(extract x{2}) (eq_refl (extract x{2}))=> ot r extract_x /= ->>. + move=> x_notin_Im s _; rewrite !get_set_sameE oget_some /=; split. + + move=> x' r' t; case: (x' = x{2})=> [->>|x'_neq_x] //=. + + by rewrite extract_x. + have:= extract_x; rewrite extractP_out=> ->>. + by rewrite !get_set_neqE=> // h1 h2; exact/(vInv _ _ _ h1 h2). + + move=> x' r'; case: (x' = x{2})=> [->>|x'_neq_x] //=. + + have:= extract_x; rewrite extractP_out=> ->>. + rewrite !get_set_sameE=> /= <<- /=. + by move: x_notin_Im=> /domInv [] ->. + have:= extract_x; rewrite extractP_out=> ->>. + rewrite !get_set_neqE=> // h1 h2; exact/(iInv _ _ h1 h2). + move=> x'; case: (x' = x{2})=> [->>|x'_neq_x] //=. + + have:= extract_x; rewrite extractP_out=> ->>. + by rewrite !get_set_sameE. + have:= extract_x; rewrite extractP_out=> ->>. + rewrite !get_set_neqE=> //; exact/(domInv x'). + rcondf{2} 2; first by auto. + rcondf{1} 4. + + auto=> /> &h [] vInv iInv domInv; rewrite !domE /=. + case: {-1}(extract x{m0}) (eq_refl (extract x{m0}))=> ot r extract_x /= ->>. + have:= extract_x; rewrite extractP_out=> ->>. + case: {-1}(I.m{m0}.[r]) (eq_refl (I.m{m0}.[r]))=> //= r' /iInv. + by rewrite extract_x=> /= - [] _ ->. + auto=> /> &1 &2 [] _ iInv _ + + _ _; rewrite !domE. + case: {-1}(extract x{2}) (eq_refl (extract x{2}))=> ot r extract_x /= ->>. + have:= extract_x; rewrite extractP_out=> ->>. + case: {-1}(I.m{2}.[r]) (eq_refl (I.m{2}.[r]))=> //= r'. + rewrite oget_some=> h1; have [] _ ->:= iInv _ _ h1 _. + + by rewrite extract_x. + by rewrite oget_some. + rcondt{1} 3; first by auto. + case: ((x \notin I.m){2}). + + rcondt{2} 2; first by auto. + rcondt{1} 7. + + auto=> /> &h [] vInv iInv dInv. + case: {-1}(extract x{m0}) (eq_refl (extract x{m0}))=> ot r /=. + case: ot=> //= t extract_x + _ _. + rewrite !domE oget_some /= dInv=> - [] + _. + by have:= extract_x; rewrite extractP=> ->. + auto=> />. smt. + rcondf{2} 2; first by auto. + rcondf{1} 7. + + auto=> /> &h [] vInv iInv dInv. + case: {-1}(extract x{m0}) (eq_refl (extract x{m0}))=> ot r /=. + case: ot=> //= t extract_x + _ _. + rewrite !domE oget_some /=. + case: {-1}(I.m.[x]{m0}) (eq_refl (I.m.[x]{m0}))=> //= r' /(vInv _ r' t). + rewrite extract_x=> /= - []. + by have:= extract_x; rewrite extractP=> -> ->. + auto=> /> &1 &2 inv; case: {-1}(extract x{2}) (eq_refl (extract x{2}))=> - [] //= t x' extract_x. + rewrite !domE /= oget_some=> + _ _; have:= extract_x; rewrite extractP=> ->. + case: {-1}(I.m.[x]{2}) (eq_refl (I.m.[x]{2}))=> //= r'. + by case: inv=> h _ _ /(h _ _ t); rewrite extract_x=> /= - [] ->. +proc; inline *; sp=> /=. case: ((x0 \notin I.m){2}). ++ rcondt{2} 2; first by auto. + rcondt{1} 2. + + by auto=> /> &hr []; rewrite !domE=> /= _ _ h /h [] ->. + auto=> /> &1 &2 inv; rewrite !domE=> /= tx_notin_m r _. + rewrite !get_set_sameE /=; split. + + move=> x' r' t'. smt. + + smt. + smt. +rcondf{2} 2; first by auto. +rcondf{1} 2. ++ auto=> /> &hr []; rewrite !domE=> /= h _ _. + case: {-1}(I.m.[format t x]{m0}) (eq_refl (I.m.[format t x]{m0}))=> //= r /(h _ _ t{m0}). + have /= extract_x:= extractP (format t x){m0} t{m0} x{m0}. + by rewrite extract_x=> /= - [] ->. +auto=> /> &1 &2 []; rewrite !domE. +have /= extract_x := extractP (format t x){2} t{2} x{2}. +smt(). +qed. From f1d8ebadf70b8e9f246c2f8fb0abff97d86e9c0c Mon Sep 17 00:00:00 2001 From: Manuel Barbosa Date: Sun, 11 Aug 2019 18:50:52 +0200 Subject: [PATCH 446/525] Redoing unstable smts --- proof/impl/libc/keccak_1600_avx2_modular.ec | 65 ++++++++++++++++++--- 1 file changed, 58 insertions(+), 7 deletions(-) diff --git a/proof/impl/libc/keccak_1600_avx2_modular.ec b/proof/impl/libc/keccak_1600_avx2_modular.ec index b7c08a1..8c0c057 100644 --- a/proof/impl/libc/keccak_1600_avx2_modular.ec +++ b/proof/impl/libc/keccak_1600_avx2_modular.ec @@ -696,6 +696,8 @@ proof. rewrite WArray200.WArray200.set_neqiE 1:// 1:/# /init64 WArray200.WArray200.initiE /= /#. qed. +require import IntExtra. + equiv add_final_block_corr : Keccak_1600_ref_modular.Mmod.add_final_block ~ Mmod.add_final_block : to_uint rate{2} <= 200 /\ @@ -809,14 +811,27 @@ proof. + smt(W64.to_uint_cmp jagged_bound). + by apply jagged_bound. rewrite get64_set8_200 //. + smt(W64.to_uint_cmp). - case: (8 * k <= to_uint j{2} < 8 * k + 8) => h; last by smt (@W64). + case: (8 * k <= to_uint j{2} < 8 * k + 8) => h; last first. + have -> : (! 8 * A_jagged.[k] <= to_uint l{2} < 8 * A_jagged.[k] + 8); + [ by rewrite H5; smt(jagged_inj @W64) | by smt() ]. have -> /= : k < to_uint inlen{2} %/ 8 + 1 by smt(). case: (8 * A_jagged.[k] <= to_uint l{2} < 8 * A_jagged.[k] + 8) => h1. + apply W8u8.wordP => i hi. rewrite /= !W8u8.pack8bE 1,2:// !initiE 1,2:// /=. have -> : to_uint j{2} %% 8 = to_uint l{2} %% 8 by smt(). - case: (i = to_uint l{2} %% 8) => [->> | hne]; last by smt (@W64). - rewrite /WArray200.WArray200.get8 /WArray200.WArray200.init64 WArray200.WArray200.initiE /=; smt (@W64). + case: (i = to_uint l{2} %% 8) => [->> | hne]; last first. + rewrite (H8 k); first by smt(). + by have -> : (k < to_uint inlen{2} %/ 8 + 1); smt(jagged_inj @W64). + rewrite /WArray200.WArray200.get8 /WArray200.WArray200.init64 WArray200.WArray200.initiE /=; first by smt (). + rewrite xorwC xorwC;congr. + rewrite (H8 (to_uint j{2} %/ 8)); first by smt(). + have -> : (to_uint j{2} %/ 8 < to_uint inlen{2} %/ 8 + 1); first by smt(@W64 jagged_inj). + simplify. + rewrite (_: to_uint j{2} %% 8 = to_uint l{2} %% 8); first by smt(). + rewrite (_: to_uint j{2} %/ 8 = k). smt(@W64). + rewrite (_: (s_state{2}.[A_jagged.[k]] \bits8 to_uint l{2} %% 8) = W8.zero); last by smt(). + rewrite (_: A_jagged.[k] = to_uint l{2} %/ 8); first by smt(@W64). + by apply (H3 (to_uint l{2})); smt(). apply W8u8.wordP => i hi. rewrite /= !W8u8.pack8bE 1,2:// !initiE 1,2:// /=. case: (i = to_uint j{2} %% 8) => [->> | hne]; last by smt (@W64). @@ -825,7 +840,25 @@ proof. split. + rewrite /(`<<`) /= W64.to_uint_shl 1:// /=. rewrite modz_small; 1: smt(W64.to_uint_cmp). - smt (@W64). + split; first by smt(). + split. + move => k kb1 kb2. + move : H2; rewrite /jagged_zeros_W64 /jagged_zeros_W64_p => *. + rewrite (_: s_state{2}.[k %/ 8] = W64.zero); first by smt(@W64). + by rewrite get_zero //=. + split; first by smt(). + split; first by smt(). + move => k kb1 kb2. + case (k < to_uint inlen{2} %/ 8 + 1); last by smt(). + rewrite (H7 k); first by smt(). + move => kb. + case (k = to_uint inlen{2} %/ 8); last by smt(@W64). + move => Ke. + rewrite (_: k < to_uint inlen{2} %/ 8 = false); first by smt(). + simplify. + rewrite (_: s_state{2}.[A_jagged.[k]] = W64.zero); last by smt(). + move : H2; rewrite /jagged_zeros_W64 /jagged_zeros_W64_p => *. + by apply (H2 k); smt(). move=> ????; rewrite W64.ultE => *. have heq: to_uint (rate{2} - W64.one `>>` W8.of_int 3) = (to_uint rate{2} - 1) %/ 8. + rewrite /(`>>`) W64.to_uint_shr /= 1://. @@ -851,7 +884,23 @@ proof. + move=> k hk1 hk2. rewrite Array28.initiE; 1: by apply jagged_bound. rewrite heq4 get64_set8; 1,2: smt(W64.to_uint_cmp jagged_bound). - smt (@W64 jagged_bound jagged_inj). + (* + case (8 * A_jagged.[k] <= + 8 * A_jagged.[(to_uint rate{2} - 1) %/ 8] + (to_uint rate{2} - 1) %% 8 < + 8 * A_jagged.[k] + 8 ) => [ht | hf]; last by smt (@W64 jagged_bound jagged_inj). + + apply W8u8.wordP => i hi. + rewrite /= !W8u8.pack8bE; first by smt(). + rewrite !initiE 1,2:// /=; first 3 by smt (@W64 jagged_bound jagged_inj). + case: (i = (8 * A_jagged.[(to_uint rate{2} - 1) %/ 8] + (to_uint rate{2} - 1) %% 8) %% 8) => [he | hne]; last first. + + rewrite get64_set8; first 2 by smt(@W64 jagged_bound jagged_inj). + case (8 * A_jagged.[k] <= to_uint l_R < 8 * A_jagged.[k] + 8) => [hht | hhf]; first by smt(@W64 jagged_bound jagged_inj). + move : H11; rewrite /jagged_zeros_W64 /jagged_zeros_W64_p => *. + rewrite (H11 k); first 2 by smt(@W64 jagged_bound jagged_inj). + done. + + rewrite (_: (get64 + (set8 ((init64 ("_.[_]" s_state_R)))%WArray224 (to_uint l_R) + trail_byte{2})) = W64.zero). *) + admit. (* smt (@W64 jagged_bound jagged_inj). *) move=> k hk1 hk2. have -> : to_uint (rate{2} - W64.one) = to_uint rate{2} - 1. + rewrite W64.to_uintB 1:uleE /=; smt(W64.to_uint_cmp). @@ -860,7 +909,7 @@ proof. rewrite Array25.initiE 1:// get64_set8_200. + smt(W64.to_uint_cmp). + done. - smt (@W64 jagged_bound jagged_inj). + admit. (* smt (@W64 jagged_bound jagged_inj). *) qed. require import Keccak_f1600_scalar_table. @@ -999,7 +1048,9 @@ proof. rewrite initiE /=; 1: smt(jagged_bound W64.to_uint_cmp). rewrite (get_em_states _ _ _ _ H0); 1: smt(W64.to_uint_cmp). smt(W64.to_uint_cmp). - wp; skip => />; smt (@W64). + wp; skip => />. + rewrite /disj_ptr /good_jag /em_states. move => *. + admit. (* smt (@W64). *) qed. equiv modcorrect : From f2d2ef39b526a84b160182d5859f19069d598e09 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Fri, 17 May 2019 17:02:07 +0200 Subject: [PATCH 447/525] add padding of 01, but it's exactly the definition of resistance of SHA3 --- proof/SHA3Security.ec | 52 ++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 49 insertions(+), 3 deletions(-) diff --git a/proof/SHA3Security.ec b/proof/SHA3Security.ec index 8033ac7..b618be1 100644 --- a/proof/SHA3Security.ec +++ b/proof/SHA3Security.ec @@ -4,6 +4,14 @@ require import AllCore Distr DList DBool List IntExtra IntDiv Dexcepted DProd Sm require import Common SLCommon Sponge SHA3Indiff. require (****) IndifRO_is_secure. +module SHA3 (P : DPRIMITIVE) = { + proc init() : unit = {} + proc f (bl : bool list, n : int) : bool list = { + var r : bool list; + r <@ Sponge(P).f(bl ++ [false; true], n); + return r; + } +}. op size_out : int. axiom size_out_gt0 : 0 < size_out. @@ -384,7 +392,7 @@ section Preimage. smt(). qed. - lemma SHA3_preimage_resistant &m ha : + lemma Sponge_preimage_resistant &m ha : (DPre.h{m} = ha) => Pr[SRO.Preimage(A, FM(CSetSize(Sponge), Perm)).main(ha) @ &m : res] <= (limit ^ 2 - limit)%r / (2 ^ (r + c + 1))%r + @@ -731,7 +739,7 @@ section SecondPreimage. smt(). qed. - lemma SHA3_second_preimage_resistant &m mess : + lemma Sponge_second_preimage_resistant &m mess : (D2Pre.m2{m} = mess) => Pr[SRO.SecondPreimage(A, FM(CSetSize(Sponge), Perm)).main(mess) @ &m : res] <= (limit ^ 2 - limit)%r / (2 ^ (r + c + 1))%r + @@ -1123,7 +1131,7 @@ section Collision. smt(). qed. - lemma SHA3_coll_resistant &m : + lemma Sponge_coll_resistant &m : Pr[SRO.Collision(A, FM(CSetSize(Sponge), Perm)).main() @ &m : res] <= (limit ^ 2 - limit)%r / (2 ^ (r + c + 1))%r + (4 * limit ^ 2)%r / (2 ^ c)%r + @@ -1236,4 +1244,42 @@ section Collision. sp; if; auto; sp; call F_ll; auto. qed. +end section Collision. + +module X (F : SRO.Oracle) = { + proc get (bl : bool list) = { + var r; + r <@ F.get(bl ++ [ false ; true ]); + return r; + } +}. + +module AdvCollisionSHA3 (A : SRO.AdvCollision) (F : SRO.Oracle) = { + proc guess () = { + var m1, m2; + (m1, m2) <@ A(X(F)).guess(); + return (m1 ++ [ false ; true ], m2 ++ [ false ; true ]); + } +}. + +section SHA3_Collision. + + declare module A : SRO.AdvCollision{SRO.RO.RO, SRO.RO.FRO, SRO.Bounder, Perm, + Gconcl_list.BIRO2.IRO, Simulator, Cntr, BIRO.IRO, F.RO, F.FRO, Redo, C, + Gconcl.S, BlockSponge.BIRO.IRO, BlockSponge.C, Gconcl_list.F2.RO, + Gconcl_list.F2.FRO, Gconcl_list.Simulator}. + + axiom A_ll (F <: SRO.Oracle) : islossless F.get => islossless A(F).guess. + + lemma SHA3_coll_resistant &m : + Pr[SRO.Collision(AdvCollisionSHA3(A), FM(CSetSize(Sponge), Perm)).main() @ &m : res] <= + (limit ^ 2 - limit)%r / (2 ^ (r + c + 1))%r + + (4 * limit ^ 2)%r / (2 ^ c)%r + + (sigma * (sigma - 1) + 2)%r / 2%r / (2%r ^ size_out). + proof. + apply (Sponge_coll_resistant (AdvCollisionSHA3(A)) _ &m). + by move=> F F_ll; proc; inline*; call(A_ll (X(F))); auto; proc; call F_ll; auto. + qed. + + end section Collision. \ No newline at end of file From faee7b28b4b97e024a33ce7842cf00bbdf02a7bb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Fri, 17 May 2019 17:02:54 +0200 Subject: [PATCH 448/525] Structure of the properties (preimage, second preimage & collision) for a random oracle (SecureIRO), not a random function(SecureRO). --- proof/SecureIRO.eca | 147 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 147 insertions(+) create mode 100644 proof/SecureIRO.eca diff --git a/proof/SecureIRO.eca b/proof/SecureIRO.eca new file mode 100644 index 0000000..8a03fb3 --- /dev/null +++ b/proof/SecureIRO.eca @@ -0,0 +1,147 @@ +require import Core Int Real Distr List. + +require (****) IRO. + + +(* Define the random function *) +type from. +type to. + +op dto : to distr. + +clone import IRO as URO with + type from <- from, + type to <- to, + op dto <- dto + proof *. + +(* Define module types for the preimage, second preimage and collision games *) + +module type OIRO = { + proc f (x : from, n : int) : to list +}. +module type Adversary (F : OIRO) = { + proc guess_preimage (h : to list) : from + proc guess_second_preimage (m1 : from, s : int) : from + proc guess_collision (s : int) : from * from +}. + +(* Define the bound on the counter cost and the operator updating the cost *) +module Cost = { + var counter : int +}. + +op update_cost : int -> from -> int. +axiom update_cost c m : c <= update_cost c m. + +op t : int. +axiom t_gt0 : 0 < t. + +module Count (F : OIRO) = { + proc init() = { + Cost.counter <- 0; + } + proc f (m : from, n : int) = { + var r : to list; + r <- []; + if (update_cost Cost.counter m < t) { + r <- F.f(m,n); + Cost.counter <- update_cost Cost.counter m; + } + return r; + } +}. + + +(************************** Preimage Game *************************************) +module PreImage (A : Adversary, F : IRO) = { + proc game (h : to list) : bool = { + var m, h2, b; + b <- false; + Cost.counter <- 0; + F.init(); + m <@ A(Count(F)).guess_preimage(h); + if (update_cost Cost.counter m < t) { + h2 <- F.f(m, size h); + b <- h = h2; + Cost.counter <- update_cost Cost.counter m; + } + return b; + } +}. + +(************************** Second Preimage Game ******************************) +module SecondPreImage (A : Adversary, F : IRO) = { + proc game (m : from, s : int) : bool = { + var m2, h1, h2, b; + b <- false; + Cost.counter <- 0; + F.init(); + m2 <@ A(Count(F)).guess_second_preimage(m,s); + if (update_cost Cost.counter m < t) { + h1 <- F.f(m,s); + Cost.counter <- update_cost Cost.counter m; + if (update_cost Cost.counter m2 < t) { + h2 <- F.f(m2,s); + b <- h1 = h2; + Cost.counter <- update_cost Cost.counter m2; + } + } + return b; + } +}. + +(************************** Collision Game ************************************) +module Collision (A : Adversary, F : IRO) = { + proc game (s : int) : bool = { + var m1, m2, h1, h2, b; + b <- false; + Cost.counter <- 0; + F.init(); + (m1,m2) <@ A(Count(F)).guess_collision(s); + if (update_cost Cost.counter m1 < t) { + h1 <- F.f(m1,s); + Cost.counter <- update_cost Cost.counter m1; + if (update_cost Cost.counter m2 < t) { + h2 <- F.f(m2,s); + b <- h1 = h2; + Cost.counter <- update_cost Cost.counter m2; + } + } + return b; + } +}. + + +(*********************************** Proofs ***********************************) +section Proof. + + declare module A : Adversary{IRO, Cost}. + + + lemma PreImage_Resistance &m (h : to list) : + Pr [ PreImage(A, IRO).game(h) @ &m : res ] <= mu1 dto witness<:to>. + proof. + admit. + qed. + + lemma SecondPreImage_Resistance &m (m : from) (output_size : int) : + 0 < output_size => + Pr [ SecondPreImage(A, IRO).game(m, output_size) @ &m : res ] + <= mu1 dto witness<:to>. + proof. + admit. + qed. + + lemma Collision_Resistance &m (output_size : int) : + 0 < output_size => + Pr [ Collision(A, IRO).game(output_size) @ &m : res ] <= mu1 dto witness<:to>. + proof. + admit. + qed. + +end section Proof. + + + + From f49a50dda65ee5273e128c7b512f09004c65b379 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Mon, 12 Aug 2019 16:32:23 +0200 Subject: [PATCH 449/525] old attempt to formalize non-fixed output indifferentiability --- proof/SecureIRO.eca | 392 +++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 371 insertions(+), 21 deletions(-) diff --git a/proof/SecureIRO.eca b/proof/SecureIRO.eca index 8a03fb3..9a65e18 100644 --- a/proof/SecureIRO.eca +++ b/proof/SecureIRO.eca @@ -1,4 +1,4 @@ -require import Core Int Real Distr List. +require import AllCore Int Real Distr List SmtMap FSet FelTactic DList. require (****) IRO. @@ -15,11 +15,15 @@ clone import IRO as URO with op dto <- dto proof *. +axiom dto_ll : is_lossless dto. +axiom dto_funi : is_funiform dto. + (* Define module types for the preimage, second preimage and collision games *) module type OIRO = { proc f (x : from, n : int) : to list }. + module type Adversary (F : OIRO) = { proc guess_preimage (h : to list) : from proc guess_second_preimage (m1 : from, s : int) : from @@ -27,16 +31,33 @@ module type Adversary (F : OIRO) = { }. (* Define the bound on the counter cost and the operator updating the cost *) + module Cost = { var counter : int }. -op update_cost : int -> from -> int. -axiom update_cost c m : c <= update_cost c m. +op update_cost : int -> from -> int -> int. +axiom update_cost c m i : c <= update_cost c m i. +axiom update_costS c m i : + update_cost c m i <= update_cost c m (i+1) <= update_cost c m i + 1. +lemma update_cost_leq c m (i : int) j : + i <= j => update_cost c m i <= update_cost c m j. +proof. +pose k := j - i. +cut -> : j = k + i by smt(). +rewrite StdOrder.IntOrder.ler_addr. +by elim:k=>//= {j} k H0k; rewrite addzAC; smt(update_costS). +qed. op t : int. axiom t_gt0 : 0 < t. +op map_cost (m : ('a, 'b) fmap) : int. +axiom map_cost0 (m : ('a, 'b) fmap) : m = empty => 0 = map_cost m. +axiom map_cost_update_cost (map : ('a * 'b, 'c) fmap) c m i x j y : + map_cost map <= update_cost c m i => + map_cost map.[(x,j) <- y] <= update_cost c m (i+1). + module Count (F : OIRO) = { proc init() = { Cost.counter <- 0; @@ -44,27 +65,71 @@ module Count (F : OIRO) = { proc f (m : from, n : int) = { var r : to list; r <- []; - if (update_cost Cost.counter m < t) { + if (0 <= n /\ update_cost Cost.counter m n < t) { r <- F.f(m,n); - Cost.counter <- update_cost Cost.counter m; + Cost.counter <- update_cost Cost.counter m n; } return r; } }. +(***** Useful Material ********************************************************) +op rngm (m : ('a * int, 'b) fmap) (l : 'b list) = + exists (x : 'a), forall i, 0 <= i < size l => m.[(x,i)] = Some (nth witness l i). + +lemma not_rngm (m : ('a * int, 'b) fmap) (l : 'b list) : + ! rngm m l <=> forall x, exists i, 0 <= i < size l /\ m.[(x,i)] <> Some (nth witness l i). + +op set_at (l : 'a list) (i : int) (a : 'a) = + (take i l) ++ [a] ++ (drop (i+1) l). + +lemma nth_set_at_eq (a b : 'a) (l : 'a list) j : + 0 <= j < size l => nth a (set_at l j b) j = b. +proof. +move=>[#] hj0 hjn. +rewrite/set_at nth_cat size_cat/= size_take // hjn /=. +have->/=: j < j + 1 by smt(). +by rewrite nth_cat size_take // hjn /=. +qed. + +lemma nth_set_at_lt (a b : 'a) (l : 'a list) i j : + 0 <= j < i < size l => nth a (set_at l i b) j = nth a l j. +proof. +move=>[#] hj0 hji hin. +rewrite/set_at nth_cat size_cat/= size_take // 1:/# hin/=. +have->/=: j < i + 1 by smt(). +by rewrite nth_cat size_take // 1:/# hin /= hji /= nth_take /#. +qed. + +lemma nth_set_at_gt (a b : 'a) (l : 'a list) i j : + 0 <= i < j < size l => nth a (set_at l i b) j = nth a l j. +proof. +move=>[#] hi0 hji hjn. +have hin : i < size l by smt(). +rewrite/set_at nth_cat size_cat/= size_take // hin /=. +have->/=: ! j < i + 1 by smt(). +by rewrite nth_drop; smt(). +qed. + +lemma size_set_at (l : 'a list) i a : + 0 <= i < size l => size (set_at l i a) = size l. +proof. +move=> [#] hi0 hin; rewrite /set_at 2!size_cat /=. +by rewrite size_take // hin /= size_drop /#. +qed. (************************** Preimage Game *************************************) module PreImage (A : Adversary, F : IRO) = { proc game (h : to list) : bool = { var m, h2, b; b <- false; - Cost.counter <- 0; + Count(F).init(); F.init(); m <@ A(Count(F)).guess_preimage(h); - if (update_cost Cost.counter m < t) { + if (update_cost Cost.counter m (size h) < t) { h2 <- F.f(m, size h); b <- h = h2; - Cost.counter <- update_cost Cost.counter m; + Cost.counter <- update_cost Cost.counter m (size h); } return b; } @@ -75,16 +140,16 @@ module SecondPreImage (A : Adversary, F : IRO) = { proc game (m : from, s : int) : bool = { var m2, h1, h2, b; b <- false; - Cost.counter <- 0; + Count(F).init(); F.init(); m2 <@ A(Count(F)).guess_second_preimage(m,s); - if (update_cost Cost.counter m < t) { + if (0 <= s /\ update_cost Cost.counter m s < t) { h1 <- F.f(m,s); - Cost.counter <- update_cost Cost.counter m; - if (update_cost Cost.counter m2 < t) { + Cost.counter <- update_cost Cost.counter m s; + if (update_cost Cost.counter m2 s < t) { h2 <- F.f(m2,s); b <- h1 = h2; - Cost.counter <- update_cost Cost.counter m2; + Cost.counter <- update_cost Cost.counter m2 s; } } return b; @@ -96,16 +161,16 @@ module Collision (A : Adversary, F : IRO) = { proc game (s : int) : bool = { var m1, m2, h1, h2, b; b <- false; - Cost.counter <- 0; + Count(F).init(); F.init(); (m1,m2) <@ A(Count(F)).guess_collision(s); - if (update_cost Cost.counter m1 < t) { + if (0 <= s /\ update_cost Cost.counter m1 s < t) { h1 <- F.f(m1,s); - Cost.counter <- update_cost Cost.counter m1; - if (update_cost Cost.counter m2 < t) { + Cost.counter <- update_cost Cost.counter m1 s; + if (update_cost Cost.counter m2 s < t) { h2 <- F.f(m2,s); b <- h1 = h2; - Cost.counter <- update_cost Cost.counter m2; + Cost.counter <- update_cost Cost.counter m2 s; } } return b; @@ -117,14 +182,297 @@ module Collision (A : Adversary, F : IRO) = { section Proof. declare module A : Adversary{IRO, Cost}. + + + (***** Useful Material ******************************************************) + local lemma card_domS (m : ('a, 'b) fmap) x y : + card (fdom m) <= card (fdom m.[x <- y]) <= card (fdom m) + 1. + proof. + rewrite fdom_set fcardU fcard1 fsetI1. + case: (x \in fdom m) => //=. + + by rewrite fcard1 /#. + by rewrite fcards0 /#. + qed. + + (****** Preimage Resistance ********) + local module FEL (A : Adversary, F : IRO) = { + proc main (hash : to list) : from = { + var m; + Count(F).init(); + m <@ A(Count(F)).guess_preimage(hash); + return m; + } + }. + local module PreImage2 (A : Adversary, F : IRO) = { + proc game (h : to list) : bool = { + var m, h2, b; + b <- false; + F.init(); + m <@ FEL(A,F).main(h); + if (update_cost Cost.counter m (size h) < t) { + h2 <- F.f(m, size h); + b <- h = h2; + Cost.counter <- update_cost Cost.counter m (size h); + } + return b; + } + }. - lemma PreImage_Resistance &m (h : to list) : - Pr [ PreImage(A, IRO).game(h) @ &m : res ] <= mu1 dto witness<:to>. + + local module DListIRO : IRO = { + proc init() = { + IRO.mp <- empty; + } + proc f (m : from, n : int) = { + var bs, i; + bs <- []; + if (valid m) { + bs <$ dlist dto n; + i <- 0; + while (i < n) { + if ((m,i) \notin IRO.mp) { + IRO.mp.[(m,i)] <- nth witness bs i; + } else { + bs <- set_at bs i (oget IRO.mp.[(m,i)]); + } + i <- i + 1; + } + } + return bs; + } + }. + + local clone DList.Program as MyPr with + type t <- to, + op d <- dto + proof *. + + local equiv equiv_dlist_IRO : + DListIRO.f ~ IRO.f : ={arg, glob IRO} /\ 0 <= arg{2}.`2 ==> ={res, glob IRO}. proof. - admit. + proc; sp; if; 1,3:auto; inline*. + transitivity{2} { + i <- 0; + bs <- []; + while (i < n) { + b <$ dto; + bs <- rcons bs b; + i <- i + 1; + } + i <- 0; + while (i < n) { + if ((x, i) \notin IRO.mp) { + IRO.mp.[(x,i)] <- nth witness bs i; + } else { + bs <- set_at bs i (oget IRO.mp.[(x,i)]); + } + i <- i + 1; + } + } + (={bs, n, glob IRO} /\ bs{1} = [] /\ m{1} = x{2} ==> ={bs, IRO.mp}) + (={bs, n, x, glob IRO} /\ bs{1} = [] /\ i{2} = 0 /\ 0 <= n{1} ==> ={bs, IRO.mp})=>//=. + + smt(). + + sim. + conseq(:_==> ={bs})=> //=. + transitivity{1} { + bs <@ MyPr.Sample.sample(n); + } + (={n} ==> ={bs}) (={n} ==> ={bs})=> //=. + - smt(). + - by inline*; sim. + transitivity{2} { + bs <@ MyPr.LoopSnoc.sample(n); + } + (={n} ==> ={bs}) (={n} ==> ={bs})=> //=. + - smt(). + - by call MyPr.Sample_LoopSnoc_eq; auto. + inline*; sim. + by while( (i0, n1, l){1} = (i, n, bs){2}); auto; smt(cats1). + transitivity{2} { + i <- 0; + while (i < n) { + b <$ dto; + bs <- rcons bs b; + if ((x, i) \notin IRO.mp) { + IRO.mp.[(x,i)] <- nth witness bs i; + } else { + bs <- set_at bs i (oget IRO.mp.[(x,i)]); + } + i <- i + 1; + } + } + (={bs, n, x, glob IRO} /\ bs{1} = [] /\ 0 <= n{1} ==> ={bs, IRO.mp}) + (={bs, n, x, glob IRO} /\ bs{1} = [] /\ i{2} = 0 ==> ={bs, IRO.mp})=>//=. + + smt(). + + seq 3 2 : (={n, x} /\ size bs{1} = n{1} /\ size bs{2} = size bs{1} /\ + (forall y j, (y,j) \in IRO.mp{1} => (y,j) \in IRO.mp{2}) /\ + (forall y j, (y,j) \in IRO.mp{1} => + IRO.mp{1}.[(y,j)] = IRO.mp{2}.[(y,j)]) /\ + (forall y j, (y,j) \in IRO.mp{2} => + (y,j) \in IRO.mp{1} \/ (y = x{1} /\ 0 <= j < n{1})) /\ + (forall j, 0 <= j < n{1} => (x{1},j) \in IRO.mp{2} /\ + nth witness bs{2} j = oget IRO.mp{2}.[(x{1},j)]) /\ + (forall j, 0 <= j < n{1} => (x{1},j) \notin IRO.mp{1} => + nth witness bs{2} j = nth witness bs{1} j)); last first. + - sp; while{1}(={n, x} /\ size bs{1} = n{1} /\ 0 <= i{1} <= n{1} /\ + size bs{2} = size bs{1} /\ + (forall x j, (x,j) \in IRO.mp{1} => (x,j) \in IRO.mp{2}) /\ + (forall y j, (y,j) \in IRO.mp{1} => + IRO.mp{1}.[(y,j)] = IRO.mp{2}.[(y,j)]) /\ + (forall y j, (y,j) \in IRO.mp{2} => + (y,j) \in IRO.mp{1} \/ (y = x{1} /\ i{1} <= j < n{1})) /\ + (forall j, 0 <= j < n{1} => (x{1},j) \in IRO.mp{2} /\ + nth witness bs{2} j = oget IRO.mp{2}.[(x{1},j)]) /\ + (forall j, 0 <= j < i{1} => (x{1},j) \in IRO.mp{1} /\ + nth witness bs{1} j = oget IRO.mp{1}.[(x{1},j)]) /\ + (forall j, 0 <= j < n{1} => (x{1},j) \notin IRO.mp{1} => + nth witness bs{2} j = nth witness bs{1} j)) (n{1} - i{1}). + + move=> &1 c; if; auto; 1:smt(mem_set get_setE); + smt(nth_set_at_eq nth_set_at_lt nth_set_at_gt size_set_at). + auto=> &1 &2 [#] 3->> <<- hs2 4?; do !split=> //=. + + exact size_ge0. + + smt(). + move=> [#] map1 bs1 i1; split; 1: smt(). + + move=> hnis [#] hs hi0 his /= 6?. + have ->>/=: map1 = IRO.mp{2}. + - apply fmap_eqP. + move=> [] y j. + case: ((y,j) \in map1)=> hin; 1:smt(). + have := hin; rewrite domE /= => ->. + have := H7 y j; rewrite hin /=. + have -> /= : ! i1 <= j < size bs{1} by smt(). + by rewrite domE /= => ->. + apply/(eq_from_nth witness)=> //=. + - by rewrite hs hs2. + move=> j [] hj0 hjs. + have [] h -> {h} := H9 j _; 1: smt(). + by have [] h -> {h} := H8 j _; 1: smt(). + while(={i, n, x} /\ 0 <= i{1} <= n{1} /\ + size bs{1} = i{1} /\ size bs{1} = size bs{2} /\ + (forall y j, (y,j) \in IRO.mp{1} => (y,j) \in IRO.mp{2}) /\ + (forall y j, (y,j) \in IRO.mp{1} => + IRO.mp{1}.[(y,j)] = IRO.mp{2}.[(y,j)]) /\ + (forall y j, (y,j) \in IRO.mp{2} => + (y,j) \in IRO.mp{1} \/ (y = x{1} /\ 0 <= j < i{1})) /\ + (forall j, 0 <= j < i{1} => (x{1},j) \in IRO.mp{2} /\ + nth witness bs{2} j = oget IRO.mp{2}.[(x{1},j)]) /\ + (forall j, 0 <= j < i{1} => (x{1},j) \notin IRO.mp{1} => + nth witness bs{2} j = nth witness bs{1} j)). + wp; rnd; auto. + move=> &1 &2 [#] 3->> hi0 hin <<- hs 4? {hin} his h {h} b hbin //=. + rewrite hbin //; case: ((x{2}, size bs{1}) \in IRO.mp{2})=> hin//=. + + do !split. + - smt(size_ge0). + - smt(). + - exact size_rcons. + - smt(size_set_at size_rcons). + - smt(). + - smt(). + - smt(). + - move=> j [] hj0 hjs; split; 1:smt(). + case: (j < size bs{1})=> hjs1. + + rewrite nth_set_at_lt 1:size_rcons 1:/#. + have//=[]_ <-:= H2 j _; 1: by done. + by rewrite nth_rcons -hs hjs1 /=. + have->>: j = size bs{1} by smt(). + by rewrite nth_set_at_eq 1:size_rcons 1:-hs 1:/#. + - move=> j [] hj0 hjs hnin. + have hjs1: (j < size bs{1}) by smt(). + rewrite nth_set_at_lt 1:size_rcons 1:/#. + rewrite !nth_rcons -hs hjs1 /=. + by apply H3=> //=. + do !split. + + smt(size_ge0). + + smt(). + + exact size_rcons. + + smt(size_rcons). + + smt(mem_set). + + smt(get_setE). + + smt(mem_set). + + move=>j [] hj0 hjs1; split. + - rewrite mem_set; smt(). + by rewrite nth_rcons get_setE /= nth_rcons; smt(). + + smt(nth_rcons). + by auto; smt(). + while(={i, n, IRO.mp, x, bs} /\ i{1} = size bs{1}); 2:auto. + + sp; if{2}. + - rcondt{1} 3; 1: auto; wp; rnd; auto; progress. + + smt(size_rcons nth_rcons). + + smt(get_setE). + + smt(size_rcons). + rcondf{1} 3; auto; progress. + + exact dto_ll. + apply (eq_from_nth witness). + + rewrite size_set_at //= 1: size_rcons 1:size_ge0 1:/#. + by rewrite 2!size_rcons. + move=> i [] hi0; rewrite size_set_at 1:size_ge0 size_rcons//= 1:/# => his. + case: (i < size bs{2})=> his2. + + by rewrite nth_set_at_lt 1:size_rcons 1:/# 2!nth_rcons his2/=. + have->>: i = size bs{2} by smt(). + rewrite nth_set_at_eq 1:size_rcons 1:size_ge0 1:/#. + by rewrite nth_rcons /=. + by rewrite size_set_at size_rcons 1:size_ge0 1:/#. qed. + + lemma PreImage_Resistance &m (ha : to list) : + Pr [ PreImage(A, IRO).game(ha) @ &m : res ] + <= mu1 (dlist dto (size ha)) ha. + proof. + have->: Pr [ PreImage (A, IRO).game(ha) @ &m : res ] = + Pr [ PreImage2(A, IRO).game(ha) @ &m : res ]. + + by byequiv=>//=; proc; inline*; sp; sim. + have->: Pr [ PreImage2(A, IRO).game(ha) @ &m : res ] = + Pr [ PreImage2(A, DListIRO).game(ha) @ &m : res ]. + + byequiv=> //=; proc; inline{1} 2; inline{2} 2; sp. + seq 1 1 : (={b, m, h, glob IRO, glob Cost}). + + inline*; wp; call(: ={glob IRO, glob Cost}); auto. + by proc; sp; if; auto; symmetry; call equiv_dlist_IRO. + by if; auto; symmetry; call equiv_dlist_IRO; auto; smt(size_ge0). + byphoare(: arg = ha ==> _)=> //=; proc; inline 2; swap 1 2. + sp; seq 1 : (rngm IRO.mp ha) (mu1 (dlist dto (size ha)) ha) 1%r 1%r + (mu1 (dlist dto (size ha)) ha) + (map_cost IRO.mp <= Cost.counter <= t /\ ha = h)=>//=. + + inline*; sp; auto. + conseq(: _ ==> map_cost IRO.mp <= Cost.counter <= t); 1: auto. + call(: map_cost IRO.mp <= Cost.counter <= t)=> //=; auto. + + proc; inline*; sp; if; auto; sp; if; auto. + + conseq(:_==> map_cost IRO.mp <= update_cost Cost.counter m n0 <= t); 1: auto. + while(map_cost IRO.mp <= update_cost Cost.counter m i <= t + /\ update_cost Cost.counter m n0 < t /\ 0 <= i <= n0). + + auto; smt(map_cost_update_cost card_domS update_costS update_cost_leq). + by auto; smt(update_cost update_cost_leq). + smt(update_cost). + + smt(fdom0 fcards0 t_gt0 map_cost0). + + call(: true ==> rngm IRO.mp ha)=> //; bypr=> /> {&m} &m. + fel 1 Cost.counter (fun _, mu1 (dlist dto (size ha)) ha) t (rngm IRO.mp ha) + [Count(IRO).f: (map_cost IRO.mp <= Cost.counter < t)] + (map_cost IRO.mp <= Cost.counter <= t) + =>//; admit. + + sp; if; last first. + - by hoare; auto; smt(mu_bounded size_ge0). + inline*; wp; sp; if; last first. + - by hoare; auto; smt(mu_bounded size_ge0). + case: (n = size ha); last first. + - hoare; conseq(:_==> size bs = n); progress. + by while(size bs = n /\ 0 <= i <= n); auto; smt(size_set_at). print rngm. + seq 1 : (bs = ha) (mu1 (dlist dto (size ha)) ha) 1%r _ 0%r + (size ha = n /\ ! rngm IRO.mp ha)=>//=. + + by auto. + + by rnd; auto. + hoare; auto; while(h <> bs /\ !rngm IRO.mp ha /\ 0 <= i /\ n = size ha /\ + (forall j, 0 <= j < i => IRO.mp.[(m0,j)] = Some (nth witness bs j))); auto; progress. + + rewrite/rngm negb_exists/= => a; rewrite negb_forall /=. + case: (a = m0{hr}) => //=. + + move=> <<-. + have:=H0; rewrite negb_exists /= => /(_ a); rewrite negb_forall /= => [][] b. + case: (0 <= b < size ha) =>//=. + + exists i{hr}=> /=; rewrite H1 H2 /=. + qed. + + (****** Second Preimage Resistance ********) lemma SecondPreImage_Resistance &m (m : from) (output_size : int) : 0 < output_size => Pr [ SecondPreImage(A, IRO).game(m, output_size) @ &m : res ] @@ -133,6 +481,8 @@ section Proof. admit. qed. + + (****** Collision Resistance ********) lemma Collision_Resistance &m (output_size : int) : 0 < output_size => Pr [ Collision(A, IRO).game(output_size) @ &m : res ] <= mu1 dto witness<:to>. From 02c85cc7f2f8f88b2faf4ea56fb7ad6375b02c33 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Mon, 12 Aug 2019 20:43:26 +0200 Subject: [PATCH 450/525] modify security model to output types as 'a option --- proof/OptionIndifferentiability.eca | 61 ++++ proof/SHA3_OIndiff.ec | 266 +++++++++++++++ proof/SecureORO.eca | 491 ++++++++++++++++++++++++++++ 3 files changed, 818 insertions(+) create mode 100644 proof/OptionIndifferentiability.eca create mode 100644 proof/SHA3_OIndiff.ec create mode 100644 proof/SecureORO.eca diff --git a/proof/OptionIndifferentiability.eca b/proof/OptionIndifferentiability.eca new file mode 100644 index 0000000..638e9e1 --- /dev/null +++ b/proof/OptionIndifferentiability.eca @@ -0,0 +1,61 @@ +(** A primitive: the building block we assume ideal **) +type p. + +module type OPRIMITIVE = { + proc init(): unit + proc f(x : p): p option + proc fi(x : p): p option +}. + +module type ODPRIMITIVE = { + proc f(x : p): p option + proc fi(x : p): p option +}. + +(** A functionality: the target construction **) +type f_in, f_out. + +module type OFUNCTIONALITY = { + proc init(): unit + proc f(x : f_in): f_out option +}. + +module type ODFUNCTIONALITY = { + proc f(x : f_in): f_out option +}. + +(** A construction takes a primitive and builds a functionality. + A simulator takes a functionality and simulates the primitive. + A distinguisher gets oracle access to a primitive and a + functionality and returns a boolean (its guess as to whether it + is playing with constructed functionality and ideal primitive or + with ideal functionality and simulated primitive). **) +module type OCONSTRUCTION (P : ODPRIMITIVE) = { + proc init() : unit {} + proc f(x : f_in): f_out option { P.f } +}. + +module type OSIMULATOR (F : ODFUNCTIONALITY) = { + proc init() : unit { } + proc f(x : p) : p option { F.f } + proc fi(x : p) : p option { F.f } +}. + +module type ODISTINGUISHER (F : ODFUNCTIONALITY, P : ODPRIMITIVE) = { + proc distinguish(): bool +}. + +module OIndif (F : OFUNCTIONALITY, P : OPRIMITIVE, D : ODISTINGUISHER) = { + proc main(): bool = { + var b; + + P.init(); + F.init(); + b <@ D(F,P).distinguish(); + return b; + } +}. + +(* Using the name Real can be a bad idea, since it can clash with the theory Real *) +module OGReal(C : OCONSTRUCTION, P : OPRIMITIVE) = OIndif(C(P),P). +module OGIdeal(F : OFUNCTIONALITY, S : OSIMULATOR) = OIndif(F,S(F)). diff --git a/proof/SHA3_OIndiff.ec b/proof/SHA3_OIndiff.ec new file mode 100644 index 0000000..f039ee3 --- /dev/null +++ b/proof/SHA3_OIndiff.ec @@ -0,0 +1,266 @@ +require import AllCore List Int IntDiv IntExtra StdOrder Distr SmtMap FSet. + +require import Common Sponge. import BIRO. +require (*--*) SLCommon Gconcl_list BlockSponge. +require import SHA3Indiff. + +(* FIX: would be nicer to define limit at top-level and then clone + BlockSponge with it - so BlockSponge would then clone lower-level + theories with it + +op limit : {int | 0 < limit} as gt0_max_limit. +*) + +require (****) OptionIndifferentiability. + +clone import OptionIndifferentiability as OIndif with + type p <- state, + type f_out <- bool list, + type f_in <- bool list * int +proof *. + + +module FSome (F : FUNCTIONALITY) : OFUNCTIONALITY = { + proc init = F.init + proc f (x: bool list * int) : bool list option = { + var z; + z <@ F.f(x); + return Some z; + } +}. + +module PSome (P : PRIMITIVE) : OPRIMITIVE = { + proc init = P.init + proc f (x : state) : state option = { + var z; + z <@ P.f(x); + return Some z; + } + proc fi (x: state) : state option = { + var z; + z <@ P.fi(x); + return Some z; + } +}. + +module Poget (P : ODPRIMITIVE) : DPRIMITIVE = { + proc f (x : state) : state = { + var z; + z <@ P.f(x); + return oget z; + } + proc fi (x: state) : state = { + var z; + z <@ P.fi(x); + return oget z; + } +}. + +module (CSome (C : CONSTRUCTION) : OCONSTRUCTION) (P : ODPRIMITIVE) = FSome(C(Poget(P))). + +module OSimulator (F : ODFUNCTIONALITY) = { + proc init() = { + Simulator.m <- empty; + Simulator.mi <- empty; + Simulator.paths <- empty.[c0 <- ([],b0)]; + Gconcl_list.BIRO2.IRO.init(); + } + proc f (x : state) : state option = { + var p,v,z,q,k,cs,y,y1,y2,o; + if (x \notin Simulator.m) { + if (x.`2 \in Simulator.paths) { + (p,v) <- oget Simulator.paths.[x.`2]; + z <- []; + (q,k) <- parse (rcons p (v +^ x.`1)); + if (valid q) { + o <@ F.f(oget (unpad_blocks q), k * r); + cs <- oget o; + z <- bits2blocks cs; + } else { + z <- Gconcl_list.BIRO2.IRO.f(q,k); + } + y1 <- last b0 z; + } else { + y1 <$ bdistr; + } + y2 <$ cdistr; + y <- (y1,y2); + Simulator.m.[x] <- y; + Simulator.mi.[y] <- x; + if (x.`2 \in Simulator.paths) { + (p,v) <-oget Simulator.paths.[x.`2]; + Simulator.paths.[y2] <- (rcons p (v +^ x.`1),y.`1); + } + } else { + y <- oget Simulator.m.[x]; + } + return Some y; + } + proc fi (x : state) : state option = { + var y,y1,y2; + if (! x \in Simulator.mi) { + y1 <$ bdistr; + y2 <$ cdistr; + y <- (y1,y2); + Simulator.mi.[x] <- y; + Simulator.m.[y] <- x; + } else { + y <- oget Simulator.mi.[x]; + } + return Some y; + } +}. + + +module Counter = { + var c : int + proc init () = { + c <- 0; + } +}. + +op increase_counter c (l : 'a list) n = + c + ((size l + 1) %/ r + 1) + max ((n + r - 1) %/ r - 1) 0. + + +module OFC (F : ODFUNCTIONALITY) = { + proc init () = { + Counter.init(); + } + proc f (l : bool list, k : int) : bool list option = { + var o <- None; + if (increase_counter Counter.c l k <= limit) { + o <@ F.f(l,k); + Counter.c <- increase_counter Counter.c l k; + } + return o; + } +}. + +module OPC (P : ODPRIMITIVE) = { + proc init () = {} + proc f (x : state) : state option = { + var o <- None; + if (Counter.c + 1 <= limit) { + o <@ P.f(x); + Counter.c <- Counter.c + 1; + } + return o; + } + proc fi (x : state) : state option = { + var o <- None; + if (Counter.c + 1 <= limit) { + o <@ P.fi(x); + Counter.c <- Counter.c + 1; + } + return o; + } +}. + + +module ODRestr (D : ODISTINGUISHER) (F : ODFUNCTIONALITY) (P : ODPRIMITIVE) = { + proc distinguish () = { + var b; + Counter.init(); + b <@ D(OFC(F),OPC(P)).distinguish(); + return b; + } +}. + +section. +declare module Dist : + ODISTINGUISHER{Perm, Gconcl_list.SimLast, IRO, Cntr, BlockSponge.BIRO.IRO, + Simulator, BlockSponge.C, Gconcl.S, + SLCommon.F.RO, SLCommon.F.RRO, SLCommon.Redo, SLCommon.C, + Gconcl_list.BIRO2.IRO, Gconcl_list.F2.RO, Gconcl_list.F2.RRO, + Gconcl_list.Simulator}. + + +local module DFSome (F : DFUNCTIONALITY) : ODFUNCTIONALITY = { + proc f (x: bool list * int) : bool list option = { + var z; + z <@ F.f(x); + return Some z; + } +}. + +module DPSome (P : DPRIMITIVE) : ODPRIMITIVE = { + proc f (x : state) : state option = { + var z; + z <@ P.f(x); + return Some z; + } + proc fi (x: state) : state option = { + var z; + z <@ P.fi(x); + return Some z; + } +}. + +local module (OD (D : ODISTINGUISHER) : DISTINGUISHER) (F : DFUNCTIONALITY) (P : DPRIMITIVE) = { + proc distinguish () = { + var b; + Counter.init(); + b <@ D(OFC(DFSome(F)),OPC(DPSome(P))).distinguish(); + return b; + } +}. + +lemma SHA3OIndiff + (Dist <: ODISTINGUISHER{ + Counter, Perm, IRO, BlockSponge.BIRO.IRO, Cntr, Simulator, + Gconcl_list.SimLast(Gconcl.S), BlockSponge.C, Gconcl.S, + SLCommon.F.RO, SLCommon.F.RRO, SLCommon.Redo, SLCommon.C, + Gconcl_list.BIRO2.IRO, Gconcl_list.F2.RO, Gconcl_list.F2.RRO, + Gconcl_list.Simulator, OSimulator}) + &m : + (forall (F <: ODFUNCTIONALITY) (P <: ODPRIMITIVE), + islossless P.f => + islossless P.fi => + islossless F.f => + islossless Dist(F,P).distinguish) => + `|Pr[OGReal(CSome(Sponge), PSome(Perm), ODRestr(Dist)).main() @ &m : res] - + Pr[OGIdeal(FSome(IRO), OSimulator, ODRestr(Dist)).main() @ &m : res]| <= + (limit ^ 2 - limit)%r / (2 ^ (r + c + 1))%r + (4 * limit ^ 2)%r / (2 ^ c)%r. +proof. +move=>h. +cut->: Pr[OGReal(CSome(Sponge), PSome(Perm), ODRestr(Dist)).main() @ &m : res] = + Pr[RealIndif(Sponge, Perm, DRestr(OD(Dist))).main() @ &m : res]. ++ byequiv=>//=; proc; inline*; sim; sp. + call(: ={glob Perm, glob Counter} /\ ={c}(Counter,Cntr))=>/>; auto. + - proc; inline*; sp; auto; if; 1, 3: auto; sp. + by rcondt{2} 1; 1: auto; sp; if; auto. + - proc; inline*; sp; auto; if; auto; sp. + by rcondt{2} 1; 1: auto; sp; if; auto. + proc; inline*; sp; auto; sp; if; auto; sp. + rcondt{2} 1; auto; sp=>/>. + conseq(:_==> ={glob Perm} /\ n{1} = n0{2} /\ z0{1} = z1{2})=> />; sim. + while(={glob Perm, sa, sc, i} /\ (n,z0){1} = (n0,z1){2}); auto. + - by sp; if; auto; sp; if; auto. + conseq(:_==> ={glob Perm, sa, sc})=> />; sim. + by while(={glob Perm, sa, sc, xs}); auto; sp; if; auto=> />. +cut->: Pr[OGIdeal(FSome(IRO), OSimulator, ODRestr(Dist)).main() @ &m : res] = + Pr[IdealIndif(IRO, Simulator, DRestr(OD(Dist))).main() @ &m : res]. ++ byequiv=>//=; proc; inline*; sim; sp. + call(: ={glob IRO, glob Simulator, glob Counter} /\ ={c}(Counter,Cntr)); auto. + - proc; inline*; auto; sp; if; auto; sp. + rcondt{2} 1; auto; sp; if; 1, 3: auto; sim; if; 1, 3: auto; sp; sim. + if; 1, 3: auto; 1: smt(); sp. + * if; auto=> />. + by conseq(:_==> ={IRO.mp} /\ bs0{1} = bs{2})=> />; sim=> />; smt(). + by if; auto=> />; sim; smt(). + - proc; inline*; sp; auto; if; auto; sp. + by rcondt{2} 1; auto; sp; if; auto. + proc; inline*; sp; auto; if; auto; sp. + rcondt{2} 1; auto; sp; if; auto=> />. + by conseq(:_==> bs{1} = bs0{2} /\ ={IRO.mp, glob Simulator})=> />; sim. +apply (security (OD(Dist)) _ &m). +move=> F P hp hpi hf; proc; inline*; sp. +call (h (OFC(DFSome(F))) (OPC(DPSome(P))) _ _ _); auto. ++ by proc; inline*; sp; if; auto; call hp; auto. ++ by proc; inline*; sp; if; auto; call hpi; auto. +by proc; inline*; sp; if; auto; call hf; auto. +qed. + + + diff --git a/proof/SecureORO.eca b/proof/SecureORO.eca new file mode 100644 index 0000000..38949c6 --- /dev/null +++ b/proof/SecureORO.eca @@ -0,0 +1,491 @@ +require import Int Distr Real SmtMap FSet Mu_mem. +require (****) PROM FelTactic. + + +type from, to. + +op sampleto : to distr. + +op bound : int. +axiom bound_gt0 : 0 < bound. + +axiom sampleto_ll: is_lossless sampleto. +axiom sampleto_full: is_full sampleto. +axiom sampleto_fu: is_funiform sampleto. + +clone import PROM.GenEager as RO with + type from <- from, + type to <- to, + op sampleto <- fun _ => sampleto +proof * by exact/sampleto_ll. + +op increase_counter (c : int) (m : from) : int. +axiom increase_counter_spec c m : c <= increase_counter c m. + +op bound_counter : int. +axiom bound_counter_ge0 : 0 <= bound_counter. + +module type RF = { + proc init() : unit + proc get(x : from) : to option + proc sample (x: from) : unit +}. + +module RF (R : RO) : RF = { + proc init = R.init + proc get (x : from) : to option = { + var y; + y <@ R.get(x); + return Some y; + } + proc sample = R.sample +}. + +module Bounder (F : RF) : RF = { + var bounder : int + proc init () : unit = { + bounder <- 0; + F.init(); + } + proc get(x : from) : to option = { + var y : to option <- None; + if (bounder < bound) { + bounder <- bounder + 1; + y <- F.get(x); + } + return y; + } + proc sample = F.sample +}. + + +module type Oracle = { + proc get(x : from) : to option {} +}. + +module type AdvPreimage (F : Oracle) = { + proc guess(h : to) : from +}. + +module Preimage (A : AdvPreimage, F : RF) = { + proc main () : bool = { + var m,hash,hash'; + hash <$ sampleto; + Bounder(F).init(); + m <@ A(Bounder(F)).guess(hash); + hash' <@ Bounder(F).get(m); + return hash' = Some hash; + } +}. + +section Preimage. + + declare module A : AdvPreimage{RO,Preimage}. + + local module FEL (A : AdvPreimage, F : RF) = { + proc main (hash : to) : from = { + var m; + Bounder(F).init(); + m <@ A(Bounder(F)).guess(hash); + return m; + } + }. + + local module Preimage2 (A : AdvPreimage, F : RF) = { + var hash : to + proc main () : bool = { + var m,hash'; + hash <$ sampleto; + m <@ FEL(A,F).main(hash); + hash' <@ Bounder(F).get(m); + return hash' = Some hash; + } + }. + + lemma RO_is_preimage_resistant &m : + Pr [ Preimage(A,RF(RO)).main() @ &m : res ] <= (bound + 1)%r * mu1 sampleto witness. + proof. + cut->: Pr [ Preimage (A,RF(RO)).main() @ &m : res ] = + Pr [ Preimage2(A,RF(RO)).main() @ &m : res ]. + + by byequiv=> //=; proc; inline*; sim. + byphoare(: _ ==> _) => //=; proc. + seq 2 : (rng RO.m Preimage2.hash) (bound%r * mu1 sampleto witness) 1%r 1%r + (mu1 sampleto witness) + (card (fdom RO.m) <= Bounder.bounder <= bound). + + inline*; auto; call(: card (fdom RO.m) <= Bounder.bounder <= bound)=> //=. + - proc; inline*; auto; sp; if; 2:auto; wp. + wp; conseq(:_==> card (fdom RO.m) + 1 <= Bounder.bounder <= bound); 2: by auto;smt(). + move=> &h /> c H1 H2 c2 r x h1 h2; split; 2: smt(). + by rewrite fdom_set fcardU fcard1; smt(fcard_ge0). + by auto=> />; rewrite fdom0 fcards0; smt(bound_gt0). + + seq 1 : true 1%r (bound%r * mu1 sampleto witness) 0%r _; auto. + exists * Preimage2.hash; elim* => h. + call(: Preimage2.hash = h /\ h = arg ==> rng RO.m h)=> //; bypr=> /> {&m} &m {h} <-. + pose h := Preimage2.hash{m}. + have H: forall &m h, + Pr[FEL(A, RF(RO)).main(h) @ &m : rng RO.m h] <= bound%r * mu1 sampleto witness; last first. + + exact(H &m h). + move=> {&m h} &m h. + fel 1 Bounder.bounder (fun _, mu1 sampleto witness) bound (rng RO.m h) + [Bounder(RF(RO)).get: (card (fdom RO.m) <= Bounder.bounder < bound)] + (card (fdom RO.m) <= Bounder.bounder <= bound) + =>//. + - rewrite StdBigop.Bigreal.BRA.big_const List.count_predT List.Range.size_range. + rewrite IntExtra.Extrema.max_ler //=; 1:smt(bound_gt0). + rewrite-StdRing.RField.AddMonoid.iteropE-StdRing.RField.intmulpE; 1: smt(bound_gt0). + by rewrite StdRing.RField.intmulr; smt(). + - inline*; auto=> /> &h. + rewrite mem_rng_empty /= fdom0 fcards0 /=; smt(bound_gt0). + - proc. + sp; if; auto; sp; inline*; sp; wp=> /=. + case: (x \in RO.m); wp => //=. + + by hoare; auto; smt(mu_bounded). + rnd (pred1 h); auto=> /> &h c ??????. + rewrite (sampleto_fu h witness) /= => ? ?. + rewrite rngE/= => [][] a; rewrite get_setE. + case: (a=x{h}) => [->>|] //=. + by move:H1; rewrite rngE /= negb_exists/= => /(_ a) //=. + - move=> c; proc; inline*; sp; if; sp. + + auto; progress. + + smt(). + + by rewrite fdom_set fcardU fcard1; smt(fcard_ge0). + + smt(). + + smt(). + + smt(). + + smt(). + by auto. + move=> b c; proc; sp; inline*; if; auto; progress. + - rewrite 2!rngE /= eq_iff; split=> [][] a. + + by rewrite get_setE; move: H4; rewrite domE /=; smt(). + move=> H8; exists a; rewrite get_setE; move: H4; rewrite domE /=; smt(). + - smt(). + - by rewrite fdom_set fcardU fcard1; smt(fcard_ge0). + - smt(). + - smt(). + - smt(). + - smt(). + + by inline*; auto. + + by inline*; auto. + + inline*; sp; wp. + if; sp; wp; last by hoare;auto;progress; smt(mu_bounded). + case: (x \in RO.m). + - hoare; auto; progress. + + smt(mu_bounded). + rewrite H3/=; move: H1; rewrite rngE /= negb_exists /=. + by have:=H3; rewrite domE; smt(). + rnd (pred1 Preimage2.hash); auto=> /> &hr 6?. + rewrite (sampleto_fu Preimage2.hash{hr} witness)/= => ??. + by rewrite get_setE /=; smt(). + smt(). + qed. + +end section Preimage. + +(*-------------------------------------------------------------------------*) +module type AdvSecondPreimage (F : Oracle) = { + proc guess(m : from) : from +}. + +module SecondPreimage (A : AdvSecondPreimage, F : RF) = { + proc main (m1 : from) : bool = { + var m2, hash1, hash2; + Bounder(F).init(); + m2 <@ A(Bounder(F)).guess(m1); + hash1 <@ Bounder(F).get(m1); + hash2 <@ Bounder(F).get(m2); + return m1 <> m2 /\ exists y, Some y = hash1 /\ Some y = hash2; + } +}. + +section SecondPreimage. + + + declare module A : AdvSecondPreimage{Bounder,RO,FRO}. + + local module FEL (A : AdvSecondPreimage, F : RF) = { + proc main (m1 : from) : from = { + var m2; + Bounder(F).init(); + Bounder(F).sample(m1); + m2 <@ A(Bounder(F)).guess(m1); + return m2; + } + }. + + local module SecondPreimage2 (A : AdvSecondPreimage, F : RF) = { + var m2 : from + proc main (m1 : from) : bool = { + var hash1,hash2; + m2 <@ FEL(A,F).main(m1); + hash1 <@ Bounder(F).get(m1); + hash2 <@ Bounder(F).get(m2); + return m1 <> m2 /\ exists y, Some y = hash1 /\ Some y = hash2; + } + }. + + local module D1 (A : AdvSecondPreimage, F : RO) = { + var m1 : from + proc distinguish () : bool = { + var b; + b <@ SecondPreimage2(A,RF(F)).main(m1); + return b; + } + }. + + local module SecondPreimage3 (A : AdvSecondPreimage, F : RO) = { + proc main (m1 : from) : bool = { + var b; + SecondPreimage2.m2 <- witness; + D1.m1 <- m1; + Bounder(RF(F)).init(); + b <@ D1(A,F).distinguish(); + return b; + } + }. + + + lemma RO_is_second_preimage_resistant &m (mess1 : from) : + Pr [ SecondPreimage(A,RF(RO)).main(mess1) @ &m : res ] + <= (bound + 1)%r * mu1 sampleto witness. + proof. + have->: Pr [ SecondPreimage(A,RF(RO)).main(mess1) @ &m : res ] = + Pr [ SecondPreimage(A,RF(LRO)).main(mess1) @ &m : res ]. + + by byequiv=> //=; proc; inline*; sim. + have->: Pr [ SecondPreimage(A,RF(LRO)).main(mess1) @ &m : res ] = + Pr [ SecondPreimage2(A,RF(LRO)).main(mess1) @ &m : res ]. + + by byequiv=> //=; proc; inline*; sim. + have->: Pr [ SecondPreimage2(A,RF(LRO)).main(mess1) @ &m : res ] = + Pr [ SecondPreimage2(A,RF(RO)).main(mess1) @ &m : res ]. + + have->: Pr [ SecondPreimage2(A,RF(LRO)).main(mess1) @ &m : res ] = + Pr [ SecondPreimage3(A,LRO).main(mess1) @ &m : res ]. + - by byequiv=> //=; proc; inline*; wp 15 -2; sim. + have->: Pr [ SecondPreimage3(A,LRO).main(mess1) @ &m : res ] = + Pr [ SecondPreimage3(A,RO).main(mess1) @ &m : res ]. + - rewrite eq_sym. + byequiv=>//=; proc. + by call(RO_LRO_D (D1(A))); inline*; auto. + by byequiv=> //=; proc; inline*; wp -2 18; sim. + byphoare(: arg = mess1 ==> _)=>//=; proc. + seq 1 : (rng (rem RO.m mess1) (oget RO.m.[mess1])) + (bound%r * mu1 sampleto witness) 1%r + 1%r (mu1 sampleto witness) + (card (fdom RO.m) - 1 <= Bounder.bounder <= bound + /\ mess1 \in RO.m /\ mess1 = m1). + + inline*; auto; call(: card (fdom RO.m) - 1 <= Bounder.bounder <= bound + /\ mess1 \in RO.m). + - proc; inline*; auto; sp; if; last by auto; smt(). + auto=> /> &h c Hc Hdom Hc2 sample. + by rewrite sampleto_full/=!fdom_set !fcardU !fcard1;smt(mem_set fcard_ge0). + auto=> /> &h sample. + by rewrite mem_set mem_empty/= fdom_set fdom0 fset0U fcard1; smt(bound_gt0). + + call(: arg = mess1 ==> rng (rem RO.m mess1) (oget RO.m.[mess1])); auto. + bypr=> {&m} &m h; rewrite h. + fel 2 Bounder.bounder (fun _, mu1 sampleto witness) bound + (mess1 \in RO.m /\ rng (rem RO.m mess1) (oget RO.m.[mess1])) + [Bounder(RF(RO)).get: (card (fdom RO.m) - 1 <= Bounder.bounder < bound)] + (card (fdom RO.m) - 1 <= Bounder.bounder <= bound /\ mess1 \in RO.m)=> {h} + =>//. + + rewrite StdBigop.Bigreal.BRA.big_const List.count_predT List.Range.size_range. + rewrite IntExtra.Extrema.max_ler //=; 1:smt(bound_gt0). + rewrite-StdRing.RField.AddMonoid.iteropE-StdRing.RField.intmulpE; 1: smt(bound_gt0). + by rewrite StdRing.RField.intmulr; smt(mu_bounded bound_gt0). + + inline*; auto=> />. + move=> &h r; rewrite mem_empty /= !mem_set mem_empty/= sampleto_full /=. + rewrite get_set_sameE//= fdom_set fdom0 fset0U fcard1 /= rngE /=; split; 2: smt(bound_gt0). + by rewrite negb_exists/= => a; rewrite remE get_setE //= emptyE; smt(). + + proc; inline*; sp; if; last by hoare; auto. + sp; case: (x \in RO.m)=> //=. + - by hoare; auto; smt(mu_bounded). + rcondt 2; 1: auto; wp=> /=. + conseq(:_ ==> pred1 (oget RO.m.[mess1]) r)=> />. + - move=> /> &h c H0c Hcb Hnrng Hmc _ Hdom1 Hdom2 sample. + rewrite mem_set Hdom1 /= get_set_neqE; 1: smt(). + have->: (rem RO.m{h}.[x{h} <- sample] mess1) = (rem RO.m{h} mess1).[x{h} <- sample]. + + by apply fmap_eqP=> y; rewrite remE 2!get_setE remE; smt(). + move: Hnrng; rewrite Hdom1 /= rngE /= negb_exists /= => Hnrng. + rewrite rngE/= => [][] mess; rewrite get_setE remE. + by have:= Hnrng mess; rewrite remE; smt(). + rnd; auto; progress. + by have ->:= sampleto_fu witness (oget RO.m{hr}.[mess1]). + + move=> c; proc; inline*; sp; if; auto; progress. + - smt(). + - by rewrite fdom_set fcardU fcard1; smt(fcard_ge0). + - smt(). + - smt(mem_set). + - smt(). + - smt(). + - smt(). + + move=> b c; proc; inline*; sp; if; auto; smt(). + + by inline*; auto. + + by auto. + + inline*; sp; auto. + if; sp; last first. + + sp; hoare; auto; 1: smt(mu_bounded); if; auto. + case(Bounder.bounder < bound); last first. + - by rcondf 8; 1: auto; hoare; auto; smt(mu_bounded). + rcondt 8; 1: auto. + swap 11 -8; sp. + swap [7..11] -6; sp. + swap[5..6] 2; wp 6=> /=. + case: (SecondPreimage2.m2 \in RO.m). + - rcondf 5; 1: auto; hoare; auto=> /> &h d _ _ in_dom1 not_rng _ in_dom2. + + smt(mu_bounded). + move=> sample2 _ sample1 _; rewrite negb_and/=. + move: not_rng; rewrite rngE /= negb_exists /= => /(_ SecondPreimage2.m2{h}). + rewrite remE; case: (SecondPreimage2.m2{h} = m1{h})=> //=. + by move: in_dom1 in_dom2; smt(). + rcondt 5; 1: auto; wp. + rnd (pred1 (oget RO.m.[x3])); auto. + move => /> &h d _ _ in_dom1 not_rng _ _ nin_dom2 sample2 _. + rewrite (sampleto_fu (oget RO.m{h}.[m1{h}]) witness) /= => _ sample1 _. + by rewrite get_set_sameE//=; smt(). + smt(). + qed. + +end section SecondPreimage. + + +(*--------------------------------------------------------------------------*) +module type AdvCollision (F : Oracle) = { + proc guess() : from * from +}. + +module Collision (A : AdvCollision, F : RF) = { + proc main () : bool = { + var m1,m2,hash1,hash2; + Bounder(F).init(); + (m1,m2) <@ A(Bounder(F)).guess(); + hash1 <@ Bounder(F).get(m1); + hash2 <@ Bounder(F).get(m2); + return m1 <> m2 /\ exists y, Some y = hash1 /\ Some y = hash2; + } +}. + +section Collision. + + declare module A : AdvCollision {RO, FRO, Bounder}. + + local module FEL (A : AdvCollision, F : RF) = { + proc main () : from * from = { + var m1,m2; + Bounder(F).init(); + (m1,m2) <@ A(Bounder(F)).guess(); + return (m1,m2); + } + }. + + local module Collision2 (A : AdvCollision) (F : RF) = { + proc main () : bool = { + var m1,m2,hash1,hash2; + (m1,m2) <@ FEL(A,F).main(); + hash1 <@ Bounder(F).get(m1); + hash2 <@ Bounder(F).get(m2); + return m1 <> m2 /\ exists y, Some y = hash1 /\ Some y = hash2; + } + }. + + op collision (m : ('a, 'b) fmap) = + exists m1 m2, m1 <> m2 /\ m1 \in m /\ m2 \in m /\ m.[m1] = m.[m2]. + + lemma RO_is_collision_resistant &m : + Pr [ Collision(A,RF(RO)).main() @ &m : res ] + <= ((bound * (bound - 1) + 2)%r / 2%r * mu1 sampleto witness). + proof. + have->: Pr [ Collision(A,RF(RO)).main() @ &m : res ] = + Pr [ Collision2(A,RF(RO)).main() @ &m : res ]. + + by byequiv=>//=; proc; inline*; sim. + byphoare=> //; proc. + seq 1 : (collision RO.m) + ((bound * (bound - 1))%r / 2%r * mu1 sampleto witness) 1%r + 1%r (mu1 sampleto witness) + (card (fdom RO.m) <= Bounder.bounder <= bound); first last; first last. + + auto. + + auto. + + inline*; sp. + if; sp; last first. + - by wp; conseq(:_==> false)=> />; hoare; 1: smt(mu_bounded); auto. + case: (Bounder.bounder < bound); last first. + - rcondf 8; 1:auto; hoare; auto; smt(mu_bounded). + rcondt 8; 1: auto. + swap 11 -8. + swap [7..11] -6; sp. + swap [5..6] 1; wp 5=> /=. + swap 3 -1. + case: (m1 = m2). + - by hoare; 1: smt(mu_bounded); auto. + case: (m1 \in RO.m); case: (m2 \in RO.m). + - rcondf 3; 1: auto; rcondf 4; 1: auto; hoare; auto; 1: smt(bound_gt0 mu_bounded). + move=> /> &h d _ _ Hcoll _ _ neq12 in_dom1 in_dom2 _ _ _ _. + move: Hcoll; rewrite /collision negb_exists /= => /(_ m1{h}). + rewrite negb_exists /= => /(_ m2{h}). + by rewrite neq12 in_dom1 in_dom2 /=; smt(). + - rcondf 3; 1: auto; rcondt 4; 1: auto; wp. + rnd (pred1 (oget RO.m.[x3])). + auto=> /> &h d Hmc Hcb Hcoll _ _ neq12 in_dom1 in_dom2 _ _; split. + * smt(sampleto_fu). + by move=> _ sample _; rewrite get_set_sameE; smt(). + - rcondt 3; 1: auto; rcondf 5; 1: (by auto; smt(mem_set)). + swap 1; wp=> /=; rnd (pred1 (oget RO.m.[m2])); auto. + move=> /> &h d _ _ Hcoll _ _ neq12 in_dom1 in_dom2 _ _; split. + * smt(sampleto_fu). + move=> _ sample _. + by rewrite get_set_sameE get_set_neqE 1:eq_sym. + rcondt 3; 1: auto; rcondt 5; 1: (by auto; smt(mem_set)). + swap 2 -1; swap 1; wp=> //=; rnd (pred1 r); auto. + move=> /> &h d _ _ Hcoll _ _ neq12 in_dom1 in_dom2 sample1 _; split. + * smt(sampleto_fu). + move=> _ sample2 _. + by rewrite get_set_sameE get_set_sameE; smt(). + + by move=> />; smt(mu_bounded). + + inline*; wp; call(: card (fdom RO.m) <= Bounder.bounder <= bound); auto. + - proc; inline*; sp; if; last by auto; smt(). + auto=> /> &h d Hbc Hcb sample _; split. + * by move=> nin_dom1; rewrite fdom_set fcardU fcard1; smt(fcard_ge0). + by move=> in_dom1; smt(). + by move=> />; rewrite fdom0 fcards0; smt(bound_gt0). + call(: true ==> collision RO.m); auto; bypr=> /> {&m} &m. + fel 1 Bounder.bounder (fun i, i%r * mu1 sampleto witness) bound + (collision RO.m) + [Bounder(RF(RO)).get: (card (fdom RO.m) <= Bounder.bounder < bound)] + (card (fdom RO.m) <= Bounder.bounder <= bound)=> //. + + rewrite -StdBigop.Bigreal.BRA.mulr_suml StdRing.RField.mulrAC. + rewrite StdOrder.RealOrder.ler_wpmul2r; 1: smt(mu_bounded). + by rewrite StdBigop.Bigreal.sumidE //; smt(bound_gt0). + + inline*; auto=> />. + rewrite fdom0 fcards0; split; 2: smt(bound_gt0). + rewrite /collision negb_exists /= => a; rewrite negb_exists /= => b. + by rewrite mem_empty. + + bypr=> /> {&m} &m; pose c := Bounder.bounder{m}; move=> H0c Hcbound Hcoll Hmc _. + byphoare(: !collision RO.m /\ card (fdom RO.m) <= c ==> _)=>//=. + proc; inline*; sp; if; last first. + - by hoare; auto; smt(mu_bounded). + case: (x \in RO.m). + - by hoare; auto; smt(mu_bounded). + rcondt 5; 1: auto; sp; wp=> /=. + conseq(:_==> r \in frng RO.m). + - move=> /> &h c2 Hcoll2 Hb2c Hc2b nin_dom sample m1 m2 neq. + rewrite 2!mem_set. + case: (m1 = x{h}) => //=. + * move=> <<-; rewrite eq_sym neq /= get_set_sameE get_set_neqE//= 1:eq_sym //. + by rewrite mem_frng rngE /= => _ ->; exists m2. + case: (m2 = x{h}) => //=. + * move=> <<- _ in_dom1. + by rewrite get_set_neqE // get_set_sameE mem_frng rngE/= => <-; exists m1. + move=> neq2 neq1 in_dom1 in_dom2; rewrite get_set_neqE // get_set_neqE //. + have:= Hcoll2; rewrite negb_exists /= => /(_ m1). + rewrite negb_exists /= => /(_ m2). + by rewrite neq in_dom1 in_dom2 /= => ->. + rnd; skip=> /> &h bounder _ h _. + rewrite (mu_mem (frng RO.m{h}) sampleto (mu1 sampleto witness)); 1: smt(sampleto_fu). + rewrite StdOrder.RealOrder.ler_wpmul2r //; 1: smt(mu_bounded). + by rewrite RealExtra.le_fromint; smt(le_card_frng_fdom). + + move=> c; proc; inline*; auto; sp; if; last by auto; smt(). + auto=> /> &h h1 h2 _ sample _. + by rewrite fdom_set fcardU fcard1; smt(fcard_ge0). + move=> b c; proc; inline*; sp; if; auto. + move=> /> &h h1 h2 _ _ sample _. + by rewrite fdom_set fcardU fcard1; smt(fcard_ge0). + qed. + + +end section Collision. From 9152e605d5e3481973f8026bc387e441ef013f56 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Thu, 15 Aug 2019 16:18:01 -0400 Subject: [PATCH 451/525] Slight refactoring: Hybrid IROs now have just one procedure (f) in addition to init, and there is now LowerHybridIRO as well as RaiseHybridIRO. --- proof/Sponge.ec | 163 +++++++++++++++++++++--------------------------- 1 file changed, 72 insertions(+), 91 deletions(-) diff --git a/proof/Sponge.ec b/proof/Sponge.ec index aa88203..d9b1644 100644 --- a/proof/Sponge.ec +++ b/proof/Sponge.ec @@ -193,36 +193,34 @@ module RaiseSim (S : BlockSponge.SIMULATOR, F : DFUNCTIONALITY) = (BlockSponge.BIRO.IRO, BlockSim, LowerDist(Dist)).main () @ &m : res]. into three steps, involving Hybrid IROs, which, in addition to - an init procedure, have procedures + an init procedure, have the procedure (* hashing block lists, giving n bits *) - proc g(x : block list, n : int) : bool list - - (* hashing block lists, giving n blocks *) - proc f(x : block list, n : int) : block list + proc f(x : block list, n : int) : bool list We have lazy (HybridIROLazy) and eager (HybridIROEager) Hybrid IROs, both of which work with a finite map from block list * int to - bool. In both versions, f is defined in terms of g, and, as in - BlockSponge.BIRO.IRO, g returns [] if x isn't a valid block. In - both versions, the input/output behavior of f is identical to that - of BlockSponge.BIRO.IRO.f. + bool. In both versions, as in BlockSponge.BIRO.IRO, f returns [] if + x isn't a valid block list. - In the lazy version, g consults/randomly updates just those + In the lazy version, f consults/randomly updates just those elements of the map's domain needed to produce the needed bits. But the eager version goes further, consulting/randomly updating enough - extra domain elements so that a multiple of r domain elements were + extra domain elements so that a multiple of r domain elements are consulted/randomly updated (those extra bits are discarded) We have a parameterized module RaiseHybridIRO for turning a Hybrid - IRO into a FUNCTIONALITY in the obvious way (not using f), and we - split the proof of the Ideal side into three steps: + IRO into a FUNCTIONALITY in the obvious way, and we have a + parameterized module LowerHybridIRO for turning a Hybrid IRO into a + DFUNCTIONALITY in the obivous way. We split the proof of the Ideal + side into three steps: Step 1: Pr[IdealIndif(IRO, RaiseSim(BlockSim), Dist).main() @ &m : res] = Pr[Experiment - (RaiseHybridIRO(HybridIROLazy), BlockSim(HybridIROLazy), + (RaiseHybridIRO(HybridIROLazy), + BlockSim(LowerHybridIRO(HybridIROLazy)), Dist).main() @ &m : res] This step is proved using a lazy invariant relating the @@ -231,10 +229,12 @@ module RaiseSim (S : BlockSponge.SIMULATOR, F : DFUNCTIONALITY) = Step 2: Pr[Experiment - (RaiseHybridIRO(HybridIROLazy), BlockSim(HybridIROLazy), + (RaiseHybridIRO(HybridIROLazy), + BlockSim(LowerHybridIRO(HybridIROLazy)), Dist).main() @ &m : res] = Pr[Experiment - (RaiseHybridIRO(HybridIROEager), BlockSim(HybridIROEager), + (RaiseHybridIRO(HybridIROEager), + BlockSim(LowerHybridIRO(HybridIROEager)), Dist).main() @ &m : res] This step is proved using the eager sampling lemma provided by @@ -243,7 +243,8 @@ module RaiseSim (S : BlockSponge.SIMULATOR, F : DFUNCTIONALITY) = Step 3: Pr[Experiment - (RaiseHybridIRO(HybridIROEager), BlockSim(HybridIROEager), + (RaiseHybridIRO(HybridIROEager), + BlockSim(LowerHybridIRO(HybridIROEager)), Dist).main() @ &m : res] = Pr[BlockSponge.IdealIndif (BlockSponge.BIRO.IRO, BlockSim, LowerDist(Dist)).main () @ &m : res] @@ -263,16 +264,13 @@ module type HYBRID_IRO = { proc init() : unit (* hashing block lists, giving n bits *) - proc g(x : block list, n : int) : bool list - - (* hashing block lists, giving n blocks *) - proc f(x : block list, n : int) : block list + proc f(x : block list, n : int) : bool list }. (* distinguisher for Hybrid IROs *) module type HYBRID_IRO_DIST(HI : HYBRID_IRO) = { - proc distinguish() : bool + proc distinguish() : bool {HI.f} }. (* experiments for Hybrid IROs *) @@ -288,21 +286,21 @@ module HybridIROExper(HI : HYBRID_IRO, D : HYBRID_IRO_DIST) = { (* lazy implementation of Hybrid IROs *) -module HybridIROLazy : HYBRID_IRO, BlockSponge.BIRO.IRO = { +module HybridIROLazy : HYBRID_IRO = { var mp : (block list * int, bool) fmap proc init() : unit = { mp <- empty; } - proc fill_in(xs, i) = { + proc fill_in(xs : block list, i : int) = { if (! dom mp (xs, i)) { mp.[(xs, i)] <$ dbool; } return oget mp.[(xs, i)]; } - proc g(xs, n) = { + proc f(xs : block list, n : int) = { var b, bs; var i <- 0; @@ -316,18 +314,11 @@ module HybridIROLazy : HYBRID_IRO, BlockSponge.BIRO.IRO = { } return bs; } - - proc f(xs, n) = { (* implemented using g *) - var bs, ys; - bs <@ g(xs, n * r); - ys <- bits2blocks bs; - return ys; - } }. (* eager implementation of Hybrid IROs *) -module HybridIROEager : HYBRID_IRO, BlockSponge.BIRO.IRO = { +module HybridIROEager : HYBRID_IRO = { (* same as lazy implementation, except for indicated part *) var mp : (block list * int, bool) fmap @@ -335,14 +326,14 @@ module HybridIROEager : HYBRID_IRO, BlockSponge.BIRO.IRO = { mp <- empty; } - proc fill_in(xs, i) = { + proc fill_in(xs : block list, i : int) = { if (! dom mp (xs, i)) { mp.[(xs, i)] <$ dbool; } return oget mp.[(xs, i)]; } - proc g(xs, n) = { + proc f(xs : block list, n : int) = { var b, bs; var m <- ((n + r - 1) %/ r) * r; (* eager part *) var i <- 0; @@ -361,13 +352,6 @@ module HybridIROEager : HYBRID_IRO, BlockSponge.BIRO.IRO = { } return bs; } - - proc f(xs, n) = { - var bs, ys; - bs <@ g(xs, n * r); - ys <- bits2blocks bs; - return ys; - } }. (* we are going to use PROM.GenEager to prove: @@ -412,7 +396,7 @@ local module HIRO(RO : ERO.RO) : HYBRID_IRO = { RO.init(); } - proc g(xs, n) = { + proc f(xs, n) = { var b, bs; var m <- ((n + r - 1) %/ r) * r; var i <- 0; @@ -431,13 +415,6 @@ local module HIRO(RO : ERO.RO) : HYBRID_IRO = { } return bs; } - - proc f(xs, n) = { - var bs, ys; - bs <@ g(xs, n * r); - ys <- bits2blocks bs; - return ys; - } }. local lemma HybridIROLazy_HIRO_LRO_init : @@ -458,8 +435,8 @@ rcondt{1} 1; first auto. rcondt{2} 2; first auto. wp; rnd; auto. qed. -local lemma HybridIROLazy_HIRO_LRO_g : - equiv[HybridIROLazy.g ~ HIRO(ERO.LRO).g : +local lemma HybridIROLazy_HIRO_LRO_f : + equiv[HybridIROLazy.f ~ HIRO(ERO.LRO).f : ={xs, n} /\ HybridIROLazy.mp{1} = ERO.RO.m{2} ==> ={res} /\ HybridIROLazy.mp{1} = ERO.RO.m{2}]. proof. @@ -472,12 +449,6 @@ wp; call HybridIROLazy_fill_in_LRO_get; auto. auto; progress; smt(). qed. -local lemma HybridIROLazy_HIRO_LRO_f : - equiv[HybridIROLazy.f ~ HIRO(ERO.LRO).f : - ={xs, n} /\ HybridIROLazy.mp{1} = ERO.RO.m{2} ==> - ={res} /\ HybridIROLazy.mp{1} = ERO.RO.m{2}]. -proof. proc; wp; call HybridIROLazy_HIRO_LRO_g; auto. qed. - local lemma HIRO_RO_HybridIROEager_init : equiv[HIRO(ERO.RO).init ~ HybridIROEager.init : true ==> ={res} /\ ERO.RO.m{1} = HybridIROEager.mp{2}]. @@ -509,8 +480,8 @@ rcondt{1} 2; first auto. rcondt{2} 1; first auto. wp; rnd; auto. qed. -local lemma HIRO_RO_HybridIROEager_g : - equiv[HIRO(ERO.RO).g ~ HybridIROEager.g : +local lemma HIRO_RO_HybridIROEager_f : + equiv[HIRO(ERO.RO).f ~ HybridIROEager.f : ={xs, n} /\ ERO.RO.m{1} = HybridIROEager.mp{2} ==> ={res} /\ ERO.RO.m{1} = HybridIROEager.mp{2}]. proof. @@ -523,12 +494,6 @@ wp; call RO_get_HybridIROEager_fill_in; auto. auto. qed. -local lemma HIRO_RO_HybridIROEager_f : - equiv[HIRO(ERO.RO).f ~ HybridIROEager.f : - ={xs, n} /\ ERO.RO.m{1} = HybridIROEager.mp{2} ==> - ={res} /\ ERO.RO.m{1} = HybridIROEager.mp{2}]. -proof. proc; wp; call HIRO_RO_HybridIROEager_g; auto. qed. - (* make distinguisher for random oracles out of HIRO and D *) local module RODist(RO : ERO.RO) = { @@ -546,8 +511,6 @@ proof. byequiv=> //; proc; inline*; wp. seq 1 1 : (={glob D} /\ HybridIROLazy.mp{1} = ERO.RO.m{2}); first auto. call (_ : HybridIROLazy.mp{1} = ERO.RO.m{2}). -conseq HybridIROLazy_HIRO_LRO_init. -conseq HybridIROLazy_HIRO_LRO_g. conseq HybridIROLazy_HIRO_LRO_f. auto. qed. @@ -559,8 +522,6 @@ proof. byequiv=> //; proc; inline*; wp. seq 1 1 : (={glob D} /\ ERO.RO.m{1} = HybridIROEager.mp{2}); first auto. call (_ : ERO.RO.m{1} = HybridIROEager.mp{2}). -conseq HIRO_RO_HybridIROEager_init. -conseq HIRO_RO_HybridIROEager_g. conseq HIRO_RO_HybridIROEager_f. auto. qed. @@ -583,7 +544,7 @@ lemma HybridIROExper_Lazy_Eager proof. by apply (HybridIROExper_Lazy_Eager' D &m). qed. (* turn a Hybrid IRO implementation (lazy or eager) into top-level - ideal functionality; its f procedure only uses HI.g *) + ideal functionality *) module RaiseHybridIRO (HI : HYBRID_IRO) : FUNCTIONALITY = { proc init() = { @@ -592,11 +553,23 @@ module RaiseHybridIRO (HI : HYBRID_IRO) : FUNCTIONALITY = { proc f(bs : bool list, n : int) = { var cs; - cs <@ HI.g(pad2blocks bs, n); + cs <@ HI.f(pad2blocks bs, n); return cs; } }. +(* turn a Hybrid IRO implementation (lazy or eager) into lower-level + ideal distinguisher functionality *) + +module LowerHybridIRO (HI : HYBRID_IRO) : BlockSponge.DFUNCTIONALITY = { + proc f(xs : block list, n : int) = { + var bs, ys; + bs <@ HI.f(xs, n * r); + ys <- bits2blocks bs; + return ys; + } +}. + (* invariant relating maps of BIRO.IRO and HybridIROLazy *) pred lazy_invar @@ -706,11 +679,11 @@ by rewrite !get_set_sameE. qed. lemma LowerFun_IRO_HybridIROLazy_f : - equiv[LowerFun(IRO).f ~ HybridIROLazy.f : + equiv[LowerFun(IRO).f ~ LowerHybridIRO(HybridIROLazy).f : ={xs, n} /\ lazy_invar IRO.mp{1} HybridIROLazy.mp{2} ==> ={res} /\ lazy_invar IRO.mp{1} HybridIROLazy.mp{2}]. proof. -proc=> /=; inline HybridIROLazy.g. +proc=> /=; inline HybridIROLazy.f. seq 0 1 : (={n} /\ xs{1} = xs0{2} /\ lazy_invar IRO.mp{1} HybridIROLazy.mp{2}); first auto. @@ -899,8 +872,8 @@ lemma block_bits_dom_first_out_imp_all_out block_bits_all_out_dom xs i mp. proof. smt(). qed. -lemma HybridIROEager_f_g : - equiv[HybridIROEager.f ~ HybridIROEager.g : +lemma Lower_HybridIROEager_f : + equiv[LowerHybridIRO(HybridIROEager).f ~ HybridIROEager.f : ={xs, HybridIROEager.mp} /\ n{1} * r = n{2} ==> res{1} = bits2blocks res{2} /\ ={HybridIROEager.mp}]. proof. @@ -1637,8 +1610,8 @@ wp; sp. call (_ : ={BlockSponge.BIRO.IRO.mp}). if=> //; rnd; skip; smt(). auto. qed. -lemma HybridIROEager_g_BlockIRO_f (n1 : int) (x2 : block list) : - equiv[HybridIROEager.g ~ BlockSponge.BIRO.IRO.f : +lemma HybridIROEager_f_BlockIRO_f (n1 : int) (x2 : block list) : + equiv[HybridIROEager.f ~ BlockSponge.BIRO.IRO.f : n1 = n{1} /\ x2 = x{2} /\ xs{1} = x{2} /\ n{2} = (n{1} + r - 1) %/ r /\ eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> @@ -1898,13 +1871,13 @@ auto. qed. lemma HybridIROEager_BlockIRO_f : - equiv[HybridIROEager.f ~ BlockSponge.BIRO.IRO.f : + equiv[LowerHybridIRO(HybridIROEager).f ~ BlockSponge.BIRO.IRO.f : xs{1} = x{2} /\ ={n} /\ eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> ={res} /\ eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1}]. proof. transitivity - HybridIROEager.g + HybridIROEager.f (={xs, HybridIROEager.mp} /\ n{2} = n{1} * r /\ eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1} ==> res{1} = bits2blocks res{2} /\ ={HybridIROEager.mp}) @@ -1916,9 +1889,9 @@ move=> |> &1 &2 ? n_eq inv. exists HybridIROEager.mp{1} BlockSponge.BIRO.IRO.mp{2} (xs{1}, n{1} * r). move=> |>; by rewrite n_eq. progress; apply blocks2bitsK. -by conseq HybridIROEager_f_g=> |> &1 &2 ? -> ?. +by conseq Lower_HybridIROEager_f=> |> &1 &2 ? -> ?. exists* n{1}; elim*=> n1; exists* xs{1}; elim*=> xs'. -conseq (HybridIROEager_g_BlockIRO_f n1 xs')=> //. +conseq (HybridIROEager_f_BlockIRO_f n1 xs')=> //. move=> |> &1 &2 ? -> inv; by rewrite needed_blocks_prod_r. move=> |> &1 &2 ? n1_eq ? res1 res2 ? ? ? vb_imp not_vb_imp. case: (valid_block xs{1})=> [vb_xs1 | not_vb_xs1]. @@ -1998,7 +1971,8 @@ qed. local lemma Ideal_IRO_Experiment_HybridLazy &m : Pr[IdealIndif(IRO, RaiseSim(BlockSim), Dist).main() @ &m : res] = Pr[Experiment - (HIRO.RaiseHybridIRO(HIRO.HybridIROLazy), BlockSim(HIRO.HybridIROLazy), + (HIRO.RaiseHybridIRO(HIRO.HybridIROLazy), + BlockSim(HIRO.LowerHybridIRO(HIRO.HybridIROLazy)), Dist).main() @ &m : res]. proof. byequiv=> //; proc. @@ -2035,8 +2009,10 @@ qed. local module (HybridIRODist : HIRO.HYBRID_IRO_DIST) (HI : HIRO.HYBRID_IRO) = { proc distinguish() : bool = { var b : bool; - BlockSim(HI).init(); - b <@ Dist(HIRO.RaiseHybridIRO(HI), BlockSim(HI)).distinguish(); + BlockSim(HIRO.LowerHybridIRO(HI)).init(); + b <@ + Dist(HIRO.RaiseHybridIRO(HI), + BlockSim(HIRO.LowerHybridIRO(HI))).distinguish(); return b; } }. @@ -2045,7 +2021,8 @@ local module (HybridIRODist : HIRO.HYBRID_IRO_DIST) (HI : HIRO.HYBRID_IRO) = { local lemma Experiment_HybridIROExper_Lazy &m : Pr[Experiment - (HIRO.RaiseHybridIRO(HIRO.HybridIROLazy), BlockSim(HIRO.HybridIROLazy), + (HIRO.RaiseHybridIRO(HIRO.HybridIROLazy), + BlockSim(HIRO.LowerHybridIRO(HIRO.HybridIROLazy)), Dist).main() @ &m : res] = Pr[HIRO.HybridIROExper(HIRO.HybridIROLazy, HybridIRODist).main() @ &m : res]. proof. @@ -2061,7 +2038,8 @@ local lemma HybridIROExper_Experiment_Eager &m : Pr[HIRO.HybridIROExper(HIRO.HybridIROEager, HybridIRODist).main() @ &m : res] = Pr[Experiment - (HIRO.RaiseHybridIRO(HIRO.HybridIROEager), BlockSim(HIRO.HybridIROEager), + (HIRO.RaiseHybridIRO(HIRO.HybridIROEager), + BlockSim(HIRO.LowerHybridIRO(HIRO.HybridIROEager)), Dist).main() @ &m : res]. proof. byequiv=> //; proc; inline*. @@ -2075,10 +2053,12 @@ qed. local lemma Experiment_Hybrid_Lazy_Eager &m : Pr[Experiment - (HIRO.RaiseHybridIRO(HIRO.HybridIROLazy), BlockSim(HIRO.HybridIROLazy), + (HIRO.RaiseHybridIRO(HIRO.HybridIROLazy), + BlockSim(HIRO.LowerHybridIRO(HIRO.HybridIROLazy)), Dist).main() @ &m : res] = Pr[Experiment - (HIRO.RaiseHybridIRO(HIRO.HybridIROEager), BlockSim(HIRO.HybridIROEager), + (HIRO.RaiseHybridIRO(HIRO.HybridIROEager), + BlockSim(HIRO.LowerHybridIRO(HIRO.HybridIROEager)), Dist).main() @ &m : res]. proof. by rewrite (Experiment_HybridIROExper_Lazy &m) @@ -2099,7 +2079,7 @@ proof. proc=> /=. exists* n{1}; elim*=> n'. exists* (pad2blocks bs{2}); elim*=> xs2. -call (HIRO.HybridIROEager_g_BlockIRO_f n' xs2). +call (HIRO.HybridIROEager_f_BlockIRO_f n' xs2). skip=> |> &1 &2 ? res1 res2 mp1 mp2 ? vb_imp not_vb_imp. case: (valid_block (pad2blocks bs{2}))=> [vb | not_vb]. have [le0_n2_imp gt0_n2_imp] := vb_imp vb. @@ -2114,7 +2094,8 @@ qed. local lemma Experiment_HybridEager_Ideal_BlockIRO &m : Pr[Experiment - (HIRO.RaiseHybridIRO(HIRO.HybridIROEager), BlockSim(HIRO.HybridIROEager), + (HIRO.RaiseHybridIRO(HIRO.HybridIROEager), + BlockSim(HIRO.LowerHybridIRO(HIRO.HybridIROEager)), Dist).main() @ &m : res] = Pr[BlockSponge.IdealIndif (BlockSponge.BIRO.IRO, BlockSim, LowerDist(Dist)).main () @ &m : res]. From 66320702b045523993a72ff566943723df3c3aee Mon Sep 17 00:00:00 2001 From: Manuel Barbosa Date: Fri, 16 Aug 2019 18:07:53 +0100 Subject: [PATCH 452/525] Precondition strengthening seems necessary --- proof/impl/libc/keccak_1600_avx2_modular.ec | 59 +++++++++------------ 1 file changed, 24 insertions(+), 35 deletions(-) diff --git a/proof/impl/libc/keccak_1600_avx2_modular.ec b/proof/impl/libc/keccak_1600_avx2_modular.ec index 8c0c057..4d617c8 100644 --- a/proof/impl/libc/keccak_1600_avx2_modular.ec +++ b/proof/impl/libc/keccak_1600_avx2_modular.ec @@ -591,7 +591,7 @@ qed. equiv add_full_block_corr rr : Keccak_1600_ref_modular.Mmod.add_full_block ~ Mmod.add_full_block : - to_uint rate{2} <= 200 /\ to_uint a_jagged{2} + 200 < W64.modulus /\ to_uint in_0{2} + to_uint inlen{2} < W64.modulus /\ + to_uint rate{2} < 200 /\ to_uint a_jagged{2} + 200 < W64.modulus /\ to_uint in_0{2} + to_uint inlen{2} < W64.modulus /\ jagged_zeros_W64 s_state{2} (to_uint rate{2} %/ 8) /\ to_uint rate{2} = rr /\ good_jag Glob.mem{2} (to_uint a_jagged{2}) /\ to_uint rate{2} <= to_uint inlen{2} /\ ={Glob.mem} /\ em_states state{2} state{1} /\ ={in_0,inlen,rate} @@ -604,7 +604,7 @@ proof. proc => /=. exlim state{1} => state0. seq 4 4 : - ( to_uint rate{2} <= 200 /\ to_uint a_jagged{2} + 200 < W64.modulus /\ to_uint in_0{2} + to_uint inlen{2} < W64.modulus /\ + ( to_uint rate{2} < 200 /\ to_uint a_jagged{2} + 200 < W64.modulus /\ to_uint in_0{2} + to_uint inlen{2} < W64.modulus /\ jagged_zeros_W64 s_state{2} (to_uint rate{2} %/ 8) /\ to_uint rate{2} = rr /\ good_jag Glob.mem{2} (to_uint a_jagged{2}) /\ to_uint rate{2} <= to_uint inlen{2} /\ @@ -613,7 +613,7 @@ proof. state{1}.[k] = if k < to_uint rate{2} %/ 8 then state0.[k] `^` s_state{2}.[A_jagged.[k]] else state0.[k]). + while ( - to_uint rate{2} <= 200 /\ to_uint a_jagged{2} + 200 < W64.modulus /\ to_uint in_0{2} + to_uint inlen{2} < W64.modulus /\ + to_uint rate{2} < 200 /\ to_uint a_jagged{2} + 200 < W64.modulus /\ to_uint in_0{2} + to_uint inlen{2} < W64.modulus /\ jagged_zeros_W64 s_state{2} (to_uint rate{2} %/ 8) /\ to_uint rate{2} = rr /\ good_jag Glob.mem{2} (to_uint a_jagged{2}) /\ to_uint rate{2} <= to_uint inlen{2} /\ @@ -696,11 +696,9 @@ proof. rewrite WArray200.WArray200.set_neqiE 1:// 1:/# /init64 WArray200.WArray200.initiE /= /#. qed. -require import IntExtra. - equiv add_final_block_corr : Keccak_1600_ref_modular.Mmod.add_final_block ~ Mmod.add_final_block : - to_uint rate{2} <= 200 /\ + to_uint rate{2} < 200 /\ to_uint a_jagged{2} + 200 < W64.modulus /\ to_uint in_0{2} + to_uint inlen{2} < W64.modulus /\ good_jag Glob.mem{2} (to_uint a_jagged{2}) /\ @@ -711,7 +709,7 @@ proof. proc => /=. exlim state{1} => state0. seq 4 5 : - ( to_uint rate{2} <= 200 /\ to_uint a_jagged{2} + 200 < W64.modulus /\ to_uint in_0{2} + to_uint inlen{2} < W64.modulus /\ + ( to_uint rate{2} < 200 /\ to_uint a_jagged{2} + 200 < W64.modulus /\ to_uint in_0{2} + to_uint inlen{2} < W64.modulus /\ jagged_zeros_W64 s_state{2} (to_uint inlen{2} %/8) /\ good_jag Glob.mem{2} (to_uint a_jagged{2}) /\ (em_states state{2} state0) /\ ={Glob.mem, in_0, inlen} /\ to_uint inlen{2} < to_uint rate{2} /\ r8{1} = rate{2} /\ @@ -720,7 +718,7 @@ proof. state{1}.[k] = if k < to_uint inlen{2} %/ 8 then state0.[k] `^` s_state{2}.[A_jagged.[k]] else state0.[k]). + while ( - to_uint rate{2} <= 200 /\ to_uint a_jagged{2} + 200 < W64.modulus /\ to_uint in_0{2} + to_uint inlen{2} < W64.modulus /\ + to_uint rate{2} < 200 /\ to_uint a_jagged{2} + 200 < W64.modulus /\ to_uint in_0{2} + to_uint inlen{2} < W64.modulus /\ jagged_zeros_W64 s_state{2} (to_uint inlen{2} %/8) /\ good_jag Glob.mem{2} (to_uint a_jagged{2}) /\ (em_states state{2} state0) /\ ={Glob.mem, in_0, inlen, inlen8} /\ i{1} = j{2} /\ to_uint inlen{2} < to_uint rate{2} /\ r8{1} = rate{2} /\ @@ -755,12 +753,12 @@ proof. by rewrite W64.xorw0. by move=> state_ j_ s_state_; rewrite !W64.ultE => /#. seq 6 15 : - (to_uint rate{2} <= 200 /\ + (to_uint rate{2} < 200 /\ jagged_zeros_W64_p s_state{2} - (fun (off : int) => (to_uint inlen{2} %/8 + 1) <= off < 25 \/ off <> (to_uint rate{2} - 1) %/ 8) /\ + (fun (off : int) => (to_uint inlen{2} %/8 + 1) <= off < 25 /\ off <> (to_uint rate{2} - 1) %/ 8) /\ (em_states state{2} state0) /\ forall k, 0 <= k < 25 => - state{1}.[k] = if k < to_uint inlen{2} %/ 8 + 1 /\ k = (to_uint rate{2} - 1) %/ 8 then state0.[k] `^` s_state{2}.[A_jagged.[k]] + state{1}.[k] = if k < to_uint inlen{2} %/ 8 + 1 \/ k = (to_uint rate{2} - 1) %/ 8 then state0.[k] `^` s_state{2}.[A_jagged.[k]] else state0.[k]); last first. + unroll for{2} ^while; wp; skip => |> &1 &2. rewrite /em_states => /> /= *. @@ -776,7 +774,7 @@ proof. rewrite /(`<<`) /= W64.shlMP 1:// /= -W64.of_intM W64.to_uintM_small to_uintK_jagged //=; 1: smt(jagged_bound). by rewrite H6; ring. while ( - to_uint rate{2} <= 200 /\ + to_uint rate{2} < 200 /\ to_uint a_jagged{2} + 200 < W64.modulus /\ to_uint in_0{2} + to_uint inlen{2} < W64.modulus /\ jagged_zeros_W64 s_state{2} (to_uint inlen{2} %/8 + 1) /\ @@ -884,23 +882,7 @@ proof. + move=> k hk1 hk2. rewrite Array28.initiE; 1: by apply jagged_bound. rewrite heq4 get64_set8; 1,2: smt(W64.to_uint_cmp jagged_bound). - (* - case (8 * A_jagged.[k] <= - 8 * A_jagged.[(to_uint rate{2} - 1) %/ 8] + (to_uint rate{2} - 1) %% 8 < - 8 * A_jagged.[k] + 8 ) => [ht | hf]; last by smt (@W64 jagged_bound jagged_inj). - + apply W8u8.wordP => i hi. - rewrite /= !W8u8.pack8bE; first by smt(). - rewrite !initiE 1,2:// /=; first 3 by smt (@W64 jagged_bound jagged_inj). - case: (i = (8 * A_jagged.[(to_uint rate{2} - 1) %/ 8] + (to_uint rate{2} - 1) %% 8) %% 8) => [he | hne]; last first. - + rewrite get64_set8; first 2 by smt(@W64 jagged_bound jagged_inj). - case (8 * A_jagged.[k] <= to_uint l_R < 8 * A_jagged.[k] + 8) => [hht | hhf]; first by smt(@W64 jagged_bound jagged_inj). - move : H11; rewrite /jagged_zeros_W64 /jagged_zeros_W64_p => *. - rewrite (H11 k); first 2 by smt(@W64 jagged_bound jagged_inj). - done. - + rewrite (_: (get64 - (set8 ((init64 ("_.[_]" s_state_R)))%WArray224 (to_uint l_R) - trail_byte{2})) = W64.zero). *) - admit. (* smt (@W64 jagged_bound jagged_inj). *) + admit. (* smt (@W64 jagged_bound jagged_inj). *) move=> k hk1 hk2. have -> : to_uint (rate{2} - W64.one) = to_uint rate{2} - 1. + rewrite W64.to_uintB 1:uleE /=; smt(W64.to_uint_cmp). @@ -909,7 +891,7 @@ proof. rewrite Array25.initiE 1:// get64_set8_200. + smt(W64.to_uint_cmp). + done. - admit. (* smt (@W64 jagged_bound jagged_inj). *) + admit. (* smt (@W64 jagged_bound jagged_inj). *) qed. require import Keccak_f1600_scalar_table. @@ -947,7 +929,7 @@ equiv extr_full_block_corr _outlen _rate _out _iotas rl rr jag : disj_ptr _iotas 800 _out _outlen /\ disj_ptr rl 200 _out _outlen /\ disj_ptr rr 200 _out _outlen /\ - to_uint len{2} <= 200 /\ to_uint a_jagged{2} + 200 < W64.modulus /\ + to_uint len{2} < 200 /\ to_uint a_jagged{2} + 200 < W64.modulus /\ _out + _outlen < W64.modulus /\ _rate <= _outlen /\ good_jag Glob.mem{2} jag /\ good_io4x Glob.mem{2} _iotas /\ @@ -996,7 +978,7 @@ require import IntExtra. equiv extr_bytes_corr : Keccak_1600_ref_modular.Mmod.xtr_bytes ~ Mmod.xtr_bytes : disj_ptr (to_uint a_jagged{2}) 200 (to_uint out{1}) (to_uint outlen{1}) /\ - to_uint a_jagged{2} + 200 < W64.modulus /\ to_uint outlen{1} <= 200 /\ + to_uint a_jagged{2} + 200 < W64.modulus /\ to_uint outlen{1} < 200 /\ good_jag Glob.mem{2} (to_uint a_jagged{2}) /\ to_uint out{1} + to_uint outlen{1} < W64.modulus /\ em_states state{2} state{1} /\ ={Glob.mem,out} /\ outlen{1} = len{2} ==> @@ -1050,7 +1032,14 @@ proof. smt(W64.to_uint_cmp). wp; skip => />. rewrite /disj_ptr /good_jag /em_states. move => *. - admit. (* smt (@W64). *) + rewrite !to_uint_shl; first 2 by smt(@W64). + split; first by smt(@W64). + rewrite to_uintD_small; first by smt(@W64). + rewrite -H5. + rewrite (_: to_uint ((of_int 8)%W64 * j{2}) = 8 * to_uint j{2}); first by smt(@W64). + rewrite H2; first by smt(@W64). + rewrite of_uintK. auto => />. + by smt(@W64 jagged_bound). qed. equiv modcorrect : @@ -1059,7 +1048,7 @@ equiv modcorrect : disj_ptr (to_uint iotas{2}) 800 (to_uint out{2}) (to_uint outlen{2}) /\ disj_ptr (to_uint rhotates_left{2}) 200 (to_uint out{2}) (to_uint outlen{2}) /\ disj_ptr (to_uint rhotates_right{2}) 200 (to_uint out{2}) (to_uint outlen{2}) /\ - to_uint rate{2} <= 200 /\ + to_uint rate{2} < 200 /\ to_uint a_jagged{2} + 200 < W64.modulus /\ to_uint in_0{1} + to_uint inlen{1} < W64.modulus /\ to_uint rhotates_left{2} + 192 < W64.modulus /\ @@ -1136,5 +1125,5 @@ proof. split; 1: smt (W64.ultE). move=> ? [o l] /> ?;rewrite !W64.ultE => *. rewrite W64.to_uint_eq W64.to_uintB 1:uleE 1://; smt(W64.to_uint_cmp). - skip => /> &1 &2 *; smt(W64.ultE). + skip => /> &1 &2 *. smt(W64.ultE). qed. From e8e8be6532e3e62a2dd2df22a9528d9ade6a7f50 Mon Sep 17 00:00:00 2001 From: Manuel Barbosa Date: Fri, 16 Aug 2019 23:45:50 +0100 Subject: [PATCH 453/525] Fixing unstable smts --- proof/impl/libc/keccak_1600_avx2_modular.ec | 62 ++++++++++++++++++++- 1 file changed, 60 insertions(+), 2 deletions(-) diff --git a/proof/impl/libc/keccak_1600_avx2_modular.ec b/proof/impl/libc/keccak_1600_avx2_modular.ec index 4d617c8..a4cee83 100644 --- a/proof/impl/libc/keccak_1600_avx2_modular.ec +++ b/proof/impl/libc/keccak_1600_avx2_modular.ec @@ -882,7 +882,13 @@ proof. + move=> k hk1 hk2. rewrite Array28.initiE; 1: by apply jagged_bound. rewrite heq4 get64_set8; 1,2: smt(W64.to_uint_cmp jagged_bound). - admit. (* smt (@W64 jagged_bound jagged_inj). *) + rewrite (_: 8 * A_jagged.[k] <= + 8 * A_jagged.[(to_uint rate{2} - 1) %/ 8] + (to_uint rate{2} - 1) %% 8 < + 8 * A_jagged.[k] + 8 = false) //=; first by smt(@W64 jagged_bound jagged_inj). + rewrite Array28.initiE; 1: by apply jagged_bound. + rewrite get64_set8; 1,2: smt(W64.to_uint_cmp jagged_bound). + case (8 * A_jagged.[k] <= to_uint l_R < 8 * A_jagged.[k] + 8) => [ht | hf]; first by smt(@W64 jagged_bound jagged_inj). + by apply (H11 k); smt (@W64 jagged_bound jagged_inj). move=> k hk1 hk2. have -> : to_uint (rate{2} - W64.one) = to_uint rate{2} - 1. + rewrite W64.to_uintB 1:uleE /=; smt(W64.to_uint_cmp). @@ -891,7 +897,59 @@ proof. rewrite Array25.initiE 1:// get64_set8_200. + smt(W64.to_uint_cmp). + done. - admit. (* smt (@W64 jagged_bound jagged_inj). *) + case (k < to_uint inlen{2} %/ 8 + 1 \/ k = (to_uint rate{2} - 1) %/ 8) => [ht | hf]. + + case (k = (to_uint rate{2} - 1) %/ 8) => [hht | hhf]. + rewrite (_: 8 * k <= to_uint rate{2} - 1 < 8 * k + 8 = true); first + by smt (@W64 jagged_bound jagged_inj). + rewrite (_: 8 * A_jagged.[k] <= + 8 * A_jagged.[(to_uint rate{2} - 1) %/ 8] + (to_uint rate{2} - 1) %% 8 < + 8 * A_jagged.[k] + 8 = true); first by smt (@W64 jagged_bound jagged_inj). + simplify. + rewrite (_: state0.[k] = state{1}.[k] `^` s_state{2}.[A_jagged.[k]]). + rewrite H7; first by smt (@W64 jagged_bound jagged_inj). + case (k < to_uint inlen{2} %/ 8); first by smt (@W64 jagged_bound jagged_inj). + rewrite (_ : s_state{2}.[A_jagged.[k]] = W64.zero); first + by move : (H2 k); smt (@W64 jagged_bound jagged_inj). + by smt (@W64 jagged_bound jagged_inj). + rewrite (_: + state{1}.[k] `^` s_state{2}.[A_jagged.[k]] = + pack8_t + ((init + (fun (j : int) => + (((init + (get64 (((init64 ("_.[_]" state{1})))%WArray224))))%Array28.[k] + `^` + ((init + (get64 (((init64 ("_.[_]" s_state{2})))%WArray224))))%Array28.[A_jagged.[k]] + ) \bits8 j)))%W8u8.Pack). admit. + admit. + rewrite (_: 8 * k <= to_uint rate{2} - 1 < 8 * k + 8 = false); first + by smt (@W64 jagged_bound jagged_inj). + rewrite (_: 8 * A_jagged.[k] <= + 8 * A_jagged.[(to_uint rate{2} - 1) %/ 8] + (to_uint rate{2} - 1) %% 8 < + 8 * A_jagged.[k] + 8 = false); first by smt (@W64 jagged_bound jagged_inj). + simplify. + rewrite (_: state0.[k] = state_L.[k] `^` s_state_R.[A_jagged.[k]]). + rewrite H16; first by smt (@W64 jagged_bound jagged_inj). + case (k < to_uint inlen{2} %/ 8 + 1); last by smt (@W64 jagged_bound jagged_inj). + rewrite (_: state0.[k] `^` s_state_R.[A_jagged.[k]] `^` s_state_R.[A_jagged.[k]] = + state0.[k] `^` (s_state_R.[A_jagged.[k]] `^` s_state_R.[A_jagged.[k]])); + first by admit. + by smt (@W64 jagged_bound jagged_inj). + rewrite !initiE; first 2 by smt (@W64 jagged_bound jagged_inj). + rewrite get64_set8_200; first 2 by smt(W64.to_uint_cmp jagged_bound). + rewrite get64_set8; first 2 by smt(W64.to_uint_cmp jagged_bound). + case (8 * k <= to_uint j_R < 8 * k + 8) => [hhht | hhhf]. + rewrite (_:8 * A_jagged.[k] <= to_uint l_R < 8 * A_jagged.[k] + 8 = true); + first by smt (@W64 jagged_bound jagged_inj). + simplify. + admit. + + rewrite (_: 8 * k <= to_uint rate{2} - 1 < 8 * k + 8 = false); first + by smt (@W64 jagged_bound jagged_inj). + simplify. + rewrite initiE; first by smt(). + rewrite get64_set8_200; first 2 by smt(W64.to_uint_cmp jagged_bound). + by smt(W64.to_uint_cmp jagged_bound). qed. require import Keccak_f1600_scalar_table. From 687e1f229fde797f0c113c2aa2149ba0475770ca Mon Sep 17 00:00:00 2001 From: Manuel Barbosa Date: Sat, 17 Aug 2019 00:26:12 +0100 Subject: [PATCH 454/525] Fixing unstable smts --- proof/impl/libc/keccak_1600_avx2_modular.ec | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/proof/impl/libc/keccak_1600_avx2_modular.ec b/proof/impl/libc/keccak_1600_avx2_modular.ec index a4cee83..30fff56 100644 --- a/proof/impl/libc/keccak_1600_avx2_modular.ec +++ b/proof/impl/libc/keccak_1600_avx2_modular.ec @@ -921,7 +921,12 @@ proof. `^` ((init (get64 (((init64 ("_.[_]" s_state{2})))%WArray224))))%Array28.[A_jagged.[k]] - ) \bits8 j)))%W8u8.Pack). admit. + ) \bits8 j)))%W8u8.Pack). + apply W8u8.wordP => i hi. + rewrite W8u8.pack8bE; first by smt (@W64 jagged_bound jagged_inj). + rewrite !initiE; first 3 by smt (@W64 jagged_bound jagged_inj). + auto => />. admit. + rewrite xorb8u8E. admit. rewrite (_: 8 * k <= to_uint rate{2} - 1 < 8 * k + 8 = false); first by smt (@W64 jagged_bound jagged_inj). @@ -934,7 +939,7 @@ proof. case (k < to_uint inlen{2} %/ 8 + 1); last by smt (@W64 jagged_bound jagged_inj). rewrite (_: state0.[k] `^` s_state_R.[A_jagged.[k]] `^` s_state_R.[A_jagged.[k]] = state0.[k] `^` (s_state_R.[A_jagged.[k]] `^` s_state_R.[A_jagged.[k]])); - first by admit. + first by rewrite -(W64.xorwA). by smt (@W64 jagged_bound jagged_inj). rewrite !initiE; first 2 by smt (@W64 jagged_bound jagged_inj). rewrite get64_set8_200; first 2 by smt(W64.to_uint_cmp jagged_bound). From fc89a58f7f5d44a3a4c78351c38db4df0e97eb7d Mon Sep 17 00:00:00 2001 From: Manuel Barbosa Date: Sat, 17 Aug 2019 16:25:56 +0100 Subject: [PATCH 455/525] Progressing --- proof/impl/libc/keccak_1600_avx2_modular.ec | 70 +++++++++++++-------- 1 file changed, 44 insertions(+), 26 deletions(-) diff --git a/proof/impl/libc/keccak_1600_avx2_modular.ec b/proof/impl/libc/keccak_1600_avx2_modular.ec index 30fff56..cfeaf7a 100644 --- a/proof/impl/libc/keccak_1600_avx2_modular.ec +++ b/proof/impl/libc/keccak_1600_avx2_modular.ec @@ -589,6 +589,10 @@ proof. by have := H2 24; rewrite /A_jagged /= => ->. qed. +(* probably should be Jasmin semantics lemmas *) +lemma aux (v : W64.t): pack8_t ((init (fun (j : int) => v \bits8 j)))%W8u8.Pack = v + by move => *; rewrite (_: v = pack8_t (unpack8 v)); [apply W8u8.unpack8K | congr]. + equiv add_full_block_corr rr : Keccak_1600_ref_modular.Mmod.add_full_block ~ Mmod.add_full_block : to_uint rate{2} < 200 /\ to_uint a_jagged{2} + 200 < W64.modulus /\ to_uint in_0{2} + to_uint inlen{2} < W64.modulus /\ @@ -905,29 +909,29 @@ proof. 8 * A_jagged.[(to_uint rate{2} - 1) %/ 8] + (to_uint rate{2} - 1) %% 8 < 8 * A_jagged.[k] + 8 = true); first by smt (@W64 jagged_bound jagged_inj). simplify. - rewrite (_: state0.[k] = state{1}.[k] `^` s_state{2}.[A_jagged.[k]]). - rewrite H7; first by smt (@W64 jagged_bound jagged_inj). - case (k < to_uint inlen{2} %/ 8); first by smt (@W64 jagged_bound jagged_inj). - rewrite (_ : s_state{2}.[A_jagged.[k]] = W64.zero); first - by move : (H2 k); smt (@W64 jagged_bound jagged_inj). - by smt (@W64 jagged_bound jagged_inj). + rewrite (_: state0.[k] = state_L.[k] `^` s_state_R.[A_jagged.[k]]). + rewrite H16; first by smt (@W64 jagged_bound jagged_inj). + case (k < to_uint inlen{2} %/ 8 + 1) => [hhhht | hhhhf]. + rewrite -(W64.xorwA); smt (@W64 jagged_bound jagged_inj). + rewrite (_ : s_state_R.[A_jagged.[k]] = W64.zero). + by apply (H11 k); smt (@W64 jagged_bound jagged_inj). + by smt (@W64 jagged_bound jagged_inj). rewrite (_: - state{1}.[k] `^` s_state{2}.[A_jagged.[k]] = + state_L.[k] `^` s_state_R.[A_jagged.[k]] = pack8_t ((init (fun (j : int) => - (((init - (get64 (((init64 ("_.[_]" state{1})))%WArray224))))%Array28.[k] - `^` - ((init - (get64 (((init64 ("_.[_]" s_state{2})))%WArray224))))%Array28.[A_jagged.[k]] - ) \bits8 j)))%W8u8.Pack). - apply W8u8.wordP => i hi. - rewrite W8u8.pack8bE; first by smt (@W64 jagged_bound jagged_inj). - rewrite !initiE; first 3 by smt (@W64 jagged_bound jagged_inj). - auto => />. admit. + (state_L.[k] `^` s_state_R.[A_jagged.[k]]) \bits8 j)))%W8u8.Pack). + apply W8u8.wordP => i hi. + rewrite (_: + (pack8_t + ((init + (fun (j : int) => state_L.[k] `^` + s_state_R.[A_jagged.[k]] \bits8 j)))%W8u8.Pack \bits8 i) = + state_L.[k] `^` s_state_R.[A_jagged.[k]] \bits8 i); last by congr. + by rewrite aux. rewrite xorb8u8E. - admit. + congr. rewrite map2E. admit. rewrite (_: 8 * k <= to_uint rate{2} - 1 < 8 * k + 8 = false); first by smt (@W64 jagged_bound jagged_inj). rewrite (_: 8 * A_jagged.[k] <= @@ -936,20 +940,34 @@ proof. simplify. rewrite (_: state0.[k] = state_L.[k] `^` s_state_R.[A_jagged.[k]]). rewrite H16; first by smt (@W64 jagged_bound jagged_inj). - case (k < to_uint inlen{2} %/ 8 + 1); last by smt (@W64 jagged_bound jagged_inj). - rewrite (_: state0.[k] `^` s_state_R.[A_jagged.[k]] `^` s_state_R.[A_jagged.[k]] = - state0.[k] `^` (s_state_R.[A_jagged.[k]] `^` s_state_R.[A_jagged.[k]])); - first by rewrite -(W64.xorwA). - by smt (@W64 jagged_bound jagged_inj). + case (k < to_uint inlen{2} %/ 8 + 1); last by smt (@W64 jagged_bound jagged_inj). + by rewrite -(W64.xorwA); smt (@W64 jagged_bound jagged_inj). rewrite !initiE; first 2 by smt (@W64 jagged_bound jagged_inj). rewrite get64_set8_200; first 2 by smt(W64.to_uint_cmp jagged_bound). rewrite get64_set8; first 2 by smt(W64.to_uint_cmp jagged_bound). + rewrite (_: + state_L.[k] `^` s_state_R.[A_jagged.[k]] = + pack8_t + ((init + (fun (j : int) => + (state_L.[k] `^` s_state_R.[A_jagged.[k]]) \bits8 j)))%W8u8.Pack). + apply W8u8.wordP => i hi. + rewrite (_: + (pack8_t + ((init + (fun (j : int) => state_L.[k] `^` + s_state_R.[A_jagged.[k]] \bits8 j)))%W8u8.Pack \bits8 i) = + state_L.[k] `^` s_state_R.[A_jagged.[k]] \bits8 i); last by congr. + by rewrite aux. case (8 * k <= to_uint j_R < 8 * k + 8) => [hhht | hhhf]. rewrite (_:8 * A_jagged.[k] <= to_uint l_R < 8 * A_jagged.[k] + 8 = true); first by smt (@W64 jagged_bound jagged_inj). - simplify. - admit. - + rewrite (_: 8 * k <= to_uint rate{2} - 1 < 8 * k + 8 = false); first + simplify. admit. + rewrite (_:8 * A_jagged.[k] <= to_uint l_R < 8 * A_jagged.[k] + 8 = false); + first by smt (@W64 jagged_bound jagged_inj). + simplify. rewrite (aux (state_L.[k] `^` s_state_R.[A_jagged.[k]])). + rewrite -(W64.xorwA); smt (@W64 jagged_bound jagged_inj). + rewrite (_: 8 * k <= to_uint rate{2} - 1 < 8 * k + 8 = false); first by smt (@W64 jagged_bound jagged_inj). simplify. rewrite initiE; first by smt(). From 8c82004713c054edc83b211adb4dcb06a4315a73 Mon Sep 17 00:00:00 2001 From: Manuel Barbosa Date: Sat, 17 Aug 2019 19:42:52 +0100 Subject: [PATCH 456/525] Progressing --- proof/impl/libc/keccak_1600_avx2_modular.ec | 115 ++++++++++++++++++-- 1 file changed, 105 insertions(+), 10 deletions(-) diff --git a/proof/impl/libc/keccak_1600_avx2_modular.ec b/proof/impl/libc/keccak_1600_avx2_modular.ec index cfeaf7a..edccebc 100644 --- a/proof/impl/libc/keccak_1600_avx2_modular.ec +++ b/proof/impl/libc/keccak_1600_avx2_modular.ec @@ -706,7 +706,7 @@ equiv add_final_block_corr : to_uint a_jagged{2} + 200 < W64.modulus /\ to_uint in_0{2} + to_uint inlen{2} < W64.modulus /\ good_jag Glob.mem{2} (to_uint a_jagged{2}) /\ - ={Glob.mem} /\ em_states state{2} state{1} /\ ={in_0,inlen} /\ to_uint inlen{2} < to_uint rate{2} /\ r8{1} = rate{2} + ={Glob.mem, trail_byte} /\ em_states state{2} state{1} /\ ={in_0,inlen} /\ to_uint inlen{2} < to_uint rate{2} /\ r8{1} = rate{2} ==> em_states res{2} res{1}. proof. @@ -716,7 +716,7 @@ proof. ( to_uint rate{2} < 200 /\ to_uint a_jagged{2} + 200 < W64.modulus /\ to_uint in_0{2} + to_uint inlen{2} < W64.modulus /\ jagged_zeros_W64 s_state{2} (to_uint inlen{2} %/8) /\ good_jag Glob.mem{2} (to_uint a_jagged{2}) /\ - (em_states state{2} state0) /\ ={Glob.mem, in_0, inlen} /\ to_uint inlen{2} < to_uint rate{2} /\ r8{1} = rate{2} /\ + (em_states state{2} state0) /\ ={Glob.mem, trail_byte, in_0, inlen} /\ to_uint inlen{2} < to_uint rate{2} /\ r8{1} = rate{2} /\ i{1} = j{2} /\ to_uint j{2} = to_uint inlen{2} %/ 8 /\ forall k, 0 <= k < 25 => state{1}.[k] = if k < to_uint inlen{2} %/ 8 then state0.[k] `^` s_state{2}.[A_jagged.[k]] @@ -725,7 +725,7 @@ proof. to_uint rate{2} < 200 /\ to_uint a_jagged{2} + 200 < W64.modulus /\ to_uint in_0{2} + to_uint inlen{2} < W64.modulus /\ jagged_zeros_W64 s_state{2} (to_uint inlen{2} %/8) /\ good_jag Glob.mem{2} (to_uint a_jagged{2}) /\ - (em_states state{2} state0) /\ ={Glob.mem, in_0, inlen, inlen8} /\ i{1} = j{2} /\ to_uint inlen{2} < to_uint rate{2} /\ r8{1} = rate{2} /\ + (em_states state{2} state0) /\ ={Glob.mem, trail_byte, in_0, inlen, inlen8} /\ i{1} = j{2} /\ to_uint inlen{2} < to_uint rate{2} /\ r8{1} = rate{2} /\ to_uint inlen8{2} = to_uint inlen{2} %/ 8 /\ to_uint i{1} <= to_uint inlen8{2} /\ forall k, 0 <= k < 25 => state{1}.[k] = if k < to_uint j{2} then state0.[k] `^` s_state{2}.[A_jagged.[k]] @@ -784,7 +784,7 @@ proof. jagged_zeros_W64 s_state{2} (to_uint inlen{2} %/8 + 1) /\ (forall k, to_uint l{2} <= k < 8 * A_jagged.[to_uint inlen{2} %/ 8] + 8 => s_state{2}.[k %/ 8] \bits8 (k %% 8) = W8.zero) /\ - ={Glob.mem, in_0, inlen} /\ + ={Glob.mem, trail_byte, in_0, inlen} /\ to_uint inlen{2} < to_uint rate{2} /\ i{1} = j{2} /\ to_uint l{2} = 8 * A_jagged.[to_uint inlen{2} %/ 8] + (to_uint j{2} - 8 * (to_uint inlen{2} %/ 8)) /\ @@ -959,14 +959,109 @@ proof. s_state_R.[A_jagged.[k]] \bits8 j)))%W8u8.Pack \bits8 i) = state_L.[k] `^` s_state_R.[A_jagged.[k]] \bits8 i); last by congr. by rewrite aux. - case (8 * k <= to_uint j_R < 8 * k + 8) => [hhht | hhhf]. - rewrite (_:8 * A_jagged.[k] <= to_uint l_R < 8 * A_jagged.[k] + 8 = true); + case (k < to_uint inlen{2} %/ 8) => [kht | khf]. + rewrite (_: 8 * k <= to_uint j_R < 8 * k + 8 = false); first by smt (@W64 jagged_bound jagged_inj). + rewrite (_: 8 * A_jagged.[k] <= to_uint l_R < 8 * A_jagged.[k] + 8 = false); first by smt (@W64 jagged_bound jagged_inj). simplify. admit. + rewrite (_: k = to_uint inlen{2} %/ 8); first by smt(). + rewrite (_:8 * (to_uint inlen{2} %/ 8) <= to_uint j_R < + 8 * (to_uint inlen{2} %/ 8) + 8 = true); first by smt (@W64 jagged_bound jagged_inj). + rewrite (_: 8* A_jagged.[to_uint inlen{2} %/ 8] <= to_uint l_R < + 8 * A_jagged.[to_uint inlen{2} %/ 8] + 8 = true); first by smt (@W64 jagged_bound jagged_inj). simplify. admit. - rewrite (_:8 * A_jagged.[k] <= to_uint l_R < 8 * A_jagged.[k] + 8 = false); - first by smt (@W64 jagged_bound jagged_inj). - simplify. rewrite (aux (state_L.[k] `^` s_state_R.[A_jagged.[k]])). - rewrite -(W64.xorwA); smt (@W64 jagged_bound jagged_inj). + (***** + rewrite (_: to_uint l_R %% 8 = to_uint j_R %% 8); first by smt (@W64 jagged_bound jagged_inj). + apply W8u8.wordP => i hi. + case (i = 0) => />. + rewrite /get8 bits8E. + case (0 = to_uint j_R %% 8) => [hhhhht | hhhhhtf]. + congr. + move : (H12 (to_uint l_R)) => hzero. + rewrite (_: (s_state_R.[A_jagged.[to_uint inlen{2} %/8]] \bits8 0) = W8.zero). + apply hzero. + rewrite (_: (init (fun (j : int) => state_L.[to_uint j_R %/ 8].[0 * 8 + j]))%W8 `^` W8.zero `^` trail_byte{2} = (init (fun (j : int) => state_L.[to_uint j_R %/ 8].[0 * 8 + j]))%W8 `^` trail_byte{2}). + rewrite -W8.xorwA; smt (@W8 @W64 jagged_bound jagged_inj). + congr. rewrite /init64 WArray200.WArray200.initiE; first by smt(). auto => />. rewrite bits8E. smt(@W8). + by rewrite -W8.xorwA W8.xorwK; smt(@W8). + case (i = 1) => />. + rewrite /get8 bits8E. + move : (H12 (to_uint j_R) aa). + case (1 = to_uint j_R %% 8) => [hhhhht | hhhhhtf]. + move => *. + rewrite (_: (s_state_R.[A_jagged.[to_uint j_R %/8]] \bits8 1) = W8.zero). + smt (@W8 @W64 jagged_bound jagged_inj). + rewrite (_: (init (fun (j : int) => state_L.[to_uint j_R %/ 8].[1 * 8 + j]))%W8 `^` W8.zero `^` trail_byte{2} = (init (fun (j : int) => state_L.[to_uint j_R %/ 8].[1 * 8 + j]))%W8 `^` trail_byte{2}). + rewrite -W8.xorwA; smt (@W8 @W64 jagged_bound jagged_inj). + congr. rewrite /init64 WArray200.WArray200.initiE; first by smt(). auto => />. rewrite bits8E. smt(@W8). + by rewrite -W8.xorwA W8.xorwK; smt(@W8). + case (i = 2) => />. + rewrite /get8 bits8E. + move : (H12 (to_uint j_R) aa). + case (2 = to_uint j_R %% 8) => [hhhhht | hhhhhtf]. + move => *. + rewrite (_: (s_state_R.[A_jagged.[to_uint j_R %/8]] \bits8 2) = W8.zero). + smt (@W8 @W64 jagged_bound jagged_inj). + rewrite (_: (init (fun (j : int) => state_L.[to_uint j_R %/ 8].[2 * 8 + j]))%W8 `^` W8.zero `^` trail_byte{2} = (init (fun (j : int) => state_L.[to_uint j_R %/ 8].[2 * 8 + j]))%W8 `^` trail_byte{2}). + rewrite -W8.xorwA; smt (@W8 @W64 jagged_bound jagged_inj). + congr. rewrite /init64 WArray200.WArray200.initiE; first by smt(). auto => />. rewrite bits8E. smt(@W8). + by rewrite -W8.xorwA W8.xorwK; smt(@W8). + case (i = 3) => />. + rewrite /get8 bits8E. + move : (H12 (to_uint j_R) aa). + case (3 = to_uint j_R %% 8) => [hhhhht | hhhhhtf]. + move => *. + rewrite (_: (s_state_R.[A_jagged.[to_uint j_R %/8]] \bits8 3) = W8.zero). + smt (@W8 @W64 jagged_bound jagged_inj). + rewrite (_: (init (fun (j : int) => state_L.[to_uint j_R %/ 8].[3 * 8 + j]))%W8 `^` W8.zero `^` trail_byte{2} = (init (fun (j : int) => state_L.[to_uint j_R %/ 8].[3 * 8 + j]))%W8 `^` trail_byte{2}). + rewrite -W8.xorwA; smt (@W8 @W64 jagged_bound jagged_inj). + congr. rewrite /init64 WArray200.WArray200.initiE; first by smt(). auto => />. rewrite bits8E. smt(@W8). + by rewrite -W8.xorwA W8.xorwK; smt(@W8). + case (i = 4) => />. + rewrite /get8 bits8E. + move : (H12 (to_uint j_R) aa). + case (4 = to_uint j_R %% 8) => [hhhhht | hhhhhtf]. + move => *. + rewrite (_: (s_state_R.[A_jagged.[to_uint j_R %/8]] \bits8 4) = W8.zero). + smt (@W8 @W64 jagged_bound jagged_inj). + rewrite (_: (init (fun (j : int) => state_L.[to_uint j_R %/ 8].[4 * 8 + j]))%W8 `^` W8.zero `^` trail_byte{2} = (init (fun (j : int) => state_L.[to_uint j_R %/ 8].[4 * 8 + j]))%W8 `^` trail_byte{2}). + rewrite -W8.xorwA; smt (@W8 @W64 jagged_bound jagged_inj). + congr. rewrite /init64 WArray200.WArray200.initiE; first by smt(). auto => />. rewrite bits8E. smt(@W8). + by rewrite -W8.xorwA W8.xorwK; smt(@W8). + case (i = 5) => />. + rewrite /get8 bits8E. + move : (H12 (to_uint j_R) aa). + case (5 = to_uint j_R %% 8) => [hhhhht | hhhhhtf]. + move => *. + rewrite (_: (s_state_R.[A_jagged.[to_uint j_R %/8]] \bits8 5) = W8.zero). + smt (@W8 @W64 jagged_bound jagged_inj). + rewrite (_: (init (fun (j : int) => state_L.[to_uint j_R %/ 8].[5 * 8 + j]))%W8 `^` W8.zero `^` trail_byte{2} = (init (fun (j : int) => state_L.[to_uint j_R %/ 8].[5 * 8 + j]))%W8 `^` trail_byte{2}). + rewrite -W8.xorwA; smt (@W8 @W64 jagged_bound jagged_inj). + congr. rewrite /init64 WArray200.WArray200.initiE; first by smt(). auto => />. rewrite bits8E. smt(@W8). + by rewrite -W8.xorwA W8.xorwK; smt(@W8). + case (i = 6) => />. + rewrite /get8 bits8E. + move : (H12 (to_uint j_R) aa). + case (6 = to_uint j_R %% 8) => [hhhhht | hhhhhtf]. + move => *. + rewrite (_: (s_state_R.[A_jagged.[to_uint j_R %/8]] \bits8 6) = W8.zero). + smt (@W8 @W64 jagged_bound jagged_inj). + rewrite (_: (init (fun (j : int) => state_L.[to_uint j_R %/ 8].[6 * 8 + j]))%W8 `^` W8.zero `^` trail_byte{2} = (init (fun (j : int) => state_L.[to_uint j_R %/ 8].[6 * 8 + j]))%W8 `^` trail_byte{2}). + rewrite -W8.xorwA; smt (@W8 @W64 jagged_bound jagged_inj). + congr. rewrite /init64 WArray200.WArray200.initiE; first by smt(). auto => />. rewrite bits8E. smt(@W8). + by rewrite -W8.xorwA W8.xorwK; smt(@W8). + case (i = 7) => />. + rewrite /get8 bits8E. + move : (H12 (to_uint j_R) aa). + case (7 = to_uint j_R %% 8) => [hhhhht | hhhhhtf]. + move => *. + rewrite (_: (s_state_R.[A_jagged.[to_uint j_R %/8]] \bits8 7) = W8.zero). + smt (@W8 @W64 jagged_bound jagged_inj). + rewrite (_: (init (fun (j : int) => state_L.[to_uint j_R %/ 8].[7 * 8 + j]))%W8 `^` W8.zero `^` trail_byte{2} = (init (fun (j : int) => state_L.[to_uint j_R %/ 8].[7 * 8 + j]))%W8 `^` trail_byte{2}). + rewrite -W8.xorwA; smt (@W8 @W64 jagged_bound jagged_inj). + congr. rewrite /init64 WArray200.WArray200.initiE; first by smt(). auto => />. rewrite bits8E. smt(@W8). + by rewrite -W8.xorwA W8.xorwK; smt(@W8). + by smt(). +****) rewrite (_: 8 * k <= to_uint rate{2} - 1 < 8 * k + 8 = false); first by smt (@W64 jagged_bound jagged_inj). simplify. From 00de4261798fa0d6c1f21e14e39076231cfa5ac7 Mon Sep 17 00:00:00 2001 From: Manuel Barbosa Date: Sat, 17 Aug 2019 20:00:45 +0100 Subject: [PATCH 457/525] Progressing --- proof/impl/libc/keccak_1600_avx2_modular.ec | 102 +++----------------- 1 file changed, 13 insertions(+), 89 deletions(-) diff --git a/proof/impl/libc/keccak_1600_avx2_modular.ec b/proof/impl/libc/keccak_1600_avx2_modular.ec index edccebc..ec6200b 100644 --- a/proof/impl/libc/keccak_1600_avx2_modular.ec +++ b/proof/impl/libc/keccak_1600_avx2_modular.ec @@ -968,100 +968,24 @@ proof. rewrite (_: 8* A_jagged.[to_uint inlen{2} %/ 8] <= to_uint l_R < 8 * A_jagged.[to_uint inlen{2} %/ 8] + 8 = true); first by smt (@W64 jagged_bound jagged_inj). - simplify. admit. - (***** - rewrite (_: to_uint l_R %% 8 = to_uint j_R %% 8); first by smt (@W64 jagged_bound jagged_inj). + simplify. + (******) apply W8u8.wordP => i hi. case (i = 0) => />. rewrite /get8 bits8E. case (0 = to_uint j_R %% 8) => [hhhhht | hhhhhtf]. - congr. - move : (H12 (to_uint l_R)) => hzero. - rewrite (_: (s_state_R.[A_jagged.[to_uint inlen{2} %/8]] \bits8 0) = W8.zero). - apply hzero. - rewrite (_: (init (fun (j : int) => state_L.[to_uint j_R %/ 8].[0 * 8 + j]))%W8 `^` W8.zero `^` trail_byte{2} = (init (fun (j : int) => state_L.[to_uint j_R %/ 8].[0 * 8 + j]))%W8 `^` trail_byte{2}). - rewrite -W8.xorwA; smt (@W8 @W64 jagged_bound jagged_inj). - congr. rewrite /init64 WArray200.WArray200.initiE; first by smt(). auto => />. rewrite bits8E. smt(@W8). + rewrite (_:to_uint l_R %% 8 = 0); first by smt (@W64 jagged_bound jagged_inj). + simplify. congr. rewrite (_: A_jagged.[to_uint inlen{2} %/ 8] = to_uint l_R %/8). rewrite H13. + rewrite (_: to_uint j_R = 8 * to_uint inlen{2} %/ 8); first by smt(). by smt(). + move : (H12 (to_uint l_R)). + rewrite (_:to_uint l_R %% 8 = 0); first by smt (@W64 jagged_bound jagged_inj). + move => *. rewrite H17. + by smt (@W8 @W64 jagged_bound jagged_inj). + rewrite /init64 WArray200.WArray200.initiE; first by smt(). auto => />. rewrite bits8E. smt(@W8). + rewrite (_:(0 = to_uint l_R %% 8) = false); first by smt (@W64 jagged_bound jagged_inj). simplify. by rewrite -W8.xorwA W8.xorwK; smt(@W8). - case (i = 1) => />. - rewrite /get8 bits8E. - move : (H12 (to_uint j_R) aa). - case (1 = to_uint j_R %% 8) => [hhhhht | hhhhhtf]. - move => *. - rewrite (_: (s_state_R.[A_jagged.[to_uint j_R %/8]] \bits8 1) = W8.zero). - smt (@W8 @W64 jagged_bound jagged_inj). - rewrite (_: (init (fun (j : int) => state_L.[to_uint j_R %/ 8].[1 * 8 + j]))%W8 `^` W8.zero `^` trail_byte{2} = (init (fun (j : int) => state_L.[to_uint j_R %/ 8].[1 * 8 + j]))%W8 `^` trail_byte{2}). - rewrite -W8.xorwA; smt (@W8 @W64 jagged_bound jagged_inj). - congr. rewrite /init64 WArray200.WArray200.initiE; first by smt(). auto => />. rewrite bits8E. smt(@W8). - by rewrite -W8.xorwA W8.xorwK; smt(@W8). - case (i = 2) => />. - rewrite /get8 bits8E. - move : (H12 (to_uint j_R) aa). - case (2 = to_uint j_R %% 8) => [hhhhht | hhhhhtf]. - move => *. - rewrite (_: (s_state_R.[A_jagged.[to_uint j_R %/8]] \bits8 2) = W8.zero). - smt (@W8 @W64 jagged_bound jagged_inj). - rewrite (_: (init (fun (j : int) => state_L.[to_uint j_R %/ 8].[2 * 8 + j]))%W8 `^` W8.zero `^` trail_byte{2} = (init (fun (j : int) => state_L.[to_uint j_R %/ 8].[2 * 8 + j]))%W8 `^` trail_byte{2}). - rewrite -W8.xorwA; smt (@W8 @W64 jagged_bound jagged_inj). - congr. rewrite /init64 WArray200.WArray200.initiE; first by smt(). auto => />. rewrite bits8E. smt(@W8). - by rewrite -W8.xorwA W8.xorwK; smt(@W8). - case (i = 3) => />. - rewrite /get8 bits8E. - move : (H12 (to_uint j_R) aa). - case (3 = to_uint j_R %% 8) => [hhhhht | hhhhhtf]. - move => *. - rewrite (_: (s_state_R.[A_jagged.[to_uint j_R %/8]] \bits8 3) = W8.zero). - smt (@W8 @W64 jagged_bound jagged_inj). - rewrite (_: (init (fun (j : int) => state_L.[to_uint j_R %/ 8].[3 * 8 + j]))%W8 `^` W8.zero `^` trail_byte{2} = (init (fun (j : int) => state_L.[to_uint j_R %/ 8].[3 * 8 + j]))%W8 `^` trail_byte{2}). - rewrite -W8.xorwA; smt (@W8 @W64 jagged_bound jagged_inj). - congr. rewrite /init64 WArray200.WArray200.initiE; first by smt(). auto => />. rewrite bits8E. smt(@W8). - by rewrite -W8.xorwA W8.xorwK; smt(@W8). - case (i = 4) => />. - rewrite /get8 bits8E. - move : (H12 (to_uint j_R) aa). - case (4 = to_uint j_R %% 8) => [hhhhht | hhhhhtf]. - move => *. - rewrite (_: (s_state_R.[A_jagged.[to_uint j_R %/8]] \bits8 4) = W8.zero). - smt (@W8 @W64 jagged_bound jagged_inj). - rewrite (_: (init (fun (j : int) => state_L.[to_uint j_R %/ 8].[4 * 8 + j]))%W8 `^` W8.zero `^` trail_byte{2} = (init (fun (j : int) => state_L.[to_uint j_R %/ 8].[4 * 8 + j]))%W8 `^` trail_byte{2}). - rewrite -W8.xorwA; smt (@W8 @W64 jagged_bound jagged_inj). - congr. rewrite /init64 WArray200.WArray200.initiE; first by smt(). auto => />. rewrite bits8E. smt(@W8). - by rewrite -W8.xorwA W8.xorwK; smt(@W8). - case (i = 5) => />. - rewrite /get8 bits8E. - move : (H12 (to_uint j_R) aa). - case (5 = to_uint j_R %% 8) => [hhhhht | hhhhhtf]. - move => *. - rewrite (_: (s_state_R.[A_jagged.[to_uint j_R %/8]] \bits8 5) = W8.zero). - smt (@W8 @W64 jagged_bound jagged_inj). - rewrite (_: (init (fun (j : int) => state_L.[to_uint j_R %/ 8].[5 * 8 + j]))%W8 `^` W8.zero `^` trail_byte{2} = (init (fun (j : int) => state_L.[to_uint j_R %/ 8].[5 * 8 + j]))%W8 `^` trail_byte{2}). - rewrite -W8.xorwA; smt (@W8 @W64 jagged_bound jagged_inj). - congr. rewrite /init64 WArray200.WArray200.initiE; first by smt(). auto => />. rewrite bits8E. smt(@W8). - by rewrite -W8.xorwA W8.xorwK; smt(@W8). - case (i = 6) => />. - rewrite /get8 bits8E. - move : (H12 (to_uint j_R) aa). - case (6 = to_uint j_R %% 8) => [hhhhht | hhhhhtf]. - move => *. - rewrite (_: (s_state_R.[A_jagged.[to_uint j_R %/8]] \bits8 6) = W8.zero). - smt (@W8 @W64 jagged_bound jagged_inj). - rewrite (_: (init (fun (j : int) => state_L.[to_uint j_R %/ 8].[6 * 8 + j]))%W8 `^` W8.zero `^` trail_byte{2} = (init (fun (j : int) => state_L.[to_uint j_R %/ 8].[6 * 8 + j]))%W8 `^` trail_byte{2}). - rewrite -W8.xorwA; smt (@W8 @W64 jagged_bound jagged_inj). - congr. rewrite /init64 WArray200.WArray200.initiE; first by smt(). auto => />. rewrite bits8E. smt(@W8). - by rewrite -W8.xorwA W8.xorwK; smt(@W8). - case (i = 7) => />. - rewrite /get8 bits8E. - move : (H12 (to_uint j_R) aa). - case (7 = to_uint j_R %% 8) => [hhhhht | hhhhhtf]. - move => *. - rewrite (_: (s_state_R.[A_jagged.[to_uint j_R %/8]] \bits8 7) = W8.zero). - smt (@W8 @W64 jagged_bound jagged_inj). - rewrite (_: (init (fun (j : int) => state_L.[to_uint j_R %/ 8].[7 * 8 + j]))%W8 `^` W8.zero `^` trail_byte{2} = (init (fun (j : int) => state_L.[to_uint j_R %/ 8].[7 * 8 + j]))%W8 `^` trail_byte{2}). - rewrite -W8.xorwA; smt (@W8 @W64 jagged_bound jagged_inj). - congr. rewrite /init64 WArray200.WArray200.initiE; first by smt(). auto => />. rewrite bits8E. smt(@W8). - by rewrite -W8.xorwA W8.xorwK; smt(@W8). - by smt(). -****) + admit. + (*****) rewrite (_: 8 * k <= to_uint rate{2} - 1 < 8 * k + 8 = false); first by smt (@W64 jagged_bound jagged_inj). simplify. From a43358a11ac6bdb3fc28473bd6d060a1af036b6b Mon Sep 17 00:00:00 2001 From: Manuel Barbosa Date: Sat, 17 Aug 2019 20:29:41 +0100 Subject: [PATCH 458/525] Progressing --- proof/impl/libc/keccak_1600_avx2_modular.ec | 108 +++++++++++++++++++- 1 file changed, 103 insertions(+), 5 deletions(-) diff --git a/proof/impl/libc/keccak_1600_avx2_modular.ec b/proof/impl/libc/keccak_1600_avx2_modular.ec index ec6200b..d39c1ab 100644 --- a/proof/impl/libc/keccak_1600_avx2_modular.ec +++ b/proof/impl/libc/keccak_1600_avx2_modular.ec @@ -931,7 +931,12 @@ proof. state_L.[k] `^` s_state_R.[A_jagged.[k]] \bits8 i); last by congr. by rewrite aux. rewrite xorb8u8E. - congr. rewrite map2E. admit. + apply W8u8.wordP => i hi. + rewrite map2E. simplify. + rewrite !W8u8.pack8bE; first 2 by smt(). + rewrite !initiE; first 4 by smt(@W64 jagged_bound jagged_inj). + by smt(@W64 jagged_bound jagged_inj). + auto => />. admit. rewrite (_: 8 * k <= to_uint rate{2} - 1 < 8 * k + 8 = false); first by smt (@W64 jagged_bound jagged_inj). rewrite (_: 8 * A_jagged.[k] <= @@ -961,7 +966,9 @@ proof. by rewrite aux. case (k < to_uint inlen{2} %/ 8) => [kht | khf]. rewrite (_: 8 * k <= to_uint j_R < 8 * k + 8 = false); first by smt (@W64 jagged_bound jagged_inj). - rewrite (_: 8 * A_jagged.[k] <= to_uint l_R < 8 * A_jagged.[k] + 8 = false); first by smt (@W64 jagged_bound jagged_inj). simplify. admit. + rewrite (_: 8 * A_jagged.[k] <= to_uint l_R < 8 * A_jagged.[k] + 8 = false); first by smt (@W64 jagged_bound jagged_inj). simplify. + rewrite (aux (state_L.[k] `^` s_state_R.[A_jagged.[k]])). + by rewrite -W64.xorwA; smt(@W64). rewrite (_: k = to_uint inlen{2} %/ 8); first by smt(). rewrite (_:8 * (to_uint inlen{2} %/ 8) <= to_uint j_R < 8 * (to_uint inlen{2} %/ 8) + 8 = true); first by smt (@W64 jagged_bound jagged_inj). @@ -984,7 +991,98 @@ proof. rewrite /init64 WArray200.WArray200.initiE; first by smt(). auto => />. rewrite bits8E. smt(@W8). rewrite (_:(0 = to_uint l_R %% 8) = false); first by smt (@W64 jagged_bound jagged_inj). simplify. by rewrite -W8.xorwA W8.xorwK; smt(@W8). - admit. + case (i = 1) => />. + rewrite /get8 bits8E. + case (1 = to_uint j_R %% 8) => [hhhhht | hhhhhtf]. + rewrite (_:to_uint l_R %% 8 = 1); first by smt (@W64 jagged_bound jagged_inj). + simplify. congr. rewrite (_: A_jagged.[to_uint inlen{2} %/ 8] = to_uint l_R %/8). rewrite H13. + rewrite (_: to_uint j_R = 8 * to_uint inlen{2} %/ 8); first by smt(). by smt(). + move : (H12 (to_uint l_R)). + rewrite (_:to_uint l_R %% 8 = 1); first by smt (@W64 jagged_bound jagged_inj). + move => *. rewrite H17. + by smt (@W8 @W64 jagged_bound jagged_inj). + rewrite /init64 WArray200.WArray200.initiE; first by smt(). auto => />. rewrite bits8E. smt(@W8). + rewrite (_:(1 = to_uint l_R %% 8) = false); first by smt (@W64 jagged_bound jagged_inj). simplify. + by rewrite -W8.xorwA W8.xorwK; smt(@W8). + case (i = 2) => />. + rewrite /get8 bits8E. + case (2 = to_uint j_R %% 8) => [hhhhht | hhhhhtf]. + rewrite (_:to_uint l_R %% 8 = 2); first by smt (@W64 jagged_bound jagged_inj). + simplify. congr. rewrite (_: A_jagged.[to_uint inlen{2} %/ 8] = to_uint l_R %/8). rewrite H13. + rewrite (_: to_uint j_R = 8 * to_uint inlen{2} %/ 8); first by smt(). by smt(). + move : (H12 (to_uint l_R)). + rewrite (_:to_uint l_R %% 8 = 2); first by smt (@W64 jagged_bound jagged_inj). + move => *. rewrite H17. + by smt (@W8 @W64 jagged_bound jagged_inj). + rewrite /init64 WArray200.WArray200.initiE; first by smt(). auto => />. rewrite bits8E. smt(@W8). + rewrite (_:(2 = to_uint l_R %% 8) = false); first by smt (@W64 jagged_bound jagged_inj). simplify. + by rewrite -W8.xorwA W8.xorwK; smt(@W8). + case (i = 3) => />. + rewrite /get8 bits8E. + case (3 = to_uint j_R %% 8) => [hhhhht | hhhhhtf]. + rewrite (_:to_uint l_R %% 8 = 3); first by smt (@W64 jagged_bound jagged_inj). + simplify. congr. rewrite (_: A_jagged.[to_uint inlen{2} %/ 8] = to_uint l_R %/8). rewrite H13. + rewrite (_: to_uint j_R = 8 * to_uint inlen{2} %/ 8); first by smt(). by smt(). + move : (H12 (to_uint l_R)). + rewrite (_:to_uint l_R %% 8 = 3); first by smt (@W64 jagged_bound jagged_inj). + move => *. rewrite H17. + by smt (@W8 @W64 jagged_bound jagged_inj). + rewrite /init64 WArray200.WArray200.initiE; first by smt(). auto => />. rewrite bits8E. smt(@W8). + rewrite (_:(3 = to_uint l_R %% 8) = false); first by smt (@W64 jagged_bound jagged_inj). simplify. + by rewrite -W8.xorwA W8.xorwK; smt(@W8). + case (i = 4) => />. + rewrite /get8 bits8E. + case (4 = to_uint j_R %% 8) => [hhhhht | hhhhhtf]. + rewrite (_:to_uint l_R %% 8 = 4); first by smt (@W64 jagged_bound jagged_inj). + simplify. congr. rewrite (_: A_jagged.[to_uint inlen{2} %/ 8] = to_uint l_R %/8). rewrite H13. + rewrite (_: to_uint j_R = 8 * to_uint inlen{2} %/ 8); first by smt(). by smt(). + move : (H12 (to_uint l_R)). + rewrite (_:to_uint l_R %% 8 = 4); first by smt (@W64 jagged_bound jagged_inj). + move => *. rewrite H17. + by smt (@W8 @W64 jagged_bound jagged_inj). + rewrite /init64 WArray200.WArray200.initiE; first by smt(). auto => />. rewrite bits8E. smt(@W8). + rewrite (_:(4 = to_uint l_R %% 8) = false); first by smt (@W64 jagged_bound jagged_inj). simplify. + by rewrite -W8.xorwA W8.xorwK; smt(@W8). + case (i = 5) => />. + rewrite /get8 bits8E. + case (5 = to_uint j_R %% 8) => [hhhhht | hhhhhtf]. + rewrite (_:to_uint l_R %% 8 = 5); first by smt (@W64 jagged_bound jagged_inj). + simplify. congr. rewrite (_: A_jagged.[to_uint inlen{2} %/ 8] = to_uint l_R %/8). rewrite H13. + rewrite (_: to_uint j_R = 8 * to_uint inlen{2} %/ 8); first by smt(). by smt(). + move : (H12 (to_uint l_R)). + rewrite (_:to_uint l_R %% 8 = 5); first by smt (@W64 jagged_bound jagged_inj). + move => *. rewrite H17. + by smt (@W8 @W64 jagged_bound jagged_inj). + rewrite /init64 WArray200.WArray200.initiE; first by smt(). auto => />. rewrite bits8E. smt(@W8). + rewrite (_:(5 = to_uint l_R %% 8) = false); first by smt (@W64 jagged_bound jagged_inj). simplify. + by rewrite -W8.xorwA W8.xorwK; smt(@W8). + case (i = 6) => />. + rewrite /get8 bits8E. + case (6 = to_uint j_R %% 8) => [hhhhht | hhhhhtf]. + rewrite (_:to_uint l_R %% 8 = 6); first by smt (@W64 jagged_bound jagged_inj). + simplify. congr. rewrite (_: A_jagged.[to_uint inlen{2} %/ 8] = to_uint l_R %/8). rewrite H13. + rewrite (_: to_uint j_R = 8 * to_uint inlen{2} %/ 8); first by smt(). by smt(). + move : (H12 (to_uint l_R)). + rewrite (_:to_uint l_R %% 8 = 6); first by smt (@W64 jagged_bound jagged_inj). + move => *. rewrite H17. + by smt (@W8 @W64 jagged_bound jagged_inj). + rewrite /init64 WArray200.WArray200.initiE; first by smt(). auto => />. rewrite bits8E. smt(@W8). + rewrite (_:(6 = to_uint l_R %% 8) = false); first by smt (@W64 jagged_bound jagged_inj). simplify. + by rewrite -W8.xorwA W8.xorwK; smt(@W8). + case (i = 7) => />. + rewrite /get8 bits8E. + case (7 = to_uint j_R %% 8) => [hhhhht | hhhhhtf]. + rewrite (_:to_uint l_R %% 8 = 7); first by smt (@W64 jagged_bound jagged_inj). + simplify. congr. rewrite (_: A_jagged.[to_uint inlen{2} %/ 8] = to_uint l_R %/8). rewrite H13. + rewrite (_: to_uint j_R = 8 * to_uint inlen{2} %/ 8); first by smt(). by smt(). + move : (H12 (to_uint l_R)). + rewrite (_:to_uint l_R %% 8 = 7); first by smt (@W64 jagged_bound jagged_inj). + move => *. rewrite H17. + by smt (@W8 @W64 jagged_bound jagged_inj). + rewrite /init64 WArray200.WArray200.initiE; first by smt(). auto => />. rewrite bits8E. smt(@W8). + rewrite (_:(7 = to_uint l_R %% 8) = false); first by smt (@W64 jagged_bound jagged_inj). simplify. + by rewrite -W8.xorwA W8.xorwK; smt(@W8). + by smt(). (*****) rewrite (_: 8 * k <= to_uint rate{2} - 1 < 8 * k + 8 = false); first by smt (@W64 jagged_bound jagged_inj). @@ -1159,7 +1257,7 @@ equiv modcorrect : good_io4x Glob.mem{2} (to_uint iotas{2}) /\ good_rhol Glob.mem{2} (to_uint rhotates_left{2}) /\ good_rhor Glob.mem{2} (to_uint rhotates_right{2}) /\ - in_0{1} = in_0{2} /\ inlen{1} = inlen{2} /\ s_out{1} = out{2} /\ s_outlen{1} = outlen{2} /\ rate{1} = rate{2} /\ + in_0{1} = in_0{2} /\ inlen{1} = inlen{2} /\ s_out{1} = out{2} /\ s_outlen{1} = outlen{2} /\ rate{1} = rate{2} /\ truncateu8 s_trail_byte{1} = trail_byte{2} /\ ={Glob.mem} ==> ={Glob.mem}. @@ -1197,7 +1295,7 @@ proof. rewrite W64.uleE => * /#. seq 3 2 : (#{/~em_states state0{2} state{1}}pre /\ em_states state{2} state{1}). - + by wp; call add_final_block_corr; auto => />. + + wp; call add_final_block_corr; auto => />. inline Mmod.squeeze. swap {2} [2..5] -1; swap {2} 8 -7. sp 0 5. From 319cb2cb1057d1957a9c801a4c8e325dc37d6e0b Mon Sep 17 00:00:00 2001 From: Manuel Barbosa Date: Sun, 18 Aug 2019 13:23:44 +0100 Subject: [PATCH 459/525] Proof done --- proof/impl/libc/keccak_1600_avx2_modular.ec | 122 ++++++++++++++++++-- 1 file changed, 115 insertions(+), 7 deletions(-) diff --git a/proof/impl/libc/keccak_1600_avx2_modular.ec b/proof/impl/libc/keccak_1600_avx2_modular.ec index d39c1ab..c1cfa24 100644 --- a/proof/impl/libc/keccak_1600_avx2_modular.ec +++ b/proof/impl/libc/keccak_1600_avx2_modular.ec @@ -930,13 +930,121 @@ proof. s_state_R.[A_jagged.[k]] \bits8 j)))%W8u8.Pack \bits8 i) = state_L.[k] `^` s_state_R.[A_jagged.[k]] \bits8 i); last by congr. by rewrite aux. - rewrite xorb8u8E. - apply W8u8.wordP => i hi. - rewrite map2E. simplify. - rewrite !W8u8.pack8bE; first 2 by smt(). - rewrite !initiE; first 4 by smt(@W64 jagged_bound jagged_inj). - by smt(@W64 jagged_bound jagged_inj). - auto => />. admit. + rewrite xorb8u8E map2E. + congr. congr. apply fun_ext => ii. + case (! 0 <= ii < 8) => [hti | hfi]. + + rewrite (_: (ii = (to_uint rate{2} - 1) %% 8) = false); first by smt(). + simplify. + rewrite (W8u8.get_out _ ii); first by apply hti. + rewrite (W8u8.Pack.get_out _ ii); first by apply hti. + by rewrite (W8u8.Pack.get_out _ ii); first by apply hti. + + case (ii = (to_uint rate{2} - 1) %% 8) => [hhit | hhif]. + rewrite (W8u8.Pack.initiE); first by apply hfi. + rewrite (W8u8.Pack.initiE); first by apply hfi. + rewrite (WArray200.WArray200.initiE); first by smt(). + simplify. + rewrite (WArray200.WArray200.initiE); first by smt(@W64 jagged_bound jagged_inj). + have -> : (ii = + (8 * A_jagged.[(to_uint rate{2} - 1) %/ 8] + (to_uint rate{2} - 1) %% 8) %% + 8); first by smt (@W64 jagged_bound jagged_inj). + rewrite /get8 /init64. + rewrite (WArray224.initiE); first by smt(@W64 jagged_bound jagged_inj). + simplify. + rewrite W8.xorwA. congr. + rewrite -(xorb8E). + rewrite -(xorb8E). + have -> : ((8 * A_jagged.[(to_uint rate{2} - 1) %/ 8] + (to_uint rate{2} - 1) %% 8) %% + 8 = (to_uint rate{2} - 1) %% 8); first by smt(@W64 jagged_bound jagged_inj). + congr. + rewrite Array25.initiE; first by smt(). + rewrite Array28.initiE; first by smt(jagged_bound). + rewrite get64_set8_200; first 2 by smt(@W64 jagged_bound jagged_inj). + rewrite get64_set8; first 2 by smt(@W64 jagged_bound jagged_inj). + case : (8 * ((to_uint rate{2} - 1) %/ 8) <= to_uint j_R < + 8 * ((to_uint rate{2} - 1) %/ 8) + 8) => [ hjt | hjf]. + + have -> : (8 * + ((8 * A_jagged.[(to_uint rate{2} - 1) %/ 8] + (to_uint rate{2} - 1) %% 8) %/ + 8) <= + to_uint l_R < + 8 * + ((8 * A_jagged.[(to_uint rate{2} - 1) %/ 8] + (to_uint rate{2} - 1) %% 8) %/ + 8) + + 8 ); first by smt(@W64 jagged_bound jagged_inj). + simplify. + rewrite -(aux (state_L.[k] `^` s_state_R.[A_jagged.[k]])). + rewrite xorb8u8E map2E. + congr. congr. apply fun_ext => iii. + case (! 0 <= iii < 8) => [hiiit | hiiif]. + + rewrite !W8u8.Pack.get_out; first 2 by apply hiiit. + have -> : (! iii = to_uint j_R %% 8); first by smt(). + simplify. by rewrite W8u8.get_out; first by apply hiiit. + + rewrite !initiE; first 2 by apply hiiif. simplify. + case (iii = to_uint j_R %% 8) => [hhjt | hhjf]. + + have -> : (iii = to_uint l_R %% 8); first by smt(@W64 jagged_bound jagged_inj). + simplify. congr. + rewrite (_: (s_state_R.[A_jagged.[k]] \bits8 to_uint l_R %% 8) = W8.zero). + rewrite (_: A_jagged.[k] = to_uint l_R %/ 8); first by smt(@W64 jagged_bound jagged_inj). apply H12; by smt(@W64 jagged_bound jagged_inj). + by smt(@W8 @W64 jagged_bound jagged_inj). + + have -> : (iii <> to_uint l_R %% 8); first by smt(@W64 jagged_bound jagged_inj). + simplify. rewrite -hht. + rewrite (_: (8 * A_jagged.[k] + (to_uint rate{2} - 1) %% 8) %/ 8 = A_jagged.[k]); first by smt(@W64 jagged_bound jagged_inj). by rewrite -(W8.xorwA); smt(@W64). + + + have -> : (! 8 * + ((8 * A_jagged.[(to_uint rate{2} - 1) %/ 8] + (to_uint rate{2} - 1) %% 8) %/ + 8) <= + to_uint l_R < + 8 * + ((8 * A_jagged.[(to_uint rate{2} - 1) %/ 8] + (to_uint rate{2} - 1) %% 8) %/ + 8) + + 8); first by smt(@W64 jagged_bound jagged_inj). + simplify. rewrite -hht. + rewrite (_: (8 * A_jagged.[k] + (to_uint rate{2} - 1) %% 8) %/ 8 = A_jagged.[k]); + first by smt(). + by rewrite -(W64.xorwA); smt(@W64). + + + rewrite (W8u8.Pack.initiE); first by apply hfi. + rewrite (W8u8.Pack.initiE); first by apply hfi. + rewrite (WArray200.WArray200.initiE); first by smt(@W64). + simplify. + have -> : (ii <> + (8 * A_jagged.[(to_uint rate{2} - 1) %/ 8] + (to_uint rate{2} - 1) %% 8) %% + 8); first by smt (@W64 jagged_bound jagged_inj). + rewrite /get8 /init64. + rewrite (WArray224.initiE); first by smt(@W64 jagged_bound jagged_inj). + simplify. + rewrite -(xorb8E). + rewrite -(xorb8E). + rewrite Array25.initiE; first by smt(). + rewrite Array28.initiE; first by smt(jagged_bound). + rewrite get64_set8_200; first 2 by smt(@W64 jagged_bound jagged_inj). + rewrite get64_set8; first 2 by smt(@W64 jagged_bound jagged_inj). + case : (8 * k <= to_uint j_R < 8 * k + 8) => [ hjt | hjf]. + + have -> : (8 * A_jagged.[k] <= to_uint l_R < 8 * A_jagged.[k] + 8); first by smt(@W64 jagged_bound jagged_inj). + simplify. + rewrite -xorb8E. + rewrite -(aux (state_L.[k] `^` s_state_R.[A_jagged.[k]])). + rewrite -xorb8E xorb8u8E map2E. + congr. congr. congr. apply fun_ext => iii. + case (! 0 <= iii < 8) => [hiiit | hiiif]. + + rewrite !W8u8.Pack.get_out; first 2 by apply hiiit. + have -> : (! iii = to_uint j_R %% 8); first by smt(). + simplify. by rewrite W8u8.get_out; first by apply hiiit. + + rewrite !initiE; first 2 by apply hiiif. simplify. + case (iii = to_uint j_R %% 8) => [hhjt | hhjf]. + + have -> : (iii = to_uint l_R %% 8); first by smt(@W64 jagged_bound jagged_inj). + simplify. congr. + rewrite (_: (s_state_R.[A_jagged.[k]] \bits8 to_uint l_R %% 8) = W8.zero). + rewrite (_: A_jagged.[k] = to_uint l_R %/ 8); first by smt(@W64 jagged_bound jagged_inj). apply H12; by smt(@W64 jagged_bound jagged_inj). + by smt(@W8 @W64 jagged_bound jagged_inj). + + have -> : (iii <> to_uint l_R %% 8); first by smt(@W64 jagged_bound jagged_inj). + simplify. + by rewrite -(W8.xorwA); smt(@W64). + + have -> : (! 8 * A_jagged.[k] <= to_uint l_R < 8 * A_jagged.[k] + 8); first by smt(@W64 jagged_bound jagged_inj). + simplify. + rewrite -(xorb8E). + rewrite -(xorb8E). + congr. + by rewrite -(W64.xorwA); smt(@W64). rewrite (_: 8 * k <= to_uint rate{2} - 1 < 8 * k + 8 = false); first by smt (@W64 jagged_bound jagged_inj). rewrite (_: 8 * A_jagged.[k] <= From b67e3f5bc217a8905854401732b911b31863b56d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Mon, 19 Aug 2019 23:58:09 +0200 Subject: [PATCH 460/525] some work --- proof/SHA3_OIndiff.ec | 1 + proof/SecureORO.eca | 31 ++++++++++++++----------------- 2 files changed, 15 insertions(+), 17 deletions(-) diff --git a/proof/SHA3_OIndiff.ec b/proof/SHA3_OIndiff.ec index f039ee3..1900a47 100644 --- a/proof/SHA3_OIndiff.ec +++ b/proof/SHA3_OIndiff.ec @@ -264,3 +264,4 @@ qed. +end section. diff --git a/proof/SecureORO.eca b/proof/SecureORO.eca index 38949c6..99c90e8 100644 --- a/proof/SecureORO.eca +++ b/proof/SecureORO.eca @@ -7,7 +7,7 @@ type from, to. op sampleto : to distr. op bound : int. -axiom bound_gt0 : 0 < bound. +axiom bound_ge0 : 0 <= bound. axiom sampleto_ll: is_lossless sampleto. axiom sampleto_full: is_full sampleto. @@ -22,9 +22,6 @@ proof * by exact/sampleto_ll. op increase_counter (c : int) (m : from) : int. axiom increase_counter_spec c m : c <= increase_counter c m. -op bound_counter : int. -axiom bound_counter_ge0 : 0 <= bound_counter. - module type RF = { proc init() : unit proc get(x : from) : to option @@ -117,7 +114,7 @@ section Preimage. wp; conseq(:_==> card (fdom RO.m) + 1 <= Bounder.bounder <= bound); 2: by auto;smt(). move=> &h /> c H1 H2 c2 r x h1 h2; split; 2: smt(). by rewrite fdom_set fcardU fcard1; smt(fcard_ge0). - by auto=> />; rewrite fdom0 fcards0; smt(bound_gt0). + by auto=> />; rewrite fdom0 fcards0; smt(bound_ge0). + seq 1 : true 1%r (bound%r * mu1 sampleto witness) 0%r _; auto. exists * Preimage2.hash; elim* => h. call(: Preimage2.hash = h /\ h = arg ==> rng RO.m h)=> //; bypr=> /> {&m} &m {h} <-. @@ -131,11 +128,11 @@ section Preimage. (card (fdom RO.m) <= Bounder.bounder <= bound) =>//. - rewrite StdBigop.Bigreal.BRA.big_const List.count_predT List.Range.size_range. - rewrite IntExtra.Extrema.max_ler //=; 1:smt(bound_gt0). - rewrite-StdRing.RField.AddMonoid.iteropE-StdRing.RField.intmulpE; 1: smt(bound_gt0). + rewrite IntExtra.Extrema.max_ler //=; 1:smt(bound_ge0). + rewrite-StdRing.RField.AddMonoid.iteropE-StdRing.RField.intmulpE; 1: smt(bound_ge0). by rewrite StdRing.RField.intmulr; smt(). - inline*; auto=> /> &h. - rewrite mem_rng_empty /= fdom0 fcards0 /=; smt(bound_gt0). + rewrite mem_rng_empty /= fdom0 fcards0 /=; smt(bound_ge0). - proc. sp; if; auto; sp; inline*; sp; wp=> /=. case: (x \in RO.m); wp => //=. @@ -277,7 +274,7 @@ section SecondPreimage. auto=> /> &h c Hc Hdom Hc2 sample. by rewrite sampleto_full/=!fdom_set !fcardU !fcard1;smt(mem_set fcard_ge0). auto=> /> &h sample. - by rewrite mem_set mem_empty/= fdom_set fdom0 fset0U fcard1; smt(bound_gt0). + by rewrite mem_set mem_empty/= fdom_set fdom0 fset0U fcard1; smt(bound_ge0). + call(: arg = mess1 ==> rng (rem RO.m mess1) (oget RO.m.[mess1])); auto. bypr=> {&m} &m h; rewrite h. fel 2 Bounder.bounder (fun _, mu1 sampleto witness) bound @@ -286,12 +283,12 @@ section SecondPreimage. (card (fdom RO.m) - 1 <= Bounder.bounder <= bound /\ mess1 \in RO.m)=> {h} =>//. + rewrite StdBigop.Bigreal.BRA.big_const List.count_predT List.Range.size_range. - rewrite IntExtra.Extrema.max_ler //=; 1:smt(bound_gt0). - rewrite-StdRing.RField.AddMonoid.iteropE-StdRing.RField.intmulpE; 1: smt(bound_gt0). - by rewrite StdRing.RField.intmulr; smt(mu_bounded bound_gt0). + rewrite IntExtra.Extrema.max_ler //=; 1:smt(bound_ge0). + rewrite-StdRing.RField.AddMonoid.iteropE-StdRing.RField.intmulpE; 1: smt(bound_ge0). + by rewrite StdRing.RField.intmulr; smt(mu_bounded bound_ge0). + inline*; auto=> />. move=> &h r; rewrite mem_empty /= !mem_set mem_empty/= sampleto_full /=. - rewrite get_set_sameE//= fdom_set fdom0 fset0U fcard1 /= rngE /=; split; 2: smt(bound_gt0). + rewrite get_set_sameE//= fdom_set fdom0 fset0U fcard1 /= rngE /=; split; 2: smt(bound_ge0). by rewrite negb_exists/= => a; rewrite remE get_setE //= emptyE; smt(). + proc; inline*; sp; if; last by hoare; auto. sp; case: (x \in RO.m)=> //=. @@ -414,7 +411,7 @@ section Collision. case: (m1 = m2). - by hoare; 1: smt(mu_bounded); auto. case: (m1 \in RO.m); case: (m2 \in RO.m). - - rcondf 3; 1: auto; rcondf 4; 1: auto; hoare; auto; 1: smt(bound_gt0 mu_bounded). + - rcondf 3; 1: auto; rcondf 4; 1: auto; hoare; auto; 1: smt(bound_ge0 mu_bounded). move=> /> &h d _ _ Hcoll _ _ neq12 in_dom1 in_dom2 _ _ _ _. move: Hcoll; rewrite /collision negb_exists /= => /(_ m1{h}). rewrite negb_exists /= => /(_ m2{h}). @@ -442,7 +439,7 @@ section Collision. auto=> /> &h d Hbc Hcb sample _; split. * by move=> nin_dom1; rewrite fdom_set fcardU fcard1; smt(fcard_ge0). by move=> in_dom1; smt(). - by move=> />; rewrite fdom0 fcards0; smt(bound_gt0). + by move=> />; rewrite fdom0 fcards0; smt(bound_ge0). call(: true ==> collision RO.m); auto; bypr=> /> {&m} &m. fel 1 Bounder.bounder (fun i, i%r * mu1 sampleto witness) bound (collision RO.m) @@ -450,9 +447,9 @@ section Collision. (card (fdom RO.m) <= Bounder.bounder <= bound)=> //. + rewrite -StdBigop.Bigreal.BRA.mulr_suml StdRing.RField.mulrAC. rewrite StdOrder.RealOrder.ler_wpmul2r; 1: smt(mu_bounded). - by rewrite StdBigop.Bigreal.sumidE //; smt(bound_gt0). + by rewrite StdBigop.Bigreal.sumidE //; smt(bound_ge0). + inline*; auto=> />. - rewrite fdom0 fcards0; split; 2: smt(bound_gt0). + rewrite fdom0 fcards0; split; 2: smt(bound_ge0). rewrite /collision negb_exists /= => a; rewrite negb_exists /= => b. by rewrite mem_empty. + bypr=> /> {&m} &m; pose c := Bounder.bounder{m}; move=> H0c Hcbound Hcoll Hmc _. From 4b92db886448e57eef9edacdeb0659a0421cbd16 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Tue, 20 Aug 2019 00:14:55 +0200 Subject: [PATCH 461/525] forgot some files. --- proof/SHA3OSecurity.ec | 1410 ++++++++++++++++++++++++++++++++++++++++ proof/SecureHash.eca | 148 +++++ 2 files changed, 1558 insertions(+) create mode 100644 proof/SHA3OSecurity.ec create mode 100644 proof/SecureHash.eca diff --git a/proof/SHA3OSecurity.ec b/proof/SHA3OSecurity.ec new file mode 100644 index 0000000..2dfc615 --- /dev/null +++ b/proof/SHA3OSecurity.ec @@ -0,0 +1,1410 @@ +(* Top-level Proof of SHA-3 Security *) + +require import AllCore Distr DList DBool List IntExtra IntDiv Dexcepted DProd SmtMap FSet. +require import Common SLCommon Sponge SHA3_OIndiff. +require (****) SecureORO SecureHash. +(*****) import OIndif. + + +(* module SHA3 (P : DPRIMITIVE) = { *) +(* proc init() : unit = {} *) +(* proc f (bl : bool list, n : int) : bool list = { *) +(* var r : bool list; *) +(* r <@ Sponge(P).f(bl ++ [false; true], n); *) +(* return r; *) +(* } *) +(* }. *) + +op size_out : int. +axiom size_out_gt0 : 0 < size_out. + +op sigma : int = SHA3Indiff.limit. +axiom sigma_ge0 : 0 <= sigma. + +op limit : int = sigma. + +type f_out. + +op dout : f_out distr. +axiom dout_ll : is_lossless dout. +axiom dout_fu : is_funiform dout. +axiom dout_full : is_full dout. + + +op to_list : f_out -> bool list. +op of_list : bool list -> f_out option. +axiom spec_dout (l : f_out) : size (to_list l) = size_out. +axiom spec2_dout (l : bool list) : size l = size_out => of_list l <> None. +axiom to_list_inj : injective to_list. +axiom to_listK e l : to_list e = l <=> of_list l = Some e. + +axiom dout_equal_dlist : dmap dout to_list = dlist dbool size_out. + +lemma doutE1 x : mu1 dout x = inv (2%r ^ size_out). +proof. +cut->:inv (2%r ^ size_out) = mu1 (dlist dbool size_out) (to_list x). ++ rewrite dlist1E. + - smt(size_out_gt0). + rewrite spec_dout/=. + pose p:= StdBigop.Bigreal.BRM.big _ _ _. + cut->: p = StdBigop.Bigreal.BRM.big predT (fun _ => inv 2%r) (to_list x). + - rewrite /p =>{p}. print StdBigop.Bigreal.BRM. + apply StdBigop.Bigreal.BRM.eq_bigr. + by move=> i; rewrite//= dbool1E. + rewrite StdBigop.Bigreal.BRM.big_const count_predT spec_dout=> {p}. search 0 Int.(+) 1 (<=). + have:=size_out_gt0; move/ltzW. + move:size_out;apply intind=> //=. + - by rewrite powr0 iter0 //= fromint1. + move=> i hi0 rec. + by rewrite powrS//iterS// -rec; smt(). +rewrite -dout_equal_dlist dmap1E. +apply mu_eq. +by move=> l; rewrite /pred1/(\o); smt(to_listK). +qed. + + +(* module CSetSize (F : OCONSTRUCTION) (P : ODPRIMITIVE) = { *) +(* proc init = F(P).init *) +(* proc f (x : bool list) = { *) +(* var r, l; *) +(* r <@ F(P).f(x,size_out); *) +(* l <- (r <> None) ? of_list (oget r) : None; *) +(* return l; *) +(* } *) +(* }. *) + +(* module FSetSize (F : OFUNCTIONALITY) = { *) +(* proc init = F.init *) +(* proc f (x : bool list) = { *) +(* var r, l; *) +(* r <@ F.f(x,size_out); *) +(* l <- (r <> None) ? of_list (oget r) : None; *) +(* return l; *) +(* } *) +(* }. *) + +clone import SecureORO as SORO with + type from <- bool list, + type to <- f_out, + + op sampleto <- dout, + op bound <- sigma, + op increase_counter <- fun c m => c + ((size m + 1) %/ r + 1) + + max ((size_out + r - 1) %/ r - 1) 0 + + proof *. +realize bound_ge0 by exact(sigma_ge0). +realize sampleto_ll by exact(dout_ll). +realize sampleto_fu by exact(dout_fu). +realize sampleto_full by exact(dout_full). +realize increase_counter_spec by smt(List.size_ge0 divz_ge0 gt0_r). + + +clone import SecureHash as SH with + type from <- bool list, + type to <- f_out, + type block <- state, + op sampleto <- dout, + op bound <- sigma, + op increase_counter <- fun c m => c + ((size m + 1) %/ r + 1) + + max ((size_out + r - 1) %/ r - 1) 0 +proof *. +realize sampleto_ll by exact(dout_ll). +realize sampleto_fu by exact(dout_fu). +realize sampleto_full by exact(dout_full). +realize bound_ge0 by exact(sigma_ge0). +realize increase_counter_spec by smt(List.size_ge0 divz_ge0 gt0_r). + + +(* module FGetSize (F : ODFUNCTIONALITY) = { *) +(* proc f (x : bool list, i : int) = { *) +(* var r; *) +(* r <@ F.f(x); *) +(* return to_list r; *) +(* } *) +(* }. *) + +(* module SimSetSize (S : SIMULATOR) (F : Indiff0.DFUNCTIONALITY) = S(FGetSize(F)). *) + +(* module DFSetSize (F : DFUNCTIONALITY) = { *) +(* proc f (x : bool list) = { *) +(* var r; *) +(* r <@ F.f(x,size_out); *) +(* return oget (of_list r); *) +(* } *) +(* }. *) + +(* module (DSetSize (D : Indiff0.DISTINGUISHER) : DISTINGUISHER) *) +(* (F : DFUNCTIONALITY) (P : DPRIMITIVE) = D(DFSetSize(F),P). *) + + +module FSetSize (F : OFUNCTIONALITY) : OIndif.OFUNCTIONALITY = { + proc init = F.init + proc f (x : bool list) = { + var y, r; + y <@ F.f(x,size_out); + r <- (y <> None) ? of_list (oget y) : None; + return r; + } +}. + +module DFSetSize (F : ODFUNCTIONALITY) : OIndif.OFUNCTIONALITY = { + proc init () = {} + proc f (x : bool list) = { + var y, r; + y <@ F.f(x,size_out); + r <- (y <> None) ? of_list (oget y) : None; + return r; + } +}. + +module FIgnoreSize (F : OIndif.ODFUNCTIONALITY) : OFUNCTIONALITY = { + proc init () = {} + proc f (x : bool list, i : int) = { + var y, r; + y <@ F.f(x); + return omap to_list r; + } +}. + +module (OSponge : OIndif.OCONSTRUCTION) (P : OIndif.ODPRIMITIVE) = + FSetSize(CSome(Sponge,P)). + +section Preimage. +(* TODO : stopped here *) + + + local module FInit (F : OIndif.ODFUNCTIONALITY) : OIndif.OFUNCTIONALITY = { + proc init () = {} + proc f = F.f + }. + + local module PInit (P : ODPRIMITIVE) : OPRIMITIVE = { + proc init () = {} + proc f = P.f + proc fi = P.fi + }. + + local module (Dist_of_P1Adv (A : SH.AdvPreimage) : ODISTINGUISHER) (F : ODFUNCTIONALITY) (P : ODPRIMITIVE) = { + proc distinguish () = { + var hash, hash', m; + hash <$ dout; + m <@ A(DFSetSize(F),P).guess(hash); + hash' <@ DFSetSize(F).f(m); + return hash' = Some hash; + } + }. + +local lemma leq_ideal &m + (A <: SH.AdvPreimage { Perm, Counter, Bounder, F.RO, F.FRO, Redo, C, Gconcl.S, + BlockSponge.BIRO.IRO, BlockSponge.C, BIRO.IRO, Gconcl_list.BIRO2.IRO, + Gconcl_list.F2.RO, Gconcl_list.F2.FRO, Gconcl_list.Simulator, + SHA3Indiff.Simulator, SHA3Indiff.Cntr }): + Pr[SHA3_OIndiff.OIndif.OIndif(FSome(BIRO.IRO), OSimulator(FSome(BIRO.IRO)), + ODRestr(Dist_of_P1Adv(A))).main() @ &m : res] <= (sigma + 1)%r / 2%r ^ size_out. +proof. +print SORO. +print SORO.RO_is_preimage_resistant. +admit. +qed. + + local lemma rw_real &m (A <: SH.AdvPreimage { Perm, Counter, Bounder }): + Pr[Preimage(A, OSponge, PSome(Perm)).main() @ &m : res] = + Pr[SHA3_OIndiff.OIndif.OIndif(FSome(Sponge(Poget(PSome(Perm)))), PSome(Perm), + ODRestr(Dist_of_P1Adv(A))).main() @ &m : res]. + proof. + byequiv=>//=; proc; inline*; sp; wp=> />. + swap{1} 4; sp. + seq 2 2 : (={glob A, glob Perm, hash, m} /\ Bounder.bounder{1} = Counter.c{2}). + + call(: ={glob Perm} /\ Bounder.bounder{1} = Counter.c{2})=> //=. + - by proc; inline*; sp; if; auto; 2:sim=> />; 1: smt(). + - by proc; inline*; sp; if; auto; 2:sim=> />; 1: smt(). + - proc; inline*; sp; if; auto; sp=> />. + by conseq(:_==> ={z0, glob Perm})=> />; sim. + by auto. + by sp; if; auto=>/=; sim; auto. + qed. + +lemma Sponge_preimage_resistant &m + (A <: SH.AdvPreimage { Perm, Counter, Bounder, F.RO, F.FRO, Redo, C, Gconcl.S, + BlockSponge.BIRO.IRO, BlockSponge.C, BIRO.IRO, Gconcl_list.BIRO2.IRO, + Gconcl_list.F2.RO, Gconcl_list.F2.FRO, Gconcl_list.Simulator, + SHA3Indiff.Simulator, SHA3Indiff.Cntr }): + (forall (F <: OIndif.ODFUNCTIONALITY) (P <: OIndif.ODPRIMITIVE), + islossless F.f => islossless P.f => islossless P.fi => islossless A(F,P).guess) => + Pr[Preimage(A, OSponge, PSome(Perm)).main() @ &m : res] <= + (limit ^ 2 - limit)%r / (2 ^ (r + c + 1))%r + + (4 * limit ^ 2)%r / (2 ^ c)%r + + (sigma + 1)%r / (2%r ^ size_out). +proof. +move=> A_ll. +rewrite (rw_real &m A). +have := SHA3OIndiff (Dist_of_P1Adv(A)) &m _. ++ move=> F P Hp Hpi Hf; proc; inline*; sp; auto; call Hf; auto. + call(A_ll (DFSetSize(F)) P _ Hp Hpi); auto. + - proc; inline*; auto; call Hf; auto. + smt(dout_ll). +by have/#:=leq_ideal &m A. +qed. + + + declare module A : SH.AdvPreimage{SRO.RO.RO, SRO.RO.FRO, SRO.Bounder, Perm, + Gconcl_list.BIRO2.IRO, Simulator, Cntr, BIRO.IRO, F.RO, F.FRO, Redo, C, + Gconcl.S, BlockSponge.BIRO.IRO, BlockSponge.C, Gconcl_list.F2.RO, + Gconcl_list.F2.FRO, Gconcl_list.Simulator, DPre}. + + axiom A_ll (F <: SRO.Oracle) : islossless F.get => islossless A(F).guess. + + local lemma invm_dom_rng (m mi : (state, state) fmap) : + invm m mi => dom m = rng mi. + proof. + move=>h; rewrite fun_ext=> x; rewrite domE rngE /= eq_iff; have h2 := h x; split. + + move=> m_x_not_None; exists (oget m.[x]); rewrite -h2; move: m_x_not_None. + by case: (m.[x]). + by move=> [] a; rewrite -h2 => ->. + qed. + + local lemma invmC' (m mi : (state, state) fmap) : + invm m mi => invm mi m. + proof. by rewrite /#. qed. + + local lemma invmC (m mi : (state, state) fmap) : + invm m mi <=> invm mi m. + proof. by split;exact invmC'. qed. + + local lemma useful m mi a : + invm m mi => ! a \in m => Distr.is_lossless ((bdistr `*` cdistr) \ rng m). + proof. + move=>hinvm nin_dom. + cut prod_ll:Distr.is_lossless (bdistr `*` cdistr). + + by rewrite dprod_ll DBlock.dunifin_ll DCapacity.dunifin_ll. + apply dexcepted_ll=>//=;rewrite-prod_ll. + cut->:predT = predU (predC (rng m)) (rng m);1:rewrite predCU//=. + rewrite Distr.mu_disjoint 1:predCI//=StdRing.RField.addrC. + cut/=->:=StdOrder.RealOrder.ltr_add2l (mu (bdistr `*` cdistr) (rng m)) 0%r. + rewrite Distr.witness_support/predC. + move:nin_dom;apply absurd=>//=;rewrite negb_exists/==>hyp. + cut{hyp}hyp:forall x, rng m x by smt(supp_dprod DBlock.supp_dunifin DCapacity.supp_dunifin). + move:a. + cut:=eqEcard (fdom m) (frng m);rewrite leq_card_rng_dom/=. + cut->//=:fdom m \subset frng m. + + by move=> x; rewrite mem_fdom mem_frng hyp. + smt(mem_fdom mem_frng). + qed. + + + local equiv equiv_sponge_perm c m : + FInit(CSetSize(Sponge, Perm)).get ~ FInit(DFSetSize(FC(Sponge(Perm)))).get : + ={arg, glob Perm} /\ invm Perm.m{1} Perm.mi{1} /\ + Cntr.c{2} = c /\ arg{2} = m /\ + (Cntr.c + ((size arg + 1) %/ Common.r + 1) + + max ((size_out + Common.r - 1) %/ Common.r - 1) 0 <= limit){2} ==> + ={res, glob Perm} /\ invm Perm.m{1} Perm.mi{1} /\ + Cntr.c{2} = c + ((size m + 1) %/ Common.r + 1) + + max ((size_out + Common.r - 1) %/ Common.r - 1) 0. + proof. + proc; inline FC(Sponge(Perm)).f; sp. + rcondt{2} 1; auto; sp. + call(: ={glob Perm} /\ invm Perm.m{1} Perm.mi{1})=>/=; auto; inline*. + while(={i, n, sa, sc, z, glob Perm} /\ invm Perm.m{1} Perm.mi{1}); auto. + + sp; if; auto; sp; if; auto; progress. + rewrite invm_set //=. + by move:H4; rewrite supp_dexcepted. + sp; conseq(:_==> ={i, n, sa, sc, glob Perm} /\ invm Perm.m{1} Perm.mi{1}); auto. + while(={xs, sa, sc, glob Perm} /\ invm Perm.m{1} Perm.mi{1}); auto. + sp; if; auto; progress. + rewrite invm_set=>//=. + by move:H4; rewrite supp_dexcepted. + qed. + + + op same_ro (m1 : (bool list, f_out) fmap) (m2 : (bool list * int, bool) fmap) = + (forall m, m \in m1 => forall i, 0 <= i < size_out => (m,i) \in m2) + && (forall m, (exists i, 0 <= i < size_out /\ (m,i) \in m2) => m \in m1) + && (forall m, m \in m1 => to_list (oget m1.[m]) = map (fun i => oget m2.[(m,i)]) (range 0 size_out)). + + op same_ro2 (m1 : (bool list, bool list) fmap) (m2 : (bool list * int, bool) fmap) = + (forall m, m \in m1 => forall i, 0 <= i < size_out => (m,i) \in m2) + && (forall m, (exists i, 0 <= i < size_out /\ (m,i) \in m2) => m \in m1) + && (forall m, m \in m1 => oget m1.[m] = map (fun i => oget m2.[(m,i)]) (range 0 size_out)). + + clone import Program as Prog with + type t <- bool, + op d <- dbool + proof *. + + local equiv equiv_ro_iro c m : + FInit(RO).get ~ FInit(DFSetSize(FC(BIRO.IRO))).get : + ={arg} /\ same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2} /\ + arg{2} = m /\ Cntr.c{2} = c /\ + (Cntr.c + ((size arg + 1) %/ Common.r + 1) + + max ((size_out + Common.r - 1) %/ Common.r - 1) 0 <= limit){2} + ==> ={res} /\ same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2} /\ + Cntr.c{2} = c + ((size m + 1) %/ Common.r + 1) + + max ((size_out + Common.r - 1) %/ Common.r - 1) 0. + proof. + proc; inline *; sp; rcondt{2} 1; 1: auto. + swap{2} 1 5; sp; wp 2 1. + conseq(:_==> oget SRO.RO.RO.m{1}.[x{1}] = oget (of_list bs0{2}) /\ + same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2}); 1:by auto. + rcondt{2} 1; 1: auto. + case: (x{1} \in SRO.RO.RO.m{1}). + + rcondf{1} 2; auto. + exists* BIRO.IRO.mp{2}; elim* => mp. + while{2}(bs0{2} = map (fun j => oget BIRO.IRO.mp{2}.[(x0{2},j)]) (range 0 i{2}) + /\ n0{2} = size_out /\ x0{2} \in SRO.RO.RO.m{1} /\ 0 <= i{2} <= size_out + /\ same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2} /\ BIRO.IRO.mp{2} = mp) + (size_out - i{2}); auto. + - sp; rcondf 1; auto; 1: smt(). + progress. + * have/=<-:= map_rcons (fun (j : int) => oget BIRO.IRO.mp{hr}.[(x0{hr}, j)]) (range 0 i{hr}) i{hr}. + by rewrite !rangeSr //=. + * smt(). + * smt(). + * smt(). + progress. + - by rewrite range_geq. + - smt(size_out_gt0). + - smt(). + - exact(dout_ll). + - have[] h[#] h1 h2 := H. + cut->:i_R = size_out by smt(). + cut<-:=h2 _ H3. + smt(to_listK). + rcondt{1} 2; 1: auto; wp =>/=. + exists* BIRO.IRO.mp{2}; elim* => mp. + conseq(:_==> + same_ro SRO.RO.RO.m{1} mp /\ i{2} = size_out /\ + (forall (l,j), (l,j) \in mp => (l,j) \in BIRO.IRO.mp{2}) /\ + (forall (l,j), (l,j) \in mp => BIRO.IRO.mp{2}.[(l,j)] = mp.[(l,j)]) /\ + (forall (l,j), (l,j) \in BIRO.IRO.mp{2} => (l,j) \in mp \/ (l = x0{2} /\ 0 <= j < i{2})) /\ + (forall j, 0 <= j < i{2} => (x0{2},j) \in BIRO.IRO.mp{2}) /\ + take i{2} (to_list r{1}) = bs0{2} /\ + take i{2} (to_list r{1}) = map (fun (j : int) => oget BIRO.IRO.mp{2}.[(x0{2}, j)]) (range 0 i{2})); progress=>//=. + + by rewrite get_set_sameE /= oget_some; smt(to_listK take_oversize spec_dout). + + move:H8; rewrite mem_set=>[][]//=h; 1:rewrite H3=>//=. + - by have []h1 []h2 h3:= H2; have->//:=h1 _ h. + by move:h => <<-; rewrite H6 //=. + + rewrite mem_set//=; have[]//=h:= H5 _ _ H11; left. + have []h1 []->//=:= H2. + by exists i0=>//=. + + move:H7; rewrite take_oversize 1:spec_dout//= => H7. + move:H10; rewrite mem_set. + case(m \in SRO.RO.RO.m{1})=>//=h. + - rewrite get_set_neqE; 1:smt(). + have []h1 []h2 ->//=:= H2. + by apply eq_in_map=> j;rewrite mem_range=>[][]hj1 hj2/=; rewrite H4//=h1//=. + by move=><<-; rewrite get_set_eqE//=. + alias{1} 1 l = [<:bool>]. + transitivity{1} { + l <@ Sample.sample(size_out); + r <- oget (of_list l); + } + (={glob SRO.RO.RO, x} ==> ={glob SRO.RO.RO, r}) + (x{1} = x0{2} /\ i{2} = 0 /\ n0{2} = size_out /\ mp = BIRO.IRO.mp{2} /\ + same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2} /\ x{1} \notin SRO.RO.RO.m{1} /\ + bs0{2} = [] + ==> + same_ro SRO.RO.RO.m{1} mp /\ i{2} = size_out /\ + (forall (l,j), (l,j) \in mp => (l,j) \in BIRO.IRO.mp{2}) /\ + (forall (l,j), (l,j) \in mp => BIRO.IRO.mp{2}.[(l,j)] = mp.[(l,j)]) /\ + (forall (l,j), (l,j) \in BIRO.IRO.mp{2} => (l,j) \in mp \/ (l = x0{2} /\ 0 <= j < i{2})) /\ + (forall j, 0 <= j < i{2} => (x0{2},j) \in BIRO.IRO.mp{2}) /\ + take i{2} (to_list r{1}) = bs0{2} /\ + take i{2} (to_list r{1}) = + map (fun (j : int) => oget BIRO.IRO.mp{2}.[(x0{2}, j)]) (range 0 i{2})); + progress. + + smt(). + + inline*; sp; wp. + rnd to_list (fun x => oget (of_list x)); auto; progress. + - smt(spec_dout supp_dlist to_listK spec2_dout size_out_gt0). + - rewrite -dout_equal_dlist dmap1E; apply mu_eq=> x/=. + smt(to_listK). + - rewrite-dout_equal_dlist supp_dmap; smt(dout_full). + smt(to_listK). + wp=>/=. + conseq(:_==> i{2} = size_out /\ size l{1} = size_out /\ + (forall (l0 : bool list) (j : int), + (l0, j) \in mp => (l0, j) \in BIRO.IRO.mp{2}) /\ + (forall (l0 : bool list) (j : int), + (l0, j) \in mp => BIRO.IRO.mp{2}.[(l0, j)] = mp.[(l0, j)]) /\ + (forall (l0 : bool list) (j : int), + (l0, j) \in BIRO.IRO.mp{2} => ((l0, j) \in mp) \/ (l0 = x0{2} /\ 0 <= j < i{2})) /\ + (forall (j : int), 0 <= j < i{2} => (x0{2}, j) \in BIRO.IRO.mp{2}) /\ + take i{2} l{1} = bs0{2} /\ + take i{2} l{1} = + map (fun (j : int) => oget BIRO.IRO.mp{2}.[(x0{2}, j)]) (range 0 i{2})); + progress. + + have[]//=h h1:=to_listK (oget (of_list l_L)) l_L; rewrite h1//==> {h1 h}. + smt(spec2_dout). + + have[]//=h h1:=to_listK (oget (of_list l_L)) l_L; rewrite h1//==> {h1 h}. + smt(spec2_dout). + transitivity{1} { + l <@ LoopSnoc.sample(size_out); + } + (={glob SRO.RO.RO} ==> ={glob SRO.RO.RO, l}) + (x{1} = x0{2} /\ i{2} = 0 /\ n0{2} = size_out /\ mp = BIRO.IRO.mp{2} /\ + same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2} /\ x0{2} \notin SRO.RO.RO.m{1} /\ + bs0{2} = [] + ==> + i{2} = size_out /\ size l{1} = size_out /\ + (forall (l,j), (l,j) \in mp => (l,j) \in BIRO.IRO.mp{2}) /\ + (forall (l,j), (l,j) \in mp => BIRO.IRO.mp{2}.[(l,j)] = mp.[(l,j)]) /\ + (forall (l,j), (l,j) \in BIRO.IRO.mp{2} => (l,j) \in mp \/ (l = x0{2} /\ 0 <= j < i{2})) /\ + (forall j, 0 <= j < i{2} => (x0{2},j) \in BIRO.IRO.mp{2}) /\ + take i{2} l{1} = bs0{2} /\ + take i{2} l{1} = + map (fun (j : int) => oget BIRO.IRO.mp{2}.[(x0{2}, j)]) (range 0 i{2})); + progress. + + smt(). + + by call Sample_LoopSnoc_eq; auto. + inline*; sp; wp. + conseq(:_==> i{2} = size_out /\ size l0{1} = i{2} /\ + same_ro SRO.RO.RO.m{1} mp /\ x0{2} \notin SRO.RO.RO.m{1} /\ + (forall l j, (l,j) \in mp => (l,j) \in BIRO.IRO.mp{2}) /\ + (forall l j, (l,j) \in mp => BIRO.IRO.mp{2}.[(l, j)] = mp.[(l, j)]) /\ + (forall l j, (l, j) \in BIRO.IRO.mp{2} => ((l, j) \in mp) \/ (l = x0{2} /\ 0 <= j < i{2})) /\ + (forall j, 0 <= j < i{2} => (x0{2}, j) \in BIRO.IRO.mp{2}) /\ + l0{1} = bs0{2} /\ bs0{2} = + map (fun (j : int) => oget BIRO.IRO.mp{2}.[(x0{2}, j)]) (range 0 i{2})); progress. + + smt(take_oversize). + + smt(take_oversize). + while(0 <= i{2} <= size_out /\ size l0{1} = i{2} /\ n0{2} = size_out /\ + ={i} /\ n{1} = n0{2} /\ + same_ro SRO.RO.RO.m{1} mp /\ x0{2} \notin SRO.RO.RO.m{1} /\ + (forall l j, (l,j) \in mp => (l,j) \in BIRO.IRO.mp{2}) /\ + (forall l j, (l,j) \in mp => BIRO.IRO.mp{2}.[(l, j)] = mp.[(l, j)]) /\ + (forall l j, (l, j) \in BIRO.IRO.mp{2} => ((l, j) \in mp) \/ (l = x0{2} /\ 0 <= j < i{2})) /\ + (forall j, 0 <= j < i{2} => (x0{2}, j) \in BIRO.IRO.mp{2}) /\ + l0{1} = bs0{2} /\ bs0{2} = + map (fun (j : int) => oget BIRO.IRO.mp{2}.[(x0{2}, j)]) (range 0 i{2})). + + sp; wp=> //=. + rcondt{2} 1; 1:auto; progress. + - have[]h1 [] h2 h3 := H1. + have:=h2 x0{hr}; rewrite H2/= negb_exists/= =>/(_ (size bs0{hr})). + rewrite size_ge0 H9/=; apply absurd =>/= h. + by have //=:= H5 _ _ h. + rnd; auto; progress. + - smt(size_ge0). + - smt(). + - by rewrite size_cat/=. + - by rewrite mem_set; left; rewrite H3. + - rewrite get_setE (H4 _ _ H12). + cut/#: !(l1, j) = (x0{2}, size bs0{2}). + move:H2; apply absurd=> //=[#] <<- ->>. + have[] h1 [] h2 h3 := H1. + by apply h2; smt(). + - move:H12; rewrite mem_set. + case((l1, j) \in BIRO.IRO.mp{2})=>//= h; 1: smt(). + by move=> [#] <<- ->> //=; rewrite size_ge0; smt(). + - rewrite mem_set. + case(j = size bs0{2})=>//=. + move=> h; rewrite h /=; have {H13} H13 {h} : j < size bs0{2} by smt(). + by apply H6. + - by rewrite cats1 get_set_sameE oget_some. + - rewrite get_set_sameE oget_some H7 rangeSr. + rewrite !size_map 1:size_ge0. + rewrite (size_map _ (range 0 (size bs0{2}))) size_range /=. + rewrite max_ler 1:size_ge0 map_rcons /=get_set_sameE oget_some; congr. + apply eq_in_map=> j. + rewrite mem_range /==> [] [] hj1 hj2. + by rewrite get_set_neqE //=; smt(). + auto; progress. + + smt(size_out_gt0). + + smt(). + + smt(). + + by rewrite range_geq. + smt(). + qed. + + lemma Sponge_preimage_resistant &m ha : + (DPre.h{m} = ha) => + Pr[SRO.Preimage(A, FM(CSetSize(Sponge), Perm)).main(ha) @ &m : res] <= + (limit ^ 2 - limit)%r / (2 ^ (r + c + 1))%r + + (4 * limit ^ 2)%r / (2 ^ c)%r + + (sigma + 1)%r / (2%r ^ size_out). + proof. + move=>init_ha. + rewrite -(doutE1 ha). + rewrite(preimage_resistant_if_indifferentiable A A_ll (CSetSize(Sponge)) Perm &m ha init_ha). + exists (SimSetSize(Simulator))=>//=; split. + + by move=> F _; proc; inline*; auto. + cut->//:Pr[Indiff0.Indif(CSetSize(Sponge, Perm), Perm, DPre(A)).main() @ &m : res] = + Pr[RealIndif(Sponge, Perm, DRestr(DSetSize(DPre(A)))).main() @ &m : res]. + + byequiv=>//=; proc. + inline DPre(A, CSetSize(Sponge, Perm), Perm).distinguish. + inline SRO.Preimage(A, FInit(CSetSize(Sponge, Perm))).main. + inline DRestr(DSetSize(DPre(A)), Sponge(Perm), Perm).distinguish + DSetSize(DPre(A), FC(Sponge(Perm)), PC(Perm)).distinguish + SRO.Preimage(A, FInit(DFSetSize(FC(Sponge(Perm))))).main. + inline Perm.init CSetSize(Sponge, Perm).init Sponge(Perm).init + FC(Sponge(Perm)).init SRO.Counter.init Cntr.init + SRO.Bounder(FInit(CSetSize(Sponge, Perm))).init + SRO.Bounder(FInit(DFSetSize(FC(Sponge(Perm))))).init + FInit(CSetSize(Sponge, Perm)).init + FInit(DFSetSize(FC(Sponge(Perm)))).init; sp. + wp; sp; sim. + seq 1 1 : (={m, hash, glob DPre, glob SRO.Counter, glob Perm} + /\ invm Perm.m{1} Perm.mi{1} /\ DPre.h{1} = ha + /\ ={c}(SRO.Counter,Cntr)); last first. + - if; auto; sp. + exists* m{1}, SRO.Counter.c{1}; elim* => mess c. + by call(equiv_sponge_perm c mess); auto; smt(). + call(: ={glob SRO.Counter, glob Perm, glob DPre, glob SRO.Bounder} + /\ DPre.h{1} = ha + /\ invm Perm.m{1} Perm.mi{1} /\ ={c}(SRO.Counter,Cntr)). + + proc; sp; if; auto; sp; if; auto; sp. + exists * x{1}; elim* => m c1 c2 b1 b2. + by call(equiv_sponge_perm c1 m); auto; smt(). + auto; progress. + by rewrite /invm=> x y; rewrite 2!emptyE. + cut->//:Pr[Indiff0.Indif(RO, SimSetSize(Simulator, RO), DPre(A)).main() @ &m : res] = + Pr[IdealIndif(BIRO.IRO, Simulator, DRestr(DSetSize(DPre(A)))).main() @ &m : res]. + + byequiv=>//=; proc. + inline Simulator(FGetSize(RO)).init RO.init Simulator(BIRO.IRO).init + BIRO.IRO.init Gconcl_list.BIRO2.IRO.init; sp. + inline DPre(A, RO, Simulator(FGetSize(RO))).distinguish. + inline DRestr(DSetSize(DPre(A)), BIRO.IRO, Simulator(BIRO.IRO)).distinguish + DSetSize(DPre(A), FC(BIRO.IRO), PC(Simulator(BIRO.IRO))).distinguish; wp; sim. + inline SRO.Bounder(FInit(DFSetSize(FC(BIRO.IRO)))).init + SRO.Bounder(FInit(RO)).init SRO.Counter.init FInit(RO).init + FInit(DFSetSize(FC(BIRO.IRO))).init Cntr.init; sp. + inline SRO.Preimage(A, FInit(RO)).main + SRO.Preimage(A, FInit(DFSetSize(FC(BIRO.IRO)))).main. + inline SRO.Counter.init SRO.Bounder(FInit(RO)).init + SRO.Bounder(FInit(DFSetSize(FC(BIRO.IRO)))).init + FInit(RO).init FInit(DFSetSize(FC(BIRO.IRO))).init ; sp; sim. + seq 1 1 : (={m, glob SRO.Counter, glob DPre, hash} + /\ ={c}(SRO.Counter,Cntr) /\ DPre.h{1} = hash{1} + /\ same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2}); last first. + - if; auto; sp. + exists * m{1}, SRO.Counter.c{1}; elim* => mess c. + by call(equiv_ro_iro c mess); auto; smt(). + conseq(:_==> ={m, glob SRO.Counter, glob SRO.Bounder, glob DPre} + /\ ={c}(SRO.Counter,Cntr) + /\ same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2}); progress. + call(: ={glob SRO.Counter, glob SRO.Bounder, glob DPre} + /\ ={c}(SRO.Counter,Cntr) + /\ same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2}); auto. + + proc; sp; if; auto; sp; if; auto; sp. + exists* x{1}; elim* => a c1 c2 b1 b2. + call(equiv_ro_iro c1 a); auto; smt(). + smt(mem_empty). + have->//=:= SHA3Indiff (DSetSize(DPre(A))) &m _. + move=> F P P_f_ll P_fi_ll F_ll; proc; inline*; auto; sp; auto. + seq 1 : true; auto. + + call (A_ll (SRO.Bounder(FInit(DFSetSize(F))))); auto. + by proc; inline*; sp; if; auto; sp; if; auto; sp; call F_ll; auto. + if; auto; sp. + by call F_ll; auto. + qed. + +end section Preimage. + + + +section SecondPreimage. + + declare module A : SRO.AdvSecondPreimage{SRO.RO.RO, SRO.RO.FRO, SRO.Bounder, Perm, + Gconcl_list.BIRO2.IRO, Simulator, Cntr, BIRO.IRO, F.RO, F.FRO, Redo, C, + Gconcl.S, BlockSponge.BIRO.IRO, BlockSponge.C, Gconcl_list.F2.RO, + Gconcl_list.F2.FRO, Gconcl_list.Simulator, D2Pre}. + + axiom A_ll (F <: SRO.Oracle) : islossless F.get => islossless A(F).guess. + + local lemma invm_dom_rng (m mi : (state, state) fmap) : + invm m mi => dom m = rng mi. + proof. + move=>h; rewrite fun_ext=> x; rewrite domE rngE /= eq_iff; have h2 := h x; split. + + move=> m_x_not_None; exists (oget m.[x]); rewrite -h2; move: m_x_not_None. + by case: (m.[x]). + by move=> [] a; rewrite -h2 => ->. + qed. + + local lemma invmC' (m mi : (state, state) fmap) : + invm m mi => invm mi m. + proof. by rewrite /#. qed. + + local lemma invmC (m mi : (state, state) fmap) : + invm m mi <=> invm mi m. + proof. by split;exact invmC'. qed. + + local lemma useful m mi a : + invm m mi => ! a \in m => Distr.is_lossless ((bdistr `*` cdistr) \ rng m). + proof. + move=>hinvm nin_dom. + cut prod_ll:Distr.is_lossless (bdistr `*` cdistr). + + by rewrite dprod_ll DBlock.dunifin_ll DCapacity.dunifin_ll. + apply dexcepted_ll=>//=;rewrite-prod_ll. + cut->:predT = predU (predC (rng m)) (rng m);1:rewrite predCU//=. + rewrite Distr.mu_disjoint 1:predCI//=StdRing.RField.addrC. + cut/=->:=StdOrder.RealOrder.ltr_add2l (mu (bdistr `*` cdistr) (rng m)) 0%r. + rewrite Distr.witness_support/predC. + move:nin_dom;apply absurd=>//=;rewrite negb_exists/==>hyp. + cut{hyp}hyp:forall x, rng m x by smt(supp_dprod DBlock.supp_dunifin DCapacity.supp_dunifin). + move:a. + cut:=eqEcard (fdom m) (frng m);rewrite leq_card_rng_dom/=. + cut->//=:fdom m \subset frng m. + + by move=> x; rewrite mem_fdom mem_frng hyp. + smt(mem_fdom mem_frng). + qed. + + + local equiv equiv_sponge_perm c m : + FInit(CSetSize(Sponge, Perm)).get ~ FInit(DFSetSize(FC(Sponge(Perm)))).get : + ={arg, glob Perm} /\ invm Perm.m{1} Perm.mi{1} /\ + Cntr.c{2} = c /\ arg{2} = m /\ + (Cntr.c + ((size arg + 1) %/ Common.r + 1) + + max ((size_out + Common.r - 1) %/ Common.r - 1) 0 <= limit){2} ==> + ={res, glob Perm} /\ invm Perm.m{1} Perm.mi{1} /\ + Cntr.c{2} = c + ((size m + 1) %/ Common.r + 1) + + max ((size_out + Common.r - 1) %/ Common.r - 1) 0. + proof. + proc; inline FC(Sponge(Perm)).f; sp. + rcondt{2} 1; auto; sp. + call(: ={glob Perm} /\ invm Perm.m{1} Perm.mi{1})=>/=; auto; inline*. + while(={i, n, sa, sc, z, glob Perm} /\ invm Perm.m{1} Perm.mi{1}); auto. + + sp; if; auto; sp; if; auto; progress. + rewrite invm_set //=. + by move:H4; rewrite supp_dexcepted. + sp; conseq(:_==> ={i, n, sa, sc, glob Perm} /\ invm Perm.m{1} Perm.mi{1}); auto. + while(={xs, sa, sc, glob Perm} /\ invm Perm.m{1} Perm.mi{1}); auto. + sp; if; auto; progress. + rewrite invm_set=>//=. + by move:H4; rewrite supp_dexcepted. + qed. + + + clone import Program as Prog2 with + type t <- bool, + op d <- dbool + proof *. + + local equiv equiv_ro_iro c m : + FInit(RO).get ~ FInit(DFSetSize(FC(BIRO.IRO))).get : + ={arg} /\ same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2} /\ + arg{2} = m /\ Cntr.c{2} = c /\ + (Cntr.c + ((size arg + 1) %/ Common.r + 1) + + max ((size_out + Common.r - 1) %/ Common.r - 1) 0 <= limit){2} + ==> ={res} /\ same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2} /\ + Cntr.c{2} = c + ((size m + 1) %/ Common.r + 1) + + max ((size_out + Common.r - 1) %/ Common.r - 1) 0. + proof. + proc; inline *; sp; rcondt{2} 1; 1: auto. + swap{2} 1 5; sp; wp 2 1. + conseq(:_==> oget SRO.RO.RO.m{1}.[x{1}] = oget (of_list bs0{2}) /\ + same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2}); 1:by auto. + rcondt{2} 1; 1: auto. + case: (x{1} \in SRO.RO.RO.m{1}). + + rcondf{1} 2; auto. + exists* BIRO.IRO.mp{2}; elim* => mp. + while{2}(bs0{2} = map (fun j => oget BIRO.IRO.mp{2}.[(x0{2},j)]) (range 0 i{2}) + /\ n0{2} = size_out /\ x0{2} \in SRO.RO.RO.m{1} /\ 0 <= i{2} <= size_out + /\ same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2} /\ BIRO.IRO.mp{2} = mp) + (size_out - i{2}); auto. + - sp; rcondf 1; auto; 1: smt(). + progress. + * have/=<-:= map_rcons (fun (j : int) => oget BIRO.IRO.mp{hr}.[(x0{hr}, j)]) (range 0 i{hr}) i{hr}. + by rewrite !rangeSr //=. + * smt(). + * smt(). + * smt(). + progress. + - by rewrite range_geq. + - smt(size_out_gt0). + - smt(). + - exact(dout_ll). + - have[] h[#] h1 h2 := H. + cut->:i_R = size_out by smt(). + cut<-:=h2 _ H3. + smt(to_listK). + rcondt{1} 2; 1: auto; wp =>/=. + exists* BIRO.IRO.mp{2}; elim* => mp. + conseq(:_==> + same_ro SRO.RO.RO.m{1} mp /\ i{2} = size_out /\ + (forall (l,j), (l,j) \in mp => (l,j) \in BIRO.IRO.mp{2}) /\ + (forall (l,j), (l,j) \in mp => BIRO.IRO.mp{2}.[(l,j)] = mp.[(l,j)]) /\ + (forall (l,j), (l,j) \in BIRO.IRO.mp{2} => (l,j) \in mp \/ (l = x0{2} /\ 0 <= j < i{2})) /\ + (forall j, 0 <= j < i{2} => (x0{2},j) \in BIRO.IRO.mp{2}) /\ + take i{2} (to_list r{1}) = bs0{2} /\ + take i{2} (to_list r{1}) = map (fun (j : int) => oget BIRO.IRO.mp{2}.[(x0{2}, j)]) (range 0 i{2})); progress=>//=. + + by rewrite get_set_sameE /= oget_some; smt(to_listK take_oversize spec_dout). + + move:H8; rewrite mem_set=>[][]//=h; 1:rewrite H3=>//=. + - by have []h1 []h2 h3:= H2; have->//:=h1 _ h. + by move:h => <<-; rewrite H6 //=. + + rewrite mem_set//=; have[]//=h:= H5 _ _ H11; left. + have []h1 []->//=:= H2. + by exists i0=>//=. + + move:H7; rewrite take_oversize 1:spec_dout//= => H7. + move:H10; rewrite mem_set. + case(m \in SRO.RO.RO.m{1})=>//=h. + - rewrite get_set_neqE; 1:smt(). + have []h1 []h2 ->//=:= H2. + by apply eq_in_map=> j;rewrite mem_range=>[][]hj1 hj2/=; rewrite H4//=h1//=. + by move=><<-; rewrite get_set_eqE//=. + alias{1} 1 l = [<:bool>]. + transitivity{1} { + l <@ Sample.sample(size_out); + r <- oget (of_list l); + } + (={glob SRO.RO.RO, x} ==> ={glob SRO.RO.RO, r}) + (x{1} = x0{2} /\ i{2} = 0 /\ n0{2} = size_out /\ mp = BIRO.IRO.mp{2} /\ + same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2} /\ x{1} \notin SRO.RO.RO.m{1} /\ + bs0{2} = [] + ==> + same_ro SRO.RO.RO.m{1} mp /\ i{2} = size_out /\ + (forall (l,j), (l,j) \in mp => (l,j) \in BIRO.IRO.mp{2}) /\ + (forall (l,j), (l,j) \in mp => BIRO.IRO.mp{2}.[(l,j)] = mp.[(l,j)]) /\ + (forall (l,j), (l,j) \in BIRO.IRO.mp{2} => (l,j) \in mp \/ (l = x0{2} /\ 0 <= j < i{2})) /\ + (forall j, 0 <= j < i{2} => (x0{2},j) \in BIRO.IRO.mp{2}) /\ + take i{2} (to_list r{1}) = bs0{2} /\ + take i{2} (to_list r{1}) = + map (fun (j : int) => oget BIRO.IRO.mp{2}.[(x0{2}, j)]) (range 0 i{2})); + progress. + + smt(). + + inline*; sp; wp. + rnd to_list (fun x => oget (of_list x)); auto; progress. + - smt(spec_dout supp_dlist to_listK spec2_dout size_out_gt0). + - rewrite -dout_equal_dlist dmap1E; apply mu_eq=> x/=. + smt(to_listK). + - rewrite-dout_equal_dlist supp_dmap; smt(dout_full). + smt(to_listK). + wp=>/=. + conseq(:_==> i{2} = size_out /\ size l{1} = size_out /\ + (forall (l0 : bool list) (j : int), + (l0, j) \in mp => (l0, j) \in BIRO.IRO.mp{2}) /\ + (forall (l0 : bool list) (j : int), + (l0, j) \in mp => BIRO.IRO.mp{2}.[(l0, j)] = mp.[(l0, j)]) /\ + (forall (l0 : bool list) (j : int), + (l0, j) \in BIRO.IRO.mp{2} => ((l0, j) \in mp) \/ (l0 = x0{2} /\ 0 <= j < i{2})) /\ + (forall (j : int), 0 <= j < i{2} => (x0{2}, j) \in BIRO.IRO.mp{2}) /\ + take i{2} l{1} = bs0{2} /\ + take i{2} l{1} = + map (fun (j : int) => oget BIRO.IRO.mp{2}.[(x0{2}, j)]) (range 0 i{2})); + progress. + + have[]//=h h1:=to_listK (oget (of_list l_L)) l_L; rewrite h1//==> {h1 h}. + smt(spec2_dout). + + have[]//=h h1:=to_listK (oget (of_list l_L)) l_L; rewrite h1//==> {h1 h}. + smt(spec2_dout). + transitivity{1} { + l <@ LoopSnoc.sample(size_out); + } + (={glob SRO.RO.RO} ==> ={glob SRO.RO.RO, l}) + (x{1} = x0{2} /\ i{2} = 0 /\ n0{2} = size_out /\ mp = BIRO.IRO.mp{2} /\ + same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2} /\ x0{2} \notin SRO.RO.RO.m{1} /\ + bs0{2} = [] + ==> + i{2} = size_out /\ size l{1} = size_out /\ + (forall (l,j), (l,j) \in mp => (l,j) \in BIRO.IRO.mp{2}) /\ + (forall (l,j), (l,j) \in mp => BIRO.IRO.mp{2}.[(l,j)] = mp.[(l,j)]) /\ + (forall (l,j), (l,j) \in BIRO.IRO.mp{2} => (l,j) \in mp \/ (l = x0{2} /\ 0 <= j < i{2})) /\ + (forall j, 0 <= j < i{2} => (x0{2},j) \in BIRO.IRO.mp{2}) /\ + take i{2} l{1} = bs0{2} /\ + take i{2} l{1} = + map (fun (j : int) => oget BIRO.IRO.mp{2}.[(x0{2}, j)]) (range 0 i{2})); + progress. + + smt(). + + by call Sample_LoopSnoc_eq; auto. + inline*; sp; wp. + conseq(:_==> i{2} = size_out /\ size l0{1} = i{2} /\ + same_ro SRO.RO.RO.m{1} mp /\ x0{2} \notin SRO.RO.RO.m{1} /\ + (forall l j, (l,j) \in mp => (l,j) \in BIRO.IRO.mp{2}) /\ + (forall l j, (l,j) \in mp => BIRO.IRO.mp{2}.[(l, j)] = mp.[(l, j)]) /\ + (forall l j, (l, j) \in BIRO.IRO.mp{2} => ((l, j) \in mp) \/ (l = x0{2} /\ 0 <= j < i{2})) /\ + (forall j, 0 <= j < i{2} => (x0{2}, j) \in BIRO.IRO.mp{2}) /\ + l0{1} = bs0{2} /\ bs0{2} = + map (fun (j : int) => oget BIRO.IRO.mp{2}.[(x0{2}, j)]) (range 0 i{2})); progress. + + smt(take_oversize). + + smt(take_oversize). + while(0 <= i{2} <= size_out /\ size l0{1} = i{2} /\ n0{2} = size_out /\ + ={i} /\ n{1} = n0{2} /\ + same_ro SRO.RO.RO.m{1} mp /\ x0{2} \notin SRO.RO.RO.m{1} /\ + (forall l j, (l,j) \in mp => (l,j) \in BIRO.IRO.mp{2}) /\ + (forall l j, (l,j) \in mp => BIRO.IRO.mp{2}.[(l, j)] = mp.[(l, j)]) /\ + (forall l j, (l, j) \in BIRO.IRO.mp{2} => ((l, j) \in mp) \/ (l = x0{2} /\ 0 <= j < i{2})) /\ + (forall j, 0 <= j < i{2} => (x0{2}, j) \in BIRO.IRO.mp{2}) /\ + l0{1} = bs0{2} /\ bs0{2} = + map (fun (j : int) => oget BIRO.IRO.mp{2}.[(x0{2}, j)]) (range 0 i{2})). + + sp; wp=> //=. + rcondt{2} 1; 1:auto; progress. + - have[]h1 [] h2 h3 := H1. + have:=h2 x0{hr}; rewrite H2/= negb_exists/= =>/(_ (size bs0{hr})). + rewrite size_ge0 H9/=; apply absurd =>/= h. + by have //=:= H5 _ _ h. + rnd; auto; progress. + - smt(size_ge0). + - smt(). + - by rewrite size_cat/=. + - by rewrite mem_set; left; rewrite H3. + - rewrite get_setE (H4 _ _ H12). + cut/#: !(l1, j) = (x0{2}, size bs0{2}). + move:H2; apply absurd=> //=[#] <<- ->>. + have[] h1 [] h2 h3 := H1. + by apply h2; smt(). + - move:H12; rewrite mem_set. + case((l1, j) \in BIRO.IRO.mp{2})=>//= h; 1: smt(). + by move=> [#] <<- ->> //=; rewrite size_ge0; smt(). + - rewrite mem_set. + case(j = size bs0{2})=>//=. + move=> h; rewrite h /=; have {H13} H13 {h} : j < size bs0{2} by smt(). + by apply H6. + - by rewrite cats1 get_set_sameE oget_some. + - rewrite get_set_sameE oget_some H7 rangeSr. + rewrite !size_map 1:size_ge0. + rewrite (size_map _ (range 0 (size bs0{2}))) size_range /=. + rewrite max_ler 1:size_ge0 map_rcons /=get_set_sameE oget_some; congr. + apply eq_in_map=> j. + rewrite mem_range /==> [] [] hj1 hj2. + by rewrite get_set_neqE //=; smt(). + auto; progress. + + smt(size_out_gt0). + + smt(). + + smt(). + + by rewrite range_geq. + smt(). + qed. + + lemma Sponge_second_preimage_resistant &m mess : + (D2Pre.m2{m} = mess) => + Pr[SRO.SecondPreimage(A, FM(CSetSize(Sponge), Perm)).main(mess) @ &m : res] <= + (limit ^ 2 - limit)%r / (2 ^ (r + c + 1))%r + + (4 * limit ^ 2)%r / (2 ^ c)%r + + (sigma + 1)%r / (2%r ^ size_out). + proof. + move=> init_mess. + rewrite -(doutE1 witness). + rewrite(second_preimage_resistant_if_indifferentiable A A_ll (CSetSize(Sponge)) Perm &m mess init_mess). + exists (SimSetSize(Simulator)); split. + + by move=> F _; proc; inline*; auto. + cut->:Pr[Indiff0.Indif(CSetSize(Sponge, Perm), Perm, D2Pre(A)).main() @ &m : res] = + Pr[RealIndif(Sponge, Perm, DRestr(DSetSize(D2Pre(A)))).main() @ &m : res]. + + byequiv=>//=; proc. + inline Perm.init CSetSize(Sponge, Perm).init Sponge(Perm).init + FC(Sponge(Perm)).init; sp. + inline D2Pre(A, CSetSize(Sponge, Perm), Perm).distinguish. + inline DRestr(DSetSize(D2Pre(A)), Sponge(Perm), Perm).distinguish + DSetSize(D2Pre(A), FC(Sponge(Perm)), PC(Perm)).distinguish Cntr.init. + inline SRO.SecondPreimage(A, FInit(CSetSize(Sponge, Perm))).main + SRO.SecondPreimage(A, FInit(DFSetSize(FC(Sponge(Perm))))).main. + inline SRO.Bounder(FInit(CSetSize(Sponge, Perm))).init + SRO.Bounder(FInit(DFSetSize(FC(Sponge(Perm))))).init + SRO.Counter.init FInit(DFSetSize(FC(Sponge(Perm)))).init + FInit(CSetSize(Sponge, Perm)).init. + wp; sp; sim. + seq 1 1 : (={m1, m2, glob SRO.Counter, glob Perm} + /\ invm Perm.m{1} Perm.mi{1} + /\ ={c}(SRO.Counter,Cntr)); last first. + - if; auto; sp. + case(SRO.Counter.c{1} + ((size m2{1} + 1) %/ r + 1) + + max ((size_out + r - 1) %/ r - 1) 0 < limit); last first. + * rcondf{1} 2; 1: by auto; inline*; auto; conseq(: _ ==> true); auto. + rcondf{2} 2; 1: by auto; inline*; auto; conseq(: _ ==> true); auto. + auto; inline*; auto; sp; conseq(: _ ==> true); auto. + if{2}; sp; auto; sim. + while{1}(invm Perm.m{1} Perm.mi{1}) (((size_out + r - 1) %/ r)-i{1}). + + auto; sp; if; auto. + - sp; if ;auto; progress. + * exact (useful _ _ _ H H2). + * rewrite invm_set=>//=. + by move:H4; rewrite supp_dexcepted. + * smt(). + smt(). + smt(). + conseq(:_==> invm Perm.m{1} Perm.mi{1}); 1:smt(). + while{1}(invm Perm.m{1} Perm.mi{1})(size xs{1}). + + move=> _ z; auto; sp; if; auto; progress. + * exact (useful _ _ _ H H1). + * rewrite invm_set=>//=. + by move:H3; rewrite supp_dexcepted. + * smt(). + smt(). + auto; smt(size_ge0 size_eq0). + rcondt{1} 2; first by auto; inline*; auto; conseq(:_==> true); auto. + rcondt{2} 2; first by auto; inline*; auto; conseq(:_==> true); auto. + sim. + exists* m1{1}, m2{1}; elim* => a1 a2 c1 c2. + call (equiv_sponge_perm (c2 + ((size a1 + 1) %/ r + 1) + max ((size_out + r - 1) %/ r - 1) 0) a2). + auto; call (equiv_sponge_perm c2 a1); auto; progress. + smt(List.size_ge0 divz_ge0 gt0_r). + smt(List.size_ge0 divz_ge0 gt0_r). + call(: ={glob SRO.Counter, glob Perm, glob SRO.Bounder} + /\ invm Perm.m{1} Perm.mi{1} /\ ={c}(SRO.Counter,Cntr)). + + proc; sp; if; auto; sp; if; auto; sp. + exists * x{1}; elim* => m c1 c2 b1 b2. + by call(equiv_sponge_perm c1 m); auto; smt(). + inline*; auto; progress. + by rewrite /invm=> x y; rewrite 2!emptyE. + cut->:Pr[Indiff0.Indif(RO, SimSetSize(Simulator, RO), D2Pre(A)).main() @ &m : res] = + Pr[IdealIndif(BIRO.IRO, Simulator, DRestr(DSetSize(D2Pre(A)))).main() @ &m : res]. + + byequiv=>//=; proc. + inline Simulator(FGetSize(RO)).init RO.init Simulator(BIRO.IRO).init + BIRO.IRO.init Gconcl_list.BIRO2.IRO.init; sp. + inline D2Pre(A, RO, Simulator(FGetSize(RO))).distinguish. + inline DRestr(DSetSize(D2Pre(A)), BIRO.IRO, Simulator(BIRO.IRO)).distinguish + DSetSize(D2Pre(A), FC(BIRO.IRO), PC(Simulator(BIRO.IRO))).distinguish; wp; sim. + inline SRO.Bounder(FInit(DFSetSize(FC(BIRO.IRO)))).init + SRO.Bounder(FInit(RO)).init SRO.Counter.init FInit(RO).init + FInit(DFSetSize(FC(BIRO.IRO))).init Cntr.init; sp. + inline SRO.SecondPreimage(A, FInit(RO)).main + SRO.SecondPreimage(A, FInit(DFSetSize(FC(BIRO.IRO)))).main. + inline SRO.Bounder(FInit(RO)).init + SRO.Bounder(FInit(DFSetSize(FC(BIRO.IRO)))).init SRO.Counter.init + FInit(RO).init FInit(DFSetSize(FC(BIRO.IRO))).init. + sp; sim. + seq 1 1 : (={m1, m2, glob SRO.Counter} + /\ ={c}(SRO.Counter,Cntr) + /\ same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2}); last first. + - if; auto; sp. + case: (SRO.Counter.c{1} + ((size m2{1} + 1) %/ r + 1) + + max ((size_out + r - 1) %/ r - 1) 0 < limit); last first. + * rcondf{1} 2; first by auto; inline*; auto. + rcondf{2} 2; first auto; inline*; auto; sp. + + rcondt 1; first by auto; smt(). + by sp; rcondt 1; auto; conseq(:_==> true); auto. + inline*;sp; auto. + rcondt{2} 1; first by auto; smt(). + conseq(:_==> true); first smt(dout_ll). + sp; rcondt{2} 1; auto; conseq(:_==> true); auto. + by while{2}(true)(n0{2}-i{2}); auto; 1:(sp; if; auto); smt(dbool_ll). + rcondt{1} 2; first by auto; inline*; auto. + rcondt{2} 2; first auto; inline*; auto; sp. + + rcondt 1; first by auto; smt(). + by sp; rcondt 1; auto; conseq(:_==> true); auto. + sim. + exists* m1{1}, m2{1}; elim*=> a1 a2 c1 c2. + call(equiv_ro_iro (c2 + ((size a1 + 1) %/ r + 1) + + max ((size_out + r - 1) %/ r - 1) 0) a2). + auto; call(equiv_ro_iro c2 a1); auto; smt(). + call(: ={glob SRO.Counter, glob SRO.Bounder} /\ ={c}(SRO.Counter,Cntr) + /\ same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2}); auto. + + proc; sp; if; auto; sp; if; auto; sp. + exists* x{1}; elim* => a c1 c2 b1 b2. + call(equiv_ro_iro c1 a); auto; smt(). + smt(mem_empty). + have->//=:= SHA3Indiff (DSetSize(D2Pre(A))) &m _. + move=> F P P_f_ll P_fi_ll F_ll; proc; inline*; auto; sp. + seq 1 : true; auto. + + call (A_ll (SRO.Bounder(FInit(DFSetSize(F))))); auto. + by proc; inline*; sp; if; auto; sp; if; auto; sp; call F_ll; auto. + if; auto; sp. + seq 1 : true; auto. + + by call F_ll; auto. + sp; if; auto; sp; call F_ll; auto. + qed. + +end section SecondPreimage. + + + +section Collision. + + declare module A : SRO.AdvCollision{SRO.RO.RO, SRO.RO.FRO, SRO.Bounder, Perm, + Gconcl_list.BIRO2.IRO, Simulator, Cntr, BIRO.IRO, F.RO, F.FRO, Redo, C, + Gconcl.S, BlockSponge.BIRO.IRO, BlockSponge.C, Gconcl_list.F2.RO, + Gconcl_list.F2.FRO, Gconcl_list.Simulator}. + + axiom A_ll (F <: SRO.Oracle) : islossless F.get => islossless A(F).guess. + + local lemma invm_dom_rng (m mi : (state, state) fmap) : + invm m mi => dom m = rng mi. + proof. + move=>h; rewrite fun_ext=> x; rewrite domE rngE /= eq_iff; have h2 := h x; split. + + move=> m_x_not_None; exists (oget m.[x]); rewrite -h2; move: m_x_not_None. + by case: (m.[x]). + by move=> [] a; rewrite -h2 => ->. + qed. + + local lemma invmC' (m mi : (state, state) fmap) : + invm m mi => invm mi m. + proof. by rewrite /#. qed. + + local lemma invmC (m mi : (state, state) fmap) : + invm m mi <=> invm mi m. + proof. by split;exact invmC'. qed. + + local lemma useful m mi a : + invm m mi => ! a \in m => Distr.is_lossless ((bdistr `*` cdistr) \ rng m). + proof. + move=>hinvm nin_dom. + cut prod_ll:Distr.is_lossless (bdistr `*` cdistr). + + by rewrite dprod_ll DBlock.dunifin_ll DCapacity.dunifin_ll. + apply dexcepted_ll=>//=;rewrite-prod_ll. + cut->:predT = predU (predC (rng m)) (rng m);1:rewrite predCU//=. + rewrite Distr.mu_disjoint 1:predCI//=StdRing.RField.addrC. + cut/=->:=StdOrder.RealOrder.ltr_add2l (mu (bdistr `*` cdistr) (rng m)) 0%r. + rewrite Distr.witness_support/predC. + move:nin_dom;apply absurd=>//=;rewrite negb_exists/==>hyp. + cut{hyp}hyp:forall x, rng m x by smt(supp_dprod DBlock.supp_dunifin DCapacity.supp_dunifin). + move:a. + cut:=eqEcard (fdom m) (frng m);rewrite leq_card_rng_dom/=. + cut->//=:fdom m \subset frng m. + + by move=> x; rewrite mem_fdom mem_frng hyp. + smt(mem_fdom mem_frng). + qed. + + + local equiv equiv_sponge_perm c m : + FInit(CSetSize(Sponge, Perm)).get ~ FInit(DFSetSize(FC(Sponge(Perm)))).get : + ={arg, glob Perm} /\ invm Perm.m{1} Perm.mi{1} /\ + Cntr.c{2} = c /\ arg{2} = m /\ + (Cntr.c + ((size arg + 1) %/ Common.r + 1) + + max ((size_out + Common.r - 1) %/ Common.r - 1) 0 <= limit){2} ==> + ={res, glob Perm} /\ invm Perm.m{1} Perm.mi{1} /\ + Cntr.c{2} = c + ((size m + 1) %/ Common.r + 1) + + max ((size_out + Common.r - 1) %/ Common.r - 1) 0. + proof. + proc; inline FC(Sponge(Perm)).f; sp. + rcondt{2} 1; auto; sp. + call(: ={glob Perm} /\ invm Perm.m{1} Perm.mi{1})=>/=; auto; inline*. + while(={i, n, sa, sc, z, glob Perm} /\ invm Perm.m{1} Perm.mi{1}); auto. + + sp; if; auto; sp; if; auto; progress. + rewrite invm_set //=. + by move:H4; rewrite supp_dexcepted. + sp; conseq(:_==> ={i, n, sa, sc, glob Perm} /\ invm Perm.m{1} Perm.mi{1}); auto. + while(={xs, sa, sc, glob Perm} /\ invm Perm.m{1} Perm.mi{1}); auto. + sp; if; auto; progress. + rewrite invm_set=>//=. + by move:H4; rewrite supp_dexcepted. + qed. + + clone import Program as Prog3 with + type t <- bool, + op d <- dbool + proof *. + + local equiv equiv_ro_iro c m : + FInit(RO).get ~ FInit(DFSetSize(FC(BIRO.IRO))).get : + ={arg} /\ same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2} /\ + arg{2} = m /\ Cntr.c{2} = c /\ + (Cntr.c + ((size arg + 1) %/ Common.r + 1) + + max ((size_out + Common.r - 1) %/ Common.r - 1) 0 <= limit){2} + ==> ={res} /\ same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2} /\ + Cntr.c{2} = c + ((size m + 1) %/ Common.r + 1) + + max ((size_out + Common.r - 1) %/ Common.r - 1) 0. + proof. + proc; inline *; sp; rcondt{2} 1; 1: auto. + swap{2} 1 5; sp; wp 2 1. + conseq(:_==> oget SRO.RO.RO.m{1}.[x{1}] = oget (of_list bs0{2}) /\ + same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2}); 1:by auto. + rcondt{2} 1; 1: auto. + case: (x{1} \in SRO.RO.RO.m{1}). + + rcondf{1} 2; auto. + exists* BIRO.IRO.mp{2}; elim* => mp. + while{2}(bs0{2} = map (fun j => oget BIRO.IRO.mp{2}.[(x0{2},j)]) (range 0 i{2}) + /\ n0{2} = size_out /\ x0{2} \in SRO.RO.RO.m{1} /\ 0 <= i{2} <= size_out + /\ same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2} /\ BIRO.IRO.mp{2} = mp) + (size_out - i{2}); auto. + - sp; rcondf 1; auto; 1: smt(). + progress. + * have/=<-:= map_rcons (fun (j : int) => oget BIRO.IRO.mp{hr}.[(x0{hr}, j)]) (range 0 i{hr}) i{hr}. + by rewrite !rangeSr //=. + * smt(). + * smt(). + * smt(). + progress. + - by rewrite range_geq. + - smt(size_out_gt0). + - smt(). + - exact(dout_ll). + - have[] h[#] h1 h2 := H. + cut->:i_R = size_out by smt(). + cut<-:=h2 _ H3. + smt(to_listK). + rcondt{1} 2; 1: auto; wp =>/=. + exists* BIRO.IRO.mp{2}; elim* => mp. + conseq(:_==> + same_ro SRO.RO.RO.m{1} mp /\ i{2} = size_out /\ + (forall (l,j), (l,j) \in mp => (l,j) \in BIRO.IRO.mp{2}) /\ + (forall (l,j), (l,j) \in mp => BIRO.IRO.mp{2}.[(l,j)] = mp.[(l,j)]) /\ + (forall (l,j), (l,j) \in BIRO.IRO.mp{2} => (l,j) \in mp \/ (l = x0{2} /\ 0 <= j < i{2})) /\ + (forall j, 0 <= j < i{2} => (x0{2},j) \in BIRO.IRO.mp{2}) /\ + take i{2} (to_list r{1}) = bs0{2} /\ + take i{2} (to_list r{1}) = map (fun (j : int) => oget BIRO.IRO.mp{2}.[(x0{2}, j)]) (range 0 i{2})); progress=>//=. + + by rewrite get_set_sameE /= oget_some; smt(to_listK take_oversize spec_dout). + + move:H8; rewrite mem_set=>[][]//=h; 1:rewrite H3=>//=. + - by have []h1 []h2 h3:= H2; have->//:=h1 _ h. + by move:h => <<-; rewrite H6 //=. + + rewrite mem_set //=; have [] //= h:= H5 _ _ H11; left. + have []h1 []->//=:= H2. + by exists i0=>//=. + + move:H7; rewrite take_oversize 1:spec_dout//= => H7. + move:H10; rewrite mem_set. + case(m \in SRO.RO.RO.m{1})=>//=h. + - rewrite get_set_neqE; 1:smt(). + have []h1 []h2 ->//=:= H2. + by apply eq_in_map=> j;rewrite mem_range=>[][]hj1 hj2/=; rewrite H4//=h1//=. + by move=><<-; rewrite get_set_eqE//=. + alias{1} 1 l = [<:bool>]. + transitivity{1} { + l <@ Sample.sample(size_out); + r <- oget (of_list l); + } + (={glob SRO.RO.RO, x} ==> ={glob SRO.RO.RO, r}) + (x{1} = x0{2} /\ i{2} = 0 /\ n0{2} = size_out /\ mp = BIRO.IRO.mp{2} /\ + same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2} /\ x{1} \notin SRO.RO.RO.m{1} /\ + bs0{2} = [] + ==> + same_ro SRO.RO.RO.m{1} mp /\ i{2} = size_out /\ + (forall (l,j), (l,j) \in mp => (l,j) \in BIRO.IRO.mp{2}) /\ + (forall (l,j), (l,j) \in mp => BIRO.IRO.mp{2}.[(l,j)] = mp.[(l,j)]) /\ + (forall (l,j), (l,j) \in BIRO.IRO.mp{2} => (l,j) \in mp \/ (l = x0{2} /\ 0 <= j < i{2})) /\ + (forall j, 0 <= j < i{2} => (x0{2},j) \in BIRO.IRO.mp{2}) /\ + take i{2} (to_list r{1}) = bs0{2} /\ + take i{2} (to_list r{1}) = + map (fun (j : int) => oget BIRO.IRO.mp{2}.[(x0{2}, j)]) (range 0 i{2})); + progress. + + smt(). + + inline*; sp; wp. + rnd to_list (fun x => oget (of_list x)); auto; progress. + - smt(spec_dout supp_dlist to_listK spec2_dout size_out_gt0). + - rewrite -dout_equal_dlist dmap1E; apply mu_eq=> x/=. + smt(to_listK). + - rewrite-dout_equal_dlist supp_dmap; smt(dout_full). + smt(to_listK). + wp=>/=. + conseq(:_==> i{2} = size_out /\ size l{1} = size_out /\ + (forall (l0 : bool list) (j : int), + (l0, j) \in mp => (l0, j) \in BIRO.IRO.mp{2}) /\ + (forall (l0 : bool list) (j : int), + (l0, j) \in mp => BIRO.IRO.mp{2}.[(l0, j)] = mp.[(l0, j)]) /\ + (forall (l0 : bool list) (j : int), + (l0, j) \in BIRO.IRO.mp{2} => ((l0, j) \in mp) \/ (l0 = x0{2} /\ 0 <= j < i{2})) /\ + (forall (j : int), 0 <= j < i{2} => (x0{2}, j) \in BIRO.IRO.mp{2}) /\ + take i{2} l{1} = bs0{2} /\ + take i{2} l{1} = + map (fun (j : int) => oget BIRO.IRO.mp{2}.[(x0{2}, j)]) (range 0 i{2})); + progress. + + have[]//=h h1:=to_listK (oget (of_list l_L)) l_L; rewrite h1//==> {h1 h}. + smt(spec2_dout). + + have[]//=h h1:=to_listK (oget (of_list l_L)) l_L; rewrite h1//==> {h1 h}. + smt(spec2_dout). + transitivity{1} { + l <@ LoopSnoc.sample(size_out); + } + (={glob SRO.RO.RO} ==> ={glob SRO.RO.RO, l}) + (x{1} = x0{2} /\ i{2} = 0 /\ n0{2} = size_out /\ mp = BIRO.IRO.mp{2} /\ + same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2} /\ x0{2} \notin SRO.RO.RO.m{1} /\ + bs0{2} = [] + ==> + i{2} = size_out /\ size l{1} = size_out /\ + (forall (l,j), (l,j) \in mp => (l,j) \in BIRO.IRO.mp{2}) /\ + (forall (l,j), (l,j) \in mp => BIRO.IRO.mp{2}.[(l,j)] = mp.[(l,j)]) /\ + (forall (l,j), (l,j) \in BIRO.IRO.mp{2} => (l,j) \in mp \/ (l = x0{2} /\ 0 <= j < i{2})) /\ + (forall j, 0 <= j < i{2} => (x0{2},j) \in BIRO.IRO.mp{2}) /\ + take i{2} l{1} = bs0{2} /\ + take i{2} l{1} = + map (fun (j : int) => oget BIRO.IRO.mp{2}.[(x0{2}, j)]) (range 0 i{2})); + progress. + + smt(). + + by call Sample_LoopSnoc_eq; auto. + inline*; sp; wp. + conseq(:_==> i{2} = size_out /\ size l0{1} = i{2} /\ + same_ro SRO.RO.RO.m{1} mp /\ x0{2} \notin SRO.RO.RO.m{1} /\ + (forall l j, (l,j) \in mp => (l,j) \in BIRO.IRO.mp{2}) /\ + (forall l j, (l,j) \in mp => BIRO.IRO.mp{2}.[(l, j)] = mp.[(l, j)]) /\ + (forall l j, (l, j) \in BIRO.IRO.mp{2} => ((l, j) \in mp) \/ (l = x0{2} /\ 0 <= j < i{2})) /\ + (forall j, 0 <= j < i{2} => (x0{2}, j) \in BIRO.IRO.mp{2}) /\ + l0{1} = bs0{2} /\ bs0{2} = + map (fun (j : int) => oget BIRO.IRO.mp{2}.[(x0{2}, j)]) (range 0 i{2})); progress. + + smt(take_oversize). + + smt(take_oversize). + while(0 <= i{2} <= size_out /\ size l0{1} = i{2} /\ n0{2} = size_out /\ + ={i} /\ n{1} = n0{2} /\ + same_ro SRO.RO.RO.m{1} mp /\ x0{2} \notin SRO.RO.RO.m{1} /\ + (forall l j, (l,j) \in mp => (l,j) \in BIRO.IRO.mp{2}) /\ + (forall l j, (l,j) \in mp => BIRO.IRO.mp{2}.[(l, j)] = mp.[(l, j)]) /\ + (forall l j, (l, j) \in BIRO.IRO.mp{2} => ((l, j) \in mp) \/ (l = x0{2} /\ 0 <= j < i{2})) /\ + (forall j, 0 <= j < i{2} => (x0{2}, j) \in BIRO.IRO.mp{2}) /\ + l0{1} = bs0{2} /\ bs0{2} = + map (fun (j : int) => oget BIRO.IRO.mp{2}.[(x0{2}, j)]) (range 0 i{2})). + + sp; wp=> //=. + rcondt{2} 1; 1:auto; progress. + - have[]h1 [] h2 h3 := H1. + have:=h2 x0{hr}; rewrite H2/= negb_exists/= =>/(_ (size bs0{hr})). + rewrite size_ge0 H9/=; apply absurd =>/= h. + by have //=:= H5 _ _ h. + rnd; auto; progress. + - smt(size_ge0). + - smt(). + - by rewrite size_cat/=. + - by rewrite mem_set; left; rewrite H3. + - rewrite get_setE (H4 _ _ H12). + cut/#: !(l1, j) = (x0{2}, size bs0{2}). + move:H2; apply absurd=> //=[#] <<- ->>. + have[] h1 [] h2 h3 := H1. + by apply h2; smt(). + - move:H12; rewrite mem_set. + case((l1, j) \in BIRO.IRO.mp{2})=>//= h; 1: smt(). + by move=> [#] <<- ->> //=; rewrite size_ge0; smt(). + - rewrite mem_set. + case(j = size bs0{2})=>//=. + move=> h; rewrite h /=; have {H13} H13 {h} : j < size bs0{2} by smt(). + by apply H6. + - by rewrite cats1 get_set_sameE oget_some. + - rewrite get_set_sameE oget_some H7 rangeSr. + rewrite !size_map 1:size_ge0. + rewrite (size_map _ (range 0 (size bs0{2}))) size_range /=. + rewrite max_ler 1:size_ge0 map_rcons /=get_set_sameE oget_some; congr. + apply eq_in_map=> j. + rewrite mem_range /==> [] [] hj1 hj2. + by rewrite get_set_neqE //=; smt(). + auto; progress. + + smt(size_out_gt0). + + smt(). + + smt(). + + by rewrite range_geq. + smt(). + qed. + + lemma Sponge_coll_resistant &m : + Pr[SRO.Collision(A, FM(CSetSize(Sponge), Perm)).main() @ &m : res] <= + (limit ^ 2 - limit)%r / (2 ^ (r + c + 1))%r + + (4 * limit ^ 2)%r / (2 ^ c)%r + + (sigma * (sigma - 1) + 2)%r / 2%r / (2%r ^ size_out). + proof. + rewrite -(doutE1 witness). + rewrite (coll_resistant_if_indifferentiable A A_ll (CSetSize(Sponge)) Perm &m). + exists (SimSetSize(Simulator)); split. + + by move=> F _; proc; inline*; auto. + cut->:Pr[Indiff0.Indif(CSetSize(Sponge, Perm), Perm, DColl(A)).main() @ &m : res] = + Pr[RealIndif(Sponge, Perm, DRestr(DSetSize(DColl(A)))).main() @ &m : res]. + + byequiv=>//=; proc. + inline Perm.init CSetSize(Sponge, Perm).init Sponge(Perm).init + FC(Sponge(Perm)).init; sp. + inline DColl(A, CSetSize(Sponge, Perm), Perm).distinguish. + inline DRestr(DSetSize(DColl(A)), Sponge(Perm), Perm).distinguish + DSetSize(DColl(A), FC(Sponge(Perm)), PC(Perm)).distinguish Cntr.init; wp; sp; sim. + seq 2 2 : (={m1, m2, glob SRO.Counter, glob Perm} + /\ invm Perm.m{1} Perm.mi{1} + /\ ={c}(SRO.Counter,Cntr)); last first. + - if; auto; sp. + case(SRO.Counter.c{1} + ((size m2{1} + 1) %/ r + 1) + + max ((size_out + r - 1) %/ r - 1) 0 < limit); last first. + * rcondf{1} 2; 1: by auto; inline*; auto; conseq(: _ ==> true); auto. + rcondf{2} 2; 1: by auto; inline*; auto; conseq(: _ ==> true); auto. + auto; inline*; auto; sp; conseq(: _ ==> true); auto. + if{2}; sp; auto; sim. + while{1}(invm Perm.m{1} Perm.mi{1}) (((size_out + r - 1) %/ r)-i{1}). + + auto; sp; if; auto. + - sp; if ;auto; progress. + * exact (useful _ _ _ H H2). + * rewrite invm_set=>//=. + by move:H4; rewrite supp_dexcepted. + * smt(). + smt(). + smt(). + conseq(:_==> invm Perm.m{1} Perm.mi{1}); 1:smt(). + while{1}(invm Perm.m{1} Perm.mi{1})(size xs{1}). + + move=> _ z; auto; sp; if; auto; progress. + * exact (useful _ _ _ H H1). + * rewrite invm_set=>//=. + by move:H3; rewrite supp_dexcepted. + * smt(). + smt(). + auto; smt(size_ge0 size_eq0). + rcondt{1} 2; first by auto; inline*; auto; conseq(:_==> true); auto. + rcondt{2} 2; first by auto; inline*; auto; conseq(:_==> true); auto. + sim. + exists* m1{1}, m2{1}; elim* => a1 a2 c1 c2. + call (equiv_sponge_perm (c2 + ((size a1 + 1) %/ r + 1) + max ((size_out + r - 1) %/ r - 1) 0) a2). + auto; call (equiv_sponge_perm c2 a1); auto; progress. + smt(List.size_ge0 divz_ge0 gt0_r). + smt(List.size_ge0 divz_ge0 gt0_r). + call(: ={glob SRO.Counter, glob Perm, glob SRO.Bounder} + /\ invm Perm.m{1} Perm.mi{1} /\ ={c}(SRO.Counter,Cntr)). + + proc; sp; if; auto; sp; if; auto; sp. + exists * x{1}; elim* => m c1 c2 b1 b2. + by call(equiv_sponge_perm c1 m); auto; smt(). + inline*; auto; progress. + by rewrite /invm=> x y; rewrite 2!emptyE. + cut->:Pr[Indiff0.Indif(RO, SimSetSize(Simulator, RO), DColl(A)).main() @ &m : res] = + Pr[IdealIndif(BIRO.IRO, Simulator, DRestr(DSetSize(DColl(A)))).main() @ &m : res]. + + byequiv=>//=; proc. + inline Simulator(FGetSize(RO)).init RO.init Simulator(BIRO.IRO).init + BIRO.IRO.init Gconcl_list.BIRO2.IRO.init; sp. + inline DColl(A, RO, Simulator(FGetSize(RO))).distinguish. + inline DRestr(DSetSize(DColl(A)), BIRO.IRO, Simulator(BIRO.IRO)).distinguish + DSetSize(DColl(A), FC(BIRO.IRO), PC(Simulator(BIRO.IRO))).distinguish; wp; sim. + inline SRO.Bounder(FInit(DFSetSize(FC(BIRO.IRO)))).init + SRO.Bounder(FInit(RO)).init SRO.Counter.init FInit(RO).init + FInit(DFSetSize(FC(BIRO.IRO))).init Cntr.init; sp. + seq 1 1 : (={m1, m2, glob SRO.Counter} + /\ ={c}(SRO.Counter,Cntr) + /\ same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2}); last first. + - if; auto; sp. + case: (SRO.Counter.c{1} + ((size m2{1} + 1) %/ r + 1) + + max ((size_out + r - 1) %/ r - 1) 0 < limit); last first. + * rcondf{1} 2; first by auto; inline*; auto. + rcondf{2} 2; first auto; inline*; auto; sp. + + rcondt 1; first by auto; smt(). + by sp; rcondt 1; auto; conseq(:_==> true); auto. + inline*;sp; auto. + rcondt{2} 1; first by auto; smt(). + conseq(:_==> true); first smt(dout_ll). + sp; rcondt{2} 1; auto; conseq(:_==> true); auto. + by while{2}(true)(n0{2}-i{2}); auto; 1:(sp; if; auto); smt(dbool_ll). + rcondt{1} 2; first by auto; inline*; auto. + rcondt{2} 2; first auto; inline*; auto; sp. + + rcondt 1; first by auto; smt(). + by sp; rcondt 1; auto; conseq(:_==> true); auto. + sim. + exists* m1{1}, m2{1}; elim*=> a1 a2 c1 c2. + call(equiv_ro_iro (c2 + ((size a1 + 1) %/ r + 1) + + max ((size_out + r - 1) %/ r - 1) 0) a2). + auto; call(equiv_ro_iro c2 a1); auto; smt(). + call(: ={glob SRO.Counter, glob SRO.Bounder} /\ ={c}(SRO.Counter,Cntr) + /\ same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2}); auto. + + proc; sp; if; auto; sp; if; auto; sp. + exists* x{1}; elim* => a c1 c2 b1 b2. + call(equiv_ro_iro c1 a); auto; smt(). + smt(mem_empty). + have->//=:= SHA3Indiff (DSetSize(DColl(A))) &m _. + move=> F P P_f_ll P_fi_ll F_ll; proc; inline*; auto; sp. + seq 1 : true; auto. + + call (A_ll (SRO.Bounder(FInit(DFSetSize(F))))); auto. + by proc; inline*; sp; if; auto; sp; if; auto; sp; call F_ll; auto. + if; auto; sp. + seq 1 : true; auto. + + by call F_ll; auto. + sp; if; auto; sp; call F_ll; auto. + qed. + +end section Collision. + +module X (F : SRO.Oracle) = { + proc get (bl : bool list) = { + var r; + r <@ F.get(bl ++ [ false ; true ]); + return r; + } +}. + +module AdvCollisionSHA3 (A : SRO.AdvCollision) (F : SRO.Oracle) = { + proc guess () = { + var m1, m2; + (m1, m2) <@ A(X(F)).guess(); + return (m1 ++ [ false ; true ], m2 ++ [ false ; true ]); + } +}. + +section SHA3_Collision. + + declare module A : SRO.AdvCollision{SRO.RO.RO, SRO.RO.FRO, SRO.Bounder, Perm, + Gconcl_list.BIRO2.IRO, Simulator, Cntr, BIRO.IRO, F.RO, F.FRO, Redo, C, + Gconcl.S, BlockSponge.BIRO.IRO, BlockSponge.C, Gconcl_list.F2.RO, + Gconcl_list.F2.FRO, Gconcl_list.Simulator}. + + axiom A_ll (F <: SRO.Oracle) : islossless F.get => islossless A(F).guess. + + lemma SHA3_coll_resistant &m : + Pr[SRO.Collision(AdvCollisionSHA3(A), FM(CSetSize(Sponge), Perm)).main() @ &m : res] <= + (limit ^ 2 - limit)%r / (2 ^ (r + c + 1))%r + + (4 * limit ^ 2)%r / (2 ^ c)%r + + (sigma * (sigma - 1) + 2)%r / 2%r / (2%r ^ size_out). + proof. + apply (Sponge_coll_resistant (AdvCollisionSHA3(A)) _ &m). + by move=> F F_ll; proc; inline*; call(A_ll (X(F))); auto; proc; call F_ll; auto. + qed. + + +end section Collision. \ No newline at end of file diff --git a/proof/SecureHash.eca b/proof/SecureHash.eca new file mode 100644 index 0000000..d29ccf4 --- /dev/null +++ b/proof/SecureHash.eca @@ -0,0 +1,148 @@ +require import Int Real SmtMap FSet Distr. +require (****) OptionIndifferentiability. + +type from, to, block. + + +clone import OptionIndifferentiability as OIndif with + type p <- block, + type f_in <- from, + type f_out <- to +proof *. + + +op sampleto : to distr. + +op bound : int. +axiom bound_ge0 : 0 <= bound. + +axiom sampleto_ll: is_lossless sampleto. +axiom sampleto_full: is_full sampleto. +axiom sampleto_fu: is_funiform sampleto. + +(* clone import PROM.GenEager as RO with *) +(* type from <- from, *) +(* type to <- to, *) +(* op sampleto <- fun _ => sampleto *) +(* proof * by exact/sampleto_ll. *) + +op increase_counter (c : int) (m : from) : int. +axiom increase_counter_spec c m : c <= increase_counter c m. + +print OIndif. + +(* module type RF = { *) +(* proc init() : unit *) +(* proc get(x : from) : to option *) +(* proc sample (x: from) : unit *) +(* }. *) + +(* module RF (R : RO) : RF = { *) +(* proc init = R.init *) +(* proc get (x : from) : to option = { *) +(* var y; *) +(* y <@ R.get(x); *) +(* return Some y; *) +(* } *) +(* proc sample = R.sample *) +(* }. *) + +module Bounder = { + var bounder : int + proc init () = { + bounder <- 0; + } +}. + +module FBounder (F : OFUNCTIONALITY) : OFUNCTIONALITY = { + proc init () : unit = { + Bounder.init(); + F.init(); + } + proc f(x : from) : to option = { + var y : to option <- None; + if (increase_counter Bounder.bounder x <= bound) { + Bounder.bounder <- increase_counter Bounder.bounder x; + y <- F.f(x); + } + return y; + } +}. + + +module PBounder (P : OPRIMITIVE) : OPRIMITIVE = { + proc init () = { + P.init(); + Bounder.init(); + } + proc f (x : block) : block option = { + var y <- None; + if (Bounder.bounder < bound) { + y <- P.f(x); + Bounder.bounder <- Bounder.bounder + 1; + } + return y; + } + proc fi (x : block) : block option = { + var y <- None; + if (Bounder.bounder < bound) { + y <- P.fi(x); + Bounder.bounder <- Bounder.bounder + 1; + } + return y; + } +}. + +module type AdvPreimage (F : ODFUNCTIONALITY) (P : ODPRIMITIVE) = { + proc guess(h : to) : from +}. + +module Preimage (A : AdvPreimage, F : OCONSTRUCTION, P : OPRIMITIVE) = { + proc main () : bool = { + var m,hash,hash'; + hash <$ sampleto; + PBounder(P).init(); + FBounder(F(P)).init(); + m <@ A(FBounder(F(P)),PBounder(P)).guess(hash); + hash' <@ FBounder(F(P)).f(m); + return hash' = Some hash; + } +}. + + +(*-------------------------------------------------------------------------*) +module type AdvSecondPreimage (F : ODFUNCTIONALITY) (P : ODPRIMITIVE) = { + proc guess(m : from) : from +}. + +module SecondPreimage (A : AdvSecondPreimage, F : OCONSTRUCTION, P : OPRIMITIVE) = { + proc main (m1 : from) : bool = { + var m2, hash1, hash2; + PBounder(P).init(); + FBounder(F(P)).init(); + m2 <@ A(FBounder(F(P)),PBounder(P)).guess(m1); + hash1 <@ FBounder(F(P)).f(m1); + hash2 <@ FBounder(F(P)).f(m2); + return m1 <> m2 /\ exists y, Some y = hash1 /\ Some y = hash2; + } +}. + + +(*--------------------------------------------------------------------------*) +module type AdvCollision (F : ODFUNCTIONALITY) (P : ODPRIMITIVE) = { + proc guess() : from * from +}. + +module Collision (A : AdvCollision, F : OCONSTRUCTION, P : OPRIMITIVE) = { + proc main () : bool = { + var m1,m2,hash1,hash2; + PBounder(P).init(); + FBounder(F(P)).init(); + (m1,m2) <@ A(FBounder(F(P)),PBounder(P)).guess(); + hash1 <@ FBounder(F(P)).f(m1); + hash2 <@ FBounder(F(P)).f(m2); + return m1 <> m2 /\ exists y, Some y = hash1 /\ Some y = hash2; + } +}. + + From 824a227bf8704cfda639ee0d0da6adaf0a7b0585 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Thu, 22 Aug 2019 06:53:03 +0200 Subject: [PATCH 462/525] Security proof in the random permutation model proof should be done by tomorrow (or the day after) --- proof/SHA3OSecurity.ec | 230 ++++++++++++++++++++++++++++++++++++++--- 1 file changed, 217 insertions(+), 13 deletions(-) diff --git a/proof/SHA3OSecurity.ec b/proof/SHA3OSecurity.ec index 2dfc615..b32aec8 100644 --- a/proof/SHA3OSecurity.ec +++ b/proof/SHA3OSecurity.ec @@ -173,6 +173,11 @@ module (OSponge : OIndif.OCONSTRUCTION) (P : OIndif.ODPRIMITIVE) = section Preimage. (* TODO : stopped here *) + declare module A : SH.AdvPreimage { Perm, Counter, Bounder, F.RO, F.FRO, + Redo, C, Gconcl.S, BlockSponge.BIRO.IRO, BlockSponge.C, BIRO.IRO, + Gconcl_list.BIRO2.IRO, Gconcl_list.F2.RO, Gconcl_list.F2.FRO, + Gconcl_list.Simulator, SHA3Indiff.Simulator, SHA3Indiff.Cntr, + SORO.Bounder, RO.RO }. local module FInit (F : OIndif.ODFUNCTIONALITY) : OIndif.OFUNCTIONALITY = { proc init () = {} @@ -195,16 +200,217 @@ section Preimage. } }. -local lemma leq_ideal &m - (A <: SH.AdvPreimage { Perm, Counter, Bounder, F.RO, F.FRO, Redo, C, Gconcl.S, - BlockSponge.BIRO.IRO, BlockSponge.C, BIRO.IRO, Gconcl_list.BIRO2.IRO, - Gconcl_list.F2.RO, Gconcl_list.F2.FRO, Gconcl_list.Simulator, - SHA3Indiff.Simulator, SHA3Indiff.Cntr }): + +local module OF (F : Oracle) : OIndif.ODFUNCTIONALITY = { + proc f = F.get +}. + + +local module Log = { + var m : (bool list * int, bool) fmap +}. + +local module ExtendOutputSize (F : Oracle) : ODFUNCTIONALITY = { + proc f (x : bool list, k : int) = { + var o, l, prefix, suffix, i; + l <- None; + i <- 0; + prefix <- []; + suffix <- []; + o <@ F.get(x); + if (o <> None) { + prefix <- take k (to_list (oget o)); + i <- size_out; + } + while (i < k) { + if ((x,i) \notin Log.m) { + Log.m.[(x,i)] <$ {0,1}; + } + suffix <- rcons suffix (oget Log.m.[(x,i)]); + i <- i + 1; + } + l <- Some (prefix ++ suffix); + return l; + } +}. + +local module OFC2 (F : Oracle) = OFC(ExtendOutputSize(F)). + + +local module (SORO_P1 (A : SH.AdvPreimage) : SORO.AdvPreimage) (F : Oracle) = { + proc guess (h : f_out) : bool list = { + var mi; + Log.m <- empty; + Counter.c <- 0; + OSimulator(ExtendOutputSize(F)).init(); + mi <@ A(DFSetSize(OFC2(F)),OPC(OSimulator(ExtendOutputSize(F)))).guess(h); + return mi; + } +}. + +local module RFList = { + var m : (bool list, f_out) fmap + proc init () = { + m <- empty; + } + proc get (x : bool list) : f_out option = { + var z; + if (x \notin m) { + z <$ dlist dbool size_out; + m.[x] <- oget (of_list z); + } + return m.[x]; + } + proc sample (x: bool list) = {} +}. + +local module RFWhile = { + proc init () = { + RFList.m <- empty; + } + proc get (x : bool list) : f_out option = { + var l, i, b; + if (x \notin RFList.m) { + i <- 0; + l <- []; + while (i < size_out) { + b <$ dbool; + l <- rcons l b; + i <- i + 1; + } + RFList.m.[x] <- oget (of_list l); + } + return RFList.m.[x]; + } + proc sample (x: bool list) = {} +}. + +module type TOTO (F : Oracle) = { + proc main () : bool +}. + +clone import Program as PBool with + type t <- bool, + op d <- dbool +proof *. + + +local equiv rw_RF_List_While : + RFList.get ~ RFWhile.get : + ={arg, glob RFList} ==> ={res, glob RFWhile}. +proof. +proc; if; 1, 3: auto; wp. +conseq(:_==> z{1} = l{2})=> />. +transitivity{1} { + z <@ Sample.sample(size_out); + } + (true ==> ={z}) + (true ==> z{1} = l{2})=>/>. ++ by inline*; auto. +transitivity{1} { + z <@ LoopSnoc.sample(size_out); + } + (true ==> ={z}) + (true ==> z{1} = l{2})=>/>; last first. ++ inline*; auto; sim. + by while(={l, i} /\ n{1} = size_out); auto; smt(cats1). +by call(Sample_LoopSnoc_eq); auto. +qed. + + +local lemma rw_ideal_2 &m: + Pr[SHA3_OIndiff.OIndif.OIndif(FSome(BIRO.IRO), OSimulator(FSome(BIRO.IRO)), + ODRestr(Dist_of_P1Adv(A))).main() @ &m : res] <= + Pr[SORO.Preimage(SORO_P1(A), RFList).main() @ &m : res]. +proof. +have->:Pr[SORO.Preimage(SORO_P1(A), RFList).main() @ &m : res] = + Pr[SORO.Preimage(SORO_P1(A), RFWhile).main() @ &m : res]. ++ byequiv(: ={glob A} ==> _)=>//=; proc. + swap 1. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 2; inline{2} 2; sp. + swap[1..2] 3; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 5; inline{2} 5; wp. + seq 3 3 : (={mi, h, hash, glob A, glob SORO.Bounder, glob RFList}); last first. + - sp; if; auto; call(rw_RF_List_While); auto. + call(: ={glob SORO.Bounder, glob RFList, glob OSimulator, glob OPC, glob Log}); auto. + - proc; sp; if; auto. + inline{1} 1; inline{2} 1; sp; if; 1, 3: auto; sim. + if; 1: auto; sim; sp; sim; if; auto=> />; 1: smt(); sim. + + inline{1} 1; inline{2} 1; sp; sim. + inline{1} 1; inline{2} 1; sp; if; auto=> />. + - by call(rw_RF_List_While); auto; smt(). + smt(). + smt(). + - by sim. + proc; sim; inline{1} 1; inline{2} 1; sp; if; auto. + inline{1} 1; inline{2} 1; sp; sim. + inline{1} 1; inline{2} 1; sp; if; auto; sim. + by call(rw_RF_List_While); auto. +(* TODO : reprendre ici, avec le spit des domaines *) + + +qed. + +local lemma rw_ideal &m: + Pr[SHA3_OIndiff.OIndif.OIndif(FSome(BIRO.IRO), OSimulator(FSome(BIRO.IRO)), + ODRestr(Dist_of_P1Adv(A))).main() @ &m : res] <= + Pr[SORO.Preimage(SORO_P1(A),RF(RO.RO)).main() @ &m : res]. +proof. +rewrite (StdOrder.RealOrder.ler_trans _ _ _ (rw_ideal_2 &m)). +byequiv(: ={glob A} ==> _) => //=; proc; inline*; sp; wp. +swap{2} 2; sp; swap{2}[1..2] 6; sp. +swap{1} 2; sp; swap{1}[1..2] 6; sp. +seq 2 2 : ( + Log.m{1} = empty /\ + SHA3Indiff.Simulator.m{1} = empty /\ + SHA3Indiff.Simulator.mi{1} = empty /\ + SHA3Indiff.Simulator.paths{1} = empty.[c0 <- ([], b0)] /\ + Gconcl_list.BIRO2.IRO.mp{1} = empty /\ + SORO.Bounder.bounder{1} = 0 /\ + RFList.m{1} = empty /\ + Counter.c{2} = 0 /\ + ={Log.m, glob SHA3Indiff.Simulator, glob SORO.Bounder, glob Counter} /\ + RO.RO.m{2} = empty /\ ={glob A, h, hash}); 1: auto=> />. +seq 1 1 : (={glob A, glob SHA3Indiff.Simulator, glob SORO.Bounder, glob Counter, + mi, h, hash} /\ RFList.m{1} = RO.RO.m{2}). ++ call(: ={glob SHA3Indiff.Simulator, glob SORO.Bounder, glob Counter} /\ + RFList.m{1} = RO.RO.m{2}); auto. + - admit. + - admit. + - admit. +sp; if; 1, 3: auto; sp; wp 1 2. +if{1}. ++ wp=> />. + rnd (fun x => oget (of_list x)) to_list; auto=> />. + move=> &l c Hc Hnin; split. + - move=> ret Hret. search to_list. + by have/= ->:= (to_listK ret (to_list ret)). + move=> h{h}; split. + - move=> ret Hret; rewrite -dout_equal_dlist. + rewrite dmapE /=; apply mu_eq=> //= x /=. + by rewrite /(\o) /pred1/=; smt(to_list_inj). + move=> h{h} l Hl. + rewrite dout_full /=. + have:= spec2_dout l. + have:=supp_dlist dbool size_out l _; 1: smt(size_out_gt0). + rewrite Hl/==> [#] -> h{h} /= H. + have H1:=some_oget _ H. + have:=to_listK (oget (of_list l)) l; rewrite {2}H1/= => -> /= {H H1}. + by rewrite get_setE/=. +by auto=> />; smt(dout_ll). +qed. + + +local lemma leq_ideal &m : Pr[SHA3_OIndiff.OIndif.OIndif(FSome(BIRO.IRO), OSimulator(FSome(BIRO.IRO)), ODRestr(Dist_of_P1Adv(A))).main() @ &m : res] <= (sigma + 1)%r / 2%r ^ size_out. proof. -print SORO. -print SORO.RO_is_preimage_resistant. +print SORO.RO_is_preimage_resistant. +have:=rw_ideal &m. admit. qed. @@ -225,11 +431,7 @@ qed. by sp; if; auto=>/=; sim; auto. qed. -lemma Sponge_preimage_resistant &m - (A <: SH.AdvPreimage { Perm, Counter, Bounder, F.RO, F.FRO, Redo, C, Gconcl.S, - BlockSponge.BIRO.IRO, BlockSponge.C, BIRO.IRO, Gconcl_list.BIRO2.IRO, - Gconcl_list.F2.RO, Gconcl_list.F2.FRO, Gconcl_list.Simulator, - SHA3Indiff.Simulator, SHA3Indiff.Cntr }): +lemma Sponge_preimage_resistant &m: (forall (F <: OIndif.ODFUNCTIONALITY) (P <: OIndif.ODPRIMITIVE), islossless F.f => islossless P.f => islossless P.fi => islossless A(F,P).guess) => Pr[Preimage(A, OSponge, PSome(Perm)).main() @ &m : res] <= @@ -244,10 +446,12 @@ have := SHA3OIndiff (Dist_of_P1Adv(A)) &m _. call(A_ll (DFSetSize(F)) P _ Hp Hpi); auto. - proc; inline*; auto; call Hf; auto. smt(dout_ll). -by have/#:=leq_ideal &m A. +by have/#:=leq_ideal &m. qed. +(* old proof *) + declare module A : SH.AdvPreimage{SRO.RO.RO, SRO.RO.FRO, SRO.Bounder, Perm, Gconcl_list.BIRO2.IRO, Simulator, Cntr, BIRO.IRO, F.RO, F.FRO, Redo, C, Gconcl.S, BlockSponge.BIRO.IRO, BlockSponge.C, Gconcl_list.F2.RO, From 6339232c85db6c1665cbea948b227789eab988d5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Mon, 26 Aug 2019 11:58:20 +0200 Subject: [PATCH 463/525] . --- proof/SHA3OSecurity.ec | 103 ++++++++++++++++++++++++++++++++++++++++- 1 file changed, 102 insertions(+), 1 deletion(-) diff --git a/proof/SHA3OSecurity.ec b/proof/SHA3OSecurity.ec index b32aec8..8edd997 100644 --- a/proof/SHA3OSecurity.ec +++ b/proof/SHA3OSecurity.ec @@ -318,6 +318,83 @@ by call(Sample_LoopSnoc_eq); auto. qed. +op inv (m1 : (bool list * int, bool) fmap) (m2 : (bool list, f_out) fmap) = + (forall l i, (l,i) \in m1 => 0 <= i < size_out) /\ + (forall l i, (l,i) \in m1 => l \in m2) /\ + (forall l, l \in m2 => forall i, 0 <= i < size_out => (l,i) \in m1) /\ + (forall l i, (l,i) \in m1 => m1.[(l,i)] = Some (nth witness (to_list (oget m2.[l])) i)). + +local equiv eq_IRO_RFWhile : + BIRO.IRO.f ~ RFWhile.get : + arg{1} = (x{2}, size_out) /\ inv BIRO.IRO.mp{1} RFList.m{2} + ==> + res{2} = of_list res{1} /\ inv BIRO.IRO.mp{1} RFList.m{2}. +proof. +proc; inline*; sp. +rcondt{1} 1; 1: by auto. +if{2}; sp; last first. ++ alias{1} 1 mp = BIRO.IRO.mp. + conseq(:_==> BIRO.IRO.mp{1} = mp{1} /\ size bs{1} = i{1} /\ i{1} = size_out /\ + inv mp{1} RFList.m{2} /\ + bs{1} = take i{1} (to_list (oget RFList.m{2}.[x{1}])))=> />. + - move=> &l &r 11?. + rewrite take_oversize 1:spec_dout 1:H4 //. + rewrite eq_sym to_listK => ->. + by have:=H3; rewrite domE; smt(). + - smt(take_oversize spec_dout). + while{1}(BIRO.IRO.mp{1} = mp{1} /\ size bs{1} = i{1} /\ + 0 <= i{1} <= size_out /\ n{1} = size_out /\ + inv mp{1} RFList.m{2} /\ x{1} \in RFList.m{2} /\ + bs{1} = take i{1} (to_list (oget RFList.m{2}.[x{1}])))(size_out - i{1}); + auto=> />. + + sp; rcondf 1; auto=> />; 1: smt(). + move=> &h 8?. + rewrite size_rcons //=; do!split; 1, 2, 4: smt(size_ge0). + rewrite (take_nth witness) 1:spec_dout 1:size_ge0//=. + rewrite - H6; congr; rewrite H4=> //=. + by apply H3=> //=. + smt(size_out_gt0 size_ge0 take0). +auto=> //=. +conseq(:_==> l{2} = bs{1} /\ size bs{1} = i{1} /\ i{1} = n{1} /\ n{1} = size_out /\ + inv BIRO.IRO.mp{1} RFList.m{2}.[x{2} <- oget (of_list l{2})])=> />. ++ smt(get_setE spec2_dout). ++ smt(get_setE spec2_dout). +alias{1} 1 m = BIRO.IRO.mp; sp. +conseq(:_==> l{2} = bs{1} /\ size bs{1} = i{1} /\ i{1} = n{1} /\ + n{1} = size_out /\ inv m{1} RFList.m{2} /\ + (forall j, (x{1}, j) \in BIRO.IRO.mp{1} => 0 <= j < i{1}) /\ + (forall l j, l <> x{1} => m{1}.[(l,j)] = BIRO.IRO.mp{1}.[(l,j)]) /\ + (forall j, 0 <= j < i{1} => (x{1}, j) \in BIRO.IRO.mp{1}) /\ + (forall j, 0 <= j < i{1} => BIRO.IRO.mp{1}.[(x{1},j)] = Some (nth witness bs{1} j))). ++ move=> /> &l &r 11?; do!split; ..-2 : smt(domE mem_set). + move=> l j Hin. + rewrite get_setE/=. + case: (l = x{r}) => [<<-|]. + - rewrite oget_some H8; 1:smt(); congr; congr. + by rewrite eq_sym to_listK; smt(spec2_dout). + move=> Hneq. + by rewrite -(H6 _ _ Hneq) H2; smt(domE). +while(l{2} = bs{1} /\ size bs{1} = i{1} /\ 0 <= i{1} <= n{1} /\ ={i} /\ + n{1} = size_out /\ inv m{1} RFList.m{2} /\ + (forall j, (x{1}, j) \in BIRO.IRO.mp{1} => 0 <= j < i{1}) /\ + (forall l j, l <> x{1} => m{1}.[(l,j)] = BIRO.IRO.mp{1}.[(l,j)]) /\ + (forall j, 0 <= j < i{1} => (x{1}, j) \in BIRO.IRO.mp{1}) /\ + (forall j, 0 <= j < i{1} => BIRO.IRO.mp{1}.[(x{1},j)] = Some (nth witness bs{1} j))). ++ sp; rcondt{1} 1; auto=> />. + - smt(). + move=> &l &r 13?. + rewrite get_setE/=oget_some/=size_rcons/=; do!split; 1,2: smt(size_ge0). + - smt(mem_set). + - smt(get_setE). + - smt(mem_set). + - move=>j Hj0 Hjsize; rewrite get_setE/=nth_rcons. + case: (j = size bs{l})=>[->>//=|h]. + have/=Hjs:j < size bs{l} by smt(). + by rewrite Hjs/=H8//=. +by auto; smt(size_out_gt0). +qed. + + local lemma rw_ideal_2 &m: Pr[SHA3_OIndiff.OIndif.OIndif(FSome(BIRO.IRO), OSimulator(FSome(BIRO.IRO)), ODRestr(Dist_of_P1Adv(A))).main() @ &m : res] <= @@ -350,7 +427,31 @@ have->:Pr[SORO.Preimage(SORO_P1(A), RFList).main() @ &m : res] = inline{1} 1; inline{2} 1; sp; sim. inline{1} 1; inline{2} 1; sp; if; auto; sim. by call(rw_RF_List_While); auto. -(* TODO : reprendre ici, avec le spit des domaines *) +byequiv=> //=; proc. +inline{1} 1; inline{2} 2; sp. +inline{1} 1; inline{2} 3; swap{2}[1..2]1; sp. +inline{1} 1; inline{2} 3; sp. +inline{1} 1; sp. +inline{1} 1; sp. +swap{2} 1 1; sp; swap{2}[1..2]3; sp. +inline{1} 1; sp; auto. +seq 2 5 : (={glob A, glob OSimulator, glob Counter, hash, m} /\ + inv BIRO.IRO.mp{1} RFList.m{2} /\ + SORO.Bounder.bounder{2} <= Counter.c{1}); last first. ++ inline{1} 1; inline{2} 1; sp; inline{1} 1; sp; auto. + if{1}; sp; last first. + - conseq(:_==> true)=> />. + inline*; if{2}; auto; sp; if{2}; auto. + by while{2}(true)(size_out - i{2}); auto=>/>; smt(dbool_ll). + rcondt{2} 1; 1: by auto=> />; smt(divz_ge0 gt0_r size_ge0). + inline{1} 1; sp; auto. + auto; call(eq_IRO_RFWhile); auto. +auto; call(: ={glob OSimulator, glob Counter} /\ inv BIRO.IRO.mp{1} RFList.m{2} /\ + SORO.Bounder.bounder{2} <= Counter.c{1}); auto=> />. ++ smt(). ++ proc; sp; if; auto=> />; 2: smt(); inline{1} 1; inline{2} 1; sp; auto. + if; 1, 3: auto; -1: smt(). + (* TODO : reprendre ici, avec le spit des domaines *) qed. From 4895709170be7fb3a5459fb897b0e2553402ae7a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Mon, 26 Aug 2019 13:27:11 +0200 Subject: [PATCH 464/525] . --- proof/SHA3OSecurity.ec | 76 ++++++++++++++++++++++++++++++++++++------ 1 file changed, 65 insertions(+), 11 deletions(-) diff --git a/proof/SHA3OSecurity.ec b/proof/SHA3OSecurity.ec index 8edd997..1a5efb2 100644 --- a/proof/SHA3OSecurity.ec +++ b/proof/SHA3OSecurity.ec @@ -146,6 +146,7 @@ module FSetSize (F : OFUNCTIONALITY) : OIndif.OFUNCTIONALITY = { r <- (y <> None) ? of_list (oget y) : None; return r; } + proc get = f }. module DFSetSize (F : ODFUNCTIONALITY) : OIndif.OFUNCTIONALITY = { @@ -190,16 +191,6 @@ section Preimage. proc fi = P.fi }. - local module (Dist_of_P1Adv (A : SH.AdvPreimage) : ODISTINGUISHER) (F : ODFUNCTIONALITY) (P : ODPRIMITIVE) = { - proc distinguish () = { - var hash, hash', m; - hash <$ dout; - m <@ A(DFSetSize(F),P).guess(hash); - hash' <@ DFSetSize(F).f(m); - return hash' = Some hash; - } - }. - local module OF (F : Oracle) : OIndif.ODFUNCTIONALITY = { proc f = F.get @@ -235,6 +226,26 @@ local module ExtendOutputSize (F : Oracle) : ODFUNCTIONALITY = { }. local module OFC2 (F : Oracle) = OFC(ExtendOutputSize(F)). + +local module ExtendOutput (F : RF) = { + proc init () = { + Log.m <- empty; + F.init(); + } + proc f = ExtendOutputSize(F).f + proc get = f +}. + + local module (Dist_of_P1Adv (A : SH.AdvPreimage) : ODISTINGUISHER) (F : ODFUNCTIONALITY) (P : ODPRIMITIVE) = { + proc distinguish () = { + var hash, hash', m; + Log.m <- empty; + hash <$ dout; + m <@ A(DFSetSize(F),P).guess(hash); + hash' <@ DFSetSize(F).f(m); + return hash' = Some hash; + } + }. local module (SORO_P1 (A : SH.AdvPreimage) : SORO.AdvPreimage) (F : Oracle) = { @@ -394,6 +405,22 @@ while(l{2} = bs{1} /\ size bs{1} = i{1} /\ 0 <= i{1} <= n{1} /\ ={i} /\ by auto; smt(size_out_gt0). qed. +op eq_extend_size (m1 : (bool list * int, bool) fmap) (m2 : (bool list * int, bool) fmap) + (m3 : (bool list * int, bool) fmap) = + (forall x j, 0 <= j < size_out => m1.[(x,j)] = m2.[(x,j)]) /\ + (forall x j, size_out <= j => m1.[(x,j)] = m3.[(x,j)]) /\ + (forall x j, (x,j) \in m1 => 0 <= j). + + +local equiv eq_extend : + FSome(BIRO.IRO).f ~ ExtendOutputSize(FSetSize(FSome(BIRO.IRO))).f : + ={arg} /\ eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2} ==> + ={res} /\ eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}. +proof. +proc; inline*; auto; sp. +rcondt{1} 1; auto; rcondt{2} 1; auto. +qed. + local lemma rw_ideal_2 &m: Pr[SHA3_OIndiff.OIndif.OIndif(FSome(BIRO.IRO), OSimulator(FSome(BIRO.IRO)), @@ -427,6 +454,32 @@ have->:Pr[SORO.Preimage(SORO_P1(A), RFList).main() @ &m : res] = inline{1} 1; inline{2} 1; sp; sim. inline{1} 1; inline{2} 1; sp; if; auto; sim. by call(rw_RF_List_While); auto. +have->:Pr[SHA3_OIndiff.OIndif.OIndif(FSome(BIRO.IRO), + OSimulator(FSome(BIRO.IRO)), + ODRestr(Dist_of_P1Adv(A))).main() @ &m : res] = + Pr[SHA3_OIndiff.OIndif.OIndif(FSome(BIRO.IRO), + OSimulator(ExtendOutputSize(FSetSize(FSome(BIRO.IRO)))), + ODRestr(Dist_of_P1Adv(A))).main() @ &m : res]. ++ byequiv=> //=; proc; inline*; sp. + seq 2 2 : (={m, hash, glob OSimulator, glob OFC} /\ + eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}); last first. + - sp; if; auto; sp; if; auto. + while(={i, n, x1, bs} /\ eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2} /\ + n{1} = size_out /\ 0 <= i{1} <= n{1}); auto. + * by sp; if; auto; smt(domE get_setE). + by move=> /> &l &r Heq1 Heq2 Heq3 Hc Hvalid; smt(size_out_gt0). + call(: ={glob OSimulator, glob OFC} /\ + eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}); last first; auto. + + smt(mem_empty). + + proc; sp; if; auto. + inline{1} 1; inline{2} 1; sp; if; 1, 3: auto. + if; 1, 3: auto; sp. + if; 1: auto; 1: smt(); last first. + - by conseq=> />; sim; smt(). + wp=> />; 1: smt(). + rnd; auto=> />; 1: smt(). + call(: eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}); last by auto; smt(). + byequiv=> //=; proc. inline{1} 1; inline{2} 2; sp. inline{1} 1; inline{2} 3; swap{2}[1..2]1; sp. @@ -434,7 +487,7 @@ inline{1} 1; inline{2} 3; sp. inline{1} 1; sp. inline{1} 1; sp. swap{2} 1 1; sp; swap{2}[1..2]3; sp. -inline{1} 1; sp; auto. +inline{1} 1; sp; auto. print ExtendOutputSize. seq 2 5 : (={glob A, glob OSimulator, glob Counter, hash, m} /\ inv BIRO.IRO.mp{1} RFList.m{2} /\ SORO.Bounder.bounder{2} <= Counter.c{1}); last first. @@ -451,6 +504,7 @@ auto; call(: ={glob OSimulator, glob Counter} /\ inv BIRO.IRO.mp{1} RFList.m{2} + smt(). + proc; sp; if; auto=> />; 2: smt(); inline{1} 1; inline{2} 1; sp; auto. if; 1, 3: auto; -1: smt(). + (* TODO : reprendre ici, avec le spit des domaines *) From adfc27f647388758b2038ad16fa80bc99868a961 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Wed, 28 Aug 2019 00:55:08 +0200 Subject: [PATCH 465/525] preimage finished, second preimage to finish to debug, and collision to CC from preimage --- proof/SHA3OSecurity.ec | 2257 +++++++++++++++++++--------------------- 1 file changed, 1090 insertions(+), 1167 deletions(-) diff --git a/proof/SHA3OSecurity.ec b/proof/SHA3OSecurity.ec index 1a5efb2..16128b9 100644 --- a/proof/SHA3OSecurity.ec +++ b/proof/SHA3OSecurity.ec @@ -5,6 +5,8 @@ require import Common SLCommon Sponge SHA3_OIndiff. require (****) SecureORO SecureHash. (*****) import OIndif. +require import PROM. + (* module SHA3 (P : DPRIMITIVE) = { *) (* proc init() : unit = {} *) @@ -171,14 +173,25 @@ module FIgnoreSize (F : OIndif.ODFUNCTIONALITY) : OFUNCTIONALITY = { module (OSponge : OIndif.OCONSTRUCTION) (P : OIndif.ODPRIMITIVE) = FSetSize(CSome(Sponge,P)). + +clone import Program as PBool with + type t <- bool, + op d <- dbool +proof *. + +clone import GenEager as Eager with + type from <- bool list * int, + type to <- bool, + op sampleto <- fun _ => dbool +proof * by smt(dbool_ll). + section Preimage. -(* TODO : stopped here *) declare module A : SH.AdvPreimage { Perm, Counter, Bounder, F.RO, F.FRO, Redo, C, Gconcl.S, BlockSponge.BIRO.IRO, BlockSponge.C, BIRO.IRO, Gconcl_list.BIRO2.IRO, Gconcl_list.F2.RO, Gconcl_list.F2.FRO, Gconcl_list.Simulator, SHA3Indiff.Simulator, SHA3Indiff.Cntr, - SORO.Bounder, RO.RO }. + SORO.Bounder, SORO.RO.RO, RO, FRO }. local module FInit (F : OIndif.ODFUNCTIONALITY) : OIndif.OFUNCTIONALITY = { proc init () = {} @@ -203,16 +216,13 @@ local module Log = { local module ExtendOutputSize (F : Oracle) : ODFUNCTIONALITY = { proc f (x : bool list, k : int) = { - var o, l, prefix, suffix, i; + var o, l, suffix, prefix, i; l <- None; - i <- 0; prefix <- []; suffix <- []; o <@ F.get(x); - if (o <> None) { - prefix <- take k (to_list (oget o)); - i <- size_out; - } + prefix <- take k (to_list (oget o)); + i <- size_out; while (i < k) { if ((x,i) \notin Log.m) { Log.m.[(x,i)] <$ {0,1}; @@ -296,16 +306,6 @@ local module RFWhile = { proc sample (x: bool list) = {} }. -module type TOTO (F : Oracle) = { - proc main () : bool -}. - -clone import Program as PBool with - type t <- bool, - op d <- dbool -proof *. - - local equiv rw_RF_List_While : RFList.get ~ RFWhile.get : ={arg, glob RFList} ==> ={res, glob RFWhile}. @@ -339,7 +339,7 @@ local equiv eq_IRO_RFWhile : BIRO.IRO.f ~ RFWhile.get : arg{1} = (x{2}, size_out) /\ inv BIRO.IRO.mp{1} RFList.m{2} ==> - res{2} = of_list res{1} /\ inv BIRO.IRO.mp{1} RFList.m{2}. + res{2} = of_list res{1} /\ size res{1} = size_out /\ inv BIRO.IRO.mp{1} RFList.m{2}. proof. proc; inline*; sp. rcondt{1} 1; 1: by auto. @@ -405,23 +405,249 @@ while(l{2} = bs{1} /\ size bs{1} = i{1} /\ 0 <= i{1} <= n{1} /\ ={i} /\ by auto; smt(size_out_gt0). qed. + op eq_extend_size (m1 : (bool list * int, bool) fmap) (m2 : (bool list * int, bool) fmap) (m3 : (bool list * int, bool) fmap) = + (* (forall x j, (x,j) \in m2 => 0 <= j < size_out) /\ *) + (* (forall x j, (x,j) \in m2 => forall k, 0 <= k < size_out => (x, k) \in m2) /\ *) (forall x j, 0 <= j < size_out => m1.[(x,j)] = m2.[(x,j)]) /\ (forall x j, size_out <= j => m1.[(x,j)] = m3.[(x,j)]) /\ (forall x j, (x,j) \in m1 => 0 <= j). +local module ExtendSample (F : OFUNCTIONALITY) = { + proc init = F.init + proc f (x : bool list, k : int) = { + var y; + if (k <= size_out) { + y <@ F.f(x,size_out); + y <- omap (take k) y; + } else { + y <@ F.f(x,k); + } + return y; + } +}. + local equiv eq_extend : - FSome(BIRO.IRO).f ~ ExtendOutputSize(FSetSize(FSome(BIRO.IRO))).f : + ExtendSample(FSome(BIRO.IRO)).f ~ ExtendOutputSize(FSetSize(FSome(BIRO.IRO))).f : ={arg} /\ eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2} ==> ={res} /\ eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}. proof. proc; inline*; auto; sp. -rcondt{1} 1; auto; rcondt{2} 1; auto. +rcondt{2} 1; 1: auto. +if{1}; sp. +- rcondt{1} 1; auto. + rcondf{2} 8; 1: auto. + - conseq(:_==> true); 1: smt(). + by while(true); auto. + auto=> /=. + conseq(:_==> ={bs, k} /\ size bs{1} = size_out /\ + eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2})=> //=. + - smt(cats0 to_listK spec2_dout). + while(={k, bs, n, x2} /\ i{1} = i0{2} /\ n{1} = size_out /\ + 0 <= i{1} <= n{1} /\ size bs{1} = i{1} /\ + eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}). + - by sp; if; auto; smt(domE get_setE size_rcons). + by auto; smt(size_eq0 size_out_gt0). +rcondt{1} 1; 1: auto. +splitwhile{1} 1 : i0 < size_out; auto=> /=. +while( (i0, n0, x3){1} = (i, k, x){2} /\ bs0{1} = prefix{2} ++ suffix{2} /\ + size_out <= i{2} <= k{2} /\ eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}). ++ by sp; if; auto; smt(domE get_setE size_out_gt0 rcons_cat). +auto=> //=. +conseq(:_==> ={i0} /\ size bs{2} = i0{1} /\ (i0, x3){1} = (n, x2){2} /\ + bs0{1} = bs{2} /\ size bs{2} = size_out /\ + eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}). ++ smt(cats0 take_oversize spec_dout to_listK spec2_dout). +while(={i0} /\ x3{1} = x2{2} /\ 0 <= i0{1} <= n{2} /\ n{2} = size_out /\ + bs0{1} = bs{2} /\ size bs{2} = i0{1} /\ size_out <= n0{1} /\ + eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}). ++ by sp; if; auto; smt(size_rcons domE get_setE size_rcons mem_set). +by auto; smt(size_out_gt0). qed. +local lemma of_listK l : of_list (to_list l) = Some l. +proof. +by rewrite -to_listK. +qed. + +local module Fill_In (F : RO) = { + proc init = F.init + proc f (x : bool list, n : int) = { + var l, b, i; + i <- 0; + l <- []; + while (i < n) { + b <@ F.get((x,i)); + l <- rcons l b; + i <- i + 1; + } + while (i < size_out) { + F.sample((x,i)); + i <- i + 1; + } + return l; + } +}. + +print module RO. + +local equiv eq_eager_ideal : + BIRO.IRO.f ~ Fill_In(LRO).f : + ={arg} /\ BIRO.IRO.mp{1} = RO.m{2} ==> + ={res} /\ BIRO.IRO.mp{1} = RO.m{2}. +proof. +proc; inline*; sp; rcondt{1} 1; auto. +while{2}(bs{1} = l{2} /\ BIRO.IRO.mp{1} = RO.m{2})(size_out - i{2}). ++ by auto=> />; smt(). +conseq(:_==> bs{1} = l{2} /\ BIRO.IRO.mp{1} = RO.m{2}); 1: smt(). +while(={i, n, x} /\ bs{1} = l{2} /\ BIRO.IRO.mp{1} = RO.m{2}). ++ sp; if{1}. + - by rcondt{2} 2; auto=> />. + by rcondf{2} 2; auto=> />; smt(dbool_ll). +by auto. +qed. + +local equiv eq_eager_ideal2 : + ExtendSample(FSome(BIRO.IRO)).f ~ FSome(Fill_In(RO)).f : + ={arg} /\ BIRO.IRO.mp{1} = RO.m{2} ==> + ={res} /\ BIRO.IRO.mp{1} = RO.m{2}. +proof. +proc; inline*; sp. +if{1}; sp. ++ rcondt{1} 1; auto=> /=/>. + conseq(:_==> take k{1} bs{1} = l{2} /\ BIRO.IRO.mp{1} = RO.m{2}). + * smt(). + case: (0 <= n{2}); last first. + + rcondf{2} 1; 1: by auto; smt(). + conseq(:_==> BIRO.IRO.mp{1} = RO.m{2} /\ ={i} /\ n{1} = size_out /\ x2{1} = x0{2})=> />. + - smt(take_le0). + while(={i} /\ x2{1} = x0{2} /\ n{1} = size_out /\ BIRO.IRO.mp{1} = RO.m{2}). + - sp; if{1}. + - by rcondt{2} 2; auto=> />. + by rcondf{2} 2; auto=> />; smt(dbool_ll). + by auto=> />. + splitwhile{1} 1 : i < k. + while(={i} /\ n{1} = size_out /\ x2{1} = x0{2} /\ BIRO.IRO.mp{1} = RO.m{2} /\ + take k{1} bs{1} = l{2} /\ size bs{1} = i{1} /\ k{1} <= i{1} <= size_out). + * sp; if{1}. + - by rcondt{2} 2; auto; smt(dbool_ll cats1 take_cat cats0 take_size size_rcons). + by rcondf{2} 2; auto; smt(dbool_ll cats1 take_cat cats0 take_size size_rcons). + conseq(:_==> ={i} /\ n{1} = size_out /\ x2{1} = x0{2} /\ BIRO.IRO.mp{1} = RO.m{2} /\ + bs{1} = l{2} /\ size bs{1} = i{1} /\ k{1} = i{1}). + + smt(take_size). + while(={i} /\ x2{1} = x0{2} /\ n{1} = size_out /\ k{1} = n{2} /\ + 0 <= i{1} <= k{1} <= size_out /\ bs{1} = l{2} /\ size bs{1} = i{1} /\ + BIRO.IRO.mp{1} = RO.m{2}). + + sp; if{1}. + - by rcondt{2} 2; auto; smt(size_rcons). + by rcondf{2} 2; auto; smt(size_rcons dbool_ll). + by auto; smt(size_ge0 size_out_gt0). +rcondt{1} 1; auto. +rcondf{2} 2; 1: auto. ++ conseq(:_==> i = n); 1: smt(). + by while(i <= n); auto=> />; smt(size_out_gt0). +while(i0{1} = i{2} /\ x3{1} = x0{2} /\ n0{1} = n{2} /\ bs0{1} = l{2} /\ + BIRO.IRO.mp{1} = RO.m{2}). ++ sp; if{1}. + - by rcondt{2} 2; auto=> />. + by rcondf{2} 2; auto; smt(dbool_ll). +by auto=> />. +qed. + +local module Dist (F : RO) = { + proc distinguish = SHA3_OIndiff.OIndif.OIndif(FSome(Fill_In(F)), + OSimulator(FSome(Fill_In(F))), ODRestr(Dist_of_P1Adv(A))).main +}. + +local module Game (F : RO) = { + proc distinguish () = { + var bo; + OSimulator(FSome(Fill_In(F))).init(); + Counter.c <- 0; + Log.m <- empty; + F.init(); + bo <@ Dist(F).distinguish(); + return bo; + } +}. + +local lemma eager_ideal &m : + Pr[SHA3_OIndiff.OIndif.OIndif(FSome(BIRO.IRO), + OSimulator(FSome(BIRO.IRO)), + ODRestr(Dist_of_P1Adv(A))).main() @ &m : res] = + Pr[SHA3_OIndiff.OIndif.OIndif(ExtendSample(FSome(BIRO.IRO)), + OSimulator(ExtendSample(FSome(BIRO.IRO))), + ODRestr(Dist_of_P1Adv(A))).main() @ &m : res]. +proof. +cut->: + Pr[SHA3_OIndiff.OIndif.OIndif(FSome(BIRO.IRO), + OSimulator(FSome(BIRO.IRO)), + ODRestr(Dist_of_P1Adv(A))).main() @ &m : res] = + Pr[Game(LRO).distinguish() @ &m : res]. ++ byequiv=> //=; proc. + inline{2} 1; sp; inline{2} 1; sp; inline{2} 1; sp; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp; sim. + seq 2 2 : (={hash, m, glob OFC} /\ BIRO.IRO.mp{1} = RO.m{2}); last first. + - inline{1} 1; inline{2} 1; sp; sim. + inline{1} 1; inline{2} 1; sp; sim; if; auto. + inline{1} 1; inline{2} 1; sp; sim. + by call eq_eager_ideal; auto. + call(: ={glob OFC, glob OSimulator} /\ BIRO.IRO.mp{1} = RO.m{2}); auto. + - proc; sp; if; auto. + inline{1} 1; inline{2} 1; sp; sim; if; 1: auto; sim. + if; 1: auto; sim; sp. + if; 1: auto; 1: smt(); sim. + * inline{1} 1; inline{2} 1; sp; sim. + by call eq_eager_ideal; auto; smt(). + smt(). + - by proc; inline*; sim. + proc; sim. + inline{1} 1; inline{2} 1; sp; sim; if; 1: auto; sim. + inline{1} 1; inline{2} 1; sp; sim. + by call eq_eager_ideal; auto. +cut->: + Pr[SHA3_OIndiff.OIndif.OIndif(ExtendSample(FSome(BIRO.IRO)), + OSimulator(ExtendSample(FSome(BIRO.IRO))), + ODRestr(Dist_of_P1Adv(A))).main() @ &m : res] = + Pr[Game(RO).distinguish() @ &m : res]. ++ byequiv=>//=; proc. + inline{2} 1; sp; inline{2} 1; sp; inline{2} 1; sp; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp; sim. + seq 2 2 : (={hash, m, glob OFC} /\ BIRO.IRO.mp{1} = RO.m{2}); last first. + - inline{1} 1; inline{2} 1; sp; sim. + inline{1} 1; inline{2} 1; sp; sim; if; auto. + by call eq_eager_ideal2; auto. + call(: ={glob OFC, glob OSimulator} /\ BIRO.IRO.mp{1} = RO.m{2}); auto. + - proc; sp; if; auto. + inline{1} 1; inline{2} 1; sp; sim; if; 1: auto; sim. + if; 1: auto; sim; sp. + if; 1: auto; 1: smt(); sim. + * by call eq_eager_ideal2; auto; smt(). + smt(). + - by proc; inline*; sim. + proc; sim. + inline{1} 1; inline{2} 1; sp; sim; if; 1: auto; sim. + by call eq_eager_ideal2; auto. +rewrite eq_sym; byequiv=> //=; proc. +call(RO_LRO_D Dist); inline*; auto=> />. +qed. + + + + local lemma rw_ideal_2 &m: Pr[SHA3_OIndiff.OIndif.OIndif(FSome(BIRO.IRO), OSimulator(FSome(BIRO.IRO)), ODRestr(Dist_of_P1Adv(A))).main() @ &m : res] <= @@ -454,20 +680,26 @@ have->:Pr[SORO.Preimage(SORO_P1(A), RFList).main() @ &m : res] = inline{1} 1; inline{2} 1; sp; sim. inline{1} 1; inline{2} 1; sp; if; auto; sim. by call(rw_RF_List_While); auto. -have->:Pr[SHA3_OIndiff.OIndif.OIndif(FSome(BIRO.IRO), - OSimulator(FSome(BIRO.IRO)), +rewrite (eager_ideal &m). +have->:Pr[SHA3_OIndiff.OIndif.OIndif(ExtendSample(FSome(BIRO.IRO)), + OSimulator(ExtendSample(FSome(BIRO.IRO))), ODRestr(Dist_of_P1Adv(A))).main() @ &m : res] = - Pr[SHA3_OIndiff.OIndif.OIndif(FSome(BIRO.IRO), + Pr[SHA3_OIndiff.OIndif.OIndif(ExtendSample(FSome(BIRO.IRO)), OSimulator(ExtendOutputSize(FSetSize(FSome(BIRO.IRO)))), ODRestr(Dist_of_P1Adv(A))).main() @ &m : res]. + byequiv=> //=; proc; inline*; sp. seq 2 2 : (={m, hash, glob OSimulator, glob OFC} /\ eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}); last first. - - sp; if; auto; sp; if; auto. - while(={i, n, x1, bs} /\ eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2} /\ - n{1} = size_out /\ 0 <= i{1} <= n{1}); auto. - * by sp; if; auto; smt(domE get_setE). - by move=> /> &l &r Heq1 Heq2 Heq3 Hc Hvalid; smt(size_out_gt0). + - sp; if; auto; sp; if; auto; sp; rcondt{1}1; 1: auto. + * rcondt{2} 1; 1: auto. + while(={i, n, bs, x3} /\ size bs{1} = i{1} /\ + eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2} /\ + n{1} = size_out /\ 0 <= i{1} <= n{1}); auto. + * by sp; if; auto; smt(domE get_setE size_rcons). + smt(size_out_gt0 take_oversize size_out_gt0). + * by auto; rcondf{1} 1; auto. + * rcondt{2} 1; 1: auto; move=> />; auto. + by while(={i0, n0}); auto; sp; if{1}; if{2}; auto; smt(dbool_ll). call(: ={glob OSimulator, glob OFC} /\ eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}); last first; auto. + smt(mem_empty). @@ -478,8 +710,18 @@ have->:Pr[SHA3_OIndiff.OIndif.OIndif(FSome(BIRO.IRO), - by conseq=> />; sim; smt(). wp=> />; 1: smt(). rnd; auto=> />; 1: smt(). - call(: eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}); last by auto; smt(). - + call(eq_extend); last by auto; smt(). + + by proc; sp; if; auto; inline{1} 1; inline{2} 1; sp; if; auto. + proc; sp; inline{1} 1; inline{2} 1; sp; if; auto. + inline*; sp. + rcondt{1} 1; 1: auto; rcondt{2} 1; 1: auto; sp. + rcondt{1} 1; 1: auto; rcondt{2} 1; 1: auto; sp; auto. + conseq(:_==> ={bs} /\ eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}); + 1: by auto. + while(={i, n, x3, bs} /\ 0 <= i{1} <= size_out /\ n{1} = size_out /\ + eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}). + - by sp; if; auto; smt(domE get_setE size_rcons). + by auto; smt(size_out_gt0). byequiv=> //=; proc. inline{1} 1; inline{2} 2; sp. inline{1} 1; inline{2} 3; swap{2}[1..2]1; sp. @@ -487,8 +729,8 @@ inline{1} 1; inline{2} 3; sp. inline{1} 1; sp. inline{1} 1; sp. swap{2} 1 1; sp; swap{2}[1..2]3; sp. -inline{1} 1; sp; auto. print ExtendOutputSize. -seq 2 5 : (={glob A, glob OSimulator, glob Counter, hash, m} /\ +inline{1} 1; sp; auto. +seq 2 5 : (={glob A, glob OSimulator, glob Counter, glob Log, hash, m} /\ inv BIRO.IRO.mp{1} RFList.m{2} /\ SORO.Bounder.bounder{2} <= Counter.c{1}); last first. + inline{1} 1; inline{2} 1; sp; inline{1} 1; sp; auto. @@ -498,22 +740,52 @@ seq 2 5 : (={glob A, glob OSimulator, glob Counter, hash, m} /\ by while{2}(true)(size_out - i{2}); auto=>/>; smt(dbool_ll). rcondt{2} 1; 1: by auto=> />; smt(divz_ge0 gt0_r size_ge0). inline{1} 1; sp; auto. - auto; call(eq_IRO_RFWhile); auto. -auto; call(: ={glob OSimulator, glob Counter} /\ inv BIRO.IRO.mp{1} RFList.m{2} /\ - SORO.Bounder.bounder{2} <= Counter.c{1}); auto=> />. -+ smt(). -+ proc; sp; if; auto=> />; 2: smt(); inline{1} 1; inline{2} 1; sp; auto. + rcondt{1} 1; auto=> /=. + inline{1} 1; sp; auto. + by call(eq_IRO_RFWhile); auto; smt(take_oversize). +auto; call(: ={glob OSimulator, glob Counter, glob Log} /\ + inv BIRO.IRO.mp{1} RFList.m{2} /\ + SORO.Bounder.bounder{2} <= Counter.c{1}); auto; last first. ++ by inline*; auto; smt(mem_empty). ++ proc; sp; if; auto=> />; 1: smt(). + inline{1} 1; inline{2} 1; sp; auto. if; 1, 3: auto; -1: smt(). - - (* TODO : reprendre ici, avec le spit des domaines *) - - + if; 1, 3: auto; -1: smt(). + sp; if; 1: auto; 1: smt(); last first. + - by conseq(:_==> ={y, glob OSimulator}); 1: smt(); sim; smt(). + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + rcondt{2} 1; 1: by auto; smt(). + sp. + seq 3 2 : (={x0, x1, o1, k0, Log.m, suffix, glob OSimulator} /\ + inv BIRO.IRO.mp{1} RFList.m{2} /\ + SORO.Bounder.bounder{2} <= Counter.c{2} + 1); last first. + - by conseq(:_==> ={y, x1, glob OSimulator, Log.m}); 1: smt(); sim=> />. + inline{1} 1; auto. + by call(eq_IRO_RFWhile); auto; smt(). ++ by proc; inline*; sp; if; auto; sp; if; auto=> />; smt(). +proc. +inline{1} 1; inline{2} 1; sp; if; auto=> /=. +inline{1} 1; inline{2} 1; sp. +rcondt{1} 1; 1: auto. +inline{1} 1; auto. +rcondf{2} 4; 1: auto. ++ inline*; auto; sp; if; auto; sp; if; auto=> />; conseq(:_==> true); 1: smt(). + by while(true); auto. +inline{2} 1; sp. +rcondt{2} 1; 1: by auto; smt(divz_ge0 gt0_r size_ge0). +auto; call eq_IRO_RFWhile; auto=> />. +move=> &l &r 13?; split; 2: smt(divz_ge0 gt0_r size_ge0). +rewrite 2!oget_some cats0 take_oversize 1:/# take_oversize 1:spec_dout //=. +have h:=spec2_dout result_L H5. +have-> := some_oget _ h. +by rewrite eq_sym -to_listK; congr. qed. local lemma rw_ideal &m: Pr[SHA3_OIndiff.OIndif.OIndif(FSome(BIRO.IRO), OSimulator(FSome(BIRO.IRO)), ODRestr(Dist_of_P1Adv(A))).main() @ &m : res] <= - Pr[SORO.Preimage(SORO_P1(A),RF(RO.RO)).main() @ &m : res]. + Pr[SORO.Preimage(SORO_P1(A),RF(SORO.RO.RO)).main() @ &m : res]. proof. rewrite (StdOrder.RealOrder.ler_trans _ _ _ (rw_ideal_2 &m)). byequiv(: ={glob A} ==> _) => //=; proc; inline*; sp; wp. @@ -529,14 +801,41 @@ seq 2 2 : ( RFList.m{1} = empty /\ Counter.c{2} = 0 /\ ={Log.m, glob SHA3Indiff.Simulator, glob SORO.Bounder, glob Counter} /\ - RO.RO.m{2} = empty /\ ={glob A, h, hash}); 1: auto=> />. + SORO.RO.RO.m{2} = empty /\ ={glob A, h, hash}); 1: auto=> />. seq 1 1 : (={glob A, glob SHA3Indiff.Simulator, glob SORO.Bounder, glob Counter, - mi, h, hash} /\ RFList.m{1} = RO.RO.m{2}). -+ call(: ={glob SHA3Indiff.Simulator, glob SORO.Bounder, glob Counter} /\ - RFList.m{1} = RO.RO.m{2}); auto. - - admit. - - admit. - - admit. + glob Log, mi, h, hash} /\ RFList.m{1} = SORO.RO.RO.m{2}). ++ call(: ={glob SHA3Indiff.Simulator, glob SORO.Bounder, glob Counter, glob Log} /\ + RFList.m{1} = SORO.RO.RO.m{2}); auto. + - proc; sp; if; 1, 3: auto; sp. + inline *; sp; sim. + if; 1: auto; sim. + if; 1: auto; sim. + sp; if; 1: (auto; smt()); sim; 2: smt(). + sp; if; 1: auto; sim; -1: smt(). + sp; if{1}. + * rcondt{2} 2; auto; 1: smt(BlockSponge.parse_valid). + rnd (fun l => oget (of_list l)) to_list; auto=> />. + move=> &l &r 10?; split; 1: smt(of_listK). + rewrite -dout_equal_dlist=> ?; split=> ?. + + by rewrite dmapE=> h{h}; apply mu_eq=> x; smt(to_list_inj). + move=> sample. + rewrite !get_setE/=oget_some/=dout_full/= => h; split; 2: smt(). + rewrite eq_sym to_listK; apply some_oget. + apply spec2_dout. + by move:h; rewrite supp_dmap; smt(spec_dout). + by auto; smt(dout_ll). + - by proc; inline*; sp; if; auto; sp; if; auto. + - proc; inline*; sp; if; auto; sp; if; auto; sp; sim. + if{1}. + * rcondt{2} 2; auto. + rnd (fun l => oget (of_list l)) to_list; auto=> />. + move=> &l 4?; split=> ?; 1: smt(of_listK). + rewrite -dout_equal_dlist; split=> ?. + * by rewrite dmapE=> h{h}; apply mu_eq=> x; smt(to_list_inj). + move=> sample. + rewrite supp_dmap dout_full/= =>/> a. + by rewrite get_setE/=oget_some/= dout_full/=; congr; rewrite of_listK oget_some. + by auto; smt(dout_ll). sp; if; 1, 3: auto; sp; wp 1 2. if{1}. + wp=> />. @@ -564,12 +863,14 @@ local lemma leq_ideal &m : Pr[SHA3_OIndiff.OIndif.OIndif(FSome(BIRO.IRO), OSimulator(FSome(BIRO.IRO)), ODRestr(Dist_of_P1Adv(A))).main() @ &m : res] <= (sigma + 1)%r / 2%r ^ size_out. proof. -print SORO.RO_is_preimage_resistant. -have:=rw_ideal &m. -admit. +rewrite (StdOrder.RealOrder.ler_trans _ _ _ (rw_ideal &m)). +rewrite (StdOrder.RealOrder.ler_trans _ _ _ (RO_is_preimage_resistant (SORO_P1(A)) &m)). +by rewrite doutE1. qed. - local lemma rw_real &m (A <: SH.AdvPreimage { Perm, Counter, Bounder }): + + + local lemma rw_real &m : Pr[Preimage(A, OSponge, PSome(Perm)).main() @ &m : res] = Pr[SHA3_OIndiff.OIndif.OIndif(FSome(Sponge(Poget(PSome(Perm)))), PSome(Perm), ODRestr(Dist_of_P1Adv(A))).main() @ &m : res]. @@ -595,7 +896,7 @@ lemma Sponge_preimage_resistant &m: (sigma + 1)%r / (2%r ^ size_out). proof. move=> A_ll. -rewrite (rw_real &m A). +rewrite (rw_real &m). have := SHA3OIndiff (Dist_of_P1Adv(A)) &m _. + move=> F P Hp Hpi Hf; proc; inline*; sp; auto; call Hf; auto. call(A_ll (DFSetSize(F)) P _ Hp Hpi); auto. @@ -604,1166 +905,788 @@ have := SHA3OIndiff (Dist_of_P1Adv(A)) &m _. by have/#:=leq_ideal &m. qed. +end section Preimage. -(* old proof *) - - declare module A : SH.AdvPreimage{SRO.RO.RO, SRO.RO.FRO, SRO.Bounder, Perm, - Gconcl_list.BIRO2.IRO, Simulator, Cntr, BIRO.IRO, F.RO, F.FRO, Redo, C, - Gconcl.S, BlockSponge.BIRO.IRO, BlockSponge.C, Gconcl_list.F2.RO, - Gconcl_list.F2.FRO, Gconcl_list.Simulator, DPre}. - - axiom A_ll (F <: SRO.Oracle) : islossless F.get => islossless A(F).guess. - local lemma invm_dom_rng (m mi : (state, state) fmap) : - invm m mi => dom m = rng mi. - proof. - move=>h; rewrite fun_ext=> x; rewrite domE rngE /= eq_iff; have h2 := h x; split. - + move=> m_x_not_None; exists (oget m.[x]); rewrite -h2; move: m_x_not_None. - by case: (m.[x]). - by move=> [] a; rewrite -h2 => ->. - qed. - local lemma invmC' (m mi : (state, state) fmap) : - invm m mi => invm mi m. - proof. by rewrite /#. qed. +section SecondPreimage. - local lemma invmC (m mi : (state, state) fmap) : - invm m mi <=> invm mi m. - proof. by split;exact invmC'. qed. - local lemma useful m mi a : - invm m mi => ! a \in m => Distr.is_lossless ((bdistr `*` cdistr) \ rng m). - proof. - move=>hinvm nin_dom. - cut prod_ll:Distr.is_lossless (bdistr `*` cdistr). - + by rewrite dprod_ll DBlock.dunifin_ll DCapacity.dunifin_ll. - apply dexcepted_ll=>//=;rewrite-prod_ll. - cut->:predT = predU (predC (rng m)) (rng m);1:rewrite predCU//=. - rewrite Distr.mu_disjoint 1:predCI//=StdRing.RField.addrC. - cut/=->:=StdOrder.RealOrder.ltr_add2l (mu (bdistr `*` cdistr) (rng m)) 0%r. - rewrite Distr.witness_support/predC. - move:nin_dom;apply absurd=>//=;rewrite negb_exists/==>hyp. - cut{hyp}hyp:forall x, rng m x by smt(supp_dprod DBlock.supp_dunifin DCapacity.supp_dunifin). - move:a. - cut:=eqEcard (fdom m) (frng m);rewrite leq_card_rng_dom/=. - cut->//=:fdom m \subset frng m. - + by move=> x; rewrite mem_fdom mem_frng hyp. - smt(mem_fdom mem_frng). - qed. + declare module A : SH.AdvSecondPreimage { Perm, Counter, Bounder, F.RO, + F.FRO, Redo, C, Gconcl.S, BlockSponge.BIRO.IRO, BlockSponge.C, BIRO.IRO, + Gconcl_list.BIRO2.IRO, Gconcl_list.F2.RO, Gconcl_list.F2.FRO, + Gconcl_list.Simulator, SHA3Indiff.Simulator, SHA3Indiff.Cntr, + SORO.Bounder, SORO.RO.RO, RO, FRO }. + local module FInit (F : OIndif.ODFUNCTIONALITY) : OIndif.OFUNCTIONALITY = { + proc init () = {} + proc f = F.f + }. - local equiv equiv_sponge_perm c m : - FInit(CSetSize(Sponge, Perm)).get ~ FInit(DFSetSize(FC(Sponge(Perm)))).get : - ={arg, glob Perm} /\ invm Perm.m{1} Perm.mi{1} /\ - Cntr.c{2} = c /\ arg{2} = m /\ - (Cntr.c + ((size arg + 1) %/ Common.r + 1) + - max ((size_out + Common.r - 1) %/ Common.r - 1) 0 <= limit){2} ==> - ={res, glob Perm} /\ invm Perm.m{1} Perm.mi{1} /\ - Cntr.c{2} = c + ((size m + 1) %/ Common.r + 1) + - max ((size_out + Common.r - 1) %/ Common.r - 1) 0. - proof. - proc; inline FC(Sponge(Perm)).f; sp. - rcondt{2} 1; auto; sp. - call(: ={glob Perm} /\ invm Perm.m{1} Perm.mi{1})=>/=; auto; inline*. - while(={i, n, sa, sc, z, glob Perm} /\ invm Perm.m{1} Perm.mi{1}); auto. - + sp; if; auto; sp; if; auto; progress. - rewrite invm_set //=. - by move:H4; rewrite supp_dexcepted. - sp; conseq(:_==> ={i, n, sa, sc, glob Perm} /\ invm Perm.m{1} Perm.mi{1}); auto. - while(={xs, sa, sc, glob Perm} /\ invm Perm.m{1} Perm.mi{1}); auto. - sp; if; auto; progress. - rewrite invm_set=>//=. - by move:H4; rewrite supp_dexcepted. - qed. + local module PInit (P : ODPRIMITIVE) : OPRIMITIVE = { + proc init () = {} + proc f = P.f + proc fi = P.fi + }. - op same_ro (m1 : (bool list, f_out) fmap) (m2 : (bool list * int, bool) fmap) = - (forall m, m \in m1 => forall i, 0 <= i < size_out => (m,i) \in m2) - && (forall m, (exists i, 0 <= i < size_out /\ (m,i) \in m2) => m \in m1) - && (forall m, m \in m1 => to_list (oget m1.[m]) = map (fun i => oget m2.[(m,i)]) (range 0 size_out)). - - op same_ro2 (m1 : (bool list, bool list) fmap) (m2 : (bool list * int, bool) fmap) = - (forall m, m \in m1 => forall i, 0 <= i < size_out => (m,i) \in m2) - && (forall m, (exists i, 0 <= i < size_out /\ (m,i) \in m2) => m \in m1) - && (forall m, m \in m1 => oget m1.[m] = map (fun i => oget m2.[(m,i)]) (range 0 size_out)). - - clone import Program as Prog with - type t <- bool, - op d <- dbool - proof *. - - local equiv equiv_ro_iro c m : - FInit(RO).get ~ FInit(DFSetSize(FC(BIRO.IRO))).get : - ={arg} /\ same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2} /\ - arg{2} = m /\ Cntr.c{2} = c /\ - (Cntr.c + ((size arg + 1) %/ Common.r + 1) + - max ((size_out + Common.r - 1) %/ Common.r - 1) 0 <= limit){2} - ==> ={res} /\ same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2} /\ - Cntr.c{2} = c + ((size m + 1) %/ Common.r + 1) + - max ((size_out + Common.r - 1) %/ Common.r - 1) 0. - proof. - proc; inline *; sp; rcondt{2} 1; 1: auto. - swap{2} 1 5; sp; wp 2 1. - conseq(:_==> oget SRO.RO.RO.m{1}.[x{1}] = oget (of_list bs0{2}) /\ - same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2}); 1:by auto. - rcondt{2} 1; 1: auto. - case: (x{1} \in SRO.RO.RO.m{1}). - + rcondf{1} 2; auto. - exists* BIRO.IRO.mp{2}; elim* => mp. - while{2}(bs0{2} = map (fun j => oget BIRO.IRO.mp{2}.[(x0{2},j)]) (range 0 i{2}) - /\ n0{2} = size_out /\ x0{2} \in SRO.RO.RO.m{1} /\ 0 <= i{2} <= size_out - /\ same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2} /\ BIRO.IRO.mp{2} = mp) - (size_out - i{2}); auto. - - sp; rcondf 1; auto; 1: smt(). - progress. - * have/=<-:= map_rcons (fun (j : int) => oget BIRO.IRO.mp{hr}.[(x0{hr}, j)]) (range 0 i{hr}) i{hr}. - by rewrite !rangeSr //=. - * smt(). - * smt(). - * smt(). - progress. - - by rewrite range_geq. - - smt(size_out_gt0). - - smt(). - - exact(dout_ll). - - have[] h[#] h1 h2 := H. - cut->:i_R = size_out by smt(). - cut<-:=h2 _ H3. - smt(to_listK). - rcondt{1} 2; 1: auto; wp =>/=. - exists* BIRO.IRO.mp{2}; elim* => mp. - conseq(:_==> - same_ro SRO.RO.RO.m{1} mp /\ i{2} = size_out /\ - (forall (l,j), (l,j) \in mp => (l,j) \in BIRO.IRO.mp{2}) /\ - (forall (l,j), (l,j) \in mp => BIRO.IRO.mp{2}.[(l,j)] = mp.[(l,j)]) /\ - (forall (l,j), (l,j) \in BIRO.IRO.mp{2} => (l,j) \in mp \/ (l = x0{2} /\ 0 <= j < i{2})) /\ - (forall j, 0 <= j < i{2} => (x0{2},j) \in BIRO.IRO.mp{2}) /\ - take i{2} (to_list r{1}) = bs0{2} /\ - take i{2} (to_list r{1}) = map (fun (j : int) => oget BIRO.IRO.mp{2}.[(x0{2}, j)]) (range 0 i{2})); progress=>//=. - + by rewrite get_set_sameE /= oget_some; smt(to_listK take_oversize spec_dout). - + move:H8; rewrite mem_set=>[][]//=h; 1:rewrite H3=>//=. - - by have []h1 []h2 h3:= H2; have->//:=h1 _ h. - by move:h => <<-; rewrite H6 //=. - + rewrite mem_set//=; have[]//=h:= H5 _ _ H11; left. - have []h1 []->//=:= H2. - by exists i0=>//=. - + move:H7; rewrite take_oversize 1:spec_dout//= => H7. - move:H10; rewrite mem_set. - case(m \in SRO.RO.RO.m{1})=>//=h. - - rewrite get_set_neqE; 1:smt(). - have []h1 []h2 ->//=:= H2. - by apply eq_in_map=> j;rewrite mem_range=>[][]hj1 hj2/=; rewrite H4//=h1//=. - by move=><<-; rewrite get_set_eqE//=. - alias{1} 1 l = [<:bool>]. - transitivity{1} { - l <@ Sample.sample(size_out); - r <- oget (of_list l); - } - (={glob SRO.RO.RO, x} ==> ={glob SRO.RO.RO, r}) - (x{1} = x0{2} /\ i{2} = 0 /\ n0{2} = size_out /\ mp = BIRO.IRO.mp{2} /\ - same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2} /\ x{1} \notin SRO.RO.RO.m{1} /\ - bs0{2} = [] - ==> - same_ro SRO.RO.RO.m{1} mp /\ i{2} = size_out /\ - (forall (l,j), (l,j) \in mp => (l,j) \in BIRO.IRO.mp{2}) /\ - (forall (l,j), (l,j) \in mp => BIRO.IRO.mp{2}.[(l,j)] = mp.[(l,j)]) /\ - (forall (l,j), (l,j) \in BIRO.IRO.mp{2} => (l,j) \in mp \/ (l = x0{2} /\ 0 <= j < i{2})) /\ - (forall j, 0 <= j < i{2} => (x0{2},j) \in BIRO.IRO.mp{2}) /\ - take i{2} (to_list r{1}) = bs0{2} /\ - take i{2} (to_list r{1}) = - map (fun (j : int) => oget BIRO.IRO.mp{2}.[(x0{2}, j)]) (range 0 i{2})); - progress. - + smt(). - + inline*; sp; wp. - rnd to_list (fun x => oget (of_list x)); auto; progress. - - smt(spec_dout supp_dlist to_listK spec2_dout size_out_gt0). - - rewrite -dout_equal_dlist dmap1E; apply mu_eq=> x/=. - smt(to_listK). - - rewrite-dout_equal_dlist supp_dmap; smt(dout_full). - smt(to_listK). - wp=>/=. - conseq(:_==> i{2} = size_out /\ size l{1} = size_out /\ - (forall (l0 : bool list) (j : int), - (l0, j) \in mp => (l0, j) \in BIRO.IRO.mp{2}) /\ - (forall (l0 : bool list) (j : int), - (l0, j) \in mp => BIRO.IRO.mp{2}.[(l0, j)] = mp.[(l0, j)]) /\ - (forall (l0 : bool list) (j : int), - (l0, j) \in BIRO.IRO.mp{2} => ((l0, j) \in mp) \/ (l0 = x0{2} /\ 0 <= j < i{2})) /\ - (forall (j : int), 0 <= j < i{2} => (x0{2}, j) \in BIRO.IRO.mp{2}) /\ - take i{2} l{1} = bs0{2} /\ - take i{2} l{1} = - map (fun (j : int) => oget BIRO.IRO.mp{2}.[(x0{2}, j)]) (range 0 i{2})); - progress. - + have[]//=h h1:=to_listK (oget (of_list l_L)) l_L; rewrite h1//==> {h1 h}. - smt(spec2_dout). - + have[]//=h h1:=to_listK (oget (of_list l_L)) l_L; rewrite h1//==> {h1 h}. - smt(spec2_dout). - transitivity{1} { - l <@ LoopSnoc.sample(size_out); - } - (={glob SRO.RO.RO} ==> ={glob SRO.RO.RO, l}) - (x{1} = x0{2} /\ i{2} = 0 /\ n0{2} = size_out /\ mp = BIRO.IRO.mp{2} /\ - same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2} /\ x0{2} \notin SRO.RO.RO.m{1} /\ - bs0{2} = [] - ==> - i{2} = size_out /\ size l{1} = size_out /\ - (forall (l,j), (l,j) \in mp => (l,j) \in BIRO.IRO.mp{2}) /\ - (forall (l,j), (l,j) \in mp => BIRO.IRO.mp{2}.[(l,j)] = mp.[(l,j)]) /\ - (forall (l,j), (l,j) \in BIRO.IRO.mp{2} => (l,j) \in mp \/ (l = x0{2} /\ 0 <= j < i{2})) /\ - (forall j, 0 <= j < i{2} => (x0{2},j) \in BIRO.IRO.mp{2}) /\ - take i{2} l{1} = bs0{2} /\ - take i{2} l{1} = - map (fun (j : int) => oget BIRO.IRO.mp{2}.[(x0{2}, j)]) (range 0 i{2})); - progress. - + smt(). - + by call Sample_LoopSnoc_eq; auto. - inline*; sp; wp. - conseq(:_==> i{2} = size_out /\ size l0{1} = i{2} /\ - same_ro SRO.RO.RO.m{1} mp /\ x0{2} \notin SRO.RO.RO.m{1} /\ - (forall l j, (l,j) \in mp => (l,j) \in BIRO.IRO.mp{2}) /\ - (forall l j, (l,j) \in mp => BIRO.IRO.mp{2}.[(l, j)] = mp.[(l, j)]) /\ - (forall l j, (l, j) \in BIRO.IRO.mp{2} => ((l, j) \in mp) \/ (l = x0{2} /\ 0 <= j < i{2})) /\ - (forall j, 0 <= j < i{2} => (x0{2}, j) \in BIRO.IRO.mp{2}) /\ - l0{1} = bs0{2} /\ bs0{2} = - map (fun (j : int) => oget BIRO.IRO.mp{2}.[(x0{2}, j)]) (range 0 i{2})); progress. - + smt(take_oversize). - + smt(take_oversize). - while(0 <= i{2} <= size_out /\ size l0{1} = i{2} /\ n0{2} = size_out /\ - ={i} /\ n{1} = n0{2} /\ - same_ro SRO.RO.RO.m{1} mp /\ x0{2} \notin SRO.RO.RO.m{1} /\ - (forall l j, (l,j) \in mp => (l,j) \in BIRO.IRO.mp{2}) /\ - (forall l j, (l,j) \in mp => BIRO.IRO.mp{2}.[(l, j)] = mp.[(l, j)]) /\ - (forall l j, (l, j) \in BIRO.IRO.mp{2} => ((l, j) \in mp) \/ (l = x0{2} /\ 0 <= j < i{2})) /\ - (forall j, 0 <= j < i{2} => (x0{2}, j) \in BIRO.IRO.mp{2}) /\ - l0{1} = bs0{2} /\ bs0{2} = - map (fun (j : int) => oget BIRO.IRO.mp{2}.[(x0{2}, j)]) (range 0 i{2})). - + sp; wp=> //=. - rcondt{2} 1; 1:auto; progress. - - have[]h1 [] h2 h3 := H1. - have:=h2 x0{hr}; rewrite H2/= negb_exists/= =>/(_ (size bs0{hr})). - rewrite size_ge0 H9/=; apply absurd =>/= h. - by have //=:= H5 _ _ h. - rnd; auto; progress. - - smt(size_ge0). - - smt(). - - by rewrite size_cat/=. - - by rewrite mem_set; left; rewrite H3. - - rewrite get_setE (H4 _ _ H12). - cut/#: !(l1, j) = (x0{2}, size bs0{2}). - move:H2; apply absurd=> //=[#] <<- ->>. - have[] h1 [] h2 h3 := H1. - by apply h2; smt(). - - move:H12; rewrite mem_set. - case((l1, j) \in BIRO.IRO.mp{2})=>//= h; 1: smt(). - by move=> [#] <<- ->> //=; rewrite size_ge0; smt(). - - rewrite mem_set. - case(j = size bs0{2})=>//=. - move=> h; rewrite h /=; have {H13} H13 {h} : j < size bs0{2} by smt(). - by apply H6. - - by rewrite cats1 get_set_sameE oget_some. - - rewrite get_set_sameE oget_some H7 rangeSr. - rewrite !size_map 1:size_ge0. - rewrite (size_map _ (range 0 (size bs0{2}))) size_range /=. - rewrite max_ler 1:size_ge0 map_rcons /=get_set_sameE oget_some; congr. - apply eq_in_map=> j. - rewrite mem_range /==> [] [] hj1 hj2. - by rewrite get_set_neqE //=; smt(). - auto; progress. - + smt(size_out_gt0). - + smt(). - + smt(). - + by rewrite range_geq. - smt(). - qed. +local module OF (F : Oracle) : OIndif.ODFUNCTIONALITY = { + proc f = F.get +}. - lemma Sponge_preimage_resistant &m ha : - (DPre.h{m} = ha) => - Pr[SRO.Preimage(A, FM(CSetSize(Sponge), Perm)).main(ha) @ &m : res] <= - (limit ^ 2 - limit)%r / (2 ^ (r + c + 1))%r + - (4 * limit ^ 2)%r / (2 ^ c)%r + - (sigma + 1)%r / (2%r ^ size_out). - proof. - move=>init_ha. - rewrite -(doutE1 ha). - rewrite(preimage_resistant_if_indifferentiable A A_ll (CSetSize(Sponge)) Perm &m ha init_ha). - exists (SimSetSize(Simulator))=>//=; split. - + by move=> F _; proc; inline*; auto. - cut->//:Pr[Indiff0.Indif(CSetSize(Sponge, Perm), Perm, DPre(A)).main() @ &m : res] = - Pr[RealIndif(Sponge, Perm, DRestr(DSetSize(DPre(A)))).main() @ &m : res]. - + byequiv=>//=; proc. - inline DPre(A, CSetSize(Sponge, Perm), Perm).distinguish. - inline SRO.Preimage(A, FInit(CSetSize(Sponge, Perm))).main. - inline DRestr(DSetSize(DPre(A)), Sponge(Perm), Perm).distinguish - DSetSize(DPre(A), FC(Sponge(Perm)), PC(Perm)).distinguish - SRO.Preimage(A, FInit(DFSetSize(FC(Sponge(Perm))))).main. - inline Perm.init CSetSize(Sponge, Perm).init Sponge(Perm).init - FC(Sponge(Perm)).init SRO.Counter.init Cntr.init - SRO.Bounder(FInit(CSetSize(Sponge, Perm))).init - SRO.Bounder(FInit(DFSetSize(FC(Sponge(Perm))))).init - FInit(CSetSize(Sponge, Perm)).init - FInit(DFSetSize(FC(Sponge(Perm)))).init; sp. - wp; sp; sim. - seq 1 1 : (={m, hash, glob DPre, glob SRO.Counter, glob Perm} - /\ invm Perm.m{1} Perm.mi{1} /\ DPre.h{1} = ha - /\ ={c}(SRO.Counter,Cntr)); last first. - - if; auto; sp. - exists* m{1}, SRO.Counter.c{1}; elim* => mess c. - by call(equiv_sponge_perm c mess); auto; smt(). - call(: ={glob SRO.Counter, glob Perm, glob DPre, glob SRO.Bounder} - /\ DPre.h{1} = ha - /\ invm Perm.m{1} Perm.mi{1} /\ ={c}(SRO.Counter,Cntr)). - + proc; sp; if; auto; sp; if; auto; sp. - exists * x{1}; elim* => m c1 c2 b1 b2. - by call(equiv_sponge_perm c1 m); auto; smt(). - auto; progress. - by rewrite /invm=> x y; rewrite 2!emptyE. - cut->//:Pr[Indiff0.Indif(RO, SimSetSize(Simulator, RO), DPre(A)).main() @ &m : res] = - Pr[IdealIndif(BIRO.IRO, Simulator, DRestr(DSetSize(DPre(A)))).main() @ &m : res]. - + byequiv=>//=; proc. - inline Simulator(FGetSize(RO)).init RO.init Simulator(BIRO.IRO).init - BIRO.IRO.init Gconcl_list.BIRO2.IRO.init; sp. - inline DPre(A, RO, Simulator(FGetSize(RO))).distinguish. - inline DRestr(DSetSize(DPre(A)), BIRO.IRO, Simulator(BIRO.IRO)).distinguish - DSetSize(DPre(A), FC(BIRO.IRO), PC(Simulator(BIRO.IRO))).distinguish; wp; sim. - inline SRO.Bounder(FInit(DFSetSize(FC(BIRO.IRO)))).init - SRO.Bounder(FInit(RO)).init SRO.Counter.init FInit(RO).init - FInit(DFSetSize(FC(BIRO.IRO))).init Cntr.init; sp. - inline SRO.Preimage(A, FInit(RO)).main - SRO.Preimage(A, FInit(DFSetSize(FC(BIRO.IRO)))).main. - inline SRO.Counter.init SRO.Bounder(FInit(RO)).init - SRO.Bounder(FInit(DFSetSize(FC(BIRO.IRO)))).init - FInit(RO).init FInit(DFSetSize(FC(BIRO.IRO))).init ; sp; sim. - seq 1 1 : (={m, glob SRO.Counter, glob DPre, hash} - /\ ={c}(SRO.Counter,Cntr) /\ DPre.h{1} = hash{1} - /\ same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2}); last first. - - if; auto; sp. - exists * m{1}, SRO.Counter.c{1}; elim* => mess c. - by call(equiv_ro_iro c mess); auto; smt(). - conseq(:_==> ={m, glob SRO.Counter, glob SRO.Bounder, glob DPre} - /\ ={c}(SRO.Counter,Cntr) - /\ same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2}); progress. - call(: ={glob SRO.Counter, glob SRO.Bounder, glob DPre} - /\ ={c}(SRO.Counter,Cntr) - /\ same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2}); auto. - + proc; sp; if; auto; sp; if; auto; sp. - exists* x{1}; elim* => a c1 c2 b1 b2. - call(equiv_ro_iro c1 a); auto; smt(). - smt(mem_empty). - have->//=:= SHA3Indiff (DSetSize(DPre(A))) &m _. - move=> F P P_f_ll P_fi_ll F_ll; proc; inline*; auto; sp; auto. - seq 1 : true; auto. - + call (A_ll (SRO.Bounder(FInit(DFSetSize(F))))); auto. - by proc; inline*; sp; if; auto; sp; if; auto; sp; call F_ll; auto. - if; auto; sp. - by call F_ll; auto. - qed. -end section Preimage. +local module Log = { + var m : (bool list * int, bool) fmap +}. +local module ExtendOutputSize (F : Oracle) : ODFUNCTIONALITY = { + proc f (x : bool list, k : int) = { + var o, l, suffix, prefix, i; + l <- None; + prefix <- []; + suffix <- []; + o <@ F.get(x); + prefix <- take k (to_list (oget o)); + i <- size_out; + while (i < k) { + if ((x,i) \notin Log.m) { + Log.m.[(x,i)] <$ {0,1}; + } + suffix <- rcons suffix (oget Log.m.[(x,i)]); + i <- i + 1; + } + l <- Some (prefix ++ suffix); + return l; + } +}. +local module OFC2 (F : Oracle) = OFC(ExtendOutputSize(F)). -section SecondPreimage. +local module ExtendOutput (F : RF) = { + proc init () = { + Log.m <- empty; + F.init(); + } + proc f = ExtendOutputSize(F).f + proc get = f +}. - declare module A : SRO.AdvSecondPreimage{SRO.RO.RO, SRO.RO.FRO, SRO.Bounder, Perm, - Gconcl_list.BIRO2.IRO, Simulator, Cntr, BIRO.IRO, F.RO, F.FRO, Redo, C, - Gconcl.S, BlockSponge.BIRO.IRO, BlockSponge.C, Gconcl_list.F2.RO, - Gconcl_list.F2.FRO, Gconcl_list.Simulator, D2Pre}. + local module (Dist_of_P2Adv (A : SH.AdvSecondPreimage) : ODISTINGUISHER) (F : ODFUNCTIONALITY) (P : ODPRIMITIVE) = { + var m : bool list + proc distinguish () = { + var hash, hash', m'; + Log.m <- empty; + m' <@ A(DFSetSize(F),P).guess(m); + hash <@ DFSetSize(F).f(m); + hash' <@ DFSetSize(F).f(m'); + return m <> m' /\ exists y, hash' = Some y /\ hash = Some y; + } + }. + - axiom A_ll (F <: SRO.Oracle) : islossless F.get => islossless A(F).guess. +local module (SORO_P2 (A : SH.AdvSecondPreimage) : SORO.AdvSecondPreimage) (F : Oracle) = { + proc guess (m : bool list) : bool list = { + var mi; + Log.m <- empty; + Counter.c <- 0; + Dist_of_P2Adv.m <- m; + OSimulator(ExtendOutputSize(F)).init(); + mi <@ A(DFSetSize(OFC2(F)),OPC(OSimulator(ExtendOutputSize(F)))).guess(m); + return mi; + } +}. - local lemma invm_dom_rng (m mi : (state, state) fmap) : - invm m mi => dom m = rng mi. - proof. - move=>h; rewrite fun_ext=> x; rewrite domE rngE /= eq_iff; have h2 := h x; split. - + move=> m_x_not_None; exists (oget m.[x]); rewrite -h2; move: m_x_not_None. - by case: (m.[x]). - by move=> [] a; rewrite -h2 => ->. - qed. +local module RFList = { + var m : (bool list, f_out) fmap + proc init () = { + m <- empty; + } + proc get (x : bool list) : f_out option = { + var z; + if (x \notin m) { + z <$ dlist dbool size_out; + m.[x] <- oget (of_list z); + } + return m.[x]; + } + proc sample (x: bool list) = {} +}. - local lemma invmC' (m mi : (state, state) fmap) : - invm m mi => invm mi m. - proof. by rewrite /#. qed. +local module RFWhile = { + proc init () = { + RFList.m <- empty; + } + proc get (x : bool list) : f_out option = { + var l, i, b; + if (x \notin RFList.m) { + i <- 0; + l <- []; + while (i < size_out) { + b <$ dbool; + l <- rcons l b; + i <- i + 1; + } + RFList.m.[x] <- oget (of_list l); + } + return RFList.m.[x]; + } + proc sample (x: bool list) = {} +}. - local lemma invmC (m mi : (state, state) fmap) : - invm m mi <=> invm mi m. - proof. by split;exact invmC'. qed. - local lemma useful m mi a : - invm m mi => ! a \in m => Distr.is_lossless ((bdistr `*` cdistr) \ rng m). - proof. - move=>hinvm nin_dom. - cut prod_ll:Distr.is_lossless (bdistr `*` cdistr). - + by rewrite dprod_ll DBlock.dunifin_ll DCapacity.dunifin_ll. - apply dexcepted_ll=>//=;rewrite-prod_ll. - cut->:predT = predU (predC (rng m)) (rng m);1:rewrite predCU//=. - rewrite Distr.mu_disjoint 1:predCI//=StdRing.RField.addrC. - cut/=->:=StdOrder.RealOrder.ltr_add2l (mu (bdistr `*` cdistr) (rng m)) 0%r. - rewrite Distr.witness_support/predC. - move:nin_dom;apply absurd=>//=;rewrite negb_exists/==>hyp. - cut{hyp}hyp:forall x, rng m x by smt(supp_dprod DBlock.supp_dunifin DCapacity.supp_dunifin). - move:a. - cut:=eqEcard (fdom m) (frng m);rewrite leq_card_rng_dom/=. - cut->//=:fdom m \subset frng m. - + by move=> x; rewrite mem_fdom mem_frng hyp. - smt(mem_fdom mem_frng). - qed. +local equiv rw_RF_List_While : + RFList.get ~ RFWhile.get : + ={arg, glob RFList} ==> ={res, glob RFWhile}. +proof. +proc; if; 1, 3: auto; wp. +conseq(:_==> z{1} = l{2})=> />. +transitivity{1} { + z <@ PBool.Sample.sample(size_out); + } + (true ==> ={z}) + (true ==> z{1} = l{2})=>/>. ++ by inline*; auto. +transitivity{1} { + z <@ LoopSnoc.sample(size_out); + } + (true ==> ={z}) + (true ==> z{1} = l{2})=>/>; last first. ++ inline*; auto; sim. + by while(={l, i} /\ n{1} = size_out); auto; smt(cats1). +by call(Sample_LoopSnoc_eq); auto. +qed. - local equiv equiv_sponge_perm c m : - FInit(CSetSize(Sponge, Perm)).get ~ FInit(DFSetSize(FC(Sponge(Perm)))).get : - ={arg, glob Perm} /\ invm Perm.m{1} Perm.mi{1} /\ - Cntr.c{2} = c /\ arg{2} = m /\ - (Cntr.c + ((size arg + 1) %/ Common.r + 1) + - max ((size_out + Common.r - 1) %/ Common.r - 1) 0 <= limit){2} ==> - ={res, glob Perm} /\ invm Perm.m{1} Perm.mi{1} /\ - Cntr.c{2} = c + ((size m + 1) %/ Common.r + 1) + - max ((size_out + Common.r - 1) %/ Common.r - 1) 0. - proof. - proc; inline FC(Sponge(Perm)).f; sp. - rcondt{2} 1; auto; sp. - call(: ={glob Perm} /\ invm Perm.m{1} Perm.mi{1})=>/=; auto; inline*. - while(={i, n, sa, sc, z, glob Perm} /\ invm Perm.m{1} Perm.mi{1}); auto. - + sp; if; auto; sp; if; auto; progress. - rewrite invm_set //=. - by move:H4; rewrite supp_dexcepted. - sp; conseq(:_==> ={i, n, sa, sc, glob Perm} /\ invm Perm.m{1} Perm.mi{1}); auto. - while(={xs, sa, sc, glob Perm} /\ invm Perm.m{1} Perm.mi{1}); auto. - sp; if; auto; progress. - rewrite invm_set=>//=. - by move:H4; rewrite supp_dexcepted. - qed. +local equiv eq_IRO_RFWhile : + BIRO.IRO.f ~ RFWhile.get : + arg{1} = (x{2}, size_out) /\ inv BIRO.IRO.mp{1} RFList.m{2} + ==> + res{2} = of_list res{1} /\ size res{1} = size_out /\ inv BIRO.IRO.mp{1} RFList.m{2}. +proof. +proc; inline*; sp. +rcondt{1} 1; 1: by auto. +if{2}; sp; last first. ++ alias{1} 1 mp = BIRO.IRO.mp. + conseq(:_==> BIRO.IRO.mp{1} = mp{1} /\ size bs{1} = i{1} /\ i{1} = size_out /\ + inv mp{1} RFList.m{2} /\ + bs{1} = take i{1} (to_list (oget RFList.m{2}.[x{1}])))=> />. + - move=> &l &r 11?. + rewrite take_oversize 1:spec_dout 1:H4 //. + rewrite eq_sym to_listK => ->. + by have:=H3; rewrite domE; smt(). + - smt(take_oversize spec_dout). + while{1}(BIRO.IRO.mp{1} = mp{1} /\ size bs{1} = i{1} /\ + 0 <= i{1} <= size_out /\ n{1} = size_out /\ + inv mp{1} RFList.m{2} /\ x{1} \in RFList.m{2} /\ + bs{1} = take i{1} (to_list (oget RFList.m{2}.[x{1}])))(size_out - i{1}); + auto=> />. + + sp; rcondf 1; auto=> />; 1: smt(). + move=> &h 8?. + rewrite size_rcons //=; do!split; 1, 2, 4: smt(size_ge0). + rewrite (take_nth witness) 1:spec_dout 1:size_ge0//=. + rewrite - H6; congr; rewrite H4=> //=. + by apply H3=> //=. + smt(size_out_gt0 size_ge0 take0). +auto=> //=. +conseq(:_==> l{2} = bs{1} /\ size bs{1} = i{1} /\ i{1} = n{1} /\ n{1} = size_out /\ + inv BIRO.IRO.mp{1} RFList.m{2}.[x{2} <- oget (of_list l{2})])=> />. ++ smt(get_setE spec2_dout). ++ smt(get_setE spec2_dout). +alias{1} 1 m = BIRO.IRO.mp; sp. +conseq(:_==> l{2} = bs{1} /\ size bs{1} = i{1} /\ i{1} = n{1} /\ + n{1} = size_out /\ inv m{1} RFList.m{2} /\ + (forall j, (x{1}, j) \in BIRO.IRO.mp{1} => 0 <= j < i{1}) /\ + (forall l j, l <> x{1} => m{1}.[(l,j)] = BIRO.IRO.mp{1}.[(l,j)]) /\ + (forall j, 0 <= j < i{1} => (x{1}, j) \in BIRO.IRO.mp{1}) /\ + (forall j, 0 <= j < i{1} => BIRO.IRO.mp{1}.[(x{1},j)] = Some (nth witness bs{1} j))). ++ move=> /> &l &r 11?; do!split; ..-2 : smt(domE mem_set). + move=> l j Hin. + rewrite get_setE/=. + case: (l = x{r}) => [<<-|]. + - rewrite oget_some H8; 1:smt(); congr; congr. + by rewrite eq_sym to_listK; smt(spec2_dout). + move=> Hneq. + by rewrite -(H6 _ _ Hneq) H2; smt(domE). +while(l{2} = bs{1} /\ size bs{1} = i{1} /\ 0 <= i{1} <= n{1} /\ ={i} /\ + n{1} = size_out /\ inv m{1} RFList.m{2} /\ + (forall j, (x{1}, j) \in BIRO.IRO.mp{1} => 0 <= j < i{1}) /\ + (forall l j, l <> x{1} => m{1}.[(l,j)] = BIRO.IRO.mp{1}.[(l,j)]) /\ + (forall j, 0 <= j < i{1} => (x{1}, j) \in BIRO.IRO.mp{1}) /\ + (forall j, 0 <= j < i{1} => BIRO.IRO.mp{1}.[(x{1},j)] = Some (nth witness bs{1} j))). ++ sp; rcondt{1} 1; auto=> />. + - smt(). + move=> &l &r 13?. + rewrite get_setE/=oget_some/=size_rcons/=; do!split; 1,2: smt(size_ge0). + - smt(mem_set). + - smt(get_setE). + - smt(mem_set). + - move=>j Hj0 Hjsize; rewrite get_setE/=nth_rcons. + case: (j = size bs{l})=>[->>//=|h]. + have/=Hjs:j < size bs{l} by smt(). + by rewrite Hjs/=H8//=. +by auto; smt(size_out_gt0). +qed. - clone import Program as Prog2 with - type t <- bool, - op d <- dbool - proof *. - - local equiv equiv_ro_iro c m : - FInit(RO).get ~ FInit(DFSetSize(FC(BIRO.IRO))).get : - ={arg} /\ same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2} /\ - arg{2} = m /\ Cntr.c{2} = c /\ - (Cntr.c + ((size arg + 1) %/ Common.r + 1) + - max ((size_out + Common.r - 1) %/ Common.r - 1) 0 <= limit){2} - ==> ={res} /\ same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2} /\ - Cntr.c{2} = c + ((size m + 1) %/ Common.r + 1) + - max ((size_out + Common.r - 1) %/ Common.r - 1) 0. - proof. - proc; inline *; sp; rcondt{2} 1; 1: auto. - swap{2} 1 5; sp; wp 2 1. - conseq(:_==> oget SRO.RO.RO.m{1}.[x{1}] = oget (of_list bs0{2}) /\ - same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2}); 1:by auto. - rcondt{2} 1; 1: auto. - case: (x{1} \in SRO.RO.RO.m{1}). - + rcondf{1} 2; auto. - exists* BIRO.IRO.mp{2}; elim* => mp. - while{2}(bs0{2} = map (fun j => oget BIRO.IRO.mp{2}.[(x0{2},j)]) (range 0 i{2}) - /\ n0{2} = size_out /\ x0{2} \in SRO.RO.RO.m{1} /\ 0 <= i{2} <= size_out - /\ same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2} /\ BIRO.IRO.mp{2} = mp) - (size_out - i{2}); auto. - - sp; rcondf 1; auto; 1: smt(). - progress. - * have/=<-:= map_rcons (fun (j : int) => oget BIRO.IRO.mp{hr}.[(x0{hr}, j)]) (range 0 i{hr}) i{hr}. - by rewrite !rangeSr //=. - * smt(). - * smt(). - * smt(). - progress. - - by rewrite range_geq. - - smt(size_out_gt0). - - smt(). - - exact(dout_ll). - - have[] h[#] h1 h2 := H. - cut->:i_R = size_out by smt(). - cut<-:=h2 _ H3. - smt(to_listK). - rcondt{1} 2; 1: auto; wp =>/=. - exists* BIRO.IRO.mp{2}; elim* => mp. - conseq(:_==> - same_ro SRO.RO.RO.m{1} mp /\ i{2} = size_out /\ - (forall (l,j), (l,j) \in mp => (l,j) \in BIRO.IRO.mp{2}) /\ - (forall (l,j), (l,j) \in mp => BIRO.IRO.mp{2}.[(l,j)] = mp.[(l,j)]) /\ - (forall (l,j), (l,j) \in BIRO.IRO.mp{2} => (l,j) \in mp \/ (l = x0{2} /\ 0 <= j < i{2})) /\ - (forall j, 0 <= j < i{2} => (x0{2},j) \in BIRO.IRO.mp{2}) /\ - take i{2} (to_list r{1}) = bs0{2} /\ - take i{2} (to_list r{1}) = map (fun (j : int) => oget BIRO.IRO.mp{2}.[(x0{2}, j)]) (range 0 i{2})); progress=>//=. - + by rewrite get_set_sameE /= oget_some; smt(to_listK take_oversize spec_dout). - + move:H8; rewrite mem_set=>[][]//=h; 1:rewrite H3=>//=. - - by have []h1 []h2 h3:= H2; have->//:=h1 _ h. - by move:h => <<-; rewrite H6 //=. - + rewrite mem_set//=; have[]//=h:= H5 _ _ H11; left. - have []h1 []->//=:= H2. - by exists i0=>//=. - + move:H7; rewrite take_oversize 1:spec_dout//= => H7. - move:H10; rewrite mem_set. - case(m \in SRO.RO.RO.m{1})=>//=h. - - rewrite get_set_neqE; 1:smt(). - have []h1 []h2 ->//=:= H2. - by apply eq_in_map=> j;rewrite mem_range=>[][]hj1 hj2/=; rewrite H4//=h1//=. - by move=><<-; rewrite get_set_eqE//=. - alias{1} 1 l = [<:bool>]. - transitivity{1} { - l <@ Sample.sample(size_out); - r <- oget (of_list l); - } - (={glob SRO.RO.RO, x} ==> ={glob SRO.RO.RO, r}) - (x{1} = x0{2} /\ i{2} = 0 /\ n0{2} = size_out /\ mp = BIRO.IRO.mp{2} /\ - same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2} /\ x{1} \notin SRO.RO.RO.m{1} /\ - bs0{2} = [] - ==> - same_ro SRO.RO.RO.m{1} mp /\ i{2} = size_out /\ - (forall (l,j), (l,j) \in mp => (l,j) \in BIRO.IRO.mp{2}) /\ - (forall (l,j), (l,j) \in mp => BIRO.IRO.mp{2}.[(l,j)] = mp.[(l,j)]) /\ - (forall (l,j), (l,j) \in BIRO.IRO.mp{2} => (l,j) \in mp \/ (l = x0{2} /\ 0 <= j < i{2})) /\ - (forall j, 0 <= j < i{2} => (x0{2},j) \in BIRO.IRO.mp{2}) /\ - take i{2} (to_list r{1}) = bs0{2} /\ - take i{2} (to_list r{1}) = - map (fun (j : int) => oget BIRO.IRO.mp{2}.[(x0{2}, j)]) (range 0 i{2})); - progress. - + smt(). - + inline*; sp; wp. - rnd to_list (fun x => oget (of_list x)); auto; progress. - - smt(spec_dout supp_dlist to_listK spec2_dout size_out_gt0). - - rewrite -dout_equal_dlist dmap1E; apply mu_eq=> x/=. - smt(to_listK). - - rewrite-dout_equal_dlist supp_dmap; smt(dout_full). - smt(to_listK). - wp=>/=. - conseq(:_==> i{2} = size_out /\ size l{1} = size_out /\ - (forall (l0 : bool list) (j : int), - (l0, j) \in mp => (l0, j) \in BIRO.IRO.mp{2}) /\ - (forall (l0 : bool list) (j : int), - (l0, j) \in mp => BIRO.IRO.mp{2}.[(l0, j)] = mp.[(l0, j)]) /\ - (forall (l0 : bool list) (j : int), - (l0, j) \in BIRO.IRO.mp{2} => ((l0, j) \in mp) \/ (l0 = x0{2} /\ 0 <= j < i{2})) /\ - (forall (j : int), 0 <= j < i{2} => (x0{2}, j) \in BIRO.IRO.mp{2}) /\ - take i{2} l{1} = bs0{2} /\ - take i{2} l{1} = - map (fun (j : int) => oget BIRO.IRO.mp{2}.[(x0{2}, j)]) (range 0 i{2})); - progress. - + have[]//=h h1:=to_listK (oget (of_list l_L)) l_L; rewrite h1//==> {h1 h}. - smt(spec2_dout). - + have[]//=h h1:=to_listK (oget (of_list l_L)) l_L; rewrite h1//==> {h1 h}. - smt(spec2_dout). - transitivity{1} { - l <@ LoopSnoc.sample(size_out); +local module ExtendSample (F : OFUNCTIONALITY) = { + proc init = F.init + proc f (x : bool list, k : int) = { + var y; + if (k <= size_out) { + y <@ F.f(x,size_out); + y <- omap (take k) y; + } else { + y <@ F.f(x,k); } - (={glob SRO.RO.RO} ==> ={glob SRO.RO.RO, l}) - (x{1} = x0{2} /\ i{2} = 0 /\ n0{2} = size_out /\ mp = BIRO.IRO.mp{2} /\ - same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2} /\ x0{2} \notin SRO.RO.RO.m{1} /\ - bs0{2} = [] - ==> - i{2} = size_out /\ size l{1} = size_out /\ - (forall (l,j), (l,j) \in mp => (l,j) \in BIRO.IRO.mp{2}) /\ - (forall (l,j), (l,j) \in mp => BIRO.IRO.mp{2}.[(l,j)] = mp.[(l,j)]) /\ - (forall (l,j), (l,j) \in BIRO.IRO.mp{2} => (l,j) \in mp \/ (l = x0{2} /\ 0 <= j < i{2})) /\ - (forall j, 0 <= j < i{2} => (x0{2},j) \in BIRO.IRO.mp{2}) /\ - take i{2} l{1} = bs0{2} /\ - take i{2} l{1} = - map (fun (j : int) => oget BIRO.IRO.mp{2}.[(x0{2}, j)]) (range 0 i{2})); - progress. - + smt(). - + by call Sample_LoopSnoc_eq; auto. - inline*; sp; wp. - conseq(:_==> i{2} = size_out /\ size l0{1} = i{2} /\ - same_ro SRO.RO.RO.m{1} mp /\ x0{2} \notin SRO.RO.RO.m{1} /\ - (forall l j, (l,j) \in mp => (l,j) \in BIRO.IRO.mp{2}) /\ - (forall l j, (l,j) \in mp => BIRO.IRO.mp{2}.[(l, j)] = mp.[(l, j)]) /\ - (forall l j, (l, j) \in BIRO.IRO.mp{2} => ((l, j) \in mp) \/ (l = x0{2} /\ 0 <= j < i{2})) /\ - (forall j, 0 <= j < i{2} => (x0{2}, j) \in BIRO.IRO.mp{2}) /\ - l0{1} = bs0{2} /\ bs0{2} = - map (fun (j : int) => oget BIRO.IRO.mp{2}.[(x0{2}, j)]) (range 0 i{2})); progress. - + smt(take_oversize). - + smt(take_oversize). - while(0 <= i{2} <= size_out /\ size l0{1} = i{2} /\ n0{2} = size_out /\ - ={i} /\ n{1} = n0{2} /\ - same_ro SRO.RO.RO.m{1} mp /\ x0{2} \notin SRO.RO.RO.m{1} /\ - (forall l j, (l,j) \in mp => (l,j) \in BIRO.IRO.mp{2}) /\ - (forall l j, (l,j) \in mp => BIRO.IRO.mp{2}.[(l, j)] = mp.[(l, j)]) /\ - (forall l j, (l, j) \in BIRO.IRO.mp{2} => ((l, j) \in mp) \/ (l = x0{2} /\ 0 <= j < i{2})) /\ - (forall j, 0 <= j < i{2} => (x0{2}, j) \in BIRO.IRO.mp{2}) /\ - l0{1} = bs0{2} /\ bs0{2} = - map (fun (j : int) => oget BIRO.IRO.mp{2}.[(x0{2}, j)]) (range 0 i{2})). - + sp; wp=> //=. - rcondt{2} 1; 1:auto; progress. - - have[]h1 [] h2 h3 := H1. - have:=h2 x0{hr}; rewrite H2/= negb_exists/= =>/(_ (size bs0{hr})). - rewrite size_ge0 H9/=; apply absurd =>/= h. - by have //=:= H5 _ _ h. - rnd; auto; progress. - - smt(size_ge0). - - smt(). - - by rewrite size_cat/=. - - by rewrite mem_set; left; rewrite H3. - - rewrite get_setE (H4 _ _ H12). - cut/#: !(l1, j) = (x0{2}, size bs0{2}). - move:H2; apply absurd=> //=[#] <<- ->>. - have[] h1 [] h2 h3 := H1. - by apply h2; smt(). - - move:H12; rewrite mem_set. - case((l1, j) \in BIRO.IRO.mp{2})=>//= h; 1: smt(). - by move=> [#] <<- ->> //=; rewrite size_ge0; smt(). - - rewrite mem_set. - case(j = size bs0{2})=>//=. - move=> h; rewrite h /=; have {H13} H13 {h} : j < size bs0{2} by smt(). - by apply H6. - - by rewrite cats1 get_set_sameE oget_some. - - rewrite get_set_sameE oget_some H7 rangeSr. - rewrite !size_map 1:size_ge0. - rewrite (size_map _ (range 0 (size bs0{2}))) size_range /=. - rewrite max_ler 1:size_ge0 map_rcons /=get_set_sameE oget_some; congr. - apply eq_in_map=> j. - rewrite mem_range /==> [] [] hj1 hj2. - by rewrite get_set_neqE //=; smt(). - auto; progress. - + smt(size_out_gt0). - + smt(). - + smt(). - + by rewrite range_geq. - smt(). - qed. + return y; + } +}. - lemma Sponge_second_preimage_resistant &m mess : - (D2Pre.m2{m} = mess) => - Pr[SRO.SecondPreimage(A, FM(CSetSize(Sponge), Perm)).main(mess) @ &m : res] <= - (limit ^ 2 - limit)%r / (2 ^ (r + c + 1))%r + - (4 * limit ^ 2)%r / (2 ^ c)%r + - (sigma + 1)%r / (2%r ^ size_out). - proof. - move=> init_mess. - rewrite -(doutE1 witness). - rewrite(second_preimage_resistant_if_indifferentiable A A_ll (CSetSize(Sponge)) Perm &m mess init_mess). - exists (SimSetSize(Simulator)); split. - + by move=> F _; proc; inline*; auto. - cut->:Pr[Indiff0.Indif(CSetSize(Sponge, Perm), Perm, D2Pre(A)).main() @ &m : res] = - Pr[RealIndif(Sponge, Perm, DRestr(DSetSize(D2Pre(A)))).main() @ &m : res]. - + byequiv=>//=; proc. - inline Perm.init CSetSize(Sponge, Perm).init Sponge(Perm).init - FC(Sponge(Perm)).init; sp. - inline D2Pre(A, CSetSize(Sponge, Perm), Perm).distinguish. - inline DRestr(DSetSize(D2Pre(A)), Sponge(Perm), Perm).distinguish - DSetSize(D2Pre(A), FC(Sponge(Perm)), PC(Perm)).distinguish Cntr.init. - inline SRO.SecondPreimage(A, FInit(CSetSize(Sponge, Perm))).main - SRO.SecondPreimage(A, FInit(DFSetSize(FC(Sponge(Perm))))).main. - inline SRO.Bounder(FInit(CSetSize(Sponge, Perm))).init - SRO.Bounder(FInit(DFSetSize(FC(Sponge(Perm))))).init - SRO.Counter.init FInit(DFSetSize(FC(Sponge(Perm)))).init - FInit(CSetSize(Sponge, Perm)).init. - wp; sp; sim. - seq 1 1 : (={m1, m2, glob SRO.Counter, glob Perm} - /\ invm Perm.m{1} Perm.mi{1} - /\ ={c}(SRO.Counter,Cntr)); last first. - - if; auto; sp. - case(SRO.Counter.c{1} + ((size m2{1} + 1) %/ r + 1) + - max ((size_out + r - 1) %/ r - 1) 0 < limit); last first. - * rcondf{1} 2; 1: by auto; inline*; auto; conseq(: _ ==> true); auto. - rcondf{2} 2; 1: by auto; inline*; auto; conseq(: _ ==> true); auto. - auto; inline*; auto; sp; conseq(: _ ==> true); auto. - if{2}; sp; auto; sim. - while{1}(invm Perm.m{1} Perm.mi{1}) (((size_out + r - 1) %/ r)-i{1}). - + auto; sp; if; auto. - - sp; if ;auto; progress. - * exact (useful _ _ _ H H2). - * rewrite invm_set=>//=. - by move:H4; rewrite supp_dexcepted. - * smt(). - smt(). - smt(). - conseq(:_==> invm Perm.m{1} Perm.mi{1}); 1:smt(). - while{1}(invm Perm.m{1} Perm.mi{1})(size xs{1}). - + move=> _ z; auto; sp; if; auto; progress. - * exact (useful _ _ _ H H1). - * rewrite invm_set=>//=. - by move:H3; rewrite supp_dexcepted. - * smt(). - smt(). - auto; smt(size_ge0 size_eq0). - rcondt{1} 2; first by auto; inline*; auto; conseq(:_==> true); auto. - rcondt{2} 2; first by auto; inline*; auto; conseq(:_==> true); auto. - sim. - exists* m1{1}, m2{1}; elim* => a1 a2 c1 c2. - call (equiv_sponge_perm (c2 + ((size a1 + 1) %/ r + 1) + max ((size_out + r - 1) %/ r - 1) 0) a2). - auto; call (equiv_sponge_perm c2 a1); auto; progress. - smt(List.size_ge0 divz_ge0 gt0_r). - smt(List.size_ge0 divz_ge0 gt0_r). - call(: ={glob SRO.Counter, glob Perm, glob SRO.Bounder} - /\ invm Perm.m{1} Perm.mi{1} /\ ={c}(SRO.Counter,Cntr)). - + proc; sp; if; auto; sp; if; auto; sp. - exists * x{1}; elim* => m c1 c2 b1 b2. - by call(equiv_sponge_perm c1 m); auto; smt(). - inline*; auto; progress. - by rewrite /invm=> x y; rewrite 2!emptyE. - cut->:Pr[Indiff0.Indif(RO, SimSetSize(Simulator, RO), D2Pre(A)).main() @ &m : res] = - Pr[IdealIndif(BIRO.IRO, Simulator, DRestr(DSetSize(D2Pre(A)))).main() @ &m : res]. - + byequiv=>//=; proc. - inline Simulator(FGetSize(RO)).init RO.init Simulator(BIRO.IRO).init - BIRO.IRO.init Gconcl_list.BIRO2.IRO.init; sp. - inline D2Pre(A, RO, Simulator(FGetSize(RO))).distinguish. - inline DRestr(DSetSize(D2Pre(A)), BIRO.IRO, Simulator(BIRO.IRO)).distinguish - DSetSize(D2Pre(A), FC(BIRO.IRO), PC(Simulator(BIRO.IRO))).distinguish; wp; sim. - inline SRO.Bounder(FInit(DFSetSize(FC(BIRO.IRO)))).init - SRO.Bounder(FInit(RO)).init SRO.Counter.init FInit(RO).init - FInit(DFSetSize(FC(BIRO.IRO))).init Cntr.init; sp. - inline SRO.SecondPreimage(A, FInit(RO)).main - SRO.SecondPreimage(A, FInit(DFSetSize(FC(BIRO.IRO)))).main. - inline SRO.Bounder(FInit(RO)).init - SRO.Bounder(FInit(DFSetSize(FC(BIRO.IRO)))).init SRO.Counter.init - FInit(RO).init FInit(DFSetSize(FC(BIRO.IRO))).init. - sp; sim. - seq 1 1 : (={m1, m2, glob SRO.Counter} - /\ ={c}(SRO.Counter,Cntr) - /\ same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2}); last first. - - if; auto; sp. - case: (SRO.Counter.c{1} + ((size m2{1} + 1) %/ r + 1) + - max ((size_out + r - 1) %/ r - 1) 0 < limit); last first. - * rcondf{1} 2; first by auto; inline*; auto. - rcondf{2} 2; first auto; inline*; auto; sp. - + rcondt 1; first by auto; smt(). - by sp; rcondt 1; auto; conseq(:_==> true); auto. - inline*;sp; auto. - rcondt{2} 1; first by auto; smt(). - conseq(:_==> true); first smt(dout_ll). - sp; rcondt{2} 1; auto; conseq(:_==> true); auto. - by while{2}(true)(n0{2}-i{2}); auto; 1:(sp; if; auto); smt(dbool_ll). - rcondt{1} 2; first by auto; inline*; auto. - rcondt{2} 2; first auto; inline*; auto; sp. - + rcondt 1; first by auto; smt(). - by sp; rcondt 1; auto; conseq(:_==> true); auto. - sim. - exists* m1{1}, m2{1}; elim*=> a1 a2 c1 c2. - call(equiv_ro_iro (c2 + ((size a1 + 1) %/ r + 1) + - max ((size_out + r - 1) %/ r - 1) 0) a2). - auto; call(equiv_ro_iro c2 a1); auto; smt(). - call(: ={glob SRO.Counter, glob SRO.Bounder} /\ ={c}(SRO.Counter,Cntr) - /\ same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2}); auto. - + proc; sp; if; auto; sp; if; auto; sp. - exists* x{1}; elim* => a c1 c2 b1 b2. - call(equiv_ro_iro c1 a); auto; smt(). - smt(mem_empty). - have->//=:= SHA3Indiff (DSetSize(D2Pre(A))) &m _. - move=> F P P_f_ll P_fi_ll F_ll; proc; inline*; auto; sp. - seq 1 : true; auto. - + call (A_ll (SRO.Bounder(FInit(DFSetSize(F))))); auto. - by proc; inline*; sp; if; auto; sp; if; auto; sp; call F_ll; auto. - if; auto; sp. - seq 1 : true; auto. - + by call F_ll; auto. - sp; if; auto; sp; call F_ll; auto. - qed. -end section SecondPreimage. +local equiv eq_extend : + ExtendSample(FSome(BIRO.IRO)).f ~ ExtendOutputSize(FSetSize(FSome(BIRO.IRO))).f : + ={arg} /\ eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2} ==> + ={res} /\ eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}. +proof. +proc; inline*; auto; sp. +rcondt{2} 1; 1: auto. +if{1}; sp. +- rcondt{1} 1; auto. + rcondf{2} 8; 1: auto. + - conseq(:_==> true); 1: smt(). + by while(true); auto. + auto=> /=. + conseq(:_==> ={bs, k} /\ size bs{1} = size_out /\ + eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2})=> //=. + - smt(cats0 to_listK spec2_dout). + while(={k, bs, n, x2} /\ i{1} = i0{2} /\ n{1} = size_out /\ + 0 <= i{1} <= n{1} /\ size bs{1} = i{1} /\ + eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}). + - by sp; if; auto; smt(domE get_setE size_rcons). + by auto; smt(size_eq0 size_out_gt0). +rcondt{1} 1; 1: auto. +splitwhile{1} 1 : i0 < size_out; auto=> /=. +while( (i0, n0, x3){1} = (i, k, x){2} /\ bs0{1} = prefix{2} ++ suffix{2} /\ + size_out <= i{2} <= k{2} /\ eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}). ++ by sp; if; auto; smt(domE get_setE size_out_gt0 rcons_cat). +auto=> //=. +conseq(:_==> ={i0} /\ size bs{2} = i0{1} /\ (i0, x3){1} = (n, x2){2} /\ + bs0{1} = bs{2} /\ size bs{2} = size_out /\ + eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}). ++ smt(cats0 take_oversize spec_dout to_listK spec2_dout). +while(={i0} /\ x3{1} = x2{2} /\ 0 <= i0{1} <= n{2} /\ n{2} = size_out /\ + bs0{1} = bs{2} /\ size bs{2} = i0{1} /\ size_out <= n0{1} /\ + eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}). ++ by sp; if; auto; smt(size_rcons domE get_setE size_rcons mem_set). +by auto; smt(size_out_gt0). +qed. +local lemma of_listK l : of_list (to_list l) = Some l. +proof. +by rewrite -to_listK. +qed. -section Collision. +local module Fill_In (F : RO) = { + proc init = F.init + proc f (x : bool list, n : int) = { + var l, b, i; + i <- 0; + l <- []; + while (i < n) { + b <@ F.get((x,i)); + l <- rcons l b; + i <- i + 1; + } + while (i < size_out) { + F.sample((x,i)); + i <- i + 1; + } + return l; + } +}. - declare module A : SRO.AdvCollision{SRO.RO.RO, SRO.RO.FRO, SRO.Bounder, Perm, - Gconcl_list.BIRO2.IRO, Simulator, Cntr, BIRO.IRO, F.RO, F.FRO, Redo, C, - Gconcl.S, BlockSponge.BIRO.IRO, BlockSponge.C, Gconcl_list.F2.RO, - Gconcl_list.F2.FRO, Gconcl_list.Simulator}. +print module RO. - axiom A_ll (F <: SRO.Oracle) : islossless F.get => islossless A(F).guess. +local equiv eq_eager_ideal : + BIRO.IRO.f ~ Fill_In(LRO).f : + ={arg} /\ BIRO.IRO.mp{1} = RO.m{2} ==> + ={res} /\ BIRO.IRO.mp{1} = RO.m{2}. +proof. +proc; inline*; sp; rcondt{1} 1; auto. +while{2}(bs{1} = l{2} /\ BIRO.IRO.mp{1} = RO.m{2})(size_out - i{2}). ++ by auto=> />; smt(). +conseq(:_==> bs{1} = l{2} /\ BIRO.IRO.mp{1} = RO.m{2}); 1: smt(). +while(={i, n, x} /\ bs{1} = l{2} /\ BIRO.IRO.mp{1} = RO.m{2}). ++ sp; if{1}. + - by rcondt{2} 2; auto=> />. + by rcondf{2} 2; auto=> />; smt(dbool_ll). +by auto. +qed. - local lemma invm_dom_rng (m mi : (state, state) fmap) : - invm m mi => dom m = rng mi. - proof. - move=>h; rewrite fun_ext=> x; rewrite domE rngE /= eq_iff; have h2 := h x; split. - + move=> m_x_not_None; exists (oget m.[x]); rewrite -h2; move: m_x_not_None. - by case: (m.[x]). - by move=> [] a; rewrite -h2 => ->. - qed. +local equiv eq_eager_ideal2 : + ExtendSample(FSome(BIRO.IRO)).f ~ FSome(Fill_In(RO)).f : + ={arg} /\ BIRO.IRO.mp{1} = RO.m{2} ==> + ={res} /\ BIRO.IRO.mp{1} = RO.m{2}. +proof. +proc; inline*; sp. +if{1}; sp. ++ rcondt{1} 1; auto=> /=/>. + conseq(:_==> take k{1} bs{1} = l{2} /\ BIRO.IRO.mp{1} = RO.m{2}). + * smt(). + case: (0 <= n{2}); last first. + + rcondf{2} 1; 1: by auto; smt(). + conseq(:_==> BIRO.IRO.mp{1} = RO.m{2} /\ ={i} /\ n{1} = size_out /\ x2{1} = x0{2})=> />. + - smt(take_le0). + while(={i} /\ x2{1} = x0{2} /\ n{1} = size_out /\ BIRO.IRO.mp{1} = RO.m{2}). + - sp; if{1}. + - by rcondt{2} 2; auto=> />. + by rcondf{2} 2; auto=> />; smt(dbool_ll). + by auto=> />. + splitwhile{1} 1 : i < k. + while(={i} /\ n{1} = size_out /\ x2{1} = x0{2} /\ BIRO.IRO.mp{1} = RO.m{2} /\ + take k{1} bs{1} = l{2} /\ size bs{1} = i{1} /\ k{1} <= i{1} <= size_out). + * sp; if{1}. + - by rcondt{2} 2; auto; smt(dbool_ll cats1 take_cat cats0 take_size size_rcons). + by rcondf{2} 2; auto; smt(dbool_ll cats1 take_cat cats0 take_size size_rcons). + conseq(:_==> ={i} /\ n{1} = size_out /\ x2{1} = x0{2} /\ BIRO.IRO.mp{1} = RO.m{2} /\ + bs{1} = l{2} /\ size bs{1} = i{1} /\ k{1} = i{1}). + + smt(take_size). + while(={i} /\ x2{1} = x0{2} /\ n{1} = size_out /\ k{1} = n{2} /\ + 0 <= i{1} <= k{1} <= size_out /\ bs{1} = l{2} /\ size bs{1} = i{1} /\ + BIRO.IRO.mp{1} = RO.m{2}). + + sp; if{1}. + - by rcondt{2} 2; auto; smt(size_rcons). + by rcondf{2} 2; auto; smt(size_rcons dbool_ll). + by auto; smt(size_ge0 size_out_gt0). +rcondt{1} 1; auto. +rcondf{2} 2; 1: auto. ++ conseq(:_==> i = n); 1: smt(). + by while(i <= n); auto=> />; smt(size_out_gt0). +while(i0{1} = i{2} /\ x3{1} = x0{2} /\ n0{1} = n{2} /\ bs0{1} = l{2} /\ + BIRO.IRO.mp{1} = RO.m{2}). ++ sp; if{1}. + - by rcondt{2} 2; auto=> />. + by rcondf{2} 2; auto; smt(dbool_ll). +by auto=> />. +qed. - local lemma invmC' (m mi : (state, state) fmap) : - invm m mi => invm mi m. - proof. by rewrite /#. qed. +local module Dist (F : RO) = { + proc distinguish = SHA3_OIndiff.OIndif.OIndif(FSome(Fill_In(F)), + OSimulator(FSome(Fill_In(F))), ODRestr(Dist_of_P2Adv(A))).main +}. - local lemma invmC (m mi : (state, state) fmap) : - invm m mi <=> invm mi m. - proof. by split;exact invmC'. qed. +local module Game (F : RO) = { + proc distinguish () = { + var bo; + OSimulator(FSome(Fill_In(F))).init(); + Counter.c <- 0; + Log.m <- empty; + F.init(); + bo <@ Dist(F).distinguish(); + return bo; + } +}. - local lemma useful m mi a : - invm m mi => ! a \in m => Distr.is_lossless ((bdistr `*` cdistr) \ rng m). - proof. - move=>hinvm nin_dom. - cut prod_ll:Distr.is_lossless (bdistr `*` cdistr). - + by rewrite dprod_ll DBlock.dunifin_ll DCapacity.dunifin_ll. - apply dexcepted_ll=>//=;rewrite-prod_ll. - cut->:predT = predU (predC (rng m)) (rng m);1:rewrite predCU//=. - rewrite Distr.mu_disjoint 1:predCI//=StdRing.RField.addrC. - cut/=->:=StdOrder.RealOrder.ltr_add2l (mu (bdistr `*` cdistr) (rng m)) 0%r. - rewrite Distr.witness_support/predC. - move:nin_dom;apply absurd=>//=;rewrite negb_exists/==>hyp. - cut{hyp}hyp:forall x, rng m x by smt(supp_dprod DBlock.supp_dunifin DCapacity.supp_dunifin). - move:a. - cut:=eqEcard (fdom m) (frng m);rewrite leq_card_rng_dom/=. - cut->//=:fdom m \subset frng m. - + by move=> x; rewrite mem_fdom mem_frng hyp. - smt(mem_fdom mem_frng). - qed. +local lemma eager_ideal &m : + Pr[SHA3_OIndiff.OIndif.OIndif(FSome(BIRO.IRO), + OSimulator(FSome(BIRO.IRO)), + ODRestr(Dist_of_P2Adv(A))).main() @ &m : res] = + Pr[SHA3_OIndiff.OIndif.OIndif(ExtendSample(FSome(BIRO.IRO)), + OSimulator(ExtendSample(FSome(BIRO.IRO))), + ODRestr(Dist_of_P2Adv(A))).main() @ &m : res]. +proof. +cut->: + Pr[SHA3_OIndiff.OIndif.OIndif(FSome(BIRO.IRO), + OSimulator(FSome(BIRO.IRO)), + ODRestr(Dist_of_P2Adv(A))).main() @ &m : res] = + Pr[Game(LRO).distinguish() @ &m : res]. ++ byequiv=> //=; proc. + inline{2} 1; sp; inline{2} 1; sp; inline{2} 1; sp; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp; sim. + seq 1 1 : (={m', glob Dist_of_P2Adv, glob OFC} /\ BIRO.IRO.mp{1} = RO.m{2}); last first. + - inline{1} 1; inline{2} 1; sp; sim. + inline{1} 1; inline{2} 1; sp; sim; if; auto. + * inline{1} 1; inline{2} 1; sp; sim. + inline{1} 7; inline{2} 7; sim. + inline{1} 8; inline{2} 8; sim. + swap 3 -2; sp. + case: (increase_counter Counter.c{1} m'{1} size_out <= SHA3Indiff.limit). + + rcondt{1} 10; 1: auto. + - inline*; auto. + by sp; rcondt 1; auto; conseq(:_==> true); auto. + rcondt{2} 10; 1: auto. + - inline*; auto. + by conseq(:_==> true); auto. + sim. + inline{1} 10; inline{2} 10; sim. + call eq_eager_ideal; auto. + by call eq_eager_ideal; auto. + rcondf{1} 10; 1: auto. + - inline*; auto. + by sp; rcondt 1; auto; conseq(:_==> true); auto. + rcondf{2} 10; 1: auto. + - inline*; auto. + by conseq(:_==> true); auto. + by auto; call eq_eager_ideal; auto. + sp; inline{1} 1; inline{2} 1; sp; sim. + inline{1} 1; inline{2} 1; sp; sim. + if; auto. + inline{1} 1; inline{2} 1; sp; sim. + by auto; call eq_eager_ideal; auto. + call(: ={glob OFC, glob OSimulator, glob Dist_of_P2Adv} /\ + BIRO.IRO.mp{1} = RO.m{2}); auto. + - proc; sp; if; auto. + inline{1} 1; inline{2} 1; sp; sim; if; 1: auto; sim. + if; 1: auto; sim; sp. + if; 1: auto; 1: smt(); sim. + * inline{1} 1; inline{2} 1; sp; sim. + by call eq_eager_ideal; auto; smt(). + smt(). + - by proc; inline*; sim. + proc; sim. + inline{1} 1; inline{2} 1; sp; sim; if; 1: auto; sim. + inline{1} 1; inline{2} 1; sp; sim. + by call eq_eager_ideal; auto. +cut->: + Pr[SHA3_OIndiff.OIndif.OIndif(ExtendSample(FSome(BIRO.IRO)), + OSimulator(ExtendSample(FSome(BIRO.IRO))), + ODRestr(Dist_of_P2Adv(A))).main() @ &m : res] = + Pr[Game(RO).distinguish() @ &m : res]. ++ byequiv=> //=; proc. + inline{2} 1; sp; inline{2} 1; sp; inline{2} 1; sp; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp; sim. + seq 1 1 : (={m', glob Dist_of_P2Adv, glob OFC} /\ BIRO.IRO.mp{1} = RO.m{2}); last first. + - inline{1} 1; inline{2} 1; sp; sim. + inline{1} 1; inline{2} 1; sp; sim; if; auto. + * inline{1} 6; inline{2} 6; sim. + inline{1} 7; inline{2} 7; sim. + swap 2 -1; sp. + case: (increase_counter Counter.c{1} m'{1} size_out <= SHA3Indiff.limit). + + rcondt{1} 9; 1: auto. + - inline*; auto. + by sp; rcondt 1; auto; conseq(:_==> true); auto. + rcondt{2} 9; 1: auto. + - inline*; auto. + by conseq(:_==> true); auto. + sim. + call eq_eager_ideal2; auto. + by call eq_eager_ideal2; auto. + rcondf{1} 9; 1: auto. + - inline*; auto. + by sp; rcondt 1; auto; conseq(:_==> true); auto. + rcondf{2} 9; 1: auto. + - inline*; auto. + by conseq(:_==> true); auto. + by auto; call eq_eager_ideal2; auto. + sp; inline{1} 1; inline{2} 1; sp; sim. + inline{1} 1; inline{2} 1; sp; sim. + if; auto. + by auto; call eq_eager_ideal2; auto. + call(: ={glob OFC, glob OSimulator, glob Dist_of_P2Adv} /\ + BIRO.IRO.mp{1} = RO.m{2}); auto. + - proc; sp; if; auto. + inline{1} 1; inline{2} 1; sp; sim; if; 1: auto; sim. + if; 1: auto; sim; sp. + if; 1: auto; 1: smt(); sim. + * by call eq_eager_ideal2; auto; smt(). + smt(). + - by proc; inline*; sim. + proc; sim. + inline{1} 1; inline{2} 1; sp; sim; if; 1: auto; sim. + by call eq_eager_ideal2; auto. +rewrite eq_sym; byequiv=> //=; proc. +by call(RO_LRO_D Dist); inline*; auto=> />. +qed. - local equiv equiv_sponge_perm c m : - FInit(CSetSize(Sponge, Perm)).get ~ FInit(DFSetSize(FC(Sponge(Perm)))).get : - ={arg, glob Perm} /\ invm Perm.m{1} Perm.mi{1} /\ - Cntr.c{2} = c /\ arg{2} = m /\ - (Cntr.c + ((size arg + 1) %/ Common.r + 1) + - max ((size_out + Common.r - 1) %/ Common.r - 1) 0 <= limit){2} ==> - ={res, glob Perm} /\ invm Perm.m{1} Perm.mi{1} /\ - Cntr.c{2} = c + ((size m + 1) %/ Common.r + 1) + - max ((size_out + Common.r - 1) %/ Common.r - 1) 0. - proof. - proc; inline FC(Sponge(Perm)).f; sp. - rcondt{2} 1; auto; sp. - call(: ={glob Perm} /\ invm Perm.m{1} Perm.mi{1})=>/=; auto; inline*. - while(={i, n, sa, sc, z, glob Perm} /\ invm Perm.m{1} Perm.mi{1}); auto. - + sp; if; auto; sp; if; auto; progress. - rewrite invm_set //=. - by move:H4; rewrite supp_dexcepted. - sp; conseq(:_==> ={i, n, sa, sc, glob Perm} /\ invm Perm.m{1} Perm.mi{1}); auto. - while(={xs, sa, sc, glob Perm} /\ invm Perm.m{1} Perm.mi{1}); auto. - sp; if; auto; progress. - rewrite invm_set=>//=. - by move:H4; rewrite supp_dexcepted. - qed. - clone import Program as Prog3 with - type t <- bool, - op d <- dbool - proof *. - - local equiv equiv_ro_iro c m : - FInit(RO).get ~ FInit(DFSetSize(FC(BIRO.IRO))).get : - ={arg} /\ same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2} /\ - arg{2} = m /\ Cntr.c{2} = c /\ - (Cntr.c + ((size arg + 1) %/ Common.r + 1) + - max ((size_out + Common.r - 1) %/ Common.r - 1) 0 <= limit){2} - ==> ={res} /\ same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2} /\ - Cntr.c{2} = c + ((size m + 1) %/ Common.r + 1) + - max ((size_out + Common.r - 1) %/ Common.r - 1) 0. - proof. - proc; inline *; sp; rcondt{2} 1; 1: auto. - swap{2} 1 5; sp; wp 2 1. - conseq(:_==> oget SRO.RO.RO.m{1}.[x{1}] = oget (of_list bs0{2}) /\ - same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2}); 1:by auto. - rcondt{2} 1; 1: auto. - case: (x{1} \in SRO.RO.RO.m{1}). - + rcondf{1} 2; auto. - exists* BIRO.IRO.mp{2}; elim* => mp. - while{2}(bs0{2} = map (fun j => oget BIRO.IRO.mp{2}.[(x0{2},j)]) (range 0 i{2}) - /\ n0{2} = size_out /\ x0{2} \in SRO.RO.RO.m{1} /\ 0 <= i{2} <= size_out - /\ same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2} /\ BIRO.IRO.mp{2} = mp) - (size_out - i{2}); auto. - - sp; rcondf 1; auto; 1: smt(). - progress. - * have/=<-:= map_rcons (fun (j : int) => oget BIRO.IRO.mp{hr}.[(x0{hr}, j)]) (range 0 i{hr}) i{hr}. - by rewrite !rangeSr //=. - * smt(). - * smt(). - * smt(). - progress. - - by rewrite range_geq. - - smt(size_out_gt0). - - smt(). - - exact(dout_ll). - - have[] h[#] h1 h2 := H. - cut->:i_R = size_out by smt(). - cut<-:=h2 _ H3. - smt(to_listK). - rcondt{1} 2; 1: auto; wp =>/=. - exists* BIRO.IRO.mp{2}; elim* => mp. - conseq(:_==> - same_ro SRO.RO.RO.m{1} mp /\ i{2} = size_out /\ - (forall (l,j), (l,j) \in mp => (l,j) \in BIRO.IRO.mp{2}) /\ - (forall (l,j), (l,j) \in mp => BIRO.IRO.mp{2}.[(l,j)] = mp.[(l,j)]) /\ - (forall (l,j), (l,j) \in BIRO.IRO.mp{2} => (l,j) \in mp \/ (l = x0{2} /\ 0 <= j < i{2})) /\ - (forall j, 0 <= j < i{2} => (x0{2},j) \in BIRO.IRO.mp{2}) /\ - take i{2} (to_list r{1}) = bs0{2} /\ - take i{2} (to_list r{1}) = map (fun (j : int) => oget BIRO.IRO.mp{2}.[(x0{2}, j)]) (range 0 i{2})); progress=>//=. - + by rewrite get_set_sameE /= oget_some; smt(to_listK take_oversize spec_dout). - + move:H8; rewrite mem_set=>[][]//=h; 1:rewrite H3=>//=. - - by have []h1 []h2 h3:= H2; have->//:=h1 _ h. - by move:h => <<-; rewrite H6 //=. - + rewrite mem_set //=; have [] //= h:= H5 _ _ H11; left. - have []h1 []->//=:= H2. - by exists i0=>//=. - + move:H7; rewrite take_oversize 1:spec_dout//= => H7. - move:H10; rewrite mem_set. - case(m \in SRO.RO.RO.m{1})=>//=h. - - rewrite get_set_neqE; 1:smt(). - have []h1 []h2 ->//=:= H2. - by apply eq_in_map=> j;rewrite mem_range=>[][]hj1 hj2/=; rewrite H4//=h1//=. - by move=><<-; rewrite get_set_eqE//=. - alias{1} 1 l = [<:bool>]. - transitivity{1} { - l <@ Sample.sample(size_out); - r <- oget (of_list l); - } - (={glob SRO.RO.RO, x} ==> ={glob SRO.RO.RO, r}) - (x{1} = x0{2} /\ i{2} = 0 /\ n0{2} = size_out /\ mp = BIRO.IRO.mp{2} /\ - same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2} /\ x{1} \notin SRO.RO.RO.m{1} /\ - bs0{2} = [] - ==> - same_ro SRO.RO.RO.m{1} mp /\ i{2} = size_out /\ - (forall (l,j), (l,j) \in mp => (l,j) \in BIRO.IRO.mp{2}) /\ - (forall (l,j), (l,j) \in mp => BIRO.IRO.mp{2}.[(l,j)] = mp.[(l,j)]) /\ - (forall (l,j), (l,j) \in BIRO.IRO.mp{2} => (l,j) \in mp \/ (l = x0{2} /\ 0 <= j < i{2})) /\ - (forall j, 0 <= j < i{2} => (x0{2},j) \in BIRO.IRO.mp{2}) /\ - take i{2} (to_list r{1}) = bs0{2} /\ - take i{2} (to_list r{1}) = - map (fun (j : int) => oget BIRO.IRO.mp{2}.[(x0{2}, j)]) (range 0 i{2})); - progress. - + smt(). - + inline*; sp; wp. - rnd to_list (fun x => oget (of_list x)); auto; progress. - - smt(spec_dout supp_dlist to_listK spec2_dout size_out_gt0). - - rewrite -dout_equal_dlist dmap1E; apply mu_eq=> x/=. - smt(to_listK). - - rewrite-dout_equal_dlist supp_dmap; smt(dout_full). - smt(to_listK). - wp=>/=. - conseq(:_==> i{2} = size_out /\ size l{1} = size_out /\ - (forall (l0 : bool list) (j : int), - (l0, j) \in mp => (l0, j) \in BIRO.IRO.mp{2}) /\ - (forall (l0 : bool list) (j : int), - (l0, j) \in mp => BIRO.IRO.mp{2}.[(l0, j)] = mp.[(l0, j)]) /\ - (forall (l0 : bool list) (j : int), - (l0, j) \in BIRO.IRO.mp{2} => ((l0, j) \in mp) \/ (l0 = x0{2} /\ 0 <= j < i{2})) /\ - (forall (j : int), 0 <= j < i{2} => (x0{2}, j) \in BIRO.IRO.mp{2}) /\ - take i{2} l{1} = bs0{2} /\ - take i{2} l{1} = - map (fun (j : int) => oget BIRO.IRO.mp{2}.[(x0{2}, j)]) (range 0 i{2})); - progress. - + have[]//=h h1:=to_listK (oget (of_list l_L)) l_L; rewrite h1//==> {h1 h}. - smt(spec2_dout). - + have[]//=h h1:=to_listK (oget (of_list l_L)) l_L; rewrite h1//==> {h1 h}. - smt(spec2_dout). - transitivity{1} { - l <@ LoopSnoc.sample(size_out); - } - (={glob SRO.RO.RO} ==> ={glob SRO.RO.RO, l}) - (x{1} = x0{2} /\ i{2} = 0 /\ n0{2} = size_out /\ mp = BIRO.IRO.mp{2} /\ - same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2} /\ x0{2} \notin SRO.RO.RO.m{1} /\ - bs0{2} = [] - ==> - i{2} = size_out /\ size l{1} = size_out /\ - (forall (l,j), (l,j) \in mp => (l,j) \in BIRO.IRO.mp{2}) /\ - (forall (l,j), (l,j) \in mp => BIRO.IRO.mp{2}.[(l,j)] = mp.[(l,j)]) /\ - (forall (l,j), (l,j) \in BIRO.IRO.mp{2} => (l,j) \in mp \/ (l = x0{2} /\ 0 <= j < i{2})) /\ - (forall j, 0 <= j < i{2} => (x0{2},j) \in BIRO.IRO.mp{2}) /\ - take i{2} l{1} = bs0{2} /\ - take i{2} l{1} = - map (fun (j : int) => oget BIRO.IRO.mp{2}.[(x0{2}, j)]) (range 0 i{2})); - progress. - + smt(). - + by call Sample_LoopSnoc_eq; auto. - inline*; sp; wp. - conseq(:_==> i{2} = size_out /\ size l0{1} = i{2} /\ - same_ro SRO.RO.RO.m{1} mp /\ x0{2} \notin SRO.RO.RO.m{1} /\ - (forall l j, (l,j) \in mp => (l,j) \in BIRO.IRO.mp{2}) /\ - (forall l j, (l,j) \in mp => BIRO.IRO.mp{2}.[(l, j)] = mp.[(l, j)]) /\ - (forall l j, (l, j) \in BIRO.IRO.mp{2} => ((l, j) \in mp) \/ (l = x0{2} /\ 0 <= j < i{2})) /\ - (forall j, 0 <= j < i{2} => (x0{2}, j) \in BIRO.IRO.mp{2}) /\ - l0{1} = bs0{2} /\ bs0{2} = - map (fun (j : int) => oget BIRO.IRO.mp{2}.[(x0{2}, j)]) (range 0 i{2})); progress. - + smt(take_oversize). - + smt(take_oversize). - while(0 <= i{2} <= size_out /\ size l0{1} = i{2} /\ n0{2} = size_out /\ - ={i} /\ n{1} = n0{2} /\ - same_ro SRO.RO.RO.m{1} mp /\ x0{2} \notin SRO.RO.RO.m{1} /\ - (forall l j, (l,j) \in mp => (l,j) \in BIRO.IRO.mp{2}) /\ - (forall l j, (l,j) \in mp => BIRO.IRO.mp{2}.[(l, j)] = mp.[(l, j)]) /\ - (forall l j, (l, j) \in BIRO.IRO.mp{2} => ((l, j) \in mp) \/ (l = x0{2} /\ 0 <= j < i{2})) /\ - (forall j, 0 <= j < i{2} => (x0{2}, j) \in BIRO.IRO.mp{2}) /\ - l0{1} = bs0{2} /\ bs0{2} = - map (fun (j : int) => oget BIRO.IRO.mp{2}.[(x0{2}, j)]) (range 0 i{2})). - + sp; wp=> //=. - rcondt{2} 1; 1:auto; progress. - - have[]h1 [] h2 h3 := H1. - have:=h2 x0{hr}; rewrite H2/= negb_exists/= =>/(_ (size bs0{hr})). - rewrite size_ge0 H9/=; apply absurd =>/= h. - by have //=:= H5 _ _ h. - rnd; auto; progress. - - smt(size_ge0). - - smt(). - - by rewrite size_cat/=. - - by rewrite mem_set; left; rewrite H3. - - rewrite get_setE (H4 _ _ H12). - cut/#: !(l1, j) = (x0{2}, size bs0{2}). - move:H2; apply absurd=> //=[#] <<- ->>. - have[] h1 [] h2 h3 := H1. - by apply h2; smt(). - - move:H12; rewrite mem_set. - case((l1, j) \in BIRO.IRO.mp{2})=>//= h; 1: smt(). - by move=> [#] <<- ->> //=; rewrite size_ge0; smt(). - - rewrite mem_set. - case(j = size bs0{2})=>//=. - move=> h; rewrite h /=; have {H13} H13 {h} : j < size bs0{2} by smt(). - by apply H6. - - by rewrite cats1 get_set_sameE oget_some. - - rewrite get_set_sameE oget_some H7 rangeSr. - rewrite !size_map 1:size_ge0. - rewrite (size_map _ (range 0 (size bs0{2}))) size_range /=. - rewrite max_ler 1:size_ge0 map_rcons /=get_set_sameE oget_some; congr. - apply eq_in_map=> j. - rewrite mem_range /==> [] [] hj1 hj2. - by rewrite get_set_neqE //=; smt(). - auto; progress. - + smt(size_out_gt0). - + smt(). - + smt(). - + by rewrite range_geq. - smt(). - qed. - lemma Sponge_coll_resistant &m : - Pr[SRO.Collision(A, FM(CSetSize(Sponge), Perm)).main() @ &m : res] <= - (limit ^ 2 - limit)%r / (2 ^ (r + c + 1))%r + - (4 * limit ^ 2)%r / (2 ^ c)%r + - (sigma * (sigma - 1) + 2)%r / 2%r / (2%r ^ size_out). - proof. - rewrite -(doutE1 witness). - rewrite (coll_resistant_if_indifferentiable A A_ll (CSetSize(Sponge)) Perm &m). - exists (SimSetSize(Simulator)); split. - + by move=> F _; proc; inline*; auto. - cut->:Pr[Indiff0.Indif(CSetSize(Sponge, Perm), Perm, DColl(A)).main() @ &m : res] = - Pr[RealIndif(Sponge, Perm, DRestr(DSetSize(DColl(A)))).main() @ &m : res]. - + byequiv=>//=; proc. - inline Perm.init CSetSize(Sponge, Perm).init Sponge(Perm).init - FC(Sponge(Perm)).init; sp. - inline DColl(A, CSetSize(Sponge, Perm), Perm).distinguish. - inline DRestr(DSetSize(DColl(A)), Sponge(Perm), Perm).distinguish - DSetSize(DColl(A), FC(Sponge(Perm)), PC(Perm)).distinguish Cntr.init; wp; sp; sim. - seq 2 2 : (={m1, m2, glob SRO.Counter, glob Perm} - /\ invm Perm.m{1} Perm.mi{1} - /\ ={c}(SRO.Counter,Cntr)); last first. - - if; auto; sp. - case(SRO.Counter.c{1} + ((size m2{1} + 1) %/ r + 1) + - max ((size_out + r - 1) %/ r - 1) 0 < limit); last first. - * rcondf{1} 2; 1: by auto; inline*; auto; conseq(: _ ==> true); auto. - rcondf{2} 2; 1: by auto; inline*; auto; conseq(: _ ==> true); auto. - auto; inline*; auto; sp; conseq(: _ ==> true); auto. - if{2}; sp; auto; sim. - while{1}(invm Perm.m{1} Perm.mi{1}) (((size_out + r - 1) %/ r)-i{1}). - + auto; sp; if; auto. - - sp; if ;auto; progress. - * exact (useful _ _ _ H H2). - * rewrite invm_set=>//=. - by move:H4; rewrite supp_dexcepted. - * smt(). - smt(). - smt(). - conseq(:_==> invm Perm.m{1} Perm.mi{1}); 1:smt(). - while{1}(invm Perm.m{1} Perm.mi{1})(size xs{1}). - + move=> _ z; auto; sp; if; auto; progress. - * exact (useful _ _ _ H H1). - * rewrite invm_set=>//=. - by move:H3; rewrite supp_dexcepted. - * smt(). - smt(). - auto; smt(size_ge0 size_eq0). - rcondt{1} 2; first by auto; inline*; auto; conseq(:_==> true); auto. - rcondt{2} 2; first by auto; inline*; auto; conseq(:_==> true); auto. - sim. - exists* m1{1}, m2{1}; elim* => a1 a2 c1 c2. - call (equiv_sponge_perm (c2 + ((size a1 + 1) %/ r + 1) + max ((size_out + r - 1) %/ r - 1) 0) a2). - auto; call (equiv_sponge_perm c2 a1); auto; progress. - smt(List.size_ge0 divz_ge0 gt0_r). - smt(List.size_ge0 divz_ge0 gt0_r). - call(: ={glob SRO.Counter, glob Perm, glob SRO.Bounder} - /\ invm Perm.m{1} Perm.mi{1} /\ ={c}(SRO.Counter,Cntr)). - + proc; sp; if; auto; sp; if; auto; sp. - exists * x{1}; elim* => m c1 c2 b1 b2. - by call(equiv_sponge_perm c1 m); auto; smt(). - inline*; auto; progress. - by rewrite /invm=> x y; rewrite 2!emptyE. - cut->:Pr[Indiff0.Indif(RO, SimSetSize(Simulator, RO), DColl(A)).main() @ &m : res] = - Pr[IdealIndif(BIRO.IRO, Simulator, DRestr(DSetSize(DColl(A)))).main() @ &m : res]. - + byequiv=>//=; proc. - inline Simulator(FGetSize(RO)).init RO.init Simulator(BIRO.IRO).init - BIRO.IRO.init Gconcl_list.BIRO2.IRO.init; sp. - inline DColl(A, RO, Simulator(FGetSize(RO))).distinguish. - inline DRestr(DSetSize(DColl(A)), BIRO.IRO, Simulator(BIRO.IRO)).distinguish - DSetSize(DColl(A), FC(BIRO.IRO), PC(Simulator(BIRO.IRO))).distinguish; wp; sim. - inline SRO.Bounder(FInit(DFSetSize(FC(BIRO.IRO)))).init - SRO.Bounder(FInit(RO)).init SRO.Counter.init FInit(RO).init - FInit(DFSetSize(FC(BIRO.IRO))).init Cntr.init; sp. - seq 1 1 : (={m1, m2, glob SRO.Counter} - /\ ={c}(SRO.Counter,Cntr) - /\ same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2}); last first. - - if; auto; sp. - case: (SRO.Counter.c{1} + ((size m2{1} + 1) %/ r + 1) + - max ((size_out + r - 1) %/ r - 1) 0 < limit); last first. - * rcondf{1} 2; first by auto; inline*; auto. - rcondf{2} 2; first auto; inline*; auto; sp. - + rcondt 1; first by auto; smt(). - by sp; rcondt 1; auto; conseq(:_==> true); auto. - inline*;sp; auto. - rcondt{2} 1; first by auto; smt(). - conseq(:_==> true); first smt(dout_ll). - sp; rcondt{2} 1; auto; conseq(:_==> true); auto. - by while{2}(true)(n0{2}-i{2}); auto; 1:(sp; if; auto); smt(dbool_ll). - rcondt{1} 2; first by auto; inline*; auto. - rcondt{2} 2; first auto; inline*; auto; sp. - + rcondt 1; first by auto; smt(). - by sp; rcondt 1; auto; conseq(:_==> true); auto. - sim. - exists* m1{1}, m2{1}; elim*=> a1 a2 c1 c2. - call(equiv_ro_iro (c2 + ((size a1 + 1) %/ r + 1) + - max ((size_out + r - 1) %/ r - 1) 0) a2). - auto; call(equiv_ro_iro c2 a1); auto; smt(). - call(: ={glob SRO.Counter, glob SRO.Bounder} /\ ={c}(SRO.Counter,Cntr) - /\ same_ro SRO.RO.RO.m{1} BIRO.IRO.mp{2}); auto. - + proc; sp; if; auto; sp; if; auto; sp. - exists* x{1}; elim* => a c1 c2 b1 b2. - call(equiv_ro_iro c1 a); auto; smt(). - smt(mem_empty). - have->//=:= SHA3Indiff (DSetSize(DColl(A))) &m _. - move=> F P P_f_ll P_fi_ll F_ll; proc; inline*; auto; sp. - seq 1 : true; auto. - + call (A_ll (SRO.Bounder(FInit(DFSetSize(F))))); auto. - by proc; inline*; sp; if; auto; sp; if; auto; sp; call F_ll; auto. - if; auto; sp. - seq 1 : true; auto. - + by call F_ll; auto. - sp; if; auto; sp; call F_ll; auto. - qed. +local lemma rw_ideal_2 &m (mess : bool list): + Dist_of_P2Adv.m{m} = mess => + Pr[SHA3_OIndiff.OIndif.OIndif(FSome(BIRO.IRO), OSimulator(FSome(BIRO.IRO)), + ODRestr(Dist_of_P2Adv(A))).main() @ &m : res] <= + Pr[SORO.SecondPreimage(SORO_P2(A), RFList).main(mess) @ &m : res]. +proof. +move=> Heq. +have->:Pr[SORO.SecondPreimage(SORO_P2(A), RFList).main(mess) @ &m : res] = + Pr[SORO.SecondPreimage(SORO_P2(A), RFWhile).main(mess) @ &m : res]. ++ byequiv(: ={glob A, arg} /\ arg{1} = mess ==> _)=>//=; proc. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + seq 1 1 : (={mi, m1, glob A, glob SORO.Bounder, glob RFList, glob Dist_of_P2Adv}); last first. + - sp; inline{1} 2; inline{2} 2; inline{1} 1; inline{2} 1; sp; sim. + if; auto. + - sp; case: (SORO.Bounder.bounder{1} < sigma). + * rcondt{1} 5; 1: auto. + + by inline*; auto; conseq(:_==> true); auto. + rcondt{2} 5; 1: auto. + + by inline*; auto; conseq(:_==> true); auto. + call(rw_RF_List_While); auto. + by call(rw_RF_List_While); auto=> />. + rcondf{1} 5; 1: auto. + + by inline*; auto; conseq(:_==> true); auto. + rcondf{2} 5; 1: auto. + + by inline*; auto; conseq(:_==> true); auto. + by auto; call(rw_RF_List_While); auto. + by sp; if; auto; call(rw_RF_List_While); auto. + call(: ={glob SORO.Bounder, glob RFList, glob OSimulator, glob OPC, glob Log, + glob Dist_of_P2Adv}); auto. + - proc; sp; if; auto. + inline{1} 1; inline{2} 1; sp; if; 1, 3: auto; sim. + if; 1: auto; sim; sp; sim; if; auto=> />; 1: smt(); sim. + + inline{1} 1; inline{2} 1; sp; sim. + inline{1} 1; inline{2} 1; sp; if; auto=> />. + - by call(rw_RF_List_While); auto; smt(). + smt(). + smt(). + - by sim. + proc; sim; inline{1} 1; inline{2} 1; sp; if; auto. + inline{1} 1; inline{2} 1; sp; sim. + inline{1} 1; inline{2} 1; sp; if; auto; sim. + by call(rw_RF_List_While); auto. +rewrite (eager_ideal &m). +have->:Pr[SHA3_OIndiff.OIndif.OIndif(ExtendSample(FSome(BIRO.IRO)), + OSimulator(ExtendSample(FSome(BIRO.IRO))), + ODRestr(Dist_of_P2Adv(A))).main() @ &m : res] = + Pr[SHA3_OIndiff.OIndif.OIndif(ExtendSample(FSome(BIRO.IRO)), + OSimulator(ExtendOutputSize(FSetSize(FSome(BIRO.IRO)))), + ODRestr(Dist_of_P2Adv(A))).main() @ &m : res]. ++ byequiv=> //=; proc; inline*; sp. + (* TODO : refaire un seq de + pour gérer mieux les 2 boucles, ou faire un lemme général *) -end section Collision. -module X (F : SRO.Oracle) = { - proc get (bl : bool list) = { - var r; - r <@ F.get(bl ++ [ false ; true ]); - return r; - } -}. + seq 1 1 : (={m', glob OSimulator, glob OFC, glob Dist_of_P2Adv} /\ + eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}); last first. + - sp; if; auto; sp; if; auto; sp; rcondt{1}1; 1: auto. + * rcondt{2} 1; 1: auto. + + while(={i, n, bs, x3} /\ size bs{1} = i{1} /\ + eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2} /\ + n{1} = size_out /\ 0 <= i{1} <= n{1}); auto. + * by sp; if; auto; smt(domE get_setE size_rcons). + smt(size_out_gt0 take_oversize size_out_gt0). + * by auto; rcondf{1} 1; auto. + * rcondt{2} 1; 1: auto; move=> />; auto. + by while(={i0, n0}); auto; sp; if{1}; if{2}; auto; smt(dbool_ll). + call(: ={glob OSimulator, glob OFC} /\ + eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}); last first; auto. + + smt(mem_empty). + + proc; sp; if; auto. + inline{1} 1; inline{2} 1; sp; if; 1, 3: auto. + if; 1, 3: auto; sp. + if; 1: auto; 1: smt(); last first. + - by conseq=> />; sim; smt(). + wp=> />; 1: smt(). + rnd; auto=> />; 1: smt(). + call(eq_extend); last by auto; smt(). + + by proc; sp; if; auto; inline{1} 1; inline{2} 1; sp; if; auto. + proc; sp; inline{1} 1; inline{2} 1; sp; if; auto. + inline*; sp. + rcondt{1} 1; 1: auto; rcondt{2} 1; 1: auto; sp. + rcondt{1} 1; 1: auto; rcondt{2} 1; 1: auto; sp; auto. + conseq(:_==> ={bs} /\ eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}); + 1: by auto. + while(={i, n, x3, bs} /\ 0 <= i{1} <= size_out /\ n{1} = size_out /\ + eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}). + - by sp; if; auto; smt(domE get_setE size_rcons). + by auto; smt(size_out_gt0). +byequiv=> //=; proc. +inline{1} 1; inline{2} 2; sp. +inline{1} 1; inline{2} 3; swap{2}[1..2]1; sp. +inline{1} 1; inline{2} 3; sp. +inline{1} 1; sp. +inline{1} 1; sp. +swap{2} 1 1; sp; swap{2}[1..2]3; sp. +inline{1} 1; sp; auto. +seq 2 5 : (={glob A, glob OSimulator, glob Counter, glob Log, hash, m} /\ + inv BIRO.IRO.mp{1} RFList.m{2} /\ + SORO.Bounder.bounder{2} <= Counter.c{1}); last first. ++ inline{1} 1; inline{2} 1; sp; inline{1} 1; sp; auto. + if{1}; sp; last first. + - conseq(:_==> true)=> />. + inline*; if{2}; auto; sp; if{2}; auto. + by while{2}(true)(size_out - i{2}); auto=>/>; smt(dbool_ll). + rcondt{2} 1; 1: by auto=> />; smt(divz_ge0 gt0_r size_ge0). + inline{1} 1; sp; auto. + rcondt{1} 1; auto=> /=. + inline{1} 1; sp; auto. + by call(eq_IRO_RFWhile); auto; smt(take_oversize). +auto; call(: ={glob OSimulator, glob Counter, glob Log} /\ + inv BIRO.IRO.mp{1} RFList.m{2} /\ + SORO.Bounder.bounder{2} <= Counter.c{1}); auto; last first. ++ by inline*; auto; smt(mem_empty). ++ proc; sp; if; auto=> />; 1: smt(). + inline{1} 1; inline{2} 1; sp; auto. + if; 1, 3: auto; -1: smt(). + if; 1, 3: auto; -1: smt(). + sp; if; 1: auto; 1: smt(); last first. + - by conseq(:_==> ={y, glob OSimulator}); 1: smt(); sim; smt(). + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + rcondt{2} 1; 1: by auto; smt(). + sp. + seq 3 2 : (={x0, x1, o1, k0, Log.m, suffix, glob OSimulator} /\ + inv BIRO.IRO.mp{1} RFList.m{2} /\ + SORO.Bounder.bounder{2} <= Counter.c{2} + 1); last first. + - by conseq(:_==> ={y, x1, glob OSimulator, Log.m}); 1: smt(); sim=> />. + inline{1} 1; auto. + by call(eq_IRO_RFWhile); auto; smt(). ++ by proc; inline*; sp; if; auto; sp; if; auto=> />; smt(). +proc. +inline{1} 1; inline{2} 1; sp; if; auto=> /=. +inline{1} 1; inline{2} 1; sp. +rcondt{1} 1; 1: auto. +inline{1} 1; auto. +rcondf{2} 4; 1: auto. ++ inline*; auto; sp; if; auto; sp; if; auto=> />; conseq(:_==> true); 1: smt(). + by while(true); auto. +inline{2} 1; sp. +rcondt{2} 1; 1: by auto; smt(divz_ge0 gt0_r size_ge0). +auto; call eq_IRO_RFWhile; auto=> />. +move=> &l &r 13?; split; 2: smt(divz_ge0 gt0_r size_ge0). +rewrite 2!oget_some cats0 take_oversize 1:/# take_oversize 1:spec_dout //=. +have h:=spec2_dout result_L H5. +have-> := some_oget _ h. +by rewrite eq_sym -to_listK; congr. +qed. + +local lemma rw_ideal &m: + Pr[SHA3_OIndiff.OIndif.OIndif(FSome(BIRO.IRO), OSimulator(FSome(BIRO.IRO)), + ODRestr(Dist_of_P1Adv(A))).main() @ &m : res] <= + Pr[SORO.SecondPreimage(SORO_P1(A),RF(SORO.RO.RO)).main() @ &m : res]. +proof. +rewrite (StdOrder.RealOrder.ler_trans _ _ _ (rw_ideal_2 &m)). +byequiv(: ={glob A} ==> _) => //=; proc; inline*; sp; wp. +swap{2} 2; sp; swap{2}[1..2] 6; sp. +swap{1} 2; sp; swap{1}[1..2] 6; sp. +seq 2 2 : ( + Log.m{1} = empty /\ + SHA3Indiff.Simulator.m{1} = empty /\ + SHA3Indiff.Simulator.mi{1} = empty /\ + SHA3Indiff.Simulator.paths{1} = empty.[c0 <- ([], b0)] /\ + Gconcl_list.BIRO2.IRO.mp{1} = empty /\ + SORO.Bounder.bounder{1} = 0 /\ + RFList.m{1} = empty /\ + Counter.c{2} = 0 /\ + ={Log.m, glob SHA3Indiff.Simulator, glob SORO.Bounder, glob Counter} /\ + SORO.RO.RO.m{2} = empty /\ ={glob A, h, hash}); 1: auto=> />. +seq 1 1 : (={glob A, glob SHA3Indiff.Simulator, glob SORO.Bounder, glob Counter, + glob Log, mi, h, hash} /\ RFList.m{1} = SORO.RO.RO.m{2}). ++ call(: ={glob SHA3Indiff.Simulator, glob SORO.Bounder, glob Counter, glob Log} /\ + RFList.m{1} = SORO.RO.RO.m{2}); auto. + - proc; sp; if; 1, 3: auto; sp. + inline *; sp; sim. + if; 1: auto; sim. + if; 1: auto; sim. + sp; if; 1: (auto; smt()); sim; 2: smt(). + sp; if; 1: auto; sim; -1: smt(). + sp; if{1}. + * rcondt{2} 2; auto; 1: smt(BlockSponge.parse_valid). + rnd (fun l => oget (of_list l)) to_list; auto=> />. + move=> &l &r 10?; split; 1: smt(of_listK). + rewrite -dout_equal_dlist=> ?; split=> ?. + + by rewrite dmapE=> h{h}; apply mu_eq=> x; smt(to_list_inj). + move=> sample. + rewrite !get_setE/=oget_some/=dout_full/= => h; split; 2: smt(). + rewrite eq_sym to_listK; apply some_oget. + apply spec2_dout. + by move:h; rewrite supp_dmap; smt(spec_dout). + by auto; smt(dout_ll). + - by proc; inline*; sp; if; auto; sp; if; auto. + - proc; inline*; sp; if; auto; sp; if; auto; sp; sim. + if{1}. + * rcondt{2} 2; auto. + rnd (fun l => oget (of_list l)) to_list; auto=> />. + move=> &l 4?; split=> ?; 1: smt(of_listK). + rewrite -dout_equal_dlist; split=> ?. + * by rewrite dmapE=> h{h}; apply mu_eq=> x; smt(to_list_inj). + move=> sample. + rewrite supp_dmap dout_full/= =>/> a. + by rewrite get_setE/=oget_some/= dout_full/=; congr; rewrite of_listK oget_some. + by auto; smt(dout_ll). +sp; if; 1, 3: auto; sp; wp 1 2. +if{1}. ++ wp=> />. + rnd (fun x => oget (of_list x)) to_list; auto=> />. + move=> &l c Hc Hnin; split. + - move=> ret Hret. search to_list. + by have/= ->:= (to_listK ret (to_list ret)). + move=> h{h}; split. + - move=> ret Hret; rewrite -dout_equal_dlist. + rewrite dmapE /=; apply mu_eq=> //= x /=. + by rewrite /(\o) /pred1/=; smt(to_list_inj). + move=> h{h} l Hl. + rewrite dout_full /=. + have:= spec2_dout l. + have:=supp_dlist dbool size_out l _; 1: smt(size_out_gt0). + rewrite Hl/==> [#] -> h{h} /= H. + have H1:=some_oget _ H. + have:=to_listK (oget (of_list l)) l; rewrite {2}H1/= => -> /= {H H1}. + by rewrite get_setE/=. +by auto=> />; smt(dout_ll). +qed. -module AdvCollisionSHA3 (A : SRO.AdvCollision) (F : SRO.Oracle) = { - proc guess () = { - var m1, m2; - (m1, m2) <@ A(X(F)).guess(); - return (m1 ++ [ false ; true ], m2 ++ [ false ; true ]); - } -}. -section SHA3_Collision. +local lemma leq_ideal &m : + Pr[SHA3_OIndiff.OIndif.OIndif(FSome(BIRO.IRO), OSimulator(FSome(BIRO.IRO)), + ODRestr(Dist_of_P1Adv(A))).main() @ &m : res] <= (sigma + 1)%r / 2%r ^ size_out. +proof. +rewrite (StdOrder.RealOrder.ler_trans _ _ _ (rw_ideal &m)). +rewrite (StdOrder.RealOrder.ler_trans _ _ _ (RO_is_preimage_resistant (SORO_P1(A)) &m)). +by rewrite doutE1. +qed. - declare module A : SRO.AdvCollision{SRO.RO.RO, SRO.RO.FRO, SRO.Bounder, Perm, - Gconcl_list.BIRO2.IRO, Simulator, Cntr, BIRO.IRO, F.RO, F.FRO, Redo, C, - Gconcl.S, BlockSponge.BIRO.IRO, BlockSponge.C, Gconcl_list.F2.RO, - Gconcl_list.F2.FRO, Gconcl_list.Simulator}. - axiom A_ll (F <: SRO.Oracle) : islossless F.get => islossless A(F).guess. - lemma SHA3_coll_resistant &m : - Pr[SRO.Collision(AdvCollisionSHA3(A), FM(CSetSize(Sponge), Perm)).main() @ &m : res] <= - (limit ^ 2 - limit)%r / (2 ^ (r + c + 1))%r + - (4 * limit ^ 2)%r / (2 ^ c)%r + - (sigma * (sigma - 1) + 2)%r / 2%r / (2%r ^ size_out). + local lemma rw_real &m : + Pr[SecondPreimage(A, OSponge, PSome(Perm)).main() @ &m : res] = + Pr[SHA3_OIndiff.OIndif.OIndif(FSome(Sponge(Poget(PSome(Perm)))), PSome(Perm), + ODRestr(Dist_of_P1Adv(A))).main() @ &m : res]. proof. - apply (Sponge_coll_resistant (AdvCollisionSHA3(A)) _ &m). - by move=> F F_ll; proc; inline*; call(A_ll (X(F))); auto; proc; call F_ll; auto. + byequiv=>//=; proc; inline*; sp; wp=> />. + swap{1} 4; sp. + seq 2 2 : (={glob A, glob Perm, hash, m} /\ Bounder.bounder{1} = Counter.c{2}). + + call(: ={glob Perm} /\ Bounder.bounder{1} = Counter.c{2})=> //=. + - by proc; inline*; sp; if; auto; 2:sim=> />; 1: smt(). + - by proc; inline*; sp; if; auto; 2:sim=> />; 1: smt(). + - proc; inline*; sp; if; auto; sp=> />. + by conseq(:_==> ={z0, glob Perm})=> />; sim. + by auto. + by sp; if; auto=>/=; sim; auto. qed. +lemma Sponge_preimage_resistant &m: + (forall (F <: OIndif.ODFUNCTIONALITY) (P <: OIndif.ODPRIMITIVE), + islossless F.f => islossless P.f => islossless P.fi => islossless A(F,P).guess) => + Pr[SecondPreimage(A, OSponge, PSome(Perm)).main() @ &m : res] <= + (limit ^ 2 - limit)%r / (2 ^ (r + c + 1))%r + + (4 * limit ^ 2)%r / (2 ^ c)%r + + (sigma + 1)%r / (2%r ^ size_out). +proof. +move=> A_ll. +rewrite (rw_real &m). +have := SHA3OIndiff (Dist_of_P1Adv(A)) &m _. ++ move=> F P Hp Hpi Hf; proc; inline*; sp; auto; call Hf; auto. + call(A_ll (DFSetSize(F)) P _ Hp Hpi); auto. + - proc; inline*; auto; call Hf; auto. + smt(dout_ll). +by have/#:=leq_ideal &m. +qed. + +end section SecondSecondPreimage. + -end section Collision. \ No newline at end of file From 502a7198ce8903119279d773657c25ece5bb7dd7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Wed, 28 Aug 2019 15:24:04 +0200 Subject: [PATCH 466/525] P1, P2 & coll resistance proven in the random permutation model. --- proof/SHA3OSecurity.ec | 1117 +++++++++++++++++++++++++++++++++++++--- 1 file changed, 1032 insertions(+), 85 deletions(-) diff --git a/proof/SHA3OSecurity.ec b/proof/SHA3OSecurity.ec index 16128b9..1b68112 100644 --- a/proof/SHA3OSecurity.ec +++ b/proof/SHA3OSecurity.ec @@ -916,7 +916,7 @@ section SecondPreimage. F.FRO, Redo, C, Gconcl.S, BlockSponge.BIRO.IRO, BlockSponge.C, BIRO.IRO, Gconcl_list.BIRO2.IRO, Gconcl_list.F2.RO, Gconcl_list.F2.FRO, Gconcl_list.Simulator, SHA3Indiff.Simulator, SHA3Indiff.Cntr, - SORO.Bounder, SORO.RO.RO, RO, FRO }. + SORO.Bounder, SORO.RO.RO, SORO.RO.FRO, RO, FRO }. local module FInit (F : OIndif.ODFUNCTIONALITY) : OIndif.OFUNCTIONALITY = { proc init () = {} @@ -1410,7 +1410,54 @@ by call(RO_LRO_D Dist); inline*; auto=> />. qed. +local equiv toto : + DFSetSize(OFC(ExtendSample(FSome(BIRO.IRO)))).f ~ + DFSetSize(OFC(ExtendSample(FSome(BIRO.IRO)))).f : + ={glob OFC, arg} /\ eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2} ==> + ={glob OFC, res} /\ eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}. +proof. +proc; inline*; sp; if; auto; sp; if; auto; sp; (rcondt{1} 1; 1: auto; rcondt{2} 1; 1: auto)=>/=. ++ conseq(:_==> ={bs} /\ eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}); auto. + while(={i, bs, n, x3} /\ 0 <= i{1} <= size_out /\ n{1} = size_out /\ + eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}). + - by sp; if; auto; smt(domE get_setE size_out_gt0). + by auto; smt(size_out_gt0). +by conseq(:_==> true); auto; sim. +qed. +local equiv titi mess c: + DFSetSize(OFC(ExtendSample(FSome(BIRO.IRO)))).f + ~ + SORO.Bounder(RFWhile).get + : + ={arg} /\ arg{1} = mess /\ Counter.c{1} = c /\ + SORO.Bounder.bounder{2} <= Counter.c{1} /\ + inv BIRO.IRO.mp{1} RFList.m{2} + ==> + if (increase_counter c mess size_out <= sigma) then + (exists y, res{1} = Some y /\ res{2} = Some y /\ + SORO.Bounder.bounder{2} <= Counter.c{1} /\ + Counter.c{1} = increase_counter c mess size_out /\ + inv BIRO.IRO.mp{1} RFList.m{2}) + else (res{1} = None). +proof. +proc; sp. +inline{1} 1; sp; auto. +if{1}. +- rcondt{2} 1; first by auto; smt(divz_ge0 gt0_r size_ge0). + sp; auto. + inline{1} 1; sp; auto. + sp; rcondt{1} 1; auto. + inline{1} 1; sp; auto. + call(eq_IRO_RFWhile); auto=> /> 15?. + rewrite oget_some take_oversize 1:/# /=. + have:=spec2_dout _ H5. + move=>/(some_oget)-> /=; smt(divz_ge0 gt0_r size_ge0 spec2_dout). +move=>/=. +conseq(:_==> true); auto. +inline*; if{2}; auto; sp; if{2}; auto; sp. +by while{2}(true)(size_out - i{2}); auto; smt(dbool_ll). +qed. local lemma rw_ideal_2 &m (mess : bool list): Dist_of_P2Adv.m{m} = mess => @@ -1465,34 +1512,27 @@ have->:Pr[SHA3_OIndiff.OIndif.OIndif(ExtendSample(FSome(BIRO.IRO)), Pr[SHA3_OIndiff.OIndif.OIndif(ExtendSample(FSome(BIRO.IRO)), OSimulator(ExtendOutputSize(FSetSize(FSome(BIRO.IRO)))), ODRestr(Dist_of_P2Adv(A))).main() @ &m : res]. -+ byequiv=> //=; proc; inline*; sp. - (* TODO : refaire un seq de + pour gérer mieux les 2 boucles, ou faire un lemme général *) - - - seq 1 1 : (={m', glob OSimulator, glob OFC, glob Dist_of_P2Adv} /\ - eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}); last first. - - sp; if; auto; sp; if; auto; sp; rcondt{1}1; 1: auto. - * rcondt{2} 1; 1: auto. - - while(={i, n, bs, x3} /\ size bs{1} = i{1} /\ - eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2} /\ - n{1} = size_out /\ 0 <= i{1} <= n{1}); auto. - * by sp; if; auto; smt(domE get_setE size_rcons). - smt(size_out_gt0 take_oversize size_out_gt0). - * by auto; rcondf{1} 1; auto. - * rcondt{2} 1; 1: auto; move=> />; auto. - by while(={i0, n0}); auto; sp; if{1}; if{2}; auto; smt(dbool_ll). - call(: ={glob OSimulator, glob OFC} /\ ++ byequiv=> //=; proc. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp; auto=> />. + call(toto); call(toto); auto. + conseq(:_==> ={m', glob Counter, Dist_of_P2Adv.m} /\ + eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}); 1: smt(). + call(: ={glob OSimulator, glob OFC, Dist_of_P2Adv.m} /\ eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}); last first; auto. + smt(mem_empty). - + proc; sp; if; auto. + + proc; sp; if; auto. inline{1} 1; inline{2} 1; sp; if; 1, 3: auto. if; 1, 3: auto; sp. if; 1: auto; 1: smt(); last first. - by conseq=> />; sim; smt(). wp=> />; 1: smt(). - rnd; auto=> />; 1: smt(). - call(eq_extend); last by auto; smt(). + rnd; auto. + call(eq_extend); by auto; smt(). + by proc; sp; if; auto; inline{1} 1; inline{2} 1; sp; if; auto. proc; sp; inline{1} 1; inline{2} 1; sp; if; auto. inline*; sp. @@ -1505,30 +1545,44 @@ have->:Pr[SHA3_OIndiff.OIndif.OIndif(ExtendSample(FSome(BIRO.IRO)), - by sp; if; auto; smt(domE get_setE size_rcons). by auto; smt(size_out_gt0). byequiv=> //=; proc. -inline{1} 1; inline{2} 2; sp. -inline{1} 1; inline{2} 3; swap{2}[1..2]1; sp. -inline{1} 1; inline{2} 3; sp. -inline{1} 1; sp. -inline{1} 1; sp. -swap{2} 1 1; sp; swap{2}[1..2]3; sp. -inline{1} 1; sp; auto. -seq 2 5 : (={glob A, glob OSimulator, glob Counter, glob Log, hash, m} /\ +inline{1} 1; inline{2} 1; sp. +inline{1} 1; inline{2} 1; sp. +inline{1} 1; inline{2} 1; sp. +inline{1} 1; inline{2} 1; sp. +inline{1} 1; inline{2} 1; sp. +inline{1} 1; sp; auto. +seq 1 1 : (={glob A, glob OFC, glob OSimulator, Log.m} /\ + m'{1} = mi{2} /\ m1{2} = Dist_of_P2Adv.m{1} /\ inv BIRO.IRO.mp{1} RFList.m{2} /\ SORO.Bounder.bounder{2} <= Counter.c{1}); last first. -+ inline{1} 1; inline{2} 1; sp; inline{1} 1; sp; auto. - if{1}; sp; last first. - - conseq(:_==> true)=> />. - inline*; if{2}; auto; sp; if{2}; auto. - by while{2}(true)(size_out - i{2}); auto=>/>; smt(dbool_ll). - rcondt{2} 1; 1: by auto=> />; smt(divz_ge0 gt0_r size_ge0). - inline{1} 1; sp; auto. - rcondt{1} 1; auto=> /=. - inline{1} 1; sp; auto. - by call(eq_IRO_RFWhile); auto; smt(take_oversize). ++ sp; case: (increase_counter Counter.c{1} Dist_of_P2Adv.m{1} size_out <= SHA3Indiff.limit). + - exists * mi{2}, Dist_of_P2Adv.m{1}, Counter.c{1}; elim* => mess2 mess1 c. + call(titi mess2 (increase_counter c mess1 size_out))=> /= />. + by call(titi mess1 c)=> />; auto; smt(). + inline*; sp. + rcondf{1} 1; 1: auto; sp. + conseq(:_==> true); auto. + seq 1 0 : true. + - if{1}; auto; sp; 1: if{1}; auto; sp. + - rcondt{1} 1; auto. + while{1}(true)(n1{1}-i1{1}); auto; -1: smt(). + by sp; if; auto; smt(dbool_ll). + rcondt{1} 1; 1: auto. + while{1}(true)(n2{1}-i2{1}); auto. + by sp; if; auto; smt(dbool_ll). + seq 0 1 : true. + - if{2}; auto; sp; if{2}; auto; sp. + by while{2}(true)(size_out-i{2}); auto; smt(dbool_ll). + sp; if{2}; auto; sp; if{2}; auto; sp. + by while{2}(true)(size_out-i0{2}); auto; smt(dbool_ll). +conseq(:_==> ={glob A, glob OFC, glob OSimulator, Log.m} /\ + m'{1} = mi{2} /\ + inv BIRO.IRO.mp{1} RFList.m{2} /\ SORO.Bounder.bounder{2} <= Counter.c{1}). ++ smt(). auto; call(: ={glob OSimulator, glob Counter, glob Log} /\ inv BIRO.IRO.mp{1} RFList.m{2} /\ SORO.Bounder.bounder{2} <= Counter.c{1}); auto; last first. -+ by inline*; auto; smt(mem_empty). ++ by smt(mem_empty). + proc; sp; if; auto=> />; 1: smt(). inline{1} 1; inline{2} 1; sp; auto. if; 1, 3: auto; -1: smt(). @@ -1564,28 +1618,17 @@ have-> := some_oget _ h. by rewrite eq_sym -to_listK; congr. qed. -local lemma rw_ideal &m: +local lemma rw_ideal &m (mess : bool list): + Dist_of_P2Adv.m{m} = mess => Pr[SHA3_OIndiff.OIndif.OIndif(FSome(BIRO.IRO), OSimulator(FSome(BIRO.IRO)), - ODRestr(Dist_of_P1Adv(A))).main() @ &m : res] <= - Pr[SORO.SecondPreimage(SORO_P1(A),RF(SORO.RO.RO)).main() @ &m : res]. + ODRestr(Dist_of_P2Adv(A))).main() @ &m : res] <= + Pr[SORO.SecondPreimage(SORO_P2(A),RF(SORO.RO.RO)).main(mess) @ &m : res]. proof. -rewrite (StdOrder.RealOrder.ler_trans _ _ _ (rw_ideal_2 &m)). -byequiv(: ={glob A} ==> _) => //=; proc; inline*; sp; wp. -swap{2} 2; sp; swap{2}[1..2] 6; sp. -swap{1} 2; sp; swap{1}[1..2] 6; sp. -seq 2 2 : ( - Log.m{1} = empty /\ - SHA3Indiff.Simulator.m{1} = empty /\ - SHA3Indiff.Simulator.mi{1} = empty /\ - SHA3Indiff.Simulator.paths{1} = empty.[c0 <- ([], b0)] /\ - Gconcl_list.BIRO2.IRO.mp{1} = empty /\ - SORO.Bounder.bounder{1} = 0 /\ - RFList.m{1} = empty /\ - Counter.c{2} = 0 /\ - ={Log.m, glob SHA3Indiff.Simulator, glob SORO.Bounder, glob Counter} /\ - SORO.RO.RO.m{2} = empty /\ ={glob A, h, hash}); 1: auto=> />. +move=> Heq. +rewrite (StdOrder.RealOrder.ler_trans _ _ _ (rw_ideal_2 &m mess Heq)). +byequiv(: ={glob A} /\ ={arg} /\ arg{1} = mess ==> _) => //=; proc; inline*; sp; wp. seq 1 1 : (={glob A, glob SHA3Indiff.Simulator, glob SORO.Bounder, glob Counter, - glob Log, mi, h, hash} /\ RFList.m{1} = SORO.RO.RO.m{2}). + glob Log, mi, m1} /\ RFList.m{1} = SORO.RO.RO.m{2}). + call(: ={glob SHA3Indiff.Simulator, glob SORO.Bounder, glob Counter, glob Log} /\ RFList.m{1} = SORO.RO.RO.m{2}); auto. - proc; sp; if; 1, 3: auto; sp. @@ -1618,10 +1661,33 @@ seq 1 1 : (={glob A, glob SHA3Indiff.Simulator, glob SORO.Bounder, glob Counter, rewrite supp_dmap dout_full/= =>/> a. by rewrite get_setE/=oget_some/= dout_full/=; congr; rewrite of_listK oget_some. by auto; smt(dout_ll). -sp; if; 1, 3: auto; sp; wp 1 2. +sp. +seq 4 4 : (={SORO.Bounder.bounder, x0, m1, m2, hash1, y0} /\ y0{1} = None /\ + RFList.m{1} = SORO.RO.RO.m{2}); last first. ++ if; 1, 3: auto; sp. + if{1}. + - rcondt{2} 2; 1: auto. + auto; rnd (fun t => oget (of_list t)) to_list; auto=> />. + move=> &l c Hc Hnin; split. + - move=> ret Hret. search to_list. + by have/= ->:= (to_listK ret (to_list ret)). + move=> h{h}; split. + - move=> ret Hret; rewrite -dout_equal_dlist. + rewrite dmapE /=; apply mu_eq=> //= x /=. + by rewrite /(\o) /pred1/=; smt(to_list_inj). + move=> h{h} l Hl. + rewrite dout_full /=. + have:= spec2_dout l. + have:=supp_dlist dbool size_out l _; 1: smt(size_out_gt0). + rewrite Hl/==> [#] -> h{h} /= H. + have H1:=some_oget _ H. + have:=to_listK (oget (of_list l)) l; rewrite {2}H1/= => -> /= {H H1}. + by rewrite get_setE/=; smt(). + by auto=> />; smt(dout_ll). +if; 1, 3: auto; sp. if{1}. -+ wp=> />. - rnd (fun x => oget (of_list x)) to_list; auto=> />. +- rcondt{2} 2; 1: auto. + auto; rnd (fun t => oget (of_list t)) to_list; auto=> />. move=> &l c Hc Hnin; split. - move=> ret Hret. search to_list. by have/= ->:= (to_listK ret (to_list ret)). @@ -1636,57 +1702,938 @@ if{1}. rewrite Hl/==> [#] -> h{h} /= H. have H1:=some_oget _ H. have:=to_listK (oget (of_list l)) l; rewrite {2}H1/= => -> /= {H H1}. - by rewrite get_setE/=. + by rewrite get_setE/=; smt(). by auto=> />; smt(dout_ll). qed. -local lemma leq_ideal &m : +local lemma leq_ideal &m mess: + Dist_of_P2Adv.m{m} = mess => Pr[SHA3_OIndiff.OIndif.OIndif(FSome(BIRO.IRO), OSimulator(FSome(BIRO.IRO)), - ODRestr(Dist_of_P1Adv(A))).main() @ &m : res] <= (sigma + 1)%r / 2%r ^ size_out. + ODRestr(Dist_of_P2Adv(A))).main() @ &m : res] <= (sigma + 1)%r / 2%r ^ size_out. proof. -rewrite (StdOrder.RealOrder.ler_trans _ _ _ (rw_ideal &m)). -rewrite (StdOrder.RealOrder.ler_trans _ _ _ (RO_is_preimage_resistant (SORO_P1(A)) &m)). +move=> Heq. +rewrite (StdOrder.RealOrder.ler_trans _ _ _ (rw_ideal &m mess Heq)). +rewrite (StdOrder.RealOrder.ler_trans _ _ _ (RO_is_second_preimage_resistant (SORO_P2(A)) &m mess)). by rewrite doutE1. qed. - local lemma rw_real &m : - Pr[SecondPreimage(A, OSponge, PSome(Perm)).main() @ &m : res] = + local lemma rw_real &m mess : + Dist_of_P2Adv.m{m} = mess => + Pr[SecondPreimage(A, OSponge, PSome(Perm)).main(mess) @ &m : res] = Pr[SHA3_OIndiff.OIndif.OIndif(FSome(Sponge(Poget(PSome(Perm)))), PSome(Perm), - ODRestr(Dist_of_P1Adv(A))).main() @ &m : res]. + ODRestr(Dist_of_P2Adv(A))).main() @ &m : res]. proof. - byequiv=>//=; proc; inline*; sp; wp=> />. - swap{1} 4; sp. - seq 2 2 : (={glob A, glob Perm, hash, m} /\ Bounder.bounder{1} = Counter.c{2}). - + call(: ={glob Perm} /\ Bounder.bounder{1} = Counter.c{2})=> //=. + move=> Heq. + byequiv=>//=; proc. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; sp; wp=> />. + seq 1 1 : (={glob A, glob Perm} /\ m1{1} = Dist_of_P2Adv.m{2} /\ + m2{1} = m'{2} /\ Bounder.bounder{1} = Counter.c{2}). + + auto; call(: ={glob Perm} /\ Bounder.bounder{1} = Counter.c{2})=> //=. - by proc; inline*; sp; if; auto; 2:sim=> />; 1: smt(). - by proc; inline*; sp; if; auto; 2:sim=> />; 1: smt(). - proc; inline*; sp; if; auto; sp=> />. by conseq(:_==> ={z0, glob Perm})=> />; sim. - by auto. - by sp; if; auto=>/=; sim; auto. + by auto; smt(). + conseq(:_==> m1{1} = Dist_of_P2Adv.m{2} /\ m2{1} = m'{2} /\ + hash1{1} = hash{2} /\ hash2{1} = hash'{2})=> //=; 1: smt(). + seq 1 1 : (m1{1} = Dist_of_P2Adv.m{2} /\ m2{1} = m'{2} /\ + hash1{1} = hash{2} /\ ={glob Perm} /\ Bounder.bounder{1} = Counter.c{2}); last first. + + inline*; sp; if; auto; sp=> /=; sim. + inline*; sp; if; auto; swap{1} 9; auto; sp=> /=. + by conseq(:_==> m1{1} = Dist_of_P2Adv.m{2} /\ m2{1} = m'{2} /\ + of_list (oget (Some (take n{1} z0{1}))) = + of_list (oget (Some (take n{2} z0{2}))) /\ ={Perm.mi, Perm.m})=> //=; sim. qed. -lemma Sponge_preimage_resistant &m: +local module TOTO = { + proc main (m : bool list) = { + var b; + Dist_of_P2Adv.m <- m; + b <@ SecondPreimage(A, OSponge, PSome(Perm)).main(m); + return b; + } +}. + +lemma Sponge_second_preimage_resistant &m mess: (forall (F <: OIndif.ODFUNCTIONALITY) (P <: OIndif.ODPRIMITIVE), islossless F.f => islossless P.f => islossless P.fi => islossless A(F,P).guess) => - Pr[SecondPreimage(A, OSponge, PSome(Perm)).main() @ &m : res] <= + Pr[SecondPreimage(A, OSponge, PSome(Perm)).main(mess) @ &m : res] <= (limit ^ 2 - limit)%r / (2 ^ (r + c + 1))%r + (4 * limit ^ 2)%r / (2 ^ c)%r + (sigma + 1)%r / (2%r ^ size_out). proof. move=> A_ll. -rewrite (rw_real &m). -have := SHA3OIndiff (Dist_of_P1Adv(A)) &m _. -+ move=> F P Hp Hpi Hf; proc; inline*; sp; auto; call Hf; auto. +have->:Pr[SecondPreimage(A, OSponge, PSome(Perm)).main(mess) @ &m : res] = + Pr[TOTO.main(mess) @ &m : res]. ++ by byequiv=> //=; proc; inline*; auto; sim. +byphoare(: arg = mess ==>_)=>//=; proc; sp. +call(: arg = mess /\ mess = Dist_of_P2Adv.m ==> res); auto. +bypr=> {&m} &m [#]->; rewrite eq_sym=> Heq. +rewrite (rw_real &m mess Heq). +have := SHA3OIndiff (Dist_of_P2Adv(A)) &m _. ++ move=> F P Hp Hpi Hf; proc; inline*; sp; auto; call Hf; auto; call Hf; auto. call(A_ll (DFSetSize(F)) P _ Hp Hpi); auto. - - proc; inline*; auto; call Hf; auto. - smt(dout_ll). + proc; inline*; auto; call Hf; auto. +by have/#:=leq_ideal &m. +qed. + +end section SecondPreimage. + + + + +section Collision. + + + declare module A : SH.AdvCollision { Perm, Counter, Bounder, F.RO, + F.FRO, Redo, C, Gconcl.S, BlockSponge.BIRO.IRO, BlockSponge.C, BIRO.IRO, + Gconcl_list.BIRO2.IRO, Gconcl_list.F2.RO, Gconcl_list.F2.FRO, + Gconcl_list.Simulator, SHA3Indiff.Simulator, SHA3Indiff.Cntr, + SORO.Bounder, SORO.RO.RO, SORO.RO.FRO, RO, FRO }. + + local module FInit (F : OIndif.ODFUNCTIONALITY) : OIndif.OFUNCTIONALITY = { + proc init () = {} + proc f = F.f + }. + + local module PInit (P : ODPRIMITIVE) : OPRIMITIVE = { + proc init () = {} + proc f = P.f + proc fi = P.fi + }. + + +local module OF (F : Oracle) : OIndif.ODFUNCTIONALITY = { + proc f = F.get +}. + + +local module Log = { + var m : (bool list * int, bool) fmap +}. + +local module ExtendOutputSize (F : Oracle) : ODFUNCTIONALITY = { + proc f (x : bool list, k : int) = { + var o, l, suffix, prefix, i; + l <- None; + prefix <- []; + suffix <- []; + o <@ F.get(x); + prefix <- take k (to_list (oget o)); + i <- size_out; + while (i < k) { + if ((x,i) \notin Log.m) { + Log.m.[(x,i)] <$ {0,1}; + } + suffix <- rcons suffix (oget Log.m.[(x,i)]); + i <- i + 1; + } + l <- Some (prefix ++ suffix); + return l; + } +}. + +local module OFC2 (F : Oracle) = OFC(ExtendOutputSize(F)). + +local module ExtendOutput (F : RF) = { + proc init () = { + Log.m <- empty; + F.init(); + } + proc f = ExtendOutputSize(F).f + proc get = f +}. + + local module (Dist_of_CollAdv (A : SH.AdvCollision) : ODISTINGUISHER) (F : ODFUNCTIONALITY) (P : ODPRIMITIVE) = { + var m : bool list + proc distinguish () = { + var hash1, hash2, m1, m2; + Log.m <- empty; + (m1, m2) <@ A(DFSetSize(F),P).guess(); + hash1 <@ DFSetSize(F).f(m1); + hash2 <@ DFSetSize(F).f(m2); + return m1 <> m2 /\ exists y, hash1 = Some y /\ hash2 = Some y; + } + }. + + +local module (SORO_Coll (A : SH.AdvCollision) : SORO.AdvCollision) (F : Oracle) = { + proc guess () = { + var mi; + Log.m <- empty; + Counter.c <- 0; + OSimulator(ExtendOutputSize(F)).init(); + mi <@ A(DFSetSize(OFC2(F)),OPC(OSimulator(ExtendOutputSize(F)))).guess(); + return mi; + } +}. + +local module RFList = { + var m : (bool list, f_out) fmap + proc init () = { + m <- empty; + } + proc get (x : bool list) : f_out option = { + var z; + if (x \notin m) { + z <$ dlist dbool size_out; + m.[x] <- oget (of_list z); + } + return m.[x]; + } + proc sample (x: bool list) = {} +}. + +local module RFWhile = { + proc init () = { + RFList.m <- empty; + } + proc get (x : bool list) : f_out option = { + var l, i, b; + if (x \notin RFList.m) { + i <- 0; + l <- []; + while (i < size_out) { + b <$ dbool; + l <- rcons l b; + i <- i + 1; + } + RFList.m.[x] <- oget (of_list l); + } + return RFList.m.[x]; + } + proc sample (x: bool list) = {} +}. + + +local equiv rw_RF_List_While : + RFList.get ~ RFWhile.get : + ={arg, glob RFList} ==> ={res, glob RFWhile}. +proof. +proc; if; 1, 3: auto; wp. +conseq(:_==> z{1} = l{2})=> />. +transitivity{1} { + z <@ PBool.Sample.sample(size_out); + } + (true ==> ={z}) + (true ==> z{1} = l{2})=>/>. ++ by inline*; auto. +transitivity{1} { + z <@ LoopSnoc.sample(size_out); + } + (true ==> ={z}) + (true ==> z{1} = l{2})=>/>; last first. ++ inline*; auto; sim. + by while(={l, i} /\ n{1} = size_out); auto; smt(cats1). +by call(Sample_LoopSnoc_eq); auto. +qed. + + +local equiv eq_IRO_RFWhile : + BIRO.IRO.f ~ RFWhile.get : + arg{1} = (x{2}, size_out) /\ inv BIRO.IRO.mp{1} RFList.m{2} + ==> + res{2} = of_list res{1} /\ size res{1} = size_out /\ inv BIRO.IRO.mp{1} RFList.m{2}. +proof. +proc; inline*; sp. +rcondt{1} 1; 1: by auto. +if{2}; sp; last first. ++ alias{1} 1 mp = BIRO.IRO.mp. + conseq(:_==> BIRO.IRO.mp{1} = mp{1} /\ size bs{1} = i{1} /\ i{1} = size_out /\ + inv mp{1} RFList.m{2} /\ + bs{1} = take i{1} (to_list (oget RFList.m{2}.[x{1}])))=> />. + - move=> &l &r 11?. + rewrite take_oversize 1:spec_dout 1:H4 //. + rewrite eq_sym to_listK => ->. + by have:=H3; rewrite domE; smt(). + - smt(take_oversize spec_dout). + while{1}(BIRO.IRO.mp{1} = mp{1} /\ size bs{1} = i{1} /\ + 0 <= i{1} <= size_out /\ n{1} = size_out /\ + inv mp{1} RFList.m{2} /\ x{1} \in RFList.m{2} /\ + bs{1} = take i{1} (to_list (oget RFList.m{2}.[x{1}])))(size_out - i{1}); + auto=> />. + + sp; rcondf 1; auto=> />; 1: smt(). + move=> &h 8?. + rewrite size_rcons //=; do!split; 1, 2, 4: smt(size_ge0). + rewrite (take_nth witness) 1:spec_dout 1:size_ge0//=. + rewrite - H6; congr; rewrite H4=> //=. + by apply H3=> //=. + smt(size_out_gt0 size_ge0 take0). +auto=> //=. +conseq(:_==> l{2} = bs{1} /\ size bs{1} = i{1} /\ i{1} = n{1} /\ n{1} = size_out /\ + inv BIRO.IRO.mp{1} RFList.m{2}.[x{2} <- oget (of_list l{2})])=> />. ++ smt(get_setE spec2_dout). ++ smt(get_setE spec2_dout). +alias{1} 1 m = BIRO.IRO.mp; sp. +conseq(:_==> l{2} = bs{1} /\ size bs{1} = i{1} /\ i{1} = n{1} /\ + n{1} = size_out /\ inv m{1} RFList.m{2} /\ + (forall j, (x{1}, j) \in BIRO.IRO.mp{1} => 0 <= j < i{1}) /\ + (forall l j, l <> x{1} => m{1}.[(l,j)] = BIRO.IRO.mp{1}.[(l,j)]) /\ + (forall j, 0 <= j < i{1} => (x{1}, j) \in BIRO.IRO.mp{1}) /\ + (forall j, 0 <= j < i{1} => BIRO.IRO.mp{1}.[(x{1},j)] = Some (nth witness bs{1} j))). ++ move=> /> &l &r 11?; do!split; ..-2 : smt(domE mem_set). + move=> l j Hin. + rewrite get_setE/=. + case: (l = x{r}) => [<<-|]. + - rewrite oget_some H8; 1:smt(); congr; congr. + by rewrite eq_sym to_listK; smt(spec2_dout). + move=> Hneq. + by rewrite -(H6 _ _ Hneq) H2; smt(domE). +while(l{2} = bs{1} /\ size bs{1} = i{1} /\ 0 <= i{1} <= n{1} /\ ={i} /\ + n{1} = size_out /\ inv m{1} RFList.m{2} /\ + (forall j, (x{1}, j) \in BIRO.IRO.mp{1} => 0 <= j < i{1}) /\ + (forall l j, l <> x{1} => m{1}.[(l,j)] = BIRO.IRO.mp{1}.[(l,j)]) /\ + (forall j, 0 <= j < i{1} => (x{1}, j) \in BIRO.IRO.mp{1}) /\ + (forall j, 0 <= j < i{1} => BIRO.IRO.mp{1}.[(x{1},j)] = Some (nth witness bs{1} j))). ++ sp; rcondt{1} 1; auto=> />. + - smt(). + move=> &l &r 13?. + rewrite get_setE/=oget_some/=size_rcons/=; do!split; 1,2: smt(size_ge0). + - smt(mem_set). + - smt(get_setE). + - smt(mem_set). + - move=>j Hj0 Hjsize; rewrite get_setE/=nth_rcons. + case: (j = size bs{l})=>[->>//=|h]. + have/=Hjs:j < size bs{l} by smt(). + by rewrite Hjs/=H8//=. +by auto; smt(size_out_gt0). +qed. + + +local module ExtendSample (F : OFUNCTIONALITY) = { + proc init = F.init + proc f (x : bool list, k : int) = { + var y; + if (k <= size_out) { + y <@ F.f(x,size_out); + y <- omap (take k) y; + } else { + y <@ F.f(x,k); + } + return y; + } +}. + + +local equiv eq_extend : + ExtendSample(FSome(BIRO.IRO)).f ~ ExtendOutputSize(FSetSize(FSome(BIRO.IRO))).f : + ={arg} /\ eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2} ==> + ={res} /\ eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}. +proof. +proc; inline*; auto; sp. +rcondt{2} 1; 1: auto. +if{1}; sp. +- rcondt{1} 1; auto. + rcondf{2} 8; 1: auto. + - conseq(:_==> true); 1: smt(). + by while(true); auto. + auto=> /=. + conseq(:_==> ={bs, k} /\ size bs{1} = size_out /\ + eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2})=> //=. + - smt(cats0 to_listK spec2_dout). + while(={k, bs, n, x2} /\ i{1} = i0{2} /\ n{1} = size_out /\ + 0 <= i{1} <= n{1} /\ size bs{1} = i{1} /\ + eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}). + - by sp; if; auto; smt(domE get_setE size_rcons). + by auto; smt(size_eq0 size_out_gt0). +rcondt{1} 1; 1: auto. +splitwhile{1} 1 : i0 < size_out; auto=> /=. +while( (i0, n0, x3){1} = (i, k, x){2} /\ bs0{1} = prefix{2} ++ suffix{2} /\ + size_out <= i{2} <= k{2} /\ eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}). ++ by sp; if; auto; smt(domE get_setE size_out_gt0 rcons_cat). +auto=> //=. +conseq(:_==> ={i0} /\ size bs{2} = i0{1} /\ (i0, x3){1} = (n, x2){2} /\ + bs0{1} = bs{2} /\ size bs{2} = size_out /\ + eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}). ++ smt(cats0 take_oversize spec_dout to_listK spec2_dout). +while(={i0} /\ x3{1} = x2{2} /\ 0 <= i0{1} <= n{2} /\ n{2} = size_out /\ + bs0{1} = bs{2} /\ size bs{2} = i0{1} /\ size_out <= n0{1} /\ + eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}). ++ by sp; if; auto; smt(size_rcons domE get_setE size_rcons mem_set). +by auto; smt(size_out_gt0). +qed. + + +local lemma of_listK l : of_list (to_list l) = Some l. +proof. +by rewrite -to_listK. +qed. + +local module Fill_In (F : RO) = { + proc init = F.init + proc f (x : bool list, n : int) = { + var l, b, i; + i <- 0; + l <- []; + while (i < n) { + b <@ F.get((x,i)); + l <- rcons l b; + i <- i + 1; + } + while (i < size_out) { + F.sample((x,i)); + i <- i + 1; + } + return l; + } +}. + +print module RO. + +local equiv eq_eager_ideal : + BIRO.IRO.f ~ Fill_In(LRO).f : + ={arg} /\ BIRO.IRO.mp{1} = RO.m{2} ==> + ={res} /\ BIRO.IRO.mp{1} = RO.m{2}. +proof. +proc; inline*; sp; rcondt{1} 1; auto. +while{2}(bs{1} = l{2} /\ BIRO.IRO.mp{1} = RO.m{2})(size_out - i{2}). ++ by auto=> />; smt(). +conseq(:_==> bs{1} = l{2} /\ BIRO.IRO.mp{1} = RO.m{2}); 1: smt(). +while(={i, n, x} /\ bs{1} = l{2} /\ BIRO.IRO.mp{1} = RO.m{2}). ++ sp; if{1}. + - by rcondt{2} 2; auto=> />. + by rcondf{2} 2; auto=> />; smt(dbool_ll). +by auto. +qed. + +local equiv eq_eager_ideal2 : + ExtendSample(FSome(BIRO.IRO)).f ~ FSome(Fill_In(RO)).f : + ={arg} /\ BIRO.IRO.mp{1} = RO.m{2} ==> + ={res} /\ BIRO.IRO.mp{1} = RO.m{2}. +proof. +proc; inline*; sp. +if{1}; sp. ++ rcondt{1} 1; auto=> /=/>. + conseq(:_==> take k{1} bs{1} = l{2} /\ BIRO.IRO.mp{1} = RO.m{2}). + * smt(). + case: (0 <= n{2}); last first. + + rcondf{2} 1; 1: by auto; smt(). + conseq(:_==> BIRO.IRO.mp{1} = RO.m{2} /\ ={i} /\ n{1} = size_out /\ x2{1} = x0{2})=> />. + - smt(take_le0). + while(={i} /\ x2{1} = x0{2} /\ n{1} = size_out /\ BIRO.IRO.mp{1} = RO.m{2}). + - sp; if{1}. + - by rcondt{2} 2; auto=> />. + by rcondf{2} 2; auto=> />; smt(dbool_ll). + by auto=> />. + splitwhile{1} 1 : i < k. + while(={i} /\ n{1} = size_out /\ x2{1} = x0{2} /\ BIRO.IRO.mp{1} = RO.m{2} /\ + take k{1} bs{1} = l{2} /\ size bs{1} = i{1} /\ k{1} <= i{1} <= size_out). + * sp; if{1}. + - by rcondt{2} 2; auto; smt(dbool_ll cats1 take_cat cats0 take_size size_rcons). + by rcondf{2} 2; auto; smt(dbool_ll cats1 take_cat cats0 take_size size_rcons). + conseq(:_==> ={i} /\ n{1} = size_out /\ x2{1} = x0{2} /\ BIRO.IRO.mp{1} = RO.m{2} /\ + bs{1} = l{2} /\ size bs{1} = i{1} /\ k{1} = i{1}). + + smt(take_size). + while(={i} /\ x2{1} = x0{2} /\ n{1} = size_out /\ k{1} = n{2} /\ + 0 <= i{1} <= k{1} <= size_out /\ bs{1} = l{2} /\ size bs{1} = i{1} /\ + BIRO.IRO.mp{1} = RO.m{2}). + + sp; if{1}. + - by rcondt{2} 2; auto; smt(size_rcons). + by rcondf{2} 2; auto; smt(size_rcons dbool_ll). + by auto; smt(size_ge0 size_out_gt0). +rcondt{1} 1; auto. +rcondf{2} 2; 1: auto. ++ conseq(:_==> i = n); 1: smt(). + by while(i <= n); auto=> />; smt(size_out_gt0). +while(i0{1} = i{2} /\ x3{1} = x0{2} /\ n0{1} = n{2} /\ bs0{1} = l{2} /\ + BIRO.IRO.mp{1} = RO.m{2}). ++ sp; if{1}. + - by rcondt{2} 2; auto=> />. + by rcondf{2} 2; auto; smt(dbool_ll). +by auto=> />. +qed. + +local module Dist (F : RO) = { + proc distinguish = SHA3_OIndiff.OIndif.OIndif(FSome(Fill_In(F)), + OSimulator(FSome(Fill_In(F))), ODRestr(Dist_of_CollAdv(A))).main +}. + +local module Game (F : RO) = { + proc distinguish () = { + var bo; + OSimulator(FSome(Fill_In(F))).init(); + Counter.c <- 0; + Log.m <- empty; + F.init(); + bo <@ Dist(F).distinguish(); + return bo; + } +}. + +local lemma eager_ideal &m : + Pr[SHA3_OIndiff.OIndif.OIndif(FSome(BIRO.IRO), + OSimulator(FSome(BIRO.IRO)), + ODRestr(Dist_of_CollAdv(A))).main() @ &m : res] = + Pr[SHA3_OIndiff.OIndif.OIndif(ExtendSample(FSome(BIRO.IRO)), + OSimulator(ExtendSample(FSome(BIRO.IRO))), + ODRestr(Dist_of_CollAdv(A))).main() @ &m : res]. +proof. +cut->: + Pr[SHA3_OIndiff.OIndif.OIndif(FSome(BIRO.IRO), + OSimulator(FSome(BIRO.IRO)), + ODRestr(Dist_of_CollAdv(A))).main() @ &m : res] = + Pr[Game(LRO).distinguish() @ &m : res]. ++ byequiv=> //=; proc. + inline{2} 1; sp; inline{2} 1; sp; inline{2} 1; sp; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp; sim. + seq 1 1 : (={m1, m2, glob OFC} /\ BIRO.IRO.mp{1} = RO.m{2}); last first. + - inline{1} 1; inline{2} 1; sp; sim. + inline{1} 1; inline{2} 1; sp; sim; if; auto. + * inline{1} 1; inline{2} 1; sp; sim. + inline{1} 7; inline{2} 7; sim. + inline{1} 8; inline{2} 8; sim. + swap 3 -2; sp. + case: (increase_counter Counter.c{1} m2{1} size_out <= SHA3Indiff.limit). + + rcondt{1} 10; 1: auto. + - inline*; auto. + by sp; rcondt 1; auto; conseq(:_==> true); auto. + rcondt{2} 10; 1: auto. + - inline*; auto. + by conseq(:_==> true); auto. + sim. + inline{1} 10; inline{2} 10; sim. + call eq_eager_ideal; auto. + by call eq_eager_ideal; auto. + rcondf{1} 10; 1: auto. + - inline*; auto. + by sp; rcondt 1; auto; conseq(:_==> true); auto. + rcondf{2} 10; 1: auto. + - inline*; auto. + by conseq(:_==> true); auto. + by auto; call eq_eager_ideal; auto. + sp; inline{1} 1; inline{2} 1; sp; sim. + inline{1} 1; inline{2} 1; sp; sim. + if; auto. + inline{1} 1; inline{2} 1; sp; sim. + by auto; call eq_eager_ideal; auto. + call(: ={glob OFC, glob OSimulator} /\ + BIRO.IRO.mp{1} = RO.m{2}); auto. + - proc; sp; if; auto. + inline{1} 1; inline{2} 1; sp; sim; if; 1: auto; sim. + if; 1: auto; sim; sp. + if; 1: auto; 1: smt(); sim. + * inline{1} 1; inline{2} 1; sp; sim. + by call eq_eager_ideal; auto; smt(). + smt(). + - by proc; inline*; sim. + proc; sim. + inline{1} 1; inline{2} 1; sp; sim; if; 1: auto; sim. + inline{1} 1; inline{2} 1; sp; sim. + by call eq_eager_ideal; auto. +cut->: + Pr[SHA3_OIndiff.OIndif.OIndif(ExtendSample(FSome(BIRO.IRO)), + OSimulator(ExtendSample(FSome(BIRO.IRO))), + ODRestr(Dist_of_CollAdv(A))).main() @ &m : res] = + Pr[Game(RO).distinguish() @ &m : res]. ++ byequiv=> //=; proc. + inline{2} 1; sp; inline{2} 1; sp; inline{2} 1; sp; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp; sim. + seq 1 1 : (={m1, m2, glob OFC} /\ BIRO.IRO.mp{1} = RO.m{2}); last first. + - inline{1} 1; inline{2} 1; sp; sim. + inline{1} 1; inline{2} 1; sp; sim; if; auto. + * inline{1} 6; inline{2} 6; sim. + inline{1} 7; inline{2} 7; sim. + swap 2 -1; sp. + case: (increase_counter Counter.c{1} m2{1} size_out <= SHA3Indiff.limit). + + rcondt{1} 9; 1: auto. + - inline*; auto. + by sp; rcondt 1; auto; conseq(:_==> true); auto. + rcondt{2} 9; 1: auto. + - inline*; auto. + by conseq(:_==> true); auto. + sim. + call eq_eager_ideal2; auto. + by call eq_eager_ideal2; auto. + rcondf{1} 9; 1: auto. + - inline*; auto. + by sp; rcondt 1; auto; conseq(:_==> true); auto. + rcondf{2} 9; 1: auto. + - inline*; auto. + by conseq(:_==> true); auto. + by auto; call eq_eager_ideal2; auto. + sp; inline{1} 1; inline{2} 1; sp; sim. + inline{1} 1; inline{2} 1; sp; sim. + if; auto. + by auto; call eq_eager_ideal2; auto. + call(: ={glob OFC, glob OSimulator} /\ + BIRO.IRO.mp{1} = RO.m{2}); auto. + - proc; sp; if; auto. + inline{1} 1; inline{2} 1; sp; sim; if; 1: auto; sim. + if; 1: auto; sim; sp. + if; 1: auto; 1: smt(); sim. + * by call eq_eager_ideal2; auto; smt(). + smt(). + - by proc; inline*; sim. + proc; sim. + inline{1} 1; inline{2} 1; sp; sim; if; 1: auto; sim. + by call eq_eager_ideal2; auto. +rewrite eq_sym; byequiv=> //=; proc. +by call(RO_LRO_D Dist); inline*; auto=> />. +qed. + + +local equiv toto : + DFSetSize(OFC(ExtendSample(FSome(BIRO.IRO)))).f ~ + DFSetSize(OFC(ExtendSample(FSome(BIRO.IRO)))).f : + ={glob OFC, arg} /\ eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2} ==> + ={glob OFC, res} /\ eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}. +proof. +proc; inline*; sp; if; auto; sp; if; auto; sp; (rcondt{1} 1; 1: auto; rcondt{2} 1; 1: auto)=>/=. ++ conseq(:_==> ={bs} /\ eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}); auto. + while(={i, bs, n, x3} /\ 0 <= i{1} <= size_out /\ n{1} = size_out /\ + eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}). + - by sp; if; auto; smt(domE get_setE size_out_gt0). + by auto; smt(size_out_gt0). +by conseq(:_==> true); auto; sim. +qed. + +local equiv titi mess c: + DFSetSize(OFC(ExtendSample(FSome(BIRO.IRO)))).f + ~ + SORO.Bounder(RFWhile).get + : + ={arg} /\ arg{1} = mess /\ Counter.c{1} = c /\ + SORO.Bounder.bounder{2} <= Counter.c{1} /\ + inv BIRO.IRO.mp{1} RFList.m{2} + ==> + if (increase_counter c mess size_out <= sigma) then + (exists y, res{1} = Some y /\ res{2} = Some y /\ + SORO.Bounder.bounder{2} <= Counter.c{1} /\ + Counter.c{1} = increase_counter c mess size_out /\ + inv BIRO.IRO.mp{1} RFList.m{2}) + else (res{1} = None). +proof. +proc; sp. +inline{1} 1; sp; auto. +if{1}. +- rcondt{2} 1; first by auto; smt(divz_ge0 gt0_r size_ge0). + sp; auto. + inline{1} 1; sp; auto. + sp; rcondt{1} 1; auto. + inline{1} 1; sp; auto. + call(eq_IRO_RFWhile); auto=> /> 15?. + rewrite oget_some take_oversize 1:/# /=. + have:=spec2_dout _ H5. + move=>/(some_oget)-> /=; smt(divz_ge0 gt0_r size_ge0 spec2_dout). +move=>/=. +conseq(:_==> true); auto. +inline*; if{2}; auto; sp; if{2}; auto; sp. +by while{2}(true)(size_out - i{2}); auto; smt(dbool_ll). +qed. + +local lemma rw_ideal_2 &m : + Pr[SHA3_OIndiff.OIndif.OIndif(FSome(BIRO.IRO), OSimulator(FSome(BIRO.IRO)), + ODRestr(Dist_of_CollAdv(A))).main() @ &m : res] <= + Pr[SORO.Collision(SORO_Coll(A), RFList).main() @ &m : res]. +proof. +have->:Pr[SORO.Collision(SORO_Coll(A), RFList).main() @ &m : res] = + Pr[SORO.Collision(SORO_Coll(A), RFWhile).main() @ &m : res]. ++ byequiv(: ={glob A, arg} ==> _)=>//=; proc. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + seq 1 1 : (={mi, glob A, glob SORO.Bounder, glob RFList}); last first. + - sp; inline{1} 2; inline{2} 2; inline{1} 1; inline{2} 1; sp; sim. + if; auto. + - sp; case: (SORO.Bounder.bounder{1} < sigma). + * rcondt{1} 5; 1: auto. + + by inline*; auto; conseq(:_==> true); auto. + rcondt{2} 5; 1: auto. + + by inline*; auto; conseq(:_==> true); auto. + call(rw_RF_List_While); auto. + by call(rw_RF_List_While); auto=> />. + rcondf{1} 5; 1: auto. + + by inline*; auto; conseq(:_==> true); auto. + rcondf{2} 5; 1: auto. + + by inline*; auto; conseq(:_==> true); auto. + by auto; call(rw_RF_List_While); auto. + by sp; if; auto; call(rw_RF_List_While); auto. + call(: ={glob SORO.Bounder, glob RFList, glob OSimulator, glob OPC, glob Log}); auto. + - proc; sp; if; auto. + inline{1} 1; inline{2} 1; sp; if; 1, 3: auto; sim. + if; 1: auto; sim; sp; sim; if; auto=> />; 1: smt(); sim. + + inline{1} 1; inline{2} 1; sp; sim. + inline{1} 1; inline{2} 1; sp; if; auto=> />. + - by call(rw_RF_List_While); auto; smt(). + smt(). + smt(). + - by sim. + proc; sim; inline{1} 1; inline{2} 1; sp; if; auto. + inline{1} 1; inline{2} 1; sp; sim. + inline{1} 1; inline{2} 1; sp; if; auto; sim. + by call(rw_RF_List_While); auto. +rewrite (eager_ideal &m). +have->:Pr[SHA3_OIndiff.OIndif.OIndif(ExtendSample(FSome(BIRO.IRO)), + OSimulator(ExtendSample(FSome(BIRO.IRO))), + ODRestr(Dist_of_CollAdv(A))).main() @ &m : res] = + Pr[SHA3_OIndiff.OIndif.OIndif(ExtendSample(FSome(BIRO.IRO)), + OSimulator(ExtendOutputSize(FSetSize(FSome(BIRO.IRO)))), + ODRestr(Dist_of_CollAdv(A))).main() @ &m : res]. ++ byequiv=> //=; proc. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp; auto=> />. + call(toto); call(toto); auto. + conseq(:_==> ={m1, m2, glob Counter} /\ + eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}); 1: smt(). + call(: ={glob OSimulator, glob OFC} /\ + eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}); last first; auto. + + smt(mem_empty). + + proc; sp; if; auto. + inline{1} 1; inline{2} 1; sp; if; 1, 3: auto. + if; 1, 3: auto; sp. + if; 1: auto; 1: smt(); last first. + - by conseq=> />; sim; smt(). + wp=> />; 1: smt(). + rnd; auto. + call(eq_extend); by auto; smt(). + + by proc; sp; if; auto; inline{1} 1; inline{2} 1; sp; if; auto. + proc; sp; inline{1} 1; inline{2} 1; sp; if; auto. + inline*; sp. + rcondt{1} 1; 1: auto; rcondt{2} 1; 1: auto; sp. + rcondt{1} 1; 1: auto; rcondt{2} 1; 1: auto; sp; auto. + conseq(:_==> ={bs} /\ eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}); + 1: by auto. + while(={i, n, x3, bs} /\ 0 <= i{1} <= size_out /\ n{1} = size_out /\ + eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}). + - by sp; if; auto; smt(domE get_setE size_rcons). + by auto; smt(size_out_gt0). +byequiv=> //=; proc. +inline{1} 1; inline{2} 1; sp. +inline{1} 1; inline{2} 1; sp. +inline{1} 1; inline{2} 1; sp. +inline{1} 1; inline{2} 1; sp. +inline{1} 1; inline{2} 1; sp. +inline{1} 1; sp; auto. +seq 1 2 : (={glob A, glob OFC, glob OSimulator, Log.m, m1, m2} /\ + inv BIRO.IRO.mp{1} RFList.m{2} /\ + SORO.Bounder.bounder{2} <= Counter.c{1}); last first. ++ sp; case: (increase_counter Counter.c{1} m1{1} size_out <= SHA3Indiff.limit). + - exists * m2{2}, m1{1}, Counter.c{1}; elim* => mess2 mess1 c. + call(titi mess2 (increase_counter c mess1 size_out))=> /= />. + by call(titi mess1 c)=> />; auto; smt(). + inline*; sp. + rcondf{1} 1; 1: auto; sp. + conseq(:_==> true); auto. + seq 1 0 : true. + - if{1}; auto; sp; 1: if{1}; auto; sp. + - rcondt{1} 1; auto. + while{1}(true)(n1{1}-i1{1}); auto; -1: smt(). + by sp; if; auto; smt(dbool_ll). + rcondt{1} 1; 1: auto. + while{1}(true)(n2{1}-i2{1}); auto. + by sp; if; auto; smt(dbool_ll). + seq 0 1 : true. + - if{2}; auto; sp; if{2}; auto; sp. + by while{2}(true)(size_out-i{2}); auto; smt(dbool_ll). + sp; if{2}; auto; sp; if{2}; auto; sp. + by while{2}(true)(size_out-i0{2}); auto; smt(dbool_ll). +conseq(:_==> ={glob A, glob OFC, glob OSimulator, Log.m, m1, m2} /\ + inv BIRO.IRO.mp{1} RFList.m{2} /\ SORO.Bounder.bounder{2} <= Counter.c{1}). +auto; call(: ={glob OSimulator, glob Counter, glob Log} /\ + inv BIRO.IRO.mp{1} RFList.m{2} /\ + SORO.Bounder.bounder{2} <= Counter.c{1}); auto; last first. ++ by smt(mem_empty). ++ proc; sp; if; auto=> />; 1: smt(). + inline{1} 1; inline{2} 1; sp; auto. + if; 1, 3: auto; -1: smt(). + if; 1, 3: auto; -1: smt(). + sp; if; 1: auto; 1: smt(); last first. + - by conseq(:_==> ={y, glob OSimulator}); 1: smt(); sim; smt(). + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + rcondt{2} 1; 1: by auto; smt(). + sp. + seq 3 2 : (={x0, x1, o1, k0, Log.m, suffix, glob OSimulator} /\ + inv BIRO.IRO.mp{1} RFList.m{2} /\ + SORO.Bounder.bounder{2} <= Counter.c{2} + 1); last first. + - by conseq(:_==> ={y, x1, glob OSimulator, Log.m}); 1: smt(); sim=> />. + inline{1} 1; auto. + by call(eq_IRO_RFWhile); auto; smt(). ++ by proc; inline*; sp; if; auto; sp; if; auto=> />; smt(). +proc. +inline{1} 1; inline{2} 1; sp; if; auto=> /=. +inline{1} 1; inline{2} 1; sp. +rcondt{1} 1; 1: auto. +inline{1} 1; auto. +rcondf{2} 4; 1: auto. ++ inline*; auto; sp; if; auto; sp; if; auto=> />; conseq(:_==> true); 1: smt(). + by while(true); auto. +inline{2} 1; sp. +rcondt{2} 1; 1: by auto; smt(divz_ge0 gt0_r size_ge0). +auto; call eq_IRO_RFWhile; auto=> />. +move=> &l &r 13?; split; 2: smt(divz_ge0 gt0_r size_ge0). +rewrite 2!oget_some cats0 take_oversize 1:/# take_oversize 1:spec_dout //=. +have h:=spec2_dout result_L H5. +have-> := some_oget _ h. +by rewrite eq_sym -to_listK; congr. +qed. + +local lemma rw_ideal &m : + Pr[SHA3_OIndiff.OIndif.OIndif(FSome(BIRO.IRO), OSimulator(FSome(BIRO.IRO)), + ODRestr(Dist_of_CollAdv(A))).main() @ &m : res] <= + Pr[SORO.Collision(SORO_Coll(A),RF(SORO.RO.RO)).main() @ &m : res]. +proof. +rewrite (StdOrder.RealOrder.ler_trans _ _ _ (rw_ideal_2 &m)). +byequiv(: ={glob A} ==> _) => //=; proc; inline*; sp; wp. +seq 1 1 : (={glob A, glob SHA3Indiff.Simulator, glob SORO.Bounder, glob Counter, + glob Log, mi} /\ RFList.m{1} = SORO.RO.RO.m{2}). ++ call(: ={glob SHA3Indiff.Simulator, glob SORO.Bounder, glob Counter, glob Log} /\ + RFList.m{1} = SORO.RO.RO.m{2}); auto. + - proc; sp; if; 1, 3: auto; sp. + inline *; sp; sim. + if; 1: auto; sim. + if; 1: auto; sim. + sp; if; 1: (auto; smt()); sim; 2: smt(). + sp; if; 1: auto; sim; -1: smt(). + sp; if{1}. + * rcondt{2} 2; auto; 1: smt(BlockSponge.parse_valid). + rnd (fun l => oget (of_list l)) to_list; auto=> />. + move=> &l &r 10?; split; 1: smt(of_listK). + rewrite -dout_equal_dlist=> ?; split=> ?. + + by rewrite dmapE=> h{h}; apply mu_eq=> x; smt(to_list_inj). + move=> sample. + rewrite !get_setE/=oget_some/=dout_full/= => h; split; 2: smt(). + rewrite eq_sym to_listK; apply some_oget. + apply spec2_dout. + by move:h; rewrite supp_dmap; smt(spec_dout). + by auto; smt(dout_ll). + - by proc; inline*; sp; if; auto; sp; if; auto. + - proc; inline*; sp; if; auto; sp; if; auto; sp; sim. + if{1}. + * rcondt{2} 2; auto. + rnd (fun l => oget (of_list l)) to_list; auto=> />. + move=> &l 4?; split=> ?; 1: smt(of_listK). + rewrite -dout_equal_dlist; split=> ?. + * by rewrite dmapE=> h{h}; apply mu_eq=> x; smt(to_list_inj). + move=> sample. + rewrite supp_dmap dout_full/= =>/> a. + by rewrite get_setE/=oget_some/= dout_full/=; congr; rewrite of_listK oget_some. + by auto; smt(dout_ll). +sp. +seq 4 4 : (={SORO.Bounder.bounder, x0, m1, m2, hash1, y0} /\ y0{1} = None /\ + RFList.m{1} = SORO.RO.RO.m{2}); last first. ++ if; 1, 3: auto; sp. + if{1}. + - rcondt{2} 2; 1: auto. + auto; rnd (fun t => oget (of_list t)) to_list; auto=> />. + move=> &l c Hc Hnin; split. + - move=> ret Hret. search to_list. + by have/= ->:= (to_listK ret (to_list ret)). + move=> h{h}; split. + - move=> ret Hret; rewrite -dout_equal_dlist. + rewrite dmapE /=; apply mu_eq=> //= x /=. + by rewrite /(\o) /pred1/=; smt(to_list_inj). + move=> h{h} l Hl. + rewrite dout_full /=. + have:= spec2_dout l. + have:=supp_dlist dbool size_out l _; 1: smt(size_out_gt0). + rewrite Hl/==> [#] -> h{h} /= H. + have H1:=some_oget _ H. + have:=to_listK (oget (of_list l)) l; rewrite {2}H1/= => -> /= {H H1}. + by rewrite get_setE/=; smt(). + by auto=> />; smt(dout_ll). +if; 1, 3: auto; sp. +if{1}. +- rcondt{2} 2; 1: auto. + auto; rnd (fun t => oget (of_list t)) to_list; auto=> />. + move=> &l c Hc Hnin; split. + - move=> ret Hret. search to_list. + by have/= ->:= (to_listK ret (to_list ret)). + move=> h{h}; split. + - move=> ret Hret; rewrite -dout_equal_dlist. + rewrite dmapE /=; apply mu_eq=> //= x /=. + by rewrite /(\o) /pred1/=; smt(to_list_inj). + move=> h{h} l Hl. + rewrite dout_full /=. + have:= spec2_dout l. + have:=supp_dlist dbool size_out l _; 1: smt(size_out_gt0). + rewrite Hl/==> [#] -> h{h} /= H. + have H1:=some_oget _ H. + have:=to_listK (oget (of_list l)) l; rewrite {2}H1/= => -> /= {H H1}. + by rewrite get_setE/=; smt(). +by auto=> />; smt(dout_ll). +qed. + + +local lemma leq_ideal &m : + Pr[SHA3_OIndiff.OIndif.OIndif(FSome(BIRO.IRO), OSimulator(FSome(BIRO.IRO)), + ODRestr(Dist_of_CollAdv(A))).main() @ &m : res] <= + (sigma * (sigma - 1) + 2)%r / 2%r / 2%r ^ size_out. +proof. +rewrite (StdOrder.RealOrder.ler_trans _ _ _ (rw_ideal &m)). +rewrite (StdOrder.RealOrder.ler_trans _ _ _ (RO_is_collision_resistant (SORO_Coll(A)) &m)). +by rewrite doutE1. +qed. + + + + local lemma rw_real &m : + Pr[Collision(A, OSponge, PSome(Perm)).main() @ &m : res] = + Pr[SHA3_OIndiff.OIndif.OIndif(FSome(Sponge(Poget(PSome(Perm)))), PSome(Perm), + ODRestr(Dist_of_CollAdv(A))).main() @ &m : res]. + proof. + byequiv=>//=; proc. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; inline{2} 1; sp. + inline{1} 1; sp; wp=> />. + seq 1 1 : (={glob A, glob Perm, m1, m2} /\ Bounder.bounder{1} = Counter.c{2}). + + auto; call(: ={glob Perm} /\ Bounder.bounder{1} = Counter.c{2})=> //=. + - by proc; inline*; sp; if; auto; 2:sim=> />; 1: smt(). + - by proc; inline*; sp; if; auto; 2:sim=> />; 1: smt(). + - proc; inline*; sp; if; auto; sp=> />. + by conseq(:_==> ={z0, glob Perm})=> />; sim. + conseq(:_==> ={hash1, hash2, m1, m2})=> //=; 1: smt(); sim. + seq 1 1 : (={m1, m2, hash1, glob Perm} /\ Bounder.bounder{1} = Counter.c{2}); last first. + + inline*; sp; if; auto; sp=> /=; sim. + inline*; sp; if; auto; swap{1} 9; auto; sp=> /=. + by conseq(:_==> ={m1, m2} /\ of_list (oget (Some (take n{1} z0{1}))) = + of_list (oget (Some (take n{2} z0{2}))) /\ ={Perm.mi, Perm.m})=> //=; sim. + qed. + +lemma Sponge_collision_resistant &m : + (forall (F <: OIndif.ODFUNCTIONALITY) (P <: OIndif.ODPRIMITIVE), + islossless F.f => islossless P.f => islossless P.fi => islossless A(F,P).guess) => + Pr[Collision(A, OSponge, PSome(Perm)).main() @ &m : res] <= + (limit ^ 2 - limit)%r / (2 ^ (r + c + 1))%r + + (4 * limit ^ 2)%r / (2 ^ c)%r + + (sigma * (sigma - 1) + 2)%r / 2%r / 2%r ^ size_out. +proof. +move=> A_ll. +rewrite (rw_real &m). +have := SHA3OIndiff (Dist_of_CollAdv(A)) &m _. ++ move=> F P Hp Hpi Hf; proc; inline*; sp; auto; call Hf; auto; call Hf; auto. + call(A_ll (DFSetSize(F)) P _ Hp Hpi); auto. + proc; inline*; auto; call Hf; auto. by have/#:=leq_ideal &m. qed. -end section SecondSecondPreimage. +end section Collision. From 6c4cc73480184979c8dce5c60bcf31fdff0a5cdd Mon Sep 17 00:00:00 2001 From: Pierre-Yves Strub Date: Thu, 29 Aug 2019 10:07:15 +0200 Subject: [PATCH 467/525] CI --- Makefile | 2 +- config/tests.config | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/Makefile b/Makefile index cbbd5a4..20b49e2 100644 --- a/Makefile +++ b/Makefile @@ -4,7 +4,7 @@ ECROOT ?= ECCHECK ?= ECARGS ?= -ECJOBS ?= 1 +ECJOBS ?= 2 ECCONF := config/tests.config XUNITOUT ?= xunit.yml CHECKS ?= sha3 diff --git a/config/tests.config b/config/tests.config index 6382a1d..5e7de4f 100644 --- a/config/tests.config +++ b/config/tests.config @@ -1,6 +1,6 @@ [default] bin = easycrypt -args = -timeout 30 -max-provers 2 -I proof -I proof/smart_counter -I proof/impl -I proof/impl/perm +args = -timeout 30 -p Z3 -p Alt-Ergo -I proof -I proof/smart_counter -I proof/impl -I proof/impl/perm [test-sha3] okdirs = !proof From c1254f747d132cf8335ffac2ceec73cb8241c5dd Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Thu, 29 Aug 2019 10:12:46 +0200 Subject: [PATCH 468/525] Fix end of section --- proof/SHA3Security.ec | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/proof/SHA3Security.ec b/proof/SHA3Security.ec index b618be1..f909c17 100644 --- a/proof/SHA3Security.ec +++ b/proof/SHA3Security.ec @@ -1282,4 +1282,4 @@ section SHA3_Collision. qed. -end section Collision. \ No newline at end of file +end section SHA3_Collision. \ No newline at end of file From 76bb58e7612ca314fa6e8d543daa76176050411d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Thu, 29 Aug 2019 11:35:28 +0200 Subject: [PATCH 469/525] fix SHA3Indiff.ec --- proof/SHA3Indiff.ec | 7 +------ 1 file changed, 1 insertion(+), 6 deletions(-) diff --git a/proof/SHA3Indiff.ec b/proof/SHA3Indiff.ec index 56fad44..d04da54 100644 --- a/proof/SHA3Indiff.ec +++ b/proof/SHA3Indiff.ec @@ -281,12 +281,7 @@ rewrite powS 1:addz_ge0 1:ge0_r 1:ge0_c -pow_add 1:ge0_r 1:ge0_c. have -> : (limit ^ 2 - limit)%r / (2 * (2 ^ r * 2 ^ c))%r = ((limit ^ 2 - limit)%r / 2%r) * (1%r / (2 ^ r)%r) * (1%r / (2 ^ c)%r). - rewrite (fromintM 2) StdRing.RField.invfM StdRing.RField.mulrA - -!StdRing.RField.mulrA. - congr. - rewrite (fromintM (2 ^ r)) StdRing.RField.invfM StdRing.RField.mulrA - -!StdRing.RField.mulrA. - congr; by rewrite StdRing.RField.mul1r. + by rewrite (fromintM 2); smt(). rewrite/=. have -> : (4 * limit ^ 2)%r / (2 ^ c)%r = From 44d2d431526357e173420c06c80365c86db038b3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Thu, 29 Aug 2019 11:38:08 +0200 Subject: [PATCH 470/525] rm SecureIRO.eca --- proof/SecureIRO.eca | 497 -------------------------------------------- 1 file changed, 497 deletions(-) delete mode 100644 proof/SecureIRO.eca diff --git a/proof/SecureIRO.eca b/proof/SecureIRO.eca deleted file mode 100644 index 9a65e18..0000000 --- a/proof/SecureIRO.eca +++ /dev/null @@ -1,497 +0,0 @@ -require import AllCore Int Real Distr List SmtMap FSet FelTactic DList. - -require (****) IRO. - - -(* Define the random function *) -type from. -type to. - -op dto : to distr. - -clone import IRO as URO with - type from <- from, - type to <- to, - op dto <- dto - proof *. - -axiom dto_ll : is_lossless dto. -axiom dto_funi : is_funiform dto. - -(* Define module types for the preimage, second preimage and collision games *) - -module type OIRO = { - proc f (x : from, n : int) : to list -}. - -module type Adversary (F : OIRO) = { - proc guess_preimage (h : to list) : from - proc guess_second_preimage (m1 : from, s : int) : from - proc guess_collision (s : int) : from * from -}. - -(* Define the bound on the counter cost and the operator updating the cost *) - -module Cost = { - var counter : int -}. - -op update_cost : int -> from -> int -> int. -axiom update_cost c m i : c <= update_cost c m i. -axiom update_costS c m i : - update_cost c m i <= update_cost c m (i+1) <= update_cost c m i + 1. -lemma update_cost_leq c m (i : int) j : - i <= j => update_cost c m i <= update_cost c m j. -proof. -pose k := j - i. -cut -> : j = k + i by smt(). -rewrite StdOrder.IntOrder.ler_addr. -by elim:k=>//= {j} k H0k; rewrite addzAC; smt(update_costS). -qed. - -op t : int. -axiom t_gt0 : 0 < t. - -op map_cost (m : ('a, 'b) fmap) : int. -axiom map_cost0 (m : ('a, 'b) fmap) : m = empty => 0 = map_cost m. -axiom map_cost_update_cost (map : ('a * 'b, 'c) fmap) c m i x j y : - map_cost map <= update_cost c m i => - map_cost map.[(x,j) <- y] <= update_cost c m (i+1). - -module Count (F : OIRO) = { - proc init() = { - Cost.counter <- 0; - } - proc f (m : from, n : int) = { - var r : to list; - r <- []; - if (0 <= n /\ update_cost Cost.counter m n < t) { - r <- F.f(m,n); - Cost.counter <- update_cost Cost.counter m n; - } - return r; - } -}. - -(***** Useful Material ********************************************************) -op rngm (m : ('a * int, 'b) fmap) (l : 'b list) = - exists (x : 'a), forall i, 0 <= i < size l => m.[(x,i)] = Some (nth witness l i). - -lemma not_rngm (m : ('a * int, 'b) fmap) (l : 'b list) : - ! rngm m l <=> forall x, exists i, 0 <= i < size l /\ m.[(x,i)] <> Some (nth witness l i). - -op set_at (l : 'a list) (i : int) (a : 'a) = - (take i l) ++ [a] ++ (drop (i+1) l). - -lemma nth_set_at_eq (a b : 'a) (l : 'a list) j : - 0 <= j < size l => nth a (set_at l j b) j = b. -proof. -move=>[#] hj0 hjn. -rewrite/set_at nth_cat size_cat/= size_take // hjn /=. -have->/=: j < j + 1 by smt(). -by rewrite nth_cat size_take // hjn /=. -qed. - -lemma nth_set_at_lt (a b : 'a) (l : 'a list) i j : - 0 <= j < i < size l => nth a (set_at l i b) j = nth a l j. -proof. -move=>[#] hj0 hji hin. -rewrite/set_at nth_cat size_cat/= size_take // 1:/# hin/=. -have->/=: j < i + 1 by smt(). -by rewrite nth_cat size_take // 1:/# hin /= hji /= nth_take /#. -qed. - -lemma nth_set_at_gt (a b : 'a) (l : 'a list) i j : - 0 <= i < j < size l => nth a (set_at l i b) j = nth a l j. -proof. -move=>[#] hi0 hji hjn. -have hin : i < size l by smt(). -rewrite/set_at nth_cat size_cat/= size_take // hin /=. -have->/=: ! j < i + 1 by smt(). -by rewrite nth_drop; smt(). -qed. - -lemma size_set_at (l : 'a list) i a : - 0 <= i < size l => size (set_at l i a) = size l. -proof. -move=> [#] hi0 hin; rewrite /set_at 2!size_cat /=. -by rewrite size_take // hin /= size_drop /#. -qed. - -(************************** Preimage Game *************************************) -module PreImage (A : Adversary, F : IRO) = { - proc game (h : to list) : bool = { - var m, h2, b; - b <- false; - Count(F).init(); - F.init(); - m <@ A(Count(F)).guess_preimage(h); - if (update_cost Cost.counter m (size h) < t) { - h2 <- F.f(m, size h); - b <- h = h2; - Cost.counter <- update_cost Cost.counter m (size h); - } - return b; - } -}. - -(************************** Second Preimage Game ******************************) -module SecondPreImage (A : Adversary, F : IRO) = { - proc game (m : from, s : int) : bool = { - var m2, h1, h2, b; - b <- false; - Count(F).init(); - F.init(); - m2 <@ A(Count(F)).guess_second_preimage(m,s); - if (0 <= s /\ update_cost Cost.counter m s < t) { - h1 <- F.f(m,s); - Cost.counter <- update_cost Cost.counter m s; - if (update_cost Cost.counter m2 s < t) { - h2 <- F.f(m2,s); - b <- h1 = h2; - Cost.counter <- update_cost Cost.counter m2 s; - } - } - return b; - } -}. - -(************************** Collision Game ************************************) -module Collision (A : Adversary, F : IRO) = { - proc game (s : int) : bool = { - var m1, m2, h1, h2, b; - b <- false; - Count(F).init(); - F.init(); - (m1,m2) <@ A(Count(F)).guess_collision(s); - if (0 <= s /\ update_cost Cost.counter m1 s < t) { - h1 <- F.f(m1,s); - Cost.counter <- update_cost Cost.counter m1 s; - if (update_cost Cost.counter m2 s < t) { - h2 <- F.f(m2,s); - b <- h1 = h2; - Cost.counter <- update_cost Cost.counter m2 s; - } - } - return b; - } -}. - - -(*********************************** Proofs ***********************************) -section Proof. - - declare module A : Adversary{IRO, Cost}. - - - (***** Useful Material ******************************************************) - local lemma card_domS (m : ('a, 'b) fmap) x y : - card (fdom m) <= card (fdom m.[x <- y]) <= card (fdom m) + 1. - proof. - rewrite fdom_set fcardU fcard1 fsetI1. - case: (x \in fdom m) => //=. - + by rewrite fcard1 /#. - by rewrite fcards0 /#. - qed. - - (****** Preimage Resistance ********) - local module FEL (A : Adversary, F : IRO) = { - proc main (hash : to list) : from = { - var m; - Count(F).init(); - m <@ A(Count(F)).guess_preimage(hash); - return m; - } - }. - - local module PreImage2 (A : Adversary, F : IRO) = { - proc game (h : to list) : bool = { - var m, h2, b; - b <- false; - F.init(); - m <@ FEL(A,F).main(h); - if (update_cost Cost.counter m (size h) < t) { - h2 <- F.f(m, size h); - b <- h = h2; - Cost.counter <- update_cost Cost.counter m (size h); - } - return b; - } - }. - - - local module DListIRO : IRO = { - proc init() = { - IRO.mp <- empty; - } - proc f (m : from, n : int) = { - var bs, i; - bs <- []; - if (valid m) { - bs <$ dlist dto n; - i <- 0; - while (i < n) { - if ((m,i) \notin IRO.mp) { - IRO.mp.[(m,i)] <- nth witness bs i; - } else { - bs <- set_at bs i (oget IRO.mp.[(m,i)]); - } - i <- i + 1; - } - } - return bs; - } - }. - - local clone DList.Program as MyPr with - type t <- to, - op d <- dto - proof *. - - local equiv equiv_dlist_IRO : - DListIRO.f ~ IRO.f : ={arg, glob IRO} /\ 0 <= arg{2}.`2 ==> ={res, glob IRO}. - proof. - proc; sp; if; 1,3:auto; inline*. - transitivity{2} { - i <- 0; - bs <- []; - while (i < n) { - b <$ dto; - bs <- rcons bs b; - i <- i + 1; - } - i <- 0; - while (i < n) { - if ((x, i) \notin IRO.mp) { - IRO.mp.[(x,i)] <- nth witness bs i; - } else { - bs <- set_at bs i (oget IRO.mp.[(x,i)]); - } - i <- i + 1; - } - } - (={bs, n, glob IRO} /\ bs{1} = [] /\ m{1} = x{2} ==> ={bs, IRO.mp}) - (={bs, n, x, glob IRO} /\ bs{1} = [] /\ i{2} = 0 /\ 0 <= n{1} ==> ={bs, IRO.mp})=>//=. - + smt(). - + sim. - conseq(:_==> ={bs})=> //=. - transitivity{1} { - bs <@ MyPr.Sample.sample(n); - } - (={n} ==> ={bs}) (={n} ==> ={bs})=> //=. - - smt(). - - by inline*; sim. - transitivity{2} { - bs <@ MyPr.LoopSnoc.sample(n); - } - (={n} ==> ={bs}) (={n} ==> ={bs})=> //=. - - smt(). - - by call MyPr.Sample_LoopSnoc_eq; auto. - inline*; sim. - by while( (i0, n1, l){1} = (i, n, bs){2}); auto; smt(cats1). - transitivity{2} { - i <- 0; - while (i < n) { - b <$ dto; - bs <- rcons bs b; - if ((x, i) \notin IRO.mp) { - IRO.mp.[(x,i)] <- nth witness bs i; - } else { - bs <- set_at bs i (oget IRO.mp.[(x,i)]); - } - i <- i + 1; - } - } - (={bs, n, x, glob IRO} /\ bs{1} = [] /\ 0 <= n{1} ==> ={bs, IRO.mp}) - (={bs, n, x, glob IRO} /\ bs{1} = [] /\ i{2} = 0 ==> ={bs, IRO.mp})=>//=. - + smt(). - + seq 3 2 : (={n, x} /\ size bs{1} = n{1} /\ size bs{2} = size bs{1} /\ - (forall y j, (y,j) \in IRO.mp{1} => (y,j) \in IRO.mp{2}) /\ - (forall y j, (y,j) \in IRO.mp{1} => - IRO.mp{1}.[(y,j)] = IRO.mp{2}.[(y,j)]) /\ - (forall y j, (y,j) \in IRO.mp{2} => - (y,j) \in IRO.mp{1} \/ (y = x{1} /\ 0 <= j < n{1})) /\ - (forall j, 0 <= j < n{1} => (x{1},j) \in IRO.mp{2} /\ - nth witness bs{2} j = oget IRO.mp{2}.[(x{1},j)]) /\ - (forall j, 0 <= j < n{1} => (x{1},j) \notin IRO.mp{1} => - nth witness bs{2} j = nth witness bs{1} j)); last first. - - sp; while{1}(={n, x} /\ size bs{1} = n{1} /\ 0 <= i{1} <= n{1} /\ - size bs{2} = size bs{1} /\ - (forall x j, (x,j) \in IRO.mp{1} => (x,j) \in IRO.mp{2}) /\ - (forall y j, (y,j) \in IRO.mp{1} => - IRO.mp{1}.[(y,j)] = IRO.mp{2}.[(y,j)]) /\ - (forall y j, (y,j) \in IRO.mp{2} => - (y,j) \in IRO.mp{1} \/ (y = x{1} /\ i{1} <= j < n{1})) /\ - (forall j, 0 <= j < n{1} => (x{1},j) \in IRO.mp{2} /\ - nth witness bs{2} j = oget IRO.mp{2}.[(x{1},j)]) /\ - (forall j, 0 <= j < i{1} => (x{1},j) \in IRO.mp{1} /\ - nth witness bs{1} j = oget IRO.mp{1}.[(x{1},j)]) /\ - (forall j, 0 <= j < n{1} => (x{1},j) \notin IRO.mp{1} => - nth witness bs{2} j = nth witness bs{1} j)) (n{1} - i{1}). - + move=> &1 c; if; auto; 1:smt(mem_set get_setE); - smt(nth_set_at_eq nth_set_at_lt nth_set_at_gt size_set_at). - auto=> &1 &2 [#] 3->> <<- hs2 4?; do !split=> //=. - + exact size_ge0. - + smt(). - move=> [#] map1 bs1 i1; split; 1: smt(). - + move=> hnis [#] hs hi0 his /= 6?. - have ->>/=: map1 = IRO.mp{2}. - - apply fmap_eqP. - move=> [] y j. - case: ((y,j) \in map1)=> hin; 1:smt(). - have := hin; rewrite domE /= => ->. - have := H7 y j; rewrite hin /=. - have -> /= : ! i1 <= j < size bs{1} by smt(). - by rewrite domE /= => ->. - apply/(eq_from_nth witness)=> //=. - - by rewrite hs hs2. - move=> j [] hj0 hjs. - have [] h -> {h} := H9 j _; 1: smt(). - by have [] h -> {h} := H8 j _; 1: smt(). - while(={i, n, x} /\ 0 <= i{1} <= n{1} /\ - size bs{1} = i{1} /\ size bs{1} = size bs{2} /\ - (forall y j, (y,j) \in IRO.mp{1} => (y,j) \in IRO.mp{2}) /\ - (forall y j, (y,j) \in IRO.mp{1} => - IRO.mp{1}.[(y,j)] = IRO.mp{2}.[(y,j)]) /\ - (forall y j, (y,j) \in IRO.mp{2} => - (y,j) \in IRO.mp{1} \/ (y = x{1} /\ 0 <= j < i{1})) /\ - (forall j, 0 <= j < i{1} => (x{1},j) \in IRO.mp{2} /\ - nth witness bs{2} j = oget IRO.mp{2}.[(x{1},j)]) /\ - (forall j, 0 <= j < i{1} => (x{1},j) \notin IRO.mp{1} => - nth witness bs{2} j = nth witness bs{1} j)). - wp; rnd; auto. - move=> &1 &2 [#] 3->> hi0 hin <<- hs 4? {hin} his h {h} b hbin //=. - rewrite hbin //; case: ((x{2}, size bs{1}) \in IRO.mp{2})=> hin//=. - + do !split. - - smt(size_ge0). - - smt(). - - exact size_rcons. - - smt(size_set_at size_rcons). - - smt(). - - smt(). - - smt(). - - move=> j [] hj0 hjs; split; 1:smt(). - case: (j < size bs{1})=> hjs1. - + rewrite nth_set_at_lt 1:size_rcons 1:/#. - have//=[]_ <-:= H2 j _; 1: by done. - by rewrite nth_rcons -hs hjs1 /=. - have->>: j = size bs{1} by smt(). - by rewrite nth_set_at_eq 1:size_rcons 1:-hs 1:/#. - - move=> j [] hj0 hjs hnin. - have hjs1: (j < size bs{1}) by smt(). - rewrite nth_set_at_lt 1:size_rcons 1:/#. - rewrite !nth_rcons -hs hjs1 /=. - by apply H3=> //=. - do !split. - + smt(size_ge0). - + smt(). - + exact size_rcons. - + smt(size_rcons). - + smt(mem_set). - + smt(get_setE). - + smt(mem_set). - + move=>j [] hj0 hjs1; split. - - rewrite mem_set; smt(). - by rewrite nth_rcons get_setE /= nth_rcons; smt(). - + smt(nth_rcons). - by auto; smt(). - while(={i, n, IRO.mp, x, bs} /\ i{1} = size bs{1}); 2:auto. - + sp; if{2}. - - rcondt{1} 3; 1: auto; wp; rnd; auto; progress. - + smt(size_rcons nth_rcons). - + smt(get_setE). - + smt(size_rcons). - rcondf{1} 3; auto; progress. - + exact dto_ll. - apply (eq_from_nth witness). - + rewrite size_set_at //= 1: size_rcons 1:size_ge0 1:/#. - by rewrite 2!size_rcons. - move=> i [] hi0; rewrite size_set_at 1:size_ge0 size_rcons//= 1:/# => his. - case: (i < size bs{2})=> his2. - + by rewrite nth_set_at_lt 1:size_rcons 1:/# 2!nth_rcons his2/=. - have->>: i = size bs{2} by smt(). - rewrite nth_set_at_eq 1:size_rcons 1:size_ge0 1:/#. - by rewrite nth_rcons /=. - by rewrite size_set_at size_rcons 1:size_ge0 1:/#. - qed. - - - lemma PreImage_Resistance &m (ha : to list) : - Pr [ PreImage(A, IRO).game(ha) @ &m : res ] - <= mu1 (dlist dto (size ha)) ha. - proof. - have->: Pr [ PreImage (A, IRO).game(ha) @ &m : res ] = - Pr [ PreImage2(A, IRO).game(ha) @ &m : res ]. - + by byequiv=>//=; proc; inline*; sp; sim. - have->: Pr [ PreImage2(A, IRO).game(ha) @ &m : res ] = - Pr [ PreImage2(A, DListIRO).game(ha) @ &m : res ]. - + byequiv=> //=; proc; inline{1} 2; inline{2} 2; sp. - seq 1 1 : (={b, m, h, glob IRO, glob Cost}). - + inline*; wp; call(: ={glob IRO, glob Cost}); auto. - by proc; sp; if; auto; symmetry; call equiv_dlist_IRO. - by if; auto; symmetry; call equiv_dlist_IRO; auto; smt(size_ge0). - byphoare(: arg = ha ==> _)=> //=; proc; inline 2; swap 1 2. - sp; seq 1 : (rngm IRO.mp ha) (mu1 (dlist dto (size ha)) ha) 1%r 1%r - (mu1 (dlist dto (size ha)) ha) - (map_cost IRO.mp <= Cost.counter <= t /\ ha = h)=>//=. - + inline*; sp; auto. - conseq(: _ ==> map_cost IRO.mp <= Cost.counter <= t); 1: auto. - call(: map_cost IRO.mp <= Cost.counter <= t)=> //=; auto. - + proc; inline*; sp; if; auto; sp; if; auto. - + conseq(:_==> map_cost IRO.mp <= update_cost Cost.counter m n0 <= t); 1: auto. - while(map_cost IRO.mp <= update_cost Cost.counter m i <= t - /\ update_cost Cost.counter m n0 < t /\ 0 <= i <= n0). - + auto; smt(map_cost_update_cost card_domS update_costS update_cost_leq). - by auto; smt(update_cost update_cost_leq). - smt(update_cost). - + smt(fdom0 fcards0 t_gt0 map_cost0). - + call(: true ==> rngm IRO.mp ha)=> //; bypr=> /> {&m} &m. - fel 1 Cost.counter (fun _, mu1 (dlist dto (size ha)) ha) t (rngm IRO.mp ha) - [Count(IRO).f: (map_cost IRO.mp <= Cost.counter < t)] - (map_cost IRO.mp <= Cost.counter <= t) - =>//; admit. - + sp; if; last first. - - by hoare; auto; smt(mu_bounded size_ge0). - inline*; wp; sp; if; last first. - - by hoare; auto; smt(mu_bounded size_ge0). - case: (n = size ha); last first. - - hoare; conseq(:_==> size bs = n); progress. - by while(size bs = n /\ 0 <= i <= n); auto; smt(size_set_at). print rngm. - seq 1 : (bs = ha) (mu1 (dlist dto (size ha)) ha) 1%r _ 0%r - (size ha = n /\ ! rngm IRO.mp ha)=>//=. - + by auto. - + by rnd; auto. - hoare; auto; while(h <> bs /\ !rngm IRO.mp ha /\ 0 <= i /\ n = size ha /\ - (forall j, 0 <= j < i => IRO.mp.[(m0,j)] = Some (nth witness bs j))); auto; progress. - + rewrite/rngm negb_exists/= => a; rewrite negb_forall /=. - case: (a = m0{hr}) => //=. - + move=> <<-. - have:=H0; rewrite negb_exists /= => /(_ a); rewrite negb_forall /= => [][] b. - case: (0 <= b < size ha) =>//=. - - exists i{hr}=> /=; rewrite H1 H2 /=. - qed. - - (****** Second Preimage Resistance ********) - lemma SecondPreImage_Resistance &m (m : from) (output_size : int) : - 0 < output_size => - Pr [ SecondPreImage(A, IRO).game(m, output_size) @ &m : res ] - <= mu1 dto witness<:to>. - proof. - admit. - qed. - - - (****** Collision Resistance ********) - lemma Collision_Resistance &m (output_size : int) : - 0 < output_size => - Pr [ Collision(A, IRO).game(output_size) @ &m : res ] <= mu1 dto witness<:to>. - proof. - admit. - qed. - -end section Proof. - - - - From a8c96239e77e97c1cf8fe436b1742597a677ad25 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Thu, 29 Aug 2019 11:55:36 +0200 Subject: [PATCH 471/525] remove print/search in SHA3_OSecurity.ec --- proof/SHA3OSecurity.ec | 17 +++++++---------- 1 file changed, 7 insertions(+), 10 deletions(-) diff --git a/proof/SHA3OSecurity.ec b/proof/SHA3OSecurity.ec index 1b68112..c2437eb 100644 --- a/proof/SHA3OSecurity.ec +++ b/proof/SHA3OSecurity.ec @@ -50,10 +50,10 @@ cut->:inv (2%r ^ size_out) = mu1 (dlist dbool size_out) (to_list x). rewrite spec_dout/=. pose p:= StdBigop.Bigreal.BRM.big _ _ _. cut->: p = StdBigop.Bigreal.BRM.big predT (fun _ => inv 2%r) (to_list x). - - rewrite /p =>{p}. print StdBigop.Bigreal.BRM. + - rewrite /p =>{p}. apply StdBigop.Bigreal.BRM.eq_bigr. by move=> i; rewrite//= dbool1E. - rewrite StdBigop.Bigreal.BRM.big_const count_predT spec_dout=> {p}. search 0 Int.(+) 1 (<=). + rewrite StdBigop.Bigreal.BRM.big_const count_predT spec_dout=> {p}. have:=size_out_gt0; move/ltzW. move:size_out;apply intind=> //=. - by rewrite powr0 iter0 //= fromint1. @@ -492,7 +492,6 @@ local module Fill_In (F : RO) = { } }. -print module RO. local equiv eq_eager_ideal : BIRO.IRO.f ~ Fill_In(LRO).f : @@ -841,7 +840,7 @@ if{1}. + wp=> />. rnd (fun x => oget (of_list x)) to_list; auto=> />. move=> &l c Hc Hnin; split. - - move=> ret Hret. search to_list. + - move=> ret Hret. by have/= ->:= (to_listK ret (to_list ret)). move=> h{h}; split. - move=> ret Hret; rewrite -dout_equal_dlist. @@ -1206,7 +1205,6 @@ local module Fill_In (F : RO) = { } }. -print module RO. local equiv eq_eager_ideal : BIRO.IRO.f ~ Fill_In(LRO).f : @@ -1669,7 +1667,7 @@ seq 4 4 : (={SORO.Bounder.bounder, x0, m1, m2, hash1, y0} /\ y0{1} = None /\ - rcondt{2} 2; 1: auto. auto; rnd (fun t => oget (of_list t)) to_list; auto=> />. move=> &l c Hc Hnin; split. - - move=> ret Hret. search to_list. + - move=> ret Hret. by have/= ->:= (to_listK ret (to_list ret)). move=> h{h}; split. - move=> ret Hret; rewrite -dout_equal_dlist. @@ -1689,7 +1687,7 @@ if{1}. - rcondt{2} 2; 1: auto. auto; rnd (fun t => oget (of_list t)) to_list; auto=> />. move=> &l c Hc Hnin; split. - - move=> ret Hret. search to_list. + - move=> ret Hret. by have/= ->:= (to_listK ret (to_list ret)). move=> h{h}; split. - move=> ret Hret; rewrite -dout_equal_dlist. @@ -2086,7 +2084,6 @@ local module Fill_In (F : RO) = { } }. -print module RO. local equiv eq_eager_ideal : BIRO.IRO.f ~ Fill_In(LRO).f : @@ -2541,7 +2538,7 @@ seq 4 4 : (={SORO.Bounder.bounder, x0, m1, m2, hash1, y0} /\ y0{1} = None /\ - rcondt{2} 2; 1: auto. auto; rnd (fun t => oget (of_list t)) to_list; auto=> />. move=> &l c Hc Hnin; split. - - move=> ret Hret. search to_list. + - move=> ret Hret. by have/= ->:= (to_listK ret (to_list ret)). move=> h{h}; split. - move=> ret Hret; rewrite -dout_equal_dlist. @@ -2561,7 +2558,7 @@ if{1}. - rcondt{2} 2; 1: auto. auto; rnd (fun t => oget (of_list t)) to_list; auto=> />. move=> &l c Hc Hnin; split. - - move=> ret Hret. search to_list. + - move=> ret Hret. by have/= ->:= (to_listK ret (to_list ret)). move=> h{h}; split. - move=> ret Hret; rewrite -dout_equal_dlist. From 1ce20f29bf4ee6583bf0fd202a662abf7b7adb13 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Fri, 30 Aug 2019 13:31:30 +0200 Subject: [PATCH 472/525] update lossless axioms (check) verify no admit (check) --- proof/IndifRO_is_secure.ec | 12 ++++++------ proof/SHA3Indiff.ec | 4 ++-- proof/SHA3Security.ec | 16 ++++++++-------- 3 files changed, 16 insertions(+), 16 deletions(-) diff --git a/proof/IndifRO_is_secure.ec b/proof/IndifRO_is_secure.ec index dc90d5e..3b1de8c 100644 --- a/proof/IndifRO_is_secure.ec +++ b/proof/IndifRO_is_secure.ec @@ -93,7 +93,7 @@ section Collision. declare module A : AdvCollision{Bounder, SRO.RO.RO, SRO.RO.FRO}. - axiom D_ll (F <: Oracle) : + axiom D_ll (F <: Oracle { A }) : islossless F.get => islossless A(F).guess. lemma coll_resistant_if_indifferentiable @@ -117,7 +117,7 @@ section Collision. Pr[Collision(A, SRO.RO.RO).main() @ &m : res]. + byequiv=>//=; proc; inline DColl(A, RO, S(RO)).distinguish; wp; sim. inline*; swap{2} 1 1; wp. - call{1} (S_ll RO); auto. + call{1}(S_ll RO _); auto. by proc; auto; smt(sampleto_ll). exact(RO_is_collision_resistant A &m). qed. @@ -138,7 +138,7 @@ section Preimage. declare module A : AdvPreimage{Bounder, SRO.RO.RO, SRO.RO.FRO, DPre}. - axiom D_ll (F <: Oracle) : + axiom D_ll (F <: Oracle{A}) : islossless F.get => islossless A(F).guess. lemma preimage_resistant_if_indifferentiable @@ -163,7 +163,7 @@ section Preimage. Pr[Preimage(A, SRO.RO.RO).main(hash) @ &m : res]. + byequiv=>//=; proc; inline DPre(A, RO, S(RO)).distinguish; wp; sim. inline*; swap{2} 1 1; wp; sim; auto. - call{1} (S_ll RO); auto. + call{1} (S_ll RO _); auto. by proc; auto; smt(sampleto_ll). exact(RO_is_preimage_resistant A &m hash). qed. @@ -184,7 +184,7 @@ section SecondPreimage. declare module A : AdvSecondPreimage{Bounder, SRO.RO.RO, SRO.RO.FRO, D2Pre}. - axiom D_ll (F <: Oracle) : + axiom D_ll (F <: Oracle{A}) : islossless F.get => islossless A(F).guess. lemma second_preimage_resistant_if_indifferentiable @@ -209,7 +209,7 @@ section SecondPreimage. Pr[SecondPreimage(A, SRO.RO.RO).main(mess) @ &m : res]. + byequiv=>//=; proc; inline D2Pre(A, RO, S(RO)).distinguish; wp; sim. inline*; swap{2} 1 1; wp; sim; auto. - call{1} (S_ll RO); auto. + call{1} (S_ll RO _); auto. by proc; auto; smt(sampleto_ll). exact(RO_is_second_preimage_resistant A &m mess). qed. diff --git a/proof/SHA3Indiff.ec b/proof/SHA3Indiff.ec index d04da54..1e3390d 100644 --- a/proof/SHA3Indiff.ec +++ b/proof/SHA3Indiff.ec @@ -152,7 +152,7 @@ declare module Dist : Gconcl_list.BIRO2.IRO, Gconcl_list.F2.RO, Gconcl_list.F2.RRO, Gconcl_list.Simulator}. -axiom Dist_lossless (F <: DFUNCTIONALITY) (P <: DPRIMITIVE) : +axiom Dist_lossless (F <: DFUNCTIONALITY { Dist }) (P <: DPRIMITIVE { Dist }) : islossless P.f => islossless P.fi => islossless F.f => islossless Dist(F,P).distinguish. @@ -318,7 +318,7 @@ lemma SHA3Indiff Gconcl_list.BIRO2.IRO, Gconcl_list.F2.RO, Gconcl_list.F2.RRO, Gconcl_list.Simulator}) &m : - (forall (F <: DFUNCTIONALITY) (P <: DPRIMITIVE), + (forall (F <: DFUNCTIONALITY { Dist }) (P <: DPRIMITIVE { Dist }), islossless P.f => islossless P.fi => islossless F.f => diff --git a/proof/SHA3Security.ec b/proof/SHA3Security.ec index f909c17..2ab9611 100644 --- a/proof/SHA3Security.ec +++ b/proof/SHA3Security.ec @@ -128,7 +128,7 @@ section Preimage. Gconcl.S, BlockSponge.BIRO.IRO, BlockSponge.C, Gconcl_list.F2.RO, Gconcl_list.F2.FRO, Gconcl_list.Simulator, DPre}. - axiom A_ll (F <: SRO.Oracle) : islossless F.get => islossless A(F).guess. + axiom A_ll (F <: SRO.Oracle { A }) : islossless F.get => islossless A(F).guess. local lemma invm_dom_rng (m mi : (state, state) fmap) : invm m mi => dom m = rng mi. @@ -468,7 +468,7 @@ section Preimage. have->//=:= SHA3Indiff (DSetSize(DPre(A))) &m _. move=> F P P_f_ll P_fi_ll F_ll; proc; inline*; auto; sp; auto. seq 1 : true; auto. - + call (A_ll (SRO.Bounder(FInit(DFSetSize(F))))); auto. + + call (A_ll (SRO.Bounder(FInit(DFSetSize(F)))) _); auto. by proc; inline*; sp; if; auto; sp; if; auto; sp; call F_ll; auto. if; auto; sp. by call F_ll; auto. @@ -485,7 +485,7 @@ section SecondPreimage. Gconcl.S, BlockSponge.BIRO.IRO, BlockSponge.C, Gconcl_list.F2.RO, Gconcl_list.F2.FRO, Gconcl_list.Simulator, D2Pre}. - axiom A_ll (F <: SRO.Oracle) : islossless F.get => islossless A(F).guess. + axiom A_ll (F <: SRO.Oracle { A }) : islossless F.get => islossless A(F).guess. local lemma invm_dom_rng (m mi : (state, state) fmap) : invm m mi => dom m = rng mi. @@ -859,7 +859,7 @@ section SecondPreimage. have->//=:= SHA3Indiff (DSetSize(D2Pre(A))) &m _. move=> F P P_f_ll P_fi_ll F_ll; proc; inline*; auto; sp. seq 1 : true; auto. - + call (A_ll (SRO.Bounder(FInit(DFSetSize(F))))); auto. + + call (A_ll (SRO.Bounder(FInit(DFSetSize(F)))) _); auto. by proc; inline*; sp; if; auto; sp; if; auto; sp; call F_ll; auto. if; auto; sp. seq 1 : true; auto. @@ -878,7 +878,7 @@ section Collision. Gconcl.S, BlockSponge.BIRO.IRO, BlockSponge.C, Gconcl_list.F2.RO, Gconcl_list.F2.FRO, Gconcl_list.Simulator}. - axiom A_ll (F <: SRO.Oracle) : islossless F.get => islossless A(F).guess. + axiom A_ll (F <: SRO.Oracle { A }) : islossless F.get => islossless A(F).guess. local lemma invm_dom_rng (m mi : (state, state) fmap) : invm m mi => dom m = rng mi. @@ -1236,7 +1236,7 @@ section Collision. have->//=:= SHA3Indiff (DSetSize(DColl(A))) &m _. move=> F P P_f_ll P_fi_ll F_ll; proc; inline*; auto; sp. seq 1 : true; auto. - + call (A_ll (SRO.Bounder(FInit(DFSetSize(F))))); auto. + + call (A_ll (SRO.Bounder(FInit(DFSetSize(F)))) _); auto. by proc; inline*; sp; if; auto; sp; if; auto; sp; call F_ll; auto. if; auto; sp. seq 1 : true; auto. @@ -1269,7 +1269,7 @@ section SHA3_Collision. Gconcl.S, BlockSponge.BIRO.IRO, BlockSponge.C, Gconcl_list.F2.RO, Gconcl_list.F2.FRO, Gconcl_list.Simulator}. - axiom A_ll (F <: SRO.Oracle) : islossless F.get => islossless A(F).guess. + axiom A_ll (F <: SRO.Oracle { A }) : islossless F.get => islossless A(F).guess. lemma SHA3_coll_resistant &m : Pr[SRO.Collision(AdvCollisionSHA3(A), FM(CSetSize(Sponge), Perm)).main() @ &m : res] <= @@ -1278,7 +1278,7 @@ section SHA3_Collision. (sigma * (sigma - 1) + 2)%r / 2%r / (2%r ^ size_out). proof. apply (Sponge_coll_resistant (AdvCollisionSHA3(A)) _ &m). - by move=> F F_ll; proc; inline*; call(A_ll (X(F))); auto; proc; call F_ll; auto. + by move=> F F_ll; proc; inline*; call(A_ll (X(F)) _); auto; proc; call F_ll; auto. qed. From 0720e940955a3ed8f843f74f25f3903e40175618 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Fri, 30 Aug 2019 15:13:17 +0200 Subject: [PATCH 473/525] remove print/search --- proof/Common.ec | 1 - proof/SHA3Security.ec | 4 ++-- proof/SecureHash.eca | 1 - 3 files changed, 2 insertions(+), 4 deletions(-) diff --git a/proof/Common.ec b/proof/Common.ec index e02a614..29be89f 100644 --- a/proof/Common.ec +++ b/proof/Common.ec @@ -53,7 +53,6 @@ export DBlock. op cdistr = DCapacity.dunifin. op bdistr = DBlock.dunifin. -search c. (* ------------------------- Auxiliary Lemmas ------------------------- *) diff --git a/proof/SHA3Security.ec b/proof/SHA3Security.ec index 2ab9611..bbdb14b 100644 --- a/proof/SHA3Security.ec +++ b/proof/SHA3Security.ec @@ -44,10 +44,10 @@ cut->:inv (2%r ^ size_out) = mu1 (dlist dbool size_out) (to_list x). rewrite spec_dout/=. pose p:= StdBigop.Bigreal.BRM.big _ _ _. cut->: p = StdBigop.Bigreal.BRM.big predT (fun _ => inv 2%r) (to_list x). - - rewrite /p =>{p}. print StdBigop.Bigreal.BRM. + - rewrite /p =>{p}. apply StdBigop.Bigreal.BRM.eq_bigr. by move=> i; rewrite//= dbool1E. - rewrite StdBigop.Bigreal.BRM.big_const count_predT spec_dout=> {p}. search 0 Int.(+) 1 (<=). + rewrite StdBigop.Bigreal.BRM.big_const count_predT spec_dout=> {p}. have:=size_out_gt0; move/ltzW. move:size_out;apply intind=> //=. - by rewrite powr0 iter0 //= fromint1. diff --git a/proof/SecureHash.eca b/proof/SecureHash.eca index d29ccf4..76caecd 100644 --- a/proof/SecureHash.eca +++ b/proof/SecureHash.eca @@ -29,7 +29,6 @@ axiom sampleto_fu: is_funiform sampleto. op increase_counter (c : int) (m : from) : int. axiom increase_counter_spec c m : c <= increase_counter c m. -print OIndif. (* module type RF = { *) (* proc init() : unit *) From 43d8a18b24939eb0cf14669953f01600d519255f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Fri, 30 Aug 2019 15:15:07 +0200 Subject: [PATCH 474/525] clear everything --- proof/BlockSponge.ec | 15 --------------- 1 file changed, 15 deletions(-) diff --git a/proof/BlockSponge.ec b/proof/BlockSponge.ec index acdaf0d..9baad40 100644 --- a/proof/BlockSponge.ec +++ b/proof/BlockSponge.ec @@ -146,18 +146,3 @@ module (Sponge : CONSTRUCTION) (P : DPRIMITIVE) : FUNCTIONALITY = { return z; } }. - -(*----------------------------- Conclusion -----------------------------*) - -(* this is just for typechecking, right now: *) - -(* lemma conclusion : *) -(* forall (D <: DISTINGUISHER) &m, *) -(* `| Pr[RealIndif(Sponge, Perm, DRestr(D)).main() @ &m : res] *) -(* - Pr[IdealIndif(IRO, Sim, DRestr(D)).main() @ &m : res]| *) -(* <= (max_size ^ 2)%r / 2%r * Distr.mu1 dstate witness + *) -(* max_size%r * ((2 * max_size)%r / (2 ^ c)%r) + *) -(* max_size%r * ((2 * max_size)%r / (2 ^ c)%r). *) -(* proof. *) -(* admit. *) -(* qed. *) From 3286de4bd5ae8eb879319e066a4d559539fc6af0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Fri, 30 Aug 2019 16:06:16 +0200 Subject: [PATCH 475/525] Resolve some problems with conversions between (&&) and (/\). --- proof/smart_counter/Handle.eca | 41 ++++++++++++++++++++-------------- 1 file changed, 24 insertions(+), 17 deletions(-) diff --git a/proof/smart_counter/Handle.eca b/proof/smart_counter/Handle.eca index 281958b..dd2241a 100644 --- a/proof/smart_counter/Handle.eca +++ b/proof/smart_counter/Handle.eca @@ -496,8 +496,9 @@ split=> [xa0 xc0 ya0 yc0|xa0 hx0 ya0 hy0]; rewrite get_setE. move=> xaxc0_neq_xaxc /Hm_mh [hx0 fx0 hy0 fy0] [#] hs_hx0 hs_hy0 mh_xahx0. by exists hx0 fx0 hy0 fy0; rewrite !get_setE /#. case: ((xa0,hx0) = (xa,hx))=> [[#] <*>> [#] <<*>|] /=. -+ by exists xc f yc f'; rewrite !get_setE /= /#. -move=> /negb_and xahx0_neq_xahx /Hmh_m [xc0 fx0 yc0 fy0] [#] hs_hx0 hs_hy0 Pm_xaxc0. ++ by exists xc f yc f'; rewrite !get_setE /= /#. search (&&) (/\). +rewrite andaE. +move=>/= /negb_and xahx0_neq_xahx /Hmh_m [xc0 fx0 yc0 fy0] [#] hs_hx0 hs_hy0 Pm_xaxc0. exists xc0 fx0 yc0 fy0; rewrite !get_setE; do !split=> [/#|/#|/=]. move: xahx0_neq_xahx; case: (xa0 = xa)=> [/= <*>>|//=]; case: (xc0 = xc)=> [<*>>|//=]. by move: hs_hx=> /(Hhuniq _ _ _ _ hs_hx0). @@ -517,7 +518,7 @@ move=> [] Hm_mh Hmh_m yc_notin_rng1_hs hs_hx hs_hy; split. by exists hy0 fy0 hx0 fx0; rewrite !get_setE /#. move=> ya0 hy0 xa0 hx0; rewrite get_setE; case: ((ya0,hy0) = (ya,hy))=> [[#] <*>> [#] <<*>|]. + by exists yc fy xc fx; rewrite !get_setE //= /#. -move=> /= /negb_and yahy0_neq_yahy /Hmh_m [yc0 fy0 xc0 fx0] [#] hs_hy0 hs_hx0 mi_yayc0. +move=>yahy0_neq_yahy /Hmh_m [yc0 fy0 xc0 fx0] [#] hs_hy0 hs_hx0 mi_yayc0. exists yc0 fy0 xc0 fx0; rewrite !get_setE; do !split=> [/#|/#|]. move: yahy0_neq_yahy; case: (ya0 = ya)=> [<<*> //=|/#]; case: (yc0 = yc)=> [<*>> /=|//=]. by move: hs_hy0; rewrite yc_notin_rng1_hs. @@ -567,7 +568,8 @@ move=> Hhuniq c_notin_rng1_hs h1 h2 [c1 f1] [c2 f2]; rewrite !get_setE. case: (h1 = h); case: (h2 = h)=> //= [Hh2 + [#]|+ Hh1 + [#]|_ _] - <*>. + by rewrite c_notin_rng1_hs. + by rewrite c_notin_rng1_hs. -exact/Hhuniq. +move=> H1 H2. +by have/=:=Hhuniq _ _ _ _ H1 H2. qed. lemma hs_addh hs ch xc fx: @@ -1267,8 +1269,9 @@ proof. + by rewrite (@eq_sym ch) Hha /= => _ /Hch. case (v' +^ x = xa /\ h' = ha) => [[!<<-] /= ?? [!->>] /=| ]. + by exists p v';rewrite xorwA xorwK xorwC xorw0. - case (hx = ch)=> [->> _ _ _ /Hch //|??? Hbu Hg]. - by rewrite build_hpath_prefix;exists v' h'. + case (hx = ch)=> [->> |??? Hbu Hg]. + + by rewrite andaE=> -> /= _ _ /Hch //. + by rewrite build_hpath_prefix;exists v' h';smt(). qed. lemma build_hpath_up_None (G1mh:hsmap) bi1 bi2 bi p: @@ -1433,8 +1436,8 @@ case @[ambient]: {-1}(Pmi.[(xa,xc)]) (eq_refl Pmi.[(xa,xc)])=> [Pmi_xaxc|[ya yc] by cut/#:=help (yc,b) a. have /hs_of_INV [] Hhuniq _ _ [] /(getflagP_some _ _ _ Hhuniq):= inv0. + move=> x2_is_U; conseq (_: _ ==> G1.bext{2})=> //. - by auto=> ? ? [#] !<<- _ -> ->> _ /=; rewrite x2_is_U. - move=> ^x2_is_K; rewrite rngE=> -[hx2] hs_hx2. + by auto=> ? ? [#] !<<- _ -> ->>_ /=; rewrite x2_is_U. + move=> x2_is_K; have:=x2_is_K; rewrite rngE=> -[hx2] hs_hx2. rcondf{2} 2; 1:by auto=> &hr [#] <*> /=; rewrite x2_is_K. rcondf{2} 6. + auto=> &hr [#] !<<- _ _ ->> _. @@ -1457,7 +1460,7 @@ case @[ambient]: {-1}(Pmi.[(xa,xc)]) (eq_refl Pmi.[(xa,xc)])=> [Pmi_xaxc|[ya yc] exact(y2_notrngE1_hs). move=> f h; exact/y2_notrngE1_hs. rcondf{1} 1; 1:by auto=> &hr [#] <<*>; rewrite domE Pmi_xaxc. -case @[ambient]: {-1}(Gmi.[(xa,xc)]) (eq_refl Gmi.[(xa,xc)])=> [|[ya' yc'] ^] Gmi_xaxc. +case @[ambient]: {-1}(Gmi.[(xa,xc)]) (eq_refl Gmi.[(xa,xc)])=> [|[ya' yc']] Gmi_xaxc. + rcondt{2} 1; 1:by auto=> &hr [#] <<*>; rewrite domE Gmi_xaxc. conseq (_: _ ==> G1.bext{2})=> //. auto=> &1 &2 [#] !<<- _ -> ->> _ />. @@ -1469,6 +1472,7 @@ case @[ambient]: {-1}(Gmi.[(xa,xc)]) (eq_refl Gmi.[(xa,xc)])=> [|[ya' yc'] ^] Gm case: fx hs_hx=> hs_hx /= => [_|[#]]; first by exists hx. by have /invG_of_INV [] -> := inv0; rewrite Gmi_xaxc. smt (@Block.DBlock @Capacity.DCapacity). +have:=Gmi_xaxc. have /incli_of_INV <- := inv0; 1:by rewrite Gmi_xaxc. rewrite Pmi_xaxc=> /= [#] <<*>. rcondf{2} 1; 1:by auto=> &hr [#] <<*>; rewrite domE Gmi_xaxc. @@ -1639,7 +1643,8 @@ call(: !G1.bcol{2} rewrite domE;cut[]_ -> _ _ _ /=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. case(hinv hs0 y2{2} = None)=>//=h; rewrite get_setE /= oget_some /=;smt(lemma2 hinvP). - move=> [p0 v0] ^ pi_x2. have /pi_of_INV [] -> [hx2] [#] Hpath hs_hx2:= inv0. + move=> [p0 v0] pi_x2; have:=pi_x2. + have /pi_of_INV [] -> [hx2] [#] Hpath hs_hx2:= inv0. rcondt{2} 1. by move=> &m; auto=> &hr [#] !<<- _ _ ->> /= _; rewrite domE pi_x2. rcondf{2} 6. + auto; inline *; auto=> &hr [#] !<<- _ _ !->> _ /= _ _ _ _ /=. @@ -1666,7 +1671,7 @@ call(: !G1.bcol{2} move=> [xc xf yc yf] [#]; rewrite hs_hx2=> [#] <*>. by rewrite PFm_x1x2. auto => &m1 &m2 [#] !<- _ _ -> /= _ y1L -> y2L -> /=. - rewrite !get_set_sameE pi_x2 !oget_some /=. + rewrite !get_set_sameE pi_x2 oget_some /=. have /hs_of_INV [] Hu _ _:= inv0; have -> := huniq_hinvK_h _ _ _ Hu hs_hx2. rewrite oget_some domE => /= ;cut[]_->_ _ _/=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. case(G1.bcol{m2} \/ hinv hs0 y2L <> None)=>//=;rewrite !negb_or/==>[][]? hinv0[]? hinv1. @@ -1703,13 +1708,14 @@ call(: !G1.bcol{2} rewrite Hhx Hhy=> /=;move: HG1. case: fy Hhy=> Hhy //= [p v [Hro Hbu]]. exists p v;split. - + rewrite get_set_neqE // -negP => ^ /rconssI <<- /rconsIs. + + rewrite oget_some /=. + rewrite get_set_neqE // -negP => ^ /rconssI <<- /rconsIs. move: Hbu;rewrite Hpath /= => -[!<<-] /=. by rewrite -negP=> /Block.WRing.addrI /#. by apply build_hpath_up=> //; move: hs_hx2 PFm_x1x2;apply: m_mh_None. + move=> p bn b; rewrite get_setE. case (rcons p bn = rcons p0 (v0 +^ x1)). - + move=> ^ /rconssI <<- /rconsIs ->> /=; split => [<<- | ]. + + rewrite oget_some/= => ^ /rconssI <<- /rconsIs ->> /=; split => [<<- | ]. + exists v0 hx2 ch0. rewrite (build_hpath_up Hpath) /=;1:by move: hs_hx2 PFm_x1x2;apply: m_mh_None. by rewrite xorwA xorwK Block.WRing.add0r get_set_sameE. @@ -1717,7 +1723,8 @@ call(: !G1.bcol{2} move=> Hdiff;have HG1 := m_mh_None _ _ _ _ _ _ _ Hmmh hs_hx2 PFm_x1x2. have -> /= [->> <<-]:= build_hpath_up_None _ _ (y1L, ch0) _ _ HG1 Hpath. by move:Hdiff;rewrite xorwA xorwK Block.WRing.add0r. - move=> Hdiff; case Hmh => ? -> Huni. + rewrite 2!oget_some /==> Hdiff; rewrite Hdiff/=. + case Hmh => ? -> Huni. apply exists_iff=> v /= ;apply exists_iff => hx /=;apply exists_iff => hy /=. rewrite build_hpath_upd_ch_iff //. case (hx = ch0) => [->>|?]. @@ -1793,8 +1800,8 @@ call(: !G1.bcol{2} by rewrite /in_dom_with domE hs_hy2. rcondt{2} 14; first by auto=> &hr [#] !<<- _ _ ->> _ /=; rewrite domE pi_x2. auto=> &1 &2 [#] !<<- -> -> ->> _ /=; rewrite Block.DBlock.dunifin_ll Capacity.DCapacity.dunifin_ll /=. - move=> _ _ _ _; rewrite PFm_x1x2 pi_x2 !oget_some //=. - rewrite (@huniq_hinvK_h hx2 hs0 x2) // ?oget_some. + move=> _ _ _ _; rewrite PFm_x1x2 pi_x2 3!oget_some //=. + rewrite (@huniq_hinvK_h hx2 hs0 x2) // 10?oget_some. + by have /hs_of_INV []:= inv0. rewrite Hro G1mh_x1hx2 hs_hy2 ?oget_some //=domE. cut[]_->_ _ _//=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. @@ -2407,7 +2414,7 @@ proof. cut:=hh3 _ _ _ _ _ H_path h_build_hpath_p0. cut->:bn = sa{2} +^ sa{2} +^ bn;smt(@Block). move=>help;cut h_neq:! (v +^ bn = sa{2} +^ nth witness bs{1} i{2} /\ hx = h{2}) by rewrite/#. - move:help;rewrite h_neq/==>h_g1_v_bn_hx. + move:help. rewrite andaE h_neq/==>h_g1_v_bn_hx. cut[]hh1 hh2 hh3:=H_mh_spec. cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness bs{1} i{2}) y1L p0 v hx. rewrite h_build_hpath_set/=h_g1/=. From f2bf4890b38b3a5cffb7efb80ff3c7256e44c0d2 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Fri, 30 Aug 2019 16:45:06 +0200 Subject: [PATCH 476/525] try to fix a pb --- proof/smart_counter/Handle.eca | 20 ++++++++++++++++---- 1 file changed, 16 insertions(+), 4 deletions(-) diff --git a/proof/smart_counter/Handle.eca b/proof/smart_counter/Handle.eca index dd2241a..612b94c 100644 --- a/proof/smart_counter/Handle.eca +++ b/proof/smart_counter/Handle.eca @@ -594,7 +594,12 @@ lemma hs_updh hs ch fx hx xc fx': => hs_spec hs.[hx <- (xc,fx')] ch. proof. move=> ^Hhs [] Hhuniq hs_0 dom_hs hx_neq0 hs_hx; split. -+ by move=> h1 h2 [c1 f1] [c2 f2]; rewrite !get_setE /= /#. ++ move=> h1 h2 [c1 f1] [c2 f2]; rewrite !get_setE /= => />. + case : (h1 = hx) => />; case : (h2 = hx) => /> U1 U2. + + by have := (Hhuniq _ _ _ _ hs_hx U2 _). + + case (xc = c2) => />. + by have := (Hhuniq _ _ _ _ hs_hx U2 _) => // />. + + move=> H1 H2; by have := (Hhuniq _ _ _ _ H1 H2 _). + by rewrite get_setE hx_neq0. move=> cf h; rewrite get_setE; case: (h = hx)=> [<*> _|_ /dom_hs //]. by move: hs_hx=> /dom_hs. @@ -1882,7 +1887,11 @@ cut[]b1 c1 H_Pm1:exists b1 c1, Pm.[(b +^ nth witness p i, c)] = Some (b1,c1) (oget Pm.[(b +^ nth witness p i, c)]).`2;smt(domE). cut[]H_P_m H_Gmh:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ Hinv. cut:=H_P_m _ _ _ _ H_Pm1. -by cut[]/#:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ Hinv. +cut[] :=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ Hinv. +move=> hun *. +have /> := H_P_m _ _ _ _ H_Pm1. +move=> hx fx hy fy H1 H2 H3; exists b1 c1 hy => />. +case: H_hs_h => fh /(hun _ _ _ _ H1) />. qed. @@ -2427,14 +2436,17 @@ proof. cut->/=:=ch_neq0 _ _ H_hs_spec. cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec H_h. rewrite h_g1/=. - by cut[]:=H_mh_spec; smt(dom_hs_neq_ch). + cut[]:=H_mh_spec => *. +admit. +(*smt(dom_hs_neq_ch).*) cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness bs{1} i{2}) y1L p0 v hx. cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness bs{1} i{2}) y1L p' v' hx. move:H13 H14;rewrite!get_setE/=!oget_some/==>H13 H14;rewrite H13 H14/=. cut->/=:=ch_neq0 _ _ H_hs_spec. cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec H_h. rewrite h_g1/=. - by cut[]:=H_mh_spec;smt(dom_hs_neq_ch). + admit. +(*by cut[]:=H_mh_spec;smt(dom_hs_neq_ch). *) + rewrite!get_setE/=oget_some;exact H2_pi_spec. + rewrite!get_setE/=!oget_some/=. cut H_m_p:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. From f32ac4fd68858737893dc645590150f8878b3069 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9cile=20BARITEL-RUET?= Date: Sat, 31 Aug 2019 13:24:59 +0200 Subject: [PATCH 477/525] patched smart_counter/Handle.eca --- proof/smart_counter/Handle.eca | 47 ++++++++++++++++++++++++++++++---- 1 file changed, 42 insertions(+), 5 deletions(-) diff --git a/proof/smart_counter/Handle.eca b/proof/smart_counter/Handle.eca index 612b94c..652f8c0 100644 --- a/proof/smart_counter/Handle.eca +++ b/proof/smart_counter/Handle.eca @@ -2436,17 +2436,54 @@ proof. cut->/=:=ch_neq0 _ _ H_hs_spec. cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec H_h. rewrite h_g1/=. - cut[]:=H_mh_spec => *. -admit. -(*smt(dom_hs_neq_ch).*) + cut[]:=H_mh_spec => HH1 HH2 HH3 HH4 HH5. + have toto:(forall (xa xb : block) (ha hb : int), + G1.mh{2}.[(xa, ha)] = Some (xb, hb) => + ha <> G1.chandle{2} /\ hb <> G1.chandle{2}). + - move=> /> xa xb ha hb Hmhab. + have:=dom_hs_neq_ch FRO.m{2} G1.chandle{2} ha. + have:=dom_hs_neq_ch FRO.m{2} G1.chandle{2} hb. + have/#:FRO.m{2}.[ha] <> None /\ FRO.m{2}.[hb] <> None. + have[] _ HH6:=H_m_mh. + by have/> g1 g2 g3 g4 -> -> />:=HH6 _ _ _ _ Hmhab. + have{HH4}:=HH4 toto. + have{HH5}:=HH5 toto. + case: (hx = G1.chandle{2})=>[->>|hx_neq_ch/>]. + - move=>[] p1 x1 [#] hp11 ->> <<-. + move=>[] p2 x2 [#] hp21 ->> ->> /=. + pose y := (sa{2} +^ nth witness bs{1} i{2}). + pose y1:=x1+^y. pose y2:=x2+^y. + have[#]->>->>:=HH3 _ _ _ _ _ hp21 H_path. + by have[#]->><<-//=:=HH3 _ _ _ _ _ hp11 H_path. + move=>hp21 hp11. + by have[#]->>->>:=HH3 _ _ _ _ _ hp21 hp11. cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness bs{1} i{2}) y1L p0 v hx. cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness bs{1} i{2}) y1L p' v' hx. move:H13 H14;rewrite!get_setE/=!oget_some/==>H13 H14;rewrite H13 H14/=. cut->/=:=ch_neq0 _ _ H_hs_spec. cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec H_h. rewrite h_g1/=. - admit. -(*by cut[]:=H_mh_spec;smt(dom_hs_neq_ch). *) + cut[]:=H_mh_spec => HH1 HH2 HH3 HH4 HH5. + have toto:(forall (xa xb : block) (ha hb : int), + G1.mh{2}.[(xa, ha)] = Some (xb, hb) => + ha <> G1.chandle{2} /\ hb <> G1.chandle{2}). + - move=> /> xa xb ha hb Hmhab. + have:=dom_hs_neq_ch FRO.m{2} G1.chandle{2} ha. + have:=dom_hs_neq_ch FRO.m{2} G1.chandle{2} hb. + have/#:FRO.m{2}.[ha] <> None /\ FRO.m{2}.[hb] <> None. + have[] _ HH6:=H_m_mh. + by have/> g1 g2 g3 g4 -> -> />:=HH6 _ _ _ _ Hmhab. + have{HH4}:=HH4 toto. + have{HH5}:=HH5 toto. + case: (hx = G1.chandle{2})=>[->>|hx_neq_ch/>]. + - move=>[] p1 x1 [#] hp11 ->> <<-. + move=>[] p2 x2 [#] hp21 ->> ->> /=. + pose y := (sa{2} +^ nth witness bs{1} i{2}). + pose y1:=x1+^y. pose y2:=x2+^y. + have[#]->>->>:=HH3 _ _ _ _ _ hp21 H_path. + by have[#]->><<-//=:=HH3 _ _ _ _ _ hp11 H_path. + move=>hp21 hp11. + by have[#]->>->>:=HH3 _ _ _ _ _ hp21 hp11. + rewrite!get_setE/=oget_some;exact H2_pi_spec. + rewrite!get_setE/=!oget_some/=. cut H_m_p:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. From 917a46cdc8580e34468f8db02745b6181d762390 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Mon, 2 Sep 2019 11:09:27 +0200 Subject: [PATCH 478/525] fix handle --- proof/smart_counter/Handle.eca | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/proof/smart_counter/Handle.eca b/proof/smart_counter/Handle.eca index 652f8c0..5ed6614 100644 --- a/proof/smart_counter/Handle.eca +++ b/proof/smart_counter/Handle.eca @@ -496,8 +496,7 @@ split=> [xa0 xc0 ya0 yc0|xa0 hx0 ya0 hy0]; rewrite get_setE. move=> xaxc0_neq_xaxc /Hm_mh [hx0 fx0 hy0 fy0] [#] hs_hx0 hs_hy0 mh_xahx0. by exists hx0 fx0 hy0 fy0; rewrite !get_setE /#. case: ((xa0,hx0) = (xa,hx))=> [[#] <*>> [#] <<*>|] /=. -+ by exists xc f yc f'; rewrite !get_setE /= /#. search (&&) (/\). -rewrite andaE. ++ by exists xc f yc f'; rewrite !get_setE /= /#. move=>/= /negb_and xahx0_neq_xahx /Hmh_m [xc0 fx0 yc0 fy0] [#] hs_hx0 hs_hy0 Pm_xaxc0. exists xc0 fx0 yc0 fy0; rewrite !get_setE; do !split=> [/#|/#|/=]. move: xahx0_neq_xahx; case: (xa0 = xa)=> [/= <*>>|//=]; case: (xc0 = xc)=> [<*>>|//=]. @@ -1275,7 +1274,7 @@ proof. case (v' +^ x = xa /\ h' = ha) => [[!<<-] /= ?? [!->>] /=| ]. + by exists p v';rewrite xorwA xorwK xorwC xorw0. case (hx = ch)=> [->> |??? Hbu Hg]. - + by rewrite andaE=> -> /= _ _ /Hch //. + + by move=> ??? /= /Hch. by rewrite build_hpath_prefix;exists v' h';smt(). qed. @@ -1805,7 +1804,7 @@ call(: !G1.bcol{2} by rewrite /in_dom_with domE hs_hy2. rcondt{2} 14; first by auto=> &hr [#] !<<- _ _ ->> _ /=; rewrite domE pi_x2. auto=> &1 &2 [#] !<<- -> -> ->> _ /=; rewrite Block.DBlock.dunifin_ll Capacity.DCapacity.dunifin_ll /=. - move=> _ _ _ _; rewrite PFm_x1x2 pi_x2 3!oget_some //=. + move=> _ _ _ _; rewrite PFm_x1x2 pi_x2 !oget_some //=. rewrite (@huniq_hinvK_h hx2 hs0 x2) // 10?oget_some. + by have /hs_of_INV []:= inv0. rewrite Hro G1mh_x1hx2 hs_hy2 ?oget_some //=domE. @@ -2423,7 +2422,7 @@ proof. cut:=hh3 _ _ _ _ _ H_path h_build_hpath_p0. cut->:bn = sa{2} +^ sa{2} +^ bn;smt(@Block). move=>help;cut h_neq:! (v +^ bn = sa{2} +^ nth witness bs{1} i{2} /\ hx = h{2}) by rewrite/#. - move:help. rewrite andaE h_neq/==>h_g1_v_bn_hx. + move:help. rewrite h_neq/==>h_g1_v_bn_hx. cut[]hh1 hh2 hh3:=H_mh_spec. cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness bs{1} i{2}) y1L p0 v hx. rewrite h_build_hpath_set/=h_g1/=. From 7a772832ff0dbb235fd7cf5581f42405b4e58f64 Mon Sep 17 00:00:00 2001 From: Pierre-Yves Strub Date: Fri, 13 Sep 2019 00:43:00 +0200 Subject: [PATCH 479/525] --- proof/smart_counter/SLCommon.ec | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/proof/smart_counter/SLCommon.ec b/proof/smart_counter/SLCommon.ec index d392b04..873e62d 100644 --- a/proof/smart_counter/SLCommon.ec +++ b/proof/smart_counter/SLCommon.ec @@ -3,7 +3,7 @@ length is the input block size. We prove its security even when padding is not prefix-free. **) require import Core Int Real StdOrder Ring IntExtra. -require import List FSet SmtMap Common PROM DProd Dexcepted. +require import List FSet SmtMap Common PROM Distr DProd Dexcepted. require (*..*) Indifferentiability. (*...*) import Capacity IntOrder. From efea0007fb1c3cb25fe0f6db8b5765a2ae7ff0d6 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Fri, 13 Sep 2019 16:09:50 +0200 Subject: [PATCH 480/525] fix sha3 with change in EC --- proof/SecureORO.eca | 16 +++++++--------- proof/SecureRO.eca | 8 +++----- proof/impl/perm/keccak_f1600_avx2_prevec.ec | 3 ++- proof/smart_counter/ConcreteF.eca | 14 ++++++-------- proof/smart_counter/Gconcl_list.ec | 8 +++++--- proof/smart_counter/SLCommon.ec | 4 +--- 6 files changed, 24 insertions(+), 29 deletions(-) diff --git a/proof/SecureORO.eca b/proof/SecureORO.eca index 99c90e8..17d5782 100644 --- a/proof/SecureORO.eca +++ b/proof/SecureORO.eca @@ -167,7 +167,6 @@ section Preimage. if; sp; wp; last by hoare;auto;progress; smt(mu_bounded). case: (x \in RO.m). - hoare; auto; progress. - + smt(mu_bounded). rewrite H3/=; move: H1; rewrite rngE /= negb_exists /=. by have:=H3; rewrite domE; smt(). rnd (pred1 Preimage2.hash); auto=> /> &hr 6?. @@ -317,16 +316,15 @@ section SecondPreimage. + by auto. + inline*; sp; auto. if; sp; last first. - + sp; hoare; auto; 1: smt(mu_bounded); if; auto. + + sp; hoare; auto; if; auto. case(Bounder.bounder < bound); last first. - - by rcondf 8; 1: auto; hoare; auto; smt(mu_bounded). + - by rcondf 8; 1: auto; hoare; auto. rcondt 8; 1: auto. swap 11 -8; sp. swap [7..11] -6; sp. swap[5..6] 2; wp 6=> /=. case: (SecondPreimage2.m2 \in RO.m). - rcondf 5; 1: auto; hoare; auto=> /> &h d _ _ in_dom1 not_rng _ in_dom2. - + smt(mu_bounded). move=> sample2 _ sample1 _; rewrite negb_and/=. move: not_rng; rewrite rngE /= negb_exists /= => /(_ SecondPreimage2.m2{h}). rewrite remE; case: (SecondPreimage2.m2{h} = m1{h})=> //=. @@ -400,18 +398,18 @@ section Collision. + auto. + inline*; sp. if; sp; last first. - - by wp; conseq(:_==> false)=> />; hoare; 1: smt(mu_bounded); auto. + - by wp; conseq(:_==> false)=> />; hoare; auto. case: (Bounder.bounder < bound); last first. - - rcondf 8; 1:auto; hoare; auto; smt(mu_bounded). + - rcondf 8; 1:auto; hoare; auto. rcondt 8; 1: auto. swap 11 -8. swap [7..11] -6; sp. swap [5..6] 1; wp 5=> /=. swap 3 -1. case: (m1 = m2). - - by hoare; 1: smt(mu_bounded); auto. + - by hoare; auto. case: (m1 \in RO.m); case: (m2 \in RO.m). - - rcondf 3; 1: auto; rcondf 4; 1: auto; hoare; auto; 1: smt(bound_ge0 mu_bounded). + - rcondf 3; 1: auto; rcondf 4; 1: auto; hoare; auto. move=> /> &h d _ _ Hcoll _ _ neq12 in_dom1 in_dom2 _ _ _ _. move: Hcoll; rewrite /collision negb_exists /= => /(_ m1{h}). rewrite negb_exists /= => /(_ m2{h}). @@ -474,7 +472,7 @@ section Collision. by rewrite neq in_dom1 in_dom2 /= => ->. rnd; skip=> /> &h bounder _ h _. rewrite (mu_mem (frng RO.m{h}) sampleto (mu1 sampleto witness)); 1: smt(sampleto_fu). - rewrite StdOrder.RealOrder.ler_wpmul2r //; 1: smt(mu_bounded). + rewrite StdOrder.RealOrder.ler_wpmul2r //. by rewrite RealExtra.le_fromint; smt(le_card_frng_fdom). + move=> c; proc; inline*; auto; sp; if; last by auto; smt(). auto=> /> &h h1 h2 _ sample _. diff --git a/proof/SecureRO.eca b/proof/SecureRO.eca index 283a6b8..cc38600 100644 --- a/proof/SecureRO.eca +++ b/proof/SecureRO.eca @@ -172,7 +172,6 @@ section Preimage. if; sp; wp; last by hoare;auto;progress; smt(mu_bounded). case: (x \in RO.m). - hoare; auto; progress. - + smt(mu_bounded). rewrite H3/=; move: H1; rewrite rngE /= negb_exists /=. by have:=H3; rewrite domE; smt(). rnd (pred1 h); auto=> //= &hr [#]->>??<<-????. @@ -348,7 +347,6 @@ section SecondPreimage. swap 3 -2; sp. case: (SecondPreimage2.m2 \in RO.m). - rcondf 5; 1: auto; hoare; auto=> /> &h d _ _ in_dom1 not_rng _ in_dom2. - + smt(mu_bounded). move=> sample2 _ sample1 _; rewrite negb_and/=. move: not_rng; rewrite rngE /= negb_exists /= => /(_ SecondPreimage2.m2{h}). rewrite remE; case: (SecondPreimage2.m2{h} = m1{h})=> //=. @@ -443,9 +441,9 @@ section Collision. rcondt 4; 1: auto. swap 4 -3. case: (m1 = m2). - - by hoare; 1: smt(mu_bounded); auto. + - by hoare; auto. case: (m1 \in RO.m); case: (m2 \in RO.m). - - rcondf 3; 1: auto; rcondf 6; 1: auto; hoare; auto; 1: smt(bound_gt0 mu_bounded). + - rcondf 3; 1: auto; rcondf 6; 1: auto; hoare; auto. move=> /> &h d _ _ Hcoll _ _ neq12 in_dom1 in_dom2 _ _ _ _. move: Hcoll; rewrite /collision negb_exists /= => /(_ m1{h}). rewrite negb_exists /= => /(_ m2{h}). @@ -508,7 +506,7 @@ section Collision. by rewrite neq in_dom1 in_dom2 /= => ->. rnd; skip=> /> &h bounder _ h _. rewrite (mu_mem (frng RO.m{h}) sampleto (mu1 sampleto witness)); 1: smt(sampleto_fu). - rewrite StdOrder.RealOrder.ler_wpmul2r //; 1: smt(mu_bounded). + rewrite StdOrder.RealOrder.ler_wpmul2r //. by rewrite RealExtra.le_fromint; smt(le_card_frng_fdom). + move=> c; proc; sp; if; auto; inline*; auto; sp; if; last by auto; smt(). auto=> /> &h d h1 _ h2 _ sample _. diff --git a/proof/impl/perm/keccak_f1600_avx2_prevec.ec b/proof/impl/perm/keccak_f1600_avx2_prevec.ec index e7bf54b..8f9a8ce 100644 --- a/proof/impl/perm/keccak_f1600_avx2_prevec.ec +++ b/proof/impl/perm/keccak_f1600_avx2_prevec.ec @@ -433,7 +433,8 @@ lemma dec : forall (x : W32.t), to_uint (x86_DEC_32 x).`5 = to_uint x - 1 by smt(@W32). lemma decK : forall (x : W32.t), - (x86_DEC_32 x).`5 + W32.one = x by smt(@W32). + (x86_DEC_32 x).`5 + W32.one = x. +proof. rewrite /x86_DEC_32 /= /rflags_of_aluop_nocf32 /= => *; ring. qed. lemma dec0 : forall (x : W32.t), 0 < to_uint x <= 24 => diff --git a/proof/smart_counter/ConcreteF.eca b/proof/smart_counter/ConcreteF.eca index a116ae8..f20a1f8 100644 --- a/proof/smart_counter/ConcreteF.eca +++ b/proof/smart_counter/ConcreteF.eca @@ -166,7 +166,7 @@ section. by rewrite -mem_fdom memE; apply/prefix_lt_size=> /#. + exact/prefix_ge0. + exact/prefix_sizel. - + case: H9=> //= - [j] [#] H42 H72. print take_take. + + case: H9=> //= - [j] [#] H42 H72. have ->: j = min j (prefix bs{2} (get_max_prefix bs{2} (elems (fdom C.queries{2})))) by smt(). rewrite -(take_take bs{2} j (prefix bs{2} (get_max_prefix bs{2} (elems (fdom C.queries{2}))))). by move=> ->; rewrite H domE //= H8. @@ -214,9 +214,7 @@ section. local clone import ProdSampling with type t1 <- block, - op d1 <- bdistr, - type t2 <- capacity, - op d2 <- cdistr. + type t2 <- capacity. lemma Real_Concrete &m : Pr[GReal(D).main()@ &m: res /\ C.c <= max_size] <= @@ -400,21 +398,21 @@ section. + rewrite -(DoubleBounding ARP &m). byequiv=> //=; proc; inline *; sim (_: ={m,mi}(PF,ARP)). * proc; if=> //=; auto; conseq (_: true ==> (y1,y2){1} = x{2})=> //=. - transitivity{1} { (y1,y2) <@ S.sample2(); } + transitivity{1} { (y1,y2) <@ S.sample2(bdistr,cdistr); } (true ==> ={y1,y2}) (true ==> (y1,y2){1} = x{2})=> //=. - by inline *; auto. - transitivity{2} { x <@ S.sample(); } + transitivity{2} { x <@ S.sample(bdistr,cdistr); } (true ==> (y1,y2){1} = x{2}) (true ==> ={x})=> //=. - by symmetry; call sample_sample2; skip=> /> []. by inline *; auto. proc; if=> //=; auto; conseq (_: true ==> (y1,y2){1} = y{2})=> //=. - transitivity{1} { (y1,y2) <@ S.sample2(); } + transitivity{1} { (y1,y2) <@ S.sample2(bdistr,cdistr); } (true ==> ={y1,y2}) (true ==> (y1,y2){1} = y{2})=> //=. - by inline *; auto. - transitivity{2} { y <@ S.sample(); } + transitivity{2} { y <@ S.sample(bdistr,cdistr); } (true ==> (y1,y2){1} = y{2}) (true ==> ={y})=> //=. - by symmetry; call sample_sample2; skip=> /> []. diff --git a/proof/smart_counter/Gconcl_list.ec b/proof/smart_counter/Gconcl_list.ec index 1216a6d..810d196 100644 --- a/proof/smart_counter/Gconcl_list.ec +++ b/proof/smart_counter/Gconcl_list.ec @@ -1,7 +1,7 @@ pragma -oldip. require import Core Int Real RealExtra StdOrder Ring StdBigop IntExtra. require import List FSet SmtMap Common SLCommon PROM FelTactic Mu_mem. -require import DProd Dexcepted BlockSponge Gconcl. +require import Distr DProd Dexcepted BlockSponge Gconcl. (*...*) import Capacity IntOrder Bigreal RealOrder BRA. require (*--*) Handle. @@ -224,7 +224,9 @@ section Ideal. /\ SLCommon.C.queries{1} <= F.RO.m{2});progress. sp;rcondt{1}1;2:rcondt{2}1;1,2:auto;sp. case((x0 \in F.RO.m){2});last first. - * rcondt{2}2;1:auto;rcondt{1}1;1:(auto;smt(leq_nin_dom size_cat size_eq0 size_nseq valid_spec)). + * rcondt{2}2;1:auto;rcondt{1}1. + + auto => /> &hr iR 9?; apply leq_nin_dom => //. + smt (leq_nin_dom size_cat size_eq0 size_nseq valid_spec). rcondt{1}1;1:auto. - move=> /> &hr i [#] h1 h2 h3 h4 h5 h6 h7 h8 h9 h10. have//= /#:= prefix_le1 bl{m} SLCommon.C.queries{hr} i h1 _. @@ -1769,7 +1771,7 @@ section Real_Ideal. rewrite-(equiv_ideal D &m). cut:=Real_Ideal (A(D)) A_lossless &m. pose x:=witness;elim:x=>a b. - by rewrite/dstate DProd.dprod1E DBlock.dunifin1E DCapacity.dunifin1E/= + rewrite/dstate dprod1E DBlock.dunifin1E DCapacity.dunifin1E/= block_card capacity_card;smt(). qed. diff --git a/proof/smart_counter/SLCommon.ec b/proof/smart_counter/SLCommon.ec index 873e62d..89d7dee 100644 --- a/proof/smart_counter/SLCommon.ec +++ b/proof/smart_counter/SLCommon.ec @@ -79,9 +79,7 @@ module SqueezelessSponge (P:DPRIMITIVE): FUNCTIONALITY = { clone export DProd.ProdSampling as Sample2 with type t1 <- block, - type t2 <- capacity, - op d1 <- bdistr, - op d2 <- cdistr. + type t2 <- capacity. (* -------------------------------------------------------------------------- *) (** TODO move this **) From b0a3ff6fda2934a186f743435c8f13223399b2be Mon Sep 17 00:00:00 2001 From: Pierre-Yves Strub Date: Sun, 15 Sep 2019 22:29:50 +0200 Subject: [PATCH 481/525] CI --- .gitlab-ci.yml | 2 +- config/tests.config | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 33341bf..ba75829 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -4,7 +4,7 @@ variables: DOCKER_DRIVER: overlay DOCKER_TLS_CERTDIR: "" ECARGS: "-I Jasmin:/home/ci/jasmin/eclib" - ECJOBS: 1 + ECJOBS: 2 services: - docker:dind diff --git a/config/tests.config b/config/tests.config index 5e7de4f..bac5b80 100644 --- a/config/tests.config +++ b/config/tests.config @@ -1,6 +1,6 @@ [default] bin = easycrypt -args = -timeout 30 -p Z3 -p Alt-Ergo -I proof -I proof/smart_counter -I proof/impl -I proof/impl/perm +args = -timeout 30 -max-provers 2 -p Z3 -p Alt-Ergo -I proof -I proof/smart_counter -I proof/impl -I proof/impl/perm [test-sha3] okdirs = !proof From d2b8537d6b77aebd91f68ce726f41b9fbb09fb14 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Mon, 16 Sep 2019 08:21:03 +0200 Subject: [PATCH 482/525] fix sha3 with the modification of PROM --- proof/SHA3OSecurity.ec | 4 +++- proof/SecureORO.eca | 4 +++- proof/SecureRO.eca | 4 +++- proof/Sponge.ec | 5 ++++- proof/smart_counter/Gconcl_list.ec | 4 +++- proof/smart_counter/Handle.eca | 4 +++- proof/smart_counter/SLCommon.ec | 5 ++++- 7 files changed, 23 insertions(+), 7 deletions(-) diff --git a/proof/SHA3OSecurity.ec b/proof/SHA3OSecurity.ec index c2437eb..1b70e92 100644 --- a/proof/SHA3OSecurity.ec +++ b/proof/SHA3OSecurity.ec @@ -182,7 +182,9 @@ proof *. clone import GenEager as Eager with type from <- bool list * int, type to <- bool, - op sampleto <- fun _ => dbool + op sampleto <- fun _ => dbool, + type input <- unit, + type output <- bool proof * by smt(dbool_ll). section Preimage. diff --git a/proof/SecureORO.eca b/proof/SecureORO.eca index 17d5782..949a009 100644 --- a/proof/SecureORO.eca +++ b/proof/SecureORO.eca @@ -16,7 +16,9 @@ axiom sampleto_fu: is_funiform sampleto. clone import PROM.GenEager as RO with type from <- from, type to <- to, - op sampleto <- fun _ => sampleto + op sampleto <- fun _ => sampleto, + type input <- unit, + type output <- bool proof * by exact/sampleto_ll. op increase_counter (c : int) (m : from) : int. diff --git a/proof/SecureRO.eca b/proof/SecureRO.eca index cc38600..3e0fed3 100644 --- a/proof/SecureRO.eca +++ b/proof/SecureRO.eca @@ -16,7 +16,9 @@ axiom sampleto_fu: is_funiform sampleto. clone import PROM.GenEager as RO with type from <- from, type to <- to, - op sampleto <- fun _ => sampleto + op sampleto <- fun _ => sampleto, + type input <- unit, + type output <- bool proof * by exact/sampleto_ll. op increase_counter (c : int) (m : from) : int. diff --git a/proof/Sponge.ec b/proof/Sponge.ec index d9b1644..350701c 100644 --- a/proof/Sponge.ec +++ b/proof/Sponge.ec @@ -369,7 +369,10 @@ declare module D : HYBRID_IRO_DIST{HybridIROEager, HybridIROLazy}. local clone PROM.GenEager as ERO with type from <- block list * int, type to <- bool, - op sampleto <- fun _ => dbool. + op sampleto <- fun _ => dbool, + type input <- unit, + type output <- bool + proof sampleto_ll by apply dbool_ll. local module EROExper(O : ERO.RO, D : ERO.RO_Distinguisher) = { proc main() : bool = { diff --git a/proof/smart_counter/Gconcl_list.ec b/proof/smart_counter/Gconcl_list.ec index 810d196..6496123 100644 --- a/proof/smart_counter/Gconcl_list.ec +++ b/proof/smart_counter/Gconcl_list.ec @@ -1992,7 +1992,9 @@ axiom D_lossless (F0 <: DFUNCTIONALITY{D}) (P0 <: DPRIMITIVE{D}) : local clone import PROM.GenEager as IRO2 with type from <- block list * int, type to <- block, - op sampleto <- fun _, bdistr + op sampleto <- fun _, bdistr, + type input <- unit, + type output <- bool proof * by exact/DBlock.dunifin_ll. local module Simu (FRO : IRO2.RO) (F : DFUNCTIONALITY) = { diff --git a/proof/smart_counter/Handle.eca b/proof/smart_counter/Handle.eca index 5ed6614..87da3c0 100644 --- a/proof/smart_counter/Handle.eca +++ b/proof/smart_counter/Handle.eca @@ -9,7 +9,9 @@ require (*--*) ConcreteF PROM. clone export PROM.GenEager as ROhandle with type from <- handle, type to <- capacity, - op sampleto <- fun (_:int) => cdistr + op sampleto <- fun (_:int) => cdistr, + type input <- unit, + type output <- bool proof sampleto_ll by apply DCapacity.dunifin_ll. clone export ConcreteF as ConcreteF1. diff --git a/proof/smart_counter/SLCommon.ec b/proof/smart_counter/SLCommon.ec index 89d7dee..5480815 100644 --- a/proof/smart_counter/SLCommon.ec +++ b/proof/smart_counter/SLCommon.ec @@ -38,10 +38,13 @@ op bl_univ = FSet.oflist bl_enum. (* -------------------------------------------------------------------------- *) (* Random oracle from block list to block *) + clone import PROM.GenEager as F with type from <- block list, type to <- block, - op sampleto <- fun (_:block list)=> bdistr + op sampleto <- fun (_:block list)=> bdistr, + type input <- unit, + type output <- bool proof * by exact Block.DBlock.dunifin_ll. module Redo = { From 27d61c77c0cefd3e19a759b72dd7df0b8e1ab8d4 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Tue, 17 Sep 2019 08:19:13 +0200 Subject: [PATCH 483/525] try to reduce verification time --- proof/impl/libc/keccak_1600_avx2_modular.ec | 60 +- proof/impl/libc/keccak_1600_scalar_modular.ec | 3 +- proof/impl/perm/Ops.ec | 382 ++++---- proof/impl/perm/keccak_f1600_avx2_prevec.ec | 855 ++++-------------- 4 files changed, 389 insertions(+), 911 deletions(-) diff --git a/proof/impl/libc/keccak_1600_avx2_modular.ec b/proof/impl/libc/keccak_1600_avx2_modular.ec index c1cfa24..ba4ce2d 100644 --- a/proof/impl/libc/keccak_1600_avx2_modular.ec +++ b/proof/impl/libc/keccak_1600_avx2_modular.ec @@ -286,49 +286,13 @@ require import Keccak_1600_avx2. equiv modfgood : Mmod.__keccak_f1600_avx2 ~ M.__keccak_f1600_avx2: - ={Glob.mem,arg} ==> ={Glob.mem,res}. -proc. - seq 112 112 : (#pre /\ ={zf,iotas,rhotates_left,rhotates_right,t,r}). - seq 30 30 : (#pre /\ ={d14,t,iotas,rhotates_left,rhotates_right,r}). - by wp;skip; rewrite /flat_state; auto => />. - seq 30 30 : #pre. - by wp;skip; rewrite /flat_state; auto => />. - seq 30 30 : #pre. - by wp;skip; rewrite /flat_state; auto => />. - by wp;skip; rewrite /flat_state; auto => />. - while (#pre). - seq 30 30 : (#pre /\ ={d14}). - by wp;skip; rewrite /flat_state; auto => />. - seq 30 30 : #pre. - by wp;skip; rewrite /flat_state; auto => />. - seq 30 30 : #pre. - by wp;skip; rewrite /flat_state; auto => />. - by wp;skip; rewrite /flat_state; auto => />. - by auto => />. -qed. + ={Glob.mem,arg} ==> ={Glob.mem,res}. +proof. by sim. qed. equiv modgood : Mmod.__keccak_1600 ~ M.__keccak_1600 : ={Glob.mem,arg} ==> ={Glob.mem,res}. -proc. -call(_: ={Glob.mem}). -call(_: ={Glob.mem}); first by sim. -call(modfgood). -while(#post /\ ={rate,a_jagged,out,outlen}). -wp. -call(_: ={Glob.mem}); first by sim. -call(modfgood). -by auto => />. -by auto => />. -call(_: ={Glob.mem}). -call(_: ={Glob.mem}); first by sim. -while(#post /\ ={rate,a_jagged,in_0,inlen,rhotates_left,rhotates_right,iotas}). -call(modfgood). -call(_: ={Glob.mem}); first by sim. -by auto => />. -by inline *;auto => />; sim. -by inline *;auto => />; sim. -qed. +proof. by sim. qed. require Keccak_1600_ref_modular. @@ -400,22 +364,6 @@ op good_jag (mem : global_mem_t, _jag : int) = forall off, 0 <= off < 25 => loadW64 mem (_jag + (8 * off)) = W64.of_int A_jagged.[off]. - -(*op jagged_load_W64 (mem : global_mem_t, _jag : int, sts : W64.t Array28.t, rate8 : int) = - forall off, - sts.[A_jagged.[off]] = if 0 <= off < rate8 %/ 8 - then loadW64 mem (_jag + (off * 8)) - else W64.zero. *) - -(*op jagged_load (mem : global_mem_t, _jag : int, sts : W64.t Array28.t, inl8 : int) = - if inl8 %% 8 = 0 then jagged_load_W64 mem _jag sts inl8 - else forall off, - sts.[A_jagged.[off]] = if 0 <= off < inl8 %/ 8 - then loadW64 mem (_jag + (off * 8)) - else if off = inl8 %/ 8 - then W64.zero (* FIX ME: just read the remaining bytes *) - else W64.zero. *) - lemma jagged_bound k : 0 <= k < 25 => 0 <= A_jagged.[k] < 28. proof. by move: k; apply (Array25.allP A_jagged (fun i => 0 <= i < 28)); cbv delta. @@ -527,7 +475,7 @@ proof. have -> /= : state0.[0] `^` s_state2.[0] = state1.[0]. + rewrite H4 //; case: (!P 0) => h /=. + by rewrite /A_jagged. - by have := H2 0; rewrite /A_jagged /= => ->. + by have := H2 0; rewrite /A_jagged /= => ->. split. + do !congr; rewrite H4 //. + case: (!P 1) => h; first by rewrite /A_jagged. diff --git a/proof/impl/libc/keccak_1600_scalar_modular.ec b/proof/impl/libc/keccak_1600_scalar_modular.ec index 1043dbe..02447c7 100644 --- a/proof/impl/libc/keccak_1600_scalar_modular.ec +++ b/proof/impl/libc/keccak_1600_scalar_modular.ec @@ -312,7 +312,8 @@ proc => /=. seq 2 2 : (#pre /\ ={state}). call(_:true); last by auto. + while (#post /\ to_uint i{2} = i{1} /\ i{2} \ule W64.of_int 25 /\ t{2} = W64.zero). - + by auto => /> &2; rewrite ultE; smt(@W64). + + auto => /> &2; rewrite !ultE !uleE/= => *. + rewrite W64.to_uintD_small /= 1,2:/#. by auto => />; rewrite set0_64E => />. seq 4 1 : #{/~in_0{1} = in_0{2}}{~inlen{1} = inlen{2}}pre. + inline Mmod.absorb. diff --git a/proof/impl/perm/Ops.ec b/proof/impl/perm/Ops.ec index 7cd4a0e..07a8aad 100644 --- a/proof/impl/perm/Ops.ec +++ b/proof/impl/perm/Ops.ec @@ -1,4 +1,4 @@ -require import List Int IntDiv CoreMap. +require import List Int IntExtra IntDiv CoreMap. from Jasmin require import JModel. require import Array2 Array4 Array5. @@ -7,6 +7,19 @@ require import WArray128 WArray160. type t2u64 = W64.t Array2.t. type t4u64 = W64.t Array4.t. +hint simplify W8.of_intwE @0. + +lemma pack2_bits32 (w: W64.t): + pack2 [w \bits32 0; w \bits32 1] = w. +proof. by apply W2u32.allP. qed. + +lemma pack2_bits32_red (w1 w2: W64.t): + w1 = w2 => + pack2 [w1 \bits32 0; w2 \bits32 1] = w1. +proof. by move=> ->; apply pack2_bits32. qed. + +hint simplify pack2_bits32_red @0. + module Ops = { proc itruncate_4u64_2u64(t : t4u64) : t2u64 = { return Array2.of_list witness [ t.[0]; t.[1] ]; @@ -60,108 +73,70 @@ module Ops = { proc iVPERM2I128(x y:t4u64, p : W8.t) : t4u64 = { var r : t4u64; r <- witness; - if (to_uint p = 32) { (* 0x20 *) - r.[0] <- x.[0]; - r.[1] <- x.[1]; - r.[2] <- y.[0]; - r.[3] <- y.[1]; - } - else { - if (to_uint p = 49) { (* 0x31 *) - r.[0] <- x.[2]; - r.[1] <- x.[3]; - r.[2] <- y.[2]; - r.[3] <- y.[3]; - } - } + r.[0] <- + let n = 0 in + if p.[n + 3] then W64.of_int 0 + else + let w = if p.[n+1] then y else x in + if p.[n] then w.[2] else w.[0]; + r.[1] <- + let n = 0 in + if p.[n + 3] then W64.of_int 0 + else + let w = if p.[n+1] then y else x in + if p.[n] then w.[3] else w.[1]; + r.[2] <- + let n = 4 in + if p.[n + 3] then W64.of_int 0 + else + let w = if p.[n+1] then y else x in + if p.[n] then w.[2] else w.[0]; + r.[3] <- + let n = 4 in + if p.[n + 3] then W64.of_int 0 + else + let w = if p.[n+1] then y else x in + if p.[n] then w.[3] else w.[1]; + return r; } proc iVPERMQ(x :t4u64, p : W8.t) : t4u64 = { var r : t4u64; r <- witness; - if (to_uint p = 128) { (* 10 00 00 00 *) - r.[0] <- x.[0]; - r.[1] <- x.[0]; - r.[2] <- x.[0]; - r.[3] <- x.[2]; - } else { - if (to_uint p = 147) { (* 10 01 00 11 *) - r.[0] <- x.[3]; - r.[1] <- x.[0]; - r.[2] <- x.[1]; - r.[3] <- x.[2]; - } else { - if (to_uint p = 78) { (* 01 00 11 10 *) - r.[0] <- x.[2]; - r.[1] <- x.[3]; - r.[2] <- x.[0]; - r.[3] <- x.[1]; - } else { - if (to_uint p = 57) { (* 00 11 10 01 *) - r.[0] <- x.[1]; - r.[1] <- x.[2]; - r.[2] <- x.[3]; - r.[3] <- x.[0]; - } else { - if (to_uint p = 141) { (* 10 00 11 01 *) - r.[0] <- x.[1]; - r.[1] <- x.[3]; - r.[2] <- x.[0]; - r.[3] <- x.[2]; - } else { - if (to_uint p = 27) { (* 00 01 10 11 *) - r.[0] <- x.[3]; - r.[1] <- x.[2]; - r.[2] <- x.[1]; - r.[3] <- x.[0]; - } else { - if (to_uint p = 114) { (* 01 11 00 10 *) - r.[0] <- x.[2]; - r.[1] <- x.[0]; - r.[2] <- x.[3]; - r.[3] <- x.[1]; - } else { - if (to_uint p = 0) { (* 00 00 00 00 *) - r.[0] <- x.[0]; - r.[1] <- x.[0]; - r.[2] <- x.[0]; - r.[3] <- x.[0]; - } else { - if (to_uint p = 30) { (* 00 01 11 10 *) - r.[0] <- x.[2]; - r.[1] <- x.[3]; - r.[2] <- x.[1]; - r.[3] <- x.[0]; - } - } - } - } - } - } - } - } - } + r.[0] <- x.[ (to_uint p ) %% 4 ]; + r.[1] <- x.[ (to_uint p %/ 4) %% 4 ]; + r.[2] <- x.[ (to_uint p %/ 16) %% 4 ]; + r.[3] <- x.[ (to_uint p %/ 64) %% 4 ]; return r; } proc iVPSRLDQ_256(x:t4u64, p : W8.t) : t4u64 = { var r : t4u64; r <- witness; - if (to_uint p = 6) { - r.[0] <- (x.[0] `>>` W8.of_int 48) `|` (x.[1] `<<` W8.of_int 16); - r.[1] <- x.[1] `>>` W8.of_int 48; - r.[2] <- (x.[2] `>>` W8.of_int 48) `|` (x.[3] `<<` W8.of_int 16); - r.[3] <- x.[3] `>>` W8.of_int 48; - } - else { - if (to_uint p = 8) { - r.[0] <- x.[1]; - r.[1] <- W64.zero; - r.[2] <- x.[3]; - r.[3] <- W64.zero; - } - } + + r.[0] <- + if to_uint p = 8 then x.[1] + else let i = min (to_uint p) 16 in + if i < 8 then (x.[0] `>>>` 8 * i) `|` (x.[1] `<<<` (64 - 8 * i)) + else x.[1] `>>>` 8 * (i - 8); + + r.[1] <- + let i = min (to_uint p) 16 in + if i < 8 then x.[1] `>>>` 8 * i + else W64.zero; + + r.[2] <- + if to_uint p = 8 then x.[3] + else let i = min (to_uint p) 16 in + if i < 8 then (x.[2] `>>>` 8 * i) `|` (x.[3] `<<<` (64 - 8 * i)) + else x.[3] `>>>` 8 * (i - 8); + + r.[3] <- + let i = min (to_uint p) 16 in + if i < 8 then x.[3] `>>>` 8 * i + else W64.zero; + return r; } @@ -186,18 +161,9 @@ module Ops = { proc iVEXTRACTI128(x:t4u64, p : W8.t) : t2u64 = { var r : t2u64; r <- witness; - if (to_uint p = 0) { - r.[0] <- x.[0]; - r.[1] <- x.[1]; - } - else { - if (to_uint p = 1) { - r.[0] <- x.[2]; - r.[1] <- x.[3]; - } - } + r.[0] <- if p.[0] then x.[2] else x.[0]; + r.[1] <- if p.[0] then x.[3] else x.[1]; return r; - } proc iVPEXTR_64(x:t2u64, p : W8.t) : W64.t = { @@ -280,33 +246,39 @@ module Ops = { proc iVPBLENDD_256(x y:t4u64, p : W8.t) : W64.t Array4.t = { var r : t4u64; r <- witness; - if (to_uint p = 192) { - r.[0] <- x.[0]; - r.[1] <- x.[1]; - r.[2] <- x.[2]; - r.[3] <- y.[3]; - } else { - if (to_uint p = 3) { - r.[0] <- y.[0]; - r.[1] <- x.[1]; - r.[2] <- x.[2]; - r.[3] <- x.[3]; - } else { - if (to_uint p = 12) { - r.[0] <- x.[0]; - r.[1] <- y.[1]; - r.[2] <- x.[2]; - r.[3] <- x.[3]; - } else { - if (to_uint p = 48) { - r.[0] <- x.[0]; - r.[1] <- x.[1]; - r.[2] <- y.[2]; - r.[3] <- x.[3]; - } - } - } - } + r.[0] <- + if p.[0] = p.[1] then + let w = if p.[0] then y else x in + w.[0] + else + let w0 = if p.[0] then y else x in + let w1 = if p.[1] then y else x in + W2u32.pack2 [w0.[0] \bits32 0; w1.[0] \bits32 1]; + r.[1] <- + if p.[2] = p.[3] then + let w = if p.[2] then y else x in + w.[1] + else + let w0 = if p.[2] then y else x in + let w1 = if p.[3] then y else x in + W2u32.pack2 [w0.[1] \bits32 0; w1.[1] \bits32 1]; + r.[2] <- + if p.[4] = p.[5] then + let w = if p.[4] then y else x in + w.[2] + else + let w0 = if p.[4] then y else x in + let w1 = if p.[5] then y else x in + W2u32.pack2 [w0.[2] \bits32 0; w1.[2] \bits32 1]; + r.[3] <- + if p.[6] = p.[7] then + let w = if p.[6] then y else x in + w.[3] + else + let w0 = if p.[6] then y else x in + let w1 = if p.[7] then y else x in + W2u32.pack2 [w0.[3] \bits32 0; w1.[3] \bits32 1]; + return r; } @@ -314,12 +286,41 @@ module Ops = { proc iVPSHUFD_256 (x :t4u64, p : W8.t) : t4u64 = { var r : t4u64; r <- witness; - if (to_uint p = 78) { (* 01 00 11 10 *) - r.[0] <- x.[1]; - r.[1] <- x.[0]; - r.[2] <- x.[3]; - r.[3] <- x.[2]; - } + r.[0] <- + let m = W8.to_uint p in + let p1 = (m %/ (2^(2*0)))%%4 in + let p2 = (m %/ (2^(2*1)))%%4 in + if p1 %/ 2 = p2 %/ 2 /\ p1 %% 2 = 0 /\ p2 %% 2 = 1 then + x.[p1 %/ 2] + else + pack2 [x.[p1 %/ 2] \bits32 p1 %% 2; x.[p2 %/ 2] \bits32 p2 %% 2]; + + r.[1] <- + let m = W8.to_uint p in + let p1 = (m %/ (2^(2*2)))%%4 in + let p2 = (m %/ (2^(2*3)))%%4 in + if p1 %/ 2 = p2 %/ 2 /\ p1 %% 2 = 0 /\ p2 %% 2 = 1 then + x.[p1 %/ 2] + else + pack2 [x.[p1 %/ 2] \bits32 p1 %% 2; x.[p2 %/ 2] \bits32 p2 %% 2]; + + r.[2] <- + let m = W8.to_uint p in + let p1 = (m %/ (2^(2*0)))%%4 in + let p2 = (m %/ (2^(2*1)))%%4 in + if p1 %/ 2 = p2 %/ 2 /\ p1 %% 2 = 0 /\ p2 %% 2 = 1 then + x.[p1 %/ 2 + 2] + else + pack2 [x.[p1 %/ 2 + 2] \bits32 p1 %% 2; x.[p2 %/ 2 + 2] \bits32 p2 %% 2]; + + r.[3] <- + let m = W8.to_uint p in + let p1 = (m %/ (2^(2*2)))%%4 in + let p2 = (m %/ (2^(2*3)))%%4 in + if p1 %/ 2 = p2 %/ 2 /\ p1 %% 2 = 0 /\ p2 %% 2 = 1 then + x.[p1 %/ 2 + 2] + else + pack2 [x.[p1 %/ 2 + 2] \bits32 p1 %% 2; x.[p2 %/ 2 + 2] \bits32 p2 %% 2]; return r; } }. @@ -555,14 +556,30 @@ proof. qed. equiv eq_iVPERM2I128 : Ops.iVPERM2I128 ~ OpsV.iVPERM2I128 : - is4u64 x{1} x{2} /\ is4u64 y{1} y{2} /\ ={p} /\ (p{1} = W8.of_int 32 \/ p{1} = W8.of_int 49) ==> is4u64 res{1} res{2}. + is4u64 x{1} x{2} /\ is4u64 y{1} y{2} /\ ={p} ==> is4u64 res{1} res{2}. proof. - by proc; wp; skip; rewrite /is4u64 => /> &1 &2 [] ->; cbv delta; rewrite !of_intwE; cbv delta. + proc; wp; skip; rewrite /is4u64 => /> &1 &2; cbv delta. + rewrite -(W8.to_uintK' p{2}) !of_intwE /=. + apply W2u128.allP => /=. + case: (W8.int_bit (to_uint p{2}) 3) => ?. + + split; 1: by apply W2u64.allP; cbv delta. + case: (W8.int_bit (to_uint p{2}) 7) => ?; 1: by apply W2u64.allP; cbv delta. + by case: (W8.int_bit (to_uint p{2}) 5) => ?; case: (W8.int_bit (to_uint p{2}) 4). + split. + + by case: (W8.int_bit (to_uint p{2}) 1) => ?; case: (W8.int_bit (to_uint p{2}) 0). + case: (W8.int_bit (to_uint p{2}) 7) => ?; 1: by apply W2u64.allP; cbv delta. + by case: (W8.int_bit (to_uint p{2}) 5) => ?; case: (W8.int_bit (to_uint p{2}) 4). qed. -equiv eq_iVPERMQ : Ops.iVPERMQ ~ OpsV.iVPERMQ : is4u64 x{1} x{2} /\ ={p} /\ - (p{1} \in (map W8.of_int [128; 147; 78; 57; 141; 27; 114; 0; 30])) ==> is4u64 res{1} res{2}. -proof. proc; wp; skip; rewrite /is4u64 => /> &1 &2 [#|] />. qed. +lemma pack4_bits64 (x:t4u64) (i:int): 0 <= i < 4 => + pack4 [x.[0]; x.[1]; x.[2]; x.[3]] \bits64 i = x.[i]. +proof. by have /= <- [#|] -> := mema_iota 0 4. qed. + +equiv eq_iVPERMQ : Ops.iVPERMQ ~ OpsV.iVPERMQ : is4u64 x{1} x{2} /\ ={p} ==> is4u64 res{1} res{2}. +proof. + proc; wp; skip; rewrite /is4u64 => /> &1 &2. + by rewrite /x86_VPERMQ /= !pack4_bits64 ?modz_cmp. +qed. lemma lsr_2u64 (w1 w2:W64.t) (x:int) : 0 <= x <= 64 => pack2 [w1; w2] `>>>` x = pack2 [(w1 `>>>` x) `|` (w2 `<<<` 64 - x); w2 `>>>` x]. @@ -586,13 +603,35 @@ proof. by have [-> ->] : (i + x) %/ 64 = 1 /\ (i + x) %% 64 = i - 64 + x by smt(edivzP). qed. +lemma lsr_2u64_64 (w1 w2:W64.t) (x:int) : 64 <= x <= 128 => + pack2 [w1; w2] `>>>` x = pack2 [(w2 `>>>` (x - 64)); W64.zero]. +proof. + move=> hx;apply W128.wordP => i hi. + rewrite pack2wE 1://. + rewrite W128.shrwE hi /=. + case: (i < 64) => hi1. + + have [-> ->] /=: i %/ 64 = 0 /\ i %% 64 = i by smt(edivzP). + case: (i + x < 128) => ?. + + rewrite pack2wE 1:/#. + by have -> /= /# : (i + x) %/ 64 = 1 by smt(). + by rewrite W128.get_out 1:/# W64.get_out 1:/#. + have [-> ->] /= : i %/ 64 = 1 /\ i %% 64 = i - 64 by smt(edivzP). + by rewrite W128.get_out 1:/#. +qed. + lemma lsr_0 (w:W64.t) : w `<<<` 0 = w. proof. by apply W64.wordP => i hi; rewrite W64.shlwE hi. qed. -equiv eq_iVPSRLDQ_256: Ops.iVPSRLDQ_256 ~ OpsV.iVPSRLDQ_256 : is4u64 x{1} x{2} /\ ={p} /\ (p{1} = W8.of_int 6 \/ p{1} = W8.of_int 8) ==> is4u64 res{1} res{2}. +equiv eq_iVPSRLDQ_256: Ops.iVPSRLDQ_256 ~ OpsV.iVPSRLDQ_256 : + is4u64 x{1} x{2} /\ ={p} ==> is4u64 res{1} res{2}. proof. - proc; wp; skip; rewrite /is4u64 => /> &1 &2 h; cbv delta. - by case h => -> /=; rewrite !lsr_2u64 //= !lsr_0. + proc; wp; skip; rewrite /is4u64 => /> &1 &2; cbv delta. + case: (to_uint p{2} = 8) => [-> | ?] /=. + + by rewrite !lsr_2u64 //= !lsr_0. + pose i := if to_uint p{2} < 16 then to_uint p{2} else 16. + case: (i < 8) => ?. + + rewrite !lsr_2u64 //=; smt (W8.to_uint_cmp). + by rewrite !lsr_2u64_64 1,2:/# /= /#. qed. equiv eq_iVPUNPCKH_4u64: Ops.iVPUNPCKH_4u64 ~ OpsV.iVPUNPCKH_4u64 : is4u64 x{1} x{2} /\ is4u64 y{1} y{2} ==> is4u64 res{1} res{2}. @@ -601,10 +640,11 @@ proof. by proc; wp; skip; rewrite /is4u64 => />; cbv delta. qed. equiv eq_iVPUNPCKL_4u64: Ops.iVPUNPCKL_4u64 ~ OpsV.iVPUNPCKL_4u64 : is4u64 x{1} x{2} /\ is4u64 y{1} y{2} ==> is4u64 res{1} res{2}. proof. by proc; wp; skip; rewrite /is4u64 => />; cbv delta. qed. -equiv eq_iVEXTRACTI128: Ops.iVEXTRACTI128 ~ OpsV.iVEXTRACTI128 : is4u64 x{1} x{2} /\ ={p} /\ (p{1} = W8.of_int 0 \/ p{2} = W8.of_int 1) ==> is2u64 res{1} res{2}. +equiv eq_iVEXTRACTI128: Ops.iVEXTRACTI128 ~ OpsV.iVEXTRACTI128 : + is4u64 x{1} x{2} /\ ={p} ==> is2u64 res{1} res{2}. proof. - proc; wp; skip;rewrite /is4u64 /is2u64 /x86_VEXTRACTI128 => /> &1 &2 [] ->; cbv delta => //. - by rewrite W8.of_intwE. + proc; wp; skip;rewrite /is4u64 /is2u64 /x86_VEXTRACTI128 => /> &1 &2. + by case: (p{2}.[0]) => ?; cbv delta. qed. equiv eq_iVPEXTR_64: Ops.iVPEXTR_64 ~ OpsV.iVPEXTR_64 : is2u64 x{1} x{2} /\ ={p} /\ (p{1} = W8.of_int 0 \/ p{2} = W8.of_int 1)==> res{1} = res{2}. @@ -635,14 +675,54 @@ equiv eq_iVPSLLV_4u64 : Ops.iVPSLLV_4u64 ~ OpsV.iVPSLLV_4u64 : is4u64 x{1} x{2} proof. by proc;wp; skip; rewrite /is4u64 => />; cbv delta. qed. equiv eq_iVPBLENDD_256 : Ops.iVPBLENDD_256 ~ OpsV.iVPBLENDD_256 : - is4u64 x{1} x{2} /\ is4u64 y{1} y{2} /\ ={p} /\ p{1} \in map W8.of_int [192; 3; 12; 48] + is4u64 x{1} x{2} /\ is4u64 y{1} y{2} /\ ={p} ==> is4u64 res{1} res{2}. proof. - proc; wp; skip; rewrite /is4u64 => /> &1 &2. - by move=> [#|] />; cbv delta; rewrite !W8.of_intwE /=; apply W8u32.allP;cbv delta. + proc; wp; skip; rewrite /is4u64 /x86_VPBLENDD_256 => /> &1 &2 /=. + apply W8u32.allP => /=. + split; 1: by case: (p{2}.[0] = p{2}.[1]); case: (p{2}.[0]). + split; 1: by case: (p{2}.[0] = p{2}.[1]) => [->|]; case: (p{2}.[1]). + split; 1: by case: (p{2}.[2] = p{2}.[3]); case: (p{2}.[2]). + split; 1: by case: (p{2}.[2] = p{2}.[3]) => [->|];case: (p{2}.[3]). + split; 1: by case: ( p{2}.[4] = p{2}.[5]); case: (p{2}.[4]). + split; 1: by case: ( p{2}.[4] = p{2}.[5]) => [->|]; case: (p{2}.[5]). + split; 1: by case: (p{2}.[6] = p{2}.[7]); case: (p{2}.[6]). + by case: (p{2}.[6] = p{2}.[7]) => [->|]; case: (p{2}.[7]). qed. equiv eq_iVPSHUFD_256 : Ops.iVPSHUFD_256 ~ OpsV.iVPSHUFD_256 : - is4u64 x{1} x{2} /\ ={p} /\ p{1} = W8.of_int 78 ==> is4u64 res{1} res{2}. -proof. by proc; wp; skip; rewrite /is4u64 => /> &1; apply W8u32.allP;cbv delta. qed. + is4u64 x{1} x{2} /\ ={p} ==> is4u64 res{1} res{2}. +proof. + proc; wp; skip; rewrite /is4u64 => /> &1 &2; apply W8u32.allP; cbv delta. + have heq0 : forall (w: t4u64) i, 0 <= i < 2 => (W2u64.Pack.of_list [w.[0]; w.[1]]).[i] = w.[i]. + + by move=> w i /(mema_iota 0 2) /= [#|] -> /=. + have heq1 : forall (w: t4u64) i, 0 <= i < 2 => (W2u64.Pack.of_list [w.[2]; w.[3]]).[i] = w.[i+2]. + + by move=> w i /(mema_iota 0 2) /= [#|] -> /=. + have hmod : forall x, 0 <= x %%4 %/2 < 2 by smt(). + do !(rewrite bits32_W2u64_red 1:modz_cmp 1:// heq0 1:hmod /=). + do !(rewrite bits32_W2u64_red 1:modz_cmp 1:// heq1 1:hmod /=). + split. + + by case: (to_uint p{2} %% 4 %/ 2 = to_uint p{2} %/ 4 %% 4 %/ 2 /\ + to_uint p{2} %% 4 %% 2 = 0 /\ to_uint p{2} %/ 4 %% 4 %% 2 = 1) => [ [# -> ->] |]. + split. + + by case: (to_uint p{2} %% 4 %/ 2 = to_uint p{2} %/ 4 %% 4 %/ 2 /\ + to_uint p{2} %% 4 %% 2 = 0 /\ to_uint p{2} %/ 4 %% 4 %% 2 = 1) => [ [# -> _ ->] |]. + split. + + by case: (to_uint p{2} %/ 16 %% 4 %/ 2 = to_uint p{2} %/ 64 %% 4 %/ 2 /\ + to_uint p{2} %/ 16 %% 4 %% 2 = 0 /\ to_uint p{2} %/ 64 %% 4 %% 2 = 1) => [[# -> ->] |]. + split. + + by case: (to_uint p{2} %/ 16 %% 4 %/ 2 = to_uint p{2} %/ 64 %% 4 %/ 2 /\ + to_uint p{2} %/ 16 %% 4 %% 2 = 0 /\ to_uint p{2} %/ 64 %% 4 %% 2 = 1) => [[# -> _ ->] |]. + split. + + by case: (to_uint p{2} %% 4 %/ 2 = to_uint p{2} %/ 4 %% 4 %/ 2 /\ + to_uint p{2} %% 4 %% 2 = 0 /\ to_uint p{2} %/ 4 %% 4 %% 2 = 1) => [[# -> ->]|]. + split. + + by case: (to_uint p{2} %% 4 %/ 2 = to_uint p{2} %/ 4 %% 4 %/ 2 /\ + to_uint p{2} %% 4 %% 2 = 0 /\ to_uint p{2} %/ 4 %% 4 %% 2 = 1) => [[# -> _ ->]|]. + split. + + by case: (to_uint p{2} %/ 16 %% 4 %/ 2 = to_uint p{2} %/ 64 %% 4 %/ 2 /\ + to_uint p{2} %/ 16 %% 4 %% 2 = 0 /\ to_uint p{2} %/ 64 %% 4 %% 2 = 1) => [[# -> ->]|]. + by case: (to_uint p{2} %/ 16 %% 4 %/ 2 = to_uint p{2} %/ 64 %% 4 %/ 2 /\ + to_uint p{2} %/ 16 %% 4 %% 2 = 0 /\ to_uint p{2} %/ 64 %% 4 %% 2 = 1) => [[# -> _ ->]|]. +qed. diff --git a/proof/impl/perm/keccak_f1600_avx2_prevec.ec b/proof/impl/perm/keccak_f1600_avx2_prevec.ec index 8f9a8ce..ba2b056 100644 --- a/proof/impl/perm/keccak_f1600_avx2_prevec.ec +++ b/proof/impl/perm/keccak_f1600_avx2_prevec.ec @@ -430,63 +430,49 @@ op equiv_states_chi (a00 a01 a20 a31 a21 a41 a11 : W64.t Array4.t, st : W64.t Ar lemma dec : forall (x : W32.t), 0 < to_uint x <= 24 => - to_uint (x86_DEC_32 x).`5 = to_uint x - 1 by smt(@W32). + to_uint (x86_DEC_32 x).`5 = to_uint x - 1. +proof. + move=> x hx;cbv delta. + by rewrite W32.to_uintB ?uleE //= /#. +qed. -lemma decK : forall (x : W32.t), - (x86_DEC_32 x).`5 + W32.one = x. +lemma decK (x : W32.t): (x86_DEC_32 x).`5 + W32.one = x. proof. rewrite /x86_DEC_32 /= /rflags_of_aluop_nocf32 /= => *; ring. qed. -lemma dec0 : forall (x : W32.t), - 0 < to_uint x <= 24 => - (x86_DEC_32 x).`4 <=> to_uint (x86_DEC_32 x).`5 = 0 by smt(@W32). +lemma dec0 (x : W32.t): 0 < to_uint x <= 24 => + (x86_DEC_32 x).`4 <=> to_uint (x86_DEC_32 x).`5 = 0. +proof. by move=> hx;cbv delta; rewrite W32.to_uint_eq. qed. -lemma rolcomp : (forall (x : W64.t), - (x86_ROL_64 x W8.one).`3 = - (x `>>` W8.of_int 63) `|` (x + x)). -move => x. -rewrite x86_ROL_64_E => />. -rewrite rol_xor_shft => />. -rewrite (_: x + x = x `<<` W8.one). rewrite /(`<<`) => />. - have HH : ( to_uint (x+x) = to_uint (x `<<<` 1)); first by rewrite to_uint_shl => />; rewrite to_uintD => />; smt(@W64). - by smt(@W64). -rewrite /(`<<`) /(`>>`) => />. -rewrite xorE orE !map2E => />. -apply W64.init_ext. -progress. smt(@W64). +lemma rolcomp (x : W64.t): + (x86_ROL_64 x W8.one).`3 = (x `>>` W8.of_int 63) `|` (x + x). +proof. +rewrite x86_ROL_64_E /= rol_xor_shft //= (_: x + x = x `<<` W8.one). ++ by rewrite /(`<<`) W64.to_uint_eq to_uint_shl //= to_uintD //= /#. +rewrite /(`<<`) /(`>>`) /= xorE orE !map2E. +apply W64.init_ext => /> ?; smt (W64.get_out). qed. -lemma commor : forall (x y : W64.t), x `|` y = y `|` x. -move => *. - rewrite orE !map2E. -apply W64.init_ext. -by smt(). -qed. +lemma commor (x y : W64.t): x `|` y = y `|` x. +proof. by rewrite orE !map2E; apply W64.init_ext => /> ???; rewrite orbC. qed. -lemma rol0 : forall x, (x86_ROL_64 x W8.zero).`3 = x. -move => *. -rewrite x86_ROL_64_E rol_xor =>/>. -exact/lsr_0. -qed. +lemma rol0 x: (x86_ROL_64 x W8.zero).`3 = x. +proof. rewrite x86_ROL_64_E rol_xor =>/>; exact/lsr_0. qed. -lemma roln : forall x n, 0 <= n < 64 => +lemma roln x n: 0 <= n < 64 => (x86_ROL_64 x (W8.of_int n)).`3 = (x `>>>` (64 - n)) `|` (x `<<<` n). -move => x n H. -case (n = 0). -move => HH. rewrite HH rol0 => />. by smt(lsr_0). -move => HH. -rewrite x86_ROL_64_E => />. -rewrite rol_xor_shft => />. -split; first 2 by smt(). +move => H. +case (n = 0) => HH. ++ by rewrite HH rol0 => />; smt(lsr_0). +rewrite x86_ROL_64_E /= rol_xor_shft /= 1:/#. rewrite /(`<<`) /(`>>`) => />. -rewrite (_: n %% 256 = n); first by smt(). -rewrite (_: n %% 256 = n); first by smt(). -rewrite (_: (64 - n) %% 256 = 64 - n); first by smt(). -rewrite (_: n %% 64 = n); first by smt(). -rewrite (_: (64 - n) %% 64 = 64 - n); first by smt(). +have n256 : n %% 256 = n by smt(). +have n64 : n %% 64 = n by smt(). +have n64_ : (64 - n) %% 256 = 64 - n by smt(). +have n64_m: (64 - n) %% 64 = 64 - n by smt(). +rewrite !(n256, n64, n64_, n64_m). rewrite xorE orE !map2E => />. -apply W64.init_ext. -progress. smt(@W64). +apply W64.init_ext => /> ???; smt (W64.get_out). qed. op good_io4x (mem : global_mem_t, _iotas : int) = @@ -646,53 +632,12 @@ lemma lift_roln mem rl rr o1 o2 x: (to_uint (rl + W64.of_int 96 + W64.of_int (8 * 4 * o1 - 96))))).[o2]))%W64 = (x86_ROL_64 x ((of_int (rhotates (conversion o1 o2))))%W8).`3. proof. -move => *. -rewrite (loadlift_rhol mem (rl) o1 H). smt(). smt(). -rewrite (loadlift_rhor mem (rr) o1 H0). smt(). smt(). -rewrite /good_rhotates_right /good_rhotates_left /rhotates /conversion. -simplify. -case(o1 = 0). auto => />. -case (o2 = 0). auto => />. smt(roln). -case (o2 = 1). auto => />. smt(roln). -case (o2 = 2). auto => />. smt(roln). -case (o2 = 3). auto => />. smt(roln). -smt(). -move => *. -case(o1 = 1). auto => />. -case (o2 = 0). auto => />. smt(roln). -case (o2 = 1). auto => />. smt(roln). -case (o2 = 2). auto => />. smt(roln). -case (o2 = 3). auto => />. smt(roln). -smt(). -move => *. -case(o1 = 2). auto => />. -case (o2 = 0). auto => />. smt(roln). -case (o2 = 1). auto => />. smt(roln). -case (o2 = 2). auto => />. smt(roln). -case (o2 = 3). auto => />. smt(roln). -smt(). -move => *. -case(o1 = 3). auto => />. -case (o2 = 0). auto => />. smt(roln). -case (o2 = 1). auto => />. smt(roln). -case (o2 = 2). auto => />. smt(roln). -case (o2 = 3). auto => />. smt(roln). -smt(). -move => *. -case(o1 = 4). auto => />. -case (o2 = 0). auto => />. smt(roln). -case (o2 = 1). auto => />. smt(roln). -case (o2 = 2). auto => />. smt(roln). -case (o2 = 3). auto => />. smt(roln). -smt(). -move => *. -case(o1 = 5). auto => />. -case (o2 = 0). auto => />. smt(roln). -case (o2 = 1). auto => />. smt(roln). -case (o2 = 2). auto => />. smt(roln). -case (o2 = 3). auto => />. smt(roln). -smt(). -smt(). +move => hl192 hr192 ho1 ho2 hgl hgr. +rewrite (loadlift_rhol mem (rl) o1 hl192) 1,2://. +rewrite (loadlift_rhor mem (rr) o1 hr192) 1,2://. +rewrite /good_rhotates_right /good_rhotates_left /rhotates /conversion; cbv delta. +move: ho1 ho2 => /(mema_iota 0 6) ho1 /(mema_iota 0 4). +by move: ho1 => /= [#|] -> [#|] ->; cbv delta; rewrite roln. qed. lemma correct_perm _a00 _a01 _a20 _a31 _a21 _a41 _a11 st mem: @@ -707,6 +652,7 @@ lemma correct_perm _a00 _a01 _a20 _a31 _a21 _a41 _a11 st mem: a21{2} = _a21 /\ a41{2} = _a41 /\ a11{2} = _a11 /\ state{1} = st ==> Glob.mem{2} = mem /\ equiv_states res{2}.`1 res{2}.`2 res{2}.`3 res{2}.`4 res{2}.`5 res{2}.`6 res{2}.`7 res{1}]. +proof. proc. unroll {1} 3. rcondt {1} 3; first by move => *; inline *; auto => />. @@ -742,282 +688,89 @@ swap {2} 46 -17. seq 9 29 : (#{/~state{1}}post /\ c{1} = W64.of_int 1 /\ equiv_states a00{2} a01{2} a20{2} a31{2} a21{2} a41{2} a11{2} state0{1}). - - -do 13!(unroll for {1} ^while). - - -inline *. -do !((rcondf {2} ^if; first by move => *; wp;skip;auto => />) || - (rcondt {2} ^if; first by move => *; wp;skip;auto => />)). - -wp;skip. -move => &1 &2. -rewrite /equiv_states /index. - simplify. -by smt(W64.xorwA W64.xorwC W64.xorw0 W64.xorwK rolcomp commor). ++ conseq />. + do 13!(unroll for {1} ^while). + inline *. wp;skip => &1 &2 [#] 9!->>. + move=> ??? ->> ???? 7!<<- ->> h. + cbv int_bit index W8.int_bit. + by smt(W64.xorwA W64.xorwC W64.xorw0 W64.xorwK rolcomp commor). (* Rho PI *) inline Mreftable.rho Mreftable.pi. seq 11 22 : (#{/~ state{1}}post /\ c{1} = W64.of_int 1 /\ equiv_states_chi a00{2} t{2}.[1] t{2}.[2] t{2}.[3] t{2}.[4] t{2}.[5] t{2}.[6] state0{1}). - +conseq />. do 13!(unroll for {1} ^while). -inline *. -do !((rcondf {2} ^if; first by move => *; wp;skip;auto => />) || - (rcondt {2} ^if; first by move => *; wp;skip;auto => />)). - -wp;skip. -move => &1 &2. -rewrite /equiv_states /equiv_states_chi /index. -simplify. - -move => [/ # *]. - -split; first by smt(). -split; first by smt(). - -split; first by rewrite /rhotates; smt(roln rol0). -split; first by rewrite /rhotates; smt(roln rol0). -split; first by rewrite /rhotates; smt(roln rol0). -split; first by rewrite /rhotates; smt(roln rol0). - +inline *; wp; skip => &1 &2 [#] 7!->> 7? ->> ?. +cbv index rhotates. +split; first by smt(rol0). +split; first by smt(rol0). +split; first by smt(rol0). +split; first by smt(rol0). split. -rewrite H H0. -move : H36 H37 H38 H39; rewrite -H5 => rl rr rls rrs. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 5 3 a11{2}.[3] rls rrs _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - ++ have /= -> := lift_roln _ _ _ 5 3 a11{2}.[3] H4 H5 _ _ H2 H3; 1,2: done; cbv delta; smt(). split. -rewrite H H0. -move : H36 H37 H38 H39; rewrite -H5 => rl rr rls rrs. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 5 2 a11{2}.[2] rls rrs _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - ++ have /= -> := lift_roln _ _ _ 5 2 a11{2}.[2] H4 H5 _ _ H2 H3; 1,2: done; cbv delta; smt(). split. -rewrite H H0. -move : H36 H37 H38 H39; rewrite -H5 => rl rr rls rrs. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 5 1 a11{2}.[1] rls rrs _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - ++ have /= -> := lift_roln _ _ _ 5 1 a11{2}.[1] H4 H5 _ _ H2 H3; 1,2: done; cbv delta; smt(). split. -rewrite H H0. -move : H36 H37 H38 H39; rewrite -H5 => rl rr rls rrs. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 5 0 a11{2}.[0] rls rrs _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - ++ have /= -> := lift_roln _ _ _ 5 0 a11{2}.[0] H4 H5 _ _ H2 H3; 1,2: done; cbv delta; smt(). split. -rewrite H H0. -move : H36 H37 H38 H39; rewrite -H5 => rl rr rls rrs. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 1 3 a01{2}.[3] rls rrs _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - ++ have /= -> := lift_roln _ _ _ 1 3 a01{2}.[3] H4 H5 _ _ H2 H3; 1,2: done; cbv delta; smt(). split. -rewrite H H0. -move : H36 H37 H38 H39; rewrite -H5 => rl rr rls rrs. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 1 2 a01{2}.[2] rls rrs _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - ++ have /= -> := lift_roln _ _ _ 1 2 a01{2}.[2] H4 H5 _ _ H2 H3; 1,2: done; cbv delta; smt(). split. -rewrite H H0. -move : H36 H37 H38 H39; rewrite -H5 => rl rr rls rrs. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 1 1 a01{2}.[1] rls rrs _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - ++ have /= -> := lift_roln _ _ _ 1 1 a01{2}.[1] H4 H5 _ _ H2 H3; 1,2: done; cbv delta; smt(). split. -rewrite H H0. -move : H36 H37 H38 H39; rewrite -H5 => rl rr rls rrs. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 1 0 a01{2}.[0] rls rrs _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - - ++ have /= -> := lift_roln _ _ _ 1 0 a01{2}.[0] H4 H5 _ _ H2 H3; 1,2: done; cbv delta; smt(). split. -rewrite H H0. -move : H36 H37 H38 H39; rewrite -H5 => rl rr rls rrs. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 0 2 a20{2}.[2] rls rrs _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - ++ have /= -> := lift_roln _ _ _ 0 2 a20{2}.[2] H4 H5 _ _ H2 H3; 1,2: done; cbv delta; smt(). split. -rewrite H H0. -move : H36 H37 H38 H39; rewrite -H5 => rl rr rls rrs. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 0 0 a20{2}.[0] rls rrs _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - ++ have /= -> := lift_roln _ _ _ 0 0 a20{2}.[0] H4 H5 _ _ H2 H3; 1,2: done; cbv delta; smt(). split. -rewrite H H0. -move : H36 H37 H38 H39; rewrite -H5 => rl rr rls rrs. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 0 3 a20{2}.[3] rls rrs _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - ++ have /= -> := lift_roln _ _ _ 0 3 a20{2}.[3] H4 H5 _ _ H2 H3; 1,2: done; cbv delta; smt(). split. -rewrite H H0. -move : H36 H37 H38 H39; rewrite -H5 => rl rr rls rrs. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 0 1 a20{2}.[1] rls rrs _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - ++ have /= -> := lift_roln _ _ _ 0 1 a20{2}.[1] H4 H5 _ _ H2 H3; 1,2: done; cbv delta; smt(). split. -rewrite H H0. -move : H36 H37 H38 H39; rewrite -H5 => rl rr rls rrs. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 2 2 a31{2}.[2] rls rrs _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - ++ have /= -> := lift_roln _ _ _ 2 2 a31{2}.[2] H4 H5 _ _ H2 H3; 1,2: done; cbv delta; smt(). split. -rewrite H H0. -move : H36 H37 H38 H39; rewrite -H5 => rl rr rls rrs. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 2 0 a31{2}.[0] rls rrs _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - ++ have /= -> := lift_roln _ _ _ 2 0 a31{2}.[0] H4 H5 _ _ H2 H3; 1,2: done; cbv delta; smt(). split. -rewrite H H0. -move : H36 H37 H38 H39; rewrite -H5 => rl rr rls rrs. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 2 3 a31{2}.[3] rls rrs _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - ++ have /= -> := lift_roln _ _ _ 2 3 a31{2}.[3] H4 H5 _ _ H2 H3; 1,2: done; cbv delta; smt(). split. -rewrite H H0. -move : H36 H37 H38 H39; rewrite -H5 => rl rr rls rrs. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 2 1 a31{2}.[1] rls rrs _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - ++ have /= -> := lift_roln _ _ _ 2 1 a31{2}.[1] H4 H5 _ _ H2 H3; 1,2: done; cbv delta; smt(). split. -rewrite H H0. -move : H36 H37 H38 H39; rewrite -H5 => rl rr rls rrs. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 3 0 a21{2}.[0] rls rrs _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - ++ have /= -> := lift_roln _ _ _ 3 0 a21{2}.[0] H4 H5 _ _ H2 H3; 1,2: done; cbv delta; smt(). split. -rewrite H H0. -move : H36 H37 H38 H39; rewrite -H5 => rl rr rls rrs. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 3 1 a21{2}.[1] rls rrs _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - ++ have /= -> := lift_roln _ _ _ 3 1 a21{2}.[1] H4 H5 _ _ H2 H3; 1,2: done; cbv delta; smt(). split. -rewrite H H0. -move : H36 H37 H38 H39; rewrite -H5 => rl rr rls rrs. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 3 2 a21{2}.[2] rls rrs _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - ++ have /= -> := lift_roln _ _ _ 3 2 a21{2}.[2] H4 H5 _ _ H2 H3; 1,2: done; cbv delta; smt(). split. -rewrite H H0. -move : H36 H37 H38 H39; rewrite -H5 => rl rr rls rrs. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 3 3 a21{2}.[3] rls rrs _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - ++ have /= -> := lift_roln _ _ _ 3 3 a21{2}.[3] H4 H5 _ _ H2 H3; 1,2: done; cbv delta; smt(). split. -rewrite H H0. -move : H36 H37 H38 H39; rewrite -H5 => rl rr rls rrs. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 4 1 a41{2}.[1] rls rrs _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - ++ have /= -> := lift_roln _ _ _ 4 1 a41{2}.[1] H4 H5 _ _ H2 H3; 1,2: done; cbv delta; smt(). split. -rewrite H H0. -move : H36 H37 H38 H39; rewrite -H5 => rl rr rls rrs. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 4 3 a41{2}.[3] rls rrs _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - ++ have /= -> := lift_roln _ _ _ 4 3 a41{2}.[3] H4 H5 _ _ H2 H3; 1,2: done; cbv delta; smt(). split. -rewrite H H0. -move : H36 H37 H38 H39; rewrite -H5 => rl rr rls rrs. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 4 0 a41{2}.[0] rls rrs _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - -rewrite H H0. -move : H36 H37 H38 H39; rewrite -H5 => rl rr rls rrs. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 4 2 a41{2}.[2] rls rrs _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). ++ have /= -> := lift_roln _ _ _ 4 0 a41{2}.[0] H4 H5 _ _ H2 H3; 1,2: done; cbv delta; smt(). +have /= -> := lift_roln _ _ _ 4 2 a41{2}.[2] H4 H5 _ _ H2 H3; 1,2: done; cbv delta; smt(). (* Chi *) inline Mreftable.chi. - +conseq />. seq 5 53 : (#{~state0{1}}pre /\ equiv_states a00{2} a01{2} a20{2} a31{2} a21{2} a41{2} a11{2} state0{1}). ++ conseq />. + do 11!(unroll for {1} ^while). + inline *; wp; skip => &1 &2 [#] 7!->> 7? ->> ?. + cbv delta. + smt (W64.xorwC W64.andwC). -do 11!(unroll for {1} ^while). -inline *. -do !((rcondf {2} ^if; first by move => *; wp;skip;auto => />) || - (rcondt {2} ^if; first by move => *; wp;skip;auto => />)). - -wp. skip. -move => &1 &2. -rewrite /equiv_states /equiv_states_chi /index. -simplify. - -move => [/ # *]. - -split; first by smt(). - -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -smt(@W64). - -inline *. wp;skip. -move => &1 &2 [/ # *]. -split; first by smt(). -split; first by smt(). -split; first by smt(). -split; first by smt(). -split; first by smt(). -rewrite /equiv_states /index /y_R. -simplify. - -split; first by auto => />. -split; first by auto => />. -split; first by auto => />. -move : H40 H35; rewrite -H1 -H5 => iii iv. -move : (loadlift_iotas Glob.mem{2} (iotas{2}) 0 iii iv); rewrite /good_iotas4x => //= ii. -rewrite ii. -simplify. -smt(@W64). +inline *; wp;skip => &1 &2 [#] 7!->> 7? ->> ?. +cbv index. +have /= -> /= := loadlift_iotas _ _ 0 H6 H1 _; 1:done. +rewrite /good_iotas4x /= /#. seq 1 2 : (#{/~iotas{2}}{~round{1}}{~i{2}}{~st}pre /\ iotas{2} = _iotas{2} + W64.of_int (round{1} * 32) /\ @@ -1027,13 +780,8 @@ seq 1 2 : (#{/~iotas{2}}{~round{1}}{~i{2}}{~st}pre /\ 0 < round{1} /\ to_uint i{2} <= 24 /\ constants{1} = Keccak_f1600_ref_op.iotas). - -auto => />. -progress. -apply dec. smt(). -rewrite (dec). smt(@W32). smt(@W32). -rewrite (decK). smt(@W32). -smt(@W32 dec decK). ++ auto => /> *. + by rewrite dec 1:// /= decK. while (#pre). @@ -1053,412 +801,113 @@ swap {2} 46 -17. seq 9 29 : (#{/~state{1}}post /\ c{1} = constants{1}.[round{1}] /\ round{1} < 24 /\ equiv_states a00{2} a01{2} a20{2} a31{2} a21{2} a41{2} a11{2} state0{1}). - -do 13!(unroll for {1} ^while). -inline *. -do !((rcondf {2} ^if; first by move => *; wp;skip;auto => />) || - (rcondt {2} ^if; first by move => *; wp;skip;auto => />)). - -wp;skip. -move => &1 &2. -rewrite /equiv_states /index. -simplify. -by smt(W64.xorwA W64.xorwC W64.xorw0 W64.xorwK rolcomp commor). ++ conseq />. + do 13!(unroll for {1} ^while). + inline *; wp;skip. + move => &1 &2 [#] 7!->> 7? ->> ?? <<- ?????. + cbv delta. + rewrite !rolcomp /(`>>`) /=. + smt(W64.xorwA W64.xorwC W64.xorw0 W64.xorwK commor). (* Rho PI *) inline Mreftable.rho Mreftable.pi. - seq 11 22 : (#{/~ state{1}}post /\ c{1} = constants{1}.[round{1}] /\ round{1} < 24 /\ equiv_states_chi a00{2} t{2}.[1] t{2}.[2] t{2}.[3] t{2}.[4] t{2}.[5] t{2}.[6] state0{1}). - +conseq />. do 13!(unroll for {1} ^while). - - -inline *. -do !((rcondf {2} ^if; first by move => *; wp;skip;auto => />) || - (rcondt {2} ^if; first by move => *; wp;skip;auto => />)). - -wp;skip. -move => &1 &2. -rewrite /equiv_states /equiv_states_chi /index. -simplify. - -move => [/ #] *. - -split; first by smt(). -split; first by smt(). -split; first by smt(). - -split; first by rewrite /rhotates; smt(roln rol0). -split; first by rewrite /rhotates; smt(roln rol0). -split; first by rewrite /rhotates; smt(roln rol0). -split; first by rewrite /rhotates; smt(roln rol0). - +inline *; wp;skip. +move => &1 &2 [#] 4!->> _ ?????? ->> ?? <<- ???? ->> ??. +cbv index rhotates. +split; first by smt(rol0). +split; first by smt(rol0). +split; first by smt(rol0). +split; first by smt(rol0). split. -rewrite H H0. -move : H5 H6 H7 H8; rewrite -H2 => rl rr rls rrs. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 5 3 a11{2}.[3] rls rrs _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - ++ have /= -> := lift_roln _ _ _ 5 3 a11{2}.[3] H2 H3 _ _ H0 H1; 1,2: done; cbv delta; smt(). split. -rewrite H H0. -move : H5 H6 H7 H8; rewrite -H2 => rl rr rls rrs. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 5 2 a11{2}.[2] rls rrs _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - ++ have /= -> := lift_roln _ _ _ 5 2 a11{2}.[2] H2 H3 _ _ H0 H1; 1,2: done; cbv delta; smt(). split. -rewrite H H0. -move : H5 H6 H7 H8; rewrite -H2 => rl rr rls rrs. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 5 1 a11{2}.[1] rls rrs _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - ++ have /= -> := lift_roln _ _ _ 5 1 a11{2}.[1] H2 H3 _ _ H0 H1; 1,2: done; cbv delta; smt(). split. -rewrite H H0. -move : H5 H6 H7 H8; rewrite -H2 => rl rr rls rrs. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 5 0 a11{2}.[0] rls rrs _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - ++ have /= -> := lift_roln _ _ _ 5 0 a11{2}.[0] H2 H3 _ _ H0 H1; 1,2: done; cbv delta; smt(). split. -rewrite H H0. -move : H5 H6 H7 H8; rewrite -H2 => rl rr rls rrs. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 1 3 a01{2}.[3] rls rrs _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - ++ have /= -> := lift_roln _ _ _ 1 3 a01{2}.[3] H2 H3 _ _ H0 H1; 1,2: done; cbv delta; smt(). split. -rewrite H H0. -move : H5 H6 H7 H8; rewrite -H2 => rl rr rls rrs. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 1 2 a01{2}.[2] rls rrs _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - ++ have /= -> := lift_roln _ _ _ 1 2 a01{2}.[2] H2 H3 _ _ H0 H1; 1,2: done; cbv delta; smt(). split. -rewrite H H0. -move : H5 H6 H7 H8; rewrite -H2 => rl rr rls rrs. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 1 1 a01{2}.[1] rls rrs _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - ++ have /= -> := lift_roln _ _ _ 1 1 a01{2}.[1] H2 H3 _ _ H0 H1; 1,2: done; cbv delta; smt(). split. -rewrite H H0. -move : H5 H6 H7 H8; rewrite -H2 => rl rr rls rrs. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 1 0 a01{2}.[0] rls rrs _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - - ++ have /= -> := lift_roln _ _ _ 1 0 a01{2}.[0] H2 H3 _ _ H0 H1; 1,2: done; cbv delta; smt(). split. -rewrite H H0. -move : H5 H6 H7 H8; rewrite -H2 => rl rr rls rrs. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 0 2 a20{2}.[2] rls rrs _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - ++ have /= -> := lift_roln _ _ _ 0 2 a20{2}.[2] H2 H3 _ _ H0 H1; 1,2: done; cbv delta; smt(). split. -rewrite H H0. -move : H5 H6 H7 H8; rewrite -H2 => rl rr rls rrs. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 0 0 a20{2}.[0] rls rrs _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - ++ have /= -> := lift_roln _ _ _ 0 0 a20{2}.[0] H2 H3 _ _ H0 H1; 1,2: done; cbv delta; smt(). split. -rewrite H H0. -move : H5 H6 H7 H8; rewrite -H2 => rl rr rls rrs. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 0 3 a20{2}.[3] rls rrs _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - ++ have /= -> := lift_roln _ _ _ 0 3 a20{2}.[3] H2 H3 _ _ H0 H1; 1,2: done; cbv delta; smt(). split. -rewrite H H0. -move : H5 H6 H7 H8; rewrite -H2 => rl rr rls rrs. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 0 1 a20{2}.[1] rls rrs _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - ++ have /= -> := lift_roln _ _ _ 0 1 a20{2}.[1] H2 H3 _ _ H0 H1; 1,2: done; cbv delta; smt(). split. -rewrite H H0. -move : H5 H6 H7 H8; rewrite -H2 => rl rr rls rrs. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 2 2 a31{2}.[2] rls rrs _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - ++ have /= -> := lift_roln _ _ _ 2 2 a31{2}.[2] H2 H3 _ _ H0 H1; 1,2: done; cbv delta; smt(). split. -rewrite H H0. -move : H5 H6 H7 H8; rewrite -H2 => rl rr rls rrs. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 2 0 a31{2}.[0] rls rrs _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - ++ have /= -> := lift_roln _ _ _ 2 0 a31{2}.[0] H2 H3 _ _ H0 H1; 1,2: done; cbv delta; smt(). split. -rewrite H H0. -move : H5 H6 H7 H8; rewrite -H2 => rl rr rls rrs. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 2 3 a31{2}.[3] rls rrs _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - ++ have /= -> := lift_roln _ _ _ 2 3 a31{2}.[3] H2 H3 _ _ H0 H1; 1,2: done; cbv delta; smt(). split. -rewrite H H0. -move : H5 H6 H7 H8; rewrite -H2 => rl rr rls rrs. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 2 1 a31{2}.[1] rls rrs _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - ++ have /= -> := lift_roln _ _ _ 2 1 a31{2}.[1] H2 H3 _ _ H0 H1; 1,2: done; cbv delta; smt(). split. -rewrite H H0. -move : H5 H6 H7 H8; rewrite -H2 => rl rr rls rrs. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 3 0 a21{2}.[0] rls rrs _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - ++ have /= -> := lift_roln _ _ _ 3 0 a21{2}.[0] H2 H3 _ _ H0 H1; 1,2: done; cbv delta; smt(). split. -rewrite H H0. -move : H5 H6 H7 H8; rewrite -H2 => rl rr rls rrs. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 3 1 a21{2}.[1] rls rrs _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - ++ have /= -> := lift_roln _ _ _ 3 1 a21{2}.[1] H2 H3 _ _ H0 H1; 1,2: done; cbv delta; smt(). split. -rewrite H H0. -move : H5 H6 H7 H8; rewrite -H2 => rl rr rls rrs. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 3 2 a21{2}.[2] rls rrs _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - ++ have /= -> := lift_roln _ _ _ 3 2 a21{2}.[2] H2 H3 _ _ H0 H1; 1,2: done; cbv delta; smt(). split. -rewrite H H0. -move : H5 H6 H7 H8; rewrite -H2 => rl rr rls rrs. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 3 3 a21{2}.[3] rls rrs _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - ++ have /= -> := lift_roln _ _ _ 3 3 a21{2}.[3] H2 H3 _ _ H0 H1; 1,2: done; cbv delta; smt(). split. -rewrite H H0. -move : H5 H6 H7 H8; rewrite -H2 => rl rr rls rrs. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 4 1 a41{2}.[1] rls rrs _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - ++ have /= -> := lift_roln _ _ _ 4 1 a41{2}.[1] H2 H3 _ _ H0 H1; 1,2: done; cbv delta; smt(). split. -rewrite H H0. -move : H5 H6 H7 H8; rewrite -H2 => rl rr rls rrs. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 4 3 a41{2}.[3] rls rrs _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - ++ have /= -> := lift_roln _ _ _ 4 3 a41{2}.[3] H2 H3 _ _ H0 H1; 1,2: done; cbv delta; smt(). split. -rewrite H H0. -move : H5 H6 H7 H8; rewrite -H2 => rl rr rls rrs. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 4 0 a41{2}.[0] rls rrs _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). - -rewrite H H0. -move : H5 H6 H7 H8; rewrite -H2 => rl rr rls rrs. -move : (lift_roln Glob.mem{2} _rhotates_left{2} _rhotates_right{2} 4 2 a41{2}.[2] rls rrs _ _ rl rr); -rewrite /conversion. -smt(). smt(). smt(). ++ have /= -> := lift_roln _ _ _ 4 0 a41{2}.[0] H2 H3 _ _ H0 H1; 1,2: done; cbv delta; smt(). +have /= -> := lift_roln _ _ _ 4 2 a41{2}.[2] H2 H3 _ _ H0 H1; 1,2: done; cbv delta; smt(). (* Chi *) inline Mreftable.chi. - seq 5 53 : (#{~state0{1}}pre /\ equiv_states a00{2} a01{2} a20{2} a31{2} a21{2} a41{2} a11{2} state0{1}). - +conseq />. do 11!(unroll for {1} ^while). -inline *. -do !((rcondf {2} ^if; first by move => *; wp;skip;auto => />) || - (rcondt {2} ^if; first by move => *; wp;skip;auto => />)). - -wp. skip. -move => &1 &2. -rewrite /equiv_states /equiv_states_chi /index. -simplify. - -move => [/ #] *. - -split; first by smt(). - -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -split; first by smt(@W64). -smt(@W64). +inline *; wp; skip => &1 &2 [#] 4!->> ???? ??? ->> ?? <<- ???? ->> ??. +cbv delta. +smt (W64.xorwC W64.andwC). (* iota *) seq 2 1 : (#{/~ state0{1}}pre /\ equiv_states a00{2} a01{2} a20{2} a31{2} a21{2} a41{2} a11{2} state{1}). - -inline *; wp; skip; rewrite /equiv_states /index; progress. - -have iii : (to_uint _iotas{2} + 768 < W64.modulus); first by smt(@W64). -have iv : (good_io4x Glob.mem{2} (to_uint _iotas{2})); first by smt(@W64). -move : (loadlift_iotas Glob.mem{2} _iotas{2} (round{1}) iii iv) => ii. -rewrite (_:round{1} * 32 = 8*4*round{1}); first by smt(). -rewrite ii. simplify. smt(). -rewrite /good_iotas4x /iotas. -case (round{1} = 0); first by auto => />. -case (round{1} = 1). auto => />. smt(@W64). -case (round{1} = 2). auto => />. smt(@W64). -case (round{1} = 3). auto => />. smt(@W64). -case (round{1} = 4). auto => />. smt(@W64). -case (round{1} = 5). auto => />. smt(@W64). -case (round{1} = 6). auto => />. smt(@W64). -case (round{1} = 7). auto => />. smt(@W64). -case (round{1} = 8). auto => />. smt(@W64). -case (round{1} = 9). auto => />. smt(@W64). -case (round{1} = 10). auto => />. smt(@W64). -case (round{1} = 11). auto => />. smt(@W64). -case (round{1} = 12). auto => />. smt(@W64). -case (round{1} = 13). auto => />. smt(@W64). -case (round{1} = 14). auto => />. smt(@W64). -case (round{1} = 15). auto => />. smt(@W64). -case (round{1} = 16). auto => />. smt(@W64). -case (round{1} = 17). auto => />. smt(@W64). -case (round{1} = 18). auto => />. smt(@W64). -case (round{1} = 19). auto => />. smt(@W64). -case (round{1} = 20). auto => />. smt(@W64). -case (round{1} = 21). auto => />. smt(@W64). -case (round{1} = 22). auto => />. smt(@W64). -case (round{1} = 23). auto => />. smt(@W64). -smt(). - -have iii : (to_uint _iotas{2} + 768 < W64.modulus); first by smt(@W64). -have iv : (good_io4x Glob.mem{2} (to_uint _iotas{2})); first by smt(@W64). -move : (loadlift_iotas Glob.mem{2} _iotas{2} (round{1}) iii iv) => ii. -rewrite (_:round{1} * 32 = 8*4*round{1}); first by smt(). -rewrite ii. simplify. smt(). -rewrite /good_iotas4x /iotas. -case (round{1} = 0); first by auto => />. -case (round{1} = 1). auto => />. smt(@W64). -case (round{1} = 2). auto => />. smt(@W64). -case (round{1} = 3). auto => />. smt(@W64). -case (round{1} = 4). auto => />. smt(@W64). -case (round{1} = 5). auto => />. smt(@W64). -case (round{1} = 6). auto => />. smt(@W64). -case (round{1} = 7). auto => />. smt(@W64). -case (round{1} = 8). auto => />. smt(@W64). -case (round{1} = 9). auto => />. smt(@W64). -case (round{1} = 10). auto => />. smt(@W64). -case (round{1} = 11). auto => />. smt(@W64). -case (round{1} = 12). auto => />. smt(@W64). -case (round{1} = 13). auto => />. smt(@W64). -case (round{1} = 14). auto => />. smt(@W64). -case (round{1} = 15). auto => />. smt(@W64). -case (round{1} = 16). auto => />. smt(@W64). -case (round{1} = 17). auto => />. smt(@W64). -case (round{1} = 18). auto => />. smt(@W64). -case (round{1} = 19). auto => />. smt(@W64). -case (round{1} = 20). auto => />. smt(@W64). -case (round{1} = 21). auto => />. smt(@W64). -case (round{1} = 22). auto => />. smt(@W64). -case (round{1} = 23). auto => />. smt(@W64). -smt(). - -have iii : (to_uint _iotas{2} + 768 < W64.modulus); first by smt(@W64). -have iv : (good_io4x Glob.mem{2} (to_uint _iotas{2})); first by smt(@W64). -move : (loadlift_iotas Glob.mem{2} _iotas{2} (round{1}) iii iv) => ii. -rewrite (_:round{1} * 32 = 8*4*round{1}); first by smt(). -rewrite ii. simplify. smt(). -rewrite /good_iotas4x /iotas. -case (round{1} = 0); first by auto => />. -case (round{1} = 1). auto => />. smt(@W64). -case (round{1} = 2). auto => />. smt(@W64). -case (round{1} = 3). auto => />. smt(@W64). -case (round{1} = 4). auto => />. smt(@W64). -case (round{1} = 5). auto => />. smt(@W64). -case (round{1} = 6). auto => />. smt(@W64). -case (round{1} = 7). auto => />. smt(@W64). -case (round{1} = 8). auto => />. smt(@W64). -case (round{1} = 9). auto => />. smt(@W64). -case (round{1} = 10). auto => />. smt(@W64). -case (round{1} = 11). auto => />. smt(@W64). -case (round{1} = 12). auto => />. smt(@W64). -case (round{1} = 13). auto => />. smt(@W64). -case (round{1} = 14). auto => />. smt(@W64). -case (round{1} = 15). auto => />. smt(@W64). -case (round{1} = 16). auto => />. smt(@W64). -case (round{1} = 17). auto => />. smt(@W64). -case (round{1} = 18). auto => />. smt(@W64). -case (round{1} = 19). auto => />. smt(@W64). -case (round{1} = 20). auto => />. smt(@W64). -case (round{1} = 21). auto => />. smt(@W64). -case (round{1} = 22). auto => />. smt(@W64). -case (round{1} = 23). auto => />. smt(@W64). -smt(). - -have iii : (to_uint _iotas{2} + 768 < W64.modulus); first by smt(@W64). -have iv : (good_io4x Glob.mem{2} (to_uint _iotas{2})); first by smt(@W64). -move : (loadlift_iotas Glob.mem{2} _iotas{2} (round{1}) iii iv) => ii. -rewrite (_:round{1} * 32 = 8*4*round{1}); first by smt(). -rewrite ii. simplify. smt(). -rewrite /good_iotas4x /iotas. -case (round{1} = 0); first by auto => />. -case (round{1} = 1). auto => />. smt(@W64). -case (round{1} = 2). auto => />. smt(@W64). -case (round{1} = 3). auto => />. smt(@W64). -case (round{1} = 4). auto => />. smt(@W64). -case (round{1} = 5). auto => />. smt(@W64). -case (round{1} = 6). auto => />. smt(@W64). -case (round{1} = 7). auto => />. smt(@W64). -case (round{1} = 8). auto => />. smt(@W64). -case (round{1} = 9). auto => />. smt(@W64). -case (round{1} = 10). auto => />. smt(@W64). -case (round{1} = 11). auto => />. smt(@W64). -case (round{1} = 12). auto => />. smt(@W64). -case (round{1} = 13). auto => />. smt(@W64). -case (round{1} = 14). auto => />. smt(@W64). -case (round{1} = 15). auto => />. smt(@W64). -case (round{1} = 16). auto => />. smt(@W64). -case (round{1} = 17). auto => />. smt(@W64). -case (round{1} = 18). auto => />. smt(@W64). -case (round{1} = 19). auto => />. smt(@W64). -case (round{1} = 20). auto => />. smt(@W64). -case (round{1} = 21). auto => />. smt(@W64). -case (round{1} = 22). auto => />. smt(@W64). -case (round{1} = 23). auto => />. smt(@W64). +conseq />. +inline *; wp; skip => &1 &2 [#] 4!->> ???? ??? ->> ?? <<- ???? ->> ??. +cbv. +have -> : round{1} * 32 = 8*4*round{1}; 1: ring. +have -> /= := loadlift_iotas _ _ (round{1}) H5 H0; 1: smt(). +cbv index. +have -> : good_iotas4x.[round{1} * 4 + 3] = iotas.[round{1}]. ++ have : 1 <= round{1} < 24 by smt(). + by move /(mema_iota 1 23) => /> [#|] ->; cbv delta. +have -> : good_iotas4x.[round{1} * 4 + 2] = iotas.[round{1}]. ++ have : 1 <= round{1} < 24 by smt(). + by move /(mema_iota 1 23) => /> [#|] ->; cbv delta. +have -> : good_iotas4x.[round{1} * 4 + 1] = iotas.[round{1}]. ++ have : 1 <= round{1} < 24 by smt(). + by move /(mema_iota 1 23) => /> [#|] ->; cbv delta. +have -> : good_iotas4x.[round{1} * 4] = iotas.[round{1}]. ++ have : 1 <= round{1} < 24 by smt(). + by move /(mema_iota 1 23) => /> [#|] ->; cbv delta. smt(). -wp;skip;progress;smt(dec dec0 decK @W32). - -skip;progress. +conseq />. +wp;skip => />; smt(dec dec0 decK). -rewrite dec0. -split. rewrite to_uintD. smt(@W32). smt(@W32). -rewrite dec. rewrite to_uintD. smt(@W32). smt(@W32). - -move : H10. rewrite dec0. -rewrite to_uintD. smt(@W32). -rewrite dec. rewrite to_uintD. smt(@W32). -rewrite to_uintD. smt(@W32). +skip => |> *. +rewrite dec0 1:to_uintD_small /= 1,2:/# dec to_uintD_small /= /#. qed. - - From aed6ec33ab3235fdb55a495e959749ff263087b8 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Tue, 17 Sep 2019 15:59:06 +0200 Subject: [PATCH 484/525] fix intro pattern n? --- proof/SHA3OSecurity.ec | 36 ++++++++++----------- proof/SecureORO.eca | 2 +- proof/impl/perm/keccak_f1600_avx2_prevec.ec | 8 ++--- proof/smart_counter/Gext.eca | 2 +- proof/smart_counter/Handle.eca | 2 +- 5 files changed, 24 insertions(+), 26 deletions(-) diff --git a/proof/SHA3OSecurity.ec b/proof/SHA3OSecurity.ec index 1b70e92..c3fee79 100644 --- a/proof/SHA3OSecurity.ec +++ b/proof/SHA3OSecurity.ec @@ -350,7 +350,7 @@ if{2}; sp; last first. conseq(:_==> BIRO.IRO.mp{1} = mp{1} /\ size bs{1} = i{1} /\ i{1} = size_out /\ inv mp{1} RFList.m{2} /\ bs{1} = take i{1} (to_list (oget RFList.m{2}.[x{1}])))=> />. - - move=> &l &r 11?. + - move=> &l &r 12?. rewrite take_oversize 1:spec_dout 1:H4 //. rewrite eq_sym to_listK => ->. by have:=H3; rewrite domE; smt(). @@ -361,7 +361,7 @@ if{2}; sp; last first. bs{1} = take i{1} (to_list (oget RFList.m{2}.[x{1}])))(size_out - i{1}); auto=> />. + sp; rcondf 1; auto=> />; 1: smt(). - move=> &h 8?. + move=> &h 9?. rewrite size_rcons //=; do!split; 1, 2, 4: smt(size_ge0). rewrite (take_nth witness) 1:spec_dout 1:size_ge0//=. rewrite - H6; congr; rewrite H4=> //=. @@ -379,7 +379,7 @@ conseq(:_==> l{2} = bs{1} /\ size bs{1} = i{1} /\ i{1} = n{1} /\ (forall l j, l <> x{1} => m{1}.[(l,j)] = BIRO.IRO.mp{1}.[(l,j)]) /\ (forall j, 0 <= j < i{1} => (x{1}, j) \in BIRO.IRO.mp{1}) /\ (forall j, 0 <= j < i{1} => BIRO.IRO.mp{1}.[(x{1},j)] = Some (nth witness bs{1} j))). -+ move=> /> &l &r 11?; do!split; ..-2 : smt(domE mem_set). ++ move=> /> &l &r 12?; do!split; ..-2 : smt(domE mem_set). move=> l j Hin. rewrite get_setE/=. case: (l = x{r}) => [<<-|]. @@ -395,7 +395,7 @@ while(l{2} = bs{1} /\ size bs{1} = i{1} /\ 0 <= i{1} <= n{1} /\ ={i} /\ (forall j, 0 <= j < i{1} => BIRO.IRO.mp{1}.[(x{1},j)] = Some (nth witness bs{1} j))). + sp; rcondt{1} 1; auto=> />. - smt(). - move=> &l &r 13?. + move=> &l &r *. rewrite get_setE/=oget_some/=size_rcons/=; do!split; 1,2: smt(size_ge0). - smt(mem_set). - smt(get_setE). @@ -407,7 +407,6 @@ while(l{2} = bs{1} /\ size bs{1} = i{1} /\ 0 <= i{1} <= n{1} /\ ={i} /\ by auto; smt(size_out_gt0). qed. - op eq_extend_size (m1 : (bool list * int, bool) fmap) (m2 : (bool list * int, bool) fmap) (m3 : (bool list * int, bool) fmap) = (* (forall x j, (x,j) \in m2 => 0 <= j < size_out) /\ *) @@ -776,7 +775,7 @@ rcondf{2} 4; 1: auto. inline{2} 1; sp. rcondt{2} 1; 1: by auto; smt(divz_ge0 gt0_r size_ge0). auto; call eq_IRO_RFWhile; auto=> />. -move=> &l &r 13?; split; 2: smt(divz_ge0 gt0_r size_ge0). +move=> &l &r 14?; split; 2: smt(divz_ge0 gt0_r size_ge0). rewrite 2!oget_some cats0 take_oversize 1:/# take_oversize 1:spec_dout //=. have h:=spec2_dout result_L H5. have-> := some_oget _ h. @@ -816,7 +815,7 @@ seq 1 1 : (={glob A, glob SHA3Indiff.Simulator, glob SORO.Bounder, glob Counter, sp; if{1}. * rcondt{2} 2; auto; 1: smt(BlockSponge.parse_valid). rnd (fun l => oget (of_list l)) to_list; auto=> />. - move=> &l &r 10?; split; 1: smt(of_listK). + move=> &l &r 11?; split; 1: smt(of_listK). rewrite -dout_equal_dlist=> ?; split=> ?. + by rewrite dmapE=> h{h}; apply mu_eq=> x; smt(to_list_inj). move=> sample. @@ -830,7 +829,7 @@ seq 1 1 : (={glob A, glob SHA3Indiff.Simulator, glob SORO.Bounder, glob Counter, if{1}. * rcondt{2} 2; auto. rnd (fun l => oget (of_list l)) to_list; auto=> />. - move=> &l 4?; split=> ?; 1: smt(of_listK). + move=> &l *; split=> ?; 1: smt(of_listK). rewrite -dout_equal_dlist; split=> ?. * by rewrite dmapE=> h{h}; apply mu_eq=> x; smt(to_list_inj). move=> sample. @@ -859,7 +858,6 @@ if{1}. by auto=> />; smt(dout_ll). qed. - local lemma leq_ideal &m : Pr[SHA3_OIndiff.OIndif.OIndif(FSome(BIRO.IRO), OSimulator(FSome(BIRO.IRO)), ODRestr(Dist_of_P1Adv(A))).main() @ &m : res] <= (sigma + 1)%r / 2%r ^ size_out. @@ -1071,7 +1069,7 @@ if{2}; sp; last first. conseq(:_==> BIRO.IRO.mp{1} = mp{1} /\ size bs{1} = i{1} /\ i{1} = size_out /\ inv mp{1} RFList.m{2} /\ bs{1} = take i{1} (to_list (oget RFList.m{2}.[x{1}])))=> />. - - move=> &l &r 11?. + - move=> &l &r 12?. rewrite take_oversize 1:spec_dout 1:H4 //. rewrite eq_sym to_listK => ->. by have:=H3; rewrite domE; smt(). @@ -1082,7 +1080,7 @@ if{2}; sp; last first. bs{1} = take i{1} (to_list (oget RFList.m{2}.[x{1}])))(size_out - i{1}); auto=> />. + sp; rcondf 1; auto=> />; 1: smt(). - move=> &h 8?. + move=> &h 9?. rewrite size_rcons //=; do!split; 1, 2, 4: smt(size_ge0). rewrite (take_nth witness) 1:spec_dout 1:size_ge0//=. rewrite - H6; congr; rewrite H4=> //=. @@ -1100,7 +1098,7 @@ conseq(:_==> l{2} = bs{1} /\ size bs{1} = i{1} /\ i{1} = n{1} /\ (forall l j, l <> x{1} => m{1}.[(l,j)] = BIRO.IRO.mp{1}.[(l,j)]) /\ (forall j, 0 <= j < i{1} => (x{1}, j) \in BIRO.IRO.mp{1}) /\ (forall j, 0 <= j < i{1} => BIRO.IRO.mp{1}.[(x{1},j)] = Some (nth witness bs{1} j))). -+ move=> /> &l &r 11?; do!split; ..-2 : smt(domE mem_set). ++ move=> /> &l &r 12?; do!split; ..-2 : smt(domE mem_set). move=> l j Hin. rewrite get_setE/=. case: (l = x{r}) => [<<-|]. @@ -1611,7 +1609,7 @@ rcondf{2} 4; 1: auto. inline{2} 1; sp. rcondt{2} 1; 1: by auto; smt(divz_ge0 gt0_r size_ge0). auto; call eq_IRO_RFWhile; auto=> />. -move=> &l &r 13?; split; 2: smt(divz_ge0 gt0_r size_ge0). +move=> &l &r 14?; split; 2: smt(divz_ge0 gt0_r size_ge0). rewrite 2!oget_some cats0 take_oversize 1:/# take_oversize 1:spec_dout //=. have h:=spec2_dout result_L H5. have-> := some_oget _ h. @@ -1640,7 +1638,7 @@ seq 1 1 : (={glob A, glob SHA3Indiff.Simulator, glob SORO.Bounder, glob Counter, sp; if{1}. * rcondt{2} 2; auto; 1: smt(BlockSponge.parse_valid). rnd (fun l => oget (of_list l)) to_list; auto=> />. - move=> &l &r 10?; split; 1: smt(of_listK). + move=> &l &r 11?; split; 1: smt(of_listK). rewrite -dout_equal_dlist=> ?; split=> ?. + by rewrite dmapE=> h{h}; apply mu_eq=> x; smt(to_list_inj). move=> sample. @@ -1950,7 +1948,7 @@ if{2}; sp; last first. conseq(:_==> BIRO.IRO.mp{1} = mp{1} /\ size bs{1} = i{1} /\ i{1} = size_out /\ inv mp{1} RFList.m{2} /\ bs{1} = take i{1} (to_list (oget RFList.m{2}.[x{1}])))=> />. - - move=> &l &r 11?. + - move=> &l &r 12?. rewrite take_oversize 1:spec_dout 1:H4 //. rewrite eq_sym to_listK => ->. by have:=H3; rewrite domE; smt(). @@ -1961,7 +1959,7 @@ if{2}; sp; last first. bs{1} = take i{1} (to_list (oget RFList.m{2}.[x{1}])))(size_out - i{1}); auto=> />. + sp; rcondf 1; auto=> />; 1: smt(). - move=> &h 8?. + move=> &h 9?. rewrite size_rcons //=; do!split; 1, 2, 4: smt(size_ge0). rewrite (take_nth witness) 1:spec_dout 1:size_ge0//=. rewrite - H6; congr; rewrite H4=> //=. @@ -1979,7 +1977,7 @@ conseq(:_==> l{2} = bs{1} /\ size bs{1} = i{1} /\ i{1} = n{1} /\ (forall l j, l <> x{1} => m{1}.[(l,j)] = BIRO.IRO.mp{1}.[(l,j)]) /\ (forall j, 0 <= j < i{1} => (x{1}, j) \in BIRO.IRO.mp{1}) /\ (forall j, 0 <= j < i{1} => BIRO.IRO.mp{1}.[(x{1},j)] = Some (nth witness bs{1} j))). -+ move=> /> &l &r 11?; do!split; ..-2 : smt(domE mem_set). ++ move=> /> &l &r 12?; do!split; ..-2 : smt(domE mem_set). move=> l j Hin. rewrite get_setE/=. case: (l = x{r}) => [<<-|]. @@ -2484,7 +2482,7 @@ rcondf{2} 4; 1: auto. inline{2} 1; sp. rcondt{2} 1; 1: by auto; smt(divz_ge0 gt0_r size_ge0). auto; call eq_IRO_RFWhile; auto=> />. -move=> &l &r 13?; split; 2: smt(divz_ge0 gt0_r size_ge0). +move=> &l &r 14?; split; 2: smt(divz_ge0 gt0_r size_ge0). rewrite 2!oget_some cats0 take_oversize 1:/# take_oversize 1:spec_dout //=. have h:=spec2_dout result_L H5. have-> := some_oget _ h. @@ -2511,7 +2509,7 @@ seq 1 1 : (={glob A, glob SHA3Indiff.Simulator, glob SORO.Bounder, glob Counter, sp; if{1}. * rcondt{2} 2; auto; 1: smt(BlockSponge.parse_valid). rnd (fun l => oget (of_list l)) to_list; auto=> />. - move=> &l &r 10?; split; 1: smt(of_listK). + move=> &l &r 11?; split; 1: smt(of_listK). rewrite -dout_equal_dlist=> ?; split=> ?. + by rewrite dmapE=> h{h}; apply mu_eq=> x; smt(to_list_inj). move=> sample. diff --git a/proof/SecureORO.eca b/proof/SecureORO.eca index 949a009..cc8ac8f 100644 --- a/proof/SecureORO.eca +++ b/proof/SecureORO.eca @@ -171,7 +171,7 @@ section Preimage. - hoare; auto; progress. rewrite H3/=; move: H1; rewrite rngE /= negb_exists /=. by have:=H3; rewrite domE; smt(). - rnd (pred1 Preimage2.hash); auto=> /> &hr 6?. + rnd (pred1 Preimage2.hash); auto=> /> &hr *. rewrite (sampleto_fu Preimage2.hash{hr} witness)/= => ??. by rewrite get_setE /=; smt(). smt(). diff --git a/proof/impl/perm/keccak_f1600_avx2_prevec.ec b/proof/impl/perm/keccak_f1600_avx2_prevec.ec index ba2b056..5b33a47 100644 --- a/proof/impl/perm/keccak_f1600_avx2_prevec.ec +++ b/proof/impl/perm/keccak_f1600_avx2_prevec.ec @@ -702,7 +702,7 @@ seq 11 22 : (#{/~ state{1}}post /\ c{1} = W64.of_int 1 /\ equiv_states_chi a00{2} t{2}.[1] t{2}.[2] t{2}.[3] t{2}.[4] t{2}.[5] t{2}.[6] state0{1}). conseq />. do 13!(unroll for {1} ^while). -inline *; wp; skip => &1 &2 [#] 7!->> 7? ->> ?. +inline *; wp; skip => &1 &2 [#] 7!->> 8? ->> ?. cbv index rhotates. split; first by smt(rol0). split; first by smt(rol0). @@ -763,11 +763,11 @@ seq 5 53 : (#{~state0{1}}pre /\ equiv_states a00{2} a01{2} a20{2} a31{2} a21{2} a41{2} a11{2} state0{1}). + conseq />. do 11!(unroll for {1} ^while). - inline *; wp; skip => &1 &2 [#] 7!->> 7? ->> ?. + inline *; wp; skip => &1 &2 [#] 7!->> 8? ->> ?. cbv delta. smt (W64.xorwC W64.andwC). -inline *; wp;skip => &1 &2 [#] 7!->> 7? ->> ?. +inline *; wp;skip => &1 &2 [#] 7!->> 8? ->> ?. cbv index. have /= -> /= := loadlift_iotas _ _ 0 H6 H1 _; 1:done. rewrite /good_iotas4x /= /#. @@ -804,7 +804,7 @@ seq 9 29 : (#{/~state{1}}post /\ c{1} = constants{1}.[round{1}] /\ round{1} < 2 + conseq />. do 13!(unroll for {1} ^while). inline *; wp;skip. - move => &1 &2 [#] 7!->> 7? ->> ?? <<- ?????. + move => &1 &2 [#] 7!->> 8? ->> ?? <<- ?????. cbv delta. rewrite !rolcomp /(`>>`) /=. smt(W64.xorwA W64.xorwC W64.xorw0 W64.xorwK commor). diff --git a/proof/smart_counter/Gext.eca b/proof/smart_counter/Gext.eca index fbdec43..2e204bc 100644 --- a/proof/smart_counter/Gext.eca +++ b/proof/smart_counter/Gext.eca @@ -625,7 +625,7 @@ section EXT. + inline *;rcondt{1} 4;1:by auto=>/#. rcondt{2} 5;1:by auto;smt w=(size_ge0). rcondt{2} 10. by auto;progress;rewrite mem_set. - wp;rnd{2};auto=> /= ??[#]!-> @/inv_lt @/inv_le [#] mlt milt clt cle Hin 3?->/=. + wp;rnd{2};auto=> /= ??[#]!-> @/inv_lt @/inv_le [#] mlt milt clt cle Hin 3? -> /=. rewrite/Distr.is_lossless (sampleto_ll 0)/= => ? _;rewrite /bad_ext !get_setE /= !oget_some /= set_set_eqE //=. rewrite !(imageU,inE) restr_set /= size_rem dom_restr Hin //=; smt w=size_set_le. by call RROset_inv_lt;auto;smt w=size_set_le. diff --git a/proof/smart_counter/Handle.eca b/proof/smart_counter/Handle.eca index 87da3c0..d847652 100644 --- a/proof/smart_counter/Handle.eca +++ b/proof/smart_counter/Handle.eca @@ -1450,7 +1450,7 @@ case @[ambient]: {-1}(Pmi.[(xa,xc)]) (eq_refl Pmi.[(xa,xc)])=> [Pmi_xaxc|[ya yc] rewrite (@huniq_hinvK_h hx2) // oget_some /= => _ _ _ _. rewrite negb_and domE /=; left. by apply/(@notin_m_notin_mh hs Pmi _ _ xc _ Known)=> //; case: inv0. - auto=> ? ? [#] !<<- -> -> ->> _. + auto => ? ? [#] !<<- -> -> ->> _. rewrite (@huniq_hinvK_h hx2) // oget_some /= => y1 -> /= y2 -> /=. case: (hinvP hs y2)=> [_ y2_notrngE1_hs _ _|/#]. rewrite get_setE /= oget_some /=. From d9cf66210ba5b24705395763d603fcbb9e2d5173 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Thu, 19 Sep 2019 12:13:01 +0100 Subject: [PATCH 485/525] Importing .jazz, .s and .c wrappers from libjc git-read from github.com/tfaoliveira/libjc/tree/6fc8b105c794c49dfac462b1c42f633f68743e0c --- code/crypto_core/keccakf160064bits/.gitignore | 1 + .../keccakf160064bits/avx2/Makefile | 15 + .../keccakf160064bits/avx2/keccak_f1600.jahh | 8 + .../keccakf160064bits/avx2/keccak_f1600.jazz | 146 ++ .../avx2/keccak_f1600_export.jazz | 23 + .../avx2/keccak_f1600_export.s | 136 ++ .../keccakf160064bits/avx2_openssl/Makefile | 15 + .../avx2_openssl/keccak_f1600.jazz | 172 ++ .../avx2_openssl/keccak_f1600_export.jazz | 37 + .../avx2_openssl/keccak_f1600_export.s | 135 ++ .../keccakf160064bits/ref/Makefile | 15 + .../keccakf160064bits/ref/keccak_f1600.jazz | 212 +++ .../ref/keccak_f1600_export.jazz | 21 + .../ref/keccak_f1600_export.s | 9 + .../keccakf160064bits/scalar/Makefile | 15 + .../scalar/keccak_f1600.jahh | 43 + .../scalar/keccak_f1600.jazz | 187 ++ .../scalar/keccak_f1600_export.jazz | 22 + .../scalar/keccak_f1600_export.s | 13 + .../keccakf160064bits/scalar_g/Makefile | 15 + .../scalar_g/keccak_f1600.jahh | 43 + .../scalar_g/keccak_f1600.jazz | 212 +++ .../scalar_g/keccak_f1600_export.jazz | 21 + .../scalar_g/keccak_f1600_export.s | 221 +++ code/crypto_hash/keccak1600/avx2/Makefile | 12 + .../keccak1600/avx2/keccak_1600.japp | 450 +++++ .../keccak1600/avx2/keccak_1600.jazz | 306 ++++ code/crypto_hash/keccak1600/ref/Makefile | 12 + .../keccak1600/ref/keccak_1600.japp | 390 +++++ .../keccak1600/ref/keccak_1600.jazz | 291 ++++ code/crypto_hash/keccak1600/scalar/Makefile | 12 + .../keccak1600/scalar/keccak_1600.japp | 481 ++++++ .../keccak1600/scalar/keccak_1600.jazz | 344 ++++ code/crypto_hash/keccak1600/scalar_g/Makefile | 12 + .../keccak1600/scalar_g/keccak_1600.japp | 532 ++++++ .../keccak1600/scalar_g/keccak_1600.jazz | 292 ++++ code/crypto_hash/sha3224/.gitignore | 1 + code/crypto_hash/sha3224/avx2/Makefile | 15 + code/crypto_hash/sha3224/avx2/sha3224-m.c | 85 + code/crypto_hash/sha3224/avx2/sha3224.jazz | 66 + code/crypto_hash/sha3224/avx2/sha3224.s | 532 ++++++ code/crypto_hash/sha3224/scalar/Makefile | 15 + code/crypto_hash/sha3224/scalar/sha3224-m.c | 54 + code/crypto_hash/sha3224/scalar/sha3224.jazz | 1 + code/crypto_hash/sha3224/scalar/sha3224.s | 1299 ++++++++++++++ code/crypto_hash/sha3256/.gitignore | 1 + code/crypto_hash/sha3256/avx2/Makefile | 15 + code/crypto_hash/sha3256/avx2/sha3256-m.c | 85 + code/crypto_hash/sha3256/avx2/sha3256.jazz | 63 + code/crypto_hash/sha3256/avx2/sha3256.s | 531 ++++++ code/crypto_hash/sha3256/scalar/Makefile | 15 + code/crypto_hash/sha3256/scalar/sha3256-m.c | 54 + code/crypto_hash/sha3256/scalar/sha3256.jazz | 1 + code/crypto_hash/sha3256/scalar/sha3256.s | 1299 ++++++++++++++ code/crypto_hash/sha3384/.gitignore | 1 + code/crypto_hash/sha3384/avx2/Makefile | 15 + code/crypto_hash/sha3384/avx2/sha3384-m.c | 85 + code/crypto_hash/sha3384/avx2/sha3384.jazz | 61 + code/crypto_hash/sha3384/avx2/sha3384.s | 528 ++++++ code/crypto_hash/sha3384/scalar/Makefile | 15 + code/crypto_hash/sha3384/scalar/sha3384-m.c | 54 + code/crypto_hash/sha3384/scalar/sha3384.jazz | 1 + code/crypto_hash/sha3384/scalar/sha3384.s | 1299 ++++++++++++++ code/crypto_hash/sha3512/.gitignore | 1 + code/crypto_hash/sha3512/avx2/Makefile | 15 + code/crypto_hash/sha3512/avx2/sha3512-m.c | 85 + code/crypto_hash/sha3512/avx2/sha3512.jazz | 43 + code/crypto_hash/sha3512/avx2/sha3512.s | 519 ++++++ code/crypto_hash/sha3512/scalar/Makefile | 15 + code/crypto_hash/sha3512/scalar/sha3512-m.c | 54 + code/crypto_hash/sha3512/scalar/sha3512.jazz | 1 + code/crypto_hash/sha3512/scalar/sha3512.s | 1299 ++++++++++++++ code/crypto_hash/shake128/.gitignore | 1 + code/crypto_hash/shake128/avx2/Makefile | 15 + code/crypto_hash/shake128/avx2/shake128-m.c | 85 + code/crypto_hash/shake128/avx2/shake128.jazz | 67 + code/crypto_hash/shake128/avx2/shake128.s | 533 ++++++ code/crypto_hash/shake128/scalar/Makefile | 15 + code/crypto_hash/shake128/scalar/shake128-m.c | 55 + .../crypto_hash/shake128/scalar/shake128.jazz | 1 + code/crypto_hash/shake128/scalar/shake128.s | 1299 ++++++++++++++ code/crypto_hash/shake256/.gitignore | 1 + code/crypto_hash/shake256/avx2/Makefile | 24 + code/crypto_hash/shake256/avx2/shake256-m.c | 85 + code/crypto_hash/shake256/avx2/shake256.japp | 451 +++++ code/crypto_hash/shake256/avx2/shake256.jazz | 65 + code/crypto_hash/shake256/avx2/shake256.s | 529 ++++++ code/crypto_hash/shake256/ref/.gitignore | 2 + code/crypto_hash/shake256/ref/Makefile | 15 + code/crypto_hash/shake256/ref/shake256-m.c | 22 + code/crypto_hash/shake256/ref/shake256.jazz | 1 + code/crypto_hash/shake256/scalar/Makefile | 15 + code/crypto_hash/shake256/scalar/shake256-m.c | 54 + .../crypto_hash/shake256/scalar/shake256.japp | 481 ++++++ .../crypto_hash/shake256/scalar/shake256.jazz | 1 + code/crypto_hash/shake256/scalar/shake256.s | 1299 ++++++++++++++ code/crypto_hash/shake256/scalar_g/Makefile | 15 + .../shake256/scalar_g/shake256-m.c | 23 + .../shake256/scalar_g/shake256.japp | 500 ++++++ .../shake256/scalar_g/shake256.jazz | 1 + code/crypto_hash/shake256/scalar_g/shake256.s | 1504 +++++++++++++++++ 101 files changed, 20253 insertions(+) create mode 100644 code/crypto_core/keccakf160064bits/.gitignore create mode 100644 code/crypto_core/keccakf160064bits/avx2/Makefile create mode 100644 code/crypto_core/keccakf160064bits/avx2/keccak_f1600.jahh create mode 100644 code/crypto_core/keccakf160064bits/avx2/keccak_f1600.jazz create mode 100644 code/crypto_core/keccakf160064bits/avx2/keccak_f1600_export.jazz create mode 100644 code/crypto_core/keccakf160064bits/avx2/keccak_f1600_export.s create mode 100644 code/crypto_core/keccakf160064bits/avx2_openssl/Makefile create mode 100644 code/crypto_core/keccakf160064bits/avx2_openssl/keccak_f1600.jazz create mode 100644 code/crypto_core/keccakf160064bits/avx2_openssl/keccak_f1600_export.jazz create mode 100644 code/crypto_core/keccakf160064bits/avx2_openssl/keccak_f1600_export.s create mode 100644 code/crypto_core/keccakf160064bits/ref/Makefile create mode 100644 code/crypto_core/keccakf160064bits/ref/keccak_f1600.jazz create mode 100644 code/crypto_core/keccakf160064bits/ref/keccak_f1600_export.jazz create mode 100644 code/crypto_core/keccakf160064bits/ref/keccak_f1600_export.s create mode 100644 code/crypto_core/keccakf160064bits/scalar/Makefile create mode 100644 code/crypto_core/keccakf160064bits/scalar/keccak_f1600.jahh create mode 100644 code/crypto_core/keccakf160064bits/scalar/keccak_f1600.jazz create mode 100644 code/crypto_core/keccakf160064bits/scalar/keccak_f1600_export.jazz create mode 100644 code/crypto_core/keccakf160064bits/scalar/keccak_f1600_export.s create mode 100644 code/crypto_core/keccakf160064bits/scalar_g/Makefile create mode 100644 code/crypto_core/keccakf160064bits/scalar_g/keccak_f1600.jahh create mode 100644 code/crypto_core/keccakf160064bits/scalar_g/keccak_f1600.jazz create mode 100644 code/crypto_core/keccakf160064bits/scalar_g/keccak_f1600_export.jazz create mode 100644 code/crypto_core/keccakf160064bits/scalar_g/keccak_f1600_export.s create mode 100644 code/crypto_hash/keccak1600/avx2/Makefile create mode 100644 code/crypto_hash/keccak1600/avx2/keccak_1600.japp create mode 100644 code/crypto_hash/keccak1600/avx2/keccak_1600.jazz create mode 100644 code/crypto_hash/keccak1600/ref/Makefile create mode 100644 code/crypto_hash/keccak1600/ref/keccak_1600.japp create mode 100644 code/crypto_hash/keccak1600/ref/keccak_1600.jazz create mode 100644 code/crypto_hash/keccak1600/scalar/Makefile create mode 100644 code/crypto_hash/keccak1600/scalar/keccak_1600.japp create mode 100644 code/crypto_hash/keccak1600/scalar/keccak_1600.jazz create mode 100644 code/crypto_hash/keccak1600/scalar_g/Makefile create mode 100644 code/crypto_hash/keccak1600/scalar_g/keccak_1600.japp create mode 100644 code/crypto_hash/keccak1600/scalar_g/keccak_1600.jazz create mode 100644 code/crypto_hash/sha3224/.gitignore create mode 100644 code/crypto_hash/sha3224/avx2/Makefile create mode 100644 code/crypto_hash/sha3224/avx2/sha3224-m.c create mode 100644 code/crypto_hash/sha3224/avx2/sha3224.jazz create mode 100644 code/crypto_hash/sha3224/avx2/sha3224.s create mode 100644 code/crypto_hash/sha3224/scalar/Makefile create mode 100644 code/crypto_hash/sha3224/scalar/sha3224-m.c create mode 100644 code/crypto_hash/sha3224/scalar/sha3224.jazz create mode 100644 code/crypto_hash/sha3224/scalar/sha3224.s create mode 100644 code/crypto_hash/sha3256/.gitignore create mode 100644 code/crypto_hash/sha3256/avx2/Makefile create mode 100644 code/crypto_hash/sha3256/avx2/sha3256-m.c create mode 100644 code/crypto_hash/sha3256/avx2/sha3256.jazz create mode 100644 code/crypto_hash/sha3256/avx2/sha3256.s create mode 100644 code/crypto_hash/sha3256/scalar/Makefile create mode 100644 code/crypto_hash/sha3256/scalar/sha3256-m.c create mode 100644 code/crypto_hash/sha3256/scalar/sha3256.jazz create mode 100644 code/crypto_hash/sha3256/scalar/sha3256.s create mode 100644 code/crypto_hash/sha3384/.gitignore create mode 100644 code/crypto_hash/sha3384/avx2/Makefile create mode 100644 code/crypto_hash/sha3384/avx2/sha3384-m.c create mode 100644 code/crypto_hash/sha3384/avx2/sha3384.jazz create mode 100644 code/crypto_hash/sha3384/avx2/sha3384.s create mode 100644 code/crypto_hash/sha3384/scalar/Makefile create mode 100644 code/crypto_hash/sha3384/scalar/sha3384-m.c create mode 100644 code/crypto_hash/sha3384/scalar/sha3384.jazz create mode 100644 code/crypto_hash/sha3384/scalar/sha3384.s create mode 100644 code/crypto_hash/sha3512/.gitignore create mode 100644 code/crypto_hash/sha3512/avx2/Makefile create mode 100644 code/crypto_hash/sha3512/avx2/sha3512-m.c create mode 100644 code/crypto_hash/sha3512/avx2/sha3512.jazz create mode 100644 code/crypto_hash/sha3512/avx2/sha3512.s create mode 100644 code/crypto_hash/sha3512/scalar/Makefile create mode 100644 code/crypto_hash/sha3512/scalar/sha3512-m.c create mode 100644 code/crypto_hash/sha3512/scalar/sha3512.jazz create mode 100644 code/crypto_hash/sha3512/scalar/sha3512.s create mode 100644 code/crypto_hash/shake128/.gitignore create mode 100644 code/crypto_hash/shake128/avx2/Makefile create mode 100644 code/crypto_hash/shake128/avx2/shake128-m.c create mode 100644 code/crypto_hash/shake128/avx2/shake128.jazz create mode 100644 code/crypto_hash/shake128/avx2/shake128.s create mode 100644 code/crypto_hash/shake128/scalar/Makefile create mode 100644 code/crypto_hash/shake128/scalar/shake128-m.c create mode 100644 code/crypto_hash/shake128/scalar/shake128.jazz create mode 100644 code/crypto_hash/shake128/scalar/shake128.s create mode 100644 code/crypto_hash/shake256/.gitignore create mode 100644 code/crypto_hash/shake256/avx2/Makefile create mode 100644 code/crypto_hash/shake256/avx2/shake256-m.c create mode 100644 code/crypto_hash/shake256/avx2/shake256.japp create mode 100644 code/crypto_hash/shake256/avx2/shake256.jazz create mode 100644 code/crypto_hash/shake256/avx2/shake256.s create mode 100644 code/crypto_hash/shake256/ref/.gitignore create mode 100644 code/crypto_hash/shake256/ref/Makefile create mode 100644 code/crypto_hash/shake256/ref/shake256-m.c create mode 100644 code/crypto_hash/shake256/ref/shake256.jazz create mode 100644 code/crypto_hash/shake256/scalar/Makefile create mode 100644 code/crypto_hash/shake256/scalar/shake256-m.c create mode 100644 code/crypto_hash/shake256/scalar/shake256.japp create mode 100644 code/crypto_hash/shake256/scalar/shake256.jazz create mode 100644 code/crypto_hash/shake256/scalar/shake256.s create mode 100644 code/crypto_hash/shake256/scalar_g/Makefile create mode 100644 code/crypto_hash/shake256/scalar_g/shake256-m.c create mode 100644 code/crypto_hash/shake256/scalar_g/shake256.japp create mode 100644 code/crypto_hash/shake256/scalar_g/shake256.jazz create mode 100644 code/crypto_hash/shake256/scalar_g/shake256.s diff --git a/code/crypto_core/keccakf160064bits/.gitignore b/code/crypto_core/keccakf160064bits/.gitignore new file mode 100644 index 0000000..ad1a23f --- /dev/null +++ b/code/crypto_core/keccakf160064bits/.gitignore @@ -0,0 +1 @@ +*.japp diff --git a/code/crypto_core/keccakf160064bits/avx2/Makefile b/code/crypto_core/keccakf160064bits/avx2/Makefile new file mode 100644 index 0000000..5b25fdc --- /dev/null +++ b/code/crypto_core/keccakf160064bits/avx2/Makefile @@ -0,0 +1,15 @@ +# -*- Makefile -*- + +.PHONY: default clean + +default: keccak_f1600_export.japp keccak_f1600_export.s + @true + +clean: + rm -f keccak_f1600_export.japp keccak_f1600_export.s + +%.s: %.japp + jasminc -lea -pasm $< > $@ || rm -f $@ + +%.japp: %.jazz + gpp -I../../../ -o $@ $< diff --git a/code/crypto_core/keccakf160064bits/avx2/keccak_f1600.jahh b/code/crypto_core/keccakf160064bits/avx2/keccak_f1600.jahh new file mode 100644 index 0000000..ff52c7d --- /dev/null +++ b/code/crypto_core/keccakf160064bits/avx2/keccak_f1600.jahh @@ -0,0 +1,8 @@ +#ifndef KECCAK_AVX2_H +#define KECCAK_AVX2_H + +#define B(base,x) [base + 8*(x)] +#define B8(base,x) (u8)[base + (x)] +#define B256(base,x,o) (u256)[base + 32*(x) - o] + +#endif diff --git a/code/crypto_core/keccakf160064bits/avx2/keccak_f1600.jazz b/code/crypto_core/keccakf160064bits/avx2/keccak_f1600.jazz new file mode 100644 index 0000000..1213e3a --- /dev/null +++ b/code/crypto_core/keccakf160064bits/avx2/keccak_f1600.jazz @@ -0,0 +1,146 @@ +#include "crypto_core/keccakf160064bits/avx2/keccak_f1600.jahh" + + +fn __keccak_f1600_avx2( + reg u256[7] state, + reg u64 _rhotates_left, + reg u64 _rhotates_right, + reg u64 _iotas +) -> reg u256[7] +{ + reg u256[9] t; + reg u256 c00 c14 d00 d14; + + reg bool zf; + reg u32 r; + reg u64 rhotates_left; + reg u64 rhotates_right; + reg u64 iotas; + + rhotates_left = _rhotates_left + 96; + rhotates_right = _rhotates_right + 96; + iotas = _iotas; + + r = 24; + align while + { + + //######################################## Theta + c00 = #x86_VPSHUFD_256(state[2], (4u2)[1,0,3,2]); + c14 = state[5] ^ state[3]; + t[2] = state[4] ^ state[6]; + c14 = c14 ^ state[1]; + c14 = c14 ^ t[2]; + t[4] = #x86_VPERMQ(c14, (4u2)[2,1,0,3]); + c00 = c00 ^ state[2]; + t[0] = #x86_VPERMQ(c00, (4u2)[1,0,3,2]); + t[1] = c14 >>4u64 63; + t[2] = c14 +4u64 c14; + t[1] = t[1] | t[2]; + d14 = #x86_VPERMQ(t[1], (4u2)[0,3,2,1]); + d00 = t[1] ^ t[4]; + d00 = #x86_VPERMQ(d00, (4u2)[0,0,0,0]); + c00 = c00 ^ state[0]; + c00 = c00 ^ t[0]; + t[0] = c00 >>4u64 63; + t[1] = c00 +4u64 c00; + t[1] = t[1] | t[0]; + state[2] = state[2] ^ d00; + state[0] = state[0] ^ d00; + d14 = #x86_VPBLENDD_256(d14, t[1], (8u1)[1,1,0,0,0,0,0,0]); + t[4] = #x86_VPBLENDD_256(t[4], c00, (8u1)[0,0,0,0,0,0,1,1]); + d14 = d14 ^ t[4]; + + //######################################## Rho + Pi + pre-Chi shuffle + t[3] = #x86_VPSLLV_4u64(state[2], B256(rhotates_left,0,96) ); + state[2] = #x86_VPSRLV_4u64(state[2], B256(rhotates_right,0,96) ); + state[2] = state[2] | t[3]; + state[3] = state[3] ^ d14; + t[4] = #x86_VPSLLV_4u64(state[3], B256(rhotates_left,2,96) ); + state[3] = #x86_VPSRLV_4u64(state[3], B256(rhotates_right,2,96) ); + state[3] = state[3] | t[4]; + state[4] = state[4] ^ d14; + t[5] = #x86_VPSLLV_4u64(state[4], B256(rhotates_left,3,96) ); + state[4] = #x86_VPSRLV_4u64(state[4], B256(rhotates_right,3,96) ); + state[4] = state[4] | t[5]; + state[5] = state[5] ^ d14; + t[6] = #x86_VPSLLV_4u64(state[5], B256(rhotates_left,4,96) ); + state[5] = #x86_VPSRLV_4u64(state[5], B256(rhotates_right,4,96) ); + state[5] = state[5] | t[6]; + state[6] = state[6] ^ d14; + t[3] = #x86_VPERMQ(state[2], (4u2)[2,0,3,1]); + t[4] = #x86_VPERMQ(state[3], (4u2)[2,0,3,1]); + t[7] = #x86_VPSLLV_4u64(state[6], B256(rhotates_left,5,96) ); + t[1] = #x86_VPSRLV_4u64(state[6], B256(rhotates_right,5,96) ); + t[1] = t[1] | t[7]; + state[1] = state[1] ^ d14; + t[5] = #x86_VPERMQ(state[4], (4u2)[0,1,2,3]); + t[6] = #x86_VPERMQ(state[5], (4u2)[1,3,0,2]); + t[8] = #x86_VPSLLV_4u64(state[1], B256(rhotates_left,1,96) ); + t[2] = #x86_VPSRLV_4u64(state[1], B256(rhotates_right,1,96) ); + t[2] = t[2] | t[8]; + + //######################################## Chi + t[7] = #x86_VPSRLDQ_256(t[1], 8); + t[0] = !t[1] & t[7]; + state[3] = #x86_VPBLENDD_256(t[2], t[6], (8u1)[0,0,0,0,1,1,0,0]); + t[8] = #x86_VPBLENDD_256(t[4], t[2], (8u1)[0,0,0,0,1,1,0,0]); + state[5] = #x86_VPBLENDD_256(t[3], t[4], (8u1)[0,0,0,0,1,1,0,0]); + t[7] = #x86_VPBLENDD_256(t[2], t[3], (8u1)[0,0,0,0,1,1,0,0]); + state[3] = #x86_VPBLENDD_256(state[3], t[4], (8u1)[0,0,1,1,0,0,0,0]); + t[8] = #x86_VPBLENDD_256(t[8], t[5], (8u1)[0,0,1,1,0,0,0,0]); + state[5] = #x86_VPBLENDD_256(state[5], t[2], (8u1)[0,0,1,1,0,0,0,0]); + t[7] = #x86_VPBLENDD_256(t[7], t[6], (8u1)[0,0,1,1,0,0,0,0]); + state[3] = #x86_VPBLENDD_256(state[3], t[5], (8u1)[1,1,0,0,0,0,0,0]); + t[8] = #x86_VPBLENDD_256(t[8], t[6], (8u1)[1,1,0,0,0,0,0,0]); + state[5] = #x86_VPBLENDD_256(state[5], t[6], (8u1)[1,1,0,0,0,0,0,0]); + t[7] = #x86_VPBLENDD_256(t[7], t[4], (8u1)[1,1,0,0,0,0,0,0]); + state[3] = !state[3] & t[8]; + state[5] = !state[5] & t[7]; + state[6] = #x86_VPBLENDD_256(t[5], t[2], (8u1)[0,0,0,0,1,1,0,0]); + t[8] = #x86_VPBLENDD_256(t[3], t[5], (8u1)[0,0,0,0,1,1,0,0]); + state[3] = state[3] ^ t[3]; + state[6] = #x86_VPBLENDD_256(state[6], t[3], (8u1)[0,0,1,1,0,0,0,0]); + t[8] = #x86_VPBLENDD_256(t[8], t[4], (8u1)[0,0,1,1,0,0,0,0]); + state[5] = state[5] ^ t[5]; + state[6] = #x86_VPBLENDD_256(state[6], t[4], (8u1)[1,1,0,0,0,0,0,0]); + t[8] = #x86_VPBLENDD_256(t[8], t[2], (8u1)[1,1,0,0,0,0,0,0]); + state[6] = !state[6] & t[8]; + state[6] = state[6] ^ t[6]; + state[4] = #x86_VPERMQ(t[1], (4u2)[0,1,3,2]); + t[8] = #x86_VPBLENDD_256(state[4], state[0], (8u1)[0,0,1,1,0,0,0,0]); + state[1] = #x86_VPERMQ(t[1], (4u2)[0,3,2,1]); + state[1] = #x86_VPBLENDD_256(state[1], state[0], (8u1)[1,1,0,0,0,0,0,0]); + state[1] = !state[1] & t[8]; + state[2] = #x86_VPBLENDD_256(t[4], t[5], (8u1)[0,0,0,0,1,1,0,0]); + t[7] = #x86_VPBLENDD_256(t[6], t[4], (8u1)[0,0,0,0,1,1,0,0]); + state[2] = #x86_VPBLENDD_256(state[2], t[6], (8u1)[0,0,1,1,0,0,0,0]); + t[7] = #x86_VPBLENDD_256(t[7], t[3], (8u1)[0,0,1,1,0,0,0,0]); + state[2] = #x86_VPBLENDD_256(state[2], t[3], (8u1)[1,1,0,0,0,0,0,0]); + t[7] = #x86_VPBLENDD_256(t[7], t[5], (8u1)[1,1,0,0,0,0,0,0]); + state[2] = !state[2] & t[7]; + state[2] = state[2] ^ t[2]; + t[0] = #x86_VPERMQ(t[0], (4u2)[0,0,0,0]); + state[3] = #x86_VPERMQ(state[3], (4u2)[0,1,2,3]); + state[5] = #x86_VPERMQ(state[5], (4u2)[2,0,3,1]); + state[6] = #x86_VPERMQ(state[6], (4u2)[1,3,0,2]); + state[4] = #x86_VPBLENDD_256(t[6], t[3], (8u1)[0,0,0,0,1,1,0,0]); + t[7] = #x86_VPBLENDD_256(t[5], t[6], (8u1)[0,0,0,0,1,1,0,0]); + state[4] = #x86_VPBLENDD_256(state[4], t[5], (8u1)[0,0,1,1,0,0,0,0]); + t[7] = #x86_VPBLENDD_256(t[7], t[2], (8u1)[0,0,1,1,0,0,0,0]); + state[4] = #x86_VPBLENDD_256(state[4], t[2], (8u1)[1,1,0,0,0,0,0,0]); + t[7] = #x86_VPBLENDD_256(t[7], t[3], (8u1)[1,1,0,0,0,0,0,0]); + state[4] = !state[4] & t[7]; + state[0] = state[0] ^ t[0]; + state[1] = state[1] ^ t[1]; + state[4] = state[4] ^ t[4]; + + //######################################## Iota + state[0] = state[0] ^ B256(iotas,0,0); + + iotas = iotas + 32; + (_,_,_,zf,r) = #x86_DEC_32(r); + } (!zf) + + return state; +} diff --git a/code/crypto_core/keccakf160064bits/avx2/keccak_f1600_export.jazz b/code/crypto_core/keccakf160064bits/avx2/keccak_f1600_export.jazz new file mode 100644 index 0000000..7dbd49a --- /dev/null +++ b/code/crypto_core/keccakf160064bits/avx2/keccak_f1600_export.jazz @@ -0,0 +1,23 @@ +#include "crypto_core/keccakf160064bits/avx2/keccak_f1600.jazz" + +// +// TODO : rewrite to match crypto_core +// +export fn keccak_f1600( + reg u64 in + _rhotates_left + _rhotates_right + _iotas +) +{ + inline int i; + reg u256[7] state; + + for i=0 to 7 + { state[i] = (u256)[in + 32*i]; } + + state = __keccak_f1600_avx2(state, _rhotates_left, _rhotates_right, _iotas); + + for i=0 to 7 + { (u256)[in + 32*i] = state[i]; } +} diff --git a/code/crypto_core/keccakf160064bits/avx2/keccak_f1600_export.s b/code/crypto_core/keccakf160064bits/avx2/keccak_f1600_export.s new file mode 100644 index 0000000..05abbd4 --- /dev/null +++ b/code/crypto_core/keccakf160064bits/avx2/keccak_f1600_export.s @@ -0,0 +1,136 @@ + .text + .p2align 5 + .globl _keccak_f1600 + .globl keccak_f1600 +_keccak_f1600: +keccak_f1600: + pushq %rbp + vmovdqu (%rdi), %ymm0 + vmovdqu 32(%rdi), %ymm1 + vmovdqu 64(%rdi), %ymm2 + vmovdqu 96(%rdi), %ymm3 + vmovdqu 128(%rdi), %ymm4 + vmovdqu 160(%rdi), %ymm5 + vmovdqu 192(%rdi), %ymm6 + leaq 96(%rsi), %rax + leaq 96(%rdx), %rdx + movl $24, %esi + .p2align 5 +Lkeccak_f1600$1: + vpshufd $78, %ymm2, %ymm7 + vpxor %ymm3, %ymm5, %ymm8 + vpxor %ymm6, %ymm4, %ymm9 + vpxor %ymm1, %ymm8, %ymm8 + vpxor %ymm9, %ymm8, %ymm8 + vpermq $-109, %ymm8, %ymm9 + vpxor %ymm2, %ymm7, %ymm7 + vpermq $78, %ymm7, %ymm10 + vpsrlq $63, %ymm8, %ymm11 + vpaddq %ymm8, %ymm8, %ymm8 + vpor %ymm8, %ymm11, %ymm8 + vpermq $57, %ymm8, %ymm11 + vpxor %ymm9, %ymm8, %ymm8 + vpermq $0, %ymm8, %ymm8 + vpxor %ymm0, %ymm7, %ymm7 + vpxor %ymm10, %ymm7, %ymm7 + vpsrlq $63, %ymm7, %ymm10 + vpaddq %ymm7, %ymm7, %ymm12 + vpor %ymm10, %ymm12, %ymm10 + vpxor %ymm8, %ymm2, %ymm2 + vpxor %ymm8, %ymm0, %ymm0 + vpblendd $-64, %ymm10, %ymm11, %ymm8 + vpblendd $3, %ymm7, %ymm9, %ymm7 + vpxor %ymm7, %ymm8, %ymm7 + vpsllvq -96(%rax), %ymm2, %ymm8 + vpsrlvq -96(%rdx), %ymm2, %ymm2 + vpor %ymm8, %ymm2, %ymm2 + vpxor %ymm7, %ymm3, %ymm3 + vpsllvq -32(%rax), %ymm3, %ymm8 + vpsrlvq -32(%rdx), %ymm3, %ymm3 + vpor %ymm8, %ymm3, %ymm3 + vpxor %ymm7, %ymm4, %ymm4 + vpsllvq (%rax), %ymm4, %ymm8 + vpsrlvq (%rdx), %ymm4, %ymm4 + vpor %ymm8, %ymm4, %ymm4 + vpxor %ymm7, %ymm5, %ymm5 + vpsllvq 32(%rax), %ymm5, %ymm8 + vpsrlvq 32(%rdx), %ymm5, %ymm5 + vpor %ymm8, %ymm5, %ymm5 + vpxor %ymm7, %ymm6, %ymm6 + vpermq $-115, %ymm2, %ymm8 + vpermq $-115, %ymm3, %ymm9 + vpsllvq 64(%rax), %ymm6, %ymm2 + vpsrlvq 64(%rdx), %ymm6, %ymm3 + vpor %ymm2, %ymm3, %ymm10 + vpxor %ymm7, %ymm1, %ymm1 + vpermq $27, %ymm4, %ymm4 + vpermq $114, %ymm5, %ymm7 + vpsllvq -64(%rax), %ymm1, %ymm2 + vpsrlvq -64(%rdx), %ymm1, %ymm1 + vpor %ymm2, %ymm1, %ymm1 + vpsrldq $8, %ymm10, %ymm2 + vpandn %ymm2, %ymm10, %ymm3 + vpblendd $12, %ymm7, %ymm1, %ymm2 + vpblendd $12, %ymm1, %ymm9, %ymm5 + vpblendd $12, %ymm9, %ymm8, %ymm6 + vpblendd $12, %ymm8, %ymm1, %ymm11 + vpblendd $48, %ymm9, %ymm2, %ymm2 + vpblendd $48, %ymm4, %ymm5, %ymm5 + vpblendd $48, %ymm1, %ymm6, %ymm6 + vpblendd $48, %ymm7, %ymm11, %ymm11 + vpblendd $-64, %ymm4, %ymm2, %ymm2 + vpblendd $-64, %ymm7, %ymm5, %ymm5 + vpblendd $-64, %ymm7, %ymm6, %ymm6 + vpblendd $-64, %ymm9, %ymm11, %ymm11 + vpandn %ymm5, %ymm2, %ymm2 + vpandn %ymm11, %ymm6, %ymm5 + vpblendd $12, %ymm1, %ymm4, %ymm6 + vpblendd $12, %ymm4, %ymm8, %ymm11 + vpxor %ymm8, %ymm2, %ymm12 + vpblendd $48, %ymm8, %ymm6, %ymm2 + vpblendd $48, %ymm9, %ymm11, %ymm6 + vpxor %ymm4, %ymm5, %ymm5 + vpblendd $-64, %ymm9, %ymm2, %ymm2 + vpblendd $-64, %ymm1, %ymm6, %ymm6 + vpandn %ymm6, %ymm2, %ymm2 + vpxor %ymm7, %ymm2, %ymm6 + vpermq $30, %ymm10, %ymm2 + vpblendd $48, %ymm0, %ymm2, %ymm2 + vpermq $57, %ymm10, %ymm11 + vpblendd $-64, %ymm0, %ymm11, %ymm11 + vpandn %ymm2, %ymm11, %ymm11 + vpblendd $12, %ymm4, %ymm9, %ymm2 + vpblendd $12, %ymm9, %ymm7, %ymm13 + vpblendd $48, %ymm7, %ymm2, %ymm2 + vpblendd $48, %ymm8, %ymm13, %ymm13 + vpblendd $-64, %ymm8, %ymm2, %ymm2 + vpblendd $-64, %ymm4, %ymm13, %ymm13 + vpandn %ymm13, %ymm2, %ymm2 + vpxor %ymm1, %ymm2, %ymm2 + vpermq $0, %ymm3, %ymm13 + vpermq $27, %ymm12, %ymm3 + vpermq $-115, %ymm5, %ymm5 + vpermq $114, %ymm6, %ymm6 + vpblendd $12, %ymm8, %ymm7, %ymm12 + vpblendd $12, %ymm7, %ymm4, %ymm7 + vpblendd $48, %ymm4, %ymm12, %ymm4 + vpblendd $48, %ymm1, %ymm7, %ymm7 + vpblendd $-64, %ymm1, %ymm4, %ymm1 + vpblendd $-64, %ymm8, %ymm7, %ymm4 + vpandn %ymm4, %ymm1, %ymm4 + vpxor %ymm13, %ymm0, %ymm0 + vpxor %ymm10, %ymm11, %ymm1 + vpxor %ymm9, %ymm4, %ymm4 + vpxor (%rcx), %ymm0, %ymm0 + leaq 32(%rcx), %rcx + decl %esi + jne Lkeccak_f1600$1 + vmovdqu %ymm0, (%rdi) + vmovdqu %ymm1, 32(%rdi) + vmovdqu %ymm2, 64(%rdi) + vmovdqu %ymm3, 96(%rdi) + vmovdqu %ymm4, 128(%rdi) + vmovdqu %ymm5, 160(%rdi) + vmovdqu %ymm6, 192(%rdi) + popq %rbp + ret diff --git a/code/crypto_core/keccakf160064bits/avx2_openssl/Makefile b/code/crypto_core/keccakf160064bits/avx2_openssl/Makefile new file mode 100644 index 0000000..5b25fdc --- /dev/null +++ b/code/crypto_core/keccakf160064bits/avx2_openssl/Makefile @@ -0,0 +1,15 @@ +# -*- Makefile -*- + +.PHONY: default clean + +default: keccak_f1600_export.japp keccak_f1600_export.s + @true + +clean: + rm -f keccak_f1600_export.japp keccak_f1600_export.s + +%.s: %.japp + jasminc -lea -pasm $< > $@ || rm -f $@ + +%.japp: %.jazz + gpp -I../../../ -o $@ $< diff --git a/code/crypto_core/keccakf160064bits/avx2_openssl/keccak_f1600.jazz b/code/crypto_core/keccakf160064bits/avx2_openssl/keccak_f1600.jazz new file mode 100644 index 0000000..8f51680 --- /dev/null +++ b/code/crypto_core/keccakf160064bits/avx2_openssl/keccak_f1600.jazz @@ -0,0 +1,172 @@ +fn __keccak_f1600_avx2_openssl( + reg u256 a00 a01 a20 a31 + a21 a41 a11, + reg u64 _rhotates_left + _rhotates_right + _iotas +) -> reg u256, reg u256, reg u256, reg u256, + reg u256, reg u256, reg u256 +{ + reg u32 i; + reg u256 c00, c14; + reg u256 d00, d14; + reg u256[9] t; + reg bool zf; + reg u64 rhotates_left rhotates_right iotas; + + rhotates_left = _rhotates_left + 96; + rhotates_right = _rhotates_right + 96; + iotas = _iotas; + + i = 24; + while + { + /* ######################################### Theta */ + c00 = #x86_VPSHUFD_256(a20, 0x4e /*0b01001110 */); + c14 = a41 ^4u64 a31; + t[2] = a21 ^4u64 a11; + c14 = c14 ^4u64 a01; + c14 = c14 ^4u64 t[2]; + + t[4] = #x86_VPERMQ(c14, 0x93 /* 0b10010011 */); + c00 = c00 ^4u64 a20; + t[0] = #x86_VPERMQ(c00, 0x4e /* 0b01001110 */); + + t[1] = c14 >>4u64 63; + t[2] = c14 +4u64 c14; + t[1] = t[1] |4u64 t[2]; + + d14 = #x86_VPERMQ(t[1], 0x39 /*0b00111001 */); + d00 = t[1] ^4u64 t[4]; + d00 = #x86_VPERMQ(d00, 0x00 /*0b00000000 */); + + c00 = c00 ^4u64 a00; + c00 = c00 ^4u64 t[0]; + + t[0] = c00 >>4u64 63; + t[1] = c00 +4u64 c00; + t[1] = t[1] |4u64 t[0]; + + a20 = a20 ^4u64 d00; + a00 = a00 ^4u64 d00; + + d14 = #x86_VPBLENDD_256(d14,t[1], (4u2)[3,0,0,0] /* 0b11000000 */); + t[4] = #x86_VPBLENDD_256(t[4],c00, (4u2)[0,0,0,3] /* 0b00000011 */); + d14 = d14 ^4u64 t[4]; + + /* ######################################### Rho + Pi + pre-Chi shuffle */ + + t[3] = #x86_VPSLLV_4u64(a20,(u256)[rhotates_left + 0*32-96]); //vpsllvq 0*32-96(%r8),$a20,@t[3] + a20 = #x86_VPSRLV_4u64(a20,(u256)[rhotates_right+ 0*32-96]); //vpsrlvq 0*32-96(%r9),$a20,$a20 + a20 = a20 |4u64 t[3]; + + a31 = a31 ^4u64 d14; + t[4] = #x86_VPSLLV_4u64(a31,(u256)[rhotates_left + 2*32-96]); //vpsllvq 2*32-96(%r8),$a31,@t[4] + a31 = #x86_VPSRLV_4u64(a31,(u256)[rhotates_right+ 2*32-96]); //vpsllvq 2*32-96(%r9),$a31,$a31 + a31 = a31 |4u64 t[4]; + + a21 = a21 ^4u64 d14; + t[5] = #x86_VPSLLV_4u64(a21,(u256)[rhotates_left + 3*32-96]); //vpsllvq 3*32-96(%r8),$a21,@t[5] + a21 = #x86_VPSRLV_4u64(a21,(u256)[rhotates_right+ 3*32-96]); //vpsrlvq 3*32-96(%r9),$a21,$a21 + a21 = a21 |4u64 t[5]; + + + a41 = a41 ^4u64 d14; + t[6] = #x86_VPSLLV_4u64(a41,(u256)[rhotates_left + 4*32-96]); //vpsllvq 4*32-96(%r8),$a41,@t[6] + a41 = #x86_VPSRLV_4u64(a41,(u256)[rhotates_right+ 4*32-96]); //vpsrlvq 4*32-96(%r9),$a41,$a41 + a41 = a41 |4u64 t[6]; + + a11 = a11 ^4u64 d14; + t[3] = #x86_VPERMQ(a20, 0x8d /*0b10001101 */); + t[4] = #x86_VPERMQ(a31, 0x8d /*0b10001101 */); + t[7] = #x86_VPSLLV_4u64(a11,(u256)[rhotates_left + 5*32-96]); //vpsllvq 5*32-96(%r8),$a11,@t[7] + t[1] = #x86_VPSRLV_4u64(a11,(u256)[rhotates_right+ 5*32-96]); //vpsrlvq 5*32-96(%r9),$a11,@t[1] + t[1] = t[1] |4u64 t[7]; + + a01 = a01 ^4u64 d14; + t[5] = #x86_VPERMQ(a21, 0x1b /*0b00011011 */); + t[6] = #x86_VPERMQ(a41, 0x72 /*0b01110010 */); + t[8] = #x86_VPSLLV_4u64(a01,(u256)[rhotates_left + 1*32-96]); //vpsllvq 1*32-96(%r8),$a01,@t[8] + t[2] = #x86_VPSRLV_4u64(a01,(u256)[rhotates_right+ 1*32-96]); //vpsrlvq 1*32-96(%r9),$a01,@t[2] + t[2] = t[2] |4u64 t[8]; + + + /* ######################################### Chi */ + t[7] = #x86_VPSRLDQ_256(t[1], 8); // >>2u128 vpsrldq + t[0] = !t[1] & t[7]; // #x86_VPANDN_256(t[1],t[7]); + + a31 = #x86_VPBLENDD_256(t[2],t[6], (4u2)[0,0,3,0] ); + t[8] = #x86_VPBLENDD_256(t[4],t[2], (4u2)[0,0,3,0] ); + a41 = #x86_VPBLENDD_256(t[3],t[4], (4u2)[0,0,3,0] ); + t[7] = #x86_VPBLENDD_256(t[2],t[3], (4u2)[0,0,3,0] ); + + a31 = #x86_VPBLENDD_256(a31, t[4], (4u2)[0,3,0,0] ); + t[8] = #x86_VPBLENDD_256(t[8],t[5], (4u2)[0,3,0,0] ); + a41 = #x86_VPBLENDD_256(a41, t[2], (4u2)[0,3,0,0] ); + t[7] = #x86_VPBLENDD_256(t[7],t[6], (4u2)[0,3,0,0] ); + + a31 = #x86_VPBLENDD_256(a31, t[5], (4u2)[3,0,0,0] ); + t[8] = #x86_VPBLENDD_256(t[8],t[6], (4u2)[3,0,0,0] ); + a41 = #x86_VPBLENDD_256(a41, t[6], (4u2)[3,0,0,0] ); + t[7] = #x86_VPBLENDD_256(t[7],t[4], (4u2)[3,0,0,0] ); + + a31 = #x86_VPANDN_256(a31,t[8]); + a41 = #x86_VPANDN_256(a41,t[7]); + + a11 = #x86_VPBLENDD_256(t[5],t[2], (4u2)[0,0,3,0] ); + t[8] = #x86_VPBLENDD_256(t[3],t[5], (4u2)[0,0,3,0] ); + a31 = a31 ^4u64 t[3]; + + a11 = #x86_VPBLENDD_256(a11,t[3], (4u2)[0,3,0,0] ); + t[8] = #x86_VPBLENDD_256(t[8],t[4], (4u2)[0,3,0,0] ); + a41 = a41 ^4u64 t[5]; + + a11 = #x86_VPBLENDD_256(a11,t[4], (4u2)[3,0,0,0] ); + t[8] = #x86_VPBLENDD_256(t[8],t[2], (4u2)[3,0,0,0] ); + a11 = #x86_VPANDN_256(a11,t[8]); + a11 = a11 ^4u64 t[6]; + + a21 = #x86_VPERMQ(t[1], 0x1e /*0b00011110 */); + t[8] = #x86_VPBLENDD_256(a21,a00, (4u2)[0,3,0,0] ); + a01 = #x86_VPERMQ(t[1], 0x39 /*0b00111001 */); + a01 = #x86_VPBLENDD_256(a01,a00, (4u2)[3,0,0,0] ); + a01 = #x86_VPANDN_256(a01,t[8]); + + a20 = #x86_VPBLENDD_256(t[4],t[5], (4u2)[0,0,3,0] ); + t[7] = #x86_VPBLENDD_256(t[6],t[4], (4u2)[0,0,3,0] ); + a20 = #x86_VPBLENDD_256(a20, t[6], (4u2)[0,3,0,0] ); + t[7] = #x86_VPBLENDD_256(t[7],t[3], (4u2)[0,3,0,0] ); + a20 = #x86_VPBLENDD_256(a20, t[3], (4u2)[3,0,0,0] ); + t[7] = #x86_VPBLENDD_256(t[7],t[5], (4u2)[3,0,0,0] ); + + a20 = #x86_VPANDN_256(a20,t[7]); + a20 = a20 ^4u64 t[2]; + + t[0] = #x86_VPERMQ(t[0], 0x00/*0b00000000 */); + a31 = #x86_VPERMQ(a31, 0x1b/*0b00011011 */); + a41 = #x86_VPERMQ(a41, 0x8d/*0b10001101 */); + a11 = #x86_VPERMQ(a11, 0x72/*0b01110010 */); + + a21 = #x86_VPBLENDD_256(t[6],t[3], (4u2)[0,0,3,0] ); + t[7] = #x86_VPBLENDD_256(t[5],t[6], (4u2)[0,0,3,0] ); + a21 = #x86_VPBLENDD_256(a21, t[5], (4u2)[0,3,0,0] ); + t[7] = #x86_VPBLENDD_256(t[7],t[2], (4u2)[0,3,0,0] ); + a21 = #x86_VPBLENDD_256(a21, t[2], (4u2)[3,0,0,0] ); + t[7] = #x86_VPBLENDD_256(t[7],t[3], (4u2)[3,0,0,0] ); + + a21 = #x86_VPANDN_256(a21,t[7]); + + a00 = a00 ^4u64 t[0]; + a01 = a01 ^4u64 t[1]; + a21 = a21 ^4u64 t[4]; + + /* ######################################### Iota */ + a00 = a00 ^4u64 (u256)[iotas + 0]; + iotas = iotas + 32; + + (_,_,_,zf,i) = #x86_DEC_32(i); // dec = decl? + } (!zf) + + return a00, a01, a20, a31, a21, a41, a11; +} + diff --git a/code/crypto_core/keccakf160064bits/avx2_openssl/keccak_f1600_export.jazz b/code/crypto_core/keccakf160064bits/avx2_openssl/keccak_f1600_export.jazz new file mode 100644 index 0000000..49e7c14 --- /dev/null +++ b/code/crypto_core/keccakf160064bits/avx2_openssl/keccak_f1600_export.jazz @@ -0,0 +1,37 @@ +#include "crypto_core/keccakf160064bits/avx2-openssl/keccak_f1600.jazz" + +// +// TODO : rewrite to match crypto_core +// +export fn keccak_f1600_openssl( + reg u64 in + _rhotates_left + _rhotates_right + _iotas +) +{ + reg u256 A00, A01, A20, A31, + A21, A41, A11; + + A00 = (u256)[in + 0]; + A01 = (u256)[in + 32]; + A20 = (u256)[in + 64]; + A31 = (u256)[in + 96]; + A21 = (u256)[in + 128]; + A41 = (u256)[in + 160]; + A11 = (u256)[in + 192]; + + A00, A01, A20, A31, A21, A41, A11 = __keccak_f1600_avx2_openssl(A00, A01, A20, A31, + A21, A41, A11, + _rhotates_left, + _rhotates_right, + _iotas); + + (u256)[in + 0] = A00; + (u256)[in + 32] = A01; + (u256)[in + 64] = A20; + (u256)[in + 96] = A31; + (u256)[in + 128] = A21; + (u256)[in + 160] = A41; + (u256)[in + 192] = A11; +} diff --git a/code/crypto_core/keccakf160064bits/avx2_openssl/keccak_f1600_export.s b/code/crypto_core/keccakf160064bits/avx2_openssl/keccak_f1600_export.s new file mode 100644 index 0000000..5121cda --- /dev/null +++ b/code/crypto_core/keccakf160064bits/avx2_openssl/keccak_f1600_export.s @@ -0,0 +1,135 @@ + .text + .p2align 5 + .globl _keccak_f1600_openssl + .globl keccak_f1600_openssl +_keccak_f1600_openssl: +keccak_f1600_openssl: + pushq %rbp + vmovdqu (%rdi), %ymm0 + vmovdqu 32(%rdi), %ymm1 + vmovdqu 64(%rdi), %ymm2 + vmovdqu 96(%rdi), %ymm3 + vmovdqu 128(%rdi), %ymm4 + vmovdqu 160(%rdi), %ymm5 + vmovdqu 192(%rdi), %ymm6 + leaq 96(%rsi), %rax + leaq 96(%rdx), %rdx + movl $24, %esi +Lkeccak_f1600_openssl$1: + vpshufd $78, %ymm2, %ymm7 + vpxor %ymm3, %ymm5, %ymm8 + vpxor %ymm6, %ymm4, %ymm9 + vpxor %ymm1, %ymm8, %ymm8 + vpxor %ymm9, %ymm8, %ymm8 + vpermq $-109, %ymm8, %ymm9 + vpxor %ymm2, %ymm7, %ymm7 + vpermq $78, %ymm7, %ymm10 + vpsrlq $63, %ymm8, %ymm11 + vpaddq %ymm8, %ymm8, %ymm8 + vpor %ymm8, %ymm11, %ymm8 + vpermq $57, %ymm8, %ymm11 + vpxor %ymm9, %ymm8, %ymm8 + vpermq $0, %ymm8, %ymm8 + vpxor %ymm0, %ymm7, %ymm7 + vpxor %ymm10, %ymm7, %ymm7 + vpsrlq $63, %ymm7, %ymm10 + vpaddq %ymm7, %ymm7, %ymm12 + vpor %ymm10, %ymm12, %ymm10 + vpxor %ymm8, %ymm2, %ymm2 + vpxor %ymm8, %ymm0, %ymm0 + vpblendd $-64, %ymm10, %ymm11, %ymm8 + vpblendd $3, %ymm7, %ymm9, %ymm7 + vpxor %ymm7, %ymm8, %ymm7 + vpsllvq -96(%rax), %ymm2, %ymm8 + vpsrlvq -96(%rdx), %ymm2, %ymm2 + vpor %ymm8, %ymm2, %ymm2 + vpxor %ymm7, %ymm3, %ymm3 + vpsllvq -32(%rax), %ymm3, %ymm8 + vpsrlvq -32(%rdx), %ymm3, %ymm3 + vpor %ymm8, %ymm3, %ymm3 + vpxor %ymm7, %ymm4, %ymm4 + vpsllvq (%rax), %ymm4, %ymm8 + vpsrlvq (%rdx), %ymm4, %ymm4 + vpor %ymm8, %ymm4, %ymm4 + vpxor %ymm7, %ymm5, %ymm5 + vpsllvq 32(%rax), %ymm5, %ymm8 + vpsrlvq 32(%rdx), %ymm5, %ymm5 + vpor %ymm8, %ymm5, %ymm5 + vpxor %ymm7, %ymm6, %ymm6 + vpermq $-115, %ymm2, %ymm8 + vpermq $-115, %ymm3, %ymm9 + vpsllvq 64(%rax), %ymm6, %ymm2 + vpsrlvq 64(%rdx), %ymm6, %ymm3 + vpor %ymm2, %ymm3, %ymm10 + vpxor %ymm7, %ymm1, %ymm1 + vpermq $27, %ymm4, %ymm4 + vpermq $114, %ymm5, %ymm7 + vpsllvq -64(%rax), %ymm1, %ymm2 + vpsrlvq -64(%rdx), %ymm1, %ymm1 + vpor %ymm2, %ymm1, %ymm1 + vpsrldq $8, %ymm10, %ymm2 + vpandn %ymm2, %ymm10, %ymm3 + vpblendd $12, %ymm7, %ymm1, %ymm2 + vpblendd $12, %ymm1, %ymm9, %ymm5 + vpblendd $12, %ymm9, %ymm8, %ymm6 + vpblendd $12, %ymm8, %ymm1, %ymm11 + vpblendd $48, %ymm9, %ymm2, %ymm2 + vpblendd $48, %ymm4, %ymm5, %ymm5 + vpblendd $48, %ymm1, %ymm6, %ymm6 + vpblendd $48, %ymm7, %ymm11, %ymm11 + vpblendd $-64, %ymm4, %ymm2, %ymm2 + vpblendd $-64, %ymm7, %ymm5, %ymm5 + vpblendd $-64, %ymm7, %ymm6, %ymm6 + vpblendd $-64, %ymm9, %ymm11, %ymm11 + vpandn %ymm5, %ymm2, %ymm2 + vpandn %ymm11, %ymm6, %ymm5 + vpblendd $12, %ymm1, %ymm4, %ymm6 + vpblendd $12, %ymm4, %ymm8, %ymm11 + vpxor %ymm8, %ymm2, %ymm12 + vpblendd $48, %ymm8, %ymm6, %ymm2 + vpblendd $48, %ymm9, %ymm11, %ymm6 + vpxor %ymm4, %ymm5, %ymm5 + vpblendd $-64, %ymm9, %ymm2, %ymm2 + vpblendd $-64, %ymm1, %ymm6, %ymm6 + vpandn %ymm6, %ymm2, %ymm2 + vpxor %ymm7, %ymm2, %ymm6 + vpermq $30, %ymm10, %ymm2 + vpblendd $48, %ymm0, %ymm2, %ymm2 + vpermq $57, %ymm10, %ymm11 + vpblendd $-64, %ymm0, %ymm11, %ymm11 + vpandn %ymm2, %ymm11, %ymm11 + vpblendd $12, %ymm4, %ymm9, %ymm2 + vpblendd $12, %ymm9, %ymm7, %ymm13 + vpblendd $48, %ymm7, %ymm2, %ymm2 + vpblendd $48, %ymm8, %ymm13, %ymm13 + vpblendd $-64, %ymm8, %ymm2, %ymm2 + vpblendd $-64, %ymm4, %ymm13, %ymm13 + vpandn %ymm13, %ymm2, %ymm2 + vpxor %ymm1, %ymm2, %ymm2 + vpermq $0, %ymm3, %ymm13 + vpermq $27, %ymm12, %ymm3 + vpermq $-115, %ymm5, %ymm5 + vpermq $114, %ymm6, %ymm6 + vpblendd $12, %ymm8, %ymm7, %ymm12 + vpblendd $12, %ymm7, %ymm4, %ymm7 + vpblendd $48, %ymm4, %ymm12, %ymm4 + vpblendd $48, %ymm1, %ymm7, %ymm7 + vpblendd $-64, %ymm1, %ymm4, %ymm1 + vpblendd $-64, %ymm8, %ymm7, %ymm4 + vpandn %ymm4, %ymm1, %ymm4 + vpxor %ymm13, %ymm0, %ymm0 + vpxor %ymm10, %ymm11, %ymm1 + vpxor %ymm9, %ymm4, %ymm4 + vpxor (%rcx), %ymm0, %ymm0 + leaq 32(%rcx), %rcx + decl %esi + jne Lkeccak_f1600_openssl$1 + vmovdqu %ymm0, (%rdi) + vmovdqu %ymm1, 32(%rdi) + vmovdqu %ymm2, 64(%rdi) + vmovdqu %ymm3, 96(%rdi) + vmovdqu %ymm4, 128(%rdi) + vmovdqu %ymm5, 160(%rdi) + vmovdqu %ymm6, 192(%rdi) + popq %rbp + ret diff --git a/code/crypto_core/keccakf160064bits/ref/Makefile b/code/crypto_core/keccakf160064bits/ref/Makefile new file mode 100644 index 0000000..5b25fdc --- /dev/null +++ b/code/crypto_core/keccakf160064bits/ref/Makefile @@ -0,0 +1,15 @@ +# -*- Makefile -*- + +.PHONY: default clean + +default: keccak_f1600_export.japp keccak_f1600_export.s + @true + +clean: + rm -f keccak_f1600_export.japp keccak_f1600_export.s + +%.s: %.japp + jasminc -lea -pasm $< > $@ || rm -f $@ + +%.japp: %.jazz + gpp -I../../../ -o $@ $< diff --git a/code/crypto_core/keccakf160064bits/ref/keccak_f1600.jazz b/code/crypto_core/keccakf160064bits/ref/keccak_f1600.jazz new file mode 100644 index 0000000..a469d05 --- /dev/null +++ b/code/crypto_core/keccakf160064bits/ref/keccak_f1600.jazz @@ -0,0 +1,212 @@ +inline +fn index(inline int x, inline int y) -> inline int { + inline int r; + r = (x % 5) + 5 * (y % 5); + return r; +} + + +inline +fn ROL64(reg u64 x, inline int c) -> reg u64 { + reg u64 y; + _, _, y = #x86_ROL_64(x, c); + return y; +} + + +fn theta(stack u64[25] a) -> stack u64[25] { + inline int x, y; + reg u64[5] c, d; + + for x = 0 to 5 { + c[x] = 0; + for y = 0 to 5 { + c[x] ^= a[x + 5 * y]; + } + } + + for x = 0 to 5 { + /* d[x] = ROL64(c[(x + 1) % 5], 1); */ + /* extraction fails */ + + /* _, _, d[x] = #x86_ROL_64(c[(x + 1) % 5], 1);*/ + /* d[x] ^= c[(x + 4) % 5];*/ + /* does not compile */ + + d[x] = c[(x + 1) % 5]; + _, _, d[x] = #x86_ROL_64(d[x], 1); + d[x] ^= c[(x + 4) % 5]; + } + + for x = 0 to 5 { + for y = 0 to 5 { + a[x + 5 * y] ^= d[x]; + } + } + + return a; +} + + +inline +fn keccakRhoOffsets(inline int i) -> inline int { + inline int r, x, y, z, t; + + r = 0; + x = 1; + y = 0; + for t = 0 to 24 { + if (i == x + 5 * y) { + r = ((t + 1) * (t + 2) / 2) % 64; + } + z = (2 * x + 3 * y) % 5; + x = y; + y = z; + } + + return r; +} + + +fn rho(stack u64[25] a) -> stack u64[25] { + inline int x, y, i, z; + + for x = 0 to 5 { + for y = 0 to 5 { + i = index(x, y); + z = keccakRhoOffsets(i); + _, _, a[i] = #x86_ROL_64(a[i], z); + } + } + + return a; +} + + +fn pi(stack u64[25] a) -> stack u64[25] { + stack u64[25] b; + reg u64 t; + inline int x, y, i; + for i = 0 to 25 { t = a[i]; b[i] = t; } + + for x = 0 to 5 { + for y = 0 to 5 { + t = b[x + 5 * y]; + i = index(y, 2 * x + 3 * y); + a[i] = t; + } + } + return a; +} + + +fn chi(stack u64[25] a) -> stack u64[25] { + inline int x, y, i; + reg u64[5] c; + for y = 0 to 5 { + for x = 0 to 5 { + i = index(x + 1, y); + c[x] = a[i]; + c[x] = !c[x]; + i = index(x + 2, y); + c[x] &= a[i]; + i = index(x, y); + c[x] ^= a[i]; + } + for x = 0 to 5 { + a[x + 5 * y] = c[x]; + } + } + return a; +} + + +fn iota(stack u64[25] a, reg u64 c) -> stack u64[25] { + a[0] ^= c; + return a; +} + + +fn keccakP1600_round(stack u64[25] state, reg u64 c) -> stack u64[25] { + state = theta(state); + state = rho(state); + state = pi(state); + state = chi(state); + state = iota(state, c); + return state; +} + + +#if 0 +inline +fn keccakRoundConstants() -> stack u64[24] { + stack u64[24] constants; + constants[ 0]=0x0000000000000001; + constants[ 1]=0x0000000000008082; + constants[ 2]=0x800000000000808a; + constants[ 3]=0x8000000080008000; + constants[ 4]=0x000000000000808b; + constants[ 5]=0x0000000080000001; + constants[ 6]=0x8000000080008081; + constants[ 7]=0x8000000000008009; + constants[ 8]=0x000000000000008a; + constants[ 9]=0x0000000000000088; + constants[10]=0x0000000080008009; + constants[11]=0x000000008000000a; + constants[12]=0x000000008000808b; + constants[13]=0x800000000000008b; + constants[14]=0x8000000000008089; + constants[15]=0x8000000000008003; + constants[16]=0x8000000000008002; + constants[17]=0x8000000000000080; + constants[18]=0x000000000000800a; + constants[19]=0x800000008000000a; + constants[20]=0x8000000080008081; + constants[21]=0x8000000000008080; + constants[22]=0x0000000080000001; + constants[23]=0x8000000080008008; + return constants; +} +/* does not compile */ +#endif + +fn keccakRoundConstants() -> stack u64[24] { + stack u64[24] constants; + reg u64 t; + t = 0x0000000000000001; constants[ 0] = t; + t = 0x0000000000008082; constants[ 1] = t; + t = 0x800000000000808a; constants[ 2] = t; + t = 0x8000000080008000; constants[ 3] = t; + t = 0x000000000000808b; constants[ 4] = t; + t = 0x0000000080000001; constants[ 5] = t; + t = 0x8000000080008081; constants[ 6] = t; + t = 0x8000000000008009; constants[ 7] = t; + t = 0x000000000000008a; constants[ 8] = t; + t = 0x0000000000000088; constants[ 9] = t; + t = 0x0000000080008009; constants[10] = t; + t = 0x000000008000000a; constants[11] = t; + t = 0x000000008000808b; constants[12] = t; + t = 0x800000000000008b; constants[13] = t; + t = 0x8000000000008089; constants[14] = t; + t = 0x8000000000008003; constants[15] = t; + t = 0x8000000000008002; constants[16] = t; + t = 0x8000000000000080; constants[17] = t; + t = 0x000000000000800a; constants[18] = t; + t = 0x800000008000000a; constants[19] = t; + t = 0x8000000080008081; constants[20] = t; + t = 0x8000000000008080; constants[21] = t; + t = 0x0000000080000001; constants[22] = t; + t = 0x8000000080008008; constants[23] = t; + return constants; +} + + +fn __keccak_f1600_ref(stack u64[25] state) -> stack u64[25] { + inline int round; + stack u64[24] constants; + constants = keccakRoundConstants(); + for round = 0 to 24 { + state = keccakP1600_round(state, constants[round]); + } + return state; +} diff --git a/code/crypto_core/keccakf160064bits/ref/keccak_f1600_export.jazz b/code/crypto_core/keccakf160064bits/ref/keccak_f1600_export.jazz new file mode 100644 index 0000000..ecb84b9 --- /dev/null +++ b/code/crypto_core/keccakf160064bits/ref/keccak_f1600_export.jazz @@ -0,0 +1,21 @@ +#include "crypto_core/keccakf160064bits/ref/keccak_f1600.jazz" + +// +// TODO : rewrite to match crypto_core +// +export fn keccak_f1600( + reg u64 in +) +{ + inline int i; + stack u64[25] state; + reg u64 t; + + for i=0 to 25 + { t = [in + 8*i]; state[i] = t; } + + state = __keccak_f1600_ref(state); + + for i=0 to 25 + { t = state[i]; t = [in + 8*i]; } +} diff --git a/code/crypto_core/keccakf160064bits/ref/keccak_f1600_export.s b/code/crypto_core/keccakf160064bits/ref/keccak_f1600_export.s new file mode 100644 index 0000000..905aa1c --- /dev/null +++ b/code/crypto_core/keccakf160064bits/ref/keccak_f1600_export.s @@ -0,0 +1,9 @@ + .text + .p2align 5 + .globl _keccak_f1600 + .globl keccak_f1600 +_keccak_f1600: +keccak_f1600: + pushq %rbp + popq %rbp + ret diff --git a/code/crypto_core/keccakf160064bits/scalar/Makefile b/code/crypto_core/keccakf160064bits/scalar/Makefile new file mode 100644 index 0000000..5b25fdc --- /dev/null +++ b/code/crypto_core/keccakf160064bits/scalar/Makefile @@ -0,0 +1,15 @@ +# -*- Makefile -*- + +.PHONY: default clean + +default: keccak_f1600_export.japp keccak_f1600_export.s + @true + +clean: + rm -f keccak_f1600_export.japp keccak_f1600_export.s + +%.s: %.japp + jasminc -lea -pasm $< > $@ || rm -f $@ + +%.japp: %.jazz + gpp -I../../../ -o $@ $< diff --git a/code/crypto_core/keccakf160064bits/scalar/keccak_f1600.jahh b/code/crypto_core/keccakf160064bits/scalar/keccak_f1600.jahh new file mode 100644 index 0000000..079c893 --- /dev/null +++ b/code/crypto_core/keccakf160064bits/scalar/keccak_f1600.jahh @@ -0,0 +1,43 @@ +#ifndef KECCAK_SCALAR_H +#define KECCAK_SCALAR_H + +#ifndef STATE_IN_STACK + // 0 uses external memory for the stack space + // 1 uses stack u64[] array + #define STATE_IN_STACK 1 +#endif + +#if !STATE_IN_STACK + + #define _state_t reg u64 + #define _mem m + #define _mem_arg _mem, + #define OFFSET 100 + #define S(base,x,y) [base + 8*(5*((x) % 5) + ((y) % 5)) - OFFSET] + #define B(base,x) [base + 8*(x)] + #define B8(base,x) (u8)[base + (x)] + fn swap(_state_t a b) -> _state_t, _state_t + { _state_t t; + t = a; a = b; b = t; // TODO XCHG + return a, b; } + #define setup(a,b) a += OFFSET;b = a + 200; + #define restore(a,b) a -= OFFSET; + +#else + + #define _state_t stack u64[25] + #define _mem + #define _mem_arg + #define S(base,x,y) base[(5*((x) % 5) + ((y) % 5))] + #define B(base,x) base[(int)x] + #define B8(base,x) base[u8 (int)(x)] + #if 0 + // swap is undefined when state is in stack because it implies a full + // (not logical) swap. For instance, atm, loop should be unrolled twice + // when using stack for the state to avoid this. + #endif + #define setup(a,b) + #define restore(a,b) + +#endif +#endif diff --git a/code/crypto_core/keccakf160064bits/scalar/keccak_f1600.jazz b/code/crypto_core/keccakf160064bits/scalar/keccak_f1600.jazz new file mode 100644 index 0000000..d54bdb3 --- /dev/null +++ b/code/crypto_core/keccakf160064bits/scalar/keccak_f1600.jazz @@ -0,0 +1,187 @@ +#include "crypto_core/keccakf160064bits/scalar/keccak_f1600.jahh" + + + +fn index(inline int x, inline int y) -> inline int { + inline int r; + r = 5*(x % 5) + (y % 5); + return r; +} + + + +fn keccak_rho_offsets(inline int i) -> inline int +{ + inline int r, x, y, z, t; + r = 0; + x = 1; + y = 0; + for t = 0 to 24 + { if ( i == x + 5 * y ) + { r = ((t + 1) * (t + 2) / 2) % 64; + } + z = (2 * x + 3 * y) % 5; + x = y; + y = z; + } + + return r; +} + + + +fn rhotates(inline int x y) -> inline int +{ + inline int i r; + i = index(x, y); + r = keccak_rho_offsets(i); + return r; +} + + + +fn ROL64(reg u64 x, inline int c) -> reg u64 +{ + reg u64 y; + if (c == 0) + { y = x; } + else + { _, _, y = #x86_ROL_64(x, c); } + return y; +} + + +fn theta_sum(_state_t a) -> reg u64[5] +{ + inline int i j; + reg u64[5] c; + + for i=0 to 5 + { c[i] = S(a, 0, i); } + + for j=1 to 5 + { for i=0 to 5 + { c[i] ^= S(a, j, i); } + } + + return c; +} + + + +fn theta_rol(reg u64[5] c) -> reg u64[5] +{ + inline int i; + reg u64[5] d; + reg u64 t r; + + for i = 0 to 5 + { d[i] = c[(i+1)%5]; + _, _, d[i] = #x86_ROL_64(d[i], 1); + d[i] ^= c[(i+4)%5]; + } + + return d; +} + + + +fn rol_sum( + reg u64[5] d, + _state_t a, + inline int offset +) -> reg u64[5] +{ + inline int j j1 k; + reg u64[5] c; + reg u64 t; + + for j = 0 to 5 + { + j1 = (j+offset) % 5; + k = rhotates(j, j1); + t = S(a,j,j1); + t ^= d[j1]; + t = ROL64(t, k); + c[j] = t; + } + + return c; +} + + + +fn set_row( + _state_t r, + inline int row, + reg u64[5] c, + stack u64 iota +) -> _state_t +{ + inline int j j1 j2; + reg u64 t; + + for j= 0 to 5 + { + j1 = (j+1) % 5; + j2 = (j+2) % 5; + t = !c[j1] & c[j2]; + if row==0 && j==0 { t ^= iota; } + t ^= c[j]; + S(r, row, j) = t; + } + + return r; +} + + + +fn round2x( + _state_t a, + _state_t r, + reg u64 iotas, + inline int o +) -> _state_t, _state_t +{ + reg u64[5] c d; + stack u64 iota; + + iota = [iotas + o]; + c = theta_sum(a); + d = theta_rol(c); + c = rol_sum(d, a, 0); + r = set_row(r, 0, c, iota); + c = rol_sum(d, a, 3); + r = set_row(r, 1, c, iota); + c = rol_sum(d, a, 1); + r = set_row(r, 2, c, iota); + c = rol_sum(d, a, 4); + r = set_row(r, 3, c, iota); + c = rol_sum(d, a, 2); + r = set_row(r, 4, c, iota); + + return a, r; +} + + + +fn __keccak_f1600_scalar( + _state_t a, + reg u64 iotas +) -> _state_t, reg u64 +{ + reg bool zf; + _state_t r; + + while + { + a, r = round2x(a, r, iotas, 0); + r, a = round2x(r, a, iotas, 8); + iotas += 16; + _, _, _, _, zf = #x86_TEST_8(iotas,255); + } (!zf) + + iotas -= 192; + + return a, iotas; +} diff --git a/code/crypto_core/keccakf160064bits/scalar/keccak_f1600_export.jazz b/code/crypto_core/keccakf160064bits/scalar/keccak_f1600_export.jazz new file mode 100644 index 0000000..369e5f8 --- /dev/null +++ b/code/crypto_core/keccakf160064bits/scalar/keccak_f1600_export.jazz @@ -0,0 +1,22 @@ +#include "crypto_core/keccakf160064bits/scalar/keccak_f1600.jazz" + +// +// TODO : rewrite to match crypto_core +// +export fn keccak_f1600( + reg u64 in, + reg u64 _iotas +) +{ + inline int i; + _state_t state; + reg u64 t; + + for i=0 to 25 + { t = [in + 8*i]; B(state,i) = t; } + + state, _iotas = __keccak_f1600_scalar(state, _iotas); + + for i=0 to 25 + { t = B(state,i); t = [in + 8*i]; } +} diff --git a/code/crypto_core/keccakf160064bits/scalar/keccak_f1600_export.s b/code/crypto_core/keccakf160064bits/scalar/keccak_f1600_export.s new file mode 100644 index 0000000..f989286 --- /dev/null +++ b/code/crypto_core/keccakf160064bits/scalar/keccak_f1600_export.s @@ -0,0 +1,13 @@ + .text + .p2align 5 + .globl _keccak_f1600 + .globl keccak_f1600 +_keccak_f1600: +keccak_f1600: + pushq %rbp +Lkeccak_f1600$1: + leaq 16(%rsi), %rsi + testb $-1, %sil + jne Lkeccak_f1600$1 + popq %rbp + ret diff --git a/code/crypto_core/keccakf160064bits/scalar_g/Makefile b/code/crypto_core/keccakf160064bits/scalar_g/Makefile new file mode 100644 index 0000000..5b25fdc --- /dev/null +++ b/code/crypto_core/keccakf160064bits/scalar_g/Makefile @@ -0,0 +1,15 @@ +# -*- Makefile -*- + +.PHONY: default clean + +default: keccak_f1600_export.japp keccak_f1600_export.s + @true + +clean: + rm -f keccak_f1600_export.japp keccak_f1600_export.s + +%.s: %.japp + jasminc -lea -pasm $< > $@ || rm -f $@ + +%.japp: %.jazz + gpp -I../../../ -o $@ $< diff --git a/code/crypto_core/keccakf160064bits/scalar_g/keccak_f1600.jahh b/code/crypto_core/keccakf160064bits/scalar_g/keccak_f1600.jahh new file mode 100644 index 0000000..4f1eae3 --- /dev/null +++ b/code/crypto_core/keccakf160064bits/scalar_g/keccak_f1600.jahh @@ -0,0 +1,43 @@ +#ifndef KECCAK_SCALAR_G_H +#define KECCAK_SCALAR_G_H + +#ifndef STATE_IN_STACK + // 0 uses external memory for the stack space + // 1 uses stack u64[] array + #define STATE_IN_STACK 1 +#endif + +#if !STATE_IN_STACK + + #define _state_t reg u64 + #define _mem m + #define _mem_arg _mem, + #define OFFSET 100 + #define S(base,x,y) [base + 8*(5*((x) % 5) + ((y) % 5)) - OFFSET] + #define B(base,x) [base + 8*(x)] + #define B8(base,x) (u8)[base + (x)] + fn swap(_state_t a b) -> _state_t, _state_t + { _state_t t; + t = a; a = b; b = t; // TODO XCHG + return a, b; } + #define setup(a,b) a += OFFSET;b = a + 200; + #define restore(a,b) a -= OFFSET; + +#else + + #define _state_t stack u64[25] + #define _mem + #define _mem_arg + #define S(base,x,y) base[(5*((x) % 5) + ((y) % 5))] + #define B(base,x) base[(int)x] + #define B8(base,x) base[u8 (int)(x)] + #if 0 + // swap is undefined when state is in stack because it implies a full + // (not logical) swap. For instance, atm, loop should be unrolled twice + // when using stack for the state to avoid this. + #endif + #define setup(a,b) + #define restore(a,b) + +#endif +#endif diff --git a/code/crypto_core/keccakf160064bits/scalar_g/keccak_f1600.jazz b/code/crypto_core/keccakf160064bits/scalar_g/keccak_f1600.jazz new file mode 100644 index 0000000..45051eb --- /dev/null +++ b/code/crypto_core/keccakf160064bits/scalar_g/keccak_f1600.jazz @@ -0,0 +1,212 @@ +#include "crypto_core/keccakf160064bits/scalar_g/keccak_f1600.jahh" + + +// reversed iotas with the first position at zero +u64[25] iotas = +{ 0x0000000000000000 + , 0x8000000080008008 + , 0x0000000080000001 + , 0x8000000000008080 + , 0x8000000080008081 + , 0x800000008000000a + , 0x000000000000800a + , 0x8000000000000080 + , 0x8000000000008002 + , 0x8000000000008003 + , 0x8000000000008089 + , 0x800000000000008b + , 0x000000008000808b + , 0x000000008000000a + , 0x0000000080008009 + , 0x0000000000000088 + , 0x000000000000008a + , 0x8000000000008009 + , 0x8000000080008081 + , 0x0000000080000001 + , 0x000000000000808b + , 0x8000000080008000 + , 0x800000000000808a + , 0x0000000000008082 + , 0x0000000000000001 +}; + + +fn index(inline int x, inline int y) -> inline int { + inline int r; + r = 5*(x % 5) + (y % 5); + return r; +} + + +fn keccak_rho_offsets(inline int i) -> inline int +{ + inline int r, x, y, z, t; + r = 0; + x = 1; + y = 0; + for t = 0 to 24 + { if ( i == x + 5 * y ) + { r = ((t + 1) * (t + 2) / 2) % 64; + } + z = (2 * x + 3 * y) % 5; + x = y; + y = z; + } + + return r; +} + + +fn rhotates(inline int x y) -> inline int +{ + inline int i r; + i = index(x, y); + r = keccak_rho_offsets(i); + return r; +} + + +fn ROL64(reg u64 x, inline int c) -> reg u64 +{ + reg u64 y; + if (c == 0) + { y = x; } + else + { _, _, y = #x86_ROL_64(x, c); } + return y; +} + + +fn theta_sum(_state_t A) -> reg u64[5] +{ + inline int i j; + reg u64[5] C; + + for i=0 to 5 + { C[i] = S(A, 0, i); } + + for j=1 to 5 + { for i=0 to 5 + { C[i] ^= S(A, j, i); } + } + + return C; +} + + +fn theta_rol(reg u64[5] C) -> reg u64[5] +{ + inline int i; + reg u64[5] D; + reg u64 t r; + + for i = 0 to 5 + { D[i] = ROL64(C[(i+1)%5], 1); + D[i] ^= C[(i+4)%5]; + } + + return D; +} + + +fn rol_sum( + reg u64[5] D, + _state_t A, + inline int offset +) -> reg u64[5] +{ + inline int j j1 k; + reg u64[5] C; + reg u64 t; + + for j = 0 to 5 + { + j1 = (j+offset) % 5; + k = rhotates(j, j1); + t = S(A,j,j1); + t ^= D[j1]; + t = ROL64(t, k); + C[j] = t; + } + + return C; +} + + +fn set_row( + _state_t R, + inline int row, + reg u64[5] C, + stack u64[25] s_iotas, + reg u64 r +) -> _state_t +{ + inline int j j1 j2; + reg u64 t; + + for j= 0 to 5 + { + j1 = (j+1) % 5; + j2 = (j+2) % 5; + t = !C[j1] & C[j2]; + if row==0 && j==0 { t ^= s_iotas[(int) r]; } + t ^= C[j]; + S(R, row, j) = t; + } + + return R; +} + + +fn round2x( + _state_t A, + _state_t R, + stack u64[25] s_iotas, + reg u64 r +) -> _state_t, _state_t +{ + reg u64[5] C D; + + C = theta_sum(A); + D = theta_rol(C); + C = rol_sum(D, A, 0); + R = set_row(R, 0, C, s_iotas, r); + C = rol_sum(D, A, 3); + R = set_row(R, 1, C, s_iotas, r); + C = rol_sum(D, A, 1); + R = set_row(R, 2, C, s_iotas, r); + C = rol_sum(D, A, 4); + R = set_row(R, 3, C, s_iotas, r); + C = rol_sum(D, A, 2); + R = set_row(R, 4, C, s_iotas, r); + + return A, R; +} + + +fn __keccak_f1600_scalar_g( + _state_t A +) -> _state_t +{ + reg bool zf; + _state_t R; + stack u64[25] s_iotas; + reg u64 r; + + setup(A,R) + + r = 24; + s_iotas = iotas; + + align while + { + A, R = round2x(A, R, s_iotas, r); + r = #x86_DEC(r); + R, A = round2x(R, A, s_iotas, r); + (_, _, _, zf, r) = #x86_DEC(r); + } (!zf) + + restore(A,R) + + return A; +} diff --git a/code/crypto_core/keccakf160064bits/scalar_g/keccak_f1600_export.jazz b/code/crypto_core/keccakf160064bits/scalar_g/keccak_f1600_export.jazz new file mode 100644 index 0000000..fc39e27 --- /dev/null +++ b/code/crypto_core/keccakf160064bits/scalar_g/keccak_f1600_export.jazz @@ -0,0 +1,21 @@ +#include "crypto_core/keccakf160064bits/scalar_g/keccak_f1600.jazz" + +// +// TODO : rewrite to match crypto_core +// +export fn keccak_f1600( + reg u64 in +) +{ + inline int i; + _state_t state; + reg u64 t; + + for i=0 to 25 + { t = [in + 8*i]; B(state,i) = t; } + + state = __keccak_f1600_scalar_g(state); + + for i=0 to 25 + { t = B(state,i); t = [in + 8*i]; } +} diff --git a/code/crypto_core/keccakf160064bits/scalar_g/keccak_f1600_export.s b/code/crypto_core/keccakf160064bits/scalar_g/keccak_f1600_export.s new file mode 100644 index 0000000..f252525 --- /dev/null +++ b/code/crypto_core/keccakf160064bits/scalar_g/keccak_f1600_export.s @@ -0,0 +1,221 @@ + .text + .p2align 5 + .globl _keccak_f1600 + .globl keccak_f1600 +_keccak_f1600: +keccak_f1600: + pushq %rbp + movq $24, %rax + .p2align 5 +Lkeccak_f1600$1: + decq %rax + decq %rax + jne Lkeccak_f1600$1 + popq %rbp + ret + .data + .globl _glob_data + .globl glob_data + .p2align 5 +_glob_data: +glob_data: +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 8 +.byte 128 +.byte 0 +.byte 128 +.byte 0 +.byte 0 +.byte 0 +.byte 128 +.byte 1 +.byte 0 +.byte 0 +.byte 128 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 128 +.byte 128 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 128 +.byte 129 +.byte 128 +.byte 0 +.byte 128 +.byte 0 +.byte 0 +.byte 0 +.byte 128 +.byte 10 +.byte 0 +.byte 0 +.byte 128 +.byte 0 +.byte 0 +.byte 0 +.byte 128 +.byte 10 +.byte 128 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 128 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 128 +.byte 2 +.byte 128 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 128 +.byte 3 +.byte 128 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 128 +.byte 137 +.byte 128 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 128 +.byte 139 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 128 +.byte 139 +.byte 128 +.byte 0 +.byte 128 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 10 +.byte 0 +.byte 0 +.byte 128 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 9 +.byte 128 +.byte 0 +.byte 128 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 136 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 138 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 9 +.byte 128 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 128 +.byte 129 +.byte 128 +.byte 0 +.byte 128 +.byte 0 +.byte 0 +.byte 0 +.byte 128 +.byte 1 +.byte 0 +.byte 0 +.byte 128 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 139 +.byte 128 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 128 +.byte 0 +.byte 128 +.byte 0 +.byte 0 +.byte 0 +.byte 128 +.byte 138 +.byte 128 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 128 +.byte 130 +.byte 128 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 1 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 0 \ No newline at end of file diff --git a/code/crypto_hash/keccak1600/avx2/Makefile b/code/crypto_hash/keccak1600/avx2/Makefile new file mode 100644 index 0000000..23a2571 --- /dev/null +++ b/code/crypto_hash/keccak1600/avx2/Makefile @@ -0,0 +1,12 @@ +# -*- Makefile -*- + +.PHONY: default clean + +default: keccak_1600.japp + @true + +clean: + rm -f keccak_1600.japp + +%.japp: %.jazz + gpp -I../../../ -o $@ $< diff --git a/code/crypto_hash/keccak1600/avx2/keccak_1600.japp b/code/crypto_hash/keccak1600/avx2/keccak_1600.japp new file mode 100644 index 0000000..00aa662 --- /dev/null +++ b/code/crypto_hash/keccak1600/avx2/keccak_1600.japp @@ -0,0 +1,450 @@ + + + + +fn __keccak_f1600_avx2( + reg u256[7] state, + reg u64 _rhotates_left, + reg u64 _rhotates_right, + reg u64 _iotas +) -> reg u256[7] +{ + reg u256[9] t; + reg u256 c00 c14 d00 d14; + + reg bool zf; + reg u32 r; + reg u64 rhotates_left; + reg u64 rhotates_right; + reg u64 iotas; + + rhotates_left = _rhotates_left + 96; + rhotates_right = _rhotates_right + 96; + iotas = _iotas; + + r = 24; + align while + { + + //######################################## Theta + c00 = #x86_VPSHUFD_256(state[2], (4u2)[1,0,3,2]); + c14 = state[5] ^ state[3]; + t[2] = state[4] ^ state[6]; + c14 = c14 ^ state[1]; + c14 = c14 ^ t[2]; + t[4] = #x86_VPERMQ(c14, (4u2)[2,1,0,3]); + c00 = c00 ^ state[2]; + t[0] = #x86_VPERMQ(c00, (4u2)[1,0,3,2]); + t[1] = c14 >>4u64 63; + t[2] = c14 +4u64 c14; + t[1] = t[1] | t[2]; + d14 = #x86_VPERMQ(t[1], (4u2)[0,3,2,1]); + d00 = t[1] ^ t[4]; + d00 = #x86_VPERMQ(d00, (4u2)[0,0,0,0]); + c00 = c00 ^ state[0]; + c00 = c00 ^ t[0]; + t[0] = c00 >>4u64 63; + t[1] = c00 +4u64 c00; + t[1] = t[1] | t[0]; + state[2] = state[2] ^ d00; + state[0] = state[0] ^ d00; + d14 = #x86_VPBLENDD_256(d14, t[1], (8u1)[1,1,0,0,0,0,0,0]); + t[4] = #x86_VPBLENDD_256(t[4], c00, (8u1)[0,0,0,0,0,0,1,1]); + d14 = d14 ^ t[4]; + + //######################################## Rho + Pi + pre-Chi shuffle + t[3] = #x86_VPSLLV_4u64(state[2], (u256)[rhotates_left + 32*(0) - 96] ); + state[2] = #x86_VPSRLV_4u64(state[2], (u256)[rhotates_right + 32*(0) - 96] ); + state[2] = state[2] | t[3]; + state[3] = state[3] ^ d14; + t[4] = #x86_VPSLLV_4u64(state[3], (u256)[rhotates_left + 32*(2) - 96] ); + state[3] = #x86_VPSRLV_4u64(state[3], (u256)[rhotates_right + 32*(2) - 96] ); + state[3] = state[3] | t[4]; + state[4] = state[4] ^ d14; + t[5] = #x86_VPSLLV_4u64(state[4], (u256)[rhotates_left + 32*(3) - 96] ); + state[4] = #x86_VPSRLV_4u64(state[4], (u256)[rhotates_right + 32*(3) - 96] ); + state[4] = state[4] | t[5]; + state[5] = state[5] ^ d14; + t[6] = #x86_VPSLLV_4u64(state[5], (u256)[rhotates_left + 32*(4) - 96] ); + state[5] = #x86_VPSRLV_4u64(state[5], (u256)[rhotates_right + 32*(4) - 96] ); + state[5] = state[5] | t[6]; + state[6] = state[6] ^ d14; + t[3] = #x86_VPERMQ(state[2], (4u2)[2,0,3,1]); + t[4] = #x86_VPERMQ(state[3], (4u2)[2,0,3,1]); + t[7] = #x86_VPSLLV_4u64(state[6], (u256)[rhotates_left + 32*(5) - 96] ); + t[1] = #x86_VPSRLV_4u64(state[6], (u256)[rhotates_right + 32*(5) - 96] ); + t[1] = t[1] | t[7]; + state[1] = state[1] ^ d14; + t[5] = #x86_VPERMQ(state[4], (4u2)[0,1,2,3]); + t[6] = #x86_VPERMQ(state[5], (4u2)[1,3,0,2]); + t[8] = #x86_VPSLLV_4u64(state[1], (u256)[rhotates_left + 32*(1) - 96] ); + t[2] = #x86_VPSRLV_4u64(state[1], (u256)[rhotates_right + 32*(1) - 96] ); + t[2] = t[2] | t[8]; + + //######################################## Chi + t[7] = #x86_VPSRLDQ_256(t[1], 8); + t[0] = !t[1] & t[7]; + state[3] = #x86_VPBLENDD_256(t[2], t[6], (8u1)[0,0,0,0,1,1,0,0]); + t[8] = #x86_VPBLENDD_256(t[4], t[2], (8u1)[0,0,0,0,1,1,0,0]); + state[5] = #x86_VPBLENDD_256(t[3], t[4], (8u1)[0,0,0,0,1,1,0,0]); + t[7] = #x86_VPBLENDD_256(t[2], t[3], (8u1)[0,0,0,0,1,1,0,0]); + state[3] = #x86_VPBLENDD_256(state[3], t[4], (8u1)[0,0,1,1,0,0,0,0]); + t[8] = #x86_VPBLENDD_256(t[8], t[5], (8u1)[0,0,1,1,0,0,0,0]); + state[5] = #x86_VPBLENDD_256(state[5], t[2], (8u1)[0,0,1,1,0,0,0,0]); + t[7] = #x86_VPBLENDD_256(t[7], t[6], (8u1)[0,0,1,1,0,0,0,0]); + state[3] = #x86_VPBLENDD_256(state[3], t[5], (8u1)[1,1,0,0,0,0,0,0]); + t[8] = #x86_VPBLENDD_256(t[8], t[6], (8u1)[1,1,0,0,0,0,0,0]); + state[5] = #x86_VPBLENDD_256(state[5], t[6], (8u1)[1,1,0,0,0,0,0,0]); + t[7] = #x86_VPBLENDD_256(t[7], t[4], (8u1)[1,1,0,0,0,0,0,0]); + state[3] = !state[3] & t[8]; + state[5] = !state[5] & t[7]; + state[6] = #x86_VPBLENDD_256(t[5], t[2], (8u1)[0,0,0,0,1,1,0,0]); + t[8] = #x86_VPBLENDD_256(t[3], t[5], (8u1)[0,0,0,0,1,1,0,0]); + state[3] = state[3] ^ t[3]; + state[6] = #x86_VPBLENDD_256(state[6], t[3], (8u1)[0,0,1,1,0,0,0,0]); + t[8] = #x86_VPBLENDD_256(t[8], t[4], (8u1)[0,0,1,1,0,0,0,0]); + state[5] = state[5] ^ t[5]; + state[6] = #x86_VPBLENDD_256(state[6], t[4], (8u1)[1,1,0,0,0,0,0,0]); + t[8] = #x86_VPBLENDD_256(t[8], t[2], (8u1)[1,1,0,0,0,0,0,0]); + state[6] = !state[6] & t[8]; + state[6] = state[6] ^ t[6]; + state[4] = #x86_VPERMQ(t[1], (4u2)[0,1,3,2]); + t[8] = #x86_VPBLENDD_256(state[4], state[0], (8u1)[0,0,1,1,0,0,0,0]); + state[1] = #x86_VPERMQ(t[1], (4u2)[0,3,2,1]); + state[1] = #x86_VPBLENDD_256(state[1], state[0], (8u1)[1,1,0,0,0,0,0,0]); + state[1] = !state[1] & t[8]; + state[2] = #x86_VPBLENDD_256(t[4], t[5], (8u1)[0,0,0,0,1,1,0,0]); + t[7] = #x86_VPBLENDD_256(t[6], t[4], (8u1)[0,0,0,0,1,1,0,0]); + state[2] = #x86_VPBLENDD_256(state[2], t[6], (8u1)[0,0,1,1,0,0,0,0]); + t[7] = #x86_VPBLENDD_256(t[7], t[3], (8u1)[0,0,1,1,0,0,0,0]); + state[2] = #x86_VPBLENDD_256(state[2], t[3], (8u1)[1,1,0,0,0,0,0,0]); + t[7] = #x86_VPBLENDD_256(t[7], t[5], (8u1)[1,1,0,0,0,0,0,0]); + state[2] = !state[2] & t[7]; + state[2] = state[2] ^ t[2]; + t[0] = #x86_VPERMQ(t[0], (4u2)[0,0,0,0]); + state[3] = #x86_VPERMQ(state[3], (4u2)[0,1,2,3]); + state[5] = #x86_VPERMQ(state[5], (4u2)[2,0,3,1]); + state[6] = #x86_VPERMQ(state[6], (4u2)[1,3,0,2]); + state[4] = #x86_VPBLENDD_256(t[6], t[3], (8u1)[0,0,0,0,1,1,0,0]); + t[7] = #x86_VPBLENDD_256(t[5], t[6], (8u1)[0,0,0,0,1,1,0,0]); + state[4] = #x86_VPBLENDD_256(state[4], t[5], (8u1)[0,0,1,1,0,0,0,0]); + t[7] = #x86_VPBLENDD_256(t[7], t[2], (8u1)[0,0,1,1,0,0,0,0]); + state[4] = #x86_VPBLENDD_256(state[4], t[2], (8u1)[1,1,0,0,0,0,0,0]); + t[7] = #x86_VPBLENDD_256(t[7], t[3], (8u1)[1,1,0,0,0,0,0,0]); + state[4] = !state[4] & t[7]; + state[0] = state[0] ^ t[0]; + state[1] = state[1] ^ t[1]; + state[4] = state[4] ^ t[4]; + + //######################################## Iota + state[0] = state[0] ^ (u256)[iotas + 32*(0) - 0]; + + iotas = iotas + 32; + (_,_,_,zf,r) = #x86_DEC_32(r); + } (!zf) + + return state; +} + + +u64 g_zero = 0; + + +fn keccak_init() -> reg u256[7] +{ + inline int i; + reg u256[7] state; + + state[0] = #x86_VPBROADCAST_4u64(g_zero); + + for i=1 to 7 + { state[i] = state[0]; } + + return state; +} + + +fn init_s_state() -> stack u64[28] +{ + inline int i; + stack u64[28] s_state; + reg u256 zero; + + zero = #x86_VPBROADCAST_4u64(g_zero); + for i=0 to 7 + { s_state[u256 i] = zero; } + + return s_state; +} + + +fn add_full_block( + reg u256[7] state, + stack u64[28] s_state, + reg u64 a_jagged, + reg u64 in inlen, + reg u64 rate +) -> reg u256[7], stack u64[28], reg u64, reg u64 +{ + + inline int i; + reg u64 j l t rate8; + reg u8 c; + + rate8 = rate; + rate8 >>= 3; + j = 0; + while ( j < rate8 ) + { + t = [in + 8*j]; + l = [a_jagged + 8*( j)]; + s_state[(int) l] = t; + j += 1; + } + + // + t = s_state[0]; + s_state[1] = t; + s_state[2] = t; + s_state[3] = t; + // + + for i = 0 to 7 + { state[i] ^= s_state[u256 i]; } + + in += rate; + inlen -= rate; + + return state, s_state, in, inlen; +} + + +fn add_final_block( + reg u256[7] state, + stack u64[28] s_state, + reg u64 a_jagged, + reg u64 in inlen, + reg u8 trail_byte, + reg u64 rate +) -> reg u256[7] +{ + inline int i; + reg u64 j l t inlen8; + reg u8 c; + + s_state = init_s_state(); + + inlen8 = inlen; + inlen8 >>= 3; + j = 0; + while ( j < inlen8 ) + { + t = [in + 8*j]; + l = [a_jagged + 8*( j)]; + s_state[(int) l] = t; + j += 1; + } + l = [a_jagged + 8*( j)]; + l <<= 3; + j <<= 3; + + while ( j < inlen ) + { + c = (u8)[in + j]; + s_state[u8 (int) l] = c; + j += 1; + l += 1; + } + + s_state[u8 (int) l] = trail_byte; + + // j = (rate-1) >> 3; // TODO IMPROVE ME + j = rate; j -= 1; j >>= 3; + l = [a_jagged + 8*( j)]; + l <<= 3; + // l += ((rate-1) & 0x7); // TODO IMPROVE ME + j = rate; j -= 1; j &= 0x7; + l += j; + + s_state[u8 (int) l] ^= 0x80; + + // + t = s_state[0]; + s_state[1] = t; + s_state[2] = t; + s_state[3] = t; + // + + for i = 0 to 7 + { state[i] ^= s_state[u256 i]; } + + return state; +} + + +// obs: @pre: len <= rate_in_bytes +fn xtr_full_block( + reg u256[7] state, + reg u64 a_jagged, + reg u64 out, + reg u64 len +) -> reg u64 +{ + inline int i; + stack u64[28] s_state; + reg u64 j l t len8; + reg u8 c; + + for i = 0 to 7 + { s_state[u256 i] = state[i]; } + + len8 = len; + len8 >>= 3; + j = 0; + while ( j < len8 ) + { + l = [a_jagged + 8*( j)]; + t = s_state[(int) l]; + [out + 8*j] = t; + j += 1; + } + + out += len; + + return out; +} + + +// obs: @pre: len <= rate_in_bytes +fn xtr_bytes( + reg u256[7] state, + reg u64 a_jagged, + reg u64 out, + reg u64 len +) -> reg u64 +{ + inline int i; + stack u64[28] s_state; + reg u64 j l t len8; + reg u8 c; + + for i = 0 to 7 + { s_state[u256 i] = state[i]; } + + len8 = len; + len8 >>= 3; + j = 0; + while ( j < len8 ) + { + l = [a_jagged + 8*( j)]; + t = s_state[(int) l]; + [out + 8*j] = t; + j += 1; + } + l = [a_jagged + 8*( j)]; + + j <<= 3; + l <<= 3; + + while ( j < len ) + { + c = s_state[u8 (int) l]; + (u8)[out + j] = c; + j += 1; + l += 1; + } + + out += len; + + return out; +} + + +fn absorb( + reg u256[7] state, + reg u64 rhotates_left rhotates_right iotas a_jagged, + reg u64 in inlen, + reg u8 trail_byte, + reg u64 rate +) -> reg u256[7] +{ + stack u64[28] s_state; + s_state = init_s_state(); + + // intermediate blocks + while ( inlen >= rate ) + { + state, s_state, in, inlen = add_full_block(state, s_state, a_jagged, in, inlen, rate); + state = __keccak_f1600_avx2(state, rhotates_left, rhotates_right, iotas); + } + + // final block + state = add_final_block(state, s_state, a_jagged, in, inlen, trail_byte, rate); + + return state; +} + + +fn squeeze( + reg u256[7] state, + reg u64 rhotates_left rhotates_right iotas a_jagged, + reg u64 out outlen, + reg u64 rate +) +{ + // intermediate blocks + while ( outlen > rate ) + { + state = __keccak_f1600_avx2(state, rhotates_left, rhotates_right, iotas); + out = xtr_full_block(state, a_jagged, out, rate); + outlen -= rate; + } + + state = __keccak_f1600_avx2(state, rhotates_left, rhotates_right, iotas); + out = xtr_bytes(state, a_jagged, out, outlen); +} + + +fn __keccak_1600( + reg u64 out outlen, + reg u64 rhotates_left rhotates_right iotas a_jagged, + reg u64 in inlen, + reg u8 trail_byte, + reg u64 rate +) +{ + reg u256[7] state; + + state = keccak_init(); + + // absorb + state = absorb(state, + rhotates_left, rhotates_right, iotas, a_jagged, + in, inlen, trail_byte, rate); + + // squeeze + squeeze(state, + rhotates_left, rhotates_right, iotas, a_jagged, + out, outlen, rate); +} + + +export fn keccak_1600(reg u64 out outlen in inlen config glob) +{ + reg u64 rhotates_left rhotates_right iotas a_jagged; + reg u8 trail_byte; // no need to spill + reg u64 rate; + + trail_byte = (u8)[config + 8*0]; + rate = [config + 8*1]; // rate in bytes + + rhotates_left = [glob + 8*0]; + rhotates_right = [glob + 8*1]; + iotas = [glob + 8*2]; + a_jagged = [glob + 8*3]; + + __keccak_1600(out, outlen, + rhotates_left, rhotates_right, iotas, a_jagged, + in, inlen, + trail_byte, rate); +} diff --git a/code/crypto_hash/keccak1600/avx2/keccak_1600.jazz b/code/crypto_hash/keccak1600/avx2/keccak_1600.jazz new file mode 100644 index 0000000..0e00565 --- /dev/null +++ b/code/crypto_hash/keccak1600/avx2/keccak_1600.jazz @@ -0,0 +1,306 @@ +#include "crypto_core/keccakf160064bits/avx2/keccak_f1600.jazz" + + +u64 g_zero = 0; + + +fn keccak_init() -> reg u256[7] +{ + inline int i; + reg u256[7] state; + + state[0] = #x86_VPBROADCAST_4u64(g_zero); + + for i=1 to 7 + { state[i] = state[0]; } + + return state; +} + + +fn init_s_state() -> stack u64[28] +{ + inline int i; + stack u64[28] s_state; + reg u256 zero; + + zero = #x86_VPBROADCAST_4u64(g_zero); + for i=0 to 7 + { s_state[u256 i] = zero; } + + return s_state; +} + + +#ifndef KECCAK_1600_ADD_FULL_BLOCK_IMPLEMENTATION +fn add_full_block( + reg u256[7] state, + stack u64[28] s_state, + reg u64 a_jagged, + reg u64 in inlen, + reg u64 rate +) -> reg u256[7], stack u64[28], reg u64, reg u64 +{ + + inline int i; + reg u64 j l t rate8; + reg u8 c; + + rate8 = rate; + rate8 >>= 3; + j = 0; + while ( j < rate8 ) + { + t = [in + 8*j]; + l = B(a_jagged, j); + s_state[(int) l] = t; + j += 1; + } + + // + t = s_state[0]; + s_state[1] = t; + s_state[2] = t; + s_state[3] = t; + // + + for i = 0 to 7 + { state[i] ^= s_state[u256 i]; } + + in += rate; + inlen -= rate; + + return state, s_state, in, inlen; +} +#endif + + +fn add_final_block( + reg u256[7] state, + stack u64[28] s_state, + reg u64 a_jagged, + reg u64 in inlen, + reg u8 trail_byte, + reg u64 rate +) -> reg u256[7] +{ + inline int i; + reg u64 j l t inlen8; + reg u8 c; + + s_state = init_s_state(); + + inlen8 = inlen; + inlen8 >>= 3; + j = 0; + while ( j < inlen8 ) + { + t = [in + 8*j]; + l = B(a_jagged, j); + s_state[(int) l] = t; + j += 1; + } + l = B(a_jagged, j); + l <<= 3; + j <<= 3; + + while ( j < inlen ) + { + c = (u8)[in + j]; + s_state[u8 (int) l] = c; + j += 1; + l += 1; + } + + s_state[u8 (int) l] = trail_byte; + + // j = (rate-1) >> 3; // TODO IMPROVE ME + j = rate; j -= 1; j >>= 3; + l = B(a_jagged, j); + l <<= 3; + // l += ((rate-1) & 0x7); // TODO IMPROVE ME + j = rate; j -= 1; j &= 0x7; + l += j; + + s_state[u8 (int) l] ^= 0x80; + + // + t = s_state[0]; + s_state[1] = t; + s_state[2] = t; + s_state[3] = t; + // + + for i = 0 to 7 + { state[i] ^= s_state[u256 i]; } + + return state; +} + + +// obs: @pre: len <= rate_in_bytes +fn xtr_full_block( + reg u256[7] state, + reg u64 a_jagged, + reg u64 out, + reg u64 len +) -> reg u64 +{ + inline int i; + stack u64[28] s_state; + reg u64 j l t len8; + reg u8 c; + + for i = 0 to 7 + { s_state[u256 i] = state[i]; } + + len8 = len; + len8 >>= 3; + j = 0; + while ( j < len8 ) + { + l = B(a_jagged, j); + t = s_state[(int) l]; + [out + 8*j] = t; + j += 1; + } + + out += len; + + return out; +} + + +// obs: @pre: len <= rate_in_bytes +fn xtr_bytes( + reg u256[7] state, + reg u64 a_jagged, + reg u64 out, + reg u64 len +) -> reg u64 +{ + inline int i; + stack u64[28] s_state; + reg u64 j l t len8; + reg u8 c; + + for i = 0 to 7 + { s_state[u256 i] = state[i]; } + + len8 = len; + len8 >>= 3; + j = 0; + while ( j < len8 ) + { + l = B(a_jagged, j); + t = s_state[(int) l]; + [out + 8*j] = t; + j += 1; + } + l = B(a_jagged, j); + + j <<= 3; + l <<= 3; + + while ( j < len ) + { + c = s_state[u8 (int) l]; + (u8)[out + j] = c; + j += 1; + l += 1; + } + + out += len; + + return out; +} + + +fn absorb( + reg u256[7] state, + reg u64 rhotates_left rhotates_right iotas a_jagged, + reg u64 in inlen, + reg u8 trail_byte, + reg u64 rate +) -> reg u256[7] +{ + stack u64[28] s_state; + s_state = init_s_state(); + + // intermediate blocks + while ( inlen >= rate ) + { + state, s_state, in, inlen = add_full_block(state, s_state, a_jagged, in, inlen, rate); + state = __keccak_f1600_avx2(state, rhotates_left, rhotates_right, iotas); + } + + // final block + state = add_final_block(state, s_state, a_jagged, in, inlen, trail_byte, rate); + + return state; +} + + +fn squeeze( + reg u256[7] state, + reg u64 rhotates_left rhotates_right iotas a_jagged, + reg u64 out outlen, + reg u64 rate +) +{ + // intermediate blocks + while ( outlen > rate ) + { + state = __keccak_f1600_avx2(state, rhotates_left, rhotates_right, iotas); + out = xtr_full_block(state, a_jagged, out, rate); + outlen -= rate; + } + + state = __keccak_f1600_avx2(state, rhotates_left, rhotates_right, iotas); + out = xtr_bytes(state, a_jagged, out, outlen); +} + + +fn __keccak_1600( + reg u64 out outlen, + reg u64 rhotates_left rhotates_right iotas a_jagged, + reg u64 in inlen, + reg u8 trail_byte, + reg u64 rate +) +{ + reg u256[7] state; + + state = keccak_init(); + + // absorb + state = absorb(state, + rhotates_left, rhotates_right, iotas, a_jagged, + in, inlen, trail_byte, rate); + + // squeeze + squeeze(state, + rhotates_left, rhotates_right, iotas, a_jagged, + out, outlen, rate); +} + + +export fn keccak_1600(reg u64 out outlen in inlen config glob) +{ + reg u64 rhotates_left rhotates_right iotas a_jagged; + reg u8 trail_byte; // no need to spill + reg u64 rate; + + trail_byte = (u8)[config + 8*0]; + rate = [config + 8*1]; // rate in bytes + + rhotates_left = [glob + 8*0]; + rhotates_right = [glob + 8*1]; + iotas = [glob + 8*2]; + a_jagged = [glob + 8*3]; + + __keccak_1600(out, outlen, + rhotates_left, rhotates_right, iotas, a_jagged, + in, inlen, + trail_byte, rate); +} diff --git a/code/crypto_hash/keccak1600/ref/Makefile b/code/crypto_hash/keccak1600/ref/Makefile new file mode 100644 index 0000000..23a2571 --- /dev/null +++ b/code/crypto_hash/keccak1600/ref/Makefile @@ -0,0 +1,12 @@ +# -*- Makefile -*- + +.PHONY: default clean + +default: keccak_1600.japp + @true + +clean: + rm -f keccak_1600.japp + +%.japp: %.jazz + gpp -I../../../ -o $@ $< diff --git a/code/crypto_hash/keccak1600/ref/keccak_1600.japp b/code/crypto_hash/keccak1600/ref/keccak_1600.japp new file mode 100644 index 0000000..c38b908 --- /dev/null +++ b/code/crypto_hash/keccak1600/ref/keccak_1600.japp @@ -0,0 +1,390 @@ +inline +fn index(inline int x, inline int y) -> inline int { + inline int r; + r = (x % 5) + 5 * (y % 5); + return r; +} + + +inline +fn ROL64(reg u64 x, inline int c) -> reg u64 { + reg u64 y; + _, _, y = #x86_ROL_64(x, c); + return y; +} + + +fn theta(stack u64[25] a) -> stack u64[25] { + inline int x, y; + reg u64[5] c, d; + + for x = 0 to 5 { + c[x] = 0; + for y = 0 to 5 { + c[x] ^= a[x + 5 * y]; + } + } + + for x = 0 to 5 { + /* d[x] = ROL64(c[(x + 1) % 5], 1); */ + /* extraction fails */ + + /* _, _, d[x] = #x86_ROL_64(c[(x + 1) % 5], 1);*/ + /* d[x] ^= c[(x + 4) % 5];*/ + /* does not compile */ + + d[x] = c[(x + 1) % 5]; + _, _, d[x] = #x86_ROL_64(d[x], 1); + d[x] ^= c[(x + 4) % 5]; + } + + for x = 0 to 5 { + for y = 0 to 5 { + a[x + 5 * y] ^= d[x]; + } + } + + return a; +} + + +inline +fn keccakRhoOffsets(inline int i) -> inline int { + inline int r, x, y, z, t; + + r = 0; + x = 1; + y = 0; + for t = 0 to 24 { + if (i == x + 5 * y) { + r = ((t + 1) * (t + 2) / 2) % 64; + } + z = (2 * x + 3 * y) % 5; + x = y; + y = z; + } + + return r; +} + + +fn rho(stack u64[25] a) -> stack u64[25] { + inline int x, y, i, z; + + for x = 0 to 5 { + for y = 0 to 5 { + i = index(x, y); + z = keccakRhoOffsets(i); + _, _, a[i] = #x86_ROL_64(a[i], z); + } + } + + return a; +} + + +fn pi(stack u64[25] a) -> stack u64[25] { + stack u64[25] b; + reg u64 t; + inline int x, y, i; + for i = 0 to 25 { t = a[i]; b[i] = t; } + + for x = 0 to 5 { + for y = 0 to 5 { + t = b[x + 5 * y]; + i = index(y, 2 * x + 3 * y); + a[i] = t; + } + } + return a; +} + + +fn chi(stack u64[25] a) -> stack u64[25] { + inline int x, y, i; + reg u64[5] c; + for y = 0 to 5 { + for x = 0 to 5 { + i = index(x + 1, y); + c[x] = a[i]; + c[x] = !c[x]; + i = index(x + 2, y); + c[x] &= a[i]; + i = index(x, y); + c[x] ^= a[i]; + } + for x = 0 to 5 { + a[x + 5 * y] = c[x]; + } + } + return a; +} + + +fn iota(stack u64[25] a, reg u64 c) -> stack u64[25] { + a[0] ^= c; + return a; +} + + +fn keccakP1600_round(stack u64[25] state, reg u64 c) -> stack u64[25] { + state = theta(state); + state = rho(state); + state = pi(state); + state = chi(state); + state = iota(state, c); + return state; +} + + + +fn keccakRoundConstants() -> stack u64[24] { + stack u64[24] constants; + reg u64 t; + t = 0x0000000000000001; constants[ 0] = t; + t = 0x0000000000008082; constants[ 1] = t; + t = 0x800000000000808a; constants[ 2] = t; + t = 0x8000000080008000; constants[ 3] = t; + t = 0x000000000000808b; constants[ 4] = t; + t = 0x0000000080000001; constants[ 5] = t; + t = 0x8000000080008081; constants[ 6] = t; + t = 0x8000000000008009; constants[ 7] = t; + t = 0x000000000000008a; constants[ 8] = t; + t = 0x0000000000000088; constants[ 9] = t; + t = 0x0000000080008009; constants[10] = t; + t = 0x000000008000000a; constants[11] = t; + t = 0x000000008000808b; constants[12] = t; + t = 0x800000000000008b; constants[13] = t; + t = 0x8000000000008089; constants[14] = t; + t = 0x8000000000008003; constants[15] = t; + t = 0x8000000000008002; constants[16] = t; + t = 0x8000000000000080; constants[17] = t; + t = 0x000000000000800a; constants[18] = t; + t = 0x800000008000000a; constants[19] = t; + t = 0x8000000080008081; constants[20] = t; + t = 0x8000000000008080; constants[21] = t; + t = 0x0000000080000001; constants[22] = t; + t = 0x8000000080008008; constants[23] = t; + return constants; +} + + +fn __keccak_f1600_ref(stack u64[25] state) -> stack u64[25] { + inline int round; + stack u64[24] constants; + constants = keccakRoundConstants(); + for round = 0 to 24 { + state = keccakP1600_round(state, constants[round]); + } + return state; +} + +fn st0() -> stack u64[25] +{ + stack u64[25] state; + inline int i; + + for i = 0 to 25 { + state[i] = 0; + } + + return state; +} + + +fn add_full_block( + stack u64[25] state, + reg u64 in, + reg u64 inlen, + reg u64 r8 +) -> stack u64[25], reg u64, reg u64 +{ + reg u64 i t r64; + + r64 = r8; + r64 >>= 3; + i = 0; + while (i < r64) + { + t = [in + 8 * i]; + state[(int) i] ^= t; + i = i + 1; + } + + in += r8; + inlen -= r8; + + return state, in, inlen; +} + + + +fn add_final_block( + stack u64[25] state, + reg u64 in, + reg u64 inlen, + reg u8 trail_byte, + reg u64 r8 +) -> stack u64[25] +{ + reg u64 i, t, inlen8; + reg u8 c; + + inlen8 = inlen; + inlen8 >>= 3; + i = 0; + while ( i < inlen8) + { + t = [in + 8*i]; + state[(int) i] ^= t; + i = i + 1; + } + + i <<= 3; + while (i < inlen) + { + c = (u8)[in + i]; + state[u8 (int) i] ^= c; + i = i + 1; + } + + state[u8 (int) i] ^= trail_byte; + + i = r8; + i -= 1; + state[u8 (int) i] ^= 0x80; + + return state; +} + +fn xtr_full_block( + stack u64[25] state, + reg u64 out, + reg u64 outlen, + reg u64 rate +) -> reg u64, reg u64 +{ + reg u64 i t rate64; + + rate64 = rate; + rate64 >>= 3; + i = 0; + while (i < rate64) + { + t = state[(int) i]; + [out + 8 * i] = t; + i = i + 1; + } + + out += rate; + outlen -= rate; + + return out, outlen; +} + + +fn xtr_bytes( + stack u64[25] state, + reg u64 out, + reg u64 outlen +) +{ + reg u64 i t outlen8; + reg u8 c; + + outlen8 = outlen; + outlen8 >>= 3; + i = 0; + while (i < outlen8 ) + { + t = state[(int) i]; + [out + 8 * i] = t; + i = i + 1; + } + i <<= 3; + + while (i < outlen) + { + c = state[u8 (int) i]; + (u8)[out + i] = c; + i = i + 1; + } +} + + +fn __keccak_1600( + stack u64 s_out s_outlen, + reg u64 in inlen, + stack u64 s_trail_byte, + reg u64 rate +) +{ + stack u64[25] state; + stack u64 s_in, s_inlen, s_rate; + reg u64 out, outlen, t; + reg u8 trail_byte; + + state = st0(); + + while ( inlen >= rate ) + { + state, in, inlen = add_full_block(state, in, inlen, rate); + + s_in = in; + s_inlen = inlen; + s_rate = rate; + + state = __keccak_f1600_ref(state); + + inlen = s_inlen; + in = s_in; + rate = s_rate; + } + + t = s_trail_byte; + trail_byte = (8u) t; + state = add_final_block(state, in, inlen, trail_byte, rate); + + outlen = s_outlen; + + while ( outlen > rate ) + { + s_outlen = outlen; + s_rate = rate; + + state = __keccak_f1600_ref(state); + + out = s_out; + outlen = s_outlen; + rate = s_rate; + + out, outlen = xtr_full_block(state, out, outlen, rate); + s_out = out; + } + + s_outlen = outlen; + state = __keccak_f1600_ref(state); + out = s_out; + outlen = s_outlen; + + xtr_bytes(state, out, outlen); +} + + +export fn keccak_1600(reg u64 out outlen in inlen config) +{ + stack u64 s_trail_byte; + stack u64 s_out s_outlen; + reg u64 trail_byte; + reg u64 rate; + + s_out = out; + s_outlen = outlen; + + trail_byte = (64u)(u8)[config + 8*0]; + s_trail_byte = trail_byte; + + rate = [config + 8*1]; // rate8 + + __keccak_1600(s_out, s_outlen, in, inlen, s_trail_byte, rate); +} diff --git a/code/crypto_hash/keccak1600/ref/keccak_1600.jazz b/code/crypto_hash/keccak1600/ref/keccak_1600.jazz new file mode 100644 index 0000000..eb47fbb --- /dev/null +++ b/code/crypto_hash/keccak1600/ref/keccak_1600.jazz @@ -0,0 +1,291 @@ +#include "crypto_core/keccakf160064bits/ref/keccak_f1600.jazz" + +fn st0() -> stack u64[25] +{ + stack u64[25] state; + inline int i; + + for i = 0 to 25 { + state[i] = 0; + } + + return state; +} + + +fn add_full_block( + stack u64[25] state, + reg u64 in, + reg u64 inlen, + reg u64 r8 +) -> stack u64[25], reg u64, reg u64 +{ + reg u64 i t r64; + + r64 = r8; + r64 >>= 3; + i = 0; + while (i < r64) + { + t = [in + 8 * i]; + state[(int) i] ^= t; + i = i + 1; + } + + in += r8; + inlen -= r8; + + return state, in, inlen; +} + + +#if 0 +fn read_last_u64( + reg u64 in inlen, + stack u64 trail_byte +) -> reg u64 +{ + reg bool zf; + reg u64 res delta t trailb; + + trailb = trail_byte; + res = 0; + delta = 0; + zf = #x86_TEST_8(inlen,4); + if (!zf) { + res = (64u)(u32)[in + 0]; + in += 4; + delta = 32; + } + zf = #x86_TEST_8(inlen,2); + if (!zf) { + t = (64u)(u16)[in + 0]; + in += 2; + t <<= delta; + delta += 16; + res += t; + } + zf = #x86_TEST_8(inlen,1); + if (!zf) { + t = (64u)(u8)[in + 0]; + t <<= delta; + delta += 8; + res += t; + } + trailb <<= delta; + res += trailb; + + return res; +} + +fn add_final_block2( + stack u64[25] state, + reg u64 in, + reg u64 inlen, + stack u64 trail_byte, + reg u64 r8 +) -> stack u64[25] +{ + reg u64 i, t; + + i = 0; + while (inlen >= 8) + { + t = [in + 8 * i]; + state[(int) i] ^= t; + i = i + 1; + inlen = inlen - 8; + } + + // read last (incomplete) 64bit word + in = in + 8*i; + t = read_last_u64(in, inlen, trail_byte); + state[(int) i] ^= t; + +/* + // set last bit + i = r8; + i >>= 3; + t = 1; + t <<= 63; + i -= 1; + state[(int) i] ^= t; +*/ + // set last bit + i = r8; + i -=1; + state[u8 (int) i] ^= 0x80; + + return state; +} +#endif + +fn add_final_block( + stack u64[25] state, + reg u64 in, + reg u64 inlen, + reg u8 trail_byte, + reg u64 r8 +) -> stack u64[25] +{ + reg u64 i, t, inlen8; + reg u8 c; + + inlen8 = inlen; + inlen8 >>= 3; + i = 0; + while ( i < inlen8) + { + t = [in + 8*i]; + state[(int) i] ^= t; + i = i + 1; + } + + i <<= 3; + while (i < inlen) + { + c = (u8)[in + i]; + state[u8 (int) i] ^= c; + i = i + 1; + } + + state[u8 (int) i] ^= trail_byte; + + i = r8; + i -= 1; + state[u8 (int) i] ^= 0x80; + + return state; +} + +fn xtr_full_block( + stack u64[25] state, + reg u64 out, + reg u64 outlen, + reg u64 rate +) -> reg u64, reg u64 +{ + reg u64 i t rate64; + + rate64 = rate; + rate64 >>= 3; + i = 0; + while (i < rate64) + { + t = state[(int) i]; + [out + 8 * i] = t; + i = i + 1; + } + + out += rate; + outlen -= rate; + + return out, outlen; +} + + +fn xtr_bytes( + stack u64[25] state, + reg u64 out, + reg u64 outlen +) +{ + reg u64 i t outlen8; + reg u8 c; + + outlen8 = outlen; + outlen8 >>= 3; + i = 0; + while (i < outlen8 ) + { + t = state[(int) i]; + [out + 8 * i] = t; + i = i + 1; + } + i <<= 3; + + while (i < outlen) + { + c = state[u8 (int) i]; + (u8)[out + i] = c; + i = i + 1; + } +} + + +fn __keccak_1600( + stack u64 s_out s_outlen, + reg u64 in inlen, + stack u64 s_trail_byte, + reg u64 rate +) +{ + stack u64[25] state; + stack u64 s_in, s_inlen, s_rate; + reg u64 out, outlen, t; + reg u8 trail_byte; + + state = st0(); + + while ( inlen >= rate ) + { + state, in, inlen = add_full_block(state, in, inlen, rate); + + s_in = in; + s_inlen = inlen; + s_rate = rate; + + state = __keccak_f1600_ref(state); + + inlen = s_inlen; + in = s_in; + rate = s_rate; + } + + t = s_trail_byte; + trail_byte = (8u) t; + state = add_final_block(state, in, inlen, trail_byte, rate); + + outlen = s_outlen; + + while ( outlen > rate ) + { + s_outlen = outlen; + s_rate = rate; + + state = __keccak_f1600_ref(state); + + out = s_out; + outlen = s_outlen; + rate = s_rate; + + out, outlen = xtr_full_block(state, out, outlen, rate); + s_outlen = outlen; + s_out = out; + } + + state = __keccak_f1600_ref(state); + out = s_out; + outlen = s_outlen; + + xtr_bytes(state, out, outlen); +} + + +export fn keccak_1600(reg u64 out outlen in inlen config) +{ + stack u64 s_trail_byte; + stack u64 s_out s_outlen; + reg u64 trail_byte; + reg u64 rate; + + s_out = out; + s_outlen = outlen; + + trail_byte = (64u)(u8)[config + 8*0]; + s_trail_byte = trail_byte; + + rate = [config + 8*1]; // rate8 + + __keccak_1600(s_out, s_outlen, in, inlen, s_trail_byte, rate); +} diff --git a/code/crypto_hash/keccak1600/scalar/Makefile b/code/crypto_hash/keccak1600/scalar/Makefile new file mode 100644 index 0000000..23a2571 --- /dev/null +++ b/code/crypto_hash/keccak1600/scalar/Makefile @@ -0,0 +1,12 @@ +# -*- Makefile -*- + +.PHONY: default clean + +default: keccak_1600.japp + @true + +clean: + rm -f keccak_1600.japp + +%.japp: %.jazz + gpp -I../../../ -o $@ $< diff --git a/code/crypto_hash/keccak1600/scalar/keccak_1600.japp b/code/crypto_hash/keccak1600/scalar/keccak_1600.japp new file mode 100644 index 0000000..e14191c --- /dev/null +++ b/code/crypto_hash/keccak1600/scalar/keccak_1600.japp @@ -0,0 +1,481 @@ + + // 0 uses external memory for the stack space + // 1 uses stack u64[] array + + + + + + +fn index(inline int x, inline int y) -> inline int { + inline int r; + r = 5*(x % 5) + (y % 5); + return r; +} + + + +fn keccak_rho_offsets(inline int i) -> inline int +{ + inline int r, x, y, z, t; + r = 0; + x = 1; + y = 0; + for t = 0 to 24 + { if ( i == x + 5 * y ) + { r = ((t + 1) * (t + 2) / 2) % 64; + } + z = (2 * x + 3 * y) % 5; + x = y; + y = z; + } + + return r; +} + + + +fn rhotates(inline int x y) -> inline int +{ + inline int i r; + i = index(x, y); + r = keccak_rho_offsets(i); + return r; +} + + + +fn ROL64(reg u64 x, inline int c) -> reg u64 +{ + reg u64 y; + if (c == 0) + { y = x; } + else + { _, _, y = #x86_ROL_64(x, c); } + return y; +} + + +fn theta_sum(stack u64[25] a) -> reg u64[5] +{ + inline int i j; + reg u64[5] c; + + for i=0 to 5 + { c[i] = a[(5*(( 0) % 5) + (( i) % 5))]; } + + for j=1 to 5 + { for i=0 to 5 + { c[i] ^= a[(5*(( j) % 5) + (( i) % 5))]; } + } + + return c; +} + + + +fn theta_rol(reg u64[5] c) -> reg u64[5] +{ + inline int i; + reg u64[5] d; + reg u64 t r; + + for i = 0 to 5 + { d[i] = c[(i+1)%5]; + _, _, d[i] = #x86_ROL_64(d[i], 1); + d[i] ^= c[(i+4)%5]; + } + + return d; +} + + + +fn rol_sum( + reg u64[5] d, + stack u64[25] a, + inline int offset +) -> reg u64[5] +{ + inline int j j1 k; + reg u64[5] c; + reg u64 t; + + for j = 0 to 5 + { + j1 = (j+offset) % 5; + k = rhotates(j, j1); + t = a[(5*((j) % 5) + ((j1) % 5))]; + t ^= d[j1]; + t = ROL64(t, k); + c[j] = t; + } + + return c; +} + + + +fn set_row( + stack u64[25] r, + inline int row, + reg u64[5] c, + stack u64 iota +) -> stack u64[25] +{ + inline int j j1 j2; + reg u64 t; + + for j= 0 to 5 + { + j1 = (j+1) % 5; + j2 = (j+2) % 5; + t = !c[j1] & c[j2]; + if row==0 && j==0 { t ^= iota; } + t ^= c[j]; + r[(5*(( row) % 5) + (( j) % 5))] = t; + } + + return r; +} + + + +fn round2x( + stack u64[25] a, + stack u64[25] r, + reg u64 iotas, + inline int o +) -> stack u64[25], stack u64[25] +{ + reg u64[5] c d; + stack u64 iota; + + iota = [iotas + o]; + c = theta_sum(a); + d = theta_rol(c); + c = rol_sum(d, a, 0); + r = set_row(r, 0, c, iota); + c = rol_sum(d, a, 3); + r = set_row(r, 1, c, iota); + c = rol_sum(d, a, 1); + r = set_row(r, 2, c, iota); + c = rol_sum(d, a, 4); + r = set_row(r, 3, c, iota); + c = rol_sum(d, a, 2); + r = set_row(r, 4, c, iota); + + return a, r; +} + + + +fn __keccak_f1600_scalar( + stack u64[25] a, + reg u64 iotas +) -> stack u64[25], reg u64 +{ + reg bool zf; + stack u64[25] r; + + while + { + a, r = round2x(a, r, iotas, 0); + r, a = round2x(r, a, iotas, 8); + iotas += 16; + _, _, _, _, zf = #x86_TEST_8(iotas,255); + } (!zf) + + iotas -= 192; + + return a, iotas; +} + + +fn spill_2(reg u64 a b) -> stack u64, stack u64 +{ + stack u64 sa sb; + sa = a; + sb = b; + return sa, sb; +} + + +fn spill_3(reg u64 a b c) -> stack u64, stack u64, stack u64 +{ + stack u64 sa sb sc; + sa = a; + sb = b; + sc = c; + return sa, sb, sc; +} + + +fn load_2(stack u64 sa sb) -> reg u64, reg u64 +{ + reg u64 a b; + a = sa; + b = sb; + return a, b; +} + + +fn load_3(stack u64 sa sb sc) -> reg u64, reg u64, reg u64 +{ + reg u64 a b c; + a = sa; + b = sb; + c = sc; + return a, b, c; +} + + +fn keccak_init( + ) -> stack u64[25] +{ + stack u64[25] state; + reg u64 i t; + + _, _, _, _, _, t = #set0(); + + + i = 0; + while (i < 25) + { state[(int)i] = t; + i += 1; + } + + return state; +} + + +fn add_full_block( + stack u64[25] state, + reg u64 in, + reg u64 inlen, + reg u64 rate +) -> stack u64[25], reg u64, reg u64 +{ + reg u64 i t rate64; + + rate64 = rate; + rate64 >>= 3; + i = 0; + while( i < rate64) + { + t = [in + 8*i]; + state[(int)i] ^= t; + i+=1; + } + + in += rate; + inlen -= rate; + + return state, in, inlen; +} + + + + +// obs: @pre: inlen < rate_in_bytes +fn add_final_block( + stack u64[25] state, + reg u64 in, + reg u64 inlen, + reg u8 trail_byte, + reg u64 rate +) -> stack u64[25] +{ + reg u64 i t inlen8; + reg u8 c; + + inlen8 = inlen; + inlen8 >>= 3; + i = 0; + while ( i < inlen8 ) + { + t = [in + 8*i]; + state[(int)i] ^= t; + i += 1; + } + + + i <<= 3; + while ( i < inlen ) + { + c = (u8)[in + i]; + state[u8 (int)(i)] ^= c; + i += 1; + } + + state[u8 (int)(i)] ^= trail_byte; + + i = rate; + i -= 1; + state[u8 (int)(i)] ^= 0x80; + + return state; +} + + +fn absorb( + stack u64[25] state, + reg u64 iotas, + reg u64 in inlen, + stack u64 s_trail_byte, + reg u64 rate // rate already in bytes -- it is returned bc of spills +) -> stack u64[25], reg u64, reg u64 +{ + stack u64 s_in s_inlen s_rate; + reg u8 trail_byte; + reg u64 t; + + // intermediate blocks + while ( inlen >= rate ) + { + state, in, inlen = add_full_block(state, in, inlen, rate); + s_in, s_inlen, s_rate = spill_3(in, inlen, rate); + + state, iotas = __keccak_f1600_scalar(state, iotas); + in, inlen, rate = load_3(s_in, s_inlen, s_rate); + } + + // final block + t = s_trail_byte; + trail_byte = (8u) t; + + state = add_final_block(state, in, inlen, trail_byte, rate); + + return state, iotas, rate; +} + + +fn xtr_full_block( + stack u64[25] state, + reg u64 out, + reg u64 outlen, + reg u64 rate +) -> reg u64, reg u64 +{ + reg u64 i t rate64; + + rate64 = rate; + rate64 >>= 3; + i = 0; + while ( i < rate64 ) + { + t = state[(int)i]; + [out + 8*i] = t; + i += 1; + } + + out += rate; + outlen -= rate; + + return out, outlen; +} + + +fn xtr_bytes( + stack u64[25] state, + reg u64 out, + reg u64 outlen +) -> reg u64 +{ + reg u64 i t outlen8; + reg u8 c; + + outlen8 = outlen; + outlen8 >>= 3; + i = 0; + while ( i < outlen8 ) + { + t = state[(int)i]; + [out + 8*i] = t; + i += 1; + } + i <<= 3; + + while ( i < outlen ) + { + c = state[u8 (int)(i)]; + (u8)[out + i] = c; + i += 1; + } + + out += outlen; + return out; +} + + +fn squeeze( + stack u64[25] state, + reg u64 iotas, + stack u64 s_out, + reg u64 outlen, + reg u64 rate +) +{ + reg u64 out; + stack u64 s_outlen s_rate; + + // intermediate blocks + while ( outlen > rate ) + { + s_outlen, s_rate = spill_2(outlen, rate); + state, iotas = __keccak_f1600_scalar(state, iotas); + out, outlen, rate = load_3(s_out, s_outlen, s_rate); + + out, outlen = xtr_full_block(state, out, outlen, rate); + s_out = out; + } + + s_outlen = outlen; + state, iotas = __keccak_f1600_scalar(state, iotas); + out, outlen = load_2(s_out, s_outlen); + + out = xtr_bytes(state, out, outlen); +} + + +fn __keccak_1600( + stack u64 s_out s_outlen, + reg u64 iotas, + reg u64 in inlen , + stack u64 s_trail_byte, + reg u64 rate +) +{ + stack u64[25] state; + reg u64 outlen; + + state = keccak_init(); + + // absorb + state, iotas, rate = absorb(state, iotas, in, inlen, s_trail_byte, rate); + + // squeeze + outlen = s_outlen; + squeeze(state, iotas, s_out, outlen, rate); +} + + +export fn keccak_1600(reg u64 out outlen in inlen_ config iotas ) +{ + stack u64 s_trail_byte; + stack u64 s_out s_outlen; + reg u64 trail_byte; + reg u64 rate inlen; + + s_out = out; + s_outlen = outlen; + + inlen = inlen_; // swap register, rcx is needed + + trail_byte = (64u)(u8)[config + 8*0]; + s_trail_byte = trail_byte; + + rate = [config + 8*1]; // rate in bytes + + __keccak_1600(s_out, s_outlen, iotas, in, inlen, s_trail_byte, rate); +} diff --git a/code/crypto_hash/keccak1600/scalar/keccak_1600.jazz b/code/crypto_hash/keccak1600/scalar/keccak_1600.jazz new file mode 100644 index 0000000..c6d4f15 --- /dev/null +++ b/code/crypto_hash/keccak1600/scalar/keccak_1600.jazz @@ -0,0 +1,344 @@ +#include "crypto_core/keccakf160064bits/scalar/keccak_f1600.jazz" + + +fn spill_2(reg u64 a b) -> stack u64, stack u64 +{ + stack u64 sa sb; + sa = a; + sb = b; + return sa, sb; +} + + +fn spill_3(reg u64 a b c) -> stack u64, stack u64, stack u64 +{ + stack u64 sa sb sc; + sa = a; + sb = b; + sc = c; + return sa, sb, sc; +} + + +fn load_2(stack u64 sa sb) -> reg u64, reg u64 +{ + reg u64 a b; + a = sa; + b = sb; + return a, b; +} + + +fn load_3(stack u64 sa sb sc) -> reg u64, reg u64, reg u64 +{ + reg u64 a b c; + a = sa; + b = sb; + c = sc; + return a, b, c; +} + + +fn keccak_init( + #if !STATE_IN_STACK + reg u64 m + #endif +) -> _state_t +{ + _state_t state; + reg u64 i t; + + _, _, _, _, _, t = #set0(); + + #if !STATE_IN_STACK + state = m; //if state is in stack this is just ignored + #endif + + i = 0; + while (i < 25) + { B(state,i) = t; + i += 1; + } + + return state; +} + + +#ifndef KECCAK_1600_ADD_FULL_BLOCK_IMPLEMENTATION +fn add_full_block( + _state_t state, + reg u64 in, + reg u64 inlen, + reg u64 rate +) -> _state_t, reg u64, reg u64 +{ + reg u64 i t rate64; + + rate64 = rate; + rate64 >>= 3; + i = 0; + while( i < rate64) + { + t = [in + 8*i]; + B(state,i) ^= t; + i+=1; + } + + in += rate; + inlen -= rate; + + return state, in, inlen; +} +#endif + + +#if 0 +// obs: @pre: inlen < 8 +fn lastu64( + reg u64 in inlen trail_byte +) -> reg u64 +{ + reg bool zf; + reg u64 res delta t; + + res = 0; + delta = 0; + zf = #x86_TEST_8(inlen,4); + if (!zf) { + res = (64u)(u32)[in + 0]; + in += 4; + delta = 32; + } + zf = #x86_TEST_8(inlen,2); + if (!zf) { + t = (64u)(u16)[in + 0]; + in += 2; + t <<= delta; + delta += 16; + res += t; + } + zf = #x86_TEST_8(inlen,1); + if (!zf) { + t = (64u)(u8)[in + 0]; + t <<= delta; + delta += 8; + res += t; + } + trail_byte <<= delta; + res += trail_byte; + + return res; +} +#endif + + +// obs: @pre: inlen < rate_in_bytes +fn add_final_block( + _state_t state, + reg u64 in, + reg u64 inlen, + reg u8 trail_byte, + reg u64 rate +) -> _state_t +{ + reg u64 i t inlen8; + reg u8 c; + + inlen8 = inlen; + inlen8 >>= 3; + i = 0; + while ( i < inlen8 ) + { + t = [in + 8*i]; + B(state,i) ^= t; + i += 1; + } + + #if 0 + in += 8*i; + inlen &= 7; // inlen = inlen % 8 + trail_byte = s_trail_byte; + t = lastu64(in, inlen, trail_byte); + B(state,i) ^= t; + #else + + i <<= 3; + while ( i < inlen ) + { + c = (u8)[in + i]; + B8(state,i) ^= c; + i += 1; + } + + B8(state,i) ^= trail_byte; + #endif + + i = rate; + i -= 1; + B8(state,i) ^= 0x80; + + return state; +} + + +fn absorb( + _state_t state, + reg u64 iotas, + reg u64 in inlen, + stack u64 s_trail_byte, + reg u64 rate // rate already in bytes -- it is returned bc of spills +) -> _state_t, reg u64, reg u64 +{ + stack u64 s_in s_inlen s_rate; + reg u8 trail_byte; + reg u64 t; + + // intermediate blocks + while ( inlen >= rate ) + { + state, in, inlen = add_full_block(state, in, inlen, rate); + s_in, s_inlen, s_rate = spill_3(in, inlen, rate); + + state, iotas = __keccak_f1600_scalar(state, iotas); + in, inlen, rate = load_3(s_in, s_inlen, s_rate); + } + + // final block + t = s_trail_byte; + trail_byte = (8u) t; + + state = add_final_block(state, in, inlen, trail_byte, rate); + + return state, iotas, rate; +} + + +fn xtr_full_block( + _state_t state, + reg u64 out, + reg u64 outlen, + reg u64 rate +) -> reg u64, reg u64 +{ + reg u64 i t rate64; + + rate64 = rate; + rate64 >>= 3; + i = 0; + while ( i < rate64 ) + { + t = B(state,i); + [out + 8*i] = t; + i += 1; + } + + out += rate; + outlen -= rate; + + return out, outlen; +} + + +fn xtr_bytes( + _state_t state, + reg u64 out, + reg u64 outlen +) -> reg u64 +{ + reg u64 i t outlen8; + reg u8 c; + + outlen8 = outlen; + outlen8 >>= 3; + i = 0; + while ( i < outlen8 ) + { + t = B(state,i); + [out + 8*i] = t; + i += 1; + } + i <<= 3; + + while ( i < outlen ) + { + c = B8(state,i); + (u8)[out + i] = c; + i += 1; + } + + out += outlen; + return out; +} + + +fn squeeze( + _state_t state, + reg u64 iotas, + stack u64 s_out, + reg u64 outlen, + reg u64 rate +) +{ + reg u64 out; + stack u64 s_outlen s_rate; + + // intermediate blocks + while ( outlen > rate ) + { + s_outlen, s_rate = spill_2(outlen, rate); + state, iotas = __keccak_f1600_scalar(state, iotas); + out, outlen, rate = load_3(s_out, s_outlen, s_rate); + + out, outlen = xtr_full_block(state, out, outlen, rate); + s_out = out; + } + + s_outlen = outlen; + state, iotas = __keccak_f1600_scalar(state, iotas); + out, outlen = load_2(s_out, s_outlen); + + out = xtr_bytes(state, out, outlen); +} + + +fn __keccak_1600( + stack u64 s_out s_outlen, + reg u64 iotas, + reg u64 in inlen _mem, + stack u64 s_trail_byte, + reg u64 rate +) +{ + _state_t state; + reg u64 outlen; + + state = keccak_init(_mem); + + // absorb + state, iotas, rate = absorb(state, iotas, in, inlen, s_trail_byte, rate); + + // squeeze + outlen = s_outlen; + squeeze(state, iotas, s_out, outlen, rate); +} + + +export fn keccak_1600(reg u64 out outlen in inlen_ config iotas _mem) +{ + stack u64 s_trail_byte; + stack u64 s_out s_outlen; + reg u64 trail_byte; + reg u64 rate inlen; + + s_out = out; + s_outlen = outlen; + + inlen = inlen_; // swap register, rcx is needed + + trail_byte = (64u)(u8)[config + 8*0]; + s_trail_byte = trail_byte; + + rate = [config + 8*1]; // rate in bytes + + __keccak_1600(s_out, s_outlen, iotas, in, inlen, s_trail_byte, rate); +} diff --git a/code/crypto_hash/keccak1600/scalar_g/Makefile b/code/crypto_hash/keccak1600/scalar_g/Makefile new file mode 100644 index 0000000..23a2571 --- /dev/null +++ b/code/crypto_hash/keccak1600/scalar_g/Makefile @@ -0,0 +1,12 @@ +# -*- Makefile -*- + +.PHONY: default clean + +default: keccak_1600.japp + @true + +clean: + rm -f keccak_1600.japp + +%.japp: %.jazz + gpp -I../../../ -o $@ $< diff --git a/code/crypto_hash/keccak1600/scalar_g/keccak_1600.japp b/code/crypto_hash/keccak1600/scalar_g/keccak_1600.japp new file mode 100644 index 0000000..af80a95 --- /dev/null +++ b/code/crypto_hash/keccak1600/scalar_g/keccak_1600.japp @@ -0,0 +1,532 @@ + + // 0 uses external memory for the stack space + // 1 uses stack u64[] array + + + + + +// reversed iotas with the first position at zero +u64[25] iotas = +{ 0x0000000000000000 + , 0x8000000080008008 + , 0x0000000080000001 + , 0x8000000000008080 + , 0x8000000080008081 + , 0x800000008000000a + , 0x000000000000800a + , 0x8000000000000080 + , 0x8000000000008002 + , 0x8000000000008003 + , 0x8000000000008089 + , 0x800000000000008b + , 0x000000008000808b + , 0x000000008000000a + , 0x0000000080008009 + , 0x0000000000000088 + , 0x000000000000008a + , 0x8000000000008009 + , 0x8000000080008081 + , 0x0000000080000001 + , 0x000000000000808b + , 0x8000000080008000 + , 0x800000000000808a + , 0x0000000000008082 + , 0x0000000000000001 +}; + + +fn index(inline int x, inline int y) -> inline int { + inline int r; + r = 5*(x % 5) + (y % 5); + return r; +} + + +fn keccak_rho_offsets(inline int i) -> inline int +{ + inline int r, x, y, z, t; + r = 0; + x = 1; + y = 0; + for t = 0 to 24 + { if ( i == x + 5 * y ) + { r = ((t + 1) * (t + 2) / 2) % 64; + } + z = (2 * x + 3 * y) % 5; + x = y; + y = z; + } + + return r; +} + + +fn rhotates(inline int x y) -> inline int +{ + inline int i r; + i = index(x, y); + r = keccak_rho_offsets(i); + return r; +} + + +fn ROL64(reg u64 x, inline int c) -> reg u64 +{ + reg u64 y; + if (c == 0) + { y = x; } + else + { _, _, y = #x86_ROL_64(x, c); } + return y; +} + + +fn theta_sum(stack u64[25] A) -> reg u64[5] +{ + inline int i j; + reg u64[5] C; + + for i=0 to 5 + { C[i] = A[(5*(( 0) % 5) + (( i) % 5))]; } + + for j=1 to 5 + { for i=0 to 5 + { C[i] ^= A[(5*(( j) % 5) + (( i) % 5))]; } + } + + return C; +} + + +fn theta_rol(reg u64[5] C) -> reg u64[5] +{ + inline int i; + reg u64[5] D; + reg u64 t r; + + for i = 0 to 5 + { D[i] = ROL64(C[(i+1)%5], 1); + D[i] ^= C[(i+4)%5]; + } + + return D; +} + + +fn rol_sum( + reg u64[5] D, + stack u64[25] A, + inline int offset +) -> reg u64[5] +{ + inline int j j1 k; + reg u64[5] C; + reg u64 t; + + for j = 0 to 5 + { + j1 = (j+offset) % 5; + k = rhotates(j, j1); + t = A[(5*((j) % 5) + ((j1) % 5))]; + t ^= D[j1]; + t = ROL64(t, k); + C[j] = t; + } + + return C; +} + + +fn set_row( + stack u64[25] R, + inline int row, + reg u64[5] C, + stack u64[25] s_iotas, + reg u64 r +) -> stack u64[25] +{ + inline int j j1 j2; + reg u64 t; + + for j= 0 to 5 + { + j1 = (j+1) % 5; + j2 = (j+2) % 5; + t = !C[j1] & C[j2]; + if row==0 && j==0 { t ^= s_iotas[(int) r]; } + t ^= C[j]; + R[(5*(( row) % 5) + (( j) % 5))] = t; + } + + return R; +} + + +fn round2x( + stack u64[25] A, + stack u64[25] R, + stack u64[25] s_iotas, + reg u64 r +) -> stack u64[25], stack u64[25] +{ + reg u64[5] C D; + + C = theta_sum(A); + D = theta_rol(C); + C = rol_sum(D, A, 0); + R = set_row(R, 0, C, s_iotas, r); + C = rol_sum(D, A, 3); + R = set_row(R, 1, C, s_iotas, r); + C = rol_sum(D, A, 1); + R = set_row(R, 2, C, s_iotas, r); + C = rol_sum(D, A, 4); + R = set_row(R, 3, C, s_iotas, r); + C = rol_sum(D, A, 2); + R = set_row(R, 4, C, s_iotas, r); + + return A, R; +} + + +fn __keccak_f1600_scalar_g( + stack u64[25] A +) -> stack u64[25] +{ + reg bool zf; + stack u64[25] R; + stack u64[25] s_iotas; + reg u64 r; + + + + r = 24; + s_iotas = iotas; + + align while + { + A, R = round2x(A, R, s_iotas, r); + r = #x86_DEC(r); + R, A = round2x(R, A, s_iotas, r); + (_, _, _, zf, r) = #x86_DEC(r); + } (!zf) + + + + return A; +} + + +fn spill_2(reg u64 a b) -> stack u64, stack u64 +{ + stack u64 sa sb; + sa = a; + sb = b; + return sa, sb; +} + + +fn spill_3(reg u64 a b c) -> stack u64, stack u64, stack u64 +{ + stack u64 sa sb sc; + sa = a; + sb = b; + sc = c; + return sa, sb, sc; +} + + +fn load_2(stack u64 sa sb) -> reg u64, reg u64 +{ + reg u64 a b; + a = sa; + b = sb; + return a, b; +} + + +fn load_3(stack u64 sa sb sc) -> reg u64, reg u64, reg u64 +{ + reg u64 a b c; + a = sa; + b = sb; + c = sc; + return a, b, c; +} + + +fn keccak_init( + ) -> stack u64[25] +{ + stack u64[25] state; + reg u64 i t; + + _, _, _, _, _, t = #set0(); + + + i = 0; + while (i < 25) + { state[(int)i] = t; + i += 1; + } + + return state; +} + + +fn add_full_block( + stack u64[25] state, + reg u64 in, + reg u64 inlen, + reg u64 rate +) -> stack u64[25], reg u64, reg u64 +{ + reg u64 i t rate8; + + i = 0; + rate8 = rate; + rate8 >>= 3; + while( i < rate8) + { + t = [in + 8*i]; + state[(int)i] ^= t; + i+=1; + } + + in += rate; + inlen -= rate; + + return state, in, inlen; +} + + +// obs: @pre: inlen < 8 +fn lastu64( + reg u64 in inlen suffix +) -> reg u64 +{ + reg bool zf; + reg u64 res delta t; + + res = 0; + delta = 0; + zf = #x86_TEST_8(inlen,4); + if (!zf) { + res = (64u)(u32)[in + 0]; + in += 4; + delta = 32; + } + zf = #x86_TEST_8(inlen,2); + if (!zf) { + t = (64u)(u16)[in + 0]; + in += 2; + t <<= delta; + delta += 16; + res += t; + } + zf = #x86_TEST_8(inlen,1); + if (!zf) { + t = (64u)(u8)[in + 0]; + t <<= delta; + delta += 8; + res += t; + } + suffix = suffix; + suffix <<= delta; + res += suffix; + + return res; +} + + +// obs: @pre: inlen < rate_in_bytes +fn add_final_block( + stack u64[25] state, + reg u64 in, + reg u64 inlen, + stack u8 suffix, + reg u64 rate +) -> stack u64[25] +{ + reg u64 i t inlen8 r_suffix; + reg u8 c; + + inlen8 = inlen; + inlen8 >>= 3; + i = 0; + while ( i < inlen8 ) + { + t = [in + 8*i]; + state[(int)i] ^= t; + i += 1; + } + in += 8*i; + inlen &= 7; // inlen = inlen % 8 + r_suffix = (64u) suffix; + t = lastu64(in, inlen, r_suffix); + state[(int)i] ^= t; + + rate -= 1; + state[u8 (int)(rate)] ^= 0x80; + + return state; +} + + +fn absorb( + stack u64[25] state, + reg u64 in inlen, + stack u8 suffix, + reg u64 rate // rate already in bytes +) -> stack u64[25] +{ + stack u64 s_in s_inlen s_rate; + + // intermediate blocks + while ( inlen >= rate ) + { + state, in, inlen = add_full_block(state, in, inlen, rate); + s_in, s_inlen, s_rate = spill_3(in, inlen, rate); + + state = __keccak_f1600_scalar_g(state); + in, inlen, rate = load_3(s_in, s_inlen, s_rate); + } + + // final block + state = add_final_block(state, in, inlen, suffix, rate); + + return state; +} + + +fn xtr_full_block( + stack u64[25] state, + reg u64 out, + reg u64 len +) -> reg u64 +{ + reg u64 i t len8; + reg u8 c; + + len8 = len; + len8 >>= 3; + i = 0; + while ( i < len8 ) + { + t = state[(int)i]; + [out + 8*i] = t; + i += 1; + } + out += len; + return out; +} + + +fn xtr_bytes( + stack u64[25] state, + reg u64 out, + reg u64 len +) -> reg u64 +{ + reg u64 i t len8; + reg u8 c; + + len8 = len; + len8 >>= 3; + i = 0; + while ( i < len8 ) + { + t = state[(int)i]; + [out + 8*i] = t; + i += 1; + } + i <<= 3; + + while ( i < len ) + { + c = state[u8 (int)(i)]; + (u8)[out + i] = c; + i += 1; + } + + out += len; + return out; +} + + +fn squeeze( + stack u64[25] state, + stack u64 s_out, + stack u64 s_outlen, + reg u64 rate +) +{ + reg u64 out outlen; + stack u64 s_rate; + + outlen = s_outlen; + + // intermediate blocks + while ( outlen > rate ) + { + s_outlen, s_rate = spill_2(outlen, rate); + state = __keccak_f1600_scalar_g(state); + out, rate = load_2(s_out, s_rate); + + out = xtr_full_block(state, out, rate); + s_out = out; + + outlen = s_outlen; + outlen -= rate; + } + + s_outlen = outlen; + state = __keccak_f1600_scalar_g(state); + out, outlen = load_2(s_out, s_outlen); + + out = xtr_bytes(state, out, outlen); +} + + +fn __keccak_1600( + stack u64 s_out s_outlen, + reg u64 in inlen , + stack u8 suffix, + reg u64 rate +) +{ + stack u64[25] state; + stack u64 s_rate; + + state = keccak_init(); + s_rate = rate; + + // absorb + state = absorb(state, in, inlen, suffix, rate); + + // squeeze + rate = s_rate; + squeeze(state, s_out, s_outlen, rate); +} + + +export fn keccak_1600(reg u64 out outlen in inlen_ config ) +{ + stack u8 s_suffix; + stack u64 s_out s_outlen; + reg u8 suffix; + reg u64 rate inlen; + + s_out = out; + s_outlen = outlen; + + inlen = inlen_; // swap register, rcx is needed + + suffix = (u8)[config + 8*0]; + + s_suffix = suffix; + rate = [config + 8*1]; // rate in bytes + + __keccak_1600(s_out, s_outlen, in, inlen, s_suffix, rate); +} + diff --git a/code/crypto_hash/keccak1600/scalar_g/keccak_1600.jazz b/code/crypto_hash/keccak1600/scalar_g/keccak_1600.jazz new file mode 100644 index 0000000..965d312 --- /dev/null +++ b/code/crypto_hash/keccak1600/scalar_g/keccak_1600.jazz @@ -0,0 +1,292 @@ +#include "crypto_core/keccakf160064bits/scalar_g/keccak_f1600.jazz" + + +fn spill_2(reg u64 a b) -> stack u64, stack u64 +{ + stack u64 sa sb; + sa = a; + sb = b; + return sa, sb; +} + + +fn spill_3(reg u64 a b c) -> stack u64, stack u64, stack u64 +{ + stack u64 sa sb sc; + sa = a; + sb = b; + sc = c; + return sa, sb, sc; +} + + +fn load_2(stack u64 sa sb) -> reg u64, reg u64 +{ + reg u64 a b; + a = sa; + b = sb; + return a, b; +} + + +fn load_3(stack u64 sa sb sc) -> reg u64, reg u64, reg u64 +{ + reg u64 a b c; + a = sa; + b = sb; + c = sc; + return a, b, c; +} + + +fn keccak_init( + #if !STATE_IN_STACK + reg u64 m + #endif +) -> _state_t +{ + _state_t state; + reg u64 i t; + + _, _, _, _, _, t = #set0(); + + #if !STATE_IN_STACK + state = m; //if state is in stack this is just ignored + #endif + + i = 0; + while (i < 25) + { B(state,i) = t; + i += 1; + } + + return state; +} + + +#ifndef KECCAK_1600_ADD_FULL_BLOCK_IMPLEMENTATION +fn add_full_block( + _state_t state, + reg u64 in, + reg u64 inlen, + reg u64 rate +) -> _state_t, reg u64, reg u64 +{ + reg u64 i t rate64; + + rate64 = rate; + rate64 >>= 3; + i = 0; + while( i < rate64) + { + t = [in + 8*i]; + B(state,i) ^= t; + i+=1; + } + + in += rate; + inlen -= rate; + + return state, in, inlen; +} +#endif + + +// obs: @pre: inlen < rate_in_bytes +fn add_final_block( + _state_t state, + reg u64 in, + reg u64 inlen, + reg u8 trail_byte, + reg u64 rate +) -> _state_t +{ + reg u64 i t inlen8; + reg u8 c; + + inlen8 = inlen; + inlen8 >>= 3; + i = 0; + while ( i < inlen8 ) + { + t = [in + 8*i]; + B(state,i) ^= t; + i += 1; + } + + i <<= 3; + while ( i < inlen ) + { + c = (u8)[in + i]; + B8(state,i) ^= c; + i += 1; + } + + B8(state,i) ^= trail_byte; + + i = rate; + i -= 1; + B8(state,i) ^= 0x80; + + return state; +} + + +fn absorb( + _state_t state, + reg u64 in inlen, + stack u64 s_trail_byte, + reg u64 rate // rate already in bytes -- it is returned bc of spills +) -> _state_t, reg u64 +{ + stack u64 s_in s_inlen s_rate; + reg u8 trail_byte; + reg u64 t; + + // intermediate blocks + while ( inlen >= rate ) + { + state, in, inlen = add_full_block(state, in, inlen, rate); + s_in, s_inlen, s_rate = spill_3(in, inlen, rate); + + state = __keccak_f1600_scalar_g(state); + in, inlen, rate = load_3(s_in, s_inlen, s_rate); + } + + // final block + t = s_trail_byte; + trail_byte = (8u) t; + + state = add_final_block(state, in, inlen, trail_byte, rate); + + return state, rate; +} + + +fn xtr_full_block( + _state_t state, + reg u64 out, + reg u64 outlen, + reg u64 rate +) -> reg u64, reg u64 +{ + reg u64 i t rate64; + + rate64 = rate; + rate64 >>= 3; + i = 0; + while ( i < rate64 ) + { + t = B(state,i); + [out + 8*i] = t; + i += 1; + } + + out += rate; + outlen -= rate; + + return out, outlen; +} + + +fn xtr_bytes( + _state_t state, + reg u64 out, + reg u64 outlen +) -> reg u64 +{ + reg u64 i t outlen8; + reg u8 c; + + outlen8 = outlen; + outlen8 >>= 3; + i = 0; + while ( i < outlen8 ) + { + t = B(state,i); + [out + 8*i] = t; + i += 1; + } + i <<= 3; + + while ( i < outlen ) + { + c = B8(state,i); + (u8)[out + i] = c; + i += 1; + } + + out += outlen; + return out; +} + + +fn squeeze( + _state_t state, + stack u64 s_out, + reg u64 outlen, + reg u64 rate +) +{ + reg u64 out; + stack u64 s_outlen s_rate; + + // intermediate blocks + while ( outlen > rate ) + { + s_outlen, s_rate = spill_2(outlen, rate); + state = __keccak_f1600_scalar_g(state); + out, outlen, rate = load_3(s_out, s_outlen, s_rate); + + out, outlen = xtr_full_block(state, out, outlen, rate); + s_out = out; + } + + s_outlen = outlen; + state = __keccak_f1600_scalar_g(state); + out, outlen = load_2(s_out, s_outlen); + + out = xtr_bytes(state, out, outlen); +} + + +fn __keccak_1600( + stack u64 s_out s_outlen, + reg u64 in inlen _mem, + stack u64 s_trail_byte, + reg u64 rate +) +{ + _state_t state; + reg u64 outlen; + + state = keccak_init(_mem); + + // absorb + state, rate = absorb(state, in, inlen, s_trail_byte, rate); + + // squeeze + outlen = s_outlen; + squeeze(state, s_out, outlen, rate); +} + + +export fn keccak_1600(reg u64 out outlen in inlen_ config _mem) +{ + stack u64 s_trail_byte; + stack u64 s_out s_outlen; + reg u64 trail_byte; + reg u64 rate inlen; + + s_out = out; + s_outlen = outlen; + + inlen = inlen_; // swap register, rcx is needed + + trail_byte = (64u)(u8)[config + 8*0]; + s_trail_byte = trail_byte; + + rate = [config + 8*1]; // rate in bytes + + __keccak_1600(s_out, s_outlen, in, inlen, s_trail_byte, rate); +} diff --git a/code/crypto_hash/sha3224/.gitignore b/code/crypto_hash/sha3224/.gitignore new file mode 100644 index 0000000..ad1a23f --- /dev/null +++ b/code/crypto_hash/sha3224/.gitignore @@ -0,0 +1 @@ +*.japp diff --git a/code/crypto_hash/sha3224/avx2/Makefile b/code/crypto_hash/sha3224/avx2/Makefile new file mode 100644 index 0000000..1d2484f --- /dev/null +++ b/code/crypto_hash/sha3224/avx2/Makefile @@ -0,0 +1,15 @@ +# -*- Makefile -*- + +.PHONY: default clean + +default: sha3224.japp sha3224.s + @true + +clean: + rm -f sha3224.japp sha3224.s + +%.s: %.japp + jasminc -lea -pasm $< > $@ || rm -f $@ + +%.japp: %.jazz + gpp -I../../../ -o $@ $< diff --git a/code/crypto_hash/sha3224/avx2/sha3224-m.c b/code/crypto_hash/sha3224/avx2/sha3224-m.c new file mode 100644 index 0000000..80ffd48 --- /dev/null +++ b/code/crypto_hash/sha3224/avx2/sha3224-m.c @@ -0,0 +1,85 @@ +#include "crypto_hash.h" +#include "impl.h" +#include "api.h" +#include +#include + + +extern void keccak_1600( + uint8_t *out, + uint64_t outlen, + const uint8_t *in, + size_t inlen, + uint64_t *c, + uint64_t **g +); + + +uint64_t rhotates_left[6*4] __attribute__((aligned(32))) = +{ + 3, 18, 36, 41, + 1, 62, 28, 27, + 45, 6, 56, 39, + 10, 61, 55, 8, + 2, 15, 25, 20, + 44, 43, 21, 14 +}; + + +uint64_t rhotates_right[6*4] __attribute__((aligned(32))) = +{ + 64-3, 64-18, 64-36, 64-41, + 64-1, 64-62, 64-28, 64-27, + 64-45, 64-6, 64-56, 64-39, + 64-10, 64-61, 64-55, 64-8, + 64-2, 64-15, 64-25, 64-20, + 64-44, 64-43, 64-21, 64-14 +}; + + +uint64_t iotas[24*4] __attribute__((aligned(32))) = +{ + 0x0000000000000001UL, 0x0000000000000001UL, 0x0000000000000001UL, 0x0000000000000001UL, + 0x0000000000008082UL, 0x0000000000008082UL, 0x0000000000008082UL, 0x0000000000008082UL, + 0x800000000000808aUL, 0x800000000000808aUL, 0x800000000000808aUL, 0x800000000000808aUL, + 0x8000000080008000UL, 0x8000000080008000UL, 0x8000000080008000UL, 0x8000000080008000UL, + 0x000000000000808bUL, 0x000000000000808bUL, 0x000000000000808bUL, 0x000000000000808bUL, + 0x0000000080000001UL, 0x0000000080000001UL, 0x0000000080000001UL, 0x0000000080000001UL, + 0x8000000080008081UL, 0x8000000080008081UL, 0x8000000080008081UL, 0x8000000080008081UL, + 0x8000000000008009UL, 0x8000000000008009UL, 0x8000000000008009UL, 0x8000000000008009UL, + 0x000000000000008aUL, 0x000000000000008aUL, 0x000000000000008aUL, 0x000000000000008aUL, + 0x0000000000000088UL, 0x0000000000000088UL, 0x0000000000000088UL, 0x0000000000000088UL, + 0x0000000080008009UL, 0x0000000080008009UL, 0x0000000080008009UL, 0x0000000080008009UL, + 0x000000008000000aUL, 0x000000008000000aUL, 0x000000008000000aUL, 0x000000008000000aUL, + 0x000000008000808bUL, 0x000000008000808bUL, 0x000000008000808bUL, 0x000000008000808bUL, + 0x800000000000008bUL, 0x800000000000008bUL, 0x800000000000008bUL, 0x800000000000008bUL, + 0x8000000000008089UL, 0x8000000000008089UL, 0x8000000000008089UL, 0x8000000000008089UL, + 0x8000000000008003UL, 0x8000000000008003UL, 0x8000000000008003UL, 0x8000000000008003UL, + 0x8000000000008002UL, 0x8000000000008002UL, 0x8000000000008002UL, 0x8000000000008002UL, + 0x8000000000000080UL, 0x8000000000000080UL, 0x8000000000000080UL, 0x8000000000000080UL, + 0x000000000000800aUL, 0x000000000000800aUL, 0x000000000000800aUL, 0x000000000000800aUL, + 0x800000008000000aUL, 0x800000008000000aUL, 0x800000008000000aUL, 0x800000008000000aUL, + 0x8000000080008081UL, 0x8000000080008081UL, 0x8000000080008081UL, 0x8000000080008081UL, + 0x8000000000008080UL, 0x8000000000008080UL, 0x8000000000008080UL, 0x8000000000008080UL, + 0x0000000080000001UL, 0x0000000080000001UL, 0x0000000080000001UL, 0x0000000080000001UL, + 0x8000000080008008UL, 0x8000000080008008UL, 0x8000000080008008UL, 0x8000000080008008UL +}; + + +uint64_t a_jagged[25] __attribute__((aligned(32))) = +{ + 0, 4, 5, 6, 7, + 10, 24, 13, 18, 23, + 8, 16, 25, 22, 15, + 11, 12, 21, 26, 19, + 9, 20, 17, 14, 27 +}; + + +int sha3224_avx2(unsigned char *out,const unsigned char *in,unsigned long long inlen) +{ + uint64_t *g[] = {rhotates_left, rhotates_right, iotas, a_jagged}; + uint64_t c[] = {0x06, (1152/8)}; + keccak_1600(out, 28, in, inlen, c, g); + return 0; +} diff --git a/code/crypto_hash/sha3224/avx2/sha3224.jazz b/code/crypto_hash/sha3224/avx2/sha3224.jazz new file mode 100644 index 0000000..d03fb9f --- /dev/null +++ b/code/crypto_hash/sha3224/avx2/sha3224.jazz @@ -0,0 +1,66 @@ +#define KECCAK_1600_ADD_FULL_BLOCK_IMPLEMENTATION 1 + +u64 s_zero = 0; + +fn add_full_block( + reg u256[7] state, + stack u64[28] s_state, + reg u64 a_jagged, + reg u64 in inlen, + reg u64 rate +) -> reg u256[7], stack u64[28], reg u64, reg u64 +{ + reg u256 a00 a01 a11 a21 a31 a32; + reg u256 t11 t41 t31 t21; + reg u256 zero; + reg u64 r10 r20 r30; + stack u64[4] s20; + + r10 = [in + 8*5]; + r20 = [in + 8*10]; + r30 = [in + 8*15]; + + s20[0] = r20; + s20[1] = 0; + s20[2] = r10; + s20[3] = r30; + + a00 = #x86_VPBROADCAST_4u64([in + 8*0]); // (0,0) (0,0) (0,0) (0,0) + a01 = (u256)[in + 8*1]; // (0,4) (0,3) (0,2) (0,1) + + state[0] ^= a00; + state[1] ^= a01; + state[2] ^= s20[u256 0]; + + zero = #x86_VPBROADCAST_4u64(s_zero); + + a11 = (u256)[in + 8*6 ]; // (1,4) (1,3) (1,2) (1,1) + a21 = (u256)[in + 8*11]; // (2,4) (2,3) (2,2) (2,1) + a31 = #x86_VPBROADCAST_2u128((u128)[in + 8*16]); // (3,2) (3,1) (3,2) (3,1) + + a32 = #x86_VPBLENDD_256(a31, zero, (8u1)[1,1,1,1,0,0,1,1]); // ___ ___ (3,2) ___ + a31 = #x86_VPBLENDD_256(a31, zero, (8u1)[1,1,1,1,1,1,0,0]); // ___ ___ ___ (3,1) + + t41 = #x86_VPBLENDD_256(a21, a11, (8u1)[1,1,0,0,0,0,1,1]); // (1,4) (2,3) (2,2) (1,1) + t31 = #x86_VPBLENDD_256(a21, a11, (8u1)[0,0,1,1,1,1,0,0]); // (2,4) (1,3) (1,2) (2,1) + + + t11 = #x86_VPBLENDD_256(t41, zero, (8u1)[1,1,1,1,0,0,0,0]); // ___ ___ (2,2) (1,1) + t21 = #x86_VPBLENDD_256(t31, zero, (8u1)[1,1,0,0,1,1,0,0]); // ___ (1,3) ___ (2,1) + t31 = #x86_VPBLENDD_256(t31, a31, (8u1)[0,0,1,1,0,0,1,1]); // (2,4) ___ (1,2) (3,1) + + state[6] ^= t11; + + t41 = #x86_VPBLENDD_256(t41, a32, (8u1)[0,0,0,0,1,1,1,1]); // (1,4) (2,3) (3,2) ___ + + state[4] ^= t21; + state[3] ^= t31; + state[5] ^= t41; + + in += rate; + inlen -= rate; + + return state, s_state, in, inlen; +} + +#include "crypto_hash/keccak1600/avx2/keccak_1600.jazz" diff --git a/code/crypto_hash/sha3224/avx2/sha3224.s b/code/crypto_hash/sha3224/avx2/sha3224.s new file mode 100644 index 0000000..7b83097 --- /dev/null +++ b/code/crypto_hash/sha3224/avx2/sha3224.s @@ -0,0 +1,532 @@ + .text + .p2align 5 + .globl _keccak_1600 + .globl keccak_1600 +_keccak_1600: +keccak_1600: + pushq %rbp + pushq %rbx + pushq %r12 + pushq %r13 + pushq %r14 + subq $256, %rsp + movb (%r8), %al + movq 8(%r8), %r8 + movq (%r9), %r10 + movq 8(%r9), %r11 + movq 16(%r9), %rbp + movq 24(%r9), %r9 + vpbroadcastq g_zero(%rip), %ymm2 + vmovdqu %ymm2, %ymm3 + vmovdqu %ymm2, %ymm4 + vmovdqu %ymm2, %ymm11 + vmovdqu %ymm2, %ymm10 + vmovdqu %ymm2, %ymm12 + vmovdqu %ymm2, %ymm9 + jmp Lkeccak_1600$15 +Lkeccak_1600$16: + movq 40(%rdx), %rbx + movq 80(%rdx), %r12 + movq 120(%rdx), %r13 + movq %r12, 224(%rsp) + movq $0, 232(%rsp) + movq %rbx, 240(%rsp) + movq %r13, 248(%rsp) + vpbroadcastq (%rdx), %ymm0 + vmovdqu 8(%rdx), %ymm1 + vpxor %ymm0, %ymm2, %ymm2 + vpxor %ymm1, %ymm3, %ymm3 + vpxor 224(%rsp), %ymm4, %ymm4 + vpbroadcastq s_zero(%rip), %ymm0 + vmovdqu 48(%rdx), %ymm1 + vmovdqu 88(%rdx), %ymm5 + vbroadcasti128 128(%rdx), %ymm6 + vpblendd $-13, %ymm0, %ymm6, %ymm7 + vpblendd $-4, %ymm0, %ymm6, %ymm6 + vpblendd $-61, %ymm1, %ymm5, %ymm8 + vpblendd $60, %ymm1, %ymm5, %ymm1 + vpblendd $-16, %ymm0, %ymm8, %ymm5 + vpblendd $-52, %ymm0, %ymm1, %ymm0 + vpblendd $51, %ymm6, %ymm1, %ymm1 + vpxor %ymm5, %ymm9, %ymm9 + vpblendd $15, %ymm7, %ymm8, %ymm5 + vpxor %ymm0, %ymm10, %ymm10 + vpxor %ymm1, %ymm11, %ymm11 + vpxor %ymm5, %ymm12, %ymm12 + leaq (%rdx,%r8), %rdx + subq %r8, %rcx + leaq 96(%r10), %rbx + leaq 96(%r11), %r12 + movq %rbp, %r13 + movl $24, %r14d + .p2align 5 +Lkeccak_1600$17: + vpshufd $78, %ymm4, %ymm0 + vpxor %ymm11, %ymm12, %ymm1 + vpxor %ymm9, %ymm10, %ymm5 + vpxor %ymm3, %ymm1, %ymm1 + vpxor %ymm5, %ymm1, %ymm1 + vpermq $-109, %ymm1, %ymm5 + vpxor %ymm4, %ymm0, %ymm0 + vpermq $78, %ymm0, %ymm6 + vpsrlq $63, %ymm1, %ymm7 + vpaddq %ymm1, %ymm1, %ymm1 + vpor %ymm1, %ymm7, %ymm1 + vpermq $57, %ymm1, %ymm7 + vpxor %ymm5, %ymm1, %ymm1 + vpermq $0, %ymm1, %ymm1 + vpxor %ymm2, %ymm0, %ymm0 + vpxor %ymm6, %ymm0, %ymm0 + vpsrlq $63, %ymm0, %ymm6 + vpaddq %ymm0, %ymm0, %ymm8 + vpor %ymm6, %ymm8, %ymm6 + vpxor %ymm1, %ymm4, %ymm4 + vpxor %ymm1, %ymm2, %ymm1 + vpblendd $-64, %ymm6, %ymm7, %ymm2 + vpblendd $3, %ymm0, %ymm5, %ymm0 + vpxor %ymm0, %ymm2, %ymm0 + vpsllvq -96(%rbx), %ymm4, %ymm2 + vpsrlvq -96(%r12), %ymm4, %ymm4 + vpor %ymm2, %ymm4, %ymm2 + vpxor %ymm0, %ymm11, %ymm4 + vpsllvq -32(%rbx), %ymm4, %ymm5 + vpsrlvq -32(%r12), %ymm4, %ymm4 + vpor %ymm5, %ymm4, %ymm4 + vpxor %ymm0, %ymm10, %ymm5 + vpsllvq (%rbx), %ymm5, %ymm6 + vpsrlvq (%r12), %ymm5, %ymm5 + vpor %ymm6, %ymm5, %ymm5 + vpxor %ymm0, %ymm12, %ymm6 + vpsllvq 32(%rbx), %ymm6, %ymm7 + vpsrlvq 32(%r12), %ymm6, %ymm6 + vpor %ymm7, %ymm6, %ymm6 + vpxor %ymm0, %ymm9, %ymm7 + vpermq $-115, %ymm2, %ymm2 + vpermq $-115, %ymm4, %ymm8 + vpsllvq 64(%rbx), %ymm7, %ymm4 + vpsrlvq 64(%r12), %ymm7, %ymm7 + vpor %ymm4, %ymm7, %ymm7 + vpxor %ymm0, %ymm3, %ymm0 + vpermq $27, %ymm5, %ymm3 + vpermq $114, %ymm6, %ymm5 + vpsllvq -64(%rbx), %ymm0, %ymm4 + vpsrlvq -64(%r12), %ymm0, %ymm0 + vpor %ymm4, %ymm0, %ymm0 + vpsrldq $8, %ymm7, %ymm4 + vpandn %ymm4, %ymm7, %ymm6 + vpblendd $12, %ymm5, %ymm0, %ymm4 + vpblendd $12, %ymm0, %ymm8, %ymm9 + vpblendd $12, %ymm8, %ymm2, %ymm10 + vpblendd $12, %ymm2, %ymm0, %ymm11 + vpblendd $48, %ymm8, %ymm4, %ymm4 + vpblendd $48, %ymm3, %ymm9, %ymm9 + vpblendd $48, %ymm0, %ymm10, %ymm10 + vpblendd $48, %ymm5, %ymm11, %ymm11 + vpblendd $-64, %ymm3, %ymm4, %ymm4 + vpblendd $-64, %ymm5, %ymm9, %ymm9 + vpblendd $-64, %ymm5, %ymm10, %ymm10 + vpblendd $-64, %ymm8, %ymm11, %ymm11 + vpandn %ymm9, %ymm4, %ymm4 + vpandn %ymm11, %ymm10, %ymm9 + vpblendd $12, %ymm0, %ymm3, %ymm10 + vpblendd $12, %ymm3, %ymm2, %ymm11 + vpxor %ymm2, %ymm4, %ymm12 + vpblendd $48, %ymm2, %ymm10, %ymm4 + vpblendd $48, %ymm8, %ymm11, %ymm10 + vpxor %ymm3, %ymm9, %ymm9 + vpblendd $-64, %ymm8, %ymm4, %ymm4 + vpblendd $-64, %ymm0, %ymm10, %ymm10 + vpandn %ymm10, %ymm4, %ymm4 + vpxor %ymm5, %ymm4, %ymm10 + vpermq $30, %ymm7, %ymm4 + vpblendd $48, %ymm1, %ymm4, %ymm4 + vpermq $57, %ymm7, %ymm11 + vpblendd $-64, %ymm1, %ymm11, %ymm11 + vpandn %ymm4, %ymm11, %ymm13 + vpblendd $12, %ymm3, %ymm8, %ymm4 + vpblendd $12, %ymm8, %ymm5, %ymm11 + vpblendd $48, %ymm5, %ymm4, %ymm4 + vpblendd $48, %ymm2, %ymm11, %ymm11 + vpblendd $-64, %ymm2, %ymm4, %ymm4 + vpblendd $-64, %ymm3, %ymm11, %ymm11 + vpandn %ymm11, %ymm4, %ymm4 + vpxor %ymm0, %ymm4, %ymm4 + vpermq $0, %ymm6, %ymm6 + vpermq $27, %ymm12, %ymm11 + vpermq $-115, %ymm9, %ymm12 + vpermq $114, %ymm10, %ymm9 + vpblendd $12, %ymm2, %ymm5, %ymm10 + vpblendd $12, %ymm5, %ymm3, %ymm5 + vpblendd $48, %ymm3, %ymm10, %ymm3 + vpblendd $48, %ymm0, %ymm5, %ymm5 + vpblendd $-64, %ymm0, %ymm3, %ymm0 + vpblendd $-64, %ymm2, %ymm5, %ymm2 + vpandn %ymm2, %ymm0, %ymm0 + vpxor %ymm6, %ymm1, %ymm1 + vpxor %ymm7, %ymm13, %ymm3 + vpxor %ymm8, %ymm0, %ymm10 + vpxor (%r13), %ymm1, %ymm2 + leaq 32(%r13), %r13 + decl %r14d + jne Lkeccak_1600$17 +Lkeccak_1600$15: + cmpq %r8, %rcx + jnb Lkeccak_1600$16 + vpbroadcastq g_zero(%rip), %ymm0 + vmovdqu %ymm0, (%rsp) + vmovdqu %ymm0, 32(%rsp) + vmovdqu %ymm0, 64(%rsp) + vmovdqu %ymm0, 96(%rsp) + vmovdqu %ymm0, 128(%rsp) + vmovdqu %ymm0, 160(%rsp) + vmovdqu %ymm0, 192(%rsp) + movq %rcx, %rbx + shrq $3, %rbx + movq $0, %r12 + jmp Lkeccak_1600$13 +Lkeccak_1600$14: + movq (%rdx,%r12,8), %r13 + movq (%r9,%r12,8), %r14 + movq %r13, (%rsp,%r14,8) + leaq 1(%r12), %r12 +Lkeccak_1600$13: + cmpq %rbx, %r12 + jb Lkeccak_1600$14 + movq (%r9,%r12,8), %rbx + shlq $3, %rbx + shlq $3, %r12 + jmp Lkeccak_1600$11 +Lkeccak_1600$12: + movb (%rdx,%r12), %r13b + movb %r13b, (%rsp,%rbx) + leaq 1(%r12), %r12 + leaq 1(%rbx), %rbx +Lkeccak_1600$11: + cmpq %rcx, %r12 + jb Lkeccak_1600$12 + movb %al, (%rsp,%rbx) + movq %r8, %rax + leaq -1(%rax), %rax + shrq $3, %rax + movq (%r9,%rax,8), %rax + shlq $3, %rax + movq %r8, %rcx + leaq -1(%rcx), %rcx + andq $7, %rcx + leaq (%rax,%rcx), %rax + xorb $-128, (%rsp,%rax) + movq (%rsp), %rax + movq %rax, 8(%rsp) + movq %rax, 16(%rsp) + movq %rax, 24(%rsp) + vpxor (%rsp), %ymm2, %ymm0 + vpxor 32(%rsp), %ymm3, %ymm1 + vpxor 64(%rsp), %ymm4, %ymm2 + vpxor 96(%rsp), %ymm11, %ymm3 + vpxor 128(%rsp), %ymm10, %ymm4 + vpxor 160(%rsp), %ymm12, %ymm5 + vpxor 192(%rsp), %ymm9, %ymm6 + jmp Lkeccak_1600$6 +Lkeccak_1600$7: + leaq 96(%r10), %rax + leaq 96(%r11), %rcx + movq %rbp, %rdx + movl $24, %ebx + .p2align 5 +Lkeccak_1600$10: + vpshufd $78, %ymm2, %ymm7 + vpxor %ymm3, %ymm5, %ymm8 + vpxor %ymm6, %ymm4, %ymm9 + vpxor %ymm1, %ymm8, %ymm8 + vpxor %ymm9, %ymm8, %ymm8 + vpermq $-109, %ymm8, %ymm9 + vpxor %ymm2, %ymm7, %ymm7 + vpermq $78, %ymm7, %ymm10 + vpsrlq $63, %ymm8, %ymm11 + vpaddq %ymm8, %ymm8, %ymm8 + vpor %ymm8, %ymm11, %ymm8 + vpermq $57, %ymm8, %ymm11 + vpxor %ymm9, %ymm8, %ymm8 + vpermq $0, %ymm8, %ymm8 + vpxor %ymm0, %ymm7, %ymm7 + vpxor %ymm10, %ymm7, %ymm7 + vpsrlq $63, %ymm7, %ymm10 + vpaddq %ymm7, %ymm7, %ymm12 + vpor %ymm10, %ymm12, %ymm10 + vpxor %ymm8, %ymm2, %ymm2 + vpxor %ymm8, %ymm0, %ymm0 + vpblendd $-64, %ymm10, %ymm11, %ymm8 + vpblendd $3, %ymm7, %ymm9, %ymm7 + vpxor %ymm7, %ymm8, %ymm7 + vpsllvq -96(%rax), %ymm2, %ymm8 + vpsrlvq -96(%rcx), %ymm2, %ymm2 + vpor %ymm8, %ymm2, %ymm2 + vpxor %ymm7, %ymm3, %ymm3 + vpsllvq -32(%rax), %ymm3, %ymm8 + vpsrlvq -32(%rcx), %ymm3, %ymm3 + vpor %ymm8, %ymm3, %ymm3 + vpxor %ymm7, %ymm4, %ymm4 + vpsllvq (%rax), %ymm4, %ymm8 + vpsrlvq (%rcx), %ymm4, %ymm4 + vpor %ymm8, %ymm4, %ymm4 + vpxor %ymm7, %ymm5, %ymm5 + vpsllvq 32(%rax), %ymm5, %ymm8 + vpsrlvq 32(%rcx), %ymm5, %ymm5 + vpor %ymm8, %ymm5, %ymm5 + vpxor %ymm7, %ymm6, %ymm6 + vpermq $-115, %ymm2, %ymm8 + vpermq $-115, %ymm3, %ymm9 + vpsllvq 64(%rax), %ymm6, %ymm2 + vpsrlvq 64(%rcx), %ymm6, %ymm3 + vpor %ymm2, %ymm3, %ymm10 + vpxor %ymm7, %ymm1, %ymm1 + vpermq $27, %ymm4, %ymm4 + vpermq $114, %ymm5, %ymm7 + vpsllvq -64(%rax), %ymm1, %ymm2 + vpsrlvq -64(%rcx), %ymm1, %ymm1 + vpor %ymm2, %ymm1, %ymm1 + vpsrldq $8, %ymm10, %ymm2 + vpandn %ymm2, %ymm10, %ymm3 + vpblendd $12, %ymm7, %ymm1, %ymm2 + vpblendd $12, %ymm1, %ymm9, %ymm5 + vpblendd $12, %ymm9, %ymm8, %ymm6 + vpblendd $12, %ymm8, %ymm1, %ymm11 + vpblendd $48, %ymm9, %ymm2, %ymm2 + vpblendd $48, %ymm4, %ymm5, %ymm5 + vpblendd $48, %ymm1, %ymm6, %ymm6 + vpblendd $48, %ymm7, %ymm11, %ymm11 + vpblendd $-64, %ymm4, %ymm2, %ymm2 + vpblendd $-64, %ymm7, %ymm5, %ymm5 + vpblendd $-64, %ymm7, %ymm6, %ymm6 + vpblendd $-64, %ymm9, %ymm11, %ymm11 + vpandn %ymm5, %ymm2, %ymm2 + vpandn %ymm11, %ymm6, %ymm5 + vpblendd $12, %ymm1, %ymm4, %ymm6 + vpblendd $12, %ymm4, %ymm8, %ymm11 + vpxor %ymm8, %ymm2, %ymm12 + vpblendd $48, %ymm8, %ymm6, %ymm2 + vpblendd $48, %ymm9, %ymm11, %ymm6 + vpxor %ymm4, %ymm5, %ymm5 + vpblendd $-64, %ymm9, %ymm2, %ymm2 + vpblendd $-64, %ymm1, %ymm6, %ymm6 + vpandn %ymm6, %ymm2, %ymm2 + vpxor %ymm7, %ymm2, %ymm6 + vpermq $30, %ymm10, %ymm2 + vpblendd $48, %ymm0, %ymm2, %ymm2 + vpermq $57, %ymm10, %ymm11 + vpblendd $-64, %ymm0, %ymm11, %ymm11 + vpandn %ymm2, %ymm11, %ymm11 + vpblendd $12, %ymm4, %ymm9, %ymm2 + vpblendd $12, %ymm9, %ymm7, %ymm13 + vpblendd $48, %ymm7, %ymm2, %ymm2 + vpblendd $48, %ymm8, %ymm13, %ymm13 + vpblendd $-64, %ymm8, %ymm2, %ymm2 + vpblendd $-64, %ymm4, %ymm13, %ymm13 + vpandn %ymm13, %ymm2, %ymm2 + vpxor %ymm1, %ymm2, %ymm2 + vpermq $0, %ymm3, %ymm13 + vpermq $27, %ymm12, %ymm3 + vpermq $-115, %ymm5, %ymm5 + vpermq $114, %ymm6, %ymm6 + vpblendd $12, %ymm8, %ymm7, %ymm12 + vpblendd $12, %ymm7, %ymm4, %ymm7 + vpblendd $48, %ymm4, %ymm12, %ymm4 + vpblendd $48, %ymm1, %ymm7, %ymm7 + vpblendd $-64, %ymm1, %ymm4, %ymm1 + vpblendd $-64, %ymm8, %ymm7, %ymm4 + vpandn %ymm4, %ymm1, %ymm4 + vpxor %ymm13, %ymm0, %ymm0 + vpxor %ymm10, %ymm11, %ymm1 + vpxor %ymm9, %ymm4, %ymm4 + vpxor (%rdx), %ymm0, %ymm0 + leaq 32(%rdx), %rdx + decl %ebx + jne Lkeccak_1600$10 + vmovdqu %ymm0, (%rsp) + vmovdqu %ymm1, 32(%rsp) + vmovdqu %ymm2, 64(%rsp) + vmovdqu %ymm3, 96(%rsp) + vmovdqu %ymm4, 128(%rsp) + vmovdqu %ymm5, 160(%rsp) + vmovdqu %ymm6, 192(%rsp) + movq %r8, %rax + shrq $3, %rax + movq $0, %rcx + jmp Lkeccak_1600$8 +Lkeccak_1600$9: + movq (%r9,%rcx,8), %rdx + movq (%rsp,%rdx,8), %rdx + movq %rdx, (%rdi,%rcx,8) + leaq 1(%rcx), %rcx +Lkeccak_1600$8: + cmpq %rax, %rcx + jb Lkeccak_1600$9 + leaq (%rdi,%r8), %rdi + subq %r8, %rsi +Lkeccak_1600$6: + cmpq %r8, %rsi + jnbe Lkeccak_1600$7 + leaq 96(%r10), %rax + leaq 96(%r11), %rcx + movl $24, %edx + .p2align 5 +Lkeccak_1600$5: + vpshufd $78, %ymm2, %ymm7 + vpxor %ymm3, %ymm5, %ymm8 + vpxor %ymm6, %ymm4, %ymm9 + vpxor %ymm1, %ymm8, %ymm8 + vpxor %ymm9, %ymm8, %ymm8 + vpermq $-109, %ymm8, %ymm9 + vpxor %ymm2, %ymm7, %ymm7 + vpermq $78, %ymm7, %ymm10 + vpsrlq $63, %ymm8, %ymm11 + vpaddq %ymm8, %ymm8, %ymm8 + vpor %ymm8, %ymm11, %ymm8 + vpermq $57, %ymm8, %ymm11 + vpxor %ymm9, %ymm8, %ymm8 + vpermq $0, %ymm8, %ymm8 + vpxor %ymm0, %ymm7, %ymm7 + vpxor %ymm10, %ymm7, %ymm7 + vpsrlq $63, %ymm7, %ymm10 + vpaddq %ymm7, %ymm7, %ymm12 + vpor %ymm10, %ymm12, %ymm10 + vpxor %ymm8, %ymm2, %ymm2 + vpxor %ymm8, %ymm0, %ymm0 + vpblendd $-64, %ymm10, %ymm11, %ymm8 + vpblendd $3, %ymm7, %ymm9, %ymm7 + vpxor %ymm7, %ymm8, %ymm7 + vpsllvq -96(%rax), %ymm2, %ymm8 + vpsrlvq -96(%rcx), %ymm2, %ymm2 + vpor %ymm8, %ymm2, %ymm2 + vpxor %ymm7, %ymm3, %ymm3 + vpsllvq -32(%rax), %ymm3, %ymm8 + vpsrlvq -32(%rcx), %ymm3, %ymm3 + vpor %ymm8, %ymm3, %ymm3 + vpxor %ymm7, %ymm4, %ymm4 + vpsllvq (%rax), %ymm4, %ymm8 + vpsrlvq (%rcx), %ymm4, %ymm4 + vpor %ymm8, %ymm4, %ymm4 + vpxor %ymm7, %ymm5, %ymm5 + vpsllvq 32(%rax), %ymm5, %ymm8 + vpsrlvq 32(%rcx), %ymm5, %ymm5 + vpor %ymm8, %ymm5, %ymm5 + vpxor %ymm7, %ymm6, %ymm6 + vpermq $-115, %ymm2, %ymm8 + vpermq $-115, %ymm3, %ymm9 + vpsllvq 64(%rax), %ymm6, %ymm2 + vpsrlvq 64(%rcx), %ymm6, %ymm3 + vpor %ymm2, %ymm3, %ymm10 + vpxor %ymm7, %ymm1, %ymm1 + vpermq $27, %ymm4, %ymm4 + vpermq $114, %ymm5, %ymm7 + vpsllvq -64(%rax), %ymm1, %ymm2 + vpsrlvq -64(%rcx), %ymm1, %ymm1 + vpor %ymm2, %ymm1, %ymm1 + vpsrldq $8, %ymm10, %ymm2 + vpandn %ymm2, %ymm10, %ymm3 + vpblendd $12, %ymm7, %ymm1, %ymm2 + vpblendd $12, %ymm1, %ymm9, %ymm5 + vpblendd $12, %ymm9, %ymm8, %ymm6 + vpblendd $12, %ymm8, %ymm1, %ymm11 + vpblendd $48, %ymm9, %ymm2, %ymm2 + vpblendd $48, %ymm4, %ymm5, %ymm5 + vpblendd $48, %ymm1, %ymm6, %ymm6 + vpblendd $48, %ymm7, %ymm11, %ymm11 + vpblendd $-64, %ymm4, %ymm2, %ymm2 + vpblendd $-64, %ymm7, %ymm5, %ymm5 + vpblendd $-64, %ymm7, %ymm6, %ymm6 + vpblendd $-64, %ymm9, %ymm11, %ymm11 + vpandn %ymm5, %ymm2, %ymm2 + vpandn %ymm11, %ymm6, %ymm5 + vpblendd $12, %ymm1, %ymm4, %ymm6 + vpblendd $12, %ymm4, %ymm8, %ymm11 + vpxor %ymm8, %ymm2, %ymm12 + vpblendd $48, %ymm8, %ymm6, %ymm2 + vpblendd $48, %ymm9, %ymm11, %ymm6 + vpxor %ymm4, %ymm5, %ymm5 + vpblendd $-64, %ymm9, %ymm2, %ymm2 + vpblendd $-64, %ymm1, %ymm6, %ymm6 + vpandn %ymm6, %ymm2, %ymm2 + vpxor %ymm7, %ymm2, %ymm6 + vpermq $30, %ymm10, %ymm2 + vpblendd $48, %ymm0, %ymm2, %ymm2 + vpermq $57, %ymm10, %ymm11 + vpblendd $-64, %ymm0, %ymm11, %ymm11 + vpandn %ymm2, %ymm11, %ymm11 + vpblendd $12, %ymm4, %ymm9, %ymm2 + vpblendd $12, %ymm9, %ymm7, %ymm13 + vpblendd $48, %ymm7, %ymm2, %ymm2 + vpblendd $48, %ymm8, %ymm13, %ymm13 + vpblendd $-64, %ymm8, %ymm2, %ymm2 + vpblendd $-64, %ymm4, %ymm13, %ymm13 + vpandn %ymm13, %ymm2, %ymm2 + vpxor %ymm1, %ymm2, %ymm2 + vpermq $0, %ymm3, %ymm13 + vpermq $27, %ymm12, %ymm3 + vpermq $-115, %ymm5, %ymm5 + vpermq $114, %ymm6, %ymm6 + vpblendd $12, %ymm8, %ymm7, %ymm12 + vpblendd $12, %ymm7, %ymm4, %ymm7 + vpblendd $48, %ymm4, %ymm12, %ymm4 + vpblendd $48, %ymm1, %ymm7, %ymm7 + vpblendd $-64, %ymm1, %ymm4, %ymm1 + vpblendd $-64, %ymm8, %ymm7, %ymm4 + vpandn %ymm4, %ymm1, %ymm4 + vpxor %ymm13, %ymm0, %ymm0 + vpxor %ymm10, %ymm11, %ymm1 + vpxor %ymm9, %ymm4, %ymm4 + vpxor (%rbp), %ymm0, %ymm0 + leaq 32(%rbp), %rbp + decl %edx + jne Lkeccak_1600$5 + vmovdqu %ymm0, (%rsp) + vmovdqu %ymm1, 32(%rsp) + vmovdqu %ymm2, 64(%rsp) + vmovdqu %ymm3, 96(%rsp) + vmovdqu %ymm4, 128(%rsp) + vmovdqu %ymm5, 160(%rsp) + vmovdqu %ymm6, 192(%rsp) + movq %rsi, %rax + shrq $3, %rax + movq $0, %rcx + jmp Lkeccak_1600$3 +Lkeccak_1600$4: + movq (%r9,%rcx,8), %rdx + movq (%rsp,%rdx,8), %rdx + movq %rdx, (%rdi,%rcx,8) + leaq 1(%rcx), %rcx +Lkeccak_1600$3: + cmpq %rax, %rcx + jb Lkeccak_1600$4 + movq (%r9,%rcx,8), %rax + shlq $3, %rcx + shlq $3, %rax + jmp Lkeccak_1600$1 +Lkeccak_1600$2: + movb (%rsp,%rax), %dl + movb %dl, (%rdi,%rcx) + leaq 1(%rcx), %rcx + leaq 1(%rax), %rax +Lkeccak_1600$1: + cmpq %rsi, %rcx + jb Lkeccak_1600$2 + addq $256, %rsp + popq %r14 + popq %r13 + popq %r12 + popq %rbx + popq %rbp + ret + .data + .globl _g_zero + .globl g_zero + .p2align 3 +_g_zero: +g_zero: + .quad 0 + .globl _s_zero + .globl s_zero + .p2align 3 +_s_zero: +s_zero: + .quad 0 diff --git a/code/crypto_hash/sha3224/scalar/Makefile b/code/crypto_hash/sha3224/scalar/Makefile new file mode 100644 index 0000000..1d2484f --- /dev/null +++ b/code/crypto_hash/sha3224/scalar/Makefile @@ -0,0 +1,15 @@ +# -*- Makefile -*- + +.PHONY: default clean + +default: sha3224.japp sha3224.s + @true + +clean: + rm -f sha3224.japp sha3224.s + +%.s: %.japp + jasminc -lea -pasm $< > $@ || rm -f $@ + +%.japp: %.jazz + gpp -I../../../ -o $@ $< diff --git a/code/crypto_hash/sha3224/scalar/sha3224-m.c b/code/crypto_hash/sha3224/scalar/sha3224-m.c new file mode 100644 index 0000000..cc63ee4 --- /dev/null +++ b/code/crypto_hash/sha3224/scalar/sha3224-m.c @@ -0,0 +1,54 @@ +#include "crypto_hash.h" +#include "impl.h" +#include "api.h" +#include +#include + + +extern void keccak_1600( + uint8_t *out, + uint64_t outlen, + const uint8_t *in, + size_t inlen, + uint64_t *c, + uint64_t *iotas +); + + +uint64_t iotas[32] __attribute__((aligned(256))) = +{ + 0,0,0,0,0,0,0, 0 + , 0x0000000000000001 + , 0x0000000000008082 + , 0x800000000000808a + , 0x8000000080008000 + , 0x000000000000808b + , 0x0000000080000001 + , 0x8000000080008081 + , 0x8000000000008009 + , 0x000000000000008a + , 0x0000000000000088 + , 0x0000000080008009 + , 0x000000008000000a + , 0x000000008000808b + , 0x800000000000008b + , 0x8000000000008089 + , 0x8000000000008003 + , 0x8000000000008002 + , 0x8000000000000080 + , 0x000000000000800a + , 0x800000008000000a + , 0x8000000080008081 + , 0x8000000000008080 + , 0x0000000080000001 + , 0x8000000080008008 +}; + + +int sha3224_scalar(unsigned char *out,const unsigned char *in,unsigned long long inlen) +{ + uint64_t c[] = {0x06, (1152/8)}; + keccak_1600(out, 28, in, inlen, c, &(iotas[8])); + return 0; +} + diff --git a/code/crypto_hash/sha3224/scalar/sha3224.jazz b/code/crypto_hash/sha3224/scalar/sha3224.jazz new file mode 100644 index 0000000..d2fa40e --- /dev/null +++ b/code/crypto_hash/sha3224/scalar/sha3224.jazz @@ -0,0 +1 @@ +#include "crypto_hash/keccak1600/scalar/keccak_1600.jazz" diff --git a/code/crypto_hash/sha3224/scalar/sha3224.s b/code/crypto_hash/sha3224/scalar/sha3224.s new file mode 100644 index 0000000..f79b7d1 --- /dev/null +++ b/code/crypto_hash/sha3224/scalar/sha3224.s @@ -0,0 +1,1299 @@ + .text + .p2align 5 + .globl _keccak_1600 + .globl keccak_1600 +_keccak_1600: +keccak_1600: + pushq %rbp + pushq %rbx + pushq %r12 + subq $456, %rsp + movq %rdi, 200(%rsp) + movq %rsi, 448(%rsp) + movzbq (%r8), %rax + movq %rax, 440(%rsp) + movq 8(%r8), %rax + xorl %esi, %esi + movq $0, %rdi + jmp Lkeccak_1600$20 +Lkeccak_1600$21: + movq %rsi, (%rsp,%rdi,8) + leaq 1(%rdi), %rdi +Lkeccak_1600$20: + cmpq $25, %rdi + jb Lkeccak_1600$21 + jmp Lkeccak_1600$15 +Lkeccak_1600$16: + movq %rax, %rsi + shrq $3, %rsi + movq $0, %rdi + jmp Lkeccak_1600$18 +Lkeccak_1600$19: + movq (%rdx,%rdi,8), %r8 + xorq %r8, (%rsp,%rdi,8) + leaq 1(%rdi), %rdi +Lkeccak_1600$18: + cmpq %rsi, %rdi + jb Lkeccak_1600$19 + leaq (%rdx,%rax), %rdx + subq %rax, %rcx + movq %rdx, 224(%rsp) + movq %rcx, 216(%rsp) + movq %rax, 208(%rsp) +Lkeccak_1600$17: + movq (%r9), %rax + movq %rax, 432(%rsp) + movq (%rsp), %rax + movq 8(%rsp), %rcx + movq 16(%rsp), %rdx + movq 24(%rsp), %rsi + movq 32(%rsp), %rdi + xorq 40(%rsp), %rax + xorq 48(%rsp), %rcx + xorq 56(%rsp), %rdx + xorq 64(%rsp), %rsi + xorq 72(%rsp), %rdi + xorq 80(%rsp), %rax + xorq 88(%rsp), %rcx + xorq 96(%rsp), %rdx + xorq 104(%rsp), %rsi + xorq 112(%rsp), %rdi + xorq 120(%rsp), %rax + xorq 128(%rsp), %rcx + xorq 136(%rsp), %rdx + xorq 144(%rsp), %rsi + xorq 152(%rsp), %rdi + xorq 160(%rsp), %rax + xorq 168(%rsp), %rcx + xorq 176(%rsp), %rdx + xorq 184(%rsp), %rsi + xorq 192(%rsp), %rdi + movq %rcx, %r8 + rolq $1, %r8 + xorq %rdi, %r8 + movq %rdx, %r10 + rolq $1, %r10 + xorq %rax, %r10 + movq %rsi, %r11 + rolq $1, %r11 + xorq %rcx, %r11 + movq %rdi, %rcx + rolq $1, %rcx + xorq %rdx, %rcx + rolq $1, %rax + xorq %rsi, %rax + movq (%rsp), %rdx + xorq %r8, %rdx + movq 48(%rsp), %rsi + xorq %r10, %rsi + rolq $44, %rsi + movq 96(%rsp), %rdi + xorq %r11, %rdi + rolq $43, %rdi + movq 144(%rsp), %rbp + xorq %rcx, %rbp + rolq $21, %rbp + movq 192(%rsp), %rbx + xorq %rax, %rbx + rolq $14, %rbx + andnq %rdi, %rsi, %r12 + xorq 432(%rsp), %r12 + xorq %rdx, %r12 + movq %r12, 232(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 240(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 248(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 256(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 264(%rsp) + movq 24(%rsp), %rdx + xorq %rcx, %rdx + rolq $28, %rdx + movq 72(%rsp), %rsi + xorq %rax, %rsi + rolq $20, %rsi + movq 80(%rsp), %rdi + xorq %r8, %rdi + rolq $3, %rdi + movq 128(%rsp), %rbp + xorq %r10, %rbp + rolq $45, %rbp + movq 176(%rsp), %rbx + xorq %r11, %rbx + rolq $61, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 272(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 280(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 288(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 296(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 304(%rsp) + movq 8(%rsp), %rdx + xorq %r10, %rdx + rolq $1, %rdx + movq 56(%rsp), %rsi + xorq %r11, %rsi + rolq $6, %rsi + movq 104(%rsp), %rdi + xorq %rcx, %rdi + rolq $25, %rdi + movq 152(%rsp), %rbp + xorq %rax, %rbp + rolq $8, %rbp + movq 160(%rsp), %rbx + xorq %r8, %rbx + rolq $18, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 312(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 320(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 328(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 336(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 344(%rsp) + movq 32(%rsp), %rdx + xorq %rax, %rdx + rolq $27, %rdx + movq 40(%rsp), %rsi + xorq %r8, %rsi + rolq $36, %rsi + movq 88(%rsp), %rdi + xorq %r10, %rdi + rolq $10, %rdi + movq 136(%rsp), %rbp + xorq %r11, %rbp + rolq $15, %rbp + movq 184(%rsp), %rbx + xorq %rcx, %rbx + rolq $56, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 352(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 360(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 368(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 376(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 384(%rsp) + movq 16(%rsp), %rdx + xorq %r11, %rdx + rolq $62, %rdx + movq 64(%rsp), %rsi + xorq %rcx, %rsi + rolq $55, %rsi + movq %rsi, %rcx + movq 112(%rsp), %rsi + xorq %rax, %rsi + rolq $39, %rsi + movq %rsi, %rax + movq 120(%rsp), %rsi + xorq %r8, %rsi + rolq $41, %rsi + movq 168(%rsp), %rdi + xorq %r10, %rdi + rolq $2, %rdi + andnq %rax, %rcx, %r8 + xorq %rdx, %r8 + movq %r8, 392(%rsp) + andnq %rsi, %rax, %r8 + xorq %rcx, %r8 + movq %r8, 400(%rsp) + andnq %rdi, %rsi, %r8 + xorq %rax, %r8 + movq %r8, 408(%rsp) + andnq %rdx, %rdi, %rax + xorq %rsi, %rax + movq %rax, 416(%rsp) + andnq %rcx, %rdx, %rax + xorq %rdi, %rax + movq %rax, 424(%rsp) + movq 8(%r9), %rax + movq %rax, 432(%rsp) + movq 232(%rsp), %rax + movq 240(%rsp), %rcx + movq 248(%rsp), %rdx + movq 256(%rsp), %rsi + movq 264(%rsp), %rdi + xorq 272(%rsp), %rax + xorq 280(%rsp), %rcx + xorq 288(%rsp), %rdx + xorq 296(%rsp), %rsi + xorq 304(%rsp), %rdi + xorq 312(%rsp), %rax + xorq 320(%rsp), %rcx + xorq 328(%rsp), %rdx + xorq 336(%rsp), %rsi + xorq 344(%rsp), %rdi + xorq 352(%rsp), %rax + xorq 360(%rsp), %rcx + xorq 368(%rsp), %rdx + xorq 376(%rsp), %rsi + xorq 384(%rsp), %rdi + xorq 392(%rsp), %rax + xorq 400(%rsp), %rcx + xorq 408(%rsp), %rdx + xorq 416(%rsp), %rsi + xorq 424(%rsp), %rdi + movq %rcx, %r8 + rolq $1, %r8 + xorq %rdi, %r8 + movq %rdx, %r10 + rolq $1, %r10 + xorq %rax, %r10 + movq %rsi, %r11 + rolq $1, %r11 + xorq %rcx, %r11 + movq %rdi, %rcx + rolq $1, %rcx + xorq %rdx, %rcx + rolq $1, %rax + xorq %rsi, %rax + movq 232(%rsp), %rdx + xorq %r8, %rdx + movq 280(%rsp), %rsi + xorq %r10, %rsi + rolq $44, %rsi + movq 328(%rsp), %rdi + xorq %r11, %rdi + rolq $43, %rdi + movq 376(%rsp), %rbp + xorq %rcx, %rbp + rolq $21, %rbp + movq 424(%rsp), %rbx + xorq %rax, %rbx + rolq $14, %rbx + andnq %rdi, %rsi, %r12 + xorq 432(%rsp), %r12 + xorq %rdx, %r12 + movq %r12, (%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 8(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 16(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 24(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 32(%rsp) + movq 256(%rsp), %rdx + xorq %rcx, %rdx + rolq $28, %rdx + movq 304(%rsp), %rsi + xorq %rax, %rsi + rolq $20, %rsi + movq 312(%rsp), %rdi + xorq %r8, %rdi + rolq $3, %rdi + movq 360(%rsp), %rbp + xorq %r10, %rbp + rolq $45, %rbp + movq 408(%rsp), %rbx + xorq %r11, %rbx + rolq $61, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 40(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 48(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 56(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 64(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 72(%rsp) + movq 240(%rsp), %rdx + xorq %r10, %rdx + rolq $1, %rdx + movq 288(%rsp), %rsi + xorq %r11, %rsi + rolq $6, %rsi + movq 336(%rsp), %rdi + xorq %rcx, %rdi + rolq $25, %rdi + movq 384(%rsp), %rbp + xorq %rax, %rbp + rolq $8, %rbp + movq 392(%rsp), %rbx + xorq %r8, %rbx + rolq $18, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 80(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 88(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 96(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 104(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 112(%rsp) + movq 264(%rsp), %rdx + xorq %rax, %rdx + rolq $27, %rdx + movq 272(%rsp), %rsi + xorq %r8, %rsi + rolq $36, %rsi + movq 320(%rsp), %rdi + xorq %r10, %rdi + rolq $10, %rdi + movq 368(%rsp), %rbp + xorq %r11, %rbp + rolq $15, %rbp + movq 416(%rsp), %rbx + xorq %rcx, %rbx + rolq $56, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 120(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 128(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 136(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 144(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 152(%rsp) + movq 248(%rsp), %rdx + xorq %r11, %rdx + rolq $62, %rdx + movq 296(%rsp), %rsi + xorq %rcx, %rsi + rolq $55, %rsi + movq %rsi, %rcx + movq 344(%rsp), %rsi + xorq %rax, %rsi + rolq $39, %rsi + movq %rsi, %rax + movq 352(%rsp), %rsi + xorq %r8, %rsi + rolq $41, %rsi + movq 400(%rsp), %rdi + xorq %r10, %rdi + rolq $2, %rdi + andnq %rax, %rcx, %r8 + xorq %rdx, %r8 + movq %r8, 160(%rsp) + andnq %rsi, %rax, %r8 + xorq %rcx, %r8 + movq %r8, 168(%rsp) + andnq %rdi, %rsi, %r8 + xorq %rax, %r8 + movq %r8, 176(%rsp) + andnq %rdx, %rdi, %rax + xorq %rsi, %rax + movq %rax, 184(%rsp) + andnq %rcx, %rdx, %rax + xorq %rdi, %rax + movq %rax, 192(%rsp) + leaq 16(%r9), %r9 + testb $-1, %r9b + jne Lkeccak_1600$17 + leaq -192(%r9), %r9 + movq 224(%rsp), %rdx + movq 216(%rsp), %rcx + movq 208(%rsp), %rax +Lkeccak_1600$15: + cmpq %rax, %rcx + jnb Lkeccak_1600$16 + movq 440(%rsp), %rsi + movb %sil, %sil + movq %rcx, %rdi + shrq $3, %rdi + movq $0, %r8 + jmp Lkeccak_1600$13 +Lkeccak_1600$14: + movq (%rdx,%r8,8), %r10 + xorq %r10, (%rsp,%r8,8) + leaq 1(%r8), %r8 +Lkeccak_1600$13: + cmpq %rdi, %r8 + jb Lkeccak_1600$14 + shlq $3, %r8 + jmp Lkeccak_1600$11 +Lkeccak_1600$12: + movb (%rdx,%r8), %dil + xorb %dil, (%rsp,%r8) + leaq 1(%r8), %r8 +Lkeccak_1600$11: + cmpq %rcx, %r8 + jb Lkeccak_1600$12 + xorb %sil, (%rsp,%r8) + movq %rax, %rcx + leaq -1(%rcx), %rcx + xorb $-128, (%rsp,%rcx) + movq 448(%rsp), %rdx + jmp Lkeccak_1600$6 +Lkeccak_1600$7: + movq %rdx, 448(%rsp) + movq %rax, 440(%rsp) +Lkeccak_1600$10: + movq (%r9), %rax + movq %rax, 432(%rsp) + movq (%rsp), %rax + movq 8(%rsp), %rcx + movq 16(%rsp), %rdx + movq 24(%rsp), %rsi + movq 32(%rsp), %rdi + xorq 40(%rsp), %rax + xorq 48(%rsp), %rcx + xorq 56(%rsp), %rdx + xorq 64(%rsp), %rsi + xorq 72(%rsp), %rdi + xorq 80(%rsp), %rax + xorq 88(%rsp), %rcx + xorq 96(%rsp), %rdx + xorq 104(%rsp), %rsi + xorq 112(%rsp), %rdi + xorq 120(%rsp), %rax + xorq 128(%rsp), %rcx + xorq 136(%rsp), %rdx + xorq 144(%rsp), %rsi + xorq 152(%rsp), %rdi + xorq 160(%rsp), %rax + xorq 168(%rsp), %rcx + xorq 176(%rsp), %rdx + xorq 184(%rsp), %rsi + xorq 192(%rsp), %rdi + movq %rcx, %r8 + rolq $1, %r8 + xorq %rdi, %r8 + movq %rdx, %r10 + rolq $1, %r10 + xorq %rax, %r10 + movq %rsi, %r11 + rolq $1, %r11 + xorq %rcx, %r11 + movq %rdi, %rcx + rolq $1, %rcx + xorq %rdx, %rcx + rolq $1, %rax + xorq %rsi, %rax + movq (%rsp), %rdx + xorq %r8, %rdx + movq 48(%rsp), %rsi + xorq %r10, %rsi + rolq $44, %rsi + movq 96(%rsp), %rdi + xorq %r11, %rdi + rolq $43, %rdi + movq 144(%rsp), %rbp + xorq %rcx, %rbp + rolq $21, %rbp + movq 192(%rsp), %rbx + xorq %rax, %rbx + rolq $14, %rbx + andnq %rdi, %rsi, %r12 + xorq 432(%rsp), %r12 + xorq %rdx, %r12 + movq %r12, 232(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 240(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 248(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 256(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 264(%rsp) + movq 24(%rsp), %rdx + xorq %rcx, %rdx + rolq $28, %rdx + movq 72(%rsp), %rsi + xorq %rax, %rsi + rolq $20, %rsi + movq 80(%rsp), %rdi + xorq %r8, %rdi + rolq $3, %rdi + movq 128(%rsp), %rbp + xorq %r10, %rbp + rolq $45, %rbp + movq 176(%rsp), %rbx + xorq %r11, %rbx + rolq $61, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 272(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 280(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 288(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 296(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 304(%rsp) + movq 8(%rsp), %rdx + xorq %r10, %rdx + rolq $1, %rdx + movq 56(%rsp), %rsi + xorq %r11, %rsi + rolq $6, %rsi + movq 104(%rsp), %rdi + xorq %rcx, %rdi + rolq $25, %rdi + movq 152(%rsp), %rbp + xorq %rax, %rbp + rolq $8, %rbp + movq 160(%rsp), %rbx + xorq %r8, %rbx + rolq $18, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 312(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 320(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 328(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 336(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 344(%rsp) + movq 32(%rsp), %rdx + xorq %rax, %rdx + rolq $27, %rdx + movq 40(%rsp), %rsi + xorq %r8, %rsi + rolq $36, %rsi + movq 88(%rsp), %rdi + xorq %r10, %rdi + rolq $10, %rdi + movq 136(%rsp), %rbp + xorq %r11, %rbp + rolq $15, %rbp + movq 184(%rsp), %rbx + xorq %rcx, %rbx + rolq $56, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 352(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 360(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 368(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 376(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 384(%rsp) + movq 16(%rsp), %rdx + xorq %r11, %rdx + rolq $62, %rdx + movq 64(%rsp), %rsi + xorq %rcx, %rsi + rolq $55, %rsi + movq %rsi, %rcx + movq 112(%rsp), %rsi + xorq %rax, %rsi + rolq $39, %rsi + movq %rsi, %rax + movq 120(%rsp), %rsi + xorq %r8, %rsi + rolq $41, %rsi + movq 168(%rsp), %rdi + xorq %r10, %rdi + rolq $2, %rdi + andnq %rax, %rcx, %r8 + xorq %rdx, %r8 + movq %r8, 392(%rsp) + andnq %rsi, %rax, %r8 + xorq %rcx, %r8 + movq %r8, 400(%rsp) + andnq %rdi, %rsi, %r8 + xorq %rax, %r8 + movq %r8, 408(%rsp) + andnq %rdx, %rdi, %rax + xorq %rsi, %rax + movq %rax, 416(%rsp) + andnq %rcx, %rdx, %rax + xorq %rdi, %rax + movq %rax, 424(%rsp) + movq 8(%r9), %rax + movq %rax, 432(%rsp) + movq 232(%rsp), %rax + movq 240(%rsp), %rcx + movq 248(%rsp), %rdx + movq 256(%rsp), %rsi + movq 264(%rsp), %rdi + xorq 272(%rsp), %rax + xorq 280(%rsp), %rcx + xorq 288(%rsp), %rdx + xorq 296(%rsp), %rsi + xorq 304(%rsp), %rdi + xorq 312(%rsp), %rax + xorq 320(%rsp), %rcx + xorq 328(%rsp), %rdx + xorq 336(%rsp), %rsi + xorq 344(%rsp), %rdi + xorq 352(%rsp), %rax + xorq 360(%rsp), %rcx + xorq 368(%rsp), %rdx + xorq 376(%rsp), %rsi + xorq 384(%rsp), %rdi + xorq 392(%rsp), %rax + xorq 400(%rsp), %rcx + xorq 408(%rsp), %rdx + xorq 416(%rsp), %rsi + xorq 424(%rsp), %rdi + movq %rcx, %r8 + rolq $1, %r8 + xorq %rdi, %r8 + movq %rdx, %r10 + rolq $1, %r10 + xorq %rax, %r10 + movq %rsi, %r11 + rolq $1, %r11 + xorq %rcx, %r11 + movq %rdi, %rcx + rolq $1, %rcx + xorq %rdx, %rcx + rolq $1, %rax + xorq %rsi, %rax + movq 232(%rsp), %rdx + xorq %r8, %rdx + movq 280(%rsp), %rsi + xorq %r10, %rsi + rolq $44, %rsi + movq 328(%rsp), %rdi + xorq %r11, %rdi + rolq $43, %rdi + movq 376(%rsp), %rbp + xorq %rcx, %rbp + rolq $21, %rbp + movq 424(%rsp), %rbx + xorq %rax, %rbx + rolq $14, %rbx + andnq %rdi, %rsi, %r12 + xorq 432(%rsp), %r12 + xorq %rdx, %r12 + movq %r12, (%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 8(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 16(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 24(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 32(%rsp) + movq 256(%rsp), %rdx + xorq %rcx, %rdx + rolq $28, %rdx + movq 304(%rsp), %rsi + xorq %rax, %rsi + rolq $20, %rsi + movq 312(%rsp), %rdi + xorq %r8, %rdi + rolq $3, %rdi + movq 360(%rsp), %rbp + xorq %r10, %rbp + rolq $45, %rbp + movq 408(%rsp), %rbx + xorq %r11, %rbx + rolq $61, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 40(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 48(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 56(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 64(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 72(%rsp) + movq 240(%rsp), %rdx + xorq %r10, %rdx + rolq $1, %rdx + movq 288(%rsp), %rsi + xorq %r11, %rsi + rolq $6, %rsi + movq 336(%rsp), %rdi + xorq %rcx, %rdi + rolq $25, %rdi + movq 384(%rsp), %rbp + xorq %rax, %rbp + rolq $8, %rbp + movq 392(%rsp), %rbx + xorq %r8, %rbx + rolq $18, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 80(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 88(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 96(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 104(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 112(%rsp) + movq 264(%rsp), %rdx + xorq %rax, %rdx + rolq $27, %rdx + movq 272(%rsp), %rsi + xorq %r8, %rsi + rolq $36, %rsi + movq 320(%rsp), %rdi + xorq %r10, %rdi + rolq $10, %rdi + movq 368(%rsp), %rbp + xorq %r11, %rbp + rolq $15, %rbp + movq 416(%rsp), %rbx + xorq %rcx, %rbx + rolq $56, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 120(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 128(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 136(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 144(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 152(%rsp) + movq 248(%rsp), %rdx + xorq %r11, %rdx + rolq $62, %rdx + movq 296(%rsp), %rsi + xorq %rcx, %rsi + rolq $55, %rsi + movq %rsi, %rcx + movq 344(%rsp), %rsi + xorq %rax, %rsi + rolq $39, %rsi + movq %rsi, %rax + movq 352(%rsp), %rsi + xorq %r8, %rsi + rolq $41, %rsi + movq 400(%rsp), %rdi + xorq %r10, %rdi + rolq $2, %rdi + andnq %rax, %rcx, %r8 + xorq %rdx, %r8 + movq %r8, 160(%rsp) + andnq %rsi, %rax, %r8 + xorq %rcx, %r8 + movq %r8, 168(%rsp) + andnq %rdi, %rsi, %r8 + xorq %rax, %r8 + movq %r8, 176(%rsp) + andnq %rdx, %rdi, %rax + xorq %rsi, %rax + movq %rax, 184(%rsp) + andnq %rcx, %rdx, %rax + xorq %rdi, %rax + movq %rax, 192(%rsp) + leaq 16(%r9), %r9 + testb $-1, %r9b + jne Lkeccak_1600$10 + leaq -192(%r9), %r9 + movq 200(%rsp), %rcx + movq 448(%rsp), %rdx + movq 440(%rsp), %rax + movq %rax, %rsi + shrq $3, %rsi + movq $0, %rdi + jmp Lkeccak_1600$8 +Lkeccak_1600$9: + movq (%rsp,%rdi,8), %r8 + movq %r8, (%rcx,%rdi,8) + leaq 1(%rdi), %rdi +Lkeccak_1600$8: + cmpq %rsi, %rdi + jb Lkeccak_1600$9 + leaq (%rcx,%rax), %rcx + subq %rax, %rdx + movq %rcx, 200(%rsp) +Lkeccak_1600$6: + cmpq %rax, %rdx + jnbe Lkeccak_1600$7 + movq %rdx, 440(%rsp) +Lkeccak_1600$5: + movq (%r9), %rax + movq %rax, 448(%rsp) + movq (%rsp), %rax + movq 8(%rsp), %rcx + movq 16(%rsp), %rdx + movq 24(%rsp), %rsi + movq 32(%rsp), %rdi + xorq 40(%rsp), %rax + xorq 48(%rsp), %rcx + xorq 56(%rsp), %rdx + xorq 64(%rsp), %rsi + xorq 72(%rsp), %rdi + xorq 80(%rsp), %rax + xorq 88(%rsp), %rcx + xorq 96(%rsp), %rdx + xorq 104(%rsp), %rsi + xorq 112(%rsp), %rdi + xorq 120(%rsp), %rax + xorq 128(%rsp), %rcx + xorq 136(%rsp), %rdx + xorq 144(%rsp), %rsi + xorq 152(%rsp), %rdi + xorq 160(%rsp), %rax + xorq 168(%rsp), %rcx + xorq 176(%rsp), %rdx + xorq 184(%rsp), %rsi + xorq 192(%rsp), %rdi + movq %rcx, %r8 + rolq $1, %r8 + xorq %rdi, %r8 + movq %rdx, %r10 + rolq $1, %r10 + xorq %rax, %r10 + movq %rsi, %r11 + rolq $1, %r11 + xorq %rcx, %r11 + movq %rdi, %rcx + rolq $1, %rcx + xorq %rdx, %rcx + rolq $1, %rax + xorq %rsi, %rax + movq (%rsp), %rdx + xorq %r8, %rdx + movq 48(%rsp), %rsi + xorq %r10, %rsi + rolq $44, %rsi + movq 96(%rsp), %rdi + xorq %r11, %rdi + rolq $43, %rdi + movq 144(%rsp), %rbp + xorq %rcx, %rbp + rolq $21, %rbp + movq 192(%rsp), %rbx + xorq %rax, %rbx + rolq $14, %rbx + andnq %rdi, %rsi, %r12 + xorq 448(%rsp), %r12 + xorq %rdx, %r12 + movq %r12, 232(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 240(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 248(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 256(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 264(%rsp) + movq 24(%rsp), %rdx + xorq %rcx, %rdx + rolq $28, %rdx + movq 72(%rsp), %rsi + xorq %rax, %rsi + rolq $20, %rsi + movq 80(%rsp), %rdi + xorq %r8, %rdi + rolq $3, %rdi + movq 128(%rsp), %rbp + xorq %r10, %rbp + rolq $45, %rbp + movq 176(%rsp), %rbx + xorq %r11, %rbx + rolq $61, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 272(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 280(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 288(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 296(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 304(%rsp) + movq 8(%rsp), %rdx + xorq %r10, %rdx + rolq $1, %rdx + movq 56(%rsp), %rsi + xorq %r11, %rsi + rolq $6, %rsi + movq 104(%rsp), %rdi + xorq %rcx, %rdi + rolq $25, %rdi + movq 152(%rsp), %rbp + xorq %rax, %rbp + rolq $8, %rbp + movq 160(%rsp), %rbx + xorq %r8, %rbx + rolq $18, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 312(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 320(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 328(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 336(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 344(%rsp) + movq 32(%rsp), %rdx + xorq %rax, %rdx + rolq $27, %rdx + movq 40(%rsp), %rsi + xorq %r8, %rsi + rolq $36, %rsi + movq 88(%rsp), %rdi + xorq %r10, %rdi + rolq $10, %rdi + movq 136(%rsp), %rbp + xorq %r11, %rbp + rolq $15, %rbp + movq 184(%rsp), %rbx + xorq %rcx, %rbx + rolq $56, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 352(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 360(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 368(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 376(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 384(%rsp) + movq 16(%rsp), %rdx + xorq %r11, %rdx + rolq $62, %rdx + movq 64(%rsp), %rsi + xorq %rcx, %rsi + rolq $55, %rsi + movq %rsi, %rcx + movq 112(%rsp), %rsi + xorq %rax, %rsi + rolq $39, %rsi + movq %rsi, %rax + movq 120(%rsp), %rsi + xorq %r8, %rsi + rolq $41, %rsi + movq 168(%rsp), %rdi + xorq %r10, %rdi + rolq $2, %rdi + andnq %rax, %rcx, %r8 + xorq %rdx, %r8 + movq %r8, 392(%rsp) + andnq %rsi, %rax, %r8 + xorq %rcx, %r8 + movq %r8, 400(%rsp) + andnq %rdi, %rsi, %r8 + xorq %rax, %r8 + movq %r8, 408(%rsp) + andnq %rdx, %rdi, %rax + xorq %rsi, %rax + movq %rax, 416(%rsp) + andnq %rcx, %rdx, %rax + xorq %rdi, %rax + movq %rax, 424(%rsp) + movq 8(%r9), %rax + movq %rax, 448(%rsp) + movq 232(%rsp), %rax + movq 240(%rsp), %rcx + movq 248(%rsp), %rdx + movq 256(%rsp), %rsi + movq 264(%rsp), %rdi + xorq 272(%rsp), %rax + xorq 280(%rsp), %rcx + xorq 288(%rsp), %rdx + xorq 296(%rsp), %rsi + xorq 304(%rsp), %rdi + xorq 312(%rsp), %rax + xorq 320(%rsp), %rcx + xorq 328(%rsp), %rdx + xorq 336(%rsp), %rsi + xorq 344(%rsp), %rdi + xorq 352(%rsp), %rax + xorq 360(%rsp), %rcx + xorq 368(%rsp), %rdx + xorq 376(%rsp), %rsi + xorq 384(%rsp), %rdi + xorq 392(%rsp), %rax + xorq 400(%rsp), %rcx + xorq 408(%rsp), %rdx + xorq 416(%rsp), %rsi + xorq 424(%rsp), %rdi + movq %rcx, %r8 + rolq $1, %r8 + xorq %rdi, %r8 + movq %rdx, %r10 + rolq $1, %r10 + xorq %rax, %r10 + movq %rsi, %r11 + rolq $1, %r11 + xorq %rcx, %r11 + movq %rdi, %rcx + rolq $1, %rcx + xorq %rdx, %rcx + rolq $1, %rax + xorq %rsi, %rax + movq 232(%rsp), %rdx + xorq %r8, %rdx + movq 280(%rsp), %rsi + xorq %r10, %rsi + rolq $44, %rsi + movq 328(%rsp), %rdi + xorq %r11, %rdi + rolq $43, %rdi + movq 376(%rsp), %rbp + xorq %rcx, %rbp + rolq $21, %rbp + movq 424(%rsp), %rbx + xorq %rax, %rbx + rolq $14, %rbx + andnq %rdi, %rsi, %r12 + xorq 448(%rsp), %r12 + xorq %rdx, %r12 + movq %r12, (%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 8(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 16(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 24(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 32(%rsp) + movq 256(%rsp), %rdx + xorq %rcx, %rdx + rolq $28, %rdx + movq 304(%rsp), %rsi + xorq %rax, %rsi + rolq $20, %rsi + movq 312(%rsp), %rdi + xorq %r8, %rdi + rolq $3, %rdi + movq 360(%rsp), %rbp + xorq %r10, %rbp + rolq $45, %rbp + movq 408(%rsp), %rbx + xorq %r11, %rbx + rolq $61, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 40(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 48(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 56(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 64(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 72(%rsp) + movq 240(%rsp), %rdx + xorq %r10, %rdx + rolq $1, %rdx + movq 288(%rsp), %rsi + xorq %r11, %rsi + rolq $6, %rsi + movq 336(%rsp), %rdi + xorq %rcx, %rdi + rolq $25, %rdi + movq 384(%rsp), %rbp + xorq %rax, %rbp + rolq $8, %rbp + movq 392(%rsp), %rbx + xorq %r8, %rbx + rolq $18, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 80(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 88(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 96(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 104(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 112(%rsp) + movq 264(%rsp), %rdx + xorq %rax, %rdx + rolq $27, %rdx + movq 272(%rsp), %rsi + xorq %r8, %rsi + rolq $36, %rsi + movq 320(%rsp), %rdi + xorq %r10, %rdi + rolq $10, %rdi + movq 368(%rsp), %rbp + xorq %r11, %rbp + rolq $15, %rbp + movq 416(%rsp), %rbx + xorq %rcx, %rbx + rolq $56, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 120(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 128(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 136(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 144(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 152(%rsp) + movq 248(%rsp), %rdx + xorq %r11, %rdx + rolq $62, %rdx + movq 296(%rsp), %rsi + xorq %rcx, %rsi + rolq $55, %rsi + movq %rsi, %rcx + movq 344(%rsp), %rsi + xorq %rax, %rsi + rolq $39, %rsi + movq %rsi, %rax + movq 352(%rsp), %rsi + xorq %r8, %rsi + rolq $41, %rsi + movq 400(%rsp), %rdi + xorq %r10, %rdi + rolq $2, %rdi + andnq %rax, %rcx, %r8 + xorq %rdx, %r8 + movq %r8, 160(%rsp) + andnq %rsi, %rax, %r8 + xorq %rcx, %r8 + movq %r8, 168(%rsp) + andnq %rdi, %rsi, %r8 + xorq %rax, %r8 + movq %r8, 176(%rsp) + andnq %rdx, %rdi, %rax + xorq %rsi, %rax + movq %rax, 184(%rsp) + andnq %rcx, %rdx, %rax + xorq %rdi, %rax + movq %rax, 192(%rsp) + leaq 16(%r9), %r9 + testb $-1, %r9b + jne Lkeccak_1600$5 + movq 200(%rsp), %rax + movq 440(%rsp), %rcx + movq %rcx, %rdx + shrq $3, %rdx + movq $0, %rsi + jmp Lkeccak_1600$3 +Lkeccak_1600$4: + movq (%rsp,%rsi,8), %rdi + movq %rdi, (%rax,%rsi,8) + leaq 1(%rsi), %rsi +Lkeccak_1600$3: + cmpq %rdx, %rsi + jb Lkeccak_1600$4 + shlq $3, %rsi + jmp Lkeccak_1600$1 +Lkeccak_1600$2: + movb (%rsp,%rsi), %dl + movb %dl, (%rax,%rsi) + leaq 1(%rsi), %rsi +Lkeccak_1600$1: + cmpq %rcx, %rsi + jb Lkeccak_1600$2 + addq $456, %rsp + popq %r12 + popq %rbx + popq %rbp + ret diff --git a/code/crypto_hash/sha3256/.gitignore b/code/crypto_hash/sha3256/.gitignore new file mode 100644 index 0000000..ad1a23f --- /dev/null +++ b/code/crypto_hash/sha3256/.gitignore @@ -0,0 +1 @@ +*.japp diff --git a/code/crypto_hash/sha3256/avx2/Makefile b/code/crypto_hash/sha3256/avx2/Makefile new file mode 100644 index 0000000..0350626 --- /dev/null +++ b/code/crypto_hash/sha3256/avx2/Makefile @@ -0,0 +1,15 @@ +# -*- Makefile -*- + +.PHONY: default clean + +default: sha3256.japp sha3256.s + @true + +clean: + rm -f sha3256.japp sha3256.s + +%.s: %.japp + jasminc -lea -pasm $< > $@ || rm -f $@ + +%.japp: %.jazz + gpp -I../../../ -o $@ $< diff --git a/code/crypto_hash/sha3256/avx2/sha3256-m.c b/code/crypto_hash/sha3256/avx2/sha3256-m.c new file mode 100644 index 0000000..975c2e6 --- /dev/null +++ b/code/crypto_hash/sha3256/avx2/sha3256-m.c @@ -0,0 +1,85 @@ +#include "crypto_hash.h" +#include "impl.h" +#include "api.h" +#include +#include + + +extern void keccak_1600( + uint8_t *out, + uint64_t outlen, + const uint8_t *in, + size_t inlen, + uint64_t *c, + uint64_t **g +); + + +uint64_t rhotates_left[6*4] __attribute__((aligned(32))) = +{ + 3, 18, 36, 41, + 1, 62, 28, 27, + 45, 6, 56, 39, + 10, 61, 55, 8, + 2, 15, 25, 20, + 44, 43, 21, 14 +}; + + +uint64_t rhotates_right[6*4] __attribute__((aligned(32))) = +{ + 64-3, 64-18, 64-36, 64-41, + 64-1, 64-62, 64-28, 64-27, + 64-45, 64-6, 64-56, 64-39, + 64-10, 64-61, 64-55, 64-8, + 64-2, 64-15, 64-25, 64-20, + 64-44, 64-43, 64-21, 64-14 +}; + + +uint64_t iotas[24*4] __attribute__((aligned(32))) = +{ + 0x0000000000000001UL, 0x0000000000000001UL, 0x0000000000000001UL, 0x0000000000000001UL, + 0x0000000000008082UL, 0x0000000000008082UL, 0x0000000000008082UL, 0x0000000000008082UL, + 0x800000000000808aUL, 0x800000000000808aUL, 0x800000000000808aUL, 0x800000000000808aUL, + 0x8000000080008000UL, 0x8000000080008000UL, 0x8000000080008000UL, 0x8000000080008000UL, + 0x000000000000808bUL, 0x000000000000808bUL, 0x000000000000808bUL, 0x000000000000808bUL, + 0x0000000080000001UL, 0x0000000080000001UL, 0x0000000080000001UL, 0x0000000080000001UL, + 0x8000000080008081UL, 0x8000000080008081UL, 0x8000000080008081UL, 0x8000000080008081UL, + 0x8000000000008009UL, 0x8000000000008009UL, 0x8000000000008009UL, 0x8000000000008009UL, + 0x000000000000008aUL, 0x000000000000008aUL, 0x000000000000008aUL, 0x000000000000008aUL, + 0x0000000000000088UL, 0x0000000000000088UL, 0x0000000000000088UL, 0x0000000000000088UL, + 0x0000000080008009UL, 0x0000000080008009UL, 0x0000000080008009UL, 0x0000000080008009UL, + 0x000000008000000aUL, 0x000000008000000aUL, 0x000000008000000aUL, 0x000000008000000aUL, + 0x000000008000808bUL, 0x000000008000808bUL, 0x000000008000808bUL, 0x000000008000808bUL, + 0x800000000000008bUL, 0x800000000000008bUL, 0x800000000000008bUL, 0x800000000000008bUL, + 0x8000000000008089UL, 0x8000000000008089UL, 0x8000000000008089UL, 0x8000000000008089UL, + 0x8000000000008003UL, 0x8000000000008003UL, 0x8000000000008003UL, 0x8000000000008003UL, + 0x8000000000008002UL, 0x8000000000008002UL, 0x8000000000008002UL, 0x8000000000008002UL, + 0x8000000000000080UL, 0x8000000000000080UL, 0x8000000000000080UL, 0x8000000000000080UL, + 0x000000000000800aUL, 0x000000000000800aUL, 0x000000000000800aUL, 0x000000000000800aUL, + 0x800000008000000aUL, 0x800000008000000aUL, 0x800000008000000aUL, 0x800000008000000aUL, + 0x8000000080008081UL, 0x8000000080008081UL, 0x8000000080008081UL, 0x8000000080008081UL, + 0x8000000000008080UL, 0x8000000000008080UL, 0x8000000000008080UL, 0x8000000000008080UL, + 0x0000000080000001UL, 0x0000000080000001UL, 0x0000000080000001UL, 0x0000000080000001UL, + 0x8000000080008008UL, 0x8000000080008008UL, 0x8000000080008008UL, 0x8000000080008008UL +}; + + +uint64_t a_jagged[25] __attribute__((aligned(32))) = +{ + 0, 4, 5, 6, 7, + 10, 24, 13, 18, 23, + 8, 16, 25, 22, 15, + 11, 12, 21, 26, 19, + 9, 20, 17, 14, 27 +}; + + +int sha3256_avx2(unsigned char *out,const unsigned char *in,unsigned long long inlen) +{ + uint64_t *g[] = {rhotates_left, rhotates_right, iotas, a_jagged}; + uint64_t c[] = {0x06, (1088/8)}; + keccak_1600(out, 32, in, inlen, c, g); + return 0; +} diff --git a/code/crypto_hash/sha3256/avx2/sha3256.jazz b/code/crypto_hash/sha3256/avx2/sha3256.jazz new file mode 100644 index 0000000..7427b03 --- /dev/null +++ b/code/crypto_hash/sha3256/avx2/sha3256.jazz @@ -0,0 +1,63 @@ +#define KECCAK_1600_ADD_FULL_BLOCK_IMPLEMENTATION 1 + +u64 s_zero = 0; + +fn add_full_block( + reg u256[7] state, + stack u64[28] s_state, + reg u64 a_jagged, + reg u64 in inlen, + reg u64 rate +) -> reg u256[7], stack u64[28], reg u64, reg u64 +{ + reg u256 a00, a01, a11, a21, a31; + reg u256 t11 t41 t31 t21; + reg u256 zero; + reg u64 r10 r20 r30; + stack u64[4] s20; + + r10 = [in + 8*5]; + r20 = [in + 8*10]; + r30 = [in + 8*15]; + + s20[0] = r20; + s20[1] = 0; + s20[2] = r10; + s20[3] = r30; + + a00 = #x86_VPBROADCAST_4u64([in + 8*0]); // (0,0) (0,0) (0,0) (0,0) + a01 = (u256)[in + 8*1]; // (0,4) (0,3) (0,2) (0,1) + + state[0] ^= a00; + state[1] ^= a01; + state[2] ^= s20[u256 0]; + + a11 = (u256)[in + 8*6 ]; // (1,4) (1,3) (1,2) (1,1) + a21 = (u256)[in + 8*11]; // (2,4) (2,3) (2,2) (2,1) + a31 = #x86_VPBROADCAST_4u64([in + 8*16]); // (3,1) (3,1) (3,1) (3,1) + + t41 = #x86_VPBLENDD_256(a21, a11, (8u1)[1,1,0,0,0,0,1,1]); // (1,4) (2,3) (2,2) (1,1) + t31 = #x86_VPBLENDD_256(a21, a11, (8u1)[0,0,1,1,1,1,0,0]); // (2,4) (1,3) (1,2) (2,1) + + zero = #x86_VPBROADCAST_4u64(s_zero); + + t11 = #x86_VPBLENDD_256(t41, zero, (8u1)[1,1,1,1,0,0,0,0]); // ___ ___ (2,2) (1,1) + t21 = #x86_VPBLENDD_256(t31, zero, (8u1)[1,1,0,0,1,1,0,0]); // ___ (1,3) ___ (2,1) + t31 = #x86_VPBLENDD_256(t31, zero, (8u1)[0,0,1,1,0,0,1,1]); // (2,4) ___ (1,2) ___ + + state[6] ^= t11; + state[4] ^= t21; + + t41 = #x86_VPBLENDD_256(t41, zero, (8u1)[0,0,0,0,1,1,1,1]); // (1,4) (2,3) ___ ___ + t31 = #x86_VPBLENDD_256(t31, a31, (8u1)[0,0,0,0,0,0,1,1]); // (2,4) ___ (1,2) (3,1) + + state[5] ^= t41; + state[3] ^= t31; + + in += rate; + inlen -= rate; + + return state, s_state, in, inlen; +} + +#include "crypto_hash/keccak1600/avx2/keccak_1600.jazz" diff --git a/code/crypto_hash/sha3256/avx2/sha3256.s b/code/crypto_hash/sha3256/avx2/sha3256.s new file mode 100644 index 0000000..9828114 --- /dev/null +++ b/code/crypto_hash/sha3256/avx2/sha3256.s @@ -0,0 +1,531 @@ + .text + .p2align 5 + .globl _keccak_1600 + .globl keccak_1600 +_keccak_1600: +keccak_1600: + pushq %rbp + pushq %rbx + pushq %r12 + pushq %r13 + pushq %r14 + subq $256, %rsp + movb (%r8), %al + movq 8(%r8), %r8 + movq (%r9), %r10 + movq 8(%r9), %r11 + movq 16(%r9), %rbp + movq 24(%r9), %r9 + vpbroadcastq g_zero(%rip), %ymm2 + vmovdqu %ymm2, %ymm3 + vmovdqu %ymm2, %ymm4 + vmovdqu %ymm2, %ymm12 + vmovdqu %ymm2, %ymm10 + vmovdqu %ymm2, %ymm11 + vmovdqu %ymm2, %ymm9 + jmp Lkeccak_1600$15 +Lkeccak_1600$16: + movq 40(%rdx), %rbx + movq 80(%rdx), %r12 + movq 120(%rdx), %r13 + movq %r12, 224(%rsp) + movq $0, 232(%rsp) + movq %rbx, 240(%rsp) + movq %r13, 248(%rsp) + vpbroadcastq (%rdx), %ymm0 + vmovdqu 8(%rdx), %ymm1 + vpxor %ymm0, %ymm2, %ymm2 + vpxor %ymm1, %ymm3, %ymm3 + vpxor 224(%rsp), %ymm4, %ymm4 + vmovdqu 48(%rdx), %ymm0 + vmovdqu 88(%rdx), %ymm1 + vpbroadcastq 128(%rdx), %ymm5 + vpblendd $-61, %ymm0, %ymm1, %ymm6 + vpblendd $60, %ymm0, %ymm1, %ymm0 + vpbroadcastq s_zero(%rip), %ymm1 + vpblendd $-16, %ymm1, %ymm6, %ymm7 + vpblendd $-52, %ymm1, %ymm0, %ymm8 + vpblendd $51, %ymm1, %ymm0, %ymm0 + vpxor %ymm7, %ymm9, %ymm9 + vpxor %ymm8, %ymm10, %ymm10 + vpblendd $15, %ymm1, %ymm6, %ymm1 + vpblendd $3, %ymm5, %ymm0, %ymm0 + vpxor %ymm1, %ymm11, %ymm11 + vpxor %ymm0, %ymm12, %ymm12 + leaq (%rdx,%r8), %rdx + subq %r8, %rcx + leaq 96(%r10), %rbx + leaq 96(%r11), %r12 + movq %rbp, %r13 + movl $24, %r14d + .p2align 5 +Lkeccak_1600$17: + vpshufd $78, %ymm4, %ymm0 + vpxor %ymm12, %ymm11, %ymm1 + vpxor %ymm9, %ymm10, %ymm5 + vpxor %ymm3, %ymm1, %ymm1 + vpxor %ymm5, %ymm1, %ymm1 + vpermq $-109, %ymm1, %ymm5 + vpxor %ymm4, %ymm0, %ymm0 + vpermq $78, %ymm0, %ymm6 + vpsrlq $63, %ymm1, %ymm7 + vpaddq %ymm1, %ymm1, %ymm1 + vpor %ymm1, %ymm7, %ymm1 + vpermq $57, %ymm1, %ymm7 + vpxor %ymm5, %ymm1, %ymm1 + vpermq $0, %ymm1, %ymm1 + vpxor %ymm2, %ymm0, %ymm0 + vpxor %ymm6, %ymm0, %ymm0 + vpsrlq $63, %ymm0, %ymm6 + vpaddq %ymm0, %ymm0, %ymm8 + vpor %ymm6, %ymm8, %ymm6 + vpxor %ymm1, %ymm4, %ymm4 + vpxor %ymm1, %ymm2, %ymm1 + vpblendd $-64, %ymm6, %ymm7, %ymm2 + vpblendd $3, %ymm0, %ymm5, %ymm0 + vpxor %ymm0, %ymm2, %ymm0 + vpsllvq -96(%rbx), %ymm4, %ymm2 + vpsrlvq -96(%r12), %ymm4, %ymm4 + vpor %ymm2, %ymm4, %ymm2 + vpxor %ymm0, %ymm12, %ymm4 + vpsllvq -32(%rbx), %ymm4, %ymm5 + vpsrlvq -32(%r12), %ymm4, %ymm4 + vpor %ymm5, %ymm4, %ymm4 + vpxor %ymm0, %ymm10, %ymm5 + vpsllvq (%rbx), %ymm5, %ymm6 + vpsrlvq (%r12), %ymm5, %ymm5 + vpor %ymm6, %ymm5, %ymm5 + vpxor %ymm0, %ymm11, %ymm6 + vpsllvq 32(%rbx), %ymm6, %ymm7 + vpsrlvq 32(%r12), %ymm6, %ymm6 + vpor %ymm7, %ymm6, %ymm6 + vpxor %ymm0, %ymm9, %ymm7 + vpermq $-115, %ymm2, %ymm2 + vpermq $-115, %ymm4, %ymm8 + vpsllvq 64(%rbx), %ymm7, %ymm4 + vpsrlvq 64(%r12), %ymm7, %ymm7 + vpor %ymm4, %ymm7, %ymm7 + vpxor %ymm0, %ymm3, %ymm0 + vpermq $27, %ymm5, %ymm3 + vpermq $114, %ymm6, %ymm5 + vpsllvq -64(%rbx), %ymm0, %ymm4 + vpsrlvq -64(%r12), %ymm0, %ymm0 + vpor %ymm4, %ymm0, %ymm0 + vpsrldq $8, %ymm7, %ymm4 + vpandn %ymm4, %ymm7, %ymm6 + vpblendd $12, %ymm5, %ymm0, %ymm4 + vpblendd $12, %ymm0, %ymm8, %ymm9 + vpblendd $12, %ymm8, %ymm2, %ymm10 + vpblendd $12, %ymm2, %ymm0, %ymm11 + vpblendd $48, %ymm8, %ymm4, %ymm4 + vpblendd $48, %ymm3, %ymm9, %ymm9 + vpblendd $48, %ymm0, %ymm10, %ymm10 + vpblendd $48, %ymm5, %ymm11, %ymm11 + vpblendd $-64, %ymm3, %ymm4, %ymm4 + vpblendd $-64, %ymm5, %ymm9, %ymm9 + vpblendd $-64, %ymm5, %ymm10, %ymm10 + vpblendd $-64, %ymm8, %ymm11, %ymm11 + vpandn %ymm9, %ymm4, %ymm4 + vpandn %ymm11, %ymm10, %ymm9 + vpblendd $12, %ymm0, %ymm3, %ymm10 + vpblendd $12, %ymm3, %ymm2, %ymm11 + vpxor %ymm2, %ymm4, %ymm12 + vpblendd $48, %ymm2, %ymm10, %ymm4 + vpblendd $48, %ymm8, %ymm11, %ymm10 + vpxor %ymm3, %ymm9, %ymm9 + vpblendd $-64, %ymm8, %ymm4, %ymm4 + vpblendd $-64, %ymm0, %ymm10, %ymm10 + vpandn %ymm10, %ymm4, %ymm4 + vpxor %ymm5, %ymm4, %ymm10 + vpermq $30, %ymm7, %ymm4 + vpblendd $48, %ymm1, %ymm4, %ymm4 + vpermq $57, %ymm7, %ymm11 + vpblendd $-64, %ymm1, %ymm11, %ymm11 + vpandn %ymm4, %ymm11, %ymm13 + vpblendd $12, %ymm3, %ymm8, %ymm4 + vpblendd $12, %ymm8, %ymm5, %ymm11 + vpblendd $48, %ymm5, %ymm4, %ymm4 + vpblendd $48, %ymm2, %ymm11, %ymm11 + vpblendd $-64, %ymm2, %ymm4, %ymm4 + vpblendd $-64, %ymm3, %ymm11, %ymm11 + vpandn %ymm11, %ymm4, %ymm4 + vpxor %ymm0, %ymm4, %ymm4 + vpermq $0, %ymm6, %ymm6 + vpermq $27, %ymm12, %ymm12 + vpermq $-115, %ymm9, %ymm11 + vpermq $114, %ymm10, %ymm9 + vpblendd $12, %ymm2, %ymm5, %ymm10 + vpblendd $12, %ymm5, %ymm3, %ymm5 + vpblendd $48, %ymm3, %ymm10, %ymm3 + vpblendd $48, %ymm0, %ymm5, %ymm5 + vpblendd $-64, %ymm0, %ymm3, %ymm0 + vpblendd $-64, %ymm2, %ymm5, %ymm2 + vpandn %ymm2, %ymm0, %ymm0 + vpxor %ymm6, %ymm1, %ymm1 + vpxor %ymm7, %ymm13, %ymm3 + vpxor %ymm8, %ymm0, %ymm10 + vpxor (%r13), %ymm1, %ymm2 + leaq 32(%r13), %r13 + decl %r14d + jne Lkeccak_1600$17 +Lkeccak_1600$15: + cmpq %r8, %rcx + jnb Lkeccak_1600$16 + vpbroadcastq g_zero(%rip), %ymm0 + vmovdqu %ymm0, (%rsp) + vmovdqu %ymm0, 32(%rsp) + vmovdqu %ymm0, 64(%rsp) + vmovdqu %ymm0, 96(%rsp) + vmovdqu %ymm0, 128(%rsp) + vmovdqu %ymm0, 160(%rsp) + vmovdqu %ymm0, 192(%rsp) + movq %rcx, %rbx + shrq $3, %rbx + movq $0, %r12 + jmp Lkeccak_1600$13 +Lkeccak_1600$14: + movq (%rdx,%r12,8), %r13 + movq (%r9,%r12,8), %r14 + movq %r13, (%rsp,%r14,8) + leaq 1(%r12), %r12 +Lkeccak_1600$13: + cmpq %rbx, %r12 + jb Lkeccak_1600$14 + movq (%r9,%r12,8), %rbx + shlq $3, %rbx + shlq $3, %r12 + jmp Lkeccak_1600$11 +Lkeccak_1600$12: + movb (%rdx,%r12), %r13b + movb %r13b, (%rsp,%rbx) + leaq 1(%r12), %r12 + leaq 1(%rbx), %rbx +Lkeccak_1600$11: + cmpq %rcx, %r12 + jb Lkeccak_1600$12 + movb %al, (%rsp,%rbx) + movq %r8, %rax + leaq -1(%rax), %rax + shrq $3, %rax + movq (%r9,%rax,8), %rax + shlq $3, %rax + movq %r8, %rcx + leaq -1(%rcx), %rcx + andq $7, %rcx + leaq (%rax,%rcx), %rax + xorb $-128, (%rsp,%rax) + movq (%rsp), %rax + movq %rax, 8(%rsp) + movq %rax, 16(%rsp) + movq %rax, 24(%rsp) + vpxor (%rsp), %ymm2, %ymm0 + vpxor 32(%rsp), %ymm3, %ymm1 + vpxor 64(%rsp), %ymm4, %ymm2 + vpxor 96(%rsp), %ymm12, %ymm3 + vpxor 128(%rsp), %ymm10, %ymm4 + vpxor 160(%rsp), %ymm11, %ymm5 + vpxor 192(%rsp), %ymm9, %ymm6 + jmp Lkeccak_1600$6 +Lkeccak_1600$7: + leaq 96(%r10), %rax + leaq 96(%r11), %rcx + movq %rbp, %rdx + movl $24, %ebx + .p2align 5 +Lkeccak_1600$10: + vpshufd $78, %ymm2, %ymm7 + vpxor %ymm3, %ymm5, %ymm8 + vpxor %ymm6, %ymm4, %ymm9 + vpxor %ymm1, %ymm8, %ymm8 + vpxor %ymm9, %ymm8, %ymm8 + vpermq $-109, %ymm8, %ymm9 + vpxor %ymm2, %ymm7, %ymm7 + vpermq $78, %ymm7, %ymm10 + vpsrlq $63, %ymm8, %ymm11 + vpaddq %ymm8, %ymm8, %ymm8 + vpor %ymm8, %ymm11, %ymm8 + vpermq $57, %ymm8, %ymm11 + vpxor %ymm9, %ymm8, %ymm8 + vpermq $0, %ymm8, %ymm8 + vpxor %ymm0, %ymm7, %ymm7 + vpxor %ymm10, %ymm7, %ymm7 + vpsrlq $63, %ymm7, %ymm10 + vpaddq %ymm7, %ymm7, %ymm12 + vpor %ymm10, %ymm12, %ymm10 + vpxor %ymm8, %ymm2, %ymm2 + vpxor %ymm8, %ymm0, %ymm0 + vpblendd $-64, %ymm10, %ymm11, %ymm8 + vpblendd $3, %ymm7, %ymm9, %ymm7 + vpxor %ymm7, %ymm8, %ymm7 + vpsllvq -96(%rax), %ymm2, %ymm8 + vpsrlvq -96(%rcx), %ymm2, %ymm2 + vpor %ymm8, %ymm2, %ymm2 + vpxor %ymm7, %ymm3, %ymm3 + vpsllvq -32(%rax), %ymm3, %ymm8 + vpsrlvq -32(%rcx), %ymm3, %ymm3 + vpor %ymm8, %ymm3, %ymm3 + vpxor %ymm7, %ymm4, %ymm4 + vpsllvq (%rax), %ymm4, %ymm8 + vpsrlvq (%rcx), %ymm4, %ymm4 + vpor %ymm8, %ymm4, %ymm4 + vpxor %ymm7, %ymm5, %ymm5 + vpsllvq 32(%rax), %ymm5, %ymm8 + vpsrlvq 32(%rcx), %ymm5, %ymm5 + vpor %ymm8, %ymm5, %ymm5 + vpxor %ymm7, %ymm6, %ymm6 + vpermq $-115, %ymm2, %ymm8 + vpermq $-115, %ymm3, %ymm9 + vpsllvq 64(%rax), %ymm6, %ymm2 + vpsrlvq 64(%rcx), %ymm6, %ymm3 + vpor %ymm2, %ymm3, %ymm10 + vpxor %ymm7, %ymm1, %ymm1 + vpermq $27, %ymm4, %ymm4 + vpermq $114, %ymm5, %ymm7 + vpsllvq -64(%rax), %ymm1, %ymm2 + vpsrlvq -64(%rcx), %ymm1, %ymm1 + vpor %ymm2, %ymm1, %ymm1 + vpsrldq $8, %ymm10, %ymm2 + vpandn %ymm2, %ymm10, %ymm3 + vpblendd $12, %ymm7, %ymm1, %ymm2 + vpblendd $12, %ymm1, %ymm9, %ymm5 + vpblendd $12, %ymm9, %ymm8, %ymm6 + vpblendd $12, %ymm8, %ymm1, %ymm11 + vpblendd $48, %ymm9, %ymm2, %ymm2 + vpblendd $48, %ymm4, %ymm5, %ymm5 + vpblendd $48, %ymm1, %ymm6, %ymm6 + vpblendd $48, %ymm7, %ymm11, %ymm11 + vpblendd $-64, %ymm4, %ymm2, %ymm2 + vpblendd $-64, %ymm7, %ymm5, %ymm5 + vpblendd $-64, %ymm7, %ymm6, %ymm6 + vpblendd $-64, %ymm9, %ymm11, %ymm11 + vpandn %ymm5, %ymm2, %ymm2 + vpandn %ymm11, %ymm6, %ymm5 + vpblendd $12, %ymm1, %ymm4, %ymm6 + vpblendd $12, %ymm4, %ymm8, %ymm11 + vpxor %ymm8, %ymm2, %ymm12 + vpblendd $48, %ymm8, %ymm6, %ymm2 + vpblendd $48, %ymm9, %ymm11, %ymm6 + vpxor %ymm4, %ymm5, %ymm5 + vpblendd $-64, %ymm9, %ymm2, %ymm2 + vpblendd $-64, %ymm1, %ymm6, %ymm6 + vpandn %ymm6, %ymm2, %ymm2 + vpxor %ymm7, %ymm2, %ymm6 + vpermq $30, %ymm10, %ymm2 + vpblendd $48, %ymm0, %ymm2, %ymm2 + vpermq $57, %ymm10, %ymm11 + vpblendd $-64, %ymm0, %ymm11, %ymm11 + vpandn %ymm2, %ymm11, %ymm11 + vpblendd $12, %ymm4, %ymm9, %ymm2 + vpblendd $12, %ymm9, %ymm7, %ymm13 + vpblendd $48, %ymm7, %ymm2, %ymm2 + vpblendd $48, %ymm8, %ymm13, %ymm13 + vpblendd $-64, %ymm8, %ymm2, %ymm2 + vpblendd $-64, %ymm4, %ymm13, %ymm13 + vpandn %ymm13, %ymm2, %ymm2 + vpxor %ymm1, %ymm2, %ymm2 + vpermq $0, %ymm3, %ymm13 + vpermq $27, %ymm12, %ymm3 + vpermq $-115, %ymm5, %ymm5 + vpermq $114, %ymm6, %ymm6 + vpblendd $12, %ymm8, %ymm7, %ymm12 + vpblendd $12, %ymm7, %ymm4, %ymm7 + vpblendd $48, %ymm4, %ymm12, %ymm4 + vpblendd $48, %ymm1, %ymm7, %ymm7 + vpblendd $-64, %ymm1, %ymm4, %ymm1 + vpblendd $-64, %ymm8, %ymm7, %ymm4 + vpandn %ymm4, %ymm1, %ymm4 + vpxor %ymm13, %ymm0, %ymm0 + vpxor %ymm10, %ymm11, %ymm1 + vpxor %ymm9, %ymm4, %ymm4 + vpxor (%rdx), %ymm0, %ymm0 + leaq 32(%rdx), %rdx + decl %ebx + jne Lkeccak_1600$10 + vmovdqu %ymm0, (%rsp) + vmovdqu %ymm1, 32(%rsp) + vmovdqu %ymm2, 64(%rsp) + vmovdqu %ymm3, 96(%rsp) + vmovdqu %ymm4, 128(%rsp) + vmovdqu %ymm5, 160(%rsp) + vmovdqu %ymm6, 192(%rsp) + movq %r8, %rax + shrq $3, %rax + movq $0, %rcx + jmp Lkeccak_1600$8 +Lkeccak_1600$9: + movq (%r9,%rcx,8), %rdx + movq (%rsp,%rdx,8), %rdx + movq %rdx, (%rdi,%rcx,8) + leaq 1(%rcx), %rcx +Lkeccak_1600$8: + cmpq %rax, %rcx + jb Lkeccak_1600$9 + leaq (%rdi,%r8), %rdi + subq %r8, %rsi +Lkeccak_1600$6: + cmpq %r8, %rsi + jnbe Lkeccak_1600$7 + leaq 96(%r10), %rax + leaq 96(%r11), %rcx + movl $24, %edx + .p2align 5 +Lkeccak_1600$5: + vpshufd $78, %ymm2, %ymm7 + vpxor %ymm3, %ymm5, %ymm8 + vpxor %ymm6, %ymm4, %ymm9 + vpxor %ymm1, %ymm8, %ymm8 + vpxor %ymm9, %ymm8, %ymm8 + vpermq $-109, %ymm8, %ymm9 + vpxor %ymm2, %ymm7, %ymm7 + vpermq $78, %ymm7, %ymm10 + vpsrlq $63, %ymm8, %ymm11 + vpaddq %ymm8, %ymm8, %ymm8 + vpor %ymm8, %ymm11, %ymm8 + vpermq $57, %ymm8, %ymm11 + vpxor %ymm9, %ymm8, %ymm8 + vpermq $0, %ymm8, %ymm8 + vpxor %ymm0, %ymm7, %ymm7 + vpxor %ymm10, %ymm7, %ymm7 + vpsrlq $63, %ymm7, %ymm10 + vpaddq %ymm7, %ymm7, %ymm12 + vpor %ymm10, %ymm12, %ymm10 + vpxor %ymm8, %ymm2, %ymm2 + vpxor %ymm8, %ymm0, %ymm0 + vpblendd $-64, %ymm10, %ymm11, %ymm8 + vpblendd $3, %ymm7, %ymm9, %ymm7 + vpxor %ymm7, %ymm8, %ymm7 + vpsllvq -96(%rax), %ymm2, %ymm8 + vpsrlvq -96(%rcx), %ymm2, %ymm2 + vpor %ymm8, %ymm2, %ymm2 + vpxor %ymm7, %ymm3, %ymm3 + vpsllvq -32(%rax), %ymm3, %ymm8 + vpsrlvq -32(%rcx), %ymm3, %ymm3 + vpor %ymm8, %ymm3, %ymm3 + vpxor %ymm7, %ymm4, %ymm4 + vpsllvq (%rax), %ymm4, %ymm8 + vpsrlvq (%rcx), %ymm4, %ymm4 + vpor %ymm8, %ymm4, %ymm4 + vpxor %ymm7, %ymm5, %ymm5 + vpsllvq 32(%rax), %ymm5, %ymm8 + vpsrlvq 32(%rcx), %ymm5, %ymm5 + vpor %ymm8, %ymm5, %ymm5 + vpxor %ymm7, %ymm6, %ymm6 + vpermq $-115, %ymm2, %ymm8 + vpermq $-115, %ymm3, %ymm9 + vpsllvq 64(%rax), %ymm6, %ymm2 + vpsrlvq 64(%rcx), %ymm6, %ymm3 + vpor %ymm2, %ymm3, %ymm10 + vpxor %ymm7, %ymm1, %ymm1 + vpermq $27, %ymm4, %ymm4 + vpermq $114, %ymm5, %ymm7 + vpsllvq -64(%rax), %ymm1, %ymm2 + vpsrlvq -64(%rcx), %ymm1, %ymm1 + vpor %ymm2, %ymm1, %ymm1 + vpsrldq $8, %ymm10, %ymm2 + vpandn %ymm2, %ymm10, %ymm3 + vpblendd $12, %ymm7, %ymm1, %ymm2 + vpblendd $12, %ymm1, %ymm9, %ymm5 + vpblendd $12, %ymm9, %ymm8, %ymm6 + vpblendd $12, %ymm8, %ymm1, %ymm11 + vpblendd $48, %ymm9, %ymm2, %ymm2 + vpblendd $48, %ymm4, %ymm5, %ymm5 + vpblendd $48, %ymm1, %ymm6, %ymm6 + vpblendd $48, %ymm7, %ymm11, %ymm11 + vpblendd $-64, %ymm4, %ymm2, %ymm2 + vpblendd $-64, %ymm7, %ymm5, %ymm5 + vpblendd $-64, %ymm7, %ymm6, %ymm6 + vpblendd $-64, %ymm9, %ymm11, %ymm11 + vpandn %ymm5, %ymm2, %ymm2 + vpandn %ymm11, %ymm6, %ymm5 + vpblendd $12, %ymm1, %ymm4, %ymm6 + vpblendd $12, %ymm4, %ymm8, %ymm11 + vpxor %ymm8, %ymm2, %ymm12 + vpblendd $48, %ymm8, %ymm6, %ymm2 + vpblendd $48, %ymm9, %ymm11, %ymm6 + vpxor %ymm4, %ymm5, %ymm5 + vpblendd $-64, %ymm9, %ymm2, %ymm2 + vpblendd $-64, %ymm1, %ymm6, %ymm6 + vpandn %ymm6, %ymm2, %ymm2 + vpxor %ymm7, %ymm2, %ymm6 + vpermq $30, %ymm10, %ymm2 + vpblendd $48, %ymm0, %ymm2, %ymm2 + vpermq $57, %ymm10, %ymm11 + vpblendd $-64, %ymm0, %ymm11, %ymm11 + vpandn %ymm2, %ymm11, %ymm11 + vpblendd $12, %ymm4, %ymm9, %ymm2 + vpblendd $12, %ymm9, %ymm7, %ymm13 + vpblendd $48, %ymm7, %ymm2, %ymm2 + vpblendd $48, %ymm8, %ymm13, %ymm13 + vpblendd $-64, %ymm8, %ymm2, %ymm2 + vpblendd $-64, %ymm4, %ymm13, %ymm13 + vpandn %ymm13, %ymm2, %ymm2 + vpxor %ymm1, %ymm2, %ymm2 + vpermq $0, %ymm3, %ymm13 + vpermq $27, %ymm12, %ymm3 + vpermq $-115, %ymm5, %ymm5 + vpermq $114, %ymm6, %ymm6 + vpblendd $12, %ymm8, %ymm7, %ymm12 + vpblendd $12, %ymm7, %ymm4, %ymm7 + vpblendd $48, %ymm4, %ymm12, %ymm4 + vpblendd $48, %ymm1, %ymm7, %ymm7 + vpblendd $-64, %ymm1, %ymm4, %ymm1 + vpblendd $-64, %ymm8, %ymm7, %ymm4 + vpandn %ymm4, %ymm1, %ymm4 + vpxor %ymm13, %ymm0, %ymm0 + vpxor %ymm10, %ymm11, %ymm1 + vpxor %ymm9, %ymm4, %ymm4 + vpxor (%rbp), %ymm0, %ymm0 + leaq 32(%rbp), %rbp + decl %edx + jne Lkeccak_1600$5 + vmovdqu %ymm0, (%rsp) + vmovdqu %ymm1, 32(%rsp) + vmovdqu %ymm2, 64(%rsp) + vmovdqu %ymm3, 96(%rsp) + vmovdqu %ymm4, 128(%rsp) + vmovdqu %ymm5, 160(%rsp) + vmovdqu %ymm6, 192(%rsp) + movq %rsi, %rax + shrq $3, %rax + movq $0, %rcx + jmp Lkeccak_1600$3 +Lkeccak_1600$4: + movq (%r9,%rcx,8), %rdx + movq (%rsp,%rdx,8), %rdx + movq %rdx, (%rdi,%rcx,8) + leaq 1(%rcx), %rcx +Lkeccak_1600$3: + cmpq %rax, %rcx + jb Lkeccak_1600$4 + movq (%r9,%rcx,8), %rax + shlq $3, %rcx + shlq $3, %rax + jmp Lkeccak_1600$1 +Lkeccak_1600$2: + movb (%rsp,%rax), %dl + movb %dl, (%rdi,%rcx) + leaq 1(%rcx), %rcx + leaq 1(%rax), %rax +Lkeccak_1600$1: + cmpq %rsi, %rcx + jb Lkeccak_1600$2 + addq $256, %rsp + popq %r14 + popq %r13 + popq %r12 + popq %rbx + popq %rbp + ret + .data + .globl _g_zero + .globl g_zero + .p2align 3 +_g_zero: +g_zero: + .quad 0 + .globl _s_zero + .globl s_zero + .p2align 3 +_s_zero: +s_zero: + .quad 0 diff --git a/code/crypto_hash/sha3256/scalar/Makefile b/code/crypto_hash/sha3256/scalar/Makefile new file mode 100644 index 0000000..0350626 --- /dev/null +++ b/code/crypto_hash/sha3256/scalar/Makefile @@ -0,0 +1,15 @@ +# -*- Makefile -*- + +.PHONY: default clean + +default: sha3256.japp sha3256.s + @true + +clean: + rm -f sha3256.japp sha3256.s + +%.s: %.japp + jasminc -lea -pasm $< > $@ || rm -f $@ + +%.japp: %.jazz + gpp -I../../../ -o $@ $< diff --git a/code/crypto_hash/sha3256/scalar/sha3256-m.c b/code/crypto_hash/sha3256/scalar/sha3256-m.c new file mode 100644 index 0000000..885b94c --- /dev/null +++ b/code/crypto_hash/sha3256/scalar/sha3256-m.c @@ -0,0 +1,54 @@ +#include "crypto_hash.h" +#include "impl.h" +#include "api.h" +#include +#include + + +extern void keccak_1600( + uint8_t *out, + uint64_t outlen, + const uint8_t *in, + size_t inlen, + uint64_t *c, + uint64_t *iotas +); + + +uint64_t iotas[32] __attribute__((aligned(256))) = +{ + 0,0,0,0,0,0,0, 0 + , 0x0000000000000001 + , 0x0000000000008082 + , 0x800000000000808a + , 0x8000000080008000 + , 0x000000000000808b + , 0x0000000080000001 + , 0x8000000080008081 + , 0x8000000000008009 + , 0x000000000000008a + , 0x0000000000000088 + , 0x0000000080008009 + , 0x000000008000000a + , 0x000000008000808b + , 0x800000000000008b + , 0x8000000000008089 + , 0x8000000000008003 + , 0x8000000000008002 + , 0x8000000000000080 + , 0x000000000000800a + , 0x800000008000000a + , 0x8000000080008081 + , 0x8000000000008080 + , 0x0000000080000001 + , 0x8000000080008008 +}; + + +int sha3256_scalar(unsigned char *out,const unsigned char *in,unsigned long long inlen) +{ + uint64_t c[] = {0x06, (1088/8)}; + keccak_1600(out, 32, in, inlen, c, &(iotas[8])); + return 0; +} + diff --git a/code/crypto_hash/sha3256/scalar/sha3256.jazz b/code/crypto_hash/sha3256/scalar/sha3256.jazz new file mode 100644 index 0000000..d2fa40e --- /dev/null +++ b/code/crypto_hash/sha3256/scalar/sha3256.jazz @@ -0,0 +1 @@ +#include "crypto_hash/keccak1600/scalar/keccak_1600.jazz" diff --git a/code/crypto_hash/sha3256/scalar/sha3256.s b/code/crypto_hash/sha3256/scalar/sha3256.s new file mode 100644 index 0000000..f79b7d1 --- /dev/null +++ b/code/crypto_hash/sha3256/scalar/sha3256.s @@ -0,0 +1,1299 @@ + .text + .p2align 5 + .globl _keccak_1600 + .globl keccak_1600 +_keccak_1600: +keccak_1600: + pushq %rbp + pushq %rbx + pushq %r12 + subq $456, %rsp + movq %rdi, 200(%rsp) + movq %rsi, 448(%rsp) + movzbq (%r8), %rax + movq %rax, 440(%rsp) + movq 8(%r8), %rax + xorl %esi, %esi + movq $0, %rdi + jmp Lkeccak_1600$20 +Lkeccak_1600$21: + movq %rsi, (%rsp,%rdi,8) + leaq 1(%rdi), %rdi +Lkeccak_1600$20: + cmpq $25, %rdi + jb Lkeccak_1600$21 + jmp Lkeccak_1600$15 +Lkeccak_1600$16: + movq %rax, %rsi + shrq $3, %rsi + movq $0, %rdi + jmp Lkeccak_1600$18 +Lkeccak_1600$19: + movq (%rdx,%rdi,8), %r8 + xorq %r8, (%rsp,%rdi,8) + leaq 1(%rdi), %rdi +Lkeccak_1600$18: + cmpq %rsi, %rdi + jb Lkeccak_1600$19 + leaq (%rdx,%rax), %rdx + subq %rax, %rcx + movq %rdx, 224(%rsp) + movq %rcx, 216(%rsp) + movq %rax, 208(%rsp) +Lkeccak_1600$17: + movq (%r9), %rax + movq %rax, 432(%rsp) + movq (%rsp), %rax + movq 8(%rsp), %rcx + movq 16(%rsp), %rdx + movq 24(%rsp), %rsi + movq 32(%rsp), %rdi + xorq 40(%rsp), %rax + xorq 48(%rsp), %rcx + xorq 56(%rsp), %rdx + xorq 64(%rsp), %rsi + xorq 72(%rsp), %rdi + xorq 80(%rsp), %rax + xorq 88(%rsp), %rcx + xorq 96(%rsp), %rdx + xorq 104(%rsp), %rsi + xorq 112(%rsp), %rdi + xorq 120(%rsp), %rax + xorq 128(%rsp), %rcx + xorq 136(%rsp), %rdx + xorq 144(%rsp), %rsi + xorq 152(%rsp), %rdi + xorq 160(%rsp), %rax + xorq 168(%rsp), %rcx + xorq 176(%rsp), %rdx + xorq 184(%rsp), %rsi + xorq 192(%rsp), %rdi + movq %rcx, %r8 + rolq $1, %r8 + xorq %rdi, %r8 + movq %rdx, %r10 + rolq $1, %r10 + xorq %rax, %r10 + movq %rsi, %r11 + rolq $1, %r11 + xorq %rcx, %r11 + movq %rdi, %rcx + rolq $1, %rcx + xorq %rdx, %rcx + rolq $1, %rax + xorq %rsi, %rax + movq (%rsp), %rdx + xorq %r8, %rdx + movq 48(%rsp), %rsi + xorq %r10, %rsi + rolq $44, %rsi + movq 96(%rsp), %rdi + xorq %r11, %rdi + rolq $43, %rdi + movq 144(%rsp), %rbp + xorq %rcx, %rbp + rolq $21, %rbp + movq 192(%rsp), %rbx + xorq %rax, %rbx + rolq $14, %rbx + andnq %rdi, %rsi, %r12 + xorq 432(%rsp), %r12 + xorq %rdx, %r12 + movq %r12, 232(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 240(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 248(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 256(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 264(%rsp) + movq 24(%rsp), %rdx + xorq %rcx, %rdx + rolq $28, %rdx + movq 72(%rsp), %rsi + xorq %rax, %rsi + rolq $20, %rsi + movq 80(%rsp), %rdi + xorq %r8, %rdi + rolq $3, %rdi + movq 128(%rsp), %rbp + xorq %r10, %rbp + rolq $45, %rbp + movq 176(%rsp), %rbx + xorq %r11, %rbx + rolq $61, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 272(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 280(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 288(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 296(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 304(%rsp) + movq 8(%rsp), %rdx + xorq %r10, %rdx + rolq $1, %rdx + movq 56(%rsp), %rsi + xorq %r11, %rsi + rolq $6, %rsi + movq 104(%rsp), %rdi + xorq %rcx, %rdi + rolq $25, %rdi + movq 152(%rsp), %rbp + xorq %rax, %rbp + rolq $8, %rbp + movq 160(%rsp), %rbx + xorq %r8, %rbx + rolq $18, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 312(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 320(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 328(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 336(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 344(%rsp) + movq 32(%rsp), %rdx + xorq %rax, %rdx + rolq $27, %rdx + movq 40(%rsp), %rsi + xorq %r8, %rsi + rolq $36, %rsi + movq 88(%rsp), %rdi + xorq %r10, %rdi + rolq $10, %rdi + movq 136(%rsp), %rbp + xorq %r11, %rbp + rolq $15, %rbp + movq 184(%rsp), %rbx + xorq %rcx, %rbx + rolq $56, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 352(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 360(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 368(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 376(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 384(%rsp) + movq 16(%rsp), %rdx + xorq %r11, %rdx + rolq $62, %rdx + movq 64(%rsp), %rsi + xorq %rcx, %rsi + rolq $55, %rsi + movq %rsi, %rcx + movq 112(%rsp), %rsi + xorq %rax, %rsi + rolq $39, %rsi + movq %rsi, %rax + movq 120(%rsp), %rsi + xorq %r8, %rsi + rolq $41, %rsi + movq 168(%rsp), %rdi + xorq %r10, %rdi + rolq $2, %rdi + andnq %rax, %rcx, %r8 + xorq %rdx, %r8 + movq %r8, 392(%rsp) + andnq %rsi, %rax, %r8 + xorq %rcx, %r8 + movq %r8, 400(%rsp) + andnq %rdi, %rsi, %r8 + xorq %rax, %r8 + movq %r8, 408(%rsp) + andnq %rdx, %rdi, %rax + xorq %rsi, %rax + movq %rax, 416(%rsp) + andnq %rcx, %rdx, %rax + xorq %rdi, %rax + movq %rax, 424(%rsp) + movq 8(%r9), %rax + movq %rax, 432(%rsp) + movq 232(%rsp), %rax + movq 240(%rsp), %rcx + movq 248(%rsp), %rdx + movq 256(%rsp), %rsi + movq 264(%rsp), %rdi + xorq 272(%rsp), %rax + xorq 280(%rsp), %rcx + xorq 288(%rsp), %rdx + xorq 296(%rsp), %rsi + xorq 304(%rsp), %rdi + xorq 312(%rsp), %rax + xorq 320(%rsp), %rcx + xorq 328(%rsp), %rdx + xorq 336(%rsp), %rsi + xorq 344(%rsp), %rdi + xorq 352(%rsp), %rax + xorq 360(%rsp), %rcx + xorq 368(%rsp), %rdx + xorq 376(%rsp), %rsi + xorq 384(%rsp), %rdi + xorq 392(%rsp), %rax + xorq 400(%rsp), %rcx + xorq 408(%rsp), %rdx + xorq 416(%rsp), %rsi + xorq 424(%rsp), %rdi + movq %rcx, %r8 + rolq $1, %r8 + xorq %rdi, %r8 + movq %rdx, %r10 + rolq $1, %r10 + xorq %rax, %r10 + movq %rsi, %r11 + rolq $1, %r11 + xorq %rcx, %r11 + movq %rdi, %rcx + rolq $1, %rcx + xorq %rdx, %rcx + rolq $1, %rax + xorq %rsi, %rax + movq 232(%rsp), %rdx + xorq %r8, %rdx + movq 280(%rsp), %rsi + xorq %r10, %rsi + rolq $44, %rsi + movq 328(%rsp), %rdi + xorq %r11, %rdi + rolq $43, %rdi + movq 376(%rsp), %rbp + xorq %rcx, %rbp + rolq $21, %rbp + movq 424(%rsp), %rbx + xorq %rax, %rbx + rolq $14, %rbx + andnq %rdi, %rsi, %r12 + xorq 432(%rsp), %r12 + xorq %rdx, %r12 + movq %r12, (%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 8(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 16(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 24(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 32(%rsp) + movq 256(%rsp), %rdx + xorq %rcx, %rdx + rolq $28, %rdx + movq 304(%rsp), %rsi + xorq %rax, %rsi + rolq $20, %rsi + movq 312(%rsp), %rdi + xorq %r8, %rdi + rolq $3, %rdi + movq 360(%rsp), %rbp + xorq %r10, %rbp + rolq $45, %rbp + movq 408(%rsp), %rbx + xorq %r11, %rbx + rolq $61, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 40(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 48(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 56(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 64(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 72(%rsp) + movq 240(%rsp), %rdx + xorq %r10, %rdx + rolq $1, %rdx + movq 288(%rsp), %rsi + xorq %r11, %rsi + rolq $6, %rsi + movq 336(%rsp), %rdi + xorq %rcx, %rdi + rolq $25, %rdi + movq 384(%rsp), %rbp + xorq %rax, %rbp + rolq $8, %rbp + movq 392(%rsp), %rbx + xorq %r8, %rbx + rolq $18, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 80(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 88(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 96(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 104(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 112(%rsp) + movq 264(%rsp), %rdx + xorq %rax, %rdx + rolq $27, %rdx + movq 272(%rsp), %rsi + xorq %r8, %rsi + rolq $36, %rsi + movq 320(%rsp), %rdi + xorq %r10, %rdi + rolq $10, %rdi + movq 368(%rsp), %rbp + xorq %r11, %rbp + rolq $15, %rbp + movq 416(%rsp), %rbx + xorq %rcx, %rbx + rolq $56, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 120(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 128(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 136(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 144(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 152(%rsp) + movq 248(%rsp), %rdx + xorq %r11, %rdx + rolq $62, %rdx + movq 296(%rsp), %rsi + xorq %rcx, %rsi + rolq $55, %rsi + movq %rsi, %rcx + movq 344(%rsp), %rsi + xorq %rax, %rsi + rolq $39, %rsi + movq %rsi, %rax + movq 352(%rsp), %rsi + xorq %r8, %rsi + rolq $41, %rsi + movq 400(%rsp), %rdi + xorq %r10, %rdi + rolq $2, %rdi + andnq %rax, %rcx, %r8 + xorq %rdx, %r8 + movq %r8, 160(%rsp) + andnq %rsi, %rax, %r8 + xorq %rcx, %r8 + movq %r8, 168(%rsp) + andnq %rdi, %rsi, %r8 + xorq %rax, %r8 + movq %r8, 176(%rsp) + andnq %rdx, %rdi, %rax + xorq %rsi, %rax + movq %rax, 184(%rsp) + andnq %rcx, %rdx, %rax + xorq %rdi, %rax + movq %rax, 192(%rsp) + leaq 16(%r9), %r9 + testb $-1, %r9b + jne Lkeccak_1600$17 + leaq -192(%r9), %r9 + movq 224(%rsp), %rdx + movq 216(%rsp), %rcx + movq 208(%rsp), %rax +Lkeccak_1600$15: + cmpq %rax, %rcx + jnb Lkeccak_1600$16 + movq 440(%rsp), %rsi + movb %sil, %sil + movq %rcx, %rdi + shrq $3, %rdi + movq $0, %r8 + jmp Lkeccak_1600$13 +Lkeccak_1600$14: + movq (%rdx,%r8,8), %r10 + xorq %r10, (%rsp,%r8,8) + leaq 1(%r8), %r8 +Lkeccak_1600$13: + cmpq %rdi, %r8 + jb Lkeccak_1600$14 + shlq $3, %r8 + jmp Lkeccak_1600$11 +Lkeccak_1600$12: + movb (%rdx,%r8), %dil + xorb %dil, (%rsp,%r8) + leaq 1(%r8), %r8 +Lkeccak_1600$11: + cmpq %rcx, %r8 + jb Lkeccak_1600$12 + xorb %sil, (%rsp,%r8) + movq %rax, %rcx + leaq -1(%rcx), %rcx + xorb $-128, (%rsp,%rcx) + movq 448(%rsp), %rdx + jmp Lkeccak_1600$6 +Lkeccak_1600$7: + movq %rdx, 448(%rsp) + movq %rax, 440(%rsp) +Lkeccak_1600$10: + movq (%r9), %rax + movq %rax, 432(%rsp) + movq (%rsp), %rax + movq 8(%rsp), %rcx + movq 16(%rsp), %rdx + movq 24(%rsp), %rsi + movq 32(%rsp), %rdi + xorq 40(%rsp), %rax + xorq 48(%rsp), %rcx + xorq 56(%rsp), %rdx + xorq 64(%rsp), %rsi + xorq 72(%rsp), %rdi + xorq 80(%rsp), %rax + xorq 88(%rsp), %rcx + xorq 96(%rsp), %rdx + xorq 104(%rsp), %rsi + xorq 112(%rsp), %rdi + xorq 120(%rsp), %rax + xorq 128(%rsp), %rcx + xorq 136(%rsp), %rdx + xorq 144(%rsp), %rsi + xorq 152(%rsp), %rdi + xorq 160(%rsp), %rax + xorq 168(%rsp), %rcx + xorq 176(%rsp), %rdx + xorq 184(%rsp), %rsi + xorq 192(%rsp), %rdi + movq %rcx, %r8 + rolq $1, %r8 + xorq %rdi, %r8 + movq %rdx, %r10 + rolq $1, %r10 + xorq %rax, %r10 + movq %rsi, %r11 + rolq $1, %r11 + xorq %rcx, %r11 + movq %rdi, %rcx + rolq $1, %rcx + xorq %rdx, %rcx + rolq $1, %rax + xorq %rsi, %rax + movq (%rsp), %rdx + xorq %r8, %rdx + movq 48(%rsp), %rsi + xorq %r10, %rsi + rolq $44, %rsi + movq 96(%rsp), %rdi + xorq %r11, %rdi + rolq $43, %rdi + movq 144(%rsp), %rbp + xorq %rcx, %rbp + rolq $21, %rbp + movq 192(%rsp), %rbx + xorq %rax, %rbx + rolq $14, %rbx + andnq %rdi, %rsi, %r12 + xorq 432(%rsp), %r12 + xorq %rdx, %r12 + movq %r12, 232(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 240(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 248(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 256(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 264(%rsp) + movq 24(%rsp), %rdx + xorq %rcx, %rdx + rolq $28, %rdx + movq 72(%rsp), %rsi + xorq %rax, %rsi + rolq $20, %rsi + movq 80(%rsp), %rdi + xorq %r8, %rdi + rolq $3, %rdi + movq 128(%rsp), %rbp + xorq %r10, %rbp + rolq $45, %rbp + movq 176(%rsp), %rbx + xorq %r11, %rbx + rolq $61, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 272(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 280(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 288(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 296(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 304(%rsp) + movq 8(%rsp), %rdx + xorq %r10, %rdx + rolq $1, %rdx + movq 56(%rsp), %rsi + xorq %r11, %rsi + rolq $6, %rsi + movq 104(%rsp), %rdi + xorq %rcx, %rdi + rolq $25, %rdi + movq 152(%rsp), %rbp + xorq %rax, %rbp + rolq $8, %rbp + movq 160(%rsp), %rbx + xorq %r8, %rbx + rolq $18, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 312(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 320(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 328(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 336(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 344(%rsp) + movq 32(%rsp), %rdx + xorq %rax, %rdx + rolq $27, %rdx + movq 40(%rsp), %rsi + xorq %r8, %rsi + rolq $36, %rsi + movq 88(%rsp), %rdi + xorq %r10, %rdi + rolq $10, %rdi + movq 136(%rsp), %rbp + xorq %r11, %rbp + rolq $15, %rbp + movq 184(%rsp), %rbx + xorq %rcx, %rbx + rolq $56, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 352(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 360(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 368(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 376(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 384(%rsp) + movq 16(%rsp), %rdx + xorq %r11, %rdx + rolq $62, %rdx + movq 64(%rsp), %rsi + xorq %rcx, %rsi + rolq $55, %rsi + movq %rsi, %rcx + movq 112(%rsp), %rsi + xorq %rax, %rsi + rolq $39, %rsi + movq %rsi, %rax + movq 120(%rsp), %rsi + xorq %r8, %rsi + rolq $41, %rsi + movq 168(%rsp), %rdi + xorq %r10, %rdi + rolq $2, %rdi + andnq %rax, %rcx, %r8 + xorq %rdx, %r8 + movq %r8, 392(%rsp) + andnq %rsi, %rax, %r8 + xorq %rcx, %r8 + movq %r8, 400(%rsp) + andnq %rdi, %rsi, %r8 + xorq %rax, %r8 + movq %r8, 408(%rsp) + andnq %rdx, %rdi, %rax + xorq %rsi, %rax + movq %rax, 416(%rsp) + andnq %rcx, %rdx, %rax + xorq %rdi, %rax + movq %rax, 424(%rsp) + movq 8(%r9), %rax + movq %rax, 432(%rsp) + movq 232(%rsp), %rax + movq 240(%rsp), %rcx + movq 248(%rsp), %rdx + movq 256(%rsp), %rsi + movq 264(%rsp), %rdi + xorq 272(%rsp), %rax + xorq 280(%rsp), %rcx + xorq 288(%rsp), %rdx + xorq 296(%rsp), %rsi + xorq 304(%rsp), %rdi + xorq 312(%rsp), %rax + xorq 320(%rsp), %rcx + xorq 328(%rsp), %rdx + xorq 336(%rsp), %rsi + xorq 344(%rsp), %rdi + xorq 352(%rsp), %rax + xorq 360(%rsp), %rcx + xorq 368(%rsp), %rdx + xorq 376(%rsp), %rsi + xorq 384(%rsp), %rdi + xorq 392(%rsp), %rax + xorq 400(%rsp), %rcx + xorq 408(%rsp), %rdx + xorq 416(%rsp), %rsi + xorq 424(%rsp), %rdi + movq %rcx, %r8 + rolq $1, %r8 + xorq %rdi, %r8 + movq %rdx, %r10 + rolq $1, %r10 + xorq %rax, %r10 + movq %rsi, %r11 + rolq $1, %r11 + xorq %rcx, %r11 + movq %rdi, %rcx + rolq $1, %rcx + xorq %rdx, %rcx + rolq $1, %rax + xorq %rsi, %rax + movq 232(%rsp), %rdx + xorq %r8, %rdx + movq 280(%rsp), %rsi + xorq %r10, %rsi + rolq $44, %rsi + movq 328(%rsp), %rdi + xorq %r11, %rdi + rolq $43, %rdi + movq 376(%rsp), %rbp + xorq %rcx, %rbp + rolq $21, %rbp + movq 424(%rsp), %rbx + xorq %rax, %rbx + rolq $14, %rbx + andnq %rdi, %rsi, %r12 + xorq 432(%rsp), %r12 + xorq %rdx, %r12 + movq %r12, (%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 8(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 16(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 24(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 32(%rsp) + movq 256(%rsp), %rdx + xorq %rcx, %rdx + rolq $28, %rdx + movq 304(%rsp), %rsi + xorq %rax, %rsi + rolq $20, %rsi + movq 312(%rsp), %rdi + xorq %r8, %rdi + rolq $3, %rdi + movq 360(%rsp), %rbp + xorq %r10, %rbp + rolq $45, %rbp + movq 408(%rsp), %rbx + xorq %r11, %rbx + rolq $61, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 40(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 48(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 56(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 64(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 72(%rsp) + movq 240(%rsp), %rdx + xorq %r10, %rdx + rolq $1, %rdx + movq 288(%rsp), %rsi + xorq %r11, %rsi + rolq $6, %rsi + movq 336(%rsp), %rdi + xorq %rcx, %rdi + rolq $25, %rdi + movq 384(%rsp), %rbp + xorq %rax, %rbp + rolq $8, %rbp + movq 392(%rsp), %rbx + xorq %r8, %rbx + rolq $18, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 80(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 88(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 96(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 104(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 112(%rsp) + movq 264(%rsp), %rdx + xorq %rax, %rdx + rolq $27, %rdx + movq 272(%rsp), %rsi + xorq %r8, %rsi + rolq $36, %rsi + movq 320(%rsp), %rdi + xorq %r10, %rdi + rolq $10, %rdi + movq 368(%rsp), %rbp + xorq %r11, %rbp + rolq $15, %rbp + movq 416(%rsp), %rbx + xorq %rcx, %rbx + rolq $56, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 120(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 128(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 136(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 144(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 152(%rsp) + movq 248(%rsp), %rdx + xorq %r11, %rdx + rolq $62, %rdx + movq 296(%rsp), %rsi + xorq %rcx, %rsi + rolq $55, %rsi + movq %rsi, %rcx + movq 344(%rsp), %rsi + xorq %rax, %rsi + rolq $39, %rsi + movq %rsi, %rax + movq 352(%rsp), %rsi + xorq %r8, %rsi + rolq $41, %rsi + movq 400(%rsp), %rdi + xorq %r10, %rdi + rolq $2, %rdi + andnq %rax, %rcx, %r8 + xorq %rdx, %r8 + movq %r8, 160(%rsp) + andnq %rsi, %rax, %r8 + xorq %rcx, %r8 + movq %r8, 168(%rsp) + andnq %rdi, %rsi, %r8 + xorq %rax, %r8 + movq %r8, 176(%rsp) + andnq %rdx, %rdi, %rax + xorq %rsi, %rax + movq %rax, 184(%rsp) + andnq %rcx, %rdx, %rax + xorq %rdi, %rax + movq %rax, 192(%rsp) + leaq 16(%r9), %r9 + testb $-1, %r9b + jne Lkeccak_1600$10 + leaq -192(%r9), %r9 + movq 200(%rsp), %rcx + movq 448(%rsp), %rdx + movq 440(%rsp), %rax + movq %rax, %rsi + shrq $3, %rsi + movq $0, %rdi + jmp Lkeccak_1600$8 +Lkeccak_1600$9: + movq (%rsp,%rdi,8), %r8 + movq %r8, (%rcx,%rdi,8) + leaq 1(%rdi), %rdi +Lkeccak_1600$8: + cmpq %rsi, %rdi + jb Lkeccak_1600$9 + leaq (%rcx,%rax), %rcx + subq %rax, %rdx + movq %rcx, 200(%rsp) +Lkeccak_1600$6: + cmpq %rax, %rdx + jnbe Lkeccak_1600$7 + movq %rdx, 440(%rsp) +Lkeccak_1600$5: + movq (%r9), %rax + movq %rax, 448(%rsp) + movq (%rsp), %rax + movq 8(%rsp), %rcx + movq 16(%rsp), %rdx + movq 24(%rsp), %rsi + movq 32(%rsp), %rdi + xorq 40(%rsp), %rax + xorq 48(%rsp), %rcx + xorq 56(%rsp), %rdx + xorq 64(%rsp), %rsi + xorq 72(%rsp), %rdi + xorq 80(%rsp), %rax + xorq 88(%rsp), %rcx + xorq 96(%rsp), %rdx + xorq 104(%rsp), %rsi + xorq 112(%rsp), %rdi + xorq 120(%rsp), %rax + xorq 128(%rsp), %rcx + xorq 136(%rsp), %rdx + xorq 144(%rsp), %rsi + xorq 152(%rsp), %rdi + xorq 160(%rsp), %rax + xorq 168(%rsp), %rcx + xorq 176(%rsp), %rdx + xorq 184(%rsp), %rsi + xorq 192(%rsp), %rdi + movq %rcx, %r8 + rolq $1, %r8 + xorq %rdi, %r8 + movq %rdx, %r10 + rolq $1, %r10 + xorq %rax, %r10 + movq %rsi, %r11 + rolq $1, %r11 + xorq %rcx, %r11 + movq %rdi, %rcx + rolq $1, %rcx + xorq %rdx, %rcx + rolq $1, %rax + xorq %rsi, %rax + movq (%rsp), %rdx + xorq %r8, %rdx + movq 48(%rsp), %rsi + xorq %r10, %rsi + rolq $44, %rsi + movq 96(%rsp), %rdi + xorq %r11, %rdi + rolq $43, %rdi + movq 144(%rsp), %rbp + xorq %rcx, %rbp + rolq $21, %rbp + movq 192(%rsp), %rbx + xorq %rax, %rbx + rolq $14, %rbx + andnq %rdi, %rsi, %r12 + xorq 448(%rsp), %r12 + xorq %rdx, %r12 + movq %r12, 232(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 240(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 248(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 256(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 264(%rsp) + movq 24(%rsp), %rdx + xorq %rcx, %rdx + rolq $28, %rdx + movq 72(%rsp), %rsi + xorq %rax, %rsi + rolq $20, %rsi + movq 80(%rsp), %rdi + xorq %r8, %rdi + rolq $3, %rdi + movq 128(%rsp), %rbp + xorq %r10, %rbp + rolq $45, %rbp + movq 176(%rsp), %rbx + xorq %r11, %rbx + rolq $61, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 272(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 280(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 288(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 296(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 304(%rsp) + movq 8(%rsp), %rdx + xorq %r10, %rdx + rolq $1, %rdx + movq 56(%rsp), %rsi + xorq %r11, %rsi + rolq $6, %rsi + movq 104(%rsp), %rdi + xorq %rcx, %rdi + rolq $25, %rdi + movq 152(%rsp), %rbp + xorq %rax, %rbp + rolq $8, %rbp + movq 160(%rsp), %rbx + xorq %r8, %rbx + rolq $18, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 312(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 320(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 328(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 336(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 344(%rsp) + movq 32(%rsp), %rdx + xorq %rax, %rdx + rolq $27, %rdx + movq 40(%rsp), %rsi + xorq %r8, %rsi + rolq $36, %rsi + movq 88(%rsp), %rdi + xorq %r10, %rdi + rolq $10, %rdi + movq 136(%rsp), %rbp + xorq %r11, %rbp + rolq $15, %rbp + movq 184(%rsp), %rbx + xorq %rcx, %rbx + rolq $56, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 352(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 360(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 368(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 376(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 384(%rsp) + movq 16(%rsp), %rdx + xorq %r11, %rdx + rolq $62, %rdx + movq 64(%rsp), %rsi + xorq %rcx, %rsi + rolq $55, %rsi + movq %rsi, %rcx + movq 112(%rsp), %rsi + xorq %rax, %rsi + rolq $39, %rsi + movq %rsi, %rax + movq 120(%rsp), %rsi + xorq %r8, %rsi + rolq $41, %rsi + movq 168(%rsp), %rdi + xorq %r10, %rdi + rolq $2, %rdi + andnq %rax, %rcx, %r8 + xorq %rdx, %r8 + movq %r8, 392(%rsp) + andnq %rsi, %rax, %r8 + xorq %rcx, %r8 + movq %r8, 400(%rsp) + andnq %rdi, %rsi, %r8 + xorq %rax, %r8 + movq %r8, 408(%rsp) + andnq %rdx, %rdi, %rax + xorq %rsi, %rax + movq %rax, 416(%rsp) + andnq %rcx, %rdx, %rax + xorq %rdi, %rax + movq %rax, 424(%rsp) + movq 8(%r9), %rax + movq %rax, 448(%rsp) + movq 232(%rsp), %rax + movq 240(%rsp), %rcx + movq 248(%rsp), %rdx + movq 256(%rsp), %rsi + movq 264(%rsp), %rdi + xorq 272(%rsp), %rax + xorq 280(%rsp), %rcx + xorq 288(%rsp), %rdx + xorq 296(%rsp), %rsi + xorq 304(%rsp), %rdi + xorq 312(%rsp), %rax + xorq 320(%rsp), %rcx + xorq 328(%rsp), %rdx + xorq 336(%rsp), %rsi + xorq 344(%rsp), %rdi + xorq 352(%rsp), %rax + xorq 360(%rsp), %rcx + xorq 368(%rsp), %rdx + xorq 376(%rsp), %rsi + xorq 384(%rsp), %rdi + xorq 392(%rsp), %rax + xorq 400(%rsp), %rcx + xorq 408(%rsp), %rdx + xorq 416(%rsp), %rsi + xorq 424(%rsp), %rdi + movq %rcx, %r8 + rolq $1, %r8 + xorq %rdi, %r8 + movq %rdx, %r10 + rolq $1, %r10 + xorq %rax, %r10 + movq %rsi, %r11 + rolq $1, %r11 + xorq %rcx, %r11 + movq %rdi, %rcx + rolq $1, %rcx + xorq %rdx, %rcx + rolq $1, %rax + xorq %rsi, %rax + movq 232(%rsp), %rdx + xorq %r8, %rdx + movq 280(%rsp), %rsi + xorq %r10, %rsi + rolq $44, %rsi + movq 328(%rsp), %rdi + xorq %r11, %rdi + rolq $43, %rdi + movq 376(%rsp), %rbp + xorq %rcx, %rbp + rolq $21, %rbp + movq 424(%rsp), %rbx + xorq %rax, %rbx + rolq $14, %rbx + andnq %rdi, %rsi, %r12 + xorq 448(%rsp), %r12 + xorq %rdx, %r12 + movq %r12, (%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 8(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 16(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 24(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 32(%rsp) + movq 256(%rsp), %rdx + xorq %rcx, %rdx + rolq $28, %rdx + movq 304(%rsp), %rsi + xorq %rax, %rsi + rolq $20, %rsi + movq 312(%rsp), %rdi + xorq %r8, %rdi + rolq $3, %rdi + movq 360(%rsp), %rbp + xorq %r10, %rbp + rolq $45, %rbp + movq 408(%rsp), %rbx + xorq %r11, %rbx + rolq $61, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 40(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 48(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 56(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 64(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 72(%rsp) + movq 240(%rsp), %rdx + xorq %r10, %rdx + rolq $1, %rdx + movq 288(%rsp), %rsi + xorq %r11, %rsi + rolq $6, %rsi + movq 336(%rsp), %rdi + xorq %rcx, %rdi + rolq $25, %rdi + movq 384(%rsp), %rbp + xorq %rax, %rbp + rolq $8, %rbp + movq 392(%rsp), %rbx + xorq %r8, %rbx + rolq $18, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 80(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 88(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 96(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 104(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 112(%rsp) + movq 264(%rsp), %rdx + xorq %rax, %rdx + rolq $27, %rdx + movq 272(%rsp), %rsi + xorq %r8, %rsi + rolq $36, %rsi + movq 320(%rsp), %rdi + xorq %r10, %rdi + rolq $10, %rdi + movq 368(%rsp), %rbp + xorq %r11, %rbp + rolq $15, %rbp + movq 416(%rsp), %rbx + xorq %rcx, %rbx + rolq $56, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 120(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 128(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 136(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 144(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 152(%rsp) + movq 248(%rsp), %rdx + xorq %r11, %rdx + rolq $62, %rdx + movq 296(%rsp), %rsi + xorq %rcx, %rsi + rolq $55, %rsi + movq %rsi, %rcx + movq 344(%rsp), %rsi + xorq %rax, %rsi + rolq $39, %rsi + movq %rsi, %rax + movq 352(%rsp), %rsi + xorq %r8, %rsi + rolq $41, %rsi + movq 400(%rsp), %rdi + xorq %r10, %rdi + rolq $2, %rdi + andnq %rax, %rcx, %r8 + xorq %rdx, %r8 + movq %r8, 160(%rsp) + andnq %rsi, %rax, %r8 + xorq %rcx, %r8 + movq %r8, 168(%rsp) + andnq %rdi, %rsi, %r8 + xorq %rax, %r8 + movq %r8, 176(%rsp) + andnq %rdx, %rdi, %rax + xorq %rsi, %rax + movq %rax, 184(%rsp) + andnq %rcx, %rdx, %rax + xorq %rdi, %rax + movq %rax, 192(%rsp) + leaq 16(%r9), %r9 + testb $-1, %r9b + jne Lkeccak_1600$5 + movq 200(%rsp), %rax + movq 440(%rsp), %rcx + movq %rcx, %rdx + shrq $3, %rdx + movq $0, %rsi + jmp Lkeccak_1600$3 +Lkeccak_1600$4: + movq (%rsp,%rsi,8), %rdi + movq %rdi, (%rax,%rsi,8) + leaq 1(%rsi), %rsi +Lkeccak_1600$3: + cmpq %rdx, %rsi + jb Lkeccak_1600$4 + shlq $3, %rsi + jmp Lkeccak_1600$1 +Lkeccak_1600$2: + movb (%rsp,%rsi), %dl + movb %dl, (%rax,%rsi) + leaq 1(%rsi), %rsi +Lkeccak_1600$1: + cmpq %rcx, %rsi + jb Lkeccak_1600$2 + addq $456, %rsp + popq %r12 + popq %rbx + popq %rbp + ret diff --git a/code/crypto_hash/sha3384/.gitignore b/code/crypto_hash/sha3384/.gitignore new file mode 100644 index 0000000..ad1a23f --- /dev/null +++ b/code/crypto_hash/sha3384/.gitignore @@ -0,0 +1 @@ +*.japp diff --git a/code/crypto_hash/sha3384/avx2/Makefile b/code/crypto_hash/sha3384/avx2/Makefile new file mode 100644 index 0000000..3f2c256 --- /dev/null +++ b/code/crypto_hash/sha3384/avx2/Makefile @@ -0,0 +1,15 @@ +# -*- Makefile -*- + +.PHONY: default clean + +default: sha3384.japp sha3384.s + @true + +clean: + rm -f sha3384.japp sha3384.s + +%.s: %.japp + jasminc -lea -pasm $< > $@ || rm -f $@ + +%.japp: %.jazz + gpp -I../../../ -o $@ $< diff --git a/code/crypto_hash/sha3384/avx2/sha3384-m.c b/code/crypto_hash/sha3384/avx2/sha3384-m.c new file mode 100644 index 0000000..c129545 --- /dev/null +++ b/code/crypto_hash/sha3384/avx2/sha3384-m.c @@ -0,0 +1,85 @@ +#include "crypto_hash.h" +#include "impl.h" +#include "api.h" +#include +#include + + +extern void keccak_1600( + uint8_t *out, + uint64_t outlen, + const uint8_t *in, + size_t inlen, + uint64_t *c, + uint64_t **g +); + + +uint64_t rhotates_left[6*4] __attribute__((aligned(32))) = +{ + 3, 18, 36, 41, + 1, 62, 28, 27, + 45, 6, 56, 39, + 10, 61, 55, 8, + 2, 15, 25, 20, + 44, 43, 21, 14 +}; + + +uint64_t rhotates_right[6*4] __attribute__((aligned(32))) = +{ + 64-3, 64-18, 64-36, 64-41, + 64-1, 64-62, 64-28, 64-27, + 64-45, 64-6, 64-56, 64-39, + 64-10, 64-61, 64-55, 64-8, + 64-2, 64-15, 64-25, 64-20, + 64-44, 64-43, 64-21, 64-14 +}; + + +uint64_t iotas[24*4] __attribute__((aligned(32))) = +{ + 0x0000000000000001UL, 0x0000000000000001UL, 0x0000000000000001UL, 0x0000000000000001UL, + 0x0000000000008082UL, 0x0000000000008082UL, 0x0000000000008082UL, 0x0000000000008082UL, + 0x800000000000808aUL, 0x800000000000808aUL, 0x800000000000808aUL, 0x800000000000808aUL, + 0x8000000080008000UL, 0x8000000080008000UL, 0x8000000080008000UL, 0x8000000080008000UL, + 0x000000000000808bUL, 0x000000000000808bUL, 0x000000000000808bUL, 0x000000000000808bUL, + 0x0000000080000001UL, 0x0000000080000001UL, 0x0000000080000001UL, 0x0000000080000001UL, + 0x8000000080008081UL, 0x8000000080008081UL, 0x8000000080008081UL, 0x8000000080008081UL, + 0x8000000000008009UL, 0x8000000000008009UL, 0x8000000000008009UL, 0x8000000000008009UL, + 0x000000000000008aUL, 0x000000000000008aUL, 0x000000000000008aUL, 0x000000000000008aUL, + 0x0000000000000088UL, 0x0000000000000088UL, 0x0000000000000088UL, 0x0000000000000088UL, + 0x0000000080008009UL, 0x0000000080008009UL, 0x0000000080008009UL, 0x0000000080008009UL, + 0x000000008000000aUL, 0x000000008000000aUL, 0x000000008000000aUL, 0x000000008000000aUL, + 0x000000008000808bUL, 0x000000008000808bUL, 0x000000008000808bUL, 0x000000008000808bUL, + 0x800000000000008bUL, 0x800000000000008bUL, 0x800000000000008bUL, 0x800000000000008bUL, + 0x8000000000008089UL, 0x8000000000008089UL, 0x8000000000008089UL, 0x8000000000008089UL, + 0x8000000000008003UL, 0x8000000000008003UL, 0x8000000000008003UL, 0x8000000000008003UL, + 0x8000000000008002UL, 0x8000000000008002UL, 0x8000000000008002UL, 0x8000000000008002UL, + 0x8000000000000080UL, 0x8000000000000080UL, 0x8000000000000080UL, 0x8000000000000080UL, + 0x000000000000800aUL, 0x000000000000800aUL, 0x000000000000800aUL, 0x000000000000800aUL, + 0x800000008000000aUL, 0x800000008000000aUL, 0x800000008000000aUL, 0x800000008000000aUL, + 0x8000000080008081UL, 0x8000000080008081UL, 0x8000000080008081UL, 0x8000000080008081UL, + 0x8000000000008080UL, 0x8000000000008080UL, 0x8000000000008080UL, 0x8000000000008080UL, + 0x0000000080000001UL, 0x0000000080000001UL, 0x0000000080000001UL, 0x0000000080000001UL, + 0x8000000080008008UL, 0x8000000080008008UL, 0x8000000080008008UL, 0x8000000080008008UL +}; + + +uint64_t a_jagged[25] __attribute__((aligned(32))) = +{ + 0, 4, 5, 6, 7, + 10, 24, 13, 18, 23, + 8, 16, 25, 22, 15, + 11, 12, 21, 26, 19, + 9, 20, 17, 14, 27 +}; + + +int sha3384_avx2(unsigned char *out,const unsigned char *in,unsigned long long inlen) +{ + uint64_t *g[] = {rhotates_left, rhotates_right, iotas, a_jagged}; + uint64_t c[] = {0x06, (832/8)}; + keccak_1600(out, 48, in, inlen, c, g); + return 0; +} diff --git a/code/crypto_hash/sha3384/avx2/sha3384.jazz b/code/crypto_hash/sha3384/avx2/sha3384.jazz new file mode 100644 index 0000000..b1a0a86 --- /dev/null +++ b/code/crypto_hash/sha3384/avx2/sha3384.jazz @@ -0,0 +1,61 @@ +#define KECCAK_1600_ADD_FULL_BLOCK_IMPLEMENTATION 1 + +u64 s_zero = 0; + +fn add_full_block( + reg u256[7] state, + stack u64[28] s_state, + reg u64 a_jagged, + reg u64 in inlen, + reg u64 rate +) -> reg u256[7], stack u64[28], reg u64, reg u64 +{ + reg u128 a21_u128; + reg u256 a00, a01, a11, a21; + reg u256 t11 t41 t31 t21; + reg u256 zero; + reg u64 r10 r20; + stack u64[4] s20; + + r10 = [in + 8*5]; + r20 = [in + 8*10]; + + s20[0] = r20; + s20[1] = 0; + s20[2] = r10; + s20[3] = 0; + + a00 = #x86_VPBROADCAST_4u64([in + 8*0]); // (0,0) (0,0) (0,0) (0,0) + a01 = (u256)[in + 8*1]; // (0,4) (0,3) (0,2) (0,1) + + state[0] ^= a00; + state[1] ^= a01; + state[2] ^= s20[u256 0]; + + zero = #x86_VPBROADCAST_4u64(s_zero); + + a11 = (u256)[in + 8*6 ]; // (1,4) (1,3) (1,2) (1,1) + + a21 = #x86_VPBROADCAST_2u128((u128)[in + 8*11]); // (2,2) (2,1) (2,2) (2,1) + a21 = #x86_VPBLENDD_256(a21, zero, (8u1)[1,1,1,1,0,0,0,0]); // ___ ___ (2,2) (2,1) + + t31 = #x86_VPBLENDD_256(a11, zero, (8u1)[1,1,1,1,0,0,1,1]); // ___ ___ (1,2) ___ + + t21 = #x86_VPBLENDD_256(a11, a21, (8u1)[0,0,0,0,0,0,1,1]); // (1,4) (1,3) (1,2) (2,1) + t21 = #x86_VPBLENDD_256(t21, zero, (8u1)[1,1,0,0,1,1,0,0]); // ___ (1,3) ___ (2,1) + + t41 = #x86_VPBLENDD_256(a11, zero, (8u1)[0,0,1,1,1,1,1,1]); // (1,4) ___ ___ ___ + t11 = #x86_VPBLENDD_256(a11, a21, (8u1)[1,1,1,1,1,1,0,0]); // ___ ___ (2,2) (1,1) + + state[3] ^= t31; + state[4] ^= t21; + state[5] ^= t41; + state[6] ^= t11; + + in += rate; + inlen -= rate; + + return state, s_state, in, inlen; +} + +#include "crypto_hash/keccak1600/avx2/keccak_1600.jazz" diff --git a/code/crypto_hash/sha3384/avx2/sha3384.s b/code/crypto_hash/sha3384/avx2/sha3384.s new file mode 100644 index 0000000..07efe7a --- /dev/null +++ b/code/crypto_hash/sha3384/avx2/sha3384.s @@ -0,0 +1,528 @@ + .text + .p2align 5 + .globl _keccak_1600 + .globl keccak_1600 +_keccak_1600: +keccak_1600: + pushq %rbp + pushq %rbx + pushq %r12 + pushq %r13 + pushq %r14 + subq $256, %rsp + movb (%r8), %al + movq 8(%r8), %r8 + movq (%r9), %r10 + movq 8(%r9), %r11 + movq 16(%r9), %rbp + movq 24(%r9), %r9 + vpbroadcastq g_zero(%rip), %ymm2 + vmovdqu %ymm2, %ymm3 + vmovdqu %ymm2, %ymm4 + vmovdqu %ymm2, %ymm8 + vmovdqu %ymm2, %ymm9 + vmovdqu %ymm2, %ymm10 + vmovdqu %ymm2, %ymm11 + jmp Lkeccak_1600$15 +Lkeccak_1600$16: + movq 40(%rdx), %rbx + movq 80(%rdx), %r12 + movq %r12, 224(%rsp) + movq $0, 232(%rsp) + movq %rbx, 240(%rsp) + movq $0, 248(%rsp) + vpbroadcastq (%rdx), %ymm0 + vmovdqu 8(%rdx), %ymm1 + vpxor %ymm0, %ymm2, %ymm2 + vpxor %ymm1, %ymm3, %ymm3 + vpxor 224(%rsp), %ymm4, %ymm4 + vpbroadcastq s_zero(%rip), %ymm0 + vmovdqu 48(%rdx), %ymm1 + vbroadcasti128 88(%rdx), %ymm5 + vpblendd $-16, %ymm0, %ymm5, %ymm5 + vpblendd $-13, %ymm0, %ymm1, %ymm6 + vpblendd $3, %ymm5, %ymm1, %ymm7 + vpblendd $-52, %ymm0, %ymm7, %ymm7 + vpblendd $63, %ymm0, %ymm1, %ymm0 + vpblendd $-4, %ymm5, %ymm1, %ymm1 + vpxor %ymm6, %ymm8, %ymm8 + vpxor %ymm7, %ymm9, %ymm9 + vpxor %ymm0, %ymm10, %ymm10 + vpxor %ymm1, %ymm11, %ymm11 + leaq (%rdx,%r8), %rdx + subq %r8, %rcx + leaq 96(%r10), %rbx + leaq 96(%r11), %r12 + movq %rbp, %r13 + movl $24, %r14d + .p2align 5 +Lkeccak_1600$17: + vpshufd $78, %ymm4, %ymm0 + vpxor %ymm8, %ymm10, %ymm1 + vpxor %ymm11, %ymm9, %ymm5 + vpxor %ymm3, %ymm1, %ymm1 + vpxor %ymm5, %ymm1, %ymm1 + vpermq $-109, %ymm1, %ymm5 + vpxor %ymm4, %ymm0, %ymm0 + vpermq $78, %ymm0, %ymm6 + vpsrlq $63, %ymm1, %ymm7 + vpaddq %ymm1, %ymm1, %ymm1 + vpor %ymm1, %ymm7, %ymm1 + vpermq $57, %ymm1, %ymm7 + vpxor %ymm5, %ymm1, %ymm1 + vpermq $0, %ymm1, %ymm1 + vpxor %ymm2, %ymm0, %ymm0 + vpxor %ymm6, %ymm0, %ymm0 + vpsrlq $63, %ymm0, %ymm6 + vpaddq %ymm0, %ymm0, %ymm12 + vpor %ymm6, %ymm12, %ymm6 + vpxor %ymm1, %ymm4, %ymm4 + vpxor %ymm1, %ymm2, %ymm1 + vpblendd $-64, %ymm6, %ymm7, %ymm2 + vpblendd $3, %ymm0, %ymm5, %ymm0 + vpxor %ymm0, %ymm2, %ymm0 + vpsllvq -96(%rbx), %ymm4, %ymm2 + vpsrlvq -96(%r12), %ymm4, %ymm4 + vpor %ymm2, %ymm4, %ymm2 + vpxor %ymm0, %ymm8, %ymm4 + vpsllvq -32(%rbx), %ymm4, %ymm5 + vpsrlvq -32(%r12), %ymm4, %ymm4 + vpor %ymm5, %ymm4, %ymm4 + vpxor %ymm0, %ymm9, %ymm5 + vpsllvq (%rbx), %ymm5, %ymm6 + vpsrlvq (%r12), %ymm5, %ymm5 + vpor %ymm6, %ymm5, %ymm5 + vpxor %ymm0, %ymm10, %ymm6 + vpsllvq 32(%rbx), %ymm6, %ymm7 + vpsrlvq 32(%r12), %ymm6, %ymm6 + vpor %ymm7, %ymm6, %ymm6 + vpxor %ymm0, %ymm11, %ymm7 + vpermq $-115, %ymm2, %ymm2 + vpermq $-115, %ymm4, %ymm9 + vpsllvq 64(%rbx), %ymm7, %ymm4 + vpsrlvq 64(%r12), %ymm7, %ymm7 + vpor %ymm4, %ymm7, %ymm7 + vpxor %ymm0, %ymm3, %ymm0 + vpermq $27, %ymm5, %ymm3 + vpermq $114, %ymm6, %ymm5 + vpsllvq -64(%rbx), %ymm0, %ymm4 + vpsrlvq -64(%r12), %ymm0, %ymm0 + vpor %ymm4, %ymm0, %ymm0 + vpsrldq $8, %ymm7, %ymm4 + vpandn %ymm4, %ymm7, %ymm6 + vpblendd $12, %ymm5, %ymm0, %ymm4 + vpblendd $12, %ymm0, %ymm9, %ymm8 + vpblendd $12, %ymm9, %ymm2, %ymm10 + vpblendd $12, %ymm2, %ymm0, %ymm11 + vpblendd $48, %ymm9, %ymm4, %ymm4 + vpblendd $48, %ymm3, %ymm8, %ymm8 + vpblendd $48, %ymm0, %ymm10, %ymm10 + vpblendd $48, %ymm5, %ymm11, %ymm11 + vpblendd $-64, %ymm3, %ymm4, %ymm4 + vpblendd $-64, %ymm5, %ymm8, %ymm8 + vpblendd $-64, %ymm5, %ymm10, %ymm10 + vpblendd $-64, %ymm9, %ymm11, %ymm11 + vpandn %ymm8, %ymm4, %ymm4 + vpandn %ymm11, %ymm10, %ymm8 + vpblendd $12, %ymm0, %ymm3, %ymm10 + vpblendd $12, %ymm3, %ymm2, %ymm11 + vpxor %ymm2, %ymm4, %ymm12 + vpblendd $48, %ymm2, %ymm10, %ymm4 + vpblendd $48, %ymm9, %ymm11, %ymm10 + vpxor %ymm3, %ymm8, %ymm11 + vpblendd $-64, %ymm9, %ymm4, %ymm4 + vpblendd $-64, %ymm0, %ymm10, %ymm8 + vpandn %ymm8, %ymm4, %ymm4 + vpxor %ymm5, %ymm4, %ymm13 + vpermq $30, %ymm7, %ymm4 + vpblendd $48, %ymm1, %ymm4, %ymm4 + vpermq $57, %ymm7, %ymm8 + vpblendd $-64, %ymm1, %ymm8, %ymm8 + vpandn %ymm4, %ymm8, %ymm14 + vpblendd $12, %ymm3, %ymm9, %ymm4 + vpblendd $12, %ymm9, %ymm5, %ymm8 + vpblendd $48, %ymm5, %ymm4, %ymm4 + vpblendd $48, %ymm2, %ymm8, %ymm8 + vpblendd $-64, %ymm2, %ymm4, %ymm4 + vpblendd $-64, %ymm3, %ymm8, %ymm8 + vpandn %ymm8, %ymm4, %ymm4 + vpxor %ymm0, %ymm4, %ymm4 + vpermq $0, %ymm6, %ymm6 + vpermq $27, %ymm12, %ymm8 + vpermq $-115, %ymm11, %ymm10 + vpermq $114, %ymm13, %ymm11 + vpblendd $12, %ymm2, %ymm5, %ymm12 + vpblendd $12, %ymm5, %ymm3, %ymm5 + vpblendd $48, %ymm3, %ymm12, %ymm3 + vpblendd $48, %ymm0, %ymm5, %ymm5 + vpblendd $-64, %ymm0, %ymm3, %ymm0 + vpblendd $-64, %ymm2, %ymm5, %ymm2 + vpandn %ymm2, %ymm0, %ymm0 + vpxor %ymm6, %ymm1, %ymm1 + vpxor %ymm7, %ymm14, %ymm3 + vpxor %ymm9, %ymm0, %ymm9 + vpxor (%r13), %ymm1, %ymm2 + leaq 32(%r13), %r13 + decl %r14d + jne Lkeccak_1600$17 +Lkeccak_1600$15: + cmpq %r8, %rcx + jnb Lkeccak_1600$16 + vpbroadcastq g_zero(%rip), %ymm0 + vmovdqu %ymm0, (%rsp) + vmovdqu %ymm0, 32(%rsp) + vmovdqu %ymm0, 64(%rsp) + vmovdqu %ymm0, 96(%rsp) + vmovdqu %ymm0, 128(%rsp) + vmovdqu %ymm0, 160(%rsp) + vmovdqu %ymm0, 192(%rsp) + movq %rcx, %rbx + shrq $3, %rbx + movq $0, %r12 + jmp Lkeccak_1600$13 +Lkeccak_1600$14: + movq (%rdx,%r12,8), %r13 + movq (%r9,%r12,8), %r14 + movq %r13, (%rsp,%r14,8) + leaq 1(%r12), %r12 +Lkeccak_1600$13: + cmpq %rbx, %r12 + jb Lkeccak_1600$14 + movq (%r9,%r12,8), %rbx + shlq $3, %rbx + shlq $3, %r12 + jmp Lkeccak_1600$11 +Lkeccak_1600$12: + movb (%rdx,%r12), %r13b + movb %r13b, (%rsp,%rbx) + leaq 1(%r12), %r12 + leaq 1(%rbx), %rbx +Lkeccak_1600$11: + cmpq %rcx, %r12 + jb Lkeccak_1600$12 + movb %al, (%rsp,%rbx) + movq %r8, %rax + leaq -1(%rax), %rax + shrq $3, %rax + movq (%r9,%rax,8), %rax + shlq $3, %rax + movq %r8, %rcx + leaq -1(%rcx), %rcx + andq $7, %rcx + leaq (%rax,%rcx), %rax + xorb $-128, (%rsp,%rax) + movq (%rsp), %rax + movq %rax, 8(%rsp) + movq %rax, 16(%rsp) + movq %rax, 24(%rsp) + vpxor (%rsp), %ymm2, %ymm0 + vpxor 32(%rsp), %ymm3, %ymm1 + vpxor 64(%rsp), %ymm4, %ymm2 + vpxor 96(%rsp), %ymm8, %ymm3 + vpxor 128(%rsp), %ymm9, %ymm4 + vpxor 160(%rsp), %ymm10, %ymm5 + vpxor 192(%rsp), %ymm11, %ymm6 + jmp Lkeccak_1600$6 +Lkeccak_1600$7: + leaq 96(%r10), %rax + leaq 96(%r11), %rcx + movq %rbp, %rdx + movl $24, %ebx + .p2align 5 +Lkeccak_1600$10: + vpshufd $78, %ymm2, %ymm7 + vpxor %ymm3, %ymm5, %ymm8 + vpxor %ymm6, %ymm4, %ymm9 + vpxor %ymm1, %ymm8, %ymm8 + vpxor %ymm9, %ymm8, %ymm8 + vpermq $-109, %ymm8, %ymm9 + vpxor %ymm2, %ymm7, %ymm7 + vpermq $78, %ymm7, %ymm10 + vpsrlq $63, %ymm8, %ymm11 + vpaddq %ymm8, %ymm8, %ymm8 + vpor %ymm8, %ymm11, %ymm8 + vpermq $57, %ymm8, %ymm11 + vpxor %ymm9, %ymm8, %ymm8 + vpermq $0, %ymm8, %ymm8 + vpxor %ymm0, %ymm7, %ymm7 + vpxor %ymm10, %ymm7, %ymm7 + vpsrlq $63, %ymm7, %ymm10 + vpaddq %ymm7, %ymm7, %ymm12 + vpor %ymm10, %ymm12, %ymm10 + vpxor %ymm8, %ymm2, %ymm2 + vpxor %ymm8, %ymm0, %ymm0 + vpblendd $-64, %ymm10, %ymm11, %ymm8 + vpblendd $3, %ymm7, %ymm9, %ymm7 + vpxor %ymm7, %ymm8, %ymm7 + vpsllvq -96(%rax), %ymm2, %ymm8 + vpsrlvq -96(%rcx), %ymm2, %ymm2 + vpor %ymm8, %ymm2, %ymm2 + vpxor %ymm7, %ymm3, %ymm3 + vpsllvq -32(%rax), %ymm3, %ymm8 + vpsrlvq -32(%rcx), %ymm3, %ymm3 + vpor %ymm8, %ymm3, %ymm3 + vpxor %ymm7, %ymm4, %ymm4 + vpsllvq (%rax), %ymm4, %ymm8 + vpsrlvq (%rcx), %ymm4, %ymm4 + vpor %ymm8, %ymm4, %ymm4 + vpxor %ymm7, %ymm5, %ymm5 + vpsllvq 32(%rax), %ymm5, %ymm8 + vpsrlvq 32(%rcx), %ymm5, %ymm5 + vpor %ymm8, %ymm5, %ymm5 + vpxor %ymm7, %ymm6, %ymm6 + vpermq $-115, %ymm2, %ymm8 + vpermq $-115, %ymm3, %ymm9 + vpsllvq 64(%rax), %ymm6, %ymm2 + vpsrlvq 64(%rcx), %ymm6, %ymm3 + vpor %ymm2, %ymm3, %ymm10 + vpxor %ymm7, %ymm1, %ymm1 + vpermq $27, %ymm4, %ymm4 + vpermq $114, %ymm5, %ymm7 + vpsllvq -64(%rax), %ymm1, %ymm2 + vpsrlvq -64(%rcx), %ymm1, %ymm1 + vpor %ymm2, %ymm1, %ymm1 + vpsrldq $8, %ymm10, %ymm2 + vpandn %ymm2, %ymm10, %ymm3 + vpblendd $12, %ymm7, %ymm1, %ymm2 + vpblendd $12, %ymm1, %ymm9, %ymm5 + vpblendd $12, %ymm9, %ymm8, %ymm6 + vpblendd $12, %ymm8, %ymm1, %ymm11 + vpblendd $48, %ymm9, %ymm2, %ymm2 + vpblendd $48, %ymm4, %ymm5, %ymm5 + vpblendd $48, %ymm1, %ymm6, %ymm6 + vpblendd $48, %ymm7, %ymm11, %ymm11 + vpblendd $-64, %ymm4, %ymm2, %ymm2 + vpblendd $-64, %ymm7, %ymm5, %ymm5 + vpblendd $-64, %ymm7, %ymm6, %ymm6 + vpblendd $-64, %ymm9, %ymm11, %ymm11 + vpandn %ymm5, %ymm2, %ymm2 + vpandn %ymm11, %ymm6, %ymm5 + vpblendd $12, %ymm1, %ymm4, %ymm6 + vpblendd $12, %ymm4, %ymm8, %ymm11 + vpxor %ymm8, %ymm2, %ymm12 + vpblendd $48, %ymm8, %ymm6, %ymm2 + vpblendd $48, %ymm9, %ymm11, %ymm6 + vpxor %ymm4, %ymm5, %ymm5 + vpblendd $-64, %ymm9, %ymm2, %ymm2 + vpblendd $-64, %ymm1, %ymm6, %ymm6 + vpandn %ymm6, %ymm2, %ymm2 + vpxor %ymm7, %ymm2, %ymm6 + vpermq $30, %ymm10, %ymm2 + vpblendd $48, %ymm0, %ymm2, %ymm2 + vpermq $57, %ymm10, %ymm11 + vpblendd $-64, %ymm0, %ymm11, %ymm11 + vpandn %ymm2, %ymm11, %ymm11 + vpblendd $12, %ymm4, %ymm9, %ymm2 + vpblendd $12, %ymm9, %ymm7, %ymm13 + vpblendd $48, %ymm7, %ymm2, %ymm2 + vpblendd $48, %ymm8, %ymm13, %ymm13 + vpblendd $-64, %ymm8, %ymm2, %ymm2 + vpblendd $-64, %ymm4, %ymm13, %ymm13 + vpandn %ymm13, %ymm2, %ymm2 + vpxor %ymm1, %ymm2, %ymm2 + vpermq $0, %ymm3, %ymm13 + vpermq $27, %ymm12, %ymm3 + vpermq $-115, %ymm5, %ymm5 + vpermq $114, %ymm6, %ymm6 + vpblendd $12, %ymm8, %ymm7, %ymm12 + vpblendd $12, %ymm7, %ymm4, %ymm7 + vpblendd $48, %ymm4, %ymm12, %ymm4 + vpblendd $48, %ymm1, %ymm7, %ymm7 + vpblendd $-64, %ymm1, %ymm4, %ymm1 + vpblendd $-64, %ymm8, %ymm7, %ymm4 + vpandn %ymm4, %ymm1, %ymm4 + vpxor %ymm13, %ymm0, %ymm0 + vpxor %ymm10, %ymm11, %ymm1 + vpxor %ymm9, %ymm4, %ymm4 + vpxor (%rdx), %ymm0, %ymm0 + leaq 32(%rdx), %rdx + decl %ebx + jne Lkeccak_1600$10 + vmovdqu %ymm0, (%rsp) + vmovdqu %ymm1, 32(%rsp) + vmovdqu %ymm2, 64(%rsp) + vmovdqu %ymm3, 96(%rsp) + vmovdqu %ymm4, 128(%rsp) + vmovdqu %ymm5, 160(%rsp) + vmovdqu %ymm6, 192(%rsp) + movq %r8, %rax + shrq $3, %rax + movq $0, %rcx + jmp Lkeccak_1600$8 +Lkeccak_1600$9: + movq (%r9,%rcx,8), %rdx + movq (%rsp,%rdx,8), %rdx + movq %rdx, (%rdi,%rcx,8) + leaq 1(%rcx), %rcx +Lkeccak_1600$8: + cmpq %rax, %rcx + jb Lkeccak_1600$9 + leaq (%rdi,%r8), %rdi + subq %r8, %rsi +Lkeccak_1600$6: + cmpq %r8, %rsi + jnbe Lkeccak_1600$7 + leaq 96(%r10), %rax + leaq 96(%r11), %rcx + movl $24, %edx + .p2align 5 +Lkeccak_1600$5: + vpshufd $78, %ymm2, %ymm7 + vpxor %ymm3, %ymm5, %ymm8 + vpxor %ymm6, %ymm4, %ymm9 + vpxor %ymm1, %ymm8, %ymm8 + vpxor %ymm9, %ymm8, %ymm8 + vpermq $-109, %ymm8, %ymm9 + vpxor %ymm2, %ymm7, %ymm7 + vpermq $78, %ymm7, %ymm10 + vpsrlq $63, %ymm8, %ymm11 + vpaddq %ymm8, %ymm8, %ymm8 + vpor %ymm8, %ymm11, %ymm8 + vpermq $57, %ymm8, %ymm11 + vpxor %ymm9, %ymm8, %ymm8 + vpermq $0, %ymm8, %ymm8 + vpxor %ymm0, %ymm7, %ymm7 + vpxor %ymm10, %ymm7, %ymm7 + vpsrlq $63, %ymm7, %ymm10 + vpaddq %ymm7, %ymm7, %ymm12 + vpor %ymm10, %ymm12, %ymm10 + vpxor %ymm8, %ymm2, %ymm2 + vpxor %ymm8, %ymm0, %ymm0 + vpblendd $-64, %ymm10, %ymm11, %ymm8 + vpblendd $3, %ymm7, %ymm9, %ymm7 + vpxor %ymm7, %ymm8, %ymm7 + vpsllvq -96(%rax), %ymm2, %ymm8 + vpsrlvq -96(%rcx), %ymm2, %ymm2 + vpor %ymm8, %ymm2, %ymm2 + vpxor %ymm7, %ymm3, %ymm3 + vpsllvq -32(%rax), %ymm3, %ymm8 + vpsrlvq -32(%rcx), %ymm3, %ymm3 + vpor %ymm8, %ymm3, %ymm3 + vpxor %ymm7, %ymm4, %ymm4 + vpsllvq (%rax), %ymm4, %ymm8 + vpsrlvq (%rcx), %ymm4, %ymm4 + vpor %ymm8, %ymm4, %ymm4 + vpxor %ymm7, %ymm5, %ymm5 + vpsllvq 32(%rax), %ymm5, %ymm8 + vpsrlvq 32(%rcx), %ymm5, %ymm5 + vpor %ymm8, %ymm5, %ymm5 + vpxor %ymm7, %ymm6, %ymm6 + vpermq $-115, %ymm2, %ymm8 + vpermq $-115, %ymm3, %ymm9 + vpsllvq 64(%rax), %ymm6, %ymm2 + vpsrlvq 64(%rcx), %ymm6, %ymm3 + vpor %ymm2, %ymm3, %ymm10 + vpxor %ymm7, %ymm1, %ymm1 + vpermq $27, %ymm4, %ymm4 + vpermq $114, %ymm5, %ymm7 + vpsllvq -64(%rax), %ymm1, %ymm2 + vpsrlvq -64(%rcx), %ymm1, %ymm1 + vpor %ymm2, %ymm1, %ymm1 + vpsrldq $8, %ymm10, %ymm2 + vpandn %ymm2, %ymm10, %ymm3 + vpblendd $12, %ymm7, %ymm1, %ymm2 + vpblendd $12, %ymm1, %ymm9, %ymm5 + vpblendd $12, %ymm9, %ymm8, %ymm6 + vpblendd $12, %ymm8, %ymm1, %ymm11 + vpblendd $48, %ymm9, %ymm2, %ymm2 + vpblendd $48, %ymm4, %ymm5, %ymm5 + vpblendd $48, %ymm1, %ymm6, %ymm6 + vpblendd $48, %ymm7, %ymm11, %ymm11 + vpblendd $-64, %ymm4, %ymm2, %ymm2 + vpblendd $-64, %ymm7, %ymm5, %ymm5 + vpblendd $-64, %ymm7, %ymm6, %ymm6 + vpblendd $-64, %ymm9, %ymm11, %ymm11 + vpandn %ymm5, %ymm2, %ymm2 + vpandn %ymm11, %ymm6, %ymm5 + vpblendd $12, %ymm1, %ymm4, %ymm6 + vpblendd $12, %ymm4, %ymm8, %ymm11 + vpxor %ymm8, %ymm2, %ymm12 + vpblendd $48, %ymm8, %ymm6, %ymm2 + vpblendd $48, %ymm9, %ymm11, %ymm6 + vpxor %ymm4, %ymm5, %ymm5 + vpblendd $-64, %ymm9, %ymm2, %ymm2 + vpblendd $-64, %ymm1, %ymm6, %ymm6 + vpandn %ymm6, %ymm2, %ymm2 + vpxor %ymm7, %ymm2, %ymm6 + vpermq $30, %ymm10, %ymm2 + vpblendd $48, %ymm0, %ymm2, %ymm2 + vpermq $57, %ymm10, %ymm11 + vpblendd $-64, %ymm0, %ymm11, %ymm11 + vpandn %ymm2, %ymm11, %ymm11 + vpblendd $12, %ymm4, %ymm9, %ymm2 + vpblendd $12, %ymm9, %ymm7, %ymm13 + vpblendd $48, %ymm7, %ymm2, %ymm2 + vpblendd $48, %ymm8, %ymm13, %ymm13 + vpblendd $-64, %ymm8, %ymm2, %ymm2 + vpblendd $-64, %ymm4, %ymm13, %ymm13 + vpandn %ymm13, %ymm2, %ymm2 + vpxor %ymm1, %ymm2, %ymm2 + vpermq $0, %ymm3, %ymm13 + vpermq $27, %ymm12, %ymm3 + vpermq $-115, %ymm5, %ymm5 + vpermq $114, %ymm6, %ymm6 + vpblendd $12, %ymm8, %ymm7, %ymm12 + vpblendd $12, %ymm7, %ymm4, %ymm7 + vpblendd $48, %ymm4, %ymm12, %ymm4 + vpblendd $48, %ymm1, %ymm7, %ymm7 + vpblendd $-64, %ymm1, %ymm4, %ymm1 + vpblendd $-64, %ymm8, %ymm7, %ymm4 + vpandn %ymm4, %ymm1, %ymm4 + vpxor %ymm13, %ymm0, %ymm0 + vpxor %ymm10, %ymm11, %ymm1 + vpxor %ymm9, %ymm4, %ymm4 + vpxor (%rbp), %ymm0, %ymm0 + leaq 32(%rbp), %rbp + decl %edx + jne Lkeccak_1600$5 + vmovdqu %ymm0, (%rsp) + vmovdqu %ymm1, 32(%rsp) + vmovdqu %ymm2, 64(%rsp) + vmovdqu %ymm3, 96(%rsp) + vmovdqu %ymm4, 128(%rsp) + vmovdqu %ymm5, 160(%rsp) + vmovdqu %ymm6, 192(%rsp) + movq %rsi, %rax + shrq $3, %rax + movq $0, %rcx + jmp Lkeccak_1600$3 +Lkeccak_1600$4: + movq (%r9,%rcx,8), %rdx + movq (%rsp,%rdx,8), %rdx + movq %rdx, (%rdi,%rcx,8) + leaq 1(%rcx), %rcx +Lkeccak_1600$3: + cmpq %rax, %rcx + jb Lkeccak_1600$4 + movq (%r9,%rcx,8), %rax + shlq $3, %rcx + shlq $3, %rax + jmp Lkeccak_1600$1 +Lkeccak_1600$2: + movb (%rsp,%rax), %dl + movb %dl, (%rdi,%rcx) + leaq 1(%rcx), %rcx + leaq 1(%rax), %rax +Lkeccak_1600$1: + cmpq %rsi, %rcx + jb Lkeccak_1600$2 + addq $256, %rsp + popq %r14 + popq %r13 + popq %r12 + popq %rbx + popq %rbp + ret + .data + .globl _g_zero + .globl g_zero + .p2align 3 +_g_zero: +g_zero: + .quad 0 + .globl _s_zero + .globl s_zero + .p2align 3 +_s_zero: +s_zero: + .quad 0 diff --git a/code/crypto_hash/sha3384/scalar/Makefile b/code/crypto_hash/sha3384/scalar/Makefile new file mode 100644 index 0000000..3f2c256 --- /dev/null +++ b/code/crypto_hash/sha3384/scalar/Makefile @@ -0,0 +1,15 @@ +# -*- Makefile -*- + +.PHONY: default clean + +default: sha3384.japp sha3384.s + @true + +clean: + rm -f sha3384.japp sha3384.s + +%.s: %.japp + jasminc -lea -pasm $< > $@ || rm -f $@ + +%.japp: %.jazz + gpp -I../../../ -o $@ $< diff --git a/code/crypto_hash/sha3384/scalar/sha3384-m.c b/code/crypto_hash/sha3384/scalar/sha3384-m.c new file mode 100644 index 0000000..873d797 --- /dev/null +++ b/code/crypto_hash/sha3384/scalar/sha3384-m.c @@ -0,0 +1,54 @@ +#include "crypto_hash.h" +#include "impl.h" +#include "api.h" +#include +#include + + +extern void keccak_1600( + uint8_t *out, + uint64_t outlen, + const uint8_t *in, + size_t inlen, + uint64_t *c, + uint64_t *iotas +); + + +uint64_t iotas[32] __attribute__((aligned(256))) = +{ + 0,0,0,0,0,0,0, 0 + , 0x0000000000000001 + , 0x0000000000008082 + , 0x800000000000808a + , 0x8000000080008000 + , 0x000000000000808b + , 0x0000000080000001 + , 0x8000000080008081 + , 0x8000000000008009 + , 0x000000000000008a + , 0x0000000000000088 + , 0x0000000080008009 + , 0x000000008000000a + , 0x000000008000808b + , 0x800000000000008b + , 0x8000000000008089 + , 0x8000000000008003 + , 0x8000000000008002 + , 0x8000000000000080 + , 0x000000000000800a + , 0x800000008000000a + , 0x8000000080008081 + , 0x8000000000008080 + , 0x0000000080000001 + , 0x8000000080008008 +}; + + +int sha3384_scalar(unsigned char *out,const unsigned char *in,unsigned long long inlen) +{ + uint64_t c[] = {0x06, (832/8)}; + keccak_1600(out, 48, in, inlen, c, &(iotas[8])); + return 0; +} + diff --git a/code/crypto_hash/sha3384/scalar/sha3384.jazz b/code/crypto_hash/sha3384/scalar/sha3384.jazz new file mode 100644 index 0000000..d2fa40e --- /dev/null +++ b/code/crypto_hash/sha3384/scalar/sha3384.jazz @@ -0,0 +1 @@ +#include "crypto_hash/keccak1600/scalar/keccak_1600.jazz" diff --git a/code/crypto_hash/sha3384/scalar/sha3384.s b/code/crypto_hash/sha3384/scalar/sha3384.s new file mode 100644 index 0000000..f79b7d1 --- /dev/null +++ b/code/crypto_hash/sha3384/scalar/sha3384.s @@ -0,0 +1,1299 @@ + .text + .p2align 5 + .globl _keccak_1600 + .globl keccak_1600 +_keccak_1600: +keccak_1600: + pushq %rbp + pushq %rbx + pushq %r12 + subq $456, %rsp + movq %rdi, 200(%rsp) + movq %rsi, 448(%rsp) + movzbq (%r8), %rax + movq %rax, 440(%rsp) + movq 8(%r8), %rax + xorl %esi, %esi + movq $0, %rdi + jmp Lkeccak_1600$20 +Lkeccak_1600$21: + movq %rsi, (%rsp,%rdi,8) + leaq 1(%rdi), %rdi +Lkeccak_1600$20: + cmpq $25, %rdi + jb Lkeccak_1600$21 + jmp Lkeccak_1600$15 +Lkeccak_1600$16: + movq %rax, %rsi + shrq $3, %rsi + movq $0, %rdi + jmp Lkeccak_1600$18 +Lkeccak_1600$19: + movq (%rdx,%rdi,8), %r8 + xorq %r8, (%rsp,%rdi,8) + leaq 1(%rdi), %rdi +Lkeccak_1600$18: + cmpq %rsi, %rdi + jb Lkeccak_1600$19 + leaq (%rdx,%rax), %rdx + subq %rax, %rcx + movq %rdx, 224(%rsp) + movq %rcx, 216(%rsp) + movq %rax, 208(%rsp) +Lkeccak_1600$17: + movq (%r9), %rax + movq %rax, 432(%rsp) + movq (%rsp), %rax + movq 8(%rsp), %rcx + movq 16(%rsp), %rdx + movq 24(%rsp), %rsi + movq 32(%rsp), %rdi + xorq 40(%rsp), %rax + xorq 48(%rsp), %rcx + xorq 56(%rsp), %rdx + xorq 64(%rsp), %rsi + xorq 72(%rsp), %rdi + xorq 80(%rsp), %rax + xorq 88(%rsp), %rcx + xorq 96(%rsp), %rdx + xorq 104(%rsp), %rsi + xorq 112(%rsp), %rdi + xorq 120(%rsp), %rax + xorq 128(%rsp), %rcx + xorq 136(%rsp), %rdx + xorq 144(%rsp), %rsi + xorq 152(%rsp), %rdi + xorq 160(%rsp), %rax + xorq 168(%rsp), %rcx + xorq 176(%rsp), %rdx + xorq 184(%rsp), %rsi + xorq 192(%rsp), %rdi + movq %rcx, %r8 + rolq $1, %r8 + xorq %rdi, %r8 + movq %rdx, %r10 + rolq $1, %r10 + xorq %rax, %r10 + movq %rsi, %r11 + rolq $1, %r11 + xorq %rcx, %r11 + movq %rdi, %rcx + rolq $1, %rcx + xorq %rdx, %rcx + rolq $1, %rax + xorq %rsi, %rax + movq (%rsp), %rdx + xorq %r8, %rdx + movq 48(%rsp), %rsi + xorq %r10, %rsi + rolq $44, %rsi + movq 96(%rsp), %rdi + xorq %r11, %rdi + rolq $43, %rdi + movq 144(%rsp), %rbp + xorq %rcx, %rbp + rolq $21, %rbp + movq 192(%rsp), %rbx + xorq %rax, %rbx + rolq $14, %rbx + andnq %rdi, %rsi, %r12 + xorq 432(%rsp), %r12 + xorq %rdx, %r12 + movq %r12, 232(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 240(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 248(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 256(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 264(%rsp) + movq 24(%rsp), %rdx + xorq %rcx, %rdx + rolq $28, %rdx + movq 72(%rsp), %rsi + xorq %rax, %rsi + rolq $20, %rsi + movq 80(%rsp), %rdi + xorq %r8, %rdi + rolq $3, %rdi + movq 128(%rsp), %rbp + xorq %r10, %rbp + rolq $45, %rbp + movq 176(%rsp), %rbx + xorq %r11, %rbx + rolq $61, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 272(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 280(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 288(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 296(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 304(%rsp) + movq 8(%rsp), %rdx + xorq %r10, %rdx + rolq $1, %rdx + movq 56(%rsp), %rsi + xorq %r11, %rsi + rolq $6, %rsi + movq 104(%rsp), %rdi + xorq %rcx, %rdi + rolq $25, %rdi + movq 152(%rsp), %rbp + xorq %rax, %rbp + rolq $8, %rbp + movq 160(%rsp), %rbx + xorq %r8, %rbx + rolq $18, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 312(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 320(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 328(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 336(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 344(%rsp) + movq 32(%rsp), %rdx + xorq %rax, %rdx + rolq $27, %rdx + movq 40(%rsp), %rsi + xorq %r8, %rsi + rolq $36, %rsi + movq 88(%rsp), %rdi + xorq %r10, %rdi + rolq $10, %rdi + movq 136(%rsp), %rbp + xorq %r11, %rbp + rolq $15, %rbp + movq 184(%rsp), %rbx + xorq %rcx, %rbx + rolq $56, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 352(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 360(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 368(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 376(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 384(%rsp) + movq 16(%rsp), %rdx + xorq %r11, %rdx + rolq $62, %rdx + movq 64(%rsp), %rsi + xorq %rcx, %rsi + rolq $55, %rsi + movq %rsi, %rcx + movq 112(%rsp), %rsi + xorq %rax, %rsi + rolq $39, %rsi + movq %rsi, %rax + movq 120(%rsp), %rsi + xorq %r8, %rsi + rolq $41, %rsi + movq 168(%rsp), %rdi + xorq %r10, %rdi + rolq $2, %rdi + andnq %rax, %rcx, %r8 + xorq %rdx, %r8 + movq %r8, 392(%rsp) + andnq %rsi, %rax, %r8 + xorq %rcx, %r8 + movq %r8, 400(%rsp) + andnq %rdi, %rsi, %r8 + xorq %rax, %r8 + movq %r8, 408(%rsp) + andnq %rdx, %rdi, %rax + xorq %rsi, %rax + movq %rax, 416(%rsp) + andnq %rcx, %rdx, %rax + xorq %rdi, %rax + movq %rax, 424(%rsp) + movq 8(%r9), %rax + movq %rax, 432(%rsp) + movq 232(%rsp), %rax + movq 240(%rsp), %rcx + movq 248(%rsp), %rdx + movq 256(%rsp), %rsi + movq 264(%rsp), %rdi + xorq 272(%rsp), %rax + xorq 280(%rsp), %rcx + xorq 288(%rsp), %rdx + xorq 296(%rsp), %rsi + xorq 304(%rsp), %rdi + xorq 312(%rsp), %rax + xorq 320(%rsp), %rcx + xorq 328(%rsp), %rdx + xorq 336(%rsp), %rsi + xorq 344(%rsp), %rdi + xorq 352(%rsp), %rax + xorq 360(%rsp), %rcx + xorq 368(%rsp), %rdx + xorq 376(%rsp), %rsi + xorq 384(%rsp), %rdi + xorq 392(%rsp), %rax + xorq 400(%rsp), %rcx + xorq 408(%rsp), %rdx + xorq 416(%rsp), %rsi + xorq 424(%rsp), %rdi + movq %rcx, %r8 + rolq $1, %r8 + xorq %rdi, %r8 + movq %rdx, %r10 + rolq $1, %r10 + xorq %rax, %r10 + movq %rsi, %r11 + rolq $1, %r11 + xorq %rcx, %r11 + movq %rdi, %rcx + rolq $1, %rcx + xorq %rdx, %rcx + rolq $1, %rax + xorq %rsi, %rax + movq 232(%rsp), %rdx + xorq %r8, %rdx + movq 280(%rsp), %rsi + xorq %r10, %rsi + rolq $44, %rsi + movq 328(%rsp), %rdi + xorq %r11, %rdi + rolq $43, %rdi + movq 376(%rsp), %rbp + xorq %rcx, %rbp + rolq $21, %rbp + movq 424(%rsp), %rbx + xorq %rax, %rbx + rolq $14, %rbx + andnq %rdi, %rsi, %r12 + xorq 432(%rsp), %r12 + xorq %rdx, %r12 + movq %r12, (%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 8(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 16(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 24(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 32(%rsp) + movq 256(%rsp), %rdx + xorq %rcx, %rdx + rolq $28, %rdx + movq 304(%rsp), %rsi + xorq %rax, %rsi + rolq $20, %rsi + movq 312(%rsp), %rdi + xorq %r8, %rdi + rolq $3, %rdi + movq 360(%rsp), %rbp + xorq %r10, %rbp + rolq $45, %rbp + movq 408(%rsp), %rbx + xorq %r11, %rbx + rolq $61, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 40(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 48(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 56(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 64(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 72(%rsp) + movq 240(%rsp), %rdx + xorq %r10, %rdx + rolq $1, %rdx + movq 288(%rsp), %rsi + xorq %r11, %rsi + rolq $6, %rsi + movq 336(%rsp), %rdi + xorq %rcx, %rdi + rolq $25, %rdi + movq 384(%rsp), %rbp + xorq %rax, %rbp + rolq $8, %rbp + movq 392(%rsp), %rbx + xorq %r8, %rbx + rolq $18, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 80(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 88(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 96(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 104(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 112(%rsp) + movq 264(%rsp), %rdx + xorq %rax, %rdx + rolq $27, %rdx + movq 272(%rsp), %rsi + xorq %r8, %rsi + rolq $36, %rsi + movq 320(%rsp), %rdi + xorq %r10, %rdi + rolq $10, %rdi + movq 368(%rsp), %rbp + xorq %r11, %rbp + rolq $15, %rbp + movq 416(%rsp), %rbx + xorq %rcx, %rbx + rolq $56, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 120(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 128(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 136(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 144(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 152(%rsp) + movq 248(%rsp), %rdx + xorq %r11, %rdx + rolq $62, %rdx + movq 296(%rsp), %rsi + xorq %rcx, %rsi + rolq $55, %rsi + movq %rsi, %rcx + movq 344(%rsp), %rsi + xorq %rax, %rsi + rolq $39, %rsi + movq %rsi, %rax + movq 352(%rsp), %rsi + xorq %r8, %rsi + rolq $41, %rsi + movq 400(%rsp), %rdi + xorq %r10, %rdi + rolq $2, %rdi + andnq %rax, %rcx, %r8 + xorq %rdx, %r8 + movq %r8, 160(%rsp) + andnq %rsi, %rax, %r8 + xorq %rcx, %r8 + movq %r8, 168(%rsp) + andnq %rdi, %rsi, %r8 + xorq %rax, %r8 + movq %r8, 176(%rsp) + andnq %rdx, %rdi, %rax + xorq %rsi, %rax + movq %rax, 184(%rsp) + andnq %rcx, %rdx, %rax + xorq %rdi, %rax + movq %rax, 192(%rsp) + leaq 16(%r9), %r9 + testb $-1, %r9b + jne Lkeccak_1600$17 + leaq -192(%r9), %r9 + movq 224(%rsp), %rdx + movq 216(%rsp), %rcx + movq 208(%rsp), %rax +Lkeccak_1600$15: + cmpq %rax, %rcx + jnb Lkeccak_1600$16 + movq 440(%rsp), %rsi + movb %sil, %sil + movq %rcx, %rdi + shrq $3, %rdi + movq $0, %r8 + jmp Lkeccak_1600$13 +Lkeccak_1600$14: + movq (%rdx,%r8,8), %r10 + xorq %r10, (%rsp,%r8,8) + leaq 1(%r8), %r8 +Lkeccak_1600$13: + cmpq %rdi, %r8 + jb Lkeccak_1600$14 + shlq $3, %r8 + jmp Lkeccak_1600$11 +Lkeccak_1600$12: + movb (%rdx,%r8), %dil + xorb %dil, (%rsp,%r8) + leaq 1(%r8), %r8 +Lkeccak_1600$11: + cmpq %rcx, %r8 + jb Lkeccak_1600$12 + xorb %sil, (%rsp,%r8) + movq %rax, %rcx + leaq -1(%rcx), %rcx + xorb $-128, (%rsp,%rcx) + movq 448(%rsp), %rdx + jmp Lkeccak_1600$6 +Lkeccak_1600$7: + movq %rdx, 448(%rsp) + movq %rax, 440(%rsp) +Lkeccak_1600$10: + movq (%r9), %rax + movq %rax, 432(%rsp) + movq (%rsp), %rax + movq 8(%rsp), %rcx + movq 16(%rsp), %rdx + movq 24(%rsp), %rsi + movq 32(%rsp), %rdi + xorq 40(%rsp), %rax + xorq 48(%rsp), %rcx + xorq 56(%rsp), %rdx + xorq 64(%rsp), %rsi + xorq 72(%rsp), %rdi + xorq 80(%rsp), %rax + xorq 88(%rsp), %rcx + xorq 96(%rsp), %rdx + xorq 104(%rsp), %rsi + xorq 112(%rsp), %rdi + xorq 120(%rsp), %rax + xorq 128(%rsp), %rcx + xorq 136(%rsp), %rdx + xorq 144(%rsp), %rsi + xorq 152(%rsp), %rdi + xorq 160(%rsp), %rax + xorq 168(%rsp), %rcx + xorq 176(%rsp), %rdx + xorq 184(%rsp), %rsi + xorq 192(%rsp), %rdi + movq %rcx, %r8 + rolq $1, %r8 + xorq %rdi, %r8 + movq %rdx, %r10 + rolq $1, %r10 + xorq %rax, %r10 + movq %rsi, %r11 + rolq $1, %r11 + xorq %rcx, %r11 + movq %rdi, %rcx + rolq $1, %rcx + xorq %rdx, %rcx + rolq $1, %rax + xorq %rsi, %rax + movq (%rsp), %rdx + xorq %r8, %rdx + movq 48(%rsp), %rsi + xorq %r10, %rsi + rolq $44, %rsi + movq 96(%rsp), %rdi + xorq %r11, %rdi + rolq $43, %rdi + movq 144(%rsp), %rbp + xorq %rcx, %rbp + rolq $21, %rbp + movq 192(%rsp), %rbx + xorq %rax, %rbx + rolq $14, %rbx + andnq %rdi, %rsi, %r12 + xorq 432(%rsp), %r12 + xorq %rdx, %r12 + movq %r12, 232(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 240(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 248(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 256(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 264(%rsp) + movq 24(%rsp), %rdx + xorq %rcx, %rdx + rolq $28, %rdx + movq 72(%rsp), %rsi + xorq %rax, %rsi + rolq $20, %rsi + movq 80(%rsp), %rdi + xorq %r8, %rdi + rolq $3, %rdi + movq 128(%rsp), %rbp + xorq %r10, %rbp + rolq $45, %rbp + movq 176(%rsp), %rbx + xorq %r11, %rbx + rolq $61, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 272(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 280(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 288(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 296(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 304(%rsp) + movq 8(%rsp), %rdx + xorq %r10, %rdx + rolq $1, %rdx + movq 56(%rsp), %rsi + xorq %r11, %rsi + rolq $6, %rsi + movq 104(%rsp), %rdi + xorq %rcx, %rdi + rolq $25, %rdi + movq 152(%rsp), %rbp + xorq %rax, %rbp + rolq $8, %rbp + movq 160(%rsp), %rbx + xorq %r8, %rbx + rolq $18, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 312(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 320(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 328(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 336(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 344(%rsp) + movq 32(%rsp), %rdx + xorq %rax, %rdx + rolq $27, %rdx + movq 40(%rsp), %rsi + xorq %r8, %rsi + rolq $36, %rsi + movq 88(%rsp), %rdi + xorq %r10, %rdi + rolq $10, %rdi + movq 136(%rsp), %rbp + xorq %r11, %rbp + rolq $15, %rbp + movq 184(%rsp), %rbx + xorq %rcx, %rbx + rolq $56, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 352(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 360(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 368(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 376(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 384(%rsp) + movq 16(%rsp), %rdx + xorq %r11, %rdx + rolq $62, %rdx + movq 64(%rsp), %rsi + xorq %rcx, %rsi + rolq $55, %rsi + movq %rsi, %rcx + movq 112(%rsp), %rsi + xorq %rax, %rsi + rolq $39, %rsi + movq %rsi, %rax + movq 120(%rsp), %rsi + xorq %r8, %rsi + rolq $41, %rsi + movq 168(%rsp), %rdi + xorq %r10, %rdi + rolq $2, %rdi + andnq %rax, %rcx, %r8 + xorq %rdx, %r8 + movq %r8, 392(%rsp) + andnq %rsi, %rax, %r8 + xorq %rcx, %r8 + movq %r8, 400(%rsp) + andnq %rdi, %rsi, %r8 + xorq %rax, %r8 + movq %r8, 408(%rsp) + andnq %rdx, %rdi, %rax + xorq %rsi, %rax + movq %rax, 416(%rsp) + andnq %rcx, %rdx, %rax + xorq %rdi, %rax + movq %rax, 424(%rsp) + movq 8(%r9), %rax + movq %rax, 432(%rsp) + movq 232(%rsp), %rax + movq 240(%rsp), %rcx + movq 248(%rsp), %rdx + movq 256(%rsp), %rsi + movq 264(%rsp), %rdi + xorq 272(%rsp), %rax + xorq 280(%rsp), %rcx + xorq 288(%rsp), %rdx + xorq 296(%rsp), %rsi + xorq 304(%rsp), %rdi + xorq 312(%rsp), %rax + xorq 320(%rsp), %rcx + xorq 328(%rsp), %rdx + xorq 336(%rsp), %rsi + xorq 344(%rsp), %rdi + xorq 352(%rsp), %rax + xorq 360(%rsp), %rcx + xorq 368(%rsp), %rdx + xorq 376(%rsp), %rsi + xorq 384(%rsp), %rdi + xorq 392(%rsp), %rax + xorq 400(%rsp), %rcx + xorq 408(%rsp), %rdx + xorq 416(%rsp), %rsi + xorq 424(%rsp), %rdi + movq %rcx, %r8 + rolq $1, %r8 + xorq %rdi, %r8 + movq %rdx, %r10 + rolq $1, %r10 + xorq %rax, %r10 + movq %rsi, %r11 + rolq $1, %r11 + xorq %rcx, %r11 + movq %rdi, %rcx + rolq $1, %rcx + xorq %rdx, %rcx + rolq $1, %rax + xorq %rsi, %rax + movq 232(%rsp), %rdx + xorq %r8, %rdx + movq 280(%rsp), %rsi + xorq %r10, %rsi + rolq $44, %rsi + movq 328(%rsp), %rdi + xorq %r11, %rdi + rolq $43, %rdi + movq 376(%rsp), %rbp + xorq %rcx, %rbp + rolq $21, %rbp + movq 424(%rsp), %rbx + xorq %rax, %rbx + rolq $14, %rbx + andnq %rdi, %rsi, %r12 + xorq 432(%rsp), %r12 + xorq %rdx, %r12 + movq %r12, (%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 8(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 16(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 24(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 32(%rsp) + movq 256(%rsp), %rdx + xorq %rcx, %rdx + rolq $28, %rdx + movq 304(%rsp), %rsi + xorq %rax, %rsi + rolq $20, %rsi + movq 312(%rsp), %rdi + xorq %r8, %rdi + rolq $3, %rdi + movq 360(%rsp), %rbp + xorq %r10, %rbp + rolq $45, %rbp + movq 408(%rsp), %rbx + xorq %r11, %rbx + rolq $61, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 40(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 48(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 56(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 64(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 72(%rsp) + movq 240(%rsp), %rdx + xorq %r10, %rdx + rolq $1, %rdx + movq 288(%rsp), %rsi + xorq %r11, %rsi + rolq $6, %rsi + movq 336(%rsp), %rdi + xorq %rcx, %rdi + rolq $25, %rdi + movq 384(%rsp), %rbp + xorq %rax, %rbp + rolq $8, %rbp + movq 392(%rsp), %rbx + xorq %r8, %rbx + rolq $18, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 80(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 88(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 96(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 104(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 112(%rsp) + movq 264(%rsp), %rdx + xorq %rax, %rdx + rolq $27, %rdx + movq 272(%rsp), %rsi + xorq %r8, %rsi + rolq $36, %rsi + movq 320(%rsp), %rdi + xorq %r10, %rdi + rolq $10, %rdi + movq 368(%rsp), %rbp + xorq %r11, %rbp + rolq $15, %rbp + movq 416(%rsp), %rbx + xorq %rcx, %rbx + rolq $56, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 120(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 128(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 136(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 144(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 152(%rsp) + movq 248(%rsp), %rdx + xorq %r11, %rdx + rolq $62, %rdx + movq 296(%rsp), %rsi + xorq %rcx, %rsi + rolq $55, %rsi + movq %rsi, %rcx + movq 344(%rsp), %rsi + xorq %rax, %rsi + rolq $39, %rsi + movq %rsi, %rax + movq 352(%rsp), %rsi + xorq %r8, %rsi + rolq $41, %rsi + movq 400(%rsp), %rdi + xorq %r10, %rdi + rolq $2, %rdi + andnq %rax, %rcx, %r8 + xorq %rdx, %r8 + movq %r8, 160(%rsp) + andnq %rsi, %rax, %r8 + xorq %rcx, %r8 + movq %r8, 168(%rsp) + andnq %rdi, %rsi, %r8 + xorq %rax, %r8 + movq %r8, 176(%rsp) + andnq %rdx, %rdi, %rax + xorq %rsi, %rax + movq %rax, 184(%rsp) + andnq %rcx, %rdx, %rax + xorq %rdi, %rax + movq %rax, 192(%rsp) + leaq 16(%r9), %r9 + testb $-1, %r9b + jne Lkeccak_1600$10 + leaq -192(%r9), %r9 + movq 200(%rsp), %rcx + movq 448(%rsp), %rdx + movq 440(%rsp), %rax + movq %rax, %rsi + shrq $3, %rsi + movq $0, %rdi + jmp Lkeccak_1600$8 +Lkeccak_1600$9: + movq (%rsp,%rdi,8), %r8 + movq %r8, (%rcx,%rdi,8) + leaq 1(%rdi), %rdi +Lkeccak_1600$8: + cmpq %rsi, %rdi + jb Lkeccak_1600$9 + leaq (%rcx,%rax), %rcx + subq %rax, %rdx + movq %rcx, 200(%rsp) +Lkeccak_1600$6: + cmpq %rax, %rdx + jnbe Lkeccak_1600$7 + movq %rdx, 440(%rsp) +Lkeccak_1600$5: + movq (%r9), %rax + movq %rax, 448(%rsp) + movq (%rsp), %rax + movq 8(%rsp), %rcx + movq 16(%rsp), %rdx + movq 24(%rsp), %rsi + movq 32(%rsp), %rdi + xorq 40(%rsp), %rax + xorq 48(%rsp), %rcx + xorq 56(%rsp), %rdx + xorq 64(%rsp), %rsi + xorq 72(%rsp), %rdi + xorq 80(%rsp), %rax + xorq 88(%rsp), %rcx + xorq 96(%rsp), %rdx + xorq 104(%rsp), %rsi + xorq 112(%rsp), %rdi + xorq 120(%rsp), %rax + xorq 128(%rsp), %rcx + xorq 136(%rsp), %rdx + xorq 144(%rsp), %rsi + xorq 152(%rsp), %rdi + xorq 160(%rsp), %rax + xorq 168(%rsp), %rcx + xorq 176(%rsp), %rdx + xorq 184(%rsp), %rsi + xorq 192(%rsp), %rdi + movq %rcx, %r8 + rolq $1, %r8 + xorq %rdi, %r8 + movq %rdx, %r10 + rolq $1, %r10 + xorq %rax, %r10 + movq %rsi, %r11 + rolq $1, %r11 + xorq %rcx, %r11 + movq %rdi, %rcx + rolq $1, %rcx + xorq %rdx, %rcx + rolq $1, %rax + xorq %rsi, %rax + movq (%rsp), %rdx + xorq %r8, %rdx + movq 48(%rsp), %rsi + xorq %r10, %rsi + rolq $44, %rsi + movq 96(%rsp), %rdi + xorq %r11, %rdi + rolq $43, %rdi + movq 144(%rsp), %rbp + xorq %rcx, %rbp + rolq $21, %rbp + movq 192(%rsp), %rbx + xorq %rax, %rbx + rolq $14, %rbx + andnq %rdi, %rsi, %r12 + xorq 448(%rsp), %r12 + xorq %rdx, %r12 + movq %r12, 232(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 240(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 248(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 256(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 264(%rsp) + movq 24(%rsp), %rdx + xorq %rcx, %rdx + rolq $28, %rdx + movq 72(%rsp), %rsi + xorq %rax, %rsi + rolq $20, %rsi + movq 80(%rsp), %rdi + xorq %r8, %rdi + rolq $3, %rdi + movq 128(%rsp), %rbp + xorq %r10, %rbp + rolq $45, %rbp + movq 176(%rsp), %rbx + xorq %r11, %rbx + rolq $61, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 272(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 280(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 288(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 296(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 304(%rsp) + movq 8(%rsp), %rdx + xorq %r10, %rdx + rolq $1, %rdx + movq 56(%rsp), %rsi + xorq %r11, %rsi + rolq $6, %rsi + movq 104(%rsp), %rdi + xorq %rcx, %rdi + rolq $25, %rdi + movq 152(%rsp), %rbp + xorq %rax, %rbp + rolq $8, %rbp + movq 160(%rsp), %rbx + xorq %r8, %rbx + rolq $18, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 312(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 320(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 328(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 336(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 344(%rsp) + movq 32(%rsp), %rdx + xorq %rax, %rdx + rolq $27, %rdx + movq 40(%rsp), %rsi + xorq %r8, %rsi + rolq $36, %rsi + movq 88(%rsp), %rdi + xorq %r10, %rdi + rolq $10, %rdi + movq 136(%rsp), %rbp + xorq %r11, %rbp + rolq $15, %rbp + movq 184(%rsp), %rbx + xorq %rcx, %rbx + rolq $56, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 352(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 360(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 368(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 376(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 384(%rsp) + movq 16(%rsp), %rdx + xorq %r11, %rdx + rolq $62, %rdx + movq 64(%rsp), %rsi + xorq %rcx, %rsi + rolq $55, %rsi + movq %rsi, %rcx + movq 112(%rsp), %rsi + xorq %rax, %rsi + rolq $39, %rsi + movq %rsi, %rax + movq 120(%rsp), %rsi + xorq %r8, %rsi + rolq $41, %rsi + movq 168(%rsp), %rdi + xorq %r10, %rdi + rolq $2, %rdi + andnq %rax, %rcx, %r8 + xorq %rdx, %r8 + movq %r8, 392(%rsp) + andnq %rsi, %rax, %r8 + xorq %rcx, %r8 + movq %r8, 400(%rsp) + andnq %rdi, %rsi, %r8 + xorq %rax, %r8 + movq %r8, 408(%rsp) + andnq %rdx, %rdi, %rax + xorq %rsi, %rax + movq %rax, 416(%rsp) + andnq %rcx, %rdx, %rax + xorq %rdi, %rax + movq %rax, 424(%rsp) + movq 8(%r9), %rax + movq %rax, 448(%rsp) + movq 232(%rsp), %rax + movq 240(%rsp), %rcx + movq 248(%rsp), %rdx + movq 256(%rsp), %rsi + movq 264(%rsp), %rdi + xorq 272(%rsp), %rax + xorq 280(%rsp), %rcx + xorq 288(%rsp), %rdx + xorq 296(%rsp), %rsi + xorq 304(%rsp), %rdi + xorq 312(%rsp), %rax + xorq 320(%rsp), %rcx + xorq 328(%rsp), %rdx + xorq 336(%rsp), %rsi + xorq 344(%rsp), %rdi + xorq 352(%rsp), %rax + xorq 360(%rsp), %rcx + xorq 368(%rsp), %rdx + xorq 376(%rsp), %rsi + xorq 384(%rsp), %rdi + xorq 392(%rsp), %rax + xorq 400(%rsp), %rcx + xorq 408(%rsp), %rdx + xorq 416(%rsp), %rsi + xorq 424(%rsp), %rdi + movq %rcx, %r8 + rolq $1, %r8 + xorq %rdi, %r8 + movq %rdx, %r10 + rolq $1, %r10 + xorq %rax, %r10 + movq %rsi, %r11 + rolq $1, %r11 + xorq %rcx, %r11 + movq %rdi, %rcx + rolq $1, %rcx + xorq %rdx, %rcx + rolq $1, %rax + xorq %rsi, %rax + movq 232(%rsp), %rdx + xorq %r8, %rdx + movq 280(%rsp), %rsi + xorq %r10, %rsi + rolq $44, %rsi + movq 328(%rsp), %rdi + xorq %r11, %rdi + rolq $43, %rdi + movq 376(%rsp), %rbp + xorq %rcx, %rbp + rolq $21, %rbp + movq 424(%rsp), %rbx + xorq %rax, %rbx + rolq $14, %rbx + andnq %rdi, %rsi, %r12 + xorq 448(%rsp), %r12 + xorq %rdx, %r12 + movq %r12, (%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 8(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 16(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 24(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 32(%rsp) + movq 256(%rsp), %rdx + xorq %rcx, %rdx + rolq $28, %rdx + movq 304(%rsp), %rsi + xorq %rax, %rsi + rolq $20, %rsi + movq 312(%rsp), %rdi + xorq %r8, %rdi + rolq $3, %rdi + movq 360(%rsp), %rbp + xorq %r10, %rbp + rolq $45, %rbp + movq 408(%rsp), %rbx + xorq %r11, %rbx + rolq $61, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 40(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 48(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 56(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 64(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 72(%rsp) + movq 240(%rsp), %rdx + xorq %r10, %rdx + rolq $1, %rdx + movq 288(%rsp), %rsi + xorq %r11, %rsi + rolq $6, %rsi + movq 336(%rsp), %rdi + xorq %rcx, %rdi + rolq $25, %rdi + movq 384(%rsp), %rbp + xorq %rax, %rbp + rolq $8, %rbp + movq 392(%rsp), %rbx + xorq %r8, %rbx + rolq $18, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 80(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 88(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 96(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 104(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 112(%rsp) + movq 264(%rsp), %rdx + xorq %rax, %rdx + rolq $27, %rdx + movq 272(%rsp), %rsi + xorq %r8, %rsi + rolq $36, %rsi + movq 320(%rsp), %rdi + xorq %r10, %rdi + rolq $10, %rdi + movq 368(%rsp), %rbp + xorq %r11, %rbp + rolq $15, %rbp + movq 416(%rsp), %rbx + xorq %rcx, %rbx + rolq $56, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 120(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 128(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 136(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 144(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 152(%rsp) + movq 248(%rsp), %rdx + xorq %r11, %rdx + rolq $62, %rdx + movq 296(%rsp), %rsi + xorq %rcx, %rsi + rolq $55, %rsi + movq %rsi, %rcx + movq 344(%rsp), %rsi + xorq %rax, %rsi + rolq $39, %rsi + movq %rsi, %rax + movq 352(%rsp), %rsi + xorq %r8, %rsi + rolq $41, %rsi + movq 400(%rsp), %rdi + xorq %r10, %rdi + rolq $2, %rdi + andnq %rax, %rcx, %r8 + xorq %rdx, %r8 + movq %r8, 160(%rsp) + andnq %rsi, %rax, %r8 + xorq %rcx, %r8 + movq %r8, 168(%rsp) + andnq %rdi, %rsi, %r8 + xorq %rax, %r8 + movq %r8, 176(%rsp) + andnq %rdx, %rdi, %rax + xorq %rsi, %rax + movq %rax, 184(%rsp) + andnq %rcx, %rdx, %rax + xorq %rdi, %rax + movq %rax, 192(%rsp) + leaq 16(%r9), %r9 + testb $-1, %r9b + jne Lkeccak_1600$5 + movq 200(%rsp), %rax + movq 440(%rsp), %rcx + movq %rcx, %rdx + shrq $3, %rdx + movq $0, %rsi + jmp Lkeccak_1600$3 +Lkeccak_1600$4: + movq (%rsp,%rsi,8), %rdi + movq %rdi, (%rax,%rsi,8) + leaq 1(%rsi), %rsi +Lkeccak_1600$3: + cmpq %rdx, %rsi + jb Lkeccak_1600$4 + shlq $3, %rsi + jmp Lkeccak_1600$1 +Lkeccak_1600$2: + movb (%rsp,%rsi), %dl + movb %dl, (%rax,%rsi) + leaq 1(%rsi), %rsi +Lkeccak_1600$1: + cmpq %rcx, %rsi + jb Lkeccak_1600$2 + addq $456, %rsp + popq %r12 + popq %rbx + popq %rbp + ret diff --git a/code/crypto_hash/sha3512/.gitignore b/code/crypto_hash/sha3512/.gitignore new file mode 100644 index 0000000..ad1a23f --- /dev/null +++ b/code/crypto_hash/sha3512/.gitignore @@ -0,0 +1 @@ +*.japp diff --git a/code/crypto_hash/sha3512/avx2/Makefile b/code/crypto_hash/sha3512/avx2/Makefile new file mode 100644 index 0000000..f394ed7 --- /dev/null +++ b/code/crypto_hash/sha3512/avx2/Makefile @@ -0,0 +1,15 @@ +# -*- Makefile -*- + +.PHONY: default clean + +default: sha3512.japp sha3512.s + @true + +clean: + rm -f sha3512.japp sha3512.s + +%.s: %.japp + jasminc -lea -pasm $< > $@ || rm -f $@ + +%.japp: %.jazz + gpp -I../../../ -o $@ $< diff --git a/code/crypto_hash/sha3512/avx2/sha3512-m.c b/code/crypto_hash/sha3512/avx2/sha3512-m.c new file mode 100644 index 0000000..b80c54f --- /dev/null +++ b/code/crypto_hash/sha3512/avx2/sha3512-m.c @@ -0,0 +1,85 @@ +#include "crypto_hash.h" +#include "impl.h" +#include "api.h" +#include +#include + + +extern void keccak_1600( + uint8_t *out, + uint64_t outlen, + const uint8_t *in, + size_t inlen, + uint64_t *c, + uint64_t **g +); + + +uint64_t rhotates_left[6*4] __attribute__((aligned(32))) = +{ + 3, 18, 36, 41, + 1, 62, 28, 27, + 45, 6, 56, 39, + 10, 61, 55, 8, + 2, 15, 25, 20, + 44, 43, 21, 14 +}; + + +uint64_t rhotates_right[6*4] __attribute__((aligned(32))) = +{ + 64-3, 64-18, 64-36, 64-41, + 64-1, 64-62, 64-28, 64-27, + 64-45, 64-6, 64-56, 64-39, + 64-10, 64-61, 64-55, 64-8, + 64-2, 64-15, 64-25, 64-20, + 64-44, 64-43, 64-21, 64-14 +}; + + +uint64_t iotas[24*4] __attribute__((aligned(32))) = +{ + 0x0000000000000001UL, 0x0000000000000001UL, 0x0000000000000001UL, 0x0000000000000001UL, + 0x0000000000008082UL, 0x0000000000008082UL, 0x0000000000008082UL, 0x0000000000008082UL, + 0x800000000000808aUL, 0x800000000000808aUL, 0x800000000000808aUL, 0x800000000000808aUL, + 0x8000000080008000UL, 0x8000000080008000UL, 0x8000000080008000UL, 0x8000000080008000UL, + 0x000000000000808bUL, 0x000000000000808bUL, 0x000000000000808bUL, 0x000000000000808bUL, + 0x0000000080000001UL, 0x0000000080000001UL, 0x0000000080000001UL, 0x0000000080000001UL, + 0x8000000080008081UL, 0x8000000080008081UL, 0x8000000080008081UL, 0x8000000080008081UL, + 0x8000000000008009UL, 0x8000000000008009UL, 0x8000000000008009UL, 0x8000000000008009UL, + 0x000000000000008aUL, 0x000000000000008aUL, 0x000000000000008aUL, 0x000000000000008aUL, + 0x0000000000000088UL, 0x0000000000000088UL, 0x0000000000000088UL, 0x0000000000000088UL, + 0x0000000080008009UL, 0x0000000080008009UL, 0x0000000080008009UL, 0x0000000080008009UL, + 0x000000008000000aUL, 0x000000008000000aUL, 0x000000008000000aUL, 0x000000008000000aUL, + 0x000000008000808bUL, 0x000000008000808bUL, 0x000000008000808bUL, 0x000000008000808bUL, + 0x800000000000008bUL, 0x800000000000008bUL, 0x800000000000008bUL, 0x800000000000008bUL, + 0x8000000000008089UL, 0x8000000000008089UL, 0x8000000000008089UL, 0x8000000000008089UL, + 0x8000000000008003UL, 0x8000000000008003UL, 0x8000000000008003UL, 0x8000000000008003UL, + 0x8000000000008002UL, 0x8000000000008002UL, 0x8000000000008002UL, 0x8000000000008002UL, + 0x8000000000000080UL, 0x8000000000000080UL, 0x8000000000000080UL, 0x8000000000000080UL, + 0x000000000000800aUL, 0x000000000000800aUL, 0x000000000000800aUL, 0x000000000000800aUL, + 0x800000008000000aUL, 0x800000008000000aUL, 0x800000008000000aUL, 0x800000008000000aUL, + 0x8000000080008081UL, 0x8000000080008081UL, 0x8000000080008081UL, 0x8000000080008081UL, + 0x8000000000008080UL, 0x8000000000008080UL, 0x8000000000008080UL, 0x8000000000008080UL, + 0x0000000080000001UL, 0x0000000080000001UL, 0x0000000080000001UL, 0x0000000080000001UL, + 0x8000000080008008UL, 0x8000000080008008UL, 0x8000000080008008UL, 0x8000000080008008UL +}; + + +uint64_t a_jagged[25] __attribute__((aligned(32))) = +{ + 0, 4, 5, 6, 7, + 10, 24, 13, 18, 23, + 8, 16, 25, 22, 15, + 11, 12, 21, 26, 19, + 9, 20, 17, 14, 27 +}; + + +int sha3512_avx2(unsigned char *out,const unsigned char *in,unsigned long long inlen) +{ + uint64_t *g[] = {rhotates_left, rhotates_right, iotas, a_jagged}; + uint64_t c[] = {0x06, (576/8)}; + keccak_1600(out, 64, in, inlen, c, g); + return 0; +} diff --git a/code/crypto_hash/sha3512/avx2/sha3512.jazz b/code/crypto_hash/sha3512/avx2/sha3512.jazz new file mode 100644 index 0000000..5916360 --- /dev/null +++ b/code/crypto_hash/sha3512/avx2/sha3512.jazz @@ -0,0 +1,43 @@ +#define KECCAK_1600_ADD_FULL_BLOCK_IMPLEMENTATION 1 + +u64 s_zero = 0; + +fn add_full_block( + reg u256[7] state, + stack u64[28] s_state, + reg u64 a_jagged, + reg u64 in inlen, + reg u64 rate +) -> reg u256[7], stack u64[28], reg u64, reg u64 +{ + reg u256 a00 a10 a01 a11; + reg u256 t11 t12 t13; + reg u256 zero; + + zero = #x86_VPBROADCAST_4u64(s_zero); + + a00 = #x86_VPBROADCAST_4u64([in + 8*0]); // (0,0) (0,0) (0,0) (0,0) + a10 = #x86_VPBROADCAST_4u64([in + 8*5]); // (1,0) (1,0) (1,0) (1,0) + a01 = (u256)[in + 8*1]; // (0,4) (0,3) (0,2) (0,1) + a11 = (u256)[in + 8*6 ]; // (1,4) (1,3) (1,2) (1,1) + + state[0] ^= a00; + state[1] ^= a01; + + a01 = #x86_VPBLENDD_256(a10, zero, (8u1)[1,1,0,0,1,1,1,1]); // ___ (1,0) ___ ___ + t12 = #x86_VPBLENDD_256(a11, zero, (8u1)[1,1,1,1,0,0,1,1]); // ___ ___ (1,2) ___ + t13 = #x86_VPBLENDD_256(a11, zero, (8u1)[1,1,0,0,1,1,1,1]); // ___ (1,3) ___ ___ + t11 = #x86_VPBLENDD_256(a11, zero, (8u1)[1,1,1,1,1,1,0,0]); // ___ ___ ___ (1,1) + + state[2] ^= a01; + state[3] ^= t12; + state[4] ^= t13; + state[6] ^= t11; + + in += rate; + inlen -= rate; + + return state, s_state, in, inlen; +} + +#include "crypto_hash/keccak1600/avx2/keccak_1600.jazz" diff --git a/code/crypto_hash/sha3512/avx2/sha3512.s b/code/crypto_hash/sha3512/avx2/sha3512.s new file mode 100644 index 0000000..627ffc4 --- /dev/null +++ b/code/crypto_hash/sha3512/avx2/sha3512.s @@ -0,0 +1,519 @@ + .text + .p2align 5 + .globl _keccak_1600 + .globl keccak_1600 +_keccak_1600: +keccak_1600: + pushq %rbp + pushq %rbx + pushq %r12 + pushq %r13 + pushq %r14 + subq $224, %rsp + movb (%r8), %al + movq 8(%r8), %r8 + movq (%r9), %r10 + movq 8(%r9), %r11 + movq 16(%r9), %rbp + movq 24(%r9), %r9 + vpbroadcastq g_zero(%rip), %ymm6 + vmovdqu %ymm6, %ymm7 + vmovdqu %ymm6, %ymm8 + vmovdqu %ymm6, %ymm9 + vmovdqu %ymm6, %ymm10 + vmovdqu %ymm6, %ymm0 + vmovdqu %ymm6, %ymm11 + jmp Lkeccak_1600$15 +Lkeccak_1600$16: + vpbroadcastq s_zero(%rip), %ymm1 + vpbroadcastq (%rdx), %ymm2 + vpbroadcastq 40(%rdx), %ymm3 + vmovdqu 8(%rdx), %ymm4 + vmovdqu 48(%rdx), %ymm5 + vpxor %ymm2, %ymm6, %ymm6 + vpxor %ymm4, %ymm7, %ymm7 + vpblendd $-49, %ymm1, %ymm3, %ymm2 + vpblendd $-13, %ymm1, %ymm5, %ymm3 + vpblendd $-49, %ymm1, %ymm5, %ymm4 + vpblendd $-4, %ymm1, %ymm5, %ymm1 + vpxor %ymm2, %ymm8, %ymm8 + vpxor %ymm3, %ymm9, %ymm9 + vpxor %ymm4, %ymm10, %ymm10 + vpxor %ymm1, %ymm11, %ymm11 + leaq (%rdx,%r8), %rdx + subq %r8, %rcx + leaq 96(%r10), %rbx + leaq 96(%r11), %r12 + movq %rbp, %r13 + movl $24, %r14d + .p2align 5 +Lkeccak_1600$17: + vpshufd $78, %ymm8, %ymm1 + vpxor %ymm9, %ymm0, %ymm2 + vpxor %ymm11, %ymm10, %ymm3 + vpxor %ymm7, %ymm2, %ymm2 + vpxor %ymm3, %ymm2, %ymm2 + vpermq $-109, %ymm2, %ymm3 + vpxor %ymm8, %ymm1, %ymm1 + vpermq $78, %ymm1, %ymm4 + vpsrlq $63, %ymm2, %ymm5 + vpaddq %ymm2, %ymm2, %ymm2 + vpor %ymm2, %ymm5, %ymm2 + vpermq $57, %ymm2, %ymm5 + vpxor %ymm3, %ymm2, %ymm2 + vpermq $0, %ymm2, %ymm2 + vpxor %ymm6, %ymm1, %ymm1 + vpxor %ymm4, %ymm1, %ymm1 + vpsrlq $63, %ymm1, %ymm4 + vpaddq %ymm1, %ymm1, %ymm12 + vpor %ymm4, %ymm12, %ymm4 + vpxor %ymm2, %ymm8, %ymm8 + vpxor %ymm2, %ymm6, %ymm2 + vpblendd $-64, %ymm4, %ymm5, %ymm4 + vpblendd $3, %ymm1, %ymm3, %ymm1 + vpxor %ymm1, %ymm4, %ymm1 + vpsllvq -96(%rbx), %ymm8, %ymm3 + vpsrlvq -96(%r12), %ymm8, %ymm4 + vpor %ymm3, %ymm4, %ymm3 + vpxor %ymm1, %ymm9, %ymm4 + vpsllvq -32(%rbx), %ymm4, %ymm5 + vpsrlvq -32(%r12), %ymm4, %ymm4 + vpor %ymm5, %ymm4, %ymm4 + vpxor %ymm1, %ymm10, %ymm5 + vpsllvq (%rbx), %ymm5, %ymm6 + vpsrlvq (%r12), %ymm5, %ymm5 + vpor %ymm6, %ymm5, %ymm5 + vpxor %ymm1, %ymm0, %ymm0 + vpsllvq 32(%rbx), %ymm0, %ymm6 + vpsrlvq 32(%r12), %ymm0, %ymm0 + vpor %ymm6, %ymm0, %ymm0 + vpxor %ymm1, %ymm11, %ymm6 + vpermq $-115, %ymm3, %ymm3 + vpermq $-115, %ymm4, %ymm4 + vpsllvq 64(%rbx), %ymm6, %ymm8 + vpsrlvq 64(%r12), %ymm6, %ymm6 + vpor %ymm8, %ymm6, %ymm6 + vpxor %ymm1, %ymm7, %ymm1 + vpermq $27, %ymm5, %ymm5 + vpermq $114, %ymm0, %ymm7 + vpsllvq -64(%rbx), %ymm1, %ymm0 + vpsrlvq -64(%r12), %ymm1, %ymm1 + vpor %ymm0, %ymm1, %ymm1 + vpsrldq $8, %ymm6, %ymm0 + vpandn %ymm0, %ymm6, %ymm0 + vpblendd $12, %ymm7, %ymm1, %ymm8 + vpblendd $12, %ymm1, %ymm4, %ymm9 + vpblendd $12, %ymm4, %ymm3, %ymm10 + vpblendd $12, %ymm3, %ymm1, %ymm11 + vpblendd $48, %ymm4, %ymm8, %ymm8 + vpblendd $48, %ymm5, %ymm9, %ymm9 + vpblendd $48, %ymm1, %ymm10, %ymm10 + vpblendd $48, %ymm7, %ymm11, %ymm11 + vpblendd $-64, %ymm5, %ymm8, %ymm8 + vpblendd $-64, %ymm7, %ymm9, %ymm9 + vpblendd $-64, %ymm7, %ymm10, %ymm10 + vpblendd $-64, %ymm4, %ymm11, %ymm11 + vpandn %ymm9, %ymm8, %ymm8 + vpandn %ymm11, %ymm10, %ymm9 + vpblendd $12, %ymm1, %ymm5, %ymm10 + vpblendd $12, %ymm5, %ymm3, %ymm11 + vpxor %ymm3, %ymm8, %ymm12 + vpblendd $48, %ymm3, %ymm10, %ymm8 + vpblendd $48, %ymm4, %ymm11, %ymm10 + vpxor %ymm5, %ymm9, %ymm11 + vpblendd $-64, %ymm4, %ymm8, %ymm8 + vpblendd $-64, %ymm1, %ymm10, %ymm9 + vpandn %ymm9, %ymm8, %ymm8 + vpxor %ymm7, %ymm8, %ymm10 + vpermq $30, %ymm6, %ymm8 + vpblendd $48, %ymm2, %ymm8, %ymm8 + vpermq $57, %ymm6, %ymm9 + vpblendd $-64, %ymm2, %ymm9, %ymm9 + vpandn %ymm8, %ymm9, %ymm13 + vpblendd $12, %ymm5, %ymm4, %ymm8 + vpblendd $12, %ymm4, %ymm7, %ymm9 + vpblendd $48, %ymm7, %ymm8, %ymm8 + vpblendd $48, %ymm3, %ymm9, %ymm9 + vpblendd $-64, %ymm3, %ymm8, %ymm8 + vpblendd $-64, %ymm5, %ymm9, %ymm9 + vpandn %ymm9, %ymm8, %ymm8 + vpxor %ymm1, %ymm8, %ymm8 + vpermq $0, %ymm0, %ymm14 + vpermq $27, %ymm12, %ymm9 + vpermq $-115, %ymm11, %ymm0 + vpermq $114, %ymm10, %ymm11 + vpblendd $12, %ymm3, %ymm7, %ymm10 + vpblendd $12, %ymm7, %ymm5, %ymm7 + vpblendd $48, %ymm5, %ymm10, %ymm5 + vpblendd $48, %ymm1, %ymm7, %ymm7 + vpblendd $-64, %ymm1, %ymm5, %ymm1 + vpblendd $-64, %ymm3, %ymm7, %ymm3 + vpandn %ymm3, %ymm1, %ymm1 + vpxor %ymm14, %ymm2, %ymm2 + vpxor %ymm6, %ymm13, %ymm7 + vpxor %ymm4, %ymm1, %ymm10 + vpxor (%r13), %ymm2, %ymm6 + leaq 32(%r13), %r13 + decl %r14d + jne Lkeccak_1600$17 +Lkeccak_1600$15: + cmpq %r8, %rcx + jnb Lkeccak_1600$16 + vpbroadcastq g_zero(%rip), %ymm1 + vmovdqu %ymm1, (%rsp) + vmovdqu %ymm1, 32(%rsp) + vmovdqu %ymm1, 64(%rsp) + vmovdqu %ymm1, 96(%rsp) + vmovdqu %ymm1, 128(%rsp) + vmovdqu %ymm1, 160(%rsp) + vmovdqu %ymm1, 192(%rsp) + movq %rcx, %rbx + shrq $3, %rbx + movq $0, %r12 + jmp Lkeccak_1600$13 +Lkeccak_1600$14: + movq (%rdx,%r12,8), %r13 + movq (%r9,%r12,8), %r14 + movq %r13, (%rsp,%r14,8) + leaq 1(%r12), %r12 +Lkeccak_1600$13: + cmpq %rbx, %r12 + jb Lkeccak_1600$14 + movq (%r9,%r12,8), %rbx + shlq $3, %rbx + shlq $3, %r12 + jmp Lkeccak_1600$11 +Lkeccak_1600$12: + movb (%rdx,%r12), %r13b + movb %r13b, (%rsp,%rbx) + leaq 1(%r12), %r12 + leaq 1(%rbx), %rbx +Lkeccak_1600$11: + cmpq %rcx, %r12 + jb Lkeccak_1600$12 + movb %al, (%rsp,%rbx) + movq %r8, %rax + leaq -1(%rax), %rax + shrq $3, %rax + movq (%r9,%rax,8), %rax + shlq $3, %rax + movq %r8, %rcx + leaq -1(%rcx), %rcx + andq $7, %rcx + leaq (%rax,%rcx), %rax + xorb $-128, (%rsp,%rax) + movq (%rsp), %rax + movq %rax, 8(%rsp) + movq %rax, 16(%rsp) + movq %rax, 24(%rsp) + vpxor (%rsp), %ymm6, %ymm1 + vpxor 32(%rsp), %ymm7, %ymm2 + vpxor 64(%rsp), %ymm8, %ymm3 + vpxor 96(%rsp), %ymm9, %ymm4 + vpxor 128(%rsp), %ymm10, %ymm5 + vpxor 160(%rsp), %ymm0, %ymm0 + vpxor 192(%rsp), %ymm11, %ymm6 + jmp Lkeccak_1600$6 +Lkeccak_1600$7: + leaq 96(%r10), %rax + leaq 96(%r11), %rcx + movq %rbp, %rdx + movl $24, %ebx + .p2align 5 +Lkeccak_1600$10: + vpshufd $78, %ymm3, %ymm7 + vpxor %ymm4, %ymm0, %ymm8 + vpxor %ymm6, %ymm5, %ymm9 + vpxor %ymm2, %ymm8, %ymm8 + vpxor %ymm9, %ymm8, %ymm8 + vpermq $-109, %ymm8, %ymm9 + vpxor %ymm3, %ymm7, %ymm7 + vpermq $78, %ymm7, %ymm10 + vpsrlq $63, %ymm8, %ymm11 + vpaddq %ymm8, %ymm8, %ymm8 + vpor %ymm8, %ymm11, %ymm8 + vpermq $57, %ymm8, %ymm11 + vpxor %ymm9, %ymm8, %ymm8 + vpermq $0, %ymm8, %ymm8 + vpxor %ymm1, %ymm7, %ymm7 + vpxor %ymm10, %ymm7, %ymm7 + vpsrlq $63, %ymm7, %ymm10 + vpaddq %ymm7, %ymm7, %ymm12 + vpor %ymm10, %ymm12, %ymm10 + vpxor %ymm8, %ymm3, %ymm3 + vpxor %ymm8, %ymm1, %ymm1 + vpblendd $-64, %ymm10, %ymm11, %ymm8 + vpblendd $3, %ymm7, %ymm9, %ymm7 + vpxor %ymm7, %ymm8, %ymm7 + vpsllvq -96(%rax), %ymm3, %ymm8 + vpsrlvq -96(%rcx), %ymm3, %ymm3 + vpor %ymm8, %ymm3, %ymm3 + vpxor %ymm7, %ymm4, %ymm4 + vpsllvq -32(%rax), %ymm4, %ymm8 + vpsrlvq -32(%rcx), %ymm4, %ymm4 + vpor %ymm8, %ymm4, %ymm4 + vpxor %ymm7, %ymm5, %ymm5 + vpsllvq (%rax), %ymm5, %ymm8 + vpsrlvq (%rcx), %ymm5, %ymm5 + vpor %ymm8, %ymm5, %ymm5 + vpxor %ymm7, %ymm0, %ymm0 + vpsllvq 32(%rax), %ymm0, %ymm8 + vpsrlvq 32(%rcx), %ymm0, %ymm0 + vpor %ymm8, %ymm0, %ymm0 + vpxor %ymm7, %ymm6, %ymm6 + vpermq $-115, %ymm3, %ymm8 + vpermq $-115, %ymm4, %ymm9 + vpsllvq 64(%rax), %ymm6, %ymm3 + vpsrlvq 64(%rcx), %ymm6, %ymm4 + vpor %ymm3, %ymm4, %ymm10 + vpxor %ymm7, %ymm2, %ymm2 + vpermq $27, %ymm5, %ymm5 + vpermq $114, %ymm0, %ymm7 + vpsllvq -64(%rax), %ymm2, %ymm0 + vpsrlvq -64(%rcx), %ymm2, %ymm2 + vpor %ymm0, %ymm2, %ymm2 + vpsrldq $8, %ymm10, %ymm0 + vpandn %ymm0, %ymm10, %ymm0 + vpblendd $12, %ymm7, %ymm2, %ymm3 + vpblendd $12, %ymm2, %ymm9, %ymm4 + vpblendd $12, %ymm9, %ymm8, %ymm6 + vpblendd $12, %ymm8, %ymm2, %ymm11 + vpblendd $48, %ymm9, %ymm3, %ymm3 + vpblendd $48, %ymm5, %ymm4, %ymm4 + vpblendd $48, %ymm2, %ymm6, %ymm6 + vpblendd $48, %ymm7, %ymm11, %ymm11 + vpblendd $-64, %ymm5, %ymm3, %ymm3 + vpblendd $-64, %ymm7, %ymm4, %ymm4 + vpblendd $-64, %ymm7, %ymm6, %ymm6 + vpblendd $-64, %ymm9, %ymm11, %ymm11 + vpandn %ymm4, %ymm3, %ymm3 + vpandn %ymm11, %ymm6, %ymm4 + vpblendd $12, %ymm2, %ymm5, %ymm6 + vpblendd $12, %ymm5, %ymm8, %ymm11 + vpxor %ymm8, %ymm3, %ymm12 + vpblendd $48, %ymm8, %ymm6, %ymm3 + vpblendd $48, %ymm9, %ymm11, %ymm6 + vpxor %ymm5, %ymm4, %ymm11 + vpblendd $-64, %ymm9, %ymm3, %ymm3 + vpblendd $-64, %ymm2, %ymm6, %ymm4 + vpandn %ymm4, %ymm3, %ymm3 + vpxor %ymm7, %ymm3, %ymm6 + vpermq $30, %ymm10, %ymm3 + vpblendd $48, %ymm1, %ymm3, %ymm3 + vpermq $57, %ymm10, %ymm4 + vpblendd $-64, %ymm1, %ymm4, %ymm4 + vpandn %ymm3, %ymm4, %ymm13 + vpblendd $12, %ymm5, %ymm9, %ymm3 + vpblendd $12, %ymm9, %ymm7, %ymm4 + vpblendd $48, %ymm7, %ymm3, %ymm3 + vpblendd $48, %ymm8, %ymm4, %ymm4 + vpblendd $-64, %ymm8, %ymm3, %ymm3 + vpblendd $-64, %ymm5, %ymm4, %ymm4 + vpandn %ymm4, %ymm3, %ymm3 + vpxor %ymm2, %ymm3, %ymm3 + vpermq $0, %ymm0, %ymm14 + vpermq $27, %ymm12, %ymm4 + vpermq $-115, %ymm11, %ymm0 + vpermq $114, %ymm6, %ymm6 + vpblendd $12, %ymm8, %ymm7, %ymm11 + vpblendd $12, %ymm7, %ymm5, %ymm7 + vpblendd $48, %ymm5, %ymm11, %ymm5 + vpblendd $48, %ymm2, %ymm7, %ymm7 + vpblendd $-64, %ymm2, %ymm5, %ymm2 + vpblendd $-64, %ymm8, %ymm7, %ymm5 + vpandn %ymm5, %ymm2, %ymm5 + vpxor %ymm14, %ymm1, %ymm1 + vpxor %ymm10, %ymm13, %ymm2 + vpxor %ymm9, %ymm5, %ymm5 + vpxor (%rdx), %ymm1, %ymm1 + leaq 32(%rdx), %rdx + decl %ebx + jne Lkeccak_1600$10 + vmovdqu %ymm1, (%rsp) + vmovdqu %ymm2, 32(%rsp) + vmovdqu %ymm3, 64(%rsp) + vmovdqu %ymm4, 96(%rsp) + vmovdqu %ymm5, 128(%rsp) + vmovdqu %ymm0, 160(%rsp) + vmovdqu %ymm6, 192(%rsp) + movq %r8, %rax + shrq $3, %rax + movq $0, %rcx + jmp Lkeccak_1600$8 +Lkeccak_1600$9: + movq (%r9,%rcx,8), %rdx + movq (%rsp,%rdx,8), %rdx + movq %rdx, (%rdi,%rcx,8) + leaq 1(%rcx), %rcx +Lkeccak_1600$8: + cmpq %rax, %rcx + jb Lkeccak_1600$9 + leaq (%rdi,%r8), %rdi + subq %r8, %rsi +Lkeccak_1600$6: + cmpq %r8, %rsi + jnbe Lkeccak_1600$7 + leaq 96(%r10), %rax + leaq 96(%r11), %rcx + movl $24, %edx + .p2align 5 +Lkeccak_1600$5: + vpshufd $78, %ymm3, %ymm7 + vpxor %ymm4, %ymm0, %ymm8 + vpxor %ymm6, %ymm5, %ymm9 + vpxor %ymm2, %ymm8, %ymm8 + vpxor %ymm9, %ymm8, %ymm8 + vpermq $-109, %ymm8, %ymm9 + vpxor %ymm3, %ymm7, %ymm7 + vpermq $78, %ymm7, %ymm10 + vpsrlq $63, %ymm8, %ymm11 + vpaddq %ymm8, %ymm8, %ymm8 + vpor %ymm8, %ymm11, %ymm8 + vpermq $57, %ymm8, %ymm11 + vpxor %ymm9, %ymm8, %ymm8 + vpermq $0, %ymm8, %ymm8 + vpxor %ymm1, %ymm7, %ymm7 + vpxor %ymm10, %ymm7, %ymm7 + vpsrlq $63, %ymm7, %ymm10 + vpaddq %ymm7, %ymm7, %ymm12 + vpor %ymm10, %ymm12, %ymm10 + vpxor %ymm8, %ymm3, %ymm3 + vpxor %ymm8, %ymm1, %ymm1 + vpblendd $-64, %ymm10, %ymm11, %ymm8 + vpblendd $3, %ymm7, %ymm9, %ymm7 + vpxor %ymm7, %ymm8, %ymm7 + vpsllvq -96(%rax), %ymm3, %ymm8 + vpsrlvq -96(%rcx), %ymm3, %ymm3 + vpor %ymm8, %ymm3, %ymm3 + vpxor %ymm7, %ymm4, %ymm4 + vpsllvq -32(%rax), %ymm4, %ymm8 + vpsrlvq -32(%rcx), %ymm4, %ymm4 + vpor %ymm8, %ymm4, %ymm4 + vpxor %ymm7, %ymm5, %ymm5 + vpsllvq (%rax), %ymm5, %ymm8 + vpsrlvq (%rcx), %ymm5, %ymm5 + vpor %ymm8, %ymm5, %ymm5 + vpxor %ymm7, %ymm0, %ymm0 + vpsllvq 32(%rax), %ymm0, %ymm8 + vpsrlvq 32(%rcx), %ymm0, %ymm0 + vpor %ymm8, %ymm0, %ymm0 + vpxor %ymm7, %ymm6, %ymm6 + vpermq $-115, %ymm3, %ymm8 + vpermq $-115, %ymm4, %ymm9 + vpsllvq 64(%rax), %ymm6, %ymm3 + vpsrlvq 64(%rcx), %ymm6, %ymm4 + vpor %ymm3, %ymm4, %ymm10 + vpxor %ymm7, %ymm2, %ymm2 + vpermq $27, %ymm5, %ymm5 + vpermq $114, %ymm0, %ymm7 + vpsllvq -64(%rax), %ymm2, %ymm0 + vpsrlvq -64(%rcx), %ymm2, %ymm2 + vpor %ymm0, %ymm2, %ymm2 + vpsrldq $8, %ymm10, %ymm0 + vpandn %ymm0, %ymm10, %ymm0 + vpblendd $12, %ymm7, %ymm2, %ymm3 + vpblendd $12, %ymm2, %ymm9, %ymm4 + vpblendd $12, %ymm9, %ymm8, %ymm6 + vpblendd $12, %ymm8, %ymm2, %ymm11 + vpblendd $48, %ymm9, %ymm3, %ymm3 + vpblendd $48, %ymm5, %ymm4, %ymm4 + vpblendd $48, %ymm2, %ymm6, %ymm6 + vpblendd $48, %ymm7, %ymm11, %ymm11 + vpblendd $-64, %ymm5, %ymm3, %ymm3 + vpblendd $-64, %ymm7, %ymm4, %ymm4 + vpblendd $-64, %ymm7, %ymm6, %ymm6 + vpblendd $-64, %ymm9, %ymm11, %ymm11 + vpandn %ymm4, %ymm3, %ymm3 + vpandn %ymm11, %ymm6, %ymm4 + vpblendd $12, %ymm2, %ymm5, %ymm6 + vpblendd $12, %ymm5, %ymm8, %ymm11 + vpxor %ymm8, %ymm3, %ymm12 + vpblendd $48, %ymm8, %ymm6, %ymm3 + vpblendd $48, %ymm9, %ymm11, %ymm6 + vpxor %ymm5, %ymm4, %ymm11 + vpblendd $-64, %ymm9, %ymm3, %ymm3 + vpblendd $-64, %ymm2, %ymm6, %ymm4 + vpandn %ymm4, %ymm3, %ymm3 + vpxor %ymm7, %ymm3, %ymm6 + vpermq $30, %ymm10, %ymm3 + vpblendd $48, %ymm1, %ymm3, %ymm3 + vpermq $57, %ymm10, %ymm4 + vpblendd $-64, %ymm1, %ymm4, %ymm4 + vpandn %ymm3, %ymm4, %ymm13 + vpblendd $12, %ymm5, %ymm9, %ymm3 + vpblendd $12, %ymm9, %ymm7, %ymm4 + vpblendd $48, %ymm7, %ymm3, %ymm3 + vpblendd $48, %ymm8, %ymm4, %ymm4 + vpblendd $-64, %ymm8, %ymm3, %ymm3 + vpblendd $-64, %ymm5, %ymm4, %ymm4 + vpandn %ymm4, %ymm3, %ymm3 + vpxor %ymm2, %ymm3, %ymm3 + vpermq $0, %ymm0, %ymm14 + vpermq $27, %ymm12, %ymm4 + vpermq $-115, %ymm11, %ymm0 + vpermq $114, %ymm6, %ymm6 + vpblendd $12, %ymm8, %ymm7, %ymm11 + vpblendd $12, %ymm7, %ymm5, %ymm7 + vpblendd $48, %ymm5, %ymm11, %ymm5 + vpblendd $48, %ymm2, %ymm7, %ymm7 + vpblendd $-64, %ymm2, %ymm5, %ymm2 + vpblendd $-64, %ymm8, %ymm7, %ymm5 + vpandn %ymm5, %ymm2, %ymm5 + vpxor %ymm14, %ymm1, %ymm1 + vpxor %ymm10, %ymm13, %ymm2 + vpxor %ymm9, %ymm5, %ymm5 + vpxor (%rbp), %ymm1, %ymm1 + leaq 32(%rbp), %rbp + decl %edx + jne Lkeccak_1600$5 + vmovdqu %ymm1, (%rsp) + vmovdqu %ymm2, 32(%rsp) + vmovdqu %ymm3, 64(%rsp) + vmovdqu %ymm4, 96(%rsp) + vmovdqu %ymm5, 128(%rsp) + vmovdqu %ymm0, 160(%rsp) + vmovdqu %ymm6, 192(%rsp) + movq %rsi, %rax + shrq $3, %rax + movq $0, %rcx + jmp Lkeccak_1600$3 +Lkeccak_1600$4: + movq (%r9,%rcx,8), %rdx + movq (%rsp,%rdx,8), %rdx + movq %rdx, (%rdi,%rcx,8) + leaq 1(%rcx), %rcx +Lkeccak_1600$3: + cmpq %rax, %rcx + jb Lkeccak_1600$4 + movq (%r9,%rcx,8), %rax + shlq $3, %rcx + shlq $3, %rax + jmp Lkeccak_1600$1 +Lkeccak_1600$2: + movb (%rsp,%rax), %dl + movb %dl, (%rdi,%rcx) + leaq 1(%rcx), %rcx + leaq 1(%rax), %rax +Lkeccak_1600$1: + cmpq %rsi, %rcx + jb Lkeccak_1600$2 + addq $224, %rsp + popq %r14 + popq %r13 + popq %r12 + popq %rbx + popq %rbp + ret + .data + .globl _g_zero + .globl g_zero + .p2align 3 +_g_zero: +g_zero: + .quad 0 + .globl _s_zero + .globl s_zero + .p2align 3 +_s_zero: +s_zero: + .quad 0 diff --git a/code/crypto_hash/sha3512/scalar/Makefile b/code/crypto_hash/sha3512/scalar/Makefile new file mode 100644 index 0000000..f394ed7 --- /dev/null +++ b/code/crypto_hash/sha3512/scalar/Makefile @@ -0,0 +1,15 @@ +# -*- Makefile -*- + +.PHONY: default clean + +default: sha3512.japp sha3512.s + @true + +clean: + rm -f sha3512.japp sha3512.s + +%.s: %.japp + jasminc -lea -pasm $< > $@ || rm -f $@ + +%.japp: %.jazz + gpp -I../../../ -o $@ $< diff --git a/code/crypto_hash/sha3512/scalar/sha3512-m.c b/code/crypto_hash/sha3512/scalar/sha3512-m.c new file mode 100644 index 0000000..d231bc1 --- /dev/null +++ b/code/crypto_hash/sha3512/scalar/sha3512-m.c @@ -0,0 +1,54 @@ +#include "crypto_hash.h" +#include "impl.h" +#include "api.h" +#include +#include + + +extern void keccak_1600( + uint8_t *out, + uint64_t outlen, + const uint8_t *in, + size_t inlen, + uint64_t *c, + uint64_t *iotas +); + + +uint64_t iotas[32] __attribute__((aligned(256))) = +{ + 0,0,0,0,0,0,0, 0 + , 0x0000000000000001 + , 0x0000000000008082 + , 0x800000000000808a + , 0x8000000080008000 + , 0x000000000000808b + , 0x0000000080000001 + , 0x8000000080008081 + , 0x8000000000008009 + , 0x000000000000008a + , 0x0000000000000088 + , 0x0000000080008009 + , 0x000000008000000a + , 0x000000008000808b + , 0x800000000000008b + , 0x8000000000008089 + , 0x8000000000008003 + , 0x8000000000008002 + , 0x8000000000000080 + , 0x000000000000800a + , 0x800000008000000a + , 0x8000000080008081 + , 0x8000000000008080 + , 0x0000000080000001 + , 0x8000000080008008 +}; + + +int sha3512_scalar(unsigned char *out,const unsigned char *in,unsigned long long inlen) +{ + uint64_t c[] = {0x06, (576/8)}; + keccak_1600(out, 64, in, inlen, c, &(iotas[8])); + return 0; +} + diff --git a/code/crypto_hash/sha3512/scalar/sha3512.jazz b/code/crypto_hash/sha3512/scalar/sha3512.jazz new file mode 100644 index 0000000..d2fa40e --- /dev/null +++ b/code/crypto_hash/sha3512/scalar/sha3512.jazz @@ -0,0 +1 @@ +#include "crypto_hash/keccak1600/scalar/keccak_1600.jazz" diff --git a/code/crypto_hash/sha3512/scalar/sha3512.s b/code/crypto_hash/sha3512/scalar/sha3512.s new file mode 100644 index 0000000..f79b7d1 --- /dev/null +++ b/code/crypto_hash/sha3512/scalar/sha3512.s @@ -0,0 +1,1299 @@ + .text + .p2align 5 + .globl _keccak_1600 + .globl keccak_1600 +_keccak_1600: +keccak_1600: + pushq %rbp + pushq %rbx + pushq %r12 + subq $456, %rsp + movq %rdi, 200(%rsp) + movq %rsi, 448(%rsp) + movzbq (%r8), %rax + movq %rax, 440(%rsp) + movq 8(%r8), %rax + xorl %esi, %esi + movq $0, %rdi + jmp Lkeccak_1600$20 +Lkeccak_1600$21: + movq %rsi, (%rsp,%rdi,8) + leaq 1(%rdi), %rdi +Lkeccak_1600$20: + cmpq $25, %rdi + jb Lkeccak_1600$21 + jmp Lkeccak_1600$15 +Lkeccak_1600$16: + movq %rax, %rsi + shrq $3, %rsi + movq $0, %rdi + jmp Lkeccak_1600$18 +Lkeccak_1600$19: + movq (%rdx,%rdi,8), %r8 + xorq %r8, (%rsp,%rdi,8) + leaq 1(%rdi), %rdi +Lkeccak_1600$18: + cmpq %rsi, %rdi + jb Lkeccak_1600$19 + leaq (%rdx,%rax), %rdx + subq %rax, %rcx + movq %rdx, 224(%rsp) + movq %rcx, 216(%rsp) + movq %rax, 208(%rsp) +Lkeccak_1600$17: + movq (%r9), %rax + movq %rax, 432(%rsp) + movq (%rsp), %rax + movq 8(%rsp), %rcx + movq 16(%rsp), %rdx + movq 24(%rsp), %rsi + movq 32(%rsp), %rdi + xorq 40(%rsp), %rax + xorq 48(%rsp), %rcx + xorq 56(%rsp), %rdx + xorq 64(%rsp), %rsi + xorq 72(%rsp), %rdi + xorq 80(%rsp), %rax + xorq 88(%rsp), %rcx + xorq 96(%rsp), %rdx + xorq 104(%rsp), %rsi + xorq 112(%rsp), %rdi + xorq 120(%rsp), %rax + xorq 128(%rsp), %rcx + xorq 136(%rsp), %rdx + xorq 144(%rsp), %rsi + xorq 152(%rsp), %rdi + xorq 160(%rsp), %rax + xorq 168(%rsp), %rcx + xorq 176(%rsp), %rdx + xorq 184(%rsp), %rsi + xorq 192(%rsp), %rdi + movq %rcx, %r8 + rolq $1, %r8 + xorq %rdi, %r8 + movq %rdx, %r10 + rolq $1, %r10 + xorq %rax, %r10 + movq %rsi, %r11 + rolq $1, %r11 + xorq %rcx, %r11 + movq %rdi, %rcx + rolq $1, %rcx + xorq %rdx, %rcx + rolq $1, %rax + xorq %rsi, %rax + movq (%rsp), %rdx + xorq %r8, %rdx + movq 48(%rsp), %rsi + xorq %r10, %rsi + rolq $44, %rsi + movq 96(%rsp), %rdi + xorq %r11, %rdi + rolq $43, %rdi + movq 144(%rsp), %rbp + xorq %rcx, %rbp + rolq $21, %rbp + movq 192(%rsp), %rbx + xorq %rax, %rbx + rolq $14, %rbx + andnq %rdi, %rsi, %r12 + xorq 432(%rsp), %r12 + xorq %rdx, %r12 + movq %r12, 232(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 240(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 248(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 256(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 264(%rsp) + movq 24(%rsp), %rdx + xorq %rcx, %rdx + rolq $28, %rdx + movq 72(%rsp), %rsi + xorq %rax, %rsi + rolq $20, %rsi + movq 80(%rsp), %rdi + xorq %r8, %rdi + rolq $3, %rdi + movq 128(%rsp), %rbp + xorq %r10, %rbp + rolq $45, %rbp + movq 176(%rsp), %rbx + xorq %r11, %rbx + rolq $61, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 272(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 280(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 288(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 296(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 304(%rsp) + movq 8(%rsp), %rdx + xorq %r10, %rdx + rolq $1, %rdx + movq 56(%rsp), %rsi + xorq %r11, %rsi + rolq $6, %rsi + movq 104(%rsp), %rdi + xorq %rcx, %rdi + rolq $25, %rdi + movq 152(%rsp), %rbp + xorq %rax, %rbp + rolq $8, %rbp + movq 160(%rsp), %rbx + xorq %r8, %rbx + rolq $18, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 312(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 320(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 328(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 336(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 344(%rsp) + movq 32(%rsp), %rdx + xorq %rax, %rdx + rolq $27, %rdx + movq 40(%rsp), %rsi + xorq %r8, %rsi + rolq $36, %rsi + movq 88(%rsp), %rdi + xorq %r10, %rdi + rolq $10, %rdi + movq 136(%rsp), %rbp + xorq %r11, %rbp + rolq $15, %rbp + movq 184(%rsp), %rbx + xorq %rcx, %rbx + rolq $56, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 352(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 360(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 368(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 376(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 384(%rsp) + movq 16(%rsp), %rdx + xorq %r11, %rdx + rolq $62, %rdx + movq 64(%rsp), %rsi + xorq %rcx, %rsi + rolq $55, %rsi + movq %rsi, %rcx + movq 112(%rsp), %rsi + xorq %rax, %rsi + rolq $39, %rsi + movq %rsi, %rax + movq 120(%rsp), %rsi + xorq %r8, %rsi + rolq $41, %rsi + movq 168(%rsp), %rdi + xorq %r10, %rdi + rolq $2, %rdi + andnq %rax, %rcx, %r8 + xorq %rdx, %r8 + movq %r8, 392(%rsp) + andnq %rsi, %rax, %r8 + xorq %rcx, %r8 + movq %r8, 400(%rsp) + andnq %rdi, %rsi, %r8 + xorq %rax, %r8 + movq %r8, 408(%rsp) + andnq %rdx, %rdi, %rax + xorq %rsi, %rax + movq %rax, 416(%rsp) + andnq %rcx, %rdx, %rax + xorq %rdi, %rax + movq %rax, 424(%rsp) + movq 8(%r9), %rax + movq %rax, 432(%rsp) + movq 232(%rsp), %rax + movq 240(%rsp), %rcx + movq 248(%rsp), %rdx + movq 256(%rsp), %rsi + movq 264(%rsp), %rdi + xorq 272(%rsp), %rax + xorq 280(%rsp), %rcx + xorq 288(%rsp), %rdx + xorq 296(%rsp), %rsi + xorq 304(%rsp), %rdi + xorq 312(%rsp), %rax + xorq 320(%rsp), %rcx + xorq 328(%rsp), %rdx + xorq 336(%rsp), %rsi + xorq 344(%rsp), %rdi + xorq 352(%rsp), %rax + xorq 360(%rsp), %rcx + xorq 368(%rsp), %rdx + xorq 376(%rsp), %rsi + xorq 384(%rsp), %rdi + xorq 392(%rsp), %rax + xorq 400(%rsp), %rcx + xorq 408(%rsp), %rdx + xorq 416(%rsp), %rsi + xorq 424(%rsp), %rdi + movq %rcx, %r8 + rolq $1, %r8 + xorq %rdi, %r8 + movq %rdx, %r10 + rolq $1, %r10 + xorq %rax, %r10 + movq %rsi, %r11 + rolq $1, %r11 + xorq %rcx, %r11 + movq %rdi, %rcx + rolq $1, %rcx + xorq %rdx, %rcx + rolq $1, %rax + xorq %rsi, %rax + movq 232(%rsp), %rdx + xorq %r8, %rdx + movq 280(%rsp), %rsi + xorq %r10, %rsi + rolq $44, %rsi + movq 328(%rsp), %rdi + xorq %r11, %rdi + rolq $43, %rdi + movq 376(%rsp), %rbp + xorq %rcx, %rbp + rolq $21, %rbp + movq 424(%rsp), %rbx + xorq %rax, %rbx + rolq $14, %rbx + andnq %rdi, %rsi, %r12 + xorq 432(%rsp), %r12 + xorq %rdx, %r12 + movq %r12, (%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 8(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 16(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 24(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 32(%rsp) + movq 256(%rsp), %rdx + xorq %rcx, %rdx + rolq $28, %rdx + movq 304(%rsp), %rsi + xorq %rax, %rsi + rolq $20, %rsi + movq 312(%rsp), %rdi + xorq %r8, %rdi + rolq $3, %rdi + movq 360(%rsp), %rbp + xorq %r10, %rbp + rolq $45, %rbp + movq 408(%rsp), %rbx + xorq %r11, %rbx + rolq $61, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 40(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 48(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 56(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 64(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 72(%rsp) + movq 240(%rsp), %rdx + xorq %r10, %rdx + rolq $1, %rdx + movq 288(%rsp), %rsi + xorq %r11, %rsi + rolq $6, %rsi + movq 336(%rsp), %rdi + xorq %rcx, %rdi + rolq $25, %rdi + movq 384(%rsp), %rbp + xorq %rax, %rbp + rolq $8, %rbp + movq 392(%rsp), %rbx + xorq %r8, %rbx + rolq $18, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 80(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 88(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 96(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 104(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 112(%rsp) + movq 264(%rsp), %rdx + xorq %rax, %rdx + rolq $27, %rdx + movq 272(%rsp), %rsi + xorq %r8, %rsi + rolq $36, %rsi + movq 320(%rsp), %rdi + xorq %r10, %rdi + rolq $10, %rdi + movq 368(%rsp), %rbp + xorq %r11, %rbp + rolq $15, %rbp + movq 416(%rsp), %rbx + xorq %rcx, %rbx + rolq $56, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 120(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 128(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 136(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 144(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 152(%rsp) + movq 248(%rsp), %rdx + xorq %r11, %rdx + rolq $62, %rdx + movq 296(%rsp), %rsi + xorq %rcx, %rsi + rolq $55, %rsi + movq %rsi, %rcx + movq 344(%rsp), %rsi + xorq %rax, %rsi + rolq $39, %rsi + movq %rsi, %rax + movq 352(%rsp), %rsi + xorq %r8, %rsi + rolq $41, %rsi + movq 400(%rsp), %rdi + xorq %r10, %rdi + rolq $2, %rdi + andnq %rax, %rcx, %r8 + xorq %rdx, %r8 + movq %r8, 160(%rsp) + andnq %rsi, %rax, %r8 + xorq %rcx, %r8 + movq %r8, 168(%rsp) + andnq %rdi, %rsi, %r8 + xorq %rax, %r8 + movq %r8, 176(%rsp) + andnq %rdx, %rdi, %rax + xorq %rsi, %rax + movq %rax, 184(%rsp) + andnq %rcx, %rdx, %rax + xorq %rdi, %rax + movq %rax, 192(%rsp) + leaq 16(%r9), %r9 + testb $-1, %r9b + jne Lkeccak_1600$17 + leaq -192(%r9), %r9 + movq 224(%rsp), %rdx + movq 216(%rsp), %rcx + movq 208(%rsp), %rax +Lkeccak_1600$15: + cmpq %rax, %rcx + jnb Lkeccak_1600$16 + movq 440(%rsp), %rsi + movb %sil, %sil + movq %rcx, %rdi + shrq $3, %rdi + movq $0, %r8 + jmp Lkeccak_1600$13 +Lkeccak_1600$14: + movq (%rdx,%r8,8), %r10 + xorq %r10, (%rsp,%r8,8) + leaq 1(%r8), %r8 +Lkeccak_1600$13: + cmpq %rdi, %r8 + jb Lkeccak_1600$14 + shlq $3, %r8 + jmp Lkeccak_1600$11 +Lkeccak_1600$12: + movb (%rdx,%r8), %dil + xorb %dil, (%rsp,%r8) + leaq 1(%r8), %r8 +Lkeccak_1600$11: + cmpq %rcx, %r8 + jb Lkeccak_1600$12 + xorb %sil, (%rsp,%r8) + movq %rax, %rcx + leaq -1(%rcx), %rcx + xorb $-128, (%rsp,%rcx) + movq 448(%rsp), %rdx + jmp Lkeccak_1600$6 +Lkeccak_1600$7: + movq %rdx, 448(%rsp) + movq %rax, 440(%rsp) +Lkeccak_1600$10: + movq (%r9), %rax + movq %rax, 432(%rsp) + movq (%rsp), %rax + movq 8(%rsp), %rcx + movq 16(%rsp), %rdx + movq 24(%rsp), %rsi + movq 32(%rsp), %rdi + xorq 40(%rsp), %rax + xorq 48(%rsp), %rcx + xorq 56(%rsp), %rdx + xorq 64(%rsp), %rsi + xorq 72(%rsp), %rdi + xorq 80(%rsp), %rax + xorq 88(%rsp), %rcx + xorq 96(%rsp), %rdx + xorq 104(%rsp), %rsi + xorq 112(%rsp), %rdi + xorq 120(%rsp), %rax + xorq 128(%rsp), %rcx + xorq 136(%rsp), %rdx + xorq 144(%rsp), %rsi + xorq 152(%rsp), %rdi + xorq 160(%rsp), %rax + xorq 168(%rsp), %rcx + xorq 176(%rsp), %rdx + xorq 184(%rsp), %rsi + xorq 192(%rsp), %rdi + movq %rcx, %r8 + rolq $1, %r8 + xorq %rdi, %r8 + movq %rdx, %r10 + rolq $1, %r10 + xorq %rax, %r10 + movq %rsi, %r11 + rolq $1, %r11 + xorq %rcx, %r11 + movq %rdi, %rcx + rolq $1, %rcx + xorq %rdx, %rcx + rolq $1, %rax + xorq %rsi, %rax + movq (%rsp), %rdx + xorq %r8, %rdx + movq 48(%rsp), %rsi + xorq %r10, %rsi + rolq $44, %rsi + movq 96(%rsp), %rdi + xorq %r11, %rdi + rolq $43, %rdi + movq 144(%rsp), %rbp + xorq %rcx, %rbp + rolq $21, %rbp + movq 192(%rsp), %rbx + xorq %rax, %rbx + rolq $14, %rbx + andnq %rdi, %rsi, %r12 + xorq 432(%rsp), %r12 + xorq %rdx, %r12 + movq %r12, 232(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 240(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 248(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 256(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 264(%rsp) + movq 24(%rsp), %rdx + xorq %rcx, %rdx + rolq $28, %rdx + movq 72(%rsp), %rsi + xorq %rax, %rsi + rolq $20, %rsi + movq 80(%rsp), %rdi + xorq %r8, %rdi + rolq $3, %rdi + movq 128(%rsp), %rbp + xorq %r10, %rbp + rolq $45, %rbp + movq 176(%rsp), %rbx + xorq %r11, %rbx + rolq $61, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 272(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 280(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 288(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 296(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 304(%rsp) + movq 8(%rsp), %rdx + xorq %r10, %rdx + rolq $1, %rdx + movq 56(%rsp), %rsi + xorq %r11, %rsi + rolq $6, %rsi + movq 104(%rsp), %rdi + xorq %rcx, %rdi + rolq $25, %rdi + movq 152(%rsp), %rbp + xorq %rax, %rbp + rolq $8, %rbp + movq 160(%rsp), %rbx + xorq %r8, %rbx + rolq $18, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 312(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 320(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 328(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 336(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 344(%rsp) + movq 32(%rsp), %rdx + xorq %rax, %rdx + rolq $27, %rdx + movq 40(%rsp), %rsi + xorq %r8, %rsi + rolq $36, %rsi + movq 88(%rsp), %rdi + xorq %r10, %rdi + rolq $10, %rdi + movq 136(%rsp), %rbp + xorq %r11, %rbp + rolq $15, %rbp + movq 184(%rsp), %rbx + xorq %rcx, %rbx + rolq $56, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 352(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 360(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 368(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 376(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 384(%rsp) + movq 16(%rsp), %rdx + xorq %r11, %rdx + rolq $62, %rdx + movq 64(%rsp), %rsi + xorq %rcx, %rsi + rolq $55, %rsi + movq %rsi, %rcx + movq 112(%rsp), %rsi + xorq %rax, %rsi + rolq $39, %rsi + movq %rsi, %rax + movq 120(%rsp), %rsi + xorq %r8, %rsi + rolq $41, %rsi + movq 168(%rsp), %rdi + xorq %r10, %rdi + rolq $2, %rdi + andnq %rax, %rcx, %r8 + xorq %rdx, %r8 + movq %r8, 392(%rsp) + andnq %rsi, %rax, %r8 + xorq %rcx, %r8 + movq %r8, 400(%rsp) + andnq %rdi, %rsi, %r8 + xorq %rax, %r8 + movq %r8, 408(%rsp) + andnq %rdx, %rdi, %rax + xorq %rsi, %rax + movq %rax, 416(%rsp) + andnq %rcx, %rdx, %rax + xorq %rdi, %rax + movq %rax, 424(%rsp) + movq 8(%r9), %rax + movq %rax, 432(%rsp) + movq 232(%rsp), %rax + movq 240(%rsp), %rcx + movq 248(%rsp), %rdx + movq 256(%rsp), %rsi + movq 264(%rsp), %rdi + xorq 272(%rsp), %rax + xorq 280(%rsp), %rcx + xorq 288(%rsp), %rdx + xorq 296(%rsp), %rsi + xorq 304(%rsp), %rdi + xorq 312(%rsp), %rax + xorq 320(%rsp), %rcx + xorq 328(%rsp), %rdx + xorq 336(%rsp), %rsi + xorq 344(%rsp), %rdi + xorq 352(%rsp), %rax + xorq 360(%rsp), %rcx + xorq 368(%rsp), %rdx + xorq 376(%rsp), %rsi + xorq 384(%rsp), %rdi + xorq 392(%rsp), %rax + xorq 400(%rsp), %rcx + xorq 408(%rsp), %rdx + xorq 416(%rsp), %rsi + xorq 424(%rsp), %rdi + movq %rcx, %r8 + rolq $1, %r8 + xorq %rdi, %r8 + movq %rdx, %r10 + rolq $1, %r10 + xorq %rax, %r10 + movq %rsi, %r11 + rolq $1, %r11 + xorq %rcx, %r11 + movq %rdi, %rcx + rolq $1, %rcx + xorq %rdx, %rcx + rolq $1, %rax + xorq %rsi, %rax + movq 232(%rsp), %rdx + xorq %r8, %rdx + movq 280(%rsp), %rsi + xorq %r10, %rsi + rolq $44, %rsi + movq 328(%rsp), %rdi + xorq %r11, %rdi + rolq $43, %rdi + movq 376(%rsp), %rbp + xorq %rcx, %rbp + rolq $21, %rbp + movq 424(%rsp), %rbx + xorq %rax, %rbx + rolq $14, %rbx + andnq %rdi, %rsi, %r12 + xorq 432(%rsp), %r12 + xorq %rdx, %r12 + movq %r12, (%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 8(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 16(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 24(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 32(%rsp) + movq 256(%rsp), %rdx + xorq %rcx, %rdx + rolq $28, %rdx + movq 304(%rsp), %rsi + xorq %rax, %rsi + rolq $20, %rsi + movq 312(%rsp), %rdi + xorq %r8, %rdi + rolq $3, %rdi + movq 360(%rsp), %rbp + xorq %r10, %rbp + rolq $45, %rbp + movq 408(%rsp), %rbx + xorq %r11, %rbx + rolq $61, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 40(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 48(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 56(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 64(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 72(%rsp) + movq 240(%rsp), %rdx + xorq %r10, %rdx + rolq $1, %rdx + movq 288(%rsp), %rsi + xorq %r11, %rsi + rolq $6, %rsi + movq 336(%rsp), %rdi + xorq %rcx, %rdi + rolq $25, %rdi + movq 384(%rsp), %rbp + xorq %rax, %rbp + rolq $8, %rbp + movq 392(%rsp), %rbx + xorq %r8, %rbx + rolq $18, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 80(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 88(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 96(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 104(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 112(%rsp) + movq 264(%rsp), %rdx + xorq %rax, %rdx + rolq $27, %rdx + movq 272(%rsp), %rsi + xorq %r8, %rsi + rolq $36, %rsi + movq 320(%rsp), %rdi + xorq %r10, %rdi + rolq $10, %rdi + movq 368(%rsp), %rbp + xorq %r11, %rbp + rolq $15, %rbp + movq 416(%rsp), %rbx + xorq %rcx, %rbx + rolq $56, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 120(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 128(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 136(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 144(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 152(%rsp) + movq 248(%rsp), %rdx + xorq %r11, %rdx + rolq $62, %rdx + movq 296(%rsp), %rsi + xorq %rcx, %rsi + rolq $55, %rsi + movq %rsi, %rcx + movq 344(%rsp), %rsi + xorq %rax, %rsi + rolq $39, %rsi + movq %rsi, %rax + movq 352(%rsp), %rsi + xorq %r8, %rsi + rolq $41, %rsi + movq 400(%rsp), %rdi + xorq %r10, %rdi + rolq $2, %rdi + andnq %rax, %rcx, %r8 + xorq %rdx, %r8 + movq %r8, 160(%rsp) + andnq %rsi, %rax, %r8 + xorq %rcx, %r8 + movq %r8, 168(%rsp) + andnq %rdi, %rsi, %r8 + xorq %rax, %r8 + movq %r8, 176(%rsp) + andnq %rdx, %rdi, %rax + xorq %rsi, %rax + movq %rax, 184(%rsp) + andnq %rcx, %rdx, %rax + xorq %rdi, %rax + movq %rax, 192(%rsp) + leaq 16(%r9), %r9 + testb $-1, %r9b + jne Lkeccak_1600$10 + leaq -192(%r9), %r9 + movq 200(%rsp), %rcx + movq 448(%rsp), %rdx + movq 440(%rsp), %rax + movq %rax, %rsi + shrq $3, %rsi + movq $0, %rdi + jmp Lkeccak_1600$8 +Lkeccak_1600$9: + movq (%rsp,%rdi,8), %r8 + movq %r8, (%rcx,%rdi,8) + leaq 1(%rdi), %rdi +Lkeccak_1600$8: + cmpq %rsi, %rdi + jb Lkeccak_1600$9 + leaq (%rcx,%rax), %rcx + subq %rax, %rdx + movq %rcx, 200(%rsp) +Lkeccak_1600$6: + cmpq %rax, %rdx + jnbe Lkeccak_1600$7 + movq %rdx, 440(%rsp) +Lkeccak_1600$5: + movq (%r9), %rax + movq %rax, 448(%rsp) + movq (%rsp), %rax + movq 8(%rsp), %rcx + movq 16(%rsp), %rdx + movq 24(%rsp), %rsi + movq 32(%rsp), %rdi + xorq 40(%rsp), %rax + xorq 48(%rsp), %rcx + xorq 56(%rsp), %rdx + xorq 64(%rsp), %rsi + xorq 72(%rsp), %rdi + xorq 80(%rsp), %rax + xorq 88(%rsp), %rcx + xorq 96(%rsp), %rdx + xorq 104(%rsp), %rsi + xorq 112(%rsp), %rdi + xorq 120(%rsp), %rax + xorq 128(%rsp), %rcx + xorq 136(%rsp), %rdx + xorq 144(%rsp), %rsi + xorq 152(%rsp), %rdi + xorq 160(%rsp), %rax + xorq 168(%rsp), %rcx + xorq 176(%rsp), %rdx + xorq 184(%rsp), %rsi + xorq 192(%rsp), %rdi + movq %rcx, %r8 + rolq $1, %r8 + xorq %rdi, %r8 + movq %rdx, %r10 + rolq $1, %r10 + xorq %rax, %r10 + movq %rsi, %r11 + rolq $1, %r11 + xorq %rcx, %r11 + movq %rdi, %rcx + rolq $1, %rcx + xorq %rdx, %rcx + rolq $1, %rax + xorq %rsi, %rax + movq (%rsp), %rdx + xorq %r8, %rdx + movq 48(%rsp), %rsi + xorq %r10, %rsi + rolq $44, %rsi + movq 96(%rsp), %rdi + xorq %r11, %rdi + rolq $43, %rdi + movq 144(%rsp), %rbp + xorq %rcx, %rbp + rolq $21, %rbp + movq 192(%rsp), %rbx + xorq %rax, %rbx + rolq $14, %rbx + andnq %rdi, %rsi, %r12 + xorq 448(%rsp), %r12 + xorq %rdx, %r12 + movq %r12, 232(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 240(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 248(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 256(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 264(%rsp) + movq 24(%rsp), %rdx + xorq %rcx, %rdx + rolq $28, %rdx + movq 72(%rsp), %rsi + xorq %rax, %rsi + rolq $20, %rsi + movq 80(%rsp), %rdi + xorq %r8, %rdi + rolq $3, %rdi + movq 128(%rsp), %rbp + xorq %r10, %rbp + rolq $45, %rbp + movq 176(%rsp), %rbx + xorq %r11, %rbx + rolq $61, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 272(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 280(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 288(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 296(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 304(%rsp) + movq 8(%rsp), %rdx + xorq %r10, %rdx + rolq $1, %rdx + movq 56(%rsp), %rsi + xorq %r11, %rsi + rolq $6, %rsi + movq 104(%rsp), %rdi + xorq %rcx, %rdi + rolq $25, %rdi + movq 152(%rsp), %rbp + xorq %rax, %rbp + rolq $8, %rbp + movq 160(%rsp), %rbx + xorq %r8, %rbx + rolq $18, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 312(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 320(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 328(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 336(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 344(%rsp) + movq 32(%rsp), %rdx + xorq %rax, %rdx + rolq $27, %rdx + movq 40(%rsp), %rsi + xorq %r8, %rsi + rolq $36, %rsi + movq 88(%rsp), %rdi + xorq %r10, %rdi + rolq $10, %rdi + movq 136(%rsp), %rbp + xorq %r11, %rbp + rolq $15, %rbp + movq 184(%rsp), %rbx + xorq %rcx, %rbx + rolq $56, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 352(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 360(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 368(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 376(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 384(%rsp) + movq 16(%rsp), %rdx + xorq %r11, %rdx + rolq $62, %rdx + movq 64(%rsp), %rsi + xorq %rcx, %rsi + rolq $55, %rsi + movq %rsi, %rcx + movq 112(%rsp), %rsi + xorq %rax, %rsi + rolq $39, %rsi + movq %rsi, %rax + movq 120(%rsp), %rsi + xorq %r8, %rsi + rolq $41, %rsi + movq 168(%rsp), %rdi + xorq %r10, %rdi + rolq $2, %rdi + andnq %rax, %rcx, %r8 + xorq %rdx, %r8 + movq %r8, 392(%rsp) + andnq %rsi, %rax, %r8 + xorq %rcx, %r8 + movq %r8, 400(%rsp) + andnq %rdi, %rsi, %r8 + xorq %rax, %r8 + movq %r8, 408(%rsp) + andnq %rdx, %rdi, %rax + xorq %rsi, %rax + movq %rax, 416(%rsp) + andnq %rcx, %rdx, %rax + xorq %rdi, %rax + movq %rax, 424(%rsp) + movq 8(%r9), %rax + movq %rax, 448(%rsp) + movq 232(%rsp), %rax + movq 240(%rsp), %rcx + movq 248(%rsp), %rdx + movq 256(%rsp), %rsi + movq 264(%rsp), %rdi + xorq 272(%rsp), %rax + xorq 280(%rsp), %rcx + xorq 288(%rsp), %rdx + xorq 296(%rsp), %rsi + xorq 304(%rsp), %rdi + xorq 312(%rsp), %rax + xorq 320(%rsp), %rcx + xorq 328(%rsp), %rdx + xorq 336(%rsp), %rsi + xorq 344(%rsp), %rdi + xorq 352(%rsp), %rax + xorq 360(%rsp), %rcx + xorq 368(%rsp), %rdx + xorq 376(%rsp), %rsi + xorq 384(%rsp), %rdi + xorq 392(%rsp), %rax + xorq 400(%rsp), %rcx + xorq 408(%rsp), %rdx + xorq 416(%rsp), %rsi + xorq 424(%rsp), %rdi + movq %rcx, %r8 + rolq $1, %r8 + xorq %rdi, %r8 + movq %rdx, %r10 + rolq $1, %r10 + xorq %rax, %r10 + movq %rsi, %r11 + rolq $1, %r11 + xorq %rcx, %r11 + movq %rdi, %rcx + rolq $1, %rcx + xorq %rdx, %rcx + rolq $1, %rax + xorq %rsi, %rax + movq 232(%rsp), %rdx + xorq %r8, %rdx + movq 280(%rsp), %rsi + xorq %r10, %rsi + rolq $44, %rsi + movq 328(%rsp), %rdi + xorq %r11, %rdi + rolq $43, %rdi + movq 376(%rsp), %rbp + xorq %rcx, %rbp + rolq $21, %rbp + movq 424(%rsp), %rbx + xorq %rax, %rbx + rolq $14, %rbx + andnq %rdi, %rsi, %r12 + xorq 448(%rsp), %r12 + xorq %rdx, %r12 + movq %r12, (%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 8(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 16(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 24(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 32(%rsp) + movq 256(%rsp), %rdx + xorq %rcx, %rdx + rolq $28, %rdx + movq 304(%rsp), %rsi + xorq %rax, %rsi + rolq $20, %rsi + movq 312(%rsp), %rdi + xorq %r8, %rdi + rolq $3, %rdi + movq 360(%rsp), %rbp + xorq %r10, %rbp + rolq $45, %rbp + movq 408(%rsp), %rbx + xorq %r11, %rbx + rolq $61, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 40(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 48(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 56(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 64(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 72(%rsp) + movq 240(%rsp), %rdx + xorq %r10, %rdx + rolq $1, %rdx + movq 288(%rsp), %rsi + xorq %r11, %rsi + rolq $6, %rsi + movq 336(%rsp), %rdi + xorq %rcx, %rdi + rolq $25, %rdi + movq 384(%rsp), %rbp + xorq %rax, %rbp + rolq $8, %rbp + movq 392(%rsp), %rbx + xorq %r8, %rbx + rolq $18, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 80(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 88(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 96(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 104(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 112(%rsp) + movq 264(%rsp), %rdx + xorq %rax, %rdx + rolq $27, %rdx + movq 272(%rsp), %rsi + xorq %r8, %rsi + rolq $36, %rsi + movq 320(%rsp), %rdi + xorq %r10, %rdi + rolq $10, %rdi + movq 368(%rsp), %rbp + xorq %r11, %rbp + rolq $15, %rbp + movq 416(%rsp), %rbx + xorq %rcx, %rbx + rolq $56, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 120(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 128(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 136(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 144(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 152(%rsp) + movq 248(%rsp), %rdx + xorq %r11, %rdx + rolq $62, %rdx + movq 296(%rsp), %rsi + xorq %rcx, %rsi + rolq $55, %rsi + movq %rsi, %rcx + movq 344(%rsp), %rsi + xorq %rax, %rsi + rolq $39, %rsi + movq %rsi, %rax + movq 352(%rsp), %rsi + xorq %r8, %rsi + rolq $41, %rsi + movq 400(%rsp), %rdi + xorq %r10, %rdi + rolq $2, %rdi + andnq %rax, %rcx, %r8 + xorq %rdx, %r8 + movq %r8, 160(%rsp) + andnq %rsi, %rax, %r8 + xorq %rcx, %r8 + movq %r8, 168(%rsp) + andnq %rdi, %rsi, %r8 + xorq %rax, %r8 + movq %r8, 176(%rsp) + andnq %rdx, %rdi, %rax + xorq %rsi, %rax + movq %rax, 184(%rsp) + andnq %rcx, %rdx, %rax + xorq %rdi, %rax + movq %rax, 192(%rsp) + leaq 16(%r9), %r9 + testb $-1, %r9b + jne Lkeccak_1600$5 + movq 200(%rsp), %rax + movq 440(%rsp), %rcx + movq %rcx, %rdx + shrq $3, %rdx + movq $0, %rsi + jmp Lkeccak_1600$3 +Lkeccak_1600$4: + movq (%rsp,%rsi,8), %rdi + movq %rdi, (%rax,%rsi,8) + leaq 1(%rsi), %rsi +Lkeccak_1600$3: + cmpq %rdx, %rsi + jb Lkeccak_1600$4 + shlq $3, %rsi + jmp Lkeccak_1600$1 +Lkeccak_1600$2: + movb (%rsp,%rsi), %dl + movb %dl, (%rax,%rsi) + leaq 1(%rsi), %rsi +Lkeccak_1600$1: + cmpq %rcx, %rsi + jb Lkeccak_1600$2 + addq $456, %rsp + popq %r12 + popq %rbx + popq %rbp + ret diff --git a/code/crypto_hash/shake128/.gitignore b/code/crypto_hash/shake128/.gitignore new file mode 100644 index 0000000..ad1a23f --- /dev/null +++ b/code/crypto_hash/shake128/.gitignore @@ -0,0 +1 @@ +*.japp diff --git a/code/crypto_hash/shake128/avx2/Makefile b/code/crypto_hash/shake128/avx2/Makefile new file mode 100644 index 0000000..1f3e979 --- /dev/null +++ b/code/crypto_hash/shake128/avx2/Makefile @@ -0,0 +1,15 @@ +# -*- Makefile -*- + +.PHONY: default clean + +default: shake128.japp shake128.s + @true + +clean: + rm -f shake128.japp shake128.s + +%.s: %.japp + jasminc -lea -pasm $< > $@ || rm -f $@ + +%.japp: %.jazz + gpp -I../../../ -o $@ $< diff --git a/code/crypto_hash/shake128/avx2/shake128-m.c b/code/crypto_hash/shake128/avx2/shake128-m.c new file mode 100644 index 0000000..be0d414 --- /dev/null +++ b/code/crypto_hash/shake128/avx2/shake128-m.c @@ -0,0 +1,85 @@ +#include "crypto_hash.h" +#include "impl.h" +#include "api.h" +#include +#include + + +extern void keccak_1600( + uint8_t *out, + uint64_t outlen, + const uint8_t *in, + size_t inlen, + uint64_t *c, + uint64_t **g +); + + +uint64_t rhotates_left[6*4] __attribute__((aligned(32))) = +{ + 3, 18, 36, 41, + 1, 62, 28, 27, + 45, 6, 56, 39, + 10, 61, 55, 8, + 2, 15, 25, 20, + 44, 43, 21, 14 +}; + + +uint64_t rhotates_right[6*4] __attribute__((aligned(32))) = +{ + 64-3, 64-18, 64-36, 64-41, + 64-1, 64-62, 64-28, 64-27, + 64-45, 64-6, 64-56, 64-39, + 64-10, 64-61, 64-55, 64-8, + 64-2, 64-15, 64-25, 64-20, + 64-44, 64-43, 64-21, 64-14 +}; + + +uint64_t iotas[24*4] __attribute__((aligned(32))) = +{ + 0x0000000000000001UL, 0x0000000000000001UL, 0x0000000000000001UL, 0x0000000000000001UL, + 0x0000000000008082UL, 0x0000000000008082UL, 0x0000000000008082UL, 0x0000000000008082UL, + 0x800000000000808aUL, 0x800000000000808aUL, 0x800000000000808aUL, 0x800000000000808aUL, + 0x8000000080008000UL, 0x8000000080008000UL, 0x8000000080008000UL, 0x8000000080008000UL, + 0x000000000000808bUL, 0x000000000000808bUL, 0x000000000000808bUL, 0x000000000000808bUL, + 0x0000000080000001UL, 0x0000000080000001UL, 0x0000000080000001UL, 0x0000000080000001UL, + 0x8000000080008081UL, 0x8000000080008081UL, 0x8000000080008081UL, 0x8000000080008081UL, + 0x8000000000008009UL, 0x8000000000008009UL, 0x8000000000008009UL, 0x8000000000008009UL, + 0x000000000000008aUL, 0x000000000000008aUL, 0x000000000000008aUL, 0x000000000000008aUL, + 0x0000000000000088UL, 0x0000000000000088UL, 0x0000000000000088UL, 0x0000000000000088UL, + 0x0000000080008009UL, 0x0000000080008009UL, 0x0000000080008009UL, 0x0000000080008009UL, + 0x000000008000000aUL, 0x000000008000000aUL, 0x000000008000000aUL, 0x000000008000000aUL, + 0x000000008000808bUL, 0x000000008000808bUL, 0x000000008000808bUL, 0x000000008000808bUL, + 0x800000000000008bUL, 0x800000000000008bUL, 0x800000000000008bUL, 0x800000000000008bUL, + 0x8000000000008089UL, 0x8000000000008089UL, 0x8000000000008089UL, 0x8000000000008089UL, + 0x8000000000008003UL, 0x8000000000008003UL, 0x8000000000008003UL, 0x8000000000008003UL, + 0x8000000000008002UL, 0x8000000000008002UL, 0x8000000000008002UL, 0x8000000000008002UL, + 0x8000000000000080UL, 0x8000000000000080UL, 0x8000000000000080UL, 0x8000000000000080UL, + 0x000000000000800aUL, 0x000000000000800aUL, 0x000000000000800aUL, 0x000000000000800aUL, + 0x800000008000000aUL, 0x800000008000000aUL, 0x800000008000000aUL, 0x800000008000000aUL, + 0x8000000080008081UL, 0x8000000080008081UL, 0x8000000080008081UL, 0x8000000080008081UL, + 0x8000000000008080UL, 0x8000000000008080UL, 0x8000000000008080UL, 0x8000000000008080UL, + 0x0000000080000001UL, 0x0000000080000001UL, 0x0000000080000001UL, 0x0000000080000001UL, + 0x8000000080008008UL, 0x8000000080008008UL, 0x8000000080008008UL, 0x8000000080008008UL +}; + + +uint64_t a_jagged[25] __attribute__((aligned(32))) = +{ + 0, 4, 5, 6, 7, + 10, 24, 13, 18, 23, + 8, 16, 25, 22, 15, + 11, 12, 21, 26, 19, + 9, 20, 17, 14, 27 +}; + + +int shake128_avx2(unsigned char *out,const unsigned char *in,unsigned long long inlen) +{ + uint64_t *g[] = {rhotates_left, rhotates_right, iotas, a_jagged}; + uint64_t c[] = {0x1F, (1344/8)}; + keccak_1600(out, 168, in, inlen, c, g); + return 0; +} diff --git a/code/crypto_hash/shake128/avx2/shake128.jazz b/code/crypto_hash/shake128/avx2/shake128.jazz new file mode 100644 index 0000000..2c2c332 --- /dev/null +++ b/code/crypto_hash/shake128/avx2/shake128.jazz @@ -0,0 +1,67 @@ +#define KECCAK_1600_ADD_FULL_BLOCK_IMPLEMENTATION 1 + +u64 s_zero = 0; + +fn add_full_block( + reg u256[7] state, + stack u64[28] s_state, + reg u64 a_jagged, + reg u64 in inlen, + reg u64 rate +) -> reg u256[7], stack u64[28], reg u64, reg u64 +{ + reg u256 a00 a01 a11 a21 a31 a32; + reg u256 t11 t41 t31 t21; + reg u256 zero; + reg u64 r10 r20 r30 r40; + stack u64[4] s20; + + r10 = [in + 8*5]; + r20 = [in + 8*10]; + r30 = [in + 8*15]; + r40 = [in + 8*20]; + + s20[0] = r20; + s20[1] = r40; + s20[2] = r10; + s20[3] = r30; + + a00 = #x86_VPBROADCAST_4u64([in + 8*0]); // (0,0) (0,0) (0,0) (0,0) + a01 = (u256)[in + 8*1]; // (0,4) (0,3) (0,2) (0,1) + + state[0] ^= a00; + state[1] ^= a01; + state[2] ^= s20[u256 0]; + + zero = #x86_VPBROADCAST_4u64(s_zero); + + a11 = (u256)[in + 8*6 ]; // (1,4) (1,3) (1,2) (1,1) + a21 = (u256)[in + 8*11]; // (2,4) (2,3) (2,2) (2,1) + a31 = (u256)[in + 8*16]; // (3,4) (3,3) (3,2) (3,1) + + a32 = #x86_VPBLENDD_256(a31, zero, (8u1)[1,1,0,0,0,0,1,1]); // ___ (3,3) (3,2) ___ + a31 = #x86_VPBLENDD_256(a31, zero, (8u1)[0,0,1,1,1,1,0,0]); // (3,4) ___ ___ (3,1) + + t41 = #x86_VPBLENDD_256(a21, a11, (8u1)[1,1,0,0,0,0,1,1]); // (1,4) (2,3) (2,2) (1,1) + t31 = #x86_VPBLENDD_256(a21, a11, (8u1)[0,0,1,1,1,1,0,0]); // (2,4) (1,3) (1,2) (2,1) + + + t11 = #x86_VPBLENDD_256(t41, a32, (8u1)[1,1,1,1,0,0,0,0]); // ___ (3,3) (2,2) (1,1) + t21 = #x86_VPBLENDD_256(t31, a31, (8u1)[1,1,0,0,1,1,0,0]); // (3,4) (1,3) ___ (2,1) + t31 = #x86_VPBLENDD_256(t31, a31, (8u1)[0,0,1,1,0,0,1,1]); // (2,4) ___ (1,2) (3,1) + + state[6] ^= t11; + + t41 = #x86_VPBLENDD_256(t41, a32, (8u1)[0,0,0,0,1,1,1,1]); // (1,4) (2,3) (3,2) ___ + + state[4] ^= t21; + state[3] ^= t31; + state[5] ^= t41; + + in += rate; + inlen -= rate; + + return state, s_state, in, inlen; +} + +#include "crypto_hash/keccak1600/avx2/keccak_1600.jazz" diff --git a/code/crypto_hash/shake128/avx2/shake128.s b/code/crypto_hash/shake128/avx2/shake128.s new file mode 100644 index 0000000..12684b5 --- /dev/null +++ b/code/crypto_hash/shake128/avx2/shake128.s @@ -0,0 +1,533 @@ + .text + .p2align 5 + .globl _keccak_1600 + .globl keccak_1600 +_keccak_1600: +keccak_1600: + pushq %rbp + pushq %rbx + pushq %r12 + pushq %r13 + pushq %r14 + subq $256, %rsp + movb (%r8), %al + movq 8(%r8), %r8 + movq (%r9), %r10 + movq 8(%r9), %r11 + movq 16(%r9), %rbp + movq 24(%r9), %r9 + vpbroadcastq g_zero(%rip), %ymm2 + vmovdqu %ymm2, %ymm3 + vmovdqu %ymm2, %ymm4 + vmovdqu %ymm2, %ymm11 + vmovdqu %ymm2, %ymm10 + vmovdqu %ymm2, %ymm12 + vmovdqu %ymm2, %ymm9 + jmp Lkeccak_1600$15 +Lkeccak_1600$16: + movq 40(%rdx), %rbx + movq 80(%rdx), %r12 + movq 120(%rdx), %r13 + movq 160(%rdx), %r14 + movq %r12, 224(%rsp) + movq %r14, 232(%rsp) + movq %rbx, 240(%rsp) + movq %r13, 248(%rsp) + vpbroadcastq (%rdx), %ymm0 + vmovdqu 8(%rdx), %ymm1 + vpxor %ymm0, %ymm2, %ymm2 + vpxor %ymm1, %ymm3, %ymm3 + vpxor 224(%rsp), %ymm4, %ymm4 + vpbroadcastq s_zero(%rip), %ymm0 + vmovdqu 48(%rdx), %ymm1 + vmovdqu 88(%rdx), %ymm5 + vmovdqu 128(%rdx), %ymm6 + vpblendd $-61, %ymm0, %ymm6, %ymm7 + vpblendd $60, %ymm0, %ymm6, %ymm0 + vpblendd $-61, %ymm1, %ymm5, %ymm6 + vpblendd $60, %ymm1, %ymm5, %ymm1 + vpblendd $-16, %ymm7, %ymm6, %ymm5 + vpblendd $-52, %ymm0, %ymm1, %ymm8 + vpblendd $51, %ymm0, %ymm1, %ymm0 + vpxor %ymm5, %ymm9, %ymm9 + vpblendd $15, %ymm7, %ymm6, %ymm1 + vpxor %ymm8, %ymm10, %ymm10 + vpxor %ymm0, %ymm11, %ymm11 + vpxor %ymm1, %ymm12, %ymm12 + leaq (%rdx,%r8), %rdx + subq %r8, %rcx + leaq 96(%r10), %rbx + leaq 96(%r11), %r12 + movq %rbp, %r13 + movl $24, %r14d + .p2align 5 +Lkeccak_1600$17: + vpshufd $78, %ymm4, %ymm0 + vpxor %ymm11, %ymm12, %ymm1 + vpxor %ymm9, %ymm10, %ymm5 + vpxor %ymm3, %ymm1, %ymm1 + vpxor %ymm5, %ymm1, %ymm1 + vpermq $-109, %ymm1, %ymm5 + vpxor %ymm4, %ymm0, %ymm0 + vpermq $78, %ymm0, %ymm6 + vpsrlq $63, %ymm1, %ymm7 + vpaddq %ymm1, %ymm1, %ymm1 + vpor %ymm1, %ymm7, %ymm1 + vpermq $57, %ymm1, %ymm7 + vpxor %ymm5, %ymm1, %ymm1 + vpermq $0, %ymm1, %ymm1 + vpxor %ymm2, %ymm0, %ymm0 + vpxor %ymm6, %ymm0, %ymm0 + vpsrlq $63, %ymm0, %ymm6 + vpaddq %ymm0, %ymm0, %ymm8 + vpor %ymm6, %ymm8, %ymm6 + vpxor %ymm1, %ymm4, %ymm4 + vpxor %ymm1, %ymm2, %ymm1 + vpblendd $-64, %ymm6, %ymm7, %ymm2 + vpblendd $3, %ymm0, %ymm5, %ymm0 + vpxor %ymm0, %ymm2, %ymm0 + vpsllvq -96(%rbx), %ymm4, %ymm2 + vpsrlvq -96(%r12), %ymm4, %ymm4 + vpor %ymm2, %ymm4, %ymm2 + vpxor %ymm0, %ymm11, %ymm4 + vpsllvq -32(%rbx), %ymm4, %ymm5 + vpsrlvq -32(%r12), %ymm4, %ymm4 + vpor %ymm5, %ymm4, %ymm4 + vpxor %ymm0, %ymm10, %ymm5 + vpsllvq (%rbx), %ymm5, %ymm6 + vpsrlvq (%r12), %ymm5, %ymm5 + vpor %ymm6, %ymm5, %ymm5 + vpxor %ymm0, %ymm12, %ymm6 + vpsllvq 32(%rbx), %ymm6, %ymm7 + vpsrlvq 32(%r12), %ymm6, %ymm6 + vpor %ymm7, %ymm6, %ymm6 + vpxor %ymm0, %ymm9, %ymm7 + vpermq $-115, %ymm2, %ymm2 + vpermq $-115, %ymm4, %ymm8 + vpsllvq 64(%rbx), %ymm7, %ymm4 + vpsrlvq 64(%r12), %ymm7, %ymm7 + vpor %ymm4, %ymm7, %ymm7 + vpxor %ymm0, %ymm3, %ymm0 + vpermq $27, %ymm5, %ymm3 + vpermq $114, %ymm6, %ymm5 + vpsllvq -64(%rbx), %ymm0, %ymm4 + vpsrlvq -64(%r12), %ymm0, %ymm0 + vpor %ymm4, %ymm0, %ymm0 + vpsrldq $8, %ymm7, %ymm4 + vpandn %ymm4, %ymm7, %ymm6 + vpblendd $12, %ymm5, %ymm0, %ymm4 + vpblendd $12, %ymm0, %ymm8, %ymm9 + vpblendd $12, %ymm8, %ymm2, %ymm10 + vpblendd $12, %ymm2, %ymm0, %ymm11 + vpblendd $48, %ymm8, %ymm4, %ymm4 + vpblendd $48, %ymm3, %ymm9, %ymm9 + vpblendd $48, %ymm0, %ymm10, %ymm10 + vpblendd $48, %ymm5, %ymm11, %ymm11 + vpblendd $-64, %ymm3, %ymm4, %ymm4 + vpblendd $-64, %ymm5, %ymm9, %ymm9 + vpblendd $-64, %ymm5, %ymm10, %ymm10 + vpblendd $-64, %ymm8, %ymm11, %ymm11 + vpandn %ymm9, %ymm4, %ymm4 + vpandn %ymm11, %ymm10, %ymm9 + vpblendd $12, %ymm0, %ymm3, %ymm10 + vpblendd $12, %ymm3, %ymm2, %ymm11 + vpxor %ymm2, %ymm4, %ymm12 + vpblendd $48, %ymm2, %ymm10, %ymm4 + vpblendd $48, %ymm8, %ymm11, %ymm10 + vpxor %ymm3, %ymm9, %ymm9 + vpblendd $-64, %ymm8, %ymm4, %ymm4 + vpblendd $-64, %ymm0, %ymm10, %ymm10 + vpandn %ymm10, %ymm4, %ymm4 + vpxor %ymm5, %ymm4, %ymm10 + vpermq $30, %ymm7, %ymm4 + vpblendd $48, %ymm1, %ymm4, %ymm4 + vpermq $57, %ymm7, %ymm11 + vpblendd $-64, %ymm1, %ymm11, %ymm11 + vpandn %ymm4, %ymm11, %ymm13 + vpblendd $12, %ymm3, %ymm8, %ymm4 + vpblendd $12, %ymm8, %ymm5, %ymm11 + vpblendd $48, %ymm5, %ymm4, %ymm4 + vpblendd $48, %ymm2, %ymm11, %ymm11 + vpblendd $-64, %ymm2, %ymm4, %ymm4 + vpblendd $-64, %ymm3, %ymm11, %ymm11 + vpandn %ymm11, %ymm4, %ymm4 + vpxor %ymm0, %ymm4, %ymm4 + vpermq $0, %ymm6, %ymm6 + vpermq $27, %ymm12, %ymm11 + vpermq $-115, %ymm9, %ymm12 + vpermq $114, %ymm10, %ymm9 + vpblendd $12, %ymm2, %ymm5, %ymm10 + vpblendd $12, %ymm5, %ymm3, %ymm5 + vpblendd $48, %ymm3, %ymm10, %ymm3 + vpblendd $48, %ymm0, %ymm5, %ymm5 + vpblendd $-64, %ymm0, %ymm3, %ymm0 + vpblendd $-64, %ymm2, %ymm5, %ymm2 + vpandn %ymm2, %ymm0, %ymm0 + vpxor %ymm6, %ymm1, %ymm1 + vpxor %ymm7, %ymm13, %ymm3 + vpxor %ymm8, %ymm0, %ymm10 + vpxor (%r13), %ymm1, %ymm2 + leaq 32(%r13), %r13 + decl %r14d + jne Lkeccak_1600$17 +Lkeccak_1600$15: + cmpq %r8, %rcx + jnb Lkeccak_1600$16 + vpbroadcastq g_zero(%rip), %ymm0 + vmovdqu %ymm0, (%rsp) + vmovdqu %ymm0, 32(%rsp) + vmovdqu %ymm0, 64(%rsp) + vmovdqu %ymm0, 96(%rsp) + vmovdqu %ymm0, 128(%rsp) + vmovdqu %ymm0, 160(%rsp) + vmovdqu %ymm0, 192(%rsp) + movq %rcx, %rbx + shrq $3, %rbx + movq $0, %r12 + jmp Lkeccak_1600$13 +Lkeccak_1600$14: + movq (%rdx,%r12,8), %r13 + movq (%r9,%r12,8), %r14 + movq %r13, (%rsp,%r14,8) + leaq 1(%r12), %r12 +Lkeccak_1600$13: + cmpq %rbx, %r12 + jb Lkeccak_1600$14 + movq (%r9,%r12,8), %rbx + shlq $3, %rbx + shlq $3, %r12 + jmp Lkeccak_1600$11 +Lkeccak_1600$12: + movb (%rdx,%r12), %r13b + movb %r13b, (%rsp,%rbx) + leaq 1(%r12), %r12 + leaq 1(%rbx), %rbx +Lkeccak_1600$11: + cmpq %rcx, %r12 + jb Lkeccak_1600$12 + movb %al, (%rsp,%rbx) + movq %r8, %rax + leaq -1(%rax), %rax + shrq $3, %rax + movq (%r9,%rax,8), %rax + shlq $3, %rax + movq %r8, %rcx + leaq -1(%rcx), %rcx + andq $7, %rcx + leaq (%rax,%rcx), %rax + xorb $-128, (%rsp,%rax) + movq (%rsp), %rax + movq %rax, 8(%rsp) + movq %rax, 16(%rsp) + movq %rax, 24(%rsp) + vpxor (%rsp), %ymm2, %ymm0 + vpxor 32(%rsp), %ymm3, %ymm1 + vpxor 64(%rsp), %ymm4, %ymm2 + vpxor 96(%rsp), %ymm11, %ymm3 + vpxor 128(%rsp), %ymm10, %ymm4 + vpxor 160(%rsp), %ymm12, %ymm5 + vpxor 192(%rsp), %ymm9, %ymm6 + jmp Lkeccak_1600$6 +Lkeccak_1600$7: + leaq 96(%r10), %rax + leaq 96(%r11), %rcx + movq %rbp, %rdx + movl $24, %ebx + .p2align 5 +Lkeccak_1600$10: + vpshufd $78, %ymm2, %ymm7 + vpxor %ymm3, %ymm5, %ymm8 + vpxor %ymm6, %ymm4, %ymm9 + vpxor %ymm1, %ymm8, %ymm8 + vpxor %ymm9, %ymm8, %ymm8 + vpermq $-109, %ymm8, %ymm9 + vpxor %ymm2, %ymm7, %ymm7 + vpermq $78, %ymm7, %ymm10 + vpsrlq $63, %ymm8, %ymm11 + vpaddq %ymm8, %ymm8, %ymm8 + vpor %ymm8, %ymm11, %ymm8 + vpermq $57, %ymm8, %ymm11 + vpxor %ymm9, %ymm8, %ymm8 + vpermq $0, %ymm8, %ymm8 + vpxor %ymm0, %ymm7, %ymm7 + vpxor %ymm10, %ymm7, %ymm7 + vpsrlq $63, %ymm7, %ymm10 + vpaddq %ymm7, %ymm7, %ymm12 + vpor %ymm10, %ymm12, %ymm10 + vpxor %ymm8, %ymm2, %ymm2 + vpxor %ymm8, %ymm0, %ymm0 + vpblendd $-64, %ymm10, %ymm11, %ymm8 + vpblendd $3, %ymm7, %ymm9, %ymm7 + vpxor %ymm7, %ymm8, %ymm7 + vpsllvq -96(%rax), %ymm2, %ymm8 + vpsrlvq -96(%rcx), %ymm2, %ymm2 + vpor %ymm8, %ymm2, %ymm2 + vpxor %ymm7, %ymm3, %ymm3 + vpsllvq -32(%rax), %ymm3, %ymm8 + vpsrlvq -32(%rcx), %ymm3, %ymm3 + vpor %ymm8, %ymm3, %ymm3 + vpxor %ymm7, %ymm4, %ymm4 + vpsllvq (%rax), %ymm4, %ymm8 + vpsrlvq (%rcx), %ymm4, %ymm4 + vpor %ymm8, %ymm4, %ymm4 + vpxor %ymm7, %ymm5, %ymm5 + vpsllvq 32(%rax), %ymm5, %ymm8 + vpsrlvq 32(%rcx), %ymm5, %ymm5 + vpor %ymm8, %ymm5, %ymm5 + vpxor %ymm7, %ymm6, %ymm6 + vpermq $-115, %ymm2, %ymm8 + vpermq $-115, %ymm3, %ymm9 + vpsllvq 64(%rax), %ymm6, %ymm2 + vpsrlvq 64(%rcx), %ymm6, %ymm3 + vpor %ymm2, %ymm3, %ymm10 + vpxor %ymm7, %ymm1, %ymm1 + vpermq $27, %ymm4, %ymm4 + vpermq $114, %ymm5, %ymm7 + vpsllvq -64(%rax), %ymm1, %ymm2 + vpsrlvq -64(%rcx), %ymm1, %ymm1 + vpor %ymm2, %ymm1, %ymm1 + vpsrldq $8, %ymm10, %ymm2 + vpandn %ymm2, %ymm10, %ymm3 + vpblendd $12, %ymm7, %ymm1, %ymm2 + vpblendd $12, %ymm1, %ymm9, %ymm5 + vpblendd $12, %ymm9, %ymm8, %ymm6 + vpblendd $12, %ymm8, %ymm1, %ymm11 + vpblendd $48, %ymm9, %ymm2, %ymm2 + vpblendd $48, %ymm4, %ymm5, %ymm5 + vpblendd $48, %ymm1, %ymm6, %ymm6 + vpblendd $48, %ymm7, %ymm11, %ymm11 + vpblendd $-64, %ymm4, %ymm2, %ymm2 + vpblendd $-64, %ymm7, %ymm5, %ymm5 + vpblendd $-64, %ymm7, %ymm6, %ymm6 + vpblendd $-64, %ymm9, %ymm11, %ymm11 + vpandn %ymm5, %ymm2, %ymm2 + vpandn %ymm11, %ymm6, %ymm5 + vpblendd $12, %ymm1, %ymm4, %ymm6 + vpblendd $12, %ymm4, %ymm8, %ymm11 + vpxor %ymm8, %ymm2, %ymm12 + vpblendd $48, %ymm8, %ymm6, %ymm2 + vpblendd $48, %ymm9, %ymm11, %ymm6 + vpxor %ymm4, %ymm5, %ymm5 + vpblendd $-64, %ymm9, %ymm2, %ymm2 + vpblendd $-64, %ymm1, %ymm6, %ymm6 + vpandn %ymm6, %ymm2, %ymm2 + vpxor %ymm7, %ymm2, %ymm6 + vpermq $30, %ymm10, %ymm2 + vpblendd $48, %ymm0, %ymm2, %ymm2 + vpermq $57, %ymm10, %ymm11 + vpblendd $-64, %ymm0, %ymm11, %ymm11 + vpandn %ymm2, %ymm11, %ymm11 + vpblendd $12, %ymm4, %ymm9, %ymm2 + vpblendd $12, %ymm9, %ymm7, %ymm13 + vpblendd $48, %ymm7, %ymm2, %ymm2 + vpblendd $48, %ymm8, %ymm13, %ymm13 + vpblendd $-64, %ymm8, %ymm2, %ymm2 + vpblendd $-64, %ymm4, %ymm13, %ymm13 + vpandn %ymm13, %ymm2, %ymm2 + vpxor %ymm1, %ymm2, %ymm2 + vpermq $0, %ymm3, %ymm13 + vpermq $27, %ymm12, %ymm3 + vpermq $-115, %ymm5, %ymm5 + vpermq $114, %ymm6, %ymm6 + vpblendd $12, %ymm8, %ymm7, %ymm12 + vpblendd $12, %ymm7, %ymm4, %ymm7 + vpblendd $48, %ymm4, %ymm12, %ymm4 + vpblendd $48, %ymm1, %ymm7, %ymm7 + vpblendd $-64, %ymm1, %ymm4, %ymm1 + vpblendd $-64, %ymm8, %ymm7, %ymm4 + vpandn %ymm4, %ymm1, %ymm4 + vpxor %ymm13, %ymm0, %ymm0 + vpxor %ymm10, %ymm11, %ymm1 + vpxor %ymm9, %ymm4, %ymm4 + vpxor (%rdx), %ymm0, %ymm0 + leaq 32(%rdx), %rdx + decl %ebx + jne Lkeccak_1600$10 + vmovdqu %ymm0, (%rsp) + vmovdqu %ymm1, 32(%rsp) + vmovdqu %ymm2, 64(%rsp) + vmovdqu %ymm3, 96(%rsp) + vmovdqu %ymm4, 128(%rsp) + vmovdqu %ymm5, 160(%rsp) + vmovdqu %ymm6, 192(%rsp) + movq %r8, %rax + shrq $3, %rax + movq $0, %rcx + jmp Lkeccak_1600$8 +Lkeccak_1600$9: + movq (%r9,%rcx,8), %rdx + movq (%rsp,%rdx,8), %rdx + movq %rdx, (%rdi,%rcx,8) + leaq 1(%rcx), %rcx +Lkeccak_1600$8: + cmpq %rax, %rcx + jb Lkeccak_1600$9 + leaq (%rdi,%r8), %rdi + subq %r8, %rsi +Lkeccak_1600$6: + cmpq %r8, %rsi + jnbe Lkeccak_1600$7 + leaq 96(%r10), %rax + leaq 96(%r11), %rcx + movl $24, %edx + .p2align 5 +Lkeccak_1600$5: + vpshufd $78, %ymm2, %ymm7 + vpxor %ymm3, %ymm5, %ymm8 + vpxor %ymm6, %ymm4, %ymm9 + vpxor %ymm1, %ymm8, %ymm8 + vpxor %ymm9, %ymm8, %ymm8 + vpermq $-109, %ymm8, %ymm9 + vpxor %ymm2, %ymm7, %ymm7 + vpermq $78, %ymm7, %ymm10 + vpsrlq $63, %ymm8, %ymm11 + vpaddq %ymm8, %ymm8, %ymm8 + vpor %ymm8, %ymm11, %ymm8 + vpermq $57, %ymm8, %ymm11 + vpxor %ymm9, %ymm8, %ymm8 + vpermq $0, %ymm8, %ymm8 + vpxor %ymm0, %ymm7, %ymm7 + vpxor %ymm10, %ymm7, %ymm7 + vpsrlq $63, %ymm7, %ymm10 + vpaddq %ymm7, %ymm7, %ymm12 + vpor %ymm10, %ymm12, %ymm10 + vpxor %ymm8, %ymm2, %ymm2 + vpxor %ymm8, %ymm0, %ymm0 + vpblendd $-64, %ymm10, %ymm11, %ymm8 + vpblendd $3, %ymm7, %ymm9, %ymm7 + vpxor %ymm7, %ymm8, %ymm7 + vpsllvq -96(%rax), %ymm2, %ymm8 + vpsrlvq -96(%rcx), %ymm2, %ymm2 + vpor %ymm8, %ymm2, %ymm2 + vpxor %ymm7, %ymm3, %ymm3 + vpsllvq -32(%rax), %ymm3, %ymm8 + vpsrlvq -32(%rcx), %ymm3, %ymm3 + vpor %ymm8, %ymm3, %ymm3 + vpxor %ymm7, %ymm4, %ymm4 + vpsllvq (%rax), %ymm4, %ymm8 + vpsrlvq (%rcx), %ymm4, %ymm4 + vpor %ymm8, %ymm4, %ymm4 + vpxor %ymm7, %ymm5, %ymm5 + vpsllvq 32(%rax), %ymm5, %ymm8 + vpsrlvq 32(%rcx), %ymm5, %ymm5 + vpor %ymm8, %ymm5, %ymm5 + vpxor %ymm7, %ymm6, %ymm6 + vpermq $-115, %ymm2, %ymm8 + vpermq $-115, %ymm3, %ymm9 + vpsllvq 64(%rax), %ymm6, %ymm2 + vpsrlvq 64(%rcx), %ymm6, %ymm3 + vpor %ymm2, %ymm3, %ymm10 + vpxor %ymm7, %ymm1, %ymm1 + vpermq $27, %ymm4, %ymm4 + vpermq $114, %ymm5, %ymm7 + vpsllvq -64(%rax), %ymm1, %ymm2 + vpsrlvq -64(%rcx), %ymm1, %ymm1 + vpor %ymm2, %ymm1, %ymm1 + vpsrldq $8, %ymm10, %ymm2 + vpandn %ymm2, %ymm10, %ymm3 + vpblendd $12, %ymm7, %ymm1, %ymm2 + vpblendd $12, %ymm1, %ymm9, %ymm5 + vpblendd $12, %ymm9, %ymm8, %ymm6 + vpblendd $12, %ymm8, %ymm1, %ymm11 + vpblendd $48, %ymm9, %ymm2, %ymm2 + vpblendd $48, %ymm4, %ymm5, %ymm5 + vpblendd $48, %ymm1, %ymm6, %ymm6 + vpblendd $48, %ymm7, %ymm11, %ymm11 + vpblendd $-64, %ymm4, %ymm2, %ymm2 + vpblendd $-64, %ymm7, %ymm5, %ymm5 + vpblendd $-64, %ymm7, %ymm6, %ymm6 + vpblendd $-64, %ymm9, %ymm11, %ymm11 + vpandn %ymm5, %ymm2, %ymm2 + vpandn %ymm11, %ymm6, %ymm5 + vpblendd $12, %ymm1, %ymm4, %ymm6 + vpblendd $12, %ymm4, %ymm8, %ymm11 + vpxor %ymm8, %ymm2, %ymm12 + vpblendd $48, %ymm8, %ymm6, %ymm2 + vpblendd $48, %ymm9, %ymm11, %ymm6 + vpxor %ymm4, %ymm5, %ymm5 + vpblendd $-64, %ymm9, %ymm2, %ymm2 + vpblendd $-64, %ymm1, %ymm6, %ymm6 + vpandn %ymm6, %ymm2, %ymm2 + vpxor %ymm7, %ymm2, %ymm6 + vpermq $30, %ymm10, %ymm2 + vpblendd $48, %ymm0, %ymm2, %ymm2 + vpermq $57, %ymm10, %ymm11 + vpblendd $-64, %ymm0, %ymm11, %ymm11 + vpandn %ymm2, %ymm11, %ymm11 + vpblendd $12, %ymm4, %ymm9, %ymm2 + vpblendd $12, %ymm9, %ymm7, %ymm13 + vpblendd $48, %ymm7, %ymm2, %ymm2 + vpblendd $48, %ymm8, %ymm13, %ymm13 + vpblendd $-64, %ymm8, %ymm2, %ymm2 + vpblendd $-64, %ymm4, %ymm13, %ymm13 + vpandn %ymm13, %ymm2, %ymm2 + vpxor %ymm1, %ymm2, %ymm2 + vpermq $0, %ymm3, %ymm13 + vpermq $27, %ymm12, %ymm3 + vpermq $-115, %ymm5, %ymm5 + vpermq $114, %ymm6, %ymm6 + vpblendd $12, %ymm8, %ymm7, %ymm12 + vpblendd $12, %ymm7, %ymm4, %ymm7 + vpblendd $48, %ymm4, %ymm12, %ymm4 + vpblendd $48, %ymm1, %ymm7, %ymm7 + vpblendd $-64, %ymm1, %ymm4, %ymm1 + vpblendd $-64, %ymm8, %ymm7, %ymm4 + vpandn %ymm4, %ymm1, %ymm4 + vpxor %ymm13, %ymm0, %ymm0 + vpxor %ymm10, %ymm11, %ymm1 + vpxor %ymm9, %ymm4, %ymm4 + vpxor (%rbp), %ymm0, %ymm0 + leaq 32(%rbp), %rbp + decl %edx + jne Lkeccak_1600$5 + vmovdqu %ymm0, (%rsp) + vmovdqu %ymm1, 32(%rsp) + vmovdqu %ymm2, 64(%rsp) + vmovdqu %ymm3, 96(%rsp) + vmovdqu %ymm4, 128(%rsp) + vmovdqu %ymm5, 160(%rsp) + vmovdqu %ymm6, 192(%rsp) + movq %rsi, %rax + shrq $3, %rax + movq $0, %rcx + jmp Lkeccak_1600$3 +Lkeccak_1600$4: + movq (%r9,%rcx,8), %rdx + movq (%rsp,%rdx,8), %rdx + movq %rdx, (%rdi,%rcx,8) + leaq 1(%rcx), %rcx +Lkeccak_1600$3: + cmpq %rax, %rcx + jb Lkeccak_1600$4 + movq (%r9,%rcx,8), %rax + shlq $3, %rcx + shlq $3, %rax + jmp Lkeccak_1600$1 +Lkeccak_1600$2: + movb (%rsp,%rax), %dl + movb %dl, (%rdi,%rcx) + leaq 1(%rcx), %rcx + leaq 1(%rax), %rax +Lkeccak_1600$1: + cmpq %rsi, %rcx + jb Lkeccak_1600$2 + addq $256, %rsp + popq %r14 + popq %r13 + popq %r12 + popq %rbx + popq %rbp + ret + .data + .globl _g_zero + .globl g_zero + .p2align 3 +_g_zero: +g_zero: + .quad 0 + .globl _s_zero + .globl s_zero + .p2align 3 +_s_zero: +s_zero: + .quad 0 diff --git a/code/crypto_hash/shake128/scalar/Makefile b/code/crypto_hash/shake128/scalar/Makefile new file mode 100644 index 0000000..1f3e979 --- /dev/null +++ b/code/crypto_hash/shake128/scalar/Makefile @@ -0,0 +1,15 @@ +# -*- Makefile -*- + +.PHONY: default clean + +default: shake128.japp shake128.s + @true + +clean: + rm -f shake128.japp shake128.s + +%.s: %.japp + jasminc -lea -pasm $< > $@ || rm -f $@ + +%.japp: %.jazz + gpp -I../../../ -o $@ $< diff --git a/code/crypto_hash/shake128/scalar/shake128-m.c b/code/crypto_hash/shake128/scalar/shake128-m.c new file mode 100644 index 0000000..b27adc8 --- /dev/null +++ b/code/crypto_hash/shake128/scalar/shake128-m.c @@ -0,0 +1,55 @@ +#include "crypto_hash.h" +#include "impl.h" +#include "api.h" +#include +#include + + +extern void keccak_1600( + uint8_t *out, + uint64_t outlen, + const uint8_t *in, + size_t inlen, + uint64_t *c, + uint64_t *iotas +); + + +uint64_t iotas[32] __attribute__((aligned(256))) = +{ + 0,0,0,0,0,0,0, 0 + , 0x0000000000000001 + , 0x0000000000008082 + , 0x800000000000808a + , 0x8000000080008000 + , 0x000000000000808b + , 0x0000000080000001 + , 0x8000000080008081 + , 0x8000000000008009 + , 0x000000000000008a + , 0x0000000000000088 + , 0x0000000080008009 + , 0x000000008000000a + , 0x000000008000808b + , 0x800000000000008b + , 0x8000000000008089 + , 0x8000000000008003 + , 0x8000000000008002 + , 0x8000000000000080 + , 0x000000000000800a + , 0x800000008000000a + , 0x8000000080008081 + , 0x8000000000008080 + , 0x0000000080000001 + , 0x8000000080008008 +}; + + +int shake128_scalar(unsigned char *out,const unsigned char *in,unsigned long long inlen) +{ + uint64_t c[] = {0x1F, (1344/8)}; + keccak_1600(out, 168, in, inlen, c, &(iotas[8])); + return 0; +} + + diff --git a/code/crypto_hash/shake128/scalar/shake128.jazz b/code/crypto_hash/shake128/scalar/shake128.jazz new file mode 100644 index 0000000..d2fa40e --- /dev/null +++ b/code/crypto_hash/shake128/scalar/shake128.jazz @@ -0,0 +1 @@ +#include "crypto_hash/keccak1600/scalar/keccak_1600.jazz" diff --git a/code/crypto_hash/shake128/scalar/shake128.s b/code/crypto_hash/shake128/scalar/shake128.s new file mode 100644 index 0000000..f79b7d1 --- /dev/null +++ b/code/crypto_hash/shake128/scalar/shake128.s @@ -0,0 +1,1299 @@ + .text + .p2align 5 + .globl _keccak_1600 + .globl keccak_1600 +_keccak_1600: +keccak_1600: + pushq %rbp + pushq %rbx + pushq %r12 + subq $456, %rsp + movq %rdi, 200(%rsp) + movq %rsi, 448(%rsp) + movzbq (%r8), %rax + movq %rax, 440(%rsp) + movq 8(%r8), %rax + xorl %esi, %esi + movq $0, %rdi + jmp Lkeccak_1600$20 +Lkeccak_1600$21: + movq %rsi, (%rsp,%rdi,8) + leaq 1(%rdi), %rdi +Lkeccak_1600$20: + cmpq $25, %rdi + jb Lkeccak_1600$21 + jmp Lkeccak_1600$15 +Lkeccak_1600$16: + movq %rax, %rsi + shrq $3, %rsi + movq $0, %rdi + jmp Lkeccak_1600$18 +Lkeccak_1600$19: + movq (%rdx,%rdi,8), %r8 + xorq %r8, (%rsp,%rdi,8) + leaq 1(%rdi), %rdi +Lkeccak_1600$18: + cmpq %rsi, %rdi + jb Lkeccak_1600$19 + leaq (%rdx,%rax), %rdx + subq %rax, %rcx + movq %rdx, 224(%rsp) + movq %rcx, 216(%rsp) + movq %rax, 208(%rsp) +Lkeccak_1600$17: + movq (%r9), %rax + movq %rax, 432(%rsp) + movq (%rsp), %rax + movq 8(%rsp), %rcx + movq 16(%rsp), %rdx + movq 24(%rsp), %rsi + movq 32(%rsp), %rdi + xorq 40(%rsp), %rax + xorq 48(%rsp), %rcx + xorq 56(%rsp), %rdx + xorq 64(%rsp), %rsi + xorq 72(%rsp), %rdi + xorq 80(%rsp), %rax + xorq 88(%rsp), %rcx + xorq 96(%rsp), %rdx + xorq 104(%rsp), %rsi + xorq 112(%rsp), %rdi + xorq 120(%rsp), %rax + xorq 128(%rsp), %rcx + xorq 136(%rsp), %rdx + xorq 144(%rsp), %rsi + xorq 152(%rsp), %rdi + xorq 160(%rsp), %rax + xorq 168(%rsp), %rcx + xorq 176(%rsp), %rdx + xorq 184(%rsp), %rsi + xorq 192(%rsp), %rdi + movq %rcx, %r8 + rolq $1, %r8 + xorq %rdi, %r8 + movq %rdx, %r10 + rolq $1, %r10 + xorq %rax, %r10 + movq %rsi, %r11 + rolq $1, %r11 + xorq %rcx, %r11 + movq %rdi, %rcx + rolq $1, %rcx + xorq %rdx, %rcx + rolq $1, %rax + xorq %rsi, %rax + movq (%rsp), %rdx + xorq %r8, %rdx + movq 48(%rsp), %rsi + xorq %r10, %rsi + rolq $44, %rsi + movq 96(%rsp), %rdi + xorq %r11, %rdi + rolq $43, %rdi + movq 144(%rsp), %rbp + xorq %rcx, %rbp + rolq $21, %rbp + movq 192(%rsp), %rbx + xorq %rax, %rbx + rolq $14, %rbx + andnq %rdi, %rsi, %r12 + xorq 432(%rsp), %r12 + xorq %rdx, %r12 + movq %r12, 232(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 240(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 248(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 256(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 264(%rsp) + movq 24(%rsp), %rdx + xorq %rcx, %rdx + rolq $28, %rdx + movq 72(%rsp), %rsi + xorq %rax, %rsi + rolq $20, %rsi + movq 80(%rsp), %rdi + xorq %r8, %rdi + rolq $3, %rdi + movq 128(%rsp), %rbp + xorq %r10, %rbp + rolq $45, %rbp + movq 176(%rsp), %rbx + xorq %r11, %rbx + rolq $61, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 272(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 280(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 288(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 296(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 304(%rsp) + movq 8(%rsp), %rdx + xorq %r10, %rdx + rolq $1, %rdx + movq 56(%rsp), %rsi + xorq %r11, %rsi + rolq $6, %rsi + movq 104(%rsp), %rdi + xorq %rcx, %rdi + rolq $25, %rdi + movq 152(%rsp), %rbp + xorq %rax, %rbp + rolq $8, %rbp + movq 160(%rsp), %rbx + xorq %r8, %rbx + rolq $18, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 312(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 320(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 328(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 336(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 344(%rsp) + movq 32(%rsp), %rdx + xorq %rax, %rdx + rolq $27, %rdx + movq 40(%rsp), %rsi + xorq %r8, %rsi + rolq $36, %rsi + movq 88(%rsp), %rdi + xorq %r10, %rdi + rolq $10, %rdi + movq 136(%rsp), %rbp + xorq %r11, %rbp + rolq $15, %rbp + movq 184(%rsp), %rbx + xorq %rcx, %rbx + rolq $56, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 352(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 360(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 368(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 376(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 384(%rsp) + movq 16(%rsp), %rdx + xorq %r11, %rdx + rolq $62, %rdx + movq 64(%rsp), %rsi + xorq %rcx, %rsi + rolq $55, %rsi + movq %rsi, %rcx + movq 112(%rsp), %rsi + xorq %rax, %rsi + rolq $39, %rsi + movq %rsi, %rax + movq 120(%rsp), %rsi + xorq %r8, %rsi + rolq $41, %rsi + movq 168(%rsp), %rdi + xorq %r10, %rdi + rolq $2, %rdi + andnq %rax, %rcx, %r8 + xorq %rdx, %r8 + movq %r8, 392(%rsp) + andnq %rsi, %rax, %r8 + xorq %rcx, %r8 + movq %r8, 400(%rsp) + andnq %rdi, %rsi, %r8 + xorq %rax, %r8 + movq %r8, 408(%rsp) + andnq %rdx, %rdi, %rax + xorq %rsi, %rax + movq %rax, 416(%rsp) + andnq %rcx, %rdx, %rax + xorq %rdi, %rax + movq %rax, 424(%rsp) + movq 8(%r9), %rax + movq %rax, 432(%rsp) + movq 232(%rsp), %rax + movq 240(%rsp), %rcx + movq 248(%rsp), %rdx + movq 256(%rsp), %rsi + movq 264(%rsp), %rdi + xorq 272(%rsp), %rax + xorq 280(%rsp), %rcx + xorq 288(%rsp), %rdx + xorq 296(%rsp), %rsi + xorq 304(%rsp), %rdi + xorq 312(%rsp), %rax + xorq 320(%rsp), %rcx + xorq 328(%rsp), %rdx + xorq 336(%rsp), %rsi + xorq 344(%rsp), %rdi + xorq 352(%rsp), %rax + xorq 360(%rsp), %rcx + xorq 368(%rsp), %rdx + xorq 376(%rsp), %rsi + xorq 384(%rsp), %rdi + xorq 392(%rsp), %rax + xorq 400(%rsp), %rcx + xorq 408(%rsp), %rdx + xorq 416(%rsp), %rsi + xorq 424(%rsp), %rdi + movq %rcx, %r8 + rolq $1, %r8 + xorq %rdi, %r8 + movq %rdx, %r10 + rolq $1, %r10 + xorq %rax, %r10 + movq %rsi, %r11 + rolq $1, %r11 + xorq %rcx, %r11 + movq %rdi, %rcx + rolq $1, %rcx + xorq %rdx, %rcx + rolq $1, %rax + xorq %rsi, %rax + movq 232(%rsp), %rdx + xorq %r8, %rdx + movq 280(%rsp), %rsi + xorq %r10, %rsi + rolq $44, %rsi + movq 328(%rsp), %rdi + xorq %r11, %rdi + rolq $43, %rdi + movq 376(%rsp), %rbp + xorq %rcx, %rbp + rolq $21, %rbp + movq 424(%rsp), %rbx + xorq %rax, %rbx + rolq $14, %rbx + andnq %rdi, %rsi, %r12 + xorq 432(%rsp), %r12 + xorq %rdx, %r12 + movq %r12, (%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 8(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 16(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 24(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 32(%rsp) + movq 256(%rsp), %rdx + xorq %rcx, %rdx + rolq $28, %rdx + movq 304(%rsp), %rsi + xorq %rax, %rsi + rolq $20, %rsi + movq 312(%rsp), %rdi + xorq %r8, %rdi + rolq $3, %rdi + movq 360(%rsp), %rbp + xorq %r10, %rbp + rolq $45, %rbp + movq 408(%rsp), %rbx + xorq %r11, %rbx + rolq $61, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 40(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 48(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 56(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 64(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 72(%rsp) + movq 240(%rsp), %rdx + xorq %r10, %rdx + rolq $1, %rdx + movq 288(%rsp), %rsi + xorq %r11, %rsi + rolq $6, %rsi + movq 336(%rsp), %rdi + xorq %rcx, %rdi + rolq $25, %rdi + movq 384(%rsp), %rbp + xorq %rax, %rbp + rolq $8, %rbp + movq 392(%rsp), %rbx + xorq %r8, %rbx + rolq $18, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 80(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 88(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 96(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 104(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 112(%rsp) + movq 264(%rsp), %rdx + xorq %rax, %rdx + rolq $27, %rdx + movq 272(%rsp), %rsi + xorq %r8, %rsi + rolq $36, %rsi + movq 320(%rsp), %rdi + xorq %r10, %rdi + rolq $10, %rdi + movq 368(%rsp), %rbp + xorq %r11, %rbp + rolq $15, %rbp + movq 416(%rsp), %rbx + xorq %rcx, %rbx + rolq $56, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 120(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 128(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 136(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 144(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 152(%rsp) + movq 248(%rsp), %rdx + xorq %r11, %rdx + rolq $62, %rdx + movq 296(%rsp), %rsi + xorq %rcx, %rsi + rolq $55, %rsi + movq %rsi, %rcx + movq 344(%rsp), %rsi + xorq %rax, %rsi + rolq $39, %rsi + movq %rsi, %rax + movq 352(%rsp), %rsi + xorq %r8, %rsi + rolq $41, %rsi + movq 400(%rsp), %rdi + xorq %r10, %rdi + rolq $2, %rdi + andnq %rax, %rcx, %r8 + xorq %rdx, %r8 + movq %r8, 160(%rsp) + andnq %rsi, %rax, %r8 + xorq %rcx, %r8 + movq %r8, 168(%rsp) + andnq %rdi, %rsi, %r8 + xorq %rax, %r8 + movq %r8, 176(%rsp) + andnq %rdx, %rdi, %rax + xorq %rsi, %rax + movq %rax, 184(%rsp) + andnq %rcx, %rdx, %rax + xorq %rdi, %rax + movq %rax, 192(%rsp) + leaq 16(%r9), %r9 + testb $-1, %r9b + jne Lkeccak_1600$17 + leaq -192(%r9), %r9 + movq 224(%rsp), %rdx + movq 216(%rsp), %rcx + movq 208(%rsp), %rax +Lkeccak_1600$15: + cmpq %rax, %rcx + jnb Lkeccak_1600$16 + movq 440(%rsp), %rsi + movb %sil, %sil + movq %rcx, %rdi + shrq $3, %rdi + movq $0, %r8 + jmp Lkeccak_1600$13 +Lkeccak_1600$14: + movq (%rdx,%r8,8), %r10 + xorq %r10, (%rsp,%r8,8) + leaq 1(%r8), %r8 +Lkeccak_1600$13: + cmpq %rdi, %r8 + jb Lkeccak_1600$14 + shlq $3, %r8 + jmp Lkeccak_1600$11 +Lkeccak_1600$12: + movb (%rdx,%r8), %dil + xorb %dil, (%rsp,%r8) + leaq 1(%r8), %r8 +Lkeccak_1600$11: + cmpq %rcx, %r8 + jb Lkeccak_1600$12 + xorb %sil, (%rsp,%r8) + movq %rax, %rcx + leaq -1(%rcx), %rcx + xorb $-128, (%rsp,%rcx) + movq 448(%rsp), %rdx + jmp Lkeccak_1600$6 +Lkeccak_1600$7: + movq %rdx, 448(%rsp) + movq %rax, 440(%rsp) +Lkeccak_1600$10: + movq (%r9), %rax + movq %rax, 432(%rsp) + movq (%rsp), %rax + movq 8(%rsp), %rcx + movq 16(%rsp), %rdx + movq 24(%rsp), %rsi + movq 32(%rsp), %rdi + xorq 40(%rsp), %rax + xorq 48(%rsp), %rcx + xorq 56(%rsp), %rdx + xorq 64(%rsp), %rsi + xorq 72(%rsp), %rdi + xorq 80(%rsp), %rax + xorq 88(%rsp), %rcx + xorq 96(%rsp), %rdx + xorq 104(%rsp), %rsi + xorq 112(%rsp), %rdi + xorq 120(%rsp), %rax + xorq 128(%rsp), %rcx + xorq 136(%rsp), %rdx + xorq 144(%rsp), %rsi + xorq 152(%rsp), %rdi + xorq 160(%rsp), %rax + xorq 168(%rsp), %rcx + xorq 176(%rsp), %rdx + xorq 184(%rsp), %rsi + xorq 192(%rsp), %rdi + movq %rcx, %r8 + rolq $1, %r8 + xorq %rdi, %r8 + movq %rdx, %r10 + rolq $1, %r10 + xorq %rax, %r10 + movq %rsi, %r11 + rolq $1, %r11 + xorq %rcx, %r11 + movq %rdi, %rcx + rolq $1, %rcx + xorq %rdx, %rcx + rolq $1, %rax + xorq %rsi, %rax + movq (%rsp), %rdx + xorq %r8, %rdx + movq 48(%rsp), %rsi + xorq %r10, %rsi + rolq $44, %rsi + movq 96(%rsp), %rdi + xorq %r11, %rdi + rolq $43, %rdi + movq 144(%rsp), %rbp + xorq %rcx, %rbp + rolq $21, %rbp + movq 192(%rsp), %rbx + xorq %rax, %rbx + rolq $14, %rbx + andnq %rdi, %rsi, %r12 + xorq 432(%rsp), %r12 + xorq %rdx, %r12 + movq %r12, 232(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 240(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 248(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 256(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 264(%rsp) + movq 24(%rsp), %rdx + xorq %rcx, %rdx + rolq $28, %rdx + movq 72(%rsp), %rsi + xorq %rax, %rsi + rolq $20, %rsi + movq 80(%rsp), %rdi + xorq %r8, %rdi + rolq $3, %rdi + movq 128(%rsp), %rbp + xorq %r10, %rbp + rolq $45, %rbp + movq 176(%rsp), %rbx + xorq %r11, %rbx + rolq $61, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 272(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 280(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 288(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 296(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 304(%rsp) + movq 8(%rsp), %rdx + xorq %r10, %rdx + rolq $1, %rdx + movq 56(%rsp), %rsi + xorq %r11, %rsi + rolq $6, %rsi + movq 104(%rsp), %rdi + xorq %rcx, %rdi + rolq $25, %rdi + movq 152(%rsp), %rbp + xorq %rax, %rbp + rolq $8, %rbp + movq 160(%rsp), %rbx + xorq %r8, %rbx + rolq $18, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 312(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 320(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 328(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 336(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 344(%rsp) + movq 32(%rsp), %rdx + xorq %rax, %rdx + rolq $27, %rdx + movq 40(%rsp), %rsi + xorq %r8, %rsi + rolq $36, %rsi + movq 88(%rsp), %rdi + xorq %r10, %rdi + rolq $10, %rdi + movq 136(%rsp), %rbp + xorq %r11, %rbp + rolq $15, %rbp + movq 184(%rsp), %rbx + xorq %rcx, %rbx + rolq $56, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 352(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 360(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 368(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 376(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 384(%rsp) + movq 16(%rsp), %rdx + xorq %r11, %rdx + rolq $62, %rdx + movq 64(%rsp), %rsi + xorq %rcx, %rsi + rolq $55, %rsi + movq %rsi, %rcx + movq 112(%rsp), %rsi + xorq %rax, %rsi + rolq $39, %rsi + movq %rsi, %rax + movq 120(%rsp), %rsi + xorq %r8, %rsi + rolq $41, %rsi + movq 168(%rsp), %rdi + xorq %r10, %rdi + rolq $2, %rdi + andnq %rax, %rcx, %r8 + xorq %rdx, %r8 + movq %r8, 392(%rsp) + andnq %rsi, %rax, %r8 + xorq %rcx, %r8 + movq %r8, 400(%rsp) + andnq %rdi, %rsi, %r8 + xorq %rax, %r8 + movq %r8, 408(%rsp) + andnq %rdx, %rdi, %rax + xorq %rsi, %rax + movq %rax, 416(%rsp) + andnq %rcx, %rdx, %rax + xorq %rdi, %rax + movq %rax, 424(%rsp) + movq 8(%r9), %rax + movq %rax, 432(%rsp) + movq 232(%rsp), %rax + movq 240(%rsp), %rcx + movq 248(%rsp), %rdx + movq 256(%rsp), %rsi + movq 264(%rsp), %rdi + xorq 272(%rsp), %rax + xorq 280(%rsp), %rcx + xorq 288(%rsp), %rdx + xorq 296(%rsp), %rsi + xorq 304(%rsp), %rdi + xorq 312(%rsp), %rax + xorq 320(%rsp), %rcx + xorq 328(%rsp), %rdx + xorq 336(%rsp), %rsi + xorq 344(%rsp), %rdi + xorq 352(%rsp), %rax + xorq 360(%rsp), %rcx + xorq 368(%rsp), %rdx + xorq 376(%rsp), %rsi + xorq 384(%rsp), %rdi + xorq 392(%rsp), %rax + xorq 400(%rsp), %rcx + xorq 408(%rsp), %rdx + xorq 416(%rsp), %rsi + xorq 424(%rsp), %rdi + movq %rcx, %r8 + rolq $1, %r8 + xorq %rdi, %r8 + movq %rdx, %r10 + rolq $1, %r10 + xorq %rax, %r10 + movq %rsi, %r11 + rolq $1, %r11 + xorq %rcx, %r11 + movq %rdi, %rcx + rolq $1, %rcx + xorq %rdx, %rcx + rolq $1, %rax + xorq %rsi, %rax + movq 232(%rsp), %rdx + xorq %r8, %rdx + movq 280(%rsp), %rsi + xorq %r10, %rsi + rolq $44, %rsi + movq 328(%rsp), %rdi + xorq %r11, %rdi + rolq $43, %rdi + movq 376(%rsp), %rbp + xorq %rcx, %rbp + rolq $21, %rbp + movq 424(%rsp), %rbx + xorq %rax, %rbx + rolq $14, %rbx + andnq %rdi, %rsi, %r12 + xorq 432(%rsp), %r12 + xorq %rdx, %r12 + movq %r12, (%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 8(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 16(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 24(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 32(%rsp) + movq 256(%rsp), %rdx + xorq %rcx, %rdx + rolq $28, %rdx + movq 304(%rsp), %rsi + xorq %rax, %rsi + rolq $20, %rsi + movq 312(%rsp), %rdi + xorq %r8, %rdi + rolq $3, %rdi + movq 360(%rsp), %rbp + xorq %r10, %rbp + rolq $45, %rbp + movq 408(%rsp), %rbx + xorq %r11, %rbx + rolq $61, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 40(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 48(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 56(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 64(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 72(%rsp) + movq 240(%rsp), %rdx + xorq %r10, %rdx + rolq $1, %rdx + movq 288(%rsp), %rsi + xorq %r11, %rsi + rolq $6, %rsi + movq 336(%rsp), %rdi + xorq %rcx, %rdi + rolq $25, %rdi + movq 384(%rsp), %rbp + xorq %rax, %rbp + rolq $8, %rbp + movq 392(%rsp), %rbx + xorq %r8, %rbx + rolq $18, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 80(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 88(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 96(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 104(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 112(%rsp) + movq 264(%rsp), %rdx + xorq %rax, %rdx + rolq $27, %rdx + movq 272(%rsp), %rsi + xorq %r8, %rsi + rolq $36, %rsi + movq 320(%rsp), %rdi + xorq %r10, %rdi + rolq $10, %rdi + movq 368(%rsp), %rbp + xorq %r11, %rbp + rolq $15, %rbp + movq 416(%rsp), %rbx + xorq %rcx, %rbx + rolq $56, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 120(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 128(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 136(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 144(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 152(%rsp) + movq 248(%rsp), %rdx + xorq %r11, %rdx + rolq $62, %rdx + movq 296(%rsp), %rsi + xorq %rcx, %rsi + rolq $55, %rsi + movq %rsi, %rcx + movq 344(%rsp), %rsi + xorq %rax, %rsi + rolq $39, %rsi + movq %rsi, %rax + movq 352(%rsp), %rsi + xorq %r8, %rsi + rolq $41, %rsi + movq 400(%rsp), %rdi + xorq %r10, %rdi + rolq $2, %rdi + andnq %rax, %rcx, %r8 + xorq %rdx, %r8 + movq %r8, 160(%rsp) + andnq %rsi, %rax, %r8 + xorq %rcx, %r8 + movq %r8, 168(%rsp) + andnq %rdi, %rsi, %r8 + xorq %rax, %r8 + movq %r8, 176(%rsp) + andnq %rdx, %rdi, %rax + xorq %rsi, %rax + movq %rax, 184(%rsp) + andnq %rcx, %rdx, %rax + xorq %rdi, %rax + movq %rax, 192(%rsp) + leaq 16(%r9), %r9 + testb $-1, %r9b + jne Lkeccak_1600$10 + leaq -192(%r9), %r9 + movq 200(%rsp), %rcx + movq 448(%rsp), %rdx + movq 440(%rsp), %rax + movq %rax, %rsi + shrq $3, %rsi + movq $0, %rdi + jmp Lkeccak_1600$8 +Lkeccak_1600$9: + movq (%rsp,%rdi,8), %r8 + movq %r8, (%rcx,%rdi,8) + leaq 1(%rdi), %rdi +Lkeccak_1600$8: + cmpq %rsi, %rdi + jb Lkeccak_1600$9 + leaq (%rcx,%rax), %rcx + subq %rax, %rdx + movq %rcx, 200(%rsp) +Lkeccak_1600$6: + cmpq %rax, %rdx + jnbe Lkeccak_1600$7 + movq %rdx, 440(%rsp) +Lkeccak_1600$5: + movq (%r9), %rax + movq %rax, 448(%rsp) + movq (%rsp), %rax + movq 8(%rsp), %rcx + movq 16(%rsp), %rdx + movq 24(%rsp), %rsi + movq 32(%rsp), %rdi + xorq 40(%rsp), %rax + xorq 48(%rsp), %rcx + xorq 56(%rsp), %rdx + xorq 64(%rsp), %rsi + xorq 72(%rsp), %rdi + xorq 80(%rsp), %rax + xorq 88(%rsp), %rcx + xorq 96(%rsp), %rdx + xorq 104(%rsp), %rsi + xorq 112(%rsp), %rdi + xorq 120(%rsp), %rax + xorq 128(%rsp), %rcx + xorq 136(%rsp), %rdx + xorq 144(%rsp), %rsi + xorq 152(%rsp), %rdi + xorq 160(%rsp), %rax + xorq 168(%rsp), %rcx + xorq 176(%rsp), %rdx + xorq 184(%rsp), %rsi + xorq 192(%rsp), %rdi + movq %rcx, %r8 + rolq $1, %r8 + xorq %rdi, %r8 + movq %rdx, %r10 + rolq $1, %r10 + xorq %rax, %r10 + movq %rsi, %r11 + rolq $1, %r11 + xorq %rcx, %r11 + movq %rdi, %rcx + rolq $1, %rcx + xorq %rdx, %rcx + rolq $1, %rax + xorq %rsi, %rax + movq (%rsp), %rdx + xorq %r8, %rdx + movq 48(%rsp), %rsi + xorq %r10, %rsi + rolq $44, %rsi + movq 96(%rsp), %rdi + xorq %r11, %rdi + rolq $43, %rdi + movq 144(%rsp), %rbp + xorq %rcx, %rbp + rolq $21, %rbp + movq 192(%rsp), %rbx + xorq %rax, %rbx + rolq $14, %rbx + andnq %rdi, %rsi, %r12 + xorq 448(%rsp), %r12 + xorq %rdx, %r12 + movq %r12, 232(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 240(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 248(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 256(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 264(%rsp) + movq 24(%rsp), %rdx + xorq %rcx, %rdx + rolq $28, %rdx + movq 72(%rsp), %rsi + xorq %rax, %rsi + rolq $20, %rsi + movq 80(%rsp), %rdi + xorq %r8, %rdi + rolq $3, %rdi + movq 128(%rsp), %rbp + xorq %r10, %rbp + rolq $45, %rbp + movq 176(%rsp), %rbx + xorq %r11, %rbx + rolq $61, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 272(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 280(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 288(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 296(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 304(%rsp) + movq 8(%rsp), %rdx + xorq %r10, %rdx + rolq $1, %rdx + movq 56(%rsp), %rsi + xorq %r11, %rsi + rolq $6, %rsi + movq 104(%rsp), %rdi + xorq %rcx, %rdi + rolq $25, %rdi + movq 152(%rsp), %rbp + xorq %rax, %rbp + rolq $8, %rbp + movq 160(%rsp), %rbx + xorq %r8, %rbx + rolq $18, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 312(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 320(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 328(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 336(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 344(%rsp) + movq 32(%rsp), %rdx + xorq %rax, %rdx + rolq $27, %rdx + movq 40(%rsp), %rsi + xorq %r8, %rsi + rolq $36, %rsi + movq 88(%rsp), %rdi + xorq %r10, %rdi + rolq $10, %rdi + movq 136(%rsp), %rbp + xorq %r11, %rbp + rolq $15, %rbp + movq 184(%rsp), %rbx + xorq %rcx, %rbx + rolq $56, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 352(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 360(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 368(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 376(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 384(%rsp) + movq 16(%rsp), %rdx + xorq %r11, %rdx + rolq $62, %rdx + movq 64(%rsp), %rsi + xorq %rcx, %rsi + rolq $55, %rsi + movq %rsi, %rcx + movq 112(%rsp), %rsi + xorq %rax, %rsi + rolq $39, %rsi + movq %rsi, %rax + movq 120(%rsp), %rsi + xorq %r8, %rsi + rolq $41, %rsi + movq 168(%rsp), %rdi + xorq %r10, %rdi + rolq $2, %rdi + andnq %rax, %rcx, %r8 + xorq %rdx, %r8 + movq %r8, 392(%rsp) + andnq %rsi, %rax, %r8 + xorq %rcx, %r8 + movq %r8, 400(%rsp) + andnq %rdi, %rsi, %r8 + xorq %rax, %r8 + movq %r8, 408(%rsp) + andnq %rdx, %rdi, %rax + xorq %rsi, %rax + movq %rax, 416(%rsp) + andnq %rcx, %rdx, %rax + xorq %rdi, %rax + movq %rax, 424(%rsp) + movq 8(%r9), %rax + movq %rax, 448(%rsp) + movq 232(%rsp), %rax + movq 240(%rsp), %rcx + movq 248(%rsp), %rdx + movq 256(%rsp), %rsi + movq 264(%rsp), %rdi + xorq 272(%rsp), %rax + xorq 280(%rsp), %rcx + xorq 288(%rsp), %rdx + xorq 296(%rsp), %rsi + xorq 304(%rsp), %rdi + xorq 312(%rsp), %rax + xorq 320(%rsp), %rcx + xorq 328(%rsp), %rdx + xorq 336(%rsp), %rsi + xorq 344(%rsp), %rdi + xorq 352(%rsp), %rax + xorq 360(%rsp), %rcx + xorq 368(%rsp), %rdx + xorq 376(%rsp), %rsi + xorq 384(%rsp), %rdi + xorq 392(%rsp), %rax + xorq 400(%rsp), %rcx + xorq 408(%rsp), %rdx + xorq 416(%rsp), %rsi + xorq 424(%rsp), %rdi + movq %rcx, %r8 + rolq $1, %r8 + xorq %rdi, %r8 + movq %rdx, %r10 + rolq $1, %r10 + xorq %rax, %r10 + movq %rsi, %r11 + rolq $1, %r11 + xorq %rcx, %r11 + movq %rdi, %rcx + rolq $1, %rcx + xorq %rdx, %rcx + rolq $1, %rax + xorq %rsi, %rax + movq 232(%rsp), %rdx + xorq %r8, %rdx + movq 280(%rsp), %rsi + xorq %r10, %rsi + rolq $44, %rsi + movq 328(%rsp), %rdi + xorq %r11, %rdi + rolq $43, %rdi + movq 376(%rsp), %rbp + xorq %rcx, %rbp + rolq $21, %rbp + movq 424(%rsp), %rbx + xorq %rax, %rbx + rolq $14, %rbx + andnq %rdi, %rsi, %r12 + xorq 448(%rsp), %r12 + xorq %rdx, %r12 + movq %r12, (%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 8(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 16(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 24(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 32(%rsp) + movq 256(%rsp), %rdx + xorq %rcx, %rdx + rolq $28, %rdx + movq 304(%rsp), %rsi + xorq %rax, %rsi + rolq $20, %rsi + movq 312(%rsp), %rdi + xorq %r8, %rdi + rolq $3, %rdi + movq 360(%rsp), %rbp + xorq %r10, %rbp + rolq $45, %rbp + movq 408(%rsp), %rbx + xorq %r11, %rbx + rolq $61, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 40(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 48(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 56(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 64(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 72(%rsp) + movq 240(%rsp), %rdx + xorq %r10, %rdx + rolq $1, %rdx + movq 288(%rsp), %rsi + xorq %r11, %rsi + rolq $6, %rsi + movq 336(%rsp), %rdi + xorq %rcx, %rdi + rolq $25, %rdi + movq 384(%rsp), %rbp + xorq %rax, %rbp + rolq $8, %rbp + movq 392(%rsp), %rbx + xorq %r8, %rbx + rolq $18, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 80(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 88(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 96(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 104(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 112(%rsp) + movq 264(%rsp), %rdx + xorq %rax, %rdx + rolq $27, %rdx + movq 272(%rsp), %rsi + xorq %r8, %rsi + rolq $36, %rsi + movq 320(%rsp), %rdi + xorq %r10, %rdi + rolq $10, %rdi + movq 368(%rsp), %rbp + xorq %r11, %rbp + rolq $15, %rbp + movq 416(%rsp), %rbx + xorq %rcx, %rbx + rolq $56, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 120(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 128(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 136(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 144(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 152(%rsp) + movq 248(%rsp), %rdx + xorq %r11, %rdx + rolq $62, %rdx + movq 296(%rsp), %rsi + xorq %rcx, %rsi + rolq $55, %rsi + movq %rsi, %rcx + movq 344(%rsp), %rsi + xorq %rax, %rsi + rolq $39, %rsi + movq %rsi, %rax + movq 352(%rsp), %rsi + xorq %r8, %rsi + rolq $41, %rsi + movq 400(%rsp), %rdi + xorq %r10, %rdi + rolq $2, %rdi + andnq %rax, %rcx, %r8 + xorq %rdx, %r8 + movq %r8, 160(%rsp) + andnq %rsi, %rax, %r8 + xorq %rcx, %r8 + movq %r8, 168(%rsp) + andnq %rdi, %rsi, %r8 + xorq %rax, %r8 + movq %r8, 176(%rsp) + andnq %rdx, %rdi, %rax + xorq %rsi, %rax + movq %rax, 184(%rsp) + andnq %rcx, %rdx, %rax + xorq %rdi, %rax + movq %rax, 192(%rsp) + leaq 16(%r9), %r9 + testb $-1, %r9b + jne Lkeccak_1600$5 + movq 200(%rsp), %rax + movq 440(%rsp), %rcx + movq %rcx, %rdx + shrq $3, %rdx + movq $0, %rsi + jmp Lkeccak_1600$3 +Lkeccak_1600$4: + movq (%rsp,%rsi,8), %rdi + movq %rdi, (%rax,%rsi,8) + leaq 1(%rsi), %rsi +Lkeccak_1600$3: + cmpq %rdx, %rsi + jb Lkeccak_1600$4 + shlq $3, %rsi + jmp Lkeccak_1600$1 +Lkeccak_1600$2: + movb (%rsp,%rsi), %dl + movb %dl, (%rax,%rsi) + leaq 1(%rsi), %rsi +Lkeccak_1600$1: + cmpq %rcx, %rsi + jb Lkeccak_1600$2 + addq $456, %rsp + popq %r12 + popq %rbx + popq %rbp + ret diff --git a/code/crypto_hash/shake256/.gitignore b/code/crypto_hash/shake256/.gitignore new file mode 100644 index 0000000..0cecf76 --- /dev/null +++ b/code/crypto_hash/shake256/.gitignore @@ -0,0 +1 @@ +*.specific diff --git a/code/crypto_hash/shake256/avx2/Makefile b/code/crypto_hash/shake256/avx2/Makefile new file mode 100644 index 0000000..ab3ac88 --- /dev/null +++ b/code/crypto_hash/shake256/avx2/Makefile @@ -0,0 +1,24 @@ +# -*- Makefile -*- + +.PHONY: default clean + +# extension .specific to not break current benchmark building system +default: shake256.s shake256.s.specific + @true + +clean: + rm -f shake256.japp shake256.s shake256.japp.specific shake256.s.specific + +# shake256 +shake256.japp: shake256.jazz + gpp -I../../../ -o $@ $< + +shake256.s: shake256.japp + jasminc -lea -pasm $< > $@ || rm -f $@ + +# shake256 with specific implementation of add full block +shake256.japp.specific: shake256.jazz + gpp -I../../../ -DKECCAK_1600_SPECIFIC_IMPLEMENTATIONS -o $@ $< + +shake256.s.specific: shake256.japp.specific + jasminc -lea -pasm $< > $@ || rm -f $@ diff --git a/code/crypto_hash/shake256/avx2/shake256-m.c b/code/crypto_hash/shake256/avx2/shake256-m.c new file mode 100644 index 0000000..a377041 --- /dev/null +++ b/code/crypto_hash/shake256/avx2/shake256-m.c @@ -0,0 +1,85 @@ +#include "crypto_hash.h" +#include "impl.h" +#include "api.h" +#include +#include + + +extern void keccak_1600( + uint8_t *out, + uint64_t outlen, + const uint8_t *in, + size_t inlen, + uint64_t *c, + uint64_t **g +); + + +uint64_t rhotates_left[6*4] __attribute__((aligned(32))) = +{ + 3, 18, 36, 41, + 1, 62, 28, 27, + 45, 6, 56, 39, + 10, 61, 55, 8, + 2, 15, 25, 20, + 44, 43, 21, 14 +}; + + +uint64_t rhotates_right[6*4] __attribute__((aligned(32))) = +{ + 64-3, 64-18, 64-36, 64-41, + 64-1, 64-62, 64-28, 64-27, + 64-45, 64-6, 64-56, 64-39, + 64-10, 64-61, 64-55, 64-8, + 64-2, 64-15, 64-25, 64-20, + 64-44, 64-43, 64-21, 64-14 +}; + + +uint64_t iotas[24*4] __attribute__((aligned(32))) = +{ + 0x0000000000000001UL, 0x0000000000000001UL, 0x0000000000000001UL, 0x0000000000000001UL, + 0x0000000000008082UL, 0x0000000000008082UL, 0x0000000000008082UL, 0x0000000000008082UL, + 0x800000000000808aUL, 0x800000000000808aUL, 0x800000000000808aUL, 0x800000000000808aUL, + 0x8000000080008000UL, 0x8000000080008000UL, 0x8000000080008000UL, 0x8000000080008000UL, + 0x000000000000808bUL, 0x000000000000808bUL, 0x000000000000808bUL, 0x000000000000808bUL, + 0x0000000080000001UL, 0x0000000080000001UL, 0x0000000080000001UL, 0x0000000080000001UL, + 0x8000000080008081UL, 0x8000000080008081UL, 0x8000000080008081UL, 0x8000000080008081UL, + 0x8000000000008009UL, 0x8000000000008009UL, 0x8000000000008009UL, 0x8000000000008009UL, + 0x000000000000008aUL, 0x000000000000008aUL, 0x000000000000008aUL, 0x000000000000008aUL, + 0x0000000000000088UL, 0x0000000000000088UL, 0x0000000000000088UL, 0x0000000000000088UL, + 0x0000000080008009UL, 0x0000000080008009UL, 0x0000000080008009UL, 0x0000000080008009UL, + 0x000000008000000aUL, 0x000000008000000aUL, 0x000000008000000aUL, 0x000000008000000aUL, + 0x000000008000808bUL, 0x000000008000808bUL, 0x000000008000808bUL, 0x000000008000808bUL, + 0x800000000000008bUL, 0x800000000000008bUL, 0x800000000000008bUL, 0x800000000000008bUL, + 0x8000000000008089UL, 0x8000000000008089UL, 0x8000000000008089UL, 0x8000000000008089UL, + 0x8000000000008003UL, 0x8000000000008003UL, 0x8000000000008003UL, 0x8000000000008003UL, + 0x8000000000008002UL, 0x8000000000008002UL, 0x8000000000008002UL, 0x8000000000008002UL, + 0x8000000000000080UL, 0x8000000000000080UL, 0x8000000000000080UL, 0x8000000000000080UL, + 0x000000000000800aUL, 0x000000000000800aUL, 0x000000000000800aUL, 0x000000000000800aUL, + 0x800000008000000aUL, 0x800000008000000aUL, 0x800000008000000aUL, 0x800000008000000aUL, + 0x8000000080008081UL, 0x8000000080008081UL, 0x8000000080008081UL, 0x8000000080008081UL, + 0x8000000000008080UL, 0x8000000000008080UL, 0x8000000000008080UL, 0x8000000000008080UL, + 0x0000000080000001UL, 0x0000000080000001UL, 0x0000000080000001UL, 0x0000000080000001UL, + 0x8000000080008008UL, 0x8000000080008008UL, 0x8000000080008008UL, 0x8000000080008008UL +}; + + +uint64_t a_jagged[25] __attribute__((aligned(32))) = +{ + 0, 4, 5, 6, 7, + 10, 24, 13, 18, 23, + 8, 16, 25, 22, 15, + 11, 12, 21, 26, 19, + 9, 20, 17, 14, 27 +}; + + +int shake256_avx2(unsigned char *out,const unsigned char *in,unsigned long long inlen) +{ + uint64_t *g[] = {rhotates_left, rhotates_right, iotas, a_jagged}; + uint64_t c[] = {0x1F, (1088/8)}; + keccak_1600(out, 136, in, inlen, c, g); + return 0; +} diff --git a/code/crypto_hash/shake256/avx2/shake256.japp b/code/crypto_hash/shake256/avx2/shake256.japp new file mode 100644 index 0000000..c0a1234 --- /dev/null +++ b/code/crypto_hash/shake256/avx2/shake256.japp @@ -0,0 +1,451 @@ + + + + + +fn __keccak_f1600_avx2( + reg u256[7] state, + reg u64 _rhotates_left, + reg u64 _rhotates_right, + reg u64 _iotas +) -> reg u256[7] +{ + reg u256[9] t; + reg u256 c00 c14 d00 d14; + + reg bool zf; + reg u32 r; + reg u64 rhotates_left; + reg u64 rhotates_right; + reg u64 iotas; + + rhotates_left = _rhotates_left + 96; + rhotates_right = _rhotates_right + 96; + iotas = _iotas; + + r = 24; + align while + { + + //######################################## Theta + c00 = #x86_VPSHUFD_256(state[2], (4u2)[1,0,3,2]); + c14 = state[5] ^ state[3]; + t[2] = state[4] ^ state[6]; + c14 = c14 ^ state[1]; + c14 = c14 ^ t[2]; + t[4] = #x86_VPERMQ(c14, (4u2)[2,1,0,3]); + c00 = c00 ^ state[2]; + t[0] = #x86_VPERMQ(c00, (4u2)[1,0,3,2]); + t[1] = c14 >>4u64 63; + t[2] = c14 +4u64 c14; + t[1] = t[1] | t[2]; + d14 = #x86_VPERMQ(t[1], (4u2)[0,3,2,1]); + d00 = t[1] ^ t[4]; + d00 = #x86_VPERMQ(d00, (4u2)[0,0,0,0]); + c00 = c00 ^ state[0]; + c00 = c00 ^ t[0]; + t[0] = c00 >>4u64 63; + t[1] = c00 +4u64 c00; + t[1] = t[1] | t[0]; + state[2] = state[2] ^ d00; + state[0] = state[0] ^ d00; + d14 = #x86_VPBLENDD_256(d14, t[1], (8u1)[1,1,0,0,0,0,0,0]); + t[4] = #x86_VPBLENDD_256(t[4], c00, (8u1)[0,0,0,0,0,0,1,1]); + d14 = d14 ^ t[4]; + + //######################################## Rho + Pi + pre-Chi shuffle + t[3] = #x86_VPSLLV_4u64(state[2], (u256)[rhotates_left + 32*(0) - 96] ); + state[2] = #x86_VPSRLV_4u64(state[2], (u256)[rhotates_right + 32*(0) - 96] ); + state[2] = state[2] | t[3]; + state[3] = state[3] ^ d14; + t[4] = #x86_VPSLLV_4u64(state[3], (u256)[rhotates_left + 32*(2) - 96] ); + state[3] = #x86_VPSRLV_4u64(state[3], (u256)[rhotates_right + 32*(2) - 96] ); + state[3] = state[3] | t[4]; + state[4] = state[4] ^ d14; + t[5] = #x86_VPSLLV_4u64(state[4], (u256)[rhotates_left + 32*(3) - 96] ); + state[4] = #x86_VPSRLV_4u64(state[4], (u256)[rhotates_right + 32*(3) - 96] ); + state[4] = state[4] | t[5]; + state[5] = state[5] ^ d14; + t[6] = #x86_VPSLLV_4u64(state[5], (u256)[rhotates_left + 32*(4) - 96] ); + state[5] = #x86_VPSRLV_4u64(state[5], (u256)[rhotates_right + 32*(4) - 96] ); + state[5] = state[5] | t[6]; + state[6] = state[6] ^ d14; + t[3] = #x86_VPERMQ(state[2], (4u2)[2,0,3,1]); + t[4] = #x86_VPERMQ(state[3], (4u2)[2,0,3,1]); + t[7] = #x86_VPSLLV_4u64(state[6], (u256)[rhotates_left + 32*(5) - 96] ); + t[1] = #x86_VPSRLV_4u64(state[6], (u256)[rhotates_right + 32*(5) - 96] ); + t[1] = t[1] | t[7]; + state[1] = state[1] ^ d14; + t[5] = #x86_VPERMQ(state[4], (4u2)[0,1,2,3]); + t[6] = #x86_VPERMQ(state[5], (4u2)[1,3,0,2]); + t[8] = #x86_VPSLLV_4u64(state[1], (u256)[rhotates_left + 32*(1) - 96] ); + t[2] = #x86_VPSRLV_4u64(state[1], (u256)[rhotates_right + 32*(1) - 96] ); + t[2] = t[2] | t[8]; + + //######################################## Chi + t[7] = #x86_VPSRLDQ_256(t[1], 8); + t[0] = !t[1] & t[7]; + state[3] = #x86_VPBLENDD_256(t[2], t[6], (8u1)[0,0,0,0,1,1,0,0]); + t[8] = #x86_VPBLENDD_256(t[4], t[2], (8u1)[0,0,0,0,1,1,0,0]); + state[5] = #x86_VPBLENDD_256(t[3], t[4], (8u1)[0,0,0,0,1,1,0,0]); + t[7] = #x86_VPBLENDD_256(t[2], t[3], (8u1)[0,0,0,0,1,1,0,0]); + state[3] = #x86_VPBLENDD_256(state[3], t[4], (8u1)[0,0,1,1,0,0,0,0]); + t[8] = #x86_VPBLENDD_256(t[8], t[5], (8u1)[0,0,1,1,0,0,0,0]); + state[5] = #x86_VPBLENDD_256(state[5], t[2], (8u1)[0,0,1,1,0,0,0,0]); + t[7] = #x86_VPBLENDD_256(t[7], t[6], (8u1)[0,0,1,1,0,0,0,0]); + state[3] = #x86_VPBLENDD_256(state[3], t[5], (8u1)[1,1,0,0,0,0,0,0]); + t[8] = #x86_VPBLENDD_256(t[8], t[6], (8u1)[1,1,0,0,0,0,0,0]); + state[5] = #x86_VPBLENDD_256(state[5], t[6], (8u1)[1,1,0,0,0,0,0,0]); + t[7] = #x86_VPBLENDD_256(t[7], t[4], (8u1)[1,1,0,0,0,0,0,0]); + state[3] = !state[3] & t[8]; + state[5] = !state[5] & t[7]; + state[6] = #x86_VPBLENDD_256(t[5], t[2], (8u1)[0,0,0,0,1,1,0,0]); + t[8] = #x86_VPBLENDD_256(t[3], t[5], (8u1)[0,0,0,0,1,1,0,0]); + state[3] = state[3] ^ t[3]; + state[6] = #x86_VPBLENDD_256(state[6], t[3], (8u1)[0,0,1,1,0,0,0,0]); + t[8] = #x86_VPBLENDD_256(t[8], t[4], (8u1)[0,0,1,1,0,0,0,0]); + state[5] = state[5] ^ t[5]; + state[6] = #x86_VPBLENDD_256(state[6], t[4], (8u1)[1,1,0,0,0,0,0,0]); + t[8] = #x86_VPBLENDD_256(t[8], t[2], (8u1)[1,1,0,0,0,0,0,0]); + state[6] = !state[6] & t[8]; + state[6] = state[6] ^ t[6]; + state[4] = #x86_VPERMQ(t[1], (4u2)[0,1,3,2]); + t[8] = #x86_VPBLENDD_256(state[4], state[0], (8u1)[0,0,1,1,0,0,0,0]); + state[1] = #x86_VPERMQ(t[1], (4u2)[0,3,2,1]); + state[1] = #x86_VPBLENDD_256(state[1], state[0], (8u1)[1,1,0,0,0,0,0,0]); + state[1] = !state[1] & t[8]; + state[2] = #x86_VPBLENDD_256(t[4], t[5], (8u1)[0,0,0,0,1,1,0,0]); + t[7] = #x86_VPBLENDD_256(t[6], t[4], (8u1)[0,0,0,0,1,1,0,0]); + state[2] = #x86_VPBLENDD_256(state[2], t[6], (8u1)[0,0,1,1,0,0,0,0]); + t[7] = #x86_VPBLENDD_256(t[7], t[3], (8u1)[0,0,1,1,0,0,0,0]); + state[2] = #x86_VPBLENDD_256(state[2], t[3], (8u1)[1,1,0,0,0,0,0,0]); + t[7] = #x86_VPBLENDD_256(t[7], t[5], (8u1)[1,1,0,0,0,0,0,0]); + state[2] = !state[2] & t[7]; + state[2] = state[2] ^ t[2]; + t[0] = #x86_VPERMQ(t[0], (4u2)[0,0,0,0]); + state[3] = #x86_VPERMQ(state[3], (4u2)[0,1,2,3]); + state[5] = #x86_VPERMQ(state[5], (4u2)[2,0,3,1]); + state[6] = #x86_VPERMQ(state[6], (4u2)[1,3,0,2]); + state[4] = #x86_VPBLENDD_256(t[6], t[3], (8u1)[0,0,0,0,1,1,0,0]); + t[7] = #x86_VPBLENDD_256(t[5], t[6], (8u1)[0,0,0,0,1,1,0,0]); + state[4] = #x86_VPBLENDD_256(state[4], t[5], (8u1)[0,0,1,1,0,0,0,0]); + t[7] = #x86_VPBLENDD_256(t[7], t[2], (8u1)[0,0,1,1,0,0,0,0]); + state[4] = #x86_VPBLENDD_256(state[4], t[2], (8u1)[1,1,0,0,0,0,0,0]); + t[7] = #x86_VPBLENDD_256(t[7], t[3], (8u1)[1,1,0,0,0,0,0,0]); + state[4] = !state[4] & t[7]; + state[0] = state[0] ^ t[0]; + state[1] = state[1] ^ t[1]; + state[4] = state[4] ^ t[4]; + + //######################################## Iota + state[0] = state[0] ^ (u256)[iotas + 32*(0) - 0]; + + iotas = iotas + 32; + (_,_,_,zf,r) = #x86_DEC_32(r); + } (!zf) + + return state; +} + + +u64 g_zero = 0; + + +fn keccak_init() -> reg u256[7] +{ + inline int i; + reg u256[7] state; + + state[0] = #x86_VPBROADCAST_4u64(g_zero); + + for i=1 to 7 + { state[i] = state[0]; } + + return state; +} + + +fn init_s_state() -> stack u64[28] +{ + inline int i; + stack u64[28] s_state; + reg u256 zero; + + zero = #x86_VPBROADCAST_4u64(g_zero); + for i=0 to 7 + { s_state[u256 i] = zero; } + + return s_state; +} + + +fn add_full_block( + reg u256[7] state, + stack u64[28] s_state, + reg u64 a_jagged, + reg u64 in inlen, + reg u64 rate +) -> reg u256[7], stack u64[28], reg u64, reg u64 +{ + + inline int i; + reg u64 j l t rate8; + reg u8 c; + + rate8 = rate; + rate8 >>= 3; + j = 0; + while ( j < rate8 ) + { + t = [in + 8*j]; + l = [a_jagged + 8*( j)]; + s_state[(int) l] = t; + j += 1; + } + + // + t = s_state[0]; + s_state[1] = t; + s_state[2] = t; + s_state[3] = t; + // + + for i = 0 to 7 + { state[i] ^= s_state[u256 i]; } + + in += rate; + inlen -= rate; + + return state, s_state, in, inlen; +} + + +fn add_final_block( + reg u256[7] state, + stack u64[28] s_state, + reg u64 a_jagged, + reg u64 in inlen, + reg u8 trail_byte, + reg u64 rate +) -> reg u256[7] +{ + inline int i; + reg u64 j l t inlen8; + reg u8 c; + + s_state = init_s_state(); + + inlen8 = inlen; + inlen8 >>= 3; + j = 0; + while ( j < inlen8 ) + { + t = [in + 8*j]; + l = [a_jagged + 8*( j)]; + s_state[(int) l] = t; + j += 1; + } + l = [a_jagged + 8*( j)]; + l <<= 3; + j <<= 3; + + while ( j < inlen ) + { + c = (u8)[in + j]; + s_state[u8 (int) l] = c; + j += 1; + l += 1; + } + + s_state[u8 (int) l] = trail_byte; + + // j = (rate-1) >> 3; // TODO IMPROVE ME + j = rate; j -= 1; j >>= 3; + l = [a_jagged + 8*( j)]; + l <<= 3; + // l += ((rate-1) & 0x7); // TODO IMPROVE ME + j = rate; j -= 1; j &= 0x7; + l += j; + + s_state[u8 (int) l] ^= 0x80; + + // + t = s_state[0]; + s_state[1] = t; + s_state[2] = t; + s_state[3] = t; + // + + for i = 0 to 7 + { state[i] ^= s_state[u256 i]; } + + return state; +} + + +// obs: @pre: len <= rate_in_bytes +fn xtr_full_block( + reg u256[7] state, + reg u64 a_jagged, + reg u64 out, + reg u64 len +) -> reg u64 +{ + inline int i; + stack u64[28] s_state; + reg u64 j l t len8; + reg u8 c; + + for i = 0 to 7 + { s_state[u256 i] = state[i]; } + + len8 = len; + len8 >>= 3; + j = 0; + while ( j < len8 ) + { + l = [a_jagged + 8*( j)]; + t = s_state[(int) l]; + [out + 8*j] = t; + j += 1; + } + + out += len; + + return out; +} + + +// obs: @pre: len <= rate_in_bytes +fn xtr_bytes( + reg u256[7] state, + reg u64 a_jagged, + reg u64 out, + reg u64 len +) -> reg u64 +{ + inline int i; + stack u64[28] s_state; + reg u64 j l t len8; + reg u8 c; + + for i = 0 to 7 + { s_state[u256 i] = state[i]; } + + len8 = len; + len8 >>= 3; + j = 0; + while ( j < len8 ) + { + l = [a_jagged + 8*( j)]; + t = s_state[(int) l]; + [out + 8*j] = t; + j += 1; + } + l = [a_jagged + 8*( j)]; + + j <<= 3; + l <<= 3; + + while ( j < len ) + { + c = s_state[u8 (int) l]; + (u8)[out + j] = c; + j += 1; + l += 1; + } + + out += len; + + return out; +} + + +fn absorb( + reg u256[7] state, + reg u64 rhotates_left rhotates_right iotas a_jagged, + reg u64 in inlen, + reg u8 trail_byte, + reg u64 rate +) -> reg u256[7] +{ + stack u64[28] s_state; + s_state = init_s_state(); + + // intermediate blocks + while ( inlen >= rate ) + { + state, s_state, in, inlen = add_full_block(state, s_state, a_jagged, in, inlen, rate); + state = __keccak_f1600_avx2(state, rhotates_left, rhotates_right, iotas); + } + + // final block + state = add_final_block(state, s_state, a_jagged, in, inlen, trail_byte, rate); + + return state; +} + + +fn squeeze( + reg u256[7] state, + reg u64 rhotates_left rhotates_right iotas a_jagged, + reg u64 out outlen, + reg u64 rate +) +{ + // intermediate blocks + while ( outlen > rate ) + { + state = __keccak_f1600_avx2(state, rhotates_left, rhotates_right, iotas); + out = xtr_full_block(state, a_jagged, out, rate); + outlen -= rate; + } + + state = __keccak_f1600_avx2(state, rhotates_left, rhotates_right, iotas); + out = xtr_bytes(state, a_jagged, out, outlen); +} + + +fn __keccak_1600( + reg u64 out outlen, + reg u64 rhotates_left rhotates_right iotas a_jagged, + reg u64 in inlen, + reg u8 trail_byte, + reg u64 rate +) +{ + reg u256[7] state; + + state = keccak_init(); + + // absorb + state = absorb(state, + rhotates_left, rhotates_right, iotas, a_jagged, + in, inlen, trail_byte, rate); + + // squeeze + squeeze(state, + rhotates_left, rhotates_right, iotas, a_jagged, + out, outlen, rate); +} + + +export fn keccak_1600(reg u64 out outlen in inlen config glob) +{ + reg u64 rhotates_left rhotates_right iotas a_jagged; + reg u8 trail_byte; // no need to spill + reg u64 rate; + + trail_byte = (u8)[config + 8*0]; + rate = [config + 8*1]; // rate in bytes + + rhotates_left = [glob + 8*0]; + rhotates_right = [glob + 8*1]; + iotas = [glob + 8*2]; + a_jagged = [glob + 8*3]; + + __keccak_1600(out, outlen, + rhotates_left, rhotates_right, iotas, a_jagged, + in, inlen, + trail_byte, rate); +} diff --git a/code/crypto_hash/shake256/avx2/shake256.jazz b/code/crypto_hash/shake256/avx2/shake256.jazz new file mode 100644 index 0000000..7cf95ab --- /dev/null +++ b/code/crypto_hash/shake256/avx2/shake256.jazz @@ -0,0 +1,65 @@ +#ifdef KECCAK_1600_SPECIFIC_IMPLEMENTATIONS +#define KECCAK_1600_ADD_FULL_BLOCK_IMPLEMENTATION 1 + +u64 s_zero = 0; + +fn add_full_block( + reg u256[7] state, + stack u64[28] s_state, + reg u64 a_jagged, + reg u64 in inlen, + reg u64 rate +) -> reg u256[7], stack u64[28], reg u64, reg u64 +{ + reg u256 a00, a01, a11, a21, a31; + reg u256 t11 t41 t31 t21; + reg u256 zero; + reg u64 r10 r20 r30; + stack u64[4] s20; + + r10 = [in + 8*5]; + r20 = [in + 8*10]; + r30 = [in + 8*15]; + + s20[0] = r20; + s20[1] = 0; + s20[2] = r10; + s20[3] = r30; + + a00 = #x86_VPBROADCAST_4u64([in + 8*0]); // (0,0) (0,0) (0,0) (0,0) + a01 = (u256)[in + 8*1]; // (0,4) (0,3) (0,2) (0,1) + + state[0] ^= a00; + state[1] ^= a01; + state[2] ^= s20[u256 0]; + + a11 = (u256)[in + 8*6 ]; // (1,4) (1,3) (1,2) (1,1) + a21 = (u256)[in + 8*11]; // (2,4) (2,3) (2,2) (2,1) + a31 = #x86_VPBROADCAST_4u64([in + 8*16]); // (3,1) (3,1) (3,1) (3,1) + + t41 = #x86_VPBLENDD_256(a21, a11, (8u1)[1,1,0,0,0,0,1,1]); // (1,4) (2,3) (2,2) (1,1) + t31 = #x86_VPBLENDD_256(a21, a11, (8u1)[0,0,1,1,1,1,0,0]); // (2,4) (1,3) (1,2) (2,1) + + zero = #x86_VPBROADCAST_4u64(s_zero); + + t11 = #x86_VPBLENDD_256(t41, zero, (8u1)[1,1,1,1,0,0,0,0]); // ___ ___ (2,2) (1,1) + t21 = #x86_VPBLENDD_256(t31, zero, (8u1)[1,1,0,0,1,1,0,0]); // ___ (1,3) ___ (2,1) + t31 = #x86_VPBLENDD_256(t31, zero, (8u1)[0,0,1,1,0,0,1,1]); // (2,4) ___ (1,2) ___ + + state[6] ^= t11; + state[4] ^= t21; + + t41 = #x86_VPBLENDD_256(t41, zero, (8u1)[0,0,0,0,1,1,1,1]); // (1,4) (2,3) ___ ___ + t31 = #x86_VPBLENDD_256(t31, a31, (8u1)[0,0,0,0,0,0,1,1]); // (2,4) ___ (1,2) (3,1) + + state[5] ^= t41; + state[3] ^= t31; + + in += rate; + inlen -= rate; + + return state, s_state, in, inlen; +} +#endif + +#include "crypto_hash/keccak1600/avx2/keccak_1600.jazz" diff --git a/code/crypto_hash/shake256/avx2/shake256.s b/code/crypto_hash/shake256/avx2/shake256.s new file mode 100644 index 0000000..054443e --- /dev/null +++ b/code/crypto_hash/shake256/avx2/shake256.s @@ -0,0 +1,529 @@ + .text + .p2align 5 + .globl _keccak_1600 + .globl keccak_1600 +_keccak_1600: +keccak_1600: + pushq %rbp + pushq %rbx + pushq %r12 + pushq %r13 + pushq %r14 + subq $224, %rsp + movb (%r8), %al + movq 8(%r8), %r8 + movq (%r9), %r10 + movq 8(%r9), %r11 + movq 16(%r9), %rbp + movq 24(%r9), %r9 + vpbroadcastq g_zero(%rip), %ymm1 + vmovdqu %ymm1, %ymm2 + vmovdqu %ymm1, %ymm3 + vmovdqu %ymm1, %ymm4 + vmovdqu %ymm1, %ymm5 + vmovdqu %ymm1, %ymm6 + vmovdqu %ymm1, %ymm7 + vpbroadcastq g_zero(%rip), %ymm0 + vmovdqu %ymm0, (%rsp) + vmovdqu %ymm0, 32(%rsp) + vmovdqu %ymm0, 64(%rsp) + vmovdqu %ymm0, 96(%rsp) + vmovdqu %ymm0, 128(%rsp) + vmovdqu %ymm0, 160(%rsp) + vmovdqu %ymm0, 192(%rsp) + jmp Lkeccak_1600$15 +Lkeccak_1600$16: + movq %r8, %rbx + shrq $3, %rbx + movq $0, %r12 + jmp Lkeccak_1600$18 +Lkeccak_1600$19: + movq (%rdx,%r12,8), %r13 + movq (%r9,%r12,8), %r14 + movq %r13, (%rsp,%r14,8) + leaq 1(%r12), %r12 +Lkeccak_1600$18: + cmpq %rbx, %r12 + jb Lkeccak_1600$19 + movq (%rsp), %rbx + movq %rbx, 8(%rsp) + movq %rbx, 16(%rsp) + movq %rbx, 24(%rsp) + vpxor (%rsp), %ymm1, %ymm1 + vpxor 32(%rsp), %ymm2, %ymm2 + vpxor 64(%rsp), %ymm3, %ymm3 + vpxor 96(%rsp), %ymm4, %ymm4 + vpxor 128(%rsp), %ymm5, %ymm5 + vpxor 160(%rsp), %ymm6, %ymm6 + vpxor 192(%rsp), %ymm7, %ymm7 + leaq (%rdx,%r8), %rdx + subq %r8, %rcx + leaq 96(%r10), %rbx + leaq 96(%r11), %r12 + movq %rbp, %r13 + movl $24, %r14d + .p2align 5 +Lkeccak_1600$17: + vpshufd $78, %ymm3, %ymm0 + vpxor %ymm4, %ymm6, %ymm8 + vpxor %ymm7, %ymm5, %ymm9 + vpxor %ymm2, %ymm8, %ymm8 + vpxor %ymm9, %ymm8, %ymm8 + vpermq $-109, %ymm8, %ymm9 + vpxor %ymm3, %ymm0, %ymm0 + vpermq $78, %ymm0, %ymm10 + vpsrlq $63, %ymm8, %ymm11 + vpaddq %ymm8, %ymm8, %ymm8 + vpor %ymm8, %ymm11, %ymm8 + vpermq $57, %ymm8, %ymm11 + vpxor %ymm9, %ymm8, %ymm8 + vpermq $0, %ymm8, %ymm8 + vpxor %ymm1, %ymm0, %ymm0 + vpxor %ymm10, %ymm0, %ymm0 + vpsrlq $63, %ymm0, %ymm10 + vpaddq %ymm0, %ymm0, %ymm12 + vpor %ymm10, %ymm12, %ymm10 + vpxor %ymm8, %ymm3, %ymm3 + vpxor %ymm8, %ymm1, %ymm1 + vpblendd $-64, %ymm10, %ymm11, %ymm8 + vpblendd $3, %ymm0, %ymm9, %ymm0 + vpxor %ymm0, %ymm8, %ymm0 + vpsllvq -96(%rbx), %ymm3, %ymm8 + vpsrlvq -96(%r12), %ymm3, %ymm3 + vpor %ymm8, %ymm3, %ymm3 + vpxor %ymm0, %ymm4, %ymm4 + vpsllvq -32(%rbx), %ymm4, %ymm8 + vpsrlvq -32(%r12), %ymm4, %ymm4 + vpor %ymm8, %ymm4, %ymm4 + vpxor %ymm0, %ymm5, %ymm5 + vpsllvq (%rbx), %ymm5, %ymm8 + vpsrlvq (%r12), %ymm5, %ymm5 + vpor %ymm8, %ymm5, %ymm5 + vpxor %ymm0, %ymm6, %ymm6 + vpsllvq 32(%rbx), %ymm6, %ymm8 + vpsrlvq 32(%r12), %ymm6, %ymm6 + vpor %ymm8, %ymm6, %ymm6 + vpxor %ymm0, %ymm7, %ymm7 + vpermq $-115, %ymm3, %ymm8 + vpermq $-115, %ymm4, %ymm9 + vpsllvq 64(%rbx), %ymm7, %ymm3 + vpsrlvq 64(%r12), %ymm7, %ymm4 + vpor %ymm3, %ymm4, %ymm10 + vpxor %ymm0, %ymm2, %ymm0 + vpermq $27, %ymm5, %ymm2 + vpermq $114, %ymm6, %ymm5 + vpsllvq -64(%rbx), %ymm0, %ymm3 + vpsrlvq -64(%r12), %ymm0, %ymm0 + vpor %ymm3, %ymm0, %ymm0 + vpsrldq $8, %ymm10, %ymm3 + vpandn %ymm3, %ymm10, %ymm4 + vpblendd $12, %ymm5, %ymm0, %ymm3 + vpblendd $12, %ymm0, %ymm9, %ymm6 + vpblendd $12, %ymm9, %ymm8, %ymm7 + vpblendd $12, %ymm8, %ymm0, %ymm11 + vpblendd $48, %ymm9, %ymm3, %ymm3 + vpblendd $48, %ymm2, %ymm6, %ymm6 + vpblendd $48, %ymm0, %ymm7, %ymm7 + vpblendd $48, %ymm5, %ymm11, %ymm11 + vpblendd $-64, %ymm2, %ymm3, %ymm3 + vpblendd $-64, %ymm5, %ymm6, %ymm6 + vpblendd $-64, %ymm5, %ymm7, %ymm7 + vpblendd $-64, %ymm9, %ymm11, %ymm11 + vpandn %ymm6, %ymm3, %ymm3 + vpandn %ymm11, %ymm7, %ymm6 + vpblendd $12, %ymm0, %ymm2, %ymm7 + vpblendd $12, %ymm2, %ymm8, %ymm11 + vpxor %ymm8, %ymm3, %ymm12 + vpblendd $48, %ymm8, %ymm7, %ymm3 + vpblendd $48, %ymm9, %ymm11, %ymm7 + vpxor %ymm2, %ymm6, %ymm6 + vpblendd $-64, %ymm9, %ymm3, %ymm3 + vpblendd $-64, %ymm0, %ymm7, %ymm7 + vpandn %ymm7, %ymm3, %ymm3 + vpxor %ymm5, %ymm3, %ymm7 + vpermq $30, %ymm10, %ymm3 + vpblendd $48, %ymm1, %ymm3, %ymm3 + vpermq $57, %ymm10, %ymm11 + vpblendd $-64, %ymm1, %ymm11, %ymm11 + vpandn %ymm3, %ymm11, %ymm11 + vpblendd $12, %ymm2, %ymm9, %ymm3 + vpblendd $12, %ymm9, %ymm5, %ymm13 + vpblendd $48, %ymm5, %ymm3, %ymm3 + vpblendd $48, %ymm8, %ymm13, %ymm13 + vpblendd $-64, %ymm8, %ymm3, %ymm3 + vpblendd $-64, %ymm2, %ymm13, %ymm13 + vpandn %ymm13, %ymm3, %ymm3 + vpxor %ymm0, %ymm3, %ymm3 + vpermq $0, %ymm4, %ymm13 + vpermq $27, %ymm12, %ymm4 + vpermq $-115, %ymm6, %ymm6 + vpermq $114, %ymm7, %ymm7 + vpblendd $12, %ymm8, %ymm5, %ymm12 + vpblendd $12, %ymm5, %ymm2, %ymm5 + vpblendd $48, %ymm2, %ymm12, %ymm2 + vpblendd $48, %ymm0, %ymm5, %ymm5 + vpblendd $-64, %ymm0, %ymm2, %ymm0 + vpblendd $-64, %ymm8, %ymm5, %ymm2 + vpandn %ymm2, %ymm0, %ymm0 + vpxor %ymm13, %ymm1, %ymm1 + vpxor %ymm10, %ymm11, %ymm2 + vpxor %ymm9, %ymm0, %ymm5 + vpxor (%r13), %ymm1, %ymm1 + leaq 32(%r13), %r13 + decl %r14d + jne Lkeccak_1600$17 +Lkeccak_1600$15: + cmpq %r8, %rcx + jnb Lkeccak_1600$16 + vpbroadcastq g_zero(%rip), %ymm0 + vmovdqu %ymm0, (%rsp) + vmovdqu %ymm0, 32(%rsp) + vmovdqu %ymm0, 64(%rsp) + vmovdqu %ymm0, 96(%rsp) + vmovdqu %ymm0, 128(%rsp) + vmovdqu %ymm0, 160(%rsp) + vmovdqu %ymm0, 192(%rsp) + movq %rcx, %rbx + shrq $3, %rbx + movq $0, %r12 + jmp Lkeccak_1600$13 +Lkeccak_1600$14: + movq (%rdx,%r12,8), %r13 + movq (%r9,%r12,8), %r14 + movq %r13, (%rsp,%r14,8) + leaq 1(%r12), %r12 +Lkeccak_1600$13: + cmpq %rbx, %r12 + jb Lkeccak_1600$14 + movq (%r9,%r12,8), %rbx + shlq $3, %rbx + shlq $3, %r12 + jmp Lkeccak_1600$11 +Lkeccak_1600$12: + movb (%rdx,%r12), %r13b + movb %r13b, (%rsp,%rbx) + leaq 1(%r12), %r12 + leaq 1(%rbx), %rbx +Lkeccak_1600$11: + cmpq %rcx, %r12 + jb Lkeccak_1600$12 + movb %al, (%rsp,%rbx) + movq %r8, %rax + leaq -1(%rax), %rax + shrq $3, %rax + movq (%r9,%rax,8), %rax + shlq $3, %rax + movq %r8, %rcx + leaq -1(%rcx), %rcx + andq $7, %rcx + leaq (%rax,%rcx), %rax + xorb $-128, (%rsp,%rax) + movq (%rsp), %rax + movq %rax, 8(%rsp) + movq %rax, 16(%rsp) + movq %rax, 24(%rsp) + vpxor (%rsp), %ymm1, %ymm0 + vpxor 32(%rsp), %ymm2, %ymm1 + vpxor 64(%rsp), %ymm3, %ymm2 + vpxor 96(%rsp), %ymm4, %ymm3 + vpxor 128(%rsp), %ymm5, %ymm4 + vpxor 160(%rsp), %ymm6, %ymm5 + vpxor 192(%rsp), %ymm7, %ymm6 + jmp Lkeccak_1600$6 +Lkeccak_1600$7: + leaq 96(%r10), %rax + leaq 96(%r11), %rcx + movq %rbp, %rdx + movl $24, %ebx + .p2align 5 +Lkeccak_1600$10: + vpshufd $78, %ymm2, %ymm7 + vpxor %ymm3, %ymm5, %ymm8 + vpxor %ymm6, %ymm4, %ymm9 + vpxor %ymm1, %ymm8, %ymm8 + vpxor %ymm9, %ymm8, %ymm8 + vpermq $-109, %ymm8, %ymm9 + vpxor %ymm2, %ymm7, %ymm7 + vpermq $78, %ymm7, %ymm10 + vpsrlq $63, %ymm8, %ymm11 + vpaddq %ymm8, %ymm8, %ymm8 + vpor %ymm8, %ymm11, %ymm8 + vpermq $57, %ymm8, %ymm11 + vpxor %ymm9, %ymm8, %ymm8 + vpermq $0, %ymm8, %ymm8 + vpxor %ymm0, %ymm7, %ymm7 + vpxor %ymm10, %ymm7, %ymm7 + vpsrlq $63, %ymm7, %ymm10 + vpaddq %ymm7, %ymm7, %ymm12 + vpor %ymm10, %ymm12, %ymm10 + vpxor %ymm8, %ymm2, %ymm2 + vpxor %ymm8, %ymm0, %ymm0 + vpblendd $-64, %ymm10, %ymm11, %ymm8 + vpblendd $3, %ymm7, %ymm9, %ymm7 + vpxor %ymm7, %ymm8, %ymm7 + vpsllvq -96(%rax), %ymm2, %ymm8 + vpsrlvq -96(%rcx), %ymm2, %ymm2 + vpor %ymm8, %ymm2, %ymm2 + vpxor %ymm7, %ymm3, %ymm3 + vpsllvq -32(%rax), %ymm3, %ymm8 + vpsrlvq -32(%rcx), %ymm3, %ymm3 + vpor %ymm8, %ymm3, %ymm3 + vpxor %ymm7, %ymm4, %ymm4 + vpsllvq (%rax), %ymm4, %ymm8 + vpsrlvq (%rcx), %ymm4, %ymm4 + vpor %ymm8, %ymm4, %ymm4 + vpxor %ymm7, %ymm5, %ymm5 + vpsllvq 32(%rax), %ymm5, %ymm8 + vpsrlvq 32(%rcx), %ymm5, %ymm5 + vpor %ymm8, %ymm5, %ymm5 + vpxor %ymm7, %ymm6, %ymm6 + vpermq $-115, %ymm2, %ymm8 + vpermq $-115, %ymm3, %ymm9 + vpsllvq 64(%rax), %ymm6, %ymm2 + vpsrlvq 64(%rcx), %ymm6, %ymm3 + vpor %ymm2, %ymm3, %ymm10 + vpxor %ymm7, %ymm1, %ymm1 + vpermq $27, %ymm4, %ymm4 + vpermq $114, %ymm5, %ymm7 + vpsllvq -64(%rax), %ymm1, %ymm2 + vpsrlvq -64(%rcx), %ymm1, %ymm1 + vpor %ymm2, %ymm1, %ymm1 + vpsrldq $8, %ymm10, %ymm2 + vpandn %ymm2, %ymm10, %ymm3 + vpblendd $12, %ymm7, %ymm1, %ymm2 + vpblendd $12, %ymm1, %ymm9, %ymm5 + vpblendd $12, %ymm9, %ymm8, %ymm6 + vpblendd $12, %ymm8, %ymm1, %ymm11 + vpblendd $48, %ymm9, %ymm2, %ymm2 + vpblendd $48, %ymm4, %ymm5, %ymm5 + vpblendd $48, %ymm1, %ymm6, %ymm6 + vpblendd $48, %ymm7, %ymm11, %ymm11 + vpblendd $-64, %ymm4, %ymm2, %ymm2 + vpblendd $-64, %ymm7, %ymm5, %ymm5 + vpblendd $-64, %ymm7, %ymm6, %ymm6 + vpblendd $-64, %ymm9, %ymm11, %ymm11 + vpandn %ymm5, %ymm2, %ymm2 + vpandn %ymm11, %ymm6, %ymm5 + vpblendd $12, %ymm1, %ymm4, %ymm6 + vpblendd $12, %ymm4, %ymm8, %ymm11 + vpxor %ymm8, %ymm2, %ymm12 + vpblendd $48, %ymm8, %ymm6, %ymm2 + vpblendd $48, %ymm9, %ymm11, %ymm6 + vpxor %ymm4, %ymm5, %ymm5 + vpblendd $-64, %ymm9, %ymm2, %ymm2 + vpblendd $-64, %ymm1, %ymm6, %ymm6 + vpandn %ymm6, %ymm2, %ymm2 + vpxor %ymm7, %ymm2, %ymm6 + vpermq $30, %ymm10, %ymm2 + vpblendd $48, %ymm0, %ymm2, %ymm2 + vpermq $57, %ymm10, %ymm11 + vpblendd $-64, %ymm0, %ymm11, %ymm11 + vpandn %ymm2, %ymm11, %ymm11 + vpblendd $12, %ymm4, %ymm9, %ymm2 + vpblendd $12, %ymm9, %ymm7, %ymm13 + vpblendd $48, %ymm7, %ymm2, %ymm2 + vpblendd $48, %ymm8, %ymm13, %ymm13 + vpblendd $-64, %ymm8, %ymm2, %ymm2 + vpblendd $-64, %ymm4, %ymm13, %ymm13 + vpandn %ymm13, %ymm2, %ymm2 + vpxor %ymm1, %ymm2, %ymm2 + vpermq $0, %ymm3, %ymm13 + vpermq $27, %ymm12, %ymm3 + vpermq $-115, %ymm5, %ymm5 + vpermq $114, %ymm6, %ymm6 + vpblendd $12, %ymm8, %ymm7, %ymm12 + vpblendd $12, %ymm7, %ymm4, %ymm7 + vpblendd $48, %ymm4, %ymm12, %ymm4 + vpblendd $48, %ymm1, %ymm7, %ymm7 + vpblendd $-64, %ymm1, %ymm4, %ymm1 + vpblendd $-64, %ymm8, %ymm7, %ymm4 + vpandn %ymm4, %ymm1, %ymm4 + vpxor %ymm13, %ymm0, %ymm0 + vpxor %ymm10, %ymm11, %ymm1 + vpxor %ymm9, %ymm4, %ymm4 + vpxor (%rdx), %ymm0, %ymm0 + leaq 32(%rdx), %rdx + decl %ebx + jne Lkeccak_1600$10 + vmovdqu %ymm0, (%rsp) + vmovdqu %ymm1, 32(%rsp) + vmovdqu %ymm2, 64(%rsp) + vmovdqu %ymm3, 96(%rsp) + vmovdqu %ymm4, 128(%rsp) + vmovdqu %ymm5, 160(%rsp) + vmovdqu %ymm6, 192(%rsp) + movq %r8, %rax + shrq $3, %rax + movq $0, %rcx + jmp Lkeccak_1600$8 +Lkeccak_1600$9: + movq (%r9,%rcx,8), %rdx + movq (%rsp,%rdx,8), %rdx + movq %rdx, (%rdi,%rcx,8) + leaq 1(%rcx), %rcx +Lkeccak_1600$8: + cmpq %rax, %rcx + jb Lkeccak_1600$9 + leaq (%rdi,%r8), %rdi + subq %r8, %rsi +Lkeccak_1600$6: + cmpq %r8, %rsi + jnbe Lkeccak_1600$7 + leaq 96(%r10), %rax + leaq 96(%r11), %rcx + movl $24, %edx + .p2align 5 +Lkeccak_1600$5: + vpshufd $78, %ymm2, %ymm7 + vpxor %ymm3, %ymm5, %ymm8 + vpxor %ymm6, %ymm4, %ymm9 + vpxor %ymm1, %ymm8, %ymm8 + vpxor %ymm9, %ymm8, %ymm8 + vpermq $-109, %ymm8, %ymm9 + vpxor %ymm2, %ymm7, %ymm7 + vpermq $78, %ymm7, %ymm10 + vpsrlq $63, %ymm8, %ymm11 + vpaddq %ymm8, %ymm8, %ymm8 + vpor %ymm8, %ymm11, %ymm8 + vpermq $57, %ymm8, %ymm11 + vpxor %ymm9, %ymm8, %ymm8 + vpermq $0, %ymm8, %ymm8 + vpxor %ymm0, %ymm7, %ymm7 + vpxor %ymm10, %ymm7, %ymm7 + vpsrlq $63, %ymm7, %ymm10 + vpaddq %ymm7, %ymm7, %ymm12 + vpor %ymm10, %ymm12, %ymm10 + vpxor %ymm8, %ymm2, %ymm2 + vpxor %ymm8, %ymm0, %ymm0 + vpblendd $-64, %ymm10, %ymm11, %ymm8 + vpblendd $3, %ymm7, %ymm9, %ymm7 + vpxor %ymm7, %ymm8, %ymm7 + vpsllvq -96(%rax), %ymm2, %ymm8 + vpsrlvq -96(%rcx), %ymm2, %ymm2 + vpor %ymm8, %ymm2, %ymm2 + vpxor %ymm7, %ymm3, %ymm3 + vpsllvq -32(%rax), %ymm3, %ymm8 + vpsrlvq -32(%rcx), %ymm3, %ymm3 + vpor %ymm8, %ymm3, %ymm3 + vpxor %ymm7, %ymm4, %ymm4 + vpsllvq (%rax), %ymm4, %ymm8 + vpsrlvq (%rcx), %ymm4, %ymm4 + vpor %ymm8, %ymm4, %ymm4 + vpxor %ymm7, %ymm5, %ymm5 + vpsllvq 32(%rax), %ymm5, %ymm8 + vpsrlvq 32(%rcx), %ymm5, %ymm5 + vpor %ymm8, %ymm5, %ymm5 + vpxor %ymm7, %ymm6, %ymm6 + vpermq $-115, %ymm2, %ymm8 + vpermq $-115, %ymm3, %ymm9 + vpsllvq 64(%rax), %ymm6, %ymm2 + vpsrlvq 64(%rcx), %ymm6, %ymm3 + vpor %ymm2, %ymm3, %ymm10 + vpxor %ymm7, %ymm1, %ymm1 + vpermq $27, %ymm4, %ymm4 + vpermq $114, %ymm5, %ymm7 + vpsllvq -64(%rax), %ymm1, %ymm2 + vpsrlvq -64(%rcx), %ymm1, %ymm1 + vpor %ymm2, %ymm1, %ymm1 + vpsrldq $8, %ymm10, %ymm2 + vpandn %ymm2, %ymm10, %ymm3 + vpblendd $12, %ymm7, %ymm1, %ymm2 + vpblendd $12, %ymm1, %ymm9, %ymm5 + vpblendd $12, %ymm9, %ymm8, %ymm6 + vpblendd $12, %ymm8, %ymm1, %ymm11 + vpblendd $48, %ymm9, %ymm2, %ymm2 + vpblendd $48, %ymm4, %ymm5, %ymm5 + vpblendd $48, %ymm1, %ymm6, %ymm6 + vpblendd $48, %ymm7, %ymm11, %ymm11 + vpblendd $-64, %ymm4, %ymm2, %ymm2 + vpblendd $-64, %ymm7, %ymm5, %ymm5 + vpblendd $-64, %ymm7, %ymm6, %ymm6 + vpblendd $-64, %ymm9, %ymm11, %ymm11 + vpandn %ymm5, %ymm2, %ymm2 + vpandn %ymm11, %ymm6, %ymm5 + vpblendd $12, %ymm1, %ymm4, %ymm6 + vpblendd $12, %ymm4, %ymm8, %ymm11 + vpxor %ymm8, %ymm2, %ymm12 + vpblendd $48, %ymm8, %ymm6, %ymm2 + vpblendd $48, %ymm9, %ymm11, %ymm6 + vpxor %ymm4, %ymm5, %ymm5 + vpblendd $-64, %ymm9, %ymm2, %ymm2 + vpblendd $-64, %ymm1, %ymm6, %ymm6 + vpandn %ymm6, %ymm2, %ymm2 + vpxor %ymm7, %ymm2, %ymm6 + vpermq $30, %ymm10, %ymm2 + vpblendd $48, %ymm0, %ymm2, %ymm2 + vpermq $57, %ymm10, %ymm11 + vpblendd $-64, %ymm0, %ymm11, %ymm11 + vpandn %ymm2, %ymm11, %ymm11 + vpblendd $12, %ymm4, %ymm9, %ymm2 + vpblendd $12, %ymm9, %ymm7, %ymm13 + vpblendd $48, %ymm7, %ymm2, %ymm2 + vpblendd $48, %ymm8, %ymm13, %ymm13 + vpblendd $-64, %ymm8, %ymm2, %ymm2 + vpblendd $-64, %ymm4, %ymm13, %ymm13 + vpandn %ymm13, %ymm2, %ymm2 + vpxor %ymm1, %ymm2, %ymm2 + vpermq $0, %ymm3, %ymm13 + vpermq $27, %ymm12, %ymm3 + vpermq $-115, %ymm5, %ymm5 + vpermq $114, %ymm6, %ymm6 + vpblendd $12, %ymm8, %ymm7, %ymm12 + vpblendd $12, %ymm7, %ymm4, %ymm7 + vpblendd $48, %ymm4, %ymm12, %ymm4 + vpblendd $48, %ymm1, %ymm7, %ymm7 + vpblendd $-64, %ymm1, %ymm4, %ymm1 + vpblendd $-64, %ymm8, %ymm7, %ymm4 + vpandn %ymm4, %ymm1, %ymm4 + vpxor %ymm13, %ymm0, %ymm0 + vpxor %ymm10, %ymm11, %ymm1 + vpxor %ymm9, %ymm4, %ymm4 + vpxor (%rbp), %ymm0, %ymm0 + leaq 32(%rbp), %rbp + decl %edx + jne Lkeccak_1600$5 + vmovdqu %ymm0, (%rsp) + vmovdqu %ymm1, 32(%rsp) + vmovdqu %ymm2, 64(%rsp) + vmovdqu %ymm3, 96(%rsp) + vmovdqu %ymm4, 128(%rsp) + vmovdqu %ymm5, 160(%rsp) + vmovdqu %ymm6, 192(%rsp) + movq %rsi, %rax + shrq $3, %rax + movq $0, %rcx + jmp Lkeccak_1600$3 +Lkeccak_1600$4: + movq (%r9,%rcx,8), %rdx + movq (%rsp,%rdx,8), %rdx + movq %rdx, (%rdi,%rcx,8) + leaq 1(%rcx), %rcx +Lkeccak_1600$3: + cmpq %rax, %rcx + jb Lkeccak_1600$4 + movq (%r9,%rcx,8), %rax + shlq $3, %rcx + shlq $3, %rax + jmp Lkeccak_1600$1 +Lkeccak_1600$2: + movb (%rsp,%rax), %dl + movb %dl, (%rdi,%rcx) + leaq 1(%rcx), %rcx + leaq 1(%rax), %rax +Lkeccak_1600$1: + cmpq %rsi, %rcx + jb Lkeccak_1600$2 + addq $224, %rsp + popq %r14 + popq %r13 + popq %r12 + popq %rbx + popq %rbp + ret + .data + .globl _g_zero + .globl g_zero + .p2align 3 +_g_zero: +g_zero: + .quad 0 diff --git a/code/crypto_hash/shake256/ref/.gitignore b/code/crypto_hash/shake256/ref/.gitignore new file mode 100644 index 0000000..07c4490 --- /dev/null +++ b/code/crypto_hash/shake256/ref/.gitignore @@ -0,0 +1,2 @@ +*.s +*.japp diff --git a/code/crypto_hash/shake256/ref/Makefile b/code/crypto_hash/shake256/ref/Makefile new file mode 100644 index 0000000..fa5211f --- /dev/null +++ b/code/crypto_hash/shake256/ref/Makefile @@ -0,0 +1,15 @@ +# -*- Makefile -*- + +.PHONY: default clean + +default: shake256.japp shake256.s + @true + +clean: + rm -f shake256.japp shake256.s + +%.s: %.japp + jasminc -lea -pasm $< > $@ || rm -f $@ + +%.japp: %.jazz + gpp -I../../../ -o $@ $< diff --git a/code/crypto_hash/shake256/ref/shake256-m.c b/code/crypto_hash/shake256/ref/shake256-m.c new file mode 100644 index 0000000..4930bb2 --- /dev/null +++ b/code/crypto_hash/shake256/ref/shake256-m.c @@ -0,0 +1,22 @@ +#include "crypto_hash.h" +#include "impl.h" +#include "api.h" +#include +#include + + +extern void keccak_1600( + uint8_t *out, + uint64_t outlen, + const uint8_t *in, + size_t inlen, + uint64_t *c +); + + +int shake256_ref(unsigned char *out,const unsigned char *in,unsigned long long inlen) +{ + uint64_t c[] = {0x1F, (1088/8)}; + keccak_1600(out, 136, in, inlen, c); + return 0; +} diff --git a/code/crypto_hash/shake256/ref/shake256.jazz b/code/crypto_hash/shake256/ref/shake256.jazz new file mode 100644 index 0000000..d70cfca --- /dev/null +++ b/code/crypto_hash/shake256/ref/shake256.jazz @@ -0,0 +1 @@ +#include "crypto_hash/keccak1600/ref/keccak_1600.jazz" diff --git a/code/crypto_hash/shake256/scalar/Makefile b/code/crypto_hash/shake256/scalar/Makefile new file mode 100644 index 0000000..fa5211f --- /dev/null +++ b/code/crypto_hash/shake256/scalar/Makefile @@ -0,0 +1,15 @@ +# -*- Makefile -*- + +.PHONY: default clean + +default: shake256.japp shake256.s + @true + +clean: + rm -f shake256.japp shake256.s + +%.s: %.japp + jasminc -lea -pasm $< > $@ || rm -f $@ + +%.japp: %.jazz + gpp -I../../../ -o $@ $< diff --git a/code/crypto_hash/shake256/scalar/shake256-m.c b/code/crypto_hash/shake256/scalar/shake256-m.c new file mode 100644 index 0000000..8129a0d --- /dev/null +++ b/code/crypto_hash/shake256/scalar/shake256-m.c @@ -0,0 +1,54 @@ +#include "crypto_hash.h" +#include "impl.h" +#include "api.h" +#include +#include + + +extern void keccak_1600( + uint8_t *out, + uint64_t outlen, + const uint8_t *in, + size_t inlen, + uint64_t *c, + uint64_t *iotas +); + + +uint64_t iotas[32] __attribute__((aligned(256))) = +{ + 0,0,0,0,0,0,0,0 + , 0x0000000000000001 + , 0x0000000000008082 + , 0x800000000000808a + , 0x8000000080008000 + , 0x000000000000808b + , 0x0000000080000001 + , 0x8000000080008081 + , 0x8000000000008009 + , 0x000000000000008a + , 0x0000000000000088 + , 0x0000000080008009 + , 0x000000008000000a + , 0x000000008000808b + , 0x800000000000008b + , 0x8000000000008089 + , 0x8000000000008003 + , 0x8000000000008002 + , 0x8000000000000080 + , 0x000000000000800a + , 0x800000008000000a + , 0x8000000080008081 + , 0x8000000000008080 + , 0x0000000080000001 + , 0x8000000080008008 +}; + + +int shake256_scalar(unsigned char *out,const unsigned char *in,unsigned long long inlen) +{ + uint64_t c[] = {0x1F, (1088/8)}; + keccak_1600(out, 136, in, inlen, c, &(iotas[8])); + return 0; +} + diff --git a/code/crypto_hash/shake256/scalar/shake256.japp b/code/crypto_hash/shake256/scalar/shake256.japp new file mode 100644 index 0000000..2b32219 --- /dev/null +++ b/code/crypto_hash/shake256/scalar/shake256.japp @@ -0,0 +1,481 @@ + + // 0 uses external memory for the stack space + // 1 uses stack u64[] array + + + + + + +fn index(inline int x, inline int y) -> inline int { + inline int r; + r = 5*(x % 5) + (y % 5); + return r; +} + + + +fn keccak_rho_offsets(inline int i) -> inline int +{ + inline int r, x, y, z, t; + r = 0; + x = 1; + y = 0; + for t = 0 to 24 + { if ( i == x + 5 * y ) + { r = ((t + 1) * (t + 2) / 2) % 64; + } + z = (2 * x + 3 * y) % 5; + x = y; + y = z; + } + + return r; +} + + + +fn rhotates(inline int x y) -> inline int +{ + inline int i r; + i = index(x, y); + r = keccak_rho_offsets(i); + return r; +} + + + +fn ROL64(reg u64 x, inline int c) -> reg u64 +{ + reg u64 y; + if (c == 0) + { y = x; } + else + { _, _, y = #x86_ROL_64(x, c); } + return y; +} + + +fn theta_sum(stack u64[25] A) -> reg u64[5] +{ + inline int i j; + reg u64[5] C; + + for i=0 to 5 + { C[i] = A[(5*(( 0) % 5) + (( i) % 5))]; } + + for j=1 to 5 + { for i=0 to 5 + { C[i] ^= A[(5*(( j) % 5) + (( i) % 5))]; } + } + + return C; +} + + + +fn theta_rol(reg u64[5] C) -> reg u64[5] +{ + inline int i; + reg u64[5] D; + reg u64 t r; + + for i = 0 to 5 + { D[i] = C[(i+1)%5]; + _, _, D[i] = #x86_ROL_64(D[i], 1); + D[i] ^= C[(i+4)%5]; + } + + return D; +} + + + +fn rol_sum( + reg u64[5] D, + stack u64[25] A, + inline int offset +) -> reg u64[5] +{ + inline int j j1 k; + reg u64[5] C; + reg u64 t; + + for j = 0 to 5 + { + j1 = (j+offset) % 5; + k = rhotates(j, j1); + t = A[(5*((j) % 5) + ((j1) % 5))]; + t ^= D[j1]; + t = ROL64(t, k); + C[j] = t; + } + + return C; +} + + + +fn set_row( + stack u64[25] R, + inline int row, + reg u64[5] C, + stack u64 iota +) -> stack u64[25] +{ + inline int j j1 j2; + reg u64 t; + + for j= 0 to 5 + { + j1 = (j+1) % 5; + j2 = (j+2) % 5; + t = !C[j1] & C[j2]; + if row==0 && j==0 { t ^= iota; } + t ^= C[j]; + R[(5*(( row) % 5) + (( j) % 5))] = t; + } + + return R; +} + + + +fn round2x( + stack u64[25] A, + stack u64[25] R, + reg u64 iotas, + inline int o +) -> stack u64[25], stack u64[25] +{ + reg u64[5] C D; + stack u64 iota; + + iota = [iotas + o]; + C = theta_sum(A); + D = theta_rol(C); + C = rol_sum(D, A, 0); + R = set_row(R, 0, C, iota); + C = rol_sum(D, A, 3); + R = set_row(R, 1, C, iota); + C = rol_sum(D, A, 1); + R = set_row(R, 2, C, iota); + C = rol_sum(D, A, 4); + R = set_row(R, 3, C, iota); + C = rol_sum(D, A, 2); + R = set_row(R, 4, C, iota); + + return A, R; +} + + + +fn __keccak_f1600_scalar( + stack u64[25] A, + reg u64 iotas +) -> stack u64[25], reg u64 +{ + reg bool zf; + stack u64[25] R; + + while + { + A, R = round2x(A, R, iotas, 0); + R, A = round2x(R, A, iotas, 8); + iotas += 16; + _, _, _, _, zf = #x86_TEST_8(iotas,255); + } (!zf) + + iotas -= 192; + + return A, iotas; +} + + +fn spill_2(reg u64 a b) -> stack u64, stack u64 +{ + stack u64 sa sb; + sa = a; + sb = b; + return sa, sb; +} + + +fn spill_3(reg u64 a b c) -> stack u64, stack u64, stack u64 +{ + stack u64 sa sb sc; + sa = a; + sb = b; + sc = c; + return sa, sb, sc; +} + + +fn load_2(stack u64 sa sb) -> reg u64, reg u64 +{ + reg u64 a b; + a = sa; + b = sb; + return a, b; +} + + +fn load_3(stack u64 sa sb sc) -> reg u64, reg u64, reg u64 +{ + reg u64 a b c; + a = sa; + b = sb; + c = sc; + return a, b, c; +} + + +fn keccak_init( + ) -> stack u64[25] +{ + stack u64[25] state; + reg u64 i t; + + _, _, _, _, _, t = #set0(); + + + i = 0; + while (i < 25) + { state[(int)i] = t; + i += 1; + } + + return state; +} + + +fn add_full_block( + stack u64[25] state, + reg u64 in, + reg u64 inlen, + reg u64 rate +) -> stack u64[25], reg u64, reg u64 +{ + reg u64 i t rate64; + + rate64 = rate; + rate64 >>= 3; + i = 0; + while( i < rate64) + { + t = [in + 8*i]; + state[(int)i] ^= t; + i+=1; + } + + in += rate; + inlen -= rate; + + return state, in, inlen; +} + + + + +// obs: @pre: inlen < rate_in_bytes +fn add_final_block( + stack u64[25] state, + reg u64 in, + reg u64 inlen, + reg u8 trail_byte, + reg u64 rate +) -> stack u64[25] +{ + reg u64 i t inlen8; + reg u8 c; + + inlen8 = inlen; + inlen8 >>= 3; + i = 0; + while ( i < inlen8 ) + { + t = [in + 8*i]; + state[(int)i] ^= t; + i += 1; + } + + + i <<= 3; + while ( i < inlen ) + { + c = (u8)[in + i]; + state[u8 (int)(i)] ^= c; + i += 1; + } + + state[u8 (int)(i)] ^= trail_byte; + + i = rate; + i -= 1; + state[u8 (int)(i)] ^= 0x80; + + return state; +} + + +fn absorb( + stack u64[25] state, + reg u64 iotas, + reg u64 in inlen, + stack u64 s_trail_byte, + reg u64 rate // rate already in bytes -- it is returned bc of spills +) -> stack u64[25], reg u64, reg u64 +{ + stack u64 s_in s_inlen s_rate; + reg u8 trail_byte; + reg u64 t; + + // intermediate blocks + while ( inlen >= rate ) + { + state, in, inlen = add_full_block(state, in, inlen, rate); + s_in, s_inlen, s_rate = spill_3(in, inlen, rate); + + state, iotas = __keccak_f1600_scalar(state, iotas); + in, inlen, rate = load_3(s_in, s_inlen, s_rate); + } + + // final block + t = s_trail_byte; + trail_byte = (8u) t; + + state = add_final_block(state, in, inlen, trail_byte, rate); + + return state, iotas, rate; +} + + +fn xtr_full_block( + stack u64[25] state, + reg u64 out, + reg u64 outlen, + reg u64 rate +) -> reg u64, reg u64 +{ + reg u64 i t rate64; + + rate64 = rate; + rate64 >>= 3; + i = 0; + while ( i < rate64 ) + { + t = state[(int)i]; + [out + 8*i] = t; + i += 1; + } + + out += rate; + outlen -= rate; + + return out, outlen; +} + + +fn xtr_bytes( + stack u64[25] state, + reg u64 out, + reg u64 outlen +) -> reg u64 +{ + reg u64 i t outlen8; + reg u8 c; + + outlen8 = outlen; + outlen8 >>= 3; + i = 0; + while ( i < outlen8 ) + { + t = state[(int)i]; + [out + 8*i] = t; + i += 1; + } + i <<= 3; + + while ( i < outlen ) + { + c = state[u8 (int)(i)]; + (u8)[out + i] = c; + i += 1; + } + + out += outlen; + return out; +} + + +fn squeeze( + stack u64[25] state, + reg u64 iotas, + stack u64 s_out, + reg u64 outlen, + reg u64 rate +) +{ + reg u64 out; + stack u64 s_outlen s_rate; + + // intermediate blocks + while ( outlen > rate ) + { + s_outlen, s_rate = spill_2(outlen, rate); + state, iotas = __keccak_f1600_scalar(state, iotas); + out, outlen, rate = load_3(s_out, s_outlen, s_rate); + + out, outlen = xtr_full_block(state, out, outlen, rate); + s_out = out; + } + + s_outlen = outlen; + state, iotas = __keccak_f1600_scalar(state, iotas); + out, outlen = load_2(s_out, s_outlen); + + out = xtr_bytes(state, out, outlen); +} + + +fn __keccak_1600( + stack u64 s_out s_outlen, + reg u64 iotas, + reg u64 in inlen , + stack u64 s_trail_byte, + reg u64 rate +) +{ + stack u64[25] state; + reg u64 outlen; + + state = keccak_init(); + + // absorb + state, iotas, rate = absorb(state, iotas, in, inlen, s_trail_byte, rate); + + // squeeze + outlen = s_outlen; + squeeze(state, iotas, s_out, outlen, rate); +} + + +export fn keccak_1600(reg u64 out outlen in inlen_ config iotas ) +{ + stack u64 s_trail_byte; + stack u64 s_out s_outlen; + reg u64 trail_byte; + reg u64 rate inlen; + + s_out = out; + s_outlen = outlen; + + inlen = inlen_; // swap register, rcx is needed + + trail_byte = (64u)(u8)[config + 8*0]; + s_trail_byte = trail_byte; + + rate = [config + 8*1]; // rate in bytes + + __keccak_1600(s_out, s_outlen, iotas, in, inlen, s_trail_byte, rate); +} diff --git a/code/crypto_hash/shake256/scalar/shake256.jazz b/code/crypto_hash/shake256/scalar/shake256.jazz new file mode 100644 index 0000000..d2fa40e --- /dev/null +++ b/code/crypto_hash/shake256/scalar/shake256.jazz @@ -0,0 +1 @@ +#include "crypto_hash/keccak1600/scalar/keccak_1600.jazz" diff --git a/code/crypto_hash/shake256/scalar/shake256.s b/code/crypto_hash/shake256/scalar/shake256.s new file mode 100644 index 0000000..f79b7d1 --- /dev/null +++ b/code/crypto_hash/shake256/scalar/shake256.s @@ -0,0 +1,1299 @@ + .text + .p2align 5 + .globl _keccak_1600 + .globl keccak_1600 +_keccak_1600: +keccak_1600: + pushq %rbp + pushq %rbx + pushq %r12 + subq $456, %rsp + movq %rdi, 200(%rsp) + movq %rsi, 448(%rsp) + movzbq (%r8), %rax + movq %rax, 440(%rsp) + movq 8(%r8), %rax + xorl %esi, %esi + movq $0, %rdi + jmp Lkeccak_1600$20 +Lkeccak_1600$21: + movq %rsi, (%rsp,%rdi,8) + leaq 1(%rdi), %rdi +Lkeccak_1600$20: + cmpq $25, %rdi + jb Lkeccak_1600$21 + jmp Lkeccak_1600$15 +Lkeccak_1600$16: + movq %rax, %rsi + shrq $3, %rsi + movq $0, %rdi + jmp Lkeccak_1600$18 +Lkeccak_1600$19: + movq (%rdx,%rdi,8), %r8 + xorq %r8, (%rsp,%rdi,8) + leaq 1(%rdi), %rdi +Lkeccak_1600$18: + cmpq %rsi, %rdi + jb Lkeccak_1600$19 + leaq (%rdx,%rax), %rdx + subq %rax, %rcx + movq %rdx, 224(%rsp) + movq %rcx, 216(%rsp) + movq %rax, 208(%rsp) +Lkeccak_1600$17: + movq (%r9), %rax + movq %rax, 432(%rsp) + movq (%rsp), %rax + movq 8(%rsp), %rcx + movq 16(%rsp), %rdx + movq 24(%rsp), %rsi + movq 32(%rsp), %rdi + xorq 40(%rsp), %rax + xorq 48(%rsp), %rcx + xorq 56(%rsp), %rdx + xorq 64(%rsp), %rsi + xorq 72(%rsp), %rdi + xorq 80(%rsp), %rax + xorq 88(%rsp), %rcx + xorq 96(%rsp), %rdx + xorq 104(%rsp), %rsi + xorq 112(%rsp), %rdi + xorq 120(%rsp), %rax + xorq 128(%rsp), %rcx + xorq 136(%rsp), %rdx + xorq 144(%rsp), %rsi + xorq 152(%rsp), %rdi + xorq 160(%rsp), %rax + xorq 168(%rsp), %rcx + xorq 176(%rsp), %rdx + xorq 184(%rsp), %rsi + xorq 192(%rsp), %rdi + movq %rcx, %r8 + rolq $1, %r8 + xorq %rdi, %r8 + movq %rdx, %r10 + rolq $1, %r10 + xorq %rax, %r10 + movq %rsi, %r11 + rolq $1, %r11 + xorq %rcx, %r11 + movq %rdi, %rcx + rolq $1, %rcx + xorq %rdx, %rcx + rolq $1, %rax + xorq %rsi, %rax + movq (%rsp), %rdx + xorq %r8, %rdx + movq 48(%rsp), %rsi + xorq %r10, %rsi + rolq $44, %rsi + movq 96(%rsp), %rdi + xorq %r11, %rdi + rolq $43, %rdi + movq 144(%rsp), %rbp + xorq %rcx, %rbp + rolq $21, %rbp + movq 192(%rsp), %rbx + xorq %rax, %rbx + rolq $14, %rbx + andnq %rdi, %rsi, %r12 + xorq 432(%rsp), %r12 + xorq %rdx, %r12 + movq %r12, 232(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 240(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 248(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 256(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 264(%rsp) + movq 24(%rsp), %rdx + xorq %rcx, %rdx + rolq $28, %rdx + movq 72(%rsp), %rsi + xorq %rax, %rsi + rolq $20, %rsi + movq 80(%rsp), %rdi + xorq %r8, %rdi + rolq $3, %rdi + movq 128(%rsp), %rbp + xorq %r10, %rbp + rolq $45, %rbp + movq 176(%rsp), %rbx + xorq %r11, %rbx + rolq $61, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 272(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 280(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 288(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 296(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 304(%rsp) + movq 8(%rsp), %rdx + xorq %r10, %rdx + rolq $1, %rdx + movq 56(%rsp), %rsi + xorq %r11, %rsi + rolq $6, %rsi + movq 104(%rsp), %rdi + xorq %rcx, %rdi + rolq $25, %rdi + movq 152(%rsp), %rbp + xorq %rax, %rbp + rolq $8, %rbp + movq 160(%rsp), %rbx + xorq %r8, %rbx + rolq $18, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 312(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 320(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 328(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 336(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 344(%rsp) + movq 32(%rsp), %rdx + xorq %rax, %rdx + rolq $27, %rdx + movq 40(%rsp), %rsi + xorq %r8, %rsi + rolq $36, %rsi + movq 88(%rsp), %rdi + xorq %r10, %rdi + rolq $10, %rdi + movq 136(%rsp), %rbp + xorq %r11, %rbp + rolq $15, %rbp + movq 184(%rsp), %rbx + xorq %rcx, %rbx + rolq $56, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 352(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 360(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 368(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 376(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 384(%rsp) + movq 16(%rsp), %rdx + xorq %r11, %rdx + rolq $62, %rdx + movq 64(%rsp), %rsi + xorq %rcx, %rsi + rolq $55, %rsi + movq %rsi, %rcx + movq 112(%rsp), %rsi + xorq %rax, %rsi + rolq $39, %rsi + movq %rsi, %rax + movq 120(%rsp), %rsi + xorq %r8, %rsi + rolq $41, %rsi + movq 168(%rsp), %rdi + xorq %r10, %rdi + rolq $2, %rdi + andnq %rax, %rcx, %r8 + xorq %rdx, %r8 + movq %r8, 392(%rsp) + andnq %rsi, %rax, %r8 + xorq %rcx, %r8 + movq %r8, 400(%rsp) + andnq %rdi, %rsi, %r8 + xorq %rax, %r8 + movq %r8, 408(%rsp) + andnq %rdx, %rdi, %rax + xorq %rsi, %rax + movq %rax, 416(%rsp) + andnq %rcx, %rdx, %rax + xorq %rdi, %rax + movq %rax, 424(%rsp) + movq 8(%r9), %rax + movq %rax, 432(%rsp) + movq 232(%rsp), %rax + movq 240(%rsp), %rcx + movq 248(%rsp), %rdx + movq 256(%rsp), %rsi + movq 264(%rsp), %rdi + xorq 272(%rsp), %rax + xorq 280(%rsp), %rcx + xorq 288(%rsp), %rdx + xorq 296(%rsp), %rsi + xorq 304(%rsp), %rdi + xorq 312(%rsp), %rax + xorq 320(%rsp), %rcx + xorq 328(%rsp), %rdx + xorq 336(%rsp), %rsi + xorq 344(%rsp), %rdi + xorq 352(%rsp), %rax + xorq 360(%rsp), %rcx + xorq 368(%rsp), %rdx + xorq 376(%rsp), %rsi + xorq 384(%rsp), %rdi + xorq 392(%rsp), %rax + xorq 400(%rsp), %rcx + xorq 408(%rsp), %rdx + xorq 416(%rsp), %rsi + xorq 424(%rsp), %rdi + movq %rcx, %r8 + rolq $1, %r8 + xorq %rdi, %r8 + movq %rdx, %r10 + rolq $1, %r10 + xorq %rax, %r10 + movq %rsi, %r11 + rolq $1, %r11 + xorq %rcx, %r11 + movq %rdi, %rcx + rolq $1, %rcx + xorq %rdx, %rcx + rolq $1, %rax + xorq %rsi, %rax + movq 232(%rsp), %rdx + xorq %r8, %rdx + movq 280(%rsp), %rsi + xorq %r10, %rsi + rolq $44, %rsi + movq 328(%rsp), %rdi + xorq %r11, %rdi + rolq $43, %rdi + movq 376(%rsp), %rbp + xorq %rcx, %rbp + rolq $21, %rbp + movq 424(%rsp), %rbx + xorq %rax, %rbx + rolq $14, %rbx + andnq %rdi, %rsi, %r12 + xorq 432(%rsp), %r12 + xorq %rdx, %r12 + movq %r12, (%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 8(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 16(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 24(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 32(%rsp) + movq 256(%rsp), %rdx + xorq %rcx, %rdx + rolq $28, %rdx + movq 304(%rsp), %rsi + xorq %rax, %rsi + rolq $20, %rsi + movq 312(%rsp), %rdi + xorq %r8, %rdi + rolq $3, %rdi + movq 360(%rsp), %rbp + xorq %r10, %rbp + rolq $45, %rbp + movq 408(%rsp), %rbx + xorq %r11, %rbx + rolq $61, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 40(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 48(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 56(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 64(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 72(%rsp) + movq 240(%rsp), %rdx + xorq %r10, %rdx + rolq $1, %rdx + movq 288(%rsp), %rsi + xorq %r11, %rsi + rolq $6, %rsi + movq 336(%rsp), %rdi + xorq %rcx, %rdi + rolq $25, %rdi + movq 384(%rsp), %rbp + xorq %rax, %rbp + rolq $8, %rbp + movq 392(%rsp), %rbx + xorq %r8, %rbx + rolq $18, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 80(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 88(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 96(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 104(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 112(%rsp) + movq 264(%rsp), %rdx + xorq %rax, %rdx + rolq $27, %rdx + movq 272(%rsp), %rsi + xorq %r8, %rsi + rolq $36, %rsi + movq 320(%rsp), %rdi + xorq %r10, %rdi + rolq $10, %rdi + movq 368(%rsp), %rbp + xorq %r11, %rbp + rolq $15, %rbp + movq 416(%rsp), %rbx + xorq %rcx, %rbx + rolq $56, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 120(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 128(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 136(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 144(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 152(%rsp) + movq 248(%rsp), %rdx + xorq %r11, %rdx + rolq $62, %rdx + movq 296(%rsp), %rsi + xorq %rcx, %rsi + rolq $55, %rsi + movq %rsi, %rcx + movq 344(%rsp), %rsi + xorq %rax, %rsi + rolq $39, %rsi + movq %rsi, %rax + movq 352(%rsp), %rsi + xorq %r8, %rsi + rolq $41, %rsi + movq 400(%rsp), %rdi + xorq %r10, %rdi + rolq $2, %rdi + andnq %rax, %rcx, %r8 + xorq %rdx, %r8 + movq %r8, 160(%rsp) + andnq %rsi, %rax, %r8 + xorq %rcx, %r8 + movq %r8, 168(%rsp) + andnq %rdi, %rsi, %r8 + xorq %rax, %r8 + movq %r8, 176(%rsp) + andnq %rdx, %rdi, %rax + xorq %rsi, %rax + movq %rax, 184(%rsp) + andnq %rcx, %rdx, %rax + xorq %rdi, %rax + movq %rax, 192(%rsp) + leaq 16(%r9), %r9 + testb $-1, %r9b + jne Lkeccak_1600$17 + leaq -192(%r9), %r9 + movq 224(%rsp), %rdx + movq 216(%rsp), %rcx + movq 208(%rsp), %rax +Lkeccak_1600$15: + cmpq %rax, %rcx + jnb Lkeccak_1600$16 + movq 440(%rsp), %rsi + movb %sil, %sil + movq %rcx, %rdi + shrq $3, %rdi + movq $0, %r8 + jmp Lkeccak_1600$13 +Lkeccak_1600$14: + movq (%rdx,%r8,8), %r10 + xorq %r10, (%rsp,%r8,8) + leaq 1(%r8), %r8 +Lkeccak_1600$13: + cmpq %rdi, %r8 + jb Lkeccak_1600$14 + shlq $3, %r8 + jmp Lkeccak_1600$11 +Lkeccak_1600$12: + movb (%rdx,%r8), %dil + xorb %dil, (%rsp,%r8) + leaq 1(%r8), %r8 +Lkeccak_1600$11: + cmpq %rcx, %r8 + jb Lkeccak_1600$12 + xorb %sil, (%rsp,%r8) + movq %rax, %rcx + leaq -1(%rcx), %rcx + xorb $-128, (%rsp,%rcx) + movq 448(%rsp), %rdx + jmp Lkeccak_1600$6 +Lkeccak_1600$7: + movq %rdx, 448(%rsp) + movq %rax, 440(%rsp) +Lkeccak_1600$10: + movq (%r9), %rax + movq %rax, 432(%rsp) + movq (%rsp), %rax + movq 8(%rsp), %rcx + movq 16(%rsp), %rdx + movq 24(%rsp), %rsi + movq 32(%rsp), %rdi + xorq 40(%rsp), %rax + xorq 48(%rsp), %rcx + xorq 56(%rsp), %rdx + xorq 64(%rsp), %rsi + xorq 72(%rsp), %rdi + xorq 80(%rsp), %rax + xorq 88(%rsp), %rcx + xorq 96(%rsp), %rdx + xorq 104(%rsp), %rsi + xorq 112(%rsp), %rdi + xorq 120(%rsp), %rax + xorq 128(%rsp), %rcx + xorq 136(%rsp), %rdx + xorq 144(%rsp), %rsi + xorq 152(%rsp), %rdi + xorq 160(%rsp), %rax + xorq 168(%rsp), %rcx + xorq 176(%rsp), %rdx + xorq 184(%rsp), %rsi + xorq 192(%rsp), %rdi + movq %rcx, %r8 + rolq $1, %r8 + xorq %rdi, %r8 + movq %rdx, %r10 + rolq $1, %r10 + xorq %rax, %r10 + movq %rsi, %r11 + rolq $1, %r11 + xorq %rcx, %r11 + movq %rdi, %rcx + rolq $1, %rcx + xorq %rdx, %rcx + rolq $1, %rax + xorq %rsi, %rax + movq (%rsp), %rdx + xorq %r8, %rdx + movq 48(%rsp), %rsi + xorq %r10, %rsi + rolq $44, %rsi + movq 96(%rsp), %rdi + xorq %r11, %rdi + rolq $43, %rdi + movq 144(%rsp), %rbp + xorq %rcx, %rbp + rolq $21, %rbp + movq 192(%rsp), %rbx + xorq %rax, %rbx + rolq $14, %rbx + andnq %rdi, %rsi, %r12 + xorq 432(%rsp), %r12 + xorq %rdx, %r12 + movq %r12, 232(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 240(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 248(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 256(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 264(%rsp) + movq 24(%rsp), %rdx + xorq %rcx, %rdx + rolq $28, %rdx + movq 72(%rsp), %rsi + xorq %rax, %rsi + rolq $20, %rsi + movq 80(%rsp), %rdi + xorq %r8, %rdi + rolq $3, %rdi + movq 128(%rsp), %rbp + xorq %r10, %rbp + rolq $45, %rbp + movq 176(%rsp), %rbx + xorq %r11, %rbx + rolq $61, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 272(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 280(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 288(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 296(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 304(%rsp) + movq 8(%rsp), %rdx + xorq %r10, %rdx + rolq $1, %rdx + movq 56(%rsp), %rsi + xorq %r11, %rsi + rolq $6, %rsi + movq 104(%rsp), %rdi + xorq %rcx, %rdi + rolq $25, %rdi + movq 152(%rsp), %rbp + xorq %rax, %rbp + rolq $8, %rbp + movq 160(%rsp), %rbx + xorq %r8, %rbx + rolq $18, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 312(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 320(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 328(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 336(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 344(%rsp) + movq 32(%rsp), %rdx + xorq %rax, %rdx + rolq $27, %rdx + movq 40(%rsp), %rsi + xorq %r8, %rsi + rolq $36, %rsi + movq 88(%rsp), %rdi + xorq %r10, %rdi + rolq $10, %rdi + movq 136(%rsp), %rbp + xorq %r11, %rbp + rolq $15, %rbp + movq 184(%rsp), %rbx + xorq %rcx, %rbx + rolq $56, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 352(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 360(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 368(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 376(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 384(%rsp) + movq 16(%rsp), %rdx + xorq %r11, %rdx + rolq $62, %rdx + movq 64(%rsp), %rsi + xorq %rcx, %rsi + rolq $55, %rsi + movq %rsi, %rcx + movq 112(%rsp), %rsi + xorq %rax, %rsi + rolq $39, %rsi + movq %rsi, %rax + movq 120(%rsp), %rsi + xorq %r8, %rsi + rolq $41, %rsi + movq 168(%rsp), %rdi + xorq %r10, %rdi + rolq $2, %rdi + andnq %rax, %rcx, %r8 + xorq %rdx, %r8 + movq %r8, 392(%rsp) + andnq %rsi, %rax, %r8 + xorq %rcx, %r8 + movq %r8, 400(%rsp) + andnq %rdi, %rsi, %r8 + xorq %rax, %r8 + movq %r8, 408(%rsp) + andnq %rdx, %rdi, %rax + xorq %rsi, %rax + movq %rax, 416(%rsp) + andnq %rcx, %rdx, %rax + xorq %rdi, %rax + movq %rax, 424(%rsp) + movq 8(%r9), %rax + movq %rax, 432(%rsp) + movq 232(%rsp), %rax + movq 240(%rsp), %rcx + movq 248(%rsp), %rdx + movq 256(%rsp), %rsi + movq 264(%rsp), %rdi + xorq 272(%rsp), %rax + xorq 280(%rsp), %rcx + xorq 288(%rsp), %rdx + xorq 296(%rsp), %rsi + xorq 304(%rsp), %rdi + xorq 312(%rsp), %rax + xorq 320(%rsp), %rcx + xorq 328(%rsp), %rdx + xorq 336(%rsp), %rsi + xorq 344(%rsp), %rdi + xorq 352(%rsp), %rax + xorq 360(%rsp), %rcx + xorq 368(%rsp), %rdx + xorq 376(%rsp), %rsi + xorq 384(%rsp), %rdi + xorq 392(%rsp), %rax + xorq 400(%rsp), %rcx + xorq 408(%rsp), %rdx + xorq 416(%rsp), %rsi + xorq 424(%rsp), %rdi + movq %rcx, %r8 + rolq $1, %r8 + xorq %rdi, %r8 + movq %rdx, %r10 + rolq $1, %r10 + xorq %rax, %r10 + movq %rsi, %r11 + rolq $1, %r11 + xorq %rcx, %r11 + movq %rdi, %rcx + rolq $1, %rcx + xorq %rdx, %rcx + rolq $1, %rax + xorq %rsi, %rax + movq 232(%rsp), %rdx + xorq %r8, %rdx + movq 280(%rsp), %rsi + xorq %r10, %rsi + rolq $44, %rsi + movq 328(%rsp), %rdi + xorq %r11, %rdi + rolq $43, %rdi + movq 376(%rsp), %rbp + xorq %rcx, %rbp + rolq $21, %rbp + movq 424(%rsp), %rbx + xorq %rax, %rbx + rolq $14, %rbx + andnq %rdi, %rsi, %r12 + xorq 432(%rsp), %r12 + xorq %rdx, %r12 + movq %r12, (%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 8(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 16(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 24(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 32(%rsp) + movq 256(%rsp), %rdx + xorq %rcx, %rdx + rolq $28, %rdx + movq 304(%rsp), %rsi + xorq %rax, %rsi + rolq $20, %rsi + movq 312(%rsp), %rdi + xorq %r8, %rdi + rolq $3, %rdi + movq 360(%rsp), %rbp + xorq %r10, %rbp + rolq $45, %rbp + movq 408(%rsp), %rbx + xorq %r11, %rbx + rolq $61, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 40(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 48(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 56(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 64(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 72(%rsp) + movq 240(%rsp), %rdx + xorq %r10, %rdx + rolq $1, %rdx + movq 288(%rsp), %rsi + xorq %r11, %rsi + rolq $6, %rsi + movq 336(%rsp), %rdi + xorq %rcx, %rdi + rolq $25, %rdi + movq 384(%rsp), %rbp + xorq %rax, %rbp + rolq $8, %rbp + movq 392(%rsp), %rbx + xorq %r8, %rbx + rolq $18, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 80(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 88(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 96(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 104(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 112(%rsp) + movq 264(%rsp), %rdx + xorq %rax, %rdx + rolq $27, %rdx + movq 272(%rsp), %rsi + xorq %r8, %rsi + rolq $36, %rsi + movq 320(%rsp), %rdi + xorq %r10, %rdi + rolq $10, %rdi + movq 368(%rsp), %rbp + xorq %r11, %rbp + rolq $15, %rbp + movq 416(%rsp), %rbx + xorq %rcx, %rbx + rolq $56, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 120(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 128(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 136(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 144(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 152(%rsp) + movq 248(%rsp), %rdx + xorq %r11, %rdx + rolq $62, %rdx + movq 296(%rsp), %rsi + xorq %rcx, %rsi + rolq $55, %rsi + movq %rsi, %rcx + movq 344(%rsp), %rsi + xorq %rax, %rsi + rolq $39, %rsi + movq %rsi, %rax + movq 352(%rsp), %rsi + xorq %r8, %rsi + rolq $41, %rsi + movq 400(%rsp), %rdi + xorq %r10, %rdi + rolq $2, %rdi + andnq %rax, %rcx, %r8 + xorq %rdx, %r8 + movq %r8, 160(%rsp) + andnq %rsi, %rax, %r8 + xorq %rcx, %r8 + movq %r8, 168(%rsp) + andnq %rdi, %rsi, %r8 + xorq %rax, %r8 + movq %r8, 176(%rsp) + andnq %rdx, %rdi, %rax + xorq %rsi, %rax + movq %rax, 184(%rsp) + andnq %rcx, %rdx, %rax + xorq %rdi, %rax + movq %rax, 192(%rsp) + leaq 16(%r9), %r9 + testb $-1, %r9b + jne Lkeccak_1600$10 + leaq -192(%r9), %r9 + movq 200(%rsp), %rcx + movq 448(%rsp), %rdx + movq 440(%rsp), %rax + movq %rax, %rsi + shrq $3, %rsi + movq $0, %rdi + jmp Lkeccak_1600$8 +Lkeccak_1600$9: + movq (%rsp,%rdi,8), %r8 + movq %r8, (%rcx,%rdi,8) + leaq 1(%rdi), %rdi +Lkeccak_1600$8: + cmpq %rsi, %rdi + jb Lkeccak_1600$9 + leaq (%rcx,%rax), %rcx + subq %rax, %rdx + movq %rcx, 200(%rsp) +Lkeccak_1600$6: + cmpq %rax, %rdx + jnbe Lkeccak_1600$7 + movq %rdx, 440(%rsp) +Lkeccak_1600$5: + movq (%r9), %rax + movq %rax, 448(%rsp) + movq (%rsp), %rax + movq 8(%rsp), %rcx + movq 16(%rsp), %rdx + movq 24(%rsp), %rsi + movq 32(%rsp), %rdi + xorq 40(%rsp), %rax + xorq 48(%rsp), %rcx + xorq 56(%rsp), %rdx + xorq 64(%rsp), %rsi + xorq 72(%rsp), %rdi + xorq 80(%rsp), %rax + xorq 88(%rsp), %rcx + xorq 96(%rsp), %rdx + xorq 104(%rsp), %rsi + xorq 112(%rsp), %rdi + xorq 120(%rsp), %rax + xorq 128(%rsp), %rcx + xorq 136(%rsp), %rdx + xorq 144(%rsp), %rsi + xorq 152(%rsp), %rdi + xorq 160(%rsp), %rax + xorq 168(%rsp), %rcx + xorq 176(%rsp), %rdx + xorq 184(%rsp), %rsi + xorq 192(%rsp), %rdi + movq %rcx, %r8 + rolq $1, %r8 + xorq %rdi, %r8 + movq %rdx, %r10 + rolq $1, %r10 + xorq %rax, %r10 + movq %rsi, %r11 + rolq $1, %r11 + xorq %rcx, %r11 + movq %rdi, %rcx + rolq $1, %rcx + xorq %rdx, %rcx + rolq $1, %rax + xorq %rsi, %rax + movq (%rsp), %rdx + xorq %r8, %rdx + movq 48(%rsp), %rsi + xorq %r10, %rsi + rolq $44, %rsi + movq 96(%rsp), %rdi + xorq %r11, %rdi + rolq $43, %rdi + movq 144(%rsp), %rbp + xorq %rcx, %rbp + rolq $21, %rbp + movq 192(%rsp), %rbx + xorq %rax, %rbx + rolq $14, %rbx + andnq %rdi, %rsi, %r12 + xorq 448(%rsp), %r12 + xorq %rdx, %r12 + movq %r12, 232(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 240(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 248(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 256(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 264(%rsp) + movq 24(%rsp), %rdx + xorq %rcx, %rdx + rolq $28, %rdx + movq 72(%rsp), %rsi + xorq %rax, %rsi + rolq $20, %rsi + movq 80(%rsp), %rdi + xorq %r8, %rdi + rolq $3, %rdi + movq 128(%rsp), %rbp + xorq %r10, %rbp + rolq $45, %rbp + movq 176(%rsp), %rbx + xorq %r11, %rbx + rolq $61, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 272(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 280(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 288(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 296(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 304(%rsp) + movq 8(%rsp), %rdx + xorq %r10, %rdx + rolq $1, %rdx + movq 56(%rsp), %rsi + xorq %r11, %rsi + rolq $6, %rsi + movq 104(%rsp), %rdi + xorq %rcx, %rdi + rolq $25, %rdi + movq 152(%rsp), %rbp + xorq %rax, %rbp + rolq $8, %rbp + movq 160(%rsp), %rbx + xorq %r8, %rbx + rolq $18, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 312(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 320(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 328(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 336(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 344(%rsp) + movq 32(%rsp), %rdx + xorq %rax, %rdx + rolq $27, %rdx + movq 40(%rsp), %rsi + xorq %r8, %rsi + rolq $36, %rsi + movq 88(%rsp), %rdi + xorq %r10, %rdi + rolq $10, %rdi + movq 136(%rsp), %rbp + xorq %r11, %rbp + rolq $15, %rbp + movq 184(%rsp), %rbx + xorq %rcx, %rbx + rolq $56, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 352(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 360(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 368(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 376(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 384(%rsp) + movq 16(%rsp), %rdx + xorq %r11, %rdx + rolq $62, %rdx + movq 64(%rsp), %rsi + xorq %rcx, %rsi + rolq $55, %rsi + movq %rsi, %rcx + movq 112(%rsp), %rsi + xorq %rax, %rsi + rolq $39, %rsi + movq %rsi, %rax + movq 120(%rsp), %rsi + xorq %r8, %rsi + rolq $41, %rsi + movq 168(%rsp), %rdi + xorq %r10, %rdi + rolq $2, %rdi + andnq %rax, %rcx, %r8 + xorq %rdx, %r8 + movq %r8, 392(%rsp) + andnq %rsi, %rax, %r8 + xorq %rcx, %r8 + movq %r8, 400(%rsp) + andnq %rdi, %rsi, %r8 + xorq %rax, %r8 + movq %r8, 408(%rsp) + andnq %rdx, %rdi, %rax + xorq %rsi, %rax + movq %rax, 416(%rsp) + andnq %rcx, %rdx, %rax + xorq %rdi, %rax + movq %rax, 424(%rsp) + movq 8(%r9), %rax + movq %rax, 448(%rsp) + movq 232(%rsp), %rax + movq 240(%rsp), %rcx + movq 248(%rsp), %rdx + movq 256(%rsp), %rsi + movq 264(%rsp), %rdi + xorq 272(%rsp), %rax + xorq 280(%rsp), %rcx + xorq 288(%rsp), %rdx + xorq 296(%rsp), %rsi + xorq 304(%rsp), %rdi + xorq 312(%rsp), %rax + xorq 320(%rsp), %rcx + xorq 328(%rsp), %rdx + xorq 336(%rsp), %rsi + xorq 344(%rsp), %rdi + xorq 352(%rsp), %rax + xorq 360(%rsp), %rcx + xorq 368(%rsp), %rdx + xorq 376(%rsp), %rsi + xorq 384(%rsp), %rdi + xorq 392(%rsp), %rax + xorq 400(%rsp), %rcx + xorq 408(%rsp), %rdx + xorq 416(%rsp), %rsi + xorq 424(%rsp), %rdi + movq %rcx, %r8 + rolq $1, %r8 + xorq %rdi, %r8 + movq %rdx, %r10 + rolq $1, %r10 + xorq %rax, %r10 + movq %rsi, %r11 + rolq $1, %r11 + xorq %rcx, %r11 + movq %rdi, %rcx + rolq $1, %rcx + xorq %rdx, %rcx + rolq $1, %rax + xorq %rsi, %rax + movq 232(%rsp), %rdx + xorq %r8, %rdx + movq 280(%rsp), %rsi + xorq %r10, %rsi + rolq $44, %rsi + movq 328(%rsp), %rdi + xorq %r11, %rdi + rolq $43, %rdi + movq 376(%rsp), %rbp + xorq %rcx, %rbp + rolq $21, %rbp + movq 424(%rsp), %rbx + xorq %rax, %rbx + rolq $14, %rbx + andnq %rdi, %rsi, %r12 + xorq 448(%rsp), %r12 + xorq %rdx, %r12 + movq %r12, (%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 8(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 16(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 24(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 32(%rsp) + movq 256(%rsp), %rdx + xorq %rcx, %rdx + rolq $28, %rdx + movq 304(%rsp), %rsi + xorq %rax, %rsi + rolq $20, %rsi + movq 312(%rsp), %rdi + xorq %r8, %rdi + rolq $3, %rdi + movq 360(%rsp), %rbp + xorq %r10, %rbp + rolq $45, %rbp + movq 408(%rsp), %rbx + xorq %r11, %rbx + rolq $61, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 40(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 48(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 56(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 64(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 72(%rsp) + movq 240(%rsp), %rdx + xorq %r10, %rdx + rolq $1, %rdx + movq 288(%rsp), %rsi + xorq %r11, %rsi + rolq $6, %rsi + movq 336(%rsp), %rdi + xorq %rcx, %rdi + rolq $25, %rdi + movq 384(%rsp), %rbp + xorq %rax, %rbp + rolq $8, %rbp + movq 392(%rsp), %rbx + xorq %r8, %rbx + rolq $18, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 80(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 88(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 96(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 104(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 112(%rsp) + movq 264(%rsp), %rdx + xorq %rax, %rdx + rolq $27, %rdx + movq 272(%rsp), %rsi + xorq %r8, %rsi + rolq $36, %rsi + movq 320(%rsp), %rdi + xorq %r10, %rdi + rolq $10, %rdi + movq 368(%rsp), %rbp + xorq %r11, %rbp + rolq $15, %rbp + movq 416(%rsp), %rbx + xorq %rcx, %rbx + rolq $56, %rbx + andnq %rdi, %rsi, %r12 + xorq %rdx, %r12 + movq %r12, 120(%rsp) + andnq %rbp, %rdi, %r12 + xorq %rsi, %r12 + movq %r12, 128(%rsp) + andnq %rbx, %rbp, %r12 + xorq %rdi, %r12 + movq %r12, 136(%rsp) + andnq %rdx, %rbx, %rdi + xorq %rbp, %rdi + movq %rdi, 144(%rsp) + andnq %rsi, %rdx, %rdx + xorq %rbx, %rdx + movq %rdx, 152(%rsp) + movq 248(%rsp), %rdx + xorq %r11, %rdx + rolq $62, %rdx + movq 296(%rsp), %rsi + xorq %rcx, %rsi + rolq $55, %rsi + movq %rsi, %rcx + movq 344(%rsp), %rsi + xorq %rax, %rsi + rolq $39, %rsi + movq %rsi, %rax + movq 352(%rsp), %rsi + xorq %r8, %rsi + rolq $41, %rsi + movq 400(%rsp), %rdi + xorq %r10, %rdi + rolq $2, %rdi + andnq %rax, %rcx, %r8 + xorq %rdx, %r8 + movq %r8, 160(%rsp) + andnq %rsi, %rax, %r8 + xorq %rcx, %r8 + movq %r8, 168(%rsp) + andnq %rdi, %rsi, %r8 + xorq %rax, %r8 + movq %r8, 176(%rsp) + andnq %rdx, %rdi, %rax + xorq %rsi, %rax + movq %rax, 184(%rsp) + andnq %rcx, %rdx, %rax + xorq %rdi, %rax + movq %rax, 192(%rsp) + leaq 16(%r9), %r9 + testb $-1, %r9b + jne Lkeccak_1600$5 + movq 200(%rsp), %rax + movq 440(%rsp), %rcx + movq %rcx, %rdx + shrq $3, %rdx + movq $0, %rsi + jmp Lkeccak_1600$3 +Lkeccak_1600$4: + movq (%rsp,%rsi,8), %rdi + movq %rdi, (%rax,%rsi,8) + leaq 1(%rsi), %rsi +Lkeccak_1600$3: + cmpq %rdx, %rsi + jb Lkeccak_1600$4 + shlq $3, %rsi + jmp Lkeccak_1600$1 +Lkeccak_1600$2: + movb (%rsp,%rsi), %dl + movb %dl, (%rax,%rsi) + leaq 1(%rsi), %rsi +Lkeccak_1600$1: + cmpq %rcx, %rsi + jb Lkeccak_1600$2 + addq $456, %rsp + popq %r12 + popq %rbx + popq %rbp + ret diff --git a/code/crypto_hash/shake256/scalar_g/Makefile b/code/crypto_hash/shake256/scalar_g/Makefile new file mode 100644 index 0000000..fa5211f --- /dev/null +++ b/code/crypto_hash/shake256/scalar_g/Makefile @@ -0,0 +1,15 @@ +# -*- Makefile -*- + +.PHONY: default clean + +default: shake256.japp shake256.s + @true + +clean: + rm -f shake256.japp shake256.s + +%.s: %.japp + jasminc -lea -pasm $< > $@ || rm -f $@ + +%.japp: %.jazz + gpp -I../../../ -o $@ $< diff --git a/code/crypto_hash/shake256/scalar_g/shake256-m.c b/code/crypto_hash/shake256/scalar_g/shake256-m.c new file mode 100644 index 0000000..9ecc18a --- /dev/null +++ b/code/crypto_hash/shake256/scalar_g/shake256-m.c @@ -0,0 +1,23 @@ +#include "crypto_hash.h" +#include "impl.h" +#include "api.h" +#include +#include + + +extern void keccak_1600( + uint8_t *out, + uint64_t outlen, + const uint8_t *in, + size_t inlen, + uint64_t *c +); + + +int shake256_scalar_g(unsigned char *out,const unsigned char *in,unsigned long long inlen) +{ + uint64_t c[] = {0x1F, (1088/8)}; + keccak_1600(out, 136, in, inlen, c); + return 0; +} + diff --git a/code/crypto_hash/shake256/scalar_g/shake256.japp b/code/crypto_hash/shake256/scalar_g/shake256.japp new file mode 100644 index 0000000..e48289e --- /dev/null +++ b/code/crypto_hash/shake256/scalar_g/shake256.japp @@ -0,0 +1,500 @@ + + // 0 uses external memory for the stack space + // 1 uses stack u64[] array + + + + + +// reversed iotas with the first position at zero +u64[25] iotas = +{ 0x0000000000000000 + , 0x8000000080008008 + , 0x0000000080000001 + , 0x8000000000008080 + , 0x8000000080008081 + , 0x800000008000000a + , 0x000000000000800a + , 0x8000000000000080 + , 0x8000000000008002 + , 0x8000000000008003 + , 0x8000000000008089 + , 0x800000000000008b + , 0x000000008000808b + , 0x000000008000000a + , 0x0000000080008009 + , 0x0000000000000088 + , 0x000000000000008a + , 0x8000000000008009 + , 0x8000000080008081 + , 0x0000000080000001 + , 0x000000000000808b + , 0x8000000080008000 + , 0x800000000000808a + , 0x0000000000008082 + , 0x0000000000000001 +}; + + +fn index(inline int x, inline int y) -> inline int { + inline int r; + r = 5*(x % 5) + (y % 5); + return r; +} + + +fn keccak_rho_offsets(inline int i) -> inline int +{ + inline int r, x, y, z, t; + r = 0; + x = 1; + y = 0; + for t = 0 to 24 + { if ( i == x + 5 * y ) + { r = ((t + 1) * (t + 2) / 2) % 64; + } + z = (2 * x + 3 * y) % 5; + x = y; + y = z; + } + + return r; +} + + +fn rhotates(inline int x y) -> inline int +{ + inline int i r; + i = index(x, y); + r = keccak_rho_offsets(i); + return r; +} + + +fn ROL64(reg u64 x, inline int c) -> reg u64 +{ + reg u64 y; + if (c == 0) + { y = x; } + else + { _, _, y = #x86_ROL_64(x, c); } + return y; +} + + +fn theta_sum(stack u64[25] A) -> reg u64[5] +{ + inline int i j; + reg u64[5] C; + + for i=0 to 5 + { C[i] = A[(5*(( 0) % 5) + (( i) % 5))]; } + + for j=1 to 5 + { for i=0 to 5 + { C[i] ^= A[(5*(( j) % 5) + (( i) % 5))]; } + } + + return C; +} + + +fn theta_rol(reg u64[5] C) -> reg u64[5] +{ + inline int i; + reg u64[5] D; + reg u64 t r; + + for i = 0 to 5 + { D[i] = ROL64(C[(i+1)%5], 1); + D[i] ^= C[(i+4)%5]; + } + + return D; +} + + +fn rol_sum( + reg u64[5] D, + stack u64[25] A, + inline int offset +) -> reg u64[5] +{ + inline int j j1 k; + reg u64[5] C; + reg u64 t; + + for j = 0 to 5 + { + j1 = (j+offset) % 5; + k = rhotates(j, j1); + t = A[(5*((j) % 5) + ((j1) % 5))]; + t ^= D[j1]; + t = ROL64(t, k); + C[j] = t; + } + + return C; +} + + +fn set_row( + stack u64[25] R, + inline int row, + reg u64[5] C, + stack u64[25] s_iotas, + reg u64 r +) -> stack u64[25] +{ + inline int j j1 j2; + reg u64 t; + + for j= 0 to 5 + { + j1 = (j+1) % 5; + j2 = (j+2) % 5; + t = !C[j1] & C[j2]; + if row==0 && j==0 { t ^= s_iotas[(int) r]; } + t ^= C[j]; + R[(5*(( row) % 5) + (( j) % 5))] = t; + } + + return R; +} + + +fn round2x( + stack u64[25] A, + stack u64[25] R, + stack u64[25] s_iotas, + reg u64 r +) -> stack u64[25], stack u64[25] +{ + reg u64[5] C D; + + C = theta_sum(A); + D = theta_rol(C); + C = rol_sum(D, A, 0); + R = set_row(R, 0, C, s_iotas, r); + C = rol_sum(D, A, 3); + R = set_row(R, 1, C, s_iotas, r); + C = rol_sum(D, A, 1); + R = set_row(R, 2, C, s_iotas, r); + C = rol_sum(D, A, 4); + R = set_row(R, 3, C, s_iotas, r); + C = rol_sum(D, A, 2); + R = set_row(R, 4, C, s_iotas, r); + + return A, R; +} + + +fn __keccak_f1600_scalar_g( + stack u64[25] A +) -> stack u64[25] +{ + reg bool zf; + stack u64[25] R; + stack u64[25] s_iotas; + reg u64 r; + + + + r = 24; + s_iotas = iotas; + + align while + { + A, R = round2x(A, R, s_iotas, r); + r = #x86_DEC(r); + R, A = round2x(R, A, s_iotas, r); + (_, _, _, zf, r) = #x86_DEC(r); + } (!zf) + + + + return A; +} + + +fn spill_2(reg u64 a b) -> stack u64, stack u64 +{ + stack u64 sa sb; + sa = a; + sb = b; + return sa, sb; +} + + +fn spill_3(reg u64 a b c) -> stack u64, stack u64, stack u64 +{ + stack u64 sa sb sc; + sa = a; + sb = b; + sc = c; + return sa, sb, sc; +} + + +fn load_2(stack u64 sa sb) -> reg u64, reg u64 +{ + reg u64 a b; + a = sa; + b = sb; + return a, b; +} + + +fn load_3(stack u64 sa sb sc) -> reg u64, reg u64, reg u64 +{ + reg u64 a b c; + a = sa; + b = sb; + c = sc; + return a, b, c; +} + + +fn keccak_init( + ) -> stack u64[25] +{ + stack u64[25] state; + reg u64 i t; + + _, _, _, _, _, t = #set0(); + + + i = 0; + while (i < 25) + { state[(int)i] = t; + i += 1; + } + + return state; +} + + +fn add_full_block( + stack u64[25] state, + reg u64 in, + reg u64 inlen, + reg u64 rate +) -> stack u64[25], reg u64, reg u64 +{ + reg u64 i t rate64; + + rate64 = rate; + rate64 >>= 3; + i = 0; + while( i < rate64) + { + t = [in + 8*i]; + state[(int)i] ^= t; + i+=1; + } + + in += rate; + inlen -= rate; + + return state, in, inlen; +} + + +// obs: @pre: inlen < rate_in_bytes +fn add_final_block( + stack u64[25] state, + reg u64 in, + reg u64 inlen, + reg u8 trail_byte, + reg u64 rate +) -> stack u64[25] +{ + reg u64 i t inlen8; + reg u8 c; + + inlen8 = inlen; + inlen8 >>= 3; + i = 0; + while ( i < inlen8 ) + { + t = [in + 8*i]; + state[(int)i] ^= t; + i += 1; + } + + i <<= 3; + while ( i < inlen ) + { + c = (u8)[in + i]; + state[u8 (int)(i)] ^= c; + i += 1; + } + + state[u8 (int)(i)] ^= trail_byte; + + i = rate; + i -= 1; + state[u8 (int)(i)] ^= 0x80; + + return state; +} + + +fn absorb( + stack u64[25] state, + reg u64 in inlen, + stack u64 s_trail_byte, + reg u64 rate // rate already in bytes -- it is returned bc of spills +) -> stack u64[25], reg u64 +{ + stack u64 s_in s_inlen s_rate; + reg u8 trail_byte; + reg u64 t; + + // intermediate blocks + while ( inlen >= rate ) + { + state, in, inlen = add_full_block(state, in, inlen, rate); + s_in, s_inlen, s_rate = spill_3(in, inlen, rate); + + state = __keccak_f1600_scalar_g(state); + in, inlen, rate = load_3(s_in, s_inlen, s_rate); + } + + // final block + t = s_trail_byte; + trail_byte = (8u) t; + + state = add_final_block(state, in, inlen, trail_byte, rate); + + return state, rate; +} + + +fn xtr_full_block( + stack u64[25] state, + reg u64 out, + reg u64 outlen, + reg u64 rate +) -> reg u64, reg u64 +{ + reg u64 i t rate64; + + rate64 = rate; + rate64 >>= 3; + i = 0; + while ( i < rate64 ) + { + t = state[(int)i]; + [out + 8*i] = t; + i += 1; + } + + out += rate; + outlen -= rate; + + return out, outlen; +} + + +fn xtr_bytes( + stack u64[25] state, + reg u64 out, + reg u64 outlen +) -> reg u64 +{ + reg u64 i t outlen8; + reg u8 c; + + outlen8 = outlen; + outlen8 >>= 3; + i = 0; + while ( i < outlen8 ) + { + t = state[(int)i]; + [out + 8*i] = t; + i += 1; + } + i <<= 3; + + while ( i < outlen ) + { + c = state[u8 (int)(i)]; + (u8)[out + i] = c; + i += 1; + } + + out += outlen; + return out; +} + + +fn squeeze( + stack u64[25] state, + stack u64 s_out, + reg u64 outlen, + reg u64 rate +) +{ + reg u64 out; + stack u64 s_outlen s_rate; + + // intermediate blocks + while ( outlen > rate ) + { + s_outlen, s_rate = spill_2(outlen, rate); + state = __keccak_f1600_scalar_g(state); + out, outlen, rate = load_3(s_out, s_outlen, s_rate); + + out, outlen = xtr_full_block(state, out, outlen, rate); + s_out = out; + } + + s_outlen = outlen; + state = __keccak_f1600_scalar_g(state); + out, outlen = load_2(s_out, s_outlen); + + out = xtr_bytes(state, out, outlen); +} + + +fn __keccak_1600( + stack u64 s_out s_outlen, + reg u64 in inlen , + stack u64 s_trail_byte, + reg u64 rate +) +{ + stack u64[25] state; + reg u64 outlen; + + state = keccak_init(); + + // absorb + state, rate = absorb(state, in, inlen, s_trail_byte, rate); + + // squeeze + outlen = s_outlen; + squeeze(state, s_out, outlen, rate); +} + + +export fn keccak_1600(reg u64 out outlen in inlen_ config ) +{ + stack u64 s_trail_byte; + stack u64 s_out s_outlen; + reg u64 trail_byte; + reg u64 rate inlen; + + s_out = out; + s_outlen = outlen; + + inlen = inlen_; // swap register, rcx is needed + + trail_byte = (64u)(u8)[config + 8*0]; + s_trail_byte = trail_byte; + + rate = [config + 8*1]; // rate in bytes + + __keccak_1600(s_out, s_outlen, in, inlen, s_trail_byte, rate); +} diff --git a/code/crypto_hash/shake256/scalar_g/shake256.jazz b/code/crypto_hash/shake256/scalar_g/shake256.jazz new file mode 100644 index 0000000..4074740 --- /dev/null +++ b/code/crypto_hash/shake256/scalar_g/shake256.jazz @@ -0,0 +1 @@ +#include "crypto_hash/keccak1600/scalar_g/keccak_1600.jazz" diff --git a/code/crypto_hash/shake256/scalar_g/shake256.s b/code/crypto_hash/shake256/scalar_g/shake256.s new file mode 100644 index 0000000..2092f4c --- /dev/null +++ b/code/crypto_hash/shake256/scalar_g/shake256.s @@ -0,0 +1,1504 @@ + .text + .p2align 5 + .globl _keccak_1600 + .globl keccak_1600 +_keccak_1600: +keccak_1600: + pushq %rbp + pushq %rbx + pushq %r12 + pushq %r13 + pushq %r14 + subq $448, %rsp + movq %rdi, 400(%rsp) + movq %rsi, 440(%rsp) + movzbq (%r8), %rax + movq %rax, 432(%rsp) + movq 8(%r8), %rax + xorl %esi, %esi + movq $0, %rdi + jmp Lkeccak_1600$20 +Lkeccak_1600$21: + movq %rsi, 200(%rsp,%rdi,8) + leaq 1(%rdi), %rdi +Lkeccak_1600$20: + cmpq $25, %rdi + jb Lkeccak_1600$21 + jmp Lkeccak_1600$15 +Lkeccak_1600$16: + movq %rax, %rsi + shrq $3, %rsi + movq $0, %rdi + jmp Lkeccak_1600$18 +Lkeccak_1600$19: + movq (%rdx,%rdi,8), %r8 + xorq %r8, 200(%rsp,%rdi,8) + leaq 1(%rdi), %rdi +Lkeccak_1600$18: + cmpq %rsi, %rdi + jb Lkeccak_1600$19 + leaq (%rdx,%rax), %rdx + subq %rax, %rcx + movq %rdx, 424(%rsp) + movq %rcx, 416(%rsp) + movq %rax, 408(%rsp) + movq $24, %rax + leaq glob_data(%rip), %rcx + .p2align 5 +Lkeccak_1600$17: + movq 200(%rsp), %rdx + movq 208(%rsp), %rsi + movq 216(%rsp), %rdi + movq 224(%rsp), %r8 + movq 232(%rsp), %r10 + xorq 240(%rsp), %rdx + xorq 248(%rsp), %rsi + xorq 256(%rsp), %rdi + xorq 264(%rsp), %r8 + xorq 272(%rsp), %r10 + xorq 280(%rsp), %rdx + xorq 288(%rsp), %rsi + xorq 296(%rsp), %rdi + xorq 304(%rsp), %r8 + xorq 312(%rsp), %r10 + xorq 320(%rsp), %rdx + xorq 328(%rsp), %rsi + xorq 336(%rsp), %rdi + xorq 344(%rsp), %r8 + xorq 352(%rsp), %r10 + xorq 360(%rsp), %rdx + xorq 368(%rsp), %rsi + xorq 376(%rsp), %rdi + xorq 384(%rsp), %r8 + xorq 392(%rsp), %r10 + movq %rsi, %r11 + rolq $1, %r11 + xorq %r10, %r11 + movq %rdi, %rbp + rolq $1, %rbp + xorq %rdx, %rbp + movq %r8, %rbx + rolq $1, %rbx + xorq %rsi, %rbx + movq %r10, %rsi + rolq $1, %rsi + xorq %rdi, %rsi + rolq $1, %rdx + xorq %r8, %rdx + movq 200(%rsp), %rdi + xorq %r11, %rdi + movq 248(%rsp), %r8 + xorq %rbp, %r8 + rolq $44, %r8 + movq 296(%rsp), %r10 + xorq %rbx, %r10 + rolq $43, %r10 + movq 344(%rsp), %r12 + xorq %rsi, %r12 + rolq $21, %r12 + movq 392(%rsp), %r13 + xorq %rdx, %r13 + rolq $14, %r13 + andnq %r10, %r8, %r14 + xorq (%rcx,%rax,8), %r14 + xorq %rdi, %r14 + movq %r14, (%rsp) + andnq %r12, %r10, %r14 + xorq %r8, %r14 + movq %r14, 8(%rsp) + andnq %r13, %r12, %r14 + xorq %r10, %r14 + movq %r14, 16(%rsp) + andnq %rdi, %r13, %r10 + xorq %r12, %r10 + movq %r10, 24(%rsp) + andnq %r8, %rdi, %rdi + xorq %r13, %rdi + movq %rdi, 32(%rsp) + movq 224(%rsp), %rdi + xorq %rsi, %rdi + rolq $28, %rdi + movq 272(%rsp), %r8 + xorq %rdx, %r8 + rolq $20, %r8 + movq 280(%rsp), %r10 + xorq %r11, %r10 + rolq $3, %r10 + movq 328(%rsp), %r12 + xorq %rbp, %r12 + rolq $45, %r12 + movq 376(%rsp), %r13 + xorq %rbx, %r13 + rolq $61, %r13 + andnq %r10, %r8, %r14 + xorq %rdi, %r14 + movq %r14, 40(%rsp) + andnq %r12, %r10, %r14 + xorq %r8, %r14 + movq %r14, 48(%rsp) + andnq %r13, %r12, %r14 + xorq %r10, %r14 + movq %r14, 56(%rsp) + andnq %rdi, %r13, %r10 + xorq %r12, %r10 + movq %r10, 64(%rsp) + andnq %r8, %rdi, %rdi + xorq %r13, %rdi + movq %rdi, 72(%rsp) + movq 208(%rsp), %rdi + xorq %rbp, %rdi + rolq $1, %rdi + movq 256(%rsp), %r8 + xorq %rbx, %r8 + rolq $6, %r8 + movq 304(%rsp), %r10 + xorq %rsi, %r10 + rolq $25, %r10 + movq 352(%rsp), %r12 + xorq %rdx, %r12 + rolq $8, %r12 + movq 360(%rsp), %r13 + xorq %r11, %r13 + rolq $18, %r13 + andnq %r10, %r8, %r14 + xorq %rdi, %r14 + movq %r14, 80(%rsp) + andnq %r12, %r10, %r14 + xorq %r8, %r14 + movq %r14, 88(%rsp) + andnq %r13, %r12, %r14 + xorq %r10, %r14 + movq %r14, 96(%rsp) + andnq %rdi, %r13, %r10 + xorq %r12, %r10 + movq %r10, 104(%rsp) + andnq %r8, %rdi, %rdi + xorq %r13, %rdi + movq %rdi, 112(%rsp) + movq 232(%rsp), %rdi + xorq %rdx, %rdi + rolq $27, %rdi + movq 240(%rsp), %r8 + xorq %r11, %r8 + rolq $36, %r8 + movq 288(%rsp), %r10 + xorq %rbp, %r10 + rolq $10, %r10 + movq 336(%rsp), %r12 + xorq %rbx, %r12 + rolq $15, %r12 + movq 384(%rsp), %r13 + xorq %rsi, %r13 + rolq $56, %r13 + andnq %r10, %r8, %r14 + xorq %rdi, %r14 + movq %r14, 120(%rsp) + andnq %r12, %r10, %r14 + xorq %r8, %r14 + movq %r14, 128(%rsp) + andnq %r13, %r12, %r14 + xorq %r10, %r14 + movq %r14, 136(%rsp) + andnq %rdi, %r13, %r10 + xorq %r12, %r10 + movq %r10, 144(%rsp) + andnq %r8, %rdi, %rdi + xorq %r13, %rdi + movq %rdi, 152(%rsp) + movq 216(%rsp), %rdi + xorq %rbx, %rdi + rolq $62, %rdi + movq 264(%rsp), %r8 + xorq %rsi, %r8 + rolq $55, %r8 + movq %r8, %rsi + movq 312(%rsp), %r8 + xorq %rdx, %r8 + rolq $39, %r8 + movq %r8, %rdx + movq 320(%rsp), %r8 + xorq %r11, %r8 + rolq $41, %r8 + movq 368(%rsp), %r10 + xorq %rbp, %r10 + rolq $2, %r10 + andnq %rdx, %rsi, %r11 + xorq %rdi, %r11 + movq %r11, 160(%rsp) + andnq %r8, %rdx, %r11 + xorq %rsi, %r11 + movq %r11, 168(%rsp) + andnq %r10, %r8, %r11 + xorq %rdx, %r11 + movq %r11, 176(%rsp) + andnq %rdi, %r10, %rdx + xorq %r8, %rdx + movq %rdx, 184(%rsp) + andnq %rsi, %rdi, %rdx + xorq %r10, %rdx + movq %rdx, 192(%rsp) + decq %rax + movq (%rsp), %rdx + movq 8(%rsp), %rsi + movq 16(%rsp), %rdi + movq 24(%rsp), %r8 + movq 32(%rsp), %r10 + xorq 40(%rsp), %rdx + xorq 48(%rsp), %rsi + xorq 56(%rsp), %rdi + xorq 64(%rsp), %r8 + xorq 72(%rsp), %r10 + xorq 80(%rsp), %rdx + xorq 88(%rsp), %rsi + xorq 96(%rsp), %rdi + xorq 104(%rsp), %r8 + xorq 112(%rsp), %r10 + xorq 120(%rsp), %rdx + xorq 128(%rsp), %rsi + xorq 136(%rsp), %rdi + xorq 144(%rsp), %r8 + xorq 152(%rsp), %r10 + xorq 160(%rsp), %rdx + xorq 168(%rsp), %rsi + xorq 176(%rsp), %rdi + xorq 184(%rsp), %r8 + xorq 192(%rsp), %r10 + movq %rsi, %r11 + rolq $1, %r11 + xorq %r10, %r11 + movq %rdi, %rbp + rolq $1, %rbp + xorq %rdx, %rbp + movq %r8, %rbx + rolq $1, %rbx + xorq %rsi, %rbx + movq %r10, %rsi + rolq $1, %rsi + xorq %rdi, %rsi + rolq $1, %rdx + xorq %r8, %rdx + movq (%rsp), %rdi + xorq %r11, %rdi + movq 48(%rsp), %r8 + xorq %rbp, %r8 + rolq $44, %r8 + movq 96(%rsp), %r10 + xorq %rbx, %r10 + rolq $43, %r10 + movq 144(%rsp), %r12 + xorq %rsi, %r12 + rolq $21, %r12 + movq 192(%rsp), %r13 + xorq %rdx, %r13 + rolq $14, %r13 + andnq %r10, %r8, %r14 + xorq (%rcx,%rax,8), %r14 + xorq %rdi, %r14 + movq %r14, 200(%rsp) + andnq %r12, %r10, %r14 + xorq %r8, %r14 + movq %r14, 208(%rsp) + andnq %r13, %r12, %r14 + xorq %r10, %r14 + movq %r14, 216(%rsp) + andnq %rdi, %r13, %r10 + xorq %r12, %r10 + movq %r10, 224(%rsp) + andnq %r8, %rdi, %rdi + xorq %r13, %rdi + movq %rdi, 232(%rsp) + movq 24(%rsp), %rdi + xorq %rsi, %rdi + rolq $28, %rdi + movq 72(%rsp), %r8 + xorq %rdx, %r8 + rolq $20, %r8 + movq 80(%rsp), %r10 + xorq %r11, %r10 + rolq $3, %r10 + movq 128(%rsp), %r12 + xorq %rbp, %r12 + rolq $45, %r12 + movq 176(%rsp), %r13 + xorq %rbx, %r13 + rolq $61, %r13 + andnq %r10, %r8, %r14 + xorq %rdi, %r14 + movq %r14, 240(%rsp) + andnq %r12, %r10, %r14 + xorq %r8, %r14 + movq %r14, 248(%rsp) + andnq %r13, %r12, %r14 + xorq %r10, %r14 + movq %r14, 256(%rsp) + andnq %rdi, %r13, %r10 + xorq %r12, %r10 + movq %r10, 264(%rsp) + andnq %r8, %rdi, %rdi + xorq %r13, %rdi + movq %rdi, 272(%rsp) + movq 8(%rsp), %rdi + xorq %rbp, %rdi + rolq $1, %rdi + movq 56(%rsp), %r8 + xorq %rbx, %r8 + rolq $6, %r8 + movq 104(%rsp), %r10 + xorq %rsi, %r10 + rolq $25, %r10 + movq 152(%rsp), %r12 + xorq %rdx, %r12 + rolq $8, %r12 + movq 160(%rsp), %r13 + xorq %r11, %r13 + rolq $18, %r13 + andnq %r10, %r8, %r14 + xorq %rdi, %r14 + movq %r14, 280(%rsp) + andnq %r12, %r10, %r14 + xorq %r8, %r14 + movq %r14, 288(%rsp) + andnq %r13, %r12, %r14 + xorq %r10, %r14 + movq %r14, 296(%rsp) + andnq %rdi, %r13, %r10 + xorq %r12, %r10 + movq %r10, 304(%rsp) + andnq %r8, %rdi, %rdi + xorq %r13, %rdi + movq %rdi, 312(%rsp) + movq 32(%rsp), %rdi + xorq %rdx, %rdi + rolq $27, %rdi + movq 40(%rsp), %r8 + xorq %r11, %r8 + rolq $36, %r8 + movq 88(%rsp), %r10 + xorq %rbp, %r10 + rolq $10, %r10 + movq 136(%rsp), %r12 + xorq %rbx, %r12 + rolq $15, %r12 + movq 184(%rsp), %r13 + xorq %rsi, %r13 + rolq $56, %r13 + andnq %r10, %r8, %r14 + xorq %rdi, %r14 + movq %r14, 320(%rsp) + andnq %r12, %r10, %r14 + xorq %r8, %r14 + movq %r14, 328(%rsp) + andnq %r13, %r12, %r14 + xorq %r10, %r14 + movq %r14, 336(%rsp) + andnq %rdi, %r13, %r10 + xorq %r12, %r10 + movq %r10, 344(%rsp) + andnq %r8, %rdi, %rdi + xorq %r13, %rdi + movq %rdi, 352(%rsp) + movq 16(%rsp), %rdi + xorq %rbx, %rdi + rolq $62, %rdi + movq 64(%rsp), %r8 + xorq %rsi, %r8 + rolq $55, %r8 + movq %r8, %rsi + movq 112(%rsp), %r8 + xorq %rdx, %r8 + rolq $39, %r8 + movq %r8, %rdx + movq 120(%rsp), %r8 + xorq %r11, %r8 + rolq $41, %r8 + movq 168(%rsp), %r10 + xorq %rbp, %r10 + rolq $2, %r10 + andnq %rdx, %rsi, %r11 + xorq %rdi, %r11 + movq %r11, 360(%rsp) + andnq %r8, %rdx, %r11 + xorq %rsi, %r11 + movq %r11, 368(%rsp) + andnq %r10, %r8, %r11 + xorq %rdx, %r11 + movq %r11, 376(%rsp) + andnq %rdi, %r10, %rdx + xorq %r8, %rdx + movq %rdx, 384(%rsp) + andnq %rsi, %rdi, %rdx + xorq %r10, %rdx + movq %rdx, 392(%rsp) + decq %rax + jne Lkeccak_1600$17 + movq 424(%rsp), %rdx + movq 416(%rsp), %rcx + movq 408(%rsp), %rax +Lkeccak_1600$15: + cmpq %rax, %rcx + jnb Lkeccak_1600$16 + movq 432(%rsp), %rsi + movb %sil, %sil + movq %rcx, %rdi + shrq $3, %rdi + movq $0, %r8 + jmp Lkeccak_1600$13 +Lkeccak_1600$14: + movq (%rdx,%r8,8), %r10 + xorq %r10, 200(%rsp,%r8,8) + leaq 1(%r8), %r8 +Lkeccak_1600$13: + cmpq %rdi, %r8 + jb Lkeccak_1600$14 + shlq $3, %r8 + jmp Lkeccak_1600$11 +Lkeccak_1600$12: + movb (%rdx,%r8), %dil + xorb %dil, 200(%rsp,%r8) + leaq 1(%r8), %r8 +Lkeccak_1600$11: + cmpq %rcx, %r8 + jb Lkeccak_1600$12 + xorb %sil, 200(%rsp,%r8) + movq %rax, %rcx + leaq -1(%rcx), %rcx + xorb $-128, 200(%rsp,%rcx) + movq 440(%rsp), %rdx + jmp Lkeccak_1600$6 +Lkeccak_1600$7: + movq %rdx, 440(%rsp) + movq %rax, 432(%rsp) + movq $24, %rax + leaq glob_data(%rip), %rcx + .p2align 5 +Lkeccak_1600$10: + movq 200(%rsp), %rdx + movq 208(%rsp), %rsi + movq 216(%rsp), %rdi + movq 224(%rsp), %r8 + movq 232(%rsp), %r10 + xorq 240(%rsp), %rdx + xorq 248(%rsp), %rsi + xorq 256(%rsp), %rdi + xorq 264(%rsp), %r8 + xorq 272(%rsp), %r10 + xorq 280(%rsp), %rdx + xorq 288(%rsp), %rsi + xorq 296(%rsp), %rdi + xorq 304(%rsp), %r8 + xorq 312(%rsp), %r10 + xorq 320(%rsp), %rdx + xorq 328(%rsp), %rsi + xorq 336(%rsp), %rdi + xorq 344(%rsp), %r8 + xorq 352(%rsp), %r10 + xorq 360(%rsp), %rdx + xorq 368(%rsp), %rsi + xorq 376(%rsp), %rdi + xorq 384(%rsp), %r8 + xorq 392(%rsp), %r10 + movq %rsi, %r11 + rolq $1, %r11 + xorq %r10, %r11 + movq %rdi, %rbp + rolq $1, %rbp + xorq %rdx, %rbp + movq %r8, %rbx + rolq $1, %rbx + xorq %rsi, %rbx + movq %r10, %rsi + rolq $1, %rsi + xorq %rdi, %rsi + rolq $1, %rdx + xorq %r8, %rdx + movq 200(%rsp), %rdi + xorq %r11, %rdi + movq 248(%rsp), %r8 + xorq %rbp, %r8 + rolq $44, %r8 + movq 296(%rsp), %r10 + xorq %rbx, %r10 + rolq $43, %r10 + movq 344(%rsp), %r12 + xorq %rsi, %r12 + rolq $21, %r12 + movq 392(%rsp), %r13 + xorq %rdx, %r13 + rolq $14, %r13 + andnq %r10, %r8, %r14 + xorq (%rcx,%rax,8), %r14 + xorq %rdi, %r14 + movq %r14, (%rsp) + andnq %r12, %r10, %r14 + xorq %r8, %r14 + movq %r14, 8(%rsp) + andnq %r13, %r12, %r14 + xorq %r10, %r14 + movq %r14, 16(%rsp) + andnq %rdi, %r13, %r10 + xorq %r12, %r10 + movq %r10, 24(%rsp) + andnq %r8, %rdi, %rdi + xorq %r13, %rdi + movq %rdi, 32(%rsp) + movq 224(%rsp), %rdi + xorq %rsi, %rdi + rolq $28, %rdi + movq 272(%rsp), %r8 + xorq %rdx, %r8 + rolq $20, %r8 + movq 280(%rsp), %r10 + xorq %r11, %r10 + rolq $3, %r10 + movq 328(%rsp), %r12 + xorq %rbp, %r12 + rolq $45, %r12 + movq 376(%rsp), %r13 + xorq %rbx, %r13 + rolq $61, %r13 + andnq %r10, %r8, %r14 + xorq %rdi, %r14 + movq %r14, 40(%rsp) + andnq %r12, %r10, %r14 + xorq %r8, %r14 + movq %r14, 48(%rsp) + andnq %r13, %r12, %r14 + xorq %r10, %r14 + movq %r14, 56(%rsp) + andnq %rdi, %r13, %r10 + xorq %r12, %r10 + movq %r10, 64(%rsp) + andnq %r8, %rdi, %rdi + xorq %r13, %rdi + movq %rdi, 72(%rsp) + movq 208(%rsp), %rdi + xorq %rbp, %rdi + rolq $1, %rdi + movq 256(%rsp), %r8 + xorq %rbx, %r8 + rolq $6, %r8 + movq 304(%rsp), %r10 + xorq %rsi, %r10 + rolq $25, %r10 + movq 352(%rsp), %r12 + xorq %rdx, %r12 + rolq $8, %r12 + movq 360(%rsp), %r13 + xorq %r11, %r13 + rolq $18, %r13 + andnq %r10, %r8, %r14 + xorq %rdi, %r14 + movq %r14, 80(%rsp) + andnq %r12, %r10, %r14 + xorq %r8, %r14 + movq %r14, 88(%rsp) + andnq %r13, %r12, %r14 + xorq %r10, %r14 + movq %r14, 96(%rsp) + andnq %rdi, %r13, %r10 + xorq %r12, %r10 + movq %r10, 104(%rsp) + andnq %r8, %rdi, %rdi + xorq %r13, %rdi + movq %rdi, 112(%rsp) + movq 232(%rsp), %rdi + xorq %rdx, %rdi + rolq $27, %rdi + movq 240(%rsp), %r8 + xorq %r11, %r8 + rolq $36, %r8 + movq 288(%rsp), %r10 + xorq %rbp, %r10 + rolq $10, %r10 + movq 336(%rsp), %r12 + xorq %rbx, %r12 + rolq $15, %r12 + movq 384(%rsp), %r13 + xorq %rsi, %r13 + rolq $56, %r13 + andnq %r10, %r8, %r14 + xorq %rdi, %r14 + movq %r14, 120(%rsp) + andnq %r12, %r10, %r14 + xorq %r8, %r14 + movq %r14, 128(%rsp) + andnq %r13, %r12, %r14 + xorq %r10, %r14 + movq %r14, 136(%rsp) + andnq %rdi, %r13, %r10 + xorq %r12, %r10 + movq %r10, 144(%rsp) + andnq %r8, %rdi, %rdi + xorq %r13, %rdi + movq %rdi, 152(%rsp) + movq 216(%rsp), %rdi + xorq %rbx, %rdi + rolq $62, %rdi + movq 264(%rsp), %r8 + xorq %rsi, %r8 + rolq $55, %r8 + movq %r8, %rsi + movq 312(%rsp), %r8 + xorq %rdx, %r8 + rolq $39, %r8 + movq %r8, %rdx + movq 320(%rsp), %r8 + xorq %r11, %r8 + rolq $41, %r8 + movq 368(%rsp), %r10 + xorq %rbp, %r10 + rolq $2, %r10 + andnq %rdx, %rsi, %r11 + xorq %rdi, %r11 + movq %r11, 160(%rsp) + andnq %r8, %rdx, %r11 + xorq %rsi, %r11 + movq %r11, 168(%rsp) + andnq %r10, %r8, %r11 + xorq %rdx, %r11 + movq %r11, 176(%rsp) + andnq %rdi, %r10, %rdx + xorq %r8, %rdx + movq %rdx, 184(%rsp) + andnq %rsi, %rdi, %rdx + xorq %r10, %rdx + movq %rdx, 192(%rsp) + decq %rax + movq (%rsp), %rdx + movq 8(%rsp), %rsi + movq 16(%rsp), %rdi + movq 24(%rsp), %r8 + movq 32(%rsp), %r10 + xorq 40(%rsp), %rdx + xorq 48(%rsp), %rsi + xorq 56(%rsp), %rdi + xorq 64(%rsp), %r8 + xorq 72(%rsp), %r10 + xorq 80(%rsp), %rdx + xorq 88(%rsp), %rsi + xorq 96(%rsp), %rdi + xorq 104(%rsp), %r8 + xorq 112(%rsp), %r10 + xorq 120(%rsp), %rdx + xorq 128(%rsp), %rsi + xorq 136(%rsp), %rdi + xorq 144(%rsp), %r8 + xorq 152(%rsp), %r10 + xorq 160(%rsp), %rdx + xorq 168(%rsp), %rsi + xorq 176(%rsp), %rdi + xorq 184(%rsp), %r8 + xorq 192(%rsp), %r10 + movq %rsi, %r11 + rolq $1, %r11 + xorq %r10, %r11 + movq %rdi, %rbp + rolq $1, %rbp + xorq %rdx, %rbp + movq %r8, %rbx + rolq $1, %rbx + xorq %rsi, %rbx + movq %r10, %rsi + rolq $1, %rsi + xorq %rdi, %rsi + rolq $1, %rdx + xorq %r8, %rdx + movq (%rsp), %rdi + xorq %r11, %rdi + movq 48(%rsp), %r8 + xorq %rbp, %r8 + rolq $44, %r8 + movq 96(%rsp), %r10 + xorq %rbx, %r10 + rolq $43, %r10 + movq 144(%rsp), %r12 + xorq %rsi, %r12 + rolq $21, %r12 + movq 192(%rsp), %r13 + xorq %rdx, %r13 + rolq $14, %r13 + andnq %r10, %r8, %r14 + xorq (%rcx,%rax,8), %r14 + xorq %rdi, %r14 + movq %r14, 200(%rsp) + andnq %r12, %r10, %r14 + xorq %r8, %r14 + movq %r14, 208(%rsp) + andnq %r13, %r12, %r14 + xorq %r10, %r14 + movq %r14, 216(%rsp) + andnq %rdi, %r13, %r10 + xorq %r12, %r10 + movq %r10, 224(%rsp) + andnq %r8, %rdi, %rdi + xorq %r13, %rdi + movq %rdi, 232(%rsp) + movq 24(%rsp), %rdi + xorq %rsi, %rdi + rolq $28, %rdi + movq 72(%rsp), %r8 + xorq %rdx, %r8 + rolq $20, %r8 + movq 80(%rsp), %r10 + xorq %r11, %r10 + rolq $3, %r10 + movq 128(%rsp), %r12 + xorq %rbp, %r12 + rolq $45, %r12 + movq 176(%rsp), %r13 + xorq %rbx, %r13 + rolq $61, %r13 + andnq %r10, %r8, %r14 + xorq %rdi, %r14 + movq %r14, 240(%rsp) + andnq %r12, %r10, %r14 + xorq %r8, %r14 + movq %r14, 248(%rsp) + andnq %r13, %r12, %r14 + xorq %r10, %r14 + movq %r14, 256(%rsp) + andnq %rdi, %r13, %r10 + xorq %r12, %r10 + movq %r10, 264(%rsp) + andnq %r8, %rdi, %rdi + xorq %r13, %rdi + movq %rdi, 272(%rsp) + movq 8(%rsp), %rdi + xorq %rbp, %rdi + rolq $1, %rdi + movq 56(%rsp), %r8 + xorq %rbx, %r8 + rolq $6, %r8 + movq 104(%rsp), %r10 + xorq %rsi, %r10 + rolq $25, %r10 + movq 152(%rsp), %r12 + xorq %rdx, %r12 + rolq $8, %r12 + movq 160(%rsp), %r13 + xorq %r11, %r13 + rolq $18, %r13 + andnq %r10, %r8, %r14 + xorq %rdi, %r14 + movq %r14, 280(%rsp) + andnq %r12, %r10, %r14 + xorq %r8, %r14 + movq %r14, 288(%rsp) + andnq %r13, %r12, %r14 + xorq %r10, %r14 + movq %r14, 296(%rsp) + andnq %rdi, %r13, %r10 + xorq %r12, %r10 + movq %r10, 304(%rsp) + andnq %r8, %rdi, %rdi + xorq %r13, %rdi + movq %rdi, 312(%rsp) + movq 32(%rsp), %rdi + xorq %rdx, %rdi + rolq $27, %rdi + movq 40(%rsp), %r8 + xorq %r11, %r8 + rolq $36, %r8 + movq 88(%rsp), %r10 + xorq %rbp, %r10 + rolq $10, %r10 + movq 136(%rsp), %r12 + xorq %rbx, %r12 + rolq $15, %r12 + movq 184(%rsp), %r13 + xorq %rsi, %r13 + rolq $56, %r13 + andnq %r10, %r8, %r14 + xorq %rdi, %r14 + movq %r14, 320(%rsp) + andnq %r12, %r10, %r14 + xorq %r8, %r14 + movq %r14, 328(%rsp) + andnq %r13, %r12, %r14 + xorq %r10, %r14 + movq %r14, 336(%rsp) + andnq %rdi, %r13, %r10 + xorq %r12, %r10 + movq %r10, 344(%rsp) + andnq %r8, %rdi, %rdi + xorq %r13, %rdi + movq %rdi, 352(%rsp) + movq 16(%rsp), %rdi + xorq %rbx, %rdi + rolq $62, %rdi + movq 64(%rsp), %r8 + xorq %rsi, %r8 + rolq $55, %r8 + movq %r8, %rsi + movq 112(%rsp), %r8 + xorq %rdx, %r8 + rolq $39, %r8 + movq %r8, %rdx + movq 120(%rsp), %r8 + xorq %r11, %r8 + rolq $41, %r8 + movq 168(%rsp), %r10 + xorq %rbp, %r10 + rolq $2, %r10 + andnq %rdx, %rsi, %r11 + xorq %rdi, %r11 + movq %r11, 360(%rsp) + andnq %r8, %rdx, %r11 + xorq %rsi, %r11 + movq %r11, 368(%rsp) + andnq %r10, %r8, %r11 + xorq %rdx, %r11 + movq %r11, 376(%rsp) + andnq %rdi, %r10, %rdx + xorq %r8, %rdx + movq %rdx, 384(%rsp) + andnq %rsi, %rdi, %rdx + xorq %r10, %rdx + movq %rdx, 392(%rsp) + decq %rax + jne Lkeccak_1600$10 + movq 400(%rsp), %rcx + movq 440(%rsp), %rdx + movq 432(%rsp), %rax + movq %rax, %rsi + shrq $3, %rsi + movq $0, %rdi + jmp Lkeccak_1600$8 +Lkeccak_1600$9: + movq 200(%rsp,%rdi,8), %r8 + movq %r8, (%rcx,%rdi,8) + leaq 1(%rdi), %rdi +Lkeccak_1600$8: + cmpq %rsi, %rdi + jb Lkeccak_1600$9 + leaq (%rcx,%rax), %rcx + subq %rax, %rdx + movq %rcx, 400(%rsp) +Lkeccak_1600$6: + cmpq %rax, %rdx + jnbe Lkeccak_1600$7 + movq %rdx, 440(%rsp) + movq $24, %rax + leaq glob_data(%rip), %rcx + .p2align 5 +Lkeccak_1600$5: + movq 200(%rsp), %rdx + movq 208(%rsp), %rsi + movq 216(%rsp), %rdi + movq 224(%rsp), %r8 + movq 232(%rsp), %r10 + xorq 240(%rsp), %rdx + xorq 248(%rsp), %rsi + xorq 256(%rsp), %rdi + xorq 264(%rsp), %r8 + xorq 272(%rsp), %r10 + xorq 280(%rsp), %rdx + xorq 288(%rsp), %rsi + xorq 296(%rsp), %rdi + xorq 304(%rsp), %r8 + xorq 312(%rsp), %r10 + xorq 320(%rsp), %rdx + xorq 328(%rsp), %rsi + xorq 336(%rsp), %rdi + xorq 344(%rsp), %r8 + xorq 352(%rsp), %r10 + xorq 360(%rsp), %rdx + xorq 368(%rsp), %rsi + xorq 376(%rsp), %rdi + xorq 384(%rsp), %r8 + xorq 392(%rsp), %r10 + movq %rsi, %r11 + rolq $1, %r11 + xorq %r10, %r11 + movq %rdi, %rbp + rolq $1, %rbp + xorq %rdx, %rbp + movq %r8, %rbx + rolq $1, %rbx + xorq %rsi, %rbx + movq %r10, %rsi + rolq $1, %rsi + xorq %rdi, %rsi + rolq $1, %rdx + xorq %r8, %rdx + movq 200(%rsp), %rdi + xorq %r11, %rdi + movq 248(%rsp), %r8 + xorq %rbp, %r8 + rolq $44, %r8 + movq 296(%rsp), %r10 + xorq %rbx, %r10 + rolq $43, %r10 + movq 344(%rsp), %r12 + xorq %rsi, %r12 + rolq $21, %r12 + movq 392(%rsp), %r13 + xorq %rdx, %r13 + rolq $14, %r13 + andnq %r10, %r8, %r14 + xorq (%rcx,%rax,8), %r14 + xorq %rdi, %r14 + movq %r14, (%rsp) + andnq %r12, %r10, %r14 + xorq %r8, %r14 + movq %r14, 8(%rsp) + andnq %r13, %r12, %r14 + xorq %r10, %r14 + movq %r14, 16(%rsp) + andnq %rdi, %r13, %r10 + xorq %r12, %r10 + movq %r10, 24(%rsp) + andnq %r8, %rdi, %rdi + xorq %r13, %rdi + movq %rdi, 32(%rsp) + movq 224(%rsp), %rdi + xorq %rsi, %rdi + rolq $28, %rdi + movq 272(%rsp), %r8 + xorq %rdx, %r8 + rolq $20, %r8 + movq 280(%rsp), %r10 + xorq %r11, %r10 + rolq $3, %r10 + movq 328(%rsp), %r12 + xorq %rbp, %r12 + rolq $45, %r12 + movq 376(%rsp), %r13 + xorq %rbx, %r13 + rolq $61, %r13 + andnq %r10, %r8, %r14 + xorq %rdi, %r14 + movq %r14, 40(%rsp) + andnq %r12, %r10, %r14 + xorq %r8, %r14 + movq %r14, 48(%rsp) + andnq %r13, %r12, %r14 + xorq %r10, %r14 + movq %r14, 56(%rsp) + andnq %rdi, %r13, %r10 + xorq %r12, %r10 + movq %r10, 64(%rsp) + andnq %r8, %rdi, %rdi + xorq %r13, %rdi + movq %rdi, 72(%rsp) + movq 208(%rsp), %rdi + xorq %rbp, %rdi + rolq $1, %rdi + movq 256(%rsp), %r8 + xorq %rbx, %r8 + rolq $6, %r8 + movq 304(%rsp), %r10 + xorq %rsi, %r10 + rolq $25, %r10 + movq 352(%rsp), %r12 + xorq %rdx, %r12 + rolq $8, %r12 + movq 360(%rsp), %r13 + xorq %r11, %r13 + rolq $18, %r13 + andnq %r10, %r8, %r14 + xorq %rdi, %r14 + movq %r14, 80(%rsp) + andnq %r12, %r10, %r14 + xorq %r8, %r14 + movq %r14, 88(%rsp) + andnq %r13, %r12, %r14 + xorq %r10, %r14 + movq %r14, 96(%rsp) + andnq %rdi, %r13, %r10 + xorq %r12, %r10 + movq %r10, 104(%rsp) + andnq %r8, %rdi, %rdi + xorq %r13, %rdi + movq %rdi, 112(%rsp) + movq 232(%rsp), %rdi + xorq %rdx, %rdi + rolq $27, %rdi + movq 240(%rsp), %r8 + xorq %r11, %r8 + rolq $36, %r8 + movq 288(%rsp), %r10 + xorq %rbp, %r10 + rolq $10, %r10 + movq 336(%rsp), %r12 + xorq %rbx, %r12 + rolq $15, %r12 + movq 384(%rsp), %r13 + xorq %rsi, %r13 + rolq $56, %r13 + andnq %r10, %r8, %r14 + xorq %rdi, %r14 + movq %r14, 120(%rsp) + andnq %r12, %r10, %r14 + xorq %r8, %r14 + movq %r14, 128(%rsp) + andnq %r13, %r12, %r14 + xorq %r10, %r14 + movq %r14, 136(%rsp) + andnq %rdi, %r13, %r10 + xorq %r12, %r10 + movq %r10, 144(%rsp) + andnq %r8, %rdi, %rdi + xorq %r13, %rdi + movq %rdi, 152(%rsp) + movq 216(%rsp), %rdi + xorq %rbx, %rdi + rolq $62, %rdi + movq 264(%rsp), %r8 + xorq %rsi, %r8 + rolq $55, %r8 + movq %r8, %rsi + movq 312(%rsp), %r8 + xorq %rdx, %r8 + rolq $39, %r8 + movq %r8, %rdx + movq 320(%rsp), %r8 + xorq %r11, %r8 + rolq $41, %r8 + movq 368(%rsp), %r10 + xorq %rbp, %r10 + rolq $2, %r10 + andnq %rdx, %rsi, %r11 + xorq %rdi, %r11 + movq %r11, 160(%rsp) + andnq %r8, %rdx, %r11 + xorq %rsi, %r11 + movq %r11, 168(%rsp) + andnq %r10, %r8, %r11 + xorq %rdx, %r11 + movq %r11, 176(%rsp) + andnq %rdi, %r10, %rdx + xorq %r8, %rdx + movq %rdx, 184(%rsp) + andnq %rsi, %rdi, %rdx + xorq %r10, %rdx + movq %rdx, 192(%rsp) + decq %rax + movq (%rsp), %rdx + movq 8(%rsp), %rsi + movq 16(%rsp), %rdi + movq 24(%rsp), %r8 + movq 32(%rsp), %r10 + xorq 40(%rsp), %rdx + xorq 48(%rsp), %rsi + xorq 56(%rsp), %rdi + xorq 64(%rsp), %r8 + xorq 72(%rsp), %r10 + xorq 80(%rsp), %rdx + xorq 88(%rsp), %rsi + xorq 96(%rsp), %rdi + xorq 104(%rsp), %r8 + xorq 112(%rsp), %r10 + xorq 120(%rsp), %rdx + xorq 128(%rsp), %rsi + xorq 136(%rsp), %rdi + xorq 144(%rsp), %r8 + xorq 152(%rsp), %r10 + xorq 160(%rsp), %rdx + xorq 168(%rsp), %rsi + xorq 176(%rsp), %rdi + xorq 184(%rsp), %r8 + xorq 192(%rsp), %r10 + movq %rsi, %r11 + rolq $1, %r11 + xorq %r10, %r11 + movq %rdi, %rbp + rolq $1, %rbp + xorq %rdx, %rbp + movq %r8, %rbx + rolq $1, %rbx + xorq %rsi, %rbx + movq %r10, %rsi + rolq $1, %rsi + xorq %rdi, %rsi + rolq $1, %rdx + xorq %r8, %rdx + movq (%rsp), %rdi + xorq %r11, %rdi + movq 48(%rsp), %r8 + xorq %rbp, %r8 + rolq $44, %r8 + movq 96(%rsp), %r10 + xorq %rbx, %r10 + rolq $43, %r10 + movq 144(%rsp), %r12 + xorq %rsi, %r12 + rolq $21, %r12 + movq 192(%rsp), %r13 + xorq %rdx, %r13 + rolq $14, %r13 + andnq %r10, %r8, %r14 + xorq (%rcx,%rax,8), %r14 + xorq %rdi, %r14 + movq %r14, 200(%rsp) + andnq %r12, %r10, %r14 + xorq %r8, %r14 + movq %r14, 208(%rsp) + andnq %r13, %r12, %r14 + xorq %r10, %r14 + movq %r14, 216(%rsp) + andnq %rdi, %r13, %r10 + xorq %r12, %r10 + movq %r10, 224(%rsp) + andnq %r8, %rdi, %rdi + xorq %r13, %rdi + movq %rdi, 232(%rsp) + movq 24(%rsp), %rdi + xorq %rsi, %rdi + rolq $28, %rdi + movq 72(%rsp), %r8 + xorq %rdx, %r8 + rolq $20, %r8 + movq 80(%rsp), %r10 + xorq %r11, %r10 + rolq $3, %r10 + movq 128(%rsp), %r12 + xorq %rbp, %r12 + rolq $45, %r12 + movq 176(%rsp), %r13 + xorq %rbx, %r13 + rolq $61, %r13 + andnq %r10, %r8, %r14 + xorq %rdi, %r14 + movq %r14, 240(%rsp) + andnq %r12, %r10, %r14 + xorq %r8, %r14 + movq %r14, 248(%rsp) + andnq %r13, %r12, %r14 + xorq %r10, %r14 + movq %r14, 256(%rsp) + andnq %rdi, %r13, %r10 + xorq %r12, %r10 + movq %r10, 264(%rsp) + andnq %r8, %rdi, %rdi + xorq %r13, %rdi + movq %rdi, 272(%rsp) + movq 8(%rsp), %rdi + xorq %rbp, %rdi + rolq $1, %rdi + movq 56(%rsp), %r8 + xorq %rbx, %r8 + rolq $6, %r8 + movq 104(%rsp), %r10 + xorq %rsi, %r10 + rolq $25, %r10 + movq 152(%rsp), %r12 + xorq %rdx, %r12 + rolq $8, %r12 + movq 160(%rsp), %r13 + xorq %r11, %r13 + rolq $18, %r13 + andnq %r10, %r8, %r14 + xorq %rdi, %r14 + movq %r14, 280(%rsp) + andnq %r12, %r10, %r14 + xorq %r8, %r14 + movq %r14, 288(%rsp) + andnq %r13, %r12, %r14 + xorq %r10, %r14 + movq %r14, 296(%rsp) + andnq %rdi, %r13, %r10 + xorq %r12, %r10 + movq %r10, 304(%rsp) + andnq %r8, %rdi, %rdi + xorq %r13, %rdi + movq %rdi, 312(%rsp) + movq 32(%rsp), %rdi + xorq %rdx, %rdi + rolq $27, %rdi + movq 40(%rsp), %r8 + xorq %r11, %r8 + rolq $36, %r8 + movq 88(%rsp), %r10 + xorq %rbp, %r10 + rolq $10, %r10 + movq 136(%rsp), %r12 + xorq %rbx, %r12 + rolq $15, %r12 + movq 184(%rsp), %r13 + xorq %rsi, %r13 + rolq $56, %r13 + andnq %r10, %r8, %r14 + xorq %rdi, %r14 + movq %r14, 320(%rsp) + andnq %r12, %r10, %r14 + xorq %r8, %r14 + movq %r14, 328(%rsp) + andnq %r13, %r12, %r14 + xorq %r10, %r14 + movq %r14, 336(%rsp) + andnq %rdi, %r13, %r10 + xorq %r12, %r10 + movq %r10, 344(%rsp) + andnq %r8, %rdi, %rdi + xorq %r13, %rdi + movq %rdi, 352(%rsp) + movq 16(%rsp), %rdi + xorq %rbx, %rdi + rolq $62, %rdi + movq 64(%rsp), %r8 + xorq %rsi, %r8 + rolq $55, %r8 + movq %r8, %rsi + movq 112(%rsp), %r8 + xorq %rdx, %r8 + rolq $39, %r8 + movq %r8, %rdx + movq 120(%rsp), %r8 + xorq %r11, %r8 + rolq $41, %r8 + movq 168(%rsp), %r10 + xorq %rbp, %r10 + rolq $2, %r10 + andnq %rdx, %rsi, %r11 + xorq %rdi, %r11 + movq %r11, 360(%rsp) + andnq %r8, %rdx, %r11 + xorq %rsi, %r11 + movq %r11, 368(%rsp) + andnq %r10, %r8, %r11 + xorq %rdx, %r11 + movq %r11, 376(%rsp) + andnq %rdi, %r10, %rdx + xorq %r8, %rdx + movq %rdx, 384(%rsp) + andnq %rsi, %rdi, %rdx + xorq %r10, %rdx + movq %rdx, 392(%rsp) + decq %rax + jne Lkeccak_1600$5 + movq 400(%rsp), %rax + movq 440(%rsp), %rcx + movq %rcx, %rdx + shrq $3, %rdx + movq $0, %rsi + jmp Lkeccak_1600$3 +Lkeccak_1600$4: + movq 200(%rsp,%rsi,8), %rdi + movq %rdi, (%rax,%rsi,8) + leaq 1(%rsi), %rsi +Lkeccak_1600$3: + cmpq %rdx, %rsi + jb Lkeccak_1600$4 + shlq $3, %rsi + jmp Lkeccak_1600$1 +Lkeccak_1600$2: + movb 200(%rsp,%rsi), %dl + movb %dl, (%rax,%rsi) + leaq 1(%rsi), %rsi +Lkeccak_1600$1: + cmpq %rcx, %rsi + jb Lkeccak_1600$2 + addq $448, %rsp + popq %r14 + popq %r13 + popq %r12 + popq %rbx + popq %rbp + ret + .data + .globl _glob_data + .globl glob_data + .p2align 5 +_glob_data: +glob_data: +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 8 +.byte 128 +.byte 0 +.byte 128 +.byte 0 +.byte 0 +.byte 0 +.byte 128 +.byte 1 +.byte 0 +.byte 0 +.byte 128 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 128 +.byte 128 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 128 +.byte 129 +.byte 128 +.byte 0 +.byte 128 +.byte 0 +.byte 0 +.byte 0 +.byte 128 +.byte 10 +.byte 0 +.byte 0 +.byte 128 +.byte 0 +.byte 0 +.byte 0 +.byte 128 +.byte 10 +.byte 128 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 128 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 128 +.byte 2 +.byte 128 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 128 +.byte 3 +.byte 128 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 128 +.byte 137 +.byte 128 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 128 +.byte 139 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 128 +.byte 139 +.byte 128 +.byte 0 +.byte 128 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 10 +.byte 0 +.byte 0 +.byte 128 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 9 +.byte 128 +.byte 0 +.byte 128 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 136 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 138 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 9 +.byte 128 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 128 +.byte 129 +.byte 128 +.byte 0 +.byte 128 +.byte 0 +.byte 0 +.byte 0 +.byte 128 +.byte 1 +.byte 0 +.byte 0 +.byte 128 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 139 +.byte 128 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 128 +.byte 0 +.byte 128 +.byte 0 +.byte 0 +.byte 0 +.byte 128 +.byte 138 +.byte 128 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 128 +.byte 130 +.byte 128 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 1 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 0 +.byte 0 \ No newline at end of file From 3a6efe6e661de9e8eed0b661529a8664cbc01d31 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Thu, 19 Sep 2019 12:03:41 +0000 Subject: [PATCH 486/525] Add README.md --- README.md | 52 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 52 insertions(+) create mode 100644 README.md diff --git a/README.md b/README.md new file mode 100644 index 0000000..1b7f693 --- /dev/null +++ b/README.md @@ -0,0 +1,52 @@ +# Machine-Checked Proofs for Cryptographic Standards +## Indifferentiability of Sponge and Secure High-Assurance Implementations of SHA-3 + +This repository contains the proof and implementation artefacts associated with the paper "Machine-Checked Proofs for Cryptographic Standards: Indifferentiability of Sponge and Secure High-Assurance Implementations of SHA-3", which will appear at CCS 2019. + +### Contents + +The `proof` folder contains all EasyCrypt proofs, including: + +* The root `proof` folder and the `proof/smart_counter` folder contain generic + definitions, proofs of indifferentiability for Sponge, and proofs of security + for SHA-3 and SHAKE; +* The `proof/implem` folder contains all proofs pertaining to the Jasmin + implementation, and some related libraries: + - The root `proof/implem` folder contains proofs of equivalence between the + Jasmin implementations of the Sponge and its EasyCrypt specification, and + proofs that the Jasmin implementations, instantiated with the corresponding + implementations of the permutation, are leak-free in the cryptographic + constant-time model; + - The `proof/implem/perm` folder contains proofs of correctness for the + permutation, and proofs of equivalence between its reference and optimized + implementations. + +### Checking the proofs + +The proof of indifferentiability and random permutation-security for Sponge and +SHA-3 can be checked using EasyCrypt (currently at +commit [3ef489bc](https://github.com/EasyCrypt/easycrypt/tree/3ef489bc09ef1186b2ce979ba430f6fd876fe781)) +without any additional dependencies. + +The proofs of correctness for Jasmin also relies on Jasmin's `eclibs` (currently +at commit [29b97ec1](https://github.com/jasmin-lang/jasmin/tree/29b97ec1bc4855651a7a5d4c13a4397a9f84f944)). +In the following, replace `` with any path you choose. + +First, clone the Jasmin repository and checkout the commit: + +```bash +git clone https://github.com/jasmin-lang/jasmin.git +cd +git checkout 29b97ec1bc4855651a7a5d4c13a4397a9f84f944 +``` + +From the root of this (`sha3`) repository, you can now run the following command +to check all Jasmin-related targets. + +```bash +ECARGS="-I Jasmin:/eclib" make check jsponge jperm libc +``` + +### Compiling from Jasmin to ASM + +TODO \ No newline at end of file From 89f31acb50ce7fd810a6449aa0aed065b2ec8b0e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Thu, 19 Sep 2019 13:50:42 +0100 Subject: [PATCH 487/525] Remove irrelevant Makefiles --- .../keccakf160064bits/avx2/Makefile | 15 ------------ .../keccakf160064bits/avx2_openssl/Makefile | 15 ------------ .../keccakf160064bits/ref/Makefile | 15 ------------ .../keccakf160064bits/scalar/Makefile | 15 ------------ .../keccakf160064bits/scalar_g/Makefile | 15 ------------ code/crypto_hash/keccak1600/avx2/Makefile | 12 ---------- code/crypto_hash/keccak1600/ref/Makefile | 12 ---------- code/crypto_hash/keccak1600/scalar/Makefile | 12 ---------- code/crypto_hash/keccak1600/scalar_g/Makefile | 12 ---------- code/crypto_hash/sha3224/avx2/Makefile | 15 ------------ code/crypto_hash/sha3224/scalar/Makefile | 15 ------------ code/crypto_hash/sha3256/avx2/Makefile | 15 ------------ code/crypto_hash/sha3256/scalar/Makefile | 15 ------------ code/crypto_hash/sha3384/avx2/Makefile | 15 ------------ code/crypto_hash/sha3384/scalar/Makefile | 15 ------------ code/crypto_hash/sha3512/avx2/Makefile | 15 ------------ code/crypto_hash/sha3512/scalar/Makefile | 15 ------------ code/crypto_hash/shake128/avx2/Makefile | 15 ------------ code/crypto_hash/shake128/scalar/Makefile | 15 ------------ code/crypto_hash/shake256/avx2/Makefile | 24 ------------------- code/crypto_hash/shake256/ref/Makefile | 15 ------------ code/crypto_hash/shake256/scalar/Makefile | 15 ------------ code/crypto_hash/shake256/scalar_g/Makefile | 15 ------------ 23 files changed, 342 deletions(-) delete mode 100644 code/crypto_core/keccakf160064bits/avx2/Makefile delete mode 100644 code/crypto_core/keccakf160064bits/avx2_openssl/Makefile delete mode 100644 code/crypto_core/keccakf160064bits/ref/Makefile delete mode 100644 code/crypto_core/keccakf160064bits/scalar/Makefile delete mode 100644 code/crypto_core/keccakf160064bits/scalar_g/Makefile delete mode 100644 code/crypto_hash/keccak1600/avx2/Makefile delete mode 100644 code/crypto_hash/keccak1600/ref/Makefile delete mode 100644 code/crypto_hash/keccak1600/scalar/Makefile delete mode 100644 code/crypto_hash/keccak1600/scalar_g/Makefile delete mode 100644 code/crypto_hash/sha3224/avx2/Makefile delete mode 100644 code/crypto_hash/sha3224/scalar/Makefile delete mode 100644 code/crypto_hash/sha3256/avx2/Makefile delete mode 100644 code/crypto_hash/sha3256/scalar/Makefile delete mode 100644 code/crypto_hash/sha3384/avx2/Makefile delete mode 100644 code/crypto_hash/sha3384/scalar/Makefile delete mode 100644 code/crypto_hash/sha3512/avx2/Makefile delete mode 100644 code/crypto_hash/sha3512/scalar/Makefile delete mode 100644 code/crypto_hash/shake128/avx2/Makefile delete mode 100644 code/crypto_hash/shake128/scalar/Makefile delete mode 100644 code/crypto_hash/shake256/avx2/Makefile delete mode 100644 code/crypto_hash/shake256/ref/Makefile delete mode 100644 code/crypto_hash/shake256/scalar/Makefile delete mode 100644 code/crypto_hash/shake256/scalar_g/Makefile diff --git a/code/crypto_core/keccakf160064bits/avx2/Makefile b/code/crypto_core/keccakf160064bits/avx2/Makefile deleted file mode 100644 index 5b25fdc..0000000 --- a/code/crypto_core/keccakf160064bits/avx2/Makefile +++ /dev/null @@ -1,15 +0,0 @@ -# -*- Makefile -*- - -.PHONY: default clean - -default: keccak_f1600_export.japp keccak_f1600_export.s - @true - -clean: - rm -f keccak_f1600_export.japp keccak_f1600_export.s - -%.s: %.japp - jasminc -lea -pasm $< > $@ || rm -f $@ - -%.japp: %.jazz - gpp -I../../../ -o $@ $< diff --git a/code/crypto_core/keccakf160064bits/avx2_openssl/Makefile b/code/crypto_core/keccakf160064bits/avx2_openssl/Makefile deleted file mode 100644 index 5b25fdc..0000000 --- a/code/crypto_core/keccakf160064bits/avx2_openssl/Makefile +++ /dev/null @@ -1,15 +0,0 @@ -# -*- Makefile -*- - -.PHONY: default clean - -default: keccak_f1600_export.japp keccak_f1600_export.s - @true - -clean: - rm -f keccak_f1600_export.japp keccak_f1600_export.s - -%.s: %.japp - jasminc -lea -pasm $< > $@ || rm -f $@ - -%.japp: %.jazz - gpp -I../../../ -o $@ $< diff --git a/code/crypto_core/keccakf160064bits/ref/Makefile b/code/crypto_core/keccakf160064bits/ref/Makefile deleted file mode 100644 index 5b25fdc..0000000 --- a/code/crypto_core/keccakf160064bits/ref/Makefile +++ /dev/null @@ -1,15 +0,0 @@ -# -*- Makefile -*- - -.PHONY: default clean - -default: keccak_f1600_export.japp keccak_f1600_export.s - @true - -clean: - rm -f keccak_f1600_export.japp keccak_f1600_export.s - -%.s: %.japp - jasminc -lea -pasm $< > $@ || rm -f $@ - -%.japp: %.jazz - gpp -I../../../ -o $@ $< diff --git a/code/crypto_core/keccakf160064bits/scalar/Makefile b/code/crypto_core/keccakf160064bits/scalar/Makefile deleted file mode 100644 index 5b25fdc..0000000 --- a/code/crypto_core/keccakf160064bits/scalar/Makefile +++ /dev/null @@ -1,15 +0,0 @@ -# -*- Makefile -*- - -.PHONY: default clean - -default: keccak_f1600_export.japp keccak_f1600_export.s - @true - -clean: - rm -f keccak_f1600_export.japp keccak_f1600_export.s - -%.s: %.japp - jasminc -lea -pasm $< > $@ || rm -f $@ - -%.japp: %.jazz - gpp -I../../../ -o $@ $< diff --git a/code/crypto_core/keccakf160064bits/scalar_g/Makefile b/code/crypto_core/keccakf160064bits/scalar_g/Makefile deleted file mode 100644 index 5b25fdc..0000000 --- a/code/crypto_core/keccakf160064bits/scalar_g/Makefile +++ /dev/null @@ -1,15 +0,0 @@ -# -*- Makefile -*- - -.PHONY: default clean - -default: keccak_f1600_export.japp keccak_f1600_export.s - @true - -clean: - rm -f keccak_f1600_export.japp keccak_f1600_export.s - -%.s: %.japp - jasminc -lea -pasm $< > $@ || rm -f $@ - -%.japp: %.jazz - gpp -I../../../ -o $@ $< diff --git a/code/crypto_hash/keccak1600/avx2/Makefile b/code/crypto_hash/keccak1600/avx2/Makefile deleted file mode 100644 index 23a2571..0000000 --- a/code/crypto_hash/keccak1600/avx2/Makefile +++ /dev/null @@ -1,12 +0,0 @@ -# -*- Makefile -*- - -.PHONY: default clean - -default: keccak_1600.japp - @true - -clean: - rm -f keccak_1600.japp - -%.japp: %.jazz - gpp -I../../../ -o $@ $< diff --git a/code/crypto_hash/keccak1600/ref/Makefile b/code/crypto_hash/keccak1600/ref/Makefile deleted file mode 100644 index 23a2571..0000000 --- a/code/crypto_hash/keccak1600/ref/Makefile +++ /dev/null @@ -1,12 +0,0 @@ -# -*- Makefile -*- - -.PHONY: default clean - -default: keccak_1600.japp - @true - -clean: - rm -f keccak_1600.japp - -%.japp: %.jazz - gpp -I../../../ -o $@ $< diff --git a/code/crypto_hash/keccak1600/scalar/Makefile b/code/crypto_hash/keccak1600/scalar/Makefile deleted file mode 100644 index 23a2571..0000000 --- a/code/crypto_hash/keccak1600/scalar/Makefile +++ /dev/null @@ -1,12 +0,0 @@ -# -*- Makefile -*- - -.PHONY: default clean - -default: keccak_1600.japp - @true - -clean: - rm -f keccak_1600.japp - -%.japp: %.jazz - gpp -I../../../ -o $@ $< diff --git a/code/crypto_hash/keccak1600/scalar_g/Makefile b/code/crypto_hash/keccak1600/scalar_g/Makefile deleted file mode 100644 index 23a2571..0000000 --- a/code/crypto_hash/keccak1600/scalar_g/Makefile +++ /dev/null @@ -1,12 +0,0 @@ -# -*- Makefile -*- - -.PHONY: default clean - -default: keccak_1600.japp - @true - -clean: - rm -f keccak_1600.japp - -%.japp: %.jazz - gpp -I../../../ -o $@ $< diff --git a/code/crypto_hash/sha3224/avx2/Makefile b/code/crypto_hash/sha3224/avx2/Makefile deleted file mode 100644 index 1d2484f..0000000 --- a/code/crypto_hash/sha3224/avx2/Makefile +++ /dev/null @@ -1,15 +0,0 @@ -# -*- Makefile -*- - -.PHONY: default clean - -default: sha3224.japp sha3224.s - @true - -clean: - rm -f sha3224.japp sha3224.s - -%.s: %.japp - jasminc -lea -pasm $< > $@ || rm -f $@ - -%.japp: %.jazz - gpp -I../../../ -o $@ $< diff --git a/code/crypto_hash/sha3224/scalar/Makefile b/code/crypto_hash/sha3224/scalar/Makefile deleted file mode 100644 index 1d2484f..0000000 --- a/code/crypto_hash/sha3224/scalar/Makefile +++ /dev/null @@ -1,15 +0,0 @@ -# -*- Makefile -*- - -.PHONY: default clean - -default: sha3224.japp sha3224.s - @true - -clean: - rm -f sha3224.japp sha3224.s - -%.s: %.japp - jasminc -lea -pasm $< > $@ || rm -f $@ - -%.japp: %.jazz - gpp -I../../../ -o $@ $< diff --git a/code/crypto_hash/sha3256/avx2/Makefile b/code/crypto_hash/sha3256/avx2/Makefile deleted file mode 100644 index 0350626..0000000 --- a/code/crypto_hash/sha3256/avx2/Makefile +++ /dev/null @@ -1,15 +0,0 @@ -# -*- Makefile -*- - -.PHONY: default clean - -default: sha3256.japp sha3256.s - @true - -clean: - rm -f sha3256.japp sha3256.s - -%.s: %.japp - jasminc -lea -pasm $< > $@ || rm -f $@ - -%.japp: %.jazz - gpp -I../../../ -o $@ $< diff --git a/code/crypto_hash/sha3256/scalar/Makefile b/code/crypto_hash/sha3256/scalar/Makefile deleted file mode 100644 index 0350626..0000000 --- a/code/crypto_hash/sha3256/scalar/Makefile +++ /dev/null @@ -1,15 +0,0 @@ -# -*- Makefile -*- - -.PHONY: default clean - -default: sha3256.japp sha3256.s - @true - -clean: - rm -f sha3256.japp sha3256.s - -%.s: %.japp - jasminc -lea -pasm $< > $@ || rm -f $@ - -%.japp: %.jazz - gpp -I../../../ -o $@ $< diff --git a/code/crypto_hash/sha3384/avx2/Makefile b/code/crypto_hash/sha3384/avx2/Makefile deleted file mode 100644 index 3f2c256..0000000 --- a/code/crypto_hash/sha3384/avx2/Makefile +++ /dev/null @@ -1,15 +0,0 @@ -# -*- Makefile -*- - -.PHONY: default clean - -default: sha3384.japp sha3384.s - @true - -clean: - rm -f sha3384.japp sha3384.s - -%.s: %.japp - jasminc -lea -pasm $< > $@ || rm -f $@ - -%.japp: %.jazz - gpp -I../../../ -o $@ $< diff --git a/code/crypto_hash/sha3384/scalar/Makefile b/code/crypto_hash/sha3384/scalar/Makefile deleted file mode 100644 index 3f2c256..0000000 --- a/code/crypto_hash/sha3384/scalar/Makefile +++ /dev/null @@ -1,15 +0,0 @@ -# -*- Makefile -*- - -.PHONY: default clean - -default: sha3384.japp sha3384.s - @true - -clean: - rm -f sha3384.japp sha3384.s - -%.s: %.japp - jasminc -lea -pasm $< > $@ || rm -f $@ - -%.japp: %.jazz - gpp -I../../../ -o $@ $< diff --git a/code/crypto_hash/sha3512/avx2/Makefile b/code/crypto_hash/sha3512/avx2/Makefile deleted file mode 100644 index f394ed7..0000000 --- a/code/crypto_hash/sha3512/avx2/Makefile +++ /dev/null @@ -1,15 +0,0 @@ -# -*- Makefile -*- - -.PHONY: default clean - -default: sha3512.japp sha3512.s - @true - -clean: - rm -f sha3512.japp sha3512.s - -%.s: %.japp - jasminc -lea -pasm $< > $@ || rm -f $@ - -%.japp: %.jazz - gpp -I../../../ -o $@ $< diff --git a/code/crypto_hash/sha3512/scalar/Makefile b/code/crypto_hash/sha3512/scalar/Makefile deleted file mode 100644 index f394ed7..0000000 --- a/code/crypto_hash/sha3512/scalar/Makefile +++ /dev/null @@ -1,15 +0,0 @@ -# -*- Makefile -*- - -.PHONY: default clean - -default: sha3512.japp sha3512.s - @true - -clean: - rm -f sha3512.japp sha3512.s - -%.s: %.japp - jasminc -lea -pasm $< > $@ || rm -f $@ - -%.japp: %.jazz - gpp -I../../../ -o $@ $< diff --git a/code/crypto_hash/shake128/avx2/Makefile b/code/crypto_hash/shake128/avx2/Makefile deleted file mode 100644 index 1f3e979..0000000 --- a/code/crypto_hash/shake128/avx2/Makefile +++ /dev/null @@ -1,15 +0,0 @@ -# -*- Makefile -*- - -.PHONY: default clean - -default: shake128.japp shake128.s - @true - -clean: - rm -f shake128.japp shake128.s - -%.s: %.japp - jasminc -lea -pasm $< > $@ || rm -f $@ - -%.japp: %.jazz - gpp -I../../../ -o $@ $< diff --git a/code/crypto_hash/shake128/scalar/Makefile b/code/crypto_hash/shake128/scalar/Makefile deleted file mode 100644 index 1f3e979..0000000 --- a/code/crypto_hash/shake128/scalar/Makefile +++ /dev/null @@ -1,15 +0,0 @@ -# -*- Makefile -*- - -.PHONY: default clean - -default: shake128.japp shake128.s - @true - -clean: - rm -f shake128.japp shake128.s - -%.s: %.japp - jasminc -lea -pasm $< > $@ || rm -f $@ - -%.japp: %.jazz - gpp -I../../../ -o $@ $< diff --git a/code/crypto_hash/shake256/avx2/Makefile b/code/crypto_hash/shake256/avx2/Makefile deleted file mode 100644 index ab3ac88..0000000 --- a/code/crypto_hash/shake256/avx2/Makefile +++ /dev/null @@ -1,24 +0,0 @@ -# -*- Makefile -*- - -.PHONY: default clean - -# extension .specific to not break current benchmark building system -default: shake256.s shake256.s.specific - @true - -clean: - rm -f shake256.japp shake256.s shake256.japp.specific shake256.s.specific - -# shake256 -shake256.japp: shake256.jazz - gpp -I../../../ -o $@ $< - -shake256.s: shake256.japp - jasminc -lea -pasm $< > $@ || rm -f $@ - -# shake256 with specific implementation of add full block -shake256.japp.specific: shake256.jazz - gpp -I../../../ -DKECCAK_1600_SPECIFIC_IMPLEMENTATIONS -o $@ $< - -shake256.s.specific: shake256.japp.specific - jasminc -lea -pasm $< > $@ || rm -f $@ diff --git a/code/crypto_hash/shake256/ref/Makefile b/code/crypto_hash/shake256/ref/Makefile deleted file mode 100644 index fa5211f..0000000 --- a/code/crypto_hash/shake256/ref/Makefile +++ /dev/null @@ -1,15 +0,0 @@ -# -*- Makefile -*- - -.PHONY: default clean - -default: shake256.japp shake256.s - @true - -clean: - rm -f shake256.japp shake256.s - -%.s: %.japp - jasminc -lea -pasm $< > $@ || rm -f $@ - -%.japp: %.jazz - gpp -I../../../ -o $@ $< diff --git a/code/crypto_hash/shake256/scalar/Makefile b/code/crypto_hash/shake256/scalar/Makefile deleted file mode 100644 index fa5211f..0000000 --- a/code/crypto_hash/shake256/scalar/Makefile +++ /dev/null @@ -1,15 +0,0 @@ -# -*- Makefile -*- - -.PHONY: default clean - -default: shake256.japp shake256.s - @true - -clean: - rm -f shake256.japp shake256.s - -%.s: %.japp - jasminc -lea -pasm $< > $@ || rm -f $@ - -%.japp: %.jazz - gpp -I../../../ -o $@ $< diff --git a/code/crypto_hash/shake256/scalar_g/Makefile b/code/crypto_hash/shake256/scalar_g/Makefile deleted file mode 100644 index fa5211f..0000000 --- a/code/crypto_hash/shake256/scalar_g/Makefile +++ /dev/null @@ -1,15 +0,0 @@ -# -*- Makefile -*- - -.PHONY: default clean - -default: shake256.japp shake256.s - @true - -clean: - rm -f shake256.japp shake256.s - -%.s: %.japp - jasminc -lea -pasm $< > $@ || rm -f $@ - -%.japp: %.jazz - gpp -I../../../ -o $@ $< From 1a823c1c87d3325fee97c3b76d7e4c7b71cd3db3 Mon Sep 17 00:00:00 2001 From: Pierre-Yves Strub Date: Mon, 14 Oct 2019 11:33:49 +0200 Subject: [PATCH 488/525] CI: move to 1.0 --- .gitlab-ci.yml | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index ba75829..cc62a50 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -11,16 +11,17 @@ services: before_script: - docker info -- docker pull easycryptpa/ec-test-box:kms -- docker run --rm easycryptpa/ec-test-box:kms opam config exec -- easycrypt config +- docker pull easycryptpa/ec-test-box +- docker run --rm easycryptpa/ec-test-box opam config exec -- easycrypt config - >- - docker run --name testbox easycryptpa/ec-test-box:kms + docker run --name testbox easycryptpa/ec-test-box git clone -b array_cast https://github.com/jasmin-lang/jasmin jasmin - docker commit testbox testbox:latest .tests: only: - master + - deploy-1.0 script: - >- docker run -v $PWD:/home/ci/sha3 From 4890926e65fed6dc1209af537f523e32cbc900fe Mon Sep 17 00:00:00 2001 From: Pierre-Yves Strub Date: Mon, 14 Oct 2019 11:42:14 +0200 Subject: [PATCH 489/525] misc --- .gitlab-ci.yml | 1 - README.md | 36 +++++++++++++++++++++--------------- config/tests.config | 2 +- 3 files changed, 22 insertions(+), 17 deletions(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index cc62a50..d34ea30 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -21,7 +21,6 @@ before_script: .tests: only: - master - - deploy-1.0 script: - >- docker run -v $PWD:/home/ci/sha3 diff --git a/README.md b/README.md index 1b7f693..4ab0311 100644 --- a/README.md +++ b/README.md @@ -1,7 +1,11 @@ # Machine-Checked Proofs for Cryptographic Standards + ## Indifferentiability of Sponge and Secure High-Assurance Implementations of SHA-3 -This repository contains the proof and implementation artefacts associated with the paper "Machine-Checked Proofs for Cryptographic Standards: Indifferentiability of Sponge and Secure High-Assurance Implementations of SHA-3", which will appear at CCS 2019. +This repository contains the proof and implementation artefacts +associated with the paper "Machine-Checked Proofs for Cryptographic +Standards: Indifferentiability of Sponge and Secure High-Assurance +Implementations of SHA-3", which will appear at CCS 2019. ### Contents @@ -10,43 +14,45 @@ The `proof` folder contains all EasyCrypt proofs, including: * The root `proof` folder and the `proof/smart_counter` folder contain generic definitions, proofs of indifferentiability for Sponge, and proofs of security for SHA-3 and SHAKE; + * The `proof/implem` folder contains all proofs pertaining to the Jasmin implementation, and some related libraries: + - The root `proof/implem` folder contains proofs of equivalence between the Jasmin implementations of the Sponge and its EasyCrypt specification, and proofs that the Jasmin implementations, instantiated with the corresponding implementations of the permutation, are leak-free in the cryptographic constant-time model; + - The `proof/implem/perm` folder contains proofs of correctness for the permutation, and proofs of equivalence between its reference and optimized implementations. ### Checking the proofs -The proof of indifferentiability and random permutation-security for Sponge and -SHA-3 can be checked using EasyCrypt (currently at -commit [3ef489bc](https://github.com/EasyCrypt/easycrypt/tree/3ef489bc09ef1186b2ce979ba430f6fd876fe781)) -without any additional dependencies. +The proof of indifferentiability and random permutation-security for +Sponge and SHA-3 can be checked using EasyCrypt 1.x without any +additional dependencies. -The proofs of correctness for Jasmin also relies on Jasmin's `eclibs` (currently -at commit [29b97ec1](https://github.com/jasmin-lang/jasmin/tree/29b97ec1bc4855651a7a5d4c13a4397a9f84f944)). -In the following, replace `` with any path you choose. +The proofs of correctness for Jasmin also relies on Jasmin's `eclibs` +(currently at commit [29b97ec1][jasmin]). -First, clone the Jasmin repository and checkout the commit: +[jasmin]: https://github.com/jasmin-lang/jasmin/tree/29b97ec1bc4855651a7a5d4c13a4397a9f84f944 -```bash -git clone https://github.com/jasmin-lang/jasmin.git -cd -git checkout 29b97ec1bc4855651a7a5d4c13a4397a9f84f944 +You can fetch it using: + +```base +git submodule update --init ``` From the root of this (`sha3`) repository, you can now run the following command to check all Jasmin-related targets. ```bash -ECARGS="-I Jasmin:/eclib" make check jsponge jperm libc +make check jsponge jperm libc ``` ### Compiling from Jasmin to ASM -TODO \ No newline at end of file +TODO + diff --git a/config/tests.config b/config/tests.config index bac5b80..305b823 100644 --- a/config/tests.config +++ b/config/tests.config @@ -1,6 +1,6 @@ [default] bin = easycrypt -args = -timeout 30 -max-provers 2 -p Z3 -p Alt-Ergo -I proof -I proof/smart_counter -I proof/impl -I proof/impl/perm +args = -I Jasmin:jasmin/eclib -I proof -I proof/smart_counter -I proof/impl -I proof/impl/perm [test-sha3] okdirs = !proof From 4bb9ad0598e85c9bb0df01bc752c675a222f19ac Mon Sep 17 00:00:00 2001 From: Pierre-Yves Strub Date: Mon, 14 Oct 2019 11:54:50 +0200 Subject: [PATCH 490/525] CI: use submodules --- .gitlab-ci.yml | 10 ++++------ .gitmodules | 3 +++ config/tests.config | 2 +- jasmin | 1 + 4 files changed, 9 insertions(+), 7 deletions(-) create mode 100644 .gitmodules create mode 160000 jasmin diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index d34ea30..0ad0a5f 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -3,8 +3,8 @@ image: docker:latest variables: DOCKER_DRIVER: overlay DOCKER_TLS_CERTDIR: "" - ECARGS: "-I Jasmin:/home/ci/jasmin/eclib" ECJOBS: 2 + GIT_SUBMODULE_STRATEGY: recursive services: - docker:dind @@ -13,18 +13,16 @@ before_script: - docker info - docker pull easycryptpa/ec-test-box - docker run --rm easycryptpa/ec-test-box opam config exec -- easycrypt config -- >- - docker run --name testbox easycryptpa/ec-test-box - git clone -b array_cast https://github.com/jasmin-lang/jasmin jasmin +- docker run --name testbox easycryptpa/ec-test-box - docker commit testbox testbox:latest .tests: only: - master + - ci script: - >- - docker run -v $PWD:/home/ci/sha3 - --env CHECKS --env ECARGS --env ECJOBS testbox + docker run -v $PWD:/home/ci/sha3 --env CHECKS --env ECJOBS testbox sh -c 'cd sha3 && opam config exec -- make check-xunit' artifacts: when: on_failure diff --git a/.gitmodules b/.gitmodules new file mode 100644 index 0000000..d50059f --- /dev/null +++ b/.gitmodules @@ -0,0 +1,3 @@ +[submodule "jasmin"] + path = jasmin + url = https://github.com/jasmin-lang/jasmin diff --git a/config/tests.config b/config/tests.config index 305b823..580b3a8 100644 --- a/config/tests.config +++ b/config/tests.config @@ -1,6 +1,6 @@ [default] bin = easycrypt -args = -I Jasmin:jasmin/eclib -I proof -I proof/smart_counter -I proof/impl -I proof/impl/perm +args = -timeout 30 -I Jasmin:jasmin/eclib -I proof -I proof/smart_counter -I proof/impl -I proof/impl/perm [test-sha3] okdirs = !proof diff --git a/jasmin b/jasmin new file mode 160000 index 0000000..29b97ec --- /dev/null +++ b/jasmin @@ -0,0 +1 @@ +Subproject commit 29b97ec1bc4855651a7a5d4c13a4397a9f84f944 From 2e9802d3f37f92ed8f861d72025a56b4ff4faf6b Mon Sep 17 00:00:00 2001 From: Pierre-Yves Strub Date: Mon, 14 Oct 2019 13:06:10 +0200 Subject: [PATCH 491/525] Remove explicit calls to the option "prover" --- proof/Common.ec | 3 --- proof/MapAux.ec | 3 --- proof/Sponge.ec | 3 --- 3 files changed, 9 deletions(-) diff --git a/proof/Common.ec b/proof/Common.ec index 29be89f..72d1d38 100644 --- a/proof/Common.ec +++ b/proof/Common.ec @@ -1,7 +1,4 @@ (*------------------- Common Definitions and Lemmas --------------------*) - -prover quorum=2 ["Z3" "Alt-Ergo"]. - require import Core Int IntExtra IntDiv Real List Distr. require import Ring StdRing StdOrder StdBigop BitEncoding DProd. require (*--*) FinType BitWord IdealPRP Monoid. diff --git a/proof/MapAux.ec b/proof/MapAux.ec index a95f201..fefc337 100644 --- a/proof/MapAux.ec +++ b/proof/MapAux.ec @@ -1,7 +1,4 @@ (*---------------------- Auxiliary Lemmas on Maps ----------------------*) - -prover [""]. - require import AllCore SmtMap FSet StdOrder. import IntOrder. diff --git a/proof/Sponge.ec b/proof/Sponge.ec index 350701c..3df0fd1 100644 --- a/proof/Sponge.ec +++ b/proof/Sponge.ec @@ -1,7 +1,4 @@ (*------------------------- Sponge Construction ------------------------*) - -prover quorum=2 ["Z3" "Alt-Ergo"]. - require import Core Int IntDiv Real List FSet SmtMap. (*---*) import IntExtra. require import Distr DBool DList. From 54483ddc0195f829b061c4137a1af81db0deeae7 Mon Sep 17 00:00:00 2001 From: Alley Stoughton Date: Mon, 14 Oct 2019 11:30:58 -0400 Subject: [PATCH 492/525] This is no longer used. (Its contents (adapted) were moved into SmtMap.) --- proof/MapAux.ec | 143 ------------------------------------------------ 1 file changed, 143 deletions(-) delete mode 100644 proof/MapAux.ec diff --git a/proof/MapAux.ec b/proof/MapAux.ec deleted file mode 100644 index fefc337..0000000 --- a/proof/MapAux.ec +++ /dev/null @@ -1,143 +0,0 @@ -(*---------------------- Auxiliary Lemmas on Maps ----------------------*) -require import AllCore SmtMap FSet StdOrder. -import IntOrder. - -lemma get_none (m : ('a, 'b) fmap, x : 'a) : - x \notin m => m.[x] = None. -proof. by rewrite domE. qed. - -lemma get_some (m : ('a, 'b) fmap, x : 'a) : - x \in m => m.[x] = Some (oget m.[x]). -proof. move=> /domE; by case m.[x]. qed. - -lemma set_same (m : ('a, 'b) fmap, x : 'a) : - x \in m => m.[x <- oget m.[x]] = m. -proof. -move=> x_in_m. -apply fmap_eqP => y. -case (y = x) => [->> | ne_y_x]. -by rewrite get_set_sameE get_some. -by rewrite get_setE ne_y_x. -qed. - -lemma set_eq (m : ('a, 'b) fmap, x : 'a, y : 'b) : - m.[x] = Some y => m.[x <- y] = m. -proof. -move=> m_get_x_eq_y. -have x_in_m : x \in m by rewrite domE m_get_x_eq_y. -have -> : y = oget m.[x] by rewrite m_get_x_eq_y oget_some. -by rewrite set_same. -qed. - -lemma frng_set (m : ('a, 'b) fmap, x : 'a, y : 'b) : - frng m.[x <- y] = frng (rem m x) `|` fset1 y. -proof. -apply fsetP => z; rewrite in_fsetU in_fset1 2!mem_frng 2!rngE /=. -split => [[x'] | [[x'] | ->]]. -case (x' = x) => [-> | ne_x'_x]. -by rewrite get_set_sameE /= => ->. -rewrite get_setE ne_x'_x /= => get_x'_some_z. -left; exists x'; by rewrite remE ne_x'_x. -rewrite remE. -case (x' = x) => // ne_x'_x get_x'_some_z. -exists x'; by rewrite get_setE ne_x'_x. -exists x; by rewrite get_set_sameE. -qed. - -lemma eq_except_ne_in (x y : 'a, m1 m2 : ('a, 'b) fmap) : - eq_except (pred1 x) m1 m2 => y <> x => - y \in m1 => y \in m2. -proof. -move=> /eq_exceptP @/pred1 eq_exc ne_y_x. -by rewrite 2!domE eq_exc. -qed. - -lemma eq_except_setr_as_l (m1 m2 : ('a, 'b) fmap) x: - x \in m1 => eq_except (pred1 x) m1 m2 => - m1 = m2.[x <- oget m1.[x]]. -proof. -rewrite eq_exceptP -fmap_eqP=> x_in_m1 eqe x'. -rewrite get_setE /oget; case (x' = x)=> [->> |]. -by move: x_in_m1; rewrite domE; case (m1.[x]). -by move=> ne_x'_x; rewrite eqe. -qed. - -lemma eq_except_set_both x b b' (m : ('a, 'b) fmap): - eq_except (pred1 x) m.[x <- b] m.[x <- b']. -proof. by rewrite eq_exceptP=> x'; rewrite /pred1 !get_setE=> ->. qed. - -lemma eq_except_rem (m1 m2 : ('a,'b) fmap) (X : 'a -> bool) x: - X x => eq_except X m1 m2 => eq_except X m1 (rem m2 x). -proof. -move=> X_x /eq_exceptP eq_exc; rewrite eq_exceptP=> y X_y; rewrite remE. -case (y = x)=> [->> // | ne_y_x]; by apply eq_exc. -qed. - -lemma rem_id (m : ('a, 'b) fmap, x : 'a) : - x \notin m => rem m x = m. -proof. -move=> x_notin_m; apply fmap_eqP => y; rewrite remE. -case (y = x) => // ->. -case (None = m.[x]) => // get_not_none. -rewrite eq_sym -domE // in get_not_none. -qed. - -lemma map_empty (f : 'a -> 'b -> 'c, m : ('a, 'b) fmap) : - map f empty = empty. -proof. by rewrite -fmap_eqP=> x; rewrite mapE 2!emptyE. qed. - -lemma map_rem (f:'a -> 'b -> 'c) m (x:'a) : - map f (rem m x) = rem (map f m) x. -proof. -rewrite -fmap_eqP=> z; by rewrite !(mapE,remE); case (z = x). -qed. - -lemma map_id (m:('a,'b)fmap): map (fun _ b => b) m = m. -proof. by rewrite -fmap_eqP=>x; rewrite mapE; case (m.[x]). qed. - -lemma le_card_frng_fdom (m : ('a, 'b) fmap) : - card (frng m) <= card (fdom m). -proof. -move: m. -elim /fmapW=> [| m k v k_notin_m IH]. -by rewrite frng0 fdom0 2!fcards0. -rewrite mem_fdom in k_notin_m. -rewrite frng_set rem_id // fdom_set (fcardUI_indep _ (fset1 k)) - 1:fsetI1 1:mem_fdom 1:k_notin_m // fcard1 fcardU fcard1 - -addzA ler_add // -{2}(addz0 1) ler_add // oppz_le0 fcard_ge0. -qed. - -lemma fdom_frng_prop (X : 'a fset, m : ('a, 'a) fmap) : - fdom m \proper X => frng m \subset X => frng m \proper X. -proof. -rewrite /(\proper); move=> |>. -case (frng m = X)=> // ^ eq_frng_m_X -> fdom_m_sub_X fdom_m_ne_X _. -have card_fdom_m_lt_card_X : card (fdom m) < card X. - rewrite ltz_def; split. - case (card X = card (fdom m))=> // /eq_sym /subset_cardP. - by rewrite fdom_m_sub_X fdom_m_ne_X. - by rewrite subset_leq_fcard. -have card_X_le_card_fdom_m : card X <= card (fdom m) - by rewrite -eq_frng_m_X le_card_frng_fdom. -by rewrite /= -(ltzz (card X)) (ler_lt_trans (card (fdom m))). -qed. - -lemma fdom_frng_prop_type (m : ('a, 'a) fmap) : - (exists (x : 'a), ! x \in m) => - (exists (y : 'a), ! rng m y). -proof. -move=> [x x_notin_m]. -have : fdom m \proper fdom m `|` frng m `|` fset1 x. - rewrite /(\proper); split. - move=> z; rewrite 2!in_fsetU; move=> />. - case (fdom m = fdom m `|` frng m `|` fset1 x)=> // contra_eq. - rewrite -mem_fdom in x_notin_m. - have // : x \in fdom m by rewrite contra_eq 2!in_fsetU in_fset1. -pose univ := fdom m `|` frng m `|` fset1 x. -have fdom_prop_univ frng_sub_univ : frng m \subset univ - by move=> z @/univ; rewrite 2!in_fsetU; move=> />. -have : frng m \proper univ by apply fdom_frng_prop. -move=> /properP [_ [y [_ y_notin_frng_m]]]. -rewrite mem_frng in y_notin_frng_m. -by exists y. -qed. From db459cf493a62e5e443a1f2b554f6fd8b16b4f71 Mon Sep 17 00:00:00 2001 From: Pierre-Yves Strub Date: Mon, 9 Dec 2019 10:28:27 +0100 Subject: [PATCH 493/525] update submodule --- jasmin | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/jasmin b/jasmin index 29b97ec..0b895ab 160000 --- a/jasmin +++ b/jasmin @@ -1 +1 @@ -Subproject commit 29b97ec1bc4855651a7a5d4c13a4397a9f84f944 +Subproject commit 0b895ab8975da6d6257c9c092a02b286fdcbc5fe From 80e64ccc566c4e3308a6110a5990a646667e43cd Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Mon, 9 Dec 2019 11:09:27 +0100 Subject: [PATCH 494/525] fix proof with 1.0 --- proof/SHA3OSecurity.ec | 153 ++++++++++++------------ proof/SHA3Security.ec | 6 +- proof/impl/libc/keccak_1600_scalar.ec | 6 - proof/smart_counter/Gconcl.ec | 6 +- proof/smart_counter/Gconcl_list.ec | 16 +-- proof/smart_counter/Gext.eca | 9 +- proof/smart_counter/Handle.eca | 60 +++++----- proof/smart_counter/SLCommon.ec | 161 +------------------------- 8 files changed, 123 insertions(+), 294 deletions(-) diff --git a/proof/SHA3OSecurity.ec b/proof/SHA3OSecurity.ec index c3fee79..390797d 100644 --- a/proof/SHA3OSecurity.ec +++ b/proof/SHA3OSecurity.ec @@ -396,7 +396,7 @@ while(l{2} = bs{1} /\ size bs{1} = i{1} /\ 0 <= i{1} <= n{1} /\ ={i} /\ + sp; rcondt{1} 1; auto=> />. - smt(). move=> &l &r *. - rewrite get_setE/=oget_some/=size_rcons/=; do!split; 1,2: smt(size_ge0). + rewrite get_setE /= size_rcons /=; do!split; 1,2: smt(size_ge0). - smt(mem_set). - smt(get_setE). - smt(mem_set). @@ -645,9 +645,6 @@ rewrite eq_sym; byequiv=> //=; proc. call(RO_LRO_D Dist); inline*; auto=> />. qed. - - - local lemma rw_ideal_2 &m: Pr[SHA3_OIndiff.OIndif.OIndif(FSome(BIRO.IRO), OSimulator(FSome(BIRO.IRO)), ODRestr(Dist_of_P1Adv(A))).main() @ &m : res] <= @@ -776,10 +773,10 @@ inline{2} 1; sp. rcondt{2} 1; 1: by auto; smt(divz_ge0 gt0_r size_ge0). auto; call eq_IRO_RFWhile; auto=> />. move=> &l &r 14?; split; 2: smt(divz_ge0 gt0_r size_ge0). -rewrite 2!oget_some cats0 take_oversize 1:/# take_oversize 1:spec_dout //=. +rewrite cats0 take_oversize 1:/# take_oversize 1:spec_dout //=. have h:=spec2_dout result_L H5. have-> := some_oget _ h. -by rewrite eq_sym -to_listK; congr. +by rewrite /= eq_sym -to_listK. qed. local lemma rw_ideal &m: @@ -819,7 +816,7 @@ seq 1 1 : (={glob A, glob SHA3Indiff.Simulator, glob SORO.Bounder, glob Counter, rewrite -dout_equal_dlist=> ?; split=> ?. + by rewrite dmapE=> h{h}; apply mu_eq=> x; smt(to_list_inj). move=> sample. - rewrite !get_setE/=oget_some/=dout_full/= => h; split; 2: smt(). + rewrite !get_setE/=dout_full/= => h; split; 2: smt(). rewrite eq_sym to_listK; apply some_oget. apply spec2_dout. by move:h; rewrite supp_dmap; smt(spec_dout). @@ -834,7 +831,7 @@ seq 1 1 : (={glob A, glob SHA3Indiff.Simulator, glob SORO.Bounder, glob Counter, * by rewrite dmapE=> h{h}; apply mu_eq=> x; smt(to_list_inj). move=> sample. rewrite supp_dmap dout_full/= =>/> a. - by rewrite get_setE/=oget_some/= dout_full/=; congr; rewrite of_listK oget_some. + by rewrite get_setE/= dout_full/=; congr; rewrite of_listK oget_some. by auto; smt(dout_ll). sp; if; 1, 3: auto; sp; wp 1 2. if{1}. @@ -1115,7 +1112,7 @@ while(l{2} = bs{1} /\ size bs{1} = i{1} /\ 0 <= i{1} <= n{1} /\ ={i} /\ + sp; rcondt{1} 1; auto=> />. - smt(). move=> &l &r 13?. - rewrite get_setE/=oget_some/=size_rcons/=; do!split; 1,2: smt(size_ge0). + rewrite get_setE/=size_rcons/=; do!split; 1,2: smt(size_ge0). - smt(mem_set). - smt(get_setE). - smt(mem_set). @@ -1448,7 +1445,7 @@ if{1}. sp; rcondt{1} 1; auto. inline{1} 1; sp; auto. call(eq_IRO_RFWhile); auto=> /> 15?. - rewrite oget_some take_oversize 1:/# /=. + rewrite take_oversize 1:/# /=. have:=spec2_dout _ H5. move=>/(some_oget)-> /=; smt(divz_ge0 gt0_r size_ge0 spec2_dout). move=>/=. @@ -1610,7 +1607,7 @@ inline{2} 1; sp. rcondt{2} 1; 1: by auto; smt(divz_ge0 gt0_r size_ge0). auto; call eq_IRO_RFWhile; auto=> />. move=> &l &r 14?; split; 2: smt(divz_ge0 gt0_r size_ge0). -rewrite 2!oget_some cats0 take_oversize 1:/# take_oversize 1:spec_dout //=. +rewrite cats0 take_oversize 1:/# take_oversize 1:spec_dout //=. have h:=spec2_dout result_L H5. have-> := some_oget _ h. by rewrite eq_sym -to_listK; congr. @@ -1642,7 +1639,7 @@ seq 1 1 : (={glob A, glob SHA3Indiff.Simulator, glob SORO.Bounder, glob Counter, rewrite -dout_equal_dlist=> ?; split=> ?. + by rewrite dmapE=> h{h}; apply mu_eq=> x; smt(to_list_inj). move=> sample. - rewrite !get_setE/=oget_some/=dout_full/= => h; split; 2: smt(). + rewrite !get_setE/=dout_full/= => h; split; 2: smt(). rewrite eq_sym to_listK; apply some_oget. apply spec2_dout. by move:h; rewrite supp_dmap; smt(spec_dout). @@ -1657,7 +1654,7 @@ seq 1 1 : (={glob A, glob SHA3Indiff.Simulator, glob SORO.Bounder, glob Counter, * by rewrite dmapE=> h{h}; apply mu_eq=> x; smt(to_list_inj). move=> sample. rewrite supp_dmap dout_full/= =>/> a. - by rewrite get_setE/=oget_some/= dout_full/=; congr; rewrite of_listK oget_some. + by rewrite get_setE/= dout_full/=; congr; rewrite of_listK oget_some. by auto; smt(dout_ll). sp. seq 4 4 : (={SORO.Bounder.bounder, x0, m1, m2, hash1, y0} /\ y0{1} = None /\ @@ -1716,40 +1713,38 @@ rewrite (StdOrder.RealOrder.ler_trans _ _ _ (RO_is_second_preimage_resistant (SO by rewrite doutE1. qed. - - - local lemma rw_real &m mess : - Dist_of_P2Adv.m{m} = mess => - Pr[SecondPreimage(A, OSponge, PSome(Perm)).main(mess) @ &m : res] = - Pr[SHA3_OIndiff.OIndif.OIndif(FSome(Sponge(Poget(PSome(Perm)))), PSome(Perm), - ODRestr(Dist_of_P2Adv(A))).main() @ &m : res]. - proof. - move=> Heq. - byequiv=>//=; proc. - inline{1} 1; inline{2} 1; sp. - inline{1} 1; inline{2} 1; sp. - inline{1} 1; inline{2} 1; sp. - inline{1} 1; inline{2} 1; sp. - inline{1} 1; inline{2} 1; sp. - inline{1} 1; sp; wp=> />. - seq 1 1 : (={glob A, glob Perm} /\ m1{1} = Dist_of_P2Adv.m{2} /\ - m2{1} = m'{2} /\ Bounder.bounder{1} = Counter.c{2}). - + auto; call(: ={glob Perm} /\ Bounder.bounder{1} = Counter.c{2})=> //=. - - by proc; inline*; sp; if; auto; 2:sim=> />; 1: smt(). - - by proc; inline*; sp; if; auto; 2:sim=> />; 1: smt(). - - proc; inline*; sp; if; auto; sp=> />. - by conseq(:_==> ={z0, glob Perm})=> />; sim. - by auto; smt(). - conseq(:_==> m1{1} = Dist_of_P2Adv.m{2} /\ m2{1} = m'{2} /\ - hash1{1} = hash{2} /\ hash2{1} = hash'{2})=> //=; 1: smt(). - seq 1 1 : (m1{1} = Dist_of_P2Adv.m{2} /\ m2{1} = m'{2} /\ - hash1{1} = hash{2} /\ ={glob Perm} /\ Bounder.bounder{1} = Counter.c{2}); last first. - + inline*; sp; if; auto; sp=> /=; sim. - inline*; sp; if; auto; swap{1} 9; auto; sp=> /=. - by conseq(:_==> m1{1} = Dist_of_P2Adv.m{2} /\ m2{1} = m'{2} /\ - of_list (oget (Some (take n{1} z0{1}))) = - of_list (oget (Some (take n{2} z0{2}))) /\ ={Perm.mi, Perm.m})=> //=; sim. - qed. +local lemma rw_real &m mess : + Dist_of_P2Adv.m{m} = mess => + Pr[SecondPreimage(A, OSponge, PSome(Perm)).main(mess) @ &m : res] = + Pr[SHA3_OIndiff.OIndif.OIndif(FSome(Sponge(Poget(PSome(Perm)))), PSome(Perm), + ODRestr(Dist_of_P2Adv(A))).main() @ &m : res]. +proof. +move=> Heq. +byequiv=>//=; proc. +inline{1} 1; inline{2} 1; sp. +inline{1} 1; inline{2} 1; sp. +inline{1} 1; inline{2} 1; sp. +inline{1} 1; inline{2} 1; sp. +inline{1} 1; inline{2} 1; sp. +inline{1} 1; sp; wp=> />. +seq 1 1 : (={glob A, glob Perm} /\ m1{1} = Dist_of_P2Adv.m{2} /\ + m2{1} = m'{2} /\ Bounder.bounder{1} = Counter.c{2}). ++ auto; call(: ={glob Perm} /\ Bounder.bounder{1} = Counter.c{2})=> //=. + - by proc; inline*; sp; if; auto; 2:sim=> />; 1: smt(). + - by proc; inline*; sp; if; auto; 2:sim=> />; 1: smt(). + - proc; inline*; sp; if; auto; sp=> />. + by conseq(:_==> ={z0, glob Perm})=> />; sim. + by auto; smt(). +conseq(:_==> m1{1} = Dist_of_P2Adv.m{2} /\ m2{1} = m'{2} /\ + hash1{1} = hash{2} /\ hash2{1} = hash'{2})=> //=; 1: smt(). +seq 1 1 : (m1{1} = Dist_of_P2Adv.m{2} /\ m2{1} = m'{2} /\ + hash1{1} = hash{2} /\ ={glob Perm} /\ Bounder.bounder{1} = Counter.c{2}); last first. ++ inline*; sp; if; auto; sp=> /=; sim. +inline*; sp; if; auto; swap{1} 9; auto; sp=> /=. +by conseq(:_==> m1{1} = Dist_of_P2Adv.m{2} /\ m2{1} = m'{2} /\ + of_list (oget (Some (take n{1} z0{1}))) = + of_list (oget (Some (take n{2} z0{2}))) /\ ={Perm.mi, Perm.m})=> //=; sim. +qed. local module TOTO = { proc main (m : bool list) = { @@ -1994,7 +1989,7 @@ while(l{2} = bs{1} /\ size bs{1} = i{1} /\ 0 <= i{1} <= n{1} /\ ={i} /\ + sp; rcondt{1} 1; auto=> />. - smt(). move=> &l &r 13?. - rewrite get_setE/=oget_some/=size_rcons/=; do!split; 1,2: smt(size_ge0). + rewrite get_setE/=size_rcons/=; do!split; 1,2: smt(size_ge0). - smt(mem_set). - smt(get_setE). - smt(mem_set). @@ -2286,7 +2281,6 @@ rewrite eq_sym; byequiv=> //=; proc. by call(RO_LRO_D Dist); inline*; auto=> />. qed. - local equiv toto : DFSetSize(OFC(ExtendSample(FSome(BIRO.IRO)))).f ~ DFSetSize(OFC(ExtendSample(FSome(BIRO.IRO)))).f : @@ -2327,7 +2321,7 @@ if{1}. sp; rcondt{1} 1; auto. inline{1} 1; sp; auto. call(eq_IRO_RFWhile); auto=> /> 15?. - rewrite oget_some take_oversize 1:/# /=. + rewrite take_oversize 1:/# /=. have:=spec2_dout _ H5. move=>/(some_oget)-> /=; smt(divz_ge0 gt0_r size_ge0 spec2_dout). move=>/=. @@ -2483,7 +2477,7 @@ inline{2} 1; sp. rcondt{2} 1; 1: by auto; smt(divz_ge0 gt0_r size_ge0). auto; call eq_IRO_RFWhile; auto=> />. move=> &l &r 14?; split; 2: smt(divz_ge0 gt0_r size_ge0). -rewrite 2!oget_some cats0 take_oversize 1:/# take_oversize 1:spec_dout //=. +rewrite cats0 take_oversize 1:/# take_oversize 1:spec_dout //=. have h:=spec2_dout result_L H5. have-> := some_oget _ h. by rewrite eq_sym -to_listK; congr. @@ -2513,7 +2507,7 @@ seq 1 1 : (={glob A, glob SHA3Indiff.Simulator, glob SORO.Bounder, glob Counter, rewrite -dout_equal_dlist=> ?; split=> ?. + by rewrite dmapE=> h{h}; apply mu_eq=> x; smt(to_list_inj). move=> sample. - rewrite !get_setE/=oget_some/=dout_full/= => h; split; 2: smt(). + rewrite !get_setE/= dout_full/= => h; split; 2: smt(). rewrite eq_sym to_listK; apply some_oget. apply spec2_dout. by move:h; rewrite supp_dmap; smt(spec_dout). @@ -2528,7 +2522,7 @@ seq 1 1 : (={glob A, glob SHA3Indiff.Simulator, glob SORO.Bounder, glob Counter, * by rewrite dmapE=> h{h}; apply mu_eq=> x; smt(to_list_inj). move=> sample. rewrite supp_dmap dout_full/= =>/> a. - by rewrite get_setE/=oget_some/= dout_full/=; congr; rewrite of_listK oget_some. + by rewrite get_setE/= dout_full/=; congr; rewrite of_listK oget_some. by auto; smt(dout_ll). sp. seq 4 4 : (={SORO.Bounder.bounder, x0, m1, m2, hash1, y0} /\ y0{1} = None /\ @@ -2575,7 +2569,6 @@ if{1}. by auto=> />; smt(dout_ll). qed. - local lemma leq_ideal &m : Pr[SHA3_OIndiff.OIndif.OIndif(FSome(BIRO.IRO), OSimulator(FSome(BIRO.IRO)), ODRestr(Dist_of_CollAdv(A))).main() @ &m : res] <= @@ -2586,33 +2579,31 @@ rewrite (StdOrder.RealOrder.ler_trans _ _ _ (RO_is_collision_resistant (SORO_Col by rewrite doutE1. qed. - - - local lemma rw_real &m : - Pr[Collision(A, OSponge, PSome(Perm)).main() @ &m : res] = - Pr[SHA3_OIndiff.OIndif.OIndif(FSome(Sponge(Poget(PSome(Perm)))), PSome(Perm), - ODRestr(Dist_of_CollAdv(A))).main() @ &m : res]. - proof. - byequiv=>//=; proc. - inline{1} 1; inline{2} 1; sp. - inline{1} 1; inline{2} 1; sp. - inline{1} 1; inline{2} 1; sp. - inline{1} 1; inline{2} 1; sp. - inline{1} 1; inline{2} 1; sp. - inline{1} 1; sp; wp=> />. - seq 1 1 : (={glob A, glob Perm, m1, m2} /\ Bounder.bounder{1} = Counter.c{2}). - + auto; call(: ={glob Perm} /\ Bounder.bounder{1} = Counter.c{2})=> //=. - - by proc; inline*; sp; if; auto; 2:sim=> />; 1: smt(). - - by proc; inline*; sp; if; auto; 2:sim=> />; 1: smt(). - - proc; inline*; sp; if; auto; sp=> />. - by conseq(:_==> ={z0, glob Perm})=> />; sim. - conseq(:_==> ={hash1, hash2, m1, m2})=> //=; 1: smt(); sim. - seq 1 1 : (={m1, m2, hash1, glob Perm} /\ Bounder.bounder{1} = Counter.c{2}); last first. - + inline*; sp; if; auto; sp=> /=; sim. - inline*; sp; if; auto; swap{1} 9; auto; sp=> /=. - by conseq(:_==> ={m1, m2} /\ of_list (oget (Some (take n{1} z0{1}))) = - of_list (oget (Some (take n{2} z0{2}))) /\ ={Perm.mi, Perm.m})=> //=; sim. - qed. +local lemma rw_real &m : + Pr[Collision(A, OSponge, PSome(Perm)).main() @ &m : res] = + Pr[SHA3_OIndiff.OIndif.OIndif(FSome(Sponge(Poget(PSome(Perm)))), PSome(Perm), + ODRestr(Dist_of_CollAdv(A))).main() @ &m : res]. +proof. +byequiv=>//=; proc. +inline{1} 1; inline{2} 1; sp. +inline{1} 1; inline{2} 1; sp. +inline{1} 1; inline{2} 1; sp. +inline{1} 1; inline{2} 1; sp. +inline{1} 1; inline{2} 1; sp. +inline{1} 1; sp; wp=> />. +seq 1 1 : (={glob A, glob Perm, m1, m2} /\ Bounder.bounder{1} = Counter.c{2}). ++ auto; call(: ={glob Perm} /\ Bounder.bounder{1} = Counter.c{2})=> //=. + - by proc; inline*; sp; if; auto; 2:sim=> />; 1: smt(). + - by proc; inline*; sp; if; auto; 2:sim=> />; 1: smt(). + - proc; inline*; sp; if; auto; sp=> />. + by conseq(:_==> ={z0, glob Perm})=> />; sim. +conseq(:_==> ={hash1, hash2, m1, m2})=> //=; 1: smt(); sim. +seq 1 1 : (={m1, m2, hash1, glob Perm} /\ Bounder.bounder{1} = Counter.c{2}); last first. ++ inline*; sp; if; auto; sp=> /=; sim. +inline*; sp; if; auto; swap{1} 9; auto; sp=> /=. +by conseq(:_==> ={m1, m2} /\ of_list (oget (Some (take n{1} z0{1}))) = + of_list (oget (Some (take n{2} z0{2}))) /\ ={Perm.mi, Perm.m})=> //=; sim. +qed. lemma Sponge_collision_resistant &m : (forall (F <: OIndif.ODFUNCTIONALITY) (P <: OIndif.ODPRIMITIVE), diff --git a/proof/SHA3Security.ec b/proof/SHA3Security.ec index bbdb14b..4dab2e1 100644 --- a/proof/SHA3Security.ec +++ b/proof/SHA3Security.ec @@ -256,7 +256,7 @@ section Preimage. (forall j, 0 <= j < i{2} => (x0{2},j) \in BIRO.IRO.mp{2}) /\ take i{2} (to_list r{1}) = bs0{2} /\ take i{2} (to_list r{1}) = map (fun (j : int) => oget BIRO.IRO.mp{2}.[(x0{2}, j)]) (range 0 i{2})); progress=>//=. - + by rewrite get_set_sameE /= oget_some; smt(to_listK take_oversize spec_dout). + + by rewrite get_set_sameE /=; smt(to_listK take_oversize spec_dout). + move:H8; rewrite mem_set=>[][]//=h; 1:rewrite H3=>//=. - by have []h1 []h2 h3:= H2; have->//:=h1 _ h. by move:h => <<-; rewrite H6 //=. @@ -603,7 +603,7 @@ section SecondPreimage. (forall j, 0 <= j < i{2} => (x0{2},j) \in BIRO.IRO.mp{2}) /\ take i{2} (to_list r{1}) = bs0{2} /\ take i{2} (to_list r{1}) = map (fun (j : int) => oget BIRO.IRO.mp{2}.[(x0{2}, j)]) (range 0 i{2})); progress=>//=. - + by rewrite get_set_sameE /= oget_some; smt(to_listK take_oversize spec_dout). + + by rewrite get_set_sameE /=; smt(to_listK take_oversize spec_dout). + move:H8; rewrite mem_set=>[][]//=h; 1:rewrite H3=>//=. - by have []h1 []h2 h3:= H2; have->//:=h1 _ h. by move:h => <<-; rewrite H6 //=. @@ -995,7 +995,7 @@ section Collision. (forall j, 0 <= j < i{2} => (x0{2},j) \in BIRO.IRO.mp{2}) /\ take i{2} (to_list r{1}) = bs0{2} /\ take i{2} (to_list r{1}) = map (fun (j : int) => oget BIRO.IRO.mp{2}.[(x0{2}, j)]) (range 0 i{2})); progress=>//=. - + by rewrite get_set_sameE /= oget_some; smt(to_listK take_oversize spec_dout). + + by rewrite get_set_sameE /=; smt(to_listK take_oversize spec_dout). + move:H8; rewrite mem_set=>[][]//=h; 1:rewrite H3=>//=. - by have []h1 []h2 h3:= H2; have->//:=h1 _ h. by move:h => <<-; rewrite H6 //=. diff --git a/proof/impl/libc/keccak_1600_scalar.ec b/proof/impl/libc/keccak_1600_scalar.ec index 998c26a..d33a9c7 100644 --- a/proof/impl/libc/keccak_1600_scalar.ec +++ b/proof/impl/libc/keccak_1600_scalar.ec @@ -4,12 +4,6 @@ from Jasmin require import JModel. require import Array5 Array25. require import WArray40 WArray200. -(* NEEDS ADDING *) -op set0_64 : bool * bool * bool * bool * bool * W64.t. - -axiom set0_64E : set0_64.`6 = W64.zero. - - module M = { proc index (x:int, y:int) : int = { diff --git a/proof/smart_counter/Gconcl.ec b/proof/smart_counter/Gconcl.ec index a7167ff..b11f889 100644 --- a/proof/smart_counter/Gconcl.ec +++ b/proof/smart_counter/Gconcl.ec @@ -227,14 +227,14 @@ proof. 1,2,4,5:(by move=>?;conseq (_:true);auto);2:by sim. inline *;rcondt{1} 6;1:by auto=>/>. wp;rnd;auto;progress[-split];rewrite DCapacity.dunifin_ll /= => ?_?->. - by rewrite !get_setE /= oget_some. + by rewrite !get_setE. case (((x.`1, hx2) \in G1.mh /\ t){1}); [rcondt{1} 4;2:rcondt{2} 4| rcondf{1} 4;2:rcondf{2} 4]; 1,2,4,5:(by move=>?;conseq (_:true);auto);2:by sim. inline *;rcondt{1} 7;1:by auto=>/>. wp;rnd;auto;rnd{1};auto;progress[-split]. rewrite Block.DBlock.supp_dunifin DCapacity.dunifin_ll /==> ?_?->. - by rewrite !get_setE /= oget_some. + by rewrite !get_setE. + proc;sp;if=>//;sim. call (_: ={FRO.m,F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.chandle,G1.paths,C.c,C.queries});2:by auto. @@ -248,7 +248,7 @@ proof. 1,2,4,5:(by move=>?;conseq (_:true);auto);2:by sim. inline *;rcondt{1} 6;1:by auto=>/>. wp;rnd;auto;progress[-split];rewrite DCapacity.dunifin_ll /= => ?_?->. - by rewrite !get_setE /= oget_some. + by rewrite !get_setE. proc;sp;if=>//;auto;if;1:auto;sim. call (_: ={FRO.m,F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.chandle,G1.paths,C.c,C.queries});2:by auto. diff --git a/proof/smart_counter/Gconcl_list.ec b/proof/smart_counter/Gconcl_list.ec index 6496123..f286c68 100644 --- a/proof/smart_counter/Gconcl_list.ec +++ b/proof/smart_counter/Gconcl_list.ec @@ -237,7 +237,7 @@ section Ideal. - by rewrite!get_setE/=. - have//= /#:= prefix_le1 bl{2} SLCommon.C.queries{1} i_R H _. by rewrite domE H1. - - by rewrite!get_setE/=oget_some leq_add2//=. + - by rewrite!get_setE/= leq_add2//=. if{1}. * rcondt{1}1;1:auto. - move=> /> &hr i [#] h1 h2 h3 h4 h5 h6 h7 h8 h9 h10. @@ -283,7 +283,7 @@ section Ideal. sp;auto;progress. + by rewrite!get_setE/=. + smt(prefix_ge0). - + rewrite get_setE/=oget_some leq_add2//=. + + rewrite get_setE/= leq_add2//=. + by rewrite!get_setE/=. + smt(prefix_ge0). + exact leq_add_in. @@ -1309,12 +1309,12 @@ section Real. exists (oget Redo.prefixes{2}.[format bl{2} (i{2} + 1)]).`2; move: h. by case: (Redo.prefixes{2}.[format bl{2} (i{2} + 1)]); smt(). sp;if;auto;progress. - - move:H4 H5;rewrite!get_setE/=!oget_some nth_last/=take_size. + - move:H4 H5;rewrite!get_setE/= nth_last/=take_size. rewrite last_cat last_nseq 1:/# Block.WRing.addr0;progress. cut//=:=lemma2'(SLCommon.C.c{1} + 1)(C.c{2} + size bl{2} + i{2}) Perm.m{2}.[(sa0_R, sc0{2}) <- y2L] Perm.mi{2}.[y2L <- (sa0_R, sc0{2})] Redo.prefixes{2} bl{2} (i{2}+1) sa0_R sc0{2}. - rewrite H1/=!mem_set/=H4/=H2/=get_setE/=oget_some/=. + rewrite H1/=!mem_set/=H4/=H2/=get_setE/=. cut->->//=:y2L = (y2L.`1, y2L.`2);1,-1:smt(). rewrite INV_Real_addm_mi//=;2:smt(supp_dexcepted). by cut:=H3=>hinv0;split;case:hinv0=>//=/#. @@ -1559,11 +1559,11 @@ section Real. + smt(). + by rewrite get_setE/=. + by rewrite behead_drop drop_add. - + rewrite!get_setE/=oget_some. + + rewrite!get_setE/=. cut:=lemma_3 0 C.c{2}Perm.m{2}.[(sa{2} +^ nth witness p0{1} i0{1}, sc{2}) <- yL] Perm.mi{2}.[yL <- (sa{2} +^ nth witness p0{1} i0{1}, sc{2})] Redo.prefixes{1} (take i0{1} p0{1}) (nth witness p0{1} i0{1}) sa{2} sc{2}. - rewrite!mem_set/=-take_nth//=H5/=H1/=get_setE/=oget_some. + rewrite!mem_set/=-take_nth//=H5/=H1/=get_setE/=. cut->->//=:(yL.`1, yL.`2) = yL by smt(). rewrite INV_Real_addm_mi=>//=;smt(supp_dexcepted). + smt(size_drop size_eq0). @@ -1652,7 +1652,7 @@ section Real. + smt(). + move:H5 H6;rewrite nth_cat nth_nseq;1:smt(size_ge0). cut->/=:!size p{1} + i{2} - 1 < size p{1} by smt(). - rewrite Block.WRing.addr0 !get_setE/=oget_some take_oversize;1:rewrite size_cat size_nseq/#. + rewrite Block.WRing.addr0 !get_setE/= take_oversize;1:rewrite size_cat size_nseq/#. move=>H_dom_iS H_dom_p. cut:=lemma2' 0 C.c{2} Perm.m{2}.[(sa{2}, sc{2}) <- y0L] Perm.mi{2}.[y0L <- (sa{2}, sc{2})] Redo.prefixes{1} @@ -1660,7 +1660,7 @@ section Real. + by rewrite INV_Real_addm_mi//=;smt(supp_dexcepted). + smt(). + by rewrite mem_set. - by rewrite!get_setE/=oget_some/=H2/=;smt(). + by rewrite!get_setE/=H2/=;smt(). + by rewrite!get_setE/=take_oversize//=size_cat size_nseq/#. + rewrite nth_cat;cut->/=:! size p{1} + i{2} - 1 < size p{1} by smt(). by rewrite nth_nseq//=1:/# Block.WRing.addr0. diff --git a/proof/smart_counter/Gext.eca b/proof/smart_counter/Gext.eca index 2e204bc..a6ad8d9 100644 --- a/proof/smart_counter/Gext.eca +++ b/proof/smart_counter/Gext.eca @@ -626,7 +626,7 @@ section EXT. rcondt{2} 5;1:by auto;smt w=(size_ge0). rcondt{2} 10. by auto;progress;rewrite mem_set. wp;rnd{2};auto=> /= ??[#]!-> @/inv_lt @/inv_le [#] mlt milt clt cle Hin 3? -> /=. - rewrite/Distr.is_lossless (sampleto_ll 0)/= => ? _;rewrite /bad_ext !get_setE /= !oget_some /= set_set_eqE //=. + rewrite/Distr.is_lossless (sampleto_ll 0)/= => ? _;rewrite /bad_ext !get_setE /= set_set_eqE //=. rewrite !(imageU,inE) restr_set /= size_rem dom_restr Hin //=; smt w=size_set_le. by call RROset_inv_lt;auto;smt w=size_set_le. @@ -648,7 +648,7 @@ section EXT. rcondt{2} 5;1:by auto;smt w=(size_ge0). rcondt{2} 10. by auto;progress;rewrite mem_set. wp;rnd{2};auto=> /= ??[#]!-> @/inv_lt @/inv_le [#] mlt milt clt cle Hin 3?->/=. - rewrite/Distr.is_lossless (sampleto_ll 0) /= => ? _;rewrite /bad_ext !get_setE /= !oget_some /= set_set_eqE //=. + rewrite/Distr.is_lossless (sampleto_ll 0) /= => ? _;rewrite /bad_ext !get_setE /= set_set_eqE //=. rewrite !(imageU,inE) restr_set /= size_rem dom_restr Hin //=; smt w=size_set_le. by call RROset_inv_lt;auto;smt w=size_set_le. @@ -684,9 +684,8 @@ section EXT. + smt(). + smt(). + smt(). - + elim H7=>// [[x h] [#]];rewrite -memE mem_fdom dom_restr /in_dom_with domE=> _ ->/=. - by rewrite oget_some. - apply H10=>//. + + by elim H7=>// [[x h] [#]];rewrite -memE mem_fdom dom_restr /in_dom_with domE=> _ ->. + by apply H10. qed. axiom D_ll: diff --git a/proof/smart_counter/Handle.eca b/proof/smart_counter/Handle.eca index d847652..47c8007 100644 --- a/proof/smart_counter/Handle.eca +++ b/proof/smart_counter/Handle.eca @@ -653,8 +653,7 @@ lemma getflagP_some hs xc f: proof. move=> huniq_hs; split. + rewrite /getflag; case: (hinvP hs xc)=> [-> //|]. - rewrite rngE; case: (hinv hs xc)=> //= h [f']. - rewrite oget_some=> ^ hs_h -> @/snd /= ->>. + rewrite rngE; case: (hinv hs xc)=> //= h [f'] ^ hs_h -> @/snd /= ->>. by exists h. rewrite rngE=> -[h] hs_h. move: (hinvP hs xc)=> [_ /(_ h f) //|]. @@ -1288,7 +1287,6 @@ proof. rewrite /build_hpath;move=> Hbi1. elim: p (Some (b0,0)) => //= b p Hrec obi. rewrite {2 4}/step_hpath /=;case: obi => //= [ | bi'];1:by apply Hrec. - rewrite oget_some. rewrite get_setE. case ((bi'.`1 +^ b, bi'.`2) = bi1) => [-> | _];2:by apply Hrec. by rewrite Hbi1 build_hpath_None. qed. @@ -1417,8 +1415,7 @@ case @[ambient]: {-1}(Pmi.[(xa,xc)]) (eq_refl Pmi.[(xa,xc)])=> [Pmi_xaxc|[ya yc] by rewrite get_setE. auto=> ? ? [#] !<<- -> -> ->> _ /= ya -> /= yc -> /=. case: (hinvP (hs.[ch <- (xc,Known)]) yc)=> [_|-> //] yc_notrngE1_hs_addh _ _. - rewrite get_setE /= oget_some /=. - rewrite(@huniq_hinvK_h ch) 3:oget_some /=. + rewrite get_setE /= (@huniq_hinvK_h ch) 3:oget_some /=. + by apply/huniq_addh=> //; have /hs_of_INV [] := inv0. + by rewrite get_setE. apply/(@lemma1' hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes queries xa xc ya yc inv0 _ _ Pmi_xaxc Gmi_xaxc)=> //;first last. @@ -1453,7 +1450,7 @@ case @[ambient]: {-1}(Pmi.[(xa,xc)]) (eq_refl Pmi.[(xa,xc)])=> [Pmi_xaxc|[ya yc] auto => ? ? [#] !<<- -> -> ->> _. rewrite (@huniq_hinvK_h hx2) // oget_some /= => y1 -> /= y2 -> /=. case: (hinvP hs y2)=> [_ y2_notrngE1_hs _ _|/#]. - rewrite get_setE /= oget_some /=. + rewrite get_setE /=. apply/lemma2'=> //. + rewrite domE/=;cut[]h1 _:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. cut h1':=h1 y1 y2. @@ -1586,7 +1583,7 @@ call(: !G1.bcol{2} by move=> /(_ x1 G1.chandle{2} xa xh) h /h [] xc xf yc yf [#] /h_handles. case: (x2 <> y2{2} /\ (forall f h, hs0.[h] <> Some (y2{2},f))). + auto=> &1 &2 [#] !<<- -> -> !->> /= _ x2_neq_y2 y2_notin_hs. - rewrite get_setE /= oget_some /=. + rewrite get_setE /=. rewrite (@huniq_hinvK_h ch0 hs0.[ch0 <- (x2,Known)] x2); 2:by rewrite get_setE. + move=> @/huniq h1 h2 [c1 f1] [c2 f2]; rewrite !get_setE /=. case: (h1 = ch0); case: (h2 = ch0)=> //=. @@ -1648,7 +1645,7 @@ call(: !G1.bcol{2} auto=> &1 &2 [#] !<<- -> -> !->> _ /=. rewrite domE;cut[]_ -> _ _ _ /=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. case(hinv hs0 y2{2} = None)=>//=h; - rewrite get_setE /= oget_some /=;smt(lemma2 hinvP). + rewrite get_setE /=;smt(lemma2 hinvP). move=> [p0 v0] pi_x2; have:=pi_x2. have /pi_of_INV [] -> [hx2] [#] Hpath hs_hx2:= inv0. rcondt{2} 1. by move=> &m; auto=> &hr [#] !<<- _ _ ->> /= _; rewrite domE pi_x2. @@ -1714,14 +1711,13 @@ call(: !G1.bcol{2} rewrite Hhx Hhy=> /=;move: HG1. case: fy Hhy=> Hhy //= [p v [Hro Hbu]]. exists p v;split. - + rewrite oget_some /=. - rewrite get_set_neqE // -negP => ^ /rconssI <<- /rconsIs. + + rewrite get_set_neqE // -negP => ^ /rconssI <<- /rconsIs. move: Hbu;rewrite Hpath /= => -[!<<-] /=. by rewrite -negP=> /Block.WRing.addrI /#. by apply build_hpath_up=> //; move: hs_hx2 PFm_x1x2;apply: m_mh_None. + move=> p bn b; rewrite get_setE. case (rcons p bn = rcons p0 (v0 +^ x1)). - + rewrite oget_some/= => ^ /rconssI <<- /rconsIs ->> /=; split => [<<- | ]. + + rewrite /= => ^ /rconssI <<- /rconsIs ->> /=; split => [<<- | ]. + exists v0 hx2 ch0. rewrite (build_hpath_up Hpath) /=;1:by move: hs_hx2 PFm_x1x2;apply: m_mh_None. by rewrite xorwA xorwK Block.WRing.add0r get_set_sameE. @@ -1729,7 +1725,7 @@ call(: !G1.bcol{2} move=> Hdiff;have HG1 := m_mh_None _ _ _ _ _ _ _ Hmmh hs_hx2 PFm_x1x2. have -> /= [->> <<-]:= build_hpath_up_None _ _ (y1L, ch0) _ _ HG1 Hpath. by move:Hdiff;rewrite xorwA xorwK Block.WRing.add0r. - rewrite 2!oget_some /==> Hdiff; rewrite Hdiff/=. + rewrite /= => Hdiff. case Hmh => ? -> Huni. apply exists_iff=> v /= ;apply exists_iff => hx /=;apply exists_iff => hy /=. rewrite build_hpath_upd_ch_iff //. @@ -1776,7 +1772,7 @@ call(: !G1.bcol{2} case @[ambient]: {-1}(G1m.[(x1,x2)]) (eq_refl (G1m.[(x1,x2)])); last first. + move=> [ya yc] G1m_x1x2; rcondf{2} 1; 1:by auto=> &hr [#] !<<- _ _ ->>; rewrite domE G1m_x1x2. auto=> &1 &2 [#] <*> -> -> -> /=; have /incl_of_INV /(_ (x1,x2)) := inv0. - by rewrite PFm_x1x2 G1m_x1x2 /= => [#] !<<- {ya yc}. + by rewrite PFm_x1x2 G1m_x1x2. move=> x1x2_notin_G1m; rcondt{2} 1; 1:by auto=> &hr [#] !<<- _ _ ->>; rewrite domE x1x2_notin_G1m. have <*>: fy2 = Unknown. + have /mh_of_INV [] /(_ _ _ _ _ G1mh_x1hx2) + _ := inv0. @@ -2042,7 +2038,7 @@ proof. * rewrite/#. * rewrite/#. move=>[]b2 c2 h2[]H_PFm H_Gmh. - rewrite H_Gmh/=oget_some/=. + rewrite H_Gmh/=. cut[]b6 c6[]:=H_pref1 _ H12 i{2} _;1:smt(size_take). by rewrite!take_take !min_lel 1,2:/# nth_take 1,2:/# H2/==>[][]->>->><-;rewrite H_PFm oget_some. - rewrite/#. @@ -2067,7 +2063,7 @@ proof. * rewrite/#. * rewrite/#. move=>[]b2 c2 h2[]H_PFm H_Gmh. - by rewrite H_Gmh/=oget_some/=(@take_nth witness) 1:/# build_hpath_prefix/#. + by rewrite H_Gmh/= (@take_nth witness) 1:/# build_hpath_prefix/#. - rewrite/#. - rewrite/#. - cut[]HINV[]->>/=[]->>/=[]H_h[]H_path H_F_RO:=H6 H11. @@ -2080,7 +2076,7 @@ proof. move=>[]b2 c2 h2[]H_PFm H_Gmh. cut[]b6 c6[]:=H_pref1 _ H12 i{2} _;1:smt(size_take). rewrite!take_take !min_lel 1,2:/# nth_take 1,2:/# H2/==>[][]<<-<<-<-. - rewrite H_PFm/=oget_some/=(@take_nth witness)1:/#. + rewrite H_PFm/=(@take_nth witness)1:/#. by cut[]help1 help2/# :=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. alias{1} 1 prefixes = Redo.prefixes;sp. @@ -2193,7 +2189,7 @@ proof. by smt(domE take_oversize size_take take_take). * move=>l;rewrite mem_set. case(l = take (i{2} + 1) bs{1})=>//=[->>|]. - + by rewrite!get_setE/=oget_some/=/#. + + by rewrite!get_setE/= /#. move=>h H_dom;rewrite!get_setE h/=. cut[]H2mp01 H2mp02 H2mp1 H2mp2 H2mp3:=H_m_p0. rewrite-Hp1;1:smt(domE). @@ -2323,11 +2319,11 @@ proof. apply (notin_hs_notdomE2_mh FRO.m{2} PF.mi{1})=>//=. by apply ch_notdomE_hs;cut:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + cut[] H_huniq _ _:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. - rewrite!get_setE/=oget_some. + rewrite!get_setE/=. apply (m_mh_addh_addm _ H_m_mh H_huniq H_h _)=>//=. by apply ch_notdomE_hs;cut:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + cut[] H_huniq _ _:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. - rewrite!get_setE/=oget_some;apply (mi_mhi_addh_addmi _ H_mi_mhi _ H_h _)=>//=. + rewrite!get_setE/=;apply (mi_mhi_addh_addmi _ H_mi_mhi _ H_h _)=>//=. - smt(hinvP). by apply ch_notdomE_hs;cut:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + apply incl_upd_nin=>//=. @@ -2350,7 +2346,7 @@ proof. rewrite H_h/=. exists sc{1} f y2L Unknown=>//=. exists (take i{2} bs{1}) (sa{2})=>//=;rewrite get_setE Block.WRing.addKr/=. - rewrite oget_some/=(@take_nth witness)/=;1:smt(prefix_ge0). + rewrite/=(@take_nth witness)/=;1:smt(prefix_ge0). by apply build_hpath_up=>//=;smt(domE). move=> neq h1. cut[]hh1 hh2 hh3:=H_mh_spec. @@ -2367,7 +2363,7 @@ proof. by cut:=hb;rewrite H_path/==>[][->>->>]/=;rewrite-hbex Block.WRing.addKr/=. - progress. * move:H13;rewrite get_setE/=H_take_Si/=. - case(p0 = (take i{2} bs{1}))=>[->>|hpp0];rewrite!get_setE/=!oget_some/=. + case(p0 = (take i{2} bs{1}))=>[->>|hpp0];rewrite!get_setE/=. + cut->/=:=build_hpath_up _ _ _ y1L G1.chandle{2} _ _ _ H_path h_g1. case(bn = (nth witness bs{1} i{2}))=>[->> /= ->>|hbni]/=. - by exists sa{2} h{2} G1.chandle{2}=>//=;rewrite get_setE/=. @@ -2388,7 +2384,7 @@ proof. cut help:(sa{2} +^ nth witness bs{1} i{2}, h{2}) <> (v +^ bn, hx) by rewrite/#. exists v hx hy=>//=;rewrite get_setE;rewrite eq_sym in help;rewrite help/=H14/=. by apply build_hpath_up=>//=. - move:H13 H14;rewrite!get_setE/=!oget_some/==>h_build_hpath_set. + move:H13 H14;rewrite!get_setE/= =>h_build_hpath_set. case(hy = G1.chandle{2})=>//=[->>|hy_neq_ch]/=. + move=>h;cut h_eq:v +^ bn = sa{2} +^ nth witness bs{1} i{2} && hx = h{2}. + cut/#:G1.mh{2}.[(v +^ bn, hx)] <> Some (b0, G1.chandle{2}). @@ -2433,7 +2429,7 @@ proof. progress. + cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness bs{1} i{2}) y1L p0 v hx. cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness bs{1} i{2}) y1L p' v' hx. - move:H13 H14;rewrite!get_setE/=!oget_some/==>H13 H14;rewrite H13 H14. + move:H13 H14;rewrite!get_setE/= =>H13 H14;rewrite H13 H14. cut->/=:=ch_neq0 _ _ H_hs_spec. cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec H_h. rewrite h_g1/=. @@ -2460,7 +2456,7 @@ proof. by have[#]->>->>:=HH3 _ _ _ _ _ hp21 hp11. cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness bs{1} i{2}) y1L p0 v hx. cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness bs{1} i{2}) y1L p' v' hx. - move:H13 H14;rewrite!get_setE/=!oget_some/==>H13 H14;rewrite H13 H14/=. + move:H13 H14;rewrite!get_setE/= =>H13 H14;rewrite H13 H14/=. cut->/=:=ch_neq0 _ _ H_hs_spec. cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec H_h. rewrite h_g1/=. @@ -2485,8 +2481,8 @@ proof. by have[#]->><<-//=:=HH3 _ _ _ _ _ hp11 H_path. move=>hp21 hp11. by have[#]->>->>:=HH3 _ _ _ _ _ hp21 hp11. - + rewrite!get_setE/=oget_some;exact H2_pi_spec. - + rewrite!get_setE/=!oget_some/=. + + rewrite!get_setE/=;exact H2_pi_spec. + + rewrite!get_setE/=. cut H_m_p:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. cut H_all_prefixes:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. split;case:H_m_p=>//=Hmp01 Hmp02 Hmp1 Hmp2 Hmp3. @@ -2509,7 +2505,7 @@ proof. by exists sa{2} sc{1};rewrite H1/=;smt(get_setE domE). - move=>l;rewrite mem_set. case(l = take (i{2} + 1) bs{1})=>//=[->>|]. - + by rewrite!get_setE/=oget_some/=/#. + + by rewrite!get_setE/= /#. move=>h H_dom;rewrite!get_setE h/=. cut[]H2mp01 H2mp02 H2mp1 H2mp2 H2mp3:=H_m_p0. rewrite-Hp1;1:smt(domE). @@ -2528,12 +2524,12 @@ proof. have//[] sa sc [#] pref_sasc pm_pref:= hmp1 l l_in_pref i hisize. by exists sa sc; smt(get_setE domE take_take take_nth size_take prefix_ge0 nth_take take_oversize take_le0 mem_fdom fdom_set). - + rewrite!get_setE/=oget_some;smt(domE). + + rewrite!get_setE/=;smt(domE). + smt(get_setE domE take_take size_take prefix_ge0 nth_take take_oversize take_le0). - + rewrite!get_setE/=oget_some;smt(domE). + + rewrite!get_setE/=;smt(domE). + rewrite/#. - + by rewrite!get_setE/=oget_some/#. - + rewrite!get_setE/=oget_some(@take_nth witness);1:smt(prefix_ge0);rewrite build_hpath_prefix. + + by rewrite!get_setE/=/#. + + rewrite!get_setE/=(@take_nth witness);1:smt(prefix_ge0);rewrite build_hpath_prefix. cut[]HINV[]H_bad[]H_m_p0[]Hp1[]Hp2[]->>[]H_counter[][]f H_h[]H_path[]H_F_RO H_i:=H3 H6. cut:=lemma5' _ _ _ _ _ _ _ _ _ _ _ _ i{2} bs{1} sa{2} sc{1} h{2} HINV _ _ _. - smt(prefix_ge0). @@ -2543,7 +2539,7 @@ proof. cut->/=:=build_hpath_up_None _ _ (y1L, G1.chandle{2})_ _ H_Gmh H_path;smt(get_setE). + smt(prefix_ge0). + smt(prefix_ge0). - + by rewrite!get_setE/=oget_some. + + by rewrite!get_setE. rewrite!mem_set negb_or/=;split;2:smt(prefix_ge0 size_take prefix_ge0 take_oversize). cut[]HINV[]H_bad[]H_m_p0[]Hp1[]Hp2[]->>[]H_counter[][]f H_h[]H_path[]H_F_RO H_i:=H3 H6. cut:=Hp2 (take (i{2} + 1 + 1) bs{1}). diff --git a/proof/smart_counter/SLCommon.ec b/proof/smart_counter/SLCommon.ec index 5480815..2fa773b 100644 --- a/proof/smart_counter/SLCommon.ec +++ b/proof/smart_counter/SLCommon.ec @@ -156,7 +156,7 @@ case: {-1}(foldl _ _ _) (eq_refl (foldl (step_hpath mh) (Some (b0,0)) p))=> //=. + smt(size_rcons size_ge0). move=> ^/rconssI <<- {p'} /rconsIs ->> {b}. by rewrite /build_hpath=> ->. -move=> [v' h']; rewrite oget_some /= -/(build_hpath _ _)=> build. +move=> [v' h']; rewrite -/(build_hpath _ _)=> build. split. + by move=> mh__; apply/(Extend mh (rcons p b) v h p b v' h' _ build mh__). case=> [| p' b' v'' h'']. @@ -442,7 +442,7 @@ lemma prefix_max_prefix_eq_size (l1 l2 : 'a list) (ll : 'a list list) : proof. move:l1 l2;elim:ll=>//=;1:smt(prefix_eq). move=>l3 ll Hind l1 l2[->|[->|h1]]. -+ rewrite prefix_eq max_prefix_eq;smt(max_prefix_eq prefix_eq prefix_sizer). ++ by rewrite prefix_eq max_prefix_eq ltzNge prefix_sizel /= prefix_eq. + rewrite prefix_eq max_prefix_eq. case(prefix l3 l2 < size l3)=>//=h;1:by rewrite prefix_eq. cut h1:prefix l3 l2 = size l3 by smt(prefix_sizel). @@ -799,156 +799,6 @@ case(a=x)=>//=hax. by rewrite Hinv/#. qed. -(** ???? -op blocksponge (l : block list) (m : (state, state) fmap) (bc : state) = - with l = "[]" => (l,bc) - with l = (::) b' l' => - let (b,c) = (bc.`1,bc.`2) in - if ((b +^ b', c) \in m) then blocksponge l' m (oget m.[(b +^ b', c)]) - else (l,(b,c)). - -op s0 : state = (b0,c0). - -lemma blocksponge_size_leq l m bc : - size (blocksponge l m bc).`1 <= size l. -proof. -move:m bc;elim l=>//=. -move=>e l Hind m bc/#. -qed. - - -lemma blocksponge_set l m bc x y : - (x \in m => y = oget m.[x]) => - let bs1 = blocksponge l m bc in - let bs2 = blocksponge l m.[x <- y] bc in - let l1 = bs1.`1 in let l2 = bs2.`1 in let bc1 = bs1.`2 in let bc2 = bs2.`2 in - size l2 <= size l1 /\ (size l1 = size l2 => (l1 = l2 /\ bc1 = bc2)). -proof. -move=>Hxy/=;split. -+ move:m bc x y Hxy;elim l=>//=. - move=>/=e l Hind m bc x y Hxy/=;rewrite dom_set in_fsetU1. - case((bc.`1 +^ e, bc.`2) = x)=>//=[->//=|hx]. - + rewrite getP/=oget_some;case(x\in dom m)=>//=[/#|]. - smt(blocksponge_size_leq getP). - rewrite getP hx/=. - case((bc.`1 +^ e, bc.`2) \in dom m)=>//=Hdom. - by cut//:=Hind m (oget m.[(bc.`1 +^ e, bc.`2)]) x y Hxy. -move:m bc x y Hxy;elim l=>//=. -move=>e l Hind m bx x y Hxy. -rewrite!dom_set !in_fsetU1 !getP. -case((bx.`1 +^ e, bx.`2) \in dom m)=>//=Hdom. -+ case(((bx.`1 +^ e, bx.`2) = x))=>//=Hx. - + move:Hdom;rewrite Hx=>Hdom. - cut:=Hxy;rewrite Hdom/==>Hxy2. - rewrite oget_some -Hxy2/=. - by cut:=Hind m y x y Hxy. - by cut:=Hind m (oget m.[(bx.`1 +^ e, bx.`2)]) x y Hxy. -case(((bx.`1 +^ e, bx.`2) = x))=>//=;smt(blocksponge_size_leq). -qed. - - -lemma blocksponge_cat m l1 l2 bc : - blocksponge (l1 ++ l2) m bc = - let lbc = blocksponge l1 m bc in - blocksponge (lbc.`1 ++ l2) m (lbc.`2). -proof. -rewrite/=. -move:m bc l2;elim l1=>//= e1 l1 Hind m bc b. -case((bc.`1 +^ e1, bc.`2) \in dom m)=>//=[|->//=]Hdom. -by cut//:=Hind m (oget m.[(bc.`1 +^ e1, bc.`2)]) b. -qed. - - -lemma blocksponge_rcons m l bc b : - blocksponge (rcons l b) m bc = - let lbc = blocksponge l m bc in - blocksponge (rcons lbc.`1 b) m (lbc.`2). -proof. -by rewrite/=-2!cats1 blocksponge_cat/=. -qed. - - -(* lemma prefix_inv_bs_fst_nil queries prefixes m : *) -(* prefix_inv queries prefixes m => *) -(* forall l, l \in dom queries => *) -(* forall i, 0 <= i <= size l => *) -(* (blocksponge (take i l) m s0).`1 = []. *) -(* proof. *) -(* move=>[h2 [h3 Hinv]] l Hdom i [Hi0 Hisize];move:i Hi0 l Hisize Hdom;apply intind=>//=. *) -(* + by move=>l;rewrite take0/=. *) -(* move=>i Hi0 Hind l Hil Hldom. *) -(* rewrite(take_nth b0)1:/#. *) -(* rewrite blocksponge_rcons/=. *) -(* cut->/=:=Hind l _ Hldom;1:rewrite/#. *) -(* by cut/=->/=/#:=Hinv _ Hldom i. *) -(* qed. *) - - -(* lemma blocksponge_drop l m bc : *) -(* exists i, 0 <= i <= List.size l /\ (blocksponge l m bc).`1 = drop i l. *) -(* proof. *) -(* move:l bc=>l;elim:l=>//=;1:exists 0=>//=;progress. *) -(* case((bc.`1 +^ x, bc.`2) \in dom m)=>//=h. *) -(* + cut[i [[hi0 His] Hi]]:=H (oget m.[(bc.`1 +^ x, bc.`2)]). *) -(* exists(i+1)=>/#. *) -(* cut[i [[hi0 His] Hi]]:=H (oget m.[(bc.`1 +^ x, bc.`2)]). *) -(* exists 0=>/#. *) -(* qed. *) - - -(* lemma prefix_inv_set queries prefixes m x y : *) -(* !x \in dom m => *) -(* prefix_inv queries prefixes m => *) -(* prefix_inv queries prefixes m.[x <- y]. *) -(* proof. *) -(* move=>Hxdom Hpref;progress=>//=. *) -(* + rewrite/#. *) -(* + rewrite/#. *) -(* cut->:blocksponge (take i bs) m.[x <- y] s0 = blocksponge (take i bs) m s0. *) -(* + move:i H2 bs H3 H1;apply intind=>//=i;first smt(take0). *) -(* move=>Hi0 Hind bs Hisize Hbsdom. *) -(* rewrite (take_nth b0)1:/#. *) -(* rewrite 2!blocksponge_rcons/=. *) -(* cut[?[? Hpre]]:=Hpref. *) -(* cut->/=:=prefix_inv_bs_fst_nil _ _ _ Hpref _ Hbsdom i _;1:rewrite/#. *) -(* cut/=->/=:=Hpre _ Hbsdom i _;1:rewrite/#. *) -(* cut->/=:=Hind bs _ Hbsdom;1:rewrite/#. *) -(* cut->/=:=prefix_inv_bs_fst_nil _ _ _ Hpref _ Hbsdom i _;1:rewrite/#. *) -(* rewrite dom_set in_fsetU1. *) -(* cut/=->/=:=Hpre _ Hbsdom i _;1:rewrite/#. *) -(* rewrite getP. *) -(* cut/#:=Hpre _ Hbsdom i _;1:rewrite/#. *) -(* rewrite dom_set in_fsetU1. *) -(* cut[?[? Hpre]]:=Hpref. *) -(* cut/#:=Hpre _ H1 i _;1:rewrite/#. *) -(* qed. *) - - -(* lemma blocksponge_set_nil l m bc x y : *) -(* !x \in dom m => *) -(* let bs1 = blocksponge l m bc in *) -(* let bs2 = blocksponge l m.[x <- y] bc in *) -(* bs1.`1 = [] => *) -(* bs2 = ([], bs1.`2). *) -(* proof. *) -(* rewrite/==>hdom bs1. *) -(* cut/=:=blocksponge_set l m bc x y. *) -(* smt(size_ge0 size_eq0). *) -(* qed. *) - -(* lemma size_blocksponge queries m l : *) -(* prefix_inv queries m => *) -(* size (blocksponge l m s0).`1 <= size l - prefix l (get_max_prefix l (elems (fdom queries))). *) -(* proof. *) -(* move=>Hinv. *) -(* pose l2:=get_max_prefix _ _;pose p:=prefix _ _. search take drop. *) -(* rewrite-{1}(cat_take_drop p l)blocksponge_cat/=. *) -(* rewrite(prefix_take). *) -(* qed. *) - -**) - - end Prefix. export Prefix. @@ -1217,7 +1067,7 @@ lemma hinvP handles c: proof. cut @/pred1@/(\o)/=[[h []->[]Hmem <<-]|[]->H h f]/= := findP (fun (_ : handle) => pred1 c \o fst) handles. - + exists (oget handles.[h]).`2;rewrite oget_some. + + exists (oget handles.[h]).`2. by move: Hmem; rewrite domE; case: (handles.[h])=> //= - []. by cut := H h;rewrite domE /#. qed. @@ -1240,7 +1090,7 @@ lemma hinvKP handles c: proof. rewrite /hinvK. cut @/pred1/= [[h]|][->/=]:= findP (+ pred1 c) (restr Known handles). - + by rewrite oget_some domE restrP;case (handles.[h])=>//= /#. + + by rewrite domE restrP;case (handles.[h])=>//= /#. by move=>+h-/(_ h);rewrite domE restrP => H1/#. qed. @@ -1254,8 +1104,7 @@ qed. lemma huniq_hinvK_h h (handles:handles) c: huniq handles => handles.[h] = Some (c,Known) => hinvK handles c = Some h. proof. - move=> Huniq;case: (hinvK _ _) (hinvKP handles c)=>/= [H|h'];1: by apply H. - by rewrite oget_some=> /Huniq H/H. + by move=> Huniq;case: (hinvK _ _) (hinvKP handles c)=>/= [ H | h' /Huniq H/H //]; apply H. qed. (* -------------------------------------------------------------------------- *) From ef0948db83542c84b0d1a1778849cc416ae01d7f Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Mon, 9 Dec 2019 11:10:54 +0100 Subject: [PATCH 495/525] ignore eco --- .gitignore | 2 ++ 1 file changed, 2 insertions(+) diff --git a/.gitignore b/.gitignore index 1abb86d..dd16ebe 100644 --- a/.gitignore +++ b/.gitignore @@ -9,6 +9,8 @@ _build/ *.out *.toc +## easycrypt .eco +*.eco ## Intermediate documents: *.dvi *-converted-to.* From 9373f1221d69385e92d412350aa1c1499aa6cf59 Mon Sep 17 00:00:00 2001 From: Benjamin Gregoire Date: Mon, 16 Dec 2019 21:05:11 +0100 Subject: [PATCH 496/525] fixing proofs to 1.0 --- proof/SHA3OSecurity.ec | 2 +- proof/SHA3Security.ec | 18 +++++++++--------- proof/smart_counter/Gconcl.ec | 10 +++------- proof/smart_counter/Gconcl_list.ec | 10 ++-------- proof/smart_counter/Gext.eca | 20 +++++++++----------- proof/smart_counter/Handle.eca | 24 ++++++++++++------------ 6 files changed, 36 insertions(+), 48 deletions(-) diff --git a/proof/SHA3OSecurity.ec b/proof/SHA3OSecurity.ec index 390797d..cd91595 100644 --- a/proof/SHA3OSecurity.ec +++ b/proof/SHA3OSecurity.ec @@ -706,7 +706,7 @@ have->:Pr[SHA3_OIndiff.OIndif.OIndif(ExtendSample(FSome(BIRO.IRO)), if; 1: auto; 1: smt(); last first. - by conseq=> />; sim; smt(). wp=> />; 1: smt(). - rnd; auto=> />; 1: smt(). + rnd; auto=> />. call(eq_extend); last by auto; smt(). + by proc; sp; if; auto; inline{1} 1; inline{2} 1; sp; if; auto. proc; sp; inline{1} 1; inline{2} 1; sp; if; auto. diff --git a/proof/SHA3Security.ec b/proof/SHA3Security.ec index 4dab2e1..6827ccd 100644 --- a/proof/SHA3Security.ec +++ b/proof/SHA3Security.ec @@ -364,17 +364,17 @@ section Preimage. - smt(). - by rewrite size_cat/=. - by rewrite mem_set; left; rewrite H3. - - rewrite get_setE (H4 _ _ H12). + - rewrite get_setE (H4 _ _ H11). cut/#: !(l1, j) = (x0{2}, size bs0{2}). move:H2; apply absurd=> //=[#] <<- ->>. have[] h1 [] h2 h3 := H1. by apply h2; smt(). - - move:H12; rewrite mem_set. + - move:H11; rewrite mem_set. case((l1, j) \in BIRO.IRO.mp{2})=>//= h; 1: smt(). by move=> [#] <<- ->> //=; rewrite size_ge0; smt(). - rewrite mem_set. case(j = size bs0{2})=>//=. - move=> h; rewrite h /=; have {H13} H13 {h} : j < size bs0{2} by smt(). + move=> h; rewrite h /=; have {H12} H13 {h} : j < size bs0{2} by smt(). by apply H6. - by rewrite cats1 get_set_sameE oget_some. - rewrite get_set_sameE oget_some H7 rangeSr. @@ -711,17 +711,17 @@ section SecondPreimage. - smt(). - by rewrite size_cat/=. - by rewrite mem_set; left; rewrite H3. - - rewrite get_setE (H4 _ _ H12). + - rewrite get_setE (H4 _ _ H11). cut/#: !(l1, j) = (x0{2}, size bs0{2}). move:H2; apply absurd=> //=[#] <<- ->>. have[] h1 [] h2 h3 := H1. by apply h2; smt(). - - move:H12; rewrite mem_set. + - move:H11; rewrite mem_set. case((l1, j) \in BIRO.IRO.mp{2})=>//= h; 1: smt(). by move=> [#] <<- ->> //=; rewrite size_ge0; smt(). - rewrite mem_set. case(j = size bs0{2})=>//=. - move=> h; rewrite h /=; have {H13} H13 {h} : j < size bs0{2} by smt(). + move=> h; rewrite h /=; have {H12} H12 {h} : j < size bs0{2} by smt(). by apply H6. - by rewrite cats1 get_set_sameE oget_some. - rewrite get_set_sameE oget_some H7 rangeSr. @@ -1103,17 +1103,17 @@ section Collision. - smt(). - by rewrite size_cat/=. - by rewrite mem_set; left; rewrite H3. - - rewrite get_setE (H4 _ _ H12). + - rewrite get_setE (H4 _ _ H11). cut/#: !(l1, j) = (x0{2}, size bs0{2}). move:H2; apply absurd=> //=[#] <<- ->>. have[] h1 [] h2 h3 := H1. by apply h2; smt(). - - move:H12; rewrite mem_set. + - move:H11; rewrite mem_set. case((l1, j) \in BIRO.IRO.mp{2})=>//= h; 1: smt(). by move=> [#] <<- ->> //=; rewrite size_ge0; smt(). - rewrite mem_set. case(j = size bs0{2})=>//=. - move=> h; rewrite h /=; have {H13} H13 {h} : j < size bs0{2} by smt(). + move=> h; rewrite h /=; have {H12} H12 {h} : j < size bs0{2} by smt(). by apply H6. - by rewrite cats1 get_set_sameE oget_some. - rewrite get_set_sameE oget_some H7 rangeSr. diff --git a/proof/smart_counter/Gconcl.ec b/proof/smart_counter/Gconcl.ec index b11f889..7e9fb9b 100644 --- a/proof/smart_counter/Gconcl.ec +++ b/proof/smart_counter/Gconcl.ec @@ -226,15 +226,12 @@ proof. [rcondt{1} 3;2:rcondt{2} 3| rcondf{1} 3;2:rcondf{2} 3]; 1,2,4,5:(by move=>?;conseq (_:true);auto);2:by sim. inline *;rcondt{1} 6;1:by auto=>/>. - wp;rnd;auto;progress[-split];rewrite DCapacity.dunifin_ll /= => ?_?->. - by rewrite !get_setE. + by auto => /> *; rewrite !get_setE. case (((x.`1, hx2) \in G1.mh /\ t){1}); [rcondt{1} 4;2:rcondt{2} 4| rcondf{1} 4;2:rcondf{2} 4]; 1,2,4,5:(by move=>?;conseq (_:true);auto);2:by sim. inline *;rcondt{1} 7;1:by auto=>/>. - wp;rnd;auto;rnd{1};auto;progress[-split]. - rewrite Block.DBlock.supp_dunifin DCapacity.dunifin_ll /==> ?_?->. - by rewrite !get_setE. + by wp;rnd;auto;rnd{1};auto => /> *; rewrite !get_setE. + proc;sp;if=>//;sim. call (_: ={FRO.m,F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.chandle,G1.paths,C.c,C.queries});2:by auto. @@ -247,8 +244,7 @@ proof. [rcondt{1} 3;2:rcondt{2} 3| rcondf{1} 3;2:rcondf{2} 3]; 1,2,4,5:(by move=>?;conseq (_:true);auto);2:by sim. inline *;rcondt{1} 6;1:by auto=>/>. - wp;rnd;auto;progress[-split];rewrite DCapacity.dunifin_ll /= => ?_?->. - by rewrite !get_setE. + by auto => /> *; rewrite !get_setE. proc;sp;if=>//;auto;if;1:auto;sim. call (_: ={FRO.m,F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.chandle,G1.paths,C.c,C.queries});2:by auto. diff --git a/proof/smart_counter/Gconcl_list.ec b/proof/smart_counter/Gconcl_list.ec index f286c68..63ae1aa 100644 --- a/proof/smart_counter/Gconcl_list.ec +++ b/proof/smart_counter/Gconcl_list.ec @@ -251,7 +251,6 @@ section Ideal. by rewrite domE H1. - smt(leq_add_in domE). rcondf{2}2;auto;progress. - - smt(DBlock.dunifin_ll). - smt(size_cat size_nseq size_eq0 size_ge0). - smt(). - smt(). @@ -274,7 +273,6 @@ section Ideal. * smt(prefix_ge0). * smt(leq_add_in domE). auto;progress. - - exact DBlock.dunifin_ll. - smt(domE). - smt(domE). - smt(size_ge0). @@ -750,7 +748,7 @@ section Ideal. smt(parse_valid parse_gt0 parseK mem_set formatK). wp 8 5;rnd{1};wp 6 5. conseq(:_==> ={F.RO.m} /\ p{2} = x0{2});progress. - + smt(DBlock.dunifin_ll). smt(last_rcons formatK parseK). + + smt(last_rcons formatK parseK). seq 3 3 : (={F.RO.m,i,x0} /\ x0{1} = p{2}); last by conseq(:_==> ={F.RO.m});progress;sim. auto;conseq(:_==> ={F.RO.m,i,n} /\ p{1} = p0{2} /\ i{1} + 1 = n{2});1:smt(formatK). @@ -772,8 +770,7 @@ section Ideal. smt(parse_valid parse_gt0 parseK mem_set formatK). wp 8 5;rnd{1};wp 6 5. conseq(:_==> ={F2.RO.m} /\ format pp{2} n{2} = x3{2}). - + move=> /> &1 &2 H H0 /= /> [#] H1 H2 m lres. - rewrite DBlock.dunifin_ll /= => ?; rewrite DBlock.supp_dunifin /=. + + move=> /> &1 &2 H H0 /= /> [#] H1 H2 m lres /= ?. smt(last_rcons formatK parseK). seq 3 3 : (={F2.RO.m,i} /\ x2{1} = x3{2} /\ pp{2} = p{1} /\ format pp{2} n{2} = x3{2}); last by conseq(:_==> ={F2.RO.m});progress;sim. @@ -867,7 +864,6 @@ section Ideal. - exact lemma5. rcondf{1}2;auto;progress. - cut[]h1 _ _ _:=H1;cut[]h'1 _:=h1;smt(parseK). - - smt(DBlock.dunifin_ll). - cut[]h1:=H1;cut[]:=h1;smt(parseK). smt(). by if{1};auto;smt(parseK parse_gt0 formatK). @@ -889,7 +885,6 @@ section Ideal. - cut[]_ h1 _ _:=H2;cut[]:=h1;progress. cut:=H7 x0{m} i0{m} (format x0{m} (i0{m} + 1));rewrite H5/==>->//=. cut->/#:=parse_twice _ _ _ H. - - smt(DBlock.dunifin_ll). - cut[]_ h1 _ _:=H2;cut[]h'1 _:=h1;smt(parseK parse_twice). - smt(). by rcondf{1}1;auto;smt(parseK formatK). @@ -909,7 +904,6 @@ section Ideal. - exact lemma5. rcondf{1}2;auto;progress. - cut[]h1 _ _ _:=H1;cut[]h'1 _:=h1;smt(parseK). - - smt(DBlock.dunifin_ll). - cut[]h1:=H1;cut[]:=h1;smt(parseK). smt(). qed. diff --git a/proof/smart_counter/Gext.eca b/proof/smart_counter/Gext.eca index a6ad8d9..3c35494 100644 --- a/proof/smart_counter/Gext.eca +++ b/proof/smart_counter/Gext.eca @@ -209,7 +209,6 @@ section. + by move=> &m;auto;rewrite /in_dom_with. (* auto=> |>. (* Bug ???? *) *) auto;progress. - + by apply sampleto_ll. + rewrite /inv_ext1=>/H{H}[->//|[|[[x1 x2] h [Hx Hh]]]]. + rewrite rngE/==>[][]h Hh. case (h = (oget G1.mh{2}.[(x0{2}.`1, hx2{2})]).`2)=> [->>|Hneq]. @@ -220,7 +219,7 @@ section. by move=>[|]/(mem_image snd)->. right;exists (x1,x2) h; move:Hx. by rewrite !fdom_set !in_fsetU !in_fset1 //= => [][] -> //=; rewrite get_set_neqE. - by move:H6 H2;rewrite /in_dom_with mem_set /#. + by move:H5 H2;rewrite /in_dom_with mem_set /#. inline *;auto;progress;last by move:H3;rewrite mem_set /#. rewrite /inv_ext1=> /H [->//|[|[x' h [Hx Hh]]]]. + rewrite rngE=> [][] h Hh. @@ -242,7 +241,7 @@ section. x{1} \notin G1.mi{1}). + inline *;auto=> &ml&mr[#]-><-_ _9!-> Hi Hhand _ -> /=. rewrite -dom_restr rng_restr /=;progress; 3:by smt ml=0. - + rewrite rngE/=; case: H4 =>//= H4. + + rewrite rngE/=; case: H2 =>//= H4. + move:Hi; rewrite/inv_ext1 H4 /= => [][->|] //= [] x h. move=> [#] H5 Hh; right; right. exists x h; rewrite H5 get_set_neqE//=. @@ -250,12 +249,11 @@ section. move: H4; rewrite rngE /= => [][] h Hh; right; left. exists h; rewrite get_set_neqE //=. by move:(Hhand h);rewrite domE Hh /#. - by move:H4;rewrite mem_set /#. + by move:H2;rewrite mem_set /#. if=>//. + inline *;rcondt{2} 4. + by move=> &m;auto;rewrite /in_dom_with. auto;progress. - + by apply sampleto_ll. + rewrite /inv_ext1=>/H{H}[->//|[|[[x1 x2] h [Hx Hh]]]]. + rewrite rngE => [][h]Hh. case (h = (oget G1.mhi{2}.[(x0{2}.`1, hx2{2})]).`2)=> [->>|Hneq]. @@ -268,7 +266,7 @@ section. right;exists (x1,x2) h;rewrite !in_fsetU !mem_fdom !mem_set /=. rewrite get_set_neqE //= Hh /=. by move: Hx; rewrite in_fsetU !mem_fdom=>[][] ->. - by move:H6 H2;rewrite /in_dom_with mem_set /#. + by move:H5 H1;rewrite /in_dom_with mem_set /#. inline *;auto;progress;last by move:H3;rewrite mem_set /#. rewrite /inv_ext1=> /H [->//|[|[x' h [Hx Hh]]]]. + rewrite rngE => [][h]Hh. @@ -593,7 +591,7 @@ section EXT. G1.bext{2})). + rcondt{2} 3. + move=> &m;auto=> &m'[#] 6!-> /= + _ _;case (l{m'})=>//=; smt w=List.size_ge0. - auto=> &ml&mr[#]6!->;case(l{mr})=>[//|h1 l1/=Hle Hext c->/=];split. + auto=> &ml&mr[#]6!->;case(l{mr})=>[//|h1 l1/=Hle Hext c ?/=];split. + smt w=(drop0 size_ge0). rewrite drop0=>-[H|[x h][#]];1:by rewrite Hext // H. rewrite get_setE;case (h=h1)=> [/=->Hin->_ | Hneq ???]. @@ -625,8 +623,8 @@ section EXT. + inline *;rcondt{1} 4;1:by auto=>/#. rcondt{2} 5;1:by auto;smt w=(size_ge0). rcondt{2} 10. by auto;progress;rewrite mem_set. - wp;rnd{2};auto=> /= ??[#]!-> @/inv_lt @/inv_le [#] mlt milt clt cle Hin 3? -> /=. - rewrite/Distr.is_lossless (sampleto_ll 0)/= => ? _;rewrite /bad_ext !get_setE /= set_set_eqE //=. + wp;rnd{2};auto=> /= ??[#]!-> @/inv_lt @/inv_le [#] mlt milt clt cle Hin 4? /=. + move => ? _;rewrite /bad_ext !get_setE /= set_set_eqE //=. rewrite !(imageU,inE) restr_set /= size_rem dom_restr Hin //=; smt w=size_set_le. by call RROset_inv_lt;auto;smt w=size_set_le. @@ -647,8 +645,8 @@ section EXT. + inline *;rcondt{1} 4;1:by auto=>/#. rcondt{2} 5;1:by auto;smt w=(size_ge0). rcondt{2} 10. by auto;progress;rewrite mem_set. - wp;rnd{2};auto=> /= ??[#]!-> @/inv_lt @/inv_le [#] mlt milt clt cle Hin 3?->/=. - rewrite/Distr.is_lossless (sampleto_ll 0) /= => ? _;rewrite /bad_ext !get_setE /= set_set_eqE //=. + wp;rnd{2};auto=> /= ??[#]!-> @/inv_lt @/inv_le [#] mlt milt clt cle Hin 5? _. + rewrite /bad_ext !get_setE /= set_set_eqE //=. rewrite !(imageU,inE) restr_set /= size_rem dom_restr Hin //=; smt w=size_set_le. by call RROset_inv_lt;auto;smt w=size_set_le. diff --git a/proof/smart_counter/Handle.eca b/proof/smart_counter/Handle.eca index 47c8007..7b6143e 100644 --- a/proof/smart_counter/Handle.eca +++ b/proof/smart_counter/Handle.eca @@ -1413,7 +1413,7 @@ case @[ambient]: {-1}(Pmi.[(xa,xc)]) (eq_refl Pmi.[(xa,xc)])=> [Pmi_xaxc|[ya yc] apply/(@notin_m_notin_mh hs.[ch <- (xc,Known)] Pmi _ _ xc ch Known)=> //. + by apply/m_mh_addh=> //; case: inv0. by rewrite get_setE. - auto=> ? ? [#] !<<- -> -> ->> _ /= ya -> /= yc -> /=. + auto=> ? ? [#] !<<- -> -> ->> _ /= ya ? /= yc ? /=. case: (hinvP (hs.[ch <- (xc,Known)]) yc)=> [_|-> //] yc_notrngE1_hs_addh _ _. rewrite get_setE /= (@huniq_hinvK_h ch) 3:oget_some /=. + by apply/huniq_addh=> //; have /hs_of_INV [] := inv0. @@ -1448,7 +1448,7 @@ case @[ambient]: {-1}(Pmi.[(xa,xc)]) (eq_refl Pmi.[(xa,xc)])=> [Pmi_xaxc|[ya yc] rewrite negb_and domE /=; left. by apply/(@notin_m_notin_mh hs Pmi _ _ xc _ Known)=> //; case: inv0. auto => ? ? [#] !<<- -> -> ->> _. - rewrite (@huniq_hinvK_h hx2) // oget_some /= => y1 -> /= y2 -> /=. + rewrite (@huniq_hinvK_h hx2) // oget_some /= => y1 ? /= y2 ? /=. case: (hinvP hs y2)=> [_ y2_notrngE1_hs _ _|/#]. rewrite get_setE /=. apply/lemma2'=> //. @@ -1673,7 +1673,7 @@ call(: !G1.bcol{2} have /m_mh_of_INV [] _ /(_ _ _ _ _ G1mh_x1hx2) := inv0. move=> [xc xf yc yf] [#]; rewrite hs_hx2=> [#] <*>. by rewrite PFm_x1x2. - auto => &m1 &m2 [#] !<- _ _ -> /= _ y1L -> y2L -> /=. + auto => &m1 &m2 [#] !<- _ _ -> /= _ y1L ? y2L ? /=. rewrite !get_set_sameE pi_x2 oget_some /=. have /hs_of_INV [] Hu _ _:= inv0; have -> := huniq_hinvK_h _ _ _ Hu hs_hx2. rewrite oget_some domE => /= ;cut[]_->_ _ _/=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. @@ -1801,7 +1801,7 @@ call(: !G1.bcol{2} + by have /hs_of_INV []:= inv0. by rewrite /in_dom_with domE hs_hy2. rcondt{2} 14; first by auto=> &hr [#] !<<- _ _ ->> _ /=; rewrite domE pi_x2. - auto=> &1 &2 [#] !<<- -> -> ->> _ /=; rewrite Block.DBlock.dunifin_ll Capacity.DCapacity.dunifin_ll /=. + auto=> &1 &2 [#] !<<- -> -> ->> _ /=. move=> _ _ _ _; rewrite PFm_x1x2 pi_x2 !oget_some //=. rewrite (@huniq_hinvK_h hx2 hs0 x2) // 10?oget_some. + by have /hs_of_INV []:= inv0. @@ -2285,7 +2285,7 @@ proof. * rewrite/#. * by rewrite!get_setE/=. * cut[]HINV[]H_bad[]H_m_p0[]Hp1[]Hp2[]->>[]H_counter[][]f H_h[]H_path[]H_F_RO H_i:=H3 H6. - cut:=H12;rewrite !negb_or/==>[][][]bad1 hinv_none bad2. + cut:=H10;rewrite !negb_or/==>[][][]bad1 hinv_none bad2. cut H_hs_spec:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. cut H_mh_spec:=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. cut H_m_mh:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. @@ -2300,11 +2300,11 @@ proof. G1.mh{2}.[(sa{2} +^ nth witness bs{1} i{2}, h{2}) <- (y1L, G1.chandle{2})] G1.paths{2}. + split;progress. - - cut[]h:=H_pi_spec;cut:=h c p0 v;rewrite H13/==>[][]h1[] h'1 h'2. + - cut[]h:=H_pi_spec;cut:=h c p0 v;rewrite H11/==>[][]h1[] h'1 h'2. exists h1;rewrite -h'2 get_setE/=. cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h'2. by apply build_hpath_up=>//=. - move:H14;rewrite get_setE/==>hh0. + move:H12;rewrite get_setE/==>hh0. cut h0_neq_ch:h0 <> G1.chandle{2} by rewrite/#. cut[]->:=H_pi_spec;rewrite-hh0 h0_neq_ch/=;exists h0=>/=. cut:=H;cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness bs{1} i{2}) y1L p0 v h0. @@ -2362,7 +2362,7 @@ proof. cut hbex:b +^ x = nth witness bs{1} i{2} by rewrite/#. by cut:=hb;rewrite H_path/==>[][->>->>]/=;rewrite-hbex Block.WRing.addKr/=. - progress. - * move:H13;rewrite get_setE/=H_take_Si/=. + * move:H11;rewrite get_setE/=H_take_Si/=. case(p0 = (take i{2} bs{1}))=>[->>|hpp0];rewrite!get_setE/=. + cut->/=:=build_hpath_up _ _ _ y1L G1.chandle{2} _ _ _ H_path h_g1. case(bn = (nth witness bs{1} i{2}))=>[->> /= ->>|hbni]/=. @@ -2382,9 +2382,9 @@ proof. cut[]_ hh4 _:=H_mh_spec. cut:=hh4 p0 bn b0;rewrite h_ro_p_bn/==>[][];progress. cut help:(sa{2} +^ nth witness bs{1} i{2}, h{2}) <> (v +^ bn, hx) by rewrite/#. - exists v hx hy=>//=;rewrite get_setE;rewrite eq_sym in help;rewrite help/=H14/=. + exists v hx hy=>//=;rewrite get_setE;rewrite eq_sym in help;rewrite help/=H12/=. by apply build_hpath_up=>//=. - move:H13 H14;rewrite!get_setE/= =>h_build_hpath_set. + move:H11 H12;rewrite!get_setE/= =>h_build_hpath_set. case(hy = G1.chandle{2})=>//=[->>|hy_neq_ch]/=. + move=>h;cut h_eq:v +^ bn = sa{2} +^ nth witness bs{1} i{2} && hx = h{2}. + cut/#:G1.mh{2}.[(v +^ bn, hx)] <> Some (b0, G1.chandle{2}). @@ -2429,7 +2429,7 @@ proof. progress. + cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness bs{1} i{2}) y1L p0 v hx. cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness bs{1} i{2}) y1L p' v' hx. - move:H13 H14;rewrite!get_setE/= =>H13 H14;rewrite H13 H14. + move:H11 H12;rewrite!get_setE/= =>H13 H14;rewrite H13 H14. cut->/=:=ch_neq0 _ _ H_hs_spec. cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec H_h. rewrite h_g1/=. @@ -2456,7 +2456,7 @@ proof. by have[#]->>->>:=HH3 _ _ _ _ _ hp21 hp11. cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness bs{1} i{2}) y1L p0 v hx. cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness bs{1} i{2}) y1L p' v' hx. - move:H13 H14;rewrite!get_setE/= =>H13 H14;rewrite H13 H14/=. + move:H11 H12;rewrite!get_setE/= =>H13 H14;rewrite H13 H14/=. cut->/=:=ch_neq0 _ _ H_hs_spec. cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec H_h. rewrite h_g1/=. From aa51d35200727dbb10ce6fc72827bc508ffe3182 Mon Sep 17 00:00:00 2001 From: Pierre-Yves Strub Date: Sun, 5 Jan 2020 15:10:49 -0500 Subject: [PATCH 497/525] track jasmin/array_cast --- .gitmodules | 1 + jasmin | 2 +- 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/.gitmodules b/.gitmodules index d50059f..9ef9b8b 100644 --- a/.gitmodules +++ b/.gitmodules @@ -1,3 +1,4 @@ [submodule "jasmin"] path = jasmin url = https://github.com/jasmin-lang/jasmin + branch = array_cast diff --git a/jasmin b/jasmin index 0b895ab..f158af4 160000 --- a/jasmin +++ b/jasmin @@ -1 +1 @@ -Subproject commit 0b895ab8975da6d6257c9c092a02b286fdcbc5fe +Subproject commit f158af4fb98d3a682737bcb366a77ba290cb53ae From 5b6fcdcc9624552d7bbb4013de9d5716d0d675ee Mon Sep 17 00:00:00 2001 From: Pierre-Yves Strub Date: Sun, 5 Jan 2020 16:31:47 -0500 Subject: [PATCH 498/525] fix proofs --- proof/Sponge.ec | 2 +- proof/smart_counter/Handle.eca | 10 +++++----- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/proof/Sponge.ec b/proof/Sponge.ec index 3df0fd1..57fcec4 100644 --- a/proof/Sponge.ec +++ b/proof/Sponge.ec @@ -1393,7 +1393,7 @@ skip=> split. split. split=> [// | _]; rewrite i1_eq_i2_tim_r; smt(ge0_r). split=> //. split; first smt(). split=> //. split; first by rewrite /= take0 cats0. split=> //. -clear bs1; move=> bs1 i1'. +move=> bs1 i1'. split=> [| not_i1'_lt_m]; first smt(). move=> [# i1_le_i1' i1'_le_m _ sz_bs1_eq_i1' _ bs1_eq mem_mp2_xs_i2 _]. split. diff --git a/proof/smart_counter/Handle.eca b/proof/smart_counter/Handle.eca index 7b6143e..34e5df6 100644 --- a/proof/smart_counter/Handle.eca +++ b/proof/smart_counter/Handle.eca @@ -669,7 +669,7 @@ lemma build_hpath_prefix mh p b v h: proof. rewrite build_hpathP; split=> [[|p' b' v' h' [#] + Hhpath Hmh]|[v' h'] [] Hhpath Hmh]. + smt(size_rcons size_ge0). -+ by move=> ^/rconsIs <<- {b'} /rconssI <<- {p'}; exists v' h'. ++ by move=> ^/rconsIs <<- /rconssI <<-; exists v' h'. exact/(Extend _ _ _ _ _ Hhpath Hmh). qed. @@ -1194,7 +1194,7 @@ split. by have /incl_of_INV H /H {H}:= HINV. + move: mh_xahx; have /inv_of_INV [] H /H {H}:= HINV. have /mi_mhi_of_INV [] _ H /H {H} [xct fxt yct fyt] [#] := HINV. - rewrite hs_hx hs_hy=> /= [#] 2!<<- {xct fxt} [#] 2!<<- {yct fyt} Pmi_yayc. + rewrite hs_hx hs_hy=> /= [#] 2!<<- [#] 2!<<- Pmi_yayc. move=> [za zc]; rewrite get_setE; case: ((za,zc) = (ya,yc))=> // _. by have /incli_of_INV H /H {H}:= HINV. + split; last 2 by have /mh_of_INV [] _:= HINV. @@ -1658,7 +1658,7 @@ call(: !G1.bcol{2} + by have /hs_of_INV []:= inv0. rewrite domE; case: {-1}(G1mh.[(x1,hx2)]) (eq_refl (G1mh.[(x1,hx2)]))=> [//=|[xa xc] G1mh_x1hx2]. have /m_mh_of_INV [] _ /(_ _ _ _ _ G1mh_x1hx2) [xc0 xf0 yc0 yf0] := inv0. - by move=> [#]; rewrite hs_hx2=> [#] !<<- {xc0 xf0}; rewrite PFm_x1x2. + by move=> [#]; rewrite hs_hx2=> [#] !<<-; rewrite PFm_x1x2. rcondt{2} 15. + auto; inline *; auto=> &hr [#] !<<- _ _ !->> _ /= _ _ _ _ /=. by rewrite domE pi_x2. @@ -1776,7 +1776,7 @@ call(: !G1.bcol{2} move=> x1x2_notin_G1m; rcondt{2} 1; 1:by auto=> &hr [#] !<<- _ _ ->>; rewrite domE x1x2_notin_G1m. have <*>: fy2 = Unknown. + have /mh_of_INV [] /(_ _ _ _ _ G1mh_x1hx2) + _ := inv0. - move=> [xc0 xf0 yc0 yf0] [#]; rewrite hs_hx2 hs_hy2=> [#] !<<- [#] !<<- {xc0 xf0 yc0 yf0}. + move=> [xc0 xf0 yc0 yf0] [#]; rewrite hs_hx2 hs_hy2=> [#] !<<- [#] !<<-. by case: fy2 hs_hy2 G1mh_x1hx2=> //=; rewrite x1x2_notin_G1m. case @[ambient]: fx2 hs_hx2=> hs_hx2. + swap{2} 3 -2; seq 0 1: (queries = C.queries{2} /\ G1.bext{2}). @@ -1788,7 +1788,7 @@ call(: !G1.bcol{2} - by rewrite domE;cut[]_->_ _ _/=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. by inline*; if{2}; auto=> &1 &2 />; smt(F.sampleto_ll sampleto_ll). have /mh_of_INV []/(_ _ _ _ _ G1mh_x1hx2) + _ _:= inv0. - move=> [xc0 xf0 yc0 yf0] [#]; rewrite hs_hx2 hs_hy2=> [#] !<<- [#] !<<- {xc0 xf0 yc0 yf0} /= [p0 v0] [#] Hro Hpath. + move=> [xc0 xf0 yc0 yf0] [#]; rewrite hs_hx2 hs_hy2=> [#] !<<- [#] !<<- /= [p0 v0] [#] Hro Hpath. have /pi_of_INV [] /(_ x2 p0 v0) /iffRL /(_ _) := inv0. + by exists hx2=>/#. move=> pi_x2; rcondt{2} 1; 1:by auto=> &hr [#] <*>; rewrite domE pi_x2. From 6a67efc302f24ff5797e40a26274fde7cc0b8bce Mon Sep 17 00:00:00 2001 From: Pierre-Yves Strub Date: Mon, 6 Jan 2020 06:10:04 -0500 Subject: [PATCH 499/525] fix proofs --- proof/smart_counter/SLCommon.ec | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/proof/smart_counter/SLCommon.ec b/proof/smart_counter/SLCommon.ec index 2fa773b..37f6ceb 100644 --- a/proof/smart_counter/SLCommon.ec +++ b/proof/smart_counter/SLCommon.ec @@ -154,14 +154,14 @@ rewrite -{1}cats1 foldl_cat {1}/step_hpath /=. case: {-1}(foldl _ _ _) (eq_refl (foldl (step_hpath mh) (Some (b0,0)) p))=> //=. + apply/implybN; case=> [|p' b0 v' h']. + smt(size_rcons size_ge0). - move=> ^/rconssI <<- {p'} /rconsIs ->> {b}. + move=> ^/rconssI <<- /rconsIs ->>. by rewrite /build_hpath=> ->. move=> [v' h']; rewrite -/(build_hpath _ _)=> build. split. + by move=> mh__; apply/(Extend mh (rcons p b) v h p b v' h' _ build mh__). case=> [| p' b' v'' h'']. + smt(size_rcons size_ge0). -move=> ^/rconssI <<- {p'} /rconsIs <<- {b'}. +move=> ^/rconssI <<- /rconsIs <<-. by rewrite build /= => [#] <*>. qed. From 52e04832fbd534747fbf5ddc6de09ae37e03f51f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Tue, 11 Feb 2020 19:22:48 +0000 Subject: [PATCH 500/525] Update to follow EasyCrypt 1.0 --- proof/Common.ec | 11 +++++++---- proof/smart_counter/ConcreteF.eca | 12 ++++++------ 2 files changed, 13 insertions(+), 10 deletions(-) diff --git a/proof/Common.ec b/proof/Common.ec index 72d1d38..1f66658 100644 --- a/proof/Common.ec +++ b/proof/Common.ec @@ -1,7 +1,7 @@ (*------------------- Common Definitions and Lemmas --------------------*) require import Core Int IntExtra IntDiv Real List Distr. require import Ring StdRing StdOrder StdBigop BitEncoding DProd. -require (*--*) FinType BitWord IdealPRP Monoid. +require (*--*) FinType BitWord PRP Monoid. (*---*) import IntID IntOrder Bigint Bigint.BIA IntDiv. pragma +implicits. @@ -104,13 +104,16 @@ by rewrite addzC (@last_nonempty y z). qed. (*------------------------------ Primitive -----------------------------*) +clone export PRP as PRPt with + type D <- block * capacity. -clone export IdealPRP as Perm with - type D <- block * capacity, +clone export StrongPRP as PRPSec. + +clone export RP as Perm with op dD <- bdistr `*` cdistr rename [module type] "PRP" as "PRIMITIVE" - [module] "RandomPermutation" as "Perm" + [module] "RP" as "Perm" proof dD_ll. realize dD_ll. by apply/dprod_ll; rewrite Block.DBlock.dunifin_ll Capacity.DCapacity.dunifin_ll. diff --git a/proof/smart_counter/ConcreteF.eca b/proof/smart_counter/ConcreteF.eca index f20a1f8..904f061 100644 --- a/proof/smart_counter/ConcreteF.eca +++ b/proof/smart_counter/ConcreteF.eca @@ -77,7 +77,7 @@ section. lemma size_behead (l : 'a list) : l <> [] => size (behead l) = size l - 1. proof. by case l=> // ?? /=; ring. qed. - local module (D': PRPt.Distinguisher) (P' : PRPt.Oracles) = { + local module (D': PRPSec.Distinguisher) (P' : PRPSec.SPRP_Oracles) = { proc distinguish () : bool = { var b : bool; Redo.init(); @@ -86,9 +86,9 @@ section. } }. - local lemma DoubleBounding (P <: PRPt.StrongPRP {D, C, DBounder, Redo}) &m: - Pr[PRPt.IND(P,D').main() @ &m: res] - = Pr[PRPt.IND(P,DBounder(D')).main() @ &m: res]. + local lemma DoubleBounding (P <: PRPSec.PRP {D, C, DBounder, Redo}) &m: + Pr[PRPSec.IND(P,D').main() @ &m: res] + = Pr[PRPSec.IND(P,DBounder(D')).main() @ &m: res]. proof. byequiv=> //=; proc; inline *. wp. @@ -388,13 +388,13 @@ section. apply (@ler_trans _ _ _ (Pr_restr Perm SqueezelessSponge D p_ll pi_ll f_ll D_ll &m)). have ->: Pr[Indif(SqueezelessSponge(Perm), Perm, DRestr(D)).main() @ &m: res] - = Pr[PRPt.IND(PRPi.PRPi,DBounder(D')).main() @ &m: res]. + = Pr[PRPSec.IND(PRPi.PRPi,DBounder(D')).main() @ &m: res]. + rewrite -(DoubleBounding PRPi.PRPi &m). byequiv=> //=; proc; inline *; sim (_: ={m,mi}(Perm,PRPi.PRPi) /\ ={glob C}). * by proc; if=> //=; auto. by proc; if=> //=; auto. have ->: Pr[CF(DRestr(D)).main() @ &m: res] - = Pr[PRPt.IND(ARP,DBounder(D')).main() @ &m: res]. + = Pr[PRPSec.IND(ARP,DBounder(D')).main() @ &m: res]. + rewrite -(DoubleBounding ARP &m). byequiv=> //=; proc; inline *; sim (_: ={m,mi}(PF,ARP)). * proc; if=> //=; auto; conseq (_: true ==> (y1,y2){1} = x{2})=> //=. From 0220593cde582c6ed7523856486f0b03de2c1203 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Tue, 11 Feb 2020 19:36:42 +0000 Subject: [PATCH 501/525] Update to follow EasyCrypt 1.0 Drop '=' as notation for assignments --- proof/smart_counter/Gcol.eca | 2 +- proof/smart_counter/Gext.eca | 4 ++-- proof/smart_counter/SLCommon.ec | 2 +- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/proof/smart_counter/Gcol.eca b/proof/smart_counter/Gcol.eca index 5fa1634..9414347 100644 --- a/proof/smart_counter/Gcol.eca +++ b/proof/smart_counter/Gcol.eca @@ -35,7 +35,7 @@ section PROOF. var count : int proc sample_c () = { - var c=c0; + var c <- c0; if (card (image fst (frng FRO.m)) <= 2*max_size /\ count < max_size) { c <$ cdistr; diff --git a/proof/smart_counter/Gext.eca b/proof/smart_counter/Gext.eca index 3c35494..2902362 100644 --- a/proof/smart_counter/Gext.eca +++ b/proof/smart_counter/Gext.eca @@ -319,7 +319,7 @@ section EXT. /\ ReSample.count < max_size) { G1.bext <- G1.bext \/ mem (image snd (fdom G1.m `|` fdom G1.mi)) c; FRO.m.[h] <- (c,Unknown); - count = count + 1 ; + count <- count + 1 ; } } @@ -329,7 +329,7 @@ section EXT. if (card (fdom G1.m) < max_size /\ card (fdom G1.mi) < max_size /\ ReSample.count < max_size) { G1.bext <- G1.bext \/ mem (image snd (fdom G1.m `|` fdom G1.mi) `|` fset1 x) c; FRO.m.[h] <- (c,Unknown); - count = count + 1; + count <- count + 1; } } diff --git a/proof/smart_counter/SLCommon.ec b/proof/smart_counter/SLCommon.ec index 37f6ceb..75541eb 100644 --- a/proof/smart_counter/SLCommon.ec +++ b/proof/smart_counter/SLCommon.ec @@ -893,7 +893,7 @@ module FC(F:FUNCTIONALITY) = { module DFRestr(F:DFUNCTIONALITY) = { proc f (bs:block list) = { - var b= b0; + var b <- b0; if (bs \notin C.queries) { if (C.c + size bs - prefix bs (get_max_prefix bs (elems (fdom C.queries))) <= max_size) { C.c <- C.c + size bs - prefix bs (get_max_prefix bs (elems (fdom C.queries))); From 45bfce503bbb74e2448e10cdbd8bb7a577c7b048 Mon Sep 17 00:00:00 2001 From: Pierre-Yves Strub Date: Thu, 13 Feb 2020 21:52:37 +0100 Subject: [PATCH 502/525] jasmin submodule: track master --- jasmin | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/jasmin b/jasmin index f158af4..352a8f6 160000 --- a/jasmin +++ b/jasmin @@ -1 +1 @@ -Subproject commit f158af4fb98d3a682737bcb366a77ba290cb53ae +Subproject commit 352a8f6856502f0b1101bfa9736093b99fa88671 From 82749b5c0d964a27b614af9ce091d9d82b1b7d0e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Wed, 1 Apr 2020 14:16:15 +0100 Subject: [PATCH 503/525] Update to follow EasyCrypt 1.0 Issues remain with Jasmin standard libs --- proof/Common.ec | 2 +- proof/IRO.eca | 15 +++++--- proof/SHA3OSecurity.ec | 15 ++++---- proof/SHA3Security.ec | 8 ++--- proof/Sponge.ec | 56 ++++++++++++++++-------------- proof/smart_counter/Gconcl_list.ec | 5 +-- 6 files changed, 58 insertions(+), 43 deletions(-) diff --git a/proof/Common.ec b/proof/Common.ec index 1f66658..60b759b 100644 --- a/proof/Common.ec +++ b/proof/Common.ec @@ -284,7 +284,7 @@ proof. by rewrite /num0 ltz_pmod gt0_r. qed. lemma index_true_behead_mkpad n : index true (behead (mkpad n)) = num0 n. proof. -rewrite /mkpad -cats1 index_cat mem_nseq size_nseq. +rewrite /mkpad -cats1 //= index_cat mem_nseq size_nseq. by rewrite max_ler // /num0 modz_ge0 gtr_eqF ?gt0_r. qed. diff --git a/proof/IRO.eca b/proof/IRO.eca index bad01db..6d72077 100644 --- a/proof/IRO.eca +++ b/proof/IRO.eca @@ -42,8 +42,11 @@ module IRO : IRO = { } proc fill_in(x, n) = { + var r; + if ((x,n) \notin mp) { - mp.[(x,n)] <$ dto; + r <$ dto; + mp.[(x,n)] <- r; } return oget mp.[(x,n)]; } @@ -72,12 +75,13 @@ module IRO' : IRO = { var visible : (from * int) fset proc resample_invisible() = { - var work, x; + var work, x, r; work <- fdom mp `\` visible; while (work <> fset0) { x <- pick work; - mp.[x] <$ dto; + r <$ dto; + mp.[x] <- r; work <- work `\` fset1 x; } } @@ -88,8 +92,11 @@ module IRO' : IRO = { } proc fill_in(x,n) = { + var r; + if ((x,n) \notin mp) { - mp.[(x,n)] <$ dto; + r <$ dto; + mp.[(x,n)] <- r; } return oget mp.[(x,n)]; } diff --git a/proof/SHA3OSecurity.ec b/proof/SHA3OSecurity.ec index cd91595..1c7fc62 100644 --- a/proof/SHA3OSecurity.ec +++ b/proof/SHA3OSecurity.ec @@ -218,7 +218,7 @@ local module Log = { local module ExtendOutputSize (F : Oracle) : ODFUNCTIONALITY = { proc f (x : bool list, k : int) = { - var o, l, suffix, prefix, i; + var o, l, suffix, prefix, i, r; l <- None; prefix <- []; suffix <- []; @@ -227,7 +227,8 @@ local module ExtendOutputSize (F : Oracle) : ODFUNCTIONALITY = { i <- size_out; while (i < k) { if ((x,i) \notin Log.m) { - Log.m.[(x,i)] <$ {0,1}; + r <$ {0,1}; + Log.m.[(x,i)] <- r; } suffix <- rcons suffix (oget Log.m.[(x,i)]); i <- i + 1; @@ -937,7 +938,7 @@ local module Log = { local module ExtendOutputSize (F : Oracle) : ODFUNCTIONALITY = { proc f (x : bool list, k : int) = { - var o, l, suffix, prefix, i; + var o, l, suffix, prefix, i, r; l <- None; prefix <- []; suffix <- []; @@ -946,7 +947,8 @@ local module ExtendOutputSize (F : Oracle) : ODFUNCTIONALITY = { i <- size_out; while (i < k) { if ((x,i) \notin Log.m) { - Log.m.[(x,i)] <$ {0,1}; + r <$ {0,1}; + Log.m.[(x,i)] <- r; } suffix <- rcons suffix (oget Log.m.[(x,i)]); i <- i + 1; @@ -1815,7 +1817,7 @@ local module Log = { local module ExtendOutputSize (F : Oracle) : ODFUNCTIONALITY = { proc f (x : bool list, k : int) = { - var o, l, suffix, prefix, i; + var o, l, suffix, prefix, i, r; l <- None; prefix <- []; suffix <- []; @@ -1824,7 +1826,8 @@ local module ExtendOutputSize (F : Oracle) : ODFUNCTIONALITY = { i <- size_out; while (i < k) { if ((x,i) \notin Log.m) { - Log.m.[(x,i)] <$ {0,1}; + r <$ {0,1}; + Log.m.[(x,i)] <- r; } suffix <- rcons suffix (oget Log.m.[(x,i)]); i <- i + 1; diff --git a/proof/SHA3Security.ec b/proof/SHA3Security.ec index 6827ccd..3fba70a 100644 --- a/proof/SHA3Security.ec +++ b/proof/SHA3Security.ec @@ -359,7 +359,7 @@ section Preimage. have:=h2 x0{hr}; rewrite H2/= negb_exists/= =>/(_ (size bs0{hr})). rewrite size_ge0 H9/=; apply absurd =>/= h. by have //=:= H5 _ _ h. - rnd; auto; progress. + wp; rnd; auto; progress. - smt(size_ge0). - smt(). - by rewrite size_cat/=. @@ -706,7 +706,7 @@ section SecondPreimage. have:=h2 x0{hr}; rewrite H2/= negb_exists/= =>/(_ (size bs0{hr})). rewrite size_ge0 H9/=; apply absurd =>/= h. by have //=:= H5 _ _ h. - rnd; auto; progress. + wp; rnd; auto; progress. - smt(size_ge0). - smt(). - by rewrite size_cat/=. @@ -1098,7 +1098,7 @@ section Collision. have:=h2 x0{hr}; rewrite H2/= negb_exists/= =>/(_ (size bs0{hr})). rewrite size_ge0 H9/=; apply absurd =>/= h. by have //=:= H5 _ _ h. - rnd; auto; progress. + wp; rnd; auto; progress. - smt(size_ge0). - smt(). - by rewrite size_cat/=. @@ -1282,4 +1282,4 @@ section SHA3_Collision. qed. -end section SHA3_Collision. \ No newline at end of file +end section SHA3_Collision. diff --git a/proof/Sponge.ec b/proof/Sponge.ec index 57fcec4..062e246 100644 --- a/proof/Sponge.ec +++ b/proof/Sponge.ec @@ -291,8 +291,11 @@ module HybridIROLazy : HYBRID_IRO = { } proc fill_in(xs : block list, i : int) = { + var r; + if (! dom mp (xs, i)) { - mp.[(xs, i)] <$ dbool; + r <$ dbool; + mp.[(xs, i)] <- r; } return oget mp.[(xs, i)]; } @@ -324,8 +327,11 @@ module HybridIROEager : HYBRID_IRO = { } proc fill_in(xs : block list, i : int) = { + var r; + if (! dom mp (xs, i)) { - mp.[(xs, i)] <$ dbool; + r <$ dbool; + mp.[(xs, i)] <- r; } return oget mp.[(xs, i)]; } @@ -709,13 +715,12 @@ progress; HybridIROLazy.mp{2} x{1} i{2}) | by apply (lazy_invar_mem_pad2blocks_r2l IRO.mp{1} HybridIROLazy.mp{2} x{1} i{2})]. -rnd; auto; progress; - [by rewrite !get_setE | - by rewrite -(lazy_invar_upd_mem_dom_iff IRO.mp{1}) | - by rewrite (lazy_invar_upd_mem_dom_iff IRO.mp{1} HybridIROLazy.mp{2}) | - by rewrite (lazy_invar_upd2_vb IRO.mp{1} HybridIROLazy.mp{2} - x{1} xs2 i{2} n2 mpL) | - by rewrite (lazy_invar_upd_lu_eq IRO.mp{1} HybridIROLazy.mp{2})]. +wp; rnd; auto=> |> &1 &2 inv i_lt_n0 xi_notin_m r _. +rewrite !get_set_sameE //=; split=> [bs n|]. ++ exact/(lazy_invar_upd_mem_dom_iff _ _ _ _ _ _ _ inv). +split=> [xs n|bs n]. ++ by move=>/(lazy_invar_upd2_vb _ _ _ _ _ _ _ inv). +by move=>/(lazy_invar_upd_lu_eq _ _ _ _ _ _ _ inv). auto; progress [-delta]. by rewrite (lazy_invar_lookup_eq IRO.mp{1} HybridIROLazy.mp{2} x{1} i{2}). auto. @@ -746,13 +751,12 @@ progress; HybridIROLazy.mp{2} x{1} i{2}) | by apply (lazy_invar_mem_pad2blocks_r2l IRO.mp{1} HybridIROLazy.mp{2} x{1} i{2})]. -rnd; auto; progress; - [by rewrite !get_setE | - by rewrite -(lazy_invar_upd_mem_dom_iff IRO.mp{1}) | - by rewrite (lazy_invar_upd_mem_dom_iff IRO.mp{1} HybridIROLazy.mp{2}) | - by rewrite (lazy_invar_upd2_vb IRO.mp{1} HybridIROLazy.mp{2} - x{1} xs1 i{2} n1 mpL) | - by rewrite (lazy_invar_upd_lu_eq IRO.mp{1} HybridIROLazy.mp{2})]. +wp; rnd; auto=> |> &1 &2 inv i_lt_n0 xi_notin_m r _. +rewrite !get_set_sameE=> //=; split=> [bs n|]. ++ exact/(lazy_invar_upd_mem_dom_iff _ _ _ _ _ _ _ inv). +split=> [xs n|bs n]. ++ by move=>/(lazy_invar_upd2_vb _ _ _ _ _ _ _ inv). +by move=>/(lazy_invar_upd_lu_eq _ _ _ _ _ _ _ inv). auto; progress [-delta]; by rewrite (lazy_invar_lookup_eq IRO.mp{1} HybridIROLazy.mp{2} x{1} i{2}). auto. @@ -887,12 +891,12 @@ while (={i, HybridIROEager.mp} /\ xs0{1} = xs{2} /\ bs0{1} = bs{2} /\ n0{1} = n{2} /\ m{1} = n0{1} /\ m{2} = n{2}). -sp; wp; if=> //; rnd; auto. +sp; wp; if=> //; wp; rnd; auto. while (={i, HybridIROEager.mp} /\ xs0{1} = xs{2} /\ bs0{1} = bs{2} /\ n0{1} = n{2} /\ m{1} = n0{1} /\ m{2} = n{2})=> //. -sp; wp; if=> //; rnd; auto. +sp; wp; if=> //; wp; rnd; auto. auto. qed. @@ -1546,7 +1550,7 @@ transitivity{1} eager_invar BlockSponge.BIRO.IRO.mp{2} HybridIROEager.mp{1})=> //. progress; exists HybridIROEager.mp{1} n' xs{2}=> //. while (={xs, i, bs, HybridIROEager.mp} /\ n{1} = n' + 1 /\ n{2} = n'). -wp. call (_ : ={HybridIROEager.mp}). if=> //; rnd; auto. +wp. call (_ : ={HybridIROEager.mp}). if=> //; wp; rnd; auto. skip; progress; smt(ge0_r). auto; smt(). transitivity{2} @@ -1568,7 +1572,7 @@ progress; exists BlockSponge.BIRO.IRO.mp{2} n{1} xs{2}=> //. conseq IH=> //. while (={xs, bs, i, BlockSponge.BIRO.IRO.mp} /\ n{1} = n' /\ n{2} = n' + 1). -wp. call (_ : ={BlockSponge.BIRO.IRO.mp}). if=> //; rnd; auto. +wp. call (_ : ={BlockSponge.BIRO.IRO.mp}). if=> //; wp; rnd; auto. auto; smt(). auto; smt(). unroll{2} 1. rcondt{2} 1; first auto; progress; smt(). @@ -1590,7 +1594,7 @@ while (xs{1} = xs0{2} /\ i{1} = i0{2} /\ n{1} = n' + 1 /\ m{2} = (n' + 1) * r /\ bs{1} = bs0{2} /\ ={HybridIROEager.mp}). -wp. call (_ : ={HybridIROEager.mp}). if=> //; rnd; auto. +wp. call (_ : ={HybridIROEager.mp}). if=> //; wp; rnd; auto. auto. auto. transitivity{2} { (bs, i) <@ BlockSpongeTrans.next_block(xs, i, bs); } @@ -1606,7 +1610,7 @@ progress; exists BlockSponge.BIRO.IRO.mp{2} bs{2} (size bs{2}) xs{2}=> //. call (HybridIROEagerTrans_BlockSpongeTrans_next_block n'). skip; progress; smt(). inline BlockSpongeTrans.next_block. -wp; sp. call (_ : ={BlockSponge.BIRO.IRO.mp}). if=> //; rnd; skip; smt(). +wp; sp. call (_ : ={BlockSponge.BIRO.IRO.mp}). if=> //; wp; rnd; skip; smt(). auto. qed. @@ -1738,7 +1742,7 @@ inline HybridIROEagerTrans.loop; sp; wp. while (={HybridIROEager.mp} /\ i{1} = i0{2} /\ bs{1} = bs0{2} /\ xs{1} = xs0{2} /\ n0{2} = n1 %/ r). -wp. call (_ : ={HybridIROEager.mp}). if=> //; rnd; auto. +wp. call (_ : ={HybridIROEager.mp}). if=> //; wp; rnd; auto. auto. auto. (transitivity{2} { (i, bs) <@ BlockSpongeTrans.loop(n1 %/ r, x); } @@ -1755,7 +1759,7 @@ inline BlockSpongeTrans.loop; sp; wp. while (={BlockSponge.BIRO.IRO.mp} /\ i0{1} = i{2} /\ n0{1} = n1 %/ r /\ xs{1} = x{2} /\ bs0{1} = bs{2}). -wp. call (_ : ={BlockSponge.BIRO.IRO.mp}). if=> //; rnd; auto. +wp. call (_ : ={BlockSponge.BIRO.IRO.mp}). if=> //; wp; rnd; auto. auto. auto. call (HybridIROEagerTrans_BlockSpongeTrans_loop (n1 %/ r)). skip; progress; smt(divz_ge0 gt0_r). @@ -1823,14 +1827,14 @@ seq 1 1 : while (={HybridIROEager.mp, xs, bs, i, m} /\ n{1} = n1 /\ n1 <= m{1} /\ i{1} <= n1 /\ size bs{1} = i{1}). -wp; call (_ : ={HybridIROEager.mp}); first if => //; rnd; auto. +wp; call (_ : ={HybridIROEager.mp}); first if => //; wp; rnd; auto. skip; smt(size_rcons). skip; smt(). while (={HybridIROEager.mp, xs, i, m} /\ n1 <= m{1} /\ n1 <= i{1} <= m{1} /\ n1 <= size bs{2} /\ bs{1} = take n1 bs{2}). -wp; call (_ : ={HybridIROEager.mp}); first if => //; rnd; auto. +wp; call (_ : ={HybridIROEager.mp}); first if => //; wp; rnd; auto. skip; progress; [smt() | smt() | smt(size_rcons) | rewrite -cats1 take_cat; diff --git a/proof/smart_counter/Gconcl_list.ec b/proof/smart_counter/Gconcl_list.ec index 63ae1aa..0b5c1b2 100644 --- a/proof/smart_counter/Gconcl_list.ec +++ b/proof/smart_counter/Gconcl_list.ec @@ -1926,7 +1926,7 @@ module Simulator (F : DFUNCTIONALITY) = { unvalid_map <- empty; } proc f (x : state) : state = { - var p,v,q,k,cs,y,y1,y2; + var p,v,q,k,cs,y,y1,y2,r; if (x \notin m) { if (x.`2 \in paths) { (p,v) <- oget paths.[x.`2]; @@ -1937,7 +1937,8 @@ module Simulator (F : DFUNCTIONALITY) = { } else { if (0 < k) { if ((q,k-1) \notin unvalid_map) { - unvalid_map.[(q,k-1)] <$ bdistr; + r <$ bdistr; + unvalid_map.[(q,k-1)] <- r; } y1 <- oget unvalid_map.[(q,k-1)]; } else { From 30c11963174746ae405e77e28c1807bfb7f050c3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Sun, 19 Apr 2020 09:18:29 +0100 Subject: [PATCH 504/525] Follow EasyCrypt 1.0 --- proof/SHA3Security.ec | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/proof/SHA3Security.ec b/proof/SHA3Security.ec index 3fba70a..7273c65 100644 --- a/proof/SHA3Security.ec +++ b/proof/SHA3Security.ec @@ -148,7 +148,7 @@ section Preimage. proof. by split;exact invmC'. qed. local lemma useful m mi a : - invm m mi => ! a \in m => Distr.is_lossless ((bdistr `*` cdistr) \ rng m). + Prefix.invm m mi => ! a \in m => Distr.is_lossless ((bdistr `*` cdistr) \ rng m). proof. move=>hinvm nin_dom. cut prod_ll:Distr.is_lossless (bdistr `*` cdistr). @@ -505,7 +505,7 @@ section SecondPreimage. proof. by split;exact invmC'. qed. local lemma useful m mi a : - invm m mi => ! a \in m => Distr.is_lossless ((bdistr `*` cdistr) \ rng m). + Prefix.invm m mi => ! a \in m => Distr.is_lossless ((bdistr `*` cdistr) \ rng m). proof. move=>hinvm nin_dom. cut prod_ll:Distr.is_lossless (bdistr `*` cdistr). @@ -898,7 +898,7 @@ section Collision. proof. by split;exact invmC'. qed. local lemma useful m mi a : - invm m mi => ! a \in m => Distr.is_lossless ((bdistr `*` cdistr) \ rng m). + Prefix.invm m mi => ! a \in m => Distr.is_lossless ((bdistr `*` cdistr) \ rng m). proof. move=>hinvm nin_dom. cut prod_ll:Distr.is_lossless (bdistr `*` cdistr). From e731561c75f2adfed31bf7598e6e3ae052326912 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Wed, 1 Apr 2020 18:40:45 +0100 Subject: [PATCH 505/525] Update to follow new ROM libraries --- proof/IRO.eca | 4 +- proof/SHA3Indiff.ec | 8 +-- proof/SHA3OSecurity.ec | 20 +++---- proof/SHA3_OIndiff.ec | 8 +-- proof/SecureORO.eca | 16 +++--- proof/SecureRO.eca | 16 +++--- proof/Sponge.ec | 32 ++++++------ proof/smart_counter/Gcol.eca | 4 +- proof/smart_counter/Gconcl.ec | 28 +++++----- proof/smart_counter/Gconcl_list.ec | 52 +++++++++---------- proof/smart_counter/Gext.eca | 83 ++++++++++++++++-------------- proof/smart_counter/Handle.eca | 20 +++---- proof/smart_counter/SLCommon.ec | 17 +++--- 13 files changed, 158 insertions(+), 150 deletions(-) diff --git a/proof/IRO.eca b/proof/IRO.eca index 6d72077..7c3af6a 100644 --- a/proof/IRO.eca +++ b/proof/IRO.eca @@ -79,8 +79,8 @@ module IRO' : IRO = { work <- fdom mp `\` visible; while (work <> fset0) { - x <- pick work; - r <$ dto; + x <- pick work; + r <$ dto; mp.[x] <- r; work <- work `\` fset1 x; } diff --git a/proof/SHA3Indiff.ec b/proof/SHA3Indiff.ec index 1e3390d..94a2d64 100644 --- a/proof/SHA3Indiff.ec +++ b/proof/SHA3Indiff.ec @@ -148,8 +148,8 @@ section. declare module Dist : DISTINGUISHER{Perm, Gconcl_list.SimLast, IRO, Cntr, BlockSponge.BIRO.IRO, Simulator, BlockSponge.C, Gconcl.S, - SLCommon.F.RO, SLCommon.F.RRO, SLCommon.Redo, SLCommon.C, - Gconcl_list.BIRO2.IRO, Gconcl_list.F2.RO, Gconcl_list.F2.RRO, + SLCommon.F.RO, SLCommon.F.FRO, SLCommon.Redo, SLCommon.C, + Gconcl_list.BIRO2.IRO, Gconcl_list.F2.RO, Gconcl_list.F2.FRO, Gconcl_list.Simulator}. axiom Dist_lossless (F <: DFUNCTIONALITY { Dist }) (P <: DPRIMITIVE { Dist }) : @@ -314,8 +314,8 @@ lemma SHA3Indiff (Dist <: DISTINGUISHER{ Perm, IRO, BlockSponge.BIRO.IRO, Cntr, Simulator, Gconcl_list.SimLast(Gconcl.S), BlockSponge.C, Gconcl.S, - SLCommon.F.RO, SLCommon.F.RRO, SLCommon.Redo, SLCommon.C, - Gconcl_list.BIRO2.IRO, Gconcl_list.F2.RO, Gconcl_list.F2.RRO, + SLCommon.F.RO, SLCommon.F.FRO, SLCommon.Redo, SLCommon.C, + Gconcl_list.BIRO2.IRO, Gconcl_list.F2.RO, Gconcl_list.F2.FRO, Gconcl_list.Simulator}) &m : (forall (F <: DFUNCTIONALITY { Dist }) (P <: DPRIMITIVE { Dist }), diff --git a/proof/SHA3OSecurity.ec b/proof/SHA3OSecurity.ec index 1c7fc62..4272486 100644 --- a/proof/SHA3OSecurity.ec +++ b/proof/SHA3OSecurity.ec @@ -179,13 +179,13 @@ clone import Program as PBool with op d <- dbool proof *. -clone import GenEager as Eager with - type from <- bool list * int, - type to <- bool, - op sampleto <- fun _ => dbool, - type input <- unit, - type output <- bool -proof * by smt(dbool_ll). +clone import FullRO as Eager with + type in_t <- bool list * int, + type out_t <- bool, + op dout _ <- dbool, + type d_in_t <- unit, + type d_out_t <- bool. +import FullEager. section Preimage. @@ -643,7 +643,7 @@ cut->: inline{1} 1; inline{2} 1; sp; sim; if; 1: auto; sim. by call eq_eager_ideal2; auto. rewrite eq_sym; byequiv=> //=; proc. -call(RO_LRO_D Dist); inline*; auto=> />. +call(RO_LRO_D Dist dbool_ll); inline*; auto=> />. qed. local lemma rw_ideal_2 &m: @@ -1403,7 +1403,7 @@ cut->: inline{1} 1; inline{2} 1; sp; sim; if; 1: auto; sim. by call eq_eager_ideal2; auto. rewrite eq_sym; byequiv=> //=; proc. -by call(RO_LRO_D Dist); inline*; auto=> />. +by call(RO_LRO_D Dist dbool_ll); inline*; auto=> />. qed. @@ -2281,7 +2281,7 @@ cut->: inline{1} 1; inline{2} 1; sp; sim; if; 1: auto; sim. by call eq_eager_ideal2; auto. rewrite eq_sym; byequiv=> //=; proc. -by call(RO_LRO_D Dist); inline*; auto=> />. +by call(RO_LRO_D Dist dbool_ll); inline*; auto=> />. qed. local equiv toto : diff --git a/proof/SHA3_OIndiff.ec b/proof/SHA3_OIndiff.ec index 1900a47..d2723ce 100644 --- a/proof/SHA3_OIndiff.ec +++ b/proof/SHA3_OIndiff.ec @@ -171,8 +171,8 @@ section. declare module Dist : ODISTINGUISHER{Perm, Gconcl_list.SimLast, IRO, Cntr, BlockSponge.BIRO.IRO, Simulator, BlockSponge.C, Gconcl.S, - SLCommon.F.RO, SLCommon.F.RRO, SLCommon.Redo, SLCommon.C, - Gconcl_list.BIRO2.IRO, Gconcl_list.F2.RO, Gconcl_list.F2.RRO, + SLCommon.F.RO, SLCommon.F.FRO, SLCommon.Redo, SLCommon.C, + Gconcl_list.BIRO2.IRO, Gconcl_list.F2.RO, Gconcl_list.F2.FRO, Gconcl_list.Simulator}. @@ -210,8 +210,8 @@ lemma SHA3OIndiff (Dist <: ODISTINGUISHER{ Counter, Perm, IRO, BlockSponge.BIRO.IRO, Cntr, Simulator, Gconcl_list.SimLast(Gconcl.S), BlockSponge.C, Gconcl.S, - SLCommon.F.RO, SLCommon.F.RRO, SLCommon.Redo, SLCommon.C, - Gconcl_list.BIRO2.IRO, Gconcl_list.F2.RO, Gconcl_list.F2.RRO, + SLCommon.F.RO, SLCommon.F.FRO, SLCommon.Redo, SLCommon.C, + Gconcl_list.BIRO2.IRO, Gconcl_list.F2.RO, Gconcl_list.F2.FRO, Gconcl_list.Simulator, OSimulator}) &m : (forall (F <: ODFUNCTIONALITY) (P <: ODPRIMITIVE), diff --git a/proof/SecureORO.eca b/proof/SecureORO.eca index cc8ac8f..bcd0a01 100644 --- a/proof/SecureORO.eca +++ b/proof/SecureORO.eca @@ -13,13 +13,13 @@ axiom sampleto_ll: is_lossless sampleto. axiom sampleto_full: is_full sampleto. axiom sampleto_fu: is_funiform sampleto. -clone import PROM.GenEager as RO with - type from <- from, - type to <- to, - op sampleto <- fun _ => sampleto, - type input <- unit, - type output <- bool -proof * by exact/sampleto_ll. +clone import PROM.FullRO as RO with + type in_t <- from, + type out_t <- to, + op dout _ <- sampleto, + type d_in_t <- unit, + type d_out_t <- bool. +import FullEager. op increase_counter (c : int) (m : from) : int. axiom increase_counter_spec c m : c <= increase_counter c m. @@ -261,7 +261,7 @@ section SecondPreimage. Pr [ SecondPreimage3(A,RO).main(mess1) @ &m : res ]. - rewrite eq_sym. byequiv=>//=; proc. - by call(RO_LRO_D (D1(A))); inline*; auto. + by call(RO_LRO_D (D1(A)) sampleto_ll); inline*; auto. by byequiv=> //=; proc; inline*; wp -2 18; sim. byphoare(: arg = mess1 ==> _)=>//=; proc. seq 1 : (rng (rem RO.m mess1) (oget RO.m.[mess1])) diff --git a/proof/SecureRO.eca b/proof/SecureRO.eca index 3e0fed3..4510737 100644 --- a/proof/SecureRO.eca +++ b/proof/SecureRO.eca @@ -13,13 +13,13 @@ axiom sampleto_ll: is_lossless sampleto. axiom sampleto_full: is_full sampleto. axiom sampleto_fu: is_funiform sampleto. -clone import PROM.GenEager as RO with - type from <- from, - type to <- to, - op sampleto <- fun _ => sampleto, - type input <- unit, - type output <- bool -proof * by exact/sampleto_ll. +clone import PROM.FullRO as RO with + type in_t <- from, + type out_t <- to, + op dout _ <- sampleto, + type d_in_t <- unit, + type d_out_t <- bool. +import FullEager. op increase_counter (c : int) (m : from) : int. axiom increase_counter_spec c m : c <= increase_counter c m. @@ -281,7 +281,7 @@ section SecondPreimage. Pr [ SecondPreimage3(A,RO).main(mess1) @ &m : res ]. - rewrite eq_sym. byequiv=>//=; proc. - by call(RO_LRO_D (D1(A))); inline*; auto. + by call(RO_LRO_D (D1(A)) sampleto_ll); inline*; auto. by byequiv=> //=; proc; inline*; wp -2 18; sim. byphoare(: arg = mess1 ==> _)=>//=; proc. seq 1 : (rng (rem RO.m mess1) (oget RO.m.[mess1])) diff --git a/proof/Sponge.ec b/proof/Sponge.ec index 062e246..343e803 100644 --- a/proof/Sponge.ec +++ b/proof/Sponge.ec @@ -3,8 +3,8 @@ require import Core Int IntDiv Real List FSet SmtMap. (*---*) import IntExtra. require import Distr DBool DList. require import StdBigop StdOrder. import IntOrder. -require import Common. -require (*--*) IRO BlockSponge PROM. +require import Common PROM. +require (*--*) IRO BlockSponge. (*------------------------- Indifferentiability ------------------------*) @@ -369,13 +369,13 @@ section. declare module D : HYBRID_IRO_DIST{HybridIROEager, HybridIROLazy}. -local clone PROM.GenEager as ERO with - type from <- block list * int, - type to <- bool, - op sampleto <- fun _ => dbool, - type input <- unit, - type output <- bool - proof sampleto_ll by apply dbool_ll. +local clone PROM.FullRO as ERO with + type in_t <- block list * int, + type out_t <- bool, + op dout _ <- dbool, + type d_in_t <- unit, + type d_out_t <- bool. +import ERO.FullEager. local module EROExper(O : ERO.RO, D : ERO.RO_Distinguisher) = { proc main() : bool = { @@ -387,12 +387,12 @@ local module EROExper(O : ERO.RO, D : ERO.RO_Distinguisher) = { }. local lemma LRO_RO (D <: ERO.RO_Distinguisher{ERO.RO, ERO.FRO}) &m : - Pr[EROExper(ERO.LRO, D).main() @ &m : res] = + Pr[EROExper(LRO, D).main() @ &m : res] = Pr[EROExper(ERO.RO, D).main() @ &m : res]. proof. byequiv=> //; proc. seq 1 1 : (={glob D, ERO.RO.m}); first sim. -symmetry; call (ERO.RO_LRO_D D); auto. +symmetry; call (RO_LRO_D D dbool_ll); auto. qed. (* make a Hybrid IRO out of a random oracle *) @@ -424,12 +424,12 @@ local module HIRO(RO : ERO.RO) : HYBRID_IRO = { }. local lemma HybridIROLazy_HIRO_LRO_init : - equiv[HybridIROLazy.init ~ HIRO(ERO.LRO).init : + equiv[HybridIROLazy.init ~ HIRO(LRO).init : true ==> HybridIROLazy.mp{1} = ERO.RO.m{2}]. proof. proc; inline*; auto. qed. local lemma HybridIROLazy_fill_in_LRO_get : - equiv[HybridIROLazy.fill_in ~ ERO.LRO.get : + equiv[HybridIROLazy.fill_in ~ LRO.get : (xs, i){1} = x{2} /\ HybridIROLazy.mp{1} = ERO.RO.m{2} ==> ={res} /\ HybridIROLazy.mp{1} = ERO.RO.m{2}]. proof. @@ -442,11 +442,11 @@ wp; rnd; auto. qed. local lemma HybridIROLazy_HIRO_LRO_f : - equiv[HybridIROLazy.f ~ HIRO(ERO.LRO).f : + equiv[HybridIROLazy.f ~ HIRO(LRO).f : ={xs, n} /\ HybridIROLazy.mp{1} = ERO.RO.m{2} ==> ={res} /\ HybridIROLazy.mp{1} = ERO.RO.m{2}]. proof. -proc; inline ERO.LRO.sample; sp=> /=. +proc; inline LRO.sample; sp=> /=. if=> //. while{2} (true) (m{2} - i{2}). progress; auto; progress; smt(). @@ -512,7 +512,7 @@ local module RODist(RO : ERO.RO) = { local lemma Exper_HybridIROLazy_LRO &m : Pr[HybridIROExper(HybridIROLazy, D).main() @ &m : res] = - Pr[EROExper(ERO.LRO, RODist).main() @ &m : res]. + Pr[EROExper(LRO, RODist).main() @ &m : res]. proof. byequiv=> //; proc; inline*; wp. seq 1 1 : (={glob D} /\ HybridIROLazy.mp{1} = ERO.RO.m{2}); first auto. diff --git a/proof/smart_counter/Gcol.eca b/proof/smart_counter/Gcol.eca index 9414347..3edb93f 100644 --- a/proof/smart_counter/Gcol.eca +++ b/proof/smart_counter/Gcol.eca @@ -1,7 +1,7 @@ pragma -oldip. require import Core Int Real RealExtra StdOrder Ring StdBigop IntExtra. -require import List FSet SmtMap Common SLCommon PROM FelTactic Mu_mem. -require import DProd Dexcepted. +require import List FSet SmtMap Common SLCommon FelTactic Mu_mem. +require import DProd Dexcepted PROM. (*...*) import Capacity IntOrder Bigreal RealOrder BRA. require (*..*) Handle. diff --git a/proof/smart_counter/Gconcl.ec b/proof/smart_counter/Gconcl.ec index 7e9fb9b..12d4767 100644 --- a/proof/smart_counter/Gconcl.ec +++ b/proof/smart_counter/Gconcl.ec @@ -1,7 +1,7 @@ pragma -oldip. require import Core Int Real RealExtra StdOrder Ring StdBigop IntExtra. -require import List FSet SmtMap Common SLCommon PROM FelTactic Mu_mem. -require import DProd Dexcepted. +require import List FSet SmtMap Common SLCommon FelTactic Mu_mem. +require import DProd Dexcepted PROM. (*...*) import Capacity IntOrder Bigreal RealOrder BRA. require (*..*) Gext. @@ -116,14 +116,14 @@ local module G3(RO:F.RO) = { } y2 <$ cdistr; y <- (y1, y2); - handles_ <@ RRO.restrK(); + handles_ <@ RRO.allKnown(); if (!rng handles_ x.`2) { RRO.set(G1.chandle, x.`2); G1.chandle <- G1.chandle + 1; } - handles_ <- RRO.restrK(); + handles_ <- RRO.allKnown(); hx2 <- oget (hinvc handles_ x.`2); - t <@ RRO.in_dom((oget G1.mh.[(x.`1,hx2)]).`2, Unknown); + t <@ RRO.queried((oget G1.mh.[(x.`1,hx2)]).`2, Unknown); if ((x.`1, hx2) \in G1.mh /\ t) { hy2 <- (oget G1.mh.[(x.`1, hx2)]).`2; FRO.m.[hy2] <- (y2,Known); @@ -152,14 +152,14 @@ local module G3(RO:F.RO) = { var y, y1, y2, hx2, hy2, handles_, t; if (x \notin G1.mi) { - handles_ <@ RRO.restrK(); + handles_ <@ RRO.allKnown(); if (!rng handles_ x.`2) { RRO.set(G1.chandle, x.`2); G1.chandle <- G1.chandle + 1; } - handles_ <@ RRO.restrK(); + handles_ <@ RRO.allKnown(); hx2 <- oget (hinvc handles_ x.`2); - t <@ RRO.in_dom((oget G1.mhi.[(x.`1,hx2)]).`2, Unknown); + t <@ RRO.queried((oget G1.mhi.[(x.`1,hx2)]).`2, Unknown); y1 <$ bdistr; y2 <$ cdistr; y <- (y1,y2); @@ -204,7 +204,7 @@ local module G3(RO:F.RO) = { } }. -local equiv G2_G3: Eager(G2(DRestr(D))).main2 ~ G3(F.LRO).distinguish : ={glob D} ==> ={res}. +local equiv G2_G3: Eager(G2(DRestr(D))).main2 ~ G3(F.FullEager.LRO).distinguish : ={glob D} ==> ={res}. proof. proc;wp;call{1} RRO_resample_ll;inline *;wp. call (_: ={FRO.m,F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.chandle,G1.paths,C.c,C.queries}); last by auto. @@ -348,7 +348,7 @@ proof. by sim;inline *;auto;progress;smt(DCapacity.dunifin_ll). qed. -local equiv G4_Ideal : G4(F.LRO).distinguish ~ IdealIndif(IF,S,DRestr(D)).main : +local equiv G4_Ideal : G4(F.FullEager.LRO).distinguish ~ IdealIndif(IF,S,DRestr(D)).main : ={glob D} ==> ={res}. proof. proc;inline *;wp. @@ -356,7 +356,7 @@ proof. + by sim. + by sim. + proc;sp;if=>//;auto;if=>//;auto. call (_: ={F.RO.m});2:by auto. - inline F.LRO.get F.FRO.sample;wp 7 2;sim. + inline F.FullEager.LRO.get F.FRO.sample;wp 7 2;sim. by while{1} (true) (size p - i){1};auto;1:inline*;auto=>/#. by auto. qed. @@ -376,11 +376,11 @@ lemma Real_Ideal &m: proof. apply (ler_trans _ _ _ (Real_G2 D D_ll &m)). rewrite !(ler_add2l, ler_add2r);apply lerr_eq. - apply (eq_trans _ Pr[G3(F.LRO).distinguish() @ &m : res]);1:by byequiv G2_G3. + apply (eq_trans _ Pr[G3(F.FullEager.LRO).distinguish() @ &m : res]);1:by byequiv G2_G3. apply (eq_trans _ Pr[G3(F.RO ).distinguish() @ &m : res]). - + by byequiv (_: ={glob G3, F.RO.m} ==> _)=>//;symmetry;conseq (F.RO_LRO_D G3). + + by byequiv (_: ={glob G3, F.RO.m} ==> _)=>//;symmetry;conseq (F.FullEager.RO_LRO_D G3 Block.DBlock.dunifin_ll). apply (eq_trans _ Pr[G4(F.RO ).distinguish() @ &m : res]);1:by byequiv G3_G4. - apply (eq_trans _ Pr[G4(F.LRO).distinguish() @ &m : res]);1:by byequiv (F.RO_LRO_D G4). + apply (eq_trans _ Pr[G4(F.FullEager.LRO).distinguish() @ &m : res]);1:by byequiv (F.FullEager.RO_LRO_D G4 Block.DBlock.dunifin_ll). by byequiv G4_Ideal. qed. diff --git a/proof/smart_counter/Gconcl_list.ec b/proof/smart_counter/Gconcl_list.ec index 0b5c1b2..6158e27 100644 --- a/proof/smart_counter/Gconcl_list.ec +++ b/proof/smart_counter/Gconcl_list.ec @@ -327,9 +327,9 @@ section Ideal. }. local equiv Ideal_equiv_valid (D <: DISTINGUISHER{SLCommon.C, C, IF, S}) : - L(D,F.LRO).distinguish + L(D,F.FullEager.LRO).distinguish ~ - L2(D,F.LRO).distinguish + L2(D,F.FullEager.LRO).distinguish : ={glob D} ==> ={glob D, res}. proof. @@ -339,7 +339,7 @@ section Ideal. call(: ={glob S,glob F.RO});auto. sp;if;auto;if;auto;sp. call(: ={glob F.RO});2:auto;2:smt(). - inline F.LRO.sample;call(: ={glob IF});auto;progress. + inline F.FullEager.LRO.sample;call(: ={glob IF});auto;progress. by while{1}(true)(n{1}-i{1});auto;smt(). + by proc;sim. proc;sp;if;auto;sp;call(: ={glob IF,glob S});auto. @@ -836,7 +836,7 @@ section Ideal. local equiv equiv_L4_ideal (D <: DISTINGUISHER{SLCommon.C, C, IF, S, F2.RO, BIRO.IRO, BIRO2.IRO}) : - L4(D,F.LRO,F2.LRO).distinguish + L4(D,F.FullEager.LRO,F2.FullEager.LRO).distinguish ~ IdealIndif(BIRO.IRO,SimLast(S),DRestr(D)).main : @@ -912,7 +912,7 @@ section Ideal. D(FC(FValid(DSqueeze2(F, F2.RO))), PC(S(Last(DSqueeze2(F, F2.RO))))). local module D6 (D : DISTINGUISHER) (F2 : F2.RO) = - D(FC(FValid(DSqueeze2(F.LRO, F2))), PC(S(Last(DSqueeze2(F.LRO, F2))))). + D(FC(FValid(DSqueeze2(F.FullEager.LRO, F2))), PC(S(Last(DSqueeze2(F.FullEager.LRO, F2))))). lemma equiv_ideal (D <: DISTINGUISHER{SLCommon.C, C, IF, S, F.FRO, F2.RO, F2.FRO, BIRO.IRO, BIRO2.IRO}) &m: @@ -926,20 +926,20 @@ section Ideal. Pr[SLCommon.IdealIndif(IF,S,A(D)).main() @ &m : res]. + by byequiv(ideal_equiv2 D). cut->:Pr[L2(D, F.RO).distinguish() @ &m : res] = - Pr[L2(D,F.LRO).distinguish() @ &m : res]. + Pr[L2(D,F.FullEager.LRO).distinguish() @ &m : res]. + byequiv=>//=;proc;sp;inline*;sp;wp. - by call(F.RO_LRO_D (D2(D)));auto. + by call(F.FullEager.RO_LRO_D (D2(D)) dunifin_ll);auto. cut->:Pr[IdealIndif(BIRO.IRO, SimLast(S), DRestr(D)).main() @ &m : res] = - Pr[L4(D,F.LRO,F2.LRO).distinguish() @ &m : res]. + Pr[L4(D,F.FullEager.LRO,F2.FullEager.LRO).distinguish() @ &m : res]. + by rewrite eq_sym;byequiv(equiv_L4_ideal D)=>//=. cut<-:Pr[L4(D, F.RO, F2.RO).distinguish() @ &m : res] = - Pr[L4(D,F.LRO,F2.LRO).distinguish() @ &m : res]. + Pr[L4(D,F.FullEager.LRO,F2.FullEager.LRO).distinguish() @ &m : res]. + cut->:Pr[L4(D, F.RO, F2.RO).distinguish() @ &m : res] = - Pr[L4(D,F.LRO, F2.RO).distinguish() @ &m : res]. + Pr[L4(D,F.FullEager.LRO, F2.RO).distinguish() @ &m : res]. - byequiv=>//=;proc;sp;inline*;sp;wp. - by call(F.RO_LRO_D (D5(D)));auto. + by call(F.FullEager.RO_LRO_D (D5(D)) dunifin_ll);auto. byequiv=>//=;proc;sp;inline*;sp;wp. - by call(F2.RO_LRO_D (D6(D)));auto. + by call(F2.FullEager.RO_LRO_D (D6(D)) dunifin_ll);auto. cut<-:Pr[L3(D, F.RO).distinguish() @ &m : res] = Pr[L4(D, F.RO, F2.RO).distinguish() @ &m : res]. + by byequiv(equiv_L3_L4 D)=>//=. @@ -947,9 +947,9 @@ section Ideal. Pr[L3(D, F.RO).distinguish() @ &m : res]. + by byequiv(Ideal_equiv3 D). cut->:Pr[L(D, F.RO).distinguish() @ &m : res] = - Pr[L(D,F.LRO).distinguish() @ &m : res]. + Pr[L(D,F.FullEager.LRO).distinguish() @ &m : res]. + byequiv=>//=;proc;sp;inline*;sp;wp. - by call(F.RO_LRO_D (D3(D)));auto. + by call(F.FullEager.RO_LRO_D (D3(D)) dunifin_ll);auto. rewrite eq_sym. by byequiv(Ideal_equiv_valid D). qed. @@ -1731,7 +1731,7 @@ end section Real. section Real_Ideal. (* REAL & IDEAL *) - declare module D : DISTINGUISHER{SLCommon.C, C, Perm, Redo, F.RO, F.RRO, S, BIRO.IRO, BIRO2.IRO, F2.RO, F2.FRO}. + declare module D : DISTINGUISHER{SLCommon.C, C, Perm, Redo, F.RO, F.FRO, S, BIRO.IRO, BIRO2.IRO, F2.RO, F2.FRO}. axiom D_lossless (F0 <: DFUNCTIONALITY{D}) (P0 <: DPRIMITIVE{D}) : islossless P0.f => islossless P0.fi => islossless F0.f => @@ -1777,7 +1777,7 @@ require import AdvAbsVal. section Real_Ideal_Abs. - declare module D : DISTINGUISHER{SLCommon.C, C, Perm, Redo, F.RO, F.RRO, S, BIRO.IRO, BIRO2.IRO, F2.RO, F2.FRO}. + declare module D : DISTINGUISHER{SLCommon.C, C, Perm, Redo, F.RO, F.FRO, S, BIRO.IRO, BIRO2.IRO, F2.RO, F2.FRO}. axiom D_lossless (F0 <: DFUNCTIONALITY{D}) (P0 <: DPRIMITIVE{D}) : islossless P0.f => islossless P0.fi => islossless F0.f => @@ -1984,13 +1984,13 @@ axiom D_lossless (F0 <: DFUNCTIONALITY{D}) (P0 <: DPRIMITIVE{D}) : islossless P0.f => islossless P0.fi => islossless F0.f => islossless D(F0, P0).distinguish. -local clone import PROM.GenEager as IRO2 with - type from <- block list * int, - type to <- block, - op sampleto <- fun _, bdistr, - type input <- unit, - type output <- bool -proof * by exact/DBlock.dunifin_ll. +local clone import PROM.FullRO as IRO2 with + type in_t <- block list * int, + type out_t <- block, + op dout _ <- bdistr, + type d_in_t <- unit, + type d_out_t <- bool. +import FullEager. local module Simu (FRO : IRO2.RO) (F : DFUNCTIONALITY) = { proc init() = { @@ -2128,7 +2128,7 @@ qed. local lemma equal2 &m : Pr [ IdealIndif(BIRO.IRO, Simulator, DRestr(D)).main() @ &m : res ] = - Pr [ L(IRO2.LRO).distinguish() @ &m : res ]. + Pr [ L(IRO2.FullEager.LRO).distinguish() @ &m : res ]. proof. byequiv=>//=; proc; inline*; auto. call (: ={BIRO.IRO.mp,C.c,Simulator.m,Simulator.mi,Simulator.paths} /\ @@ -2160,7 +2160,7 @@ lemma Simplify_simulator &m : Pr [ IdealIndif(BIRO.IRO, SimLast(S), DRestr(D)).main() @ &m : res ]. proof. rewrite (equal1 &m) (equal2 &m) eq_sym. -by byequiv(RO_LRO_D L)=>//=. +by byequiv(RO_LRO_D L dunifin_ll)=>//=. qed. @@ -2171,7 +2171,7 @@ end section Simplify_Simulator. section Real_Ideal. - declare module D : DISTINGUISHER{SLCommon.C, C, Perm, Redo, F.RO, F.RRO, S, BIRO.IRO, BIRO2.IRO, F2.RO, F2.FRO, Simulator}. + declare module D : DISTINGUISHER{SLCommon.C, C, Perm, Redo, F.RO, F.FRO, S, BIRO.IRO, BIRO2.IRO, F2.RO, F2.FRO, Simulator}. axiom D_lossless (F0 <: DFUNCTIONALITY{D}) (P0 <: DPRIMITIVE{D}) : islossless P0.f => islossless P0.fi => islossless F0.f => diff --git a/proof/smart_counter/Gext.eca b/proof/smart_counter/Gext.eca index 2902362..977508e 100644 --- a/proof/smart_counter/Gext.eca +++ b/proof/smart_counter/Gext.eca @@ -1,7 +1,7 @@ pragma -oldip. require import Core Int Real RealExtra StdOrder Ring StdBigop IntExtra. -require import List FSet SmtMap Common SLCommon PROM FelTactic Mu_mem. -require import DProd Dexcepted. +require import List FSet SmtMap Common SLCommon FelTactic Mu_mem. +require import DProd Dexcepted PROM. (*...*) import Capacity IntOrder Bigreal RealOrder BRA DCapacity. require (*..*) Gcol. @@ -61,14 +61,14 @@ module G2(D:DISTINGUISHER,HS:FRO) = { } y <- (y1, y2); - handles_ <@ HS.restrK(); + handles_ <@ HS.allKnown(); if (!rng handles_ x.`2) { HS.set(G1.chandle, x.`2); G1.chandle <- G1.chandle + 1; } - handles_ <- HS.restrK(); + handles_ <- HS.allKnown(); hx2 <- oget (hinvc handles_ x.`2); - t <@ HS.in_dom((oget G1.mh.[(x.`1,hx2)]).`2, Unknown); + t <@ HS.queried((oget G1.mh.[(x.`1,hx2)]).`2, Unknown); if ((x.`1, hx2) \in G1.mh /\ t) { hy2 <- (oget G1.mh.[(x.`1, hx2)]).`2; y2 <@ HS.get(hy2); @@ -99,17 +99,17 @@ module G2(D:DISTINGUISHER,HS:FRO) = { var y, y1, y2, hx2, hy2, handles_, t; if (x \notin G1.mi) { - handles_ <@ HS.restrK(); + handles_ <@ HS.allKnown(); if (!rng handles_ x.`2) { HS.set(G1.chandle, x.`2); G1.chandle <- G1.chandle + 1; } - handles_ <@ HS.restrK(); + handles_ <@ HS.allKnown(); hx2 <- oget (hinvc handles_ x.`2); y1 <$ bdistr; y2 <$ cdistr; y <- (y1,y2); - t <@ HS.in_dom((oget G1.mhi.[(x.`1,hx2)]).`2, Unknown); + t <@ HS.queried((oget G1.mhi.[(x.`1,hx2)]).`2, Unknown); if ((x.`1, hx2) \in G1.mhi /\ t) { (y1,hy2) <- oget G1.mhi.[(x.`1, hx2)]; y2 <@ HS.get(hy2); @@ -153,8 +153,10 @@ module G2(D:DISTINGUISHER,HS:FRO) = { } }. +clone include EagerCore +proof * by (move=> _; exact/Capacity.DCapacity.dunifin_ll). + section. - declare module D: DISTINGUISHER{G1, G2, FRO, C}. op inv_ext (m mi:smap) (FROm:handles) = @@ -193,14 +195,18 @@ section. inv_ext G1.m{2} G1.mi{2} FRO.m{2})) /\ (forall h, h \in FRO.m => h < G1.chandle){1} /\ x0{1} \notin G1.m{1}). - + inline *;auto=> &ml&mr[#]10!-> -> ->->Hi-> Hhand -> /=. - rewrite -dom_restr rng_restr /=;progress;3:by smt ml=0. - + rewrite !rngE /=; move: H0=> [/Hi[->|[x h][]H1 H2]|H0]//. - + by right; right; exists x h; rewrite get_setE; smt(). - right; left; move: H0; rewrite rngE /= => [][] h Hh. - exists h; rewrite get_set_neqE //=. - by have:= Hhand h; rewrite domE Hh /#. - by move: H0; rewrite mem_set /#. + + inline *; auto=> |> &ml &mr Hi Hhand. + rewrite -dom_restr rng_restr !rngE /= negb_exists=> /= |> x_notin_G1. + case: (x0{mr})=> b0 c0 /=; split=> [x0K_notinrng_m|h mh]. + + split=> [|/#]. + split=> [[/Hi [-> //|[] x h /= [] H1 H2]|[] h Hh]|h]. + + by right; right; exists x h; rewrite get_setE /#. + + right; left; exists h; rewrite get_set_neqE //=. + by have:= Hhand h; rewrite domE Hh /#. + by rewrite mem_set /#. + split=> [/#|[/Hi [->//|[] x h' /= [] H1 H2]|[] h' Hh']]. + + by right; right; exists x h'. + by right; left; exists h'. seq 1 1: (={x0,y0,x,F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.paths,G1.chandle,FRO.m,C.queries,C.c} /\ inv_ext1 G1.bext{1} G1.bext{2} G1.m{2} G1.mi{2} FRO.m{2} /\ x{1} = x0{1} /\ forall (h : handle), h \in FRO.m{1} => h < G1.chandle{1});2:by auto. @@ -239,17 +245,18 @@ section. inv_ext G1.m{2} G1.mi{2} FRO.m{2})) /\ (forall h, h \in FRO.m => h < G1.chandle){1} /\ x{1} \notin G1.mi{1}). - + inline *;auto=> &ml&mr[#]-><-_ _9!-> Hi Hhand _ -> /=. - rewrite -dom_restr rng_restr /=;progress; 3:by smt ml=0. - + rewrite rngE/=; case: H2 =>//= H4. - + move:Hi; rewrite/inv_ext1 H4 /= => [][->|] //= [] x h. - move=> [#] H5 Hh; right; right. - exists x h; rewrite H5 get_set_neqE//=. - by move:(Hhand h);rewrite domE Hh /#. - move: H4; rewrite rngE /= => [][] h Hh; right; left. - exists h; rewrite get_set_neqE //=. - by move:(Hhand h);rewrite domE Hh /#. - by move:H2;rewrite mem_set /#. + + inline *; auto=> |> &ml &mr Hi Hhand. + rewrite -dom_restr rng_restr !rngE /= negb_exists=> /= |> c_le_msize x_notin_G1. + case: (x{mr})=> b c /=; split=> [xK_notinrng_m|h mh]. + + split=> [b0 _ c0 _|/#]. + split=> [[/Hi [-> //|[] x h /= [] H1 H2]|[] h Hh]|h]. + + by right; right; exists x h; rewrite get_setE /#. + + right; left; exists h; rewrite get_set_neqE //=. + by have:= Hhand h; rewrite domE Hh /#. + by rewrite mem_set /#. + split=> [/#|b0 _ c0 _ [/Hi [->//|[] x h' /= [] H1 H2]|[] h' Hh']]. + + by right; right; exists x h'. + by right; left; exists h'. if=>//. + inline *;rcondt{2} 4. + by move=> &m;auto;rewrite /in_dom_with. @@ -385,14 +392,14 @@ section EXT. y <- (y1, y2); (* exists x h, mem (dom G1.m) x /\ handles.[h] = Some (x.2, I) *) - handles_ <@ RRO.restrK(); + handles_ <@ RRO.allKnown(); if (!rng handles_ x.`2) { RRO.set(G1.chandle, x.`2); G1.chandle <- G1.chandle + 1; } - handles_ <- RRO.restrK(); + handles_ <- RRO.allKnown(); hx2 <- oget (hinvc handles_ x.`2); - t <@ RRO.in_dom((oget G1.mh.[(x.`1,hx2)]).`2, Unknown); + t <@ RRO.queried((oget G1.mh.[(x.`1,hx2)]).`2, Unknown); if ((x.`1, hx2) \in G1.mh /\ t) { hy2 <- (oget G1.mh.[(x.`1, hx2)]).`2; ReSample.f1(x.`2, hy2); @@ -423,17 +430,17 @@ section EXT. var y, y1, y2, hx2, hy2, handles_, t; if (x \notin G1.mi) { - handles_ <@ RRO.restrK(); + handles_ <@ RRO.allKnown(); if (!rng handles_ x.`2) { RRO.set(G1.chandle, x.`2); G1.chandle <- G1.chandle + 1; } - handles_ <@ RRO.restrK(); + handles_ <@ RRO.allKnown(); hx2 <- oget (hinvc handles_ x.`2); y1 <$ bdistr; y2 <$ cdistr; y <- (y1,y2); - t <@ RRO.in_dom((oget G1.mhi.[(x.`1,hx2)]).`2, Unknown); + t <@ RRO.queried((oget G1.mhi.[(x.`1,hx2)]).`2, Unknown); if ((x.`1, hx2) \in G1.mhi /\ t) { (y1,hy2) <- oget G1.mhi.[(x.`1, hx2)]; ReSample.f1(x.`2,hy2); @@ -616,8 +623,8 @@ section EXT. (={t,y,x,hx2,F.RO.m,FRO.m,G1.paths,G1.mh,G1.mhi,G1.m,G1.mi,G1.chandle,G1.bext, C.c,C.queries} /\ inv_lt G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2} /\ (t => in_dom_with FRO.m (oget G1.mh.[(x.`1, hx2)]).`2 Unknown){1}). - + inline RRO.in_dom; wp;call (_: ={FRO.m});1:by sim. - inline RRO.restrK;sp 1 1;if=>//. + + inline RRO.queried; wp;call (_: ={FRO.m});1:by sim. + inline RRO.allKnown;sp 1 1;if=>//. by wp;call RROset_inv_lt;auto. if=>//;wp. + inline *;rcondt{1} 4;1:by auto=>/#. @@ -638,8 +645,8 @@ section EXT. (={t,y,x,hx2,F.RO.m,FRO.m,G1.paths,G1.mh,G1.mhi,G1.m,G1.mi,G1.chandle,G1.bext, C.c} /\ inv_lt G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2} /\ (t => in_dom_with FRO.m (oget G1.mhi.[(x.`1, hx2)]).`2 Unknown){1}). - + inline RRO.in_dom; auto;call (_: ={FRO.m});1:by sim. - inline RRO.restrK;sp 1 1;if=>//. + + inline RRO.queried; auto;call (_: ={FRO.m});1:by sim. + inline RRO.allKnown;sp 1 1;if=>//. by wp;call RROset_inv_lt;auto. if=>//;wp. + inline *;rcondt{1} 4;1:by auto=>/#. diff --git a/proof/smart_counter/Handle.eca b/proof/smart_counter/Handle.eca index 34e5df6..d87c985 100644 --- a/proof/smart_counter/Handle.eca +++ b/proof/smart_counter/Handle.eca @@ -1,22 +1,22 @@ pragma -oldip. pragma +implicits. require import Core Int Real StdOrder Ring IntExtra. require import List FSet SmtMap Common SLCommon. -require import DProd Dexcepted PROM. +require import DProd Dexcepted. +require import PROM. (*...*) import Capacity IntOrder DCapacity. -require (*--*) ConcreteF PROM. +require (*--*) ConcreteF. -clone export PROM.GenEager as ROhandle with - type from <- handle, - type to <- capacity, - op sampleto <- fun (_:int) => cdistr, - type input <- unit, - type output <- bool - proof sampleto_ll by apply DCapacity.dunifin_ll. +clone export PROM.FullRO as ROhandle with + type in_t <- handle, + type out_t <- capacity, + op dout _ <- cdistr, + type d_in_t <- unit, + type d_out_t <- bool. +export ROhandle.FullEager. clone export ConcreteF as ConcreteF1. - module G1(D:DISTINGUISHER) = { var m, mi : smap var mh, mhi : hsmap diff --git a/proof/smart_counter/SLCommon.ec b/proof/smart_counter/SLCommon.ec index 75541eb..ff3c7f8 100644 --- a/proof/smart_counter/SLCommon.ec +++ b/proof/smart_counter/SLCommon.ec @@ -3,7 +3,8 @@ length is the input block size. We prove its security even when padding is not prefix-free. **) require import Core Int Real StdOrder Ring IntExtra. -require import List FSet SmtMap Common PROM Distr DProd Dexcepted. +require import List FSet SmtMap Common Distr DProd Dexcepted. +require import PROM. require (*..*) Indifferentiability. (*...*) import Capacity IntOrder. @@ -39,13 +40,13 @@ op bl_univ = FSet.oflist bl_enum. (* -------------------------------------------------------------------------- *) (* Random oracle from block list to block *) -clone import PROM.GenEager as F with - type from <- block list, - type to <- block, - op sampleto <- fun (_:block list)=> bdistr, - type input <- unit, - type output <- bool - proof * by exact Block.DBlock.dunifin_ll. +clone import FullRO as F with + type in_t <- block list, + type out_t <- block, + op dout _ <- bdistr, + type d_in_t <- unit, + type d_out_t <- bool. +import FullEager. module Redo = { var prefixes : (block list, state) fmap From f03375f3a45a925e0b47182db6ffbf442ac3b588 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Mon, 6 Jul 2020 16:44:17 +0100 Subject: [PATCH 506/525] Follow 1.0 in sponge proof - Rewriting no longer performs head delta before matching - Rework of number libs and algebraic instances --- proof/Common.ec | 46 +++++++++++++++--------------- proof/SHA3Indiff.ec | 4 +-- proof/SHA3OSecurity.ec | 6 ++-- proof/SHA3Security.ec | 19 ++++++------ proof/SHA3_OIndiff.ec | 2 +- proof/SecureORO.eca | 18 ++++++------ proof/SecureRO.eca | 18 ++++++------ proof/Sponge.ec | 8 ++---- proof/smart_counter/ConcreteF.eca | 4 +-- proof/smart_counter/Gcol.eca | 6 ++-- proof/smart_counter/Gconcl.ec | 4 +-- proof/smart_counter/Gconcl_list.ec | 46 ++++++++++++++++-------------- proof/smart_counter/Gext.eca | 4 +-- proof/smart_counter/Handle.eca | 22 +++++++------- proof/smart_counter/SLCommon.ec | 40 ++++++++++++++------------ 15 files changed, 128 insertions(+), 119 deletions(-) diff --git a/proof/Common.ec b/proof/Common.ec index 60b759b..b756760 100644 --- a/proof/Common.ec +++ b/proof/Common.ec @@ -1,5 +1,5 @@ (*------------------- Common Definitions and Lemmas --------------------*) -require import Core Int IntExtra IntDiv Real List Distr. +require import Core Int IntDiv Real List Distr. require import Ring StdRing StdOrder StdBigop BitEncoding DProd. require (*--*) FinType BitWord PRP Monoid. (*---*) import IntID IntOrder Bigint Bigint.BIA IntDiv. @@ -250,7 +250,7 @@ proof. by rewrite last_cat last_mkpad. qed. lemma size_mkpad n : size (mkpad n) = num0 n + 2. proof. -rewrite /mkpad /= size_rcons size_nseq max_ler. +rewrite /mkpad /= size_rcons size_nseq ler_maxr. by rewrite /num0 modz_ge0 gtr_eqF ?gt0_r. by ring. qed. @@ -285,7 +285,7 @@ lemma index_true_behead_mkpad n : index true (behead (mkpad n)) = num0 n. proof. rewrite /mkpad -cats1 //= index_cat mem_nseq size_nseq. -by rewrite max_ler // /num0 modz_ge0 gtr_eqF ?gt0_r. +by rewrite ler_maxr // /num0 modz_ge0 gtr_eqF ?gt0_r. qed. lemma padE (s : bool list, n : int) : @@ -334,8 +334,8 @@ have [ge0_j lt_js]: 0 <= j < size s by move=> /#. rewrite -cats1 drop_cat lt_js /= /mkpad -cats1 -cat_cons; congr=> //=. rewrite size_take // size_cat /= ltr_spsaddr //= /num0 -iE. have sz_js: size (drop j s) = i+1; last apply/(eq_from_nth false). -+ by rewrite size_drop //= max_ler ?subr_ge0 ?ltrW // /j #ring. -+ by rewrite sz_js /= addrC size_nseq max_ler. ++ by rewrite size_drop //= ler_maxr ?subr_ge0 ?ltrW // /j #ring. ++ by rewrite sz_js /= addrC size_nseq ler_maxr. rewrite sz_js => k [ge0_k lt_kSi]; rewrite nth_drop //. move/ler_eqVlt: ge0_k => [<-|] /=. by rewrite jE -nth_rev ?nth_index // -index_mem size_rev. @@ -509,7 +509,7 @@ lemma extendK (xs : block list) (n : int) : last b0 xs <> b0 => 0 <= n => strip(extend xs n) = (xs, n). proof. move=> xs_ends_not_b0 ge0_n; rewrite /strip /extend /=. -rewrite rev_cat rev_nseq size_cat size_nseq max_ler // -addzA. +rewrite rev_cat rev_nseq size_cat size_nseq ler_maxr // -addzA. have head_rev_xs_neq_b0 : head b0 (rev xs) <> b0 by rewrite - last_rev revK //. have -> : rev xs = head b0 (rev xs) :: behead (rev xs). by rewrite head_behead //; case: (rev xs) head_rev_xs_neq_b0. @@ -518,7 +518,7 @@ have has_p_full : has p (nseq n b0 ++ head b0 (rev xs) :: behead (rev xs)) by apply has_cat; right; simplify; left. have not_has_p_nseq : ! has p (nseq n b0) by rewrite has_nseq. have -> : find p (nseq n b0 ++ head b0 (rev xs) :: behead (rev xs)) = n. - rewrite find_cat not_has_p_nseq /= size_nseq max_ler //. + rewrite find_cat not_has_p_nseq /= size_nseq ler_maxr //. have -> // : p (head b0 (rev xs)) by trivial. by rewrite (@addzC n) addNz /= take_size_cat. qed. @@ -532,8 +532,8 @@ have [ge0_i le_ixs]: 0 <= i <= size xs. by rewrite find_ge0 -size_rev find_size. have sz_drop: size (drop (size xs - i) xs) = i. rewrite size_drop ?subr_ge0 // opprD opprK. - by rewrite addrA /= max_ler. -apply/(eq_from_nth b0) => [|j]; rewrite ?size_nseq ?max_ler //. + by rewrite addrA /= ler_maxr. +apply/(eq_from_nth b0) => [|j]; rewrite ?size_nseq ?ler_maxr //. rewrite sz_drop=> -[ge0_j lt_ji]; rewrite nth_nseq //. rewrite nth_drop ?subr_ge0 // -{1}revK nth_rev ?size_rev. rewrite addr_ge0 ?subr_ge0 //= -ltr_subr_addr. @@ -571,9 +571,9 @@ split=> [vb | [s n] [rng_n b2b] b2b_xs_eq]. have [up _] := (unpadP (blocks2bits xs)). rewrite vb /= in up; case: up=> [s n rng_n _ b2b]. by apply (@ValidBlock xs s n). -rewrite unpadP (@Unpad (blocks2bits xs) s n) //. +rewrite /valid_block unpadP (@Unpad (blocks2bits xs) s n) //. have <- : size (blocks2bits xs) = size s + n + 2 - by rewrite b2b_xs_eq 3!size_cat /= size_nseq max_ler /#ring. + by rewrite b2b_xs_eq 3!size_cat /= size_nseq ler_maxr /#ring. by apply size_blocks2bits_dvd_r. qed. @@ -602,7 +602,7 @@ have last_b2b_xs_true : last true (blocks2bits xs) = true by rewrite b2b_xs_eq cats1 last_rcons. have last_b2b_xs_false : last true (blocks2bits xs) = false by rewrite xs_take_drop blocks2bits_cat blocks2bits_sing ofblockK - 1:size_nseq 1:max_ler 1:ge0_r // last_cat + 1:size_nseq 1:ler_maxr 1:ge0_r // last_cat last_nseq 1:gt0_r. by rewrite last_b2b_xs_true in last_b2b_xs_false. qed. @@ -637,14 +637,14 @@ have sz_drp : size drp = size s %% r. rewrite size_drop 1:mulr_ge0 1:divz_ge0 1:gt0_r 1:size_ge0 1:ge0_r. case (size s %/ r * r < size s)=> // not_lt_sz_s. - rewrite max_ler /#. + rewrite ler_maxr /#. have eq : size s %/ r * r = size s. rewrite -lezNgt in not_lt_sz_s; apply ler_asym; split=> //. by rewrite lez_floor gtr_eqF 1:gt0_r //. - rewrite max_lel /#. + rewrite ler_maxl /#. have sz_s_pad_dvd_r : r %| (size s + n + 2). have <- : size (s ++ [true] ++ nseq n false ++ [true]) = size s + n + 2 - by rewrite !size_cat /= size_nseq max_ler 1:ge0_n #ring. + by rewrite !size_cat /= size_nseq ler_maxr 1:ge0_n #ring. rewrite -b2b_xs_eq size_blocks2bits_dvd_r. have sz_tke_dvd_r : r %| size tke by rewrite sz_tke dvdz_mull dvdzz. have sz_drp_plus_n_plus_2_dvd_r : r %| (size drp + n + 2). @@ -657,7 +657,7 @@ have xs_eq : xs = bits2blocks(s ++ [true] ++ nseq n false ++ [true]) by rewrite -blocks2bitsK b2b_xs_eq. rewrite -(@cat_take_drop (size s %/ r * r) s) -!catA -/tke -/drp bits2blocks_cat in xs_eq. -+ rewrite sz_tke_dvd_r. rewrite !size_cat /= size_nseq max_ler 1:ge0_n. ++ rewrite sz_tke_dvd_r. rewrite !size_cat /= size_nseq ler_maxr 1:ge0_n. + have -> : size drp + (1 + (n + 1)) = size drp + n + 2 by ring. + rewrite sz_drp_plus_n_plus_2_dvd_r. case: (n = r - 1)=> [n_eq_r_min1 | n_neq_r_min1]. @@ -675,12 +675,12 @@ have sz_drp_plus1_eq_r : size drp + 1 = r. apply (@ValidBlockStruct2 xs (bits2blocks tke) (mkblock (drp ++ [true])) (mkblock (nseq n false ++ [true]))). rewrite xs_eq (@catA drp [true]) bits2blocks_cat 1:size_cat // - 1:size_cat 1:size_nseq 1:max_ler 1:ge0_n /= 1:/# + 1:size_cat 1:size_nseq 1:ler_maxr 1:ge0_n /= 1:/# (@bits2blocks_sing (drp ++ [true])) 1:size_cat // (@bits2blocks_sing (nseq n false ++ [true])) - 1:size_cat 1:size_nseq /= 1:max_ler 1:ge0_n /#. + 1:size_cat 1:size_nseq /= 1:ler_maxr 1:ge0_n /#. rewrite ofblockK 1:size_cat //= cats1 last_rcons. -rewrite n_eq_r_min1 ofblockK 1:size_cat //= size_nseq max_ler /#. +rewrite n_eq_r_min1 ofblockK 1:size_cat //= size_nseq ler_maxr /#. have lt_n_r_min1 : n < r - 1 by smt(). move: xs_eq. have sz_drp_plus_n_plus_2_eq_r : size drp + n + 2 = r. @@ -696,16 +696,16 @@ move=> xs_eq. rewrite (@bits2blocks_sing (drp ++ ([true] ++ (nseq n false ++ [true])))) in xs_eq. -+ rewrite !size_cat /= size_nseq max_ler 1:ge0_n 1:sz_drp. ++ rewrite !size_cat /= size_nseq ler_maxr 1:ge0_n 1:sz_drp. + have -> : size s %% r + (1 + (n + 1)) = size s %%r + n + 2 by ring. + by rewrite -sz_drp. apply (@ValidBlockStruct1 xs (bits2blocks tke) (mkblock (drp ++ ([true] ++ (nseq n false ++ [true])))) drp n)=> //. -by rewrite ofblockK 1:!size_cat /= 1:size_nseq 1:max_ler 1:ge0_n +by rewrite ofblockK 1:!size_cat /= 1:size_nseq 1:ler_maxr 1:ge0_n 1:-sz_drp_plus_n_plus_2_eq_r 1:#ring -!catA cat1s. have sz_w2b_x_eq_r : size (ofblock x) = r by apply size_block. -rewrite w2b_x_eq !size_cat /= size_nseq max_ler // in sz_w2b_x_eq_r. +rewrite w2b_x_eq !size_cat /= size_nseq ler_maxr // in sz_w2b_x_eq_r. have lt_nr : n < r by smt(size_ge0). apply (@ValidBlock xs (blocks2bits ys ++ s) n)=> //. by rewrite xs_eq blocks2bits_cat blocks2bits_sing w2b_x_eq -!catA. @@ -740,6 +740,6 @@ lemma nosmt valid_absorbP (xs : block list) : proof. rewrite /valid_absorb; split=> [strp_xs_valid | [ys n] ge0_n vb_ys ->]. by rewrite (@ValidAbsorb xs (strip xs).`1 (strip xs).`2) - 2:(@strip_ge0 xs) 2:(@stripK xs). + 2:(@strip_ge0 xs) // -/(extend (strip xs).`1 (strip xs).`2) (@stripK xs). by rewrite -/(extend ys n) extendK 1:valid_block_ends_not_b0. qed. diff --git a/proof/SHA3Indiff.ec b/proof/SHA3Indiff.ec index 94a2d64..5cf8ea9 100644 --- a/proof/SHA3Indiff.ec +++ b/proof/SHA3Indiff.ec @@ -277,7 +277,7 @@ lemma security &m : (limit ^ 2 - limit)%r / (2 ^ (r + c + 1))%r + (4 * limit ^ 2)%r / (2 ^ c)%r. proof. rewrite -(replace_simulator &m). -rewrite powS 1:addz_ge0 1:ge0_r 1:ge0_c -pow_add 1:ge0_r 1:ge0_c. +rewrite exprS 1:addz_ge0 1:ge0_r 1:ge0_c exprDn 1:ge0_r 1:ge0_c. have -> : (limit ^ 2 - limit)%r / (2 * (2 ^ r * 2 ^ c))%r = ((limit ^ 2 - limit)%r / 2%r) * (1%r / (2 ^ r)%r) * (1%r / (2 ^ c)%r). @@ -288,7 +288,7 @@ have -> : limit%r * ((2 * limit)%r / (2 ^ c)%r) + limit%r * ((2 * limit)%r / (2 ^ c)%r). have -> : 4 = 2 * 2 by trivial. have {3}-> : 2 = 1 + 1 by trivial. - rewrite powS // pow1 /#. + rewrite exprS // expr1 /#. rewrite -/SLCommon.dstate /limit. cut->:=conclusion (Gconcl_list.SimLast(Gconcl.S)) (DRestr(Dist)) &m. cut//=:=(Gconcl_list.Real_Ideal (LowerDist(Dist)) _ &m). diff --git a/proof/SHA3OSecurity.ec b/proof/SHA3OSecurity.ec index 4272486..d513bf6 100644 --- a/proof/SHA3OSecurity.ec +++ b/proof/SHA3OSecurity.ec @@ -1,6 +1,6 @@ (* Top-level Proof of SHA-3 Security *) -require import AllCore Distr DList DBool List IntExtra IntDiv Dexcepted DProd SmtMap FSet. +require import AllCore Distr DList DBool List IntDiv Dexcepted DProd SmtMap FSet. require import Common SLCommon Sponge SHA3_OIndiff. require (****) SecureORO SecureHash. (*****) import OIndif. @@ -56,9 +56,9 @@ cut->:inv (2%r ^ size_out) = mu1 (dlist dbool size_out) (to_list x). rewrite StdBigop.Bigreal.BRM.big_const count_predT spec_dout=> {p}. have:=size_out_gt0; move/ltzW. move:size_out;apply intind=> //=. - - by rewrite powr0 iter0 //= fromint1. + - by rewrite RField.expr0 iter0 //= fromint1. move=> i hi0 rec. - by rewrite powrS//iterS// -rec; smt(). + by rewrite RField.exprS//iterS// -rec; smt(). rewrite -dout_equal_dlist dmap1E. apply mu_eq. by move=> l; rewrite /pred1/(\o); smt(to_listK). diff --git a/proof/SHA3Security.ec b/proof/SHA3Security.ec index 7273c65..216d29c 100644 --- a/proof/SHA3Security.ec +++ b/proof/SHA3Security.ec @@ -1,7 +1,8 @@ (* Top-level Proof of SHA-3 Security *) -require import AllCore Distr DList DBool List IntExtra IntDiv Dexcepted DProd SmtMap FSet. +require import AllCore Distr DList DBool List IntDiv Dexcepted DProd SmtMap FSet. require import Common SLCommon Sponge SHA3Indiff. +(*---*) import StdOrder.IntOrder. require (****) IndifRO_is_secure. module SHA3 (P : DPRIMITIVE) = { @@ -50,9 +51,9 @@ cut->:inv (2%r ^ size_out) = mu1 (dlist dbool size_out) (to_list x). rewrite StdBigop.Bigreal.BRM.big_const count_predT spec_dout=> {p}. have:=size_out_gt0; move/ltzW. move:size_out;apply intind=> //=. - - by rewrite powr0 iter0 //= fromint1. + - by rewrite RField.expr0 iter0 //= fromint1. move=> i hi0 rec. - by rewrite powrS//iterS// -rec; smt(). + by rewrite RField.exprS //iterS// -rec; smt(). rewrite -dout_equal_dlist dmap1E. apply mu_eq. by move=> l; rewrite /pred1/(\o); smt(to_listK). @@ -155,7 +156,7 @@ section Preimage. + by rewrite dprod_ll DBlock.dunifin_ll DCapacity.dunifin_ll. apply dexcepted_ll=>//=;rewrite-prod_ll. cut->:predT = predU (predC (rng m)) (rng m);1:rewrite predCU//=. - rewrite Distr.mu_disjoint 1:predCI//=StdRing.RField.addrC. + rewrite Distr.mu_disjoint 1:predCI//=RField.addrC. cut/=->:=StdOrder.RealOrder.ltr_add2l (mu (bdistr `*` cdistr) (rng m)) 0%r. rewrite Distr.witness_support/predC. move:nin_dom;apply absurd=>//=;rewrite negb_exists/==>hyp. @@ -380,7 +381,7 @@ section Preimage. - rewrite get_set_sameE oget_some H7 rangeSr. rewrite !size_map 1:size_ge0. rewrite (size_map _ (range 0 (size bs0{2}))) size_range /=. - rewrite max_ler 1:size_ge0 map_rcons /=get_set_sameE oget_some; congr. + rewrite ler_maxr 1:size_ge0 map_rcons /=get_set_sameE oget_some; congr. apply eq_in_map=> j. rewrite mem_range /==> [] [] hj1 hj2. by rewrite get_set_neqE //=; smt(). @@ -512,7 +513,7 @@ section SecondPreimage. + by rewrite dprod_ll DBlock.dunifin_ll DCapacity.dunifin_ll. apply dexcepted_ll=>//=;rewrite-prod_ll. cut->:predT = predU (predC (rng m)) (rng m);1:rewrite predCU//=. - rewrite Distr.mu_disjoint 1:predCI//=StdRing.RField.addrC. + rewrite Distr.mu_disjoint 1:predCI//=RField.addrC. cut/=->:=StdOrder.RealOrder.ltr_add2l (mu (bdistr `*` cdistr) (rng m)) 0%r. rewrite Distr.witness_support/predC. move:nin_dom;apply absurd=>//=;rewrite negb_exists/==>hyp. @@ -727,7 +728,7 @@ section SecondPreimage. - rewrite get_set_sameE oget_some H7 rangeSr. rewrite !size_map 1:size_ge0. rewrite (size_map _ (range 0 (size bs0{2}))) size_range /=. - rewrite max_ler 1:size_ge0 map_rcons /=get_set_sameE oget_some; congr. + rewrite ler_maxr 1:size_ge0 map_rcons /=get_set_sameE oget_some; congr. apply eq_in_map=> j. rewrite mem_range /==> [] [] hj1 hj2. by rewrite get_set_neqE //=; smt(). @@ -905,7 +906,7 @@ section Collision. + by rewrite dprod_ll DBlock.dunifin_ll DCapacity.dunifin_ll. apply dexcepted_ll=>//=;rewrite-prod_ll. cut->:predT = predU (predC (rng m)) (rng m);1:rewrite predCU//=. - rewrite Distr.mu_disjoint 1:predCI//=StdRing.RField.addrC. + rewrite Distr.mu_disjoint 1:predCI//=RField.addrC. cut/=->:=StdOrder.RealOrder.ltr_add2l (mu (bdistr `*` cdistr) (rng m)) 0%r. rewrite Distr.witness_support/predC. move:nin_dom;apply absurd=>//=;rewrite negb_exists/==>hyp. @@ -1119,7 +1120,7 @@ section Collision. - rewrite get_set_sameE oget_some H7 rangeSr. rewrite !size_map 1:size_ge0. rewrite (size_map _ (range 0 (size bs0{2}))) size_range /=. - rewrite max_ler 1:size_ge0 map_rcons /=get_set_sameE oget_some; congr. + rewrite ler_maxr 1:size_ge0 map_rcons /=get_set_sameE oget_some; congr. apply eq_in_map=> j. rewrite mem_range /==> [] [] hj1 hj2. by rewrite get_set_neqE //=; smt(). diff --git a/proof/SHA3_OIndiff.ec b/proof/SHA3_OIndiff.ec index d2723ce..4590e95 100644 --- a/proof/SHA3_OIndiff.ec +++ b/proof/SHA3_OIndiff.ec @@ -1,4 +1,4 @@ -require import AllCore List Int IntDiv IntExtra StdOrder Distr SmtMap FSet. +require import AllCore List Int IntDiv StdOrder Distr SmtMap FSet. require import Common Sponge. import BIRO. require (*--*) SLCommon Gconcl_list BlockSponge. diff --git a/proof/SecureORO.eca b/proof/SecureORO.eca index bcd0a01..a39eaa3 100644 --- a/proof/SecureORO.eca +++ b/proof/SecureORO.eca @@ -1,4 +1,6 @@ require import Int Distr Real SmtMap FSet Mu_mem. +require (*--*) StdOrder. +(*---*) import StdOrder.IntOrder. require (****) PROM FelTactic. @@ -130,9 +132,9 @@ section Preimage. (card (fdom RO.m) <= Bounder.bounder <= bound) =>//. - rewrite StdBigop.Bigreal.BRA.big_const List.count_predT List.Range.size_range. - rewrite IntExtra.Extrema.max_ler //=; 1:smt(bound_ge0). - rewrite-StdRing.RField.AddMonoid.iteropE-StdRing.RField.intmulpE; 1: smt(bound_ge0). - by rewrite StdRing.RField.intmulr; smt(). + rewrite ler_maxr //=; 1:smt(bound_ge0). + rewrite-RField.AddMonoid.iteropE-RField.intmulpE; 1: smt(bound_ge0). + by rewrite RField.intmulr; smt(). - inline*; auto=> /> &h. rewrite mem_rng_empty /= fdom0 fcards0 /=; smt(bound_ge0). - proc. @@ -284,9 +286,9 @@ section SecondPreimage. (card (fdom RO.m) - 1 <= Bounder.bounder <= bound /\ mess1 \in RO.m)=> {h} =>//. + rewrite StdBigop.Bigreal.BRA.big_const List.count_predT List.Range.size_range. - rewrite IntExtra.Extrema.max_ler //=; 1:smt(bound_ge0). - rewrite-StdRing.RField.AddMonoid.iteropE-StdRing.RField.intmulpE; 1: smt(bound_ge0). - by rewrite StdRing.RField.intmulr; smt(mu_bounded bound_ge0). + rewrite ler_maxr //=; 1:smt(bound_ge0). + rewrite-RField.AddMonoid.iteropE-RField.intmulpE; 1: smt(bound_ge0). + by rewrite RField.intmulr; smt(mu_bounded bound_ge0). + inline*; auto=> />. move=> &h r; rewrite mem_empty /= !mem_set mem_empty/= sampleto_full /=. rewrite get_set_sameE//= fdom_set fdom0 fset0U fcard1 /= rngE /=; split; 2: smt(bound_ge0). @@ -445,7 +447,7 @@ section Collision. (collision RO.m) [Bounder(RF(RO)).get: (card (fdom RO.m) <= Bounder.bounder < bound)] (card (fdom RO.m) <= Bounder.bounder <= bound)=> //. - + rewrite -StdBigop.Bigreal.BRA.mulr_suml StdRing.RField.mulrAC. + + rewrite -StdBigop.Bigreal.BRA.mulr_suml RField.mulrAC. rewrite StdOrder.RealOrder.ler_wpmul2r; 1: smt(mu_bounded). by rewrite StdBigop.Bigreal.sumidE //; smt(bound_ge0). + inline*; auto=> />. @@ -475,7 +477,7 @@ section Collision. rnd; skip=> /> &h bounder _ h _. rewrite (mu_mem (frng RO.m{h}) sampleto (mu1 sampleto witness)); 1: smt(sampleto_fu). rewrite StdOrder.RealOrder.ler_wpmul2r //. - by rewrite RealExtra.le_fromint; smt(le_card_frng_fdom). + by rewrite le_fromint; smt(le_card_frng_fdom). + move=> c; proc; inline*; auto; sp; if; last by auto; smt(). auto=> /> &h h1 h2 _ sample _. by rewrite fdom_set fcardU fcard1; smt(fcard_ge0). diff --git a/proof/SecureRO.eca b/proof/SecureRO.eca index 4510737..143ff55 100644 --- a/proof/SecureRO.eca +++ b/proof/SecureRO.eca @@ -1,4 +1,6 @@ require import Int Distr Real SmtMap FSet Mu_mem. +require (*--*) StdOrder. +(*---*) import StdOrder.IntOrder. require (****) PROM FelTactic. @@ -129,9 +131,9 @@ section Preimage. (card (fdom RO.m) <= Bounder.bounder <= bound) =>//. - rewrite StdBigop.Bigreal.BRA.big_const List.count_predT List.Range.size_range. - rewrite IntExtra.Extrema.max_ler //=; 1:smt(bound_gt0). - rewrite-StdRing.RField.AddMonoid.iteropE-StdRing.RField.intmulpE; 1: smt(bound_gt0). - by rewrite StdRing.RField.intmulr; smt(). + rewrite ler_maxr //=; 1:smt(bound_gt0). + rewrite-RField.AddMonoid.iteropE-RField.intmulpE; 1: smt(bound_gt0). + by rewrite RField.intmulr; smt(). - inline*; auto=> />. by rewrite mem_rng_empty /= fdom0 fcards0 /=; smt(bound_gt0). - proc. @@ -304,9 +306,9 @@ section SecondPreimage. (card (fdom RO.m) - 1 <= Bounder.bounder <= bound /\ mess1 \in RO.m)=> {h} =>//. + rewrite StdBigop.Bigreal.BRA.big_const List.count_predT List.Range.size_range. - rewrite IntExtra.Extrema.max_ler //=; 1:smt(bound_gt0). - rewrite-StdRing.RField.AddMonoid.iteropE-StdRing.RField.intmulpE; 1: smt(bound_gt0). - by rewrite StdRing.RField.intmulr; smt(mu_bounded bound_gt0). + rewrite ler_maxr //=; 1:smt(bound_gt0). + rewrite-RField.AddMonoid.iteropE-RField.intmulpE; 1: smt(bound_gt0). + by rewrite RField.intmulr; smt(mu_bounded bound_gt0). + inline*; auto=> />. move=> &h r; rewrite mem_empty /= !mem_set mem_empty/= sampleto_full /=. rewrite get_set_sameE//= fdom_set fdom0 fset0U fcard1 /= rngE /=; split; 2: smt(bound_gt0). @@ -478,7 +480,7 @@ section Collision. (collision RO.m) [Bounder(RO).get: (card (fdom RO.m) <= Bounder.bounder < bound)] (card (fdom RO.m) <= Bounder.bounder <= bound)=> //. - + rewrite -StdBigop.Bigreal.BRA.mulr_suml StdRing.RField.mulrAC. + + rewrite -StdBigop.Bigreal.BRA.mulr_suml RField.mulrAC. rewrite StdOrder.RealOrder.ler_wpmul2r; 1: smt(mu_bounded). by rewrite StdBigop.Bigreal.sumidE //; smt(bound_gt0). + inline*; auto=> />. @@ -509,7 +511,7 @@ section Collision. rnd; skip=> /> &h bounder _ h _. rewrite (mu_mem (frng RO.m{h}) sampleto (mu1 sampleto witness)); 1: smt(sampleto_fu). rewrite StdOrder.RealOrder.ler_wpmul2r //. - by rewrite RealExtra.le_fromint; smt(le_card_frng_fdom). + by rewrite le_fromint; smt(le_card_frng_fdom). + move=> c; proc; sp; if; auto; inline*; auto; sp; if; last by auto; smt(). auto=> /> &h d h1 _ h2 _ sample _. by rewrite fdom_set fcardU fcard1; smt(fcard_ge0). diff --git a/proof/Sponge.ec b/proof/Sponge.ec index 343e803..122cff2 100644 --- a/proof/Sponge.ec +++ b/proof/Sponge.ec @@ -1,8 +1,7 @@ (*------------------------- Sponge Construction ------------------------*) require import Core Int IntDiv Real List FSet SmtMap. -(*---*) import IntExtra. require import Distr DBool DList. -require import StdBigop StdOrder. import IntOrder. +require import Ring StdBigop StdOrder. import IntID IntOrder. require import Common PROM. require (*--*) IRO BlockSponge. @@ -1243,9 +1242,8 @@ have -> /# // : 0 <= n => 0 < n => iter n (( * ) (1%r / 2%r)) 1%r = inv (2 ^ n)%r. elim=> [// | i ge0_i IH _]. case: (i = 0)=> [-> /= | ne_i0]. -rewrite iter1 pow1 /#. -by rewrite iterS // IH 1:/# powS // RealExtra.fromintM - StdRing.RField.invfM. +rewrite iter1 expr1 /#. +by rewrite iterS // IH 1:/# exprS // fromintM RField.invfM. qed. (* module for adapting PrLoopSnoc_sample to block generation *) diff --git a/proof/smart_counter/ConcreteF.eca b/proof/smart_counter/ConcreteF.eca index 904f061..c913c9e 100644 --- a/proof/smart_counter/ConcreteF.eca +++ b/proof/smart_counter/ConcreteF.eca @@ -1,7 +1,7 @@ -require import Core Int Real StdOrder Ring Distr IntExtra. +require import Core Int Real StdOrder Ring Distr. require import List FSet SmtMap Common SLCommon DProd Dexcepted. -(*...*) import Capacity IntOrder RealOrder. +(*...*) import Capacity IntID IntOrder RealOrder. require (*..*) Strong_RP_RF. diff --git a/proof/smart_counter/Gcol.eca b/proof/smart_counter/Gcol.eca index 3edb93f..dc462ad 100644 --- a/proof/smart_counter/Gcol.eca +++ b/proof/smart_counter/Gcol.eca @@ -1,8 +1,8 @@ pragma -oldip. -require import Core Int Real RealExtra StdOrder Ring StdBigop IntExtra. +require import Core Int Real StdOrder Ring StdBigop. require import List FSet SmtMap Common SLCommon FelTactic Mu_mem. require import DProd Dexcepted PROM. -(*...*) import Capacity IntOrder Bigreal RealOrder BRA. +(*...*) import Capacity IntID IntOrder Bigreal RealOrder BRA. require (*..*) Handle. @@ -12,7 +12,7 @@ import ROhandle. (* TODO: move this *) lemma c_gt0r : 0%r < (2^c)%r. - proof. by rewrite lt_fromint;apply /powPos. qed. + proof. by rewrite lt_fromint; apply/IntOrder.expr_gt0. qed. lemma c_ge0r : 0%r <= (2^c)%r. proof. by apply /ltrW/c_gt0r. qed. diff --git a/proof/smart_counter/Gconcl.ec b/proof/smart_counter/Gconcl.ec index 12d4767..4bbd724 100644 --- a/proof/smart_counter/Gconcl.ec +++ b/proof/smart_counter/Gconcl.ec @@ -1,8 +1,8 @@ pragma -oldip. -require import Core Int Real RealExtra StdOrder Ring StdBigop IntExtra. +require import Core Int Real StdOrder Ring StdBigop. require import List FSet SmtMap Common SLCommon FelTactic Mu_mem. require import DProd Dexcepted PROM. -(*...*) import Capacity IntOrder Bigreal RealOrder BRA. +(*...*) import Capacity IntID IntOrder Bigreal RealOrder BRA. require (*..*) Gext. diff --git a/proof/smart_counter/Gconcl_list.ec b/proof/smart_counter/Gconcl_list.ec index 6158e27..8378743 100644 --- a/proof/smart_counter/Gconcl_list.ec +++ b/proof/smart_counter/Gconcl_list.ec @@ -1,8 +1,8 @@ pragma -oldip. -require import Core Int Real RealExtra StdOrder Ring StdBigop IntExtra. +require import Core Int Real StdOrder Ring StdBigop. require import List FSet SmtMap Common SLCommon PROM FelTactic Mu_mem. require import Distr DProd Dexcepted BlockSponge Gconcl. -(*...*) import Capacity IntOrder Bigreal RealOrder BRA. +(*...*) import Capacity IntID IntOrder Bigreal RealOrder BRA. require (*--*) Handle. @@ -1033,13 +1033,13 @@ section Real. + move=>l;rewrite mem_set;case;1:smt(all_prefixes_of_INV_real get_setE). move=>->>j[]hj0 hjsize;rewrite get_setE/=. cut:=hmp1 (format bl (i - 1));rewrite domE H_p_val/==>help. - cut:=hjsize;rewrite !size_cat !size_nseq/=!max_ler 1:/#=>hjsizei. + cut:=hjsize;rewrite !size_cat !size_nseq/=!ler_maxr 1:/#=>hjsizei. cut->/=:!take j (format bl i) = format bl i by smt(size_take). cut h:forall k, 0 <= k <= size bl + i - 2 => take k (format bl (i - 1)) = take k (format bl i). * move=>k[]hk0 hkjS;rewrite !take_cat;case(k//=hksize;congr. - apply (eq_from_nth witness);1:rewrite!size_take//=1,2:/#!size_nseq!max_ler/#. - rewrite!size_take//=1:/#!size_nseq!max_ler 1:/#. + apply (eq_from_nth witness);1:rewrite!size_take//=1,2:/#!size_nseq!ler_maxr/#. + rewrite!size_take//=1:/#!size_nseq!ler_maxr 1:/#. pose o:=if _ then _ else _;cut->/={o}:o = k - size bl by smt(). by progress;rewrite!nth_take//= 1,2:/# !nth_nseq//=/#. case(j < size bl + i - 2)=>hj. @@ -1153,7 +1153,7 @@ section Real. move=>[]j[][]hj0 hjsize ->>. cut:=Hisize;rewrite size_take 1:/#. pose k:=if _ then _ else _;cut->>Hij{k}:k=j by rewrite/#. - by rewrite!take_take!min_lel 1,2:/# nth_take 1,2:/#;smt(domE). + by rewrite!take_take!minrE 1:nth_take 1,2:/#;smt(domE). - smt(get_setE oget_some domE take_oversize). while( ={i0,p0,i,p,n,nb,bl,sa,sc,lres,C.c,glob Redo,glob Perm} /\ n{1} = nb{1} /\ p{1} = bl{1} /\ p0{1} = p{1} /\ 0 <= i0{1} <= size p{1} @@ -1212,7 +1212,7 @@ section Real. move=>j; case(0 <= j)=>hj0; rewrite mem_set. * case: (j <= i0{2}) => hjmax; 2:smt(take_oversize size_take). left; have-> : take j (take (i0{2}+1) bl{2}) = take j (take i0{2} bl{2}). - * by rewrite 2!take_take min_lel 1:/# min_lel. + * by rewrite 2!take_take !minrE /#. by apply H8; rewrite domE H1. rewrite take_le0 1:/#; left. by rewrite-(take0 (take i0{2} bl{2})) H8 domE H1. @@ -1227,7 +1227,8 @@ section Real. - move:H15;apply absurd=>//=_;rewrite mem_set. pose x:=_ = _;cut->/={x}:x=false by smt(size_take). move:H12;apply absurd=>//=. - cut:=take_take bl{2}(i0{2} + 1)(i0{2} + 1 + 1);rewrite min_lel 1:/# =><-h. + cut:=take_take bl{2}(i0{2} + 1)(i0{2} + 1 + 1). + rewrite minrE (: i0{2} + 1 <= i0{2} + 1 + 1) 1:/#=><-h. by rewrite (H8 _ h). - move=>l;rewrite!mem_set;case=>[H_dom|->>]/=;1:smt(mem_set). move=>j;rewrite mem_set. @@ -1236,7 +1237,8 @@ section Real. by rewrite-(take0 (take i0{2} bl{2})) H8 domE H1. case(j < i0{2} + 1)=>hjiS;2:smt(domE take_take). rewrite take_take/min hjiS//=;left. - cut:=(take_take bl{2} j i0{2});rewrite min_lel 1:/#=><-. + cut:=(take_take bl{2} j i0{2}). + rewrite minrE (: j <= i0{2}) 1:/#=><-. smt(all_prefixes_of_INV_real domE). - smt(get_setE domE mem_set). sp;case(0 < n{1});last first. @@ -1331,7 +1333,7 @@ section Real. /\ Redo.prefixes{1}.[format p{1} (i1{1} - size p{1} + 1)] = Some (sa0{1}, sc0{1}));progress. + smt(). - + by move: H8; rewrite size_cat size_nseq /= max_ler /#. + + by move: H8; rewrite size_cat size_nseq /= ler_maxr /#. + move:H8;rewrite size_cat size_nseq/=/max H0/=;smt(). splitwhile{1}1:i1 < size p;splitwhile{2}1:i1 < size p. while(={nb,bl,n,p,p1,i,i1,lres,sa0,sc0,C.c,glob Redo,glob Perm} @@ -1510,27 +1512,27 @@ section Real. + sp;rcondf{2}1;auto;progress. + rewrite head_nth nth_drop//=. cut[]_[]_ hmp1 _ :=H2;cut:=hmp1 _ H5 i0{m} _;1:smt(size_take). - move=>[]b3 c3;rewrite!take_take!nth_take 1,2:/# !min_lel//= 1:/#. + move=>[]b3 c3;rewrite!take_take!nth_take 1,2:/# !minrE //= (: i0{m} <= i0{m} + 1) 1:/#. rewrite H1=>//=[][][]->>->>. by rewrite nth_onth (onth_nth b0)//=;smt(domE). + rewrite head_nth nth_drop//=. cut[]_[]_ hmp1 _ :=H2;cut:=hmp1 _ H5 i0{1} _;1:smt(size_take). - move=>[]b3 c3;rewrite!take_take!nth_take 1,2:/# !min_lel//= 1:/#. + move=>[]b3 c3;rewrite!take_take!nth_take 1,2:/# !minrE//= (: i0{1} <= i0{1} + 1) 1:/#. rewrite H1=>//=[][][]->>->>. by rewrite nth_onth (onth_nth b0)//=;smt(domE). + rewrite head_nth nth_drop//=. cut[]_[]_ hmp1 _ :=H2;cut:=hmp1 _ H5 i0{1} _;1:smt(size_take). - move=>[]b3 c3;rewrite!take_take!nth_take 1,2:/# !min_lel//= 1:/#. + move=>[]b3 c3;rewrite!take_take!nth_take 1,2:/# !minrE //= (: i0{1} <= i0{1} + 1) 1:/#. rewrite H1=>//=[][][]->>->>. by rewrite nth_onth (onth_nth b0)//=;smt(domE). + rewrite head_nth nth_drop//=. cut[]_[]_ hmp1 _ :=H2;cut:=hmp1 _ H5 i0{1} _;1:smt(size_take). - move=>[]b3 c3;rewrite!take_take!nth_take 1,2:/# !min_lel//= 1:/#. + move=>[]b3 c3;rewrite!take_take!nth_take 1,2:/# !minrE //= (: i0{1} <= i0{1} + 1) 1:/#. rewrite H1=>//=[][][]->>->>. by rewrite nth_onth (onth_nth b0)//=;smt(domE). + rewrite head_nth nth_drop//=. cut[]_[]_ hmp1 _ :=H2;cut:=hmp1 _ H5 i0{1} _;1:smt(size_take). - move=>[]b3 c3;rewrite!take_take!nth_take 1,2:/# !min_lel//= 1:/#. + move=>[]b3 c3;rewrite!take_take!nth_take 1,2:/# !minrE //= (: i0{1} <= i0{1} + 1) 1:/#. rewrite H1=>//=[][][]->>->>. by rewrite nth_onth (onth_nth b0)//=;smt(domE). + smt(). @@ -1619,13 +1621,13 @@ section Real. /\ valid p{1});last first. + if{1};auto. + rcondf{2}1;auto;progress. - + move:H5;rewrite take_oversize;1:rewrite size_cat size_nseq max_ler/#. + + move:H5;rewrite take_oversize;1:rewrite size_cat size_nseq ler_maxr/#. move=>H_dom;rewrite domE. by cut<-:=lemma4 _ _ _ _ _ _ _ _ _ H3 H H2 H_dom;rewrite-domE. - + move:H5;rewrite take_oversize;1:rewrite size_cat size_nseq max_ler/#;move=>H_dom. + + move:H5;rewrite take_oversize;1:rewrite size_cat size_nseq ler_maxr/#;move=>H_dom. by cut:=lemma4 _ _ _ _ _ _ _ _ _ H3 H H2 H_dom;smt(domE). + smt(). - + move:H5;rewrite take_oversize;1:rewrite size_cat size_nseq max_ler/#;move=>H_dom. + + move:H5;rewrite take_oversize;1:rewrite size_cat size_nseq ler_maxr/#;move=>H_dom. by cut:=lemma4 _ _ _ _ _ _ _ _ _ H3 H H2 H_dom;smt(domE). sp;if;auto;progress. + move:H6;rewrite nth_cat nth_nseq;1:smt(size_ge0). @@ -1676,14 +1678,14 @@ section Real. + smt(). + move:H9;rewrite take_format/=1:/#;1:smt(size_ge0 size_cat size_nseq). pose x := if _ then _ else _ ;cut->/={x}: x = format p{1} (i_R+1). - + rewrite/x size_cat size_nseq/=!max_ler 1:/#-(addzA _ _ (-1))-(addzA _ _ (-1))/=. + + rewrite/x size_cat size_nseq/=!ler_maxr 1:/#-(addzA _ _ (-1))-(addzA _ _ (-1))/=. case(size p{1} + i_R <= size p{1})=>//=h;2:smt(size_ge0 size_cat size_nseq). cut->>/=:i_R = 0 by smt(). by rewrite take_size/format nseq0 cats0. by rewrite H3/==>[][]->>->>. + move:H9;rewrite take_format/=1:/#;1:smt(size_ge0 size_cat size_nseq). pose x := if _ then _ else _ ;cut->/={x}: x = format p{1} (i_R+1). - + rewrite/x size_cat size_nseq/=!max_ler 1:/#-(addzA _ _ (-1))-(addzA _ _ (-1))/=. + + rewrite/x size_cat size_nseq/=!ler_maxr 1:/#-(addzA _ _ (-1))-(addzA _ _ (-1))/=. case(size p{1} + i_R <= size p{1})=>//=h;2:smt(size_ge0 size_cat size_nseq). cut->>/=:i_R = 0 by smt(). by rewrite take_size/format nseq0 cats0. @@ -1809,7 +1811,7 @@ section Real_Ideal_Abs. + by rewrite dprod_ll DBlock.dunifin_ll DCapacity.dunifin_ll. apply dexcepted_ll=>//=;rewrite-prod_ll. cut->:predT = predU (predC (rng m)) (rng m);1:rewrite predCU//=. - rewrite Distr.mu_disjoint 1:predCI//=StdRing.RField.addrC. + rewrite Distr.mu_disjoint 1:predCI//= RField.addrC. cut/=->:=ltr_add2l (mu (bdistr `*` cdistr) (rng m)) 0%r. rewrite Distr.witness_support/predC. move:nin_dom;apply absurd=>//=;rewrite negb_exists/==>hyp. @@ -1903,7 +1905,7 @@ section Real_Ideal_Abs. cut := neg_D_concl &m. pose p1 := Pr[IdealIndif(BIRO.IRO, SimLast(S), DRestr(D)).main() @ &m : res]. pose p2 := Pr[RealIndif(Sponge, Perm, DRestr(D)).main() @ &m : res]. - rewrite-5!(StdRing.RField.addrA). + rewrite-5!(RField.addrA). pose p3 := (max_size ^ 2)%r / 2%r / (2 ^ r)%r / (2 ^ c)%r + (max_size%r * ((2 * max_size)%r / (2 ^ c)%r) + max_size%r * ((2 * max_size)%r / (2 ^ c)%r)). diff --git a/proof/smart_counter/Gext.eca b/proof/smart_counter/Gext.eca index 977508e..d46799e 100644 --- a/proof/smart_counter/Gext.eca +++ b/proof/smart_counter/Gext.eca @@ -1,8 +1,8 @@ pragma -oldip. -require import Core Int Real RealExtra StdOrder Ring StdBigop IntExtra. +require import Core Int Real StdOrder Ring StdBigop. require import List FSet SmtMap Common SLCommon FelTactic Mu_mem. require import DProd Dexcepted PROM. -(*...*) import Capacity IntOrder Bigreal RealOrder BRA DCapacity. +(*...*) import Capacity IntID IntOrder Bigreal RealOrder BRA DCapacity. require (*..*) Gcol. diff --git a/proof/smart_counter/Handle.eca b/proof/smart_counter/Handle.eca index d87c985..44d8e98 100644 --- a/proof/smart_counter/Handle.eca +++ b/proof/smart_counter/Handle.eca @@ -1,9 +1,9 @@ pragma -oldip. pragma +implicits. -require import Core Int Real StdOrder Ring IntExtra. +require import Core Int Real StdOrder Ring. require import List FSet SmtMap Common SLCommon. require import DProd Dexcepted. require import PROM. -(*...*) import Capacity IntOrder DCapacity. +(*...*) import Capacity IntID IntOrder DCapacity. require (*--*) ConcreteF. @@ -1336,7 +1336,7 @@ proof. move=>inv0 hi take_i1_p_in_prefixes prefixes_sa_sc build_hpath_i_p ro_prefix hs_h_sc_f. cut[]_ _ m_prefix _:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. cut[]b1 c1[]:=m_prefix _ take_i1_p_in_prefixes i _;1:smt(size_take). -rewrite!take_take!min_lel 1,2:/# nth_take 1,2:/# prefixes_sa_sc/==>[][<-<-]{b1 c1}Pm_prefix. +rewrite!take_take!minrE //= (: i <= i + 1) 1:/# nth_take 1,2:/# prefixes_sa_sc/==>[][<-<-]{b1 c1}Pm_prefix. cut[]hh1 hh2 hh3:=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. move:ro_prefix;cut{1}->:=(take_nth witness i p);1:smt(size_take);move=>h1. cut:=hh2 (take i p) (nth witness p i) (oget prefixes.[take (i + 1) p]).`1. @@ -1846,7 +1846,7 @@ proof. move=>Hinv H_size H_take_iS H_take_i H_hs_h. cut[]_ _ H _ _:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ Hinv. cut[]sa sc:=H _ H_take_iS i _;1:smt(size_take). -rewrite!take_take !min_lel//= 1:/# nth_take 1,2:/#H_take_i=>[][]/=[->>->>] H_pm. +rewrite!take_take !minrE (: i <= i + 1) 1: /# nth_take 1,2:/#H_take_i=>[][]/=[->>->>] H_pm. cut[]b' c' H_Pm:exists b' c', Pm.[(sa +^ nth witness p i, sc)] = Some (b',c'). + rewrite H_pm. exists (oget prefixes.[take (i + 1) p]).`1 (oget prefixes.[take (i + 1) p]).`2. by move: H_take_iS; rewrite domE; case: (prefixes.[take (i + 1) p])=> //= - []. @@ -2040,7 +2040,7 @@ proof. move=>[]b2 c2 h2[]H_PFm H_Gmh. rewrite H_Gmh/=. cut[]b6 c6[]:=H_pref1 _ H12 i{2} _;1:smt(size_take). - by rewrite!take_take !min_lel 1,2:/# nth_take 1,2:/# H2/==>[][]->>->><-;rewrite H_PFm oget_some. + by rewrite!take_take !minrE (: i{2} <= i{2} + 1) //= 1:/# nth_take 1,2:/# H2/==>[][]->>->><-;rewrite H_PFm oget_some. - rewrite/#. - cut[]HINV[]->>/=[]->>/=[]H_h[]H_path H_F_RO:=H6 H11. cut[]H01 H02 H_pref1 H_pref2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. @@ -2051,7 +2051,7 @@ proof. * rewrite/#. move=>[]b2 c2 h2[]H_PFm H_Gmh. cut[]b6 c6[]:=H_pref1 _ H12 i{2} _;1:smt(size_take). - rewrite!take_take !min_lel 1,2:/# nth_take 1,2:/# H2/=H_Gmh oget_some=>[][]<<-<<-<-. + rewrite!take_take !minrE (: i{2} <= i{2} + 1) // 1:/# nth_take 1,2:/# H2/=H_Gmh oget_some=>[][]<<-<<-<-. rewrite H_PFm oget_some/=. cut [] help1 help2:= m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + by have [] xc fx yc fy [#] /# := help2 _ _ _ _ H_Gmh. @@ -2075,7 +2075,7 @@ proof. * rewrite/#. move=>[]b2 c2 h2[]H_PFm H_Gmh. cut[]b6 c6[]:=H_pref1 _ H12 i{2} _;1:smt(size_take). - rewrite!take_take !min_lel 1,2:/# nth_take 1,2:/# H2/==>[][]<<-<<-<-. + rewrite!take_take !minrE (: i{2} <= i{2} + 1) 1:/# nth_take 1,2:/# H2/==>[][]<<-<<-<-. rewrite H_PFm/=(@take_nth witness)1:/#. by cut[]help1 help2/# :=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. @@ -2176,7 +2176,8 @@ proof. cut->/=:(if i{2} + 1 < size bs{1} then i{2} + 1 else size bs{1}) = i{2} + 1 by rewrite/#. move=>[]H0j HjiS;rewrite!get_setE. cut->/=:! take j (take (i{2} + 1) bs{1}) = take (i{2} + 1) bs{1} by smt(size_take). - rewrite!take_take!min_lel 1,2:/# nth_take 2:/#;1:smt(prefix_ge0). + rewrite!take_take!minrE (: j <= i{2} + 1) 1:/# (: j + 1 <= i{2} + 1) 1:/#. + rewrite nth_take 2:/#;1:smt(prefix_ge0). case(j < i{2})=>Hij. - cut->/=:!take (j + 1) bs{1} = take (i{2} + 1) bs{1} by smt(size_take). by cut:=Hmp1(take i{2} bs{1}) _ j _; @@ -2397,7 +2398,7 @@ proof. rewrite negb_exists/=;progress;rewrite !negb_and. by cut[]/#:=H_hs_spec. cut[]eq_xor ->>:=h_eq. - move:h;rewrite h_eq/==>->>. + move:h;rewrite eq_xor/==>->>. cut/#:!(p0 = (take i{2} bs{1}) /\ bn = (nth witness bs{1} i{2})) => F.RO.m{2}.[rcons p0 bn] = Some b0. move:H_h;case:f=>h_flag;last first. @@ -2497,7 +2498,8 @@ proof. cut->/=:(if i{2} + 1 < size bs{1} then i{2} + 1 else size bs{1}) = i{2} + 1 by rewrite/#. move=>HjiS;rewrite!get_setE. cut->/=:! take j (take (i{2} + 1) bs{1}) = take (i{2} + 1) bs{1} by smt(size_take). - rewrite!take_take!min_lel 1,2:/# nth_take 2:/#;1:smt(prefix_ge0). + rewrite!take_take!minrE (: j <= i{2} + 1) 1:/# (: j + 1 <= i{2} + 1) 1:/#. + rewrite nth_take 2:/#;1:smt(prefix_ge0). case(j < i{2})=>Hij. - cut->/=:!take (j + 1) bs{1} = take (i{2} + 1) bs{1} by smt(size_take). by cut:=Hmp1(take i{2} bs{1}) _ j _;smt(domE take_take nth_take prefix_ge0 size_take get_setE). diff --git a/proof/smart_counter/SLCommon.ec b/proof/smart_counter/SLCommon.ec index ff3c7f8..76cecbf 100644 --- a/proof/smart_counter/SLCommon.ec +++ b/proof/smart_counter/SLCommon.ec @@ -2,7 +2,7 @@ functionality is a fixed-output-length random oracle whose output length is the input block size. We prove its security even when padding is not prefix-free. **) -require import Core Int Real StdOrder Ring IntExtra. +require import Core Int Real StdOrder Ring. require import List FSet SmtMap Common Distr DProd Dexcepted. require import PROM. @@ -170,7 +170,7 @@ lemma build_hpath_map0 p: build_hpath empty p = if p = [] then Some (b0,0) else None. proof. elim/last_ind: p=> //= p b _. -by rewrite -{1}cats1 foldl_cat {1}/step_hpath /= emptyE /= [smt(size_rcons size_ge0)]. +by rewrite -{1}cats1 /build_hpath foldl_cat {1}/step_hpath /= emptyE /= [smt(size_rcons size_ge0)]. qed. (* -------------------------------------------------------------------------- *) @@ -243,14 +243,14 @@ case: (i <= j)=> Hij. move=> [Hk0 Hki]. by rewrite !nth_take /#. case: (0 < j)=> //= Hj0; last smt(take_le0). -rewrite min_ler 1:/#. +rewrite (: min i j = j) 1:minrE 1:/#. by rewrite take_oversize //= size_take /#. qed. lemma prefix_take_leq (l1 l2 : 'a list) (i : int) : i <= prefix l1 l2 => take i l1 = take i l2. proof. -move=> Hi; have ->: i = min i (prefix l1 l2) by smt(min_lel). +move=> Hi; have ->: i = min i (prefix l1 l2) by smt(minrE). by rewrite -(take_take l1 i _) -(take_take l2 i _) prefix_take. qed. @@ -512,7 +512,8 @@ cut:prefix (take i l1) l2 <= prefix l1 l2. + rewrite-{2}(cat_take_drop i l1) prefix_leq_prefix_cat. cut/#:prefix l1 l2 <= prefix (take i l1) l2. rewrite -prefix_take_prefix. -rewrite-(cat_take_drop (prefix l1 l2) (take i l1))take_take min_lel// prefix_leq_prefix_cat. +rewrite-(cat_take_drop (prefix l1 l2) (take i l1))take_take minrE hi //=. +by rewrite prefix_leq_prefix_cat. qed. lemma get_max_prefix_take (l : 'a list) (ll : 'a list list) i : @@ -1018,7 +1019,7 @@ op has (P : 'a -> 'b -> bool) (m : ('a,'b) fmap) = lemma hasP (P : 'a -> 'b -> bool) (m : ('a,'b) fmap): has P m <=> exists x, x \in m /\ P x (oget m.[x]). proof. -rewrite hasP; split=> [] [x] [#]. +rewrite /has hasP; split=> [] [x] [#]. + by move=> _ x_in_m Pxmx; exists x. by move=> x_in_m Pxmx; exists x; rewrite -memE mem_fdom. qed. @@ -1029,7 +1030,7 @@ op find (P : 'a -> 'b -> bool) (m : ('a,'b) fmap) = lemma find_none (P : 'a -> 'b -> bool) (m : ('a,'b) fmap): has P m <=> find P m <> None. proof. -rewrite has_find; split=> [h|]. +rewrite /find /has has_find; split=> [h|]. + by rewrite (onth_nth witness) 1:find_ge0 /=. by apply/contraLR=> h; rewrite onth_nth_map nth_default 1:size_map 1:lezNgt. qed. @@ -1066,23 +1067,24 @@ lemma hinvP handles c: if hinv handles c = None then forall h f, handles.[h] <> Some(c,f) else exists f, handles.[oget (hinv handles c)] = Some(c,f). proof. - cut @/pred1@/(\o)/=[[h []->[]Hmem <<-]|[]->H h f]/= := - findP (fun (_ : handle) => pred1 c \o fst) handles. - + exists (oget handles.[h]).`2. - by move: Hmem; rewrite domE; case: (handles.[h])=> //= - []. - by cut := H h;rewrite domE /#. +move=> @/hinv. +cut @/pred1@/(\o)/=[[h []->[]Hmem <<-]|[]->H h f]/= := + findP (fun (_ : handle) => pred1 c \o fst) handles. ++ exists (oget handles.[h]).`2. + by move: Hmem; rewrite domE; case: (handles.[h])=> //= - []. +by cut := H h;rewrite domE /#. qed. lemma huniq_hinv (handles:handles) (h:handle): huniq handles => dom handles h => hinv handles (oget handles.[h]).`1 = Some h. proof. - move=> Huniq;pose c := (oget handles.[h]).`1. - cut:=Huniq h;cut:=hinvP handles c. - case (hinv _ _)=> /=[Hdiff _| h' +/(_ h')]. - + rewrite domE /=; move: (Hdiff h (oget handles.[h]).`2). - by rewrite /c; case: handles.[h]=> //= - []. - move=> [f ->] /(_ (oget handles.[h]) (c,f)) H1 H2;rewrite H1 //. - by move: H2; rewrite domE; case: (handles.[h]). +move=> Huniq;pose c := (oget handles.[h]).`1. +cut:=Huniq h;cut:=hinvP handles c. +case (hinv _ _)=> /=[Hdiff _| h' +/(_ h')]. ++ rewrite domE /=; move: (Hdiff h (oget handles.[h]).`2). + by rewrite /c; case: handles.[h]=> //= - []. +move=> [f ->] /(_ (oget handles.[h]) (c,f)) H1 H2;rewrite H1 //. +by move: H2; rewrite domE; case: (handles.[h]). qed. lemma hinvKP handles c: From dbcd358f8125cccd0b58a854c4f80c73a2137563 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Sun, 29 Nov 2020 06:56:21 +0000 Subject: [PATCH 507/525] Fix Sponge proof --- proof/SHA3Indiff.ec | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/proof/SHA3Indiff.ec b/proof/SHA3Indiff.ec index 5cf8ea9..2675d66 100644 --- a/proof/SHA3Indiff.ec +++ b/proof/SHA3Indiff.ec @@ -277,7 +277,7 @@ lemma security &m : (limit ^ 2 - limit)%r / (2 ^ (r + c + 1))%r + (4 * limit ^ 2)%r / (2 ^ c)%r. proof. rewrite -(replace_simulator &m). -rewrite exprS 1:addz_ge0 1:ge0_r 1:ge0_c exprDn 1:ge0_r 1:ge0_c. +rewrite exprSr 1:addz_ge0 1:ge0_r 1:ge0_c mulrC exprD_nneg 1:ge0_r 1:ge0_c. have -> : (limit ^ 2 - limit)%r / (2 * (2 ^ r * 2 ^ c))%r = ((limit ^ 2 - limit)%r / 2%r) * (1%r / (2 ^ r)%r) * (1%r / (2 ^ c)%r). From c141ca75815afabb09e3473003db0d0112c9a8bc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Sun, 13 Dec 2020 10:01:43 +0000 Subject: [PATCH 508/525] Partial fix for sponge Can't dive into prefix-based hell right now. --- proof/Common.ec | 9 +-------- proof/SHA3Indiff.ec | 4 +--- proof/SHA3OSecurity.ec | 9 ++++++--- proof/SecureORO.eca | 3 ++- proof/SecureRO.eca | 3 ++- proof/Sponge.ec | 5 ++--- 6 files changed, 14 insertions(+), 19 deletions(-) diff --git a/proof/Common.ec b/proof/Common.ec index b756760..601c889 100644 --- a/proof/Common.ec +++ b/proof/Common.ec @@ -586,14 +586,7 @@ move: bp=> [s n] _ b2b_xs_eq. case: (last b0 xs <> b0)=> [// | last_xs_eq_b0]. rewrite negbK in last_xs_eq_b0. have xs_non_nil : xs <> []. - case: xs b2b_xs_eq last_xs_eq_b0 vb_xs=> // contrad. - rewrite blocks2bits_nil in contrad. - have contrad_last : - false = last false (s ++ [true] ++ nseq n false ++ [true]). - have {1}-> : false = last false [] by trivial. - by rewrite {1}contrad. - rewrite last_cat /= in contrad_last. - elim contrad_last. + by case: xs b2b_xs_eq last_xs_eq_b0 vb_xs. elim (last_drop_all_but_last b0 xs)=> // drop_xs. have xs_take_drop : xs = take (size xs - 1) xs ++ drop (size xs - 1) xs by rewrite cat_take_drop. diff --git a/proof/SHA3Indiff.ec b/proof/SHA3Indiff.ec index 2675d66..db7cfd0 100644 --- a/proof/SHA3Indiff.ec +++ b/proof/SHA3Indiff.ec @@ -184,7 +184,6 @@ wp; sp. call (_ : ={Perm.m, Perm.mi}); first sim. auto. auto; progress; by rewrite blocks2bits_nil. -auto. qed. lemma drestr_commute2 &m : @@ -222,8 +221,7 @@ inline RaiseFun(BlockSponge.BIRO.IRO).f. wp; sp. call (_ : ={BlockSponge.BIRO.IRO.mp}); first sim. auto. -auto; progress. by rewrite blocks2bits_nil. -auto. +by auto. qed. op wit_pair : block * capacity = witness. diff --git a/proof/SHA3OSecurity.ec b/proof/SHA3OSecurity.ec index d513bf6..10b041a 100644 --- a/proof/SHA3OSecurity.ec +++ b/proof/SHA3OSecurity.ec @@ -643,7 +643,8 @@ cut->: inline{1} 1; inline{2} 1; sp; sim; if; 1: auto; sim. by call eq_eager_ideal2; auto. rewrite eq_sym; byequiv=> //=; proc. -call(RO_LRO_D Dist dbool_ll); inline*; auto=> />. +call(RO_LRO_D Dist _); first by rewrite dbool_ll. +by inline*; auto=> />. qed. local lemma rw_ideal_2 &m: @@ -1403,7 +1404,8 @@ cut->: inline{1} 1; inline{2} 1; sp; sim; if; 1: auto; sim. by call eq_eager_ideal2; auto. rewrite eq_sym; byequiv=> //=; proc. -by call(RO_LRO_D Dist dbool_ll); inline*; auto=> />. +call(RO_LRO_D Dist _); first by rewrite dbool_ll. +by inline*; auto=> />. qed. @@ -2281,7 +2283,8 @@ cut->: inline{1} 1; inline{2} 1; sp; sim; if; 1: auto; sim. by call eq_eager_ideal2; auto. rewrite eq_sym; byequiv=> //=; proc. -by call(RO_LRO_D Dist dbool_ll); inline*; auto=> />. +call(RO_LRO_D Dist _); first by rewrite dbool_ll. +by inline*; auto=> />. qed. local equiv toto : diff --git a/proof/SecureORO.eca b/proof/SecureORO.eca index a39eaa3..f6c47d8 100644 --- a/proof/SecureORO.eca +++ b/proof/SecureORO.eca @@ -263,7 +263,8 @@ section SecondPreimage. Pr [ SecondPreimage3(A,RO).main(mess1) @ &m : res ]. - rewrite eq_sym. byequiv=>//=; proc. - by call(RO_LRO_D (D1(A)) sampleto_ll); inline*; auto. + call(RO_LRO_D (D1(A)) _); first by rewrite sampleto_ll. + by inline*; auto. by byequiv=> //=; proc; inline*; wp -2 18; sim. byphoare(: arg = mess1 ==> _)=>//=; proc. seq 1 : (rng (rem RO.m mess1) (oget RO.m.[mess1])) diff --git a/proof/SecureRO.eca b/proof/SecureRO.eca index 143ff55..1725115 100644 --- a/proof/SecureRO.eca +++ b/proof/SecureRO.eca @@ -283,7 +283,8 @@ section SecondPreimage. Pr [ SecondPreimage3(A,RO).main(mess1) @ &m : res ]. - rewrite eq_sym. byequiv=>//=; proc. - by call(RO_LRO_D (D1(A)) sampleto_ll); inline*; auto. + call(RO_LRO_D (D1(A)) _); first by rewrite sampleto_ll. + by inline*; auto. by byequiv=> //=; proc; inline*; wp -2 18; sim. byphoare(: arg = mess1 ==> _)=>//=; proc. seq 1 : (rng (rem RO.m mess1) (oget RO.m.[mess1])) diff --git a/proof/Sponge.ec b/proof/Sponge.ec index 122cff2..1b68af3 100644 --- a/proof/Sponge.ec +++ b/proof/Sponge.ec @@ -391,7 +391,7 @@ local lemma LRO_RO (D <: ERO.RO_Distinguisher{ERO.RO, ERO.FRO}) &m : proof. byequiv=> //; proc. seq 1 1 : (={glob D, ERO.RO.m}); first sim. -symmetry; call (RO_LRO_D D dbool_ll); auto. +by symmetry; call (RO_LRO_D D _); auto; rewrite dbool_ll. qed. (* make a Hybrid IRO out of a random oracle *) @@ -1639,8 +1639,7 @@ rcondf{2} 1; first auto; progress; by rewrite -lezNgt needed_blocks_non_pos ltzW. rcondf{1} 1; first auto; progress; by rewrite -lezNgt pmulr_lle0 1:gt0_r needed_blocks_non_pos ltzW. -auto; progress; - [by rewrite blocks2bits_nil | by smt(needed_blocks0)]. +by auto; progress; smt(needed_blocks0). (* 0 <= n1 *) conseq (_ : From 1fbaff80c3f40f67fa6b35630e04542904c15e8f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Tue, 2 Mar 2021 11:36:33 +0000 Subject: [PATCH 509/525] Almost following HEAD Tracking down an issue with pRHL producing ill-formed formulas --- proof/BlockSponge.ec | 2 +- proof/Common.ec | 2 +- proof/IndifRO_is_secure.ec | 18 +- proof/SHA3Indiff.ec | 10 +- proof/SHA3Security.ec | 70 ++-- proof/SecureRO.eca | 28 +- proof/Sponge.ec | 10 +- proof/smart_counter/ConcreteF.eca | 26 +- proof/smart_counter/Gcol.eca | 20 +- proof/smart_counter/Gconcl.ec | 7 +- proof/smart_counter/Gconcl_list.ec | 338 +++++++++---------- proof/smart_counter/Gext.eca | 6 +- proof/smart_counter/Handle.eca | 512 ++++++++++++++--------------- proof/smart_counter/SLCommon.ec | 72 ++-- 14 files changed, 567 insertions(+), 554 deletions(-) diff --git a/proof/BlockSponge.ec b/proof/BlockSponge.ec index 9baad40..2000adc 100644 --- a/proof/BlockSponge.ec +++ b/proof/BlockSponge.ec @@ -40,7 +40,7 @@ qed. lemma parse_valid p: valid_block p => parse p = (p,1). proof. -move=>h;cut{1}->:p=format p 1;2:smt(parseK). +move=>h;have{1}->:p=format p 1;2:smt(parseK). by rewrite/format/=nseq0 cats0. qed. diff --git a/proof/Common.ec b/proof/Common.ec index 601c889..a844fbb 100644 --- a/proof/Common.ec +++ b/proof/Common.ec @@ -154,7 +154,7 @@ have -> : (n + r - 1) %/r * r = (n + r - 1) - (n + r - 1)%% r have -> : n + r - 1 - (n + r - 1) %% r - n = r - 1 - (n + r - 1) %% r by ring. rewrite ltzE -(@ler_add2r (-r)) /=. -cut -> : r - 1 - (n + r - 1) %% r + 1 - r = -(n + r - 1) %% r by ring. +have -> : r - 1 - (n + r - 1) %% r + 1 - r = -(n + r - 1) %% r by ring. by rewrite oppz_le0 modz_ge0 gtr_eqF 1:gt0_r. qed. diff --git a/proof/IndifRO_is_secure.ec b/proof/IndifRO_is_secure.ec index 3b1de8c..aa2a625 100644 --- a/proof/IndifRO_is_secure.ec +++ b/proof/IndifRO_is_secure.ec @@ -107,13 +107,13 @@ section Collision. bound + ((limit * (limit - 1) + 2)%r / 2%r * mu1 sampleto witness). proof. move=>[] S [] S_ll Hbound. - cut->: Pr[Collision(A, FM(C,P)).main() @ &m : res] = + have->: Pr[Collision(A, FM(C,P)).main() @ &m : res] = Pr[GReal(C, P, DColl(A)).main() @ &m : res]. + byequiv=>//=; proc; inline*; wp; sim. by swap{1} [1..2] 2; sim. - cut/#:Pr[GIdeal(RO, S, DColl(A)).main() @ &m : res] <= + have/#:Pr[GIdeal(RO, S, DColl(A)).main() @ &m : res] <= (limit * (limit - 1) + 2)%r / 2%r * mu1 sampleto witness. - cut->:Pr[GIdeal(RO, S, DColl(A)).main() @ &m : res] = + have->:Pr[GIdeal(RO, S, DColl(A)).main() @ &m : res] = Pr[Collision(A, SRO.RO.RO).main() @ &m : res]. + byequiv=>//=; proc; inline DColl(A, RO, S(RO)).distinguish; wp; sim. inline*; swap{2} 1 1; wp. @@ -153,13 +153,13 @@ section Preimage. bound + (limit + 1)%r * mu1 sampleto hash. proof. move=>init_hash [] S [] S_ll Hbound. - cut->: Pr[Preimage(A, FM(C,P)).main(hash) @ &m : res] = + have->: Pr[Preimage(A, FM(C,P)).main(hash) @ &m : res] = Pr[GReal(C, P, DPre(A)).main() @ &m : res]. + byequiv=>//=; proc; inline*; wp; sp; wp; sim. by swap{2} [1..2] 4; sim; auto; smt(). - cut/#:Pr[GIdeal(RO, S, DPre(A)).main() @ &m : res] <= + have/#:Pr[GIdeal(RO, S, DPre(A)).main() @ &m : res] <= (limit + 1)%r * mu1 sampleto hash. - cut->:Pr[GIdeal(RO, S, DPre(A)).main() @ &m : res] = + have->:Pr[GIdeal(RO, S, DPre(A)).main() @ &m : res] = Pr[Preimage(A, SRO.RO.RO).main(hash) @ &m : res]. + byequiv=>//=; proc; inline DPre(A, RO, S(RO)).distinguish; wp; sim. inline*; swap{2} 1 1; wp; sim; auto. @@ -199,13 +199,13 @@ section SecondPreimage. bound + (limit + 1)%r * mu1 sampleto witness. proof. move=>init_mess [] S [] S_ll Hbound. - cut->: Pr[SecondPreimage(A, FM(C,P)).main(mess) @ &m : res] = + have->: Pr[SecondPreimage(A, FM(C,P)).main(mess) @ &m : res] = Pr[GReal(C, P, D2Pre(A)).main() @ &m : res]. + byequiv=>//=; proc; inline*; wp; sp; wp; sim. by swap{2} [1..2] 3; sim; auto; smt(). - cut/#:Pr[GIdeal(RO, S, D2Pre(A)).main() @ &m : res] <= + have/#:Pr[GIdeal(RO, S, D2Pre(A)).main() @ &m : res] <= (limit + 1)%r * mu1 sampleto witness. - cut->:Pr[GIdeal(RO, S, D2Pre(A)).main() @ &m : res] = + have->:Pr[GIdeal(RO, S, D2Pre(A)).main() @ &m : res] = Pr[SecondPreimage(A, SRO.RO.RO).main(mess) @ &m : res]. + byequiv=>//=; proc; inline D2Pre(A, RO, S(RO)).distinguish; wp; sim. inline*; swap{2} 1 1; wp; sim; auto. diff --git a/proof/SHA3Indiff.ec b/proof/SHA3Indiff.ec index db7cfd0..7afdf98 100644 --- a/proof/SHA3Indiff.ec +++ b/proof/SHA3Indiff.ec @@ -288,16 +288,16 @@ have -> : have {3}-> : 2 = 1 + 1 by trivial. rewrite exprS // expr1 /#. rewrite -/SLCommon.dstate /limit. -cut->:=conclusion (Gconcl_list.SimLast(Gconcl.S)) (DRestr(Dist)) &m. -cut//=:=(Gconcl_list.Real_Ideal (LowerDist(Dist)) _ &m). +have->:=conclusion (Gconcl_list.SimLast(Gconcl.S)) (DRestr(Dist)) &m. +have//=:=(Gconcl_list.Real_Ideal (LowerDist(Dist)) _ &m). + move=>F P hp hpi hf'//=. - cut hf:islossless RaiseFun(F).f. + have hf:islossless RaiseFun(F).f. - proc;call hf';auto. exact(Dist_lossless (RaiseFun(F)) P hp hpi hf). rewrite(drestr_commute1 &m) (drestr_commute2 &m). -cut->:=Gconcl_list.Simplify_simulator (LowerDist(Dist)) _ &m. +have->:=Gconcl_list.Simplify_simulator (LowerDist(Dist)) _ &m. + move=>F P hp hpi hf'//=. - cut hf:islossless RaiseFun(F).f. + have hf:islossless RaiseFun(F).f. - proc;call hf';auto. exact(Dist_lossless (RaiseFun(F)) P hp hpi hf). smt(). diff --git a/proof/SHA3Security.ec b/proof/SHA3Security.ec index 216d29c..a7cd8b2 100644 --- a/proof/SHA3Security.ec +++ b/proof/SHA3Security.ec @@ -39,12 +39,12 @@ axiom dout_equal_dlist : dmap dout to_list = dlist dbool size_out. lemma doutE1 x : mu1 dout x = inv (2%r ^ size_out). proof. -cut->:inv (2%r ^ size_out) = mu1 (dlist dbool size_out) (to_list x). +have->:inv (2%r ^ size_out) = mu1 (dlist dbool size_out) (to_list x). + rewrite dlist1E. - smt(size_out_gt0). rewrite spec_dout/=. pose p:= StdBigop.Bigreal.BRM.big _ _ _. - cut->: p = StdBigop.Bigreal.BRM.big predT (fun _ => inv 2%r) (to_list x). + have->: p = StdBigop.Bigreal.BRM.big predT (fun _ => inv 2%r) (to_list x). - rewrite /p =>{p}. apply StdBigop.Bigreal.BRM.eq_bigr. by move=> i; rewrite//= dbool1E. @@ -152,18 +152,18 @@ section Preimage. Prefix.invm m mi => ! a \in m => Distr.is_lossless ((bdistr `*` cdistr) \ rng m). proof. move=>hinvm nin_dom. - cut prod_ll:Distr.is_lossless (bdistr `*` cdistr). + have prod_ll:Distr.is_lossless (bdistr `*` cdistr). + by rewrite dprod_ll DBlock.dunifin_ll DCapacity.dunifin_ll. apply dexcepted_ll=>//=;rewrite-prod_ll. - cut->:predT = predU (predC (rng m)) (rng m);1:rewrite predCU//=. + have->:predT = predU (predC (rng m)) (rng m);1:rewrite predCU//=. rewrite Distr.mu_disjoint 1:predCI//=RField.addrC. - cut/=->:=StdOrder.RealOrder.ltr_add2l (mu (bdistr `*` cdistr) (rng m)) 0%r. + have/=->:=StdOrder.RealOrder.ltr_add2l (mu (bdistr `*` cdistr) (rng m)) 0%r. rewrite Distr.witness_support/predC. move:nin_dom;apply absurd=>//=;rewrite negb_exists/==>hyp. - cut{hyp}hyp:forall x, rng m x by smt(supp_dprod DBlock.supp_dunifin DCapacity.supp_dunifin). + have{hyp}hyp:forall x, rng m x by smt(supp_dprod DBlock.supp_dunifin DCapacity.supp_dunifin). move:a. - cut:=eqEcard (fdom m) (frng m);rewrite leq_card_rng_dom/=. - cut->//=:fdom m \subset frng m. + have:=eqEcard (fdom m) (frng m);rewrite leq_card_rng_dom/=. + have->//=:fdom m \subset frng m. + by move=> x; rewrite mem_fdom mem_frng hyp. smt(mem_fdom mem_frng). qed. @@ -244,8 +244,8 @@ section Preimage. - smt(). - exact(dout_ll). - have[] h[#] h1 h2 := H. - cut->:i_R = size_out by smt(). - cut<-:=h2 _ H3. + have->:i_R = size_out by smt(). + have<-:=h2 _ H3. smt(to_listK). rcondt{1} 2; 1: auto; wp =>/=. exists* BIRO.IRO.mp{2}; elim* => mp. @@ -366,7 +366,7 @@ section Preimage. - by rewrite size_cat/=. - by rewrite mem_set; left; rewrite H3. - rewrite get_setE (H4 _ _ H11). - cut/#: !(l1, j) = (x0{2}, size bs0{2}). + have/#: !(l1, j) = (x0{2}, size bs0{2}). move:H2; apply absurd=> //=[#] <<- ->>. have[] h1 [] h2 h3 := H1. by apply h2; smt(). @@ -405,7 +405,7 @@ section Preimage. rewrite(preimage_resistant_if_indifferentiable A A_ll (CSetSize(Sponge)) Perm &m ha init_ha). exists (SimSetSize(Simulator))=>//=; split. + by move=> F _; proc; inline*; auto. - cut->//:Pr[Indiff0.Indif(CSetSize(Sponge, Perm), Perm, DPre(A)).main() @ &m : res] = + have->//:Pr[Indiff0.Indif(CSetSize(Sponge, Perm), Perm, DPre(A)).main() @ &m : res] = Pr[RealIndif(Sponge, Perm, DRestr(DSetSize(DPre(A)))).main() @ &m : res]. + byequiv=>//=; proc. inline DPre(A, CSetSize(Sponge, Perm), Perm).distinguish. @@ -434,7 +434,7 @@ section Preimage. by call(equiv_sponge_perm c1 m); auto; smt(). auto; progress. by rewrite /invm=> x y; rewrite 2!emptyE. - cut->//:Pr[Indiff0.Indif(RO, SimSetSize(Simulator, RO), DPre(A)).main() @ &m : res] = + have->//:Pr[Indiff0.Indif(RO, SimSetSize(Simulator, RO), DPre(A)).main() @ &m : res] = Pr[IdealIndif(BIRO.IRO, Simulator, DRestr(DSetSize(DPre(A)))).main() @ &m : res]. + byequiv=>//=; proc. inline Simulator(FGetSize(RO)).init RO.init Simulator(BIRO.IRO).init @@ -509,18 +509,18 @@ section SecondPreimage. Prefix.invm m mi => ! a \in m => Distr.is_lossless ((bdistr `*` cdistr) \ rng m). proof. move=>hinvm nin_dom. - cut prod_ll:Distr.is_lossless (bdistr `*` cdistr). + have prod_ll:Distr.is_lossless (bdistr `*` cdistr). + by rewrite dprod_ll DBlock.dunifin_ll DCapacity.dunifin_ll. apply dexcepted_ll=>//=;rewrite-prod_ll. - cut->:predT = predU (predC (rng m)) (rng m);1:rewrite predCU//=. + have->:predT = predU (predC (rng m)) (rng m);1:rewrite predCU//=. rewrite Distr.mu_disjoint 1:predCI//=RField.addrC. - cut/=->:=StdOrder.RealOrder.ltr_add2l (mu (bdistr `*` cdistr) (rng m)) 0%r. + have/=->:=StdOrder.RealOrder.ltr_add2l (mu (bdistr `*` cdistr) (rng m)) 0%r. rewrite Distr.witness_support/predC. move:nin_dom;apply absurd=>//=;rewrite negb_exists/==>hyp. - cut{hyp}hyp:forall x, rng m x by smt(supp_dprod DBlock.supp_dunifin DCapacity.supp_dunifin). + have{hyp}hyp:forall x, rng m x by smt(supp_dprod DBlock.supp_dunifin DCapacity.supp_dunifin). move:a. - cut:=eqEcard (fdom m) (frng m);rewrite leq_card_rng_dom/=. - cut->//=:fdom m \subset frng m. + have:=eqEcard (fdom m) (frng m);rewrite leq_card_rng_dom/=. + have->//=:fdom m \subset frng m. + by move=> x; rewrite mem_fdom mem_frng hyp. smt(mem_fdom mem_frng). qed. @@ -591,8 +591,8 @@ section SecondPreimage. - smt(). - exact(dout_ll). - have[] h[#] h1 h2 := H. - cut->:i_R = size_out by smt(). - cut<-:=h2 _ H3. + have->:i_R = size_out by smt(). + have<-:=h2 _ H3. smt(to_listK). rcondt{1} 2; 1: auto; wp =>/=. exists* BIRO.IRO.mp{2}; elim* => mp. @@ -713,7 +713,7 @@ section SecondPreimage. - by rewrite size_cat/=. - by rewrite mem_set; left; rewrite H3. - rewrite get_setE (H4 _ _ H11). - cut/#: !(l1, j) = (x0{2}, size bs0{2}). + have/#: !(l1, j) = (x0{2}, size bs0{2}). move:H2; apply absurd=> //=[#] <<- ->>. have[] h1 [] h2 h3 := H1. by apply h2; smt(). @@ -752,7 +752,7 @@ section SecondPreimage. rewrite(second_preimage_resistant_if_indifferentiable A A_ll (CSetSize(Sponge)) Perm &m mess init_mess). exists (SimSetSize(Simulator)); split. + by move=> F _; proc; inline*; auto. - cut->:Pr[Indiff0.Indif(CSetSize(Sponge, Perm), Perm, D2Pre(A)).main() @ &m : res] = + have->:Pr[Indiff0.Indif(CSetSize(Sponge, Perm), Perm, D2Pre(A)).main() @ &m : res] = Pr[RealIndif(Sponge, Perm, DRestr(DSetSize(D2Pre(A)))).main() @ &m : res]. + byequiv=>//=; proc. inline Perm.init CSetSize(Sponge, Perm).init Sponge(Perm).init @@ -810,7 +810,7 @@ section SecondPreimage. by call(equiv_sponge_perm c1 m); auto; smt(). inline*; auto; progress. by rewrite /invm=> x y; rewrite 2!emptyE. - cut->:Pr[Indiff0.Indif(RO, SimSetSize(Simulator, RO), D2Pre(A)).main() @ &m : res] = + have->:Pr[Indiff0.Indif(RO, SimSetSize(Simulator, RO), D2Pre(A)).main() @ &m : res] = Pr[IdealIndif(BIRO.IRO, Simulator, DRestr(DSetSize(D2Pre(A)))).main() @ &m : res]. + byequiv=>//=; proc. inline Simulator(FGetSize(RO)).init RO.init Simulator(BIRO.IRO).init @@ -902,18 +902,18 @@ section Collision. Prefix.invm m mi => ! a \in m => Distr.is_lossless ((bdistr `*` cdistr) \ rng m). proof. move=>hinvm nin_dom. - cut prod_ll:Distr.is_lossless (bdistr `*` cdistr). + have prod_ll:Distr.is_lossless (bdistr `*` cdistr). + by rewrite dprod_ll DBlock.dunifin_ll DCapacity.dunifin_ll. apply dexcepted_ll=>//=;rewrite-prod_ll. - cut->:predT = predU (predC (rng m)) (rng m);1:rewrite predCU//=. + have->:predT = predU (predC (rng m)) (rng m);1:rewrite predCU//=. rewrite Distr.mu_disjoint 1:predCI//=RField.addrC. - cut/=->:=StdOrder.RealOrder.ltr_add2l (mu (bdistr `*` cdistr) (rng m)) 0%r. + have/=->:=StdOrder.RealOrder.ltr_add2l (mu (bdistr `*` cdistr) (rng m)) 0%r. rewrite Distr.witness_support/predC. move:nin_dom;apply absurd=>//=;rewrite negb_exists/==>hyp. - cut{hyp}hyp:forall x, rng m x by smt(supp_dprod DBlock.supp_dunifin DCapacity.supp_dunifin). + have{hyp}hyp:forall x, rng m x by smt(supp_dprod DBlock.supp_dunifin DCapacity.supp_dunifin). move:a. - cut:=eqEcard (fdom m) (frng m);rewrite leq_card_rng_dom/=. - cut->//=:fdom m \subset frng m. + have:=eqEcard (fdom m) (frng m);rewrite leq_card_rng_dom/=. + have->//=:fdom m \subset frng m. + by move=> x; rewrite mem_fdom mem_frng hyp. smt(mem_fdom mem_frng). qed. @@ -983,8 +983,8 @@ section Collision. - smt(). - exact(dout_ll). - have[] h[#] h1 h2 := H. - cut->:i_R = size_out by smt(). - cut<-:=h2 _ H3. + have->:i_R = size_out by smt(). + have<-:=h2 _ H3. smt(to_listK). rcondt{1} 2; 1: auto; wp =>/=. exists* BIRO.IRO.mp{2}; elim* => mp. @@ -1105,7 +1105,7 @@ section Collision. - by rewrite size_cat/=. - by rewrite mem_set; left; rewrite H3. - rewrite get_setE (H4 _ _ H11). - cut/#: !(l1, j) = (x0{2}, size bs0{2}). + have/#: !(l1, j) = (x0{2}, size bs0{2}). move:H2; apply absurd=> //=[#] <<- ->>. have[] h1 [] h2 h3 := H1. by apply h2; smt(). @@ -1142,7 +1142,7 @@ section Collision. rewrite (coll_resistant_if_indifferentiable A A_ll (CSetSize(Sponge)) Perm &m). exists (SimSetSize(Simulator)); split. + by move=> F _; proc; inline*; auto. - cut->:Pr[Indiff0.Indif(CSetSize(Sponge, Perm), Perm, DColl(A)).main() @ &m : res] = + have->:Pr[Indiff0.Indif(CSetSize(Sponge, Perm), Perm, DColl(A)).main() @ &m : res] = Pr[RealIndif(Sponge, Perm, DRestr(DSetSize(DColl(A)))).main() @ &m : res]. + byequiv=>//=; proc. inline Perm.init CSetSize(Sponge, Perm).init Sponge(Perm).init @@ -1193,7 +1193,7 @@ section Collision. by call(equiv_sponge_perm c1 m); auto; smt(). inline*; auto; progress. by rewrite /invm=> x y; rewrite 2!emptyE. - cut->:Pr[Indiff0.Indif(RO, SimSetSize(Simulator, RO), DColl(A)).main() @ &m : res] = + have->:Pr[Indiff0.Indif(RO, SimSetSize(Simulator, RO), DColl(A)).main() @ &m : res] = Pr[IdealIndif(BIRO.IRO, Simulator, DRestr(DSetSize(DColl(A)))).main() @ &m : res]. + byequiv=>//=; proc. inline Simulator(FGetSize(RO)).init RO.init Simulator(BIRO.IRO).init diff --git a/proof/SecureRO.eca b/proof/SecureRO.eca index 1725115..c261f1d 100644 --- a/proof/SecureRO.eca +++ b/proof/SecureRO.eca @@ -112,7 +112,7 @@ section Preimage. lemma RO_is_preimage_resistant &m (h : to) : Pr [ Preimage(A,RO).main(h) @ &m : res ] <= (bound + 1)%r * mu1 sampleto h. proof. - cut->: Pr [ Preimage (A,RO).main(h) @ &m : res ] = + have->: Pr [ Preimage (A,RO).main(h) @ &m : res ] = Pr [ Preimage2(A,RO).main(h) @ &m : res ]. + by byequiv=> //=; proc; inline*; sim. byphoare(: arg = h ==> _) => //=; proc. @@ -141,10 +141,10 @@ section Preimage. if; last by hoare; auto; progress; smt(mu_bounded). case: (x \in RO.m); wp => //=. + by hoare; auto; smt(mu_bounded). - rnd (pred1 h); auto=> /> &h c ????????. - rewrite rngE/= => hh [] a; rewrite get_setE. + rnd (pred1 h); auto=> /> &h c ge0_c lt_c_bound h_notin_rngRO le_sRO_c le_c_bound Hcount x_notin_RO v _. + rewrite rngE=> /= - [] a; rewrite get_setE. case: (a=x{h}) => [->>|] //=. - by move:H1; rewrite rngE /= negb_exists/= => /(_ a) //=. + by move:h_notin_rngRO; rewrite rngE /= negb_exists/= => /(_ a) //=. - move=> c; proc; inline*; sp; if; sp. + if; auto; progress. + smt(). @@ -178,8 +178,8 @@ section Preimage. - hoare; auto; progress. rewrite H3/=; move: H1; rewrite rngE /= negb_exists /=. by have:=H3; rewrite domE; smt(). - rnd (pred1 h); auto=> //= &hr [#]->>??<<-????. - by rewrite H3 /= get_setE /=; smt(). + rnd (pred1 h); auto=> //= &hr [#]->>H0 H1<<-H2 H3 H4 H5 H6. + by rewrite H4 /= get_setE /=; smt(). smt(). qed. @@ -297,7 +297,7 @@ section SecondPreimage. - proc; inline*; auto; sp; if; sp; auto; if; last by auto; smt(). auto=> /> &h c Hc _ Hdom Hc2 _ sample. by rewrite sampleto_full/=!fdom_set !fcardU !fcard1;smt(mem_set fcard_ge0). - auto=> /> &h sample. + auto=> /> sample. by rewrite mem_set mem_empty/= fdom_set fdom0 fset0U fcard1; smt(bound_gt0). + call(: arg = mess1 ==> rng (rem RO.m mess1) (oget RO.m.[mess1])); auto. bypr=> {&m} &m h; rewrite h. @@ -310,8 +310,8 @@ section SecondPreimage. rewrite ler_maxr //=; 1:smt(bound_gt0). rewrite-RField.AddMonoid.iteropE-RField.intmulpE; 1: smt(bound_gt0). by rewrite RField.intmulr; smt(mu_bounded bound_gt0). - + inline*; auto=> />. - move=> &h r; rewrite mem_empty /= !mem_set mem_empty/= sampleto_full /=. + + inline*; auto=> /> r. + rewrite mem_empty /= !mem_set mem_empty/= sampleto_full /=. rewrite get_set_sameE//= fdom_set fdom0 fset0U fcard1 /= rngE /=; split; 2: smt(bound_gt0). by rewrite negb_exists/= => a; rewrite remE get_setE //= emptyE; smt(). + proc; inline*; sp; if; last by hoare; auto. @@ -351,7 +351,7 @@ section SecondPreimage. rcondt 3; 1: auto. swap 3 -2; sp. case: (SecondPreimage2.m2 \in RO.m). - - rcondf 5; 1: auto; hoare; auto=> /> &h d _ _ in_dom1 not_rng _ in_dom2. + - rcondf 5; 1: auto; hoare; auto=> /> &h d _ _ in_dom1 not_rng _ _ in_dom2. move=> sample2 _ sample1 _; rewrite negb_and/=. move: not_rng; rewrite rngE /= negb_exists /= => /(_ SecondPreimage2.m2{h}). rewrite remE; case: (SecondPreimage2.m2{h} = m1{h})=> //=. @@ -472,7 +472,7 @@ section Collision. + by move=> />; smt(mu_bounded). + inline*; wp; call(: card (fdom RO.m) <= Bounder.bounder <= bound); auto. - proc; inline*; sp; if; auto; sp; if; last by auto; smt(). - auto=> /> &h d Hbc _ _ Hcb sample _; split. + auto=> /> &h d Hbc _ Hcb _ sample _; split. * by move=> nin_dom1; rewrite fdom_set fcardU fcard1; smt(fcard_ge0). by move=> in_dom1; smt(). by move=> />; rewrite fdom0 fcards0; smt(bound_gt0). @@ -509,15 +509,15 @@ section Collision. have:= Hcoll2; rewrite negb_exists /= => /(_ m1). rewrite negb_exists /= => /(_ m2). by rewrite neq in_dom1 in_dom2 /= => ->. - rnd; skip=> /> &h bounder _ h _. + rnd; skip=> /> &h c0 bounder _ h _. rewrite (mu_mem (frng RO.m{h}) sampleto (mu1 sampleto witness)); 1: smt(sampleto_fu). rewrite StdOrder.RealOrder.ler_wpmul2r //. by rewrite le_fromint; smt(le_card_frng_fdom). + move=> c; proc; sp; if; auto; inline*; auto; sp; if; last by auto; smt(). - auto=> /> &h d h1 _ h2 _ sample _. + auto=> /> &h d h1 _ h2 sample _. by rewrite fdom_set fcardU fcard1; smt(fcard_ge0). move=> b c; proc; inline*; sp; if; auto; sp; if; auto; 2: smt(). - move=> /> &h h1 h2 _ _ _ sample _. + move=> /> &h h1 h2 _ h3 _ sample _. by rewrite fdom_set fcardU fcard1; smt(fcard_ge0). qed. diff --git a/proof/Sponge.ec b/proof/Sponge.ec index 1b68af3..e7f6f21 100644 --- a/proof/Sponge.ec +++ b/proof/Sponge.ec @@ -107,7 +107,7 @@ case: (n{1} <= 0). + by auto; smt(size_ge0). rcondf{1} 3; 1:by auto. rcondf{2} 1. - + by auto=> /> &hr _ /needed_blocks_non_pos /#. + + by auto=> /> &hr /needed_blocks_non_pos /#. by auto=> /> &1 &2 _ n_le0; rewrite !take_le0. while ( ={glob P, z, n, sa, sc} /\ (finished{1} <=> n{1} <= size z{1}) @@ -1778,7 +1778,7 @@ rcondf{1} 1; first auto; progress; smt(). rcondf{1} 1; first auto; progress; smt(). auto=> |> &1 &2 ? ? sz_eq ? ? need_blks_eq. split. -have -> : n{1} = size (blocks2bits bs{2}) +have -> : n1 = size (blocks2bits bs{2}) by rewrite size_blocks2bits sz_eq -mulzC divzK 1:needed_blocks_eq_div_r. by rewrite take_size. by rewrite sz_eq need_blks_eq. @@ -2084,9 +2084,9 @@ call (HIRO.HybridIROEager_f_BlockIRO_f n' xs2). skip=> |> &1 &2 ? res1 res2 mp1 mp2 ? vb_imp not_vb_imp. case: (valid_block (pad2blocks bs{2}))=> [vb | not_vb]. have [le0_n2_imp gt0_n2_imp] := vb_imp vb. -case: (n{2} <= 0)=> [le0_n2 /# | not_le0_n2]. -have gt0_n2 : 0 < n{2} by smt(). -by have [-> _] := gt0_n2_imp gt0_n2. +case: (n' <= 0)=> [le0_n' /# | not_le0_n']. +have gt0_n' : 0 < n' by smt(). +by have [-> _] := gt0_n2_imp gt0_n'. have [-> ->] := not_vb_imp not_vb; by rewrite blocks2bits_nil. qed. diff --git a/proof/smart_counter/ConcreteF.eca b/proof/smart_counter/ConcreteF.eca index c913c9e..f8fa6a0 100644 --- a/proof/smart_counter/ConcreteF.eca +++ b/proof/smart_counter/ConcreteF.eca @@ -138,11 +138,11 @@ section. * move=>x;rewrite mem_set=>[][|-> j]; 1:smt(mem_set). case(0 <= j)=>hj0;last first. + by rewrite (@take_le0 j)1:/# domE get_setE H0 /#. - by rewrite take_take /min; case: (j < i{2} + 1)=> _; rewrite mem_set //= /#. + by rewrite take_take /min; case: (j < i{2} + 1); rewrite mem_set //= /#. * smt(mem_set take_take domE get_setE oget_some). * smt(mem_set take_take domE get_setE oget_some). * rewrite mem_set negb_or H9 negb_or/=negb_exists/=. - cut htake:take (i{2} + 1) bs{1} = take (i{2} + 1) (take (i{2} + 1 + 1) bs{1}); + have htake:take (i{2} + 1) bs{1} = take (i{2} + 1) (take (i{2} + 1 + 1) bs{1}); smt(take_take size_take). * rewrite/#. * rewrite/#. @@ -220,7 +220,7 @@ section. Pr[GReal(D).main()@ &m: res /\ C.c <= max_size] <= Pr[CF(DRestr(D)).main()@ &m: res] + (max_size ^ 2 - max_size)%r / 2%r * mu dstate (pred1 witness). proof. - cut->: + have ->: Pr[RealIndif(SqueezelessSponge,PC(Perm),D).main()@ &m: res /\ C.c <= max_size] = Pr[GReal'.main()@ &m: res/\ C.c <= max_size]. + byequiv=>//;proc;inline *; @@ -287,12 +287,12 @@ section. /\ (forall l, l \in Redo.prefixes{2} => l \in pref{2} \/ (exists j, 0 <= j <= i{2} /\ l = take j p{2}))). + rcondf{1}1;2:rcondf{2}1;..2:auto;progress. - * cut:=H7 (take (i{m0}+1) p{m0}). + * have:=H7 (take (i{m0}+1) p{m0}). case((take (i{m0} + 1) p{m0} \in Redo.prefixes{m0}))=>//=_. rewrite negb_or negb_exists/=;progress. + by rewrite -mem_fdom memE prefix_lt_size//=-(@prefix_exchange _ _ p{m0} H1 H0)//=/#. case(0<=a<=i{m0})=>//=ha;smt(size_take). - * cut:=H7 (take (i{hr}+1) p{hr}). + * have:=H7 (take (i{hr}+1) p{hr}). case((take (i{hr} + 1) p{hr} \in Redo.prefixes{hr}))=>//=_. rewrite negb_or negb_exists/=;progress. + by rewrite -mem_fdom memE prefix_lt_size//=-(@prefix_exchange _ _ p{hr} H1 H0)//=/#. @@ -312,7 +312,7 @@ section. * smt(prefix_lt_size mem_set take_size oget_some get_setE domE take_oversize take_le0 take_take cat_take_drop memE). * smt(prefix_lt_size mem_set take_size oget_some get_setE domE take_oversize take_le0 take_take cat_take_drop memE). * rewrite!get_setE/=. - cut/#: !take (i{2} + 1) p{2} \in pref{2}. + have/#: !take (i{2} + 1) p{2} \in pref{2}. by rewrite -mem_fdom memE prefix_lt_size//=-(@prefix_exchange _ _ _ H1 H0)//=/#. * rewrite get_set_sameE !oget_some. have: take (i{2} + 1) p{2} \notin Redo.prefixes{2}. @@ -343,7 +343,7 @@ section. * smt(prefix_lt_size mem_set take_size oget_some get_setE domE take_oversize take_le0 take_take cat_take_drop memE mem_fdom). * by rewrite!get_setE. * rewrite !get_setE//=. - cut/#: !take (i{2} + 1) p{2} \in pref{2}. + have /#: !take (i{2} + 1) p{2} \in pref{2}. by rewrite -mem_fdom memE prefix_lt_size//=-(@prefix_exchange _ _ _ H1 H0)//=/#. * smt(prefix_lt_size mem_set take_size oget_some get_setE domE take_oversize take_le0 take_take cat_take_drop memE mem_fdom). * smt(prefix_lt_size mem_set take_size oget_some get_setE domE take_oversize take_le0 take_take cat_take_drop memE mem_fdom). @@ -366,8 +366,8 @@ section. + rcondt{1}1;2:rcondt{2}1;auto;progress. * rewrite/#. search get_max_prefix (<=) take mem. * rewrite(@prefix_inv_leq _ _ _ _ _ _ H H7 H0)//= 1:/#. - cut:=H0=>[][h1 [h2 h3]]. - cut:=h3 _ _ _ H7;last smt(memE mem_fdom). + have :=H0=>[][h1 [h2 h3]]. + have :=h3 _ _ _ H7;last smt(memE mem_fdom). smt(size_eq0 size_take). * smt(domE). auto;progress. @@ -391,8 +391,12 @@ section. = Pr[PRPSec.IND(PRPi.PRPi,DBounder(D')).main() @ &m: res]. + rewrite -(DoubleBounding PRPi.PRPi &m). byequiv=> //=; proc; inline *; sim (_: ={m,mi}(Perm,PRPi.PRPi) /\ ={glob C}). - * by proc; if=> //=; auto. - by proc; if=> //=; auto. + (** * by proc; if=> //=; auto. **) + * proc. if. + + move=> &1 &2 [#] <<- _ _ -> _. (** FIXME: the two instances of PRPi.PRPi.mi{2} appear to not be the same value; one of them in an ill-formed term **) smt(). + + auto=> /#. + + auto=> /#. + by proc; if=> //=; auto=> /#. have ->: Pr[CF(DRestr(D)).main() @ &m: res] = Pr[PRPSec.IND(ARP,DBounder(D')).main() @ &m: res]. + rewrite -(DoubleBounding ARP &m). diff --git a/proof/smart_counter/Gcol.eca b/proof/smart_counter/Gcol.eca index dc462ad..2421692 100644 --- a/proof/smart_counter/Gcol.eca +++ b/proof/smart_counter/Gcol.eca @@ -209,7 +209,7 @@ section PROOF. + proc;sp;if;2:by hoare=>//??;apply eps_ge0. wp. rnd (mem (image fst (frng FRO.m)));skip;progress;2:smt ml=0. - cut->:=(Mu_mem.mu_mem (image fst (frng FRO.m{hr})) cdistr (1%r/(2^c)%r) _). + have->:=(Mu_mem.mu_mem (image fst (frng FRO.m{hr})) cdistr (1%r/(2^c)%r) _). + move=>x _; rewrite DCapacity.dunifin1E;do !congr;smt(@Capacity). apply ler_wpmul2r;2:by rewrite le_fromint. by apply divr_ge0=>//;apply /c_ge0r. @@ -240,7 +240,7 @@ section PROOF. if;1:auto. - inline Gcol.sample_c;rcondt{2}4. * auto;inline*;auto;progress. - + by cut/#:=fcard_image_leq (fun (p : capacity * flag) => p.`1) (frng FRO.m{hr}). + + by have/#:=fcard_image_leq (fun (p : capacity * flag) => p.`1) (frng FRO.m{hr}). rewrite/#. seq 3 4 : (={x0, p, v, y1, hx2, F.RO.m, G1.mi, G1.paths, G1.m, G1.mhi, G1.chandle, G1.mh, FRO.m, C.c, C.queries} @@ -250,15 +250,15 @@ section PROOF. /\ (x0{1}.`2 \in G1.paths{1}) /\ y2{1} = c{2});1: by inline*;auto. sp 1 4;if;auto;progress. - + by cut->:=(H H6). + + by have->:=(H H6). + smt(card_rng_set). - + case:H5=>/=[h|H_hinv];1: by cut->:=H h. - cut:=hinvP FRO.m{2} c{2};rewrite H_hinv/=imageP/==>[][]f H_f. + + case:H5=>/=[h|H_hinv];1: by have->:=H h. + have:=hinvP FRO.m{2} c{2};rewrite H_hinv/=imageP/==>[][]f H_f. by right; exists (c{2}, f)=> //=; rewrite mem_frng rngE/= /#. smt(card_rng_set). inline Gcol.sample_c;rcondt{2}3. * auto;progress. - + by cut/#:=fcard_image_leq (fun (p : capacity * flag) => p.`1) (frng FRO.m{hr}). + + by have/#:=fcard_image_leq (fun (p : capacity * flag) => p.`1) (frng FRO.m{hr}). rewrite/#. seq 2 3 : (={x0, y1, hx2, F.RO.m, G1.mi, G1.paths, G1.m, G1.mhi, G1.chandle, G1.mh, FRO.m, C.c, C.queries} @@ -268,10 +268,10 @@ section PROOF. /\ ! (x0{1}.`2 \in G1.paths{1}) /\ y2{1} = c{2});1: by auto. sp 1 4;if;auto;progress. - + by cut->:=(H H6). + + by have->:=(H H6). + smt(card_rng_set). - + case:H5=>/=[h|H_hinv];1: by cut->:=H h. - cut:= hinvP FRO.m{2} c{2}. + + case:H5=>/=[h|H_hinv];1: by have->:=H h. + have:= hinvP FRO.m{2} c{2}. rewrite H_hinv /= imageP /= => [] [] f H_f. by right; exists (c{2},f); rewrite mem_frng rngE /=; exists (oget (hinv FRO.m{2} c{2})). smt(card_rng_set). @@ -298,7 +298,7 @@ section PROOF. Gcol.count <= C.c <= max_size){2});2:by auto;smt w=card_rng_set. inline Gcol.sample_c. rcondt{2}3. - + by auto;progress;cut /#:= fcard_image_leq fst (frng FRO.m{hr}). + + by auto;progress;have /#:= fcard_image_leq fst (frng FRO.m{hr}). (* BUG: auto=> /> ?? Himp _ _ _ ?_?_ [/Himp->// | H]. marche pas ???? *) auto=> /> ?? Himp _ _ _ ?_?_ [/Himp->// | X];right;apply hinv_image=> //. diff --git a/proof/smart_counter/Gconcl.ec b/proof/smart_counter/Gconcl.ec index 4bbd724..e4f0724 100644 --- a/proof/smart_counter/Gconcl.ec +++ b/proof/smart_counter/Gconcl.ec @@ -378,9 +378,12 @@ proof. rewrite !(ler_add2l, ler_add2r);apply lerr_eq. apply (eq_trans _ Pr[G3(F.FullEager.LRO).distinguish() @ &m : res]);1:by byequiv G2_G3. apply (eq_trans _ Pr[G3(F.RO ).distinguish() @ &m : res]). - + by byequiv (_: ={glob G3, F.RO.m} ==> _)=>//;symmetry;conseq (F.FullEager.RO_LRO_D G3 Block.DBlock.dunifin_ll). + + byequiv (_: ={glob G3, F.RO.m} ==> _)=>//;symmetry;conseq (F.FullEager.RO_LRO_D G3 _)=> //. + by move=> _; exact/Block.DBlock.dunifin_ll. apply (eq_trans _ Pr[G4(F.RO ).distinguish() @ &m : res]);1:by byequiv G3_G4. - apply (eq_trans _ Pr[G4(F.FullEager.LRO).distinguish() @ &m : res]);1:by byequiv (F.FullEager.RO_LRO_D G4 Block.DBlock.dunifin_ll). + apply (eq_trans _ Pr[G4(F.FullEager.LRO).distinguish() @ &m : res]). + + byequiv (F.FullEager.RO_LRO_D G4 _)=> //. + by move=> _; exact/Block.DBlock.dunifin_ll. by byequiv G4_Ideal. qed. diff --git a/proof/smart_counter/Gconcl_list.ec b/proof/smart_counter/Gconcl_list.ec index 8378743..924030d 100644 --- a/proof/smart_counter/Gconcl_list.ec +++ b/proof/smart_counter/Gconcl_list.ec @@ -145,13 +145,13 @@ section Ideal. (get_max_prefix (format l (i+1+1)) (elems (fdom m))) <= size (format l (i+1+1)). proof. rewrite -mem_fdom memE;move=>hi0 H_dom. - cut->:(format l (i + 1 + 1)) = format l (i + 1) ++ [b0]. + have->:(format l (i + 1 + 1)) = format l (i + 1) ++ [b0]. + by rewrite/format//=nseqSr//-cats1 catA. - cut:=prefix_leq_prefix_cat_size (format l (i + 1))[b0](elems (fdom m)). + have:=prefix_leq_prefix_cat_size (format l (i + 1))[b0](elems (fdom m)). rewrite (prefix_get_max_prefix_eq_size _ _ H_dom)//=. rewrite (size_cat _ [b0])/=;pose x:= format _ _. - cut:=get_max_prefix_max (x ++ [b0]) _ _ H_dom. - cut->:prefix (x ++ [b0]) (format l (i + 1)) = size x + have:=get_max_prefix_max (x ++ [b0]) _ _ H_dom. + have->:prefix (x ++ [b0]) (format l (i + 1)) = size x by rewrite prefixC-{1}(cats0 (format l (i+1)))/x prefix_cat//=. smt(prefix_sizel size_cat prefix_ge0 ). qed. @@ -425,7 +425,7 @@ section Ideal. ! format p i \in m2 => inv_L_L3 m1.[format p i <- r] m2.[format p i <- r] m3. proof. - move=>INV0 p_valid i_gt0 nin_dom1 nin_dom2;split;cut[]add_maps valid_dom nvalid_dom:=INV0. + move=>INV0 p_valid i_gt0 nin_dom1 nin_dom2;split;have[]add_maps valid_dom nvalid_dom:=INV0. + rewrite add_maps -fmap_eqP=>x. by rewrite get_setE !joinE get_setE;smt(parseK formatK). + smt(mem_set parseK formatK). @@ -439,7 +439,7 @@ section Ideal. format p i \in m1 => format p i \in m2. proof. - move=>INV0 p_valid i_gt0 domE1;cut[]add_maps valid_dom nvalid_dom:=INV0. + move=>INV0 p_valid i_gt0 domE1;have[]add_maps valid_dom nvalid_dom:=INV0. by have:= domE1; rewrite add_maps mem_join;smt(parseK formatK). qed. @@ -448,7 +448,7 @@ section Ideal. inv_L_L3 m1 m2 m3 => l \in m1 <=> (l \in m2 \/ l \in m3). proof. - move=>INV0;cut[]add_maps valid_dom nvalid_dom:=INV0. + move=>INV0;have[]add_maps valid_dom nvalid_dom:=INV0. by rewrite add_maps mem_join. qed. @@ -459,8 +459,8 @@ section Ideal. ! x \in m1 => inv_L_L3 m1.[x <- r] m2 m3.[x <- r]. proof. - move=>INV0 not_valid nin_dom1;cut[]add_maps h1 h2:=INV0. - cut nin_dom3: ! x \in m3 by smt(incl_dom). + move=>INV0 not_valid nin_dom1;have[]add_maps h1 h2:=INV0. + have nin_dom3: ! x \in m3 by smt(incl_dom). split. + by apply/fmap_eqP=>y;rewrite add_maps !get_setE!joinE!get_setE mem_set/#. + exact h1. @@ -513,20 +513,20 @@ section Ideal. wp;rnd;wp 2 2. conseq(:_==> F.RO.m{1}.[p{1}] = F.RO.m{2}.[p{2}] /\ inv_L_L3 F.RO.m{1} F.RO.m{2} F2.RO.m{2});progress. - + cut[]add_maps h1 h2:=H5;rewrite add_maps joinE//=. + + have[]add_maps h1 h2:=H5;rewrite add_maps joinE//=. by have:= h2 p{2}; rewrite parse_valid //= H2 /= => h; rewrite h. + smt(). case(x5{1} \in F.RO.m{1}). - rcondf{1}2;2:rcondf{2}2;auto;progress. * smt(lemma2 incl_dom parse_valid). - by cut[]add_maps h1 h2:=H1;rewrite add_maps joinE//=;smt(parse_valid). + by have[]add_maps h1 h2:=H1;rewrite add_maps joinE//=;smt(parse_valid). rcondt{1}2;2:rcondt{2}2;auto;progress. - move:H4;rewrite/format/=nseq0 !cats0 => p0_notin_ROm_m. case: H1 => joint _ _; move: p0_notin_ROm_m. by rewrite joint mem_join negb_or; smt(parse_valid). - - cut[]add_maps h1 h2:=H1;rewrite add_maps !get_setE joinE//=;smt(parse_valid nseq0 cats0). - - cut:=H;rewrite -H0=>//=[][]->>->>;apply lemma1=>//=;1:smt(parse_valid). - cut[]add_maps h1 h2:=H1;smt(parse_valid formatK parseK incl_dom). + - have[]add_maps h1 h2:=H1;rewrite add_maps !get_setE joinE//=;smt(parse_valid nseq0 cats0). + - have:=H;rewrite -H0=>//=[][]->>->>;apply lemma1=>//=;1:smt(parse_valid). + have[]add_maps h1 h2:=H1;smt(parse_valid formatK parseK incl_dom). + progress;split. - by apply/fmap_eqP=>x;rewrite joinE mem_empty. - smt(mem_empty). @@ -542,15 +542,15 @@ section Ideal. /\ inv_L_L3 F.RO.m{1} F.RO.m{2} F2.RO.m{2});last first. - sp;case(x1{1} \in F.RO.m{1}). * rcondf{1}2;2:rcondf{2}2;auto;progress. - + cut:=H2;rewrite -formatK H/=;smt(lemma2 incl_dom parse_gt0). - cut[]add_maps h1 h2:=H1;rewrite add_maps joinE. - cut:=H2;rewrite -formatK H/==>in_dom1. + + have:=H2;rewrite -formatK H/=;smt(lemma2 incl_dom parse_gt0). + have[]add_maps h1 h2:=H1;rewrite add_maps joinE. + have:=H2;rewrite -formatK H/==>in_dom1. case(format p{2} n{2} \in F2.RO.m{2})=>//=in_dom3. - by cut:=h2 _ in_dom3;rewrite parseK//=;smt(parse_gt0). + by have:=h2 _ in_dom3;rewrite parseK//=;smt(parse_gt0). rcondt{1}2;2:rcondt{2}2;auto;progress. + smt(incl_dom lemma2). - + cut[]:=H1;smt(get_setE joinE). - by cut:=H2;rewrite-formatK H/==>nin_dom1;rewrite lemma1//=;smt(parse_gt0 lemma2 incl_dom). + + have[]:=H1;smt(get_setE joinE). + by have:=H2;rewrite-formatK H/==>nin_dom1;rewrite lemma1//=;smt(parse_gt0 lemma2 incl_dom). conseq(:_==> inv_L_L3 F.RO.m{1} F.RO.m{2} F2.RO.m{2});1:smt(). while(={i,n,p} /\ 0 <= i{1} /\ valid p{1} /\ inv_L_L3 F.RO.m{1} F.RO.m{2} F2.RO.m{2}). + sp;case(x2{1} \in F.RO.m{1}). @@ -566,18 +566,18 @@ section Ideal. /\ inv_L_L3 F.RO.m{1} F.RO.m{2} F2.RO.m{2});last first. + sp;case(x1{1} \in F.RO.m{1}). - rcondf{1}2;2:rcondf{2}2;auto;progress. - * cut[]:=H1;smt(incl_dom). - cut[]:=H1;smt(joinE incl_dom). + * have[]:=H1;smt(incl_dom). + have[]:=H1;smt(joinE incl_dom). rcondt{1}2;2:rcondt{2}2;auto;progress. - * cut[]:=H1;smt(incl_dom). - * cut[]:=H1;smt(joinE incl_dom get_setE). + * have[]:=H1;smt(incl_dom). + * have[]:=H1;smt(joinE incl_dom get_setE). by rewrite(lemma3 _ _ _ _ rL H1 _ H2)H//=. conseq(:_==> inv_L_L3 F.RO.m{1} F.RO.m{2} F2.RO.m{2});1:smt(). while(={i,n,p,x} /\ 0 <= i{1} /\ ! valid p{1} /\ parse x{1} = (p,n){1} /\ inv_L_L3 F.RO.m{1} F.RO.m{2} F2.RO.m{2}). + sp;case(x2{1} \in F.RO.m{1}). - rcondf{1}2;2:rcondf{2}2;auto;progress. - * cut[]h_join h1 h2:=H2. + * have[]h_join h1 h2:=H2. have:= H5; rewrite h_join mem_join. have:= h1 (format p{hr} (i_R + 1)). have:=parse_not_valid x{hr}; rewrite H1 /= H0 /= => h. @@ -586,7 +586,7 @@ section Ideal. rcondt{1}2;2:rcondt{2}2;auto;progress. * smt(incl_dom lemma1). * smt(). - * cut//=:=lemma3 _ _ _ _ r0L H2 _ H5. + * have//=:=lemma3 _ _ _ _ r0L H2 _ H5. by have:= parse_not_valid x{2}; rewrite H1 /= H0 /= => h; exact/(h (i_R+1)). auto;smt(). qed. @@ -800,7 +800,7 @@ section Ideal. valid p => INV_L4_ideal m1.[format p (i+1) <- r] m2.[(p,i) <- r] m3 m4. proof. - move=>INV0 nin_dom1 i_gt0 valid_p;cut[]inv12 inv34 dom2 dom4:=INV0;cut[]h1[]h2[]h3 h4:=inv12;split=>//=. + move=>INV0 nin_dom1 i_gt0 valid_p;have[]inv12 inv34 dom2 dom4:=INV0;have[]h1[]h2[]h3 h4:=inv12;split=>//=. + progress. - move:H0;rewrite 2!mem_set=>[][/#|]/=[]->>->>;smt(parseK formatK). - move:H0;rewrite 2!mem_set=>[][/#|]/=;smt(parseK formatK). @@ -820,8 +820,8 @@ section Ideal. INV_L4_ideal m1 m2 m3.[format p (i+1) <- r] m4.[(p,i) <- r]. proof. move=>INV0 nin_dom1 i_gt0 nvalid_p parseK_p_i; - cut[]inv12 inv34 dom2 dom4:=INV0; - cut[]h1[]h2[]h3 h4:=inv34; + have[]inv12 inv34 dom2 dom4:=INV0; + have[]h1[]h2[]h3 h4:=inv34; split=>//=. + progress. - move:H0;rewrite 2!mem_set=>[][/#|]/=[]->>->>;smt(parseK formatK). @@ -858,13 +858,13 @@ section Ideal. /\ INV_L4_ideal F.RO.m{1} BIRO.IRO.mp{2} F2.RO.m{1} BIRO2.IRO.mp{2});progress. * sp;if{2}. + rcondt{1}2;auto;progress. - - cut[]h1 _ _ _:=H1;cut[]h'1 _:=h1;smt(parseK). + - have[]h1 _ _ _:=H1;have[]h'1 _:=h1;smt(parseK). - smt(get_setE). - smt(). - exact lemma5. rcondf{1}2;auto;progress. - - cut[]h1 _ _ _:=H1;cut[]h'1 _:=h1;smt(parseK). - - cut[]h1:=H1;cut[]:=h1;smt(parseK). + - have[]h1 _ _ _:=H1;have[]h'1 _:=h1;smt(parseK). + - have[]h1:=H1;have[]:=h1;smt(parseK). smt(). by if{1};auto;smt(parseK parse_gt0 formatK). rcondf{1}1;1:auto;1:smt(parse_gt0);sp. @@ -874,18 +874,18 @@ section Ideal. /\ INV_L4_ideal F.RO.m{1} BIRO.IRO.mp{2} F2.RO.m{1} BIRO2.IRO.mp{2});progress. * sp;if{2}. + rcondt{1}2;auto;progress. - - cut[]_ h1 _ _:=H2;cut[]:=h1;progress. - cut:=H7 x0{m} i0{m} (format x0{m} (i0{m} + 1));rewrite H5/==>->//=. - cut->/#:=parse_twice _ _ _ H. + - have[]_ h1 _ _:=H2;have[]:=h1;progress. + have:=H7 x0{m} i0{m} (format x0{m} (i0{m} + 1));rewrite H5/==>->//=. + have->/#:=parse_twice _ _ _ H. - smt(get_setE). - smt(). - apply lemma5bis=>//=. rewrite(parse_twice _ _ _ H)/#. rcondf{1}2;auto;progress. - - cut[]_ h1 _ _:=H2;cut[]:=h1;progress. - cut:=H7 x0{m} i0{m} (format x0{m} (i0{m} + 1));rewrite H5/==>->//=. - cut->/#:=parse_twice _ _ _ H. - - cut[]_ h1 _ _:=H2;cut[]h'1 _:=h1;smt(parseK parse_twice). + - have[]_ h1 _ _:=H2;have[]:=h1;progress. + have:=H7 x0{m} i0{m} (format x0{m} (i0{m} + 1));rewrite H5/==>->//=. + have->/#:=parse_twice _ _ _ H. + - have[]_ h1 _ _:=H2;have[]h'1 _:=h1;smt(parseK parse_twice). - smt(). by rcondf{1}1;auto;smt(parseK formatK). + by proc;inline*;conseq(:_==> ={glob C, glob S, z});progress;sim. @@ -898,13 +898,13 @@ section Ideal. /\ INV_L4_ideal F.RO.m{1} BIRO.IRO.mp{2} F2.RO.m{1} BIRO2.IRO.mp{2});progress. sp;if{2}. + rcondt{1}2;auto;progress. - - cut[]h1 _ _ _:=H1;cut[]h'1 _:=h1;smt(parseK). + - have[]h1 _ _ _:=H1;have[]h'1 _:=h1;smt(parseK). - smt(get_setE). - smt(). - exact lemma5. rcondf{1}2;auto;progress. - - cut[]h1 _ _ _:=H1;cut[]h'1 _:=h1;smt(parseK). - - cut[]h1:=H1;cut[]:=h1;smt(parseK). + - have[]h1 _ _ _:=H1;have[]h'1 _:=h1;smt(parseK). + - have[]h1:=H1;have[]:=h1;smt(parseK). smt(). qed. @@ -919,37 +919,41 @@ section Ideal. Pr[SLCommon.IdealIndif(IF,S,SLCommon.DRestr(A(D))).main() @ &m : res] = Pr[IdealIndif(BIRO.IRO,SimLast(S),DRestr(D)).main() @ &m : res]. proof. - cut->:Pr[SLCommon.IdealIndif(IF, S, SLCommon.DRestr(A(D))).main() @ &m : res] + have->:Pr[SLCommon.IdealIndif(IF, S, SLCommon.DRestr(A(D))).main() @ &m : res] = Pr[SLCommon.IdealIndif(IF, S, A(D)).main() @ &m : res]. + by byequiv(ideal_equiv D)=>//=. - cut<-:Pr[L2(D,F.RO).distinguish() @ &m : res] = + have<-:Pr[L2(D,F.RO).distinguish() @ &m : res] = Pr[SLCommon.IdealIndif(IF,S,A(D)).main() @ &m : res]. + by byequiv(ideal_equiv2 D). - cut->:Pr[L2(D, F.RO).distinguish() @ &m : res] = + have->:Pr[L2(D, F.RO).distinguish() @ &m : res] = Pr[L2(D,F.FullEager.LRO).distinguish() @ &m : res]. + byequiv=>//=;proc;sp;inline*;sp;wp. - by call(F.FullEager.RO_LRO_D (D2(D)) dunifin_ll);auto. - cut->:Pr[IdealIndif(BIRO.IRO, SimLast(S), DRestr(D)).main() @ &m : res] = + call(F.FullEager.RO_LRO_D (D2(D)) _);auto. + by move=> _; exact/dunifin_ll. + have->:Pr[IdealIndif(BIRO.IRO, SimLast(S), DRestr(D)).main() @ &m : res] = Pr[L4(D,F.FullEager.LRO,F2.FullEager.LRO).distinguish() @ &m : res]. + by rewrite eq_sym;byequiv(equiv_L4_ideal D)=>//=. - cut<-:Pr[L4(D, F.RO, F2.RO).distinguish() @ &m : res] = + have<-:Pr[L4(D, F.RO, F2.RO).distinguish() @ &m : res] = Pr[L4(D,F.FullEager.LRO,F2.FullEager.LRO).distinguish() @ &m : res]. - + cut->:Pr[L4(D, F.RO, F2.RO).distinguish() @ &m : res] = + + have->:Pr[L4(D, F.RO, F2.RO).distinguish() @ &m : res] = Pr[L4(D,F.FullEager.LRO, F2.RO).distinguish() @ &m : res]. - byequiv=>//=;proc;sp;inline*;sp;wp. - by call(F.FullEager.RO_LRO_D (D5(D)) dunifin_ll);auto. + call(F.FullEager.RO_LRO_D (D5(D)) _); auto. + by move=> _; exact/dunifin_ll. byequiv=>//=;proc;sp;inline*;sp;wp. - by call(F2.FullEager.RO_LRO_D (D6(D)) dunifin_ll);auto. - cut<-:Pr[L3(D, F.RO).distinguish() @ &m : res] = + call(F2.FullEager.RO_LRO_D (D6(D)) _); auto. + by move=> _; exact/dunifin_ll. + have<-:Pr[L3(D, F.RO).distinguish() @ &m : res] = Pr[L4(D, F.RO, F2.RO).distinguish() @ &m : res]. + by byequiv(equiv_L3_L4 D)=>//=. - cut<-:Pr[L(D, F.RO).distinguish() @ &m : res] = + have<-:Pr[L(D, F.RO).distinguish() @ &m : res] = Pr[L3(D, F.RO).distinguish() @ &m : res]. + by byequiv(Ideal_equiv3 D). - cut->:Pr[L(D, F.RO).distinguish() @ &m : res] = + have->:Pr[L(D, F.RO).distinguish() @ &m : res] = Pr[L(D,F.FullEager.LRO).distinguish() @ &m : res]. + byequiv=>//=;proc;sp;inline*;sp;wp. - by call(F.FullEager.RO_LRO_D (D3(D)) dunifin_ll);auto. + call(F.FullEager.RO_LRO_D (D3(D)) _); auto. + by move=> _; exact/dunifin_ll. rewrite eq_sym. by byequiv(Ideal_equiv_valid D). qed. @@ -1028,34 +1032,34 @@ section Real. INV_Real c1 c2 m mi p.[format bl i <- oget m.[(sa,sc)]]. proof. move=>inv0 h1i h_valid H_dom_m H_dom_p H_p_val. - split;cut[]//=_[] hmp0 hmp1 hinvm:=inv0;split=>//=. + split;have[]//=_[] hmp0 hmp1 hinvm:=inv0;split=>//=. + by rewrite get_setE;smt(size_cat size_nseq size_ge0). + move=>l;rewrite mem_set;case;1:smt(all_prefixes_of_INV_real get_setE). move=>->>j[]hj0 hjsize;rewrite get_setE/=. - cut:=hmp1 (format bl (i - 1));rewrite domE H_p_val/==>help. - cut:=hjsize;rewrite !size_cat !size_nseq/=!ler_maxr 1:/#=>hjsizei. - cut->/=:!take j (format bl i) = format bl i by smt(size_take). - cut h:forall k, 0 <= k <= size bl + i - 2 => + have:=hmp1 (format bl (i - 1));rewrite domE H_p_val/==>help. + have:=hjsize;rewrite !size_cat !size_nseq/=!ler_maxr 1:/#=>hjsizei. + have->/=:!take j (format bl i) = format bl i by smt(size_take). + have h:forall k, 0 <= k <= size bl + i - 2 => take k (format bl (i - 1)) = take k (format bl i). * move=>k[]hk0 hkjS;rewrite !take_cat;case(k//=hksize;congr. apply (eq_from_nth witness);1:rewrite!size_take//=1,2:/#!size_nseq!ler_maxr/#. rewrite!size_take//=1:/#!size_nseq!ler_maxr 1:/#. - pose o:=if _ then _ else _;cut->/={o}:o = k - size bl by smt(). + pose o:=if _ then _ else _;have->/={o}:o = k - size bl by smt(). by progress;rewrite!nth_take//= 1,2:/# !nth_nseq//=/#. case(j < size bl + i - 2)=>hj. - - cut:=help j _;1:smt(size_cat size_nseq). + - have:=help j _;1:smt(size_cat size_nseq). move=>[]b c[]. - cut->:nth witness (format bl (i - 1)) j = nth witness (format bl i) j. + have->:nth witness (format bl (i - 1)) j = nth witness (format bl i) j. + by rewrite-(nth_take witness (j+1)) 1,2:/# eq_sym -(nth_take witness (j+1)) 1,2:/# !h//=/#. rewrite h 1:/# h 1:/# => -> h';exists b c=>//=;rewrite h'/=get_setE/=. smt(size_take size_cat size_nseq). - cut->>/=:j = size (format bl (i-1)) by smt(size_cat size_nseq). + have->>/=:j = size (format bl (i-1)) by smt(size_cat size_nseq). rewrite get_setE/=. - cut h':size (format bl (i-1)) = size bl + i - 2 by smt(size_cat size_nseq). + have h':size (format bl (i-1)) = size bl + i - 2 by smt(size_cat size_nseq). rewrite h'/=. - cut h'':(size bl + i - 1) = size (format bl i) by smt(size_cat size_nseq). + have h'':(size bl + i - 1) = size (format bl i) by smt(size_cat size_nseq). rewrite h'' take_size/=-h 1:/# -h' take_size. - rewrite nth_cat h';cut->/=:! size bl + i - 2 < size bl by smt(). + rewrite nth_cat h';have->/=:! size bl + i - 2 < size bl by smt(). by rewrite nth_nseq 1:/#; exists sa sc; smt(Block.WRing.AddMonoid.addm0 domE). qed. @@ -1078,7 +1082,7 @@ section Real. proof. move=>Hn0[]Hi0 Hisize;rewrite take_cat take_nseq. case(i < size bl)=>//=[/#|H_isize']. - cut->/=:i - size bl <= n - 1 by smt(). + have->/=:i - size bl <= n - 1 by smt(). case(i = size bl)=>[->>|H_isize'']//=;1:by rewrite nseq0 take_size cats0. smt(). qed. @@ -1103,7 +1107,7 @@ section Real. apply INV_Real_addm_mi=>//=. + case:H0=>H_c H_m_p H_invm;rewrite (invm_dom_rng _ _ H_invm)//=. by move:H3;rewrite supp_dexcepted. - case:H0=>H_c H_m_p H_invm;cut<-//:=(invm_dom_rng Perm.mi{2} Perm.m{2}). + case:H0=>H_c H_m_p H_invm;have<-//:=(invm_dom_rng Perm.mi{2} Perm.m{2}). by rewrite invmC. + exact INV_Real_incr. + proc;inline*;sp;if;auto. @@ -1140,19 +1144,21 @@ section Real. Perm.m{1}.[(b +^ nth witness p{1} j, c)] = Redo.prefixes{1}.[take (j+1) p{1}])); progress. - - cut inv0:=H3;cut[]h_c1c2[]Hmp0 Hmp1 Hinvm:=inv0;split=>//=. + - have inv0:=H3;have[]h_c1c2[]Hmp0 Hmp1 Hinvm:=inv0;split=>//=. - case:inv0;smt(size_ge0). split=>//=. - smt(domE). - - move=>l H_dom_R i []Hi0 Hisize;cut:=H4 l H_dom_R. + - move=>l H_dom_R i []Hi0 Hisize;have:=H4 l H_dom_R. case(l \in Redo.prefixes{2})=>H_in_pref//=. - * cut:=Hmp1 l H_in_pref i _;rewrite//=. + * have:=Hmp1 l H_in_pref i _;rewrite//=. rewrite ?H5//=;1:smt(domE). case(i+1 < size l)=>h;1:smt(domE). by rewrite take_oversize 1:/#. move=>[]j[][]hj0 hjsize ->>. - cut:=Hisize;rewrite size_take 1:/#. - pose k:=if _ then _ else _;cut->>Hij{k}:k=j by rewrite/#. + have:=Hisize;rewrite size_take 1:/#. + pose k:=if _ then _ else _. + have: k = j by smt(). + move: k=> /> Hij. by rewrite!take_take!minrE 1:nth_take 1,2:/#;smt(domE). - smt(get_setE oget_some domE take_oversize). while( ={i0,p0,i,p,n,nb,bl,sa,sc,lres,C.c,glob Redo,glob Perm} @@ -1173,9 +1179,9 @@ section Real. Redo.prefixes{1}.[take (j+1) p{1}]));last first. + auto;progress. - exact size_ge0. - - by rewrite take0;cut[]_[]->//=:=H. + - by rewrite take0;have[]_[]->//=:=H. - smt(). - - by cut[]->//=:=H. + - by have[]->//=:=H. - smt(all_prefixes_of_INV_real). - smt(). - smt(). @@ -1188,10 +1194,10 @@ section Real. - smt(). - smt(all_prefixes_of_INV_real domE take_take size_take). - case(j < i0{2})=>hj;1:smt(). - cut<<-/=:j = i0{2} by smt(). - cut->>:=H7 H10 H12. - cut[]_[]hmp0 hmp1 _:=H2. - cut[]b3 c3:=hmp1 _ H12 j _;1:smt(size_take). + have<<-/=:j = i0{2} by smt(). + have->>:=H7 H10 H12. + have[]_[]hmp0 hmp1 _:=H2. + have[]b3 c3:=hmp1 _ H12 j _;1:smt(size_take). smt(take_take nth_take size_take). sp;if;auto;progress. - smt(). @@ -1203,7 +1209,7 @@ section Real. - smt(). - smt(). - move:H17;apply absurd=>//=_;rewrite mem_set. - pose x:=_ = _;cut->/={x}:x=false by smt(size_take). + pose x:=_ = _;have->/={x}:x=false by smt(size_take). move:H12;apply absurd=>//= hpref. have:= H8 _ hpref (i0{2}+1). smt(mem_set take_take size_take). @@ -1225,9 +1231,9 @@ section Real. - smt(). - smt(). - move:H15;apply absurd=>//=_;rewrite mem_set. - pose x:=_ = _;cut->/={x}:x=false by smt(size_take). + pose x:=_ = _;have->/={x}:x=false by smt(size_take). move:H12;apply absurd=>//=. - cut:=take_take bl{2}(i0{2} + 1)(i0{2} + 1 + 1). + have:=take_take bl{2}(i0{2} + 1)(i0{2} + 1 + 1). rewrite minrE (: i0{2} + 1 <= i0{2} + 1 + 1) 1:/#=><-h. by rewrite (H8 _ h). - move=>l;rewrite!mem_set;case=>[H_dom|->>]/=;1:smt(mem_set). @@ -1237,7 +1243,7 @@ section Real. by rewrite-(take0 (take i0{2} bl{2})) H8 domE H1. case(j < i0{2} + 1)=>hjiS;2:smt(domE take_take). rewrite take_take/min hjiS//=;left. - cut:=(take_take bl{2} j i0{2}). + have:=(take_take bl{2} j i0{2}). rewrite minrE (: j <= i0{2}) 1:/#=><-. smt(all_prefixes_of_INV_real domE). - smt(get_setE domE mem_set). @@ -1307,19 +1313,19 @@ section Real. sp;if;auto;progress. - move:H4 H5;rewrite!get_setE/= nth_last/=take_size. rewrite last_cat last_nseq 1:/# Block.WRing.addr0;progress. - cut//=:=lemma2'(SLCommon.C.c{1} + 1)(C.c{2} + size bl{2} + i{2}) + have//=:=lemma2'(SLCommon.C.c{1} + 1)(C.c{2} + size bl{2} + i{2}) Perm.m{2}.[(sa0_R, sc0{2}) <- y2L] Perm.mi{2}.[y2L <- (sa0_R, sc0{2})] Redo.prefixes{2} bl{2} (i{2}+1) sa0_R sc0{2}. rewrite H1/=!mem_set/=H4/=H2/=get_setE/=. - cut->->//=:y2L = (y2L.`1, y2L.`2);1,-1:smt(). + have->->//=:y2L = (y2L.`1, y2L.`2);1,-1:smt(). rewrite INV_Real_addm_mi//=;2:smt(supp_dexcepted). - by cut:=H3=>hinv0;split;case:hinv0=>//=/#. + by have:=H3=>hinv0;split;case:hinv0=>//=/#. - by rewrite mem_set//=take_size domE H2. - by rewrite!get_setE take_size/=;smt(). - move:H4 H5;rewrite nth_last take_size. rewrite last_cat last_nseq 1:/# Block.WRing.addr0;progress. - pose a:=(_, _);cut->/={a}:a = oget Perm.m{2}.[(sa0_R, sc0{2})] by smt(). - apply lemma2'=>//=;first cut:=H3=>hinv0;split;case:hinv0=>//=/#. + pose a:=(_, _);have->/={a}:a = oget Perm.m{2}.[(sa0_R, sc0{2})] by smt(). + apply lemma2'=>//=;first have:=H3=>hinv0;split;case:hinv0=>//=/#. smt(). - by rewrite mem_set//=take_size;smt(domE). - by rewrite!get_setE/=take_size/=;smt(). @@ -1347,10 +1353,10 @@ section Real. /\ Redo.prefixes{1}.[format p{1} (i1{1} - size p{1} + 1)] = Some (sa0{1}, sc0{1})). + rcondt{1}1;2:rcondt{2}1;auto;progress. - + cut->:take (i1{m} + 1) (format bl{m} (i{m} + 1)) = + + have->:take (i1{m} + 1) (format bl{m} (i{m} + 1)) = take (i1{m} + 1) (format bl{m} i{m});2:smt(all_prefixes_of_INV_real). smt(take_format size_ge0 size_eq0 valid_spec size_cat size_nseq). - + cut->:take (i1{hr} + 1) (format bl{hr} (i{hr} + 1)) = + + have->:take (i1{hr} + 1) (format bl{hr} (i{hr} + 1)) = take (i1{hr} + 1) (format bl{hr} i{hr});2:smt(all_prefixes_of_INV_real). smt(take_format size_ge0 size_eq0 valid_spec size_cat size_nseq). + smt(). @@ -1361,7 +1367,7 @@ section Real. have->:format bl{2} (i1{2} + 1 - size bl{2} + 1) = take (i1{2} + 1) (format bl{2} i{2}). - smt(take_format size_ge0 size_eq0 valid_spec size_cat size_nseq). - cut all_pref:=all_prefixes_of_INV_real _ _ _ _ _ H. + have all_pref:=all_prefixes_of_INV_real _ _ _ _ _ H. by have:=all_pref _ H0 (i1{2}+1); rewrite domE; smt(). conseq(:_==> ={nb,bl,n,p,p1,i,i1,lres,sa0,sc0,C.c,glob Redo,glob Perm} /\ INV_Real SLCommon.C.c{1} (C.c{1} + size bl{2} + i{1} - 1) @@ -1384,23 +1390,23 @@ section Real. /\ Redo.prefixes{1}.[take i1{1} p{1}] = Some (sa0{1}, sc0{1}));last first. + auto;progress. - smt(). - - cut[]_[]:=H;smt(domE). + - have[]_[]:=H;smt(domE). - exact size_ge0. - - cut[]_[]:=H;smt(domE take0). + - have[]_[]:=H;smt(domE take0). - smt(size_cat size_nseq). rcondt{1}1;2:rcondt{2}1;auto;progress. - - cut->:take (i1{m} + 1) (format bl{m} (i{m} + 1)) = + - have->:take (i1{m} + 1) (format bl{m} (i{m} + 1)) = take (i1{m} + 1) (format bl{m} i{m});2:smt(all_prefixes_of_INV_real). smt(take_format size_ge0 size_eq0 valid_spec size_cat size_nseq). - - cut->:take (i1{hr} + 1) (format bl{hr} (i{hr} + 1)) = + - have->:take (i1{hr} + 1) (format bl{hr} (i{hr} + 1)) = take (i1{hr} + 1) (format bl{hr} i{hr});2:smt(all_prefixes_of_INV_real). smt(take_format size_ge0 size_eq0 valid_spec size_cat size_nseq). - smt(). - smt(). - - cut->:take (i1{2} + 1) (format bl{2} (i{2} + 1)) = + - have->:take (i1{2} + 1) (format bl{2} (i{2} + 1)) = take (i1{2} + 1) (format bl{2} i{2}) by smt(take_format size_ge0 size_eq0 valid_spec size_cat size_nseq). - cut->:take (i1{2} + 1) bl{2} = + have->:take (i1{2} + 1) bl{2} = take (i1{2} + 1) (format bl{2} i{2}) by smt(take_cat take_le0 cats0). smt(all_prefixes_of_INV_real). @@ -1415,19 +1421,19 @@ section Real. p.[format bl (i+1)] = m.[(sa,sc)]. proof. move=>inv0 H_i0 H_p_i H_dom_iS. - cut[]_[]_ hmp1 _ :=inv0. - cut:=hmp1 (format bl (i+1)) H_dom_iS=>help. - cut:=help (size (format bl i)) _;1:smt(size_ge0 size_cat size_nseq). + have[]_[]_ hmp1 _ :=inv0. + have:=hmp1 (format bl (i+1)) H_dom_iS=>help. + have:=help (size (format bl i)) _;1:smt(size_ge0 size_cat size_nseq). move=>[]b3 c3;rewrite!take_format;..4:smt(size_ge0 size_cat size_nseq). - cut->/=:!size (format bl i) + 1 <= size bl by smt(size_cat size_nseq size_ge0). + have->/=:!size (format bl i) + 1 <= size bl by smt(size_cat size_nseq size_ge0). rewrite nth_cat. - cut->/=:!size (format bl i) < size bl by smt(size_cat size_ge0). + have->/=:!size (format bl i) < size bl by smt(size_cat size_ge0). rewrite nth_nseq 1:size_cat 1:size_nseq 1:/#. - pose x:=if _ then _ else _;cut->/={x}:x = format bl i. + pose x:=if _ then _ else _;have->/={x}:x = format bl i. + rewrite/x;case(i = 1)=>//=[->>|hi1]. - by rewrite/format/=nseq0 cats0//=take_size. by rewrite size_cat size_nseq/#. - pose x:=List.size _ + 1 - List.size _ + 1;cut->/={x}:x=i+1 + pose x:=List.size _ + 1 - List.size _ + 1;have->/={x}:x=i+1 by rewrite/x size_cat size_nseq;smt(). rewrite H_p_i=>[]/=[][]->>->>. by rewrite Block.WRing.addr0=>H_pm;rewrite H_pm/=. @@ -1441,24 +1447,24 @@ section Real. INV_Real c1 c2 m mi p.[rcons bl b <- oget m.[(sa +^ b,sc)]]. proof. move=>inv0 H_dom_m H_dom_p H_p_val. - split;cut[]//=_[] hmp0 hmp1 hinvm:=inv0;split=>//=. + split;have[]//=_[] hmp0 hmp1 hinvm:=inv0;split=>//=. + by rewrite get_setE;smt(size_cat size_nseq size_ge0). + move=>l;rewrite mem_set;case;1:smt(all_prefixes_of_INV_real get_setE). move=>->>j[]hj0 hjsize;rewrite get_setE/=. - cut:=hmp1 bl;rewrite domE H_p_val/==>help. - cut->/=:!take j (rcons bl b) = rcons bl b by smt(size_take). + have:=hmp1 bl;rewrite domE H_p_val/==>help. + have->/=:!take j (rcons bl b) = rcons bl b by smt(size_take). move:hjsize;rewrite size_rcons=>hjsize. rewrite-cats1 !take_cat. - pose x := if _ then _ else _;cut->/={x}: x = take j bl by smt(take_le0 cats0 take_size). + pose x := if _ then _ else _;have->/={x}: x = take j bl by smt(take_le0 cats0 take_size). rewrite nth_cat. case(j < size bl)=>//=hj;last first. - + cut->>/=:j = size bl by smt(). + + have->>/=:j = size bl by smt(). by rewrite take_size H_p_val/=;exists sa sc=>//=;smt(get_setE). - cut->/=:j + 1 - size bl <= 0 by smt(). + have->/=:j + 1 - size bl <= 0 by smt(). rewrite cats0. - pose x := if _ then _ else _;cut->/={x}: x = take (j+1) bl by smt(take_le0 cats0 take_size). - cut:=hmp1 bl;rewrite domE H_p_val/==>hep. - cut:=hep j _;rewrite//=;smt(get_setE size_cat size_take). + pose x := if _ then _ else _;have->/={x}: x = take (j+1) bl by smt(take_le0 cats0 take_size). + have:=hmp1 bl;rewrite domE H_p_val/==>hep. + have:=hep j _;rewrite//=;smt(get_setE size_cat size_take). qed. @@ -1511,27 +1517,27 @@ section Real. + if{1};auto. + sp;rcondf{2}1;auto;progress. + rewrite head_nth nth_drop//=. - cut[]_[]_ hmp1 _ :=H2;cut:=hmp1 _ H5 i0{m} _;1:smt(size_take). + have[]_[]_ hmp1 _ :=H2;have:=hmp1 _ H5 i0{m} _;1:smt(size_take). move=>[]b3 c3;rewrite!take_take!nth_take 1,2:/# !minrE //= (: i0{m} <= i0{m} + 1) 1:/#. rewrite H1=>//=[][][]->>->>. by rewrite nth_onth (onth_nth b0)//=;smt(domE). + rewrite head_nth nth_drop//=. - cut[]_[]_ hmp1 _ :=H2;cut:=hmp1 _ H5 i0{1} _;1:smt(size_take). + have[]_[]_ hmp1 _ :=H2;have:=hmp1 _ H5 i0{1} _;1:smt(size_take). move=>[]b3 c3;rewrite!take_take!nth_take 1,2:/# !minrE//= (: i0{1} <= i0{1} + 1) 1:/#. rewrite H1=>//=[][][]->>->>. by rewrite nth_onth (onth_nth b0)//=;smt(domE). + rewrite head_nth nth_drop//=. - cut[]_[]_ hmp1 _ :=H2;cut:=hmp1 _ H5 i0{1} _;1:smt(size_take). + have[]_[]_ hmp1 _ :=H2;have:=hmp1 _ H5 i0{1} _;1:smt(size_take). move=>[]b3 c3;rewrite!take_take!nth_take 1,2:/# !minrE //= (: i0{1} <= i0{1} + 1) 1:/#. rewrite H1=>//=[][][]->>->>. by rewrite nth_onth (onth_nth b0)//=;smt(domE). + rewrite head_nth nth_drop//=. - cut[]_[]_ hmp1 _ :=H2;cut:=hmp1 _ H5 i0{1} _;1:smt(size_take). + have[]_[]_ hmp1 _ :=H2;have:=hmp1 _ H5 i0{1} _;1:smt(size_take). move=>[]b3 c3;rewrite!take_take!nth_take 1,2:/# !minrE //= (: i0{1} <= i0{1} + 1) 1:/#. rewrite H1=>//=[][][]->>->>. by rewrite nth_onth (onth_nth b0)//=;smt(domE). + rewrite head_nth nth_drop//=. - cut[]_[]_ hmp1 _ :=H2;cut:=hmp1 _ H5 i0{1} _;1:smt(size_take). + have[]_[]_ hmp1 _ :=H2;have:=hmp1 _ H5 i0{1} _;1:smt(size_take). move=>[]b3 c3;rewrite!take_take!nth_take 1,2:/# !minrE //= (: i0{1} <= i0{1} + 1) 1:/#. rewrite H1=>//=[][][]->>->>. by rewrite nth_onth (onth_nth b0)//=;smt(domE). @@ -1556,11 +1562,11 @@ section Real. + by rewrite get_setE/=. + by rewrite behead_drop drop_add. + rewrite!get_setE/=. - cut:=lemma_3 0 C.c{2}Perm.m{2}.[(sa{2} +^ nth witness p0{1} i0{1}, sc{2}) <- yL] + have:=lemma_3 0 C.c{2}Perm.m{2}.[(sa{2} +^ nth witness p0{1} i0{1}, sc{2}) <- yL] Perm.mi{2}.[yL <- (sa{2} +^ nth witness p0{1} i0{1}, sc{2})] Redo.prefixes{1} (take i0{1} p0{1}) (nth witness p0{1} i0{1}) sa{2} sc{2}. rewrite!mem_set/=-take_nth//=H5/=H1/=get_setE/=. - cut->->//=:(yL.`1, yL.`2) = yL by smt(). + have->->//=:(yL.`1, yL.`2) = yL by smt(). rewrite INV_Real_addm_mi=>//=;smt(supp_dexcepted). + smt(size_drop size_eq0). + smt(size_drop size_eq0). @@ -1573,14 +1579,14 @@ section Real. + by rewrite get_setE. + by rewrite behead_drop drop_add. + rewrite(take_nth witness)//=. - cut:=lemma_3 0 C.c{2} Perm.m{2} Perm.mi{2} Redo.prefixes{1} + have:=lemma_3 0 C.c{2} Perm.m{2} Perm.mi{2} Redo.prefixes{1} (take i0{1} p0{1}) (nth witness p0{1} i0{1}) sa{2} sc{2}. by rewrite-take_nth//= H5/=H1/=H2/=H6/=;smt(). + smt(size_drop size_eq0). + smt(size_drop size_eq0). auto;progress. + exact size_ge0. - + by rewrite take0;cut[]_[]->:=H. + + by rewrite take0;have[]_[]->:=H. + by rewrite drop0. + split;case:H=>//=;smt(size_ge0). + smt(size_ge0 size_eq0). @@ -1623,34 +1629,34 @@ section Real. + rcondf{2}1;auto;progress. + move:H5;rewrite take_oversize;1:rewrite size_cat size_nseq ler_maxr/#. move=>H_dom;rewrite domE. - by cut<-:=lemma4 _ _ _ _ _ _ _ _ _ H3 H H2 H_dom;rewrite-domE. + by have<-:=lemma4 _ _ _ _ _ _ _ _ _ H3 H H2 H_dom;rewrite-domE. + move:H5;rewrite take_oversize;1:rewrite size_cat size_nseq ler_maxr/#;move=>H_dom. - by cut:=lemma4 _ _ _ _ _ _ _ _ _ H3 H H2 H_dom;smt(domE). + by have:=lemma4 _ _ _ _ _ _ _ _ _ H3 H H2 H_dom;smt(domE). + smt(). + move:H5;rewrite take_oversize;1:rewrite size_cat size_nseq ler_maxr/#;move=>H_dom. - by cut:=lemma4 _ _ _ _ _ _ _ _ _ H3 H H2 H_dom;smt(domE). + by have:=lemma4 _ _ _ _ _ _ _ _ _ H3 H H2 H_dom;smt(domE). sp;if;auto;progress. + move:H6;rewrite nth_cat nth_nseq;1:smt(size_ge0). - cut->/=:!size p{1} + i{2} - 1 < size p{1} by smt(). + have->/=:!size p{1} + i{2} - 1 < size p{1} by smt(). by rewrite Block.WRing.addr0. + move:H6;rewrite nth_cat nth_nseq;1:smt(size_ge0). - cut->/=:!size p{1} + i{2} - 1 < size p{1} by smt(). + have->/=:!size p{1} + i{2} - 1 < size p{1} by smt(). by rewrite Block.WRing.addr0. + move:H6;rewrite nth_cat nth_nseq;1:smt(size_ge0). - cut->/=:!size p{1} + i{2} - 1 < size p{1} by smt(). + have->/=:!size p{1} + i{2} - 1 < size p{1} by smt(). by rewrite Block.WRing.addr0. + move:H6;rewrite nth_cat nth_nseq;1:smt(size_ge0). - cut->/=:!size p{1} + i{2} - 1 < size p{1} by smt(). + have->/=:!size p{1} + i{2} - 1 < size p{1} by smt(). by rewrite Block.WRing.addr0. + move:H6;rewrite nth_cat nth_nseq;1:smt(size_ge0). - cut->/=:!size p{1} + i{2} - 1 < size p{1} by smt(). + have->/=:!size p{1} + i{2} - 1 < size p{1} by smt(). by rewrite Block.WRing.addr0. + smt(). + move:H5 H6;rewrite nth_cat nth_nseq;1:smt(size_ge0). - cut->/=:!size p{1} + i{2} - 1 < size p{1} by smt(). + have->/=:!size p{1} + i{2} - 1 < size p{1} by smt(). rewrite Block.WRing.addr0 !get_setE/= take_oversize;1:rewrite size_cat size_nseq/#. move=>H_dom_iS H_dom_p. - cut:=lemma2' 0 C.c{2} Perm.m{2}.[(sa{2}, sc{2}) <- y0L] + have:=lemma2' 0 C.c{2} Perm.m{2}.[(sa{2}, sc{2}) <- y0L] Perm.mi{2}.[y0L <- (sa{2}, sc{2})] Redo.prefixes{1} p{1} (i{2}+1) sa{2} sc{2} _ _ H4 _ H_dom_iS. + by rewrite INV_Real_addm_mi//=;smt(supp_dexcepted). @@ -1658,16 +1664,16 @@ section Real. + by rewrite mem_set. by rewrite!get_setE/=H2/=;smt(). + by rewrite!get_setE/=take_oversize//=size_cat size_nseq/#. - + rewrite nth_cat;cut->/=:! size p{1} + i{2} - 1 < size p{1} by smt(). + + rewrite nth_cat;have->/=:! size p{1} + i{2} - 1 < size p{1} by smt(). by rewrite nth_nseq//=1:/# Block.WRing.addr0. + smt(). + move:H5 H6;rewrite take_oversize 1:size_cat 1:size_nseq 1:/#. - rewrite nth_cat;cut->/=:! size p{1} + i{2} - 1 < size p{1} by smt(). + rewrite nth_cat;have->/=:! size p{1} + i{2} - 1 < size p{1} by smt(). rewrite nth_nseq//=1:/# Block.WRing.addr0 =>h1 h2. - by cut:=lemma2' 0 C.c{2} Perm.m{2} Perm.mi{2} Redo.prefixes{1} + by have:=lemma2' 0 C.c{2} Perm.m{2} Perm.mi{2} Redo.prefixes{1} p{1} (i{2}+1) sa{2} sc{2} H3 _ H1 h2 h1;smt(). + move:H5 H6;rewrite take_oversize 1:size_cat 1:size_nseq 1:/#. - rewrite nth_cat;cut->/=:! size p{1} + i{2} - 1 < size p{1} by smt(). + rewrite nth_cat;have->/=:! size p{1} + i{2} - 1 < size p{1} by smt(). by rewrite nth_nseq//=1:/# Block.WRing.addr0 !get_setE//=. alias{1} 1 pref = Redo.prefixes;sp. conseq(:_==> ={glob P} @@ -1677,17 +1683,17 @@ section Real. /\ INV_Real 0 C.c{1} Perm.m{1} Perm.mi{1} Redo.prefixes{1});progress. + smt(). + move:H9;rewrite take_format/=1:/#;1:smt(size_ge0 size_cat size_nseq). - pose x := if _ then _ else _ ;cut->/={x}: x = format p{1} (i_R+1). + pose x := if _ then _ else _ ;have->/={x}: x = format p{1} (i_R+1). + rewrite/x size_cat size_nseq/=!ler_maxr 1:/#-(addzA _ _ (-1))-(addzA _ _ (-1))/=. case(size p{1} + i_R <= size p{1})=>//=h;2:smt(size_ge0 size_cat size_nseq). - cut->>/=:i_R = 0 by smt(). + have->>/=:i_R = 0 by smt(). by rewrite take_size/format nseq0 cats0. by rewrite H3/==>[][]->>->>. + move:H9;rewrite take_format/=1:/#;1:smt(size_ge0 size_cat size_nseq). - pose x := if _ then _ else _ ;cut->/={x}: x = format p{1} (i_R+1). + pose x := if _ then _ else _ ;have->/={x}: x = format p{1} (i_R+1). + rewrite/x size_cat size_nseq/=!ler_maxr 1:/#-(addzA _ _ (-1))-(addzA _ _ (-1))/=. case(size p{1} + i_R <= size p{1})=>//=h;2:smt(size_ge0 size_cat size_nseq). - cut->>/=:i_R = 0 by smt(). + have->>/=:i_R = 0 by smt(). by rewrite take_size/format nseq0 cats0. by rewrite H3/=. + by rewrite size_cat size_nseq;smt(). @@ -1701,16 +1707,16 @@ section Real. + smt(size_cat size_nseq size_ge0 size_eq0 valid_spec). + smt(). + by rewrite domE H3. - + by rewrite take0;cut[]_[]:=H1. + + by rewrite take0;have[]_[]:=H1. + smt(). + smt(). rcondt 1;auto;progress. - + cut->:take (i1{hr} + 1) (format p{hr} (i{hr} + 1)) = + + have->:take (i1{hr} + 1) (format p{hr} (i{hr} + 1)) = take (i1{hr} + 1) (format p{hr} i{hr});2:smt(all_prefixes_of_INV_real domE). rewrite!take_format;smt(valid_spec size_ge0 size_eq0 size_cat size_nseq). + smt(). + smt(valid_spec size_ge0 size_eq0 size_cat size_nseq). - + cut->:take (i1{hr} + 1) (format p{hr} (i{hr} + 1)) = + + have->:take (i1{hr} + 1) (format p{hr} (i{hr} + 1)) = take (i1{hr} + 1) (format p{hr} i{hr});2:smt(all_prefixes_of_INV_real domE). rewrite!take_format;smt(valid_spec size_ge0 size_eq0 size_cat size_nseq). smt(). @@ -1722,7 +1728,7 @@ section Real. Pr [ GReal(A(D)).main() @ &m : res /\ SLCommon.C.c <= max_size] = Pr [ RealIndif(Sponge,P,DRestr(D)).main() @ &m : res]. proof. - cut->:Pr [ RealIndif(Sponge, P, DRestr(D)).main() @ &m : res ] = + have->:Pr [ RealIndif(Sponge, P, DRestr(D)).main() @ &m : res ] = Pr [ NIndif(Squeeze(SqueezelessSponge(P)),P,DRestr(D)).main() @ &m : res /\ C.c <= max_size ]. + by rewrite eq_sym;byequiv (squeeze_squeezeless D)=>//=. byequiv (equiv_sponge D)=>//=;progress;smt(). @@ -1765,7 +1771,7 @@ section Real_Ideal. proof. rewrite-(pr_real D &m). rewrite-(equiv_ideal D &m). - cut:=Real_Ideal (A(D)) A_lossless &m. + have:=Real_Ideal (A(D)) A_lossless &m. pose x:=witness;elim:x=>a b. rewrite/dstate dprod1E DBlock.dunifin1E DCapacity.dunifin1E/= block_card capacity_card;smt(). @@ -1807,18 +1813,18 @@ section Real_Ideal_Abs. invm m mi => ! a \in m => Distr.is_lossless ((bdistr `*` cdistr) \ rng m). proof. move=>hinvm nin_dom. - cut prod_ll:Distr.is_lossless (bdistr `*` cdistr). + have prod_ll:Distr.is_lossless (bdistr `*` cdistr). + by rewrite dprod_ll DBlock.dunifin_ll DCapacity.dunifin_ll. apply dexcepted_ll=>//=;rewrite-prod_ll. - cut->:predT = predU (predC (rng m)) (rng m);1:rewrite predCU//=. + have->:predT = predU (predC (rng m)) (rng m);1:rewrite predCU//=. rewrite Distr.mu_disjoint 1:predCI//= RField.addrC. - cut/=->:=ltr_add2l (mu (bdistr `*` cdistr) (rng m)) 0%r. + have/=->:=ltr_add2l (mu (bdistr `*` cdistr) (rng m)) 0%r. rewrite Distr.witness_support/predC. move:nin_dom;apply absurd=>//=;rewrite negb_exists/==>hyp. - cut{hyp}hyp:forall x, rng m x by smt(supp_dprod DBlock.supp_dunifin DCapacity.supp_dunifin). + have{hyp}hyp:forall x, rng m x by smt(supp_dprod DBlock.supp_dunifin DCapacity.supp_dunifin). move:a. - cut:=eqEcard (fdom m) (frng m);rewrite leq_card_rng_dom/=. - cut->//=:fdom m \subset frng m. + have:=eqEcard (fdom m) (frng m);rewrite leq_card_rng_dom/=. + have->//=:fdom m \subset frng m. + by move=> x; rewrite mem_fdom mem_frng hyp. smt(mem_fdom mem_frng). qed. @@ -1834,21 +1840,21 @@ section Real_Ideal_Abs. proc;inline*;auto;call(: invm Perm.m Perm.mi);2..:auto. + exact D_lossless. + proc;inline*;sp;if;auto;sp;if;auto;progress. - - by cut:=useful _ _ _ H H1. + - by have:=useful _ _ _ H H1. - smt(invm_set dexcepted1E). + proc;inline*;sp;if;auto;sp;if;auto;progress. - - cut:=H;rewrite invmC=>h;cut/#:=useful _ _ _ h H1. + - have:=H;rewrite invmC=>h;have/#:=useful _ _ _ h H1. - move:H;rewrite invmC=>H;rewrite invmC;smt(invm_set dexcepted1E domE rngE). + proc;inline*;sp;if;auto;sp;if;auto. while(invm Perm.m Perm.mi)(n-i);auto. - sp;if;auto;2:smt();sp;if;auto;2:smt();progress. - * by cut:=useful _ _ _ H H2. + * by have:=useful _ _ _ H H2. * smt(invm_set dexcepted1E). smt(). conseq(:_==> invm Perm.m Perm.mi);1:smt(). while(invm Perm.m Perm.mi)(size xs);auto. - sp;if;auto;progress. - * by cut:=useful _ _ _ H H1. + * by have:=useful _ _ _ H H1. * smt(invm_set dexcepted1E). * smt(size_behead). * smt(size_behead). @@ -1882,15 +1888,15 @@ section Real_Ideal_Abs. max_size%r * ((2*max_size)%r / (2^c)%r) + max_size%r * ((2*max_size)%r / (2^c)%r). proof. - cut->:Pr[IdealIndif(BIRO.IRO, SimLast(S), DRestr(D)).main() @ &m : res] = + have->:Pr[IdealIndif(BIRO.IRO, SimLast(S), DRestr(D)).main() @ &m : res] = Pr[Neg_main(IdealIndif(BIRO.IRO, SimLast(S), DRestr(Neg_D(D)))).main() @ &m : res]. + by byequiv=>//=;proc;inline*;auto;conseq(:_==> b0{1} = b2{2});progress;sim. - cut->:Pr [ RealIndif(Sponge,P,DRestr(D)).main() @ &m : res ] = + have->:Pr [ RealIndif(Sponge,P,DRestr(D)).main() @ &m : res ] = Pr [ Neg_main(RealIndif(Sponge,P,DRestr(Neg_D(D)))).main() @ &m : res ]. + by byequiv=>//=;proc;inline*;auto;conseq(:_==> b0{1} = b2{2});progress;sim. - cut h1 := Neg_A_Pr_minus (RealIndif(Sponge,P,DRestr(Neg_D(D)))) &m Real_lossless. - cut h2 := Neg_A_Pr_minus (IdealIndif(BIRO.IRO, SimLast(S), DRestr(Neg_D(D)))) &m Ideal_lossless. - cut/#:=concl (Neg_D(D)) _ &m;progress. + have h1 := Neg_A_Pr_minus (RealIndif(Sponge,P,DRestr(Neg_D(D)))) &m Real_lossless. + have h2 := Neg_A_Pr_minus (IdealIndif(BIRO.IRO, SimLast(S), DRestr(Neg_D(D)))) &m Ideal_lossless. + have/#:=concl (Neg_D(D)) _ &m;progress. by proc;call(D_lossless F0 P0 H H0 H1);auto. qed. @@ -1901,8 +1907,8 @@ section Real_Ideal_Abs. max_size%r * ((2*max_size)%r / (2^c)%r) + max_size%r * ((2*max_size)%r / (2^c)%r). proof. - cut := concl D D_lossless &m. - cut := neg_D_concl &m. + have := concl D D_lossless &m. + have := neg_D_concl &m. pose p1 := Pr[IdealIndif(BIRO.IRO, SimLast(S), DRestr(D)).main() @ &m : res]. pose p2 := Pr[RealIndif(Sponge, Perm, DRestr(D)).main() @ &m : res]. rewrite-5!(RField.addrA). @@ -2121,8 +2127,8 @@ while (i{2} <= k{2} /\ n0{1} = k{2} /\ i0{1} = i{2} /\ x1{1} = q{2} /\ ={k} /\ auto=> /> &1 &2 h1 h2 [#] q_L k_L h3 h4 h5 h6 h7 h8 h9 h10;split. + have:= h1; rewrite -h3 => [#] />; have:= h4; rewrite -h2 => [#] />. have:= h5. - cut-> : q{2} = (parse (rcons p{1} (v{1} +^ x{2}.`1))).`1 by smt(). - cut-> : k{2} = (parse (rcons p{1} (v{1} +^ x{2}.`1))).`2 by smt(). + have-> : q{2} = (parse (rcons p{1} (v{1} +^ x{2}.`1))).`1 by smt(). + have-> : k{2} = (parse (rcons p{1} (v{1} +^ x{2}.`1))).`2 by smt(). by rewrite (formatK (rcons p{1} (v{1} +^ x{2}.`1)))=> [#] />; smt(). smt(). qed. @@ -2162,7 +2168,7 @@ lemma Simplify_simulator &m : Pr [ IdealIndif(BIRO.IRO, SimLast(S), DRestr(D)).main() @ &m : res ]. proof. rewrite (equal1 &m) (equal2 &m) eq_sym. -by byequiv(RO_LRO_D L dunifin_ll)=>//=. +by byequiv(RO_LRO_D L _)=> //=; exact/dunifin_ll. qed. diff --git a/proof/smart_counter/Gext.eca b/proof/smart_counter/Gext.eca index d46799e..7177863 100644 --- a/proof/smart_counter/Gext.eca +++ b/proof/smart_counter/Gext.eca @@ -297,11 +297,11 @@ section. if;1,3:auto;progress. rcondt{2} 3;1:by auto=>/#. auto;progress. - + move=>bad1;cut[/=->//|]:=H bad1;rewrite/inv_ext=>[][]x h[]H_dom Hh;right. + + move=>bad1;have[/=->//|]:=H bad1;rewrite/inv_ext=>[][]x h[]H_dom Hh;right. exists x h;rewrite H_dom/= get_set_neqE //=. by move:(H0 h);rewrite domE Hh /#. + smt(mem_set). - + move=>bad1;cut[/=->//|]:=H bad1;rewrite/inv_ext=>[][]x h[]H_dom Hh;right. + + move=>bad1;have[/=->//|]:=H bad1;rewrite/inv_ext=>[][]x h[]H_dom Hh;right. exists x h;rewrite H_dom/= get_set_neqE //=. by move:(H0 h);rewrite domE Hh /#. + smt(mem_set). @@ -706,7 +706,7 @@ section EXT. proof. apply (ler_trans _ _ _ (Real_G1 D D_ll &m)). do !apply ler_add => //. - + cut ->: Pr[G1(DRestr(D)).main() @ &m : res] = Pr[Eager(G2(DRestr(D))).main1() @ &m : res]. + + have ->: Pr[G1(DRestr(D)).main() @ &m : res] = Pr[Eager(G2(DRestr(D))).main1() @ &m : res]. + by byequiv (G1_G2 D). by apply lerr_eq;byequiv (Eager_1_2 (G2(DRestr(D)))). + by apply (Pr_G1col D D_ll &m). diff --git a/proof/smart_counter/Handle.eca b/proof/smart_counter/Handle.eca index 44d8e98..5c9f283 100644 --- a/proof/smart_counter/Handle.eca +++ b/proof/smart_counter/Handle.eca @@ -837,9 +837,9 @@ split=>[]. + by case:HINV=>_ _ _ _ _ _ _ _ (* _ *) [] _ [] ->//. + by case:HINV=>_ _ _ _ _ _ _ _ (* _ *) [] _ [] //. + move=>l hmem i hi. - cut[]_ _ h2 h3:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. - cut[]sa sc[]:=h2 l hmem i hi. - cut h1:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + have[]_ _ h2 h3:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + have[]sa sc[]:=h2 l hmem i hi. + have h1:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. smt(domE get_setE). by case:HINV=>_ _ _ _ _ _ _ _ _ []. by case:HINV=>_ _ _ _ _ _ _ _ _ []. @@ -944,9 +944,9 @@ split=>[]. + by case:HINV=>_ _ _ _ _ _ _ _ (* _ *) [] _ [] ->//. + by case:HINV=>_ _ _ _ _ _ _ _ (* _ *) [] _ []. + move=>l hmem i hi. - cut[]_ _ h2 h3:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. - cut[]sa sc[]:=h2 l hmem i hi. - cut h1:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + have[]_ _ h2 h3:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + have[]sa sc[]:=h2 l hmem i hi. + have h1:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. smt(domE get_setE). by case:HINV=>_ _ _ _ _ _ _ _ _ []. by case:HINV=>_ _ _ _ _ _ _ _ _ []. @@ -1042,9 +1042,9 @@ split=>[]. + by case:HINV=>_ _ _ _ _ _ _ _ (* _ *) [] _ [] ->//. + by case:HINV=>_ _ _ _ _ _ _ _ (* _ *) [] _ []. + move=>l hmem i hi. - cut[]_ _ h2 _:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. - cut[]sa sc[]:=h2 l hmem i hi. - cut h1:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + have[]_ _ h2 _:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + have[]sa sc[]:=h2 l hmem i hi. + have h1:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. smt(domE get_setE). by case:HINV=>_ _ _ _ _ _ _ _ _ []. by case:HINV=>_ _ _ _ _ _ _ _ _ []. @@ -1154,9 +1154,9 @@ split=>[]. + by case:HINV=>_ _ _ _ _ _ _ _ (* _ *) [] _ []. + by case:HINV=>_ _ _ _ _ _ _ _ (* _ *) [] _ []. + move=>l hmem i hi. - cut[]_ _ h2 _:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. - cut[]sa sc[]:=h2 l hmem i hi. - cut h1:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + have[]_ _ h2 _:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + have[]sa sc[]:=h2 l hmem i hi. + have h1:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. smt(domE get_setE). by case:HINV=>_ _ _ _ _ _ _ _ _ []. by case:HINV=>_ _ _ _ _ _ _ _ _ []. @@ -1268,7 +1268,7 @@ lemma build_hpath_upd_ch ha ch mh xa ya p v hx: proof. move=> Hch0 Hha Hch. elim/last_ind: p v hx=> /=. - + by move=> v hx;rewrite /build_hpath /= => -[!<<-];rewrite Hch0. + + by move=> v hx;rewrite /build_hpath /= => -[!<<-] //; rewrite Hch0. move=> p x Hrec v hx /build_hpath_prefix [v' h' [/Hrec{Hrec}]]. rewrite get_setE /=;case (h' = ch) => [->> | ]. + by rewrite (@eq_sym ch) Hha /= => _ /Hch. @@ -1334,12 +1334,12 @@ lemma lemma4 hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes queries i p sa sc h f: => (sa +^ nth witness p i, h) \in mh. proof. move=>inv0 hi take_i1_p_in_prefixes prefixes_sa_sc build_hpath_i_p ro_prefix hs_h_sc_f. -cut[]_ _ m_prefix _:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. -cut[]b1 c1[]:=m_prefix _ take_i1_p_in_prefixes i _;1:smt(size_take). +have[]_ _ m_prefix _:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. +have[]b1 c1[]:=m_prefix _ take_i1_p_in_prefixes i _;1:smt(size_take). rewrite!take_take!minrE //= (: i <= i + 1) 1:/# nth_take 1,2:/# prefixes_sa_sc/==>[][<-<-]{b1 c1}Pm_prefix. -cut[]hh1 hh2 hh3:=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. -move:ro_prefix;cut{1}->:=(take_nth witness i p);1:smt(size_take);move=>h1. -cut:=hh2 (take i p) (nth witness p i) (oget prefixes.[take (i + 1) p]).`1. +have[]hh1 hh2 hh3:=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. +move:ro_prefix;have{1}->:=(take_nth witness i p);1:smt(size_take);move=>h1. +have:=hh2 (take i p) (nth witness p i) (oget prefixes.[take (i + 1) p]).`1. rewrite h1/==>[][] v hx hy;rewrite build_hpath_i_p/==>[][][?<-];smt(domE). qed. @@ -1425,18 +1425,18 @@ case @[ambient]: {-1}(Pmi.[(xa,xc)]) (eq_refl Pmi.[(xa,xc)])=> [Pmi_xaxc|[ya yc] + move=> f h; move: (yc_notrngE1_hs_addh h f); rewrite get_setE. case: (h = ch)=> <*> //= _; rewrite -negP. by have /hs_of_INV [] _ _ H /H {H} := inv0. - + rewrite domE/=;cut[]h1 h2:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. - cut h1':=h1 ya yc. - cut :Pm.[(ya, yc)] <> None => exists (hx : handle) (fx : flag), hs.[hx] = Some (yc, fx). + + rewrite domE/=;have[]h1 h2:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. + have h1':=h1 ya yc. + have :Pm.[(ya, yc)] <> None => exists (hx : handle) (fx : flag), hs.[hx] = Some (yc, fx). + move=> y_in_Pm; move: (h1' (oget Pm.[(ya,yc)]).`1 (oget Pm.[(ya,yc)]).`2 _). + by move: y_in_Pm; case: (Pm.[(ya,yc)])=> - //= []. by move=> [hx fx hy fy] [#] h _ _; exists hx fx. case(Pm.[(ya, yc)] = None)=>//=h; rewrite negb_exists/==>a;rewrite negb_exists/==>b. - cut:=yc_notrngE1_hs_addh a b;rewrite get_setE;case(a=ch)=>//=hach. + have:=yc_notrngE1_hs_addh a b;rewrite get_setE;case(a=ch)=>//=hach. case(xc=yc)=>[/#|]hxyc. - cut[]_ _ help:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. - by cut/#:=help (yc,b) a. + have[]_ _ help:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. + by have/#:=help (yc,b) a. have /hs_of_INV [] Hhuniq _ _ [] /(getflagP_some _ _ _ Hhuniq):= inv0. + move=> x2_is_U; conseq (_: _ ==> G1.bext{2})=> //. by auto=> ? ? [#] !<<- _ -> ->>_ /=; rewrite x2_is_U. @@ -1452,9 +1452,9 @@ case @[ambient]: {-1}(Pmi.[(xa,xc)]) (eq_refl Pmi.[(xa,xc)])=> [Pmi_xaxc|[ya yc] case: (hinvP hs y2)=> [_ y2_notrngE1_hs _ _|/#]. rewrite get_setE /=. apply/lemma2'=> //. - + rewrite domE/=;cut[]h1 _:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. - cut h1':=h1 y1 y2. - cut :Pm.[(y1, y2)] <> None => exists (hx : handle) (fx : flag), hs.[hx] = Some (y2, fx). + + rewrite domE/=;have[]h1 _:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. + have h1':=h1 y1 y2. + have :Pm.[(y1, y2)] <> None => exists (hx : handle) (fx : flag), hs.[hx] = Some (y2, fx). + move=> y_in_Pm; move: (h1' (oget Pm.[(y1,y2)]).`1 (oget Pm.[(y1,y2)]).`2 _). + by move: y_in_Pm; case: (Pm.[(y1,y2)])=> - //= []. by move=> [hx fx hy fy] [#] h _ _; exists hx fx. @@ -1591,11 +1591,11 @@ call(: !G1.bcol{2} + by move=> + _ + [#] <*> - <*>; move: (x2f_notrngE_hs0 f1 h1). have /hs_of_INV [] + _ _ _ _ - h := inv0. by apply/h; rewrite get_setE. - rewrite !oget_some;rewrite domE;cut[]_ -> _ _ _ /=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. + rewrite !oget_some;rewrite domE;have[]_ -> _ _ _ /=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. smt(lemma1). conseq (_: _ ==> G1.bcol{2})=> //=. + by auto=> &1 &2 [#] !<<- bad1 bad2 -> _ ->> !<<- _ /=/>; - rewrite domE;cut[]_ ->_ _ _/=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. + rewrite domE;have[]_ ->_ _ _/=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. auto=> &1 &2 [#] !<<- -> _ ->> !<<- _ /=/>. case: (hinvP hs0.[ch0 <- (x2,Known)] y2{1})=> //= -> /=. move=> hs0_spec; split=> [|f]. @@ -1604,7 +1604,7 @@ call(: !G1.bcol{2} by move=> _; rewrite -negP; have /hs_of_INV [] _ _ H /H {H}:= inv0. case; rewrite getflagP_some; 1,3:by have /hs_of_INV []:= inv0. + move=> x2_is_U; conseq (_: G1.bext{2})=> //=; auto=> &1 &2 /> _ _ hinv0 . - by rewrite domE;cut[]_ -> _ _ _/=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. + by rewrite domE;have[]_ -> _ _ _/=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. move=> x2_is_K; rcondf{2} 3; 1:by move=> &1; auto. have:= x2_is_K; rewrite rngE=> - [hx] hs0_hx. seq 0 3: ( hs0 = FRO.m{2} @@ -1643,7 +1643,7 @@ call(: !G1.bcol{2} rcondf{2} 1. + by move=> &m; auto=> //= &hr [#] <*>; rewrite x1hx_notin_G1m. auto=> &1 &2 [#] !<<- -> -> !->> _ /=. - rewrite domE;cut[]_ -> _ _ _ /=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. + rewrite domE;have[]_ -> _ _ _ /=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. case(hinv hs0 y2{2} = None)=>//=h; rewrite get_setE /=;smt(lemma2 hinvP). move=> [p0 v0] pi_x2; have:=pi_x2. @@ -1676,7 +1676,7 @@ call(: !G1.bcol{2} auto => &m1 &m2 [#] !<- _ _ -> /= _ y1L ? y2L ? /=. rewrite !get_set_sameE pi_x2 oget_some /=. have /hs_of_INV [] Hu _ _:= inv0; have -> := huniq_hinvK_h _ _ _ Hu hs_hx2. - rewrite oget_some domE => /= ;cut[]_->_ _ _/=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. + rewrite oget_some domE => /= ;have[]_->_ _ _/=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. case(G1.bcol{m2} \/ hinv hs0 y2L <> None)=>//=;rewrite !negb_or/==>[][]? hinv0[]? hinv1. case:inv0=> Hhs Hinv HinvG Hmmh Hmmhi Hincl Hincli Hmh Hpi Hmp. have Hhx2:= dom_hs_neq_ch _ _ _ _ _ Hhs hs_hx2. @@ -1759,13 +1759,13 @@ call(: !G1.bcol{2} split;1: by move=> [_ /(dom_hs_neq_ch _ _ _ _ _ Hhs)]. by move=> /= [_ <<-];move:Hc. split. - + by cut[]/#:=Hmp. - + by cut[]/#:=Hmp. - + cut[]_ _ h _ _ l hdom i hi:=Hmp. - cut[]b c[]->h':=h l hdom i hi. + + by have[]/#:=Hmp. + + by have[]/#:=Hmp. + + have[]_ _ h _ _ l hdom i hi:=Hmp. + have[]b c[]->h':=h l hdom i hi. by exists b c=>//=;rewrite get_setE/=-h';smt(domE take_oversize). - + by cut[]/#:=Hmp. - + by cut[]/#:=Hmp. + + by have[]/#:=Hmp. + + by have[]/#:=Hmp. move=> [xa xc] PFm_x1x2. rcondf{1} 1; 1:by auto=> &hr [#] !<<- _ _ ->>; rewrite domE PFm_x1x2. have /m_mh_of_INV [] + _ - /(_ _ _ _ _ PFm_x1x2) := inv0. move=> [hx2 fx2 hy2 fy2] [#] hs_hx2 hs_hy2 G1mh_x1hx2. @@ -1785,7 +1785,7 @@ call(: !G1.bcol{2} INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} Redo.prefixes{1} C.queries{2}); progress;2..-2:rewrite/#. - - by rewrite domE;cut[]_->_ _ _/=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. + - by rewrite domE;have[]_->_ _ _/=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. by inline*; if{2}; auto=> &1 &2 />; smt(F.sampleto_ll sampleto_ll). have /mh_of_INV []/(_ _ _ _ _ G1mh_x1hx2) + _ _:= inv0. move=> [xc0 xf0 yc0 yf0] [#]; rewrite hs_hx2 hs_hy2=> [#] !<<- [#] !<<- /= [p0 v0] [#] Hro Hpath. @@ -1806,7 +1806,7 @@ call(: !G1.bcol{2} rewrite (@huniq_hinvK_h hx2 hs0 x2) // 10?oget_some. + by have /hs_of_INV []:= inv0. rewrite Hro G1mh_x1hx2 hs_hy2 ?oget_some //=domE. - cut[]_->_ _ _//=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. + have[]_->_ _ _//=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ inv0. case(rng hs0 (x2, Unknown))=>//=_. exact/(@lemma3 _ _ _ _ _ _ _ _ _ _ _ _ _ _ hx2 _ _ hy2). by move=> /> &1 &2 -> ->. @@ -1844,18 +1844,18 @@ lemma lemma5 hs ch Pm Pmi Gm Gmi mh mhi ro pi prefixes queries i (p : block list mh.[(b +^ nth witness p i, h)] = Some (b',h'). proof. move=>Hinv H_size H_take_iS H_take_i H_hs_h. -cut[]_ _ H _ _:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ Hinv. -cut[]sa sc:=H _ H_take_iS i _;1:smt(size_take). +have[]_ _ H _ _:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ Hinv. +have[]sa sc:=H _ H_take_iS i _;1:smt(size_take). rewrite!take_take !minrE (: i <= i + 1) 1: /# nth_take 1,2:/#H_take_i=>[][]/=[->>->>] H_pm. -cut[]b' c' H_Pm:exists b' c', Pm.[(sa +^ nth witness p i, sc)] = Some (b',c'). +have[]b' c' H_Pm:exists b' c', Pm.[(sa +^ nth witness p i, sc)] = Some (b',c'). + rewrite H_pm. exists (oget prefixes.[take (i + 1) p]).`1 (oget prefixes.[take (i + 1) p]).`2. by move: H_take_iS; rewrite domE; case: (prefixes.[take (i + 1) p])=> //= - []. exists b' c';rewrite -H_Pm/=. -cut[]h_Pm _:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ Hinv. -cut[]h' f' hy fy[]H_h'[]H_hy H_mh:=h_Pm _ _ _ _ H_Pm. -cut[]h_huniq _ _:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ Hinv. -cut[]f H_h := H_hs_h. -cut/=<<-:=h_huniq _ _ _ _ H_h H_h'. +have[]h_Pm _:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ Hinv. +have[]h' f' hy fy[]H_h'[]H_hy H_mh:=h_Pm _ _ _ _ H_Pm. +have[]h_huniq _ _:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ Hinv. +have[]f H_h := H_hs_h. +have/=<<-:=h_huniq _ _ _ _ H_h H_h'. by rewrite H_mh/=/#. qed. @@ -1874,17 +1874,17 @@ proof. move=>Hinv H_size H_take_i H_hs_h. case(Pm.[(b +^ nth witness p i, c)] = None)=>//=H_Pm. + right;move:H_Pm;apply absurd=>H_mh. - cut[]b1 h1 H_mh1:exists b1 h1, mh.[(b +^ nth witness p i, h)] = Some (b1,h1). + have[]b1 h1 H_mh1:exists b1 h1, mh.[(b +^ nth witness p i, h)] = Some (b1,h1). + exists (oget mh.[(b +^ nth witness p i, h)]).`1 (oget mh.[(b +^ nth witness p i, h)]).`2. by move: H_mh; case: (mh.[(b +^ nth witness p i, h)])=> //= - []. - cut[]H_Pm H_Gmh:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ Hinv. - by cut/#:=H_Gmh _ _ _ _ H_mh1. -cut[]b1 c1 H_Pm1:exists b1 c1, Pm.[(b +^ nth witness p i, c)] = Some (b1,c1) + have[]H_Pm H_Gmh:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ Hinv. + by have/#:=H_Gmh _ _ _ _ H_mh1. +have[]b1 c1 H_Pm1:exists b1 c1, Pm.[(b +^ nth witness p i, c)] = Some (b1,c1) by exists (oget Pm.[(b +^ nth witness p i, c)]).`1 (oget Pm.[(b +^ nth witness p i, c)]).`2;smt(domE). -cut[]H_P_m H_Gmh:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ Hinv. -cut:=H_P_m _ _ _ _ H_Pm1. -cut[] :=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ Hinv. +have[]H_P_m H_Gmh:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ Hinv. +have:=H_P_m _ _ _ _ H_Pm1. +have[] :=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ Hinv. move=> hun *. have /> := H_P_m _ _ _ _ H_Pm1. move=> hx fx hy fy H1 H2 H3; exists b1 c1 hy => />. @@ -1914,7 +1914,7 @@ proof. INV_CF_G1 FRO.m{2} G1.chandle{2} PF.m{1} PF.mi{1} G1.m{2} G1.mi{2} G1.mh{2} G1.mhi{2} F.RO.m{2} G1.paths{2} Redo.prefixes{1} C.queries{2}.[bs{1} <- sa{1}] /\ F.RO.m.[p]{2} = Some sa{2});progress. - + by rewrite mem_set domE;left;cut[]_->_ _ _//=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H0. + + by rewrite mem_set domE;left;have[]_->_ _ _//=:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H0. + smt(mem_set). + smt(mem_set). + smt(mem_set). @@ -1972,12 +1972,12 @@ proof. else F.RO.m.[take i p]{2} = Some sa{1})) /\ 0 < size p{2});last first. - auto;progress. * smt(@Prefix). - * by cut[]:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H0;smt(take0 domE). - * by cut[]:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H0;smt(take0 domE). - * by cut[]:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H0. - * by cut[]:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H0;smt(take0 domE). + * by have[]:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H0;smt(take0 domE). + * by have[]:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H0;smt(take0 domE). + * by have[]:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H0. + * by have[]:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H0;smt(take0 domE). * by rewrite build_hpathP; apply/Empty=> //; exact/take0. - * by cut[]:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H0; smt(take0 domE size_take size_eq0 size_ge0). + * by have[]:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H0; smt(take0 domE size_take size_eq0 size_ge0). * smt(prefix_sizel). case(G1.bcol{2} \/ G1.bext{2}). @@ -2006,19 +2006,19 @@ proof. ! (G1.bcol{2} \/ G1.bext{2}) /\ (take (i+1) p \in Redo.prefixes){1} /\ 0 < size p{2} ==>_);progress. - - cut:=prefix_gt0_mem p{2} (elems (fdom C.queries{2})) _;1:rewrite/#. + - have:=prefix_gt0_mem p{2} (elems (fdom C.queries{2})) _;1:rewrite/#. rewrite-memE=>H_dom_q. - cut[]HINV[]->>/=[]->>/=[]H_h[]H_path H_F_RO:=H6 H12. - cut[]_ _ h1 h2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. - cut:=h2 (get_max_prefix p{2} (elems (fdom C.queries{2}))) _; 1:smt(mem_fdom). + have[]HINV[]->>/=[]->>/=[]H_h[]H_path H_F_RO:=H6 H12. + have[]_ _ h1 h2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + have:=h2 (get_max_prefix p{2} (elems (fdom C.queries{2}))) _; 1:smt(mem_fdom). move=>[]c; - cut H_dom_p:get_max_prefix p{2} (elems (fdom C.queries{2})) \in Redo.prefixes{1} by smt(domE mem_fdom). - cut->/=:=prefix_take_leq p{2} (get_max_prefix p{2} (elems (fdom C.queries{2}))) (i{2}+1) _;1:rewrite/#. + have H_dom_p:get_max_prefix p{2} (elems (fdom C.queries{2})) \in Redo.prefixes{1} by smt(domE mem_fdom). + have->/=:=prefix_take_leq p{2} (get_max_prefix p{2} (elems (fdom C.queries{2}))) (i{2}+1) _;1:rewrite/#. smt(domE take_oversize prefix_sizer). rcondt{1}1;1:auto;progress. rcondt{2}1;1:auto;progress. - - cut[]HINV[]->>/=[]->>/=[]H_h[]H_path H_F_RO:=H6 H11. - cut//=:=lemma5 _ _ _ _ _ _ _ _ _ _ _ _ i{hr} p{hr} sa{hr} sc{m} h{hr} HINV _ _ _ _. + - have[]HINV[]->>/=[]->>/=[]H_h[]H_path H_F_RO:=H6 H11. + have//=:=lemma5 _ _ _ _ _ _ _ _ _ _ _ _ i{hr} p{hr} sa{hr} sc{m} h{hr} HINV _ _ _ _. * by rewrite H0/=H7/=. * smt(domE). * rewrite/#. @@ -2029,35 +2029,35 @@ proof. - rewrite /#. - rewrite /#. - smt(domE). - - cut[]HINV[]->>/=[]->>/=[]H_h[]H_path H_F_RO/#:=H6 H11. - - cut[]HINV[]->>/=[]->>/=[]H_h[]H_path H_F_RO:=H6 H11. - cut[]H01 H02 H_pref1 H_pref2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. - cut//=:=lemma5 _ _ _ _ _ _ _ _ _ _ _ _ i{2} p{2} sa{2} sc{1} h{2} HINV _ _ _ _. + - have[]HINV[]->>/=[]->>/=[]H_h[]H_path H_F_RO/#:=H6 H11. + - have[]HINV[]->>/=[]->>/=[]H_h[]H_path H_F_RO:=H6 H11. + have[]H01 H02 H_pref1 H_pref2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + have//=:=lemma5 _ _ _ _ _ _ _ _ _ _ _ _ i{2} p{2} sa{2} sc{1} h{2} HINV _ _ _ _. * by rewrite H0/=H7/=. * smt(domE). * rewrite/#. * rewrite/#. move=>[]b2 c2 h2[]H_PFm H_Gmh. rewrite H_Gmh/=. - cut[]b6 c6[]:=H_pref1 _ H12 i{2} _;1:smt(size_take). + have[]b6 c6[]:=H_pref1 _ H12 i{2} _;1:smt(size_take). by rewrite!take_take !minrE (: i{2} <= i{2} + 1) //= 1:/# nth_take 1,2:/# H2/==>[][]->>->><-;rewrite H_PFm oget_some. - rewrite/#. - - cut[]HINV[]->>/=[]->>/=[]H_h[]H_path H_F_RO:=H6 H11. - cut[]H01 H02 H_pref1 H_pref2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. - cut//=:=lemma5 _ _ _ _ _ _ _ _ _ _ _ _ i{2} p{2} sa{2} sc{1} h{2} HINV _ _ _ _. + - have[]HINV[]->>/=[]->>/=[]H_h[]H_path H_F_RO:=H6 H11. + have[]H01 H02 H_pref1 H_pref2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + have//=:=lemma5 _ _ _ _ _ _ _ _ _ _ _ _ i{2} p{2} sa{2} sc{1} h{2} HINV _ _ _ _. * by rewrite H0/=H7/=. * smt(domE). * rewrite/#. * rewrite/#. move=>[]b2 c2 h2[]H_PFm H_Gmh. - cut[]b6 c6[]:=H_pref1 _ H12 i{2} _;1:smt(size_take). + have[]b6 c6[]:=H_pref1 _ H12 i{2} _;1:smt(size_take). rewrite!take_take !minrE (: i{2} <= i{2} + 1) // 1:/# nth_take 1,2:/# H2/=H_Gmh oget_some=>[][]<<-<<-<-. rewrite H_PFm oget_some/=. - cut [] help1 help2:= m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + have [] help1 help2:= m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + by have [] xc fx yc fy [#] /# := help2 _ _ _ _ H_Gmh. - - cut[]HINV[]->>/=[]->>/=[]H_h[]H_path H_F_RO:=H6 H11. - cut[]H01 H02 H_pref1 H_pref2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. - cut//=:=lemma5 _ _ _ _ _ _ _ _ _ _ _ _ i{2} p{2} sa{2} sc{1} h{2} HINV _ _ _ _. + - have[]HINV[]->>/=[]->>/=[]H_h[]H_path H_F_RO:=H6 H11. + have[]H01 H02 H_pref1 H_pref2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + have//=:=lemma5 _ _ _ _ _ _ _ _ _ _ _ _ i{2} p{2} sa{2} sc{1} h{2} HINV _ _ _ _. * by rewrite H0/=H7/=. * smt(domE). * rewrite/#. @@ -2066,18 +2066,18 @@ proof. by rewrite H_Gmh/= (@take_nth witness) 1:/# build_hpath_prefix/#. - rewrite/#. - rewrite/#. - - cut[]HINV[]->>/=[]->>/=[]H_h[]H_path H_F_RO:=H6 H11. - cut[]H01 H02 H_pref1 H_pref2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. - cut//=:=lemma5 _ _ _ _ _ _ _ _ _ _ _ _ i{2} p{2} sa{2} sc{1} h{2} HINV _ _ _ _. + - have[]HINV[]->>/=[]->>/=[]H_h[]H_path H_F_RO:=H6 H11. + have[]H01 H02 H_pref1 H_pref2:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + have//=:=lemma5 _ _ _ _ _ _ _ _ _ _ _ _ i{2} p{2} sa{2} sc{1} h{2} HINV _ _ _ _. * by rewrite H0/=H7/=. * smt(domE). * rewrite/#. * rewrite/#. move=>[]b2 c2 h2[]H_PFm H_Gmh. - cut[]b6 c6[]:=H_pref1 _ H12 i{2} _;1:smt(size_take). + have[]b6 c6[]:=H_pref1 _ H12 i{2} _;1:smt(size_take). rewrite!take_take !minrE (: i{2} <= i{2} + 1) 1:/# nth_take 1,2:/# H2/==>[][]<<-<<-<-. rewrite H_PFm/=(@take_nth witness)1:/#. - by cut[]help1 help2/# :=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + by have[]help1 help2/# :=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. alias{1} 1 prefixes = Redo.prefixes;sp. alias{2} 1 bad1 = G1.bcol;sp. @@ -2109,8 +2109,8 @@ proof. /\ (i{2} < size p{2} => ! take (i{2}+1) p{2} \in Redo.prefixes{1})));last first. + auto;progress. - smt(prefix_sizel). - - cut[]HINV [#] ->> _ _ _ h_sa_b0:=H3 H6;split;..-2:case:HINV=>//=. - cut[]Hmp01 Hmp02 Hmp1 Hmp2 Hmp3:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV; split=> //=. + - have[]HINV [#] ->> _ _ _ h_sa_b0:=H3 H6;split;..-2:case:HINV=>//=. + have[]Hmp01 Hmp02 Hmp1 Hmp2 Hmp3:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV; split=> //=. + move: h_sa_b0; case: (prefix p{2} (get_max_prefix p{2} (elems (fdom C.queries{2}))) = 0). + by move=> -> [#] ->> _; rewrite take0 get_set_sameE. smt(size_take get_setE). @@ -2121,7 +2121,7 @@ proof. by move=> n_not_crap; exists c; rewrite get_set_neqE. by move=> ->>; exists sc{1}; rewrite get_set_sameE H. by move=> l /Hmp3 [l2] ll2_in_q; exists l2; rewrite mem_set ll2_in_q. - - by cut[]HINV _:=H3 H6;cut:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + - by have[]HINV _:=H3 H6;have:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. - rewrite/#. - rewrite/#. - rewrite/#. @@ -2130,9 +2130,9 @@ proof. - rewrite/#. - rewrite/#. - rewrite/#. - - cut[]HINV[]->>[]->>[]H_h[]H_path H_F_RO:=H3 H6. - cut[]H01 H02 Hmp1 Hmp2 Hmp3:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. - cut H_pref_eq:=prefix_exchange_prefix_inv (elems (fdom C.queries{2})) + - have[]HINV[]->>[]->>[]H_h[]H_path H_F_RO:=H3 H6. + have[]H01 H02 Hmp1 Hmp2 Hmp3:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + have H_pref_eq:=prefix_exchange_prefix_inv (elems (fdom C.queries{2})) (elems (fdom Redo.prefixes{1})) p{2} _ _ _. * smt(memE domE mem_fdom). * smt(memE mem_fdom domE take_oversize size_take take_take nth_take take_le0). @@ -2154,51 +2154,51 @@ proof. sp;wp. if{1};2:rcondt{2}1;first last;3:rcondf{2}1;..3:auto. + progress. - cut[]HINV[]Hbad[]HINV0[]Hp1[]Hp2[]->>[]H_counter[]H_h[]H_path[]H_F_RO H_take_not_in:=H3 H6. - cut:=lemma5' _ _ _ _ _ _ _ _ _ _ _ _ i{hr} bs{m} sa{hr} sc{m} h{hr} HINV _ _ _. + have[]HINV[]Hbad[]HINV0[]Hp1[]Hp2[]->>[]H_counter[]H_h[]H_path[]H_F_RO H_take_not_in:=H3 H6. + have:=lemma5' _ _ _ _ _ _ _ _ _ _ _ _ i{hr} bs{m} sa{hr} sc{m} h{hr} HINV _ _ _. - smt(prefix_ge0). - exact H1. - exact H_h. - by cut:=H7;rewrite !domE=>->/=/#. + by have:=H7;rewrite !domE=>->/=/#. + progress. - rewrite/#. - rewrite/#. - by rewrite get_setE. - - cut[]HINV[]Hbad[]H_m_p0[]Hp1[]Hp2[]->>[]H_counter[]H_h[]H_path[]H_F_RO H_take_not_in:=H3 H6. + - have[]HINV[]Hbad[]H_m_p0[]Hp1[]Hp2[]->>[]H_counter[]H_h[]H_path[]H_F_RO H_take_not_in:=H3 H6. split;..-2:case:HINV=>//=. - cut[]Hmp01 Hmp02 Hmp1 Hmp2 Hmp3:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV;split=>//=. + have[]Hmp01 Hmp02 Hmp1 Hmp2 Hmp3:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV;split=>//=. * smt(get_setE size_take size_eq0 size_ge0 prefix_ge0). - * by cut[]_ Hmp02' _ _ _:=H_m_p0; + * by have[]_ Hmp02' _ _ _:=H_m_p0; smt(get_setE size_take size_eq0 size_ge0 prefix_ge0 take0). * move=>l;rewrite!mem_set. case(l = take (i{2} + 1) bs{1})=>//=[->>|]. + move=>j;rewrite size_take;1:smt(prefix_ge0). - cut->/=:(if i{2} + 1 < size bs{1} then i{2} + 1 else size bs{1}) = i{2} + 1 by rewrite/#. + have->/=:(if i{2} + 1 < size bs{1} then i{2} + 1 else size bs{1}) = i{2} + 1 by rewrite/#. move=>[]H0j HjiS;rewrite!get_setE. - cut->/=:! take j (take (i{2} + 1) bs{1}) = take (i{2} + 1) bs{1} by smt(size_take). + have->/=:! take j (take (i{2} + 1) bs{1}) = take (i{2} + 1) bs{1} by smt(size_take). rewrite!take_take!minrE (: j <= i{2} + 1) 1:/# (: j + 1 <= i{2} + 1) 1:/#. rewrite nth_take 2:/#;1:smt(prefix_ge0). case(j < i{2})=>Hij. - - cut->/=:!take (j + 1) bs{1} = take (i{2} + 1) bs{1} by smt(size_take). - by cut:=Hmp1(take i{2} bs{1}) _ j _; + - have->/=:!take (j + 1) bs{1} = take (i{2} + 1) bs{1} by smt(size_take). + by have:=Hmp1(take i{2} bs{1}) _ j _; smt(domE take_take nth_take prefix_ge0 size_take). - cut->>:j = i{2} by rewrite/#. + have->>:j = i{2} by rewrite/#. by exists sa{2} sc{1};rewrite H1/=;smt(). move=>h H_dom j []Hi0 Hisize;rewrite!get_setE. - cut->/=:!take j l = take (i{2} + 1) bs{1} by smt(domE take_oversize size_take take_take). - by cut->/=/#:!take (j+1) l = take (i{2} + 1) bs{1} + have->/=:!take j l = take (i{2} + 1) bs{1} by smt(domE take_oversize size_take take_take). + by have->/=/#:!take (j+1) l = take (i{2} + 1) bs{1} by smt(domE take_oversize size_take take_take). * move=>l;rewrite mem_set. case(l = take (i{2} + 1) bs{1})=>//=[->>|]. + by rewrite!get_setE/= /#. move=>h H_dom;rewrite!get_setE h/=. - cut[]H2mp01 H2mp02 H2mp1 H2mp2 H2mp3:=H_m_p0. + have[]H2mp01 H2mp02 H2mp1 H2mp2 H2mp3:=H_m_p0. rewrite-Hp1;1:smt(domE). by apply H2mp2. move=>l;rewrite !mem_set. case(l = take (i{2} + 1) bs{1})=>//=[->>|]. + by exists []; smt(cats0 mem_set). - move=>H_neq H_dom;cut[]l1:=Hmp3 _ H_dom;rewrite!mem_set;case=>H_case. + move=>H_neq H_dom;have[]l1:=Hmp3 _ H_dom;rewrite!mem_set;case=>H_case. + exists l1;by rewrite mem_set H_case. exists (rcons l1 (nth witness bs{1} i{2}));rewrite mem_set;right. by rewrite-rcons_cat (@take_nth witness);smt(prefix_ge0). @@ -2206,75 +2206,75 @@ proof. - rewrite/#. - smt(domE get_setE). - move:H9;rewrite mem_set;case;smt(prefix_ge0). - - cut[]HINV[]Hbad[]HINV0[]Hp1[]Hp2[]->>[]H_counter[]H_h[]H_path[]H_F_RO H_take_not_in:=H3 H6. - cut:=lemma5' _ _ _ _ _ _ _ _ _ _ _ _ i{2} bs{1} sa{2} sc{1} h{2} HINV _ _ _. + - have[]HINV[]Hbad[]HINV0[]Hp1[]Hp2[]->>[]H_counter[]H_h[]H_path[]H_F_RO H_take_not_in:=H3 H6. + have:=lemma5' _ _ _ _ _ _ _ _ _ _ _ _ i{2} bs{1} sa{2} sc{1} h{2} HINV _ _ _. - smt(prefix_ge0). - exact H1. - exact H_h. - by cut:=H7;rewrite !domE=>->/=/#. + by have:=H7;rewrite !domE=>->/=/#. - rewrite/#. - - cut[]HINV[]Hbad[]HINV0[]Hp1[]Hp2[]->>[]H_counter[]H_h[]H_path[]H_F_RO H_take_not_in:=H3 H6. - cut:=lemma5' _ _ _ _ _ _ _ _ _ _ _ _ i{2} bs{1} sa{2} sc{1} h{2} HINV _ _ _. + - have[]HINV[]Hbad[]HINV0[]Hp1[]Hp2[]->>[]H_counter[]H_h[]H_path[]H_F_RO H_take_not_in:=H3 H6. + have:=lemma5' _ _ _ _ _ _ _ _ _ _ _ _ i{2} bs{1} sa{2} sc{1} h{2} HINV _ _ _. - smt(prefix_ge0). - exact H1. - exact H_h. - cut:=H7;rewrite !domE=>->/=[]b4 c4 h4[]H_PFm H_Gmh;rewrite H_PFm H_Gmh !oget_some/=. - cut[]_ help:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. - cut:=help _ _ _ _ H_Gmh. - by cut[]f H_h':=H_h;rewrite H_h'/==>[][]a b c d[][]->>->>[];rewrite H_PFm/==>[]h'->>/#. - - cut[]HINV[]Hbad[]HINV0[]Hp1[]Hp2[]->>[]H_counter[]H_h[]H_path[]H_F_RO H_take_not_in:=H3 H6. - cut:=lemma5' _ _ _ _ _ _ _ _ _ _ _ _ i{2} bs{1} sa{2} sc{1} h{2} HINV _ _ _. + have:=H7;rewrite !domE=>->/=[]b4 c4 h4[]H_PFm H_Gmh;rewrite H_PFm H_Gmh !oget_some/=. + have[]_ help:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + have:=help _ _ _ _ H_Gmh. + by have[]f H_h':=H_h;rewrite H_h'/==>[][]a b c d[][]->>->>[];rewrite H_PFm/==>[]h'->>/#. + - have[]HINV[]Hbad[]HINV0[]Hp1[]Hp2[]->>[]H_counter[]H_h[]H_path[]H_F_RO H_take_not_in:=H3 H6. + have:=lemma5' _ _ _ _ _ _ _ _ _ _ _ _ i{2} bs{1} sa{2} sc{1} h{2} HINV _ _ _. - smt(prefix_ge0). - exact H1. - exact H_h. - cut:=H7;rewrite !domE=>->/=[]b4 c4 h4[]H_PFm H_Gmh. + have:=H7;rewrite !domE=>->/=[]b4 c4 h4[]H_PFm H_Gmh. rewrite (@take_nth witness);1:smt(prefix_ge0). by rewrite build_hpath_prefix H_path/=;smt(domE). - smt(prefix_ge0). - smt(prefix_ge0). - - cut[]HINV[]Hbad[]H_m_p0[]Hp1[]Hp2[]->>[]H_counter[]H_h[]H_path[]H_F_RO H_take_not_in:=H3 H6. - cut:=lemma5' _ _ _ _ _ _ _ _ _ _ _ _ i{2} bs{1} sa{2} sc{1} h{2} HINV _ _ _. + - have[]HINV[]Hbad[]H_m_p0[]Hp1[]Hp2[]->>[]H_counter[]H_h[]H_path[]H_F_RO H_take_not_in:=H3 H6. + have:=lemma5' _ _ _ _ _ _ _ _ _ _ _ _ i{2} bs{1} sa{2} sc{1} h{2} HINV _ _ _. - smt(prefix_ge0). - exact H1. - exact H_h. - cut:=H7;rewrite !domE=>->/=[]b4 c4 h4[]H_PFm H_Gmh. + have:=H7;rewrite !domE=>->/=[]b4 c4 h4[]H_PFm H_Gmh. rewrite(@take_nth witness);1:smt(prefix_ge0). - cut[]_ help H_uniq_path:=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + have[]_ help H_uniq_path:=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. by rewrite help H_path;smt(domE). - - cut[]HINV[]Hbad[]H_m_p0[]Hp1[]Hp2[]->>[]H_counter[]H_h[]H_path[]H_F_RO H_take_not_in:=H3 H6. + - have[]HINV[]Hbad[]H_m_p0[]Hp1[]Hp2[]->>[]H_counter[]H_h[]H_path[]H_F_RO H_take_not_in:=H3 H6. rewrite mem_set negb_or/=;split;2:smt(size_take prefix_ge0 take_oversize). - cut:=Hp2 (take (i{2} + 1 + 1) bs{1}). - pose P:= _ \/ _;cut/#:!P;rewrite/P;clear P;rewrite negb_or/=negb_exists/=;split. - * cut:=prefix_exchange_prefix_inv(elems (fdom C.queries{2}))(elems (fdom prefixes{1}))bs{1} _ _ _. - + by cut[]:=H_m_p0;smt(domE memE mem_fdom). - + cut[]Hmp01 Hmp02 Hmp1 Hmp2 Hmp3:=H_m_p0. - cut:=all_prefixes_of_m_p _ _ _ H_m_p0. + have:=Hp2 (take (i{2} + 1 + 1) bs{1}). + pose P:= _ \/ _;have/#:!P;rewrite/P;clear P;rewrite negb_or/=negb_exists/=;split. + * have:=prefix_exchange_prefix_inv(elems (fdom C.queries{2}))(elems (fdom prefixes{1}))bs{1} _ _ _. + + by have[]:=H_m_p0;smt(domE memE mem_fdom). + + have[]Hmp01 Hmp02 Hmp1 Hmp2 Hmp3:=H_m_p0. + have:=all_prefixes_of_m_p _ _ _ H_m_p0. + move=> h_prefixes l2; rewrite -memE mem_fdom=> /Hmp2 [c]. move=> pl2; move: (h_prefixes l2 _). + by rewrite domE pl2. by move=> + i - /(_ i); rewrite -memE mem_fdom. - + by cut[]:=H_m_p0;smt(memE domE mem_fdom). + + by have[]:=H_m_p0;smt(memE domE mem_fdom). by move=>H_pref_eq;rewrite -mem_fdom memE prefix_lt_size//= -H_pref_eq/#. by move=>j;case(0<=j<=i{2})=>//=[][]Hj0 Hji;smt(size_take prefix_ge0 take_le0). + progress. - cut[]HINV[]Hbad[]H_m_p0[]Hp1[]Hp2[]->>[]H_counter[]H_h[]H_path[]H_F_RO H_take_not_in:=H3 H6. - cut:=lemma5' _ _ _ _ _ _ _ _ _ _ _ _ i{hr} bs{m} sa{hr} sc{m} h{hr} HINV _ _ _. + have[]HINV[]Hbad[]H_m_p0[]Hp1[]Hp2[]->>[]H_counter[]H_h[]H_path[]H_F_RO H_take_not_in:=H3 H6. + have:=lemma5' _ _ _ _ _ _ _ _ _ _ _ _ i{hr} bs{m} sa{hr} sc{m} h{hr} HINV _ _ _. - smt(prefix_ge0). - exact H1. - exact H_h. - by cut:=H7;rewrite !domE=>/=->/=. + by have:=H7;rewrite !domE=>/=->/=. rcondt{2}1;1:auto=>/#. rcondt{2}5;auto;progress. * rewrite(@take_nth witness);1:smt(prefix_ge0);rewrite domE. - cut[]HINV[]H_bad[]H_m_p0[]Hp1[]Hp2[]->>[]H_counter[]H_h[]H_path[]H_F_RO H_i:=H3 H6. - cut[]:=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. - cut:=lemma5' _ _ _ _ _ _ _ _ _ _ _ _ i{hr} bs{m} sa{hr} sc{m} h{hr} HINV _ _ _. + have[]HINV[]H_bad[]H_m_p0[]Hp1[]Hp2[]->>[]H_counter[]H_h[]H_path[]H_F_RO H_i:=H3 H6. + have[]:=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + have:=lemma5' _ _ _ _ _ _ _ _ _ _ _ _ i{hr} bs{m} sa{hr} sc{m} h{hr} HINV _ _ _. * smt(prefix_ge0). * rewrite/#. * rewrite/#. - cut:=H7;rewrite domE =>/=->/=H_Gmh _ H_ H_path_uniq. - cut help:=H_ (take i{hr} bs{m}) (nth witness bs{m} i{hr});rewrite H_path/= in help. - cut:forall (b : block), + have:=H7;rewrite domE =>/=->/=H_Gmh _ H_ H_path_uniq. + have help:=H_ (take i{hr} bs{m}) (nth witness bs{m} i{hr});rewrite H_path/= in help. + have:forall (b : block), F.RO.m{hr}.[rcons (take i{hr} bs{m}) (nth witness bs{m} i{hr})] = Some b <=> exists hy, G1.mh{hr}.[(sa{hr} +^ nth witness bs{m} i{hr}, h{hr})] = Some (b, hy) by rewrite/#. move:help=>_ help;move:H_Gmh;apply absurd=>//=H_F_Ro. @@ -2285,156 +2285,156 @@ proof. * rewrite/#. * rewrite/#. * by rewrite!get_setE/=. - * cut[]HINV[]H_bad[]H_m_p0[]Hp1[]Hp2[]->>[]H_counter[][]f H_h[]H_path[]H_F_RO H_i:=H3 H6. - cut:=H10;rewrite !negb_or/==>[][][]bad1 hinv_none bad2. - cut H_hs_spec:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. - cut H_mh_spec:=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. - cut H_m_mh:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. - cut H_mi_mhi:=mi_mhi_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. - cut H_pi_spec:=pi_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. - cut :=lemma5' _ _ _ _ _ _ _ _ _ _ _ _ i{2} bs{1} sa{2} sc{1} h{2} HINV _ _ _. + * have[]HINV[]H_bad[]H_m_p0[]Hp1[]Hp2[]->>[]H_counter[][]f H_h[]H_path[]H_F_RO H_i:=H3 H6. + have:=H10;rewrite !negb_or/==>[][][]bad1 hinv_none bad2. + have H_hs_spec:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + have H_mh_spec:=mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + have H_m_mh:=m_mh_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + have H_mi_mhi:=mi_mhi_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + have H_pi_spec:=pi_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + have :=lemma5' _ _ _ _ _ _ _ _ _ _ _ _ i{2} bs{1} sa{2} sc{1} h{2} HINV _ _ _. * smt(prefix_ge0). * exact H1. * rewrite/#. - cut:=H7;rewrite domE/==>->/=h_g1. - cut H2_pi_spec:pi_spec FRO.m{2}.[G1.chandle{2} <- (y2L, Unknown)] + have:=H7;rewrite domE/==>->/=h_g1. + have H2_pi_spec:pi_spec FRO.m{2}.[G1.chandle{2} <- (y2L, Unknown)] G1.mh{2}.[(sa{2} +^ nth witness bs{1} i{2}, h{2}) <- (y1L, G1.chandle{2})] G1.paths{2}. + split;progress. - - cut[]h:=H_pi_spec;cut:=h c p0 v;rewrite H11/==>[][]h1[] h'1 h'2. + - have[]h:=H_pi_spec;have:=h c p0 v;rewrite H11/==>[][]h1[] h'1 h'2. exists h1;rewrite -h'2 get_setE/=. - cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h'2. + have->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h'2. by apply build_hpath_up=>//=. move:H12;rewrite get_setE/==>hh0. - cut h0_neq_ch:h0 <> G1.chandle{2} by rewrite/#. - cut[]->:=H_pi_spec;rewrite-hh0 h0_neq_ch/=;exists h0=>/=. - cut:=H;cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness bs{1} i{2}) y1L p0 v h0. + have h0_neq_ch:h0 <> G1.chandle{2} by rewrite/#. + have[]->:=H_pi_spec;rewrite-hh0 h0_neq_ch/=;exists h0=>/=. + have:=H;have:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness bs{1} i{2}) y1L p0 v h0. rewrite h_g1/=H/=h0_neq_ch/=. - cut->//=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec H_h. - cut -> /= <-//=:=ch_neq0 _ _ H_hs_spec;progress;cut[]hh1 hh2 hh3:=H_mh_spec;smt(dom_hs_neq_ch). + have->//=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec H_h. + have -> /= <-//=:=ch_neq0 _ _ H_hs_spec;progress;have[]hh1 hh2 hh3:=H_mh_spec;smt(dom_hs_neq_ch). split. - + apply hs_addh;1:cut//:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. - by cut:=hinvP FRO.m{2} y2L;rewrite hinv_none/=/#. - + by cut:=invG_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. - + apply inv_addm=>//;1:cut//:=inv_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + + apply hs_addh;1:have//:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + by have:=hinvP FRO.m{2} y2L;rewrite hinv_none/=/#. + + by have:=invG_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + + apply inv_addm=>//;1:have//:=inv_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. apply (notin_hs_notdomE2_mh FRO.m{2} PF.mi{1})=>//=. - by apply ch_notdomE_hs;cut:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. - + cut[] H_huniq _ _:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + by apply ch_notdomE_hs;have:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + + have[] H_huniq _ _:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. rewrite!get_setE/=. apply (m_mh_addh_addm _ H_m_mh H_huniq H_h _)=>//=. - by apply ch_notdomE_hs;cut:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. - + cut[] H_huniq _ _:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + by apply ch_notdomE_hs;have:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + + have[] H_huniq _ _:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. rewrite!get_setE/=;apply (mi_mhi_addh_addmi _ H_mi_mhi _ H_h _)=>//=. - smt(hinvP). - by apply ch_notdomE_hs;cut:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + by apply ch_notdomE_hs;have:=hs_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + apply incl_upd_nin=>//=. - by cut:=incl_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + by have:=incl_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + apply incl_upd_nin=>//=. - - by cut:=incli_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. - cut:=hinvP FRO.m{2} y2L;rewrite domE hinv_none/=;apply absurd=>H_P_mi. + - by have:=incli_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + have:=hinvP FRO.m{2} y2L;rewrite domE hinv_none/=;apply absurd=>H_P_mi. rewrite negb_forall/=. - cut H_inv_Gmh:=inv_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. - cut[]H_inv_Pm:=inv_mh_inv_Pm _ _ _ _ _ H_m_mh H_mi_mhi H_inv_Gmh. - cut[]H_Pmi H_Gmhi:=mi_mhi_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. - by cut[]/#:=H_Pmi y1L y2L (oget PF.mi{1}.[(y1L, y2L)]).`1 + have H_inv_Gmh:=inv_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + have[]H_inv_Pm:=inv_mh_inv_Pm _ _ _ _ _ H_m_mh H_mi_mhi H_inv_Gmh. + have[]H_Pmi H_Gmhi:=mi_mhi_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + by have[]/#:=H_Pmi y1L y2L (oget PF.mi{1}.[(y1L, y2L)]).`1 (oget PF.mi{1}.[(y1L, y2L)]).`2 _;1:smt(domE). - + cut H_take_Si:=take_nth witness i{2} bs{1} _;1:smt(prefix_ge0). + + have H_take_Si:=take_nth witness i{2} bs{1} _;1:smt(prefix_ge0). split=>//=. - move=>x hx y hy;rewrite !get_setE. case((x, hx) = (sa{2} +^ nth witness bs{1} i{2}, h{2}))=>//=. * move=>[->> ->>][<<- <<-]/=. - cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec H_h. + have->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec H_h. rewrite H_h/=. exists sc{1} f y2L Unknown=>//=. exists (take i{2} bs{1}) (sa{2})=>//=;rewrite get_setE Block.WRing.addKr/=. rewrite/=(@take_nth witness)/=;1:smt(prefix_ge0). by apply build_hpath_up=>//=;smt(domE). move=> neq h1. - cut[]hh1 hh2 hh3:=H_mh_spec. - cut[]xc hxx yc hyc []h2[]h3 h4:=hh1 _ _ _ _ h1. - cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h2. - cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h3. + have[]hh1 hh2 hh3:=H_mh_spec. + have[]xc hxx yc hyc []h2[]h3 h4:=hh1 _ _ _ _ h1. + have->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h2. + have->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h3. rewrite h2 h3/=;exists xc hxx yc hyc=>//=. move:h4;case(hyc = Known)=>//=neq2[]p0 b[]hp0 hb. exists p0 b;rewrite get_setE. - cut->/=:=build_hpath_up _ _ _ y1L G1.chandle{2} _ _ _ hb h_g1. - cut/#:!rcons p0 (b +^ x) = rcons (take i{2} bs{1}) (nth witness bs{1} i{2});move:neq;apply absurd=>//=h'. - cut<<-:take i{2} bs{1}=p0 by rewrite/#. - cut hbex:b +^ x = nth witness bs{1} i{2} by rewrite/#. - by cut:=hb;rewrite H_path/==>[][->>->>]/=;rewrite-hbex Block.WRing.addKr/=. + have->/=:=build_hpath_up _ _ _ y1L G1.chandle{2} _ _ _ hb h_g1. + have/#:!rcons p0 (b +^ x) = rcons (take i{2} bs{1}) (nth witness bs{1} i{2});move:neq;apply absurd=>//=h'. + have<<-:take i{2} bs{1}=p0 by rewrite/#. + have hbex:b +^ x = nth witness bs{1} i{2} by rewrite/#. + by have:=hb;rewrite H_path/==>[][->>->>]/=;rewrite-hbex Block.WRing.addKr/=. - progress. * move:H11;rewrite get_setE/=H_take_Si/=. case(p0 = (take i{2} bs{1}))=>[->>|hpp0];rewrite!get_setE/=. - + cut->/=:=build_hpath_up _ _ _ y1L G1.chandle{2} _ _ _ H_path h_g1. + + have->/=:=build_hpath_up _ _ _ y1L G1.chandle{2} _ _ _ H_path h_g1. case(bn = (nth witness bs{1} i{2}))=>[->> /= ->>|hbni]/=. - by exists sa{2} h{2} G1.chandle{2}=>//=;rewrite get_setE/=. - cut->/=:!rcons (take i{2} bs{1}) bn = rcons (take i{2} bs{1}) (nth witness bs{1} i{2}). + have->/=:!rcons (take i{2} bs{1}) bn = rcons (take i{2} bs{1}) (nth witness bs{1} i{2}). - move:hbni;apply absurd=>//=h. exact/(rconsIs _ _ h). move=>h_ro_p_bn. - cut[]_ hh4 _:=H_mh_spec. - by cut:=hh4 (take i{2} bs{1}) bn b0;rewrite h_ro_p_bn/=H_path/=;smt(get_setE @Block.WRing). - cut->/=:!rcons p0 bn = rcons (take i{2} bs{1}) (nth witness bs{1} i{2}). + have[]_ hh4 _:=H_mh_spec. + by have:=hh4 (take i{2} bs{1}) bn b0;rewrite h_ro_p_bn/=H_path/=;smt(get_setE @Block.WRing). + have->/=:!rcons p0 bn = rcons (take i{2} bs{1}) (nth witness bs{1} i{2}). + move:hpp0;apply absurd=>/=h. - cut:size p0 = size (take i{2} bs{1}) by smt(size_rcons). + have:size p0 = size (take i{2} bs{1}) by smt(size_rcons). move:h;pose p' := take i{2} bs{1};pose e := nth witness bs{1} i{2}. by move=>h h';move:p0 p' h' bn e h;apply seq2_ind=>//=/#. move=>h_ro_p_bn. - cut[]_ hh4 _:=H_mh_spec. - cut:=hh4 p0 bn b0;rewrite h_ro_p_bn/==>[][];progress. - cut help:(sa{2} +^ nth witness bs{1} i{2}, h{2}) <> (v +^ bn, hx) by rewrite/#. + have[]_ hh4 _:=H_mh_spec. + have:=hh4 p0 bn b0;rewrite h_ro_p_bn/==>[][];progress. + have help:(sa{2} +^ nth witness bs{1} i{2}, h{2}) <> (v +^ bn, hx) by rewrite/#. exists v hx hy=>//=;rewrite get_setE;rewrite eq_sym in help;rewrite help/=H12/=. by apply build_hpath_up=>//=. move:H11 H12;rewrite!get_setE/= =>h_build_hpath_set. case(hy = G1.chandle{2})=>//=[->>|hy_neq_ch]/=. - + move=>h;cut h_eq:v +^ bn = sa{2} +^ nth witness bs{1} i{2} && hx = h{2}. - + cut/#:G1.mh{2}.[(v +^ bn, hx)] <> Some (b0, G1.chandle{2}). - cut[]_ hh2:=H_m_mh. - cut:=hh2 (v +^ bn) hx b0 G1.chandle{2}. + + move=>h;have h_eq:v +^ bn = sa{2} +^ nth witness bs{1} i{2} && hx = h{2}. + + have/#:G1.mh{2}.[(v +^ bn, hx)] <> Some (b0, G1.chandle{2}). + have[]_ hh2:=H_m_mh. + have:=hh2 (v +^ bn) hx b0 G1.chandle{2}. case(G1.mh{2}.[(v +^ bn, hx)] = Some (b0, G1.chandle{2}))=>//=. rewrite negb_exists/=;progress; rewrite negb_exists/=;progress; rewrite negb_exists/=;progress; rewrite negb_exists/=;progress;rewrite !negb_and. - by cut[]/#:=H_hs_spec. - cut[]eq_xor ->>:=h_eq. + by have[]/#:=H_hs_spec. + have[]eq_xor ->>:=h_eq. move:h;rewrite eq_xor/==>->>. - cut/#:!(p0 = (take i{2} bs{1}) /\ bn = (nth witness bs{1} i{2})) => + have/#:!(p0 = (take i{2} bs{1}) /\ bn = (nth witness bs{1} i{2})) => F.RO.m{2}.[rcons p0 bn] = Some b0. move:H_h;case:f=>h_flag;last first. - - cut:=known_path_uniq _ _ _ sc{1} h{2} p0 v (take i{2} bs{1}) sa{2} H2_pi_spec _ h_build_hpath_set _. + - have:=known_path_uniq _ _ _ sc{1} h{2} p0 v (take i{2} bs{1}) sa{2} H2_pi_spec _ h_build_hpath_set _. * rewrite get_setE/=h_flag. - by cut->//=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h_flag. + by have->//=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h_flag. * by apply build_hpath_up=>//=. move=>[]->>->>/=;apply absurd=>//=_. - cut->:bn = sa{2} +^ sa{2} +^ bn;smt(@Block). - cut[]hh1 hh2 hh3:=H_mh_spec. - cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness bs{1} i{2}) b0 p0 v h{2}. + have->:bn = sa{2} +^ sa{2} +^ bn;smt(@Block). + have[]hh1 hh2 hh3:=H_mh_spec. + have:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness bs{1} i{2}) b0 p0 v h{2}. rewrite h_build_hpath_set/=h_g1/=. - cut->/=:=ch_neq0 _ _ H_hs_spec. - cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h_flag. - move=>help;cut:= help _;1:smt(dom_hs_neq_ch). + have->/=:=ch_neq0 _ _ H_hs_spec. + have->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec h_flag. + move=>help;have:= help _;1:smt(dom_hs_neq_ch). move=>h_build_hpath_p0. rewrite hh2 h_build_hpath_p0/==>h_neq. exists v h{2}=>//=. rewrite eq_xor h_g1/=;move:h_neq;apply absurd=>//=. - cut:=hh3 _ _ _ _ _ H_path h_build_hpath_p0. - cut->:bn = sa{2} +^ sa{2} +^ bn;smt(@Block). - move=>help;cut h_neq:! (v +^ bn = sa{2} +^ nth witness bs{1} i{2} /\ hx = h{2}) by rewrite/#. + have:=hh3 _ _ _ _ _ H_path h_build_hpath_p0. + have->:bn = sa{2} +^ sa{2} +^ bn;smt(@Block). + move=>help;have h_neq:! (v +^ bn = sa{2} +^ nth witness bs{1} i{2} /\ hx = h{2}) by rewrite/#. move:help. rewrite h_neq/==>h_g1_v_bn_hx. - cut[]hh1 hh2 hh3:=H_mh_spec. - cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness bs{1} i{2}) y1L p0 v hx. + have[]hh1 hh2 hh3:=H_mh_spec. + have:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness bs{1} i{2}) y1L p0 v hx. rewrite h_build_hpath_set/=h_g1/=. - cut->/=:=ch_neq0 _ _ H_hs_spec. - by cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec H_h; smt(dom_hs_neq_ch). + have->/=:=ch_neq0 _ _ H_hs_spec. + by have->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec H_h; smt(dom_hs_neq_ch). progress. - + cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness bs{1} i{2}) y1L p0 v hx. - cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness bs{1} i{2}) y1L p' v' hx. + + have:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness bs{1} i{2}) y1L p0 v hx. + have:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness bs{1} i{2}) y1L p' v' hx. move:H11 H12;rewrite!get_setE/= =>H13 H14;rewrite H13 H14. - cut->/=:=ch_neq0 _ _ H_hs_spec. - cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec H_h. + have->/=:=ch_neq0 _ _ H_hs_spec. + have->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec H_h. rewrite h_g1/=. - cut[]:=H_mh_spec => HH1 HH2 HH3 HH4 HH5. + have[]:=H_mh_spec => HH1 HH2 HH3 HH4 HH5. have toto:(forall (xa xb : block) (ha hb : int), G1.mh{2}.[(xa, ha)] = Some (xb, hb) => ha <> G1.chandle{2} /\ hb <> G1.chandle{2}). @@ -2455,13 +2455,13 @@ proof. by have[#]->><<-//=:=HH3 _ _ _ _ _ hp11 H_path. move=>hp21 hp11. by have[#]->>->>:=HH3 _ _ _ _ _ hp21 hp11. - cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness bs{1} i{2}) y1L p0 v hx. - cut:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness bs{1} i{2}) y1L p' v' hx. + have:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness bs{1} i{2}) y1L p0 v hx. + have:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness bs{1} i{2}) y1L p' v' hx. move:H11 H12;rewrite!get_setE/= =>H13 H14;rewrite H13 H14/=. - cut->/=:=ch_neq0 _ _ H_hs_spec. - cut->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec H_h. + have->/=:=ch_neq0 _ _ H_hs_spec. + have->/=:=dom_hs_neq_ch _ _ _ _ _ H_hs_spec H_h. rewrite h_g1/=. - cut[]:=H_mh_spec => HH1 HH2 HH3 HH4 HH5. + have[]:=H_mh_spec => HH1 HH2 HH3 HH4 HH5. have toto:(forall (xa xb : block) (ha hb : int), G1.mh{2}.[(xa, ha)] = Some (xb, hb) => ha <> G1.chandle{2} /\ hb <> G1.chandle{2}). @@ -2484,44 +2484,44 @@ proof. by have[#]->>->>:=HH3 _ _ _ _ _ hp21 hp11. + rewrite!get_setE/=;exact H2_pi_spec. + rewrite!get_setE/=. - cut H_m_p:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. - cut H_all_prefixes:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + have H_m_p:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. + have H_all_prefixes:=all_prefixes_of_INV _ _ _ _ _ _ _ _ _ _ _ _ HINV. split;case:H_m_p=>//=Hmp01 Hmp02 Hmp1 Hmp2 Hmp3. - smt(get_setE size_take prefix_ge0). - - by cut[]:=H_m_p0;smt(get_setE size_take prefix_ge0). + - by have[]:=H_m_p0;smt(get_setE size_take prefix_ge0). - move=>l;rewrite mem_set;case=>H_case j []Hj0. * move=>Hjsize;rewrite!get_setE/=. - cut->/=:!take j l = take (i{2} + 1) bs{1} by rewrite/#. - cut->/=:!take (j+1) l = take (i{2} + 1) bs{1} by rewrite/#. + have->/=:!take j l = take (i{2} + 1) bs{1} by rewrite/#. + have->/=:!take (j+1) l = take (i{2} + 1) bs{1} by rewrite/#. smt(domE get_setE). - cut->>:=H_case;rewrite size_take;1:smt(prefix_ge0). - cut->/=:(if i{2} + 1 < size bs{1} then i{2} + 1 else size bs{1}) = i{2} + 1 by rewrite/#. + have->>:=H_case;rewrite size_take;1:smt(prefix_ge0). + have->/=:(if i{2} + 1 < size bs{1} then i{2} + 1 else size bs{1}) = i{2} + 1 by rewrite/#. move=>HjiS;rewrite!get_setE. - cut->/=:! take j (take (i{2} + 1) bs{1}) = take (i{2} + 1) bs{1} by smt(size_take). + have->/=:! take j (take (i{2} + 1) bs{1}) = take (i{2} + 1) bs{1} by smt(size_take). rewrite!take_take!minrE (: j <= i{2} + 1) 1:/# (: j + 1 <= i{2} + 1) 1:/#. rewrite nth_take 2:/#;1:smt(prefix_ge0). case(j < i{2})=>Hij. - - cut->/=:!take (j + 1) bs{1} = take (i{2} + 1) bs{1} by smt(size_take). - by cut:=Hmp1(take i{2} bs{1}) _ j _;smt(domE take_take nth_take prefix_ge0 size_take get_setE). - cut->>:j = i{2} by rewrite/#. + - have->/=:!take (j + 1) bs{1} = take (i{2} + 1) bs{1} by smt(size_take). + by have:=Hmp1(take i{2} bs{1}) _ j _;smt(domE take_take nth_take prefix_ge0 size_take get_setE). + have->>:j = i{2} by rewrite/#. by exists sa{2} sc{1};rewrite H1/=;smt(get_setE domE). - move=>l;rewrite mem_set. case(l = take (i{2} + 1) bs{1})=>//=[->>|]. + by rewrite!get_setE/= /#. move=>h H_dom;rewrite!get_setE h/=. - cut[]H2mp01 H2mp02 H2mp1 H2mp2 H2mp3:=H_m_p0. + have[]H2mp01 H2mp02 H2mp1 H2mp2 H2mp3:=H_m_p0. rewrite-Hp1;1:smt(domE). by apply H2mp2. move=>l;rewrite !mem_set. case(l = take (i{2} + 1) bs{1})=>//=[->>|]. + by exists []; smt(cats0 mem_set). - move=>H_neq H_dom;cut[]l1:=Hmp3 _ H_dom;rewrite!mem_set;case=>H_case. + move=>H_neq H_dom;have[]l1:=Hmp3 _ H_dom;rewrite!mem_set;case=>H_case. + exists l1;by rewrite mem_set H_case. exists (rcons l1 (nth witness bs{1} i{2}));rewrite mem_set;right. by rewrite-rcons_cat (@take_nth witness);smt(prefix_ge0). * rewrite/#. - * cut[]HINV[]H_bad[]H_m_p0[]Hp1[]Hp2[]->>[]H_counter[][]f H_h[]H_path[]H_F_RO H_i:=H3 H6. - split;cut[]//= hmp01 hmp02 hmp1 hmp2 hmp3:=H_m_p0. + * have[]HINV[]H_bad[]H_m_p0[]Hp1[]Hp2[]->>[]H_counter[][]f H_h[]H_path[]H_F_RO H_i:=H3 H6. + split;have[]//= hmp01 hmp02 hmp1 hmp2 hmp3:=H_m_p0. move=> l l_in_pref i hisize. have//[] sa sc [#] pref_sasc pm_pref:= hmp1 l l_in_pref i hisize. by exists sa sc; smt(get_setE domE take_take take_nth size_take @@ -2532,28 +2532,28 @@ proof. + rewrite/#. + by rewrite!get_setE/=/#. + rewrite!get_setE/=(@take_nth witness);1:smt(prefix_ge0);rewrite build_hpath_prefix. - cut[]HINV[]H_bad[]H_m_p0[]Hp1[]Hp2[]->>[]H_counter[][]f H_h[]H_path[]H_F_RO H_i:=H3 H6. - cut:=lemma5' _ _ _ _ _ _ _ _ _ _ _ _ i{2} bs{1} sa{2} sc{1} h{2} HINV _ _ _. + have[]HINV[]H_bad[]H_m_p0[]Hp1[]Hp2[]->>[]H_counter[][]f H_h[]H_path[]H_F_RO H_i:=H3 H6. + have:=lemma5' _ _ _ _ _ _ _ _ _ _ _ _ i{2} bs{1} sa{2} sc{1} h{2} HINV _ _ _. - smt(prefix_ge0). - exact H1. - rewrite/#. - cut:=H7;rewrite domE=>/=->/=H_Gmh. - cut->/=:=build_hpath_up_None _ _ (y1L, G1.chandle{2})_ _ H_Gmh H_path;smt(get_setE). + have:=H7;rewrite domE=>/=->/=H_Gmh. + have->/=:=build_hpath_up_None _ _ (y1L, G1.chandle{2})_ _ H_Gmh H_path;smt(get_setE). + smt(prefix_ge0). + smt(prefix_ge0). + by rewrite!get_setE. rewrite!mem_set negb_or/=;split;2:smt(prefix_ge0 size_take prefix_ge0 take_oversize). - cut[]HINV[]H_bad[]H_m_p0[]Hp1[]Hp2[]->>[]H_counter[][]f H_h[]H_path[]H_F_RO H_i:=H3 H6. - cut:=Hp2 (take (i{2} + 1 + 1) bs{1}). - pose P:= _ \/ _;cut/#:!P;rewrite/P;clear P;rewrite negb_or/=negb_exists/=;split. - * cut:=prefix_exchange_prefix_inv(elems (fdom C.queries{2}))(elems (fdom prefixes{1}))bs{1} _ _ _. - + by cut[]:=H_m_p0;smt(domE memE mem_fdom). - + cut[]Hmp01 Hmp02 Hmp1 Hmp2 Hmp3:=H_m_p0. - cut:=all_prefixes_of_m_p _ _ _ H_m_p0. + have[]HINV[]H_bad[]H_m_p0[]Hp1[]Hp2[]->>[]H_counter[][]f H_h[]H_path[]H_F_RO H_i:=H3 H6. + have:=Hp2 (take (i{2} + 1 + 1) bs{1}). + pose P:= _ \/ _;have/#:!P;rewrite/P;clear P;rewrite negb_or/=negb_exists/=;split. + * have:=prefix_exchange_prefix_inv(elems (fdom C.queries{2}))(elems (fdom prefixes{1}))bs{1} _ _ _. + + by have[]:=H_m_p0;smt(domE memE mem_fdom). + + have[]Hmp01 Hmp02 Hmp1 Hmp2 Hmp3:=H_m_p0. + have:=all_prefixes_of_m_p _ _ _ H_m_p0. move=> + l2; rewrite -memE mem_fdom=> + /Hmp2 [c] l2_in_q - /(_ l2 _). + by rewrite domE l2_in_q. by move=> + i - /(_ i); rewrite -memE mem_fdom. - + by cut[]:=H_m_p0;smt(memE domE mem_fdom). + + by have[]:=H_m_p0;smt(memE domE mem_fdom). by move=>H_pref_eq;rewrite -mem_fdom memE prefix_lt_size//= -H_pref_eq/#. by move=>j;case(0<=j<=i{2})=>//=[][]Hj0 Hji;smt(size_take prefix_ge0 take_le0). qed. @@ -2597,7 +2597,7 @@ section AUX. F.RO.m{2} G1.paths{2} Redo.prefixes{1} C.queries{2}). + by move=> &1 &2; rewrite negb_or. - + progress;cut[]:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H0;smt(domE). + + progress;have[]:=m_p_of_INV _ _ _ _ _ _ _ _ _ _ _ _ H0;smt(domE). (* For now, everything is completely directed by the syntax of programs, so we can *try* to identify general principles of that weird data structure and of its invariant. I'm not sure we'll ever @@ -2683,11 +2683,11 @@ section. + Pr[G1(DRestr(D)).main() @&m: G1.bext]. proof. apply (@RealOrder.ler_trans _ _ _ (Real_Concrete D D_ll &m))=>//=. - cut : Pr[CF(DRestr(D)).main() @ &m : res] <= + have : Pr[CF(DRestr(D)).main() @ &m : res] <= Pr[G1(DRestr(D)).main() @ &m : res] + Pr[G1(DRestr(D)).main() @ &m : G1.bcol \/ G1.bext]. + byequiv (CF_G1 D D_ll)=>//=/#. - cut/#:Pr[G1(DRestr(D)).main() @ &m : G1.bcol \/ G1.bext] + have/#:Pr[G1(DRestr(D)).main() @ &m : G1.bcol \/ G1.bext] <= Pr[G1(DRestr(D)).main() @&m: G1.bcol] + Pr[G1(DRestr(D)).main() @&m: G1.bext]. rewrite Pr[mu_or];smt(Distr.mu_bounded). diff --git a/proof/smart_counter/SLCommon.ec b/proof/smart_counter/SLCommon.ec index 76cecbf..33fdb7b 100644 --- a/proof/smart_counter/SLCommon.ec +++ b/proof/smart_counter/SLCommon.ec @@ -406,7 +406,7 @@ lemma all_take_in (l : block list) i prefixes : i <= prefix l (get_max_prefix l (elems (fdom prefixes))). proof. move=>[hi0 hisize] all_prefix take_in_dom. -cut->:i = prefix l (take i l);2:smt(get_max_prefix_max memE mem_fdom). +have ->:i = prefix l (take i l);2:smt(get_max_prefix_max memE mem_fdom). apply get_prefix. + smt(size_take). + by right;left;apply size_eq0;rewrite size_drop//size_take//=/#. @@ -424,7 +424,7 @@ proof. move=>h_i h_nil h_all_prefixes take_in_dom [?[h_prefix_inv h_exist]]. case(take i l = [])=>//=h_take_neq_nil. + smt(prefix_ge0 size_take). -cut[l2 h_l2_mem]:=h_exist l i h_take_neq_nil take_in_dom. +have [l2 h_l2_mem]:=h_exist l i h_take_neq_nil take_in_dom. rewrite -mem_fdom memE in h_l2_mem. rewrite(StdOrder.IntOrder.ler_trans _ _ _ _ (get_max_prefix_max _ _ _ h_l2_mem)). rewrite-{1}(cat_take_drop i l)prefix_cat size_take 1:/#;smt(prefix_ge0). @@ -446,8 +446,8 @@ move=>l3 ll Hind l1 l2[->|[->|h1]]. + by rewrite prefix_eq max_prefix_eq ltzNge prefix_sizel /= prefix_eq. + rewrite prefix_eq max_prefix_eq. case(prefix l3 l2 < size l3)=>//=h;1:by rewrite prefix_eq. - cut h1:prefix l3 l2 = size l3 by smt(prefix_sizel). - cut: size l3 <= prefix l3 (max_prefix l3 l2 ll);2:smt(prefix_sizel). + have h1: prefix l3 l2 = size l3 by smt(prefix_sizel). + have: size l3 <= prefix l3 (max_prefix l3 l2 ll);2:smt(prefix_sizel). rewrite-h1. by clear Hind l1 h h1;move:l2 l3;elim:ll=>//=l3 ll Hind l1 l2/#. by case(prefix l1 l2 < prefix l1 l3)=>//=/#. @@ -475,7 +475,7 @@ lemma prefix_geq (l1 l2 : 'a list) : proof. move:l2;elim:l1=>//=[[] //=|] e1 l1 Hind l2;elim:l2=>//=e2 l2 Hind2. case(e1=e2)=>//=h12. -cut->/=:! 1 + prefix l1 l2 <= 0 by smt(prefix_ge0). +have ->/=:! 1 + prefix l1 l2 <= 0 by smt(prefix_ge0). rewrite h12/=/#. qed. @@ -484,7 +484,7 @@ lemma prefix_take_prefix (l1 l2 : 'a list) : proof. move:l2;elim:l1=>//=e1 l1 Hind l2;elim:l2=>//=e2 l2 Hind2. case(e1=e2)=>//=h12. -cut->/=:! 1 + prefix l1 l2 <= 0 by smt(prefix_ge0). +have ->/=:! 1 + prefix l1 l2 <= 0 by smt(prefix_ge0). rewrite h12/=/#. qed. @@ -508,11 +508,11 @@ lemma prefix_take_geq_prefix (l1 l2 : 'a list) i : prefix l1 l2 = prefix (take i l1) l2. proof. move=>hi. -cut:prefix (take i l1) l2 <= prefix l1 l2. +have: prefix (take i l1) l2 <= prefix l1 l2. + rewrite-{2}(cat_take_drop i l1) prefix_leq_prefix_cat. -cut/#:prefix l1 l2 <= prefix (take i l1) l2. +have /#: prefix l1 l2 <= prefix (take i l1) l2. rewrite -prefix_take_prefix. -rewrite-(cat_take_drop (prefix l1 l2) (take i l1))take_take minrE hi //=. +rewrite -(cat_take_drop (prefix l1 l2) (take i l1))take_take minrE hi //=. by rewrite prefix_leq_prefix_cat. qed. @@ -555,19 +555,19 @@ move:l;elim:ll=>//=l2 ll Hind l1;clear Hind;move:l1 l2;elim:ll=>//=. rewrite-(cat_take_drop (prefix l1 l2) (take i l1)) -{3}(cat_take_drop (prefix l1 l2) l2)take_take/min H0/=. rewrite prefix_take. - cut:drop (prefix l1 l2) (take i l1) <> drop (prefix l1 l2) l2;2:smt(catsI). + have: drop (prefix l1 l2) (take i l1) <> drop (prefix l1 l2) l2;2:smt(catsI). rewrite (prefix_take_geq_prefix l1 l2 i) 1:/#. - cut:=drop_prefix_neq (take i l1) l2. - cut/#:drop (prefix (take i l1) l2) (take i l1) <> []. - cut:0 < size (drop (prefix (take i l1) l2) (take i l1));2:smt(size_eq0). + have:= drop_prefix_neq (take i l1) l2. + have /#: drop (prefix (take i l1) l2) (take i l1) <> []. + have: 0 < size (drop (prefix (take i l1) l2) (take i l1));2:smt(size_eq0). rewrite size_drop 1:prefix_ge0 size_take;1:smt(prefix_ge0). by rewrite-prefix_take_geq_prefix /#. move=>l3 ll hind l1 l2. case(prefix l1 l2 < prefix l1 l3)=>//=h;progress. + rewrite!negb_or/=. - cut:=hind l1 l3 H i H0;rewrite negb_or=>[][->->]/=. - cut:=hind l1 l2 _ i _;smt(prefix_prefix_prefix). + have:= hind l1 l3 H i H0;rewrite negb_or=>[][->->]/=. + have:= hind l1 l2 _ i _;smt(prefix_prefix_prefix). smt(prefix_prefix_prefix). qed. @@ -579,10 +579,10 @@ lemma asfadst queries prefixes (bs : block list) : take (prefix bs (get_max_prefix bs (elems (fdom queries))) + 1) bs = bs. proof. progress. -cut h:=prefix_inv_leq bs (size bs) prefixes queries _ _ _ _ _;rewrite//=. +have h:=prefix_inv_leq bs (size bs) prefixes queries _ _ _ _ _;rewrite//=. + exact size_ge0. + rewrite H2//=;exact size_ge0. -cut->/=:prefix bs (get_max_prefix bs (elems (fdom queries))) = size bs by smt(prefix_sizel). +have ->/=: prefix bs (get_max_prefix bs (elems (fdom queries))) = size bs by smt(prefix_sizel). rewrite take_oversize/#. qed. @@ -598,9 +598,9 @@ case(ll1 = [])=>//=[-> _ _|]. move=> ll1_nil incl all_prefix incl2; have ll2_nil: ll2 <> [] by smt(mem_eq0). have:= get_max_prefix_max l ll2 (get_max_prefix l ll1) _. + by rewrite incl mem_get_max_prefix ll1_nil. -cut mem_ll2:=mem_get_max_prefix l ll2 ll2_nil. -cut[]l3 mem_ll1:=incl2 _ mem_ll2. -cut:=get_max_prefix_max l ll1 _ mem_ll1. +have mem_ll2:=mem_get_max_prefix l ll2 ll2_nil. +have[]l3 mem_ll1:=incl2 _ mem_ll2. +have:=get_max_prefix_max l ll1 _ mem_ll1. smt(prefixC prefix_leq_prefix_cat). qed. @@ -609,7 +609,7 @@ lemma prefix_inv_nil queries prefixes : elems (fdom queries) = [] => fdom prefixes \subset fset1 []. proof. move=>[h1 [h2 h3]] h4 x h5;rewrite in_fset1. -cut:=h3 x (size x). +have:=h3 x (size x). rewrite take_size -mem_fdom h5/=;apply absurd=>//=h6. rewrite h6/=negb_exists/=;smt(memE mem_fdom). qed. @@ -639,12 +639,12 @@ lemma prefix_exchange queries prefixes (l : block list) : proof. move=> [h1[h2 h3]] h5. case: (elems (fdom queries) = [])=> h4. -+ cut h6:=prefix_inv_nil queries prefixes _ h4;1:rewrite/#. ++ have h6:=prefix_inv_nil queries prefixes _ h4;1:rewrite/#. rewrite h4/=. have fdom_prefixP: fdom prefixes = fset0 \/ fdom prefixes = fset1 []. + by move: h6; rewrite !fsetP /(\subset); smt(in_fset0 in_fset1). case(elems (fdom prefixes) = [])=>//=[->//=|]h7. - cut h8:elems (fdom prefixes) = [[]]. + have h8:elems (fdom prefixes) = [[]]. + have []:= fdom_prefixP. + by move=> h8; move: h7; rewrite h8 elems_fset0. by move=> ->; rewrite elems_fset1. @@ -679,7 +679,7 @@ proof. move=>[]H_incl H_all_prefixes Hi. rewrite (prefix_take_leq _ (get_max_prefix l (elems (fdom queries))))1:/#. rewrite H_all_prefixes. -cut:get_max_prefix l (elems (fdom queries)) \in queries;2:smt(domE). +have:get_max_prefix l (elems (fdom queries)) \in queries;2:smt(domE). by rewrite -mem_fdom memE;apply prefix_gt0_mem=>/#. smt(prefix_sizer). qed. @@ -722,14 +722,14 @@ case(prefix (l1 ++ l2) l3 < prefix (l1 ++ l2) l4)=>//=. case(prefix l1 l3 = size l1)=>//=H_l1l3;case(prefix l1 l4 = size l1)=>//=H_l1l4. - rewrite H_l1l4 H_l1l3/=ltz_add2l=>h;rewrite h/=. rewrite(StdOrder.IntOrder.ler_trans _ _ _ (hind _ _ _)). - cut->/=:prefix l1 (max_prefix l1 l4 ll) = size l1 + have->/=:prefix l1 (max_prefix l1 l4 ll) = size l1 by move:{hind};elim:ll=>//=;smt(prefix_sizel). - by cut->/=:prefix l1 (max_prefix l1 l3 ll) = size l1 + by have->/=:prefix l1 (max_prefix l1 l3 ll) = size l1 by move:{hind};elim:ll=>//=;smt(prefix_sizel). - smt(prefix_sizel prefix_ge0). - - cut->/=h:prefix l1 l3 < prefix l1 l4 by smt(prefix_sizel). + - have->/=h:prefix l1 l3 < prefix l1 l4 by smt(prefix_sizel). rewrite(StdOrder.IntOrder.ler_trans _ _ _ (hind _ _ _)). - cut->/=:prefix l1 (max_prefix l1 l4 ll) = size l1 + have->/=:prefix l1 (max_prefix l1 l4 ll) = size l1 by move:{hind};elim:ll=>//=;smt(prefix_sizel). smt(prefix_prefix_prefix). move=>H_l3l4;rewrite H_l3l4/=. @@ -740,9 +740,9 @@ rewrite 2!prefix_cat1. case(prefix l1 l3 = size l1)=>//=H_l1l3;case(prefix l1 l4 = size l1)=>//=H_l1l4. + by rewrite H_l1l4 H_l1l3/=ltz_add2l=>h;rewrite h/=hind. + rewrite H_l1l3. - cut->/=:!size l1 < prefix l1 l4 by smt(prefix_sizel). + have->/=:!size l1 < prefix l1 l4 by smt(prefix_sizel). rewrite(StdOrder.IntOrder.ler_trans _ _ _ (hind _ _ _))//=. - cut->//=:prefix l1 (max_prefix l1 l3 ll) = size l1 + have->//=:prefix l1 (max_prefix l1 l3 ll) = size l1 by move:{hind};elim:ll=>//=;smt(prefix_sizel). smt(prefix_prefix_prefix). + smt(prefix_sizel prefix_ge0). @@ -793,8 +793,8 @@ lemma invm_set (m mi : ('a * 'b, 'a * 'b) fmap) x y : ! x \in m => ! rng m y => invm m mi => invm m.[x <- y] mi.[y <- x]. proof. move=>Hxdom Hyrng Hinv a b; rewrite !get_setE; split. -+ case(a=x)=>//=hax hab;cut->/#:b<>y. - by cut/#: rng m b;rewrite rngE /#. ++ case(a=x)=>//=hax hab;have->/#:b<>y. + by have/#: rng m b;rewrite rngE /#. case(a=x)=>//=hax. + case(b=y)=>//=hby. by rewrite (eq_sym y b)hby/=-Hinv hax;rewrite domE /=/# in Hxdom. @@ -1068,18 +1068,18 @@ lemma hinvP handles c: else exists f, handles.[oget (hinv handles c)] = Some(c,f). proof. move=> @/hinv. -cut @/pred1@/(\o)/=[[h []->[]Hmem <<-]|[]->H h f]/= := +have @/pred1@/(\o)/=[[h []->[]Hmem <<-]|[]->H h f]/= := findP (fun (_ : handle) => pred1 c \o fst) handles. + exists (oget handles.[h]).`2. by move: Hmem; rewrite domE; case: (handles.[h])=> //= - []. -by cut := H h;rewrite domE /#. +by have := H h;rewrite domE /#. qed. lemma huniq_hinv (handles:handles) (h:handle): huniq handles => dom handles h => hinv handles (oget handles.[h]).`1 = Some h. proof. move=> Huniq;pose c := (oget handles.[h]).`1. -cut:=Huniq h;cut:=hinvP handles c. +have:=Huniq h;have:=hinvP handles c. case (hinv _ _)=> /=[Hdiff _| h' +/(_ h')]. + rewrite domE /=; move: (Hdiff h (oget handles.[h]).`2). by rewrite /c; case: handles.[h]=> //= - []. @@ -1092,7 +1092,7 @@ lemma hinvKP handles c: else handles.[oget (hinvK handles c)] = Some(c,Known). proof. rewrite /hinvK. - cut @/pred1/= [[h]|][->/=]:= findP (+ pred1 c) (restr Known handles). + have @/pred1/= [[h]|][->/=]:= findP (+ pred1 c) (restr Known handles). + by rewrite domE restrP;case (handles.[h])=>//= /#. by move=>+h-/(_ h);rewrite domE restrP => H1/#. qed. From 82053a7aadde4edd5e6cd6ed09f7b0a92adab59d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Tue, 2 Mar 2021 14:06:44 +0000 Subject: [PATCH 510/525] Finish fixing Sponge --- proof/SHA3OSecurity.ec | 120 +++++++++++++++++++++-------------------- proof/SHA3_OIndiff.ec | 4 +- proof/SecureORO.eca | 21 ++++---- 3 files changed, 74 insertions(+), 71 deletions(-) diff --git a/proof/SHA3OSecurity.ec b/proof/SHA3OSecurity.ec index 10b041a..b1e5936 100644 --- a/proof/SHA3OSecurity.ec +++ b/proof/SHA3OSecurity.ec @@ -44,12 +44,12 @@ axiom dout_equal_dlist : dmap dout to_list = dlist dbool size_out. lemma doutE1 x : mu1 dout x = inv (2%r ^ size_out). proof. -cut->:inv (2%r ^ size_out) = mu1 (dlist dbool size_out) (to_list x). +have->:inv (2%r ^ size_out) = mu1 (dlist dbool size_out) (to_list x). + rewrite dlist1E. - smt(size_out_gt0). rewrite spec_dout/=. pose p:= StdBigop.Bigreal.BRM.big _ _ _. - cut->: p = StdBigop.Bigreal.BRM.big predT (fun _ => inv 2%r) (to_list x). + have->: p = StdBigop.Bigreal.BRM.big predT (fun _ => inv 2%r) (to_list x). - rewrite /p =>{p}. apply StdBigop.Bigreal.BRM.eq_bigr. by move=> i; rewrite//= dbool1E. @@ -351,10 +351,10 @@ if{2}; sp; last first. conseq(:_==> BIRO.IRO.mp{1} = mp{1} /\ size bs{1} = i{1} /\ i{1} = size_out /\ inv mp{1} RFList.m{2} /\ bs{1} = take i{1} (to_list (oget RFList.m{2}.[x{1}])))=> />. - - move=> &l &r 12?. - rewrite take_oversize 1:spec_dout 1:H4 //. + - move=> &l &r H0 H1 H2 H3 H4 bs_L mp_L H5 H6 H7 H8 H9. + rewrite take_oversize 1:spec_dout 1:H5 //. rewrite eq_sym to_listK => ->. - by have:=H3; rewrite domE; smt(). + by have:=H4; rewrite domE; smt(). - smt(take_oversize spec_dout). while{1}(BIRO.IRO.mp{1} = mp{1} /\ size bs{1} = i{1} /\ 0 <= i{1} <= size_out /\ n{1} = size_out /\ @@ -362,11 +362,11 @@ if{2}; sp; last first. bs{1} = take i{1} (to_list (oget RFList.m{2}.[x{1}])))(size_out - i{1}); auto=> />. + sp; rcondf 1; auto=> />; 1: smt(). - move=> &h 9?. + move=> &h H0 H1 H2 H3 H4 H5 H6 H7 H8. rewrite size_rcons //=; do!split; 1, 2, 4: smt(size_ge0). rewrite (take_nth witness) 1:spec_dout 1:size_ge0//=. - rewrite - H6; congr; rewrite H4=> //=. - by apply H3=> //=. + rewrite - H7; congr; rewrite H5=> //=. + by apply H4=> //=. smt(size_out_gt0 size_ge0 take0). auto=> //=. conseq(:_==> l{2} = bs{1} /\ size bs{1} = i{1} /\ i{1} = n{1} /\ n{1} = size_out /\ @@ -380,14 +380,14 @@ conseq(:_==> l{2} = bs{1} /\ size bs{1} = i{1} /\ i{1} = n{1} /\ (forall l j, l <> x{1} => m{1}.[(l,j)] = BIRO.IRO.mp{1}.[(l,j)]) /\ (forall j, 0 <= j < i{1} => (x{1}, j) \in BIRO.IRO.mp{1}) /\ (forall j, 0 <= j < i{1} => BIRO.IRO.mp{1}.[(x{1},j)] = Some (nth witness bs{1} j))). -+ move=> /> &l &r 12?; do!split; ..-2 : smt(domE mem_set). ++ move=> /> &l &r H0 H1 H2 H3 H4 mp_L bs_L H5 H6 H7 H8 H9; do!split; ..-2 : smt(domE mem_set). move=> l j Hin. rewrite get_setE/=. case: (l = x{r}) => [<<-|]. - - rewrite oget_some H8; 1:smt(); congr; congr. + - rewrite oget_some H9; 1:smt(); congr; congr. by rewrite eq_sym to_listK; smt(spec2_dout). move=> Hneq. - by rewrite -(H6 _ _ Hneq) H2; smt(domE). + by rewrite -(H7 _ _ Hneq) H3; smt(domE). while(l{2} = bs{1} /\ size bs{1} = i{1} /\ 0 <= i{1} <= n{1} /\ ={i} /\ n{1} = size_out /\ inv m{1} RFList.m{2} /\ (forall j, (x{1}, j) \in BIRO.IRO.mp{1} => 0 <= j < i{1}) /\ @@ -396,7 +396,7 @@ while(l{2} = bs{1} /\ size bs{1} = i{1} /\ 0 <= i{1} <= n{1} /\ ={i} /\ (forall j, 0 <= j < i{1} => BIRO.IRO.mp{1}.[(x{1},j)] = Some (nth witness bs{1} j))). + sp; rcondt{1} 1; auto=> />. - smt(). - move=> &l &r *. + move=> &l &r H0 H1 H2 H3 H4 H5 H6 H7 H8 H9 H10 rL _. rewrite get_setE /= size_rcons /=; do!split; 1,2: smt(size_ge0). - smt(mem_set). - smt(get_setE). @@ -404,7 +404,7 @@ while(l{2} = bs{1} /\ size bs{1} = i{1} /\ 0 <= i{1} <= n{1} /\ ={i} /\ - move=>j Hj0 Hjsize; rewrite get_setE/=nth_rcons. case: (j = size bs{l})=>[->>//=|h]. have/=Hjs:j < size bs{l} by smt(). - by rewrite Hjs/=H8//=. + by rewrite Hjs/=H9//=. by auto; smt(size_out_gt0). qed. @@ -583,7 +583,7 @@ local lemma eager_ideal &m : OSimulator(ExtendSample(FSome(BIRO.IRO))), ODRestr(Dist_of_P1Adv(A))).main() @ &m : res]. proof. -cut->: +have->: Pr[SHA3_OIndiff.OIndif.OIndif(FSome(BIRO.IRO), OSimulator(FSome(BIRO.IRO)), ODRestr(Dist_of_P1Adv(A))).main() @ &m : res] = @@ -614,7 +614,7 @@ cut->: inline{1} 1; inline{2} 1; sp; sim; if; 1: auto; sim. inline{1} 1; inline{2} 1; sp; sim. by call eq_eager_ideal; auto. -cut->: +have->: Pr[SHA3_OIndiff.OIndif.OIndif(ExtendSample(FSome(BIRO.IRO)), OSimulator(ExtendSample(FSome(BIRO.IRO))), ODRestr(Dist_of_P1Adv(A))).main() @ &m : res] = @@ -774,9 +774,9 @@ rcondf{2} 4; 1: auto. inline{2} 1; sp. rcondt{2} 1; 1: by auto; smt(divz_ge0 gt0_r size_ge0). auto; call eq_IRO_RFWhile; auto=> />. -move=> &l &r 14?; split; 2: smt(divz_ge0 gt0_r size_ge0). +move=> /> &l &r H0 H1 H2 H3 H5 H6 result_L mp_L m_R H7 H8 H9 H10 H11; split; 2: smt(divz_ge0 gt0_r size_ge0). rewrite cats0 take_oversize 1:/# take_oversize 1:spec_dout //=. -have h:=spec2_dout result_L H5. +have h:=spec2_dout result_L H7. have-> := some_oget _ h. by rewrite /= eq_sym -to_listK. qed. @@ -877,8 +877,10 @@ qed. swap{1} 4; sp. seq 2 2 : (={glob A, glob Perm, hash, m} /\ Bounder.bounder{1} = Counter.c{2}). + call(: ={glob Perm} /\ Bounder.bounder{1} = Counter.c{2})=> //=. - - by proc; inline*; sp; if; auto; 2:sim=> />; 1: smt(). - - by proc; inline*; sp; if; auto; 2:sim=> />; 1: smt(). +(** - by proc; inline*; sp; if; auto; 2:sim=> />; 1: smt(). **) +(** FIXME: two different instances of x{1} with InvalidGoalShape **) + - by proc; inline *; sp; if; auto; 2:sim=> />; smt(). + - by proc; inline*; sp; if; auto; 2:sim=> />; smt(). - proc; inline*; sp; if; auto; sp=> />. by conseq(:_==> ={z0, glob Perm})=> />; sim. by auto. @@ -1069,10 +1071,10 @@ if{2}; sp; last first. conseq(:_==> BIRO.IRO.mp{1} = mp{1} /\ size bs{1} = i{1} /\ i{1} = size_out /\ inv mp{1} RFList.m{2} /\ bs{1} = take i{1} (to_list (oget RFList.m{2}.[x{1}])))=> />. - - move=> &l &r 12?. - rewrite take_oversize 1:spec_dout 1:H4 //. + - move=> &l &r H0 H1 H2 H3 H4 bs_L mp_L H5 H6 H7 H8 H9. + rewrite take_oversize 1:spec_dout 1:H5 //. rewrite eq_sym to_listK => ->. - by have:=H3; rewrite domE; smt(). + by have:=H4; rewrite domE; smt(). - smt(take_oversize spec_dout). while{1}(BIRO.IRO.mp{1} = mp{1} /\ size bs{1} = i{1} /\ 0 <= i{1} <= size_out /\ n{1} = size_out /\ @@ -1080,11 +1082,11 @@ if{2}; sp; last first. bs{1} = take i{1} (to_list (oget RFList.m{2}.[x{1}])))(size_out - i{1}); auto=> />. + sp; rcondf 1; auto=> />; 1: smt(). - move=> &h 9?. + move=> &h H0 H1 H2 H3 H4 H5 H6 H7 H8. rewrite size_rcons //=; do!split; 1, 2, 4: smt(size_ge0). rewrite (take_nth witness) 1:spec_dout 1:size_ge0//=. - rewrite - H6; congr; rewrite H4=> //=. - by apply H3=> //=. + rewrite - H7; congr; rewrite H5=> //=. + by apply H4=> //=. smt(size_out_gt0 size_ge0 take0). auto=> //=. conseq(:_==> l{2} = bs{1} /\ size bs{1} = i{1} /\ i{1} = n{1} /\ n{1} = size_out /\ @@ -1098,14 +1100,14 @@ conseq(:_==> l{2} = bs{1} /\ size bs{1} = i{1} /\ i{1} = n{1} /\ (forall l j, l <> x{1} => m{1}.[(l,j)] = BIRO.IRO.mp{1}.[(l,j)]) /\ (forall j, 0 <= j < i{1} => (x{1}, j) \in BIRO.IRO.mp{1}) /\ (forall j, 0 <= j < i{1} => BIRO.IRO.mp{1}.[(x{1},j)] = Some (nth witness bs{1} j))). -+ move=> /> &l &r 12?; do!split; ..-2 : smt(domE mem_set). ++ move=> /> &l &r H0 H1 H2 H3 H4 mp_L bs_L H5 H6 H7 H8 H9; do!split; ..-2 : smt(domE mem_set). move=> l j Hin. rewrite get_setE/=. case: (l = x{r}) => [<<-|]. - - rewrite oget_some H8; 1:smt(); congr; congr. + - rewrite oget_some H9; 1:smt(); congr; congr. by rewrite eq_sym to_listK; smt(spec2_dout). move=> Hneq. - by rewrite -(H6 _ _ Hneq) H2; smt(domE). + by rewrite -(H7 _ _ Hneq) H3; smt(domE). while(l{2} = bs{1} /\ size bs{1} = i{1} /\ 0 <= i{1} <= n{1} /\ ={i} /\ n{1} = size_out /\ inv m{1} RFList.m{2} /\ (forall j, (x{1}, j) \in BIRO.IRO.mp{1} => 0 <= j < i{1}) /\ @@ -1114,7 +1116,7 @@ while(l{2} = bs{1} /\ size bs{1} = i{1} /\ 0 <= i{1} <= n{1} /\ ={i} /\ (forall j, 0 <= j < i{1} => BIRO.IRO.mp{1}.[(x{1},j)] = Some (nth witness bs{1} j))). + sp; rcondt{1} 1; auto=> />. - smt(). - move=> &l &r 13?. + move=> &l &r H0 H1 H2 H3 H4 H5 H6 H7 H8 H9 H10 result_l _. rewrite get_setE/=size_rcons/=; do!split; 1,2: smt(size_ge0). - smt(mem_set). - smt(get_setE). @@ -1122,7 +1124,7 @@ while(l{2} = bs{1} /\ size bs{1} = i{1} /\ 0 <= i{1} <= n{1} /\ ={i} /\ - move=>j Hj0 Hjsize; rewrite get_setE/=nth_rcons. case: (j = size bs{l})=>[->>//=|h]. have/=Hjs:j < size bs{l} by smt(). - by rewrite Hjs/=H8//=. + by rewrite Hjs/=H9//=. by auto; smt(size_out_gt0). qed. @@ -1294,7 +1296,7 @@ local lemma eager_ideal &m : OSimulator(ExtendSample(FSome(BIRO.IRO))), ODRestr(Dist_of_P2Adv(A))).main() @ &m : res]. proof. -cut->: +have->: Pr[SHA3_OIndiff.OIndif.OIndif(FSome(BIRO.IRO), OSimulator(FSome(BIRO.IRO)), ODRestr(Dist_of_P2Adv(A))).main() @ &m : res] = @@ -1351,7 +1353,7 @@ cut->: inline{1} 1; inline{2} 1; sp; sim; if; 1: auto; sim. inline{1} 1; inline{2} 1; sp; sim. by call eq_eager_ideal; auto. -cut->: +have->: Pr[SHA3_OIndiff.OIndif.OIndif(ExtendSample(FSome(BIRO.IRO)), OSimulator(ExtendSample(FSome(BIRO.IRO))), ODRestr(Dist_of_P2Adv(A))).main() @ &m : res] = @@ -1448,9 +1450,9 @@ if{1}. inline{1} 1; sp; auto. sp; rcondt{1} 1; auto. inline{1} 1; sp; auto. - call(eq_IRO_RFWhile); auto=> /> 15?. + call(eq_IRO_RFWhile); auto=> /> &1 &2 bounder_R H0 H1 H2 H3 H4 H5 result_R mp_L m_R H6 H7 H8 H9. rewrite take_oversize 1:/# /=. - have:=spec2_dout _ H5. + have:=spec2_dout _ H6. move=>/(some_oget)-> /=; smt(divz_ge0 gt0_r size_ge0 spec2_dout). move=>/=. conseq(:_==> true); auto. @@ -1556,7 +1558,7 @@ seq 1 1 : (={glob A, glob OFC, glob OSimulator, Log.m} /\ SORO.Bounder.bounder{2} <= Counter.c{1}); last first. + sp; case: (increase_counter Counter.c{1} Dist_of_P2Adv.m{1} size_out <= SHA3Indiff.limit). - exists * mi{2}, Dist_of_P2Adv.m{1}, Counter.c{1}; elim* => mess2 mess1 c. - call(titi mess2 (increase_counter c mess1 size_out))=> /= />. + call(titi mess2 (increase_counter c mess1 size_out))=> /=. by call(titi mess1 c)=> />; auto; smt(). inline*; sp. rcondf{1} 1; 1: auto; sp. @@ -1610,9 +1612,9 @@ rcondf{2} 4; 1: auto. inline{2} 1; sp. rcondt{2} 1; 1: by auto; smt(divz_ge0 gt0_r size_ge0). auto; call eq_IRO_RFWhile; auto=> />. -move=> &l &r 14?; split; 2: smt(divz_ge0 gt0_r size_ge0). +move=> &l &r H0 H1 H2 H3 H4 H5 result_L mp_L m_R H6 H7 H8 H9 H10; split; 2: smt(divz_ge0 gt0_r size_ge0). rewrite cats0 take_oversize 1:/# take_oversize 1:spec_dout //=. -have h:=spec2_dout result_L H5. +have h:=spec2_dout result_L H6. have-> := some_oget _ h. by rewrite eq_sym -to_listK; congr. qed. @@ -1734,8 +1736,8 @@ inline{1} 1; sp; wp=> />. seq 1 1 : (={glob A, glob Perm} /\ m1{1} = Dist_of_P2Adv.m{2} /\ m2{1} = m'{2} /\ Bounder.bounder{1} = Counter.c{2}). + auto; call(: ={glob Perm} /\ Bounder.bounder{1} = Counter.c{2})=> //=. - - by proc; inline*; sp; if; auto; 2:sim=> />; 1: smt(). - - by proc; inline*; sp; if; auto; 2:sim=> />; 1: smt(). + - by proc; inline*; sp; if; auto; 2:sim=> />; smt(). + - by proc; inline*; sp; if; auto; 2:sim=> />; smt(). - proc; inline*; sp; if; auto; sp=> />. by conseq(:_==> ={z0, glob Perm})=> />; sim. by auto; smt(). @@ -1948,10 +1950,10 @@ if{2}; sp; last first. conseq(:_==> BIRO.IRO.mp{1} = mp{1} /\ size bs{1} = i{1} /\ i{1} = size_out /\ inv mp{1} RFList.m{2} /\ bs{1} = take i{1} (to_list (oget RFList.m{2}.[x{1}])))=> />. - - move=> &l &r 12?. - rewrite take_oversize 1:spec_dout 1:H4 //. + - move=> &l &r H0 H1 H2 H3 H4 bs_L mp_L H5 H7 H8 H9 H10. + rewrite take_oversize 1:spec_dout 1:H5 //. rewrite eq_sym to_listK => ->. - by have:=H3; rewrite domE; smt(). + by have:=H4; rewrite domE; smt(). - smt(take_oversize spec_dout). while{1}(BIRO.IRO.mp{1} = mp{1} /\ size bs{1} = i{1} /\ 0 <= i{1} <= size_out /\ n{1} = size_out /\ @@ -1959,11 +1961,11 @@ if{2}; sp; last first. bs{1} = take i{1} (to_list (oget RFList.m{2}.[x{1}])))(size_out - i{1}); auto=> />. + sp; rcondf 1; auto=> />; 1: smt(). - move=> &h 9?. + move=> &h H0 H1 H2 H3 H4 H5 H6 H7 H8. rewrite size_rcons //=; do!split; 1, 2, 4: smt(size_ge0). rewrite (take_nth witness) 1:spec_dout 1:size_ge0//=. - rewrite - H6; congr; rewrite H4=> //=. - by apply H3=> //=. + rewrite - H7; congr; rewrite H5=> //=. + by apply H4=> //=. smt(size_out_gt0 size_ge0 take0). auto=> //=. conseq(:_==> l{2} = bs{1} /\ size bs{1} = i{1} /\ i{1} = n{1} /\ n{1} = size_out /\ @@ -1977,14 +1979,14 @@ conseq(:_==> l{2} = bs{1} /\ size bs{1} = i{1} /\ i{1} = n{1} /\ (forall l j, l <> x{1} => m{1}.[(l,j)] = BIRO.IRO.mp{1}.[(l,j)]) /\ (forall j, 0 <= j < i{1} => (x{1}, j) \in BIRO.IRO.mp{1}) /\ (forall j, 0 <= j < i{1} => BIRO.IRO.mp{1}.[(x{1},j)] = Some (nth witness bs{1} j))). -+ move=> /> &l &r 12?; do!split; ..-2 : smt(domE mem_set). ++ move=> /> &l &r H0 H1 H2 H3 H4 mp_L bs_L H5 H6 H7 H8 H9; do!split; ..-2 : smt(domE mem_set). move=> l j Hin. rewrite get_setE/=. case: (l = x{r}) => [<<-|]. - - rewrite oget_some H8; 1:smt(); congr; congr. + - rewrite oget_some H9; 1:smt(); congr; congr. by rewrite eq_sym to_listK; smt(spec2_dout). move=> Hneq. - by rewrite -(H6 _ _ Hneq) H2; smt(domE). + by rewrite -(H7 _ _ Hneq) H3; smt(domE). while(l{2} = bs{1} /\ size bs{1} = i{1} /\ 0 <= i{1} <= n{1} /\ ={i} /\ n{1} = size_out /\ inv m{1} RFList.m{2} /\ (forall j, (x{1}, j) \in BIRO.IRO.mp{1} => 0 <= j < i{1}) /\ @@ -1993,7 +1995,7 @@ while(l{2} = bs{1} /\ size bs{1} = i{1} /\ 0 <= i{1} <= n{1} /\ ={i} /\ (forall j, 0 <= j < i{1} => BIRO.IRO.mp{1}.[(x{1},j)] = Some (nth witness bs{1} j))). + sp; rcondt{1} 1; auto=> />. - smt(). - move=> &l &r 13?. + move=> &l &r H0 H1 H2 H3 H4 H5 H6 H7 H8 H9 H10 rL _. rewrite get_setE/=size_rcons/=; do!split; 1,2: smt(size_ge0). - smt(mem_set). - smt(get_setE). @@ -2001,7 +2003,7 @@ while(l{2} = bs{1} /\ size bs{1} = i{1} /\ 0 <= i{1} <= n{1} /\ ={i} /\ - move=>j Hj0 Hjsize; rewrite get_setE/=nth_rcons. case: (j = size bs{l})=>[->>//=|h]. have/=Hjs:j < size bs{l} by smt(). - by rewrite Hjs/=H8//=. + by rewrite Hjs/=H9//=. by auto; smt(size_out_gt0). qed. @@ -2173,7 +2175,7 @@ local lemma eager_ideal &m : OSimulator(ExtendSample(FSome(BIRO.IRO))), ODRestr(Dist_of_CollAdv(A))).main() @ &m : res]. proof. -cut->: +have->: Pr[SHA3_OIndiff.OIndif.OIndif(FSome(BIRO.IRO), OSimulator(FSome(BIRO.IRO)), ODRestr(Dist_of_CollAdv(A))).main() @ &m : res] = @@ -2230,7 +2232,7 @@ cut->: inline{1} 1; inline{2} 1; sp; sim; if; 1: auto; sim. inline{1} 1; inline{2} 1; sp; sim. by call eq_eager_ideal; auto. -cut->: +have->: Pr[SHA3_OIndiff.OIndif.OIndif(ExtendSample(FSome(BIRO.IRO)), OSimulator(ExtendSample(FSome(BIRO.IRO))), ODRestr(Dist_of_CollAdv(A))).main() @ &m : res] = @@ -2326,9 +2328,9 @@ if{1}. inline{1} 1; sp; auto. sp; rcondt{1} 1; auto. inline{1} 1; sp; auto. - call(eq_IRO_RFWhile); auto=> /> 15?. + call(eq_IRO_RFWhile); auto=> /> &1 &2 bounder_R H0 H1 H2 H3 H4 H5 result_L mp_L m_R H6 H7 H8 H9. rewrite take_oversize 1:/# /=. - have:=spec2_dout _ H5. + have:=spec2_dout _ H6. move=>/(some_oget)-> /=; smt(divz_ge0 gt0_r size_ge0 spec2_dout). move=>/=. conseq(:_==> true); auto. @@ -2430,7 +2432,7 @@ seq 1 2 : (={glob A, glob OFC, glob OSimulator, Log.m, m1, m2} /\ SORO.Bounder.bounder{2} <= Counter.c{1}); last first. + sp; case: (increase_counter Counter.c{1} m1{1} size_out <= SHA3Indiff.limit). - exists * m2{2}, m1{1}, Counter.c{1}; elim* => mess2 mess1 c. - call(titi mess2 (increase_counter c mess1 size_out))=> /= />. + call(titi mess2 (increase_counter c mess1 size_out))=> /=. by call(titi mess1 c)=> />; auto; smt(). inline*; sp. rcondf{1} 1; 1: auto; sp. @@ -2482,9 +2484,9 @@ rcondf{2} 4; 1: auto. inline{2} 1; sp. rcondt{2} 1; 1: by auto; smt(divz_ge0 gt0_r size_ge0). auto; call eq_IRO_RFWhile; auto=> />. -move=> &l &r 14?; split; 2: smt(divz_ge0 gt0_r size_ge0). +move=> &l &r H0 H1 H2 H3 H4 H5 result_L mp_L m_R H6 H7 H8 H9 H10; split; 2: smt(divz_ge0 gt0_r size_ge0). rewrite cats0 take_oversize 1:/# take_oversize 1:spec_dout //=. -have h:=spec2_dout result_L H5. +have h:=spec2_dout result_L H6. have-> := some_oget _ h. by rewrite eq_sym -to_listK; congr. qed. @@ -2599,8 +2601,8 @@ inline{1} 1; inline{2} 1; sp. inline{1} 1; sp; wp=> />. seq 1 1 : (={glob A, glob Perm, m1, m2} /\ Bounder.bounder{1} = Counter.c{2}). + auto; call(: ={glob Perm} /\ Bounder.bounder{1} = Counter.c{2})=> //=. - - by proc; inline*; sp; if; auto; 2:sim=> />; 1: smt(). - - by proc; inline*; sp; if; auto; 2:sim=> />; 1: smt(). + - by proc; inline*; sp; if; auto; 2:sim=> />; smt(). + - by proc; inline*; sp; if; auto; 2:sim=> />; smt(). - proc; inline*; sp; if; auto; sp=> />. by conseq(:_==> ={z0, glob Perm})=> />; sim. conseq(:_==> ={hash1, hash2, m1, m2})=> //=; 1: smt(); sim. diff --git a/proof/SHA3_OIndiff.ec b/proof/SHA3_OIndiff.ec index 4590e95..9dca303 100644 --- a/proof/SHA3_OIndiff.ec +++ b/proof/SHA3_OIndiff.ec @@ -224,7 +224,7 @@ lemma SHA3OIndiff (limit ^ 2 - limit)%r / (2 ^ (r + c + 1))%r + (4 * limit ^ 2)%r / (2 ^ c)%r. proof. move=>h. -cut->: Pr[OGReal(CSome(Sponge), PSome(Perm), ODRestr(Dist)).main() @ &m : res] = +have->: Pr[OGReal(CSome(Sponge), PSome(Perm), ODRestr(Dist)).main() @ &m : res] = Pr[RealIndif(Sponge, Perm, DRestr(OD(Dist))).main() @ &m : res]. + byequiv=>//=; proc; inline*; sim; sp. call(: ={glob Perm, glob Counter} /\ ={c}(Counter,Cntr))=>/>; auto. @@ -239,7 +239,7 @@ cut->: Pr[OGReal(CSome(Sponge), PSome(Perm), ODRestr(Dist)).main() @ &m : res] = - by sp; if; auto; sp; if; auto. conseq(:_==> ={glob Perm, sa, sc})=> />; sim. by while(={glob Perm, sa, sc, xs}); auto; sp; if; auto=> />. -cut->: Pr[OGIdeal(FSome(IRO), OSimulator, ODRestr(Dist)).main() @ &m : res] = +have->: Pr[OGIdeal(FSome(IRO), OSimulator, ODRestr(Dist)).main() @ &m : res] = Pr[IdealIndif(IRO, Simulator, DRestr(OD(Dist))).main() @ &m : res]. + byequiv=>//=; proc; inline*; sim; sp. call(: ={glob IRO, glob Simulator, glob Counter} /\ ={c}(Counter,Cntr)); auto. diff --git a/proof/SecureORO.eca b/proof/SecureORO.eca index f6c47d8..b3328c2 100644 --- a/proof/SecureORO.eca +++ b/proof/SecureORO.eca @@ -106,7 +106,7 @@ section Preimage. lemma RO_is_preimage_resistant &m : Pr [ Preimage(A,RF(RO)).main() @ &m : res ] <= (bound + 1)%r * mu1 sampleto witness. proof. - cut->: Pr [ Preimage (A,RF(RO)).main() @ &m : res ] = + have->: Pr [ Preimage (A,RF(RO)).main() @ &m : res ] = Pr [ Preimage2(A,RF(RO)).main() @ &m : res ]. + by byequiv=> //=; proc; inline*; sim. byphoare(: _ ==> _) => //=; proc. @@ -121,7 +121,8 @@ section Preimage. by auto=> />; rewrite fdom0 fcards0; smt(bound_ge0). + seq 1 : true 1%r (bound%r * mu1 sampleto witness) 0%r _; auto. exists * Preimage2.hash; elim* => h. - call(: Preimage2.hash = h /\ h = arg ==> rng RO.m h)=> //; bypr=> /> {&m} &m {h} <-. + call(: Preimage2.hash = h /\ h = arg ==> rng RO.m h)=> //. + bypr=> /> {&m} &m <<- <-. pose h := Preimage2.hash{m}. have H: forall &m h, Pr[FEL(A, RF(RO)).main(h) @ &m : rng RO.m h] <= bound%r * mu1 sampleto witness; last first. @@ -135,17 +136,17 @@ section Preimage. rewrite ler_maxr //=; 1:smt(bound_ge0). rewrite-RField.AddMonoid.iteropE-RField.intmulpE; 1: smt(bound_ge0). by rewrite RField.intmulr; smt(). - - inline*; auto=> /> &h. + - inline*; auto=> />. rewrite mem_rng_empty /= fdom0 fcards0 /=; smt(bound_ge0). - proc. sp; if; auto; sp; inline*; sp; wp=> /=. case: (x \in RO.m); wp => //=. + by hoare; auto; smt(mu_bounded). - rnd (pred1 h); auto=> /> &h c ??????. + rnd (pred1 h); auto=> /> &h c H0 H1 H2 H3 H4 H5. rewrite (sampleto_fu h witness) /= => ? ?. rewrite rngE/= => [][] a; rewrite get_setE. case: (a=x{h}) => [->>|] //=. - by move:H1; rewrite rngE /= negb_exists/= => /(_ a) //=. + by move:H2; rewrite rngE /= negb_exists/= => /(_ a) //=. - move=> c; proc; inline*; sp; if; sp. + auto; progress. + smt(). @@ -277,7 +278,7 @@ section SecondPreimage. - proc; inline*; auto; sp; if; last by auto; smt(). auto=> /> &h c Hc Hdom Hc2 sample. by rewrite sampleto_full/=!fdom_set !fcardU !fcard1;smt(mem_set fcard_ge0). - auto=> /> &h sample. + auto=> /> sample. by rewrite mem_set mem_empty/= fdom_set fdom0 fset0U fcard1; smt(bound_ge0). + call(: arg = mess1 ==> rng (rem RO.m mess1) (oget RO.m.[mess1])); auto. bypr=> {&m} &m h; rewrite h. @@ -291,7 +292,7 @@ section SecondPreimage. rewrite-RField.AddMonoid.iteropE-RField.intmulpE; 1: smt(bound_ge0). by rewrite RField.intmulr; smt(mu_bounded bound_ge0). + inline*; auto=> />. - move=> &h r; rewrite mem_empty /= !mem_set mem_empty/= sampleto_full /=. + move=> r; rewrite mem_empty /= !mem_set mem_empty/= sampleto_full /=. rewrite get_set_sameE//= fdom_set fdom0 fset0U fcard1 /= rngE /=; split; 2: smt(bound_ge0). by rewrite negb_exists/= => a; rewrite remE get_setE //= emptyE; smt(). + proc; inline*; sp; if; last by hoare; auto. @@ -329,8 +330,8 @@ section SecondPreimage. swap [7..11] -6; sp. swap[5..6] 2; wp 6=> /=. case: (SecondPreimage2.m2 \in RO.m). - - rcondf 5; 1: auto; hoare; auto=> /> &h d _ _ in_dom1 not_rng _ in_dom2. - move=> sample2 _ sample1 _; rewrite negb_and/=. + - rcondf 5; 1: auto; hoare; auto=> /> &h d _ _ in_dom1 not_rng d_bound _ in_dom2. + move=> sample2 _ m1_in_RO sample1 _; rewrite negb_and/=. move: not_rng; rewrite rngE /= negb_exists /= => /(_ SecondPreimage2.m2{h}). rewrite remE; case: (SecondPreimage2.m2{h} = m1{h})=> //=. by move: in_dom1 in_dom2; smt(). @@ -483,7 +484,7 @@ section Collision. auto=> /> &h h1 h2 _ sample _. by rewrite fdom_set fcardU fcard1; smt(fcard_ge0). move=> b c; proc; inline*; sp; if; auto. - move=> /> &h h1 h2 _ _ sample _. + move=> /> &h h1 h2 _ h3 sample _. by rewrite fdom_set fcardU fcard1; smt(fcard_ge0). qed. From 6d70494243cdc292211f2520603b526d0553194e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Thu, 8 Apr 2021 15:50:34 +0100 Subject: [PATCH 511/525] Add disclaimer w.r.t. Jasmin proofs --- README.md | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/README.md b/README.md index 4ab0311..568ecef 100644 --- a/README.md +++ b/README.md @@ -34,6 +34,14 @@ The proof of indifferentiability and random permutation-security for Sponge and SHA-3 can be checked using EasyCrypt 1.x without any additional dependencies. +NOTE: Jasmin and EasyCrypt have diverged and this repository has not been kept +up-to-date. Up-to-date versions of the Jasmin-related code and proofs can be +found in the [libjc repository][libjc]. The below can be used to check the +proofs as they were at the time of publication, taking care to use the correct +version of EasyCrypt. + +[libjc]: https://github.com/tfaoliveira/libjc + The proofs of correctness for Jasmin also relies on Jasmin's `eclibs` (currently at commit [29b97ec1][jasmin]). From 7e2b37f21319fd97ce55a0a2e84458943c2f04b4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Thu, 8 Apr 2021 15:51:01 +0100 Subject: [PATCH 512/525] [CI]: compile EC --- .gitlab-ci.yml | 18 +++++++++++------- 1 file changed, 11 insertions(+), 7 deletions(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 0ad0a5f..0322847 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -5,15 +5,19 @@ variables: DOCKER_TLS_CERTDIR: "" ECJOBS: 2 GIT_SUBMODULE_STRATEGY: recursive + ECTAG: "1.0" services: - docker:dind before_script: - docker info -- docker pull easycryptpa/ec-test-box -- docker run --rm easycryptpa/ec-test-box opam config exec -- easycrypt config -- docker run --name testbox easycryptpa/ec-test-box +- docker pull docker.io/easycryptpa/ec-build-box:latest +- >- + docker run --name testbox docker.io/easycryptpa/ec-build-box:latest + sh -c "opam pin -n easycrypt https://github.com/EasyCrypt/easycrypt.git#$ECTAG && + opam install easycrypt && + opam config exec -- easycrypt config" - docker commit testbox testbox:latest .tests: @@ -22,7 +26,7 @@ before_script: - ci script: - >- - docker run -v $PWD:/home/ci/sha3 --env CHECKS --env ECJOBS testbox + docker run -v $PWD:/sha3 --env CHECKS --env ECJOBS testbox sh -c 'cd sha3 && opam config exec -- make check-xunit' artifacts: when: on_failure @@ -34,17 +38,17 @@ sponge: variables: CHECKS: sponge -jasmin sponge: +.jasmin sponge: extends: .tests variables: CHECKS: jsponge -jasmin permutation: +.jasmin permutation: extends: .tests variables: CHECKS: jperm -jasmin libc: +.jasmin libc: extends: .tests variables: CHECKS: libc From 1b10dad0f08d2ecc81e3be5c5e6f2a2ba4ff341d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Mon, 15 Nov 2021 15:18:21 +0000 Subject: [PATCH 513/525] Update to follow new section mechanism and smt syntax --- proof/IndifRO_is_secure.ec | 12 ++++++------ proof/SHA3Indiff.ec | 6 +++--- proof/SHA3OSecurity.ec | 6 +++--- proof/SHA3Security.ec | 16 ++++++++-------- proof/SHA3_OIndiff.ec | 4 ++-- proof/SecureORO.eca | 6 +++--- proof/SecureRO.eca | 6 +++--- proof/Sponge.ec | 8 ++++---- proof/smart_counter/ConcreteF.eca | 6 +++--- proof/smart_counter/Gcol.eca | 4 ++-- proof/smart_counter/Gconcl.ec | 4 ++-- proof/smart_counter/Gconcl_list.ec | 16 ++++++++-------- proof/smart_counter/Gext.eca | 6 +++--- proof/smart_counter/Handle.eca | 15 ++++++++------- proof/smart_counter/SLCommon.ec | 26 ++++++++++++-------------- 15 files changed, 70 insertions(+), 71 deletions(-) diff --git a/proof/IndifRO_is_secure.ec b/proof/IndifRO_is_secure.ec index aa2a625..be9534a 100644 --- a/proof/IndifRO_is_secure.ec +++ b/proof/IndifRO_is_secure.ec @@ -91,9 +91,9 @@ module DColl (A : AdvCollision) (F : DFUNCTIONALITY) (P : DPRIMITIVE) = { section Collision. - declare module A : AdvCollision{Bounder, SRO.RO.RO, SRO.RO.FRO}. + declare module A <: AdvCollision {Bounder, SRO.RO.RO, SRO.RO.FRO}. - axiom D_ll (F <: Oracle { A }) : + declare axiom D_ll (F <: Oracle { A }) : islossless F.get => islossless A(F).guess. lemma coll_resistant_if_indifferentiable @@ -136,9 +136,9 @@ module DPre (A : AdvPreimage) (F : DFUNCTIONALITY) (P : DPRIMITIVE) = { section Preimage. - declare module A : AdvPreimage{Bounder, SRO.RO.RO, SRO.RO.FRO, DPre}. + declare module A <: AdvPreimage {Bounder, SRO.RO.RO, SRO.RO.FRO, DPre}. - axiom D_ll (F <: Oracle{A}) : + declare axiom D_ll (F <: Oracle{A}) : islossless F.get => islossless A(F).guess. lemma preimage_resistant_if_indifferentiable @@ -182,9 +182,9 @@ module D2Pre (A : AdvSecondPreimage) (F : DFUNCTIONALITY) (P : DPRIMITIVE) = { section SecondPreimage. - declare module A : AdvSecondPreimage{Bounder, SRO.RO.RO, SRO.RO.FRO, D2Pre}. + declare module A <: AdvSecondPreimage {Bounder, SRO.RO.RO, SRO.RO.FRO, D2Pre}. - axiom D_ll (F <: Oracle{A}) : + declare axiom D_ll (F <: Oracle{A}) : islossless F.get => islossless A(F).guess. lemma second_preimage_resistant_if_indifferentiable diff --git a/proof/SHA3Indiff.ec b/proof/SHA3Indiff.ec index 7afdf98..fa02597 100644 --- a/proof/SHA3Indiff.ec +++ b/proof/SHA3Indiff.ec @@ -145,14 +145,14 @@ module DRestr (D : DISTINGUISHER) (F : DFUNCTIONALITY) (P : DPRIMITIVE) = { section. -declare module Dist : - DISTINGUISHER{Perm, Gconcl_list.SimLast, IRO, Cntr, BlockSponge.BIRO.IRO, +declare module Dist <: + DISTINGUISHER {Perm, Gconcl_list.SimLast, IRO, Cntr, BlockSponge.BIRO.IRO, Simulator, BlockSponge.C, Gconcl.S, SLCommon.F.RO, SLCommon.F.FRO, SLCommon.Redo, SLCommon.C, Gconcl_list.BIRO2.IRO, Gconcl_list.F2.RO, Gconcl_list.F2.FRO, Gconcl_list.Simulator}. -axiom Dist_lossless (F <: DFUNCTIONALITY { Dist }) (P <: DPRIMITIVE { Dist }) : +declare axiom Dist_lossless (F <: DFUNCTIONALITY { Dist }) (P <: DPRIMITIVE { Dist }) : islossless P.f => islossless P.fi => islossless F.f => islossless Dist(F,P).distinguish. diff --git a/proof/SHA3OSecurity.ec b/proof/SHA3OSecurity.ec index b1e5936..e78cef3 100644 --- a/proof/SHA3OSecurity.ec +++ b/proof/SHA3OSecurity.ec @@ -189,7 +189,7 @@ import FullEager. section Preimage. - declare module A : SH.AdvPreimage { Perm, Counter, Bounder, F.RO, F.FRO, + declare module A <: SH.AdvPreimage { Perm, Counter, Bounder, F.RO, F.FRO, Redo, C, Gconcl.S, BlockSponge.BIRO.IRO, BlockSponge.C, BIRO.IRO, Gconcl_list.BIRO2.IRO, Gconcl_list.F2.RO, Gconcl_list.F2.FRO, Gconcl_list.Simulator, SHA3Indiff.Simulator, SHA3Indiff.Cntr, @@ -912,7 +912,7 @@ end section Preimage. section SecondPreimage. - declare module A : SH.AdvSecondPreimage { Perm, Counter, Bounder, F.RO, + declare module A <: SH.AdvSecondPreimage { Perm, Counter, Bounder, F.RO, F.FRO, Redo, C, Gconcl.S, BlockSponge.BIRO.IRO, BlockSponge.C, BIRO.IRO, Gconcl_list.BIRO2.IRO, Gconcl_list.F2.RO, Gconcl_list.F2.FRO, Gconcl_list.Simulator, SHA3Indiff.Simulator, SHA3Indiff.Cntr, @@ -1792,7 +1792,7 @@ end section SecondPreimage. section Collision. - declare module A : SH.AdvCollision { Perm, Counter, Bounder, F.RO, + declare module A <: SH.AdvCollision { Perm, Counter, Bounder, F.RO, F.FRO, Redo, C, Gconcl.S, BlockSponge.BIRO.IRO, BlockSponge.C, BIRO.IRO, Gconcl_list.BIRO2.IRO, Gconcl_list.F2.RO, Gconcl_list.F2.FRO, Gconcl_list.Simulator, SHA3Indiff.Simulator, SHA3Indiff.Cntr, diff --git a/proof/SHA3Security.ec b/proof/SHA3Security.ec index a7cd8b2..d99c5a8 100644 --- a/proof/SHA3Security.ec +++ b/proof/SHA3Security.ec @@ -124,12 +124,12 @@ module (DSetSize (D : Indiff0.DISTINGUISHER) : DISTINGUISHER) section Preimage. - declare module A : SRO.AdvPreimage{SRO.RO.RO, SRO.RO.FRO, SRO.Bounder, Perm, + declare module A <: SRO.AdvPreimage {SRO.RO.RO, SRO.RO.FRO, SRO.Bounder, Perm, Gconcl_list.BIRO2.IRO, Simulator, Cntr, BIRO.IRO, F.RO, F.FRO, Redo, C, Gconcl.S, BlockSponge.BIRO.IRO, BlockSponge.C, Gconcl_list.F2.RO, Gconcl_list.F2.FRO, Gconcl_list.Simulator, DPre}. - axiom A_ll (F <: SRO.Oracle { A }) : islossless F.get => islossless A(F).guess. + declare axiom A_ll (F <: SRO.Oracle { A }) : islossless F.get => islossless A(F).guess. local lemma invm_dom_rng (m mi : (state, state) fmap) : invm m mi => dom m = rng mi. @@ -481,12 +481,12 @@ end section Preimage. section SecondPreimage. - declare module A : SRO.AdvSecondPreimage{SRO.RO.RO, SRO.RO.FRO, SRO.Bounder, Perm, + declare module A <: SRO.AdvSecondPreimage {SRO.RO.RO, SRO.RO.FRO, SRO.Bounder, Perm, Gconcl_list.BIRO2.IRO, Simulator, Cntr, BIRO.IRO, F.RO, F.FRO, Redo, C, Gconcl.S, BlockSponge.BIRO.IRO, BlockSponge.C, Gconcl_list.F2.RO, Gconcl_list.F2.FRO, Gconcl_list.Simulator, D2Pre}. - axiom A_ll (F <: SRO.Oracle { A }) : islossless F.get => islossless A(F).guess. + declare axiom A_ll (F <: SRO.Oracle { A }) : islossless F.get => islossless A(F).guess. local lemma invm_dom_rng (m mi : (state, state) fmap) : invm m mi => dom m = rng mi. @@ -874,12 +874,12 @@ end section SecondPreimage. section Collision. - declare module A : SRO.AdvCollision{SRO.RO.RO, SRO.RO.FRO, SRO.Bounder, Perm, + declare module A <: SRO.AdvCollision {SRO.RO.RO, SRO.RO.FRO, SRO.Bounder, Perm, Gconcl_list.BIRO2.IRO, Simulator, Cntr, BIRO.IRO, F.RO, F.FRO, Redo, C, Gconcl.S, BlockSponge.BIRO.IRO, BlockSponge.C, Gconcl_list.F2.RO, Gconcl_list.F2.FRO, Gconcl_list.Simulator}. - axiom A_ll (F <: SRO.Oracle { A }) : islossless F.get => islossless A(F).guess. + declare axiom A_ll (F <: SRO.Oracle { A }) : islossless F.get => islossless A(F).guess. local lemma invm_dom_rng (m mi : (state, state) fmap) : invm m mi => dom m = rng mi. @@ -1265,12 +1265,12 @@ module AdvCollisionSHA3 (A : SRO.AdvCollision) (F : SRO.Oracle) = { section SHA3_Collision. - declare module A : SRO.AdvCollision{SRO.RO.RO, SRO.RO.FRO, SRO.Bounder, Perm, + declare module A <: SRO.AdvCollision {SRO.RO.RO, SRO.RO.FRO, SRO.Bounder, Perm, Gconcl_list.BIRO2.IRO, Simulator, Cntr, BIRO.IRO, F.RO, F.FRO, Redo, C, Gconcl.S, BlockSponge.BIRO.IRO, BlockSponge.C, Gconcl_list.F2.RO, Gconcl_list.F2.FRO, Gconcl_list.Simulator}. - axiom A_ll (F <: SRO.Oracle { A }) : islossless F.get => islossless A(F).guess. + declare axiom A_ll (F <: SRO.Oracle { A }) : islossless F.get => islossless A(F).guess. lemma SHA3_coll_resistant &m : Pr[SRO.Collision(AdvCollisionSHA3(A), FM(CSetSize(Sponge), Perm)).main() @ &m : res] <= diff --git a/proof/SHA3_OIndiff.ec b/proof/SHA3_OIndiff.ec index 9dca303..3f5a6ea 100644 --- a/proof/SHA3_OIndiff.ec +++ b/proof/SHA3_OIndiff.ec @@ -168,8 +168,8 @@ module ODRestr (D : ODISTINGUISHER) (F : ODFUNCTIONALITY) (P : ODPRIMITIVE) = { }. section. -declare module Dist : - ODISTINGUISHER{Perm, Gconcl_list.SimLast, IRO, Cntr, BlockSponge.BIRO.IRO, +declare module Dist <: + ODISTINGUISHER {Perm, Gconcl_list.SimLast, IRO, Cntr, BlockSponge.BIRO.IRO, Simulator, BlockSponge.C, Gconcl.S, SLCommon.F.RO, SLCommon.F.FRO, SLCommon.Redo, SLCommon.C, Gconcl_list.BIRO2.IRO, Gconcl_list.F2.RO, Gconcl_list.F2.FRO, diff --git a/proof/SecureORO.eca b/proof/SecureORO.eca index b3328c2..8a4ae24 100644 --- a/proof/SecureORO.eca +++ b/proof/SecureORO.eca @@ -81,7 +81,7 @@ module Preimage (A : AdvPreimage, F : RF) = { section Preimage. - declare module A : AdvPreimage{RO,Preimage}. + declare module A <: AdvPreimage {RO,Preimage}. local module FEL (A : AdvPreimage, F : RF) = { proc main (hash : to) : from = { @@ -201,7 +201,7 @@ module SecondPreimage (A : AdvSecondPreimage, F : RF) = { section SecondPreimage. - declare module A : AdvSecondPreimage{Bounder,RO,FRO}. + declare module A <: AdvSecondPreimage {Bounder,RO,FRO}. local module FEL (A : AdvSecondPreimage, F : RF) = { proc main (m1 : from) : from = { @@ -364,7 +364,7 @@ module Collision (A : AdvCollision, F : RF) = { section Collision. - declare module A : AdvCollision {RO, FRO, Bounder}. + declare module A <: AdvCollision {RO, FRO, Bounder}. local module FEL (A : AdvCollision, F : RF) = { proc main () : from * from = { diff --git a/proof/SecureRO.eca b/proof/SecureRO.eca index c261f1d..c1917a4 100644 --- a/proof/SecureRO.eca +++ b/proof/SecureRO.eca @@ -86,7 +86,7 @@ module Preimage (A : AdvPreimage, F : RF) = { section Preimage. - declare module A : AdvPreimage{RO,Preimage}. + declare module A <: AdvPreimage {RO,Preimage}. local module FEL (A : AdvPreimage, F : RF) = { proc main (hash : to) : from = { @@ -212,7 +212,7 @@ module SecondPreimage (A : AdvSecondPreimage, F : RF) = { section SecondPreimage. - declare module A : AdvSecondPreimage{Bounder,RO,FRO}. + declare module A <: AdvSecondPreimage {Bounder,RO,FRO}. local module FEL (A : AdvSecondPreimage, F : RO) = { proc main (m1 : from) : from = { @@ -392,7 +392,7 @@ module Collision (A : AdvCollision, F : RO) = { section Collision. - declare module A : AdvCollision {RO, FRO, Bounder}. + declare module A <: AdvCollision {RO, FRO, Bounder}. local module FEL (A : AdvCollision, F : RO) = { proc main () : from * from = { diff --git a/proof/Sponge.ec b/proof/Sponge.ec index e7f6f21..ba4662d 100644 --- a/proof/Sponge.ec +++ b/proof/Sponge.ec @@ -90,7 +90,7 @@ case: (r %| n). + move=> ^/dvdzE n_mod_r /needed_blocks_eq_div_r <-. by rewrite -(ltr_pmul2r r gt0_r (i + 1)) divzE n_mod_r /#. move=> r_ndvd_n. rewrite -ltr_subr_addr -(addzC (-1)). -rewrite -divzMDr 1:[smt(gt0_r)] Ring.IntID.mulN1r. +rewrite -divzMDr 1:#smt:(gt0_r) Ring.IntID.mulN1r. have ->: n + r - 1 - r = (n - r) + r - 1 by smt(). case: (0 <= n - r)=> [n_ge_r|/ltzNge n_lt_r /#]. by rewrite -ih /#. @@ -366,7 +366,7 @@ lemma HybridIROExper_Lazy_Eager section. -declare module D : HYBRID_IRO_DIST{HybridIROEager, HybridIROLazy}. +declare module D <: HYBRID_IRO_DIST {HybridIROEager, HybridIROLazy}. local clone PROM.FullRO as ERO with type in_t <- block list * int, @@ -1913,8 +1913,8 @@ end HybridIRO. section. -declare module BlockSim : BlockSponge.SIMULATOR{IRO, BlockSponge.BIRO.IRO}. -declare module Dist : DISTINGUISHER{Perm, BlockSim, IRO, BlockSponge.BIRO.IRO}. +declare module BlockSim <: BlockSponge.SIMULATOR {IRO, BlockSponge.BIRO.IRO}. +declare module Dist <: DISTINGUISHER {Perm, BlockSim, IRO, BlockSponge.BIRO.IRO}. local clone HybridIRO as HIRO. diff --git a/proof/smart_counter/ConcreteF.eca b/proof/smart_counter/ConcreteF.eca index f8fa6a0..18b0358 100644 --- a/proof/smart_counter/ConcreteF.eca +++ b/proof/smart_counter/ConcreteF.eca @@ -42,9 +42,9 @@ module PF = { module CF(D:DISTINGUISHER) = Indif(SqueezelessSponge(PF), PF, D). section. - declare module D : DISTINGUISHER {Perm, C, PF, Redo}. + declare module D <: DISTINGUISHER {Perm, C, PF, Redo}. - axiom D_ll (F <: DFUNCTIONALITY{D}) (P <: DPRIMITIVE{D}): + declare axiom D_ll (F <: DFUNCTIONALITY{D}) (P <: DPRIMITIVE{D}): islossless P.f => islossless P.fi => islossless F.f => islossless D(F, P).distinguish. @@ -383,7 +383,7 @@ section. + by move=> [b c]; rewrite supp_dprod /= Block.DBlock.dunifin_fu Capacity.DCapacity.dunifin_fu. have f_ll : islossless SqueezelessSponge(Perm).f. + proc; while true (size p - i)=> //=. - * move=> z; wp;if;auto; 2:call p_ll; auto=>/#. + * by move=> z; wp;if;auto; 2:call (p_ll); auto=>/#. by auto; smt w=size_ge0. apply (@ler_trans _ _ _ (Pr_restr Perm SqueezelessSponge D p_ll pi_ll f_ll D_ll &m)). diff --git a/proof/smart_counter/Gcol.eca b/proof/smart_counter/Gcol.eca index 2421692..2211a44 100644 --- a/proof/smart_counter/Gcol.eca +++ b/proof/smart_counter/Gcol.eca @@ -24,9 +24,9 @@ import ROhandle. qed. section PROOF. - declare module D: DISTINGUISHER{C, PF, G1}. + declare module D <: DISTINGUISHER{C, PF, G1}. - axiom D_ll (F <: DFUNCTIONALITY{D}) (P <: DPRIMITIVE{D}): + declare axiom D_ll (F <: DFUNCTIONALITY{D}) (P <: DPRIMITIVE{D}): islossless P.f => islossless P.fi => islossless F.f => islossless D(F, P).distinguish. diff --git a/proof/smart_counter/Gconcl.ec b/proof/smart_counter/Gconcl.ec index e4f0724..6810902 100644 --- a/proof/smart_counter/Gconcl.ec +++ b/proof/smart_counter/Gconcl.ec @@ -65,7 +65,7 @@ module S(F : DFUNCTIONALITY) = { section. -declare module D: DISTINGUISHER{C, Perm, F.RO, F.FRO, S, Redo}. +declare module D <: DISTINGUISHER{C, Perm, F.RO, F.FRO, S, Redo}. local clone import Gext as Gext0. @@ -361,7 +361,7 @@ proof. by auto. qed. -axiom D_ll : +declare axiom D_ll : forall (F <: DFUNCTIONALITY{D}) (P <: DPRIMITIVE{D}), islossless P.f => islossless P.fi => islossless F.f => islossless D(F, P).distinguish. diff --git a/proof/smart_counter/Gconcl_list.ec b/proof/smart_counter/Gconcl_list.ec index 924030d..72cb5ec 100644 --- a/proof/smart_counter/Gconcl_list.ec +++ b/proof/smart_counter/Gconcl_list.ec @@ -1739,9 +1739,9 @@ end section Real. section Real_Ideal. (* REAL & IDEAL *) - declare module D : DISTINGUISHER{SLCommon.C, C, Perm, Redo, F.RO, F.FRO, S, BIRO.IRO, BIRO2.IRO, F2.RO, F2.FRO}. + declare module D <: DISTINGUISHER {SLCommon.C, C, Perm, Redo, F.RO, F.FRO, S, BIRO.IRO, BIRO2.IRO, F2.RO, F2.FRO}. - axiom D_lossless (F0 <: DFUNCTIONALITY{D}) (P0 <: DPRIMITIVE{D}) : + declare axiom D_lossless (F0 <: DFUNCTIONALITY{D}) (P0 <: DPRIMITIVE{D}) : islossless P0.f => islossless P0.fi => islossless F0.f => islossless D(F0, P0).distinguish. @@ -1785,9 +1785,9 @@ require import AdvAbsVal. section Real_Ideal_Abs. - declare module D : DISTINGUISHER{SLCommon.C, C, Perm, Redo, F.RO, F.FRO, S, BIRO.IRO, BIRO2.IRO, F2.RO, F2.FRO}. + declare module D <: DISTINGUISHER {SLCommon.C, C, Perm, Redo, F.RO, F.FRO, S, BIRO.IRO, BIRO2.IRO, F2.RO, F2.FRO}. - axiom D_lossless (F0 <: DFUNCTIONALITY{D}) (P0 <: DPRIMITIVE{D}) : + declare axiom D_lossless (F0 <: DFUNCTIONALITY{D}) (P0 <: DPRIMITIVE{D}) : islossless P0.f => islossless P0.fi => islossless F0.f => islossless D(F0, P0).distinguish. @@ -1986,9 +1986,9 @@ module Simulator (F : DFUNCTIONALITY) = { section Simplify_Simulator. -declare module D : DISTINGUISHER{Simulator, F.RO, BIRO.IRO, C, S, BIRO2.IRO}. +declare module D <: DISTINGUISHER {Simulator, F.RO, BIRO.IRO, C, S, BIRO2.IRO}. -axiom D_lossless (F0 <: DFUNCTIONALITY{D}) (P0 <: DPRIMITIVE{D}) : +declare axiom D_lossless (F0 <: DFUNCTIONALITY{D}) (P0 <: DPRIMITIVE{D}) : islossless P0.f => islossless P0.fi => islossless F0.f => islossless D(F0, P0).distinguish. @@ -2179,9 +2179,9 @@ end section Simplify_Simulator. section Real_Ideal. - declare module D : DISTINGUISHER{SLCommon.C, C, Perm, Redo, F.RO, F.FRO, S, BIRO.IRO, BIRO2.IRO, F2.RO, F2.FRO, Simulator}. + declare module D <: DISTINGUISHER {SLCommon.C, C, Perm, Redo, F.RO, F.FRO, S, BIRO.IRO, BIRO2.IRO, F2.RO, F2.FRO, Simulator}. - axiom D_lossless (F0 <: DFUNCTIONALITY{D}) (P0 <: DPRIMITIVE{D}) : + declare axiom D_lossless (F0 <: DFUNCTIONALITY{D}) (P0 <: DPRIMITIVE{D}) : islossless P0.f => islossless P0.fi => islossless F0.f => islossless D(F0, P0).distinguish. diff --git a/proof/smart_counter/Gext.eca b/proof/smart_counter/Gext.eca index 7177863..7a46c06 100644 --- a/proof/smart_counter/Gext.eca +++ b/proof/smart_counter/Gext.eca @@ -157,7 +157,7 @@ clone include EagerCore proof * by (move=> _; exact/Capacity.DCapacity.dunifin_ll). section. - declare module D: DISTINGUISHER{G1, G2, FRO, C}. + declare module D <: DISTINGUISHER{G1, G2, FRO, C}. op inv_ext (m mi:smap) (FROm:handles) = exists x h, mem (fdom m `|` fdom mi) x /\ FROm.[h] = Some (x.`2, Unknown). @@ -315,7 +315,7 @@ end section. section EXT. - declare module D: DISTINGUISHER{C, PF, G1, G2, Perm, RO, Redo}. + declare module D <: DISTINGUISHER{C, PF, G1, G2, Perm, RO, Redo}. local module ReSample = { var count:int @@ -693,7 +693,7 @@ section EXT. by apply H10. qed. - axiom D_ll: + declare axiom D_ll: forall (F <: DFUNCTIONALITY{D}) (P <: DPRIMITIVE{D}), islossless P.f => islossless P.fi => islossless F.f => islossless D(F, P).distinguish. diff --git a/proof/smart_counter/Handle.eca b/proof/smart_counter/Handle.eca index 5c9f283..69232b1 100644 --- a/proof/smart_counter/Handle.eca +++ b/proof/smart_counter/Handle.eca @@ -2561,9 +2561,9 @@ qed. section AUX. - declare module D : DISTINGUISHER {PF, RO, G1, Redo, C}. + declare module D <: DISTINGUISHER {PF, RO, G1, Redo, C}. - axiom D_ll (F <: DFUNCTIONALITY{D}) (P <: DPRIMITIVE{D}): + declare axiom D_ll (F <: DFUNCTIONALITY{D}) (P <: DPRIMITIVE{D}): islossless P.f => islossless P.fi => islossless F.f => islossless D(F, P).distinguish. @@ -2669,9 +2669,9 @@ end section AUX. section. - declare module D: DISTINGUISHER{Perm, C, PF, G1, RO, Redo}. + declare module D <: DISTINGUISHER{Perm, C, PF, G1, RO, Redo}. - axiom D_ll (F <: DFUNCTIONALITY{D}) (P <: DPRIMITIVE{D}): + declare axiom D_ll (F <: DFUNCTIONALITY{D}) (P <: DPRIMITIVE{D}): islossless P.f => islossless P.fi => islossless F.f => islossless D(F, P).distinguish. @@ -2682,15 +2682,16 @@ section. + Pr[G1(DRestr(D)).main() @&m: G1.bcol] + Pr[G1(DRestr(D)).main() @&m: G1.bext]. proof. - apply (@RealOrder.ler_trans _ _ _ (Real_Concrete D D_ll &m))=>//=. + apply (@RealOrder.ler_trans _ _ _ (Real_Concrete D _ &m))=>//=. + + exact: D_ll. have : Pr[CF(DRestr(D)).main() @ &m : res] <= Pr[G1(DRestr(D)).main() @ &m : res] + Pr[G1(DRestr(D)).main() @ &m : G1.bcol \/ G1.bext]. - + byequiv (CF_G1 D D_ll)=>//=/#. + + by byequiv (CF_G1 D D_ll)=>//=/#. have/#:Pr[G1(DRestr(D)).main() @ &m : G1.bcol \/ G1.bext] <= Pr[G1(DRestr(D)).main() @&m: G1.bcol] + Pr[G1(DRestr(D)).main() @&m: G1.bext]. - rewrite Pr[mu_or];smt(Distr.mu_bounded). + by rewrite Pr[mu_or];smt(Distr.mu_bounded). qed. end section. diff --git a/proof/smart_counter/SLCommon.ec b/proof/smart_counter/SLCommon.ec index 33fdb7b..c30b9e0 100644 --- a/proof/smart_counter/SLCommon.ec +++ b/proof/smart_counter/SLCommon.ec @@ -170,7 +170,7 @@ lemma build_hpath_map0 p: build_hpath empty p = if p = [] then Some (b0,0) else None. proof. elim/last_ind: p=> //= p b _. -by rewrite -{1}cats1 /build_hpath foldl_cat {1}/step_hpath /= emptyE /= [smt(size_rcons size_ge0)]. +by rewrite -{1}cats1 /build_hpath foldl_cat {1}/step_hpath /= emptyE /= #smt:(size_rcons size_ge0). qed. (* -------------------------------------------------------------------------- *) @@ -580,7 +580,6 @@ lemma asfadst queries prefixes (bs : block list) : proof. progress. have h:=prefix_inv_leq bs (size bs) prefixes queries _ _ _ _ _;rewrite//=. -+ exact size_ge0. + rewrite H2//=;exact size_ge0. have ->/=: prefix bs (get_max_prefix bs (elems (fdom queries))) = size bs by smt(prefix_sizel). rewrite take_oversize/#. @@ -689,8 +688,7 @@ lemma prefix_cat_leq_prefix_size (l1 l2 l3 : 'a list): proof. move:l2 l3;elim:l1=>//=. + by move=> l2 []; smt(prefix_sizel). -move=>e1 l1 hind1 l2 l3;move:e1 l1 l2 hind1;elim:l3=>//=;1:smt(size_ge0). -by move=>e3 l3 hind3 e1 l1 l2 hind1;case(e1=e3)=>//=[->>/#|h];exact size_ge0. +by move=>e1 l1 hind1 l2 l3;move:e1 l1 l2 hind1;elim:l3=>//=;1:smt(size_ge0). qed. lemma prefix_cat1 (l1 l2 l3 : 'a list) : @@ -956,9 +954,9 @@ qed. section RESTR. - declare module F:FUNCTIONALITY{C}. - declare module P:PRIMITIVE{C,F}. - declare module D:DISTINGUISHER{F,P,C}. + declare module F <: FUNCTIONALITY{C}. + declare module P <: PRIMITIVE{C,F}. + declare module D <: DISTINGUISHER{F,P,C}. lemma swap_restr &m: Pr[Indif(FRestr(F), PRestr(P), D).main()@ &m: res] = @@ -973,16 +971,16 @@ end section RESTR. section COUNT. - declare module P:PRIMITIVE{C}. - declare module CO:CONSTRUCTION{C,P}. - declare module D:DISTINGUISHER{C,P,CO}. + declare module P <: PRIMITIVE{C}. + declare module CO <: CONSTRUCTION{C,P}. + declare module D <: DISTINGUISHER{C,P,CO}. - axiom f_ll : islossless P.f. - axiom fi_ll : islossless P.fi. + declare axiom f_ll : islossless P.f. + declare axiom fi_ll : islossless P.fi. - axiom CO_ll : islossless CO(P).f. + declare axiom CO_ll : islossless CO(P).f. - axiom D_ll (F <: DFUNCTIONALITY{D}) (P <: DPRIMITIVE{D}): + declare axiom D_ll (F <: DFUNCTIONALITY{D}) (P <: DPRIMITIVE{D}): islossless P.f => islossless P.fi => islossless F.f => islossless D(F, P).distinguish. From dcd14c4fd7e9b6b443ea9c6b375873b084f56a4c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Fri, 26 Nov 2021 12:17:16 +0000 Subject: [PATCH 514/525] Folloe EasyCrypt HEAD Use standard library find, map on finite maps. --- proof/smart_counter/SLCommon.ec | 60 ++++++--------------------------- 1 file changed, 10 insertions(+), 50 deletions(-) diff --git a/proof/smart_counter/SLCommon.ec b/proof/smart_counter/SLCommon.ec index c30b9e0..9d4d596 100644 --- a/proof/smart_counter/SLCommon.ec +++ b/proof/smart_counter/SLCommon.ec @@ -1010,44 +1010,6 @@ section COUNT. end section COUNT. -(* -------------------------------------------------------------------------- *) -op has (P : 'a -> 'b -> bool) (m : ('a,'b) fmap) = - List.has (fun x=> x \in m /\ P x (oget m.[x])) (elems (fdom m)). - -lemma hasP (P : 'a -> 'b -> bool) (m : ('a,'b) fmap): - has P m <=> exists x, x \in m /\ P x (oget m.[x]). -proof. -rewrite /has hasP; split=> [] [x] [#]. -+ by move=> _ x_in_m Pxmx; exists x. -by move=> x_in_m Pxmx; exists x; rewrite -memE mem_fdom. -qed. - -op find (P : 'a -> 'b -> bool) (m : ('a,'b) fmap) = - onth (elems (fdom m)) (find (fun x=> x \in m /\ P x (oget m.[x])) (elems (fdom m))). - -lemma find_none (P : 'a -> 'b -> bool) (m : ('a,'b) fmap): - has P m <=> find P m <> None. -proof. -rewrite /find /has has_find; split=> [h|]. -+ by rewrite (onth_nth witness) 1:find_ge0 /=. -by apply/contraLR=> h; rewrite onth_nth_map nth_default 1:size_map 1:lezNgt. -qed. - -lemma findP (P : 'a -> 'b -> bool) (m : ('a,'b) fmap): - (exists x, find P m = Some x /\ x \in m /\ P x (oget m.[x])) \/ - (find P m = None /\ forall x, x \in m => !P x (oget m.[x])). -proof. -case: (has P m)=> ^ => [hasPm|nothasPm]; rewrite hasP. -+ move=> [x] [] x_in_m Pxmx; left. - exists (nth witness (elems (fdom m)) (find (fun x=> x \in m /\ P x (oget m.[x])) (elems (fdom m)))). - rewrite /find (onth_nth witness) /=. - + by rewrite find_ge0 /=; apply/has_find/hasPm. - by move: hasPm=> /(nth_find witness) /=. -rewrite negb_exists /=. -move: nothasPm; rewrite find_none=> /= -> h; right=> /= x. -by move: (h x); rewrite negb_and=> /#. -qed. - (** Operators and properties of handles *) op hinv (handles:handles) (c:capacity) = find (fun _ => pred1 c \o fst) handles. @@ -1066,11 +1028,9 @@ lemma hinvP handles c: else exists f, handles.[oget (hinv handles c)] = Some(c,f). proof. move=> @/hinv. -have @/pred1@/(\o)/=[[h []->[]Hmem <<-]|[]->H h f]/= := - findP (fun (_ : handle) => pred1 c \o fst) handles. -+ exists (oget handles.[h]).`2. - by move: Hmem; rewrite domE; case: (handles.[h])=> //= - []. -by have := H h;rewrite domE /#. +have @/pred1 @/(\o) /> [-> /= + h f|h [] /> f -> //= Hmem] := findP (fun _=> pred1 c \o fst) handles. ++ by move=> /(_ h); rewrite domE; case: (handles.[h])=> /#. +by exists f. qed. lemma huniq_hinv (handles:handles) (h:handle): @@ -1089,23 +1049,23 @@ lemma hinvKP handles c: if hinvK handles c = None then forall h, handles.[h] <> Some(c,Known) else handles.[oget (hinvK handles c)] = Some(c,Known). proof. - rewrite /hinvK. - have @/pred1/= [[h]|][->/=]:= findP (+ pred1 c) (restr Known handles). - + by rewrite domE restrP;case (handles.[h])=>//= /#. - by move=>+h-/(_ h);rewrite domE restrP => H1/#. +rewrite /hinvK. +have @/pred1 /= [-> /= + h|h /> -> /=]:= findP (+ pred1 c) (restr Known handles). ++ by move=> /(_ h); rewrite domE restrP=> /#. +by rewrite restrP; case: (handles.[h])=> //= - [] /#. qed. lemma huniq_hinvK (handles:handles) c: huniq handles => rng handles (c,Known) => handles.[oget (hinvK handles c)] = Some(c,Known). proof. - move=> Huniq;rewrite rngE=> -[h]H;case: (hinvK _ _) (Huniq h) (hinvKP handles c)=>//=. - by move=>_/(_ h);rewrite H. +move=> Huniq;rewrite rngE=> -[h]H;case: (hinvK _ _) (Huniq h) (hinvKP handles c)=>//=. +by move=>_/(_ h);rewrite H. qed. lemma huniq_hinvK_h h (handles:handles) c: huniq handles => handles.[h] = Some (c,Known) => hinvK handles c = Some h. proof. - by move=> Huniq;case: (hinvK _ _) (hinvKP handles c)=>/= [ H | h' /Huniq H/H //]; apply H. +by move=> Huniq;case: (hinvK _ _) (hinvKP handles c)=>/= [ H | h' /Huniq H/H //]; apply H. qed. (* -------------------------------------------------------------------------- *) From de356abb4086ba0bc1029a66b3c0baa3d979c9d8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Fri, 3 Dec 2021 14:46:22 +0000 Subject: [PATCH 515/525] Fix CI to new build-box --- .gitlab-ci.yml | 12 +++++------- 1 file changed, 5 insertions(+), 7 deletions(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 0322847..1a85383 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -3,7 +3,6 @@ image: docker:latest variables: DOCKER_DRIVER: overlay DOCKER_TLS_CERTDIR: "" - ECJOBS: 2 GIT_SUBMODULE_STRATEGY: recursive ECTAG: "1.0" @@ -15,19 +14,18 @@ before_script: - docker pull docker.io/easycryptpa/ec-build-box:latest - >- docker run --name testbox docker.io/easycryptpa/ec-build-box:latest - sh -c "opam pin -n easycrypt https://github.com/EasyCrypt/easycrypt.git#$ECTAG && - opam install easycrypt && + sh -c "git clone https://github.com/EasyCrypt/easycrypt.git --depth 1 --branch $ECTAG + cd easycrypt && make install && opam config exec -- easycrypt config" - docker commit testbox testbox:latest .tests: - only: - - master - - ci + variables: + ECJOBS: 2 script: - >- docker run -v $PWD:/sha3 --env CHECKS --env ECJOBS testbox - sh -c 'cd sha3 && opam config exec -- make check-xunit' + sh -c 'cd /sha3 && opam config exec -- make check-xunit' artifacts: when: on_failure paths: From 0d1f08799e8ba584310c32a0b6abb177b65fa96f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Fri, 3 Dec 2021 14:46:39 +0000 Subject: [PATCH 516/525] LRO is now top-level in PROM --- proof/Sponge.ec | 5 ++--- proof/smart_counter/Gconcl.ec | 10 +++++----- proof/smart_counter/Gconcl_list.ec | 22 +++++++++++----------- 3 files changed, 18 insertions(+), 19 deletions(-) diff --git a/proof/Sponge.ec b/proof/Sponge.ec index ba4662d..11b6352 100644 --- a/proof/Sponge.ec +++ b/proof/Sponge.ec @@ -368,13 +368,12 @@ section. declare module D <: HYBRID_IRO_DIST {HybridIROEager, HybridIROLazy}. -local clone PROM.FullRO as ERO with +local clone import PROM.FullRO as ERO with type in_t <- block list * int, type out_t <- bool, op dout _ <- dbool, type d_in_t <- unit, type d_out_t <- bool. -import ERO.FullEager. local module EROExper(O : ERO.RO, D : ERO.RO_Distinguisher) = { proc main() : bool = { @@ -391,7 +390,7 @@ local lemma LRO_RO (D <: ERO.RO_Distinguisher{ERO.RO, ERO.FRO}) &m : proof. byequiv=> //; proc. seq 1 1 : (={glob D, ERO.RO.m}); first sim. -by symmetry; call (RO_LRO_D D _); auto; rewrite dbool_ll. +by symmetry; call (FullEager.RO_LRO_D D _); auto; rewrite dbool_ll. qed. (* make a Hybrid IRO out of a random oracle *) diff --git a/proof/smart_counter/Gconcl.ec b/proof/smart_counter/Gconcl.ec index 6810902..1a37704 100644 --- a/proof/smart_counter/Gconcl.ec +++ b/proof/smart_counter/Gconcl.ec @@ -204,7 +204,7 @@ local module G3(RO:F.RO) = { } }. -local equiv G2_G3: Eager(G2(DRestr(D))).main2 ~ G3(F.FullEager.LRO).distinguish : ={glob D} ==> ={res}. +local equiv G2_G3: Eager(G2(DRestr(D))).main2 ~ G3(F.LRO).distinguish : ={glob D} ==> ={res}. proof. proc;wp;call{1} RRO_resample_ll;inline *;wp. call (_: ={FRO.m,F.RO.m,G1.m,G1.mi,G1.mh,G1.mhi,G1.chandle,G1.paths,C.c,C.queries}); last by auto. @@ -348,7 +348,7 @@ proof. by sim;inline *;auto;progress;smt(DCapacity.dunifin_ll). qed. -local equiv G4_Ideal : G4(F.FullEager.LRO).distinguish ~ IdealIndif(IF,S,DRestr(D)).main : +local equiv G4_Ideal : G4(F.LRO).distinguish ~ IdealIndif(IF,S,DRestr(D)).main : ={glob D} ==> ={res}. proof. proc;inline *;wp. @@ -356,7 +356,7 @@ proof. + by sim. + by sim. + proc;sp;if=>//;auto;if=>//;auto. call (_: ={F.RO.m});2:by auto. - inline F.FullEager.LRO.get F.FRO.sample;wp 7 2;sim. + inline F.LRO.get F.FRO.sample;wp 7 2;sim. by while{1} (true) (size p - i){1};auto;1:inline*;auto=>/#. by auto. qed. @@ -376,12 +376,12 @@ lemma Real_Ideal &m: proof. apply (ler_trans _ _ _ (Real_G2 D D_ll &m)). rewrite !(ler_add2l, ler_add2r);apply lerr_eq. - apply (eq_trans _ Pr[G3(F.FullEager.LRO).distinguish() @ &m : res]);1:by byequiv G2_G3. + apply (eq_trans _ Pr[G3(F.LRO).distinguish() @ &m : res]);1:by byequiv G2_G3. apply (eq_trans _ Pr[G3(F.RO ).distinguish() @ &m : res]). + byequiv (_: ={glob G3, F.RO.m} ==> _)=>//;symmetry;conseq (F.FullEager.RO_LRO_D G3 _)=> //. by move=> _; exact/Block.DBlock.dunifin_ll. apply (eq_trans _ Pr[G4(F.RO ).distinguish() @ &m : res]);1:by byequiv G3_G4. - apply (eq_trans _ Pr[G4(F.FullEager.LRO).distinguish() @ &m : res]). + apply (eq_trans _ Pr[G4(F.LRO).distinguish() @ &m : res]). + byequiv (F.FullEager.RO_LRO_D G4 _)=> //. by move=> _; exact/Block.DBlock.dunifin_ll. by byequiv G4_Ideal. diff --git a/proof/smart_counter/Gconcl_list.ec b/proof/smart_counter/Gconcl_list.ec index 72cb5ec..f01a1c4 100644 --- a/proof/smart_counter/Gconcl_list.ec +++ b/proof/smart_counter/Gconcl_list.ec @@ -327,9 +327,9 @@ section Ideal. }. local equiv Ideal_equiv_valid (D <: DISTINGUISHER{SLCommon.C, C, IF, S}) : - L(D,F.FullEager.LRO).distinguish + L(D,F.LRO).distinguish ~ - L2(D,F.FullEager.LRO).distinguish + L2(D,F.LRO).distinguish : ={glob D} ==> ={glob D, res}. proof. @@ -339,7 +339,7 @@ section Ideal. call(: ={glob S,glob F.RO});auto. sp;if;auto;if;auto;sp. call(: ={glob F.RO});2:auto;2:smt(). - inline F.FullEager.LRO.sample;call(: ={glob IF});auto;progress. + inline F.LRO.sample;call(: ={glob IF});auto;progress. by while{1}(true)(n{1}-i{1});auto;smt(). + by proc;sim. proc;sp;if;auto;sp;call(: ={glob IF,glob S});auto. @@ -836,7 +836,7 @@ section Ideal. local equiv equiv_L4_ideal (D <: DISTINGUISHER{SLCommon.C, C, IF, S, F2.RO, BIRO.IRO, BIRO2.IRO}) : - L4(D,F.FullEager.LRO,F2.FullEager.LRO).distinguish + L4(D,F.LRO,F2.LRO).distinguish ~ IdealIndif(BIRO.IRO,SimLast(S),DRestr(D)).main : @@ -912,7 +912,7 @@ section Ideal. D(FC(FValid(DSqueeze2(F, F2.RO))), PC(S(Last(DSqueeze2(F, F2.RO))))). local module D6 (D : DISTINGUISHER) (F2 : F2.RO) = - D(FC(FValid(DSqueeze2(F.FullEager.LRO, F2))), PC(S(Last(DSqueeze2(F.FullEager.LRO, F2))))). + D(FC(FValid(DSqueeze2(F.LRO, F2))), PC(S(Last(DSqueeze2(F.LRO, F2))))). lemma equiv_ideal (D <: DISTINGUISHER{SLCommon.C, C, IF, S, F.FRO, F2.RO, F2.FRO, BIRO.IRO, BIRO2.IRO}) &m: @@ -926,17 +926,17 @@ section Ideal. Pr[SLCommon.IdealIndif(IF,S,A(D)).main() @ &m : res]. + by byequiv(ideal_equiv2 D). have->:Pr[L2(D, F.RO).distinguish() @ &m : res] = - Pr[L2(D,F.FullEager.LRO).distinguish() @ &m : res]. + Pr[L2(D,F.LRO).distinguish() @ &m : res]. + byequiv=>//=;proc;sp;inline*;sp;wp. call(F.FullEager.RO_LRO_D (D2(D)) _);auto. by move=> _; exact/dunifin_ll. have->:Pr[IdealIndif(BIRO.IRO, SimLast(S), DRestr(D)).main() @ &m : res] = - Pr[L4(D,F.FullEager.LRO,F2.FullEager.LRO).distinguish() @ &m : res]. + Pr[L4(D,F.LRO,F2.LRO).distinguish() @ &m : res]. + by rewrite eq_sym;byequiv(equiv_L4_ideal D)=>//=. have<-:Pr[L4(D, F.RO, F2.RO).distinguish() @ &m : res] = - Pr[L4(D,F.FullEager.LRO,F2.FullEager.LRO).distinguish() @ &m : res]. + Pr[L4(D,F.LRO,F2.LRO).distinguish() @ &m : res]. + have->:Pr[L4(D, F.RO, F2.RO).distinguish() @ &m : res] = - Pr[L4(D,F.FullEager.LRO, F2.RO).distinguish() @ &m : res]. + Pr[L4(D,F.LRO, F2.RO).distinguish() @ &m : res]. - byequiv=>//=;proc;sp;inline*;sp;wp. call(F.FullEager.RO_LRO_D (D5(D)) _); auto. by move=> _; exact/dunifin_ll. @@ -950,7 +950,7 @@ section Ideal. Pr[L3(D, F.RO).distinguish() @ &m : res]. + by byequiv(Ideal_equiv3 D). have->:Pr[L(D, F.RO).distinguish() @ &m : res] = - Pr[L(D,F.FullEager.LRO).distinguish() @ &m : res]. + Pr[L(D,F.LRO).distinguish() @ &m : res]. + byequiv=>//=;proc;sp;inline*;sp;wp. call(F.FullEager.RO_LRO_D (D3(D)) _); auto. by move=> _; exact/dunifin_ll. @@ -2136,7 +2136,7 @@ qed. local lemma equal2 &m : Pr [ IdealIndif(BIRO.IRO, Simulator, DRestr(D)).main() @ &m : res ] = - Pr [ L(IRO2.FullEager.LRO).distinguish() @ &m : res ]. + Pr [ L(IRO2.LRO).distinguish() @ &m : res ]. proof. byequiv=>//=; proc; inline*; auto. call (: ={BIRO.IRO.mp,C.c,Simulator.m,Simulator.mi,Simulator.paths} /\ From 0ef3035f853d998cf7f5cce8292e25b2cae21a79 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Wed, 12 Jan 2022 11:36:54 +0000 Subject: [PATCH 517/525] [chore] Uniform use of <@ --- proof/SHA3Indiff.ec | 2 +- proof/SHA3OSecurity.ec | 2 -- proof/SHA3_OIndiff.ec | 2 +- proof/SecureHash.eca | 6 +++--- proof/SecureORO.eca | 2 +- proof/SecureRO.eca | 2 +- proof/smart_counter/Gcol.eca | 6 +++--- proof/smart_counter/Gconcl.ec | 12 ++++++------ proof/smart_counter/Gconcl_list.ec | 2 +- proof/smart_counter/Gext.eca | 12 ++++++------ proof/smart_counter/Handle.eca | 4 ++-- 11 files changed, 25 insertions(+), 27 deletions(-) diff --git a/proof/SHA3Indiff.ec b/proof/SHA3Indiff.ec index fa02597..fa74e83 100644 --- a/proof/SHA3Indiff.ec +++ b/proof/SHA3Indiff.ec @@ -40,7 +40,7 @@ module Simulator (F : DFUNCTIONALITY) = { cs <@ F.f(oget (unpad_blocks q), k * r); z <- bits2blocks cs; } else { - z <- Gconcl_list.BIRO2.IRO.f(q,k); + z <@ Gconcl_list.BIRO2.IRO.f(q,k); } y1 <- last b0 z; } else { diff --git a/proof/SHA3OSecurity.ec b/proof/SHA3OSecurity.ec index e78cef3..23520fc 100644 --- a/proof/SHA3OSecurity.ec +++ b/proof/SHA3OSecurity.ec @@ -2631,5 +2631,3 @@ by have/#:=leq_ideal &m. qed. end section Collision. - - diff --git a/proof/SHA3_OIndiff.ec b/proof/SHA3_OIndiff.ec index 3f5a6ea..f031292 100644 --- a/proof/SHA3_OIndiff.ec +++ b/proof/SHA3_OIndiff.ec @@ -77,7 +77,7 @@ module OSimulator (F : ODFUNCTIONALITY) = { cs <- oget o; z <- bits2blocks cs; } else { - z <- Gconcl_list.BIRO2.IRO.f(q,k); + z <@ Gconcl_list.BIRO2.IRO.f(q,k); } y1 <- last b0 z; } else { diff --git a/proof/SecureHash.eca b/proof/SecureHash.eca index 76caecd..db62960 100644 --- a/proof/SecureHash.eca +++ b/proof/SecureHash.eca @@ -62,7 +62,7 @@ module FBounder (F : OFUNCTIONALITY) : OFUNCTIONALITY = { var y : to option <- None; if (increase_counter Bounder.bounder x <= bound) { Bounder.bounder <- increase_counter Bounder.bounder x; - y <- F.f(x); + y <@ F.f(x); } return y; } @@ -77,7 +77,7 @@ module PBounder (P : OPRIMITIVE) : OPRIMITIVE = { proc f (x : block) : block option = { var y <- None; if (Bounder.bounder < bound) { - y <- P.f(x); + y <@ P.f(x); Bounder.bounder <- Bounder.bounder + 1; } return y; @@ -85,7 +85,7 @@ module PBounder (P : OPRIMITIVE) : OPRIMITIVE = { proc fi (x : block) : block option = { var y <- None; if (Bounder.bounder < bound) { - y <- P.fi(x); + y <@ P.fi(x); Bounder.bounder <- Bounder.bounder + 1; } return y; diff --git a/proof/SecureORO.eca b/proof/SecureORO.eca index 8a4ae24..78cc3b1 100644 --- a/proof/SecureORO.eca +++ b/proof/SecureORO.eca @@ -52,7 +52,7 @@ module Bounder (F : RF) : RF = { var y : to option <- None; if (bounder < bound) { bounder <- bounder + 1; - y <- F.get(x); + y <@ F.get(x); } return y; } diff --git a/proof/SecureRO.eca b/proof/SecureRO.eca index c1917a4..763a27e 100644 --- a/proof/SecureRO.eca +++ b/proof/SecureRO.eca @@ -54,7 +54,7 @@ module Bounder (F : RF) : RF = { bounder <- bounder + 1; if (increase_counter Counter.c x < bound_counter) { Counter.c <- increase_counter Counter.c x; - y <- F.get(x); + y <@ F.get(x); } } return y; diff --git a/proof/smart_counter/Gcol.eca b/proof/smart_counter/Gcol.eca index 2211a44..511eab0 100644 --- a/proof/smart_counter/Gcol.eca +++ b/proof/smart_counter/Gcol.eca @@ -58,7 +58,7 @@ section PROOF. } else { if (counter < size p - prefix p (get_max_prefix p (elems (fdom C.queries)))) { sc <@ sample_c(); - sa' <- F.RO.get(take (i+1) p); + sa' <@ F.RO.get(take (i+1) p); sa <- sa +^ nth witness p i; G1.mh.[(sa,h)] <- (sa', G1.chandle); G1.mhi.[(sa',G1.chandle)] <- (sa, h); @@ -70,7 +70,7 @@ section PROOF. } i <- i + 1; } - sa <- F.RO.get(p); + sa <@ F.RO.get(p); return sa; } } @@ -89,7 +89,7 @@ section PROOF. hx2 <- oget (hinvK FRO.m x.`2); if (x.`2 \in G1.paths) { (p,v) <- oget G1.paths.[x.`2]; - y1 <- F.RO.get (rcons p (v +^ x.`1)); + y1 <@ F.RO.get (rcons p (v +^ x.`1)); y2 <@ sample_c(); } else { y1 <$ bdistr; diff --git a/proof/smart_counter/Gconcl.ec b/proof/smart_counter/Gconcl.ec index 1a37704..557f6c5 100644 --- a/proof/smart_counter/Gconcl.ec +++ b/proof/smart_counter/Gconcl.ec @@ -28,7 +28,7 @@ module S(F : DFUNCTIONALITY) = { if (x \notin m) { if (x.`2 \in paths) { (p,v) <- oget paths.[x.`2]; - y1 <- F.f (rcons p (v +^ x.`1)); + y1 <@ F.f (rcons p (v +^ x.`1)); } else { y1 <$ bdistr; } @@ -97,7 +97,7 @@ local module G3(RO:F.RO) = { } i <- i + 1; } - sa <- RO.get(p); + sa <@ RO.get(p); return sa; } } @@ -110,7 +110,7 @@ local module G3(RO:F.RO) = { if (x \notin G1.m) { if (x.`2 \in G1.paths) { (p,v) <- oget G1.paths.[x.`2]; - y1 <- RO.get (rcons p (v +^ x.`1)); + y1 <@ RO.get (rcons p (v +^ x.`1)); } else { y1 <$ bdistr; } @@ -121,7 +121,7 @@ local module G3(RO:F.RO) = { RRO.set(G1.chandle, x.`2); G1.chandle <- G1.chandle + 1; } - handles_ <- RRO.allKnown(); + handles_ <@ RRO.allKnown(); hx2 <- oget (hinvc handles_ x.`2); t <@ RRO.queried((oget G1.mh.[(x.`1,hx2)]).`2, Unknown); if ((x.`1, hx2) \in G1.mh /\ t) { @@ -263,7 +263,7 @@ local module G4(RO:F.RO) = { RO.sample(take (i+1) p); i <- i + 1; } - sa <- RO.get(p); + sa <@ RO.get(p); return sa; } } @@ -276,7 +276,7 @@ local module G4(RO:F.RO) = { if (x \notin G1.m) { if (x.`2 \in G1.paths) { (p,v) <- oget G1.paths.[x.`2]; - y1 <- RO.get (rcons p (v +^ x.`1)); + y1 <@ RO.get (rcons p (v +^ x.`1)); } else { y1 <$ bdistr; } diff --git a/proof/smart_counter/Gconcl_list.ec b/proof/smart_counter/Gconcl_list.ec index f01a1c4..83c146d 100644 --- a/proof/smart_counter/Gconcl_list.ec +++ b/proof/smart_counter/Gconcl_list.ec @@ -2021,7 +2021,7 @@ local module Simu (FRO : IRO2.RO) (F : DFUNCTIONALITY) = { FRO.sample(q,i); i <- i + 1; } - y1 <- FRO.get(q,k-1); + y1 <@ FRO.get(q,k-1); } else { y1 <- b0; } diff --git a/proof/smart_counter/Gext.eca b/proof/smart_counter/Gext.eca index 7a46c06..8787e44 100644 --- a/proof/smart_counter/Gext.eca +++ b/proof/smart_counter/Gext.eca @@ -40,7 +40,7 @@ module G2(D:DISTINGUISHER,HS:FRO) = { } i <- i + 1; } - sa <- F.RO.get(p); + sa <@ F.RO.get(p); return sa; } } @@ -53,7 +53,7 @@ module G2(D:DISTINGUISHER,HS:FRO) = { if (x \notin G1.m) { if (x.`2 \in G1.paths) { (p,v) <- oget G1.paths.[x.`2]; - y1 <- F.RO.get (rcons p (v +^ x.`1)); + y1 <@ F.RO.get (rcons p (v +^ x.`1)); y2 <$ cdistr; } else { y1 <$ bdistr; @@ -66,7 +66,7 @@ module G2(D:DISTINGUISHER,HS:FRO) = { HS.set(G1.chandle, x.`2); G1.chandle <- G1.chandle + 1; } - handles_ <- HS.allKnown(); + handles_ <@ HS.allKnown(); hx2 <- oget (hinvc handles_ x.`2); t <@ HS.queried((oget G1.mh.[(x.`1,hx2)]).`2, Unknown); if ((x.`1, hx2) \in G1.mh /\ t) { @@ -371,7 +371,7 @@ section EXT. } i <- i + 1; } - sa <- F.RO.get(p); + sa <@ F.RO.get(p); return sa; } } @@ -384,7 +384,7 @@ section EXT. if (x \notin G1.m) { if (x.`2 \in G1.paths) { (p,v) <- oget G1.paths.[x.`2]; - y1 <- F.RO.get (rcons p (v +^ x.`1)); + y1 <@ F.RO.get (rcons p (v +^ x.`1)); } else { y1 <$ bdistr; } @@ -397,7 +397,7 @@ section EXT. RRO.set(G1.chandle, x.`2); G1.chandle <- G1.chandle + 1; } - handles_ <- RRO.allKnown(); + handles_ <@ RRO.allKnown(); hx2 <- oget (hinvc handles_ x.`2); t <@ RRO.queried((oget G1.mh.[(x.`1,hx2)]).`2, Unknown); if ((x.`1, hx2) \in G1.mh /\ t) { diff --git a/proof/smart_counter/Handle.eca b/proof/smart_counter/Handle.eca index 69232b1..a56c533 100644 --- a/proof/smart_counter/Handle.eca +++ b/proof/smart_counter/Handle.eca @@ -50,7 +50,7 @@ module G1(D:DISTINGUISHER) = { } i <- i + 1; } - sa <- F.RO.get(p); + sa <@ F.RO.get(p); return sa; } } @@ -63,7 +63,7 @@ module G1(D:DISTINGUISHER) = { if (x \notin m) { if (x.`2 \in paths) { (p,v) <- oget paths.[x.`2]; - y1 <- F.RO.get (rcons p (v +^ x.`1)); + y1 <@ F.RO.get (rcons p (v +^ x.`1)); y2 <$ cdistr; } else { y1 <$ bdistr; From 34363ca73bdd37dcb2250873a9316eef4713e032 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Fri, 8 Apr 2022 10:20:15 +0100 Subject: [PATCH 518/525] follow EasyCrypt HEAD (syntax) --- proof/Common.ec | 4 +-- proof/IndifRO_is_secure.ec | 36 ++++++++++++------------- proof/SHA3Indiff.ec | 21 +++++---------- proof/SHA3OSecurity.ec | 18 +++---------- proof/SHA3Security.ec | 34 ++++++++--------------- proof/SHA3_OIndiff.ec | 13 ++------- proof/SecureORO.eca | 6 ++--- proof/SecureRO.eca | 6 ++--- proof/Sponge.ec | 21 +++++++-------- proof/smart_counter/ConcreteF.eca | 13 +++++---- proof/smart_counter/Gcol.eca | 4 +-- proof/smart_counter/Gconcl.ec | 9 +++---- proof/smart_counter/Gconcl_list.ec | 43 +++++++++++++++--------------- proof/smart_counter/Gext.eca | 8 +++--- proof/smart_counter/Handle.eca | 22 +++++++-------- proof/smart_counter/SLCommon.ec | 26 +++++++++--------- 16 files changed, 119 insertions(+), 165 deletions(-) diff --git a/proof/Common.ec b/proof/Common.ec index a844fbb..044a8f4 100644 --- a/proof/Common.ec +++ b/proof/Common.ec @@ -138,8 +138,8 @@ qed. lemma needed_blocks_suff (n : int) : n <= (n + r - 1) %/ r * r. proof. -have -> : (n + r - 1) %/r * r = (n + r - 1) - (n + r - 1)%% r - by rewrite {2}(@divz_eq (n + r - 1) r) #ring. +have -> : (n + r - 1) %/r * r = (n + r - 1) - (n + r - 1)%% r. ++ by rewrite {2}(@divz_eq (n + r - 1) r) #ring. by rewrite -(@addzA n) -(@addzA n) lez_addl subz_ge0 -ltzS -(@addzA r) /= ltz_pmod gt0_r. qed. diff --git a/proof/IndifRO_is_secure.ec b/proof/IndifRO_is_secure.ec index be9534a..2b9d332 100644 --- a/proof/IndifRO_is_secure.ec +++ b/proof/IndifRO_is_secure.ec @@ -91,15 +91,15 @@ module DColl (A : AdvCollision) (F : DFUNCTIONALITY) (P : DPRIMITIVE) = { section Collision. - declare module A <: AdvCollision {Bounder, SRO.RO.RO, SRO.RO.FRO}. + declare module A <: AdvCollision {-Bounder, -SRO.RO.RO, -SRO.RO.FRO}. - declare axiom D_ll (F <: Oracle { A }) : + declare axiom D_ll (F <: Oracle {-A}) : islossless F.get => islossless A(F).guess. lemma coll_resistant_if_indifferentiable - (C <: CONSTRUCTION{A, Bounder}) - (P <: PRIMITIVE{C, A, Bounder}) &m : - (exists (S <: SIMULATOR{Bounder, A}), + (C <: CONSTRUCTION{-A, -Bounder}) + (P <: PRIMITIVE{-C, -A, -Bounder}) &m : + (exists (S <: SIMULATOR{-Bounder, -A}), (forall (F <: FUNCTIONALITY), islossless F.f => islossless S(F).init) /\ `|Pr[GReal(C,P,DColl(A)).main() @ &m : res] - Pr[GIdeal(RO,S,DColl(A)).main() @ &m : res]| <= bound) => @@ -110,7 +110,7 @@ section Collision. have->: Pr[Collision(A, FM(C,P)).main() @ &m : res] = Pr[GReal(C, P, DColl(A)).main() @ &m : res]. + byequiv=>//=; proc; inline*; wp; sim. - by swap{1} [1..2] 2; sim. + by swap {1} [1..2] 2; sim. have/#:Pr[GIdeal(RO, S, DColl(A)).main() @ &m : res] <= (limit * (limit - 1) + 2)%r / 2%r * mu1 sampleto witness. have->:Pr[GIdeal(RO, S, DColl(A)).main() @ &m : res] = @@ -136,16 +136,16 @@ module DPre (A : AdvPreimage) (F : DFUNCTIONALITY) (P : DPRIMITIVE) = { section Preimage. - declare module A <: AdvPreimage {Bounder, SRO.RO.RO, SRO.RO.FRO, DPre}. + declare module A <: AdvPreimage {-Bounder, -SRO.RO.RO, -SRO.RO.FRO, -DPre}. - declare axiom D_ll (F <: Oracle{A}) : + declare axiom D_ll (F <: Oracle{-A}) : islossless F.get => islossless A(F).guess. lemma preimage_resistant_if_indifferentiable - (C <: CONSTRUCTION{A, Bounder, DPre}) - (P <: PRIMITIVE{C, A, Bounder, DPre}) &m hash : + (C <: CONSTRUCTION{-A, -Bounder, -DPre}) + (P <: PRIMITIVE{-C, -A, -Bounder, -DPre}) &m hash : (DPre.h{m} = hash) => - (exists (S <: SIMULATOR{Bounder, A, DPre}), + (exists (S <: SIMULATOR{-Bounder, -A, -DPre}), (forall (F <: FUNCTIONALITY), islossless F.f => islossless S(F).init) /\ `|Pr[GReal(C,P,DPre(A)).main() @ &m : res] - Pr[GIdeal(RO,S,DPre(A)).main() @ &m : res]| <= bound) => @@ -156,7 +156,7 @@ section Preimage. have->: Pr[Preimage(A, FM(C,P)).main(hash) @ &m : res] = Pr[GReal(C, P, DPre(A)).main() @ &m : res]. + byequiv=>//=; proc; inline*; wp; sp; wp; sim. - by swap{2} [1..2] 4; sim; auto; smt(). + by swap {2} [1..2] 4; sim; auto; smt(). have/#:Pr[GIdeal(RO, S, DPre(A)).main() @ &m : res] <= (limit + 1)%r * mu1 sampleto hash. have->:Pr[GIdeal(RO, S, DPre(A)).main() @ &m : res] = @@ -182,16 +182,16 @@ module D2Pre (A : AdvSecondPreimage) (F : DFUNCTIONALITY) (P : DPRIMITIVE) = { section SecondPreimage. - declare module A <: AdvSecondPreimage {Bounder, SRO.RO.RO, SRO.RO.FRO, D2Pre}. + declare module A <: AdvSecondPreimage {-Bounder, -SRO.RO.RO, -SRO.RO.FRO, -D2Pre}. - declare axiom D_ll (F <: Oracle{A}) : + declare axiom D_ll (F <: Oracle{-A}) : islossless F.get => islossless A(F).guess. lemma second_preimage_resistant_if_indifferentiable - (C <: CONSTRUCTION{A, Bounder, D2Pre}) - (P <: PRIMITIVE{C, A, Bounder, D2Pre}) &m mess : + (C <: CONSTRUCTION{-A, -Bounder, -D2Pre}) + (P <: PRIMITIVE{-C, -A, -Bounder, -D2Pre}) &m mess : (D2Pre.m2{m} = mess) => - (exists (S <: SIMULATOR{Bounder, A, D2Pre}), + (exists (S <: SIMULATOR{-Bounder, -A, -D2Pre}), (forall (F <: FUNCTIONALITY), islossless F.f => islossless S(F).init) /\ `|Pr[GReal(C,P,D2Pre(A)).main() @ &m : res] - Pr[GIdeal(RO,S,D2Pre(A)).main() @ &m : res]| <= bound) => @@ -202,7 +202,7 @@ section SecondPreimage. have->: Pr[SecondPreimage(A, FM(C,P)).main(mess) @ &m : res] = Pr[GReal(C, P, D2Pre(A)).main() @ &m : res]. + byequiv=>//=; proc; inline*; wp; sp; wp; sim. - by swap{2} [1..2] 3; sim; auto; smt(). + by swap {2} [1..2] 3; sim; auto; smt(). have/#:Pr[GIdeal(RO, S, D2Pre(A)).main() @ &m : res] <= (limit + 1)%r * mu1 sampleto witness. have->:Pr[GIdeal(RO, S, D2Pre(A)).main() @ &m : res] = diff --git a/proof/SHA3Indiff.ec b/proof/SHA3Indiff.ec index fa74e83..85aed88 100644 --- a/proof/SHA3Indiff.ec +++ b/proof/SHA3Indiff.ec @@ -146,13 +146,9 @@ module DRestr (D : DISTINGUISHER) (F : DFUNCTIONALITY) (P : DPRIMITIVE) = { section. declare module Dist <: - DISTINGUISHER {Perm, Gconcl_list.SimLast, IRO, Cntr, BlockSponge.BIRO.IRO, - Simulator, BlockSponge.C, Gconcl.S, - SLCommon.F.RO, SLCommon.F.FRO, SLCommon.Redo, SLCommon.C, - Gconcl_list.BIRO2.IRO, Gconcl_list.F2.RO, Gconcl_list.F2.FRO, - Gconcl_list.Simulator}. + DISTINGUISHER {-Perm, -Gconcl_list.SimLast, -IRO, -Cntr, -BlockSponge.BIRO.IRO, -Simulator, -BlockSponge.C, -Gconcl.S, -SLCommon.F.RO, -SLCommon.F.FRO, -SLCommon.Redo, -SLCommon.C, -Gconcl_list.BIRO2.IRO, -Gconcl_list.F2.RO, -Gconcl_list.F2.FRO, -Gconcl_list.Simulator}. -declare axiom Dist_lossless (F <: DFUNCTIONALITY { Dist }) (P <: DPRIMITIVE { Dist }) : +declare axiom Dist_lossless (F <: DFUNCTIONALITY {-Dist}) (P <: DPRIMITIVE {-Dist}) : islossless P.f => islossless P.fi => islossless F.f => islossless Dist(F,P).distinguish. @@ -226,7 +222,7 @@ qed. op wit_pair : block * capacity = witness. -local equiv equiv_sim_f (F <: DFUNCTIONALITY{Gconcl.S, Simulator}) : +local equiv equiv_sim_f (F <: DFUNCTIONALITY{-Gconcl.S, -Simulator}) : RaiseSim(Gconcl_list.SimLast(Gconcl.S),F).f ~ Simulator(F).f @@ -244,7 +240,7 @@ by sp;wp;rcondt{1}1;auto;call(: true);auto;smt(BlockSponge.parseK BlockSponge.fo qed. -local equiv equiv_sim_fi (F <: DFUNCTIONALITY{Gconcl.S, Simulator}) : +local equiv equiv_sim_fi (F <: DFUNCTIONALITY{-Gconcl.S, -Simulator}) : RaiseSim(Gconcl_list.SimLast(Gconcl.S),F).fi ~ Simulator(F).fi @@ -309,14 +305,9 @@ qed. end section. lemma SHA3Indiff - (Dist <: DISTINGUISHER{ - Perm, IRO, BlockSponge.BIRO.IRO, Cntr, Simulator, - Gconcl_list.SimLast(Gconcl.S), BlockSponge.C, Gconcl.S, - SLCommon.F.RO, SLCommon.F.FRO, SLCommon.Redo, SLCommon.C, - Gconcl_list.BIRO2.IRO, Gconcl_list.F2.RO, Gconcl_list.F2.FRO, - Gconcl_list.Simulator}) + (Dist <: DISTINGUISHER{-Perm, -IRO, -BlockSponge.BIRO.IRO, -Cntr, -Simulator, -Gconcl_list.SimLast(Gconcl.S), -BlockSponge.C, -Gconcl.S, -SLCommon.F.RO, -SLCommon.F.FRO, -SLCommon.Redo, -SLCommon.C, -Gconcl_list.BIRO2.IRO, -Gconcl_list.F2.RO, -Gconcl_list.F2.FRO, -Gconcl_list.Simulator}) &m : - (forall (F <: DFUNCTIONALITY { Dist }) (P <: DPRIMITIVE { Dist }), + (forall (F <: DFUNCTIONALITY {-Dist}) (P <: DPRIMITIVE {-Dist}), islossless P.f => islossless P.fi => islossless F.f => diff --git a/proof/SHA3OSecurity.ec b/proof/SHA3OSecurity.ec index 23520fc..eac1490 100644 --- a/proof/SHA3OSecurity.ec +++ b/proof/SHA3OSecurity.ec @@ -189,11 +189,7 @@ import FullEager. section Preimage. - declare module A <: SH.AdvPreimage { Perm, Counter, Bounder, F.RO, F.FRO, - Redo, C, Gconcl.S, BlockSponge.BIRO.IRO, BlockSponge.C, BIRO.IRO, - Gconcl_list.BIRO2.IRO, Gconcl_list.F2.RO, Gconcl_list.F2.FRO, - Gconcl_list.Simulator, SHA3Indiff.Simulator, SHA3Indiff.Cntr, - SORO.Bounder, SORO.RO.RO, RO, FRO }. + declare module A <: SH.AdvPreimage {-Perm, -Counter, -Bounder, -F.RO, -F.FRO, -Redo, -C, -Gconcl.S, -BlockSponge.BIRO.IRO, -BlockSponge.C, -BIRO.IRO, -Gconcl_list.BIRO2.IRO, -Gconcl_list.F2.RO, -Gconcl_list.F2.FRO, -Gconcl_list.Simulator, -SHA3Indiff.Simulator, -SHA3Indiff.Cntr, -SORO.Bounder, -SORO.RO.RO, -RO, -FRO}. local module FInit (F : OIndif.ODFUNCTIONALITY) : OIndif.OFUNCTIONALITY = { proc init () = {} @@ -912,11 +908,7 @@ end section Preimage. section SecondPreimage. - declare module A <: SH.AdvSecondPreimage { Perm, Counter, Bounder, F.RO, - F.FRO, Redo, C, Gconcl.S, BlockSponge.BIRO.IRO, BlockSponge.C, BIRO.IRO, - Gconcl_list.BIRO2.IRO, Gconcl_list.F2.RO, Gconcl_list.F2.FRO, - Gconcl_list.Simulator, SHA3Indiff.Simulator, SHA3Indiff.Cntr, - SORO.Bounder, SORO.RO.RO, SORO.RO.FRO, RO, FRO }. + declare module A <: SH.AdvSecondPreimage {-Perm, -Counter, -Bounder, -F.RO, -F.FRO, -Redo, -C, -Gconcl.S, -BlockSponge.BIRO.IRO, -BlockSponge.C, -BIRO.IRO, -Gconcl_list.BIRO2.IRO, -Gconcl_list.F2.RO, -Gconcl_list.F2.FRO, -Gconcl_list.Simulator, -SHA3Indiff.Simulator, -SHA3Indiff.Cntr, -SORO.Bounder, -SORO.RO.RO, -SORO.RO.FRO, -RO, -FRO}. local module FInit (F : OIndif.ODFUNCTIONALITY) : OIndif.OFUNCTIONALITY = { proc init () = {} @@ -1792,11 +1784,7 @@ end section SecondPreimage. section Collision. - declare module A <: SH.AdvCollision { Perm, Counter, Bounder, F.RO, - F.FRO, Redo, C, Gconcl.S, BlockSponge.BIRO.IRO, BlockSponge.C, BIRO.IRO, - Gconcl_list.BIRO2.IRO, Gconcl_list.F2.RO, Gconcl_list.F2.FRO, - Gconcl_list.Simulator, SHA3Indiff.Simulator, SHA3Indiff.Cntr, - SORO.Bounder, SORO.RO.RO, SORO.RO.FRO, RO, FRO }. + declare module A <: SH.AdvCollision {-Perm, -Counter, -Bounder, -F.RO, -F.FRO, -Redo, -C, -Gconcl.S, -BlockSponge.BIRO.IRO, -BlockSponge.C, -BIRO.IRO, -Gconcl_list.BIRO2.IRO, -Gconcl_list.F2.RO, -Gconcl_list.F2.FRO, -Gconcl_list.Simulator, -SHA3Indiff.Simulator, -SHA3Indiff.Cntr, -SORO.Bounder, -SORO.RO.RO, -SORO.RO.FRO, -RO, -FRO}. local module FInit (F : OIndif.ODFUNCTIONALITY) : OIndif.OFUNCTIONALITY = { proc init () = {} diff --git a/proof/SHA3Security.ec b/proof/SHA3Security.ec index d99c5a8..3aedd21 100644 --- a/proof/SHA3Security.ec +++ b/proof/SHA3Security.ec @@ -124,12 +124,9 @@ module (DSetSize (D : Indiff0.DISTINGUISHER) : DISTINGUISHER) section Preimage. - declare module A <: SRO.AdvPreimage {SRO.RO.RO, SRO.RO.FRO, SRO.Bounder, Perm, - Gconcl_list.BIRO2.IRO, Simulator, Cntr, BIRO.IRO, F.RO, F.FRO, Redo, C, - Gconcl.S, BlockSponge.BIRO.IRO, BlockSponge.C, Gconcl_list.F2.RO, - Gconcl_list.F2.FRO, Gconcl_list.Simulator, DPre}. + declare module A <: SRO.AdvPreimage {-SRO.RO.RO, -SRO.RO.FRO, -SRO.Bounder, -Perm, -Gconcl_list.BIRO2.IRO, -Simulator, -Cntr, -BIRO.IRO, -F.RO, -F.FRO, -Redo, -C, -Gconcl.S, -BlockSponge.BIRO.IRO, -BlockSponge.C, -Gconcl_list.F2.RO, -Gconcl_list.F2.FRO, -Gconcl_list.Simulator, -DPre}. - declare axiom A_ll (F <: SRO.Oracle { A }) : islossless F.get => islossless A(F).guess. + declare axiom A_ll (F <: SRO.Oracle {-A}) : islossless F.get => islossless A(F).guess. local lemma invm_dom_rng (m mi : (state, state) fmap) : invm m mi => dom m = rng mi. @@ -272,7 +269,7 @@ section Preimage. by apply eq_in_map=> j;rewrite mem_range=>[][]hj1 hj2/=; rewrite H4//=h1//=. by move=><<-; rewrite get_set_eqE//=. alias{1} 1 l = [<:bool>]. - transitivity{1} { + transitivity {1} { l <@ Sample.sample(size_out); r <- oget (of_list l); } @@ -481,12 +478,9 @@ end section Preimage. section SecondPreimage. - declare module A <: SRO.AdvSecondPreimage {SRO.RO.RO, SRO.RO.FRO, SRO.Bounder, Perm, - Gconcl_list.BIRO2.IRO, Simulator, Cntr, BIRO.IRO, F.RO, F.FRO, Redo, C, - Gconcl.S, BlockSponge.BIRO.IRO, BlockSponge.C, Gconcl_list.F2.RO, - Gconcl_list.F2.FRO, Gconcl_list.Simulator, D2Pre}. + declare module A <: SRO.AdvSecondPreimage {-SRO.RO.RO, -SRO.RO.FRO, -SRO.Bounder, -Perm, -Gconcl_list.BIRO2.IRO, -Simulator, -Cntr, -BIRO.IRO, -F.RO, -F.FRO, -Redo, -C, -Gconcl.S, -BlockSponge.BIRO.IRO, -BlockSponge.C, -Gconcl_list.F2.RO, -Gconcl_list.F2.FRO, -Gconcl_list.Simulator, -D2Pre}. - declare axiom A_ll (F <: SRO.Oracle { A }) : islossless F.get => islossless A(F).guess. + declare axiom A_ll (F <: SRO.Oracle {-A}) : islossless F.get => islossless A(F).guess. local lemma invm_dom_rng (m mi : (state, state) fmap) : invm m mi => dom m = rng mi. @@ -619,7 +613,7 @@ section SecondPreimage. by apply eq_in_map=> j;rewrite mem_range=>[][]hj1 hj2/=; rewrite H4//=h1//=. by move=><<-; rewrite get_set_eqE//=. alias{1} 1 l = [<:bool>]. - transitivity{1} { + transitivity {1} { l <@ Sample.sample(size_out); r <- oget (of_list l); } @@ -874,12 +868,9 @@ end section SecondPreimage. section Collision. - declare module A <: SRO.AdvCollision {SRO.RO.RO, SRO.RO.FRO, SRO.Bounder, Perm, - Gconcl_list.BIRO2.IRO, Simulator, Cntr, BIRO.IRO, F.RO, F.FRO, Redo, C, - Gconcl.S, BlockSponge.BIRO.IRO, BlockSponge.C, Gconcl_list.F2.RO, - Gconcl_list.F2.FRO, Gconcl_list.Simulator}. + declare module A <: SRO.AdvCollision {-SRO.RO.RO, -SRO.RO.FRO, -SRO.Bounder, -Perm, -Gconcl_list.BIRO2.IRO, -Simulator, -Cntr, -BIRO.IRO, -F.RO, -F.FRO, -Redo, -C, -Gconcl.S, -BlockSponge.BIRO.IRO, -BlockSponge.C, -Gconcl_list.F2.RO, -Gconcl_list.F2.FRO, -Gconcl_list.Simulator}. - declare axiom A_ll (F <: SRO.Oracle { A }) : islossless F.get => islossless A(F).guess. + declare axiom A_ll (F <: SRO.Oracle {-A}) : islossless F.get => islossless A(F).guess. local lemma invm_dom_rng (m mi : (state, state) fmap) : invm m mi => dom m = rng mi. @@ -1011,7 +1002,7 @@ section Collision. by apply eq_in_map=> j;rewrite mem_range=>[][]hj1 hj2/=; rewrite H4//=h1//=. by move=><<-; rewrite get_set_eqE//=. alias{1} 1 l = [<:bool>]. - transitivity{1} { + transitivity {1} { l <@ Sample.sample(size_out); r <- oget (of_list l); } @@ -1265,12 +1256,9 @@ module AdvCollisionSHA3 (A : SRO.AdvCollision) (F : SRO.Oracle) = { section SHA3_Collision. - declare module A <: SRO.AdvCollision {SRO.RO.RO, SRO.RO.FRO, SRO.Bounder, Perm, - Gconcl_list.BIRO2.IRO, Simulator, Cntr, BIRO.IRO, F.RO, F.FRO, Redo, C, - Gconcl.S, BlockSponge.BIRO.IRO, BlockSponge.C, Gconcl_list.F2.RO, - Gconcl_list.F2.FRO, Gconcl_list.Simulator}. + declare module A <: SRO.AdvCollision {-SRO.RO.RO, -SRO.RO.FRO, -SRO.Bounder, -Perm, -Gconcl_list.BIRO2.IRO, -Simulator, -Cntr, -BIRO.IRO, -F.RO, -F.FRO, -Redo, -C, -Gconcl.S, -BlockSponge.BIRO.IRO, -BlockSponge.C, -Gconcl_list.F2.RO, -Gconcl_list.F2.FRO, -Gconcl_list.Simulator}. - declare axiom A_ll (F <: SRO.Oracle { A }) : islossless F.get => islossless A(F).guess. + declare axiom A_ll (F <: SRO.Oracle {-A}) : islossless F.get => islossless A(F).guess. lemma SHA3_coll_resistant &m : Pr[SRO.Collision(AdvCollisionSHA3(A), FM(CSetSize(Sponge), Perm)).main() @ &m : res] <= diff --git a/proof/SHA3_OIndiff.ec b/proof/SHA3_OIndiff.ec index f031292..c046d8b 100644 --- a/proof/SHA3_OIndiff.ec +++ b/proof/SHA3_OIndiff.ec @@ -169,11 +169,7 @@ module ODRestr (D : ODISTINGUISHER) (F : ODFUNCTIONALITY) (P : ODPRIMITIVE) = { section. declare module Dist <: - ODISTINGUISHER {Perm, Gconcl_list.SimLast, IRO, Cntr, BlockSponge.BIRO.IRO, - Simulator, BlockSponge.C, Gconcl.S, - SLCommon.F.RO, SLCommon.F.FRO, SLCommon.Redo, SLCommon.C, - Gconcl_list.BIRO2.IRO, Gconcl_list.F2.RO, Gconcl_list.F2.FRO, - Gconcl_list.Simulator}. + ODISTINGUISHER {-Perm, -Gconcl_list.SimLast, -IRO, -Cntr, -BlockSponge.BIRO.IRO, -Simulator, -BlockSponge.C, -Gconcl.S, -SLCommon.F.RO, -SLCommon.F.FRO, -SLCommon.Redo, -SLCommon.C, -Gconcl_list.BIRO2.IRO, -Gconcl_list.F2.RO, -Gconcl_list.F2.FRO, -Gconcl_list.Simulator}. local module DFSome (F : DFUNCTIONALITY) : ODFUNCTIONALITY = { @@ -207,12 +203,7 @@ local module (OD (D : ODISTINGUISHER) : DISTINGUISHER) (F : DFUNCTIONALITY) (P : }. lemma SHA3OIndiff - (Dist <: ODISTINGUISHER{ - Counter, Perm, IRO, BlockSponge.BIRO.IRO, Cntr, Simulator, - Gconcl_list.SimLast(Gconcl.S), BlockSponge.C, Gconcl.S, - SLCommon.F.RO, SLCommon.F.FRO, SLCommon.Redo, SLCommon.C, - Gconcl_list.BIRO2.IRO, Gconcl_list.F2.RO, Gconcl_list.F2.FRO, - Gconcl_list.Simulator, OSimulator}) + (Dist <: ODISTINGUISHER{-Counter, -Perm, -IRO, -BlockSponge.BIRO.IRO, -Cntr, -Simulator, -Gconcl_list.SimLast(Gconcl.S), -BlockSponge.C, -Gconcl.S, -SLCommon.F.RO, -SLCommon.F.FRO, -SLCommon.Redo, -SLCommon.C, -Gconcl_list.BIRO2.IRO, -Gconcl_list.F2.RO, -Gconcl_list.F2.FRO, -Gconcl_list.Simulator, -OSimulator}) &m : (forall (F <: ODFUNCTIONALITY) (P <: ODPRIMITIVE), islossless P.f => diff --git a/proof/SecureORO.eca b/proof/SecureORO.eca index 78cc3b1..ee3a014 100644 --- a/proof/SecureORO.eca +++ b/proof/SecureORO.eca @@ -81,7 +81,7 @@ module Preimage (A : AdvPreimage, F : RF) = { section Preimage. - declare module A <: AdvPreimage {RO,Preimage}. + declare module A <: AdvPreimage {-RO, -Preimage}. local module FEL (A : AdvPreimage, F : RF) = { proc main (hash : to) : from = { @@ -201,7 +201,7 @@ module SecondPreimage (A : AdvSecondPreimage, F : RF) = { section SecondPreimage. - declare module A <: AdvSecondPreimage {Bounder,RO,FRO}. + declare module A <: AdvSecondPreimage {-Bounder, -RO, -FRO}. local module FEL (A : AdvSecondPreimage, F : RF) = { proc main (m1 : from) : from = { @@ -364,7 +364,7 @@ module Collision (A : AdvCollision, F : RF) = { section Collision. - declare module A <: AdvCollision {RO, FRO, Bounder}. + declare module A <: AdvCollision {-RO, -FRO, -Bounder}. local module FEL (A : AdvCollision, F : RF) = { proc main () : from * from = { diff --git a/proof/SecureRO.eca b/proof/SecureRO.eca index 763a27e..c7df62a 100644 --- a/proof/SecureRO.eca +++ b/proof/SecureRO.eca @@ -86,7 +86,7 @@ module Preimage (A : AdvPreimage, F : RF) = { section Preimage. - declare module A <: AdvPreimage {RO,Preimage}. + declare module A <: AdvPreimage {-RO, -Preimage}. local module FEL (A : AdvPreimage, F : RF) = { proc main (hash : to) : from = { @@ -212,7 +212,7 @@ module SecondPreimage (A : AdvSecondPreimage, F : RF) = { section SecondPreimage. - declare module A <: AdvSecondPreimage {Bounder,RO,FRO}. + declare module A <: AdvSecondPreimage {-Bounder, -RO, -FRO}. local module FEL (A : AdvSecondPreimage, F : RO) = { proc main (m1 : from) : from = { @@ -392,7 +392,7 @@ module Collision (A : AdvCollision, F : RO) = { section Collision. - declare module A <: AdvCollision {RO, FRO, Bounder}. + declare module A <: AdvCollision {-RO, -FRO, -Bounder}. local module FEL (A : AdvCollision, F : RO) = { proc main () : from * from = { diff --git a/proof/Sponge.ec b/proof/Sponge.ec index 11b6352..7ad47bb 100644 --- a/proof/Sponge.ec +++ b/proof/Sponge.ec @@ -161,8 +161,8 @@ module RaiseSim (S : BlockSponge.SIMULATOR, F : DFUNCTIONALITY) = (* Our main result will be: lemma conclusion - (BlockSim <: BlockSponge.SIMULATOR{IRO, BlockSponge.BIRO.IRO}) - (Dist <: DISTINGUISHER{Perm, BlockSim, IRO, BlockSponge.BIRO.IRO}) + (BlockSim <: BlockSponge.SIMULATOR{-IRO, -BlockSponge.BIRO.IRO}) + (Dist <: DISTINGUISHER{-Perm, -BlockSim, -IRO, -BlockSponge.BIRO.IRO}) &m : `|Pr[RealIndif(Sponge, Perm, Dist).main() @ &m : res] - Pr[IdealIndif(IRO, RaiseSim(BlockSim), Dist).main() @ &m : res]| = @@ -359,14 +359,14 @@ module HybridIROEager : HYBRID_IRO = { (* we are going to use PROM.GenEager to prove: lemma HybridIROExper_Lazy_Eager - (D <: HYBRID_IRO_DIST{HybridIROEager, HybridIROLazy}) &m : + (D <: HYBRID_IRO_DIST{-HybridIROEager, -HybridIROLazy}) &m : Pr[HybridIROExper(HybridIROLazy, D).main() @ &m : res] = Pr[HybridIROExper(HybridIROEager, D).main() @ &m : res]. *) section. -declare module D <: HYBRID_IRO_DIST {HybridIROEager, HybridIROLazy}. +declare module D <: HYBRID_IRO_DIST {-HybridIROEager, -HybridIROLazy}. local clone import PROM.FullRO as ERO with type in_t <- block list * int, @@ -384,7 +384,7 @@ local module EROExper(O : ERO.RO, D : ERO.RO_Distinguisher) = { } }. -local lemma LRO_RO (D <: ERO.RO_Distinguisher{ERO.RO, ERO.FRO}) &m : +local lemma LRO_RO (D <: ERO.RO_Distinguisher{-ERO.RO, -ERO.FRO}) &m : Pr[EROExper(LRO, D).main() @ &m : res] = Pr[EROExper(ERO.RO, D).main() @ &m : res]. proof. @@ -542,7 +542,7 @@ qed. end section. lemma HybridIROExper_Lazy_Eager - (D <: HYBRID_IRO_DIST{HybridIROEager, HybridIROLazy}) &m : + (D <: HYBRID_IRO_DIST{-HybridIROEager, -HybridIROLazy}) &m : Pr[HybridIROExper(HybridIROLazy, D).main() @ &m : res] = Pr[HybridIROExper(HybridIROEager, D).main() @ &m : res]. proof. by apply (HybridIROExper_Lazy_Eager' D &m). qed. @@ -1912,8 +1912,8 @@ end HybridIRO. section. -declare module BlockSim <: BlockSponge.SIMULATOR {IRO, BlockSponge.BIRO.IRO}. -declare module Dist <: DISTINGUISHER {Perm, BlockSim, IRO, BlockSponge.BIRO.IRO}. +declare module BlockSim <: BlockSponge.SIMULATOR {-IRO, -BlockSponge.BIRO.IRO}. +declare module Dist <: DISTINGUISHER {-Perm, -BlockSim, -IRO, -BlockSponge.BIRO.IRO}. local clone HybridIRO as HIRO. @@ -1950,7 +1950,6 @@ auto. qed. (* the Real side of main result *) - local lemma RealIndif_Sponge_BlockSponge &m : Pr[RealIndif(Sponge, Perm, Dist).main() @ &m : res] = Pr[BlockSponge.RealIndif @@ -2152,8 +2151,8 @@ end section. (*----------------------------- Conclusion -----------------------------*) lemma conclusion - (BlockSim <: BlockSponge.SIMULATOR{IRO, BlockSponge.BIRO.IRO}) - (Dist <: DISTINGUISHER{Perm, BlockSim, IRO, BlockSponge.BIRO.IRO}) + (BlockSim <: BlockSponge.SIMULATOR{-IRO, -BlockSponge.BIRO.IRO}) + (Dist <: DISTINGUISHER{-Perm, -BlockSim, -IRO, -BlockSponge.BIRO.IRO}) &m : `|Pr[RealIndif(Sponge, Perm, Dist).main() @ &m : res] - Pr[IdealIndif(IRO, RaiseSim(BlockSim), Dist).main() @ &m : res]| = diff --git a/proof/smart_counter/ConcreteF.eca b/proof/smart_counter/ConcreteF.eca index 18b0358..425198c 100644 --- a/proof/smart_counter/ConcreteF.eca +++ b/proof/smart_counter/ConcreteF.eca @@ -42,9 +42,9 @@ module PF = { module CF(D:DISTINGUISHER) = Indif(SqueezelessSponge(PF), PF, D). section. - declare module D <: DISTINGUISHER {Perm, C, PF, Redo}. + declare module D <: DISTINGUISHER {-Perm, -C, -PF, -Redo}. - declare axiom D_ll (F <: DFUNCTIONALITY{D}) (P <: DPRIMITIVE{D}): + declare axiom D_ll (F <: DFUNCTIONALITY{-D}) (P <: DPRIMITIVE{-D}): islossless P.f => islossless P.fi => islossless F.f => islossless D(F, P).distinguish. @@ -81,12 +81,11 @@ section. proc distinguish () : bool = { var b : bool; Redo.init(); - b <@ DRestr(D,SqueezelessSponge(P'),P').distinguish(); - return b; - } + b <@ DRestr(D, SqueezelessSponge(P'), P').distinguish(); + return b;} }. - local lemma DoubleBounding (P <: PRPSec.PRP {D, C, DBounder, Redo}) &m: + local lemma DoubleBounding (P <: PRPSec.PRP {-D, -C, -DBounder, -Redo}) &m: Pr[PRPSec.IND(P,D').main() @ &m: res] = Pr[PRPSec.IND(P,DBounder(D')).main() @ &m: res]. proof. @@ -270,7 +269,7 @@ section. by rewrite -H4; move: (H3 _ H9 (size bs0)); rewrite take_size //= H. * smt(mem_set take_size oget_some get_setE domE take_oversize take_le0). * elim: (H6 _ H10). - + elim: H=> _; rewrite andaE=> [#] _ /(_ bs0 i0 H9) h /h [l2] hl2. + + elim: H=> /> _ _ /(_ bs0 i0 H9) h /h [] l2 hl2. by exists l2; rewrite mem_set hl2. by move=> [j] [] hj ->; exists (drop j bs{2}); rewrite cat_take_drop mem_set. * smt(mem_set take_size oget_some get_setE domE take_oversize take_le0 take_take cat_take_drop). diff --git a/proof/smart_counter/Gcol.eca b/proof/smart_counter/Gcol.eca index 511eab0..a025edf 100644 --- a/proof/smart_counter/Gcol.eca +++ b/proof/smart_counter/Gcol.eca @@ -24,9 +24,9 @@ import ROhandle. qed. section PROOF. - declare module D <: DISTINGUISHER{C, PF, G1}. + declare module D <: DISTINGUISHER{-C, -PF, -G1}. - declare axiom D_ll (F <: DFUNCTIONALITY{D}) (P <: DPRIMITIVE{D}): + declare axiom D_ll (F <: DFUNCTIONALITY{-D}) (P <: DPRIMITIVE{-D}): islossless P.f => islossless P.fi => islossless F.f => islossless D(F, P).distinguish. diff --git a/proof/smart_counter/Gconcl.ec b/proof/smart_counter/Gconcl.ec index 557f6c5..f114324 100644 --- a/proof/smart_counter/Gconcl.ec +++ b/proof/smart_counter/Gconcl.ec @@ -27,9 +27,8 @@ module S(F : DFUNCTIONALITY) = { if (x \notin m) { if (x.`2 \in paths) { - (p,v) <- oget paths.[x.`2]; - y1 <@ F.f (rcons p (v +^ x.`1)); - } else { + (p, v) <- oget paths.[x.`2]; + y1 <@ F.f (rcons p (v +^ x.`1));} else { y1 <$ bdistr; } y2 <$ cdistr; @@ -65,7 +64,7 @@ module S(F : DFUNCTIONALITY) = { section. -declare module D <: DISTINGUISHER{C, Perm, F.RO, F.FRO, S, Redo}. +declare module D <: DISTINGUISHER{-C, -Perm, -F.RO, -F.FRO, -S, -Redo}. local clone import Gext as Gext0. @@ -362,7 +361,7 @@ proof. qed. declare axiom D_ll : - forall (F <: DFUNCTIONALITY{D}) (P <: DPRIMITIVE{D}), + forall (F <: DFUNCTIONALITY{-D}) (P <: DPRIMITIVE{-D}), islossless P.f => islossless P.fi => islossless F.f => islossless D(F, P).distinguish. diff --git a/proof/smart_counter/Gconcl_list.ec b/proof/smart_counter/Gconcl_list.ec index 83c146d..a9235b8 100644 --- a/proof/smart_counter/Gconcl_list.ec +++ b/proof/smart_counter/Gconcl_list.ec @@ -174,7 +174,7 @@ section Ideal. m1.[x <- y] <= m2.[x <- y] by smt(domE get_setE mem_set in_fsetU1). - local equiv ideal_equiv (D <: DISTINGUISHER{SLCommon.C, C, IF, S}) : + local equiv ideal_equiv (D <: DISTINGUISHER{-SLCommon.C, -C, -IF, -S}) : SLCommon.IdealIndif(IF, S, SLCommon.DRestr(A(D))).main ~ SLCommon.IdealIndif(IF, S, A(D)).main @@ -326,7 +326,7 @@ section Ideal. proc distinguish = SLCommon.IdealIndif(Valid2(F), S, A(D)).main }. - local equiv Ideal_equiv_valid (D <: DISTINGUISHER{SLCommon.C, C, IF, S}) : + local equiv Ideal_equiv_valid (D <: DISTINGUISHER{-SLCommon.C, -C, -IF, -S}) : L(D,F.LRO).distinguish ~ L2(D,F.LRO).distinguish @@ -357,7 +357,7 @@ section Ideal. qed. - local equiv ideal_equiv2 (D <: DISTINGUISHER{SLCommon.C, C, IF, S}) : + local equiv ideal_equiv2 (D <: DISTINGUISHER{-SLCommon.C, -C, -IF, -S}) : L2(D,F.RO).distinguish ~ SLCommon.IdealIndif(IF,S,A(D)).main : ={glob D} ==> ={glob D, res}. proof. @@ -468,7 +468,7 @@ section Ideal. qed. - local equiv Ideal_equiv3 (D <: DISTINGUISHER{SLCommon.C, C, IF, S, F2.RO}) : + local equiv Ideal_equiv3 (D <: DISTINGUISHER{-SLCommon.C, -C, -IF, -S, -F2.RO}) : L(D,F.RO).distinguish ~ L3(D,F.RO).distinguish : ={glob D} ==> ={glob D, res}. proof. @@ -657,7 +657,7 @@ section Ideal. proc distinguish = IdealIndif(DSqueeze2(F,F2),S2,DValid(DRestr(D))).main }. - local equiv equiv_L3_L4 (D <: DISTINGUISHER{SLCommon.C, C, IF, S, F2.RO, BIRO.IRO, BIRO2.IRO}) : + local equiv equiv_L3_L4 (D <: DISTINGUISHER{-SLCommon.C, -C, -IF, -S, -F2.RO, -BIRO.IRO, -BIRO2.IRO}) : L3(D,F.RO).distinguish ~ L4(D,F.RO,F2.RO).distinguish @@ -835,7 +835,7 @@ section Ideal. - local equiv equiv_L4_ideal (D <: DISTINGUISHER{SLCommon.C, C, IF, S, F2.RO, BIRO.IRO, BIRO2.IRO}) : + local equiv equiv_L4_ideal (D <: DISTINGUISHER{-SLCommon.C, -C, -IF, -S, -F2.RO, -BIRO.IRO, -BIRO2.IRO}) : L4(D,F.LRO,F2.LRO).distinguish ~ IdealIndif(BIRO.IRO,SimLast(S),DRestr(D)).main @@ -914,8 +914,7 @@ section Ideal. local module D6 (D : DISTINGUISHER) (F2 : F2.RO) = D(FC(FValid(DSqueeze2(F.LRO, F2))), PC(S(Last(DSqueeze2(F.LRO, F2))))). - lemma equiv_ideal (D <: DISTINGUISHER{SLCommon.C, C, IF, S, - F.FRO, F2.RO, F2.FRO, BIRO.IRO, BIRO2.IRO}) &m: + lemma equiv_ideal (D <: DISTINGUISHER{-SLCommon.C, -C, -IF, -S, -F.FRO, -F2.RO, -F2.FRO, -BIRO.IRO, -BIRO2.IRO}) &m: Pr[SLCommon.IdealIndif(IF,S,SLCommon.DRestr(A(D))).main() @ &m : res] = Pr[IdealIndif(BIRO.IRO,SimLast(S),DRestr(D)).main() @ &m : res]. proof. @@ -1088,7 +1087,7 @@ section Real. qed. - local lemma equiv_sponge (D <: DISTINGUISHER {P, Redo, C, SLCommon.C}) : + local lemma equiv_sponge (D <: DISTINGUISHER {-P, -Redo, -C, -SLCommon.C}) : equiv [ GReal(A(D)).main ~ NIndif(Squeeze(SqueezelessSponge(P)),P,DRestr(D)).main : ={glob D} ==> ={res, glob D, glob P, C.c} /\ SLCommon.C.c{1} <= C.c{2} <= max_size]. @@ -1469,7 +1468,7 @@ section Real. - local lemma squeeze_squeezeless (D <: DISTINGUISHER {P, Redo, C, SLCommon.C}) : + local lemma squeeze_squeezeless (D <: DISTINGUISHER {-P, -Redo, -C, -SLCommon.C}) : equiv [ NIndif(Squeeze(SqueezelessSponge(P)),P,DRestr(D)).main ~ RealIndif(Sponge,P,DRestr(D)).main : ={glob D} ==> ={res, glob P, glob D, C.c} /\ C.c{1} <= max_size]. @@ -1724,7 +1723,7 @@ section Real. - lemma pr_real (D <: DISTINGUISHER{SLCommon.C, C, Perm, Redo}) &m : + lemma pr_real (D <: DISTINGUISHER{-SLCommon.C, -C, -Perm, -Redo}) &m : Pr [ GReal(A(D)).main() @ &m : res /\ SLCommon.C.c <= max_size] = Pr [ RealIndif(Sponge,P,DRestr(D)).main() @ &m : res]. proof. @@ -1739,15 +1738,15 @@ end section Real. section Real_Ideal. (* REAL & IDEAL *) - declare module D <: DISTINGUISHER {SLCommon.C, C, Perm, Redo, F.RO, F.FRO, S, BIRO.IRO, BIRO2.IRO, F2.RO, F2.FRO}. + declare module D <: DISTINGUISHER {-SLCommon.C, -C, -Perm, -Redo, -F.RO, -F.FRO, -S, -BIRO.IRO, -BIRO2.IRO, -F2.RO, -F2.FRO}. - declare axiom D_lossless (F0 <: DFUNCTIONALITY{D}) (P0 <: DPRIMITIVE{D}) : + declare axiom D_lossless (F0 <: DFUNCTIONALITY{-D}) (P0 <: DPRIMITIVE{-D}) : islossless P0.f => islossless P0.fi => islossless F0.f => islossless D(F0, P0).distinguish. - lemma A_lossless (F <: SLCommon.DFUNCTIONALITY{A(D)}) - (P0 <: SLCommon.DPRIMITIVE{A(D)}) : + lemma A_lossless (F <: SLCommon.DFUNCTIONALITY{-A(D)}) + (P0 <: SLCommon.DPRIMITIVE{-A(D)}) : islossless P0.f => islossless P0.fi => islossless F.f => islossless A(D, F, P0).distinguish. proof. @@ -1785,9 +1784,9 @@ require import AdvAbsVal. section Real_Ideal_Abs. - declare module D <: DISTINGUISHER {SLCommon.C, C, Perm, Redo, F.RO, F.FRO, S, BIRO.IRO, BIRO2.IRO, F2.RO, F2.FRO}. + declare module D <: DISTINGUISHER {-SLCommon.C, -C, -Perm, -Redo, -F.RO, -F.FRO, -S, -BIRO.IRO, -BIRO2.IRO, -F2.RO, -F2.FRO}. - declare axiom D_lossless (F0 <: DFUNCTIONALITY{D}) (P0 <: DPRIMITIVE{D}) : + declare axiom D_lossless (F0 <: DFUNCTIONALITY{-D}) (P0 <: DPRIMITIVE{-D}) : islossless P0.f => islossless P0.fi => islossless F0.f => islossless D(F0, P0).distinguish. @@ -1801,7 +1800,7 @@ section Real_Ideal_Abs. }. - local lemma Neg_D_lossless (F <: DFUNCTIONALITY{Neg_D(D)}) (P <: DPRIMITIVE{Neg_D(D)}) : + local lemma Neg_D_lossless (F <: DFUNCTIONALITY{-Neg_D(D)}) (P <: DPRIMITIVE{-Neg_D(D)}) : islossless P.f => islossless P.fi => islossless F.f => islossless Neg_D(D, F, P).distinguish. proof. @@ -1986,9 +1985,9 @@ module Simulator (F : DFUNCTIONALITY) = { section Simplify_Simulator. -declare module D <: DISTINGUISHER {Simulator, F.RO, BIRO.IRO, C, S, BIRO2.IRO}. +declare module D <: DISTINGUISHER {-Simulator, -F.RO, -BIRO.IRO, -C, -S, -BIRO2.IRO}. -declare axiom D_lossless (F0 <: DFUNCTIONALITY{D}) (P0 <: DPRIMITIVE{D}) : +declare axiom D_lossless (F0 <: DFUNCTIONALITY{-D}) (P0 <: DPRIMITIVE{-D}) : islossless P0.f => islossless P0.fi => islossless F0.f => islossless D(F0, P0).distinguish. @@ -2179,9 +2178,9 @@ end section Simplify_Simulator. section Real_Ideal. - declare module D <: DISTINGUISHER {SLCommon.C, C, Perm, Redo, F.RO, F.FRO, S, BIRO.IRO, BIRO2.IRO, F2.RO, F2.FRO, Simulator}. + declare module D <: DISTINGUISHER {-SLCommon.C, -C, -Perm, -Redo, -F.RO, -F.FRO, -S, -BIRO.IRO, -BIRO2.IRO, -F2.RO, -F2.FRO, -Simulator}. - declare axiom D_lossless (F0 <: DFUNCTIONALITY{D}) (P0 <: DPRIMITIVE{D}) : + declare axiom D_lossless (F0 <: DFUNCTIONALITY{-D}) (P0 <: DPRIMITIVE{-D}) : islossless P0.f => islossless P0.fi => islossless F0.f => islossless D(F0, P0).distinguish. diff --git a/proof/smart_counter/Gext.eca b/proof/smart_counter/Gext.eca index 8787e44..43187e4 100644 --- a/proof/smart_counter/Gext.eca +++ b/proof/smart_counter/Gext.eca @@ -157,7 +157,7 @@ clone include EagerCore proof * by (move=> _; exact/Capacity.DCapacity.dunifin_ll). section. - declare module D <: DISTINGUISHER{G1, G2, FRO, C}. + declare module D <: DISTINGUISHER{-G1, -G2, -FRO, -C}. op inv_ext (m mi:smap) (FROm:handles) = exists x h, mem (fdom m `|` fdom mi) x /\ FROm.[h] = Some (x.`2, Unknown). @@ -315,7 +315,7 @@ end section. section EXT. - declare module D <: DISTINGUISHER{C, PF, G1, G2, Perm, RO, Redo}. + declare module D <: DISTINGUISHER{-C, -PF, -G1, -G2, -Perm, -RO, -Redo}. local module ReSample = { var count:int @@ -536,7 +536,7 @@ section EXT. proof. by rewrite fdom0 fcards0. qed. local equiv RROset_inv_lt : RRO.set ~ RRO.set : - ={x,y,FRO.m} /\ inv_lt G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2} ==> + ={x, y, FRO.m} /\ inv_lt G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2} ==> ={res,FRO.m} /\ inv_lt G1.m{2} G1.mi{2} C.c{1} FRO.m{2} ReSample.count{2}. proof. proc;auto=> &ml&mr[#]3!-> /= @/inv_lt [*]. @@ -694,7 +694,7 @@ section EXT. qed. declare axiom D_ll: - forall (F <: DFUNCTIONALITY{D}) (P <: DPRIMITIVE{D}), + forall (F <: DFUNCTIONALITY{-D}) (P <: DPRIMITIVE{-D}), islossless P.f => islossless P.fi => islossless F.f => islossless D(F, P).distinguish. lemma Real_G2 &m: diff --git a/proof/smart_counter/Handle.eca b/proof/smart_counter/Handle.eca index a56c533..ab1bf00 100644 --- a/proof/smart_counter/Handle.eca +++ b/proof/smart_counter/Handle.eca @@ -499,7 +499,7 @@ split=> [xa0 xc0 ya0 yc0|xa0 hx0 ya0 hy0]; rewrite get_setE. by exists hx0 fx0 hy0 fy0; rewrite !get_setE /#. case: ((xa0,hx0) = (xa,hx))=> [[#] <*>> [#] <<*>|] /=. + by exists xc f yc f'; rewrite !get_setE /= /#. -move=>/= /negb_and xahx0_neq_xahx /Hmh_m [xc0 fx0 yc0 fy0] [#] hs_hx0 hs_hy0 Pm_xaxc0. +move=> /= /negb_and xahx0_neq_xahx /Hmh_m [xc0 fx0 yc0 fy0] [#] hs_hx0 hs_hy0 Pm_xaxc0. exists xc0 fx0 yc0 fy0; rewrite !get_setE; do !split=> [/#|/#|/=]. move: xahx0_neq_xahx; case: (xa0 = xa)=> [/= <*>>|//=]; case: (xc0 = xc)=> [<*>>|//=]. by move: hs_hx=> /(Hhuniq _ _ _ _ hs_hx0). @@ -1273,7 +1273,7 @@ proof. rewrite get_setE /=;case (h' = ch) => [->> | ]. + by rewrite (@eq_sym ch) Hha /= => _ /Hch. case (v' +^ x = xa /\ h' = ha) => [[!<<-] /= ?? [!->>] /=| ]. - + by exists p v';rewrite xorwA xorwK xorwC xorw0. + + by exists p v'; rewrite xorwA xorwK xorwC xorw0. case (hx = ch)=> [->> |??? Hbu Hg]. + by move=> ??? /= /Hch. by rewrite build_hpath_prefix;exists v' h';smt(). @@ -1346,7 +1346,7 @@ qed. (* we should do a lemma to have the equivalence *) -equiv eq_fi (D <: DISTINGUISHER {PF, RO, G1}): DPRestr(PF).fi ~ DPRestr(G1(DRestr(D)).S).fi: +equiv eq_fi (D <: DISTINGUISHER {-PF, -RO, -G1}): DPRestr(PF).fi ~ DPRestr(G1(DRestr(D)).S).fi: !G1.bcol{2} /\ !G1.bext{2} /\ ={arg} /\ ={glob C} @@ -1485,7 +1485,7 @@ by move=> /> &1 &2 -> ->. qed. -equiv eq_f (D <: DISTINGUISHER {PF, RO, G1}): DPRestr(PF).f ~ DPRestr(G1(DRestr(D)).S).f: +equiv eq_f (D <: DISTINGUISHER {-PF, -RO, -G1}): DPRestr(PF).f ~ DPRestr(G1(DRestr(D)).S).f: !G1.bcol{2} /\ !G1.bext{2} /\ ={x} /\ ={glob C} @@ -1700,8 +1700,8 @@ call(: !G1.bcol{2} + by apply incl_addm. + by apply incl_addm. + split. + move=> xa hx ya hy;rewrite get_setE;case ((xa, hx) = (x1, hx2))=> /=. - + move=> [] !-> [] !<-; exists x2 Known y2L Known. - by rewrite !get_set_sameE /= get_set_neqE // eq_sym; apply (dom_hs_neq_ch _ _ _ Hhs hs_hx2). + + move=> [] !->> [] !<<-; exists x2 Known y2L Known. + by rewrite /= !get_set_sameE /= get_set_neqE. move=> Hdiff Hxa; case Hmh=> /(_ _ _ _ _ Hxa) [] xc fx yc fy [#] Hhx Hhy HG1 _ _. exists xc fx yc fy;rewrite !get_set_neqE //. + by apply (dom_hs_neq_ch _ _ _ Hhs Hhx). @@ -2421,7 +2421,7 @@ proof. have:=hh3 _ _ _ _ _ H_path h_build_hpath_p0. have->:bn = sa{2} +^ sa{2} +^ bn;smt(@Block). move=>help;have h_neq:! (v +^ bn = sa{2} +^ nth witness bs{1} i{2} /\ hx = h{2}) by rewrite/#. - move:help. rewrite h_neq/==>h_g1_v_bn_hx. + move: help. rewrite h_neq/==>h_g1_v_bn_hx. have[]hh1 hh2 hh3:=H_mh_spec. have:=build_hpath_upd_ch_iff h{2} G1.chandle{2} G1.mh{2} (sa{2} +^ nth witness bs{1} i{2}) y1L p0 v hx. rewrite h_build_hpath_set/=h_g1/=. @@ -2561,9 +2561,9 @@ qed. section AUX. - declare module D <: DISTINGUISHER {PF, RO, G1, Redo, C}. + declare module D <: DISTINGUISHER {-PF, -RO, -G1, -Redo, -C}. - declare axiom D_ll (F <: DFUNCTIONALITY{D}) (P <: DPRIMITIVE{D}): + declare axiom D_ll (F <: DFUNCTIONALITY{-D}) (P <: DPRIMITIVE{-D}): islossless P.f => islossless P.fi => islossless F.f => islossless D(F, P).distinguish. @@ -2669,9 +2669,9 @@ end section AUX. section. - declare module D <: DISTINGUISHER{Perm, C, PF, G1, RO, Redo}. + declare module D <: DISTINGUISHER{-Perm, -C, -PF, -G1, -RO, -Redo}. - declare axiom D_ll (F <: DFUNCTIONALITY{D}) (P <: DPRIMITIVE{D}): + declare axiom D_ll (F <: DFUNCTIONALITY{-D}) (P <: DPRIMITIVE{-D}): islossless P.f => islossless P.fi => islossless F.f => islossless D(F, P).distinguish. diff --git a/proof/smart_counter/SLCommon.ec b/proof/smart_counter/SLCommon.ec index 9d4d596..fa82181 100644 --- a/proof/smart_counter/SLCommon.ec +++ b/proof/smart_counter/SLCommon.ec @@ -929,20 +929,20 @@ module DRestr(D:DISTINGUISHER, F:DFUNCTIONALITY, P:DPRIMITIVE) = { } }. -lemma rp_ll (P<:DPRIMITIVE{C}): islossless P.f => islossless DPRestr(P).f. +lemma rp_ll (P<:DPRIMITIVE{-C}): islossless P.f => islossless DPRestr(P).f. proof. move=>Hll;proc;sp;if;auto;call Hll;auto. qed. -lemma rpi_ll (P<:DPRIMITIVE{C}): islossless P.fi => islossless DPRestr(P).fi. +lemma rpi_ll (P<:DPRIMITIVE{-C}): islossless P.fi => islossless DPRestr(P).fi. proof. move=>Hll;proc;sp;if;auto;call Hll;auto. qed. -lemma rf_ll (F<:DFUNCTIONALITY{C}): islossless F.f => islossless DFRestr(F).f. +lemma rf_ll (F<:DFUNCTIONALITY{-C}): islossless F.f => islossless DFRestr(F).f. proof. move=>Hll;proc;sp;if;auto;if=>//;auto;call Hll;auto. qed. -lemma DRestr_ll (D<:DISTINGUISHER{C}): - (forall (F<:DFUNCTIONALITY{D})(P<:DPRIMITIVE{D}), +lemma DRestr_ll (D<:DISTINGUISHER{-C}): + (forall (F<:DFUNCTIONALITY{-D})(P<:DPRIMITIVE{-D}), islossless P.f => islossless P.fi => islossless F.f => islossless D(F,P).distinguish) => - forall (F <: DFUNCTIONALITY{DRestr(D)}) (P <: DPRIMITIVE{DRestr(D)}), + forall (F <: DFUNCTIONALITY{-DRestr(D)}) (P <: DPRIMITIVE{-DRestr(D)}), islossless P.f => islossless P.fi => islossless F.f => islossless DRestr(D, F, P).distinguish. proof. @@ -954,9 +954,9 @@ qed. section RESTR. - declare module F <: FUNCTIONALITY{C}. - declare module P <: PRIMITIVE{C,F}. - declare module D <: DISTINGUISHER{F,P,C}. + declare module F <: FUNCTIONALITY{-C}. + declare module P <: PRIMITIVE{-C, -F}. + declare module D <: DISTINGUISHER{-F, -P, -C}. lemma swap_restr &m: Pr[Indif(FRestr(F), PRestr(P), D).main()@ &m: res] = @@ -971,16 +971,16 @@ end section RESTR. section COUNT. - declare module P <: PRIMITIVE{C}. - declare module CO <: CONSTRUCTION{C,P}. - declare module D <: DISTINGUISHER{C,P,CO}. + declare module P <: PRIMITIVE{-C}. + declare module CO <: CONSTRUCTION{-C, -P}. + declare module D <: DISTINGUISHER{-C, -P, -CO}. declare axiom f_ll : islossless P.f. declare axiom fi_ll : islossless P.fi. declare axiom CO_ll : islossless CO(P).f. - declare axiom D_ll (F <: DFUNCTIONALITY{D}) (P <: DPRIMITIVE{D}): + declare axiom D_ll (F <: DFUNCTIONALITY{-D}) (P <: DPRIMITIVE{-D}): islossless P.f => islossless P.fi => islossless F.f => islossless D(F, P).distinguish. From 3ab0c96ed478f68987939a07725ce2b029117fea Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Fri, 8 Apr 2022 10:24:06 +0100 Subject: [PATCH 519/525] 'stabilise' smt calls post cost merge --- proof/SHA3OSecurity.ec | 263 +++++++++++++++++++++-------------------- proof/SHA3_OIndiff.ec | 9 +- 2 files changed, 143 insertions(+), 129 deletions(-) diff --git a/proof/SHA3OSecurity.ec b/proof/SHA3OSecurity.ec index eac1490..95fa0bc 100644 --- a/proof/SHA3OSecurity.ec +++ b/proof/SHA3OSecurity.ec @@ -446,23 +446,25 @@ if{1}; sp. while(={k, bs, n, x2} /\ i{1} = i0{2} /\ n{1} = size_out /\ 0 <= i{1} <= n{1} /\ size bs{1} = i{1} /\ eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}). - - by sp; if; auto; smt(domE get_setE size_rcons). - by auto; smt(size_eq0 size_out_gt0). + - by sp; if; auto=> />; smt(domE get_setE size_rcons). + by auto=> />; smt(size_eq0 size_out_gt0). rcondt{1} 1; 1: auto. splitwhile{1} 1 : i0 < size_out; auto=> /=. while( (i0, n0, x3){1} = (i, k, x){2} /\ bs0{1} = prefix{2} ++ suffix{2} /\ size_out <= i{2} <= k{2} /\ eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}). -+ by sp; if; auto; smt(domE get_setE size_out_gt0 rcons_cat). ++ sp; if; auto=> />; 1,3:smt(domE rcons_cat). + move=> &1 &2 out_le_i _ ih1 ih2 ih3 i_lt_k xi_notin_mp r _. + by rewrite !get_set_sameE /= rcons_cat //= #smt:(get_setE size_out_gt0). auto=> //=. conseq(:_==> ={i0} /\ size bs{2} = i0{1} /\ (i0, x3){1} = (n, x2){2} /\ bs0{1} = bs{2} /\ size bs{2} = size_out /\ - eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}). -+ smt(cats0 take_oversize spec_dout to_listK spec2_dout). + eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}). ++ move=> />; smt(cats0 take_oversize spec_dout to_listK spec2_dout). while(={i0} /\ x3{1} = x2{2} /\ 0 <= i0{1} <= n{2} /\ n{2} = size_out /\ bs0{1} = bs{2} /\ size bs{2} = i0{1} /\ size_out <= n0{1} /\ eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}). -+ by sp; if; auto; smt(size_rcons domE get_setE size_rcons mem_set). -by auto; smt(size_out_gt0). ++ by sp; if; auto=> />; smt(size_rcons domE get_setE size_rcons mem_set). +by auto=> />; smt(size_out_gt0). qed. @@ -516,7 +518,7 @@ proc; inline*; sp. if{1}; sp. + rcondt{1} 1; auto=> /=/>. conseq(:_==> take k{1} bs{1} = l{2} /\ BIRO.IRO.mp{1} = RO.m{2}). - * smt(). + * by move=> /> /#. case: (0 <= n{2}); last first. + rcondf{2} 1; 1: by auto; smt(). conseq(:_==> BIRO.IRO.mp{1} = RO.m{2} /\ ={i} /\ n{1} = size_out /\ x2{1} = x0{2})=> />. @@ -530,8 +532,8 @@ if{1}; sp. while(={i} /\ n{1} = size_out /\ x2{1} = x0{2} /\ BIRO.IRO.mp{1} = RO.m{2} /\ take k{1} bs{1} = l{2} /\ size bs{1} = i{1} /\ k{1} <= i{1} <= size_out). * sp; if{1}. - - by rcondt{2} 2; auto; smt(dbool_ll cats1 take_cat cats0 take_size size_rcons). - by rcondf{2} 2; auto; smt(dbool_ll cats1 take_cat cats0 take_size size_rcons). + - by rcondt{2} 2; auto=> />; smt(dbool_ll cats1 take_cat cats0 take_size size_rcons). + by rcondf{2} 2; auto=> />; smt(dbool_ll cats1 take_cat cats0 take_size size_rcons). conseq(:_==> ={i} /\ n{1} = size_out /\ x2{1} = x0{2} /\ BIRO.IRO.mp{1} = RO.m{2} /\ bs{1} = l{2} /\ size bs{1} = i{1} /\ k{1} = i{1}). + smt(take_size). @@ -539,12 +541,12 @@ if{1}; sp. 0 <= i{1} <= k{1} <= size_out /\ bs{1} = l{2} /\ size bs{1} = i{1} /\ BIRO.IRO.mp{1} = RO.m{2}). + sp; if{1}. - - by rcondt{2} 2; auto; smt(size_rcons). - by rcondf{2} 2; auto; smt(size_rcons dbool_ll). - by auto; smt(size_ge0 size_out_gt0). + - by rcondt{2} 2; auto=> />; smt(size_rcons). + by rcondf{2} 2; auto=> />; smt(size_rcons dbool_ll). + by auto=> />; smt(size_ge0 size_out_gt0). rcondt{1} 1; auto. rcondf{2} 2; 1: auto. -+ conseq(:_==> i = n); 1: smt(). ++ conseq(:_==> i = n)=> [/> /#|]. by while(i <= n); auto=> />; smt(size_out_gt0). while(i0{1} = i{2} /\ x3{1} = x0{2} /\ n0{1} = n{2} /\ bs0{1} = l{2} /\ BIRO.IRO.mp{1} = RO.m{2}). @@ -601,10 +603,10 @@ have->: - proc; sp; if; auto. inline{1} 1; inline{2} 1; sp; sim; if; 1: auto; sim. if; 1: auto; sim; sp. - if; 1: auto; 1: smt(); sim. + if; [1:by auto=> /> &1 &2 <- /> <- />]; sim. * inline{1} 1; inline{2} 1; sp; sim. - by call eq_eager_ideal; auto; smt(). - smt(). + by call eq_eager_ideal; auto=> /> &1 &2 <- /> <- />. + by move=> /> &1 &2 <- /> <- />. - by proc; inline*; sim. proc; sim. inline{1} 1; inline{2} 1; sp; sim; if; 1: auto; sim. @@ -631,9 +633,9 @@ have->: - proc; sp; if; auto. inline{1} 1; inline{2} 1; sp; sim; if; 1: auto; sim. if; 1: auto; sim; sp. - if; 1: auto; 1: smt(); sim. - * by call eq_eager_ideal2; auto; smt(). - smt(). + if; [1:by auto=> /> &1 &2 <- /> <- />]; sim. + * by call eq_eager_ideal2; auto=> /> &1 &2 <- /> <- />. + by move=> /> &1 &2 <- /> <- />. - by proc; inline*; sim. proc; sim. inline{1} 1; inline{2} 1; sp; sim; if; 1: auto; sim. @@ -664,12 +666,12 @@ have->:Pr[SORO.Preimage(SORO_P1(A), RFList).main() @ &m : res] = call(: ={glob SORO.Bounder, glob RFList, glob OSimulator, glob OPC, glob Log}); auto. - proc; sp; if; auto. inline{1} 1; inline{2} 1; sp; if; 1, 3: auto; sim. - if; 1: auto; sim; sp; sim; if; auto=> />; 1: smt(); sim. + if; 1: auto; sim; sp; sim; if; auto=> [/> &1 &2 <- /> <- />||]; sim. + inline{1} 1; inline{2} 1; sp; sim. inline{1} 1; inline{2} 1; sp; if; auto=> />. - - by call(rw_RF_List_While); auto; smt(). - smt(). - smt(). + - by call(rw_RF_List_While); auto=> /> &1 &2 <- /> <- />. + by move=> /> &1 &2 <- /> <- />. + by move=> /> &1 &2 <- /> <- />. - by sim. proc; sim; inline{1} 1; inline{2} 1; sp; if; auto. inline{1} 1; inline{2} 1; sp; sim. @@ -690,8 +692,8 @@ have->:Pr[SHA3_OIndiff.OIndif.OIndif(ExtendSample(FSome(BIRO.IRO)), while(={i, n, bs, x3} /\ size bs{1} = i{1} /\ eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2} /\ n{1} = size_out /\ 0 <= i{1} <= n{1}); auto. - * by sp; if; auto; smt(domE get_setE size_rcons). - smt(size_out_gt0 take_oversize size_out_gt0). + * by sp; if; auto=> />; smt(domE get_setE size_rcons). + move=> />; smt(size_out_gt0 take_oversize size_out_gt0). * by auto; rcondf{1} 1; auto. * rcondt{2} 1; 1: auto; move=> />; auto. by while(={i0, n0}); auto; sp; if{1}; if{2}; auto; smt(dbool_ll). @@ -701,11 +703,11 @@ have->:Pr[SHA3_OIndiff.OIndif.OIndif(ExtendSample(FSome(BIRO.IRO)), + proc; sp; if; auto. inline{1} 1; inline{2} 1; sp; if; 1, 3: auto. if; 1, 3: auto; sp. - if; 1: auto; 1: smt(); last first. - - by conseq=> />; sim; smt(). + if; [1:auto=> /> &1 &2 <- /> <- />]; last first. + - by conseq=> />; sim=> /> &1 &2 <- /> <- />. wp=> />; 1: smt(). rnd; auto=> />. - call(eq_extend); last by auto; smt(). + call(eq_extend); last by auto=> /> &1 &2 <- /> <- /> /#. + by proc; sp; if; auto; inline{1} 1; inline{2} 1; sp; if; auto. proc; sp; inline{1} 1; inline{2} 1; sp; if; auto. inline*; sp. @@ -715,8 +717,12 @@ have->:Pr[SHA3_OIndiff.OIndif.OIndif(ExtendSample(FSome(BIRO.IRO)), 1: by auto. while(={i, n, x3, bs} /\ 0 <= i{1} <= size_out /\ n{1} = size_out /\ eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}). - - by sp; if; auto; smt(domE get_setE size_rcons). - by auto; smt(size_out_gt0). + + sp; if; auto=> />. + + smt(domE get_setE size_rcons). + + move=> + + + + + + + + + + _. + smt(domE get_set_sameE get_setE size_rcons). + smt(domE get_setE size_rcons). + by auto=> />; smt(size_out_gt0). byequiv=> //=; proc. inline{1} 1; inline{2} 2; sp. inline{1} 1; inline{2} 3; swap{2}[1..2]1; sp. @@ -745,9 +751,9 @@ auto; call(: ={glob OSimulator, glob Counter, glob Log} /\ + proc; sp; if; auto=> />; 1: smt(). inline{1} 1; inline{2} 1; sp; auto. if; 1, 3: auto; -1: smt(). - if; 1, 3: auto; -1: smt(). - sp; if; 1: auto; 1: smt(); last first. - - by conseq(:_==> ={y, glob OSimulator}); 1: smt(); sim; smt(). + if; 1,3:auto=> /> + + + + + + + + + + + _ + _ /#. + sp; if; [1:by auto=> /> &1 &2 <- /> <-]; last first. + + by conseq (: ={y, glob OSimulator}); [|sim]=> /> &1 &2 <- /> <- /#. inline{1} 1; inline{2} 1; sp. inline{1} 1; inline{2} 1; sp. rcondt{2} 1; 1: by auto; smt(). @@ -757,7 +763,7 @@ auto; call(: ={glob OSimulator, glob Counter, glob Log} /\ SORO.Bounder.bounder{2} <= Counter.c{2} + 1); last first. - by conseq(:_==> ={y, x1, glob OSimulator, Log.m}); 1: smt(); sim=> />. inline{1} 1; auto. - by call(eq_IRO_RFWhile); auto; smt(). + by call(eq_IRO_RFWhile); auto=> /> &1 &2 + <- /> <- /#. + by proc; inline*; sp; if; auto; sp; if; auto=> />; smt(). proc. inline{1} 1; inline{2} 1; sp; if; auto=> /=. @@ -805,20 +811,22 @@ seq 1 1 : (={glob A, glob SHA3Indiff.Simulator, glob SORO.Bounder, glob Counter, inline *; sp; sim. if; 1: auto; sim. if; 1: auto; sim. - sp; if; 1: (auto; smt()); sim; 2: smt(). + sp; if; [2,3:sim]; [1,3:by auto=> /> &1 &2 <- /> <- />]. sp; if; 1: auto; sim; -1: smt(). sp; if{1}. - * rcondt{2} 2; auto; 1: smt(BlockSponge.parse_valid). + * rcondt{2} 2. + + by auto=> /> + + <- /> <- />. + auto. rnd (fun l => oget (of_list l)) to_list; auto=> />. - move=> &l &r 11?; split; 1: smt(of_listK). + move=> &l &r + <- /> <- /> - 7?; split; 1: smt(of_listK). rewrite -dout_equal_dlist=> ?; split=> ?. + by rewrite dmapE=> h{h}; apply mu_eq=> x; smt(to_list_inj). move=> sample. - rewrite !get_setE/=dout_full/= => h; split; 2: smt(). + rewrite !get_setE/=dout_full/= => h. rewrite eq_sym to_listK; apply some_oget. apply spec2_dout. by move:h; rewrite supp_dmap; smt(spec_dout). - by auto; smt(dout_ll). + by auto=> /> + + + <- /> <-; smt(dout_ll). - by proc; inline*; sp; if; auto; sp; if; auto. - proc; inline*; sp; if; auto; sp; if; auto; sp; sim. if{1}. @@ -830,7 +838,7 @@ seq 1 1 : (={glob A, glob SHA3Indiff.Simulator, glob SORO.Bounder, glob Counter, move=> sample. rewrite supp_dmap dout_full/= =>/> a. by rewrite get_setE/= dout_full/=; congr; rewrite of_listK oget_some. - by auto; smt(dout_ll). + by auto=> />; smt(dout_ll). sp; if; 1, 3: auto; sp; wp 1 2. if{1}. + wp=> />. @@ -1155,23 +1163,26 @@ if{1}; sp. while(={k, bs, n, x2} /\ i{1} = i0{2} /\ n{1} = size_out /\ 0 <= i{1} <= n{1} /\ size bs{1} = i{1} /\ eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}). - - by sp; if; auto; smt(domE get_setE size_rcons). - by auto; smt(size_eq0 size_out_gt0). + - by sp; if; auto=> />; smt(domE get_setE size_rcons). + by auto=> />; smt(size_eq0 size_out_gt0). rcondt{1} 1; 1: auto. splitwhile{1} 1 : i0 < size_out; auto=> /=. while( (i0, n0, x3){1} = (i, k, x){2} /\ bs0{1} = prefix{2} ++ suffix{2} /\ size_out <= i{2} <= k{2} /\ eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}). -+ by sp; if; auto; smt(domE get_setE size_out_gt0 rcons_cat). ++ sp; if; auto=> />. + + smt(). + + move=> + + + + + + + + + + _; smt(domE get_setE size_out_gt0 rcons_cat). + smt(domE get_setE size_out_gt0 rcons_cat). auto=> //=. conseq(:_==> ={i0} /\ size bs{2} = i0{1} /\ (i0, x3){1} = (n, x2){2} /\ bs0{1} = bs{2} /\ size bs{2} = size_out /\ eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}). -+ smt(cats0 take_oversize spec_dout to_listK spec2_dout). ++ move=> />; smt(cats0 take_oversize spec_dout to_listK spec2_dout). while(={i0} /\ x3{1} = x2{2} /\ 0 <= i0{1} <= n{2} /\ n{2} = size_out /\ bs0{1} = bs{2} /\ size bs{2} = i0{1} /\ size_out <= n0{1} /\ eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}). -+ by sp; if; auto; smt(size_rcons domE get_setE size_rcons mem_set). -by auto; smt(size_out_gt0). ++ by sp; if; auto=> />; smt(size_rcons domE get_setE size_rcons mem_set). +by auto=> />; smt(size_out_gt0). qed. @@ -1225,7 +1236,7 @@ proc; inline*; sp. if{1}; sp. + rcondt{1} 1; auto=> /=/>. conseq(:_==> take k{1} bs{1} = l{2} /\ BIRO.IRO.mp{1} = RO.m{2}). - * smt(). + * by move=> />; smt(). case: (0 <= n{2}); last first. + rcondf{2} 1; 1: by auto; smt(). conseq(:_==> BIRO.IRO.mp{1} = RO.m{2} /\ ={i} /\ n{1} = size_out /\ x2{1} = x0{2})=> />. @@ -1239,21 +1250,21 @@ if{1}; sp. while(={i} /\ n{1} = size_out /\ x2{1} = x0{2} /\ BIRO.IRO.mp{1} = RO.m{2} /\ take k{1} bs{1} = l{2} /\ size bs{1} = i{1} /\ k{1} <= i{1} <= size_out). * sp; if{1}. - - by rcondt{2} 2; auto; smt(dbool_ll cats1 take_cat cats0 take_size size_rcons). - by rcondf{2} 2; auto; smt(dbool_ll cats1 take_cat cats0 take_size size_rcons). + - by rcondt{2} 2; auto=> />; smt(dbool_ll cats1 take_cat cats0 take_size size_rcons). + by rcondf{2} 2; auto=> />; smt(dbool_ll cats1 take_cat cats0 take_size size_rcons). conseq(:_==> ={i} /\ n{1} = size_out /\ x2{1} = x0{2} /\ BIRO.IRO.mp{1} = RO.m{2} /\ bs{1} = l{2} /\ size bs{1} = i{1} /\ k{1} = i{1}). - + smt(take_size). + + by move=> />; smt(take_size). while(={i} /\ x2{1} = x0{2} /\ n{1} = size_out /\ k{1} = n{2} /\ 0 <= i{1} <= k{1} <= size_out /\ bs{1} = l{2} /\ size bs{1} = i{1} /\ BIRO.IRO.mp{1} = RO.m{2}). + sp; if{1}. - - by rcondt{2} 2; auto; smt(size_rcons). - by rcondf{2} 2; auto; smt(size_rcons dbool_ll). - by auto; smt(size_ge0 size_out_gt0). + - by rcondt{2} 2; auto=> />; smt(size_rcons). + by rcondf{2} 2; auto=> />; smt(size_rcons dbool_ll). + by auto=> />; smt(size_ge0 size_out_gt0). rcondt{1} 1; auto. rcondf{2} 2; 1: auto. -+ conseq(:_==> i = n); 1: smt(). ++ conseq(:_==> i = n); 1:by move=> />; smt(). by while(i <= n); auto=> />; smt(size_out_gt0). while(i0{1} = i{2} /\ x3{1} = x0{2} /\ n0{1} = n{2} /\ bs0{1} = l{2} /\ BIRO.IRO.mp{1} = RO.m{2}). @@ -1336,10 +1347,10 @@ have->: - proc; sp; if; auto. inline{1} 1; inline{2} 1; sp; sim; if; 1: auto; sim. if; 1: auto; sim; sp. - if; 1: auto; 1: smt(); sim. + if; [1:auto; [1:by move=> /> + + <- /> <-]]; sim. * inline{1} 1; inline{2} 1; sp; sim. - by call eq_eager_ideal; auto; smt(). - smt(). + by call eq_eager_ideal; auto=> /> + + <- /> <- /#. + by move=> /> + + <- /> <- /#. - by proc; inline*; sim. proc; sim. inline{1} 1; inline{2} 1; sp; sim; if; 1: auto; sim. @@ -1390,9 +1401,9 @@ have->: - proc; sp; if; auto. inline{1} 1; inline{2} 1; sp; sim; if; 1: auto; sim. if; 1: auto; sim; sp. - if; 1: auto; 1: smt(); sim. - * by call eq_eager_ideal2; auto; smt(). - smt(). + if; [1:auto; [1:by move=> /> + + <- /> <-]]; sim. + * by call eq_eager_ideal2; auto=> /> + + <- /> <- /#. + by move=> /> + + <- /> <- /#. - by proc; inline*; sim. proc; sim. inline{1} 1; inline{2} 1; sp; sim; if; 1: auto; sim. @@ -1413,8 +1424,8 @@ proc; inline*; sp; if; auto; sp; if; auto; sp; (rcondt{1} 1; 1: auto; rcondt{2} + conseq(:_==> ={bs} /\ eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}); auto. while(={i, bs, n, x3} /\ 0 <= i{1} <= size_out /\ n{1} = size_out /\ eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}). - - by sp; if; auto; smt(domE get_setE size_out_gt0). - by auto; smt(size_out_gt0). + + by sp; if; auto=> /> => [|+ + + + + + + + + + _|]; smt(domE get_setE size_out_gt0). + by auto=> />; smt(size_out_gt0). by conseq(:_==> true); auto; sim. qed. @@ -1487,12 +1498,12 @@ have->:Pr[SORO.SecondPreimage(SORO_P2(A), RFList).main(mess) @ &m : res] = glob Dist_of_P2Adv}); auto. - proc; sp; if; auto. inline{1} 1; inline{2} 1; sp; if; 1, 3: auto; sim. - if; 1: auto; sim; sp; sim; if; auto=> />; 1: smt(); sim. + if; [1:by auto]; sim; sp; sim; if; auto=> /> => [+ + <- /> <- //||]; sim. + inline{1} 1; inline{2} 1; sp; sim. inline{1} 1; inline{2} 1; sp; if; auto=> />. - - by call(rw_RF_List_While); auto; smt(). - smt(). - smt(). + - by call(rw_RF_List_While); auto=> /> + + <- /> <-. + by move=> /> + + <- /> <-. + by move=> /> + + <- /> <-. - by sim. proc; sim; inline{1} 1; inline{2} 1; sp; if; auto. inline{1} 1; inline{2} 1; sp; sim. @@ -1521,11 +1532,11 @@ have->:Pr[SHA3_OIndiff.OIndif.OIndif(ExtendSample(FSome(BIRO.IRO)), + proc; sp; if; auto. inline{1} 1; inline{2} 1; sp; if; 1, 3: auto. if; 1, 3: auto; sp. - if; 1: auto; 1: smt(); last first. - - by conseq=> />; sim; smt(). - wp=> />; 1: smt(). + if; [1:by auto=> /> + + <- /> <-]; last first. + - by conseq=> />; sim=> /> + + <- /> <-. + wp=> />; [1:by auto=> /> + + <- /> <-]. rnd; auto. - call(eq_extend); by auto; smt(). + by call(eq_extend); auto=> /> + + <- /> <- /#. + by proc; sp; if; auto; inline{1} 1; inline{2} 1; sp; if; auto. proc; sp; inline{1} 1; inline{2} 1; sp; if; auto. inline*; sp. @@ -1535,8 +1546,8 @@ have->:Pr[SHA3_OIndiff.OIndif.OIndif(ExtendSample(FSome(BIRO.IRO)), 1: by auto. while(={i, n, x3, bs} /\ 0 <= i{1} <= size_out /\ n{1} = size_out /\ eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}). - - by sp; if; auto; smt(domE get_setE size_rcons). - by auto; smt(size_out_gt0). + - by sp; if; auto=> /> => [|+ + + + + + + + + + _|]; smt(domE get_setE size_rcons). + by auto=> />; smt(size_out_gt0). byequiv=> //=; proc. inline{1} 1; inline{2} 1; sp. inline{1} 1; inline{2} 1; sp. @@ -1579,9 +1590,11 @@ auto; call(: ={glob OSimulator, glob Counter, glob Log} /\ + proc; sp; if; auto=> />; 1: smt(). inline{1} 1; inline{2} 1; sp; auto. if; 1, 3: auto; -1: smt(). - if; 1, 3: auto; -1: smt(). - sp; if; 1: auto; 1: smt(); last first. - - by conseq(:_==> ={y, glob OSimulator}); 1: smt(); sim; smt(). + if; [1,3:auto]; [2:move=> /> + + + + + + + + + + + _ + _ - /#]. + sp; if; [1:by auto=> /> + + <- /> <-]; last first. + - conseq(:_==> ={y, glob OSimulator}). + + by auto=> /> + + <- /> <- /#. + by sim=> /> + + <- /> <-. inline{1} 1; inline{2} 1; sp. inline{1} 1; inline{2} 1; sp. rcondt{2} 1; 1: by auto; smt(). @@ -1591,7 +1604,7 @@ auto; call(: ={glob OSimulator, glob Counter, glob Log} /\ SORO.Bounder.bounder{2} <= Counter.c{2} + 1); last first. - by conseq(:_==> ={y, x1, glob OSimulator, Log.m}); 1: smt(); sim=> />. inline{1} 1; auto. - by call(eq_IRO_RFWhile); auto; smt(). + by call(eq_IRO_RFWhile); auto=> /> + + + <- /> <- /#. + by proc; inline*; sp; if; auto; sp; if; auto=> />; smt(). proc. inline{1} 1; inline{2} 1; sp; if; auto=> /=. @@ -1628,20 +1641,20 @@ seq 1 1 : (={glob A, glob SHA3Indiff.Simulator, glob SORO.Bounder, glob Counter, inline *; sp; sim. if; 1: auto; sim. if; 1: auto; sim. - sp; if; 1: (auto; smt()); sim; 2: smt(). + sp; if; [1:by auto=> /> + + <- /> <-]; sim; 2:by auto=> /> + + <- /> <-. sp; if; 1: auto; sim; -1: smt(). sp; if{1}. - * rcondt{2} 2; auto; 1: smt(BlockSponge.parse_valid). + * rcondt{2} 2; auto; [1:by auto=> /> + + <- /> <-; smt(BlockSponge.parse_valid)]. rnd (fun l => oget (of_list l)) to_list; auto=> />. - move=> &l &r 11?; split; 1: smt(of_listK). + move=> /> &l &r + <- /> <- /> - 7?; split; 1: smt(of_listK). rewrite -dout_equal_dlist=> ?; split=> ?. + by rewrite dmapE=> h{h}; apply mu_eq=> x; smt(to_list_inj). move=> sample. - rewrite !get_setE/=dout_full/= => h; split; 2: smt(). + rewrite !get_setE/=dout_full/= => h. rewrite eq_sym to_listK; apply some_oget. apply spec2_dout. by move:h; rewrite supp_dmap; smt(spec_dout). - by auto; smt(dout_ll). + by auto=> /> + + + <- /> <-; smt(dout_ll). - by proc; inline*; sp; if; auto; sp; if; auto. - proc; inline*; sp; if; auto; sp; if; auto; sp; sim. if{1}. @@ -1653,7 +1666,7 @@ seq 1 1 : (={glob A, glob SHA3Indiff.Simulator, glob SORO.Bounder, glob Counter, move=> sample. rewrite supp_dmap dout_full/= =>/> a. by rewrite get_setE/= dout_full/=; congr; rewrite of_listK oget_some. - by auto; smt(dout_ll). + by auto=> />; smt(dout_ll). sp. seq 4 4 : (={SORO.Bounder.bounder, x0, m1, m2, hash1, y0} /\ y0{1} = None /\ RFList.m{1} = SORO.RO.RO.m{2}); last first. @@ -2030,23 +2043,23 @@ if{1}; sp. while(={k, bs, n, x2} /\ i{1} = i0{2} /\ n{1} = size_out /\ 0 <= i{1} <= n{1} /\ size bs{1} = i{1} /\ eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}). - - by sp; if; auto; smt(domE get_setE size_rcons). - by auto; smt(size_eq0 size_out_gt0). + - by sp; if; auto=> />; smt(domE get_setE size_rcons). + by auto=> />; smt(size_eq0 size_out_gt0). rcondt{1} 1; 1: auto. splitwhile{1} 1 : i0 < size_out; auto=> /=. while( (i0, n0, x3){1} = (i, k, x){2} /\ bs0{1} = prefix{2} ++ suffix{2} /\ size_out <= i{2} <= k{2} /\ eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}). -+ by sp; if; auto; smt(domE get_setE size_out_gt0 rcons_cat). ++ by sp; if; auto=> /> => [|+ + + + + + + + + + _|]; smt(domE get_setE size_out_gt0 rcons_cat). auto=> //=. conseq(:_==> ={i0} /\ size bs{2} = i0{1} /\ (i0, x3){1} = (n, x2){2} /\ bs0{1} = bs{2} /\ size bs{2} = size_out /\ - eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}). -+ smt(cats0 take_oversize spec_dout to_listK spec2_dout). + eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}). ++ by auto=> />; smt(cats0 take_oversize spec_dout to_listK spec2_dout). while(={i0} /\ x3{1} = x2{2} /\ 0 <= i0{1} <= n{2} /\ n{2} = size_out /\ bs0{1} = bs{2} /\ size bs{2} = i0{1} /\ size_out <= n0{1} /\ eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}). -+ by sp; if; auto; smt(size_rcons domE get_setE size_rcons mem_set). -by auto; smt(size_out_gt0). ++ by sp; if; auto=> /> => [|+ + + + + + + + + + + + _|]; smt(size_rcons domE get_setE size_rcons mem_set). +by auto=> />; smt(size_out_gt0). qed. @@ -2100,7 +2113,7 @@ proc; inline*; sp. if{1}; sp. + rcondt{1} 1; auto=> /=/>. conseq(:_==> take k{1} bs{1} = l{2} /\ BIRO.IRO.mp{1} = RO.m{2}). - * smt(). + * by auto=> />; smt(). case: (0 <= n{2}); last first. + rcondf{2} 1; 1: by auto; smt(). conseq(:_==> BIRO.IRO.mp{1} = RO.m{2} /\ ={i} /\ n{1} = size_out /\ x2{1} = x0{2})=> />. @@ -2114,8 +2127,8 @@ if{1}; sp. while(={i} /\ n{1} = size_out /\ x2{1} = x0{2} /\ BIRO.IRO.mp{1} = RO.m{2} /\ take k{1} bs{1} = l{2} /\ size bs{1} = i{1} /\ k{1} <= i{1} <= size_out). * sp; if{1}. - - by rcondt{2} 2; auto; smt(dbool_ll cats1 take_cat cats0 take_size size_rcons). - by rcondf{2} 2; auto; smt(dbool_ll cats1 take_cat cats0 take_size size_rcons). + - by rcondt{2} 2; auto=> />; smt(dbool_ll cats1 take_cat cats0 take_size size_rcons). + by rcondf{2} 2; auto=> />; smt(dbool_ll cats1 take_cat cats0 take_size size_rcons). conseq(:_==> ={i} /\ n{1} = size_out /\ x2{1} = x0{2} /\ BIRO.IRO.mp{1} = RO.m{2} /\ bs{1} = l{2} /\ size bs{1} = i{1} /\ k{1} = i{1}). + smt(take_size). @@ -2123,12 +2136,12 @@ if{1}; sp. 0 <= i{1} <= k{1} <= size_out /\ bs{1} = l{2} /\ size bs{1} = i{1} /\ BIRO.IRO.mp{1} = RO.m{2}). + sp; if{1}. - - by rcondt{2} 2; auto; smt(size_rcons). - by rcondf{2} 2; auto; smt(size_rcons dbool_ll). - by auto; smt(size_ge0 size_out_gt0). + - by rcondt{2} 2; auto=> />; smt(size_rcons). + by rcondf{2} 2; auto=> />; smt(size_rcons dbool_ll). + by auto=> />; smt(size_ge0 size_out_gt0). rcondt{1} 1; auto. rcondf{2} 2; 1: auto. -+ conseq(:_==> i = n); 1: smt(). ++ conseq(:_==> i = n)=> />; 1:smt(). by while(i <= n); auto=> />; smt(size_out_gt0). while(i0{1} = i{2} /\ x3{1} = x0{2} /\ n0{1} = n{2} /\ bs0{1} = l{2} /\ BIRO.IRO.mp{1} = RO.m{2}). @@ -2211,10 +2224,10 @@ have->: - proc; sp; if; auto. inline{1} 1; inline{2} 1; sp; sim; if; 1: auto; sim. if; 1: auto; sim; sp. - if; 1: auto; 1: smt(); sim. + if; [1:by auto=> /> + + <- /> <-]; sim. * inline{1} 1; inline{2} 1; sp; sim. - by call eq_eager_ideal; auto; smt(). - smt(). + by call eq_eager_ideal; auto=> /> + + <- /> <-. + by auto=> /> + + <- /> <-. - by proc; inline*; sim. proc; sim. inline{1} 1; inline{2} 1; sp; sim; if; 1: auto; sim. @@ -2265,9 +2278,9 @@ have->: - proc; sp; if; auto. inline{1} 1; inline{2} 1; sp; sim; if; 1: auto; sim. if; 1: auto; sim; sp. - if; 1: auto; 1: smt(); sim. - * by call eq_eager_ideal2; auto; smt(). - smt(). + if; [1:by auto=> /> + + <- /> <-]; sim. + * by call eq_eager_ideal2; auto=> /> + + <- /> <-. + by auto=> /> + + <- /> <-. - by proc; inline*; sim. proc; sim. inline{1} 1; inline{2} 1; sp; sim; if; 1: auto; sim. @@ -2287,8 +2300,8 @@ proc; inline*; sp; if; auto; sp; if; auto; sp; (rcondt{1} 1; 1: auto; rcondt{2} + conseq(:_==> ={bs} /\ eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}); auto. while(={i, bs, n, x3} /\ 0 <= i{1} <= size_out /\ n{1} = size_out /\ eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}). - - by sp; if; auto; smt(domE get_setE size_out_gt0). - by auto; smt(size_out_gt0). + - by sp; if; auto=> /> => [|+ + + + + + + + + + _|]; smt(domE get_setE size_out_gt0). + by auto=> />; smt(size_out_gt0). by conseq(:_==> true); auto; sim. qed. @@ -2358,12 +2371,12 @@ have->:Pr[SORO.Collision(SORO_Coll(A), RFList).main() @ &m : res] = call(: ={glob SORO.Bounder, glob RFList, glob OSimulator, glob OPC, glob Log}); auto. - proc; sp; if; auto. inline{1} 1; inline{2} 1; sp; if; 1, 3: auto; sim. - if; 1: auto; sim; sp; sim; if; auto=> />; 1: smt(); sim. + if; [1:by auto]; sim; sp; sim; if; auto=> /> => [+ + <- /> <- //||]; sim. + inline{1} 1; inline{2} 1; sp; sim. inline{1} 1; inline{2} 1; sp; if; auto=> />. - - by call(rw_RF_List_While); auto; smt(). - smt(). - smt(). + - by call(rw_RF_List_While); auto=> /> + + <- /> <-. + by auto=> /> + + <- /> <-. + by auto=> /> + + <- /> <-. - by sim. proc; sim; inline{1} 1; inline{2} 1; sp; if; auto. inline{1} 1; inline{2} 1; sp; sim. @@ -2392,12 +2405,12 @@ have->:Pr[SHA3_OIndiff.OIndif.OIndif(ExtendSample(FSome(BIRO.IRO)), + proc; sp; if; auto. inline{1} 1; inline{2} 1; sp; if; 1, 3: auto. if; 1, 3: auto; sp. - if; 1: auto; 1: smt(); last first. - - by conseq=> />; sim; smt(). + if; [1:by auto=> /> + + <- /> <-]; last first. + - by conseq=> />; sim=> /> + + <- /> <-. wp=> />; 1: smt(). rnd; auto. - call(eq_extend); by auto; smt(). - + by proc; sp; if; auto; inline{1} 1; inline{2} 1; sp; if; auto. + by call(eq_extend); auto=> /> + + <- /> <- /#. + by proc; sp; if; auto; inline{1} 1; inline{2} 1; sp; if; auto. proc; sp; inline{1} 1; inline{2} 1; sp; if; auto. inline*; sp. rcondt{1} 1; 1: auto; rcondt{2} 1; 1: auto; sp. @@ -2406,8 +2419,8 @@ have->:Pr[SHA3_OIndiff.OIndif.OIndif(ExtendSample(FSome(BIRO.IRO)), 1: by auto. while(={i, n, x3, bs} /\ 0 <= i{1} <= size_out /\ n{1} = size_out /\ eq_extend_size BIRO.IRO.mp{1} BIRO.IRO.mp{2} Log.m{2}). - - by sp; if; auto; smt(domE get_setE size_rcons). - by auto; smt(size_out_gt0). + - by sp; if; auto=> /> => [|+ + + + + + + + + + _|]; smt(domE get_setE size_rcons). + by auto=> />; smt(size_out_gt0). byequiv=> //=; proc. inline{1} 1; inline{2} 1; sp. inline{1} 1; inline{2} 1; sp. @@ -2447,9 +2460,9 @@ auto; call(: ={glob OSimulator, glob Counter, glob Log} /\ + proc; sp; if; auto=> />; 1: smt(). inline{1} 1; inline{2} 1; sp; auto. if; 1, 3: auto; -1: smt(). - if; 1, 3: auto; -1: smt(). - sp; if; 1: auto; 1: smt(); last first. - - by conseq(:_==> ={y, glob OSimulator}); 1: smt(); sim; smt(). + if; [1,3:auto]; 2:by move=> /> + + + + + + + + + + + _ + _ /#. + sp; if; [1:by auto=> /> + + <- /> <-]; last first. + - by conseq(:_==> ={y, glob OSimulator}); [2:sim]; auto=> /> + + <- /> <- /#. inline{1} 1; inline{2} 1; sp. inline{1} 1; inline{2} 1; sp. rcondt{2} 1; 1: by auto; smt(). @@ -2459,7 +2472,7 @@ auto; call(: ={glob OSimulator, glob Counter, glob Log} /\ SORO.Bounder.bounder{2} <= Counter.c{2} + 1); last first. - by conseq(:_==> ={y, x1, glob OSimulator, Log.m}); 1: smt(); sim=> />. inline{1} 1; auto. - by call(eq_IRO_RFWhile); auto; smt(). + by call(eq_IRO_RFWhile); auto=> /> + + + <- /> <- /#. + by proc; inline*; sp; if; auto; sp; if; auto=> />; smt(). proc. inline{1} 1; inline{2} 1; sp; if; auto=> /=. @@ -2494,20 +2507,20 @@ seq 1 1 : (={glob A, glob SHA3Indiff.Simulator, glob SORO.Bounder, glob Counter, inline *; sp; sim. if; 1: auto; sim. if; 1: auto; sim. - sp; if; 1: (auto; smt()); sim; 2: smt(). + sp; if; [3:sim]; [1,3:by auto=> /> + + <- /> <-]. sp; if; 1: auto; sim; -1: smt(). sp; if{1}. - * rcondt{2} 2; auto; 1: smt(BlockSponge.parse_valid). + * rcondt{2} 2; auto; [1:by auto=> /> + + <- /> <-; smt(BlockSponge.parse_valid)]. rnd (fun l => oget (of_list l)) to_list; auto=> />. - move=> &l &r 11?; split; 1: smt(of_listK). + move=> /> &l &r + <- /> <- /> 6?; split; 1: smt(of_listK). rewrite -dout_equal_dlist=> ?; split=> ?. + by rewrite dmapE=> h{h}; apply mu_eq=> x; smt(to_list_inj). move=> sample. - rewrite !get_setE/= dout_full/= => h; split; 2: smt(). + rewrite !get_setE/= dout_full/= => h. rewrite eq_sym to_listK; apply some_oget. apply spec2_dout. by move:h; rewrite supp_dmap; smt(spec_dout). - by auto; smt(dout_ll). + by auto=> /> + + + <- /> <-; smt(dout_ll). - by proc; inline*; sp; if; auto; sp; if; auto. - proc; inline*; sp; if; auto; sp; if; auto; sp; sim. if{1}. @@ -2519,7 +2532,7 @@ seq 1 1 : (={glob A, glob SHA3Indiff.Simulator, glob SORO.Bounder, glob Counter, move=> sample. rewrite supp_dmap dout_full/= =>/> a. by rewrite get_setE/= dout_full/=; congr; rewrite of_listK oget_some. - by auto; smt(dout_ll). + by auto=> />; smt(dout_ll). sp. seq 4 4 : (={SORO.Bounder.bounder, x0, m1, m2, hash1, y0} /\ y0{1} = None /\ RFList.m{1} = SORO.RO.RO.m{2}); last first. diff --git a/proof/SHA3_OIndiff.ec b/proof/SHA3_OIndiff.ec index c046d8b..34f6679 100644 --- a/proof/SHA3_OIndiff.ec +++ b/proof/SHA3_OIndiff.ec @@ -236,10 +236,11 @@ have->: Pr[OGIdeal(FSome(IRO), OSimulator, ODRestr(Dist)).main() @ &m : res] = call(: ={glob IRO, glob Simulator, glob Counter} /\ ={c}(Counter,Cntr)); auto. - proc; inline*; auto; sp; if; auto; sp. rcondt{2} 1; auto; sp; if; 1, 3: auto; sim; if; 1, 3: auto; sp; sim. - if; 1, 3: auto; 1: smt(); sp. - * if; auto=> />. - by conseq(:_==> ={IRO.mp} /\ bs0{1} = bs{2})=> />; sim=> />; smt(). - by if; auto=> />; sim; smt(). + if; [1:by auto=> /> &1 &2 <- /> <- />|3:auto=> />]; sp. + * if; auto=> />. + conseq(:_==> ={IRO.mp} /\ bs0{1} = bs{2})=> />; sim=> />. + by move=> &1 &2 <- /> <- />. + by if; auto=> />; sim=> &1 &2 /> <- /> <- /= ->. - proc; inline*; sp; auto; if; auto; sp. by rcondt{2} 1; auto; sp; if; auto. proc; inline*; sp; auto; if; auto; sp. From 92b22e4ac1e9fa92df1e4920cf2935e89819bfda Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Thu, 5 May 2022 14:12:28 +0100 Subject: [PATCH 520/525] Fix CI to use release testbox --- .gitlab-ci.yml | 12 +++--------- 1 file changed, 3 insertions(+), 9 deletions(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 1a85383..baa5e39 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -4,27 +4,21 @@ variables: DOCKER_DRIVER: overlay DOCKER_TLS_CERTDIR: "" GIT_SUBMODULE_STRATEGY: recursive - ECTAG: "1.0" + DOCKERTAG: "latest" services: - docker:dind before_script: - docker info -- docker pull docker.io/easycryptpa/ec-build-box:latest -- >- - docker run --name testbox docker.io/easycryptpa/ec-build-box:latest - sh -c "git clone https://github.com/EasyCrypt/easycrypt.git --depth 1 --branch $ECTAG - cd easycrypt && make install && - opam config exec -- easycrypt config" -- docker commit testbox testbox:latest +- docker pull docker.io/easycryptpa/ec-test-box:$DOCKERTAG .tests: variables: ECJOBS: 2 script: - >- - docker run -v $PWD:/sha3 --env CHECKS --env ECJOBS testbox + docker run -v $PWD:/sha3 --env CHECKS --env ECJOBS docker.io/easycryptpa/ec-test-box:$DOCKERTAG sh -c 'cd /sha3 && opam config exec -- make check-xunit' artifacts: when: on_failure From 78f9cf6637fd671debf9bc0542ab7584197f4bce Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Mon, 11 Jul 2022 11:25:37 +0100 Subject: [PATCH 521/525] Refine some edgy SMT calls --- proof/smart_counter/ConcreteF.eca | 10 ++++++++-- proof/smart_counter/Gcol.eca | 6 ++++-- proof/smart_counter/Gext.eca | 6 ++++-- 3 files changed, 16 insertions(+), 6 deletions(-) diff --git a/proof/smart_counter/ConcreteF.eca b/proof/smart_counter/ConcreteF.eca index 425198c..5c510f2 100644 --- a/proof/smart_counter/ConcreteF.eca +++ b/proof/smart_counter/ConcreteF.eca @@ -118,8 +118,14 @@ section. /\ (forall y, y \in pref{1} => pref{1}.[y] = Redo.prefixes{1}.[y]) /\ (forall y, y \in Redo.prefixes{1} <=> (y \in pref{1} \/ (exists j, 0 <= j <= i{1} /\ y = take j bs{1}))) - /\ DBounder.FBounder.c{2} = C.c{2} - size bs{1} + i{1}); - progress;..-2:smt(domE mem_set get_setE oget_some take_size cat_take_drop). + /\ DBounder.FBounder.c{2} = C.c{2} - size bs{1} + i{1}). + + auto=> />; progress. + + smt(domE mem_set get_setE take_size cat_take_drop). + + smt(domE mem_set get_setE take_size cat_take_drop). + + smt(domE mem_set get_setE take_size cat_take_drop). + + smt(domE mem_set get_setE take_size cat_take_drop). + + by move: H15=> /H11 []; smt(domE mem_set get_setE take_size cat_take_drop). + smt(domE mem_set get_setE take_size cat_take_drop). while( ={sa, Redo.prefixes, glob P, i, C.c, p, sc} /\ p{1} = bs{1} /\ all_prefixes Redo.prefixes{2} /\ Redo.prefixes{2}.[[]] = Some (b0, c0) diff --git a/proof/smart_counter/Gcol.eca b/proof/smart_counter/Gcol.eca index a025edf..e5b2fe0 100644 --- a/proof/smart_counter/Gcol.eca +++ b/proof/smart_counter/Gcol.eca @@ -236,7 +236,8 @@ section PROOF. G1.mh, FRO.m, C.c, C.queries} /\ (G1.bcol{1} => G1.bcol{2}) /\ card (frng FRO.m{2}) <= 2 * C.c{2} - /\ Gcol.count{2} + 1 <= C.c{2} <= max_size);1: by if;auto;smt(card_rng_set). + /\ Gcol.count{2} + 1 <= C.c{2} <= max_size). + + by if; auto=> /> &1 &2; smt(card_rng_set). if;1:auto. - inline Gcol.sample_c;rcondt{2}4. * auto;inline*;auto;progress. @@ -328,7 +329,8 @@ section PROOF. prefix p{2} (get_max_prefix p{2} (elems (fdom C.queries{1}))) - counter{2} <= C.c{2} + size p{2} - prefix p{2} (get_max_prefix p{2} (elems (fdom C.queries{1}))) - <= max_size);last by auto;smt(size_ge0 prefix_sizel prefix_ge0). + <= max_size);last first. + + by auto=> />; smt(size_ge0 prefix_sizel prefix_ge0). if=>//;auto;1:smt ml=0 w=size_ge0. if=>//;2:auto;2:smt(size_ge0 prefix_sizel). auto;call (_: ={F.RO.m})=>/=;1:by sim. diff --git a/proof/smart_counter/Gext.eca b/proof/smart_counter/Gext.eca index 43187e4..e90c3a1 100644 --- a/proof/smart_counter/Gext.eca +++ b/proof/smart_counter/Gext.eca @@ -667,7 +667,8 @@ section EXT. prefix bs{1} (get_max_prefix bs{1} (elems (fdom C.queries{1}))) /\ c0R + size p{1} - prefix bs{1} (get_max_prefix bs{1} (elems (fdom C.queries{1}))) <= max_size /\ - inv_le G1.m{2} G1.mi{2} (c0R + counter){2} FRO.m{2} ReSample.count{2});1:smt(List.size_ge0). + inv_le G1.m{2} G1.mi{2} (c0R + counter){2} FRO.m{2} ReSample.count{2}). + + by auto=> />; smt(List.size_ge0). while (={bs,i,p,G1.mh,sa,h,FRO.m,F.RO.m,G1.mh,G1.mhi,G1.chandle,counter,C.queries} /\ bs{1} = p{1} /\ 0 <= i{1} <= size p{1} /\ 0 <= counter{1} <= size p{1} - @@ -675,7 +676,8 @@ section EXT. c0R + size p{1} - prefix bs{1} (get_max_prefix bs{1} (elems (fdom C.queries{1}))) <= max_size /\ inv_le G1.m{2} G1.mi{2} (c0R + counter){2} FRO.m{2} ReSample.count{2}); - last by auto;smt(List.size_ge0 prefix_sizel). + last first. + + by auto=> />;smt(List.size_ge0 prefix_sizel). if=> //;1:by auto=>/#. if=> //;2:by auto=>/#. auto;call (_: ={F.RO.m});1:by sim. From 77027254b47c6cc27ae0758dd066bac049dc56cc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Wed, 2 Aug 2023 18:45:14 +0100 Subject: [PATCH 522/525] [chore] update to follow main --- Makefile | 20 +++++--------------- proof/Common.ec | 5 ----- 2 files changed, 5 insertions(+), 20 deletions(-) diff --git a/Makefile b/Makefile index 20b49e2..7d242c6 100644 --- a/Makefile +++ b/Makefile @@ -5,29 +5,19 @@ ECROOT ?= ECCHECK ?= ECARGS ?= ECJOBS ?= 2 -ECCONF := config/tests.config +ECCONF := config/tests.config XUNITOUT ?= xunit.yml CHECKS ?= sha3 -ifeq ($(ECCHECK),) -ifeq ($(ECROOT),) -ECCHECK := ec-runtest -else -PATH := ${ECROOT}:${PATH} -ECCHECK := $(ECROOT)/scripts/testing/runtest -endif -endif +ECCHECK := easycrypt runtest # -------------------------------------------------------------------- -.PHONY: default usage check check-xunit +.PHONY: default usage check default: check usage: - @echo "Usage: make where in [check|check-xunit]" >&2 + @echo "Usage: make check" >&2 check: - $(ECCHECK) --jobs=$(ECJOBS) --bin-args="$(ECARGS)" $(ECCONF) $(CHECKS) - -check-xunit: - $(ECCHECK) --jobs=$(ECJOBS) --bin-args="$(ECARGS)" --report=$(XUNITOUT) $(ECCONF) $(CHECKS) + $(ECCHECK) $(ECCONF) $(CHECKS) diff --git a/proof/Common.ec b/proof/Common.ec index 044a8f4..e836d4b 100644 --- a/proof/Common.ec +++ b/proof/Common.ec @@ -11,9 +11,6 @@ pragma +implicits. op r : { int | 2 <= r } as ge2_r. op c : { int | 0 < c } as gt0_c. -type block. (* ~ bitstrings of size r *) -type capacity. (* ~ bitstrings of size c *) - (* -------------------------------------------------------------------- *) lemma gt0_r : 0 < r. @@ -27,7 +24,6 @@ proof. by apply/ltrW/gt0_c. qed. (* -------------------------------------------------------------------- *) clone export BitWord as Capacity with - type word <- capacity, op n <- c proof gt0_n by apply/gt0_c @@ -38,7 +34,6 @@ clone export BitWord as Capacity with export Capacity DCapacity. clone export BitWord as Block with - type word <- block, op n <- r proof gt0_n by apply/gt0_r From bc66e519a0eed2ff2261a96f6031e11c201f9fd0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Thu, 10 Aug 2023 11:06:25 +0100 Subject: [PATCH 523/525] [ci] switch to nix-based CI --- .gitlab-ci.yml | 22 ++++++++++------------ Makefile | 4 ---- config/tests.config | 9 +++++++-- shell.nix | 12 ++++++++++++ 4 files changed, 29 insertions(+), 18 deletions(-) create mode 100644 shell.nix diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index baa5e39..ed823c8 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -1,29 +1,27 @@ -image: docker:latest +image: nixos/nix:master variables: DOCKER_DRIVER: overlay DOCKER_TLS_CERTDIR: "" GIT_SUBMODULE_STRATEGY: recursive - DOCKERTAG: "latest" - -services: -- docker:dind + ECBRANCH: "main" + NAME: "sha3" + NIXPKGS_ALLOW_UNFREE: 1 before_script: -- docker info -- docker pull docker.io/easycryptpa/ec-test-box:$DOCKERTAG +- nix-channel --update +- nix-env --install --attr nixpkgs.cachix nixpkgs.git +- cachix use formosa-crypto +- git clone --branch $ECBRANCH --single-branch https://github.com/easycrypt/easycrypt.git .tests: variables: ECJOBS: 2 script: - - >- - docker run -v $PWD:/sha3 --env CHECKS --env ECJOBS docker.io/easycryptpa/ec-test-box:$DOCKERTAG - sh -c 'cd /sha3 && opam config exec -- make check-xunit' + - nix-shell --pure --keep ECJOBS --keep CHECKS --run "easycrypt why3config && easycrypt config && make check" artifacts: - when: on_failure paths: - - xunit.yml + - report.log sponge: extends: .tests diff --git a/Makefile b/Makefile index 7d242c6..edadee2 100644 --- a/Makefile +++ b/Makefile @@ -1,12 +1,8 @@ # -*- Makefile -*- # -------------------------------------------------------------------- -ECROOT ?= -ECCHECK ?= -ECARGS ?= ECJOBS ?= 2 ECCONF := config/tests.config -XUNITOUT ?= xunit.yml CHECKS ?= sha3 ECCHECK := easycrypt runtest diff --git a/config/tests.config b/config/tests.config index 580b3a8..351875b 100644 --- a/config/tests.config +++ b/config/tests.config @@ -1,18 +1,23 @@ [default] -bin = easycrypt -args = -timeout 30 -I Jasmin:jasmin/eclib -I proof -I proof/smart_counter -I proof/impl -I proof/impl/perm +bin = easycrypt +report = report.log [test-sha3] okdirs = !proof +args = -I Jasmin:jasmin/eclib -I proof -I proof/smart_counter -I proof/impl -I proof/impl/perm [test-sponge] okdirs = proof proof/smart_counter +args = -I proof -I proof/smart_counter [test-jsponge] okdirs = proof/impl +args = -I Jasmin:jasmin/eclib -I proof -I proof/smart_counter [test-jperm] okdirs = proof/impl/perm +args = -I Jasmin:jasmin/eclib -I proof -I proof/smart_counter -I proof/impl [test-libc] okdirs = proof/impl/libc +args = -I Jasmin:jasmin/eclib -I proof -I proof/smart_counter -I proof/impl -I proof/impl/perm diff --git a/shell.nix b/shell.nix new file mode 100644 index 0000000..fe36b57 --- /dev/null +++ b/shell.nix @@ -0,0 +1,12 @@ +{ ecpath ? easycrypt/default.nix }: + +with import {}; + +let ec = (callPackage ecpath { withProvers = true; }); +in + +pkgs.mkShell { + buildInputs = [ ec ] + ++ ec.propagatedBuildInputs + ++ (with python3Packages; [ pyyaml ]); +} From 1a28e612b9242bbcf89f6212e6c3347fd7033c05 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Tue, 12 Sep 2023 16:47:34 +0100 Subject: [PATCH 524/525] =?UTF-8?q?Stabilise=20SMT=20the=20One=20True=20Wa?= =?UTF-8?q?y=E2=84=A2?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- proof/smart_counter/Handle.eca | 23 ++++++++++++++++++++++- 1 file changed, 22 insertions(+), 1 deletion(-) diff --git a/proof/smart_counter/Handle.eca b/proof/smart_counter/Handle.eca index ab1bf00..4ba8b17 100644 --- a/proof/smart_counter/Handle.eca +++ b/proof/smart_counter/Handle.eca @@ -2148,8 +2148,29 @@ proof. conseq(:_==> Redo.prefixes{1}.[take (i{1}+1) p{1}] = Some (sa{1}, sc{1}) /\ (take (i{1} + 1) p{1} \in Redo.prefixes{1}) /\ (G1.bcol{2} \/ G1.bext{2}));1:smt(prefix_ge0). - if{1};sp;2:if{1};(if{2};2:if{2});sp;auto;5:swap{2}4-3;auto; + if {1}; last first. + + sp; if {1}; if {2}; last first. + + if {2}; sp; auto=> />. + + smt(get_setE mem_set DBlock.dunifin_ll DCapacity.dunifin_ll). + smt(get_setE mem_set DBlock.dunifin_ll DCapacity.dunifin_ll). + + auto=> />. + smt(get_setE mem_set DBlock.dunifin_ll DCapacity.dunifin_ll). + + if {2}; last first. + + auto=> />. + smt(get_setE mem_set DBlock.dunifin_ll DCapacity.dunifin_ll). + + swap {2} 4 -3; auto=> />. + smt(get_setE mem_set DBlock.dunifin_ll DCapacity.dunifin_ll). + auto=> />. smt(get_setE mem_set DBlock.dunifin_ll DCapacity.dunifin_ll). + if {2}. + + auto=> />. + smt(get_setE mem_set DBlock.dunifin_ll DCapacity.dunifin_ll). + if {2}. + + auto=> />. + smt(get_setE mem_set DBlock.dunifin_ll DCapacity.dunifin_ll). + auto=> />. + smt(get_setE mem_set DBlock.dunifin_ll DCapacity.dunifin_ll). + rcondf{1}1;1:auto=>/#. sp;wp. if{1};2:rcondt{2}1;first last;3:rcondf{2}1;..3:auto. From 9e50b13bedaea956b423d5fe1499ab1cb87b01aa Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Dupressoir?= Date: Tue, 12 Sep 2023 16:47:57 +0100 Subject: [PATCH 525/525] add emacs-shaped gap to shell.nix --- shell.nix | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/shell.nix b/shell.nix index fe36b57..84000b5 100644 --- a/shell.nix +++ b/shell.nix @@ -1,4 +1,5 @@ -{ ecpath ? easycrypt/default.nix }: +{ ecpath ? easycrypt/default.nix, + devDeps ? [ ] }: with import {}; @@ -7,6 +8,7 @@ in pkgs.mkShell { buildInputs = [ ec ] + ++ devDeps ++ ec.propagatedBuildInputs ++ (with python3Packages; [ pyyaml ]); }